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*)