104 lines
		
	
	
	
		
			3 KiB
		
	
	
	
		
			OpenEdge ABL
		
	
	
	
	
	
			
		
		
	
	
			104 lines
		
	
	
	
		
			3 KiB
		
	
	
	
		
			OpenEdge ABL
		
	
	
	
	
	
79900 #include "rundecs.h"
 | 
						|
79910     (*  COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER  *)
 | 
						|
79920  (**)
 | 
						|
79930 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
 | 
						|
79940 PROCEDURE NASSTCMN(ANOBJECT:OBJECTP); EXTERN;
 | 
						|
79950 FUNCTION SCPNTPT(TEMP: NAKEGER; SOURCE: OBJECTP): ASNAKED; EXTERN ;
 | 
						|
79960 (**)
 | 
						|
79970 (**)
 | 
						|
79980 PROCEDURE ONLINEEND(RF, ROUTINE: OBJECTP);
 | 
						|
79990   VAR TEMP: NAKEGER;
 | 
						|
80000     BEGIN
 | 
						|
80010     WITH TEMP, NAK DO
 | 
						|
80020       BEGIN
 | 
						|
80030 (*+11() ASNAK := 0; ()+11*)
 | 
						|
80040       STOWEDVAL := RF;
 | 
						|
80050       POSITION := RF^.OFFSET+LMOFFSET;
 | 
						|
80060       ASNAK := SCPNTPT(TEMP, ROUTINE);
 | 
						|
80070       END;
 | 
						|
80080     IF FPTST(RF^) THEN GARBAGE(RF)
 | 
						|
80090     END;
 | 
						|
80100 (**)
 | 
						|
80110 (**)
 | 
						|
80120 PROCEDURE ONPAGEEND(RF, ROUTINE: OBJECTP);
 | 
						|
80130   VAR TEMP: NAKEGER;
 | 
						|
80140     BEGIN
 | 
						|
80150     WITH TEMP, NAK DO
 | 
						|
80160       BEGIN
 | 
						|
80170 (*+11() ASNAK := 0; ()+11*)
 | 
						|
80180       STOWEDVAL := RF;
 | 
						|
80190       POSITION := RF^.OFFSET+PMOFFSET;
 | 
						|
80200       ASNAK := SCPNTPT(TEMP, ROUTINE);
 | 
						|
80210       END;
 | 
						|
80220     IF FPTST(RF^) THEN GARBAGE(RF)
 | 
						|
80230     END;
 | 
						|
80240 (**)
 | 
						|
80250 (**)
 | 
						|
80260 PROCEDURE ONPHYSICALFILEEND(RF, ROUTINE: OBJECTP);
 | 
						|
80270   VAR TEMP: NAKEGER;
 | 
						|
80280     BEGIN
 | 
						|
80290     WITH TEMP, NAK DO
 | 
						|
80300       BEGIN
 | 
						|
80310 (*+11() ASNAK := 0; ()+11*)
 | 
						|
80320       STOWEDVAL := RF;
 | 
						|
80330       POSITION := RF^.OFFSET+PFMOFFSET;
 | 
						|
80340       ASNAK := SCPNTPT(TEMP, ROUTINE);
 | 
						|
80350       END;
 | 
						|
80360     IF FPTST(RF^) THEN GARBAGE(RF)
 | 
						|
80370     END;
 | 
						|
80380 (**)
 | 
						|
80390 (**)
 | 
						|
80400 PROCEDURE ONLOGICALFILEEND(RF, ROUTINE: OBJECTP);
 | 
						|
80410   VAR TEMP: NAKEGER;
 | 
						|
80420     BEGIN
 | 
						|
80430     WITH TEMP, NAK DO
 | 
						|
80440       BEGIN
 | 
						|
80450 (*+11() ASNAK := 0; ()+11*)
 | 
						|
80460       STOWEDVAL := RF;
 | 
						|
80470       POSITION := RF^.OFFSET+LFMOFFSET;
 | 
						|
80480       ASNAK := SCPNTPT(TEMP, ROUTINE);
 | 
						|
80490       END;
 | 
						|
80500     IF FPTST(RF^) THEN GARBAGE(RF)
 | 
						|
80510     END;
 | 
						|
80520 (**)
 | 
						|
80530 (**)
 | 
						|
80540 PROCEDURE MAKETERM(RF, S: OBJECTP);
 | 
						|
80550   VAR T1 (*+01(), T2 ()+01*): TERMSET;
 | 
						|
80560       CH: CHAR;
 | 
						|
80570       I: INTEGER;
 | 
						|
80580       TEMP: NAKEGER;
 | 
						|
80590       P: UNDRESSP;
 | 
						|
80600     BEGIN T1 := []; (*+01() T2 := []; ()+01*)
 | 
						|
80610     WITH S^ DO
 | 
						|
80620       FOR I := 1 TO STRLENGTH DO
 | 
						|
80630         BEGIN CH := CHARVEC[I];
 | 
						|
80640 (*+01() IF ORD(CH) < 59 THEN T1 := T1 + [CH] ELSE T2 := T2 + [ CHR( ORD(CH)-59 ) ] ()+01*)
 | 
						|
80650 (*-01() T1 := T1 + [CH] ()-01*)
 | 
						|
80660         END;
 | 
						|
80670 (*+11() TEMP.ASNAK := 0; ()+11*)
 | 
						|
80680     TEMP.NAK.STOWEDVAL := RF;
 | 
						|
80690     WITH TEMP, NAK, STOWEDVAL^.ANCESTOR^ DO
 | 
						|
80700       BEGIN
 | 
						|
80710       POSITION := RF^.OFFSET+TERMOFFSET;
 | 
						|
80720         IF FPTWO(PVALUE^) THEN
 | 
						|
80730             NASSTCMN(STOWEDVAL);
 | 
						|
80740       PVALUE^.OSCOPE := 0;
 | 
						|
80750       P := INCPTR(PVALUE, POSITION)
 | 
						|
80760       END;
 | 
						|
80770     P^.FIRSTTERMSET := T1 ;
 | 
						|
80780 (*+01()
 | 
						|
80790     P := INCPTR(P, SZWORD);
 | 
						|
80800     P^.FIRSTTERMSET := T2;
 | 
						|
80810 ()+01*)
 | 
						|
80820     IF FPTST(RF^) THEN GARBAGE(RF)
 | 
						|
80830     END;
 | 
						|
80840 (**)
 | 
						|
80850 (**)
 | 
						|
80860 (*-02()
 | 
						|
80870 BEGIN (*OF A68*)
 | 
						|
80880 END; (*OF A68*)
 | 
						|
80890 ()-02*)
 | 
						|
80900 (*+01()
 | 
						|
80910 BEGIN (*OF MAIN PROGRAM*)
 | 
						|
80920 END (* OF EVERYTHING *).
 | 
						|
80930 ()+01*)
 |