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