181 lines
		
	
	
	
		
			6.3 KiB
		
	
	
	
		
			OpenEdge ABL
		
	
	
	
	
	
			
		
		
	
	
			181 lines
		
	
	
	
		
			6.3 KiB
		
	
	
	
		
			OpenEdge ABL
		
	
	
	
	
	
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*)
 |