Trailing-Edge
-
PDP-10 Archives
-
BB-J713A-BM
-
language-sources/de3n.bli
There are 18 other files named de3n.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: H3DECL.BLI
!DATE: 22 JUNE 73 MGM/FLD
%3.2% GLOBAL BIND H3DEV=1; !MODULE VERSION NUMBER
! REVISION HISTORY:
! 9-27-77 ROUTINE RFS IS MODIFIED TO FIX BUG#48. NESTED
! ROUTINES WITH INCR OR DECR LOOP EXPRESSIONS.IT USES
! GLOBAL VARIABLE REGTEMP DEFINED IN H2REGI.BLI AND
! ARGUMENT PASSED FROM DECSIMPLE TO IDENTIFY IT
! THAT WE ARE IN A ROUTINE.
!
%%
% 5. "RFS" DOES THE DIRTY WORK OF R/F/S DECLARATION. IT
EXISTS MERELY BECAUSE A LARGE NUMBER OF GPVS MUST BE
PUSHED AND MANY THINGS DONE IN THE NEW CONTEXT.
A. WHEN ENTERED, THE WINDOW STILL HAS NOT CHANGED FROM
THE SYNTAX ROUTINE CALL:
(XXX,"SROUTINE",<ROUTINE NAME>,"(")
B. AFTER PUSHING THE REGISTER AND LEVEL GPVS, WE MUST
UPDATE THE BLOCKLEVEL AND FUNCTIONLEVEL
C. WE THEN PROCESS THE FORMAL PARAMETER LIST IN THE NEW
CONTEXT.
D. THEN WE PUSH THE R/F/S ONTO THE FUNCTION LIST (FCNLIST)
IF IT WAS NOT DECLARED FORWARD.
E. WE THEN PROCESS THE BODY OF THE FUNCTION.
F. AFTER THE EXPRESSION GENERATOR RETURNS, WE ERASE THE CODE
IF WE WERE IN A STRUCTURE DECLARATION AND THE LEXEME
SCAN WAS NOT TURNED OFF (.STRDEF=3) AND SET THE BIT
AND LEXEME STRING ADDRESS IN THE ADD'L INF. WORD.
G. OTHERWISE, WE FIX UP THE CODE FOR THE BODY AND CALL THE
LOADER INTERFACE ROUTINE.
H. WE THEN DECREMENT THE BLOCK AND FUNCTION LEVELS
AND CALL BLOCKPURGE BEFORE LEAVING.
I. WINDOW OUT: (XXX,";",XXX,XXX).
J. PARAMETERS:
I. STE OF R/F/S NAME;
II. STRUCTURE BOOLEAN;
%
%%
FORWARD FPARMLIST, SPARMLIST;
GLOBAL ROUTINE RFS(RFSTE,RFSTRB,RFISGLO,ROUFLAG) =
BEGIN
LOCAL LOCGPV[9], SAVCON, NF;
EXTERNAL REGTEMP; LOCAL SAVTEMP; %9-27-77%
%5.200.21% GLOBAL TSBLEVEL; !LEVEL OF STRUCTURE PARAMS
SAVTEMP=.REGTEMP; %9-27-77%
LOCGPV=.REGUSE AND .SVREGM; REGUSE_0;
PUSHGPV(1,CODEPTR);
%5.200.21% PUSHGPV(8,TSBLEVEL);
REGINIT(.RFISGLO);
IF .FCNSTATE EQL 2
THEN (FUNCTIONLEVEL_.FUNCTIONLEVEL+1;
NEEDDISP_1)
ELSE (PUSHGPV(5,TRBLEVEL)_.BLOCKLEVEL;
PUSHGPV(3,FUNCTIONLEVEL)_0;
PUSHGPV(6,NEEDDISP)_0);
IF .RFISGLO THEN PUSHGPV(7,TGRBLEVEL)_.BLOCKLEVEL;
PUSHGPV(2,NEXTLOCAL)_SAVCON_2+.NOSVR+.FUNCTIONLEVEL;
PUSHGPV(4,MAXLOCAL)_.NEXTLOCAL;
% MUST FOLLOW POSSIBLE PUSH %
BLOCKLEVEL_.BLOCKLEVEL+1;
BEGIN
LOCAL LLL,LLN,L1,L2,L3;
% CODE CELL HEADER CODE NUMBERS %
% ENTER STRUCTURE NAME IN THE SYMBOL TABLE AS A FORMAL %
IF .RFSTRB THEN L3_DECSYQ(.RFSTE,STRFPT,0);
HRUND(); ! WINDOW: (<ROUTINE NAME>,"(",<FP 1>,",")
% PROCESS FORMALS FOR APPROPRIATE TYPE %
IF (IF .RFSTRB
THEN SPARMLIST(.RFSTE,.L3)
ELSE FPARMLIST(.RFSTE))
THEN EXITBLOCK;
% WINDOW: (<EMPTY>,"=",XXX,XXX); FORMAT CHECKED BELOW %
IF (.DEL<LEFTHALF> NEQ HEQL)
THEN (RECOVER(.NSYM,ERSYNOEQ); EXITBLOCK);
% GENERATE A CT ENTRY TO HANG OFF THE FCNLIST, IF NOT
ALREADY DECLARED FORWARD--I.E. IF STE ADD'L INF.
WORD IS 0. %
IF .CODETOG THEN BEGIN
CODEPTR_L2_GENFCN(.RFSTE);
% FUDGE A NEW CODE CELL FROM THIS HEADER SO THAT LOWER
LEVEL ROUTINES MAY BE USED TO PROCESS THE CODE HANGING
FROM IT CONVENIENTLY--I.E. A GLITCH.%
LLN_.CT[.CODEPTR,1]<NEXTF>;
LLL_.CT[.CODEPTR,1]<LASTF>;
CT[.CODEPTR,1]<0,30>_.CODEPTR^15+.CODEPTR;
PUSHCODE();
CT[.CODEPTR,1]<NEXTF>_.LLN;
CT[.CODEPTR,1]<LASTF>_.LLL;
CT[.LLN,0]<LASTF>_CT[.LLL,0]<NEXTF>_.CODEPTR;
% NOTE: HEREAFTER IN THIS ROUTINE, WE USE THE COMMENT CONVENTION:
[SEE X]. THIS MEANS, SEE THE CIRCLED LETTER X ON THE R/F/S
CT GENERATION SHEET, FOR THE CURRENT POSITION OF CODEPTR. %
% [SEE C]. FIND THE BODY HEADER CELL AND PREPARE TO
GENERATE THE BODY CODE: %
ACPDT(); ! [SEE D]
END;
%%
% IF WE ARE IN A STRUCTURE, WE MUST TEST FOR A SIZE EXPRESSION.
THIS INVOLVES A LEXEME STREAM COPY ONLY. HOWEVER, IN THE
INTEREST OF SIMPLICITY WE GENERATE CODE OFF THE PROLOG
AND THROW IT AWAY IMMEDIATELY. HENCE, WE POINT TO THE
PROLOG, GENERATE A NEW CODE HEADER FOR IT, GO OFF AND COPY
THE LEXEME STREAM--VIA STRDEF=5. WHEN WE GET BACK, IF WE
ARE STILL COPYING, WE EMPTY THE PROLOG CODE, SET THE LEXEME
SIZE FIELD IN THE STRUCTURE STE, SET THE SIZE SIMBIT ON
AND RESUME. CODEPTR WILL BE LEFT POINTING TO THE PROLOG.
%
%%
IF .RFSTRB
THEN
BEGIN
LOCAL SVERR;
%5.200.21% TSBLEVEL_.BLOCKLEVEL;
IF .FUTDEL<LEFTHALF> NEQ HSQOPEN OR .FUTSYM NEQ HEMPTY
THEN ST[.RFSTE,1]<LXTESF>_0
ELSE
(HRUND(); ! WINDOW: (EMPTY, "[", SIZE-SYM-1,SIZE-DEL-1)
SVERR_.NFUTSYM; %POINT TO RIGHT PLACE%
STRDEF_5; ! CAREFULLY PLACED AFTER ABOVE RUND!
IF .CODETOG THEN PUSHCODE();
ST[.RFSTE,1]<LXTESF>_STRSCOPY(.ST[.RFSTE,1]<NPARMF>);
ST[.RFSTE,1]<SIMBITSF>_1;
HRUND(); ! WINDOW SIZE-SYM-1,SIZE-DEL-1,XXX,XXX)
EXPRESSION(1);
STRECOPY();
IF .CODETOG THEN
(DULEX(.SYM); CLEARSOME(); GTPURGE(1));
IF NOT .STRDEF
THEN
(RELSTRLIST(.ST[.RFSTE,1]<LXTESF>);
RECOVER(.SVERR,ERSMNOTC); EXITBLOCK 2);
IF .CODETOG THEN
(CODEPTR_LOCATE(FRC,1);
EMPTY(.CODEPTR);); ! REMOVE CODE HANGING FROM PROLOG
);
STRDEF_3; !SET UP FOR BODY LEXEME COPY
CURST_STRSCOPY(.ST[.RFSTE,1]<NPARMF>);
END;
! IF .CODETOG THEN
! (ACPR1(); ! [SEE E]
! PUSHCODE(););
!
! % COMPILE THE BODY AND CONVEY THE VALUE/NO VALUE TO
! THE CODE GENERATORS. WINDOW HERE: (<EMPTY>,"=",...)%
!
! HRUND(); ! WINDOW: (<BODY SYM 1>,<BODY DEL 1>,...)
! EXPRESSION(1); ! WINDOW: (<BODY LEXEME>,";",XXX,XXX)
! IF .CODETOG THEN CONVEY(.SYM);
!
!% NOTE: STRUCTURES ARE PROCESSED BY COPYING THE LEXEME STREAM
! FOR THE STRUCTURE AND AT THE SAME TIME GENERATING CODE
! FOR THE BODY. THE CODE IS KEPT IF ANY DECLARATIONS ARE NECESSARY,
! THE CONDITION FOR A BLOCK. THE LEXEME SCAN IS TURNED OFF IF
! A BLOCK IS DECLARED. HENCE, AT THIS POINT WE MUST FIX UP MACRO
! TYPE STRUCTURES, BY:
!
! 1. ERASING THE CODE GENERATED FOR THE STRUCTURE;
! 2. RELEASING THE FUNCTION HEADER FROM FCNLIST;
! 3. SETTING THE STE TO INDICATE A MACRO-TYPE STRUCTURE. %
!
! % CHECK FOR STRUCTURE OF MACRO-TYPE: %
!
! IF .RFSTRB THEN
! (IF .STRDEF
! THEN (IF .CODETOG THEN (ERASE(.L2); CLEARRTGT());
! ST[.RFSTE,1]<SIMBITAF>_1;
! ST[.RFSTE,1]<LXTEAF>_.CURST;
! STRECOPY();
! EXITBLOCK;)
! ELSE RELSTRLIST(.CURST));
!REPLACE THE ABOVE WITH A CALL TO
!H1RFS WHICH DOES PRECISELY THE SAME THING
!BUT CUTS DOWN THE NUMBER OF INTERSEGMENT CALLS
IF H1RFS(.RFSTE,.L2,.RFSTRB) THEN EXITBLOCK;
% NOT A MACRO TYPE STRUCTURE, SO:
1. PROMOTE THE CONVEY CELL TO ONE OF TYPE CODE: %
IF .CODETOG THEN BEGIN
ACPR1(); ! [SEE F]
PROMOTE(1^1+1^0);
ACPR1(); ! [SEE G]
CLASSLAB();
% 2. CODEPTR SITTING AT EPILOG. GENERATE PROLOG FIRST,
BUT REMEMBER WHERE WE HAVE BEEN. %
PUSHCODE(); LLL_.CODEPTR;
NEXTLOCAL_.NEXTLOCAL-.SAVCON; % # INTERNALLY DECLARED %
REGUSE_.REGUSE AND (IF .RFISGLO THEN .SVREGM ELSE NOT
.LOCGPV AND .SVREGM);
IF .ROUFLAG THEN REGUSE=.REGUSE OR .REGTEMP; %9-27-77%
CODEPTR_LOCATE(FRC,1); ! [SEE D]
PUSHCODE();
NF_.ST[.RFSTE,1]<NPARMF>;
IF .RFSTRB THEN NF_.NF*2+1;
GPROLOG(.RFSTE, .NEEDDISP, .NF, .NEXTLOCAL);
% 3. GENERATE EPILOG NOW. %
CODEPTR_.LLL;
GEPILOG(.RFSTE,.NEEDDISP,.NF,.NEXTLOCAL);
CLEARRTGT();
% 4. LINEARIZE THE CHAIN OF CODE: %
CODEPTR_.L2;
FLATFUNC();
% 6. DETERMINE # TOSUBTRACT FROM LOCAL OFFSETS FOR THIS ROUTINE.
CALL THE LOADER INTERFACE ROUTINE TO OUTPUT
THE CODE: %
FNSTAT_IF .NEEDDISP THEN 0 ELSE .NOSVR-.NOSAVREG+1;
WRITECODE(.L2);
LDINT(.L2);
END;
END;
% BLOCK EXITS FROM ABOVE COME HERE TO DECREMENT THE
FUNCTION AND BLOCK LEVELS: %
BLOCKLEVEL_.BLOCKLEVEL-1;
IF .FCNSTATE EQL 2
THEN FUNCTIONLEVEL_.FUNCTIONLEVEL-1
ELSE (POPGPV(3,FUNCTIONLEVEL); POPGPV(5,TRBLEVEL);POPGPV(6,NEEDDISP));
IF .RFISGLO THEN POPGPV(7,TGRBLEVEL);
RESRT(1);
BLOCKPURGE(.BLOCKLEVEL);
PURGENSYMS();
POPGPV(4,MAXLOCAL);
%5.200.21% POPGPV(8,TSBLEVEL);
POPGPV(2,NEXTLOCAL);
POPGPV(1,CODEPTR);
POPGPV(0,REGUSE);
REGTEMP=.SAVTEMP;
END;
%%
% THE ONLY ROUTINE LEFT (NOT DEFINED) WHICH PROCESSES THE
RFS DECLARATIONS IS THE FORMAL PARAMETER LIST PROCESSING
ROUTINE, "FPARMLIST". ITS FUNCTION IS TO SET UP THE KTH
FORMAL BY:
1. DECLARING IT;
2. PUT THE NUMBER K-N-1 IN THE ADDITIONAL INF. WORD;
THE ROUTINE RETURNS A VALUE OF TRUE OR FALSE AS THE
ROUTINE DOES OR DOES NOT FIND ERRORS, RESPECTIVELY. IN
ADDITION, IT SETS THE VALUE POINTED TO BY ITS FIRST PARAMETER
TO ITS SUM WITH THE NUMBER OF PARAMETERS.
FORMAT:
FPARMLIST(FPWHR:<POINTER TO SUBFIELD WHICH WILL BE
SET TO ITSELF + THE NUMBER OF PARAMS>,
FPTYPE:<TYPE WHICH THE PARAMETER IS TO BE
DECLARED>,
FPLEFT:<LEFT DELIMITER>,
FPRIGHT:<RIGHT DELIMITER>)
WINDOW IN: (XXX,.FPLEFT,1ST FORMAL,(","/.FPRIGHT))
WINDOW OUT: ((<EMPTY>/XXX),"=",XXX,XXX)
NOTES: 1. DELIMITER "=" IS NOT TESTED FOR;
2. THE NULL PARAMETER LIST IS ACCEPTED;
3. THE EMPTY PARAMETER LIST "()" OR "[]" IS NOT
ACCEPTED.
%
%%
ROUTINE FPARMLIST(FPWHR)=
BEGIN
LOCAL L1,L2,CHAIN,SAVE,COUNT;
IF .DEL<LEFTHALF> NEQ HPAROPEN THEN RETURN 0;
COUNT_SAVE_0;
DO
(IF DECSYM(L1,FORMALT)
THEN
(COUNT_.COUNT+1;
ST[.L1,1]<ADDRESSF>_.SAVE;
SAVE_.L1)
ELSE RETURN 1;)
WHILE .DEL<LEFTHALF> EQL HCOMMA;
IF .DEL<LEFTHALF> NEQ HROCLO
THEN (RECOVER(.NDEL,ERSYNOFPRD); RETURN 1)
ELSE HRUND();
CHAIN_-1;
DO
(L2_.ST[.L1,1]<ADDRESSF>;
CHAIN_ST[.L1,1]<ADDRESSF>_.CHAIN-1)
WHILE (L1_.L2) NEQ 0;
ST[.FPWHR,1]<NPARMF>_.COUNT;
0
END;
%%
% SPARMLIST(SPSTE:<STRUCTURE STE>,
SPSTF:<STRUCTURE NAME AS FORMAL STE>)
STRUCTURE PARAMETER LIST PROCESSOR. THE PARAMETERS ARE PROCESSED
AS FOR ROUTINES, IN THAT EACH OF THE FORMALS IS GIVEN A
NEGATIVE OFFSET FROM THE CURRENT STACK REGISTER. HOWEVER, THE ADDITIONAL
CONSIDERATIONS:
1. THE STRUCTURE NAME AS FORMAL PARAMETER IS GIVEN THE CORRECT
(0TH FORMAL) OFFSET.
2. VARIABLES ARE DECLARED FOR THE INCARNATION ACTUALS: THEY ARE
DECLARED 1ST AS LOCALS, THEN THE STRUCTURE FORMAL IS DECLARED.
THEY DIFFER ONLY IN TYPE (SAME NAME AT SAME BLOCKLEVEL). THE
CORRECT OFFSETS ARE THEN PUT INTO THE ADDITIONAL INFORMATION
WORDS.
NOTE: DIRTY CODE -- WE REQUIRE THE CURRENT SYMBOL TABLE LINKAGE.
RETURNED VALUE 1 IMPLIES ERRORS.
%
%%
ROUTINE SPARMLIST(SPSTE,SPSTF)=
BEGIN
LOCAL L1,L2,CHAIN,SAVE,COUNT;
IF .DEL<LEFTHALF> NEQ HSQOPEN
THEN
(ST[.SPSTE,1]<NPARMF>_0;
ST[.SPSTF,1]<ADDRESSF>_-2;
RETURN 0);
COUNT_SAVE_0;
DO (IF DECSYN(L1,FORMALT)
THEN
(IF (COUNT_.COUNT+1) GEQ 16 THEN (ERROR(.NFUTSYM,ERTMFP); RETURN 1);
!NPARMF IS ONLY 4 BITS WIDE
SAVE_L1_DECSYQ(.L1,STRFPT,.SAVE);
HRUND();)
ELSE
RETURN 1;)
WHILE .DEL<LEFTHALF> EQL HCOMMA;
IF .DEL<LEFTHALF> NEQ HSQCLO
THEN (RECOVER(.NDEL,ERSYNOFPRD); RETURN 1);
HRUND();
CHAIN_-1; % NOTE INITIAL STACK OFFSET %
ST[.SPSTF,1]<ADDRESSF>_-.COUNT-2; %STRUCTURE NAME AS FORMAL OFFSET %
DO
(L2_.ST[.L1,1]<ADDRESSF>;
CHAIN_ST[.L1,1]<ADDRESSF>_.CHAIN-1;
ST[.ST[.L1,0]<LINKF>,1]<ADDRESSF>_.CHAIN-.COUNT-1;)
WHILE (L1_.L2) NEQ 0;
ST[.SPSTE,1]<NPARMF>_.COUNT;
0
END;
%%
% "SMACHOP" PROCESSES MACHINE OP CODE DECLARATIONS IN THE FORM
E.G. MACHOP MOVE=#200, MOVEM=(#200+2); EACH SYMBOL IS CHECKED FOR VALIDITY,
THE EXPRESSION IS EVALUATED AND INSURED TO BE LITERAL, AND THE ADDITIONAL
INFORMATION WORD IS SET TO THE VALUE OF THE EXPRESSION.
WINDOW IN: (XXX, "SMACHOP", NAME:1, "=")
WINDOW OUT: (XXX, ";", XXX, XXX)
%
%%
GLOBAL ROUTINE SALLMACHOP=
BEGIN
MACRO STINMACHINECODE(I)=
(MACHINECODE(0,(I),1); STINSERT(MACHOPT^16 OR 1^15,(I)))$;
STINMACHINECODE(#104);
INCR I FROM #130 TO #677 DO
STINMACHINECODE(.I);
HRUND();
END;
GLOBAL ROUTINE SMACHOP =
BEGIN
LOCAL SMSTE, SMSYNCHK;
DO
(IF DECSYM(SMSTE,MACHOPT)
THEN IF .DEL<LEFTHALF> EQL HEQL
THEN
(HRUND();
SMSYNCHK_.NSYM;
EXPRESSION(1);
IF NOT LITP(.SYM) THEN (RECOVER(.SMSYNCHK,ERSMBADEXP); RETURN)
ELSE ST[.SMSTE,1]_.SYM)
ELSE (RECOVER(.NDEL,ERSYMEQ); RETURN)
ELSE RETURN;)
WHILE .DEL<LEFTHALF> EQL HCOMMA;
END;
%%
% THE ROUTINE INSTVECTOR IS USED AT INITIALIZATION TIME TO DEFINE
THE STRUCTURE VECTOR AT THE OUTERMOST BLOCK-LEVEL:
STRUCTURE VECTOR[I]=((.VECTOR+.I)<0,36>);
THE LEXEME STREAM FOR THIS DEFINITION IS:
(EMPTY, "(")
(EMPTY,"(")
(400...03, "+")
(400...02, ")")
(EMPTY, "<")
(ZERO, ",")
(36, ">")
(EMPTY, ")")
THE EXTERNALS "LX"... MUST DEFINE THE LEXEMES FOR THE INDICATED
LITERALS---AND THEY MUST HAVE BEEN INITIALIZED BEFORE THIS ROUTINE
IS CALLED. THE ENTRY WILL DIFFER FROM THAT FOR VECTOR ABOVE IN
THAT:
1. NO EXTRA STRUCTURE FORMAL WILL BE DEFINED (I.E. FOR VECTOR);
2. NO STRUCTURE FORMAL FOR .I WILL BE DEFINED.
NOTE: SIZE IS DEFAULT.
%
%%
GLOBAL ROUTINE INSTVECTOR=
BEGIN
!EXTERNAL WDVECTOR, ! USED TO HOLD THE NAME "VECTOR"
! PTOVECTOR, ! STE OF CURRENT STRUCTURE "VECTOR"
! LXOPEP, ! " " "("
! LXPLUS, ! " " "+"
! LXCLOP, ! " " ")"
! LXOPEA, ! " " "<"
! LXCOMMA,! " " ","
! LXCLOA; ! " " ">"
BIND IVEC=PLIT (HEMPTY,LXOPEP, HEMPTY,LXOPEP, #400000000003,LXPLUS,
#400000000002,LXCLOP, HEMPTY,LXOPEA, ZERO,LXCOMMA,
36,LXCLOA, HEMPTY,LXCLOP, HEMPTY,LXCLOA);
LOCAL STVEC G:OLDG;
ACCUM_WDVECTOR_'VECTO';
(WDVECTOR+1)<29,7>_"R";
(WDVECTOR+1)<0,29>_-2;
(ACCUM+1)_.(WDVECTOR+1);
PTOVECTOR_STINSERT(LSM+(STRT^TYPEFP),SIMBITAM+NFPARMBIT+(G_OLDG_GETSPACE(2)));
INCR I FROM 0 TO 16 BY 2 DO
(G[0]_-1;
G[2]_.IVEC[.I];
G[3][email protected][.I+1];
OLDG[1]_OLDG_.G;
G_GETSPACE(2));
OLDG[1]_0;
RELEASESPACE(.G,2);
END;
!END OF H3DECL.BLI