Trailing-Edge
-
PDP-10 Archives
-
BB-D868C-BM
-
language-sources/ma0n.bli
There are 18 other files named ma0n.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: 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