;
;
;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 F0R 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 MODULE(N)
<
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; ELSD 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