!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
!  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

!COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: D. B. TOLMAN/MD/JNG/SJW
MODULE DRIVER (START,RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4)=
BEGIN

GLOBAL BIND DRIVV = 5^24 + 1^18 + 20;	! VERSION DATE: 16-May-76

%(
REVISION HISTORY

2	-----	-----	ADD CODE TO EXECUTE "SYNTAX" FOR SELECTED STATEMENTS
			BEFORE CALLING THEIR SEMANTICS ROUTINES

3	-----	-----	ADD THE CODE TO RECOGNIZE END OF FILE IN AN INCLUDED
			FILE AND THEN RESTORE THE ORIGIONAL SOURCE FILE
			AND CONTINUE PROCESSING IT

4	-----	-----	MOVE ZZOUTMSG TO UNEND SO THAT IT CAN BE CALLED BY MAIN
			WHILE IN ANY PHASE

5	----	-----	MOVE THE END OF PROGRAM UNIT AND END OF 
			COMPILATION CODE TO ROUTINES ENDUNIT AND
			FINALCHAR RESPECTIVELY IN MODULE UNEND.
			THIS WILL ALLOW THEM TO BE ACCESSED BY MAIN

6	-----	-----	ADD ERROR DETECTION OF PROGRAM UNIT TERMINATION IN
			INCLUDE

7	-----	-----	REDUCE THE END OF THE STACK BY POOLSIZ FOR
			PHAZE1 AND THEN RESTORE FOR LATER PASSES

8	-----	-----	FINAL CHAR HAS GONE AWAY

9	-----	-----	ADD PROCESSING TO GLOBINIT TO INITIALIZE
			THE FLGREG FOR THE NEW DEBUG SWITCH MODIFIERS

10	-----	-----	FIX DOCHECK TO HANDLE THE NEW ACTIVVE DO STACK
			WHICH NOW CONTAINS THE ACTIVE INDEX FOR EACH LOOP
			
			ADD ROUTINE CKDOINDEX() WHICH WILL SEARCH THE
			ACTIVE LIST FOR SOME GIVEN VARIABLE

11	-----	-----	ADD ROUTINE CKAJDIM  TO CHECK THE LIST OF
			VARIABLE DIMENSIONS WHICH WERE NOT LEGAL
			AT THE TIME TO SEE IF THEY HAVE BECOME LEGAL

12	-----	-----	MOVE DOCHECK CALL TO UNLINK LOOP LIST DOWN
			AFTER SEMANTICS SO THE LAST STAATEMENT WILL
			BE PART OF THE LOOP FOR INDEX MODIFICATION
			CHECKING PURPOSES

13	-----	-----	FIX DOCHECK SO IT POPS INDEX PROPERLY

14	 230	-----	LEGAL VARIABLE DIMENSIONS MUST BE ALLOCATED

15	303	16369	CLEAR FLGREG OF ARGUMENT LIST FLAG BETWEEN STATEMENTS

16	307	16611	CLEAR BUFFERS AFTER FINISHING ERROR MESSAGES

17	343	17636	FIX END OF STA. SO THAT THE LINE NUMBER IS CORRECT.

18	462	19960	FIX MRP1 TO ALWAYS LEAVE SREG<LEFT> THE WAY
			IT FOUND IT (FIX PDL OV'S IN LATER PHAZES)

**********	BEGIN VERSION 5A	**********

19	571	22378	DEFINE AND CALL CLERIDUSECNTS AT END OF MRP1
			  TO CLEAR IDUSECNTS OF .I TEMPS SHARED IN
			  DIM TABLE
20	573	-----	REQUIRE DBUGIT.REQ

)%	!END REVISION HISTORY




REQUIRE  DBUGIT.REQ;		![573]  SJW  16-MAY-77

SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;



EXTERNAL  ZZOUTMSG,DIGITS;
EXTERNAL E67,E69,E29,E107,E108,E61,E110,E123;	!ERROR MESSGE POINTERS

EXTERNAL  FATLERR,WARNERR,NUMFATL,NUMWARN,STMNDESC;


	GLOBAL ROUTINE
ENDSTA   =

BEGIN
	EXTERNAL ERLSTR;
	EXTERNAL PSTATE,LEXICAL,GSTLEXEME,GSTNOEND,GSTEOP,ISN,WARNERR,PSTEND,ENDCODE,NEWENTRY,LABLOFSTATEMENT,CONTSTA;
	EXTERNAL  PSTBKIMP,PSTEXEC;

	%CHECK FOR UNIT TERMINATION IN INCLUDE%
	IF .FLGREG<ININCLUD> 
	THEN
	BEGIN	%ITS A NO O %
		PSTATE _ IF .FLGREG<PROGTYP> EQL  BKPROG
			THEN	PSTBKIMP<0,0>
			ELSE	PSTEXEC<0,0>;
		RETURN	FATLERR(.ISN, E123<0,0>)
	END;

	IF .PSTATE  NEQ   PSTEND<0,0>
	THEN
	BEGIN
		% MISSING END STATEMENT %
		WARNERR ( .ISN, E69<0,0> );
		PSTATE _ PSTEND<0,0>;
%**;[343], ENDSTA , MD , 23-JAN-76 %
%**;[343], ADD @ LINE 3239  %
		NAME _ IDOFSTATEMENT _ ENDDATA;![343] CREATE ENTRY BEFORE CALL TO LEXICAL
		NAME<RIGHT> _ SORTAB;![343]
		NEWENTRY();![343]
		LEXICAL ( .GSTNOEND );	! RESTORE LEXICAL TO BEGINNING OF LAST
						! STATEMENT AND PERFORM END OF PROGRAM
						! UNIT PROCESSING
	END
	ELSE
	BEGIN	% WE HAVE AN "END" STATEMENT  %
		
		% MAKE DUMMY CONTINUE LABEL HERE IF LABELELD %
		IF .LABLOFSTATEMENT  NEQ  0
		THEN
		BEGIN	% LABELED END % 
			CONTSTA();
			LABLOFSTATEMENT _ 0
		END
		ELSE	LEXICAL ( .GSTLEXEME ) ;      ! PICK UP EOS


%**;[343], ENDSTA , MD , 23-JAN-76 %
%**;[343], ADD @ LINE 3255  %
		NAME _ IDOFSTATEMENT _ ENDDATA;![343] CREATE ENTRY BEFORE CALL TO LEXICAL
		NAME<RIGHT> _ SORTAB;![343]
		NEWENTRY();![343]
		LEXICAL ( .GSTEOP )	! END OF PROGRAM UNIT PROCESSING

	END;

%**;[343] , ENDSTA , MD ,23-JAN-76 %
%**;[343] , DELETE 3 LINES @ LINE 3260 %

	%CLEAR OUT THE ERROR MESSAGE QUEUE %
	ERLSTR( NOT .FLGREG<TTYDEV> AND NOT  .FLGREG<NOERRORS> );

END;	% ROUTINE  ENDSTA %




	GLOBAL ROUTINE
CKAJDIM  =

BEGIN
	%SCAN THE STACK OF VARIABLES IN DIMSTK TO SEE IF 
	 THEY HAVE BEEN DEFINED AS DUMMIES BY NOW  %

	EXTERNAL  DIMSTK,SAVSPAC,E126,FATLERR,E15;
	REGISTER BASE  LINK:PTR;

	LINK_.DIMSTK<RIGHT>;
	WHILE ( .LINK  )  NEQ  0
	DO
	BEGIN
		PTR _ .(.LINK+1)<RIGHT>;	!VARIABLE OR ARRAY POINTER
		IF .PTR[OPRSP1]  EQL ARRAYNM1
		THEN
		BEGIN
			%ITS AN ARRAY%
			IF NOT .PTR[IDATTRIBUT(DUMMY)]
			THEN  FATLERR( PLIT'A DUMMY ARRAY?0', PTR[IDSYMBOL], .(.LINK+1)<LEFT>,E15<0,0>);
		END
		ELSE
		BEGIN
			%ITS A VARIABLE %
			IF .PTR[OPERSP]  NEQ  FORMLVAR
			   AND   NOT .PTR[IDATTRIBUT(INCOM)]
			THEN	FATLERR ( .PTR[IDSYMBOL],.(.LINK+1)<LEFT>,E126<0,0>);
%**;[230],ROUTINE CKAJDIM,INSERT @ 3289,MD,11/17/74%
%[230]%			PTR[IDATTRIBUT(NOALLOC)]_0; !MUST ALLOCATE
		END;

		LINK _ @( VREG _ .LINK );
		SAVSPAC ( 1,.VREG )
	END
END;
	GLOBAL ROUTINE
LABLCHECK=

BEGIN
	%
	ROUTINE SCANS THE LABEL TABLE AND OUTPUTS A LIST OF UNDEFINED
	LABELS IT ENCOUNTERS.
	%
	EXTERNAL LABTBL,LSTOUT,DECODELINE,LINENO,ZZOUTMSG,HEADCHK;
	LOCAL BASE PTR, UNDEFLABEL,COUNT;
	COUNT _ 0;
	UNDEFLABEL _ 0;
		DECR I FROM LASIZ-1 TO 0 DO
		BEGIN
			IF (PTR _ .LABTBL[.I]) NEQ 0
			THEN
			 BEGIN
			  DO BEGIN
				IF .PTR[SNHDR] EQL 0
				THEN IF .PTR[SNUMBER] LEQ 99999
				   THEN (!ERROR UNDEFINED LABEL
					 IF .UNDEFLABEL EQL 0 THEN( HEADCHK(); ZZOUTMSG(PLIT '?M?J?M?JUNDEFINED LABELS?M?J?M?J?0'));
					UNDEFLABEL _ .PTR[SNUMBER];
					DECODELINE( .UNDEFLABEL );
					ZZOUTMSG( LINENO<0,0> );
					IF (COUNT _.COUNT+1) GTR 3
					THEN (COUNT _ 0; ZZOUTMSG( PLIT'?M?J?0' ); HEADCHK());
					NUMFATL _ .NUMFATL+1; !INCREMENT # OF ERRORS
				    );
			     END WHILE (PTR _ .PTR[CLINK]) NEQ 0;


			 END
		END;
		IF .UNDEFLABEL  NEQ  0
		THEN
		BEGIN
			ZZOUTMSG( PLIT'?M?J?0');
			FLGREG<ERRSW> _ 1; !SET FLAG FOR FATAL ERRORS
		END
END; !OF LABLCHECK



	GLOBAL ROUTINE 
UNDOLABEL= !UNTERMINATED DO LABELS

BEGIN
	%
	ROUTINE IS CALLED BY CLASSIFIER MODULE AFTER END OF PROGRAM
	FLAG IS SEEN AND SOME UNTERMINATED DO LOOPS ARE KNOWN TO EXIST.
	ROUTINE THEN FOLLOWS CHAIN OF UNTERMINATD DO'S AND OUTPUTS THE LOOP TERMINAL LABEL
	MISSING AND THE LINE NUMBER OF THE DO STATEMENT IN WHICH IT WAS FOUND
	%
	EXTERNAL LASDOLABEL,DECODELINE,LINENO,ZZOUTMSG,HEADCHK;
	MAP BASE LASDOLABEL;
	LOCAL BASE PTR;
		FLGREG<ERRSW> _ 1;
		HEADCHK();
		ZZOUTMSG(PLIT'?M?J?M?JUNTERMINATED DO LOOPS?M?J?M?J?0');
		DO
		BEGIN
			HEADCHK();
			PTR _ .LASDOLABEL<RIGHT>; PTR _ .PTR[SNDOLNK];
			ZZOUTMSG(PLIT'LINE: ');
			PTR_.(.PTR)<LEFT>;	!PTR TO DO NODE
			DECODELINE( .PTR[SRCISN] );
			ZZOUTMSG ( LINENO<0,0> );
			ZZOUTMSG ( PLIT'?M?J?0' );
			NUMFATL _ .NUMFATL+1;	!INCREMENT ERROR COUNT
		END UNTIL (LASDOLABEL _ @(.LASDOLABEL<LEFT>)) EQL 0;
END; !OF UNDOLABEL



	GLOBAL ROUTINE 
DOCHECK ( LABNODE )  =

BEGIN
	%LABNODE CONTAINS APOINTER TO A STATEMENT LABEL NODE
	 ADJUST THE DO NEST LEVEL COUNT AND CHECK FOR ILLEGAL NESTING
	 WE GET HERE ONLY IF THE LABEL WAS IN A DO STATEMENT SEEN ALREADY
	%
	EXTERNAL LASDOLABEL,DONESTLEVEL,DOINDEX,FATLEX;
	MAP BASE LABNODE: LASDOLABEL;
	!

	DONESTLEVEL _ .DONESTLEVEL - .LABNODE[SNDOLVL]; !SUBTRACT THE NEST LEVEL OF THE LABEL
	IF .LABNODE NEQ .LASDOLABEL<RIGHT>
		THEN	!INCORRECT DO LOOP NESTING
		(LOCAL BASE SRCPT;
		 SRCPT _ .LASDOLABEL[SNDOLNK]; !THE LINK PTR TO THE LAST DO NODE SEEN
		SRCPT _ .(.SRCPT)<LEFT>; !GET PTR TO SOURCE NODE
		FATLERR ( .SRCPT[SRCISN] %  THE ISN OF THE LAST DO SEEN %
			, .ISN, E29<0,0>)	!ILLEGALLY NESTED DO
		)
		!
		!ELSE UNSTACK NESTED LABELS OF DO'S THAT HAVE THE SAME TERMINAL LABEL
		!
		ELSE
		DO
		BEGIN
			EXTERNAL  CURDOINDEX;
			CURDOINDEX _ @(.LASDOLABEL<LEFT>+1);	!INDEX POINTER
			LASDOLABEL _ @(.LASDOLABEL<LEFT>);	!LABEL POINTER
		END
		UNTIL .LABNODE NEQ .LASDOLABEL<RIGHT>;
END;





	GLOBAL ROUTINE
CKDOINDEX ( ID )   =

BEGIN
	%SEARCH BACK UP THE CURRENTLY ACTIVE DO LOOP LIST AND SEE
	 IF ID ( A POINTER TO A VARIABLE ) IS AN ACTIVE INDEX %

	MAP BASE ID;
	REGISTER LAB,IDX;
	EXTERNAL LASDOLABEL,CURDOINDEX;

	IF .LASDOLABEL EQL 0 THEN RETURN 0;

	LAB _ .LASDOLABEL<LEFT>;
	IDX _ .CURDOINDEX<RIGHT>;

	DO
	BEGIN
		IF .ID<RIGHT>  EQL  .IDX
		THEN	RETURN -1;	!ITS A MATCH
		IDX _ .(@LAB+1)<RIGHT>;
		LAB _ .(@LAB)<LEFT>;
	END
	UNTIL  .LAB  EQL  0;
	RETURN 0	!NO MATCH

END;

MACHOP POPJ=#263;
MACRO CORE(X) = BEGIN
			CALLI(X,#11);
		     END$;
EXTERNAL LOWLOC,SEGINCORE,ILABIX,PHAZCONTROL %()%,ERRLINK,SP,TMPCNT[4],FREELIST,LSAVE,LEXL,LEXEMEGEN %()%;


	GLOBAL ROUTINE
GLOBINIT=		!INITIALIZE ALL GLOBALS
BEGIN
	!FILE GLOBL.BLI HAS ALL THE GLOBALS DEFINED
	EXTERNAL  GLOBEND;

	% FIRST ZERO EVERYTHING UP TO GLOBEND - THERE ARE A FEW AFTER 
	  GLOBEND WHICH SHOULD NOT BE ZEROED FOR EVERY COMPILATION UNIT %

	SYMTBL[0]_ 0;	!THE FIRST GLOBAL IN GLOBL.BLI
	VREG<LEFT>_ SYMTBL<0,0>; VREG<RIGHT> _ SYMTBL[1]<0,0>; !SET BLT POINTER
	BLT(VREG,GLOBEND);	!ZERO THE GLOBAL AREA
	IF .JOBREL  GEQ  .JOBFF  THEN
	BEGIN
	   	(.JOBFF)<FULL> _ 0;
		IF .JOBREL  GTR  .JOBFF  THEN
		BEGIN
			VREG<LEFT> _ .JOBFF; VREG<RIGHT> _ .JOBFF+1;
			BLT(VREG,.JOBREL)
		END
	END;
	!INITIALIZE GLOBAL AREA
	BEGIN
		EXTERNAL ENTRY,SYMTYPE,TBLSEARCH,NAME,ONEPLIT,PROGNAME;
		EXTERNAL GINTEGER,GREAL,PAGE,PAGELINE,NONIOINIO;
		REGISTER T1,T2;
	
		ILABIX _ 100000;	!INITIAL TEMPORTRY LABEL VALUE
		TYPTAB["A"-"A"]_GREAL<0,0>;
		T1<LEFT>_TYPTAB["A"-"A"];T1<RIGHT>_.T1<LEFT>+1;
		BLT(T1,TYPTAB["Z"-"A"]);
		T1<LEFT>_TYPTAB["I"-"A"];T1<RIGHT>_.T1<LEFT>+1;
		TYPTAB["I"-"A"]_GINTEGER<0,0>;
		BLT(T1,TYPTAB["N"-"A"]);
		PROGNAME _ SIXBIT'MAIN.';
		PAGE _ 1^18;
		PAGELINE _ -1;
		NONIOINIO _ 0;
		FLGREG<ERRSW> _ 0;
		SPACEFREE_@JOBREL-@JOBFF;
		SEGINCORE_1;
		FLGREG<BLKDATA> _ 0;	! CLEAR THE BLKDATA BIT
		FLGREG<LABLDUM> _ 0;	! LABEL FORMALS PARAMETERS
		FLGREG<PROGTYP> _ MAPROG;	! MAIN PROGRAM
		FLGREG<MULTENT> _ 0;	! MULTIPLE ENTRIES FLAG
		FLGREG<ENDFILE> _ 0;	!CLEAR END OF FILE FLAG
		FLGREG<BTTMSTFL> _ 1;	!BOTTOMMOST SUBROUTINE FLAG
		
		
		LOWLOC _ 1;

	END	!OF GLOBI1

	!
END;	!OF ROUTINE GLOBINIT


!**[571] DRIVER @3534  SJW  11-MAY-77
![571]  DEFINE ROUTINE CLERIDUSECNTS BEFORE ROUTINE MRP1
ROUTINE  CLERIDUSECNTS =
BEGIN
	EXTERNAL  DTABPTR;		! HEAD OF DIM ENTRY LIST
	LOCAL  PTR;			! TO MARCH DOWN LIST
	LOCAL DIMENTRY  E;		! ONE ELEMENT ON LIST
	LOCAL BASE  ITEMP;		! SYM TAB ENTRY FOR .I TEMPORARY

	LABEL  CHECKTHIS;

	PTR _ .DTABPTR<RIGHT>;		! START AT HEAD OF LIST
	WHILE  .PTR NEQ 0
	  DO BEGIN
	    E _ .PTR;			! THIS DIM TABLE ENTRY
CHECKTHIS:  BEGIN
	      IF .E [DIMNUM] LSS 2	! OFFSET SHARED IS FOR 2ND DIM
		THEN LEAVE CHECKTHIS;
	      IF NOT .E [ADJDIMFLG]	! SHARED ONLY IF ADJUSTABLE DIMS
		THEN LEAVE CHECKTHIS;
	      ITEMP _ .E [DFACTOR (1)];	! SYM TAB ENTRY OF .I TEMP
	      ITEMP [IDUSECNT] _ 0;	! CLEAR USE COUNT
	    END;			! OF CHECKTHIS
	    PTR _ .E [ARALINK];		! NEXT ELEMENT
	  END;				! OF WHILE  .PTR NEQ 0
END;					! OF CLERIDUSECNTS

	GLOBAL ROUTINE
MRP1=

BEGIN
	REGISTER T1,T2;
	EXTERNAL  ENDUNIT;
	EXTERNAL GSTSTMNT,GSTLEXEME,BUGOUT,GSTNOEND,GSTEOP,ERLSTR;
	EXTERNAL  FATLERR,LEXLINE,STALABL;
	EXTERNAL LEXICAL,STMNDESC,STRNGOUT;
	EXTERNAL  ENDOFILE;
	EXTERNAL  ISN,PSTEND,DECODELINE,WARNERR;
	BIND  EOSLEX = 5;
	EXTERNAL  EOPRESTORE,EOPSVPOOL;
	EXTERNAL  CURPOOLEND,POOL;
	EXTERNAL ENTRY,TBLSEARCH,SYMTYPE;
	EXTERNAL JOBERR,JOBFFSAV,ENDSTA,WARNOUT,ERRMSG,CCLSW,ONEPLIT;
	EXTERNAL LASDOLABEL,ADJCALL;
	EXTERNAL LINENO,PAGEHEADING;
	LABEL COMPILATION;
	BIND EOF =#200;

	%REDUCE THE STACK BY POOLSIZ BECAUSE POOL CANNOT
	  BE DESTROYED LIKE THE OLD DAYS%
	SREG _ .SREG  + POOLSIZ^18;

	% FIRST PROGRAM UNIT INITIALIZATION %
	CURPOOLEND _ POOL[0]<0,0>;
	LINENO[1] _ '	';	! TAB FOLLOWING LINE NUMBERS

		BEGIN	%CHECK AND SET APPROPRIATE FLAGS FOR DEBUG SWITCH%
			
			MACRO
				%DEFINE BIT POSITIONS AS SET BY SCAN FOR
					THE VARIOUS DEBUG MODIFIERS.  THESE ARE SET
					IN DEBGSW.
		
					THE LEFT HALF INDICATES WHICH MODIFIERS HAVE
					BEEN SPEICFICALLY EXCLUDED AND THE RIGHT HALF
					INDICATES THOSE WHICH HAVE BEEN INCLUDED
				%
		
				DBSDIMN = 0,1$,
				DBSLABL = 1,1$,
				DBSINDX = 2,1$,
				DBSTRAC = 3,1$,
				DBSBOUN = 4,1$;
		
			BIND  NUMSWITCHES = 5;
		
			BIND	DEBUGFLGS =
					% FLGREG BIT POSITIONS FOR THE VARIOUS MODIFIERS%
					1^DBGDIMNBR +
					1^DBGINDXBR +
					1^DBGLABLBR +
					1^DBGTRACBR +
					1^DBGBOUNBR     ;
		
			EXTERNAL  DEBGSW;	!SWITCH VALUE VARIABLE - SET BY SCAN
		
			REGISTER R;
		
			% FIRST CHECK FOR SPECIFIC EXCLUSIONS.  IF ONLY EXCLUSIONS ARE
			  SPECIFIED IT IMPLIES A REQUEST FOR THE REST %
		
			IF .DEBGSW<LEFT>  LSS  1^NUMSWITCHES
				AND  .DEBGSW<LEFT>  NEQ  0
				AND  .DEBGSW<RIGHT>  EQL  0
			THEN
				%ONLY EXCLUSIONS - INCLUDE THE REST %
				R _ NOT .DEBGSW<LEFT>
			ELSE
				% RIGHT SIDE IS GOOD %
				R _ .DEBGSW<RIGHT>;
		
			%CLEAR SWITCHES IN FLGREG %
			FLGREG<FULL> _ .FLGREG<FULL>  AND  ( NOT  DEBUGFLGS );
		
			% NOW SET THE SPECIFIC SWITCHES %
			IF .R NEQ  0
			THEN
			BEGIN
				EXTERNAL FATLERR,E133;

				IF .R<DBSDIMN>  THEN  FLGREG<DBGDIMN> _ -1;
				IF .R<DBSINDX>  THEN  FLGREG<DBGINDX> _ -1;
				IF .R<DBSLABL>	THEN  FLGREG<DBGLABL> _ -1;
				IF .R<DBSTRAC>	THEN ( FLGREG<DBGTRAC> _ -1; FLGREG<DBGLABL> _ -1 );
				IF .R<DBSBOUN>	THEN  FLGREG<BOUNDS> _ -1;

				%NO GLOBAL OPTIMIZATION IF /DEBUG%
				IF .FLGREG<OPTIMIZE>
				THEN 	( EXTERNAL LINELINE;
					 LINELINE _ -1;	%TO GET THE MESSAGE PRINTED%
					 FLGREG<OPTIMIZE>_0; FATLERR(0,E133<0,0>));

			END
		END;	%DEBUG MODIFER PROCESSING%
		
	PAGEHEADING();		! BUILD THE PAGE HEADING SKELITION
	FLGREG<FATALERR> _ FLGREG<WARNGERR> _ 0;

!**;[462] Change @ line 3614 in MRP1	JNG	24-Sep-76
%[462]%	IF  EOPRESTORE()  EQL  EOF
%[462]%	THEN
%[462]%	BEGIN
%[462]%		SREG _ .SREG - POOLSIZ^18;	!RESTORE THE STACK
%[462]%		RETURN 0
%[462]%	END;




COMPILATION:
	WHILE 1
	DO
	BEGIN	% COMPILATION LOOP %
		LABEL  STATEMENT;
		EXTERNAL  PSTATE,GINTEGER;

		GLOBINIT();	! INITIALIZE THE GLOBAL AREA

		JOBFFSAV _ .JOBFF;	!SAVING THE STATE OF THE LOW SEG
		% CREATE A CONSTANT NODE FOR 1 %
		NAME _ CONTAB;	SYMTYPE _ GINTEGER<0,0>;	ENTRY[1] _ 1;
		ONEPLIT _ TBLSEARCH();

		DO
		STATEMENT:BEGIN	% PROGRAM UNIT LOOP %

			LABLOFSTATEMENT _ 0;
%**;[303],DRIVER,JNT,18-JUN-75%
%**;[303],IN MRP1 @ 3625 (AFTER STATEMENT:)%
			FLGREG<FELFLG>_0;	![303] CLEAR ARG LIST FLAG

			% CLASSIFY THE NEXT STATEMENT %
			WHILE 1 DO
			BEGIN
				IF LEXICAL ( .GSTSTMNT )  NEQ  ENDOFILE<0,0>
				THEN	EXITLOOP

				ELSE
				BEGIN	% MISSING END STATEMENT %
					EXTERNAL POSTINCL;
					IF .FLGREG<ININCLUD> THEN POSTINCL()
					ELSE
					IF .PSTATE  EQL  0
					THEN  ( LEXICAL(.GSTEOP);LEAVE COMPILATION)
					ELSE (  ENDSTA();
						LEAVE STATEMENT	!SKIP REST OF STATEMENT PROCESSING
						)
				END
			END;

			BEGIN	% CLASSIFIED STATEMENT %


				EXTERNAL  CREFIT;
				BIND LINNE = 2;
				IF .FLGREG<CROSSREF>  THEN CREFIT(.ISN,LINNE);	!LINE NUMBER OF STATEMENT

				IF DBUGIT THEN
				BEGIN
					EXTERNAL STRNGOUT,LINENO;
					REGISTER  T;
					IF ( T_.BUGOUT AND 4)  NEQ  0
					THEN
					BEGIN
						STRNGOUT(KEYWRD(.STMNDESC));
						DECODELINE(.ISN);
						STRNGOUT(PLIT(' CLASSIFICATION - STATEMENT '));
						STRNGOUT (LINENO);
						STRNGOUT(PLIT'?M?J');

					END
				END;

			% CHECK STATEMENT ORDERING  %
			
				% STRUCTURE FOR THE STATMENT ORDER CHECKING STATE TABLE %
				BEGIN

				STRUCTURE	ORDERTAB[ST,CD] =
					.ORDERTAB+(.CD*(PSTEND<0,0>+1))+.ST;

	
			
				EXTERNAL  STMNSTATE,STMNDESC,PSTATE;
				MAP  ORDERTAB  STMNSTATE;
			
				REGISTER CODE;
				IF ( CODE _ .STMNSTATE[ .PSTATE, .ORDERCODE( @STMNDESC) ] ) LEQ PSTEND<0,0>
				THEN
				BEGIN	% VALID ORDERING %
					PSTATE _ .CODE
				END
				ELSE
				BEGIN	% ILLEGAL ORDERING %
					EXTERNAL  ISN,FATLERR,WARNERR;
					CASE (.CODE-PSTEND<0,0>-1) OF SET
			
					%OW - ORDER WARNING %
					BEGIN
						WARNERR ( KEYWRD(@STMNDESC)<0,0>, .ISN, E107<0,0>  )
					END;
			
					% ED - MISSING END %
					BEGIN
						ENDSTA();
						LEAVE   STATEMENT	! END OF PROGRAM UNIT
					END;
			
					% BD - ILLEGAL STATEMENT IN BLOCK DATA %
					BEGIN
						FATLERR ( .ISN, E108<0,0> );
						LEAVE STATEMENT	! SKIP THE STATEMENT
					END;
			
					% IE - INTERNAL COMPILER ERROR %
					BEGIN
						EXTERNAL FATLERR;
						FATLERR ( PLIT'STORDER',.ISN,E61<0,0>)
					END
				
					TES
				END
				END
			END;
			

			% PROCESS LABELS HERE  %

			IF .STALABL  NEQ  0
			THEN
			BEGIN	% FOUND A LABEL %
				EXTERNAL  LABLEGAL,GLEGAL,GILLEGAL,LABDEF;

				IF (T1 _ .LABOK( @STMNDESC )  )  EQL   GLEGAL<0,0>
				THEN
				BEGIN	% LEGITIMATE LABEL %
					LABDEF()
				END
				ELSE
				BEGIN
					IF .T1  EQL  GILLEGAL<0,0>
					THEN	FATLERR( PLIT'NON-EXECUTABLE?0',.ISN,E110<0,0>);
	
					% ELSE DELAYED LABEL PROCESSING FOR ARRAY ASSIGNMENTS / STMNT FNS  %
				END
			END;
	

			BEGIN
			EXTERNAL  SP,LSAVE,LOOK4LABEL,SYNTAX;

			% EXECUTE THE STATEMENT ROUTINE %
			SP _ -1;	LSAVE _ 0;	LOOK4LABEL_0;	! STACK AND LEXEME INITIALIZATION
			% EXECUTE SYNTAX FOR THOSE STATEMENTS WHICH DO IT FIRST %
			IF ( T1_.SYNOW(@STMNDESC))  NEQ  0
			THEN	IF  SYNTAX (.T1)  LSS  0 THEN  LEAVE STATEMENT;

			% NOW THE SEMANTICS ROUTINE %
			( .STMNROUTINE( @STMNDESC )) () ;

			%UNLINK LOOP LIST IF NECESSARRY%
			IF .LABLOFSTATEMENT NEQ 0
			THEN
			BEGIN
				MAP BASE LABLOFSTATEMENT;
				IF .LABLOFSTATEMENT[SNDOLVL] NEQ 0
				THEN	DOCHECK(.LABLOFSTATEMENT)
			END;

			END;

		END
		UNTIL  .PSTATE  EQL  PSTEND<0,0>;

%**;[307],DRIVER,JNT,26-JUN-75%
%**;[307],IN MRP1 @ 3769%
		CKAJDIM();	!CHECK FOR BAD VARIABLE DIMENSIONS

		LABLCHECK();	!CHECK FOR UNDEFINED LABELS

!**[571] MRP1 @3816  SJW  11-MAY-77
%[571]%		CLERIDUSECNTS ();	! CLEAR .I USECNTS IN SHARED DIM ENTRIES

		EOPSVPOOL();	![307] SAVE BUFFERS BETWEEN PROGRAM UNITS

		IF .LASDOLABEL NEQ 0 THEN UNDOLABEL(); !OUTPUT LIST OF UNTERMINATED DO LOOPS

		IF .NUMFATL  EQL  0
			THEN IF NOT .FLGREG<SYNONLY> THEN
			  BEGIN
				EXTERNAL ADJCALL,PHAZCONTROL;
				EXTERNAL FFBUFSV;

				LOCAL REG0SAV,LFFBUFSV;
				 LFFBUFSV _ .FFBUFSV;	!JOBFF FOR PROPER REALLOCATION OF BUFFERS
				 REG0SAV_.FLGREG;
				ADJCALL();	!INSERT CALLS FOR ADJUSTABLE DIMENSIONS

				%ADD POOLSIZ BACK TO THE STACK%
				SREG _ .SREG - POOLSIZ^18;

				PHAZCONTROL();
				FLGREG_.REG0SAV;
				FFBUFSV _ .LFFBUFSV;
				% REMOVE POOLSIZ FROM THE STACK AGAIN%
				SREG _ .SREG + POOLSIZ^18;

			  END;

		ENDUNIT();	!END OF PROGRAM UNIT MESSAGES

		IF .FLGREG<ENDFILE>  THEN LEAVE COMPILATION;

		EOPRESTORE();	! RESTORE THE STATEMENT BUFFER

		!
		!RESET SIZE OF LOWSEG
		BEGIN MACHOP JFCL=#255;
		!
			JOBFF _ VREG _ .JOBFFSAV<RIGHT>;
			CORE(VREG);
			JFCL(0,0);
		END;
	END;	% COMPILATION %

!**;[462] Insert @ line 3833 in MRP1	JNG	24-Sep-76
%[462]%	SREG _ .SREG - POOLSIZ^18;	!RESTORE THE STACK



END;		!END OF MRP1
MRP1();
POPJ(SREG,0)
END ELUDOM