398 lines
16 KiB
OpenEdge ABL
398 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*)
|