Google
 

Trailing-Edge - PDP-10 Archives - AP-D608C-SB - algcon.mac
There are 8 other files named algcon.mac in the archive. Click here to see a list.
;
;
;
;
;
;
;	COPYRIGHT (C) 1975,1976,1977,1978
;	DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;	THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
;	SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY 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 EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
;	AGREES TO THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
;	SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
;
;	THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
;	NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
;	EQUIPMENT CORPORATION.
;
;	DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;	SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
;
;; COPYRIGHT 1971,1972,1973 DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

; WRITTEN BY K. NIST, C.M.U./ EDITED BY R. M. DE MORGAN

	SEARCH ALGPRM		; MAIN PARAMETER FILE

	SALL

%TITLE(ALGCON,ALGOL COMPILER CONTROL MODULE)

	TWOSEG

	RELOC 400000

	MLON
;   THIS MODULE CONTAINS THE FOLLOWING ROUTINES:
;
;
;   .RINIT	".RINIT" WILL INITIALIZE THE READ MODULE AND WRITE MODULE.
;		".RINIT" WILL SCAN THE COMMAND STRING AND OPEN FILES,
;		INITIALIZE VARIABLES, AND ACQUIRE AND ALLOCATE SPACE
;		FOR TABLES.
;
;   .PINIT	".PINIT" IS CALLED BEFORE EACH ENTRY PROCEDURE TO
;		REINITIALIZE VARIABLES AND REALLOCATE TABLES.  ".PINIT"
;		IS AUTOMATICALLY DONE AS PART OF ".RINIT".
;
;   .RUND	".RUND" PERFORM LEXICAL SCANNING.  ".RUND" WILL "READ UNTIL
;		NEXT DELIMITER" AND THEN SHIFT THE WINDOW.  ".RUND" WILL
;		COMPUTE "LEXEX" AND "COMPNAME".
;
;   .SEARCH	".SEARCH" WILL SEARCH THE SYMBOL TABLE FOR AN IDENTIFIER
;		AND, OPTIONALLY, IF NOT FOUND WILL ENTER THE IDENTIFIER
;		INTO THE TABLE.
;
;   .STADD	".STADD" WILL ADD TO THE SYMBOL TABLE AN ENTRY FOR AN
;		IDENTIFIER WHOSE NAME DUPLICATES THE NAME OF AN EXISTING
;		IDENTIFIER.
;
;   .XTNDLB	".XTNDLB" WILL MAKE THE LAST ENTRY IN THE SYMBOL TABLE AN
;		EXTENDED ENTRY.
;
;   .TOFIX	".TOFIX" WILL ENTER A TYPE-15 FIXUP INTO THE FIXUP TABLE.
;
;   .CON1	".CON1" WILL ENTER A 1-WORD CONSTANT INTO THE CONSTANTS
;		TABLE.
;
;   .CON2	".CON2" WILL ENTER A 2-WORD CONSTANT INTO THE CONSTANTS
;		TABLE.
;
;   .FAILED	".FAILED" WILL ENTER AN ERROR MESSAGE INTO THE MESSAGE TABLE
;		TO BE INCLUDED IN THE LISTING.
;   .BLK1	".BLK1" IS CALLED AT THE BEGINNING OF A BLOCK TO ENTER INTO
;		THE LISTING THE MESSAGE "START OF BLOCK N".
;
;   .BLK2	".BLK2" IS CALLED AT THE END OF A BLOCK TO ENTER INTO THE
;		LISTING THE MESSAGE "END BLOCK N, CONT M".
;
;   .SCRUND	".SCRUND" WILL COMPUTE "LEXEX" AND "COMPNAME".
;
;   GETCS	"GETCS" WILL READ AND INTERPRET A COMMAND STRING.
;
;   LMSGZ	"LMSGZ" IS CALLED AT THE END OF A COMPILATION TO PRINT
;		THE REMAINING CONTENTS OF THE MESSAGE TABLE.
;
;   .STOVER	".STOVER" WILL HANDLE STACK OVERFLOWS.
;
;   INS		"INS" AND "TCHECK" ARE USED TO INSERT MESSAGES INTO
;   TCHECK	THE LISTING.
;
;   GETSPC	"GETSPC" IS USED TO ACQUIRE SPACE IN THE SYMBOL TABLE.
;
;   HAL		"HAL" WILL COMPUTE THE HASH VALUE AND NAME LENGTH FOR A
;		SYMBOL TABLE ENTRY.
;   TABLE ALLOCATION:

;
; TEMP   SYMBOL            FIXUP CONSTANTS    STACK
; CODE   TABLE             TABLE TABLE
;!      !                       !            !                       !
;!  \   !           \     /     !     \      !                 \     !
;!--->  !------------>   <------!------>     !------------------>    !
;!  /   !           /     \     !     /      !                 /     !
;!      !                       !            !                       !
; T      ST           N N        FC     N     CS                    C
; C      YC           A A        IO     A     OT                    O
; B      MM           S F        XN     C     NA                    R
; A      BA           T T        UT     T     EC                    E
; S      OX           E E        PA     E     NK                    N
; E      L                        B           DB                    D
;
;
;
;
;	TEMPCODE IS A BUFFER THAT RECEIVES PARTIALLY GENERATED CODE FOR
;	EXPRESSIONS. TEMPCODE CAN OVERFLOW IF THE COMPILER ENCOUNTERS
;	A SUPER-LARGE EXPRESSION.  WHEN THIS HAPPENS THE COMPILATION
;	ABORTS.   THE DEFAULT LENGTH OF TEMPCODE IS "TEMPL".  THE ALGOL
;	USER CAN OVER-RIDE THIS WITH THE /T SWITCH.
;
		IFNDEF	TEMPL,<
		TEMPL==400>
;
;
;	THE SYMBOL TABLE HAS ENTRIES FOR ALL IDENTIFIERS ACTIVE IN THE
;	USER'S PROGRAM.  THE FIXUP TABLE CONTAINS THE ACCUMULATED TYPE-15
;	LOADER BLOCK FIX-UPS.  THE SYMBOL TABLE AND FIXUP TABLE GROW
;	TOWARD EACH OTHER. IF THEY SHOULD MEET, CORE WILL BE EXPANDED
;	BY AN AMOUNT "DELTA", THE FIXUP TABLE, CONSTANTS TABLE, AND STACK
;	WILL BE MOVED UPWARD IN CORE BY AN AMOUNT "DELTA", AND THE COMPILATION
;	WILL CONTINUE.  THE COMBINED INITIAL LENGTH OF THE SYMBOL TABLE
;	AND FIXUP TABLE IS "TABLES".
;
		IFNDEF	TABLES,<
		TABLES==400>
;	THE CONSTANTS TABLE CONTAINS WHATEVER SINGLE AND DOUBLE PRECISION
;	FIXED AND FLOATING POINT CONSTANTS THAT CANNOT BE EXPRESSED AS
;	IMMEDIATES, AND ALSO STRINGS.  IF THE CONSTANTS TABLE SHOULD
;	OVERFLOW, CORE WILL BE EXPANDED BY AN AMOUNT "DELTA", THE STACK
;	WILL BE MOVED UPWARD IN CORE BY AN AMOUNT "DELTA", AND THE
;	COMPILATION WILL CONTINUE.  THE INITIAL LENGTH OF THE CONSTANTS
;	TABLE IS "CONL".
;
		IFNDEF	CONL,<
		CONL==30>
;
;
;
;	THE STACK CONTAINS "PUSH" AND "PUSHJ" DATA, AND OTHER BLOCKS OF
;	DATA.  WHEN THE STACK OVERFLOWS, CORE IS EXPANDED BY AN AMOUNT
;	"DELTA".  THE INITIAL LENGTH OF THE STACK IS "STACKL".
;
		IFNDEF	STACKL,<
		STACKL==100>
;
;
;
;	THE UPPER BOUND OF THE STACK IS "COREND". PLEASE NOTE THAT NOTHING
;	CAN GO INTO THE LOW SEGMENT ABOVE "COREND".
;
;
		IFNDEF	DELTA,<
		DELTA==100>
;
;
;
;	ALL BUFFER RINGS ARE COMPOSED OF BUFFERS OF STANDARD SIZE
;	FOR THE PARTICULAR DEVICE.  THE ALGOL USER CAN SELECT THE NUMBER
;	OF BUFFERS IN EACH RING WITH THE /B SWITCH.  THE DEFAULT NUMBER
;	OF BUFFERS IN EACH BUFFER RING IS:
;
		IFNDEF	SBUF,<		; SOURCE
		SBUF==2>

		IFNDEF	LBUF,<		; LISTING
		LBUF==2>

		IFNDEF	OBUF,<		; OBJECT CODE
		OBUF==2>
; 	REGISTER ASSIGNMENTS:

	FL==A0			; FLAGS REGISTER
;	A10-A13			; SAFE OVER READ MODDULE
	A14==14			; SAFE OVER READ MODULE
	DEL==15
	SYM==16
	SP==17			; STACK POINTER (SAFE OVER READ MODULE)

	STOPS==A7
	DBASE==A10


; 	READ MODULE FLAGS -- BIT ASSIGNMENTS (RFLAGS)

	EXISTS==400000		; LISTING FILE EXISTS
	LTTY==200000		; LISTING DEVICE IS A TTY
	CSDONE==100000		; COMMAND STRING SCANNED, COMPILATION STARTED
	SPAREN==40000		; PARENTHETICAL COMMAND STRING SWITCH
	TTY==20000		; SOURCE DEVICE IS A TTY
	ESWIT==10000		; LINE NUMBERS IN COLS 73-80
	NSWIT==4000		; NO ERROR PRINTOUTS ON TTY
	COMPLETE==2000		; 1 = LISTING COMPLETE AND CLOSED
	TMG==1000		; TERMINATION MESSAGE GIVEN
	ELINE==400		; EDITORS LINE NUMBER SCANNED
	BLANKL==200		; BLANK LINE BEING SCANNED
	WITHIN==100		; WITHIN NEWLINE ROUTINE
	ONECHS==40		; 1 CHARACTER SWITCH SCANNED
	STATS==20		;  STATS REQUESTED.
; 	ACCUMULATOR ZERO -- BIT ASSIGNMENTS

; **************************************************
; *                                                *
; *     W A R N I N G    ! ! ! ! ! ! ! ! ! ! !     *
; *                                                *
; *  THIS  M U S T  AGREE WITH GB DEFINITIONS      *
; *           IN FILE ALGMAC !!!                   *
; *                                                *
; **************************************************


	TRLOFF==20000		; DON'T PLANT TRACE INFO ( IMPLIES TRPOFF)
	TRPOFF==10000		; DON'T MAKE SYMBOL BLOCKS
	CREF==4000		; /CREF - PRODUCE O/P FOR CROSS-REF PROGRAM
	ACOFF==2000		; /CHECKOFF - FORCE NO ARRAY-BOUND CHECKS
	ACON==1000		; /CHECKON - FORCE ARRAY-BOUND CHECKS
	OBOO==400		; OBJECT CODE LISTING ON/OFF FLAG
	NOENTR==200		; 1 => MAKE NO NEW ENTRIES IN SYMBOL TABLE
	ACOO==100		; ARRAY-BOUND CHECKING IN FORCE
	LNOO==40		; LINE-NUMBERS ON/OFF FLAG
	LISTOO==20		; LISTON/LISTOFF SWITCH
	DECLAR==10		; DECLARATION MODE
	BPAIR==4		; SCANNING A BOUND PAIR
	ERRF==2			; FATAL ERROR FOUND. NO CODE GENERATED
	ERRL==1			; SCANNING IN ERROR-LABEL


;	OTHER RANDOM BITS

	USE==400000		; BUFFER USE BIT
	EXACT==400000		; USE EXACT POINTER FOR ERROR MSG UP-ARROW
	DEVTTY==10		; DEVCHR TTY BIT


	RWTRT==-1
	RWTLNK==0
	RWTLEN==0
	RWTLEX==1
	RWTNAM==2
	SYMBLK==0
	SYMLNK==0
	SYMTYP==1
	SYMNAM==2
	.FAILE=FAILED
	INTERN	.PINIT
	INTERN	.BLK1
	INTERN	.BLK2
	INTERN	.FAILE
	.LSCAN=LSCAN
	INTERN	.LSCAN
	.RINIT=RINIT
	INTERN	.RINIT
	.SEARCH=SEARCH
	INTERN	.SEARCH
	.STADD=STADD
	INTERN	.STADD
	.GETSPC=GETSPC
	INTERN	.GETSPC
	.RUND=RUND
	INTERN	.RUND
	.XTNDL=XTNDLB
	INTERN	.XTNDL
	.HAL=HAL
	INTERN	.HAL
	.CON1=CON1
	INTERN	.CON1
	.CON2=CON2
	INTERN	.CON2
	INTERN	.SCRUND
	INTERN	.TOFIX
	INTERN	.STOVE
	INTERN	COREB
	INTERN	CSBLK
	INTERN	CHKSUM
	INTERN	CCLSW
	INTERN	SRCEMC
	INTERN	TARGMC
	INTERN	PRNAME
	INTERN	OFILE

	EXTERN	.JBERR
	EXTERN	.HELPR
	EXTERN	.JBREL
	EXTERN	.FAIL
	EXTERN	.JBAPR
	EXTERN	.JBTPC
	EXTERN	.JBFF
	EXTERN	.JBDDT
	BLKLEV=BLOCKL
	..HARD==60
	..SOFT==0
	..FRIED==1040
	..IUO==1140
	..FATAL==200
	..FVARY==400
	..SYM==10
	..DEL==4
	..NSYM==2
	..NDEL==1
	..IMM==20000
	..IUO2==100
	SUSPCO==40



	RELOC 0

	DEFINE	FAIL(NNN,ARG1,ARG2,TEXT)
	<
	PUSHJ	SP,FAILX
	XWD	<<..'ARG1+..'ARG2>&<777777>>,^D'NNN
	>




FAILX:	BLOCK	5		; INITIALISED FROM HISEG AT START1.

;	PUSH	SP,A1		; SAVE A1
;	PUSH	SP,A2		; SAVE A2
;	MOVE	A1,@-2(SP)	; GET PARAM
;	MOVEM	A1,FAILX1	; SAVE IT
;	PUSHJ	SP,.FAIL	; CALL FAIL ROUTINE

FAILX1:	BLOCK	5
;	XWD	0,0		; PARAM WILL BE PUT HERE
;	POP	SP,A2		; RESTORE A2
;	POP	SP,A1		; RESTORE A1
;	AOS	(SP)		; SKIP RETURN
;	POPJ	SP,		; EXIT FAILX

	RELOC


	$IMM==1			; CONSTANT, SIMPLE
	$CT==3			; CONSTANT, REGULAR
	$ST==7			; VARIABLE, SIMPLE
	$SYMB==4		; THIS BIT ON IMPLIES A SIMPLE VARIABLE
;    FORMAT OF A RESERVED WORD TABLE ENTRY
;
;	EACH ENTRY IN THIS TABLE IS LINKED INTO ONE OF 26 SUB-LISTS (ONE
;	FOR EACH LETTER OF THE ALPHABET) WHOSE HEADS CAN BE FOUND USING
;	THE "RESERVED WORD HASH TABLE".  WHICH SUB-LIST THAT AN ENTRY IS LOCATED
;	ON DEPENDS UPON THE FIRST LETTER OF THE NAME OF THE DELIMITER WORD.
;
;	ALL ENTRIES IN THE TABLE THAT ARE LOCATED BEFORE THE ADDRESS "FRW"
;	ARE CONSIDERED FLAGGED, AND THE WORD PRECEDING THESE ENTRIES MUST
;	CONTAIN THE ADDRESS OF A ROUTINE THAT WILL PERFORM THE SPECIAL PROCESSING
;	FOR THAT DELIMITER WORD.  OTHER THAN THIS, NEITHER THE POSITION OF
;	A DELIMITER WORD IN THE TABLE NOR ITS POSITION ON A SUB-LIST IS
;	CRITICAL,  ALTHOUGH DELIMITERS ON A SUB-LIST SHOULD BE ARRANGED IN
;	ORDER OF FREQUENCY OF USAGE.
;
;	THE RIGHT HALF OF THE FIRST WORD OF AN ENTRY CONTAINS THE SUB-LIST
;	LINK.  THE LEFT HALF CONTAINS EITHER A 0 OR A -1, DEPENDING ON WHETHER
;	THE DELIMITER NAME WILL TAKE UP 1 WORD OR 2, RESPECTIVELY.  THE SECOND
;	WORD OF THE ENTRY CONTAINS THE COMPLETE LEXEME FOR THE DELIMITER.
;	THE THIRD AND FOURTH WORDS OF THE ENTRY CONTAIN THE NAME OF THE DELIMITER.
;	THERE IS NO FOURTH WORD IF THE NAME IS ONLY 1 WORD LONG (5 CHARACTERS
;	OR LESS).



	DEFINE	N1(NAM,LN)
	<
					<373737373737>&<LN-1+SIXBIT/NAM/>
	>

	DEFINE	N2(NAM)
	<
					<373737373737>&<SIXBIT/NAM/>
	>
	DEFINE LEX(ROOT)
	<
	INTERN	Z'ROOT
	EXTERN	L$'ROOT,R$'ROOT
Z'ROOT:	XWD	L$'ROOT,R$'ROOT>

;	***  RESERVED WORD TABLE  ***

	FBEGIN
FB:	FB1		; BEGIN
	LEX(BEGIN)
	N1(NIGEB,5)

	FEND
FE:	FE1		; END
	LEX(END)
	N1(DNE,3)

	FFALSE
FF1:	FF2		; FALSE
	0
	N1(ESLAF,5)

	FGO
FG1:	0		; GO
	LEX(GOTO)
	N1(OG,2)

	COMNT2
FC:	XWD	-1,FC1	; COMMENT
	0
	N1(EMMOC,7)
	N2(TN)

	FTRUE
FT1:	0		; TRUE
	0
	N1(EURT,4)
FRW:	;  ALL PRECEDING RESERVED WORDS ARE FLAGGED.

FA:
	.+3		; ARRAY
	LEX(ARRAY)
	N1(YARRA,5)

	0		; AND
	LEX(AND)
	N1(DNA,3)

FB1:
	XWD	-1,0	; BOOLEAN
	LEX(BOOLEAN)
	N1(ELOOB,7)
	N2(NA)


FC1:
	XWD	-1,.+4	; COMPLEX
	LEX(COMPLEX)
	N1(LPMOC,7)
	N2(XE)


	XWD	-1,.+4	; CHECKON
	LEX(CON)
	N1(KCEHC,7)
	N2(NO)

	XWD	-1,0	; CHECKOFF
	LEX(COFF)
	N1(KCEHC,8)
	N2(FFO)

FD:
	.+3		; DO
	LEX(DO)
	N1(OD,2)

	0		; DIV
	LEX(DIV)
	N1(VID,3)
FE1:
	.+3		; ELSE
	LEX(ELSE)
	N1(ESLE,4)

	XWD	-1,.+4	; EXTERNAL
	LEX(EXTERNAL)
	N1(RETXE,8)
	N2(LAN)

	0		; EQV
	LEX(EQV)
	N1(VQE,3)

FF:
	FF1		; FOR
	LEX(FOR)
	N1(ROF,3)

FF2:
	XWD	-1,0	; FORWARD
	LEX(FORWARD)
	N1(AWROF,7)
	N2(DR)

FG:
	FG1		; GOTO
	XWD	L$GOTO,R$GOTO
	N1(OTOG,4)

FI:
	.+3		; IF
	LEX(IF)
	N1(FI,2)

	XWD	-1,.+4	; INTEGER
	LEX(INTEGER)
	N1(GETNI,7)
	N2(RE)

	0		; IMP
	LEX(IMP)
	N1(PMI,3)
FLL:
	.+3		; LABEL
	LEX(LABEL)
	N1(LEBAL,5)

	.+3		; LONG
	LEX(LONG)
	N1(GNOL,4)


	XWD	-1,.+4	; LISTON
	LEX(LON)
	N1(OTSIL,6)
	N2(N)

	XWD	-1,.+4	; LISTOFF
	LEX(LOFF)
	N1(OTSIL,7)
	N2(FF)

	0		; LINE
	LEX(LINE)
	N1(ENIL,4)

FN:
	0		; NOT
	LEX(NOT)
	N1(TON,3)

FO:
	.+3		; OWN
	LEX(OWN)
	N1(NWO,3)

	0		; OR
	LEX(OR)
	N1(RO,2)

FP:
	XWD	-1,0	; PROCEDURE
	LEX(PROCEDURE)
	N1(ECORP,9)
	N2(ERUD)
FR:
	.+3		; REAL
	LEX(REAL)
	N1(LAER,4)

	0		; REM
	LEX(REM)
	N1(MER,3)


FS:
	.+3		; STEP
	LEX(STEP)
	N1(PETS,4)

	XWD	-1,.+4	; STRING
	LEX(STRING)
	N1(NIRTS,6)
	N2(G)

	XWD	-1,0	; SWITCH
	LEX(SWITCH)
	N1(CTIWS,6)
	N2(H)

FT:
	FT1		; THEN
	LEX(THEN)
	N1(NEHT,4)

FU:
	0		; UNTIL
	LEX(UNTIL)
	N1(LITNU,5)

FV:
	0		; VALUE
	LEX(VALUE)
	N1(EULAV,5)

FW:
	0		; WHILE
	LEX(WHILE)
	N1(ELIHW,5)
;	** RESERVED WORD HASH TABLE **

RESWRD:	FA
	FB
	FC
	FD
	FE
	FF
	FG
	0
	FI
	0
	0
	FLL
	0
	FN
	FO
	FP
	0
	FR
	FS
	FT
	FU
	FV
	FW
	0
	0
	0
;   SPECIAL CHARACTERS

	.TAB==11
	.LF==12
	.VT==13
	.FF==14
	.CR==15
	.CZ==32
	.ALT1==33
	.CLEFT==37
	.SPACE==" "
	.EXCL=="!"
	.DQUOT==""""
	.$=="$"
	.%=="%"
	.AMPER=="&"
	.LPAREN=="("
	.RPAREN==")"
	.STAR=="*"
	.PLUS=="+"
	.COMMA==","
	.MINUS=="-"
	.DOT=="."
	.SLASH=="/"
	.N0=="0"
	.N7=="7"
	.N9=="9"
	.COLON==":"
	.SEMI==";"
	.EQUAL=="="
	.QUESTION=="?"
	.AAAAA=="@"
	.A=="A"
	.B=="B"
	.E=="E"
	.I=="I"
	.O=="O"
	.T=="T"
	.Z=="Z"
	.LBRAC=="["
	.RBRAC=="]"
	.UP=="^"
	.LEFT=="_"
	.ALT2==175
	.ALT3==176

	.CRF==SIXBIT/   CRF/
	.LST==SIXBIT/   LST/
	.REL==SIXBIT/   REL/
	.ALG==SIXBIT/   ALG/
	.DSK==SIXBIT/   DSK/
	.TMP==SIXBIT/   TMP/
SUBTTL ** RINIT **

;	READ MODULE INITIALIZATION ROUTINE

RINIT:	MOVEM	A1,LINK		; SAVE RETURN LINK
	CLOSE	3,0		; CLOSE SOURCE FILE, IF OPEN
	CLOSE 	5,0		; CLOSE COMMAND STRING FILE, IF OPEN
	MOVE	SP,[		; LOAD A STACK POINTER
	XWD	-46,TMPBUF]	; TEMPORARILY USE TMPBUF AS A STACK

; IF THIS IS NOT THE 1ST CALL TO ".RINIT" THEN THE LISTING FROM
; THE PREVIOUS COMPILATION MIGHT NOT YET BE COMPLETE, AND ALSO
; THE REL-FILE MIGHT NOT YET BE CLOSED NOR DELETED IF IT IS TO
; BE DELETED.

	MOVE	A7,RFLAGS	; GET OLD READ MODULE FLAGS
	MOVE	A4,COREB	; GET OLD VALUE OF CORE
	XORI	A4,RANDOM	; CODE IT
	CAME	A4,CHKSUM	; IF VALUE OF CORE NOT VALID
	JRST	START1		; THEN SKIP THIS PART
	SKIPL	WFLAG		; UNLESS REL-FILE IS TO BE DELETED
	JRST	START0		; SKIP OVER THIS PART

	; DELETE REL-FILE

	SKIPE	OFILE		; IF THERE IS NO REL FILE
	CLOSE	1,40		; DON'T SUPERSEDE
	SETZM	WFLAG		; CLEAR THE WRITE MODULE FLAG

	; COMPLETE THE LISTING

START0:;	TLNE	A7,COMPLETE	; IF PREVIOUS RUN'S LISTING IS COMPLETE
	;	JRST	START		; THEN SKIP THIS PART
	PUSHJ	SP,CREFNL	; CLOSE OFF ANY CREF INFO
	MOVEI	A1,NLCHRS	; PUT A BLANK LINE IN LISTING
	PUSHJ	SP,INSERT
	SKIPN	A1,.JBERR	; IF THERE ARE NO ERRORS
	SKIPA	A1,[[ASCIZ/No/]]; THEN SAY SO
	PUSHJ	SP,LPRINT	; CONVERT TO DECIMAL ASCII
	PUSHJ	SP,DONE1	; INCLUDE IT IN LISTING
	MOVE	A1,.JBERR
	CAIN	A1,1		; DON'T USE SOJG - DONE1 NEEDS .JBERR
	SKIPA	A1,[[ASCIZ/ error
/]]
	MOVEI	A1,ERRORM	; " ERRORS"
	PUSHJ	SP,DONE1	; INCLUDE IN LISTING
	IFN FTSTATS,<
	TLNN	A7,STATS	;  STATS ?
	JRST	START3		;  NO
	MOVEI	A1,[ASCIZ/
Number of identifiers = /]	; 
	PUSHJ	SP,DONE2	; 
	MOVE	A1,DEFCNT	; 
	PUSHJ	SP,LPRINT	; 
	PUSHJ	SP,DONE2	; 
	MOVEI	A1,[ASCIZ/
Average characters in each = /]	; 
	PUSHJ	SP,DONE2	; 
	MOVE	A1,IDCHRS	; 
	IDIV	A1,DEFCNT	; 
	ADDI	A1,1		; 
	PUSHJ	SP,LPRINT	; 
	PUSHJ	SP,DONE2	; 
	MOVEI	A1,[ASCIZ/
Number of identifier references = /] ; 
	PUSHJ	SP,DONE2	; 
	MOVE	A1,REFCNT	; 
	PUSHJ	SP,LPRINT	; 
	PUSHJ	SP,DONE2	; 
	MOVEI	A1,NLCHRS	; 
	PUSHJ	SP,DONE2	; 

START3:	>
	MOVEI	A1,LINES3	; PUT 3 BLANK LINES
	PUSHJ	SP,INSERT	; IN LISTING
	TLNE	A7,EXISTS	; IF LISTING EXISTS,
	PUSHJ	SP,WRITEL	; WRITE OUT THIS BUFFER
START:	CLOSE	1,0		; CLOSE REL-FILE
	CLOSE	2,0		; CLOSE LISTING
	JRST	START1+1	; SKIP NEXT INSTRUCTION

START1:	SETOM	CSCOMP		; MARK COMMAND STRING TO BE READ
	SKIPN	.JBDDT		; UNLESS DDT IS LOADED...
	RESET			; RESET IO
	MOVE	A4,.JBFF	; ADD ADDRESS OF FREE CORE
	XORI	A4,RANDOM	; HASH IT
	MOVEM	A4,CHKSUM	; SET CHECK SUM
	HRRZ	A5,.JBFF	; GET START OF FREE CORE
	MOVEM	A5,COREB	; SET BASE OF CORE

	; ***  BEGIN THE CURRENT COMPILATION  ***

	IFE	FTSYM,<
	MOVEI	FL,TRPOFF	; DEFAULT TO NO SYMBOLS (TYPE 1044 BLOCKS)
	>
	IFN	FTSYM,<
	SETZ	FL,		; CLEAR FLAG REGISTER>
	MOVE	A7,IFLAGS	; GET A NEW SET OF FLAGS
	SETZB	A5,DYNOWN	; CLEAR OUR PROCESSOR TO KA, AND INITIAL HEAP SIZE
	MOVEI	A4,TEMPL	; DEFAULT LENGTH OF TEMPCODE
	MOVEM	A4,LTCODE	; SET LENGTH OF TEMPCODE
	MOVEI	A1,RLIST	; READ MODULE INIT LIST
	PUSHJ	SP,BMOVE	; INITIALIZE READ MODULE FROM HIGH SEG
	HRLOI	A4,377776
	AOBJN	A4,.+2		; IS IT A KI10?
	SETO	A5,		; YES
	MOVEI	A4,0
	BLT	A4,0
	JUMPE	A4,.+2		; KL ?
	MOVEI	A5,777777	; YES
	MOVEM	A5,SRCEMC	; FLAG SOURCE AND
	MOVEM	A5,TARGMC	;  TARGET M/C'S (BY DEFAULT)
	MOVEI	A4,600000	; SET PROCESSOR TO TRAP ON
	APRENB	A4,		; A PUSHDOWN OVERFLOW
	SKIPA	A4,.+1		; SET THE RESERVED WORD TABLE POINTER
	XWD	A1,RESWRD-.A	; TO THE ACTUAL RESERVED WORD TABLE
	MOVEM	A4,RWS		; SET IT
	SKIPE	.JBDDT		; SPECIAL MESSAGE IF
	SKIPE	CCLSW		; NOT CCL-MODE AND
	JRST	START2
	TTCALL	3,DDTMSG	; DDT HAS BEEN LOADED

	; PROCESS COMMAND STRING

START2:	MOVEI	A4,OBUF		; DEFAULT NUMBER OF OBJECT BUFFERS
	MOVEM	A4,OLIST+7	; SET IT
	MOVEI	A4,LBUF		; DEFAULT NUMBER OF LISTING BUFFERS
	MOVEM	A4,LLIST+7	; SET IT
	MOVEI	A4,SBUF		; DEFAULT NUMBER OF SOURCE BUFFERS
	MOVEM	A4,SLIST+7	; SET IT
	SKIPN	CSCOMP		; IF PREVIOUS COMMAND STRING NOT EMPTY
	JRST	.+4		; THEN DONT READ ANOTHER
	SKIPGE	CCLSW		; IF CCLSW = -1
	JRST	QUIT		; THEN NOTHING MORE TO COMPILE
	PUSHJ	SP,GETCS	; READ IN THE COMMAND STRING
	; SCAN OBJECT CODE FILE NAME

	MOVEI	A4,.REL		; EXTENSION NAME DEFAULT
	MOVSM	A4,OFILE+1	; SET DEFAULT
	MOVEI	A1,OLIST	; OBJECT CODE PARAM LIST
	PUSHJ	SP,SCAN2	; SCAN NAME

	; SCAN LISTING FILE NAME

	MOVEI	A4,.DSK		; LISTING DEVICE DEFAULT
	MOVSM	A4,LLIST+1	; SET IT
EDIT(042); DONT USE OLD LISTING FILE NAME AGAIN
	SETZM	LFILE		; [E042] CLEAR LISTING FILE NAME
	CAIE	A6,.LEFT	; _?
	CAIN	A6,.EQUAL	; OR =?
	JRST	CS1		; -YES, NEXT SCAN SOURCE FILES
	CAIE	A6,.COMMA	; IF TERMINATING CHAR NOT A COMMA
	JRST	CSER		; THEN COMMAND STRING ERROR
	MOVEI	A4,777777	; EXTENSION NAME DEFAULT - GARBAGE
	MOVSM	A4,LFILE+1	; SET DEFAULT VALUE
	MOVEI	A1,LLIST	; LISTING PARAM LIST
	PUSHJ	SP,SCAN2	; SCAN NAME
	CAIN	A6,.LEFT	; _?
	JRST	CS1		; YES
	CAIE	A6,.EQUAL	; =?
	JRST	CSER		; NO - COMMAND STRING ERROR

	; SCAN SOURCE FILE NAME

CS1:	TRO	FL,LISTOO	; TURN LISTING ON
	PUSHJ	SP,SCAN3	; SCAN 1ST SOURCE FILE AND OPEN IT	
	JRST	CS5		; CONTINUE
	; SCAN SOURCE FILE NAME AND OPEN IT. DEV:FILE.EXT[123,456]/A/B

SCAN3:	MOVEI	A4,.ALG		; EXTENSION NAME DEFAULT
	MOVSM	A4,SFILE+1	; SET DEFAULT
	MOVEI	A1,SLIST	; SOURCE PARAM LIST
	PUSHJ	SP,SCAN2	; SCAN NAME
	CAIE	A6,.COMMA	; IF THE LAST CHAR IS NOT A COMMA
	JRST	CS12		; THEN SKIP THIS PART
	AOS	CSCOMP		; MARK: LINE NOT COMPLETELY SCANNED
	JRST	CS14		; CONTINUE

CS12:	CAIE	A6,.CR		; IF IT IS NOT A CR
	JRST	CS13		; THEN SKIP THIS PART
	PUSHJ	SP,SCANCH	; STEP OVER THE LINE FEED
	PUSHJ	SP,SCANCH	; READ THE NEXT CHAR
	JRST	CS12		; TRY AGAIN


CS13:	CAIG	A6,0		; IF IT IS A NULL OR OTHER TERMINATOR
	SETOM	CSCOMP		; THEN MARK: END OF COMMAND STRING
	HRLZI	A4,070000	; BYTE POINTER BACK-UP CONSTANT
	ADDM	A4,CSP		; BACK UP THE COMMAND STRING POINTER

CS14:	TLZ	A7,TTY		; CLEAR TTY FLAG
	MOVE	A5,SLIST+1	; GET SOURCE DEVICE NAME
	DEVCHR	A5,		; WHAT IS DEVICE?
	TLNE	A5,DEVTTY	; IS IT A TTY?
	TLO	A7,TTY		; YES - SET FLAG BIT

	; OPEN SOURCE DEVICE

	OPEN	3,SLIST		; OPEN SOURCE DEVICE
	JRST	DSERR1		; -SOMETHING WRONG
	TLNE	A7,CSDONE	; UNLESS THIS IS THE 1ST SOURCE FILE IN
	JRST	CS11		; THE COMMAND STRING, SKIP THIS PART
	; ESTABLISH SOURCE BUFFER RING

	MOVE	A5,SLIST+7	; GET NUMBER OF BUFFERS
	MOVEI	A1,(A5)		; COPY TO A1
	IMULI	A1,204		; EACH BUFFER TAKES UP 204 WORDS
	PUSHJ	SP,ALLOCATE	; GET SPACE FOR THESE BUFFERS
	ADD	A1,[		; SET REGISTER A1 TO LOOK LIKE
	XWD	202,1]		; A BUFFER LINK WORD
	HRRZM	A1,OLDSBR	; SAVE ADDRESS OF SOURCE BUFFER RING
	JRST	.+3		; JUMP INTO LOOP

	MOVEM	A1,204(A1)	; SET NEXT BUFFER TO POINT TO THIS BUFFER
	ADDI	A1,204		; STEP TO NEXT BUFFER
	SOJG	A5,.-2		; LOOP
	MOVEM	A1,@OLDSBR	; SET LINK WORD OF 1ST BUFFER


CS11:	MOVE	A4,OLDSBR	; GET OLD SOURCE BUFFER RING
	HRLI	A4,400000	; TURN ON USE BIT
	MOVEM	A4,BHEAD3	; USE FOR THE CURRENT FILE ALSO
	HRLI	A4,000700	; S-P BITS
	MOVEM	A4,BHEAD3+1	; SET UP BYTE POINTER

	; FIND SOURCE FILE

CS9:	LOOKUP	3,SFILE		; SELECT SOURCE FILE
	JRST	DSERR2		; FILE DOESNT EXIST
	POPJ	SP,		; EXIT SCAN3
SUBTTL	**  COMMAND STRING ROUTINES  **

	; SCAN A FILE NAME ELEMENT (DEV, FILE, OR EXT)

SCAN1:	SETZ	A3,0		; CLEAR A3
	SKIPA	A2,.+1
	POINT	6,A3		; SET UP OUTPUT POINTER

CS8:	PUSHJ	SP,SCANCH	; GET NEXT CHAR
	SKIPL	CTABLE(A6)	; IF NOT LETTER OR DIGIT
	POPJ	SP,		; THEN EXIT
	SUBI	A6,40		; ELSE CONVERT TO SIXBIT
	TLNE	A2,770000	; MORE THAN SIX CHARS?
	IDPB	A6,A2		; DEPOSIT CHAR
	JRST	CS8		; YES - IGNORE
	; SCAN A FILE NAME OF THE FORM  DEV:FILE.EXT[123,456]/A/B

SCAN2:	MOVEI	A4,.DSK		; "DSK"
	MOVSM	A4,1(A1)	; SET DEFAULT VALUE
	SETZM	5(A1)		; CLEAR TIME/DATE
	SETZM	6(A1)		; CLEAR PPN
	PUSHJ	SP,SCAN1	; SCAN 1ST STRING
	CAIE	A6,.COLON	; ENDS IN COLON?
	JRST	CS2		; -NO, MUST BE A FILE NAME
	MOVEM	A3,1(A1)	; SET DEVICE NAME
	PUSHJ	SP,SCAN1	; SCAN NEXT STRING

CS2:	MOVEM	A3,3(A1)	; SET FILENAME
	CAIE	A6,.DOT		; ENDS IN DOT?
	JRST	CS10		; -NO
	PUSHJ	SP,SCAN1	; -YES, SCAN EXTENSION NAME
	HLLZM	A3,4(A1)	; SAVE EXTENSION NAME

CS10:	CAIN	A6,.EXCL	; IF EXCLAMATION MARK FOUND
	JRST	RUNUUO		; THEN TRANSFER TO NEXT CUSP
	CAIE	A6,.LBRAC	; IF IT IS NOT A "["
	JRST	SWITCH		; EXIT VIA SWITCH

	; SCAN PROJECT/PROGRAMMER NUMBERS

	PUSHJ	SP,SCAN4	; SCAN 1ST NUMBER
	CAIE	A6,.COMMA	; IT IS AN ERROR IF THIS
	JRST	CSER		; CHAR IS NOT A COMMA
	HRLZM	A5,6(A1)	; SAVE PROJECT NUMBER
	PUSHJ	SP,SCAN4	; SCAN 2ND NUMBER
	CAIE	A6,.RBRAC	; IF IT'S A ]
	CAIN	A6,.CR		;
	SKIPA			;
	JRST	CSER		;
	HRRM	A5,6(A1)	; SAVE PROGRAMMER NUMBER
EDIT(022); MAKE SWITCHES AFTER PPN'S WORK.
	PUSHJ	SP,SCANCH	; [E022] READ NEXT CHAR.
	JRST	SWITCH		; [E022] PROCESS SWITCHES, EXIT SCAN2.




	; SUBROUTINE TO SCAN PROJECT NUMBER OR PROGRAMMER NUMBER

SCAN4:	MOVEI	A5,0		; CLEAR A5
	PUSHJ	SP,SCANCH	; GET NEXT CHAR
	CAIL	A6,.N0		; IF IT IS BELOW "0"
	CAILE	A6,.N7		; OR ABOVE "7"
	POPJ	SP,		; THEN EXIT SCAN4
	LSH	A5,3		; MULTIPLY BY 8
	ADDI	A5,-.N0(A6)	; AND ADD IN CURRENT DIGIT
	JRST	SCAN4+1		; LOOP
	; CHECK FOR, AND PROCESS, A COMMAND SWITCH

SWITCH:	CAIN	A6,.SLASH	; SWITCH ?
	JRST	SW13		; YES
	CAIE	A6,.LPAREN	; START OF COMPIL SWITCH-STRING ?
	POPJ	SP,		;  NO.
	TLO	A7,SPAREN	; YES - REMEMBER
SW13:	MOVEI	A4,6
	SETZM	SWIT
	SKIPA	A5,.+1		;
	POINT	6,SWIT		;

SW1:	PUSHJ	SP,SCANCH	; GET A CHARACTER
	SKIPL	CTABLE(A6)	; LETTER ?
	JRST	SW2		; NO
	ADDI	A6,40		; YES - TO SIXBIT
	IDPB	A6,A5
	SOJG	A4,SW1		; GET UP TO 6
	MOVE	A5,SWIT		; GET SWITCH
	CAMN	A5,[
	SIXBIT/CHECKO/]		; /CHECKON OR /CHECKOFF !
	JRST	SW3		; YES
	PUSHJ	SP,SCANCH
	SKIPGE	CTABLE(A6)	; SKIP REMAINING
	JRST	.-2		;  LETTERS

SW2:	MOVEM	A6,SWDEL	; SAVE DELIMITER CHARACTER
	CAIN	A4,6
	JRST	SE1		; ERROR - NOTHING THERE !
	CAIN	A4,5		; 1 CHAR SW ?
	TLOA	A7,ONECHS	; YES - REMEMBER
	TLZ	A7,ONECHS	; ELSE REMEMBER NOT
	IMULI	A4,6
	SETO	A6,
	LSH	A6,-^D36(A4)	; MAKE MASK
	MOVEM	A6,SWMASK
	HRLZI	A6,-SWTABN
	SETZ	A4,

SW4:	MOVE	A5,SWTAB(A6)	; GET AN ENTRY FROM SWITCH-TABLE
	ANDCM	A5,SWMASK	; MASK IT
	CAMN	A5,SWIT		; WHAT HE TYPED ?
	JRST	SW5		; YES

SW9:	AOBJN	A6,SW4		; NO - GET NEXT ENTRY
	JUMPE	A4,SE2		; RECOGNIZED - ERROR IF NOT

SW11:	SETZ	A5,
	MOVE	A6,SWDEL	; RESTORE DELIMITER
	TLNE	A4,SWNYET	; "NOT IMPLEMENTED YET" ?
	JRST	NOTIMP		; YES - TELL HIM
	TLNN	A4,VALSW	; VALUE WANTED ?
	JRST	SW12		; NO
	CAIN	A6,.COLON	; YES - DELIMITER = COLON ?
	JRST	SW14		; YES - OK
	TLNN	A4,SWVOPT-VALSW	; NO - OPTIONAL ?
	JRST	SE3		; NO - COMPLAIN
	JRST	SW6		; YES - OK (VALUE = 0)
SW14:	JFCL	17,.+1		; CLEAR OVERFLOW FLAG

SW7:	PUSHJ	SP,SCANCH	; GET DIGIT
	CAIL	A6,.N0		; IS
	CAILE	A6,.N9		;  IT ?
	JRST	SW6A		; NO - END OF VALUE
	IMULI	A5,^D10		; YES - ADD IT IN
	ADDI	A5,-.N0(A6)
	JOV	SE4		; TOO BIG !
	JRST	SW7

SW12:	CAIN	A6,.COLON	; NO VALUE WANTED - DID HE GIVE ONE ?
	JRST	SE6		; YES - COMPLAIN
	JRST	SW6		; NO - GOOD.

SW6A:	CAIN	A6,"K"		; nK OR
	IMULI	A5,^D1024
	CAIN	A6,"P"		;  nP ?
	IMULI	A5,^D512
	JOV	SE4		; TOO BIG.
	CAIE	A6,"K"
	CAIN	A6,"P"	;  & GET NEXT CHAR
	PUSHJ	SP,SCANCH

SW6:	; HERE, A5 = VALUE, OR 0
	;	A6 = DELIMITER (OF SWITCH OR VALUE)
	;       A4 = DISPATCH TABLE ENTRY
	TLNN	A4,SETVAL	; SET VALUE TYPE ?
	JRST	SW10		; NO
	MOVEM	A5,@A4		; YES - SET IT !!MUST BE @, NOT ()!!
	JRST	SWEND		; GET NEXT SWITCH

SW10:	TLNE	A4,XCTSW	; EXCECUTE INSTRUCTION TYPE ?
	XCT	@A4		; YES - DO IT
	TLNN	A4,XCTSW	; ELSE
	PUSHJ	SP,@A4		;  JUMP TO ROUTINE
	JRST	SWEND		; DONE - GET NEXT SWITCH

SW3:	; CHECKO SCANNED - IS IT -N OR -FF ?
	PUSHJ	SP,SCANCH	; GET 7TH CHARACTER
	CAIN	A6,"N"		; CHECKON ?
	TRO	FL,ACON!ACOO	; YES - REMEMBER
	CAIN	A6,"F"		; CHECKOFF ?
	TRO	FL,ACOFF
	TRNN	FL,ACON!ACOFF	; IF NEITHER FLAG WAS SET
	JRST	SE2		;  IT'S UNRECOGNIZED
	PUSHJ	SP,SCANCH	; GOBBLE
	SKIPGE	CTABLE(A6)	;  REMAINING
	JRST	.-2		;   LETTERS
	JRST	SWEND		; DO NEXT SWITCH

SW5:	SKIPGE	SWDTAB(A6)	; 1 CHAR FLAG ?
	TLNN	A7,ONECHS	; YES - ONLY 1 CHAR TYPED ?
	JRST	SW8		; NO
	MOVE	A4,SWDTAB(A6)	; YES - GET ENTRY
	JRST	SW11		; AND DISPATCH

SW8:	JUMPN	A4,SE5		; UNIQUE ? - ERROR IF NOT
	MOVE	A4,SWDTAB(A6)	; YES - GET ENTRY
	JRST	SW9		; AND GO ON LOOKING
SE1:	TTCALL	3,[
	ASCIZ/
? Non-alpha switch
/]
	JRST	CSER+1

SE2:	TTCALL	3,[
	ASCIZ/
? Unrecognized/]
	JRST	SE9

SE3:	TTCALL	3,[
	ASCIZ/
? No value for/]
	JRST	SE9

SE4:	TTCALL	3,[
	ASCIZ/
? Value too large for/]
	JRST	SE9

SE5:	TTCALL	3,[
	ASCIZ/
? Non-unique/]
	JRST	SE9

SE6:	TTCALL	3,[
	ASCIZ/
? No value allowed for/]
	JRST	SE9

NOTIMP:	TTCALL	3,[
	ASCIZ/
? Unimplemented/]

SE9:	SKIPA	A5,.+1		;
	POINT	6,SWIT		;
	SKIPA	A6,.+1		;
	POINT	7,SWERR+2	;
	ILDB	A4,A5		; MOVE SWITCH TO TYPE-BUFFER
	JUMPE	A4,.+4		; NULL - END ?
	ADDI	A4,40		; TO ASCII
	IDPB	A4,A6
	JRST	.-4		; GO ON
	IDPB	A4,A6		; DEPOSIT THE NULL (AS ASCIZ TERMINATOR)
	TTCALL	3,SWERR
	TTCALL	3,[
	ASCIZ/
/]
	SETZM	SWERR+2		; CLEAR BUFFER
	SETZM	SWERR+3
	JRST	CSER+1

SWEND:	TLNN	A7,SPAREN	; IN A COMPIL SWITCH-STRING ?
	JRST	SWITCH		; NO
	CAIN	A6,.RPAREN	; CORRECT TERMINATOR ?
	PUSHJ	SP,SCANCH	; YES - GOBBLE IT
	JRST	SWITCH
;	SWITCH TABLES
;
; EACH SWITCH HAS A V-MACRO IN THE DEFINITION OF THE SWS-MACRO.
;
; FORMAT OF THE V-MACRO ENTRY:
;
;	V	NAME,*,ACTIONS,ADDRESS-OR-INSTRUCTION
;
; WHERE:
;
;	NAME	IS THE SWITCH-NAME (ALPHA) - ONLY
;		THE FIRST 6 ARE USED.
;
;	*	MEANS THIS SWITCH WILL BE RECOGNIZED IN PREFERENCE TO OTHERS
;		BEGINNING WITH THE SAME LETTER, IF ONLY 1 CHARACTER IS
;		TYPED (E.G. /H MEANS /HELP, NOT /HEAP)
;
;	ACTIONS	IS A BIT-MASK, AS FOLLOWS:
;
;		VALSW	A VALUE (/SW:VALUE) IS EXPECTED
;		SETVAL	A VALUE IS TO BE SET INTO THE ADDRESS SPECIFIED BY
;			THE FOURTH PARAMETER (0 IF NOT VALSW)
;		XCTSW	AN INSTRUCTION, SUPPLIED AS THE FOURTH PARAMETER, IS
;			TO BE OBEYED.
;		SWVOPT	THE VALUE IS OPTIONAL (IMPLIES VALSW)
;		SWNYET	NOT-YET-IMPLEMENTED: TYPE MESSAGE & GO TO ERROR
;
;	ADDRESS-OR-INSTRUCTION
;		IS THE ADDRESS OF THE ROUTINE TO OBEY, OR
;		IS THE ADDRESS TO SET A VALUE TO (SETVAL), OR
;		IS THE INSTRUCTION TO OBEY (XCTSW).
;
;

	DEFINE	SWS,<
;;	V	NAME,*,ACTIONS,ADDRESS
	V	SYMBOLS,,XCTSW,<TRZ FL,TRPOFF>	; PRODUCE DEBUGGER SYMBOLS (TYPE 1044 BLOCKS)
	V	NOSYMBOLS,,XCTSW,<TRO FL,TRPOFF>; NO SYMBOL BLOCKS
	V	NOERRORS,,XCTSW,<TLO A7,NSWIT>	; SUPPRESS ERRORS ON TTY
	V	NOLIST,,XCTSW,<TRZ FL,LISTOO!CREF>	; TURN OFF LISTING
	IFN	FTSTATS,<
	V	STATS,,XCTSW,<TLO A7,STATS> ;  STATISTICS
	>
	IFE	FTSTATS,<
	V	STATS,,SWNYET
	>
	V	LIST,*,XCTSW,<TRO FL,LISTOO>	; TURN ON LISTING
	V	QUOTED,*,SETVAL,RWS		; QUOTED STROP-WORDS
	V	NOQUOTES,,,SWNOQT		; UNQUOTED STROP-WORDS
	V	HEAP,,SETVAL!VALSW,DYNOWN	; CHANGE INITIAL HEAP-SIZE
	V	HELP,*,XCTSW,<JRST HELPER>	; TELL HIM WHAT TO DO
	V	TEMPCODE,,SETVAL!VALSW,LTCODE	; TEMPCODE BUFFER SIZE
	V	NUMBERS,,XCTSW,<TLO A7,ESWIT>	; SEQUENCE NUMBERS
	V	NONUMBERS,,XCTSW,<TLZ A7,ESWIT>	; NO SEQUENCE NUMBERS
	V	KA10,,SETVAL,TARGMC		; TARGET M/C = KA10
	V	KI10,,XCTSW,<SETOM TARGMC>	; TARGET M/C = KI10
	V	KL10,,,KLSW			; TARGET M/C = KL10
	V	BUFFERS,,SETVAL!VALSW,<7(A1)>	; # I/O BUFFERS
	V	TRACE,*,SWVOPT,SWTRAC		; TRACE-BUFFER LENGTH
	V	PRODUCTION,*,XCTSW,<TRO FL,TRLOFF!TRPOFF> 
						; SUPPRESS DIAGNOSTIC INFO
	V	CREF,,XCTSW,<TRO FL,CREF!LISTOO> ; CROSS-REFERENCE LISTING
	V	NOCREF,,XCTSW,<TRZ FL,CREF>	; NO CREF LISTING
	>

	SETVAL==200000
	VALSW==100000
	XCTSW==40000
	SWNYET==20000
	SWVOPT==10000!VALSW
	DEFINE	V(A,B,C,D),<
	<SIXBIT/A/>>

SWTAB:	SWS					; GENERATE SWITCH NAME TABLE

SWTABN==.-SWTAB					; GET # SWITCHES

	DEFINE	V(A,B,C,D),<
	.ZZZ==0
	IFIDN	<B><*>,<
	.ZZZ==400000>
	IFNB	<C>,<
	.ZZZ==.ZZZ!C>
	IFN	.ZZZ&XCTSW,<			;; GENERATE INSTR, & POINTER
	.ZZZ,,[D]>
	IFE	.ZZZ&XCTSW,<			;; ELSE JUST ENTER VALUE GIVEN
	<.ZZZ_^D18>+<D>>	>

SWDTAB:	SWS					; GENERATE SWITCH DISPATCH TABLE

	PURGE	SWS
	PURGE	.ZZZ
	PURGE	V
XALL

KLSW:	MOVEI	A4,777777
	MOVEM	A4,TARGMC
	POPJ	SP,

SWNOQT:	SKIPA	A4,.+1		;
	XWD	A1,RESWRD-.A		; SET UP RESERVED-WORD-TABLE
	MOVEM	A4,RWS			;  POINTER
	POPJ	SP,

SWTRAC:	SKIPN	A5		; VALUE GIVEN ?
	MOVEI	A5,^D100	; NO - GIVE DEFAULT
	MOVEM	A5,TRACLN
	TRZ	FL,TRLOFF!TRPOFF ; & ENSURE TRACING ON
	POPJ	SP,

HELPER:	MOVE	A1,[
	SIXBIT/ALGOL/]
	PUSHJ	SP,.HELPR
	JRST	CSER+1			; TREAT AS SWITCH-ERROR (GET NEXT LINE)



;
;	SWITCH SCANNER DATA
;
	RELOC

SWIT:	BLOCK	2			; BUFFER FOR SWITCH
SWDEL:	BLOCK	1			; SWITCH DELIMITER SAVE
SWMASK:	BLOCK	1			; SAVE FOR UNIQUENESS-TEST MASK
SWERR:	BLOCK	3			; INITIALISED FROM HISEG.
;	ASCIZ/ switch:       /		; END OF ERROR-MESSAGE

	RELOC
	; INPUT THE COMMAND STRING

GETCS:	SETZM	CSFILE		; CLEAR COMMAND STRING FILE NAME
	SETZM	CSFILE+1	; CLEAR COMMAND STRING EXTENSION NAME
	SETZM	CSFILE+3	; CLEAR PROJECT/PROGRAMMER NUMBER
	SKIPN	CCLSW		; IF ENTRY WAS NOT FROM CCL
	JRST	GETCS2		; THEN SKIP THIS PART

	; READ CCL COMMAND STRING WITH TMPCOR UUO

	SETOM	CCLSW		; MARK: CCL COMMAND STRING HAS BEEN READ
	SKIPA	A4,.+1		; GET TMPCOR PARAMETER
	XWD	2,TEMPC1	; READ JUST FOR LENGTH OF FILE
	TMPCOR	A4,		; READ TEMPORARY CORE FILE
	SKIPA	A3,[
	XWD	440600,A1]	; READ ERROR, SEE IF THERE IS A DISK FILE
	JRST	GETCS3		; CONTINUE

	; READ CCL COMMAND STRING FROM DISK

	PJOB	A4,		; GET JOB NUMBER
	IDIVI	A4,^D100	; GET 1ST DIGIT
	ADDI	A4,20		; CONVERT TO SIXBIT
	IDPB	A4,A3		; PUT IN A1
	IDIVI	A5,^D10		; GET 2ND AND 3RD DIGITS
	ADDI	A5,20		; CONVERT 2ND DIGIT TO SIXBIT
	IDPB	A5,A3		; PUT IN A1
	ADDI	A6,20		; CONVERT THIRD DIGIT TO SIXBIT
	IDPB	A6,A3		; PUT IT IN A1
	HRRI	A1,.ALG		; A1 NOW CONTAINS XXXALG
	MOVEM	A1,CSFILE	; SET FILE NAME
	MOVEI	A1,.TMP		; THE EXTENSION NAME IS TMP
	MOVSM	A1,CSFILE+1	; SET EXTENSION NAME
	MOVEI	A1,.DSK		; DEVICE IS DSK
	MOVSM	A1,CSLIST+1	; SET DEVICE NAME
	; OPEN COMMAND STRING FILE, WRITE A "*"

GETCS2:	OPEN	5,CSLIST	; OPEN COM STRING DEVICE
	JRST	TERMIN		; CANT OPEN, QUIT
	LOOKUP	5,CSFILE	; FIND THE FILE IF THERE IS ONE
	JRST	TERMIN		; FILE CANNOT BE READ
	SKIPE	CCLSW		; IF CALLED FROM CCL
	JRST	GETCS4		; THEN DONT PRINT COMMAND STRING STAR
	OUTBUF	5,1		; GET A BUFFER RING
	OUTPUT	5,0		; GET AN OUTPUT BUFFER
	MOVEI	A4,.STAR	; "*"
	IDPB	A4,STHEAD+1	; PUT IN OUTPUT BUFFER
	OUTPUT	5,0		; WRITE IT TO THE TTY

	; READ IN COMMAND STRING

GETCS4:	INBUF	5,1		; GET AN INPUT BUFFER RING
	AOS	A4,CSBLK	; POINT AT DESIRED BLOCK OF CMD STRING
	USETI	5,(A4)		; AND TELL MONITOR TO READ IT
	INPUT	5,0		; READ THE COMMAND STRING
	STATO	5,20000		; DID WE REACH END OF THE COMMAND FILE ?
	JRST	GETCS5		; NOT YET
	SETZM	CSBLK		; YES, MARK END-OF-COMMAND-FILE REACHED
	SETZM	CSTRIN		; AND ENSURE NULL TERMINATOR IN C.S.
	JRST	GETCS3		; NOW PROCEED TO FETCH THE NULL TERMINATOR

GETCS5:	MOVE	A4,CSHEAD	; BUFFER ADDRESS
	HRLZI	A4,2(A4)	; WHERE COMMAND STRING SITS NOW
	HRRI	A4,CSTRIN	; WHERE TO MOVE IT TO
	MOVE	A5,CSHEAD+2	; GET LENGTH OF BUFFER
	IDIVI	A5,5		; IN WORDS
	BLT	A4,CSTRIN-1(A5)	; AND SAVE THE COMMAND STRING
	SETZM	CSTRIN(A5)	; CLOBBER OLD GARBAGE

EDIT(117); CORRECT COMMAND SCANNER TO IGNORE LEADING SPACES
GETCS3:	MOVE	A5,[POINT 7,CSTRIN]; [E117] GET BYTE POINTER TO A5
	MOVEM	A5,CSP		; [E117] SAVE IT
	SKIPL	CSCOMP		; IF CURRENT CMD FILE NOT FINISHED
	POPJ	SP,		; THEN RETURN NOW
	ILDB	A6,A5		; [E117] GET NEXT CHAR
	CAIE	A6,.SPACE	; [E117] IF CHAR IS SPACE
	CAIN	A6,.TAB		; [E117]  OR TAB,
	JRST	.-3		; [E117] SKIP OVER IT
	CAIN	A6,.CR		; IF THE 1ST CHARACTER IS A CR
	JRST	GETCS		; THEN READ ANOTHER COMMAND STRING
	CAIN	A6,.CZ		; CONTROL-Z ?
	EXIT			; YES - ALL DONE
	JUMPL	A6,GETCS	; DITTO FOR OTHER TERMINATOR
	SETZM	CSCOMP		; MARK: COMMAND STRING YET TO BE SCANNED
	POPJ	SP,		; RETURN
SCANCH:	ILDB	A6,CSP		; FETCH NEXT CHAR
	CAIG	A6,172		; LOWER CASE ?
	CAIGE	A6,141
	JRST	SCANC1
	SUBI	A6,40		; CONVERT IT TO UPPER CASE
	POPJ	SP,

SCANC1:	CAIE	A6,.SPACE	; IGNORE SPACES AND TABS
	CAIN	A6,.TAB
	JRST	SCANCH
	CAIE	A6,.LF
	CAIN	A6,.VT
	JRST	SCANC2
	CAIE	A6,.FF
	CAIN	A6,.ALT1
	JRST	SCANC2
	CAIE	A6,.ALT2
	CAIN	A6,.ALT3

SCANC2:	MOVNI	A6,1
	CAIE	A6,0
	POPJ	SP,
	SKIPE	CSFILE		; ARE WE READING A DISK CMD FILE ?
	SKIPN	CSBLK		; YES, ANY MORE TO COME ?
	POPJ	SP,		; NO, RETURN NULL TERMINATOR NOW
	SETZM	CSFILE+3	; CLEAR CMD FILE PPN
	MOVEI	A6,.DSK		; DEVICE MUST BE RESET TO DSK
	MOVSM	A6,CSLIST+1	; AFTER CALL TO BMOVE AT START1+14
	PUSH	SP,A4		; SAVE A4 AND A5 OVER
	PUSH	SP,A5		; CALL TO GETCS2
	PUSHJ	SP,GETCS2	; TO READ NEXT CMD FILE BLOCK
	POP	SP,A5		; RESTORE A5,A4
	POP	SP,A4
	JRST	SCANCH

	RELOC

;----------------------------------------------------------
OLIST:	BLOCK	3		; "B" DATA MODE (14)
				; SIXBIT DEVICE
;	XWD	BHEAD1,0	; BUFFER HEADER
OFILE:	BLOCK	1		; SIXBIT FILENAME
	BLOCK	1		; SIXBIT EXTENSION
	BLOCK	1		; TIME/DATE
	BLOCK	1		; PROJECT/PROGRAMMER
	BLOCK	1		; NUMBER OF RING BUFFERS

BHEAD1:	BLOCK	1		; OBJECT BUFFER HEADER BLOCK
	BLOCK	1		; WRITE POINTER
	BLOCK	1		; COUNT

;----------------------------------------------------------
LLIST:	BLOCK	1		; "A" DATA MODE
	BLOCK	2		; SIXBIT DEVICE
;	XWD	BHEAD2,0	; BUFFER HEADER
LFILE:	BLOCK	1		; SIXBIT FILENAME
	BLOCK	1		; SIXBIT EXTENSION
	BLOCK	1		; TIME/DATE
	BLOCK	1		; PROJECT/PROGRAMMER 
	BLOCK	1		; NUMBER OF BUFFERS

BHEAD2:	BLOCK	1		; LISTING BUFFER HEADER BLOCK
W:	BLOCK	1		; LISTING POINTER
	BLOCK	1		; COUNT

;----------------------------------------------------------
SLIST:	BLOCK	1		; "A" DATA MODE
	BLOCK	2		; SIXBIT DEVICE
;	XWD	0,BHEAD3	; BUFFER HEADER
SFILE:	BLOCK	1		; SIXBIT FILENAME
	BLOCK	1		; SIXBIT EXTENSION
	BLOCK	1		; TIME/DATE
	BLOCK	1		; PROJECT/PROGRAMMER
	BLOCK	1		; NUMBER OF BUFFERS

BHEAD3:	BLOCK	1		; SOURCE BUFFER HEADER BLOCK
P:	BLOCK	1		; READ POINTER
	BLOCK	1		; COUNT
;----------------------------------------------------------
CSLIST:	BLOCK	3
;	1			; "AL" DATA MODE
;	SIXBIT	/TTY/		; DEVICE
;	XWD	STHEAD,CSHEAD	; BUFFER HEADS

CSFILE:	BLOCK	1		; SIXBIT FILE NAME
	BLOCK	1		; SIXBIT EXTENSION
	BLOCK	1		; TIME/DATE
	BLOCK	1		; PROJECT/PROGRAMMER NUMBER

CSHEAD:	BLOCK	1		; BUFFER
CSP:	BLOCK	1		; POINTER
	BLOCK	1		; COUNT

;--------------------------------------------------------
STHEAD:	BLOCK	3		; BUFFER HEADER FOR COMMAND STRING STAR

	CSLEN==201		; LENGTH OF COMMAND STRING BUFFER

CSTRIN:	BLOCK	CSLEN		; COMMAND STRING BUFFER

CCLSW:	BLOCK	1		; CCL SWITCH. 1=ENTERED FROM CCL
RFLAGS:	BLOCK	1		; READ-MODULE FLAGS
SRCEMC:	BLOCK	1		; =0 FOR KA SOURCE, -VE FOR KI, +VE FOR KL
TARGMC:	BLOCK	1		; DITTO FOR TARGET M/C
BLOCK1:	BLOCK	1		; BEGINNING OF SYMBOL TABLE BLOCK 1
STACKB:	BLOCK	1		; BEGINNING OF STACK
COREB:	BLOCK	1		; BEGINNING OF CORE ACQUIRED WITH CORE UUO
COREND:	BLOCK	1		; END OF LOW SEGMENT
LTCODE:	BLOCK	1		; LENGTH OF TEMPCODE
CSCOMP:	BLOCK	1		; -1 = COMMAND STRING COMPLETELY SCANNED
				; 0 = COMMAND STRING CONTAINS YET ANOTHER COMP.
				; 1 = CURRENT LINE OF COM.STRING NOT COMPLETELY SCAND.
CSBLK:	BLOCK	1		; POINTER TO WHICH CMD FILE BLK WE'RE AT
CHKSUM:	BLOCK	1		; CHECK SUM
PNBUF:	BLOCK	2		; PREPARED NAME BUFFER

	RELOC

TEMPC1:	XWD	.ALG,0		; TMPCOR READ BLOCK
	IOWD	CSLEN,CSTRIN
SUBTTL	** A RANDOM COLLECTION OF RANDOM ROUTINES **

	; TERMINATE COMPILATION DUE TO ABNORMAL CONDITION

TERMIN:	TTCALL	3,TERMSG	; WRITE TERMINATE MSG
EDIT(001); DON'T DELETE OLD .REL-FILE IF DISASTERS STRIKE.
QUIT:	CLOSE	1,40		; [E001] CLOSE OBJECT FILE
	CLOSE	2,0		; CLOSE LISTING FILE
	CLOSE	3,0		; CLOSE SOURCE FILE
	SKIPN	CSFILE		; HAVE WE A DSK CMD FILE ?
	JRST	QUIT1		; NO SO NO NEED TO DELETE IT !
	PUSHJ	SP,GETCS	; YES, OPEN IT
	SETZM	CSFILE		; CLEAR ITS NAME
	RENAME	5,CSFILE	; AND DELETE IT
	JFCL			; IGNORE ERRORS
	CLOSE	5,0		; CLOSE THE DEVICE
	SETZM	CSBLK		; MARK IT ABSENT

QUIT1:	MOVE	A4,COREB	; GET ORIGINAL VALUE OF JOBFF
	HRRZM	A4,.JBFF	; RETURN CORE USED DURING COMPILATION
	SETZM	COREB		; MARK: RETURNED
	EXIT			; RETURN TO MONITOR



	; COMMAND STRING ERROR

CSER:	TTCALL	3,CSERM		; WRITE MSG
	SETOM	CSCOMP		; MARK: COMMAND STRING FULLY SCANNED
	SKIPN	CCLSW		; TERMINATE IF CALLED FROM CCL
	TLNE	A7,CSDONE	; IF COMMAND STRING ONLY PART SCANNED
	JRST	TERMIN		; THEN TERMINATE
	JRST	START2		; ELSE GET ANOTHER COMMAND STRING



	; WRITE TO LISTING, GET NEXT OUTPUT BUFFER

WRITEL:	HLLZ	A3,W		; GET S-P BITS
	ROT	A3,4		; PUT 1ST 4 BITS IN RIGHT HALF
	SETCM	A3,MSKTBL(A3)	; GET A MASK FROM TABLE
	ANDM	A3,@W		; DELETE TRAILING EXTRA CHARS
	OUT	2,0		; GET NEXT OUTPUT BUFFER
	JRST	.+3		; -OK, SKIP
	TTCALL	3,LISTER	; -OUTPUT ERROR
	JRST	TERMIN		; TERMINATE COMP

	; WRITTEN OK, MARK END OF NEW BUFFER

	MOVE	A6,BHEAD2	; ADDR OF CURRENT BUFFER
	HLRZ	A3,(A6)		; LENGTH OF BUFFER
	TLZ	A6,USE		; ZERO USE BIT
	ADDI	A6,(A3)		; ADD LENGTH TO ADDRESS
	MOVEM	A6,OBEND	; SAVE ADDR OF END OF BUFFER DATA
	POPJ	SP,		; EXIT
	; ALLOCATE BUFFER SPACE

ALLOCATE:
	PUSH	SP,.JBFF	; SAVE ADDRESS OF BUFFER
	ADDB	A1,.JBFF	; SET NEW VALUE OF FREE SPACE POINTER
	CAMGE	A1,.JBREL	; IF NOT BEYOND END OF LOW SEGMENT
	JRST	.+3		; THEN SKIP THIS
	CORE	A1,		; MOVE UP THE TOP OF THE LOW SEG
	JRST	TERMIN		; -CANNOT ACQUIRE MORE CORE
	POP	SP,A1		; GET ADDRESS OF BUFFER
	POPJ	SP,		; EXIT ALLOCATE



	; CANNOT OPEN SOURCE DEVICE

DSERR1:	SKIPA	A1,[		; INCLUDE DEVICE IN MSG
	POINT	6,SLIST+1]	; POINTER TO DEVICE NAME

	; CANNOT OPEN LISTING FILE

DSERR3:	MOVE	A4,[
	POINT	6,LLIST+1]	; LOAD POINTER TO LISTING DEVICE NAME

DSERR0:	MOVEI	A6,6		; 6 CHARS LONG
	PUSHJ	SP,PRENAM	; WRITE TO TTY
	TTCALL	3,ILLDEV	; WRITE REST OF MSG
	JRST	CSER+1		; TERMINATE COMP



	; WRITE DEVICE NAME ON TTY

PRENAM:	MOVE	A5,[		; POINTER TO WHERE
	POINT	7,PNBUF]	; PREPARED NAME WILL GO
	MOVEI	A3,.QUESTION
	IDPB	A3,A5		; OUTPUT A "?"

PNL:	ILDB	A3,A4		; GET A CHAR
	MOVEI	A3,40(A3)	; CONV TO ASCII
	IDPB	A3,A5		; PUT IN BUFFER
	SOJG	A6,PNL		; LOOP
	IDPB	A6,A5		; END BUFFER WITH A NULL
	TTCALL	3,PNBUF		; WRITE BUFFER TO TTY
	POPJ	SP,		; EXIT
	; CANNOT READ FROM INDICATED SOURCE FILE

DSERR2:	HLRZ	A4,SFILE+1	; IF EXTENSION NAME IS NULL
	JUMPE	A4,.+3		; THEN THE ERROR IS REAL
	SETZM	SFILE+1		; OTHERWISE CHANGE FROM .ALG TO .
	JRST	CS9		; AND TRY AGAIN
	MOVE	A4,[		; PUT FILENAME IN MSG
	POINT	6,SFILE]	; POINTER TO FILENAME
	MOVEI	A6,6		; 6 CHARS LONG
	PUSHJ	SP,PRENAM	; WRITE FILENAME TO TTY
	TTCALL	3,..DOT		; WRITE DOT TO TTY
	MOVEI	A6,3		; 3 CHAR EXTENSION LENGTH
	MOVE	A5,[
	POINT	7,PNBUF]
	PUSHJ	SP,PNL		; WRITE FILENAME EXT TO TTY
	MOVE	A6,SFILE+1
	ANDI	A6,7		; GET LOOKUP RETURN CODE
	CAIN	A6,2		; IF RC=2,
	JRST	READPR		; THEN FILE READ PROTECTED
	TTCALL	3,NOFILE	; ELSE FILE DOESNT EXIST
	JRST	CSER+1		; TERMINATE COMP

READPR:	TTCALL	3,READPM	; WRITE MSG
	JRST	CSER+1		; TERMINATE COMP



..DOT:	ASCIZ	/./		; DOT

IFLAGS:	XWD	<WITHIN+COMPLETE>&777777,NORMAL ; INITIAL READ MODULE FLAGS

	; UNABLE TO CREATE LISTING FILE

DSERR4:	TTCALL	3,UNLIST	; UNABLE TO CREATE LISTING
	JRST	CSER+1		; TERMINATE COMP
	; PUT 2-DIGIT DECIMAL NUMBER IN LISTING

DEC2:	IDIVI	A4,^D10		; A4=TENS, A5=ONES
	MOVEI	A4,.N0(A4)	; CONV TO ASCII
	IDPB	A4,A3		; MOVE TO LISTING
	MOVEI	A5,.N0(A5)	; CONV TO ASCII
	IDPB	A5,A3		; MOVE TO LISTING
	IDPB	A14,A3		; MOVE : OR - TO LISTING
	POPJ	SP,		; EXIT

	; RUN THE NEXT CUSP

RUNUUO:	SKIPE	.JBERR		; IF THERE WERE ERRORS
	JRST	QUIT		; THEN ABORT LOADING
	MOVSI	A3,(SIXBIT /SYS/)
	MOVEM	A3,LB		; SEARCH DEVICE
	MOVE	A3,OFILE	; GET NAME OF PROGRAM TO BE CALLED
	MOVEM	A3,LB+1		; PUT IN PARAMETER BLOCK
	SETZM	LB+2
	SETZM	LB+3
	SETZM	LB+4
	SETZM	LB+5		; CLEAR OUT THE REST
	HRLZI	A4,1		; ENTER IT AT ITS CCL ENTRY POINT
	HRRI	A4,LB		; ADDRESS OF PARAMETER BLOCK
	RUN	A4,		; LOAD AND RUN NEXT CUSP
	JRST	TERMIN		; CUSP NOT FOUND, STOP
	; PUT CURRENT DATE AND TIME IN LISTING

DATIME:	MOVE	A3,LBP		; GET BUFFER POINTER
	DATE	A4,		; GET DATE
	IDIVI	A4,^D372	; DIVIDE BY 372 DAYS/YEAR
	IDIVI	A5,^D31		; DIVIDE BY 31 DAYS PER MONTH
	MOVE	A1,A5		; SAVE ACC A5
	MOVE	A2,A4		; SAVE ACC A4
	MOVEI	A14,.MINUS	; -
	MOVEI	A4,1(A6)	; DAY
	PUSHJ	SP,DEC2		; WRITE 2 DIGITS
	ROT	A1,-1
	MOVEI	A4,[
	SIXBIT /JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC/](A1)
	JUMPGE	A1,.+2
	TLOA	A4,(POINT 6,0,17)
	TLO	A4,(POINT 6,0,)	; GET MONTH
	MOVEI	A5,3
	ILDB	A6,A4
	ADDI	A6,40
	IDPB	A6,A3
	SOJG	A5,.-3		; AND WRITE IT
	IDPB	A14,A3
	MOVEI	A4,100(A2)	; YEAR
	PUSHJ	SP,DEC2		; WRITE 2 DIGITS
	MOVEI	A1,.SPACE	; BLANK
	DPB	A1,A3		; INCLUDE
	MOVEI	A5,3		; FOUR
	IDPB	A1,A3		; BLANKS.
	SOJG	A5,.-1		; PUT A BLANK IN LISTING
	MSTIME	A4,		; GET TIME OF DAY
	IDIVI	A4,^D1000	; CONVERT TO SECONDS
	IDIVI	A4,^D3600	; DIVIDE BY 3600 SEC/HOUR
	IDIVI	A5,^D60		; DIVIDE BY 60 SEC/MIN
	MOVE	A2,A5		; SAVE ACC A5
	MOVEI	A14,.COLON	; :
	PUSHJ	SP,DEC2		; WRITE HOUR AS 2 DIGITS
	MOVE	A4,A2		; MINUTE
	PUSHJ	SP,DEC2		; WRITE 2 DIGITS
	MOVE	A4,A6		; SECOND
	PUSHJ	SP,DEC2		; WRITE 2 DIGITS
	MOVEI	A1,0		; ASCII NULL
	DPB	A1,A3		; PUT NULL AT END OF MESSAGE
	MOVEI	A1,LB		; ADDR OF BUFFER
	PUSHJ	SP,INSERT	; INSERT LINE IN LISTING
	TLNE	A7,LTTY		; IF LISTING IS TO TTY:
	JRST	DATIM1		;  THEN DON'T DO IT
	MOVEI	A1,COMSTR
	PUSHJ	SP,INSERT
	MOVEI	A1,CSTRIN
	PUSHJ	SP,INSERT
DATIM1:	MOVEI	A1,LINES3	; 3 BLANK LINES
	PUSHJ	SP,INSERT	; INSERT IN LISTING
	JRST	ICHECK		; ALIGN TO A FULLWORD, EXIT DATIME
	RELOC

LINK:	BLOCK	1		; RETURN LINK
LINK1:	BLOCK	1		; RETURN LINK .PINIT
OLDSBR:	BLOCK	1		; OLD SOURCE BUFFER RING

	RELOC


;	"DEC" WILL CONVERT THE NUMBER IN A4 TO DECIMAL ASCII CHARACTERS,
;	AND PLACE THE RESULT DIRECTLY INTO THE LISTING.  "DEC" WILL PRINT
;	THE NUMBER RIGHT-JUSTIFIED IN A FIELD WHOSE SIZE IS SPECIFIED IN
;	A3.  "DEC" WILL PRECEDE THE FIRST PRINTABLE CHARACTER OF THE NUMBER
;	WITH THE CHARACTER THAT IS SPECIFIED IN RH A2.
;	"CRFDEC" WILL FILL THE FIELD WITH THE CHARACTER IN LH A2,
;	INSTEAD OF BLANKS

DEC:	HRLI	A2," "		; BLANK-FILL

CRFDEC:	MOVE	A1,A3		; COPY NUMBER OF CHARS
	IDIVI	A4,^D10		; DIVIDE BY 10
	LSHC	A5,-4		; MOVE REMAINDER TO ACC A3
	SOJG	A1,.-2		; LOOP TILL END OF NUMBER
	HLRZ	A1,A2		; PUT FILLER IN ACC A1

DEC1:	LSHC	A5,4		; GET NEXT CHAR FROM A6
	JUMPN	A5,DEC3		; JUMP IF NON ZERO
	IDPB	A1,W		; INCLUDE A LEADING BLANK
	SOJG	A3,DEC1		; LOOP TILL END OF NUMBER

DEC3:	DPB	A2,W		; INCLUDE SPECIAL CHARACTER
	MOVEI	A5,.N0(A5)	; CONVERT TO ASCII
	IDPB	A5,W		; PUT NUMBER IN LISTING
	MOVEI	A5,0		; CLEAR A5
	LSHC	A5,4		; GET NEXT CHAR FROM A6
	SOJG	A3,DEC3+1	; LOOP TILL END OF NUMBER
	POPJ	SP,		; EXIT DEC - A3=0 IS RELIED ON!

	; DETERMINE WHETHER NL CHAR IS FOR END OF LINE OR END OF BUFFER

NCHECK:	MOVE	A1,P		; GET READ POINTER
	CAMN	A1,IBEND	; IF AT END OF BUFFER
	JRST	INEND1		; THEN GET ANOTHER BUFFER
	JRST	SKRET		; EXIT NCHECK

	; COMPUTE LENGTH OF TAB

TAB:	MOVE	A2,CC		; GET CHAR COUNT
	SUB	A2,LP1		; COMPUTE POSITION ON CURRENT LINE
	ADDI	A2,^D8		; TAB TO THE NEW POSITION
	ANDCMI	A2,7		; BACK UP TO 8-CHAR MULTIPLE
	SUBI	A2,1		; BACK UP 1 MORE CHAR
	ADD	A2,LP1		; COMPUTE NEW CHARACTER COUNT
	MOVEM	A2,CC		; SE IT
	MOVE	A2,CTABLE(A1)	; RELOAD THE TABLE ENTRY VALUE
	POPJ	SP,		; EXIT TAB
CSERM:	ASCIZ	/?INVALID COMMAND STRING
/
TERMSG:	ASCIZ	/?COMPILATION TERMINATED
/
LISTER:	ASCIZ	/?OUTPUT ERROR ON LISTING
/
ILLDEV:	ASCIZ	/ DEVICE NOT AVAILABLE
/
NOFILE:	ASCIZ	/ FILE DOES NOT EXIST
/
DDTMSG:	ASCIZ	/ DDT is loaded
/
HEADIN:	ASCIZ	/DECsystem 10 ALGOL-60, Version /
READPM:	ASCIZ	/ FILE READ PROTECTED
/
UNLIST:	ASCIZ	/?CANNOT CREATE LISTING FILE
/
LINES3:	ASCIZ	/


/
FORM:	XWD	060000,0

ERRORM:	ASCIZ	/ errors
/
QUERY:	ASCIZ	/?/
ALGOL:	ASCIZ	/ALGOL: /
ALGDDT:	ASCIZ/ALGDDT: /
COMSTR:	ASCIZ/
Command string: /
SUBTTL	**  RINIT  **

	; CREATE OBJECT FILE

CS5:	SKIPE	OFILE		; IF FILE NAME NOT NULL
	JRST	NOOBJ-1		; THEN CREATE THE OBJECT FILE
	MOVS	A5,OLIST+1	; GET DEVICE NAME
	CAIE	A5,.DSK		; UNLESS DEVICE NAME IS DSK
	PUSHJ	SP,WRITE1	; CREATE OBJECT FILE

	; WRITE "ALGOL: NAME "

NOOBJ:	PUSHJ	SP,WRITE0	; ELSE CALL WRITE0
	TLO	A7,CSDONE	; 1ST PART OF CS DONE
	SKIPN	CCLSW		; IF THIS IS NOT A CCL RUN
	JRST	LST1		; THEN SKIP THIS
	SKIPN	.JBDDT		; IF NO DDT ..
	TTCALL	3,ALGOL		; WRITE "ALGOL: "
	SKIPE	.JBDDT		; ELSE..
	TTCALL	3,ALGDDT	; ..WRITE "ALGDDT: "
	MOVEI	A4,6		; WRITE 6 CHARACTERS OF FILE NAME
	MOVE	A5,[		; LOAD A POINTER TO
	XWD	440600,SFILE]	; THE NAME OF THE SOURCE FILE
	ILDB	A6,A5		; GET NEXT SIXBIT CHARACTER
	ADDI	A6,40		; CONVERT IT TO ASCII
	TTCALL	1,A6		; WRITE IT TO TERMINAL
	SOJG	A4,.-3		; LOOP
	TTCALL	3,NLCHRS	; WRITE A CR/LF

	; CREATE LISTING

LST1:	SETZM	W		; ZERO W
	SKIPE	LFILE		; IS THERE A LISTING?
	JRST	LST		; -YES
	MOVS	A5,LLIST+1	; -MAYBE, CHECK DEVICE
	CAIN	A5,.DSK		; DSK?
	JRST	NOLST		; -YES, NO LISTING
	
LST:	MOVE	A5,LLIST+1	; GET DEVICE NAME
	DEVCHR	A5,		; GET DEVICE CHARACTERISTICS WITH DEVCHR
	TLNE	A5,DEVTTY	; IF LISTING DEVICE IS A TTY
	TLO	A7,LTTY!NSWIT	; THEN SET INDICATOR
	TLNE	A5,DEVTTY	;  AND
	TRZ	FL,CREF		;   TURN OFF CREF'ING.
	OPEN	2,LLIST		; OPEN LISTING
	JRST	DSERR3		; -SOMETHING WRONG
	OUTBUF	2,@LLIST+7	; GET A BUFFER RING
	HLRZ	A3,LFILE+1	; GET EXT
	CAIE	A3,777777	; STILL GARBAGE ?
	JRST	LST2		; NO - USE HIS
	MOVEI	A3,.LST		; YES USE .LST
	TRNE	FL,CREF		;  UNLESS WE'RE CREF'ING
	MOVEI	A3,.CRF		;   IN WHICH CASE USE .CRF
	MOVSM	A3,LFILE+1
LST2:	ENTER	2,LFILE		; CREATE FILE
	JRST	DSERR4		; -CANNOT CREATE
	TLO	A7,EXISTS	; SET FLAG: FILE EXISTS
	SETZM	FIVEC		; INIT FIVE CHAR COUNT

	; PUT HEADING IN LISTING

	PUSHJ	SP,WRITEL	; GET THE 1ST LISTING BUFFER
	MOVEI	A1,FORM		; ADDRESS OF A FORM FEED
	TLNE	A7,LTTY		; IF LISTING IS SENT TO TTY
	PUSHJ	SP,INSERT	; THEN SEND A FORM-FEED THERE
	MOVEI	A1,HEADIN	; ADDR OF HEADING
	PUSHJ	SP,INSERT	; PUT IN LISTING
	MOVE	A6,LBP		; PREPARE TO PRINT VERSION NUMBER
	LDB	A1,[
	POINT	9,.JBVER,11]
EDIT(111); INSERT VERSION NUMBER IN OCTAL
	PUSHJ	SP,LST4		; [E111] INSERT OCTAL VALUE
	LDB	A1,[
	POINT	6,.JBVER,17]
	JUMPE	A1,LST3
	IDIVI	A1,^D26
	JUMPE	A1,.+3		; FIRST LETTER OF..
	ADDI	A1,.A-1
	IDPB	A1,A6		; ..MINOR VERSION NUMBER
	ADDI	A2,.A-1
	IDPB	A2,A6		; ..AND ITS SECOND LETTER

LST3:	MOVEI	A1,.LPAREN
	IDPB	A1,A6
	HRRZ	A1,.JBVER	; [E111] GET EDIT NUMBER
	PUSHJ	SP,LST4		; [E111] INSERT IT IN OCTAL
	MOVEI	A1,.RPAREN
	IDPB	A1,A6
	MOVEI	A1,.SPACE
	MOVEI	A4,3
	IDPB	A1,A6		; INSERT THREE SPACES
	SOJG	A4,.-1
	MOVEI	A1,0
	IDPB	A1,A6
	MOVEI	A1,LB
	PUSHJ	SP,INSERT
	PUSHJ	SP,DATIME	; PUT DATE, TIME AND COMMAND-STRING IN LISTING
	TLNE	A7,LTTY		; IF LISTING IS TO TTY
	PUSHJ	SP,WRITEL	; THEN CLEAR THE BUFFER
	JRST	NOLST1		; CONTINUE

LST4:	IDIVI	A1,10		; [E111] SPLIT OFF OCTAL DIGIT
	JUMPE	A1,LST5		; [E111] JUMP IF ALL DONE
	HRLM	A2,(SP)		; [E111] OTHERWISE SAVE DIGIT
	PUSHJ	SP,LST4		; [E111] AND INSERT EARLIER
	HLRZ	A2,(SP)		; [E111] DIGITS FIRST.
LST5:	ADDI	A2,.N0		; [E111] CONVERT TO ASCII
	IDPB	A2,A6		; [E111] INSERT IN TEXT
	POPJ	SP,		; [E111] AND RETURN

NOLST:	HRRI	A7,NLIST1	; SET FLAGS ADDR
	; INITIALIZE VARIABLES AND TABLES

NOLST1:	SETZM	CC		; INIT CHARACTER COUNT
	IFN	FTSTATS,<
	SETZM	DEFCNT		; INIT 
	SETZM	IDCHRS		;  STATS 
	SETZM	REFCNT		;   COUNTERS.
	>
	SETZM	OLDNO		; INIT OLD LINE NUMBER
	SETZM	LINE5		; INIT 5-CHAR LINE NUMBER
	SETZM	LSBUFP		; INIT NAME BUF LIST POINTER
	SETZM	BNUM		; INIT BEGIN NUMBER
	SETZM	LBNUM		; INIT LAST BEGIN NUMBER
	SETZM	ENUM		; INIT END NUMBER
	SETZM	LENUM		; INIT LAST END NUMBER
	SETZM	NSYM		; INIT NSYM
	SETZM	PLIST+4		; INIT PLIST+4
	SETZM	NDEL		; INIT NDEL
	SETZM	DUBBLE		; INIT DUBBLE
	SETZM	BLEX		; INIT BUFFERED LEXEME
	SETZM	.JBERR		; INIT ERROR COUNT
	SETZM	TBLEN		; INIT TMPBUF DATA LENGTH WORD
	SETZM	SSTART		; INIT SEGMENT START
	SETZM	LINENO		; INIT LINENO
	SETZM	NXTSLN		; CLEAR NEXT STATEMENT NUMBER FOR SYM
	SETZM	NXTDLN		; AND DEL (WILL BE COPIED BY RUND)
	SETOM	LSTSLN		; MAKE LAST AN IMPOSSIBLE VALUE
	SETOM	LASTRA		; MAKE SURE FIRST STN IS SENT
	SETZM	SENDSN		; MARK NOT SET UP YET
	SETZM	STCFL		; INIT STRING CHARACTERS FLAG
	MOVEI	A4,50		; SET THE BEGIN TABLE INDEX
	MOVEM	A4,BTI		; TO 50
	MOVEI	A4,MTABLE	; ADDRESS OF MTABLE
	MOVEM	A4,NAMTE	; INIT MESSAGE TABLE POINTER
	MOVEI	A4,PLIST+3	; ADDR OF POINTER TABLE
	MOVEM	A4,PLIST	; INIT UP-ARROW LIST
	MOVEM	A7,RFLAGS	; SAVE THE FLAGS
	HRRZ	A4,.JBFF	; GET ADDRESS OF FREE SPACE
	MOVEM	A4,TCBASE	; USE AS BASE FOR ALLOCATION
	JSP	A1,.PINIT	; ALLOCATE TABLES
	MOVEM	A7,A7SAV	; SAVE A7
	MOVE	A7,RFLAGS	; GET FLAGS AGAIN
	PUSHJ	SP,READ		; READ IN FIRST LINE OF SOURCE

EMPTY:	TLZ	A7,WITHIN	; MARK: WITHIN NEWLINE
	MOVE	A2,P		; GET READ POINTER
	MOVEM	A2,LSTART	; SAVE POINTER TO LINE START
	PUSHJ	SP,NL11		; CHECK FOR LINE NUMBERS, ETC
	HALT	.		; CANT POSSIBLY RETURN HERE

EMPTY1:	SETOM	NDEL		; MAKE IT LOOK LIKE SOMTHING IS IN NDEL
	PUSHJ	SP,RUND		; DO AN INITIAL RUND
	AOJA	DEL,@LINK	; CLEAR DEL AND EXIT
SUBTTL	**  PINIT  **

.PINIT:	MOVEM	A1,LINK1	; SAVE RETURN LINK

	; INITIALIZE VARIABLES

	SETZM	TOFIXI		; INIT FIXUP TABLE HALFWORD INDEX
	SETZM	RA		; INIT PROGRAM COUNTER
	SETZM	FNLEVEL		; INIT FUNCTION LEVEL
	SETZM	BLOCKL		; INIT BLOCK LEVEL
	SETZM	LEXBLOCK	; INIT LEXICAL BLOCK LEVEL
	SETZM	CURBLOCK	; INIT CURRENT BLOCK LEVEL
	SETZM	THUNK		; INIT THUNK
	SETOM	CAX		; INIT CAX
	SETOM	PROSKIP		; INIT PROCEDURE SKIP
	HRLZI	DBASE,400000	; INIT DISPLAY POINTER
	HRLZI	DBASE+1,400000	; INIT DISPLAY POINTER
	MOVEI	A4,A13+1	; INIT
	MOVEM	A4,LAC		; LAC
	HRLZI	STOPS,160000	; INIT STOPS

	; ACQUIRE SPACE FOR TABLES

	MOVE	A5,TCBASE	; BASE OF AVAILABLE CORE
	ADD	A5,LTCODE	; THE LENGTH OF TEMPCODE
	ADDI	A5,TABLES+CONL+STACKL+1
				; PLUS THE LENGTH OF SYMBOL AND FIXUP TABLES
				; PLUS LENGTH OF CONSTANT TABLE
				; PLUS LENGTH OF STACK
	MOVEM	A5,COREND	; SAVE THE CALLI PARAMETER
	HRRZM	A5,.JBFF	; SET NEW VALUE OF JOBFF
	CORE	A5,		; GET CORE FOR ALL OF THAT
	JRST	TERMIN		; CORE NOT AVAILABLE, TERMINATE
	; ALLOCATE TABLES

	MOVE	SP,TCBASE	; BASE OF TEMPCODE
	MOVEM	SP,INDEX	; SET THE TEMPCODE INDEX
	ADD	SP,LTCODE	; ADD LENGTH OF TEMPCODE
	MOVEM	SP,TCMAX	; SET END OF TEMPCODE
	ADDI	SP,1		; LEAVE 1 WORD BETWEEN SYMBOL TABLE AND TEMPCODE
	MOVEM	SP,BLOCK1	; WHICH IS ALSO THE START OF THE SYMBOL TABLE
	MOVEM	SP,STBB		; START OF CURRENT BLOCK IN SYMBOL TABLE
	MOVEM	SP,NASTE	; 1ST AVAILABLE ENTRY IN SYMBOL TABLE
	ADDI	SP,TABLES	; ADD LENGTH OF TABLES
	MOVEM	SP,CONTAB	; SET BASE OF CONSTANT TABLE
	MOVEM	SP,FIXUP	; WHICH IS ALSO THE BASE OF THE FIXUP TABLE
	MOVEM	SP,LASTST	; END OF STRING CHAIN
	MOVEI	A5,1(SP)	; STEP OVER 1ST WORD OF CONSTANTS TABLE
	MOVEM	A5,NACTE	; SET NEXT AVAILABLE CONSTANT TABLE ENTRY
	MOVEI	A5,-1(SP)	; BACK UP 1
	MOVEM	A5,NAFTE	; SET NEXT AVAILABLE FIX-UP TABLE ENTRY
	MOVEM	A5,LASTC1	; SET CONSTANT TABLE POINTER
	MOVEI	A5,-2(SP)	; BACK UP 1 MORE
	MOVEM	A5,LASTC2	; SET CONSTANT TABLE POINTER
	ADDI	SP,CONL		; ADD LENGTH OF CONSTANT TABLE
	MOVEM	SP,CONEND	; SET END OF CONSTANT TABLE
	MOVEM	SP,STACKB	; SAVE BEGINNING ADDR OF STACK
	HRLI	SP,-STACKL	; SET UP STACK POINTER
	MOVE	A4,INDEX	; TEMPCODE POINTER
	HRLI	A4,770000	; INIT
	MOVEM	A4,HANDLE	; HANDLE
	HRREI	A4,-1		; THE 1ST ENTRY IN THE CONSTANTS TABLE MUST
	PUSHJ	SP,CON1		; BE A CONSTANT OF -1
	MOVEI	A1,B0LIST##	; INIT LIST
	PUSHJ	SP,BMOVE	; INITIALIZE BLOCK-0 FROM HIGH SEGMENT
	JRST	@LINK1		; EXIT .PINIT
SUBTTL	**  TABLE OVERFLOW ROUTINES  **

	; SYMBOL TABLE OR FIXUP TABLE OVERFLOW

OVFL1:	PUSHJ	SP,OVFLS	; SAVE SOME REGISTERS
	MOVE	A4,NAFTE	; BASE OF CORE TO MOVE
	PUSHJ	SP,OVFL		; MOVE IT
	ADDM	A4,CONTAB	; UPDATE BASE OF CONSTANT TABLE
	ADDM	A4,FIXUP	; UPDATE BASE OF FIXUP TABLE
	ADDM	A4,LASTST	; UPDATE STRING CHAIN
	ADDM	A4,NACTE	; UPDATE CONSTANT TABLE POINTER
	ADDM	A4,NAFTE	; UPDATE FIXUP TABLE POINTER
	ADDM	A4,LASTC1	; UPDATE 1-WORD CONSTANT CHAIN
	ADDM	A4,LASTC2	; UPDATE 2-WORD CONSTANT CHAIN

OVFL3:	ADDM	A4,CONEND	; UPDATE POINTER TO END OF CONSTANT TABLE
	ADDM	A4,STACKB	; UPDATE BASE OF STACK
	MOVE	A4,OVA		; RESTORE A4
	MOVE	A5,OVB		; RESTORE A5
	MOVE	A6,OVC		; RESTORE A6
	MOVE	A3,OVD		; RESTORE A3
	POPJ	SP,		; EXIT OVFL1 OR OVFL2


	; CONSTANTS TABLE OVERFLOW

OVFL2:	PUSHJ	SP,OVFLS	; SAVE SOME REGISTERS
	MOVE	A4,CONEND	; BASE OF CORE TO MOVE
	PUSHJ	SP,OVFL		; MOVE IT
	JRST	OVFL3		; CONTINUE


OVFL:	MOVEI	A5,DELTA	; LENGTH OF CORE TO ACQUIRE
	ADDB	A5,COREND	; NEW END OF LOW SEGMENT
	HRRZM	A5,.JBFF	; SET JOBFF
	CORE	A5,		; GET SOME MORE CORE
	JRST	OVFLX		; -CANT GET IT
	MOVE	A5,COREND	; GET NEW END OF CORE
	ADDI	A5,1-DELTA	; BLT "TO" ADDRESS
	HRLI	A5,-DELTA(A5)	; BLT "FROM" ADDRESS
	JRST	OVFLL1		; JUMP INTO MOVE LOOP
OVFLL:	MOVE	A3,A5		; COPY BLT PARAM TO A3
	BLT	A3,DELTA-1(A5)	; MOVE A DELTA OF CORE
	SUB	A5,[		; COMPUTE THE NEXT BLT CONSTANT
	XWD	DELTA,DELTA]	; BACK UP TO NEXT DELTA

OVFLL1:	HLRZ	A6,A5		; GET THE "FROM" ADDRESS
	CAILE	A6,(A4)		; IF ABOVE THE BASE OF CORE TO MOVE
	JRST	OVFLL		; THEN CONTINUE LOOPING
	HRL	A4,A4		; FORM A NEW BLT POINTER FOR
	ADDI	A4,DELTA	; CORE OF SIZE LESS THAN DELTA
	MOVE	A3,A4		; COPY BLT CONSTANT TO A3
	BLT	A3,DELTA-1(A5)	; MOVE THE LESS THAN DELTA CORE
	MOVE	A4,[		; CORRECTION FACTOR FOR DISPLAY POINTERS
	XWD	DELTA,DELTA]	; VALUE
	MOVEI	A5,DBASE	; HEAD OF CHAIN
	ADDM	A4,(A5)		; UPDATE THE POINTER
	HLRE	A5,(A5)		; LOCATE NEXT DISPLAY POINTER IN CHAIN
	JUMPG	A5,.-2		; LOOP UNLESS END OF LIST
	MOVEI	A5,DBASE+1	; HEAD OF CHAIN
	ADDM	A4,(A5)		; UPDATE THE POINTER
	HLRE	A5,(A5)		; LOCATE NEXT DISPLAY POINTER IN CHAIN
	JUMPG	A5,.-2		; LOOP UNLESS END OF LIST
	MOVEI	A4,DELTA	; UPDATE FACTOR
	ADD	SP,A4		; SET POINTER TO NEW LOCATION OF STACK
	POPJ	SP,		; EXIT OVFL


OVFLX:	TTCALL	3,OVFLXM	; SEND MSG TO TTY
	JRST	TERMIN		; TERMINATE COMPILATION

OVFLXM:	ASCIZ	/?MORE CORE REQUIRED
/
OVFLS:	MOVEM	A4,OVA		; SAVE A4
	MOVEM	A5,OVB		; SAVE A5
	MOVEM	A6,OVC		; SAVE A6
	MOVEM	A3,OVD		; SAVE A3
	POPJ	SP,		; EXIT OVFLS

	; STACK OVERFLOW ALLOCATING STACK LOCALS

OVFL5:	MOVEM	A4,OVA		; SAVE ACC A4
	MOVE	A4,.STOVE	; GET RETURN LINK
	MOVEM	A4,.JBTPC	; SAVE IN JOBTPC
	JRST	.+2		; SKIP

	; STACK OVERFLOW BY PUSH OR PUSHJ

OVFL4:	MOVEM	A4,OVA		; SAVE IN ACC A4
	MOVEI	A4,DELTA	; CORE INCREMENT
	ADDB	A4,COREND	; NEW END OF LOW SEGMENT
	HRRZM	A4,.JBFF	; SET JOBFF
	CORE	A4,		; GET MORE CORE
	JRST	OVFLX		; -NOT AVAILABLE, TERMINATE
	HRLZI	A4,-DELTA	; CORRECTION CONSTANT
	ADD	SP,A4		; FIX UP STACK POINTER
	MOVE	A4,OVA		; RESTORE ACC A4
	JRST	2,@.JBTPC	; RETURN TO COMPILATION



	RELOC

OVA:	BLOCK	1
OVB:	BLOCK	1
OVC:	BLOCK	1
OVD:	BLOCK	1
.STOVE:	BLOCK	2		; RETURN LINK
;	JRST	OVFL5		; JUMP INTO HIGH SEGMENT

	RELOC
SUBTTL  ** NEW-LINE **

;	*** NEW-LINE ROUTINE ***
;
;	THIS ROUTINE IS CALLED WHENEVER A CARRIAGE-RETURN, LINE-FEED,
;	OR OTHER SUCH CHARACTER IS SCANNED.  NEWLINE PERFORMS ALL I/O
; 	PROCESSING ASSOCIATED WITH THE SOURCE AND LISTING FILES.
;	NEWLINE RETURNS IN REGISTER A1 THE 1ST CHAR OF THE NEXT
;	LINE.  REGISTERS A1 - A6 ARE NOT SAFE OVER NEWLINE.
;
;
;	THROUGHOUT THE COMPILER, CHARACTERS ARE SCANNED WHERE THEY SIT
;	IN THE SOURCE BUFFER RING.  CHARACTERS ARE READ WITH AN "ILDB".
;	THE LISTING IS FORMED BY TRANSFERING CHARACTERS FROM THE SOURCE
;	BUFFER RING TO THE LISTING BUFFER RING WITH A "BLT" INSTRUCTION.
;	A "BLT" IS 20 TIMES FASTER PER CHARACTER THAN AN "IDPB", ALTHOUGH
;	THERE IS A GREATER OVERHEAD INVOLVED AT THE BEGINNING OF EACH LINE.
;
;	THE FOLLOWING ARE SOME OF THE CHARACTERISTICS OF THE "NEWLINE" ROUTINE:
;
;	1.)  THE POSITIONS OF THE CHARACTERS IN THE WORDS MUST BE THE SAME
;	IN THE SOURCE AND LISTING BUFFERS.  THEREFORE, ANYTHING ELSE THAT APPEARS
;	IN THE LISTING MUST BE ARRANGED IN STRINGS THAT ARE A MULTIPLE OF
;	5 CHARACTERS AND WHICH ARE MOVED TO THE LISTING WITH IDPB'S.
;	THIS INCLUDES THE LINE PREFIX (ON THE FRONT OF EACH LINE OF ALGOL
;	TEXT IN THE LISTING), WHICH ALSO MUST BE A MULTIPLE OF 8 PRINTABLE
;	CHARACTERS SO THAT TABS ALIGN CORRECTLY.
;
;	2.)  THE LINE IS MOVED FROM THE SOURCE BUFFER RING TO THE LISTING BUFFER
;	RING AFTER THE LINE HAS BEEN SCANNED, SINCE UNTIL THEN THE EXTENT
;	OF THE LINE IS NOT KNOWN.  WHENEVER A NEW SOURCE BUFFER IS OBTAINED
;	FROM THE SOURCE DEVICE, A WORD CONTAINING A CR/LF IS INSERTED AFTER
;	THE DATA IN THE BUFFER TO MARK ITS END.  THUS, WHENEVER A CR IS SCANNED
;	A CHECK MUST BE MADE TO SEE IF  IT IS THE END OF THE BUFFER.

;	3.)  A CONSIDERABLE AMOUNT OF CODE IS DEDICATED TO HANDLING THE
;	FOLLOWING EXCEPTIONAL CASES:  WHEN THE LINE WONT FIT IN WHAT IS LEFT
;	OF THE OUTPUT BUFFER ("SHOB1" AND "SHOB2"),  AND WHEN THE SOURCE
;	LINE IS SPLIT OVER TWO INPUT BUFFERS ("INEND" AND "SHIB").
;	WHEN THE INPUT LINE IS SPLIT OVER TWO INPUT BUFFERS, THE 1ST PART
;	MUST BE SAVED (IN "TMPBUF") WHILE THE 2ND PART IS BEING SCANNED,
;	SINCE ONCE THE NEW INPUT BUFFER IS OBTAINED, THE OLD INPUT BUFFER IS
;	NO LONGER RELIABLE.
				; THE RIGHT HALF OF RFLAGS CONTAINS
				; THE ADDRESS OF ONE OF THE FOLLOWING:
				;    NORMAL:
				;    NOLIST:
				;    NLIST1:
				;    ENDPRG:

NEWLINE: MOVEM	A7,A7SAV	; SAVE A7
	MOVE	A7,RFLAGS	; GET READ MODULE FLAGS
	JRST	(A7)		; GO TO APPROPRIATE ROUTINE


	; LISTING EXISTS AND WAS ON

NORMAL:	SETCM	A2,A7		; IF SOURCE
	TLNN	A2,TTY!LTTY	; AND LISTING ARE TTY
	JRST	NLIST1		; THEN SUPRESS LISTING
	TRNN	FL,LISTOO	; DID HE TURN LISTING OFF?
	JRST	TURNOF		; -YES

	; LISTING EXISTS AND IS ON

TURNON:	MOVE	A2,P		; PUT READ POINTER IN A2
	TLNE	A7,ESWIT	; IF LINE NUMBERS IN 73-80
	MOVE	A2,LINEND	; THEN GET TRUE READ POINTER
	MOVEM	A2,P		; SAVE TRUE READ POINTER
	CAMN	A2,IBEND	; AT END OF INPUT BUFFER?
	JRST	INEND		; -YES, GET ANOTHER
	TLO	A7,WITHIN	; WE ARE WITHIN THE NEWLINE ROUTINE

	; PRINT THE 1ST BATCH OF MESSAGES

	MOVEI	A5,MTABLE	; ADDR OF MESSAGE TABLE
	CAML	A5,NAMTE	; IF END OF TABLE
	JRST	NL2		; THEN NO MESSAGES TO PRINT
	SETZM	LMSGS		; SET LMSG SWITCH TO "1ST PASS"
	PUSHJ	SP,LMSG		; PRINT 1ST GROUP OF MESSAGES

NL2:	SKIPLE	FFCNT2		; IF THERE ARE FORM-FEEDS THAT HAVE NOT
	PUSHJ	SP,INSFF	; YET BEEN PUT IN LISTING, PUT THEM THERE
	PUSHJ	SP,CREFNL	; IF CREF, DO CREF STUFF

	; MAKE SURE THAT THERE IS ROOM IN OUTPUT BUFFER FOR 1ST PART OF LINE

	MOVEI	A1,.SPACE	; PUT A BLANK IN ACC A1
	MOVE	A4,W		; GET WRITE POINTER
	TLNE	A7,LTTY		; IF THE LISTING IS TO THE TTY
	JRST	NL15		; THEN PRODUCE A DIFFERENT LISTING
	MOVEI	A4,5(A4)	; GO AHEAD 5 WORDS
	CAML	A4,OBEND	; AT END OF BUFFER?
	PUSHJ	SP,SHOB1	; -YES, GET ANOTHER
	; PRINT PROGRAM COUNTER

	SETZM	(A4)		; CLEAR 1ST CHARS OF TEXT
	MOVEI	A5,6		; PRINT 6 CHARS
	TLNE	A7,TMG		; IF NO REL FILE
	JRST	NL18		; THEN DONT PRINT PC
	MOVE	A4,[		; LOAD A POINTER TO
	POINT	3,RA,17]	; PROGRAM COUNTER

NL1:	ILDB	A6,A4		; GET 3 BITS
	MOVEI	A6,.N0(A6)	; CONV TO ASCII
	IDPB	A6,W		; PUT IN LISTING
	SOJG	A5,NL1		; LOOP

NL19:	IDPB	A5,W		; INCLUDE A NULL

	; PRINT BEGIN NUMBER

	MOVE	A4,BNUM		; LOAD BEGIN NUMBER
	CAMN	A4,LBNUM	; COMPARE TO LAST BEGIN NUMBER
	JSP	A3,NL3		; -SAME, PRINT SOME BLANKS
	MOVEM	A4,LBNUM	; SAVE AS LAST BEGIN NUMBER
	MOVEI	A2,.B		; WRITE A "B"
	MOVEI	A3,5		; WRITE 5 CHARS
	PUSHJ	SP,DEC		; WRITE IT

	; PRINT END NUMBER

	MOVE	A4,ENUM		; LOAD END NUMBER
	CAMN	A4,LENUM	; COMPARE TO LST END NUMBER
	JSP	A3,NL3		; -SAME, PRINT SOME BLANKS
	MOVEM	A4,LENUM	; SAVE AS LAST END NUMBER
	MOVEI	A2,.E		; WRITE AN "E"
	MOVEI	A3,5		; WRITE 5 CHARS
	PUSHJ	SP,DEC		; CONVERT TO DECIMAL
	JRST	NL6		; CONTINUE


	; SUBROUTINE FOR PUTTING 5 BLANKS IN LISTING INSTEAD OF BEGIN/END NUMBER

NL3:	MOVEI	A5,5		; WRITE 5 BLANKS
	IDPB	A1,W		; INCLUDE A BLANK
	SOJG	A5,.-1		; LOOP
	JRST	4(A3)		; EXIT
	; PUT 6 BLANKS IN LISTING INSTEAD OF PC

NL18:	IDPB	A1,W		; PUT BLANK IN LISTING
	SOJG	A5,NL18		; LOOP 5 MORE TIMES
	JRST	NL19		; CONTINUE



	; PUT LINE NUMBER IN LISTING

NL6:	TLZN	A7,ELINE	; IF TEXT HAS A LINE NUMBER
	TLNE	A7,ESWIT	; OR NUMBERS IN 73-80
	JRST	NL5		; THEN DONT GENERATE A LINE NUMBER
	MOVE	A4,LINENO	; GET LINE NUMBER
	MOVEI	A2,.SPACE	; ACC A2 = BLANK
	MOVEI	A3,7		; PRINT 7 CHARS LONG
	PUSHJ	SP,DEC		; CONVERT TO DECIMAL
	JRST	NL7		; CONTINUE

NL5:	MOVEI	A3,0
	IDPB	A3,W		; INSERT A NULL
	IDPB	A1,W		; INCLUDE ANOTHER SPACE
	TLNN	A7,ESWIT	; IF NOT NUMBERS IN 73-80
	JRST	NL7		; THEN SKIP THIS PART
	MOVE	A2,CHAR		; GET THE SAVED CHARACTER
	DPB	A2,CHARP	; REINSERT IT INTO ITS PLACE IN THE LINE

	; READ THE LF THAT FOLLOWS THE CR

NL7:	IDPB	A1,W		; PUT BLANK IN LISTING
	MOVE	A2,P		; LOAD READ POINTER
	PUSHJ	SP,GETNL	; READ NEXT CHAR
	MOVE	A3,CTABLE(A1)	; GET TABLE ENTRY
	CAIN	A3,4		; IF IT IS A LF
	MOVEM	A1,CHAR2	; THEN SAVE THIS CHAR
	CAIE	A3,4		; IS IT A LF?
	ADD	A2,[		; BACK UP POINTER
	XWD	070000,0]	; POINTER DECREMENT CONSTANT
	; PUT 1ST WORD OF LINE TEXT IN OUTPUT BUFFER

	MOVE	A6,LSTART	; POINTER TO BEGINNING OF LAST LINE
	MOVEM	A2,LSTART	; SET NEXT LINE START
	HLLZ	A4,W		; GET WRITE POINTER S-P BITS
	ROT	A4,4		; PUT 1ST 4 BITS IN RIGHT HALF
	MOVE	A4,MSKTBL(A4)	; GET A MASK
	AND	A4,@A6		; MASK OFF EXTRANEOUS CHARS
	IORM	A4,@W		; PUT REMAINING CHARS IN LISTING

	; MOVE REMAINDER OF ALGOL TEXT TO OUTPUT BUFFER WITH A BLT

	AOS	A5,W		; STEP WRITE POINTER AND LOAD IT
	HRLI	A5,1(A6)	; STEP OLD READ POINTER
	SKIPE	TBLEN		; IS INPUT LINE SPLIT OVER 2 BUFFERS?
	JRST	SHIB		; -YES, TREAT SEPARATELY
	MOVEI	A4,(A2)		; CURRENT READ POINTER ADDRESS
	SUBI	A4,1(A6)	; CURRENT LINE LENGTH
	ADDI	A4,@W		; END OF LINE IN WRITE BUFFER

	;
	; Edit(1005)  Deal with very long source lines correctly
	;
NL14:	CAMGE	A4,OBEND	; [E1005] WILL LINE OVERFLOW OUTPUT BUFFER?
	JRST	.+3		; [E1005] - NO, SO OK
	PUSHJ	SP,SHOB2	; [E1005] - YES, HANDLE WITH CARE
	JRST	NL14		; [E1005] - TRY AGAIN
	CAIL	A4,(A5)		; NEGATIVE LENGTH?

NL13:	BLT	A5,(A4)		; MOVE THE LINE
	HLL	A4,A2		; FORM NEW WRITE POINTER
	MOVEM	A4,W		; SAVE IT

	; PRINT 2ND BATCH OF MESSAGES

NL10:	PUSHJ	SP,GETNL	; STEP TO NEXT CHAR
	MOVEI	A5,MTABLE	; ADDR OF MESSAGE TABLE
	CAML	A5,NAMTE	; IF NO MESSAGES IN TABLE
	JRST	NL9		; THEN SKIP THIS PART
	SETOM	LMSGS		; SET LMSG SWITCH TO 2ND PASS
	PUSHJ	SP,LMSG		; PRINT REST OF MSGS
	MOVEI	A1,MTABLE	; START OF MESSAGE TABLE
	MOVEM	A1,NAMTE	; SET POINTER TO START OF TABLE

	; PROCESS ANY FORM FEEDS

NL9:	LDB	A1,A2		; GET THE NEXT CHAR
	JUMPN	A1,.+3		; SKIP THIS IF NOT A NULL
	PUSHJ	SP,GETNL	; READ THE NEXT CHAR
	JUMPE	A1,.-1		; READ ANOTHER IF IT IS A NULL
	TLZ	A7,WITHIN	; WE ARE ABOUT TO EXIT THE NEWLINE ROUTINE
	CAIE	A1,.FF		; IF IT IS NOT A FORM-FEED
	JRST	NL11+1		; THEN SKIP THIS PART
	PUSHJ	SP,FFOUND	; PROCESS THE FORM-FEED
	JRST	NL9+2		; LOOK FOR ANOTHER FORM-FEED
	; SKIP OVER ANY NULLS AT BEGINNING OF NEXT LINE

NL11:	PUSHJ	SP,GETNL	; READ NEXT CHAR
	JUMPE	A1,NL11		; READ AGAIN IF A NULL

	; PROCESS LINE NUMBER IF ANY

	TLNE	A7,ESWIT	; IF NUMBERS IN 73-80
	JRST	COL73		; THEN SCAN THE LINE NUMBER
	MOVE	A4,LINENO	; GET OLD LINE NUMBER
	MOVE	A5,(A2)		; PICK UP FIRST WORD
	TRNN	A5,1		; IS IT A LINE NUMBER?
	AOJA	A4,NL8		; -NO, INCREMENT LINE NO. AND SKIP
	CAIN	A1,.SPACE	; IF LINE NUMBER IS BLANK
	JRST	BLN		; THEN JUMP
	MOVEI	A5,4		; SCAN NEXT 4 CHARS
	MOVEI	A4,-.N0(A1)	; CONVERT 1ST CHAR TO DECIMAL
	PUSHJ	SP,GETNL	; GET NEXT CHAR
	IMULI	A4,^D10		; MULTIPLY PREVIOUS RESULT BY 10
	ADDI	A4,-.N0(A1)	; ADD IN CURRENT CHAR
	SOJG	A5,.-3		; LOOP
	PUSHJ	SP,GETNL	; SKIP OVER TAB
	SOS	CC		; DONT COUNT THIS AS A POSITION
	CAIN	A1,.FF		; IF IT IS A FORM-FEED
	PUSHJ	SP,FFOUND	; THEN PROCESS IT
	CAIE	A1,.TAB		; IF IT IS NOT A TAB
	JRST	NOTAB		; THEN TREAT SEPARATELY

NL16:	PUSHJ	SP,GETNL	; GET NEXT CHAR
	CAIE	A1,.FF		; IF IT IS NOT A FORM-FEED
	JRST	.+3		; THEN SKIP THIS PART
	PUSHJ	SP,FFOUND	; PROCESS IT
	JRST	NL16		; READ ANOTHER CHAR
	TLO	A7,ELINE	; MARK: EDITOR LINE NUMBER SCANNED
	; SAVE ALL LINE POINTERS

NL8:	MOVE	A5,CC		; GET POSITION COUNT
	EXCH	A4,LINENO	; SET NEW LINE NUMBER
	EXCH	A5,LP1		; SET START OF CURRENT LINE
	TLZE	A7,BLANKL	; IF THIS WAS A BLANK LINE
	JRST	.+3		; THEN SKIP
	MOVEM	A4,OLDNO	; SET OLD LINE NUMBER
	MOVEM	A5,LP2		; SET START OF PRECEDING LINE

	; CHECK FOR A BLANK LINE

	MOVE	A5,CTABLE(A1)	; GET CHARS TABLE ENTRY
	CAIN	A5,4		; IF IT IS A NEW LINE CHAR
	TLO	A7,BLANKL	; THEN MARK THIS A BLANK LINE

	; EXIT FROM NEWLINE

	MOVEM	A2,P		; SAVE READ POINTER
	PUSHJ	SP,CREFST	; O/P CREF START DATA, IF WE'RE CREF'ING
	MOVEM	A7,RFLAGS	; STORE READ-MODULE FLAGS
	MOVE	A7,A7SAV	; RESTORE A7
	JRST	SKRET		; EXIT NEWLINE

SUBTTL	** SUBROUTINES OF NEWLINE  **

	; ROUTINES FOR CROSS-REFERENCING.

CREFIT:	; ENTER WITH LEXEME OF IDENTIFIER IN A1. CALLED FROM SEARCH.
	MOVE	A2,SYMNAM(A1)	; GET FIRST WORD OF NAME
	ANDI	A2,77		; GET # CHARS - 1
	ADDI	A2,1
	DPB	A2,[
	POINT	7,CREFRF,13]	; PUT INTO CREF DATA
	ADDI	A2,3		; ALLOW FOR ^A^? AND POSSIBLE ^B
	ADDM	A2,CRFCNT	; UPDATE CHAR-COUNTER
	PUSHJ	SP,NAME		; GET NAME IN ASCIZ
	MOVEI	A1,CREFRF
	EXCH	A7,RFLAGS	; GET READ-MODULE FLAGS
	PUSHJ	SP,INSERT	; OUTPUT (<DEL> B) ^A^?
	MOVEI	A1,LB		; WHERE NAME ROUTINE LEFT IT
	PUSHJ	SP,INSERT	; SYMBOL NAME
	MOVEI	A1,CREFDF	; DEFINITION FLAG
	HRRZ	A2,NDEL		; GET TERMINATING DELIMITER,
	CAIN	A2,15		; AND IF IT IS A COLON THEN
	JRST	CREFLB		; THIS IS A LABEL DEFINITION
	TRNN	FL,DECLAR	; DECLARATION ?
	SOSA	CRFCNT		; NO - DON'T ALLOW FOR ^B IN COUNT OF CHARS
CREFLB:	PUSHJ	SP,INSERT	; YES - TELL CREF
	EXCH	A7,RFLAGS	; PUT READ-MODULE FLAGS AWAY.
	POPJ	SP,		; BACK TO SEARCH

CREFNL:	; CALLED BY NEWLINE JUST BEFORE PRINTING SOURCE-LINE
	MOVEI	A1,CREFND	; END CREF DATA
	JRST	CRFNL3

CRFNL2:	MOVEI	A1,[
	BYTE(7)177,"D",0,0,0]	; <DEL>D - END CREF DATA - NO LINE #

CRFNL3:	SKIPE	CRFCNT		; ANY CREF'ING DONE ON THIS LINE ?
	TRNN	FL,CREF		; ANY CREF'ING AT ALL ?
	POPJ	SP,		; NO
	PUSHJ	SP,INSERT	; <DEL> A
	AOS	CRFCNT		; ALLOW FOR <DEL>A
	AOS	A1,CRFCNT	; # OF CHARACTERS OUTPUT BY CREF
	IDIVI	A1,5		; 
	JUMPE	A2,CRFNL1	; WHOLE # OF WORDS ?
	SUBI	A2,5
	MOVEM	A2,CRFCNT	; NO - MUST MAKE IT SO
	PUSHJ	SP,INSNUL	; BY PUTTING IN NULLS
	AOSE	CRFCNT		; ENOUGH ?
	JRST	.-2		; NO

CRFNL1:	SETZM	CRFCNT		; CLEAR COUNT
	POPJ	SP,
CREFST:	; OUTPUT START-OF-CREF DATA, IF REQUIRED.
	SKIPN	CRFCNT		; NOT ALREADY STARTED, AND...
	TRNN	FL,CREF		; CREF ?
	POPJ	SP,		; NO
	PUSH	SP,A1		; YES - SAVE A1 (USED IN NEWLINE)
	MOVEI	A1,[
	BYTE(7)177,"B",0,0,0]	; <DEL>B - START CREF DATA
	PUSHJ	SP,INSERT	; OUTPUT IT
	MOVEI	A1,2		; UPDATE 
	ADDM	A1,CRFCNT	;  CREF COUNTER
	POP	SP,A1
	POPJ	SP,

CREFDF:	BYTE(7)2,0,0,0,0	; ^B (DEFINITION FLAG)
CREFND:	BYTE(7)177,"A",0,0,0	; <DEL> A (END OF CREF DATA)

	RELOC

CREFRF:	BLOCK	1
;	BYTE(7)1,0,0,0,0	; ^A (SYMBOL REF. 2ND BYTE PLUGGED WITH LENGTH)
CRFCNT:	BLOCK	1		; # OF CHARS O/P BY CREF

	RELOC

	; BRIEF FORM OF LISTING FOR WHEN SENT TO TTY

NL15:	TLNN	A7,ELINE	; IF THERE IS AN EDITOR'S LINE NUMBER
	TLNE	A7,ESWIT	; OR NUMBERS IN 73 - 80
	JRST	NL7+1		; THEN DONT GENERATE ANOTHER ONE
	MOVEI	A4,2(A4)	; END OF WHERE LINE PREFIX WILL GO
	CAML	A4,OBEND	; IF PAST END OF BUFFER
	PUSHJ	SP,SHOB1	; THEN GET ANOTHER OUTPUT BUFFER
	MOVE	A4,LINENO	; GET THE CURRENT LINE NUMBER
	MOVEI	A2,.SPACE	; PRECEDE WITH A SPACE
	MOVEI	A3,7		; FIELD IS 7 CHARS WIDE
	PUSHJ	SP,DEC		; PUT LINE NUMBER IN LISTING
	IDPB	A3,W		; PUT AN ASCII NULL IN LISTING
	IDPB	A3,W		; PUT IN ANOTHER ONE
	JRST	NL7		; CONTINUE



	; LISTING EXISTS BUT WAS OFF

NOLIST:	TRNN	FL,LISTOO	; IF SO, IS IT CURRENTLY ON?
	JRST	NLIST1		; -NO, CONTINUE WITH NO LISTING
	HRRI	A7,NORMAL	; TIME TO TURN LISTING BACK ON
	JRST	TURNON		; CONTINUE AS ON

	; TURN LISTING OFF

TURNOF:	HRRI	A7,NOLIST	; TURN LISTING OFF

	; LISTING IS OFF

NLIST1:	MOVE	A2,P		; LOAD READ POINTER
	TLNE	A7,ESWIT	; IF NUMBERS IN 73-80
	MOVE	A2,LINEND	; GET TRUE READ POINTER
	MOVEM	A2,P		; SAVE TRUE VALUE
	CAMN	A2,IBEND	; AT END OF INPUT BUFFER?
	JRST	INEND		; -YES, GET A NEW INPUT BUFFER
	TLO	A7,WITHIN	; WE ARE WITHIN THE NEWLINE ROUTINE
	MOVEM	A2,LSTART	; SAVE POINTER FOR LATER
	SETZM	SSTART		; CLEAR SEGMENT START MARKER
	SETZM	TBLEN		; EMPTY OUT TMPBUF

	; PRINT 1ST BATCH OF MESSAGES

	MOVEI	A5,MTABLE	; ADDR OF MESSAGE TABLE
	CAML	A5,NAMTE	; IF NO MESSAGES IN TABLE
	JRST	NLIST2		; THEN SKIP THIS PART
	SETZM	LMSGS		; SET LMSG SWITCH TO 1ST PASS
	PUSHJ	SP,LMSG		; PRINT MESSAGES
	; READ THE LF THAT FOLLOWS THE CR

NLIST2:	PUSHJ	SP,GETNL	; GET NEXT CHAR
	MOVE	A4,CTABLE(A1)	; GET TABLE ENTRY
	CAIE	A4,4		; IT IS NORMALLY A LF
	JRST	NL10+1		; -NO, CONTINUE WITHOUT STEPPING READ POINTER
	MOVEM	A2,LSTART	; SAVE READ POINTER
	MOVEM	A1,CHAR2	; SAVE THIS CHAR
	JRST	NL10		; CONTINUE

;	"GETNL" WILL READ THE NEXT CHARACTER OF THE SOURCE TEXT.  "GETNL" 
;	MUST BE USED WHENEVER A CHARACTER IS TO BE READ WITHIN "NEWLINE".
;	"GETNL" WILL CALL "INEND" IF AN END OF BUFFER OCCURRS.


GETNL:	ILDB	A1,A2		; GET NEXT CHAR
	AOS	CC		; STEP POSITION COUNT
	CAME	A2,IBEND	; UNLESS AT END OF INPUT BUFFER
	POPJ	SP,		; EXIT GETNL
	MOVEM	A2,P		; INEND WANTS POINTER SET
	PUSHJ	SP,INEND	; READ NEXT INPUT BUFFER
	MOVE	A7,RFLAGS	; RELOAD READ MODULE FLAGS
	MOVE	A2,P		; RELOAD READ POINTER
	JRST	GETNL+2		; TEST AGAIN
;	"INEND" IS CALLED WHENEVER THE END OF AN INPUT BUFFER IS REACHED.
;	"INEND" WILL MOVE THE 1ST PART OF THE SPLIT INPUT LINE TO "TMPBUF"
;	AND THEN CALL "READ" TO OBTAIN THE NEXT INPUT BUFFER.

INEND1:	MOVEM	A2,NLR+4	; SAVE A2
	MOVE	A2,A1		; MOVE READ POINTER TO A2
	MOVEM	A7,A7SAV	; SAVE A7
	MOVE	A7,RFLAGS	; GET READ MODULE FLAGS

INEND:	MOVEM	A4,NLR		; SAVE A4
	MOVEM	A5,NLR+1	; SAVE A5
	MOVEM	A6,NLR+2	; SAVE A6
	MOVEM	A3,NLR+3	; SAVE A3
	HRRZ	A6,A2		; GET READ POINTER
	SKIPN	A5,SSTART	; UNLESS LINE ALREADY BROKEN ONCE
	MOVE	A5,LSTART	; GET START OF LINE SEGMENT
	SUBI	A6,(A5)		; LENGTH OF DATA TO MOVE
	MOVEI	A4,TMPBUF-1(A6)	; END OF LINE IN TEMPBUF
	HRLZI	A5,(A5)		; MOVE SEGMENT FROM RING BUFFER
	HRRI	A5,TMPBUF	; TO TEMP BUFFER
	HRRM	A5,LSTART	; SET NEW VALUE FOR LSTART
	ADD	A4,TBLEN	; ADD TO WHAT IS IN TMPBUF
EDIT(025); BE MORE INFORMATIVE IF WE ARE GIVING UP
	CAIGE	A4,BUF0		; [E025] WILL IT ALL FIT IN TMPBUF ?
	 JRST	INEND2		; [E025] YES - CARRY ON
	OUTSTR	[ASCIZ	/
? SOURCE STATEMENT TOO LONG /]	; [E025] NO  - TELL USER
	JRST	TERMIN		; THEN GIVE UP
INEND2:	ADD	A5,TBLEN	; [E025] ADD TO WHAT IS IN TMPBUF
	ADDM	A6,TBLEN	; ADDITIONAL LENGTH OF TMPBUF
	BLT	A5,(A4)		; MOVE LINE
	PUSHJ	SP,READ		; READ NEXT BUFFER

INEND5:	MOVE	A5,P		; GET NEW POINTER
	MOVEI	A5,1(A5)	; ADD 1
	MOVEM	A5,SSTART	; SAVE THIS ADDR
	ILDB	A1,P		; READ 1ST CHAR
	CAIN	A1,.CZ		; IF THIS IS A CONTROL-Z
	JRST	INEND4		; THEN READ AGAIN
	MOVEM	A7,RFLAGS	; SAVE READ-MODULE FLAGS
	MOVE	A7,A7SAV	; RESTORE A7
	MOVE	A4,NLR		; RESTORE A4
	MOVE	A5,NLR+1	; RESTORE A5
	MOVE	A6,NLR+2	; RESTORE A6
	MOVE	A3,NLR+3	; RESTORE A3
	MOVE	A2,NLR+4	; RESTORE A2
	POPJ	SP,		; EXIT NEWLINE

INEND4:	PUSHJ	SP,READ1	; CALL INEND BUT DONT PRINT A LINE NUMBER ON TTY
	JRST	INEND5		; CONTINUE
;	IF THE SOURCE DEVICE IS A TTY, "READ" WILL SEND THE NEXT LINE NUMBER
;	TO THE TTY.  THEN "READ" WILL OBTAIN THE NEXT BUFFER FROM THE SOURCE
;	DEVICE, AND MARK THE END OF DATA IN IT WITH A WORD CONTAINING A
;	CR/LF.

READ:	TLNN	A7,TTY		; IS SOURCE DEVICE A TTY?
	JRST	READ1		; -NO, SKIP WRITING A LINE NUMBER
	TLNN	A7,WITHIN	; IF WITHIN THE NEWLINE ROUTINE
	JRST	READ1		; THEN PRINT NUMBER ELSE SKIP THIS PART
	PUSH	SP,W		; SAVE W
	MOVEI	A5,BUF0
	HRLI	A5,440700
	MOVEM	A5,W		; SET UP BYTE POINTER
	MOVE	A4,LINENO	; GET CURRENT LINE NUMBER
	ADDI	A4,1		; INCREMENT IT
	MOVEI	A2,.SPACE
	MOVEI	A3,7
	PUSHJ	SP,DEC		; PRINT LINE NO.
	MOVEI	A4,.SPACE	; LOAD A BLANK
	IDPB	A4,W		; PUT THE BLANK IN BUFFER
	MOVEI	A4,0
	IDPB	A4,W		; AND FINISH WITH A NULL
	POP	SP,W		; RESTORE W
	TTCALL	3,BUF0		; OUTPUT LINE NUMBER

READ1:	IN	3,0		; INPUT NEXT BUFFER
	JRST	INOKA		; -SUCCESSFUL READ
	STATO	3,710000	; WAS IT A READ ERROR?
	JRST	EOF		; -NO, JUST END OF FILE
	TTCALL	3,INERRM	; WRITE ERROR MSG
	JRST	TERMIN		; TERMINATE COMP


INERRM:	ASCIZ	/?INPUT ERROR
/


	; INPUT BUFFER READ SUCCESSFULLY

INOKA:	MOVE	A6,BHEAD3	; ADDR OF CURRENT BUFFER
	HRRZ	A5,1(A6)	; LENGTH OF BUFFER IN WORDS
	JUMPE	A5,READ		; IF EMPTY GET ANOTHER BUFFER
	ADD	A5,P		; ADDR OF END OF BUFFER
	SKIPN	(A5)		; BACKUP OVER NULLS
	SOJA	A5,.-1
	MOVE	A4,NLCHRS	; LOAD A CR/LF
	MOVEM	A4,1(A5)	; PUT IT AT END OF BUFFER
	ADD	A5,[		; HOW POINTER WILL LOOK AT
	XWD	350000,1]	; END OF BUFFER
	MOVEM	A5,IBEND	; STORE FOR LATER COMPARISON
	POPJ	SP,		; EXIT INEND
	; END-OF-FILE ENCOUNTERED

EOF:	MOVE	A4,BHEAD3	; LOCATE CURRENT BUFFER RING
	MOVEM	A4,OLDSBR	; SAVE ITS ADDRESS
	CLOSE	3,0		; CLOSE SOURCE FILE
	SKIPG	CSCOMP		; IF NO MORE SOURCE FILES
	JRST	ENDPRG		; THEN RETURN EOF LEXEME
	TLZ	A7,ESWIT	; TURN OFF 73-80 INDICATOR
	SETZM	CSCOMP		; CLEAR SWITCH
	PUSHJ	SP,SCAN3	; SCAN NEXT SOURCE FILE AND OPEN IT
	JRST	READ		; READ 1ST BUFFER

	; END OF SOURCE DATA (NO MORE SOURCE FILES)

ENDPRG:	HRRI	A7,ENDPRG	; LSCAN WILL READ NO MORE
	MOVEM	A7,RFLAGS	; SAVE READ-MODULE FLAGS
	MOVE	A7,A7SAV	; RESTORE A7
	MOVE	A2,[		; SET UP A POINTER TO
	POINT	7,NLCHRS]	; A NEW-LINE CHAR
	MOVEM	A2,P		; PUT IN READ POINTER
	MOVE	A3,ZEOF		; OUTPUT END-OF-FILE LEXEME

	; RETURN TO CALLER OF LSCAN

EOF5:	POP	SP,A4		; GET RETURN LINK
	MOVEI	A4,(A4)		; CLEAR LEFT HALF
	CAIN	A4,EMPTY
	JRST	EMPTY1		; NULL FILE
	CAIE	A4,RUND0
	CAIN	A4,RUND5	; IF IT IS ONE OF THESE
	JRST	(A4)		; THEN GO THERE
	JRST	EOF5		; ELSE ASCEND ANOTHER LEVEL

NLCHRS:	ASCIZ	/
/
	; NO ROOM IN OUTPUT BUFFER FOR LINE PREFIX

SHOB1:	HLRZ	A5,W		; GET OLD S-P BITS
	PUSHJ	SP,WRITEL	; GET NEXT BUFFER
	AOS	A4,W		; STEP WRITE POINTER, LOAD IT
	SETZM	(A4)		; ZERO 1ST WORD OF LINE IN BUFFER
	SETZM	5(A4)		; ZERO 6TH WORD OF LINE IN BUFFER
	HRLM	A5,W		; SET NEW WRITE POINTER
	POPJ	SP,		; CONTINUE



	; NO ROOM IN OUTPUT BUFFER FOR THE ALGOL TEXT

SHOB2:	SOS	A6,OBEND	; LAST WORD IN BUFFER
	CAIGE	A6,(A5)		; IF FULL UP
	JRST	SHOB3		; THEN SKIP THIS
	MOVE	A3,A5		; SAVE A5
	BLT	A5,(A6)		; AND FILL UP BUFFER
	MOVE	A5,A3		; RESTORE A5

SHOB3:	HRLI	A6,010700
	MOVEM	A6,W		; SET UP W
	SUBI	A4,(A6)		; REMAINDER
	SUBI	A6,-1(A5)	; AMOUNT TRANSFERRED
	HRLZI	A6,(A6)
	ADD	A5,A6		; MOVE UP INPUT POINTER
	PUSHJ	SP,WRITEL	; GET NEW OUTPUT BUFFER
	ADDI	A4,@W		; STOP ADDRESS FOR BLT
	AOS	W		; STEP WRITE POINTER
	HRR	A5,W		; SET UP OUTPUT POINTER
	POPJ	SP,		; [E1005] AND TRY AGAIN

	; INPUT LINE WAS SPLIT OVER 2 INPUT BUFFERS

SHIB:	SOS	A4,TBLEN	; A4=LENGTH OF FIRST PART
	ADDI	A4,@W		; STOP ADDR FOR BLT
	CAMGE	A4,OBEND	; WILL THIS OVERFLOW BUFFER?
	JRST	SHIB1		; -NO, SKIP

	; 1ST PART OF INPUT LINE WILL NOT FIT IN OUTPUT BUFFER

	PUSH	SP,A6		; [E1005] SAVE A6
	PUSHJ	SP,SHOB2	; [E1005] SEND WHAT WE CAN
	POP	SP,A6		; [E1005] RESTORE A6
	JRST	SHIB+2		; [E1005] AND TRY AGAIN
SHIB1:	CAIG	A4,(A5)		; SKIP BLT IF LENGTH NEGATIVE
	JRST	.+3		; -YES, SKIP
	MOVE	A3,A5		; MOVE TO ACC A3
	BLT	A3,-1(A4)	; MOVE 1ST PART OF LINE
	MOVEM	A4,W		; SET W JUST IN CASE SHOB2 IS CALLED
	MOVEI	A5,(A4)		; WHERE 2ND PART WILL START
	HRL	A5,SSTART	; WHERE 2ND PART NOW SITS
	ADDI	A4,(A2)		; ADD CURRENT POINTER ADDR
	SUB	A4,SSTART	; STOP ADDR FOR BLT
	SETZM	TBLEN		; ZERO TBLEN
	SETZM	SSTART		; CLEAR SSTART
	JRST	NL14		; CONTINUE

FFOUND:	MOVEI	A1,0		; ASCII NULL
	DPB	A1,A2		; DELETE FORM FEED FROM INPUT BUFFER
	AOS	FFCNT		; STEP FORM FEED COUNNT
	AOS	FFCNT2		; STEP OTHER FORM FEED COUNT
	POPJ	SP,		; EXIT FFOUND



	; PUT FORM-FEED IN FRONT OF LINE

INSFF:	MOVEI	A1,[
	BYTE(7)177,"F",14,0,0]	; PUT IN "END-OF-CREF",F.F
	TRNN	FL,CREF		; IF CREF, OTHERWISE

INSFF1:	MOVEI	A1,FORM		; ADDRESS OF A FORM-FEED
	PUSHJ	SP,INSERT	; PUT IT IN LISTING
	PUSHJ	SP,IC2		; CALL ICHECK (BUT DONT WRITE A CR/LF)
	SOSLE	FFCNT2		; IF MORE FORM-FEEDS TO INSERT, THEN
	JRST	INSFF1		; LOOP
	TRNN	FL,CREF		; IF NOT CREF
	POPJ	SP,		; EXIT INSFF
	MOVEI	A1,2		; UPDATE CREF-CHARACTER-COUNTER
	ADDM	A1,CRFCNT	;
	MOVEI	A1,[
	BYTE(7)177,"B",0,0,0]	; ELSE START CREF DATA FOR NEW LINE
	JRST	INSERT		; EXIT VIA INSERT

	; LINE NUMBER NOT FOLLOWED BY A TAB

NOTAB:	CAIN	A1,.CR		; IF IT IS A CARRIAGE RETURN
	JRST	.+4		; THEN SKIP THIS PART
	MOVEI	A1,.TAB		; AN ASCII TAB CHARACTER
	DPB	A1,A2		; REPLACE THE CHARACTER WITH A TAB
	JRST	NL16		; CONTINUE
	PUSHJ	SP,GETNL	; READ THE NEXT CHARACTER
	CAIN	A1,.CR		; IF IT IS A CARRIAGE RETURN
	JRST	NL8-1		; THEN IT IS PROBABLY THE SEQUENCE: CR CR LF
	MOVEI	A1,.LF		; LINE-FEED
	PUSHJ	SP,FFOUND+1	; REPLACE CR BY LF ETC.
	JRST	NL8-1		; CONTINUE



	; BLANK LINE NUMBER ENCOUNTERED

BLN:	MOVEI	A5,7		; SKIP OVER 7 CHARACTERS
	MOVEI	A6,0		; ASCII NULL
	DPB	A6,A2		; REPLACE CHARACTER WITH A NULL
	PUSHJ	SP,GETNL	; READ A CHARACTER
	SOJG	A5,.-2		; LOOP
	PUSHJ	SP,FFOUND	; NULL OUT THE FORM-FEED
	JRST	NL11		; CONTINUE
	RELOC

IBEND:	BLOCK	1		; END OF INPUT BUFFER
OBEND:	BLOCK	1		; END OF OUTPUT BUFFER
BNUM:	BLOCK	1		; BEGIN NUMBER
LBNUM:	BLOCK	1		; LAST BEGIN NUMBER
ENUM:	BLOCK	1		; END NUMBER
LENUM:	BLOCK	1		; LAST END NUMBER
LINEND:	BLOCK	1		; READ POINTER AT END OF CURRENT LINE
LINE5:	BLOCK	1		; 5 -CHAR DATASET LINE NUMBER
LSTART:	BLOCK	1		; START OF CURRENT LINE
SSTART:	BLOCK	1		; START OF CURRENT LINE SEGMENT
CHAR:	BLOCK	1		; SAVE CHAR FROM 80-COLUMN LINE
CHARP:	BLOCK	1		; SAVED CHARACTER'S RESTORATION POINTER
TBLEN:	BLOCK	1		; LENGTH OF DATA IN TMPBUF
A7SAV:	BLOCK	1		; SAVE AREA FOR A7
NLR:	BLOCK	5		; SAVE AREA FOR REGISTERS OVER NEWLINE
EDIT(025); INCREASE SIZE OF TMPBUF
TMPBUF:	BLOCK	200		; SAVED 1ST PART OF SPLIT SOURCE LINE

BUF0:	BLOCK	5

	RELOC
;	THE "COL73" ROUTINE WAS CONTRIVED AFTER THE REST OF "NEWLINE" WAS
;	WRITTEN.  "NEWLINE" HAS THE CONVENTION THAT THE LINE NUMBER MUST BE
;	KNOWN BEFORE THE LINE IS SCANNED.  "COL73" WILL CAUSE THE WHOLE
;	LINE TO BE "UNOFFICIALLY" MOVED INTO "TMPBUF" BEFORE SCANNING ANY OF
;	IT SO THAT THE LINE NUMBER CAN FIRST BE SCANNED.  HOWEVER, IF PART
;	OF THE LINE WAS MOVED THERE BY "INEND", ONLY THE LAST PART OF THE LINE
;	IS "UNOFFICIAL".  BY "UNOFFICIAL" IT IS MEANT THAT THE TEXT IS
;	NOT REALLY THERE (NOT INCLUDED IN "TBLEN", WHICH IS THE COUNT
;	OF DATA WORDS IN "TMPBUF"), AND THE LISTING WILL BE TAKEN FROM
;	TEXT IN THE SOURCE BUFFER RATHER THAN FROM "TMPBUF".  HOWEVER
;	THE SOURCE BYTE POINTER WILL POINT INTO "TMPBUF".  THE 1ST CHARACTER
;	OF THE LINE NUMBER IS EXTRACTED AND REPLACED WITH A CR SO THAT
;	THE SCANNER WILL NOT RUN INTO THE LINE NUMBER.


	; FORM READ POINTER TO TMPBUF

COL73:	MOVE	A3,A2		; COPY READ POINTER
	HRRI	A3,TMPBUF	; POINT IT TO TMPBUF
	ADD	A3,TBLEN	; IN CASE SOMETHING ALREADY IN TMPBUF
	MOVEI	A5,^D16		; PUT NEXT 17 WORDS IN TMPBUF

COL73A:	ADDI	A5,(A2)		; END OF SOURCE IN RING BUFFER
	MOVE	A6,IBEND	; END OF RING BUFFER
	CAIGE	A5,(A6)		; IF THE LINE IS ENTIRELY WITHIN RING BUFFER
	JRST	COL73B		; THEN SKIP THIS PART

	; USE INEND TO PUT PART OF LINE IN TMPBUF

	MOVE	A2,LSTART	; GET LINE START
	SKIPN	SSTART		; SKIP IF TMPBUF NOT EMPTY
	TLNE	A2,760000	; IF BYTE POINTER NOT AT END OF WORD
	JRST	.+2		; THEN SKIP THIS PART
	ADDI	A3,1		; THEN IGNORE 1ST WORD OF TMPBUF
	SUBI	A5,(A6)		; EXCESS LENGTH - 1
	MOVEM	A6,P		; SET P
	MOVE	A2,A6		; COPY TO A2
	PUSHJ	SP,INEND	; GET NEXT INPUT BUFFER
	MOVE	A7,RFLAGS	; RE-FETCH READ MODULE FLAGS
	MOVE	A2,P		; RELOAD POINTER
	JRST	COL73A		; MOVE REMAINDER TO TMPBUF
	; MOVE REMAINDER OF LINE TO TMPBUF "UNOFFICIALLY"

COL73B:	MOVEM	A5,LINEND	; SAVE END OF TEXT IN RING BUFFER
	HRLZ	A6,A2		; "FROM" ADDRESS
	HRRI	A6,TMPBUF	; "TO" ADDRESS
	ADD	A6,TBLEN	; IN CASE TMPBUF NOT EMPTY
	SUBI	A5,(A2)		; LENGTH OF MOVE - 1
	JUMPL	A5,.+3		; SKIP IF NOTHING TO MOVE
	ADDI	A5,(A6)		; "STOP" ADDRESS
	BLT	A6,(A5)		; MOVE TEXT TO TMPBUF

	; REPLACE 1ST DIGIT OF LINE NUMBER WITH A CR

	MOVE	A2,A3		; A2 = NEW READ POINTER
	IBP	A3		; STEP TO COLUMN 2
	IBP	A3		; STEP TO COLUMN 3
	ADDI	A3,^D14		; STEP TO COLUMN 73
	LDB	A4,A3		; GET THE CHARACTER THAT IS THERE
	MOVEM	A4,CHAR		; SAVE IT FOR LATER
	MOVEI	A6,.CR		; ASCII CARRIAGE RETURN CHARACTER
	DPB	A6,A3		; PUT IN PLACE OF OTHER CHARACTER
	MOVEM	A3,CHARP	; SAVE POINTER TO THIS CHARACTER
	SUBI	A4,.N0		; CONVERT FROM ASCII TO BINARY
	MOVEI	A6,7		; READ 7 MORE CHARACTERS

	; SCAN LINE NUMBER

COL73C:	ILDB	A5,A3		; READ NEXT CHAR
	CAIN	A5,.SPACE	; IF IT IS A BLANK
	JRST	.+3		; THEN IGNORE IT
	IMULI	A4,^D10		; MULT PREVIOUS RESULT BY 10
	ADDI	A4,-.N0(A5)	; ADD IN CURRENT DIGIT
	SOJG	A6,COL73C	; LOOP

	; FROM TRUE LINE POINTER TO SOURCE BUFFER RING

	HRR	A3,LINEND	; GET POINTER TO TEXT IN RING BUFFER
	TLNN	A3,760000	; STEP POINTER, BUT NOT TO NEXT WORD
	SUBI	A3,1		; TRUE POINTER
	IBP	A3		; THE NEXT CHARACTER TO BE READ FROM THE RING BUFFER
	MOVEM	A3,LINEND	; SAVE THIS POINTER
	LDB	A1,A2		; READ THE NEXT CHARACTER
	JRST	NL8		; CONTINUE
SUBTTL	**  ERROR HANDLING ROUTINES  **

;   ERROR MESSAGES
;
;	ERROR MESSAGES ARE NOT PRINTED IMMEDIATELY AS THE ERRORS ARE
;	DETECTED.  IF THEY WERE THEN, SINCE THE ALGOL TEXT IS NOT MOVED TO
;	THE LISTING UNTIL AFTER THE LINE HAS BEEN SCANNED (FOR EFFICIENCY)
;	USUALLY THE ERROR CODE WOULD APPEAR BELOW THE ERROR MESSAGE, AND
;	OTHER TIMES THE ERROR CODE WOULD APPEAR ABOVE THE ERROR MESSAGE
;	BECAUSE THE SCANNER IS USUALLY PROCESSING AHEAD OF THE SYNTAX
;	ANALYZERS.  TO COMBAT THIS,  MESSAGES ARE BUFFERED IN A MESSAGE TABLE.
;	THEN, WHEN THE SCANNER REACHES THE END OF A LINE, "NEWLINE" WILL
;	1.) PRINT ALL MESSAGES THAT PERTAIN TO THE PRECEDING LINE OF
;	TEXT, 2.) PRINT THE CURRENT LINE OF TEXT, AND 3.) PRINT ALL MESSAGES
;	THAT PERTAIN TO THE CURRENT LINE OF TEXT.
;
;	EACH TIME THE SCANNER READ A CHARACTER WITH AN "ILDB" IT STEPS
;	"CC" WITH AN "AOS".  FOR EACH ITEM SCANNED "RUND" WILL STORE "CC"
;	IN THE CORRECT WORD OF "PLIST".  "PLIST" HAS 4 WORDS, ONE FOR EACH
;	PORT OF THE WINDOW.  "LP1" AND "LP2" CONTAIN THE CHARACTER NUMBERS
;	THAT BEGAN THE CURRENT AND PREVIOUS LINES OF TEXT, RESPECTIVELY.
;	USING ALL OF THE ABOVE, THE MESSAGE ROUTINE CAN TELL EXACTLY
;	WHERE TO PRINT THE UP-ARROW.
;
;	THE MESSAGE ROUTINE USUALLY PRINTS THE UP ARROW 1 POSITION
;	TO THE LEFT OF WHERE IT HAS CALCULATED THAT THE UP-ARROW SHOULD GO.
;	(THIS IS USUALLY A MORE CORRECT PLACE TO PUT IT.)  BUT THIS CAN
;	BE PREVENTED BY STORING THE CHARACTER COUNT WORD WITH BIT ZERO
;	SET TO ONE.
;	".FAILED" IS CALLED BY THE ".FAIL" ROUTINE WITH A1 CONTAINING
;	THE FOLLOWING PARAMETER:
;
;
;
;   +----------------------------------------------------------------+
;   !      ! !    !                 !                                !
;   !      !F!    !      FLAGS      !        MESSAGE NUMBER          !
;   !      ! !    !                 !                                !
;   +----------------------------------------------------------------+
;           4      8              17 18                            35
;
;   BIT 4:	UP-ARROW GOES UNDER READ BYTE POINTER, DONT SHIFT LEFT 1
;   BITS 8-9:	(OF NO CONCERN TO THIS MODULE)
;   BIT 10:	FATAL ERROR. HALT IMMEDIATELY
;   BIT 11:	"ILLEGAL USE OF" TYPE MESSAGE
;   BIT 12:	DELETE REL-FILE
;   BIT 13:	(OF NO CONCERN TO THIS MODULE)
;   BIT 14:	UP-ARROW GOES UNDER SYM
;   BIT 15:	UP-ARROW GOES UNDER DEL
;   BIT 16:	UP-ARROW GOES UNDER NSYM
;   BIT 17:	UP-ARROW GOES UNDER NDEL
;   BITS 18-35:	MESSAGE NUMBER
;	FROM THE ABOVE PARAMETER ".FAILED" WILL COMPUTE A MESSAGE TABLE
;	ENTRY AND INSERT IT INTO THE MESSAGE TABLE.  THE FORMAT OF A MESSAGE
;	TABLE ENTRY IS:
;
;
;
;   +-----------------------------------------------------------------+
;   !               !      !         !                                !
;   !  BYTE COUNT   !FLAGS !KIND/TYPE!       MESSAGE NUMBER           !
;   !               !      !         !                                !
;   +-----------------------------------------------------------------+
;    0             7 8   11 12     17 18                            35
;
;   BITS 0-7:	POSITION OF ARROW ON PRINT PAGE
;   BIT 8:	ERROR ON THE PRECEDING LINE
;   BIT 9:	ERROR ON SOME PREVIOUS LINE
;   BIT 10:	"ILLEGAL USE OF" TYPE MESSAGE
;   BIT 11:	DELETE REL-FILE
;   BITS 12-17:	KIND AND TYPE EXTRACTED FROM LEXEME IN SYM
;   BITS 18-35:	MESSAGE NUMBER
;	THE MESSAGES "START OF BLOCK N" AND "END BLOCK N, CONT M" ARE
;	ALSO BUFFERED IN THE MESSAGE TABLE.  ENTRIES FOR THESE HAVE THE
;	FOLLOWING FORMAT, WHICH IS DISTINGUISHED FROM THE OTHERS BY HAVING
;	A POSITION COUNT OF 377.
;
;
;
;   +-----------------------------------------------------------------+
;   !               !   !                      !                      !
;   !      377      !   !       VALUE 1        !       VALUE 2        !
;   !               !   !                      !                      !
;   +-----------------------------------------------------------------+
;    0             7 8 9 10                  22 23                  35
;
;
;   BITS 0-7:	377
;   BIT 8:	MESSAGE ON THE PRECEDING OR SOME PREVIOUS LINE
;   BIT 9:	MUST BE ZERO
;   BITS 10-22:	VALUE 1
;   BITS 23-35:	VALUE 2
;
;	IF VALUE2 = 0 THEN PRINT "START OF BLOCK (VALUE1)"
;	ELSE PRINT "END BLOCK (VALUE2), CONT (VALUE1)";
	..PREC==1000		; ERROR ON PRECEDING LINE
	..PREV==400		; ERROR ON SOME PREVIOUS LINE
	..IUO1==200		; "ILLEGAL USE OF" FORM
	..TERM==100		; "REL FILE DELETED"



;	".FAIL", ".BLK1", AND ".BLK2" PUT ENTRIES IN THE MESSAGE TABLE,
;	"LMSG" TAKES THEM OUT AND PRINTS THEM.
;	LMSGS = 0 FOR PASS1, -1 FOR PASS2


	; EDIT (1002)	Include bad identifiers in error messages.

LMSG1:	MOVE	A1,(A5)		; [E1002] Get message entry.
	TLNE	A1,..IUO1	; [E1002] If IUO or undeclared identifier
	JRST	.+4		; [E1002] 	...
	HRRZ	A1,A1		; [E1002]	...
	CAIE	A1,1		; [E1002]	...
	JRST	.+3		; [E1002]	...
	PUSHJ	SP,IUOLN	; [E1002] then get entry length in A1
	ADDM	A1,A5		; [E1002] and step extra length.
	AOJA	A5,.+2		; STEP TO NEXT TABLE ENTRY

LMSG:	PUSH	SP,A2		; SAVE A2
	CAML	A5,NAMTE	; END OF MESSAGES?
	JRST	LMSGE		; -YES, DONE
	MOVE	A2,(A5)		; GET ENTRY CONTENTS
	MOVE	A4,LMSGS	; LOAD THE SWITCH
	TLNN	A2,..PREC+..PREV; IF EITHER BIT IS SET
	SETCM	A4,A4		; THEN THIS MESSAGE SHOULD BE PRINTED
	JUMPN	A4,LMSG1	; ONLY ON THE 1ST PASS THROUGH LMSG

	; CHECK FOR "START BLOCK" AND "END BLOCK" ENTRIES


	LSH	A2,-^D28	; COLUMN POINTER
	CAIN	A2,377		; IF BYTES=255 THEN IT IS
	JRST	BLK1A		; A BLOCK BEGIN OR END LINE

	PUSHJ	SP,CRFNL2	; TERMINATE CREF DATA, IF ANY.
	; WRITE: "******   ^"

	MOVEI	A1,STAR3	; "*******"
	PUSHJ	SP,INSERT	; SEND TO LISTING
	MOVE	A2,(A5)		; GET MESSAGE TABLE ENTRY
	TLNE	A2,..PREV	; IF ERROR OCCURRED ON A PREVIOUS LINE
	JRST	LMSG3		; THEN HANDLE SEPARATELY
	LSH	A2,-^D28	; GET ARROW POSITION
	JUMPE	A2,LMSG2	; NO ^ IF ZERO
	TLNN	A7,LTTY		; UNLESS THE LISTING IS GOING TO THE TTY
	ADDI	A2,^D16		; PUT 16 MORE BLANKS AT START OF LINE
	TLNN	A7,EXISTS	; [E134] ARE WE LISTING
	 JRST	LMSG2		; [E134] NO - DON'T BOTHER
	MOVEI	A1,(A2)		; [E134] GET THE COUNT
	MOVEI	A2,.SPACE	; [E134] SPACE CHARACTER
	PUSHJ	SP,INS7		; [E134] PUT CHAR IN BUFFER
	SOJG	A1,.-1		; [E134]
	MOVEI	A2,.UP		; [E134]
	PUSHJ	SP,INS7		; [E134] OUTPUT ^
	SETZ	A2,		; [E134]
	PUSHJ	SP,INS7		; [E134] AND A NULL
	JRST	LMSG2		; [E134]

LMSG4:	PUSHJ	SP,INSERT	; INSERT LINE IN LISTING

LMSG2:	PUSHJ	SP,ICHECK	; INCLUDE CR/LF
	PUSHJ	SP,NPRINT	; PUT ERROR LINE NUMBER IN LISTING

	; WRITE ERROR MESSAGE TO LISTING

	JSP	A6,LMSG0	; GET ERROR MESSAGE
	HLL	A1,(A5)		; GET FLAGS
	TRNN	A1,777777	; IF NO ENTRY THEN
	MOVEI	A1,[		; USE A
	ASCIZ	//]		; LITERAL NULL STRING
	TLNE	A1,..IUO1	; IF "ILLEGAL USE OF"
	PUSHJ	SP,IUO		; THEN HANDLE SEPARATELY
	PUSHJ	SP,INSE		; PUT MESSAGE IN LISTING
	HRRZ	A1,(A5)		; [E1002] If undeclared identifier
	CAIN	A1,1		; [E1002] 	...
	PUSHJ	SP,OUTSYM	; [E1002] then list spelling.
	PUSHJ	SP,KCHECK	; PUT CR/LF IN MESSAGE

	; CHECK FOR FATAL ERROR

	MOVE	A4,(A5)		; GET MESSAGE TABLE ENTRY
	TLNN	A4,..TERM	; IF OBJECT CODE NOT TERMINATED
	JRST	LMSG1		; THEN LOOP
	AOS	.JBERR		; ELSE INCREMENT ERROR COUNT
	TLOE	A7,TMG		; IF TERM MSG PREV GIVEN 
	JRST	LMSG1		; THEN LOOP
	SETOM	WFLAG		; MARK REL FILE TO BE ERASED
	TRO	FL,TRPOFF	; [E140] DON'T MAKE SYMBOL BLOCKS
	MOVEI	A1,TERMC	; ADDR OF TERMINATION MESSAGE
	PUSHJ	SP,INS		; "REL-FILE DELETED"
	PUSHJ	SP,TCHECK	; CR/LF
	JRST	LMSG1		; LOOP


TERMC:	ASCIZ	/?ALGNRF No .REL file created/
STAR3:	ASCIZ	/*******/
SPACE2:	ASCIZ	/  /
	; "NPRINT" WILL PRINT THE LINE NUMBER OF THE ERROR

NPRINT:	SKIPN	LMSGS		; IF MESSAGE FOR PREVIOUS LINE
	SKIPA	A1,OLDNO	; THEN GET OLD LINE NUMBER
	MOVE	A1,LINENO	; ELSE GET LINE NUMBER
	PUSHJ	SP,LPRINT	; CONVERT IT TO ASCII
	PUSHJ	SP,INSE		; WRITE LINE NUMBER TO LISTING AND TTY
	MOVEI	A1,SPACE2	; WRITE 2 SPACES
	JRST	INSE		; SEND TO LISTING AND TTY, EXIT NPRINT




	; ERROR IS NEITHER ON CURRENT NOR PRECEDING LINE

LMSG3:	MOVEI	A1,Y19		; "ERROR ON A PREVIOUS LINE"
	JRST	LMSG4		; CONTINUE

	; EXIT LMSG

LMSGE:	PUSHJ	SP,CREFST	; OUTPUT CREF START DATA, IF REQUIRED.
	POP	SP,A2		; RESTORE A2
	POPJ	SP,		; EXIT LMSG


;	AN "IUO" MESSAGE IS A MESSAGE OF THE FORM "XXX YYY FOUND WHERE A 
;	ZZZ WAS EXPECTED".  THE ERROR MESSAGE NUMBER SPECIFIES ONLY THE
;	TEXT OF ZZZ.  XXX AND YYY ARE THE TYPE AND KIND OF WHAT WAS
;	FOUND, AND THE TEXT OF THESE MUST BE DETERMINED BY DECODING THE
;	LEXEME IN SYM.


IUO:	MOVEI	A1,Y1		; "ILLEGAL USE OF "
	PUSHJ	SP,INS		; PUT IN LISTING
	LDB	A1,[		; GET "TYPE" OF ITEM
	POINT	3,(A5),14]	; POINTER TO TYPE FIELD IN ENTRY
	CAIN	A1,4		; IF IT IS A LABEL
	JRST	IUOLAB		; THEN HANDLE SEPARATELY
	MOVE	A1,IUOMT1(A1)	; GET NAME
	PUSHJ	SP,INS		; PUT IN LISTING
	LDB	A1,[		; GET "KIND" OF ITEM
	POINT	3,(A5),17]	; POINTER TO KIND FIELD IN ENTRY
	MOVE	A1,IUOMT2(A1)	; GET NAME
IUO1:	PUSHJ	SP,INS		; PUT IN LISTING
	PUSHJ	SP,OUTSYM	; [E1002] Put spelling in listing.
	MOVEI	A1,Y2		; " WHERE A "
	PUSHJ	SP,INS		; PUT IN LISTING
	JSP	A6,LMSG0	; GET MESSAGE
	PUSHJ	SP,INS		; PUT IN LISTING
	MOVEI	A1,Y3		; " WAS EXPECTED"
	POPJ	SP,		; EXIT IUO

IUOLAB:	LDB	A1,[		; GET "KIND" OF ITEM
	POINT	3,(A5),17]	; POINTER TO KIND FIELD
	MOVE	A1,IUOMT3(A1)	; GET PROPER NAME
	JRST	IUO1		; CONTINUE

LMSG0:	HRRZ	A1,(A5)		; GET MESSAGE #
	ROT	A1,-1
	JUMPL	A1,.+3
	HLRZ	A1,TTABLE(A1)
	JRST	(A6)
	HRRZ	A1,TTABLE(A1)
	JRST	(A6)
	; BLOCK START OR END

BLK1A:	TLNE	A7,LTTY		; IF LISTING IS ON TTY
	JRST	LMSG1		; THEN DONT WRITE BLOCK BEGIN OR END MSG
	MOVE	A4,(A5)		; RELOAD PARAM WORD
	TRNE	A4,017777	; IF RIGHT-MOST 13 BITS NOT ZERO
	JRST	BLK2A		; THEN THIS IS AN END MESSAGE

	; "START OF BLOCK N"

	TRNN	FL,CREF		; CREF ?
	JRST	BLK2B		; NO
	PUSH	SP,A5		; DEC CLOBBERS THIS
	PUSHJ	SP,CREFST	; OUTPUT CREF START-DATA, IF NEEDED.
	MOVEI	A1,BLK2M3	; START-BLOCK
	PUSHJ	SP,INSERT
	MOVEI	A3,5		; FOR DEC
	MOVE	A2,[
	XWD	"-","-"]	; FILLER-CHAR,,RIGHT-MOST FILLER
	LDB	A4,[
	POINT	13,(A5),22]	; BLOCK-NUMBER
	PUSHJ	SP,CRFDEC	; TO DECIMAL TO LISTING
	MOVEI	A5,^D8		; UPDATE 
	ADDM	A5,CRFCNT	;  CHARACTER-COUNT
	POP	SP,A5
	JRST	LMSG1		; DON'T PRINT 'START OF BLOCK'

BLK2B:	MOVEI	A1,BLK1M	; "START OF BLOCK "

BLKC:	PUSHJ	SP,INSERT	; PUT IN LISTING
	LDB	A1,[		; GET THE NUMBER STORED IN
	POINT	13,(A5),22]	; BITS 10-22
	PUSHJ	SP,LPRINT	; CONVERT TO DECIMAL ASCII
	PUSHJ	SP,INSERT	; PUT NUMBER IN LISTING
	PUSHJ	SP,ICHECK	; CR/LF
	JRST	LMSG1		; LOOP


	; "END OF BLOCK N, CONT M"

BLK2A:	TRNN	FL,CREF		; CREF ?
	JRST	BLK2C		; NO
	PUSH	SP,A5
	PUSHJ	SP,CREFST	; OUTPUT CREF START DATA, IF NEEDED.
	MOVEI	A1,BLK2M4	; END BLOCK
	PUSHJ	SP,INSERT
	MOVEI	A3,5
	MOVE	A2,[
	XWD	"-","-"]	; FILLER-CHAR,,RIGHT-MOST-FILLER
	LDB	A4,[
	POINT	13,(A5),35]	; BLOCK-NUMBER
	PUSHJ	SP,CRFDEC	; TO LISTING IN DECIMAL
	MOVEI	A5,^D8		; UPDATE
	ADDM	A5,CRFCNT	;  CHAR-COUNT
	POP	SP,A5
	JRST	LMSG1		; DON'T PRINT 'END OF BLOCK'

BLK2C:	MOVEI	A1,BLK2M1	; "END BLOCK "
	PUSHJ	SP,INSERT	; PUT IN LISTING
	LDB	A1,[		; GET THE NUMBER STORED IN
	POINT	13,(A5),35]	; BITS 23-35
	PUSHJ	SP,LPRINT	; CONVERT TO DECIMAL ASCII
	PUSHJ	SP,INSERT	; PUT NUMBER IN LISTING
	MOVEI	A1,BLK2M2	; ", CONT "
	JRST	BLKC		; CONTINUE

BLK1M:	ASCIZ	/START OF BLOCK /
BLK2M1:	ASCIZ	/END BLOCK /
BLK2M2:	ASCIZ	/, CONT /
BLK2M3:	BYTE(7)015,6,"B",0	; CREF START-BLOCK:  T15 6CH B
BLK2M4:	BYTE(7)016,6,"E",0	; CREF END BLOCK: T16 6CH E
;	"LMSGZ" IS CALLED AT THE END OF THE COMPILATION BY ".ZZEND".  "LMSGZ"
;	WILL PRINT ALL MESSAGES THAT REMAIN IN THE MESSAGE TABLE THAT
;	HAVE NOT YET BEEN PRINTED.

LMSGZ:	MOVEM	A7,A7SAV	; SAVE A7
	MOVE	A7,RFLAGS	; FETCH THE READ MODULE FLAGS
	MOVEI	A5,MTABLE	; ADDR OF MESSAGE TABLE
	CAML	A5,NAMTE	; IF NO MESSAGES IN MESSAGE TABLE
	POPJ	SP,		; THEN EXIT LMSGZ
	AOSE	LMSGS		; DUMP 1ST GROUP OF MESSAGES, UNLESS JUST DONE
	JRST	LMSGZ2
	PUSHJ	SP,LMSG		; PRINT MESSAGES

LMSGZ2:	MOVEI	A5,MTABLE	; ADDR OF MESSAGE TABLE
	SETOM	LMSGS		; DUMP 2ND GROUP OF MESSSAGES
	PUSHJ	SP,LMSG		; PUT THEM IN LISTING
	PUSHJ	SP,CRFNL2	; OUTPUT CREF END, & ANY NECESSARY NULLS
	MOVEI	A1,LINES3	; PUT 3 BLANK LINES
	PUSHJ	SP,INSERT	; IN LISTING
	JRST	ICHECK		; INSERT A CR/LF, EXIT LMSGZ



LBP:	XWD	440700,LB	; LISTING BUFFER POINTER

	RELOC

MTABLE:	BLOCK	50		; MESSAGE TABLE
NAMTE:	BLOCK	1
;	MTABLE			; NEXT AVAIL MESSAGE TABLE ENTRY
LMSGS:	BLOCK	1		; LMSG SWITCH: 0 FOR PASS1, -1 FOR PASS2
LB:	BLOCK	40		; LISTING BUFFER FOR MESSAGES
OLDNO:	BLOCK	1		; OLD LINE NUMBER
	RELOC

Y1:	ASCIZ	//
Y2:	ASCIZ	/ FOUND WHERE A/
Y3:	ASCIZ	/ WAS EXPECTED/
Y4:	ASCIZ	/STRING/
Y5:	ASCIZ	/COMPLEX/
Y6:	ASCIZ	/TYPELESS/
Y7:	ASCIZ	/BOOLEAN/
Y8:	ASCIZ	/LONG REAL/
Y9:	ASCIZ	/REAL/
Y10:	ASCIZ	/INTEGER/
Y11:	ASCIZ	/ VARIABLE/
Y12:	ASCIZ	/ EXPRESSION/
Y13:	ASCIZ	/ ARRAY IDENTIFIER/
Y14:	ASCIZ	/ PROCEDURE/
Y15:	ASCIZ	/ CONSTANT/
Y16:	ASCIZ	/LABEL/
Y17:	ASCIZ	/DESIGNATIONAL EXPRESSION/
Y18:	ASCIZ	/SWITCH/
IUOMT1:	Y4
	Y5
	Y6
	Y7
	0
	Y8
	Y9
	Y10

IUOMT2:	Y11
	Y12
	Y13
	Y14
	Y15

IUOMT3:	Y16
	Y17
	0
	Y18

Y19:	ASCIZ	/ ERROR ON A PREVIOUS LINE:/
;	THE INSERT ROUTINES ("INSERT", "INS", AND "INSE") ARE USED TO INSERT
;	MESSAGES INTO THE LISTING.  THE CHECK ROUTINES ("ICHECK", "TCHECK",
;	AND "KCHECK") WILL INSERT A CR/LF INTO THE LISTING, AND THEN
;	INSERT NULLS INTO THE LISTING SO THAT THE TOTAL NUMBER OF CHARACTERS
;	INSERTED SINCE THE LAST CHECK ROUTINE WAS CALLED IS A MULTIPLE OF 5.
;	WHENEVER AN INSERT ROUTINE IS USED, A CHECK ROUTINE MUST BE CALLED
;	BEFORE THE NEXT CALL TO NEWLINE.
;
;	"INSERT" AND "ICHECK" WRITE MESSAGES IN THE LISTING.  "INS" AND
;	"TCHECK" ALSO WRITE THE MESSAGE TO THE TTY.  "INSE" AND "KCHECK"
;	ARE USED TO WRITE MESSAGES WHEN MESSAGE 98 MIGHT BE ENCOUNTERED.


INSE:	HRRZ	A3,(A5)		; GET MESSAGE NUMBER
	CAIN	A3,^D98		; IF THIS IS MESSAGE 98
	JRST	INSERT		; THEN DONT WRITE TO TTY


	; INSERT LINE IN LISTING, AND ALSO WRITE IT TO TTY

INS:	TLNN	A7,NSWIT	; IF NO N-SWITCH
	TTCALL	3,(A1)		; THEN WRITE IT TO TTY
	JRST	INSERT		; INSERT LINE IN LISTING


	; PUT DECIMAL NUMBER IN LISTING

LPRINT:	MOVE	A6,LBP		; GET BUFFER BYTE POINTER
	PUSHJ	SP,LPR1		; CONVERT IT TO CHARACTERS
	MOVEI	A1,0		; ASCII NULL
	IDPB	A1,A6		; END STRING WITH AN ASCII NULL
	MOVEI	A1,LB		; OUTPUT ADDRESS OF BUFFER
	POPJ	SP,		; EXIT LPRINT


	; CONVERT IT TO DECIMAL

LPR1:	IDIVI	A1,12		; DIVIDE BY TEN
	PUSH	SP,A2		; PUT DIGIT ON STACK
	SKIPE	A1		; SKIP IF END OF NUMBER
	PUSHJ	SP,LPR1		; RECURSIVE CALL TO LPR1
	POP	SP,A1		; FETCH DIGIT FROM STACK
	ADDI	A1,.N0		; CONV TO ASCII
	IDPB	A1,A6		; PUT IN BUFFER
	POPJ	SP,		; ASCEND FROM LPR1
	; Write msg to listing, and to TTY if CCL and there were errors,
	;  or if not CCL (DONE1).
	; DONE2 writes msg to listing, and to TTY if not CCL.
	; Both used at end, called from START0, to do N Errors, stats, etc.

DONE1:	SKIPN	.JBERR

DONE2:	SKIPN	CCLSW
	JRST	INS		; TO TTY AS WELL, IF REQUD.

	; Insert a message in listing. The address of the message in ASCIZ
	; format should be in A1

INSERT:	TROA	A2,777777	; SET SWITCH TO SAY INSERT, NOT INSNUL

INSNUL:	SETZ	A2,		; INSERT ONE NULL
	TLNN	A7,EXISTS	; IF LISTING DOES NOT EXIST

INS2:	POPJ	SP,		; THEN DONT SEND MESSAGE THERE
	JUMPE	A2,INS7		; IF NOT NULL...
	HRLI	A1,440700	; SET UP BYTE POINTER

	; CHARACTER TRANSFER LOOP

INS6:	ILDB	A2,A1		; GET A CHAR
	JUMPE	A2,INS2		; IF NULL, THE END
	PUSHJ	SP,INS7		; [E134] OUTPUT THE CHARACTER
	JRST	INS6		; [E134] AND LOOP UNTIL DONE

INS7:	SOSGE	FIVEC		; DECR NO OF REMAINING CHARS
	JRST	INS3		; -END OF 5-CHAR GROUP

INS1:	IDPB	A2,W		; PUT CHAR IN LISTING
	POPJ	SP,		; DONE

	; AT END OF WORD, CHECK FOR END OF LISTING BUFFER

INS3:	HRRZ	A6,W		; GET LISTING POINTER
	ADDI	A6,2		; STEP TO NEXT WORD
	CAML	A6,OBEND	; IF IT IS NOT WITHIN BUFFER
	JRST	INS5		; THEN GET A NEW BUFFER

INS4:	MOVEI	A6,4		; 4 CHARS LEFT AFTER THIS ONE
	MOVEM	A6,FIVEC	; SET 5-CHAR GROUP COUNT
	JRST	INS1		; CONTINUE

	; END OF BUFFER, GET ANOTHER

INS5:	HLRZ	A4,W		; SAVE S-P BITS OF LISTING POINTER
	PUSHJ	SP,WRITEL	; GET A NEW BUFFER
	AOS	A6,W		; STEP LISTING POINTER
	SETZM	(A6)		; ZERO 1ST WORD OF BUFFER
	HRLM	A4,W		; SET S-P BITS
	JRST	INS4		; CONTINUE



KCHECK:	HRRZ	A3,(A5)		; GET MESSAGE NUMBER
	CAIN	A3,^D98		; IF IT IS MESSAGE 98
	JRST	ICHECK		; THEN DONT WRITE CR/LF TO TTY
	; WRITE CR/LF TO TTY, THEN CALL "ICHECK"

TCHECK:	MOVEI	A1,NLCHRS	; PUT A CR/LF
	PUSHJ	SP,INS		; INTO LISTING
	JRST	IC2		; CONTINUE

	; "ICHECK MUST BE CALLED AFTER USING "INSERT" TO WRITE THE CR/LF TO
	; THE LISTING, AND TO MAKE SURE THAT THE TOTAL INSERTED MESSAGE
	; IS A MULTIPLE OF 5 CHARACTERS LONG.

ICHECK:	MOVEI	A1,NLCHRS	; PUT A CR/LF
	PUSHJ	SP,INSERT	; INTO LISTING

IC2:	TLNN	A7,EXISTS	; IF LISTING DOESNT EXIST
	POPJ	SP,		; THEN SKIP THIS
	MOVEI	A1,0		; NULL CHARACTER

IC1:	SOSGE	FIVEC		; DECR NO OF REMAINING CHARS
	POPJ	SP,		; EXIT ICHECK IF NONE LEFT
	IDPB	A1,W		; PUT NULL INTO LISTTIG
	JRST	IC1		; LOOP


	RELOC

FIVEC:	BLOCK	1		; FIVE CHARACTER COUNT

	RELOC
	; PUT ENTRY IN MESSAGE TABLE

FAILED:	MOVEM	A6,REG3+5	; SAVE A6
	MOVE	A6,[		; LOAD BLT WORD
	XWD	A1,REG3]	; BLT WORD
	BLT	A6,REG3+4	; SAVE REGS

	; FIND THE BYTE POINTER TO THE ERROR

	SETOM	BYTES		; ZERO ^ POSITION
	SETZB	A4,FAILF	; CLEAR FLAGS
	TLNN	A1,..IMM+17	; IF THERE IS TO BE NO ^
	JRST	FAILA		; THEN SKIP THIS PART
	TLNN	A1,..IMM	; IF NOT ^ WHERE POINTER IS NOW
	JRST	.+3		; THEN SKIP
	AOS	BYTES		; USE EXACT POINTER
	MOVE	A4,CC		; THEN USE CURRENT READ POINTER
	MOVE	A5,PLIST	; GET POINTER  LIST POINTER
	XORI	A5,2		; FLIP IT
	TLNE	A1,..SYM	; IF ^ UNDER SYM
	MOVE	A4,(A5)		; THEN GET SYM POINTER
	TLNE	A1,..DEL	; IF ^ UNDER DEL
	MOVE	A4,1(A5)	; THEN GET DEL POINTER
	XORI	A5,2		; FLIP POINTER SWITCH
	TLNE	A1,..NSYM	; IF ^ UNDER NSYM
	MOVE	A4,(A5)		; THEN GET NSYM POINTER
	TLNE	A1,..NDEL	; IF ^ UNDER NDEL
	MOVE	A4,1(A5)	; THEN GET NDEL POINTER
	JUMPE	A4,FAILB	; IF POINTER ZERO, ERROR ON A PREVIOUS LINE
	TLZE	A4,EXACT	; IF FLAG BIT IS ON
	AOS	BYTES		; THEN USE EXACT POINTER

	; DETERMINE WHAT LINE THE ERROR IS ON

	CAMGE	A4,LP1		; IF ERROR NOT ON CURRENT LINE
	JRST	FAILC		; THEN CHECK PRECEDING LINE
	SUB	A4,LP1		; COMPUTE POSITION ON LINE
	ADDM	A4,BYTES	; SAVE IT
	JRST	FAILA		; CONTINUE

FAILC:	CAMGE	A4,LP2		; IF ERROR NOT ON PRECEDING LINE
	JRST	FAILB		; THEN DONT PRINT AN ^
	SUB	A4,LP2		; COMPUTE POSITION ON LINE
	ADDM	A4,BYTES	; SAVE IT
	AOSA	FAILF		; SET FLAG +
FAILB:	SETOM	FAILF		; SET FLAG -

	; CREATE MESSAGE TABLE ENTRY

FAILA:	AOS	A4,BYTES	; GET UP ARROW POSITION
	LDB	A5,[		; GET TYPE FIELD OF SYM
	POINT	6,SYM,8]	; POINTER TO TYPE FIELD
	CAIN	A5,<$L>B44	; IF TYPE = LABEL
	MOVEI	A5,4		; THEN CHANGE TO 04
	ANDI	A5,7		; USE ONLY 3 BITS OF TYPE FIELD
	LSH	A4,7		; SHIFT 7
	ADD	A4,A5		; INCLUDE TYPE FIELD
	LSH	A4,3		; SHIFT 3
	LDB	A5,[		; GET KIND FIELD OF SYM
	POINT	2,SYM,2]	; POINTER TO KIND FIELD
	TLNN	SYM,$SYMB	; IF SYM IS A CONSTANT
	MOVEI	A5,4		; THEN USE AN 04
	ADD	A4,A5		; INCLUDE KIND
	MOVS	A4,A4		; MOVE IMFO TO FINAL POSITION
	MOVE	A5,REG3		; GET PARAMETER TO "FAILED"
	HRR	A4,A5		; INCLUDE MESSAGE NUMBER
	COMMENT	/ [E1002] Delete next two lines.
	TLNE	A5,..IUO2	; IF "IUO" MESSAGE
	TLO	A4,..IUO1	; THEN SET IUO FLAG.
	/
	SKIPLE	A6,FAILF	; IF ERROR ON PRECEDING LINE
	TLO	A4,..PREC	; THEN SET FLAG
	SKIPGE	A6		; IF ERROR ON SOME PREVIOUS LINE
	TLO	A4,..PREV	; THEN SET FLAG
	TLNE	A5,SUSPCO	; IF TERMINATION BIT ON
	TLO	A4,..TERM	; THEN TURN ON CORRESPONDING BIT

BLK0:	MOVE	A6,NAMTE	; NEXT AVAILABLE MSG TABLE ENTRY SPACE
	CAIL	A6,MTABLE+50	; IF PAST END OF TABLE
	JRST	BLK2		; [E1002] then don't put in table
	HRRZ	A3,A5		; [E1002] If undeclared identifier
	CAIN	A3,1		; [E1002] 	...
	JRST	.+4		; [E1002]	...
	TLNN	A5,..IUO2	; [E1002] or IUO
	JRST	BLK1		; [E1002]	...
	TLO	A4,..IUO1	; [E1002] then enter symbol spelling.
	HRRZ	A3,SYM		; [E1002] Address of symbol in A3
	CAIL	A3,MTABLE	; [E1002] In symbol table (best to make sure)?
	CAML	A3,NASTE	; [E1002]	...
	JRST	BLK3		; [E1002] No - enter a null.
	HLRZ	A1,A4		; [E1002] Get lexeme kind in A1
	ANDI	A1,7		; [E1002] 	...
	CAIE	A1,1		; [E1002] If kind = expression or constant
	CAIN	A1,4		; [E1002] 	...
	JRST	BLK3		; [E1002] then make a null entry.
	MOVEI	A3,SYMNAM(A3)	; [E1002] Start of spelling in ST.
	HRRZ	A1,@A3		; [E1002]	...
	PUSHJ	SP,IUOLN1	; [E1002] Get entry length in A1.
	JRST	BLK4
BLK3:	MOVEI	A1,1		; [E1002] Null entry of length 1.
	MOVEI	A3,[EXP 0]	; [E1002] and zero value.
BLK4:	ADDM	A1,A6		; [E1002] Room for spelling in table ?
	CAIL	A6,MTABLE+50	; [E1002]	...
	JRST	BLK2		; [E1002] No - don't enter it.
	MOVE	A6,NAMTE	; [E1002] Save current next entry free.
	ADDM	A1,NAMTE	; [E1002] Add in spelling entry length.
	HRL	A2,A3		; [E1002] Set up BLT word.
	HRR	A2,A6		; [E1002]	...
	AOJ	A2,		; [E1002] 	...
	BLT	A2,@NAMTE	; [E1002] Move spelling into message table.
BLK1:	MOVEM	A4,(A6)		; [E1002] Put entry into table.
	AOS	NAMTE		; [E1002] Step table index.
BLK2:	TLNE	A5,..FATAL	; [E1002] If termination bit is on
	JRST	FAILT		; THEN STOP COMPILATION
	MOVS	A6,[		; GET POINTERS FOR
	XWD	A1,REG3]	; BLT
	BLT	A6,A6		; RESTORE REGISTERS
	POPJ	SP,		; EXIT FAILED
	; FATAL ERROR. STOP COMPILATION IMMEDIATELY.

	ILDB	A1,P		; READ NEXT CHAR

FAILT:	LDB	A1,P		; RESD CHAR (FIRST TIME)
	MOVE	A2,CTABLE(A1)	; GET ITS ENTRY
	CAIN	A2,4		; IF IT A NEW-LINE CHAR
	PUSHJ	SP,NEWLINE	; THEN PRINT LINE AND MESSAGES
	JRST	FAILT-1		; ELSE READ ANOTHER CHAR
	MOVEI	A1,TERMSG	; TERMINATION MESSAGE
	PUSHJ	SP,INS		; INSERT IT IN LISTING
	PUSHJ	SP,TCHECK	; CR/LF
	JRST	RINIT+1		; GET ANOTHER COMMAND STRING

	RELOC

REG3:	BLOCK	6		; REGISTER SAVE AREA
BYTES:	BLOCK	1		; BYTE COUNT FOR ^
FAILF:	BLOCK	1		; FLAG USED BY FAILED
LP1:	BLOCK	1		; POINTER TO START OF CURRENT LINE
LP2:	BLOCK	1		; POINTER TO START OF PRECEDING LINE
BLKF:	BLOCK	1		; .BLK1 .BLK2 FLAG

	RELOC
	; [E1002] IUOLN - Finds the word length of a spelling in the ST.

IUOLN:	HRRZ	A1,1(A5)	; [E1002] Get entry length in A1.
IUOLN1:	ANDI	A1,77		; [E1002]	...
	ADDI	A1,2		; [E1002]	...
	IDIVI	A1,6		; [E1002]	...
	SKIPE	,A2		; [E1002]	...
	AOJ	A1,		; [E1002]	...
	POPJ	SP,		; [E1002] Return.

	; [E1002] OUTSYM - Inserts a spelling from the message table
	;		   into the listing.

OUTSYM:	MOVE	A1,A5		; [E1002] Adress of spelling - 1.
	SKIPN	,1(A5)		; [E1002] If null entry
	POPJ	SP,		; [E1002] then don't bother.
	PUSH	SP,A5		; [E1002] Convert to ASCIZ in LB.
	SOJ	A1,		; [E1002]	...
	PUSHJ	SP,NAME		; [E1002]	...
	POP	SP,A5		; [E1002]	...
	MOVEI	A1,[ASCIZ/ </]	; [E1002] List a '<'.
	PUSHJ	SP,INS		; [E1002]	...
	MOVEI	A1,LB		; [E1002] List spelling.
	PUSHJ	SP,INS		; [E1002]	...
	MOVEI	A1,[ASCIZ/>/]	; [E1002] List a '>'.
	PUSHJ	SP,INS		; [E1002]	...
	POPJ	SP,		; [E1002] Return.

	; START OF BLOCK

.BLK1:	SETZM	BLKF		; ZERO THE FLAG
	JRST	.+2		; SKIP

	; END OF BLOCK

.BLK2:	SETOM	BLKF		; SET FLAG NON-ZERO
	MOVEM	A6,REG3+5	; SAVE WORD
	MOVE	A6,[		; LOAD BLT WORD
	XWD	A1,REG3]	; BLT WORD
	BLT	A6,REG3+4	; SAVE ALL 6 REGS
	MOVE	A2,CURBLOCK	; GET CURRENT BLOCK NUMBER
	SKIPN	BLKF		; IF .BLK1 THEN
	LSHC	A1,^D36		; MOVE TO A1, CLEAR 2ND PARAM
	LSH	A2,^D23		; COMBINE THE PARAM IN A1
	LSHC	A1,-^D23	; WITH THE PARAM IN A2
	MOVE	A5,PLIST	; POINTER BUFFER
	XORI	A5,2		; FLIP IT TO SYM AND DEL
	MOVE	A4,1(A5)	; GET POINTER TO DEL
	SKIPN	BLKF		; IF .BLK1 THEN
	MOVE	A4,(A5)		; USE POINTER TO SYM INSTEAD
	TLZE	A4,EXACT	; IF FLAG BIT IS ON
	ADDI	A4,1		; THEN USE EXACT POINTER
	CAMG	A4,LP1		; DETERMINE WHICH LINE IT IS ON
	TLO	A2,..PREC	; MARK: ON PRECEDING LINE
	TLO	A2,776000	; SET BYTES=255
	MOVE	A4,A2		; MOVE TO A4
	MOVEI	A5,0		; CLEAR A5
	JRST	BLK0		; CONTINUE
SCDLT=.-43

	LEX(NE)			; "#"

	BLOCK	4

	LEX(LPAR)		; "("
	LEX(RPAR)		; ")"
	LEX(TIMES)		; "*"
	LEX(PLUS)		; "+"
	LEX(COM)		; ","
	LEX(MINUS)		; "-"
	LEX(DOT)		; "."
	LEX(SLASH)		; "/"

TCDLT:	XWD	L$ASS,R$ASS	; ":="
	0
	LEX(LEQ)		; "<="
	0
	LEX(GTE)		; ">="
	0
	LEX(UPLUS)
	LEX(UMINUS)
	LEX(PHID)
	0
	LEX(COLON)		; ":"
	LEX(SC)			; ";"
	LEX(LSS)		; "<"
	LEX(EQ)			; "="
	LEX(GTR)		; ">"
	BLOCK	^D28

	LEX(LBRA)		; "["
	LEX(EOF)		; END-OF-FILE
	LEX(RBRA)		; "]"
	LEX(POW)		; "^"
	LEX(ASS)		; "_"
SUBTTL	** LSCAN **

; 	*****  L S C A N  *****
; 
; 		"LSCAN" READS ALGOL TEXT FROM A FILE AND
; 	CONVERTS IT TO AN INTERNAL CODE.  EACH CALL TO
; 	LSCAN PRODUCES THE NEXT ITEM FROM THE ALGOL
; 	PROGRAM.  ITEMS ARE OF THREE TYPES:
; 
; 		1.  IF THE ITEM IS A DELIMITER (EITHER
; 	SINGLE CHARACTER OR RESERVED WORD) LSCAN SETS
;	A3 EQUAL TO THE LEXEME OF THAT DELIMITER.
; 
; 		2.  IF THE ITEM IS A LITERAL CONSTANT
; 	LSCAN SETS A3 EQUAL THE LEXEME FOR THAT
; 	CONSTANT (PUTTING THE CONSTANT IN THE OBJECT
; 	MODULE'S CONSTANT TABLE IF NECESSARY), AND
; 	SKIP-RETURNS.
; 
; 		3.  IF THE ITEM IS AN IDENTIFIER NAME
; 	LSCAN PLACES IN A3 A POSITIVE NUMBER (A
; 	BUFFER ADDRESS), AND SKIP-RETURNS.  THIS NUMBER
; 	IS THE INPUT PARAMETER TO THE ROUTINE "SEARCH"
; 	WHICH IS USED TO PRODUCE THE LEXEME FOR THE
; 	IDENTIFIER.


LSCAN:	SKIPE	A3,BLEX		; IF THERE IS A BUFFERED LEXEME
	JRST	BLEXR		; THEN TREAT SEPARATELY
	LDB	A1,P		; PICK UP 1ST CHAR
	SKIPE	A2,CTABLE(A1)	; LOAD TABLE ENTRY, SKIP IF DELIM
	JRST	@TABLE1(A2)	; JUMP TO APPROPRIATE ROUTINE
	JRST	DELIM
	DIGITS			; NUMBERS
	LETTER			; LETTERS
TABLE1:	DELIM			; DELIMITERS
	FLAGD			; DELIMITERS (FLAGGED)
	SPACE			; IGNORABLES
	SPACE			; SPACE & TAB
	NEW1			; NEW-LINE
	LOWER			; LOWER CASE
	OTHER			; OTHER CHARS
	SQUOTE			; SINGLE QUOTE


	; SPACE OR TAB

SPACE:	CAIN	A1,.TAB		; IF IT IS A TAB
	PUSHJ	SP,TAB		; COMPUTE ITS LENGTH
	ILDB	A1,P		; GET ANOTHER CHAR
	AOSA	CC		; STEP POSITION COUNT

	; END OF LINE - WATCH THE SPACING HERE !

NEW1:	PUSHJ	SP,NEWLINE	; PROCESS LISTING, GET NEXT CHAR
	JFCL			; NO-OP

NEW3:	MOVE	A2,CTABLE(A1)	; LOAD TABLE ENTRY
	JRST	@TABLE1(A2)	; JUMP TO APPROPRIATE ROUTINE

	; FLAGGED CHAR:   : < > !

FLAGD:	CAIN	A1,.EXCL	; IF CHAR IS A "!"
	JRST	COMNT0		; THEN PROCESS COMMENT
	MOVE	A4,A1		; COPY CHARACTER TO A4
	JSP	A6,IGST		; READ THE NEXT CHARACTER
	CAIN	A1,.EQUAL	; IS IT AN "=" ??
	JRST	FLAGD1		; -YES, ITS A 2-CHAR DELIM
	MOVE	A3,SCDLT(A4)	; PICK UP LEXEME FOR DELIM
	POPJ	SP,		; EXIT LSCAN
	; :=, <=, OR >=

FLAGD1:	MOVE	A3,TCDLT-.COLON(A4); GET DELIMETER LEXEME
	JRST	SQOK2		; EXIT LSCAN

	; A SPECIAL CHARACTER WAS SCANNED

OTHER:	HLRZ	A2,CTABLE(A1)	; GET LEFT HALF OF CHARS TABLE ENTRY
	JRST	@TABLE3(A2)	; JUMP THROUGH TABLE 3


TABLE3:	ILLEGAL			; ILLEGAL CHARACTER
	POWER			; @ &
	SCON			; " $ %
	DOT			; .


	; SPECIAL CONSTANT

SCON:	CAIN	A1,.%		; A "%" INDICATES
	JRST	OCTAL		; AN OCTAL CONSTANT
	CAIN	A1,.$		; A "$" INDICATES
	JRST	DOLLAR		; A SYMBOL CONSTANT
	JRST	STRING		; OTHERWISE, MUST BE A STRING



	; A CONSTANTLESS EXPONENT

POWER:	SETZB	A4,MARKER	; MARK: NO DECIMAL POINT
	MOVEI	A5,1		; SET DOUBLE-LENGTH CONSTANT = 1
	SETZM	FORMAT		; [E044] ASSUME SINGLE PRECISION
	JRST	C22		; [E044] AND JUMP INTO DIGITS
	; A DOT HAS BEEN SCANNED

DOT:	JSP	A6,IGST		; GET THE NEXT CHAR
	MOVE	A3,CTABLE(A1)
	AOJGE	A3,DOT1		; IF NOT DIGIT, DELIMITER
	MOVEI	A3,^D9		; SET LOOP INDEX
	MOVEM	A3,MARKER	; SET DECIMAL POINT MARKER
	SETZB	A4,FORMAT	; [E044] CLEAR HI WORD OF DOUBLE
	MOVEI	A5,-.N0(A1)	; CONVERT 1ST CHAR TO BINARY
	SOJA	A3,LLOOP1	; JUMP INTO "NUMBER"


	; THE DOT IS A DELIMITER

DOT1:	SKIPA	A3,ZDOT		; LOAD ITS LEXEME

BLEXR:	SETZM	BLEX		; CLEAR INDICATOR
	POPJ	SP,		; EXIT LSCAN

	; AN ILLEGAL CHAR HAS BEEN SCANNED

ILLEGAL: FAIL	(93,SOFT,IMM,ILLEGAL CHARACTER)

ILL1:	ILDB	A1,P		; GET NEXT CHAR
	AOS	CC		; STEP POSITION COUNT
	MOVE	A2,CTABLE(A1)	; GET ITS TABLE ENTRY
	CAIN	A2,6		; IF IT TOO IS AN ILLEGAL CHARACTER
	JRST	ILL1		; THEN LOOP WITHOUT PRINTING ANOTHER MSG
	JRST	@TABLE1(A2)	; OTHERWISE JUMP THROUGH TABLE 1
; 	**** CHARACTER TABLE ****
; 
; 	THIS TABLE IS USED TO CLASSIFY EACH OF
; 	THE ASCII CHARACTERS ACCORDING TO THE
; 	FOLLOWING TYPES:
; 
; 	-2	DIGIT
; 	-1	LETTER
; 	0	SINGLE-CHARACTER DELIMITERS
; 	1	FLAGGED DELIMITERS
; 	2	SHOULD BE IGNORED ON INPUT
; 	3	SPACE CHARS (SPACE & TAB)
; 	4	NEW-LINE CHARS (CR, LF, )
; 	5	LOWER CASE LETTERS
; 	6	OTHER CHARS.  
; 		   LEFT HALF:
; 			0 ILLEGAL CHAR
; 			1 @ &
; 			2 " $ %
; 			3 .
; 	7	SINGLE QUOTE
	0	;   -1 PSEUDO ALTMODE (SCANCH)
CTABLE:	2	;   0 NULL
	6	;   1 ^A
	6	;   2 ^B
	6	;   3 ^C
	6	;   4 ^D  (EOT)
	6	;   5 ^E  (WRU)
	6	;   6 ^F
	6	;   7 ^G  (BELL)
	6	;  10 ^H  (BACKSPACE)
	3	;  11 ^I  (TAB)
	4	;  12 ^J  (LINE FEED)
	6	;  13 ^K  (VERT TAB)
	3	;  14 ^L  (FORM)
	4	;  15 ^M  (RETURN)
	6	;  16 ^N
	6	;  17 ^O
	6	;  20 ^P
	2	;  21 ^Q  (XON)
	2	;  22 ^R  (TAPE)
	2	;  23 ^S  (XOFF)
	2	;  24 ^T  (NOTAPE)
	6	;  25 ^U
	6	;  26 ^V
	6	;  27 ^W
	6	;  30 ^X
	6	;  31 ^Y
	4	;  32 ^Z
	6	;  33 ^LBRAC  (ESC)
	6	;  34 ^\
	6	;  35 ^RBRAC
	6	;  36 ^^
	6	;  37 ^_
	3	;  40 SPACE
  XWD  1,1	;  41 !
  XWD  2,6	;  42 "
	0	;  43 #
  XWD  2,6	;  44 $
  XWD  2,6	;  45 %
  XWD  1,6	;  46 &
	7	;  47 '
	0	;  50 (
	0	;  51 )
	0	;  52 *
	0	;  53 +
	0	;  54 ,
	0	;  55 -
  XWD  3,6	;  56 .
	0	;  57 /
	-2	;  60 0
	-2	;  61 1
	-2	;  62 2
	-2	;  63 3
	-2	;  64 4
	-2	;  65 5
	-2	;  66 6
	-2	;  67 7
	-2	;  70 8
	-2	;  71 9
	1	;  72 :
	0	;  73 ; 
	1	;  74 LESS THAN
	0	;  75 =
	1	;  76 GRTR THAN
	6	;  77 ?
  XWD  1,6	; 100 @
	-1	; 101 A
	-1	; 102 B
	-1	; 103 C
	-1	; 104 D
	-1	; 105 E
	-1	; 106 F
	-1	; 107 G
	-1	; 110 H
	-1	; 111 I
	-1	; 112 J
	-1	; 113 K
	-1	; 114 L
	-1	; 115 M
	-1	; 116 N
	-1	; 117 O
	-1	; 120 P
	-1	; 121 Q
	-1	; 122 R
	-1	; 123 S
	-1	; 124 T
	-1	; 125 U
	-1	; 126 V
	-1	; 127 W
	-1	; 130 X
	-1	; 131 Y
	-1	; 132 Z
	0	; 133 LBRAC
	6	; 134 \
	0	; 135 RBRAC
	0	; 136 ^
	0	; 137 _
	6	; 140 LEFT SINGLE QUOTE
	5	; 141 LA
	5	; 142 LB
	5	; 143 LC
	5	; 144 LD
	5	; 145 LE
	5	; 146 LF
	5	; 147 LG
	5	; 150 LH
	5	; 151 LI
	5	; 152 LJ
	5	; 153 LK
	5	; 154 LL
	5	; 155 LM
	5	; 156 LN
	5	; 157 LO
	5	; 160 LP
	5	; 161 LQ
	5	; 162 LR
	5	; 163 LS
	5	; 164 LT
	5	; 165 LU
	5	; 166 LV
	5	; 167 LW
	5	; 170 LX
	5	; 171 LY
	5	; 172 LZ
	6	; 173 LEFT BRACE
	6	; 174 VERTICAL BAR
	3	; 175 RIGHT BRACE (ALTMODE)
	6	; 176 NOT
	2	; 177 DELETE
;	*****  L E T T E R  *****
;
;	"LETTER" SCANS IDENTIFIER NAMES AND RESERVED WORDS,
;	UNLESS RESERVED WORDS ARE QUOTED.  "LETTER" WILL OUTPUT 
;	THE LEXEME OF A RESERVED WORD OR THE BUFFER ADDRESS OF AN
;	IDENTIFIER.
;
;	"LETTER" READS CHARACTERS 6 AT A TIME.  THE 7-BIT 
;	CHARACTERS ARE READ INTO REGISTER A1 WITH AN ILDB AND
;	THEN 6 OF THESE BITS ARE SHIFTED INTO REGISTER A2 WITH
;	A "LSHC A1,-6" .  WHEN REGISTER A2 IS FULL IT IS DUMPED
;	INTO THE NEXT WORD OF A NAME BUFFER.  THUS THE NAME IS 
;	STORED IN A NAME BUFFER, 6 CHARACTERS PER WORD (NOT
;	THE SAME AS "SIXBIT" CHARACTERS), WITH THE CHARACTERS IN
;	REVERSE ORDER, AND WITH BLANKS ON THE RIGHT.  THE RIGHT-MOST
;	6 BITS OF THE 1ST WORD OF THE NAME IN THE NAME BUFFER 
;	CONTAIN THE LENGTH OF THE NAME IN CHARACTERS MINUS 1.  
;	THE WORD IMMEDIATELY PRECEDING THE NAME BUFFER CONTAINS
;	THE LENGTH OF THE NAME IN WORDS MINUS 1.  
;
;	UNLESS RESERVED WORDS ARE QUOTED, THE NAME IS THEN LOOKED
;	UP IN THE RESERVED WORD TABLE TO FIND OUT IF IT IS A RESERVED
;	WORD.  IF IT IS FOUND, THE LEXEME IS OUTPUT, AND THE NAME
;	BUFFER WILL BE USED AGAIN AT THE NEXT CALL TO "LETTER".
;	IF IT IS NOT FOUND, THE NAME BUFFER ADDRESS IS OUTPUT.  
;	THIS ADDRESS IS USED BY "SEARCH" TO LOCATE THE IDENTIFIER
;	IN THE SYMBOL TABLE.  THE NEXT CALL TO "LETTER" WILL NOT
;	USE THE SAME NAME BUFFER, THUS "SEARCH" DOES NOT HAVE TO
;	BE CALLED IMMEDIATELY.  "LETTER" CURRENTLY ROTATES AMONGST
;	THREE NAME BUFFERS.
;


LOWER:	MOVEI	A1,-40(A1)	; CONVERT TO UPPER CASE

LETTER:	SKIPE	A5,RWS		; IF RESERVED MODE
	MOVE	A5,@A5		; LOCATE RESERVED WORD SUBLIST
	MOVEM	A5,RWSL		; SAVE IT FOR LATER
	AOSA	A3,LSBUFP	; GET LIST INDEX AND SKIP
	SETZM	LSBUFP		; ZERO INDEX
	SKIPN	A3,LSBUFT(A3)	; LOCATE A NAME BUFFER
	JRST	.-2		; -RECYCLE
	SETZ	A2,		; CLEAR A2
	HRLZI	A5,-5		; SCAN 1ST 5 CHARS
	HRLZI	A6,-13		; BUT NO MORE THAN 65 CHARS
	; CHARACTER-READING LOOP

LET1:	LSHC	A1,-6		; MOVE CHAR TO ACC A1
	ILDB	A1,P		; GET NEXT CHAR
	AOS	CC		; STEP POSITION COUNT
	SKIPL	A4,CTABLE(A1)	; CHECK IF LETTER OR NUMBER
	JRST	@TABLE2(A4)	; -NO, GOTO A ROUTINE

LET2:	AOBJN	A5,LET1		; LOOP

	; END OF 6-CHAR GROUP

	MOVEM	A2,@A3		; SAVE CHARS IN NAME BUFFER
	SETZ	A2, 		; CLEAR A2
	HRLI	A5,-6		; READ NEXT 6 CHARS
	AOBJN	A6,LET1		; BUT NOT PAST 65 CHARS


	; LINE EXCEEDS 64 CHARS

LET3:	MOVEI	A6,-1(A6)	; BACK UP COUNTER
	FAIL	(91,SOFT,IMM,NAME EXCEEDS 64 CHARACTERS)
	PUSHJ	SP,ATNAC	; ADVANCE TO NEXT ALPHAMERIC CHARACTER
	MOVEI	A5,77		; MAKE NAME 63 CHARACTERS LONG
	MOVEI	A6,12		; MAKE NAME 11 WORDS LONG
	JRST	LET4+3		; CONTINUE


TABLE2:	LET4			; DELIMITERS
	LET4			; DELIMITERS (FLAGGED)
	LET1+1			; IGNORABLES
	LET12			; SPACE & TAB
	LET13			; NEW-LINE
	LET11			; LOWER CASE
	LET14			; OTHER
	LET4			; SINGLE QUOTE

LET12:	SKIPN	RWS		; RESERVED WORD MODE?
	JRST	LET1+1		; NO - IGNORE
	; END OF NAME, CHECK IF RESERVED WORD

LET4:	MOVEM	A2,@A3		; SAVE LAST GROUP OF CHARS
	TRNE	A5,100		; IF NAME IS 65 CHARACTERS LONG
	JRST	LET3		; THEN GIVE ERROR
	HRRZM	A6,-1(A3)	; PUT LENGTH-IN-WORDS IN BUFFER
	MOVEI	A6,(A5)		; PUT LENGTH-IN-CHARS IN A6
	IORB	A6,(A3)		; PUT LENGTH IN BUFFER, PICK UP 1ST WORD

SQ3:	SKIPN	A5,RWSL		; IS THERE A SUBLIST?
	JRST	LET9		; -NO, SKIP EVERY THING

LET7:	CAME	A6,RWTNAM(A5)	; DO 1ST WORDS MATCH?
	JRST	LET8		; -NO, CONTINUE SEARCH

LET5:	SKIPL	A4,RWTLEN(A5)	; IS NAME 1 WORD LONG?
	JRST	LET6		; -NO, 2 WORDS LONG

LET10:	MOVE	A4,1(A3)	; GET 2ND WORD OF NAME BUFFER
	CAME	A4,RWTNAM+1(A5)	; DO 2ND WORDS MATCH
	JRST	LET8		; -NO, CONTINUE

	; NAME FOUND IN RESERVED-WORD TABLE

LET6:	MOVE	A3,RWTLEX(A5)	; LOAD LEXEME
	SKIPE	RWS		; IF RESERVED WORD MODE
	SOS	LSBUFP		; RELEASE BUFFER
	CAIGE	A5,FRW		; IS RESERVED WORD FLAGGED?
	JRST	@RWTRT(A5)	; -YES, GOTO ROUTINE
	POPJ	SP,		; -NO, LSCAN



LET8:	HRRZ	A5,RWTLNK(A5)	; LOCATE ENTRY ON SUBLIST
	JUMPN	A5,LET7		; LOOP UNLESS LINK=0

	;;; GENERAL SKIP RETURN POINT

	; NAME IS NOT A RESERVED WORD - IS AN IDENTIFIER

LET9:	POP	SP,A4		; GET RETURN LINK
	JRST	1(A4)		; SKIP RETURN

	; LOWER-CASE LETTER SCANNED

LET11:	MOVEI	A1,-40(A1)	; CONVERT TO UPPER CASE
	JRST	LET2		; CONTINUE
LET13:	PUSHJ	SP,NCHECK	; INPUT NEXT LINE
	JRST	LET1+3		; -END OF BUFFER IN MID LINE, CONTINUE
	JRST	LET4		; END OF NAME


LET14:	CAIE	A1,.DOT		; IF THIS IS A DOT
	JRST	LET4		; ELSE END OF NAME
	PUSH	SP,A6		; SAVE A6
	PUSH	SP,A2		; SAVE A2
	JSP	A6,GETCHR	; READ NEXT CHARACTER
	POP	SP,A2		; RESTORE A2
	POP	SP,A6		; RESTORE A6
	SKIPGE	CTABLE(A1)	; IF IT IS A LETTER OR A NUMBER
	JRST	LET2		; THEN CONTINUE WITH IDENTIFIER NAME
	MOVE	A4,ZDOT		; ELSE BUFFER THE LEXEME FOR
	MOVEM	A4,BLEX		; THE DELIMITER "DOT"
	JRST	LET4		; END OF IDENTIFIER NAME
	; THE FOLLOWING ROUTINES PROCESS THE FLAGGED RESERVED WORDS

FBEGIN:	SOSGE	A5,BTI		; DECREMENT BEGIN TABLE INDEX
	POPJ	SP,		; EXIT LSCAN IF TABLE IS FULL
	AOS	A4,BNUM		; ADD 1 TO BEGIN NUMBER
	MOVEM	A4,BTAB(A5)	; STORE NUMBER IN TABLE
	POPJ	SP,		; EXIT LSCAN



FEND:	AOSG	A4,BTI		; STEP BEGIN TABLE INDEX
	POPJ	SP,		; EXIT LSCAN IF TABLE STILL FULL
	SKIPE	A4,BTAB-1(A4)	; LOAD BEGIN NUMBER (DON'T PRINT E0)
	MOVEM	A4,ENUM		; SAVE FOR PRINTING
	POPJ	SP,		; EXIT LSCAN



	; A "GO" HAS BEEN SCANNED, NOW SEARCH FOR THE "TO"

FGO:	LDB	A1,P		; GET LAST CHAR
	MOVE	A2,CTABLE(A1)	; GET ITS TABLE ENTRY

FGO1:	CAIE	A2,3		; IF IT  IS NOT A SPACE OR A TAB
	JRST	GOERR2		; THEN HE BLEW IT
	JSP	A6,GETCHR	; GET ANOTHER CHAR
	CAIE	A1,.T		; IF IT IS NOT A "T"
	JRST	FGO1		; THEN SEARCH NEXT CHAR
	JSP	A6,GETCHR	; GET ANOTHER CHAR
	CAIE	A1,.O		; IF IT IS NOT A "O"
	JRST	GOERR1		; THEN IT IS WRONG
	JSP	A6,GETCHR	; GET ANOTHER CHAR
	CAIE	A2,-1		; THIS CHARACTER MUST NOT BE AN UPPER
	CAIN	A2,5		; OR LOWER CASE LETTER
	JRST	GOERR1		; OR IT IS AN ERROR

FGO2:	MOVE	A3,ZGOTO	; LOAD LEXEME
	POPJ	SP,		; EXIT LSCAN

GOERR1:	PUSHJ	SP,ATNAC		; ADVANCE TO NON-ALPHAMERIC CHAR

GOERR2:	FAIL	(92,SOFT,IMM,IMPROPER WORD DELIMITER)
	JRST	FGO2
COMNT2:	SKIPN	RWS		; 'COMMENT': IF QUOTED MODE
	POP	SP,A1		; THEN LOSE LINK FROM SQUOTE
	TDZA	A1,A1		; AND CLEAR A1

COMNT0:	MOVEI	A1,-1		; "!": FLAG A1
	CAME	DEL,ZEND	; IF DEL#END
EDIT(104); Allow comment to go over newlines without error.
	JRST	COMNT4		; [E104] THEN PROCEED
	FAIL(0,SOFT,IMM,PROBABLY SEMICOLON OMITTED)
	PUSHJ	SP,COMNT3(A1)	; [E104] DISPATCH INTO CODE
	JRST	LSCAN		; [E104] AND RESTART
COMNT4:	PUSHJ	SP,COMNT3(A1)	; [E104] DISPATCH TO IGNORE COMMENT
	IBP	P		; [E104] THEN STEP BYTE POINTER
	AOS	CC		; [E104] AND CHARACTER COUNT
	JRST	LSCAN		; [E104] TO IGNORE SEMICOLON

NEW2:	PUSHJ	SP,NEWLINE	; CALL NEWLINE (SKIP RETURN!)

COMNT1:	JSP	A6,GETCHR	; GET NEXT CHAR

COMNT3:	LDB	A1,P		; GET THE CHARACTER
	MOVE	A2,CTABLE(A1)	; GET ITS TABLE ENTRY
	CAIN	A2,4		; IF IT IS A NEW-LINE CHAR
	JRST	NEW2		; THEN HANDLE SPECIALLY
	CAIE	A1,.SEMI	; IF IT IS NOT A SEMI-COLON
	JRST	COMNT1		; THEN LOOP
	POPJ	SP,		; [E104] THEN RETURN
44;	*****  D I G I T S  *****
;
;	"DIGITS" IS USED TO SCAN DECIMAL CONSTANTS.  "DIGITS"
;	WILL COMPUTE THE VALUE, PUT IT INTO THE CONSTANTS TABLE
;	IF NECESSARY, AND PRODUCE THE LEXEME.
;
;	"DIGITS" WORKS BY READING THE 1ST 10 DIGITS WITH A
;	QUICK 7-INSTRUCTION LOOP (LLOOP1) THAT ALWAYS PRODUCES AN INTEGER.
;	IF A DECIMAL POINT IS ENCOUNTERED, THE LOOP INDEX IS SAVED
;	IN "MARKER" AND USED LATER TO DETERMINE THE POWER OF TEN, 
;	THEN CONTROL RETURNS TO THE LOOP.  IF THERE ARE MORE THAN
;	TEN DIGITS, CONTROL PASSES TO A SECOND LOOP (LLOOP2) THAT
;	READS DIGITS INTO THE DOUBLE AC 4-5 ABSORBING A DECIMAL
;	POINT IF NECESSARY.   FINALLY
;	THE CONSTANT IS CONVERTED TO THE INDICATED TYPE.
;	SINGLE-PRECISION FLOATING POINT IS FIRST CONVERTED TO
;	DOUBLE-PRECISION FLOATING POINT, THEN THE POWER OF TEN
;	IS INCLUDED.  THIS IS DONE SO THAT ALL 27 BITS OF THE
;	FRACTION ARE ACCURATE.
;	ROUNDING TO SINGLE-PRECISION IS DONE LATER, IF NECESSARY, BY
;	CONVERT.
;

DIGITS:
	; SET UP FOR READING DIGITS

	MOVEI	A3,^D9		; READ 1ST 9 DIGITS OF NUMBER
	SETZB	A4,MARKER	; CLEAR DECIMAL POINT MARKER
	SETZM	EXTRA		; AND EXTRA DIGIT COUNT
EDIT(044); Dont force constants to D.P. unnecessarily
	SETZM	FORMAT		; [E044] ASSUME IT WILL BE SINGLE PRECISION
	MOVEI	A5,-.N0(A1)	; CONVERT 1ST CHAR TO BINARY

	; MAIN LOOP FOR SCANNING NUMBER

LLOOP1:	ILDB	A1,P		; READ NEXT CHAR
	AOS	CC		; STEP POSITION COUNT

C1:	MOVE	A2,CTABLE(A1)	; GET CHAR'S TABLE ENTRY
	JRST	@TABLE4(A2)	; JUMP THROUGH TABLE 4

C2:	IMULI	A5,^D10		; MULT PREVIOUS RESULT BY TEN
	ADDI	A5,-.N0(A1)	; ADD IN NEW DIGIT
	SOJG	A3,LLOOP1	; LOOP

	; NUMBER IS LONGER THAN 10 CHARS

	MOVEI	A3,30000	; SET A NEW INDEX
	SKIPE	MARKER		; IF A DECIMAL POINT HAS OCCURRED
	ADDM	A3,MARKER	; THEN ADD NEW INDEX TO MARKER
	; LOOP THAT READS UNTIL OVERFLOW

LLOOP2:	JSP	A6,IGST		; READ NEXT CHAR
	CAIN	A1,.DOT		; IF IT IS A DOT
	JRST	C3		; THEN EXIT THIS LOOP
	MOVE	A2,CTABLE(A1)	; IF CHAR IS NOT NUMERIC
	AOJGE	A2,@TABLE4(A2)	; GO ELSEWHERE
	EXCH	A4,A5		; SWAP TO LONG MULTIPLY
	MULI	A4,^D10		; MULTIPLY SUM SO FAR
	ADDI	A5,-.N0(A1)	; AND ADD THE NUMBER
	TLZE	A5,(1B0)	; [E044] OVERFLOW INTO TOP BIT ?
	AOJA	A4,C6D		; [E044] YES - ADD IT IN TO A4
	JUMPN	A4,C6D		; IF A4 NON-ZERO SUM V. LARGE
	SOJA	A3,LLOOP2	; KEEP GOING

C3:	MOVEM	A3,MARKER	; STORE DECIMAL POINT MARKER
	
;	MAIN LOOP FOR SCANNING LONG NUMBERS

LLOOP3:	ILDB	A1,P		; GET NEXT CHAR
	AOS	CC		; STEP POSITION COUNT

C5:	MOVE	A2,CTABLE(A1)	; GET TABLE ENTRY
	JRST	@TABLE5(A2)	; AND USE TABLE5
C6:	MOVEM	A5,COPY		; LONG INTEGER MULTIPLY
	MULI	A4,^D10		; MULTIPLY HIGH-ORDER WORD
	JUMPN	A4,C6A		; TOO BIG IF NON-ZERO
	MOVE	A4,COPY		; NOW THE LOW-ORDER
	MOVEM	A5,COPY		; INTO THE CORRECT HALF
	MULI	A4,^D10		; MULTIPLY LOW-ORDER WORD
	ADDI	A5,-.N0(A1)	; ADD IN THE NEW NUMBER
	ADD	A4,COPY		; ADD BACK THE HIGH ORDER WORD
	TLZE	A5,(1B0)	; [E044] CARRY INTO TOP BIT OF LOW WORD ?
	ADDI	A4,1		; [E044] YES - ADD IN TO HIGH WORD
C6D:	SOJA	A3,LLOOP3	; AND KEEP GOING

C6A:	DIVI	A4,^D10		; RESTORE THE ORIGINAL NUMBER
	MOVE	A5,COPY		; RESTORE LOW-ORDER WORD
	SKIPE	MARKER		; IF DECIMAL POINT EVER SCANNED
	JRST	C6C		; DON'T WORRY
;
; OTHERWISE NUMBER IS TOO LARGE - SAY SO
;
	CAIL	A1,"5"		;
	ADDI	A5,1		; ROUND IN IGNORED DIGIT
	MOVE	A1,[
	XWD	..IMM,^D98]
	PUSHJ	SP,.FAILED
	AOS	EXTRA		; ALLOW FOR DIGIT JUST IGNORED
C6C:	AOS	CC
	ILDB	A1,P		; NEXT CHAR
	MOVE	A2,CTABLE(A1)	; GET ITS TABLE ENTRY
	AOJGE	A2,@TABLE5(A2)
	SKIPN	MARKER		; IF NO DECIMAL POINT SEEN,
	AOS	EXTRA		; COUNT IGNORED DIGITS
	JRST	C6C		; AND KEEP IGNORING
	C2			; NUMBER
	C8			; LETTER
TABLE4:	C8			; DELIMITER
	C8			; DELIMITER (FLAGGED)
	LLOOP1			; IGNORABLE CHARACTER
	LLOOP1			; SPACE & TAB
	C8B			; NEW-LINE
	C8			; LOWER CASE LETTER
	C10			; OTHER (E.G. PERIOD, &, @)
	C8			; SINGLE QUOTE



C8B:	PUSHJ	SP,NCHECK	; INPUT NEXT LINE
	JRST	C1		; -END OF BUFFER IN MID LINE, CONTINUE

	; NORMAL END OF NUMBER

C8:	SKIPE	MARKER		; IF A DECIMAL POINT WAS EVER SCANNED
	JRST	C18		; THEN THE NUMBER IS DOUBLE-FLOATING

C8A:	TLNE	A5,777777	; IF LEFT HALF OF VALUE IS NON ZERO
	JRST	C9		; THEN NUMBER IS NOT INTEGER-IMMEDIATE

	; THE CONSTANT IS AN INTEGER-IMMEDIATE

	MOVE	A3,A5		; MOVE CONSTANT TO A3 FOR OUTPUT
	HRLI	A3,$EXP+$I+$SIM+$DEC+$IMM; LEXEME TYPE FIELDS
	JRST	LET9		; EXIT LSCAN

	; THE CONSTANT IS AN INTEGER FULLWORD

C9:	PUSHJ	SP,CON1Z		; SEARCH CONSTANTS TABLE
	HRLI	A3,$EXP+$I+$SIM+$DEC+$CT; LEXEME LEFT HALF
	JRST	LET9		; EXIT LSCAN
	; A SPECIAL CHARACTER WAS SCANNED

C10:	HLRZ	A2,CTABLE(A1)	; GET LEFT HALF OF CHAR'S TABLE ENTRY
	JRST	@TABLE6(A2)	; JUMP THROUGH TABLE 6

TABLE6:	C19			; ILLEGAL CHARACTER
	C22			; [E044] @ &
	C20			; " $ %
	C16			; .

	; A DOT WAS SCANNED

C16:	SKIPE	MARKER		; IF MARKER NOT ZERO THEN THERE ARE
	JRST	C17		; TWO DECIMAL POINTS IN THIS CONSTANT
	MOVEM	A3,MARKER	; SET DECIMAL POINT MARKER
	JRST	LLOOP1		; RETURN TO LOOP
	; CONSTANT CONTAINS TWO DECIMAL POINTS

C17:	PUSHJ	SP,BADNAC	; PRINT ERROR MSG, USE ATNAC

	; CONVERT CONSTANT TO DOUBLE-FLOATING

C18:	SUB	A3,MARKER	; FIX SCALING CONSTANT
	JRST	C13		; HALVES AND CONTINUE



	; AN ILLEGAL CHARACTER WAS SCANNED

C19:	PUSHJ	SP,BADNAC	; PRINT ERROR MESSAGE, USE ATNAC
	JRST	C8		; CONTINUE

C20:	PUSHJ	SP,BADCON	; PRINT ERROR MSG
	JRST	C8		; CONTINUE

	C6			; NUMBER
	C30			; LETTER
TABLE5:	C28			; DELIMITER
	C28			; DELIMITER (FLAGGED)
	LLOOP3			; IGNORABLE
	C28			; SPACE & TAB
	C36			; NEW-LINE
	C30			; LOWER CASE LETTER
	C21			; OTHER
	C28			; SINGLE QUOTE
	; A SPECIAL CHAR WAS SCANNED

C21:	HLRZ	A2,CTABLE(A1)	; GET LEFT HALF OF CHAR'S TABLE ENTRY
	JRST	@TABLE7(A2)	; JUMP THROUGH TABLE 7

TABLE7:	C27			; ILLEGAL CHARACTER
	C22			; @ &
	C30			; " $ %
	C25			; .

	; A @ OR & WAS SCANNED

C22:	JSP	A6,IGST		; GET NEXT CHAR
	CAIE	A1,.AAAAA	; IF IT IS A @
	CAIN	A1,.AMPER	; OR A &
	AOSA	FORMAT		; [E044] THEN REMEMBER IT WAS
	JRST	C24		; [E044] ELSE CARRY ON
	JSP	A6,GETCHR	; [E044] IGNORE IT
;****	JRST	C24		; [E044] FALL THROUGH TO GET EXPONENT

	; PRODUCE LEXEME FOR DOUBLE PRECISION CONSTANT

C24:	PUSHJ	SP,EXPONT	; SCAN THE EXPONENT

C13:	PUSHJ	SP,FCMML	; INCLUDE CORRECT POWER OF TEN
	SKIPE	FORMAT		; [E044] IS THIS EXPLICIT DOUBLE PRECISION ?
	JRST	C13A		; [E044] YES - MUST MAKE DOUBLE-WORD CONSTANT
	JUMPE	A5,C13B		; [E044] NO  - CAN WE USE A SINGLE WORD ?
	TLO	A5,(1B0)	; [E044] NO  - SET SIGN BIT OF SECOND WORD TO 1
C13A:	PUSHJ	SP,CON2		; PUT CONSTANT IN CONSTANT TABLE
	HRLI	A3,$EXP+$LR+$SIM+$DEC+$CT; LEXEME LEFT HALF
	JRST	LET9		; EXIT LSCAN
C13B:	TRNN	A4,-1		; [E044] CAN THIS BE AN IMMEDIATE CONSTANT ?
	JRST	C13C		; [E044] YES - GO FORM THE LEXEME
	PUSHJ	SP,CON1		; [E044] NO  - ENTER IT IN THE TABLE
	HRLI	A3,$EXP+$R+$SIM+$DEC+$CT; [E044] FORM LEXEME
	JRST	LET9		; [E044] EXIT FROM LSCAN
C13C:	HLRZ	A3,A4		; [E044] IMMEDIATE REAL CONSTANT - GET VALUE
	HRLI	A3,$EXP+$R+$SIM+$DEC+$IMM; [E044] SET LEXEME BITS IN L.H.
	JRST	LET9		; [E044] AND EXIT FROM LSCAN


	; A DOT WAS SCANNED

C25:	SKIPE	MARKER		; IF MARKER NOT ZERO THEN THERE ARE
	JRST	C26		; TWO DECIMAL POINTS IN THIS CONSTANT
	MOVEM	A3,MARKER	; SET DECIMAL POINT MARKER
	JRST	LLOOP3		; RETURN TO LOOP
	; EITHER A LETTER OR TWO DECIMAL POINTS APPEARED IN CONSTANT

C26:	PUSHJ	SP,BADNAC	; PRINT ERROR MSG, USE ATNAC
	JSP	A6,IGST		; GET NEXT CHAR
	CAME	A1,.AAAAA	; IF IT IS A @
	CAMN	A1,.AMPER	; OR A &
	JRST	C22		; THEN CONTINUE AS DOUBLE-PRECISION
	JRST	C28		; ELSE CONVERT TO SINGLE-PRECISION



	; A STRANGE CHAR APPEARED IN CONSTANT

C27:	PUSHJ	SP,BADNAC	; PRINT ERROR MSG, USE ATNAC
	JRST	C28		; CONTINUE

C30:	PUSHJ	SP,BADCON	; PRINT ERROR MESSAGE

C28:	SKIPE	MARKER		; IF A DECIMAL POINT WAS EVER SCANNED
	JRST	C29		; THEN JUMP OVER THIS PART

	; INTEGER TOO LARGE FOR INTEGER

	MOVE	A1,[		; LOAD PARAMETER FOR MESSAGE
	XWD	..IMM,^D98]	; MSG 98
	PUSHJ	SP,.FAILED	; "INTEGER CONST CONVERTED TO TYPE REAL"
	TDZA	A3,A3		; EXPONENT OF ZERO

C29:	SUB	A3,MARKER	; FIX SCALING
	ADD	A3,EXTRA	; ALLOW FOR SKIPPED DIGITS
	JRST	C13		; CONTINUE AS DOUBLE PRECISION
BADCON:	FAIL	(90,FRIED,IMM,INVALID CONSTANT)
	POPJ	SP,		; EXIT BADCON

	; SUBROUTINE TO SCAN POWER OF TEN

EXPONT:	SKIPE	MARKER		; IF A DECIMAL POINT HAS OCCURRED
	SUBM	A3,MARKER	; THEN SET CORRECT POWER OF TEN
	SETZB	A3,SIGN		; CLEAR EXPONENT AND SIGN
	CAIN	A1,.MINUS	; IF IT IS A MINUS SIGN
	JRST	C34		; THEN SET INDICATOR
	CAIN	A1,.PLUS	; IF IT IS A PLUS SIGN
	JRST	C35		; THEN READ NEXT CHAR

LLOOP4:	HRRZ	A2,CTABLE(A1)	; GET CHAR'S TABLE ENTRY
	CAIE	A2,-2		; IF IT IS NOT A DIGIT
	JRST	C31		; THEN JUMP OUT OF LOOP
	IMULI	A3,^D10		; MULT PREVIOUS RESULT BY TEN
	ADDI	A3,-.N0(A1)	; ADD IN CURRENT DIGIT
	CAILE	A3,^D300	; IF NUMBER IS EXCEEDINGLY LARGE
	JRST	C33		; THEN STOP THIS NONSENSE
	JSP	A6,IGST		; GET NEXT CHAR
	JRST	LLOOP4		; LOOP


C31:	CAIN	A2,6		; IF IT IS AN ILLEGAL CHAR
	JRST	C33		; THEN PRINT ERROR
	SKIPE	SIGN		; IF SIGN IS NEGATIVE
	MOVN	A3,A3		; THEN NEGATE EXPONENT
	ADD	A3,EXTRA	; ALLOW FOR ANY IGNORED DIGITS
	SETZM	EXTRA		;
	ADD	A3,MARKER	; ADD IN DECIMAL POINT CORRECTION
	POPJ	SP,		; EXIT EXPONT
C33:	PUSHJ	SP,BADNAC	; PRINT MSG, USE ATNAC

C4:	SETZ	A3,		; USE A ZERO EXPONENT
	POPJ	SP,		; EXIT EXPONT


C34:	SETOM	SIGN		; SET SIGN MINUS

C35:	JSP	A6,IGST		; GET NEXT CHAR
	JRST	LLOOP4		; RETURN TO LOOP



C36:	PUSHJ	SP,NCHECK	; INPUT NEXT LINE
	JRST	C5		; -END OF BUFFER IN MID LINE, CONTINUE
	JRST	C28		; TRUE END OF LINE

; UNDERFLOW HANDLERS

FPU1:	TLNN	A2,000100	; IF NOT UNDERFLOW
	JRST	(A2)		; THEN RETURN
	TLZ	A2,440100	; CLEAR FLAGS
	MOVEM	A2,OVA
	LDB	A2,[
	POINT	4,-2(A2),12]	; GET RELEVANT ACC. NUMBER
	SETZM	(A2)		; AND ZERO IT
	JRST	2,@OVA		; AND RETURN

FPU2:	TLNN	A2,000100	; IF NOT UNDERFLOW
	JRST	(A2)		; THEN RETURN
	TLZ	A2,440100	; CLEAR FLAGS
	MOVEM	A2,OVA
	LDB	A2,[
	POINT	4,-2(A2),12]	; GET RELEVANT ACC. NUMBER
	SETZM	(A2)		; AND ZERO IT
	SETZM	1(A2)		; ALSO ZERO NEXT ACC.
	JRST	2,@OVA		; AND RETURN

FPUS:	TLNN	A2,000100	; IF NOT UNDERFLOW
	JRST	(A2)		; THEN RETURN
	TLZ	A2,440100	; CLEAR FLAGS
	MOVEM	A2,OVA
	LDB	A2,[
	POINT	4,-2(A2),12]	; GET RELEVANT ACC. NUMBER
	MOVEM	A2,OVB		; AND SAVE IT
	MOVEM	A3,OVC		; AND A3
	MOVE	A2,(A2)		; GET VALUE OF ACC.
	HLRE	A3,A2		; GET EXPONENT, EXTENDING SIGN
	ASH	A3,-11
	TSCE	A3,A3		; IF NEGATIVE, COMPLEMENT EXPONENT
	TLOA	A2,777000	; NEGATIVE - SET ALL ONES
	TLZ	A2,777000	; POSITIVE - SET ALL ZEROS
	CAMGE	A3,[
	XWD	000346,000346]	; WILL ALL OF MANTISSA DISAPPEAR?
	TDZA	A2,A2		; YES - SAVE LONG SHIFT
	ASH	A2,400000(A3)	; DENORMALIZE MANTISSA TO SUIT EXPONENT
	MOVEM	A2,@OVB		; RESTORE RELEVANT ACC.
	MOVE	A3,OVC		; RESTORE A3
	JRST	2,@OVA		; AND RETURN
	RELOC

LSBUFP:	BLOCK	2		; NAME BUFFER POINTER
LSBUF1:	BLOCK	14		; NAME BUFFER
LSBUF2:	BLOCK	14		; NAME BUFFER
LSBUF3:	BLOCK	14		; NAME BUFFER
RWSL:	BLOCK	1		; ADDR OF RESERVED WORD TABLE SUBLIST
BLEX:	BLOCK	1		; BUFFERED LEXEME
CC:	BLOCK	1		; POSITION COUNT
BTI:	BLOCK	1		; BEGIN-TABLE INDEX
BTAB:	BLOCK	50		; BEGIN-TABLE

EXPSAV:	BLOCK	1		; TO SAVE THE EXPONENT
DECEXP:	BLOCK	1		; TO STORE THE DECIMAL EXPONENT

	RELOC
LSBUFT:	XWD	A6,LSBUF1	; NAME BUFFER LIST
	XWD	A6,LSBUF2
	XWD	A6,LSBUF3
	0

MSKTBL:	000000000000
	000000000000
	000000000377
	000000077777
	000000000000
	000017777777
	000000000000
	003777777777
	SUBTTL	POWERS OF TEN TABLE
;
;POWER OF TEN TABLE IN DOUBLE PRECISION INTEGER FORMAT,
; EACH WITH 35 BITS OF FRACTION (SIGNS ARE EXLCLUDED), THE
; BINARY POINT IS BETWEEN BITS 0 AND 1 OF THE HIGH ORDER
; WORD, THE EXPONENT (EXCESS 200) FOR THE 70 BIT FRACTION
; IS STORED IN THE SHORT TABLE "EXPTEN"
;
DEFINE .TAB. (A)<
REPEAT 0,<
NUMBER 732,357347511265,056017357445
NUMBER 736,225520615661,074611525567
NUMBER 741,273044761235,213754053125
NUMBER 744,351656155504,356747065752
NUMBER 750,222114704413,025260341562
NUMBER 753,266540065515,332534432117
NUMBER 756,344270103041,121263540543
NUMBER 762,216563051724,322660234335
NUMBER 765,262317664312,007434303425
NUMBER 770,337003641374,211343364332
NUMBER 774,213302304735,325716130610
NUMBER 777,256162766125,113301556752
>
NUMBER 002,331617563552,236162112545
NUMBER 006,210071650242,242707256537
NUMBER 011,252110222313,113471132267
NUMBER 014,324532266776,036407360745
NUMBER 020,204730362276,323044526457
NUMBER 023,246116456756,207655654173
NUMBER 026,317542172552,051631227231
NUMBER 032,201635314542,132077636440
NUMBER 035,242204577672,360517606150
NUMBER 040,312645737651,254643547602
NUMBER 043,375417327624,030014501542
NUMBER 047,236351506674,217007711035
NUMBER 052,306044030453,262611673245
NUMBER 055,367455036566,237354252116
NUMBER 061,232574123152,043523552261
NUMBER 064,301333150004,254450504735
NUMBER 067,361622002005,327562626124
NUMBER 073,227073201203,246647575664
NUMBER 076,274712041444,220421535242
NUMBER 101,354074451755,264526064512
NUMBER 105,223445672164,220725640716
NUMBER 110,270357250621,265113211102
NUMBER 113,346453122766,042336053323
NUMBER 117,220072763671,325412633103
NUMBER 122,264111560650,112715401724
NUMBER 125,341134115022,135500702312
NUMBER 131,214571460113,172410431376
NUMBER 134,257727774136,131112537675
NUMBER 137,333715773165,357335267655
NUMBER 143,211340575011,265512262714
NUMBER 146,253630734214,043034737477
NUMBER 151,326577123257,053644127417
NUMBER 155,206157364055,173306466551
NUMBER 160,247613261070,332170204303
NUMBER 163,321556135307,020626245364
NUMBER 167,203044672274,152375747331
NUMBER 172,243656050753,205075341217
NUMBER 175,314631463146,146314631463
A:
NUMBER 201,200000000000,0
NUMBER 204,240000000000,0
NUMBER 207,310000000000,0
NUMBER 212,372000000000,0
NUMBER 216,234200000000,0
NUMBER 221,303240000000,0
NUMBER 224,364110000000,0
NUMBER 230,230455000000,0
NUMBER 233,276570200000,0
NUMBER 236,356326240000,0
NUMBER 242,225005744000,0
NUMBER 245,272207335000,0
NUMBER 250,350651224200,0
NUMBER 254,221411634520,0
NUMBER 257,265714203644,0
NUMBER 262,343277244615,0
NUMBER 266,216067446770,040000000000
NUMBER 271,261505360566,050000000000
NUMBER 274,336026654723,262000000000
NUMBER 300,212616214044,117200000000
NUMBER 303,255361657055,143040000000
NUMBER 306,330656232670,273650000000
NUMBER 312,207414740623,165311000000
NUMBER 315,251320130770,122573200000
NUMBER 320,323604157166,147332040000
NUMBER 324,204262505412,000510224000
NUMBER 327,245337226714,200632271000
NUMBER 332,316627074477,241000747200
NUMBER 336,201176345707,304500460420
NUMBER 341,241436037271,265620574524
NUMBER 344,311745447150,043164733651
NUMBER 347,374336761002,054022122623
NUMBER 353,235613266501,133413263573
NUMBER 356,305156144221,262316140531
NUMBER 361,366411575266,037001570657
NUMBER 365,232046056261,323301053415
NUMBER 370,300457471736,110161266320
NUMBER 373,360573410325,332215544004
NUMBER 377,226355145205,250330436402
REPEAT 0,<
NUMBER 402,274050376447,022416546102
NUMBER 405,353062476160,327122277522
NUMBER 411,222737506706,206363367623
NUMBER 414,267527430470,050060265567
NUMBER 417,345455336606,062074343124
NUMBER 423,217374313163,337245615764
NUMBER 426,263273376020,327117161361
NUMBER 431,340152275425,014743015655
NUMBER 435,214102366355,050055710514
NUMBER 440,257123064050,162071272637
NUMBER 443,332747701062,216507551406
NUMBER 447,210660730537,231114641743
NUMBER 452,253035116667,177340012333
>
>
DEFINE NUMBER(A,B,C)
<EXP B,C>
TENTAB:	.TAB. TENS
XX==<TENS-TENTAB>/2	; CALCULATE THE NUMBER OF TABLE ENTRIES BEFORE "TENS"
XX==XX-XX/4*4		; CALC XX=XX MOD 4

BINR1==<BINR2==<BINR3==0>>	; INIT THE BINARY
DEFINE NUMBER (A,B,C)<
IFE XX-1,<	BYTE (9) BINR1,BINR2,BINR3,<A>
	BINR1==<BINR2==<BINR3==0>> >
IFE XX-2,<BINR3==A>
IFE XX-3,<BINR2==A>
IFE XX,<BINR1==A
	XX==4>
XX==XX-1>

	POINT ^D9,EXPTEN-1(A6),^D17
	POINT ^D9,EXPTEN-1(A6),^D26
	POINT ^D9,EXPTEN-1(A6),^D35
BYTAB:	POINT ^D9,EXPTEN(A6),^D8
	POINT ^D9,EXPTEN(A6),^D17
	POINT ^D9,EXPTEN(A6),^D26
	POINT ^D9,EXPTEN(A6),^D35

.TAB. EXPTEN
IFN BINR1!BINR2!BINR3,< BYTE (9) BINR1,BINR2,BINR3,0>
	SUBTTL	FLOATING CONSTANT MAKER
		;
		; BASED ON FORTRAN ROUTINE FCMML
		; TO CONVERT A DOUBLE-LENGTH INTEGER CONSTANT TO A
		; DOUBLE PRECISION CONSTANT FOR KA OR KI PROCESSORS
		;
FCMML:	PUSH	SP,A7		; SAVE A7
	MOVEM	A3,DECEXP	; HIGH ORDER WORD
	MOVE	A6,A5		; LOW ORDER WORD
	JFFO	A4,FCMML0	; DOES HIGH WORD HAVE ONES ?
	EXCH	A4,A6		; NO, SWAP HIGH AND LOW
	MOVEI	A2,243		; SET BIN POINT BETWEEN HALVES
	JFFO	A4,FCMML0+1	; ANY ONES NOW ?
	JRST	FCFML		; NUMBER IS ZERO

FCMML0:	MOVEI	A2,306		; MAXIMUM EXPONENT
	EXCH	A5,A6		; SWAP LOW WORD AND SHIFT COUNT
	ASHC	A4,-1(A6)	; LEFT NORMALISE
	SUBI	A2,-1(A6)	;  ADJUST EXPONENT ACCORDINGLY

FCMML2:	MOVM	A1,A3		; GET MAGNITUDE OF DECIMAL EXP
	CAILE	A1,^D100	; TOO BIG ?
	JRST	FCMOVR		; YES, OVERFLOW ERROR
	JUMPE	A1,FCMML6	; EXP=0

FCMML3:	SETZM	EXPSAV
	CAIG	A1,^D38		; EXPONENT GT 38
	JRST	FCMML4		; NO
	SUBI	A1,^D38		; REDUCE IT BY 38
	MOVEM	A1,EXPSAV	; SAVE THE DIFFERENCE
	MOVEI	A1,^D38		; SET FOR FIRST  * OR /

FCMML4:	LSH	A1,1		;
	SKIPGE	DECEXP		; IS EXPONENT -VE ?
	MOVNS	A1		; ADJUST TABLE INDEX
	;
	; START LONG PRECISION INTEGER MULTIPLY
	;
	MUL	A5,TENS(A1)	; A5 := (A5*H)*H
	MOVE	A3,A5		; SAVE RESULT
	MOVE	A5,A4		; GET HIGH FRACTION
	MUL	A5,TENS+1(A1)	; AND MULTIPLY BY LOW TEN
	ADD	A3,A5		; ADD HIGH PARTS OF CROSS PRODUCTS
	MUL	A4,TENS(A1)	; FORM PRODUCT OF THE HIGH PARTS
	TLZE	A3,(1B0)	; PROPAGATE A CARRY IF REQ'D
	ADDI	A4,1		;
	ADD	A5,A3
	TLZE	A5,(1B0)
	ADDI	A4,1
	TLNE	A4,(1B1)	; IS RESULT NORMALISED ?
	JRST	.+3		; YES
	ASHC	A4,1		; NO - LEFT SHIFT ONE
	SUBI	A2,1		; AND ADJUST EXPONENT



FCMML5:	MOVE	A6,A1		; MOVE DECIMAL EXPONENT TO DOUBLE AC
	ASH	A6,-1		; RESTORE SIGNED EXPONENT
	IDIVI	A6,4		; BYTAB PACKED 4 ENTRIES PER WORD
	LDB	A6,BYTAB(A7)	; GET BINARY EXPONENT POWER 10
	ADD	A2,A6		; ADD IT INTO FINAL BINARY EXPONENT
	SUBI	A2,200		; GET RID OF EXCESS 200
	SKIPE	A1,EXPSAV	;
	JRST	FCMML3

; We get here with (A4,A5) holding a double precision
; binary fraction (normalized to bit 1 of A4), and A2
; holding the binary exponent.
FCMML6:	SKIPE	TARGMC		; [E056] FOR A KA10 ?
	JRST	FCMMLI		; [E056] NO  - SIMPLE CASE.
	CAIL	A2,^D27		; [E056] YES - WILL EXPONENT UNDERFLOW ?
	JRST	FCMMLA		; [E056] NO  - THIS, TOO, IS SIMPLE
	TRNE	A4,200		; [E056] DO WE NEED TO ROUND HIGH WORD ?
	TROA	A4,177		; [E056] YES - SET CARRY TO PROPAGATE
	TRZA	A4,177		; [E056] NO  - CLEAR BOTTOM 8 BITS
	SKIPA	A5,[3777777B20]	; [E056] YES - PRESET TO GET CARRY
	SETZ	A5,		; [E056] NO  - CLEAR BOTTOM WORD
FCMMLA:	ADDI	A5,077600	; [E056] KA10 - ADD EXTRA ADJUSTMENT
FCMMLI:	ADDI	A5,200		; [E056] KA/KI - ROUND LOW ORDER WORD
	TLZE	A5,(1B0)	; [E056] IF NO CARRY NEEDED
	AOSL	A4		; [E056] OR A4 WAS NOT 377777,,777777
	JRST	FCMML7		; [E056] THEN CARRY ON
; Adding in a half (to the lowest bit position) caused carry. This can
; only happen if all bits were one, in which case all significant bits
; are now zero.
	ADDI	A2,1		; [E056] INCREASE EXPONENT BY ONE, AND SET
	MOVSI	A4,(1B1)	; [E056] (A4,A5) TO 200000000000000000....

FCMML7:	TRNE	A2,777400	; [E056] IS EXPONENT IN RANGE 000-377 ?
	JRST	FCMOV1		; [E056] NO  - OVERFLOW. SET TO MIN/MAX
	ASHC	A4,-^D8		; [E056] YES - MAKE ROOM FOR EXPONENT
	DPB	A2,[
	POINT	^D9,A4,^D8]	; [E056] AND INSERT IT
	SKIPE	TARGMC		; [E056] IS IT FOR A KA ?
	JRST	FCFML		; [E056] NO  - DONE
	ASH	A5,-^D8		; [E056] YES - MAKE ROOM FOR LOW EXPONENT
	JUMPE	A5,FCFML	; [E056] NO EXPONENT IF ZERO
	HRREI	A1,-^D27(A2)	; [E056] ELSE GET LOW EXPONENT IN A1
	DPB	A1,[
	POINT	^D8,A5,^D8]	; [E056] AND DEPOSIT IT IN LOW WORD

FCFML:	POP	SP,A7		; RESTORE A7
	POPJ	SP,

FCMOVR:	MOVE	A2,DECEXP

FCMOV1:	SKIPGE	A2
	TDZA	A4,A4		; YES, ZERO ON UNDERFLOW
	HRLOI	A4,377777	; NO MAX NUMBER ON OVERFLOW
	MOVE	A5,A4		; SAVE PATCHED RESULT AS ANSWER
	SKIPN	TARGMC		; [E056] FOR A KA10 ?
	TLZ	A5,033000	; [E056] YES - SET EXPONENT
	JRST	FCFML
SUBTTL	CONSTANT TABLE HANDLING
;   CONSTANTS TABLE
;
;	THE SIZE OF THE CONSTANTS TABLE ALWAYS INCREASES DURING A COMPILATION.
;	NEW ENTRIES ARE PLACED AT THE END, AND ARE ALSO LINKED INTO ONE OF
;	THREE CHAINS ACCORDING TO WHETHER IT IS FOR A 1-WORD CONSTANT,
;	A 2-WORD CONSTANT, OR A STRING.  THEREFORE EACH ENTRY HAS A LINK.
;	THIS LINK IS ALWAYS IN THE RIGHT HALF OF THE 1ST WORD OF THE ENTRY.
;	THE VALUE OF THE LINK IS EQUAL TO A NUMBER WHICH IF SUBTRACTED
;	FROM THE ADDRESS OF THE ENTRY WILL YIELD THE ADDRESS OF THE NEXT
;	ENTRY OF THE CHAIN.  EACH CHAIN TERMINATES IN A FAKE ENTRY WHOSE
;	1ST DATA WORD IS THE 1ST WORD OF THE CONSTANTS TABLE.  BECAUSE
;	OF THIS, THE CONSTANTS TABLE CAN BE SEARCHED IN A 3-INSTRUCTION LOOP.
;	THE FORMATS OF THE DIFFERENT TYPES OF ENTRIES ARE:
;
;
;
;            1-WORD CONSTANTS        2-WORD CONSTANTS             STRINGS
;
;         !--------------------!  !--------------------!  !--------------------!
;         !                    !  !                    !  !                    !
; WORD-0  ! LEFT:  BACKCHAIN   !  ! LEFT:  BACKCHAIN 1 !  ! LEFT:  BACKCHAIN 1 !
;         ! RIGHT: LINK        !  ! RIGHT: LINK        !  ! RIGHT: LINK        !
;         !                    !  !                    !  !                    !
;         !--------------------!  !--------------------!  !--------------------!
;         !                    !  !                    !  !                    !
; WORD-1  !       VALUE        !  ! LEFT:  (NOT USED)  !  ! LEFT:  (NOT USED)  !
;         !                    !  ! RIGHT: BACKCHAIN 2 !  ! RIGHT: BACKCHAIN 2 !
;         !                    !  !                    !  !                    !
;         !--------------------!  !--------------------!  !--------------------!
;                                 !                    !  !                    !
; WORD-2                          ! 1ST WORD OF VALUE  !  ! LEFT:  (NOT USED)  !
;                                 !                    !  ! RIGHT: # OF BYTES  !
;                                 !                    !  !                    !
;                                 !--------------------!  !--------------------!
;                                 !                    !  !                    !
; WORD-3                          ! 2ND WORD OF VALUE  !  ! 1ST WORD OF STRING !
;                                 !                    !  !                    !
;                                 !                    !  !                    !
;                                 !--------------------!  !--------------------!
;                                                         !                    !
;
;                                                         !                    !
;                                                         !--------------------!
;                                                         !                    !
; WORD-N+2                                                ! NTH WORD OF STRING !
;                                                         !                    !
;                                                         !                    !
;                                                         !--------------------!
	; ENTER 1-WORD CONSTANT IN CONSTANTS TABLE

CON1Z:	MOVE	A4,A5		; LOAD INTO A4, MOSTLY FOR DIGITS

CON1:	MOVEM	A4,@CONTAB	; SAVE VALUE IN BEGINNING OF CONSTANTS TABLE
	SKIPA	A3,LASTC1	; LOAD LAST 1-WORD CONSTANT, AND SKIP

CON1A:	SUB	A3,(A3)		; STEP BACK TO PREVIOUS ENTRY
	CAME	A4,1(A3)	; DO VALUES MATCH?
	JRST	CON1A		; -NO, LOOP
	MOVEI	A6,1(A3)	; ADDR OF NEXT WORD
	CAME	A6,CONTAB	; WAS WORD REALLY IN CONSTANTS TABLE?
	JRST	CON1B		; YES, STOP SEARCH
	MOVEI	A6,2		; NEW ENTRY IS 2 WORDS LONG
	PUSHJ	SP,GETCTS	; GET SOME SPACE IN CONSTANTS TABLE
	MOVEI	A6,(A3)		; COPY ADDR OF NEW ENTRY TO A6
	SUB	A6,LASTC1	; SUBTRACT FROM LAST 1-WORD ENTRY ADDR
	MOVEM	A6,(A3)		; SAVE IN NEW ENTRY AS A LINK
	MOVEM	A4,1(A3)	; PUT VALUE IN ENTRY
	MOVEM	A3,LASTC1	; SET NEW LASTC1

CON1B:	SUB	A3,CONTAB	; CONV FROM ABS TO REL ADDRESS
	POPJ	SP,		; EXIT CON1



	; GET SPACE IN CONSTANTS TABLE

GETCTS:	HRRZ	A3,NACTE	; ADDR OF NEW ENTRY
	ADDB	A6,NACTE	; ADD LENGTH OF NEW ENTRY
	CAML	A6,CONEND	; DOES IT OVERFLOW THE TABLE?
	JRST	OVFL2		; -YES, MOVE THE TABLES, EXIT GETCTS
	POPJ	SP,		; EXIT GETCTS

	; ENTER 2-WORD CONSTANT IN CONSTANTS TABLE

CON2:	MOVEM	A4,@CONTAB	; SAVE VALUE IN BEGINNING OF CONSTANT TABLE
	SKIPA	A3,LASTC2	; LOAD ADDR OF LAST 2-WORD CONSTANT AND SKIP

CON2A:	SUB	A3,(A3)		; STEP BACK TO PREVIOUS ENTRY
	CAME	A4,2(A3)	; DO VALUES MATCH?
	JRST	CON2A		; -NO, LOOP
	MOVEI	A6,2(A3)	; STEP TO NEXT WORD
	CAMN	A6,CONTAB	; WAS WORD REALLY IN CONSTANTS TABLE?
	JRST	CON2B		; -NO, ENTER IT
	CAME	A5,3(A3)	; DO 2ND WORDS MATCH?
	JRST	CON2A		; -NO, LOOP
	JRST	CON1B		; EXIT CON2
CON2B:	MOVEI	A6,4		; NEW ENTRY IS 4 WORDS LONG
	PUSHJ	SP,GETCTS	; GET SPACE FOR IT
	MOVEI	A6,(A3)		; COPY ADDR TO A6
	SUB	A6,LASTC2	; SUBTRACT FROM LAST 2-WORD ENTRY ADDR
	MOVEM	A6,(A3)		; SAVE IN NEW ENTRY AS A LINK
	MOVEM	A4,2(A3)	; PUT 1ST WORD IN ENTRY
	MOVEM	A5,3(A3)	; PUT 2ND WORD IN ENTRY
	SETZM	1(A3)		; CLEAR BACK-CHAINS
	MOVEM	A3,LASTC2	; SET NEW LASTC2
	JRST	CON1B

	RELOC

MARKER:	BLOCK	1		; DECIMAL POINT MARKER
COPY:	BLOCK	1		; TEMPORARY COPY OF VALUE OF CONSTANT
EXTRA:	BLOCK	1		; NUMBER OF DIGITS IGNORED
SIGN:	BLOCK	1		; SIGN OF THE EXPONENT
FORMAT:	BLOCK	1		; [E044] SINGLE/DOUBLE PRECISION FLAG
LASTC1:	BLOCK	1		; LAST 1-WORD CONSTANT IN CONSTANT TABLE
LASTC2:	BLOCK	1		; LAST 2-WORD CONSTANT IN CONSTANT TABLE
CONEND:	BLOCK	1		; END OF CONSTANT TABLE

	RELOC
;	*****  A T N A C  *****
;
;	ADVANCE TO NEXT NON-ALPHAMERIC CHARACTER
;

BADNAC:	PUSHJ	SP,BADCON	; BADCON/ATNAC
	JRST	ATNAC

ATNAC2:	CAIE	A1,.DOT		; IF IT IS NOT A DOT
	POPJ	SP,		; THEN EXIT ATNAC

ATNAC:	ILDB	A1,P		; LOAD THE NEXT CHAR
	AOS	CC		; STEP POSITION COUNT
	MOVE	A2,CTABLE(A1)	; GET ITS TABLE ENTRY
	JRST	@TABLE9(A2)	; JUMP THROUGH TABLE 9


	ATNAC			; NUMBER
	ATNAC			; LETTER
TABLE9:	ATNAC1			; DELIMITER
	ATNAC1			; DELIMITER (FLAGGED)
	ATNAC			; IGNORABLE CHAR
	ATNAC1			; SPACE & TAB
	ATNAC3			; NEW-LINE CHAR
	ATNAC			; LOWER-CASE
	ATNAC2			; OTHER CHAR   @ % $ " & . ILLEGALS
	ATNAC			; SINGLE QUOTE


ATNAC3:	PUSHJ	SP,NCHECK	; INPUT NEXT LINE
	JRST	ATNAC+2		; -END OF BUFFER IN MID LINE, CONTINUE

ATNAC1:	POPJ	SP,		; EXIT ATNAC
;	*****  OCTAL CONSTANTS  *****



OCTAL:	SETZB	A4,A5		; CLEAR A4,A5

	; CHARACTER READING LOOP

OCTALL:	ILDB	A1,P		; GET A CHAR
	AOS	CC		; STEP POSITION COUNT
	CAIL	A1,.N0		; IF IT IS BELOW 0
	CAILE	A1,.N7		; OR ABOVE 7
	JRST	OCTALD		; THEN CONSTANT IS FINISHED
	LSHC	A4,3		; MULTIPLY BY 8
	JUMPN	A4,OCTILL	; TEST FOR OVERFLOW
	IORI	A5,-.N0(A1)	; ADD IN CURRENT DIGIT
	JRST	OCTALL		; LOOP


OCTALD:	MOVE	A2,CTABLE(A1)	; GET CHARS TABLE ENTRY
	JRST	@TABLE8(A2)	; JUMP THROUGH TABLE 8


	OCTILL			; NUMBER
	OCTOUT			; LETTER
TABLE8:	OCTOUT			; DELIM
	OCTOUT			; DELIM (FLAGGED)
	OCTALL			; IGNORABLE
	OCTALL			; SPACE & TAB
	OCTNL			; NEW-LINE
	OCTOUT			; LOWER CASE
	OCTIL1			; OTHER
	OCTOUT			; SINGLE QUOTE

	; NEW-LINE CHARACTER SCANNED

OCTNL:	PUSHJ	SP,NCHECK	; INPUT NEXT LINE
	JRST	OCTALL+2	; -END OF BUFFER IN MID LINE, CONTINUE

	; END OF OCTAL CONSTANT

OCTOUT:	TLNE	A5,777777	; IF LEFT HALF NON-ZERO 
	JRST	OCTFUL		; THEN THE CONSTANT IS A FULLWORD
	SKIPA	A3,A5		; MOVE THE CONSTANT TO A3

FFALSE:	MOVEI	A3,0		; 'FALSE'

	; CONSTANT IS A HALFWORD

FALSE1:	HRLI	A3,$EXP+$B+$SIM+$DEC+$IMM; LEXEME
	JRST	LET9		; EXIT LSCAN
	; "TRUE" SCANNED

FTRUE:	HRREI	A5,-1		; "TRUE" IS A WORD OF ALL ONES

	; CONSTANT IS A FULL WORD

OCTFUL:	PUSHJ	SP,CON1Z	; PUT IN CONSTANT TABLE
	HRLI	A3,$EXP+$B+$REG+$DEC+$CT; LEXEME
	JRST	LET9		; EXIT LSCAN

	; INVALID FORMAT FOR OCTAL CONSTANT

OCTILL:	PUSHJ	SP,BADNAC	; PRINT ERROR MSG, USE ATNAC
	JRST	OCTOUT		; CONTINUE


OCTIL1:	PUSHJ	SP,BADCON	; PRINT ERROR MESSAGE
	JRST	OCTOUT		; CONTINUE

;	*****  SYMBOL CONSTANTS  *****
;
;
;
DOLLAR:	JSP	A6,STCHAR	; GET NEXT CHAR
	MOVE	A3,A1		; THIS WILL BE THE TERMINATING CHAR
	MOVEI	A5,0		
	MOVEI	A4,6		; READ 6 CHARS

SCLOOP:	JSP	A6,STCHAR	; READ ANOTHER CHAR
	CAIN	A1,(A3)		; IF IT IS THE END CHAR
	JRST	SCDONE		; THEN THE CONSTANT IS DONE
	LSH	A5,7		; SHIFT THE CONSTANT OVER 7
	IORI	A5,(A1)		; INCLUDE THE CURRENT CHAR
	SOJG	A4,SCLOOP	; LOOP
	PUSHJ	SP,BADNAC	; PRINT ERROR MSG, USE ATNAC
	JRST	C8A		; CONTINUE AS IF AN INTEGER

SCDONE:	IBP	P		; STEP TO NEXT CHAR
	AOS	CC
	JRST	C8A		; CONTINUE AS AN INTEGER
;	*****  STRINGS  *****
;
;
;
	; SET UP

STRING:	MOVEI	A6,3		; GET 3 WORDS FROM
	PUSHJ	SP,GETCTS	; THE CONSTANTS TABLE
	MOVE	A6,A3		; COPY 1ST WORD ADDRESS TO A6
	PUSH	SP,LASTST	; SAVE ADDRESS OF STRING CHAIN
	SUB	A6,LASTST	; COMPUTE DISTANCE BACK TO LAST STRING
	MOVEM	A3,LASTST	; SET NEW POINTER TO LAST STRING
	HRRZM	A6,(A3)		; USE AS THE LINK
	SETZM	1(A3)		; CLEAR THE BACK CHAIN POINTERS
	ADDI	A3,2		; STEP FORWARD 2 WORDS
	HRRZM	A3,CCOUNT	; SET POINTER TO CHAR COUNT WORD
	HRLI	A3,000700	; FORM BUFFER BYTE POINTER
	MOVEM	A3,STRPNT	; SET POINTER
	SETZB	A5,BCOUNT	; CLEAR CHARACTER AND BRACKET COUNTS
	JRST	STR6		; CONTINUE

	; CHARACTER READING LOOP

STR1:	JSP	A6,STCHAR	; READ A CHARACTER
	CAIE	A1,.DQUOT	; IF IT IS A "
	CAIN	A1,.SEMI	; IF IT IS A SEMI-COLON
	JRST	SPECIAL		; THEN IT IS ILLEGAL
	CAIN	A1,.CLEFT	; IF IT IS A ^_
	JRST	CLEFT		; THEN SCAN FOR A LINE-FEED

STR2:	IDPB	A1,STRPNT	; PUT THE CHAR IN THE CONSTANTS TABLE
	ADDI	A5,1		; STEP THE CHARACTER COUNT
	SOJG	A4,STR1		; LOOP

	; END OF 20-CHARACTER GROUP

STR6:	MOVEI	A6,4		; GET 4 MORE WORDS FROM THE 
	PUSHJ	SP,GETCTS	; CONSTANTS TABLE
	SUB	A3,[		; SET UP FOR LOOP
	XWD	4,4]		; THE 4 WORDS THAT WERE JUST ACQUIRED
	SETZM	4(A3)		; MUST BE CLEARED TO ZERO
	AOBJN	A3,.-1		; ZERO THE NEXT WORD
	MOVEI	A4,^D20		; READ THE NEXT 20 CHARACTERS
	JRST	STR1		; LOOP
	; A " OR ; WAS SCANNED

SPECIAL:
	MOVE	A3,A1		; SAVE THE CHAR
	JSP	A6,GETCHR	; GET THE NEXT CHARACTER
	CAIE	A1,(A3)		; IF IT IS NOT A "
	JRST	STEND		; THEN IT WAS THE END OF THE STRING
	JRST	STR2		; AND CONTINUE

	; A ^_ WAS ENCOUNTERED

CLEFT:	MOVEI	A1,.LEFT	; "_"
	DPB	A1,P		; PUT A _ IN LISTING
	JSP	A6,STCHAR	; GET THE NEXT CHARACTER
	CAIG	A1,.FF
	CAIGE	A1,.LF		; IF LF,FF OR VT
	JRST	STCHAR		; THEN READ THE NEXT CHAR FOR REAL
	JRST	STR1		; OTHERWISE LOOP



	; END OF STRING FOUND

STEND:	CAIN	A3,.SEMI	; IF CHAR IS A SEMICOLON THEN
	JRST	STERR		; IT IS AN ERROR
	HRRZ	A4,STRPNT	; GET THE BUFFER STRING POINTER
	ADDI	A4,1		; STEP TO NEXT AVAILABLE WORD
	MOVEM	A4,NACTE	; SAVE IT
	MOVEI	A4,0		; LOAD A ZERO
	MOVEI	A3,4		; SET COUNT
	IDPB	A4,STRPNT	; INCLUDE FOUR NULLS
	SOJG	A3,.-1
	MOVE	A3,CCOUNT	; GET THE CHARACTER COUNT WORD POINTER
	MOVEM	A5,@A3		; SAVE THE CHARACTER COUNT

	; SEARCH FOR A DUPLICATE STRING IN CONSTANTS TABLE

	SUBI	A3,2		; STEP BACK TO START OF ENTRY
EDIT(040); CALCULATE LENGTH OF NULL STRINGS CORRECTLY
	SOSL	A5		; [E040] MAKE DIVISION COME OUT RIGHT
	IDIVI	A5,5		; COMPUTE THE NUMBER OF WORDS
	MOVN	A5,A5		; NEGATIVE OF LENGTH
	HRLZI	A5,-2(A5)	; NEGATIVE LENGTH+1 TO LEFT HALF
	HRRI	A5,2		; INDEX TO BYTES WORD
	HRLI	A3,A2		; LEFT HALF = A2
	MOVE	A1,A3		; COPY A3 TO A1
	JRST	STR4		; JUMP INTO LOOP
	; COMPARE THE 2 STRING ENTRIES

STR3:	HRLI	A1,A2		; LEFT HALF = A2
	MOVE	A2,A5		; SET COUNT REGISTER
	MOVE	A4,@A3		; GET WORD OF ENTRY
	CAME	A4,@A1		; IF MISMATCH
	JRST	STR4		; THEN QUIT THIS ENTRY
	AOBJN	A2,.-3		; LOOP FOR ALL OF STRING

	; DUPLICATE FOUND, USE IT INSTEAD

	HRRZM	A3,NACTE	; RETURN THE NEW ENTRY TO AVAILABLE SPACE
	POP	SP,LASTST	; RESTORE THE OLD VALUE OF LASTST
	MOVE	A3,A1		; -MATCH FOUND, USE IT
	JRST	STR5		; CONTINUE


	; LOCATE NEXT STRING IN CONSTANTS TABLE

STR4:	SUB	A1,(A1)		; LOCATE NEXT ENTRY ON CHAIN
	MOVEI	A1,(A1)		; ZERO LEFT HALF
	CAMLE	A1,CONTAB	; IF NOT END OF CHAIN
	JRST	STR3		; THEN COMPARE THESE ENTRIES
	POP	SP,A1		; DISCARD SAVED VALUE OF LASTST

	; FORM LEXEME

STR5:	SUB	A3,CONTAB	; CONVERT TO RELATIVE ADDRESS
	HRLI	A3,$EXP+$S+$REG+$DEC+$CT; LEXEME
	JRST	LET9		; EXIT LSCAN

	; INVALID FORMAT FOR STRING CONSTANT

STERR:	PUSHJ	SP,BADNAC	; PRINT "INVALID CONSTANT" MESSAGE, USE ATNAC
	JRST	STEND+2		; COMPLETE CONSTANT AND CONTINUE



	RELOC

LASTST:	BLOCK	1		; LAST STRING IN CONSTANTS TABLE
CCOUNT:	BLOCK	1		; CHARACTER COUNT WORD POINTER
BCOUNT:	BLOCK	1		; BRACKET COUNT
STRPNT:	BLOCK	1		; BYTE POINTER INTO BUFFER

	RELOC
;	THERE ARE THREE ROUTINES THAT WILL READ THE NEXT CHARACTER FROM
;	THE SOURCE STREAM.  HOWEVER MOST OF THE TIME THE COMPILER DOES NOT
;	USE ANY OF THEM BUT INSTEAD HAS THE NECESSARY CODE IN-LINE.
;	THESE ROUTINES ARE DESCRIBED:
;
;	"GETCHR" IS THE MOST OFTEN USED.  "GETCHR" WILL PROCESS IGNORABLE
;	CHARACTERS, LOWER CASE LETTERS, TABS, AND CHARACTERS THAT SIGNIFY
;	THE END OF THE INPUT BUFFER.  "GETCHR" WILL PRESENT ALL OTHER CHARACTERS
;	UNCHANGED.
;
;	"STCHAR" IS USED TO READ CHARACTERS FOR STRINGS.  THE NEWLINE AND
;	TAB FUNCTIONS ARE PERFORMED, BUT NEWLINE CHARACTERS ARE ALSO PRESENTED
;	AS OUTPUT.  IGNORABLE CHARACTERS ARE NOT PRESENTED.  LOWER CASE
;	LETTERS ARE NOT CONVERTED TO UPPER CASE.
;
;	"GETNL" MUST BE USED TO READ CHARACTERS FROM WITHIN THE NEWLINE
;	ROUTINE.  "GETNL" WILL CHECK FOR END OF INPUT BUFFER, AND READ
;	ANOTHER BUFFER IF THIS OCCURRS.

;   ** GETCHR **

IGST:	MOVEM	A6,A6SAV	; SAVE THE LINK
	JSP	A6,GETCHR	; AND CALL GETCHR
	CAIN	A2,3		; IF IT IS A SPACE OR TAB
	JRST	GETCHR		; THEN TRY AGAIN
	JRST	@A6SAV		; ELSE EXIT

GETCHR:	ILDB	A1,P		; GET THE NEXT CHARACTER
	AOS	CC		; STEP CHARACTER COUNT
	MOVE	A2,CTABLE(A1)	; GET THE CHARS TABLE ENTRY
	XCT	TABL11(A2)	; ANALYZE CHARACTER
	JRST	(A6)		; CHAR OK, EXIT GETCHR
EDIT(073); If chars were split across a buffer, GETCHR did not convert LC
GET.NL:	PUSHJ	SP,NCHECK	; [E073] DO WE NEED TO CALL NEWLINE ?
	 JRST	GETCHR+2	; [E073] NO - JUST TEST CHAR FOR LC, ETC.
	JSP	A2,SAVE		; SAVE  SOME REGISTERS
	PUSHJ	SP,NEWLINE	; CALL NEWLINE
	JFCL			; WONT RETURN HERE
	JSP	A2,REST		; RESTORE THE REGISTERS
	JRST	GETCHR+2	; CONTINUE WITH NEW CHARACTER

GETTAB:	CAIN	A1,.TAB		; IF IT IS A TAB
	PUSHJ	SP,TAB		; THEN TAKE CARE OF IT

	JRST	(A6)		; NUMBER
	JRST	(A6)		; LETTER
TABL11:	JRST	(A6)		; DELIMITER
	JRST	(A6)		; FLAGGED DELIMITER
	JRST	GETCHR		; IGNORABLE CHARACTER
	JRST	GETTAB		; SPACE & TAB
	JRST	GET.NL		; [E073] ACTION FOR NEWLINE
	SUBI	A1,40		; LOWER CASE
	JRST	(A6)		; OTHER CHARACTERS
	JRST	(A6)		; SINGLE QUOTE
;   ** STCHAR **

STCHAR:	SKIPE	A2,STCFL	; IF THERE ARE ANY BUFFERED CHARACTERS
	JRST	STCNL1		; THEN USE THEM

	; READ THE NEXT CHARACTER

STCHR1:	ILDB	A1,P		; GET NEXT CHAR
	AOS	CC		; STEP POSITION COUNT
	MOVE	A2,CTABLE(A1)	; GET ITS TABLE ENTRY
	JRST	@TABL10(A2)	; JUMP THROUGH TABLE

	STCOK			; NUMBER
	STCOK			; LETTER
TABL10:	STCOK			; DELIMITER
	STCOK			; DELIMITER (FLAGGED)
	STCHR1			; IGNORABLE
	STCTAB			; SPACE & TAB
	STCNL			; NEW-LINE CHARACTER
	STCOK			; LOWER CASE LETTER
	STCOK			; OTHER
	STCOK			; SINGLE QUOTE


	; CHECK FOR A TAB

STCTAB:	CAIN	A1,.TAB		; IF IT IS A TAB
	PUSHJ	SP,TAB		; THEN FIND ITS LENGTH


	; NOT A SPECIAL CHARACTER

STCOK:	SETZM	STCFL		; CLEAR THE FLAG
	JRST	(A6)		; EXIT STCHAR

	; A NEW-LINE CHARACTER HAS BEEN SCANNED

STCNL:	MOVEM	A1,CHAR1	; SAVE THIS CHARACTER
	PUSHJ	SP,NCHECK	; IF THIS IS ONLY THE END OF BUFFER
	JRST	STCHR1+2	; THEN GET ANOTHER BUFFER AND CONTINUE
	AOS	STCFL		; SET THE FLAG +
	SETZM	CHAR2		; CLEAR 2ND CHAR
	SETZM	FFCNT		; ZERO FORM-FEED COUNT
	JSP	A2,SAVE		; SAVE THE REGISTERS
	PUSHJ	SP,NEWLINE	; PRINT THE LAST LINE
	JFCL			; CANT RETURN HERE
	JSP	A2,REST		; RESTORE THE REGISTERS
	EXCH	A1,CHAR1	; GET THE 1ST CHAR
	JRST	(A6)		; EXIT STCHAR
	; 1ST CALL AFTER A NL CHAR: PRESENT 2ND BUFFERED CHAR

STCNL1:	JUMPL	A2,STCNL2	; JUMP IF FLAG NEGATIVE
	SETOM	STCFL		; SET FLAG NEGATIVE
	SKIPN	A1,CHAR2	; GET THE 2ND CHAR
	JRST	STCHR1		; IF NONE, READ NEXT CHAR
	JRST	(A6)		; EXIT STCHAR


	; 2ND CALL AFTER A NL CHAR: PRESENT ANY FORM-FEEDS

STCNL2:	SOSGE	FFCNT		; DECREMENT FORM-FEED COUNT
	JRST	STCNL3		; JUMP IF NEG (NO MORE FORM FEEDS)
	MOVEI	A1,.FF		; FORM FEED
	JRST	(A6)		; EXIT STCHAR


	; A SUBSEQUENT CALL: PRESENT 3RD BUFFERED CHAR

STCNL3:	SETZM	STCFL		; ZERO FLAG
	MOVE	A1,CHAR1	; GET THE 3RD CHARACTER
	JRST	STCHR1+2	; READ NEXT CHAR



	; SAVE A4, A5, A6, AND A3 ON STACK

SAVE:	PUSH	SP,A4		; SAVE A4
	PUSH	SP,A5		; SAVE A5
	PUSH	SP,A6		; SAVE A6
	PUSH	SP,A3		; SAVE A3
	JRST	(A2)		; EXIT SAVE


	; RESTORE THEM

REST:	POP	SP,A3		; RESTORE A3
	POP	SP,A6		; RESTORE A6
	POP	SP,A5		; RESTORE A5
	POP	SP,A4		; RESTORE A4
	JRST	(A2)		; EXIT REST

	RELOC

CHAR1:	BLOCK	1		; 1ST NL CHAR
CHAR2:	BLOCK	1		; 2ND NL CHAR
FFCNT:	BLOCK	1		; FORM-FEED COUNT
FFCNT2:	BLOCK	1		; FLAG -- NUMBER OF NL CHARS
STCFL:	BLOCK	1		; FLAG -- NUMBER OF NL CHARS

	RELOC
;  *********  QUOTED DELIMITER WORDS  *********

	; SET UP

SQUOTE:	SKIPE	RWS		; IF NO QUOTED RESERVED WORDS
	JRST	SQ4		; THEN THIS IS AN ERROR, PROBABLY
	JSP	A6,IGST		; READ A CHARACTER
	MOVE	A2,CTABLE(A1)	; GET THE CHARS TABLE ENTRY
	AOJN	A2,SQILL	; ONLY A LETTER ALLOWED
	MOVE	A5,RESWRD-.A(A1); GET THE RESERVED WORD TABLE SUBLIST
	MOVEM	A5,RWSL		; SAVE IT FOR LATER
	SETZB	A2,SAVED	; ZERO A2 AND SAVED 1ST WORD OF NAME
	HRLZI	A5,-5		; READ 5 CHARS

	; CHARACTER-READING LOOP

SQ1:	LSHC	A1,-6		; SHIFT CHAR INTO A2
	ILDB	A1,P		; READ NEXT CHAR
	AOS	CC		; STEP CHAR COUNT
	SKIPL	A4,CTABLE(A1)	; GET THE CHARS TABLE ENTRY
	JRST	@TABLE0(A4)	; GOTO ROUTINE IF NOT A LETTER

SQ2:	AOBJN	A5,SQ1		; LOOP

	; NAME LONGER THAN 1 WORD

	SKIPLE	SAVED		; IF 2ND TIME HERE THEN
	JRST	SQILL		; THIS IS AN ERROR
	MOVEM	A2,SAVED	; SAVE THE 1ST 5 CHARS OF THE NAME
	SETZ	A2,		; CLEAR F
	HRLI	A5,-6		; READ 6 MORE CHARS
	JRST	SQ1		; RETURN TO THE LOOP


TABLE0:	SQILL			; DELIMITERS
	SQILL			; FLAGGED DELIMITERS
	SQ1+1			; IGNORABLE CHARS
	SQ1+1			; SPACE & TAB
	SQNL			; NEW-LINE
	SQLOW			; LOWER CASE LETTER
	SQILL			; OTHER
	SQOK			; SINGLE QUOTE

SQ4:	SKIPE	FNLEVEL		; BEGINNING OF THE WORLD ?
	JRST	ILLEGAL		; NO - ERROR
	SETZM	RWS		; YES - PRETEND WE'VE HAD /QUOTE
	JRST	SQUOTE		; AND TRY AGAIN.
; LOWER CASE LETTER SCANNED

SQLOW:	MOVEI	A1,-40(A1)	; CONVERT TO UPPER CASE
	JRST	SQ2		; RETURN TO LOOP


	; A NEW-LINE CHARACTER WAS SCANNED

SQNL:	PUSHJ	SP,NCHECK	; CHECK IF END OF BUFFER
	JRST	SQ1+2		; END OF BUFFER, CONTINUE AS IF NOTHING


SQILL:	JSP	A6,GETCHR	; READ THE NEXT CHAR
	FAIL	(92,HARD,IMM,IMPROPER WORD DELIMITER)
	JRST	C4		; RETURN THE NULL DELIMITER


	; MATCHING QUOTE FOUND, LOOK IT UP IN RESERVED WORD TABLE

SQOK:	SKIPE	A1,SAVED	; FETCH 1ST WORD, SKIP IF NONE
	EXCH	A1,A2		; A1=2ND WORD, A2=1ST WORD
	MOVE	A6,A2		; MOVE 1ST WORD TO A6
	IORI	A6,(A5)		; INCLUDE THE CHAR COUNT
	MOVEI	A3,A1-1		; LET A3 POINT TO THE 2ND WORD
	PUSHJ	SP,SQ3		; SEARCH THE RESERVED WORD TABLE
	JRST	SQOK2		; DELIMITER

	; PROBABLY "TRUE" OR "FALSE" SCANNED

	TLNN	A3,40		; UNLESS IT IS 'TRUE' OR 'FALSE'
	JRST	SQILL		; IT IS AN ERROR
	;
	; Edit(1006)  Fix compiler crash with multiple 'true' or 'false'
	;
	;AOS	LSBUFP		; [E1006] Remove this line
	AOSA	(SP)		; PREPARE FOR SKIP RETURN

	; EXTENSION FROM LSCAN

DELIM:	MOVE	A3,SCDLT(A1)	; GET THE LEXEME

SQOK2:	IBP	P		; READ THE NEXT CHAR
	AOS	CC		; STEP THE CHARACTER COUNT
	POPJ	SP,		; EXIT

	RELOC

SAVED:	BLOCK	1		; SAVED 1ST 5 CHARS OF NAME
RWS:	BLOCK	1		; RESERVED WORD TABLE POINTER

	RELOC
SUBTTL	**  SEARCH  **

;   SYMBOL TABLE ENTRY:
;
;          !-----------------!    WORD 1  BIT  0:     DYNAMIC
;          !        !        !                 BITS 1-2:   KIND
;  WORD-0  ! BL/PL  !  LINK  !                 BITS 3-8:   TYPE
;          !        !        !                 BITS 9-11:  STATUS
;          !--------!--------!                 BIT  12:    1=DECLARED
;          !        !        !                 BITS 13-17: NUMBER OF ACTUALS
;  WORD-1  ! LEXEME !  VALUE ! 
;          !        !        !
;          !-----------------!    WORD 0  BIT  0:     1=EXTENDED ENTRY
;          !                 !                 BIT  1:     1=MESSAGE GIVEN
;  WORD-2  !      NAME       !                 BIT  2:     (NOT USED)
;                                              BITS 3-11:  BLOCK LEVEL
;          !                 !                 BITS 12-17: PROCEDURE LEVEL
;          !                 !
;          !-----------------!
;          !                 !
;          ! EXTENSION WORD1 !
;          !                 !
;          !-----------------!    NOTE:  THE EXTENSION WORDS ARE OPTIONAL
;          !                 !
;          ! EXTENSION WORD2 !
;          !                 !
;          !-----------------!
;
;
;
;
;
;	*****  S E A R C H  *****
;
;	"SEARCH" IS USED TO LOOK UP AN IDENTIFIER IN THE SYMBOL 
;	TABLE. "SEARCH" USES AS INPUT THE BUFFER ADDRESS CONTAINED
;	IN NSYM AND OUTPUTS THE IDENTIFIER'S LEXEME INTO SYM.
;
;	IF THE IDENTIFIER IS NOT FOUND IN THE SYMBOL TABLE, "SEARCH"
;	WILL AUTOMATICALLY PUT IT INTO THE TABLE UNLESS THE GLOBAL
;	BOOLEAN "NOENTRY" IS SET TO 1.
;
;	IF THE GLOBAL BOOLEAN "DECLAR" IS SET TO 1 THEN "SEARCH"
;	WILL SEARCH ONLY THE CURRENT BLOCK LEVEL PORTION OF THE
;	SYMBOL TABLE.  "DECLAR" INDICATES DECLARATION MODE.
SEARCH:	MOVE	A3,NSYM		; GET NSYM
	MOVE	A2,(A3)		; GET 1ST WORD OF NAME
	MOVE	A4,A2		; COPY TO A4
	MULI	A4,RANDOM	; RANDOMIZE
	ANDI	A4,177		; USE 7 BITS FOR HASH INDEX
	SKIPN	A1,SYMHT##(A4)	; LOCATE 1ST ENTRY IN SUBLIST
	JRST	NEWSYM		; -NONE, MUST BE A NEW SYMBOL

SERCH1:	TRNN	FL,DECLAR	; ARE WE IN DECLARATION MODE?
	JRST	LOOP3+1		; -NO, GOTO 3-INST LOOP
	SKIPA	A5,STBB		; LOAD BLOCK POINTER, SKIP

	; 4-INST LOOP FOR DECLARATION MODE

LOOP4:	HRRZ	A1,SYMLNK(A1)	; LOCATE NEXT SUBLIST ENTRY
	CAILE	A5,(A1)		; WITHIN CURRENT BLOCK?
	JRST	NEWSYM		; -NO, MUST BE NEW
	CAME	A2,SYMNAM(A1)	; 1ST WORDS SAME?
	JRST	LOOP4		; -NO, LOOP
	JRST	SERCH2		; -YES, CHECK REMAINDER


	; 3-INST LOOP FOR NORMAL MODE

LOOP3:	HRRZ	A1,SYMLNK(A1)	; LOCATE NEXT SUBLIST ENTRY
	CAME	A2,SYMNAM(A1)	; 1ST WORDS MATCH?
	JRST	LOOP3		; -NO, LOOP
	TRNN	A1,777777	; LINK TO ZERO?
	JRST	NEWSYM		; -YES, MATCH NOT REALLY FOUND

	; MATCH FOUND ON 1ST WORDS

SERCH2:	SKIPN	A6,-1(A3)	; GET LENGTH OF NAME
	JRST	SERCH3		; -IS 1 WORD LONG, DONE
	ADD	A1,[		; SET UP REGISTER FOR
	XWD	A6,SYMNAM]	; INDIRECT ADDRESSING
	MOVE	A5,@A3		; GET A WORD FROM BUFFER
	CAME	A5,@A1		; COMPARE TO WORD IN ENTRY
	JRST	SERCH4		; -MISMATCH
	SOJG	A6,.-3		; -MATCH. LOOP
	MOVEI	A1,-SYMNAM(A1)	; CORRECT ADDRESS
				; -END OF NAME, SEARCH COMPLETE
	; END OF NAME, SYMBOL FOUND

SERCH3:	IFN	FTSTATS,<
	AOS	REFCNT		; INCREMENT STATS COUNTER
	>
	HLL	A1,SYMTYP(A1)	; LOAD LEXEME
	MOVE	SYM,A1		; MOVE LEXEME TO SYM
	TRNE	FL,CREF		; ARE WE CREF'ING ?
	PUSHJ	SP,CREFIT	; YES - DO IT (CLOBBER AC1-6)
	MOVE	A1,SYM		; THE RECOVERY ROUTINES IN UTL EXPECT IT!
	TLZ	SYM,37		; ZERO THE 5 BITS
	TLO	SYM,$ST		; MARK LEXEME A VARIABLE, SIMPLE
	TRNN	FL,BPAIR	; IF NOT SCANNING A BOUND PAIR, THEN
	POPJ	SP,		; EXIT SEARCH
	LDB	A4,[		; GET THE ENTRY'S BLOCK LEVEL
	POINT	9,SYMBLK(SYM),11] ; POINTER TO BLOCK LEVEL FIELD
	CAME	A4,BLOCKL	; IF NOT THE SAME AS CURRENT BLOCK LEVEL
	POPJ	SP,		; THEN OK, EXIT SEARCH
	FAIL	(84,HARD,NSYM,VARIABLE CANT BE USED HERE)
	POPJ	SP,		; EXIT SEARCH


	; SYMBOL NOT IN SYMBOL TABLE

NEWSYM:	TRNE	FL,NOENTR	; SHOULD AN ENTRY BE MADE?
	JRST	NONEW		; -NO, SKIP
	IFN	FTSTATS,<
	AOS	DEFCNT		; INCREMENT STATS COUNTER.
	MOVE	A1,(A3)		; 
	ANDI	A1,77		;  GET # CHARS -1
	ADDM	A1,IDCHRS	;  ACCUMULATE FOR AVERAGE.
	>
	MOVE	A6,-1(A3)	; GET NAME LENGTH
	PUSHJ	SP,GETSYM	; GET SOME SPACE IN SYMBOL TABLE
	PUSHJ	SP,LINKUP	; FILL THE ENTRY AND LINK IT UP
	HRLI	A1,$ST		; MARK LEXEME A VARIABLE, SIMPLE
	MOVE	SYM,A1		; MOVE LEXEME TO SYM
	TRNE	FL,CREF		; ARE WE CREF'ING ?
	PUSHJ	SP,CREFIT	; YES - DO IT (& CLOBBER AC1-6)
	SKIPA	A1,SYM		; THE RECOVERY ROUTINES IN UTL EXPECT IT!

NONEW:	MOVEI	SYM,0		; RETURN A NULL SYMBOL
	POPJ	SP, 		; EXIT SEARCH

SERCH4:	HRRZ	A1,SYMLNK-SYMNAM(A1); LOCATE NEXT ENTRY ON SUBLIST
	JRST	SERCH1		; RETURN TO LOOP



GETSYM:	MOVEI	A5,SYMNAM+1(A6)	; TOTAL LENGTH OF NEW ENTRY

	; ACQUIRE SOME SPACE IN SYMBOL TABLE

GETSPC:	HRRZ	A1,NASTE	; LOCATE NEXT AVAIL ENTRY
	ADDB	A5,NASTE	; COMPUTE NEW NEXT ENTRY
	CAMLE	A5,NAFTE	; CHECK FOR TABLE OVERFLOW
	JRST	OVFL1		; -OVERFLOW, MOVE THE TABLES, EXIT
	POPJ	SP,		; EXIT
	; COMPUTE AN ENTRY'S HASH VALUE AND NAME LENGTH IN WORDS-1

HAL:	MOVE	A4,SYMNAM(A3)	; GET 1ST WORD OF NAME
	MULI	A4,RANDOM	; RANDOMIZE
	ANDI	A4,177		; SAVE 7 BITS FOR HASH
	MOVE	A5,SYMNAM(A3)	; GET 1ST WORD OF NAME
	MOVEI	A5,1(A5)	; ADD 1
	ANDI	A5,77		; SAVE ONLY LENGTH BYTE
	IDIVI	A5,6		; DIVIDE BY 6 CHARS/WORD
	MOVEI	A6,(A5)		; COPY IN A6
	POPJ	SP,		; EXIT



	; LINK NEW ENTRY INTO SYMBOL TABLE

LINKUP:	MOVE	A5,SYMHT##(A4)	; PUT NEW ENTRY ON TOP OF
	MOVEM	A1,SYMHT##(A4)	; HASH TABLE SUBLIST
	MOVE	A2,BLKLEV	; GET BLOCK LEVEL
	LSH	A2,6		; SHIFT IT 6
	IOR	A2,FNLEVE	; INCLUDE FUNCTION LEVEL
	HRL	A5,A2		; PUT WITH NEW LINK
	MOVEM	A5,SYMLNK(A1)	; SET LINK FIELD
	SETZM	SYMTYP(A1)	; CLEAR TYPE & VALUE
	MOVEI	A5,SYMNAM(A1)	; SET UP FOR
	HRLI	A5,A6		; INDIRECT ADDRESSING

LNKUP1:	MOVE	A2,@A3		; GET WORD FROM SOURCE
	MOVEM	A2,@A5		; PUT IN SYMBOL TABLE ENTRY
	SOJGE	A6,LNKUP1	; LOOP TILL DONE
	POPJ	SP,		; DONE

	IFN	FTSTATS,<
	RELOC			; 
IDCHRS:BLOCK	1		; # CHARS IN IDENTIFIERS (FOR STATS)
DEFCNT:BLOCK	1		; # OF IDENTIFIERS DEFINED.
REFCNT: BLOCK	1		; # OF REFERENCES TO IDENTIFIERS.
	RELOC			; 
	>
SUBTTL	** STADD & XTNDLB & TOFIX **

;	*****  S T A D D  *****
;	
;	"STADD" WILL MAKE A NEW ENTRY IN THE SYMBOL TABLE FOR A NEW
;	IDENTIFIER WHOSE NAME IS THE SAME AS THE IDENTIFIER NAMED
;	IN SYM.  SINCE "STADD" IS USED ONLY FOR LABELS, "STADD"
;	WILL AUTOMATICALLY EXTEND THIS ENTRY.  THE LEXEME FOR THIS
;	NEW ENTRY REPLACES THAT WHICH IS IN SYM.  THE VALUE FIELD OF THE
;	NEW ENTRY WILL POINT TO THE OLD ENTRY.
;
;
STADD:	MOVEI	A3,(SYM)	; GET ADDR OF OLD ENTRY
	PUSHJ	SP,HAL		; GET HASH AND LENGTH OF ENTRY
	PUSHJ	SP,GETSYM	; GET SOME SPACE IN SYMBOL TABLE
	MOVEI	A3,SYMNAM(A3)	; ADDRES OF NAME FIELD
	HRLI	A3,A6		; SET UP FOR INDIRECT ADDRESSING
	PUSHJ	SP,LINKUP	; LINK UP THE NEW ENTRY
	HRRM	SYM,1(A1)	; CHAIN NEW ENTRY TO OLD ENTRY
	HRRZI	SYM,(A1)	; MOVE ADDR TO SYM

;	*****  E X T E N D  *****
;
;	THE ENTRY NAMED IN SYM IS EXTENDED BY 2 WORDS.
;
;
XTNDLB:	MOVEI	A5,2		; GET TWO MORE WORDS FROM
	PUSHJ	SP,GETSPC	; THE SYMBOL TABLE
	SETZM	(A1)		; ZERO 1ST WORD OF EXTENSION
	SETZM	1(A1)		; ZERO 2ND WORD OF EXTENSION
	HRLZI	A5,400000	; SET EXTEND BIT ON
	IORM	A5,(SYM)	; PUT IN ENTRY
	POPJ	SP,		; EXIT EXTEND
;	*****  T O F I X  *****
;
;	PUT HALFWORD INTO FIX-UP TABLE
;
;
.TOFIX:	MOVEI	A4,1		; LOAD A 1
	XORB	A4,TOFIXI	; DECIDE WHICH HALF
	SOJE	A4,TOFIX1	; IF RIGHT HALF, GET ANOTHER WORD
	MOVE	A4,NAFTE	; LOCATE WORD -1
	HRLM	A2,1(A4)	; PUT HALFWORD INTO TABLE
	POPJ	SP,		; EXIT TOFIX


TOFIX1:	SOS	A4,NAFTE	; STEP TO NEXT AVAIL WORD IN FIX-UP TABLE
	CAML	A4,NASTE	; IF SUFFICIENT SPACE IN FIXUP TABLE
	JRST	.+3		; THEN SKIP THIS PART
	PUSHJ	SP,OVFL1	; THEN MOVE THE TABLES
	ADDI	A4,DELTA	; USE CORRECT POINTER
	HRRZM	A2,1(A4)	; PUT HALFWORD INTO TABLE
	POPJ	SP,		; EXIT TOFIX

	RELOC

TOFIXI:	BLOCK	1		; "TOFIX" HALFWORD POINTER

	RELOC
SUBTTL	** RUND **

;	*****  R U N D  *****
;
;	"RUND" ADVANCES THE WINDOW BY PUTTING NSYM INTO SYM, NDEL
;	INTO DEL, AND CALLING "LSCAN" TO OBTAIN NEW LEXEMES FOR 
;	NSYM AND NDEL.  IF NSYM CONTAINED AN IDENTIFIER BUFFER
;	ADDRESS, THE LEXEME IS OBTAINED BY CALLING "SEARCH".
;	"RUND" WILL INSERT NULL-SYMBOLS BETWEEN CONSECUTIVE 
;	DELIMITERS, AND WILL INSERT NULL DELIMITERS BETWEEN CONSECUTIVE
;	SYMBOLS.  "RUND" WILL COMPUTE "LEXEX" AND "COMPNAME", AND
;	WILL CORRECTLY BUFFER THE CHARACTER COUNTERS SO THAT THEY CAN
;	BE FOUND BY THE ROUTINES THAT PRINT THE UP-ARROWS IN
;	ERROR MESSAGES.
;
;
RUND:
	; SHIFT WINDOW

	MOVE	A4,NXTSLN	; GET NSYM LINE NO
	MOVEM	A4,CURSLN	; AND SAVE AS CURRENT LINE NO
	MOVE	A4,NXTDLN	; SIMILARLY UPDATE DEL
	MOVEM	A4,CURDLN	; FROM NDEL LINE NO
	MOVE	SYM,NSYM	; MOVE NSYM TO SYM
	TLNE	SYM,$SYMB	; UNLESS THIS IS A CONSTANT
	PUSHJ	SP,SEARCH	; GET LEXEME, PUT IN SYM
	MOVE	DEL,NDEL	; THE LEFT
	JUMPE	DEL,RUND2	; -RUND PREVIOUSLY SCANNED 2 SYMS IN A ROW

	; SCAN NEXT ITEM

	PUSHJ	SP,LSCAN	; SCAN NEXT ITEM

RUND0:	JRST	RUND3		; -A DELIM WAS SCANNED (2ND IN A ROW)
	MOVE	A2,CC		; LOAD POINTER FOR ERR MSG UP-ARROW

RUND1:	MOVE	A4,LINENO	; A SYMBOL HAS BEEN SCANNED
	MOVEM	A4,NXTSLN	; SO REMEMBER WHAT LINE IT WAS ON
	MOVEI	A4,2
	XORB	A4,PLIST	; ALTERNATE BETWEEN TWO POINTER BUFFERS
	MOVEM	A2,(A4)		; SAVE READ POINTER
	MOVEM	A3,NSYM		; PUT LEXEME IN NSYM

	; SCAN ANOTHER ITEM

	PUSHJ	SP,LSCAN	; SCAN ANOTHER ITEM

RUND5:	JRST	RUND4		; -A DELIM WAS SCANNED
	; SCANNED 2 NON-DELIMITERS IN A ROW

	MOVEM	A3,DUBBLE	; -ANOTHER SYM SCANNED, SAVE FOR NEXT RUND
	MOVE	A2,CC		; LOAD POINTER FOR ERR MSG UP-ARROW
	MOVEM	A2,DOUBLP	; SAVE THE POINTER FOR LATER TOO
	MOVE	A4,PLIST	; POINTER BUFFER
	MOVE	A2,(A4)		; GET POINTER TO SYM
	TLO	A2,EXACT	; USE EXACT POINTER
	SETZM	NDEL		; PUT NULL-DELIM INTO NDEL
	JRST	RUND8+1		; CONTINUE

	; FETCH THE SAVED 2ND SYMBOL

RUND2:	MOVE	A3,DUBBLE	; RETRIEVE OLD DOUBLE SYM
	MOVE	A2,DOUBLP	; RETRIEVE ITS POINTER TOO
	JRST	RUND1		; CONTINUE ON


	; DELIMITER ONLY, NO SYMBOL


	; Edit (1003)	Make ALGDDT NEXT command work in this case.

RUND3:	MOVE	A4,LINENO	; [E1003] UPDATE NXTSLN TO BE THE
	MOVEM	A4,NXTSLN	; [E1003] CURRENT LINE NUMBER
	MOVEM	A3,NDEL		; [E1003] PUT LEXEME IN NDEL
	SETZM	NSYM		; PUT NULL SYMBOL IN NSYM
	MOVE	A4,PLIST	; POINTER BUFFER
	MOVE	A2,1(A4)	; GET POINTER TO SYM
	TLO	A2,EXACT	; USE EXACT POINTER
	MOVEI	A4,2		; HERE IT IS AGAIN
	XORB	A4,PLIST	; ALTERNATE BETWEEN TWO POINTER BUFFERS
	MOVEM	A2,(A4)		; SAVE NULL-SYMBOL POINTER
	JRST	RUND8


	; SCANNED A SYMBOL FOLLOWED BY A DELIMITER

RUND4:	MOVEM	A3,NDEL		; PUT LEXEME IN NDEL
	MOVE	A4,PLIST	; RELOAD ADDR OF CURRENT POINTER BUFFER

RUND8:	MOVE	A2,CC		; LOAD POINTER FOR ERR MSG UP-ARROW
	MOVEM	A2,1(A4)	; SAVE READ POINTER
	MOVE	A4,LINENO	; GET LINE NUMBER FOR NDEL
	MOVEM	A4,NXTDLN	; AND SAVE IT
	; COMPUTE LEXEX AND COMPNAME

RUND7:	TLNN	SYM,$SYMB	; IF CONSTANT OR NULL SYMBOL
	JRST	RUND6		; THEN SKIP THIS
	LDB	A4,[		; PICK UP THE BLOCK LEVEL
	POINT	9,SYMBLK(SYM),11] ; POINTER TO BLOCK LEVEL FIELD
	SETCM	A5,SYM		; COMPLEMENT THE LEXEME
	TLNN	A5,$FON		; IF FORMAL-BY-NAME
	JRST	IRREG		; THEN ONES COMP BL
	TLNE	A5,$PRO		; IF IT IS NOT A PROCEDURE
	JRST	REGUL		; THEN POSITIVE BL
	HRRZ	A5,SYM		; GET SYMBOL TABLE ADDRESS ALONE
	CAIGE	A5,B0END##	; IF A LIBRARY PROCEDURE
	JRST	REGUL		; THEN POSITIVE BL

	; IF FORMAL BY NAME OR NON-LIBRARY PROCEDURE, LEXEX=-BL-1

IRREG:	ADDI	A4,1		; PLUS 1
	LSH	A4,^D27		; SHIFT BL+1 TO POSITION
	MOVNM	A4,LEXEX	; NEGATE AND MOVE TO LEXEME EXTENSION
	JRST	RUND6+1


	; FOR ALL OTHERS, LEXEX=BL, COMPNAME=A RANDOM BIT ON

REGUL:	LSH	A4,^D27		; SHIFT BL INTO POSITION
	MOVEM	A4,LEXEX	; STORE IN LEXEME EXTENSION
	MOVE	A4,SYM		; GET SYMBOL TABLE ADDRESS
	ANDI	A4,37		; SAVE FIVE BITS
	MOVEI	A5,1		; PUT A 1 IN ACCUMULATOR
	LSH	A5,(A4)		; SHIFT IT RANDOMLY
	MOVEM	A5,COMPNAME	; STORE IT IN COMPNAME
	POPJ	SP,		; EXIT RUND


	; DONT COMPUTE LEXEX OR COMPNAME FOR A CONSTANT OR NULL SYMBOL

RUND6:	SETZM	LEXEX		; CLEAR LEXEME EXTENSION
	SETZM	COMPNAME	; CLEAR COMPOSIT NAME
	POPJ	SP,		; EXIT RUND
.SCRUND:
	MOVE	A4,PLIST	; ADDRESS OF SAVED POINTER
	MOVE	A4,(A4)		; TO NSYM. GET IT
	MOVEI	A5,2		; ADDRESS OF POINTER BUFFER FOR
	XOR	A5,PLIST	; SYM
	MOVEM	A4,(A5)		; SET SYM POINTER
	MOVEM	A4,1(A5)	; SET DEL POINTER
	JRST	RUND7



	RELOC

DUBBLE:	BLOCK	1		; SAVE AREA FOR CASE OF DOUBLE-SYMBOL
DOUBLP:	BLOCK	1		; SAVE AREA FOR ITS POINTER

	RELOC
SUBTTL	** ERROR MESSAGE TEXT TABLE **

TTABLE:

[ASCIZ	/SEMICOLON OMITTED/],,
[ASCIZ	/UNDECLARED IDENTIFIER/]				; 1
[ASCIZ	/INCORRECT STATEMENT/],,
[ASCIZ	/INCORRECT EXPRESSION/]					; 3
[ASCIZ	/PROBABLY OPERATOR OMITTED/],,
[ASCIZ	/IDENTIFIER OR CONSTANT MISSING/]			; 5
[ASCIZ	/INCORRECT DESIGNATIONAL EXPRESSION/],,
[ASCIZ	/INCORRECT OR UNPARENTHESIZED ASSIGNMENT/]		; 7
[ASCIZ	/SYMBOL NOT PERMITTED HERE/],,
[ASCIZ	/AMBIGUOUS USE OF COLON/]				; 9
[ASCIZ	/SEMICOLON PROBABLY SUPERFLUOUS/],,
[ASCIZ	/ONLY LETTER STRING ALLOWED/]				; 11
[ASCIZ	/THIS DELIMITER IS NOT PERMITTED BEFORE 'DO'/],,
[ASCIZ	/'WHILE' STATEMENT IS NOT ALLOWED BETWEEN 'THEN' AND 'ELSE'/]
								; 13
[ASCIZ	/'THEN' MUST NOT BE FOLLOWED BY 'IF'/],,
[ASCIZ	/'THEN' STATEMENT NOT FOUND/]				; 15
[ASCIZ	/DECLARATIONS MUST BE TERMINATED BY SEMICOLON/],,
[ASCIZ	/THIS IS NOT ALLOWED AFTER END/]			; 17
[ASCIZ	/CANNOT BE USED AS ARGUMENT/],,
[ASCIZ	/ARGUMENT TOO LARGE/]					; 19
[ASCIZ	/PROBABLY 'END' OMITTED/],,
[ASCIZ	/COMPLEX ARITHMETIC NOT IMPLEMENTED/]			; 21
[ASCIZ	/DECLARATOR 'LONG' MUST BE FOLLOWED BY 'REAL'/],,
[ASCIZ	/NOT PERMITTED AS DECLARATOR/]				; 23
[ASCIZ	/NOT PERMITTED AS SPECIFIER/],,
[ASCIZ	/INCORRECT DECLARATION OR SPECIFICATION/]		; 25
[ASCIZ	/NO DECLARATION SHOULD FOLLOW PROCEDURE OR SWITCH DECLARATION/],,
[ASCIZ	/IMPROPER ARRAY DELARATION OR SPECIFICATION/]		; 27
[ASCIZ	/DELIMITER MUST NOT BE DECLARED OR SPECIFIED/],,
[ASCIZ	/PROBABLY LIST ELEMENT MISSING/]			; 29
[ASCIZ	/IMPROPER DECLARATION/],,
[ASCIZ	/VALUE WAS ALREADY SPECIFIED/]				; 31
[ASCIZ	/IMPROPER TYPE OF FORMAL IN VALUELIST/],,
[ASCIZ	/NON-FORMALS MUST NOT BE SPECIFIED/]			; 33
[ASCIZ	/BOUND PAIR NOT FOUND/],,
[ASCIZ	/INCORRECT BOUND PAIR/]					; 35
[ASCIZ	/PROBABLY RIGHT BRACKET OMITTED/],,
[ASCIZ	/TYPE DOES NOT MATCH FORWARD DECLARATION/]		; 37
[ASCIZ	/:= MISSING IN SWITCH DECLARATION/],,
[ASCIZ	/PROCEDURE NESTING TOO DEEP/]				; 39
[ASCIZ	/NOT A SIMPLE IDENTIFIER IN FORMAL LIST/],,
[ASCIZ	/FORMAL LIST NOT PROPERLY TERMINATED/]			; 41
[ASCIZ	/PROBABLY SEMICOLON MISSING IN PROCEDURE HEADING/],,
[ASCIZ	/NOT ALL FORMALS HAVE BEEN SPECIFIED/]			; 43
[ASCIZ	/INCORRECTLY STRUCTURED FORMAL LIST/],,
[ASCIZ	/'UNTIL' EXPRESSION NOT FOUND/]				; 45
[ASCIZ	/BYTE NOT PERMITTED AS CONTROL VARIABLE/],,
[ASCIZ	/ASSIGNMENT DELIMITER NOT FOUND/]			; 47
[ASCIZ	/DELIMITER 'DO' NOT FOUND/],,
[ASCIZ	/ASSIGNMENT HAS NON-MATCHING TYPES/]			; 49
[ASCIZ	/DELIMITER OMITTED/],,
[ASCIZ	/CANNOT BE USED AS UNARY OPERATOR/]			; 51
[ASCIZ	/CANNOT BE USED AS BINARY OPERATOR/],,
[ASCIZ	/'THEN' EXPRESSION NOT FOUND/]				; 53
[ASCIZ	/CONDITIONAL EXPRESSION MUST HAVE 'ELSE' PART/],,
[ASCIZ	/CONDITIONAL EXPRESSION MUST BE PARENTHESIZED/]		; 55
[ASCIZ	/IMPROPER SEQUENCE OF DELIMITERS/],,
[ASCIZ	/WRONG NUMBER OF DIMENSIONS/]				; 57
[ASCIZ	/TOO MANY PARAMETERS FOR STANDARD FUNCTION/],,
[ASCIZ	/NON-TYPE PROCEDURE IN EXPRESSION/]			; 59
[ASCIZ	/MATCHING CLOSE PARENTHESIS NOT FOUND/],,
[ASCIZ	/INCORRECT NUMBER OF ACTUAL PARAMETERS/]		; 61
[ASCIZ	/FORWARD HAS NO MATCHING DECLARATION IN SAME BLOCK/],,
[ASCIZ	//]							; 63
[ASCIZ	/FORWARD DECLARATION WAS REQUIRED/],,
[ASCIZ	/TYPES DO NOT MATCH/]					; 65
[ASCIZ	/STACK ADDRESS OVERFLOW/],,
[ASCIZ	/NON-INTEGER OPERAND FOR OPERATOR 'DIV' OR 'REM'/]	; 67
[ASCIZ	/COMPLEX ARITHMETIC NOT IMPLEMENTED/],,
[ASCIZ	/NON-ARITHMETIC OPERAND FOR ARITHMETIC OPERATOR/]	; 69
[ASCIZ	/NON-ARITHMETIC OPERAND FOR RELATIONAL OPERATOR/],,
[ASCIZ	/NON-BOOLEAN OPERAND FOR BOOLEAN OPERATOR/]		; 71
[ASCIZ	/DELIMITER 'NOT' REQUIRES BOOLEAN OPERAND/],,
[ASCIZ	/UNARY + AND - REQUIRE ARITHMETIC OPERAND/]		; 73
[ASCIZ	/OVERFLOW WHILE COMBINING CONSTANTS/],,
[ASCIZ	/OVERFLOW IN LONG REAL OPERATION ON CONSTANTS/]		; 75
[ASCIZ	/OVERFLOW OR UNDEFINED RESULT FOR "CONSTANT ^ CONSTANT"/],,
[ASCIZ	/PARAMETER FOR STANDARD FUNCTION MUST BE ARITHMETIC/]	; 77
[ASCIZ	/STANDARD FUNCTION "INT" REQUIRES BOOLEAN PARAMETER/],,
[ASCIZ	/STANDARD FUNCTION "BOOL" REQUIRES INTEGER OPERAND/]	; 79
[ASCIZ	/PARAMETER MUST BE OF ARITHMETIC TYPE/],,
[ASCIZ	/FOR STATEMENT NOT ALLOWED BETWEEN 'THEN' AND 'ELSE'/]	; 81
[ASCIZ	/SWITCH IDENTIFIER NOT ALLOWED HERE/],,
[ASCIZ	/EXPRESSION TOO LONG/]					; 83
[ASCIZ	/IDENTIFIER DECLARED IN THIS BLOCK NOT PERMITTED HERE/],,
[ASCIZ	/INCORRECT FILE OR BLOCK STRUCTURE/]			; 85
[ASCIZ	/INCORRECT BLOCK STRUCTURE: TOO MANY ENDS/],,
[ASCIZ	/PROCEDURE INCORRECTLY TERMINATED/]			; 87
[ASCIZ	/INCORRECT FILE STRUCTURE/],,
[ASCIZ	/EMPTY SOURCE FILE/]					; 89
[ASCIZ	/INVALID CONSTANT/],,
[ASCIZ	/IDENTIFIER EXCEEDS 64 CHARACTERS/]			; 91
[ASCIZ	/IMPROPER WORD DELIMITER/],,
[ASCIZ	/CHARACTER NOT LEGAL IN ALGOL/]				; 93
[ASCIZ	/EXPONENT TOO SMALL/],,
[ASCIZ	/EXPONENT TOO LARGE/]					; 95
[ASCIZ	/DECLARATION FOLLOWS STATEMENT/],,
[ASCIZ	/IMPROPER USE OF "."/]					; 97
[ASCIZ	/INTEGER CONSTANT TOO BIG: CONVERTED TO TYPE REAL/],,
[0]								; 99
[ASCIZ	/N EXPRESSION/],,
[ASCIZ	/ STATEMENT/]						; 101
[ASCIZ	/ BOOLEAN EXPRESSION/],,
[ASCIZ	/ DESIGNATIONAL EXPRESSION/]				; 103
[ASCIZ	/ LABEL IDENTIFIER/],,
[ASCIZ	/ LABEL IDENTIFIER/]					; 105
[ASCIZ	/N UNDECLARED (UNSPECIFIED) IDENTIFIER/],,
[ASCIZ	/N ARITHMETIC EXPRESSION/]				; 107
[ASCIZ	/ NEW IDENTIFIER/],,
[ASCIZ	/N ARITHMETIC EXPRESSION/]				; 109
[ASCIZ	/N ARITHMETIC EXPRESSION/],,
[ASCIZ	/N ARITHMETIC EXPRESSION/]				; 111
[ASCIZ	/N ARITHMETIC VARIABLE/],,
[ASCIZ	/ VARIABLE/]						; 113
[ASCIZ	/ STRING EXPRESSION/],,
[ASCIZ	/ BOOLEAN OR ARITHMETIC EXPRESSION/]			; 115
[ASCIZ	/ BOOLEAN OR ARITHMETIC EXPRESSION/],,
[ASCIZ	/N ARRAY IDENTIFIER/]					; 117
[ASCIZ	/N ARITHMETIC EXPRESSION/],,
[ASCIZ	/ SWITCH IDENTIFIER/]					; 119
[ASCIZ	/N ACTUAL PARAMETER/],,
[ASCIZ	/ PROCEDURE IDENTIFIER/]				; 121
[ASCIZ	/N ARITHMETIC EXPRESSION/],,
[ASCIZ	/N ARITHMETIC EXPRESSION/]				; 123
[ASCIZ	/ STRING VARIABLE/],,
[ASCIZ	/ BOOLEAN OR ARITHMETIC EXPRESSION/]			; 125
[ASCIZ	/NO VALUE ASSIGNED TO TYPED PROCEDURE/],,
[ASCIZ/	ASSIGNMENT TO PROCEDURE OUTSIDE ITS BODY/]		; 127
[ASCIZ/INTEGER TOO LARGE - 34 359 738 367 SUPPLIED/],,
[ASCIZ/ILLEGAL USE OF RESERVED WORD/]				; 129
;	"BMOVE" WITH "RLIST" AS ITS PARAMETER IS USED TO INITIALIZE
;	THE READ MODULE'S LOW-SEGMENT FROM THE HIGH-SEGMENT.

RLIST:
	XWD	FAILX,12
	PUSH	SP,A1
	PUSH	SP,A2
	MOVE	A1,@-2(SP)
	MOVEM	A1,FAILX1
	PUSHJ	SP,.FAIL
	0
	POP	SP,A2
	POP	SP,A1

;	GENERAL SKIP RETURN

SKRET:	AOS	(SP)
	POPJ	SP,

	XWD	.STOVE+1,1
	JRST	OVFL5

	XWD	.JBAPR,1
	JRST	OVFL4

	XWD	OLIST,3
	14
	0
	XWD	BHEAD1,0

	XWD	LLIST,3
	0
	0
	XWD	BHEAD2,0

	XWD	SLIST,3
	0
	0
	XWD	0,BHEAD3

	XWD	CSLIST,3
	1
	SIXBIT	/TTY/
	XWD	STHEAD,CSHEAD

	XWD	SWERR,4
	ASCIZ/ switch:       /

	XWD	CREFRF,2
	BYTE(7)1,0,0,0,0
	0

	XWD	TRACLN,2
	DEC	100
	EXP	DELTA1

	0			; TERMINATE LIST

SUBTTL OUTPUT MODULE

;   THIS MODULE CONTAINS THE FOLLOWING ROUTINES
;
;
;	.MABS	(MOVE ABSOLUTE)		WRITE OUT 1 WORD
;					A1=VALUE
;					NO RELOCATION
;
;	.MREL	(MOVE RELOCATED)	WRITE OUT 1 WORD
;					A1=VALUE
;					RELOCATE RIGHT HALF
;
;	.RAFIX	(REL ADDRESS FIXUP)	WRITE OUT 1 TYPE-10 FIXUP
;					A1=CHAIN
;					PROGRAM COUNTER=VALUE
;					RELOCATE BOTH HALVES
;
;	.ADRFIX (ADDRESS FIXUP)		WRITE OUT 1 TYPE-10 FIXUP
;					A1=CHAIN
;					A2=VALUE
;					RELOCATE BOTH HALVES
;
;	.ABSFIX	(ABSOLUTE FIXUP)	WRITE OUT 1 TYPE-10 FIXUP
;					A1=CHAIN
;					A2=VALUE
;					RELOCATE LEFT HALF (CHAIN)
;
;	.FIX50	(RADIX50 FIXUP)		WRITE OUT 1 TYPE-2 FIXUP
;					A1=LOCATION
;					A2=RADIX50 NAME
;					RELOCATE LOCATION
;
;	.EXTFIX (EXTERNAL FIXUP)	WRITE OUT ALL TYPE-2 FIXUPS FOR 1 EXTERNAL
;					PROCEDURE
;					A5=ADDRESS OF SYMBOL TABLE ENTRY
;
;	.ADDFIX	(ADDITIVE FIXUP)	WRITE OUT 1 TYPE-2 ADDITIVE FIXUP
;					A1=LOCATION (RELOCATE)
;					RADIX50 NAME IS ALWAYS %ALGDR
;
;	.TYPE0 (BLOCK TYPE-0 ENTRY)	WRITE OUT 1 TYPE-0 IDENTIFIER ENTRY
;	WRITE1		OPEN REL-FILE
;
;	WRITE0		CALLED IN PLACE OF WRITE1 WHEN THERE IS NO REL-FILE
;
;	.PROGD		PREPARE TO COMPILE A MAIN PROGRAM
;
;	.PROCD		PREPARE TO COMPILE AN EXTERNAL PROCEDURE
;
;	BMOVE		MOVE BLOCKS OF DATA ACCORDING TO A LIST
;			A1=LIST
;
;	.ZZEND		MOVE CONSTANTS TABLE TO REL-FILE,
;			MOVE FIXUP TABLE TO REL-FILE,
;			MOVE LIBRARY FIXUPS TO REL-FILE,
;			PUT AN END BLOCK IN REL-FILE,
;			CLOSE REL-FILE.
;
;	DUMP		REL-FILE DUMP PROGRAM
;
;	NAME		EXTRACT FROM SYMBOL TABLE ENTRY THE IDENTIFIER NAME
;			IN ASCIZ FORMAT
	INTERN	.PROGD
	INTERN	.PROCD
	INTERN	.RAFIX		; RELOCATABLE FIX-UP ROUTINE
	INTERN	.ADRFIX		; ADDRESS FIX-UP ROUTINE
	INTERN	.ABSFIX		; ABSOLUTE FIX-UP ROUTINE
	INTERN	.ADDFIX		; ADDITIVE FIX-UP ROUTINE
	INTERN	.EXTFIX		; EXTERNAL NAME FIX-UP ROUTINE
	INTERN	.FIX50		; EXTERNAL NAME FIX-UP ROUTINE (RADIX50 INPUT)
	INTERN	.MREL		; MOVE RELOCATABLE
	INTERN	.MABS		; MOVE ABSOLUTE
	INTERN	.ZZEND		; WRITE MODULE PROGRAM END ROUTINE
	EXTEN==400000		; EXTENDED ENTRY FLAG BIT
	EXISTS==400000		; 1 = LISTING FILE EXISTS
	COMPLETE==002000	; 1 = LISTING FILE COMPLETE AND CLOSED


	IND==0
	ADR==1
	PTR==2
	BLK==3
	EN==4
	TYP==5
	LEN==6				;
;	INITIALIZE WRITE MODULE, CREATE REL-FILE, PREPARE TO RECEIVE OUTPUT.

WRITE1:	OPEN	1,OLIST		; OPEN THE OBJECT FILE
	JRST	DSERR5		; CANNOT OPEN DEVICE
	OUTBUF	1,@OLIST+7	; GET A BUFFER RING
	ENTER	1,OFILE		; ENTER THE NEW FILE
	JRST	DSERR6		; -CANNOT CREATE NEW FILE
	PUSHJ	SP,WRITE	; INITIALIZE BUFFERS
	OUT	1,0		; GET 1ST OUTPUT BUFFER
	JRST	.+2		; -OK
	JRST	DSERR7		; ERROR
	MOVEI	A1,1		; A 1 MEANS TO OUTPUT OBJECT CODE
	MOVEM	A1,WFLAG	; SET WRITE MODULE FLAG
	JRST	SKRET		; EXIT WRITE1


;	INITIALIZE WRITE MODULE, DON'T CREATE REL-FILE, PREPARE TO
;	RECEIVE OUTPUT.

WRITE0:	MOVEI	A1,203		; ALLOCATE A DUMMY BUFFER WHOSE LENGTH
	PUSHJ	SP,ALLOCATE	; IS 203
	ADDI	A1,1		; STEP TO LINK WORD
	HRRZM	A1,BHEAD1	; SET BUFFER HEADER
	HRLI	A1,202		; BUFFER LENGTH
	MOVEM	A1,(A1)		; PUT BUFFER RING LINK IN BUFFER
	PUSHJ	SP,WRITE	; INITIALIZE BUFFERS
	SETZM	WFLAG		; MARK: NO REL FILE
	POPJ	SP,		; EXIT WRITE0
;	"WRITE" IS CALLED BY "WRITE0" AND "WRITE1".  "WRITE" ALLOCATES
;	SPACE FOR THE ISOLATED BUFFERS,  AND SETS UP ALL OF THE STATUS BLOCKS.

	; SET STATUS BLOCKS FROM HIGH SEGMENT

WRITE:	HRLZI	A1,A3		; ADDRESS OF A3
	MOVEM	A1,T0ADR	; INIT T0ADR
	MOVEM	A1,T1ADR	; INIT T1ADR
	MOVEM	A1,T2ADR	; INIT T2ADR
	MOVEM	A1,T10ADR	; INIT T10ADR
	HRLZI	A1,440200	; LEFT HALF OF BYTE POINTERS
	MOVEM	A1,T1PTR	; INIT T1PTR
	MOVEM	A1,T10PTR	; INIT T10PTR
	HRLZI	A1,440400	; LEFT HALF OF TYPE-2 BYTE POINTER
	MOVEM	A1,T2PTR	; INIT T2PTR
	MOVEI	A1,2		; 2
	MOVEM	A1,T2TYP	; INIT T2TYP
	MOVEI	A1,1		; 1
	MOVEM	A1,T1TYP	; INIT T1TYP
	MOVEI	A1,NEWT0	;
	MOVEM	A1,T0TYP	;
	MOVE	A2,BHEAD1	; GET BUFFER ADDRESS
	HLRZ	A2,(A2)		; GET LENGTH OF BUFFER
	SUBI	A2,1		; TRUE USABLE LENGTH
	MOVEM	A2,BUFLEN	; SAVE THE OUTPUT BUFFER LENGTH
	; ACQUIRE SPACE FOR TYPE-2 BUFFER, INITIALIZE ITS STATUS BLOCK

	MOVEI	A1,600		; BUFFERS MIGHT USE UP TO #600 WORDS
	PUSHJ	SP,ALLOCATE	; GET SPACE FOR BUFFERS
	EXCH	A1,A2		; SWAP REGS, IE A1=BASE ADDR, A2=LENGTH
	MOVEI	A3,(A2)		; BUFFER FOR TYPE-2 BLOCKS
	ADDI	A2,-1(A1)	; STEP POINTER
	MOVEM	A2,T2END	; MARK END OF TYPE-2 BUFFER
	MOVEI	A4,TYPE2	; PARAM FOR INITB
	MOVEI	A5,^D19		; LENGTH OF MOST SUB-BLOCKS
	MOVEM	A5,T2LEN	;
	PUSHJ	SP,INITB	; INITIALIZE TYPE-2 STATUS BLOCK

	; ACQUIRE SPACE FOR TYPE-10 BUFFER, INITIALIZE ITS STATUS BLOCK

	MOVEI	A3,1(A2)	; BUFFER FOR TYPE-10 BLOCKS
	ADD	A2,A1		; STEP POINTER
	MOVEM	A2,T10END	; MARK END OF TYPE-10 BUFFER
	MOVEI	A4,TYPE10	; PARAM FOR INITB
	MOVEM	A5,T10LEN	;
	PUSHJ	SP,INITB	; INITIALIZE TYPE-10 STATUS BLOCK

	; ACQUIRE SPACE FOR TYPE-0 BUFFER, INITIALIZE ITS STATUS BLOCK

	MOVEI	A3,1(A2)	; BUFFER FOR TYPE-0 BLOCKS
	ADD	A2,A1		; STEP POINTER
	MOVEM	A2,T0END	; MARK END OF TYPE-0 BUFFER
	MOVEI	A4,TYPE0	; PARAM FOR INITB
	MOVEI	A6,^D127	; LONG 'SUB'-BLOCK FOR PSEUDO-TYPE0
	MOVEM	A6,T0LEN	;
	PUSHJ	SP,INITB	; INITIALIZE TYPE-0 STATUS BLOCK
	ADDI	A2,1		; NEW BEGINNING OF FREE SPACE
	HRRM	A2,.JBFF	; SET JOBFF

	; INITIALIZE TYPE-1 STATUS BLOCK

	HRRZ	A3,BHEAD1	; GET ADDRESS OF PRIME BUFFER
	ADDI	A3,1		; STEP TO NEXT WORD
	HRRM	A3,T1ADR	; SET T1ADR
	ADD	A3,A1		; STEP TO END OF BUFFER
	MOVEM	A3,T1END	; SET END OF BUFFER
	MOVEM	A5,T1LEN	;
	POPJ	SP,		; EXIT WRITE



	; CANT OPEN OBJECT FILE DEVICE

DSERR5:	MOVE	A1,[		; LOAD A POINTER TO
	POINT	6,OLIST+1]	; THE FILE NAME
	JRST	DSERR0		; PRINT THE MESSAGE, TERMINATE
;	CANNOT CREATE REL-FILE

DSERR6:	TTCALL	3,UNOBJ		; PRINT MSG
	JRST	TERMIN		; TERMINATE COMPILATION


UNOBJ:	ASCIZ	/?CANNOT CREATE OBJECT FILE
/

	; ERROR ON "OUT" UUO

DSERR7:	TTCALL	3,UNEXP		; PRINT ERROR MSG
	JRST	TERMIN		; TERMINATE


UNEXP:	ASCIZ	/OUTPUT ERROR
/
;	"BMOVE" WILL MOVE BLOCKS OF DATA AROUND IN CORE ACCORDING TO A
;	CONTROL LIST WHOSE ADDRESS IS IN A1.  THE FIRST WORD OF THE CONTROL
;	LIST IS A CONTROL WORD WHOSE LEFT HALF CONTAINS THE LOCATION
;	WHERE THE DATA WILL GO,  AND WHOSE RIGHT HALF CONTAINS THE LENGTH OF
;	THE BLOCK OF DATA IN WORDS.  THE CONTROL WORD IS FOLLOWED IMMEDIATELY
;	BY THE BLOCK OF DATA THAT IS TO BE MOVED.  THE BLOCK OF DATA IS
;	FOLLOWED IMMEDIATELY BY ANOTHER CONTROL WORD AND ANOTHER BLOCK TO
;	BE MOVED, ETC.  THE CONTROL LIST IS TERMINATED BY AN ALL ZERO
;	CONTROL WORD.


BMOVE:	SKIPN	A2,(A1)		; IF NO MORE BLOCKS THEN
	POPJ	SP,		; EXIT BMOVE
	MOVS	A3,A2		; "TO" ADDRESS TO A3
	HRLI	A3,1(A1)	; "FROM" ADDRESS
	MOVS	A4,A2		; "TO" ADDRESS PLUS
	ADD	A4,(A1)		; LENGTH OF BLOCK
	ADDI	A1,1(A2)	; "END" ADDRESS PLUS 1
	BLT	A3,-1(A4)	; MOVE THE DATA
	JRST	BMOVE		; PROCESS ANOTHER BLOCK
;
;	These are the patterns for the LINK blocks
;	output at the beginning of the program. They are
;	BLT'd to the low segment before data is written
;	in them.
;
	XWD	LB,WRITE4-WRITE3+1
WRITE3:	XWD	0,WRITE4-WRITE3-1

	XWD	4,0		; TYPE-4 BLOCK OF LENGTH 0
	XWD	0,0		; RELOCATION BITS

	XWD	6,2		; TYPE-6 BLOCK OF LENGTH 2
	XWD	0,0		; RELOCATION BITS
PRNAME:	RADIX50	0,ALGOBJ	; PROGRAM NAME
	XWD	3,1		; ALGOL, 1 FLAGS MAIN PROGRAM


EDIT(140); Use compiler Version number as program version number
	XWD	1,2		; [E140] Type-1 block of length 2
	XWD	0,0		; [E140] No relocation bits
PRGVER:	EXP	.JBVER		; [E140] Version word (in JOBDAT)
	EXP	0		; [E140] Fill value in later

	XWD	2,20		; TYPE-2 BLOCK OF LENGTH 16
	XWD	040000,0	; RELOCATION BITS
	RADIX50	04,%BEGIN	; PROGRAM ENTRY POINT
	XWD	0,0		; VALUE
	RADIX50	60,%ALGDA	; %ALGDA
	XWD	0,0		; NO VALUE
DIR:	RADIX50	60,%ALGDR	; %ALGDR
	XWD	0,0		; NO USAGE
HEAP:	RADIX50	04,%HEAP	; %HEAP DEFINITION
	XWD	0,0		; VALUE
FLAGS:	RADIX50	04,%FLAGS
	XWD	0,0		; RUN-TIME FLAGS
TRACE:	RADIX50	04,%TRACE		;
	XWD	0,0
VERLHS:	RADIX50	04,%JBVER
	EXP	0			; LEFT HALF OF VERSION #
VERRHS:	RADIX50	04,%JBEDT
	EXP	0			;

WRITE4:	0
	0

	MODHDR==SIXBIT/MOD/
WRITE7:	XWD	LB+WRITE4-WRITE3,14
MODBL:	XWD	NEWT0,12	;
	EXP	MODHDR+12	; ACTUAL BLOCK HEADER
	BLOCK	11
	0
	0
;	".PROGD" MOVES THE TYPE-4,-6, -2 AND TYPE0 BLOCKS
;	THAT START EACH AGOL MAIN PROGRAM
;	TO THE PRIME BUFFER.


.PROGD:	MOVEI	A1,WRITE3-1	; PARAM FOR INIT
	PUSHJ	SP,BMOVE	; MOVE CODE TO BUFFER
	TRNE	FL,TRPOFF	; UNLESS PRODUCTION
	JRST	PD1
	MOVEI	A1,WRITE7	; TYPE-0 MODULE HEADER
	PUSHJ	SP,BMOVE	; TO LOW SEGMENT
	MOVEI	A1,13		; EXTRA LENGTH
	ADDM	A1,LB
PD1:	HRLZI	A1,<<2B23>+3>	; KI-10 ALGOL INDICATOR
	SKIPN	TARGMC		; OR, AS APPPROPRIATE,
	HRLZI	A1,<<1B23>+3>	; KA-10 ALGOL
	HLLM	A1,<LB+PRNAME+1-WRITE3>
	HRRZ	A1,T1ADR	; BEGINNING OF AVAILABLE SPACE IN BUFFER
	ADDI	A1,1		; TRUE BEGINNING
	MOVEI	A5,(A1)		; SAVE FOR LATER IN A5
	HRLM	A1,LB		; SET DESTINATION  PART OF CONTROL WORD
	ADDI	A1,WRITE4-WRITE3-2
				; END OF WHERE THIS BLOCK WILL BE
	TRNN	FL,TRPOFF	; ADJUST IF NOT PRODUCTION [54]
	ADDI	A1,13		; TO INCLUDE MODULE HEADER [54]
	CAMG	A1,T1END	; IF ENOUGH SPACE IN BUFFER
	JRST	.+3		; THEN USE THIS BUFFER
	PUSHJ	SP,GETBUF	; ELSE GET ANOTHER OUTPUT BUFFER
	JRST	PD1		; AND TRY AGAIN
	HRRM	A1,T1ADR	; SET NEW T1ADR
	MOVEI	A1,LB		; ADDRESS OF NEW BMOVE LIST
	PUSHJ	SP,BMOVE	; MOVE INTO FINAL POSITION
	MOVE	A2,TRACLN	; LENGTH OF TRACE-BUFFER (/T SW)
	MOVEM	A2,TRACE-WRITE3(A5)	;
	MOVE	A2,DYNOWN	; LENGTH OF HEAP (/HEAP SWITCH)
	CAIGE	A2,DELTA1	; ENSURE IT'S AT LEAST...
	MOVEI	A2,DELTA1	; ...THE MINIMUM
	MOVEM	A2,HEAP-WRITE3(A5)
	SETZ	A2,			;
	SKIPE	SRCEMC
	TRO	A2,SMC1		; COMPILED ON KI/KL
	SKIPE	TARGMC
	TRO	A2,TMC1		; COMPILED FOR KI/KL
	SKIPLE	SRCEMC
	TRO	A2,SMC2		; COMPILED ON KL
	SKIPLE	TARGMC
	TRO	A2,TMC2		; COMPILED FOR KL
	MOVEM	A2,FLAGS-WRITE3(A5)
	SKIPN	A1,OFILE	; GET OBJECT FILE NAME
	SKIPA	A2,PRNAME	; NONE - USE DEFAULT
	PUSHJ	SP,RADX50	; CONVERT TO RADIX50
	MOVEM	A2,PRNAME-WRITE3-1(A5)	; PUT IN BUFFER
	MOVE	A1,.JBVER	; LINK-PLANTED VERSION NUMBER
	MOVEM	A1,PRGVER-WRITE3(A5) ; Save as program version number
	HLRZM	A1,VERLHS-WRITE3(A5)
	HRRZM	A1,VERRHS-WRITE3(A5)
	TRNE	FL,TRPOFF	; ONLY IF REQUIRED
	JRST	WRITE2
	TLZ	A2,740000	; CLEAR CODE BITS
	IDIVI	A2,50		; RIGHT-
	JUMPE	A3,.-1		;  JUSTIFY
	IMULI	A2,50		;    RADIX-50
	ADDI	A2,(A3)		;      NAME.
	MOVEM	A2,MODBL-1-WRITE3(A5) ; PUT MODULE TITLE IN BLOCK
	MOVE	A2,SLIST+1	; SOURCE DEVICE
	MOVEM	A2,MODBL+2-WRITE3(A5)	;
	MOVE	A2,LINENO	; CURRENT LINE NUMBER
	MOVEM	A2,MODBL-2-WRITE3(A5)	;
	HRLI	A5,SFILE	; FILE INFO
	MOVEI	A1,MODBL-WRITE3+6(A5)	; END OF FILE INFO
	ADDI	A5,MODBL+3-WRITE3
	BLT	A5,(A1)		; ALL TO TYPE0-BLOCK
	JRST	WRITE2		; CONTINUE
;------------------------------------------------
	XWD	LB,WRITE6-WRITE5+1
WRITE5:	XWD	0,WRITE6-WRITE5-1

	XWD	4,1		; TYPE-4 BLOCK OF LENGTH 1
	XWD	0,0		; RELOCATION BITS
PNAME1:	XWD	0,0		; PROCEDURE NAME

	XWD	6,2		; TYPE-6 BLOCK OF LENGTH 2
	XWD	0,0		; RELOCATION BITS
PNAME2:	XWD	0,0		; PROCEDURE NAME
	XWD	3,0		; ALGOL

	XWD	2,2		; TYPE-2 BLOCK OF LENGTH 2
	XWD	040000,0	; RELOCATION BITS
PNAME3:	XWD	0,0		; PROCEDURE ENTRY POINT NAME
PVALUE:	XWD	0,0		; VALUE

WRITE6:	0
	0

WRITE8:	XWD	LB+WRITE6-WRITE5,14
EMODBL:	XWD	NEWT0,12	; SUBSEQUENT MODULES
	EXP	MODHDR+12	;
	BLOCK	11		;
	0
	0
;	".PROCD" MOVES TO THE PRIME BUFFER THE TYPE-4,-6, AND -2 BLOCKS
;	THAT START EACH ALGOL EXTERNAL PROCEDURE.

.PROCD:	MOVEI	A1,WRITE5-1	; PARAM FOR INIT
	PUSHJ	SP,BMOVE	; MOVE CODE TO BUFFER
	TRNE	FL,TRPOFF	; UNLESS PRODUCTION
	JRST	PD2
	MOVEI	A1,WRITE8	; LENGTH/DESTN FOR BMOVE
	PUSHJ	SP,BMOVE
	MOVEI	A1,13		; EXTRA LENGTH
	ADDM	A1,LB
PD2:	HRLZI	A1,<<2B23>+3>	; KI-10 ALGOL INDICATOR
	SKIPN	TARGMC		; OR, AS APPROPRIATE
	HRLZI	A1,<<1B23>+3>	; KA-10 ALGOL
	MOVEM	A1,<LB+PNAME2+1-WRITE5>
	HRRZ	A1,T1ADR	; BEGINNING OF AVAILABLE SPACE IN BUFFER
	ADDI	A1,1		; TRUE BEGINNING
	PUSH	SP,A1		; SAVE ON STACK FOR LATER
	HRLM	A1,LB		; SET DESTINATION PART OF CONTROL WORD
	ADDI	A1,WRITE6-WRITE5-2	; END OF WHERE THIS BLOCK WILL BE
	TRNN	FL,TRPOFF	; IF NOT PRODUCTION...
	ADDI	A1,13		; ...INCLUDE EXTRA PIECE.
	CAMG	A1,T1END	; IF THERE IS ENOUGH SPACE IN BUFFER
	JRST	.+4		; THEN USE THIS BUFFER
	POP	SP,A1		; ELSE LOSE STACKED A1
	PUSHJ	SP,GETBUF	; AND GET ANOTHER OUTPUT BUFFER
	JRST	PD2		; AND TRY AGAIN
	HRRM	A1,T1ADR	; SET NEW T1ADR
	MOVEI	A1,LB		; ADDRESS OF NEW BMOVE LIST
	PUSHJ	SP,BMOVE	; MOVE INTO FINAL POSITION
	HRRZ	A5,NSYM		; GET ADDR OF BUFFER CONTAINING PROCEDURE NAME
	SUBI	A5,2		; MAKE LOOK LIKE SYMBOL TABLE ENTRY
	PUSHJ	SP,PULL50	; CONVERT NAME IN ENTRY TO RADIX50
	POP	SP,A3		; ADDRESS OF MOVED BLOCK
	MOVEM	A2,PNAME1-WRITE5-1(A3)	; PUT NAME IN BUFFER
	MOVEM	A2,PNAME2-WRITE5-1(A3)	; PUT NAME IN BUFFER
	TLO	A2,040000	; CODE 04
	MOVEM	A2,PNAME3-WRITE5-1(A3)	; PUT NAME IN BUFFER
	TRNE	FL,TRLOFF	; /PRODUCTION ?
	JRST	WRITE2		; YES - IMPLIES /NOSYMBOLS
	PUSH	SP,A2		; NO  - REMEMBER A2
	MOVE	A1,NSYM		; GET SYMBOL BUFFER ADDRESS
	MOVE	A1,(A1)		; GET FIRST WORD
	ANDI	A1,77		; GET LENGTH IN CHARS - 1
	ADDI	A1,6+6+2+5	; LENGTH+1 + ROUNDING + PROFILE & SIZE
	IDIVI	A1,6		; GET NUMBER OF SIXBITZ WORDS
	MOVEM	A1,PVALUE-WRITE5-1(A3)	; SET VALUE WORD
	POP	SP,A2		; RESTORE NAME
	TRNE	FL,TRPOFF	; 
	JRST	WRITE2
	TLZ	A2,740000	; CLEAR CODE BITS
	MOVEM	A2,EMODBL-1-WRITE5(A3) ; PUT MODULE TITLE IN.
	MOVE	A2,SLIST+1	; SOURCE DEVICE
	MOVEM	A2,EMODBL+2-WRITE5(A3)	;
	MOVE	A2,LINENO	;
	MOVEM	A2,EMODBL-2-WRITE5(A3)	;
	ADDI	A3,EMODBL+3-WRITE5
	HRLI	A3,SFILE	; SOURCE FILE INFO
	MOVEI	A1,3(A3)	;
	BLT	A3,(A1)		;
;	"WRITE2" IS CALLED BY ".PROGD" AND ".PROCD".  "WRITE2" WILL PUT
;	THE PROGRAM COUNTER (RA) INTO THE 1ST DATA WORD OF A NEW TYPE-1
;	LOADER BLOCK.

WRITE2:	PUSHJ	SP,FIN1		; INITIALIZE PRIME BUFFER
	MOVEI	A4,TYPE1	; INITIALISE TYPE-1 BLOCK
	PUSHJ	SP,INITB
	AOS	A3,T1IND	; GET INDEX
	SETZM	@T1ADR		; SET START ADDRESS
	MOVEI	A3,1		; RELOCATE RIGHT HALF
	IDPB	A3,T1PTR	; SET RELOCATION BITS
	MOVEI	A4,10		; THIS BUFFER IS FOR
	MOVEM	A4,T10TYP	; TYPE-10 BLOCKS
	POPJ	SP,		; EXIT .PROGD OR .PROCD



;	"PULL50" WILL EXTRACT THE RADIX50 NAME OF AN IDENTIFIER FROM THE
;	SYMBOL TABLE ENTRY.  A5 SHOULD CONTAIN THE ADDRESS OF THE SYMBOL TABLE
;	ENTRY.  THE OUTPUT IS IN A2, RIGHT-JUSTIFIED.


PULL50:	MOVEI	A1,0		; CLEAR A1
	MOVE	A2,2(A5)	; GET 1ST WORD OF NAME
	MOVEI	A3,(A2)
	ANDI	A3,77		; #CHARS.-1
	MOVEI	A4,(A3)
	IMULI	A4,6		; COPY*6
	CAIGE	A3,5		; IF THERE ARE LESS THAN 6 CHARS
	JRST	IDL		; THEN SKIP THIS PART
	MOVE	A1,3(A5)	; PICK UP 2ND WORD
	CAIGE	A3,^D10		; IF THERE ARE LESS THAN 11 CHARS
	ROT	A1,-^D24(A4)	; SHIFT AROUND 6TH CHAR.
	ANDI	A1,77
	XORI	A1,40		; CONVERT TO PROPER SIXBIT
	MOVEI	A3,4		; RESET CHAR COUNT
	MOVEI	A4,^D30		; SET UP FINAL SHIFT

IDL:	ROT	A1,-^D12	; MOVE LAST CHAR TO LEFT SIDE OF A1
	LSHC	A1,6		; MOVE NEXT CHAR INTO A1
	XORI	A1,40		; CONVERT TO PROPER SIXBIT
	SOJGE	A3,IDL		; LOOP TILL DONE
	ROT	A1,(A4)		; RESULT
;	"RADX50" WILL CONVERT THE SIXBIT NAME IN A1 TO RADIX50, AND
;	OUTPUT THE RESULT IN A2, LEFT-JUSTIFIED.


RADX50:	MOVEI	A2,0		; CLEAR A2
	MOVEI	A3,6		; SCAN 6 CHARS
	MOVE	A6,[		; LOAD A POINTER TO
	POINT	6,A1]		; A1

RADIXL:	IMULI	A2,50		; MULTIPLY CHAR BY 50
	ILDB	A4,A6		; GET NEXT CHAR
	JUMPE	A4,.+5		; SKIP IF A NULL CHAR
	CAILE	A4,40		; IF THIS IS A LETTER
	SUBI	A4,7		; THEN SUB 7
	SUBI	A4,17		; CONVERT TO SPECIAL SIXBIT
	ADDI	A2,(A4)		; ADD INTO PREVIOUS RESULT
	SOJG	A3,RADIXL	; LOOP
	POPJ	SP, 		; EXIT RADX50




	RELOC

WFLAG:	BLOCK	1		; WRITE MODULE FLAG
A1SAV:	BLOCK	1		; SAVE AREA FOR .TYPE0 ACS
A2SAV:	BLOCK	1		; SAVE AREA FOR A2
A4SAV:	BLOCK	1		; SAVE AREA FOR A4
A5SAV:	BLOCK	1		; SAVE AREA FOR A5
A6SAV:	BLOCK	1		; SAVE AREA FOR A6
BUFLEN:	BLOCK	1		; OUTPUT BUFFER LENGTH
WINDEX:	BLOCK	1		; WORD INDEX
TRACLN:	BLOCK	1
;	^D100			; TRACE BUFFER LENGTH (/T SW)
DYNOWN:	BLOCK	1		; LENGTH OF HEAP (/HEAP SWITCH)
;
;  TERMINOLOGY
;
;
;	LOADER SUB-BLOCK:	A WORD OF RELOCATION BITS FOLLOWED BY UP
;				TO 18 DATA WORDS.
;
;
;	LOADER BLOCK:		A DESCRIPTOR WORD FOLLOWED BY ANY NUMBER
;				OF LOADER SUB-BLOCKS.  ONLY THE LAST SUB-BLOCK
;				MAY CONTAIN LESS THAN 18 DATA WORDS.
;
;
;	DESCRIPTOR WORD:	LEFT HALF CONTAINS LOADER BLOCK TYPE.
;				RIGHT HALF CONTAINS THE NUMBER OF DATA WORDS
;				IN THE LOADER BLOCK.  NOTE THAT THIS NUMBER
;				DOES NOT INCLUDE THE DESCRIPTOR WORD OR ANY
;				RELOCATION BITS WORDS.
;
;
;	BUFFER:			A BLOCK OF 200 (OCTAL) WORDS THAT CAN RECIEVE
;				OUTPUT.
;
;
;	RING BUFFER:		A BUFFER, AS DEFINED ABOVE, THAT IS INCLUDED
;				IN AN OUTPUT BUFFER-RING ACCEPTABLE TO THE
;				OPERATING SYSTEM.
;
;
;	BUFFER-RING:		A RING OF RING BUFFERS.
;
;
;	ISOLATED BUFFER:	A BUFFER THAT IS NOT A RING BUFFER.  ANY OUTPUT
;				DATA THAT IS PLACED IN AN ISOLATED BUFFER
;				MUST EVENTUALLY BE MOVED TO A RING BUFFER.
;
;
;	PRIME BUFFER:	THROUGHOUT MOST OF THE COMPILATION, TYPE-1, TYPE-2,
;			TYPE-10, AND TYPE-0 DATA IS PRODUCED SIMULTANEOUSLY.
;			BUT DUE TO THE INGENIOUS DESIGN OF THE BUFFER-RING
;			CONCEPT IT IS ONLY POSSIBLE TO FILL ONE RING BUFFER
;			AT A TIME.  THEREFORE TYPE-1 DATA IS PLACED IN THE
;			AVAILABLE RING BUFFER, AND THE TYPE-2, TYPE-10, AND TYPE-0
;			DATA ARE PLACED IN THREE ISOLATED BUFFERS.  WE SHALL
;			CALL THE AVAILABLE RING BUFFER THE "PRIME BUFFER".
;	STATUS BLOCK		THIS MODULE CONTAINS GENERALIZED ROUTINES
;				THAT CAN OPERATE ON ANY BUFFER.  THE INPUT
;				PARAMETER TO THESE ROUTINES IS THE ADDRESS
;				OF A "STATUS BLOCK".  A STATUS BLOCK IS A BLOCK
;				OF WORDS THAT DESCRIBES THE CURRENT STATUS OF THE
;				BUFFER.  A STATUS BLOCK HAS THE FOLLOWING FORMAT:
;
;
;   STATUS BLOCK FORMAT:
;
;	WORD 0 (T#IND)		LOADER SUB-BLOCK INDEX.  THIS WORD NORMALLY
;	INDEX WORD		CYCLES FROM -18 TO 0.  WHEN IT BECOMES +1
;				IT IS TIME TO CALL THE ROUTINE "GET" WHICH
;				SETS UP THE BUFFER FOR ANOTHER SUB-BLOCK.
;				IF, FOR EXAMPLE, "GET" FINDS THAT THERE ARE
;				ONLY 7 UNUSED WORDS AT THE END OF THE BUFFER,
;				THEN IT WILL SET UP THIS WORD TO CYCLE FROM
;				-7 TO 0.
;
;
;	WORD 1 (T#ADR)		BUFFER POINTER.  THE RIGHT HALF OF THIS WORD
;	ADDRESS WORD		POINTS TO THE EVENTUAL LAST WORD OF THE SUB-BLOCK
;				THAT IS BEING FILLED.  THE LEFT HALF ALWAYS
;				CONTAINS A3.  THEN A DATA WORD IS MOVED INTO
;				A SUB-BLOCK BY THE FOLLOWING SEQUENCE:
;
;		AOSLE	A3,T#IND	; STEP AND FETCH THE INDEX
;		PUSHJ	SP,T#GET	; -NO ROOM IN SUB-BLOCK, CALL GET
;		MOVEM	A1,@T#ADR	; MOVE DATA WORD INTO SUB-BLOCK
;
;
;	WORD 2 (T#PTR)		RELOCATION BITS BYTE POINTER.  THE RELOCATION
;	POINTER WORD		BITS ARE INSERTED INTO THE RELOCATION WORD
;				USING AN IDPB WITH THIS BYTE POINTER.
;
;
;	WORD 3 (T#BLK)		THIS WORD POINTS TO THE DESCRIPTOR WORD OF
;	BLOCK START		OF THE LOADER BLOCK IN THE BUFFER.  AFTER
;				THE BUFFER IS FILLED THE DESCRIPTOR WORD IS
;				SET BY THE SEQUENCE:
;
;		(USED LENGTH OF BUFFER) := T#ADR+T#IND-T#BLK ;
;		@T#BLK := (USED LENGTH OF BUFFER)-(USED LENGTH OF BUFFER)/19 ;
;
;
;	WORD 4 (T#END)		THIS WORD POINTS TO THE LAST USABLE WORD
;	BUFFER END		OF THE BUFFER.
;
;
;	WORD 5 (T#TYP)		THIS WORD CONTAINS THE LOADER BLOCK TYPE FOR
;	BLOCK TYPE		WHICH THIS BUFFER IS BEING USED.
;	IF AT ANY TIME "GET" DETECTS THAT ANY OF THESE BUFFERS IS FULL,
;	"GET" WILL CALL "FIN".  "FIN" WILL USE "MOVBLK" TO MOVE THE TYPE-2, TYPE-0
;	AND TYPE-10 LOADER BLOCKS FROM THE ISOLATED BUFFERS TO THE PRIME
;	BUFFER (AND IN THE PROCESS DO OUT UUO'S WHENEVER THE PRIME BUFFER
;	BECOMES FULL).  "FIN" WILL THEN USE "INITB" TO INITIALIZE EACH OF
;	THE BUFFERS FOR MORE OUTPUT.


; *********  STATUS BLOCKS  *********


TYPE1:
T1IND:	BLOCK	1		; INDEX
T1ADR:	BLOCK	1	; (A3)	; ADDRESS POINTER
T1PTR:	BLOCK	1
;	XWD	440200,0	; POINTER TO RELOCATION BITS
T1BLK:	BLOCK	1		; LOCATION OF LOADER BLOCK
T1END:	BLOCK	1		; END OF THAT BUFFER
T1TYP:	BLOCK	1		; TYPE 1
T1LEN:	BLOCK	1		; LENGTH

TYPE2:
T2IND:	BLOCK	1	; -^D18	; INDEX
T2ADR:	BLOCK	1	; (A3)	; ADDRESS POINTER
T2PTR:	BLOCK	1
;	XWD	440400,0	; POINTER TO RELOCATION BITS
T2BLK:	BLOCK	1		; LOCATION OF LOADER BLOCK
T2END:	BLOCK	1		; END OF THAT BUFFER
T2TYP:	BLOCK	1		; TYPE 2
T2LEN:	BLOCK	1		; LENGTH


TYPE10:
T10IND:	BLOCK	1	; -^D18	; INDEX
T10ADR:	BLOCK	1	; (A3)	; ADDRESS POINTER
T10PTR:	BLOCK	1
;	XWD	440200,0	; POINTER TO RELOCATION BITS
T10BLK:	BLOCK	1		; LOCATION OF LOADER BLOCK
T10END:	BLOCK	1		; END OF THAT BUFFER
T10TYP:	BLOCK	1		; TYPE 10

T10LEN:	BLOCK	1		; LENGTH

T1000S:	; *** All headers for new block-types (type .GE. 1000) must follow this label.

TYPE0:
T0IND:	BLOCK	1	; -^D126.	; INDEX
T0ADR:	BLOCK	1	; (A3)	; ADDRESS POINTER
T0PTR:	BLOCK	1		; POINTER TO RELOCATION BITS (UNUSED)
T0BLK:	BLOCK	1		; LOCATION OF LOADER BLOCK
T0END:	BLOCK	1		; END OF THAT BUFFER
T0TYP:	BLOCK	1		; TYPE 0
T0LEN:	BLOCK	1		; LENGTH
TYPE15=TYPE10
T15IND=T10IND
T15ADR=T10ADR
T15PTR=T10PTR
T15BLK=T10BLK
T15END=T10END
T15TYP=15

	NEWT0==1044	; BLOCK TYPE FOR ALGOL SYMBOLS

	RELOC
; *********  OUTPUT ROUTINES  *********




;--------------------------------------------------------------
.MABS:	AOSLE	A3,T1IND	; FETCH THE INDEX AND STEP IT
	PUSHJ	SP,T1GET	; -AT END OF 18-WORD BLOCK
	MOVEM	A1,@T1ADR	; STORE THE WORD IN THE BUFFER
	IBP	T1PTR		; RELOCATION BITS ARE ZERO

MABS1:	AOS	RA		; STEP PROGRAM COUNTER
	POPJ	SP,		; EXIT .MABS



;--------------------------------------------------------------
.MREL:	TRNN	A1,777777	; IF RIGHT HALF OF T IS ZERO
	JRST	.MABS		; THEN DO A MABS
.MREL0::AOSLE	A3,T1IND	; STEP AND FETCH WORD INDEX
	PUSHJ	SP,T1GET	; -END OF SUB-BLOCK
	MOVEM	A1,@T1ADR	; STORE THE WORD IN THE BUFFER
	MOVEI	A3,1		; RELOCATE RIGHT HALF
	IDPB	A3,T1PTR	; SET RELOCATION BITS
	JRST	MABS1		; EXIT .MREL



;--------------------------------------------------------------
.RAFIX:	TRNN	A1,777777	; IF RIGHT HALF ZERO
	POPJ	SP,		; THEN DO NOTHING
	AOSLE	A3,T10IND	; STEP AND FETCH WORD INDEX
	PUSHJ	SP,T10GET	; -END OF SUB-BLOCK
	HRL	A1,RA		; THE VALUE IS THE CURRENT PROGRAM COUNTER

RAFIX1:	MOVSM	A1,@T10ADR	; STORE THE WORD IN THE BUFFER
	MOVEI	A3,3		; RELOCATE BOTH HALVES
	IDPB	A3,T10PTR	; SET THE RELOCATION BITS
	POPJ	SP,		; EXIT .RAFIX
;--------------------------------------------------------------
.ADRFIX:
	TRNN	A1,777777	; IF RIGHT HALF ZERO
	POPJ	SP,		; THEN DO NOTHING
	AOSLE	A3,T10IND	; STEP AND FETCH WORD INDEX
	PUSHJ	SP,T10GET	; -END OF SUB-BLOCK
	HRL	A1,A2		; PUT VALUE WITH BACK-CHAIN POINTER
	JRST	RAFIX1		; EXIT .ADRFIX
;--------------------------------------------------------------
.ABSFIX:
	TRNN	A1,777777	; IF RIGHT HALF ZERO
	POPJ	SP,		; THEN DO NOTHING
	AOSLE	A3,T10IND	; STEP AND FETCH WORD INDEX
	PUSHJ	SP,T10GET	; -END OF SUB-BLOCK
	HRL	A2,A1		; PUT VALUE WITH BACK-CHAIN POINTER
	MOVEM	A2,@T10ADR	; PUT WORD INTO BUFFER
	MOVEI	A3,2		; RELOCATE THE LEFT HALF
	IDPB	A3,T10PTR	; SET RELOCATION BITS
	POPJ	SP,		; EXIT .ABSFIX



;--------------------------------------------------------------
.FIX50:	TRNN	A1,777777	; IF RIGHT HALF ZERO
	POPJ	SP,		; THEN DO NOTHING
	MOVEM	A5,A5SAV	; SAVE A5
	AOSLE	A3,T2IND	; STEP AND FETCH WORD INDEX
	PUSHJ	SP,T2GET	; -END OF SUB-BLOCK
	TLO	A2,600000	; INCLUDE THE CODE 60 INDICATOR
	MOVEM	A2,@T2ADR	; STORE THE WORD IN THE BUFFER
	AOSLE	A3,T2IND	; STEP AND FETCH THE WORD INDEX
	PUSHJ	SP,T2GET	; -END OF SUB-BLOCK
	HRRZM	A1,@T2ADR	; STORE THE WORD IN THE BUFFER
	MOVE	A5,A5SAV	; RESTORE A5
	JRST	.ADDF1		; EXIT VIA ADDFIX
;--------------------------------------------------------------
.EXTFIX:
	MOVEM	A5,A5SAV	; SAVE A5 BECAUSE PULL50 WILL CLOBBER IT
	PUSHJ	SP,PULL50	; EXTRACT NAME AND CONVERT TO RADIX50
	MOVE	A5,A5SAV	; RESTORE A5
	MOVE	A1,1(A5)	; LOAD VALUE FIELD OF ENTRY
	PUSHJ	SP,.FIX50	; WRITE OUT THIS BACK-CHAIN POINTER
	MOVE	A3,(A5)		; GET 1ST WORD OF ENTRY
	TLNN	A3,EXTEN	; IF THIS IS NOT AN EXTENDED ENTRY
	POPJ	SP,		; THEN EXIT .EXTFIX
	MOVE	A3,2(A5)	; GET NAME WORD
	ADDI	A3,1		; ADD 1 TO BYTE COUNT
	ANDI	A3,77		; SAVE ONLY LENGTH BYTE
	IDIVI	A3,6		; CONVERT TO A WORD COUNT
	ADDI	A3,3(A5)	; STEP TO EXTENSION
	MOVE	A1,(A3)		; GET 1ST WORD OF EXTENSION
	JRST	.FIX50		; WRITE OUT THIS BACK-CHAIN POINTER, EXIT .EXTFIX



;--------------------------------------------------------------
.ADDFIX:
	AOSLE	A3,T2IND	; STEP AND FETCH WORD INDEX
	PUSHJ	SP,T2GET	; -END OF SUB-BLOCK
	MOVE	A2,DIR		; ADDITIVE FIX UP TO %ALGDR
	MOVEM	A2,@T2ADR	; STORE THE WORD IN THE BUFFER
	AOSLE	A3,T2IND	; STEP AND FETCH THE WORD INDEX
	PUSHJ	SP,T2GET	; -END OF SUB-BLOCK
	HRLI	A1,400000	; INDICATE AN ADDITIVE FIX-UP
	MOVEM	A1,@T2ADR	; STORE THE WORD IN THE BUFFER

.ADDF1:	MOVEI	A3,1		; RELOCATE RIGHT HALF OF SECOND WORD
	IDPB	A3,T2PTR	; SET THE RELOCATION BITS
	POPJ	SP,		; EXIT .ADDFIX
;--------------------------------------------------------------

.TYPE0::LDB	A2,[
	POINT	6,2(A1),35]	; LENGTH IN CHARS
	IDIVI	A2,5		; THEN WORDS
	AOS	A2		; ADJUST
	MOVNM	A2,A1SAV	; SAVE IT FOR LOOP
	ADDI	A2,2		; ADD EXTRA LENGTH
	HRLI	A2,'SYM'	; AND SET CODE
	PUSHJ	SP,MOVE0	; ENTER IT
	MOVE	A2,1(A1)	; LEXEME,,VALUE
	MOVE	A4,FNLEVEL	;  
	SOJG	A4,TYPE0A	; IF AT PL = 0
	TLC	A2,$EXT		; AND STATUS
	TLZE	A2,$STATUS	; .NE. EXTERNAL,
	TLOA	A2,$OWN		; FORCE $OWN
	TLO	A2,$EXT		; LEAVE $EXT ALONE !

TYPE0A:	PUSHJ	SP,MOVE0
	PUSHJ	SP,NAME		; CONVERT TO ASCII
	HRL	A1,A1SAV	; -VE LHS COUNT
	HRRI	A1,LB		; BEGINNING OF NAME
	MOVE	A2,(A1)
	PUSHJ	SP,MOVE0	; TO BLOCK
	AOBJN	A1,.-2		; REST OF NAME TOO
	POPJ	SP,

.PRSYM::LDB	A2,[
	POINT	6,2(A1),35]	; GET LENGTH IN CHARS
	IDIVI	A2,5		; THEN WORDS
	AOS	A2		; AND ALLOW FOR EXTRA
	MOVNM	A2,A1SAV	; SAVE IT FOR LOOP
	ADDI	A2,2		; ADD EXTRA LENGTH
	HRLI	A2,'SYM'	; SET CODE
	PUSHJ	SP,MOVE0	; WRITE IT TO THE FILE
	MOVE	A2,A1		; GET NEW LEXEME
	TLZ	A2,$PRO-$VAR	; CHANGE TYPE TO VARIABLE
	TLZ	A2,$STATUS	; AND STATUS TO SIMPLE
	HRR	A2,FNLEVEL	; RESULT IS AT FNLEVEL+1(DL)
	AOJA	A2,TYPE0A	; SO GO INSERT IN BUFFER
.BHDR::	PUSHJ	SP,SNDSTN	; MAKE SURE STN ITEM IS SENT
	MOVE	A2,BHDR		; ALGOL BLOCK SYMBOL HEADER
	PUSHJ	SP,MOVE0
	MOVE	A2,BLOCKLEVEL
	HRL	A2,CURBLOCK	; 
	PUSHJ	SP,MOVE0
	MOVE	A2,FNLEVEL
	HRL	A2,CURDLN
	JRST	MOVE0			; EXIT VIA MOVE0

.SBHDR::PUSHJ	SP,SNDSTN	; MAKE SURE STN ITEM IS SENT
	MOVE	A2,SBHDR	; BLOCK BEGIN ITEM
	JRST	MOVE0		; EXIT VIA MOVE0

	BLKH==SIXBIT/BLK/
BHDR:	EXP	BLKH+3
	SBLKH==SIXBIT/BKS/
SBHDR:	EXP	SBLKH+1

.ESBLK::MOVE	A2,CURDLN	; "END" STATEMENT - LINE NO IS DEL
	MOVEM	A2,CURSLN	; LINE NUMBER (END IS A DELIMITER)
.SNBLK::MOVE	A2,RA		; GET ADDRESS.
	CAME	A2,LASTRA	; IS IT A NEW ADDRESS ?
	PUSHJ	SP,SNDSTN	; YES - OUTPUT OLD STN BLOCK
	MOVE	A2,RA		; THEN GET ADDRESS AGAIN
	MOVEM	A2,LASTRA	; REMEMBER FOR NEXT TIME
	MOVE	A2,CURSLN	; GET LINE NUMBER
	MOVEM	A2,SENDLN	; REMEMBER THIS ALSO
	SETOM	SENDSN		; SAY WE HAVE A BLOCK
	POPJ	SP,		; AND RETURN

SNDSTN:	SKIPN	SENDSN		; DO WE NEED TO SEND ONE ?
	POPJ	SP,		; NO  - RETURN
	SETZM	SENDSN		; YES - SAY WE HAVE DONE SO
	MOVE	A2,SNHDR	; STATEMENT NUMBER BLOCK.
	PUSHJ	SP,MOVE0
	MOVE	A2,LASTRA	; PROGRAM COUNTER
	PUSHJ	SP,MOVE0
	MOVE	A2,SENDLN	; GET LINE NUMBER OF STATEMENT
	CAMN	A2,LSTSLN	; IF SAME AS LAST TIME, THEN
	AOSA	STMTNO		; INCREMENT STATEMENT WITHIN LINE
	SETZM	STMTNO		; OTHERWISE RESET TO 0
	MOVEM	A2,LSTSLN	; REMEMBER LINE NUMBER FOR NEXT TIME
	HRL	A2,STMTNO	; STATEMENT-WITHIN-LINE-#,,LINE-#
	JRST	MOVE0		; TO .REL FILE & POPJ.

	STMNTB==SIXBIT/STN/
SNHDR:	EXP	STMNTB+3
.MRK.0::PUSHJ	SP,MRK.XX
.MRK.1::PUSHJ	SP,MRK.XX
.MRK.2::PUSHJ	SP,MRK.XX
.MRK.3::PUSHJ	SP,MRK.XX
.MRK.4::PUSHJ	SP,MRK.XX
.MRK.5::PUSHJ	SP,MRK.XX
.MRK.6::PUSHJ	SP,MRK.XX
.MRK.7::PUSHJ	SP,MRK.XX
.MRK.8::PUSHJ	SP,MRK.XX
.MRK.9::PUSHJ	SP,MRK.XX
MRK.XX:	TRNE	FL,TRPOFF	; ARE WE SENDING SYMBOLS ?
	JRST	[
	  SUB	SP,[1,,1]	; NO - CLEAR JUNK FROM STACK
	  POPJ	SP,]		; AND RETURN
	PUSHJ	SP,SNDSTN	;YES - MAKE SURE STN HAS BEEN SENT
	MOVE	A2,[XWD	'MRK',2];GET MARKER TYPE CODE
	PUSHJ	SP,MOVE0	; AND SEND IT OUT
	POP	SP,A2		; THEN GET LINK
	SUBI	A2,.MRK.1	; CONVERT TO TYPE CODE
	HRL	A2,RA		; GET ADDRESS INTO LEFT HALF
; ****	JRST	MOVE0		;**** FALL INTO MOVE0 ****

MOVE0:	AOSLE	A3,T0IND	; GET INDEX
	PUSHJ	SP,T0GET	; -END OF SUB-BLOCK
	MOVEM	A2,@T0ADR	; STORE THE WORD IN THE BUFFER
	POPJ	SP,		; EXIT MOVE0

	RELOC

LASTRA:	BLOCK	1		; ADDRESS OF STN BLOCK.
SENDSN:	BLOCK	1		; FLAG TO SAY SEND STN ITEM
SENDLN:	BLOCK	1		; LINE NUMBER FOR STN ITEM

	RELOC

;--------------------------------------------------------------
T1GET:	MOVEI	A4,TYPE1	; ADDR OF STATUS BLOCK THAT DESCRIBES THE TYPE-1 BLOCK
	JRST	GET		; CONTINUE



T2GET:	MOVEI	A4,TYPE2	; ADDR OF STATUS BLOCK THAT DESCRIBES THE TYPE-2 BLOCK
	JRST	GET		; CONTINUE



T10GET:	MOVEI	A4,TYPE10	; ADDR OF STATUS BLOCK THAT DESCRIBES THE TYPE-10 BLOCK
	JRST	GET		; CONTINUE


T0GET:	MOVEI	A4,TYPE0	; ADDR OF STATUS BLOCK THAT DESCRIBES THE TYPE-0 BLOCK
	PUSHJ	SP,GET		;
	POPJ	SP,		;

;	"GET" IS CALLED WHEN A SUB-BLOCK IS FULL.  "GET" WILL SET UP THE
;	STATUS BLOCK FOR THE NEXT SUB-BLOCK.  IF THERE IS ROOM LEFT
;	IN THE BUFFER FOR MORE THAN 18 DATA WORDS, "GET" WILL SET THE INDEX
;	WORD TO CYCLE FROM -18 TO 0.  IF THERE IS BETWEEN 3 AND 18 WORDS
;	OF SPACE LEFT IN THE BUFFER, "GET" WILL SET THE INDEX WORD SO THAT
;	IT BECOMES ZERO WHEN THE BUFFER IS FULL.
;
;	IF THERE ARE LESS THAN 3 AVAILABLE WORDS LEFT IN THE BUFFER,
;	"GET" WILL NOT START ANOTHER SUB-BLOCK IN THAT BUFFER.  INSTEAD,
;	"GET" WILL CALL "FIN" TO MOVE THE LOADER BLOCKS TO THE PRIME BUFFER.
;	THEN "GET" WILL PUT THE PROGRAM COUNTER (RA) INTO THE 1ST DATA WORD
;	OF THE NEW TYPE-1 LOADER BLOCK.
;
GET:	MOVE	A5,EN(A4)	; COMPUTE THE AMOUNT OF SPACE LEFT
	SUB	A5,ADR(A4)	; IN THE BUFFER.
	MOVEI	A5,(A5)		; CLEAR LEFT HALF OF A5
	CAIGE	A5,3		; IF LESS THAN 3 WORDS REMAIN
	JRST	GET1		; THEN DONT START ANOTHER SUB-BLOCK.
	CAMLE	A5,LEN(A4)	; IF MORE THAN LEN WORDS REMAIN
	MOVE	A5,LEN(A4)	; USE EXACTLY LEN WORDS FOR THIS SUB-BLOCK
	MOVE	A3,ADR(A4)	; GET OLD ADDRESS POINTER
	ADDI	A3,1		; THE NEXT WORD IS THE NEW RELOCATION BITS WORD
	HRRM	A3,PTR(A4)	; SET POINTER'S ADDRESS FIELD
	SETZM	(A3)		; CLEAR THE RELOCATION BITS
	MOVEI	A3,44		; REINITIALIZE THE P-FIELD OF
	DPB	A3,[		; THE RELOCATION BITS BYTE POINTER TO
	POINT	6,PTR(A4),5]	; THE 1ST BYTE.
	ADDM	A5,ADR(A4)	; ADD LENGTH OF NEW SUB-BLOCK TO OLD ADDR POINTER
	MOVN	A3,A5		; NEGATE LENGTH OF NEW SUB-BLOCK
	ADDI	A3,2		; BUT DONT COUNT THE RELOCATION WORD
	HRREM	A3,IND(A4)	; THIS WILL BE THE NEW INDEX WORD
	POPJ	SP,		; EXIT GET


GET1:	MOVEM	A2,A2SAV	; SAVE A2
	MOVEM	A4,A4SAV	; SAVE A4
	SOS	IND(A4)		; CORRECT END OF DATA
	PUSHJ	SP,FIN		; FINISH
	MOVEI	A4,TYPE1
	PUSHJ	SP,INITB	; INITIALIZE NEW TYPE1
	AOS	A3,T1IND	; STEP AND FETCH THE INDEX
	MOVE	A2,RA		; GET PROGRAM COUNTER
	TLZE	A2,400000	; IF RA WAS DECREMENTED
	ADDI	A2,1		; THEN COMPENSATE
	HRRZM	A2,@T1ADR	; PUT PROGRAM COUNTER INTO SUB-BLOCK
	MOVEI	A3,1		; 2ND HALF IS RELOCATABLE
	IDPB	A3,T1PTR	; OUTPUT RELOCATION BITS
	MOVE	A4,A4SAV	; RESTORE A4
	MOVE	A2,A2SAV	; RESTORE A2
	AOSGE	A3,IND(A4)	; STEP INDEX
	POPJ	SP,		; EXIT T1GET, T2GET, OR T10GET
	JRST	GET1		; TRY AGAIN IF BLOCK TOO SHORT.
;	"COMPL" COMPUTES THE NUMBER OF DATA WORDS IN A LOADER BLOCK.
;	"COMPL" EXPECTS A4 TO CONTAIN THE ADDRESS OF THE STATUS BLOCK, AND THAT THE
;	STATUS BLOCK ADDRESS WORD (T#ADR) POINT TO THE LAST ACTUAL DATA WORD OF THE
;	LOADER BLOCK.  "COMPL" WILL INSERT THIS NUMBER INTO THE LOADER BLOCK'S
;	DESCRIPTOR WORD.


COMPL:	HRRZ	A5,ADR(A4)	; GET END OF LOADER BLOCK
	SUB	A5,BLK(A4)	; LENGTH OF USED BUFFER SPACE
	HRL	A5,TYP(A4)	; GET TYPE BITS
	TLNE	A5,1700		; NO ADJUSTMENT FOR TYPES
	JRST	COMPL1		; 1000-1077
	MOVEI	A2,-1(A5)	; COPY LENGTH-1 TO A2
	IDIVI	A2,^D19		; COMPUTE NUMBER OF RELOCATION WORDS
	SUBI	A5,1(A2)	; ELSE SUB FOR # DATA WORDS

COMPL1:	MOVEM	A5,@BLK(A4)	; PUT TYPE AND LENGTH AT BEGINNING OF BLOCK
	POPJ	SP,		; EXIT COMPL




;	"GETBUF" WILL GET A NEW PRIME BUFFER, AND THEN UPDATE THE PRIME
;	BUFFER STATUS BLOCK TO REFLECT THIS CHANGE.


GETBUF:	MOVE	A2,T1ADR	; END OF DATA IN BUFFER
	HRRM	A2,BHEAD1+1	; MARK IN HEADER
	SKIPLE	WFLAG		; IF THERE IS AN OBJECT MODULE
	OUT	1,0		; GET ANOTHER BUFFER
	JRST	.+2		; -OK
	JRST	DSERR7		; -OUTPUT ERROR
	HRRZ	A2,BHEAD1	; ADDRESS OF NEW BUFFER
	ADDI	A2,1		; STEP OVER 1ST WORD
	HRRM	A2,T1BLK	; MARK BLOCK BEGINNING
	HRRM	A2,T1ADR	; SET T1ADR
	ADD	A2,BUFLEN	; COMPUTE END OF BUFFER
	HRRZM	A2,T1END	; SAVE THIS ADDRESS
	POPJ	SP,		; EXIT CHECK3
;	"FIN" WILL ADD THE INDEX WORD, T1IND, TO THE ADDRESS WORD, T1ADR,
;	AND EXPECT THE SUM TO POINT TO THE LAST DATA WORD IN THE PRIME BUFFER.
;	THEN "FIN" WILL COMPUTE THE NUMBER OF DATA WORDS IN THE LOADER BLOCK
;	THAT IS BEING FILLED IN THE PRIME BUFFER, AND INSERT THIS NUMBER
;	INTO THE LOADER BLOCK'S DESCRIPTOR WORD.  THEN "FIN" WILL USE "MOVBLK"
;	TO MOVE LOADER BLOCKS FROM THE ISOLATED BUFFERS TO THE PRIME BUFFER.
;	FINALLY, "FIN" WILL INITIALIZE THE PRIME BUFFER TO RECEIVE SUB-BLOCKS
;	OF A NEW LOADER BLOCK.


FIN:	HRRE	A4,T1IND	; GET INDEX
	ADDM	A4,T1ADR	; COMPUTE END OF DATA IN PRIME BUFFER
	MOVEI	A4,TYPE1	; PARAM FOR COMPL
	PUSHJ	SP,COMPL	; LENGTH OF CODE IN BUFFER, PUT IN BUFFER
	MOVEI	A4,TYPE2	; PARAM FOR MOVBLK
	PUSHJ	SP,MOVBLK	; MOVE TYPE-2 LOADER BLOCK TO PRIME BUFFER
	MOVEI	A4,TYPE10	; PARAM FOR MOVBLK
	PUSHJ	SP,MOVBLK	; MOVE TYPE-10 LOADER BLOCK TO PRIME BUFFER
	MOVEI	A4,TYPE0	; PARAM FOR MOVBLK
	TRNN	FL,TRPOFF	; UNLESS PRODUCTION SWITCH SET
	PUSHJ	SP,MOVBLK	; MOVE TYPE-0 LOADER BLOCK TO PRIME BUFFER

FIN1:	MOVE	A3,T1END	; END OF BUFFER
	SUB	A3,T1ADR	; COMPUTE REMAINING LENGTH OF BUFFER
	MOVEI	A3,(A3)		; ZERO LEFT HALF
	CAIGE	A3,3		; IF THERE ARE LESS THAN 3 WORDS LEFT
	PUSHJ	SP,GETBUF	; THEN GET ANOTHER BUFFER
	AOS	A3,T1ADR	; NEXT AVAILABLE WORD IN PRIME BUFFER
	POPJ	SP,
;	"INITB" INITIALIZES A BUFFER SO THAT IT CAN RECEIVE THE 1ST SUB-BLOCK
;	OF A NEW LOADER BLOCK.  "INITB" EXPECTS A3 TO CONTAIN THE ADDRESS
;	OF THE NEW LOADER BLOCK (ADDRESS OF THE DESCRIPTOR WORD), AND THAT
;	A4 CONTAIN THE ADDRESS OF THE STATUS BLOCK.


INITB:	HRRZM	A3,BLK(A4)	; SET POINTER TO DESCRIPTOR WORD
	HRRZS	A3		; CLEAR LHS
	ADD	A3,LEN(A4)	; STEP TO END OF SUB-BLOCK
	CAMLE	A3,EN(A4)	; IF PAST END OF BUFFER
	MOVE	A3,EN(A4)	; THEN BUFFER END BECOMES SUB-BLOCK END
	HRRM	A3,ADR(A4)	; SET ADDRESS POINTER
	SUB	A3,BLK(A4)	; COMPUTE LENGTH OF SUB-BLOCK
	MOVNM	A3,IND(A4)	; SET INDEX WORD
	CAIL	A4,T1000S	; All this not requ'd for 1000 up,
	POPJ	SP,		; So skip it
	AOS	IND(A4)		; Step past relocation word
	MOVE	A3,BLK(A4)	; Beginning of block
	MOVEI	A3,1(A3)	; Relocation word
	SETZM	(A3)		; To zero
	HRRM	A3,PTR(A4)	; SET ADDR FIELD OF RELOCATION BITS POINTER
	MOVEI	A3,44		; BYTE 1
	DPB	A3,[		; SET P-FIELD OF RELOCATION
	POINT	6,PTR(A4),5]	; BITS BYTE POINTER
	POPJ	SP,		; EXIT INITB




;	"MOVBLK" WILL MOVE A LOADER BLOCK FROM AN ISOLATED BUFFER TO THE
;	PRIME BUFFER.  "MOVBLK" EXPECTS A4 TO CONTAIN THE ADDRESS OF THE STATUS BLOCK,
;	AND THAT T1ADR POINT TO THE LAST ACTUAL DATA WORD IN THE PRIME BUFFER.
;	UPON COMPLETION, "MOVBLK" WILL SET T1ADR TO POINT TO THE NEW LAST
;	DATA WORD IN THE PRIME BUFFER.
;
;	IF THE LOADER BLOCK TO BE MOVED WILL NOT FIT IN THE AVAILABLE SPACE
;	IN THE PRIME BUFFER, "MOVBLK" WILL MOVE AS MUCH AS WILL FIT, AND
;	THEN PERFORM AN OUT UUO TO GET A NEW PRIME BUFFER, THEN MOVE THE
;	REMAINDER OF THE LOADER BLOCK TO THE NEW PRIME BUFFER.
MOVBLK:	HRRE	A5,IND(A4)	; GET INDEX
	ADDM	A5,ADR(A4)	; COMPUTE END OF LOADER BLOCK
	PUSHJ	SP,COMPL	; COMPUTE LENGTH OF BLOCK, PUT IN BLOCK

	; COMPUTE LENGTH OF LOADER BLOCK TO MOVE

	HRRZ	A5,ADR(A4)	; GET END OF USED SPACE
	SUB	A5,BLK(A4)	; SUBTRACT BEGINNING OF LOADER BLOCK
EDIT(070); Allow only one data word in new block-types
	SOJL	A5,MBLK2	; [E070] Exit if no data words
	MOVE	A3,TYP(A4)	; [E070] Else get Block-Type
	TRNN	A3,1700		; [E070] And if not a new block
	JUMPE	A5,MBLK2	; [E070] Exit if only one word
	ADDI	A5,2		; TRUE LENGTH OF BLOCK TO MOVE

	; COMPUTE REMAINING SPACE IN CURRENT OUTPUT BUFFER

	MOVE	A3,T1END	; END OF OUTPUT BUFFER
	SUB	A3,T1ADR	; SUBTRACT POINTER
	MOVEI	A3,(A3)		; ZERO LEFT HALF OF A3
				; A5=LENGTH OF LOADER BLOCK TO MOVE
				; A3=LENGTH OF AVAIL SPACE IN PRIME BUFFER
	JUMPE	A3,MBLK3	; JUMP IF NO SPACE LEFT
	CAIGE	A3,(A5)		; IF THERE IS NOT ENOUGH SPACE THEN
	JRST	MBLK4		; CONTINUE

	; MOVE REMAINDER OF LOADER BLOCK TO OUTPUT BUFFER

	HRLZ	A3,BLK(A4)	; "FROM" ADDRESS
	MOVE	A2,T1ADR	; END OF DATA IN PRIME BUFFER

MBLK1:	HRRI	A3,1(A2)	; "TO" ADDRESS
	ADDI	A2,(A5)		; "END" ADDRESS IN PRIME BUFFER
	HRRM	A2,T1ADR	; SAVE AS NEW ADDRESS POINER
	HRRM	A2,T1BLK
	AOS	T1BLK
	BLT	A3,(A2)		; MOVE IT

MBLK2:	MOVE	A3,BLK(A4)	; LOCATE BEGINNING OF LOADER BLOCK
	JRST	INITB		; INITIALIZE IT, EXIT MOVBLK
	; NO SPACE IN PRIME BUFFER

MBLK3:	HRL	A3,BLK(A4)	; "FROM" ADDRESS
	JRST	MBLK5		; CONTINUE


	; INSUFFICIENT SPACE IN PRIME BUFFER

MBLK4:	SUB	A5,A3		; COMPUTE LENGTH OF 2ND PART
	ADD	A3,BLK(A4)	; COMPUTE "FROM" ADDRESS FOR 2ND PART
	HRLZI	A3,(A3)		; SAVE FOR LATER
	AOS	A2,T1ADR	; "TO" ADDRESS
	HRL	A2,BLK(A4)	; "FROM" ADDRESS
	BLT	A2,@T1END	; MOVE 1ST PART OF LOADER BLOCK


MBLK5:	MOVE	A2,T1END	; END OF PRIME BUFFER
	HRRM	A2,T1ADR	; SET T1ADR TO IT
	PUSHJ	SP,GETBUF	; GET ANOTHER PRIME BUFFER
	HRRZ	A2,T1ADR	; ADDR OF BEGINNING OF NEW BUFFER
	JRST	MBLK1		; CONTINUE
.ZZEND:	MOVEM	A6,A6SAV	; SAVE A6
	PUSHJ	SP,LMSGZ	; PRINT ANY ERROR MESSAGES LEFT IN TABLE

;--------------------------------------------------------
;	SEARCH SYMBOL TABLE FOR UNDEFINED LABELS.
;--------------------------------------------------------

ZLAB:	MOVE	A1,STBB		; WHERE AN UNDEFINED LABEL ENTRY MIGHT BE
	CAML	A1,NASTE	; IF NO UNDEFINED LABEL
	JRST	ZC0		; THEN SKIP THIS PART
	PUSHJ	SP,NAME		; EXTRACT FROM SYMBOL TABLE ENTRY THE ASCIZ NAME
	MOVE	A2,(A1)		; GET 1ST WORD OF ENTRY
	TLNE	A2,EXTEN	; IF IT IS AN EXTENDED ENTRY
	ADDI	A6,2		; THEN ADD 2 TO POINTER
	MOVEM	A6,STBB		; SAVE FOR LATER
	HRRZ	A1,-2(A6)	; GET THE CHAIN HEAD
	MOVEI	A2,777777	; FIX IT UP TO JUMP TO -1
	PUSHJ	SP,.ABSFIX	; WRITE OUT THE FIX-UP
	MOVEI	A1,UNDLAB	; "UNDEFINED LABEL "
	PUSHJ	SP,INS		; SEND TO LISTING AND TO TTY
	MOVEI	A1,LB		; ADDRESS OF NAME OF LABEL
	PUSHJ	SP,INS		; SEND TO LISTING AND TO TTY
	PUSHJ	SP,TCHECK	; CR/LF
	AOS	.JBERR		; ADD 1 TO ACCUMULATED ERROR COUNT
	JRST	ZLAB		; LOOK FOR ANOTHER UNDEFINED LABEL


UNDLAB:	ASCIZ	/UNDEFINED LABEL /
;--------------------------------------------------------
;	MOVE 1-WORD CONSTANTS TO REL-FILE
;--------------------------------------------------------

ZC1:	HLRZ	A1,(A2)		; IF BACK-CHAIN IS ZERO
	JUMPE	A1,.+4		; THEN DONT OUTPUT THIS CONSTANT
	MOVE	A1,1(A2)	; GET CONSTANTS VALUE
	HLRZ	A6,(A2)		; GET THE BACK CHAIN
	PUSHJ	SP,ZZZ		; OUTPUT THE WORD AND THE BACK CHAIN
	SUB	A2,(A2)		; LOCATE NEXT ENTRY ON CHAIN
	TLZA	A2,777777	; ZERO LEFT HALF

ZC0:	MOVE	A2,LASTC1	; START OF 1-WORD-CONSTANTS CHAIN

ZC2:	CAMLE	A2,CONTAB	; UNLESS END OF CHAIN
	JRST	ZC1		; LOOP
;--------------------------------------------------------
;	MOVE 2-WORD CONSTANTS TO REL-FILE
;--------------------------------------------------------

	MOVE	A2,LASTC2	; START OF 2-WORD-CONSTANTS CHAIN
	JRST	ZC4		; JUMP INTO LOOP

ZC3:	MOVE	A1,2(A2)	; GET 1ST WORD OF VALUE
	HLRZ	A6,(A2)		; GET THE BACK CHAIN
	JUMPE	A6,ZC4-2	; IF NO BACK-CHAIN THEN SKIP THIS CONSTANT
	PUSHJ	SP,ZZZ		; OUTPUT THE WORD AND ITS FIXUP
	MOVE	A1,3(A2)	; GET 2ND WORD OF VALUE
	HRRZ	A6,1(A2)	; GET THE BACK CHAIN
	PUSHJ	SP,ZZZ		; OUTPUT THE WORD AND ITS FIXUP
	SUB	A2,(A2)		; LOCATE NEXT ENTRY ON CHAIN
	MOVEI	A2,(A2)		; ZERO LEFT HALF

ZC4:	CAMLE	A2,CONTAB	; UNLESS END OF CHAIN, 
	JRST	ZC3		; LOOP

;--------------------------------------------------------
;	MOVE ANY ASCII STRINGS FROM CONSTANTS TABLE TO REL-FILE
;--------------------------------------------------------

	MOVE	A2,LASTST	; ADDR OF LAST STRING
	JRST	ZC8		; JUMP INTO LOOP

ZC5:	HLLZ	A1,(A2)		; GET 1ST BACK-CHAIN
	IOR	A1,1(A2)	; OR WITH OTHER BACK-CHAINS
	JUMPE	A1,ZC8-2	; IF ALL 3 ZERO THEN SKIP THIS STRING
	HRRZ	A1,RA		; GET ADDRESS OF EVENTUAL
	ADDI	A1,2		; STRING ADDRESS
	HRLI	A1,440700	; SET POSITION BITS
	PUSHJ	SP,.MREL	; WRITE 1ST WORD OF STRING HEADER
	HLRZ	A6,(A2)		; GET THE BACK CHAIN
	PUSHJ	SP,ZZZ+1	; WRITE OUT THE FIXUP
	MOVE	A1,2(A2)	; GET BYTE COUNT
	HRRZ	A6,1(A2)	; GET THE 2ND BACK CHAIN
	PUSHJ	SP,ZZZ		; WRITE OUT THE WORD AND ITS FIXUP
	SKIPN	2(A2)		; IF STRING IS 0 CHARS LONG
	JRST	ZC7		; THEN SKIP THIS PART
	PUSH	SP,A1		; SAVE VALUE OF RA FOR LATER
	MOVEI	A1,2(A2)	; START OF STRING -1
	MOVEM	A1,TEMP		; PUT IN TEMP
ZC6:	AOS	A1,TEMP		; GET ADDR OF NEXT WORD OF STRING
	MOVE	A1,(A1)		; GET NEXT WORD OF STRING
	PUSHJ	SP,.MABS	; WRITE IT OUT
	HRREI	A1,-5		; DECREMENT CHARACTER COUNT
	ADDB	A1,2(A2)	; BY 5
	JUMPG	A1,ZC6		; LOOP IF STILL SOME LEFT
	POP	SP,A1		; RETRIEVE OLD VALUE OF RA

ZC7:	PUSH	SP,RA		; SAVE CURRENT VALUE OF RA
	MOVEM	A1,RA		; SET RA TO OLD VALUE
	HLRZ	A1,1(A2)	; GET 3RD BACK-CHAIN POINTER
	PUSHJ	SP,.RAFIX	; WRITE IT OUT
	POP	SP,RA		; RESTORE CORRECT VALUE OF RA
	SUB	A2,(A2)		; STEP TO NEXT STRING
	MOVEI	A2,(A2)		; ZERO LEFT HALF

ZC8:	CAMLE	A2,CONTAB	; IF THERE IS ANOTHER STRING
	JRST	ZC5		; THEN LOOP

;--------------------------------------------------------
;	MOVE CONTENTS OF FIXUP TABLE TO REL-FILE
;--------------------------------------------------------
;
;
;	TYPE-15 BLOCKS (NOT MORE THAN 1 PER PROGRAM)
;	ARE CREATED AS FOLLOWS -
;	THE BLOCK HEADER WORD IS WRITTEN DIRECTLY INTO THE 
;	CURRENT PRIME BUFFER, SINCE ITS TOTAL LENGTH IS
;	KNOWN, THEN ITS CONSTITUENT SUB-BLOCKS ARE BUILT IN
;	THE TYPE-10 BUFFER AND MOVED OUT ONE BY ONE INTO THE 
;	PRIME BUFFER, SO AS TO PRESENT ONE CONTINUOUS STREAM
;	TO THE LOADER.
;
;
	PUSHJ	SP,FIN		; CLEAR OUT ALL OTHER BUFFERS
	MOVE	A2,FIXUP	; COMPUTE TOTAL LENGTH
	SUB	A2,NAFTE	; OF THE BLOCK
	LSH	A2,1		; SINCE TABLE WAS PACKED
	SOJL	A2,ZEXIT3-2	; MAYBE NOTHING
	HRLI	A2,15		; BLOCK HEADER
	MOVEI	A3,0		; CLEAR A3 'cos T1ADR uses it
	MOVEM	A2,@T1ADR
	SOS	A3,T15BLK	; INITIALIZE FIRST S-B
	MOVEI	A4,TYPE15
	PUSHJ	SP,INITB	;
	AOS	T15BLK		; To please future calls
	HRL	A2,RA
	SETZM	PTR15
	PUSHJ	SP,MOV15A	; WRITE OUT RELOC ETC
	MOVE	A1,FIXUP
ZEXIT1:	SUBI	A1,1		; STEP TO NEXT WORD (TABLE GROWS DOWNWARD)
	CAMG	A1,NAFTE	; IF AT END OF TABLE
	JRST	ZEXIT2		; THEN FINISHED PROCESSING TABLE
	MOVE	A3,(A1)		; GET RIGHT HALF
	PUSHJ	SP,MOV15	; PUT INTO TYPE-15 BLOCK
	HLRZ	A3,(A1)		; GET LEFT HALF
	PUSHJ	SP,MOV15	; PUT INTO TYPE-15 BLOCK
	JRST	ZEXIT1		; LOOP
;--------------------------------------------------------
;	SUBROUTINE FOR MOVING TYPE-15 FIXUPS
;--------------------------------------------------------

MOV15:	AOS	A2,PTR15	; GET A VALUE FOR IT
	HRL	A2,A3		; PUT VALUE WITH BACK CHAIN POINTER

MOV15A:	AOSLE	A3,T15IND	; GET INDEX
	PUSHJ	SP,T15GET	; -END OF SUB-BLOCK
	MOVEM	A2,@T15ADR	; PUT FIX-UP INTO BUFFER
	MOVEI	A3,2		; BACK POINTER IS RELOCATABLE
	TLNN	A2,777777	; IF THERE IS NO BACK-CHAIN
	MOVEI	A3,0		; THEN BACK POINTER IS NOT RELOCATABLE
	IDPB	A3,T15PTR	; OUTPUT RELOCATION BITS
	POPJ	SP,		; EXIT MOV15

;--------------------------------------------------------------
;	THIS SECTION OUTPUTS A TYPE15 SUB-BLOCK TO PRIME BUFFER
;----------------------------------------------------------------

T15GET:	AOS	A5,T1ADR	; UPDATE NEXT LOCN
	HRRZ	A4,T1ADR	; DESTINATION
	ADDI	A4,^D17(A3)	; PLUS LENGTH OF THIS S-B
	HRL	A5,T15BLK	; BLOCK BEGINNING
	CAMG	A4,T1END	; ANY ROOM ?
	JRST	T15GT1		; IF SO, JUMP ON
;
;	THIS SECTION OUTPUTS AS MUCH OF A SUB-BLOCK AS WILL
;	FIT TO THE PRIME BUFFER, PUSHES OUT THE BUFFER
;	VIA GETBLK, AND LEAVES THE REMAINDER OF THE SUB-BLOCK 
;	TO T15GET.
;

	BLT	A5,@T1END	; SHIFT AS MANY AS POSS.
	SUB	A4,T1END	; #WORDS STILL TO MOVE
	ADDI	A3,^D18		; TOTAL WORDS TO MOVE
	SUBI	A3,(A4)		; WORDS MOVED
	ADDM	A3,T1ADR	; UPDATE LAST WORD USED
	HRRZ	A5,T15BLK	; SET A5 UP FOR LATER
	ADDI	A5,(A3)
	MOVEM	A2,A2SAV	; GETBUF DESTROYS IT
	PUSHJ	SP,GETBUF	; OUTPUT
	MOVE	A2,A2SAV	; RESTORE A2
	HRLI	A5,(A5)		; ORIGIN ON LEFT
	HRR	A5,T1ADR
	ADDI	A4,(A5)
	ADDI	A5,1
T15GT1:	BLT	A5,(A4)
	HRRM	A4,T1ADR	; UPDATE T1ADR
	SOS	A3,T15BLK	;
	MOVEI	A4,TYPE15
	PUSHJ	SP,INITB	;
	AOS	T15BLK		;
	AOS	A3,T15IND	; FOR MOV15
	POPJ	SP,		; OR MAYBE ONLY EXIT

;	SUBROUTINE FOR MOVING CONSTANTS TO REL-FILE

ZZZ:	PUSHJ	SP,.MABS	; WRITE OUT THE WORD
	SOS	A1,RA		; GET AND DECREMENT RA
	TLO	A1,400000	; TAG IT
	MOVEM	A1,RA
	MOVE	A1,A6		; MOVE THE CHAIN TO A1
	PUSHJ	SP,.RAFIX	; WRITE OUT THE FIXUP
	AOS	A1,RA
	HRRZM	A1,RA		; INCREMENT RA AND CLEAR FLAG
	POPJ	SP,


;--------------------------------------------------------
;	MOVE TO REL-FILE THE TYPE-2 ENTRIES FOR THE LIBRARY PROCEDURES
;--------------------------------------------------------

ZEXIT2:	MOVNI	A1,^D18		; CHECK FOR NULL S-BLK
	AOS	A3,T15IND
	CAME	A1,T15IND
	PUSHJ	SP,T15GET
	SETOM	ECOUNT		; INITIALIZE ALIAS COUNT
	MOVEI	A5,BLOCK0##	; 1ST ENTRY IN BLOCK 0

ZEXIT3:	AOS	A2,ECOUNT	; STEP ALIAS INDEX
	MOVE	A2,ATABLE##(A2)	; GET ALIAS NAME IN RADIX50
	IMULI	A2,50		; APPEND PROCESSOR CHARACTER
	ADDI	A2,13		; IE "A" IN RAD 50
	SKIPE	TARGMC		; OR IF ITS FOR A KI
	ADDI	A2,<"I"-"A">	; AN I
	MOVE	A1,1(A5)	; VALUE FIELD CONTAINS BACK CHAIN
	PUSHJ	SP,.FIX50	; WRITE OUT FIX-UP
	MOVE	A1,(A5)		; GET 1ST WORD OF ENTRY
	MOVE	A3,2(A5)	; 1ST WORD OF NAME
	ADDI	A3,1		; ADD 1 TO CHARACTER COUNT
	ANDI	A3,77		; SAVE ONLY CHAR COUNT
	IDIVI	A3,6		; CONVERT TO WORD COUNT MINUS 1
	ADDI	A5,3(A3)	; STEP TO PAST NAME
	TLNN	A1,EXTEN	; IF THIS IS NOT AN EXTENDED ENTRY 
	JRST	ZEXIT4		; THEN SKIP THIS PART
	MOVE	A1,(A5)		; LOAD 1ST WORD OF EXTENSION
	MOVE	A2,ECOUNT	; GET THE ENTRY COUNT
	MOVE	A2,AT2##(A2)	; GET 2ND ALIAS NAME IN RADIX50
	IMULI	A2,50		; AND ADD PROCESSOR CHARACTER
	ADDI	A2,13
	SKIPE	TARGMC
	ADDI	A2,<"I"-"A">
	PUSHJ	SP,.FIX50	; WRITE OUT FIX-UP
	ADDI	A5,2		; SET PAST EXTENSION TO NEXT ENTRY
ZEXIT4:	CAIGE	A5,B0END##	; IF STILL WITHIN BLOCK 0
	JRST	ZEXIT3		; THEN LOOP

;--------------------------------------------------------
;	WRITE OUT THE TYPE-5 END BLOCK
;--------------------------------------------------------

	PUSHJ	SP,FIN+4	; FINISH
	HRRZ	A1,T1ADR	; GET NEXT FREE LOCATION
	MOVE	A2,[		; THIS IS A TYPE-5 BLOCK
	XWD	5,1]		; OF LENGTH 1
	MOVEM	A2,(A1)		; PUT INTO BUFFER
	HRLZI	A2,200000	; RELOCATION BITS
	MOVEM	A2,1(A1)	; PUT INTO BUFFER
	MOVE	A2,RA		; GET END OF PROGRAM PLUS 1
	HRRZM	A2,2(A1)	; PUT INTO BUFFER
	ADDI	A1,2		; END OF DATA
	HRRM	A1,T1ADR	; SET NEW T1ADR
	HRRM	A1,BHEAD1+1	; SET END OF DATA
	MOVE	A6,A6SAV	; RESTORE A6
	TLNE	A7,EXISTS	; IF THE LISTING EXISTS
	TLZ	A7,COMPLETE	; THEN MARK IT COMPLETE
	MOVEM	A7,RFLAGS	; SAVE READ MODULE FLAGS
	MOVE	A7,A7SAV	; RESTORE A7
	POPJ	SP,		; EXIT .ZZEND


	RELOC

TEMP:	BLOCK	1		; TEMP
PTR15:	BLOCK	1		; STATIC OWN AREA POINTER
ECOUNT:	BLOCK	1		; ENTRY COUNT

	RELOC
;	"NAME" WILL EXTRACT FROM A SYMBOL TABLE ENTRY THE NAME OF THE
;	IDENTIFIER IN ASCIZ FORMAT.  A1 SHOULD CONTAIN THE ADDRESS OF
;	THE SYMBOL TABLE ENTRY.  THE OUTPUT IS IN A BUFFER CALLED "LB"


NAME:	SKIPA	A5,.+1
	XWD	LB,LB+1
	SETZM	LB		; CLEAR ENOUGH OF LB
	BLT	A5,LB+^D14	;  FOR A 64-CHAR NAME.
	MOVE	A5,LBP		; BYTE POINTER TO OUTPUT BUFFER
	MOVEI	A6,2(A1)	; STEP TO 1ST NAME WORD OF ENTRY
	MOVE	A3,(A6)		; LOAD 1ST NAME WORD
	LSHC	A3,-6		; PEEL OFF LENGTH COUNT
	LSH	A4,-36		; CHAR COUNT -1
	MOVEI	A2,1(A4)	; A2 = CHAR COUNT

NAMEL:	LSHC	A3,-6		; GET NEXT CHAR
	LSH	A4,-36		; MOVE TO RIGHT OF REG
	JUMPE	A4,NAMEL	; IF A NULL THEN GET ANOTHER CHAR
	TRNN	A4,40		; IF IT IS A LETTER
	IORI	A4,100		; THEN CONVERT IT TO ASCII
	IDPB	A4,A5		; PUT IN BUFFER
	JUMPN	A3,.+3		; SKIP IF STILL MORE CHARS IN A3
	ADDI	A6,1		; STEP WORD INDEX
	MOVE	A3,(A6)		; PICK UP NEXT WORD OF NAME
	SOJG	A2,NAMEL	; LOOP ONCE FOR EACH CHAR
	POPJ	SP,		; EXIT NAME
SUBTTL DATA MODULE

	DEFINE MOD(N,ALOC)
	<INTERN B.'N
	INTERN Q.'N;
	Q.'N==ALOC
	B.'N: BLOCK ALOC
	>

;..STORAGE ALLOCATION FOR MODULES
	RELOC

	MOD(MDEC,0);
	MOD(MSTM,0);
	MOD(MEXP,0);
	MOD(MFOR,12);
	MOD(MUTL,2);
	MOD(MSER,16);
	MOD(MCOD,3);
	MOD(MFUN,1);
SUBTTL GLOBAL VARIABLES (FULL WORDS)

	DEFINE GLOB(G)
	<INTERN G
	G: BLOCK	1
	>

	GLOB NSYM;		;NEXT SYMBOL
	GLOB NDEL;		;NEXT DELIMITER
	GLOB BLOCKLEVEL;	;CURRENT BLOCKLEVEL
	GLOB FNLEVEL;		;CURRENT FUNCTION LEVEL
	GLOB STBB;		;SYMBOL TABLE BASE FOR THIS BLOCK
	GLOB NASTE;		;NEXT AVAIL. SYMBOL TABLE ENTRY
	GLOB NACTE;		;NEXT AVAIL. CONSTANTS TABOL ENTRY
	GLOB NAFTE;		;NEXT AVAILABLE FIXUP TABLE ENTRY;
	GLOB FIXUP;		;BASE OF FIXUP TABLE;
	GLOB CONTAB;		;CONSTANT TABLE BASE;
	GLOB CAX;		;PROCEDURE LEVEL OF LAST ACCESSED NON-LOCAL
	GLOB RA;		;RELATIVE ADDRESS OF NEXT INSTRUCTION PLACED IN 
				;OBCODE
	GLOB LEXBLOCK;		;MONOTONICALLY INCREASING COUNT OF BLOCKS
	GLOB CURBLOCK;		;LEXBLOCK OF CURRENT BLOCK
	GLOB ARDEC;		;ARRAY DECLARED IN BLOCK => TRUE; ELSE FALSE
	GLOB PROSKIP;		;PROCEDURE FOUND SWITCH (-1 NONE FOUND) OR ADDR
				;OF FIRST ONE
	GLOB LSTSLN;		; LINE NUMBER OF LAST STN BLOCK
	GLOB CURSLN;		; LINE NUMBER FOR SYM
	GLOB NXTSLN;		; LINE NUMBER OF NSYM
	GLOB CURDLN;		; LINE NUMBER FOR DEL
	GLOB NXTDLN;		; LINE NUMBER OF NDEL
	GLOB STMTNO;		; STATEMENT # WITHIN A LINE.
	GLOB LINENO;		;LINE NUMBER SPECIFIED BY LINE PSEUDO-STATEMENT
	GLOB INDEX;		;FIRST AVAILABLE FREE WORD IN TEMPCODE
	GLOB HANDLE;		;PORTION POINTER FOR CURRENTLY OPEN PORTION
	GLOB LEXEX;		;BLOCKLEVEL & HANDLE FOR SYM	* THESE
	GLOB COMPNAME;		;COMPOSIT NAME FOR SYM		* MUST
	GLOB LLEXEX;		;BLOCKLEVEL & HANDLE FOR LEFT OP* APPEAR
	GLOB LCOMPNAME;		;COMPOSIT NAME FOR LEFT OP	* TOGETHER
	GLOB LAC;		;LAST ALLOCATED ACCUMULATOR
	GLOB TCBASE;		;THE FIRST LOCATION OF TEMPCODE BUFFER.
	GLOB TCMAX;		;THE LAST LOCATION OF TEMPCODE BUFFER.
	GLOB THUNK;		;ADDRESS OF JRST OVER THUNKS (0 IF NONE YET.);
	GLOB OP;		;CONTAINS THE OPERATOR DURING CODE GENERATION;
	GLOB KA;		;COMMUNICATIONS CELL FOR GLOAD AND LOAD;
	GLOB FBSYMSAVE;		;SAVED STEP ELEMENT LEXEME
	GLOB FBLEXSAVE;
	GLOB FBCOMPSAVE;
	GLOB PREFACC;		;PREFERED REGISTER FOR CGINCR
;THIS IS LEXICAL SCANNER'S TABLE OF LINE POINTERS.

	GLOB PLIST;

	BLOCK 6;

	RELOC



	END