Google
 

Trailing-Edge - PDP-10 Archives - BB-JF16A-SB_1986 - micro.mac
There are 5 other files named micro.mac in the archive. Click here to see a list.
TITLE MICRO CODE ASSEMBLER
SUBTTL TOM EGGERS/JSL/AF/DAL/TWE	10 NOV 77
;ASSEMBLY INSTRUCTIONS:
;	LOAD MICRO
;	SSAV MICRO

	.TEXT	"/SYMSEG:HI/LOCALS"
	.REQUE	SYS:SCAN
	.REQUE	SYS:HELPER

CUSTVR==0	;CUSTOMER VERSION
DECVER==31	;MAJOR VERSION
DECMVR==0	;MINOR VERSION
DECEVR==254	;EDIT NUMBER
LOC <.JBVER==:137>
	BYTE (3) CUSTVR (9) DECVER (6) DECMVR (18) DECEVR

;NEW FEATURES NEEDED:
; 1)	SCAN SWITCHES TO SET OR CLEAR CONDITIONAL ASSEMBLY VARIABLES
;	AND TO TURN ON OR OFF LISTING ON A PER-FILE BASIS

	DEFINE SWSET (VAR,VAL),<
IFNDEF VAR,<VAR==VAL>
IF2,<	IFN VAR,<
PRINTX	SWITCH VAR IS ON
>	IFE VAR,<
PRINTX	SWITCH VAR IS OFF
>>	>

SWSET	FTULD,1		;1 TO OUTPUT "ULD" FILE
SWSET	FTCOIN,0	;1 TO CREF ALL LINES OF ONE WORD TOGETHER
SWSET	FTMAP,1		;1 TO PRINT MAP OF LINE #'S BY LOCATION
SWSET	FTECHR,0	;1 TO PRINT LAST CHAR ON ERROR
SWSET	(FTIF,1)	;1 TO ENABLE CONDITIONAL ASSEMBLY LOGIC
SWSET	(FTHASH,1)	;1 TO HASH SYMBOL TABLE

NINBUF==2		;NUMBER OF INPUT BUFFERS REQUESTED
NOUBUF==2		;NUMBER OF OUTPUT BUFFERS
;AC DEFINITIONS
F==0	;FLAG REGISTER
T1=1	;GLOBAL TEMP
T2=T1+1	;DITTO
T3=T2+1
T4=T3+1
RAM==7	;CONTAINS RAM NUMBER CURRENTLY BEING ASSEMBLED
	UCODE==0
	DISP==1		;BITS WITHIN AC RAM
FPNT=10	;POINTS TO CURRENT FIELD NAME IN SYM TABLE
SPNT=11	;POINTS TO CURRENT SYMBOL NAME IN SYM TABLE
C=12	;HOLDS LAST CHARACTER READ FOR INPUT
C1=C+1
N=14	;GLOBAL AC FOR PASSING ARGS
N1=N+1	;DITTO
PM=16	;STACK FOR MACROS AND RESCANS
P=17	;PUSH DOWN POINTER

;IN AC F (RIGHT HALF)
REREAD==1	;REREAD LAST INPUT CHARACTER
SUPP==2		;SUPPRESS ASSEMBLY
SEQUEN==4	;FORCE SEQUENTIAL LOCATION ASSIGNMENT
NOXLAT==10	;PREVENT CHARACTER TRANSLATION WHILE STORING MACRO TEXT
LALF==20	;ENABLE CONSTRAINT/TAG PROCESSING THIS WORD
BINF==200	;BINARY WORD HAS BEEN STARTED
PASS2==400	;0 FOR PASS1, 1 FOR PASS2
ERROR==1000	;ERROR FOUND ON LINE
NOHDR==2000	;SUPPRESS PRINTING TOP-OF-PAGE HEADERS
RTOL==4000	;RIGHT TO LEFT BIT NUMBERING
DOLST==10000	;OUTPUT LISTING FILE
DOULD==20000	;OUTPUT .ULD FILE
HEXF==40000	;RADIX 16 FLAG
DRAMF==100000	;.DCODE SEEN
UPCF==200000	;USED BY "ALLOC" TO FLAG "USED PC"

OPDEF UUO1 [1B8]

DEFINE MSG (A,B)
<XLIST
	  UUO1 [XWD [ASCIZ @B@],A]
LIST>

;DEFINE IO CHANNELS
IFN FTULD,<OUTCH2==2>;END FTULD
OUTCHN==0
INCHN==1

LPPAG==^D58		;LINES PER PAGE
PNTMAX==^D127		;LENGTH OF SRC LINE BUFFER
			; MUST BE MULTIPLE OF 8, MINUS 1
	DEFINE PINDEX (SIZ,ADR)
	<XX==-1
	REPEAT ^D36/<SIZ>,<	POINT SIZ,ADR,<XX==XX+SIZ>
> >
;STRUCTURE DEFINITIONS
MICMXB==^D144		;MAX NUMBER OF BITS IN A MICRO WORD
MICMXW==MICMXB/^D36	;MAX NUMBER OF WORDS FOR A MICRO WORD
NWORDS==4		;MAX NUMBER OF WORDS TO HOLD A SYMBOL
NCHARS==NWORDS*5-1	;MAX NUM OF CHARS IN A SYMBOL
MACMAX==30		;MAX NUMBER OF WORDS FOR MACRO WITH ARGUMENTS

MAXPC==17777		;MAXIMUM ADDRESS OF MICRO CODE
MAXDSP==777		;MAX ADDRESS OF DISPATCH
PRFMAX==^D16		;MAX NUMBER OF PREFERENCE REGIONS IN CONTROL STORE

;STRUCTURE OF A SYMBOL TABLE ENTRY

LOC	 0
SYMLNK:	BLOCK	1	;LEFT HALF CHAINS SYMBOLS WITHIN A FIELD TOGETHER
			;RIGHT HALF CHAINS FIELDS TOGETHER
			;POINTER TO 1ST FIELD IS IN FLDPNT
SYMTXT:	BLOCK	NWORDS	;1ST WORD WITH ASCIZ TEXT FOR NAME
SYMVAL:	BLOCK	1	;CONTAINS VALUES FOR A SYMBOL
			;FOR MACRO SYMS, RH POINTS TO 1ST CHAR OF MACRO EXPANSION
			;FOR PSEUDO OPS, RH IS HANDLER ADDRESS
SYMFLG:	BLOCK	1	;CONTAINS FLAGS FOR SYMBOL
SYMCRF:	BLOCK	1	;LEFT IS POINTER TO LAST ITEM IN CREF LIST
			;RIGHT IS POINTER TO 1ST ITEM
IFN FTHASH,<
SYMHSH:	BLOCK	1	;LH: FLDPNT IN FIELD NAME BLOCKS
			;    POINTER TO FIELD IN SYMBOL
			;RH: LINK TO NEXT SYMBOL WITH
			;    SAME HASH CODE
	HSHLEN==^D503	;NUMBER OF ENTRIES IN HSHTAB
>
SYMLEN==.-SYMLNK	;# OF WORDS IN A SYMBOL BLOCK

;FLAGS IN SYMBOL FLAG FIELD
MULF==1
DEFF==2		;DEFINED FLAG (1 IF DEFINED)
NCRFF==4	;SUPPRESS CREF OF THIS SYMBOL

;MACHINE-SPECIFIC FEATURE CODES

M$KL10==1
M$STAR==2
;STRUCTURE OF LOCATION ASSIGNMENT LIST (LAL)
;"LALHED" IS IN XWD FORMAT:
	;LH POINTS TO HEAD OF LIST
	;RH POINTS TO LAST ITEM (FOOT) OF LIST
LOC	0
LALPNT:	BLOCK 	1	;LH IS POINTER TO 2-WORD-BLOCK LIST OF TAGS,
			;   = ASSIGNMENTS, & ABS ASSIGNMENTS
			;RH IS POINTER TO NEXT 3-WORD-BLOCK
LALLOC:	BLOCK	1	;U-WORD LOCATION
LALLIN:	BLOCK	1	;BYTE (1)ASSIGNED(10)UNUSED(7)PCTYPE(18)LINE#
LALSZ==.	;LENGTH OF THIS BLOCK

;THE CODE AND VALUE BLOCK LIST IS POINTED TO BY LALPNT(LEFT HALF)
LOC	0
LALCD:	BLOCK	1	;LH IS POINTER TO NEXT BLOCK
			;RH IS CODE TYPE (LISTED NEXT)
	.LLNUM==1	;THIS BLOCK ENTRY IS "NUMBER:"
	.LLTAG==2	;ENTRY IS "TAG:"
	.LLEQL==3	;ENTRY IS FOR "=", WITH/WITHOUT BINARY NUMBER
	.LLFIL==4	;ENTRY SELECTS NEW INDEX IN FILE LIST
	.LLRGN==5	;ENTRY SELECTS A NEW LIST OF REGION SPEC'S
LALVL:	BLOCK	1	;CODE TYPE	LH		RH
			;.LLNUM	UNUSED		NUMBER
			;.LLTAG	FIELD ENTRY	POINTER TO SYM TAB ENTRY
			;.LLEQL BITS 0-5:	NUMBER OF BITS
			;	BITS6-20:	* POSITIONS
			;	BITS 21-35:	"1" POSITIONS
			;.LLFIL UNUSED		INDEX INTO FILE LIST
			;.LLRGN	START ADDR	END ADDR OF REGION
LLCDSZ==.
	TWOSEG
	RELOC	400000

MICRO::	RESET
	MOVEI	17,1
	MOVEI	0,0
	BLT	17,17		;ZERO THE AC'S
	MOVE	P,[IOWD PDLEND-PDL-1,PDL]
	MOVEI	C,0
	RUNTIM	C,		;GET STARTING RUNTIME
;	PUSHJ	P,ADJT20	;ADJUST FOR TOPS-20
	SETZM	GOBLT
	MOVE	T1,[GOBLT,,GOBLT+1]
	BLT	T1,ENDBLT-1	;ZERO STORAGE AREA
	MOVEM	C,STTIME	;SAVE STARTING TIME
	MOVE	PM,[IOWD PMEND-PMDL-1,PMDL]
	PUSH	PM,[0]		;THERE ARE NO FORMALS TO THE TOP-LEVEL MACRO
	MOVE	T1,[PUSHJ P, UUOH]
	MOVEM	T1,41
	MOVEI	T1,PUTL		;INIT OUTPUT TO LISTING
	MOVEM	T1,PUTP

	MOVE	T1,0
	PUSHJ	P,.ISCAN##
	MOVE	T1,[10,,[0
			0
			0
			-1	;FLAG SAYING MICRO.HLP IS ON SYS:
			0
			ALLIN,,ALLOUT
			0
			EXP 1B18]]
	PUSHJ	P,.TSCAN##
;SETUP IO

INIMCR:	MOVEI	T1,0
	SKIPN	T2,O.DEV
	MOVSI	T2,'DSK'
	MOVEM	T2,OUTDEV
	MOVSI	T3,OUTBLK
	OPEN	OUTCHN,T1
	  MSG [EXIT], CAN NOT OPEN LISTING DEVICE
	OUTBUF	OUTCHN,NOUBUF

	MOVEI	T1,.RBPRV		;MAX EXTENDED ENTER ENTRY NEEDED
	MOVEM	T1,OUTFIL+.RBCNT
	SKIPE	T1,I.FILE		;GET INDEX TO 1ST INPUT FILE
	MOVE	T1,I.NAM(T1)		;GET NAME (OR LEAVE NAME 0)
	SKIPE	O.NAM+1			;IS THERE AN OUTPUT NAME?
	MOVE	T1,O.NAM		;YES, SO USE IT AND NOT DEFAULT
	MOVEM	T1,OUTFIL+.RBNAM
	HLLZ	T2,O.EXT
	SKIPN	O.EXT
	MOVSI	T2,'MCR'
	MOVEM	T2,OUTFIL+.RBEXT
	SETZB	T3,OUTFIL+.RBPRV
	MOVE	T4,O.PPN
	MOVEM	T4,OUTFIL+.RBPPN
	ENTER	OUTCHN,OUTFIL
	  MSG	[EXIT], CAN NOT ENTER LISTING FILE
	SETOM	OUTENA		;ENABLE OUTPUT
;HERE TO INITIALIZE ULD OUTPUT

IFN FTULD,<
INIULD:	TRNN	F,DOULD		;.ULD FILE SPECIFIED
	JRST	NOULD		;NO--SKIP ALL THIS STUFF
;DEFAULT .ULD DEVICE, FILE AND PPN TO MATCH OUTPUT FILE
	MOVE	T1,O.DEV
	SKIPN	U.DEV
	MOVEM	T1,U.DEV
	MOVE	T1,O.NAM
	SKIPN	U.NAM+1
	MOVEM	T1,U.NAM
	MOVSI	T1,'ULD'	;DEFAULT EXT IS .ULD
	SKIPN	U.EXT
	MOVEM	T1,U.EXT
	MOVE	T1,O.PPN
	SKIPN	U.PPN
	MOVEM	T1,U.PPN
	MOVEI	T1,0
	MOVE	T2,U.DEV
	MOVSI	T3,BUFOUT
	OPEN	OUTCH2,T1
	  MSG	[EXIT], CAN NOT OPEN ULD DEVICE
	OUTBUF	OUTCH2,0
	MOVE	T1,U.NAM
	HLLZ	T2,U.EXT
	MOVEI	T3,0
	MOVE	T4,U.PPN
	ENTER	OUTCH2,T1
	  MSG	[EXIT], CAN NOT ENTER ULD FILE
NOULD:
>;END FTULD
;INITIALIZE TO BEGIN ASSEMBLY

	MOVE	T1,I.CNT
	MOVEM	T1,I.MAXC
	PUSHJ	P,PNTINI	;INIT OUTPUT LISTING
	HRROI	T1,1		;START AT PAGE 1, NEED A HEADER
	MOVEM	T1,PAGNUM

	MOVEI	N,LALSZ		;INIT 1ST LOCATION ASSIGNMENT BLOCK
	MOVEM	N,LALCOR
	PUSHJ 	P,GETWRD
	HRLS	N
	MOVEM	N,LALHED	;AT BEGINNING, HEAD AND FOOT ARE EQUAL

;INITIALIZE PREFERENCE PARAMETERS

	SETZM	PRFTB1		;START AT ZERO
	MOVEI	T1,MAXPC	;END AT HIGHEST PC ASSEMBLED FOR
	MOVEM	T1,PRFTB2
	MOVSI	T1,-<<MAXPC+^D35>/^D36>
	MOVEM	T1,PRFTB3	;AOBJN PTR FOR SCAN THROUGH USAGE
	SETZM	PRFTB3+1	;FLAG END OF PREFRENCE TABLE
	SETOM	PRFTB4		;FULL MASK FOR FIRST WORD OF USAGE

;BEGIN ASSEMBLY BY READING 1ST INPUT FILE FOR PASS 1
	PUSHJ	P,BEGPAS	;START PASS 1
	SETZM	INFILE+.RBNAM	;FILE NAME IS MEANINGLESS BETWEEN PASSES
	PUSHJ	P,ALLOC		;DEFINE TAGS AND ALLOCATE U-INSTRUCTIONS
	HLRS	LALHED		;RESET FOOT TO POINT TO HEAD OF
				;  LOCATION ASSIGNMENT LIST
	TRO	F,PASS2
	PUSHJ	P,START2	;LIST TABLE OF CONTENTS
	MOVE	T1,.JBFF##	;GET FIRST FREE LOC BEFORE BUILDING CREF
	MOVEM	T1,P2JFF	;SAVE TO RE-USE AFTER CREF PRINTED
	PUSHJ	P,BEGPAS	;START PASS 2
	PUSHJ	P,FINLST
IFN FTULD,<
	PUSH	P,PUTP		;SAVE CURRENT OUTPUT ROUTINE
	MOVEI	T1,PUTU		;SETUP FOR ULD OUTPUT
	MOVEM	T1,PUTP
	PUSHJ	P,PRINT		;LAST STATEMENT IN "ULD" FILE
	 ASCIZ	/
END
/
	POP	P,PUTP		;RESTORE OUTPUT POINTER
	CLOSE	OUTCH2,
	RELEAS	OUTCH2,
>;END FTULD
	CLOSE	OUTCHN,
	RELEAS	OUTCHN,
	RESET
	EXIT	1,		;MICRO ASSEMBLY COMPLETLY DONE
	JRST	MICRO		;DO ANOTHER
;SUBROUTINE FOR DOING EACH PASS

BEGPAS:	SETZM	STATE	;INIT STATE FOR SYNTAX ANALYSIS
	HLRZ	T1,LALHED	;GET ADDRESS OF FIRST LAL ITEM
	SKIPE	T1
	MOVE	T1,LALLOC(T1)	;GET LOCATION ALLOCATED TO IT
	MOVEM	T1,PC+UCODE	;INITIAL PC INTO WHICH TO ASSEMBLE
	SETZM	PC+DISP
	SETOM	HIGHPC+UCODE	;INITIAL HIGH PC IS -1
	SETOM	HIGHPC+DISP
	MOVEI	RAM,UCODE	;START WITH UCODE ASSEMBLY
	MOVEI	T1,1
	MOVEM	T1,LINNUM	;INIT LINE NUMBER TO 1
	MOVEI	T1,^D8		;START RADIX AT OCTAL
	MOVEM	T1,RADIX
	PUSHJ	P,BEGIO		;INIT INPUT IO
	 MSG [EXIT], NO INPUT FILES
	SETZM	USAGE
	MOVE	T1,[USAGE,,USAGE+1]
	BLT	T1,USGEND-1	;CLEAR USAGE TABLE
	ANDI	F,PASS2!DOULD!DRAMF

;TOP LEVEL ASSEMBLY LOOP

STATLP:	SKIPE	STATE
	JRST	STAT1
	TRZ	F,BINF		;ONLY CLEARED IN STATE 0
	SETZM	VALUE
	MOVE	T1,[VALUE,,VALUE+1]
	BLT	T1,VALEND-1
	MOVE	T1,LINNUM
	HRRZM	T1,CRFLIN#	;CREF LINE # CHANGES ONLY ON MICRO WORDS
STAT1:	PUSHJ	P,TOKEN		;SCAN NEXT TOKEN
	LSH	N,.SZTRM	;MOVE TOKEN TYPE OVER
	LDB	T1,STAPNT	;GET TERM CHARACTER TYPE
	IOR	T1,N		;COMBINE STATE, TOKEN TYPE, AND TERM TYPE
	IOR	T1,STATE
	IDIVI	T1,^D36/<.SZDSP+.SZSTA>
	LDB	T1,STAMTB(T1+1)	;GET DISPATCH AND NEW STATE
	DPB	T1,[POINT .SZSTA,STATE,^D35-.SZTOK-.SZTRM]
	LSH	T1,-.SZSTA
	LSH	T1,+1		;MAKE ROOM FOR PASS 1 OR 2 BIT
	TRNE	F,PASS2
	TRO	T1,1		;ON PASS 2, EXECUTE 2ND ENTRY
STAXCT:				;TAG NOT USED, FOR DDT REFERENCE ONLY	
	XCT	STDISP(T1)	;DISPATCH TO HANDLE FIELD AND TERM
;FALL THROUGH TO HERE AFTER STATE EXECUTE

	SKIPN	STATE
	TRNN	F,BINF
	JRST	STAX2		;NO BINARY ASSEMBLED YET
	TRNN	F,PASS2
	JRST	STAX1		;DEFAULTS INSERTED AND BIN PRINTED ONLY ON PASS2
	PUSHJ	P,DEFALT	;INSERT FIELD DEFAULTS
	PUSHJ	P,PNTBIN	;PRINT BINARY IN OUTPUT FILE(S)
	PUSHJ	P,USEDPC	;CHECK AND MARK USED MICRO WORD
STAX1:	PUSHJ	P,GETPC		;SETUP FOR NEXT MICRO WORD ADDRESS
STAX2:	CAIN	C,";"
	PUSHJ	P,SCNEND	;FLUSH A COMMENT
	CAIE	C,12
	JRST	STATLP		;AND START ALL OVER AGAIN
	PUSHJ	P,PNTLIN	;FINISH END OF LINE
	SKIPN	STATE		;DID LINE RETURN US TO STATE ZERO?
	TRZ	F,ERROR		;YES, RESET SWITCH TO PRINT ERRONEOUS LINE
	AOS	LINNUM		;INCREMENT LINE NUMBER
	SKIPN	ENDFIL		;END-OF-FILE?
	JRST	STATLP		;NO
	POPJ	P,		;END OF PASS
;STATE TABLE DISPATCH TABLE
;	THE 1ST ENTRY FOR ANY PAIR IS THE PASS 1 DISPATCH
;	THE 2ND ENTRY IS THE PASS 2 DISPATCH

STDISP:	PUSHJ	P,ILLFOR	;FOR ANY UNDEFINED FORMAT
	PUSHJ	P,ILLFOR	;FOR ANY UNDEFINED FORMAT
 DLBLK:	PUSHJ	P,LOCBLK	;"=" SCANNED AT BEGINNING OF LINE
	PUSHJ	P,LOCBLK
 DTAG:	PUSHJ	P,TAG		;"SYMBOL:" SCANNED
	JFCL
 DLSET:	PUSHJ	P,LOCSET	;"NUMBER:"
	PUSHJ	P,LOCSET
 DCFLD:	PUSHJ	P,CFSPC		;COND ASSY OR FIELD
	PUSHJ	P,CFSPC		;COND ASSY OR FIELD
 DFLD:	PUSHJ	P,FLDSPC	;FIELD/
	PUSHJ	P,FLDSPC
 DMDEF:	PUSHJ	P,DEFMAC
	PUSHJ	P,DEFMAC
 DSUDO:	PUSHJ	P,PSEUDO
	PUSHJ	P,PSEUDO
 DMAC:	PUSHJ	P,BEGMAC
	PUSHJ	P,BEGMAC
 DNOP:	JFCL
	JFCL
 DDEFF:	PUSHJ	P,DEFFLD
	PUSHJ	P,DEFFLD
 DDEFS:	PUSHJ	P,DEFSYM
	PUSHJ	P,DEFSYM
 DFSYM:	TRO	F,BINF		;"FIELD/SYMBOL" SCANNED
	PUSHJ	P,FLDSYM
 DFNUM:	TRO	F,BINF		;"FIELD/NUMBER" SCANNED
	PUSHJ	P,FLDNUM
 DCMNT:	PUSHJ	P,SCNEND
	PUSHJ	P,SCNEND
 DCSUP:	PUSHJ	P,CFSUP		;SUPPRESSED ASSEMBLY, ACCEPT IF OR IFNOT
	PUSHJ	P,CFSUP		; OR ENDIF, ONLY.


;THE "ILLFOR" SUBROUTINE USES "SCNEND"S POPJ TO RETURN
ILLFOR:	MSG SCNEND, ILLEGAL FORMAT

;SEARCH FOR END OF LINE (ALWAYS A LINE-FEED = 12)

	PUSHJ	P,GETCHR
SCNEND:	CAIE	C,12		;SEARCH FOR END OF LINE
	JRST	.-2
	POPJ	P,
;ASSIGN ABSOLUTE LOCATIONS, PROCESS "=" CONSTRAINTS, ASSIGN
;  "LOOSE" MICRO WORDS REMAINING, AND DEFINE ADDRESS TAGS

ALLOC:	MOVEI	RAM,UCODE	;THIS PROCESS FOR "U WORDS" ONLY
	SETZM	HGHEQL#		;ZERO LARGEST = BIT STRING SEEN
	MOVEI	N,":"
	PUSHJ	P,LALSRC	;START SEARCH TO PROCESS "NUM:"
	  JFCL					;NOT ASSIGNED
	  PUSHJ	P,ALLOC9
	  PUSHJ	P,[	MOVE T1,N		;"NUMBER:"
			HRRZ N,LALVL(N+1)
			JRST LLEQ99 ]
	  PUSHJ	P,LLTAG				;"TAG:"
	  PUSHJ P,[	PUSHJ P,LENCAL		;GET LENGTH OF 1'S & 0'S
			CAMLE T1,HGHEQL#
			MOVEM	T1,HGHEQL	;SAVE LARGEST SO FAR
			JRST LLZERO ]
ALLOC1:	MOVEI	N,"="
	PUSHJ	P,LALSRC	;THIS PROCESS FOR "=" CONSTRAINTS ONLY
	  PUSHJ	P,[	PUSH P,N			;NOT ASSIGNED
			PUSHJ P,PCNEXT
			POP P,T1
			JUMPGE N,LLXIT
			JRST LLEQ99 ]
	  PUSHJ	P,LLZSKP		;ALREADY ASSIGNED BY "NUM:" OR "="
	  PUSHJ	P,LLZERO		;"NUM:" TURNS OFF FURTHER = BLOCKS
	  PUSHJ	P,LLTAG			;"TAG:"
	  PUSHJ	P,LLEQL			;"="
	SOSLE	HGHEQL			;ASSIGN MOST "HIGHLY CONSTRAINED"
	JRST	ALLOC1			; WORDS FIRST
ALLOC2:	MOVEI	N," "
	PUSHJ	P,LALSRC	;ASSIGN REMAINING LOCS AND DEFINE TAGS
	  PUSHJ	P,[	PUSH P,N		;NOT ASSIGNED
			PUSHJ P,PCNXT1
			JRST LLEQL9 ]
	  SKIPA				;ALREADY ASSIGNED
	  JFCL				;"NUMBER:"
	  PUSHJ	P,LLTAG			;"TAG:"
	  JFCL				;"="
	POPJ P,		;RETURN FROM ALLOC SUBROUTINE

ALLOC9:	MSG CPOPJ1, ALLOC INTERNAL ERROR

LLTAG:	TRNN	F,UPCF		;IS THE LOCATION DEFINED?
	POPJ	P,		;NO, THEN DON'T DEFINE SYMBOL
	HRRZ	N,PC(RAM)	;YES, GO DEFINE IT
	HRRZ	SPNT,LALVL(N+1)
	HLRZ	FPNT,LALVL(N+1)
	PUSHJ	P,DEFCHK
	  HALT	DEFVAL
	PUSHJ	P,DEFSLS
	POPJ	P,

LLEQL:	PUSH	P,N
	LDB	T2,PATPNT	;GET 1'S AND 0'S PATTERN
	MOVEM	T2,BLDPAT
	LDB	T4,ASTPNT	;GET * PATTERN
	MOVEM	T4,BLDAST
	LDB	N,EQLSIZ	;GET LENGTH OF = BIT STRING
	JUMPE	N,LLXP		;IF 0, DON'T ASSIGN NOW
	MOVEI	T1,1		;FIND HOW MANY CONSECUTIVE WORDS
	LSH	T1,(N)		;  WORDS=2**NUMBER OF BITS
	SKIPGE	N,PC(RAM)	;GET CURRENT PC
	CAMLE	T1,FRECNT	;IS NEW BLOCK LARGER?
	JRST	LOCB6		;YES, OR PC NOT RESTRICTED

	MOVEI	T3,-1(T1)	;GET 1S FOR BITS SPECIFIED
	ANDCM	T3,BLDAST	;CLEAR * POSITIONS
	TDNE	T3,LOCAST	;CHECK FOR 1S OR 0S WHERE *S GIVEN IN MASTER
	JRST	LOCB5		;YES, PATTERN IS ILLEGAL
LOCB4:	MOVE	T3,N
	ANDCM	T3,BLDAST	;CLEAR DON'T-CARE BITS
	ANDI	T3,-1(T1)	;MASK PC TO NEW BLOCK SIZE
	CAMN	T3,BLDPAT	;DOES PC MATCH NEW PATTERN?
	JRST	LLEQL9		;YES, USE IT
	MOVE	T3,N		;GET PC AGAIN
	AND	T3,LOCAST	;SAVE STATE OF * BITS
	IOR	N,LOCAST	;THEN FORCE THEM TO CARRY
	AOBJP	N,.+1		;PICK NEXT PC IN BLOCK
	IOR	N,LOCPAT	;RESET BIT CARRIED OUT OF
	ANDCM	N,LOCAST	;CLEAR OUT DON'T CARE BITS
	IOR	N,T3		;SET ANY WHICH WERE SET BEFORE
	JUMPL	N,LOCB4		;LOOP IF ANY MORE IN THIS BLOCK
LOCB5:	MOVEM	T1,FRECNT	;SAVE NEW PARAMETERS
	MOVEM	T2,LOCPAT
	MOVEM	T4,LOCAST
	MSG LOCB7, NO SUCH MICRO WORD ADR PATTERN IN CURRENT BLOCK


LOCB6:	MOVEM	T1,FRECNT	;YES, STORE NEW BLOCK SIZE AWAY
	MOVEM	T2,LOCPAT	; ALSO BIT PATTERN
	MOVEM	T4,LOCAST	; AND * PATTERN
	PUSHJ	P,LENCAL	;GET LENGTH OF 1'S & 0'S
	CAMGE	T1,HGHEQL	;START NEW EQUAL PATTERN?
	JRST	LLXP		; NO, WAIT TILL A LATER PASS
LOCB7:	PUSHJ	P,FREWRD	;DOESN'T FIT
	 MSG LLXP, NO SUCH REQUIRED MICRO WORD ADDRESS PATTERN
LLEQL9:	POP	P,T1
LLEQ99:	MOVEM	N,PC(RAM)	;SAVE NEXT PC LOCATION
	TRO	F,UPCF		;SET USED PC FLAG
LLXIT:	POPJ	P,

LLZSKP:	AOSA	(P)		;RETURN WILL ADVANCE TO NEXT U-WORD
LLXP:	POP	P,N
LLZERO:	SETZM	PC(RAM)		;DON'T ASSIGN LOC NOW
	TRZ	F,UPCF		;  AND DEASSIGN IF ASSIGNED
	JRST	LLXIT
;SUBROUTINE TO CALCULATE LENGTH OF CONSTRAINT STRING
; ONES AND ZEROS ONLY

LENCAL:	LDB	T2,ASTPNT	;GET ASTERISK PATTERN
	LDB	T1,EQLSIZ	;GET LENGTH OF ENTIRE STRING
	MOVE	T3,MACHT	;GET MACHINE-SPECIFIC FEATURE CONTROL
	CAIN	T3,M$KL10
	JRST	[CAIL	T1,^D9		;IF A LONG CONSTRAINT,
		ADDI	T1,5		;  INCREASE LENGTH IN ORDER TO GET
		JRST	.+1]		;    IT PROCESSED EARLIER
	CAIN	T3,M$STAR
	JRST	[CAIGE	T1,4		;IF LOW FOUR BITS CONSTRAINED
		JRST	.+1
		CAIGE	T1,^D12		; OR LONG CONSTRAINT
		TRNN	T2,17		;REALLY CONSTRAINED, THAT IS
		ADDI	T1,3		;GIVE EXTRA WEIGHT TO REQUEST
		JRST	.+1]
	JUMPN	T2,[	ANDI T2,-1(T2)
			SOJA T1,.]
	POPJ	P,		;RETURN WITH LENGTH IN T1
;SEARCH PASS 1 LIST STRUCTURE TO FIND ALL ENTRIES
	;SUBR CALL IF LOCATION NOT ASSIGNED
	;SUBR CALL IF LOCATION IS ASSIGNED
	;SUBR CALL FOR "NUMBER:"
	;SUBR CALL FOR "TAG:"
	;SUBR CALL FOR "="
	;RETURN

LALSRC:	MOVEM	N,PCTYPE#	;SAVE CHAR FOR "LOCATION/LINE" INDEX
	HLRZ	N,LALHED
LALS1:	JUMPE	N,[	POP P,T1
			JRST 5(T1) ]
	PUSH	P,N
	HRRZ	T2,LALLIN(N)	;COPY LINE# INTO STANDARD PLACE SO
	MOVEM	T2,LINNUM	;  ERROR MSG'S WILL BE REASONABLE
	TRZ	F,UPCF		;CLEAR "USED PC" FLAG
	LDB	T1,LALUSD	;GET "ASSIGNED" FLAG
	ADD	T1,-1(P)	;CALC CO-ROUTINE CALL ADR
	XCT	(T1)		;  AND CALL FOR ASSIGNED OR NOT
	 TROA	F,LALF		;SET FLAG FOR PROCESSING CONSTRAINTS
	TRZ	F,LALF		;CLEAR IT
	MOVE	N,(P)		;RECOVER ADDRESS OF LAL ENTRY
	HLRZ	N+1,LALPNT(N)	;GET ADDRESS OF CODE/VALUE LIST, IF ANY
LALS2:	JUMPE	N+1,LALS5
	LDB	T1,[POINT 4,LALCD(N+1),35]	;GET CODE TYPE
	PUSH	P,N+1
	CAIG	T1,3
	CAIGE	T1,1
	JRST	[CAIN	T1,.LLFIL	;IS THIS A NEW-FILE ENTRY?
		JRST	LALFIL		;YES, SPECIAL PROCESSING
		CAIN	T1,.LLRGN	;IS IT A REGION ENTRY?
		JRST	LALRGN		;YES.
		MSG LALS3, ILL CODE TYPE IN "ALLOC"
		]
	ADD	T1,-2(P)	;CONSTRUCT CALL ADR
	TRNE	F,LALF		;SHOULD CO-ROUTINE BE INVOKED?
	XCT	1(T1)		;YES, CALL IT
LALS3:	POP	P,N+1
	HLRZ	N+1,LALCD(N+1)
	MOVE	N,(P)
	JRST LALS2
;HERE AFTER PROCESSING ALL CONSTRAINTS AND TAGS FOR THIS MICROINSTR

LALS5:	TRNN	F,UPCF		;WAS A LOCATION ASSIGNED?
	JRST	LALS6		;NO
	MOVE	T1,PC(RAM)
	MOVEM	T1,LALLOC(N)	;GET U-WORD LOCATION BACK
	MOVE	T1,PCTYPE#
	IORI	T1,1B18		;SET "ASSIGNED" FLAG
	HRLM	T1,LALLIN(N)	;STORE ASSIGNED, AND HOW INDICATOR
	PUSHJ	P,USEDPC	;MARK IT AS USED
LALS6:	POP	P,N
	HRRZ	N,LALPNT(N)
	HRRM	N,LALHED	;UPDATE ONLY FOR DEBUGGING EASE
	JRST	LALS1

LALUSD:	POINT 1,LALLIN(N),0	;"ASSIGNED" FLAG
				;  1 IFF LOCATION ALREADY ASSIGNED
				;  0 IF NO LOCATION ASSIGNED YET
EQLSIZ:	POINT 6,LALVL(N+1),5	;LENGTH OF = BIT STRING
PATPNT:	POINT 15,LALVL(N+1),35	;POINTS TO 1 0 PATTERN
ASTPNT:	POINT 15,LALVL(N+1),20	;POINTS TO * PATTERN

;HERE TO CHANGE THE FILE SPEC REPORTED BY ERROR MESSAGES

LALFIL:	HRRZ	T1,LALVL(N+1)	;GET FILE SPEC ADDRESS
	MOVEM	T1,I.SPEC	;SETUP FILE DESCRIPTOR ADDRESS
	PUSHJ	P,GETFIL	;GET NAME OUT OF DESCRIPTOR
	JRST	LALS3

;HERE TO CHANGE THE REGION LIST

LALRGN:	MOVSI	N,-PRFMAX	;PREPARE TO SETUP REGION TABLES
LALR1:	MOVE	T2,LALVL(N+1)	;GET A PREFERENCE REGION ENTRY
	HRRZM	T2,PRFTB2(N)	;SETUP UPPER BOUND
	HLRZM	T2,PRFTB1(N)	;SETUP LOWER BOUND
	JUMPE	T2,LALS3	;QUIT IF END
	PUSHJ	P,REGN5		;GO CALCULATE PCNXT CONTROLS
	ADDI	N+1,1
	AOBJN	N,LALR1		;LOOP OVER ALL REGION ENTRIES
	JRST	LALS3		;RESUME SEARCH FOR LOCATION ASSIGNMENTS
IFN FTULD,<
;OUTPUT "ULD" FILE IN ASCII TEXT
;FIRST SET RADIX TO BE OCTAL
;THEN OUTPUT FIELD DEFINITIONS AND THEIR SYMBOLS, ADDRESS FIELD
;AND ITS LABELS, AND MACRO DEFINITIONS

ULDOUT:	TRNN	F,DOULD		;DO WE WANT A .ULD FILE?
	POPJ	P,0		;NO--DO NOT DUMP TABLES
	PUSH	P,PUTP		;SAVE CURRENT OUTPUT ROUTINE
	MOVEI	T1,PUTU
	MOVEM	T1,PUTP		;SETUP OUTPUT TO ULD FILE
	PUSHJ	P,PRINT
	 ASCIZ	/RADIX /
	MOVE	C,RADIX		;GET RADIX FOR OUTPUT
	PUSHJ	P,PNTDEC	;PUT IT INTO ULD FILE

	PUSHJ	P,ULDFLD	;OUTPUT ALL FIELDS AND THEIR SYMBOLS
;	PUSHJ	P,ULDMAC	;OUTPUT ALL MACROS
	POP	P,PUTP		;RESTORE OUTPUT
	POPJ	P,


REPEAT 0,<
;OUTPUT ALL MACROS AND THEIR RESPECTIVE DEFINITIONS FOR
;"ULD" FILE

ULDMAC:	MOVE	FPNT,MACPNT(RAM)	;GET INITIAL MACRO PTR
	HLRZ	FPNT,SYMLNK(FPNT)	;BYPASS 1ST ITEM -- "MACRO%"
	MOVE	SPNT,FPNT
ULDM1:	JUMPE	FPNT,CRLF	;RETURN IF DONE
	PUSHJ	P,PRINT
	 ASCIZ	/
MACRO /
	MOVEI	N,SYMTXT(FPNT)	;OUPUT MACRO NAME
	PUSHJ	P,PRINT0
	PUSHJ	P,PRINT
	 ASCIZ	/="/
	LDB	N,DEFVAL	;GET PTR TO MACRO EXPANSION
	PUSHJ	P,PRINT0
	PUSHJ	P,PRINT
	 ASCIZ	/"/
	HLRZ	FPNT,SYMLNK(FPNT)
	JRST	ULDM1
>;END REPEAT 0
;OUTPUT FIELD DEFINITIONS AND THEIR RESPECTIVE SYMBOLS

ULDFLD:	MOVEI	FPNT,FLDPNT	;GET PTR TO FIELDS
ULDF2:	HRRZ	FPNT,SYMLNK(FPNT)	;SAVE FIELD PTR
	JUMPE	FPNT,CRLF	;RETURN IF DONE
	MOVE	SPNT,FPNT	;COPY POINTER
	LDB	T1,DEFTYP	;GET RAM NUMBER
	JUMPN	T1,ULDF2	;SKIP DRAM DEFS
	CAMN	FPNT,SWTPNT	;IS THIS CONDITIONAL ASSEMBLY FIELD?
	JRST	ULDF2		;SKIP FIELD
	CAME	FPNT,MACPNT+UCODE
	CAMN	FPNT,MACPNT+DISP	;IS IT EITHER MACRO FIELD?
	JRST	ULDF2		;SKIP FIELD
	MOVEI	N,[ASCIZ /
FIELD /]
	CAME	FPNT,JPNT+UCODE
	CAMN	FPNT,JPNT+DISP	;IS IT A JUMP ADDRESS FIELD?
	MOVEI	N,[ASCIZ /
ADDRESS /]			;YES, USE SPECIAL NAME
	PUSHJ	P,PRINT0	;PUT THAT OUT
ULDF3:	MOVEI	N,SYMTXT(FPNT)	;YES (OR NO), OUTPUT THE FIELD NAME
	PUSHJ	P,PRINT0
	PUSHJ	P,PRINT
	 ASCIZ	/=</
	LDB	T3,DEFPOS	;GET FIELD POSITION
	LDB	C,DEFSIZ	;GET FIELD SIZE
	TRNN	F,RTOL		;LEFT TO RIGHT ASSIGNMENT
	JRST	RL		;NO
	ADDM	T3,C
	SUBI	C,1
	JRST	ULDF4
RL:	SUBM	T3,C
	ADDI	C,1		;GET LEFTBIT POSITION
ULDF4:	PUSHJ	P,PNTDEC	;OUTPUT LEFTBIT POSITION IN DECIMAL
	PUSHJ	P,PRINT
	 ASCIZ	/:/
	MOVE	C,T3		;GET RIGHTBIT POSITION
	PUSHJ	P,PNTDEC	;OUTPUT RIGHTBIT POSITION
	PUSHJ	P,PRINT
	 ASCIZ	/>/
	HLRZ	SPNT,SYMLNK(FPNT)	;GET SYMBOL PTR
ULDSYM:	JUMPE	SPNT,ULDF2	;END OF SYMBOLS OF CURRENT FIELD
	PUSHJ	P,PRINT
	 ASCIZ	/
 /
	MOVEI	N,SYMTXT(SPNT)	;OUTPUT SYMBOL
	PUSHJ	P,PRINT0
	PUSHJ	P,PRINT
	 ASCIZ	/=/
	LDB	C,DEFVAL	;GET SYMBOL VALUE
	PUSHJ	P,PNTOCT		;OUTPUT SYMBOL VALUE
	HLRZ	SPNT,SYMLNK(SPNT)	;GET NEXT SYMBOL
	JRST	ULDSYM
>;END FTULD
;HERE TO START PASS 2 BY LISTING TABLE OF CONTENTS, IF ANY

START2:	TRZ	F,ERROR		;INHIBIT TTY OUTPUT
	SETZM	LISTSW		;START WITH LISTING ENABLED
IFN FTULD,<
	PUSHJ	P,ULDOUT	;START PASS2 BY OUTPUTING FIELDS,
>;END FTULD			;ADDRESSES AND MACROS OF "ULD" FILE
	TRNN	F,HEXF		;RADIX 8 OR 16?
	TDZA	N,N		;8.  CLEAR N
	MOVEI	N,1		;16.  SET 1 AS INDEX
	MOVE	T1,[EXP ^D12,^D16](N)	;GET OUTPUT GROUP SIZE (BITS)
	MOVEM	T1,GRPSIZ
	MOVE	T1,HIGHPC+UCODE	;GET HIGHEST LOC'N USED
	CAMGE	T1,HIGHPC+DISP	; IN EITHER RAM
	MOVE	T1,HIGHPC+DISP
	JFFO	T1,.+1		;FIND MSB OF HIGHEST PC
	MOVEI	T1,^D36+2(N)	;ADD 2 BITS IF OCTAL, 3 IF HEX
	SUBI	T1,(T2)		;GET # OF BITS+(2 OR 3) IN HIGH PC
	IDIV	T1,[EXP 3,4](N)	;COMPUTE NO OF DIGITS REQ'D FOR ADDR
	MOVEM	T1,ADRCOL	;SAVE # OF COLUMNS FOR ADDRESS

	SKIPN	T1,WIDTH+DISP	;USE SPECIFIED WIDTH IF SPECIFIED
	MOVE	T1,MAXPOS+DISP	;GET # BITS-1 IN RAM
	IDIV	T1,GRPSIZ
	ADDI	T1,1		;GET NUMBER OF GROUPS FOR DRAM
	MOVEM	T1,GRPCNT+DISP

	SKIPN	T1,WIDTH+UCODE	;USE SPECIFIED WIDTH IF SPECIFIED
	MOVE	T1,MAXPOS+UCODE	;# OF BITS-1 IN URAM
	IDIV	T1,GRPSIZ
	ADDI	T1,1		;GET NUMBER OF GROUPS FOR CRAM
	MOVEM	T1,GRPCNT+UCODE

	CAMGE	T1,GRPCNT+DISP
	MOVE	T1,GRPCNT+DISP	;GET MAX OF THE TWO
	IMULI	T1,5		;5 CHARACTERS PER GROUP
	ADDI	T1,3		;PLUS U & 2 SPACES (EXTRA CHARACTERS)
	ADD	T1,ADRCOL	;PLUS COLUMNS FOR ADDRESS
	MOVEM	T1,SRCCOL	;GIVES SOURCE COLUMN NO
;HERE TO LIST TABLE OF CONTENTS, IF ANY

	SKIPE	N,TTLPNT	;IS THERE A TITLE?
	OUTSTR	(N)		;YES, SEND TO TTY
	OUTSTR	[ASCIZ /
/]
	SKIPN	TOCPNT		;ANYTHING FOR TABLE OF CONTENTS?
	JRST	TOCEND		;NO
	MOVEI	C,[ASCIZ /Table of Contents/]
	PUSHJ	P,SETHDR	;SETUP SPECIAL HEADER
	HLRZ	N,TOCPNT	;BEGIN SCAN OF TOC LIST
TOCLUP:	PUSH	P,N		;SAVE ADDR OF THIS ENTRY
	PUSHJ	P,PRINT
	 ASCIZ	/; /		;OUTPUT AS COMMENT

	MOVE	N,0(P)		;PICK UP ENTRY ADDR
	HRRZ	C,0(N)		;LINE NUMBER OF DEFINITION
	PUSHJ	P,PNTDEC	;IN DECIMAL
	PUSHJ	P,TAB

	MOVE	N,0(P)		;ENTRY ADDR AGAIN
	MOVEI	N,1(N)		;POINT TO TEXT
	PUSHJ	P,PRINT0	;PRINT IT
	PUSHJ	P,NEWLIN

	POP	P,N		;PICK UP LINK
	HLRZ	N,0(N)		;GET ADDR OF NEXT ENTRY
	JUMPN	N,TOCLUP	;PRINT IT IF IT EXISTS
;ALSO NOTE ASSEMBLER-GENERATED STUFF

	PUSHJ	P,PRINT
	 ASCIZ \;	Cross Reference Index
\
	TRNN	F,DRAMF		;ANY DRAM STUFF?
	JRST	TOCLOC		;NO
	PUSHJ	P,PRINT		;YES, MENTION IT HERE
	 ASCIZ \;	DCODE Location / Line Number Index
\
TOCLOC:	PUSHJ	P,PRINT
	 ASCIZ \;	UCODE Location / Line Number Index
\
	SETZM	HDRPNT		;TURN OFF SPECIAL HEADERS
TOCEND:	PUSHJ	P,FORM		;THROW A PAGE
	POPJ	P,		;AND RETURN FOR PASS 2
;FIELD/ SCANNED.  COULD BE CONDITIONAL ASSEMBLY

CFSPC:	IFN FTIF,<
	LDB	T1,[POINT 7,NAME,6]
	CAIE	T1,"."		;ALL PSEUDO OPS BEGIN .
	JRST	CFSPC1		;AVOID FUTILE SCAN
	MOVEI	FPNT,PSUDF%	;PSEUDO FIELD TABLE
	PUSHJ	P,SRCSY1	;IS IT A DEFINED PSEUDO-FIELD?
	  JRST	CFSPC1		;NO, TRY FOR NORMAL FIELD
	LDB	T1,DEFVAL	;YES, GET HANDLER ADDRESS
	JRST	0(T1)		;GO TO IT

;HERE FOR FIELD SCANNED WHILE ASSEMBLY IS SUPPRESSED.
; LOOK FOR .IF, .IFNOT, OR .ENDIF ONLY

CFSUP:	LDB	T1,[POINT 7,NAME,6]
	CAIE	T1,"."		;ALL PSEUDO OPS BEGIN .
	JRST	SCNEND		;NO, IGNORE THE FIELD
	MOVEI	FPNT,PSUDS%	;PSEUDO FIELD TABLE
	PUSHJ	P,SRCSY1	;IS IT A DEFINED PSEUDO-FIELD?
	JRST	SCNEND		;NO, IGNORE THE FIELD
	LDB	T1,DEFVAL	;YES, GET HANDLER ADDRESS
	JRST	0(T1)		;GO TO IT
;STILL IN FTIF

$DEFLT:	MOVEI	T1,1		;SET SWITCH IF NOT DEFINED
	JRST	SWT
$SET:	TDZA	T1,T1		;ERROR IF SWITCH PREVIOUSLY DEFINED
$CHNG:	SETO	T1,		;ERROR IF SWITCH NOT DEFINED
SWT:	MOVEM	T1,SWTFLG#
	PUSH	P,RAM		;SWITCHES ARE NOT RAM-SPECIFIC
	MOVEI	RAM,0
	SKIPE	FPNT,SWTPNT	;IS THE SWITCH% FIELD DEFINED?
	JRST	SWT1		;YES, AVOID SEARCH
	MOVE	T1,[SWTCH,,FIELD]
	BLT	T1,FIELD+NWORDS-1
	PUSHJ	P,MAKFLD	;CREATE INTIAL SWITCH FIELD
	 MSG STOP, !!CAN'T DEFINE "SWITCH%"!!
	MOVEM	FPNT,SWTPNT
SWT1:	MOVE	T1,[NAME,,FIELD]
	BLT	T1,FIELD+NWORDS-1
	PUSHJ	P,TOKEN		;GO GET SWITCH NAME
	CAIE	N,.TKS		;IT MUST BE SYMBOLIC
	MSG SWT99, NO SYMBOL IN CONDITIONAL ASSEMBLY DEFINITION
	PUSHJ	P,SRCSYM	;GO LOOK FOR SYMBOL
	 JRST	SWT2		;NOT FOUND
	SKIPLE	SWTFLG		;FOUND.  IS THIS A DEFAULT?
	JRST	SWT99		;YES -- DEFAULT HAS BEEN PREVIOUSLY SET
	TRNN	F,PASS2		;IS IT PASS1?
	SKIPE	SWTFLG		; AND A SET?
	JRST	SWT3		;NO, GO CHANGE VALUE
	MSG SWT3, SWITCH SET TWICE
SWT2:	SKIPGE	SWTFLG		;IS THIS A CHANGE?
	MSG .+1, SWITCH CHANGED WITHOUT SET OR DEFAULT
	PUSHJ	P,MAKS1		;FILL IN SYMBOL ENTRY
	 JRST	SWT99		;CAN'T CREATE IT
SWT3:	CAIE	C,"="		;DID SWITCH NAME TERMINATE WITH EQUAL?
	MSG SWT99, FORMAT ERROR ON SWITCH SPECIFICATION
	PUSHJ	P,TOKEN		;GO GET SWITCH VALUE
	CAIE	N,.TKN
	MSG SWT99, SWITCH VALUE MUST BE NUMERIC
	MOVE	N,NUMBER	;GET SWITCH VALUE
	PUSHJ	P,DEFCHK	;CHECK VALUE, SET DEFINE BIT
	  HALT	DEFVAL		;PUT INTO VALUE OF SYMBOL
SWT99:	POP	P,RAM		;RESTORE CURRENT RAM
	SETZM	STATE
	SETZM	FIELD
	JRST	SCNEND		;IGNORE REST OF LINE
;HERE FOR REGION PSEUDO-OP

$REGN:	SETZM	PREFX#		;INDEX INTO PREFERENCE TABLES
	CAIE	RAM,UCODE
	MSG REGN99, REGIONS ALLOWED IN UCODE ONLY

REGN1:	PUSHJ	P,TOKEN		;GET BEGINNING OF REGION
	CAIE	N,.TKN		;MUST BE NUMERIC
	MSG REGN3, REGION LOWER BOUND MUST BE NUMERIC
	HRRZ	T1,NUMBER	;GET LOWER BOUND
	MOVE	N,PREFX		;GET INDEX INTO TABLE
	MOVEM	T1,PRFTB1(N)	;STORE LOWER BOUND
	CAIE	C,","		;COMMA SEPARATES LOWER FROM UPPER BOUND
	MSG REGN3, REGION BOUNDS MUST BE SEPARATED BY COMMA

	PUSHJ	P,TOKEN		;GO GET UPPER BOUND
	CAIE	N,.TKN
	MSG REGN3, REGION UPPER BOUND MUST BE NUMERIC
	HRRZ	T1,NUMBER	;GET UPPER BOUND
	MOVE	N,PREFX		;GET INDEX INTO TABLE
	MOVEM	T1,PRFTB2(N)	;STORE UPPER BOUND
	CAILE	T1,MAXPC	;IS IT REASONABLE?
	MSG REGN2, REGION LIMIT TOO LARGE FOR MAXPC
	CAMG	T1,PRFTB1(N)	;UPPER LIMIT MUST BE GREATER THAN LOWER
	MSG REGN2, REGION UPPER BOUND MUST BE GREATER THAN LOWER BOUND

	PUSHJ	P,REGN5		;CONVERT TO MORE CONVENIENT FORM FOR FREE SRCH

	CAIE	C,"/"		;ARE THERE MORE REGIONS TO BE DESCRIBED?
	JRST	REGN3		;NO
	AOS	T1,PREFX	;YES.  COUNT NUMBER OF REGIONS
	CAILE	T1,PRFMAX	;DO WE HAVE ROOM FOR MORE?
	MSG REGN3, TOO MANY REGIONS
	JRST	REGN1
;HERE AFTER PROCESSING REGION STATEMENT

REGN2:	CAIN	C,"/"		;FOUND A BAD REGION DEF.  ARE THERE MORE?
	JRST	REGN1		;YES, TRY TO PROCESS THEM

REGN3:	TRNE	F,PASS2		;STORE INTO LAL ON PASS1 ONLY
	JRST	REGN99
	MOVE	N,PREFX
	ADDI	N,2		;ALLOW 1 FOR LINK/CODE, 1 FOR STOPPER WORD
	ADDM	N,LALCOR
	PUSHJ	P,GETWRD	;OBTAIN CORE FOR REGION SPEC ON LAL
	PUSHJ	P,LALLNK	;LINK IT TO LAST ITEM ON LAL
	MOVEI	T1,.LLRGN	;TYPE CODE FOR LAL CODE/VALUE LIST
	MOVEM	T1,0(N)
	ADDI	N,1		;POINT TO FIRST REGION ENTRY
	HRLI	N,T2		;MAKE ADDRESS INTO INDIRECT (INDEXED) POINTER
	MOVEI	T2,0
REGN4:	HRLZ	T1,PRFTB1(T2)
	HRR	T1,PRFTB2(T2)
	MOVEM	T1,@N		;COPY REGION DESCRIPTOR TO LAL ENTRY
	JUMPE	T1,REGN99	;STOP AFTER ALL REGIONS IN LAL ENTRY
	AOJA	T2,REGN4	;GO TO NEXT

REGN99:	SETZM	STATE		;DO NOT EXPECT SYMBOL HERE
	JRST	SCNEND

;HERE IS SUBROUTINE TO CONVERT REGION SPEC TO FORM SUITABLE FOR PCNXT1

REGN5:	MOVE	T1,PRFTB1(N)	;BEGIN TO BUILD AOBJN POINTER
	IDIVI	T1,^D36		;GET LOC IN USAGE OF FIRST WORD OF REGION
	MOVNI	T2,(T2)		;GET ADDITIONAL BIT POSITION
	MOVEI	T3,1		;SETUP TO BUILD MASK
	LSH	T3,^D36(T2)	;BIT IN LAST POSITION TO BE IGNORED
	SUBI	T3,1		;GET ONES IN BITS TO BE CONSIDERED
	MOVEM	T3,PRFTB4(N)	;SAVE MASK FOR FREE SEARCHES

	ADD	T2,PRFTB1(N)	;GET ADDR OF FIRST BIT IN THIS WORD OF USAGE
	SUB	T2,PRFTB2(N)	;GET DIFFERENCE OF ADDRESSES
	SUBI	T2,^D35		;ENSURE ROUNDING UP
	IDIVI	T2,^D36		;GET NEGATIVE # OF WORDS TO SCAN IN USAGE
	HRL	T1,T2		;COMBINE WITH INDEX INTO USAGE
	MOVEM	T1,PRFTB3(N)	;STORE AS AOBJN POINTER
	SETZM	PRFTB3+1(N)	;END TABLE THEREAFTER
	POPJ	P,
;HERE TO SPECIFY CONTROL STORE WIDTH

$WIDTH:	PUSHJ	P,TOKN10	;GET DECIMAL ARGUMENT
	CAIE	N,.TKN		;IS IT NUMERIC?
	MSG	WID99, WIDTH ARGUMENT MUST BE DECIMAL NUMBER
	SOS	T1,NUMBER	;GET THE MAX BIT # OF THE WORD
	MOVEM	T1,WIDTH(RAM)	;SETUP WIDTH OF THIS RAM
WID99:	SETZM	STATE
	JRST	SCNEND

;HERE FOR MACHINE SELECTION PSEUDO OP

$MACH:	MOVE	T1,[NAME,,FIELD]
	BLT	T1,FIELD+NWORDS-1
	PUSHJ	P,TOKEN		;COLLECT SELECTION SYMBOL
	CAIE	N,.TKS
	MSG MACH99, NO SYMBOL IN MACHINE OPERATOR
	MOVEI	FPNT,MACHL
	PUSHJ	P,SRCSY1	;MATCH A SYMBOL
	 MSG MACH99, UNKNOWN MACHINE TYPE
	LDB	T1,DEFVAL
	MOVEM	T1,MACHT	;SELECT MACHINE TYPE
MACH99:	SETZM	STATE
	JRST	SCNEND
;HERE FOR CONDITIONAL ASSEMBLY TEST PSEUDO-OPS
; ** NOTE-- WE GET HERE EVEN WITH ASSEMBLY SUPPRESSED **

$ENDIF:	MOVEI	T1,1
	JRST	IF1
$IF:	TDZA	T1,T1
$IFNOT:	MOVNI	T1,1
IF1:	MOVEM	T1,SWTFLG	;FLAG TO INVERT ASSEMBLY SENSE
	PUSHJ	P,TOKEN
	CAIE	N,.TKS		;SWITCH MUST BE SYMBOLIC
	MSG IF99, SWITCH MUST BE SYMBOLIC
	SKIPE	FPNT,SWTPNT
	PUSHJ	P,SRCSYM	;GO LOOK FOR SWITCH SYMBOL
	 MSG IF99, SWITCH NOT DEFINED
	TRNN	F,SUPP		;CURRENTLY SUPPRESSED?
	JRST	IF3		;NO
	CAME	SPNT,SUPSYM	;IS THIS THE SYMBOL WHICH SUPPRESSED?
	JRST	SCNEND		;NO, IGNORE
IF3:	MOVEM	SPNT,SUPSYM	;SAVE SUPPRESSION SYMBOL
	LDB	T1,DEFVAL	;GET SWITCH VALUE
	SKIPG	SWTFLG		;VALUE IRRELEVANT ON ENDIF
	SKIPE	T1		;SWITCH SET?
	TRZA	F,SUPP
	TRO	F,SUPP		;SUPPRESS ASSY
	SKIPGE	SWTFLG		;INVERT SENSE?
	TRC	F,SUPP
IF99:	MOVEI	T1,0
	TRNE	F,SUPP		;NOW...ARE WE SUPPRESSED?
	MOVEI	T1,4_<.SZTOK+.SZTRM>
	MOVEM	T1,STATE	;STATE 0 IF ASSEMBLING, 4 IF SUPPRESSED
	JRST	SCNEND

CFSPC1:
>;END IFN FTIF
FLDSPC:	MOVE	T1,[NAME,,FIELD]
	BLT	T1,FIELD+NWORDS-1	;MOVE NAME TO FIELD
	POPJ	P,
;FIELD/NUMBER SCANNED, INSERT VALUE INTO MICRO WORD

FLDNUM:	PUSHJ	P,SRCFLD
	 JRST	FLDS1
	LDB	T2,DEFSIZ	;GET SIZE OF FIELD
	SETOM	T1		;1S INTO T1
	LSH	T1,(T2)		;0S ON RIGHT EQUAL TO BYTE LENGTH
	MOVE	N,NUMBER
	MOVM	T2,N		;SAVE POS VAL OF NUMBER
	TDZ	N,T1		;MASK NUMBER TO CORRECT SIZE
	TDNE	T2,T1		;WILL NUMBER FIT IN FIELD?
	MSG FLDN2, NUMBER TOO BIG FOR FIELD
	PUSHJ	P,BITS1		;NUMBER ALWAYS GOES INTO FIELD
FLDN2:	PUSHJ	P,MAKCRF	;PUT FIELD INTO CREF LISTING
	JRST	FLDS99

;FIELD/SYMBOL SCANNED, INSERT VALUE INTO MICRO WORD

FLDSYM:	PUSHJ	P,SRCFLD
FLDS1:	 MSG FLDS99, FIELD NOT DEFINED
	PUSHJ	P,SRCSYM
	 TRCA	RAM,DISP!UCODE	;NOT FOUND, LOOK IN OTHER TABLE
	JRST	FLDS3		;FOUND
	PUSH	P,FPNT		;SAVE FIELD POINTER
	PUSHJ	P,SRCFLD	;FIND OTHER FIELD, IF ANY
	 JRST	FLDLUZ		;NONE
	PUSHJ	P,SRCSYM
	 JRST	FLDLUZ		;NO SYMBOL IN OTHER FIELD EITHER
	POP	P,FPNT		;GET CORRECT FIELD BACK
	TRC	RAM,DISP!UCODE	;PUT MODE BACK
FLDS3:	LDB	T1,DEFTM1	;GET 1ST TIME
	ADDM	T1,TIME1	;ACCUMULATE SUM
	LDB	T1,DEFTM2	;SAME FOR 2ND TIME
	ADDM	T1,TIME2
	LDB	T1,DEFFNC
	MOVE	T1,DEFTAB(T1)
	PUSHJ	P,(T1)		;DISPATCH ON FUNCTION
FLDS99:	TRO	F,BINF
ZFPOPJ:	SETZM	FIELD		;NO CARRY OVER OF FIELD NAMES
	POPJ	P,

FLDLUZ:	POP	P,FPNT		;ADJUST STACK
	TRC	RAM,DISP!UCODE	;PUT MODE BACK
	MSG	FLDS99, SYMBOL NOT DEFINED
; PSEUDO INSTRUCTION SCANNED, (MAY BE MACRO NAME)

PSEUDO:	MOVEI	FPNT,PSUDO%	;PSEUDO SYMBOL TABLE
	PUSHJ	P,SRCSY1	;IS IT A DEFINED PSEUDO OP?
	  JRST	BEGMAC		;NO, SEE IF IT'S A MACRO
	LDB	T1,DEFVAL	;YES, GET HANDLER ADDRESS
	JRST	0(T1)		;GO TO IT

$DCODE:	MOVEI	RAM,DISP
	TRO	F,DRAMF		;WE'RE USING DRAM FEATURE
	POPJ	P,

$UCODE:	MOVEI	RAM,UCODE
	POPJ	P,

$RTOL:	TRO	F,RTOL		;SET RIGHT TO LEFT BIT ASSIGNMENT
	POPJ	P,

$BIN:	AOSA	DOBIN
$NOBIN:	SOS	DOBIN
	POPJ	P,0

$CREF:	AOSA	DOCREF		;ENABLE CREF
$NOCRF:	SOS	DOCREF
	POPJ	P,

$SEQU:	TROA	F,SEQUEN
$RAND:	TRZ	F,SEQUEN
	POPJ	P,

$HEX:	TRO	F,HEXF
	MOVEI	T1,^D16
	MOVEM	T1,RADIX
	POPJ	P,

$OCTAL:	TRZ	F,HEXF
	MOVEI	T1,^D8
	MOVEM	T1,RADIX
	POPJ	P,

$PAGE:	TRNN	F,PASS2		;IGNORE ON PASS1
	POPJ	P,
	PUSH	P,C
	PUSHJ	P,FORM
	POP	P,C
	POPJ	P,

$LIST:	AOSA	LISTSW
$NOLIS:	SOS	LISTSW
	POPJ	P,
; MACRO CALL SCANNED
;COMMENTED LINES BUMMED OUT FOR SPEED

BEGMAC:	CAML	PM,[-4,,0]	;IS THERE SPACE FOR A MACRO ON STACK?
	MSG MACX, EXCESSIVE MACRO NESTING
			;OUGHT TO SUPPRESS ON PASS1, CAN'T DUE TO
			;STATE PROCESSING TROUBLES
	PUSH	PM,C		;SAVE CURRENT CHARACTER
	PUSH	PM,CHRPNT	;AND INPUT POINTER
	PUSH	PM,[0]		;AND COUNT OF ACTUALS
	MOVE	T1,[POINT 7,NAME]	;RESCAN MACRO
	MOVE	T2,T1
MAC1:	ILDB	C,T1		;LOOK AT NEXT CHAR OF MACRO NAME
	JUMPE	C,MAC5		;STOP IF LAST ONE
	CAIN	C,135		;IS THIS UNMATCHED CLOSE BRACKET?
	MSG MACLUZ, UNMATCHED CLOSE BRACKET IN MACRO INVOCATION
MAC2:	IDPB	C,T2		;PUT IT INTO MACRO NAME
	CAIE	C,133		;DOES IT SIGNAL BEGINNING OF ACTUAL?
	JRST	MAC1		;NO, KEEP LOOKING

;HERE WHEN OPEN BRACKET FOUND.  SCAN OFF THE ACTUAL, SAVING ON PM

	CAML	PM,[-NWORDS-1,,0]	;IS THERE SPACE FOR MORE ON MACRO STACK?
	MSG MACLUZ, EXCESSIVE MACRO NESTING
	AOS	T3,0(PM)	;GET COUNT OF ACTUALS INCREMENTED
	ADD	PM,[NWORDS,,NWORDS]	;MAKE SPACE FOR ANOTHER
	MOVEM	T3,0(PM)	;STORE UPDATED ACTUALS COUNT
..N==0
REPEAT NWORDS,<..N==..N-1
	SETZM	..N(PM)	>
	MOVE	T3,[POINT 7,-NWORDS(PM)]
	MOVEI	T4,0		;COUNT OF NESTED BRACKET PAIRS
MAC3:	ILDB	C,T1		;GET CHARACTER OF ACTUAL
	CAIN	C,133		;ANOTHER OPEN BRACKET?
	ADDI	T4,1		;YES, COUNT THE NESTING LEVEL
	CAIN	C,135		;A CLOSE BRACKET?
	SOJL	T4,MAC2		;YES, IF MATCHED, END OF ACTUAL
	IDPB	C,T3		;NO, STORE CHAR IN ACTUAL
	CAMN	T3,[POINT 7,-1(PM),27]	;ARE WE OUT OF SPACE FOR ACTUAL?
	SETZ	T3,		;YES, STOP STORING IT
	JUMPN	C,MAC3		;KEEP COLLECTING UNLESS TEXT STOPS
	MSG MACLUZ, UNMATCHED OPEN BRACKETS IN MACRO INVOCATION
;HERE AFTER REMOVING ACTUALS FROM MACRO INVOCATION, LEAVING NAME IN "NAME"

MAC5:	IDPB	C,T2		;CLEAR REST OF "NAME"
	TLNE	T2,(76B5)
	JRST	MAC5		;STORE BYTES TO END OF WORD
	MOVEI	T2,1(T2)	;ADDRESS OF NEXT WORD
MAC6:	SETZM	0(T2)		;CLEAR IT
	CAIGE	T2,NAME+NWORDS	;IS THAT ENOUGH TO GET GOOD SYMBOL MATCH?
	AOJA	T2,MAC6		;NO, GO CLEAR MORE

;	MOVE	T1,[MACRO,,FIELD]	;LOOK FOR MACRO DEF
;	BLT	T1,FIELD+NWORDS-1
;	PUSHJ	P,SRCFLD
;	  MSG ZFPOPJ, NO MACROS DEFINED
	SETZM	FIELD
	SKIPE	FPNT,MACPNT(RAM)	;AVOID FIELD SEARCH
	PUSHJ	P,SRCSYM		;LOOK FOR DEFINITION
	 MSG MACLUZ, MACRO NAME NOT DEFINED
	LDB	N,DEFVAL	;GET POINTER TO MACRO
	HRLI	N,(POINT 7,0)
	MOVEM	N,CHRPNT	;SET IT UP FOR INPUT PROCESSING
	MOVEI	C,","		;MACRO MUST NOT INVOKE END-OF-LINE ACTIONS
	JRST	ZFPOPJ

MACLUZ:	PUSHJ	P,POPMAC	;UN-NEST THIS MACRO
MACX:	LDB	T1,STAPNT	;GET CHAR TYPE
	CAIN	T1,EOL		;END OF LINE?
	SETZM	STATE		;YES, RETURN TO STATE ZERO
	JRST	ZFPOPJ

;HERE TO REMOVE A MACRO INVOCATION FROM THE PARSING STACK

POPMAC:	POP	PM,C		;GET COUNT OF ACTUALS
	HRRZS	C		;IGNORE GARBAGE ON LH
	IMULI	C,NWORDS	;GET AMOUNT OF SPACE USED FOR ACTUALS
	HRLI	C,(C)		;COPY TO BOTH HALVES
	SUB	PM,C		;DROP ACTUALS FROM STACK
	POP	PM,CHRPNT	;NOW RESTORE INPUT POINTER
	POP	PM,C		;AND CHARACTER
	POPJ	P,
; SYMBOL: SCANNED, DEFINE ADDRESS TAG

TAG:	SKIPE	FPNT,JPNT(RAM)	;DO WE KNOW WHERE J FIELD IS DEFINED?
	JRST	TAG1		;YES, DO NOT SEARCH
	MOVE	T1,[ASCII /J/]	;NO KNOWN JUMP ADDRESS FIELD, MAKE ONE UP
	MOVEM	T1,FIELD
	SETZM	FIELD+1
	MOVE	T1,[FIELD+1,,FIELD+2]
	BLT	T1,FIELD+NWORDS-1
	PUSHJ	P,SRCFLD
	 MSG TAG99, CAN'T FIND J FIELD
	MOVEM	FPNT,JPNT(RAM)	;REMEMBER FOR FUTURE
	JRST	TAG2		;NOW GO PUT A SYMBOL INTO THE FIELD

TAG1:	HRLZI	T1,SYMTXT(FPNT)	;ADDRESS OF NAME OF FIELD
	HRRI	T1,FIELD
	BLT	T1,FIELD+NWORDS-1	;COPY JUMP FIELD NAME TO FIELD
				; SO ERROR MESSAGES COME OUT RIGHT
TAG2:	PUSHJ	P,MAKSYM
	  JFCL
;ORIGINALLY, TAG WAS CALLED ON BOTH PASSES, AND HERE SHOULD BE:
;	TRNE	F,PASS2
;	JRST	TAG99
; ALSO, THE FOLLOWING CALL TO BEGCRF WOULD BE UNNECESSARY
	PUSHJ	P,BEGCRF	;PUT DEFINE LINE INTO CREF
	PUSH	P,[.LLTAG]	;FLAG FOR "TAG:"
	HRL	SPNT,FPNT	;POINTER TO SYMBOL'S FIELD
	PUSH	P,SPNT		;POINTER TO SYMBOL TABLE ENTRY
	PUSHJ	P,LALSTO	;PUT 1ST PASS ENTRY INTO LIST
;	HRRZ	N,PC(RAM)
;	PUSHJ	P,DEFCHK
;	 HALT	DEFVAL
;	PUSHJ	P,DEFSLS
TAG99:	JRST	ZFPOPJ


;SUBROUTINE TO ADD ONE ENTRY TO LIST OF "CODE AND
;VALUE LIST" OF LOCATION AND ASSIGNMENT LIST
;	-1(P)	NEW CONTENTS OF LALVL
;	-2(P)	NEW CONTENTS OF LALCD
;CALLED BY "PUSHJ P,LALSTO", DESTROYES T1-T4, AND N

LALSTO:	MOVEI	N,LLCDSZ	;GET 2 FREE WORDS FROM STORAGE
	ADDM	N,LALCOR	;TALLY CORE USED FOR LAL
	PUSHJ	P,GETWRD
	PUSHJ	P,LALLNK	;LINK ONTO EXISTING LIST
	POP	P,T1		;GET RETURN OFF STACK
	POP	P,LALVL(N)	;PUT 1ST WORD IN
	POP	P,LALCD(N)	;PUT 2ND WORD INTO ITEM
LALS99:	JRST	(T1)		;RETURN

LALLNK:	HRRZ	T2,LALHED	;GET POINTER TO FOOT OF LIST
	MOVE	T1,T2		;FIND LIST END, APPEND NEXT ITEM
	HLRZ	T2,LALCD(T1)
	JUMPN	T2,.-2
	HRLM	N,LALCD(T1)	
	POPJ	P,
;SET LOCATION COUNTER FOR LEADING BIT PATTERN

LOCBLK:	SETZB	N,BLDPAT#	;INIT COUNT, INIT PATTERN FOR 1'S
	SETZM	BLDAST#		;INIT PATTERN FOR *'S
LOCB1:	PUSHJ	P,GETCHR
	CAIN	C," "
	JRST	LOCB1
	CAIN	C,"0"
	SOJA	N,LOCB1		;COUNT DIGITS
	MOVSI	T1,(1B0)	;GET BIT INTO POSITION FOR PATTERNS
	LSH	T1,(N)
	CAIN	C,"1"
	JRST	[IORM	T1,BLDPAT
		SOJA	N,LOCB1 ]
	CAIN	C,"*"
	JRST	[IORM	T1,BLDAST
		SOJA	N,LOCB1 ]
	MOVNS	N		;GET POSITIVE POSITION COUNT
	MOVEM	C,RRDC		;SAVE CHAR FOR REREAD
	CAIE	C,12
	TRO	F,REREAD	;ONLY BACK UP IF NOT END-OF-LINE
	TRNE	F,SEQUEN	;ARE WE IN FORCED SEQUENTIAL MODE?
	MSG LOCB99, ADDRESS CONSTRAINT ILLEGAL IN SEQUENTIAL MODE
;LOCB2:	
	MOVEI	T1,1		;FIND HOW MANY CONSECUTIVE WORDS
	LSH	T1,(N)		;WORDS=2**NUMBER OF BITS
	MOVE	T2,BLDPAT	;GET BIT PATTERN
	ROT	T2,(N)		;MOVE TO LOW ORDER
;	MOVEM	T2,BLDPAT
	MOVE	T4,BLDAST	;GET * PATTERN
	ROT	T4,(N)
;	MOVEM	T4,BLDAST
	JUMPN	RAM,[MOVE N,PC(RAM)	;GET CURRENT PC
		ANDI	N,-1(T1)	;MASK PC TO RELEVANT BITS
		SUB T2,N	;HOW FAR OFF?
		JUMPE T2,CPOPJ	;XFER IF RIGHT ON
		SKIPGE	T2
		ADD T2,T1	;GET POS VAL, MOD BLOCK SIZE
		ADD N,T2	;ADJUST PC
		JRST	LOCB8
	;	MSG LOCB8, DISP LOCATION CHECK FAILED
		]
	TRNE	F,PASS2
	JRST	LOCB99		;ALL U-WORD CONSTRAINTS DONE IN PASS 1
	PUSH	P,[.LLEQL]
	DPB	N,[POINT 6,T2,5]
	DPB	T4,[POINT 15,T2,20]
	PUSH	P,T2
	PUSHJ	P,LALSTO
	JRST	LOCB99
LOCB8:	MOVEM	N,PC(RAM)	;SET UP FIRST WORD ADDRESS
LOCB99:	POPJ	P,
; NUMBER:  SET LOCATION COUNTER

LOCSET:	SKIPGE	N,NUMBER
	MSG LOCS99, LOCATION NEGATIVE
	CAMLE	N,[EXP MAXPC,MAXDSP](RAM)
	MSG LOCS99, LOCATION TOO LARGE

	JUMPN	RAM,[	HRROM N,PC(RAM)
			JRST LOCS99 ]
	TRNE	F,PASS2
	JRST	LOCS99
	PUSH	P,[.LLNUM]		;"NUMBER:" IS CODE 1
	PUSH	P,N		;SAVE "NUMBER"
	PUSHJ	P,LALSTO	;PUT THESE 2 ENTRIES INTO
				;TABLE FOR PROCESSING ON PASS 1.5
LOCS99:	SETZM	FIELD
	POPJ	P,
;FIELD/= HAS BEEN SCANNED. SO, A MICRO FIELD DEFINITION IS IN PROGRESS.

DEFSYM:	PUSHJ	P,SRCFLD	;FIND THE FIELD
	 MSG DEFS99, UNDEFINED FIELD IN SYMBOL DEFINITION
	PUSHJ	P,MAKSYM	;GO MAKE THE SYMBOL
	  JFCL			;DO CONSISTENCY CHECK
	PUSHJ	P,TOKEN
	CAIE	N,.TKN		;SKIP IF TOKEN NUMERIC
	MSG DEFS99, VALUE REQUIRED IN SYMBOL DEFINITION
	MOVE	N,NUMBER
	PUSHJ	P,DEFCHK
	 HALT	DEFVAL
	PUSHJ	P,DEFSLS
	CAIE	C,","
	JRST	DEFS99
	PUSHJ	P,TOKN10
	MOVE	N,NUMBER
	PUSHJ	P,DEFCHK
	 HALT	DEFTM1		;1ST TIME VALUE
	CAIE	C,","
	JRST	DEFS99
	PUSHJ	P,TOKN10
	MOVE	N,NUMBER
	PUSHJ	P,DEFCHK
	 HALT	DEFTM2		;2ND TIME VALUE
DEFS99:	JRST	SCNEND

DEFSLS:	LDB	T1,DEFPOS
	CAILE	T1,MICMXB
	MSG .+1, POSITION TOO LARGE FOR MICRO WORD
	LDB	T2,DEFSIZ
	TRNN	F,RTOL		;BYPASS IF LEFT TO RIGHT
	JRST	DEFLR
	ADD	T1,T2		;GET LEFTBIT POSITION + 1
	CAILE	T1,MICMXB	;IS LEFTBIT .LE. MAX BIT POSITION?
	MSG .+1, SIZE TOO LARGE FOR POSITION
	JRST	DEFS2
DEFLR:	ADDI	T1,1
	CAMGE	T1,T2
	MSG .+1, SIZE TOO LARGE FOR POSITION
DEFS2:	LDB	T1,DEFVAL
	MOVEI	N,1
	LSH	N,(T2)
	CAMG	N,T1
	MSG .+1, VALUE TOO LARGE FOR FIELD
	POPJ	P,
;HERE WHEN MACRO DEFINITION SCANNED

DEFMAC:	MOVEI	FPNT,PSUDM%	;FIRST CHECK FOR PSEUDO-MACRO
	PUSHJ	P,SRCSY1	;IS IT ONE OF THOSE NAMES?
	  JRST	DEFM0		;NO, DEFINE A REAL MACRO
	LDB	T1,DEFVAL	;YES, GET ADDR OF HANDLER
	JRST	0(T1)

$TITLE:	TRNE	F,PASS2
	JRST	SCNEND		;TREAT AS COMMENT ON PASS 2
	SKIPE	TTLPNT		;DO WE ALREADY HAVE A TITLE
	MSG SCNEND, TITLE MULTIPLY DEFINED
	MOVE	N,.JBFF
	HRRZM	N,TTLPNT	;SAVE ADDRESS INTO WHICH IT IS STORED
	JRST	DEFT2		;GO COLLECT IT

$PAGET:	PUSHJ	P,$PAGE		;.PAGE WITH .TOC STRING
$TOC:	TRNE	F,PASS2		;ENTIRELY DIFFERENT FUNCTION ON PASS2
	JRST	TOC2
	PUSHJ	P,MAKTOC	;CREATE TABLE OF CONTENTS ENTRY
	JRST	DEFT2		;GO COLLECT TEXT FOR IT

TOC2:	HLRZ	N,TOCPNT	;TRY TO FIND THIS ON LIST
TOC3:	HRRZ	T1,0(N)		;GET LINE # OF DEFINITION
	CAMLE	T1,LINNUM	;IS IT OLD FOR THIS LINE?
	MSG STOP, !!TOC LST FOULED UP !!
	CAMN	T1,LINNUM	;IS THIS WHERE WE DEFINED IT?
	JRST	SCNEND		;YES, IT WILL PRINT AS SUBTTL
	HLRZ	N,0(N)		;NO, LOOK AT NEXT
	HRLM	N,TOCPNT
	JRST	TOC3

MAKTOC:	MOVEI	N,1		;LINK WORD
	PUSHJ	P,GETWRD
	SKIPN	T1,TOCPNT	;TOC INITIALIZED?
	MOVEI	T1,TOCPNT	;NO, POINT TO IT
	HRLM	N,0(T1)		;LINK THIS ONE TO LAST ON LIST
	HRRM	N,TOCPNT	;AND NOTE THIS IS NOW LAST

	MOVE	T1,LINNUM
	HRRZM	T1,0(N)		;STUFF LINE # INTO ENTRY
	POPJ	P,
;DEFINE A MACRO

DEFM0:	SKIPE	FPNT,MACPNT(RAM)	;IS THE "MACRO%" FIELD DEFINED?
	JRST	DEFM1		;YES, AVOID SEARCH
	MOVE	T1,[MACRO,,FIELD]	;FORCE FIELD NAME
	BLT	T1,FIELD+NWORDS-1
	PUSHJ	P,MAKFLD	;MAKE INITIAL FIELD FOR MACROS
	 MSG STOP, !!CAN'T DEFINE "MACRO%"!!
	MOVEM	FPNT,MACPNT(RAM)	;REMEMBER FOR FUTURE
DEFM1:	SETZM	FIELD
	PUSHJ	P,MAKSYM
	  JRST	SCNEND
	MOVE	N,.JBFF		;GET ADDRESS FOR STRING
	DPB	N,DEFVAL	; AND SAVE AS VALUE OF MACRO
	PUSHJ	P,DEFSET	;SET DEFINED FLAG
	  JFCL
	TRZA	F,NOXLAT	;ENABLE TRANSLATION FOR MACRO TEXT
DEFT2:	TRO	F,NOXLAT	;DISABLE TRANSLATION FOR .TOC, .TITLE TEXT
	PUSHJ	P,COPMAC	;COPY TEXT INTO SYMBOL TABLE
	JRST	SCNEND

;SUBR TO COPY QUOTED TEXT INTO SYMBOL TABLE

COPMAC:	SETZM	PCORC		;FORCE GETTING NEW CORE IN PUTCOR
CMAC1:	PUSHJ	P,GETCHR
	CAIN	C,12		;EOL?
	MSG CMAC99, MISSING TERMINAL QUOTE
	CAIN	C,42		;TERMINAL QUOTE?
	SETZB	C,C1		;YES, TERMINATE

	TRNE	F,NOXLAT	;INHIBIT TRANSLATION?
	MOVE	C,C1		;YES, GET UNTRANSLATED CHAR BACK
	PUSHJ	P,PUTCOR	;STORE CHAR IN CORE
	JUMPN	C,CMAC1		; COLLECT ASCIZ STRING

CMAC99:	POPJ	P,
;DEFINE A FIELD

DEFFLD:	PUSHJ	P,MAKFLD
	 JFCL			;DO CHECKS ON PASS2 AND PROCESS SYMBOLIC DEFAULTS
	PUSHJ	P,TOKEN		;GET 1ST ARG
	CAIE	N,.TKN
	JRST	DFANG		;FORMAT MAY BE <LPOS:RPOS>
	MOVE	N,NUMBER
	PUSHJ	P,DEFCHK	;CHECK THAT VALUE FITS FIELD
	 HALT	DEFVAL

DEFFL2:	CAIN	C,","		;POSSIBLE 2ND ARG?
	PUSHJ	P,TOKN10	;YES, GO SCAN
	CAIE	N,.TKN
	 MSG .+1, SIZE REQUIRED FOR FIELD DEFINITION
	MOVE	N,NUMBER
	PUSHJ	P,DEFCHK
	 HALT	DEFSIZ

	CAIN	C,","
	PUSHJ	P,TOKN10
	CAIE	N,.TKN
	 MSG .+1, POSITION REQUIRED FOR FIELD DEFINITION
	MOVE	N,NUMBER
	PUSHJ	P,DEFCHK
	 HALT	DEFPOS
	TRNN	F,RTOL			;RIGHT TO LEFT NUMBERING?
	JRST	GETA1			;NO
	LDB	T1,DEFSIZ		;GET FIELD SIZE AGAIN
	SOJLE	T1,GETA1
	ADD	N,T1			;YES, GET HIGHEST BIT POSITION
GETA1:	CAML	N,MAXPOS(RAM)
	MOVEM	N,MAXPOS(RAM)	;KEEP TRACK OF MICRO WORD SIZE
;CONTINUATION OF GETARG -- LOOK AT FOURTH ARGUMENT, IF ANY

	CAIE	C,","
	JRST	GETA6
GETA2:	PUSHJ	P,GETCHR	;4TH ARG IS SINGLE CHAR
	CAIN	C," "
	JRST	GETA2		; BUT FLUSH SPACES
	MOVSI	N,DEFTAB-DEFTND
GETA3:	HLRZ	T1,DEFTAB(N)	;SEARCH TABLE FOR CHARACTER
	CAMN	T1,C
	JRST	GETA5
	AOBJN	N,GETA3
	MSG GETA6, UNDEFINED SPECIAL FUNCTION CHARACTER

GETA5:	HRRZS	N
	PUSHJ	P,DEFCHK
	 HALT	DEFFNC
	HRRZ	T1,DEFTB2(N)	;GET DEFINITION-TIME ACTION
	CAIN	T1,DEFJ
	PUSHJ	P,DEFJ		;CHECK FOR JUMP ADR FIELD
GETA6:	PUSHJ	P,DEFSLS
	JRST	SCNEND

;HERE WHEN THIS FIELD DEFINITION CLAIMS TO BE THE JUMP ADDRESS

DEFJ:	TRNE	F,PASS2
	POPJ	P,		;"J" DEFINITION FOR PASS 1 ONLY
	SKIPE	JPNT(RAM)	;HAS ANY OTHER MADE THIS CLAIM?
	MSG CPOPJ, MORE THAN ONE ADDRESS FIELD DEFINED
	HRRZM	FPNT,JPNT(RAM)	;ESTABLISH THE SYMBOL POINTER
	POPJ	P,
;PROCESS FIELD DEFINITION FOR FORMAT "FIELD/=<LPOS:RPOS>SYMBOL,DEFAULT"
;THE 1ST "LESS THAN" IS USED TO RECOGNIZE THE FORMAT
;"LPOS" IS THE DECIMAL LEFTMOST BIT POSITION IN THE FIELD.
;"RPOS" IS THE DECIMAL RIGHTMOST BIT POSITION IN THE FIELD.
;THE DEFAULT, WHEN PRESENT, DEPENDS ON "SYMBOL"

DFANG:	CAIN	N,.TKB	;TOKEN MUST BE NULL AND BREAK CHAR
	CAIE	C,"<"		; "LESS THAN" OR FORMAT ERROR
DFANG1:	MSG SCNEND, FIELD DEFINITION FORMAT ERROR
	PUSHJ	P,TOKN10	;GET 1ST REAL TOKEN
	CAIE	N,.TKN		;MUST BE REAL AND NUMERIC
	MSG SCNEND, LEFT BIT POSITION NOT NUMERIC
	MOVE	T1,NUMBER	;SAVE LEFT BIT POSITION
	MOVEM	T1,LFTPOS#
	CAIN	C,">"		;IS ONLY ONE NUMBER GIVEN?
	JRST	DFANG6		;YES, ASSUME 1-BIT FIELD
	CAIE	C,":"		;BIT POSITION SEPARATOR SHOULD BE COLON
	MSG .+1, COLON MUST SEPARATE BIT POSITIONS
	PUSHJ	P,TOKN10
	CAIE	N,.TKN
	MSG SCNEND, RIGHT BIT POSITION NOT NUMERIC
DFANG6:	MOVE	N,NUMBER		;PICK UP RIGHT BIT POSITION
	CAMGE	N,LFTPOS#		; AND GET LARGER IN "NUMBER",
	EXCH	N,LFTPOS#		;  AND SMALLER IN "LFTPOS"
	MOVEM	N,NUMBER
	CAML	N,MAXPOS(RAM)
	MOVEM	N,MAXPOS(RAM)		;KEEP TRACK OF MICRO WORD SIZE
	SUB	N,LFTPOS#		;CALCULATE FIELD SIZE
	ADDI	N,1			; ...
	PUSHJ	P,DEFCHK
	  HALT	DEFSIZ			;AND STORE IN FIELD DEFINTION
	MOVE	N,NUMBER
	TRNE	F,RTOL
	MOVE	N,LFTPOS		;IF R TO L, POS IS SMALLER NUMBER
	PUSHJ	P,DEFCHK
	  HALT	DEFPOS			;STORE POSITION IN FIELD DEF
	CAIE	C,">"
	JRST	DFANG1		;FORMAT ERROR
DFANG2:	PUSHJ	P,TOKEN		;GET DEFAULT FUNCTION, IF ANY
	CAIN	N,.TKB
	JRST	DFANG5		;NO DEFAULT FUNCTION. WE'RE DONE.
	CAIE	N,.TKS
	MSG SCNEND, FIELD DEFAULT FUNCTION MUST BE SYMBOLIC
	MOVSI	N,DEFTAB-DEFTND
	MOVE	T2,NAME		;GET 1ST CHARS OF SYMBOL AND
	ROT	T2,7		;  ROTATE 1ST CHAR TO RIGHTMOST POS.
DFANG3:	HLRZ	T1,DEFTAB(N)	;SEARCH FOR DEFAULT FUNCTION CHARACTER
	CAMN	T1,T2		;DO TOKEN AND DEFAULT FUNCTION MATCH?
	JRST	DFANG4		;YES, FOUND
	AOBJN	N,DFANG3	;NO, KEEP LOOKING
	MSG DFANG5, UNDEFINED DEFAULT FUNCTION CHARACTER
DFANG4:	HRRZS	N
	PUSHJ	P,DEFCHK	;INSERT FUNCTION# INTO FIELD
	 HALT	DEFFNC
	HRRZ	T1,DEFTB2(N)	;GET DEFINITION-TIME ACTION
	PUSHJ	P,0(T1)		;DO THE ACTION
DFANG5:	PUSHJ	P,DEFSLS	;CHECK FIELD DEFINITION FOR RATIONALITY
	LDB	T1,STAPNT	;GET CHARACTER TYPE
	CAIE	T1,EOL		;SHOULD BE END-OF-LINE CHARACTER
	JRST	DFANG1		;FORMAT ERROR
	JRST	SCNEND		;DONE AT LAST, FINAL RETURN

;ON PASS2 WHEN FIELD IS DEFINED BUT IN ADR OF DEFAULT FIELD
;	PROCESS SYMBOL FIELD DEFAULT

DEFF80:	CAIE	C,","
	MSG CPOPJ, MISSING COMMA BEFORE DEFAULT FIELD NAME
	PUSHJ	P,TOKEN
	CAIE	N,.TKS
DEFF81:	MSG CPOPJ, MISSING DEFAULT FIELD NAME
	TRNN	F,PASS2
	POPJ	P,
	PUSH	P,FPNT
	PUSHJ	P,FLDSPC	;MOVE SYMBOL TEXT TO FIELD STORAGE
	PUSHJ	P,SRCFLD	;SEARCH FOR FIELD
	 MSG DEFF85, SYMBOLIC FIELD DEFAULT NOT DEFINED
	POP	P,SPNT
	DPB	FPNT,DEFPNT	;STORE ADR OF DEFAULT FIELD
DEFF84:	MOVE	FPNT,SPNT
	MOVSI	T1,SYMTXT(FPNT)	;MOVE SYMBOL TEXT BACK TO "FIELD"
	HRRI	T1,FIELD	;  SO OTHER DEFINITIONS CAN USE IT!
	BLT	T1,FIELD+NWORDS-1
	POPJ	P,

DEFF85:	POP	P,SPNT
	JRST	DEFF84

;PROCESS NUMERIC DEFAULTS

DEFF90:	CAIE	C,","
	MSG CPOPJ, MISSING COMMA BEFORE NUMERIC FIELD DEFAULT
	PUSHJ	P,TOKEN
	CAIE	N,.TKN
DEFF91:	MSG CPOPJ, MISSING NUMERIC FIELD DEFAULT
	MOVE	N,NUMBER
	PUSHJ	P,DEFCHK	;CHECK THAT VALUE FITS FIELD
	 HALT	DEFVAL
	POPJ	P,
;CHECK TO SEE THAT VALUE FITS IN THE BYTE FIELD ALLOWED
;AND THEN STUFF IT THERE

DEFCHK:	LDB	T1,DEFFLG	;FIRST CHECK FOR MULTIPLE DEFINITION
	TRNE	T1,MULF		;IF SET, WE'VE ALREADY OBJECTED
	JRST	CPOPJ1		;CAN'T EXPECT THAT TO BE CONSISTENT
	HRRZ	T1,@(P)
	TRNN	F,PASS2
	JRST	DEFC2
	LDB	N1,(T1)	;GET PASS1 DEFINITION
	CAME	N,N1
	MSG STOP, PASS1 AND PASS2 DEFINITIONS DIFFER
	JRST CPOPJ1
DEFC2:	DPB	N,(T1)
	LDB	N1,(T1)
	CAME	N,N1
	MSG .+1, NUMBER TOO BIG FOR FIELD
DEFSET:	LDB	T4,DEFFLG	;PUT DEFINE FLAG ON
	IORI	T4,DEFF
	DPB	T4,DEFFLG
	JRST	CPOPJ1
;SUBROUTINE FOR A DEFAULT FROM ANOTHER FIELD- ALLOWS RECURSION
;CALLED WITH	FPNT/ FIELD POINTER TO WHERE DATA ULTIMATELY GOES
;		SPNT/ FIELD POINTER TO WHERE DATA COMES FROM (SO FAR)

FLDSET:	PUSH	P,FPNT		;SAVE THIS FIELD'S POINTER
	PUSH	P,SPNT
	LDB	SPNT,DEFPNT	;GET POINTER TO DEFAULT SOURCE FIELD
	EXCH	SPNT,FPNT	;"FLDTST" NEEDS "FPNT" POINTING TO SOURCE
	PUSHJ	P,FLDTST	;HAS DEFAULT FIELD HAD VALUE SET?
	 JRST	FLDS2		;NO,IT'S VIRGIN
	EXCH	SPNT,FPNT	;PUT POINTERS BACK IN NORMAL ORDER
	AND	T3,VALUE-1(N)	;YES,EXTRACT VALUE FROM OTHER FIELD
	AND	T4,VALUE(N)
	MOVNS	N1		; AND GET IT RIGHT JUSTIFIED IN T3
	LSHC	T3,(N1)
	MOVE	N,T3		;"BITSET" WANTS IT IN "N"
	PUSHJ	P,BITS1		;PUT DATA IN "FPNT" (DESTINATION) FIELD
	JRST	FLDXIT

FLDS2:	EXCH	SPNT,FPNT	;MAKE FPNT POINT TO THIS FIELD
				; AND SPNT POINT TO DEFAULT FIELD
	LDB	T1,DEFFNC	;GET DEFAULT FUNCTION FOR DEFAULT FIELD
	JUMPE	T1,FLDXIT	;IGNORE IF DEFAULT FIELD HAS NO DEFAULT
	HRRZ	T1,DEFTAB(T1)	;GET DISPATCH ADDRESS
	PUSHJ	P,(T1)		; AND GO DO IT, PUTTING VALUE IN THIS FIELD
FLDXIT:	POP	P,SPNT		;RESTORE SPNT FOR THIS FIELD
	POP	P,FPNT		;RESTORE FPNT FOR THIS FIELD
	POPJ	P,		;DONE WITH DEFAULT FIELD FUNCTION
TIMSET:	MOVE	N,TIME1		;DEFAULT TIME INSERTION
	CAMGE	N,TIME2		;GET MAX
	MOVE	N,TIME2
	LDB	T2,DEFVAL	;GET DEFAULT MINIMUM TIME
	CAMGE	N,T2
	MOVE	N,T2		;DEFAULT TIME .GT. MAX(T1,T2)
	JRST	BITS1

PCINC:	JUMPN	RAM,PCMSG	;DISPATCH RAM HAS NO DEFAULT PC'S
	MOVE T1,LALHED		;POINTER TO FOOT OF LIST
	HRRZ T1,LALPNT(T1)	;GET POINTER TO NEXT WORD
	HRRZ N,LALLOC(T1)	;GET NEXT LOCATION ASSIGNMENT
	HRRZ	T1,LALLIN(T1)	;GET LINE # OF NEXT U-WORD
	JUMPN	T1,BITS1	;XFER IF ONE EXISTS
PCMSG:	MSG CPOPJ, NO DEFAULT PC AVAILABLE

;SUBROUTINE TO DEPOSIT DATA IN A FIELD
;DESTINATION FIELD POINTED TO BY "FPNT"
;SOURCE POINTED TO BY "SPNT" (WHEN ENTERED AT "BITSET")

BITSET:	LDB	N,DEFVAL	;VALUE INSERTION INTO MICRO FIELD
BITS1:	PUSH	P,N		;SAVE VALUE
	PUSHJ	P,FLDTST	;FIELD ALREADY LOADED?
	 JRST	BITS3		;NO
	MOVE	T1,0(P)		;YES...CHECK FOR CONFLICTING OVERLAP
	MOVEI	T2,0
	LSHC	T1,(N1)
	SKIPE	N
	XOR	T1,VALUE-1(N)
	XOR	T2,VALUE(N)	;GET DIFFERENCE FROM PREVIOUS VALUES
	SKIPE	N
	AND	T1,VALSET-1(N)
	AND	T2,VALSET(N)	;LIMIT DIFF TO FIELDS ALREADY SET
	TDNN	T1,T3
	TDNE	T2,T4		;ANY SUCH DIFFERENCES IN THIS FIELD?
	MSG NPOPJ, MICRO FIELD SET WITH CONFLICTING VALUES
				;NO, SET THIS VALUE INTO MICROWORD
BITS3:	POP	P,T1
	MOVEI	T2,0
	LSHC	T1,(N1)		;PUSH VALUE INTO PLACE
	SETCA	T3,		;MAKE UNUSED FIELDS BE 1S
	SETCA	T4,
	TDNN	T1,T3		;IF VALUE EXTENDS OUTSIDE FIELD,
	TDNE	T2,T4		; THEN THERE IS AN ERROR
	MSG CPOPJ, VALUE TOO LARGE FOR FIELD
	SKIPE	N
	IORM	T1,VALUE-1(N)
	IORM	T2,VALUE(N)
	SKIPE	N
	ORCAM	T3,VALSET-1(N)	;MARK MICRO WORD FIELD AS USED
	ORCAM	T4,VALSET(N)
	POPJ	P,
;SKIP IF SOME FIELDS MATCH THIS ONE
;NO SKIP IF FIELD VIRGIN
;ON RETURN, LEAVE MASK FOR THIS FIELD IN T3,T4
;LEAVE SHIFT POSITION AND TABLE INDEX IN N1,N
FLDTST:	MOVEI	T3,0
	MOVNI	T4,1
	LDB	T1,DEFSIZ
	LSHC	T3,(T1)		;CREATE MASK OF CORRECT SIZE IN T3
	LDB	N,DEFPOS
;THE FOLLOWING 4 LINES OF CODES ARE FOR .RTOL
	TRNN	F,RTOL
	JRST	FLDT2
	SUBI	N,MICMXB
	SETCA	N,
FLDT2:	ADDI	N,1
	IDIVI	N,^D36
	MOVNS	N1
	MOVEI	T4,0
	LSHC	T3,(N1)		;MOVE T3,T4 MASK INTO POSITION
	SKIPE	N
	TDNN	T3,VALSET-1(N)
	TDNE	T4,VALSET(N)
	AOS	(P)
	POPJ	P,

;CODE TO SEARCH FIELD DEFINITION LIST AND INSERT DEFAULTS
DEFALT:	MOVEI	FPNT,FLDPNT	;START OF LIST
DFLT2:	HRRZ	FPNT,SYMLNK(FPNT)
	JUMPE	FPNT,CPOPJ	;STOP AT END OF LIST
	MOVE	SPNT,FPNT
	LDB	T1,DEFTYP	;GET "UCODE" OR "DISP" TYPE
	CAME	T1,RAM		;MATCH CURRENT MODE?
	JRST	DFLT4		;NO
	PUSHJ	P,FLDTST	;IS FIELD VIRGIN?
	 SKIPA			;YES
	JRST	DFLT4		;NO
	LDB	T1,DEFFNC
	JUMPE	T1,DFLT4	;0 FUNCTION MEANS NO DEFAULT
	MOVE	T1,DEFTAB(T1)
	PUSHJ	P,(T1)		;DISPATCH ON FUNCTION
DFLT4:	JRST	DFLT2
PARITY:	POP	P,T1		;GET RETURN ADR
	PUSH	P,FPNT		; SAVE FPNT TO PARITY FIELD
	PUSHJ	P,(T1)		; AND MAKE "CALLER" BE "CALLEE"
	POP	P,FPNT		;SET UP PARITY FIELD POINTERS
	MOVE	SPNT,FPNT
	MOVEI	T1,0		;INIT PARITY
	MOVSI	T2,-MICMXW	;COUNT THRU ALL OF MICRO WORD
	XOR	T1,VALUE(T2)	;COMPUTE TABLE PARITY
	AOBJN	T2,.-1
	TSC	T1,T1		;REDUCE TO 18 BITS
	MOVEI	N,0
PARLUP:	JUMPN	T1,[ANDI T1,-1(T1)	;REMOVE 1 BIT
		AOJA N,PARLUP ]
	TRNE	N,1		;IF PARITY ALREADY ODD,
	POPJ	P,		;  THEN OK AS IS
	MOVEI	N,1		;GET A PARITY BIT
	LDB	T2,DEFSIZ	;GET PARITY FIELD SIZE
	JUMPN	T2,BITS1	;PUT PARITY BIT INTO FIELD
	TRNE	F,RTOL		;CAN'T DO FREE PARITY YET IN RTOL MODE
	MSG	STOP, NO CODE FOR FREE PARITY IN RTOL MODE
	MOVSI	T1,-MICMXW	;MINUS TABLE LENGTH OF MICRO WORD
PAR3:	SETCM	T2,VALSET(T1)	;GET BIT USAGE
	JFFO	T2,[MOVSI N,(1B0)	;BIT TO SHIFT
		MOVNS T3	;GET RIGHT SHIFT COUNT
		LSH	N,(T3)	; AND SHIFT PARITY BIT TO FREE PLACE
		IORM	N,VALUE(T1)
		IORM	N,VALSET(T1)
		JRST	PAR5 ]
	AOBJN	T1,PAR3		;CONTINUE  LOOKING FOR PLACE FOR BIT
PAR5:	HLRES	T1		;GET # WORDS REMAINING
	ADDI	T1,MICMXW	;GET WHICH WORD HAD FREE BIT
	IMULI	T1,^D36
	SUB	T1,T3		;CONVERT TO BIT NUMBER
	CAMLE	T1,MAXPOS(RAM)	;WAS THERE ROOM FOR PARITY BIT?
	MSG .+1, NO ROOM FOR PARITY BIT
	POPJ	P,
;SUBROUTINE TO FIND A FIELD OR MAKE ONE IF IT DOESN'T EXIST.
;	NO SKIP IF IT ALREADY EXISTS. SKIP IF NEWLY MADE.
;	RETURNS POINTER TO FIELD BLOCK IN SPNT AND FPNT.

MAKFLD:	PUSHJ	P,SRCF1
	 JRST	MAKF1		;NOT FOUND
	TRNN	F,PASS2		;ONLY ONCE PER PASS, PLEASE
	JRST	MULFLD
	PUSHJ	P,BEGCRF	;PUT DEFINITION IN THE CREF
	LDB	T1,DEFFLG	;CHECK FOR MULTIPLY DEFINED
	TRNE	T1,MULF
	MSG CPOPJ, MULTIPLY DEFINED FIELD
	POPJ	P,		;AND RETURN FOUND

MAKF1:	SKIPN	FIELD
	MSG CPOPJ, CAN'T DEFINE A NULL FIELD
	TRNE	F,PASS2		;BETTER BE PASS 1
	MSG STOP, !!FIELD UNDEFINED ON PASS 2!!
	PUSH	P,N
	PUSHJ	P,GETROM
	MOVE	FPNT,N		;SAVE POINTER TO NEW FIELD
	MOVE	SPNT,N
	POP	P,N1		;GET POINTER TO PREVIOUS FIELD
	HRRZ	N,SYMLNK(N1)	;GET POINTER FROM PREVIOUS FIELD
	HRRZM	N,SYMLNK(FPNT)	;AND CONTINUE FROM NEW FIELD
	HRRM	FPNT,SYMLNK(N1)	;LINK LIST STRUCTURE
	MOVSI	T1,FIELD
	HRRI	T1,SYMTXT(FPNT)
	BLT	T1,SYMTXT+NWORDS-1(FPNT)	;COPY NAME TEXT INTO DEFINITION
	DPB	RAM,DEFTYP
IFN FTHASH,<
	MOVEI	T1,FLDPNT	;THIS IS A FIELD DEF
	PUSHJ	P,STHASH	;STORE HASH CODE
>
	JRST	CPOPJ1

MULSYM:
MULFLD:	LDB	T1,DEFFLG	;PICK UP FLAGS
	IORI	T1,MULF		;NOTE MULTIPLE DEFINITION
	DPB	T1,DEFFLG
	MSG CPOPJ, MULTIPLE DEFINITION
;SUBROUTINE TO MAKE A SYMBOL DEFINITION (IF ONE DOESN' EXIST)
;SIMILAR TO MAKFLD ABOVE
;	CALLED WITH POINTER TO FIELD IN FPNT
;	SKIPS IF NEWLY MADE. RETURNS POINTER IN SPNT.
;	NO SKIP IF ALREADY DEFINED.
;	POINTER IN SPNT TO PRESENT DEFINITION.

MAKSYM:	PUSHJ	P,SRCSY1	;LOOK FOR SYMBOL, BUT DON'T CREF YET
	 JRST	MAKS1		;NOT FOUND
	TRNN	F,PASS2		;DISALLOW MULTIPLE DEFINITION
	JRST	MULSYM
	PUSHJ	P,BEGCRF	;NOTE DEFINITION IN CREF
	LDB	T1,DEFFLG	;LOOK AT FLAGS
	TRNE	T1,MULF		;IS THIS MULTIPLY DEFINED?
	MSG CPOPJ, MULTIPLY DEFINED SYMBOL
	POPJ	P,

MAKS1:	SKIPN	NAME		;NO DEFINED YET
	MSG CPOPJ, CAN'T DEFINE NULL SYMBOL
	TRNE	F,PASS2
	MSG STOP, !!SYMBOL UNDEFINED ON PASS2!!
	PUSH	P,N
	PUSHJ	P,GETROM
	HRRZM	N,SPNT
	POP	P,N1
	HLRZ	N,SYMLNK(N1)
	HRLZM	N,SYMLNK(SPNT)	;LINK TO NEXT SYMBOL
	HRLM	SPNT,SYMLNK(N1)
	MOVSI	T1,NAME
	HRRI	T1,SYMTXT(SPNT)
	BLT	T1,SYMTXT+NWORDS-1(SPNT)
	DPB	RAM,DEFTYP
	SKIPL	DOCREF
	TDZA	T1,T1		;NO FLAGS IF CREF ENABLED
	MOVEI	T1,NCRFF	;INHIBIT CREF ON THIS SYMBOL
	DPB	T1,DEFFLG
IFN FTHASH,<
	MOVEI	T1,(FPNT)	;FIELD FOR THIS SYMBOL
	PUSHJ	P,STHASH	;PLACE IN HASH LIST
>
	JRST	CPOPJ1
SRCFLD:
IFN FTHASH,<
	MOVEI	N,FLDPNT
	MOVEI	N1,FIELD		;LOCATION OF SYMBOL
	PUSHJ	P,FIND		;FIND IN TABLE
	  JRST	SRCF2		;NOT FOUND--TRY SLOW WAY
	JRST	SCRF3		;FOUND
>
SRCF1:	MOVEI	N,FLDPNT	;ENTER HERE FROM MAKFLD
SRCF2:	MOVEI	N1,(N)		;SAVE POINTER TO LAST LOWER FIELD
	HRRZ	N,SYMLNK(N)
	JUMPE	N,SRCX		;QUIT IF END OF LIST
XX=0
REPEAT NWORDS,<	MOVE	T1,FIELD+XX
	CAMLE	T1,XX+SYMTXT(N)
	JRST	SRCF2
	CAME	T1,XX+SYMTXT(N)
	JRST	SRCX		;NO MATCH, RETURN PTR TO SMALLER FLD
XX=XX+1>
SCRF3:	HRRZ	FPNT,N
	HRRZ	SPNT,N
	LDB	T1,DEFTYP
	CAIE	T1,(RAM)	;DOES FIELD TYPE MATCH CURRENT MODE?
	JRST	SRCF2		;NO, LOOK SOME MORE
	JRST	CPOPJ1		;YES, SKIP RETURN

SRCX:	MOVEI	N,(N1)		;GET POINTER TO SMALLER FIELD
	POPJ	P,		;RETURN NO MATCH
SRCSYM:
IFN FTHASH,<
	MOVEI	N,(FPNT)
	MOVEI	N1,NAME		;ADDRESS OF TEXT
	PUSHJ	P,FIND		;GO FIND SYMBOL
	  JRST	SRCSA		;NOT FOUND--TRY SLOW WAY
	MOVEI	SPNT,(N)	;FOUND.  SET ADDRESS
	JRST	SRCSB		;FOUND
>
SRCSA:	PUSHJ	P,SRCS1		;LOOK FOR SYMBOL
	 POPJ	P,		;WASN'T THERE
SRCSB:	LDB	T1,DEFFLG	;GET SYMBOL FLAGS
	TRNN	T1,NCRFF	;DOES THIS ONE INHIBIT CREF?
	PUSHJ	P,MAKCRF	; CREF THE REFERENCE
	LDB	T4,DEFFLG
	TRNN	T4,DEFF		;IS SYMBOL DEFINED?
	POPJ	P,		;NO
	JRST	CPOPJ1
;HERE IS BASIC SEARCH ROUTINE

SRCSY1:				;HERE TO SEARCH FOR PSEUDO-OP
SRCS1:	MOVEI	N,(FPNT)
SRCS2:	MOVEI	N1,(N)
	HLRZ	N,SYMLNK(N)
	JUMPE	N,SRCX		;END OF LIST, RETURN NO MATCH
XX=0
REPEAT NWORDS,<	MOVE	T1,NAME+XX
	CAMLE	T1,XX+SYMTXT(N)
	JRST	SRCS2		;TRY NEXT ENTRY, THIS IS TOO SMALL
	CAME	T1,XX+SYMTXT(N)
	JRST	SRCX		;NO CAN FIND
XX=XX+1 >
SRCS3:	MOVEI	SPNT,(N)	;THIS IS THE SYMBOL
	JRST	CPOPJ1
IFN FTHASH,<
;HERE IS THE STUFF FOR HASHED SYMBOL TABLE

;SUBROUTINE TO PUT A SYMBOL INTO HASH LIST
;CALL WITH:
;	T1 = POINTER TO FIELD NAME (OR FLDPNT IF FIELD)
;	SPNT = POINTER TO SYMBOL
;	PUSHJ	P,STHASH
;	RETURN HERE ALWAYS
STHASH:	HRLZM	T1,SYMHSH(SPNT)	;STORE POINTER
	MOVEI	N1,SYMTXT(SPNT)	;POINTER TO TEXT
	PUSHJ	P,HASHNO	;COMPUTE HASH NUMBER
	SKIPE	T1,HSHTAB(T2)	;ANYTHING THERE YET?
	HRRM	T1,SYMHSH(SPNT)	;YES--POINT THIS TO THAT
	HRRZM	SPNT,HSHTAB(T2)	;MAKE THIS START OF LIST
	POPJ	P,0		;RETURN
;SUBROUTINE TO FIND A SYMBOL OR FIELD NAME
;CALL WITH:
;	N = ADDRESS OF FIELD BLOCK (OR FLDPNT)
;	N1 = ADDRESS OF ASCII STRING
;	PUSHJ	P,FIND
;	  HERE IF NOT FOUND
;	HERE WITH N POINTING TO BLOCK IF FOUND
FIND:	PUSH	P,T2		;PRESERVE ACS
	PUSHJ	P,HASHNO	;COMPUTE HASH NUMBER
	SKIPN	T1,HSHTAB(T2)	;GET HASH TABLE INDEX
	JRST	FINDX		;NOT IN TABLE
FIND1:	HLRZ	T2,SYMHSH(T1)	;GET POINTER
	CAIN	T2,(N)		;RIGHT LIST?
	JRST	FIND3		;YES--SEE IF MATCH
FIND2:	HRRZ	T1,SYMHSH(T1)	;NEXT FIELD IN LIST
	JUMPN	T1,FIND1	;LOOP IF MORE ENTRIES
FINDX:	POP	P,T2		;RESTORE T2
	POPJ	P,0		;NOT THERE

FIND3:	CAIE	N,FLDPNT	;FIELD DEF?
	JRST	FIND4		;NO--IGNORE RAM TYPE
	LDB	T2,[POINT 6,SYMFLG(T1),11]
	CAIE	T2,(RAM)	;DOES FIELD MATCH CURENT MODE?
	JRST	FIND2		;NO--KEEP LOOKING
FIND4:

	XX==0
REPEAT NWORDS,<	MOVE T2,SYMTXT+XX(T1)
	CAME	T2,XX(N1)
	JRST	FIND2
XX==XX+1 >
	MOVE	N,T1		;FOUND
	POP	P,T2		;RESTORE T2
	JRST	CPOPJ1		;EXIT
;SUBROUTINE TO COMPUTE A HASH NUMBER
;CALL WITH:
;	N1 = ADDRESS OF ASCII STRING
;	PUSHJ	P,HASHNO
;	HERE WITH NUMBER IN T2
;
HASHNO:	MOVE	T1,(N1)		;GET FIRST WORD
XX==1
REPEAT NWORDS-1,<
	ADD	T1,XX(N1)
XX==XX+1
>
	LSH	T1,-1		;MAKE POSITIVE
	IDIVI	T1,HSHLEN	;PUT IN RANGE
	POPJ	P,0		;RETURN

> ;ENF FTHASH
MAKCRF:	SKIPL	DOCREF		;IS CREF ENABLED?
	TRNN	F,PASS2
	POPJ	P,		;BUILD CREF ON PASS2
	TDZA	N1,N1		;CLEAR DEFINE FLAG
BEGCRF:	MOVEI	N1,1B18		;FLAG AS DEFINITION
	MOVEI	N,1		;GET 1 WORD FOR CREF REFERENCE
	AOS	CRFCOR		;TALLY CORE USED FOR CREF
	PUSHJ	P,GETWRD
	HLRZ	T1,SYMCRF(SPNT)	;GET LAST ADR IN LIST
	HRLM	N,SYMCRF(SPNT)	;MAKE NEW WORD LAST ADR
	SKIPN	T1		;IF OLD LAST ADR IS ZERO, THEN
	MOVEI	T1,SYMCRF(SPNT)	; LAST ADR IS IN SYMBOL BLOCK
	HRRM	N,(T1)		;PUT THIS WORD ONTO END OF LIST
IFN FTCOIN,<	HRRZ	T1,CRFLIN>	;GET LINE # AT WHICH THIS WORD STARTED
IFE FTCOIN,<	HRRZ	T1,LINNUM>	;GET CURRENT LINE NUMBER
	IOR	T1,N1		;PUT DEFINE FLAG, IF ANY, IN
	HRLZM	T1,(N)		; STUFF INTO WORD NOW ON LIST END
				; AND MAKE POINTER TO NEXT BE 0
	POPJ	P,

GETROM:	MOVEI	N,SYMLEN	;GET ROOM FOR NEW SYM TABLE ENTRY
	ADDM	N,SYMCOR	;TALLY SYMBOL TABLE CORE USAGE

GETWRD:	PUSH	P,.JBFF##
	ADDB	N,.JBFF##
	CAMG	N,.JBREL##
	JRST	GETW2
	CORE	N,
	 MSG [EXIT], NOT ENOUGH MEMORY TO EXPAND
GETW2:	HRRZ	T1,(P)		;GET ADR OF 1ST NEW WORD
	SETZM	(T1)		;ZERO THAT 1ST WORD
	HRLS	T1		;SET UP BLT AC
	ADDI	T1,1		; ...
	HRRZ	T2,.JBFF##	;GET LAST WORD+1
	CAILE	T2,+1(T1)	;ONLY DO BLT IF 2 OR MORE WORDS
	BLT	T1,-1(T2)	;ZERO NEW WORDS

NPOPJ:	POP	P,N
	POPJ	P,
;SUBROUTINE TO BUILD A SYMBOLIC OR NUMERIC TOKEN
;	ENTRY TOKEN - BUILD SYMBOL, OCTAL NUMBER, OR DECIMAL NUMBER
;	ENTRY TOKN10 - BUILD SYMBOL, OR DECIMAL NUMBER
;OCTAL NUMBERS ARE OF FORM <+,-, ><DIGITS 0-7>
;	AN 8 OR 9 OR A DECIMAL POINT MAKES NUMBER DECIMAL
;DECIMAL NUMBERS ARE OF FORM <+,-, ><DIGITS 0-9><POINT, >
;	AN 8 OR 9 OR A FINAL DECIMAL POINT IS REQUIRED
;A SYMBOL IS ANYTHING THAT IS NOT A LEGAL NUMBER
;	RETURN .TKB - BLANK TOKEN
;	RETURN .TKN - SIGNED NUMERIC TOKEN WITH VALUE IN "NUMBER"
;	RETURN .TKS - SYMBOL TOKEN WITH ASCIZ TEXT IN "NAME" TABLE
	.TKB==0	;BLANK (OR NULL) TOKEN
	.TKN==1	;NUMERIC TOKEN
	.TKS==2	;SYMBOLIC TOKEN


TOKEN:	TDZA	T1,T1		;ENTRY FOR SYM,OCT#,DEC#  START WITH STATE 0
TOKN10:	MOVEI	T1,5_.SZTX	;ENTRY FOR SYM,DEC#	START WITH STATE 5 
	TRNE	F,HEXF		;USE ALT STATE TABLE IF HEX
	ADDI	T1,20_.SZTX
	MOVEM	T1,TOKSTA#	;INIT STATE TABLE
	SETZM	TKZER
	MOVE	T1,[TKZER,,TKZER+1]
	BLT	T1,TKZEND-1	;INITIALIZE TOKEN VALUES
	MOVE	T1,[POINT 7,NAME]
	MOVEM	T1,TOKPNT#	;INIT SYMBOL BUILD POINTER
	MOVE	T1,PNTCNT	;WHERE ON PRINT LINE TOKEN STARTS
	SKIPN	CHRPNT		; ARE WE ON PRINT LINE (NOT MACRO)?
	MOVEM	T1,PNTTOK	;YES.  SAVE START OF TOKEN

TOK2:	PUSHJ	P,GETCHR	;GET NEXT CHARACTER
	MOVE	T1,TOKSTA	;GET OLD STATE
	LSH	T1,-.SZTX	;DROP XCT INDEX
	IMULI	T1,3*4		;SELECT LINE IN TOKTAB
	LDB	T2,TOKTYP	;GET CHARACTER TYPE
	ADDI	T1,(T2)		; AND COMBINE WITH OLD STATE
	IDIVI	T1,4		;GET NEXT STATE, 4 ENTRIES/WORD
	LDB	T1,TOKNXT(T1+1)
	MOVEM	T1,TOKSTA	;SAVE NEW STATE
	ANDI	T1,<1_.SZTX>-1	; AND EXTRACT DISPATCH ADDRESS
	XCT	TOKXCT(T1)	;PROCESS CURRENT CARACTER
	 JRST	TOK1		;PUT IT INTO SYMBOL NAME
	JRST	TOK2		;GO GET NEXT CHARACTER

		; EXECUTE TABLE
TOKXCT:	SKIPA			; 0 IGNORE CHARACTER
	JFCL			; 1 INCLUDE IN SYMBOL ONLY
	SETOM	TOKMIN		; 2 SET MINUS FLAG
	PUSHJ	P,TOKDIG	; 3 PROCESS 0-9
	JRST	TOK5		; 4 RETURN .TKB - NO TOKEN
	JRST	TOK6		; 5 RETURN .TKS - SYMBOL
	JRST	TOK7		; 6 RETURN .TKN - DECIMAL NUMBER
	JRST	TOK8		; 7 RETURN .TKN - OCTAL NUMBER
	JRST	TOKF		; 8 CONVERT FORMAL TO ACTUAL
.SZTX==4			;NUMBER OF BITS REQUIRED TO REPRESENT INDEX
		;MARGINAL INDEX TABLE INTO TOKTAB
TOKNXT:	PINDEX 9,TOKTAB(T1)

DEFINE	TOKT(A1,B1,A2,B2,A3,B3,A4,B4,A5,B5,A6,B6,A7,B7,A8,B8,A9,B9,A10,B10),<
	XLIST
	BYTE (9) A1_4+B1, A2_4+B2, A3_4+B3, A4_4+B4
	BYTE (9) A5_4+B5, A6_4+B6, A7_4+B7, A8_4+B8
	BYTE (9) A9_4+B9, A10_4+B10
	LIST	>

;STATE TABLE. THE ROWS ARE INDEXED BY STATE; COLUMNS BY CHAR TYPE.
; EACH ENTRY IS A NINE-BIT BYTE CONSISTING OF TWO PARTS:
;  THE HIGH ORDER 5 BITS IDENTIFY THE NEW STATE,
;  THE LOW ORDER 4 BITS IDENTIFY THE CHARACTER PROCESSING FUNCTION.

TOKTAB:;TERM, " ",  ".", "+",  "-",   0-7,  8-9, OTHER, A-F, "@"

TOKT	0,4,  0,0,  1,1, 14,1, 14,2,  2,3,  3,3,  1,1,  1,1, 12,1	;STATE #0
TOKT	0,5,  6,1,  1,1,  1,1,  1,1,  1,1,  1,1,  1,1,  1,1,  1,1	;STATE #1
TOKT	0,7,  7,1,  4,1,  1,1,  1,1,  2,3,  3,3,  1,1,  1,1,  1,1	;STATE #2
TOKT	0,6, 10,1,  4,1,  1,1,  1,1,  3,3,  3,3,  1,1,  1,1,  1,1	;STATE #3
TOKT	0,6, 11,1,  1,1,  1,1,  1,1,  1,1,  1,1,  1,1,  1,1,  1,1	;STATE #4
TOKT	5,4,  5,0,  1,1,  3,1,  3,2,  3,3,  3,3,  1,1,  1,1, 12,1	;STATE #5
TOKT	0,5,  6,0,  1,1,  1,1,  1,1,  1,1,  1,1,  1,1,  1,1,  1,1	;STATE #6
TOKT	0,7,  7,0,  4,1,  1,1,  1,1,  2,3,  3,3,  1,1,  1,1,  1,1	;STATE #7
TOKT	0,6, 10,0,  4,1,  1,1,  1,1,  3,3,  3,3,  1,1,  1,1,  1,1	;STATE #10
TOKT	0,6, 11,0,  1,1,  1,1,  1,1,  1,1,  1,1,  1,1,  1,1,  1,1	;STATE #11
TOKT	0,10, 13,0,  1,1,  1,1,  1,1, 12,3, 12,3,  1,1,  1,1,  1,1	;STATE #12
TOKT	0,10, 13,0,  1,1,  1,1,  1,1,  1,1,  1,1,  1,1,  1,1,  1,1	;STATE #13
TOKT	0,5, 15,1,  1,1,  1,1,  1,1,  2,3,  3,3,  1,1,  1,1,  1,1	;STATE #14
TOKT	0,5, 15,0,  1,1,  1,1,  1,1,  2,3,  3,3,  1,1,  1,1,  1,1	;STATE #15

;STATE #0 - FLUSHES SPACES, ALLOWS + OR - FOR NUMBERS
;STATES #1,6 - BUILDS SYMBOLS, A CHARACTER WAS ILLEGAL FOR A NUMBER
;STATES #2,7 - BUILDS OCTAL NUMBER UNTIL 8,9, OR (.) SEEN
;STATES #3,10 - BUILDS DECIMAL NUMBER
;STATES #4,11 - A (.) SEEN AFTER A NUMBER, GO TO #1 FOR ANYTHING OTHER
;		THAN SPACE OR TERM.
;STATE #5 - SAME AS #0 EXCEPT ANY NUMBER IS FORCED DECIMAL
;	STATES #6-11 AND #15 FLUSH MULTIPLE SPACES
;STATE #12 - COLLECT MACRO FORMAL ARGUMENT
;STATE #13 - DROP TRAILING SPACES FROM FORMAL
;STATES #14,15 - INITIAL PLUS OR MINUS. ANYTHING OTHER THAN DIGIT MAKES SYMBOL
;	STATES 20-35, SAME AS 0-15 BUT FOR HEX MODE

BLOCK	2*3	;LEAVE SPACE FOR EXPANSION OF OCTAL TABLE
;	TERM, " ",  ".", "+",  "-",   0-7,  8-9, OTHER, A-F, "@"

TOKT	20,4, 20,0, 21,1, 34,1, 34,2, 22,3, 22,3, 21,1, 21,1, 32,0	;STATE #20
TOKT	20,5, 26,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1	;STATE #21
TOKT	20,7, 27,1, 24,1, 21,1, 21,1, 22,3, 22,3, 21,1, 22,3, 21,1	;STATE #22 (NUMBER)
TOKT	20,6, 30,1, 24,1, 21,1, 21,1, 23,3, 23,3, 21,1, 21,1, 21,1	;STATE #23 (DECIMAL)
TOKT	20,6, 31,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1	;STATE #24
TOKT	25,4, 25,0, 21,1, 23,1, 23,2, 23,3, 23,3, 21,1, 21,1, 21,1	;STATE #25
TOKT	20,5, 26,0, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1	;STATE #26
TOKT	20,7, 27,0, 24,1, 21,1, 21,1, 22,3, 22,3, 21,1, 22,3, 21,1	;STATE #27
TOKT	20,6, 30,0, 24,1, 21,1, 21,1, 23,3, 23,3, 21,1, 21,1, 21,1	;STATE #30
TOKT	20,6, 31,0, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1	;STATE #31
TOKT	20,10, 33,0, 21,1, 21,1, 21,1, 32,3, 32,3, 21,1, 21,1, 21,1	;STATE #32
TOKT	20,10, 33,0, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1, 21,1	;STATE #33
TOKT	20,5, 35,1, 21,1, 21,1, 21,1, 22,3, 22,3, 21,1, 22,3, 21,1	;STATE #34 (LEADING PLUS OR MINUS)
TOKT	20,5, 35,0, 21,1, 21,1, 21,1, 22,3, 22,3, 21,1, 22,3, 21,1	;STATE #35
TOK1:	MOVE	T1,TOKPNT	;GET SYMBOL BUILD POINTER
	CAME	T1,[POINT 7,NAME+MACMAX-1,34-7]
	IDPB	C,TOKPNT	;ROOM FOR CHAR, STORE AWAY
	JRST	TOK2

TOKDIG:	LDB	T1,DIGPNT	;GET DIGIT VALUE OF CHARACTER
	MOVE	T2,RADIX	;8 OR 16
	IMULM	T2,TOKOCT	;BUILD OCTAL NUMBER
	ADDM	T1,TOKOCT	;  AND ADD IN NEXT DIGIT
	MOVEI	T2,^D10
	IMULM	T2,TOKDEC	;BUILD DECIMAL NUMBER
	ADDM	T1,TOKDEC	;  AND ADD IN NEXT DIGIT
	POPJ	P,

;HERE WHEN TOKEN COLLECTED WAS A FORMAL --
; REPLACE IT WITH THE ACTUAL, AND SCAN OFF THE ACTUAL

TOKF:	HLRZ	T2,0(PM)	;IS THE ACTUAL A FORMAL OF PREVIOUS INVOKATION
	SKIPN	T2		;SKIP IF SO
	MOVEI	T2,0(PM)	;NO, USE MACRO

	HRRZ	T3,0(T2)	;GET NUMBER OF ARGS IN CONTAINING MACRO
	SKIPLE	T1,TOKDEC	;GET DECIMAL ARGUMENT NUMBER
	CAMLE	T1,T3		;IT MUST BE LE NUMBER OF ARGS
	JRST	TOK5		;ELSE RETURN NOTHING

	SUB	T1,T3		;NUMBER OF ADDITIONAL ACTUALS ON STACK ABOVE
				; THE ONE WE WANT
	IMULI	T1,NWORDS	;CONVERT TO NUMBER OF WORDS ON STACK
	ADDI	T1,-NWORDS(T2)	;OFFSET FROM CURRENT STACK
	HRLI	T1,(POINT 7,)	;MAKE INTO BYTE POINTER

	IMULI	T3,NWORDS	;CALCULATE LENGTH OF MACRO INVOCATION
	SUBI	T2,3(T3)	;GET ADDRESS OF PREVIOUS MACRO
	HRLZS	T2

	CAML	PM,[-4,,0]	;IS THERE ROOM ON STACK FOR ANOTHER NESTING?
	MSG TOK5, EXCESSIVE MACRO NESTING
	PUSH	PM,C		;SAVE CURRENT SCAN PARAMETERS
	PUSH	PM,CHRPNT
	PUSH	PM,T2		;SAVE BASE OF MASTER MACRO
	MOVEM	T1,CHRPNT	;FOR RENEWED SCANNING
	JRST	TOKEN		;GO EAT THE ACTUAL AS A TOKEN.
TOK5:	MOVEI	N,.TKB
	JRST	TOK99

TOK6:	MOVEI	T1,0		;TRAILING SPACE FLUSHER FOR SYMBOLS
	LDB	T2,TOKPNT	;GET LAST CHAR IN SYMBOL
	CAIN	T2," "
	DPB	T1,TOKPNT	;REPLACE A TRAILING SPACE WITH NULL
	MOVEI	N,.TKS
	JRST	TOK99

TOK7:	SKIPA	N,TOKDEC	;PICK UP DECIMAL NUMBER
TOK8:	MOVE	N,TOKOCT	;PICK UP OCTAL NUMBER
	SKIPGE	TOKMIN
	MOVNS	N		;NEGATE IF MINUS FLAG SET
	MOVEM	N,NUMBER
	MOVEI	N,.TKN
TOK99:	POPJ	P,
;LOWEST LEVEL ROUTINE TO GET A CHARACTER
;	IF REREAD FLAG SET, RETURNS LAST CHARACTER READ

GETCP:	PUSHJ	P,POPMAC	;POP OFF MACRO PARAMETERS
				; NOW THAT IT HAS BEEN PROCESSED
	MOVE	C,PNTCNT	;GET POSITION ON PRINT LINE
	SKIPN	CHRPNT		;ARE WE BACK TO SOURCE?
	MOVEM	C,PNTTOK	;YES.  NOTE BEGINNING OF TOKEN

GETCHR:	TRZE	F,REREAD
	JRST	[MOVE C,RRDC
		POPJ	P, ]
	SKIPN	C,CHRPNT	;RESCANNING ANYTHING?
	JRST	GETC5		;NO, GET NEXT CHAR FROM FILE BUFFER

;HERE TO GET A CHARACTER FROM A TEXT STRING STORED INTERNALLY, NOTABLY EITHER
; A MACRO OR ONE OF ITS ACTUALS.  IF THE ENTIRE STRING HAS BEEN PROCESSED,
; THE LEFT HALF OF CHRPNT IS ZERO,  AND THE NEXT CALL WILL UN-DO THE NESTING
; AND GET A CHARACTER FROM THE NEXT LOWER LEVEL.  THE NESTING CANNOT BE
; UNDONE WHEN THE END OF THE STRING IS FOUND, BECAUSE THE NEST MAY INCLUDE
; MACRO ACTUALS WHICH MIGHT NOT BE EVALUATED UNTIL THE ENTIRE MACRO, INCLUDING
; ITS TERMINATOR, HAD BEEN PROCESSED.

	TLNN	C,-1		;DID WE FINISH THE RESCAN?
	JRST	GETCP		;YES, RETURN TO PREVIOUS LEVEL
	ILDB	C,CHRPNT	;NO, GET ANOTHER CHAR FROM SYMBOL TABLE
	JUMPN	C,GETC9		;GO PROCESS WITH IT UNLESS END OF TEXT

;HERE WHEN AN INTERNAL TEXT STRING HAS RUN OUT.  RETURN THE TERMINATOR THAT
; CAUSED US TO USE IT, AND SETUP TO UN-NEST IT ON THE NEXT CALL TO GETCHR

	HRRZS	CHRPNT		;SO WE GO TO GETCP NEXT CALL
	HRRZ	C,0(PM)		;GET NUMBER OF ACTUALS STORED ON STACK
	IMUL	C,[-NWORDS]	; COMPUTE SPACE USED BY ACTUALS
	SUBI	C,2		;ALLOW MORE SPACE FOR ACTUAL COUNT AND CHRPNT
	HRLI	C,PM		;STICK AN INDEX REGISTER IN THAT ADDRESS
	MOVE	C,@C		;GET THE TERMINATOR THAT GOT US HERE
	JRST	GETC9		;GO PROCESS IT AGAIN
;HERE WHEN ALL NESTED STRINGS ARE EXHAUSTED, TO GET MORE FROM INPUT FILE

GETC5:	SOSGE	INBLK+2
	JRST	GETC7
	ILDB	C1,INBLK+1	;GET CHAR FROM INPUT FILE
	MOVE	C,@INBLK+1	;GET WORD WITH BYTE
	TRNE	C,1		;LINE NUMBER?
	JRST	GETC5		;YES--SKIP IT
GETC8:	MOVEI	C,7
	CAIN	C1,11		;IS IT TAB INPUT?
	ANDCAM	C,PNTCNT	;YES.  COUNT LISTING COLUMNS
	LDB	C,GETPNT	;TRANSLATE INPUT CHARACTER
	JUMPE	C,GETC5

	MOVEM	C1,EOLCHR	;SAVE LAST CHAR TO FIND WHAT ENDED LINE
	CAIE	C,12		;DON'T SAVE 12,13, OR 14
	SOSG	PNTCNT		;ROOM IN LISTING FILE (LEAVE 1 CHAR ROOM)
	JRST	.+2		;NO
	IDPB	C1,PNTPNT	;YES, SAVE INPUT CHAR IN OUTPUT LISTING

GETC9:	POPJ	P,

GETC7:	IN	INCHN,
	 JRST	GETC5
	GETSTS	INCHN,C
	TRZE	C,740000
	MSG .+1, INPUT FILE ERROR
	SETSTS	INCHN,(C)
	TRNN	C,1B22
	JRST	GETC5
	PUSHJ	P,NXTFIL
	 SKIPA	C1,[12]		;END-OF-FILE RETURNS LINE-FEED
	MOVEI	C1,14		;START WITH FORM FEED
	JRST	GETC8
;PRINT SOURCE LINE IN OUTPUT LISTING

PNTLIN:	PUSH	P,C
	TRNN	F,PASS2!ERROR
	JRST	PNTL2		;NO LIST ON PASS1, RE-INIT LISTING
	MOVE	N,SRCCOL	;GET COLUMN NO TO PRINT SOURCE
	SKIPL	DOBIN		;IF LEAVING SPACE FOR BINARY,
	PUSHJ	P,TABTON	;TAB OUT TO THERE
	MOVEI	C,";"		;PRINT SOURCE AS COMMENT
	PUSHJ	P,PUTL
	TRNN	F,SUPP		;SUPPRESSED ASSEMBLY?
	MOVEI	C," "		;NO, JUST ONE SEMICOLON
	PUSHJ	P,PUTL
	HRRZ	C,LINNUM
	PUSHJ	P,PNTDEC
	PUSHJ	P,TAB
	MOVEI	C,0
	IDPB	C,PNTPNT
	MOVEI	N,PNTBUF
	PUSHJ	P,PRINT0
	MOVEI	C,15
	PUSHJ	P,PUTL
	MOVE	C,EOLCHR
	CAIE	C,14
	MOVEI	C,12		;END LINE WITH 15,14, OR 15,12
	PUSHJ	P,PUTL
PNTL2:	POP	P,C
PNTINI:	MOVE	T1,[POINT 7,PNTBUF]	;INIT OUTPUT LIST LINE BUFFER
	MOVEM	T1,PNTPNT	;INIT OUTPUT BUFFER BYTE POINTER
	MOVEI	T1,PNTMAX
	MOVEM	T1,PNTCNT	;INIT OUTPUT BUFFER CHAR COUNT
	POPJ	P,
;SUBROUTINE TO PRINT BINARY IN OUTPUT FILE(S)

PNTBIN:	SKIPGE	DOBIN		;IS .NOBIN IN FORCE?
	JRST	PNTXIT		;YES--SKIP BINARY
	AOS	WRDCNT(RAM)	;COUNT MICRO WORDS
	PUSH	P,C
	PUSH	P,PUTP
	MOVEI	N,[ASCII /U /
		ASCII /D / ](RAM)
	PUSHJ	P,PRINT0
IFN FTULD,<
	MOVEI	T1,PUTU		;OUTPUT ADDRESS IN BRACKETS TO ULD
	MOVEM	T1,PUTP
	PUSHJ	P,PRINT
	 ASCIZ	/
[/
	MOVEI	T1,PUTLU
	MOVEM	T1,PUTP		;OUTPUT ADDRESS TO BOTH FILES
>;END FTULD
	HRRZ	C,PC(RAM)		;GET ADDRESS OF WORD
	MOVE	T1,ADRCOL		;GET # OF COL'S FOR ADDRESS
	PUSHJ	P,PNTOC3
	MOVEI	C,","		;SEND COMMA TO LISTING ONLY
	PUSHJ	P,PUTL
	MOVEI	C," "		;SPACE TO LISTING
	PUSHJ	P,PUTL

IFN FTULD,<
	MOVEI	C,"]"		;CLOSE BRACKET TO ULD
	PUSHJ	P,PUTU
	MOVEI	C,"="		;FOLLOWED BY EQUAL
	PUSHJ	P,PUTU
>;END FTULD
	MOVE	T1,GRPCNT(RAM)	;HOW MANY GROUPS TO PRINT?
	MOVEM	T1,MICCNT#	;SET COUNTER

	MOVEI	T2,0		;START AT ZERO
	TRNN	F,RTOL		;UNLESS RIGHT TO LEFT NUMBERING
	JRST	PNTB1A
	IMUL	T1,GRPSIZ	;GET # OF BITS REPRESENTED BY GROUPS
	MOVEI	T2,MICMXB	;TOTAL # OF BITS STORED
	SUBI	T2,(T1)		;GET # STORED NOT TO PRINT
PNTB1A:	MOVEM	T2,MICPOS	;SET STARTING BIT POSITION FOR OUTPUT
	JRST	PNTB3
;LOOP TO OUTPUT MICROWORD

PNTB2:	MOVEI	C,","
	PUSHJ	P,PUTL		;TO LISTING FILE ONLY
;	PUSHJ	P,PUT
PNTB3:	MOVE	T1,GRPSIZ	;# OF BITS TO PUT OUT TOGETHER
	ADDB	T1,MICPOS	;BIT # AFTER LAST ONE THIS GROUP
	IDIVI	T1,^D36		;CONVERT TO WORD AND POSITION
	CAILE	T1,0
	SKIPA	C,VALUE-1(T1)	;GET PREVIOUS BITS
	MOVEI	C,0		; UNLESS THERE AREN'T ANY
	CAIG	T1,MICMXW
	SKIPA	C+1,VALUE(T1)	;GET NEXT BITS
	MOVEI	C+1,0
	LSHC	C,(T2)		;MOVE GROUP INTO LOW BITS OF C
	MOVEI	C+1,1		;A MASK
	LSH	C+1,@GRPSIZ	;POSITION NEXT BEYOND GROUP
	ANDI	C,-1(C+1)	;SAVE GROUP BITS ONLY
	PUSHJ	P,PNTOC4
	SOSLE	MICCNT		;DONE ENOUGH GROUPS?
	JRST	PNTB2
PNTB99:	POP	P,PUTP		;RESTORE NORMAL OUTPUT ROUTINE
	POP	P,C
PNTXIT:	POPJ	P,
FINLST:	SKPINC
	 JFCL			;CLEAR ^O FLAG
	TRO	F,ERROR!NOHDR	;FORCE NEXT MSG TO TTY, SUPPRESS HEADERS
	SETZM	LISTSW		;UNSUPPRESS LISTING
	PUSHJ	P,PRINT
	 ASCIZ /

; Number of microwords used: /
	TRNN	F,DRAMF
	JRST	FINCNT
	PUSHJ	P,PRINT
	 ASCIZ /
;	D words= /
	MOVE	C,WRDCNT+DISP
	PUSHJ	P,PNTDEC
	PUSHJ	P,PRINT
	 ASCIZ /
;	U words= /
FINCNT:	MOVE	C,WRDCNT+UCODE
	PUSHJ	P,PNTDEC
	PUSHJ	P,PRINT
	 ASCIZ /, Highest= /
	MOVE	C,HIGHPC+UCODE
	PUSHJ	P,PNTDEC
	PUSHJ	P,CRLF
	TRZ	F,ERROR		;"END" DOESN'T GO TO TTY CONSOLE
	PUSHJ	P,PRINT
	 ASCIZ /
	END
/
	TRZ	F,NOHDR
;START CREF LISTING

	MOVEI	C,[ASCIZ /Cross Reference Listing/]
	PUSHJ	P,SETHDR
	MOVEI	FPNT,FLDPNT	;GET START OF SYM TABLE
CRFLUP:	HRRZ	FPNT,(FPNT)	;GET NEXT FIELD
	JUMPE	FPNT,CRFEND	;STOP AT END
	MOVE	SPNT,FPNT
	LDB	RAM,DEFTYP	;GET "UCODE" OR "DISP" NUMBER
	MOVEI	N,[ASCII /(U) /
		ASCII /(D) / ] (RAM)
	TRNE	F,DRAMF		;IF NO DRAM, NO NEED TO DISTINGUISH
	PUSHJ	P,PRINT0
	MOVEI	N,SYMTXT(FPNT)	;GET TEXT ADDRESS
	PUSHJ	P,PRINT0	; AND PRINT FIELD NAME
	PUSHJ	P,CRFLST	;LIST CREF FOR FIELD
CRSLUP:	HLRZ	SPNT,SYMLNK(SPNT)	;GET NEXT
	JUMPE	SPNT,CRFLUP		;GET NEXT FIELD IF NULL
	MOVE	T1,SYMTXT(SPNT)
	PUSHJ	P,TAB
	MOVEI	N,SYMTXT(SPNT)	;GET ADR OF SYMBOL
	PUSHJ	P,PRINT0
	PUSHJ	P,CRFLST
	JRST	CRSLUP

;HERE TO PRINT CREF FOR ONE SYMBOL

CRFLST:	HRRZ	N,SYMCRF(SPNT)	;GET POINTER TO 1ST ITEM
CRILUP:	HRRZS	N
	JUMPE	N,NEWLIN	;EXITS WITH POPJ
	PUSH	P,(N)		;SAVE LIST ITEM
	MOVE	T1,HORPOS	;GET HORIZONTAL POSITION
	CAILE	T1,^D120+1	;ROOM FOR ANOTHER ITEM?
	PUSHJ	P,NEWLIN	;NO
CRILP2:	PUSHJ	P,TAB		;TAB BEFORE EACH ITEM
	MOVE	T1,HORPOS
	CAIGE	T1,NCHARS+8	;SPACED OVER SYMBOLS?
	JRST	CRILP2		;NO, ANOTHER TAB NEEDED
	HLRZ	C,(P)		;GET LINE NUMBER
	TRZ	C,1B18		;CLEAR DEFINITION FLAG
	PUSHJ	P,PNTDEC
	SKIPL	0(P)		;IS DEFINITION FLAG SET?
	JRST	CRILP3		;NO
	PUSHJ	P,PRINT		;YES, FLAG IT
	 ASCIZ / #/
CRILP3:	POP	P,N
	JRST	CRILUP
;START LOCATION/LINE LISTING

CRFEND:	MOVE	T1,P2JFF	;RECLAIM SPACE
	MOVEM	T1,.JBFF	; USED FOR CREF
IFN FTMAP,<
	MOVEI	RAM,DISP
	MOVEI	C,[ASCIZ \Location / Line Number Index
; Dcode Loc'n	0	1	2	3	4	5	6	7\]
	TRNE	F,DRAMF		;ANY DRAM STUFF THIS ASSY?
	PUSHJ	P,UMAP		;YES, GO MAP DRAM

;NOW BUILD UCODE LOC/LINE TABLE

	MOVE	N,HIGHPC+UCODE	;HIGHEST ADDRESS ASSIGNED FOR UCODE
	ADDI	N,1		;ADD 1 TO INCLUDE LOC 0
	LSH	N,-1		;ALLOCATE 1/2 WORD FOR EACH LOC
	PUSHJ	P,GETWRD	;GET SPACE FOR TABLE
	HRLI	N,C		;MAKE INDIRECT POINTER INDEXED BY C
	MOVEM	N,GUPNT#	;SAVE FOR ACCESSING TABLE
	HLRZ	N,LALHED	;GET BEGINNING OF LOC'N ASSIGNMENT LIST
MAPLLP:	HRRZ	C,LALLOC(N)	;GET ADDRESS ASSIGNED TO THIS WORD
	ROT	C,-1		;INDEX INTO TABLE OF HALFWORDS
	JUMPL	C,MAPL2		;ODD ADDRESS STORED IN RH
	HRLM	N,@GUPNT	;SAVE ADDR OF LAL ENTRY FOR THIS LOC'N
	JRST	MAPL3
MAPL2:	HRRM	N,@GUPNT
MAPL3:	HRRZ	N,LALPNT(N)	;GET ADDR OF NEXT LAL ENTRY
	JUMPN	N,MAPLLP	;LOOP UNTIL NO MORE

	MOVEI	RAM,UCODE
	MOVEI	C,[ASCIZ \Location / Line Number Index
; Ucode Loc'n	0	1	2	3	4	5	6	7\]
	PUSHJ	P,UMAP		;THEN MAP UCODE
	JRST	SUMARY		;FOLLOWED BY RUNNING STATISTICS

;GENERATE LOC/LINE LISTING

UMAP:	PUSHJ	P,SETHDR
	HRLO	FPNT,HIGHPC(RAM)	;GET HIGHEST LOC'N USED
	SETCA	FPNT,		;USE AS LIMIT ON AOBJN POINTER
	JRST	LOCST

LOCLUP:	TRNE	FPNT,7		;TIME FOR A NEW LINE?
	JRST	LOCL1		;NO
	PUSHJ	P,NEWLIN	;YES
	TRNN	FPNT,70		;DOUBLE SPACE AFTER 100 LOC'S
	PUSHJ	P,NEWLIN
LOCST:	MOVEI	N,[ASCIZ /U /
		   ASCIZ /D /](RAM)
	PUSHJ	P,PRINT0	;MARK U/D
	MOVEI	C,(FPNT)	;GET LOCATION
	PUSHJ	P,PNTOC4	;PRINT IN OCTAL, 4 DIGITS
;HERE AT BEGINNING OF LINE TO SEE WHETHER THERE IS A LARGE UNUSED
; SPACE, AND IF SO, TO SUMMARIZE IT IN A SINGLE LINE.

	MOVE	SPNT,FPNT	;COPY BASE ADDR OF THIS LINE
LOCS1:	PUSHJ	P,@GLINE(RAM)	;GET LINE NUMBER, IF ANY
	JUMPN	C,LOCS2		;IS THIS LOC USED?
	AOBJN	FPNT,LOCS1	;NO, SCAN UNTIL USED LOC'N FOUND
LOCS2:	SUB	FPNT,SPNT	;RH BECOMES # OF UNUSED LOCATIONS
	TRNN	FPNT,-20	;IS IT MORE THAN 2 LINE'S WORTH?
	JRST	LOCS3		;NO, JUST PRINT BLANKS IN UNUSED LOC'S
	PUSHJ	P,PRINT		;YES, USE ONE LINE TO COVER THE GROUP
	ASCIZ / - /
	MOVEI	C,(FPNT)	;GET NUMBER OF UNUSED ADDRESSES
	ANDI	C,7		;GET PARTIAL LINE USAGE
	HRLI	C,(C)		;REPLICATE BOTH HALVES
	SUB	FPNT,C		;REDUCE UNUSED PART TO EVEN MULTIPLE OF LINE
	ADD	FPNT,SPNT	;ADJUST LINE BASE FOR AREA SKIPPED
	MOVEI	C,-1(FPNT)	;GET LAST ADDRESS SKIPPED
	PUSHJ	P,PNTOC4
	PUSHJ	P,PRINT
	ASCIZ / Unused/
	JRST	LOCLUP		;GO START A LINE OF USED LOCATIONS

LOCS3:	MOVE	FPNT,SPNT	;RESTORE BASE OF LINE
	PUSHJ	P,TAB
LOCL1:	PUSHJ	P,TAB		;SPACE OVER
	PUSHJ	P,@GLINE(RAM)
	JUMPE	C,LOCL2		;DON'T PRINT IF NOT USED
	PUSHJ	P,PNTDEC	;PRINT LINE NUMBER
	SKIPE	C,PCTYPE	;GET "HOW ASSIGNED" FLAG, IF ANY
	PUSHJ	P,PUTL
LOCL2:	AOBJN	FPNT,LOCLUP	;GO TO NEXT
	JRST	CRLF		;RETURN PRINT TO LEFT MARGIN, PC TO CALLER
;SUBROUTINES USED BY LOC/LINE LISTER TO FIND LINE #

GLINE:	Z	GULINE		;GET UCODE LINE # FOR LOC IN FPNT
	Z	GDLINE		;SAME FOR DISP LINE #

GULINE:	MOVEI	C,(FPNT)	;COPY ADDRESS
	ROT	C,-1		;DIVIDE BY 2, REMAINDER TO SIGN
	SKIPGE	C		;EVEN ADDRESS?
	SKIPA	C,@GUPNT	;GET ADDR OF LAL ENTRY FOR THIS WORD
	MOVS	C,@GUPNT
	TRNN	C,-1		;IS THERE A LAL ENTRY FOR THIS WORD?
	JRST	GULIN2		;NO, RETURN 0
	LDB	T1,[POINT 7,LALLIN(C),17]
	MOVEM	T1,PCTYPE	;SET "HOW ASSIGNED" CODE
	HRRZ	C,LALLIN(C)	;GET LINE NUMBER AT WHICH LOC'N ASSIGNED
	POPJ	P,

GULIN2:	SETZB	C,PCTYPE	;NO LINE NUMBER, NO ASSIGNMENT
	POPJ	P,

GDLINE:	MOVEI	C,(FPNT)	;COPY LOC'N
	ROT	C,-1		;PREPARE INDEX INTO DTABL
	SKIPGE	C		;RIGHT OR LEFT?
	SKIPA	C,DTABL(C)	;RIGHT
	MOVS	C,DTABL(C)	;LEFT
	TLZ	C,-1		;CLEAR OTHER HALF
	SETZM	PCTYPE		;PREVENT "HOW ASSIGNED" FLAG FROM PRINTING
	POPJ	P,
>;END IFN FTMAP
;HERE WHEN LISTING FINISHED

SUMARY:	TRO	F,ERROR!NOHDR	;FORCE NEXT MESSAGE TO TTY
	SKIPN	ERRCNT		;ANY ERRORS?
	SKIPA	N,[Z [ASCIZ /
No/]]
	MOVEI	N,[ASCIZ /
? /]
	PUSHJ	P,PRINT0
	SKIPE	C,ERRCNT
	PUSHJ	P,PNTDEC	;NUMBER OF ERRORS IF ANY
	PUSHJ	P,PRINT
	ASCIZ	/ error/
	MOVEI	C,"s"		;PLURAL
	MOVE	N,ERRCNT
	CAIE	N,1		;IS IT PLURAL?
	PUSHJ	P,PUTL		;YES
	PUSHJ	P,PRINT
	 ASCIZ / detected
End of microcode assembly
/
	HRRZ	C,PAGCNT
	PUSHJ	P,PNTDEC
	PUSHJ	P,PRINT
	ASCIZ / pages of listing
Used /
	MOVEI	C,0
	RUNTIM	C,		;GET FINAL RUNTIME
;	PUSHJ	P,ADJT20	;ADJUST FOR TOPS-20
	SUB	C,STTIME	;GET USED RUNTIME (MS)
	ADDI	C,5		;ROUND TO HUNDREDTH OF SEC
	IDIVI	C,^D10
	IDIVI	C,^D100		;GET HUNDREDTHS OF SEC
	PUSH	P,C+1		;SAVE FRACTION
	PUSHJ	P,PNTDEC	;PRINT SECONDS
	MOVEI	C,"."
	PUSHJ	P,PUTL
	POP	P,C		;RECOVER FRACTION
	PUSHJ	P,PNTDC2
	PUSHJ	P,PRINT
	ASCIZ / seconds, /
	LDB	C,[POINT 9,.JBREL,26]	;GET PAGES USED
	ADDI	C,1			;PAGE 0 COUNTS AS A PAGE
	PUSHJ	P,PNTDEC
	PUSHJ	P,PRINT
	ASCIZ / pages of core
  Symbol table: /
	MOVE	C,SYMCOR
	PUSHJ	P,PNTCOR
	ASCIZ /P
  Text strings: /
	MOVE	C,TXTCOR
	PUSHJ	P,PNTCOR
	ASCIZ /P
  Loc'n assignment: /
	MOVE	C,LALCOR
	PUSHJ	P,PNTCOR
	ASCIZ /P
  Cross reference: /
	MOVE	C,CRFCOR
	PUSHJ	P,PNTCOR
	ASCIZ /P
/
	POPJ	P,		;LISTING FINISHED

PNTCOR:	ADDI	C,400		;ROUND CORE TO NEAREST PAGE
	LSH	C,-^D9		;GET PAGE COUNT
	PUSHJ	P,PNTDEC
	JRST	PRINT		;THEN PRINT ASCIZ WHICH FOLLOWS CALL
;SEARCH FOR FREE MICRO WORDS.
;	LOCPAT CONTAINS THE 1'S PATTERN
;	LOCAST CONTAINS THE ASTERISK "DON'T CARE" PATTERN
;	FRECNT CONTAINS THE SIZE OF THE BLOCK WITHIN WHICH
;		THE PATTERN OF LOCPAT EXISTS. FRECNT IS ALWAYS
;		A SINGLE BIT.
;SUBROUTINE RETURNS THE 1ST LOCATION MEETING CRITERIA AND SKIPS.
;IF CRITERIA CANNOT BE MET WITH ANY LOCATION, THEN NO SKIP

FREWRD:	JUMPN	RAM,STOP
	TRNE	F,SEQUEN
	JRST	STOP		;SHOULDN'T GET HERE IN SEQUENTIAL MODE
	MOVE	T1,LOCPAT	;GET PATTERN TO MATCH
	IOR	T1,LOCAST	;COUNT IN THE *'S
	ANDI	T1,FRESIZ-1	;*** LOOK ONLY AT LOW BITS ***
	MOVE	T1,FRETAB(T1)	;GET LIST OF WORDS FITTING PATTERN
	MOVEI	T2,FRESIZ	;TABLE IS BUILT FOR 32 WORDS
	SUB	T2,FRECNT	;GET # OF WORDS TO THROW AWAY
	SKIPL	T2		;*** NO SHIFT IF NEGATIVE ***
	LSH	T1,(T2)		;  AND THROW THEM AWAY
	MOVEM	T1,FREMSK#	;SAVE PATTERN FOR MATCHING

;HERE BEGINS THE SEARCH, STARTING WITH THE FIRST REGION IN THE 
; PREFERENCE TABLES (PRFTB), AND ADVANCING TO OTHERS AS NECESSARY

	MOVEI	N1,0		;ESTABLISH INDEX INTO REGION TABLES
FNDL1:	SKIPN	PRFTB3(N1)	;IS THERE ANOTHER REGION?
	MSG PCNXT1, NO ADDRESS MEETS CONSTRAINTS
	SKIPA	N,PRFTB1(N1)	;GET A START OF REGION ADDRESS
FNDL2:	AOS	N,FNDPC#	;TRY A LARGER ADDRESS

;HERE WE HAVE A TENTATIVE ADDRESS IN N.
; CHECK TO SEE WHETHER IT MATCHES THE CONSTRAINT

FNDL3:	MOVN	T1,FRECNT	;UNSPECIFIED BITS =1
	ANDCB	T1,LOCAST	;1S IN BITS SPECIFIED AS 0 OR 1
	AND	T1,N		;SELECT CONSTRAINED BITS OF ADDRESS
	CAMLE	T1,LOCPAT	;WILL FORCING THEM DECREASE THE ADDR?
	AOJA	N,FNDL3		;YES, DON'T DO THAT
	ANDCM	N,T1		;NO.  CLEAR OUT CONSTRAINED BIT POSITIONS
	IOR	N,LOCPAT	; AND SET IN THE CONSTRAINT

	CAML	N,PRFTB2(N1)	;IS THIS WITHIN REGION STILL?
	AOJA	N1,FNDL1	;NO, LOOK IN NEXT REGION
;HERE WE HAVE AN ADDRESS MEETING THE CONSTRAINT.
; CHECK TO SEE WHETHER THE REQUIRED LOCATIONS ARE FREE AT THIS ADDRESS

	MOVEM	N,FNDPC		;SAVE AS BASIS FOR SEARCH
FNDL4:	MOVEI	T3,(N)		;GET A COPY OF ADDRESS
	IDIVI	T3,^D36		;FORM AN INDEX INTO USAGE
	MOVE	T1,USAGE(T3)
	MOVE	T2,USAGE+1(T3)
	LSHC	T1,(T4)		;GET 32 USAGE BITS INTO T1 BITS 0-31
	TDNE	T1,FREMSK	;ARE ALL REQUIRED BITS AVAILABLE?
	JRST	FNDL2		;NO, GO TRY ANOTHER ADDRESS

;WITHIN A 32-WORD BLOCK, THE REQUIRED WORDS ARE FREE AT THIS
; ADDRESS.  ARE THERE MORE LOCATIONS THAT NEED TO BE CHECKED?

	MOVN	T1,FRECNT	;ONES IN BIT POSITIONS LEFT OF PATTERN
	ANDCB	T1,LOCPAT	; NOW 1S WHERE PATTERN HAD 0 OR *
	ANDCM	T1,LOCAST	; 1S WHERE PATTERN HAD 0S
	ANDI	T1,-FRESIZ	;LOOK AT BITS BEYOND 32-BIT RANGE
	MOVEI	T2,(T1)		;MAKE A COPY OF TEST BITS
	ANDCMI	T2,(N)		;ANY ZEROS IN THAT PART OF ADDR?
	JUMPE	T2,FNDL6	;NO, THIS ADDRESS MATCHES CONSTRAINT

;HERE WE HAVE TO LOOK AT ANOTHER 32-WORD BLOCK

	MOVEI	T2,(N)		;GET A COPY OF CURRENT ADDRESS
	ANDCMI	T2,(T1)		;SAVE BITS NOT ZERO IN PATTERN
	ORCMI	N,(T1)		;MAKE ONES OF ALL NON-ZEROS AFTER RIGHT 5
	ADDI	N,FRESIZ	;CHANGE SOME ZEROS
	ANDI	N,(T1)		;DISCARD NON-ZERO POSITIONS
	IORI	N,(T2)		;RESTORE UNCHANGING BITS
	JRST	FNDL4		;GO LOOK AT ANOTHER BLOCK OF 32 WORDS

;HERE WE HAVE FOUND THE LOCATION WE WANT

FNDL6:	MOVN	T1,FRECNT	;GET 1'S LEFT OF CONSTRAINT
	ANDCB	T1,LOCPAT	;MAKE THAT 1'S IN 0 AND * POSITIONS
	ANDCM	T1,LOCAST	;LEAVE 1'S IN 0 POSITIONS ONLY
	MOVSI	N,-1		;SETUP COUNT FOR PROGRESSION THROUGH BLOCK
	JUMPE	T1,FNDL8	;WERE THERE ANY ZEROS IN PATTERN?
FNDL7:	ANDI	T1,-1(T1)	;CLEAR A BIT FROM ZERO MASK
	ASH	N,1		;DOUBLE NUMBER OF LOC'NS ALLOCATED
	JUMPN	T1,FNDL7	;LOOK FOR MORE
FNDL8:	HRR	N,FNDPC		;INSERT STARTING ADDR OF BLOCK
	JRST	CPOPJ1
RADIX 10

FRESIZ==32		;TABLE SIZE IS 32
FRETAB:	DEFINE FOOMAC (N)<	XN=N
	REPEAT N,<	XBIT==XN
	XB==0
	REPEAT 2*N-XN,<XB==XB+<XN&XBIT/XN>B<<XBIT==XBIT+1>-N-1>
>
	EXP	XB_<<XN==XN+1>-N-1>
> >
IF1,<	BLOCK	FRESIZ >
IF2,<	FOOMAC \FRESIZ
	SUPPRESS XN,XBIT,XB >

RADIX 8
;SETUP A NEW LOCATION ADDRESS FOR STARTING NEXT MICRO WORD ASSEMBLY

GETPC:	JUMPN	RAM,PCNEXT	;
	TRNE	F,PASS2
	JRST	GETPC2
GETPC1:	MOVEI	N,LALSZ		;ON PASS1, SETUP A NEW LAL BLOCK
	ADDM	N,LALCOR	;TALLY CORE USED FOR LAL
	PUSHJ	P,GETWRD
	MOVE	T1,LALHED
	HRRM	N,LALPNT(T1)	;ADD NEW BLOCK TO END OF LAL LIST
	HRRM	N,LALHED	;UPDATE FOOT POINTER
	HRRZ	T2,LINNUM	;PUT CURRENT LINE NUMBER INTO BLOCK
	HRRM	T2,LALLIN(T1)	; AND SAVE IN JUST COMPLETED MICRO WORD
	JRST	GETPC9		;EXIT

GETPC2:	MOVE	N,PC(RAM)	;GET PC FOR LAST U-WORD
	HRRZ	T1,LALHED	;GET LINE# FOR LAST U-WORD
	HRRZ	T2,LALLIN(T1)	; ...
	CAME	T2,LINNUM	;SAME LINE# AS FOR PASS 1?
	 MSG .+1, LINE NUMBER DIFFERENT ON PASSES 1 AND 2

	HRRZ	T1,LALHED	;GET FOOT POINTER
	HRRZ	T1,LALPNT(T1)	;GET POINTER TO NEXT WORD
	HRRM	T1,LALHED	;  AND MAKE THAT NEW FOOT POINTER
	MOVE	N,LALLOC(T1)	;GET LOCATION ASSIGNMENT
	MOVEM	N,PC(RAM)	;AND SAVE IN NORMAL PLACE
GETPC9:	POPJ	P,
PCNEXT:	MOVE	N,PC(RAM)
	SKIPN	RAM		;IF DISPATCH RAM,
	TRNE	F,SEQUEN	; OR SEQUENTIAL MODE
	AOJA	N,PCNXT2	;PC MERELY COUNTS
	JUMPGE	N,PCNXT1	;IF NOT IN ADR BLOCK, FIND 1ST FREE WORD
	MOVE	T2,N		;FIND BITS IN PC THAT
	AND	T2,LOCAST	;  SHOULD NOT CHANGE
	IOR	N,LOCAST	;INSERT BITS TO PROPOGATE CARRIES
	AOBJP	N,PCNXT1	;IF .GE. 0, FIND 1ST FREE WORD
	IOR	N,LOCPAT	;RE-INSERT BITS THAT MUST BE 1'S
	ANDCM	N,LOCAST	;MAKE ROOM FOR PC BITS THAT MUST NOT
	IOR	N,T2		;  CHANGE, AND INSERT THEM
PCNXT2:	MOVEM	N,PC(RAM)
	POPJ	P,

PCNXT1:	MOVEI	N,0		;START AT BEGINNING OF PREFERENCE LIST
PCNXT3:	SKIPN	T3,PRFTB3(N)	;GET NEXT AOBJN POINTER FOR PREF LIST
	MSG	CPOPJ, NO MORE MICROWORDS AVAILABLE
	MOVE	T1,PRFTB4(N)	;GET MASK FOR FIRST WORD OF USAGE TABLE
	TDZA	T1,USAGE(T3)	;CLEAR THE BIT IF ALREADY USED
PCNXT4:	SETCM	T1,USAGE(T3)	;LOOK FOR ZEROS IN USAGE
	JFFO	T1,PCNXT6	;JUMP IF ANY UNUSED WORDS HERE
	AOBJN	T3,PCNXT4	;ELSE LOOK AT NEXT WORD

PCNXT5:	HRRZM	T3,PRFTB3(N)	;MARK THIS REGION AS FULL
	AOJA	N,PCNXT3	;GO LOOK IN NEXT PREFERENCE BLOCK

;HERE WHEN A ZERO FOUND IN USAGE

PCNXT6:	MOVEM	T3,PRFTB3(N)	;NOTE WHERE WE FOUND A SPACE
	MOVEM	T1,PRFTB4(N)	;AND UPDATE MASK

	MOVEI	T1,(T3)		;GET LOCN IN USAGE
	IMULI	T1,^D36		;CONVERT TO ADDRESS
	ADDI	T1,(T2)		;GET ADDR FOR THIS BIT
	CAML	T1,PRFTB2(N)	;IS IT WITHIN PREFERENCE RANGE?
	JRST	PCNXT5		;NO, GO TO NEXT RANGE
	MOVEI	N,(T1)		;YES.  RETURN IT
	JRST	PCNXT2
;TEST PC LOCATION FOR PREVIOUS USAGE AND SET USAGE BITS

USEDPC:	HRRZ	N,PC(RAM)
	CAMLE	N,HIGHPC(RAM)
	MOVEM	N,HIGHPC(RAM)	;SAVE HIGHEST PC SO FAR
	JUMPN	RAM,USED1	;DIFFERENT IF DISPATCH
	IDIVI	N,^D36
	MOVN	T1,N1		;NEGATE REMAINDER FOR RIGHT SHIFTS
	MOVSI	N1,(1B0)
	LSH	N1,(T1)
	TDNE	N1,USAGE(N)
USDMSG:	MSG USDXIT, MICRO WORD USED TWICE
	IORM	N1,USAGE(N)
	JRST	USDXIT

USED1:	TRNN	F,PASS2		;COLLECT THIS ON PASS 2 ONLY
	JRST	USDXIT
	ROT	N,-1		;DIVIDE BY 2
	JUMPL	N,USED2		;ODD, USE RH
	HLRZ	N1,DTABL(N)	;PREVIOUS CONTENTS
	JUMPN	N1,USDMSG	;ERROR IF ALREADY SET
	MOVE	N1,LINNUM	;ELSE GET THIS LINE #
	HRLM	N1,DTABL(N)	;AND RECORD IT
	JRST	USDXIT		;OK RETURN

USED2:	HRRZ	N1,DTABL(N)
	JUMPN	N1,USDMSG
	MOVE	N1,LINNUM
	HRRM	N1,DTABL(N)
USDXIT:	POPJ	P,
PRINT:	POP	P,N
	PUSHJ	P,PRINT0
	JRST	1(N)

CRLF:	MOVEI	N,[ASCIZ /
/]
PRINT0:	HRLI	N,440700
PRINT1:	ILDB	C,N
	JUMPE	C,CPOPJ
	PUSHJ	P,@PUTP
	JRST	PRINT1

PNTSX0:	HRLI	N,440600	;SIXBIT PRINTER
PNTSX1:	TLNN	N,770000
	POPJ	P,
	ILDB	C,N
	JUMPE	C,CPOPJ
	ADDI	C,40		;CONVERT TO ASCII
	PUSHJ	P,@PUTP
	JRST	PNTSX1

PNTOCT:	TDZA	T1,T1
PNTOC4:	MOVEI	T1,4
PNTOC2:	PUSHJ	P,SGNCHK
PNTOC3:	IDIV	C,RADIX
	HRLM	C+1,(P)
	SOSG	T1
	SKIPE	C
	PUSHJ	P,PNTOC3
	JRST	PNTDC4

PNTDEC:	TDZA	T1,T1
PNTDC2:	MOVEI	T1,2
	PUSHJ	P,SGNCHK
PNTDC3:	IDIVI	C,^D10
	HRLM	C+1,(P)
	SOSG	T1
	SKIPE	C
	PUSHJ	P,PNTDC3
PNTDC4:	HLRE	C,(P)
	MOVMS	C
	CAILE	C,^D9
	ADDI	C,"A"-"9"-1	;10-15 BECOME A-F
	ADDI	C,"0"		;0-9 BECOME SAME CHARACTERS
	JRST	@PUTP

SGNCHK:	JUMPGE	C,CPOPJ
	PUSH	P,C
	MOVEI	C,"-"
	PUSHJ	P,@PUTP
	POP	P,C
	MOVMS	C
	POPJ	P,
TABTON:	PUSHJ	P,TAB
	CAMLE	N,HORPOS
	JRST	TABTON
	POPJ	P,

NEWLIN:	PUSHJ	P,CRLF		;SEND END OF LINE
	MOVE	N,VERPOS	;HOW FAR DOWN PAGE
	CAIGE	N,LPPAG		;COMPARE LINES PER PAGE LIMIT
	POPJ	P,
	JRST	FORM		;EJECT & PRINT NEW HEADER

SETHDR:	HRRZM	C,HDRPNT	;SAVE ADDR OF NEW SUBHEADER
FORM:	SKIPN	VERPOS		;ALREADY AT TOP OF PAGE?
	POPJ	P,		;YES, DON'T BE REDUNDANT
	SKIPA	C,[14]		;AND GET NEW PAGE
TAB:	MOVEI	C,11
	JRST	@PUTP
;HERE IS SINGLE-CHARACTER OUTPUT ROUTINE

PUTL:	SKIPGE	LISTSW		;IS LISTING ENABLED?
	JRST	[TRNN	F,ERROR		;NO.  SHOULD WE OUTPUT AN ERROR?
		JRST	PUTCHK		;NO, JUST GO COUNT THE PAGES
		JRST	PUT1]	;YES, CONSIDER LISTING ENABLED
PUT1:	SKIPGE	PAGNUM		;IS PAGE HEADER FLAG SET?
	JRST	HEADER		;NEW HEADER FOR NEW PAGE
PUT2:	PUSHJ	P,PUTCHK	;TAKE ANY SPECIAL ACTION REQUIRED FOR CHAR
PUT3:	SKIPN	OUTENA		;IS OUTPUT POSSIBLE?
	JRST	PUT5		;NO, DON'T TRY
	SOSG	OUTBLK+2	;IS BUFFER FULL?
	OUT	OUTCHN,		;YES, DO IT
	  JRST	PUT4		;ALL OK
	SETZM	OUTENA		;DISABLE OUTPUT.  AN ERROR OCCURED
	MSG CPOPJ, OUTPUT ERROR ON .MCR FILE

PUT4:	IDPB	C,OUTBLK+1
PUT5:	TRNE	F,ERROR
	OUTCHR	C
	POPJ	P,
;SUBROUTINE TO TRACK CHARACTER POSITION ON LINE AND PAGE

PUTCHK:	TRNN	C,140		;SPACING CHARACTER?
	JRST	PUTC2		;NO
	AOS	HORPOS		;INDEX HORIZONTAL LINE POSITION
	POPJ	P,

PUTC2:	CAIN	C,14
	JRST	[AOS PAGNUM
		HRROS PAGNUM	;SET HEADER FLAG
		SETZM SUBPAG
		SETZM VERPOS
		POPJ P, ]
	CAIN	C,15
	SETZM	HORPOS		;ZERO POSITION FOR CARRIAGE RETURN
	CAIN	C,12		;LF?
	JRST	PUTC3		;YES, COUNT NEW LINE
	CAIE	C,11
	POPJ	P,		;NOT HORIZONTAL TAB
	EXCH	C,HORPOS
	IORI	C,7
	ADDI	C,1
	EXCH	C,HORPOS
	POPJ	P,

;HERE ON LINE FEED.  CHECK TO SEE WHETHER PAGE IS OVERFLOWED

PUTC3:	AOS	C,VERPOS
	CAIG	C,LPPAG		;TOO MANY LINES ON PAGE?
	JRST	[MOVEI	C,12	;NO, RESTORE LF
		POPJ	P,]
	HRROS	PAGNUM		;REQUEST A NEW PAGE HEADER
	SOS	SUBPAG		;COUNT SUBPAGES
	SETZM	VERPOS		;RESET PAGE POSITION TO TOP
	MOVEI	C,14		;SUBSTITUTE FF FOR LF
	POPJ	P,
;PUT A CHARACTER INTO THE OUTPUT ULD ASCIZ FILE

IFN FTULD,<
PUTLU:	PUSHJ	P,PUTL		;PUT CHAR INTO LISTING
PUTU:	TRNN	F,DOULD		;WANT .ULD FILE?
	POPJ	P,0		;NO--DO NOT DO IT THEN
	JUMPE	C,PUTPOP	;SUPRESS NULL CHARACTER
	JUMPG	RAM,PUTPOP	;BYPASS IF DRAM
	SOSG	BUFOUT+2	;ADVANCE BYTE PTR
	PUSHJ	P,PUTU3		;OUTPUT BUFFERFULL
	IDPB	C,BUFOUT+1	;PUT BYTE INTO BUFFER
PUTPOP:	POPJ	P,

PUTU3:	OUT	OUTCH2,		;OUTPUT THE BUFFER
	  POPJ	P,		;NO ERROR
	TRZ	F,DOULD		;SUPPRESS FURTHER OUTPUT
	MSG CPOPJ1, OUTPUT ERROR ON .ULD FILE
>;END FTULD

;HERE TO PUT A CHARACTER INTO CORE STRING

PUTCOR:	SOSLE	PCORC		;CHECK COUNT
	JRST	PUTCR1		;MORE ROOM IN PRESENT SPACE
	PUSH	P,N		;DESTROY NOTHING FOR THIS
	MOVEI	N,1
	AOS	TXTCOR
	PUSHJ	P,GETWRD	;GRAB MORE CORE
	HRLI	N,(POINT 7,)	;CONVERT ADDRESS TO BYTE POINTER
	MOVEM	N,PCORP		;SETUP POINTER
	MOVEI	N,5		;NUMBER OF CHARACTERS THAT WILL GO IN WORD
	MOVEM	N,PCORC		;SET COUNT
	POP	P,N		;RESTORE N
PUTCR1:	IDPB	C,PCORP		;STORE CHAR INTO CORE STRING
	POPJ	P,
;PRINT HEADER ROUTINE

HEADER:	CAIN	C,14		;IS THIS DOUBLE FORM FEED?
	JRST	HEADFF		;YES, DON'T CREATE BLANK PAGE
	HRRZS	PAGNUM
	TRNN	F,NOHDR		;HEADERS SUPPRESSED?
	TRNN	F,PASS2		; OR PASS 1?
	JRST	PUT2		;YES, DO NOT GENERATE HEADER
	PUSH	P,16		;SAVE AC'S 0-16
	MOVEI	16,1(P)
	BLT	16,16(P)
	ADD	P,[16,,16]
	TRZ	F,ERROR		;DON'T SEND HEADER TO TTY
				; WILL BE RESTORED WITH AC'S
	PUSHJ	P,PRINT
	 ASCIZ /; /
	MOVEI	N,OUTFIL	;GET ADR OF OUTPUT FILE DESCRIPTOR
	PUSHJ	P,HEDNAM	;AND PRINT THE DESCRIPTOR
	MOVEI	N,^D32
	PUSHJ	P,TABTON	;POSITION THE VERSION STUFF
	PUSHJ	P,PRINT
	 ASCIZ /MICRO /
	PUSH	P,RADIX		;SAVE RADIX
	MOVEI	C,^D8		;AND FORCE OCTAL FOR VERSION OUTPUT
	MOVEM	C,RADIX
	LDB	C,[POINT 9,.JBVER,11]	;GET MAJOR VERSION #
	PUSHJ	P,PNTOCT
	LDB	N,[POINT 6,.JBVER,17]
	SOJL	N,HEAD2
	IDIVI	N,^D26
	JUMPE	N,HEAD3
	MOVEI	C,"A"-1(N)
	PUSHJ	P,PUTL
HEAD3:	MOVEI	C,"A"(N+1)
	PUSHJ	P,PUTL
HEAD2:	MOVEI	C,"("
	PUSHJ	P,PUTL
	HRRZ	C,.JBVER
	PUSHJ	P,PNTOCT
	MOVEI	C,")"
	PUSHJ	P,PUTL
	LDB	N,[POINT 3,.JBVER,2]	;GET CUSTOMER VERSION
	JUMPE	N,HEAD4
	MOVEI	C,"-"
	PUSHJ	P,PUTL
	MOVE	C,N
	PUSHJ	P,PNTOCT
HEAD4:	POP	P,RADIX		;RESTORE PREVAILING RADIX

	MOVE	N,SRCCOL	;SPACE OVER TO TITLE
	PUSHJ	P,TABTON
	SKIPN	N,TTLPNT	;IS THERE A TITLE?
	MOVEI	N,[ASCIZ /Microcode file/]
	PUSHJ	P,PRINT0	;PRINT A TITLE
;HERE TO DO PAGE # & 2ND LINE OF HEADER

	PUSHJ	P,PRINT
	 ASCIZ /	Page /
	HRRZ	C,PAGNUM
	PUSHJ	P,PNTDEC	;PRINT PAGE NUMBER
	SKIPE	C,SUBPAG	;IS THERE A SUBPAGE NUMBER?
	PUSHJ	P,PNTDEC	;YES.  PRINT IT.  NEGATIVE, SO GETS LEADING -
	PUSHJ	P,PRINT
	 ASCIZ /
; /
	SKIPE	N,HDRPNT	;SPECIAL HEADER?
	JRST	HEAD5		;YES
	MOVEI	N,INFILE	;GET CURRENT INPUT FILE DESCRIPTOR
	PUSHJ	P,HEDNAM
	HLRZ	N,TOCPNT	;GET SUBTTL STRING ADDR
	JUMPE	N,HEAD6		;MAKE SURE THERE'S SOMETHING TO PRINT
	MOVEI	N,1(N)		;POINT TO TEXT STRING
HEAD5:	PUSH	P,N		;SAVE SUBTITLE STRING ADDR
	MOVE	N,SRCCOL
	ADDI	N,^D8
	PUSHJ	P,TABTON	;TAB OVER FOR SUBTITLE
	POP	P,N		;GET BACK SUBTITLE STRING
	PUSHJ	P,PRINT0	;PRINT SUBTTL OR SPECIAL HEADER
HEAD6:
;***************
;		THIS CODE FILLS OUT BLANKS IF SUBTITLE IS SHORTER THAN
;		64 CHARACTERS SO THAT THE STUPID COM MACHINE WON'T GET
;		GARBAGE FROM THE TITLE LINE INCLUDED IN ITS INDEX ENTRIES.
	MOVE	N,SRCCOL	;GET COLUMN WHERE SUBTITLE GOES
	ADDI	N,^D64		;FIND POSITION 64 LATER
	CAMLE	N,HORPOS	;ARE WE THERE YET?
	PUSHJ	P,TABTON	;NO, GET THERE
;***************
	PUSHJ	P,CRLF
	PUSHJ	P,CRLF
	AOS	PAGCNT		;COUNT TOTAL PAGES OUTPUT
	SUB	P,[16,,16]
	MOVSI	16,1(P)
	BLT	16,15
	POP	P,16
	JRST	PUT2		;RESUME WHERE WE LEFT OFF

;HERE WHEN ABOUT TO THROW A PAGE AND PRINT THE HEADER, AND WE
;DISCOVER THAT NEXT CHARACTER IS A FORM FEED

HEADFF:	SKIPN	SUBPAG		;WERE WE ABOUT TO PRINT A SUBPAGE HEADING?
	POPJ	P,		;NO, THIS IS DOUBLE FORM FEED IN INPUT.  IGNORE
	SETZM	SUBPAG		;YES, TREAT AS A NEW PAGE
	AOS	PAGNUM
	POPJ	P,		;IGNORE THIS FF. WE PUT ONE IN FOR SUBPAGE
;SUBR TO PRINT FILENAME, TIME, AND DATE

HEDNAM:	PUSH	P,N		;SAVE DESCRIPTOR POINTER
	ADDI	N,.RBNAM	;POINT TO FILE NAME
	PUSHJ	P,PNTSX0
	MOVEI	C,"."
	PUSHJ	P,@PUTP
	MOVE	N,(P)
	PUSH	P,.RBEXT(N)
	HLLZS	(P)		;GUARANTEE EXTENSION IS ONLY 3 CHARS
	MOVEI	N,0(P)
	PUSHJ	P,PNTSX0
	POP	P,N		;RESTORE STACK
	MOVE	N,(P)
	SKIPN	.RBPPN(N)
	JRST	HEDNM2
	PUSH	P,RADIX		;PPN IS ALWAYS OCTAL
	MOVEI	C,^D8
	MOVEM	C,RADIX		;FORCE IT
	MOVEI	C,"["		;OUTPUT PROJ,PROG
	PUSHJ	P,@PUTP
	HLRZ	C,.RBPPN(N)
	PUSHJ	P,PNTOCT
	MOVEI	C,","
	PUSHJ	P,@PUTP
	HRRZ	C,.RBPPN(N)
	PUSHJ	P,PNTOCT
	MOVEI	C,"]"
	PUSHJ	P,@PUTP
	POP	P,RADIX		;RESTORE PREVAILING RADIX
;HERE TO PRINT DATE AND TIME OF FILE

HEDNM2:	PUSHJ	P,TAB
	POP	P,N		;GET POINTER TO BLOCK BACK
	LDB	C,[POINT 12,.RBPRV(N),35]	;GET LOW PART OF DATE
	LDB	C1,[POINT 3,.RBEXT(N),20]	;GET HIGH PART OF DATE
	DPB	C1,[POINT 3,C,23]		;AND STICK ONTO LOW PART
	JUMPE	C,CPOPJ		;IF 1-JAN-1964, SUPPRESS DATE AND TIME
	PUSH	P,C		;SAVE DATE
	LDB	C,[POINT 11,.RBPRV(N),23]
	IDIVI	C,^D60		;GET MINUTES INTO C+1
	PUSH	P,C+1
	PUSHJ	P,PNTDC2	;PRINT HOURS
	MOVEI	C,":"
	PUSHJ	P,@PUTP
	POP	P,C		;GET MINUTES BACK
	PUSHJ	P,PNTDC2	; AND PRINT
	MOVEI	C," "
	PUSHJ	P,@PUTP
	POP	P,C		;GET DATE BACK
	IDIVI	C,^D31
	PUSH	P,C		;SAVE MONTH AND YEAR
	MOVEI	C,1(C+1)		;GET DAY
	PUSHJ	P,PNTDEC	; AND PRINT
	POP	P,C		;GET MONTH AND YEAR BACK
	IDIVI	C,^D12
	PUSH	P,C		;SAVE YEAR
	MOVEI	N,[SIXBIT /-JAN-/
		SIXBIT /-FEB-/
		SIXBIT /-MAR-/
		SIXBIT /-APR-/
		SIXBIT /-MAY-/
		SIXBIT /-JUNE-/
		SIXBIT /-JULY-/
		SIXBIT /-AUG-/
		SIXBIT /-SEPT-/
		SIXBIT /-OCT-/
		SIXBIT /-NOV-/
		SIXBIT /-DEC-/ ] (C+1)	;INDEX INTO TABLE BY MONTH
	PUSHJ	P,PNTSX0
	POP	P,C		;GET YEAR BACK
	ADDI	C,^D1964	;ADD IN BASE YEAR
	PUSHJ	P,PNTDEC
	POPJ	P,
;HERE TO PRINT ERROR MESSAGE
;CALLED BY LUUO

UUOH:	TRO	F,ERROR
	AOS	ERRCNT
	PUSH	P,C		;SAVE REGS
	PUSH	P,N
	PUSH	P,T1
	PUSH	P,PUTP		;SAVE PREVAILING OUTPUT ROUTINE
	MOVEI	T1,PUTL		;MAKE IT LISTING
	MOVEM	T1,PUTP
	MOVE	N,40		;GET ERROR LUUO
	HRRZ	T1,(N)
	MOVEM	T1,-4(P)	;SAVE RETURN

;FIRST LINE -- MESSAGE TEXT AS SPECIFIED BY CALLER

	MOVEI	C,";"
	PUSHJ	P,PUTL
	HLRZ	N,(N)		;GET ADR OF MSG
	PUSHJ	P,PRINT0

;SECOND LINE -- CONTEXT OF ERROR

	PUSHJ	P,PRINT
	 ASCIZ /
; /
	MOVEI	N,[ASCII /U= /
		   ASCII /D= / ](RAM)
	PUSHJ	P,PRINT0
	HRRZ	C,PC(RAM)
	PUSHJ	P,PNTOC4
	MOVEI	N,[ASCIZ /, /]
	SKIPN	NAME
	SKIPE	FIELD
	PUSHJ	P,PRINT0	;GIVE COMMA SPACE IF FIELD OR NAME TO BE PRINTED
	MOVEI	N,FIELD
	PUSHJ	P,PRINT0
	MOVEI	C,"/"
	SKIPE	FIELD
	PUSHJ	P,PUTL
	MOVEI	N,NAME
	PUSHJ	P,PRINT0
;ERROR MESSAGE OUTPUT, CONTINUED

	MOVE	N,I.MAXC	;# OF SOURCE FILES
	CAIG	N,1		; MORE THAN ONE?
	JRST	UUOHP		;NO. NO NEED TO IDENTIFY WHICH
	PUSHJ	P,PRINT		;YES.  IDENTIFY IT
	 ASCIZ /, FILE= /
	MOVEI	N,INFILE+.RBNAM	;ADDR OF CURRENT INPUT NAME
	PUSHJ	P,PNTSX0	;PRINT IT
	MOVEI	C,"."
	PUSHJ	P,PUTL		;MARK EXTENSION
	PUSH	P,INFILE+.RBEXT	;PUT EXT ONTO STACK
	HLLZS	0(P)		;STRIP IT TO 3 CHARS
	MOVEI	N,0(P)		;GET ITS ADDRESS
	PUSHJ	P,PNTSX0	;NOW PRINT EXTENSION
	POP	P,N		; RESTORE P
UUOHP:	TRNN	F,PASS2
	JRST	UUOHL		;PAGE # MEANINGLESS ON PASS 1
	PUSHJ	P,PRINT
	 ASCIZ /, PAGE= /
	HRRZ	C,PAGNUM
	PUSHJ	P,PNTDEC
UUOHL:	PUSHJ	P,PRINT
	 ASCIZ /, LINE= /
	HRRZ	C,LINNUM
	PUSHJ	P,PNTDEC
IFN FTECHR,<
	PUSHJ	P,PRINT
	 ASCIZ /, CHAR= /
	MOVE	C,-2(P)		;GET C BACK
	MOVEI	T1,3		;TYPE 3 OCTAL DIGITS
	PUSHJ	P,PNTOC2
>;END IFN FTECHR
; NOW PRINT STARS OVER BAD TOKEN

	SKIPGE	DOBIN
	TDZA	T1,T1		;IF NO BINARY, SOURCE STARTS AT FIRST TAB
	MOVE	T1,SRCCOL	;SPACE TAKEN BY BINARY OUTPUT
	IORI	T1,7		;ROUNDED TO NEXT TAB
	ADDI	T1,^D9+PNTMAX	; ANOTHER TAB, THEN LENGTH OF SRC BUFFER
	SUB	T1,PNTTOK	;MINUS AMOUNT LEFT IN SRC BUFFER
	SUB	T1,HORPOS	;MINUS AMOUNT ALREADY USED
				; IS DISTANCE FROM HERE TO THERE
	JUMPG	T1,UUOHM
	ADD	T1,HORPOS	;IF NEG, GO BACK TO BEGINNING OF LINE
	SUBI	T1,1		; (ALLOW FOR SEMICOLON AT BEGIN OF LINE)
	PUSHJ	P,PRINT
	 ASCIZ /
;/
UUOHM:	MOVEI	C," "
	PUSHJ	P,PUTL		;SPACE OVER TO BEGINNING OF BAD TOKEN
	SOJG	T1,.-1
	MOVE	T1,PNTTOK	;THERE'S BEGINNING OF TOKEN
	SUB	T1,PNTCNT	; HERE'S END.   DIFFERENCE IS LENGTH
	MOVEI	C,"*"
	PUSHJ	P,PUTL		;MARK BAD TOKEN WITH STARS
	SOJG	T1,.-1
	PUSHJ	P,CRLF
	POP	P,PUTP		;RESTORE OUTPUT ROUTINE
	POP	P,T1		;RESTORE REGS
	POP	P,N
	POP	P,C
	POPJ	P,
STOP:	SKPINC		;TURN OFF ^O
	 JFCL
XX=-1
REPEAT ^D16,<	MOVEM	<XX=XX+1>,SAVACS+XX >
	MSG .+1,< INTERNAL ERROR, "SAVE" CORE IMAGE
AND CALL JUD LEONARD, MAYNARD, X6819>
	EXIT
BEGIO:	SETZM	I.SPEC		;START LOOKING AT 1ST FILE
	MOVE	T1,I.MAXC
	MOVNM	T1,I.CNT	;INIT COUNTER TO NUMBER OF FILES
NXTFIL:	SETOM	ENDFIL		;SET END-OF-FILE INDICATOR
	SKIPL	I.CNT
	POPJ	P,		;NO FILES LEFT
	PUSHJ	P,ALLIN		;GET NEXT INPUT FILE DESCRIPTOR
	PUSHJ	P,GETFIL
	TRNE	F,PASS2
	JRST	NXTF1		;ON PASS 2, DON'T NEED TO CREATE FILE LIST
	PUSH	P,[.LLFIL]	;BUILD ENTRY FOR LALLST
	PUSH	P,I.SPEC
	PUSHJ	P,LALSTO

NXTF1:	SETZM	T1
	SKIPN	T2,I.DEV(C)
	MOVSI	T2,'DSK'
	MOVEM	T2,INDEV	;SAVE INPUT DEVICE
	MOVEI	T3,INBLK
	OPEN	INCHN,T1
	  MSG CPOPJ, CAN NOT OPEN INPUT DEVICE
	SKIPN	T1,BUFADR	;GET SAVED .JBFF FOR BUFFER AREA
	JRST	[MOVE	T1,.JBFF##
		MOVEM	T1,BUFADR
		ADDI	T1,203*NINBUF	;ALLOW FOR N DISK BUFFERS, AT LEAST
		JRST	.+2]
	EXCH	T1,.JBFF##	;AND RECLAIM BUFFER SPACE
	INBUF	INCHN,NINBUF	;ALLOCATE N INPUT BUFFERS
	CAML	T1,.JBFF
	MOVEM	T1,.JBFF	;SAVE LARGEST .JBFF

	MOVEI	T1,.RBPRV	;SIZE OF LOOKUP BLOCK
	MOVEM	T1,INFILE+.RBCNT
	LOOKUP	INCHN,INFILE
	  MSG	CPOPJ, CAN NOT LOOKUP INPUT FILE
	SETZM	ENDFIL		;CLEAR END-OF-FILE INDICATOR

	TRNE	F,PASS2		;PASS1?
	JRST	CPOPJ1		;NO, DON'T BOTHER
	PUSHJ	P,MAKTOC	;ENTER NEW SOURCE INTO TABLE OF CONTENTS
	PUSH	P,PUTP		;SAVE CURRENT OUTPUT ROUTINE
	MOVEI	T1,PUTCOR	;OUTPUT TO CORE
	MOVEM	T1,PUTP
	SETZM	PCORC		;FORCE IT TO GET MORE CORE
	PUSHJ	P,TAB
	MOVEI	N,INFILE
	PUSHJ	P,HEDNAM	;ADD FILE NAME
	MOVEI	C,0
	PUSHJ	P,PUTCOR	;TERMINATE CORE STRING AS ASCIZ
	POP	P,PUTP		;RESTORE OUTPUT ROUTINE
CPOPJ1:	AOS	(P)		;FILE FOUND, SKIP RETURN
CPOPJ:	POPJ	P,
;HERE TO GET A FILE SPEC READY FOR INPUT

GETFIL:	MOVE	C,I.SPEC	;ADDRESS AT WHICH SPECIFIER DATA IS STORED
	MOVE	T1,I.NAM(C)
	SKIPN	I.NAM+1(C)
	MOVE	T1,[SIXBIT /MICRO/]
	MOVEM	T1,INFILE+.RBNAM
	HLLZ	T2,I.EXT(C)
	SKIPN	I.EXT(C)
	MOVSI	T2,'MIC'
	MOVEM	T2,INFILE+.RBEXT
	SETZB	T3,INFILE+.RBPRV
	MOVE	T4,I.PPN(C)
	MOVEM	T4,INFILE+.RBPPN	;SAVE PROJ,PROG
	POPJ	P,
ALLIN:	HRRZ	T1,.JBFF##		;GET DEFAULT INPUT SPEC LOCATION
	SKIPN	I.FILE
	MOVEM	T1,I.FILE		;SET DEFAULT INPUT SPEC LOC

	SKIPN	T1,I.SPEC		;LOOKING FOR 1ST SPEC?
	SKIPA	T1,I.FILE		;YES, START AT BEGINNING
	ADDI	T1,I.LEN	;GET ADR OF NEXT SPEC
	MOVEM	T1,I.SPEC	;  AND SAVE
	ADDI	T1,I.LEN+1	;ALLOW ROOM FOR WHOLE SPEC
	CAML	T1,.JBFF##
	HRRZM	T1,.JBFF	;PROTECT THIS FILE SPEC
	CAMG	T1,.JBREL##
	JRST	ALLIN2		;THERE IS ENOUGH CORE
	CORE	T1,
	  MSG [EXIT], NOT ENOUGH CORE FOR COMMAND SCANNER
ALLIN2:	AOS	I.CNT
	MOVE	T1,I.SPEC	;POINT TO THIS DESCRIPTOR
	MOVEI	T2,I.LEN
	POPJ	P,

ALLOUT:	TROE	F,DOLST		;LIST FILE GIVEN?
	JRST	ALOUT1		;YES--THIS IS .ULD FILE
	MOVEI	T1,O.DEV
	MOVEI	T2,O.LEN
	POPJ	P,
ALOUT1:	TROE	F,DOULD
	  MSG	[EXIT],TOO MANY OUTPUT FILES GIVEN
	MOVEI	T1,U.DEV
	MOVEI	T2,U.LEN
	POPJ	P,0

.TNEWL::
	POPJ	P,


REPEAT 0,<
;GENERATE CONSISTENT RUN TIME UNDER TOPS-20
ADJT20:	MOVE	T1,[112,,11]		;IS THIS TOPS-20
	GETTAB	T1,			; ..
	  POPJ	P,0			;OLD TOPS-10
	CAIE	T1,40000		;MAGIC NUMBER
	POPJ	P,0			;TOPS-10
	MOVEI	T1,400000		;THIS FORK
	JSYS	172			;GTRPI
	SUB	C,T3			;DISCOUNT PAGER TIME
	POPJ	P,0			;RETURN
> ;END REPEAT 0
DEFINE	DEFLST,<		;TABLE OF SPECIAL DEFINE FUNCTIONS
	DEF	0,,BITSET
	DEF	"+",DEFJ,PCINC
	DEF	"D",DEFF90,BITSET
	DEF	"T",,TIMSET
	DEF	"P",,PARITY
	DEF	"J",DEFJ,BITSET
	DEF	"F",DEFF80,FLDSET
>;END DEFLST DEFINITION

DEFINE	DEF(A,B,C),<	XWD	A,C	>
DEFTAB:	DEFLST
DEFTND:
DEFINE	DEF(A,B,C),<
IFB <B>,<	Z	CPOPJ	>
IFNB <B>,<	Z	B	>
>
DEFTB2:	DEFLST
DEFTM1:	POINT	6,SYMVAL(SPNT),5	;TIME VALUE #1 (SYMBOL ONLY)
DEFTM2:	POINT	6,SYMVAL(SPNT),11	;TIME VALUE #2 (SYMBOL ONLY)
DEFPOS:	POINT	9,SYMVAL(FPNT),8	;MICRO WORD POSITION (FIELD ONLY)
DEFSIZ:	POINT	6,SYMVAL(FPNT),17	;MICRO WORD FIELD SIZE (FIELD ONLY)
DEFVAL:	POINT	18,SYMVAL(SPNT),35	;VALUE OF SYMBOL
				; OR POINTS TO 1ST CHAR OF MACRO EXPANSION
				; OR HANDLER ADR OF PSEUDO OP
				; OR ANOTHER FIELD FOR A DEFAULT
DEFFLG:	POINT	6,SYMFLG(SPNT),5	;FLAGS FOR A SYMBOL
DEFTYP:	POINT	6,SYMFLG(SPNT),11	;"UCODE" OR "DISP" NUMBER
DEFFNC:	POINT	6,SYMFLG(SPNT),17	;FUNCTION TO EXECUTE
DEFPNT:	POINT	18,SYMFLG(SPNT),35	;SYMBOLIC FIELD DEFAULT POINTER

	;FIELD NAME FOR MACRO DEFINITIONS

MACRO:	ASCIZ /MACRO%/
	REPEAT NWORDS-2,<	0>
SWTCH:	ASCIZ	/SWITCH%/
	REPEAT NWORDS-2,<	0>

;CHARACTER TABLES
COL==1
COM==2
EOL==3
EQL==4
QOT==5
SLSH==6

TOKTYP:	POINT 4,CHRTAB(C),3		;GET CHARACTER TYPE FOR TOKEN BUILDER
STAPNT:	POINT .SZTRM,CHRTAB(C),3+.SZTRM	;TERM TYPE FOR TOP LEVEL STATE
GETPNT:	POINT	7,CHRTAB(C1),35		;CHARACTER TRANSLATION
DIGPNT:	POINT	4,CHRTAB(C),28		;DIGIT VALUE OF CHARACTER

DEFINE BYTS (TYP,TERM,TRAN),<
XLIST
..X==.-CHRTAB
..N==0			;"NUMERIC VALUE" OF CHAR
IFGE <..X-"0">,<	IFLE <..X-"9">,<	..N==..X-"0" >>
IFGE <..X-"A">,<	IFLE <..X-"F">,<	..N==..X-"A"+^D10 >>
IFGE <..X-"a">,<	IFLE <..X-"f">,<	..N==..X-"a"+^D10 >>
	BYTE (4)TYP(.SZTRM)TERM(^D21-.SZTRM)0(4)..N(7)TRAN
LIST	>

CHRTAB:		;CHARACTER LOOK UP TABLE
		;FIRST PARAMETER IS CHARACTER TYPE
		;SECOND IS TERMINATOR SUB-TYPE
		;THIRD IS TRANSLATED VALUE
BYTS  ,,0		; NUL
BYTS  ,,1		; SOH
BYTS  ,,2		; STX
BYTS  ,,3		; ETX
BYTS  ,,4		; EOT
BYTS  ,,5		; ENQ
BYTS  ,,6		; ACK
BYTS  ,,7		; BEL

BYTS  ,,10		; BS
BYTS  ,,40		; HT
BYTS  ,EOL,12		; LF
BYTS  ,EOL,12		; VT
BYTS  ,EOL,12		; FF
BYTS  ,,00		; CR
BYTS  ,,16		; SO
BYTS  ,,17		; SI
BYTS  ,,20		; DLE
BYTS  ,,21		; DC1
BYTS  ,,22		; DC2
BYTS  ,,23		; DC3
BYTS  ,,24		; DC4
BYTS  ,,25		; NAK
BYTS  ,,26		; SYN
BYTS  ,,27		; ETB

BYTS  ,,30		; CAN
BYTS  ,,31		; EM
BYTS  ,,32		; SUB
BYTS  ,,33		; ESC
BYTS  ,,34		; FS
BYTS  ,,35		; GS
BYTS  ,,36		; RS
BYTS  ,,37		; US

BYTS 1,," "		; SP=40
BYTS 7,,"!"		; !
BYTS  ,QOT,042		; "
BYTS 7,,"#"		; #
BYTS  ,,"$"		; $
BYTS  ,,"%"		; %
BYTS 7,,"&"		; &
BYTS  ,,"'"		; '

BYTS 7,,<"(">		; (
BYTS 7,,<")">		; )
BYTS 7,,"*"		; *
BYTS 3,,"+"		; +
BYTS  ,COM,<",">		; ,
BYTS 4,,"-"		; -
BYTS 2,,"."		; .
BYTS  ,SLSH,"/"		; /

BYTS 5,,"0"		; 0
BYTS 5,,"1"		; 1
BYTS 5,,"2"		; 2
BYTS 5,,"3"		; 3
BYTS 5,,"4"		; 4
BYTS 5,,"5"		; 5
BYTS 5,,"6"		; 6
BYTS 5,,"7"		; 7
BYTS 6,,"8"		; 8
BYTS 6,,"9"		; 9
BYTS  ,COL,":"		; :
BYTS  ,EOL,073		; ;
BYTS  ,,074		; <
BYTS  ,EQL,"="		; =
BYTS  ,,076		; >
BYTS 7,,"?"		; ?

BYTS 11,,"@"		; @
BYTS 10,,"A"		; A
BYTS 10,,"B"		; B
BYTS 10,,"C"		; C
BYTS 10,,"D"		; D
BYTS 10,,"E"		; E
BYTS 10,,"F"		; F
BYTS 7,,"G"		; G

BYTS 7,,"H"		; H
BYTS 7,,"I"		; I
BYTS 7,,"J"		; J
BYTS 7,,"K"		; K
BYTS 7,,"L"		; L
BYTS 7,,"M"		; M
BYTS 7,,"N"		; N
BYTS 7,,"O"		; O

BYTS 7,,"P"		; P
BYTS 7,,"Q"		; Q
BYTS 7,,"R"		; R
BYTS 7,,"S"		; S
BYTS 7,,"T"		; T
BYTS 7,,"U"		; U
BYTS 7,,"V"		; V
BYTS 7,,"W"		; W

BYTS 7,,"X"		; X
BYTS 7,,"Y"		; Y
BYTS 7,,"Z"		; Z
BYTS 7,,133		; [ (RESERVED FOR USE AS MACRO ARGUMENT DELIMITER)
BYTS  ,,"\"		; \
BYTS 7,,135		; ] (RESERVED FOR USE AS MACRO ARGUMENT DELIMITER)
BYTS  ,,"^"		; ^
BYTS 7,,"_"		; _
BYTS  ,,140		; `
BYTS 10,,"A"		; A (LOWER CASE)
BYTS 10,,"B"		; B
BYTS 10,,"C"		; C
BYTS 10,,"D"		; D
BYTS 10,,"E"		; E
BYTS 10,,"F"		; F
BYTS 7,,"G"		; G

BYTS 7,,"H"		; H
BYTS 7,,"I"		; I
BYTS 7,,"J"		; J
BYTS 7,,"K"		; K
BYTS 7,,"L"		; L
BYTS 7,,"M"		; M
BYTS 7,,"N"		; N
BYTS 7,,"O"		; O

BYTS 7,,"P"		; P
BYTS 7,,"Q"		; Q
BYTS 7,,"R"		; R
BYTS 7,,"S"		; S
BYTS 7,,"T"		; T
BYTS 7,,"U"		; U
BYTS 7,,"V"		; V
BYTS 7,,"W"		; W

BYTS 7,,"X"		; X
BYTS 7,,"Y"		; Y
BYTS 7,,"Z"		; Z
BYTS  ,,173		; {
BYTS  ,,174		; |
BYTS  ,,175		; }
BYTS  ,,176		; ~
BYTS  ,,000		; DEL

IFN	.-CHRTAB-^D128,<PRINTX CHARACTER TABLE MESSED UP>

IF1,
<	.MXSTA==0
	.MXTOK==0
	.MXTRM==0
	.MXDSP==0
DEFINE ITEM (STATE,TOKTYP,TRMTYP,DISP,NSTATE)<
	IFG STATE-.MXSTA,<.MXSTA==STATE>
	IFG TOKTYP-.MXTOK,<.MXTOK==TOKTYP>
	IFG TRMTYP-.MXTRM,<.MXTRM==TRMTYP>
	IFG <DISP-STDISP>/2-.MXDSP,<.MXDSP==<DISP-STDISP>/2>
	IFG NSTATE-.MXSTA,<.MXSTA==NSTATE>
	>	;END OF DEFINE ITEM
DEFINE EXPAND (N)
<	BLOCK	1
	>	;END OF DEFINE EXPAND
>	;END OF IF1

IF2,<	DEFINE ITEM (STATE,TOKTYP,TRMTYP,DISP,NSTATE)<
	.XE==<STATE_.SZTOK+TOKTYP>_.SZTRM+TRMTYP
	.XN==^D36/<.SZDSP+.SZSTA>
	.XV==<<DISP-STDISP>/2>_.SZSTA+NSTATE
	INSERT \<.XE/.XN>,\<.XE-.XE/.XN*.XN>
	>	;END OF DEFINE ITEM

DEFINE INSERT (Q,R)<
	IFNDEF .ENT'Q,<.ENT'Q==0>
	.ENT'Q==.ENT'Q+.XV_<^D36-<R+1>*<.SZDSP+.SZSTA>>
	>	;END OF DEFINE INSERT

DEFINE EXPAND (N)<
	IFNDEF	.ENT'N,<.ENT'N==0>
	EXP	.ENT'N
	>	;END OF DEFINE EXPAND
>	;END OF IF2
;	OLD STATE	TOKEN	TERM	DISP	NEW STATE

	ITEM	0,	.TKB,	EQL,	DLBLK,	0
	ITEM	0,	.TKS,	COL,	DTAG,	0
	ITEM	0,	.TKN,	COL,	DLSET,	0
	ITEM	0,	.TKS,	EQL,	DDEFS,	0
	ITEM	0,	.TKS,	SLSH,	DCFLD,	1
	ITEM	0,	.TKS,	QOT,	DMDEF,	0
	ITEM	0,	.TKS,	EOL,	DSUDO,	0
	ITEM	0,	.TKS,	COM,	DMAC,	0
	ITEM	0,	.TKB,	EOL,	DNOP,	0
;??	ITEM	1,	.TKS,	EQL,	DDEFS,	0
	ITEM	1,	.TKB,	EQL,	DDEFF,	0
	ITEM	1,	.TKS,	COM,	DFSYM,	2
	ITEM	1,	.TKS,	EOL,	DFSYM,	0
	ITEM	1,	.TKN,	COM,	DFNUM,	2
	ITEM	1,	.TKN,	EOL,	DFNUM,	0
	ITEM	2,	.TKS,	SLSH,	DFLD,	3
	ITEM	2,	.TKS,	COM,	DMAC,	2
	ITEM	2,	.TKS,	EOL,	DMAC,	2
	ITEM	2,	.TKB,	EOL,	DNOP,	2
	ITEM	3,	.TKS,	COM,	DFSYM,	2
	ITEM	3,	.TKS,	EOL,	DFSYM,	0
	ITEM	3,	.TKN,	COM,	DFNUM,	2
	ITEM	3,	.TKN,	EOL,	DFNUM,	0
IFN FTIF,<	;CONDITIONAL ASSEMBLY STATES
	ITEM	4,	.TKB,	EQL,	DCMNT,	4
	ITEM	4,	.TKS,	COL,	DNOP,	4
	ITEM	4,	.TKN,	COL,	DNOP,	4
	ITEM	4,	.TKS,	EQL,	DCMNT,	4
	ITEM	4,	.TKS,	SLSH,	DCSUP,	4
	ITEM	4,	.TKS,	QOT,	DCMNT,	4
	ITEM	4,	.TKS,	EOL,	DCMNT,	4
	ITEM	4,	.TKS,	COM,	DCMNT,	4
	ITEM	4,	.TKB,	EOL,	DCMNT,	4
>;END IFN FTIF

;STATE	MEANING
; 0	START OF LINE/MICROWORD
; 1	SYMBOL/ SCANNED AT START OF LINE/MICROWORD
; 2	COMMA SEEN, SO IN MIDDLE OF MICROWORD
; 3	SYMBOL/ SCANNED IN MIDDLE OF MICROWORD
; 4	ASSEMBLY SUPPRESSED

DEFINE LOG2 (A,B)
<	A==0
	REPEAT ^D35,<IFGE B-1_A,<A==A+1>
	> >	;END OF DEFINE LOG2

	LOG2 .SZTOK,.MXTOK
	LOG2 .SZSTA,.MXSTA
	LOG2 .SZTRM,.MXTRM
	LOG2 .SZDSP,.MXDSP
;POINTERS FOR ADDRESSING STATE TABLE AS BYTE ARRAY

STAMTB:	PINDEX	.SZDSP+.SZSTA,STATAB(T1)

STATAB:	XLIST	;EXPANSION OF STATE TABLE
	XX=-1
	REPEAT 1+<1_<.SZSTA+.SZTOK+.SZTRM>/<^D36/<.SZDSP+.SZSTA>>>,
	<	EXPAND \<XX==XX+1>
>
	LIST

;FAKED SYMBOL TABLE ENTRIES FOR PSEUDO OPS
DEFINE	STE	(TEXT,DISP,%NEXT,%A),<
	XLIST
	XWD	%NEXT,0
%A:	ASCII	"TEXT"
REPEAT NWORDS-<.-%A>,<	0>
	XWD	0,DISP
	EXP	DEFF_^D30
	EXP	0
	%%TAG==1
IFIDN <%NEXT><0>,<%%TAG==0>
IFN   %%TAG,< %NEXT:>
	LIST	>
;PSEUDO SYMBOL TABLE FOR PSEUDO-OPS

PSUDO%:	XWD	.+1,0		;FIELD NODE
	STE	.BIN,$BIN
	STE	.CREF,$CREF
	STE	.DCODE,$DCODE
	STE	.HEXADECIMAL,$HEX
	STE	.LIST,$LIST
	STE	.NOBIN,$NOBIN
	STE	.NOCREF,$NOCRF
	STE	.NOLIST,$NOLIS
	STE	.OCTAL,$OCTAL
	STE	.PAGE,$PAGE
	STE	.RANDOM,$RAND
	STE	.RTOL,$RTOL
	STE	.SEQUENTIAL,$SEQU
	STE	.UCODE,$UCODE,0

PSUDM%:	XWD	.+1,0	;FIELD NODE FOR PSEUDO-MACROS
	STE	.PAGE,$PAGET
	STE	.TITLE,$TITLE
	STE	.TOC,$TOC,0

;FAKED SYMBOL TABLE ENTRIES FOR CONDITIONAL ASSEMBLY OPERATORS
	IFN FTIF,<
PSUDF%:	XWD	.+1,0		;FIELD NODE FOR PSEUDO-FIELDS

	STE	.CHANGE,$CHNG
	STE	.DEFAULT,$DEFLT
	STE	.ENDIF,$ENDIF
	STE	.IF,$IF
	STE	.IFNOT,$IFNOT
	STE	.MACHINE,$MACH
	STE	.REGION,$REGN
	STE	.SET,$SET
	STE	.WIDTH,$WIDTH,0

;SYMBOL TABLE ENTRIES USED WHILE ASSEMBLY IS SUPPRESSED

PSUDS%:	XWD	.+1,0		;FIELD NODE
	STE	.ENDIF,$ENDIF
	STE	.IF,$IF
	STE	.IFNOT,$IFNOT,0

;SYMBOLS FOR .MACHINE PSEUDO-OP

MACHL:	XWD	.+1,0
	STE	KL10,M$KL10
	STE	STAR,M$STAR,0
>;END IFN FTIF
	XLIST	;LITERALS
	LIT
	LIST
	RELOC	0
PAT==.
PATCH:	BLOCK	40	;PATCH SPACE, INTENTIONALLY NOT ZERO'D
SAVACS:	BLOCK	^D16		;AC STORAGE DURING FATAL ERRORS
GOBLT:				;START OF BLT TO ZERO MEMORY
	VAR
VERPOS:	BLOCK	1		;LINE NUMBER ON PAGE
HORPOS:	BLOCK	1		;COLUMN NEXT OUTPUT CHARACTER WILL GO INTO
FLDPNT:	BLOCK	1		;POINTS TO BEGINNING OF SYMBOL TABLE
MAXPOS:	BLOCK	2		;LARGEST BIT POSITION DEFINED FOR MICRO CODE
VALUE:	BLOCK	MICMXW		;HOLDS BINARY MICRO CODE UNDER CONSTRUCTION
VALSET:	BLOCK	MICMXW		;1S IN ALL FIELDS WHERE ITEMS INSERTED INTO "VALUE"
TIME1:	BLOCK	1		;TIME VALUE #1 MAXIMUM
TIME2:	BLOCK	1		;TIME VALUE #2 MAXIMUM
VALEND:				;END OF BLT TO INIT A MICRO WORD
TKZER:				;BLOCK TO ZERO FOR EACH TOKEN SCAN
TOKMIN:	BLOCK	1		;FLAG NUMERIC TOKEN IS NEGATIVE
TOKOCT:	BLOCK	1		;BUILDING OCTAL VALUE
TOKDEC:	BLOCK	1		; DECIMAL TOKEN VALUE
NUMBER:	BLOCK	1		;NUMERIC RESULT OF TOKEN SCANNER
NAME:	BLOCK	MACMAX		;ASCII TEXT FOR SYMBOL NAME
TKZEND:				;END OF BLT TO INIT A TOKEN
FIELD:	BLOCK	NWORDS		;ASCII TEXT FOR FIELD NAME
PC:	BLOCK	2		;MICRO WORD LOCATION COUNTER
STATE:	BLOCK	1		;SYNTAX SCANNER STATE
ENDFIL:	BLOCK	1		;NON-0 INDICATES END OF ALL INPUT DATA
CHRPNT:	BLOCK	1		;HOLDS 0, OR BYTE POINTER FOR RESCANS
INBLK:	BLOCK	3		;BLOCK FOR DOING INPUT FILE IO
OUTBLK:	BLOCK	3		;OUTPUT FILE BYTE POINTER, BYTE COUNT, ETC.
PDL:	BLOCK	100		;PUSH DOWN LIST
PDLEND:
PMDL:	BLOCK	400		;STACK FOR RECURSING ON MACROS
PMEND:
STTIME:	BLOCK	1		;RUNTIME AT START

PNTBUF:	BLOCK	<PNTMAX/5>+1	;BUFFER FOR HOLDING LISTING TEXT

EOLCHR:	BLOCK	1		;HOLDS LAST CHAR IN PRINT LINE
RRDC:	BLOCK	1		;IF REREAD SET, THIS IS CHAR TO USE
PCORC:	BLOCK	1		;SPACE REMAINING IN CORE WORD FOR PUTCOR
PCORP:	BLOCK	1		;BYTE POINTER FOR PUTCOR
PUTP:	BLOCK	1		;ADDRESS OF CHARACTER OUTPUT ROUTINE
OUTENA:	BLOCK	1		;-1 IF OUTPUT FILE OPEN AND NO ERRORS
LISTSW:	BLOCK	1		;NEGATIVE TO INHIBIT LISTING
ERRCNT:	BLOCK	1		;COUNTS MSG UUOS FOR ERRORS
PAGNUM:	BLOCK	1		;SOURCE PAGE NUMBER IN RIGHT HALF
				;-1 IN LEFT IS FLAG TO PRINT HEADER
SUBPAG:	BLOCK	1		;AUTOMATIC NUMBERING FOR PAGES NOT
				; BROKEN UP BY USER.  ZERO OR NEGATIVE
PAGCNT:	BLOCK	1		;COUNT OF PAGES OUTPUT
TTLPNT:	BLOCK	1		;ADDRESS OF TITLE TEXT
TOCPNT:	BLOCK	1		;LIST POINTER TO TABLE OF CONTENTS
HDRPNT:	BLOCK	1		;ADDRESS OF HEADER TEXT
LINNUM:	BLOCK	1		;SOURCE LINE NUMBER
RADIX:	BLOCK	1		;8 IF OCTAL, 16 IF HEX
GRPSIZ:	BLOCK	1		;NUMBER OF BITS (12 OR 16) IN LISTING GROUP
GRPCNT:	BLOCK	2		;NUMBER OF GROUPS TO PRINT FOR EACH RAM
WIDTH:	BLOCK	2		;CONTROL STORE WIDTH FOR EACH RAM
MICPOS:	BLOCK	1		;CURRENT BITPOSITION IN VALUE FOR LISTING
ADRCOL:	BLOCK	1		;COLUMNS ALLOWED FOR ADDRESS OUTPUT
SRCCOL:	BLOCK	1		;COLUMNS ALLOWED FOR BINARY OUT
FRECNT:	BLOCK	1		;COUNT OF REQUIRED CONSECUTIVE MICRO WORDS
LOCPAT:	BLOCK	1		;BIT PATTERN FOR LOCATION ASSIGNMENTS
LOCAST:	BLOCK	1		;BIT PATTERN FOR *'S IN LOCATION PATTERN
LALHED:	BLOCK	1		; XWD (POINTER TO HEAD OF ADDRESS
				;      ASSIGNMENT LIST), FOOT POINTER
PNTCNT:	BLOCK	1		;COUNT OF REMAINING SPACE IN PNTBUF
PNTPNT:	BLOCK	1		;BYTE POINTER INTO PNTBUF FOR LISTING
PNTTOK:	BLOCK	1		;PNTCNT AT START OF LAST TOP-LEVEL TOKEN
DOBIN:	BLOCK	1		;.BIN/NOBIN LEVEL
DOCREF:	BLOCK	1		;.CREF/NOCREF LEVEL
MACHT:	BLOCK	1		;SELECTOR FOR MACHINE-SPECIFIC FEATURES
WRDCNT:	BLOCK	2		;COUNT OF MICRO WORDS USED
HIGHPC:	BLOCK	2		;HIGHEST LOCATION ASSIGNED
MACPNT:	BLOCK	2		;ADDRESSES OF "MACRO%" FIELD HEADERS
JPNT:	BLOCK	2		;ADDRESSES OF "J" FIELD HEADERS
SWTPNT:	BLOCK	1		;ADDRESS OF "SWITCH%" FIELD HEADER
SUPSYM:	BLOCK	1		;ADDRESS OF SYMBOL TABLE ENTRY FOR
				;SYMBOL WHICH TURNED OFF ASSY
PRFTB1:	BLOCK	PRFMAX		;START OF EACH PREFERENCE REGION
PRFTB2:	BLOCK	PRFMAX		;END OF EACH PREFERENCE REGION
PRFTB3:	BLOCK	PRFMAX+1	;AOBJN POINTERS FOR PREF REGIONS IN USAGE
PRFTB4:	BLOCK	PRFMAX		;MASKS FOR STARTING WORD OF USAGE

LALCOR:	BLOCK	1		;CORE USED FOR LOCN ASSIGNMENT LIST
CRFCOR:	BLOCK	1		;CORE USED FOR CROSS REFERENCE LIST
SYMCOR:	BLOCK	1		;CORE USED FOR SYMBOL TABLE
TXTCOR:	BLOCK	1		;CORE USED FOR TEXT STRINGS

USAGE:	BLOCK <MAXPC+1>/^D36+1	;HOLDS 1S FOR EVERY MICRO WORD USED
USGEND:
DTABL:	BLOCK	<MAXDSP+1>/2	;EACH HALF,LINE # AT WHICH WORD DEFINED
				;IN DISPATCH TABLE (DCODE)

BUFADR:	BLOCK	1		;SAVE .JBFF FOR INPUT FILE BUFFERS
P2JFF:	BLOCK	1		;SAVE .JBFF AT START OF PASS2, TO BE RECLAIMED
				; FOR BUILDING LOC/LINE INDEX
I.MAXC:	BLOCK	1		;COUNT OF NUMBER OF INPUT FILES
I.CNT:	BLOCK	1		;FILE COUNTER USED BY ALLIN
I.FILE:	BLOCK	1		;POINTER TO 1ST INPUT FILE SPEC
I.SPEC:	BLOCK	1		;POINTER TO INPUT FILE SPEC AREA

O.DEV:	BLOCK	1
O.NAM:	BLOCK	2
O.EXT:	BLOCK	1
O.MOD:	BLOCK	2
O.PPN:	BLOCK	2
O.LEN==.-O.DEV
IFN FTULD,<
U.DEV:	BLOCK	1		;"ULD" FILE MISC
U.NAM:	BLOCK	2
U.EXT:	BLOCK	1
U.MOD:	BLOCK	2
U.PPN:	BLOCK	2
U.LEN==.-U.DEV
OUTFI2:	BLOCK	5	;OUTPUT FILE "ENTER" BLOCK FOR "ULD"
BUFOUT:	BLOCK	3		;"ULD" FILE BYTE PTR, CT, ETC.
>;END FTULD

I.DEV==0		;INPUT DEVICE
I.NAM==1		;INPUT FILE NAME/MASK
I.EXT==3		;INPUT EXTENSION
I.MOD==4		;STANDARD SWITCHES
I.PPN==6		;INPUT PPN
I.LEN==10		;LENGTH OF INPUT FILE DESCRIPTOR BLOCK

OUTDEV:	BLOCK	1	;OUTPUT DEVICE NAME
OUTFIL:	BLOCK	5	;OUTPUT FILE "ENTER" BLOCK
INDEV:	BLOCK	1	;INPUT DEVICE NAME
INFILE:	BLOCK	5	;INPUT FILE "LOOKUP" BLOCK
	.RBCNT=0	;NUMBER OF ADDITIONAL WORDS IN LOOKUP/ENTER BLOCK
	.RBPPN=1	;PROJECT, PROGRAMMER NUMBER
	.RBNAM=2	;FILE NAME
	.RBEXT=3	;EXTENSION, DATE1
	.RBPRV=4	;PROTECTION, CREATION TIME-DATE

IFN FTHASH,<
HSHTAB:	BLOCK	HSHLEN	;HASH TABLE
>

ENDBLT:		;END OF BLT TO ZERO MEMORY
	END	MICRO