Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap5_198111 - decus/20-0136/macy11.mac
There are 2 other files named macy11.mac in the archive. Click here to see a list.
	XLIST
	DEFINE	DEFTTL	(NAME,MAJOR,MINOR,EDIT,DATE)
<
	LALL
	TITLE	NAME	V'MAJOR	DATE
	SUBTTL	INITIALIZATION

;	COPYRIGHT DIGITAL EQUIPMENT CORPORATION
;	1969,1970,1971,1972,1973,1974

MNNUM=	"MINOR"-100
	IFIDN	<MINOR>	<>	<MNNUM=0>
	IFIDN	<DATE>	<>	<DEBUG=0>

	DEFINE	DEFOUT	<
	OUTSTR	[ASCIZ	/NAME: /]>

	IFIDN	<MACDLX>	<NAME>	<XREL=0>

	TWOSEG

	INTERN	.JBVER
	LOC	<.JBVER==137>
	EXP	0B2!<MAJOR>B11!<MNNUM>B17!EDIT

	INTERN	.JBREN
	LOC	<.JBREN=124>
	XWD	START

	RELOC	0
	RELOC	400000

	SYN	RELOC,.LOC
	SYN	RELOC,.RELOC

SYSPPN:	XWD	1,4		;SYSTEM PPN
SYSDEV:	SIXBIT	/DSK/		;SYSTEM DEVICE

TITLE:	ASCIZ	/NAME MAJOR'MINOR(EDIT)/

	ENTRY		COLD

;[w1]	EXTERNAL	JOBREL,JOBFF,JOBUUO,JOB41,JOBHRL,.JBREL
	jobrel=.jbrel##
	jobff=.jbff##
	jobuuo=.jbuuo##
	job41=.jb41##
	jobhrl=.jbhrl##

	XALL
>
	LIST
	DEFTTL	MACY11,27,,657,13-NOV-74
	DEFINE	ASCNAM	<
	EXP	"M","A","C","Y","1","1">
	SUBTTL	CONCISE CHANGE HISTORY
							COMMENT	%

Edit #	Description
*********************************************************************
626	Prevent Z-errors from being fatal
627	Prevent spurious X-errors on JMPs between CSECTs and to globals.
630	Provide complete Z-error checking.
631	Correct action of .MEXIT within repeat blocks.(IRP,IRPC,REPT).
632	Preclude garbage generation if .IDENT has too many chars.
633	Make .MCALL work right all the time.
634	Make MACY11 accept .PDP10 pseudo-ops.
635	Clean up page 1.
*****************release*******************
636	Load .JBREN,fix a spelling error, add debug patch area.
637	Add .PSECT capability.
640	Add Cutler mods.
641	Add disable of default globals, dflt registers
642	Implement /RSX, different default source extension order,
	improved spacing in symbol table output.
643	Correct minor glitches in CCL -file handling.
644	Fix another .IRP problem;i.e., correct action of macro defs
	inside .IRPs.
645	Force .IF IDN and .ASCII to accept null strings.
646	Not used.
647	Correct a .PSECT bug.
650	Correct action of default globalization.
651	Take one giant step backward. Skip 650, modify 647 and
	really correct default globalization.
652	Add SWITCH.INI capability and expand local symbol range.
653	Simplify default global disabilization.
654	Make SWITCH.INI processing take line numbers and
	upper/lower case.
655	Eliminate form feed before reprint of command line at
	end of listing.
******************RELEASE******************
656	ADD "JOB" LOGGING VIA SUBROUTINES IN LOGREC AND
	LOGAPP.
		****** NOW MUST BE LOADED WITH COMMAND STRING *****
			.LOAD MACY11.NNN,LOGREC,LOGAPP
		***************************************************
	LOGGING IS DONE IN DSKZ:JOB###.LOG[350,3004]
******************RELEASE******************
657	FIX "?LOGENT ENTER FAILURE"
	    "[NOT LOGGED]" JUNK FROM JOBLOG
******************RELEASE******************
%
	SUBTTL	VARIABLE PARAMETERS

	DEFINE	GENPAR	(NAME,VALUE)
<
	IFNDEF	NAME,	<NAME=	VALUE>
>

	GENPAR	PAGSIZ,^D54	; NUMBER OF LINES ON A PAGE

	GENPAR	NUMBUF,2	; NUMBER OF BUFFERS PER DEVICE

	GENPAR	CORINC,2000	; CORE INCREMENT

	GENPAR	SPL,4		; SYMBOLS PER LINE (SYMBOL TABLE LISTING)

	GENPAR	SPLTTY,3	; SYMBOLS PER LINE (TTY)

	GENPAR	DATLEN,^D350	; DATA BLOCK LENGTH

	GENPAR	RLDLEN,^D40

	GENPAR	LSRNGE,^D65534	;LOCAL SYMBOL RANGE

	GENPAR	WPB,10		; MACRO BLOCK SIZE

	GENPAR	CPL,^D132	; CHARACTERS PER LINE

	GENPAR	PDPLEN,100	;  PUSH-DOWN POINTER LENGTH

	GENPAR	COLLPT,^D128	;CPL LPT

	GENPAR	COLTTY,^D72	;CPL TTY

	GENPAR	TTLLEN,COLLPT-^D<8*5>	;TITLE AND SUB-TITLE BUFFER SIZE

	GENPAR	LCFDEF,LC.ME!LC.MEB!LC.LD	;DEFAULT LISTING SUPPRESSION

BKT1=	1
BKT2=	2
BKT3=	3
BKT4=	4
BKT6=	6

	.LOC
	IFDEF	DEBUG	<
PATCH:	BLOCK	100	;DEBUGGING PATCH AREA	>
RSXSW:	BLOCK	1		;NON-ZERO IF RSW PSECT DEFAULTS
				;ARE ENABLED
PDPSTK:	BLOCK	PDPLEN
CCLTOP:	BLOCK	1		;TOP OF CCL STORAGE
CCLPNT:	BLOCK	1		;CCL POINTER
BZCOR:
	.RELOC
	SUBTTL	ACCUMULATOR ASSIGNMENTS

	%00=	0		; ACCUMULATION OF SIXBIT SYMBOL, SCRATCH
	%01=	1		; SYMBOL VALUE AND FLAGS SET BY SRCH.  SCRATCH
	%02=	2		; SCRATCH
	%03=	3		; UNIVERSAL SCRATCH
	%04=	4		; UNIVERSAL SCRATCH +1
	%05=	5		; LOCATION COUNTER
	%06=	6		; SCRATCH
	%07=	7		; SYMBOL TABLE SEARCH INDEX
	%10=	10		; EXPRESSION OR TERM VALUE, SCRATCH
	%11=	11		; SCRATCH
	%12=	12		;
	%13=	13		; LINE BUFFER BYTE POINTER
	%14=	14		; CURRENT CHARACTER (ASCII)
	%15=	15		; LH - ASSEMBLER FLAGS,  RH - ERROR FLAGS
	%16=	16		; EXEC FLAGS
	%17=	17		; PUSH-DOWN POINTER
	SUBTTL	FLAG REGISTERS

				; %16 - LH

	LSTBIT=	000001		; 1- SUPPRESS LISTING OUTPUT
	BINBIT=	000002		; 1- SUPPRESS BINARY OUTPUT
	CRFBIT=	000004		; 1- CREF DISABLED
	ESWBIT=	000010		; 1- LIST OCTAL
	SOLBIT=	000020		; 1- SEQUENCE OUTPUT LINES
	NSWBIT=	000040		; 1- SUPPRESS ERRORS ON TTY
	FMTBIT=	000100		; 1- GNS MODE
	TTYBIT=	000200		; 1- LISTING IS ON TTY
	ERRBIT=	000400		; 1- ERROR MESSAGES ENABLED
	P1LBIT=	001000		; 1- LIST ON PASS 1
	CDRBIT=	002000		; 1- /CDR MODE
	LPTBIT=	004000		; 1- SUPPRESS LISTING TO LPT
	GBLDIS=	010000		; 1- DEFAULT GLOBALS DISABLED
	INFBIT=	020000		; 1- VALID INFORMATION SEEN
	HDRBIT=	040000		; 1- TIME FOR NEW LISTING PAGE
	REGBIT=	100000		; 1- REGISTERS SET AT COMMAND LEVEL
	MODBIT=	200000		; 1- USER MODE AC'S SET
	GBLCCL=	400000		;INDICATES WHETHER GBLDIS WAS SET BEFORE
				;SOURCE SCANNING BEGAN


				; %16 - RH

	RSXBIT=	000001		; 1- RSX defaults freshly enabled


				; %15 - LH

	ASZFLG=	000010		; 1- ASCIZ MODE
	NQEFLG=	000020		; 1- NO "Q" ERRORS AT END OF LINE
	ENDFLG=	000040		; 1- END OF SOURCE ENCOUNTERED
	FFFLG=	000100		; 1- ISOLATED FORM FEED
	FMTFLG=	000200		; 1- OVER-RIDE LC.FMT
	LSBFLG=	000400		; 1- NEW LOCAL SYMBOL RANGE
	DEFFLG=	001000		; 1- CREF DEFINITION
	DSTFLG=	002000		; 1- CREF DESTINATION
	DS2FLG=	004000		; 1- DITTO, 2ND FIELD
	DISBIT=	010000		; 1- DISABLE CURRENTLY IN EFFECT
	LHMFLG=	020000		; 1- MOVE LISTING TO LH MARGIN
	FLTFLG=	040000		; 1- ERROR ENCOUNTERED IN FLOATING ROUTINE
	ISWFLG=	100000		; 1- /I SEEN
	P1F=	400000		; 1- PASS 1 IN PROGRESS
	SUBTTL	ERROR FLAGS

ERR.A=	400000
ERR.B=	200000
ERR.D=	100000
ERR.E=	040000
ERR.I=	020000
ERR.L=	010000
ERR.M=	004000
ERR.O=	002000
ERR.P=	001000
ERR.Q=	000400
ERR.R=	000200
ERR.T=	000100
ERR.U=	000040
ERR.N=	000020
ERR.Z=	000010		;MARGINAL INSTRUCTION
ERR.X=	000004

ERR.P1=	000001

ERRMNE:	ASCIZ	/ABDEILMOPQRTUNZX/

				;DEFINE ERROR TYPES CONSIDERED "FATAL"
QMEMSK==	ERR.A!ERR.B!ERR.D!ERR.E!ERR.I!ERR.L!ERR.M
QMEMSK==QMEMSK!	ERR.O!ERR.P!ERR.Q!ERR.R!ERR.T!ERR.U!ERR.N
	SUBTTL	MISCELLANEOUS PARAMETERS

	TTYDEV=	000010		; 1- DEVICE IS A TTY
	PTRDEV=	000200		; 1- DEVICE IS A PTR
	LPTDEV=	040000		; 1- DEVICE IS A LPT
	CDRDEV=	100000		; 1- DEVICE IS A CDR

	IODATA= 200000		; 1- IO DATA ERROR
	IODEV=  100000		; 1- IO PARITY ERROR
	IOWRLK= 400000		; 1- IO WRITE LOCK ERROR
	IOBKTL=	040000		; 1- IO BLOCK TOO LARGE
	IOEOF=	020000		; 1- END OF FILE ON IO DEVICE


				; DEVICE PARAMETERS

	BIN=	1
	LST=	2
	SRC=	3
	CCL=	3
	CRF=	4
	MAC=	5
	SWI=	6		;CHANNEL NUMBER FOR SWITCH.INI

	INBIT=	2		;DEVICE CAN DO INPUT
	ALMODE=	1		;ASCII LINE MODE
	.IOASC=	0		;ASCII MODE
	IO.EOF=	1B22		;EOF BIT IN DEVICE STATUS
	SUBTTL	OPDEFS

	OPDEF	CALL	[PUSHJ %17,]
	OPDEF	RETURN	[POPJ %17,]
	OPDEF	SPUSH	[PUSH %17,]
	OPDEF	SPOP	[POP %17,]

	OPDEF	RESET	[CALLI	 0]
	OPDEF	DEVCHR	[CALLI	 4]
	OPDEF	CORE	[CALLI	11]
	OPDEF	EXIT	[CALLI	12]
	OPDEF	DATE	[CALLI	14]
	OPDEF	APRENB	[CALLI	16]
	OPDEF	MSTIME	[CALLI	23]
	OPDEF	RUNTIM	[CALLI	27]
	OPDEF	ZBINK	[CLOSE BIN,]

	OPDEF	OUTCHR	[TTCALL 1,]
	OPDEF	OUTSTR	[TTCALL 3,]
	OPDEF	INCHWL	[TTCALL 4,]


	DEFINE	GENM40	(A,B,C,D,E,F)	;GEN MOD 40
<
	XWD	$'A*50*50+$'B*50+$'C , $'D*50*50+$'E*50+$'F
>
	SUBTTL	UUO HANDLERS

	DEFINE	UUODEF	(NAME,SUBR)
<
	XLIST
	OPDEF	NAME	[<.-UUOTBL>B8]
	Z	SUBR
	LIST
>

UUOTBL:				;UUO TRANSFER TABLE
	0			;ZERO IS ILLEGAL
	UUODEF	DEVSET,	DEVSE0	;DEVICE INITIALIZATION
	UUODEF	FERROR,	FERRO0	;FATAL ERROR
	UUODEF	LSTSTR,	LSTST0	;LIST ASCIZ STRING
	UUODEF	LSTMSG,	LSTMS0	;LIST ASCIZ MESSAGE
	UUODEF	DNC,	DNC0	;DECIMAL NUMBER CONVERSION
	UUODEF	LSTSYM,	LSTSY0	;LIST SYMBOL
	OPDEF	LSTSIX	[LSTSYM 2,]
	UUODEF	LSTICH,	LSTIC0	;LIST IMMEDIATE CHARACTER
	UUODEF	SETLCT,	SETLC0	;SET LCTST
;	UUODEF	TSTLCT,	TSTLC0	;SKIP IF ARG NOT SET IN LCFLGS
;	UUODEF	TSTEDT,	TSTED0	;SKIP IF NOT SET
	UUODEF	WCIMT,	WCIMT0	;WRITE CHARACTER IN MACRO TREE
;	UUODEF	ERRSET,	ERRSE0	;SET ERROR FLAG (%15 RH)
;	UUODEF	ERRSKP,	ERRSK0	;DITTO, AND SKIP
	UUODEF	ERRXIT,	ERRXI0	;DITTO, AND EXIT

	OPDEF	SKPLCR	[TLNE %12,]	;REPLACES TSTLCT
	OPDEF	SKPLCS	[TLNN %12,]	;SKIP IF LISTING CONTROL SET
	OPDEF	SKPEDR	[TRNE %12,]	;REPLACES TSTEDT
	OPDEF	SKPEDS	[TRNN %12,]	;SKIP IF ENABLE SET
	OPDEF	ERRSET	[TRO  %15,]
	OPDEF	ERRSKP	[TROA %15,]

	BLOCK	40+UUOTBL-.	;ZERO REMAINDER OF TABLE

UUOPRO:				;UUO PROCESSOR
	SPUSH	%02		;STACK WORK REGISTER
	LDB	%02,[POINT 9,JOBUUO,8]	;GET INDEX
	SKIPN	%02,UUOTBL(%02)	;FETCH VECTOR, NULL?
	 HALT	.		;  YES, ERROR
	EXCH	%02,0(%17)	;NO, SET VECTOR AND RESTORE REG
	RETURN			;  "CALL" THE ROUTINE
	SUBTTL	EXEC INITIALIZATION

COLD:				;INITIAL ENTRY POINT
	SETZM	RSXSW		;ENABLE RSX DEFAULTS
	HLLZS	%16		;CLEAR RH %16

START:	SETZM	CCLTOP		;CLEAR CCL POINTER

NXTCCL:	RESET
	SKIPE	%03,CCLTOP	;CCL IN PROGRESS?
	HRRZM	%03,JOBFF	;  YES
	MOVE	0,JOBFF		;GET FIRST FREE
	ADDI	0,200*NUMBUF*2+200+200	;MAKE ROOM FOR BUFFERS, ETC.
	CORE	0,		;SET CORE
	 HALT	.		;  DIDN'T MAKE IT
	MOVSI	%17,-%17
	SETZM	%00(%17)
	AOBJN	%17,.-1
	TLO	%12,LCFDEF	;SET DEFAULT LISTING FLAGS
	IFDEF	XREL,	<TRO	%12,ED.ABS>
	HRLI	%16,BINBIT!LSTBIT!CRFBIT ;INIT "EXEC" FLAG REGISTER
	MOVE	%17,[IOWD PDPLEN,PDPSTK]	;BASIC PDP
	MOVSI	%03,-<EZCOR-BZCOR>
	SETZM	BZCOR(%03)	;CLEAR VARIABLES
	AOBJN	%03,.-1
	MOVE	0,[CALL UUOPRO]
	MOVEM	0,JOB41		;SET UUO TRAP
	MOVEI	0,ERR.X
	MOVEM	0,ERRSUP	;DEFAULT DISABLE OF "X" FLAG
	CALL	SETSYM
	SETZM	0
	RUNTIM	0,		;GET CURRENT RUN TIME,
	MOVEM	0,RUNTIM
	DATE	0,		;  AND DATE,
	MOVEM	0,DATE
	MSTIME	0,		;  AND TIME
	MOVEM	0,MSTIME
	TLZ	%16,GBLDIS
	SUBTTL	SWITCH.INI PROCESSING

	MOVE	%02,[XWD SWIOPN,LSWOPN]
	BLT	%02,LSWOPN+2
	MOVE	%02,[XWD SWILOO,LSWLOO]
	BLT	%02,LSWLOO+3
	OPEN	SWI,LSWOPN	;INITIALIZE CHANNEL
	HALT	.
	LOOKUP	SWI,LSWLOO	;OPEN FILE
	JRST	SWIEND		;SWITCH.INI NOT PRESENT
	INBUF	SWI,1		;SET UP THE RING WITH ONLY ONE BUFFER
	CALL	SWIRD		;GET FIRST BUFFERFUL
	JRST	SWIEND		;...MUST HAVE BEEN EMPTY
	MOVE	%02,SWIBUF+2	;COLLECT BYTE COUNT

SWINB:				;LOOK FOR NON-BLANKS
	CALL	SWICHR		;GET A CHARCTER
	JRST	SWIEND		;ALL DONE
	CAIE	%14,SPACE	
	CAIN	%14,TAB
	JRST	SWINB		;BYPASS THIS BLANK-TYPE CHARACTER
	MOVSI	%01,-6		;SET UP COUNTER
	JRST	.+3		;BYPASS FIRST COLLECTION

SWICMP:			 	;COMPARE SYMBOL WITH "MACY11"
	CALL	SWICHR
	JRST	SWIEND
	CAME	%14,NMTABL(%01)
	JRST	SWIEOL		;NO GOOD. GO TO END OF LINE.
	AOBJN	%01,SWICMP	;BACK FOR MORE(PERHAPS)
				;MATCHED!
	MOVE	%06,[POINT 7,SWIBYT] ;PREPARE TO FILL INTERMED. BUFFER

SWIMOV:				;FILL INTERMEDIATE BUFFER
	CALL	SWICHR		;GET ONE
	JRST	SWIGET
	CAIN	%14,CRR		;END OF LINE?
	JRST	SWIGET		;YES
	CAIN	%14,"-"		;HYPHEN?
	JRST	SWICON		;YES...ASSUME CONTINUATION
	IDPB	%14,%06		;ELSE, PUT THE CHARACTER INTO THE BUFFER
	JRST	SWIMOV		;CONTINUE

SWICON:			;PROCESS LINE CONTINUATION
	CALL	SWICHR
	JRST	SWIERR		;PROBLEMS...
	CAIE	%14,CRR		;EOL YET?
	JRST	SWICON		;NO
	CALL	SWICHR		;CHECK FOR PRESENCE OF LINE FEED
	CAIA			;THIS IS THE ERROR RETURN
	CAIE	%14,LF		;SKIP IF LINE FEED
	JRST	SWIERR		;CRAP OUT
	JRST	SWIMOV		;BACK FOR CONTINUATION LINE

SWIGET:
	SETZ	%14,
	IDPB	%14,%06
	MOVE	%13,[POINT 7,SWIBYT,6] ;FAKE UP AC13 FOR GETNB, ET.AL.
	CALL	SETNB
	CAIE	%14,"/"		;FIRST CHARACTER A SLASH?
	JRST	SWIERR		;NO.
	CALL	SSWPRO		;GO PROCESS SWITCHES

SWIEND:
	CLOSE	SWI,
	OUTSTR	[BYTE (7) CRR,LF,0]
	JRST	START0

SWIERR:				;ERROR IN SWITCH.INI
	OUTSTR	[BYTE (7) CRR,LF,0]
	OUTSTR	[ASCIZ /? ERROR IN SWITCH.INI FILE/]
	OUTSTR	[BYTE (7) CRR,LF,0]
;[w1]	CALL	JOBOFF##
	EXIT
				;SUBROUTINES
SWIRD:				;GET A BUFFERFUL OF DATA
	IN	SWI,		;GET IT
	JRST	CPOPJ1		;GOOD...TAKE SKIP RETURN
	STATO	SWI,IO.EOF	;WAS IT AN END OF FILE?
	OUTSTR	[ASCIZ /ERROR IN READING SWITCH.INI/]
	RETURN			;TAKE NORMAL RETURN

SWICHR:				;GET A SINGLE CHARACTER IN AC14
	SOJL	%02,SWCHR2	;JUMP ON END-OF-FILE
	IBP	SWIBUF+1	;INCREMENT INPUT BYTE POINTER
	MOVE	%14,@SWIBUF+1	;GET ENTIRE WORD
	TRNE	%14,1		;LINE NUMBER?
	JRST	SWICH1		;YES
	LDB	%14,SWIBUF+1	;GET THE CHARACTER
	CAIL	%14,"A"+40	;LOWER-CASE?
	CAILE	%14,"Z"+40	;...?
	CAIA			;NO
	SUBI	%14,40		;CONVERT TO UPPER CASE
	JRST	CPOPJ1		;TAKE SKIP-RETURN

SWICH1:				;LINE SEQ NUMBER
	AOS	SWIBUF+1	;INCREMENT POINTER AROUND LSN
	SUBI	%02,5		;DECREMENT COUNTER
	JUMPGE	%02,SWICHR	;IF COUNT OK, BACK FOR MORE
				;ELSE, FALL INTO COLLECTION OF ANOTHER LOAD
SWCHR2:
	CALL	SWIRD		;GET ANOTHER LOAD
	RETURN			;TERMINAL RETURN
	MOVE	%02,SWIBUF+2	;GET BYTE COUNT
	JRST	SWICHR		;BACK FOR MORE

				;LOOK FOR END OF LINE
SWEOL0:	CALL	SWICHR
	JRST	SWIEND

SWIEOL:
	CAIE	%14,LF		;LINE FEED?
	JRST	SWEOL0		;NO
	JRST	SWINB		;NEW LINE AT LAST

				;DATA AREAS
NMTABL:	ASCNAM			;NAME TO MATCH
SWIOPN:
	EXP	.IOASC		;ASCII MODE
	SIXBIT	/DSK/		;DEVICE
	XWD	0,SWIBUF

SWILOO:
	SIXBIT	/SWITCH/
	SIXBIT	/INI/
	EXP	0
	XWD	0,0		;USE CURRENT PPN

	.LOC
LSWOPN:	BLOCK	3
LSWLOO:	BLOCK	4
SWIBUF:	BLOCK	3		;BUFFER HEADER
SWIBYT:	BLOCK	^D29		;INTERMEDIATE BUFFER FOR MACY11 LINE
	.RELOC
	SUBTTL	CONTINUATION OF OPENING FESTIVITIES

START0:
;[w1]	CALL	JOBOFF##
	SKIPN	CCLTOP
	OUTCHR	["*"]		;AWAKEN THE USER
;[w1]	CALL	JOBON##
	MOVE	%13,JOBFF
	HLL	%13,ASCBYT
	MOVEM	%13,TTIBEG
START1:	CALL	CCLGET		;GET A TTI CHAR
	CAIE	%14,SPACE
	CAIN	%14,TAB
	JRST	START1		;IGNORE BLANKS
	CAIL	%14,"A"+40	;UPPER CASE?
	CAILE	%14,"Z"+40
	CAIA
	SUBI	%14,40		;  YES, CONVERT TO UPPER
	CAIN	%14,CRR
	JRST	START1		;DITTO FOR CR'S
	CAIE	%14,LF		;IF LINE FEED
	CAIN	%14,ALTMOD	;  OR ALTMODE,
	MOVEI	%14,0		;SET END OF ENTRY
	DPB	%14,%13
	IBP	%13
	JUMPN	%14,START1
	ADDI	%13,1
	HRRZM	%13,JOBFF
	MOVE	%13,TTIBEG
	SETCHR			;SET THE FIRST CHAR
	JUMPE	%14,NXTCCL	;RESTART IF NOTHING TO PROCESS

	CALL	GETBIN		;INIT THE BINARY
	CAIE	%14,","		;ANOTHER FIELD?
	JRST	START2		;  NO
	GETCHR			;YES, BYPASS COMMA
	CALL	GETLST		;INIT THE LISTING FILE
START2:	MOVE	%03,SYSDEV
	MOVEM	%03,DEVNAM
	DEVSET	MAC,1
	 XWD	0,MACBUF
	MOVE	%03,JOBFF
	MOVEM	%03,JOBFFM
	INBUF	MAC,NUMBUF
	CAIE	%14,"_"		;TEST FOR LEGAL SEPARATOR
	CAIN	%14,"<"		;>
	MOVEI	%14,"="
	CAIE	%14,"="
	FERROR	[ASCIZ /NO _ SEEN/]	;FATAL ERROR
	MOVEM	%13,TTISAV	;SAVE FOR PASS2 RESCAN
	HLLZM	%12,LCFLGS
	MOVE	%03,[XWD LCBLK,LCSAVE]
	BLT	%03,LCSAVE+LCLEN-1	;SAVE LISTING FLAGS
	HRRZM	%12,EDFLGS
	MOVE	%03,[XWD EDBLK,EDSAVE]
	BLT	%03,EDSAVE+EDLEN-1	;  AND ENABLE/DISABLE FLAGS
	MOVE	%03,JOBFF
	MOVEM	%03,CRFBAS
	CALL	ACEXCH		;GET USER AC'S
	SKIPE	CCLTOP
	DEFOUT
	SKIPN	CCLTOP
	OUTSTR	[BYTE (7) CRR,LF,0]	;CONFIRM ALL'S WELL
	CALL	ASSEMB		;CALL THE ASSEMBLER
	SETZM	%03
	RUNTIM	%03,
	MOVEM	%03,RUNTIM+2
	TLNN	%16,LSTBIT
	CALL	SYMTB
	SETZM	%03
	RUNTIM	%03,
	MOVEM	%03,RUNTIM+3
	CALL	ACEXCH		;GET EXEC AC'S
	SKPINC			;RESET POSSIBLE ^O
	 JFCL
	CALL	LSTCR		;LIST A CR/LF
	SPUSH	%16
	SKIPN	ERRCNT
	SKIPN	CCLTOP
	TLO	%16,ERRBIT	;MESSAGE TO LPT AND TTY
	TLZ	%16,NSWBIT	;CLEAR /N
	CALL	LSTCR
	SKIPE	%11,ERRCNT	;ANY ERRORS?
	LSTICH	"?"		; YES, FLAG THE LISTING
	LSTMSG	[ASCIZ / ERRORS DETECTED:  5/]
	SKIPE	%11,ERRCNT+1	;ANY NON-FATAL ERRORS?
	LSTMSG	[ASCIZ -/5-]	;  YES
	SKIPE	%11,DGCNT	;ANY DEFAULT GLOBALS?
	LSTMSG	[ASCIZ /	DEFAULT GLOBALS GENERATED:  5/];GUESS SO
	LSTMSG	[ASCIZ /00/]
	SPOP	%00
	TLNE	%00,NSWBIT	;WAS /N SET?
	TLO	%16,NSWBIT	;  YES, RE-SET IT
	SETZM	STLBUF
	LSTICH	SPACE
	LSTICH	"*"
	LSTSTR	@TTIBEG
	LSTMSG	[ASCIZ /0 RUN-TIME: /]
	MOVSI	%01,-3
START4:	MOVE	%03,RUNTIM+1(%01)
	SUB	%03,RUNTIM(%01)
	IDIVI	%03,^D1000
	DNC	%03
	LSTICH	SPACE
	AOBJN	%01,START4
	SKIPN	%11,TIMCNT
	JRST	START5
	LSTMSG	[ASCIZ /(5-/]
	MOVE	%03,TIMTIM
	IDIVI	%03,^D1000
	MOVE	%11,%03
	LSTMSG	[ASCIZ /5) /]
START5:	LSTMSG	[ASCIZ /SECONDS0/]
	HRRZ	%11,JOBREL	;GET TOP OF COR
	ASH	%11,-^D10	;CONVERT TO "K"
	ADDI	%11,1		;BE HONEST ABOUT IT
	LSTMSG	[ASCIZ / CORE USED:  5K0/]
	SKPEDS	ED.WRP
	JRST	START6
	MOVE	%03,WRPCNT+1
	IMULI	%03,^D100
	IDIV	%03,WRPCNT
	MOVE	%11,%03
	LSTMSG	[ASCIZ / WRAP-AROUND:  5%0/]
START6:	CALL	LSTCR
				;FALL INTO THE NEXT PAGE...
EXIT:	TLNE	%16,MODBIT	;EXEC MODE?
	CALL	ACEXCH		; NO, GET AC'S
	CLOSE	LST,		;CLOSE THE LISTING FILE
	CLOSE	BIN,		;CLOSE THE BINARY FILE
	TLON	%16,LSTBIT	;WAS THERE A LISTING FILE?
	CALL	LSTTST		;YES, TEST FOR FINAL ERROR
	TLON	%16,BINBIT	;IS THERE A BINARY FILE?
	CALL	BINTST		;YES, TEST FOR FINAL ERROR
	TDZE	%14,%14		;END OF COMMAND STRING?
	 FERROR	[ASCIZ /NOT ALL INPUT FILES PROCESSED/]	;  NO
	JRST	NXTCCL		;RESTART


FERRO0:				; "FERROR" UUO
	TRZE	%16,RSXBIT	;NON-RSX DEFAULTS FRESHLY ENABLED?
	JRST	START		;YES.  IT'S OK...
	PUSH	%17,JOBUUO	;SAVE ARG
	TLNE	%16,MODBIT
	CALL	ACEXCH		;SET EXEC AC'S
	HRLI	%16,ERRBIT!LSTBIT!BINBIT!CRFBIT	;FUDGE FLAGS
	LSTMSG	[ASCIZ /0? /]
	LSTMSG	@0(%17)		;OUTPUT BASIC MESSAGE
	LSTMSG	[ASCIZ /00*/]
	MOVEI	%03,0
	DPB	%03,%13
	LSTSTR	@TTIBEG
	LSTICH	"?"
	LSTMSG	[ASCIZ /00/]	;TWO CR/LF'S
	JRST	START


	.LOC
RUNTIM:	BLOCK	4
DATE:	BLOCK	1
MSTIME:	BLOCK	1
ERRCNT:	BLOCK	2
DGCNT:	BLOCK	1		;NUMBER OF DEFAULT GLOBALS GENERATED
	.RELOC
TIMTST:	JFCL
	 CAIA
	AOS	0(%17)
	SPOP	TIMTMP
	SPUSH	%02
	SETZM	%02
	RUNTIM	%02,
	EXCH	%02,0(%17)
	CALL	@TIMTMP
	 CAIA
	AOS	-1(%17)
	EXCH	%02,-1(%17)
	MOVEM	%02,TIMTMP
	SETZM	%02
	RUNTIM	%02,
	SUB	%02,0(%17)
	ADDM	%02,TIMTIM
	AOS	TIMCNT
	SPOP	%02
	SPOP	%02
	JRST	@TIMTMP

	.LOC
TIMTIM:	BLOCK	1
TIMCNT:	BLOCK	1
TIMTMP:	BLOCK	1
	.RELOC
	SUBTTL	FILE INITIALIZATION

GETBIN:				;GET BINARY FILE
	MOVE	%03,SYSDEV
	MOVEM	%03,DEVNAM	;SET DEFAULT DEVICE
	CALL	CSIFLD		;GET THIS FIELD
	 RETURN			;  NO, EXIT
	CAIN	%14,"@"		;CCL?
	JRST	CCLSET		;  YES
	DEVSET	BIN,10		;INIT IMAGE MODE
	 XWD	BINBUF,0	;ARG
	OUTBUF	BIN,NUMBUF	;BUMP JOBFF
	MOVE	%03,[XWD DEVNAM,BINBLK]
	BLT	%03,BINBLK+4	;SAVE NAME FOR LATER ENTER
	TLZ	%16,BINBIT	;INDICATE GOOD BINARY FILE
	RETURN

SETBIN:				;SET BIN (END OF PASS 1)
	TLNE	%16,BINBIT	;ANY BINARY?
	RETURN			;  NO, EXIT
	CALL	ACEXCH		;YES, GET EXEC AC'S
	MOVS	%03,[XWD DEVNAM,BINBLK]
	BLT	%03,DEVNAM+4	;SET UP BLOCK
	SKIPE	%03,FILEXT	;EXPLICIT EXTENSION?
	JRST	SETBI1		;  YES
	MOVSI	%03,(SIXBIT /OBJ/)
	SKPEDR	ED.ABS		;ABS MODE?
	 MOVSI	%03,(SIXBIT /BIN/)	;  YES
SETBI1:	HLLZM	%03,FILEXT	;SET IN LOOKUP BLOCK
	ENTER	BIN,FILNAM	;ENTER FILE NAME IN DIRECTORY
	 FERROR	[ASCIZ /NO ROOM FOR 3/]	;  FULL
	JRST	ACEXCH		;TOGGLE AC'S AND EXIT
GETLST:				;GET LISTING FILE
	MOVE	%03,SYSDEV
	MOVEM	%03,DEVNAM	;SET DEFAULT DEVICE
	CALL	CSIFLD		;GET THIS FIELD
	 RETURN			;  NO, EXIT
	DEVSET	LST,1		;INIT ASCII MODE
	 XWD	LSTBUF,0
	OUTBUF	LST,NUMBUF
	SKIPN	%03,FILEXT	;EXPLICIT EXTENSION?
	MOVSI	%03,(SIXBIT /LST/)	;  NO, SUPPLY ONE
	HLLZM	%03,FILEXT
	ENTER	LST,FILNAM
	 FERROR	[ASCIZ /NO ROOM FOR 3/]	;  FULL
	MOVE	%00,DEVNAM
	DEVCHR	%00,		;GET DEVICE CHARACTERISTICS
	MOVEI	%03,LC.TTM
	TLNE	%00,TTYDEV	;IS DEVICE TELETYPE?
	TLOA	%16,TTYBIT	;  YES, FLAG AND SKIP
	TDNE	%03,LCMSK	;NO, TTM SEEN?
	CAIA
	TLO	%12,0(%03)	;NO, SUPPRESS TELETYPE MODE
	TLZ	%16,LSTBIT	;INDICATE A GOOD LISTING FILE
	JRST	LPTINI		;INIT LINE OUTPUT AND EXIT


SETCRF:
	TLNE	%16,LSTBIT!CRFBIT
	RETURN
	CALL	ACEXCH
	CALL	GETCOR
	MOVE	%03,SYSDEV
	MOVEM	%03,DEVNAM
	DEVSET	CRF,10
	 XWD	CRFBUF,0
	OUTBUF	CRF,
	MOVEI	%00,3
	PJOB	%02,
SETCR1:	IDIVI	%02,^D10
	ADDI	%03,"0"-40
	LSHC	%03,-6
	SOJG	%00,SETCR1
	HRRI	%04,(SIXBIT /CRF/)
	MOVEM	%04,CRFNAM
	MOVEM	%04,FILNAM
	MOVSI	%03,(SIXBIT /TMP/)
	MOVEM	%03,FILEXT
	SETZM	FILPPN
	ENTER	CRF,FILNAM
	 FERROR	[ASCIZ /NO ROOM FOR 3/]
	JRST	ACEXCH
SETSRC:				;SET FOR SOURCE SCAN (EACH PASS)
	CALL	ACEXCH		;GET EXEC AC'S
	SETZM	%03
	RUNTIM	%03,
	MOVEM	%03,RUNTIM+1
	MOVE	%13,TTISAV	;SET CHAR POINTER
	SETCHR			;SET THE FIRST CHARACTER
	MOVE	%03,SYSDEV
	MOVEM	%03,DEVNAM	;SET DEFAULT DEVICE NAME
	SETZM	PPNSAV		;CLEAR PROJECT-PROGRAMMER NUMBER
	SETZM	LINNUM		;CLEAR SEQUENCE NUMBER
	SETZM	LINNUB		;  AND ITS BACKUP
	TLNE	%16,SOLBIT	;SEQUENCE OUTPUT LINES?
	AOS	LINNUM		;  YES, PRESET
	MOVS	%03,[XWD LCBLK,LCSAVE]
	BLT	%03,LCBLK+LCLEN-1	;RESTORE LC FLAGS
	HLL	%12,LCFLGS
	MOVS	%03,[XWD EDBLK,EDSAVE]
	BLT	%03,EDBLK+EDLEN-1	;  AND ENABLE/DISABLE FLAGS
	HRR	%12,EDFLGS
	CALL	GETSRC		;PROCESS FIRST FIELD
	JRST	ACEXCH		;EXCHANGE AC'S AND EXIT

GETSRC:				;GET A SOURCE FILE
	GETCHR			;BYPASS DELIMITER
	CALL	CSIFLD		;GET THE FIELD
	 FERROR	[ASCIZ /NULL SOURCE FIELD/]	;  NO
	DEVSET	SRC,1		;INIT DEVICE
	 XWD	0,SRCBUF
	MOVEI	%03,JOBFFS
	EXCH	%03,JOBFF	;SET TO TOP OF INPUT BUFFER
	INBUF	SRC,NUMBUF
	MOVEM	%03,JOBFF	;RESTORE JOBFF
	MOVE	%00,DEVNAM
	DEVCHR	%00,
	TLNN	%00,TTYDEV
	JRST	GETSR3
	OUTSTR	[BYTE (7) 15,12]
	SKPINC			;TYPED AHEAD?
	 CAIA			;  NO
	JRST	GETSR3		;YES, NO MESSAGE
	OUTSTR	[ASCIZ /READY/]
	OUTSTR	[BYTE (7) 15,12]
GETSR3:	SKIPE	%03,FILEXT	;EXPLICIT EXTENSION?
	JRST	GETSR1		;  YES
	MOVSI	%03,(SIXBIT /P11/)
	CALL	GETSR2		;  NO, TRY .P11 FIRST
	 RETURN			;  MADE IT
	MOVSI	%03,(SIXBIT /PAL/)
	CALL	GETSR2		;  NO, TRY .PAL NEXT
	 RETURN			;  MADE IT
	SETZM	%03
	CALL	GETSR2		;TRY NULL EXTENSION
	 RETURN			;  OK, EXIT
	MOVSI	%03,(SIXBIT /MAC/)
	CALL	GETSR2		;TRY .MAC NEXT
	 RETURN
	MOVSI	%03,(SIXBIT /M11/)
GETSR1:	CALL	GETSR2		;  NO, TRY .M11 NEXT
	 RETURN			;  MADE IT
				;NO DICE
	 FERROR	[ASCIZ /CANNOT FIND 3/]

GETSR2:	HLLZM	%03,FILEXT	;SAVE EXTENSION IN LOOKUP BLOCK
	LOOKUP	SRC,FILNAM	;LOOKUP FILE NAME
	 JRST	CPOPJ1		;  NOT FOUND, SKIP-RETURN
	MOVE	%03,[XWD FILNAM,SRCSAV]
	BLT	%03,SRCSAV+1
	RETURN			;EXIT
CCLSET:				;SET CCL INPUT
	SKIPE	CCLTOP
	 FERROR	[ASCIZ /NESTED CCL'S/]
	MOVE	%00,DEVNAM
	DEVCHR	%00,
	TDC	%00,[XWD 2,2]
	TDNE	%00,[XWD 2,2]	;LEGIT FILE?
	 FERROR	[ASCIZ /DEVICE INPUT ERROR FOR COMMAND STRING/]
	DEVSET	CCL,1		;YES, INIT
	 XWD	0,SRCBUF	;BORROW SOURCE BUFFER
	SKIPE	%03,FILEXT	;EXPLICIT EXTENSION?
	JRST	CCLSE1		;  YES
	MOVSI	%03,(SIXBIT /CCL/) ;TRY THE DEFAULT
	HLLZM	%03,FILEXT
	LOOKUP	CCL,FILNAM
	 TDZA	%03,%03		;  MISSED
	JRST	CCLSE2		;OK
CCLSE1:	HLLZM	%03,FILEXT
	LOOKUP	CCL,FILNAM
	 FERROR	[ASCIZ /CANNOT FIND 3/]	;MISSED COMPLETELY
CCLSE2:	MOVE	%01,JOBFF	;GET CURRENT FIRST FREE
	HRLI	%01,(POINT 7,,)	;FORM BYTE POINTER
	MOVEM	%01,CCLPNT	;SAVE IT
	MOVEI	%03,JOBFFS	;SET TO READ INTO SOURCE BUFFER
	MOVEM	%03,JOBFF
	INBUF	CCL,NUMBUF
	SETZM	%15		;CLEAR ERROR FLAG
CCLSE3:	CALL	CHAR		;GET A CHARACTER
	TLZE	%15,ENDFLG	;END?
	JRST	CCLSE4		;  YES
	TRZE	%15,-1		;NO, GOOD CHARACTER?
	JRST	CCLSE3		;NO, GET ANOTHER
	HRRZ	%06,%01		;COLLECT RIGHT HALF OF BYTE POINTER
	CAML	%06,.JBREL	;COMPARE IT TO LAST FREE CORE ADDR
	FERROR	[ASCIZ /CCL FILE TOO LARGE/];
	IDPB	%14,%01		;STORE THE CHAR
	JRST	CCLSE3		;BACK FOR MORE

CCLSE4:	SETZM	%14
	IDPB	%14,%01		;STORE TERMINATOR
	AOS	%01
	HRRZM	%01,CCLTOP	;SET TOP POINTER
	JRST	NXTCCL


CCLGET:				;GET A CCL CHAR
	SKIPN	CCLTOP		;ANY CCL?
	JRST	CCLGE1		;  NO
	ILDB	%14,CCLPNT	;YES, GET A CHAR
	JUMPN	%14,CPOPJ	;EXIT IF NON-NULL
	EXIT			;  FINIS

CCLGE1:
	INCHWL	%14		;GET A TTY CHAR
	RETURN
DEVSE0:				; "DEVSET" UUO
	MOVE	%03,JOBUUO
	HRRZM	%03,DEVBLK	;SET MODE
	MOVE	%04,DEVNAM
	MOVEM	%04,DEVBLK+1	;XFER NAME
	MOVE	%04,@0(%17)	;FETCH ARG (BUFFER ADDRESS)
	MOVEM	%04,DEVBLK+2
	AND	%03,[Z 17,]	;MASK TO AC FIELD
	IOR	%03,[OPEN DEVBLK]	;FORM UUO
	XCT	%03
	 FERROR	[ASCIZ /CANNOT ENTER 3/]	;MISSED
	CALL	SWPRO		;PROCESS SWITCHES
CPOPJ1:	AOS	0(%17)		;BYPASS ARG
CPOPJ:	RETURN


	.LOC			;FILE INITIALIZATION VARIABLES
DEVBLK:	BLOCK	3		;"OPEN" BLOCK

				;FOLLOWING 5 MUST BE KEPT TOGETHEI
DEVNAM:	BLOCK	1		;DEVICE NAME
FILNAM:	BLOCK	1		;FILE NAME
FILEXT:	BLOCK	1		;EXTENSION
	BLOCK	1
FILPPN:	BLOCK	1		;PROJECT-PROGRAMMER NUMBER

BINBLK:	BLOCK	5		;STORAGE FOR ABOVE

BINBUF:	BLOCK	1		;BINARY BLOCK HEADER
BINPNT:	BLOCK	1
BINCNT:	BLOCK	1
BINPCT:	BLOCK	1

LSTBUF:	BLOCK	1
LSTPNT:	BLOCK	1
LSTCNT:	BLOCK	1

CRFBUF:	BLOCK	1
CRFPNT:	BLOCK	1
CRFCNT:	BLOCK	1

SRCBUF:	BLOCK	1
SRCPNT:	BLOCK	1
SRCCNT:	BLOCK	1
SRCSAV:	BLOCK	2

TTIBEG:	BLOCK	1		;BEGINNING OF TTY BUFFER
TTISAV:	BLOCK	1		;TELETYPE POINTER SAVE
PPNSAV:	BLOCK	1		;PPN STORAGE
CRFBAS:	BLOCK	1
JOBFFS:	BLOCK	204*NUMBUF	;SOURCE BUFFER
	.RELOC
	SUBTTL	COMMAND STRING FIELD SCANNER

CSIFLD:				;PROCESS CLMMAND SCANNER FIELD
	TLZ	%16,INFBIT	;CLEAR INFO BIT
	CALL	CSISYM		;TRY FOR A SYMBOL
	CAIE	%14,":"		;DEVICE?
	JRST	CSIFL1		;  NO
	MOVEM	%00,DEVNAM	;YES, STORE IT
	GETCHR			;BYPASS COLON
	CALL	CSISYM		;GET ANOTHER SYMBOL
CSIFL1:	MOVEM	%00,FILNAM	;ASSUME FILE NAME
	SETZM	FILEXT		;CLEAR EXTENSION
	CAIE	%14,"."		;EXPLICIT ONE?
	JRST	CSIFL2		;  YES
	GETCHR			;BYPASS PERIOD
	CALL	CSISYM		;GET EXTENSION
	HLLOM	%00,FILEXT	;STUFF IT
CSIFL2:	CAIE	%14,"["		;PPN?
	JRST	CSIFL6		;  NO
	SETZM	PPNSAV		;CLEAR CELL
CSIFL3:	HRLZS	PPNSAV		;MOVE RH TO LH
CSIFL4:	GETCHR			;GET THE NEXT CHAR
	CAIN	%14,"]"		;FINISHED?
	JRST	CSIFL5		;  YES
	CAIN	%14,","		;SEPARATOR?
	JRST	CSIFL3		;  YES
	CAIL	%14,"0"		;TEST FOR OCTAL NUMBER
	CAILE	%14,"7"
	 FERROR	[ASCIZ /ILLEGAL PPN/]
	HRRZ	%03,PPNSAV	;MERGE NEW CHAR
	IMULI	%03,8
	ADDI	%03,-"0"(%14)
	HRRM	%03,PPNSAV
	JRST	CSIFL4		;LOOP

CSIFL5:	GETCHR
CSIFL6:	MOVE	%03,PPNSAV
	MOVEM	%03,FILPPN	;SAVE BACKGROUND PPN
	TLNE	%16,INFBIT	;ANYTHING PROCESSED?
	JRST	CPOPJ1		;  YES, SKIP-EXIT
	JRST	SWPRO		;NO, BE SURE TO PROCESS SWITCHES


CSISYM:				;COMMAND SCANNER SYMBOL
	CALL	GETSYM		;GET ONE IN RAD50
	JUMPE	%00,CPOPJ	;EXIT IF NULL
	TLO	%16,INFBIT	;OK, SET INFO BIT
	JRST	M40SIX		;CONVERT TO SIXBIT
SSWPRO:				;SPECIAL ENTRY POINT FOR SWITCH.INI PROCESSING
	SETOM	SWPENT		;SIGNAL SOURCE OF CALL
	CAIA

SWPRO:				;SWITCH PROCESSOR
	SETZM	SWPENT		;SIGNAL NORMAL ENTRY
	CAIE	%14,"/"		;SWITCH?
	RETURN			;  NO, EXIT
	CALL	GETNB		;YES, BYPASS SLASH
	CALL	CSISYM		;GET THE SYMBOL
	MOVSI	%03,-<SWPRTE-SWPRT>	;SET FOR TABLE SCAN
	AOBJN	%03,.+1
	CAME	%00,SWPRT-1(%03)	;COMPARE
	AOBJN	%03,.-2		;  NO
	JUMPG	%03,SWPRO1	;MISSED, ERROR
	SETZM	ARGCNT		;CLEAR ARGUMENT COUNT
	XCT	SWPRT(%03)
	TRZN	%15,-1		;SKIP IF ERRORS ENCOUNTERED
	JRST	SWPRO		;TRY FOR MORE

SWPRO1:	 
	SKIPN	SWPENT		;SWITCH.INI?
	FERROR	 [ASCIZ /BAD SWITCH/]	;NO. ABORT NORMALLY
	JRST	SWIERR

	DEFINE	GENSWT	(MNE,ACTION)	;GENERATE SWITCH TABLE
<
	XLIST
	SIXBIT	/MNE/
	ACTION
	LIST
>

SWPRT:				;SWITCH PROCESSOR TABLE
	GENSWT	LI,<CALL .LIST>
	GENSWT	NL,<CALL .NLIST>
	GENSWT	EN,<CALL .ENABL>
	GENSWT	DS,<CALL .DSABL>
	GENSWT	CRF,<TLZ %16,CRFBIT>
	GENSWT	N,<TLO %16,NSWBIT>
	GENSWT	I,<TLO %15,ISWFLG>
	GENSWT	P,<TLZ %15,ISWFLG>
	GENSWT	GNS,<CALL SWPGNS>
	GENSWT	SOL,<TLO %16,SOLBIT>
	GENSWT	CDR,<TLO %16,CDRBIT>
	GENSWT	EQ,<CALL PROEQ>
	GENSWT	NSQ,<CALL PRONSQ>
	GENSWT	RSX,<CALL	RSX>
SWPRTE:

RSX:				;ACTIVATE RSX OPTIONS
	SETOM	RSXSW		;SET RSX SWITCH NON-ZERO
	TRO	%16,RSXBIT
	RETURN
SWPGNS:	TLO	%16,FMTBIT	;SET FLAG
	MOVEI	%03,LC.SEQ!LC.LOC!LC.BIN!LC.BEX!LC.ME!LC.TOC
	TLO	%12,0(%03)	;SUPPRESS SELECTED FLAGS
	IORM	%03,LCMSK	;ALSO RESTRICT SOURCE OVER-RIDES
	RETURN

PROEQ:	CALL	GSARG
	 RETURN
	CALL	SSRCH
	 JFCL
	TLON	%01,DEFSYM
	TRZ	%01,177777
	CALL	INSRT
	JRST	PROEQ

PRONSQ:	SETZM	P10SEQ
	SETOM	P10SEQ+1
	RETURN

	.LOC
SWPENT:	BLOCK	1		;NON-ZERO IN SWPRO IF ENTERED FROM
				;SWITCH.INI PROCESSING
	.RELOC
	SUBTTL	HEADER ROUTINE

HEADER:	CALL	ACEXCH		;YES, SAVE THE ACCUMULATORS
	SPUSH	%16		;SAVE CURRENT FLAGS
	TLO	%16,NSWBIT	;DON'T OUTPUT TO TTY
	MOVEI	%02,FF		;GET A FORM FEED
	CALL	LSTDMP		;OUTPUT IT
	MOVEI	%03,PAGSIZ+3	;RESET LINE COUNTER REGISTER
	MOVEM	%03,LPPCNT
	MOVN	%11,COLCNT	;GET COLUMNS PER LINE
	SUBI	%11,8*5+3	;LEAVE ROOM FOR DATE, ETC.
	MOVE	%01,[POINT 7,TTLBUF]
	TDZA	%10,%10		;ZERO COUNT
HEADE3:	CALL	LSTOUT
	ILDB	%02,%01		;FETCH CHAR FROM BUFFER
	CAIN	%02,TAB		;TAB?
	IORI	%10,7		;  YES, FUDGE
	ADDI	%10,1
	CAMGE	%10,%11
	JUMPN	%02,HEADE3
	CALL	LSTTAB
	LSTSTR	TITLE
	CALL	LST2SP

;THE FOLLOWING SECTION PRINTS THE DATE, WHICH IS FOUND IN
;REGISTER XDATE IN THE FORM
;	((Y-1964)*12 + (M-1))*31 + (D-1)
	MOVE	%10,DATE	;GET THE DATE IN %10
	IDIVI	%10,^D31	;DIVIDE BY 31 DECIMIAL
	ADDI	%11,1
	DNC	%11		;OUTPUT DAY
	IDIVI	%10,^D12	;DIVIDE BY 12 DECIMAL
	LSTSIX	MONTH(%11)
	MOVEI	%11,^D64(%10)	;GET THE YEAR
	DNC	%11
	CALL	LST2SP		;OUTPUT TAB
	MOVE	%03,MSTIME	;GET THE CURRENT TIME
	IDIVI	%03,^D60*^D1000	;NUMBER OF MIN. SINCE MIDNITE
	IDIVI	%03,^D60	;NUMBER OF HOURS
	SPUSH	%04		;SAVE MINUTES
	CAIG	%03,9
	LSTICH	"0"
	DNC	%03		;OUTPUT THE HOURS
	LSTICH	":"		;OUTPUT A COLON AFTER THE HOURS
	SPOP	%11		;PUT MINUTES IN OUTPUT AC
	CAIG	%11,^D9		;IS IT A ONE-DIGIT NUMBER?
	LSTICH	"0"		;YES, OUTPUT A ZERO
	DNC	%11		;OUTPUT THE MINUTES
	TLNE	%15,P1F
	JRST	HEADE1
	MOVE	%11,PAGNUM	;GET PAGE NUMBER
	LSTMSG	[ASCIZ /  PAGE 5/]
	AOSE	%11,PAGEXT	;INCREMENT, PICK UP, AND TEST
	LSTMSG	[ASCIZ /-5/]
HEADE1:	CALL	LSTCR
	TLNN	%16,SOLBIT	;SEQUENCE OUTPUT?
	JRST	HEADE2
	AOS	PAGNUM		;  YES, BUMP COUNT
	SETOM	PAGEXT
HEADE2:	LSTSIX	SRCSAV
	HLLZ	%00,SRCSAV+1
	JUMPE	%00,.+3
	LSTICH	"."
	LSTSIX	%00
	CALL	LSTTAB
	LSTSTR	STLBUF		;LIST SUB-TITLE
	CALL	LSTCR
	CALL	LSTCR
	SPOP	%02		;RESTORE FLAGS
	TLNN	%02,NSWBIT
	TLZ	%16,NSWBIT
	JRST	ACEXCH		;RESTORE F4 REGS AND EXIT
MONTH:
	SIXBIT	/-JAN-/
	SIXBIT	/-FEB-/
	SIXBIT	/-MAR-/
	SIXBIT	/-APR-/
	SIXBIT	/-MAY-/
	SIXBIT	/-JUN-/
	SIXBIT	/-JUL-/
	SIXBIT	/-AUG-/
	SIXBIT	/-SEP-/
	SIXBIT	/-OCT-/
	SIXBIT	/-NOV-/
	SIXBIT	/-DEC-/


	.LOC
PAGNUM:	BLOCK	1		;PAGE NUMBER
PAGEXT:	BLOCK	1		;PAGE EXTENSION
	.RELOC
	SUBTTL	AC EXCHANGE LOOP

ACEXCH:				;SWAP AC'S
	TLC	%16,MODBIT	;TOGGLE MODE BIT
	EXCH	%00,AC00
	EXCH	%01,AC01
	EXCH	%02,AC02
	EXCH	%03,AC03
	EXCH	%04,AC04
	EXCH	%05,AC05
	EXCH	%06,AC06
	EXCH	%07,AC07
	EXCH	%10,AC10
	EXCH	%11,AC11
;	EXCH	%12,AC12
	EXCH	%13,AC13
	EXCH	%14,AC14
	RETURN


	.LOC
AC00:	BLOCK	1
AC01:	BLOCK	1
AC02:	BLOCK	1
AC03:	BLOCK	1
AC04:	BLOCK	1
AC05:	BLOCK	1
AC06:	BLOCK	1
AC07:	BLOCK	1
AC10:	BLOCK	1
AC11:	BLOCK	1
AC12:	BLOCK	1
AC13:	BLOCK	1
AC14:	BLOCK	1
	.RELOC
	SUBTTL	BINARY OUTPUT ROUTINE

BINOUT:				;BINARY OUTPUT
	SPUSH	%02
	ANDI	%02,377		;MASK TO 8 BITS
	ADDM	%02,CHKSUM	;UPDATE CHECKSUM
	TLNN	%16,ESWBIT	;EXPANDED LISTING (OCTAL) REQUESTED?
	JRST	BINOU2		;  NO
	SPUSH	%01		;  YES, STACK WORKING REGISTERS
	SPUSH	%02
	MOVSI	%01,(POINT 3,0(%17),26)	;POINT TO STACKED CODE
BINOU1:	ILDB	%02,%01		;GET THE NEXT BYTE
	ADDI	%02,"0"		;CONVERT TO ASCII
	CALL	LSTOUT		;LIST IT
	TLNE	%01,770000	;END?
	JRST	BINOU1		;  NO
	CALL	LSTCR		;YES, LIST CR/LF
	SPOP	%02		;RESTORE REGISTERS
	SPOP	%01
BINOU2:	TLNE	%16,BINBIT	;BINARY REQUESTED?
	JRST	BINOU6		;  NO, EXIT
	TLNN	%15,ISWFLG	;PACKED MODE?
	JRST	BINOU3		;  YES
	SOSG	BINCNT
	CALL	BINDMP
	IDPB	%02,BINPNT
	JRST	BINOU6

BINOU3:	SOSLE	BINPCT
	JRST	BINOU4
	CALL	BINDMP
	MOVE	%03,BINCNT
	IMULI	%03,4
	MOVEM	%03,BINPCT
BINOU4:	MOVN	%03,BINPCT
	ANDI	%03,3
	JUMPN	%03,BINOU5
	SOS	BINCNT
	IBP	BINPNT
BINOU5:	DPB	%02,BINTBL(%03)
BINOU6:	SPOP	%02
	RETURN

BINDMP:	OUTPUT	BIN,
BINTST:	STATO	BIN,IODATA!IODEV!IOWRLK!IOBKTL
	RETURN
	 FERROR	[ASCIZ /BINARY OUTPUT ERROR/]

BINTBL:
	POINT	8,@BINPNT,17
	POINT	8,@BINPNT, 9
	POINT	8,@BINPNT,35
	POINT	8,@BINPNT,27
	SUBTTL	LISTING OUTPUT

LSTST0:	TDZA	%03,%03		; "LSTSTR" UUO
LSTMS0:	SETOM	%03		; "LSTMSG" UUO
	HLLM	%03,0(%17)	;SAVE FLAG
	MOVEI	%10,@JOBUUO	;FETCH ARG
	TLOA	%10,(POINT 7,,)	;SET BYTE POINTER AND SKIP
LSTMS1:	CALL	LSTOUT		;TYPE CHARACTER
LSTMS2:	ILDB	%02,%10		;GET CHARACTER
	JUMPE	%02,CPOPJ	;TEST FOR END
	CAIL	%02,"0"		;TEST FOR SWITCH
	CAILE	%02,"5"
	JRST	LSTMS1		;NO, TYPE THE CHARACTER
	SKIPL	0(%17)		;STRING?
	JRST	LSTMS1		;  YES, PRINT NUMERICS
	XCT	LMT-"0"(%02)	;EXECUTE TABLE
	JRST	LSTMS2		;GET NEXT CHARACTER

LMT:
	CALL	LSTCR		; 0 - CR/LF
	LSTICH	0(%14)		; 1 - CHARACTER
	CALL	LM2		; 2 - DEV:
	CALL	LM3		; 3 - DEV:FILNAM.EXT
	HALT	.
	DNC	%11		; 5 - DECIMAL NUMBER

LM2:	LSTSIX	DEVNAM
	LSTICH	":"
	RETURN

LM3:	CALL	LM2
	LSTSIX	FILNAM
	LSTICH	"."
	HLLZ	%00,FILEXT
	LSTSIX	%00
	RETURN
DNC0:				; "DNC" UUO
	MOVE	%03,@JOBUUO	;FETCH ARG
	LDB	%04,[POINT 4,JOBUUO,12]
DNC1:	SPUSH	%04
	IDIVI	%03,^D10
	HRLM	%04,-1(%17)
	SPOP	%04
	SOS	%04
	SKIPE	%03
	CALL	DNC1
DNC2:	HLRZ	%02,0(%17)
	SOJL	%04,LSTNUM
	LSTICH	SPACE
	JRST	DNC2


LSTSY0:				;"LSTSYM" UUO
	SPUSH	%00		;STACK A COUPLE REGISTERS
	SPUSH	%01
	LDB	%02,[POINT 4,JOBUUO,12]	;FETCH FLAG
	DPB	%02,[POINT 1,-2(%17),0]
	MOVE	%00,@JOBUUO	;FETCH WORD
	TRNN	%02,2		;SIXBIT?
	CALL	M40SIX		;  NO, CONVERT TO IT
	MOVSI	%01,(POINT 6,%00)
LSTSY1:	ILDB	%02,%01		;GET THE NEXT CHAR
	SKIPL	-2(%17)		;IF NO FLAG,
	JUMPE	%02,LSTSY2	;  BRANCH ON BLANK
	ADDI	%02,40		;CONVERT TO ASCII
	CALL	LSTOUT		;LIST IT
	TLNE	%01,770000
	JRST	LSTSY1
LSTSY2:	SPOP	%01
	SPOP	%00
	RETURN

LSTIC0:				; "LSTICH" UUO
	MOVEI	%02,@JOBUUO
	JRST	LSTOUT
LSTFLD:				;LIST FIELD
	JUMPE	%10,LSTFL1	;EXIT IF NULL
	CALL	LSTWB		;LIST WORD/BYTE
	MOVEI	%02,"'"
	TLNE	%10,GLBSYM
	MOVEI	%02,"G"
	TDNE	%10,[PFMASK]	;RELOCATABLE?
	CALL	LSTOUT
LSTFL1:	JRST	LSTTAB

LSTWB:				;LIST WORD OR BYTE
	LDB	%03,[POINT 2,%10,17]
	CAIE	%03,1
	JRST	LSTWRD		;WORD

LSTBYT:				;LIST BYTE
	CALL	LSTSP		;LIST THREE SPACES...
LSTBY1:	CALL	LST2SP		;...(SORT OF DEVIOUSLY)
;THIS DEVIOUSNESS IS A KLUDGE WHICH PERMITS A NEATLY ALIGNED
;SYMBOL TABLE
	TRZ	%10,177400	;CLEAR HIGH BITS
	SKIPA	%03,[POINT 3,%10,35-9]

LSTWRD:	MOVE	%03,[POINT 3,%10,35-18]
LSTWR1:	ILDB	%02,%03
	SPUSH	%03
	CALL	LSTNUM		;LIST NUMBER
	SPOP	%03
	TLNE	%03,770000
	JRST	LSTWR1
	RETURN
LST3SP:				;LIST SPACES
	CALL	LSTSP
LST2SP:	CALL	LSTSP
LSTSP:	MOVEI	%02,SPACE
	JRST	LSTOUT

LSTNUM:	TROA	%02,"0"		;LIST NUMERIC
LSTASC:	ADDI	%02,40		;CONVERT SIXBIT TO ASCII
	JRST	LSTOUT

LSTCR:	TDZA	%02,%02		;LIST CR-LF
LSTTAB:	MOVEI	%02,TAB		;LIST A TAB
LSTOUT:				;LISTING ROUTINE
	TLNN	%16,LSTBIT!LPTBIT	;LISTING REQUESTED?
	CALL	LPTOUT		;  YES
	TLNE	%16,ERRBIT	;ERROR LISTING?
	TLNE	%16,NSWBIT!TTYBIT	;  YES, TO TTY?
	RETURN			;  NO
	JUMPE	%02,LSTOU1	;BRANCH IF CR-LF
	OUTCHR	%02		;LIST CHARACTER
	RETURN			;EXIT

LSTOU1:	OUTSTR	[BYTE (7) CRR, LF, 0]
	RETURN			;CR-LF TO TTY
LPTOUT:				;OUTPUT TO LISTING DEVICE
	TLNN	%16,FMTBIT	;FMT MODE?
	JRST	LPTOU1		;NO, NORMAL
	TLNN	%15,FMTFLG	;YES, IN OVER-RIDE?
	RETURN			;  NO
	JUMPN	%02,LSTDMP	;YES
	JRST	LPTOU5

LPTOU1:	TLZE	%16,HDRBIT	;TIME FOR A HEADING?
	CALL	HEADER		;  YES
	JUMPE	%02,LPTOU5	;BRANCH IF CR-LF
	CAIN	%02,TAB
	JRST	LPTOU4		;DON'T LIST TABS IMMEDIATELY
	AOSLE	COLCNT		;OFF LINE?
	JRST	LPTOU2
	SKIPE	TABCNT		;ANY IMBEDDED TABS?
	CALL	PROTAB		;  YES, PROCESS THEM
	JRST	LSTDMP		;LIST THE CHARACTER

LPTOU2:	SKIPN	WRPSAV
	MOVEM	%13,WRPSAV
	RETURN

LPTOU4:	AOS	TABCNT		;TAB, BUMP COUNT
	SPUSH	%02
	MOVEI	%02,7
	IORM	%02,COLCNT
	AOS	COLCNT
	SPOP	%02
	RETURN

LPTOU5:	MOVEI	%02,CRR		;CR-LF
	CALL	LSTDMP
	MOVEI	%02,LF
LPTOU6:	CALL	LSTDMP
	SOSG	LPPCNT		;END OF PAGE?
LPTINI:	TLO	%16,HDRBIT	;  YES, SET FLAG
LPTINF:	MOVNI	%02,COLTTY	;SET FOR COLUMN COUNT
	SKPLCR	LC.TTM
	 MOVNI	%02,COLLPT
	MOVEM	%02,COLCNT
	SETZB	%02,TABCNT	;ZERO TAB COUNT AND REGISTER
	SETZM	WRPSAV
	RETURN

PROTAB:				;PROCESS IMBEDDED TABS
	SKIPG	TABCNT		;ANY LEFT?
	RETURN			;  NO
	SOS	TABCNT		;YES, DECREMENT COUNT
	SPUSH	%02
	MOVEI	%02,TAB
	CALL	LSTDMP		;LIST ONE
	SPOP	%02
	JRST	PROTAB		;TEST FOR MORE
LSTDMP:	SOSG	LSTCNT		;DECREMENT ITEM COUNT
	CALL	LSTDM1		;EMPTY ENTIRE BUFFER
	IDPB	%02,LSTPNT	;STORE THE CHARACTER
	CAIN	%02,LF		;IF LINE FEED,
	TLNN	%16,TTYBIT	;  AND LISTING IS ON TTY, DUMP BUFFER
	RETURN
				;DUMP THE BUFFER


LSTDM1:	OUTPUT	LST,		;EMPTY A BUFFER
LSTTST:	STATO	LST,IODATA!IODEV!IOWRLK!IOBKTL	;CHECK FOR ERRORS
	RETURN			;NO, EXIT
	 FERROR	[ASCIZ /LISTING OUTPUT ERROR/]

	.LOC
COLCNT:	BLOCK	1		;COLUMN COUNT
TABCNT:	BLOCK	1		;TAB COUNT
LPPCNT:	BLOCK	1		;LINES/PAGE COUNT
WRPSAV:	BLOCK	1
WRPCNT:	BLOCK	2
	.RELOC
	SUBTTL	SOURCE INPUT

CHAR:	CALL	CHARLC
	CAIN	%02,QJLC
	SUBI	%14,40
	RETURN

CHARLC:
CHAR0:	SKIPE	MCACNT
	JRST	CHAR10
	SKIPE	MSBMRP
	JRST	CHAR2		;BRANCH IF IN MACRO
	SOSGE	SRCCNT		;DECREMENT ITEM COUNT
	JRST	CHAR4		;GET ANOTHER BUFFER IF NECESSARY
	IBP	SRCPNT		;INCREMENT THE BYTE POINTER
	MOVE	%14,@SRCPNT	;PICK UP AN ENTIRE WORD FROM BUFFER
	TRZE	%14,1		;IS THE SEQUENCE NUMBER BIT ON?
	JRST	CHAR8		;YES, SKIP AROUND IT
	LDB	%14,SRCPNT	;NO, PICK UP A GOOD CHARACTER
CHAR1:	LDB	%02,C7PNTR	;MAP
	XCT	CHARTB(%02)	;DECIDE WHAT TO DO
	RETURN			;ACCEPT IT

CHAR2:	CALL	READMC		;GET A CHARACTER FROM MACRO TREE
	 JRST	CHAR0		;  NULL, TRY AGAIN
	JRST	CHAR1		;TEST IT

CHAR4:	INPUT	SRC,		;CALL MONITIOR FOR A BUFFER
	STATZ	SRC, IODATA+IODEV+IOBKTL+IOWRLK
CHAR4A:	 FERROR	[ASCIZ /INPUT DATA ERROR/]
	STATO	SRC, IOEOF	;WAS AN END OF FILE REACHED?
	JRST	CHAR0		;GET NEXT CHAR
CHAR5:	CLOSE	SRC,
	SKIPE	AC14		;CRR SEEN BY COMMAND SCANNER?
	TLNN	%16,MODBIT
	JRST	CHAR6
	CALL	ACEXCH		;GET EXEC AC'S
	CALL	GETSRC		;GET THE NEXT SOURCE FILE
	CALL	ACEXCH		;SAVE EXEC AC'S AND RETURN
	JRST	CHAR0

CHAR6:	TLO	%15,ENDFLG	;YES, FLAG END
	MOVEI	%14,LF		;MAKE IT A LINE
	JRST	CHAR1
CHAR8:	SKIPL	P10SEQ+1
	MOVEM	%14,P10SEQ
	MOVSI	%14,(<TAB>B6)
	IORM	%14,P10SEQ+1
	AOS	SRCPNT		;INCREMENT POINTER PAST WORD
	MOVNI	%14,5		;GET -5
	ADDM	%14,SRCCNT	;SUBTRACT 5 FROM WORD COUNT
	JRST	CHAR0

CHAR10:	SOSGE	MACBUF+2	;MORE CHARS TO GET W/OUT INPUT?
	JRST	CHAR11		;NO
	IBP	MACPNT		;INCREMENT MACRO POINTER
	MOVE	%14,@MACPNT	;GET A WHOLE WORD FROM SOURCE BUFFER
	TRZE	%14,1		;SEQUENCE NUMBER?
	JRST	CHAR12		;YES.
	LDB	%14,MACPNT
	JRST	CHAR1

CHAR11:	INPUT	MAC,
	STATZ	MAC,740000
	 JRST	CHAR4A
	STATO	MAC,IOEOF
	 JRST	CHAR
	JRST	CHAR6

CHAR12:	SKIPL	P10SEQ+1	;SOMETHING THERE ALREADY?
	MOVEM	%14,P10SEQ	;NO
	MOVSI	%14,(<TAB>B6)
	IORM	%14,P10SEQ+1
	AOS	MACPNT		;BOOST POINTER AROUND SEQ NR & TAB
	MOVNI	%14,5		;SET UP -5
	ADDM	%14,MACBUF+2	;DECREMENT THE WORD COUNT
	JRST	CHAR10		;GO BACK AND TRY AGAIN

CHARTB:				;CHARACTER JUMP TABLE
	PHASE	0
	MOVEI	%14,RUBOUT	;ILLEGAL CHARACTER
QJNU:	JRST	CHAR0		;NULL, TRY AGAIN
QJCR:	JFCL			;END OF STATEMENT
QJVT:	MOVEI	%14,LF		;VERTICAL TAB
QJTB:	JFCL			;TAB
QJSP:	JFCL			;SPACE
QJPC:	JFCL			;PRINTING CHARACTER
QJLC:	JFCL
	DEPHASE
	SUBTTL	BASIC ASSEMBLY LOOP

ASSEMB:				;ASSEMBLER PROPER
	TLO	%15,P1F		;SET FOR PASS 1
	MOVE	%03,.MAIN.
	MOVEM	%03,PRGTTL	;INIT TITLE
	MOVE	%03,.ABS.
	MOVEM	%03,SECNAM	;INIT ABSOLUTE SECTOR
	MOVE	%03,[XWD [ASCIZ /.MAIN./],TTLBUF]
	BLT	%03,TTLBUF+2
	MOVE	%03,[XWD [ASCIZ /TABLE OF CONTENTS/],STLBUF]
	BLT	%03,STLBUF+4	;PRESET SUBTTL BUFFER
	TLNN	%16,REGBIT	;WERE REGS EN-DISABLED AT COMMAND LEVEL?
	CALL	.ENABA		;NO..SET UP DEFAULT REGISTER DEFS
	CALL	INIPAS		;INITIALIZE PASS ONE
	CALL	BLKINI		;INITIALIZE BINARY OUTPUT
	TLNE	%16,GBLDIS	;HAVE DFLT GLOBALS BEEN DISABLED?
	TLOA	%16,GBLCCL	;YES. SAVE SETTING
	TLZ	%16,GBLCCL	;RESET CCL-LEVEL DLFT GLOBAL SW
	CALL	LINE		;GO DO PASS ONE.
	TLZ	%15,P1F		;RESET TO PASS 2
	TLNE	%16,GBLCCL	;SHLD GBLDIS REMAIN SET?
	TLOA	%16,GBLDIS	;YES
	TLZ	%16,GBLDIS	 ;...
	CALL	SETCRF		;SET CREF OUTPUT FILE
	SKIPN	CCLTOP
	JRST	ASSEM1
	TLO	%16,LPTBIT!ERRBIT	;LIST TO TTY
	LSTSYM	PRGTTL
	CALL	LSTCR
	TLZ	%16,LPTBIT!ERRBIT
ASSEM1:
	TLNN	%16,REGBIT	;WERE REGS EN-DISABLED AT COMMAND LEVEL?
	CALL	.ENABA		;NO..SET UP DEFLT REG DEFS
	CALL	INIPAS
	SETZM	STLBUF
	CALL	LINE		;CALL THE ASSEMBLER (PASS TWO)
	TLZ	%16,REGBIT	;CLEAR THIS BIT

	RETURN

LINE:				;PROCESS ONE LINE
	CALL	GETLIN		;GET A SOURCE LINE
	CALL	STMNT		;PROCESS ONE STATEMENT
	CALL	ENDL		;PROCESS END OF LINE
	TLZN	%15,ENDFLG	;TEST FOR END STATEMENT
	JRST	LINE		;GET THE NEXT LINE
	JRST	ENDP		;END OF PASS
INIPAS:
	CALL	SETSRC		;RESET INPUT COMMAND STRING
	SKPEDR	ED.ABS		;ABSOLUTE?
	 TDZA	%05,%05		;  YES, SET PC TO ZERO
	MOVSI	%05,(1B<SUBOFF>)	;  NO, SET TO RELOCATABLE
	MOVSI	%03,-^D256
	SETZM	SECBAS(%03)	;INIT SECTOR BASES
	AOBJN	%03,.-1
	SETZM	MSBMRP
	SETZM	LSBNUM
	CALL	LSBINC		;INIT LOCAL SYMBOLS
	MOVEI	%03,^D8
	MOVEM	%03,CRADIX
	MOVEI	%00,1
	MOVEM	%00,PAGNUM	;INITIALIZE PAGE NUMBER
	MOVEM	%00,ERPNUM	;  AND ERROR PAGE NUMBER
	SETOM	ERPBAK		;BE SURE TO PRINT FIRST TIME
	SETOM	PAGEXT		;  AND EXTENSION
	TLO	%16,HDRBIT
	SETZM	CNDMSK		;CLEAR CONDITIONAL MASK
	SETZM	CNDWRD		;  AND TEST WORD
	SETZM	CNDLVL
	SETZM	CNDMEX
	MOVEM	%12,TIMBLK	;PRESERVE R12
	SETZM	REPSW		;CLEAR REPEAT SWITCH
	SETZM	REPBLK		;;AND FIRST WORD OF BLOCK
	MOVEI	%12,REPBLK-1	;INITIALIZE 'STACK' POINTER
	MOVEM	%12,REPCT	;.....
	MOVE	%12,[REPBLK,,REPBLK+1];PREPARE FOR AND....
	BLT	%12,REPBLK+^D127 ;...EXECUTE THE BLT TO CLEAR THE STACK
	SETZ 	%12,		;CLEAR THE REGISTER
	EXCH	%12,TIMBLK	;AND THEN TIMBLK W/ REG RESTORE
	SETZM	TIMBLK+1
	SETZM	PHAOFF
	SETZM	WRPCNT
	SETZM	WRPCNT+1
	JRST	ENDLI		;EXIT THROUGH END OF LINE ROUTINE

.MAIN.:	GENM40	.,M,A,I,N,.

.ABS.:	GENM40	., ,A,B,S,.
	SUBTTL	STATEMENT EVALUATOR

STMNT:				;STATEMENT PROCESSOR
	SETZM	ARGCNT
	SKIPN	CNDWRD		;UNSATISIFIED CONDITIONAL?
	SKIPE	CNDMEX		;OR PERHAPS AN .MEXIT?
	JRST	STMNT5		;YES...
STMNTF:	SETZM	ARGCNT		;CLEAR ARGUMENT COUNT
	CALL	GETSYM		;TRY FOR SYMBOL
	JUMPE	%00,STMNT3	;BRANCH IF NULL
	CAIN	%14,":"		;LABEL?
	JRST	LABEL		;  YES
	CAIN	%14,"="		;ASSIGNMENT?
	JRST	ASGMT		;  YES
	CALL	OSRCH		;NO, TRY MACROS OR OPS
	 JRST	STMNT2		;TREAT AS EXPRESSION
STMNT1:	CALL	CRFOPR		;CREF OPERATOR REFERENCE
	LDB	%02,TYPPNT	;RESTORE TYPE
	XCT	STMNJT(%02)	;EXECUTE TABLE
STMNJT:				;STATEMENT JUMP TABLE
	PHASE	0
	JRST	STMNT2		;BASIC SYMBOL
MAOP:	JRST	MACROC		;MACRO
OCOP:	JRST	PROPC		;OP CODE
DIOP:	JRST	0(%01)		;PSEUDO-OP
	DEPHASE

STMNT2:	MOVE	%13,SYMBEG	;NON-OP SYMBOL, RESET CHAR POINTER
	CALL	SETNB		;SET CURRENT CHAR
	CAIE	%14,";"		;IF SEMI-COLON
	CAIN	%14,0		;  OR LINE TERMINATOR,
	RETURN			;  NULL LINE
	JRST	.WORD		;NEITHER, TREAT AS ".WORD"

STMNT3:	CALL	GETLSB		;IT'S A LOCAL SYMBOL, RIGHT?
	JUMPE	%00,STMNT2	;WRONG.
	CAIE	%14,":"		;THEN IT'S A LABEL, RIGHT?
	JRST	STMNT2		;SORRY, WRONG AGAIN. IT'S AN EXPRESSION
	CAMLE	%05,LSBMAX	;WITHIN RANGE?
	ERRSET	ERR.A		;  NO, ERROR
	JRST	LABELF

STMNT4:	CALL	GETNB
	CAIN	%14,":"		;ANOTHER COLON?
	CALL	GETNB		;YES...BYPASS IT.

STMNT5:	;TRAP FOR .MEXIT OR UNSATISIFED CONDITIONALS
	CALL	GETSYM
	CAIN	%14,":"
	JRST	STMNT4
	CAIN	%14,"="
	JRST	STMNT6
	CALL	TSTMLI		;CONDITIONED OUT
	CAIE	%03,DCCND	;TEST FOR CONDITIONAL OP CODE
	CAIN	%03,DCCNDE
	JRST	STMNT1		;  YES, PROCESS IT
STMNT6:	SETLCT	LC.CND		;NO, SET LISTING FLAG
	TLO	%15,NQEFLG
	RETURN
LABEL:				;LABEL PROCESSOR
	CALL	LSBTST		;TEST FOR NEW LOCAL SYM RANGE
LABELF:	MOVSI	%04,0		;ASSUME NO GLOBAL DEFINITION
	CALL	GETNB		;BYPASS COLON
	CAIE	%14,":"		;ANOTHER COLON?
	JRST	.+3		;NO
	MOVSI	%04,GLBSYM	;GET GLOBAL FLAG
	CALL	GETNB		;BYPASS SECOND COLON
	SPUSH	%04		;STACK GLOBAL FLAG
	CALL	SSRCH		;SEARCH SYMBOL TABLE
	JRST	LABEL0		;NOT THERE.
	TLNE	%01,REGSYM	;REGISTER?
	JRST	LABEL2		;YES, ERROR

LABEL0:	TLNE	%01,DEFSYM	;SYMBOL DEFINED?
	JRST	LABEL1		;YES
	TLNE	%01,FLTSYM	;DEFAULTED GLOBAL SYMBOL?
	TLZ	%01,FLTSYM!GLBSYM ;YES-CLEAR FLAGS.
	TDO	%01,0(%17)	;INSERT GLOBAL BIT
	TDO	%01,%05		;SET CURRENT PC VALUE

LABEL1:	MOVE	%03,%01		;COPY VALUE REGISTER
	TDC	%03,%05		;COMPARE WITH PC
	TDNN	%03,[PCMASK]	;EQUAL ON MEANINGFUL BITS
	JRST	LABEL3		;  YES
LABEL2:	TLNN	%15,P1F		;NO, PASS 1?
	TLNE	%01,MDFSYM	;NO, MULTIPLY DEFINED ALREADY?
	TLOA	%01,MDFSYM	;  YES, FLAG SYMBOL
	ERRSET	ERR.P		;NO, PHASE ERROR
	CAIA
LABEL3:	TLO	%01,LBLSYM!DEFSYM	;OK, FLAG AS LABEL
	CAMN	%00,M40DOT	;PERCHANCE PC?
	ERRSKP	ERR.M		;  YES, FLAG ERROR AND SKIP
	CALL	INSRT		;INSERT/UPDATE
	TLNE	%01,MDFSYM	;MULTIPLY DEFINED?
	ERRSET	ERR.M		;  YES
	SPOP	%04		;CLEAN STACK
	CALL	SETNB		;
	MOVEM	%13,CLILBL
	CALL	CRFDEF
	CALL	SETPF0
	JRST	STMNTF		;RETURN TO STATEMENT EVALUATOR
ASGMT:				;ASSIGNMENT PROCESSOR
	MOVSI	%04,0		;ASSUME NO GLOBAL DEFINITION
	CALL	GETNB		;GET NEXT NON-BLANK
	CAIE	%14,"="		;ANOTHER EQUALS?
	JRST	.+3		;NO
	MOVSI	%04,GLBSYM	;SET GLOBAL SYMBOL FLAG
	CALL	GETNB		;GET NEXT NON-BLANK
	SPUSH	%04		;STACK FLAG
	SPUSH	%00		;STACK SYMBOL
	CALL	RELEXP
	CALL	SETPF1
	JRST	ASGMT0

ASGMTF:	CALL	SETPF1

ASGMTX:	MOVSI	%04,0		;SET ZERO FLAG
	EXCH	%04,0(%17)	;EXCHANGE WITH SYMBOL
	SPUSH	%04		;STACK SYMBOL AGAIN
ASGMT0:	SPOP	%00		;RETRIEVE SYMBOL
	CALL	SSRCH		;SEARCH TABLE
	JFCL			;NOT THERE YET
	CALL	CRFDEF
	TLNE	%01,LBLSYM	;LABEL?
	JRST	ASGMT1		;  YES, ERROR
	TLNE	%01,FLTSYM	;DEFAULTED GLOBAL SYMBOL?
	TLZ	%01,FLTSYM!GLBSYM ;YES-CLEAR DEFAULT FLAGS
	AND	%01,[XWD GLBSYM!MDFSYM,0]	;MASK
	TRNN	%15,ERR.U!ERR.A	;ANY UNDEFINED SYMBOLS OR ADDRSNG ERRS?
	TLO	%01,DEFSYM	;  NO, FLAG AS DEFINED
	TDOA	%01,%10		;MERGE NEW VALUE
ASGMT1:	TLO	%01,MDFSYM	;  ERROR, FLAG AS MULTIPLY DEFINED
	TLNE	%01,MDFSYM	;EVER MULTIPLY DEFINED?
	ERRSET	ERR.M		;  YES
	CAME	%00,M40DOT	;LOCATION COUNTER?
	TDO	%01,0(%17)	;NO - MERGE GLOBAL DEFINITION BIT
	SPOP	%04		;CLEAN STACK
	CAME	%00,M40DOT	;SKIP IF LOCATION COUNTER
	JRST	INSRT		;INSERT AND EXIT
	CALL	TSTMAX		;TEST FOR NEW HIGH
	LDB	%02,SUBPNT
	LDB	%03,CCSPNT
	CAME	%02,%03		;CURRENT SECTOR?
ASGMT2:	ERRXIT	ERR.A!ERR.P1	;  ERROR, DON'T STORE
	CALL	INSRT
	JRST	SETRLD
	SUBTTL	END OF LINE PROCESSOR

ENDL:				;END OF LINE PROCESSOR
	SKIPE	MCACNT
	JRST	ENDLI
	SKIPE	ARGPNT
	 HALT	.
	SETCHR
	CAIA
ENDL01:	CALL	GETNB		;SET NON-BLANK CHARACTER
	CAIE	%14,0		;IF CR/LF
	CAIN	%14,";"		;  OR COMMENT,
	JRST	ENDL02		;  BRANCH
	TLNE	%15,NQEFLG	;NO, OK?
	JRST	ENDL01		;  YES, TRY AGAIN
	ERRSET	ERR.Q		;  NO, FLAG ERROR
ENDL02:	SKPLCR	LC.COM		;COMMENT SUPPRESSION?
	 MOVEM	%13,CLIPNT+1	;  YES, MARK IT
	MOVE	%01,CLIPNT
	SKPLCR	LC.SRC		;SOURCE SUPPRESSION?
	 MOVEM	%01,CLIPNT+1	;  YES
	SETZM	CODPNT		;INITIALIZE FOR CODE OUTPUT
	CALL	PROCOD		;PROCESS CODE
	 JFCL			;  NO CODE, IGNORE THIS TIME
ENDL10:	TDZ	%15,ERRSUP
	TRNE	%15,-1-ERR.P1
	TRZ	%15,ERR.P1
	TRZN	%15,ERR.P1	;PASS 1 ERROR?
	TLNN	%15,P1F		;  NO, ARE WE IN PASS2?
	CAIA			;  YES, LIST THIS LINE
	TRZ	%15,-1		;PASS 1, CLEAR ANY ERROR FLAGS
	TRNE	%15,-1		;ANY ERRORS?
	TLO	%16,ERRBIT	;  YES, SET BIT
	TLNE	%16,ERRBIT!P1LBIT	;ERRORS OR PASS1 LISTING?
	JRST	ENDL11		;  YES
	TLNN	%16,LSTBIT
	TLNE	%15,FFFLG	;NO, PASS ONE?
	JRST	ENDL41		;  YES, DON'T LIST
	SKIPL	LCLVLB		;IF LISTING DIRECTIVE
	SKIPGE	%02,LCLVL	;  OR LISTING SUPPRESSED,
	JRST	ENDL41		;  BYPASS
	SKPLCR	@LCTST		;  AND SUPPRESSION BITS
	JUMPLE	%02,ENDL41	;  YES
	TLNE	%15,P1F
	JRST	ENDL42
	JRST	ENDL20		;NO, LIST THIS LINE

ENDL11:	TRNN	%15,-1		;ARE WE HERE DUE TO ERRORS?
	JRST	ENDL20		;  NO
	TRNE	%15,-1-ERR.Q	;ERRORS OTHER THAN "Q"?
	TRZ	%15,ERR.Q	;  YES, DON'T LIST IT
	TRNE	%15,QMEMSK	;ANY FATAL TYPES?
	AOSA	ERRCNT		;  YES
	AOS	ERRCNT+1	;NO, TALLY SECONDARY
	MOVE	%03,LINPNT
	MOVEM	%03,CLIPNT	;LIST ENTIRE LINE
	SETZM	CLIPNT+1
	TLO	%16,LPTBIT
	MOVE	%11,ERPNUM
	CAME	%11,ERPBAK
	LSTMSG	[ASCIZ /**PAGE 50/]
	MOVEM	%11,ERPBAK
	TLZ	%16,LPTBIT
	HRLZ	%00,%15		;PUT FLAGS IN AC0 LEFT
	MOVE	%01,[POINT 7,ERRMNE,]
ENDL12:	ILDB	%02,%01		;FETCH CHARACTER
	SKIPGE	%00		;THIS CHARACTER?
	CALL	LSTOUT		;  YES
	LSH	%00,1
	JUMPN	%00,ENDL12	;TEST FOR END
ENDL20:	SKPLCR	LC.SEQ
	 JRST	ENDL22
	TLO	%15,FMTFLG
	MOVE	%01,LINNUM
	EXCH	%01,LINNUB
	CAME	%01,LINNUB
	JRST	ENDL21
	SKIPLE	%11,MSBLVL
	LSTMSG	[ASCIZ /   (5)/]
	JRST	ENDL22

ENDL21:	HRRZ	%00,COLCNT
	IDIVI	%00,8
	MOVE	%03,LINNUM
	IDIVI	%03,^D10
	ADDI	%01,1
	JUMPN	%03,.-2
	CALL	LSTSP
	CAIGE	%01,5
	AOJA	%01,.-2
	DNC	LINNUM
ENDL22:	CALL	LSTTAB
	TLO	%15,FMTFLG
	TLNE	%15,LHMFLG	;TO BE LEFT-JUSTIFIED?
	JRST	ENDL30		;  YES
	SKPLCR	LC.LOC
	 JRST	ENDL23		;SKIP
	MOVE	%10,PF0		;FIRST FIELD TO BE PRINTED?
	CALL	LSTFLD		;  YES
ENDL23:	SKPLCR	LC.BIN
	 JRST	ENDL30
	MOVE	%10,PF1		;PRINT PF1
	CALL	LSTFLD
	SKPLCS	LC.TTM
	 JRST	ENDL30		;  YES, THROUGH FOR NOW
	MOVE	%10,PF2
	CALL	LSTFLD		;  NO, LIST
	MOVE	%10,PF3
	CALL	LSTFLD
ENDL30:	SKIPE	P10SEQ
	LSTSTR	P10SEQ
	TLNN	%15,P1F
	SKPEDS	ED.TIM		;TIMING REQUESTED?
	 JRST	ENDL77		;  NO
	SKIPN	%01,TIMBLK+1	;YES, ANY INCREMENT?
	JRST	ENDL76		;  NO, JUST A TAB
	ADDM	%01,TIMBLK	;YES, UPDATE MASTER
	IDIVI	%01,^D10
	SPUSH	%02
	DNC	4,%01
	LSTICH	"."
	SPOP	%02
	LSTICH	"0"(%02)
	SETZM	TIMBLK+1	;CLEAR INCREMENT
ENDL76:	CALL	LSTTAB
ENDL77:	SKIPN	%13,CLIPNT	;ANY LINE TO LIST?
	JRST	ENDL40		;  NO
	SKIPE	%03,CDRCHR	;CDR CHAR TO STUFF?
	DPB	%03,CDRPNT	;  YES, DO SO
	MOVEI	%03,0
	DPB	%03,CLIPNT+1	;MARK END OF PRINTING LINE
ENDL78:	LDB	%02,%13		;SET FIRST CHARACTER
	ILDB	%01,ILCPNT
	SKIPE	ILCPNT
	TLO	%01,(1B0)
	DPB	%03,ILCPNT
	JUMPE	%02,ENDL33

ENDL31:	CALL	LSTOUT		;LIST THIS CHARACTER
	ILDB	%02,%13		;GET THE NEXT
ENDL32:	JUMPN	%02,ENDL31	;LOOP IF NOT END
ENDL33:	JUMPE	%01,ENDL40	;BRANCH IF NO ILLEGAL CHARS STORED
	MOVEI	%02,"?"		;YES, MARK THE LISTING
	CALL	LSTOUT
	HRRZ	%02,%01		;GET SAVED CHARACTER
	MOVEI	%01,0		;RESET ILLEGAL CHARACTER
	JRST	ENDL32
ENDL40:	SKPEDR	ED.WRP
	SKIPN	%13,WRPSAV
	JRST	ENDL44
	AOS	WRPCNT+1
	SPUSH	COLCNT
	CALL	LSTCR
	SPOP	%03
	ADD	%03,COLCNT
	MOVNS	%03
	IDIVI	%03,^D8
	MOVEM	%03,TABCNT
	JRST	ENDL78

ENDL44:	AOS	WRPCNT
	CALL	LSTCR		;LIST CR/LF
ENDL42:	TLNE	%16,SOLBIT	;SEQUENCE OUTPUT?
	SKPLCR	LC.BEX		;  YES, EXTENSION LINE?
	 CAIA			;  YES, IGNORE
	AOS	LINNUM		;NO, BUMP LINE NUMBER
ENDL41:	CALL	ENDLIF		;SEMI-INIT LINE
	CALL	PROCOD		;PROCESS ADDITIONAL CODE, IF ANY
	 JRST	ENDL50
	SETLCT	LC.BEX
	JRST	ENDL10		;MORE CODE, LOOP

ENDL50:	SKIPN	%03,FFCNT	;FORM FEED ENCOUNTERED?
	JRST	ENDLI		;  NO
	SETZM	TIMBLK		;RESET TIMING AT END OF LINE
	HRRZS	%03
	TLNN	%15,P1F		;SKIP IF PASS 1
	SKIPGE	LCLVL
	CAIA
	TLO	%16,HDRBIT	;SET HEADER BIT
	JUMPE	%03,ENDLI
	TLNN	%16,SOLBIT
	ADDM	%03,PAGNUM	;YES, BUMP PAGE NUMBER
	SETOM	PAGEXT
	TLNE	%16,FMTBIT
	TLNE	%15,P1F
	JRST	ENDLI
	TLO	%15,FMTFLG
	LSTICH	CRR
	LSTICH	FF
	SOJG	%03,.-2
ENDLI:	SETZM	CODPNT
	SETZM	LCTST
	SETZM	GLBPNT
	SETZM	FFCNT
	TLZ	%15,FMTFLG
	SETZM	LINPNT
	SETZM	CLIPNT+1
ENDLIF:	AND	%05,[PCMASK]	;CLEAN UP PC
	SETZM	PF0		;CLEAR PRINT WORDS
	SETZM	PF1
	SETZM	PF2
	SETZM	PF3
	SETZM	CLIPNT
	SETZM	CLILBL
	SETZM	LCLVLB
	SKIPL	%03,P10SEQ+1
	MOVEM	%03,P10SEQ
	SETZM	CDRCHR
	SETZM	ILCPNT
	TRZ	%15,-1
	TLZ	%15,NQEFLG!FFFLG!DSTFLG!DS2FLG!LHMFLG
	TLZ	%16,ERRBIT!P1LBIT
	RETURN

	.LOC
PF0:	BLOCK	1		;PRINT FIELD STORAGE
PF1:	BLOCK	1
PF2:	BLOCK	1
PF3:	BLOCK	1
PFT0:	BLOCK	1		;TEMPS FOR ABOVE
PFT1:	BLOCK	1
LINNUM:	BLOCK	1		;SEQUENCE NUMBER
LINNUB:	BLOCK	1
P10SEQ:	BLOCK	2
	.RELOC
	SUBTTL	ERROR FLAGGING

ERRSK0:	AOSA	0(%17)		;FLAG ERROR AND SKIP
ERRXI0:	SPOP	0(%17)		;FLAG ERROR AND EXIT
ERRSE0:	TRO	%15,@JOBUUO	;FLAG ERROR
	RETURN
	SUBTTL	OP CODE HANDLERS

PROPC:				;PROCESS OP CODES
	CALL	TSTEVN		;MAKE SURE WE'RE EVEN
	LDB	%02,SUBPNT	;GET CLASS
	HRLI	%01,BC2
	MOVEM	%01,OPCODE	;STORE OP
	SETZM	OFFSET		;CLEAN UP FOR AEXP
	SETZM	ADREXT
	SETZM	ADREXT+1
	MOVE	%03,PROPCT(%02)	;FETCH PROPER TABLE ENTRY
	LDB	%04,[POINT 9,%03,35]
	ADDM	%04,TIMBLK+1	;UPDATE TIMING
	TRZ	%03,777
	TLO	%15,0(%03)	;SET PROPER CREF FLAGS
	HLRZS	%03		;SET INDEX
	CALL	0(%03)		;CALL PROPER HANDLER
	SKIPE	%01,OPCODE	;FETCH OP-CODE
	CALL	STCODE		;STOW CODE
	SKIPE	%01,ADREXT	;EXTENSION?
	CALL	STCODE		;  YES, STORE IT
	SKIPE	%01,ADREXT+1
	CALL	STCODE		;DITTO
	LDB	%01,[POINT 16,OPCODE,35];GET ALL OF 1ST WORD OF INSTRUCTION
	CAIN	%01,167		;X-ERROR SUSCEPTIBLE JMP?
	JRST	PROPC5		;YES. GO CHECK
	LSH	%01,-6
	CAIN	%01,0001	;JMP?
	JRST	PROPC2		;YES. GO TO Z-ERROR CHECKING
	LSH	%01,-3
	CAIN	%01,004		;JSR?
	JRST	PROPC2		;YES. GO TO Z-ERROR CHECKING
	TRC	%01,170		;PREPARE TO CHECK FOR...
	TRCN	%01,170		;EAE INSTRUCTION?
	RETURN			;YES. GO HOME.
	TRNN	%01,070		;DOUBLE OPERAND INSTRUCTION OR XOR??
	RETURN			;NO. HOME FREE.
	CAIE	%01,074		;XOR?
	JRST	PROPC1		;NO. GO TO NORMAL DOUBLE OPERAND CHECKING.
	LDB	%01,[POINT 12,OPCODE,35];GET SRCE MODE,REG, DEST MODE,REG
	TRZA	%01,7000	;GENERATE LITERAL SOURCE MODE OF 0

	COMMENT %
THERE ARE FOUR GENERAL CASES WHERE INSTRUCTIONS WILL NOT
FUNCTION IDENTICALLY FROM ONE MODEL OF PDP-11 TO ANOTHER.  THESE
CASES ARE AS FOLLOWS:
1. JMP OR JSR TO A MODE 0 DESTINATION.
2. JMP OR JSR TO A MODE 2 DESTINATION.
3. DOUBLE OPERAND INSTRUCTION OR XOR WITH A SOURCE MODE OF 0
   (WHICH IS IMPLIED IN AN XOR) AND A DESTINATION MODE BETWEEN
   2 AND 5 INCLUSIVE, WITH THE SAME REGISTER USED IN BOTH SOURCE
   AND DESTINATION.
4. DOUBLE OPERAND INSTRUCTION WITH A SOURCE MODE OF ZERO (INCL XOR)
   AND A SOURCE REGISTER OF 7 AND A DESTINATION MODE OF 
   SIX OR SEVEN.
%

; THE FOLLOWING BLOCK OF CODE CHECKS FOR Z-ERROR CONDITIONS IN DOUBLE OPERAND INSTRUCTIONS, INCLUDING XOR

PROPC1:	LDB	%01,[POINT 12,OPCODE,35];GET SRC,DST MODE&RG
	TRNE	%01,7000	;SOURCE MODE=0?
	RETURN			;NO. GO HOME
	TRC	%01,0760	;PREPARE TO CHECK FOR....
	TRCN	%01,0760	;CASE 4?
	ERRSET	ERR.Z		;YES. FLAG IT
; NOW CHECK FOR CASE THREE
	TRZ	%01,0700	;CLEAR SOURCE REGISTER
	CAIL	%01,20		;DEST MODE <2 *OR*
	CAILE	%01,57		;          >5 ?
	RETURN			;YES. NO PROBLEM.
	LSH	%01,6		;ALIGN DEST REG W/ SOURCE REG FIELD
	XOR	%01,OPCODE	;COMPARE SOURCE AND DEST REGS
	TRNN	%01,0700	;ARE THE TWO EQUAL?
	ERRSET	ERR.Z		;SURE ARE. FLAG THE STATEMENT.
	RETURN			;END OF CASE 3 AND 4 CHECKING.

; THE FOLLOWING BLOCK OF CODE CHECKS FOR Z-ERROR CONDITIONS IN JMP AND JSR COMMANDS.

PROPC2:	LDB	%01,[POINT 3,OPCODE,35-3];PICK UP DEST MODE
	TRNE	%01,5		;MODE 0 OR 2?
	CAIA			;NO. SKIP AROUND FLAGGING...
	ERRSET	ERR.Z		;YES. FLAG THE STMNT.
	RETURN			;GO BACK

PROPC5:	LDB	%02,[POINT 16,ADREXT,35]
	MOVE	%11,%05		;POSITION CURRENT CSECT VALUE
	XORM	%11,%10		;COMPARE IT TO DESTINATION CSECT
	TRNE	%11,(<GLBSYM>B17!377B<SUBOFF>);JMP TO DIFFERENT CSECT, OR GLOBAL VARIABLE?
	RETURN			;YES.  BYPASS X-ERROR CHECKING
	CAILE	%02,000374	;IS THE JMP SHORT ENOUGH TO BE A BRANCH?
	CAIL	%02,177376
	ERRSET	ERR.X		;YES
	RETURN

OPCERR:	ERRSET	ERR.O
	RETURN
PROPCT:		;BITS 27-35 CONTAIN INSTRUCTION EXECUTION TIME IN .1USECS
	PHASE	0
	HALT
OPCL0:	XWD	POPCL0,		+^D15
OPCL1:	XWD	POPCL1,	DSTFLG	+^D23
OPCL1A:	XWD	POPCL1,		+^D23
OPCL2:	XWD	POPCL2,	DS2FLG	+^D23
OPCL2A:	XWD	POPCL2,		+^D23
OPCL3:	XWD	POPCL3,	DSTFLG	+^D35
OPCL4:	XWD	POPCL4,		+^D26
OPCL5:	XWD	POPCL5,	DS2FLG
OPCL5A:	XWD	POPCL5,	DSTFLG	+^D44
OPCL6:	XWD	POPCL6,		+^D93
OPCL7:	XWD	POPCL7,	DS2FLG
OPCL8:	XWD	POPCL8,	DSTFLG
OPCL9:	XWD	POPCL9,	DS2FLG
OPCL10:	XWD	POPC10,
OPCL11:	XWD	POPC11,	DS2FLG
OPCL12:	XWD	POPC12,	DS2FLG
OPCL13:	XWD	POPC13,
OPCL14:	XWD	POPC14,	DS2FLG
OPCL15:	XWD	POPC11,
	DEPHASE

	IFN	<DS2FLG!DSTFLG>&777,	<PRINTX	;PROPCT OVERLAP>

	.LOC
OPCODE:	BLOCK	1
OFFSET:	BLOCK	1
ADREXT:	BLOCK	2
TIMBLK:	BLOCK	2		;TIMING INFO
	.RELOC
POPCL0:
	LDB	%03,[POINT 16,OPCODE,35]
	CAILE	%03,000004	;ONE OF THE COMMON ONES?
	RETURN			;  NO, USE DEFAULT TIME
	MOVE	%04,[DEC 18,18,48,93,93](%03)
	MOVEM	%04,TIMBLK+1
	RETURN

POPCL1:	CALL	AEXP		;PROCESS ADDRESS EXPRESSION
	DPB	%00,[POINT 6,OPCODE,35]
	LDB	%03,[POINT 9,OPCODE,35-6]
	CAIN	%03,057		;TEST INSTRUCTION?
	SKIPN	%04		;  YES, NON-REGISTER MODE?
	CAIA			;  NO
	SUBI	%04,^D5		;YES, GET A REFUND
	ADDM	%04,TIMBLK+1
	RETURN

POPCL2:	;DOUBLE OPERAND INSTRUCTION HANDLING
	CALL	AEXP
	DPB	%00,[POINT 6,OPCODE,35-6]
	SKIPE	%04		;REGISTER MODE?
	ADDI	%04,1		;  NO, ADD (WE'RE IN SRC)
	LDB	%03,[POINT 3,OPCODE,35-12]
	CAIE	%03,3		;IF BIT
	CAIN	%03,4		;  OR BIC,
	ADDI	%04,^D6		;  ADD SURCHARGE
	ADDM	%04,TIMBLK+1
POP2ND:	CALL	TSTCOM
	CALL	AEXP
	DPB	%00,[POINT 6,OPCODE,35]
	JUMPE	%04,CPOPJ	;EXIT IF NO TIMING
	LDB	%03,[POINT 3,OPCODE,35-12]
	CAIE	%03,2		;IF CMP
	CAIN	%03,3		;  OR BIT,
	SUBI	%04,^D5		;  GET REFUND
	ADDM	%04,TIMBLK+1
	RETURN

POPCL3:	CALL	REGEXP
	DPB	%10,[POINT 3,OPCODE,35]
	RETURN

POPCL4:				;PROCESS BRANCH ON CONDITION
	CALL	RELADR		;CALL RELATIVE ADDRESS EVALUATOR
	MOVNS	%10
	TRNE	%10,000200	;NEGATIVE?
	TRC	%10,077400	;  YES, TOGGLE HIGH BITS
	TRNE	%10,077400	;ANY OVERFLOW?
	ERRSET	ERR.A		;  YES, FLAG IT
	TRNE	%15,ERR.A	;ANY ADDRESS ERRORS?
	MOVNI	%10,1		;  YES, MAKE EFFECTIVE HALT
	DPB	%10,[POINT 8,OPCODE,35]
	RETURN

POPCL5:	CALL	REGEXP
	DPB	%10,[POINT 3,OPCODE,35-6]
	JRST	POP2ND

POPCL6:	CALL	EXPR		;EVALUATE THE EXPRESSION
	 JFCL			;  NULL, TREAT AS ZERO
	CALL	TSTARB		;TEST ARITHMETIC BYTE
	DPB	%01,[POINT 8,OPCODE,35]	;STUFF INTO BASIC
	RETURN
POPCL9:				;OLD ASH/ASHC MODES

POPCL7:	CALL	AEXP
	DPB	%00,[POINT 6,OPCODE,35]
	CALL	TSTCOM
	CALL	REGEXP
	DPB	%10,[POINT 3,OPCODE,35-6]
	RETURN

POPCL8:	CALL	REGEXP
	DPB	%10,[POINT 3,OPCODE,35-6]
	CALL	TSTCOM
	CALL	RELADR		;EVALUATE RELATIVE ADDRESS
	TRNE	%10,177700	;INBOUNDS?
	ERRSET	ERR.A		;  NO, FLAG ERROR
	TRNE	%15,ERR.A	;ANY ERRORS?
	MOVEI	%10,1		;  YES, BRANCH TO SELF
	DPB	%10,[POINT 6,OPCODE,35]
	RETURN

POPC10:	CALL	ABSEXP
	TRNE	%10,177700
	ERRSET	ERR.T
	DPB	%10,[POINT 6,OPCODE,35]
	RETURN

RELADR:				;RELATIVE ADDRESS EVALUATOR
	CALL	EXPR
	 ERRSET	ERR.A		;  NULL, ERROR
	SETZB	%04,RELLVL
	CALL	EXPRPX
	MOVE	%01,%05
	ADDI	%01,2
	CALL	EXPRMI
	 ERRSET	ERR.A
	CALL	ABSTST
	TRNE	%10,1		;EVEN?
	ERRSET	ERR.A		;  NO, FLAG ERROR
	LSH	%10,-1		;/2
	RETURN
POPC11:	CAIE	%14,"#"
	JRST	POPC1B
	SPUSH	%13
	CALL	GETNB
	MOVEI	%03,1
	MOVEM	%03,FLTLEN	;SET LENGTH FOR ROUNDING
	CALL	FLTG
	SPOP	%00
	TLNE	%15,FLTFLG
	JRST	POPC1A
	HRRZ	%10,FLTNUM
	TLO	%10,BC2
	AOS	%02,OFFSET
	MOVEM	%10,ADREXT-1(%02)
	MOVEI	%00,27
	JRST	POPC1C

POPC1A:	MOVE	%13,%00
	SETCHR
POPC14:				;NEW CLASS 14
POPC1B:	CALL	AEXP
POPC1C:	DPB	%00,[POINT 6,OPCODE,35]
	CALL	TSTCOM
	CALL	REGEXP
	TRNE	%10,177774
	ERRSET	ERR.A
	DPB	%10,[POINT 2,OPCODE,35-6]
	RETURN

POPC12:	CALL	REGEXP
	TRNE	%10,177774
	ERRSET	ERR.A
	DPB	%10,[POINT 2,OPCODE,35-6]
	JRST	POP2ND

POPC13:	CALL	ABSEXP
	TRNE	%10,177770
	ERRSET	ERR.A
	DPB	%10,[POINT 3,OPCODE,35]
	RETURN

TSTCOM:
	TLNN	%15,DS2FLG
	TLZA	%15,DSTFLG
	TLO	%15,DSTFLG
	CAIN	%14,","
	JRST	GETNB
	ERRSET	ERR.A
	POP	%17,0(%17)
	RETURN
	SUBTTL	DIRECTIVES

.ABS:	MOVEI	%03,ED.ABS
	TDNE	%03,EDMSK	;MASKED OUT?
	RETURN			;  YES
	TRO	%12,0(%03)	;NO, SET IT
	HRRM	%12,EDFLGS
	TLZ	%05,(PFMASK)	;CLEAR RELOCATION
	RETURN

	IFDEF	XREL,
<
.ASECT=	OPCERR
.CSECT=	OPCERR
.GLOBL=	OPCERR
.LOCAL=	OPCERR
.LIMIT=	OPCERR
>

	IFNDEF	XREL
<
.ASECT:	HRRZS	0(%17)		;NOT LOCAL
	MOVE	%00,.ABS.	;FUDGE FOR ABS
	JRST	CSECTF		;BRANCH AROUND TEST

.PSECT:	SETOM	PSCTSW		;SIGNAL PSECT PROCESSING

.CSECT:	TDZA	%03,%03
.LOCAL:	MOVSI	%03,1
	HLLM	%03,0(%17)	;FLAG LOCAL
	SKPEDR	ED.ABS		;ABS MODE?
	 JRST	OPCERR		; YES, ERROR
	CALL	GETSYM		;TRY FOR A SYMBOL
CSECTF:	CALL	TSTMAX		;TEST MAX PC
	MOVSI	%10,-^D256	;INIT FOR SEARCH
CSECT2:	CAMN	%00,SECNAM(%10)	;MATCH?
	JRST	CSECT3		;  YES
	TRNE	%10,-2		;IF POINTING AT ONE
	SKIPE	SECNAM(%10)	;OR SLOT IS FULL,
	AOBJN	%10,CSECT2	;LOOP
	JUMPL	%10,CSECT3	;BRANCH IF GOOD
	ERRSET	ERR.A		;END, ERROR
	RETURN
CSECT3:	SKIPN	PSCTSW		;PROCESSING PSECT?
	JRST	CSECT4		;NO. BR AROUND PROCESSING.
	SETZM	PSCTSW		;CLEAR THE SWITCH.
;	PSECT PROCESSING
	SPUSH	%00		;SAVE THE SECTION NAME
				;USE AC2 & AC6 FOR SCRATCH
	SKIPE	%02,PSCFLG(%10)	;HAS THIS PSECT BEEN PROCESSED ALREADY?
	JRST	PSECT1		;YES.
	HRROI	%02,2410!LOW!CON!RW!REL!LCL!I ;ASSUME NAMED PSECT
	SKIPN	%10		;ASECT?
	HRROI	%02,2410!LOW!OVR!RW!ABS!GBL!I ;YES

PSECT1:	SPUSH	%02		;SAVE THE REGISTER
				;DON'T SAVE AC6 SINCE IT GETS SET AFRESH
				;AFTER THESE CALLS.
	CALL	SETNB		;PICK UP THE CURRENT CHAR IN AC14
	SKIPN	%14		;IS THIS THE END OF THE LINE?
	JRST	PSECT5		;YES.
	CAIN	%14,";"		;IS THIS THE BEGINNING OF A COMMENT?
	JRST	PSECT5		;YES.
	CAIE	%14,","		;IS IT A COMMA?
	JRST	PSECT4		;NO. TERMINATE PROCESSING
	CALL	GETNB		;SPACE AROUND THE COMMA, AND
	CALL	GSARG		;GO GET A SYMBOLIC ATTRIBUTE
	JRST	PSECT4		;ERROR OUT IF THERE AIN'T NOTHIN' 
				;AFTER THE COMMA
	SPOP	%02		;RETRIEVE THE REGISTER
	MOVEI	%06,ATRARG	;GET ADDRESS OF TABLE

PSECT2:	CAMN	%00,@%06	;COMPARE ARG TO TBL ENTRY.SAME?
	JRST	PSECT3		;YES...GO AND PROCESS IT.
	ADDI	%06,2		;INCREMENT THE POINTER
	CAIE	%06,ATREND	;TABLE EXHAUSTED?
	JRST	PSECT2		;NO.
	CAIA			;YES.

PSECT4:	SPOP	%02		;RESTORE AC2
	SPOP	%00		;AND AC0
	ERRSET	ERR.A		;FLAG THE STATEMENT,
	RETURN			;AND IGNORE THE WHOLE PSECT

PSECT3:	AOS	%06		;INCREMENT THE POINTER TO THE BIT SETTING
	HRRZ	%00,@%06	;GET BIT POSITION INDR
	SKIPL	@%06		;SHLD THE BIT BE SET TO ONE?
	TDZA	%02,%00		;NO. CLEAR THE BIT.
	TDO	%02,%00		;YES. SET IT.
	JRST	PSECT1		;GO BACK FOR MORE.
PSECT5:	SPOP	%02		;RETRIEVE THE REGISTER
	MOVEM	%02,PSCFLG(%10)	;SAVE THE ATTRIBUTE FLAGS
	SPOP	%00		;RECOVER THE SECTION NAME...
				;...AND FALL INTO CSECT PROCESSING

CSECT4:	MOVEM	%00,SECNAM(%10)	;SAVE NAME
	MOVE	%01,%05		;GET CURRENT PC
	LDB	%02,SUBPNT	;CURRENT RELOCATION
	HRRM	%01,SECBAS(%02)	;STORE CURRENT
	HRRZ	%05,SECBAS(%10)	;GET NEW ONE
	DPB	%10,CCSPNT	;MAKE SURE RELOCATION IS SET
	HRRZ	%03,%10
	IDIVI	%03,^D36
	MOVNS	%04
	HLRZ	%01,0(%17)	;GET LOCAL FLAG
	ROT	%01,-1(%04)	;MOVE INTO POSITION
	IORM	%01,SECLCF(%03)	;MERGE BIT
	MOVE	%01,%05

	AOS	%02,GLBPNT
	MOVEM	%00,GLBBUF(%02)	;STORE NAME
	ANDI	%01,177777
	DPB	%02,SUBPNT	;STORE POINTER
	MOVEI	%03,RLDT7
	DPB	%03,MODPNT	;SET CLASS 7
	CALL	STCODE
	MOVE	%10,%05
	CALL	LSBTST
	JRST	SETPF1
>

TSTMAX:	LDB	%03,CCSPNT	;GET CURRENT SEC
	HLRZ	%04,SECBAS(%03)	;MAX FOR THIS ONE
	CAIGE	%04,0(%05)	;NEW MAX?
	HRLM	%05,SECBAS(%03)	;  YES
	RETURN
	.LOC
SECNAM:	BLOCK	^D256		;SECTOR NAMES
SECBAS:	BLOCK	^D256		;SECTOR BASES
SECLCF:	BLOCK	^D<256/36>+1	;SECTOR LOCAL FLAGS
SECLCP:	BLOCK	1		;SECTOR LOCAL POINTER
PSCFLG:	BLOCK	^D256		;PSECT ATTRIBUTE FLAGS
;THOSE SLOTS WHICH CORRESPOND TO PSECTS HAVE ALL ONES IN THE LH
;OF THE WORD
PSCTSW:	BLOCK	1		;SET TO ONES DURING PSECT PROCESSING
	.RELOC

	DEFINE	ATARG	(C1,C2,C3,BIT,SET)
<
	XLIST
C1'C2'C3=SET'B<35-BIT>
	GENM40	C1,C2,C3,,,
	EXP	SET'B0!1B<35-BIT>
	LIST
>

ATRARG:				;ATTRIBUTE ARGUMENT TABLE
	ATARG	H,G,H,0,1
	ATARG	L,O,W,0,0
	ATARG	C,O,N,2,0
	ATARG	O,V,R,2,1
	ATARG	R,W,,4,0
	ATARG	R,O,,4,1
	ATARG	A,B,S,5,0
	ATARG	R,E,L,5,1
	ATARG	L,C,L,6,0
	ATARG	G,B,L,6,1
	ATARG	I,,,7,0
	ATARG	D,,,7,1
ATREND:				;END OF TABLE
	IFNDEF	XREL
<
.GLOBL:				;.GLOBL PSEUDO-OP
	SKPEDR	ED.ABS
	 JRST	OPCERR
.GLOB1:	CALL	GSARG		;GET AN ARGUMENT
	 JRST	.GLOB2		;BRANCH IF NULL
	CAMN	%00,M40DOT	;MESSING WITH PC?
	JRST	.GLOB2		;  YES, ERROR
	CALL	SSRCH		;OK, SEARCH TABLE
	 JFCL
	TLZ	%01,FLTSYM	;CLEAR DEFAULTED GLOBAL SYMBOL FLAG
	TLNE	%01,REGSYM	;REGISTER SYMBOL?
	TLOA	%01,MDFSYM	;  YES, ERROR
	TLOA	%01,GLBSYM	;NO, FLAG GLOBAL
	ERRSET	ERR.R		;  YES, FLAG REGISTER ERROR
	CALL	INSRT		;INSERT IN TABLE
	CALL	CRFDEF
	JRST	.GLOB1		;TRY FOR MORE

.GLOB2:	SKIPN	ARGCNT		;ANY ARGUMENTS PROCESSED?
	ERRSET	ERR.A		;  NO
	RETURN
>

TSTEVN:				;TEST FOR EVEN
	TRNN	%05,1		;ARE WE EVEN?
	RETURN			;  YES, JUST EXIT
	ERRSET	ERR.B		;NO, FLAG ERROR AND EVEN THINGS UP
	SPUSH	%01
	CALL	.EVEN
	SPOP	%01
	RETURN

	IFNDEF	XREL
<
.LIMIT:				; ".LIMIT" PSEUDO-OP
	SKPEDR	ED.ABS		;ABS MODE?
	 POPJ	%17,		;  YES, IGNORE IT
	CALL	TSTEVN		;NO, MAKE SURE WE'RE EVEN
	MOVSI	%01,BC2(<RLDT11>B<MODOFF>)
	CALL	STCODE
	MOVSI	%01,BC2
	JRST	STCODE		;GENERATE TWO WORDS
>
.ODD:				;  ".ODD" DIRECTIVE
	TRNE	%05,1
	RETURN
	JRST	.EVENX

.EVEN:	TRNN	%05,1
	RETURN
.EVENX:	MOVEI	%10,1
	JRST	.DEPHX

.PHASE:
	CALL	RELEXP
	MOVE	%03,%05
	TRO	%03,600000
	SUB	%03,%10
	TLNE	%03,(PFMASK)
	ERRXIT	ERR.A!ERR.P1
	ANDI	%03,177777
	MOVEM	%03,PHAOFF
.PHASX:	TRZ	%10,600000
	SPUSH	M40DOT
	JRST	ASGMTF

.DEPHA:	SETZM	%10
	EXCH	%10,PHAOFF
.DEPHX:	ADD	%10,%05
	JRST	.PHASX

	.LOC
PHAOFF:	BLOCK	1
	.RELOC

.BLKB:	TDZA	%03,%03
.BLKW:	SETOM	%03
	HLLM	%03,0(%17)
	CALL	SETPF0		;LIST LOCATION
	CALL	EXPR
	 MOVEI	%10,1
	CALL	ABSTST
	CALL	SETPF1
	SKIPGE	0(%17)
	ASH	%10,1
	ADD	%10,%05
	TRZ	%10,600000
	SPUSH	M40DOT
	JRST	ASGMTX
.EQUIV:				;.EQUIV DEFSYM,ANYSYM
	CALL	GSARG		;GET SYMBOLIC ARG
	 JRST	OPCERR		;  ERROR
	MOVEM	%00,.EQUI9	;OK, SAVE IT
	CALL	GSARG		;GET SECOND ARG
	 JRST	OPCERR		;  MISSING
	EXCH	%00,.EQUI9	;GET FIRST MNEMONIC
	CALL	OSRCH		;TEST FOR MACRO/OP CODE
	 JRST	.EQUI1		;  NO
	CALL	CRFOPR
	JRST	.EQUI2

.EQUI1:	CALL	SSRCH		;NO, TRY USER SYMBOL
	 JRST	OPCERR		;  MISSING
	CALL	CRFREF
.EQUI2:	CAIN	%02,MAOP	;FOUND, MACRO?
	CALL	INCMAC		;YES, INCREMENT USE LEVEL
	MOVE	%00,.EQUI9	;GET SECOND MNEMONIC
	MOVEM	%01,.EQUI9	;SAVE VALUE
	CAIE	%02,0		;USER SYMBOL?
	MOVEI	%02,1		;NO  NO, TREAT AS OP
	SPUSH	%02
	CALL	@[EXP SSRCH,MSRCH](%02)	;CALL PROPER SEARCH
	 JFCL
	CAIN	%02,MAOP	;MACRO?
	TRNE	%02,-1
	CAIA
	CALL	DECMAC		;  YES, DECREMENT REFERENCE
	MOVE	%01,.EQUI9	;GET NEW VALUE
	SPOP	%02
	CALL	@[EXP CRFDEF,CRFOPD](%02)
	JRST	INSRT		;INSERT AND EXIT

	.LOC
.EQUI9:	BLOCK	1
	.RELOC

.PDP10:	RETURN			;NO-OP, FOR COMPATIBILITY W/ MACX11
.TITLE:				;TITLE PSEUDO-OP
	SPUSH	SYMEND		;SAVE START
	CALL	GETSYM		;GET THE SYMBOL
	SPOP	%13
	SKIPN	%00		;ONE FOUND?
	ERRXIT	ERR.A		;  NO, FLAG ERROR AND EXIT
	MOVEM	%00,PRGTTL	;YES, STORE TITLE
	MOVEI	%01,TTLBUF	;POINT TO TITLE BUFFER
	JRST	.SBTT1		;EXIT THROUGH SUB-TITLE

.SBTTL:				;SUB-TITLE PROCESSOR
	MOVE	%13,SYMEND
	TLNN	%15,P1F		;PASS ONE?
	JRST	.SBTT3		;  NO
	MOVEM	%13,CLIPNT	;YES, FUDGE FOR TABLE OF CONTENTS
	SKPLCS	LC.TOC
	 TLO	%16,P1LBIT
	TLO	%15,NQEFLG!LHMFLG
	RETURN	

.SBTT3:	MOVEI	%01,STLBUF	;POINT TO PROPER BUFFER
.SBTT1:	HRLI	%01,(POINT 7,)	;COMPLETE BYTE POINTER
	MOVEI	%02,TTLLEN	;SET COUNT
.SBTT2:	GETCHR			;GET THE NEXT CHARACTER
	SOSL	%02
	IDPB	%14,%01		;STORE IN BUFFER
	JUMPN	%14,.SBTT2
	IDPB	%14,%01		;BE SURE TO STORE TERMINATOR
	RETURN

.IDENT:				; ".IDENT"
	SPUSH	%05		;SAVE PC
	SETZM	%05		;NO EVEN TEST
	CALL	.RAD50		;PROCESS AS RAD50
	SETZM	CODPNT		;SET FOR SCAN
	CALL	FETCOD		;FETCH NEXT ENTRY
	 JFCL
	HRLZM	%01,PRGIDN
	CALL	FETCOD
	 JFCL
	HRRM	%01,PRGIDN
	SPUSH	%04		;CLEAR A REGISTER
	MOVEI	%05,1		;THE FOLLOWING CODE CLEARS POSSIBLE TRASH IN THE CODE BUFFER
.IDNT1:	AOS	%05		;INCREMENT POINTER INTO BUFFER
	SKIPE	%04,CODBUF(%05)	;WORD CLEAR?
	SETZM	CODBUF(%05)	;CLEAR IT
	JUMPN	%04,.IDNT1	;BACK IF IT WASN'T CLEAR
	SPOP	%04		;IF IT WAS, SET UP FOR A RETURN....
	SPOP	%05		;....
	RETURN		;..AND DO IT

	.LOC
TTLBUF:	BLOCK	<TTLLEN+4>/5+1	;TITLE BUFFER
STLBUF:	BLOCK	<TTLLEN+4>/5+1	;SUB-TITLE BUFFER
PRGTTL:	BLOCK	1		;PROGRAM TITLE
PRGIDN:	BLOCK	1		;PROGRAM IDENT
	.RELOC
.REM:				;REMARK
	JUMPE	%14,OPCERR	;ERROR IF EOL
	SPUSH	%14
.REM1:	GETCHR
.REM2:	CAMN	%14,0(%17)
	JRST	.REM3
	JUMPN	%14,.REM1
	CALL	ENDL
	TLNE	%15,ENDFLG
	JRST	.REM4
	CALL	GETLIN
	SKPLCS	LC.TTM
	TLO	%15,LHMFLG	;LEFT JUSTIFY IF IN TTM MODE
	JRST	.REM2

.REM3:	CALL	GETNB
.REM4:	SPOP	0(%17)
	RETURN

.ERROR:	TLNE	%15,P1F		;  ".ERROR", PASS ONE?
	RETURN			;  YES, IGNORE
	AOS	ERRCNT
.PRINT:				;  ".PRINT" DIRECTIVE
	TLO	%16,ERRBIT	;FORCE TTY LISTING
	CALL	SETPF0
	CALL	EXPR		;ANY EXPRESSION?
	 RETURN			;  NO
	JRST	SETPF1

.EOT:
	RETURN
.ROUND:	TDZA	%03,%03
.TRUNC:	MOVEI	%03,1
	MOVEI	%01,ED.FPT
	TDNN	%01,EDMSK
	XCT	[EXP <TRZ %12,0(%01)> , <TRO %12,0(%01)>](%03)
	HRRM	%12,EDFLGS
	RETURN

.RADIX:	MOVEI	%03,^D10
	EXCH	%03,CRADIX
	SPUSH	%03
	CALL	ABSEXP
	CAIL	%10,^D2
	CAILE	%10,^D10
	ERRSKP	ERR.N
	MOVEM	%10,0(%17)
	POP	%17,CRADIX
	RETURN

	.LOC
CRADIX:	BLOCK	1		;CURRENT RADIX
	.RELOC
.END:				;"END" PSEUDO-OP
	SKIPE	CNDLVL		;IF IN CONDITIONAL
	ERRSET	ERR.E		;  FLAG ERROR
	TLO	%15,ENDFLG	;FLAG "END SEEN"
	CALL	EXPR		;EVALUATE THE ADDRESS
END2:	 MOVEI	%10,1		;  NULL, FORCE ODD VECTOR
	MOVEM	%10,ENDVEC
	TRNE	%15,ERR.U	;ANY UNDEFINED SYMBOLS?
	ERRSET	ERR.P1		;  YES, PASS ONE ERROR
	JRST	SETPF1

	.LOC
ENDVEC:	BLOCK	1		;END VECTOR
	.RELOC
	SUBTTL	DATA-GENERATING DIRECTIVES

.ASCII:	TLZA	%15,ASZFLG	;  ".ASCII" DIRECTIVE
.ASCIZ:	TLO	%15,ASZFLG	;  ".ASCIZ" DIRECTIVE
	SPUSH	%05		;STACK LOCATION COUNTER
.ASCI1:	SETZM	%01		;CLEAR AC
.ASCI2:	CALL	GTCHR		;GET A TEXT CHARACTER
	JRST	.ASCI6		;  NO
	TRZE	%10,177400	;OVERFLOW?
	ERRSET	ERR.T		;  YES
.ASCI3:	JUMPN	%01,.ASCI4	;BRANCH IF SECOND BYTE OF WORD
	DPB	%10,[POINT 8,%01,35]	;HIGH ORDER, STORE
	HRLI	%01,BC1		;FLAG AS SINGLE BYTE
	TRNN	%05,1		;ODD LOCATION?
	AOJA	%05,.ASCI2	;  NO, GET ANOTHER ARG
	JRST	.ASCI5		;YES, DUMP IT OUT

.ASCI4:	DPB	%10,[POINT 8,%01,35-8]	;STORE ODD BYTE
	HRLI	%01,BC2		;FLAG AS DOUBLE
.ASCI5:	CALL	STCODE		;STORE IT
	AOJA	%05,.ASCI1	;TRY FOR MORE

.ASCI6:	MOVEI	%10,0
	TLZE	%15,ASZFLG	;ASCIZ MODE?
	JRST	.ASCI3		;  YES
	SKIPE	%01		;NO, ANY CODE ACCUMULATED?
	CALL	STCODE		;  YES, DUMP IT
	JRST	.WORDX		;RESTORE PC AND EXIT
.RAD50:				;  ".RAD50" DIRECTIVE
	CALL	TSTEVN		;BE SURE ITS AN EVEN LOCATION
	SPUSH	%05		;STACK PC
.RAD51:	SETZM	%00		;CLEAR AC
	MOVSI	%01,(POINT 6,%00)	;SET POINTER
.RAD52:	CALL	GTCHR		;GET A TEXT ARGUMENT
	 JRST	.RAD54		;  FINISHED
	TRZE	%10,177600	;OVERFLOW?
	ERRSET	ERR.T		;  YES
	CAIL	%10,"A"+40
	CAILE	%10,"Z"+40
	CAIA
	SUBI	%10,40
	EXCH	%14,%10
	LDB	%02,ANPNTR	;MAP
	EXCH	%14,%10
	SUBI	%10,40		;CONVERT TO SIXBIT
	JUMPE	%10,.RAD53	;ACCEPT BLANKS
	CAIN	%02,0		;SKIP IF ALPHA/NUMERIC
	ERRSKP	ERR.A		;ELSE ERROR
.RAD53:	IDPB	%10,%01		;STORE CHARACTER
	CAME	%01,[POINT 6,%00,17]	;3 CHARS ACCUMULATED?
	JRST	.RAD52		;  NO
	CALL	.RAD55		;YES, STORE THIS WORD
	JRST	.RAD51		;LOOP

.RAD54:	CAME	%05,0(%17)	;STORE ZERO IF EMPTY
	TLNN	%01,(1B0)	;YES, CURRENT WORD EMPTY?
	CALL	.RAD55		;  NO, DUMP IT
	JRST	.WORDX		;RESTORE PC AND EXIT

.RAD55:	CALL	SIXM40		;CONVERT TO RAD50
	HLRZ	%01,%00		;ARG TO AC
	HRLI	%01,BC2		;FLAG AS WORD
	CALL	STCODE		;STORE IT
	ADDI	%05,2		;UPDATE PC
	RETURN
.BYTE:				;"BYT" PSEUDO-OP
	SPUSH	%05		;STACK PC
.BYTE1:	CALL	EXPR		;EVALUATE EXPRESSION
	 JFCL			;  ACCEPT NULLS
	TRNE	%10,177400	;ANY HIGH ORDER BITS SET?
	TRC	%10,177400	;  YES, TOGGLE FOR TEST
	CALL	TSTARB		;TEST ARITHMETIC BYTE
	TLC	%01,BC1!BC2	;RESET TO ONE BYTE
	CALL	STCODE
	HRROS	ARGCNT
	CALL	TGARG		;ANY MORE?
	 JRST	.WORDX		;  NO
	AOJA	%05,.BYTE1	;INCREMENT PC AND LOOP


.WORD:				;"WORD" PSEUDO-OP
	CALL	TSTEVN
	SPUSH	%05		;STACK PC
.WORD1:	CALL	EXPR		;EVALUATE EXPRESSION
	 JFCL			;  ACCEPT NULLS
	CALL	TSTAR
	CALL	STCODE
	HRROS	ARGCNT
	CALL	TGARG		;END OF STRING?
	 JRST	.WORDX		;  YES, EXIT
	ADDI	%05,2		;INCREMENT PC
	JRST	.WORD1		;GO FOR MORE

.WORDX:	SPOP	%05		;RESTORE ORIGIONAL PC
	RETURN
.FLT2:	SKIPA	%03,[2]		;TWO WORD FLOATING
.FLT4:	MOVEI	%03,4		;FOUR WORD FLOATING
	MOVEM	%03,FLTLEN	;SET LENGTH FOR ROUNDING
.FLT2A:	CALL	FLTG		;PROCESS FLOATING POINT
	TLNE	%15,FLTFLG	;ANY ERRORS?
	ERRSET	ERR.A		;  YES
	MOVN	%06,FLTLEN	;SET NEGATIVE OF LENGTH
	HRLZS	%06		;SET INDEX
.FLT2B:	MOVE	%01,FLTNUM(%06)	;GET A VALUE
	HRLI	%01,BC2
	CALL	STCODE		;STORE IT
	AOBJN	%06,.FLT2B	;LOOP IF MORE
	HRROS	ARGCNT
	CALL	TGARG		;MORE?
	 RETURN			;  NO
	JRST	.FLT2A		;GET ANOTHER
	SUBTTL	"A" EXPRESSION EVALUATOR

AEXP:				;"A" EXPRESSION EVALUATOR
	CALL	AEXP0A
	LDB	%03,[POINT 3,%00,35-3]	;GET MODE
	MOVE	%04,[DEC 0,14,14,26,14,26,26,38](%03)
	RETURN

AEXP0A:	PUSH	%17,[0]		;STACK INITIAL VALUE
AEXP01:	CAIN	%14,"#"
	JRST	AEXP02
	CAIN	%14,"%"
	JRST	AEXP04
	CAIN	%14,"("
	JRST	AEXP06
	CAIN	%14,"-"
	JRST	AEXP07
	CAIN	%14,"@"
	JRST	AEXP08
	JRST	AEXP10		;NO UNARIES, PROCESS BASIC EXPRESSION

AEXP02:				; #
	CALL	GETNB		;BYPASS UNARY OP
	CALL	EXPR		;EVALUATE EXPRESSION
	 ERRSET	ERR.Q		;  NULL, ERROR
AEXP03:	CALL	TSTAR		;TEST ARITHMETIC
	SPOP	%00		;RETRIEVE PRESET VALUE
	TRO	%00,27		;SET BITS
	AOS	%02,OFFSET	;GET OFFSET
	MOVEM	%01,ADREXT-1(%02)	;STORE ADDRESS
	RETURN			;EXIT

AEXP04:				; %
	CALL	REGEXP		;EVALUATE REG EXPRESSION
	SPOP	%00		;RETRIEVE CODE
AEXP05:	TRZE	%10,-10		;ANY OVERFLOW?
	ERRSKP	ERR.R		;  YES, FLAG ERROR AND SKIP
	TRO	%00,00(%10)	;SET BITS
	RETURN			;EXIT

AEXP06:				; (
	CALL	AEXP20		;EVALUATE PARENTHESES
	SETZ	%01,		;ZERO IN CASE OF INDEX
	CAIE	%14,"+"		;FINAL "+" SEEN?
	JRST	AEXP13		;  NO, GO SEE IF (R) OR @(R)?
	SPOP	%00		;YES, RETRIEVE CODE
	TRO	%00,20(%10)	;SET BITS
	JRST	GETNB		;BYPASS DELIMITER AND EXIT

AEXP13:	SPOP	%00	;GET CODE
	TRON	%00,10	;IS "@" SET?
	JRST	AEXP05	;NO-REGISTER MODE
	SPUSH	%00	;YES-INDEX MODE
	JRST	AEXP12
AEXP07:				; -(
	MOVEM	%13,SYMBEG	;SAVE POINTER IN CASE OF FAILURE
	CALL	GETNB		;GET THE NEXT NON-BLANK
	CAIE	%14,"("		;PARENTHESIS?
	JRST	AEXP09		;  NO, TREAT AS EXPRESSION
	CALL	AEXP20		;YES, EVALUATE
	SPOP	%00		;RETRIEVE CODE
	TRO	%00,40(%10)	;SET BITS
	RETURN			;EXIT

AEXP08:				; @
	SPOP	%00		;RETRIEVE BASIC CODE
	TROE	%00,10		;SET INDIRECT BIT, WAS IT BEFORE?
	ERRSET	ERR.Q		;  YES, FLAG ERROR
	SPUSH	%00		;RE-STACK CODE
	CALL	GETNB		;BYPASS CHARACTER
	JRST	AEXP01		;GO BACK TO BEGINNING

AEXP09:				; -( FAILURE
	MOVE	%13,SYMBEG	;GET POINTER TO "-"
	CALL	SETNB		;RESTORE CHARACTER
AEXP10:				; NO UNARIES
	CALL	EXPR		;EVALUATE EXPRESSION
	 ERRSET	ERR.Q		;  NULL, ERROR
	CAIN	%14,"("		;ANOTHER EXPRESSION?
	JRST	AEXP11		;  YES, BRANCH
	SPOP	%00		;RETRIEVE CODE
	TLNE	%10,REGSYM	;REGISTER EXPRESSION?
	JRST	AEXP05		;  YES, TREAT AS %
	MOVE	%01,%10		;GET VALUE
	LDB	%02,SUBPNT	;  RELOCATION
	LDB	%04,CCSPNT	;  CURRENT SECTOR
	SKIPN	%00		;ANY INDIRECTION?
	SKPEDS	ED.AMA!ED.PIC	;  NO, ABSOLUTE MODE REQUESTED?
	 JRST	AEXP1R		;  NO, PROCESS RELATIVE
	SKPEDS	ED.PIC		;PIC?
	 JRST	AEXP1Q		;  NO, JUST AMA
	TLNN	%10,GLBSYM	;YES, IF GLOBAL
	CAME	%02,%04		;  OR OTHER SECTOR,
	 CAIA			;  TREAT AS AMA
	JRST	AEXP1R		;ELSE RELATIVE
AEXP1Q:	TRO	%00,10		;SET INDIRECT BIT
	SPUSH	%00
	JRST	AEXP03		;FINISH WITH 37
AEXP1R:	TRO	%00,67		;SET BITS FOR INDEXED BY PC.
	HRLI	%01,BC2		;TWO DATA BYTES
	MOVEI	%03,RLDT6	;ASSUME EXTERNAL
	TLNE	%10,GLBSYM
	JRST	AEXP1B		;  TRUE, OK AS IS
	CAME	%02,%04		;SAME SEG?
	JRST	AEXP1A		;  NO, FURTHER TESTING REQUIRED
	SUBI	%10,4(%05)	;YES, COMPUTE OFFSET
	SKIPE	OFFSET		;THIRD WORD?
	SUBI	%10,2		;  YES, TWO MORE FOR GOOD MEASURE
	DPB	%10,[POINT 16,%01,35]	;STORE RESULT
	JRST	AEXP1D		;BRANCH TO EXIT

AEXP1A:	MOVEI	%03,RLDT3	;OK FOR QUICKIE?
	JUMPE	%02,AEXP1C	;  YES, IF TO ABS SEG
	MOVE	%04,SECNAM(%02)
	AOS	%02,GLBPNT
	MOVEM	%04,GLBBUF(%02)	;STORE IN GLOBAL TEMP
	MOVEI	%03,RLDT16	;TYPE #16
AEXP1B:	DPB	%02,SUBPNT	;STORE GLOBAL BUFFER POINTER
AEXP1C:	SKPEDR	ED.PIC		;PIC ENABLED?
	 ERRSET	ERR.R		;  YES, NO REL TO OTHER SECTOR
	DPB	%03,MODPNT	;STORE MODE
AEXP1D:	AOS	%02,OFFSET
	MOVEM	%01,ADREXT-1(%02)
	RETURN


AEXP11:				; E1(E2)
	TLNE	%10,REGSYM	;REGISTER EXPRESSION?
	ERRSET	ERR.R		;  YES, ERROR
	SPUSH	%10		;STACK E1
	CALL	AEXP20		;PROCESS EXPRESSION
	SPOP	%01		;RETRIEVE E1
AEXP12:	DPB	%10,[POINT 3,0(%17),35]	;STORE REG
	MOVE	%10,%01
	CALL	TSTAR		;TEST MODE
	AOS	%02,OFFSET
	MOVEM	%01,ADREXT-1(%02)	;STORE ADDRESS
	SPOP	%00		;RETRIEVE CODE BITS
	TRO	%00,60		;COMPLETE CODE
	RETURN			;EXIT

AEXP20:				;()
	CALL	GETNB		;BYPASS PAREN
	CALL	REGEXP		;EVALUATE REGISTER EXPRESSION
	CAIE	%14,")"		;PROPER DELIMITER
	ERRSKP	ERR.Q		;  NO, FLAG ERROR AND SKIP
	CALL	GETNB		;  YES, BYPASS CHARACTER
	JRST	SETNB		;RETURN WITH NON-BLANK DELIMITER
TSTARB:				;TEST ARITHMETIC BYTE
	CALL	TSTAR		;TEST ARITHMETIC
	TRZE	%01,177400	;OVERFLOW?
	ERRSET	ERR.A		;  YES
	LDB	%02,MODPNT	;FETCH CLASS
	CAIE	%02,RLDT1	;IF ONE
	CAIN	%02,RLDT15	;  OR FIFTEEN,
	ERRSET	ERR.A		;RELOCATION ERROR
	SKIPE	%02		;ABSOLUTE?
	TRO	%02,200		;  NO, MAKE BIT MODIFICATION
	DPB	%02,MODPNT
	RETURN


TSTAR:				;TEST ADDITIVE RELOCATION  (0,1,5,15)
	MOVE	%01,%10		;COPY TO FINAL AC
	LDB	%02,SUBPNT	;GET RELOCATION
	HRLI	%01,BC2		;SET FOR TWO BYTES
	JUMPE	%02,CPOPJ	;EXIT IF ABS
	MOVEI	%03,RLDT5	;ASSUME EXTERNAL
	TLNE	%10,GLBSYM	;GLOBAL?
	JRST	TSTAR1		;  YES
	MOVEI	%03,RLDT1
	LDB	%04,CCSPNT
	CAMN	%02,%04		;CURRENT SECTOR?
	JRST	TSTAR3		;  YES
	MOVE	%04,SECNAM(%02)
	AOS	%02,GLBPNT
	MOVEM	%04,GLBBUF(%02)	;STORE SECTOR NAME
	MOVEI	%03,RLDT15	;TYPE 15
TSTAR1:	DPB	%02,SUBPNT
TSTAR2:	DPB	%03,MODPNT
	RETURN

TSTAR3:	SKPEDR	ED.PIC		;PIC ENABLED?
	 ERRSET	ERR.R		;  YES, NO DIRECT REFS TO CURRENT
	JRST	TSTAR2

	.LOC
GLBPNT:	BLOCK	1
GLBBUF:	BLOCK	40
	.RELOC
	SUBTTL	EXPRESSION EVALUATOR

REGEXP:				;REGISTER EXPRESSION
	CALL	EXPR
	 ERRSET	ERR.A		;  NULL, ERROR
REGTST:	TDZE	%10,[<GLBSYM>B17!377B<SUBOFF>!177770]
	ERRSET	ERR.R		;  ERROR
	RETURN

ABSEXP:				;ABSOLUTE EXPRESSION
	CALL	EXPR
	 ERRSET	ERR.A
ABSTST:	TLZE	%10,(<GLBSYM>B17!377B<SUBOFF>)
	ERRSET	ERR.A		;ERROR IF GLOBAL OR RELOCATABLE
	ANDI	%10,177777
	RETURN

RELEXP:				;RELOCATABLE EXPRESSION
	CALL	EXPR
	 ERRSET	ERR.A
RELTST:	TLNE	%10,GLBSYM	;NO GLOBALS ALLOWED
	JRST	ABSTST		;LET ABS FLAG IT
	RETURN
EXPR:				;EXPRESSION PROCESSOR, REGISTER ALLOWED

	CALL	TERM		;GET THE FIRST TERM
	 POPJ	%17,		;  NULL, EXIT
	SETZB	%04,RELLVL	;CLEAR RELOCATION LEVEL COPNT
	CALL	EXPRPX		;SET, IF NECESSARY
EXPR1:	LDB	%03,C4PNTR	;MAP CHARACTER USING COLUMN 4
	JUMPE	%03,EXPR3	;BRANCH IF NULL
	SPUSH	EXPRJT(%03)	;STACK ENTRY
	SPUSH	%10		;STACK CURRENT VALUE
	CALL	GETNB		;BYPASS OP
	CALL	TERM		;GET THE NEXT EXPRESSION TERM
	 ERRSET	ERR.Q		;  NULL, FLAG ERROR
	SPOP	%01		;GET PREVIOUS VALUE
	SPOP	%02
	CALL	0(%02)	;CALL ROUTINE
	 ERRSET	ERR.A		;  ERROR
	TRZ	%10,600000	;CLEAR ANY OVERFLOW
	JRST	EXPR1		;TEST FOR MORE

EXPR3:	SOSLE	RELLVL		;RELOCATION LEVEL .GT. 1?
	ERRSET	ERR.A		;  YES
	JRST	CPOPJ1		;EXIT GOOD


EXPRJT:				;EXPRESSION JUMP TABLE
	PHASE	0
	0
EXPL:	MOVEI	%02,EXPRPL		; +
EXMI:	MOVEI	%02,EXPRMI		; -
EXOR:	IOR	%10,EXPXCT		; !
EXAN:	AND	%10,EXPXCT		; &
EXMU:	IMUL	%10,EXPXCT		; *
EXDV:	IDIV	%10,EXPXCT		; /
	DEPHASE
EXPRPL:				; +
	TDZA	%04,%04		;ZERO FOR ADD
EXPRMI:				; -
	HRROI	%04,1		;ONE FOR SUBTRACT
	CALL	EXPRPX		;UPDATE RELOCATION COUNT
EXPRP1:	LDB	%02,SUBPNT	;GET RELOCATION
	EXCH	%10,%01
	LDB	%03,SUBPNT
	TLNE	%01,REGSYM
	TLO	%10,REGSYM	;TRANSFER REGISTER FLAG
	JUMPE	%03,EXPRM1	;BRANCH IF SUBTRACTING ABS
	TLON	%04,-1		;NOT ABS, FIRST-TIME ADDITION?
	JRST	EXPRP1		;  YES, REVERSE
	TLNN	%01,GLBSYM	;IF EITHER IS GLOBAL,
	TLNE	%10,GLBSYM
	JRST	EXPRM2		;  ERROR
	CAME	%02,%03		;LAST CHANCE, BOTH SAME RELOCATION
	JRST	EXPRM2		;  FORGET IT
	SKIPN	RELLVL		;IF BACK TO ZERO,
	TLZ	%10,(PFMASK)	;MAKE ABSOLUTE
EXPRM1:	AOS	0(%17)		;INDICATE GOOD RESULT
EXPRM2:	XCT	[EXP <ADDM %10,%01>,<SUBM %10,%01>](%04) ;PERFORM OP
	DPB	%01,[POINT 16,%10,35]	;STORE TRIMMED RESULT
	RETURN			;EXIT

EXPRPX:				;UPDATE RELOCATION LEVEL
	TLNE	%10,(PFMASK)	;IF ABS,
	TLNE	%10,GLBSYM	;  OR GLOBAL,
	RETURN			;  NO ACTION
	XCT	[EXP <AOSA RELLVL>,<SOSGE RELLVL>](%04)
	 ERRSET	ERR.A		;  NEGATIVE COUNT, ERROR
	RETURN

EXPXCT:	HRRI	%02,%01		;COMPLETE INSTRUCTION
	SPUSH	%02		;STACK INSTRUCTION
	CALL	EXPXC1		;TEST FOR ABSOLUTE
	EXCH	%10,%01
	CALL	EXPXC1		;DITTO FOR OTHER
	SPOP	%02		;FETCH INSTRUCTION
	XCT	%02		;EXECUTE IT
	ANDI	%10,177777	;MAKE ABSOLUTE
	JRST	CPOPJ1		;GOOD EXIT

EXPXC1:	CALL	ABSTST		;TEST FOR ABSOLUTE
	LSH	%10,^D<36-16>
	ASH	%10,-^D<36-16>	;EXTEND SIGN
	RETURN

	.LOC
RELLVL:	BLOCK	1		;RELOCATION LEVEL
	.RELOC
	SUBTTL	TERM EVALUATOR

TERM:				;TERM PROCESSOR
	SETZB	%10,%01		;RETURN VALUE IN %10
	CALL	GETSYM		;TRY FOR SYMBOL
	JUMPE	%00,TERM4	;  NOT A SYMBOL
	CALL	SSRCH		;SEARCH TABLE
	 JRST	TERM2		;  NOT THERE

TERM0:	CALL	CRFREF		;
	TLNE	%01,MDFSYM	;MULTIPLY DEFINED?
	ERRSET	ERR.D		;YES
	TLNN	%01,DEFSYM!GLBSYM ;UNDEFINED?
	ERRSET	ERR.U		;YES. NOTE THAT THIS TRAP CAN BE
;ENTERED ONLY WHEN THE DEFAULT GLOBALS ARE DISABLED.
	MOVE	%03,%01		;GET EXTRA COPY
	TLZ	%01,776000-REGSYM	;CLEAR ALL BUT REGISTER BIT
	TLNN	%03,DEFSYM	;DEFINED?
	TLNN	%03,GLBSYM	;  NO, GLOBAL?
	JRST	TERM1		;  LOCAL
	TLO	%01,GLBSYM	;JUST GLOBAL
	AOS	%04,GLBPNT	;GLOBAL
	MOVEM	%00,GLBBUF(%04)	;SAVE NAME
	DPB	%04,SUBPNT	;SAVE NUMBER IN RELOCATION
TERM1:	MOVE	%10,%01		;RESULT TO %10
	JRST	CPOPJ1		;GOOD EXIT

TERM2:	CALL	OSRCH		;TRY OP CODES
	 JRST	TERM3		;  NO
	CAIE	%02,OCOP	;PSEUDO-OP?
	JRST	TERM3		;  YES
	CALL	CRFOPR
	HRRZ	%10,%01		;YES, TREAT AS NUMERIC
	JRST	CPOPJ1		;GOOD EXIT

TERM3:	CALL	SSRCH		;NOT YET DEFINED
	SKPEDS	ED.ABS		;SKIP IF ABSOLUTE ASSEMBLY
	TLNE	%16,GBLDIS	;ARE DEFAULT GLOBALS ENABLED?
	JRST	TERM5		;NO.
	TLO	%01,FLTSYM!GLBSYM ;DEFAULT GLOBAL SYMBOL
	CALL	INSRT
	JRST	TERM0

TERM4:	LDB	%02,C5PNTR	;NON-SYMBOLIC
	XCT	TERMJT(%02)	;EXECUTE TABLE
	JRST	CPOPJ1		;GOOD EXIT


TERM5:				;DEFAULT GLOBALS DISALLOWED
	CALL	INSRT
	CALL	CRFREF
	ERRSET	ERR.U		;FLAG THE STATEMENT
	JRST	CPOPJ1		;TAKE THE SKIP RETURN
TERMJT:				;TERM JUMP TABLE
	PHASE	0
	RETURN			;NULL RETURN
TEPL:	CALL	TERMPL		; +
TEMI:	CALL	TERMMI		; -
TEUA:	CALL	TERMUA		; ^
TEAB:	CALL	TERMAB		; <>
TESQ:	CALL	TERMSQ		; '
TEDQ:	CALL	TERMDQ		; "
TEPC:	CALL	TERMPC		; %
TENM:	CALL	TERMNM		; 0-9
	DEPHASE
TERMPL:				; +
	CALL	GETNB
	CALL	TERM
	 ERRSET	ERR.A
	RETURN

TERMMI:				; -
	CALL	TERMUC
	ADDI	%10,1
	TRZ	%10,600000
	RETURN

TERMUA:				; ^
	CALL	GETNB
	CAIN	%14,"F"
	JRST	TERMUF
	CAIN	%14,"C"
	JRST	TERMUC
	SETZ	%03,
	CAIN	%14,"D"
	MOVEI	%03,^D10
	CAIN	%14,"O"
	MOVEI	%03,^D8
	CAIN	%14,"B"
	MOVEI	%03,^D2
	SKIPN	%03
	ERRXIT	ERR.A
	SPUSH	CRADIX
	MOVEM	%03,CRADIX
	CALL	TERMPL
	SPOP	CRADIX
	RETURN

TERMUC:	CALL	TERMPL
	CALL	ABSTST
	TRC	%10,177777
	RETURN

TERMUF:	CALL	GETNB
	MOVEI	%03,1
	MOVEM	%03,FLTLEN
	CALL	FLTG
	TLNE	%15,FLTFLG
	ERRSET	ERR.A
	LDB	%10,[POINT 16,FLTNUM,35]
	RETURN

TERMAB:				; <>
	CALL	GETNB
	SPUSH	RELLVL
	CALL	EXPR
	 ERRSET	ERR.A
	CAIE	%14,">"		;"<"
	ERRSKP	ERR.A
	CALL	GETNB
	SPOP	RELLVL
	RETURN
TERMNM:				;NUMERIC TERM
	SETZB	%00,%01		;CLEAR ACS
TERMN1:	IMULI	%10,^D10	;DECIMAL ACCUMULATOR
	ADDI	%10,-"0"(%14)
	IMUL	%01,CRADIX
	ADDI	%01,-"0"(%14)
	CAIGE	%00,-"0"(%14)	;HIGHEST NUMBER SO FAR?
	MOVEI	%00,-"0"(%14)	;  YES, SAVE IT
	GETCHR			;GET THE NEXT CHARACTER
	CAIL	%14,"0"		;TEST NUMERIC
	CAILE	%14,"9"
	CAIA			;  NO
	JRST	TERMN1		;YES, PROCESS IT
	CAIE	%14,"."		;DECIMAL POINT?
	JRST	TERMN2		;  NO
	CALL	GETNB		;YES, BYPASS IT
	JRST	TERMN3		;SKIP AROUND TEST

TERMN2:	CAIN	%14,"$"
	JRST	TERMN4
	CAML	%00,CRADIX	;IN BOUNDS?
	ERRSKP	ERR.N		;  YES, FLAG ERROR AND LEAVE DECIMAL
	MOVE	%10,%01		;NO, MOVE OCTAL IN
TERMN3:	TDZE	%10,[-1B19]	;OVERFLOW?
	ERRSET	ERR.T		;  YES, FLAG TRUNCATION ERROR
	JRST	SETNB


TERMN4:	MOVE	%00,%10
	HRL	%00,LSBNUM
	TLO	%00,ST.LSB
	TLO	%15,LSBFLG
	CALL	SSRCH
	 ERRSET	ERR.U
	MOVE	%10,%01
	JRST	GETNB

TERMPC:				; %
	CALL	GETNB		;BYPASS PERCENT
	CALL	TERM		;GET A TERM
	 ERRSET	ERR.R		;  ERROR
	CALL	REGTST		;TEST VALID REGISTER TERM
	TLO	%10,REGSYM	;FLAG IT
	RETURN			;EXIT
TERMDQ:				; """
	GETCHR			;GET THE NEXT NON-TERMINATOR
	JUMPE	%14,TERMQE	;  END OF LINE, ERROR
	LDB	%10,%13		;LOAD UN-MAPPED CHARACTER
	GETCHR			;TRY ONE MORE
	JUMPE	%14,TERMQE	;  ERROR
	LDB	%14,%13
	DPB	%14,[POINT 8,%10,35-8]	;STORE IN UPPER
	JRST	GETNB		;RETURN WITH NEXT NON-BLANK


TERMSQ:				; "'"
	GETCHR			;GET NON-TERMINATOR
	JUMPE	%14,TERMQE	;  TERMINATOR, ERROR
	LDB	%10,%13		;LOAD UN-MAPPED CHARACTER
	JRST	GETNB		;RETURN NON-BLANK

TERMQE:	ERRSET	ERR.Q		;RAN OUT OF CHARACTERS
	RETURN
	SUBTTL	SYMBOL/CHARACTER HANDLERS

GETSYM:				;GET A SYMBOL
	MOVEM	%13,SYMBEG	;SAVE START FOR RESCAN
	SETZB	%00,%01		;CLEAR AC AND COUNT
GETSY1:	MOVEM	%13,SYMEND	;SAVE END
	LDB	%02,ANPNTR	;MAP CHARACTER TYPE
	XCT	GETSYT(%02)	;EXECUTE TABLE
	 JRST	SETNB		;  FINISHED, RETURN NEXT NON-BLANK
	CAIL	%01,6		;OVERFLOW?
	JRST	GETSY2		;  YES, DON'T STORE
	HLRZ	%03,RADTBL-40(%14)	;MAP CHAR
	IMUL	%03,RAD50M(%01)	;SKIFT IT
	ADD	%00,%03		;ACCUMULATE
GETSY2:	GETCHR			;GET THE NEXT CHAR
	AOJA	%01,GETSY1	;TRY FOR MORE

GETSYT:				;GETSYM TABLE
	PHASE	0
	JFCL			;NON-ALPHA/NUMBERIC
.DOL:!	TLNN	%16,MODBIT	;INVALID IN COMMAND STRING
.DOT:!	TLNN	%16,MODBIT	;DITTO
.ALP:!	CAIA
.NUM:!	CALL	GETSY3		;NUMERIC, DOUBLE TEST
	DEPHASE

GETSY3:	TLNE	%16,MODBIT	;ACCEPT IF IN COMMAND STRING
	JUMPE	%00,CPOPJ	;  NO, NULL IF FIRST
	JRST	CPOPJ1

RAD50M:				;RAD50 MULTIPLIERS
	XWD	50*50,
	XWD	   50,
	XWD	    1,
	XWD		,50*50
	XWD		,50
	XWD		,1
GETLSB:				;GET LOCAL SYMBOL
	SETZM	%00
GETLS1:	CAIL	%14,"0"		;TEST RANGE
	CAILE	%14,"9"
	JRST	GETLS2		;  OUTSIDE
	IMULI	%00,^D10	;OK, ACCUMULATE NUMBER
	ADDI	%00,-"0"(%14)
	GETCHR
	JRST	GETLS1

GETLS2:	JUMPE	%00,GETLS3
	CAIE	%14,"$"
	JRST	GETLS3
	CAILE	%00,^D127	;NUMBER TOO LARGE?
	ERRSET	ERR.T		;  YES, ERROR
	HRL	%00,LSBNUM	;STUFF IN BLOCK NUMBER
	TLO	%00,ST.LSB	;FLAG IT
	TLO	%15,LSBFLG
	JRST	GETNB

GETLS3:	MOVE	%13,SYMBEG	;MISSED, RESTORE POINTER
	SETZM	%00
	JRST	SETNB
	OPDEF	GETNB	[CALL .]
GETNB:				;GET NON-BLANK CHARACTER
	IBP	%13		;INDEX BYTE POINTER

	OPDEF	SETNB	[CALL .]
SETNB:				;SET TO NON-BLANK CHARACTER
	SETCHR			;SET CHARACTER IN %14
	CAIE	%14,SPACE	;IF SPACE
	CAIN	%14,TAB		;  OR TAB;
	JRST	GETNB		;  BYPASS
	RETURN			;OTHERWISE EXIT


;	OPDEF	GETCHR	[ILDB %14,%13]
	OPDEF	GETCHR	[CALL .]
GETCHR:				;GET THE NEXT CHARACTER
	IBP	%13		;INDEX BYTE POINTER

;	OPDEF	SETCHR	[LDB  %14,%13]
	OPDEF	SETCHR	[CALL .]
SETCHR:				;SET THE CURRENT CHAR IN %14
	LDB	%14,%13
	CAIL	%14,"A"+40
	CAILE	%14,"Z"+40
	RETURN
	SUBI	%14,40
	RETURN

	.LOC
SYMBEG:	BLOCK	1		;SYMBOL START
SYMEND:	BLOCK	1		;SYMBOL END
	.RELOC
	SUBTTL	ARGUMENT HANDLERS

TGARG:				;TEST FOR GENERAL ARGUMENT
	SETZM	GTCDEL		;CLEAR DELIMITER
	TLNN	%16,MODBIT	;EXEC MODE?
	JRST	TGARG1		;  YES
	CAIE	%14,";"		;EOL?
	CAIN	%14,0
	RETURN			;  YES
	SKIPL	ARGCNT		;END OF EXPRESSION?
	JRST	TGARG5		;  NO
	HRRZS	ARGCNT		;YES, CLEAR FLAG
	CAIN	%14,","		;REQUIRED COMMA SEEN?
	JRST	TGARG2		;  YES
	RETURN			;NO, CONSIDER NULL

TGARG5:	SKIPE	ARGCNT		;NO, FIRST ARGUMENT?
	CAIE	%14,","		;  NO, COMMA TO BYPASS?
	JRST	TGARG3		;  NO
	JRST	TGARG2		;YES

TGARG1:	CAIE	%14,":"		;EXEC MODE, ARGUMENT?
	RETURN			;  NO
TGARG2:	CALL	GETNB		;YES, BYPASS TERMINATOR
TGARG3:	AOS	ARGCNT		;INCREMENT ARG COUNT
	JRST	CPOPJ1		;GOOD EXIT


GSARG:				;GET SYMBOLIC ARGUMENT
	CALL	TGARG		;TEST FOR EXISTENCE
	 RETURN			;  NO
GSARGF:	CALL	GETSYM		;YES, GET SYMBOL
	JUMPN	%00,CPOPJ1	;GOOD EXIT
	ERRSET	ERR.A		;  ERROR
	RETURN			;ERROR, BAD EXIT


	.LOC
ARGBLK:				;GENERAL ARGUMENT BLOCK
ARGPNT:	BLOCK	1		;POINTER TO PREVIOUS
ARGBEG:	BLOCK	1		;START OF ARG
ARGEND:	BLOCK	1		;END OF ARG
ARGCHC:	BLOCK	1		;CHARACTER COUNT
ARGTXP:	BLOCK	1		;TEXT POINTER
ARGCNT:	BLOCK	1		;ARGUMENT NUMBER COUNT
ARGLEN=	.-ARGBLK
	.RELOC
GTCHR:				;GET TEXT CHARACTER
	SKIPE	GTCDEL		;DELIMITER IN PROGRESS?
	JRST	GTCHR3		;  YES
	SKIPE	ARGCNT		;NO, FIRST ARG?
	CAIE	%14,";"		;NO, EOL?
	CAIN	%14,0
	RETURN			;  YES, TAKE NULL EXIT
	CAIE	%14,"<"		;EXPRESSION MODE?
	JRST	GTCHR2		;  NO
	CALL	GETNB		;YES, BYPASS CHARACTER
	SPUSH	%00		;STACK REGISTERS
	SPUSH	%01
	CALL	ABSEXP		;EVALUATE EXPRESSION
	SPOP	%01
	SPOP	%00
	CAIE	%14,">"		;GOOD TERMINATION?
	ERRSKP	ERR.A		;  NO
	CALL	GETNB		;YES, BYPASS IT
GTCHR1:	AOS	ARGCNT		;BUMP ARG COUNT
	JRST	CPOPJ1		;GOOD EXIT

GTCHR2:	MOVEM	%14,GTCDEL	;SET DELIMITER
GTCHR3:	GETCHR			;GET THE NEXT CHARACTER
	CAME	%14,GTCDEL	;TERMINATOR?
	JRST	GTCHR4		;  NO
	SETZM	GTCDEL		;YES, CLEAR DELIMITEP
	CALL	GETNB		;BYPASS DELIMITER
				;BLOWUP IF THE LINE IS HENCEFORTH EMPTY
	JRST	GTCHR		;TRY AGAIN

GTCHR4:	LDB	%10,%13		;GET UN-MAPPED COPY
	JUMPN	%10,GTCHR1	;BRANCH IF NOT EOL
	MOVEI	6,";"		;SEE IF LAST DELIMITER WAS A SEMICOLON
	CAME	%06,GTCDEL	;WAS IT?
	ERRSET	ERR.A		;NO, FLAG ERROR
	SETZM	GTCDEL
	RETURN			;NULL EXIT


	.LOC			;ARGUMENT STORAGE WORDS
GTCDEL:	BLOCK	1		;ARGUMENT DELIMITER
	.RELOC
	SUBTTL	END OF PASS ROUTINES

ENDP:				;END OF PASS ROUTINES
	CALL	TSTMAX		;BE SURE TO TRAP MAX PC
	LDB	%02,CCSPNT
	HRRM	%05,SECBAS(%02)	;SET HIGH LOCATION
	TLNN	%15,P1F		;PASS 1?
	JRST	ENDP20		;  NO
	CALL	SETBIN		;SET BINARY (OBJ OR BIN)
	IFNDEF	XREL,	<
	SKPEDR	ED.ABS	>	;YES, ABSOLUTE?
	 POPJ	%17,		;  YES, NO ACTION
	IFNDEF	XREL
<	MOVE	%00,PRGTTL	;GET PROGRAM TITLE
	SETZ	%01,
	CALL	HDROUD		;OUTPUT DOUBLE WORD
	MOVE	%00,PRGIDN
	MOVSI	%01,3000
	SKIPE	%00		;ANY IDENT?
	CALL	HDROUD		;  YES, DUMP IT
	MOVE	%06,[POINT 1,SECLCF,0]
	MOVEM	%06,SECLCP	;SET LOCAL POINTER
	SETZB	%06,DGCNT	;INIT SECTOR COUNT AND DFLT GLBL COUNT
ENDP11:	SETZ	%07,		;INIT FOR TABLE SEARCH
	MOVE	%00,SECNAM(%06)	;GET SECTOR NAME
	HLRZ	%01,SECBAS(%06)	;GET ITS LENGTH
	SKIPN	RSXSW		;RSX DEFAULTS IN EFFECT?
	JRST	ENDP01		;NO
				;ASSUME RSX DEFAULTS
	HRLI	%01,2514	;ASSUME ASECT DEFAULT
	SKIPE	%06		;WERE WE JUSTIFIED?
	HRLI	%01,2450	;NO, SO ASSUME UNNAMED CSECT
	CAILE	%06,1		;WAS IT MAYBE A NAMED CSECT?
	HRLI	%01,2554	;YES
	JRST	ENDP02		;BRANCH AROUND NON-RSX DEFAULTS

				;NON-RSX PSECT DEFAULTS
ENDP01:	HRLI	%01,450		;ASSUME RELOCATABLE
	SKIPN	%06		;YES?
	HRLI	%01,410		;  NO, ABS

ENDP02:	EXCH	%07,PSCFLG(%06)	;CHECK FOR POSSIBLE PSECT
	SKIPGE	%07		;IS THIS SECTION A PSECT?
	HRL	%01,%07		;WHY,YES. STORE THE ATTRIBUTE FLAGS AND
				;RLD TYPE 5 
	EXCH	%07,PSCFLG(%06)	;RESTORE THINGS
	LDB	%03,SECLCP	;LOCAL?
	SKIPE	%03
	TLO	%01,2000	;  YES
	CALL	HDROUD		;OUTPUT IT
ENDP12:	CALL	GETSTE		;GET THE NEXT SYMBOL TABLE ENTRY
	 JRST	ENDP15		;  END, BRANCH
	TLNN	%00,ST.MAC!ST.LSB
	TLNN	%01,GLBSYM	;GLOBAL?
	JRST	ENDP12		;  NO, FORGET IT
	LDB	%02,SUBPNT	;GET RELOCATION
	MOVSI	%03,2150	;ASSUME REL
	JUMPN	%06,ENDP13	;BRANCH IF TRUE
	MOVSI	%03,2100	;NO, ASSUME EXTERNAL
	TLNN	%01,DEFSYM	;TRUE?
	JRST	ENDP14		;  YES
	TLO	%03,10		;INTERNAL
ENDP13:	TLNE	%01,DEFSYM	;IF EXTERNAL
	CAME	%02,%06		;  OR NON-MATCH
	JRST	ENDP12
ENDP14:	
	TLNE	%01,FLTSYM	;WAS THIS TUSKER DEFAULTED?
	AOS	DGCNT		;YUP.
	HLL	%01,%03
	CALL	HDROUD		;OUTPUT IT
	JRST	ENDP12		;TRY FOR MORE
ENDP15:	ADDI	%06,1		;MOVE TO NEXT SECTOR
	IBP	SECLCP		;BUMP LOCAL POINTER
	SKIPN	SECNAM(%06)	;IF NON-NULL
	CAIN	%06,1		;  OR SECTOR 1,
	JRST	ENDP11		;PROCESS
	MOVE	%01,ENDVEC	;GET END VECTOR
	LDB	%02,SUBPNT	;ISOLATE ITS RELOCATION
	MOVE	%00,SECNAM(%02)	;GET THE NAME
	HRLI	%01,1410	;ASSUME ABSOLUTE
	SKIPE	%02
	TLO	%01,40		;NO, RELOCATABLE
	CALL	HDROUD		;OUTPUT IT
	CALL	BLKDMP		;DUMP THE BLOCK
	MOVEI	%02,BKT2
	CALL	BSWORD		;SET BLOCK TYPE
	CALL	BLKDMP		;DUMP THE BUFFER
	MOVEI	%02,BKT4	;OUTPUT A DUMMY CSECT
	CALL	BSWORD
	MOVEI	%02,RLDT7
	CALL	BSWORD
	SETZ	%02,
	CALL	BSWORD
	CALL	BSWORD
	CALL	BSWORD
	JRST	BLKDMP		;DUMP THE BUFFER AND EXIT
>

ENDP20:	CALL	BLKDMP		;END OF PASS 2
	MOVEI	%02,BKT6	;ASSUME RELOCATABLE
	SKPEDR	ED.ABS		;ABSOLUTE?
	 MOVE	%02,ENDVEC	;  YES, SET XFER VECTOR
	CALL	BSWORD		;STORE IT
	JRST	BLKDMP		;DUMP THE BUFFER AND EXIT


	IFNDEF	XREL
<
HDROUD:				;OUTPUT DOUBLE WORD
	MOVE	%02,BYTCNT
	CAILE	%02,RLDLEN-^D8+2	;ROOM?
	CALL	BLKDMP		;  NO
	MOVEI	%02,BKT1
	SKIPN	BYTCNT		;BUFFER INITIALIZED?
	CALL	BSWORD		;  NO, DO SO
	MOVE	%02,%00		;FIRST WORD
	CALL	.+2
	MOVE	%02,%01
	SPUSH	%02
	HLRZ	%02,0(%17)	;LEFT HALF
	CALL	BSWORD
	SPOP	%02
	JRST	BSWORD
>
	SUBTTL	CODE ROLL HANDLERS

SETRLD:				;SET RLD HEADER
	MOVE	%01,%05
	ADD	%01,PHAOFF
	ANDI	%01,177777
	HRLI	%01,(<RLDT10>B<MODOFF>)

STCODE:				;STOW CODE
	SPUSH	%03
	AOS	%03,CODPNT	;INCREMENT INDEX
	MOVEM	%01,CODBUF-1(%03)	;STORE
	SPOP	%03
	RETURN

PROCOD:				;PROCESS CODE
	CALL	PROCO1		;PROCESS ONE WORD
	 RETURN			;  NULL, EXIT
	MOVEM	%00,PF0		;OK, SET PRINT FIELDS
	MOVEM	%01,PF1
	SKPLCR	LC.TTM		;EXIT IF TTY
	 CALL	PROCO1
	 JRST	CPOPJ1		;  NULL, BUT GOOD EXIT
	MOVEM	%01,PF2
	CALL	PROCO1
	 JRST	CPOPJ1
	MOVEM	%01,PF3
	JRST	CPOPJ1

PROCO1:	CALL	FETCOD		;FETCH AN ENTRY
	 RETURN			;  END
	CALL	PROWRD		;PROCESS WORD
	MOVE	%00,PFT0	;TRANSFER PRINT STUFF
	MOVE	%01,PFT1
	JRST	CPOPJ1

SETPF0:				;SET PRINT FIELD 0
	MOVE	%03,%05
	TLO	%03,DEFSYM
	MOVEM	%03,PF0
	RETURN

SETPF1:				;SET PRINT FIELD 1
	MOVE	%03,%10
	TLO	%03,DEFSYM
	MOVEM	%03,PF1
	RETURN

FETCOD:	MOVE	%03,CODPNT	;FETCH INDEX
	SKIPN	%01,CODBUF(%03)	;NULL?
	RETURN			;  YES, EXIT NULL
	SETZM	CODBUF(%03)
	AOS	CODPNT		;BUMP POINTER
	JRST	CPOPJ1
PROWRD:				;PROCESS WORD
	LDB	%02,MODPNT	;GET CLASS
	ANDI	%02,177		;MASK OUT BYTE BIT
	MOVE	%10,RLDTBL(%02)	;GET PROPER TABLE ENTRY
	MOVE	%03,PF0
	MOVE	%04,PF1
	CAIE	%02,RLDT7
	CAIN	%02,RLDT10
	JRST	PROWR6
	MOVE	%03,%05		;GET A COPY OF THE PC
	TLO	%03,DEFSYM	;WITH DEFINED BIT SET
	TLNN	%01,BC1!BC2	;CODE TO BE GENNED?
	SETZM	%03		;  NO, DON'T PRINT LOCATION
	MOVE	%04,%10		;FLAGS TO %04
	DPB	%01,[POINT 36-8,%04,35]	;REMAINDER FROM %01
	CAIN	%02,RLDT1	;SPECIAL IF CLASS 1
	TLO	%04,(1B<SUBOFF>)
PROWR6:	MOVEM	%03,PFT0
	MOVEM	%04,PFT1	;SET TEMP PRINT FIELD 1
	IFNDEF	XREL
<
	TLNN	%15,P1F		;IF PASS ONE
	SKPEDR	ED.ABS		;  OR ABSOLUTE?
	 JRST	PROWR3		;  YES, BRANCH
	LDB	%03,TYPPNT	;GET BYTE COUNT
	CAIN	%02,RLDT11	;TYPE 11?
	MOVEI	%03,4		;  YES, ALL IN ONE BUFFER
	ADD	%03,BYTCNT
	HRRZ	%04,%10
	ADD	%04,RLDCNT
	CAIG	%03,RLDLEN
	CAILE	%04,RLDLEN	;ROOM TO STORE?
	CALL	BLKDMP		;  NO, DUP CURRENT BUFFER
	SKIPN	BYTCNT		;BUFFER EMPTY?
	TLNN	%01,BC1!BC2	;  YES, ANY CODE?
	JRST	PROWR1		;OK, BYPASS
	MOVEI	%02,BKT3
	CALL	BSWORD		;  NO, STORE BLOCK TYPE
	MOVE	%02,%05
	CALL	BSWORD		;STORE CURRENT ADDRESS
PROWR1:	LDB	%02,MODPNT	;GET THE TYPE
	JUMPE	%02,PROWR3	;BRANCH IF ABSOLUTE
	CALL	RLDSTB		;STORE IT
	TLNN	%01,BC1!BC2	;CODE?
	TDZA	%02,%02		;  NO, SET ZERO
	MOVE	%02,BYTCNT	;YES, SET BYTE POINT FOR REFERENCE
	CALL	RLDSTB
	LDB	%02,SUBPNT
	JUMPE	%02,PROWR2	;BRANCH IF NOT EXTERNAL/REL
	MOVS	%02,GLBBUF(%02)	;GET GLOBAL NAME
	CALL	RLDSTW
	HLRZS	%02
	CALL	RLDSTW		;  AND LEFT HALF
PROWR2:	MOVE	%02,%01		;GET VALUE
	TLNE	%10,1		;SHOULD WE STORE?
	CALL	RLDSTW		;  YES
>
PROWR3:	MOVE	%02,%01		;GET BASIC VALUE
	TLNE	%02,BC1!BC2	;CODE?
	CALL	BYTOUT		;  YES
	LSH	%02,-^D8	;SHIFT HIGH ORDER BYTE DOWN
	TLNE	%01,BC2		;WORD?
	CALL	BYTOUT		;  YES, OUTPUT HIGH BYTE
	TLNN	%01,BC1!BC2	;CODE?
	CALL	BLKDMP		;  NO, SPECIAL.  DUMP THE BUFFER
	RETURN

	IFNDEF	XREL
<
RLDSTW:
	SPUSH	%02
	CALL	RLDSTB
	LSH	%02,-^D8
	CALL	RLDSTB
	SPOP	%02
	RETURN

RLDSTB:	AOS	%03,RLDCNT
	MOVEM	%02,RLDBLK-1(%03)
	RETURN
>

RLDTBL:
	PHASE	0

RLDT0:	XWD	DEFSYM!	0,	0
RLDT1:	XWD	DEFSYM!	1,	4
RLDT2:	XWD	0!	0,	6
RLDT3:	XWD	DEFSYM!	1,	4
RLDT4:	XWD	0!	0,	6
RLDT5:	XWD	GLBSYM!	1,	10
RLDT6:	XWD	GLBSYM!	1,	10
RLDT7:	XWD	0!	1,	10
RLDT10:	XWD	DEFSYM!	1,	4
RLDT11:	XWD	DEFSYM!	0,	2
RLDT12:	XWD	0!	0,	0
RLDT13:	XWD	0!	0,	0
RLDT14:	XWD	0!	0,	0
RLDT15:	XWD	DEFSYM!	1,	10
RLDT16:	XWD	DEFSYM!	1,	10
RLDT17:	XWD	0!	0,	0
	DEPHASE


	.LOC
CODPNT:	BLOCK	1		;CODE ROLL POINTER
CODBUF:	BLOCK	^D100		;CODE ROLL BUFFER
	.RELOC
	SUBTTL	OCTAL OUTPUT ROUTINES

BYTOUT:				;OUTPUT A BYTE OF CODE
	TLNN	%15,P1F		;PASS 1
	SKPEDR	ED.NPP
	 JRST	BYTOU2		;  YES, JUST INCREMENT AND EXIT
	SKPEDS	ED.ABS
	 JRST	BYTOU1		;  NO
	MOVE	%03,BYTCNT	;YES GET BYTE COUNT
	CAIGE	%03,DATLEN+2	;OUT OF ROOM?
	CAME	%05,CURADR	;  OR A SEQUENCE BREAK?
	CALL	BLKDMP		;  YES, DUMP THE BUFFER
	SKIPE	BYTCNT		;DO WE NEED INITIALIZATION?
	JRST	BYTOU1		;  NO, STORE IT
	SPUSH	%02		;STACK CURRENT CHARACTER
	MOVE	%02,%05		;GET PC
	CALL	BSWORD		;STORE IT
	MOVEM	%05,CURADR	;NEW SEQUENCE BREAK TEST
	SPOP	%02		;RETRIEVE BYTE
BYTOU1:	CALL	BSBYTE		;STORE THE BYTE
	AOS	CURADR		;UPDATE CURRENT ADDRESS
BYTOU2:	MOVEI	%03,LC.ME
	SKPLCS	LC.MEB		;MACRO EXPANSION OF BINARY?
	 ANDCAM	%03,LCTST	;  YES, DISABLE LC.ME
	AOJA	%05,CPOPJ	;INCREMENT CLC AND EXIT

BSWORD:				;BINARY STORAGE OF WORD
	SPUSH	%02
	CALL	BSBYTE		;STORE LOW ORDER
	LDB	%02,[POINT 8,0(%17),35-8]	;FETCH HIGH BYTE
	CALL	BSBYTE		;STORE IT
	SPOP	%02		;RESTORE WORD
	RETURN			;  AND EXIT

BSBYTE:				;BINARY STORAGE OF BYTE
	AOS	%03,BYTCNT	;INCREMENT AND FETCH THE BYTE COUNT
	MOVEM	%02,DATBLK-1(%03)	;STORE CURRENT BYTE IN BUFFER
	RETURN
BLKDMP:				;DUMP THE CURRENT BLOCK
	SKIPN	BYTCNT		;IS IT EMPTY?
	JRST	RLDDMP		;  YES, TEST FOR REL BLOCK
	SPUSH	%01		;GET A COUPLE OF SCRATCH REGISTERS
	SPUSH	%02
BLKDM1:	MOVEI	%02,01		;BLOCK TYPE ONE
	CALL	BINOUT		;OUTPUT FLAG WORD
	LSH	%02,-8
	CALL	BINOUT
	MOVE	%02,BYTCNT	;FETCH BYTE COUNT
	ADDI	%02,4		;FUDGE FOR HEADER
	CALL	BINOUT		;OUTPUT IT
	LSH	%02,-8
	CALL	BINOUT
	HRLZ	%01,BYTCNT	;GET BYTE COUNT
	MOVNS	%01		;NEGATE BYTE CT
	MOVE	%02,DATBLK(%01)	;GET AN ITEM FROM THE DATA BLOCK
	CALL	BINOUT		;DUMP IT
	AOBJN	%01,.-2		;RECYCLE IF NOT DONE
	MOVN	%02,CHKSUM	;GET NEG OF CHECKSUM.
	CALL	BINOUT		;DUMP IT
	SETZ	%02,		;FINISHED WITH BLOCK
	MOVEI	%01,^D6
	CALL	BINOUT		;DUMP SOME BLANK TAPE
	SOJG	%01,.-1
	SPOP	%02		;RESTORE REGISTERS
	SPOP	%01

RLDDMP:
	IFNDEF	XREL
<
	SKIPN	RLDCNT
	JRST	BLKINI
	SPUSH	%01
	SPUSH	%02
	HRLZ	%01,RLDCNT
	CALL	BLKINI
	MOVEI	%02,BKT4
	CALL	BSWORD
	MOVNS	%01
	MOVE	%02,RLDBLK(%01)
	CALL	BSBYTE
	AOBJN	%01,.-2
	CALL	BLKDMP
	SPOP	%02
	SPOP	%01
>

BLKINI:				;CODE BLOCK INITIALIZATION
	SETZM	BYTCNT		;CLEAR BYTE COUNT
	IFNDEF	XREL,	<SETZM	RLDCNT>
	RETURN			;EXIT
	.LOC
CURADR:	BLOCK	1		;SEQUENCE BREAK TEST
CHKSUM:	BLOCK	1		;CHECK SUM
BYTCNT:	BLOCK	1		;BYTE COUNT
DATBLK:	BLOCK	DATLEN+10	;ABS BUFFER
	IFNDEF	XREL
<
RLDCNT:	BLOCK	1		;RLD COUNT
RLDBLK:	BLOCK	RLDLEN+10	;RLD BUFFER
>
	.RELOC
	SUBTTL	INPUT LINE ACCUMULATORS

GETLIN:				;GET THE NEXT SOURCE LINE
	SETZM	CRRCNT
	SETZM	LINCHC
	SETZM	LINTBC		;TAB ORIENTED CHAR COUNT
	MOVE	%13,[POINT 7,LINBUF]
GETLI1:	CALL	CHARLC		;GET AN INPUT CHARACTER
	LDB	%02,C7PNTR	;GET CHARCTERISTICS
	XCT	GETLIT(%02)	;EXECUTE TABLE
	SKIPE	CRRCNT		;OK, ANY IMBEDDED CR'S?
	CALL	ILCPRO		;  YES, ERROR
	AOS	%03,LINCHC
	CAIL	%03,CPL
	ERRSKP	ERR.L
	IDPB	%14,%13
	AOS	LINTBC		;UPDATE TAB COUNT
	JRST	GETLI1		;  OK, STORE IT

GETLI2:	MOVEI	%03,7
	IORM	%03,LINTBC	;FUDGE TAB COUNT
	RETURN

GETLI3:	CAIE	%14,CRR		;TERMINATOR, CR?
	JRST	GETLI5		;  NO, A REAL ONE
	SKIPN	CRRCNT		;YES, FIRST?
	AOSA	CRRCNT		;  YES, FLAG IT
GETLI4:	CALL	ILCPRO		;  NO, ERROR
	JRST	GETLI1

GETLI5:	CAIN	%14,FF		;FORM FEED?
	SKIPE	MCACNT
	JRST	GETLI6		;  NO
	SKIPN	LINCHC
	TLO	%15,FFFLG
	AOS	FFCNT
	AOS	ERPNUM		;BUMP ERROR PAGE COUNT
GETLI6:	MOVEI	%14,0
	IDPB	%14,%13
	MOVEI	%13,LINBUF
	HLL	%13,ASCBYT
	MOVEM	%13,LINPNT
	MOVEM	%13,CLIPNT
	SKIPE	MCACNT
	JRST	SETNB
	SKIPN	MSBMRP		;MACRO EXPANSION?
	AOSA	%14		;  NO, INCREMENT LINE COUNT
	SETLCT	LC.ME		;  IGNORE MEB FOR NOW
	TLNN	%16,SOLBIT	;SEQUENCE OUTPUT LINES?
	ADDM	%14,LINNUM	;  NO, BUMP
	TLNE	%15,ENDFLG	;PERCHANCE END OF FILE?
	ERRSET	ERR.E		;  YES, FLAG "NO END STATEMENT"
	LDB	%03,CDRPNT
	MOVEM	%03,CDRCHR
	MOVEI	%03,0
	TLNE	%16,CDRBIT	;/CDR MODE?
	DPB	%03,CDRPNT	;  YES, STUFF A NULL
	JRST	SETNB		;RETURN WITH FIRST NON-BLANK

GETLC:	SKPEDS	ED.LC
	SUBI	%14,40
	RETURN

ILCPRO:				;ILLEGAL CHARACTER PROCESSOR
	ERRSET	ERR.I		;FLAG ERROR
	SKIPN	ILCPNT		;FIRST IN THIS LINE?
	MOVEM	%13,ILCPNT	;  YES
	RETURN

GETLIT:				;GETLIN MAP TABLE
	PHASE	0
	JRST	GETLI4
QJNU:	JRST	GETLI4		;ILLEGAL CHARACTER
QJCR:	JRST	GETLI3
QJVT:	JRST	GETLI3
QJTB:	CALL	GETLI2
QJSP:	JFCL
QJPC:	JFCL
QJLC:	CALL	GETLC
	DEPHASE
GETMLI:				;GET MACRO-TYPE LINE
	CALL	GETLIN		;GET A STANDARD LINE
	CALL	GETSYM
TSTMLI:	SKIPE	%00
	CALL	OSRCH
	 SETZB	%01,%02		;  NO
	CAIE	%02,DIOP	;DIRECTIVE?
	TDZA	%03,%03		;  NO
	LDB	%03,SUBPNT	;YES, RETURN WITH FLAGS
	RETURN

CDRPNT:	POINT	7,LINBUF+^D14,6+7+7	;POINTER TO COLUMN 73

	.LOC
CDRCHR:	BLOCK	1		;/CDR SAVE CHARACTER
LINPNT:	BLOCK	1		;POINTER TO START OF LINE
CLIPNT:	BLOCK	2
CLILBL:	BLOCK	1
ILCPNT:	BLOCK	1		;ILLEGAL CHARACTER POINTER
FFCNT:	BLOCK	1		;TERMINATION CHARACTER
ERPNUM:	BLOCK	1		;ERROR PAGE NUMBER
ERPBAK:	BLOCK	1		;ONE MESSAGE PER PAGE
CRRCNT:	BLOCK	1
LINCHC:	BLOCK	1
LINTBC:	BLOCK	1
LINBUF:	BLOCK	CPL/5+2
	.RELOC
	SUBTTL	SYMBOL TABLE LISTING

SYMTB:				;LIST THE SYMBOL TABLE
	TLNN	%16,CRFBIT	;CREF SUPPRESSED?
	JRST	CRFLST		;  NO, DO IT
	SKPLCR	LC.SYM		;HOW ABOUT SYMBOL TABLE?
	 RETURN			;  NO, EXIT
	SETZ	%07,		;INITIALIZE POINTER
	TLO	%16,HDRBIT	;FLAG NEW PAGE
	MOVE	%03,[XWD [ASCIZ /SYMBOL TABLE/],STLBUF]
	BLT	%03,STLBUF+4

SYMTB1:	MOVEI	%06,SPLTTY	;SET "SYMBOLS PER LINE"
	SKPLCR	LC.TTM		;TELETYPE?
	 MOVEI	%06,SPL		;  NO
SYMTB2:	CALL	GETSTE		;GET THE NEXT SYMBOL TABLE ENTRY
	 JRST	SYMTB3		;  END
	TLNE	%00,ST.MAC!ST.LSB
	JRST	SYMTB2
	CALL	LSTSTE		;LIST SYMBOL TABLE ENTRY
	SOJG	%06,SYMTB2	;TEST FOR MORE ITEMS ON LINE
	CALL	LSTCR
	JRST	SYMTB1		;START NEW LINE

SYMTB3:	MOVE	%00,M40DOT
	MOVE	%01,%05		;PRINT PC
	TLO	%01,DEFSYM
	CALL	LSTSTE
SYMTBF:	CALL	LSTCR
	CALL	LSTCR
	IFNDEF	XREL
<
	SKPEDR	ED.ABS		;ABS MODE?
	 RETURN			;  YES, EXIT
	MOVE	%07,[XWD -^D<256-1>,1]
SYMTB4:	MOVE	%00,SECNAM(%07)
	HLRZ	%01,SECBAS(%07)
	DPB	%07,SUBPNT	;SET SECTOR
	TLO	%01,LBLSYM!DEFSYM	;SUPPRESS "="
	CALL	LSTSTE
	CALL	LSTCR
	SKIPE	SECNAM+1(%07)
	AOBJN	%07,SYMTB4
>
	RETURN
CRFLST:
	MOVE	%00,M40DOT
	CALL	SRCHF
	 JFCL
	MOVE	%01,%05
	TLO	%01,DEFSYM
	CALL	INSRTF
	SETZB	%00,%07
	CALL	CRFPUT		;OUTPUT A NULL
CRFL01:	CALL	GETSTE
	 JRST	CRFL10
	TLNE	%00,ST.MAC!ST.LSB
	JRST	CRFL01
	CALL	CRFPUT
	MOVE	%00,%01
	CALL	CRFPUT
	JRST	CRFL01

CRFL10:	RELEAS	SRC,
	MOVE	%03,[XWD [ASCIZ /CROSS REFERENCE TABLE/],STLBUF]
	BLT	%03,STLBUF+6
	MOVSI	%00,(1B0)
	MOVEM	%00,CRFMIN
	SETCAM	%00,CRFMAX
	SETOM	CRFTMP

CRFL20:	CLOSE	CRF,
	MOVE	%03,SYSDEV
	MOVEM	%03,DEVNAM
	DEVSET	CRF,10
	 XWD	0,CRFBUF
	MOVEI	%03,JOBFFS
	MOVEM	%03,JOBFF
	INBUF	CRF,NUMBUF
	MOVE	%03,CRFBAS
	MOVEM	%03,JOBFF
	MOVE	%03,CRFNAM
	MOVEM	%03,FILNAM
	MOVSI	%03,(SIXBIT /TMP/)
	MOVEM	%03,FILEXT
	SETZM	FILPPN
	LOOKUP	CRF,FILNAM
	 HALT	.
	SETZM	LINNUM
	SETZM	NEXT
	CALL	SETSYM
CRFL30:	CALL	CRFGET
	 JRST	CRFL50
	JUMPE	%00,CRFL50
	TLNE	%00,-1		;SYMBOL?
	 JRST	CRFL31		;  YES
	CAMGE	%00,LINNUM	;NO, VALID LINE NUMBER?
	 HALT	.		;  NO
	MOVEM	%00,LINNUM	;YES, SET IT
	JRST	CRFL30

CRFL31:	TLC	%00,(1B0)
	MOVEM	%00,CRFSAV
	TRZ	%00,600000	;CLEAR FLAGS
CRFL32:	CAML	%00,CRFMIN
	CAML	%00,CRFMAX
	JRST	CRFL30
	HRRZ	%03,JOBFF
	ADDI	%03,WPB+10
	CAMGE	%03,SYMBOT
	JRST	CRFL40
	MOVE	%03,JOBREL
	CORE	%03,
	 HALT	.
	HLRZ	%04,JOBHRL
	ADD	%04,JOBREL
	ASH	%04,-^D10
	CAILE	%03,1(%04)
	JRST	CRFL40
	MOVNI	%07,2
	ADD	%07,SYMLEN
	CAIG	%07,4
	HALT	.
	MOVE	%01,@SYMPNT
	MOVEM	%01,CRFMAX
	MOVE	%01,@VALPNT
	CALL	REMMAC
	HRRZ	%02,JOBREL
CRFL33:	MOVE	%03,-4(%02)
	MOVEM	%03,-2(%02)
	SUBI	%02,1
	SOJGE	%07,CRFL33
	MOVEI	%02,2
	ADDM	%02,SYMBOT
	CALL	SRCHI
	CAML	%00,CRFMAX
	JRST	CRFL30
CRFL40:	CALL	SRCHF		;SEARCH SYMBOL TABLE
	 CAIA
	JRST	CRFL41
	CALL	GETBLK		;GET A STORAGE BLOCK
	HRLI	%01,(POINT 18,,35)
	MOVEM	%01,0(%01)	;STORE TERMINAL
	CALL	INSRTF
	SPUSH	%01
	JRST	CRFL4X

CRFL41:	SPUSH	%01
	MOVE	%01,0(%01)	;GET CURRENT POINTER
	LDB	%02,%01		;PEEK AT LAST
	LDB	%03,[POINT 16,%02,35]
	CAMN	%03,LINNUM	;NEW LINE?
	JRST	CRFL43		;  YES
CRFL4X:	IBP	%01		;NO, BUMP POINTER
	SKIPE	0(%01)		;END OF BLOCK?
	JRST	CRFL42		;  NO
	MOVE	%02,%01		;YES, SAVE CURRENT POINTER
	CALL	GETBLK		;GET ANOTHER BLOCK
	HRLI	%01,(POINT 18,,17)
	HRRZM	%01,0(%02)	;SET LINK
CRFL42:	MOVE	%02,LINNUM	;SET LINE NUMBER
CRFL43:	SPOP	%03		;RESTORE VALUE
	MOVE	%00,CRFSAV
	ANDI	%00,600000	;ISOLATE FLAGS
	IOR	%02,%00		;MERGE INTO VALUE
	DPB	%02,%01		;SET IT
	MOVEM	%01,0(%03)	;STORE NEW POINTER
	JRST	CRFL30

CRFL50:	MOVSI	%03,(1B0)
	MOVEM	%03,CRFSAV
	MOVEI	%07,0
CRFL51:	CALL	GETSTE
	 JRST	CRFL60
	SPUSH	%01
	LDB	%02,[POINT 2,%00,1]
	CAME	%02,CRFTMP
	TLO	%16,HDRBIT
	MOVEM	%02,CRFTMP
	CAIN	%02,2
CRFL52:	CAMG	%00,CRFSAV
	JRST	CRFL53
	MOVEM	%00,CRFSAV+1
	CALL	CRFGET
	 SETOM	%00
	TLC	%00,(1B0)
	MOVEM	%00,CRFSAV
	CALL	CRFGET
	 JFCL
	EXCH	%00,CRFSAV+1
	JRST	CRFL52
CRFL53:	CAME	%00,CRFSAV
	TDZA	%01,%01
	MOVE	%01,CRFSAV+1
	CALL	LSTSTQ
	SPOP	%01
	SPUSH	0(%01)
CRFL54:	MOVN	%03,COLCNT
	CAIL	%03,8
	JRST	CRFL55
	CALL	LSTCR
	CALL	LSTTAB
	MOVE	%02,CRFTMP
	CAIN	%02,2
	SKPLCR	LC.SYM
	 JRST	CRFL55
	CALL	LSTTAB
	CALL	LSTTAB
CRFL55:	ILDB	%11,%01
	JUMPN	%11,CRFL56
	MOVE	%01,0(%01)
	HRLI	%01,(POINT 18,)
	JRST	CRFL55

CRFL56:	ANDI	%11,177777
	DNC	5,%11
	LDB	%11,%01
	TRNE	%11,400000
	LSTICH	"#"
	TRNE	%11,200000
	LSTICH	"*"
	CALL	LSTTAB
	CAME	%01,0(%17)
	JRST	CRFL54
	SPOP	0(%17)
	CALL	LSTCR
	JRST	CRFL51
CRFL60:	HRLOI	%03,377777
	EXCH	%03,CRFMAX
	MOVEM	%03,CRFMIN
	CAME	%03,CRFMAX
	JRST	CRFL20
	SETZM	FILNAM
	RENAME	CRF,FILNAM
	 JFCL
	JRST	SYMTBF

CRFGET:	SOSLE	CRFCNT
	JRST	CRFGE1
	INPUT	CRF,
	STATZ	CRF,IOEOF
	 RETURN
CRFGE1:	ILDB	%00,CRFPNT
	JRST	CPOPJ1

	.LOC
CRFNAM:	BLOCK	1
CRFTMP:	BLOCK	1
CRFMAX:	BLOCK	1
CRFMIN:	BLOCK	1
CRFSAV:	BLOCK	2
	.RELOC
LSTSTQ:	LDB	%02,[POINT 2,%00,1]
	TRC	%02,2
	SKPLCS	LC.SYM
	 JUMPE	%02,LSTSTE
	LSTSYM	%00
	JRST	LSTTAB

LSTSTE:				;LIST SYMBOL TABLE ENTRY
	LSTSYM	1,%00		;LIST IT
	MOVEI	%02,"="
	TLNE	%01,LBLSYM
	MOVEI	%02,SPACE
	CALL	LSTOUT
	MOVEI	%02,"%"
	TLNN	%01,REGSYM	;REGISTER?
	MOVEI	%02,SPACE	;  NO
	CALL	LSTOUT
	LDB	%10,[POINT 16,%01,35]
	TLNE	%01,DEFSYM
	JRST	LSTST1
	LSTSTR	[ASCIZ /******/]
	CAIA
LSTST1:	CALL	LSTWRD
	LDB	%10,SUBPNT
	MOVEI	%02,SPACE
	JUMPL	%07,LSTST2
	SKIPE	%10
	MOVEI	%02,"R"
LSTST2:	CALL	LSTOUT
	MOVEI	%02,SPACE
	JUMPL	%07,LSTST3
	TLNN	%01,DEFSYM!GLBSYM ;DEFINED SYMBOL?
	MOVEI	%02,"U"		;NO. NOTE THAT THIS TRAP WILL
				;BE ENTERED ONLY WHEN THE DEFAULT
				;GLOBALS ARE DISABLED.
	CALL	LSTOUT
	MOVEI	%02,SPACE
	TLNE	%01,GLBSYM
	MOVEI	%02,"G"
LSTST3:	CALL	LSTOUT
	MOVEI	%02,SPACE	;ASSUME NOT DEFAULTED GLOBAL
	JUMPL	%07,LSTST4	;IF LT DON'T CHECK
	TLNE	%01,FLTSYM	;DEFAULTED GLOBAL?
	MOVEI	%02,"X"		;YES
LSTST4:	CALL	LSTOUT		;OUTPUT CHARACTER
	CAILE	%10,1
	CALL	LSTBY1		;OUTPUT SECTION NR WITH 2 LEADING SPACES
	JRST	LSTTAB
	SUBTTL	USER SYMBOL TABLE HANDLERS

MSRCH:	TLOA	%00,ST.MAC
SSRCH:				;SYMBOL SEARCH
	TLZ	%00,ST.MAC
	CAMN	%00,M40DOT	;PC?
	JRST	SSRCH3		;  YES
SRCHF:	MOVE	%07,DELTA	;SET OFFSET FOR INDEX
	MOVE	%02,%07
	ASH	%02,-1		;SET INCREMENT
SSRCH1:	CAMGE	%00,@SYMPNT	;ARE WE LOOKING ABOVE SYMBOL?
	JRST	SSRCH2		;  YES, MOVE DOWN
	CAMG	%00,@SYMPNT	;NO, POSSIBLY AT IT?
	JRST	SSRCH4		;  YES
	TDOA	%07,%02		;  NO, INCREMENT INDEX
SSRCH2:	SUB	%07,%02		;DECREMENT INDEX
	ASH	%02,-1		;DECREMENT DELTA
	CAMG	%07,SYMLEN	;ARE WE OUT OF BOUNDS?
	JUMPN	%02,SSRCH1	;  NO, BRANCH IF NOT THROUGH
	JUMPN	%02,SSRCH2	;  YES, MOVE DOWN IF NOT THROUGH
	SETZB	%01,%02
	SOJA	%07,CPOPJ	;NOT FOUND, SET INDEX AND EXIT NORMAL

SSRCH3:	MOVE	%01,%05
	TLOA	%01,DEFSYM	;SET PC AS DEFINED
SSRCH4:	MOVE	%01,@VALPNT	;FOUND, FETCH VALUE
	LDB	%02,TYPPNT	;SET TYPE POINTER
	JRST	CPOPJ1		;EXIT +1
INSRT:				;INSERT ITEM IN SYMBOL TABLE
	CAMN	%00,M40DOT	;PC?
	JRST	INSRT2		;  YES
INSRTF:	CAMN	%00,@SYMPNT	;IS IT HERE ALREADY?
	JRST	INSRT1		;  YES
	MOVNI	%06,2		;NO, PREPARE TI INSERT
	ADDB	%06,SYMBOT	;DECREMENT POINTER TO BOTTOM OF TABLE
	CAMG	%06,JOBFF	;ARE WE INTRUDING ON THE MACROS?
	CALL	GETCOR		;  YES, GET MORE CORE
	MOVE	%06,SYMBOT
	HRLI	%06,2(%06)	;SET UP BLT
	BLT	%06,@SYMPNT	;MOVE LOWER SYMBOLS DOWN
	CALL	SRCHI		;RE-INITIALIZE THE POINTERS
	ADDI	%07,2		;COMPENSATE FOR SHIFT
	MOVEM	%00,@SYMPNT	;STORE SYMBOL
INSRT1:	MOVEM	%01,@VALPNT	;STORE VALUE
	RETURN

INSRT2:	MOVE	%05,%01		;".", SET PC
	AND	%05,[PCMASK]	;MAKE SURE ITS CLEAN
	RETURN
SRCHI:				;INITIALIZE FOR SEARCH
	SPUSH	%01		;STACK WORKING REGISTERS
	SPUSH	%02
	MOVE	%01,SYMTOP	;GET THE TOP LOCATION
	SUB	%01,SYMBOT	;COMPUTE THE DIFFERENCE
	MOVEM	%01,SYMLEN	;SAVE IT
	MOVEI	%02,1		;SET LOW BIT
	LSH	%02,1		;SHIFT OVER ONE
	TDZ	%01,%02		;CLEAR CORRESPONDING ONE
	JUMPN	%01,.-2		;TEST FOR ALL BITS CLEARED
	MOVEM	%02,DELTA	;END, SAVE LEADING BIT FOR SEARCH OFFSET
	MOVE	%01,SYMBOT	;GET THE BASE
	HRLI	%01,(Z (%07))	;SET INDEX
	MOVEM	%01,SYMPNT	;SET SYMBOL POINTER
	SUBI	%01,1
	MOVEM	%01,VALPNT	;SET VALUE POINTER
	SPOP	%02		;RESTORE REGISTERS
	SPOP	%01
	RETURN			;EXIT


GETSTE:				;GET SYMBOL TABLE ENTRY
	ADDI	%07,2		;MOVE UP TWO
	CAML	%07,SYMLEN	;TEST FOR END
	RETURN			;  YES, EXIT
	MOVE	%00,@SYMPNT
	MOVE	%01,@VALPNT
	LDB	%02,TYPPNT
	JRST	CPOPJ1		;OK, PERFORM SKIP-RETURN


	.LOC
SYMPNT:	BLOCK	1		;POINTER TO SYMBOL TABLE MNEMONIC
VALPNT:	BLOCK	1		;POINTER TO SYMBOL TABLE VALUE
SYMLEN:	BLOCK	1		;SYMBOL TABLE LENGTH
DELTA:	BLOCK	1		;BINARY SEARCH OFFSET
	.RELOC
	SUBTTL	CREF HANDLERS

CRFOPD:	TLOA	%15,DEFFLG	;CREF OP DEFINITION
CRFOPR:	TLZ	%15,DEFFLG	;CREF OP REFERENCE
	TLNN	%16,LSTBIT!CRFBIT
	TLNE	%15,P1F
	RETURN
	SPUSH	%00
	TLNN	%00,ST.MAC
	TLO	%00,ST.MAC!ST.LSB
	CALL	CRFREX
	SPOP	%00
	RETURN

CRFDEF:	TLOA	%15,DEFFLG
CRFREF:	TLZ	%15,DEFFLG
	TLNN	%16,LSTBIT!CRFBIT
	TLNE	%15,P1F
	RETURN
	TLNE	%00,ST.MAC!ST.LSB
	RETURN
CRFREX:	SPUSH	%00
	TLNE	%15,DEFFLG
	TRO	%00,400000
	TLNE	%15,DSTFLG
	TRO	%00,200000
	EXCH	%00,LINNUM
	CAME	%00,CRFSAV
	CALL	CRFPUT
	MOVEM	%00,CRFSAV
	EXCH	%00,LINNUM
	CALL	CRFPUT
	SPOP	%00
	RETURN

CRFPUT:	SOSG	CRFCNT
	CALL	CRFDMP
	IDPB	%00,CRFPNT
	RETURN

CRFDMP:	OUTPUT	CRF,
CRFTST:	STATZ	CRF,IODATA!IODEV!IOWRLK!IOBKTL
	 FERROR	[ASCIZ /CREF OUTPUT ERROR/]
	RETURN
	SUBTTL	MEMORY MANAGEMENT

GETCOR:				;GET CORE
	SPUSH	%00		;GET A COULPLE OF WORKING REGISTERS
	SPUSH	%01
	HRRO	%01,JOBREL	;GET TOP OF CURRENT CORE
	MOVEI	%00,CORINC(%01)	;COMPUTE NEXT K
	CORE	%00,		;MAKE A REQUEST
	 FERROR	[ASCIZ /INSUFFICIENT CORE/]
	MOVEI	%00,1(%01)
	SUB	%00,SYMBOT	;COMPUTE NUMBER OF ITEMS TO BE MOVED
	POP	%01,CORINC(%01)	;POP ITEM UP ONE K
	SOJG	%00,.-1		;TEST FOR COMPLETION
	MOVEI	%01,CORINC	;UPDATE POINTERS
	ADDM	%01,SYMBOT
	ADDM	%01,SYMPNT
	ADDM	%01,VALPNT
	ADDM	%01,SYMTOP
	SPOP	%01		;RESTORE REGISTERS
	SPOP	%00
	RETURN			;EXIT


	.LOC
SYMBOT:	BLOCK	1		;SYMBOL TABLE BBASE
SYMTOP:	BLOCK	1		;SYMBOL TABLE TOP
	.RELOC

SETSYM:				;SET SYMBOL TABLE
	HRRZ	%03,JOBREL
	MOVEM	%03,SYMTOP	;SET TOP OF SYMBOL TABLE
	SUBI	%03,2
	MOVEM	%03,SYMBOT	;  AND BOTTOM
	MOVSI	%03,(1B0)
	MOVEM	%03,@SYMBOT	;SET BOTTOM AND
	SETCAM	%03,@SYMTOP	;  TOP BUMPERS
	JRST	SRCHI
	SUBTTL	ENABLE/DISABLE HANDLERS

.ENABL:				; ".ENABL" DIRECTIVE
	TLZ	%15,DISBIT	;SET THIS INDICATOR BIT
	TDZA	%03,%03		;CLEAR AC3 AND SKIP

.DSABL:	MOVEI	%03,1		;  ".DSABL" DIRECTIVE
	HRLM	%03,0(%17)	;SAVE FLAG
	SKIPE	%03		;WAS IT A DISABLE?
	TLO	%15,DISBIT	;YEAH, KLUDGE IT UP SOME MORE

.ENAB1:	CALL	GETEDT		;ARGS, GET ONE
	 JRST	.ENAB2		;  BRANCH IF NULL
	HLRZ	%02,0(%17)	;GET INDEX
	MOVE	%03,EDMSK	;SET REGS
	TLNN	%16,MODBIT	;COMMAND STRING?
	TDOA	%03,%01		;  YES, SET MASK AND SKIP
	TDNN	%03,%01		;NO, SUPPRESSED?
	XCT	[EXP <TROA %12,(%01)>,<TRZA %12,(%01)>](%02)
	 SETZM	%01
	IFDEF	XREL,	<TRO	%12,ED.ABS>
	MOVEM	%03,EDMSK
	SKPEDR	ED.ABS		;ABS?
	TLZ	%05,(PFMASK)	;  YES, JUST IN CASE
	TRNE	%01,ED.LSB
	CALL	.ENAB3
	TRNE	%01,ED.GBL	;DEALING WITH DEFAULT GLOBALS?
	CALL	.ENAB4		;YES
	TRNE	%01,ED.REG	;DEALING WITH DEFAULT REGISTER DEFNS?
	CALL	.ENAB9		;YES
	TLNE	%16,MODBIT
	TRNN	%01,ED.NPP
	CAIA
	CALL	SETRLD
	TRNN	%01,ED.ERF
	JRST	.ENAB1
	MOVE	%13,SYMBEG
	GETCHR
	GETCHR

.ENAB5:	GETCHR
	MOVSI	%03,1
	MOVE	%04,[POINT 7,ERRMNE]

.ENAB6:	LSH	%03,-1
	ILDB	%00,%04
	JUMPE	%00,.ENAB7
	CAME	%00,%14
	JRST	.ENAB6
	XCT	[EXP <ANDCAM %03,ERRSUP>, <IORM %03,ERRSUP>](%02)
	TLO	%02,(1B0)
	JRST	.ENAB5
.ENAB7:	CAMN	%13,SYMEND
	JRST	.ENAB8
	ERRSET	ERR.A
	ANDCAM	%15,ERRSUP
	TLO	%02,(1B0)

.ENAB8:	MOVEI	%03,-1-ERR.P1
	TLZN	%02,(1B0)
	XCT	[EXP <ANDCAM %03,ERRSUP>, <IORM %03,ERRSUP>](%02)
	MOVE	%13,SYMEND
	CALL	SETNB
	JRST	.ENAB1

.ENAB2:	HRRM	%12,EDFLGS
	SKIPN	ARGCNT		;END, ANY ARGS?
	ERRSET	ERR.A		;  NO, ERROR
	RETURN

.ENAB3:				;LSB TEST
	TLNN	%16,MODBIT	;COMMAND STRING?
	ERRSKP	ERR.A		;  YES, ERROR
	JUMPE	%02,LSBINC	;NO, NEW BLOCK IF .ENABL
	RETURN

.ENAB4:				;DEFAULT GLOBALS
	TLNE	%15,DISBIT	;ENABLE DEFAULT GLOBALS?
	TLOA	%16,GBLDIS	;NO.
	TLZ	%16,GBLDIS	;YES
	RETURN

.ENAB9:				;DEFAULT REGISTER STUFF
	TLO	%16,REGBIT	;TELL THE WORLD THAT WE WERE HERE.
	TLNE	%15,DISBIT	;ENABLE?
	JRST	.ENABB		;NO. PARDON THE HEX...

.ENABA:	;SET UP DEFAULT REGISTER DEFINITIONS
	SPUSH	%05		;SAVE AC5 FOR SCRATCH
	MOVEI	%05,0		;INITIALIZE TABLE POINTER

.ENABC:	MOVE	%00,REGTBL(%05)	;GET REGISTER SYMBOL
	CALL	SSRCH		;SRCH FOR IT TO SET UP SYMPNT,VALPNT
	JFCL			;IT DOESN'T REALLY MATTER IF IT'S HERE OR NOT
	TLNE	%01,DFLSYM	;WAS IT ALREADY A DEFAULT SYMBOL?
	JRST	.ENABE		;YES. DON'T CHANGE THEM
	MOVEM	%01,REGSAV(%05)	;SAVE AWAY THE OLD VALUE
	SETZM	%01		;CLEAR WHATEVER WAS THERE BEFORE
	TLO	%01,REGSYM!DEFSYM!DFLSYM ;SET DEFINITION, REGISTER AND
					;DEFAULT BITS
	ADDI	%01,0(%05)	;GENERATE VALUE
	CALL	INSRT		;AND PUT IT INTO THE  TABLE
	CAIGE	%05,7		;AT THE END YET?
	AOJA	%05,.ENABC	;NO, GO BACK FOR MORE.

.ENABE:	SPOP	%05		;RESTORE AC5.
	RETURN			;RETURN

.ENABB:	;DISABLE THE DEFAULT VALUES 
	SPUSH	%05		;GENERATE A SCRATCH REGISTER
	SETZM	%05		;IT'LL BE A POINTER, STARTING AT ZERO

.ENABD:	MOVE	%00,REGTBL(%05)	;GET A REGISTER SYMBOL
	CALL	SSRCH		;FIND IT
	JFCL			;DOESN'T MATTER...
	TLNN	%01,DFLSYM	;IS IT ALREADY A NON-DEFAULT?
	JRST	.ENABF		;YES. DON'T FUTZ AROUND.
	MOVE	%01,REGSAV(%05)	;RESTORE THE OLD VALUE
	CALL	INSRT		;AND STUFF IT BACK IN
	CAIE	%05,7		;END OF TABLE?
	AOJA	%05,.ENABD	;NO, GO BACK FOR MORE
.ENABF:	SPOP	%05		;RESTORE AC5
	RETURN			;AND RETURN

	.LOC
REGSAV:	BLOCK	^D8		;AREA TO STORE REGISTER DEFINITIONS
;WHILE DEFAULTS ARE ENABLED
	.RELOC
GETEDT:				;GET ED TYPE
	CALL	GSARG		;TRY FOR ARGUMENT
	 RETURN			;  MISSED
	HLLZS	%00
	MOVSI	%03,-<EDTBLE-EDTBL>	;SET FOR SEARCH
	CAME	%00,EDTBL(%03)	;MATCH?
	AOBJN	%03,.-1		;  NO
	SETZM	%01
	SKIPL	%03		;FOUND?
	ERRSKP	ERR.A		;  NO, ERROR
	MOVEI	%01,1		;YES, SET FLAG
	LSH	%01,0(%03)	;COMPUTE BIT POSITION
	JRST	CPOPJ1


	DEFINE	EDTGEN	(M,N,E)
<
	XLIST
	ED.'M'N'E=	1_.
	GENM40	M,N,E
	LIST
>


EDTBL:
	PHASE	0

	EDTGEN	L,S,B
	EDTGEN	F,P,T
	EDTGEN	A,B,S
	EDTGEN	C,O,M
	EDTGEN	N,P,P
	EDTGEN	E,R,F
	EDTGEN	A,M,A
	EDTGEN	P,I,C
	EDTGEN	T,I,M
	EDTGEN	L,C
	EDTGEN	W,R,P
	EDTGEN	G,B,L
	EDTGEN	R,E,G

	DEPHASE
EDTBLE:

	.LOC
EDBLK:
EDFLGS:	BLOCK	1		;FLAGS
EDMSK:	BLOCK	1		;MASK
EDLVL:	BLOCK	1		;LISTING LEVEL
ERRSUP:	BLOCK	1
EDLEN=	.-EDBLK

EDSAVE:	BLOCK	EDLEN		;STORAGE FOR ABOVE
	.RELOC
	SUBTTL	LOCAL SYMBOL HANDLERS

LSBTST:	SKPEDR	ED.LSB
	RETURN
	TLNE	%15,LSBFLG
LSBINC:				;LOCAL SYMBOL BLOCK INCREMENT
	AOS	LSBNUM		;INCREMENT BLOCK NUMBER
	MOVEI	%03,LSRNGE-1
	ADD	%03,%05
	MOVEM	%03,LSBMAX	;SET MAX RANGE
	MOVEI	%03,^D64-1
	MOVEM	%03,LSBGEN	;PRESET GENERATED SYMBOL NUMBER
	TLZ	%15,LSBFLG
	RETURN

	.LOC
LSBNUM:	BLOCK	1
LSBGEN:	BLOCK	1
LSBMAX:	BLOCK	1		;MAX RANGE
	.RELOC
	SUBTTL	LISTING CONTROL

.LIST:	TDZA	%03,%03		;  ".LIST" DIRECTIVE
.NLIST:	MOVEI	%03,1		;  ".NLIST" DIRECTIVE
	HRLM	%03,0(%17)	;SAVE FLAG
.LIST1:	CALL	GETLCT		;ARGS, GET ONE
	 JRST	.LIST2		;  BRANCH IF NULL
	HLRZ	%02,0(%17)	;GET INDEX
	MOVE	%03,LCMSK	;SET REGS
	TLNN	%16,MODBIT	;COMMAND STRING?
	TDOA	%03,%01		;  YES, SET MASK AND SKIP
	TDNN	%03,%01		;NO, SUPPRESSED?
	XCT	[EXP <TLZA %12,(%01)>,<TLOA %12,(%01)>](%02)
	 SETZM	%01
	MOVEM	%03,LCMSK
	JRST	.LIST1

.LIST2:	SKIPE	ARGCNT		;END, ANY ARGS?
	JRST	LPTINF
	HLRZ	%02,0(%17)	;SET INDEX
	TLNE	%16,MODBIT	;COMMAND STRING?
	JRST	.LIST3		;  NO
	SETOM	%03
	XCT	[EXP <HRRZM %03,LCLVL>, <HLLZM %03,LCLVL>](%02)
	RETURN

.LIST3:	XCT	[EXP <AOS LCLVL>,<SOS LCLVL>](%02)
.LIST4:	SKPLCR	LC.LD		;LISTING DIRECTIVE SUPPRESSED?
	SETOM	LCLVLB		;  YES, FLAG IT
	RETURN

SETLC0:				;"SETLCT" OPDEF
	EXCH	%03,LCTST	;FETCH TEST WORD
	TRO	%03,@JOBUUO	;SET BIT(S)
	EXCH	%03,LCTST	;RESTORE
	RETURN

.PAGE:
	HRROS	FFCNT
	JRST	.LIST4
GETLCT:				;GET LC TYPE
	CALL	GSARG		;TRY FOR ARGUMENT
	 RETURN			;  MISSED
	MOVSI	%03,-<LCTBLE-LCTBL>	;SET FOR SEARCH
	CAME	%00,LCTBL(%03)	;MATCH?
	AOBJN	%03,.-1		;  NO
	SETZM	%01
	SKIPL	%03		;FOUND?
	ERRSKP	ERR.A		;  NO, ERROR
	MOVEI	%01,1		;YES, SET FLAG
	LSH	%01,0(%03)	;COMPUTE BIT POSITION
	JRST	CPOPJ1

	DEFINE	LCTGEN	(M,N,E)
<
	XLIST
	LC.'M'N'E=	1_.
	GENM40	M,N,E
	LIST
>
LCTBL:
	PHASE	0

	LCTGEN	S,E,Q
	LCTGEN	L,O,C
	LCTGEN	B,I,N
	LCTGEN	S,R,C
	LCTGEN	C,O,M
	LCTGEN	B,E,X
	LCTGEN	M,D,
	LCTGEN	M,C,
	LCTGEN	M,E,
	LCTGEN	M,E,B
	LCTGEN	C,N,D
	LCTGEN	L,D,
	LCTGEN	T,T,M
	LCTGEN	T,O,C
	LCTGEN	S,Y,M

	DEPHASE
LCTBLE:

	.LOC
LCBLK:
LCFLGS:	BLOCK	1		;FLAGS
LCMSK:	BLOCK	1		;MASK
LCLVL:	BLOCK	1		;LISTING LEVEL
LCLEN=	.-LCBLK

LCSAVE:	BLOCK	LCLEN		;STORAGE FOR ABOVE
LCTST:	BLOCK	1		;TEST WORD
LCLVLB:	BLOCK	1
	.RELOC
	SUBTTL	CONDITIONALS

.IIF:				;IMMEDIATE IF
	CALL	CNDSET
	CALL	TCON		;TEST ARGS
	 JRST	.IIF1		;FALSE
	MOVE	%02,%13		;FETCH CHARACACTER POINTER
	CAIN	%14,","		;SITTING ON COMMA?
	IBP	%02		;  YES, MOVE ONE CHAR PAST
	CALL	TGARG		;TEST FOR ARG
	 JRST	OPCERR		;  MISSING, ERROR
	SKIPE	%03,CLILBL
	ERRSET	ERR.Q
	SKPLCR	LC.CND
	 MOVEM	%02,CLIPNT	;SAVE NEW START
	JRST	STMNT

.IIF1:	TLO	%15,NQEFLG	;UNSAT, IGNORE REST OF LINE
	JRST	.ENDCX



.IFZ:
.IFEQ:
.IFNZ:
.IFNE:
.IFG:
.IFGT:
.IFL:
.IFLT:
.IFGE:
.IFLE:
.IFDF:
.IFNDF:
	CALL	CNDSET		;TEST LABEL
	HRLZS	%00		;LEFT JUSTIFY ARGUMENT
	SKIPE	CNDWRD		;SUPPRESSED?
	TLOA	%15,NQEFLG	;  YES, BUMP LEVEL BUT IGNORE
	CALL	TCONF		;NO, PROCESS ARGUMENT
	 JRST	CNDXF		;  FALSE
	JRST	CNDXT		;TRUE

.IF:				;".IF" DIRECTIVE
	CALL	CNDSET
	SKIPE	CNDWRD		;SUPPRESSED?
	TLOA	%15,NQEFLG	;  YES, BUMP LEVEL BUT IGNORE
	CALL	TCON		;TEST
CNDXF:	 SKIPA	%03,[-1]	;FALSE
CNDXT:	SETZM	%03
	MOVE	%04,CNDMSK
	LSHC	%03,-1		;SET HIGH ORDER BIT OF MASK
	MOVEM	%04,CNDMSK
	MOVE	%04,CNDWRD
	LSHC	%03,-1		;DITTO FOR TEST WORD
	MOVEM	%04,CNDWRD
	AOS	%10,CNDLVL	;BUMP LEVEL
	JRST	.ENDCF
.IFT:	SKIPA	%03,CNDMSK	;".IFT"
.IFF:	SETCM	%03,CNDMSK	;".IFF"
	CAIA
.IFTF:	SETZM	%03
	HLLM	%03,0(%17)	;PROTECT IT
	CALL	CNDSET		;TEST FOR LABEL
	LDB	%03,[POINT 1,0(%17),0]	;GET SIGN BIT
	DPB	%03,[POINT 1,CNDWRD,0]
	JRST	.ENDCX


.ENDC:				;".ENDC" DIRECTIVE
	SKIPG	CNDLVL		;IN CONDITIONAL?
	JRST	OPCERR		;  NO
	MOVE	%03,CNDMSK
	LSH	%03,1		;MOVE MASK BITS DOWN
	MOVEM	%03,CNDMSK
	MOVE	%03,CNDWRD
	LSH	%03,1		;DITTO FOR TEST WORD
	MOVEM	%03,CNDWRD
	SOS	%10,CNDLVL
.ENDCF:	HRLI	%10,1		;PRINT BYTE
	CALL	SETPF1

.ENDCX:	SKIPG	LCLVL
	SKPLCS	LC.CND
	 RETURN
	SKIPN	%03,CLILBL
	SETLCT	LC.CND
	MOVEM	%03,CLIPNT+1
	RETURN

CNDSET:				;SET PRIOR CONDITIONS
	SKPLCR	LC.CND		;CONDITIONAL SUPPRESSION?
	 SKIPE	CNDWRD		;SKIP IF IN SAT MODE
	SETZM	CLILBL
	RETURN			;NO
TCON:				;TEST CONDITIONAL
	CALL	GSARG		;TEST FOR ARGUMENTS
	 JRST	TCON2		;  NO, ERROR
TCONF:	SETZM	CNDREQ		;CLEAR "REQUEST"
	SETZM	CNDRES		;  AND RESULT
	MOVSI	%01,-<TCONTE-TCONT>	;SET FOR SCAN
TCON1:	HLLZ	%02,TCONT(%01)	;TRY LEFT HALF
	CAMN	%00,%02		;MAKE IT?
	JRST	TCON4		;  YES
	HRLZ	%02,TCONT(%01)	;NO, TRY RIGHT HALF
	CAMN	%00,%02
	JRST	TCON3
	AOBJN	%01,.+1
	AOBJN	%01,TCON1	;LOOP IF NOT END
TCON2:	ERRSET	ERR.A		;NO MATCH, ERROR
	RETURN

TCON3:	SETOM	CNDREQ		;RIGHT HALF, "FALSE"
TCON4:	MOVE	%02,TCONT+1(%01)	;FOUND, GET ADDRESS
	HLLZM	%02,CNDINS	;SAVE POSSIBLE INSTRUCTION
	CALL	0(%02)		;CALL HANDLER
	MOVE	%03,CNDREQ	;GET REQUEST
	CAMN	%03,CNDRES	;MATCH?
	AOS	0(%17)		;  YES, SKIP-RETURN
	RETURN


	DEFINE	GTCON	(A,B,C,D,E,F,ADDR)
<
	XLIST
	GENM40	A,B,C,D,E,F
	ADDR
	LIST
>

TCONT:
	GTCON	E,Q, ,N,E, ,<CAIE  %10,TCONA>
	GTCON	Z, , ,N,Z, ,<CAIE  %10,TCONA>
	GTCON	G,T, ,L,E, ,<CAIG  %10,TCONA>
	GTCON	G, , ,L,E, ,<CAIG  %10,TCONA>
	GTCON	L,T, ,G,E, ,<CAIL  %10,TCONA>
	GTCON	L, , ,G,E, ,<CAIL  %10,TCONA>
	GTCON	D,F, ,N,D,F,<Z TCONS>
	GTCON	B, , ,N,B, ,<Z TCONB>
	GTCON	I,D,N,D,I,F,<Z TCOND>
	GTCON	L,I, ,N,L, ,<Z TCONL>
	GTCON	E,N, ,D,S, ,<Z TCONED>

TCONTE:
TCONA:				;ARITHMETIC CONDITIONALS
	CALL	TGARG		;TEST FOR ARGUMENT
	 ERRSET	ERR.A		;  NULL, ERROR
	CALL	ABSEXP		;EVALUATE THE EXPRESSION
	HRROS	ARGCNT
	LSH	%10,+^D<36-16>
	ASH	%10,-^D<36-16>	;EXTEND SIGN
	XCT	CNDINS		;EXECUTE INSTRUCTION
	 SETOM	CNDRES		;  FALSE
	RETURN


TCONS:				;TEST SYMBOLIC CONDITIONALS
	CALL	TGARG		;TEST FOR ANOTHER ARG
	 ERRSET	ERR.A		;  NO, ERROR
	MOVE	%01,CNDREQ
	MOVEM	%01,CNDRES
	SPUSH	CNDREQ
TCONS1:	CALL	GETSYM
	SKIPN	%00
	ERRSKP	ERR.A
	CALL	SSRCH		;SEARCH THE SYMBOL TABLE
	 SETZ	%01,		;  NOT THERE OR GETSYM ERROR
	SKIPE	%00
	CALL	CRFREF
	TLNE	%01,MDFSYM
	ERRSET	ERR.D		;FLAG IF MULTI-DEFINED SYM
	TLNE	%01,DEFSYM	;FLAGGED AS DEFINED?
	TDZA	%01,%01
	SETOM	%01
	SPOP	%00
	CAME	%01,CNDRES
	SETCAM	%00,CNDRES
	MOVE	%01,CNDREQ
	CAIN	%14,"&"
	JRST	TCONS2
	CAIE	%14,"!"
	RETURN
	SETCA	%01,
TCONS2:	SPUSH	%01
	CALL	GETNB
	JRST	TCONS1
TCONB:				;.IFB, .IFNB
	CALL	TGARG
	 RETURN			;  NO ARG, OK
	CALL	GGARG
	CALL	SETNB		;BYPASS ALL BLANKS
	CAIE	%14,0
	SETOM	CNDRES
	JRST	PGARG

TCOND:
	CALL	TGARG
	 ERRSET	ERR.A
	CALL	GGARG
	SPUSH	ARGBEG
	HRRZ	%06,ARGCHC	;PICK UP CHARACTER COUNT
	JUMPE	%06,TCOND2	;JUMP IF ARGUMENT IS NON-NULL
	MOVE	%00,%14
	GETCHR
	JUMPN	%14,.-2
TCOND2:	GETNB
	CALL	TGARG
	 ERRSET	ERR.A
	CALL	GGARG
	SPOP	%00
TCOND1:	SETCHR
	IBP	%13
	MOVE	%02,%14
	EXCH	%00,%13
	SETCHR
	IBP	%13
	EXCH	%00,%13
	CAME	%02,%14
	SOSA	CNDRES		;MISSED
	JUMPN	%14,TCOND1
	CALL	PGARG
	SPUSH	%13		;END OF SECOND ARGUMENT
	CALL	PGARG		;RESTORE FIRST ARGUMENT
	SPOP	%13
	JRST	SETCHR		;SET FINAL CHARACTER
TCONL:
	CALL	GETLCT
	 JRST	TCONL1
	SKPLCR	0(%01)
	 SETOM	CNDRES
	RETURN

TCONL1:	SKIPGE	LCLVL
	SETOM	CNDRES
	RETURN

TCONED:
	CALL	GETEDT
	 JFCL
	SKPEDS	0(%01)
	 SETOM	CNDRES
	RETURN


	.LOC
CNDMSK:	BLOCK	1		;MASK BITS SET BY .IF
CNDWRD:	BLOCK	1		;CNDMSK, ADJUSTED FOR .IFT, ETC.

CNDLVL:	BLOCK	1		;CONDITIONAL LEVEL COUNT
CNDREQ:	BLOCK	1		;CONDITIONAL "REQUEST" TYPE
CNDRES:	BLOCK	1		;RESULT
CNDINS:	BLOCK	1		;STORAGE FOR INSTRUCTION
CNDMEX:	BLOCK	1		;MEXIT IN PROGRESS
	.RELOC
	SUBTTL	MACRO STORAGE HANDLERS

GETBLK:				;GET A BLOCK FOR MACRO STORAGE
	SKIPE	%01,NEXT	;ANY REMNANTS OF GARBAGE COLLECTION?
	JRST	GETBL1		;  YES, RE-USE
	MOVEI	%01,WPB
	ADDB	%01,JOBFF	;UPDATE FREE LOCATION POINTER
	CAML	%01,SYMBOT	;ANY ROOM?
	CALL	GETCOR		;  NO, GET MORE CORE
	SUBI	%01,WPB		;POINT TO START OF BLOCK
	SETZM	WPB-1(%01)	;CLEAR VECTOR
GETBL1:	HLL	%01,TXTBYT	;FORM BYTE POINTER
	MOVEM	%01,MWPNTR	;SET NEW BYTE POINTER
	HRLI	%01,-<WPB-1>	;GET SET TO INITIALIZE BLOCK
	SETOM	0(%01)		;CLEAR ENTRY
	AOBJN	%01,.-1		;SET ALL EXCEPT LAST TO -1
	PUSH	%17,0(%01)	;GET TOP
	POP	%17,NEXT	;SET FOR NEXT BLOCK
	SETZM	0(%01)		;CLEAR LAST WORD
	MOVE	%01,MWPNTR	;RETURN POINTER IN %01
	RETURN			;EXIT

TXTBYT:	POINT	8,,7
ASCBYT:	POINT	7,,6

INCMAC:				;INCREMENT MACRO STORAGE
	AOSA	0(%01)

DECMAC:				;DECREMENT MACRO STORAGE
	SOSL	0(%01)		;TEST FOR END
	RETURN			;  NO, EXIT

REMMAC:				;REMOVE MACRO STORAGE
	SPUSH	%01		;SAVE POINTER
REMMA1:	HRLS	%01		;SAVE CURRENT POINTER
	HRR	%01,WPB-1(%01)	;GET NEXT LINK
	TRNE	%01,-1		;TEST FOR END (NULL)
	JRST	REMMA1		;  NO
	HLRZS	%01		;YES, GET RETURN POINTER
	HRL	%01,NEXT	;GET CURRENT START OF CHAIN
	HLRM	%01,WPB-1(%01)	;STORE AT TOP
	SPOP	%01		;RESTORE BORROWED REGISTER
	HRRZM	%01,NEXT	;SET NEW START
	RETURN			;EXIT

	.LOC
NEXT:	BLOCK	1		;BLOCK CHAIN POINTER
MWPNTR:	BLOCK	1		;MACRO WRITE POINTER
	.RELOC
	SUBTTL	REPEAT/MACRO ROUTINES

CF.SPC=	200			;HIGH ORDER BIT INVOKES SPECIAL MODE
CF.DSY=	100			;DUMMY SYMBOL
CF.TRP=	040			;FLAGS END OF PROTOTYPE
CF.ARG=	020			;TRAPPED AT READMC/SETASC

CH.MAC=	CF.SPC!CF.TRP!T.MACR	;END OF MACRO
CH.RPT=	CF.SPC!CF.TRP!T.REPT	;END OF REPEAT
CH.IRP=	CF.SPC!CF.TRP!T.IRP	;END OF IRP

CH.EOE=	CF.SPC!CF.ARG!1		;END OF ENTRY
CH.FIN=	CF.SPC!CF.ARG!2		;IRP ARG DELIMITER
; THIS MACRO PUSHES THE ITERATION COUNT FOR REPEAT BLOCKS ONTO A PSEUDO-STACK CALLED REPBLK.
;THE POINTER IS CALLED REPCT.  THE COUNT IS ASSUMED TO BE IN REGISTER 'REG'.
	DEFINE	RCTPSH	(REG)	
<
	XLIST
	AOS	REPCT		;PUSH THE POINTER
	MOVEM	REG,@REPCT	;STACK THE COUNT
	AOS	@REPCT		;COMPENSATE FOR THE XTRA ENDM THAT WILL BE SEEN
	SETOM	REPSW		;TELL EVERYBODY WE'RE IN A REPEAT BLOCK
	LIST
>
.REPT:				;.REPT DIRECTIVE
	CALL	ABSEXP		;EVALUATE ABSOLUTE EXPRESSION
	TRNE	%10,1B20	;NEGATIVE?
	SETZM	%10		;  YES, SET TO ZERO
	RCTPSH	%10		;PUSH THE COUNT
	SPUSH	%10		;SAVE
	PUSH	%17,[0]		;TO KEEP .RIF HAPPY
.REPTF:	CALL	GETBLK		;GET STORAGE
	PUSH	%17,MWPNTR	;SAVE STARTING LOCATION
	SETZM	@MWPNTR		;CLEAR LEVEL COUNT
	AOS	MWPNTR		;START IN NEXT WORD
	SETZM	@MWPNTR		;CLEAR SECOND WORD
	AOS	MWPNTR
	CALL	TMCLBL
	 SETLCT	LC.MD!LC.MC	;FLAG AS CALL
	SETZM	MACCNT		;INIT ARG COUNT
.REPT1:	CALL	ENDL
	CALL	GETMLI		;GET A LINE
	SETLCT	LC.MD!LC.MC	;FLAG FOR LISTING
	CAIN	%03,DCRPT
	AOS	MACCNT
	CAIN	%03,DCRPTE
	SOSL	MACCNT		;TEST FOR END
	TLNE	%15,ENDFLG	;OR END OF INPUT
	JRST	.REPT2		;  YES
	MOVE	%13,LINPNT
	SETCHR
	CAIA
	GETCHR			;STORE LINE
	WCIMT	0(%14)
	JUMPN	%14,.-2		;TEST FOR EOL
	JRST	.REPT1

.REPT2:	MOVEI	%14,CH.RPT
.REPTX:	WCIMT	0(%14)		;MARK END OF STORAGE
	CALL	MPUSH		;STACK
	POP	%17,MSBTXP	;SET TEXT POINTER
	POP	%17,MSBAUX	;  AND .RIF EXPRESSION
	POP	%17,MSBCNT	;  AND COUNT
	HRLZS	MSBCNT		;MOVE COUNT TO LEFT HALF
	JRST	MPOP		;TEST FOR END
ENDRPT:				;END OF REPEAT

ENDIRP:	AOS	%03,MSBCNT	;BUMP COUNT, PLACE IN REG
	HLRZ	%04,%03		;GET END VALUE
	CAIGE	%04,0(%03)	;FINISHED?
	JRST	CPOPJ1		;  YES
	MOVE	%03,MSBTXP	;NO, SET READ POINTER
	ADDI	%03,2
	MOVEM	%03,MSBMRP
	RETURN

.ENDM:
.ENDR:	JRST	OPCERR		;CAN'T OCCUR OUTSIDE OF DEFINITION
.IRP:	TDZA	%03,%03		;".IRP", CLEAR FLAG
.IRPC:	MOVEI	%03,1		;".IRPC", SET FLAG
	ADDI	%03,1
	MOVEM	%03,IRPTYP	;STORE IT
	CALL	TGARG		;TEST FOR GENERAL ARGUMENT
	 JRST	OPCERR		;  MISSING, ERROR
	CALL	GGARG		;PROCESS THE ARGUMENT
	SETZM	ARGCNT
	CALL	PROMA		;PROCESS DUMMY ARGS
	CALL	PGARG
	SETZM	IRPCNT
	SETZM	IRPMAX
	CALL	GETBLK
	MOVEM	%01,IRPBEG	;SAVE START

.IRP1:	AOS	%03,IRPCNT	;BUMP COUNT
	HRRZ	%04,MACCNT	;GET ARGUMENT COUNT
	CAMLE	%03,%04		;THROUGH?
	JRST	.IRP2		;  YES
	CALL	TGARG
	 JFCL
	CALL	GGARG
	CALL	MCFINF
	WCIMT	CH.FIN
	HRRZ	%03,ARGCNT
	CAMLE	%03,IRPMAX
	MOVEM	%03,IRPMAX
	CALL	PGARG
	JRST	.IRP1

.IRP2:	WCIMT	CH.FIN
	EXCH	%12,IRPMAX	;GET THE ITERATION COUNT WHERE WE CAN USE IT AND.....
	RCTPSH	%12		;PUSH IT ONTO THE 'STACK'
	EXCH	%12,IRPMAX	;NOW PUT THINGS BACK WHERE THEY BELONG.
	SPUSH	IRPMAX
	SPUSH	IRPBEG
	CALL	TMCLBL
	 SETLCT	LC.MD!LC.MC
	CALL	ENDL		;POLISH OFF LINE

	CALL	GETBLK
	SPUSH	MWPNTR
	CALL	PROMT		;PROCESS TEXT
	 SETLCT	LC.MD!LC.MC	;ARGUMENT

	MOVEI	%14,CH.IRP	;MARK AS .IRP
	JRST	.REPTX		;EXIT THROUGH .REPT
.MACR:				;.MACR DIRECTIVE
.MACRO:
	CALL	GSARG		;GET THE NAME
	 JRST	OPCERR
MACROF:	MOVEM	%00,MACNAM	;SAVE NAME
	CALL	MSRCH
	 MOVSI	%01,MAOP	;RETURN POINT IF NAME NOT FOUND
	LDB	%02,TYPPNT	;ISOLATE TYPE
	CAIE	%02,MAOP	;MACRO?
	JRST	OPCERR		;  NO, ERROR
	TRNE	%01,-1
	CALL	DECMAC
	HLLM	%01,0(%17)	;SAVE FLAGS, ETC.
	CALL	GETBLK
	HLL	%01,0(%17)	;RESTORE FLAGS
	CALL	INSRT
	CALL	CRFOPD
	CALL	PROMA		;PROCESS MACRO ARGUMENTS

	CALL	TMCLBL
	 SETLCT	LC.MD
	CALL	ENDL		;WRITE OUT THE LINE

	CALL	PROMT		;PROCESS MACRO TEXT
	 SETLCT	LC.MD		;  ARGUMENT

	WCIMT	CH.MAC		;FLAG END
	CALL	GSARG		;ARGUMENT?
	 RETURN			;  NO
	CAME	%00,MACNAM	;YES, DOES IT MATCH NAME?
	ERRSET	ERR.A		;  NO, ERROR
	RETURN


PROMA:				;PROCESS MACRO ARGUMENTS
	SETZM	DSYLST		;MARK END OF LIST
	SETZM	MACCNT		;ZERO NUMBER
PROMA1:	CALL	TGARG		;TEST FOR ARGUMENT
	 RETURN			;  NO
	CAIE	%14,"?"		;YES, PERHAPS GENERATION?
	JRST	PROMA2		;NO
	MOVN	%03,MACCNT	;YES, GET COUNT
	MOVSI	%04,(1B0)
	LSH	%04,0(%03)	;SHIFT BIT
	IORM	%04,MACCNT	;SAVE IT
	CALL	GETNB		;BYPASS UNARY
PROMA2:	CALL	GSARGF		;GET THE ARGUMENT
	 RETURN			;  ERROR
	AOS	%03,MACCNT	;OK, BUMP COUNT
	MOVEM	%00,DSYLST-1(%03)	;STORE MNEMONIC
	SETZM	DSYLST(%03)
	JRST	PROMA1		;TRY FOR MORE

TMCLBL:	MOVE	%03,@0(%17)
	SKPLCR	(%03)
	SKIPN	%03,CLILBL
	RETURN
	MOVEM	%03,CLIPNT+1
	JRST	CPOPJ1
PROMT:				;PROCESS MACRO TEXT
	SETZB	%03,@MWPNTR	;CLEAR LEVEL COUNT
	AOS	MWPNTR
	EXCH	%03,MACCNT	;SET AND CLEAR COUNT
	MOVEM	%03,@MWPNTR
	AOS	MWPNTR
PROMT1:	CALL	GETMLI		;PUTS THE TYPE BITS IN AC3
	XCT	@0(%17)		;EXECUTE ARGUMENT
	CAIN	%03,DCMAC	;MACRO/RPT TYPE INSTRUCTION?
	AOS	MACCNT		;YES
	CAIN	%03,DCMACE	;END?
	SOSL	MACCNT		;YES
	TLNE	%15,ENDFLG	;END ENCOUNTERED?
	JRST	CPOPJ1		;YES. RETURN AND BYPASS ARGUMENT
	CAIN	%03,DCMCAL	;".MCALL"?
	SKIPN	MCACNT		;  YES, NESTED?
	CAIA			;  NO
	CALL	MCALLT		;YES, TEST FOR ADDITIONS
	MOVE	%13,LINPNT
	SETCHR
PROMT2:	CALL	GETSYM
	JUMPE	%00,PROMT4
	SETZM	%02
PROMT3:	SKIPN	%03,DSYLST(%02)
	JRST	PROMT4
	CAME	%03,%00
	AOJA	%02,PROMT3
	SOS	CONCNT
	WCIMT	CF.SPC!CF.DSY+1(%02)
	SOS	CONCNT
	SKIPA	%13,SYMEND
PROMT4:	MOVE	%13,SYMBEG
	SETCHR
PROMT5:	CAMN	%13,SYMEND
	JRST	PROMT6
	WCIMT	0(%14)
	GETCHR
	JRST	PROMT5

PROMT6:	JUMPE	%14,PROMT8
	SKPEDR	ED.COM
	 CAIE	%14,";"
	JRST	PROMT7
	GETCHR
	CAIN	%14,";"
	JRST	PROMT8
	WCIMT	";"
	JRST	PROMT2

PROMT7:	CAIN	%14,"'"
	AOSA	CONCNT
	WCIMT	0(%14)
	GETCHR
	JRST	PROMT2

PROMT8:	WCIMT	0
	SKIPE	ARGEND
	 HALT	.
	SETCHR
	SKIPGE	MACCNT
	JRST	GETSYM
	CALL	ENDL
	JRST	PROMT1
MACROC:				;MACRO CALL
	CALL	SETPF0
	TRNN	%01,-1		;EMPTY?
	JRST	OPCERR		;OP VALUE = 0?
	SPUSH	%01		;STACK ADDRESS
	MOVE	%03,1(%01)
	MOVEM	%03,MACCNT	;SET COUNT
	CALL	INCMAC
	CALL	GETBLK
	SPUSH	MWPNTR		;STACK START ADDRESS
	CALL	MCFIN
	WCIMT	CH.FIN		;PAD ANY MISSING ARGUMENTS
	MOVEI	%14,CH.MAC
	CALL	MPUSH
	POP	%17,MSBAUX
	SPOP	%01
	HLL	%01,TXTBYT
	MOVEM	%01,MSBTXP
	ADDI	%01,2
	MOVEM	%01,MSBMRP
	MOVE	%03,ARGCNT
	HRLZM	%03,MSBCNT		;SET FOR ".NARG"
	CALL	TMCLBL
	 SETLCT	LC.MC
	RETURN

MCFIN:	SETZM	IRPTYP
MCFINF:	SETZM	ARGCNT
	SETZM	ARGINC
MCFIN1:	MOVE	%03,IRPTYP
	CALL	@[EXP MCFMAC, MCFIRP, MCFIRC](%03)
	 RETURN
	WCIMT	CH.EOE
	JRST	MCFIN1

MCFIRC:	JUMPE	%14,MCFIRX
	WCIMT	0(%14)
	AOS	ARGCNT
	GETCHR
	JRST	CPOPJ1

MCFMAC:	MOVE	%03,ARGCNT
	ADD	%03,ARGINC
	SUB	%03,MACCNT
	TRNN	%03,(1B0)
	RETURN
MCFIRP:	CALL	TGARG
MCFIRX:	 AOSA	ARGINC
	JRST	MCFOK
	CALL	MCFGEN
	 SKIPN	IRPTYP
	JRST	CPOPJ1
	RETURN
MCFOK:	AOS	0(%17)		;ALL GOOD EXITS NOW
	CAIN	%14,"\"		;TEST UNARIES
	JRST	MCFOK2
	CALL	GGARG
	JUMPE	%14,MCFOK1
	WCIMT	0(%14)
	GETCHR
	JUMPN	%14,.-2
	JRST	PGARG

MCFOK1:	CALL	MCFGEN
	 JFCL
	JRST	PGARG

MCFOK2:	CALL	GETNB		;"\", BYPASS
	CAIN	%14,"\"		;DOPBLE?
	JRST	MCFOK3		;  YES
	CALL	ABSEXP		;NO, EVALUATE EXPRESSION
	HRROS	ARGCNT
	MOVE	%03,%10		;SET
	MOVE	%01,CRADIX	;SET CHARACTERISTICS
	HRLI	%01,"0"
	JRST	MCFDIV

MCFOK3:	CALL	GETNB		;BYPASS SECOND "\"
	CALL	ABSEXP
	HRROS	ARGCNT
	MOVE	%00,%10		;GET VALUE
	CALL	M40SIX		;CONVERT TO SIXBIT
	MOVE	%03,%00
	MOVE	%01,[XWD 40,100]
	JRST	MCFDIV

MCFDIV:	IDIVI	%03,0(%01)	;DIVIDE NUMBER
	HRLM	%04,0(%17)	;STACK REMAINDER
	SKIPE	%03		;ANY MORE?
	CALL	MCFDIV		;  YES
	HLRZ	%03,0(%17)	;NO,RETRIEVE NUMBER
	HLRZ	%04,%01		;GET CONSTANT
	ADD	%03,%04		;ADD IT IN
	WCIMT	0(%03)		;STORE IT
	RETURN


MCFGEN:				;GENERAT SYMBOL
	HLLZ	%03,MACCNT
	MOVE	%04,ARGCNT
	ADD	%04,ARGINC
	LSH	%03,-1(%04)
	JUMPE	%03,CPOPJ
	JUMPG	%03,CPOPJ1
	AOS	%03,LSBGEN	;BUMP GENERATED SYMBOL NUMBER
	MOVE	%01,[XWD "0",^D10]	;SET CHARACTERISTICS
	CALL	MCFDIV		;OUTPUT
	WCIMT	"$"		;COMPLETE GENED SYMBOL
	JRST	CPOPJ1
.NARG:
	CALL	GSARG		;FETCH SYMBOL
	 JRST	OPCERR		;  MISSING, ERROR
	SPUSH	%00		;STACK THE SYMBOL
	HLRZ	%10,MSBCNT	;GET COUNT
	JRST	ASGMTF		;EXIT THROUGH "="

.NCHR:
	CALL	GSARG		;GET THE SYMBOL
	 JRST	OPCERR		;  MISSING, ERROR
	SPUSH	%00		;OK, STACK IT
	CALL	TGARG		;TEST FOR SECOND ARG
	 JFCL			;  EH?
	CALL	GGARG		;FETCH THE ARG
	SPUSH	ARGCHC		;SAVE COUNT
	CALL	PGARG		;FLUSH STORAGE
	SPOP	%10		;COUNT TO %10
	HRRZS	%10
	JRST	ASGMTF		;EXIT THROUGH "="

.NTYPE:
	CALL	GSARG		;GET THE SYMBOL
	 JRST	OPCERR		;  MISSING, ERROR
	SPUSH	%00		;OK, STACK IT
	CALL	TGARG		;TEST FOR SECOND ARG
	 JFCL			;  EH?
	CALL	AEXP		;PROCESS ADDRESS EXPRESSION
	MOVE	%10,%00
	SETZM	CODPNT		;CLEAR CODE ROLL
	SETZM	CODBUF
	JRST	ASGMTF		;EXIT THROUGH "="
.MCALL:
	CALL	MCALLT		;TEST ARGUMENTS
	SKIPN	MCACNT
	RETURN
	TLNE	%15,P1F
	SKIPN	%03,JOBFFM
	JRST	MCALL6
	EXCH	%03,JOBFF
	INBUF	MAC,NUMBUF
	MOVEM	%03,JOBFF
	MOVE	%03,[XWD MACLUP,MACFIL]
	BLT	%03,MACPPN
	LOOKUP	MAC,MACFIL	;TRY FOR SYSMAC IN USER UFD. PRESENT?
	 CAIA			;NO
	JRST	MCALL3		;YES
	MOVE	%03,SYSPPN	;NOT FOUND. SET UP FOR SEARCH IN SYS:
	MOVEM	%03,MACPPN	;*
	LOOKUP	MAC,MACFIL	;TRY AGAIN.  GOOD?
	 JRST	MCALL6		;NOPE.

MCALL3:	SETZM	MCATMP
MCALL4:	CALL	GETMLI
	TLNE	%15,ENDFLG
	JRST	MCALL6
	CAIN	%03,DCMACE
	SOS	MCATMP
	CAIE	%03,DCMAC
	JRST	MCALL4
	AOS	%03,MCATMP
	CAIE	%03,1
	JRST	MCALL4
	CALL	GSARG
	 JRST	MCALL3
	CALL	MSRCH
	 CAIA
	TRNE	%01,-1
	JRST	MCALL4
	CALL	MACROF
	TLNE	%15,ENDFLG
	JRST	MCALL6
	SOSLE	MCACNT
	JRST	MCALL3
	JRST	MCALL7

MCALL6:	ERRSET	ERR.A
MCALL7:	SETZM	MCACNT
	TLZ	%15,ENDFLG
	RETURN
MCALLT:	CALL	GSARG		;GET NEXT ARGUMENT
	 RETURN			;  END, EXIT
	CALL	MSRCH		;FOUND, ALREADY PROCESSED?
	 AOSA	MCACNT		;  NO, INCREMENT COUNT AND SKIP
	JRST	MCALLU		;  YES, IGNORE
	MOVSI	%01,MAOP	;FLAG AS MACRO
	CALL	INSRT		;INSERT
MCALLU:	CALL	CRFOPD
	JRST	MCALLT


MACLUP:	SIXBIT	/SYSMAC/
	SIXBIT	/SML/
	EXP	0
	XWD	0,0


	.LOC
MACFIL:	BLOCK	1
MACEXT:	BLOCK	1
	BLOCK	1
MACPPN:	BLOCK	1

JOBFFM:	BLOCK	1

MCACNT:	BLOCK	1		;MACRO CALL COUNT
MCATMP:	BLOCK	1

MACBUF:	BLOCK	1
MACPNT:	BLOCK	1
	BLOCK	1

	.RELOC
	SUBTTL	MACRO STORAGE HANDLERS

WCIMT0:				;WRITE CHARACTER IN MACRO TREE
	SPUSH	%02		;STACK WORK REGISTER
	MOVEI	%02,@JOBUUO	;FETCH ARG
	SOSL	CONCNT		;ANY CONCATENATION CHARS?
	WCIMT	"'"		;YES, WRITE THEM
	SETZM	CONCNT		;CLEAR COUNT
	JUMPN	%02,WCIMT1	;BRANCH IF NON-DELIMITER
	MOVEI	%02,LF
WCIMT1:	CALL	WCIMT2		;WRITE IT
	SPOP	%02
	RETURN

WCIMT2:	TRNN	%02,177		;ATTEMPT TO WRITE A NULL?
	 HALT	.		;  YES, NASTY
	SKIPN	@MWPNTR		;END OF BLOCK?
	JRST	WCIMT3		;  YES, GET ANOTHER
	DPB	%02,MWPNTR	;NO, STORE BYTE
	IBP	MWPNTR		;POINT TO NEXT BYTE
	RETURN			;EXIT

WCIMT3:	SPUSH	%01
	PUSH	%17,MWPNTR	;NEAD A NEW BLOCK, SAVE CURRENT POINTER
	CALL	GETBLK		;GET IT
	HRRZS	%01		;GET START OF NEW BLOCK
	EXCH	%01,0(%17)	;EXCHANGE WITH POINTER TO LAST
	POP	%17,0(%01)	;STORE VECTOR
	SPOP	%01
	JRST	WCIMT2		;TRY AGAIN
READMC:				;READ MACRO CHARACTER
	CALL	READMB		;GET A MACRO BYTE
READMF:	TRNN	%14,CF.SPC	;SPECIAL?
	JRST	CPOPJ1		;  NO
	TRNE	%14,CF.DSY	;YES, DUMMY SYMBOL?
	JRST	READM1		;  YES
	TRNE	%14,CF.TRP	;END OF SOMETHIN?
	JRST	MPOP		;  YES
	TRNE	%14,CF.ARG	;NO, CHAR TRAP AT THIS LEVEL?
	SKIPN	%03,CALSAV
	JRST	CPOPJ1
	MOVEM	%03,MSBMRP
	SETZM	CALSAV
	JRST	READMC

READM1:	TRZ	%14,CF.SPC!CF.DSY
	MOVE	%03,MSBAUX
	EXCH	%03,MSBMRP
	MOVEM	%03,CALSAV
	MOVE	%04,MSBTYP
	CAIE	%04,CH.IRP	;IRP?
	JRST	READM5		;  NO
	MOVEI	%04,0(%14)
READM2:	SOJLE	%04,READM4
READM3:	CALL	READMB
	CAIE	%14,CH.FIN
	JRST	READM3
	JRST	READM2

READM4:	HRRZ	%14,MSBCNT
READM5:	MOVEI	%04,0(%14)	;GET COUNT
READM6:	SOJLE	%04,READMC
READM7:	CALL	READMB
	CAIN	%14,CH.FIN
	JRST	READMF
	CAIE	%14,CH.EOE
	JRST	READM7
	JRST	READM6


READMB:				;READ MACRO BYTE
	LDB	%14,MSBMRP	;GET CHARACTER
	IBP	MSBMRP
	JUMPN	%14,CPOPJ	;EXIT IF NON-NULL
	MOVE	%14,MSBMRP
	MOVE	%14,0(%14)	;END OF BLOCK, GET LINK
	HLL	%14,TXTBYT	;FORM BYTE POINTER
	MOVEM	%14,MSBMRP
	JRST	READMB		;TRY AGAIN
.MEXIT:
	SKIPN	MSBTYP		;IN MACRO?
	JRST	OPCERR		;  NO, ERROR
	SETOM	CNDMEX		;SET FLAG
	RETURN

MPUSH:
	CALL	GETBLK
	MOVSI	%03,-<MSBLEN>
	PUSH	%17,MWPNTR
MPUSH1:	SETZM	%04
	EXCH	%04,MSBTYP(%03)
	MOVEM	%04,@MWPNTR
	AOS	MWPNTR
	AOBJN	%03,MPUSH1
	MOVEM	%14,MSBTYP
	POP	%17,MSBPBP
	AOS	MSBLVL
	RETURN

MPOP:
	SKIPN	MSBLVL
	HALT	.
	CAMN	%14,MSBTYP
	JRST	MPOP1
	CALL	MPOP1
	ERRSET	ERR.A
	JRST	MPOP

MPOP1:	TRC	%14,CF.SPC!CF.TRP
	CAIL	%14,T.MIN
	CAILE	%14,T.MAX
	HALT	.
	SKIPN	REPSW		;ARE WE INSIDE A REPEAT BLOCK?
	JRST	MPOP3		;NO, SO DON'T MESS AROUND
	SOSLE	@REPCT		;DECREMENT THE TOP LEVEL OF THE STACK
	JRST	MPOP4		;IF WE'RE STILL IN THE TOP LEVEL, SPLIT.
	SETZM	CNDMEX		;OTHERWISE, ENABLE CODE GENERATION AGAIN,
	SOS	REPCT		;POP THE STACK,
	EXCH	%12,REPCT	;,
	CAIN	%12,REPBLK-1	;AND SEE IF IT'S EMPTY. IS IT?
	SETZM	REPSW		;YES, SO TELL FOLKS WE'RE NOT IN A REPEAT ANY MORE.
	EXCH	%12,REPCT	;NOW PUT THINGS BACK WHERE THEY BELONG
	CAIA
MPOP3:	SETZM	CNDMEX
MPOP4:	SPUSH	%13
	XCT	MPOPT(%14)
	 JRST	MPOP2
	SKIPE	%01,MSBTXP
	CALL	DECMAC
	SKIPE	%01,MSBAUX
	CALL	REMMAC
	SKIPN	%01,MSBPBP
	 HALT	.
	MOVSI	%03,0(%01)
	HRRI	%03,MSBTYP
	BLT	%03,MSBTYP+MSBLEN-1
	CALL	REMMAC
	SOS	MSBLVL
MPOP2:	SPOP	%13
	RETURN
MPOPT:
	PHASE	0
	HALT	.
T.MIN=	.
T.MACR:	CAIA
T.REPT:	CALL	ENDRPT
T.IRP:	CALL	ENDIRP
T.MAX=	.-1
	DEPHASE

	.LOC

MSBTYP:	BLOCK	1
MSBPBP:	BLOCK	1
MSBTXP:	BLOCK	1
MSBAUX:	BLOCK	1
MSBMRP:	BLOCK	1
MSBCNT:	BLOCK	1

MSBLEN=	.-MSBTYP


CALSAV:	BLOCK	1
MACCNT:	BLOCK	1
MSBLVL:	BLOCK	1
MACNAM:	BLOCK	1
CONCNT:	BLOCK	1
DSYLST:	BLOCK	^D65		;MACRO ARGUMENT STORAGE
IRPTYP:	BLOCK	1		;1=IRP,2=IRPC
IRPBEG:	BLOCK	1
IRPCNT:	BLOCK	1
IRPMAX:	BLOCK	1
ARGINC:	BLOCK	1
REPSW:	BLOCK	1		;SET NON-ZERO WHILE INSIDE IRP,IRPC,REPT
REPCT:	BLOCK	1		;POINTER TO 'STACK' IN REPBLK.
REPBLK:	BLOCK	^D128		;'STACK' FOR REPEAT ITERATION COUNTS

	.RELOC
GGARG:
	SPUSH	%13		;SAVE START OF FIELD
	MOVEM	%13,%00		;AND END
	MOVEI	%01,0		;ZERO CHARACTER COUNT
	CAIE	%14,"<"
	JRST	GGARG2
	SETZM	%02
	GETCHR
	MOVEM	%13,0(%17)	;SAVE NEW START
	MOVEM	%13,%00		;  AND END
GGARG1:	JUMPE	%14,GGARG6
	CAIN	%14,"<"
	AOS	%02
	CAIN	%14,">"
	SOJL	%02,GGARG7
	CALL	GGARG9
	JRST	GGARG1

GGARG2:	CAIE	%14,"^"
	JRST	GGARG5
	CALL	GETNB
	CAILE	%14,40
	CAILE	%14,137
	JRST	GGARG6
	MOVE	%02,%14
	GETCHR
	MOVEM	%13,0(%17)	;SAVE NEW START
	MOVEM	%13,%00		;  AND END
GGARG3:	JUMPE	%14,GGARG6
	CAMN	%14,%02
	JRST	GGARG7
	CALL	GGARG9
	JRST	GGARG3

GGARG5:	CAIE	%14,";"
	CAIN	%14,","
	JRST	GGARG8
	CAIE	%14,SPACE
	CAIN	%14,TAB
	JRST	GGARG8
	JUMPE	%14,GGARG8
	CALL	GGARG9
	JRST	GGARG5
GGARG6:	ERRSKP	ERR.A
GGARG7:	GETCHR
GGARG8:	SPUSH	%00		;STACK END
	SPUSH	%01		;  ANC COUNT
	SPUSH	MWPNTR		;PROTECT POINTER
	CALL	GETBLK		;GET STORAGE
	SPOP	MWPNTR
	MOVE	%02,%01		;GET COPY OF STORAGE POINTER
	HRLI	%02,ARGBLK
	BLT	%02,ARGLEN-1(%01)	;ZIP CUREENT
	MOVEM	%01,ARGPNT	;SET NEW POINTER
	SPOP	ARGCHC		;SET COUNT
	SPOP	ARGEND
	SPOP	ARGBEG
	LDB	%03,ARGEND
	HRLM	%03,ARGCHC
	MOVEI	%03,0
	DPB	%03,ARGEND
	MOVEM	%13,ARGTXP	;SAVE END OF FIELD
	MOVE	%13,ARGBEG	;SET TO START OF ARG
	JRST	SETCHR		;SET IT

GGARG9:	GETCHR			;GET THE NEXT CHARACTER
	MOVEM	%13,%00		;SET NEW END
	AOJA	%01,CPOPJ	;INCREMENT COUNT AND EXIT


PGARG:				;POP GENARAL ARGUMENT
	SKIPN	%13,ARGTXP	;SET TEXT POINTER
	 HALT	.
	SKIPN	%01,ARGPNT	;GET POINTER TO PREVIOUS
	 HALT	.
	SKIPN	ARGEND
	 HALT	.
	HLRZ	%03,ARGCHC
	DPB	%03,ARGEND
	HRLZ	%03,%01
	HRRI	%03,ARGBLK
	BLT	%03,ARGBLK+ARGLEN-1	;XFER DATA
	CALL	REMMAC		;RETURN BLOCK FOR DEPOSIT
	JRST	SETNB		;SET NON-BLANK AND EXIT
	SUBTTL	FLOATING POINT EVALUATOR

FLTG:
	TLZ	%15,FLTFLG	;CLEAR ERROR FLAG
	SETZB	%00,FLTNUM
	SETZB	%01,FLTNUM+1
	SETZB	%02,FLTNUM+2
	SETZB	%03,FLTNUM+3
	CAIN	%14,"-"
	TLO	%00,(1B0)
	EXCH	%00,FLTNUM
	SKIPL	FLTNUM
	CAIN	%14,"+"
FLTG2:	GETCHR
	CAIL	%14,"0"
	CAILE	%14,"9"
	JRST	FLTG3
	TLNE	%00,760000
	AOJA	%03,FLTG2
	ASHC	%00,1
	MOVEM	%00,FLTTMP
	MOVEM	%01,FLTTMP+1
	ASHC	%00,2
	ADD	%00,FLTTMP
	ADD	%01,FLTTMP+1
	ADDI	%01,-"0"(%14)
	TLZE	%01,(1B0)
	ADDI	%00,1
	AOBJP	%03,FLTG2

FLTG3:	CAIE	%14,"."
	JRST	FLTG4
	TRNE	%02,400000
	TLO	%15,FLTFLG
	MOVEI	%02,400000(%03)
	JRST	FLTG2
FLTG4:	SKIPN	%03
	TLO	%15,FLTFLG
	TRZN	%02,400000
	HRRZ	%02,%03
	HLRZS	%03
	SUB	%02,%03
	CAIE	%14,"E"
	JRST	FLTG6
	GETCHR

	SPUSH	%00
	SPUSH	%01
	SETZB	%00,%01
	CAIN	%14,"-"
	TLOA	%01,(1B0)
	CAIN	%14,"+"
FLTG5:	GETCHR
	CAIL	%14,"0"
	CAILE	%14,"9"
	JRST	FLTG5A
	IMULI	%00,^D10
	ADDI	%00,-"0"(%14)
	AOJA	%01,FLTG5

FLTG5A:	TLZE	%01,(1B0)
	MOVNS	%00
	SKIPN	%01
	TLO	%15,FLTFLG
	ADD	%02,%00
	SPOP	%01
	SPOP	%00
FLTG6:	CAIN	%01,0
	JUMPE	%00,FLTG12
	TDZA	%03,%03
FLTG7:	ASHC	%00,1
	TLNN	%00,200000
	SOJA	%03,FLTG7
	JUMPL	%02,FLTG9
FLTG8:	SOJL	%02,FLTG10
	MOVEM	%00,FLTTMP
	MOVEM	%01,FLTTMP+1
	ASHC	%00,-2
	ADD	%00,FLTTMP
	ADD	%01,FLTTMP+1
	TLZE	%01,(1B0)
	ADDI	%00,1
	TLNE	%00,(1B0)
	CALL	FLTG20
	ADDI	%03,3
	JRST	FLTG8
FLTG9:	CAML	%00,[^D10B4]
	CALL	FLTG20
	SPUSH	%01+1
	DIV	%00,[^D10B4]
	DIV	%01,[^D10B4]
	SPOP	%01+1
	SUBI	%03,4
	AOJL	%02,FLTG9
FLTG10:	SPUSH	%03		;STACK EXPONENT
	MOVSI	%02,(1B<16-7>)	;SET ONE WORD ROUNDING BIT
	SETZ	%03,		;CLEAR LOW ORDER
	SKIPA	%04,FLTLEN	;GET LENGTH AND SKIP
	ASHC	%02,-^D16	;MOVE ROUNDING MASK
	SOJG	%04,.-1
	TDNN	%00,%02		;TEST FOR ROUNDING REQUIRED
	TDNE	%01,%03
	SKPEDR	ED.FPT		;YES, ".ROUND" MODE?
	 JRST	FLTG11		;  NO, FORGET ROUNDING
	ASHC	%02,1		;SHIFT BIT UP ONE
	ADD	%00,%02
	ADD	%01,%03		;ADD IN BIT
FLTG11:	SPOP	%03		;RESTORE EXPONENT
	TLZE	%01,(1B0)	;OVERFLOW, LOW ORDER?
	ADDI	%00,1		;  YES, ADD TO UPPER
	TLNE	%00,(1B0)	;OVERFLOW, HIGH ORDER?
	CALL	FLTG20		;  YES, CORRECT
	LSH	%01,1		;MOVE OVER SIGN BIT
	LSHC	%00,-7		;MAKE ROOM FOR EXPONENT
	ADDI	%03,^D<35+35+128>
	DPB	%03,[POINT 8,%00,8]
	LDB	%02,[POINT 8,%00,8]
	CAME	%02,%03		;OVER/UNDER FLOW?
	ERRSET	ERR.T		;  YES
FLTG12:	IOR	%00,FLTNUM
	MOVSI	%02,-4
FLTG13:	LDB	%03,[POINT 16,%00,15]
	MOVEM	%03,FLTNUM(%02)
	LSHC	%00,^D16
	AOBJN	%02,FLTG13
	JRST	SETNB

FLTG20:	LSH	%01,1
	LSHC	%00,-1
	LSH	%01,-1
	AOJA	%03,CPOPJ

	.LOC
FLTNUM:	BLOCK	4		;FLOATING POINT NUMBER
FLTLEN:	BLOCK	1		;LENGTH
FLTTMP:	BLOCK	2
	.RELOC
	SUBTTL	SIXBIT/RAD50 CONVERSION ROUTINES

SIXM40:				;SIXBIT TO RAD50
	SPUSH	%01
	SPUSH	%02
	SPUSH	%03		;STACK REGISTERS
	SETZ	%01,
	MOVSI	%03,(POINT 6,%00)
SIXM41:	ILDB	%02,%03		;GET A CHARACTER
	HLRZ	%02,RADTBL(%02)	;MAP
	IMULI	%01,50
	ADD	%01,%02
	TLNE	%03,770000	;FINISHED?
	JRST	SIXM41		;  NO
	IDIVI	%01,50*50*50	;YES, SPLIT INTO HALVES
	HRLZ	%00,%01		;HIGH ORDER
	HRR	%00,%02		;  AND LOW ORDER
	SPOP	%03		;RESTORE REGISTERS
	SPOP	%02
	SPOP	%01
	RETURN

M40SIX:				;RAD50 TO SIXBIT
	SPUSH	%01
	SPUSH	%02
	SPUSH	%03
	LDB	%01,[POINT 16,%00,17]
	IMULI	%01,50*50*50	;MERGE
	ANDI	%00,177777
	ADD	%00,%01
	SETZ	%02,		;ACCUMULATOR
	MOVSI	%03,-6
M40SI1:	IDIVI	%00,50
	HRRZ	%01,RADTBL(%01)	;MAP
	LSHC	%01,-6		;MOVE INTO COLLECTOR
	AOBJN	%03,M40SI1	;TEST FOR END
	MOVE	%00,%02
	SPOP	%03
	SPOP	%02
	SPOP	%01
	RETURN
RADTBL:
	XWD	<$=0>,	0
	XWD	0,	"A"-40
	XWD	0,	"B"-40
	XWD	0,	"C"-40
	XWD	<$$=33>,	"D"-40
	XWD	0,	"E"-40
	XWD	0,	"F"-40
	XWD	0,	"G"-40

	XWD	0,	"H"-40
	XWD	0,	"I"-40
	XWD	0,	"J"-40
	XWD	0,	"K"-40
	XWD	0,	"L"-40
	XWD	0,	"M"-40
	XWD	<$.=34>,	"N"-40
	XWD	0,	"O"-40

	XWD	<$0=36>,	"P"-40
	XWD	<$1=37>,	"Q"-40
	XWD	<$2=40>,	"R"-40
	XWD	<$3=41>,	"S"-40
	XWD	<$4=42>,	"T"-40
	XWD	<$5=43>,	"U"-40
	XWD	<$6=44>,	"V"-40
	XWD	<$7=45>,	"W"-40

	XWD	<$8=46>,	"X"-40
	XWD	<$9=47>,	"Y"-40
	XWD	0,	"Z"-40
	XWD	0,	"$"-40
	XWD	0,	"."-40
	XWD	0,	0
	XWD	0,	"0"-40
	XWD	0,	"1"-40

	XWD	0,	"2"-40
	XWD	<$A=1>,	"3"-40
	XWD	<$B=2>,	"4"-40
	XWD	<$C=3>,	"5"-40
	XWD	<$D=4>,	"6"-40
	XWD	<$E=5>,	"7"-40
	XWD	<$F=6>,	"8"-40
	XWD	<$G=7>,	"9"-40

	XWD	<$H=10>,	0
	XWD	<$I=11>,	0
	XWD	<$J=12>,	0
	XWD	<$K=13>,	0
	XWD	<$L=14>,	0
	XWD	<$M=15>,	0
	XWD	<$N=16>,	0
	XWD	<$O=17>,	0

	XWD	<$P=20>,	0
	XWD	<$Q=21>,	0
	XWD	<$R=22>,	0
	XWD	<$S=23>,	0
	XWD	<$T=24>,	0
	XWD	<$U=25>,	0
	XWD	<$V=26>,	0
	XWD	<$W=27>,	0

	XWD	<$X=30>,	0
	XWD	<$Y=31>,	0
	XWD	<$Z=32>,	0
	XWD	0,	0
	XWD	0,	0
	XWD	0,	0
	XWD	0,	0
	XWD	0,	0
	SUBTTL	PERMANENT SYMBOL TABLE ROUTINES

OSRCH:				;OP TABLE SEARCH
	CALL	MSRCH		;TRY FOR USER-DEFINED OPS FIRST
	 TLZA	%00,ST.MAC	;  NO, CLEAR FLAG AND SKIP
	JRST	CPOPJ1		;YES, GOOD EXIT
	MOVEI	%02,1B^L<OPTTOP-OPTBOT>	;SET UP OFFSET AND DELTA
	MOVEI	%01,1B^L<OPTTOP-OPTBOT>/2
OSRCH1:	CAMN	%00,OPTBOT-2(%02)	;ARE WE LOOKING AT IT?
	JRST	OSRCH3		;  YES
	CAML	%00,OPTBOT-2(%02)	;TEST FOR DIRECTION OF NEXT MOVE
	TDOA	%02,%01		;ADD
OSRCH2:	SUB	%02,%01		;SUBTRACT
	ASH	%01,-1		;HALVE DELTA
	JUMPE	%01,OSRCH4	;EXIT IF END
	CAILE	%02,OPTTOP-OPTBOT	;YES, ARE WE OUTOF BOUNDS?
	JRST	OSRCH2		;YES, MOVE DOWN
	JRST	OSRCH1		;NO, TRY AGAIN

OSRCH3:	MOVE	%01,OPTBOT-1(%02)	;FOUND, PLACE VALUE IN %01
	LDB	%02,TYPPNT
	JRST	CPOPJ1

OSRCH4:	SETZB	%01,%02
	RETURN
	SUBTTL	SYMBOL TABLE FLAGS

TYPOFF=	^D17			;PACKING PARAMETERS
SUBOFF=	^D15
MODOFF=	^D7

BC1=	1
BC2=	2

DEFSYM=	400000			;DEFINED SYMBOL
LBLSYM=	200000			;LABEL
REGSYM=	100000			;REGISTER
GLBSYM=	040000			;GLOBAL
MDFSYM=	020000			;MULTIPLY-DEFINED FLAG
FLTSYM=	010000			;DEFAULTED GLOBAL SYMBOL
DFLSYM=	004000			;DEFAULT SYMBOL DEFINITION

TYPPNT:	POINT	2,%01,TYPOFF	;TYPE POINTER
SUBPNT:	POINT	8,%01,SUBOFF	;SUB-TYPE POINTER
CCSPNT:	POINT	8,%05,SUBOFF	;CURRENT CSECT POINTER
MODPNT:	POINT	8,%01,MODOFF

MOD20=	400000
MOD45=	200000

ST.MAC=	200000
ST.LSB=	400000

MDMASK=	377B<MODOFF>
PFMASK=	377B<SUBOFF>
ADMASK=	177777
PCMASK=	PFMASK!ADMASK

DCCND=	1
DCCNDE=	2
DCMAC=	3
DCMACE=	4
DCRPT=	DCMAC
DCRPTE=	DCMACE
DCMCAL=	7

M40DOT:	GENM40	.
	SUBTTL	PERMANENT SYMBOL TABLE

REGTBL:
	GENM40	R,0, , , , 
	GENM40	R,1, , , , 
	GENM40	R,2, , , , 
	GENM40	R,3, , , , 
	GENM40	R,4, , , , 
	GENM40	R,5, , , , 
	GENM40	S,P, , , , 
	GENM40	P,C, , , , 

	DEFINE	OPCDEF	(A,B,C,D,E,F,CLASS,VALUE,MOD)
<
	XLIST
	GENM40	A,B,C,D,E,F
	XWD	MOD!<CLASS>B33!OCOP,VALUE
	LIST
>

	DEFINE	DIRDEF	(A,B,C,D,E,F,TYPE)
<
	XLIST
	IFDEF	A'B'C'D'E'F,
<
	GENM40	A,B,C,D,E,F
	XWD	<TYPE+0>B33!DIOP,A'B'C'D'E'F
>
	LIST
>
OPTBOT:				;OP TABLE BOTTOM

	;OPCLASS 2  - DOUBLE OPERAND INSTRUCTIONS
	;OPCLASS 5  - XOR
	;OPCLASS 5A - JSR
	OPCDEF	A,B,S,D, , ,	OPCL1,	170600,	MOD45

	OPCDEF	A,B,S,F, , ,	OPCL1,	170600,	MOD45

	OPCDEF	A,D,C, , , ,	OPCL1,	005500,	MOD20!MOD45

	OPCDEF	A,D,C,B, , ,	OPCL1,	105500,	MOD20!MOD45

	OPCDEF	A,D,D, , , ,	OPCL2,	060000,	MOD20!MOD45

	OPCDEF	A,D,D,D, , ,	OPCL11,	172000,	MOD45

	OPCDEF	A,D,D,F, , ,	OPCL11,	172000,	MOD45

	OPCDEF	A,S,H, , , ,	OPCL9,	072000,	MOD45

	OPCDEF	A,S,H,C, , ,	OPCL9,	073000,	MOD45

	OPCDEF	A,S,L, , , ,	OPCL1,	006300,	MOD20!MOD45

	OPCDEF	A,S,L,B, , ,	OPCL1,	106300,	MOD20!MOD45

	OPCDEF	A,S,R, , , ,	OPCL1,	006200,	MOD20!MOD45

	OPCDEF	A,S,R,B, , ,	OPCL1,	106200,	MOD20!MOD45

	OPCDEF	B,C,C, , , ,	OPCL4,	103000,	MOD20!MOD45

	OPCDEF	B,C,S, , , ,	OPCL4,	103400,	MOD20!MOD45

	OPCDEF	B,E,Q, , , ,	OPCL4,	001400,	MOD20!MOD45

	OPCDEF	B,G,E, , , ,	OPCL4,	002000,	MOD20!MOD45

	OPCDEF	B,G,T, , , ,	OPCL4,	003000,	MOD20!MOD45
	OPCDEF	B,H,I, , , ,	OPCL4,	101000,	MOD20!MOD45

	OPCDEF	B,H,I,S, , ,	OPCL4,	103000,	MOD20!MOD45

	OPCDEF	B,I,C, , , ,	OPCL2,	040000,	MOD20!MOD45

	OPCDEF	B,I,C,B, , ,	OPCL2,	140000,	MOD20!MOD45

	OPCDEF	B,I,S, , , ,	OPCL2,	050000,	MOD20!MOD45

	OPCDEF	B,I,S,B, , ,	OPCL2,	150000,	MOD20!MOD45

	OPCDEF	B,I,T, , , ,	OPCL2A,	030000,	MOD20!MOD45

	OPCDEF	B,I,T,B, , ,	OPCL2A,	130000,	MOD20!MOD45

	OPCDEF	B,L,E, , , ,	OPCL4,	003400,	MOD20!MOD45

	OPCDEF	B,L,O, , , ,	OPCL4,	103400,	MOD20!MOD45

	OPCDEF	B,L,O,S, , ,	OPCL4,	101400,	MOD20!MOD45

	OPCDEF	B,L,T, , , ,	OPCL4,	002400,	MOD20!MOD45

	OPCDEF	B,M,I, , , ,	OPCL4,	100400,	MOD20!MOD45

	OPCDEF	B,N,E, , , ,	OPCL4,	001000,	MOD20!MOD45

	OPCDEF	B,P,L, , , ,	OPCL4,	100000,	MOD20!MOD45

	OPCDEF	B,P,T, , , ,	OPCL0,	000003,	MOD45

	OPCDEF	B,R, , , , ,	OPCL4,	000400,	MOD20!MOD45

	OPCDEF	B,V,C, , , ,	OPCL4,	102000,	MOD20!MOD45
	OPCDEF	B,V,S, , , ,	OPCL4,	102400,	MOD20!MOD45

	OPCDEF	C,C,C, , , ,	OPCL0,	000257,	MOD20!MOD45

	OPCDEF	C,F,C,C, , ,	OPCL0,	170000,	MOD45

	OPCDEF	C,L,C, , , ,	OPCL0,	000241,	MOD20!MOD45

	OPCDEF	C,L,N, , , ,	OPCL0,	000250,	MOD20!MOD45

	OPCDEF	C,L,R, , , ,	OPCL1,	005000,	MOD20!MOD45

	OPCDEF	C,L,R,B, , ,	OPCL1,	105000,	MOD20!MOD45

	OPCDEF	C,L,R,D, , ,	OPCL1,	170400,	MOD45

	OPCDEF	C,L,R,F, , ,	OPCL1,	170400,	MOD45

	OPCDEF	C,L,V, , , ,	OPCL0,	000242,	MOD20!MOD45

	OPCDEF	C,L,Z, , , ,	OPCL0,	000244,	MOD20!MOD45

	OPCDEF	C,M,P, , , ,	OPCL2A,	020000,	MOD20!MOD45

	OPCDEF	C,M,P,B, , ,	OPCL2A,	120000,	MOD20!MOD45

	OPCDEF	C,M,P,D, , ,	OPCL15,	173400,	MOD45

	OPCDEF	C,M,P,F, , ,	OPCL15,	173400,	MOD45

	OPCDEF	C,N,Z, , , ,	OPCL0,	000254,	MOD20!MOD45

	OPCDEF	C,O,M, , , ,	OPCL1,	005100,	MOD20!MOD45

	OPCDEF	C,O,M,B, , ,	OPCL1,	105100,	MOD20!MOD45
	OPCDEF	D,E,C, , , ,	OPCL1,	005300,	MOD20!MOD45

	OPCDEF	D,E,C,B, , ,	OPCL1,	105300,	MOD20!MOD45

	OPCDEF	D,I,V, , , ,	OPCL7,	071000,	MOD45

	OPCDEF	D,I,V,D, , ,	OPCL11,	174400,	MOD45

	OPCDEF	D,I,V,F, , ,	OPCL11,	174400,	MOD45

	OPCDEF	E,M,T, , , ,	OPCL6,	104000,	MOD20!MOD45

	OPCDEF	F,A,D,D, , ,	OPCL3,	075000,	MOD20
	OPCDEF	F,D,I,V, , ,	OPCL3,	075030,	MOD20
	OPCDEF	F,M,U,L, , ,	OPCL3,	075020,	MOD20
	OPCDEF	F,S,U,B, , ,	OPCL3,	075010,	MOD20

	OPCDEF	H,A,L,T, , ,	OPCL0,	000000,	MOD20!MOD45

	OPCDEF	I,N,C, , , ,	OPCL1,	005200,	MOD20!MOD45

	OPCDEF	I,N,C,B, , ,	OPCL1,	105200,	MOD20!MOD45

	OPCDEF	I,O,T, , , ,	OPCL0,	000004,	MOD20!MOD45

	OPCDEF	J,M,P, , , ,	OPCL1A,	000100,	MOD20!MOD45

	OPCDEF	J,S,R, , , ,	OPCL5A,	004000,	MOD20!MOD45

	OPCDEF	L,D,C,D,F, ,	OPCL11,	177400,	MOD45

	OPCDEF	L,D,C,F,D, ,	OPCL11,	177400,	MOD45

	OPCDEF	L,D,C,I,D, ,	OPCL14,	177000,	MOD45

	OPCDEF	L,D,C,I,F, ,	OPCL14,	177000,	MOD45

	OPCDEF	L,D,C,L,D, ,	OPCL14,	177000,	MOD45

	OPCDEF	L,D,C,L,F, ,	OPCL14,	177000,	MOD45

	OPCDEF	L,D,D, , , ,	OPCL11,	172400,	MOD45

	OPCDEF	L,D,E,X,P, ,	OPCL14,	176400,	MOD45

	OPCDEF	L,D,F, , , ,	OPCL11,	172400,	MOD45

	OPCDEF	L,D,F,P,S, ,	OPCL1A,	170100,	MOD45

	OPCDEF	L,D,S,C, , ,	OPCL0,	170004,	MOD45

	OPCDEF	L,D,U,B, , ,	OPCL0,	170003,	MOD45
	OPCDEF	M,A,R,K, , ,	OPCL10,	006400,	MOD45

	OPCDEF	M,F,P,D, , ,	OPCL1A,	106500,	MOD45

	OPCDEF	M,F,P,I, , ,	OPCL1A,	006500,	MOD45

	OPCDEF	M,O,D,D, , ,	OPCL11,	171400,	MOD45

	OPCDEF	M,O,D,F, , ,	OPCL11,	171400,	MOD45

	OPCDEF	M,O,V, , , ,	OPCL2,	010000,	MOD20!MOD45

	OPCDEF	M,O,V,B, , ,	OPCL2,	110000,	MOD20!MOD45

	OPCDEF	M,T,P,D, , ,	OPCL1,	106600,	MOD45

	OPCDEF	M,T,P,I, , ,	OPCL1,	006600,	MOD45

	OPCDEF	M,U,L, , , ,	OPCL7,	070000,	MOD45

	OPCDEF	M,U,L,D, , ,	OPCL11,	171000,	MOD45

	OPCDEF	M,U,L,F, , ,	OPCL11,	171000,	MOD45

	OPCDEF	N,E,G, , , ,	OPCL1,	005400,	MOD20!MOD45

	OPCDEF	N,E,G,B, , ,	OPCL1,	105400,	MOD20!MOD45

	OPCDEF	N,E,G,D, , ,	OPCL1,	170700,	MOD45

	OPCDEF	N,E,G,F, , ,	OPCL1,	170700,	MOD45

	OPCDEF	N,O,P, , , ,	OPCL0,	000240,	MOD20!MOD45

	OPCDEF	R,E,S,E,T, ,	OPCL0,	000005,	MOD20!MOD45

	OPCDEF	R,O,L, , , ,	OPCL1,	006100,	MOD20!MOD45

	OPCDEF	R,O,L,B, , ,	OPCL1,	106100,	MOD20!MOD45

	OPCDEF	R,O,R, , , ,	OPCL1,	006000,	MOD20!MOD45

	OPCDEF	R,O,R,B, , ,	OPCL1,	106000,	MOD20!MOD45

	OPCDEF	R,T,I, , , ,	OPCL0,	000002,	MOD20!MOD45
	OPCDEF	R,T,S, , , ,	OPCL3,	000200,	MOD20!MOD45

	OPCDEF	R,T,T, , , ,	OPCL0,	000006,	MOD45

	OPCDEF	S,B,C, , , ,	OPCL1,	005600,	MOD20!MOD45

	OPCDEF	S,B,C,B, , ,	OPCL1,	105600,	MOD20!MOD45

	OPCDEF	S,C,C, , , ,	OPCL0,	000277,	MOD20!MOD45

	OPCDEF	S,E,C, , , ,	OPCL0,	000261,	MOD20!MOD45

	OPCDEF	S,E,N, , , ,	OPCL0,	000270,	MOD20!MOD45

	OPCDEF	S,E,T,D, , ,	OPCL0,	170011,	MOD45

	OPCDEF	S,E,T,F, , ,	OPCL0,	170001,	MOD45

	OPCDEF	S,E,T,I, , ,	OPCL0,	170002,	MOD45

	OPCDEF	S,E,T,L, , ,	OPCL0,	170012,	MOD45

	OPCDEF	S,E,V, , , ,	OPCL0,	000262,	MOD20!MOD45

	OPCDEF	S,E,Z, , , ,	OPCL0,	000264,	MOD20!MOD45

	OPCDEF	S,O,B, , , ,	OPCL8,	077000,	MOD45

	OPCDEF	S,P,L, , , ,	OPCL13,	000230,	MOD45

	OPCDEF	S,T,A,0, , ,	OPCL0,	170005,	MOD45

	OPCDEF	S,T,B,0, , ,	OPCL0,	170006,	MOD45

	OPCDEF	S,T,C,D,F, ,	OPCL12,	176000,	MOD45

	OPCDEF	S,T,C,D,I, ,	OPCL12,	175400,	MOD45

	OPCDEF	S,T,C,D,L, ,	OPCL12,	175400,	MOD45

	OPCDEF	S,T,C,F,D, ,	OPCL12,	176000,	MOD45

	OPCDEF	S,T,C,F,I, ,	OPCL12,	175400,	MOD45

	OPCDEF	S,T,C,F,L, ,	OPCL12,	175400,	MOD45
	OPCDEF	S,T,D, , , ,	OPCL12,	174000,	MOD45

	OPCDEF	S,T,E,X,P, ,	OPCL12,	175000,	MOD45

	OPCDEF	S,T,F, , , ,	OPCL12,	174000,	MOD45

	OPCDEF	S,T,F,P,S, ,	OPCL1,	170200,	MOD45

	OPCDEF	S,T,Q,0, , ,	OPCL0,	170007,	MOD45

	OPCDEF	S,T,S,T, , ,	OPCL1,	170300,	MOD45

	OPCDEF	S,U,B, , , ,	OPCL2,	160000,	MOD20!MOD45

	OPCDEF	S,U,B,D, , ,	OPCL11,	173000,	MOD45

	OPCDEF	S,U,B,F, , ,	OPCL11,	173000,	MOD45

	OPCDEF	S,W,A,B, , ,	OPCL1,	000300,	MOD20!MOD45

	OPCDEF	S,X,T, , , ,	OPCL1,	006700,	MOD45

	OPCDEF	T,R,A,P, , ,	OPCL6,	104400,	MOD20!MOD45

	OPCDEF	T,S,T, , , ,	OPCL1A,	005700,	MOD20!MOD45

	OPCDEF	T,S,T,B, , ,	OPCL1A,	105700,	MOD20!MOD45

	OPCDEF	T,S,T,D, , ,	OPCL1A,	170500,	MOD45

	OPCDEF	T,S,T,F, , ,	OPCL1A,	170500,	MOD45

	OPCDEF	W,A,I,T, , ,	OPCL0,	000001,	MOD20!MOD45

	OPCDEF	X,O,R, , , ,	OPCL5,	074000,	MOD45
	DIRDEF	.,A,B,S, , 

	DIRDEF	.,A,S,C,I,I

	DIRDEF	.,A,S,C,I,Z

	DIRDEF	.,A,S,E,C,T

	DIRDEF	.,B,L,K,B, 

	DIRDEF	.,B,L,K,W, 

	DIRDEF	.,B,Y,T,E, 

	DIRDEF	.,C,S,E,C,T

	DIRDEF	.,D,E,P,H,A

	DIRDEF	.,D,S,A,B,L

	DIRDEF	.,E,N,A,B,L

	DIRDEF	.,E,N,D, , 

	DIRDEF	.,E,N,D,C, ,	DCCNDE

	DIRDEF	.,E,N,D,M, ,	DCMACE

	DIRDEF	.,E,N,D,R, ,	DCRPTE

	DIRDEF	.,E,O,T, , 

	DIRDEF	.,E,Q,U,I,V

	DIRDEF	.,E,R,R,O,R

	DIRDEF	.,E,V,E,N, 
	DIRDEF	.,F,L,T,2, 

	DIRDEF	.,F,L,T,4, 

	DIRDEF	.,G,L,O,B,L

	DIRDEF	.,I,D,E,N,T

	DIRDEF	.,I,F, , , ,	DCCND

	DIRDEF	.,I,F,D,F, ,	DCCND

	DIRDEF	.,I,F,E,Q, ,	DCCND

	DIRDEF	.,I,F,F, , ,	DCCND

	DIRDEF	.,I,F,G, , ,	DCCND

	DIRDEF	.,I,F,G,E, ,	DCCND

	DIRDEF	.,I,F,G,T, ,	DCCND

	DIRDEF	.,I,F,L, , ,	DCCND

	DIRDEF	.,I,F,L,E, ,	DCCND

	DIRDEF	.,I,F,L,T, ,	DCCND

	DIRDEF	.,I,F,N,D,F,	DCCND

	DIRDEF	.,I,F,N,E, ,	DCCND

	DIRDEF	.,I,F,N,Z, ,	DCCND

	DIRDEF	.,I,F,T, , ,	DCCND

	DIRDEF	.,I,F,T,F, ,	DCCND

	DIRDEF	.,I,F,Z, , ,	DCCND

	DIRDEF	.,I,I,F, , 

	DIRDEF	.,I,R,P, , ,	DCMAC

	DIRDEF	.,I,R,P,C, ,	DCMAC

	DIRDEF	.,L,I,M,I,T

	DIRDEF	.,L,I,S,T, 

	DIRDEF	.,L,O,C,A,L
	DIRDEF	.,M,A,C,R, ,	DCMAC

	DIRDEF	.,M,A,C,R,O,	DCMAC

	DIRDEF	.,M,C,A,L,L,	DCMCAL

	DIRDEF	.,M,E,X,I,T

	DIRDEF	.,N,A,R,G, 

	DIRDEF	.,N,C,H,R, 

	DIRDEF	.,N,L,I,S,T

	DIRDEF	.,N,T,Y,P,E

	DIRDEF	.,O,D,D, ,

	DIRDEF	.,P,A,G,E, 

	DIRDEF	.,P,D,P,1,0

	DIRDEF	.,P,H,A,S,E

	DIRDEF	.,P,R,I,N,T

	DIRDEF	.,P,S,E,C,T

	DIRDEF	.,R,A,D,I,X

	DIRDEF	.,R,A,D,5,0

	DIRDEF	.,R,E,M, , 

	DIRDEF	.,R,E,P,T, ,	DCRPT

	DIRDEF	.,R,O,U,N,D

	DIRDEF	.,S,B,T,T,L

	DIRDEF	.,T,I,T,L,E

	DIRDEF	.,T,R,U,N,C

	DIRDEF	.,W,O,R,D, 

OPTTOP:	-1B36			;OP TABLE TOP
	SUBTTL	CHARACTER DISPATCH ROUTINES

C1PNTR:	POINT	4,CHJTBL(%14), 3
C2PNTR:	POINT	4,CHJTBL(%14), 7
C3PNTR:	POINT	4,CHJTBL(%14),11
C4PNTR:	POINT	4,CHJTBL(%14),15
C5PNTR:	POINT	4,CHJTBL(%14),19
C6PNTR:	POINT	4,CHJTBL(%14),23
C7PNTR:	POINT	4,CHJTBL(%14),27
C8PNTR:	POINT	4,CHJTBL(%14),31
C9PNTR:	POINT	4,CHJTBL(%14),35

ANPNTR=	C8PNTR
CHJTBL:				;CHARACTER JUMP TABLE
	PHASE	0


	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJNU,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;

	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
TAB:	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJTB,    ,    	; TAB
LF:	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJCR,    ,    	; LF
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJVT,    ,    	;
FF:	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJCR,    ,    	; FF
CRR:	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJCR,    ,    	; CR
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;

	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;

	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJNU,    ,    	; EOF
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
SPACE:	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJSP,    ,    	; SPACE
	BYTE	(4)	    ,    ,    ,EXOR,    ,    ,QJPC,    ,    	; !
	BYTE	(4)	    ,    ,    ,    ,TEDQ,    ,QJPC,    ,    	; "
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,    ,    	; #
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.DOL,    	; $
	BYTE	(4)	    ,    ,    ,    ,TEPC,    ,QJPC,    ,    	; %
	BYTE	(4)	    ,    ,    ,EXAN,    ,    ,QJPC,    ,    	; &
	BYTE	(4)	    ,    ,    ,    ,TESQ,    ,QJPC,    ,    	; '

	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,    ,    	; (
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,    ,    	; )
	BYTE	(4)	    ,    ,    ,EXMU,    ,    ,QJPC,    ,    	; *
	BYTE	(4)	    ,    ,    ,EXPL,TEPL,    ,QJPC,    ,    	; +
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,    ,    	; ,
	BYTE	(4)	    ,    ,    ,EXMI,TEMI,    ,QJPC,    ,    	; -
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.DOT,    	; .
	BYTE	(4)    	    ,    ,    ,EXDV,    ,    ,QJPC,    ,    	; /

	BYTE	(4)	    ,    ,    ,    ,TENM,    ,QJPC,.NUM,    	; 0
	BYTE	(4)	    ,    ,    ,    ,TENM,    ,QJPC,.NUM,    	; 1
	BYTE	(4)	    ,    ,    ,    ,TENM,    ,QJPC,.NUM,    	; 2
	BYTE	(4)	    ,    ,    ,    ,TENM,    ,QJPC,.NUM,    	; 3
	BYTE	(4)	    ,    ,    ,    ,TENM,    ,QJPC,.NUM,    	; 4
	BYTE	(4)	    ,    ,    ,    ,TENM,    ,QJPC,.NUM,    	; 5
	BYTE	(4)	    ,    ,    ,    ,TENM,    ,QJPC,.NUM,    	; 6
	BYTE	(4)	    ,    ,    ,    ,TENM,    ,QJPC,.NUM,    	; 7

	BYTE	(4)	    ,    ,    ,    ,TENM,    ,QJPC,.NUM,    	; 8
	BYTE	(4)	    ,    ,    ,    ,TENM,    ,QJPC,.NUM,    	; 9
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,    ,    	; :
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,    ,    	; ;
	BYTE	(4)	    ,    ,    ,    ,TEAB,    ,QJPC,    ,    	; <
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,    ,    	; =
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,    ,    	; >
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,    ,    	; ?
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,    ,    	; @
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; A
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; B
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; C
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; D
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; E
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; F
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; G

	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; H
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; I
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; J
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; K
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; L
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; M
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; N
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; O

	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; P
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; Q
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; R
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; S
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; T
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; U
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; V
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; W

	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; X
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; Y
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,.ALP,    	; Z
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,    ,    	; [
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,    ,    	; \
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,    ,    	; ]
	BYTE	(4)	    ,    ,    ,    ,TEUA,    ,QJPC,    ,    	; ^
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJPC,    ,    	; _
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;

	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;

	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;

	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJLC,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
ALTMOD:	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
	BYTE	(4)	    ,    ,    ,    ,    ,    ,    ,    ,    	;
RUBOUT:	BYTE	(4)	    ,    ,    ,    ,    ,    ,QJNU,    ,    	;

	DEPHASE
	SUBTTL	IMPURE AREA AND DEBUG PATCH AREA

	.LOC			;IMPURE STORAGE


EZCOR:				;END OF ZERO'D CORE

	.RELOC			;BACK TO CODE SEGMENT

	IFDEF	DEBUG,	<
ZZZ000:	BLOCK	100		;DEBUG PATCH AREA>

	END	START		;....MACY11