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