Trailing-Edge
-
PDP-10 Archives
-
BB-D868D-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