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