583 lines
31 KiB
OpenEdge ABL
583 lines
31 KiB
OpenEdge ABL
50000 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
|
50010 (**)
|
|
50020 (**)
|
|
50030 (*+82()
|
|
50040 (**)
|
|
50050 (*+01() (*+31() (*$P+,T+*) ()+31*) ()+01*)
|
|
50060 (*+25() (*+31() (*$P+,T+*) ()+31*) ()+25*)
|
|
50070 (**)
|
|
50080 PROCEDURE PARSEPARSER;
|
|
50090 VAR ACOUNT, BCOUNT: INTEGER; CCOUNT: 0..10000;
|
|
50100 HTCOPY: HASHTAB;
|
|
50110 THIS, THAT: PLEX;
|
|
50120 BPRODTBL: ARRAY [1..40] OF PROD;
|
|
50130 SEXFR,FEXFR:ARRAY[0..PRODLEN] OF 0..PRODLEN;
|
|
50140 TEMP:INTEGER;
|
|
50150 I: INTEGER;
|
|
50160 J: INTEGER;
|
|
50165 (* MAP: RECORD CASE BOOLEAN OF
|
|
50166 TRUE : (INT:ADDRINT);
|
|
50167 FALSE : (POINT:^INTEGER);
|
|
50168 END; *)
|
|
50170 (*+01()
|
|
50180 FRED: PLEX;
|
|
50190 FRIG: RECORD CASE SEVERAL OF
|
|
50200 1:(INT: INTEGER); 2:(POINT: PINTEGER) END;
|
|
50210 ()+01*)
|
|
50220 (*+25()
|
|
50230 FRIG: RECORD CASE SEVERAL OF
|
|
50240 1:(INT: INTEGER); 2:(POINT: PINTEGER) END;
|
|
50250 ()+25*)
|
|
50260 (*+04()
|
|
50270 PROCEDURE INITIO;
|
|
50280 (*+01() VAR AW66: PW66; ()+01*)
|
|
50290 BEGIN
|
|
50300 ERRDEV := FALSE;
|
|
50310 (*+23() NUMPARAMS:=0; (* TO COUNT NO OF P-OP PARAMETERS OUTPUT TO LSTFILE *) ()+23*)
|
|
50320 LSTLINE := -1; (*FOR FIRST TIME OF OUTSRC*)
|
|
50330 LSTCNT := 100; (*TO FORCE NEWPAGE*)
|
|
50340 LSTPAGE := 0;
|
|
50350 (*-03() (*-04()
|
|
50360 RESET(INPUT);
|
|
50370 REWRITE(LSTFILE);
|
|
50380 ()-04*) ()-03*)
|
|
50390 (*+03()
|
|
50400 WRITE('SOURCE-FILE: ');
|
|
50410 OPEN(INPUT,'','SYMB',SEQRD);
|
|
50420 WRITE('LIST-FILE: ');
|
|
50430 OPEN(LSTFILE,'','DATA',SEQWR);
|
|
50440 OPEN(OUTPUT,'TERMINAL','SYMB',SEQWR);
|
|
50450 ()+03*)
|
|
50460 RESET(INPUT, 'INPUT');
|
|
50470 REWRITE(OUTPUT, 'CONSOLE');
|
|
50480 REWRITE(LSTFILE, 'LSTFILE');
|
|
50490 SRCBUF[0] := ' '; (*IT WILL NEVER BE WRITTEN TO AGAIN*)
|
|
50500 (*+01()
|
|
50510 LINELIMIT(OUTPUT, 100000);
|
|
50520 AW66 := ASPTR(66B);
|
|
50530 ONLINE := AW66^.JOPR=3;
|
|
50540 ()+01*)
|
|
50550 (*+02() ONLINE := TRUE; ()+02*)
|
|
50560 (*+03() ONLINE := FILENR(LSTFILE)<>1; ()+03*)
|
|
50570 ONLINE := TRUE;
|
|
50580 (*-04() (*-02() DATE(DAT); TIME(TIM); ()-02*) ()-04*)
|
|
50590 END;
|
|
50600 ()+04*)
|
|
50610 PROCEDURE CLASS(TAG: ALFA);
|
|
50620 VAR DUMMY: PLEX;
|
|
50630 I: INTEGER;
|
|
50640 BEGIN WITH CURRENTLEX DO
|
|
50650 BEGIN
|
|
50660 LXV := LXVTAB; LXTOKEN := TKTAG;
|
|
50670 (*+11() S10:=TAG; LXCOUNT:=1; ()+11*)
|
|
50680 (*-11() STASHLEX(TAG); ()-11*)
|
|
50690 DUMMY := HASHIN
|
|
50700 END
|
|
50710 END;
|
|
50720 PROCEDURE TLEX(TAG: ALFA; SLEX: LXIOTYPE);
|
|
50730 VAR DUMMY: PLEX;
|
|
50740 I: INTEGER;
|
|
50750 BEGIN WITH CURRENTLEX DO
|
|
50760 BEGIN
|
|
50770 LXV := LXVTAG; LXTOKEN := TKTAG; LXV.LXPIO := SLEX;
|
|
50780 (*+11() S10:=TAG; LXCOUNT:=1; ()+11*)
|
|
50790 (*-11() STASHLEX(TAG); ()-11*)
|
|
50800 DUMMY := HASHIN;
|
|
50810 END
|
|
50820 END;
|
|
50830 PROCEDURE SEMANTICROUTINE(SRTN: RTNTYPE);
|
|
50840 VAR C: INTEGER;
|
|
50850 SAE: CHAR;
|
|
50860 PROCEDURE LABL(SEX, FEX, VALUE: INTEGER);
|
|
50870 VAR TEMP: INTEGER;
|
|
50880 BEGIN
|
|
50890 WHILE SEX<>0 DO
|
|
50900 BEGIN TEMP := PRODTBL[SEX].SEXIT; PRODTBL[SEX].SEXIT := VALUE; SEX := TEMP END;
|
|
50910 WHILE FEX<>0 DO
|
|
50920 BEGIN TEMP := PRODTBL[FEX].FEXIT; PRODTBL[FEX].FEXIT := VALUE; FEX := TEMP END
|
|
50930 END;
|
|
50940 BEGIN WITH SRPLSTK[PLSTKP]^ DO WITH PRODTBL[(BCOUNT-1) MOD PRODLEN + 1] DO CASE SRTN OF
|
|
50950 10: (*SR01*) (*START OF EACH RULE*)
|
|
50960 ACOUNT := 0;
|
|
50970 11: (*SR02*) (*TAG*)
|
|
50980 IF ACOUNT=0 THEN BEGIN PRSTKC := S; SYLXV.LX1IO := LXV.LXPIO END
|
|
50990 ELSE IF ACOUNT=1 THEN BEGIN PRSTKA := 2; PRINPC := SSA; SYLXV.LX2IO := LXV.LXPIO; ACOUNT := -99 END
|
|
51000 ELSE (*ACOUNT<0*) BEGIN PRINPC := S; SYLXV.LX2IO := LXV.LXPIO END;
|
|
51010 12: (*SR03A*) (*TAB*)
|
|
51020 BEGIN C := ORD(S10[4])-ORD('0');
|
|
51030 IF (C<0) OR (C>9) THEN C := ORD(S10[4])-ORD('A')+10;
|
|
51040 IF S10[1]='C' THEN WITH SYLXV DO
|
|
51050 IF ACOUNT=0 THEN CASE S10[3] OF
|
|
51060 '0': BEGIN PRSTKC:=C0; LX1CL0:=C END; '1': BEGIN PRSTKC:=C1; LX1CL1:=C END;
|
|
51070 '2': BEGIN PRSTKC:=C2; LX1CL2:=C END; END
|
|
51080 ELSE CASE S10[3] OF
|
|
51090 '0': BEGIN PRINPC:=C0; LX2CL0:=C END; '1': BEGIN PRINPC:=C1; LX2CL1:=C END;
|
|
51100 '2': BEGIN PRINPC:=C2; LX2CL2:=C END; END END;
|
|
51110 35: (*SR20B)* (*NO 2ND TAG OR TAB*)
|
|
51120 IF ACOUNT=-1 THEN BEGIN PRINPC := A; SYLXV.LX2IO := LXIODUMMY END;
|
|
51130 13: (*SR03B*) (*NO 1ST TAG OR TAB*)
|
|
51140 BEGIN ACOUNT := -1; PRSTKC := S; SYLXV.LX1IO := LXIODUMMY; PRSTKA := 3 END;
|
|
51150 14: (*SR04A*) (*AFTER COMMA*)
|
|
51160 ACOUNT := ACOUNT+1;
|
|
51170 15: (*SR04B*) (*AFTER STICK*)
|
|
51180 IF ACOUNT>=0 THEN
|
|
51190 BEGIN PRSTKA := ACOUNT; ACOUNT := -1 END;
|
|
51200 16: (*SR05*) (*RTN PRESENT*)
|
|
51210 BEGIN
|
|
51220 SAE := SRPLSTK[PLSTKP]^.S10[1];
|
|
51230 IF (SAE = 'S') OR (SAE = 'A') THEN C := 0
|
|
51240 ELSE IF SAE = 'E' THEN C := ESY01-1
|
|
51250 ELSE SEMERR(ESE+16);
|
|
51260 RTN := C + (*-04() INP^.LXDENRP ()-04*)(*+04() SHRINK(INP^.LXDENRP) ()+04*)
|
|
51270 END;
|
|
51280 17: (*SR06*) (*RTN ABSENT*)
|
|
51290 RTN := DUMMY;
|
|
51300 18: (*SR07A*) (*POP PRESENT*)
|
|
51310 PRPOP := (*-04() INP^.LXDENRP ()-04*)(*+04() SHRINK(INP^.LXDENRP) ()+04*);
|
|
51320 19: (*SR07B*) (*POP ABSENT*)
|
|
51330 BEGIN PRPOP := 0; PRPUSH := LXIODUMMY END;
|
|
51340 20: (*SR08A*) (*PUSH PRESENT*)
|
|
51350 PRPUSH := INP^.LXV.LXPIO;
|
|
51360 21: (*SR08B*) (*PUSH ABSENT*)
|
|
51370 PRPUSH := LXIODUMMY;
|
|
51380 22: (*SR10*) (*SKIP PRESENT*)
|
|
51390 PRSKIP := TRUE;
|
|
51400 23: (*SR11*) (*SKIP ABSENT*)
|
|
51410 PRSKIP := FALSE;
|
|
51420 24: (*SR12*) (*SCAN=++*)
|
|
51430 PRSCAN := 2;
|
|
51440 25: (*SR14A)* (*SCAN=+*)
|
|
51450 PRSCAN := 1;
|
|
51460 26: (*SR14B*) (*SCAN ABSENT*)
|
|
51470 PRSCAN := 0;
|
|
51480 28: (*SR15*) (*SEX*)
|
|
51490 IF (LXV.LXP<PRODLEN) AND (LXV.LXPSTB<>NIL) THEN
|
|
51500 SEXIT := LXV.LXP
|
|
51510 ELSE
|
|
51520 BEGIN
|
|
51530 IF LXV.LXPSTB=NIL THEN
|
|
51540 BEGIN
|
|
51550 CCOUNT:=CCOUNT+1; LXV.LXP:=PRODLEN+CCOUNT;
|
|
51560 SEXFR[CCOUNT]:=0; FEXFR[CCOUNT]:=0
|
|
51570 END;
|
|
51580 TEMP:=LXV.LXP-PRODLEN;
|
|
51590 SEXIT:=SEXFR[TEMP]; SEXFR[TEMP]:=BCOUNT
|
|
51600 END;
|
|
51610 29: (*SR16A*) (*FEX*)
|
|
51620 IF (INP^.LXV.LXP<PRODLEN) AND (INP^.LXV.LXPSTB<>NIL) THEN
|
|
51630 FEXIT := INP^.LXV.LXP
|
|
51640 ELSE
|
|
51650 BEGIN
|
|
51660 IF INP^.LXV.LXPSTB=NIL THEN
|
|
51670 BEGIN
|
|
51680 CCOUNT:=CCOUNT+1; INP^.LXV.LXP:=PRODLEN+CCOUNT;
|
|
51690 SEXFR[CCOUNT]:=0; FEXFR[CCOUNT]:=0
|
|
51700 END;
|
|
51710 TEMP:=INP^.LXV.LXP-PRODLEN;
|
|
51720 FEXIT:=FEXFR[TEMP];FEXFR[TEMP]:=BCOUNT
|
|
51730 END;
|
|
51740 30: (*SR16B*) (*FEX ABSENT*)
|
|
51750 FEXIT := BCOUNT+1;
|
|
51760 31: (*SR16C*) (*END OF RULE*)
|
|
51770 BCOUNT := BCOUNT+1;
|
|
51780 32: (*SR16D*) (*ERROR*)
|
|
51790 OUTERR(ELX+7, ERRORR, NIL);
|
|
51800 34: (*SR20A*) (*AT LABEL*)
|
|
51810 BEGIN
|
|
51820 IF LXV.LXPSTB<>NIL THEN
|
|
51830 BEGIN
|
|
51840 TEMP:=LXV.LXP-PRODLEN;
|
|
51850 LABL(SEXFR[TEMP],FEXFR[TEMP],BCOUNT);
|
|
51860 SEXFR[TEMP]:=0; FEXFR[TEMP]:=0;
|
|
51870 WHILE (CCOUNT>0) AND (SEXFR[CCOUNT]=0) AND (FEXFR[CCOUNT]=0)
|
|
51880 DO CCOUNT:=CCOUNT-1
|
|
51890 END;
|
|
51900 LXV.LXP := BCOUNT END;
|
|
51910 36: (*SR20C*) (*END OF FILE*)
|
|
51920 ENDOFPROG := TRUE;
|
|
51930 END
|
|
51940 END;
|
|
51950 ()+82*)
|
|
51960 (*OLD VERSION OF SEMANTICROUTINE WHICH WAS USED TO PRODUCE THE CALLS OF MPROD AND BLABL WHICH FOLLOW*)
|
|
51970 (*
|
|
51980 PROCEDURE SEMANTICROUTINE(SRTN: RTNTYPE);
|
|
51990 VAR C: INTEGER;
|
|
52000 SAR: CHAR;
|
|
52010 BEGIN WITH SRPLSTK[PLSTKP]^ DO CASE SRTN OF
|
|
52020 10: (*SR01+) BEGIN WRITE(LSTFILE, ' BMPROD(', BCOUNT:3, ', '); ACOUNT:=0; END;
|
|
52030 11: (*SR02+): IF ACOUNT<>1 THEN WRITE(LSTFILE, 'S , LXIO', S1, ', 0, ')
|
|
52040 ELSE BEGIN WRITE(LSTFILE, '2, SSA,LXIO', S1, ', 0, '); ACOUNT:=-99 END;
|
|
52050 12: (*SR03A+) BEGIN C := ORD(S1[4])-ORD('0');
|
|
52060 IF (C<0) OR (C>9) THEN C := ORD(S1[4])-ORD('A')+10;
|
|
52070 IF S1[1]='C' THEN WRITE(LSTFILE, 'C', S1[3], ', LXIODUMMY , ', C:2, ', ') END;
|
|
52080 35: (*SR20B+) IF ACOUNT=-1 THEN WRITE(LSTFILE, 'A , LXIODUMMY , 0, ');
|
|
52090 13: (*SR03B+) BEGIN ACOUNT:=-1; WRITE(LSTFILE, 'S , LXIODUMMY , 0, 3, ') END;
|
|
52100 14: (*SR04A+) ACOUNT := ACOUNT+1;
|
|
52110 15: (*SR04B+) IF ACOUNT>=0 THEN
|
|
52120 BEGIN WRITE(LSTFILE, ACOUNT:1, ', '); ACOUNT:=-1 END;
|
|
52130 16: (*SR05+) BEGIN SAE := SRPLSTK[PLSTKP].S1[1];
|
|
52140 IF (SAE='S') OR (SAE = 'A') THEN C:=0
|
|
52150 ELSE IF SAE='E' THEN C:=ESY01-1
|
|
52160 ELSE SEMERR(ESE+16);
|
|
52170 WRITE(LSTFILE,C+INP^.LXDENRP:4)
|
|
52180 END;
|
|
52190 17: (*SR06+) WRITE(LSTFILE, 'DUMMY , ');
|
|
52200 18: (*SR07A+) WRITE(LSTFILE, INP^.LXDENRP:1, ', ');
|
|
52210 19: (*SR07B+) WRITE(LSTFILE, '0, LXIODUMMY , ');
|
|
52220 20: (*SR08A+) WRITE(LSTFILE, 'LXIO', INP^.S1, ', ');
|
|
52230 21: (*SR08B+) WRITE(LSTFILE, 'LXIODUMMY , ');
|
|
52240 22: (*SR10+) WRITE(LSTFILE, 'TRUE , ');
|
|
52250 23: (*SR11+) WRITE(LSTFILE, 'FALSE, ');
|
|
52260 24: (*SR12+) WRITE(LSTFILE, '2, ');
|
|
52270 25: (*SR14A+) WRITE(LSTFILE, '1, ');:
|
|
52280 26: (*SR14B+) WRITE(LSTFILE, '0, ');:
|
|
52290 28: (*SR15+) IF (LXV.LXP<PRODLEN) AND (LXV.LXPSTB<>NIL) THEN
|
|
52300 WRITE(LSTFILE, LXV.LXP:4, ', ')
|
|
52310 ELSE BEGIN
|
|
52320 IF LXV.LXPSTB=NIL THEN BEGIN LXV.LXP := PRODLEN; CCOUNT := CCOUNT+1 END;
|
|
52330 WRITE(LSTFILE, -(LXV.LXP DIV PRODLEN-1):4, ', ');
|
|
52340 LXV.LXP := LXV.LXP MOD PRODLEN + (BCOUNT+1)*PRODLEN END;
|
|
52350 29: (*SR16A+) IF (INP^.LXV.LXP<PRODLEN) AND (INP^.LXV.LXPSTB<>NIL) THEN
|
|
52360 WRITE(LSTFILE, INP^.LXV.LXP:4)
|
|
52370 ELSE BEGIN
|
|
52380 IF INP^.LXV.LXPSTB=NIL THEN BEGIN INP^.LXV.LXP := PRODLEN; CCOUNT := CCOUNT+1 END;
|
|
52390 WRITE(LSTFILE, -(INP^.LXV.LXP MOD PRODLEN):4);
|
|
52400 INP^.LXV.LXP := INP^.LXV.LXP DIV PRODLEN * PRODLEN + BCOUNT END;
|
|
52410 30: (*SR16B+) WRITE(LSTFILE, BCOUNT+1:4);
|
|
52420 31: (*SR16C+) BEGIN WRITELN(LSTFILE,');'); BCOUNT := BCOUNT+1; END;
|
|
52430 32: (*SR16D+) OUTERR(ELX+7, ERRORR, NIL);
|
|
52440 34: (*SR20A+) BEGIN
|
|
52450 IF LXV.LXPSTB<>NIL THEN BEGIN
|
|
52460 WRITELN(LSTFILE, ' BLABL(', LXV.LXP DIV PRODLEN - 1:3, ', ',
|
|
52470 LXV.LXP MOD PRODLEN:3, ', ', BCOUNT:3, ');');
|
|
52480 CCOUNT := CCOUNT-1;
|
|
52490 END;
|
|
52500 LXV.LXP := BCOUNT END;
|
|
52510 36: (*SR20C+) ENDOFPROG := TRUE;
|
|
52520 END
|
|
52530 END;
|
|
52540 *)
|
|
52550 (*+82()
|
|
52560 PROCEDURE INITPR;
|
|
52570 BEGIN
|
|
52580 PLINPQ := NIL;
|
|
52590 PLPTR := 1;
|
|
52600 SRPLSTK[SRPLSTKSIZE] := LEXSTOP;
|
|
52610 SRPLSTK[SRPLSTKSIZE-1] := LEXSTOP;
|
|
52620 PLSTKP := SRPLSTKSIZE-1;
|
|
52630 ENDOFPROG := FALSE;
|
|
52640 INP := LEXSTART
|
|
52650 END;
|
|
52660 PROCEDURE BMPROD(PTR: INTEGER;
|
|
52670 CONFIG1: CONFIG; IO1: LXIOTYPE; CLA1: CL2TYPE; STKA: INTEGER;
|
|
52680 CONFIG2: CONFIG; IO2: LXIOTYPE; CLA2: CL2TYPE;
|
|
52690 SRTN: RTNTYPE; POP: INTEGER; PUSH: LXIOTYPE; SKIP: BOOLEAN; SCAN: INTEGER; SEX, FEX: INTEGER);
|
|
52700 BEGIN WITH BPRODTBL[PTR] DO
|
|
52710 BEGIN
|
|
52720 PRSTKA := STKA; PRSTKC := CONFIG1; PRINPC := CONFIG2;
|
|
52730 CASE CONFIG1 OF S: SYLXV.LX1IO := IO1;
|
|
52740 C0: SYLXV.LX1CL0 := CLA1; C1: SYLXV.LX1CL1 := CLA1; C2: SYLXV.LX1CL2 := CLA1 END;
|
|
52750 CASE CONFIG2 OF S, A, SSA: SYLXV.LX2IO := IO2;
|
|
52760 C0: SYLXV.LX2CL0 := CLA2; C1: SYLXV.LX2CL1 := CLA2; C2: SYLXV.LX2CL2 := CLA2 END;
|
|
52770 RTN := SRTN; PRPOP := POP; PRPUSH := PUSH; PRSKIP := SKIP; PRSCAN := SCAN;
|
|
52780 SEXIT := ABS(SEX); FEXIT := ABS(FEX);
|
|
52790 END
|
|
52800 END;
|
|
52810 PROCEDURE BLABL(SEX, FEX, VALUE: INTEGER);
|
|
52820 VAR TEMP: INTEGER;
|
|
52830 BEGIN
|
|
52840 WHILE SEX<>0 DO
|
|
52850 BEGIN TEMP := BPRODTBL[SEX].SEXIT; BPRODTBL[SEX].SEXIT := VALUE; SEX := TEMP END;
|
|
52860 WHILE FEX<>0 DO
|
|
52870 BEGIN TEMP := BPRODTBL[FEX].FEXIT; BPRODTBL[FEX].FEXIT := VALUE; FEX := TEMP END
|
|
52880 END;
|
|
52890 PROCEDURE PARSER;
|
|
52900 VAR MATCH: BOOLEAN;
|
|
52910 STK: PLEX;
|
|
52920 I: INTEGER;
|
|
52930 BEGIN
|
|
52940 WHILE NOT ENDOFPROG DO
|
|
52950 WITH BPRODTBL[PLPTR] DO
|
|
52960 BEGIN
|
|
52970 MATCH := TRUE;
|
|
52980 IF PRSTKA<3 THEN
|
|
52990 BEGIN
|
|
53000 STK := SRPLSTK[PLSTKP+PRSTKA];
|
|
53010 CASE PRSTKC OF
|
|
53020 S: MATCH := SYLXV.LX1IO = STK^.LXV.LXIO;
|
|
53030 C0: MATCH := SYLXV.LX1CL0 = STK^.LXV.LXCLASS0;
|
|
53040 C1: MATCH := SYLXV.LX1CL1 = STK^.LXV.LXCLASS1;
|
|
53050 C2: MATCH := SYLXV.LX1CL2 = STK^.LXV.LXCLASS2
|
|
53060 END
|
|
53070 END;
|
|
53080 IF MATCH THEN
|
|
53090 CASE PRINPC OF
|
|
53100 A: ;
|
|
53110 S: MATCH := SYLXV.LX2IO = INP^.LXV.LXIO;
|
|
53120 C0: MATCH := SYLXV.LX2CL0 = INP^.LXV.LXCLASS0;
|
|
53130 C1: MATCH := SYLXV.LX2CL1 = INP^.LXV.LXCLASS1;
|
|
53140 C2: MATCH := SYLXV.LX2CL2 = INP^.LXV.LXCLASS2;
|
|
53150 SSA: MATCH := SYLXV.LX2IO = SRPLSTK[PLSTKP+1]^.LXV.LXIO
|
|
53160 END;
|
|
53170 IF MATCH THEN
|
|
53180 IF RTN>FINISH THEN
|
|
53190 SEMANTICROUTINE(RTN);
|
|
53200 IF MATCH THEN
|
|
53210 BEGIN
|
|
53220 PLSTKP := PLSTKP+PRPOP;
|
|
53230 IF PRPUSH<>LXIODUMMY THEN
|
|
53240 BEGIN PLSTKP := PLSTKP-1; SRPLSTK[PLSTKP] := PUSHTBL[PRPUSH] END;
|
|
53250 IF PRSKIP THEN
|
|
53260 INP := PARSIN;
|
|
53270 FOR I := 1 TO PRSCAN DO
|
|
53280 BEGIN PLSTKP := PLSTKP-1; SRPLSTK[PLSTKP] := INP; INP := PARSIN END;
|
|
53290 PLPTR := SEXIT
|
|
53300 END
|
|
53310 ELSE
|
|
53320 PLPTR := FEXIT
|
|
53330 END
|
|
53340 END;
|
|
53350 (*+01() (*$T-+) ()+01*)
|
|
53360 (*+25() (*$T-+) ()+25*)
|
|
53370 PROCEDURE CLASSES;
|
|
53380 BEGIN
|
|
53390 HTCOPY := HT;
|
|
53400 (*+01() ENEW(FRED, SZWORD); (*TO MARK THE PRESENT HEAP LIMIT*) ()+01*)
|
|
53410 CLASS('CL00 '); CLASS('CL01 ');
|
|
53420 CLASS('CL10 '); CLASS('CL11 ');
|
|
53430 CLASS('CL12 '); CLASS('CL13 ');
|
|
53440 CLASS('CL14 ');
|
|
53450 CLASS('CL20 '); CLASS('CL21 ');
|
|
53460 CLASS('CL22 '); CLASS('CL23 ');
|
|
53470 CLASS('CL24 '); CLASS('CL25 ');
|
|
53480 CLASS('CL26 '); CLASS('CL27 ');
|
|
53490 CLASS('CL28 '); CLASS('CL29 ');
|
|
53500 CLASS('CL2A '); CLASS('CL2B ');
|
|
53510 CLASS('CL2C '); CLASS('CL2D ');
|
|
53520 CLASS('CL2E '); CLASS('CL2F ');
|
|
53530 CLASS('ANY ');
|
|
53540 END;
|
|
53550 PROCEDURE TLEXS;
|
|
53560 BEGIN
|
|
53570 TLEX('ACTPL ', LXIOACTPL);
|
|
53580 TLEX('ACTRL ', LXIOACTRL);
|
|
53590 TLEX('BOUNDS ', LXIOBOUNDS);
|
|
53600 TLEX('BRINPT ', LXIOBRINPT);
|
|
53610 TLEX('BRTHPT ', LXIOBRTHPT);
|
|
53620 TLEX('CSTICK ', LXIOCSTICK);
|
|
53630 TLEX('DCLL ', LXIODCLL);
|
|
53640 TLEX('FLDSPL ', LXIOFLDSPL);
|
|
53650 TLEX('FORDCL ', LXIOFORDCL);
|
|
53660 TLEX('FORRLB ', LXIOFORRLB);
|
|
53670 TLEX('IDEFL ', LXIOIDEFL);
|
|
53680 TLEX('LABSQ ', LXIOLABSQ);
|
|
53690 TLEX('MOIDDR ', LXIOMOIDDR);
|
|
53700 TLEX('NONRDR ', LXIONONRDR);
|
|
53710 TLEX('ODEFL ', LXIOODEFL);
|
|
53720 TLEX('OPRAND ', LXIOOPRAND);
|
|
53730 TLEX('PRIM ', LXIOPRIM);
|
|
53740 TLEX('PRMDRL ', LXIOPRMDRL);
|
|
53750 TLEX('RIDEFL ', LXIORIDEFL);
|
|
53760 TLEX('RODEFL ', LXIORODEFL);
|
|
53770 TLEX('RSPEC ', LXIORSPEC);
|
|
53780 TLEX('RVDEFL ', LXIORVDEFL);
|
|
53790 TLEX('TERT ', LXIOTERT);
|
|
53800 TLEX('TRMSCL ', LXIOTRMSCL);
|
|
53810 TLEX('UNITLC ', LXIOUNLC);
|
|
53820 TLEX('UNITLP ', LXIOUNLP);
|
|
53830 TLEX('UNITSR ', LXIOUNSR);
|
|
53840 TLEX('VDEFL ', LXIOVDEFL);
|
|
53850 TLEX('AGAIN ', LXIOAGAIN);
|
|
53860 TLEX('AT ', LXIOAT);
|
|
53870 TLEX('BEGIN ', LXIOBEGIN);
|
|
53880 TLEX('BOOLDEN ', LXIOBOOLDEN);
|
|
53890 TLEX('BUS ', LXIOBUS);
|
|
53900 TLEX('BY ', LXIOBY);
|
|
53910 TLEX('CASE ', LXIOCASE);
|
|
53920 TLEX('COMMA ', LXIOCOMMA);
|
|
53930 TLEX('COMMENT ', LXIOCMMENT);
|
|
53940 TLEX('DO ', LXIODO);
|
|
53950 TLEX('ELIF ', LXIOELIF);
|
|
53960 TLEX('ELSE ', LXIOELSE);
|
|
53970 TLEX('END ', LXIOEND);
|
|
53980 TLEX('ERROR ', LXIOERROR);
|
|
53990 TLEX('ESAC ', LXIOESAC);
|
|
54000 TLEX('EXIT ', LXIOEXIT);
|
|
54010 TLEX('FI ', LXIOFI);
|
|
54020 TLEX('FOR ', LXIOFOR);
|
|
54030 TLEX('FROM ', LXIOFROM);
|
|
54040 TLEX('GO ', LXIOGO);
|
|
54050 TLEX('GOTO ', LXIOGOTO);
|
|
54060 TLEX('HEAP ', LXIOHEAP);
|
|
54070 TLEX('IDTY ', LXIOIDTY);
|
|
54080 TLEX('IF ', LXIOIF);
|
|
54090 TLEX('IN ', LXIOIN);
|
|
54100 TLEX('LOC ', LXIOLOC);
|
|
54110 TLEX('LONG ', LXIOLONG);
|
|
54120 TLEX('MDIND ', LXIOMDIND);
|
|
54130 TLEX('MODE ', LXIOMODE);
|
|
54140 TLEX('NIL ', LXIONIL);
|
|
54150 TLEX('OD ', LXIOOD);
|
|
54160 TLEX('OF ', LXIOOF);
|
|
54170 TLEX('OP ', LXIOOP);
|
|
54180 TLEX('OPR ', LXIOOPR);
|
|
54190 TLEX('OTHDR ', LXIOOTHDR);
|
|
54200 TLEX('OUSE ', LXIOOUSE);
|
|
54210 TLEX('OUT ', LXIOOUT);
|
|
54220 TLEX('PRAGMAT ', LXIOPRAGMAT);
|
|
54230 TLEX('PRIMDR ', LXIOPRDR);
|
|
54240 TLEX('PRIO ', LXIOPRIO);
|
|
54250 TLEX('PROC ', LXIOPROC);
|
|
54260 TLEX('REF ', LXIOREF);
|
|
54270 TLEX('SHORT ', LXIOSHORT);
|
|
54280 TLEX('SKIP ', LXIOSKIP);
|
|
54290 TLEX('START ', LXIOSTART);
|
|
54300 TLEX('STICK ', LXIOSTICK);
|
|
54310 TLEX('STRGDEN ', LXIOSTRGDEN);
|
|
54320 TLEX('STRUCT ', LXIOSTRUCT);
|
|
54330 TLEX('SUB ', LXIOSUB);
|
|
54340 TLEX('TAB ', LXIOTAB);
|
|
54350 TLEX('TAG ', LXIOTAG);
|
|
54360 TLEX('THEN ', LXIOTHEN);
|
|
54370 TLEX('TO ', LXIOTO);
|
|
54380 TLEX('VOID ', LXIOVOID);
|
|
54390 TLEX('WHILE ', LXIOWHILE);
|
|
54400 TLEX('BECOM ', LXIOBECOM);
|
|
54410 TLEX('CLOSE ', LXIOCLOSE);
|
|
54420 TLEX('COLON ', LXIOCOLON);
|
|
54430 TLEX('EQUAL ', LXIOEQUAL);
|
|
54440 TLEX('OPEN ', LXIOOPEN);
|
|
54450 TLEX('PRIMDEN ', LXIOPRDEN);
|
|
54460 TLEX('SEMIC ', LXIOSEMIC);
|
|
54470 TLEX('STOP ', LXIOSTOP);
|
|
54480 END;
|
|
54490 (*+01() (*+31() (*$T++) ()+31+) ()+01*)
|
|
54500 (*+25() (*+31() (*$T++) ()+31+) ()+25*)
|
|
54510 BEGIN (*PARSEPARSER*)
|
|
54520 CLASSES;
|
|
54530 TLEXS;
|
|
54540 (*FLOYD PRODUCTION RULES WHICH WERE USED WITH THE OLD VERSION OF SEMANTICROUTINE GIVEN ABOVE
|
|
54550 TO PRODUCE THE CALLS OF BMPROD AND BLABL WHICH FOLLOW*)
|
|
54560 (*
|
|
54570 BEGIN: ! => , ! + INIT;
|
|
54580 INIT: ! => , ! + PRODRL;
|
|
54590 PRODRL: STOP@! => 36 ,1-> ! APRODRL;
|
|
54600 APRODRL: TAG@!COLON@ => 34 ,1-> ! (1) + ALABEL;
|
|
54610 ALABEL: ! => 10 , ! BLABEL;
|
|
54620 BLABEL: TAG@!AT@ => 11 ,1-> ! (1) COMMA;
|
|
54630 TAB@! => 12 ,1-> ! COMMA;
|
|
54640 TAG@! => 11 ,1-> ! COMMA;
|
|
54650 STICK@! => 13 ,1-> ! + ASTICK,ERROR;
|
|
54660 COMMA: !COMMA@ => 14 , ! (1) + BLABEL;
|
|
54670 STICK: !STICK@ => 15 , ! (1) + ASTICK,ERROR;
|
|
54680 ASTICK: TAG@!AT@ => 11 ,1-> ! (1) + EQUAL;
|
|
54690 TAB@! => 12 ,1-> ! + EQUAL;
|
|
54700 TAG@! => 11 ,1-> ! + EQUAL;
|
|
54710 EQUAL@! => 35 , ! EQUAL;
|
|
54720 EQUAL: EQUAL@!OPR@ => ,1-> ! (1) + AEQUAL,ERROR;
|
|
54730 AEQUAL: TAG@!OPR@ => 16 , ! (1) FSEM;
|
|
54740 ! => 17 , ! ASEM;
|
|
54750 ASEM: OPR@! => ,1-> ! + ASEM2;
|
|
54760 ASEM2: COMMA@!PRIMDEN@ => 18 ,1-> ! (1) ++ PUSH;
|
|
54770 STICK2: COMMA@!STICK@ => 19 ,1-> ! ++ ASTICK2,ERROR;
|
|
54780 PUSH: OPR@,ANY!TAG@ => 20 ,2-> ! (1) ++ ASTICK2;
|
|
54790 OPR@,ANY!STICK@ => 21 ,2-> ! ++ ASTICK2,ERROR;
|
|
54800 ASTICK2: OPEN@!PRIMDEN@ => 22 ,2-> ! (1) ++ STAR;
|
|
54810 ! => 23 , ! STAR;
|
|
54820 STAR: OPR@!OPR@ => 24 ,1-> ! (1) + SEX;
|
|
54830 OPR@! => 25 ,1-> ! + SEX;
|
|
54840 ! => 26 , ! SEX;
|
|
54850 SEX: TAG@! => 28 ,2-> ! + FEX,ERROR;
|
|
54860 FEX: COMMA@!TAG@ => 29 ,1-> ! (1) + SEMI;
|
|
54870 ! => 30 , ! SEMI;
|
|
54880 SEMI: SEMIC@! => 31 ,1-> ! INIT;
|
|
54890 ERROR: START@! => 32 , ! ERR;
|
|
54900 ! => ,1-> ! ERROR;
|
|
54910 ERR: !SEMIC@ => 31 , ! (1) INIT;
|
|
54920 !STOP@ => 36 ,1-> ! ERROR;
|
|
54930 ! => , ! (1) ERR;
|
|
54940 FSEM: TAG@!PRSMDEN@ => 16 ,1-> ! (1) + ASEM,ERROR;
|
|
54950 *)
|
|
54960 BMPROD( 1, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 00 , 0, LXIODUMMY , FALSE, 1, 0, 2);
|
|
54970 BLABL( 1, 0, 2);
|
|
54980 BMPROD( 2, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 00 , 0, LXIODUMMY , FALSE, 1, 0, 3);
|
|
54990 BLABL( 2, 0, 3);
|
|
55000 BMPROD( 3, S , LXIOSTOP , 0, 0, A , LXIODUMMY , 0, 36 , 1, LXIODUMMY , FALSE, 0, 0, 4);
|
|
55010 BLABL( 3, 0, 4);
|
|
55020 BMPROD( 4, S , LXIOTAG , 0, 0, S , LXIOCOLON , 0, 34 , 1, LXIODUMMY , TRUE , 1, 0, 5);
|
|
55030 BLABL( 4, 0, 5);
|
|
55040 BMPROD( 5, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 10 , 0, LXIODUMMY , FALSE, 0, 0, 6);
|
|
55050 BLABL( 5, 0, 6);
|
|
55060 BMPROD( 6, S , LXIOTAG , 0, 0, S , LXIOAT , 0, 11 , 1, LXIODUMMY , TRUE , 0, 0, 7);
|
|
55070 BMPROD( 7, S , LXIOTAB , 0, 0, A , LXIODUMMY , 0, 12 , 1, LXIODUMMY , FALSE, 0, -6, 8);
|
|
55080 BMPROD( 8, S , LXIOTAG , 0, 0, A , LXIODUMMY , 0, 11 , 1, LXIODUMMY , FALSE, 0, -7, 9);
|
|
55090 BMPROD( 9, S , LXIOSTICK , 0, 0, A , LXIODUMMY , 0, 13 , 1, LXIODUMMY , FALSE, 1, 0, 0);
|
|
55100 BLABL( 8, 0, 10);
|
|
55110 BMPROD( 10, S , LXIODUMMY , 0, 3, S , LXIOCOMMA , 0, 14 , 0, LXIODUMMY , TRUE , 1, 6, 11);
|
|
55120 BMPROD( 11, S , LXIODUMMY , 0, 3, S , LXIOSTICK , 0, 15 , 0, LXIODUMMY , TRUE , 1, -9, -9);
|
|
55130 BLABL( 11, 0, 12);
|
|
55140 BMPROD( 12, S , LXIOTAG , 0, 0, S , LXIOAT , 0, 11 , 1, LXIODUMMY , TRUE , 1, 0, 13);
|
|
55150 BMPROD( 13, S , LXIOTAB , 0, 0, A , LXIODUMMY , 0, 12 , 1, LXIODUMMY , FALSE, 1, -12, 14);
|
|
55160 BMPROD( 14, S , LXIOTAG , 0, 0, A , LXIODUMMY , 0, 11 , 1, LXIODUMMY , FALSE, 1, -13, 15);
|
|
55170 BMPROD( 15, S , LXIOEQUAL , 0, 0, A , LXIODUMMY , 0, 35 , 0, LXIODUMMY , FALSE, 0, -14, 16);
|
|
55180 BLABL( 15, 0, 16);
|
|
55190 BMPROD( 16, S , LXIOEQUAL , 0, 0, S , LXIOOPR , 0, 00 , 1, LXIODUMMY , TRUE , 1, 0, -11);
|
|
55200 BLABL( 16, 0, 17);
|
|
55210 BMPROD( 17, S , LXIOTAG , 0, 0, S , LXIOOPR , 0, 00 , 0, LXIODUMMY , TRUE , 0, 0, 18);
|
|
55220 BMPROD( 18, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 17 , 0, LXIODUMMY , FALSE, 0, 0, 19);
|
|
55230 BLABL( 18, 0, 19);
|
|
55240 BMPROD( 19, S , LXIOOPR , 0, 0, A , LXIODUMMY , 0, 00 , 1, LXIODUMMY , FALSE, 1, 0, 20);
|
|
55250 BLABL( 19, 0, 20);
|
|
55260 BMPROD( 20, S , LXIOCOMMA , 0, 0, S , LXIOPRDEN , 0, 18 , 1, LXIODUMMY , TRUE , 2, 0, 21);
|
|
55270 BMPROD( 21, S , LXIOCOMMA , 0, 0, S , LXIOSTICK , 0, 19 , 1, LXIODUMMY , FALSE, 2, 0, -16);
|
|
55280 BLABL( 20, 0, 22);
|
|
55290 BMPROD( 22, S , LXIOOPR , 0, 1, S , LXIOTAG , 0, 20 , 2, LXIODUMMY , TRUE , 2, -21, 23);
|
|
55300 BMPROD( 23, S , LXIOOPR , 0, 1, S , LXIOSTICK , 0, 21 , 2, LXIODUMMY , FALSE, 2, -22, -21);
|
|
55310 BLABL( 23, 0, 24);
|
|
55320 BMPROD( 24, S , LXIOOPEN , 0, 0, S , LXIOPRDEN , 0, 22 , 2, LXIODUMMY , TRUE , 2, 0, 25);
|
|
55330 BMPROD( 25, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 23 , 0, LXIODUMMY , FALSE, 0, -24, 26);
|
|
55340 BLABL( 25, 0, 26);
|
|
55350 BMPROD( 26, S , LXIOOPR , 0, 0, S , LXIOOPR , 0, 24 , 1, LXIODUMMY , TRUE , 1, 0, 27);
|
|
55360 BMPROD( 27, S , LXIOOPR , 0, 0, A , LXIODUMMY , 0, 25 , 1, LXIODUMMY , FALSE, 1, -26, 28);
|
|
55370 BMPROD( 28, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 26 , 0, LXIODUMMY , FALSE, 0, -27, 29);
|
|
55380 BLABL( 28, 0, 29);
|
|
55390 BMPROD( 29, S , LXIOTAG , 0, 0, A , LXIODUMMY , 0, 28 , 2, LXIODUMMY , FALSE, 1, 0, -23);
|
|
55400 BLABL( 29, 0, 30);
|
|
55410 BMPROD( 30, S , LXIOCOMMA , 0, 0, S , LXIOTAG , 0, 29 , 1, LXIODUMMY , TRUE , 1, 0, 31);
|
|
55420 BMPROD( 31, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 30 , 0, LXIODUMMY , FALSE, 0, -30, 32);
|
|
55430 BLABL( 31, 0, 32);
|
|
55440 BMPROD( 32, S , LXIOSEMIC , 0, 0, A , LXIODUMMY , 0, 31 , 1, LXIODUMMY , FALSE, 0, 2, 33);
|
|
55450 BLABL( 0, 29, 33);
|
|
55460 BMPROD( 33, S , LXIOSTART , 0, 0, A , LXIODUMMY , 0, 32 , 0, LXIODUMMY , FALSE, 0, 0, 34);
|
|
55470 BMPROD( 34, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 00 , 1, LXIODUMMY , FALSE, 0, 33, 35);
|
|
55480 BLABL( 33, 0, 35);
|
|
55490 BMPROD( 35, S , LXIODUMMY , 0, 3, S , LXIOSEMIC , 0, 31 , 0, LXIODUMMY , TRUE , 0, 2, 36);
|
|
55500 BMPROD( 36, S , LXIODUMMY , 0, 3, S , LXIOSTOP , 0, 36 , 1, LXIODUMMY , FALSE, 0, 33, 37);
|
|
55510 BMPROD( 37, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 00 , 0, LXIODUMMY , TRUE , 0, 35, 38);
|
|
55520 BLABL( 17, 0, 38);
|
|
55530 BMPROD( 38, S , LXIOTAG , 0, 0, S , LXIOPRDEN , 0, 16 , 1, LXIODUMMY , TRUE , 1, 19, 33);
|
|
55540 ERRS := 0; INITIO; INITLX; INITPR;
|
|
55550 PRAGFLGS := PRAGFLGS + [PRGPOINT] - [PRGUPPER];
|
|
55560 BCOUNT := 1;
|
|
55570 CCOUNT := 0;
|
|
55580 PARSER;
|
|
55590 IF CCOUNT<>0 THEN WRITELN(LSTFILE,'CCOUNT ERROR', CCOUNT);
|
|
55600 WRITELN(LSTFILE,'LAST PROD', BCOUNT-1);
|
|
55610 (*+01() J := GETB(4); ()+01*)
|
|
55620 FOR I := 0 TO HTSIZE DO (*GET RID OF ALL UNWANTED LEXEMES*)
|
|
55630 BEGIN THIS := HT[I];
|
|
55640 WHILE THIS<>HTCOPY[I] DO
|
|
55650 BEGIN
|
|
55660 THAT := THIS^.LINK;
|
|
55670 EDISPOSE(THIS, THIS^.LXCOUNT*SZWORD+LEX1SIZE);
|
|
55680 THIS := THAT;
|
|
55690 END;
|
|
55700 END;
|
|
55710 HT := HTCOPY; (*RESTORE HT TO STATE BEFORE FRED*)
|
|
55720 (*+01()
|
|
55730 FOR I := J TO ORD(FRED) DO
|
|
55740 BEGIN FRIG.INT := I; FRIG.POINT^ := 0 END;
|
|
55750 ()+01*)
|
|
55760 END;
|
|
55770 (**)
|
|
55780 ()+82*)
|