55100 #include "rundecs.h"
55110     (*  COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER  *)
55120 (**)
55130 (**)
55140 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
55150 PROCEDURE SLCMN(STOWEDVAL: OBJECTP; INDEX, SLICDEX: INTEGER); EXTERN;
55160 (**)
55170 (**)
55180 FUNCTION GETSLN(NEWREFSLN:OBJECTP): OBJECTP;
55190   VAR OLDREF:OBJECTP;
55200     BEGIN
55210     WITH NEWREFSLN^ DO
55220       BEGIN
55230       OLDREF := PVALUE;
55240       ANCESTOR := OLDREF^.ANCESTOR;
55250       WITH ANCESTOR^ DO FINC;
55260       OSCOPE := OLDREF^.OSCOPE;
55270       CCOUNT := 1;
55280       END;
55290     IF FPTST(OLDREF^) THEN GARBAGE(OLDREF);
55300     GETSLN := NEWREFSLN;
55310     END;
55320 (**)
55330 (**)
55340 (*THE FOLLOWING PROCEDURES ARE USUALLY WRITTEN IN ASSEMBLER*)
55350 (**)
55360 (*-01()
55370 PROCEDURE STARTSL(NOROWS, DEPTH: INTEGER);
55380 (*PSTARTSLICE*)
55390      (* SOURDESC, SLICDESC, SOURDEX, SLICDEX, ADJACC *)
55400     BEGIN
55410     SOURDEX:= 0;
55420     SLICDEX:= 0;
55430     SOURDESC := ASPTR(GETSTKTOP(SZADDR, DEPTH));
55440     ENEW(SLICDESC, REFSLNCONST+NOROWS*SZPDS);
55450     ADJACC := SOURDESC^.LBADJ;
55460     WITH SLICDESC^ DO
55470       BEGIN
55480 (*-02() FIRSTWORD := SORTSHIFT * ORD(REFSLN); ()-02*)
55490 (*+02() PCOUNT:=0; SORT:=REFSLN; ()+02*)
55500       ROWS := NOROWS-1;
55510       MDBLOCK := SOURDESC^.MDBLOCK;
55520       SIZE := SOURDESC^.SIZE
55530       END;
55540     END;
55550 (**)
55560 (**)
55570 PROCEDURE TRIMS (* SOURDESC, SLICDESC, SOURDEX, SLICDEX, ADJACC,
55580                    REVISEDLB, SLICEPDS *);
55590      (* ALL PARAMETERS ARE GLOBAL SINCE THERE ARE TOO MANY TO BE PASSED IN *)
55600      (* THE X REGISTERS AND THE PROCEDURES ARE NON RECURSIVE               *)
55610     BEGIN
55620     WITH SLICEPDS DO
55630       BEGIN
55640       ADJACC := ADJACC+(REVISEDLB-LI)*DI;
55650       UI:= UI+REVISEDLB-LI;
55660       LI := REVISEDLB;
55670       SLICDESC^.DESCVEC[SLICDEX] := SLICEPDS;
55680       END;
55690     SOURDEX:= SOURDEX+1;
55700     SLICDEX:= SLICDEX+1;
55710     END;
55720 (* *)
55730 PROCEDURE SLICEA(DEPTH: INTEGER) (* SOURDESC, SOURDEX, SLICEPDS*);
55740 (*PTRIM - [ ]*)
55750     BEGIN
55760     SLICEPDS := SOURDESC^.DESCVEC[SOURDEX];
55770     SLICDESC^.DESCVEC[SLICDEX] := SLICEPDS;
55780     SOURDEX := SOURDEX+1;
55790     SLICDEX := SLICDEX+1;
55800     END;
55810 (* *)
55820 PROCEDURE SLICEB(DEPTH: INTEGER) (*SOURDESC, SLICDESC, SOURDEX, SLICDEX, STACKPOS *);
55830 (*PTRIM+1 - [@N]*)
55840     BEGIN
55850     SLICEPDS := SOURDESC^.DESCVEC[SOURDEX];
55860     REVISEDLB := GETSTKTOP(SZINT, DEPTH);
55870     TRIMS;
55880     END;
55890 (* *)
55900 PROCEDURE SLICEC(DEPTH: INTEGER) (* ARGUEMENTS AS ABOVE *);
55910 (*PTRIM+2 - [ :U]*)
55920     BEGIN
55930     SLICEPDS := SOURDESC^.DESCVEC[SOURDEX];
55940     REVISEDLB := 1;
55950     IF GETSTKTOP(SZINT, DEPTH)>SLICEPDS.UI THEN SLCMN(SOURDESC, GETSTKTOP(SZINT, DEPTH), SOURDEX);
55960     SLICEPDS.UI := GETSTKTOP(SZINT, DEPTH);
55970     TRIMS;
55980     END;
55990 (* *)
56000 PROCEDURE SLICED(DEPTH: INTEGER) (* AS ABOVE *);
56010 (*PTRIM+3 - [:U@N]*)
56020     BEGIN
56030     SLICEPDS := SOURDESC^.DESCVEC[SOURDEX];
56040     REVISEDLB := GETSTKTOP(SZINT, DEPTH);
56050     IF GETSTKTOP(SZINT, DEPTH+SZINT)>SLICEPDS.UI THEN SLCMN(SOURDESC, GETSTKTOP(SZINT, SZINT), SOURDEX);
56060     SLICEPDS.UI := GETSTKTOP(SZINT, DEPTH+SZINT);
56070     TRIMS;
56080     END;
56090 (* *)
56100 PROCEDURE SLICEE(DEPTH: INTEGER) (* AS ABOVE *);
56110 (*PTRIM+4 - [L: ]*)
56120     BEGIN
56130     SLICEPDS := SOURDESC^.DESCVEC[SOURDEX];
56140     REVISEDLB:= 1;
56150     IF GETSTKTOP(SZINT, DEPTH)<SLICEPDS.LI THEN SLCMN(SOURDESC, GETSTKTOP(SZINT, DEPTH), SOURDEX);
56160     SLICEPDS.LI := GETSTKTOP(SZINT, DEPTH);
56170     TRIMS;
56180     END;
56190 (* *)
56200 PROCEDURE SLICEF(DEPTH: INTEGER) (* AS ABOVE *);
56210 (*PTRIM+5 - [L: @N]*)
56220     BEGIN
56230     SLICEPDS := SOURDESC^.DESCVEC[SOURDEX];
56240     REVISEDLB := GETSTKTOP(SZINT, DEPTH);
56250     IF GETSTKTOP(SZINT, DEPTH+SZINT)<SLICEPDS.LI THEN SLCMN(SOURDESC, GETSTKTOP(SZINT, DEPTH+SZINT), SOURDEX);
56260     SLICEPDS.LI := GETSTKTOP(SZINT, DEPTH+SZINT);
56270     TRIMS;
56280     END;
56290 (* *)
56300 PROCEDURE SLICEG(DEPTH: INTEGER) (* AS ABOVE *);
56310 (*PTRIM+6 - [L:U]*)
56320     BEGIN
56330     SLICEPDS := SOURDESC^.DESCVEC[SOURDEX];
56340     REVISEDLB:= 1;
56350     IF GETSTKTOP(SZINT, DEPTH)>SLICEPDS.UI THEN SLCMN(SOURDESC, GETSTKTOP(SZINT, DEPTH), SOURDEX);
56360     SLICEPDS.UI := GETSTKTOP(SZINT, DEPTH);
56370     IF GETSTKTOP(SZINT, DEPTH+SZINT)<SLICEPDS.LI THEN SLCMN(SOURDESC, GETSTKTOP(SZINT, DEPTH+SZINT), SOURDEX);
56380     SLICEPDS.LI := GETSTKTOP(SZINT, DEPTH+SZINT);
56390     TRIMS;
56400     END;
56410 (* *)
56420 PROCEDURE SLICEH(DEPTH: INTEGER) (* AS ABOVE *);
56430 (*PTRIM+7 - [L:U@N]*)
56440     BEGIN
56450     SLICEPDS := SOURDESC^.DESCVEC[SOURDEX];
56460     REVISEDLB := GETSTKTOP(SZINT, DEPTH);
56470     IF GETSTKTOP(SZINT, DEPTH+SZINT)>SLICEPDS.UI THEN SLCMN(SOURDESC, GETSTKTOP(SZINT, DEPTH+SZINT), SOURDEX);
56480     SLICEPDS.UI := GETSTKTOP(SZINT, DEPTH+SZINT);
56490     IF GETSTKTOP(SZINT, DEPTH+2*SZINT)<SLICEPDS.LI THEN
56500       SLCMN(SOURDESC, GETSTKTOP(SZINT, DEPTH+2*SZINT), SOURDEX);
56510     SLICEPDS.LI := GETSTKTOP(SZINT, DEPTH+2*SZINT);
56520     TRIMS;
56530     END;
56540 (* *)
56550 PROCEDURE SLICEI(DEPTH: INTEGER) (* AS ABOVE *);
56560 (*PTRIM+8 - [:]*)
56570     BEGIN
56580     SLICEPDS := SOURDESC^.DESCVEC[SOURDEX];
56590     REVISEDLB:= 1;
56600     TRIMS;
56610     END;
56620 (* *)
56630 PROCEDURE SLICEJ(DEPTH: INTEGER) (* NOW INCLUDING ADJACC *);
56640 (*PTRIM+9 - [K]*)
56650     BEGIN
56660     WITH SOURDESC^.DESCVEC[SOURDEX] DO
56670       BEGIN
56680       IF (GETSTKTOP(SZINT, DEPTH)<LI) OR (GETSTKTOP(SZINT, DEPTH)>UI) THEN
56690         SLCMN (SOURDESC , GETSTKTOP (SZINT , DEPTH) , SOURDEX ) ;
56700       ADJACC := ADJACC-GETSTKTOP(SZINT, DEPTH)*DI;
56710       END;
56720     SOURDEX:= SOURDEX+1;
56730     END;
56740 (**)
56750 (**)
56760 FUNCTION ENDSL(PRIMARY: OBJECTP) (* SLICDESC, ADJACC +) : OBJECTP;
56770 (*PENDSLICE*)
56780     BEGIN
56790     SLICDESC^.LBADJ := ADJACC;
56800     SLICDESC^.PVALUE := PRIMARY;
56810     ENDSL := SLICDESC
56820     END;
56830 ()-01*)
56840 (**)
56850 (**)
56860 (*-02() BEGIN END ; ()-02*)
56870 (*+01()
56880 BEGIN (*OF MAIN PROGRAM*)
56890 END (*OF EVERYTHING*).
56900 ()+01*)