Google
 

Trailing-Edge - PDP-10 Archives - bb-d868b-bm_tops20_v3a_2020_dist - 3a-sources/sn1n.bli
There are 18 other files named sn1n.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
!  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!
!COPYRIGHT (C) 1972,1973,1974,1977,1978 DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. 01754
!FILENAME:	H1SYNT.BLI
!DATE:		10 JANUARY 74	MGM/FLD/KR


!  REVISION HISTORY  :
!
!  12-28-77 ROUTINES UPLEVELCHECK,IDCHECKER,SSPUNOP,SSPLF,
!           SML ARE MODIFIED AND SYMVALUE OWN VARIABLE IS ADDED
!	    TO FIX BUG#4.
!
!  12-27-77 ROUTINE UPLEVELCHECK IS ADDED TO CHECK REGISTER
!	    DECLARATIONS AND USAGES INSIDE ROUTINES AND IMBEDDED
!	    ROUTINES (GLOBAL ALSO). REPLACE REGISTER LEXEME BY
!	    REGISTER VALUE IF VALID IN A CONTEXT.
!
!  12-21-77 ROUTINE IDCHECKER IS MODIFIED TO FIX BUG#4.
!	    NESTED GLOBAL ROUTINES DECLARING REGISTERS WITH SAME
!	    NAME.
!
!  9-19-77 ROUTINE CONSTCASE,SIF ARE MODIFIED
!          TO FIX BUG#46,NESTED IF EXPRESSIONS OR CASE EXPR.
!
!  7-15-77  ROUTINE FIXBADEXP IS MODIFIED SO THAT AN UNDEFINED
!           SYMBOL IN A BLOCK IS TREATED AS AN EXTERNAL AFTER
!           GIVING FIRST WARNING MESSAGE.THIS WILL NOT GIVE ANYMORE
!           MESSAGE FOR THIS SYMBOL IN THIS BLOCK WHEREEVER USED.
!           THIS WILL ELIMINATE LOTS OF ERROR MESSAGES AND NOTIFIES
!           THE USER ONCE ONLY.
!    6-2-77     ROUTINE SCOMPOUND IS MODIFIED SO THAT NO LOCALS
!	        ARE ADDED AND SUBTRACTED AT BLOCK LEVEL.IT DONE
!	        ONLY AT THE BEGINING OF ROUTINE ENTRY AND EXIT.
!	        IF LOCALS ARE DEFINED AT MODULE LEVEL AND NO ROUTINES
!	        INT THAT MODULE ,IT IS SAME AS OLD METHOD.
!	        THIS WILL NOT CLOBBER STACK FOR LOCALS AND PUSH.
!
!   5-27-77     MACRO CLOSEBR IS MODIFIED TO FIX BUG#11 IN
!	        BLISS10.DOC.THIS RECOGNIZES THE CASE X[]_.X[] +1.
!	        IT SETS A FLAG TO BE USED IN GTGOTM IN GT1.BLI.
!
!    5-16-77	FIX ROUTINE SSPLF TO CALL FIXSIDEEFFECTS FOR
!		CHARACTER HANDLING SPECIAL FUNCTIONS.  FIXES
!		BUG 30.
!
!    5-15-77	FIX ROUTINE SUSERCALL AND SCOMPOUND TO ALLOW
!		THE LATTER TO KEEP TRACK OF THE NUMBER OF ACTUAL
!		ARGUMENTS THAT ARE ON THE STACK WHEN A BLOCK
!		IS PROCESSED.  LOCALS IN SUCH A BLOCK USED TO
!		OVERWRITE ACTUAL ARGUMENTS ALREADY PUSHED ON THE
!		STACK.  FIXES BUG 26.
!
!   5-9-77   ROUTINE SPLIT CALLS SPLIT1.THE CHANGE IS DUE TO
!            OWN OR GLOBAL INITIALIZATION.THEY ARE HANDLED AS
!            PLITS IN SOME SENSE.SPLIT1 IS MODIFIED TO DO THIS.
!            ROUTINE TUPLEITEM AND SUSERCALL WERE MODIFIED TO FIX
!             BUGS REPLICATION COUNT LSS 0 AND LAST ARGUMENT 
!             OF A ROUTINE CALL IN A STRUCTURE.
!	      ROUTINE SPLIT1 IS SAME AS SPLIT EXCEPT FEW CHANGES.
!
%%
%
		F I X E S

	5.200.2 - IN SPTR, CAUSES A NON ZERO TO BE LEFT
		  IN SYM, CORRECTING THE BUG
		  WHERE A<> IS COMPILED UNDER /X (CODETOG=0)


		  FIXBADEXP ADDED TO TEST FOR UNDECLARED NAMES
		  AND FOR STRUCTURE, LINKAGE, LABEL NAMES
		  APPEARING IN EXPRESSIONS.
%
%%
%3.40%	GLOBAL BIND H1SYV=4;	!MODULE VERSION NUMBER
!                   SYNTAX ANALYSIS ROUTINES
!             ---------------------------------------




! FORWARD REFERENCE DECLARATIONS
!--------------------------------

OWN SYMVALUE;	%SYM VALUE IS RETURNED. USED IN UPLEVELCHECK,SML,SSPLF,SSPUNOP AND FIX BUG#4 DEC-28-77 %
FORWARD  SCOMPOUND,SOPERATOR,SML;







! INIT CODE FOR SYNTAX
!----------------------


%3.1%	GLOBAL ROUTINE INITSYNTAX=
	( ERRORFOUND_ERRLEVEL_0; HRUND(); HRUND());
! BOOLEAN PREDICATES AND SMALL MISC. SERVICE ROUTINES
!-----------------------------------------------------


ROUTINE SEFOLLOWS=
	(.DEL<26,1> AND (IF .SYM EQL HEMPTY THEN
			NOT(.DEL<25,1>) ELSE .DEL<25,1>));

ROUTINE AEFOLLOWS=
	(.DEL<24,1> AND (IF .SYM EQL HEMPTY THEN
			NOT(.DEL<25,1>) ELSE .DEL<25,1>));

ROUTINE  FUTAE=
	(.FUTDEL<24,1> AND ( IF .FUTSYM EQL HEMPTY THEN
			NOT(.FUTDEL<25,1>) ELSE .FUTDEL<25,1>));

ROUTINE CORRECTP1=
	BEGIN
	.FUTSYM EQL HEMPTY AND
		(.FUTDEL<HCLASS> EQL CLOBRAC OR .FUTDEL<HCLASS> EQL OPRTR
		OR .FUTDEL<LEFTHALF> EQL HPAROPEN
                OR .FUTDEL<LEFTHALF> EQL HSQOPEN
		OR .FUTDEL<LEFTHALF> EQL HPTOPEN)
	END;

ROUTINE HDELCLASS=
	(IF .DEL<HCLASS> EQL 1 THEN SOPERATOR() ELSE (@DEL)());


ROUTINE SUCCESSIVERELATIONALS(OP)=
	(.OP<HPRIORITY> EQL #30  AND  .DEL<HPRIORITY> EQL #30);


ROUTINE FIXBADEXP=
	IF BADEXPTYPE^(-.ST[.SYM<STEF>,0]<TYPEF>)
	THEN (
		EMESSAGE("ERROR"," FOR ","THE S","YMBOL"," :   ",5);
		EOSTN(.SYM<STEF>);
		ENEWLINE();
                !MAKE UNDEFINED SYMBOLS AS EXTERNAL IN A BLOCK  6-21-77
                ! GIVE WARNINGS ONCE ONLY FOR A SYMBOL IN A BLOCK
		WARNEM(.NSYM,
		IF .ST[.SYM<STEF>,0]<TYPEF> EQL UNDEDT
                THEN (ST[.SYM<STEF>,0]<TYPEF>_EXTRNT;#437)
		 ELSE ERRBADSYM);
		SYM_ZERO);


ROUTINE NOERRORS=(.ERRORFOUND EQL 0);

ROUTINE SHUTOFFCODE= CODETOG_.CODETOG^1;

ROUTINE TURNONCODE= IF .CODETOG NEQ 0 THEN CODETOG_.CODETOG^(-1);

ROUTINE FIXFUTDEL=
    IF .FUTSYM EQL HEMPTY THEN
	BEGIN
	IF .FUTDEL<LEFTHALF> EQL HMIN THEN
	    (FUTDEL_NGNEG<0,0>; FUTDEL<LEFTHALF>_HNEG) ELSE
	IF .FUTDEL<LEFTHALF> EQL HPLUS THEN
	    (LOCAL A,B; A_.SYM; B_.DEL; WRUND(1);
		SYM_.A; DEL_.B) ELSE
	0
	END;
! SYNTAX ERROR REPORTING AND RECOVERY ROUTINES
!----------------------------------------------

%3.1%	GLOBAL ROUTINE RECOVER(POSN,M) =
BEGIN	!
	!  THIS ROUTINE IS CALLED TO REPORT AN ERROR AND RECOVER TO
	! A SENSIBLE POINT --- WHERE SENSIBLE IS DEFINED TO BE ANY
	! UNMATCHED CLOSE BRACKET. ANY OPEN BRACKET SEEN ALONG THE
	! WAY TO OUR UNMATCHED CLOSE IS USED TO TRIGGER SYNTAX ANALYSIS
	! OF ITS INTERIOR.
	!
	ERROR(.POSN,.M);
	!IF CALLED WITH _ IN DEL, WE LOOP FOREVER UNLESS WE MOVE
	!THE WINDOW BEFORE ENTERING THE UNIL LOOP
	IF .DEL <LEFTHALF> EQL HSTO THEN HRUND();
	UNTIL .DEL<LEFTHALF> EQL HSTO OR .DEL<HCLASS> EQL CLOBRAC DO
	BEGIN IF .DEL<HCLASS> EQL OPENBRACKET AND .DEL<ADDRESSF> NEQ 0
		THEN    BEGIN
			ERRLEVEL_0;
                        (.DEL)();
			ERRLEVEL_1
			END
		ELSE HRUND()
	END 
END;
	


ROUTINE DEMAND(PPOSN,ERR,TYPE)=
	BEGIN
	!
	!  THIS ROUTINE IS SIMILAR TO RECOVER IN THAT IT REPORTS
	!  AN ERROR THEN ATTEMPTS TO SCAN AHEAD AND RECOVER. IT 
	!  DIFFERS IN THAT ONLY CERTAIN TYPES OF CLOSING DELIMITERS
	!  ARE ACCEPTABLE.  THE ROUTINE IS CALLED ONLY FROM SPECIFIED
	!  "DEMAND RECOVERY" POINTS -- EG. COMPOUND STMTS.
	!
	DO (HRUND(); RECOVER(.PPOSN,.ERR)) UNTIL
	    CASE .TYPE OF
		SET
		%0% .DEL<LEFTHALF> EQL HSEMCOL  OR  .DEL<LEFTHALF> EQL HROCLO;
		%1% .DEL<LEFTHALF> EQL HSEMCOL  OR  .DEL<LEFTHALF> EQL HEND;
		TES
	END;


	ROUTINE UPLEVELCHECK(XXX)=
	BEGIN
	% XXX - ST POINTER OF REGISTER LEXEME.
	  SYMVALUE - REGISTER NAME IS RETURNED.
	  RETURNS REGISTER NAME IF THE REGISTER USAGE IS VALID IN
		A CONTEXT.
	  DEC-27-1977
	%
	LOCAL STVEC TEMP;
		TEMP=.XXX<STEF>;
		IF .TEMP[0]<TYPEF> EQL REGT THEN
		  BEGIN
		  IF .TGRBLEVEL GEQ .TEMP[0]<BLF> AND .FCNSTATE EQL 3
		    THEN ERROR(.NSYM,#40)
		    ELSE
		     ( SYMVALUE=.TEMP[1]<ADDRESSF>;
		       SYMVALUE<VEF>=1;
		       RETURN 1
		     );
		  END;
		RETURN 0
	END;

%3.1%	GLOBAL ROUTINE IDCHECKER(P,N)=
	BEGIN LOCAL L,TEMP;	%12-21-77%
	INCR I FROM 1 TO .N DO
	    BEGIN
	    L_@(@P-@I);
	    TEMP=(@P-@I);	%12-21-77%
            IF .L<LSF> THEN
		BEGIN
		CHECKEXTER(.L<LINKF>);
		IF NOT CHKULA(.L<LINKF>) THEN ERROR(.NSYM,#40);
	%THE FOLLOWING 1 LINE WERE ADDED ON 12-21-77 TO FIX BUG=#4 %
		IF UPLEVELCHECK(.L) THEN  .TEMP=.SYMVALUE;
		END;
	    END;
	END;
! ACTUAL SYNTAX ROUTINES FOLLOW
!-------------------------------


%V2H%	GLOBAL ROUTINE SLABEL=

%V2H%	  !WE HAVE ENCOUNTERED A LABEL FOLLOWED BY COLON; THE LABEL
%V2H%	  !LEXEME IS IN SYM, COLON LEXEME IN DEL.  READ ALL LABELS UNTIL
%V2H%	  !WE RUN OUT.  CHAIN ALL LABEL STES TOGETHER AND PUT CHAIN
%V2H%	  !INDEX INTO GLOBAL LABIND.

%V2H%	  BEGIN

%V2H%	    REGISTER STIND;	!TO HOLD INDEX OF LABEL STE

%V2H%	    DO
%V2H%	      BEGIN
%V2H%		IF .ST[STIND_.SYM<STEF>,1]<DEADALIVEF> NEQ 0
%V2H%		  THEN EXITCOMPOUND WARNEM(.NSYM,ERALUSEDLAB);
%V2H%		ST[.STIND,1]_.LABIND;	!STORE INDEX TO PREVIOUS LABEL
%V2H%		LABIND_.STIND;		!SAVE INDEX TO CHAIN OF LABELS
%V2H%	      END
%V2H%	      UNTIL (HRUND(); .DEL<LEFTHALF> NEQ HLABCOLON);	!UNTIL NO MORE LABELS

%V2H%	    IF .DEL<HCLASS> NEQ 0 %OPEN BRACKET%	!LABELS MUST PRECEDE OPEN BRACKET
%V2H%	      THEN (LABIND_0; WARNEM(.NDEL,ERCANTLABEL));
%V2H%	  END;



%V2H%	ROUTINE BIRTHLABEL(HIND)=

%V2H%	  !HIND - IS THE INDEX OF THE HEADER CELL OF THE EXPRESSION WHICH 
%V2H%	  !IS TO BE LABELLED BY THOSE LABELS IN THE CHAIN POINTED TO BY
%V2H%	  !GLOBAL LOCATION LABIND.

%V2H%	  !BIRTHLABEL STORES .HIND INTO THE PREVF OF THE ADDINFO WORD OF
%V2H%	  !ALL LABEL STES AND TURNS ON THE ALIVE BITS IN ALL STES TO
%V2H%	  !INDICATE THAT THERE ARE NO LABELS WHICH HAVE BEEN READ,
%V2H%	  !BUT NOT LINKED TO AN EXPRESSION.

%V2H%	  !BIRTHLABEL RETURNS THE INDEX TO THE STE CHAIN AS ITS VALUE.

%V2H%	  !ALL STES UPON ENTRY TO BIRTHLABEL MUST BE IN DORMANT
%V2H%	  !STATE:	DEADB=ALIVEB=0.
%V2H%	  !THEY WILL BE IN ALIVE STATE ON EXIT FROM BIRTHLABEL:	ALIVEB=1.

%V2H%	  BEGIN

%V2H%	    REGISTER	NEWSTUFF,	!WILL CONTAIN ALIVEM(ASK) + INDEX
%V2H%					!TO LABELLED EXPR TO BE ADDED TO
%V2H%					!ALL STES.
%V2H%			STIND;		!INDEX OF CURRENT STE.

%V2H%	    NEWSTUFF_ALIVEM+.HIND^15;	!HIND GOES IN PREVF
%V2H%	    STIND_.LABIND;		!GET INDEX TO FIRST STE.

%V2H%	    DO
%V2H%	      BEGIN
%V2H%		ST[.STIND,1]_.ST[.STIND,1]+.NEWSTUFF;	!UPDATE STE
%V2H%		STIND_.ST[.STIND,1]<NEXTF>;		!GET INDEX TO NEXT STE
%V2H%	      END
%V2H%	    UNTIL .STIND EQL 0;	!SIGNIFYING END OF THE CHAIN.

%V2H%	    STIND_.LABIND; LABIND_0;	!ZERO LABIND
%V2H%	    RETURN .STIND;		!AND RETURN THE INDEX TO THE CHAIN.
%V2H%	  END;



%V2H%	ROUTINE KILLLABEL(CHAIN)=

%V2H%	  !WE HAVE FINISHED COMPILING THE EXPRESSION WHICH WAS
%V2H%	  !LABELLED BY THE STES IN THE CHAIN POINTED TO BY CHAIN.
%V2H%	  !NOW WE WANT TO TURN ON ALL DEADBITS IN THE
%V2H%	  !CHAIN SO THAT LEAVE EXPRESSIONS WILL NOT BE ABLE TO REFERENCE
%V2H%	  !THE NOW DEFUNCT LABELS.  THIS ASSUMES ALL LABELS ARE IN
%V2H%	  !ALIVE STATE.  IT LEAVES ALL LABELS IN DEAD STATE.

%V2H%	  BEGIN

%V2H%	    REGISTER STIND;	!HOLDS CURRENT STE INDEX

%V2H%	    STIND_.CHAIN;		!GET INDEX TO FIRST STE

%V2H%	    DO
%V2H%	      BEGIN
%V2H%		ST[.STIND,1]<DEADALIVEF>_1;	!DEADB ON, ALIVEB OFF
%V2H%		STIND_.ST[.STIND,1]<NEXTF>;	!GET INDEX TO NEXT STE
%V2H%	      END
%V2H%	    UNTIL .STIND EQL 0;	!SIGNIFYING END OF THE CHAIN

%V2H%	  END;
%3.1%	GLOBAL ROUTINE EXPRESSION(TOG)=
	BEGIN LOCAL SAVDEC; EXTERNAL INDECS; 
	!
	! THIS ROUTINE, WHEN CALLED, WILL COMPILE THE CODE
	! FOR A SIMPLE EXPRESSION -- IT IS CALLED FROM A
	! VARIETY OF PLACES IN THE SYNTAX ANALYZER TO DO
	! JUST THAT. ON EXIT A CLOSE BRACKET OF SOME FORM
	! IS IN 'DEL', AND THE LEXEME FOR THE VALUE OF
	! THE EXPRESSION IS IN 'SYM'.
	! THE PARAMETER 'TOG' IS SIMPLY PASSED ON TO
	! 'GENCODE' TO CONTROL ACTUAL CODE GENERATION.
	!
	!
%V2H%	  IF .DEL<LEFTHALF> EQL HLABCOLON	!THEN WE HAVE ONE OR MORE LABELS.
%V2H%	    THEN SLABEL();			!GO PROCESS THEM
	SAVDEC_.INDECS; INDECS_0;
	WHILE .DEL<HCLASS> NEQ CLOBRAC DO
	    IF AEFOLLOWS()
		THEN HDELCLASS()
		ELSE IF .DEL<HCLASS> EQL DCLRTR
		    THEN RECOVER(.NDEL,21)
		    ELSE RECOVER(.NDEL,1);
%5.200.19%	IF .SYM<LSF> THEN FIXBADEXP();

	SYM_GENCODE(.SYM,.TOG);
	INDECS_.SAVDEC; REALS_0;
	END;
%3.1%	GLOBAL ROUTINE SCOMPOUND=

% PRINCIPLE:  READ UNTIL THE MATCHING CLOSING BRACKET(END OR ROCLO)
	1.READ ONCE SO THAT THE NEXT DELIMITER IS IN DEL.
	2.PROCESS THE DECLARATIONS.
	3.PROCESS THE EXPRESSIONS IN SUCCESSION.
	4.ACCEPT AN ARBITRARY EXPRESSION IN SUCCESSION.
	5.WHEN A SEMICOLON IS FOUND SKIP AND START ALL OVER AGAIN.
	6. IF THE CLOSING BRACKET IS FOLLOWED BY AN HEMPTY FUTSYM
	(IT SHOULD BE HEMPTY) PUT RESULT IN FUTSYM AND READ ONCE MORE%

%V2H%	BEGIN LOCAL BRAC,NOPEN, SEMCNT, NXTLOC, BLKP,CPPSAVER,SESSAVER,STPOVEC,OLDMAPTB,LFLAGS,LLABIND;
	 EXTERNAL MAXLOCAL,MAPTB,UNMAP,PTOVECTOR,INDECS,STRDEF,FLAGS,CODEPROP;
	BRAC_ .DEL<LEFTHALF>; SEMCNT_0;SESSAVER_.SESTOG; NOPEN_.NDEL;
	CPPSAVER_.CODEPROP; CODEPROP_0;
	INDECS_BLKP_.FUTDEL<HCLASS> EQL DCLRTR;LFLAGS_.FLAGS;
        IF .CODETOG  THEN GCE0(.BLKP);
        IF .BLKP THEN 
	    BEGIN
%V2H%	    SETLABSIFNECESSARY(BEC);
	    BLOCKLEVEL_ .BLOCKLEVEL + 1;
	    STPOVEC_.PTOVECTOR; OLDMAPTB_.MAPTB;
	    MAPTB_0; STRDEF_.STRDEF AND -2;
%V2H%	    END
%V2H%	    ELSE SETLABSIFNECESSARY(CMPEXC);
        NXTLOC_ .NEXTLOCAL;
	WHILE .FUTDEL<HCLASS> EQL DCLRTR DO 
	    BEGIN
            HRUND();
	    IF .SYM NEQ HEMPTY THEN WARNEM(.NSYM,#105);
            (@DEL)(); IF .DEL<LEFTHALF> NEQ HSEMCOL 
                THEN DEMAND(.NDEL,#100,1);
	    END;
        INDECS_0;
	IF .REALFS NEQ 0 THEN IDFIXFS();
	HRUND();

	BEGIN

	UNTIL .DEL<LEFTHALF> EQL .BRAC+#375240 DO
	    BEGIN
		SESTOG_0;
		EXPRESSION(2*( .SEMCNT GTR 0 ));
		SESSAVER_.SESSAVER OR .SESTOG;
		IF .SYM EQL HEMPTY THEN SYM_ZERO;
		IF .DEL<LEFTHALF> EQL HSEMCOL 
		  THEN
		    BEGIN
		    IF .CODETOG THEN
		    BEGIN
		    IF (SEMCNT_.SEMCNT+1) EQL 1
			 THEN ( SYM_GENCODE(.SYM,2));
		    GCE1(.SYM);
		    FIXSIDEEFFECTS();
		    END;
		    HRUND();
		    END
		  ELSE IF .DEL<LEFTHALF> NEQ .BRAC+#375240

	!ALLOW ELSE TO CLOSE THE COMPOUND EXPRESSION OR BLOCK AFTER
	!WE OUTPUT A PAIR OF FATAL ERROR MESSAGES.  #30 POINTS
	!ROUGHLY TO THE OPEN DELIMITER AND ERNOCBDEL POINTS ROUGHLY
	!TO THE ELSE.
	!ON RECOVERY, ACT AS IF THE PROPER CLOSE BRACKET APPEARED
	!BEFORE THE ELSE AND GO ON.

	THEN

	BEGIN
		IF .DEL<LEFTHALF> EQL HELSE
		  THEN
		    BEGIN
		      ERROR(.NOPEN,#30);
	              ERROR(.NDEL,ERNOCBDEL);
		      ERRLEVEL_0;
		      EXITCOMPOUND[4]
		    END
	  ELSE
			(ERROR(.NOPEN,24);DEMAND(.NDEL,25,.BRAC EQL HBEGIN))
	END;
		ERRLEVEL_0;
	    END;
	IF .SYM EQL HEMPTY THEN SYM_ZERO;
	IF .CODETOG THEN IF (.SEMCNT GEQ 1 OR .BLKP  OR .CODEPROP) 
    	   THEN SYM_GCE2(GENCODE(.SYM,2),( IF .BLKP THEN   
	     IF .FUTDEL<LEFTHALF> EQL HELUDOM THEN  %6-2-77%
        (.NXTLOC-(IF .NEXTLOCAL GTR .MAXLOCAL THEN .NEXTLOCAL ELSE .MAXLOCAL) -1)
                 ELSE -1  ELSE 0))
	   ELSE GCE2(ZERO,0);  !5-26-77
	IF CORRECTP1() THEN FUTSYM_.SYM
	ELSE(IF FUTAE() THEN RECOVER(.NFUTDEL,3) ELSE RECOVER(.NFUTSYM,12); ERRLEVEL_1);
	IF .ERRLEVEL EQL 0 THEN HRUND();

	END;

	SESTOG_.SESTOG OR .SESSAVER; CODEPROP_.CODEPROP OR .CPPSAVER;
        IF .BLKP THEN 
	  BEGIN
	  UNMAP(); MAPTB_.OLDMAPTB; FLAGS<18,16>_.LFLAGS<LEFTHALF>;
	  IF .NEXTLOCAL GTR .MAXLOCAL THEN MAXLOCAL_.NEXTLOCAL;
	  BLOCKLEVEL_.BLOCKLEVEL-1; BLOCKPURGE(.BLOCKLEVEL);
	  PTOVECTOR_.STPOVEC;
	  NEXTLOCAL_.NXTLOC;
	  END;
%V2H%	KILLLABSIFNECESSARY;

END;
%3.1%	GLOBAL ROUTINE SSET(TYPE)=

%PRINCIPLE:READ UNTIL THE CLOSING BRACKET "TES"
	1.READ SO THAT THE NEXT DELIMITER IS IN DEL(THE CASE EXPR USES THIS ROUTINE TOO)
	2.PROCESS THE INNER EXPRESSION IN SUCCESSION.
	3.SKIP A SEMICOLON AND START ALL OVER AGAIN.
	4.ACCEPT AN ARBITRARY EXPRESSION.
	5.IF FUTSYM FOLLOWING TES IS HEMPTY(AS IT SHOULD BE),TRANSMIT
	THE RESULT TO FUTSYM AND READ ONCE MORE IN ORDER TO DELETE TES%

BEGIN LOCAL CASETYPE; CASETYPE_(.DEL<LEFTHALF> EQL HOF);
	IF .TYPE THEN CLEARRTGT();
	IF .CASETYPE THEN HRUND() ELSE (IF .CODETOG THEN GCE0(0););HRUND();
	UNTIL .DEL<HCLASS> EQL CLOBRAC AND .DEL<LEFTHALF> NEQ HSEMCOL DO
	    BEGIN
		EXPRESSION(0); VTARGET_2; SYM_GENCODE(.SYM,2);
		IF .SYM EQL HEMPTY THEN SYM_ZERO;
		IF .DEL<LEFTHALF> EQL HSEMCOL 
		    THEN BEGIN
			IF .CODETOG THEN
			IF NOT.CASETYPE THEN SYM_GCE1(.SYM) ELSE
			IF .TYPE 
			    THEN (SYM_GCOST3(.SYM);CLEARSOME();GTPURGE(1))
			    ELSE (SYM_GCOST3(.SYM);GTPURGE(1);RESRT(0));
			HRUND()
			END;
		ERRLEVEL_0;
	    END;
	IF .SYM EQL HEMPTY THEN SYM_ZERO;
	IF .DEL<LEFTHALF> EQL HTES
		THEN 
			BEGIN
			IF .CODETOG THEN
			IF NOT.CASETYPE THEN SYM_GCE2(.SYM,0) ELSE
			IF .TYPE 
			    THEN (SYM_GCOST4(.SYM); CLEARSOME(); GTPURGE(1))
			    ELSE (SYM_GCOST4(.SYM); RESRT(1); CLEARSOME();
				  GTPURGE(2); LIVR(.SYM); GTDECR());
			END
           	ELSE (RECOVER(.NDEL,2);RETURN ERRLEVEL_1);
	IF .FUTSYM EQL HEMPTY AND .FUTDEL<HCLASS> EQL CLOBRAC
		THEN FUTSYM_.SYM
	ELSE (IF FUTAE() THEN RECOVER(.NFUTDEL,3) ELSE RECOVER(.NFUTSYM,12); ERRLEVEL_1);
	IF .ERRLEVEL EQL 0 THEN HRUND()
END;
ROUTINE SOPERATOR=

	%OPERATOR IN QUESTION IS IN DEL;
	1. STORE LEFTOPERAND AND OPERATOR;
	2.TEST IF LEFT OPERAND IS LEGAL;
	3.READ SO THAT NEXTDEL IS IN DEL.
	4.IF DEL GOES FIRST THEN (CALL ROUTINE FOR DEL,RETURN TO 4)
	5.CHECK IF RIGHT OPERAND IS LEGAL.
	6.COMPUTE RESULT.%

IF .DEL<LEFTHALF> NEQ HSTO
    THEN BEGIN LOCAL LEFTOP, OP;
%5.200.19%	IF .SYM<LSF> THEN FIXBADEXP();
	LEFTOP_.SYM; OP_.DEL;

	IF (.SYM EQL HEMPTY) XOR .OP<HUNARY>
	    THEN(RECOVER(.NDEL,6);RETURN(ERRLEVEL_1));
	HRUND();
%V2H%	  !CHECK TO SEE IF WE HAVE A LABELLED EXPRESSION.  IF SO,
%V2H%	  !GET RID OF ALL LABELS BEFORE CHECKING PRIORITY OF NEXT DELIMITER.
%V2H%	  IF .DEL<LEFTHALF> EQL HLABCOLON THEN SLABEL();
	WHILE .DEL<HPRIORITY> LSS .OP<HPRIORITY> 
         OR(.DEL<HPRIORITY> EQL .OP<HPRIORITY> AND .OP<HUNARY>) DO
    	BEGIN
	     IF SEFOLLOWS()
	       THEN HDELCLASS()
	       ELSE (IF .DEL<HCLASS> EQL OPENBRACKET
		THEN RECOVER(.NDEL,7) ELSE RECOVER(.NDEL,4); ERRLEVEL_1);
	     IF .ERRLEVEL THEN RETURN
        END;
	IF SUCCESSIVERELATIONALS(.OP) THEN WARNEM(.NDEL,5);
%5.200.19%	IF .SYM<LSF> THEN FIXBADEXP();
	IF (.SYM EQL HEMPTY AND (NOT(  SEFOLLOWS())))
	      THEN (RECOVER(.NFUTDEL,4); ERRLEVEL_1)
	      ELSE SYM_IF .OP<HUNARY>
					THEN GENGRAPH(.SYM,.OP,1)
					ELSE GENGRAPH(.LEFTOP,.SYM,.OP,2);
	END

    ELSE %HERE FOLLOWS THE STORE OPERATOR%

	BEGIN LOCAL L,LEFTPARTLIST[8],OP; L_-1;OP_.DEL;
	WHILE .OP<HPRIORITY> GEQ .DEL<HPRIORITY> DO
	BEGIN IF .SYM EQL HEMPTY AND
		 (NOT (.DEL<HUNARY> OR .DEL<HCLASS> EQL OPENBRACKET))
        THEN (RECOVER (.NDEL,8); ERRLEVEL_1)
	ELSE IF .OP<HPRIORITY> GTR .DEL<HPRIORITY>
		THEN
%5.200.19%		(IF .SYM<LSF> THEN FIXBADEXP();
%5.200.8%		IF AEFOLLOWS() THEN HDELCLASS()
%5.200.8%				ELSE IF .DEL<HCLASS> EQL DCLRTR THEN RECOVER(.NDEL,21)
%5.200.8%								ELSE RECOVER(.NDEL,1))

		ELSE BEGIN
%5.200.19%	IF .SYM<LSF> THEN FIXBADEXP();
		L_.L+1;    %ANOTHER _ HAS BEEN FOUND%
			IF .L EQL 8 THEN ERROR(.NSYM,9)
				ELSE LEFTPARTLIST[.L]_.SYM;
%V2H%			HRUND();
%V2H%			IF .DEL<LEFTHALF> EQL HLABCOLON THEN SLABEL();
		     END;
	IF .ERRLEVEL THEN RETURN
	END;		% NOW IS L=# OF LEFTARROWS%
	IF NOT AEFOLLOWS() AND .SYM EQL HEMPTY THEN (RECOVER(.NFUTDEL,10);ERRLEVEL_1)
	ELSE %THE LEFTPARTS HAVE BEEN COMPUTED SO THAT THERE IS NO HARM
	IN  ASSIGNING  FROM RIGHT TO LEFT%
	WHILE .L GEQ 0 DO
		BEGIN
		SYM_GENGRAPH(@(LEFTPARTLIST[.L]),.SYM,.OP,2);
		L_.L-1;
		END
 END;
ROUTINE SUSERCALL(CREAT)=

% CREAT IS 1 FOR COROUTINE CREATION, 0 FOR CALL.
PRINCIPLE: READ UNTIL THE RIGHT PARENTHESIS
	1.SAVE THE NAME AND INITIATE THE NUMBER OF PARAMETERS.
	2.READ IN ORDER TO GET THE FIRST PARAMETER'S,BEGIN IN SYM AND DEL.
	3.TREAT THE PARAMETERS SUCCESSIVELY.
	4.WHEN A COMMA IS FOUND STSRT WITH NEXT PARAMETER.
	5.IF FUTSYM FOLLOWING THE RIGHT PARENTHESIS  IS HEMPTY 
	(AS IT SHOULD BE) TRANSMIT SYM TO FUTSYM AND READ ONCE MORE.%

BEGIN LOCAL FU,M;   %4-12-77%
        IF .REALS NEQ 0
          THEN (CHECKEXTER(.REALS);
               IF NOT CHKULA(.REALS) THEN ERROR(.NSYM,#40));
        FU_SYM_GENCODE(.SYM,1); M_1;
	% M IS INITIATED WITH 1 TO COUNT THE LAST PARAMETER%
        IF .CREAT THEN
          IF .DEL<LEFTHALF> NEQ HPAROPEN THEN
            (RECOVER(.NDEL,#72);   RETURN  ERRLEVEL _ 1);
        HRUND();
	UNTIL .DEL<HCLASS> EQL CLOBRAC AND .DEL<LEFTHALF> NEQ HCOMMA DO
             BEGIN
		EXPRESSION(2);
		 IF .DEL<LEFTHALF> EQL HCOMMA
     		    THEN BEGIN M_.M+1; IF .SYM EQL HEMPTY THEN ERROR(.NSYM,11);
     			IF .CODETOG THEN (IF .CREAT THEN GCREA1(.SYM)
                                          ELSE GFRC1(.SYM));  
                        HRUND();
			FIXSIDEEFFECTS();
          		END;
		ERRLEVEL_0
	     END;	%NOW IS M = 1+# OF COMMAS%
	IF .SYM EQL HEMPTY
	    THEN IF .M EQL 1 THEN M_0 ELSE ERROR(.NSYM,11);
	IF .DEL<LEFTHALF> EQL HROCLO
             THEN (IF .SYM<LEFTHALF> EQL GTLEX THEN EXPRESSION(2);  %4-14-77 %
	           SYM _ IF .CODETOG THEN
                             (IF .CREAT THEN GCREA2(.SYM,.FU,.M)
                              ELSE GFRC2(.SYM,.FU,.M))  
                         ELSE ZERO)
	     ELSE (RECOVER(.NDEL,2);RETURN ERRLEVEL_1);
	FIXSIDEEFFECTS();
	IF CORRECTP1() THEN FUTSYM_.SYM
   	     ELSE (RECOVER(.NFUTSYM,IF FUTAE() THEN 3 ELSE 12);ERRLEVEL_1);
	IF .ERRLEVEL EQL 0 THEN HRUND();
        .M
END;
%3.1%	GLOBAL ROUTINE SCREATE =
%_CALLS SUSERCALL TO DO THE FUNCTION-CALL LIKE PART.
  OTHERWISE STRAIGHTFORWARD.
_%
BEGIN
  LOCAL NPAR,SAVVAL;
  HRUND();                         ! READ PAST 'CREATE'.
  GCREA0();
  CLEARRTGT();
  NPAR _ SUSERCALL(1);
  SAVVAL _ .SYM;

  IF .DEL<LEFTHALF> NEQ HCRAT THEN
    (RECOVER(.NDEL,#67);   RETURN ERRLEVEL _ 1);
  HRUND();                         ! READ PAST 'AT'.

  CLEARRTGT();
  EXPRESSION(2);
  IF .SYM EQL HEMPTY OR .DEL<LEFTHALF> NEQ HLENGTH THEN
    ( RECOVER(.NDEL,#70);   RETURN ERRLEVEL _ 1)
  ELSE
  IF .CODETOG THEN GCREA3(.SYM);
  HRUND();                         ! READ PAST 'LENGTH'.

  EXPRESSION(2);
  IF .SYM EQL HEMPTY OR .DEL<LEFTHALF> NEQ HTHEN THEN
    ( RECOVER(.NDEL,#71);   RETURN ERRLEVEL _ 1)
  ELSE
    IF .CODETOG THEN GCREA4(.SYM);
  HRUND();                         ! READ PAST 'THEN'.

  CLEARRTGT();
  EXPRESSION(2);
  IF .SYM EQL HEMPTY THEN SYM _ ZERO;
  IF .CODETOG THEN GCREA5(.SYM);
  CLEARRTGT();
  LIVR(SYM _ .SAVVAL)
END;    ! END OF SCREATE.
%3.1%	GLOBAL ROUTINE SEXCHJ =
%_STRAIGHTFORWARD ANALYSIS OF EXCHJ.
  EMPTY VALUE-EXPRESSION ALLOWED, WITH OR WITHOUT COMMA.
  THE CODE FOR THE PROCESS-EXPRESSION IS NOT GENERATED UNTIL IT
  CAN BE DETERMINED IF IT CAN BE OBTAINED WITH A SINGLE MOVE, AND AFTER
  THE VALUE-EXPRESSION.  TO DO THIS, INSPECT VALUES OF CODEPROP.
_%
BEGIN
  LOCAL SAVECP,PPCP;

        ! WINDOW:  XXX  EXCHJ  0  (

  IF (.FUTSYM NEQ HEMPTY) OR (.FUTDEL<LEFTHALF> NEQ HROPEN) THEN
    ( HRUND();   RECOVER(.NFUTDEL,#64);  RETURN ERRLEVEL _ 1)
  ELSE (HRUND();  HRUND());            ! READ PAST '('.

  CODEPROP _ 0;            ! TO SEE IF PROC IS ONE-MOVER.
  EXPRESSION(2);                       ! COMPILE PROCESS EXPRESSION.
  PPCP _ .CODEPROP;

  IF .SYM EQL HEMPTY THEN
    ( RECOVER(.NSYM,#65);  RETURN ERRLEVEL _ 1)
  ELSE IF .CODETOG THEN SAVECP _ GEXCH0(.SYM);

  CODEPROP _ 0;
  SYM _ HEMPTY;                         ! PREPARE FOR TEST BELOW.
  CLEARRTGT();

  IF .DEL<LEFTHALF> EQL HCOMMA THEN
     ( HRUND();  EXPRESSION(2));       ! COMPILE VALUE-EXPRESSION.
  IF .DEL<LEFTHALF> NEQ HROCLO THEN
    ( RECOVER(.NDEL,#66);  RETURN ERRLEVEL _ 1)
  ELSE
    IF .SYM EQL HEMPTY THEN SYM _ ZERO;
  IF CORRECTP1() THEN
    ( IF .CODETOG THEN
        FUTSYM _ GEXCH1(.SYM,(IF NOT (.PPCP OR .CODEPROP) THEN .SAVECP ELSE 0)))
  ELSE
    ( RECOVER(.NDEL,IF FUTAE() THEN 3 ELSE 12);  RETURN ERRLEVEL _ 1);
  HRUND();                             ! READ PAST ')'.
  CLEARRTGT();
  CODEPROP _ 1
END;   ! END OF SEXCHJ.
%3.1%	GLOBAL ROUTINE SSQOPEN=

%PRINCIPLE:READ UNTIL SQUCLOSE AND COLLECT THE SUBSCRIPTS
	1.DISTINQUISH BETWEEN THE SIMPLE AND NON-SIMPLE STRUCTURE
	(AS DESCRIBED BY BILL); THE NON-SIMPLE A[I,J,0] WITH MAP STRUCTURE
	:A IS TREATED AS STRUC(A,I,J) AND THE SYNTAX CODE FOR IT IS THE 
	SAME AS FOR SPAROPEN.
	THE SIMPLE A[I,.....,J,0] IS TREATED AS FOLLOWS.
	2.SAVE STRUCTURE NAME AND READ ONCE TO GET THE BEGINNING OF THE 
	FIRST SUBSCRIPT
	3.WHENEVER A COMMA IS FOUND ,BOOK SUBSCRIPT AND DELETE COMMA
	4.IF FUTSYM IS 0 FOLLOWING SQUCLO(AS IT SHOULD BE)
	TRANSMIT SYM TO FUTSYM AND READ ONCE MORE.RESULT IS P1.%

BEGIN 
  LOCAL ACTUALS,  ! STE INDEX OF ACTUAL PARAMETER BLOCK
          INCACTS,  !  "   "    "  INCARNATION ACTUALS BLOCK
          CPTOSYM,  ! CHARACTER POINTER TO SYM IN CASE OF EXPANSION ERRORS
          NUMPARMS, ! NUMBER OF PARAMETERS ALLOWED
          STRUCT,   ! STE INDEX OF STRUCTURE
          SAVELAST, ! LAST PARAMETER WHEN EXTRAS PASSED
          DEFAULT,  ! DEFAULT VECTOR STRUCTURE USED
          SIMPLE;   ! TRADITIONAL MISNOMER FOR MACRO-TYPE EXPANSION.
    REGISTER T; LOCAL PSZ;
    LOCAL L;
    MAP STVEC ACTUALS:INCACTS:REALS:STRUCT;
    MACRO DEFAULT0=IF .SYM EQL HEMPTY THEN SYM_ZERO$;

    % IF WE DO NOT HAVE A SYMBOL IN SYM, OR THE SYMBOL HAS NOT
      BEEN MAPPED, WE DEFAULT THE VECTOR STRUCTURE WITH ACTUAL OF 1%

    IF DEFAULT_
      (IF .REALS EQL 0
         THEN 1
         ELSE
          (CHECKEXTER(.REALS);
           IF MAPPABLE((.REALS[0]<TYPEF>))
             THEN (INCACTS_.REALS[1]<STRF>) EQL 0
             ELSE 1))
      THEN INCACTS_MKDUMINCA(.PTOVECTOR);
    STRUCT_.INCACTS[0]<STRXF>;
    NUMPARMS_.STRUCT[1]<NPARMF>; %USED TO CALCULATE DISPLACEMENT IN PARS.%
    DEFAULT0;
    
    ACTUALS_GETSPACE(PSZ_.INCACTS[0]<PSZF>);
    IF SIMPLE_.STRUCT[1]<SIMBITAF>
      THEN CPTOSYM_.NSYM
      ELSE INCR I FROM 1 TO .NUMPARMS DO
             IF .CODETOG THEN GFRC1(.INCACTS[.I]);

    BEGIN
      LOCAL NOMORE;
      MACRO CLOSEBR=
              (IF .DEL<LEFTHALF> EQL HSQCLO AND
                .FUTDEL<LEFTHALF> EQL HSTO THEN STUTYPE_1;
              IF .DEL<LEFTHALF> EQL HCOMMA
                AND .FUTSYM EQL HEMPTY
                AND .FUTDEL<LEFTHALF> EQL HSQCLO
                 THEN (HRUND(); 1)
                 ELSE .DEL<LEFTHALF> EQL HSQCLO)$,

            MOREACTS=
              (IF NOMORE_CLOSEBR
                 THEN .NUMPARMS GTR .L
                 ELSE
                   (IF .DEL<LEFTHALF> NEQ HCOMMA
                      THEN (RECOVER(.NDEL,2);
                            RETURN ERRLEVEL_1);
                    HRUND();
                    EXPRESSION(0);
                    DEFAULT0;
                    1))$,

            ACT=IF .NOMORE THEN ZERO ELSE .SYM$;

      DEL<LEFTHALF>_HCOMMA;
      L_-1;
      NOMORE_0;
  
      DO IF (L_.L+1) LEQ .NUMPARMS
           THEN ACTUALS[.L]_ACT
           ELSE WARNEM(.NSYM,ERSMEXACT)
        WHILE MOREACTS;
  
	!V2G- IF NOT USING THE DEFAULT STRUCTURE WARN IF LESS THAN THE SPECIFIED
	!V2G- NUMBER OF ACTUALS IS PASSED.
	IF .L LSS .NUMPARMS THEN IF NOT .DEFAULT THEN WARNEM(.NSYM,ERFEWERACT);	!V2G-

      IF .SIMPLE
        THEN GSSA(.ACTUALS,.INCACTS,.STRUCT,1,.CPTOSYM)
        ELSE
          BEGIN
            IF NOT .CODETOG THEN EXITBLOCK;
            INCR I FROM 0 TO .NUMPARMS-1 DO
              GFRC1(SYM_GENCODE(.ACTUALS[.I],2));
            SYM_GFRC2(SYM_GENCODE(.ACTUALS[.NUMPARMS],2), .STRUCT+LSM,
                      .NUMPARMS^1+1)
          END;
    END;
	IF CORRECTP1() THEN FUTSYM_.SYM
	     ELSE (RECOVER(.NDEL,IF FUTAE() THEN 3 ELSE 12);ERRLEVEL_1);
	IF .ERRLEVEL EQL 0 THEN HRUND();
        IF .DEFAULT THEN RELEASESPACE(.INCACTS,.PSZ);
        RELEASESPACE(.ACTUALS, .PSZ);
END;
%3.1%	GLOBAL ROUTINE SPTR=

	%PRINCIPLE: READ UNTIL THE MATCHING POINTER CLOSE
	1. INITIATE THE  POINTER PARAMETERS WITH THEIR DEFAULT
	VALUES AND SAVE NAME.
	2. READ ONCE TO START WITH THE FIRST POINTER PARAMETER
	3.READ THE PARAMETERS SUCCESSIVELY,IF A PARAMETER IS HEMPTY
	THEN GO ON TO THE NEXT ONE, THE DEFAULT VALUE HAS ALREADY 
	BEEN SET.
	4.THE FINISHING PART IS EXACTLY LIKE THAT OF THESUSERCALL
	OR SQUOPEN %

BEGIN LOCAL NAME, PAR[4], L; NAME_.SYM; PAR[1]_36;
	PAR_L_PAR[2]_PAR[3]_0;
	HRUND();
	UNTIL .DEL<HCLASS> EQL CLOBRAC AND .DEL<LEFTHALF> NEQ HCOMMA DO
	    BEGIN
		EXPRESSION(0);
		IF .DEL<LEFTHALF> EQL HCOMMA
			THEN    BEGIN
				 IF .SYM NEQ HEMPTY THEN PAR[.L]_.SYM;
				L_.L+1; HRUND()
	          		END;
		IF .L GTR 4 THEN (ERROR(.NSYM,#41); L_4);
		ERRLEVEL_0
	    END;
        PAR[.L] _ .SYM;
	IF .DEL<LEFTHALF> EQL HPOINTCLO
          	THEN (IF .CODETOG THEN SYM_GENGRAPH(.NAME,.PAR,.PAR[1],
				.PAR[2],.PAR[3],HPTOPEN^18+(NGPTR<0,0> AND #777777),5)
%5.200.2%				ELSE SYM_.NAME)
          	ELSE (RECOVER(.NDEL,2);RETURN ERRLEVEL_1);
	IF CORRECTP1() THEN FUTSYM_.SYM
          	ELSE (RECOVER (.NFUTDEL,IF FUTAE() THEN 3 ELSE 12); ERRLEVEL_1);
	IF .ERRLEVEL EQL 0 THEN HRUND()
END;
%3.1%	GLOBAL ROUTINE SCASE=

	%THE ROUTINE CONSISTS OF TWO PARTS,THE "SIMPLE CASE" AND THE
	"GENERAL CASE".   A SIMPLE CASE HAS THE FORM 
	CASE<CONSTANT> OF SET E0;E1;.....EN TES
	AND IF CONSTANT =I THEN IT IS COMPILED AS(EI),I.E.
	ALL THE OTHER EXPRESSION ARE SIMPLY SKIPPED%

  BEGIN
    ROUTINE CONSTCASE=
        BEGIN LOCAL VAL,EN,SVTARGET; EN_LITV(.SYM);VAL_0;
	!!! THE FOLLOWING 4 STATEMENTS UNDO THE CASE SKELETON
	ACPR2();	! --> C1
	ERASEBOT(.CODEPTR);
	CODEPTR_.CT[.CODEPTR,0]<PREVF>;	! --> C0
	UNTEMPLATE();
	IF .FUTDEL<LEFTHALF> NEQ HSET OR .FUTSYM NEQ HEMPTY
          	THEN (RECOVER(.NFUTSYM,16);RETURN ERRLEVEL_1);
	HRUND(); SHUTOFFCODE(); ! WINDOW: (0,"SET", EX1S, EX1D)
        SVTARGET=.VTARGET;
        UNTIL .DEL<HCLASS> EQL CLOBRAC AND .DEL<LEFTHALF> NEQ HSEMCOL DO
	    BEGIN
		IF .EN EQL 0 AND .CODETOG NEQ 0 THEN (TURNONCODE(); GCE0(0);VTARGET=0);
                HRUND(); ! WINDOW: (EX1S, EX1D, EX1FS, EX1FD)
		EXPRESSION(0); 				! WINDOW: (EXPR, (";"/"TES"),...)
		IF .DEL<LEFTHALF> EQL HSEMCOL THEN
			 BEGIN IF .EN EQL 0 AND .CODETOG 
            		THEN (IF .SYM EQL HEMPTY THEN SYM_ZERO; VAL_GCE2(.SYM,0);SHUTOFFCODE(););
            		EN_.EN-1;
          		END
		ELSE IF .CODETOG NEQ 0 AND .EN EQL 0 THEN SHUTOFFCODE();
		ERRLEVEL_0

	    END;
	TURNONCODE();
	IF .SYM EQL HEMPTY OR .EN GTR 0 THEN SYM_ZERO;
	IF .DEL<LEFTHALF> EQL HTES
          	THEN(IF .CODETOG AND .EN EQL 0 THEN VAL_GCE2(.SYM,0))
          	ELSE(RECOVER(.NDEL,2);RETURN ERRLEVEL_1);
	IF .FUTSYM EQL HEMPTY AND .FUTDEL<HCLASS> EQL CLOBRAC
          	THEN FUTSYM_.VAL ELSE (IF FUTAE() THEN RECOVER(.NFUTDEL,3)  
                ELSE RECOVER(.NFUTSYM,12);ERRLEVEL_1);
	IF .ERRLEVEL EQL 0 THEN HRUND();
        VTARGET=.SVTARGET
        END;


	% PRINCIPLE: READ IN FIRST LOOP TILL OF AND IN
	SECOND         SET EXPR.
	1.INITIATE THE NUMBER OF CASE EXPRESSION AT ZERO
	2.READ ONCE IN ORDER TO START THE ANALYSIS OF THE FIRST
	CASE EXPRESSION.
	3. WHEN COMMA IS FOUND INCREASE N AND START WITH NEXT 
	CASE EXPRESSION
	4.WHEN OF IS FOUND TEST IF IT IS FOLLOWED BY SET
	5. ANALYSE THE SET EXPRESSION SIMILAR AS IN ROUTINE SSET%

%V2H%	BEGIN LOCAL LLABIND, N;  N_1; IF .CODETOG THEN GCOST0(); SETLABSIFNECESSARY(COSTC); HRUND();
        DO
		BEGIN 
		EXPRESSION(0); VTARGET_-1; SYM_GENCODE(.SYM,2);
		IF .DEL<LEFTHALF> EQL HCOMMA
			THEN BEGIN N_.N+1;IF .SYM EQL HEMPTY THEN ERROR(.NDEL,15);
			     IF .CODETOG THEN  GCOST1(.SYM);
			     HRUND();
			     FIXSIDEEFFECTS();
		   	     END;
		ERRLEVEL_0
		END		%N=1+ # OF COMMAS%
	UNTIL .DEL<HCLASS> EQL CLOBRAC AND .DEL<LEFTHALF> NEQ HCOMMA;
	IF .SYM EQL HEMPTY THEN SYM_ZERO;
	IF .DEL<LEFTHALF> EQL HOF
%V2H%	    THEN (IF .CODETOG THEN(IF LITP(.SYM) AND .N EQL 1 THEN RETURN (CONSTCASE(); KILLLABSIFNECESSARY) ELSE
			GCOST2(.SYM,.N);
		    IF .N EQL 1 THEN (GTPURGE(0);GTINCR();SAVRT(0))))
%V2H%	    ELSE (RECOVER(.NDEL,2);RETURN (ERRLEVEL_1; KILLLABSIFNECESSARY));
	FIXSIDEEFFECTS();
	IF .FUTDEL<LEFTHALF> NEQ HSET OR .FUTSYM NEQ HEMPTY
	    THEN (RECOVER(.NFUTDEL,16);ERRLEVEL_1);
%V2H%	SSET(.N GTR 1);
%V2H%	KILLLABSIFNECESSARY;
    END
END;
%3.1%	GLOBAL ROUTINE SREP=
    BEGIN LOCAL LLABIND, J, DEC;
    !
    !        THIS ROUTINE COMPILES THE CODE FOR INCR/DECR LOOPS.
    !
    ROUTINE IDDEL=
	BEGIN LOCAL X;
	IF (X_.DEL<LEFTHALF> ) EQL HFROM THEN 1 ELSE
	IF .X EQL HTO THEN 2 ELSE
	IF .X EQL HBY THEN 3 ELSE
	IF .X EQL HDO THEN 4 ELSE 0
	END;
    DEC_.DEL<LEFTHALF>; HRUND();
    SYM_DECLTEMPREG(.SYM,1);
    IF .CODETOG THEN GID0(.SYM);
%V2H%	SETLABSIFNECESSARY(IDFTDC);
    INCR I FROM 1 TO 4 DO
	BEGIN
	IF (J_IDDEL()) LSS .I
%V2H%	    THEN (RECOVER(.NDEL,36); RETURN (ERRLEVEL_1; KILLLABSIFNECESSARY))
	    ELSE IF .J GTR .I THEN
		INCR K FROM .I TO .J-1 DO
		    IF .CODETOG THEN
			CASE .K OF
			   SET
			    0;
			    GID1(ZERO);
			    GID2(LITLEXEME(IF .DEC EQL HDECR THEN (1^35) ELSE NOT(1^35)));
			    (GID3(LITLEXEME(1),.DEC EQL HDECR);CLEARRTGT());
%V2H%			    (RECOVER(.NDEL,37); RETURN(ERRLEVEL_1; KILLLABSIFNECESSARY));
			    TES;
	HRUND();  EXPRESSION(0); VTARGET_IF .I NEQ 4 THEN -1 ELSE 0; SYM_GENCODE(.SYM,1);
	I_.J;
	IF .SYM EQL HEMPTY THEN ERROR(.NSYM,40);
	IF .CODETOG THEN
	    CASE .I OF
		SET
		0;
		SYM_GID1(.SYM);
		SYM_GID2(.SYM);
		(SYM_GID3(.SYM,.DEC EQL HDECR);CLEARRTGT());
		SYM_GID4(.SYM,.DEC EQL HDECR);
		TES;
	FIXSIDEEFFECTS();
	END;
	DECLTEMPREG(0,0);  CLEARRTGT();
%V2H%	KILLLABSIFNECESSARY;
    END;
%V2H%	GLOBAL ROUTINE SLEAVE=

%V2H%	  !ENTER WITH WINDOW:	XXX	LEAVE	XXX	XXX
%V2H%	  !			SYM	DEL	FUTSYM	FUTDEL
%V2H%	  !
%V2H%	  !FUTSYM MUST BE DECLARED A LABELT SYMBOL AND MUST BE IN ALIVE
%V2H%	  !STATE:	ALIVEB=1.

%V2H%	  BEGIN
%V2H%	    REGISTER HIND;	!TO HOLD INDEX OF LABELLED HEADER

%V2H%	  BEGIN
%V2H%	    !FIRST MAKE SURE THAT .FUTSYM IS A PROPER LABEL.
%V2H%	    IF .ST[HIND_.FUTSYM<STEF>,0]<TYPEF> NEQ LABELT
%V2H%	      THEN EXITCOMP (ERROR(.NFUTSYM,ERIMPLABEL); ERRLEVEL_1);
%V2H%	    IF NOT .ST[.HIND,1]<ALIVEB> THEN EXITCOMP( ERROR(.NFUTSYM,EROUTLABSCOPE); ERRLEVEL_1);

%V2H%	    !NOW GET THE INDEX TO THE LABELLED HEADER
%V2H%	    HIND_.ST[.FUTSYM<STEF>,1]<PREVF>;
%V2H%	  END;

%V2H%	    !NOW MOVE WINDOW TO CHECK FOR "WITH" EXPRESSION
%V2H%	    HRUND();		!GET NEXT DEL INTO DEL
%V2H%	    IF .DEL<LEFTHALF> EQL HWITH
%V2H%	      THEN (HRUND(); EXPRESSION(0))
%V2H%	      ELSE SYM_ZERO;

%V2H%	    !NOW GET AND CHECK THE RESULT EXPRESSION
%V2H%	    VTARGET_2; SYM_GENCODE(.SYM,2); IF .ERRLEVEL THEN RETURN;
%V2H%	    IF .SYM EQL HEMPTY THEN SYM_ZERO;
%V2H%	    IF .CODETOG THEN (SYM_ GLEAVE(.SYM,.HIND));

%V2H%	  END;
%3.1%	GLOBAL ROUTINE SESCAPE=
    BEGIN
    !
    !    THIS ROUTINE HANDLES COMPILATION OF ALL ESCAPE EXPRESSIONS.
    !
    LOCAL ESC, D;
    ESC_ IF (D_.DEL<LEFTHALF>) EQL HRETURN THEN 0 ELSE
		IF .D EQL HEXIT THEN 1 ELSE
		IF .D EQL HEXITLOOP THEN 2 ELSE
		IF .D EQL HEXITBLOCK THEN 3 ELSE
		IF .D EQL HEXITCOMP THEN 4 ELSE
		IF .D EQL HEXITCOND THEN 5 ELSE
		IF .D EQL HEXITSELECT THEN 6 ELSE
		IF .D EQL HEXITCASE THEN 7 ELSE
		IF .D EQL HEXITSET THEN 8 ELSE  -1;
    HRUND();
    D_LITLEXEME(1);
    IF .DEL<LEFTHALF> EQL HSQOPEN AND .SYM EQL HEMPTY THEN
	    BEGIN HRUND(); EXPRESSION(2);
	    IF NOT LITP(D_.SYM) OR .D EQL HEMPTY THEN ERROR(.NSYM,41);
	    IF .DEL<LEFTHALF> NEQ HSQCLO THEN
		(RECOVER(.NDEL,42); RETURN ERRLEVEL_1);
	    FIXFUTDEL(); ! KLUDGE TO HANDLE UNARY OP AFTER ].
	    HRUND();
	    END;
    EXPRESSION(0); VTARGET_2; SYM_GENCODE(.SYM,2);
    IF .ERRLEVEL THEN RETURN;
    IF .SYM EQL HEMPTY THEN SYM_ZERO;
    IF .CODETOG THEN
	    SYM_CASE .ESC OF 
		SET
		GRETURN(.SYM);
		GEXIT(.SYM,.D);
		GXLOOP(.SYM,.D);
		GXBLOCK(.SYM,.D);
		GXCMPEX(.SYM,.D);
		GXCOND (.SYM,.D);
		GXSELECT(.SYM,.D);
		GXCASE(.SYM,.D);
		GXSET(.SYM,.D);
		TES;
    END;
GLOBAL ROUTINE SSPUNOP=
  BEGIN LOCAL TYPE,P;
    !THIS ROUTINE HANDLES SPECIAL UNARY OPERATORS(FUNCTIONS) IMPLEMENTED
    !TO ALLOW USE OF OPCODES SUCH AS JFFO AND MOVM AND ACCORDING TO USER PRESSURE.
    TYPE_.ST[.SYM<STEF>,1];
    HRUND();
    EXPRESSION(2);
    IF (P_.SYM) EQL HEMPTY THEN P_ZERO;
    IF .DEL<LEFTHALF> NEQ HROCLO THEN
      (RECOVER(.NDEL,44); RETURN ERRLEVEL_1)
%3.7%   ELSE IF .CODETOG THEN 
	% THE FOLLOWING 7 LINES ARE ADDED TO FIX BUG#4 %
				(
				 IF NOT LITP(.P) THEN
				  IF  .P<LSF> THEN
				   IF UPLEVELCHECK(.P) THEN
					P=.SYMVALUE;
				 SYM=GSPUNOP(.TYPE,.P);
				 );
    IF CORRECTP1() THEN FUTSYM_.SYM
    ELSE (RECOVER(.NFUTSYM,IF FUTAE() THEN 3 ELSE 12);
	  ERRLEVEL_1);
    HRUND()
  END;


ROUTINE SSPLF=
    BEGIN LOCAL T, O, P1, P2;
    !    THIS ROUTINE HANDLES THE COMPILATION OF THE SPECIAL
    !    CHARACTER HANDLING FUNCTIONS.
    !
    T_.ST[.SYM<STEF>,1];
    P1_P2_0;
    HRUND();
    EXPRESSION(2);
    IF (P1_.SYM) EQL HEMPTY THEN ERROR(.NSYM,43);
    IF .DEL<LEFTHALF> EQL HCOMMA THEN
	BEGIN
 	HRUND(); EXPRESSION(2);
	IF (P2_.SYM) EQL HEMPTY THEN ERROR(.NSYM,43);
	END;
    IF  .DEL<LEFTHALF> NEQ HROCLO 
	THEN (RECOVER(.NDEL,44);RETURN ERRLEVEL_1)
%3.7%   ELSE IF .CODETOG THEN 
	% THE FOLLOWING 9 LINES ARE ADDED TO FIX BUG#4 %
		BEGIN
		 INCR I FROM 0 TO 1 DO
		  ( IF NOT LITP(.P1[.I]) THEN
		     IF .P1[.I]<LSF> THEN
		      IF UPLEVELCHECK(.P1[.I]) THEN
			  P1[.I]=.SYMVALUE;
		  );
		 SYM=GSPLF(.T,.P1,.P2);
		END;
    IF CORRECTP1() 
	THEN FUTSYM_.SYM
	ELSE (RECOVER(.NFUTSYM,IF FUTAE() THEN 3 ELSE 12); ERRLEVEL_1);
    IF .T LSS 10 THEN
    IF .T GEQ 6 THEN FIXSIDEEFFECTS()
	ELSE IF NOT .T THEN FIXSIDEEFFECTS(); %5-16-77%
    HRUND();
    END;
%3.1%	GLOBAL ROUTINE SSELECT=
%V2H%    BEGIN LOCAL LLABIND, N;
    !
    !    THIS ROUTINE ANALYZES THE SYNTAX OF SELECT EXPRESSIONS
    !
    HRUND();
    N_0;
    IF .CODETOG THEN GSE0();
%V2H%	SETLABSIFNECESSARY(SELECTC);
    UNTIL .DEL<HCLASS> EQL CLOBRAC AND .DEL<LEFTHALF> NEQ HCOMMA DO
	BEGIN
	    EXPRESSION(0); VTARGET_-1; SYM_GENCODE(.SYM,2);
	    IF .SYM EQL HEMPTY THEN SYM_ZERO;
	    IF .DEL<LEFTHALF> EQL HCOMMA THEN
		(N_.N+1; IF .CODETOG THEN GSE1(.SYM); HRUND());
	    FIXSIDEEFFECTS();
	    ERRLEVEL_0;
        END;
    IF .SYM EQL HEMPTY THEN (SYM_ZERO; ERROR(.NSYM,50));
%V2H%    IF .DEL<LEFTHALF> NEQ HOF THEN (RECOVER(.NDEL,45); RETURN(ERRLEVEL_1; KILLLABSIFNECESSARY));
%3.39%    IF .CODETOG THEN (GSE2(.N+1,.SYM); GTPURGE(0); GTINCR(); SAVRT(0));
    HRUND();
    FIXSIDEEFFECTS();
%V2H%    IF .DEL<LEFTHALF> NEQ HNSET THEN (RECOVER(.NDEL,46); RETURN(ERRLEVEL_1; KILLLABSIFNECESSARY));
    HRUND();
    UNTIL .DEL<HCLASS> EQL CLOBRAC AND .DEL<LEFTHALF> NEQ HSEMCOL AND 
	.DEL<LEFTHALF> NEQ HCOLON AND .DEL<LEFTHALF> NEQ HALWAYS AND 
	.DEL<LEFTHALF> NEQ HOTHERWISE DO
	BEGIN
%3.39%  IF .DEL<LEFTHALF> EQL HOTHERWISE THEN (HRUND(); IF .CODETOG THEN (GSE3O(); CLEARSOME(); GTPURGE(1))) ELSE
%3.39%  IF .DEL<LEFTHALF> EQL HALWAYS THEN (HRUND(); IF .CODETOG THEN (GSE3A(); CLEARSOME(); GTPURGE(1))) ELSE
          BEGIN
  	EXPRESSION(0); VTARGET_-1; SYM_GENCODE(.SYM,1);
  	IF .SYM EQL HEMPTY THEN (ERROR(.NSYM,47); SYM_ZERO);
%3.39%	IF .CODETOG THEN (GSE3(.SYM); CLEARSOME(); GTPURGE(1))
        END;
%V2H%  	IF .DEL<LEFTHALF> NEQ HCOLON THEN (RECOVER(.NDEL,48); RETURN( ERRLEVEL_0; KILLLABSIFNECESSARY));
	HRUND();
	EXPRESSION(0); VTARGET_2; SYM_GENCODE(.SYM,2);
	IF .SYM EQL HEMPTY THEN SYM_ZERO;

	!OTHERWISE AND ALWAYS DON'T REQUIRE A FOLLOWING SEMICOLON.  IF IT
	!IS MISSING, PRINT A WARNING AND ASSUME IT IS THERE

	BEGIN
	IF .DEL<LEFTHALF> EQL HOTHERWISE OR
	   .DEL<LEFTHALF> EQL HALWAYS
	    THEN
	      BEGIN
		WARNEM(.NSYM,ERNOSEMI);
		IF .CODETOG THEN
%3.39%		  (GSE4(.SYM); CLEARSOME(); GTPURGE(1); EXITCOMPOUND[3])	!TO %A%
	      END;

	IF .DEL<LEFTHALF> EQL HSEMCOL THEN
%3.39%	    ( IF .CODETOG THEN (GSE4(.SYM); CLEARSOME(); GTPURGE(1)); HRUND())
	ELSE IF .DEL<LEFTHALF> NEQ HTESN  THEN EXITLOOP;
%A%	END;

	ERRLEVEL_0;
	END;
%V2H%    IF .DEL<LEFTHALF> NEQ HTESN THEN (RECOVER(.NDEL,49); RETURN (ERRLEVEL_0; KILLLABSIFNECESSARY));
%3.39%    IF .CODETOG THEN (SYM_GSE5(.SYM); RESRT(1); CLEARSOME(); GTPURGE(2); LIVR(.SYM); GTDECR());
    IF .FUTSYM EQL HEMPTY AND .FUTDEL<HCLASS> EQL CLOBRAC
	THEN FUTSYM_.SYM
	ELSE (IF FUTAE() THEN RECOVER(.NFUTDEL,3) ELSE RECOVER(.NFUTSYM,12); ERRLEVEL_1);
    IF .ERRLEVEL EQL 0 THEN HRUND();
%V2H%	KILLLABSIFNECESSARY;
    END;
%3.1%	GLOBAL ROUTINE SIF=
    BEGIN
%V2H%	LOCAL LLABIND;	!HOLDS INDEX TO LABEL CHAIN IF ANY
    !
    !    THIS ROUTINE COMPILES THE IF-THEN-ELSE FORM OF CONTROL EXPRESSION.
    !
%V2H%	ROUTINE CONSTIF(TRIP)=
	    BEGIN  LOCAL RESULT,SVTARGET;
	    IF .CODETOG THEN GCE0(0);  
	    IF NOT .TRIP THEN SHUTOFFCODE(); 
            SVTARGET=.VTARGET;
	    VTARGET = 0;		%9-19-77%
            HRUND();
            EXPRESSION(0);		%9-19-77%
	    IF  .SYM EQL HEMPTY THEN SYM_ZERO;
	    IF .TRIP 
		THEN (RESULT_.SYM; SHUTOFFCODE())
		ELSE TURNONCODE();
	    IF .DEL<LEFTHALF> EQL HELSE THEN
		BEGIN HRUND(); EXPRESSION(1); END;
	    IF .SYM EQL HEMPTY THEN SYM_ZERO;
	    IF NOT .TRIP THEN RESULT_.SYM ELSE TURNONCODE();
	    IF .CODETOG THEN SYM_GCE2(.RESULT,0);
		CODEPTR_LOCATE(ITEC,5);
		CLASSLAB();
		UNTEMPLATE();
		VTARGET=.SVTARGET
	  END;





%V2H%	  !IF WE HAVE LABELS ON THIS IF THEN ELSE, STORE SKELETON HEADER
%V2H%	  !IN LABEL STES.
        LOCAL SKIPTOG;
	LOCAL NESTEDIF;    EXTERNAL NOIFOPT;		%9-19-77%
	NESTEDIF=.NOIFOPT;				%9-19-77%
	SKIPTOG_.DEL<LEFTHALF> EQL HIFSKIP;
	IF .CODETOG THEN GITE0();
%V2H%	SETLABSIFNECESSARY(ITEC);	!IF THIS ITE LABELED, TURN LABELS ON.
	IF .NESTEDIF EQL 2 THEN NOIFOPT=1;		%9-19-77%
%V2H%	  HRUND();  EXPRESSION(0); VTARGET_-1; SYM_GENCODE(.SYM,2);
	NOIFOPT = 2;					%9-19-77%
	IF .SYM EQL HEMPTY THEN(ERROR(.NSYM,38); SYM_1) ELSE
	IF .DEL<LEFTHALF> EQL HTHEN AND LITP(.SYM) AND .CODETOG THEN
%V2H%	    RETURN( CONSTIF(LITV(.SYM));NOIFOPT=.NESTEDIF; KILLLABSIFNECESSARY);	%9-19-77%

	IF .CODETOG THEN ( GITE1(.SYM,.SKIPTOG); GTPURGE(0); GTINCR(); SAVRT(0));
	IF .DEL<LEFTHALF> NEQ HTHEN 
	    THEN RECOVER(.NDEL,39)
	    ELSE
		BEGIN HRUND(); EXPRESSION(2);
			IF .SYM EQL HEMPTY THEN SYM_ZERO;
			IF .CODETOG THEN (GITE2(.SYM);GTPURGE(1); RESRT(0))
		END;
	IF .DEL<LEFTHALF> NEQ HELSE 
	    THEN (IF .CODETOG THEN
		 (SYM_ZERO; SYM_GITE3(.SYM); RESRT(1);CLEARSOME();GTPURGE(2);LIVR(.SYM);GTDECR()))
	    ELSE
		BEGIN HRUND(); EXPRESSION(2);
		IF .CODETOG THEN
		    (SYM_GITE3(.SYM); RESRT(1); CLEARSOME(); GTPURGE(2); LIVR(.SYM);GTDECR());
		 END;
%V2H%	  KILLLABSIFNECESSARY;
	NOIFOPT = .NESTEDIF;				%9-19-77%
    END;
%3.1%	GLOBAL ROUTINE SDO=
	%PRINCIPLE: CONSIDER WHILE (OR UNTIL) AS A SPECIAL SORT OF
	COMMA AND READ UNTIL THE END OF THE WHOLE SO 
	EXPRESSION.
	1.  BOOK THAT THE ANALYSIS OF THE DO PART HAS STARTED
	(IN VARIABLE COM)
	2.  READ IN ORDERRTO START WITH THE DO EXPRESSION
	3.  VERY SIMILAR TO THE REP ROUTINE R10 %
%V2H%	BEGIN LOCAL LLABIND, COM, SORT; COM_0; IF .CODETOG THEN GDWU0();
%V2H%	SETLABSIFNECESSARY(DWUC);
	HRUND(); CLEARRTGT();
	EXPRESSION(1);
	IF .SYM EQL HEMPTY THEN SYM_ZERO;
	IF .CODETOG THEN GDWU1(.SYM);
	FIXSIDEEFFECTS();
	SORT_.DEL<LEFTHALF>;
	IF .SORT NEQ HUNTLCLO  AND  .SORT NEQ HWHLCLO
%V2H%	    THEN (RECOVER(.NDEL,2); RETURN( ERRLEVEL_1; KILLLABSIFNECESSARY)) ELSE HRUND();
	EXPRESSION(1);
	IF .SYM EQL HEMPTY THEN SYM_ZERO;
	IF .CODETOG THEN SYM_GDWU2(.SYM,.SORT EQL HWHLCLO);
	ERRLEVEL_0; CLEARRTGT();
%V2H%	KILLLABSIFNECESSARY;
END;



%3.1%	GLOBAL ROUTINE SWU=
	%ALMOST THE SAME AS SDO EXCEPT THAT DIRECT AT THE BEGINNING
	THE DISTINCTION IS FOUND BETWEEN WHILE AND UNTIL EXPRESSIONS.
	DO IS CONSIDERED AS SORT OF A COMMA%
%V2H%	BEGIN LOCAL LLABIND, SORT, COM;  SORT_.DEL<LEFTHALF>; COM_0;
%V2H%	IF .CODETOG THEN GWUD0(); SETLABSIFNECESSARY(WUDC); HRUND(); CLEARRTGT();
	EXPRESSION(0); VTARGET_-1; SYM_GENCODE(.SYM,1);
	IF .SYM EQL HEMPTY THEN (SYM_ZERO; ERROR(.NSYM,31));
	IF .CODETOG THEN GWUD1(.SYM,.SORT EQL HUNTIL);
	FIXSIDEEFFECTS();
	IF .DEL<LEFTHALF> EQL HDO
%V2H%	    THEN HRUND() ELSE (RECOVER(.NDEL,2); RETURN( ERRLEVEL_1; KILLLABSIFNECESSARY));
	EXPRESSION(1);
	IF .SYM EQL HEMPTY THEN SYM_ZERO;
	IF .CODETOG THEN SYM_GWUD2(.SYM);
	ERRLEVEL_0; CLEARRTGT();
%V2H%	KILLLABSIFNECESSARY;
END;
%3.1%	GLOBAL ROUTINE SPAROPEN =
BEGIN 
	%THIS ROUTINE ACTS AS A SWITCH TO 
	THE APPROPRIATE ROUTINE TO HANDLE: (1)USER FUNCTION/
	ROUTINE CALLS, OR (2) SPECIAL FUNCTIONS.%
	
	IF .SYM<LSF> THEN
		BEGIN
		IF .ST[.SYM<STEF>,0]<TYPEF> EQL MACHT THEN SML() ELSE
		IF .ST[.SYM<STEF>,0]<TYPEF> EQL SPLFT THEN SSPLF() ELSE
		IF .ST[.SYM<STEF>,0]<TYPEF> EQL SPUNOPT THEN SSPUNOP() ELSE
			 SUSERCALL(0)
		END ELSE SUSERCALL(0);
END;

ROUTINE SML=
BEGIN LOCAL OP, N, P1,P2, P3, P4;
	%THIS ROUTINE HANDLES THE ANALYSIS OF THE MACHINE LANGUAGE
	SPECIAL FUNCTIONS. %
	OP_.ST[.SYM<STEF>,1]; N_P1_P2_P3_P4_0; HRUND();
	UNTIL .DEL<HCLASS> EQL CLOBRAC AND .DEL<LEFTHALF> NEQ HCOMMA DO
	    BEGIN
		EXPRESSION(2);
		IF .DEL<LEFTHALF> EQL HCOMMA
		    THEN (P1[.N]_.SYM; N_ .N+1; HRUND());
		ERRLEVEL_0;
	    END;
	P1[.N]_.SYM; ! IF NOT LITP(.P1) THEN ERROR(.NSYM,#146);
	% THE FOLLOWING 6 LINES ARE ADDED TO FIX REGISTER
	 DECLARATIONS AND USAGE IN NESTED GLOBAL ROUTINES 12-27-77 %
	IF NOT LITP(.P1) THEN
	 IF .P1<LSF> THEN
	  BEGIN
	   IF UPLEVELCHECK(.P1) THEN P1=.SYMVALUE
				ELSE ERROR(.NSYM,#146);
	  END;
	IF .DEL<LEFTHALF> EQL HROCLO
		THEN (IF .CODETOG THEN 
	% THE FOLLOWING 10 LINES ARE ADDED TO FIX BUG#4 %
					BEGIN
					 INCR I FROM 0 TO 2 DO
					  ( IF NOT LITP(.P2[.I]) THEN
					     IF .P2[.I]<LSF> THEN
						IF UPLEVELCHECK(.P2[.I]) THEN
						 P2[.I]=.SYMVALUE;
					  );
					  SYM=GML(.OP,.P1,.P2,.P3,.P4)
					END 
		     )
		ELSE (RECOVER(.NDEL,#150); RETURN ERRLEVEL_1);
	IF CORRECTP1() THEN FUTSYM_.SYM
		ELSE(RECOVER(.NFUTSYM,IF FUTAE() THEN 3 ELSE 12); ERRLEVEL_1);
	HRUND();
END;
%3.1%	GLOBAL ROUTINE DECLTEMPREG(SYMBLEX,SWIT)=
	% THIS ROUTINE DECLARES (AND UN-DECLARES) A TEMPORARY
	REGISTER FOR USE IN INCR-DECR LOOPS. SWIT=1 IMPLIES
	MAKE DECLAR,SWIT=0 SIMPLY DOES A BLOCKPURGE. IN CASE
	OF A DECLARATION WE RETURN THE LEXEME FOR THE NEW 
	REGISTER VARIABLE.
	%
	BEGIN LOCAL L1;
	IF .SWIT THEN
	  BEGIN BLOCKLEVEL_.BLOCKLEVEL+1; L1_.REALS;
	    IF .SYMBLEX<LSF> NEQ 1 AND .L1 EQL 0 THEN ERROR(.NSYM,#36) ELSE
		BEGIN
		ACCUM_.ST[.L1,2]; ACCUM+1_.ST[.L1,3];
		L1_STINSERT(.UNDECLEX,0);
		ST[.L1,0]<TYPEF>_REGT;
		SYMBLEX_ST[.L1,1]_LTINSERT(ACQUIRE(-.L1,1)<0,36>);
		ST[.L1,1]<NRF>_1;
		SYMBLEX<VEF>_1;
		.SYMBLEX
		END
	  END ELSE BLOCKPURGE(BLOCKLEVEL_.BLOCKLEVEL-1)
	END;
%%
%    PLIT SYNTAX PROCESSING ROUTINES.  THE SYNTAX FOR PLITS IS AS
  FOLLOWS:

    <PLIT> ::= PLIT <PLITARG>
    <PLITARG> ::= <LOAD TIME EXPRESSION> !
                  <LONG STRING> !
                  <TUPLE>
    <TUPLE> ::= (<TUPLE ITEM LIST>)
    <TUPLE ITEM LIST> ::= <TUPLE ITEM> !
                          <TUPLE ITEM>,<TUPLE ITEM LIST>
    <TUPLE ITEM> ::= <LOAD TIME EXPRESSION> !
                     <LONG STRING> !
                     <DUPLICATION FACTOR>:<PLITARG>
    <DUPLICATION FACTOR> ::= <COMPILE TIME EXPRESSION>

     [NOTE: <LOAD TIME EXPRESSION> ::= <PLIT> ! ...]

     GENERALLY PLITS ARE TREATED EXACTLY AS GLOBALS.  A FAKE SYMBOL
  TABLE ENTRY OF TYPE "PLITT" IS ENTERED IN THE SYMBOL TABLE;
  ITS ADDITIONAL INFORMATION WORD IS ITS OFFSET FROM THE PLIT REGION
  BASE.  OF COURSE, A NEW RELOCATION TYPE FOR PLITS IS REQUIRED.

     INTERNALLY THE ELEMENTS OF ALL PLITS ARE HUNG OFF A HEADER
  POINTED TO BY "PLHEAD".  EACH ELEMENT IS A POINTER TABLE TYPE
  ELEMENT, WITH TWO EXCEPTIONS:

     1. LITERALS ARE ALSO PUT IN, WITH RELOCATION TYPE "NORELOC";
     2. DUPLICATED SUBLISTS ARE ENTERED AS 2 CELL HEADERS; WORD 2
        CONTAINS THE REPETITION FACTOR.

     "PLHEAD" IS PROCESSED BY THE LOADER INTERFACE AT THE END OF
  THE COMPILATION.  THE SYNTAX PROCESSING ROUTINES FOR THE PLITS
  GENERALLY CORRESPOND TO THE NON-TERMINAL PRODUCTIONS OF THE SYNTAX.
  EACH ROUTINE IS PASSED A HEADER ONTO WHICH THE RESULTING CHAIN OF
  POINTER TYPE ENTRIES IS LINKED.  EACH RETURNS THE LENGTH OF THE
  SPACE OCCUPIED BY THE PARTICULAR NON-TERMINAL IN ORDER THAT THE
  "PLNEXT" (NEXT PLIT OFFSET) MAY BE UPDATED CORRECTLY.
%
%%
  MAP STVEC PLHEAD;   ! CT HEADER FOR THE SYSTEM PLITS

  FORWARD PLITARG, PLITLEX, FINNAMES;
  GLOBAL ROUTINE SPLIT1(A) =
    BEGIN
! IF .A EQL  0 THEN IT IS PLIT OR UPLIT.
! IF .A EQL 2 THEN CALLED FROM OWNEQL.
! IF .A EQL 1 THEN CALLED FROM GLOEQL.
! (5.200.13) INTRODUCES  UPLIT, UNCOUNTED PLIT
! (5.200.13)      BIND PLITLENGTH=1;
%5.200.13%	LOCAL PLITLENGTH;

      LOCAL STVEC TEMPHEAD:NEXTCELL:FIRSTCELL, OFFST, LOCGPV, NAMESINDEX;
      PUSHGPV(0,PLBOOL)_1;
      NAMESINDEX_0;
      TEMPHEAD_HEADER(0,0,0);

            IF .A EQL 0 THEN
%5.200.13%	IF .DEL<LEFTHALF> THEN PLITLENGTH_0	! UPLIT IS ODD
%5.200.13%			  ELSE PLITLENGTH_1;	!  PLIT IS EVEN

%5.200.13%   IF (.PLITLENGTH EQL 1 OR .A GEQ 1) THEN FIRSTCELL_NEWBOT(.TEMPHEAD,1);
      OFFST_PLITARG(NAMESINDEX,.TEMPHEAD,0);
%5.200.13%      IF .NAMESINDEX NEQ 0 THEN FINNAMES(.NAMESINDEX,.PLITLENGTH);
%5.200.13%      IF (.PLITLENGTH EQL 1  OR .A GEQ 1) THEN FIRSTCELL[1]_.OFFST;
         IF .A EQL 0 THEN (
%5.200.13%      SYM_PLITLEX(.PLNEXT+.PLITLENGTH);
%5.200.13%      PLNEXT_.PLNEXT+.OFFST+.PLITLENGTH;
                SYM<POSNSIZEF>_36);
  CASE .A OF SET
      PUSHBOT(.PLHEAD,.TEMPHEAD);
      PUSHBOT(.GLOHEAD,.TEMPHEAD);
      PUSHBOT(.OWNHEAD,.TEMPHEAD)
   TES;
      FLATTEN(.TEMPHEAD);
      POPGPV(0,PLBOOL);
     IF .A EQL 0 THEN .SYM ELSE .FIRSTCELL
    END;


  GLOBAL ROUTINE SPLIT=SPLIT1(0);
%5.200.13%	  ROUTINE FINNAMES(NAMESINDEX,PLITLSW)=	!FINISH NAMES BINDING IN PLITS
    BEGIN
      LOCAL L,LL;
%5.200.16%	LOCAL GSW;
	WHILE .NAMESINDEX NEQ 0 DO
	  BEGIN
%5.200.16%	    LL_.ST[.NAMESINDEX,1]<18,15>;
!THE LEFT HALF HOLDS A FORWARD INDEX AND, NOW (5.200.16), A GLOBAL SWITCH
%5.200.16%		GSW_.ST[.NAMESINDEX,1]<35,1>;
	    ST[.NAMESINDEX,1]<LEFTHALF>_0;
%5.200.13%	    ST[.NAMESINDEX,1]_.ST[.NAMESINDEX,1]+.PLNEXT+.PLITLSW;
%5.200.16%	ST[.NAMESINDEX,0]<TYPEF>_
%5.200.16%		IF .GSW THEN GPLITT ELSE PLITT;

!  %5.200.16%	    IF .ST[.NAMESINDEX,0]<TYPEF> EQL GPLITT
%5.200.16%	IF .GSW
		THEN DEFGLLEX(.NAMESINDEX);
	    NAMESINDEX_.LL
	  END
    END;
  FORWARD TUPLEITEM, LSORLE;
  ROUTINE PLITARG(NAMESINDEX,HEAD,DUPPLITFL) =
    !HEAD IS INDEX TO LIST OF PLIT ARGS
    !NAMESINDEX CONTAINS ADDRESS OF WORD TO RECEIVE STINDEX OF NAME TO
    !BE BOUND VIA A NAMES OR INDEXES BIND
    !DUPPLITFL EQL 1 <=> DUPPLICATION FACTOR MAKES A NAMES OF
    !INDEXES BIND ILLEGAL AT THIS POINT.
    BEGIN
      HRUND();
      IF .SYM EQL HEMPTY AND .DEL<LEFTHALF> EQL HROPEN
        THEN
          BEGIN
            LOCAL LENTH,	!LENGTH OF PLIT IN WORDS, NOT COUNTING PLIT[-1]
		  LNAMESINDEX,	!INDEX TO NAMES BIND ST ENTRY CHAIN
		  LNSYM;	!CONTAINS .NSYM IN CASE WE MUST HRUND ON A GLOBAL BIND
	    REGISTER PLITFLAGS,	!PLIT FLAGS EXPLAINED IN MACROS BELOW
		     RSTE;	!STE INDEX OF NAME TO BE BOUND
	   MACRO CHAIN(X)=ST[X,1]<18,18>_.LNAMESINDEX;
			   LNAMESINDEX_X;$;

	    MACRO NAMESFL=PLITFLAGS<0,1>$,	!1 -> NAMES BIND, 0-> INDEXES BIND
		  GLOBALFL=PLITFLAGS<1,1>$;	!1<-> GLOBAL BIND
            PLITFLAGS_LNAMESINDEX_LENTH_0;
%A%         DO (HRUND();

	  !LOOP UNTIL THERE ARE NO MORE NAMES OR INDEXES BINDS
%B%	  WHILE (NAMESFL_(.DEL<LEFTHALF> EQL HNAMES)) OR
			 (.DEL<LEFTHALF> EQL HINDEXES) OR
			 (GLOBALFL_(.DEL<LEFTHALF> EQL HGLOBALLY))
	   DO
	    BEGIN
	      BEGIN
		LNSYM_.NSYM;
		IF .DUPPLITFL THEN (WARNEM(.LNSYM,ERNOBINDDUP);EXITCOMPOUND[2]);	%C%
		IF NOT .SYM<LSF> THEN (WARNEM(.LNSYM,ERNONAME); EXITCOMPOUND[2]);	%C%
		RSTE_.SYM<STEF>;	!STE INDEX OF NAME TO BE BOUND
%2.20%		IF .GLOBALFL THEN HRUND();	!TO MOVE OVER GLOBALLY LEXEME

		IF NOT ((.DEL<LEFTHALF> EQL HINDEXES) OR (NAMESFL_(.DEL<LEFTHALF> EQL HNAMES)))
		  THEN (WARNEM(.NDEL,ERDMBIN); EXITLOOP %EXIT LOOP -B-%);

		IF .ST[.RSTE,0]<BLF> EQL .BLOCKLEVEL	!IF NAME ALREADY DECLARED AT THIS BLOCK LEVEL
		  THEN (IF .ST[.RSTE,0]<TYPEF> NEQ UNDEDT THEN (WARNEM(.LNSYM,ERNMPREV); EXITCOMPOUND[3]))	%C%
		  ELSE RSTE_DECSYQ(.RSTE,0,0);

%2.34%		IF .GLOBALFL THEN IF GSTINSERT(.RSTE) NEQ 0
%2.20%		  THEN (WARNEM(.LNSYM,ERALDECGL); GLOBALFL_0);

		ST[.RSTE,1]_.LENTH;	!SAVE OFFSET IN ALL CASES


		ST[.RSTE,0]<TYPEF>_CASE .PLITFLAGS OF SET
		ABSOLUTET;				!INDEXES
%5.200.16%	(CHAIN(.RSTE);%PLITT% UNDEDT);			!NAMES
		(DEFGBC(.RSTE,.LENTH);GABSOLUTET);	!GLOBALLY INDEXES
%5.200.16%	(CHAIN(.RSTE);ST[.RSTE,1]<35,1>_1;%GPLITT%  UNDEDT)			!GLOBALLY NAMES
		TES
%C%	      END;
	      HRUND();
	    END;	!OF WHILE-DO LOOP %B%
	    .NAMESINDEX_.LNAMESINDEX;
	     LENTH_.LENTH+TUPLEITEM(.HEAD);)	!END OF DO PORTION OF DO-WHILE LOOP
              WHILE .DEL<LEFTHALF> EQL HCOMMA;	!END OF DO-WHILE LOOP %A% 
            IF .DEL<LEFTHALF> NEQ HROCLO OR .FUTSYM NEQ HEMPTY 
              THEN RETURN RECOVER(.NDEL,ERSYPLMRP);
            HRUND();
            .LENTH
          END
        ELSE LSORLE(.HEAD)
    END;
 ROUTINE TUPLEITEM(HEAD) =
    BEGIN
      EXPRESSION(1);
      IF .DEL<LEFTHALF> EQL HCOLON
        THEN
          BEGIN
            LOCAL LEN, STVEC NEWHEAD, NAMESINDEX;
            IF NOT LITP(.SYM) THEN (ERROR(.NSYM,ERSMPLNLI); SYM_ZERO);
            NEWHEAD_HEADER(2,0,1);
           !THE FOLLOWING THREE LINES WILL CHECK FOR NEGATIVE
           !RELICATION COUNT IN A PLIT AND WARN THEM. 3-28-77
            LEN_LITV(.SYM);
            IF .LEN LSS 0 THEN (LEN_0;WARNEM(.NSYM,#763));
            NEWHEAD[2]<RIGHTHALF>_.LEN;
            PUSHBOT(.HEAD,.NEWHEAD);
            LEN_.LEN*PLITARG(NAMESINDEX,.NEWHEAD,1);
	    .LEN
          END
        ELSE LSORLE(.HEAD)
    END;

  FORWARD LEXTOP;
  MACRO UNDER(A,B)=
    BEGIN
      MAP STVEC A:B;
      CT[.A[1]<PREVF>,0]<NEXTF>_.B[1]<NEXTF>;
      CT[.B[1]<NEXTF>,0]<PREVF>_.A[1]<PREVF>;
      A[1]<PREVF>_.B[1]<PREVF>;
      CT[.B[1]<PREVF>,0]<NEXTF>_.A;
      RELEASESPACE(.B,1)
    END$;

  ROUTINE LSORLE(HEAD)=
%5.200.18%BEGIN LOCAL WHICHB;
    IF .STRHED NEQ 0
      THEN
        BEGIN
          LOCAL RLEN, LSHEAD;
          LSHEAD_.STRHED<RIGHTHALF>;
          RLEN_.STRHED<LEFTHALF>;
          STRHED_0;
%5.200.34 - CHANGE FOR UPLIT... %
	IF .CT[.HEAD,1]<NEXTF> EQL .HEAD THEN
		BEGIN
		LOCAL FSW,LSW;
		FSW=.CT[.LSHEAD,1]<NEXTF>;
		LSW=.CT[.LSHEAD,1]<PREVF>;
		CT[.HEAD,1]<NEXTF>=.FSW;
		CT[.FSW,0]<PREVF>=.HEAD;
		CT[.HEAD,1]<PREVF>=.LSW;
		CT[.LSW,0]<NEXTF>=.HEAD;
		RELEASESPACE(.LSHEAD,1);
		END
         ELSE  UNDER(HEAD,LSHEAD);
% .... 5.200.34%
          .RLEN
        END
      ELSE
%5.200.18%	(WHICHB_WHICHBIND();
%5.200.18%	IF .WHICHB GTR 1 THEN WHICHB_3-.WHICHB;
%5.200.18%	IF .WHICHB EQL 0
%5.200.18%    THEN  (ERROR(.NSYM, ERSMPLNLO); LEXTOP(.HEAD,ZERO)) ! 0 - RUNTIME CODE MADE / 3 - RUNTIME ADDRESS
%5.200.18%	ELSE  (LEXTOP(.HEAD,.SYM)))			! 1 - LITERAL / 2 - LOADTIME ADDRESS
%5.200.18%END;
  ROUTINE LEXTOP(HEAD,LEX) =
    BEGIN
      LOCAL STVEC CELL, CODE3;
      CELL_GETSPACE(1);
      CELL[0]_.CELL^15+.CELL;
      IF .LEX<LSF>
        THEN
          BEGIN
            CODE3_
		IF PTRTYPP(.LEX)
		  THEN MADDRFRPTRTYP(.LEX)
		  ELSE FSA(.LEX<STEF>);
            CELL[0]<RELOCF>_.CODE3<RELOCF>;
            CELL[1]_
%3.40%		IF PTRTYPP(.LEX)
		  THEN VALPTRTYP(.LEX<STEF>)
		  ELSE .LEX<POSNSIZEF>^24 OR (.CODE3 AND IXYM);
          END
        ELSE
          BEGIN
            CELL[0]<RELOCF>_NORELOC;
            CELL[1]_LITV(.LEX);
          END;
      PUSHBOT(.HEAD,.CELL);
      1
    END;
  ROUTINE PLITLEX(OFFST)=
  BEGIN
    ACCUM[0]_0; ACCUM[1]_-1;
    (STINSERT((PLITT^TYPEFP)+LSM,.OFFST)+LSM)
  END;



!END OF H1SYNT.BLI