597 lines
26 KiB
OpenEdge ABL
597 lines
26 KiB
OpenEdge ABL
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*)
|