397 lines
		
	
	
	
		
			16 KiB
		
	
	
	
		
			OpenEdge ABL
		
	
	
	
	
	
			
		
		
	
	
			397 lines
		
	
	
	
		
			16 KiB
		
	
	
	
		
			OpenEdge ABL
		
	
	
	
	
	
75200 #include "rundecs.h"
 | 
						|
75210     (*  COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER  *)
 | 
						|
75220  (**)
 | 
						|
75230 PROCEDURE CL68(PB: ASNAKED; RF: OBJECTP); EXTERN ;
 | 
						|
75240 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
 | 
						|
75250 PROCEDURE FORMPDESC(OLDESC: OBJECTP; VAR PDESC1: PDESC); EXTERN ;
 | 
						|
75260 FUNCTION NEXTEL(I: INTEGER; VAR PDESC1: PDESC): BOOLEAN; EXTERN ;
 | 
						|
75270 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
 | 
						|
75280 FUNCTION SAFEACCESS(LOCATION: OBJECTP): UNDRESSP; EXTERN;
 | 
						|
75290 PROCEDURE TESTCC (TARGET: OBJECTP); EXTERN ;
 | 
						|
75300 PROCEDURE TESTSS (REFSTRUCT: OBJECTP); EXTERN ;
 | 
						|
75310 FUNCTION CRSTRING(LENGTH: OFFSETRANGE): OBJECTP; EXTERN ;
 | 
						|
75320 FUNCTION GETPROC(RN: OBJECTP): ASNAKED; EXTERN ;
 | 
						|
75330 PROCEDURE CLPASC1(P1: IPOINT; PROC: ASPROC); EXTERN;
 | 
						|
75340 PROCEDURE CLRDSTR(PCOV: OBJECTP; VAR CHARS: GETBUFTYPE; TERM (*+01() , TERM1 ()+01*) : TERMSET;
 | 
						|
75350                   VAR I: INTEGER; BOOK: FETROOMP; PROC: ASPROC); EXTERN;
 | 
						|
75360 FUNCTION FUNC68(PB: ASNAKED; RF: OBJECTP): BOOLEAN; EXTERN;
 | 
						|
75370 PROCEDURE TESTF(RF:OBJECTP;VAR F:OBJECTP); EXTERN;
 | 
						|
75380 PROCEDURE ENSSTATE(RF:OBJECTP;VAR F:OBJECTP;READING:STATUSSET); EXTERN;
 | 
						|
75390 FUNCTION ENSPAGE(RF:OBJECTP;VAR F:OBJECTP):BOOLEAN; EXTERN;
 | 
						|
75400 FUNCTION ENSLINE(RF:OBJECTP;VAR F:OBJECTP):BOOLEAN; EXTERN;
 | 
						|
75410 (**)
 | 
						|
75420 (**)
 | 
						|
75430 PROCEDURE GETT(RF: OBJECTP);
 | 
						|
75440 (*+02() LABEL 1; ()+02*)
 | 
						|
75450   VAR COUNT, XMODE, XSIZE, SIZE, I, J: INTEGER;
 | 
						|
75460       Q:INTPOINT;
 | 
						|
75470       PVAL,F:OBJECTP;
 | 
						|
75480       P: UNDRESSP;
 | 
						|
75490       TEMP: REALTEGER;
 | 
						|
75500       TEMPLATE:DPOINT;
 | 
						|
75510       WASSTRING:BOOLEAN;
 | 
						|
75520       BUFFER:RECORD CASE SEVERAL OF
 | 
						|
75530       1:     (CHARS: GETBUFTYPE);
 | 
						|
75540       2:     (INTS :ARRAY [1..20] OF INTEGER);
 | 
						|
75550       0, 3, 4, 5, 6, 7, 8, 9, 10: () ;
 | 
						|
75560              END;
 | 
						|
75570       PDESC1: PDESC;
 | 
						|
75580 (**)
 | 
						|
75590 (*+02() PROCEDURE DUMMYG; (*JUST HERE TO MAKE 1 GLOBAL, NOT CALLED*)
 | 
						|
75600         BEGIN GOTO 1 END;     ()+02*)
 | 
						|
75610 (**)
 | 
						|
75620   PROCEDURE SKIPSPACES(RF:OBJECTP;VAR F:OBJECTP);
 | 
						|
75630    (*SKIP INITIAL SPACES,++ENSSPOSN OF NEXT NON SPACE CHAR++*)
 | 
						|
75640     VAR CA:CHAR;
 | 
						|
75650         I: INTEGER;
 | 
						|
75660     BEGIN
 | 
						|
75670     REPEAT
 | 
						|
75680       IF [LINEOVERFLOW]<=F^.PCOVER^.STATUS
 | 
						|
75690       THEN IF NOT ENSLINE(RF,F) THEN ERRORR(NOLOGICAL);
 | 
						|
75700       I := 0;
 | 
						|
75710       WITH F^ DO
 | 
						|
75720         CLRDSTR(PCOVER, BUFFER.CHARS, ALLCHAR-[' '] (*+01() , ALLCHAR1 ()+01*) , I, PCOVER^.BOOK, PCOVER^.DOGETS)
 | 
						|
75730     UNTIL NOT(LINEOVERFLOW IN F^.PCOVER^.STATUS)
 | 
						|
75740     END;   (*SKIPSPACES*)
 | 
						|
75750 (**)
 | 
						|
75760   PROCEDURE VALUEREAD(RF:OBJECTP;VAR F:OBJECTP);
 | 
						|
75770 (*+01() LABEL 111,222,77; ()+01*)
 | 
						|
75780     VAR PTR: UNDRESSP;
 | 
						|
75790         C,CC:CHAR;
 | 
						|
75800         CARRYON, ISEEN: BOOLEAN;
 | 
						|
75810         I,J,K:INTEGER;
 | 
						|
75820         OLD:STATUSSET;
 | 
						|
75830     PROCEDURE READNUM;
 | 
						|
75840     CONST MAXINTDIV10 = (*+11() 28147497671065 ()+11*) (*+12() 3276 ()+12*) (*+13() 214748364 ()+13*) ;
 | 
						|
75850           MAXINTMOD10 = (*+11() 5 ()+11*) (*+12() 7 ()+12*) (*+13() 7 ()+13*) ;
 | 
						|
75860       VAR PM, DIGITS, I, VALDIG: INTEGER;
 | 
						|
75870           NEG: BOOLEAN;
 | 
						|
75880         BEGIN WITH F^, TEMP, BUFFER DO
 | 
						|
75890           BEGIN
 | 
						|
75900           PM := 0;
 | 
						|
75910           CLRDSTR(PCOVER,CHARS,ALLCHAR-['+','-'] (*+01() , ALLCHAR1 ()+01*) ,PM,PCOVER^.BOOK,PCOVER^.DOGETS);
 | 
						|
75920           NEG := (PM=1) AND (CHARS[0]='-');
 | 
						|
75930           I := 0;
 | 
						|
75940           CLRDSTR(PCOVER,CHARS,ALLCHAR-[' '] (*+01() , ALLCHAR1 ()+01*) ,I,PCOVER^.BOOK,PCOVER^.DOGETS);
 | 
						|
75950           DIGITS := 0;
 | 
						|
75960           CLRDSTR(PCOVER,CHARS,ALLCHAR-['0'..'9'] (*+01() , ALLCHAR1 ()+01*) ,DIGITS,PCOVER^.BOOK,PCOVER^.DOGETS);
 | 
						|
75970           IF (PM>1) OR (DIGITS=0) THEN ERRORR(NODIGIT);
 | 
						|
75980           INT := 0;
 | 
						|
75990           FOR I := 0 TO DIGITS-1 DO
 | 
						|
76000             BEGIN
 | 
						|
76010               VALDIG := ORD( CHARS[I] ) - ORD( '0' ) ;
 | 
						|
76020               IF ( INT > MAXINTDIV10 ) OR ( ( INT = MAXINTDIV10 ) AND ( VALDIG > MAXINTMOD10 ) ) THEN
 | 
						|
76030                 ERRORR( WRONGVAL ) ;
 | 
						|
76040               INT := INT * 10 + VALDIG
 | 
						|
76050             END;
 | 
						|
76060           IF NEG THEN INT := - INT
 | 
						|
76070           END
 | 
						|
76080         END;
 | 
						|
76090 (**)
 | 
						|
76100     PROCEDURE READREAL;
 | 
						|
76110 (*+01()
 | 
						|
76120       CONST TML=10000000000000000B;
 | 
						|
76130             LIMIT=14631463146314631B; (*16*TML/10*)
 | 
						|
76140 ()+01*)
 | 
						|
76150       VAR RINT: MINT ;
 | 
						|
76160           PM, BEFORE, AFTER, E, I, RINTEXP: INTEGER;
 | 
						|
76170           NEG: BOOLEAN;
 | 
						|
76180         BEGIN WITH F^, TEMP, BUFFER DO
 | 
						|
76190           BEGIN
 | 
						|
76200           PM := 0;
 | 
						|
76210           CLRDSTR(PCOVER,CHARS,ALLCHAR-['+','-'] (*+01() , ALLCHAR1 ()+01*) ,PM,PCOVER^.BOOK,PCOVER^.DOGETS);
 | 
						|
76220           NEG := (PM=1) AND (CHARS[0]='-');
 | 
						|
76230           I := 0;
 | 
						|
76240           CLRDSTR(PCOVER,CHARS,ALLCHAR-[' '] (*+01() , ALLCHAR1 ()+01*) ,I,PCOVER^.BOOK,PCOVER^.DOGETS);
 | 
						|
76250           BEFORE := 0; AFTER := 0; E := 0;
 | 
						|
76260           CLRDSTR(PCOVER,CHARS,ALLCHAR-['0'..'9'] (*+01() , ALLCHAR1 ()+01*) ,BEFORE,PCOVER^.BOOK,PCOVER^.DOGETS);
 | 
						|
76270           RINT := 0;
 | 
						|
76280           FOR I := 0 TO BEFORE-1 DO
 | 
						|
76290             (*+01() IF RINT<LIMIT THEN ()+01*)
 | 
						|
76300               RINT := RINT*10+(ORD(CHARS[I])-ORD('0'))
 | 
						|
76310             (*+01() ELSE E := E+1 ()+01*) ;
 | 
						|
76320           I := 0;
 | 
						|
76330           CLRDSTR(PCOVER,CHARS,ALLCHAR-['.','E'(*-50(),CHR(ORD('E')+32)()-50*)](*+01(),ALLCHAR1()+01*),
 | 
						|
76340                        I,PCOVER^.BOOK,PCOVER^.DOGETS);
 | 
						|
76350           IF (I>0) AND (CHARS[0]='.') THEN
 | 
						|
76360             BEGIN
 | 
						|
76370             CLRDSTR (
 | 
						|
76380               PCOVER,CHARS,ALLCHAR-['0'..'9'] (*+01() , ALLCHAR1 ()+01*) ,AFTER,PCOVER^.BOOK,PCOVER^.DOGETS
 | 
						|
76390                     ) ;
 | 
						|
76400             FOR I := 0 TO AFTER-1 DO
 | 
						|
76410               (*+01() IF RINT<LIMIT THEN ()+01*)
 | 
						|
76420                 RINT := RINT*10+(ORD(CHARS[I])-ORD('0'))
 | 
						|
76430               (*+01() ELSE E := E+1 ()+01*) ;
 | 
						|
76440             RINTEXP := BEFORE + AFTER - E ;
 | 
						|
76450             I := 0;
 | 
						|
76460             CLRDSTR(PCOVER,CHARS,ALLCHAR-['E'(*-50(),CHR(ORD('E')+32)()-50*)](*+01(),ALLCHAR1()+01*),
 | 
						|
76470                     I,PCOVER^.BOOK,PCOVER^.DOGETS);
 | 
						|
76480             IF (PM>1) OR (AFTER=0) THEN ERRORR(NODIGIT);
 | 
						|
76490             E := E-AFTER;
 | 
						|
76500             END
 | 
						|
76510           ELSE IF (PM>1) OR (BEFORE=0) THEN ERRORR(NODIGIT);
 | 
						|
76520           IF (I>0) AND ((CHARS[0]='E') (*-50()OR (CHARS[0]=CHR(ORD('E')+32))()-50*)) THEN
 | 
						|
76530             BEGIN
 | 
						|
76540             I := 0;
 | 
						|
76550             CLRDSTR(PCOVER,CHARS,ALLCHAR-[' '] (*+01() , ALLCHAR1 ()+01*) ,I,PCOVER^.BOOK,PCOVER^.DOGETS);
 | 
						|
76560             READNUM;
 | 
						|
76570             E := E+INT;
 | 
						|
76580             END;
 | 
						|
76590           IF ( E + RINTEXP <= MINREALEXP ) OR ( RINT = 0 ) THEN REA := 0.0
 | 
						|
76600           ELSE IF E>=323 THEN ERRORR(WRONGVAL)
 | 
						|
76610           ELSE
 | 
						|
76620             BEGIN
 | 
						|
76630    (*-02()  REA := TIMESTEN(RINT, E); ()-02*)
 | 
						|
76640    (*+02()  REA := TIMESTE(RINT, E); ()+02*)
 | 
						|
76650             IF INT=INTUNDEF THEN ERRORR(WRONGVAL);
 | 
						|
76660             END;
 | 
						|
76670           IF NEG THEN REA := -REA;
 | 
						|
76680           END
 | 
						|
76690         END;
 | 
						|
76700 (**)
 | 
						|
76710     BEGIN WITH TEMP DO
 | 
						|
76720       BEGIN
 | 
						|
76730       IF NOT([OPENED,READMOOD,CHARMOOD]<=F^.PCOVER^.STATUS) THEN
 | 
						|
76740         ENSSTATE(RF, F, [OPENED,READMOOD,CHARMOOD]);
 | 
						|
76750       XSIZE := SZINT;
 | 
						|
76760       CASE XMODE OF
 | 
						|
76770    -1:    (*FILLER*) XSIZE := 0;
 | 
						|
76780 (*+61() 1,3,5: (*LONG MODES*)
 | 
						|
76790           BEGIN XSIZE := SZLONG; DUMMY END; ()+61*)
 | 
						|
76800     0:    (*INT*)
 | 
						|
76810           BEGIN SKIPSPACES(RF,F); READNUM; P^.FIRSTINT := INT END;
 | 
						|
76820     2:    (*REAL*)
 | 
						|
76830           BEGIN XSIZE := SZREAL; SKIPSPACES(RF,F); READREAL; P^.FIRSTREAL := REA END;
 | 
						|
76840     4:    (*COMPL*)
 | 
						|
76850           BEGIN
 | 
						|
76860           XSIZE := SZADDR;
 | 
						|
76870           SKIPSPACES(RF,F);
 | 
						|
76880           READREAL;
 | 
						|
76890           P^.FIRSTREAL := REA;
 | 
						|
76900           I := 0;
 | 
						|
76910           WITH F^ DO
 | 
						|
76920             CLRDSTR (
 | 
						|
76930               PCOVER,BUFFER.CHARS,ALLCHAR-[' ','I'] (*+01() , ALLCHAR1 ()+01*) ,I,PCOVER^.BOOK,PCOVER^.DOGETS
 | 
						|
76940                     ) ;
 | 
						|
76950           ISEEN := FALSE;
 | 
						|
76960           FOR K := 0 TO I-1 DO
 | 
						|
76970             ISEEN := ISEEN OR (BUFFER.CHARS[K]='I');
 | 
						|
76980           IF NOT ISEEN THEN ERRORR(WRONGCHAR);
 | 
						|
76990           READREAL;
 | 
						|
77000           P := INCPTR(P, SZREAL);
 | 
						|
77010           P^.FIRSTREAL := REA;
 | 
						|
77020           END;
 | 
						|
77030     6:    (*CHAR*)
 | 
						|
77040           BEGIN IF [LINEOVERFLOW]<=F^.PCOVER^.STATUS
 | 
						|
77050             THEN IF NOT ENSLINE(RF,F) THEN ERRORR(NOLOGICAL);
 | 
						|
77060             I := -1;
 | 
						|
77070             WITH F^ DO
 | 
						|
77080               CLRDSTR(PCOVER, BUFFER.CHARS, ALLCHAR (*+01() , ALLCHAR ()+01*) , I, PCOVER^.BOOK, PCOVER^.DOGETS);
 | 
						|
77090             P^.FIRSTWORD := I
 | 
						|
77100           END;
 | 
						|
77110     7:    (*STRING*)
 | 
						|
77120           WITH BUFFER DO
 | 
						|
77130             BEGIN
 | 
						|
77140             XSIZE := SZADDR;
 | 
						|
77150             I:=0;
 | 
						|
77160             REPEAT
 | 
						|
77170               IF [PAGEOVERFLOW]<=F^.PCOVER^.STATUS
 | 
						|
77180               THEN CARRYON:=ENSPAGE(RF,F)
 | 
						|
77190               ELSE CARRYON:=TRUE;
 | 
						|
77200               IF CARRYON THEN
 | 
						|
77210                 IF [LINEOVERFLOW]<=F^.PCOVER^.STATUS
 | 
						|
77220                 THEN BEGIN OLD:=F^.PCOVER^.STATUS;
 | 
						|
77230                   IF F^.LINEMENDED=UNDEFIN THEN CARRYON := FALSE
 | 
						|
77240                   ELSE CARRYON:=FUNC68(GETPROC(F^.LINEMENDED),RF);
 | 
						|
77250                   ENSSTATE(RF,F,OLD)
 | 
						|
77260                   END
 | 
						|
77270                 ELSE
 | 
						|
77280                   WITH F^ DO
 | 
						|
77290                     BEGIN
 | 
						|
77300                     CLRDSTR(PCOVER, CHARS, TERM (*+01() , TERM1 ()+01*) , I, PCOVER^.BOOK, PCOVER^.DOGETS);
 | 
						|
77310                     CARRYON := LINEOVERFLOW IN PCOVER^.STATUS
 | 
						|
77320                     END
 | 
						|
77330             UNTIL NOT CARRYON;
 | 
						|
77340             WITH P^ DO
 | 
						|
77350               BEGIN FPDEC(FIRSTPTR^);
 | 
						|
77360               IF FPTST(FIRSTPTR^) THEN GARBAGE(FIRSTPTR);
 | 
						|
77370               FIRSTPTR:=CRSTRING(I);
 | 
						|
77380               FPINC(FIRSTPTR^);
 | 
						|
77390               PTR := INCPTR(FIRSTPTR, STRINGCONST);
 | 
						|
77400               END;
 | 
						|
77410             WHILE I <> (I DIV CHARPERWORD) * CHARPERWORD DO
 | 
						|
77420               BEGIN CHARS[I]:=CHR(0);
 | 
						|
77430               I:=I+1
 | 
						|
77440               END;
 | 
						|
77450             J:=I DIV CHARPERWORD ;
 | 
						|
77460             FOR I:=1 TO J DO
 | 
						|
77470               BEGIN PTR^.FIRSTWORD := INTS[I]; PTR := INCPTR(PTR, SZWORD) END;
 | 
						|
77480             END;    (*STRING*)
 | 
						|
77490     8:    (*BOOL*)
 | 
						|
77500           BEGIN IF [LINEOVERFLOW]<=F^.PCOVER^.STATUS
 | 
						|
77510             THEN IF NOT ENSLINE(RF,F) THEN ERRORR(NOLOGICAL);
 | 
						|
77520           I := -1;
 | 
						|
77530           WITH F^ DO
 | 
						|
77540             CLRDSTR(PCOVER, BUFFER.CHARS, ALLCHAR (*+01() , ALLCHAR ()+01*) , I, PCOVER^.BOOK, PCOVER^.DOGETS);
 | 
						|
77550           IF CHR(I)='T' THEN INT := TRUEVAL
 | 
						|
77560           ELSE IF CHR(I)='F' THEN INT := 0
 | 
						|
77570           ELSE ERRORR(WRONGCHAR) ;
 | 
						|
77580           P^.FIRSTWORD := INT
 | 
						|
77590           END;      (*BOOL*)
 | 
						|
77600     9:    (*BITS*)
 | 
						|
77610           BEGIN K:=0;
 | 
						|
77620           FOR J:=1 TO BITSWIDTH DO
 | 
						|
77630             BEGIN SKIPSPACES(RF,F);
 | 
						|
77640             I := -1;
 | 
						|
77650             WITH F^ DO
 | 
						|
77660               CLRDSTR(PCOVER, BUFFER.CHARS, ALLCHAR (*+01() , ALLCHAR ()+01*) , I, PCOVER^.BOOK, PCOVER^.DOGETS);
 | 
						|
77670             IF CHR(I) IN ['T','F'] THEN K := K*2+ORD(CHR(I)='T')
 | 
						|
77680             ELSE ERRORR(WRONGCHAR)
 | 
						|
77690             END;
 | 
						|
77700           P^.FIRSTWORD := K
 | 
						|
77710           END;
 | 
						|
77720    10:    (*BYTES*)
 | 
						|
77730           FOR J:=1 TO BYTESWIDTH DO
 | 
						|
77740             BEGIN
 | 
						|
77750             IF LINEOVERFLOW IN F^.PCOVER^.STATUS THEN
 | 
						|
77760               IF NOT ENSLINE(RF, F) THEN ERRORR(NOLOGICAL);
 | 
						|
77770             I := -1;
 | 
						|
77780             WITH F^ DO
 | 
						|
77790               CLRDSTR(PCOVER, BUFFER.CHARS, ALLCHAR (*+01() , ALLCHAR ()+01*) , I, PCOVER^.BOOK, PCOVER^.DOGETS);
 | 
						|
77800             ALF[J] := CHR(I);
 | 
						|
77810             P^.FIRSTWORD := INT
 | 
						|
77820             END;
 | 
						|
77830    11:    (*PROC*)
 | 
						|
77840           CL68(GETPROC(PVAL), RF);
 | 
						|
77850    12:    (*STRUCT*)
 | 
						|
77860           BEGIN J:=0;
 | 
						|
77870           REPEAT J:=J+1 UNTIL TEMPLATE^[J]<0;
 | 
						|
77880           I:=ORD(P);
 | 
						|
77890           WHILE ORD(P)-I<TEMPLATE^[0] DO
 | 
						|
77900             BEGIN J:=J+1;
 | 
						|
77910             XMODE:=TEMPLATE^[J]-1;
 | 
						|
77920             VALUEREAD(RF,F);
 | 
						|
77930             P:=INCPTR(P, XSIZE)
 | 
						|
77940             END;
 | 
						|
77950           XMODE:=12;
 | 
						|
77960           END;      (*STRUCT*)
 | 
						|
77970    14:    (*CODE(REF FILE)VOID*)
 | 
						|
77980           CLPASC1( ORD(RF), PROCC );
 | 
						|
77990         END;   (*CASE*)
 | 
						|
78000       END    (*WITH*)
 | 
						|
78010     END;     (*VALUEREAD*)
 | 
						|
78020 (**)
 | 
						|
78030     BEGIN   (*GET*)
 | 
						|
78040 (*+02() 1: ()+02*) COUNT := GETSTKTOP(SZWORD, 0);
 | 
						|
78050     FPINC(RF^);
 | 
						|
78060     J := COUNT+SZWORD; WHILE J>SZWORD DO
 | 
						|
78070       BEGIN
 | 
						|
78080       J := J-SZWORD;
 | 
						|
78090       XMODE := GETSTKTOP(SZWORD, J);
 | 
						|
78100       IF XMODE IN [0..13,15..31] THEN
 | 
						|
78110         BEGIN
 | 
						|
78120         J := J - SZADDR;
 | 
						|
78130         PVAL := ASPTR(GETSTKTOP(SZADDR, J));
 | 
						|
78140         FPINC(PVAL^);
 | 
						|
78150         END
 | 
						|
78160       ELSE IF XMODE=14 THEN J := J-SZPROC
 | 
						|
78170       END;
 | 
						|
78180     TESTF(RF,F);
 | 
						|
78190     J := COUNT+SZWORD; WHILE J>SZWORD DO
 | 
						|
78200       BEGIN
 | 
						|
78210       J := J-SZWORD;
 | 
						|
78220       XMODE:=GETSTKTOP(SZWORD, J);
 | 
						|
78230       IF XMODE>=16 THEN   (*ROW*)
 | 
						|
78240         BEGIN XMODE:=XMODE-16;
 | 
						|
78250         J := J-SZADDR;
 | 
						|
78260         PVAL:=ASPTR(GETSTKTOP(SZADDR, J));
 | 
						|
78270         WITH PVAL^ DO
 | 
						|
78280           BEGIN
 | 
						|
78290            IF FPTWO(ANCESTOR^.PVALUE^) THEN
 | 
						|
78300             TESTCC(PVAL);
 | 
						|
78310           FORMPDESC(PVAL,PDESC1);
 | 
						|
78320           TEMPLATE:=MDBLOCK;
 | 
						|
78330           WITH ANCESTOR^ DO
 | 
						|
78340             BEGIN
 | 
						|
78350             IF ORD(TEMPLATE)=0 THEN SIZE:=1
 | 
						|
78360             ELSE IF ORD(TEMPLATE)<=MAXSIZE THEN SIZE:=ORD(TEMPLATE)
 | 
						|
78370             ELSE SIZE:=TEMPLATE^[0];
 | 
						|
78380             WHILE NEXTEL(0,PDESC1) DO WITH PDESC1 DO WITH PDESCVEC[0] DO
 | 
						|
78390               BEGIN I:=PP;
 | 
						|
78400               WHILE I<PP+PSIZE DO
 | 
						|
78410                 BEGIN
 | 
						|
78420                 P:=INCPTR(PVALUE, I);
 | 
						|
78430                 VALUEREAD(RF,F); I:=I+SIZE
 | 
						|
78440                 END
 | 
						|
78450               END
 | 
						|
78460             END
 | 
						|
78470           END
 | 
						|
78480         END
 | 
						|
78490       ELSE IF XMODE>=0 THEN
 | 
						|
78500         BEGIN WASSTRING:=FALSE;
 | 
						|
78510         IF XMODE = 14 THEN
 | 
						|
78520           BEGIN
 | 
						|
78530           J := J - SZPROC ;
 | 
						|
78540           TEMP.PROCC := GETSTKTOP( SZPROC , J )
 | 
						|
78550           END
 | 
						|
78560         ELSE
 | 
						|
78570           BEGIN
 | 
						|
78580           J := J - SZADDR ;
 | 
						|
78590           PVAL:=ASPTR(GETSTKTOP(SZADDR, J));
 | 
						|
78600           IF XMODE <> 11 THEN WITH PVAL^ DO
 | 
						|
78610             IF SORT IN [RECN, REFN] THEN
 | 
						|
78620               IF XMODE<>7 THEN  (*NOT STRING*)
 | 
						|
78630                 BEGIN
 | 
						|
78640                 TEMPLATE:=PVALUE^.DBLOCK;
 | 
						|
78650                 IF FPTWO(PVALUE^) THEN
 | 
						|
78660                       TESTSS(PVAL);
 | 
						|
78670                 P := INCPTR(PVALUE, STRUCTCONST)
 | 
						|
78680                 END
 | 
						|
78690               ELSE
 | 
						|
78700                 BEGIN ENEW(P,1); P^.FIRSTPTR:=PVALUE;WASSTRING:=TRUE END
 | 
						|
78710             ELSE
 | 
						|
78720               BEGIN
 | 
						|
78730               TEMPLATE := DBLOCK;
 | 
						|
78740               WITH ANCESTOR^ DO
 | 
						|
78750                 IF FPTWO(PVALUE^) THEN
 | 
						|
78760                   P := SAFEACCESS(PVAL)
 | 
						|
78770                 ELSE
 | 
						|
78780                   BEGIN
 | 
						|
78790                   PVALUE^.OSCOPE := 0;
 | 
						|
78800                   P := INCPTR(PVALUE,PVAL^.OFFSET)
 | 
						|
78810                   END
 | 
						|
78820               END
 | 
						|
78830           END;
 | 
						|
78840         VALUEREAD(RF,F);
 | 
						|
78850         IF WASSTRING THEN
 | 
						|
78860           BEGIN PVAL^.PVALUE := P^.FIRSTPTR; EDISPOSE(P, 1) END;
 | 
						|
78870         END;
 | 
						|
78880       END;
 | 
						|
78890     J := COUNT+SZWORD; WHILE J>SZWORD DO
 | 
						|
78900       BEGIN
 | 
						|
78910       J := J-SZWORD;
 | 
						|
78920       XMODE := GETSTKTOP(SZWORD, J);
 | 
						|
78930       IF XMODE IN [0..13,15..31] THEN
 | 
						|
78940         BEGIN
 | 
						|
78950         J := J - SZADDR;
 | 
						|
78960         PVAL := ASPTR(GETSTKTOP(SZADDR, J)); WITH PVAL^ DO
 | 
						|
78970           BEGIN FDEC; IF FTST THEN GARBAGE(PVAL) END;
 | 
						|
78980         END
 | 
						|
78990       ELSE IF XMODE = 14 THEN J := J - SZPROC
 | 
						|
79000       END;
 | 
						|
79010     WITH RF^ DO
 | 
						|
79020       BEGIN FDEC; IF FTST THEN GARBAGE(RF) END;
 | 
						|
79030     END;     (*GET*)
 | 
						|
79040 (**)
 | 
						|
79050 (**)
 | 
						|
79060 (*+01() (*$X4*) ()+01*)
 | 
						|
79070 (**)
 | 
						|
79080 (**)
 | 
						|
79090 (*-02()
 | 
						|
79100 BEGIN (*OF A68*)
 | 
						|
79110 END; (*OF A68*)
 | 
						|
79120 ()-02*)
 | 
						|
79130 (*+01()
 | 
						|
79140 BEGIN (*OF MAIN PROGRAM*)
 | 
						|
79150 END (* OF EVERYTHING *).
 | 
						|
79160 ()+01*)
 |