Google
 

Trailing-Edge - PDP-10 Archives - BB-5255D-BM - language-sources/ma1n.bli
There are 18 other files named ma1n.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:	H1MACR.BLI
!DATE:		22 JUNE 73	MGM/FLD

! REVISION HISTORY::
!  1-17-78 ROUTINE BODY IS MODIFIED SO THAT '.' IS CARRIED INSIDE
!	    MACRO BODY AS IT IS IF '?' NAME TYPE.IE.
!	    MACRO XX=?X.Y $; 
!
!  12-21-77 ROUTINE BODY IS MODIFIED TO ALLOW SPECIAL NAMES WITH 
!	    ? MARK IN FRONT AS NAMES IN MACRO BODY. THESE NAMES CAN HAVE
!	    $,.,% ARE PART OF NAMES. EX: MACRO X=?A$$B%%Y $;
!
!  9-19-77  ROUTINE BODY IS MODIFIED TO FIX BUGS#38,NEW FEATURES
!           ADDED TO 7C(223).
!
%3.2%	GLOBAL BIND H1MAV=2;	!MODULE VERSION NUMBER





%               MACRO SOURCE FILE FOR BLISS-10/11
               -------------------------------------


  THIS IMPLEMENTS THE SIMPLE MACROS AS SPECIFIED IN THE BLISS-10
  AND BLISS-11 DESCRIPTIONS.

  GLOBAL VARIABLES INTRODUCED BY THIS MODULE ARE:

     MCBUFF(3) - TOP OF PUSHDOWN OF MACRO EXPANSIONS (3 WORDS)
     STEMC     - SYMBOL TABLE INDEX OF CURRENT MACRO
     FBLKMC    - POINTER TO FORMAL BLOCK FOR CURRENT MACRO
     BODYMC    - POINTER TO CURRENT POSITION IN BODY OF CURRENT MACRO
     POSIT     - COUNTER IN CURRENT CELL OF CURRENT MACRO BODY
     FORGET    - POINTER TO STENTRY FOR MACRO INUSEBIT CLEARING

%

  BIND EOL=#15;

    FORWARD SSMACRO, GETFORMALS, BODY, ISFORMAL;
GLOBAL ROUTINE SMACRO =

%WINDOW IN:  ( XXX , "MACRO" , <NAME> , XXX )
 WINDOW OUT: ( XXX , ";" , XXX , XXX )
%
BEGIN
%5.200.37%	EXTERNAL EOLCONTEXT;LOCAL OLDCONTEXT;
%5.200.37%	OLDCONTEXT_.EOLCONTEXT;EOLCONTEXT_"M";
   DO SSMACRO() WHILE .FUTDEL<LEFTF> EQL HCOMMA;
   IF .FUTDEL<LEFTF> NEQ HSEMCOL THEN
      ERROR(.NFUTDEL,#100);
%5.200.37%	EOLCONTEXT_.OLDCONTEXT;
%5.200.20%   HRUND()		! WAS WRUND(1)
END;

% SSMACRO PROCESSES EACH MACRO IN THE LIST.
  THE MACRO NAME, IF LEGAL, IS DECLARED AT THE CURRENT BLOCKLEVEL.
  THEN THE LEVEL IS BUMPED AND THE FORMALS COLLECTED.
  NEXT THE BODY IS COLLECTED AS A CHARACTER STRING WITH THE
  FORMAL PARAMETERS REPLACED BY A SPECIAL CHARACTER PAIR (#176
  SAYS A FORMAL FOLLOWS, AND THE NEXT GIVES THE FORMAL NUMBER).
  AT MOST 31 FORMAL PARAMETERS ARE ALLOWED.

 WINDOW IN:  ( XXX , "MACRO" , <NAME> , XXX )
     OR      ( XXX , XXX , XXX , "," )
 WINDOW OUT: ( XXX , XXX , XXX , "," OR ";" )
%

ROUTINE SSMACRO =

BEGIN
   LOCAL T;
%2.15%   IF .MCBUFF NEQ 0 THEN
%2.15%		BEGIN
%2.15%		  WARNEM(.NDEL,#174);
%2.15%		  UNTIL .CHAR EQL "$" DO SKAN(#10);
%2.15%		  WRUND(1);
%2.15%		  RETURN
%2.15%		END;
   IF .FUTDEL<LEFTF> EQL HCOMMA THEN WRUND(1);
   IF NOT DECSYN(STEMC,MACROT) THEN RETURN;
   BLOCKLEVEL_.BLOCKLEVEL+1;
   GETFORMALS();
   ST[.STEMC,1]<NEXTF> _ .FBLKMC;
   BODYMC<0,18>_ST[.FBLKMC,0]; !INITIALIZE TO COLLECT BODY
   POSITC_TOOBIG;  !READY TO OVERFLOW
   BODY();

   BLOCKLEVEL_.BLOCKLEVEL-1;
   BLOCKPURGE(.BLOCKLEVEL)

END;
%     GETFORMALS---

  COLLECT THE FORMAL PARAMETERS AND SET UP THE FORMAL
  BLOCK FOR THIS MACRO. THIS BLOCK CONSISTS OF:
     WORD 0:   LEFT - NUMBER OF FORMALS: N
               RIGHT - INDEX OF BODY STRING
     WORD 1 THRU WORD N:
               SYMBOL TABLE INDEX FOR RESPECTIVE FORMAL ID

  (THE FORMAL BLOCK WILL BE USED DIFFERENTLY AT MACRO EXPANSION TIME.)

 WINDOW IN:  ( XXX , XXX , XXX , "(" OR "=" )
 WINDOW OUT: ( XXX , XXX , XXX , "=" )
%

ROUTINE GETFORMALS =

BEGIN
   LOCAL SAVE[32],T,S;

   T_0;
   IF .FUTDEL<LEFTF> EQL HPAROPEN THEN
      (DO(WRUND(1);
         IF (.FUTDEL<LEFTF> EQL HCOMMA OR .FUTDEL<LEFTF> EQL HROCLO) AND .REALFS NEQ 0
             AND .T LSS 31 THEN
           (T_.T+1;
            SAVE[.T]_.REALFS
           )
         ELSE
           (ERROR(.NFUTSYM,#173); RETURN )
        )
      WHILE .FUTDEL<LEFTF> EQL HCOMMA;
      IF .T GTR 31 THEN WARNEM(.NFUTDEL,#172);
      IF .FUTDEL<LEFTF> NEQ HROCLO THEN ERROR(.NFUTDEL,#76);
      WRUND(0)
     );
   BEGIN
     BIND VECTOR THEACTS=ST[FBLKMC_GETSPACE(1+.T^(-1)),0];;
     THEACTS[0]<LEFTF>_.T;
     INCR I FROM 1 TO .T DO THEACTS[.I]_.SAVE[.I];
   END;

END;
%   BODY---

  COLLECT THE BODY OF THE ROUTINE.
  THE INPUT CHAR STREAM IS COPIED UNTIL AN INITIAL LETTER
  IS DETECTED. AN ATOM IS COLLECTED AND COMPARED WITH
  THE FORMALS. IF A FORMAL, THEN THE CHAR PAIR (#176,#NUMBER)
  GOES INTO THE BODY. ELSE THE IDENTIFIER ITSELF GOES INTO THE
  BODY. THE FIRST DOLLAR SIGN TERMINATES THE DEFINITION.

 WINDOW IN:  ( XXX , XXX , XXX , "=" )
 WINDOW OUT: ( XXX , XXX , XXX , "," OR ";" )
%

ROUTINE BODY =

BEGIN
	LOCAL ESCAPE;		%1-17-78%
   LOCAL T; MACHOP ILDB=#134;
	%5.200.6% GLOBAL QUOTESEEN;		! M205.1
   REGISTER R;
	%5.200.6% QUOTESEEN_0;		!WE BEGIN OUTSIDE A QUOTED STRING
   IF .FUTDEL<LEFTF> NEQ HEQL  THEN
      (ERROR(.NFUTDEL,#75);
      MCSAV(TERMINATOR);   !PROVIDE VALID BODY STRING
      RETURN);
	ESCAPE=0;		%1-17-78%
WHILE 1 DO           %9-19-77%
BEGIN                %9-19-77%
   UNTIL .CHAR EQL "$" DO
    BEGIN
      IF ((.TYPE EQL 2) OR ((.TYPE EQL 8) AND (.QUOTESEEN EQL 0))) THEN	%12-21-77%
	  BEGIN
!	1-17-1978
%DEC-21-77%	IF .TYPE EQL #10 THEN (ESCAPE=1; MCSAV(.CHAR)); ! COPY ESCAPE CHAR FOR SPECIAL IDENTIFIER
	     SKAN(#10);  !GET AN ATOM
	     IF (T_ISFORMAL()) NEQ 0 THEN
	        (MCSAV(#176);
	        MCSAV(.T))
	     ELSE !NOT A FORMAL SO COPY THE CHARACTERS
	       ( T_(ACCUM-1)<1,7>;
	        INCR I FROM 1 TO .ACCUMLENGTH DO
		    BEGIN
		    REGISTER CHR;
		    CHR=ILDB(R,T);
		    IF .CHR EQL "." AND NOT .ESCAPE	%1-17-78%
		    THEN
			MCSAV("&")
		    ELSE
			MCSAV(.CHR);
		    END);
		ESCAPE=0;			%1-17-78%
	  END

%5.200.6%	ELSE IF .TYPE EQL 3
			THEN ( IF .QUOTESEEN EQL 0 THEN QUOTESEEN_.CHAR
				ELSE IF .QUOTESEEN EQL .CHAR THEN QUOTESEEN _ 0;
				MCSAV(.CHAR);SCANNER()
				)
		ELSE IF .CHAR EQL "%" THEN					! XXXXXXX  XXXXX
		    IF .QUOTESEEN EQL 0
			THEN BEGIN
			    DO SCANNER()
				UNTIL .CHAR EQL "%" ;	%9-19-77%
			    IF .CHAR NEQ "$" THEN SCANNER();
			    END
			ELSE (MCSAV(.CHAR); SCANNER())
		ELSE IF .CHAR EQL "!" THEN
		    IF .QUOTESEEN EQL 0
			THEN BEGIN
			    SCANNER();
			    IF .CHAR EQL "!"
				THEN BEGIN
				    DO (MCSAV(.CHAR); SCANNER())
					UNTIL .CHAR EQL "$" OR .CHAR EQL EOL;
				    IF .CHAR NEQ "$" THEN
					(MCSAV(.CHAR); SCANNER());
				    END
				ELSE IF .CHAR NEQ "$" THEN BEGIN
				    UNTIL .CHAR EQL "$" OR .CHAR EQL EOL DO
					SCANNER();
				    IF .CHAR NEQ "$" THEN SCANNER();
				    END
			    END
			ELSE (MCSAV(.CHAR); SCANNER())
%5.200.6%

      ELSE
	  (MCSAV(.CHAR);
	  SCANNER())
   END;
  SCANNER();				%9-19-77%
  IF .CHAR NEQ "$" THEN EXITLOOP;   %9-19-77%
  MCSAV(.CHAR);    			%9-19-77%
  SCANNER()        			%9-19-77%
  
END;
   MCSAV(TERMINATOR);   !TERMINATES THE STRING
   WRUND(1);   !GET , OR ; INTO FUTDEL
    QUOTESEEN=0;
    .VREG

END;
%   ISFORMAL---

  LOOK TO SEE IF CURRENT ATOM IN ACCUM IS A FORMAL.
  IF NOT RETURN 0, ELSE RETURN THE NUMBER OF THE 
  FORMAL.
%

ROUTINE ISFORMAL =

BEGIN
   LOCAL S,T;REGISTER R;

   IF (T_.(R_ST[.FBLKMC,0]<0,0>)<LEFTF>) NEQ 0 THEN
     INCR I FROM 1 TO .T DO
      (S_ST[.(.R+.I)<NEXTF>,0];
       IF .ACCUM EQL @(.S+2) THEN
         IF .(ACCUM+1) EQL @(.S+3) THEN RETURN .I;
      );

END;


!END OF H1MACR.BLI