101 lines
3.1 KiB
OpenEdge ABL
101 lines
3.1 KiB
OpenEdge ABL
|
60000 #include "rundecs.h"
|
||
|
|
60010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
||
|
|
60020 (**)
|
||
|
|
60030 (**)
|
||
|
|
60040 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
|
||
|
|
60050 FUNCTION CRSTRING(LENGTH: OFFSETRANGE): OBJECTP; EXTERN;
|
||
|
|
60060 FUNCTION SAFEACCESS (LOCATION: OBJECTP) : UNDRESSP; EXTERN;
|
||
|
|
60070 (**)
|
||
|
|
60080 (**)
|
||
|
|
60090 FUNCTION CATCC(LCH, RCH: CHAR): OBJECTP;
|
||
|
|
60100 (*PCAT*)
|
||
|
|
60110 VAR POINT :OBJECTP;
|
||
|
|
60120 BEGIN
|
||
|
|
60130 POINT := CRSTRING(2);
|
||
|
|
60140 WITH POINT^ DO
|
||
|
|
60150 BEGIN CHARVEC[1] := LCH; CHARVEC[2] := RCH END;
|
||
|
|
60160 CATCC := POINT;
|
||
|
|
60170 END;
|
||
|
|
60180 (**)
|
||
|
|
60190 (**)
|
||
|
|
60200 FUNCTION CATSS(LEFT, RIGHT: OBJECTP): OBJECTP;
|
||
|
|
60210 (*PCAT-1*)
|
||
|
|
60220 VAR POINT: OBJECTP;
|
||
|
|
60230 I, D: INTEGER; C: CHAR;
|
||
|
|
60240 BEGIN
|
||
|
|
60250 WITH LEFT^ DO
|
||
|
|
60260 BEGIN D := STRLENGTH;
|
||
|
|
60270 IF
|
||
|
|
60280 ( PCOUNT = 0 )
|
||
|
|
60290 AND
|
||
|
|
60300 ( STRLENGTH+RIGHT^.STRLENGTH <= (STRLENGTH + CHARPERWORD - 1) DIV CHARPERWORD * CHARPERWORD ) THEN
|
||
|
|
60310 BEGIN POINT := LEFT; I := D+RIGHT^.STRLENGTH; POINT^.STRLENGTH := I END
|
||
|
|
60320 ELSE
|
||
|
|
60330 BEGIN POINT := CRSTRING(STRLENGTH+RIGHT^.STRLENGTH);
|
||
|
|
60340 FOR I := 1 TO STRLENGTH DO
|
||
|
|
60350 BEGIN C := CHARVEC[I]; POINT^.CHARVEC[I] := C END;
|
||
|
|
60360 IF FPTST(LEFT^) THEN GARBAGE(LEFT)
|
||
|
|
60370 END
|
||
|
|
60380 END;
|
||
|
|
60390 WITH RIGHT^ DO
|
||
|
|
60400 FOR I := 1 TO RIGHT^.STRLENGTH DO
|
||
|
|
60410 BEGIN C := CHARVEC[I]; POINT^.CHARVEC[I+D] := C END;
|
||
|
|
60420 IF FPTST(RIGHT^) THEN GARBAGE(RIGHT);
|
||
|
|
60430 CATSS := POINT;
|
||
|
|
60440 END;
|
||
|
|
60450 (**)
|
||
|
|
60460 (**)
|
||
|
|
60470 FUNCTION PLABSS(LEFT, RIGHT: OBJECTP): OBJECTP;
|
||
|
|
60480 (*PPLUSABCH, PPLUSABCH-1*)
|
||
|
|
60490 VAR TEMP: OBJECTP;
|
||
|
|
60500 PILPTR: UNDRESSP;
|
||
|
|
60510 BEGIN
|
||
|
|
60520 WITH LEFT^ DO
|
||
|
|
60530 IF SORT = REFN THEN
|
||
|
|
60540 BEGIN
|
||
|
|
60550 WITH PVALUE^ DO FDEC; (*SO THAT CATSS CAN POSSIBLY RE-USE IT*)
|
||
|
|
60560 PVALUE := CATSS(PVALUE, RIGHT);
|
||
|
|
60570 WITH PVALUE^ DO FINC
|
||
|
|
60580 END
|
||
|
|
60590 ELSE
|
||
|
|
60600 BEGIN
|
||
|
|
60610 PILPTR := SAFEACCESS(LEFT);
|
||
|
|
60620 TEMP := PILPTR^.FIRSTPTR;
|
||
|
|
60630 WITH TEMP^ DO FDEC; (*SO THAT CATSS CAN POSSIBLY RE-USE IT*)
|
||
|
|
60640 PILPTR^.FIRSTPTR := CATSS(TEMP, RIGHT);
|
||
|
|
60650 WITH PILPTR^.FIRSTPTR^ DO FINC
|
||
|
|
60660 END;
|
||
|
|
60670 PLABSS := LEFT;
|
||
|
|
60680 END;
|
||
|
|
60690 (**)
|
||
|
|
60700 (**)
|
||
|
|
60710 FUNCTION PLTOSS(LEFT, RIGHT: OBJECTP): OBJECTP;
|
||
|
|
60720 (*PPLUSTOCS, PPLUSTOCS-1*)
|
||
|
|
60730 VAR TEMP: OBJECTP;
|
||
|
|
60740 PILPTR: UNDRESSP;
|
||
|
|
60750 BEGIN
|
||
|
|
60760 WITH RIGHT^ DO
|
||
|
|
60770 IF SORT = REFN THEN
|
||
|
|
60780 BEGIN
|
||
|
|
60790 WITH PVALUE^ DO FDEC;
|
||
|
|
60800 PVALUE := CATSS(LEFT, PVALUE);
|
||
|
|
60810 WITH PVALUE^ DO FINC
|
||
|
|
60820 END
|
||
|
|
60830 ELSE
|
||
|
|
60840 BEGIN
|
||
|
|
60850 PILPTR := SAFEACCESS(RIGHT);
|
||
|
|
60860 TEMP := PILPTR^.FIRSTPTR;
|
||
|
|
60870 WITH TEMP^ DO FDEC;
|
||
|
|
60880 PILPTR^.FIRSTPTR := CATSS(LEFT, TEMP);
|
||
|
|
60890 WITH PILPTR^.FIRSTPTR^ DO FINC
|
||
|
|
60900 END;
|
||
|
|
60910 PLTOSS := RIGHT;
|
||
|
|
60920 END;
|
||
|
|
60930 (**)
|
||
|
|
60940 (**)
|
||
|
|
60950 (*-02() BEGIN END ; ()-02*)
|
||
|
|
60960 (*+01()
|
||
|
|
60970 BEGIN (*OF MAIN PROGRAM*)
|
||
|
|
60980 END (*OF EVERYTHING*).
|
||
|
|
60990 ()+01*)
|