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*)