!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:	LOMACR.BLI
!DATE:		19 JULY 73	MGM/FLD

%3.13%	GLOBAL BIND LOMAV=3;	!MODULE VERSION NUMBER

! REVISION HISTORY::
!
  


%   MCSAV---

  COLLECT A STRING OF CHARACTERS INTO CHUNCKS IN CORE.
  A BLOCK OF 'NOBLKS' CELLS IS ACQUIRED. IT HOLDS ALL CHARS IN
  NORMAL FORMAT. THE LAST TWO CHAR POSITIONS + EXTRA BIT
  GIVE THE INDEX OF THE NEXT CELL OF CHARS.

%

%3.1%	GLOBAL ROUTINE MCSAV (A) =

BEGIN
   LOCAL T;
   REGISTER R;
   MACHOP IDPB=#136;
   IF .POSITC GEQ TOOBIG THEN
     (POSITC_1;
      T_(@BODYMC)<NEXTF> _ GETSPACE(NOBLKS);
      BODYMC _ (ST[.T,0]-1)<1,7>;
     );
   R_.A;
   IDPB(R,BODYMC);
   POSITC_.POSITC+1;

END;
!   ***** SECTION TWO *****
!         MACRO EXPANSION
!

GLOBAL ROUTINE EXPMCR (STI) =
	% CALLED ONLY FROM IDFIXER WHICH, HAVING
	  SEEN A MACRO NAME, WISHES TO REPLACE IT
	  WITH ITS EXPANSION. (LOLEXA). %


%WINDOW IN:  ( XXX , XXX , XXX , <NAME> )

   SETUP AN EXPANSION OF THE MACRO GIVEN AS PARAMETER.
   FIRST CHECK IF THIS MACRO IS ALREADY IN USE AS SHOWN
   BY <INUSEBIT> IN STENTRY. IF SO THEN TRACE BACK THE
   MACRO EXPANSION CHAIN AS A DIAGNOSTIC AND DON'T EXPAND
   THE MACRO. THE IDENTIFIER ITSELF IS DELETED.

   OTHERWISE CALLECT ACTUAL PARAMETERS IF REQUIRED AND SAVE
   AS STRINGS JUST LIKE THE BODY WITH RESPECTIVE STIS IN THE
   FORMAL BLOCK OF THE MACRO. NULL PARAMETERS, AND TOO FEW
   PARAMETERS ARE OKAY. EXTRA PARAMETERS ARE SCANNER FOR
   BALANCE JUST LIKE THE OTHERS, THEN IGNORED.
%

BEGIN
   LOCAL S,T,ST1,NFORMALS,I;

   ST1_ST[.STI,1]<0,0>;
   IF .(.ST1)<INUSEBIT> THEN
     (WARNEM(.NFUTDEL,#175);
      S_T_MCBUFF<0,0>;   !GIVE TRACEBACK OF MACRO NESTING
      OUTSTR("MACRO",5);OCHAR(" ");
      OUTSTN(.STI);
      UNTIL .S EQL 0 DO
        (OUTSTR(" CALL",5);OUTSTR("ED FR",5);OUTSTR("OM ",3);
         IF @.T EQL 0 THEN
           (OUTSTR("SOURC",5);OCHAR("E"))
         ELSE IF .(.T+1)<ACTUALF> EQL 0 THEN
            OUTSTN(.(.T+1)<NAMEF>)
         ELSE
           (OUTSTR("PARAM",5);OUTSTR(" #",2);
            OUTMOC(.(.T+1)<ACTUALF>)
           )
         ;
         T_ST[S_.(.T+1)<NEXTF>,0]<0,0>
        );
      OCHAR(".");
      NEWLINE();
      RETURN
     )
   ELSE (.ST1)<INUSEBIT>_1;
   FBLKMC_ST[.(.ST1)<NEXTF>,0]<0,0>;   !THIS IS AN ADDRESS - NOT AN INDEX!
   NFORMALS_.(.FBLKMC)<LEFTF>;   !NUMBER OF FORMAL PARAMETERS

   IF .NFORMALS NEQ 0 THEN
%2.20%     (INCR J FROM .FBLKMC<RIGHTF>+1 TO .FBLKMC<RIGHTF>+.NFORMALS DO (.J)<0,36>_0;
      SKAN(#2);
      IF .CHAR NEQ "(" THEN  WARNEM(.NFUTSYM,#177)
			ELSE ( SCANNER();
			      I_1;
			      DO(
			         T_GETACTUAL(S_.I LEQ .NFORMALS);
			         IF .S THEN (.FBLKMC+.I)<WORDF>_.T;
			         I_.I+1
			        )
			      UNTIL (T_.CHAR EQL ")";SCANNER();.T);
		     ));
   PUSHEXP( .FBLKMC,TOOBIG,.STI,0,.CHAR,.FBLKMC) ;
   SCANNER();

END;

%   GETACTUAL---

   SETUP TO COLLECT A STRING.
   COUNT LEFT AND RIGHT PARENS TO ENFORCE BALANCE.

%

%3.1%	GLOBAL ROUTINE GETACTUAL(KEEP) =

  % COLLECT UP TO THE NEXT COMMA OR RIGHT DELIMITER IN
    THE CONTEXT OF MATCHED LEFT AND RIGHT BRACKETS: "()",
    "[]", OR "<>". %


% FIXED (5.200.5) TO ERASE COMMENTS APPEARING IN ACTUALS%
  BEGIN
    LOCAL STKP,STACK[30],STACKP[30];
    MACRO BALANCED=(.STKP EQL 0)$,
          PUSHSTK(CODE,POS)=(STKP_.STKP+1; STACKP[.STKP]_POS;
                             STACK[.STKP]_CODE)$,
          POPSTK=(STKP_.STKP-1)$,
          TOPCODE=.STACK[.STKP]$,
          TOPPOS=.STACKP[.STKP]$;
    LOCAL WHICH, TRUE;

    IF .KEEP THEN
      (BODYMC_STEMC<0,0>; ! USED ONLY AS A TEMPORARY
       POSITC_TOOBIG);

    STKP_0;

    TRUE_1;
    WHILE .TRUE DO
      (CASE (WHICH_SELECT .CHAR OF
                         NSET
                           "," : 0;
                           "(" : 1^18+0;
                           "[" : 1^18+1;
                           "<" : 1^18+2;
                           ")" : 2^18+0;
                           "]" : 2^18+1;
                           ">" : 2^18+2;
%3.13%			   "'" : 3^18+0;
%3.13%	    %DBL QUOTE%    #42 : 3^18+0;
%5.200.5%		   "%" : 4^18+0;
%5.200.5%		   "!" : 5^18+0
                         TESN)^(-18)
        OF
          SET

            !  COMMA FOUND--IF BALANCED, EXIT WITH STE INDEX OF STRING
            IF BALANCED THEN EXITLOOP;

            !  LEFT DELIMITER FOUND--STACK IT
            PUSHSTK(.WHICH<RIGHTHALF>,.NCBUFF);

            !  RIGHT DELIMITER FOUND--IF BALANCED EXIT, OTHERWISE CHECK
            !  THE MATCHING LEFT AT TOP OF STACK.
            (IF BALANCED THEN EXITLOOP;
             IF .WHICH<RIGHTHALF> EQL TOPCODE
               THEN POPSTK
               ELSE (ERROR(TOPPOS,ERSYUNMTCH); ERROR(.NCBUFF,ERSYUNMTCH); EXITLOOP));

%3.13%	   ! SOME FORM OF QUOTE SEEN -- COPY UNTIL CLOSING QUOTE SEEN
%3.13%	      (WHICH_.CHAR;
%3.13%	       DO (IF .KEEP THEN MCSAV(.CHAR)) UNTIL (SCANNER(); .CHAR EQL .WHICH));

%5.200.5%	! ERASE COMMENT BEGINNING WITH "%"

		(IF .KEEP THEN MCSAV(.CHAR);
		DO 0  UNTIL ( SCANNER(); .CHAR EQL "%"));

%5.200.5%	! ERASE COMMENT BEGINNING WITH "!"

		DO 0  UNTIL ( SCANNER(); .CHAR EQL EOL);

          TES;

       IF .KEEP THEN MCSAV(.CHAR);
       SCANNER());  % END OF DO %

    IF .KEEP THEN MCSAV(TERMINATOR);
    .STEMC
  END;


%   PUSHEXP---
   PUSH A NEW MACRO ON THE EXPANSION STACK.
   PARAMETERS ARE:
      PTR - STINDEX FOR NEW CHAR STRING FOR EXPANSION
            (MAY BE BODY OR ACTUAL)
      COUNT - INITIAL COUNT IN ABOVE STRING (NOW ALWAYS "TOOBIG")
      NAME  - STINDEX OF THE NAME OF THIS MACRO
      NPAR  - ACTUAL PARAMETER NUMBER (0 IMPLIES THE BODY ITSELF)
      CCHAR - NEXT CHAR VALUE FROM CURRENT EXPANSION TO BE SAVED
      FBLK  - ADDRESS OF THE FORMAL BLOCK OF THIS MACRO EXPANSION

%

%3.1%	GLOBAL ROUTINE PUSHEXP(PTR,COUNT,NAME,NPAR,CCHAR,FBLK) =

BEGIN
   REGISTER T,S;

   IF .EMFLG THEN
     (FORCELINE(0);
      NEWLINE();
      IF .NPAR EQL 0 THEN
        (OUTSTR("CALL ",5);OUTSTN(.NAME);OCHAR(":"))
      ELSE
        (OUTSTR("ACTUA",5);OUTSTR("L #",3);OUTMOC(.NPAR);OCHAR(":")
        );
     );
   T_ST[S_GETSPACE(2),0]<0,0>;
   (.T)<0,36>_.MCBUFF;
   (@T+1)<WORDF>_.(MCBUFF+1);
   (@T+2)<POSITF>_.POSIT;
   (@T+2)<CHARF>_.CCHAR;
   (@T+3)<WORDF>_.(MCBUFF+2);

   MCBUFF_.PTR;
   (MCBUFF+1)<NEXTF>_@S;
   (MCBUFF+1)<NAMEF>_.NAME;
   (MCBUFF+1)<ACTUALF>_.NPAR;
   (MCBUFF+2)<WORDF>_.FBLK;
   POSIT_.COUNT;

   IF .PTR EQL 0 THEN POPEXP();   !TEST FOR NULL ACTUAL PARAMETER

END;

%   POPEXP---

%

%3.1%	GLOBAL ROUTINE POPEXP =

BEGIN
   LOCAL T,S,U;

   T_ST[S_.(MCBUFF+1)<NEXTF>,0];
   IF .(MCBUFF+1)<ACTUALF> EQL 0 THEN
     (%WE HAVE FINISHED A MACRO EXPANSION - TIME
       TO RELEASE THE ACTUAL PARAMETER STRINGS
      %
      IF (U_.(.(MCBUFF+2))<LEFTF>) GEQ 1 THEN
         INCR J FROM .(MCBUFF+2)<0,36>+1 TO .(MCBUFF+2)<0,36>+.U DO
           PRGSTR(@.J);
      %RECORD THAT THIS STENTRY IS TO BE UNMARKED INUSE%
      U_ST[.(MCBUFF+1)<NAMEF>,1]<0,0>;
      IF .FORGET<LEFTF> NEQ 0 THEN (.U)<LEFTF>_.FORGET<LEFTF>;
      FORGET<LEFTF>_.U;

	% FORGETTING MEANS THAT ALTHOUGH ALL OF THE CHARACTERS
	  FROM THE MACRO BODY, OR SPRINGING FROM IT VIA ITS
	  ACTUALS OR FROM EXPANSIONS OF MACROS APPEARING IN
	  ITS BODY OR ITS ACTUALS, ETC., HAVE BEEN SCANNED,

	  IT IS NOT SAFE TO TURN OFF THE INUSEBIT, THE FEAR
	  BEING THAT THE MACRO NAME ITSELF MAY HAVE BEEN SCANNED
	  FROM WITHIN ITSELF.

	  WHEN MAY INUSEBIT BE TURNED OFF SAFELY? THE CHANGE OF
	  5.200.7 ASSERTS THAT IT IS AS SOON AS A CHARACTER HAS
	  BEEN SCANNED AND PLACED IN ACCUM IN THE ACCUMULATION OF
	  AN IDENTIFIER; FOR SUCH A CHARACTER MUST HAVE COME FROM
	  "BELOW"  ANY MACRO WHICH IS IN THE FORGET LIST. %

     );
   MCBUFF_@@T;
   (MCBUFF+1)<WORDF>_@(@T+1);
   POSIT_.(@T+2)<POSITF>;
   CHAR_.(@T+2)<CHARF>;
   (MCBUFF+2)<WORDF>_@(.T+3);

   RELEASESPACE(.S,2);

   IF .EMFLG THEN
     (NEWLINE();
      OUTSTR("RETUR",5);OUTSTR("N TO ",5);
      IF (T_.(MCBUFF+1)<NAMEF>) EQL 0
      THEN (OUTSTR("SOURC",5);OUTSTR("E.",2);NEWLINE())
      ELSE (OUTSTN(.T);OCHAR(":"));
     );


END;

%     PRGSTR---

 RELEASE A BODY TYPE STRING FROM CORE.
 USED WITH BOTH THE BODY AND THE ACTUAL PARAMETERS
 OF A MACRO CALL.
%
GLOBAL ROUTINE PRGSTR(T) =

BEGIN
   LOCAL S;
   UNTIL .T EQL 0 DO
     (S_.ST[.T,2*NOBLKS-1]<NEXTF>;
      RELEASESPACE(.T,NOBLKS);
      T_.S
     );

END;

%     DUMPMACRO---

 ROUTINE TO DELETE THE DEFINITION OF A MACRO.
 CALLED ONLY BY BLOCKPURGE.

   NOTE: IF MACRO IS CURRENTLY EXPANDING THIS
   DEFINITION THEN IT IS NOT PURGED BUT SIMPLY ALLOWED
   TO BE DISCONNECTED FROM THE SYMBOL TABLE. IT TERMINATES
   EXPANSION NORMALLY AND THEN IS EFFECTIVELY GONE.
   THE SPACE IS NEVER RECOVERD.

%

GLOBAL ROUTINE DUMPMACRO (STI) =

BEGIN
   LOCAL FORMAL,NAME,T;
   %CHECK THAT NAME NOT ON MACRO EXPANSION LIST%
   T_ST[.STI,1];
   IF .(.T)<INUSEBIT> THEN
     (WARNEM(.NDEL,#176);
      OUTSTR("MACRO",5);OUTSTR(": ",2);
      OUTSTN(.STI);
      NEWLINE();
      RETURN
     );
   %GOT HERE THEN DELETE DEFINITION%
   FORMAL_.ST[.STI,1]<NEXTF>;
   PRGSTR(.(T_ST[.FORMAL,0])<NEXTF>); !DELETE THE BODY
   RELEASESPACE(.STI,2);   !NOW THE STENTRY ITSELF
   RELEASESPACE(.FORMAL,.(.T)<LEFTF>/2+1); !AND THE FORMAL BLOCK
END;
!**********************SECTION 3****************************

%     SCANNER---

%

FORWARD SCAN2;

GLOBAL ROUTINE SCANNER =

BEGIN
   REGISTER R;
   MACHOP ILDB=#134;

   IF .MCBUFF NEQ 0 THEN %READING FROM MACRO TEXT%
     (SCAN2();
      IF .EMFLG AND (.MCBUFF NEQ 0) THEN
         IF .CHAR EQL EOL THEN NEWLINE() ELSE OCHAR(.CHAR)
     )
   ELSE  %READING FROM SOURCE%
     (IF .CHAR EQL EOL THEN READALINE();
      CHAR _ ILDB(R,PBUFF);
      NCBUFF _ .NCBUFF + (IF .CHAR EQL #11 %TAB% THEN 8 ELSE 1);
     );
   TYPE _ .TYPETAB[.CHAR]

END;

ROUTINE SCAN2 =

%DO THE ACTUAL PROCESSING OF MACRO TEXT%

BEGIN
   REGISTER R;
   MACHOP ILDB=#134;
   IF .POSIT GEQ TOOBIG THEN
     (POSIT _ 1;
      MCBUFF _ (ST[.(.MCBUFF)<NEXTF>,0]-1)<1,7>
     );
   POSIT _ .POSIT + 1;
   CHAR _ ILDB(R,MCBUFF);
   WHILE .CHAR EQL TERMINATOR DO POPEXP();
   IF .CHAR EQL #176 THEN !INVOKE ACTUAL ACTUAL PARAMETER
%2.20%	BEGIN
%2.20%	  !IF WE HAVE A NULL PARAMETER, IGNORE IT
%2.20%	  !BY SUBSTITUTING THE NULL STRING IN THE MACRO WHERE
%2.20%	  !THE ACTUAL PARAMETER WOULD HAVE GONE.
%2.20%	  SCAN2();	!TO GET THE PARAMETER NUMBER
%2.20%	  IF @(.(MCBUFF + 2) +.CHAR) EQL 0 !WE HAVE A NULL ACTUAL
%2.20%		THEN SCAN2()	!SIMPLY RETURN NEXT CHAR OF MACRO BODY
%2.20%		ELSE	!PROCESS THE NON-NULL ACTUAL PARAMETER STRING
%2.20%     (PUSHEXP(.(MCBUFF+2)+.CHAR,
              TOOBIG,
              .(MCBUFF+1)<NAMEF>,
              .CHAR,
              0,
              .(MCBUFF+2)
             );
      SCAN2()
     );
%2.25%	END;
   IF .CHAR EQL 0 THEN SCAN2();

END;

!END OF LOMACR.BLI