Google
 

Trailing-Edge - PDP-10 Archives - BB-H138C-BM - language-sources/lx0n.bli
There are 18 other files named lx0n.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:	LOLEXA.BLI
!DATE:		18 OCTOBER 73	MGM/FLD


!  REVISION HISTORY :
!  12-21-77 ROUTINE IDFIXFS IS MODIFIED TO ALLOW REGISTERS WITH SAME
!  	    NAMES DEFINED IN NESTED GLOBAL ROUTINES.
!
!  9-19-77  ROUTINE SKAN IS MODIFIED TO FIX BUGS#40,41.
!           ROUTINE IDFIXER IS MODIFIED SO THAT MACRO NAME
!           IS ALLOWED AS PART OF THE  REQUIRE FILE NAME.
!
!  7-15-77   ROUTINE IDFIXFS IS MODIFIED TO ALLOW REGISTER BIND TO
!            BIND VARIABLE AND ASSIGNMENT TO OWN AND GLOBAL VARIABLES.
!  5-9-77   ROUTINES IDFIXFS,IDFIXER,SKAN ARE MODIFIED TO
!  6-6-77   ROUTINE IDFIXER IS MODIFIED SO THAT REQUIRE FILE
!           NAME CAN BE A MACRO NAME AND NO MACRO EXPANSION AND
!           NO ERROR MESSAGE.
!
!           FIX BUGS REQUIRE FILE NAME,MACRO X=!!$; AND
!           #-14 VALUE (BIND A=#-14).
!
	%5.200.1:  CHANGE TO WATCH FOR OFF-END-OF-15BIT-ADDRESSING/ PAB%
%3.2%	GLOBAL BIND LOLEV=6;	!MODULE VERSION NUMBER

        EXTERNAL REGASSN;   ! 7-8-77
OWN REDO;		! USED TO CHANGE RECUR. TO IT. IN HRUND


FORWARD WRUND;



!                   LEXICAL  ANALYZER  
!          --------------------------------------  




! SUPPORT ROUTINES 
!-------------------

%3.1%	GLOBAL  ROUTINE LEXERR=
	!  THIS ROUTINE IS CALLED ONLY FOR SOME QUEER
	!  ERRORS WHERE A DELIMITER WAS NOT PLACED BETWEEN
	!  TWO OPERANDS.
	BEGIN  ERROR(.NDEL,#776); HRUND();
	  SYM_LITLEXEME(0)
	END;

%3.1%	GLOBAL ROUTINE PUNT(ERR)=
	!
	! THIS ROUTINE IS CALLED FOR CATISTROPHIC COMPILER
	! ERRORS WHICH FORCE US TO DO A COMPLETE RESTART. WE
	! GIVE AN ERROR TO THE USER AND JRST BACK TO REINIT
	! THE MAIN LOOP. SORRY FOLKS!!
	!
	BEGIN EXTERNAL FINIO;
	ERROR(.NDEL,.ERR); EOCHAR(#77); EOCHAR(#11); EMESSAGE("PUNT!",1);
%2.19%	!ZERO XREFLG SO THAT WE WON'T GET INTO AN INFINITE LOOP
%2.19%	!BETWEEN XEOB AND PUNT.
%2.19%	ENEWLINE(); FINIO(); XREFLG_0; NDRIVER();
	END;
! DYNAMIC STORAGE MANAGEMENT  
!-----------------------------  


GLOBAL ROUTINE DOCOREUUO (UUOARG) =

  !DO A STANDARD CORE UUO WITH ARG OF .UUOARG.
  !RETURN 0 IF SUCCESS, ELSE (-1)

    BEGIN

      REGISTER R;
%3.31%  MACHOP CALLI = #047, TDZA = #634, SETOI = #475;

	R_.UUOARG;

	CALLI	(R,#11);	!CORE  UUO
	TDZA	(R,R);		!ERROR RETURN
%3.31%	SETOI	(R,0);		!SUCCESSFUL RETURN

%3.31%	COREGONE_ NOT .R

    END;


%3.1%	GLOBAL ROUTINE CALLEXECFORSPACE=
  BEGIN
    REGISTER R;
    MACHOP HLRO=#564;
    EXTERNAL ?.JBREL,?.JBSYM,?.JBDDT;
%3.31% IF DOCOREUUO(.?.JBREL<0,18> + #2000) THEN PUNT(#770);
    ENDOFSPACE _ .ENDOFSPACE + #2000/TIMXMF;
%5.200.1%	IF .ENDOFSPACE GTR #100000 THEN
	EMESSAGE("WARNI","NG: E","NDOFS","PACE ",
	"HAS E","XCEED","ED 2*","*15  ",8);
    IF
	(.?.JBSYM<RIGHTHALF> GTR 0) AND (.?.JBSYM<RIGHTHALF> LSS #400000)
     THEN
      BEGIN
        BIND
            L=NOT HLRO(R,?.JBSYM),
            NEWSYM=(.?.JBREL<,18>)[-L],
            OLDSYM=(.?.JBSYM<,18>)[0];
        DECR I FROM L TO 0 DO
            NEWSYM[.I] _ .OLDSYM[.I];
        ?.JBSYM<,18> _ NEWSYM
      END
  END;
    ROUTINE GARBAGECOLLECT=
        BEGIN REGISTER R1, LST;

! 	ENEWLINE();EMESSAGE("G IN ",1);
      NOGBGCOL_.NOGBGCOL+1;
	R1_.FREEHEAD;
	DECR I FROM (.TOPOFTABLE^(-4-TIMXGF)) TO 0 DO (AVL+.I)<0,36>_0;
	DO AVL[.R1/TIMXGF]_1 UNTIL (R1_.TABLE[.R1,1]) LEQ 1;
	LST_R1_0;
	WHILE (R1_.R1+TIMXGF) LEQ .TOPOFTABLE DO
	    IF .AVL[.R1/TIMXGF] THEN
		BEGIN
		TABLE[.LST,1]_.R1; LST_.R1;
		WHILE (R1_.R1+(TIMXGF*.TABLE[.R1,0]); .AVL[.R1/TIMXGF]) DO
		    TABLE[.LST,0]_.TABLE[.LST,0]+.TABLE[.R1,0];
		END;
	TABLE[.LST,1]_0;
! 	EMESSAGE("G OUT",1);
	END;


    ROUTINE ZEROIT(LOC,NUM)=
	BEGIN
	INCR I FROM .LOC TO .LOC+2*(.NUM-1) BY 2 DO
	    TABLE[.I,0]_TABLE[.I,1]_0;
	.LOC
	END;


%3.1%	GLOBAL ROUTINE RELEASESPACE(LOC,NUM)=
	BEGIN
	TABLE[.LOC,0]_.NUM; TABLE[.LOC,1]_.FREEHEAD; 
	FREEHEAD_.LOC; AMNTFREE_.AMNTFREE+.NUM 
	END;


    ROUTINE GETTER(NUM)=
	BEGIN LOCAL L,LL,N,M;

	L_.FREEHEAD; LL_0; AMNTFREE_.AMNTFREE-.NUM;
	WHILE .L GTR  1 DO
	    IF (M_.TABLE[.L,0]) LSS .NUM
		THEN (LL_.L; L_.TABLE[.L,1])
		ELSE IF .M EQL .NUM
			THEN (TABLE[.LL,1]_.TABLE[.L,1]; RETURN .L)
			ELSE (M_TABLE[.L,0]_.M-.NUM;  RETURN .L+.M*TIMXGF );
	AMNTFREE_.AMNTFREE+.NUM; RETURN -1
	END;
    ROUTINE GET12(NUM)=
	BEGIN LOCAL L,LL,N,M;

	L_.FREEHEAD; LL_0; AMNTFREE_.AMNTFREE-.NUM;
	WHILE .L GTR 1 DO
	    IF .TABLE[.L,0] NEQ .NUM
		THEN (LL_.L; L_.TABLE[.L,1])
		ELSE (TABLE[.LL,1]_.TABLE[.L,1]; RETURN .L);
	AMNTFREE_.AMNTFREE+.NUM; RETURN -1
	END;


%3.1%	GLOBAL  ROUTINE GETSPACE(NUM)=
	BEGIN LOCAL X;EXTERNAL CALLEXECFORSPACE,RETOT;

	IF .NUM LEQ 2 THEN IF (X_GET12(.NUM)) GTR 0 
		THEN RETURN ZEROIT(.X,.NUM);
	IF (X_GETTER(.NUM)) GTR 0 THEN RETURN ZEROIT(.X,.NUM);
	IF .AMNTFREE GTR .NUM*4 THEN       ! IF AVAIL SPACE IIS 4*REQUEST
	    IF .AMNTFREE GTR (.ENDOFSPACE-.TOPOFTABLE) THEN
		BEGIN
		GARBAGECOLLECT();
		IF (X_GETTER(.NUM)) GTR 0 THEN RETURN ZEROIT(.X,.NUM);
		END;
	WHILE (.TOPOFTABLE+TIMXGF*.NUM) GTR .ENDOFSPACE DO CALLEXECFORSPACE();
	X_.TOPOFTABLE; TOPOFTABLE_.TOPOFTABLE+TIMXGF*.NUM;
%5.200.1%	IF .TOPOFTABLE GTR #100000 THEN
	(EMESSAGE("WARNI","NG: T","OPOFT","ABLE ","HAS E",
	"XCEED","ED 2*","*15  ",8);COREGONE_1;PUNT(#770););
	ZEROIT(.X,.NUM)
	END;
! LITERAL TABLE MANAGEMENT AND LIT-LEXEMES  
!---------------------------------------------  


%2.9%	GLOBAL ROUTINE LTINSERT(LIT)=
%2.9%	  !LTINSERT RETURNS AS ITS VALUE THE INDEX INTO THE
%2.9%	  !LT WHERE THE LITERAL .LIT IS STORED.
%2.9%	  !.LIT IS A LITERAL VALUE.
%2.9%	  BEGIN
%2.9%	    !ALWAYS RETURN THE LARGEST POSSIBLE OFFSET FOR THE LITERAL 0.
%2.9%	    IF .LIT EQL 0 THEN RETURN #37777;

%2.9%	    BEGIN
%2.9%	      REGISTER	R1,	!INDEX THRU LT SEARCH
%2.9%			R2,	!HASH FUNCTION VALUE
%2.9%			TVAL,	!LT ENTRY FOR COMPARISONS WITH .LIT
%2.9%			RBASE;	!BASE ADDRES OF CURRENT LT MODULE

%2.9%	      !FIRST COMPUTE THE HASH FUNCTION
%2.9%	      R2_((.LIT +.LIT^(-9) +.LIT^(-18) +.LIT^(-27)) AND LTMASK);
%2.9%	      !NOW SEARCH EACH MODULE FROM NUMBER LTNUM-1 TO 0
%2.28%	      INCR TNUM FROM 0 TO LTNUM - 1 DO
%2.9%		BEGIN
%2.9%		  !IF WE HAVEN'T SET UP THIS MODULE YET, WE DO SO
%2.9%		  IF .LTBASE[.TNUM] EQL 0
%2.9%		    THEN LTBASE[.TNUM]<RIGHTHALF>_CT[GETSPACE(LTSIZE^(-1)),0];
%2.9%		  RBASE_.LTBASE[.TNUM]<RIGHTHALF>;

%2.9%		  R1_.R2;

%2.9%		  !NOW LET'S SEARCH THIS PARTICULAR MODULE.
%2.9%		  WHILE 1 DO
%2.9%		    BEGIN
%2.9%		      !IF THIS ENTRY EQUALS .LIT RETURN WITH THE APPROP INDEX
%2.9%		      IF ((TVAL_@(@RBASE)[R1_((.R1+1) AND LTMASK)]) EQL .LIT)
%2.9%			THEN
%2.9%			  RETURN (.R1 + .TNUM*LTSIZE);

%2.9%			!IF THIS ENTRY IS 0, WE INSERT THE LITERAL HERE IF WE
%2.9%			!HAVE NOT YET EXCEEDED LTLIM FOR THIS MODULE.
%2.9%			IF .TVAL EQL 0
%2.9%			  THEN IF .LTBASE[.TNUM]<LEFTHALF> LEQ LTLIM
%2.9%			    THEN
%2.9%			    BEGIN
%2.9%			      LTBASE[.TNUM]_.LTBASE[.TNUM]+1^18;	!UP COUNT
%2.9%			      (@RBASE)[.R1]<0,36>_.LIT;	!INSERT LIT
%2.9%			      RETURN (.R1 + .TNUM*LTSIZE);	!RETURN INDEX
%2.9%			    END
%2.9%			  ELSE EXITLOOP		!TO %B%
%2.9%			ELSE EXITCOMPOUND	!TO %A%
%2.9%		    END;	!%A% TO HERE IF ENTRY IS NOT THE RIGHT LIT
%2.9%		END;		!%B% TO HERE IF HAVE FINISHED THIS MODULE

%2.9%	  END;
%2.9%	  END;
%2.9%	GLOBAL ROUTINE GETLITVAL(IND)=
%2.9%	  !RETURNS THE 36 BIT VALUE OF THE LITERAL WHOSE INDEX IS IND
%2.9%	  IF .IND EQL #37777 THEN RETURN 0 ELSE
%2.9%	  .(.LTBASE[(.IND)/LTSIZE])[(.IND AND LTMASK)]<0,36>;



%3.1%	GLOBAL  ROUTINE LITLEXEME(VALUE)=
    BEGIN
     LOCAL L1;
      !
      !  THIS ROUTINE CREATES, AND RETURNS, A LEXEME FOR THE
      !  LITERAL WHOSE VALUE IS IN 'VALUE'.
      !

      IF .VALUE LEQ #37777 AND .VALUE GTR 0
        THEN
          BEGIN
            L1_LITLEX1;  L1<LTEF>_.VALUE;
          END
        ELSE
          BEGIN
            L1_LITLEX2;  L1<LTEF>_LTINSERT(.VALUE);
          END;
      .L1
    END;
! SYMBOL TABLE ROUTINES  
!------------------------ 


%3.1%	GLOBAL  ROUTINE HASH(SYMBOL)=
      ! 
      !  THIS ROUTINE COMPUTES THE HASH FUNCTION OF SYMBOL
      !
%3.29%	ABS(.SYMBOL MOD HTSIZE);




%3.1%	GLOBAL  ROUTINE STINSERT(LEX,ADDINFO)=
    BEGIN LOCAL L1,L2;
      !
      !  THIS ROUTINE CREATES A ST ENTRY AT THE CURRENT BLOCK
      !  AND FUNCTION LEVELS.  THE SYMBOL IS ASSUMED TO BE IN
      !  ACCUM.
      !

      L1_HASH(.ACCUM);
      L2_GETSPACE(2);
      LEX<BLF>_.BLOCKLEVEL;
      LEX<FLF>_.FUNCTIONLEVEL;
      LEX<LINKF>_.HT[.L1];
      HT[.L1]_.L2;
      ST[.L2,0]_.LEX;
      ST[.L2,1]_.ADDINFO;
      ST[.L2,2]_.ACCUM;
      ST[.L2,3]_.(ACCUM+1);
      IF .XREFLG THEN XREFINS(.LEX);
      .L2
    END;
  GLOBAL ROUTINE GLOBALCHECK(STINDEX) =

    !CHECK TO SEE IF THIS NAME HAS BEEN DECLARED GLOBAL AT ANY
    !BLOCKLEVEL.  IF SO, RETURN THE INDEX OF THE STE, OTHERWISE 0.
	!IF NOT, MAKE AN ENTRY IN THE GST FOR THIS SYMBOL.
    !STINDEX IS THE ST INDEX OF THE NAME WE CURRENTLY WISH TO
    !DECLARE GLOBAL.

      BEGIN

	REGISTER L1;

	!LOOK THRU GLOBAL SYMBOL TABLE FOR MATCH IN FIRST 6 CHARS
%2.31%	L1_.GLLIST;


	WHILE .L1 NEQ 0 DO
	  BEGIN
	    IF .ST[.STINDEX,2] EQL .ST[.L1,2] THEN	!IF NAME IS ...
%2.31%	    IF (((.ST[.STINDEX,3] XOR .ST[.L1,3]) AND
%2.31%		#774000^18) EQL 0) THEN	!THE SAME IN THE FIRST SIX CHARS
	          RETURN(.L1);
	    L1_.ST[.L1,0]<LINKF>
	  END;

	  RETURN(0);	!TO INDICATE THAT WE DIDN'T FIND ENTRY
      END;
%2.34%	GLOBAL ROUTINE GSTINSERT(IND)=
%2.34%		!INSERT STE WITH INDEX .IND INTO GLOBAL SYMBOL TABLE ALSO.
%2.34%		!FOR NOW, THE ADDINFO WORD OF THIS ENTRY WILL BE LEFT NULL.
%2.34%	
%2.34%		BEGIN
%2.34%	
%2.34%		  REGISTER GIND;	!INDEX OF GLOBAL STE
%2.34%	
%2.34%		  !FIRST SEE IF IT'S ALREADY THERE
%2.34%		  IF(GIND_GLOBALCHECK(.IND)) NEQ 0 THEN
%2.34%		    BEGIN
%2.34%		      WARNEM(.NFUTSYM,ERREDGLOBAL);
%2.34%		      RETURN .GIND;
%2.34%		    END;
%2.34%	
%2.34%		  !SINCE WE DIDN'T FIND ONE, LET'S MAKE ONE

%2.34%		  GIND_GETSPACE(2);	!FIRST GET CELL FOR NEW GSTE

%2.34%		  DECR I FROM 3 TO 0 DO	!COPY THE ST INFO INTO THE GST CELL
%2.34%		    CT[.GIND,.I]_.CT[.IND,.I];
%2.34%	
%2.34%		  CT[.GIND,0]<LINKF>_.GLLIST;	!PUT THIS GSTE INTO LIST
%2.34%		  GLLIST_.GIND;		!LINK TO NEW CELL
%2.34%	
%2.34%		  RETURN(0);	!TO INDICATE THAT WE MADE A NEW ENTRY
%2.34%	
	END;	!OF ROUTINE GTINSERT


GLOBAL   ROUTINE SEARCH=
    BEGIN LOCAL L1;
%5.200.31%	GLOBAL XREFERASE;
      !
      !  THIS ROUTINE SEARCHES FOR THE SYMBOL IN ACCUM, AND RETURNS
      !  ITS SYMBOL TABLE INDEX.  NOTE THAT IF NOT FOUND AN "UNDECLARED"
      !  ENTRY IS MADE IN THE SYMBOL TABLE.
      !

      L1_.HT[HASH(.ACCUM)];
      WHILE .L1 NEQ 0 DO
        BEGIN
          IF .ACCUM EQL .ST[.L1,2] THEN
          IF .(ACCUM+1) EQL .ST[.L1,3] THEN
	    BEGIN
%5.200.31%	IF .XREFERASE THEN XREFERASE_0 ELSE
	    IF .XREFLG THEN XLINE();
            RETURN .L1;
	    END;
	  L1_.ST[.L1,0]<LINKF>;
        END;
      RETURN(STINSERT(.UNDECLEX,0));
    END;
! CHARACTER SCAN ROUTINES  
!--------------------------  








%3.1%	GLOBAL  ROUTINE SKAN(COED)=
	BEGIN
%5.200.37%	EXTERNAL EOLCONTEXT;

%5.200.4%	MACRO STORNCOUNT=IF .ACCUMLENGTH LSS 140 THEN
				(ACCUMLENGTH_.ACCUMLENGTH+1;
				 REPLACEI(PACCUM,.CHAR));
				 SCANNER()$;


      !  THIS ROUTINE DOES THE PRIMARY CHARACTER SCANNING FOR
      !  THE COMPILER.  THE ACTION OF THE ROUTINE DEPENDS UPON
      !  THE VALUE OF THE PARAMETER 'COED' AS FOLLOWS (WHERE
      !  'CODE' IS XXX0YZ):
      !
      !       Z=1   :  READ A NEW (LOGICAL) LINE BEFORE SCANNING
      !       Y=1   :  DEBLANK BEFORE SCANNING
      !       XXX=0 :  DO NOTHING (OTHER THAN AS SPECIFIED BY 'YZ')
      !           1 :  SCAN FOR NEXT ATOM
      !           2 :  CONTINUE SCAN FOR <IDENTIFIER>
      !           3 :  CONTINUE SCAN FOR DECIMAL NUMBER
      !           4 :  CONTINUE SCAN FOR OCTAL NUMBER
      !           5 :  CONTINUE SCAN FOR QUOTED STRING
%3.17% !	  6 :  (CONTINUE) SCAN FOR SPECIAL <IDENTIFIER>
      !
      !  THE VALUE RETURNED BY THE ROUTINE IS:
      !
      !       0:   NO SCANNING PERFORMED
      !       1:   <IDENTIFIER> FOUND (IT IS IN ACCUM)
      !       2:   <LITERAL> FOUND (VALUE IN VAL)
      !       3:   (LONG) STRING FOUND (CHAR COUNT IN VAL,
      !                                 STRING IN STRING)
      !       4:   SPECIAL CHARACTER FOUND
      !
      !
      !  THE LENGTH OF THE ITEM SCANNED IS RECORDED IN
      !  "ACCUMLENGTH".


    IF .COED THEN UNTIL .CHAR EQL EOL DO SCANNER();
    IF .CHAR EQL EOL THEN SCANNER();
    IF .COED^(-1) THEN WHILE .CHAR LEQ #40 DO SCANNER();

      CASE .COED^(-3) OF
        SET

          RETURN 0;   !  XXX=0, WE DO NOTHING ELSE

          BEGIN       !  XXX=1, SCAN FOR NEXT ATOM
            VAL_ACCUMLENGTH_STRINFIXED_STRING_0;
            PACCUM_(ACCUM-1)<1,7>;
            ACCUM_(ACCUM+1)_-2;


		CASE .TYPE OF
		  SET
			(SKAN(#30);2);    ! DIGITS 0-7

			(SKAN(#30);2);    ! DIGITS 8,9

			(SKAN(#20);1);    ! LETTERS

			BEGIN             ! QUOTED STRING
%5.200.37%		EXTERNAL EOLCONTEXT;LOCAL OLDCONTEXT;
%5.200.37%		LOCAL OUTPUT;
%5.200.37%		OLDCONTEXT_.EOLCONTEXT;
%5.200.37%		EOLCONTEXT_"S";
			  QUOTETYPE_.CHAR;
%5.200.37%		  SCANNER(); OUTPUT_SKAN(#50);
%5.200.37%		EOLCONTEXT_.OLDCONTEXT;
%5.200.37%		.OUTPUT
			END;

			BEGIN             ! OCTAL NUMBER (#)
                           SCANNER();
                           IF .CHAR LSS #60 OR .CHAR GTR #71
                               THEN WARNEM(.NFUTSYM,#764);
			   SKAN(#40);
			  2
			END;

			BEGIN		!FOR ! OR EOL(#15)
			  DO SKAN(3) UNTIL .TYPE NEQ 5;
			  SKAN(#10)
			END;

			BEGIN             ! COMMENT (%)
%5.200.37%		LOCAL OLDEOL; EXTERNAL EOLCONTEXT;
%5.200.37%		OLDEOL_.EOLCONTEXT;
%5.200.37%		EOLCONTEXT_"%";
                          DO SCANNER() UNTIL .CHAR EQL "%";
%5.200.37%		EOLCONTEXT_.OLDEOL;
			  SCANNER(); SKAN(#12)
			END;

			BEGIN             ! SPECIAL DELIMITER
			  REPLACEI(PACCUM,.CHAR);
			  VAL_.CHAR-(
			    IF .CHAR LEQ #57 THEN #40 ELSE
			    IF .CHAR LEQ #100 THEN #52 ELSE
			    #104);
			  SCANNER();
			  4
			END;

			BEGIN             ! SUPER ESCAPE (?)
%3.17%			  SCANNER();
%3.17%			  IF (.TYPE NEQ 2) AND (.CHAR NEQ "%") AND (.CHAR NEQ ".")
%3.17%				AND (.CHAR NEQ "$") THEN RETURN SKAN(.COED);
%3.17%			  SKAN(#60);		!PICK UP SPECIAL IDENTIFIER
%3.17%			  1
			END;

			BEGIN             ! MACRO FORMAL (FORMALT)
			  REPLACEI(PACCUM,.CHAR);
			  SCANNER(); ACCUMLENGTH_1;
			  SKAN(#20);
			  1
			END;

			0;                ! INVALID TYPE-CODE

			0;                ! INVALID TYPE-CODE

			0;		  ! INVALID TYPE-CODE

			0;		  ! INVALID TYPE-CODE

			0;		  ! INVALID TYPE-CODE

			(SCANNER();SKAN(#12));	  ! IGNORE CHARACTER

		  TES

          END;        ! THIS IS THE END OF XXX=1

          BEGIN       !   XXX=2, CONTINUE SKAN FOR IDENTIFIER
              WHILE .TYPE LEQ 2 DO
              BEGIN
%5.200.7%		LOCAL TEMPFORGET;
			EXTERNAL QUOTESEEN;		! IN MA1N/BODY  A205.1
	%5.200.4%	IF .ACCUMLENGTH LSS 140 THEN
			(ACCUMLENGTH_.ACCUMLENGTH+1;
			IF ( .QUOTESEEN eql 0)  THEN IF .CHAR GEQ "a" THEN IF .CHAR LEQ "z" THEN		! A205.1	
			    CHAR=.CHAR-#40;		%9-19-77%								! A205.1
			IF ( .QUOTESEEN eql 0) THEN IF .CHAR EQL "&" THEN
			    CHAR="." ELSE IF .CHAR EQL  "_" THEN
				CHAR="%";		%9-19-77%
			 REPLACEI(PACCUM,.CHAR));
	%5.200.7%		UNTIL (TEMPFORGET_.FORGET<LEFTF>) EQL 0 DO
				BEGIN
				(.TEMPFORGET)<INUSEBIT>_0;
				FORGET<LEFTF>_.(.TEMPFORGET)<LEFTF>;
				(.TEMPFORGET)<LEFTF>_0
				END;
			SCANNER();
              END;
             END;

             BEGIN      !  XXX=3, CONTINUE SKAN FOR DECIMAL CONSTANT
               WHILE .TYPE LEQ 1 DO
                  BEGIN
                    VAL _ .VAL*10+ (.CHAR-"0");
	%5.200.4%		STORNCOUNT
                  END;

                  %NOW LOOK FOR FLOATING VALUES%
                  IF .CHAR EQL "." THEN
                     BEGIN LOCAL SCALE,ONETENTH,EXP,M1,M2,SIGNUM;
                        ONETENTH_SCALE_(#175631463146);
%2.21%                        VAL _ FLOAT (.VAL);
                        SCANNER();
                        WHILE .TYPE LEQ 1 DO
                          (VAL_.VAL FADR .SCALE FMPR
                              (FLOAT (.CHAR - "0"));
                        SCALE _ .SCALE FMPR .ONETENTH;
                           SCANNER()
                          );

                        IF .CHAR EQL "E" THEN %WE HAVE AN EXPONENT%
                        BEGIN
                           SCANNER();
                           SIGNUM_0;
                           IF .CHAR EQL "+" THEN SCANNER()
                           ELSE IF  .CHAR EQL "-" THEN(SIGNUM_1;SCANNER());
                           EXP_0;
                           ACCUMLENGTH_0;
                           WHILE .TYPE LEQ 1 DO
                             (ACCUMLENGTH_.ACCUMLENGTH+1;
                              EXP_.EXP*10+(.CHAR-"0");
                              SCANNER()
                             );
                           IF .ACCUMLENGTH EQL 0 THEN WARNEM(.NFUTDEL,#200);
                           M1_#201400^18;   !FLOATING ONE
                           M2_#204500^18;   !FLOATIMG TEN
                           WHILE .EXP NEQ 0 DO
                             (IF .EXP THEN M1_.M1 FMPR .M2;
                              M2_.M2 FMPR .M2;
                              EXP_.EXP^(-1)
                             );
                           VAL_IF .SIGNUM THEN .VAL FDVR .M1
                               ELSE .VAL FMPR .M1;
                        END
                     END
                 ;
             END;

             BEGIN    !  XXX=4,  CONTINUE SKAN FOR OCTAL CONSTANT
               WHILE .TYPE EQL 0 DO
                 BEGIN
                   VAL _ .VAL ^3+(.CHAR-"0");
	%5.200.4%	   STORNCOUNT;
                 END;
              END;

  BEGIN       ! XXX=5.   FINISH SCAN FOR QUOTED STRING

    LOCAL ZBIT, COED, SIZES, CALLFORDEL;
    MACRO NOCHAR=.SIZES<0,18>$,
          BSIZE=.SIZES<18,18>$,
          SEVENBIT=(.COED EQL 0)$,
          SIXBITS=(.COED EQL 1)$,
          RAD50=(.COED EQL 2)$;

    ROUTINE PRWORD(COED,SIZES)=
      BEGIN
        LOCAL RV;
        MACRO INRANGE(X,Y)=(.CHAR GEQ X AND .CHAR LEQ Y)$,
              CONVERT=(CASE .COED OF
                SET
                  IF .CHAR NEQ #77 THEN .CHAR ELSE ! QUESTION MARK
                    (SCANNER();
                     IF INRANGE("A","_") THEN .CHAR-"A"+1 ELSE
                     IF .CHAR EQL "0"    THEN 0           ELSE
                     IF .CHAR EQL "1"    THEN #177        ELSE
                     IF .CHAR EQL #77    THEN #77         ELSE
                     (WARNEM(.NFUTSYM,ERSYIQC); .CHAR));
                  .CHAR+(IF NOT INRANGE(("A"+#40),("Z"+#40)) THEN #40);
                  IF INRANGE("0","9") THEN 1+.CHAR-"0" ELSE
                  IF INRANGE("A","Z") THEN #13+.CHAR-"A" ELSE
                  IF .CHAR EQL "." THEN #45 ELSE
                  IF .CHAR EQL #44 THEN #46 ELSE
                  IF .CHAR EQL #45 THEN #47 ELSE 0
                TES)$;

        PSTRING_STRING[-1]<1,BSIZE>;
        STRING_0;

        RV_INCR I FROM 0 TO NOCHAR DO    
          BEGIN
            IF .CHAR EQL .QUOTETYPE
              THEN (SCANNER();
                    IF .CHAR NEQ .QUOTETYPE THEN EXITLOOP (NOCHAR-.I);
		    IF .I EQL NOCHAR THEN CHAR_.CHAR+128);
            IF .I EQL NOCHAR THEN EXITLOOP (-1);
	    IF .CHAR EQL (.QUOTETYPE+128) THEN CHAR_.QUOTETYPE;
            REPLACEI(PSTRING,CONVERT);
            SCANNER()
          END;

        IF .QUOTETYPE NEQ "'" THEN
          STRING_.STRING^(-(SEVENBIT+(IF .RV LSS 0 THEN 0 ELSE BSIZE*.RV)));

        IF RAD50 THEN
          BEGIN
            REGISTER AC;
            AC_0;
            PSTRING_STRING[-1]<1,6>;
            INCR I FROM 1 TO 5 DO AC_(.AC+SCANI(PSTRING))*#50;
            STRING_.AC+SCANI(PSTRING)
          END;
        .RV EQL -1
      END;     ! ROUTINE PRWORD


    MACRO BL(A)='A' AND -2$,
          BS(N,A)='A' OR ((-1)^(-N*7) AND -2)$;

    BIND KEY= PLIT (
                    BL(ASCIZ),-2,
                    BL(ASCII),-2,
                    BL(SIXBI),BS(1,T),
                    BL(RADIX),BS(2,50));
    MAP STVEC REALFS;
    LOCAL SPEC;

    % SET UP CODE, SIZES, AND ZBIT. %

    SPEC_IF .REALFS NEQ 0 THEN
      (INCR I FROM 0 TO 3 DO
      IF .REALFS[2] EQL .KEY[2*.I] THEN
        IF .REALFS[3] EQL .KEY[2*.I+1] THEN EXITLOOP .I) ELSE -1;

    IF .SPEC GEQ 0 THEN CALLFORDEL_1 ELSE (SPEC_1; CALLFORDEL_0);
    COED_IF ZBIT_(.SPEC EQL 0) THEN 0 ELSE .SPEC-1;
    SIZES _ IF .COED EQL 0 THEN 7^18+5 ELSE 6^18+6;

    % PROCESS SHORT OR LONG STRINGS. %

    SPEC_0;
    IF (SPEC_PRWORD(.COED,.SIZES)) OR
       (.ZBIT AND ((.STRING AND #377) NEQ 0)) THEN
      BEGIN
        ACCUMLENGTH_0;
        FSTRHED_HEADER(0,0,0);
        DO CT[NEWBOT(.FSTRHED,1),1]_.STRING !NOTE: NORELOC=0(!)
          WHILE (IF .SPEC
                   THEN (SPEC_PRWORD(.COED,.SIZES); 1)
                   ELSE IF .ZBIT THEN 
                     IF (.STRING AND #377) NEQ 0 THEN (STRING_0; 1))
              AND
                (ACCUMLENGTH_.ACCUMLENGTH+1) LSS LONGESTPLIT;
        IF (FSTRHED<LEFTHALF>_.ACCUMLENGTH) GEQ LONGESTPLIT THEN
          (ERROR(.NFUTSYM,ERSYMRQ); PUNT(0));
        STRING_0
      END;
    VAL_.STRING;
    2+.CALLFORDEL
  END;       ! END CASE XXX=5.

%3.17% BEGIN		! XXX=6  (CONTINUE) SCAN FOR SPECIAL IDENTIFIER

%3.17%	   WHILE ((.TYPE LEQ 2) OR
%3.17%		(.CHAR EQL "%") OR (.CHAR EQL "$") OR (.CHAR EQL "."))
%3.17% %5.200.4%	DO (
%7C(223)%                       IF .CHAR GEQ "a" THEN 
%7C(223)%                           IF .CHAR LEQ "z"
%7C(223)%                          THEN CHAR = .CHAR - #40;	%9-19-77%
                             STORNCOUNT
                            );

%3.17% END;		! CASE XXX=6.

        TES
    END;
! PRINCIPAL LEXICAL PROCESSOR  
!------------------------------  





  GLOBAL ROUTINE IDFIXFS=
    BEGIN

    !  THIS ROUTINE IS CALLED TO FIX FUTSYM ONLY.  NO DEPENDENCY
    !  ON RUND IS REQUIRED EXCEPT THAT REALFS BE FILLED.  IT SHOULD
    !  BE CALLED AFTER ALL THE DECLARATIONS FOR A BLOCK HAVE BEEN
   !  MADE.

      MACRO WHEN(T,X)=IF T EQL .TYPE THEN (X; RETURN 1)$;
      LOCAL STVEC SYM, TYPE;

      IF (SYM_.REALFS) EQL 0 THEN RETURN 0;

      !MAKE REQUIRE FILE NAME AS UNDECLARED SYMBOL --- 4-22-77
      IF .DEL<LEFTHALF> EQL HREQUIRE THEN TYPE_1
       ELSE
      BEGIN
      WHILE ( TYPE_.SYM[0]<TYPEF>) EQL ABSOLUTET  OR (.TYPE EQL GABSOLUTET)
        DO IF .SYM[1]<LSF>
             THEN SYM_.SYM[1]<STEF>
             ELSE (FUTSYM_0;
                   FUTSYM<ADDRESSF>_.SYM[1]<ADDRESSF>;
                   RETURN 1)
       END;

      WHEN(LEXEMT, FUTSYM_.ST[.SYM[1]<ADDRESSF>,0]) ELSE

%	12-21-77 TREAT REGISTER TYPE AS LOCALS.
      WHEN(REGT, IF (NOT .INDECS OR .REGASSN )  THEN
          IF .TGRBLEVEL GEQ .SYM[0]<BLF> AND .FCNSTATE EQL 3
            THEN (ERROR(.NFUTSYM,#40); FUTSYM_0; REALFS_0)
            ELSE (FUTSYM_.SYM[1]<ADDRESSF>; FUTSYM<VEF>_1)) ELSE
%

%5.200.24%      IF (.TYPE GEQ UNDEDT AND .TYPE LEQ GPLITT) OR (.TYPE EQL STRT) OR (.TYPE EQL LINKAGET)
        OR (.TYPE EQL MACHT)  OR  (.TYPE EQL SPLFT)  OR  (.TYPE EQL SPUNOPT)
        THEN
          BEGIN
            FUTSYM_0;
            IF .SYM[0]<LSF> THEN (FUTSYM<LSF>_1; FUTSYM<POSNSIZEF>_36);
            FUTSYM<STEF>_.SYM;
            IF .TYPE EQL BINDT THEN FUTSYM<DOTF>_1;
            RETURN 1
            END;
      0
    END;
%3.1%	GLOBAL ROUTINE IDFIXER(COED,WRND1FLG)=
        BEGIN LOCAL L1,L2;
        !  THIS ROUTINE TAKES CARE OF SEARCHING FOR ID'S AND
	!  BUILDING THE APPROPRIATE LEXEME IN FUTSYM.

          L1_.ST[L2_SEARCH(),0]<TYPEF>;
	  IF .COED NEQ 0 THEN IF .L1 NEQ DELMT THEN REALFS_.L2;
          IF .L1 EQL DELMT
            THEN
              BEGIN  !   DELIMITER
                FUTDEL_.ST[.L2,1]; HOLD_0;
		RETURN
              END;
	  IF .COED EQL 0 THEN IF .L1 NEQ MACROT
            THEN
              BEGIN  !   ERROR, 2ND NAME NOT A DELIMITER
                FUTDEL_ERRLEX;
		RETURN
              END;
   %		9-13-77  ALLOW MACRO NAME IN REQUIRE FILE.
          IF .L1 EQL MACROT AND .DEL<LEFTHALF> EQL HREQUIRE THEN
                L1_1;   !6-6-77 REQUIRE FILE NAME CAN BE MACRO NAME
   %
          IF .L1 EQL MACROT
            THEN
              BEGIN  !  MACRO IDENTIFIER
                EXTERNAL EXPMCR;
		IF .COED NEQ 0 THEN REALFS_0; 
                EXPMCR(.L2);
                HOLD_0;
                IF .COED GEQ 0 THEN
		    IF .WRND1FLG
			THEN REDO=(IF .COED EQL 1 THEN 2 ELSE .COED)
			ELSE WRUND(IF .COED EQL 1 THEN 2 ELSE .COED);
		RETURN
              END;
          IF .COED NEQ 0 THEN
	          (IF IDFIXFS() THEN (IF .COED GEQ 0 THEN 
                               (HOLD_0; WRUND(0);
	!IF .FUTSYM IS A SPECIAL FUNCTION (SPLFT) OR A SPECIAL
	!UNARY OPERATOR (SPUNOPT) THEN .FUTDEL MUST BE AN OPEN
	!PAREN.  OTHERWISE WE HAVE A FATAL SYNTAX ERROR IN WHICH
	!CASE WE OUTPUT THE ERROR MESSAGE, ZERO FUTSYM, AND RETURN.

%7-JUN-77%    IF ((.L1 EQL SPLFT) AND (.ST[.L2,1] LSS 10)) OR .L1 EQL SPUNOPT
	  THEN IF .FUTDEL <LEFTHALF> NEQ HPAROPEN
		THEN (ERROR(.NCBUFF,ERRUNOP); FUTSYM_REALFS_0);
	);RETURN));
          ERROR(.NSYM,#776); IF .COED GEQ 0 THEN ( HOLD_0; WRUND(.COED));
        END;  
  ROUTINE WRUND1(COED)=
    BEGIN LOCAL L1,L2;
%5.200.31%	EXTERNAL XREFERASE;	!DEALS WITH HELD IDENTIFIERS; SEE SEARCH
      !
      !       RUND (READ-UNTIL-NEXT-DELIMITER) IS CALLED TO
      !       FILL "FUTSYM" AND "FUTDEL".  THE ROUTINE CALLS
      !       ITSELF RECURSIVELY IN THE EVENT THAT THE FIRST
      !       ATOM SCANNED IS NOT A DELIMITER.
      !
%     THE PARAMETER 'CODE' CAUSES THE FOLLOWING:
        =0  THEN FIND A DELIMITER FOR FUTDEL,
        =1  THEN MOVE WINDOW AND FIND A DELIMITER FOR FUTDEL AND
            POSSIBLY ALSO A SYMBOL FOR FUTSYM,
        =2  THEN LIKE 1 EXCEPT DON'T MOVE WINDOW.
%

    IF .COED THEN
      BEGIN
        IF .STRHED NEQ 0 THEN ERROR (.NSYM,ERSMLONG);
        STRHED_.FSTRHED; FSTRHED_0;
        DEL_.FUTDEL; SYM_.FUTSYM; FUTSYM_0; NSYM_.NFUTSYM; NDEL_.NFUTDEL;
        NFUTSYM_.NCBUFF; REALS_.REALFS; REALFS_0;
      END;
    NFUTDEL_.NCBUFF;
	!V2G- BECAUSE OF THE ROUGH HANDLING OF ACCUM ELSEWHERE IN
	!V2G- THE COMPILER, IT SEEMS ADVANTAGEOUS TO SAVE ITS CONTENTS
	!V2G- HERE SO THAT WE CAN RECOVER THEM SAFELY IN THE CASE OF
	!V2G- LEXICAL SCAN AFTER AN IMPLICIT MAP.  THIS FIXES A BUG
	!V2G- CAUSED BY THE CLOBBERING OF ACCUM DURING PLIT BUILDING.
	!V2G- THE CODE (IN TEST T026) 
	!V2G-		BIND A=PLIT(0,1,2),
	!V2G-		     VECTOR B=1;
	!V2G- RESULTED IN GENERATION OF A SPURIOUS ALREADY DEFINED
	!V2G- SYMBOL ERROR.
	  IF .HOLD EQL 0 THEN (HOLD_SKAN(#12); SACCUM_.ACCUM; SACCUM[1]_.ACCUM[1])	!V2G-
%5.200.31%		 ELSE (ACCUM_.SACCUM; ACCUM[1]_.SACCUM[1];XREFERASE_1);	!V2G-

    CASE .HOLD OF
      SET

        0;      !   ERROR, SKAN SHOULD NOT RETURN THIS VALUE

	IDFIXER(.COED,-1);	!CASE ONE, IDINTIFIER FOUND BY SKAN

        BEGIN    !  CASE TWO, LITERAL FOUND BY SKAN
          IF .COED GEQ 1
            THEN
              BEGIN  !  FIRST CALL, LITERALS ARE ACCEPTIBLE
                FUTSYM_LITLEXEME(.VAL);
                HOLD_0; WRUND(0);
              END
            ELSE
              BEGIN  !  2ND CALL, LITERALS ARE IN ERROR
                FUTDEL_ERRLEX;
              END;
        END;


        BEGIN   ! CASE 3, PREFIXED (ASCII,ASCIZ,SIXBIT,RADIX50) STRING
          REALFS_0; FUTSYM_LITLEXEME(.VAL);
          HOLD_0; WRUND(.COED);
        END;

        BEGIN   !   CASE FOUR, SPECIAL CHARACTER
          HOLD_0;
          IF (FUTDEL_.DT[.VAL]) EQL 0 THEN (ERROR(.NSYM,#776); WRUND(.COED))
        END;

      TES;
   %NOW IS OKAY TO FORGET ANY INUSEBITS ON MACROS THAT
    HAVE TERMINATED SINCE WE ENTERED WRUND.%
    IF .REDO GEQ 0 THEN RETURN;
   UNTIL (COED_.FORGET<LEFTF>) EQL 0 DO
     ((.COED)<INUSEBIT>_0;
      FORGET<LEFTF>_.(.COED)<LEFTF>;
      (.COED)<LEFTF>_0
     );
    END;
%SMLA-B%
%3.1%	GLOBAL  ROUTINE WRUND2 =
        BEGIN
!          EXTERNAL CSTIL;     ! LAST LEXEME STREAM POINTER

!          EXTERNAL CSTI;     ! CURRENT LEXEME STREAM (INPUT) POINTER
!          EXTERNAL INDECS;    ! WE ARE PROCESSING DECLARATIONS--USE DOTTED FORMAL
          LOCAL SIMPLE,       ! NO STRUCTURE FORMAL IN FUTSYM
                USERDOT,      ! USER HAS DOTTED THE SYMBOL IN FUTSYM
                CANADDRESS,  ! ABLE TO ADDRESS THE FORMAL AT THE CURRENT BLOCKLEVEL
                ISSTRNAME,    ! THE FORMAL IS THE STRUCTURE NAME (AND HENCE NOT
                              !   AVAILABLE AS AN INCARNATION ACTUAL EVEN UNDOTTED)
                PREVEMPTY,    ! PREVIOUS SYMBOL (SYM) WAS EMPTY
                OPENBFOLLOWS, ! OPEN BRACKET FOLLOWS THIS SYMBOL
                MUSTDOT;      ! WE MUST TURN DOTTED BIT OF LEXEME BEFORE COPY AND
                              !  POSSIBLE IN GENERATION.

          LOCAL NEWFUTSYM,    ! FUTURE SYMBOL FOR COPY
                OFFST,       ! PARAMETER OFFSET FOR LEXEME
                ROFFSET,      ! PARAMETER OFFSET FOR ACTUALS TABLE
                NEWIV,        ! VALUE OF WORD 0 OF LXT ENTRY
                DFORMAL,       ! DOTTEF FORMAL STE INDEX
                IFORMAL,      ! INCARNATION FORMAL STE INDEX
                TYPECODE;     ! CODE FOR FORMALS IN LEXEME TABLE

%5.200.21%	LABEL DOSTRFPT;
%5.200.21%	EXTERNAL TSBLEVEL;

          % ASSUME SIMPLE %
          SIMPLE _ 1;

          % SET BOOLEANS IF WE HAVE A SYMBOL AND THAT SYMBOL IS A STRUCTURE FORMAL %
          IF .FUTSYM<LSF> THEN
            (IF .ST[DFORMAL_.FUTSYM<STEF>,0]<TYPEF> EQL STRFPT THEN
%5.200.21%     DOSTRFPT:  (USERDOT_.DEL<LEFTHALF> EQL HDOT;
               CANADDRESS_CHKULA(.DFORMAL);
               ISSTRNAME_.ST[IFORMAL_.ST[.DFORMAL,0]<LINKF>,0]<TYPEF>
                           EQL STRT; %DIRTY CODE--DEPENDS ON ST STRUCTURE!!!%

%5.200.21%		IF (.ISSTRNAME AND NOT .USERDOT) OR (.TSBLEVEL NEQ .ST[.DFORMAL,0]<BLF>)
%5.200.21%		THEN  (	FUTSYM_ZERO;
%5.200.21%			REALFS_0;
%5.200.21%			SIMPLE_1;
%5.200.21%			ERROR(.NFUTSYM,IF .TSBLEVEL NEQ .ST[.DFORMAL,0]<BLF> THEN #431 ELSE #430);
%5.200.21%			LEAVE DOSTRFPT);

               PREVEMPTY_.LXT[.CSTI,2] EQL 0; %FIX THIS%
               OPENBFOLLOWS_.FUTDEL<LEFTHALF> EQL HSQOPEN;
               SIMPLE_0;

               % DETERMINE WHETHER CURRENT LEXEME IN FUTSYM NEEDS MODIFICATION,
                   EVEN IF WE ARE NOT COPYING THE LEXEME STREAM ANY MORE; WE MODIFY
                   IT BY TURNING ON THE DOT BIT OF THE INCARNATION FORMAL. %

                 IF MUSTDOT_ 1 - (.USERDOT OR
                                  .ISSTRNAME OR
                                  .OPENBFOLLOWS OR
                                  .INDECS)
                   THEN (FUTSYM<DOTF>_1; FUTSYM<LSF>_1;
                         FUTSYM<STEF>_.IFORMAL);)
% EXIT FROM DOSTRFPT %	);
          
          % IF NOT COPYING LEXEMES FOR THE STRUCTURE, LEAVE. %

          IF NOT .STRDEF THEN RETURN;

          NEWIV_-1; %WORD 0 OF LXT ENTRY IS NORMALLY -1 %
          % DETERMINE WHERE TO COPY THE LEXEMES AND THE VALUE OF NEWFUTSYM %

          IF .SIMPLE
            THEN (CSTIL_.CSTI;
                  LXT[.CSTIL,1]<NEXTF>_CSTI_GETSPACE(2);
                  NEWFUTSYM_IF.REALFS NEQ 0 THEN .REALFS+LSM ELSE .FUTSYM)            ELSE
              BEGIN

                % DETERMINE THE 2 BIT CODE INDICATING THE TYPE OF LEXEME FOR 
                    THE GENERATION:

                       00--NO MODIFICATION
                       01--TURN ON DOT BIT WHEN GENERATING (UNADDRESSABLE FORMALS)
                       10--USE ACTUAL AS PARAMETER
                       11--USE INCARNATION ACTUAL AS PARAMETER  %

                  NEWFUTSYM_0;
                  NEWFUTSYM<0,34>_
                    CASE
                      (NEWFUTSYM<34,2>_TYPECODE_
                         (IF .CANADDRESS
                            THEN (IF (.USERDOT OR .ISSTRNAME)
                                    THEN 2 ELSE 3)
                            ELSE .MUSTDOT))
                    OF
                      SET

                      (.DFORMAL+LSM);       !NORMAL FORMAL
                      (.IFORMAL+LSM);       ! DOTTED INCARNATION FORMAL
                      (OFFST_(-(#777777000000 OR .ST[.DFORMAL,1]<ADDRESSF>)); ! NEG STACK OFFSET FOR NORMAL FORMAL
                       IF .STRDEF<TACCESS> THEN
                          IF (ROFFSET_.ST[.STRDEF<LEFTHALF>,.STRDEF<NPF>+2-.OFFST]) EQL 0
                            THEN NEWIV_0
                            ELSE LXT[.ROFFSET,0]_.LXT[.ROFFSET,0]+1;
                         .OFFST);
                      -(#777777000000 OR .ST[.IFORMAL,1]<ADDRESSF>)  ! NEG OF STACK OFFSET FOR INC FORMAL

                      TES;

                  % DETERMINE WHETHER OR NOT TO GENERATE A NEW LEXEME TABLE ENTRY %
 
                  IF NOT .PREVEMPTY AND .USERDOT THEN TYPECODE_0;
                  IF .TYPECODE NEQ 2
                    THEN (CSTIL_.CSTI;
                          CSTI_LXT[.CSTI,1]<NEXTF>_GETSPACE(2));
             END;
          IF (LXT[.CSTI,0]_.NEWIV) GEQ 0 THEN
            ST[.STRDEF<LEFTHALF>,.STRDEF<NPF>+2-.OFFST]_.CSTI;

          LXT[.CSTI,1]_0;
          LXT[.CSTI,2]_.NEWFUTSYM;
          LXT[.CSTI,3]_.FUTDEL;
      END;
  ROUTINE WRUND3 =
      BEGIN

      %%
      %  CODE FOR LEXEME EXPANSION.  INSTEAD OF COPYING FROM THE INPUT STREAM, WE
       GRAB THE LEXEMES FROM THE CURRENT LEXEME STREAM, INDEXED BY CURSTE.  THE ONLY
       "ODD" OCCURRENCE WOULD BE INDICATED BY THE NEW FUTSYM<34,2> BEING NONZERO:
       IN PARTICULAR THE CODE BELOW HAVE THE INDICATED MEANING:

          1--MUST TURN ON THE "DOTTED" BIT BEFORE PASSING IT ON;
          2--THIS IS A STRUCTURE NORMAL FORMAL PARAMETER--SUBSTITUTE NORMAL ACTUAL LEXEME;
          3--THIS IS AN INCARNATION FORMAL PARAMETER--SUBSTITUTE INCARNATION ACTUAL VALUE.
      %
      %%

        SYM_.FUTSYM; DEL_.FUTDEL;
        NSYM_.NFUTSYM; NDEL_.NFUTDEL;
	REALS_.REALFS; REALFS_0;

        IF .CURSTE EQL 0
          THEN  %END OF LEXEME STREAM--RESTORE EXPANSION VARIABLES%

            BEGIN
              REGISTER L;;
              L_.SSTREX;
              SSTREX_.ST[.L,0];
              STREXP_.ST[.L,1];
              CURSTE_.ST[.L,2];
              CURSTAP_.ST[.L,3];
              CURSTIP_.ST[.L,4];
              CURSTNP_.ST[.L,5];

              IF .ST[.L,8]<LSF>
               THEN (REALFS_.ST[.L,8]<STEF>; IDFIXFS())
               ELSE (REALFS_0; FUTSYM_.ST[.L,8]);
              FUTDEL_.ST[.L,9];
              NFUTSYM_.ST[.L,10];
              NFUTDEL_.ST[.L,11];
    
              RELEASESPACE(.L,6);
              % WE JUST DID THE RUND ! %
            END
          ELSE
            BEGIN
            LOCAL SFUTSYM;

            MAP STVEC CURSTAP;

            % DECREASE OCCF. AND USE ON GT ENTRIES WHOSE USE IS UP
              BECAUSE THEY ARE DOTTED STRUCTURE FORMALS, BUT FOR
              WHICH NO CODE IS BEING GENERATED BECAUSE OF A CONSTANT
              IF OR CASE EXPRESSION.  IT IS IMPORTANT THAT CODETOG
              BE ACCURATE FOR THE SYMBOL IN "FUTSYM" (MOVING INTO SYM)!!!!!%

            IF (.MUSTDU NEQ 0) AND NOT .CODETOG
              THEN CURSTAP[.MUSTDU]_FOCGPH(.CURSTAP[.MUSTDU],-1);
            MUSTDU_0;
            % GENERATE A LEXEME PAIR INTO FUTSYM AND FUTDEL %

            
            REALFS_0;
            FUTSYM_.LXT[.CURSTE,2];
            FUTDEL_.LXT[.CURSTE,3];

            CASE .FUTSYM<34,2> OF
              SET
                IF .FUTSYM<LSF> THEN (REALFS_.FUTSYM<STEF>; IDFIXFS());
                FUTSYM_.FUTSYM<0,34>+DOTM;

                %%
                % FOR NEXT TWO, NOTE E.G.: STRUCTURE A[X,Y,Z,0]=...

                  ACTUALS:  OFFSET  REPRESENTS  FUTSYM<ADDRESSF>=-STACK OFFSET

                              0        .A         5
                              1        .X         4
                              2        .Y         3
                              3        .Z         2

                  INCARNATION ACTUALS:

                              0       ----       ---
                              1         X         8
                              2         Y         7
                              3         Z         6  
                %
                %%
    
                (FUTSYM_.ST[.CURSTAP,.CURSTNP+2-(SFUTSYM_.FUTSYM<ADDRESSF>)];
                IF NOT .STREXP<1,1> THEN
                  (MUSTDU_.CURSTNP+2-.SFUTSYM;
                 IF .LXT[.CURSTE,0] NEQ -1
                    THEN FUTSYM_CURSTAP[.MUSTDU]_
                     FOCGPH(.FUTSYM,.LXT[.CURSTE,0])););
                FUTSYM_.ST[.CURSTIP,(.CURSTNP^1)+3-.FUTSYM<ADDRESSF>];
              TES;
            CURSTE_.LXT[.CURSTE,1]<NEXTF>;
            END;
      END;   % END OF IF STATEMENT THAT IS WRUND3 %
GLOBAL ROUTINE WRUND(COED)=
BEGIN
    LOCAL RETVAL,OCOED;
    OCOED=.COED;
    DO
	BEGIN
	REDO=-1;
	RETVAL=(IF NOT .STREXP
	    THEN % NOT EXPANDING A STRUCTURE--BUT WE MAY BE DECLARING ONE %
		BEGIN
		WRUND1(.COED); %O L D   W R U N D  C A L L %
		IF .REDO LSS 0 THEN
		    IF .OCOED AND .STRDEF NEQ 0 THEN WRUND2();
		END
	    ELSE
		WRUND3());
	    COED=.REDO;
	    END
    WHILE .REDO GEQ 0;
    .RETVAL
END;
%3.1%	GLOBAL ROUTINE HRUND =
	BEGIN  
	!
	! THIS ROUTINE IS THE SYNTAX ANALYSERS INTERFACE TO THE
	! LEXICAL ANALYZER .. IN PARTICULAR, 'HRUND' CALLS 'WRUND'
	! AND THEN MAKES UNIQUE LEXEMES FOR SOME OF THE AMBIGUOUS
	! ONES. FOR EXAMPLE, 'DO' MAY BE USED IN THE CONTEXT
	!        	' WHILE  E  DO  E '
	! OR
	!		' DO  E  WHILE  E '
	!SIMILARLY AN OPEN-PAREN, '(', CAN BE USED AS A COMPOUND-
	! EXPRESSION OPENER -- OR AS A FUNCTION CALLER. 'HRUND'
	! SORTS ALL THIS TYPE OF STUFF OUT FROM MINIMAL CONTEXT.
	!
	WRUND(1);
        IF .FUTDEL<LEFTHALF> EQL HSESEMCOL
          THEN (SESTOG_.SESTOG OR 8; FUTDEL<LEFTHALF>_HSEMCOL; RETURN);
	IF .FUTSYM EQL HEMPTY AND
	   .DEL<LEFTHALF> NEQ HEND AND
	   .DEL<LEFTHALF> NEQ HPTCLO AND
	   .DEL<LEFTHALF> NEQ HROCLO AND
           .DEL<LEFTHALF> NEQ HTES AND
           .DEL<LEFTHALF> NEQ HTESN
	THEN BEGIN
	 IF .FUTDEL<LEFTHALF> EQL HPAROPEN
                THEN (FUTDEL_NSCOMPOUND<0,0>; FUTDEL<LEFTHALF>_HROPEN)
		ELSE IF .FUTDEL<LEFTHALF> EQL HMIN



                        AND .DEL<LEFTHALF> NEQ HSQCLO
		THEN (FUTDEL_NGNEG<0,0>;FUTDEL<LEFTHALF>_HNEG)
		ELSE IF .FUTDEL<LEFTHALF> EQL HPLUS



                        AND .DEL<LEFTHALF> NEQ HSQCLO
		THEN BEGIN LOCAL A,B;A_.SYM;B_.DEL;
			WRUND(1);SYM_.A;DEL_.B
		     END
	END
%V2H%	ELSE IF .FUTDEL<LEFTHALF> EQL HCOLON
%V2H%	  THEN 
%V2H%	    BEGIN
%V2H%	      IF .FUTSYM<LSF> THEN
%V2H%	      IF .ST[.FUTSYM<STEF>,0]<TYPEF> EQL LABELT	!WE HAVE A LABEL.
%V2H%	        THEN FUTDEL_HLABCOLON^18+SLABEL<0,0>;	!SO USE LABEL TYPE LEXEME.
%V2H%	    END
%V2H%	  ELSE
%V2H%		     IF .FUTDEL<LEFTHALF> EQL HWHILE OR
		.FUTDEL<LEFTHALF> EQL HUNTIL OR
		.FUTDEL<LEFTHALF> EQL HDOOPEN
	THEN (FUTDEL<HPRIORITY>_32; FUTDEL<24,1>_0)
	END;
%MERGE%  GLOBAL ROUTINE SRUND(FUNC)=
BEGIN	LOCAL	SVAL;

	SYM_ .FUTSYM;  DEL_ .FUTDEL;  VAL_ ACCUMLENGTH_ HOLD_ 0;

	PACCUM_ ACCUM<36,7>;  ACCUM_ ACCUM[1]_ -2;

	SKAN(.FUNC);  SACCUM_ .ACCUM;  SACCUM[1]_ .ACCUM[1];  SVAL_ .VAL;

	IF .ACCUMLENGTH EQL 0 THEN
		RETURN (FUTDEL_ .DT[.VAL];  FUTSYM_ 0;  1);	! SPECIAL CHARACTER

	HOLD_ SKAN(#12);			! GRAB DELIMETER

	WRUND1(0);  VAL_ .SVAL;			! AND FIX FUTDEL

	1
END;




!END OF LOLEXA.BLI