1060 lines
40 KiB
OpenEdge ABL
1060 lines
40 KiB
OpenEdge ABL
82000 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
|
82010 (*+83()
|
|
82020 (**)
|
|
82030 (*+21()
|
|
82040 PROCEDURE MONITORSEMANTIC(SRTN: RTNTYPE);
|
|
82050 BEGIN
|
|
82060 WRITE(OUTPUT, LSTLINE:5, PLSTKP:3, RTSTKDEPTH:4, ' S ', SRTN:3);
|
|
82070 (*+01() WRITELN(OUTPUT, SRSEMP:4,SRSUBP:4,' ', ORD(SRSTK[SRSEMP].SB):6OCT, ' ', ORD(RTSTACK):6OCT) ()+01*)
|
|
82080 (*-01() IF SRSEMP<0 THEN WRITELN(OUTPUT)
|
|
82090 ELSE WRITELN(OUTPUT, SRSEMP:4,SRSUBP:4,' ',ORD(SRSTK[SRSEMP].SB):6,' ',ORD(RTSTACK):6) ()-01*)
|
|
82100 END;
|
|
82110 ()+21*)
|
|
82120 (**)
|
|
82130 (**)
|
|
82140 PROCEDURE SEMANTICROUTINE(SRTN: RTNTYPE);
|
|
82150 (*FUNCTION: CALLS THE SEMANTIC ROUTINE SPECIFIED BY THE PARSER*)
|
|
82160 (*-53()
|
|
82170 LABEL 759;
|
|
82180 ()-53*)
|
|
82190 VAR STB1: PSTB;
|
|
82200 LEX1: PLEX;
|
|
82210 SB, SBB: PSB;
|
|
82220 R: PRANGE;
|
|
82230 M, FLDM: MODE;
|
|
82240 SECDRY: 0..3;
|
|
82250 OFFST: OFFSETR;
|
|
82260 ROWCOUNT: CNTR;
|
|
82270 I, J: INTEGER;
|
|
82280 L: LABL;
|
|
82290 PTR: PTRIMCHAIN;
|
|
82300 REFED: BOOLEAN;
|
|
82310 (*+53()
|
|
82320 PROCEDURE MONITOR1;
|
|
82330 VAR I: INTEGER;
|
|
82340 ()+53*)
|
|
82350 BEGIN
|
|
82360 IF SRTN>=ESY01 THEN
|
|
82370 BEGIN
|
|
82380 FOR I := ERRPTR+1 TO ERRLXPTR-1 DO ERRBUF[I] := ERRCHAR;
|
|
82390 IF ERRPTR<ERRLXPTR THEN ERRPTR := ERRLXPTR-1;
|
|
82400 OUTERR(SRTN-ESY01+ESY+1, ERRORR, NIL);
|
|
82410 END
|
|
82420 ELSE BEGIN
|
|
82430 (*+21()
|
|
82440 MONITORSEMANTIC(SRTN);
|
|
82450 ()+21*)
|
|
82460 CASE SRTN OF
|
|
82470 (**)
|
|
82480 10: (*SR01*)
|
|
82490 BEGIN SRSEMP := SRSEMP+1; SRSTK[SRSEMP].SB := SRPLSTK[PLSTKP]^.LXV.LXPSB END;
|
|
82500 (**)
|
|
82510 11: (*SR02*)
|
|
82520 (*LONG/SHORT*)
|
|
82530 SRSTK[SRSEMP].MD := LENGTHEN(INP^.LXV.LXPMD, SRSTK[SRSEMP].SUBP);
|
|
82540 (**)
|
|
82550 12: (*SR03A*)
|
|
82560 (*LONG*)
|
|
82570 BEGIN SRSEMP := SRSEMP+1; SRSTK[SRSEMP].SUBP := 1 END;
|
|
82580 (**)
|
|
82590 13: (*SR03B*)
|
|
82600 (*SHORT*)
|
|
82610 BEGIN SRSEMP := SRSEMP+1; SRSTK[SRSEMP].SUBP := -1 END;
|
|
82620 (**)
|
|
82630 14: (*SR04A*)
|
|
82640 (*LONG AND FORMAL-ROWERS*)
|
|
82650 WITH SRSTK[SRSEMP] DO SUBP := SUBP+1;
|
|
82660 (**)
|
|
82670 15: (*SR04B*)
|
|
82680 (*SHORT*)
|
|
82690 WITH SRSTK[SRSEMP] DO SUBP := SUBP-1;
|
|
82700 (**)
|
|
82710 16: (*SR05*)
|
|
82720 (*FUNCTION: CREATES A MODE TABLE ENTRY HAVING PARSED A .REF TO MODE DECLARATOR*)
|
|
82730 WITH SRSTK[SRSEMP] DO MD := FINDREF(MD);
|
|
82740 (**)
|
|
82750 17: (*SR06*)
|
|
82760 (*FUNCTION: EXECUTED AFTER ROUTINE-SPECIFICATION OF ROUTINE-TEXT WITHOUT PARAMETERS*)
|
|
82770 BEGIN
|
|
82780 ROUTNNT;
|
|
82790 CGRTA;
|
|
82800 M := SRPOPMD;
|
|
82810 SUBSAVE (*BECAUSE FINDPRC DOES A SUBREST*);
|
|
82820 FINDPRC(M, 0, PROC);
|
|
82830 END;
|
|
82840 (**)
|
|
82850 18: (*SR07A*)
|
|
82860 (*FIRST FIELD-SELECTOR AFTER DECLARER*)
|
|
82870 NEWFIELD(SRPLSTK[PLSTKP]);
|
|
82880 (**)
|
|
82890 19: (*SR07B*)
|
|
82900 (*SUBSEQUENT FIELD-SELECTORS*)
|
|
82910 BEGIN
|
|
82920 SRSTK[SRSEMP+1] := SRSTK[SRSEMP-1]; SRSEMP := SRSEMP+1;
|
|
82930 NEWFIELD(INP)
|
|
82940 END;
|
|
82950 (**)
|
|
82960 20: (*SR08A*)
|
|
82970 BEGIN
|
|
82980 DCLMODE := SRSTK[SRSEMP].MD;
|
|
82990 DCLDEFN := [STINIT (*FOR STDIDTY*)];
|
|
83000 DEFID(SRPLSTK[PLSTKP])
|
|
83010 END;
|
|
83020 (**)
|
|
83030 21: (*SR08B*)
|
|
83040 BEGIN
|
|
83050 SRSEMP := SRSEMP+1; SRSTK[SRSEMP] := SRSTK[SRSEMP-1];
|
|
83060 DEFID(INP)
|
|
83070 END;
|
|
83080 (**)
|
|
83090 22: (*SR10*)
|
|
83100 (*FUNCTION: BEFORE FIELD(PARAMETER) OF .STRUCT (.PROC) DECLARER*)
|
|
83110 SUBSAVE;
|
|
83120 (**)
|
|
83130 23: (*SR11*)
|
|
83140 (*FUNCTION: CREATES A MODE TABLE ENTRY HAVING PARSED A STRUCTURED
|
|
83150 WITH FIELDS MODE DECLARATOR
|
|
83160 *)
|
|
83170 FINSTRUCT((SRSEMP-SRSUBP) DIV 2);
|
|
83180 (**)
|
|
83190 24: (*SR12*)
|
|
83200 (*FUNCTION: START ROWED-ACTUAL-DECLARER IN VARIABLE-DECLARATION OR SOME GENERATORS*)
|
|
83210 BEGIN BRKASCR; SB:=MAKESUBSTACK(0, MDBNDS) END;
|
|
83220 (**)
|
|
83230 25: (*SR14A*)
|
|
83240 (*FORMAL*)
|
|
83250 BEGIN SRSEMP := SRSEMP-1; SRSTK[SRSEMP].MD := FINDROW(SRSTK[SRSEMP+1].MD, SRSTK[SRSEMP].SUBP) END;
|
|
83260 (**)
|
|
83270 26: (*SR14B*)
|
|
83280 (*FUNCTION: EXECUTED AFTER AN ACTUAL-ROWER-LIST-BRACKET*)
|
|
83290 BEGIN
|
|
83300 J := (SRSEMP-SRSUBP) DIV 2;
|
|
83310 CGACTBNDS(SRSTK[SRSUBP-1].SB,J); (*LOADS BOUNDS INTO SB*)
|
|
83320 POPUNITS
|
|
83330 END;
|
|
83340 (**)
|
|
83350 27: (*SR14C*)
|
|
83360 (*FUNCTION: EXECUTED AFTER AN ACTUAL-DECLARER*)
|
|
83370 WITH SRSTK[SRSEMP] DO
|
|
83380 MD := FINDROW(MD, SRSTK[SRSEMP-1].SB^.SBLOCRG);
|
|
83390 (**)
|
|
83400 28: (*SR15*)
|
|
83410 (*FUNCTION: CREATES A MODE TABLE ENTRY HAVING PARSED A PROCEDURE DECLARATOR*)
|
|
83420 BEGIN
|
|
83430 M := SRPOPMD;
|
|
83440 FINDPRC(M, SRSEMP-SRSUBP, PROC);
|
|
83450 END;
|
|
83460 (**)
|
|
83470 29: (*SR16A*)
|
|
83480 BEGIN DCLMODE := SRPOPMD; DCLDEFN := [STINIT (*FOR STDIDTY*)] END;
|
|
83490 (**)
|
|
83500 30: (*SR16B*)
|
|
83510 (*FUNCTION: EXECUTED AFTER DECLARER IN VARIABLE-DECLARATION*)
|
|
83520 BEGIN DCLMODE := SRPOPMD; DCLDEFN := [STVAR] END;
|
|
83530 (**)
|
|
83540 31: (*SR16C*)
|
|
83550 BEGIN DCLMODE := MDROUT; DCLDEFN := [STINIT (*FOR STDIDTY*)] END;
|
|
83560 (**)
|
|
83570 32: (*SR16D*)
|
|
83580 BEGIN DCLMODE := PRCBNDS; DCLDEFN := [STINIT (*FOR STDIDTY*)] END;
|
|
83590 (**)
|
|
83600 33: (*SR17*)
|
|
83610 (*FUNCTION: EXECUTED WHEN A VARIABLE-DEFINITION IS NOT PRECEDED BY .LOC*)
|
|
83620 OUTERR(ESE+73, WARNING, NIL);
|
|
83630 (**)
|
|
83640 34: (*SR20A*)
|
|
83650 (*FUNCTION: EXECUTED AT THE BEGINNING OF ANY RANGE EXCEPT A ROUTINE-TEXT.
|
|
83660 PERFORMS RANGE ENTRY FUNCTIONS. MARKS STACK FOR BEGINNING OF A BALANCE.
|
|
83670 THE BALANCE IS THE ESTABLISHING-CLAUSE WHICH STARTS ALL SUCH RANGES.
|
|
83680 *)
|
|
83690 BEGIN RANGENT; SUBSAVE END;
|
|
83700 (**)
|
|
83710 35: (*SR20B*)
|
|
83720 (*FUNCTION: EXECUTED AT THE END OF A CONDITIONAL- OR CASE-CHOOSER*)
|
|
83730 BEGIN RGINFO := RGINFO+[DCLDELAY]; RANGEXT; SEMANTICROUTINE(43) (*SR22A*) END;
|
|
83740 (**)
|
|
83750 36: (*SR20C*)
|
|
83760 (*FUNCTION: EXECUTED WHEN AN ELSE-PART-OPTION OR OUT-PART-OPTION IS EMPTY.
|
|
83770 THE NET EFFECT IS TO ACT AS THOUGH THE OMITTED OPTION WAS .SKIP.
|
|
83780 *)
|
|
83790 BEGIN SB := PUSHSB(MDSKIP);
|
|
83800 SEMANTICROUTINE(43) (*SR22A*)
|
|
83810 END;
|
|
83820 (**)
|
|
83830 37: (*SR20DB*)
|
|
83840 (*FUNCTION: EXECUTED AFTER ENQUIRY-CLAUSE OF CONDITIONAL-CHOOSER*)
|
|
83850 BEGIN
|
|
83860 IF DCLLABEL IN RGINFO THEN SEMERR(ESE+02);
|
|
83870 MEEKLOAD(MDBOOL, ESE+34);
|
|
83880 CGIFA;
|
|
83890 DISPOSE(SRSTK[SRSEMP].SB); SRSEMP := SRSEMP-1; SUBSAVE;
|
|
83900 SEMANTICROUTINE(34) (*SR20A*)
|
|
83910 END;
|
|
83920 (**)
|
|
83930 38: (*SR20DI*)
|
|
83940 (*FUNCTION: EXECUTED AFTER ENQUIRY-CLAUSE OF CASE-CHOOSER*)
|
|
83950 BEGIN
|
|
83960 IF DCLLABEL IN RGINFO THEN SEMERR(ESE+02);
|
|
83970 MEEKLOAD(MDINT, ESE+35);
|
|
83980 CGCASA;
|
|
83990 DISPOSE(SRSTK[SRSEMP].SB); SRSEMP := SRSEMP-1; SUBSAVE;
|
|
84000 (*SEMANTICROUTINE(34) (*SR20A *)
|
|
84010 END;
|
|
84020 (**)
|
|
84030 39: (*SR20EB*)
|
|
84040 (*FUNCTION: EXECUTED AFTER A THEN-PART OF A CONDITIONAL-ALTERNATIVES*)
|
|
84050 BEGIN
|
|
84060 RGINFO := RGINFO+[DCLDELAY]; RANGEXT;
|
|
84070 INNERBAL;
|
|
84080 ASSIGNFLAD;
|
|
84090 CGFLINE;
|
|
84100 SEMANTICROUTINE(34) (*SR20A*)
|
|
84110 END;
|
|
84120 (**)
|
|
84130 40: (*SR20EI*)
|
|
84140 (*FUNCTION: START ROWED-ACTUAL-DECLARER IN GENERATOR*)
|
|
84150 SB:=MAKESUBSTACK(0, MDBNDS);
|
|
84160 (**)
|
|
84170 41: (*SR20F*)
|
|
84180 (*FUNCTION: EXECUTED AFTER EACH UNIT IN THE IN-PART OF A CASE-ALTERNATIVES*)
|
|
84190 BEGIN INNERBAL; MARK(FIXUPM); CGFLINE END;
|
|
84200 (**)
|
|
84210 42: (*SR20G*)
|
|
84220 (*FUNCTION: PERFORMS FINAL PROCESSING OF CASE-CLAUSE*)
|
|
84230 BEGIN SEMANTICROUTINE(35) (*SR20B*); CGCASC END;
|
|
84240 (**)
|
|
84250 43: (*SR22A*)
|
|
84260 (*FUNCTION: EXECUTED AFTER PROCESSING THE LAST UNIT OF A BALANCE.
|
|
84270 NOTE THAT HERE BALANCES INCLUDE CONDITIONAL-, CASE- AND ESTABLISHING-CLAUSES.
|
|
84280 AN ENQUIRY-CLAUSE DOES NOT REALLY REQUIRE BALANCING BUT THE PARSER DOES NOT DISTINGUISH
|
|
84290 BETWEEN THE TWO KINDS OF ESTABLISHING-CLAUSES (ENQUIRY- AND SERIAL-).
|
|
84300 THUS, ENQUIRY-CLAUSES ARE TREATED AS SERIAL-CLAUSES EVEN THOUGH THE YIELD IS
|
|
84310 ALWAYS THE LAST UNIT.
|
|
84320 *)
|
|
84330 BEGIN LASTIBAL; SETBALFLAG END;
|
|
84340 (**)
|
|
84350 44: (*SR22B*)
|
|
84360 (*FUNCTION: EXECUTED AFTER ENCLOSED-CLAUSE OF PROGRAM OR PRIMARY.
|
|
84370 *)
|
|
84380 BEGIN RGINFO := RGINFO+[DCLDELAY]; RANGEXT END;
|
|
84390 (**)
|
|
84400 45: (*SR23*)
|
|
84410 (*FUNCTION: EXECUTED AFTER ENCLOSED-CLAUSE OF A CAST*)
|
|
84420 BEGIN STRONG;
|
|
84430 WITH SRSTK[SRSEMP].SB^ DO SBINF := SBINF-[SBMORF, SBVOIDWARN, SBCOLL];
|
|
84440 RANGEXT
|
|
84450 END;
|
|
84460 (**)
|
|
84470 46: (*SR24*)
|
|
84480 (*FUNCTION: EXECUTED AFTER UNIT FOLLOWED BY A COMPLETER IN A SERIAL-CLAUSE*)
|
|
84490 INNERBAL;
|
|
84500 (**)
|
|
84510 47: (*SR25A1*)
|
|
84520 (*FUNCTION: EXECUTED AFTER NON-EMPTY FOR-PART.*)
|
|
84530 PUTLOOP(INP);
|
|
84540 (**)
|
|
84550 48: (*25A2*)
|
|
84560 (*FUNCTION: EXECUTED AFTER EMPTY FOR-PART WHEN COUNTING-PART IS NON-EMPTY.*)
|
|
84570 PUTLOOP(LEXALEPH);
|
|
84580 (**)
|
|
84590 49: (*SR25B1*)
|
|
84600 (*FUNCTION: EXECUTED AFTER NON-EMPTY FROM- BY- OR TO-PART.*)
|
|
84610 MEEKLOAD(MDINT, ESE+39);
|
|
84620 (**)
|
|
84630 50: (*SR25B2*)
|
|
84640 (*FUNCTION: EXECUTED AFTER EMPTY FROM-PART WHEN COUNTING-PART IS NON-EMPTY.*)
|
|
84650 BEGIN PUTDEN(LEXONE); SEMANTICROUTINE(49) (*SR25B1*) END;
|
|
84660 (**)
|
|
84670 51: (*SPARE*);
|
|
84680 (**)
|
|
84690 52: (*SR25B3*)
|
|
84700 (*FUNCTION: EXECUTED AFTER EMPTY TO-PART WHEN COUNTING PART IS NON-EMPTY*)
|
|
84710 BEGIN
|
|
84720 WITH SRSTK[SRSUBP-1].SB^ DO SBINF := SBINF+[SBEMPTYTO]
|
|
84730 END;
|
|
84740 (**)
|
|
84750 53: (*SR25B5*)
|
|
84760 (*FUNCTION: EXECUTED AFTER EMPTY BY-PART WHEN COUNTING PART IS NON-EMPTY*)
|
|
84770 WITH SRSTK[SRSUBP-1].SB^ DO SBINF := SBINF+[SBEMPTYBY];
|
|
84780 (**)
|
|
84790 54: (*SR26A*)
|
|
84800 (*FUNCTION: EXECUTED BEFORE WHILE-PART, OR BEFORE DO-PART IF NONE.*)
|
|
84810 BEGIN WITH SRSTK[SRSUBP-1] DO WITH SB^ DO
|
|
84820 BEGIN
|
|
84830 RANGENT; (*START RANGE OF LOOPCLAUSE - MATCHED IN S-44*)
|
|
84840 LEX1 := SBLEX;
|
|
84850 IF LEX1<>NIL THEN
|
|
84860 BEGIN
|
|
84870 RGINFO := RGINFO+[DCLLOOP];
|
|
84880 CGFIXRG;
|
|
84890 SBOFFSET := ALLOC(SZWORD); (*DECMARKER*)
|
|
84900 IF NOT(SBEMPTYBY IN SBINF) THEN I := ALLOC(SZINT); (*BY PART*)
|
|
84910 STB1 := GETSTB(LEX1, [STINIT (*FOR STDIDTY*)], STBDEFID);
|
|
84920 WITH STB1^ DO
|
|
84930 BEGIN STMODE := MDINT; STOFFSET := ALLOC(SZINT); (*FROM PART*)
|
|
84932 (*+41() SBOFFSET := STOFFSET+SZINT; (*OFFSET OF 'TO' PART*) ()+41*)
|
|
84940 IF SBEMPTYTO IN SBINF THEN
|
|
84950 CGLPC(SB)
|
|
84960 ELSE
|
|
84970 BEGIN I := ALLOC(SZINT) (*TO PART*); CGLPB(SB) END
|
|
84980 END
|
|
84990 END
|
|
85000 ELSE CGLPA(SB);
|
|
85010 POPUNITS;
|
|
85020 CGFLINE;
|
|
85030 SEMANTICROUTINE(34) (*SR20A*) (*START RANGE OF WHILE-PART ( OR DO-PART ) *)
|
|
85040 END
|
|
85050 END;
|
|
85060 (**)
|
|
85070 55: (*SR26B*)
|
|
85080 (*FUNCTION: EXECUTED BEFORE WHILE-PART AFTER EMPTY COUNTING-PART.*)
|
|
85090 BEGIN PUTLOOP(NIL); SEMANTICROUTINE(54) (*SR26A*) END;
|
|
85100 (**)
|
|
85110 56: (*SR26C*)
|
|
85120 (*FUNCTION: EXECUTED AFTER WHILE-DO-PART WITH NON-EMPTY WHILE-PART.*)
|
|
85130 BEGIN ASSIGNFLAD; RANGEXT END; (*END RANGE OF WHILE-PART*)
|
|
85140 (**)
|
|
85150 57: (*SR27A*)
|
|
85160 (*FUNCTION: EXECUTED BEFORE DO-PART AFTER NON-EMPTY WHILE-PART.*)
|
|
85170 BEGIN
|
|
85180 IF DCLLABEL IN RGINFO THEN SEMERR(ESE+02);
|
|
85190 MEEKLOAD(MDBOOL, ESE+36);
|
|
85200 CGLPD;
|
|
85210 DISPOSE(SRSTK[SRSEMP].SB); SRSEMP := SRSEMP-1;
|
|
85220 SCPUSH(MDVOID);
|
|
85230 SEMANTICROUTINE(34) (*SR20A*) (*START RANGE OF DO-PART*)
|
|
85240 END;
|
|
85250 (**)
|
|
85260 58: (*SR27B1*)
|
|
85270 (*FUNCTION: EXECUTED BEFORE DO-PART AFTER EMPTY WHILE-PART AND NON-EMPTY COUNTING-PART.*)
|
|
85280 BEGIN SEMANTICROUTINE(54) (*SR26A*); SCPUSH(MDVOID) END;
|
|
85290 (**)
|
|
85300 59: (*SR27B2*)
|
|
85310 (*FUNCTION: EXECUTED BEFORE DO-PART AFTER EMPTY-WHILE-PART AND EMPTY COUNTING-PART.*)
|
|
85320 BEGIN PUTLOOP(NIL); SEMANTICROUTINE(58) (*SR27B1*) END;
|
|
85330 (**)
|
|
85340 60: (*SR27C*)
|
|
85350 (*FUNCTION: EXECUTED AFTER DO-PART.*)
|
|
85360 BEGIN
|
|
85370 STRONG; RANGEXT; (*END RANGE OF DO-PART*)
|
|
85380 UNSTACKSB;
|
|
85390 DISPOSE(SRSTK[SRSEMP].SB); SRSEMP := SRSEMP-1;
|
|
85400 CGLPE;
|
|
85405 SRSTK[SRSEMP].SB^.SBMODE:=MDVOID;
|
|
85410 STACKSB(SRSTK[SRSEMP].SB); (*THE .VOID RESULT OF THE DO-PART*)
|
|
85420 END;
|
|
85430 (**)
|
|
85440 (*+53()
|
|
85450 END;
|
|
85460 END END;
|
|
85470 PROCEDURE MONITOR2;
|
|
85480 LABEL 759;
|
|
85490 VAR I: INTEGER;
|
|
85500 BEGIN
|
|
85510 (*+21() MONITORSEMANTIC(SRTN); ()+21*)
|
|
85520 CASE SRTN OF
|
|
85530 ()+53*)
|
|
85540 61: (*SR28*)
|
|
85550 (*FUNCTION: EXECUTED AFTER LOOP-CLAUSE*)
|
|
85560 WITH SRSTK[SRSEMP].SB^ DO
|
|
85570 IF SBLEX<>NIL THEN
|
|
85580 BEGIN CURID := CURID-SZWORD-(3-ORD(SBEMPTYBY IN SBINF)-ORD(SBEMPTYTO IN SBINF))*SZINT;
|
|
85590 IF NOT(SBEMPTYTO IN SBINF) THEN ASSIGNFLAD;
|
|
85600 CGLPG
|
|
85610 END;
|
|
85620 (**)
|
|
85630 62: (*SR29*)
|
|
85640 (*FUNCTION: VOIDS A UNIT FOLLOWED BY A SEMICOLON IN AN ESTABLISHING-CLAUSE.*)
|
|
85650 BEGIN
|
|
85660 SCPUSH(MDVOID); STRONG;
|
|
85670 UNSTACKSB;
|
|
85680 DISPOSE(SRSTK[SRSEMP].SB); SRSEMP := SRSEMP-1;
|
|
85690 END;
|
|
85700 (**)
|
|
85710 63: (*SR33*)
|
|
85720 (*APPLIED-LABEL*)
|
|
85730 STB1 := APPLAB(SRPLSTK[PLSTKP]);
|
|
85740 (**)
|
|
85750 64: (*SR34A*)
|
|
85760 (*FUNCTION: EXECUTED WHEN APPLIED-IDENTIFIER IS FOUND.
|
|
85770 PLACES SEMANTIC BLOCK FOR THE IDENTIFIER ON THE STACK.
|
|
85780 *)
|
|
85790 PUTIND(APPID(SRPLSTK[PLSTKP]));
|
|
85800 (**)
|
|
85810 65: (*SR34B1*)
|
|
85820 (*FUNCTION: EXECUTED WHEN DENOTATION IS ENCOUNTERED.
|
|
85830 PLACES SEMANTIC BLOCK FOR THE DENOTATION ON THE STACK.
|
|
85840 *)
|
|
85850 BEGIN PUTDEN(SRPLSTK[PLSTKP]) END;
|
|
85860 (**)
|
|
85870 66: (*SR34B2*)
|
|
85880 (*FUNCTION: AS SR34B1, BUT TAKES DENOTATION FROM INP*)
|
|
85890 BEGIN SRSEMP := SRSEMP-1; PUTDEN(INP) END;
|
|
85900 (**)
|
|
85910 67: (*SR34C*)
|
|
85920 (*FUNCTION: EXECUTED WHEN A HIP IS ENCOUNTERED.
|
|
85930 PLACES SEMANTIC BLOCK FOR IT ON STACK.
|
|
85940 *)
|
|
85950 SB := PUSHSB(SRPLSTK[PLSTKP]^.LXV.LXPMD); (*COMORF*)
|
|
85960 (**)
|
|
85970 68: (*SR35*)
|
|
85980 (*FUNCTION: EXECUTED AT START OF MODE-DEFINITION*)
|
|
85990 BEGIN
|
|
86000 DEFMI(SRPLSTK[PLSTKP]);
|
|
86010 END;
|
|
86020 (**)
|
|
86030 69: (*SR36*)
|
|
86040 (*FUNCTION: EXECUTED AT START OF ACTUAL-ROWED-DECLARER IN MODE-DEFINITION*)
|
|
86050 BEGIN
|
|
86060 ROUTNNT;
|
|
86070 CGRTA;
|
|
86080 SRSEMP := SRSEMP+1; SRSTK[SRSEMP].MD := PRCBNDS;
|
|
86090 SEMANTICROUTINE(100) (*SR63B*);
|
|
86100 SB:=MAKESUBSTACK(0,MDBNDS)
|
|
86110 END;
|
|
86120 (**)
|
|
86130 70: (*SR37A*)
|
|
86140 (*FUNCTION: EXECUTED WHEN "ROWED" MODE-INDICATION IS APPLIED IN AN ACTUAL-DECLARER
|
|
86150 IN A GENERATOR.
|
|
86160 *)
|
|
86170 BEGIN
|
|
86180 SRSEMP := SRSEMP-1;
|
|
86190 ELABMI(SRPLSTK[PLSTKP]);
|
|
86200 END;
|
|
86210 (**)
|
|
86220 71: (*SR37B*)
|
|
86230 (*FUNCTION: EXECUTED WHEN A "ROWED" MODE-INDICATION ISAPPLIED IN AN ACTUAL-DECLARER
|
|
86240 IN A VARIABLE-DEFINITION OR SOME GENERATORS.
|
|
86250 *)
|
|
86260 BEGIN
|
|
86270 SRSEMP := SRSEMP-1;
|
|
86280 BRKASCR;
|
|
86290 ELABMI(SRPLSTK[PLSTKP + ORD(SRPLSTK[PLSTKP]^.LXV.LXIO<>LXIOMDIND)]);
|
|
86300 END;
|
|
86310 (**)
|
|
86320 72: (*SR38A*)
|
|
86330 (*FUNCTION: EXECUTED WHEN MODE-DEFINITION IS COMPLETED BY ASCRIBING
|
|
86340 A USER DEFINED "ROWED" MODE-INDICATION.
|
|
86350 *)
|
|
86360 BEGIN
|
|
86370 STB1 := SRPLSTK[PLSTKP+1]^.LXV.LXPSTB;
|
|
86380 FILLSTB(STB1); STB1^.STMODE := SRPOPMD;
|
|
86390 NECENV(SRPLSTK[PLSTKP]^.LXV.LXPSTB);
|
|
86400 PUTIND(SRPLSTK[PLSTKP]^.LXV.LXPSTB);
|
|
86410 CGFIRM
|
|
86420 END;
|
|
86430 (**)
|
|
86440 73: (*SR38B*)
|
|
86450 (*FUNCTION: EXECUTED AFTER MODE-DEFINITION IN CASES NOT COVERED BY SR38A.*)
|
|
86460 BEGIN
|
|
86470 M := SRPOPMD;
|
|
86480 STB1 := SRPLSTK[PLSTKP+1]^.LXV.LXPSTB;
|
|
86490 IF M=NIL THEN M := MDERROR; (*FOR .MODE .A = .A*)
|
|
86500 IF M=NIL THEN M:=MDERROR;
|
|
86510 WITH STB1^, SRSTK[SRSEMP].SB^ DO
|
|
86520 BEGIN
|
|
86530 IF M^.MDV.MDID=MDIDROW THEN (*ROWED MODE*)
|
|
86540 BEGIN
|
|
86550 UNSTACKSB;
|
|
86560 STPTR := SBXPTR ; STLEVEL := SBLEVEL;
|
|
86570 RGSTATE := 13;
|
|
86580 END;
|
|
86590 STDEFTYP := STDEFTYP+[STCONST];
|
|
86600 IF STRECUR IN STDEFTYP THEN RECURFIX(M);
|
|
86610 STMODE := M;
|
|
86620 END;
|
|
86630 END;
|
|
86640 (**)
|
|
86650 (**)
|
|
86660 74: (*SR39*)
|
|
86670 (*FUNCTION: EXECUTED AFTER DEFINING-LABEL*)
|
|
86680 BEGIN
|
|
86690 DEFLAB(SRPLSTK[PLSTKP]);
|
|
86700 CGFLINE
|
|
86710 END;
|
|
86720 (**)
|
|
86730 75: (*SR41*)
|
|
86740 (*FUNCTION: EXECUTED AFTER SECONDARY OF SELECTION*)
|
|
86750 BEGIN
|
|
86760 M := WEAK;
|
|
86770 SECDRY := 0;
|
|
86780 WITH M^ DO IF MDV.MDID=MDIDREF THEN
|
|
86790 BEGIN M := MDPRRMD; SECDRY := 1 END;
|
|
86800 WITH M^ DO IF MDV.MDID=MDIDROW THEN
|
|
86810 BEGIN ROWCOUNT := MDV.MDCNT; M := MDPRRMD; SECDRY := SECDRY+2 END;
|
|
86820 IF M^.MDV.MDID<>MDIDSTRUCT THEN SEMERR(ESE+43)
|
|
86830 ELSE WITH M^ DO
|
|
86840 BEGIN OFFST := 0;
|
|
86850 LEX1 := SRPLSTK[PLSTKP+2];
|
|
86860 FOR I := 0 TO MDV.MDCNT-1 DO WITH MDSTRFLDS[I] DO
|
|
86870 BEGIN
|
|
86880 FLDM := MDSTRFMD;
|
|
86890 IF MDSTRFLEX=LEX1 THEN GOTO 759;
|
|
86900 OFFST := OFFST+FLDM^.MDV.MDLEN
|
|
86910 END;
|
|
86920 SEMERRP(ESE+44, LEX1);
|
|
86930 759: CGSELECT(OFFST, FLDM, SECDRY);
|
|
86940 WITH SRSTK[SRSEMP].SB^ DO
|
|
86950 BEGIN
|
|
86960 IF SECDRY>=2 THEN FLDM := FINDROW(FLDM, ROWCOUNT);
|
|
86970 IF ODD(SECDRY) THEN SBMODE := FINDREF(FLDM)
|
|
86980 ELSE SBMODE := FLDM;
|
|
86990 SBINF := SBINF+[SBMORF,SBVOIDWARN];
|
|
87000 END;
|
|
87010 END
|
|
87020 END;
|
|
87030 (**)
|
|
87040 (**)
|
|
87050 76: (*SR42*)
|
|
87060 (*FUNCTION: EXECUTED AFTER PRIMARY OF CALL*)
|
|
87070 BEGIN
|
|
87080 M := MEEK;
|
|
87090 SBB := MAKESUBSTACK(1,M^.MDPRRMD);
|
|
87100 WITH M^, SRSTK[SRSEMP] DO WITH SB^ DO BEGIN
|
|
87102 (*-02() CGFIRM; (*LOAD ANY DELAYED STUFF*)
|
|
87104 SBINF := SBINF-[SBSTKDELAY]; (*BUT NOT NECESSARILY THIS STUFF*)
|
|
87106 ()-02*)
|
|
87110 IF (MDV.MDID=MDIDPASC) AND (SBTYP<>SBTDEN) THEN M := COERCE(COFIRM(M, NIL));
|
|
87120 IF NOT (SBTYP IN [SBTDEN,SBTPROC,SBTRPROC]) THEN LOADSTK(RTSTACK);
|
|
87130 IF NOT (MDV.MDID IN [MDIDPASC,MDIDPROC]) THEN
|
|
87140 BEGIN MODERR(M, ESE+25); SBMODE := PRCERROR END;
|
|
87150 UNSTACKSB; (*PRIMARY OF CALL*)
|
|
87160 RANGENT; (*FOR PARAMETERS*)
|
|
87170 STACKSB(SB); (*SO IT IS PART OF THE PARAMETERS RANGE*)
|
|
87171 (*+05()
|
|
87172 IF M^.MDV.MDID<>MDIDPASC THEN
|
|
87173 BEGIN
|
|
87174 OFFST := 0;
|
|
87175 FOR I := 0 TO MDV.MDCNT-1 DO WITH MDPRCPRMS[I]^ DO
|
|
87178 IF MDV.MDPILE THEN OFFST := OFFST+SZADDR ELSE OFFST := OFFST+MDV.MDLEN;
|
|
87179 CLEAR(RTSTACK);
|
|
87180 ADJUSTSP := 0; HOIST(0, OFFST, FALSE);
|
|
87182 IF ADJUSTSP<>0 THEN FILL(SBTSTK, PUSHSB(MDINT));
|
|
87183 END;
|
|
87184 ()+05*)
|
|
87186 RGINFO := RGINFO+[DCLLOCRNG];
|
|
87190 WITH ROUTNL^ DO RNLOCRG := RNLOCRG+1;
|
|
87200 SBCNT := 0;
|
|
87210 PARMSC
|
|
87220 END
|
|
87230 END;
|
|
87240 (**)
|
|
87250 77: (*SR43*)
|
|
87260 (*FUNCTION: EXECUTED FOR EVERY OPERAND WHICH MAY POSSIBLY BE A LEFT-DYADIC-OPERAND.
|
|
87270 CHECKS THAT THE OPERATOR TO THE RIGHT OF THE OPERAND IS A LEGAL DYADIC-OPERATOR.
|
|
87280 *)
|
|
87290 WITH INP^.LXV DO
|
|
87300 IF LXPSTB<>NIL THEN
|
|
87310 IF LXPSTB^.STDYPRIO=10 THEN SEMERRP(ESE+22, INP);
|
|
87320 (**)
|
|
87330 78: (*SR44*)
|
|
87340 (*FUNCTION: AFTER MONADIC-OPERATOR*)
|
|
87350 BEGIN OPDSAVE(FIRMBAL); OPIDENT(TRUE) END;
|
|
87360 (**)
|
|
87370 79: (*SR45*)
|
|
87380 (*FUNCTION: EXECUTED IN ORDER TO REDUCE OPRAND OPR OPRAND TO OPRAND*)
|
|
87390 BEGIN OPDSAVE(FIRMBAL); OPIDENT(FALSE) ;
|
|
87400 END;
|
|
87410 (**)
|
|
87420 80: (*SR46*)
|
|
87430 (*FUNCTION: EXECUTED FOR EACH LEFT-HAND-OPERAND OF A DYADIC-OPERATOR*)
|
|
87440 BEGIN
|
|
87450 M := FIRMBAL;
|
|
87460 IF BALFLAG OR (SRSTK[SRSEMP].SB^.SBDELAYS<>0) THEN LHOPBAL(M);
|
|
87470 OPDSAVE(M)
|
|
87480 END;
|
|
87490 (**)
|
|
87500 (**)
|
|
87510 81: (*SR48A*)
|
|
87520 (*FUNCTION: EXECUTED AFTER LEFT HAND TERTIARY OF IDENTITY-RELATION*)
|
|
87530 BEGIN
|
|
87540 M := BALANCE(STRSTRONG);
|
|
87550 IF BALFLAG OR (SRSTK[SRSEMP].SB^.SBDELAYS<>0) THEN LHOPBAL(M);
|
|
87560 OPDSAVE(M)
|
|
87570 END;
|
|
87580 (**)
|
|
87590 82: (*SR48B*)
|
|
87600 (*FUNCTION: EXECUTED AFTER RIGHT HAND TERTIARY OF IDENTITY-RELTION*)
|
|
87610 BEGIN
|
|
87620 OPDSAVE(BALANCE(STRSTRONG));
|
|
87630 IF SRSTK[SRSEMP].SB^.SBBALSTR=STRNONE THEN SB := SRSTK[SRSEMP-2].SB
|
|
87640 ELSE SB := SRSTK[SRSUBP-1].SB;
|
|
87650 (*SB IS RESULT OF BALANCING LHS*)
|
|
87660 M := BALMOIDS(SRSTK[SRSEMP].SB^.SBMODE, SB^.SBMODE);
|
|
87670 WITH SRSTK[SRSEMP].SB^ DO
|
|
87680 IF SBBALSTR>M1COERC THEN M1COERC := SBBALSTR;
|
|
87690 WITH SB^ DO
|
|
87700 IF SBBALSTR>M2COERC THEN M2COERC := SBBALSTR;
|
|
87710 IF (M1COERC>STRSOFT) AND (M2COERC>STRSOFT) THEN SEMERR(ESE+26)
|
|
87720 ELSE IF M^.MDV.MDID<>MDIDREF THEN MODERR(M, ESE+57);
|
|
87730 LHFIRM := NIL; (*SO THAT PUTMD AND BALOPR DO NOT THINK IT IS MONADIC*)
|
|
87740 PUTMD(M, M);
|
|
87750 BALOPR;
|
|
87760 CGOPR(PIDTYREL+SRPLSTK[PLSTKP+1]^.LXV.LXP, MDBOOL, TRUE);
|
|
87770 DISPOSE(SRSTK[SRSEMP].SB); SRSEMP := SRSEMP-1;
|
|
87780 WITH SRSTK[SRSEMP].SB^ DO SBINF := SBINF+[SBMORF,SBVOIDWARN]
|
|
87790 END;
|
|
87800 (**)
|
|
87810 (**)
|
|
87820 83: (*SR49A*)
|
|
87830 (*FUNCTION: EXECUTED AFTER DESTINATION OF ASSIGNATION.*)
|
|
87840 BEGIN M := SOFT;
|
|
87850 WITH M^ DO
|
|
87860 BEGIN
|
|
87870 IF MDV.MDID<>MDIDREF THEN
|
|
87880 BEGIN MODERR(M, ESE+20); SRSTK[SRSEMP].SB^.SBMODE := MDREFERROR; SCPUSH(MDERROR) END
|
|
87890 ELSE SCPUSH(MDPRRMD);
|
|
87900 CGDEST;
|
|
87910 END
|
|
87920 END;
|
|
87930 (**)
|
|
87940 (**)
|
|
87950 84: (*SR49B*)
|
|
87960 (*FUNCTION: EXECUTED AFTER SOURCE OF ASSIGNATION.*)
|
|
87970 BEGIN
|
|
87980 STRONG; CGASSIGN; DISPOSE(SRSTK[SRSEMP].SB);SRSEMP := SRSEMP-1;
|
|
87990 WITH SRSTK[SRSEMP].SB^ DO SBINF := SBINF-[SBMORF,SBVOIDWARN]
|
|
88000 END;
|
|
88010 (**)
|
|
88020 85: (*SR50*)
|
|
88030 (*FUNCTION: EXECUTED AFTER PRIMARY OF SLICE*)
|
|
88040 BEGIN M:= WEAK;
|
|
88050 WITH M^ DO IF MDV.MDID=MDIDREF THEN M := MDPRRMD;
|
|
88060 WITH M^ DO
|
|
88070 IF M=MDSTRNG THEN BEGIN FLDM := COERCE(M); ROWCOUNT := 1 END
|
|
88080 ELSE IF MDV.MDID=MDIDROW THEN ROWCOUNT:=MDV.MDCNT
|
|
88090 ELSE BEGIN MODERR(M, ESE+47); ROWCOUNT := 63 (*MAX CNTR*) END;
|
|
88100 SBB := MAKESUBSTACK(1, M);
|
|
88110 WITH SBB^ DO
|
|
88120 BEGIN
|
|
88130 SBTRIMCNT := ROWCOUNT; SBSLICEDIM := ROWCOUNT; SBPRIMDIM := ROWCOUNT;
|
|
88140 SBTRIMS := NIL; SBUNITS := 0 END;
|
|
88150 CGFIRM;
|
|
88160 SEMANTICROUTINE(86) (*SR51*)
|
|
88170 END;
|
|
88180 (**)
|
|
88190 86: (*SR51*)
|
|
88200 (*FUNCTION: EXECUTED AT START OF NEW TRIMSCRIPT*)
|
|
88210 BEGIN
|
|
88220 SB := SRSTK[SRSUBP-1].SB;
|
|
88230 WITH SB^ DO
|
|
88240 BEGIN
|
|
88250 IF SBTRIMCNT=0 THEN SEMERR(ESE+48); (*TOO MANY TRIMSCRIPTS*)
|
|
88260 SBTRIMCNT := SBTRIMCNT-1;
|
|
88270 NEW(PTR); WITH PTR^ DO BEGIN LINK := SBTRIMS; TRTYPE := 0 END;
|
|
88280 SBTRIMS := PTR
|
|
88290 END
|
|
88300 END;
|
|
88310 (**)
|
|
88320 87: (*SR52*)
|
|
88330 (*FUNCTION: EXECUTED AFTER LOWER-BOUND OF TRIMMER*)
|
|
88340 WITH SRSTK[SRSUBP-1].SB^ DO
|
|
88350 BEGIN SBUNITS := SBUNITS+1; WITH SBTRIMS^ DO TRTYPE := TRTYPE+4 END;
|
|
88360 (**)
|
|
88370 88: (*SR53*)
|
|
88380 (*FUNCTION: EXECUTED AFTER UPPER-BOUND OF TRIMMER*)
|
|
88390 WITH SRSTK[SRSUBP-1].SB^ DO
|
|
88400 BEGIN SBUNITS := SBUNITS+1; WITH SBTRIMS^ DO TRTYPE := TRTYPE+2 END;
|
|
88410 (**)
|
|
88420 89: (*SR54A*)
|
|
88430 (*FUNCTION: EXECUTED BEFORE UNIT IN REVISED-LOWER-BOUND*)
|
|
88440 IF SRSTK[SRSUBP-1].SB^.SBMODE=MDSTRNG THEN SEMERR(ESE+32);
|
|
88450 (**)
|
|
88460 90: (*SR54B*)
|
|
88470 (*FUNCTION: EXECUTED AFTER REVISED-LOWER-BOUND OF TRIMMER*)
|
|
88480 BEGIN
|
|
88490 MEEKLOAD(MDINT, ESE+50);
|
|
88494 WITH SRSTK[SRSUBP-1].SB^ DO
|
|
88500 BEGIN SBUNITS := SBUNITS+1; WITH SBTRIMS^ DO TRTYPE := TRTYPE+1 END;
|
|
88510 END;
|
|
88520 (**)
|
|
88530 (*+53()
|
|
88540 END END ;
|
|
88550 PROCEDURE MONITOR3;
|
|
88560 VAR I: INTEGER;
|
|
88570 BEGIN
|
|
88580 (*+21() MONITORSEMANTIC(SRTN); ()+21*)
|
|
88590 CASE SRTN OF
|
|
88600 ()+53*)
|
|
88610 91: (*SR55*)
|
|
88620 (*FUNCTION: EXECUTED WHEN DEFAULT TRIMMER IS ENCOUNTERED.
|
|
88630 A DEFAULT TRIMMER CONSISTS OF A COLON (NO UMITS) *)
|
|
88640 WITH SRSTK[SRSUBP-1].SB^.SBTRIMS^ DO TRTYPE := TRTYPE+8;
|
|
88650 (**)
|
|
88660 92: (*SR56*)
|
|
88670 (*FUNCTION: EXECUTED AFTER SUBSCRIPT*)
|
|
88672 BEGIN
|
|
88674 IF BALFLAG THEN I := SRSTK[SRSUBP].SUBP ELSE I := SRSUBP;
|
|
88680 WITH SRSTK[I-1].SB^ DO
|
|
88690 BEGIN
|
|
88700 IF (SBSLICEDIM=1) AND (SBPRIMDIM<3) THEN WITH SRSTK[I+1].SB^ DO
|
|
88710 SBINF := SBINF-[SBSTKDELAY]; (*TO SAVE UNNECESSARY STACKING*)
|
|
88720 MEEKLOAD(MDINT, ESE+51);
|
|
88730 SBSLICEDIM := SBSLICEDIM-1;
|
|
88740 SBUNITS := SBUNITS+1; WITH SBTRIMS^ DO TRTYPE := TRTYPE+9
|
|
88750 END;
|
|
88752 END;
|
|
88760 (**)
|
|
88770 93: (*SR57*)
|
|
88780 (*FUNCTION: EXECUTED AFTER SLICE*)
|
|
88790 BEGIN
|
|
88800 SB := SRSTK[SRSUBP-1].SB;
|
|
88810 WITH SB^ DO
|
|
88820 BEGIN
|
|
88830 M := SRSTK[SRSUBP+1].SB^.SBMODE;
|
|
88840 IF SBTRIMCNT>0 THEN MODERR(M, ESE+49); (*TOO FEW TRIMSCRIPTS*)
|
|
88850 WITH M^ DO
|
|
88860 BEGIN REFED := MDV.MDID=MDIDREF; IF REFED THEN M := MDPRRMD END;
|
|
88870 WITH M^ DO
|
|
88880 IF MDV.MDID=MDIDROW THEN
|
|
88890 BEGIN M := FINDROW(MDPRRMD, SBSLICEDIM);
|
|
88900 IF REFED THEN M := FINDREF(M)
|
|
88910 END
|
|
88920 ELSE IF SBSLICEDIM=0 THEN
|
|
88930 M := MDCHAR;
|
|
88940 CGSLICE(SB, REFED);
|
|
88950 POPUNITS;
|
|
88960 SBMODE := M; SBINF := SBINF+[SBMORF,SBVOIDWARN];
|
|
88970 END
|
|
88980 END;
|
|
88990 (**)
|
|
89000 (**)
|
|
89010 (**)
|
|
89020 (**)
|
|
89030 94: (*SR58*)
|
|
89040 (*FUNCTION: EXECUTED AFTER LOWER-BOUND OF TRIMMER OR ACTUAL-ROWER.*)
|
|
89050 MEEKLOAD(MDINT, ESE+52);
|
|
89060 (**)
|
|
89070 95: (*SR59*)
|
|
89080 (*FUNCTION: EXECUTED AFTER UPPER-BOUND OF TRIMMER OR ACTUAL-ROWER.*)
|
|
89090 MEEKLOAD(MDINT, ESE+53);
|
|
89100 (**)
|
|
89110 96: (*SR60*)
|
|
89120 (*FUNCTION: EXECUTED AFTER ALL BUT LAST ACTUAL-PARAMETER IN ACTUAL-PARAMETER-LIST.*)
|
|
89130 BEGIN STRONG;
|
|
89140 CGFIRM;
|
|
89150 PARMSC
|
|
89160 END;
|
|
89170 (**)
|
|
89180 97: (*SR61*)
|
|
89190 (*FUNCTION: EXECUTED AFTER A CALL*)
|
|
89200 BEGIN
|
|
89210 STRONG;
|
|
89220 SB := SRSTK[SRSUBP+1].SB;
|
|
89230 WITH SB^.SBMODE^ DO
|
|
89240 BEGIN
|
|
89250 (*+01() IF (MDV.MDID=MDIDPASC) AND (SB^.SBCNT<3) THEN
|
|
89260 BEGIN
|
|
89270 IF SB^.SBCNT>1 THEN WITH SRSTK[SRSEMP-1].SB^ DO SBINF := SBINF-[SBSTKDELAY];
|
|
89280 GETTOTAL(SRSTK[SRSEMP].SB)
|
|
89290 END
|
|
89300 ELSE
|
|
89310 ()+01*)
|
|
89320 CGFIRM;
|
|
89330 IF SB^.SBCNT<SB^.SBMODE^.MDV.MDCNT THEN SEMERR(ESE+72);
|
|
89340 SBB := SRSTK[SRSUBP-1].SB; (*FOR RESULT*)
|
|
89350 IF MDV.MDID=MDIDPROC THEN CGCALL(SB, SBB)
|
|
89360 ELSE (*MDV.MDID=MDIDPASC*) CGPASC(SB, SBB);
|
|
89370 IF SBB^.SBMODE=MDVOID THEN FILL(SBTVOID, SBB);
|
|
89380 POPUNITS;
|
|
89390 UNSTACKSB;
|
|
89400 WITH ROUTNL^ DO RNLOCRG := RNLOCRG-1;
|
|
89410 RGINFO := RGINFO-[DCLLOCRNG];
|
|
89420 SB := PUSHSB(MDVOID); (*RANGEXT EXPECTS SBB FOR ITS YIELD*)
|
|
89430 RANGEXT; (*FROM PARAMETERS RANGE*)
|
|
89440 UNSTACKSB; DISPOSE(SRSTK[SRSEMP].SB);SRSEMP := SRSEMP-1;
|
|
89450 STACKSB(SBB);
|
|
89460 SBB^.SBINF := SBB^.SBINF+[SBMORF]-[SBVOIDWARN]
|
|
89470 END
|
|
89480 END;
|
|
89490 (**)
|
|
89500 98: (*SR62*)
|
|
89510 (*FUNCTION: EXECUTED AFTER LEAP-GENERATOR.*)
|
|
89520 BEGIN
|
|
89530 M := SRPOPMD;
|
|
89540 IF M^.MDV.MDID=MDIDROW THEN
|
|
89550 SRSTK[SRSEMP].SB^.SBMODE := FINDREF(M)
|
|
89560 ELSE BEGIN SB := PUSHSB(FINDREF(M)); UNSTACKSB END;
|
|
89570 IF SRPLSTK[PLSTKP+1]^.LXV.LXIO=LXIOLOC THEN
|
|
89580 BEGIN
|
|
89590 RGINFO := RGINFO+[DCLLOCGEN];
|
|
89600 CGLEAPGEN(FALSE)
|
|
89610 END
|
|
89620 ELSE CGLEAPGEN(TRUE);
|
|
89630 WITH SRSTK[SRSEMP].SB^ DO SBINF := SBINF+[SBMORF,SBVOIDWARN]
|
|
89640 END;
|
|
89650 (**)
|
|
89660 99: (*SR63A*)
|
|
89670 (*FUNCTION: EXECUTED AT THE BEGINNING OF ROUTINE-TEXT WITH A NON-EMPTY
|
|
89680 FORMAL-DECLARATIVE-PACK-OPTION.
|
|
89690 *)
|
|
89700 BEGIN
|
|
89710 ROUTNNT;
|
|
89720 CGRTA;
|
|
89730 SUBSAVE
|
|
89740 END;
|
|
89750 (**)
|
|
89760 100: (*SR63B*)
|
|
89770 (*FUNCTION: EXECUTED AFTER ROUTINE-SPECIFICATION IN A ROUTINE-TEXT.
|
|
89780 SAVES THE MODE OF THE ROUTINE-TEXT AND ESTABLISHES THE MODE OF THE
|
|
89790 STRONG CONTEXT OF THE UNIT WHICH FOLLOWS.
|
|
89800 *)
|
|
89810 BEGIN
|
|
89820 ROUTNL^.RNPARAMS:=CURID;
|
|
89830 STB1:=DCIL;
|
|
89840 WHILE STB1<>NIL DO
|
|
89850 WITH ROUTNL^ ,STB1^ DO
|
|
89860 BEGIN
|
|
89870 IF STBLKTYP=STBDEFID THEN
|
|
89880 BEGIN
|
|
89890 STOFFSET := STOFFSET -PARAMOFFSET -RNPARAMS;
|
|
89910 CGPARM(STB1);
|
|
89920 END;
|
|
89930 STB1:=STTHREAD
|
|
89940 END;
|
|
89950 CURID:=0;I:=ALLOC(SIZIBBASE+SIZLEBBASE);
|
|
89960 CGFLINE;
|
|
89970 SCPUSH(SRSTK[SRSEMP].MD^.MDPRRMD);
|
|
89980 ROUTNL^.RNMODE := SRPOPMD
|
|
89990 END;
|
|
90000 (**)
|
|
90010 101: (*SR63C*)
|
|
90020 (*FUNCTION: EXECUTED AFTER ROUTINE-TEXT.*)
|
|
90030 BEGIN
|
|
90040 STRONG;
|
|
90050 RANGEXT;
|
|
90060 CGRTB;
|
|
90070 (*CURRENTLY, SRSTK[SRSEMP].SB REPRESENTS THE FINAL UNIT OF THE ROUTINE-TEXT, AND ITS
|
|
90080 YIELD SITS UPON THE CONCEPTUAL RTSTACK. NOW, SRSTK[SRSEMP].SB IS MODIFIED TO REPRESENT
|
|
90090 THE ROUTINE-TEXT ITSELF.
|
|
90100 *)
|
|
90102 WITH SRSTK[SRSEMP] DO WITH SB^, ROUTNL^ DO
|
|
90104 BEGIN
|
|
90110 IF ((RGSTATE MOD 16)=0) OR (STVAR IN DCLDEFN) THEN (*ANONYMOUS ROUTINE*) RNLEX := NIL
|
|
90120 ELSE WITH DCIL^ DO
|
|
90130 IF STBLKTYP=STBDEFOP THEN RNLEX := STLEX^.LINK
|
|
90140 ELSE RNLEX := STLEX;
|
|
90142 CGRTC;
|
|
90150 UNSTACKSB;
|
|
90180 SBMODE := RNMODE; SBINF := SBINF+[SBMORF,SBVOIDWARN];
|
|
90190 IF (RNNONIC=1) OR (RGLEV=2) THEN
|
|
90200 BEGIN
|
|
90210 SBXPTR := RNPROCBLK;
|
|
90220 SBLEVEL:=RNNECLEV;
|
|
90230 SBOFFSET:=0;
|
|
90240 SBLEN := SZADDR;
|
|
90250 SBTYP:=SBTPROC;
|
|
90260 ROUTNXT;
|
|
90270 STACKSB(SB);
|
|
90280 (*-05()(*-02()ASSIGNFLAD; ()-02*) ()-05*)
|
|
90290 END
|
|
90300 ELSE
|
|
90310 BEGIN
|
|
90320 ROUTNXT;
|
|
90330 CGRTD(RNPROCBLK);
|
|
90340 END
|
|
90350 END
|
|
90360 END;
|
|
90370 (**)
|
|
90380 102: (*SR65A*)
|
|
90390 (*FUNCTION: EXECUTED AFTER DEFINING-IDENTIFIER IN ROUTINE-IDENTITY-DEFINITION.*)
|
|
90400 BEGIN DEFID(SRPLSTK[PLSTKP]); SRSEMP := SRSEMP+1; SRSTK[SRSEMP].STB := DCIL END;
|
|
90410 (**)
|
|
90420 103: (*SR65B*)
|
|
90430 (*FUNCTION: EXECUTED AFTER DEFINING-IDENTIFIER IN ROUTINE-VARIABLE-DEFINITION.*)
|
|
90440 BEGIN DCLDEFN := [STVAR,STINIT]; SEMANTICROUTINE(102) (*SR65A*) END;
|
|
90450 (**)
|
|
90460 104: (*SR65C*)
|
|
90470 (*FUNCTION: EXECUTED AFTER DEFINING-OPERATOR IN ROUTINE-OPERATION-DEFINITION*)
|
|
90480 BEGIN DEFOP(SRPLSTK[PLSTKP]); SRSEMP := SRSEMP+1; SRSTK[SRSEMP].STB := DCIL END;
|
|
90490 (**)
|
|
90500 105: (*SR66A*)
|
|
90510 (*FUNCTION: EXECUTED AFTER ROUTINE-SPECIFICATION IN ROUTINE-IDENTITY-DEFINITION
|
|
90520 OR ROUTINE-VARIABLE-DEFINITION.*)
|
|
90530 BEGIN
|
|
90540 SEMANTICROUTINE(100) (*SR63B*);
|
|
90550 STB1 := SRSTK[SRSEMP].STB; SRSEMP := SRSEMP-1;
|
|
90560 WITH STB1^ DO
|
|
90570 IF STMODE=MDROUT THEN
|
|
90580 BEGIN
|
|
90590 IF RGLEV=3 THEN
|
|
90600 BEGIN
|
|
90610 STPTR := ROUTNL^.RNPROCBLK ;
|
|
90620 STLEVEL :=0 ; STDEFTYP := STDEFTYP+[STRCONST,STCONST];
|
|
90630 END;
|
|
90640 STMODE := ROUTNL^.RNMODE
|
|
90650 END
|
|
90660 ELSE STMODE := FINDREF(ROUTNL^.RNMODE)
|
|
90670 END;
|
|
90680 (**)
|
|
90690 106: (*SR66C*)
|
|
90700 (*FUNCTION: EXECUTED AFTER ROUTINE-SPECIFICATION IN ROUTINE-OPERATION-DEFINITION*)
|
|
90710 BEGIN
|
|
90720 SEMANTICROUTINE(100) (*SR63B*);
|
|
90730 STB1 := SRSTK[SRSEMP].STB; SRSEMP := SRSEMP-1;
|
|
90740 DEFOPM(STB1, ROUTNL^.RNMODE)
|
|
90750 END;
|
|
90760 (**)
|
|
90770 107: (*SR67A*)
|
|
90780 (*FUNCTION: EXECUTED AFTER DEFINING-IDENTIFIER IN A VARIABLE-DEFINITION WHICH HAS NO INITIALIZING UNIT.*)
|
|
90790 BEGIN DCLDEFN := [STVAR]; DEFID(SRPLSTK[PLSTKP]) END;
|
|
90800 (**)
|
|
90810 108: (*SR67B*)
|
|
90820 (*FUNCTION: EXECUTED AFTER DEFINING-IDENTIFIER IN AN IDENTITY-DEFINITION OR A VARIABLE-DEFINITION
|
|
90830 WHICH INCLUDES AN INITIALIZING UNIT. ENTERS THE IDENTIFIER IN THE SYMBOL TABLE AND
|
|
90840 ESTABLISHES THE MODE OF THE STRONG CONTEXT OF THE UNIT WHICH FOLLOWS.
|
|
90850 *)
|
|
90860 BEGIN SCPUSH(DCLMODE); DCLDEFN := DCLDEFN+[STINIT]; DEFID(SRPLSTK[PLSTKP]) END;
|
|
90870 (**)
|
|
90880 109: (*SR67C*)
|
|
90890 (*FUNCTION: EXECUTED AFTER THE DEFINING-OPERATOR IN AN OPERATION-DEFINITION*)
|
|
90900 BEGIN
|
|
90910 SCPUSH(DCLMODE);
|
|
90920 DEFOP(SRPLSTK[PLSTKP]);
|
|
90930 DEFOPM(DCIL, DCLMODE)
|
|
90940 END;
|
|
90950 (**)
|
|
90960 110: (*SR68A*)
|
|
90970 (*FUNCTION: EXECUTED AFTER UNIT IN IDENTITY- OR VARIABLE-DEFINITION*)
|
|
90980 BEGIN STRONG;
|
|
90990 WITH SRSTK[SRSEMP].SB^ DO
|
|
91000 IF NOT(STVAR IN DCLDEFN) AND
|
|
91010 ((SBTYP=SBTDEN) AND NOT(STUSED IN DCIL^.STDEFTYP)
|
|
91020 OR ((SBTYP=SBTPROC) AND (NOT(STUSED IN DCIL^.STDEFTYP) OR (ROUTNL^.RNLEVEL=0))))
|
|
91030 THEN
|
|
91040 DISALLOCIND
|
|
91050 ELSE CGFIRM;
|
|
91060 END;
|
|
91070 (**)
|
|
91080 111: (*SR68B*)
|
|
91090 (*FUNCTION: EXECUTED AFTER ROUTINE-TEXT IN ROUTINE-IDENTITY,
|
|
91100 -VARIABLE OR -OPERATION DEFINITION.
|
|
91110 *)
|
|
91120 WITH SRSTK[SRSEMP].SB^ DO
|
|
91130 IF NOT(STVAR IN DCLDEFN) AND ((SBTYP=SBTPROC) AND (NOT(STUSED IN DCIL^.STDEFTYP) OR (RGLEV=2)))
|
|
91140 THEN
|
|
91150 DISALLOCIND
|
|
91160 ELSE CGFIRM;
|
|
91170 (**)
|
|
91180 112: (*SR69*)
|
|
91190 (*FUNCTION: EXECUTED AFTER A DECLARATION-LIST.*)
|
|
91200 BEGIN
|
|
91210 BRKASCR;CGFIXRG;
|
|
91220 END;
|
|
91230 (**)
|
|
91240 113: (*SR70*)
|
|
91250 (*FUNCTION: EXECUTED AFTER FIRST UNIT OF COLLATERAL-CLAUSE*)
|
|
91260 BEGIN
|
|
91270 RGINFO := RGINFO+[DCLCOLL];
|
|
91280 (*FINDTOPCOLL*)
|
|
91290 J := PLSTKP+2;
|
|
91300 R := RANGEL;
|
|
91310 WHILE (SRPLSTK[J]=LEXBEGIN) OR (SRPLSTK[J]=LEXOPEN) DO
|
|
91320 BEGIN
|
|
91330 J := J+1;
|
|
91340 WITH R^ DO
|
|
91350 BEGIN RGINF := RGINF+[DCLCOLL]; R := RGLINK END
|
|
91360 END;
|
|
91370 I := J-PLSTKP-1;
|
|
91380 (*FINDCOLLM*)
|
|
91390 M := SCL^.SCMODE;
|
|
91400 WITH M^ DO
|
|
91410 IF MDV.MDID=MDIDROW THEN
|
|
91420 BEGIN
|
|
91430 I := I-MDV.MDCNT;
|
|
91440 IF I>0 THEN M := MDPRRMD
|
|
91450 ELSE M := FINDROW(MDPRRMD, -I+1)
|
|
91460 END;
|
|
91470 WHILE I>0 DO WITH M^ DO
|
|
91480 BEGIN
|
|
91490 I := I-1;
|
|
91500 IF MDV.MDID<>MDIDSTRUCT THEN SEMERR(ESE+60)
|
|
91510 ELSE IF I>0 THEN M := MDSTRFLDS[0].MDSTRFMD
|
|
91520 END;
|
|
91530 NEW(SB);
|
|
91540 WITH SB^ DO
|
|
91550 BEGIN SBMODE := M; SBLEVEL := 0; SBDELAYS := 0; SBTYP := SBTVOID; SBINF := [SBCOLL] END;
|
|
91560 COLLSC(SB); STRONG;
|
|
91570 (*AT THIS POINT, THERE IS AN UNWANTED SUBSTACK MARKER AS SRSEMP-1, PUT THERE
|
|
91580 BY S-34. WE SHALL INSERT SB BELOW IT*)
|
|
91590 SRSTK[SRSEMP+1].SB := SRSTK[SRSEMP].SB; SRSEMP := SRSEMP+1;
|
|
91600 SRSTK[SRSUBP+1].SUBP := SRSTK[SRSUBP].SUBP; SRSUBP := SRSUBP+1;
|
|
91610 SRSTK[SRSUBP-1].SB := SB;
|
|
91620 IF NOT (DCLCOLL IN R^.RGINF) OR (SRPLSTK[J]^.LXV.LXIO<>LXIOUNLC) THEN CGLEFTCOLL(SB);
|
|
91630 CGCOLLUNIT;
|
|
91640 COLLSC(SB)
|
|
91650 END;
|
|
91660 (**)
|
|
91670 114: (*SR71*)
|
|
91680 (*FUNCTION: EXECUTED AFTER MIDDLE UNITS OF COLLATERAL-CLAUSE*)
|
|
91690 BEGIN STRONG; CGCOLLUNIT; COLLSC(SRSTK[SRSUBP-1].SB) END;
|
|
91700 (**)
|
|
91710 115: (*SR72*)
|
|
91720 (*FUNCTION: EXECUTED AFTER LAST UNIT OF COLLATERAL-CLAUSE*)
|
|
91730 BEGIN
|
|
91740 STRONG;
|
|
91750 CGCOLLUNIT;
|
|
91760 WITH SRSTK[SRSUBP-1].SB^ DO WITH SBMODE^ DO
|
|
91770 IF MDV.MDID=MDIDSTRUCT THEN
|
|
91780 IF MDV.MDCNT>SBLEVEL THEN SEMERR(ESE+58);
|
|
91790 J := PLSTKP+2; I := 0;
|
|
91800 WHILE (SRPLSTK[J]=LEXBEGIN) OR (SRPLSTK[J]=LEXOPEN) OR (SRPLSTK[J]^.LXV.LXIO=LXIOUNLC) DO
|
|
91810 BEGIN I := I+ORD(SRPLSTK[J]^.LXV.LXIO<>LXIOUNLC); J := J+1 END;
|
|
91820 CGFINCOLL(I);
|
|
91830 END;
|
|
91840 (**)
|
|
91850 116: (*SR73*)
|
|
91860 (*FUNCTION: EXECUTED AFTER MOID-DECLARER OF CAST*)
|
|
91870 SCPUSH(SRPOPMD);
|
|
91880 (**)
|
|
91890 117: (*SR74*)
|
|
91900 (*FUNCTION: EXECUTED AFTER A PRIORITY-DEFINITION*)
|
|
91910 BEGIN DEFPRIO(SRPLSTK[PLSTKP+1], SRPLSTK[PLSTKP]) END;
|
|
91920 (**)
|
|
91930 118: (*SR80*)
|
|
91940 BEGIN
|
|
91950 SEMANTICROUTINE(62) (*SR29*);
|
|
91960 DEFLAB(LEXLSTOP);
|
|
91970 STB1 := DCIL;
|
|
91980 WHILE STB1<>NIL DO WITH STB1^ DO
|
|
91990 BEGIN
|
|
92000 IF STBLKTYP=STBAPPLAB THEN SEMERRP(ESE+38, STLEX);
|
|
92010 STB1 := STTHREAD
|
|
92020 END;
|
|
92030 SBB := PUSHSB(MDVOID);(*RANGEXT EXPECTS IT*)
|
|
92040 RANGEXT;
|
|
92050 CGEND;
|
|
92060 ROUTNXT
|
|
92070 END;
|
|
92080 (**)
|
|
92090 119: (*SR81*)
|
|
92100 (*FUNCTION: EXECUTED AFTER SYNTACTIC ERROR, BEFORE START OF IGNORED SYMBOLS*)
|
|
92110 BEGIN
|
|
92120 ERRCHAR := '=';
|
|
92130 END;
|
|
92140 (**)
|
|
92150 120: (*SR00*)
|
|
92160 BEGIN
|
|
92170 I := CURID;
|
|
92180 ROUTNNT;
|
|
92190 CURID := I;
|
|
92200 ROUTNL^.RNLEVEL := 0;
|
|
92210 ROUTNL^.RNLENIDS := CURID;
|
|
92220 CGINIT;
|
|
92230 CGFLINE
|
|
92240 END;
|
|
92250 (**)
|
|
92252 121: (*FINISH*) (*INVOKED: AFTER END OF PROGRAM TO INDICATE TO THE PARSER THAT
|
|
92254 ITS JOB IS DONE*)
|
|
92256 ENDOFPROG := TRUE;
|
|
92260 END
|
|
92270 END
|
|
92280 (*+53()
|
|
92290 ; BEGIN
|
|
92300 IF (SRTN>120) OR (SRTN<61) THEN MONITOR1
|
|
92310 ELSE IF SRTN<91 THEN MONITOR2
|
|
92320 ELSE MONITOR3
|
|
92330 ()+53*)
|
|
92340 END;
|
|
92350 (**)
|
|
92360 ()+83*)
|