83300 #include "rundecs.h"
83310 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
83320 (**)
83330 PROCEDURE CL68(PB: ASNAKED; RF: OBJECTP); EXTERN ;
83340 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
83350 PROCEDURE FORMPDESC(OLDESC: OBJECTP; VAR PDESC1: PDESC); EXTERN ;
83360 FUNCTION NEXTEL(I: INTEGER; VAR PDESC1: PDESC): BOOLEAN; EXTERN ;
83370 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
83380 FUNCTION CRSTRING(LENGTH: OFFSETRANGE): OBJECTP; EXTERN ;
83390 FUNCTION GETPROC(RN: OBJECTP): ASNAKED; EXTERN ;
83400 PROCEDURE TESTF(RF:OBJECTP;VAR F:OBJECTP); EXTERN;
83410 FUNCTION ENSLINE(RF:OBJECTP;VAR F:OBJECTP):BOOLEAN; EXTERN;
83420 PROCEDURE ENSSTATE(RF:OBJECTP;VAR F:OBJECTP;READING:STATUSSET); EXTERN;
83430 FUNCTION ENSPAGE(RF:OBJECTP;VAR F:OBJECTP):BOOLEAN; EXTERN;
83440 (**)
83450 PROCEDURE CLPASC1(P1: IPOINT; PROC: ASPROC); EXTERN;
83460 PROCEDURE CLPASC5(P1,P2 :IPOINT; P3,P4 :INTEGER; P5 :IPOINT; PROC: ASPROC); EXTERN;
83470 FUNCTION NXTBIT(VAR N: INTEGER): INTEGER; EXTERN;
83480 (**)
83490 (**)
83500 (*+01() (*$X6*) ()+01*) (*ONLY USED WITH PROC*)
83510 (*+01() FUNCTION TIMESTEN(T, E: INTEGER): REAL ; EXTERN ; ()+01*)
83520 (*+05() FUNCTION TIMESTEN( T: REAL; E: INTEGER ): REAL ; EXTERN ; ()+05*)
83530 (*+01() (*$X4*) ()+01*)
83540 (**)
83550 (**)
83560 FUNCTION SUBFIXED(SIGN, (*0 OR 1 OR -1 FOR SPACE TO BE PROVIDED FOR SIGN*)
83570 BEFORE, (*DIGITS (POSSIBLY SUPPRESSED) REQUIRED BEFORE DECIMAL POINT;
83580 -VE MEANS AS MANY AS NECESSARY*)
83590 POINT, (*0 OR 1 FOR SPACE TO BE PROVIDED FOR DECIMAL POINT*)
83600 AFTER (*DIGITS AFTER DECIMAL POINT*)
83610 : INTEGER;
83620 VAR EXP: INTEGER; (*TO RECEIVE DECIMAL EXPONENT IF EXPNEEDED*)
83630 EXPNEEDED: BOOLEAN;
83640 X: REALTEGER;
83650 R: BOOLEAN; (*TRUE IF X IS REALLY .REAL*)
83660 VAR S: OBJECTP; (*NIL IF A NEW STRING IS TO BE CREATED;
83670 OTHERWISE, A STRING WHOSE CHARVEC IS TO RECEIVE THE RESULT
83680 (AND WHICH MUST BE LONG ENOUGH)*)
83690 START: INTEGER (*FIRST INDEX OF S TO BE USED*)
83700 ): BOOLEAN;
83710 LABEL 999;
83720 CONST POWOF2 = (*+01() 2000000000000000000B; (* 2^55 = 36028797018963968.0 *) ()+01*)
83730 (*TWO TO THE POWER (NO. OF DIGITS IN MANTISSA)+7*)
83740 (*+02() 1.0; ()+02*)
83750 (*+05() 1.0; ()+05*)
83760 POWOF2OVER10 = (*+01() 146314631463146315B; (* ROUND( 2^55 / 10 ) = 3602879701896397.0 *) ()+01*)
83770 (*CAREFULLY ROUNDED UP*)
83780 (*+02() 0.1; ()+02*)
83790 (*+05() 0.1; ()+05*)
83800 (*+44() TYPE MINT = INTEGER; ()+44*)
83810 VAR L, M, BLANKS, PT, FIRSTDIG, INDEX: INTEGER;
83820 A, B, ROUNDD: MINT;
83830 PROCEDURE CONVR(Y(*>=0.0*): REAL; VAR L: INTEGER; VAR A: MINT);
83840 (*COMPUTES L = THE LARGEST NUMBER OF DIGITS BEFORE THE DECIMAL POINT (POSSIBLY NEGATIVE) WHICH MIGHT BE NEEDED;
83850 A = (Y*POWOF2)/10**L (ROUNDED TO NEAREST INTEGER?) *)
83860 (*+01() EXTERN; ()+01*)
83870 (*+05()
83880 CONST LOG10E = 0.43429; (*DELIBERATELY UNDERESTIMATED*)
83890 VAR LL: REAL;
83900 BEGIN
83910 LL :=LN(Y)*LOG10E;
83920 IF LL>0.0 THEN L := 1+TRUNC(LL)
83930 ELSE L := TRUNC(LL);
83940 A := TIMESTEN(Y (* *POWOF2 *), -L);
83950 IF A >= 1.0 THEN
83960 BEGIN L := L+1; A := TIMESTEN(Y (* *POWOF2 *), -L) END;
83970 END ;
83980 ()+05*)
83990 (*+02()
84000 CONST LOG10E = 0.43429; (*DELIBERATELY UNDERESTIMATED*)
84010 VAR LL: REAL;
84020 BEGIN
84030 LL :=LN(Y)*LOG10E;
84040 IF LL>0.0 THEN L := 1+TRUNC(LL)
84050 ELSE L := TRUNC(LL);
84060 A := (*-44() TIMESTE(Y (* *POWOF2 *), -L) ()-44*) (*+44() L ()+44*);
84070 IF A >= 1.0 THEN
84080 BEGIN L := L+1; A := (*-44() TIMESTE(Y (* *POWOF2 *), -L) ()-44*) (*+44() L ()+44*) END;
84090 END ;
84100 ()+02*)
84110 PROCEDURE CONVI(Y(*>=0*): INTEGER; VAR L: INTEGER; VAR A: MINT);
84120 (*AS CONVR, BUT FOR INTEGERS*)
84130 (*+01() EXTERN; ()+01*)
84140 (*+05()
84150 VAR I: INTEGER ; YY: INTEGER ;
84160 BEGIN
84170 YY := Y ;
84180 L := 0 ;
84190 WHILE YY >= 1 DO
84200 BEGIN L := L + 1 ; YY := YY DIV 10 END ;
84210 A := TIMESTEN(Y (* *POWOF2 *), -L)
84220 END ;
84230 ()+05*)
84240 (*+02()
84250 VAR I: INTEGER ; YY: INTEGER ;
84260 BEGIN
84270 YY := Y ;
84280 L := 0 ;
84290 WHILE YY >= 1 DO
84300 BEGIN L := L + 1 ; YY := YY DIV 10 END ;
84310 (*-44() A := TIMESTE(Y (* *POWOF2 *), -L) ()-44*)
84320 (*+44() A := Y; ()+44*)
84330 END ;
84340 ()+02*)
84350 (*-44()
84360 PROCEDURE ROUNDER(DIGITS: INTEGER; VAR ROUNDD: MINT);
84370 (* COMPUTES ROUNDD = 0.5 X ( 10 TO THE POWER OF - DIGITS ) X POWOF2 *)
84380 (*+01() EXTERN; ()+01*)
84390 (*+05()
84400 VAR I : INTEGER ;
84410 BEGIN
84420 IF DIGITS < 0 THEN DIGITS := 0 ELSE IF DIGITS > REALWIDTH THEN DIGITS := REALWIDTH ;
84430 ROUNDD := 1 ;
84440 FOR I := 1 TO DIGITS DO
84450 ROUNDD := ROUNDD / 10 ;
84460 (* ROUNDD = 10 TO THE POWER OF - DIGITS *)
84470 ROUNDD := 0.5 * ROUNDD (* *POWOF2 *);
84480 END ;
84490 ()+05*)
84500 (*+02()
84510 VAR I : INTEGER ;
84520 BEGIN
84530 IF DIGITS < 0 THEN DIGITS := 0 ELSE IF DIGITS > REALWIDTH THEN DIGITS := REALWIDTH ;
84540 ROUNDD := 1 ;
84550 FOR I := 1 TO DIGITS DO
84560 ROUNDD := ROUNDD / 10 ;
84570 (* ROUNDD = 10 TO THE POWER OF - DIGITS *)
84580 ROUNDD := 0.5 * ROUNDD (* *POWOF2 *);
84590 END ;
84600 ()+02*)
84610 ()-44*)
84620 BEGIN (* OF SUBFIXED *)
84630 WITH X DO
84640 BEGIN
84650 IF R THEN IF REA <> 0.0 THEN CONVR(ABS(REA), L, A) ELSE CONVI(ABS(INT), L, A)
84660 ELSE CONVI(ABS(INT), L, A);
84670 (*-44()
84680 IF EXPNEEDED THEN
84690 IF REA<>0.0 THEN
84700 BEGIN
84710 ROUNDER(BEFORE+AFTER, ROUNDD);
84720 B := A; A := A*10;
84730 IF A+ROUNDD<POWOF2 THEN
84740 BEGIN B := A; L := L-1 END;
84750 A := B+ROUNDD;
84760 EXP := L-BEFORE; L := BEFORE
84770 END
84780 ELSE
84790 BEGIN A := 0; EXP := 0 END
84800 ELSE
84810 BEGIN
84820 ROUNDER(L+AFTER, ROUNDD);
84830 A := A+ROUNDD (*+01()+ORD(ROUNDD=0)()+01*);
84840 IF A<POWOF2OVER10 THEN
84850 BEGIN A := A*10; L := L-1 END
84860 END
84870 ()-44*)
84880 END ;
84890 IF L>0 THEN
84900 BEGIN IF BEFORE<0 THEN BEFORE := L; M := L END
84910 ELSE
84920 IF BEFORE<=0 THEN BEGIN BEFORE := ORD(POINT=0); M := BEFORE END ELSE M := 1;
84930 IF (L>BEFORE) OR (AFTER<0) THEN BEGIN SUBFIXED := FALSE; GOTO 999 END;
84940 IF S=NIL THEN S := CRSTRING(SIGN+BEFORE+POINT+AFTER);
84950 BLANKS := START-1+BEFORE-M+ORD(SIGN<0);
84960 WITH S^ DO
84970 BEGIN
84980 FOR INDEX := START TO BLANKS DO
84990 CHARVEC[INDEX] := ' ';
85000 IF SIGN=1 THEN
85010 BEGIN BLANKS := BLANKS+SIGN;
85020 IF (*-44() ( R AND ( X.REA < 0.0 ) ) OR ()-44*)
85030 ( NOT R AND ( X.INT < 0 ) ) THEN
85040 CHARVEC[BLANKS] := '-' ELSE CHARVEC[BLANKS] := '+'
85050 END;
85060 PT := BLANKS+M+1; FIRSTDIG := START+BEFORE+SIGN-L+ORD(L<0);
85070 (*-44()
85080 FOR INDEX := BLANKS+1 TO BLANKS+M+POINT+AFTER DO
85090 IF INDEX=PT THEN CHARVEC[INDEX] := '.'
85100 ELSE IF INDEX<FIRSTDIG THEN CHARVEC[INDEX] := '0'
85110 ELSE
85120 BEGIN
85130 A := A*10;
85140 (*+01()
85150 CHARVEC[INDEX] := CHR( ORD( '0' ) + A DIV POWOF2 ) ;
85160 A := A MOD POWOF2
85170 ()+01*)
85180 (*-01()
85190 L := TRUNC( A (* / POWOF2 *));
85200 CHARVEC[INDEX] := CHR( ORD( '0' ) + L );
85210 A := A - L (* *POWOF2 *);
85220 ()-01*)
85230 END
85240 ()-44*)
85250 (*+44()
85260 FOR INDEX := BLANKS+M+POINT+AFTER DOWNTO BLANKS+1 DO
85270 IF INDEX=PT THEN CHARVEC[INDEX] := '.'
85280 ELSE IF INDEX<FIRSTDIG THEN CHARVEC[INDEX] := '0'
85290 ELSE
85300 BEGIN
85310 B := A MOD 10;
85320 A := A DIV 10;
85330 CHARVEC[INDEX] := CHR( ORD( '0' ) + B );
85340 END;
85350 ()+44*)
85360 END;
85370 SUBFIXED := TRUE;
85380 999:
85390 END;
85400 (**)
85410 (**)
85420 PROCEDURE ERRORFILL(VAR S: OBJECTP; LENGTH: INTEGER);
85430 VAR I: INTEGER;
85440 BEGIN
85450 IF S=NIL THEN S := CRSTRING(LENGTH);
85460 WITH S^ DO
85470 FOR I := 1 TO STRLENGTH DO CHARVEC[I] := ERRORCHAR
85480 END;
85490 (**)
85500 (**)
85510 PROCEDURE PUTT(RF: OBJECTP);
85520 (*+02() LABEL 1; ()+02*)
85530 VAR P: ^REALTEGER;
85540 TEMP: REALTEGER;
85550 PDESC1:PDESC;
85560 TEMPLATE:DPOINT;
85570 COUNT, XMODE, XSIZE, SIZE, I, J: INTEGER;
85580 F,PVAL:OBJECTP;
85590 (**)
85600 (*+02() PROCEDURE DUMMYP; (*JUST HERE TO MAKE 1 GLOBAL, NOT CALLED*)
85610 BEGIN GOTO 1 END; ()+02*)
85620 (**)
85630 PROCEDURE ENSROOM(RF:OBJECTP;VAR F:OBJECTP;UPB:INTEGER);
85640 BEGIN IF [LINEOVERFLOW]<=F^.PCOVER^.STATUS
85650 THEN IF NOT ENSLINE(RF,F) THEN ERRORR(NOLOGICAL);
85660 WITH F^.PCOVER^ DO
85670 BEGIN IF COFCPOS+UPB-ORD(COFCPOS<=1)>CHARBOUND
85680 THEN BEGIN IF UPB>=CHARBOUND THEN ERRORR(SMALLLINE);
85690 STATUS:=STATUS+[LINEOVERFLOW];
85700 ENSROOM(RF,F,UPB)
85710 END
85720 ELSE IF COFCPOS<>1 THEN
85730 CLPASC5(ORD(F^.PCOVER), ORD(F), -1, ORD(' '), ORD(BOOK), DOPUTS);
85740 END (*WITH*);
85750 END; (*ENSROOM*)
85760 (**)
85770 PROCEDURE CRREALSTR(R:REAL;VAR S:OBJECTP;START:INTEGER);
85780 VAR E, F: REALTEGER;
85790 NOOK: BOOLEAN;
85800 BEGIN
85810 F.REA := R ;
85820 NOOK:=SUBFIXED(1,1,1,REALWIDTH-1,E.INT,TRUE,F,TRUE,S,START);
85830 S^.CHARVEC[START+REALWIDTH+2]:='E';
85840 NOOK:=SUBFIXED(1,EXPWIDTH,0,0,E.INT,FALSE,E,FALSE,S,START+REALWIDTH+3)
85850 END;
85860 (**)
85870 PROCEDURE VALUEPRINT(RF:OBJECTP;VAR F:OBJECTP);
85880 VAR D,I,J,EXP,UPB,LWB:INTEGER;
85890 S,STR :OBJECTP;
85900 NOOK:BOOLEAN;
85910 BEGIN WITH TEMP DO
85920 BEGIN
85930 UPB:=1;
85940 IF NOT([OPENED,WRITEMOOD,CHARMOOD]<=F^.PCOVER^.STATUS) THEN
85950 ENSSTATE(RF, F, [OPENED,WRITEMOOD,CHARMOOD]);
85960 XSIZE := SZINT;
85970 CASE XMODE OF
85980 -1: (*FILLER*) XSIZE := 0;
85990 (*+61() 1,3,5: (*LONG MODES*)
86000 BEGIN XSIZE := SZLONG; DUMMY END; ()+61*)
86010 0: (*INTEGER*)
86020 BEGIN UPB:=INTSPACE;
86030 ENSROOM(RF,F,UPB);
86040 NOOK:=SUBFIXED(1,INTWIDTH,0,0,EXP,FALSE,TEMP,FALSE,PUTSTRING,1);
86050 WITH F^.PCOVER^ DO CLPASC5(ORD(F^.PCOVER), ORD(PUTSTRING), 1, INTSPACE, ORD(BOOK), DOPUTS)
86060 END;
86070 2: (*REAL*)
86080 BEGIN XSIZE := SZREAL; UPB:=REALSPACE;
86090 ENSROOM(RF,F,UPB);
86100 CRREALSTR(REA,PUTSTRING,1);
86110 WITH F^.PCOVER^ DO CLPASC5(ORD(F^.PCOVER), ORD(PUTSTRING), 1, UPB, ORD(BOOK), DOPUTS);
86120 END;
86130 4: (*COMPL*)
86140 BEGIN UPB:=COMPLSPACE;
86150 ENSROOM(RF,F,UPB);
86160 REA := P^.REA;
86170 CRREALSTR(REA,PUTSTRING,1);
86180 PUTSTRING^.CHARVEC[REALSPACE+1]:=' ';
86190 PUTSTRING^.CHARVEC[REALSPACE+2]:='I';
86200 P:=INCPTR(P, SZREAL); REA := P^.REA;
86210 CRREALSTR(REA,PUTSTRING,REALSPACE+3);
86220 WITH F^.PCOVER^ DO CLPASC5(ORD(F^.PCOVER), ORD(PUTSTRING), 1, UPB, ORD(BOOK), DOPUTS);
86230 END;
86240 7,9,10: BEGIN LWB:=1; (*STRING,BITS,BYTES*)
86250 IF XMODE=7 THEN
86260 BEGIN XSIZE := SZADDR; STR:=PTR; D:=STR^.STRLENGTH;
86270 IF [PAGEOVERFLOW]<=F^.PCOVER^.STATUS
86280 THEN IF NOT ENSPAGE(RF,F) THEN ERRORR(9999)
86290 END
86300 ELSE IF XMODE=9 THEN
86310 BEGIN J:=INT; (*BITS*)
86320 STR := CRSTRING(BITSWIDTH);
86330 WITH STR^ DO
86340 FOR I:=1 TO BITSWIDTH DO
86350 IF NXTBIT(J)=1 THEN CHARVEC[I]:='T' ELSE CHARVEC[I]:='F';
86360 D:=BITSWIDTH
86370 END
86380 ELSE IF XMODE=10 THEN (*BYTES*)
86390 BEGIN STR := CRSTRING(BYTESWIDTH);
86400 WITH STR^ DO
86410 FOR I:=1 TO BYTESWIDTH DO CHARVEC[I]:=ALF[I];
86420 D:=BYTESWIDTH
86430 END;
86440 WHILE LWB<=D DO
86450 BEGIN IF [LINEOVERFLOW]<=F^.PCOVER^.STATUS
86460 THEN IF NOT ENSLINE(RF,F) THEN ERRORR(9999);
86470 WITH F^.PCOVER^ DO
86480 BEGIN UPB:=LWB+CHARBOUND-COFCPOS; (*ROOM LEFT ON LINE*)
86490 IF UPB>D THEN UPB:=D;
86500 WITH F^.PCOVER^ DO CLPASC5(ORD(F^.PCOVER), ORD(STR), LWB, UPB, ORD(BOOK), DOPUTS);
86510 LWB:=UPB+1;
86520 END (*WITH*)
86530 END; (*OD*)
86540 IF XMODE IN [9,10] THEN GARBAGE(STR)
86550 END; (*STRING*)
86560 6,8: (*CHAR, BOOL*)
86570 BEGIN
86580 IF LINEOVERFLOW IN F^.PCOVER^.STATUS THEN
86590 IF NOT ENSLINE(RF, F) THEN ERRORR(9999);
86600 IF XMODE=8 THEN (*BOOL*)
86610 IF (*+01()INT<0()+01*) (*-01()INT<>0()-01*) THEN
86620 INT := ORD('T') ELSE INT := ORD('F');
86630 IF (INT>=0) AND (INT<=MAXABSCHAR) THEN
86640 WITH F^.PCOVER^ DO CLPASC5(ORD(F^.PCOVER), ORD(S), -1, INT, ORD(BOOK), DOPUTS)
86650 ELSE ERRORR(RCHARERROR)
86660 END;
86670 11: (*PROC*) CL68(GETPROC(PTR), RF);
86680 12: (*STRUCT*)
86690 BEGIN J:=0;
86700 REPEAT J:=J+1 UNTIL TEMPLATE^[J]<0;
86710 I:=ORD(P);
86720 WHILE ORD(P)-I<TEMPLATE^[0] DO
86730 BEGIN J:=J+1;
86740 XMODE:=TEMPLATE^[J]-1;
86750 TEMP := P^ ;
86760 VALUEPRINT(RF,F);
86770 P:=INCPTR(P, XSIZE)
86780 END;
86790 XMODE:=12
86800 END;
86810 14: (*CODE(REF FILE)VOID*)
86820 BEGIN
86830 XSIZE := SZPROC;
86840 CLPASC1(ORD(RF), PROCC);
86850 END;
86860 END; (*CASE*)
86870 END (*WITH TEMP*);
86880 END; (*VALUEPRINT*)
86890 (**)
86900 BEGIN (*PUT*)
86910 (*PUTT IS CALLED FROM EITHER PUT OR PRINT, WHICH ARE WRITTEN
86920 IN ASSEMBLER. AT THIS POINT, STKTOP(0) CONTAINS COUNT, THE
86930 SPACE OCCUPIED BY DATA LIST ITEMS, BELOW THAT ARE PAIRS
86940 ON THE STACK, EACH CONSISTING OF AN XMODE AND A VALUE
86950 *)
86960 (*+02() 1: ()+02*) COUNT := GETSTKTOP(SZWORD, 0);
86970 FPINC(RF^);
86980 J := COUNT+SZWORD;
86990 WHILE J>SZWORD DO
87000 BEGIN
87010 J := J-SZWORD;
87020 XMODE := GETSTKTOP(SZWORD, J);
87030 CASE XMODE OF
87040 4,7,11,12,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31:
87050 BEGIN
87060 J := J-SZADDR;
87070 PVAL := ASPTR(GETSTKTOP(SZADDR, J));
87080 FPINC(PVAL^);
87090 END;
87100 (*+61() 1,3,5: J := J-SZLONG; ()+61*)
87110 14: J := J-SZPROC;
87120 2: J := J-SZREAL;
87130 0,6,8,9,10: J := J-SZINT;
87140 -1: (*NO ACTION*);
87150 END;
87160 END;
87170 TESTF(RF,F);
87180 J := COUNT+SZWORD;
87190 WHILE J>SZWORD DO
87200 BEGIN
87210 J := J-SZWORD;
87220 XMODE := GETSTKTOP(SZWORD, J);
87230 IF XMODE>=16 THEN (*ROW*)
87240 BEGIN
87250 J := J-SZADDR;
87260 XMODE:=XMODE-16;
87270 PVAL := ASPTR(GETSTKTOP(SZADDR, J));
87280 WITH PVAL^ DO
87290 BEGIN
87300 FORMPDESC(PVAL,PDESC1);
87310 TEMPLATE:=MDBLOCK;
87320 IF ORD(TEMPLATE)=0 THEN SIZE := SZADDR
87330 ELSE IF ORD(TEMPLATE)<=MAXSIZE THEN SIZE:=ORD(TEMPLATE)
87340 ELSE SIZE:=TEMPLATE^[0];
87350 WHILE NEXTEL(0,PDESC1) DO WITH PDESC1 DO WITH PDESCVEC[0] DO
87360 BEGIN I:=PP;
87370 WHILE I<PP+PSIZE DO
87380 BEGIN P:=INCPTR(PVALUE, I);
87390 TEMP := P^;
87400 VALUEPRINT(RF,F);
87410 I:=I+SIZE
87420 END
87430 END
87440 END
87450 END
87460 ELSE
87470 BEGIN
87480 CASE XMODE OF
87490 4,5,12: (*STRUCT, INCLUDING COMPL*)
87500 BEGIN
87510 J := J-SZADDR;
87520 PVAL := ASPTR(GETSTKTOP(SZADDR, J));
87530 TEMPLATE := PVAL^.DBLOCK;
87540 P := INCPTR(PVAL, STRUCTCONST);
87550 END;
87560 0,6,8,9,10:
87570 BEGIN J := J-SZINT; TEMP.INT := GETSTKTOP(SZINT, J) END;
87580 (*+61()
87590 1,3:
87600 BEGIN J := J-SZLONG; TEMP.LONG := GETSTKTOP(SZLONG, J) END;
87610 ()+61*)
87620 2:
87630 BEGIN J := J-SZREAL; (*-01()TEMP.REA()-01*)(*+01()TEMP.INT()+01*) := GETSTKTOP(SZREAL, J) END;
87640 7,11:
87650 BEGIN J := J-SZADDR; TEMP.PTR := ASPTR(GETSTKTOP(SZADDR, J)) END;
87660 14:
87670 BEGIN J := J-SZPROC; TEMP.PROCC := GETSTKTOP(SZPROC, J) END;
87680 -1: (*NO ACTION*);
87690 END;
87700 VALUEPRINT(RF, F);
87710 END;
87720 END; (*OD*)
87730 J := COUNT+SZWORD;
87740 WHILE J>SZWORD DO
87750 BEGIN
87760 J := J-SZWORD;
87770 XMODE := GETSTKTOP(SZWORD, J);
87780 CASE XMODE OF
87790 4,7,11,12,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31:
87800 BEGIN
87810 J := J-SZADDR;
87820 PVAL := ASPTR(GETSTKTOP(SZADDR, J));
87830 WITH PVAL^ DO
87840 BEGIN FDEC; IF FTST THEN GARBAGE(PVAL) END;
87850 END;
87860 (*+61() 1,3,5: J := J-SZLONG; ()+61*)
87870 14: J := J-SZPROC;
87880 2: J := J-SZREAL;
87890 0,6,8,9,10: J := J-SZINT;
87900 -1: (*NO ACTION*);
87910 END;
87920 END;
87930 WITH RF^ DO
87940 BEGIN FDEC; IF FTST THEN GARBAGE(RF) END;
87950 END; (* PUT *)
87960 (**)
87970 (**)
87980 (*-02()
87990 BEGIN (*OF A68*)
88000 END; (*OF A68*)
88010 ()-02*)
88020 (*+01()
88030 BEGIN (*OF MAIN PROGRAM*)
88040 END (* OF EVERYTHING *).
88050 ()+01*)