42000 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
42010 (**)
42020 (**)
42030 (*+85()
42040 (**)
42050 PROCEDURE STANDARDPRELUDE;
42060 FUNCTION DEFPRC0(YIELD: MODE; CP: CODEPROC): MODE;
42070 BEGIN SRSEMP := -1; SRSUBP := 0; SUBSAVE;
42080 FINDPRC(YIELD,0,CP); DEFPRC0 := SRSTK[SRSEMP].MD
42090 END;
42100 FUNCTION DEFPRC1(P1, YIELD: MODE; CP: CODEPROC): MODE;
42110 BEGIN SRSEMP := -1; SRSUBP := 0; SUBSAVE;
42120 SRSEMP := SRSEMP+1; SRSTK[SRSEMP].MD := P1;
42130 FINDPRC(YIELD,1,CP); DEFPRC1 := SRSTK[SRSEMP].MD
42140 END;
42150 FUNCTION DEFPRC2(P1, P2, YIELD: MODE; CP: CODEPROC): MODE;
42160 BEGIN SRSEMP := -1; SRSUBP := 0; SUBSAVE;
42170 SRSEMP := SRSEMP+1; SRSTK[SRSEMP].MD := P1;
42180 SRSEMP := SRSEMP+1; SRSTK[SRSEMP].MD := P2;
42190 FINDPRC(YIELD,2,CP); DEFPRC2 := SRSTK[SRSEMP].MD
42200 END;
42210 PROCEDURE INTAB(VAR LEX: PLEX; TAG: ALFA; LXVV: LXM);
42220 VAR I: INTEGER;
42230 BEGIN WITH CURRENTLEX DO
42240 BEGIN
42250 LXV := LXVV; LXTOKEN := TKBOLD;
42260 (*+11() S10:=TAG; LXCOUNT:=1; ()+11*)
42270 (*-11() STASHLEX(TAG); ()-11*)
42280 END;
42290 LEX := HASHIN
42300 END;
42310 FUNCTION DEFTAG(TAG: ALFA): PLEX;
42320 VAR I: INTEGER;
42330 BEGIN WITH CURRENTLEX DO
42340 BEGIN
42350 LXV := LXVTAG; LXTOKEN := TKTAG;
42360 (*+11() S10:=TAG; LXCOUNT:=1; ()+11*)
42370 (*-11() STASHLEX(TAG); ()-11*)
42380 END;
42390 DEFTAG := HASHIN
42400 END;
42410 FUNCTION DEFLTAG(TAG1, TAG2: ALFA): PLEX;
42420 VAR I: INTEGER;
42430 BEGIN WITH CURRENTLEX DO
42440 BEGIN
42450 LXV := LXVTAG; LXTOKEN := TKTAG;
42460 (*+11() S20 := TAG2; S10 := TAG1; LXCOUNT := 2; ()+11*)
42470 (*-11() STASHLLEX(TAG1, TAG2); ()-11*)
42480 DEFLTAG := HASHIN
42490 END
42500 END;
42510 FUNCTION GETSTB(LEX: PLEX; DEF: DEFTYP; BLK: BLKTYP): PSTB;
42520 (*FUNCTION: CREATE A NEW STBLOCK FOR LEX*)
42530 VAR STB: PSTB;
42540 BEGIN
42550 NEW(STB); WITH STB^, LEX^.LXV DO
42560 BEGIN
42570 STLINK := LXPSTB; LXPSTB := STB;
42580 STLEX := LEX;
42590 STTHREAD := DCIL; DCIL := STB;
42600 STDEFTYP := DEF; STBLKTYP := BLK;
42610 STRANGE := 0;
42620 STLEVEL := 0; STLOCRG := 0;
42630 GETSTB := STB
42640 END
42650 END;
42660 (**)
42670 (**)
42680 PROCEDURE INITSTDIDS;
42690 (*CREATE STBLOCKS FOR STANDARD-PRELUDE IDENTIFIERS*)
42700 VAR PRCRR,PRCON, REFFILE: MODE;
42710 PROCEDURE DEFSTID(MD: MODE; LX: PLEX);
42720 VAR STB: PSTB; THIS:MODE; LENGTH:INTEGER;
42722 (*+05() LEX: PLEX; I: INTEGER; ()+05*)
42730 BEGIN STB := GETSTB(LX, [STVAR], STBDEFID);
42740 WITH STB^ DO
42750 BEGIN STMODE := MD;
42760 IF NOT(STMODE^.MDV.MDID IN [MDIDCHAN,MDIDPASC]) THEN
42762 BEGIN
42764 THIS:=MD;
42766 IF THIS^.MDV.MDID=MDIDREF THEN THIS:=THIS^.MDPRRMD;
42767 IF THIS^.MDV.MDPILE THEN LENGTH:=SZADDR
42768 ELSE LENGTH:=THIS^.MDV.MDLEN;
42770 (*-41() STOFFSET := CURID; CURID := CURID+LENGTH ()-41*)
42780 (*+41() CURID := CURID+LENGTH; STOFFSET := CURID ()+41*)
42782 IF MD^.MDV.MDID<>MDIDREF THEN STDEFTYP := [STINIT];
42785 END
42790 ELSE
42800 (*-05() BEGIN STVALUE := LX; STDEFTYP := [STCONST] END; ()-05*)
42801 (*+05() BEGIN
42802 ENEW(LEX, LEX1SIZE + LX^.LXCOUNT*SZWORD);
42803 FOR I := 1 TO LEX1SIZE DIV SZWORD + LX^.LXCOUNT DO
42804 LEX^.LEXWORDS[I] := LX^.LEXWORDS[I];
42805 STVALUE := LEX;
42806 STDEFTYP := [STCONST];
42807 END;
42808 ()+05*)
42810 END
42820 END;
42830 PROCEDURE DEFSTID1(TAG: ALFA; MD: MODE);
42840 BEGIN DEFSTID(MD, DEFTAG(TAG)) END;
42850 PROCEDURE DEFSTID2(TAG1, TAG2: ALFA; MD: MODE);
42860 BEGIN DEFSTID(MD, DEFLTAG(TAG1, TAG2)) END;
42870 PROCEDURE DEFCONST(TAG: ALFA; MD: MODE; VALUE: A68INT);
42880 VAR STB: PSTB;
42890 LX: PLEX;
42900 BEGIN STB := GETSTB(DEFTAG(TAG), [STCONST], STBDEFID);
42910 WITH STB^ DO
42920 BEGIN
42930 STMODE := MD;
42940 ENEW(LX, SZADDR+SZINT+LEX1SIZE); WITH LX^ DO
42950 BEGIN LXV := LXVPRDEN; LXCOUNT := (SZADDR+SZINT) DIV SZWORD;
42960 LXTOKEN := TKDENOT; LXDENRP := VALUE; LXDENMD := MD END;
42970 STVALUE := LX
42980 END
42990 END;
43000 PROCEDURE DEFREAL(TAG:ALFA;MD:MODE;VALUE1(*-01(), VALUE2(*+03(), VALUE3()+03*)()-01*): INTEGER);
43010 VAR STB:PSTB;
43020 LX:PLEX;
43021 TEMP: RECORD CASE SEVERAL OF
43022 1: (REA: REAL);
43023 2: (INT1: INTEGER;
43024 (*-01() INT2: INTEGER;
43025 (*+03() INT3: INTEGER; ()+03*)
43026 ()-01*) ) ;
43027 3,4,5,6,7,8,9,10: ();
43028 END;
43030 BEGIN
43040 STB:=GETSTB(DEFTAG(TAG),[STCONST],STBDEFID);
43050 WITH STB^ DO
43060 BEGIN
43070 STMODE:=MD;
43080 ENEW(LX,SZADDR+SZREAL+LEX1SIZE);
43090 WITH LX^ DO
43100 BEGIN
43110 LXV:=LXVPRDEN; LXCOUNT:=(SZADDR+SZREAL) DIV SZWORD; LXTOKEN:=TKDENOT;
43112 TEMP.INT1 := VALUE1;
43114 (*-01() TEMP.INT2 := VALUE2;
43116 (*+03() TEMP.INT3 := VALUE3; ()+03*)
43118 ()-01*)
43120 LXDENRPREAL := TEMP.REA; LXDENMD:=MD
43130 END;
43140 STVALUE:=LX
43150 END
43160 END;
43170 BEGIN
43180 (**)
43190 DEFCONST('MAXINT ', MDINT, MAXINT);
43200 (*+01()
43210 DEFREAL('MAXREAL ', MDREAL, 37767777777777777777B);
43220 DEFREAL('SMALLREAL ', MDREAL, 16414000000000000000B);
43222 DEFREAL('PI ', MDREAL, 17216220773250420551B);
43230 ()+01*)
43240 (*+05()
43250 DEFREAL('MAXREAL ', MDREAL, 2147483647, -1);
43260 DEFREAL('SMALLREAL ', MDREAL, 1017118720, 0);
43270 DEFREAL('PI ', MDREAL, 1074340347, 1413754136);
43280 ()+05*)
43290 DEFCONST('MAXABSCHAR', MDINT, MAXABSCHAR);
43300 DEFSTID1('BITSPACK ', DEFPRC1(FINDROW(MDBOOL,1),MDBITS, PASC));
43310 DEFSTID1('BYTESPACK ', DEFPRC1(MDSTRNG,MDBYTES, PASC));
43407 PRCRR := DEFPRC1(MDREAL,MDREAL, PASC);
43410 DEFSTID1('SQRT ', PRCRR);
43420 DEFSTID1('EXP ', PRCRR);
43430 DEFSTID1('LN ', PRCRR);
43440 DEFSTID1('COS ', PRCRR);
43450 DEFSTID1('ARCCOS ', PRCRR);
43460 DEFSTID1('SIN ', PRCRR);
43470 DEFSTID1('ARCSIN ', PRCRR);
43480 DEFSTID1('TAN ', PRCRR);
43490 DEFSTID1('ARCTAN ', PRCRR);
43500 DEFSTID1('NEXTRANDOM', DEFPRC1(FINDREF(MDINT),MDREAL, PASC));
43510 DEFSTID2('STANDINCHA','NNEL ', MDCHAN);
43520 DEFSTID2('STANDOUTCH','ANNEL ', MDCHAN);
43530 DEFSTID2('STANDBACKC','HANNEL ', MDCHAN);
43540 REFFILE := FINDREF(MDFILE);
43550 DEFSTID1('CHAN ', DEFPRC1(REFFILE,MDCHAN, PASC));
43560 DEFSTID1('MAKETERM ', DEFPRC2(REFFILE,MDSTRNG,MDVOID, PASC));
43570 PRCON := DEFPRC2(REFFILE,DEFPRC1(REFFILE,MDBOOL,PROC),MDVOID,PASC);
43580 DEFSTID2('ONLOGICALF','ILEEND ', PRCON);
43590 DEFSTID2('ONPHYSICAL','FILEEND ', PRCON);
43600 DEFSTID1('ONPAGEEND ', PRCON);
43610 DEFSTID1('ONLINEEND ', PRCON);
43620 SRSEMP := -1; SRSUBP := 0; SUBSAVE; SRSEMP := SRSEMP+6;
43630 SRSTK[SRSEMP-5].MD := REFFILE; SRSTK[SRSEMP-4].MD := MDSTRNG;
43640 SRSTK[SRSEMP-3].MD := MDCHAN; SRSTK[SRSEMP-2].MD := MDINT;
43650 SRSTK[SRSEMP-1].MD := MDINT; SRSTK[SRSEMP].MD := MDINT;
43660 FINDPRC(MDINT,6,PASC);
43670 DEFSTID1('ESTABLISH ', SRSTK[SRSEMP].MD);
43680 SRSEMP := -1; SRSUBP := 0; SUBSAVE; SRSEMP := SRSEMP+3;
43690 SRSTK[SRSEMP-2].MD := REFFILE; SRSTK[SRSEMP-1].MD := MDSTRNG;
43700 SRSTK[SRSEMP].MD := MDCHAN;
43710 FINDPRC(MDINT,3,PASC);
43720 DEFSTID1('OPEN ', SRSTK[SRSEMP].MD);
43730 DEFSTID1('ASSOCIATE ', DEFPRC2(REFFILE,FINDREF(FINDROW(MDCHAR,1)),MDVOID, PASC));
43740 DEFSTID1('CLOSE ', PASCVF);
43750 DEFSTID1('CHARNUMBER', DEFPRC1(REFFILE,MDINT, PASC));
43760 DEFSTID1('LINENUMBER', DEFPRC1(REFFILE,MDINT, PASC));
43770 DEFSTID1('PAGENUMBER', DEFPRC1(REFFILE,MDINT, PASC));
43780 DEFSTID1('SPACE ', PASCVF);
43790 DEFSTID1('NEWLINE ', PASCVF);
43800 DEFSTID1('NEWPAGE ', PASCVF);
43810 SRSEMP := -1; SRSUBP := 0; SUBSAVE; SRSEMP := SRSEMP+4;
43820 SRSTK[SRSEMP-3].MD := REFFILE; SRSTK[SRSEMP-2].MD := MDINT;
43830 SRSTK[SRSEMP-1].MD := MDINT; SRSTK[SRSEMP].MD := MDINT;
43840 FINDPRC(MDVOID,4,PASC);
43850 DEFSTID1('SET ', SRSTK[SRSEMP].MD);
43860 DEFSTID1('RESET ', PASCVF);
43870 DEFSTID1('WHOLE ', DEFPRC2(MDNUMBER,MDINT,MDSTRNG, PASC));
43880 SRSEMP := -1; SRSUBP := 0; SUBSAVE; SRSEMP := SRSEMP+3;
43890 SRSTK[SRSEMP-2].MD := MDNUMBER; SRSTK[SRSEMP-1].MD := MDINT;
43900 SRSTK[SRSEMP].MD := MDINT;
43910 FINDPRC(MDSTRNG,3,PASC);
43920 DEFSTID1('FIXED ', SRSTK[SRSEMP].MD);
43930 SRSEMP := -1; SRSUBP := 0; SUBSAVE; SRSEMP := SRSEMP+4;
43940 SRSTK[SRSEMP-3].MD := MDNUMBER; SRSTK[SRSEMP-2].MD := MDINT;
43950 SRSTK[SRSEMP-1].MD := MDINT; SRSTK[SRSEMP].MD := MDINT;
43960 FINDPRC(MDSTRNG,4,PASC);
43970 DEFSTID1('FLOAT ', SRSTK[SRSEMP].MD);
43980 DEFSTID1('PUT ', DEFPRC2(REFFILE,FINDROW(MDOUT,1),MDVOID, PASC));
43990 DEFSTID1('GET ', DEFPRC2(REFFILE,FINDROW(MDIN,1),MDVOID, PASC));
44000 DEFSTID1('PUTBIN ', DEFPRC2(REFFILE,FINDROW(MDOUTB,1),MDVOID, PASC));
44010 DEFSTID1('GETBIN ', DEFPRC2(REFFILE,FINDROW(MDINB,1),MDVOID, PASC));
44020 DEFSTID1('LASTRANDOM', FINDREF(MDINT));
44030 DEFSTID1('RANDOM ', DEFPRC0(MDREAL, PASC));
44040 DEFSTID1('STANDIN ', REFFILE);
44050 DEFSTID1('STANDOUT ', REFFILE);
44060 DEFSTID1('STANDBACK ', REFFILE);
44070 DEFSTID1('PRINT ', DEFPRC1(FINDROW(MDOUT,1),MDVOID, PASC));
44080 DEFSTID1('WRITE ', DEFPRC1(FINDROW(MDOUT,1),MDVOID, PASC));
44090 DEFSTID1('READ ', DEFPRC1(FINDROW(MDIN,1),MDVOID, PASC));
44100 DEFSTID1('WRITEBIN ', DEFPRC1(FINDROW(MDOUTB,1),MDVOID, PASC));
44110 DEFSTID1('READBIN ', DEFPRC1(FINDROW(MDINB,1),MDVOID,PASC));
44120 LEXLSTOP := DEFTAG('STOP ');
44121 (*-01() (*-05()
44122 DEFSTID1('MAXREAL ', MDREAL);
44124 DEFSTID1('SMALLREAL ', MDREAL);
44126 DEFSTID1('PI ', MDREAL);
44128 ()-05*) ()-01*)
44130 (*+54()
44140 DEFSTID1('ONERROR ', DEFPRC1(DEFPRC1(MDEXC,MDVOID,PROC),MDVOID,PASC));
44150 DEFSTID2('MAKEXCEPTI','ON ', DEFPRC1(MDINT,MDEXC,PASC));
44160 DEFSTID1('ERROR ', DEFPRC1(MDINT,MDVOID,PASC));
44170 DEFSTID1('OFFERROR ', DEFPRC0(MDVOID,PASC));
44180 ()+54*)
44190 (**)
44200 (**)
44210 (**)
44220 END;
44230 (**)
44240 (**)
44250 PROCEDURE INITOPS;
44260 VAR OBABS, OBAND, OBARG, OBBIN, OBCONJ, OBDIV, OBDVAB, OBELEM, OBENTI, OBEQ,
44270 OBGE, OBGT, OBLE, OBLENG, OBLT, OBLWB, OBMDAB, OBMNAB, OBMINUS, OBMOD, OBNE, OBNOT,
44280 OBODD, OBOR, OBOVAB, OBOVER, OBPLAB, OBPLTO, OBPLITM, OBPLUS, OBREPR, OBROUN, OBSHL,
44290 OBSHR, OBSHRT, OBSIGN, OBTIMES, OBTMAB, OBUP, OBUPB, OBRE, OBIM: INTEGER;
44300 CURROB, THISOB, PREVOB: INTEGER;
44310 PROCEDURE NOB(VAR OB: INTEGER);
44320 BEGIN OB := CURROB; THISOB := OB END;
44330 PROCEDURE OPTAB(IDNDX: OPIDNDXTYP; OPCOD: POP; MIN,MAX: XTYPE; RESMD: MODE);
44340 BEGIN
44350 IF THISOB=PREVOB THEN OPTABL[CURROB-1].OPMORE := TRUE;
44360 PREVOB := THISOB;
44370 WITH OPTABL[CURROB] DO
44380 BEGIN OPIDNDX := IDNDX; OPOPCOD := OPCOD; OPMIN := MIN; OPMAX := MAX;
44390 OPMODE := RESMD; OPMORE := FALSE END;
44400 CURROB := CURROB+1
44410 END;
44420 PROCEDURE DEFSTOP(LX: PLEX; PRIO: INTEGER; OB: INTEGER);
44430 VAR STB: PSTB;
44440 BEGIN STB := GETSTB(LX, [], STBDEFPRIO); WITH STB^ DO
44450 BEGIN STDYPRIO := PRIO; STUSERLEX := NIL; STSTDOP := OB END
44460 END;
44470 PROCEDURE DEFSTOP1(TAB: ALFA; PRIO: INTEGER; OB: INTEGER);
44480 VAR LX: PLEX;
44490 BEGIN INTAB(LX, TAB, LXVOPR); DEFSTOP(LX, PRIO, OB) END;
44500 PROCEDURE DEFSTOP2(PUNCT: ALFA; PRIO: INTEGER; OB: INTEGER);
44510 VAR S, I: INTEGER;
44520 CHA: CHAR;
44530 LEX: PLEX;
44540 PROCEDURE NEXTCH; BEGIN CHA := PUNCT[I]; I := I+1 END;
44550 BEGIN
44560 I := 1; NEXTCH;
44570 (*+01() IF CHA=':' THEN S := ORD('$')-ORD('+') ELSE S := ORD(CHA)-ORD('+'); ()+01*)
44580 (*+25() IF CHA=':' THEN S := ORD('$')-ORD('+') ELSE S := ORD(CHA)-ORD('+'); ()+25*)
44590 (*-01() (*-25() S := ORD(CHA)-ORD('!'); (*ASCII VERSION*)
44592 IF CHA='%' THEN S := 23
44600 ELSE IF CHA IN ['[', ']', '^','\'] THEN S := S-55; ()-25*) ()-01*)
44610 NEXTCH;
44620 WITH OPCHTABLE[S] DO
44630 BEGIN
44640 LEX := OTLEX;
44650 S := OTNEXT
44660 END;
44670 WHILE S<>0 DO
44680 WITH OPCHTABLE[S] DO
44690 IF CHA=OTCHAR THEN
44700 BEGIN
44710 NEXTCH;
44720 LEX := OTLEX;
44730 S := OTNEXT
44740 END
44750 ELSE S := OTALT;
44760 DEFSTOP(LEX, PRIO, OB)
44770 END;
44780 BEGIN
44790 CURROB := 1; PREVOB := 0;
44800 (**)
44810 NOB(OBABS);
44820 OPTAB(IDMON , PABSI , XINT,XLREAL , MDABSENT);
44830 OPTAB(IDMONL, PABSI-4 , XCOMPL,XLCOMPL, MDREAL);
44840 OPTAB(IDMON , PABSB , XBOOL,XBITS , MDINT);
44850 OPTAB(IDMON , PABSCH , XCHAR,XCHAR , MDINT);
44860 NOB(OBAND);
44870 OPTAB(IDBB , PANDB , XBOOL,XBITS , MDABSENT);
44880 NOB(OBARG);
44890 OPTAB(IDMONL, PARG , XCOMPL,XLCOMPL, MDREAL);
44900 NOB(OBBIN);
44910 OPTAB(IDMON , PBIN , XINT,XINT , MDBITS);
44920 NOB(OBCONJ);
44930 OPTAB(IDMON , PCONJ , XCOMPL,XLCOMPL, MDABSENT);
44940 NOB(OBDIV);
44950 OPTAB(IDAAL , PDIV , XINT,XLINT , MDREAL);
44960 OPTAB(IDAA , PDIV , XINT,XLCOMPL , MDABSENT);
44970 NOB(OBDVAB);
44980 OPTAB(IDRA , PDIVAB , XREAL,XLCOMPL , MDABSENT);
44990 NOB(OBELEM);
45000 OPTAB(IDIB , PELMBT , XBITS,XBITS , MDBOOL);
45010 OPTAB(IDIB , PELMBY , XBYTES,XBYTES , MDCHAR);
45020 NOB(OBENTI);
45030 OPTAB(IDMONL, PENTI , XREAL,XLREAL , MDINT);
45040 NOB(OBEQ);
45050 OPTAB(IDAA , PEQ , XINT,XLCOMPL , MDBOOL);
45060 OPTAB(IDAA , PEQCS , XCHAR,XSTRNG , MDBOOL);
45070 OPTAB(IDBB , PEQB , XBOOL,XBYTES , MDBOOL);
45080 NOB(OBGE);
45090 OPTAB(IDAA , PGE , XINT,XLREAL , MDBOOL);
45100 OPTAB(IDAA , PGECS , XCHAR,XSTRNG , MDBOOL);
45110 OPTAB(IDBB , PGEBT , XBITS,XBYTES , MDBOOL);
45120 NOB(OBGT);
45130 OPTAB(IDAA , PGT , XINT,XLREAL , MDBOOL);
45140 OPTAB(IDAA , PGTCS , XCHAR,XSTRNG , MDBOOL);
45150 OPTAB(IDBB , PGTBY , XBYTES,XBYTES , MDBOOL);
45160 NOB(OBIM);
45170 OPTAB(IDMONL, PIM , XCOMPL,XLCOMPL,MDREAL);
45180 NOB(OBLE);
45190 OPTAB(IDAA , PLE , XINT,XLREAL , MDBOOL);
45200 OPTAB(IDAA , PLECS , XCHAR,XSTRNG , MDBOOL);
45210 OPTAB(IDBB , PLEBT , XBITS,XBYTES , MDBOOL);
45220 (*+61()
45230 NOB(OBLENG);
45240 OPTAB(IDMON , PLENGI , XINT,XINT , MDLINT);
45250 OPTAB(IDMON , PLENGR , XREAL,XREAL , MDLREAL);
45260 OPTAB(IDMON , PLENGC , XCOMPL,XCOMPL , MDLCOMPL);
45270 ()+61*)
45280 NOB(OBLT);
45290 OPTAB(IDAA , PLT , XINT,XLREAL , MDBOOL);
45300 OPTAB(IDAA , PLTCS , XCHAR,XSTRNG , MDBOOL);
45310 OPTAB(IDBB , PLTBY , XBYTES,XBYTES , MDBOOL);
45320 NOB(OBLWB);
45330 OPTAB(IDIBRM, PLWBM , -1,-1 , MDINT);
45340 OPTAB(IDIBR , PLWB , XINT,XINT , MDINT);
45350 OPTAB(IDMON , PLWBMSTR, XSTRNG,XSTRNG, MDINT);
45360 NOB(OBMDAB);
45370 OPTAB(IDRA , PMODAB , XINT,XLINT , MDABSENT);
45380 NOB(OBMNAB);
45390 OPTAB(IDRA , PMINUSAB, XINT,XLCOMPL , MDABSENT);
45400 NOB(OBMINUS);
45410 OPTAB(IDAA , PSUB , XINT,XLCOMPL , MDABSENT);
45420 OPTAB(IDMON , PNEGI , XINT,XLCOMPL , MDABSENT);
45430 NOB(OBMOD);
45440 OPTAB(IDAAL , PMOD , XINT,XLINT , MDINT);
45450 NOB(OBNE);
45460 OPTAB(IDAA , PNE , XINT,XLCOMPL , MDBOOL);
45470 OPTAB(IDAA , PNECS , XCHAR,XSTRNG , MDBOOL);
45480 OPTAB(IDBB , PNEB , XBOOL,XBYTES , MDBOOL);
45490 NOB(OBNOT);
45500 OPTAB(IDMON , PNOTB , XBOOL,XBITS , MDABSENT);
45510 NOB(OBODD);
45520 OPTAB(IDMON , PODD , XINT,XLINT , MDBOOL);
45530 NOB(OBOR);
45540 OPTAB(IDBB , PORB , XBOOL,XBITS , MDABSENT);
45550 NOB(OBOVAB);
45560 OPTAB(IDRA , POVERAB , XINT,XLINT , MDABSENT);
45570 NOB(OBOVER);
45580 OPTAB(IDAAL , POVER , XINT,XLINT , MDINT);
45590 NOB(OBPLAB);
45600 OPTAB(IDRA , PPLSAB , XINT,XLCOMPL , MDABSENT);
45610 OPTAB(IDSC , PPLSABS,XCHAR,XSTRNG, REFSTRNG);
45620 NOB(OBPLITM);
45630 OPTAB(IDAAL , PPLITM+2, XINT,XLREAL , MDCOMPL);
45640 (*BECAUSE THERE ARE NO POPS FOR XINT AND XLINT*)
45650 NOB(OBPLTO);
45660 OPTAB(IDCS , PPLSTOCS,XCHAR,XSTRNG, REFSTRNG);
45670 NOB(OBPLUS);
45680 OPTAB(IDAA , PADD , XINT,XLCOMPL , MDABSENT);
45690 OPTAB(IDAA , PCAT , XCHAR,XSTRNG, MDSTRNG);
45700 OPTAB(IDMON , PNOOP , XINT,XLCOMPL , MDABSENT);
45710 NOB(OBRE);
45720 OPTAB(IDMONL, PRE , XCOMPL,XLCOMPL,MDREAL);
45730 NOB(OBREPR);
45740 OPTAB(IDMON , PREPR , XINT,XINT , MDCHAR);
45750 NOB(OBROUN);
45760 OPTAB(IDMONL, PROUN , XREAL,XLREAL , MDINT);
45770 NOB(OBSHL);
45780 OPTAB(IDBI , PSHL , XBITS,XBITS , MDABSENT);
45790 NOB(OBSHR);
45800 OPTAB(IDBI , PSHR , XBITS,XBITS , MDABSENT);
45810 (*+61()
45820 NOB(OBSHRT);
45830 OPTAB(IDMON , PSHRTI , XLINT,XLINT , MDINT);
45840 OPTAB(IDMON , PSHRTR , XLREAL,XLREAL, MDREAL);
45850 OPTAB(IDMON , PSHRTC , XLCOMPL,XLCOMPL, MDCOMPL);
45860 ()+61*)
45870 NOB(OBSIGN);
45880 OPTAB(IDMON , PSGNI , XINT,XLREAL , MDINT);
45890 NOB(OBTIMES);
45900 OPTAB(IDAA , PMUL , XINT,XLCOMPL , MDABSENT);
45910 OPTAB(IDIB , PMULIC , XCHAR,XSTRNG, MDSTRNG);
45920 OPTAB(IDBI , PMULCI , XCHAR,XSTRNG, MDSTRNG);
45930 NOB(OBTMAB);
45940 OPTAB(IDRA , PTIMSAB, XINT,XLCOMPL , MDABSENT);
45950 OPTAB(IDSI , PTIMSABS,XSTRNG,XSTRNG,REFSTRNG);
45960 NOB(OBUP);
45970 OPTAB(IDBI , PEXP , XINT,XLCOMPL , MDABSENT);
45980 NOB(OBUPB);
45990 OPTAB(IDIBRM, PUPBM , -1,-1 , MDINT);
46000 OPTAB(IDIBR , PUPB , XINT,XINT , MDINT);
46010 OPTAB(IDMON , PUPBMSTR, XSTRNG,XSTRNG, MDINT);
46020 DEFSTOP1('ABS ',10, OBABS);
46030 DEFSTOP1('ARG ',10, OBARG);
46040 DEFSTOP1('BIN ',10, OBBIN);
46050 DEFSTOP1('CONJ ',10, OBCONJ);
46060 DEFSTOP1('ENTIER ',10, OBENTI);
46070 (*+61()
46080 DEFSTOP1('LENG ',10, OBLENG);
46090 ()+61*)
46100 DEFSTOP1('NOT ',10, OBNOT);
46110 DEFSTOP1('ODD ',10, OBODD);
46120 DEFSTOP1('REPR ',10, OBREPR);
46130 DEFSTOP1('ROUND ',10, OBROUN);
46140 (*+61()
46150 DEFSTOP1('SHORTEN ',10, OBSHRT);
46160 ()+61*)
46170 DEFSTOP1('SIGN ',10, OBSIGN);
46180 DEFSTOP1('RE ',10, OBRE);
46190 DEFSTOP1('IM ',10, OBIM);
46200 DEFSTOP1('DIVAB ', 1, OBDVAB);
46210 DEFSTOP2('/:= ', 1, OBDVAB);
46220 DEFSTOP1('MINUSAB ', 1, OBMNAB);
46230 DEFSTOP2('-:= ', 1, OBMNAB);
46240 DEFSTOP1('MODAB ', 1, OBMDAB);
46250 DEFSTOP2('%*:= ', 1, OBMDAB);
46260 DEFSTOP1('OVERAB ', 1, OBOVAB);
46270 DEFSTOP2('%:= ', 1, OBOVAB);
46280 DEFSTOP1('PLUSAB ', 1, OBPLAB);
46290 DEFSTOP2('+:= ', 1, OBPLAB);
46300 DEFSTOP1('PLUSTO ', 1, OBPLTO);
46310 DEFSTOP2('+=: ', 1, OBPLTO);
46320 DEFSTOP1('TIMESAB ', 1, OBTMAB);
46330 DEFSTOP2('*:= ', 1, OBTMAB);
46340 DEFSTOP1('OR ', 2, OBOR);
46350 DEFSTOP1('AND ', 3, OBAND);
46360 DEFSTOP1('EQ ', 4, OBEQ);
46370 DEFSTOP2('= ', 4, OBEQ);
46380 DEFSTOP1('NE ', 4, OBNE);
46390 DEFSTOP2('/= ', 4, OBNE);
46400 DEFSTOP1('GE ', 5, OBGE);
46410 DEFSTOP2('>= ', 5, OBGE);
46420 DEFSTOP1('GT ', 5, OBGT);
46430 DEFSTOP2('> ', 5, OBGT);
46440 DEFSTOP1('LE ', 5, OBLE);
46450 DEFSTOP2('<= ', 5, OBLE);
46460 DEFSTOP1('LT ', 5, OBLT);
46470 DEFSTOP2('< ', 5, OBLT);
46480 DEFSTOP2('+ ', 6, OBPLUS);
46490 DEFSTOP2('- ', 6, OBMINUS);
46500 DEFSTOP1('ELEM ', 7, OBELEM);
46510 DEFSTOP2('* ', 7, OBTIMES);
46520 DEFSTOP2('/ ', 7, OBDIV);
46530 DEFSTOP1('MOD ', 7, OBMOD);
46540 DEFSTOP2('%* ', 7, OBMOD);
46550 DEFSTOP1('OVER ', 7, OBOVER);
46560 DEFSTOP2('% ', 7, OBOVER);
46570 (*-51()
46580 DEFSTOP2('^ ', 8, OBUP);
46590 ()-51*)
46600 (*+51()
46610 DEFSTOP2(''' ', 8, OBUP);
46620 ()+51*)
46630 DEFSTOP2('** ', 8, OBUP);
46640 DEFSTOP1('LWB ', 8, OBLWB);
46650 DEFSTOP1('UPB ', 8, OBUPB);
46660 DEFSTOP1('SHL ', 8, OBSHL);
46670 DEFSTOP1('SHR ', 8, OBSHR);
46680 DEFSTOP1('I ', 9, OBPLITM);
46690 DEFSTOP2('+* ', 9, OBPLITM);
46700 END;
46710 BEGIN (*STANDARDPRELUDE*)
46720 DCIL := NIL; SRSUBP := 0; SRSEMP := -1;
46730 CURID := SIZIBBASE+SIZLEBBASE;
46740 INITSTDIDS;
46750 INITOPS;
46760 NEW(MONADUMMY); WITH MONADUMMY^ DO
46770 BEGIN STLINK := NIL; STLEX := NIL; STTHREAD := NIL; STDEFTYP := [STINIT]; STBLKTYP := STBDEFOP;
46780 STRANGE := 0; STOFFSET := 0; STLEVEL := 0; STLOCRG := 0;
46790 STMODE := DEFPRC1(MDERROR, MDERROR, PROC) END;
46800 NEW(DYADUMMY); DYADUMMY^ := MONADUMMY^; DYADUMMY^.STMODE := DEFPRC2(MDERROR, MDERROR, MDERROR, PROC);
46810 END;
46820 (**)
46830 ()+85*)
46840 (**)
46850 (*+01()
46860 PROCEDURE INITBEGIN;
46870 (*FILLS XSEG.BUFFER WITH WORDS TO BE OUTPUT BY EMITBEG*)
46880 VAR COUNT: INTEGER;
46890 PROCEDURE INTWD(INT: INTEGER);
46900 BEGIN
46910 XSEG.BUFFER[COUNT].CODEWORD := INT;
46920 COUNT := COUNT+1
46930 END;
46940 PROCEDURE ALFWD(ALF: ALFA);
46950 VAR X: RECORD CASE INTEGER OF
46960 1: (I: INTEGER);
46970 2: (A: ALFA)
46980 END;
46990 BEGIN WITH X DO
47000 BEGIN
47010 A := ALF;
47020 XSEG.BUFFER[COUNT].CODEWORD := I;
47030 COUNT := COUNT+1
47040 END;
47050 END;
47060 BEGIN
47070 COUNT := 1;
47080 INTWD(77000007000000000000B); (*PRFX TABLE*)
47090 ALFWD('A68PROG:::');
47100 INTWD(0); (*FOR DAT*)
47110 INTWD(0); (*FOR TIM*)
47120 ALFWD(NOSNUM);
47130 ALFWD(ALG68NUM);
47140 ALFWD(' ');
47150 ALFWD(' I ');
47160 (*LDSET TABLE - LIB, MAP, ERR*)
47170 (*-52()
47180 INTWD(70000004000000000000B);
47190 INTWD(00100001000000000000B);
47200 ALFWD('A68SLIB:::');
47210 INTWD(00110000000000000002B);
47220 INTWD(00130000000000000000B);
47230 ()-52*)
47240 (*+52()
47250 INTWD(70000002000000000000B);
47260 INTWD(00100001000000000000B);
47270 ALFWD('A68SLIB:::');
47280 ()+52*)
47290 INTWD(34000002000000000000B); (*PIDL TABLE*)
47300 ALFWD('A68PROG:::');
47310 INTWD(55555555555555003400B); (*3400B WORDS OF STACK/HEAP SPACE*)
47320 INTWD(36000002000000000000B); (*ENTR TABLE*)
47330 ALFWD('P.MAIN::::');
47340 INTWD(00000000000001000003B);
47350 INTWD(46000001000000000000B); (*XFER TABLE*)
47360 ALFWD('P.MAIN::::');
47370 XSEG.BUFFER[0].CODEWORD := COUNT-1;
47380 END;
47390 ()+01*)
47400 (**)
47410 (**)
47420 (**)
47430 (**)
47440 (**)
47450 (**)
47460 (*+85()
47470 (**)
47480 PROCEDURE INITSEMANTICS;
47490 VAR I : INTEGER;
47500 PROCEDURE SETOLIST(VAR OLIST: OLSTTYP; A,B,C,D,E,F: STATE);
47510 VAR I: INTEGER;
47520 BEGIN FOR I:=0 TO 5 DO OLIST[I].DP:=FALSE;
47530 OLIST[0].OVAL:=A; OLIST[1].OVAL:=B;OLIST[2].OVAL:=C;
47540 OLIST[3].OVAL:=D; OLIST[4].OVAL:=E; OLIST[5].OVAL:=F;
47550 END;
47560 (**)
47570 (**)
47580 BEGIN (*INITSEMANTICS*)
47590 (*SIMPLE,SPECIAL,WEAKREF,ROWED,DRESSED,UNDRESSED*)
47600 SETOLIST(OLIST1, 0 ,1 ,4 ,2 ,2 ,3);OLIST1[2].DP:=TRUE;OLIST1[5].DP:=TRUE;
47610 SETOLIST(OLIST2, 0 ,3 ,6 ,6 ,6 ,6);
47620 SETOLIST(OLIST3, 0 ,1 ,2 ,4 ,2 ,3);
47630 SETOLIST(OLIST4, 4 ,1 ,11 ,4 ,4 ,3);
47640 FOR I := 0 TO 5 DO OLIST4[I].DP:=TRUE; OLIST4[1].DP:=FALSE;
47650 SETOLIST(OLIST5, 11 ,11 ,11 ,11 ,11 ,0);OLIST5[5].DP:=TRUE;
47660 SETOLIST(OLIST6, 0 ,1 ,2 ,4 ,2 ,3);OLIST6[5].DP:=TRUE;
47670 (**)
47680 END;
47690 ()+85*)