Trailing-Edge
-
PDP-10 Archives
-
ALGOL-10_V10B_BIN_SRC_1err
-
algmac.mac
There are 8 other files named algmac.mac in the archive. Click here to see a list.
;
;
;COPYRIGHT (C) 1975,1981,1982 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;
;
;
; WRITTEN BY J. THOMAS, A. N. HABERMANN, T. TEITELBAUM, L. SNYDER, C.M.U.
; EDITED BY R. M. DE MORGAN.
SALL
SEARCH ALGPRM ; MAIN PARAMETER FILE
%UNIVERSAL(ALGMAC,ALGOL COMPILER PSEUDO-ALGOL MACROS)
REPEAT 0, <
SYNTACTIC DESCRIPTION OF SYNTAX AND CODE GENERATION ROUTINES
MODULE: MDEC
FILE: ALGDEC
TITLE: ROUTINES FOR PROCESSING DECLARATION/SPECIFICATION CONSTRUCTS
PROCEDURE SPRODEC: PROCEDURE <ID> (<FP>,<FP>) ; <SPEC-LIST> ; <STMT> ;
CODE GPRO1-----------------^
CODE GPRO2------------------^
CODE GPRO3-----------------------^----^
CODE GPRO4------------------------------^
CODE GPRO5--------------------------------------------^
CODE GPRO6-----------------------------------------------------^
PROCEDURE SIMP: <DECLAR> <ID> , <ID> ; ! <SPEC> <ID> , <ID> ;
CODE GSMP1-----------^-----------------------^
CODE SPEC1-----------------------------------------^-----^
CODE GSMP2-----------------^-----^
PROCEDURE SARYDEC: ARRAY <ID> , <ID> [ <EXP> : <EXP> , <EXP> : <EXP> ]
CODE GARY1-----^
CODE GARY2--------^
CODE GARY3-------------^------^
CODE GBP1------------------------------^-------^-------^------^
CODE GARY4-----------------------------------------------------^
PROCEDURE SSWDEC: SWITCH <SW ID> := <DESIG EXP> , <DESIG EXP> ;
CODE GSW1DEC-----------------^
CODE GSW2DEC-------------------------------^------------^
CODE GSW3DEC---------------------------------------------^
SUPPORT ROUTINES:
PROCEDURE COMPOSEDEC: COMBINE MULTIPLE WORD DECLARATION DELIMITERS
PROCEDURE SPCHECK: PROHIBIT SPECIFICATIONS AS DECLARATIONS
PROCEDURE XANL0: POSTPROCESS FORWARD DECLARATION
PROCEDURE XANL1: POSTPROCESS OWN DECLARATION
PROCEDURE XANL2: POSTPROCESS SIMPLE DECLARATIONS
PROCEDURE XANL3: POSTPROCESS VALUE AND LABEL SPECIFICATION
PROCEDURE XANL4: POSTPROCESS ARRAY DECLARATIONS
PROCEDURE XANL5: POSTPROCESS PROCEDURE DECLARATIONS
PROCEDURE XANL6: POSTPROCESS SWITCH DECLARATIONS
PROCEDURE XANL7: POSTPROCESS FORWARD LABEL DECLARATIONS
PROCEDURE DSEL: SELECT DECLAR/SPECIF PROCESSING ROUTINE
PROCEDURE DUBDEC: PROHIBIT MULTIPLE DECLARATIONS
MODULE: MSTM
FILE: ALGSTM
TITLE: ROUTINES FOR PROCESSING ALGOL STATEMENT CONSTRUCTS
PROCEDURE SWHILE: WHILE <BE> DO <ST>
CODE GWHL1---------^
CODE GWHL2--------------^
CODE GWHL3------------------------^
CODE GWHL4-------------------------^
PROCEDURE SSIF: IF <BE> THEN <ST> ELSE <ST>
CODE GSIF1------------^
CODE GSIF2------------------------^
CODE GSIF3---------------------------^
CODE GSIF4----------------------------------^
CODE GSIF5------------------------------------^
PROCEDURE SBEGIN: BEGIN <ST> END ! BEGIN <DECL-LIST> ; <ST> END
CODE GBEG0-----^------------------^
CODE GBEG1--------^
CODE GBEG2---------------------------^
CODE GBEG3----------------------------------------^
CODE GBEG4-------------^---------------------------------^
CODE GBEG5-------------------------------------------------^
CODE GBEG6------------------^---------------------------------^
PROCEDURE SGOTO: GOTO <DESIG-EXP>
CODE GGO-----------------------^
PROCEDURE SCOL: <LAB> : <ST>
CODE GCOL1---------^
CODE GCOL2----------^
PROCEDURE SONOFF: CHECKON 1
CODE GSONOFF----------^
MODULE: MEXP
FILE: ALGEXP
TITLE: ROUTINES FOR PROCESSING ALGOL EXPRESSION CONSTRUCTS
PROCEDURE SASS: <LHS> := <RHS>
CODE GASS1----------^
CODE GASS2-----------------^
PROCEDURE SOP: <LHS> <OPERATOR> <RHS>
CODE GOP1---------------^
CODE GOP2---------------------------^
PROCEDURE EXPARN: ( <EXP> ) ! ( <LHS> _ <RHS> )
CODE GPAR1---------------------------^
CODE GPAREN------------^---------------------^
PROCEDURE SEIF: IF <BE> THEN <EXP> ELSE <EXP>
CODE GEIF1------------^
CODE GEIF2-------------------------^
CODE GEIF3--------------------------------------^
PROCEDURE SARY: <ID> [ <EXP> , <EXP> ]
CODE GSS1--------^
CODE GSS2-----------------^-------^
CODE GSS3--------------------------^
PROCEDURE SSW: <SW ID> [ <EXP> ]
CODE GSW1-----------^
CODE GSW2-------------------^
CODE GSW3----------------------^
PROCEDURE SDOT: <STR ID> . [ <EXP> ]
CODE GDOT1------------^
CODE GDOT2---------------------^
CODE GDOT3-----------------------^
PROCEDURE STRIG: <TRIG FUN ID> ( <EXP> )
CODE GTRG1----------------^
CODE GTRG2------------------------^
CODE GTRG3--------------------------^
PROCEDURE SFPARN: <FUN ID> ( <EXP> , <EXP> )
CODE GFUN1-----------^
CODE GFUN2--------------^-------^
CODE GFUN3--------------------^-------^
CODE GFUN4------------------------------^
MODULE: MFOR
FILE: ALGFOR
TITLE: ROUTINES FOR PROCESSING THE FOR STATEMENT
PROCEDURE SFOR: FOR <ID> := <FL-ELEM> , <DL-ELEM> DO <ST> ;
CODE GFOR1-----------^
CODE GFOR2---------------^-----------^
CODE GFOR3------------------------^-----------^
CODE GFOR4-------------------------------------^
CODE GFOR5--------------------------------------------^
CODE GFOR6---------------------------------------------^
PROCEDURE SSTEP: <EXP> STEP <EXP> UNTIL <EXP>
CODE GSTP1---------^
CODE GSTP2--------------------^
CODE GSTP3--------------------------------^
PROCEDURE SUNTIL: <EXP> UNTIL <EXP>
CODE GUNT1---------^
CODE GUNT2--------------------^
PROCEDURE SFWHIL: <EXP> WHILE <BE>
CODE GFWH1--------^
CODE GFWH2-------------------^
SUPPORT ROUTINES:
PROCEDURE VRESTORE: RECOVER CONTROL VARIABLE ASSIGNMENT CODE
PROCEDURE VGETS: MAKE CONTROL VARIABLE ASSIGNMENT
PROCEDURE BODY: GENERATE TRANSFER TO FOR BODY
MODULE: MUTL
FILE: ALGUTL
TITLE: SUPPORT ROUTINES FOR SYNTAX AND CODE GENERATION ROUTINES
SUPPORT ROUTINES:
PROCEDURE LOOK: SCAN SYMBOL TABLE FOR SYMBOL IN NSYM
PROCEDURE SCINSERT: FIXUP WINDOW IN CASE OF A MISSING SEMICOLON
PROCEDURE RUND2: SHIFT WINDOW PAST BEGIN AND ;CATCH MISSING SEMI
PROCEDURE RUND3: SHIFT WINDOW PAST ) AND ] AND CATCH MISSING SEMI
PROCEDURE RUND5: SHIFT WINDOW AND CATCH MISSING SEMI BEFORE STATEMENTS
PROCEDURE PSUEDO: PROCESS SEQUENCES OF CHECKON/OFF,LISTON/OFF,LINE
PROCEDURE ERREAD: SHIFT WINDOW AFTER ERROR, TRY TO RESTORE CONTEXT
PROCEDURE COBBLE: PROCESS BRACKET PAIRS WHILE ERREADING IN DECLARATIONS
PROCEDURE DESCEND: PROCESS TEXT BETWEEN (),[] AND BEGIN-END
PROCEDURE FAIL: PRINT DIAGNOSTIC AND SET ERROR FLAGS
PROCEDURE ERRLEX: SET SYM TO AN ALWAYS INCORRECT LEXEME
PROCEDURE SEMERR: GIVE SEMANTICS ERROR DIAGNOSTIC
PROCEDURE F1: PRINT DIAGNOSTIC FOR ILLEGAL STATEMENT SELECT
PROCEDURE F2: PRINT DIAGNOSTIC FOR DECLARATION OUT OF ORDER
PROCEDURE F3: PRINT DIAGNOSTIC FOR ILLEGAL EXPRESSION SELECT
PROCEDURE F4: PRINT DIAGNOSTIC FOR ILLEGAL DESIG. EXP SELECT
PROCEDURE F5: PRINT DIAGNOSTIC FOR ILLEGAL USE OF ASSINGMENT
PROCEDURE BENTRY: BLOCK ENTRY ROUTINE
PROCEDURE PCALL: GENERATE JSP TO SYSTEM ROUTINES
PROCEDURE MJRST0: GENERATE JRST WITH ZERO ADDRESS TO BE FIXED LATER
PROCEDURE TOSTACK: GENERATE CODE TO PUSH A VALUE ONTO THE STACK
PROCEDURE LABREF: PROCESS LABEL REFERENCES
PROCEDURE FATRUND: SHIFT WINDOW AND GOBBLE FATCOMMA IF PRESENT
PROCEDURE GCOND: PROCESS EXPRESSION FOLLOWING THEN AND ELSE
PROCEDURE GDOUBLE: DOUBLE LAST SUBSCRIPT VALUE FOR LONG ARRAYS
PROCEDURE GSTAT: COMPLETE STATEMENT PROCESSING
PROCEDURE GBOOL: PROCESS A BOOLEAN EXPRESSION
ERROR MESSAGE LIST
0. PROBABLY SEMICOLON OMITTED
1. UNDECLARED IDENTIFIER
2. INCORRECT STATEMENT
3. INCORRECT EXPRESSION
4. PROBABLY OPERATOR OMITTED
5. IDENTIFIER OR CONSTANT MISSING
6. INCORRECT DESIGNATIONAL EXPRESSION
7. INCORRECT OR UNPARENTHESIZED ASSIGNMENT
8. SYMBOL NOT PERMITTED HERE
9. AMBIGUOUS USE OF COLON
10. SEMICOLON PROBABLY SUPERFLUOUS
11. ONLY LETTER STRING ALLOWED
12. THIS DELIMITER IS NOT PERMITTED BEFORE DO
13. WHILE STATEMENT IS NOT ALLOWED BETWEEN THEN AND ELSE
14. THEN MUST NOT BE FOLLOWED BY IF
15. THEN STATEMENT NOT FOUND
16. DECLARATIONS MUST BE TERMINATED BY SEMICOLON
17. THIS IS NOT ALLOWED AFTER END
18. CANNOT BE USED AS ARGUMENT
19. ARGUMENT TOO LARGE
20. PROBABLY END OMITTED
21. COMPLEX ARITHMETIC NOT IMPLEMENTED
22. DECLARATOR LONG MUST BE FOLLOWED BY REAL
23. NOT PERMITTED AS SPECIFIER
24. NOT PERMITTED AS SPECIFIER
25. INCORRECT DECLARATION OR SPECIFICATION
26. NO DECLARATION SHOULD FOLLOW PROCEDURE DECLARATION
27. IMPROPER ARRAY DELARATION OR SPECIFICATION
28. DELIMITER MUST NOT BE DECLARED OR SPECIFIED
29. PROBABLY LIST ELEMENT MISSING
30. IMPROPER DECLARATION
31. VALUE WAS ALREADY SPECIFIED
32. IMPROPER TYPE OF FORMAL IN VALUELIST
33. NON-FORMALS MUST NOT BE SPECIFIED
34. BOUND PAIR NOT FOUND
35. INCORRECT BOUND PAIR
36. PROBABLY RIGHT BRACKET OMITTED
37. TYPE DOES NOT MATCH FORWARD DECLARATION
38. :=MISSING IN SWITCH DECLARATION
39. PROCEDURE NESTING TOO DEEP
40. NOT SIMPLE IDENTIFIER IN FORMAL LIST
41. FORMAL LIST NOT PROPERLY TERMINATED
42. PROBABLY ; MISSING IN PROCEDURE HEADING
43. NOT ALL FORMALS HAVE BEEN SPECIFIED
44. INCORRECT STRUCTURED FORMAL LIST
45. UNTIL EXPRESSION NOT FOUND
46. BYTE SELECTOR NOT PERMITTED AS CONTROLLED VARIABLE
47. ASSIGNMENT DELIMITER NOT FOUND
48. DELIMITER "DO" NOT FOUND
49. ASSIGNMENT HAS NON-MATCHING TYPES
50. PROBABLY DELIMITER OMITTED
51. CANNOT BE USED AS UNARY OPERATOR
52. CANNOT BE USED AS BINARY OPERATOR
53. THEN EXPRESSION NOT FOUND
54. CONDITIONAL EXPRESSION MUST HAVE ELSE PART
55. CONDITIONAL EXPRESSION MUST BE PARENTESIZED
56. IMPROPER SEQUENCE OF DELIMITERS
57. WRONG NUMBER OF DIMENSIONS
58. TOO MANY PARAMETERS FOR STANDARD FUNCTION
59. NON-TYPE PROCEDURE AS EXPRESSION
60. MATCHING CLOSE PARENTHESIS NOT FOUND
61. INCORRECT NUMBER OF ACTUAL PARAMETERS
62. FORWARD HAS NO MATCHING DECLARATION IN SAME BLOCK
63. FORWARD DECLARATION NOT ALLOWED FOR THIS TYPE
64. FORWARD DECLARATION WAS REQUIRED
65. ASSIGNMENT HAS NON-MATCHING TYPES
66. STACK ADDRESS OVERFLOW
67. NON-INTEGER OPERAND FOR DELIMITER REM OR DIV
68. COMPLEX ARITHMETIC NOT IMPLEMENTED
69. NON-ARITHMETIC OPERAND FOR ARITHMETIC OPERATOR
70. NON-ARITHMETIC OPERAND FOR RELATIONAL OPERATOR
71. NON-BOOLEAN OPERAND FOR BOOLEAN OPERATOR
72. DELIMITER NOT REQUIRES BOOLEAN OPERAND
73. UNARY + AND - REQUIRE ARITHMETIC OPERAND
74. OVERFLOW WHILE COMBINING CONSTANTS
75. OVERFLOW IN LONG REAL OPERATION ON CONSTANTS
76. UNDEFINED RESULT FOR POWER OPERATION ON CONSTANTS
77. PARAMETER FOR STANDARD FUNCTION MUST BE ARITHMETIC
78. STANDARD FUNCTION "INT" REQUIRES BOOLEAN PARAMETER
79. STANDARD FUNCTION "BOOL" REQUIRES ARITHMETIC PARAMETER
80. PARAMETER MUST BE OF ARITHMETIC TYPE
81. FOR STATEMENT NOT ALLOWED BETWEEN THEN AND ELSE
82. SWITCH IDENTIFIER NOT ALLOWED HERE
83. EXPRESSION TOO LONG
84. IDENTIFIER DECLARED IN THIS BLOCK NOT PERMITTED
85. INCORRECT FILE OR BLOCK STRUCTURE
86. INCORRECT BLOCK STRUCTURE;TOO MANY ENDS
87. PROCEDURE INCORRECTLY TERMINATED
88. INCORRECT FILE STRUCTURE
89. EMPTY SOURCE FILE
90. INVALID CONSTANT
91. IDENTIFIER EXCEEDS 64 CHARACTERS
92. IMPROPER WORD DELIMITER
93. CHARACTER NOT LEGAL IN ALGOL
94. EXPONENT TOO SMALL
95. EXPONENT TOO LARGE
96. DECLARATION FOLLOWS STATEMENT
97. IMPROPER USE OF PERIOD
98. INTEGER CONSTANT CONVERTED TO TYPE REAL
100. EXPECTED WAS AN EXPRESSION
101. EXPECTED WAS A STATEMENT
102. EXPECTED WAS A BOOLEAN EXPRESSION
103. EXPECTED WAS A DESIGNATIONAL EXPRESSION
104. EXPECTED WAS A LABEL IDENTIFIER
105. EXPECTED WAS A LABEL IDENTIFIER
106. IDENTIFIER MUST NOT BE DECLARED OR SPECIFIED TWICE
107. BOUND PAIR EXPRESSION MUST BE ARITHMETIC
108. IDENTIFIER USED TWICE IN FORMAL LIST
109. STEP EXPRESSION MUST BE ARITHMETIC
110. UNTIL EXPRESSION MUST BE ARITHMETIC
111. INITIALIZING EXPRESSION MUST BE ARITHMETIC
112. CANNOT BE USED AS CONTROLLED VARIABLE
113. IMPROPER LEFT PART OF ASSIGNMENT
114. EXPECTED WAS A STRING EXPRESSION
115. EXPRESSION OF IMPROPER TYPE
116. EXPRESSION OF IMPROPER TYPE
117. EXPECTED WAS AN ARRAY IDENTIFIER
118. SUBSCRIPT MUST BE ARITHMETIC EXPRESSION
119. EXPECTED WAS A SWITCH IDENTIFIER
120. IMPROPER ACTUAL PARAMETER
121. EXPECTED WAS A PROCEDURE IDENTIFIER
122. SUBSCRIPT OF SWITCH DESIGNATOR MUST BE ARITHMETIC
123. VARIABLE OF IMPROPER TYPE
124. EXPECTED WAS A STRING VARIABLE
125. PARAMETER IN STANDARD FUNCTION HAS INCORRECT TYPE>
REPEAT 0, <
THE MACRO MODULE:
1/ GIVES THIS COMPILATION LISTING THE TITLE #, WHICH ALSO NAMES THIS
MODULE'S SYMBOL TABLE FOR DDT.
2/ DECLARES AN EXTERNAL NAME B.# WHICH MUST BE DECLARED AS AN INTERN IN
THE LOW SEG DATA MODULE. ALL OWN SPACE IS ALLOCATED AS AN OFFSET
RELATIVE TO B.# . THE TOTAL SPACE ALLOCATED IN THE LOW SEG DATA MODULE
FOR THIS MODULE IS PRINTED AT THE END OF THE ASSEMBLY.
FOR THE TEST (IE DEBUG==1) VERSION LOCALS ARE ALSO ALLOCATED AS FOR OWNS
INSTEAD OF BEING OFFSETS IN THE COMPILE TIME STACK.
3/ PLACES A LABEL C.# AT THE HEAD OF THE CODE FOR USE IN REFERENCING
BY DDT.
4/ INITIALISES ALL THE ASSEMBLY TIME VARIABLES USED BY THE VARIOUS MACROS.
>
DEFINE $BASE <B.'N>
REPEAT 0, <
NOW SOME UTILITY MACROS FOR PRINTING MESSAGES AND ERRORS.
ALLOWING MULTIPLE PARAMETERS TO OUR MACROS.
HANDLING THE ASSEMBLY TIME STACK.
>
; MACROS FOR MANIPULATING THE ASSEMBLY TIME STACK.
DEFINE $PUT(SUBI)
< $S'SUBI== $ITEM >
DEFINE $GET(SUBI)
< $ITEM==$S'SUBI >
DEFINE $EXAMINE(LH,RH); EXAMINE TOP WORD OF STACK
<
$GET(\$$SP)
LH==$ITEM_-^D18
RH==$ITEM&777777
>
DEFINE $PUSH(LH,RH)
<; PUSH TWO HALF WORDS ONTO THE STACK
$$SP==$$SP+1
IFG $$SP-$$SPMAX,<$$SPMAX==$$SP >
$ITEM== XWD LH,RH
$PUT(\$$SP)
>
DEFINE $POP(LH,RH)
<; UNSTACK TWO HALF WORDS
IFE $$SP,<$ERROR(<STACK UNDERFLOW>)>
IFN $$SP,<
$GET(\$$SP)
LH==$ITEM_-^D18
RH==$ITEM&777777
$$SP==$$SP-1
>>
DEFINE $DEF(NAME,OFFSET)
<DEFINE NAME <@-'OFFSET'(SP)>
>
DEFINE $DEFST(NAME,OFFSET,REG)
<DEFINE NAME <@-'OFFSET'('REG')>
>
DEFINE $DEFLC(NAME,OFFSET,REG)
<DEFINE NAME <-'OFFSET'('REG')>
>
; MACROS FOR PRINTING MESSAGES
DEFINE $PRINT(A,B)
<
PRINTX A B
>
DEFINE $ERROR(A)
<
IF1,<
PRINTX ******ERROR A ******
>
$ECNT==$ECNT+1
>
DEFINE $MULTP(NAME)
<
DEFINE NAME(A,B,C,D,E,F,G,H,I,J,K,L,A1,A2,A3,A4,A5,A6,A7,A8,A9,B1,B2,B3,B4)
<
%'NAME(<A,B,C,D,E,F,G,H,I,J,K,L,A1,A2,A3,A4,A5,A6,A7,A8,A9,B1,B2,B3,B4>)
>>
$MULTP(EXPROC)
$MULTP(FORWARD)
$MULTP(REGISTER)
$MULTP(FAKE)
$MULTP(LOCAL)
DEFINE $CHECK(TYPE)
< $EXAMINE($TYPES,$T)
IFE $TYPES&TYPE,<
$ERROR(<ILLEGAL CONSTRUCT>)
>>
; MACRO TO CHECK USER HAS DEFINED ALL WE NEED TO KNOW
DEFINE $CHKDEF(L)
< IF1,< IRP L,<
IFB <L>,<STOPI>
IFNB <L>,< IFNDEF L,<
$ERROR(< L HAS NOT BEEN GIVEN A VALUE >,)
>
IFDEF L,< $T== L&777777777760
IFN $T,<
$ERROR(< L HAS AN INVALID VALUE >,)
>>>>>>
REPEAT 0, <
NOW WE DEFINE A MACRO TO ALLOCATE VALUES TO OUR ASSEMBLY TIME
CONSTANTS. WE USE THEM TO RECORD WHAT CONSTRUCTS WE EXPECT TO SEE.
>
DEFINE $SETCON(I)
< $T==1
IRP I,<
IFB <I>,<STOPI>
IFNB <I>,<
$'I==$T
$T==$T_1
>>>
$SETCON(<PROC,IF,THEN,ELSE,FI,LOOP,AS,SA,WHILE,DO,OD,ENDD,BEGIN,REGIS,LOC,NEW>)
$STMSTART==$BEGIN+$REGIS+$LOC+$THEN+$ELSE+$LOOP+$DO+$NEW
; NOW SOME MACROS WHICH ARE USED TO PURGE THE SYMBOL TABLE
; OF ALL THE ASSEMBLY TIME RUBBISH WE GENERATED AT THE END OF PASS 2
DEFINE $DELSTACK(INDEX)
<PURGE $S'INDEX >
DEFINE $ENDALL
<
$Q==$MCNT;
IF2,<
$T==0
REPEAT $$SPMAX,<$DELSTACK(\$T)
$T==$T+1>
>
XLIST
LIT
LIST
>
DEFINE %EXPROC(A)
< IRP A,<
IFB <A>,<STOPI>
IFNB <A>,<
IFNDEF A,<
DEFINE A
<
PUSHJ SP,.'A;*
>>
EXTERNAL .'A;
>>>
DEFINE %FORWARD(A)
<
IRP A,<
IFB <A>,<STOPI>
IFNB <A>,<
DEFINE A
<
PUSHJ SP,.'A;*
>>>>
DEFINE $OWNN(I)
< IRP I,<
IFB <I>,<STOPI>
IFNB <I>,<
I==$MCNT+$BASE
$MCNT==$MCNT+1
>>>
DEFINE OWN(A,B,C,D,E,F,G,H,I,J,K,L)
<
$OWNN(<A,B,C,D,E,F,G,H,I,J,K,L>)
>
DEFINE %REGISTER(R)
<
IRP R,<
IFB <R>,<STOPI>
IFNB <R>,<
R==RBASE-$RCNT
$PUSH($REGIS,$RCNT)
PUSH SP,R;*
$RCNT==$RCNT+1
$LRCNT==$LRCNT+1
>> ; END OF IRP
IFG $RCNT-RMAX,< $ERROR(<TOO MANY LOCAL REGISTERS >)>
>
DEFINE NEWLOP
<
PUSH SP,LLEXEX;*
PUSH SP,LCOMPNAME;*
$NEWCT==2
$PUSH($NEW,0)
>
DEFINE PROCEDURE(A)
<
$PLEVEL==$PLEVEL+1
IFG $PLEVEL-PMAX,<
$ERROR(<PROCEDURES NESTED MORE THAN PMAX >)
>
$PUSH($NEWCT,$NEWCT)
$PUSH($LCNT,$LRCNT)
$PUSH($PROC,$RCNT)
$LRCNT==0
$LCNT==0
$RCNT==0
$NEWCT==0
IFNDEF A,<
DEFINE A
<
PUSHJ SP,.'A;*
>>
.'A:;*
INTERN .'A;*
>
DEFINE BEGIN
<
$PUSH($BEGIN,0)
>
EXTERN .STOVERFLOW;
DEFINE %FAKE(I)
<$T==0
IRP I,<
IFB <I>,<STOPI>
IFNB <I>,<
$DEFLC (I,\$T,\DBASE)
$T==$T+1
>>>
DEFINE %LOCAL(I)
<
IFN $PLEVEL-PMAX,<
$T==DBASE+$PLEVEL-1
>
IFE $PLEVEL-PMAX,< ;ACCESS LOCALS BY STACK POINTER
$T==SP
>
IRP I,<
IFB <I>,<STOPI>
IFNB <I>,<
$DEFLC(I,\$LCNT,\$T)
$LCNT==$LCNT+1
>> ; END OF IRP
IFG $LCNT,<
$PUSH($LOC,0)
IFN $PLEVEL-PMAX,< ; SAVE OLD DISPLAY
PUSH SP,$T;*
HRLI $T,(SP);*
>
$.==$LCNT
ADD SP,[XWD $.,$.];*
JUMPL SP,.+2;*
JSR .STOVERFLOW;*
IFN $PLEVEL-PMAX,< ; SET UP NEW DISPLAY
HRR $T,SP;*
>>>
DEFINE FORMAL(F)
<
$T==$LCNT+$LRCNT+$NEWCT
IFN <$PLEVEL-PMAX>*$LCNT,< ; ACCOUNT FOR PUSHED DISPLAY REG
$T==$T+1
>
$DEFST(F,\$T,\SP);
>
DEFINE ENDD
<
$POP($TYPES,$T)
IFE $TYPES-$LOC,<
$.==$LCNT
SUB SP,[XWD $.,$.];*
IFN $PLEVEL-PMAX,<; UPDATE DISPLAY
$T==DBASE+$PLEVEL-1
POP SP,$T;*
>
$POP($TYPES,$T) >
IFE $TYPES-$REGIS,<
REPEAT $LRCNT,< $T==RBASE-$T
POP SP,$T;*
$POP($TYPES,$T)>>
IFE $TYPES-$NEW,<
POP SP,LCOMPNAME;*
POP SP,LLEXEX;*
$POP($TYPES,$T)
>
IFN $$SP,<
$EXAMINE($TYPES,$T)
IFE $TYPES-$PROC,<
POPJ SP,0;*
$POP($TYPES,$RCNT)
$POP($LCNT,$LRCNT)
$POP($NEWCT,$NEWCT)
$PLEVEL==$PLEVEL-1
>>
IFE $$SP,<
$ENDALL
>>
; MACROS FOR HANDLING CREATED LABELS
DEFINE $PLAB(A,B)
<
; PLACE A CREATED LABEL FORMED BY CONCATENATING A AND BLAL
$'B'A: ;*
XALL
>
DEFINE $JLAB(A,B)
<
; GENERATE A JUMP TO THE CREATED LABEL
JRST $'B'A;*
>
DEFINE $UNDEFTF(TYPE)
< ; REMOVE TRUE AND FALSE DEFS.
IFE TYPE,<$ERROR(<TRUE/FALSE UNUSED IN BOOLEAN>)>
DEFINE TRUE< ERROR;*
$ERROR(<TRUE NOT IN A BOOLEAN EXPRESSION >)
>
DEFINE FALSE< ERROR;*
$ERROR(<FALSE NOT IN A BOOLEAN EXPRESSION >)
>>
DEFINE $DEFTF(TT)
< ; MACRO TO DEFINE THE TRUE AND FALSE LABELS
$TCNT==0
$FCNT==0
DEFINE TRUE < $'TT'T;*
$TCNT==$TCNT+1
>
DEFINE FALSE < $'TT'F;*
$FCNT==$FCNT+1
>>
REPEAT 0, <
MACROS FOR THE "IF THEN FI" AND "IF THEN ELSE FI" STATEMENTS
"IF"DEFINE TRUE==T.N,FALSE==F.N
.BE.
"THEN"T.N:
.STRUE.
"FI"F.N:
OR FOR IF THEN ELSE FI :-
"IF"DEFINE TRUE==T.N,FALSE==F.N
.BE.
"THEN"T.N:
.STRUE.
"ELSE"JRST S.N
F.N:
.SFALSE.
"FI"S.N:
>
DEFINE IF(TEXT)
<
$BTYPE==$IF
$LABCNT==$LABCNT+1
$PUSH($IF,$LABCNT)
$DEFTF(\$LABCNT)>
DEFINE THEN
<
$UNDEFTF($FCNT)
$POP($TYPES,$T); UNSTACK LAST ITEM
$PLAB(<T>,\$T); AND PLACE IT HERE
$PUSH($THEN,$T); AND CHANGE TYPE TO THEN.
>
DEFINE ELSE
<
$POP($TYPES,$T); UNSTACK LAST ITEM
$JLAB(<S>,\$T); GENERATE THE JUMP PAST THE ELSE PART
$PUSH($ELSE,$T); STACK AWAY THE ELSE LABEL.
$PLAB(<F>,\$T); PLACE LABEL FOR ELSE DESTINATION.
>
DEFINE FI
<
$POP($TYPES,$T); UNSTACK LAST ITEM
IFE $TYPES-$ELSE<; WE HAD AN ELSE PART
$PLAB(<S>,\$T); PALE THE SKIP LABEL
>
IFE $TYPES-$THEN,<; WE ONLY HAD A THEN PART
$PLAB(<F>,\$T); PLACE THE FALSE LABEL.
>>
REPEAT 0, <
MACROS FOR WHILE ... DO ... OD CONSTRUCT
"WHILE"DEFINE TRUE==T.N,FALSE==F.N
W.N:
.BE.
"DO"T.N:
.STAT.
"OD"JRST W.N
F.N:
>
DEFINE WHILE(TEXT)
<
$BTYPE==$WHILE
$LABCNT==$LABCNT+1
$PLAB(<W>,\$LABCNT)
$PUSH($WHILE,$LABCNT)
$DEFTF(\$LABCNT)>
DEFINE DO
<
$POP($TYPES,$T)
$UNDEFTF($FCNT)
$PLAB(<T>,\$T)
$PUSH($DO,$T)>
DEFINE OD
<
$POP($TYPES,$T)
$JLAB(<W>,\$T)
$PLAB(<F>,\$T)>
REPEAT 0,<
MACROS FOR THE LOOP AS SA CONSTRUCT
"LOOP"T.N:
.STAT.
"AS"DEFINE TRUE==T.N,FALSE==F.N
.BE.
"SA"F.N:
>
DEFINE LOOP
<
$LABCNT==$LABCNT+1
$PLAB(<T>,\$LABCNT)
$PUSH($LOOP,$LABCNT)>
DEFINE AS(TEXT)
<
$BTYPE==$AS
$POP($TYPES,$T)
$DEFTF(\$T)
$PUSH($AS,$T)>
DEFINE SA
<
$POP($TYPES,$T)
$PLAB(<F>,\$T)
$UNDEFTF($TCNT)>
OPDEF GOTO [JRST 0,0]
OPDEF NOOP [JFCL 0,0]
DEFINE INCR(LOCN)
<
AOS LOCN;*
>
DEFINE DECR(LOCN)
<
SOS LOCN;*
>
DEFINE SETT(LOCN)
<
SETOM LOCN;*
>
DEFINE SETF(LOCN)
<
SETZM LOCN;*
>
DEFINE ZERO(LOCN)
<
SETZM LOCN;*
>
DEFINE SELMCC(A,B,C) ; MACRO TO SELECT TARGET M/C AND SOURCE M/C
; FOR CODE PLANTING CONVERSION ETC MACROS
;
; IT USES THE FOLLOWING TABLE FOR BRANCHING
;
; TARGET M/C
; KA KI/KL
; SOURCE KA A B
; M/C KI/KL A C
;
<
SKIPN TARGMC
GOTO A ; KA TARGET
SKIPN SRCEMC
GOTO B ; KI TARGET, KA SOURCE
>
; CLEARLY IT SIMPLY DROPS THROUGH TO C
DEFINE MODULE(N)
<
SALL
Q.'N==$Q;
EXTERNAL B.'N;
INTERNAL C.'N,Q.'N;
C.'N:
DEFINE $BASE <B.'N>
%TITLE(N,ALGOL COMPILER MODULE N)
; SET UP SOME CHECKS:
$CHKDEF(<SP,PMAX,RBASE,RMAX>)
; SET UP ASSEMBLY TIME VARIABLES:
$ECNT==0 ; NUMBER OF MACRO ERRORS FOUND
$LABCNT==0 ; UNIQUE LABEL COUNTER
$$SP==0 ; ASSEMBLY TIME STACK POINTER
$$SPMAX==0 ; RECORD OF MAX OF $$SP
$PLEVEL==0 ; DEPTH OF PROCEDURE NESTING
$ALLOW==0 ; RECORD OF WHICH CONSTRUCTS ARE ALLOWED
; COUNTERS USED FOR SPACE ALLOCATION:
$NEWCT==0 ; LEFTOP REGISTER
$LCNT==0 ; LOCALS
$LRCNT==0 ; REGISTERS LOCAL TO PROCEDURES
$RCNT==0 ; REGISTERS LOCAL TO CURRENT PROCEDURE
$MCNT==0 ; LOW SEGMENT AREA FOR OWNS AND NON STACK
; VERSION LOCALS
> ; END OF MODULE MACRO
EXTERN NSYM; ;NEXT SYMBOL
EXTERN NDEL; ;NEXT DELIMITER
EXTERN BLOCKLEVEL; ;CURRENT BLOCKLEVEL
EXTERN FNLEVEL; ;CURRENT FUNCTION LEVEL
EXTERN STBB; ;SYMBOL TABLE BASE FOR THIS BLOCK
EXTERN NASTE; ;NEXT AVAIL. SYMBOL TABLE ENTRY
EXTERN NACTE; ;NEXT AVAIL. CONSTANTS TABLE ENTRY
EXTERN NAFTE; ;NEXT AVAILABLE FIXUP TABLE ENTRY;
EXTERN FIXUP; ;BASE OF FIXUP TABLE;
EXTERN CONTAB; ;CONSTANT TABLE BASE;
EXTERN CAX; ;PROCEDURE LEVEL OF LAST ACCESSED NON-LOCAL
EXTERN RA; ;RELATIVE ADDRESS OF NEXT INSTRUCTION PLACED IN OBCODE
EXTERN LEXBLOCK; ;MONOTONICALLY INCREASING COUNT OF BLOCKS
EXTERN CURBLOCK; ;LEXBLOCK OF CURRENT BLOCK
EXTERN ARDEC; ;ARRAY DECLARED IN BLOCK: TRUE; ELSE FALSE
EXTERN PROSKIP; ;PROCEDURE FOUND SWITCH (-1 NONE FOUND) OR ADDR OF FIRST ONE
EXTERN LINENO; ;LINE NUMBER SPECIFIED BY LINE PSEUDO-STATEMENT
EXTERN INDEX; ;FIRST AVAILABLE FREE WORD IN TEMPCODE
EXTERN HANDLE; ;PORTION POINTER FOR CURRENTLY OPEN PORTION
EXTERN LEXEX; ;BLOCKLEVEL & HANDLE FOR SYM * THESE
EXTERN COMPNAME; ;COMPOSIT NAME FOR SYM * MUST
EXTERN LLEXEX; ;BLOCKLEVEL & HANDLE FOR LEFT OP* APPEAR
EXTERN LCOMPNAME; ;COMPOSIT NAME FOR LEFT OP * TOGETHER
EXTERN LAC; ;LAST ALLOCATED ACCUMULATOR
EXTERN TCBASE; ;THE FIRST LOCATION OF TEMPCODE BUFFER.
EXTERN TCMAX; ;THE LAST LOCATION OF TEMPCODE BUFFER.
EXTERN THUNK; ;ADDRESS OF JRST OVER THUNKS (0 IF NONE YET.);
EXTERN OP; ;CONTAINS THE OPERATOR DURING CODE GENERATION;
EXTERN KA; ;COMUNICATIONS CELL FOR GLOAD AND LOAD;
EXTERN FBSYMSAVE; ;SAVED STEP ELEMENT LEXEME
EXTERN FBLEXSAVE;
EXTERN FBCOMPSAVE;
EXTERN PREFACC; ;PREFERED REGISTER FOR CGINCR
SUBTTL GLOBAL BOOLEANS
;THIS MACRO DEFINES THE BIT POSITIONS OF VARIOUS BOOLEAN VARIABLES
;WHICH OCCUPY A GLOBAL FLAG WORD. THESE VARIABLES ARE TESTED BY
;MACROS NAMED "TGB" AND "TNGB".
DEFINE GB(BVAR)
<BVAR==BVBIT
BVBIT==BVBIT_1
>
BVBIT==1
GB ERRL; ;SCANNING IN ERROR LEVEL
GB ERRF; ;FATAL ERROR FOUND. NO CODE GENERATED
GB BPAIR; ;SCANNING TEXT WITHIN ARRAY DECLARATION BOUND PAIR
GB DECLAR; ;SCANNING DECLARATIONS. LSCAN ONLY SEARCHES TOP LEVEL
GB LISTOO; ;LIST ON/LIST OFF FLAG
GB LNOO; ;LINE NUMBERS ON/ LINE NUMBERS OFF FLAG
GB ACOO; ;ARRAY SUBSCRIPT CHECKING ON/OFF FLAG
GB NOENTRY; ;SEARCH ROUTINE BEING USED ONLY FOR LOOKUP
GB OBOO; ;OBJECT CODE LISTING ON/OFF FLAG
GB ACON; ;ARRAY SUBSCRIPT-CHECKING FORCED ON BY SWITCH
GB ACOFF; ;ARRAY SUBSCRIPT-CHECKING FORCED OFF BY SWITCH
GB CREF; ;OUTPUT CREF DATA
GB TRPOFF; ;DON'T TRACE PROCEDURES
GB TRLOFF; ;DON'T TRACE LABELS
GB TRON; ; PLANT P-M BLOCKS FOR PROCEDURES ONLY
GB TRLB; ; PLANT P-M BLOCKS FOR LABELS AND PROCS
SUBTTL REGISTER ASSIGNMENTS
;COMPILE-TIME REGISTERS
FL==0; ;GLOBAL BOOLEAN REGISTER
T==A1; ;TEMPORARY REGISTER
T1==A2; ;TEMPORARY REGISTER
T2==A3; ;TEMPORARY REGISTER
T3==A4; ;TEMPORARY REGISTER
T4==A5; ;TEMPORARY REGISTER
T5==A6; ;TEMPORARY REGISTER
REV==A6; ;PORTION REVERSAL DISPLACEMENT REGISTER
STOPS==A7; ;FLAG REGISTER INDICATING PENDING STOPPERS (DELIMS)
DBASE==A10; ;FIRST DISPLAY REGISTER - STACK VERSION
;DBASE+1 ;SECOND DISPLAY REGISTER - STACK VERSION
;A12-A14 ;LOCAL REGISTERS
LOP==14; ;LEXEME OF LEFT OPERAND
DEL==15; ;DEL FRAME OF WINDOW
SYM==16; ;SYM FRAME OF WINDOW
PMAX==3; ;LIMIT ON PROCEDURE LEVELS
RMAX==3; ;LIMIT ON LOCAL REGISTERS
RBASE==14; ;FIRST LOCAL REGISTER - ALLOC. DOWNWARD
ANYAC==15; ;ANYAC PASSED TO LOAD MEANS CHOOSE ANY ACC
SUBTTL DEFINITION OF SUPPORT ROUTINES DISPATCH OFFSETS
; ***** THESE MUST AGREE WITH DEFINITION OF <ALGDIR> IN ALGSYS *****
PARAM==1
GOLAB==3
ARRAY==4
OARRAY==5
CHKARR==6
COMPAR==7
PBYTE==10
BLKBEG==11
BLKEND==12
STRASS==47
TRLAB==52 ; TRACE LABELS
STRDEC==54 ; DEFINE STRING
SUBTTL DELIMITER LEXEME DEFINITIONS
;THIS MACRO DEFINES THE CONFIGURATIONS OF THE DELIMITER LEXEMES.
;THE ARGUMENTS HAVE THE FOLLOWING MEANING:
;ROOT THE SUFFIX TO BE USED WHEN REFERING TO THIS DELIMITER
;PRIORITY PRIORITY OF OPERATORS AND OTHER DELIMITERS FOR PARSING
; IN THE OPERATOR SYNTAX ROUTINE (SOP).
;DISPATCH VALUE OF INDEX INTO TRANSFER VECTORS USED BY THE 'SEL
; ROUTINES. NOTE: SOME VALUES ARE SHARED BY DIS-
; JOINT CLASSES.
;DISCRIMINATION A FIELD USED TO UNIQUELY DISCRIMINATE DELIMITERS WHICH
; WOULD OTHERWISE BE THE SAME (E.G. RELATIONALS)
;OTHER FIELD ACCEPTING ANY 36-BIT VALUE, USED TO SET OTHER
; FLAGS
DEFINE DD(ROOT,PRIORITY,DISPATCH,DISCRIMINATION,OTHER)
<
$ITEM==0
IFN $STOPPER,<IFE $SBIT,<$ERROR(TOO MANY STOPPERS)>
$ITEM==$ITEM!$SBIT
.'ROOT==$SBIT
$SBIT==$SBIT_1>
IFN $KWSTST,<$ITEM==$ITEM!KWSTST>
IFN $SYMSTST,<$ITEM==$ITEM!SYMSTST>
IFN $DECSPEC,<$ITEM==$ITEM!DECSPEC>
IFN $EXPCONT,<$ITEM==$ITEM!EXPCONT>
RADIX 10
IFNB <PRIORITY>,<$PRIOR==PRIORITY>
IFNB <DISPATCH>,<$DC==DISPATCH>
IFNB <DISCRIMINATION>,<$DISC==DISCRIMINATION>
RADIX 8
IFNB <OTHER>,<$ITEM==$ITEM!OTHER>
$ITEM==$ITEM!$DC!<$PRIOR_4>!<$DISC_^D8>
EXTERN Z'ROOT
INTERN L$'ROOT,R$'ROOT
L$'ROOT==$ITEM_-^D18
R$'ROOT==$ITEM&777777>
;MACRO TO YIELD DISCRIMINATION VALUE OF GIVEN ROOT DELIMITER.
DEFINE DESC(ROOT) <R$'ROOT_-10&37>
$STOPPER==0
$EXPCONT==0
$KWSTST==0
$SYMSTST==0
$DECSPEC==0
$SBIT==1B12
ERRST==1B13 ;==1 IF DELIM. MAY RESTART SYNTAX PROCESSING DURING ERROR READ
EXPCONT==1B14 ;==1 IF DELIM. MAY FOLLOW EXPRESSION (WHILE TREATED SEPARATELY)
KWSTST==1B15 ;==1 IF DELIM. IS KEY WORD STATEMENT START
SYMSTST==1B16 ;==1 IF DELIM IS SYMBOL STATEMENT START
DECSPEC==1B17 ;==1 IF DELIM. IS A DECLARATION OR SPECIFICATION WORD
;THE NULL DELIMITER
;WARNING: THE NULL DELIMITER MUST BE ALL ZEROS.
DD PHID,0,0,0; DELIMITER: THE NULL DELIMITER
;SYMBOL STATEMENT STARTS (EXCEPT COLON)
$SYMSTST==1
$EXPCONT==1
DD ASS,2,8; DELIMITER: "_"
DD LBRA,12,1,,ERRST; DELIMITER: "["
DD LPAR,12,2,,ERRST; DELIMITER: "("
DD DOT,13,9; DELIMITER: "."
;KEY WORD STATEMENT STARTS (EXCEPT WHILE)
$SYMSTST==0
$EXPCONT==0
$KWSTST==1
DD IF,0,3; DELIMITER: "IF"
DD BEGIN,,10,,ERRST; DELIMITER: "BEGIN"
DD FOR,,11; DELIMITER: "FOR"
DD GOTO,,12; DELIMITER: "GOTO"
;PSEUDO-STATEMENT. ALLOWED AS BOTH DECL/SPECS AND STATEMENTS
$DECSPEC==1
DD LON,,14,0; DELIMITER: "LISTON"
DD LOFF,,,3; DELIMITER: "LISTOFF"
DD CON,,,7; DELIMITER: "CHECKON"
DD COFF,,,10; DELIMITER: "CHECKOFF"
DD LINE,,,12; DELIMITER: "LINE"
;WHILE IS BOTH A KEYWORD STATEMENT START AND EXPRESSION STOPPER
$DECSPEC==0
$STOPPER==1
DD WHILE,0,7,0; DELIMITER: "WHILE"
;COLON IS BOTH A SYMBOL STATEMENT START AND EXPRESSION STOPPER
$KWSTST==0
$SYMSTST==1
$EXPCONT==1
DD COLON,0,13; DELIMITER: ":"
;THE REST OF THE EXPRESSION STOPPERS
$SYMSTST==0
DD THEN,0,0; DELIMITER: "THEN"
DD DO,,,,ERRST; DELIMITER: "DO"
DD RBRA; DELIMITER: "]"
DD RPAR; DELIMITER: ")"
DD COM; DELIMITER: ","
DD ELSE; DELIMITER: "ELSE"
DD SC; DELIMITER: ";"
DD END; DELIMITER: "END"
DD EOF; DELIMITER: END OF FILE
DD STEP,,5; DELIMITER: "STEP"
DD UNTIL,,6; DELIMITER: "UNTIL"
;THE FOLLOWING VARIABLE DESCRIBES THE CLASS OF STOPPERS WHICH
;CANNOT BE "ACTIVE" AT THE TOP LEVEL OF THE PROGRAM (STMT LEVEL)
NOTTOP==.THEN!.DO!.RBRA!.RPAR!.STEP!.UNTIL!.WHILE
;THE FOLLOWING VARIABLE DESCRIBES THE CLASS OF STOPPERS WHICH
;ARE EXPUNGED FROM STOPS WHEN NONSENSE DELIMITER
;IS FOUND DURING EXPRESSION SELECTION...(SEE F3 & F4).
EXPUNGE==.WHILE!.COLON!.COM!.STEP!.UNTIL
;DECLARATION DELIMITERS
$STOPPER==0
$EXPCONT==0
$DECSPEC==1
DD EXTERNAL,0,15,0,0; DELIMITER: "EXTERNAL"
DD OWN,,,1,1_15; DELIMITER: "OWN"
DD FORWARD,,,2,2_15; DELIMITER: "FORWARD"
DD LABEL,,,3,3_15; DELIMITER: "LABEL"
DD VALUE,,,4,3_15; DELIMITER: "VALUE"
DD ARRAY,,,5,4_15; DELIMITER: "ARRAY"
DD PROCEDURE,,,6,5_15!ERRST; DELIMITER: "PROCEDURE"
DD SWITCH,,,7,6_15; DELIMITER: "SWITCH"
DD LONG,,,8,7_15; DELIMITER: "LONG"
DD REAL,,,9,10_15; DELIMITER: "REAL"
DD INTEGER,,,10,10_15; DELIMITER: "INTEGER"
DD BOOLEAN,,,11,10_15; DELIMITER: "BOOLEAN"
DD STRING,,,12,10_15; DELIMITER: "STRING"
DD COMPLEX,,,13,10_15; DELIMITER: "COMPLEX"
;NAMES OF CALL SITES AND TEST PATTERNS
OTHEN==1
OACTUAL==2
;OPERATOR DELIMITER LEXEMES
$DECSPEC==0
$EXPCONT==1
$ODROP==100000; BIT FOR REVERSIBLE OPERATOR
$ODCOP==200000; BIT FOR COMMUTATIVE OPERATOR
DD POW,11,4,00; DELIMITER: "^"
DD TIMES,10,,11,$ODCOP!$ODROP; DELIMITER: "*"
DD DIV,10,,15; DELIMITER: "DIV"
DD SLASH,10,,16; DELIMITER: "/"
DD REM,10,,17; DELIMITER: "REM"
DD UMINUS,10,,21; DELIMITER: UNARY "-"
DD UPLUS,10,,22; DELIMITER: UNARY "+"
DD PLUS,9,,24,$ODCOP!$ODROP; DELIMITER: "+"
DD MINUS,9,,28; DELIMITER: "-"
DD LSS,8,,33,$ODROP; DELIMITER: "<"
DD GTR,8,,35,$ODROP; DELIMITER: ">"
DD LEQ,8,,39,$ODROP; DELIMITER: "<=="
DD GTE,8,,41,$ODROP; DELIMITER: ">=="
DD EQ,8,,45,$ODCOP!$ODROP; DELIMITER: "=="
DD NE,8,,47,$ODCOP!$ODROP; DELIMITER: "#"
DD NOT,7,,49; DELIMITER: "NOT"
DD AND,6,,50,$ODCOP!$ODROP; DELIMITER: "AND"
DD OR,5,,51,$ODCOP!$ODROP; DELIMITER: "OR"
DD IMP,4,,52,$ODROP; DELIMITER: "IMP"
DD EQV,3,,53,$ODCOP!$ODROP; DELIMITER: "EQV"
;OPERATOR DELIMITER FIELDS
$OPDSP==000017; ; DISPATCH FIELD
$RELPR==000200; ; VALUE OF PRIORITY FIELD FOR RELATIONS (8)
$OPPRI==000360; ; PRIORITY FIELD
$OPDSC==077400; ; DISCRIMINATION FIELD (INDEX INTO OPCODE TABLE)
SUBTTL SYMBOL LEXEME MASKS AND VALUES
;SYMBOL TABLE EXTENDED BIT (BIT 0)
$X==400000
;MESSAGE GIVEN FOR UNDECLARED SYMBOL (BIT 1)
$MSG==200000
;BLOCK LEVEL (BITS 3-11)
$BL==077700
;PROCEDURE LEVEL (BITS 12-17)
$PL==000077
;DYNAMIC BIT (FOR PARAM. DESCRIP. WORD) (BIT 0)
$DYN==400000
;SERRL FIELD (BIT 0)
$SERRL==400000
$IDI==006000
$PHI==077000
;COMPOUND TYPE BITS
$TRANK==030000 ; TYPE RANK -- INDEX FOR INTEGER, REAL, LONG REAL
;DECLARE FIELD (BIT 12)
$DECL==000040
;ADDRESS MODES (BITS 13-17)
$AM==000037
$FIX==000000 ; FIXED -- NO PROCESSING NEEDED
$IMM==000001 ; IMMEDIATE CONSTANT
$CT==000003 ; CONSTANT IN CONSTANT TABLE
$PVAL==000006
$ST==000007 ; SIMPLE VARIABLE IN SYMBOL TABLE
$ACC==000014 ; EXPRESSION IN ACC
$SP==000022 ; EXPRESSION IN STACK
$AMPRV==000026 ; INDEXED BY ACC PREVIOUS TO ACC FIELD
$PRV==000026 ; INDEXED BY ACC PREVIOUS TO ACC FIELD
$SELF==000027 ; INDEXED BY ACC IN ACC FIELD
$ISP==000032 ; INDIRECT STACK POINTER FOR PTR IN STACK
$NEXT==000033 ; INDEXED BY ACC NEXT TO ACC FIELD
$PTR==000034 ; POINTER TO SUBSC. VAR. IN ACC
$REL==000035 ; RELOCATABLE ADDRESS
$RA==000036
$AX==000037 ; INDEXED BY AX
$PCT==000037
;COMPOUND ADDRESS MODE BITS
$AMAC==000003 ; NOT IN ACC
$STACK==000005 ; NOT ON STACK
$INDC==000020
$ABS==000022 ; NON-RELOCATABLE (IMM OR ACC)
$SINGL==000030 ; CONSTANT OR SIMPLE VARIABLE
$CONST==000034 ; IMMEDIATE OR TABLED CONSTANT
;LEXEX FIELDS
$LEXSA==000777 ; STACK ADDRESS
$LEXBL==777000 ; BLOCK LEVEL
;LONG BIT - USED IN DECSPEC FOR ASSEMBLING LEXEMES
$LONGBIT==000001
SUBTTL OPDEFS FOR PSEUDOS
;LONG REAL MOVE PSEUDOS
OPDEF LMOVE [700_33]
OPDEF LMOVEM [702_33]
OPDEF LMOVN [710_33]
OPDEF LMOVNM [712_33]
OPDEF LPUSH [701_33]
OPDEF DPUSH [701_33]
OPDEF LMOVM [714_33]
;TEMPCODE MACRO INSTRUCTIONS
OPDEF TCTHEN [703_33]
OPDEF TCELSE [704_33]
OPDEF TCFI [705_33]
OPDEF TCTO [706_33]
OPDEF TCOT [707_33]
OPDEF TCTYDES [711_33]
OPDEF TCSF [713_33]
OPDEF TCADDFIX [740_33]
;LONG REAL OPERATION PSEUDOS
OPDEF LFAD [716_33]
OPDEF LFSB [717_33]
OPDEF LFMP [720_33]
OPDEF LFDV [721_33]
OPDEF RLFSB [722_33]
OPDEF RLFDV [723_33]
;POWER PSEUDOS
OPDEF POWR1 [724_33]
OPDEF POWR2 [725_33]
OPDEF POWR3 [726_33]
OPDEF POWR4 [727_33]
OPDEF POWR5 [730_33]
;CONVERSION PSEUDOS
OPDEF CIR [731_33]
OPDEF CIL [732_33]
OPDEF CRI [733_33]
OPDEF CRL [734_33]
OPDEF CLI [735_33]
OPDEF CLR [736_33]
OPDEF ELI [737_33]
SUBTTL UTILITY TEST MACROS: $HALVE,TEST,SETONE,SETZERO
;THE FOLLOWING MACROS ARE USED AS UTILITY MACROS IN THE SENSE
;THAT THEY ARE USED BY OTHER MACROS.
; THESE MACROS TAKE A 36-BIT MASK AS ARGUMENT:
; ONE HALF OF MASK MUST BE ZERO
; THE OTHER HALF IS USED AS IMMEDIATE DATA
;MACRO TO SPLIT 36-BIT MASK INTO LEFT HALF AND RIGHT HALF.
DEFINE $HALVE(BITS)
<
LH==<BITS>_-^D18
RH==<BITS>&777777
IFN LH*RH,<$ERROR(BOTH HALVES OF IMMEDIATE ARE NON-ZERO)
>>
;TEST FOR COND(BLANK,E,A,N) IN REG AGAINST NON-ZERO HALF OF BITS
DEFINE TEST(COND,REG,BITS)
<
$HALVE(BITS)
IFN LH,<
TLN'COND REG,LH;*
>IFN RH,<
TRN'COND REG,RH;*
>>
; SET CELLS OF REG MASKED BY NON-ZERO HALF OF BITS TO ONES
DEFINE SETONE(REG,BITS)
<
$HALVE(BITS);
IFN LH,<
TLO REG,LH;*
>IFN RH,<
IORI REG,RH;*
>>
;SET CELLS OF REG MASKED BY NON-ZERO HALF OF BITS TO ZEROS
DEFINE SETZERO(REG,BITS)
<
$HALVE(BITS);
IFN LH,<
TLZ REG,LH;*
>IFN RH,<
ANDCMI REG,RH;*
>>
SUBTTL MACROS FOR DEFINING MACRO PREDICATES USED IN BOOLEAN EXP'S
;THE FOLLOWING TWO MACROS ARE USED TO DEFINE MACRO PREDICATES
;DEFBOOL(NAME,T) DEFINES A MACRO NAMED "NAME" WHICH HAS
; ONE ARGUMENT (A BIT PATTARN). "NAME" WILL TEST
; REGISTER T AND SKIP IF ANY SELECTED BITS ON
; OTHERWISE, IT WILL GOTO FALSE (OR TRUE) DE-
; PENDING ON THE TYPE OF STATEMENT IN WHICH THE
; BOOLEAN OCCURS (AS IS DIFFERENT FROM WHILE & IF)
;DEFNBOOL(NAME,T) SAME AS DEFBOOL EXCEPT THE TEST IS MADE ON
; THE OPPOSITE CONDITION
DEFINE DEFBOOL(NAME,REG)
<
DEFINE NAME(BITS)
<
IFN $BTYPE-$AS,<TEST(N,REG,BITS)
GOTO FALSE;*
>IFE $BTYPE-$AS,<TEST(E,REG,BITS)
GOTO TRUE;*
>>>
DEFINE DEFNBOOL(NAME,REG)
<
DEFINE NAME(BITS)
<
IFN $BTYPE-$AS,<TEST(E,REG,BITS)
GOTO FALSE;*
>IFE $BTYPE-$AS,<TEST(N,REG,BITS)
GOTO TRUE;*
>>>
SUBTTL DEFINITION OF MACRO PREDICATES: TEL,TNEL,DELEL,DELNEL,NDELEL,NDELNEL,TGB,TNGB
;BOOLEAN..."T IS AN ELEMENT OF BIT.ENCODED.SET"
DEFBOOL(TEL,T);
;BOOLEAN..."T IS NOT AN ELEMENT OF BIT.ENCODED.SET"
DEFNBOOL(TNEL,T);
;BOOLEAN..."DEL IS AN ELEMENT OF BIT.ENCODED.SET"
DEFBOOL(DELEL,DEL);
;BOOLEAN..."DEL IS NOT AN ELEMENT OF BIT.ENCODED.SET"
DEFNBOOL(DELNEL,DEL);
;BOOLEAN..."NDEL IS A MEMBER OF A BIT ENCODED SET"
DEFINE NDELEL(BITS)
<
MOVE T,NDEL;*
TEL(BITS)
>
;BOOLEAN..."NDEL IS NOT AN ELEMENT OF A BIT ENCODED SET"
DEFINE NDELNEL(BITS)
<
MOVE T,NDEL;*
TNEL(BITS)
>
;BOOLEAN..."ONE OF A SET OF GLOBAL BOOLEANS IS TRUE"
DEFBOOL(TGB,FL)
;BOOLEAN..."ALL OF A SET OF GLOBAL BOOLEANS ARE FALSE"
DEFNBOOL(TNGB,FL)
;SET GLOBAL BOOLEANS (GB) TRUE
DEFINE STRUE(BITS)
<
SETONE(FL,BITS)
>
;SET GLOBAL BOOLEANS FALSE
DEFINE SFALSE(BITS)
<
SETZERO(FL,BITS)
>
SUBTTL DEFINITION OF SSEL,ESEL AND LSEL
;THE FOLLOWING MACROS DEFINE THREE MACROS CALLED SSEL,ESEL AMD LSEL
;THE FOUR SELECTION MACROS ARE DEFINED AS FOLLOWS
;ESEL PROCESSES THE SYNTACTIC CONSTRUCTIONS:
; <ARITHMETIC EXPRESSION> AND <BOOLEAN EXPRESSION>
;SSEL PROCESSES THE SYNTACTIC CONSTRUCTION:
; <STATEMENT>
;LSEL PROCESSES THE SYNTACTIC CONSTRUCTION:
; <DESIGNATIONAL EXPRESSION>
;SINCE THESE SYNTACTIC CONSTRUCTIONS CAN APPEAR IN MANY CONTEXTS IN
;AN ALGOL PROGRAM, IT IS HELPFUL FOR THE 'SEL ROUTINE TO KNOW WHERE
;IT IS BEING CALLED FROM. THE FORMAL PARAMETER "SITE" SUPPLIES THIS
;INFORMATION. (THE SITE IS USELESS FOR FSEL, BUT IS PROVIDED FOR
;REASONS OF CONSISTENCY.) EACH MACRO HAS THE SAME STRUCTURE. THE
;WHILE TESTS EACH DELIMITER ENCOUNTERED TO DETERMINE WHETHER OR NOT
;IT IS A CLOSING DELIMITER FOR SOME OUTER ENCLOSING (DYNAMICALLY)
;PROCEDURE IF SO, THE 'SEL RETURNS TO ITS CALLER. OTHERWISE, IF
;ERROR LEVEL IS ON (INDICATING THAT A SYNTACTICALLY MALFORMED CON-
;STRUCTION HAS BEEN FOUND), THEN THE CONSTRUCTION IS PROCESSED BY
;ERREAD, UNTIL A TERMINATING DELIMITER IS FOUND. IF EVERYTHING IS OK,
;THEN THE PROPER SYNTAX ROUTINE FOR HANDLING THE DELIMITER CURRENTLY
;IN "DEL" IS CALLED USING A TRANSFER VECTOR. EACH 'SEL
;HAS ITS OWN TRANSFER VECTOR WHICH GUARANTEES THAT ONLY LEGAL
;ROUTINES ARE CALLED.
;IF SITE IS AN UNDEFINED SYMBOL (EG. IN CASE NO ROUTINE EVER
;TESTS AGAINST IT) THEN THE SELECT ROUTINE WILL IGNORE IT.
DEFINE SSELECT(SITE)
<
TRNN FL,TRPOFF;*
PUSHJ SP,.ESBLK##;*
LDB T,DCBYTE;*
PUSHJ SP,@STABLE(T);*
NOOP .SSEL!SITE;*
>
DEFINE ESELECT(SITE)
<
LDB T,DCBYTE;*
PUSHJ SP,@ETABLE(T);*
NOOP .ESEL!SITE;*
>
DEFINE LSELECT(SITE)
<
LDB T,DCBYTE;*
PUSHJ SP,@LTABLE(T);*
NOOP .LSEL!SITE;*
>
DEFINE FSELECT(SITE)
<
LDB T,DCBYTE;*
PUSHJ SP,@FTABLE(T);*
>
;IDENTIFICATION BITS FOR SELECT SITES.
.SSEL==1B18
.ESEL==1B19
.LSEL==1B20
.DECSEL==1B21
.SPSEL==1B22
.ERSEL==1B23
SSELTH==5
ESELTH==3;
LSELTH==3;
;MACRO TO GENERATE 'SEL MACROS
;..THIS MACHINE CODE IS EQUIVALENT TO...
;.. WHILE DEL NOT ELEMENT OF STOPS
;.. DO IF ERRL THEN ERREAD ELSE STYPE'SEL(SITE) FI OD;
DEFINE DEFSEL(STYPE)
<
DEFINE STYPE'SEL(SITE)
<
SELTH==STYPE'SELTH
TDNE DEL,STOPS;*
GOTO .+4+SELTH;*
TEST(E,FL,ERRL);*
PUSHJ SP,.ERR;*
STYPE'SELECT(SITE);*
GOTO .-4-SELTH;*
>
>
;BOOLEAN..."DEL NOT AN ELEMENT OF DYNAMIC SET OF STOPS"
DEFINE NOTSTOP
<
IFN $BTYPE-$AS,<
TDNE DEL,STOPS;*
GOTO FALSE;*
>IFE $BTYPE-$AS,<
TDNN DEL,STOPS;*
GOTO TRUE;*
>>
DEFSEL(S)
DEFSEL(E)
DEFSEL(L)
;MACRO SELECT LEFT HAND SIDE
DEFINE SLHS
<
IF DEL EQ LEFT BRACKET
CAME DEL,ZLBRA;*
GOTO FALSE;*
THEN
BEGIN
SBRACK;
NOOP .SSEL;
ENDD;
FI;
IF DEL EQ DOT
CAME DEL,ZDOT;*
GOTO FALSE;*
THEN
BEGIN
SDOT;
NOOP .SSEL;
ENDD;
FI;
>
SUBTTL DEF. OF FAIL AND STOPPER TEST MACROS
;FAIL ROUTINE MACRO
;THIS MACRO GENERATES A CALL ON THE FAIL ROUTINE
;ARGUMENTS HAVE THE FOLLOWING MEANING:
;N IS THE GODEL NUMBER FOR THE ERROR IN THE STANDARD
; ENUMERATION.
;ARG1 IS EITHER "HARD" OR "SOFT" INDICATING, RESPECTIVELY,
; WHETHER THE SCAN OF THIS CONSTRUCTION IS TO BE TERMIN-
; ATED OR CONTINUED.
;ARG2 IS EITHER "SYM", "DEL", "NSYM", OR "NDEL" DEPENDING
; ON WHICH ELEMENT OF THE WINDOW IS IN ERROR.
;TEXT IS AN IGNORED PARAMETER WHICH IS USED TO REMIND
; THE DESIGNERS OF THE CIRCUMSTANCES UNDER WHICH THIS
; ERROR CAN OCCUR. (IT IS USED FOR TRACING TOO.)
; [THAT WAS AN AMBIGUOUS COMMENT!]
SUSPSYN==20; SUSPEND SYNTAX PROCESSING
SUSPCOD==40; SUSPEND CODE GENERATION
SUSPSEM==1000; SUSPEND SEMANTICS CHECKING
..HARD==SUSPSYN!SUSPCOD
..SOFT==0
..FRIED==SUSPCOD!SUSPSEM
..IUO==100!SUSPCOD!SUSPSEM
..FATAL==200
..FVARY==400
..SYM==10
..DEL==4
..NSYM==2
..NDEL==1
DEFINE FAIL(N,ARG1,ARG2,TEXT)
<
PUSHJ SP,.FAIL;*
RADIX 10;*
XLIST
XWD <..'ARG1>!<..'ARG2>,N;*
LIST
RADIX 8;*
>
SUBTTL DEF. OF SEMERR MACRO
;SEMERR ROUTINE MACRO
;THE MACRO GENERATES A CALL TO .SER
;ARGUMENTS HAVE THE FOLLOWING MEANING:
;LEX THE LEXEME EXPECTED, IF THE IDENTIFIER HAPPENS TO BE UNDEFINED
;N THE INTEGER INDICATING THE KIND OF CONSTRUCTION EXPECTED
;TEXT IGNORED (AS IN FAIL ABOVE)
DEFINE SEMERR(N,LEX,TEXT)
<
PUSHJ SP,.SEMERR;*
XLIST
RADIX 10;*
XWD LEX,N;*
RADIX 8;*
LIST
>
;MACRO..."STX_STOPS"
DEFINE SAVESTOPS(X)
<
MOVEM STOPS,X;*
>
;MACRO..."STOPS_STOPS OR SET"
DEFINE ADDSTOPS(X)
<
SETONE(STOPS,X);*
>
;MACRO..."STX_STOPS"
DEFINE RESTOPS(X)
<
MOVE STOPS,X;*
>
;MACRO..."STX_STOPS;STOPS_STOPS OR SET"
DEFINE SETSTOPS(ARG1,ARG2)
<
SAVESTOPS(ARG1);*
ADDSTOPS(ARG2);*
>
;MACRO TO DELIMIT SEMANTICS AND CODE GENERATION
DEFINE CODE(C)
<
>
DEFINE ENDCODE
<
>
SUBTTL MACROS TO TEST SYMBOL LEXEMES.
DEFINE T.INIT(S)
<
IFIDN <$BTYPE><$AS>,<$ERROR TEST CANT BE USED IN AS>
IFB <S>,<T.REGZ==SYM>
IFNB <S>,<T.REGZ==S>
>
DEFINE DEFTEST(NAME,BITS)
<
DEFINE NAME(REG)
<
T.INIT(REG)
TLNE T.REGZ,BITS;*
GOTO FALSE;*
>
>
DEFTEST(T.VAR,$KIND-$VAR)
DEFTEST(T.I,$TYPE-$I)
DEFTEST(T.R,$TYPE-$R)
DEFTEST(T.LR,$TYPE-$LR)
DEFTEST(T.C,$TYPE-$C)
DEFTEST(T.B,$TYPE-$B)
DEFTEST(T.S,$TYPE-$S)
DEFTEST(T.L,$TYPE-$L)
DEFTEST(T.N,$TYPE-$N)
DEFTEST(T.PHI,$PHI)
DEFTEST(T.ARITH,$ARC)
DEFTEST(T.ONE,$VAR1)
DEFTEST(T.TWO,$VAR2)
DEFTEST(T.SIM,$STATUS-$SIM)
DEFTEST(T.IMM,$AM-$IMM)
DEFTEST(T.SINGLE,$SINGLE)
DEFTEST(T.ACC,$AMAC)
DEFTEST(T.CONST,$CONST)
SUBTTL TEST ("T.") MACROS FOR LEXEMES
DEFINE T.EXP(REG)
<
T.INIT(REG)
TLNE T.REGZ,$KIND;*
TLNE T.REGZ,$KIND-$EXP;*
GOTO FALSE;*
>
DEFINE T.ARR(REG)
<
T.INIT(REG)
TLNE T.REGZ,$KIND;*
TLNE T.REGZ,$KIND-$ARR;*
GOTO FALSE;*
>
DEFINE T.PRO(REG)
<
T.INIT(REG)
TLNE T.REGZ,200000;*
TLNN T.REGZ,100000;*
GOTO FALSE;*
>
DEFINE T.IRLR(REG)
<
TLNN REG,$IRLR;*
GOTO FALSE;*
>
DEFINE T.REG(REG)
<
T.INIT(REG)
TLNE T.REGZ,$STATUS;*
TLNE T.REGZ,$STATUS-$REG;*
GOTO FALSE;*
>
DEFINE T.OWN(REG)
<
T.INIT(REG)
TLNE T.REGZ,$STATUS;*
TLNE T.REGZ,$STATUS-$OWN;*
GOTO FALSE;*
>
DEFINE T.FOW(REG)
<
T.INIT(REG)
TLNE T.REGZ,$STATUS;*
TLNE T.REGZ,$STATUS-$FOW;*
GOTO FALSE;*
>
DEFINE T.FON(REG)
<
T.INIT(REG)
TLNE T.REGZ,000400;*
TLNN T.REGZ,000100;*
GOTO FALSE;*
TLNE T.REGZ,000200;*
GOTO FALSE;*
>
DEFINE T.FOV(REG)
<
T.INIT(REG)
TLNE T.REGZ,000400;*
TLNN T.REGZ,000200;*
GOTO FALSE;*
TLNE T.REGZ,000100;*
GOTO FALSE;*
>
DEFINE T.FORM(REG)
<
T.INIT(REG)
TLNE T.REGZ,000300
TLNN T.REGZ,000400
GOTO FALSE
>
DEFINE T.DECL(REG)
<
T.INIT(REG)
TLNN T.REGZ,$DECL;$
GOTO FALSE;$
>
DEFINE T.AE(REG)
<
T.INIT(REG)
TLNN T.REGZ,$ARR!$ARC;*
TLNN T.REGZ,$DECL;*
GOTO FALSE;*
>
DEFINE T.COGE(REG)
<
T.INIT(REG)
TLNN T.REGZ,$SINGLE
GOTO FALSE
>
DEFINE T.PTR(REG)
<
T.INIT(REG)
TLNN T.REGZ,$AMAC;*
TLNN T.REGZ,$INDC
GOTO FALSE
>
DEFINE T.STK(REG)
<
TLNE REG,$STACK;*
GOTO FALSE;*
>
DEFINE T.VIRGIN(REG)
<
T.INIT(REG)
TLNN T.REGZ,777770;*
TRNN T.REGZ,777777;*
GOTO FALSE;*
>
DEFINE T.OPER(OPCOD)
<
MOVE T,OP;*
CAME T,OPCOD;*
GOTO FALSE;*
>
DEFINE T.RELATION(REG)
<
MOVE REG,OP;*
TRNE REG,$OPPRI-$RELPRI;*
GOTO FALSE;*
>
DEFINE T.REV
<
TRNE REV,SYM-LOP;*
GOTO FALSE;*
>
DEFINE T.TOPLEV
<
TEST(E,STOPS,NOTTOP);*
GOTO FALSE;*
>
SUBTTL TEST-NOT ("TN.") MACROS FOR LEXEMES
DEFINE TN.I(REG)
<
TLNN REG,$TYPE-$I;*
GOTO FALSE;*
>
DEFINE TN.R(REG)
<
TLNN REG,$TYPE-$R;*
GOTO FALSE;*
>
DEFINE TN.LR(REG)
<
TLNN REG,$TYPE-$LR;*
GOTO FALSE;*
>
DEFINE TN.B(REG)
<
TLNN REG,$TYPE-$B;*
GOTO FALSE;*
>
DEFINE TN.L(REG)
<
T.INIT(REG)
TLNN T.REGZ,$TYPE-$L;*
GOTO FALSE;*
>
DEFINE TN.ARITH(REG)
<
TLNN REG,$ARC;*
GOTO FALSE;*
>
DEFINE TN.AC0(REG)
<
TLNE REG,$AM-$ACC;*
GOTO TRUE;*
TRNN REG,777777;*
GOTO FALSE;*
>
DEFINE TN.ACC(REG)
<
TLNN REG,$AM-$ACC;*
GOTO FALSE;*
>
DEFINE TN.SINGLE(REG)
<
TLNN REG,$SINGLE;*
GOTO FALSE;*
>
DEFINE TN.VIRGIN(REG)
<
T.INIT(REG)
TLNN T.REGZ,777770;*
JUMPN T.REGZ,FALSE;*
>
DEFINE TN.OPER(OPCOD)
<
MOVE T,OP;*
CAMN T,OPCOD;*
GOTO FALSE;*
>
DEFINE TN.TOPLEV
<
TEST(N,STOPS,NOTTOP);*
GOTO FALSE;*
>
SUBTTL STORE ("S.") MACROS FOR LEXEXES
DEFINE S.BL(NEWBL)
<
MOVE T,LEXEX;*
TLZ T,$LEXBL;*
OR T,NEWBL;*
MOVEM T,LEXEX;*
>
DEFINE S.CN(NEWCN)
<
MOVEM NEWCN,LEXEX+1;*
>
DEFINE S.SA(NEWSA)
<
MOVE T,LEXEX;*
TLZ T,$LEXSA;*
OR T,NEWSA;*
MOVEM T,LEXEX;*
>
SUBTTL FETCH ("F.") MACROS FOR LEXEMES
DEFINE F.TYPE(TMP,REG)
<
HLRZ TMP,REG;*
ANDI TMP,$TYPE;*
>
DEFINE F.TRANK(REG,LEX)
<
HLRZ REG,LEX;*
ANDI REG,$TRANK;*
LSH REG,-14;*
>
DEFINE F.LOCN(REG,LEX)
<
HRRZ REG,LEX;*
>
DEFINE F.DISC(REG)
<
MOVE REG,OP;*
ANDI REG,$OPDSC;*
LSH REG,-10;*
>
DEFINE F.BL(TMP,REG)
<
HLLZ TMP,LEXEX-REG+SYM;*
TLZ TMP,$LEXSA;*
>
DEFINE F.CN(TMP,REG)
<
MOVE TMP,LEXEX+1-REG+SYM;*
>
DEFINE F.SA(TMP,REG)
<
HLLZ TMP,LEXEX-REG+SYM;*
TLZ TMP,$LEXBL;*
>
SUBTTL MISCELLANEOUS MACROS
DEFINE MCALL(NAME)
<
PUSHJ SP,.PCALL;*
NOOP NAME;*
>
DEFINE MABSI(ARG)
<
MOVE T,[ARG];*
PUSHJ SP,.MABS;*
>
DEFINE FIXREL(LOC,VAL)
<
IFNB <LOC>,<
MOVE T,LOC;*
>
IFB <VAL>,<
PUSHJ SP,.RAFIX;*
>
IFNB <VAL>,<
MOVE T1,VAL;*
PUSHJ SP,.ADRFIX;*
>>
DEFINE FIXABS(LOC,VAL)
<
IFNB <LOC>,<
MOVE T,LOC;*
>
IFNB <VAL>,<
MOVE T1,VAL;*
>
PUSHJ SP,.ABSFIX;*
>
DEFINE FIXADD(LOC,VAL)
<
IFNB <LOC>,<
MOVE T,LOC;*
>
IFNB <VAL>,<
MOVE T1,VAL;*
>
PUSHJ SP,.ADDFIX;*
>
DEFINE SYMSAVE
<
MOVEM SYM,LOP;*
MOVE T,LEXEX;*
MOVEM T,LLEXEX;*
MOVE T,COMPNAME;*
MOVEM T,LCOMPNAME;*
>
DEFINE SYMRESTORE
<
MOVEM LOP,SYM;*
MOVE T,LLEXEX;*
MOVEM T,LEXEX;*
MOVE T,LCOMPNAME;*
MOVEM T,COMPNAME;*
>
;..SPLIT PLACES A JRST 0 IN OBCODE AND SAVES STATE INFORMATION
;..(IE. CAX AND RA) IN ITS ARGUMENT LOCATION;
;..JOIN PUTS OUT THE FIXUP FOR THAT JRST TO RA AND RESTORES
;..CAX TO ITS VALUE AT THE SPLIT. THE USE OF JOIN IMPLIES THAT
;..CONTROL MAY NEVER "FALL THROUGH" FROM THE PREVIOUS INSTRUCTION
;..BUT MUST ALWAYS COME FROM THE MATCHING SPLIT;
DEFINE SPLIT(ARG)
<
HRRZ T,RA;*
HRL T,CAX;*
MOVEM T,ARG;*
HRLZI T,<JRST 0>_-22;*
PUSHJ SP,.MABS;*
>
DEFINE JOIN(ARG)
<
IFNB <ARG>,<
MOVE T,ARG;*
>
HLRZM T,CAX;*
PUSHJ SP,.RAFIX;*
>
DEFINE STATEMENT(TYPE)
<
HRLZI SYM,$STMT!TYPE;*
>
DEFINE KILLAX
<
SETOM CAX;*
>
;..REGISTER ALLOCATION SCHEME.
;..INITIALIZATION, PRESERVATION, AND RESTORATION OF "LAC".
DEFINE LACINIT
<
MOVEI T,A13+1;*
MOVEM T,LAC;*
>
DEFINE LACSAVE(X)
<
MOVE T,LAC;*
MOVEM T,X;*
>
DEFINE LACRESTORE(X)
<
MOVE T,X;*
MOVEM T,LAC;*
>
;..SET REV TO MEAN THAT SYM IS SYM AND LOP IS LOP.
DEFINE REVER
<
MOVNI REV,SYM;*
>
SUBTTL MACROS FOR TEMPCODE MANIPULATIONS
;REOPEN AND CLOSE USE REGS T,T1, T2,T3;T4 IS NOT TOUCHED
;DIRECTION FOR USE: SEE MEMO ALGOL10-9,8
DEFINE REOPEN(REG)
<
IFB <REG>,<
SETZ T,
>
IFNB <REG>,<
MOVEI T,REG(REV)
>
PUSHJ SP,.REOPEN
>
DEFINE CLOSE(REG)
<
IFB <REG>,<
SETZ T,
>
IFNB <REG>,<
MOVEI T,REG(REV)
>
PUSHJ SP,.CLOSE
>
;EMITCODE USES T,T1,T2,T3; ONLY T4 IS NOT TOUCHED
;T CONTAINS OPCODE,T1 THE PAIR #,ACC,AND T2 CONTAINS TAD (TEMPADDRESS)
DEFINE EMITCODE(REG)
<
IFB <REG>,<
SETZI T2,
>
IFNB <REG>,<
MOVE T2,REG
>
PUSHJ SP,.EMITCODE
>
;PLUNK USES T,T1,T2;T3 AND T4 ARE UNDISTURBED
;T CONTAINS THE OPCODE,T1 THE ACC TO BE USED, AND
;T2 IS USED TO TRANSMIT THE TAD (WHICH IS TAKEN FROM
;REG IF IT IS NOT BLANK
DEFINE PLUNK(REG)
<
IFB <REG>,<
SETZI T2,
>
IFNB <REG>,<
MOVE T2,REG
>
PUSHJ SP,.PLUNK
>
;PLUNKI USES T,T1,T2; T3 AND T4 ARE UNDISTURBED
;T CONTAINS THE PREPARED INSTRUCTION
;IF REG IS NOT BLANK, TAD IS TAKEN FROM REG AND TRANSMITTED
;VIA T2
DEFINE PLUNKI(REG)
<
IFB <REG>,<
SETZI T2,
>
IFNB <REG>,<
MOVE T2,REG
>
PUSHJ SP,.IPLUNK
>
; LOAD MUST BE USED CAREFULLY
;IT EXISTS IN THREE VERSIONS:
;LOAD
;LOADN (LOAD NEGATIVE)
;LOADC (LOAD COMPLEMENT)
;REG BLANK MEANS SYM AND!!! OFFSET FROM LEXEX IS ZERO!!!
;BECAUSE REG NON-BLANK ASSUMES THAT REV HAS A SIGNIFICANT VALUE
;ACC BLANK MEANS TAD IS ALREADY IN T1
;ACC==13 MEANS:"USE FIRST AVAILABLE ACC"
;LOAD ASSUMES EITHER A CLOSED PORTION IN TEMPCODE OR
;A VAR. FOR WHICH NO CODE HAS BEEN GENERATED YET
;THE RESULT OF LOAD IS A COMPLETE PORTION (CLOSED) IN
;TEMPCODE WITH A MODIFIED LEXEME
;REG MUST BE EITHER SYM OR LOP (LEFT OPERAND(A REGISTER))
;IT IS ESSENTIAL THAT SYM - LOP == 2 FOR THE COMPUTATION OF
;THE OFFSET FROM LEXEX, WHICH DEPENDS ON THIS DIFFERENCE
;AND ON THE VARIABLE REV;
;REV==-SYM MEANS ORDER NOT REVERSED
;REV==-LOP MEANS ORDER HAS BEEN REVERSED
;THE REASON FOR THIS IS THAT IT IS THEN NOT NECESSARY TO
;EXCHANGE THE LEXEME EXTENSIONS WHEN THE LEXEMES ARE EXCHANGED
DEFINE LOAD(REG,ACC)
<
IFNB <ACC>,<
MOVEI T1,ACC
>
IFB <REG>,<
HRLI T1,<MOVE 0,(SYM+1)>_-22
>
IFNB <REG>,<
HRLI T1,<MOVE 0,(REG)>_-22
>
PUSHJ SP,.LOAD
>
DEFINE LOADN(REG,ACC)
<
IFNB <ACC>,<
MOVEI T1,ACC
>
IFB <REG>,<
HRLI T1,<MOVN 0,(SYM+1)>_-22
>
IFNB <REG>,<
HRLI T1,<MOVN 0,(REG)>_-22
>
PUSHJ SP,.LOAD
>
DEFINE LOADC(REG,ACC)
<
IFNB <ACC>,<
MOVEI T1,ACC
>
IFB <REG>,<
HRLI T1,<SETCM 0,(SYM+1)>_-22
>
IFNB <REG>,<
HRLI T1,<SETCM 0,(REG)>_-22
>
PUSHJ SP,.LOAD
>
;..W==1 MEANS ONE WORD OPERAND,W==2 MEANS TWO WORD OPERAND;
;..RESULT 23-BIT TAD IN T2; IF REG NB:REG<TAD>_T2;
DEFINE TOCT(W,REG)
<
IFE W-1, <
PUSHJ SP,.TOCT1
>
IFE W-2, <
PUSHJ SP,.TOCT2
>
IFNB <REG>,<
TLZ REG,$AM
TLO REG,$CT
HRR REG,T2
>
>
DEFINE FETCH(REG) ; REG MUST BE EITHER SYM OR LOP
<REOPEN(REG)
MOVE T2,REG
PUSHJ SP,.FETCH
MOVE REG,T4
>
DEFINE MOB(X)
<
PUSHJ SP,.MOB;*
NOOP X;*
>
;MACRO TO ADDRESS FIRST WORD OF SYMBOL TABLE ENTRY
DEFINE STW0 <0(SYM)>
; MACRO TO ADDRESS SECOND WORD OF A SYMBOL TABLE ENTRY
DEFINE STW1 <1(SYM)>
LIT
END