	.SYMTAB 3511.

	TITLE	PALX

	.NSTGW
IF1,[
	VERSIO==.FVERS

;VARIABLE PARAMETERS.

IFNDEF ITS,	ITS==0
IFNDEF TENEX,	TENEX==0
IFNDEF TWENEX,	TWENEX==0
IFNDEF SAIL,	SAIL==0

IFE ITS\TENEX\TWENEX\SAIL,[
IFE .OSMIDAS-SIXBIT/ITS/,	ITS==1
IFE .OSMIDAS-SIXBIT/TENEX/,	TENEX==1
IFE .OSMIDAS-SIXBIT/TWENEX/,	TWENEX==1
IFE .OSMIDAS-SIXBIT/SAIL/,	SAIL==1
]
IFN TWENEX, TENEX==1		;TWENEX IMPLIES TENEX

IFNDEF RELCOD,RELCOD==0		; ASSUME MAKING ABSOLUTE

	CORINC==2000		; CORE INCREMENT
	SPL==	4		; SYMBOLS PER LINE (SYMBOL TABLE LISTING)
	SPLTTY==3		; SYMBOLS PER LINE (TTY)
	ARADIX==8.		; ASSEMBLER RADIX
IFE RELCOD, 	DATLEN==350.		; DATA BLOCK LENGTH
IFN RELCOD, DATLEN==18.
	CPW==	6		; CHARACTERS PER WORD
	WPB==	10		; MACRO BLOCK SIZE
	CPL==	120.		; CHARACTERS PER LINE
	PDPLEN==300		; PUSH-DOWN POINTER LENGTH
	LSTBSZ==400		;LISTING BUFFER SIZE.
IFN SAIL, LSTBSZ==203
	SRCBSZ==2000		;SOURCE BUFFER SIZE.
IFN TENEX,SRCBSZ==1777
IFN SAIL,SRCBSZ==200
	TTIBSZ==60		;COMMAND BUFFER SIZE.
	SRCPSZ==8		;LENGTH OF .INSRT PDL.
;;; No one could ever want extend feature -CBF
IFN SAIL,  EXTEND==0		; FOR 18-BIT ADDRESSING
IFE SAIL,  EXTEND==0		; FOR 16-BIT ADDRESSING
IFN EXTEND,[
	ADRSIZ==18.
	ADRMSK==777777
]
IFE EXTEND,[
	ADRSIZ==16.
	ADRMSK==177777
]
IFN TENEX, NEWBIN==1
;;newbin==1   turn this on to force ITS newbin for making NPALX
IFNDEF NEWBIN, NEWBIN==0
IF1 [  IFN ITS,[
         IFE NEWBIN,[
	     PRINTX/Defaulting assembly to old (large) Palx output format.
To use new format the NEWBIN assembly flag should be set to 1
/]
           .ELSE [ PRINTX/Defaulting assembly to new (compressed) Palx output format.
To use old format the NEWBIN assembly flag should be set to 0.
/           ] ] ]

IFN ITS,FILCHR==3		;FILE PADDING CHARACTER
IFN SAIL,FILCHR==0
IFNDEF PAGLPT,PAGLPT==60.-5*SAIL	;# LINES/PAGE ON LPT.
IFNDEF PAGXGP,PAGXGP==98.		;# LINES/PAGE ON XGP.
IFNDEF %COMP1,%COMP1==177777		;INITIALL SETTING OF %COMPAT.


;ACCUMULATOR ASSIGNMENTS

	N=	0		; ACCUMULATION OF SIXBIT SYMBOL, SCRATCH
	A=	1		; SYMBOL VALUE AND FLAGS SET BY SRCH.  SCRATCH
	B=	2		; SCRATCH
	C=	3		; SCRATCH
	W=	4		; CODE TO BE GENERATED.  LH - TYPE,  RH - VALUE
	L=	5		; LOCATION COUNTER
	R6=	6		; SCRATCH
	S=	7		; SYMBOL TABLE SEARCH INDEX
	V=	10		; EXPRESSION OR TERM VALUE, SCRATCH
	T1=	11		; SCRATCH
	MP=	12		; MACRO STORAGE BYTE POINTER
	IP=	13		; LINE BUFFER BYTE POINTER
	I=	14		; CURRENT CHARACTER (ASCII)
	AF=	15		; LH - ASSEMBLER FLAGS,  RH - ERROR FLAGS
	F=	16		; EXEC FLAGS
	P=	17		; PUSH-DOWN POINTER
;FLAG REGISTERS			(STILL UNDER IF1)

				; F - LH

	LSTBIT==000001		;1 - WE'RE MAKING A LISTING.
	BINBIT==000002		;1 - WE'RE MAKING A BINARY.
	CSWBIT==000004		;1 - MAKE CREF-TYPE LISTING.
	DSWBIT==000010		; 1 - /D, JOB DISOWNED.
	MSWBIT==000020		; 1- SUPRESS MACRO LISTING
	NSWBIT==000040		; 1- SUPRESS ERRORS ON TTY
	RSWBIT==000100		; 1- REPRODUCE SOURCE
	TTYBIT==000200		; 1- LISTING IS ON TTY
	PSWBIT==000400		;1 - BINARY ON PTP:
	SYMBIT==001000		;1 - SUPPRESS SYM TAB IN BINARY.
	LSWBIT==002000		;1 - FORCE LISTING.
	NULBIT==004000		;1 - NO OUTPUT FILES GIVEN (NO "_").
	BSWBIT==010000		;1 - SUPPRESS BINARY.
	ESWBIT==020000		;1 - /E, FORCE ERROR FILE OUTPUT.
	ERRBIT==040000		;1 - ERROR FILE OPEN.
	ERQBIT==100000		;1 - ERROR FILE SPEC'D (BUT NOT NEC. OPEN YET)

				; F - RH

	ARWBIT==000001		; 1- LEFT ARROW SEEN
	INSBIT==000002		; 1- READING FILENAME DURING .INSRT .
	CHRBIT==000004		; 1- RFILE RE-READS LAST CHAR (USED IN .INSRT)
	INFBIT==000010		; 1- VALID INFORMATION SEEN
	FFBIT==000020		; 1- FORM-FEED SEEN
	ENDBIT==000400		; 1- END OF ALL INPUT FILES
	HDRBIT==040000		; 1- TIME FOR NEW LISTING PAGE


				; AF - LH

	SUPFLG==000001		;SUPPRESSED SYMBOL - "===".
	INDFLG==000002		;@ WAS SEEN IN ADDRESS.
	SRCFLG==000004		;HAVE READ WHOLE LINE, BUT NOT LISTED.
	LINFLG==000010		; 1- SUPPRESS LISTING OF LINE
	ENDFLG==000020		; 1- END OF SOURCE ENCOUNTERED
	RSWFLG==000040		; 1- LINE TO BE SUPPRESSED IN REDUCTION
	TTYFLG==000100		; 1- TTY MODE LISTING FORMAT
	CONFLG==000200		; 1- CONCATENATION CHARACTER SEEN
	ASZFLG==000400		; 1 FOR ASCIZ, 0 FOR ASCII PSEUDOOP
	ROKFLG==001000		; 1- REGISTER "OK" FLAG
	REGFLG==002000		; 1- REGISTER FLAG
	HKLFLG==004000		; 1- HALF KILLED SYMBOL BEING DEFINED
	TTMFLG==010000		; 1- .TTYMAC IN PROGRESS
	EXTFLG==020000		; 1- EXTERNAL SYMBOL REFERENCED
	NDSFLG==040000		; 1- DON'T ENTER UNDEFINED SYMS IN DICT.
	LCHFLG==100000		; 1- LOCATION COUNTER HAS CHANGED
	LCRFLG==200000		; 1- LOCATION COUNTER RELOCATABLE
	LCRFBP==420100		;BP TO LCRFLG.
	P1F==	400000		; 1- PASS 1 IN PROGRESS

;IN RH.
ERRU==	000040		;SOME SYM WAS UNDEFINED.
ERRP1==	000001		;LIST THIS LINE ON TTY (^D IN ERROR UUO).

;SYMBOL FLAGS, USU. IN A (ALONG WITH VALUE).

INDSYM==000040		; VALUE OF SYMBOL DEPENDS ON ANOTHER SYMBOL
ENTSYM==000400		; SYMBOL IS AN ENTRY POINT
EXTSYM==000200		; SYMBOL IS EXTERNAL
RELSYM==000100		; SYMBOL HAS RELOCATABLE VALUE
LBLSYM==001000		;LABEL
MDLSYM==002000		;MULTIPLY DEFINED LABEL FLAG
REGSYM==004000		;REGISTER
UNDSYM==010000		;UNDEFINED SYMBOL FLAG
HKLSYM==020000		;HALF KILLED SYMBOL
SUPSYM==040000		;DON'T OUTPUT THIS SYMBOL.
NCRSYM==100000		;DON'T CREF THIS SYM.
INISYM==200000		;PDP-11 INSTRUCTION, ERROR IF REDEFINED (BUT OK TO EXPUNGE).
;MISCELLANEOUS PARAMETERS	(STILL UNDER IF1)

	SETCHA=	LDB I,IP	;RESTORE LAST CHAR READ.
	CALL=	PUSHJ P,
	RET=	POPJ P,
	ERRUUO=	1^9		;ERROR IN PASS 2 ONLY.
	ERRUU1=	2^9		;ERROR IN EITHER PASS.

.XCREF A,B,CALL,RET

IFN ITS+SAIL,[

;CHANNEL NAMES.

	TTO==	0
	BIN==	1
	LST==	2
	ERR==	3
	TTI==	4
	ERRC==	5
	CMDC==	6
	SRC==	7
]
; CREF FLAG CHARACTERS

	CRFLIN==35
	CRFSYM==36
	CRFMAC==34
	CRFOPC==33

	CRR==15
	LF==12
	TAB==11
	SPACE==40
	RUBOUT==177
	FF==14
	INDBIT=="@

DEFINE POINT ?S,ADDR,B=-1
<<<<35.-.RADIX 10.,B>&77>_30.\<<.RADIX 10.,S>&77>_24.> ADDR>TERMIN

DEFINE PHASE A
 OFFSET A-.
TERMIN

DEFINE DEPHASE
 OFFSET 0
TERMIN

] ;END IF1 ON PAGE 1

IFN ITS,[

 SBLK

IF1,[

;MAKE SURE ITS SYSTEM CALLS ARE DEFINED.

IFNDEF .IOT,[
IFE .OSMIDAS-SIXBIT/ITS/,[
  .INSRT SYS:ITSDFS
 ]
 IFN .OSMIDAS-SIXBIT/ITS/,[
  .INSRT ITSDFS
 ]
 .ITSDF
]

;ASSEMBLE A "NEW SYSTEM CALL" WITH NAME A, ARGS B.
%LSCAL==1000
DEFINE SYSCAL A,B
 .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
  .LOSE %LSCAL
TERMIN

DEFINE SYSCL A,B
 .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
TERMIN

;OUTPUT CHAR IN B TO FILE X.
DEFINE UNIOB X
       .IOT X,B
TERMIN

;INPUT CHAR FROM FILE X INTO B.
DEFINE UNIIB X
 .IOT X,B
TERMIN

;X IS CHANNEL, B HAS BP, C HAS MINUS # BYTES.
;Y IS # BYTES/WD, OR NULL FOR 1.
DEFINE OUTBFR X,Y
IFNB Y,	IDIVI C,Y
	HRLI B,(C)
	.IOT X,B
TERMIN

BUG==.LOSE
] ;IF1
] ;ITS

IFN TENEX,[

;.DECREL
.DECSAV

IF1,[

IFNDEF GTJFN,[
 IFE .OSMIDAS-SIXBIT/ITS/,[
  .INSRT SYS:TNXDFS
 ]
 IFN .OSMIDAS-SIXBIT/ITS/,[
  .INSRT TNXDFS
 ]
 .TNXDF
 ];IFNDEF GTJFN

DEFINE UNIOB X
 SAVE A
 MOVE A,X!JFN
 BOUT
 REST A
TERMIN

DEFINE UNIIB X
 SAVE A
 MOVE A,X!JFN
 BIN
 REST A
TERMIN

DEFINE OUTBFR X,Y
 MOVE A,X!JFN
 SOUT
TERMIN

BUG==JRST 4,		; HALTF IS NORMAL EXIT
.VALUE==JRST 4,
] ;IF1
] ;TENEX

IFN SAIL,[

.DECREL

IF1,[

IFNDEF SPCWAR,[
 IFE .OSMIDAS-SIXBIT/ITS/,[
  .INSRT SYS:SAIDFS
 ]
 IFN .OSMIDAS-SIXBIT/ITS/,[
  .INSRT SAIDFS
 ]
.DECDF
]

EXPUNG RESCAN,GETLIN,GETCHR,SWITCH

DEFINE UNIOB X
IFSN X,TTO,[
 SOSG X!HDR+2
  OUT X,
   CAIA
    JRST 4,.
 IDPB B,X!HDR+1
]
IFSE X,TTO,OUTCHR B
TERMIN

DEFINE UNIIB X
IFSN X,TTI,[
 SOSG X!HDR+2
  IN X,
   CAIA
    SKIPA B,[^C]
     ILDB B,X!HDR+1
]
IFSE X,TTI,[
 INCHWL B
 CAIN B,^M
  INCHWL B
]
TERMIN

BUG==JRST 4,
] ;IF1
] ;SAIL

IF1,[

;NEW MACROS

DEFINE	SAVE	$1,$2,$3,$4,$5,$6,$7,$8,$9,$10,$11,$12
IRP X,,[$1,$2,$3,$4,$5,$6,$7,$8,$9,$10,$11,$12]
IFSN X,,	PUSH	P,X
TERMIN
TERMIN

DEFINE	REST	$1,$2,$3,$4,$5,$6,$7,$8,$9,$10,$11,$12
IRP X,,[$1,$2,$3,$4,$5,$6,$7,$8,$9,$10,$11,$12]
IFSN X,,	POP	P,X
TERMIN
TERMIN

DEFINE	INSIRP	A,B
IRPS FOO,,[B]
	A,FOO
TERMIN TERMIN

DEFINE	ERROR1	ADDR,MSG
IFSN MSG,,  ERRUU1 [<010000,,ADDR> ? ASCIZ\MSG\]
IFSE MSG,,  ERRUU1 [ASCIZ\ADDR\]
TERMIN

DEFINE	ERROR	ADDR,MSG
IFSN MSG,,  ERRUUO [<010000,,ADDR> ? ASCIZ\MSG\]
IFSE MSG,,  ERRUUO [ASCIZ\ADDR\]
TERMIN

;RESTART READING FROM A (IN INBUF).
DEFINE	RESCAN	A/
	MOVEI	IP,GCHI
	HRRM	IP,GETCHA
	MOVE	IP,A
TERMIN

;NEWLIN FOO 		;IN AN OUTPUT ROUTINE, MAKES ^@
;FOO:	OUTPUT-1-CHAR	;OUTPUT BOTH CR AND LF.
;	POPJ P,
DEFINE	NEWLIN	X
	JUMPN	B,X
	SAVE	B
	MOVEI	B,^M
	CALL	X
	MOVEI	B,^J
	PUSH	P,[POPBJ]
TERMIN

IFE RELCOD,[DEFINE LOCABS FOO,BAR	;IN ABS ASSEMBLY, ALL VALUES ARE ABS.
TERMIN ]
IFN RELCOD,[
DEFINE LOCABS FOO,BAR
	CAIE A,
	 ERRUU!BAR!1 [ASCIZ\FOO Relocatable\]
	CAIE C,
	 ERRUU!BAR!1 [ASCIZ\FOO External\]
TERMIN
]
] ; END IF1
;IMPURE AREA

	.YSTGW

ZZZ==.
LOC	41
	JSR	UUOH
IFN ITS,TSINT		;ITS INT HANDLER.

LOC ZZZ

LOCTR:	L,,0	;@LOCTR GIVES .+OFFSET .
SYMTBA:	0	;ADDRESS OF SYMBOL TABLE (= RH OF SYMPNT)
SYMPNT:	S,,	;POINTER TO SYMBOL TABLE NAME WORD.
VALPNT:	S,,-1	;POINTER TO SYMBOL TABLE VALUE
IFE SAIL,JOBREL:	0	;MEMORY BOUND.
CRFINS:	JFCL\CALL CRFOUT	;INSN TO CREF SYM IN N, VAL IN A.
CRFIND:	JFCL\CALL CRFODF	;CREF FOR DEFINING OCCURRENCE.

ARGRET:	0		;ADRESS OF RTN FOR ARGC TO CALL,
	RET		;JSR ARGRET  TO SET COROUTINE START ADDRESS.
ARGTRM:	0		;TEMP. USED BY ARGC ROUTINES.

BZCOR:				;BEGINNING OF CORE TO BE INITIALIZED TO ZERO

SYMLEN:	0		;LENGTH OF SYMBOL TABLE
SYMAOB:	0		;AOBJN PTR -> SYM. TAB.
MACTOP:	0		;TOP OF MACRO STORAGE
MACPDP:	0		;MACRO PDL POINTER.
MACBPT:	0		;POINTS TO BOTTOM OF MACRO PDL FRAME.
MACLVL:	0		;MACRO NESTING LEVEL
MACXIT:	0	;ADDR OF ROUTINE TO CALL WHEN FINISH READING STRING.
		;CALL THERE+1 FOR .MEXIT TO AVOID DOING MORE PASSES.
		;WILL BE MACEND, REPEND, AIRPON OR AIRPCN .
ARGLST:	BLOCK	65.	;;HOLD MACRO ARG NAMES DURING DEFINITION READING.

MWPNTR:	BLOCK	1	;MACRO WRITE POINTER
NEXT:	BLOCK	1	;MACRO STG FREE LIST (OF 10-WD BLOCKS)
%RPCNT:	0		;VALUE OF .RPCNT .
%IRPCN:	0		;VALUE OF .IRPCNT .
%NARG:	0		;%NARG PSEUDO SYM, # ARGS TO INNERMOST MACRO CALL.
%SUCCE:	0		;%SUCCESS PSEUDO SYM, 0 IF LAST COND FAILED, -1 OTHERWISE

SYMBEG:	BLOCK	1		;POINTER TO START OF SYMBOL FOR RESCAN PURPOSES


LINBUF:	BLOCK	CPL/5+1		;SOURCE LINE BUFFER
LINIP:	0			;LAST FILLED PLACE IN LINBUF.
LINEPP:	0			;P SAVED AT ENTRY TO "LINE"; USED FOR PDL OV RECOVERY.
				;0 IF NOT INSIDE THE RTN "LINE".

BYTCNT:	BLOCK	1		;BYTE COUNT
IFE RELCOD,[			; THIS DATA NEEDED ONLY FOR BIN.
LODADR:	BLOCK	1		;LOAD ADDRESS
CURADR:	BLOCK	1		;CURRENT DATA BLOCK ADDRESS
CHKSUM:	BLOCK	1		;CHECK SUM
DATBBL:	0?0			; 1,0 (BEG. OF BLOCK) GO HERE.
	0?0			;BLOCK LENGTH HERE
	0?0			;1ST ADDR HERE.
DATBLK:	BLOCK	DATLEN		;DATA BLOCK
]

IFN RELCOD,[			; THIS IS RELOCATABLE CODE DATA

LOADRS:	0			; LOAD ADDRESS OF CURRENT BLOCK
RELPNT:	0			; BYTE POINTER TO RELOCATION BYTES

BLKHED:	0,,0			; BLOCK HEADER, TYPE,,SIZE
BLKREL:	0			; RELOCATION BYTES GO ICI
BLKDAT:	BLOCK	DATLEN		; DATA WORDS GO ICI

ABSLC:	0			; ABSOLUTE LC SAVED HERE
RELLC:	0			; RELOCATABLE LOCATION COUNTER SAVED ICI

INDWRD:	0			; ALLOCATION WORD FOR INDIRECT TABLES
INDOFF:	BLOCK 36.		; INDIRECT VALUE OFFSET TABLE
INDREF:	BLOCK 36.		; INDIRECT VALUE SYMBOL TABLE


]
INSCNT:	0		;# INSTRUCTIONS ASSEMBLED.
INSLEN:	0		;# WDS IN INSTRUCTIONS (FOR AVG LENGTH)
IRUNTM:	0		;RUN TIME AT START OF THIS COMMAND.
DATTIM:	BLOCK 6		;DATE & TIME AS ASCIZ STRING.
%OPSYS:	0		;OPERATING SYSTEM, SO PALX CAN DO .IF Z %OPSYS-"TW
%YEAR:	0		;THE CURRENT YEAR  AS A NUMBER (LAST TWO DIGITS ONLY)
%MONTH:	0		;THE CURRENT MONTH AS A NUMBER
%DAY:	0		;THE CURENT DAY OF MONTH AS A NUMBER
PAGNUM:	0		;PAGE NUMBER IN SRC.
PAGTOT:	0		;PAGE NUM. IN LISTING.
PAGEXT:	0		;PAGE EXTENSION
ERRNUM:	0		;ERROR COUNT
NONFTL:	0	;-1 AT FINIS2 IF NO FATAL ERROR
		;(SO OK TO RENAME BIN,LST FILES)

CEXT:			;CODE EXTENSION BLOCK
CEXT1:	0		;   BYTES 3&4 OF CODE
CEXT2:	0		;   BYTES 5&6 OF CODE

IFN RELCOD,[
REXTAB:	0		; RELOCATION OF CODE GOES HERE
REXT:			; NEXT TWO FOR ADDRESS FIELDS
REXT1:	0		; RELOCATION FOR WORD 2 OF INSTRUCTION (SRC)
REXT2:	0		; RELOCATION FOR WORD 3 OF INSTRUCTION (DST)

EEXTAB:	0		; EXTERNAL REFERENCES, THIS FOR .WORD STUFF
EEXT:			; THESE TWO FOR ADDRESS FIELDS
EEXT1:	0		; SRC
EEXT2:	0		; DST
]

OFFST:	0		;0 OF 1, FOR CEXT1 OR CEXT2

LLABN:	0		;MOST RECENTLY DEFINED LABEL'S NAME,
LLABV:	0		;  VALUE.
LLABS:	-1		;  "S" REG.
VALREQ:	0		;UNDEF. SYM. IS ERROR IF >0.
CTLCF:	0		;COMMAND TERM. BY ^C, EXIT WHEN DONE.
CTLSF:	0		;SET => TYPEOUT SUPPRESSED BY ^S.
SRCEOF:	0		;SET IF INTERNALLY DETECTED EOF.
STRTLC:	0		;START ADDR PUT HERE BY .END .
LINPOS:	0		;LSTSIX, ERROCT COUNT CHARS.

HSWCNT:	0	;NUMBER OF TIMES /H OCCURRED.
LSWCNT:	-1	;# OF /L'S IN CMD STRING, + 1 ON PASS 2, - 1.
		;LINES ARE LISTED IFF THIS WORD IS >0.
		;SET TO 0 IF LISTING CAUSED EVEN IF NO /L WAS GIVEN.
LSWCN1:	-1	;COUNT IS ACCUMULATED HERE, THEN PUT IN LSWCNT
		;CMD STRING IS READ SEVERAL TIMES. THIS AVOIDS
		;COUNTING EACH /L EACH TIME.
%ABSAD:	0	;#0 => GENERATE "@#FOO" FOR "FOO".

%COMPA:	0	;NONZERO => CHECK FOR INSNS THAT ARE
		;INCOMPATIBLE BETWEEN DIFFERENT PDP11'S.

%TTYFL:	0	;NONZERO CAUSES TTY OUTPUT NOT TO BE DONE
		;(IT IS THROWN AWAY). DOES NOT AFFECT OUTPUT
		;TO LISTING OR ERROR FILE.

FAICND:	0	;-1 WHILE INSIDE FAILING CONDITIONAL.
UNCONP:	0	;PAGNUM, SAVED AT START OF FAILING CONDIT.
UNCONL:	0	;SLNCNT, " ......"........"
RFILN:	0		;ACCUMULATE FILENAMES IN THIS BLOCK.
XESAVE:	0		;FN1 GOES HERE.
EXTSAV:	0		;2ND NAME GOES HERE.
RFILSN:	BLOCK	2	;SNAME, ACCESS PTR GO HERE.

RFILN1=XESAVE
RFILN2=EXTSAV

RFILP:	0		;0 IF NULL FILSPEC.
RFILNC:	0
IFN SAIL,[
	RFPPNF:	0		;reading PPN flag
	swpblk: 0		;used by SWAP uuo, DEV
	swpnam:	0		;dmp file NAME
	swpext:	0		;dmp file EXT,,mode bits
	swpsa:	0		;core size,,starting address offset
	swpppn:	0		;dmp file PPN
	swpnpp:	0		;new PPN if creating new job
];sail
TTICSV:	0			;SAVE TTICNT HERE AFTER READING CMD .

TTICNT:	0
TTIPNT:	0
TTIBUF:	BLOCK	TTIBSZ

SRCBUF:	BLOCK	SRCBSZ
	0

SRCCNT:	0		;NUM. INPUT FILES OPENED SO FAR, -1 . (INCLUDES THOSE WHICH HAVE BEEN CLOSED)
SRCNUM:	0		;# INPUT FILES OPENED BEFORE THE CURRENT ONE.
SRCERR:	0		;WHAT SRCNUM HELD AT TIME OF LAST ERROR MESSAGE.
SRCDPH:	0		;DEPTH IN .INSRT FILES, 0 IN OUTER LEVEL.
SRCBPT:	0		;B.P. (ASCII) TO START OF BUFFER FOR CURRENT SRC FILE.
SRCBND:	0		;B.P. TO A ^C AFTER END OF LAST SRC BUFFERFULL.
SRCPNT:	0		;BP FOR ILDBING FROM SRC BUFFER.
SRCTTY:	0		;-1 => SRC FILE IS TTY.
%FNAM2:	0		;DECIMAL VAL OF 2ND NAME OF SRC.


LINCNT:	0		;POS. IN LISTING PAGE.
SLNCNT:	0		;POS. IN SOURCE PAGE, -1 .

TITBUF:	BLOCK 20	;TITLE, IN ASCIZ.
STITBF:	BLOCK 20	;SUBTITLE, IN ASCIZ.
TSLWRD:	0		;SUPPRESS LISTING IF NOT 0.
NOCREF:	0		;SUPPRESS CREF OUTPUT FOR SYMBOL USE.
LSTOPN:	0		;-1 => LST FILE IS ACTUALLY OPEN (NOT JUST INTENDED TO BE OPENED).

CMDFIL:	0		;CMD FILE NESTING LEVEL.
CMDPDL:	BLOCK 20	;IN TENEX VERSION, USED TO SAVE CMDCJF FOR PUSHED CMD FILES.

EZCOR:

CCLFLG:	0		;FLAG ENTERED AT START + 1
IFN SAIL,[
TMPNBP:	0		;NEXT BYTE POINTER FOR INPUT FROM TMPBUF
TMPBUF:	BLOCK TTIBSZ
]
MSNAME:	0			;INITIAL SNAME.
PAGSIZ:	PAGLPT		;# LINES/PAGE IN LISTING (INCL. MARGINS)
TIMDIV:	IFN ITS,100000.	;DIVISOR FOR RUNTIME PRINTOUT RTN.
	IFN SAIL,1000.
	IFN TENEX,0	;(READ FROM SYSTEM ALONG WITH RUNTIME)

SRCJFN:	-TENEX+IFN ITS+SAIL,SRC
SRCMOD:	2	;BLOCK ASCII INPUT.

IFN SAIL,[
SRCREC:	0		;RECORD COUNT
SRCWL:	0		;# WORDS LEFT IN FILE
]


CMDCJF:	-TENEX+IFN ITS+SAIL,CMDC
CMDCMO:	0	;UNIT ASCII INPUT.
IFN SAIL,[
CMDCHD:	0
CMDCPN:	0
CMDCCN:	0
];IFN SAIL

IRPS X,,DEV FN1 FN2 SNM TNM JFN MOD HDR PNT CTR BUF
X==.IRPCN
TERMIN

LSTDEV:	0	;LST FILE NAMES.
LSTFN1:	0
LSTFN2:	0
LSTSNM:	0
LSTTNM:	'LSTOUT
LSTJFN:	-TENEX+IFN ITS+SAIL,LST
LSTMOD:	3	;BLOCK ASCII OUTPUT.
LSTHDR:	0
LSTPNT:	0	;BP INTO BUFFER.
LSTCNT:	0	;# BYTES LEFT EMPTY.
LSTBUF:	BLOCK LSTBSZ

ERRDEV:	0	;ERROR OUTPUT FILE NAMES.
ERRFN1:	0
ERRFN2:	0
ERRSNM:	0
ERRTNM:	'ERROUT
ERRJFN:	-TENEX+IFN ITS+SAIL,ERR
ERRMOD:	1	;UNIT ASCII OUT.
IFN SAIL,[
ERRHDR:	0	;DEC VERSION BUFFER HEADER.
ERRPNT:	0	;(IT IS 3 WDS LONG)
ERRCNT:	0
ERRBUF:	BLOCK 203
]


;; buffer for ITS output conversion
ifn its&newbin,[
outbuf: block  datlen	; block for converting words to bytes, needs to be
			; as large as DATBLK cause symbols don't shrink??
outbp:  441000,,outbuf	; byte pointer to output buffer
			; used for leftover bytes
]
BINDEV:	0	;BINARY OUTPUT FILE NAMES.
BINFN1:	0
BINFN2:	0
BINSNM:	0
BINTNM:	'BINOUT	;TEMP. FN2 TO USE.
BINJFN:	-TENEX+IFN ITS+SAIL,BIN
IFE NEWBIN, BINMOD:	7	;BLOCK IMAGE OUT.
IFN NEWBIN, BINMOD:	.uio
BINHDR:	0
BINPNT:	0
BINCNT:	0
IFN SAIL,[
BINBUF:	BLOCK 203
BINBSZ==203	]
IFE RELCOD+SAIL,[
BINBUF==DATBLK
BINBSZ==DATLEN	]

IFN SAIL,[
OPNMD:	10	;10 FOR OUTPUT, 17 FOR INPUT
OPNDV:	0
OPNHD:	0

ENTNM:	0
ENTEX:	0
	0
ENTPPN:	0
]

IFN TENEX,[
TTIJFN:	0		;JFNS FOR THE VARIOUS FILES
TTOJFN:	0

STRTMP:	BLOCK 40		;SCRATCH FOR STRING CONVERSION
PSIACA:	0		;AC A DURING PSI

JBLOCK:	BLOCK 11	;LONG FORM GTJFN BLOCK
JBKSTR:	BLOCK 100	;STRING STORAGE FOR 7-BIT JFN ARGS
JBKSTE=.-1
JBKSPT:	BLOCK 1		;POINTER INTO STRING STORAGE

LEVTAB:	PIPC1	;WHERE TO STORE LVL 1 PC.
	0
	0
CHNTAB:	1,,PSICO	;^O INT. CHNL, LVL 1, CALL PSICO.
	REPEAT 35,0
CHNMSK:	SETZ
PIPC1:	0
]		;END TENEX STORAGE

NODEFN:	0		;SYMBOL NOT TO BE DEFINED.

PDL:	BLOCK	PDPLEN

PAT:
PATCH:	BLOCK	100
;ONCE-ONLY INITIALIZATIONN.
PALX11:	TDZA	A,A		;CLEAR CCL ENTRY FLAG
CCLX11:	SETO	A,			;SET CCL ENTRY FLAG
	MOVEM	A,CCLFLG		;STORE FOR LATER CHECKS
	MOVE	P,[-PDPLEN,,PDL-1]
IFN ITS,[
	.FDELE	[SIXBIT/   DSK_PALX_BINOUT       /]
	 JFCL
	.FDELE	[SIXBIT/   DSK_PALX_LSTOUT       /]
	 JFCL			;DELETE ANY WORTHLESS OUTPUT FILES.
	.FDELE	[SIXBIT/   DSK_PALX_ERROUT       /]
	 JFCL
	.OPEN	TTI,[SIXBIT/   TTY/]
	 BUG
	.OPEN	TTO,[SIXBIT/  !TTY/]
	 BUG
	.SUSET	[.SMASK,,[200000]]	;PDL OV ONLY.
	.SUSET	[.SMSK2,,[1_TTI]]
]
IFN TENEX,[
	MOVEI	A,100		;INITIAL TTI AND TTO JFNS
	MOVEM	A,TTIJFN
	MOVEI	A,101
	MOVEM	A,TTOJFN
	MOVEI	A,400000		;THIS FORK
	CIS			;CLEAR INTERRUPTS IN PROGRES,, ETC.
	MOVE	B,[LEVTAB,,CHNTAB] ;POINTERS TO INTERRUPT PARAMS
	SIR			;SET INTERRUPT VECTOR
	EIR			;TURN THEM ON
	MOVE	B,CHNMSK	;AND MASK FOR CHANNELS ON
	AIC
	MOVSI	A,17		;ASSIGN CONTROL O TO CHANNEL 0
	ATI
IFN TWENEX,[
	MOVEI A,0
	RSCAN
	 TDN
	SKIPE B,A
RSCAN1:	 PBIN
	CAIE A,40
	 SOJG B,RSCAN1
]
]
IFN SAIL,SETZM TMPNBP
IFN ITS\TENEX,MOVEI A,JOBFFI
IFN SAIL,MOVE	A,JOBFF
	HRRM	A,SYMPNT	;SYM TAB ALWAYS STARTS RIGHT ABOVE
	HRRZM	A,SYMTBA	;LAST ASSEMBLED STUFF.
	SETZM	%TTYFL
	MOVE	N,[.FNAM1]	;IDENTIFY SELF.
	CALL	TTOSIX
	MOVEI	B," 		;SPACE
	CALL	TYO
	MOVEI	N,.FVERS
	CALL	TTODEC
;FALLS THROUGH
;FALLS THROUGH.
;COME HERE TO REINITIALIZE, READ A COMMAND AND THEN ASSEMBLE.
RESTRT:	;FIRST CLEAR I/O SYSTEM AND FLUSH EXTRA CORE.
IFN TENEX,[
	RESET			;CLEAR SYSTEM STUFF, FILES,...
IRPS X,,[SRCJFN,BINJFN,LSTJFN,ERRJFN]
	SETOM X
TERMIN
	SETO A,			;CLEAR MAP OF SCRATCH PGS
	LDB B,[111100,,SYMTBA]
	HRLI B,400000
	PMAP
	ADDI B,1
	TRNN B,400
	JRST .-3
]
IFN SAIL,[
	RESET
	MOVE	A,SYMTBA
	SUBI	A,1
	CORE	A,
	 BUG
]
IFN ITS,[
	.IOPDL
	SKIPE	MSNAME		;PUT OUR REMEMBERED DEFAULT INTO SYSTEM VAR IN CASE FOO^S .
	.SUSET	[.SSNAM,,MSNAME]
	SYSCL	TTYSET,[1000,,TTI ? [222020,,202020] ? [232020,,220220]]
	 JFCL			;in case it is not a TTY
	LDB	A,[121000,,SYMTBA]
	.CORE	1(A)
	 .VALUE
]
	MOVE	P,[-PDPLEN,,PDL-1]
	SETZB	F,AF		;CLEAR ALL FLAGS
	MOVE	N,[XWD BZCOR,BZCOR+1]
	SETZB	A,BZCOR
	BLT	N,EZCOR-1

;FALLS THROUGH.
;FALLS THROUGH.
;OBTAIN THE COMMAND (FROM SUPERIOR OR FROM TTY)
	CALL	TTYCR
IFN ITS,[
;TRY TO GET IT FROM SUPERIOR.
	.SUSET	[.ROPTIO,,I]
	TLNN	I,40000	;IF SUPERIOR MAY HAVE CMD FOR US, READ IT.
	 JRST	RESTR1
	.BREAK	12,[5,,TTIBUF]	;IF DDT STRING, READ IT.
	SKIPN	TTIBUF
	JRST	RESTR1
	SETOM	CTLCF		;CAUSE EXIT AFTER EXECUTION,
	MOVE	IP,[440700,,TTIBUF]
	MOVEM	IP,TTIPNT	;SET UP POINTER,
	ILDB	I,IP
	CAIE	I,^M
	AOJA	A,.-2		;COUNT CHARS.
	MOVEM	A,TTICNT
	.BREAK 12,[SETZ [0](5)]	;FLUSH CMD STRING.
	JRST	RESTR9
]
IFN SAIL,[
	SKIPN CCLFLG
	JRST RESTR1		;NOT STARTED AT STARTING ADDRESS + 1
	SKIPE TMPNBP
	JRST TMPNXT
	MOVE A,[1,,[SIXBIT /PAL   / ? -TTIBSZ,,TMPBUF-1 ]]
	TMPCOR A,		;READ TMPCOR FILE, RETURN LENGTH IN A
	 JRST TMPCFL		;ATTEMPT TO READ TMPCOR FILE FAILED
TMPFIL:	CAILE A,TTIBSZ-1
	MOVEI A,TTIBSZ-1
	SETZM TMPBUF(A)
	MOVE W,[440700,,TMPBUF]
	MOVEM W,TMPNBP
TMPNXT:	MOVE B,[440700,,TTIBUF]
	MOVEM B,TTIPNT
	MOVEI A,0
TMPLUP:	ILDB C,TMPNBP
	IDPB C,B
	JUMPE C,TMPDON
	CAIN C,12
	AOJA A,TMPEOL
	AOJA A,TMPLUP

TMPDON:	SETOM CTLCF
TMPEOL:	MOVEM A,TTICNT
	JRST RESTR9

TMPCFL:	PJOB A,			;GET JOB NUMBER IN A
	IDIVI A,10.
	MOVE C,B
	IDIVI A,10.
	DPB B,[060300,,C]
	DPB A,[140300,,C]
	ADDI C,202020
	HRLZ A,C
	HRRI A,'PAL
	MOVSI B,'TMP
	SETZB C,W
	INIT CMDC,17
	 SIXBIT /DSK/
	 0
	 JRST TMPGVP
	LOOKUP CMDC,A
	 JRST TMPGVP
	MOVS A,W		;-WORD COUNT
	MOVN A,A
	CAIL A,TTIBSZ
	 JRST TMPGVP
	INPUT CMDC,[-TTIBSZ,,TMPBUF-1 ? 0]
	RELEASE CMDC,
	JRST TMPFIL

TMPGVP:	RELEASE CMDC,
	SETOM CTLCF
	JRST RESTR1
];END OF IFN SAIL CONDITIONAL
	
RESTR1:	CALL	TTILIN		;READ COMMAND FROM TTY.
RESTR9:
IFN ITS,.SUSET	[.RSNAM,,MSNAME]
ifn its&newbin,[
    	move	a,[441000,,outbuf]
	movem	a,outbp
	]
IFN SAIL,[
	MOVEI	A,0
	DSKPPN	A,
	MOVEM	A,MSNAME
]
	SKIPN	N,TTICNT	;SAVE NUM CHARS FOR PASS 2.
	 JRST	FINIS5		;NULL COMMAND, EXIT OR RESTART.
	MOVE	N,TTICNT
	MOVEM	N,TTICSV
IFN ITS, 	MOVEI	N,"I+"T_8	;%OPSYS IS ITS
IFN SAIL,	MOVEI	N,"S+"A_8	;%OPSYS IS SAIL
IFN TENEX,[			;%OPSYS IS TENEX OR TWENEX
IFN TWENEX,	MOVEI	N,"T+"W_8	;%OPSYS IS TWENEX
IFE TWENEX,	MOVEI	N,"T+"E_8	;%OPSYS IS TENEX
]
	MOVEM 	N,%OPSYS	;SAVE
	CALL	GETDAT		;PUT ASCII DATE & TIME INTO DATTIM.

;SEE WHETHER COMMAND CONTAINS UNQUOTED "_".
;ALSO, COUNT THE /L'S AND /H'S IN THE CMD STRING,
;AND SET THE BITS FOR ALL OTHER SWITCHES EXCEPT /T.
	SETOM	LSWCN1
	SAVE	TTICNT
	SAVE	TTIPNT
TSTAR0:	CALL	RFILE		;READ ALL FILENAMES.
	TRZN	F,ENDBIT	;UNTIL END OF CMD STRING.
	JRST	TSTAR0
	TLZ	AF,TTYFLG	;CANCEL /T SWITCH.
	TRZN	F,ARWBIT	;IF SAW NO ARROW,
	TLO	F,NULBIT	;SAY SO.
	REST	TTIPNT
	REST	TTICNT
	MOVE	A,LSWCN1	;SAVE # OF /L'S WHERE REMAINING PASSES
	MOVEM	A,LSWCNT	;THRU CMD STRING WON'T CHANGE IT.
;FALLS THROUGH
;FALLS THROUGH.
;COMPUTE SIZES OF AND SET UP POINTERS TO VARIOUS TABLES.
;; doubled symbol table size to 2**11 from 2**10 -CBF 8 Jan 83
	MOVEI	A,2_11.		;GET HASH TABLE SIZE.
	LSH	A,@HSWCNT
	SUBI	A,1
	MOVEM	A,SYMLEN	;STORE IT.
	MOVNM	A,SYMAOB	;STORE AOBJN PTR.
	HRLZS	SYMAOB
	MOVE	B,SYMTBA	;SYMTAB START + # ENTRIES =
	ADDI	B,1(A)		;ADDR OF TABLE OF 2ND WDS (VALUES)
	HRRM	B,VALPNT
	ADDI	B,(A)		;ADDR OF WD AFTER ITS END.
	MOVEM	B,MACTOP	;MACRO STORAGE STARTS THERE.
	ADDI	B,100

;NOW ALLOCATE CORE FOR THEM.
IFN ITS,[
	LSH	B,-10.
	.CORE	1(B)
	.VALUE
	.SUSET	[.RMEMT,,JOBREL]
]
IFN TENEX,[
	MOVEM	B,JOBREL
]
IFN SAIL,[
	CORE	B,
	 BUG
]
	HRRZ	A,SYMTBA
	HRLS	A		;CLEAR THE CORE WE JUST GOT.
	ADDI	A,1
	MOVE	B,JOBREL
	SETZM	-1(A)
	BLT	A,-1(B)

;PUT INITIAL SYMBOLS INTO HASH TABLE.
	MOVE	B,[-INILEN,,INITAB]
INIT0:	MOVE	N,(B)		;GET, HASH NAME.
	CALL	SRCH
	 JFCL
	AOBJN	B,.+1
	MOVE	A,(B)		;GET, STORE VALUE.
	MOVEM	A,@VALPNT
	MOVEM	N,@SYMPNT
	AOBJN	B,INIT0
;FALLS THROUGH.
;FALLS THROUGH.
;READ THE FILE NAMES AND OPEN THE FILES.
	MOVE	B,MSNAME	;DEFAULT SNAME.
	MOVEM	B,RFILSN
	CALL	GETBIN		;INITIALIZE THE BINARY FILE
	CALL	GETLST		;INITIALIZE THE LISTING FILE
	CALL	GETERR		;   ERROR FILE.
	TLO	AF,P1F		;MUST SAY PASS 1 BEFORE CALL INIPAS.
	CALL	INIPAS
	CALL	GETSRC		;INITIALIZE THE SOURCE FILE
	MOVEI	S,BINDEV
	TLNE	F,BINBIT	;IF SHOULD OPEN BINARY, DO IT NOW.
	 CALL	OINIT
	MOVEI	S,LSTDEV
	TLNE	F,LSTBIT
	 TLNE	F,TTYBIT
	  JRST	INIT1
	CALL	OINIT		;IF SUPPOSED TO, OPEN LST FILE,
	SETOM	LSTOPN		;AND SAY IT'S OK TO OUTPUT TO IT NOW.
INIT1:	MOVEI	S,ERRDEV
	TLNE	F,ERQBIT	;OPEN ERR FILE IF WANTED.
	 CALL	OINIT		;(DON'T SET ERRBIT TILL ERR FILE OPENED
	TLNE	F,ERQBIT	;SO ERRORS OPENING SRC, BIN, LST DON'T GET IOCERR
	 TLO	F,ERRBIT	;TRYING TO PUT ERR MSG IN ERR FILE)
IFN ITS,[
	TLNE	F,DSWBIT	;IF SAID TO DISOWN SELF, DO IT.
	CALL	INITD
]
	CALL	ASSEMB		;CALL THE ASSEMBLER
;FALLS THROUGH
;FALLS THROUGH.
;PRINT VARIOUS MESSAGES ON TTY ABOUT THE ASSEMBLY.
	CALL	ERRFCR		;TURN ON TTY OUTPUT, SKIP A LINE
	SKIPN	A,ERRNUM	;TEST ERRORS, LOAD A
	JRST	NOERRS
	CALL	ERRDEC		;PRINT NUM. ERRS.
	MOVEI	A,[ASCIZ/ Errors Detected/]
	CALL	ERRSTR
	CALL	ERR2CR
NOERRS:	MOVE	A,INSLEN	;GET AVERAGE INSN LENGTH.
	JUMPE	A,FINIS1	;(NO MESSAGE IF NO INSNS)
	IMULI	A,10.
	IDIV	A,INSCNT
	IDIVI	A,10.		;WANT THE 1ST FRACTIONAL DIGIT.
	SAVE	B
	CALL	ERRDEC		;TYPE INTEGER PART.
	MOVEI	B,".
	CALL	ERROUT
	REST	A
	CALL	ERRDEC		;TYPE FRACTIONAL DIGIT.
	MOVEI	A,[ASCIZ/ Words Average Instruction Length/]
	CALL	ERRSTR
	CALL	ERR2CR
FINIS1:
IFN ITS,[
	.SUSET	[.RRUNT,,A]	;CURRENT RUNTIME.
	SUB	A,IRUNTM	;DEDUCT STARTING TIME
	IDIVI	A,10000.	;CONVERT TO SECONDS.
	IMULI	A,4069.
]
IFN TENEX,[
	MOVEI A,400000		;RUN TIME OF THIS FORK
	RUNTM
	SUB A,IRUNTM		;MINUS WHEN STARTED ASSY
]
IFN SAIL,[
	MOVEI A,0
	RUNTIM A,
	SUB A,IRUNTM
]
	IDIV	A,TIMDIV	;A_# SECONDS, B_FRACTION.
	LSH	B,1
	CAML	B,TIMDIV	;>1/2 SECOND => ROUND UP.
	 ADDI	A,1
	CALL	ERRDEC		;PRINT NUM. SECONDS.
	MOVEI	A,[ASCIZ / Seconds Runtime/]
	CALL	ERRSTR
	CALL	ERRCR
;FALLS THROUGH.
;FALLS THROUGH.
;CLOSE AND MAYBE RENNAME THE FILES.
	SETOM	NONFTL		;ASSEMBLY FINISHED, OK TO RENAME BIN, LST.

;COME HERE IF ENCOUNTER FATAL ERROR. (EG TOO MANY SYMS)
FINIS2:	MOVEI	S,ERRDEV	;RENAME ERR FILE (IF ANY) IN ANY CASE.
	CALL	OCLOS1
	MOVEI	S,SRCJFN-JFN
	CALL	ICLOSE		;CLOSE SRC FILE.
	CALL	BINCLS		;CLOSE BINARY, WRITE LAST BUFFER.
	TLNN	F,TTYBIT
	TLNN	F,LSTBIT	;IF HAVE LST FILE,
	JRST	FINIS5
	CALL	LSTCLS		;FINISH LAST BLOCK OF LISTING
FINIS5:
IFN ITS,.LOGOUT			;...IF DISOWNED.
	SKIPN	CTLCF		;EXIT IF SHOULD,
	JRST	RESTRT		;ELSE NEW CMD STRING.
IFN ITS,	.BREAK	16,160000
IFN SAIL,	EXIT
IFN TENEX,	RESET ? HALTF

IFN ITS,[
;DISOWN SELF, DON'T DO TTY I-O.
INITD:	.OPEN	TTI,[SIXBIT/   NUL/]
	.VALUE			;PREVENT "TTY" IO FROM HANGING.
	.OPEN	TTO,[SIXBIT/  !NUL/]
	.VALUE
	.VALUE	[ASCIZ/:PROCEED :DISOWN /]	;GIVE BACK TTY.
	RET
]
;ROUTINES TO READ AND DEFAULT THE NAMES FOR THE OUTPUT FILES,
;AND TO DECIDE WHICH OF THEM ARE WANTED.
;THESE ROUTINES DO NOT ACTUALLY OPEN THE FILES.
;THEY DO SOMETIMES INITIALIZE BUFFERS, ETC.

;INITIALIZE A BINARY FILE, DEFAULTING DEV TO DSK, FN2 TO BIN.
;IF /P IS GIVEN, ALWAYS WRITE TO PTP IN 8-BIT MODE.
;ELSE IF NULL FILSPEC, NO BIN.

GETBIN:	CALL	RFIL0
	TLNN	F,PSWBIT+NULBIT+SYMBIT	;/P OR /S OR NO "_"
	SKIPE	RFILP		;OR NONNULL BIN SPEC
	TLNE	F,BSWBIT	;AND IF /B NOT GIVEN,
	RET
	MOVE	B,[RFILN,,BINDEV]	;MAKE BIN FILE.
	BLT	B,BINSNM	;COPY NAMES.
	SKIPN	B,BINFN2
IFN RELCOD, MOVSI B,'REL
IFN NEWBIN,IFE RELCOD,MOVE B,[SIXBIT /PBIN/]
IFE NEWBIN,IFE RELCOD,MOVSI B,'BIN
	MOVEM	B,BINFN2	;DEFAULT THE FN2, AND THE DEV.
	MOVSI	B,'DSK
	TLNE	F,PSWBIT
	MOVSI	B,'PTP
	SKIPN	BINDEV
	MOVEM	B,BINDEV
	TLNE	F,PSWBIT	;/P IMPLIES NO SYMS.
	 TLO	F,SYMBIT
	TLO	F,BINBIT	;SAY WE'RE MAKING A BIN FILE.
	SETZM	BINCNT		;SAY NOTHING YET PUT IN BINBUF
	RET

;INITIALIZE A LISTING FILE
;IF ARWBIT OR ENDBIT, DOESN'T ACTUALLY READ ANYTHING.
;IF ON TTY, SETS TTYBIT.

GETLST:	CALL	RFILL		;READ FILE NAME, SET FOR INPUT.
	SKIPGE	LSWCNT		;IF AT LEAST 1 /L APPEARED,
	TLNE	F,RSWBIT+CSWBIT	;OR /R OR /C,
	JRST	.+3
	SKIPN	RFILP		;OR NONNULL LST SPEC => WRITE LST.
	RET
	SKIPGE	LSWCNT		;IF NO /L'S IN CMD, SAY THERE WAS 1.
	 SETZM	LSWCNT		;(LIST ON PASS 2 ONLY)
	MOVS	B,RFILN		;FULL WORD DEVICE NAME
	CAIE	B,'TTY
	JRST	GETLS1
	TLO	F,TTYBIT+LSTBIT
	JRST	ERRTTY		;TEST FOR RUNNING DISOWNED.

GETLS1:	MOVE	B,[RFILN,,LSTDEV]
	BLT	B,LSTSNM	;COPY NAMES FROM SPEC.
	MOVSI	B,'DSK
	SKIPN	LSTDEV
	MOVEM	B,LSTDEV

IFN ITS,	MOVE	B,[SIXBIT/LIST/]
IFN TENEX+SAIL,	MOVSI	B,'LST
		TLNE	F,CSWBIT	;DEFAULT FN2 TO LIST,
IFN ITS,	MOVE	B,[SIXBIT/CREF/]	;OR CREF IF /C.
IFN TENEX+SAIL,	MOVSI	B,'CRF
		SKIPN	LSTFN2
		MOVEM	B,LSTFN2

	TLO	F,LSTBIT	;ELSE INDICATE HAVE LISTING.
	SETZM	LSTCNT		;SAY NOTHING YET PUT IN LSTBUF
	RET

;DECIDE WHETHER AN ERROR OUTPUT FILE IS WANTED,
;AND READ AND DEFAULT IT'S NAMES IF IT IS.
GETERR:	CALL	RFILL		;READ IN NAMES.
	TLNE	F,DSWBIT+NSWBIT+ESWBIT ;IF WON'T HAVE ERRORS ON TTY,
	JRST	.+3		;OR /E WAS GIVEN,
	SKIPN	RFILP		;OR HAD ERR SPEC,
	RET
	MOVE	B,[RFILN,,ERRDEV]
	BLT	B,ERRSNM	;COPY NAMES FOR LATER RENAME.
	MOVSI	B,'DSK
	SKIPN	ERRDEV
	MOVEM	B,ERRDEV
	MOVE	B,[SIXBIT/ERRORS/]
	SKIPN	ERRFN2
	MOVEM	B,ERRFN2
	TLO	F,ERQBIT	;SAY WE'RE MAKING AN ERROR FILE.
	RET
;INITIALIZE A SOURCE FILE
;READS THE FILENAMES FROM THE COMMAND BUFFER,
;DEFAULTING DEVICE, SNAME AND FN1 TO THOSE PREVIOUSLY USED,
;DEFAULTING FN2 TO '>' .
;OPENS THE FILE AND SAVES REAL FN1 AND FN2 FOR PRINTING ON LISTING.

GETSRC:	SAVE	N,A
	CALL	RFILE		;READ FILE NAME.
;ENTER HERE FOR .INSRT AFTER PUSHING SRC INFO ON MACPDL.
GETINS:	SAVE	S
IFN ITS,	MOVSI	B,(SIXBIT/>/)
;IFN TENEX,	MOVSI B,'P11
IFN TENEX,	MOVE B,[SIXBIT/PALX/]
IFN SAIL,	MOVSI B,'PAL
	SKIPN	RFILN2		;DEFAULT 2ND NAME.
	MOVEM	B,RFILN2
	SETZM	SRCEOF		;HAVEN'T SEEN .EOT IN THIS FILE.
	SETZM	SRCTTY		;ASSUME THIS FILE ISN'T THE TTY.
	MOVS	B,RFILN		;DON'T REOPEN TTY! (WOULD .RESET)
	CAIN	B,(SIXBIT/TTY/)
	JRST	GETSR1
	MOVEI	S,SRCJFN-JFN
	CALL	IINIT		;OPEN SRC FILE.
	 JRST	GETSX1		;FAILED.
GETSR1:	SKIPE	SRCDPH		;IF THIS IS PART OF .INSRT, LIST THE LINE WITH THE PSEUDO.
	CALL	ENDLF
	SKIPN	RFILN1		;IF DEV HAS NO NAMES,
	MOVEM	N,RFILN1	;STORE SPECIFIED NAME.
	MOVE	N,RFILN1
	SKIPN	LSTFN1		;DEFAULT LST, BIN, ERR FN1'S TO SRC'S.
	MOVEM	N,LSTFN1
	SKIPN	BINFN1
	MOVEM	N,BINFN1
	SKIPN	ERRFN1
	MOVEM	N,ERRFN1
	AOS	B,SRCCNT	;SRCNUM IDENTIFIES THIS SRC FILE.
	MOVEM	B,SRCNUM
	MOVE	B,SRCBPT	;SAVE PTR TO START OF BUFFER.
	MOVEM	B,SRCPNT
	MOVEM	B,SRCBND	;SAY BUFFER EMPTY.
	MOVEI	B,^C
	IDPB	B,SRCBND
	SETOB	B,PAGEXT	;NOW STARTING PAGE 1.
	MOVNM	B,PAGNUM
	SETZM	SLNCNT		;LINE 1.
	TRO	F,HDRBIT	;START PAGE IN LISTING
IFN ITS+SAIL,[
	MOVE	B,[440600,,RFILN2]
	SETZ	0,		;ACCUM. %FNAM2 IN 0.
FNAM2A:	ILDB	A,B
	CAIL	A,'0		;IGNORE NON-DIGITS.
	CAILE	A,'9
	JRST	FNAM2B
	IMULI	0,10.		;READ IN DIGITS AS DECIMAL NUM.
	ADDI	0,-'0(A)
FNAM2B:	TLNE	B,770000	;READ TILL END OF WD.
	JRST	FNAM2A
	MOVEM	0,%FNAM2	;SET VALUE OF %FNAM2.
]
IFN TENEX,[	;USE FILE VERSION # AS %FNAM2.
	SAVE	C
	SETZM	%FNAM2		; ASSUME IS ZERO (INCASE NOT DSK)
	MOVS	B,RFILN		; GET DEVICE NAME
	CAIE	B,'DSK		; DSK?
	JRST	FNAM2C		; NO - SKIP GTFDB
	MOVE	A,SRCJFN
	MOVE	B,[1,,7]	;READ THE VERSION #.
	MOVEI	C,%FNAM2	;INTO %FNAM2.
	GTFDB
	HLRZS	%FNAM2		;VERSION RETURNED IN LH.
FNAM2C:	REST	C
]
	REST	S,A,0
	MOVS	B,RFILN
	CAIE	B,'TTY	;IF SRC IS TTY,
	RET
	SETOM	SRCTTY		;SPECIAL STUFF FOR INPUT.
ERRTTY:	TLNN	F,DSWBIT	;IF WILL BE DISOWNED, CAN'T USE TTY.
	RET
	CALL	ERRFCR
	MOVEI	A,[ASCIZ/Using TTY while disowned?/]
	JRST	CMDERR

;.INSRT PSEUDO - PUSH INTO FILE WHOSE NAME FOLLOWS THE PSEUDO.
AINSRT:
IFN SAIL,[
	SKIPE SRCTTY
	JRST AINSR3		;.INSRT IN TTY INPUT IS OK
	MOVE B,RFILN
	CAME B,[SIXBIT /DSK/]
	 ERROR1 ENDL,.INSRT in non-disk source
]
AINSR3:	MOVE	A,SRCDPH	;DON'T ALLOW PUSH TOO DEEP.
	CAIL	A,SRCPSZ
	 ERROR1	ENDL,.INSRT PDL overflow
	SAVE	F,RFILN,RFILN1,RFILN2,RFILSN
	MOVSI	B,'DSK		;DON'T CLOBBER CMD-STRING NAME DEFAULTS,
	MOVEM	B,RFILN		;DEFAULT THIS FILE'S DEV TO DSK.
	TRO	F,INSBIT+CHRBIT	;TELL RFILE TO READ FROM ASSEMBLY INPUT.
	CALL	RFILE		;READ NAME OF FILE TO INSERT.
	SETCHAR
	TRZA	F,INSBIT	;MOVE TO END OF LINE .INSRT'S ON.
AINSR1:	CALL	@GETCHA
	CAIE	I,^J
	JRST	AINSR1
AINSR2:	HRRZ	B,MACPDP	;PUSH OUTER FILE'S NAMES ONTO MACPDL.
IFN TENEX,[PUSH	B,SRCJFN
	SETOM	SRCJFN]
IFN SAIL,[
	PUSH B,SRCREC
	PUSH B,SRCWL
]
	REST	1(B),2(B),3(B),4(B),F
	MOVEI	B,4(B)
IRPS X,,SLNCNT PAGEXT PAGNUM SRCTTY SRCBPT SRCPNT SRCBND SRCNUM MP
	PUSH	B,X
TERMIN
	HRRM	B,MACPDP	;SAVE ALL INFO ON CURRENT SRC FILE
	SETZ	MP,		;PUSH OUT OF ANY MACRO CALL.
	AOS	B,SRCDPH	;ONE .INSRT LEVEL DEEPER NOW.
IFN ITS+TENEX,	ADDI	B,200(B)
IFN ITS,[.IOPUS	SRC,
	SYSCAL	CORBLK,[(SETZ 1000) ? 1000,,-1 ? 1000,,(B) ? 1000,,400001]
	SYSCAL	CORBLK,[(SETZ 1000) ? 1000,,-1 ? 1000,,1(B) ? 1000,,-1 ? 1000,,0]
;THOSE CALLS GET FRESH PAGE # 200+2N, SHARE PAGE 0 AS PAGE 200+2N+1.
]
IFN ITS+TENEX,[
	LSH	B,10.		;ADDR OF START OF FRESH PAGE.
	HRRM	B,SRCBPT	;THAT PAGE IS BUFFER FOR THIS SRC FILE.
]
IFN SAIL,[
	MOVE B,[440700,,SRCBUF]
	MOVEM B,SRCBPT
]
	CALL	GCHSE0		;GET CHARS FROM SRC FILE (NOT FROM MACROS, ETC)
	SAVE	N,A
	JRST	GETINS		;NOW GO OPEN INSERTED FILE.

GETSX1:	SKIPN	SRCDPH		;INPUT OPEN FAILED:
	 JRST	OPENL		;NOT IN .INSRT => FATAL.
	MOVSI	B,'TTY		;IN .INSRT, CHANGE DEV. TO TTY:
	MOVEM	B,RFILN
	SAVE	F
	TLZ	F,NSWBIT	;TYPE OUT THIS ERR MSG EVEN IF DON'T TYPE MOST ERRORS.
	ERROR1	[.INSRT OPEN failed, TTY: inserted instead:]
	REST	F
	JRST	GETSR1
;OPEN AN INPUT FILE. S POINTS TO ITS FILE BLOCK.
;ONLY THE JFN AND MOD WORDS OF THE FILE BLOCK MUST EXIST.
;THE FILENAMES ARE ASSUMED TO BE IN RFILN, RFILN1, RFILN2, RFILSN.
IINIT:
IFN ITS,[
	SYSCL	OPEN,[JFN(S) ? 4000,,MOD(S) ? RFILN ? RFILN1 ? RFILN2 ? RFILSN]
	 RET
	HRLZ	B,JFN(S)
	HRRI	B,RFILN
	MOVE	N,RFILN1	;SAVE IN CASE NON-DIR-DEV.
	.RCHST	B,		;GET REAL FN1, FN2.
	HRLZS	RFILN
	JRST	POPJ1
]
IFN TENEX,[
	SAVE A,B
	CALL ICLOSE
	MOVEI A,RFILN1
	CALL JBKINI
	MOVEI A,JBLOCK+2
	SKIPE C,RFILN
	CALL JBKSIX
	MOVSI A,100000		;OLD FILE, INPUT
	MOVEM A,JBLOCK
	MOVEI A,JBLOCK
	MOVEI B,0
	GTJFN
	 JRST POPBAJ	;CANT GET JFN OF SOURCE
	MOVEM A,JFN(S)
	MOVE B,[070000,,200000]	;READ, ASCII
	OPENF
	 JRST POPBAJ
	REST B,A
	JRST POPJ1
]
IFN SAIL,[
	MOVE A,RFILN
	MOVEM A,OPNDV
	SETZM OPNHD
	MOVEI A,10
	HRRZ B,JFN(S)
	CAIN B,SRC
	MOVEI A,17
	CAIN B,CMDC
	MOVEI A,0
	MOVEM A,OPNMD
	MOVEI A,HDR(S)
	MOVEM A,OPNHD
	MOVS A,JFN(S)
	LSH A,5
	IOR A,[OPEN OPNMD]
	XCT A
	RET
	MOVE A,RFILN1
	MOVEM A,ENTNM
	MOVE A,RFILN2
	HLLZM A,ENTEX
	MOVE A,RFILSN
	MOVEM A,ENTPPN
	MOVS A,JFN(S)
	LSH A,5
	IOR A,[LOOKUP ENTNM]
	XCT A
	RET
	MOVS A,ENTPPN
	MOVNM A,SRCWL	;# WORDS LEFT IN FILE
	SETZM SRCREC	;ZERO RECORD COUNT
	JRST POPJ1
]

;OPEN AN OUTPUT FILE. S POINTS TO THE FILE BLOCK.
;THE FILE BLOCK SHOULD LOOK LIKE THAT OF THE LST, BIN FILES.
IFN TENEX,[
OINIT:	MOVEI A,[SIXBIT /^PAL11ERR         /]
	CALL JBKINI
	MOVEI A,JBLOCK+2
	SKIPE C,DEV(S)
	CALL JBKSIX
	MOVEI	A,JBLOCK+4
	SKIPE C,TNM(S)
	CALL JBKSIX
	MOVSI A,400000
	MOVEM A,JBLOCK
	MOVEI A,JBLOCK
	MOVEI B,0
	GTJFN
	  JRST OPENLB
	MOVEM A,JFN(S)
	LDB B,[020100,,MOD(S)]
	MOVE B,OPENTB(B)	; GET CORRECT OPEN BITS
	OPENF
	 JRST	OPENLB
	RET

OPENTB:	070000,,100000
IFN RELCOD, 440000,,100000
IFE RELCOD, 100000,,100000
]
IFN ITS,[
OINIT:	SYSCL	OPEN,[JFN(S) ? DEV(S) ? [SIXBIT/_PALX_/]
		 TNM(S) ? SNM(S) ? 4000,,MOD(S)]
	 JRST	OPENLB
	RET
]


IFN SAIL,[
OINIT:	MOVE A,MOD(S)	;GET 0 FOR ASCII OR 10 FOR BINARY.
	TRNN A,4
	 TDZA A,A
	MOVEI A,10
	MOVEM A,OPNMD	;BUFFERED OUTPUT
	MOVE A,DEV(S)
	MOVEM A,OPNDV
	MOVSI A,HDR(S)
	HLLZM A,OPNHD
	MOVS A,JFN(S)
	LSH A,5
	IOR A,[OPEN OPNMD]
	XCT A
	JRST OPENLB
	MOVE A,FN1(S)
	MOVEM A,ENTNM
	MOVE A,FN2(S)
	HLLZM A,ENTEX
	SETZM ENTEX+1
	MOVE A,SNM(S)
	MOVEM A,ENTPPN
	MOVS A,JFN(S)
	LSH A,5
	IOR A,[ENTER ENTNM]
	XCT A
	JRST OPENLB
	MOVE A,MOD(S)
	MOVEI B,8
	TRNE A,10
	 DPB B,[300600,,PNT(S)]	; CHANGE BYTE SIZE TO 8
	MOVEI A,BUF(S)
	EXCH A,JOBFF
	MOVS B,JFN(S)
	LSH B,5
	IOR B,[OUTBUF 1]
	XCT B
	MOVEM A,JOBFF
	RET
]
;TTILIN,TTILN - READ IN A COMMAND, PROCESSING RUBOUTS, PROMPTING WITH "*"
IFE TWENEX,[
TTILIN:	SETZM	%TTYFL
	MOVEI	B,"*
	SETZM	CTLSF
	CALL	TYO

TTILN:	SETZM	%TTYFL
	SETZM	CTLSF
	SETZM	TTICNT		;NO CHARS READ YET.
	MOVE	B,[440700,,TTIBUF]
	SKIPE	SRCTTY
	 HRR	B,SRCBPT
	TLNE	AF,TTMFLG	;FOR .TTYMAC, READ INTO LINBUF.
	 HRRI	B,LINBUF
TTIRU1:	MOVEM	B,TTIPNT
TTILUP:	UNIIB	TTI
	CAIE	B,^J
	 CAIN	B,^_
	  MOVEI	B,^M
	CAIN	B,^M
	 JRST	TTICR		;^M MEANS ALL READ.
IFN TENEX,CAIE	B,^A
	CAIN	B,177
	 JRST	TTIRUB
	CAIE	B,33		;ALTMODE, AND SAIL'S EOF CHR,
	 CAIN	B,612
	  JRST	TTICTC
	CAIE	B,^Z
	 CAIN	B,^C
	  JRST	TTICTC		;^C - END LINE, CAUSE EXIT.
IFN TENEX,CAIE	B,^Q
	 CAIN	B,^U
	  JRST	TTIRU2		;^U - CANCEL COMMAND.
	CAIN B,^X
	 MOVEI B,"_		;TV BACKARROW (UNDERSCORE AT SAIL) WINS TOO
	IDPB	B,TTIPNT	;NORMAL CHAR.
	AOS	TTICNT
	JRST	TTILUP

TTICTC:	CALL	TTYCR
	TLNE	AF,TTMFLG
	 RET
	SETOM	SRCEOF		;IF TTY IS SRC, EOF.
	SKIPN	SRCTTY
	 SETOM	CTLCF		;IF THIS IS CMD STR, EXIT AFTERWARDS.
TTICR:
IFN TWENEX,UNIIB TTI		;READ AND THROW AWAY ^J FOLLOWING ^M
	TLNN	AF,TTMFLG
	 SKIPE	SRCTTY
	  RET
	MOVE	B,[440700,,TTIBUF]
	MOVEM	B,TTIPNT	;SET UP FOR REMOVAL OF CHARS.
	RET

TTIRUB:	SOSGE	TTICNT		;IF NO CHAR TO RUB, RETRY.
	JRST	TTIRU2
	LDB	B,TTIPNT
	CALL	TYO		;PRINT DELETED CHARACTER
	MOVSI	B,070000
	ADD	B,TTIPNT
	JUMPGE	B,TTIRU1	;J IF STILL IN SAME WD.
	SUB	B,[430000,,1]	;ELSE BACK UP 1.
	JRST	TTIRU1

TTIRU2:	SOS	(P)		;RUBOUT WITH EMPTY BUFFER.
	JRST	TTYCR		;RETURN TO CALL TO TTILIN OR TTILN.
]
IFN TWENEX,[
TTILIN:	SETZM %TTYFL
	SETZM CTLSF
	MOVEI B,"*
	CALL TYO
	SAVE C
	HRROI C,[ASCIZ "*"]
	JRST TTILN1

TTILN:	SAVE C
	MOVEI C,0
	SETZM %TTYFL
	SETZM CTLSF
TTILN1:	SAVE A
	MOVE A,[440700,,TTIBUF]
	SKIPE SRCTTY
	 HRR A,SRCBPT
	TLNE AF,TTMFLG		;FOR .TTYMAC, READ INTO LINBUF.
	 HRRI A,LINBUF
	HRRZM A,TTICNT
	MOVE B,[RD%BRK\RD%BEL\RD%CRF\TTIBSZ]
	RDTTY
	 HALTF
	LDB C,A
	SUB A,TTICNT		;CONVERT TO COUNT NOT INCLUDING TERMINATOR
	MULI A,5		; ...
	SUBI B,-4(A)		; ...
	HRRZM B,TTICNT
	TLNE AF,TTMFLG
	 JRST TTILN2
	MOVE B,[440700,,TTIBUF]
	SKIPN SRCTTY
	 MOVEM B,TTIPNT		;SET UP FOR REMOVAL OF CHARS.
	CAIE C,^Z
	 JRST TTILN2
	SETOM SRCEOF		;IF TTY IS SRC, EOF.
	SKIPN SRCTTY
	 SETOM CTLCF		;IF THIS IS CMD STR, EXIT AFTERWARDS.
TTILN2:	REST A
	REST C
	RET
]
;READ IN THE LST OR ERR FILE NAMES.
RFILL:	SETZM	RFILP		;LST: 0 IF ARW OR NUL, 1 ELSE.
	CAIA
RFIL0:	SETOM	RFILP		;BIN: 0 IF SPEC EXISTS & IS EMPTY.
	SETZM	RFILN		;CAUSE DEFAULTING OF DEV, FN1, FN2 INDIVIDUALLY.
	SETZM	RFILN1
	SETZM	RFILN2
	TLNN	F,NULBIT	;EXIT IF NO MORE OUTPUT SPECS.
	TRNE	F,ARWBIT
	RET
	SETZM	RFILP

RFILE:	SAVE	V		;B.P. INTO NAME GOES IN T0.
	SETZM	RFILN2		;FORCE DEFAULTING OF FN2.
RFNAM0:	MOVEI	B,RFXCTB	;COUNT HOW MANY NAMES SO FAR.
	MOVEM	B,RFILNC
RFNAME:	SETZ	0,		;GET NEXT NAME; RESET NAME, B.P.
	MOVE	V,[440600,,0]
RFLOOP:	CALL	TTICHR		;READ A CHAR.
IFE SAIL,TRNN	F,INSBIT	;COMMA ORDINARY CHAR. IN .INSRT .
	CAIE	B,",
	CAIN	B,^M
	JRST	RFSPAC		;", , ^M TERMINATE SPEC.
IFN SAIL,[
	CAIE	B,"[
	CAIN	B,"]
	 JRST	RFSPAC
	TRNN	F,INSBIT	;! IN INSERT FILE NAME . . .
	 TRNE	F,ARWBIT	;     OR "SOURCE" FILE NAME . . .
	  JRST	RFLOP1		;	DOESN'T CAUSE A SWAP!!
	CAIN	B,"!
	 JRST	RFSPAC
RFLOP1:
]
	TRNN	F,INSBIT	;_ ALSO ORDINARY IN .INSRT .
	CAIE	B,"_
	CAIN	B,<" >
	JRST	RFSPAC		;THESE ALSO.
	CAIN	B,":
	JRST	RFCOL		;COLON SETS DEV.
	CAIN	B,";
	JRST	RFSEM		;SEMI SETS SNAME.
IFN TENEX+SAIL,[
	CAIN B,".
	JRST RFSPAC
]
	TRNE	F,INSBIT	;NO COMMAND FILES OR SWITCHES IN .INSRT'S.
	 JRST	RFLOO1
	CAIN	B,"@
	JRST	RFATSN		;@ -- USE CMD FILE.
	CAIN	B,"/
	JRST	RFSPAC		;SLASH ENDS NAME.
RFLOO1:	CAIN	B,^R		;^R - RESET FILENAME COUNTER.
	 JRST	RFSPAC
	CAIN	B,^Q		;^Q - QUOTE NEXT CHAR.
	CALL	TTICHR
	MOVEI	B,-40(B)	;NORMAL - CONV. TO SIXBIT.
	TLNE	V,770000	;PUT IN NAME IF ROOM LEFT.
	IDPB	B,V
	JRST	RFLOOP
RFXCTB:	MOVEM	0,RFILN+1		;TABLE EXECUTED BELOW
	MOVEM	0,RFILN2
	MOVEM	0,RFILN
	MOVEM	0,RFILSN
	SKIPA

IFN SAIL,[
	HRRM 0,RFILSN
	HRLM 0,RFILSN
RFPPTB=.
]

RFCOL:	SKIPE	0
	MOVEM	0,RFILN
	SETOM	RFILP		;INDICATE NOT NULL.
	JRST	RFNAME

RFSEM:	SKIPE	0
	MOVEM	0,RFILSN	;SIMILAR BUT SET SNAME INSTEAD.
	SETOM	RFILP
	JRST	RFNAME

RFSPAC:
IFN SAIL,[
	SKIPL V,RFPPNF
	JRST RFSPAZ		;NOT PROCESSING PPN NOW
	JUMPE 0,RFSPZ3
RFSPZ1:	TRNE 0,77
	JRST RFSPZ2
	LSH 0,-6
	JRST RFSPZ1
RFSPZ2:	TLNN 0,77
	JRST RFSPZ4
	LSH 0,-6
	JRST RFSPZ2
RFSPZ4:	XCT RFPPTB(V)
	SOS RFPPNF
RFSPZ3:	CAIE B,",
	JRST [SETZM RFPPNF ? JRST RFSPA0]
	MOVNI B,2
	MOVEM B,RFPPNF
	JRST RFNAME
]
IFE SAIL,RFSPAC:
RFSPAZ:	JUMPE	0,RFSPA0	;IF NAME WAS READ,
	XCT	@RFILNC		;STORE IT,
	AOS	RFILNC		;COUNT NAMES SO FAR.
	SETOM	RFILP		;SAY NON-NULL SPEC.
RFSPA0:	CAIN	B,^R		;^R - RESET FILENAME COUNTER.
	 JRST	RFNAM0
IFN TENEX,	CAIE B,".
	CAIN	B,40
	JRST	RFNAME		;SPACE -- GET ANOTHER NAME.
IFN SAIL,[
	CAIN	B,".
	 JRST	[HLLOS RFILN2 ? JRST RFNAME]	;INDICATE NULL FN2
	CAIN	B,"[
	 JRST	[SETOM RFPPNF ? JRST RFNAME]
	CAIN	B,"]
	 JRST	RFNAME
	CAIN	B,"!
	 JRST	RFSWAP
]
	CAIE	B,"/
	JRST	RFSPA1		;SLASH -- READ A SWITCH
	CALL	TTICHR
	SETZ	V,

DEFINE	SWITCH	A,D
	CAIN	B,"A
	HRROI V,D
TERMIN			;MACRO TO HANDLE NORMAL SWITCH.

	SWITCH	B,BSWBIT	;/B - SUPPRESS BINARY.
	SWITCH	C,CSWBIT	;/C - CREF LISTING.
IFN ITS,SWITCH	D,DSWBIT+NSWBIT	;/D - DISOWN SELF.
	SWITCH	E,ESWBIT	;/E - FORCE ERROR FILE OUTPUT.
	CAIN	B,"H		;/H - DOUBLE SYMTAB SIZE.
	 JRST	[AOS HSWCNT ? JRST RFNAME]
	CAIN	B,"L		;/L - ONCE => LIST, TWICE => BOTH PASSES.
	 JRST	[AOS LSWCN1 ? JRST RFNAME]
	SWITCH	M,MSWBIT	;/M - NO MACRO LISTING.
	SWITCH	N,NSWBIT	;/N - NO ERROR MSGS ON TTY.
IFE RELCOD, SWITCH P,PSWBIT	;/P - BINARY ON PTP:.
	SWITCH	R,RSWBIT	;/R - REPRODUCE SOURCE IN LISTING.
IFE RELCOD, SWITCH S,SYMBIT	;/S - NO SYMS IN BINARY.
	CAIN	B,"V		;/V - SET # LINES/PAGE IN LISTING.
	 JRST	RFVSW
	CAIE	B,"T		;/T - COMPLEMENT TTY-TYPE LISTING.
	JUMPE	V,ERRSW		;IF INVALID SWITCH.
	TLO	F,(V)
	TRNN	V,-1		;HANDLE /T SPECIALLY.
	TLC	AF,TTYFLG
	JRST	RFNAME		;SWITCH DONE, READ ANOTHER NAME.

RFSPA1:	CAIN B,^X		;TV BACKARROW OR UNDERSCORE OR WHATEVER
	 MOVEI B,"_
	CAIE	B,"_
	 JRST RFSP1A
	TRO	F,ARWBIT	;_ -- SAY SAW AN _.
	SETOM RFILP	;IF THIS SPEC WAS THE LAST OUTPUT SPEC, ASSUME NON-NULL.
RFSP1A:	CAIN	B,^M
	TRO	F,ENDBIT
POPVJ:	REST	V
	RET
IFN SAIL,[
RFSWAP:	MOVSI	V,(SIXBIT /DSK/)
	SKIPN	RFILSN
	MOVSI	V,(SIXBIT /SYS/)
	SKIPN	B,RFILN		;FILL IN SWPBLK WITH SOME REASONABLE DEFAULTS
	 MOVE	B,V
	MOVEM	B,SWPBLK
	MOVE	B,RFILN1
	MOVEM	B,SWPNAM
	SKIPN	B,RFILN2
	 MOVSI	B,(SIXBIT /DMP/)
	HLLZM	B,SWPEXT	;MODE BITS IN RIGHT HALF
	SKIPE	B,CCLFLG	;START IN RPG MODE ONLY IF PALX STARTED THAT WAY
	 MOVEI	B,1		;YEP
	MOVEM	B,SWPSA
	SKIPN	B,RFILSN
	 MOVE	B,MSNAME
	MOVEM	B,SWPPPN
	SETZM	SWPNPP
	MOVEI	B,SWPBLK
	SWAP	B,
	JRST	4,.		;BUT DID HE EVER RETURN?
				;NO, HE'LL NEVER RETURN.
				;AND HIS FATE IS STILL UNLEARNED!
				;HE MAY RIDE FOREVER 'NEATH THE STREETS OF BOSTON.
				;HE'S THE MAN WHO NEVER RETURNED!
];SAIL
;/V SWITCH - FOLLOW BY NUMBER, "L" OR "X", SETS #LINES/PAGE.
RFVSW:	CALL	RFDECN		;READ DECIMAL # FROM TTY.
	CAIN	B,"L		;L MEANS USE SIZE OF LPT.
	 MOVEI	V,PAGLPT
	CAIN	B,"X		;X MEANS USE SIZE OF XGP.
	 MOVEI	V,PAGXGP
	MOVEM	V,PAGSIZ
	JRST	RFNAME

;READ DECIMAL NUMBER FROM COMMAND INPUT STREAM.
RFDECN:	SETZ	V,		;AND RETURN IT IN V.
RFDEC1:	CALL	TTICHR
	CAIL	B,"0
	CAILE	B,"9
	 RET			;RETURN ON NNON-DIGIT.
	IMULI	V,10.
	ADDI	V,-"0(B)
	JRST	RFDEC1

;COME AFTER READING AN "@";  READ IN CMD FILE NAME, OPEN IT.
RFATSN:	SAVE	RFILP,RFILNC,N,S,RFILSN
	MOVSI	B,-3
RFATS0:	SAVE	RFILN(B)	;SAVE, ZERO FILEAMES.
	SETZM	RFILN(B)
	AOBJN	B,RFATS0
	CALL	RFILE		;READ CMD FILE NAMES.
	MOVEI	B,(SIXBIT/CMD/)
	SKIPN	RFILN2
	MOVSM	B,RFILN2	;DEFAULT THE FN2.
	MOVSI	B,'DSK
	SKIPN	RFILN
	MOVEM	B,RFILN		;DEFAULT THE DEV.
	SKIPE	B,CMDFIL	;IF ALREADY INSIDE CMD FILE,
IFN TENEX,[CALL [MOVE N,CMDCJF
		MOVEM N,CMDPDL(B) ;REMEMBER JFN OF OUTER CMD FILE.
		RET]]
IFN ITS,.IOPUS	CMDC,		;SAVE IT.
IFN SAIL,[
	CALL [	IOPUSH CMDC,0		;SPECIFY ZERO IOPUSH ID
		 JRST [	CALL ERRFCR
			MOVEI A,[ASCIZ/Too many levels of indirect command file indirection/]
			JRST CMDERR	]
		RET ]
];IFN SAIL
	AOS	CMDFIL
	MOVEI	S,CMDCJF-JFN
	CALL	IINIT		;INIT. INPUT FILE ON(OR PUT) CHNL IN CMDJFN
	 CALL	OPENL
	REST	RFILN2,RFILN1,RFILN,RFILSN,S,N,RFILNC,RFILP
	MOVEI	B," 		;SPACE BEFORE CMD FILE.
	TRZ	F,ENDBIT	;IN CASE CR AFTER CMD FILE SPEC.
	JRST	RFSPAC

;GET NEXT CMD STRING CHAR.
TTICHR:	TRZE	F,CHRBIT	;CHRBIT => RE-READ LAST SOURCE CHAR.
	 JRST	[LDB B,IP ? JRST TTILC]
	TRNE	F,INSBIT	;IF READING FILENAME FOR .INSRT,
	 JRST	[CALL	@GETCHA	;READ FROM ASSEMBLY INPUT,
		 MOVEI	B,(I)
		 JRST	TTILC]
	SKIPE	CMDFIL		;IF NO CMD FILE, GET FROM COMMAND BUF
	 JRST	TTICH1
	SOSGE	TTICNT		;IF NO CHARS LEFT,
	 SKIPA	B,[^M]		;SAY EOL.
	  ILDB	B,TTIPNT	;ELSE GET NEXT CHAR FROM BUFFER.
TTILC:	CAIL	B,140		;CONVERT LOWER CASE TO UPPER.
	 SUBI	B,40
	RET

TTICH1:	UNIIB	CMDC,		;READ FROM CMD FILE INTO B.
	JUMPE B,TTICH1
	CAIE	B,^J		;TREAT ^M, ^J IN FILES AS SPACES.
	 CAIN	B,^M
	  MOVEI	B,<" >
	CAIN	B,^L
	 JRST	TTICH2		;^L ENDS CMD FILE.
	CAIE	B,^C
	 JUMPGE	B,TTILC
TTICH2:	SAVE	A,B,S		;EOF IN CMD FILE, POP OUT OF IT.
	MOVEI	S,CMDCJF-JFN
	CALL	ICLOSE		;CLOSE INPUT ON CHNL IN CMDCJFN
	SOSE	B,CMDFIL
IFN ITS,.IOPOP	CMDC,		;ANOTHER CMD FILE OUTSIDE, POP IT.
IFN SAIL,[
	CALL [	IOPOP CMDC,0
		 BUG		;WAS NOTHING PUSHED
		RET	]
];IFN SAIL
IFN TENEX,[CALL	[MOVE B,CMDPDL(B)
		MOVEM B,CMDCJFN	;RESTORE CMD JFN TO THAT OF OUTER FILE.
		RET]]
	REST	S,B,A
	MOVEI	B," 		;PUT SPACE AFTER CMD FILE.
	RET
;I/O ROUTINES

LSTSP:	MOVEI	B," 
	JRST	LSTOUT
LSTCR:	TDZA	B,B
LSTTAB:	MOVEI	B,11
LSTOUT:	TRZE	F,HDRBIT	;START NEW PAGE IF WAS REQUESTED.
	CALL	HEADER
LSTSRC:	NEWLIN	LSTDMP		;TURN ^@ INTO ^M^J.
LSTDMP:	TLNE	F,TTYBIT	;IF LISTING ON TTY,
	 JRST	LSTDM0		;WRITE ON IT INSTEAD.
	SKIPN	LSTOPN
	RET			;DON'T OUTPUT TO LST FILE IF IT ISN'T REALLY OPEN.
	SOSG	LSTCNT		;DECREMENT ITEM COUNT
	CALL	LIST1		;EMPTY ENTIRE BUFFER
	IDPB	B,LSTPNT	;STORE THE CHARACTER
LSTDM1:	CAIE	B,^J		;IF LF,
	RET
	SOSG	LINCNT		;COUNT 1 LINE IN PAGE.
	TRO	F,HDRBIT
	RET

LSTDM0:	CALL	TYO
	JRST	LSTDM1

LIST1:
IFN SAIL,[
	OUT	LST,
	 RET
	BUG
]
.ELSE [
	SAVE	A,B,C,W
	MOVE	B,[440700,,LSTBUF]
	MOVEM	B,LSTPNT
	SKIPGE	C,LSTCNT
	 JRST	LIST1A		 ;NOTHING WAS EVER PUT IN LSTBUF.
	SUBI	C,5*LSTBSZ	;-<# CHARS TO OUTPUT>
	OUTBFR	LST,5
LIST1A:	MOVEI	A,5*LSTBSZ
	MOVEM	A,LSTCNT
	REST	W
	JRST	POPCBA
]

LSTCLS:
IFN ITS\TENEX,[
	SOS	LSTCNT		;LIST1 ASSUMES LSTCNT SOS'S ONCE TOO MANNY.
IFN ITS,[
	MOVE	A,LSTCNT
	IDIVI	A,5
	MOVEI	C,FILCHR
LSTCL1:	SOJL	B,LSTCL2
	SOS	LSTCNT
	IDPB	C,LSTPNT
	JRST	LSTCL1
LSTCL2:	]
	SKIPL	LSTCNT		;IF ANYTHING WAS EVER OUTPUT,
	 CALL	LIST1		;WE HAVE A PARTIAL BUFFER TO WRITE OUT.
]

	SETZM	LSTOPN
	MOVEI	S,LSTDEV
	JRST	OCLOSE		;CLOSE FILE (MAYBE RENAME)
;START NEW PAGE IN LISTING.
HEADER:	SAVE	F,0,A,B
	TLO	F,NSWBIT	;DON'T OUTPUT TO TTY
	TLZ	F,ERRBIT	;  OR ERROR FILE.
	MOVEI	B,14		;OUTPUT A FORM FEED
	CALL	LSTDMP
	MOVE	B,PAGSIZ	;RESET LINE COUNTER REGISTER
	SUBI	B,3
	MOVEM	B,LINCNT
	TLNE	F,RSWBIT	;NO HEADERS IF OUTPUTTING SOURCE.
	JRST	HEADE2
	CALL	LSTTAB
	MOVE	N,[440700,,TITBUF]
	CALL	LSTSTR		;LIST THE TITLE.
	CAME	N,[350700,,TITBUF]
	CALL	LSTTAB		;AND TAB IF TITLE NONNULL.
	MOVE	N,[SIXBIT/PALX/]
	CALL	LSTSIX
	CALL	LSTSP
	MOVEI	N,.FVERS
	CALL	LSTNUM
	CALL	LSTTAB
	MOVE	N,[440700,,DATTIM]
	CALL	LSTSTR
PPAGE==[440700,,[ASCIZ/	Page /]]
	MOVE	N,PPAGE
	CALL	LSTSTR		;PRINT '	PAGE '
	AOS	A,PAGTOT	;PRINT LISTING PAGE'S NUMBER.
	CALL	ERRDEC
	CALL	LSTCR
	CALL	LSTTAB
	CALL	LSTFIL		;PRINT SRC FILE'S NAME
	MOVE	N,PPAGE
	CALL	LSTSTR		;PRINT '	PAGE '
	MOVE	A,PAGNUM	;AND SRC PAGE'S NUMBER.
	CALL	ERRDEC
	AOSN	A,PAGEXT
	JRST	HEADE1
	MOVEI	B,".		;HANDLE CONTINUATION PAGES' NUMBERS.
	CALL	LSTDMP
	CALL	ERRDEC
HEADE1:	CALL	LSTSP
	CALL	LSTTAB
	MOVE	0,[440700,,STITBF]
	CALL	LSTSTR		;LIST SUBTITLE.
	CALL	ERR2CR
HEADE2:	REST	B,A,0,F
	RET

;OUTPUT ASCIZ STRING <- BP IN N TO LST.
LSTSTR:	ILDB	B,N
	JUMPE	B,CPOPJ
	CALL	LSTDMP
	JRST	LSTSTR
TTYOUT:	NEWLIN	TYO		;TURN ^@ INTO ^M^J.
TYO:
TTYDMP:	SKIPE	%TTYFL
	 RET
	UNIOB	TTO
	RET

TTYCR:	SAVE	B
	MOVEI	B,^M
	CALL	TYO
	MOVEI	B,^J
	CALL	TYO
	JRST	POPBJ

;OUTPUT SIXBIT WD IN N TO TTY.
TTOSIX:	SAVE	B
TTOSI1:	SETZ	A,
	ROTC	N,6
	JUMPE	A,POPBJ
	MOVEI	B,40(A)
	CALL	TYO
	JRST	TTOSI1

;OUTPUT DECIMAL NUMBER IN N TO TTY.
TTODEC:	PUSH P,A
	PUSH P,B
	MOVE A,N
	PUSHJ P,TTODC1
	POP P,B
	POP P,A
	POPJ P,

TTODC1:	IDIVI A,10.
	HRLM B,(P)
	SKIPE A
	 PUSHJ P,TTODC1
	HLRZ B,(P)
	ADDI B,"0
	JRST TYO

;GET CHAR FROM SOURCE FILE.
GCHS:	ILDB	I,SRCPNT
	CAIGE	I,^M		;IF ORD. CHAR,
	JRST	GCHS0
GCHR1:	IDPB	I,IP		;SAVE FOR RESCAN, LISTING.
	MOVEM	IP,LINIP
	CAMN	IP,[010700,,LINBUF+CPL/5]
	CALL	GCHSEL		;IF FULL, LIST NEXT TIME.
	RET

GCHS0:	JUMPE I,GCHS		;IGNORE NULL CHARS
	CAIN	I,^J
	JRST	GCHSLF
	CAIN	I,^L		;HANDLE SPECIAL CHARS.
	JRST	GCHSFF
	CAIE	I,^C		;ONLY ^C, ^J, ^L REALLY SPECIAL.
	JRST	GCHR1
	MOVE	I,SRCPNT	;^C - AT END OF BUFFER?
	CAMN	I,SRCBND
	JRST	GCHBUF		;YES, READ NEXT BUFFER.
	JRST	GCHEOF		;NO,  THIS IS EOF.

GCHSFF:	AOS	PAGNUM		;FF - INCREM SOURCE PAGE.
	SETOM	PAGEXT
	SETZM	SLNCNT		;1ST LINE THEREOF.
GCHMFF:	TRO	F,HDRBIT	;NEW LISTING PAGE.
	JRST	@GETCHA		;SKIP FF, GET ANOTHER CHAR.

;LF - INCREM SOURCE LINE NUM, SAY HAVE WHOLE LINE.
GCHSLF:	AOS	SLNCNT
GCHMLF:	CALL	GCHSEL
	JRST	GCHR1		;STORE CHAR AS USUAL.
;READ NEXT SOURCE BUFFER.
GCHBUF:	SKIPE	SRCEOF		;IF INTERNAL EOF,
	JRST	GCHEOF		;GET NEXT FILE.
	SKIPE	SRCTTY
	JRST	GCHTTY		;IF FROM TTY, HANDLE RUBOUTS.
IFN ITS,[
	HRRZ	I,SRCBPT	;ADDR OF START OF BUFFER.
	HRLI	I,-SRCBSZ	;AOBJN -> BUFFER.
	.IOT	SRC,I		;READ IN BUFFERFULL.
	HLRZ	I,I
	MOVEI	I,SRCBSZ(I)	;NUM. WDS READ.
	JUMPE	I,GCHEOF		;NONE READ MEANS EOF.
	ADD	I,SRCBPT
	MOVEM	I,SRCBND	;POINT AFTER LAST WD READ.
]
IFN TENEX,[
	SAVE A,B,C
	MOVE A,SRCJFN
	HRRO B,SRCBPT
	MOVNI C,5*SRCBSZ
	SIN
	MOVEM B,SRCBND
	MOVEI I,SRCBSZ*5(C)
	REST C,B,A
	JUMPE I,GCHEOF
]
IFN SAIL,[
	SKIPN SRCWL
	JRST GCHEOF
	SAVE I+1
	HRRO I,SRCBPT
	ADD I,[-SRCBSZ,,-1]
	MOVEI I+1,0
	IN SRC,I
	 JRST GCHBU1
	STATO SRC,20000		;EOF?
	 JRST [	OUTSTR [ASCIZ /Input lossage in source input
/]
		JRST 4,.]
	MOVN I,SRCWL
	CAIA
GCHBU1:	MOVNI I,SRCBSZ
	ADDM I,SRCWL
	REST I+1
	AOS SRCREC
	MOVNS I		;# WORDS READ
	ADD I,SRCBPT
	MOVEM I,SRCBND
]
GCHBF1:	MOVEI	I,^C
	IDPB	I,SRCBND	;PUT ^C AFTER BUFFER.
GCHBF2:	MOVE	I,SRCBPT
	MOVEM	I,SRCPNT
	JRST	GCHS		;GO READ 1ST OF CHARS READ.

;READ SOURCE LINE FROM TTY.
GCHTTY:	SAVE	TTIPNT,TTICNT	;TTILIN WILL CLOBBER THESE.
	CALL	TTILN
	MOVEI	I,^M
	IDPB	I,TTIPNT
	MOVEI	I,^J
	IDPB	I,TTIPNT	;TERMINATE LINE PROPERLY.
	MOVE	I,TTIPNT
	MOVEM	I,SRCBND	;REMEMBER END OF BUFFER.
	REST	TTICNT,TTIPNT
	JRST	GCHBF1		;SET UP SRCPNT, READ 1ST CHAR.

GCHEOF:
	SKIPN	SRCDPH		;IF EOF IN .INSRT FILE,
	 JRST	GCHEO1
IFN ITS,[
	LDB	I,[121000,,SRCBPT]	;FLUSH THE FILE'S BUFFER.
	SYSCAL	CORBLK,[1000,, ? 1000,,-1 ? I]
	.IOPOP	SRC,
]
IFN TENEX,[
	SAVE	A,B,C,S
	SETO	A,		;INDICATE DELETE PAGE,
	LDB	B,[111100,,SRCBPT]	;GET PAGE #,
	HRLI	B,4^5		;SAY IN SELF.
	SETZ	C,
	PMAP			;DELETE THE 2 PAGES USED FOR A BUFFER.
	AOS	B
	PMAP
	MOVEI	S,SRCJFN-JFN
	CALL	ICLOSE		;RELEASE THE JFN OF FILE JUST ENDED.
	REST	S,C,B,A
]
	HRRO	I,MACPDP	;GET SRCPDL PTR, -1 IN LH SO NO PDLOV
IRPS X,,[MP SRCNUM SRCBND SRCPNT SRCBPT SRCTTY PAGNUM PAGEXT SLNCNT
RFILN RFILN1 RFILN2 RFILSN]
	POP	I,X
TERMIN
IFN SAIL,[
	SAVE A,B
	POP I,SRCWL
	POP I,SRCREC
	SKIPE SRCTTY
	JRST GCHETT		;BACK TO TTY
	OPEN SRC,[	17
			SIXBIT /DSK/
			0]
	JRST 4,.
	MOVE A,RFILN1
	MOVEM A,ENTNM
	MOVE A,RFILN2
	CAMN A,[-1]
	MOVEI A,0
	MOVEM A,ENTEX
	SETZM ENTEX+1
	MOVE A,RFILSN
	MOVEM A,ENTPPN
	LOOKUP SRC,ENTNM
	JRST 4,.
	USETI SRC,@SRCREC
	MOVSI A,-SRCBSZ
	HRRI A,SRCBUF-1
	MOVEI B,0
	IN SRC,A
	 JRST GCHEOX
	STATO SRC,20000		;EOF?
	 JRST [	OUTSTR [ASCIZ /Input lossage in source input
/]
		JRST 4,.]
GCHEOX:	REST B,A
]
IFN TENEX,POP	I,SRCJFN
	HRRM	I,MACPDP
	TRO	F,HDRBIT	;NEW PAGE IN LISTING.
	SOS	SRCDPH		;EXITED 1 .INSRT FILE.
	SETZM	SRCEOF
	CALL	GCHSET		;MIGHT BE POPPING INTO MACRO.
	JRST	@GETCHA		;TRY AGAIN TO READ CHAR.

GCHEO1:	TRNE	F,ENDBIT	;CRR SEEN BY COMMAND SCANNER?
	JRST	GCHSND		;NO, NO END STMT.
	CALL	GETSRC		;GET THE NEXT SOURCE FILE
	JRST	GCHBUF

;COME HERE ON EOF OF LAST SRC FILE.
GCHSND:	ERROR1	No END Statement
	TLO	AF,ENDFLG	;MAKE THIS LAST LINE OF PASS.
	MOVEI	I,^J
	JRST	GCHSLF		;MAKE THIS LAST CHAR OF LINE.

IFN SAIL,[
GCHETT:	MOVE A,SRCBPT
	MOVEM A,SRCPNT
	MOVEM A,SRCBND
	MOVEI A,^C
	IDPB A,SRCBND
	JRST GCHEOX
]
;GET CHAR FROM MACRO.
GCHM:	ILDB	I,MP
GCHM1:	CAIL	I,^K
	JRST	GCHR1		;<15, ORD. CHAR, JUST STORE & GO.
	JUMPE	I,GCHMNL	;^@ - GO TO NEXT BLOCK.
	CAIN	I,^J
	JRST	GCHMLF		;^J - HAVE WHOLE LINE.
	CAIE	I,^C
	JRST	GCHR1		;ALL BUT ^C NORMAL CHARS.
	CALL	READMB		;^C - SPECIAL CODE FOLLOWS.
	TRZE	I,100		;IF >= 100,
	JRST	GETDS		; MEANS SUBSTITUTE A MACRO ARG.
	CALL	@GCHMT-1(I)	;ELSE MEANS POP THIS STRING.
	JRST	@GETCHA	;AFTER TERMINATING, GET NEXT CHAR.

GCHMT:	PHASE	1
QUEMAC::@MACXIT		;^C^A - END READING STRING (REPEAT, IRP OR MACRO)
QUEARG::DSEND		;^C^B - END MACRO ARG.
	DEPHASE

GCHMNL:	HRR	MP,(MP)	;^@ - TRACE LINK TO NEXT BLOCK.
	LDB	I,MP
	JRST	GCHM1


;GET CHAR WHILE RESCANNING.
GCHI:	CAMN	IP,LINIP
	JRST	GCHI0
	ILDB	I,IP
	RET
GCHI0:	CALL	GCHSET		;DONE REREADING, CHOSE NEW SOURCE,
	SETCHAR
	CAIE	I,^J		;RESET GCHL IF NEC.
	CAMN	IP,[010700,,LINBUF+CPL/5]
	CALL	GCHSEL
	JRST	GETCHR		;GET CHAR FROM IT.

GCHSET:	MOVEI	I,GCHM		;IF MP>0 USE GCHM
	JUMPN	MP,GCHSE1
GCHSE0:	MOVEI	I,GCHS		;ELSE READ FROM SRC.
GCHSE1:	HRRM	I,GETCHA
	RET
;START NEW LINE, READ 1ST CHAR.
GETLIN:	MOVE	IP,LINPNT
	MOVEM	IP,LINIP	;RE-START BUFFER.

;READ 1 CHAR INTO I.  IMPURE!!
GETCHR:
GETCHA:	JRST	GCHS		;OR GCHM, GCHI, GCHL .

GCHL:	SAVE	A,B
	CALL	ENDLA		;DECIDE WHETHER TO LIST.
	TRNE	AF,ERRP1	;IF WERE ERRORS,
	MOVEI	A,ERROUT	; PRINT ON TTY.
	CALL	LOTAB		;IN TTY FMT LISTING, 2 TABS.
	CALL	(A)
	TLNN	AF,TTYFLG
	CALL	(A)		;NORMAL FMT, 2 MORE.
	TLNN	AF,TTYFLG
	CALL	(A)
	MOVE	I,LINPNT
GCHL1:	CAMN	I,LINIP		;UNTIL THE END OF THE LINE,
	 JRST	GCHL2
	ILDB	B,I		;FETCH AND LIST THE CHARS IN LINBUF.
	CALL	(A)
	JRST	GCHL1

GCHL2:	CAIN	B,^J		;IF DIDN'T END W/ CRLF,
	JRST	GETCH3
	MOVEI	B,^M		;OUTPUT CRLF ANYWAY.
	CALL	(A)
	MOVEI	B,^J
	CALL	(A)
GETCH3:	REST	B,A
	CALL	GCHSET		;RESTORE SOURCE.
	JRST	GETLIN		;RESTART BUFFER, FETCH.

;SET TO LIST LINE WHERN FETCH NEXT CHAR.
GCHSEL:	TLO	AF,SRCFLG
	MOVEI	IP,GCHL
	HRRM	IP,GETCHA
	MOVE	IP,LINIP
	RET
;ROUTINE TO OUTPUT RELOCATABLE BINARY

IFE RELCOD,[
; THIS NOT NEEDED IF MAKING RELOCATABLE

BINOUT:				;BINARY OUTPUT
	ANDI	B,377		;MASK TO 8 BITS
SYMOUT:	TLNE	F,PSWBIT
	JRST	BINPPB
	SOSG	BINCNT
	CALL	BINDMP
	IDPB	B,BINPNT
	RET

BINPPB:	UNIOB	BIN
	RET

BINDMP:
IFN SAIL,[
	OUT BIN,
	 RET
	BUG
]
.ELSE [
	SAVE	A,B,C
	MOVE	B,[444400,,BINBUF]
	MOVEM	B,BINPNT
	SKIPGE	C,BINCNT
	 JRST	BINDM1		;NOTHING WAS EVER PUT IN BINBUF.
	SUBI	C,BINBSZ	;-<# WDS TO OUTPUT>
ifn its&newbin, pushj p,outblk
.else	OUTBFR	BIN
BINDM1:	MOVEI	A,BINBSZ
	MOVEM	A,BINCNT	;BUFFER NOW EMPTY.
]
] ;END IFE RELCOD
POPCBA:	REST	C
POPBAJ:	REST	B
POPAJ:	REST	A
	RET

;CLOSE BINARY FILE.
BINCLS:	TLZN	F,BINBIT	;NO MORE BIN OPEN.
	RET
IFE RELCOD,[
	SKIPN	B,BINCNT	;(NOTHING EVER PUT IN BIN BUFFER =>
				;DON'T TRY TO WRITE IT OUT.
	 JRST	BINCL1		;PREVENTS IOCERR IF NO BIN FILE)
	SETZ	B,		;PUT A ZERO AT THE END.
	CALL	BINOUT		;SO LOADERS WILL SEE EOF.
]
IFE RELCOD+SAIL,[
	MOVEI	S,BINDEV
	TLNE	F,PSWBIT	;DON'T .IOT IF UNIT MODE.
	JRST	BINCL1
	SOS	BINCNT		;(SYMOUT DOES THIS SO I WILL)
	CALL	BINDMP		;OUTPUT PARTIAL BUFFER.
]
BINCL1:	MOVEI	S,BINDEV
	SETZ	N,
	JRST	OCLOSE		;CLOSE, MAYBE RENAME.
IFN ITS,[
OCLOSE:	SKIPE	NONFTL		;DON'T RENAME BIN, LST AFTER FATAL ERROR.
OCLOS1:	SYSCL	RENMWO,[JFN(S) ? FN1(S) ? FN2(S)]
	 JFCL
ICLOSE:	SYSCAL	CLOSE,[JFN(S)]
	RET
]
IFN SAIL,[
ICLOSE:
OCLOSE:
OCLOS1:	MOVS A,JFN(S)
	LSH A,5
	TLO A,(CLOSE)
	XCT A
	TLC A,(CLOSE#RELEAS)
	XCT A
	RET
]
IFN TENEX,[
OCLOSE:	SKIPE NONFTL
OCLOS1:	CALL	ORENM
ICLOSE:	SKIPGE A,JFN(S)
	RET
	GTSTS
	JUMPGE B,CLOSR1
	CLOSF
	  JFCL
	JRST CLOSR2
CLOSR1:	RLJFN
	  JFCL
CLOSR2:	SETOM JFN(S)
	RET

ORENM:	SKIPGE A,JFN(S)
	RET
	DVCHR
	TLNN B,100000
	 RET
	MOVE A,JFN(S)
	HRLI A,400000
	CLOSF
	 JFCL
	MOVEI A,FN1(S)
	CALL JBKINI
	MOVEI A,JBLOCK+2
	SKIPE C,DEV(S)
	CALL JBKSIX
	MOVSI A,600000
	MOVEM A,JBLOCK
	MOVEI A,JBLOCK
	MOVEI B,0
	GTJFN
	  JRST RNMXXX
	MOVE B,A
	MOVE A,JFN(S)
	RNAMF
	  JRST RNMXXX
	MOVEM B,JFN(S)
	RET

RNMXXX:	HRROI A,[ASCIZ /
? File RNAMF error
/]
	PSOUT
	RET

JBKINI:	PUSH P,A
	MOVEI A,JBKSTR
	MOVEM A,JBKSPT
	SETZM JBLOCK
	MOVE A,[JBLOCK,,JBLOCK+1]
	BLT A,JBLOCK+10
	MOVE A,[377777,,377777]
	MOVEM A,JBLOCK+1
	MOVEI A,JBLOCK+4	;NAME
	CALL JBKINS
	MOVEI A,JBLOCK+5	;EXT
	CALL JBKINS
	MOVEI A,JBLOCK+3	;USER
	CALL JBKINS
	JRST POPAJ

JBKINS:	AOS C,-1(P)
	SKIPN C,-1(C)
	RET
JBKSIX:	MOVE B,JBKSPT		;CALLED HERE, A/ DSP ADDR, B/ SIXBIT

	HRLI B,440700
	MOVEM B,0(A)
	MOVE A,B
	AOS JBKSPT
	AOS JBKSPT
	MOVEI B,0
	LSHC B,6
	ADDI B,40
	IDPB B,A
	JUMPN C,.-4
	MOVEI B,0
	IDPB B,A
	RET
]
ERRTMS:	CALL	ERRFCR
	MOVEI	A,[ASCIZ/Too many symbols/]
	JRST	CMDERR

ERRSW:	SAVE	B		;SAVE BAD SWITCH.
	CALL	ERRFCR		;TURN ON TYPEOUT AND CRLF.
	MOVEI	B,"/
	CALL	ERROUT
	REST	B
	CALL	ERROUT		;PRINT THE SWITCH.
	MOVEI	A,[ASCIZ / is a bad switch/]
CMDERR:	CALL	ERRSTR
	CALL	ERRCR
CMDER0:	SETZM	CTLCF		;ERROR - GIVE USER ANOTHER CHANCE.
IFN ITS,	.RESET	TTI,
IFN TENEX,[	MOVE A,TTIJFN
	CFIBF
]
IFN SAIL,	CLRBFI
	JRST	FINIS2

;COME HERE AFTER FAILING OUTPUT OPEN.
OPENLB:	HRLI	B,(S)
	HRRI	B,RFILN
	BLT	B,RFILSN
OPENL:	CALL	ERRFCR
	CALL	LSTFIL		;PRINT NAME OF LOSING FILE.
	MOVEI	B,^I
	CALL	ERROUT
	TRO	F,ENDBIT	;PREVENT ERRTF MESSAGE.
IFN ITS,[
	.OPEN	ERRC,OPENLF
	.VALUE
OPENL0:	.IOT	ERRC,B
	CAIN	B,^L
	JRST	CMDER0
	CALL	ERROUT
	JRST	OPENL0

OPENLF:	SIXBIT/   ERR/
	1?0
]

IFN TENEX,[
	HRLOI	B,400000
	MOVEI	A,101
	MOVEI	C,0
	ERSTR
	 JFCL
	 JFCL
	JRST	CMDER0
]
IFN SAIL,[
	MOVEI A,[ASCIZ /Cannot LOOKUP or ENTER/]
	CALL ERRSTR
	JRST CMDER0
]
;ERROR UUO.
UERROR:	TLNE	AF,P1F		;DO NOTHING ON PASS 1.
	JRST	UUOXIT
;ERROR1 UUO.
UERR1:	CALL	ERRFIL		;PRINT FILENAMES IF NEC.
	AOS	ERRNUM		;TALLY ERROR.
	SAVE	N		;HAS SYM. BEING USED, MAYBE.
	MOVE	N,LLABN
	SKIPN	LLABN		;IF DEFINED A LABEL,
	JRST	UERR2
	CALL	LSTSIX		;PRINT . REL. TO IT.
	MOVN	A,LLABV
	ADD	A,L
	ANDI	A,ADRMSK
	JUMPE	A,UERR3		;JUST LABEL IF DISP=0.
	MOVEI	B,"+
	CALL	ERROUT		;AS LABEL+DISP.
	AOS	LINPOS
	CALL	ERROCT
UERR3:	MOVE	N,LINPOS	;MOVE TO POS. 16.
	CAIGE	N,10
UERR2:	CALL	ERRTAB		;NO LABEL, JUST PRINT 2 TABS.
	CALL	ERRTAB
	REST	N
	MOVEI	A,(L)
	CALL	ERROCT		;PRINT LOC. CTR.
	CALL	ERRTAB
	CALL	ERRPGL		;PRINT PAGE AND LINE NUMBER.
	CALL	ERRTAB
	HRRZ	A,40
	CALL	ERRSTR		;PRINT ERROR MESSAGE.
	CALL	ERRCR
	JRST	UUOXIT

ERRPGL:	MOVE	A,PAGNUM	;PRINT PAGE AND LINE NUMBER.
	CALL	ERRDEC
	MOVEI	B,"-
	CALL	ERROUT
	MOVE	A,SLNCNT
	AOJA	A,ERRDEC

ERRFCR:	SETZM	CTLSF		;TURN ON TYPEOUT AND CRLF.
	TLZA	F,NSWBIT
ERR2CR:	CALL	ERRCR		;ERROR-OUTPUT 2 CRLFS.
ERRCR:	TDZA	B,B		;ONLY 1 CRLF.
ERRSP:	MOVEI	B," 		;A SPACE.

;OUTPUT CHAR IN B AS PART OF ERROR MSG (TO LST, MAYBE TO TTY).
ERROUT:	NEWLIN	ERROU1
ERROU1:	TLNE	F,ERRBIT	;OUTPUT TO ERR FILE IF ANY.
	CALL	ERROU2
	TLNN	F,NSWBIT+TTYBIT	;IF LST IS TTY OR ERROR MSGS SUPPR,
	CALL	TYO		; DON'T OUTPUT TO TTY.
	TLNN	F,LSTBIT	;OUTPUT TO LST IF HAVE ONE.
	RET
	JRST	LSTOUT

ERROU2:	UNIOB	ERR
	RET
;DECIMAL PRINT.
ERRDEC:	SKIPA	B,[10.]		;SET RADIX 10.
ERROCT:	MOVEI	B,10		;OR 8.
	MOVEM	B,ERRRDX'	;SAVE IT.
ERROC1:	IDIV	A,ERRRDX
	HRLM	B,(P)		;SAVE NEXT DIGIT.
	SKIPE	A
	CALL	ERROC1
	HLRZ	B,(P)		;GET DIGITS IN REVERSE ORDER.
	ADDI	B,"0
	AOS	LINPOS
	JRST	ERROUT

;PRINT A TAB.
ERRTAB:	MOVEI	B,^I
	JRST	ERROUT

;PRINT ERROR MESSAGE.
ERRSTR:	HRLI	A,440700
ERRMS1:	ILDB	B,A
	CAIG	B,^H		;CTL CHARS ARE SPECIAL.
	JRST	ERRMS2
	CALL	ERROUT
	JRST	ERRMS1
ERRMS2:	XCT	ERRMST(B)
	JRST	ERRMS1

;TABLE OF ACTIONS ON CHARS 0 THRU 8.
ERRMST:	RET			;END OF ASCIZ.
	CALL	LSTSIX		;PRINT SYMBOL'S NAME.
	JRST	ERRMSB		;^B - SET RETURN ADDR.
	JFCL
	TRO	AF,ERRP1	;^D - FORCE LISTING OF LINE.
	CALL	LSTNUM		;^E - DECIMAL NUMBER IN N

ERRMSB:	HRRZ	B,(A)		;SET RET ADDR FROM RH OF WD IN STRING.
	HRRM	B,-4(P)
	TLZ	A,77^4		;SKIP CHARS LEFT IN WD.
	JRST	ERRMS1

;TYPE NAME OF CURRENT INPUT FILE ON TTY.
ERRFIL:	SAVE	F,0
	TLZ	F,LSTBIT	;SO LSTFIL WON'T WRITE TO LST.
	MOVE	N,SRCNUM	;GET # OF FILE OF LAST ERROR.
	CAMN	N,SRCERR	;IF PREV. ERROR WAS IN OTHER FILE,
	JRST	ERRFI1
	MOVEM	N,SRCERR	;SAY LAST ERROR WAS IN THIS FILE.
	MOVE	0,[SIXBIT/FILE/]
	CALL	LSTSIX		;PRINT "FILE" AND FILE'S NAME.
	CALL	ERRTAB
	CALL	LSTFIL
	CALL	ERRCR
ERRFI1:	REST	0,F		;ELSE DO NOTHING.
	RET

LSTNUM:	SAVE	A,B
	MOVE	A,N
	CALL	ERRDEC
	REST	B,A
	RET
;PRINT NAME OF CURRENT FILE ON LST, TTY, ERR.
LSTFIL:	MOVE	N,RFILN
	CAMN	N,[SIXBIT/DSK/]
	JRST	LSTFI1
	CALL	LSTSIX		;PRINT DEV IF NOT DSK.
	MOVEI	B,":
	CALL	ERROUT
	JRST	LSTFI2

LSTFI1:	IFN ITS+TENEX,[
	MOVE	N,RFILSN	;IS DSK - PRINT SNAME
	CALL	LSTSIX
	MOVEI	B,";
	CALL	ERROUT
]
LSTFI2:	MOVE	N,RFILN1
	CALL	LSTSIX		;PRINT 1ST NAME.
	CALL	ERRSP
	MOVE	N,RFILN2
IFN ITS+TENEX,	JRST	LSTSIX		;, 2ND NAME.
IFN SAIL,[
	CAME N,[-1]
	PUSHJ P,LSTSIX
	MOVE B,RFILN
	CAME B,[SIXBIT /DSK/]
	RET
	MOVEI B,"[	;]
	CALL ERROUT
	SAVE A
	MOVEI A,N
	HLLZ N,RFILSN
LSTFI3:	TLNE N,770000
	JRST LSTFI4
	LSH N,6
	JRST LSTFI3
LSTFI4:	CALL LSTSIX
	JUMPN A,LSTFI5
	MOVEI B,",
	CALL ERROUT
	HRLZ N,RFILSN
	AOJA A,LSTFI3
LSTFI5:	REST A	;[
	MOVEI B,"]
	JRST ERROUT
]

;OUTPUT WD IN N AS SIXBIT TO LST, TTO, ERR.
LSTSIX:	SETZM	LINPOS
	TLNN	N,770000
	 JRST	LSTLTG		;LOCAL TAG
LSTSI0:	SAVE	R6
	MOVSI	R6,440600
LSTSI1:	ILDB	B,R6
	JUMPE	B,POPR6J
	ADDI	B," 
	CALL	ERROUT
	AOS	LINPOS		;COUNT CHARS PRINTED.
	TLNE	R6,770000
	 JRST	LSTSI1
POPR6J:	REST	R6
	RET

LSTLTG:	SAVE	N,S		;OUTPUT LOCAL TAG
	HRRZ	S,N		;-> BASE SYMBOL
	MOVE	N,@SYMPNT
	CALL	LSTSI0
	REST	S,N
	MOVEI	B,"/		;SLASH SEPARATES THE TWO SYMBOLS
	AOS	LINPOS
	CALL	ERROUT
	SAVE	A
	HLRZ	A,N		;NNN$
	CALL	ERRDEC
	REST	A
	MOVEI	B,"$
	AOS	LINPOS
	JRST	ERROUT
;GETDAT DATE AND TIME ROUTINE

IFN SAIL,[
GETDAT:	MOVE C,[440700,,DATTIM]
	DATE N,
	IDIVI N,31.
	ADDI A,1	;DAY
	MOVEM A,%DAY
	SAVE A
	IDIVI N,12.
	ADDI A,1	;MONTH
	MOVEM A,%MONTH
	ADDI N,64.	;YEAR
	MOVEM N,%YEAR
	MOVEI B,"/
	CALL GETDA1	;CONVERT A
	REST A
	CALL GETDA2
	MOVE A,N
	CALL GETDA2
	MOVEI B,40
	IDPB B,C
	TIMER N,
	IDIVI N,60.	;NUMBER OF SECOND SINCE MIDNIGHT
	IDIVI N,60.
	SAVE A		;SECS
	IDIVI N,60.
	EXCH N,A
	CALL GETDA2
	MOVEI B,":
	MOVE A,N
	CALL GETDA2
	REST A
	CALL GETDA2
	MOVEI A,0
	RUNTIM A,
	MOVEM A,IRUNTM
	RET

GETDA2:	IDPB B,C
GETDA1:	SAVE B
	IDIVI A,10.
	ADDI A,"0
	IDPB A,C
	ADDI B,"0
	IDPB B,C
	REST B
	RET
]

IFN TENEX,[
GETDAT:	GTAD
	MOVE	B,A		;INTERNAL TENEX FMT TIME AND DATE.
	HRROI	A,DATTIM	;INTO ASCII IN DATTIM.
	SETZ	C,
	ODTIM
	MOVEI	A,400000
	RUNTM			;GET RUNTIME THIS FORK.
	MOVEM	A,IRUNTM
	MOVEM	B,TIMDIV
	SETO 2,			; -1 means use current date and time
	SETZ 4,			; 0 means default options
	ODCNV
	HLRZ A,B		; Year
	SUBI A,1900.
	MOVEM A,%YEAR
	HRRZM B,%MONTH
	AOS %MONTH		; January = 1
	HLRZM C,%DAY
	AOS %DAY
	RET
]

IFN ITS,[
GETDAT:	MOVE	C,[440700,,DATTIM]
	.RDATE	N,		;DATE AS SIXBIT/YYMMDD/
	CALL	GETYMD		;SET UP %YEAR, %MONTH AND %DAY
	ROT	N,14		;NOW SIXBIT/MMDDYY/
	MOVEI	B,"/		;CHAR. TO SEPARATE NUMBERS WITH.
	CALL	GETDA1		;OUTPUT INTO DATTIM.
	MOVEI	B,40
	IDPB	B,C		;2 SPACES.
	IDPB	B,C
	.RTIME	N,		;SIXBIT/HHMMSS/
	MOVEI	B,":		;CHAR. FOR SEPARATOR.
	CALL	GETDA1
	.SUSET	[.RRUNT,,IRUNTM]
	RET

GETDA1:	MOVEI	I,6		;# CHARS TO GET OUT OF N.
GETDA2:	SETZ	A,
	ROTC	N,6		;NEXT CHAR. TO A.
	ADDI	A,40
	IDPB	A,C
	SOJE	I,CPOPJ		;AFTER 6TH, DONE.
	TRNE	I,1
	 JRST	GETDA2
	IDPB	B,C		;AFTER 2ND AND 4TH, SEPARATOR.
	JRST	GETDA2

GETYMD:	SAVE	N,C		;SAVE THE ORIGINAL SIXBIT OF /YYMMDD/
	MOVEI	I,6		;NUMBER OF CHARS TO GET
	MOVEI	C,[%YEAR ? %MONTH ? %DAY]	;WHERE TO PUT THINGS AS WE GET THEM
GETDA3:	SETZI	B,		;ZERO THE NUMBER
GETDA4:	SETZI	A,
	ROTC	N,6		;NEXT CHAR INTO A
	IMULI	B,10.
	SUBI	A,'0		;SUBTRACT SIXBIT OF 0, GIVES REAL NUMBER
	ADD	B,A		;NEW NUMBER
	SOS	I		;DECREMENT COUNTER
	TRNE	I,1		;TEST IT
	 JRST	GETDA4		;GO GET NEXT CHAR IF ODD
	MOVEM	B,@(C)		;STORE THE NUMBER AWAY
	AOS	C		;INCREMENT WHERE TO PUT THINGS
	JUMPG	I,GETDA3	;IF MORE TO DO, DO THEM
	REST	C,N		;RESTORE THE SAVED REGS
	RET			;GET OUT

]
ASSEMB:				;ASSEMBLER PROPER
IFN RELCOD,[
	MOVE	A,[ASCII ".MAIN"]
	MOVEM	A,TITBUF	; SET DEFAULT TITLE TO ".MAIN"
	SETOM	INDWRD		; RELEASE ALL INDIRECT SLOTS
]
	TLNE	F,TTYBIT	;TELETYPE?
	TLC	AF,TTYFLG	;  YES, TOGGLE BIT FOR LISTING
	SETOM	LLABS
	CALL	LINE		;GO DO PASS ONE.
	SETOM	LLABS
	TLZ	AF,P1F		;RESET TO PASS 2
	AOS	VALREQ		;NORMALLY NEED VALUES.
	SETZM	TSLWRD
	SETZM	STITBF
	MOVEI	B,1		;DEFAULT START ADDR IS 1.
	MOVEM	B,STRTLC
	TRZ	F,ENDBIT+FFBIT+ARWBIT
	MOVE	B,[440700,,TTIBUF]
	MOVEM	B,TTIPNT	;RESTART CMD STRING SCAN.
	MOVE	B,TTICSV
	MOVEM	B,TTICNT
	MOVE	B,MSNAME	;SET DEFAULT SNAME TO USER'S.
	MOVEM	B,RFILSN	;FOR THE 1ST INPUT FILE.
	SAVE	F
SETP2A:	TDNE	F,[NULBIT,,ARWBIT]
	JRST	SETP2B		;READ PAST OUTPUT SPECS.
	CALL	RFILE
	JRST	SETP2A
SETP2B:	REST	F
	AOS	LSWCNT		;LIST LINES NOW EVEN IF ONLY ONE /L.
	CALL	INIPAS
	CALL	GETSRC		;READ IN SRC FILE'S NAME, OPEN & INIT.
	CALL	BLKINI		;INITIALIZE BINARY OUTPUT BLOCK
IFN RELCOD,[
	CALL	ENTOUT		; DUMP ENTRY POINT BLOCK
	CALL	NAMOUT		; DUMP NAME BLOCK
	CALL	CODINI		; INITILIZE FOR CODE DUMPING
]
	CALL	LINE		;CALL THE ASSEMBLER (PASS TWO)
IFN RELCOD,[
	CALL	STORLC		; SAVE THE LOCATION COUNTER
]
	CALL	COMPRS
	TLNE	F,BINBIT
	CALL	DUMP2		;OUTPUT END BLOCK, SYMTAB TO BIN.
	TLNE	F,LSTBIT	;LISTING?
	CALL	SYMTB		;  YES, OUTPUT THE SYMBOL TABLE
	RET

INIPAS:	MOVEI	B,%COMP1	;INIT. %COMPAT.
	MOVEM	B,%COMPAT
	MOVEI	B,GCHS		;INIT. GETCHA TO GET FROM SRC.
	HRRM	B,GETCHA
	HLLZS	LOCTR		;CLEAR OFFSET.
	MOVE	B,[004400,,MACPDL-1]
	MOVEM	B,MACPDP	;INIT. MACRO PDL.
	SETZM	MACBPT
	SETZB	L,LLABN		;CLEAR LOCATION COUNTER
IFN RELCOD, TLO AF,LCRFLG	; MAKE LOCATION COUNTER RELOCATABLE
	SETZB	W,MP
	MOVSI	B,'DSK
	MOVEM	B,RFILN		;DEFAULT DEV. FOR 1ST SRC FILE.
	SETZM	SRCDPH		;NOT IN .INSRT FILE.
	SETOM	SRCCNT		;NOW READING 0TH SRC FILE.
	SETZM	SRCERR		;PRETEND HAD HAD ERROR IN THAT FILE.
	MOVE	B,[440700,,SRCBUF]
	MOVEM	B,SRCBPT	;B.P. TO OUTER LEVEL SRC BUFFER.
	TLZ	AF,SRCFLG+LINFLG+RSWFLG
	MOVEI	B,(CALL)
	TLNE	F,CSWBIT	;CREF IF /C AND PASS 2.
	TLNE	AF,P1F
	MOVEI	B,(JFCL)
	HRLM	B,CRFINS
	HRLM	B,CRFIND
	RET
;THE MAIN STATEMENT-READING LOOP OF THE ASSEMBLER.
LINE:	MOVEM	P,LINEPP	;REMEMBER P TO RESTORE IT ON ERRORS THAT RESTART HERE.
LINE1:	CALL	GETLIN		;SET UP LISTING BUFFER ETC FOR NEXT LINE.
	CALL	STMNT		;READ AND PROCESS IT.
	TLZN	AF,ENDFLG	;TEST FOR END STATEMENT
	JRST	LINE1		;GET THE NEXT LINE
	SETZM	LINEPP		;WE'RE NO LONGER INSIDE "LINE" FOR PDL OV'S SAKE.
	TRNN	F,ENDBIT	;IF FILSPECS REMAIN...
	ERROR1	Extra input files
	RET			;END OF PASS


LINPNT:	440700,,LINBUF	;POINTER TO START OF LINE
TYPPNT:	220500,,1	;OP TYPE POINTER

ENDLR:	TLNE	F,RSWBIT	;SUPPRESS IF /R
	TLO	AF,RSWFLG	;SET LOCAL FLAG

ENDL:				;END OF LINE PROCESSOR
	CAIA
ENDL0:	 CALL	GETCHR		;MOVE TILL EOL.
	CAIE	I,^J
	 JRST	ENDL0

ENDLF:				;ENDL FIN
	HLRZ	B,W		;GET TYPE
	XCT	ENDLT2(B)	;EVEN LOCATION TEST
	ERROR1	Word at odd address
	CALL	ENDLA		;DECIDE WHETHER TO LIST.

	TRNE	AF,ERRP1	;IF WAS ^D IN ERROR,
	MOVEI	A,ERROUT	; LIST ON TTY.
	CAIN	A,CPOPJ		;IF WOULDN'T LIST ANYWAY, SKIP WORK.
	JRST	ENDL11
	TLNN	F,RSWBIT	;/R => DON'T LIST OCTAL.
	CALL	PRNTA		;LIST THE OCTAL
	SETZ	B,
	TLNN	AF,SRCFLG	;IF HAVE FULL SRC LINE,
	JRST	ENDL10
	TLNN	F,RSWBIT
	CALL	LOTAB		; LIST IT.
	SKIPA	C,LINPNT	;GET SET TO PRINT LINE
ENDL9:	CALL	0(A)		;LIST A CHARACTER
	ILDB	B,C		;GET ANOTHER CHARACTER
	CAIE	B,^J
	JRST	ENDL9
ENDL10:	CALL	0(A)			;END,LIST CR/LF
	TLNN	F,RSWBIT
	CALL	PRNTB		;LIST EXTENSION LINE, IF ANY

ENDL11:	HLRZ	B,W		;GET TYPE
IFN RELCOD, PUSH P,B		; SAVE THE STMT TYPE
	XCT	ENDLT3(B)	;UPDATE LOCATION COUNTER
	 CALL	DUMP		;OUTPUT WDS IF NEC.
IFN RELCOD,[
	POP	P,B		; RECOVER STMT TYPE
	TLNE	F,BINBIT	; MAKING BINARY --
	TLNE	AF,P1F		; -- OR PASS 2?
	JRST	ENDL12		; NO - DON'T DUMP EXTERNAL REFS
	TLZN	AF,EXTFLG	; ANY EXTERNAL REFERENCES?
	JRST	ENDL12		; NO - THEN DON'T BOTHER TO LOOK
	XCT	ENDLT4(B)	; FIXUP NEEDED? (TO ENDL12 IF NOT)
	CALL	CODUMP		; YES - DUMP CODE BLOCK
	CALL	BLKINI		; RE-INIT BLOCK
	SETZ	C,		; ZERO EXTERNAL POINTER
GLBREF:	SKIPN	EEXTAB(C)	; A GLOBAL REF MADE FOR THIS WORD?
	JRST	GLBNXT		; NO CHECK REST
	MOVE	N,EEXTAB(C)	; YES - GET SYMBOL
	PUSH	P,C		; SAVE REFERENCE LOCATION
	CALL	GRD50		; CONVERT TO RADIX 50
	POP	P,C		; RESTORE LOCATION OF REFERENCE
	TLO	B,600000	; SAY IS GLOBAL REFERENCE
	AOS	A,BYTCNT	; PUT IT INTO --
	MOVEM	B,BLKDAT-1(A)	; -- THE OUTPUT BLOCK
	IBP	RELPNT		; ZERO RELOCATION FOR NAME
	TLNN	AF,LCRFLG	; GET RELOCATION --
	TDZA	B,B		; -- OF LOCATION --
	MOVEI	B,1		; -- OF REFERENCE
	IDPB	B,RELPNT	; AND PUT IN RELOCATION WORD
	MOVEI	B,0(R6)		; GET LOCATION OF REFERENCE
	TLO	B,400000	; SAY@IS ADDITIVE REQUEST
	AOS	A,BYTCNT	; PUT INTO --
	MOVEM	B,BLKDAT-1(A)	; -- THE SYMBOL BLOCK
GLBNXT:	ADDI	R6,2		; INCREMENT REFERENCE LOCATION
	CAIGE	R6,0(L)		; LAST ONE DONE?
	AOJA	C,GLBREF	; NO - DO THEM ALL
	CALL	DMPSYM		; YES - DUMP THE SYMBOL BLOCK
	CALL	CODINI		; RE-INIT FOR CODE DUMPING
ENDL12:
]
	ANDI    L,ADRMSK
IFE RELCOD,[
	SETZB	W,CEXT1		;ZERO ARGUMENT
	SETZM	CEXT2		;  AND EXTENSIONS
]
IFN RELCOD,[
	SETZB	W,CEXT		; CLEAR ARGUEMENTS FOR CODE ..
	MOVE	1,[CEXT,,CEXT+1]
	BLT	1,EEXT2
]
	TRZ	AF,-1
	TLNE	AF,SRCFLG	;IF LISTED LINE, FLUSH CALL TO GCHL.
	CALL	[MOVE	IP,LINPNT	;RESET LINE BUFFER PTR
		 MOVEM	IP,LINIP	;TO BEG. OF BUFFER.
		 JRST	GCHSET]		;GETCHR SHOULDN'T TRY TO LIST LINE.
	TLZ	AF,LINFLG+RSWFLG+SRCFLG
	RET
ENDLT2:	PHASE	0
	CAIA
CL1:	CAIA			; ASSIGNMENT
CL2:	CAIA			; .=
CL3:	TRNE	L,1		; XXXXXX
CL4:	CAIA			;    XXX
CL5:	CAIA			; .END
CL6:	TRNE	L,1		; XXXXXX XXXXXX
CL7:	TRNE	L,1		; XXXXXX XXXXXX XXXXXX
	DEPHASE


ENDLT3:
	PHASE	0
	CAIA
CL1:	CAIA			; ASSIGNMENT
CL2:	SKIPA	L,W		; .=
CL3:	MOVSI	R6,-2		; XXXXXX
CL4:	MOVSI	R6,-1		;    XXX
CL5:	CAIA			; .END
CL6:	MOVSI	R6,-4		; XXXXXX XXXXXX
CL7:	MOVSI	R6,-6		; XXXXXX XXXXXX XXXXXX
	DEPHASE


IFN RELCOD,[

ENDLT4:
	PHASE 0
	JRST	ENDL12
CL1:	JRST	ENDL12		; ASSIGNMENT
CL2:	JRST	ENDL12		; .=
CL3:	MOVEI	R6,-2(L)	; XXXXXX
CL4:	JRST	ENDL12		;    XXX
CL5:	JRST	ENDL12		; .END
CL6:	MOVEI	R6,-4(L)	; XXXXXX XXXXXX
CL7:	MOVEI	R6,-6(L)	; XXXXXX XXXXXX XXXXXX
	DEPHASE
]
;DECIDE WHETHER TO LIST.
ENDLA:	MOVEI	A,CPOPJ		;ASSUME DON'T LIST.
	SKIPN	TSLWRD		;MUST NOT BE .XLISTED,
	TLNN	F,LSTBIT	;MUST HAVE LISTING.
	RET
	TLNE	F,MSWBIT	;IF /M, MUSTN'T BE IN MACRO.
	JUMPN	MP,CPOPJ
	SKIPLE	LSWCNT		;NO /L, OR ONLY 1 /L AND PASS 1, => NO LIST.
	TLNE	AF,LINFLG+RSWFLG	;MUST BE NON-SUPPRESSED.
	RET
	MOVEI	A,LSTOUT	;OK, LIST.
	SKIPN	NOCREF
	TLNN	F,CSWBIT	;IF /C,
	RET
	MOVEI	B,CRFLIN	;INDICATE REAL LINE COMING UP.
	JRST	LSTOUT
STMNT:				;STATEMENT PROCESSOR
	SETZM	OFFST		;CLEAR ADDRESS OFFSET
	CALL	GETSYM		;TRY FOR SYMBOL
	 JRST	STMNT2		;  NO
	CAIN	I,":		;LABEL?
	JRST	LABEL		;  YES
	CAIN	I,"=		;ASSIGNMENT?
	JRST	ASGMT		;  YES
	CALL	SRCH
	 JRST	STMNT3		;TREAT AS EXPRESSION
	XCT	CRFINS
	MOVEI	W,(A)
	LDB	B,TYPPNT	;FOUND, GET TYPE
	JRST	@STMNJT(B)	;GO TO ROUTINE.

STMNJT:	PHASE	0
	STMNT3
NPOP::	STMNT3		;VALUE-RETURNING PSEUDOS.
PSOP::	JRST	0(A)	;PSEUDO-OP, GO TO ROUTINE
CNOP::	JRST	CONDIT	;CONDITIONAL
	IRPS X,,BG OP SC UN BC TR RT FL ML FS
	X!OP::	P!X!OP
	TERMIN
SPOP::	SPOPTB(A)	;MARK, SOB.
MAOP::	JRST	CALLM	;MACROS.
INOP::	STMNT3		;%FNAM2 .
INVOP::	[ CALL 0(A) ? JRST STMNT] ;INVISIBLE PSEUDO-OP.
	DEPHASE

SPOPTB:	BUG		;NO SPECIAL INSN HAS CODE 0.
	JRST PMARK
	JRST PSOB

STMNT2:	CAIE	I,".		;LOC TYPE STATEMENT?
	 JRST	STMNT4		;  NO
	CALL	GETNB		;POSSIBLY, GET NEXT NON-BLANK
	CAIE	I,"=
	 JRST	STMNT3		;  NO
	CALL	GETCHR		;YES, BYPASS CHAR
	CAIN	I,"=
	 CALL	GETCHR		;ALLOW .==
	AOS	VALREQ		;UNDEFS SYMS ARE ERRORS.
	CALL	EXPRF		;EVALUATE THE EXPRESSION
	 ERROR1	No value after ".="
	SOS	VALREQ
IFN RELCOD,[
	CALL	STORLC		; SAVE LOCATION COUNTER
	SKIPG	A		; NEW ONE RELOCATABLE?
	 TLZA	AF,LCRFLG	; NO - MAKE IT ABSOLUTE
	  TLO	AF,LCRFLG	; YES - SAY RELOCATABLE
	TLO	AF,LCHFLG	; SAY LOCATION COUNTER CHANGED
	SKIPE	C
	 ERROR1	Cannot set location counter to external value
]
	SUB	V,LOCTR		;UN-OFFSET.
	LDB	W,[POINT ADRSIZ,V,35]	;GET VALUE
	HRLI	W,CL2		;SET CLASS
IFN RELCOD,[
	SKIPG	A		; RELOCATABLE?
	 AOS	REXTAB		; YES - SAY SO FOR LISTING
]
	JRST	ENDL		;LIST AND EXIT

POPOP::
STMNT3:	RESCAN	SYMBEG
	SETCHAR			;RESET CHARACTER
STMNT4:	CALL	EXPRF		;GET AN EXPRESSION
	 SKIPA			;  NO SOAP
	  JRST	WORDF		;  YES, EXIT THROUGH "WORD"
	CAIN	I,",		;IS THERE A COMMA?
	 JRST	WORDD		;YES, PROCESS A WORD OF ZERO.
	JRST	ENDL		;NO-EXIT NULL

IFN RELCOD,[
;
;    ROUTINE TO SAVE AWAY THE LOCATION COUNTER IN THE
;  PROPER SLOT, DEPENDING UPON WETHER OR NOT IT IS RELOCATABLE.
;  THE VALUE IS ONLY SAVED IF IT IS LARGER THAN THE LAST ONE.

STORLC:	TLZE	AF,LCRFLG	; RELOCATABLE
	 JRST	STOREL		; YES - SAVE THAT WAY
	CAMLE	L,ABSLC		; NO - LARGER THAN LAST?
	 MOVEM	L,ABSLC		; YES - SAVE IT
	RET			; EXIT

STOREL:	CAMLE	L,RELLC		; LARGER THAN LAST?
	 MOVEM	L,RELLC		; YES - SAVE IT
	RET			; EXIT
]
LABEL:	CALL	GETCHR		;PASS BY THE COLON.
	CAIN	I,":
	 TLOA	AF,HKLFLG	;ANOTHER COLON => .5KILL, PASS BY.
	  TLZA	AF,HKLFLG
	CALL	GETCHR
	CALL	SRCH		;SEARCH USER TABLE
	 JFCL
	MOVEI	B,@LOCTR	;GET POINT + OFFSET.


	TLNE	A,UNDSYM	;OK TO DEFINE IF UNDEF.
	 JRST	LABEL4
	TLZE	A,INISYM
	 JRST [	ERROR1 	PDP-11 instruction redefined
		JRST LABEL4]
	TLNN	AF,P1F
	 JRST	LABEL3		;PASS 2, DIFFERENT ERROR MSGS.
	LDB	W,TYPPNT
	JUMPN	W,[ERROR1 	Is reserved
		   JRST LABEL4]
	CAIN	B,(A)		;ELSE ERROR IF NEW VALUE #OLD.
	 TLNE	A,REGSYM+MDLSYM	;OR ALREADY HAD ONE.
	  JRST LABEL9
	JRST LABEL4

;PASS 1 MULT DEF SYMS.
LABEL9:	ERROR1		Label being redefined
	TLO	A,MDLSYM	;SAY THIS SYM IS MUL DEF.
;HERE ACTUALLY REDEFINE THE SYMBOL.
LABEL4:	HRRI	A,(B)		;GET LOC + OFFSET.
	TLZ	A,#NCRSYM#ENTSYM#MDLSYM ;DON'T CLEAR NO-CREF BIT.
	TLO	A,LBLSYM	;SET LABEL FLAG.
	TLZE	AF,HKLFLG	;IS THIS SYMBOL HALF KILLED?
	 TLO	A,HKLSYM	;YES, SAY SO IN IT'S VALUE
IFN RELCOD,[
	TLNE	AF,LCRFLG	; LOCATION COUNTER RELOCATABLE?
	 TLOA	A,RELSYM	; YES - MAKE LABEL RELOCATABLE
	  TLZ	A,RELSYM	; NO - MAKE LABEL ABSOLUTE
]
	MOVEM	N,LLABN		;REMEMBER LAST LABEL DEFINED.
	HRRZM	A,LLABV
	TLNE	N,770000
	 HRRZM	S,LLABS
	CALL	INSRT		;DEFINE IT.
	JRST	STMNT		;EXIT.

;COME HERE FOR LABEL IN PASS 2 .
LABEL3:	TLNN	A,LBLSYM
	 ERROR	LABEL4,	Not a label on pass 1
	TLNE	A,MDLSYM
	 ERROR	LABEL4,	Multiply defined label
	CAIE	B,0(A)
	 ERROR		Out of phase
	JRST	LABEL4
ASGMT:				;ASSIGNMENT PROCESSOR
	PUSH	P,N		;STACK SYMBOL
	CALL	GETCHR		;BYPASS "=
	CAIN	I,"=		;== IS HALF KILLED
	TLOA	AF,HKLFLG
	TLZA	AF,HKLFLG
	CALL	GETCHR		;BYPASS SECOND =
	CAIN	I,"=		;IF THERE'S A THIRD "=",
	TLOA	AF,SUPFLG	;THEN SYMBOL IS FULLY KILLED.
	TLZA	AF,SUPFLG
	CALL	GETCHR
	CALL	EXPR		;  EVAL EXPRESSION.
	 ERROR1	Null value in assignment to 
IFE RELCOD,[			;NON-RELOCATABLE ASSIGNMENT.
ASGMT0:	LDB	W,[POINT ADRSIZ,V,35]	;GET EXPRESSION VALUE.
	HRLI	W,CL1			;SET CLASS.
	POP	P,N		;GET SYMBOL
	CALL	SRCH		;SEARCH USER TABLE.
	 JFCL
	LDB	B,TYPPNT	;IF OLD VALUE A MACRO,
	CAIN	B,MAOP
	 CALL	REMMAC		;GIVE BACK STORAGE.
	CAIN	B,INOP
	 JRST	ASGMT5		;SETTING INDIR. OPS SPECIAL.
	TLZE	A,INISYM
	 JRST [	ERROR1		PDP-11 instruction being redefined
		JRST ASGMT1]
	TLNN	A,LBLSYM	;  LABEL?
	 JRST	ASGMT1		;   NO
	MOVEI	B,(W)
	TLNN	AF,REGFLG	;ERROR IF NEW VALUE NOT = OLD.
	 CAIE	B,(A)
	  TLO	A,MDLSYM
ASGMT1:	TLNN	A,MDLSYM	;MUL DEF?
	 JRST	ASGMT2		; NO
	ERROR1		Label being redefined
ASGMT2:	TLZ	A,#NCRSYM#LBLSYM
	TLNE	AF,REGFLG	;REGISTER EXPRESSION?
	 TLOA	A,REGSYM	;YES--FLAG AND TEST MAGNITUDE.
	  TLZA	A,REGSYM	;NO--RESET AND SKIP TEST.
	   CAIG	V,7		;YES--OUT OF RANGE?
	    JRST ASGMT3		;NO.
	ERRUU1	REGMES
	SETZ	V,		;CLEAR VALUE
ASGMT3:	TRNE	AF,ERRU		;ANY UNDEFINED ERRORS?
	 TLOA	A,UNDSYM	;YES, SET FLAG SAYING SYM IS UNDEFINED.
	  TLZ	A,UNDSYM	;ELSE MARK IT AS DEFINED.
	HRR	A,V		;GET VALUE
	TLZE	AF,HKLFLG	;.5KILL IF NEC.
	 TLO	A,HKLSYM
	TLZE	AF,SUPFLG	;FULLY KILL IF NEC.
	 TLO	A,SUPSYM
	XCT	CRFIND		;INDIC. BEING DEFINED.
	CALL	INSRT		;DEFINE SYMBOL AND EXIT.
	JRST	ENDL

ASGMT5:	DPB	W,[2000+A,,]	;SET IND. OP'S WORD.
	XCT	CRFIND
	JRST	ENDL
]
IFN RELCOD,[
;FALLS THROUGH.
;    THIS ASSIGNMENT PROCESSOR IS FOR THE RELOCATABLE VERSION
;  OF THE ASSEMBLER. IT MUST KNOW ABOUT RELOCATABLE VALUES
;  AND EXTERNAL REFERENCES. IF A SYMBOL IS SET EQUAL TO
;  AN EXPRESSION CONTAINING AN EXTERNAL REFERENCE, IT BUILDS
;  AN ENTRY IN THE INDIRECT VALUE TABLE CONSISTING OF THE NAME
;  OF THE EXTERNAL SYMBOL, AND THE OFFSET FROM ITS VALUE.

ASGMT0:	LDB	W,[POINT 16,V,35] ; GET VALUE OF EXPRESSION
	HRLI	W,CL1		; SET CLASS
	POP	P,N		; THE SYMBOL
	PUSH	P,A		; SAVE THE RELOCATION COUNT OF EXP.
	CALL	SRCH		; LOOKUP SYMBOL
	JRST	ASGMT2		; NOT THERE - EASY TO FIX!
	TLNN	A,INDSYM	; OLD VALUE DEPENDENT?
	JRST	ASGMT6		; NO
	HRRZI	B,0(A)		; YES - GET INDIRECT VALUE TABLE INDEX
	CALL	RELIND		; RETURN THE TABLE SLOT
ASGMT6:	LDB	B,TYPPNT	; GET SYMBOL TYPE
	CAIN	B,MAOP		; A MACRO?
	CALL	REMMAC		; YES - RELEASE STORAGE
	CAIN	B,INOP		; AN INDIRECT OP?
	JRST	ASGMT5		; YES - THEY IS DIFFERENT
	TLNE	A,EXTSYM	; EXTERNAL?
	ERROR1	External symbol  being redefined
	TLNE	A,ENTSYM	; ENTRY POINT?
	TLNE	A,UNDSYM	; YES - DEFINED YET?
	JRST	.+3		; NO - FINE
	CAIE	V,0(A)		; YES - TO SAME VALUE?
	ERROR1	Entry point  being redefined
	TLNN	A,LBLSYM	; A LABEL?
	JRST	ASGMT1		; NO - OK TO REDEFINE
	MOVEI	B,0(W)		; YES - GET NEW VALUE
	TLNN	AF,REGFLG	; NEW VALUE A REGISTER OR  --
	CAIE	B,0(A)		; -- NEW VALUE NOT EQUAL OLD?
	TLO	A,MDLSYM	; YES - THEN IS MULTIPLY DEFINED
ASGMT1:	TLZ	A,RELSYM	; CLEAR RELOCATION
	TLNN	A,MDLSYM	; MULTIPLY DEFINED?
	JRST	ASGMT2		; NO - FINE!
	ERROR1	Label  being redefined
	TLZ	A,UNDSYM	; MAKE IT DEFINED
ASGMT4:	TLZE	AF,HKLFLG	; HALF KILLED?
	TLO	A,HKLSYM	; YES - HALF KILL IT
	TLZE	AF,SUPFLG	;FULLY KILL IF NEC.
	TLO	A,SUPSYM
	POP	P,B		; GET RELOCATION OF EXPRESSION
	CAIN	B,1		; RELOCATABLE VALUE?
	TLOA	A,RELSYM	; YES - SET RELOCATION BIT
	CAIA			; NO - DON'T SET FOR LISTING
	AOS	REXTAB		; SET RELOCATION FOR LISTING
	XCT	CRFIND		; CREF IT
	CALL	INSRT		; PUT IN SYMBOL TABLE
	JRST	ENDL		; LIST AND EXIT


ASGMT2:	TLZ	A,-1-NCRSYM-ENTSYM ; CLEAR BITS
	JUMPN	C,ASGMT7	; INDIRECT VALUE GUYS IS SPECIAL
	TLNE	AF,REGFLG	; A REGISTER?
	TLOA	A,REGSYM	; YES - SAY SO, TEST VALUE
	TLZA	A,REGSYM	; NO - SAY SO, DON'T TEST VALUE
	CAIG	V,7		; TEST VALUE - 0-7?
	JRST	ASGMT3		; YES - THAT'S FINE!
	ERRUU1	REGMES		; NO - NOT SO GOOD
	SETZ	V,		; CLEAR VALUE
ASGMT3:	TRNE	AF,ERRU		; ANY UNDEFINED GUYS?
	TLO	A,UNDSYM	; YES - SAY THIS ONE IS
	HRRI	A,0(V)		; GET VALUE
	JRST	ASGMT4		; GO INSERT SYMBOL

ASGMT5:	DPB	W,[2000+A,,0]	; SET IND. OPS WORD
	XCT	CRFIND		; CREF IT
	JRST	ENDL		; LIST AND EXIT

ASGMT7:	PUSHJ	P,GETIND	; GET AN INDIRRECT VALUE SLOT
	MOVEM	C,INDREF(B)	; STORE SYMBOL NAME
	TRNE	V,100000	; SIGN EXTEND --
	TRO	V,700000	; -- THE OFFSET
	MOVEM	V,INDOFF(B)	; SAVE IT IN TABLE
	HRRI	A,0(B)		; SET SYMS VALUE TO INDEX
	TLO	A,INDSYM	; SAY VALUE DEPENDENT
	MOVEM	C,EEXTAB	; SET EXTERNALNESS FOR LISTING
	JRST	ASGMT4		; INSERT SYMBOL
;
;    ROUTINE TO ASSIGN OR DEASSIGN SLOTS IN THE INDIRECT
;  VALUE TABLE. ENTER AT GETIND TO GET TABLE INDEX IN B.
;  ENTER AT RELIND WITH TABLE INDEX IN B TO RELEASE IT.
;

GETIND:	PUSH	P,A		; SAVE A
	MOVE	A,INDWRD	; GET ALLOCATION INFO
	JFFO	A,GOTIND	; FIND FREE SLOT
	ERROR1	POPAJ,Indirect value table overflow
RELIND:	PUSH	P,A		; RELEASE, SAVE A
GOTIND:	MOVE	A,BITS(B)	; GET MASK FOR SLOT'S BIT
	XORM	A,INDWRD	; COMPLEMENT SLOT'S USAGE
	POP	P,A		; RESTORE A
	RET			; RETURN

	.X==400000,,000000

BITS:	REPEAT 36.,[.X
	.X==.X_-1
]

]
PBGOP:				;PROCESS BASIC GROUP OPS
	CALL	AEXP		;GET FIRST ARGUMENT
	DPB	V,[060600,,W]	;STORE SRC MODE AND REG IN INSN.
	SKIPE	CEXT1		;SKIP IF REGISTER TYPE
	 AOS	OFFST		;FLAG SECOND FIELD
	CALL	PSOB3		;SKIP A COMMA.
	CALL	AEXP		;READ DESTINATION
	IOR	W,V		;MERGE IT INTO INSN.
	SKIPE	%COMPA		;IF WE'RE CHECKING FOR INTER-MODEL INCOMPATIBLE INSNS
	 TRNE	W,7000		;CHECK FOR "OPR AC,-(AC)", ETC.
	  JRST	OPXIT
	TRCE	V,60		;LOOK FOR INCREMENT OR DECREMENT IN DESTINATION.
	 TRCN	V,60
	  JRST	OPXIT
	LSH	V,6		;SEE IF SRC REGISTER AND DEST REGISTER ARE THE SAME.
	XOR	V,W
	TRNN	V,700
	 ERRUU1	PBGOPE
	JRST	OPXIT

PBGOPE:	ASCIZ/Inter-model incompatible PDP-11 instruction/

PUNOP:	CALL	AEXP		;1-OPERAND INSNS (TST, ETC.).
	CAIN	W,100		;CHECK FOR "JMP".
	 SKIPN	%COMPA
	  TDOA	W,V		;MERGE DEST INTO INSN.
	   JRST PUNOP1		;"JMP", AND CHECKING MODEL COMPATIBILITY.
PRTOP2:	IOR	W,V		;MERGE INTO BASIC CODE
OPXIT:	AOS	INSCNT		;1 MORE INSTRUCTION.
	AOS	INSLEN		;UPDATE TOTAL LENGTH OF INSTRUCTIONS.
	HRLI	W,CL3		;ASSUME 1 WORD
	SKIPN	CEXT1		;TRUE?
	JRST	ENDL		;  YES, LIST AND EXIT
	AOS	INSLEN
	HRLI	W,CL6		;NO, ASSUME TWO
	SKIPN	CEXT2		;TRUE?
	JRST	ENDL
	AOS	INSLEN
	HRLI	W,CL7		;NO, SET FOR THREE
	JRST	ENDL		;LIST AND EXIT

PFSOP:	MOVEI	A,3		;FLOATING AC-TO-MEM, AC IS 0 TO 3.
	CALL	REGEX1		;READ IN THE AC, CHECK IN BOUNDS.
	DPB	V,[060200,,W]	;STORE AC IN INSN.
	CALL	PSOB3		;PASS THE COMMA
	CALL	AEXP		;READ THE DESTINATION.
	JRST	PRTOP2

PSCOP:	MOVEI	A,7		;XOR OR JSR: AN AC TO MEM INSN, WHOSE AC IS FOM 0 TO 7,
	CALL	REGEX1		;SO READ THE AC.
	DPB	V,[060300,,W]	;AND STORE IT IN THE INSN.
	CALL	PSOB3		;SKIP OVER THE COMMA,
	CALL	AEXP		;AND READ THE DESTINATION.
PUNOP1:	IOR	W,V		;MERGE DEST INTO INSN - HERE FOR JSR AND JMP AND XOR.
	ANDI	V,70		;CHECK FOR "JMP (AC)+", ETC.
	SKIPE	%COMPAT
	 CAIE	V,20
	  JRST	OPXIT
	TRNN	W,70000		;DON'T BARF FOR "XOR" - ONLY "JMP" AND "JSR".
	 ERRUU1	PBGOPE		;INSN THAT EXECUTES DIFFERENTLY ON DIFFERENT MODEL PDP-11'S.
	JRST	OPXIT

PMARK:	MOVEI	W,6400		;REPLACE SPECIAL-INSN-CODE BY VALUE OF INSN.
	CALL	EXPRF		;READ ARG,
	 SETZ	V,
	TRZE	V,777700	;IT MUST FIT IN 6 BITS.
	 ERROR	MARK instruction argument too large
	LOCABS	MARK INSN ARG,O,;DON'T WANT RELOCATABLE OR EXTERNAL.
	JRST	PRTOP2
PFLOP:	SKIPA	A,[3]		;FLOATING MEM-TO-AC INSNS.
PMLOP:	MOVEI	A,7		;NON-FLOATING MEM-TO-AC INSNS.
	SAVE	A
	CALL	AEXP		;READ SRC ADDR.
	IORI	W,(V)		;MRERGE NTO INSN.
	CALL	PSOB3		;PASS COMMA.
	REST	A
	CALL	REGEX1		;READ AC ARG, CHECK SMALL ENOUGH.
	LSH	V,6		;SHIFT AC # INTO PLACE,
	JRST	PRTOP2		;MERGE IN AND DONE.

PRTOP:				;PROCESS RETURN JUMP
PRTOP1:	CALL	REGEXP		;GET A REGISTER EXPRESSION
	JRST	PRTOP2

PSOB:	MOVEI	W,77000		;VALUE OF INSN, FOR PRTOP2.
	CALL	REGEXP		;READ # OF AC TO DECREMENT.
	LSH	V,6
	IORI	W,(V)		;PUT INTO INSN.
	CALL	PSOB3		;PASS COMMA, ERROR IF NONE.
	CALL	EXPRF		;READ ADDRESS TO BRANCH TO,
	 JRST	PBCOP2		;(ERROR IF NO ADDRESS)
IFN RELCOD,[
	JUMPN	C,PBCOP2	; CAN'T BE EXTERNAL
	LDB	C,[LCRFBP,,AF]	;COMPARE RELOCATION AGAINST
	CAME	A,C		;THAT OF POINT.
	 JRST	PBCOP2		;OFFSET OF SOB CAN'T BE RELOCATABLE
]
	SUBI	V,@LOCTR	;GET OFFSET FROM CURRENT ADDR.,
	SUBI	V,2
	MOVNS	V			;BEFORE ".", NEGATE.
	ROT	V,-1
	ANDCMI	V,700000
	TDNN	V,[-100]	;ERROR IF WON'T FIT IN 6 BIT FIELD.
	 JRST	PRTOP2
	JRST	PBCOP2

PSOB3:	CAIE	I,",
	ERROR1	CPOPJ,Missing comma
	JRST	GETCHR		;SKIP THE COMMA

PTROP:				;PROCESS TRAP/EMT OPS
	CALL	EXPRF		;GET EXPRESSION
	SETZ	V,		;NULL RETURN. ASSUME ZERO.
	TRZE	V,777400	;VALUE TOO BIG?
	 ERROR	TRAP/EMT Code too large
	LOCABS	TRAP/EMT CODE,O,;ERROR UNLESS LOCAL & ABSOLUTE.
	JRST	PRTOP2

PBCOP:				;PROCESS BRANCH ON CONDITION
	CALL	EXPRF		;EVALUATE EXPRESSION
	JRST	PBCOP2		;  NULL, ERROR
IFN RELCOD,[
	JUMPN	C,PBCOP2	; CAN'T BE EXTERNAL
	TLNE	AF,LCRFLG	; L. C. RELOCATABLE?
	JRST	.+3		; YES - THEN TARGET MUST BE
	JUMPN	A,PBCOP2	; NO - TARGET MUST BE ABSOLUTE
	CAIA
	JUMPE	A,PBCOP2
]
	SUBI	V,@LOCTR	;SUBTRACT . .
	MOVEI	V,-2(V)
	ROT	V,-1		;/2, ODD BIT TO SIGN
	ANDCMI	V,700000
	TRNE	V,000200	;NEGATIVE?
	TRC	V,077400	;  YES, TOGGLE HIGH BITS
	TRNN	V,077400	;ANY OVERFLOW?
	JUMPGE	V,PRTOP2	;  NO, BRANCH IF EVEN
PBCOP2:	MOVEI	V,377		; YES, INVALID BRANCH, SO ASSEMBLE A BRANCH TO ".".
	ERROR	Branch out of range
	JRST	PRTOP2
;EXPRESSION HANDLERS

AEXP:				;"A EXPRESSION EVALUATOR
AEXP01:	SETZ	V,
	CALL	SETNB		;GET A NON-BLANK
	CAIN	I,"#
	JRST	AEXP02
	CAIN	I,"(
	JRST	AEXP06
	CAIN	I,"-
	JRST	AEXP07
	CAIN	I,"@
	TLOA	AF,INDFLG	;IF INDIR., SAY SO.
	JRST	AEXP10		;NO UNARIES, PROCESS BASIC EXPRESSION
	CALL	GETCHR		;SKIP TH "@"
	JRST	AEXP01		;GO READ ADDR.

AEXP02:				; #
	CALL	GETCHR		;BYPASS UNARY OP
	CALL	EXPRF		;EVALUATE EXPRESSION
	 ERROR1	Null expression in instruction
AEXP21:	MOVE	B,OFFST		;GET OFFST
	HRROM	V,CEXT(B)	;STORE ADDRESS
IFN RELCOD,[
	MOVEM	A,REXT(B)	; SET RELOCATION
	MOVEM	C,EEXT(B)	; SET EXTERNAL NESS
]
	MOVEI	V,27		;(PC)+ MODE.
	JRST	AEXPXT

AEXP05:	CAILE	V,7		;ANY OVERFLOW?
	ERRUU1	REGMES		;OVERFLOW.
AEXPXT:	TLZE	AF,INDFLG	;IF WAS @,
	TRO	V,10		;MAKE INDIRECT.
	RET

AEXP06:				; (
	CALL	AEXP20		;EVALUATE PARENTHESES
	SETZ	A,		;ZERO IN CASE OF INDEX
	CAIE	I,"+		;FINAL "+ SEEN?
	JRST	AEXP13		;  NO, GO SEE IF (R) OR @(R)?
	CALL	GETNB
	TRO	V,20
	JRST	AEXPXT

AEXP13:	TLCN	AF,INDFLG
	JRST	AEXP05		;NO-REGISTER MODE
	MOVE	A,OFFST		;YES, SAME AS @0(REG)
	HLROM	A,CEXT(A)	;STORE THE 0 .
	ADDI	V,70
	RET

AEXP07:				; -(
	MOVEM	IP,SYMBEG	;SAVE POINTER IN CASE OF FAILURE
	CALL	GETNB		;GET THE NEXT NON-BLANK
	CAIE	I,"(		;PARENTHESIS?
	JRST	AEXP09		;  NO, TREAT AS EXPRESSION
	CALL	AEXP20		;YES, EVALUATE
	TRO	V,40		;SET BITS
	JRST	AEXPXT
AEXP09:				; -( FAILURE
	RESCAN	SYMBEG		;GET POINTER TO "-
	SETCHAR			;RESTORE CHARACTER
AEXP10:				; NO UNARIES
	CALL	EXPR		;EVALUATE EXPRESSION
	 ERROR1	Null immediate operand
	CAIN	I,"(		;ANOTHER EXPRESSION?
	JRST	AEXP11		;  YES, BRANCH
	TLNE	AF,REGFLG	;REGISTER EXPRESSION?
	JRST	AEXP05		;  YES, TREAT AS %
	SKIPE	%ABSAD		; USER WANT ABSOLUTE ADDRESSING?
	TLOE	AF,INDFLG	; YES - CAN WE DO IT?
	CAIA			; NO - GIVE HIM PC RELATIVE THEN
	JRST	AEXP21		; YES - THEN GIVE IT TO HIM
IFE RELCOD,[
	SUBI	V,@LOCTR	;DECREMENT BY CLC
	HRROI	A,-4(V)		;ASSUME FIRST ADDRESS FIELD
	SKIPE	B,OFFST		;TRUE?
	HRROI	A,-6(V)		;  NO, TREAT AS SECOND FIELD
	MOVEM	A,CEXT(B)	;SET VALUE
	MOVEI	V,67
	JRST	AEXPXT
]
IFN RELCOD,[
	TLNE	AF,LCRFLG	; NO - LOCATION COUNTER RELOCATABLE?
	JRST	AEXP30		; YES - THIS REQUIRES EXTRA THOUGHT
AEXP31:	SUBI	V,@LOCTR	; EASY, COMPUTE OFFSET
	HRROI	R6,-4(V)	; ASSUME FIRST AOERAND
	SKIPE	B,OFFST		; GOOD GUESS?
	HRROI	R6,-6(V)	; NOPE - WAS SECOND
AEXP33:	MOVEM	R6,CEXT(B)	; SET VALUE
	MOVEM	A,REXT(B)	; SET RELOCATION
	MOVEM	C,EEXT(B)	; SET EXTERNALNESS
	MOVEI	V,67		; (PC)
	JRST	AEXPXT		; EXIT

AEXP30:	JUMPE	A,AEXP32	; IF TAG ABSOLUTE, CAN'T BE RELITIVE
	SETZ	A,		; IF TAG RELOCATABLE, RELOCATION IS ZERO
	JRST	AEXP31		; FINNISH IT OFF

AEXP32:	SETO	A,		; SAY NEGATIVE RELOCATION (DUMP WILL FIX)
	HRROI	R6,-2(V)	; PC WILL BE INCREMENTED AT THIS POINT
	MOVE	B,OFFST		; OFFSET FROM START OF INSTRUCTION
	JRST	AEXP33		; FINNISH THIS OFF

]

AEXP11:				; E1(E2)
	TLNE	AF,REGFLG	;REGISTER EXPRESSION?
	 ERRUU1	REGMES
	MOVE	B,OFFST
	HRROM	V,CEXT(B)	;SAVE DISPLACEMENT.
IFN RELCOD,[
	MOVEM	A,REXT(B)	; SET RELOCATION
	MOVEM	C,EEXT(B)	; SET EXTERNAL REFERENCE
]
	CALL	AEXP20		;GET REGISTER NUM.
	IORI	V,60		;SET INDEXED MODE.
	JRST	AEXPXT


AEXP20:				;()
	CALL	GETCHR		;BYPASS PAREN
	CALL	REGEXP		;EVALUATE REGISTER EXPRESSION
	CAIE	I,")		;PROPER DELIMITER
	 ERROR1	SETNB,Missing )
	JRST	GETNB		;BYPASS THE ")".

;READ IN A REGISTER NUMBER.
REGEXP:	MOVEI	A,7		;NORMALLY 7 IS LARGEST LEGAL REG. #.
REGEX1:	HRLM	A,(P)		;CALL HERE IF SOME OTHER LARGEST LEGAL.
	CALL	EXPR		;EVALUATE EXPRESSION
	 ERRUUO	REGMES		;ERROR IF NULL.
	LOCABS	REGISTER,O
	HLRZ	A,(P)
	CAIG	V,(A)		;ARE WE WITHIN BOUNDS?
	RET
	ERRUUO	REGMES		;NO, ERROR.
	SETZ	V,		;SET VALUE TO ZERO
	RET

REGMES:	ASCIZ/Bad register number/
EXPR:				;EXPRESSION PROCESSOR, REGISTER ALLOWED
	TLOA	AF,ROKFLG	;ALLOW REGISTER TYPE SYMBOLS

EXPRF:				;EXPRESSION FIN, NO REGISTERS ALLOWED
	 TLZ	AF,ROKFLG	;PRECLUDE REGISTER
	CALL	EXPRZ
	 RET
	AOS	(P)
	CAIE	I,">
	 RET
	ERROR1	Unmatched >
	JRST	GETNB

EXPRZ:	SETZB	A,C		; NO RELOCATION, NO EXT. REF.
	CALL	EXPRRC		;REALLY READ EXPR.
	 CAIA
	AOS	(P)		;WE SKIP IF EXPRRC DID.
IFN RELCOD,[
	JUMPE	A,EXPRF2	; ABSOLUTE IS OK
	CAIE	A,1		; RELOCATION ONE?
	ERROR1	Relocation error
	CAIA
EXPRF2:	JUMPE	C,EXPRF3	; LOCAL IS OK TOO
	TLNE	AF,REGFLG	; A REGISTER?
	 ERROR1	Register in bad context
EXPRF3:
]
	RET


IFE RELCOD,[

; THIS EXPRRC ROUTINE FOR ABSOLUTE VERSION OF ASSEMBLER

EXPRRC:	TLZ	AF,REGFLG	;RESET ACTUAL FLAG
	CALL	EXPRT		;GET THE FIRST TERM
	 RET			;  NULL, EXIT
EXPRF1:	LDB	B,C4PNTR	;MAP CHARACTER USING COLUMN 4
EXPRF2:	XCT	EXPRJT(B)	;EXECUTE TABLE
	PUSH	P,N		;STACK INSTRUCTION
	CALL	GETCHR
	PUSH	P,V		;STACK CURRENT VALUE
	PUSH	P,R6		; SAVE OP TYPE
	CALL	EXPRT		;GET THE NEXT EXPRESSION TERM
	 ERROR1 No term after operator
	POP	P,R6		; RESTORE OP TYPE
	POP	P,N		;GET PREVIOUS VALUE
IFE EXTEND,[
	TRNE	N,100000	;EXTEND SIGN IF NEGATIVE
	TDO	N,[-1,,700000]
	TRNE	V,100000
	TDO	V,[-1,,700000]
]
	POP	P,R6
	XCT	R6		;EXECUTE INSTRUCTION
	LDB	V,[POINT ADRSIZ,0,35]	;RETURN TRIMMED RESULT IN V
	JRST	EXPRF1		;RECYCLE
]
IFN RELCOD,[

; THIS EXPRRC ROUTINE FOR RELOCATABLE VERSION OF ASSEMBLER

EXPRRC:	TLZ	AF,REGFLG	; NOT A REGISTER YET
	CALL	EXPRT		; READ FIRST TERM
	RET			; NULL - THEN EXIT  NULL TOO
EXPRF1:	LDB	R6,C4PNTR	; GET OP TYPE
	XCT	EXPRJT(R6)	; TEST VALIDITY
	PUSH	P,N		; SAVE THE INSN FOR THIS OPERATOR.
	CALL	GETCHR		; BY PASS IT
	PUSH	P,C		; SAVE EXTERNAL REFERENCE
	PUSH	P,A		; SAVE RELOCATION COUNT
	PUSH	P,V		; SAVE VALUE
	PUSH	P,R6		; SAVE OP(EXPRT CLOBBERS IF CALLS SRCH)
	CALL	EXPRT		; EVALUATE NEXT TERM
	ERROR1	No term after operator 
	POP	P,R6		; RESTORE OP
	POP	P,N		; RESTORE OLD VALUE
	TRNE	N,100000	; SIGN EXTEND --
	TDO	N,[-1,,700000]	; -- OLD VALUE
	TRNE	V,100000	; SIGN EXTEND --
	TDO	V,[-1,,700000]	; -- VALUE OF NEW TERM
	XCT	EXPTB3(R6)	; COMPUTE RELOCATION, EXTRN'NESS
	SUB	P,[2,,2]	; REMOVE EXTERNAL, RELOCATION FROM STACK
	POP	P,R6		;GET BACK THE INSN TO COMBINE
	SAVE	A		; SAVE A (IDIV IN R6 WILL ZORCH IT)
	XCT	R6		;VALUES OF OPERANDS.
	REST	A		; RESTORE RELOCATION
	LDB	V,[POINT 16,N,35] ; TRIM VALUE TO V
	JRST	EXPRF1		; DO NEXT TERM, IF ANY

EXPTB3:	PHASE 0
	0
EXND::	0
EXTM::	0
EXPL::	CALL	ADDREL
EXML::	CALL	MULREL
EXMI::	CALL	SUBREL
EXDV::	CALL	DIVREL
EXOR::	CALL	BTHABS
EXAN::	CALL	BTHABS
EXXR::	CALL	BTHABS
EXLA::	CALL	BTHABS
	DEPHASE
]
EXPRJT:	PHASE	0		;EXPRESSION JUMP TABLE
	ERROR1	CPOPJ1,Bad character in expression
EXND::	JRST	CPOPJ1
EXTM::	JRST	CNSTRM		;CONSECUTIVE TERMS, MAYBE
EXPL::	MOVSI	N,(ADDI N,0(V))		; +
EXML::	MOVSI	N,(IMULI N,(V))		; *
EXMI::	MOVSI	N,(SUBI N,0(V))		; -
EXDV::	MOVE	N,[IDIV N,V]		; /
EXOR::	MOVSI	N,(IORI N,0(V))		; !
EXAN::	MOVSI	N,(ANDI N,0(V))		; &
EXXR::	MOVSI	N,(XORI N,(V))		; #
EXLA::	MOVSI	N,(LSH N,(V))		; _
	DEPHASE

CNSTRM:	SAVE	A,C
	CALL	EXPRT	
	 JRST	CNSTR1			;WASN'T REALLY A TERM
	ERROR1 Consecutive terms
CNSTR0:	CALL	EXPRT
	 JRST	CNSTR1
	JRST	CNSTR0

CNSTR1:	REST	C,A
	JRST	EXPRF1			;RESUME LOOKING FOR OPERATORS
IFN RELCOD,[
;
;    ROUTINES TO COMPUTE THE RELOCATABLITY AND EXTERNALNESS
;  OF AN EXPRESSION.


;  ROUTINE TO ASSURE BOTH ARGUEMENTS ARE ABSOLUTE AND LOCAL

BTHABS:	SKIPN	A		; SECOND MUST BE ABS
	SKIPE	-1(P)		; SO MUST FIRST
	ERROR1	Relocatable quantity in illegal context
BTHLCL:	SKIPN	C		; SECOND MUST BE LOCAL
	SKIPE	-2(P)		; SO MUST FIRST
	ERROR1	External reference in illegal context
	RET			; RETURN

ADDREL:	ADD	A,-1(P)		; NEW RELOCATION IS SUM OF OTHER TWO
	SKIPN	-2(P)		; FIRST  TERM EXTERNAL?
	RET			; YES - THEN EXTRN'ESS OF 2ND IS IT
	SKIPE	C		; NO - IS SECOND EXTERNAL?
	ERROR1	Cannot add external references
	MOVE	C,-2(P)		; RETURN EXTERNALNESS OF FIRST
	RET			; RETURN

SUBREL:	EXCH	A,-1(P)		; SWAP RELOCATION COUNTS
	SUB	A,-1(P)		; RELOCATION IS DIFFERENCE
	EXCH	C,-2(P)		; EXCHANGE EXTERNALS
	SKIPE	-2(P)		; SUBTRACTING AN EXTERNAL?
	ERROR1	Cannot subtract an external reference
	RET			; NO - FINE!


MULREL:	JUMPE	A,MULRE2	; SECOND ABS IS FINE!
	SKIPE	-1(P)		; SECOND REL, IS FIRST?
	ERROR1	BTHLCL,Product of two relocatable quantities
	IMULI	A,0(N)		; NO - RELOCATION IS 2ND*1ST OPERAND
	JRST	BTHLCL		; AND BOTH MUST BE LOCAL
MULRE2:	MOVE	A,-1(P)		; GET RELOCATION OF FIRST
	IMULI	A,0(V)		; RELOCATION IS THAT TIMES 2ND OPERAND
	JRST	BTHLCL		; AGAIN, BOTH MUST BE LOCAL

DIVREL:	SKIPE	A		; DIVISOR MUST BE ABSOLUTE
	ERROR1	Division by a relocatable quantity
	MOVE	A,-1(P)		; RELOCATION OF DIVIDEND
	SAVE	B		; SAVE B (IDIV WILL CLOBBER IT)
	IDIV	A,V		; RELOCATION IS THAT OVER DIVISOR
	REST	B		; RESTORE B
	JRST	BTHLCL		; ASSURE BOTH ARE LOCAL

]


EXPRT:	SETZB	A,C		; NO RELOCATION, EXT. REF.
	TDZA	V,V
TERM0:	CALL	GETCHR
	LDB	B,CPNTRM
	JRST	@TERMT1(B)

TERMT1:	PHASE	0
	CPOPJ		;CHARS. THAT FORCE NULL TERMS.
TERMSP::TERM0		;SPACES, + => SKIP CHAR.
TERMDG::TERM1		;DIGIT => READ NUMBER.
TERMSY::TERMS		;ALPHABETIC => READ SYMBOL.
TERMOB::TERME		;< => READ EXPR.
TERMMI::TERMM		;- => READ & NEGATE TERM.
TERMQ1::TERMQ		;' => READ 1 ASCII CHAR.
TERMQ2::TERMDQ		;" => READ 2 ASCII CHARS.
	DEPHASE

TERME:	CALL	GETCHR		;SKIP THE "<"
	PUSH	P,AF		;SAVE REGFLG, ROKFLG.
	TLO	AF,ROKFLG	;REG'NESS OK (WILL FORGET IT ANYWAY).
	CALL	EXPRRC
	 SETZ	V,		;IF EXPR NULL.
	TLZ	AF,REGFLG+ROKFLG	;RESTORE THESE FLAGS.
	POP	P,B
	AND	B,[REGFLG+ROKFLG,,]
	IOR	AF,B
	CAIE	I,">
	 ERROR1	Unmatched <
	CAIN	I,">
	 CALL	GETCHR		;SKIP THE >.
	JRST	NUMXIT

TERM1:	CALL	GETSYM		;MIGHT BE LOCAL TAG
	 CAIA
	  JRST	TERMS0		;YUP
	SETZ	T1,		;IS NUMBER
TERM2:	IMULI	V,10		;ACCUMULATE OCTAL.
	ADDI	V,-"0(I)
	IMULI	T1,10.		;ACCUMULATE DECIMAL.
	ADDI	T1,-"0(I)
	CALL	GETCHR		;GET NEXT CHARACTER
	CAIL	I,"0		;IS IT IN RANGE?
	CAILE	I,"9
	JRST	NUMXA		;NO, TEST FOR END OF NUM.
	JRST	TERM2		;DO IT AGAIN.

NUMXA:	CAIE	I,".		;IS CHAR A ".?
	JRST	NUMXIT		;NO, OCTAL.
	CALL	GETCHR		;YES, GET PAST CHAR.
	MOVE	V,T1		;GET DECIMAL NUMBER.
IFE EXTEND,[
NUMXIT:	TDZE	V,[-200000]	;MASK TO 16 BITS, ANY OVERFLOW?
	ERROR1	Numeric overflow
]
IFN EXTEND,[
NUMXIT:	TDZ	V,[-1,,0]	;MASK TO 18 BITS.
]
	AOS	0(P)		;SET FOR SKIP-EXIT
	JRST	SETNB		;RETURN NON-BLANK
ROKTST:				;REGISTER "OK" TEST
	TLNN	AF,ROKFLG	;REGISTER ALLOWED?
	ERROR	Register in bad context
	TLO	AF,REGFLG	;SET FLAG
IFN RELCOD, JRST TERMS2	; CHECK RELOCATIBILITY
	RET

TERMPE:	MOVEI	V,@LOCTR	;TERM IS "." -- GET CURRENT LOCATION COUNTER
IFN RELCOD,[
	SETZ	C,		; NOT EXTERNAL
	TLNN	AF,LCRFLG	; LOCATION COUNTER RELOCATABLE?
	TDZA	A,A		; NO - SAY IS ABSOLUTE
	MOVEI	A,1		; YES - SAY IS RELOCATABLE
]
	ANDI	V,ADRMSK
	CALL	GETCHR		;MOVE PAST CHARACTER
	JRST	NUMXIT		;EXIT NUMERIC


TERMDQ:	CALL	GETCHR		;STARTS WITH " -- GET THE NEXT CHARACTER
	MOVE	V,I		;MOVE TO EXPRESSION AC
	CALL	GETCHR		;GET THE NEXT CHAR
	LSH	I,8		;MOVE OVER ONE
	CAIA			;SKIP AND FALL THROUGH
TERMQ:				;"'
	CALL	GETCHR		;GET THE NEXT CHARACTER
	TRO	V,(I)		;MERGE/PLACE CHARACTER IN 10
	CALL	GETCHR
	JRST	NUMXIT		;EXIT NUMERIC

TERMM:	CALL	GETCHR		;PASS BY THE "-".
	CALL	EXPRT
	 JFCL
	MOVN	V,V		;READ, NEGATE TERM.
	ANDI	V,ADRMSK
IFN RELCOD,[
	MOVNS	A		; NEGATE RELOCATION COUNT
]
	JRST	CPOPJ1


IFE RELCOD,[

; THIS TERMS ROUTINE FOR ABSOLUTE ASSEMBLER

TERMS:	CALL	GETSYM
	 JRST	TERMPE		;IF NOT SYMBOL, MUST BE ".".
TERMS0:	AOS	(P)
	CALL	SRCH
	 JRST	EXPRT2		;NO STE, SAY IS UNDEF MAYBE?
	XCT	CRFINS
	TLNE	A,UNDSYM	;IF UNDEF, MAYBE IS ERROR.
	 JRST	EXPRT3
	LDB	B,TYPPNT	;YES, GET TYPE
	LDB	V,[POINT ADRSIZ,A,35]	;OK, GET VALUE
	XCT	EXPRTT(B)	;DISPATCH ON TABLE
	RET
	JRST	ROKTST		;IF XCT SKIPS, IS REG SYM.

EXPRT2:	CALL	INSRT		;NOT IN SYMBOL TABLE, FLAG AS UNDEFINED
	XCT	CRFINS
EXPRT3:	SKIPE	VALREQ
	ERROR1		Undefined
	TRO	AF,ERRU
	RET
]

ASEE:	CALL	GETSYM		;SKIP SYMBOL AFTER .SEE
	 RET
	CALL	SRCH
	 CAIA
	  XCT	CRFINS		;AND CREF IT
	RET			;TRY FOR TERM AGAIN
IFN RELCOD,[

; TERMS ROUTINE FOR THE RELOCATABLE VERSION

TERMS:	CALL	GETSYM		; GET THE SYMBOL
	JRST	TERMPE		; NOT A SYMBOL, WAS "."
	AOS	0(P)		; WILL SKIP RETURN
	SETZ	C,		; CLEAR C (GETSYM CLOBBERS IT!)
	CALL	SRCH		; LOOK UP SYMBOL
	JRST	TRMUDS		; NOT THERE - UNDEFINED
	XCT	CRFINS		; CREF THE SYMBOL REFERENCE
	TLNE	A,UNDSYM	; UNDEFINED?
	JRST	TRMUD2		; YES - COULD BE TROUBLE
	TLNE	A,EXTSYM	; EXTERNAL?
	JRST	TRMEXT		; YES - RETURN EXTERNAL REF.
	TLNE	A,INDSYM	; DEPENDENT VALUE?
	JRST	TRMIND		; YES - RETURN THAT
	LDB	B,TYPPNT	; GET TYPE
	LDB	V,[POINT 16,A,35]; GET VALUE
	XCT	EXPRTT(B)	; IS IT A REGISTER?
	CAIA			; NO - SET RELOCATION
	JRST	ROKTST		; YES - CHECK CONTEXT
TERMS2:	TLNN	A,RELSYM	; RELOCATABLE?
	TDZA	A,A		; NO - SET ZERO RELOCATION COUNT
	MOVEI	A,1		; YES - RELOCATION COUNT IS 1
	RET			; RETURN IT

TRMUDS:	MOVSI	A,UNDSYM	; SAY IT IS UNDEFINED
	TLNN	AF,NDSFLG	; ARE WE INSERTING UNDEFINED SYMBOLS?
	CALL	INSRT		; YES - INSERT IN TABLE
	XCT	CRFINS
TRMUD2:	TRO	AF,ERRU		; SAY WE GOTS A UNDEFINED FELLA
	SKIPN	VALREQ		; WANT VALUES?
	JRST	TERMS2		; SET RELOCATABILITY AND EXIT
	ERROR1	 Undefined - treated as if external
TRMEXT:	MOVE	C,N		; SAY EXTERNAL REQ.
	TLO	AF,EXTFLG	; SAY EXTERNAL SEEN
	JRST	TERMS2		; SET RELOCATILIBITY AND EXIT

TRMIND:	HRRE	V,INDOFF(A)	; GET OFFSET
	MOVE	C,INDREF(A)	; GET DEPENDENT SYMBOL
	TLO	AF,EXTFLG	; SAY EXTERNAL SEEN
	JRST	TERMS2		; SET RELOCATABILITY AND EXIT

]

EXPRTT:	PHASE 0
	TLNN	A,REGSYM	;NORMAL SYMBOL.
	CALL	(A)		;VALUE-RETURNING PSEUDO.
REPEAT 2,ERROR1	Pseudo-op in bad context
REPEAT MAOP-CNOP-1,JFCL		;MACHINE INSNS.
	ERROR1	Macro name in bad context
INOP::	HRRZ	V,(A)		;PSEUDO-SYMBOL.
INVOP::	JRST	EXPRT4		;INVISIBLE PSEUDO.
	DEPHASE

EXPRT4:	CALL	0(A)
	SOS	(P)		;WAS AOS'ED
	JRST	EXPRT
;SYMBOL/CHARACTER HANDLERS

GETSYM:				;GET A SYMBOL
	MOVSI	C,440600	;SET POINTER
	TDZA	N,N		;CLEAR AC AND SKIP
GETSY1:	CALL	GETCHR		;GET NEXT CHARACTER
	MOVEM	IP,SYMBEG	;SAVE START IN CASE OF FAIL
	LDB	B,ANPNTR	;MAP CHARACTER TYPE
	XCT	GETSY3(B)	;EXECUTE TABLE
GETSY2:	SUBI	I,40		;VALID, CONVERT TO SIXBIT
GETSY6:	CAME	C,[0600,,]	;ARE WE FULL?
	IDPB	I,C		;  NO, STORE CHARACTER
GETSY5:	CALL	GETCHR		;GET THE NEXT INPUT CHARACTER
	LDB	B,ANPNTR	;MAPE CHARACTER TYPE
GETSY8:	XCT	GETSY4(B)	;EXECUTE TABLE
	CAME	N,[SIXBIT /./];FINISHED, WAS IT A DOT?
	JRST	CPOPJ1		;  NO, VALID.  EXIT +1
GETSY7:	RESCAN	SYMBEG		;  YES, RESET CHARACTER POINTER
	SETCHAR			;  AND CHARACTER
	SETZ	N,		;CLEAR AC
CPOPJ:	RET


GETSY3:				;FIRST CHARACTER TABLE
	PHASE	0
	RET			;NOTHING CHARACTER, EXIT NULL
.TAB::	JRST	GETSY1		;SPACE OR TAB, BYPASS
.ALP::	JFCL			;ALPHA, FALL THROUGH
.NUM::	JRST GETLTG		;NUMERIC, SEE IF LOCAL TAG
.DOT::	JFCL			;DOT, FALL THROUGH, TEST LATER
.TRM::	RET			;TERMINATOR, EXIT NULL
.LOW::	SUBI	I,40		;LOWER CASE, TO UPPER.
	DEPHASE


GETSY4:				;SUCCEEDING CHARACTERS
	PHASE	0
	JFCL
	CALL	GETNB		;SPACE OR TAB, BYPASS AND FALL THROUGH
	JRST	GETSY2		;ALPHA, RECYCLE
	JRST	GETSY2		;NUMERIC, DITTO
	JRST	GETSY2		;DOT, DITTO
	JFCL			;TERMINATOR, FALL THROUGH
.LOW::	JRST	GETSY6
	DEPHASE

POPJ1:
CPOPJ1:	AOS	(P)
	RET

SETNB:	SETCHAR			;SET CHARACTER IN I
	CAIA
GETNB:	CALL	GETCHR
	CAIE	I,SPACE		;IF SPACE
	CAIN	I,TAB		;  OR TAB;
	JRST	GETNB		;  BYPASS
	RET			;OTHERWISE EXIT

;POSSIBLE LOCAL TAG, OR SYMBOL BEGINNING WITH A DIGIT
GETLTG:	SAVE	A
	MOVEI	A,-"0(I)	;ACCUMULATE NUMERIC PART IN A, SYMBOL IN N
GETLT1:	SUBI	I,40
	TLNE	C,770000
	 IDPB	I,C
	CALL	GETCHR
	CAIN	I,"$
	 JRST	GETLT2		;LOOKS LIKE A LOCAL TAG
	LDB	B,ANPNTR	;GET CHARACTER TYPE
	XCT	GETLT3(B)
	IMULI	A,10.		;A DIGIT, KEEP LOOKING
	ADDI	A,-"0(I)
	JRST	GETLT1

GETLT8:	REST	A		;TURNED OUT TO BE A SYMBOL THAT BEGAN WITH A DIGIT
	JRST	GETSY8

GETLT7:	REST	A		;TURNED OUT TO BE A NUMBER, RESCAN
	JRST	GETSY7

GETLT3:	PHASE	0
	JRST	GETLT7		;NULL CHARACTER, FROB WAS A NUMBER
.TAB::	JRST	GETLT7		;SPACE OR TAB, FROB WAS A NUMBER
.ALP::	JRST	GETLT8		;ALPHABETIC, REJOIN NORMAL SYMBOL LOOP
.NUM::	JFCL			;DIGIT, CAN'T TELL YET
.DOT::	JRST	GETLT7		;DOT, FOR NOW ASSUME DECIMAL NUMBER
.TRM::	JRST	GETLT7		;TERMINATOR, FROB WAS A NUMBER
.LOW::	JRST	GETLT8		;LOWER CASE ALPHABETIC, REJOIN NORMAL SYMBOL LOOP
	DEPHASE

GETLT2:	MOVE	N,A		;LOCAL TAG WITH THIS NUMBER
	REST	A
	SKIPE	FAICND
	 JRST	GETLT4
	CAILE	N,0
	 CAIL	N,10000
	  ERROR1	GETSY7,$ Illegal local tag
	SKIPGE	LLABS
	 ERROR1	$ Local tag before first label
GETLT4:	HRLZS	N		;GENERATE UNIQUE SYMBOL NAME
	HRR	N,LLABS		;4.4-4.9=0, 3.1-4.3=NNN, 1.1-2.9=S OF PRECEDING REAL TAG
	CALL	GETNB		;READ NEXT DELIMITER
	JRST	POPJ1		;RETURN AS IF NORMAL SYMBOL
;PSEUDO-OPS

AEND:				;"END" PSEUDO-OP
	TLO	AF,ENDFLG	;FLAG "END SEEN"
	CALL	EXPRF		;EVALUATE THE ADDRESS
IFE RELCOD, MOVEI V,1		;  NULL, FORCE ODD VECTOR
IFN RELCOD, SETO A,		; NULL - INDICATE NO STARTING ADDRESS
	MOVEM	V,STRTLC	;SAVE START ADDR.
IFN RELCOD,[
	HRLM	A,STRTLC	; SET RELOCATION OF STARTING ADDRESS
	SKIPE	C
	ERROR1	Starting address cannot be external
]
	MOVEI	W,(V)		;SET VALUE FOR ENDL.
	HRLI	W,CL5		;FLAG AS .END
IFN RELCOD,[
	JUMPLE	A,ENDL		; LIST AND EXIT IF ABSOLUTE
	AOS	REXTAB		; OTHERWISE SET RELOCATION FOR LISTING
]
	JRST	ENDL		;LIST AND EXIT

AIFF:: AIFT:: AIFTF::
OPCERR:	ERROR1		At top level
	JRST	ENDL		;FLAG ERROR, LIST, AND EXIT

AEVEN:	MOVEI	W,1(L)		;.EVEN - MOVE UP TO NEXT EVEN ADDR.
	TRZ	W,1
	JRST	LOCSL

AODD:	MOVEI	W,(L)		;GET CURRENT LOC. CTR,
	TRO	W,1		;MOVE UP TO ODD ADDR,
LOCSL:
IFN RELCOD,[
	TLO	AF,LCHFLG	; SAY LOCATION COUNTER CHANGED
	TLNE	AF,LCRFLG	; LOCATION COUNTER RELOCATABLE?
	AOS	REXTAB		; YES - SET RELOCATION FOR LISTING
]
	ANDI	W,ADRMSK
	HRLI	W,CL2		;LISTING-CLASS IS LOC CTR SETTING,
	JRST	ENDL

; .OFFSET -- SET OFFSET.
AOFFSE:	CALL	EXPRF		;READ IN VALUE,
	SETZ	V,		;OR 0 IF NONE,
	HRRM	V,LOCTR		;STORE AS OFFSET,
	MOVEI	W,(V)		;SET UP VALUE OF LINE.
	HRLI	W,CL1
	LOCABS	OFFSET,1
	JRST	ENDL
;COPY REST OF LINE TO TTY AND TITBUF (ASCIZ).
ATITLE:	MOVE	A,[440700,,TITBUF]
	CALL	SETNB
ATITL1:	CAIN	I,^M
	SETZ	I,
	IDPB	I,A
	JUMPE	I,ATITL2
	MOVE	B,I
	CALL	TTYDMP
	CALL	GETCHR
	JRST	ATITL1
ATITL2:	CALL	TTYCR
	JRST	ENDL

;.STITL - COPY REST OF LINE TO STITBF (ASCIZ).
ASBTTL:				;DEC'S NAME FOR SUBTITLE
ASTITL:	MOVE	A,[440700,,STITBF]
	CALL	SETNB	;GET FIRST NON-BLANK(WELL...)
ASTIT1:	CAIN	I,^M
	SETZ	I,
	IDPB	I,A
	JUMPE	I,ENDL
	CALL	GETCHR
	JRST	ASTIT1

;.LIST - DECREMENT LISTING SUPPRESS COUNT UNLESS IT'S 0.
ALIST:	SOSL	TSLWRD
	TLOA	AF,LINFLG
	SETZM	TSLWRD
	JRST	ENDL

;INCREM. LISTING SUPPR COUNT.
ANLIST:
AXLIST:	AOS	TSLWRD
	JRST	ENDL

;.ABS - SET %ABSADR SO ABSOLUTE ADDRESSING WILL BE THE DEFAULT.
AABS:	SETOM	%ABSADR
	JRST	ENDL

;COMMENT PSEUDOOP - BYPASSES TVEDIT DIRECTORIES.
ACOMNT:	CALL	SETNB
	SAVE	I		;REMEMBER THE DELIMITER.
ACOMN1:	CALL	GETCHR
	CAME	I,(P)
	 JRST	ACOMN1		;KEEP GOING TILL DELIMITER.
	SUB	P,[1,,1]
	CALL	GETCHR		;PASS THE DELIMITER.
	JRST	ENDL
RAD50:	CALL	SETNB	;GET FIRST NON-BLANK
	PUSH	P,I	;SAVE DELIMITER
	MOVSI	W,CL3	;FLAG WORD TO BE OUTPUT
RAD501:	CALL	GRAD50	;GET ONE RAD50 CHARACTER
	MOVSI	W,CL3	;NOW COMMITED TO OUTPUT SOMETHING
	IMULI	B,3100	;PUT IT IN IT'S PLACE
	ADD	W,B
	CALL	GRAD50
	IMULI	B,50	;THIS ONE TOO
	ADD	W,B
	CALL	GRAD50
	ADD	W,B
	CALL	ENDLF	;OUTPUT A WORD
	JRST	RAD501	;AND TRY FOR MORE

GRAD50:	CALL	GETCHR
	CAMN	I,-1(P)	;IS IT THE DELIMITER?
	JRST	RAD50T	;YES
	LDB	B,SQPNTR	;GET SQUOZE FOR CHAR.
	JUMPN	B,CPOPJ		;A SQUOZE CHAR, OK.
	CAIN	I,40		;SPACE ALSO OK (FOR 0)
	 RET

RAD50E:	ERROR	.RAD50: Bad character
	JRST	.+2
RAD50T:	CALL	GETCHR
	SKIPE	W		;DO WE HAVE SOMETHING TO OUTPUT?
	CALL	ENDLF		;YES, DO SO
	SUB	P,[2,,2]	;UNSCREW THE STACK.
	JRST	ENDL

;.ASCII /STRING/
AASCIZ:	TLOA	AF,ASZFLG	;FLAG TO PUT ON NULL
AASCII:	TLZ	AF,ASZFLG	;NO TERMINATING NULL
AASCI0:	CALL	SETNB		;GET FIRST NON-BLANK
	CAIN	I,";
	 JRST	AASCI4
	CAIE	I,^M
	 CAIN	I,^J
	  JRST	AASCI4
	CAIN	I,"<		;"<" INDICATES A .BYTE VALUE
	 JRST	AASCI6		;...
	PUSH	P,I		;STACK TERMINATOR
AASCI1:	CALL	GETCHR		;GET NEXT CHARACTER
	CAMN	I,0(P)		;TERMINATOR?
	 JRST	AASCI2		;  YES
	MOVEI	W,0(I)		;PLACE IN AC4
	HRLI	W,CL4		;SET CLASS
	CALL	ENDLF		;PRINT AND DUMP IT
	JRST	AASCI1		;RECYCLE
AASCI2:	CALL	GETCHR		;SKIP TERMINATOR
	POP	P,N		;FLUSH TERMINATOR FROM STACK
	JRST	AASCI0
AASCI4:	MOVSI	W,CL4		;ZERO DATUM (RH)
	TLNE	AF,ASZFLG
	 CALL	ENDLF		;OUTPUT IT IF ASCIZ
	SETZ	W,
	JRST	ENDL		;EXIT

AASCI6:	CALL GETCHR		;SKIP <
	CALL EXPRZ		;GET EXPRESSION, REGISTER NOT ALLOWED
	 ERROR	Expression expected
	LOCABS	.BYTE ARG,O
	TDCN	V,[177400]	;OVERFLOW?
	 JRST	.+3		;  NO.
				;HIGH BITS ARE NOW COMPLEMENTED.
	TDZE	V,[-400]	;MASK TO 8 BITS.
				;ANY OVERFLOW
	ERROR	Byte too large
	LDB	W,[POINT 8,V,35]	;SET CODE
	HRLI	W,CL4		;SET CLASS
	CAIE	I,">		;ANY MORE
	 ERROR	> Expected
	CALL	ENDLF		;YES, DUMP THIS ITEM
	CALL	GETCHR		;BYPASS >
	JRST	AASCI0		;GET ANOTHER ITEM
;.BYTE BYTE1,BYTE2,BYTE3
ABYTE:	CALL	EXPRF		;EVALUATE EXPRESSION
	SETZ	V,		;NULL, ASSUME 0
	LOCABS	.BYTE ARG,O
	TDCN	V,[177400]	;OVERFLOW?
	JRST	.+3		;  NO.
				;HIGH BITS ARE NOW COMPLEMENTED.
	TDZE	V,[-400]	;MASK TO 8 BITS.
				;ANY OVERFLOW
	ERROR	Byte too large
	LDB	W,[POINT 8,V,35]	;SET CODE
	HRLI	W,CL4		;SET CLASS
	CAIE	I,",		;ANY MORE
	JRST	ENDL		;  NO, EXIT
	CALL	ENDLF		;YES, DUMP THIS ITEM
	CALL	GETCHR		;BYPASS COMMA
	JRST	ABYTE		;GET ANOTHER ITEM

AWORD:	CALL	EXPRF		;.WORD -- EVALUATE EXPRESSION
WORDD:	SETZ	V,		;  NULL, ASSUME 0
WORDF:	MOVE	W,V		;GET VALUE
IFN RELCOD,[
	MOVEM	A,REXTAB	; SET RELOCATION AND --
	MOVEM	C,EEXTAB	; -- EXTERNALNESS OF WORD
]
	HRLI	W,CL3		;SET CLASS
	CAIE	I,",		;END OF STRING?
	JRST	ENDL		;  YES, LIST AND EXIT
	CALL	ENDLF		;NO, LIST THIS WORD
	CALL	GETCHR		;BYPASS COMMA
	JRST	AWORD		;RE-CYCLE

ABLKW:	CALL	EXPRF		;.BLKW, READ # WDS SPACE TO LEAVE.
	 MOVEI	V,1		;ASSUME 1 IF NO ARG.
	LSH	V,1		;# BYTES SPACE.
	MOVEI	W,(L)
	ADDI	W,1		;BUT 1ST MOVE UP TO EVEN ADDR.
	TRZ	W,1
	JRST	ABLKB1

ABLKB:	CALL	EXPRF		;.BLKB, READ # BYTES SPACE.
	 MOVEI	V,1
	MOVEI	W,(L)
ABLKB1:	LOCABS	.BLKW/.BLKB ARG,1
	ADDI	W,(V)		;W _ NEW LOC. CTR.
	JRST	LOCSL
;FLEXPR FLTNUM

DEFINE	FLOAT X
	FSC X,233		;OR YOUR FAVORITE FLOAT INSTR.
TERMIN

FLTNU1:	SETZ V,
	MOVE B,[1.0]
FLTNU4:	CAIL I,"0
	CAILE I,"9
	RET
	FMPR B,[10.0]		;B HAS HIGHEST POWER OF 10 THAT WE HAVE SEEN
	FMPR V,[10.0]
	MOVEI T1,-"0(I)
	FLOAT T1
	FADR V,T1
	CALL GETCHR		;GET NEXT CHARACTER
	JRST FLTNU4

FLTNUM:	PUSH P,I		;SAVE FIRST CHAR SO WE CAN CHECK NUM IS NEG
	CAIN I,"-
	CALL GETCHR
	CALL FLTNU1		;TRY TO PARSE THE INTEGER BEFORE THE DECIMAL PT.
FLTNU2:	CAIE I,".		;IS CHAR A ".?
	JRST FLTNU3
	CALL GETCHR		;YES, GET PAST .
	PUSH P,V		;SAVE FIRST NUMBER
	CALL FLTNU1
	FDVR V,B
	POP P,T1
	FADR V,T1
FLTNU3:	CAIE I,"E		;SCALING FIELD?
	CAIN I,"@
	SKIPA
	JRST FLTNU5
	CALL GETCHR
	MOVE B,[10.0]
	CAIE I,"-
	JRST FLTNU9
	MOVE B,[0.1]
	CALL GETCHR
FLTNU9:	SETZ R6,		;GET A DECIMAL INTEGER INTO R6
FLTNU6:	CAIL I,"0
	CAILE I,"9
	JRST FLTNU8
	IMULI R6,12
	ADDI R6,-"0(I)
	CALL GETCHR
	JRST FLTNU6
FLTNU8:	TRNE R6,1
	FMPR V,B
	FMPR B,B
	LSH R6,-1
	JUMPN R6,FLTNU8
FLTNU5:	POP P,C
	CAIN C,"-
	MOVN V,V
	SETZ T1,
	RET			;NEVER SKIPS

FLEXPR:	CALL FLTNUM
	SETZ C,			;FLAG INDICATION NO ERROR SO FAR
	AOSA (P)		;ALWAYS SKIPS
FLEXP1:	CALL GETCHR
	CAIE I,";		;LOOK FOR COMMENT
	CAIN I,15		;OR END OF LINE
	RET
	CAIN I,",
	RET			;OR SEPARATOR
	JUMPN C,FLEXP1		;IF WE'VE SEEN ONE ERROR QUIT COMPLAINING
	CAIE I,40
	CAIN I,11		;ERROR IF ANYTHING EXCEPT SPACE OR TAB
	JRST FLEXP1
	ERROR1 Bad character in scan of floating point number
	AOJA C,FLEXP1
;AFLT2 AFLT4			;.FLT2 .FLT4

AFLT2:	CALL FLEXPR		;.FLT2 -- EVALUATE FLOATING PT. EXPRESSION
	SETZ V,			;  NULL, ASSUME 0
	TLZE V,400000
	MOVN V,V		;MAKE A SIGN MAGNITUDE NUMBER
	DPB V,[POINT 26,V,34]	;Shift the fraction left 1 bit.
	LSH V,-2
	HLRM V,W		;FIRST WORD OF NUMBER
	LSH V,-2
	HRRM V,CEXT1
	HRLI W,CL6
IFN RELCOD,[
	MOVEM A,REXTAB		; SET RELOCATION AND --
	MOVEM C,EEXTAB		; -- EXTERNALNESS OF WORD
]
	CAIE I,",		;END OF STRING?
	JRST ENDL		;  YES, LIST AND EXIT
	CALL ENDLF		;NO, LIST THIS WORD
AFLTB:	CALL GETCHR		;BYPASS COMMA
	CAIE I,40		;LOOK FOR NON BLANK CHAR
	JRST AFLT2		;RE-CYCLE
	JRST AFLTB

AFLT4:	CALL FLEXPR
	SETZ V,T1
	TLZE V,400000
	DMOVN V,V
	DPB V,[POINT 3,T1,8]	;Put the low 30 bits of the fraction together
	PUSH P,T1
	DPB V,[POINT 26,V,34]
	LSH V,-2
	HLRM V,W
	LSH V,-2
	HRRM V,CEXT1
IFN RELCOD,[
	MOVEM A,REXTAB		; SET RELOCATION AND --
	MOVEM C,EEXTAB		; -- EXTERNALNESS OF WORD
]
	HRLI W,CL6
	CALL ENDLF
	POP P,T1
	LSH T1,2
	HRRM T1,CEXT1
	LSH T1,2
	HLRM T1,W
	HRLI W,CL6
	CAIE I,",
	JRST ENDL
	CALL ENDLF
	CALL GETCHR
	JRST AFLT4
AREM:				;DEC'S NAME FOR SAME THING
AMSG:	SOS	ERRNUM		;DON'T COUNT AN ERROR.
AERROR:	CAIA
	CALL	GETCHR		;FETCH TILL EOL.
	CAIE	I,^M
	JRST	.-2
	SETZ	I,
	DPB	I,IP		;MAKE LINBUF ASCIZ.
	ERRUU1	LINBUF		;ISSUE ERROR MSG.
	TLO	AF,LINFLG
	JRST	ENDL

;PRINT OUT MESSAGE BETWEEN DELIMITERS
APRINT:	CALL	SETNB
	PUSH	P,I
APRIN1:	CALL	GETCHR
	CAMN	I,(P)
	JRST	APRIN2
	MOVE	B,I
	CALL	TTYDMP
	TLNE	F,ERRBIT	;IF ERR FILE OPEN, OUTPUT TO IT.
	CALL	ERROU2
	JRST	APRIN1
APRIN2:	POP	P,I
	JRST	ENDL

;.EOT - FORCE EOF (SKIP REST OF FILE)
AEOT:	CALL	ENDLR		;FINISH LINE FROM CURRENT FILE.
	MOVE	A,SRCPNT	;PUT ^C IN BUFFER.
	MOVEI	B,^C
	IDPB	B,A
	RET

;.EJECT - NEW PAGE IN LISTING.
APAGE:
AEJECT:	TRO	F,HDRBIT	;FORCE NEW PAGE.
	TLO	AF,LINFLG	;DON'T LIST THIS LINE.
	JRST	ENDL

;.XCREF - SET DON'T-CREF BITS OF SPECIFIED SYMBOLS.
AXCREF:	CALL	GETSYM
	 ERROR1	ENDL,What symbol? - .XCREF
	CALL	SRCH		;FIND STE.
	 MOVSI	A,UNDSYM
	TLO	A,NCRSYM
	CALL	INSRT
	CAIE	I,",		;IF FOLLOWED BY COMMA, GET ANOTHER SYMBOL.
	JRST	ENDL
	CALL	GETCHR		;PASS COMMA
	JRST	AXCREF		; GET MORE

;.Expunge -- flush symbols following
aexpunge:
	call getsym
	 error1 endl,Nothing to expunge
	call srch
	 jfcl
	movsi a,undsym
	call insrt
	caie i,",
	jrst endl
	call getchr
	jrst aexpunge

;.AUXIL - TELLS @ THAT THIS IS AN AUXILIARY FILE OF SYMBOL DEFINITIONS.
AAUXIL:	RET
IFN RELCOD,[
;
;    PSEUDO-OPS FOR RELOCATABLE STUFF


; .ENTRY PSEUDO-OP

AENTRY:	CALL	GETSYM		; READ SYMBOL NAME
	ERROR1	ENDL,Expected a symbol name
	CALL	SRCH		; LOOK UP THE SYMBOL
	JRST	UNDENT		; NOT THERE, COULD BE TROUBLE
	TLNE	A,UNDSYM	; DEFINED?
	JRST	UNDENT		; NO, COULD BE TROUBLE
SETENT:	TLO	A,ENTSYM	; YES - SAY IS ENTRY POINT
	CALL	INSRT		; PUT IN SYM TAB
	XCT	CRFINS		; CREF THE REFERENCE
	CAIE	I,",		; MORE SYMBOLS?
	JRST	ENDL		; NO - EXIT
	CALL	GETCHR		; YES - PASS COMMA
	JRST	AENTRY		; AND GET THEM

;
;    HERE IF SYMBOL UNDEFINED, ERROR ON PASS 2
;

UNDENT:	TLNN	AF,P1F		; PASS ONE?
	ERROR	 Undefined
	JRST	SETENT		; YES - NOT AN ERROR THEN

; .EXTRN PSEUDO-OP

AEXTRN:	CALL	GETSYM		; GET SYMBOL NAME
	ERROR1	ENDL,Expected a symbol name
	CALL	SRCH		; LOOK UP SYMBOL
	JRST	EXTSET		; NOT THERE - THIS IS EASY!
	TLNE	A,EXTSYM	; ALREADY EXTERNAL?
	JRST	EXTST2		; YES - THIS IS SIMPLE TOO!
	TLNN	A,UNDSYM	; UNDEFINED?
	JRST	EXTERR		; NO - THAT IS REAL TROUBLE
EXTSET:	MOVSI	A,EXTSYM	; SAY IS EXTERNAL
	CALL	INSRT		; PUT IN SYMTAB
EXTST2:	XCT	CRFIND		; CREF A DEFINING OCCURENCE
EXTNXT:	CAIE	I,",		; MORE SYMBOLS?
	JRST	ENDL		; NO - EXIT
	CALL	GETCHR		; YES - PASS COMMA
	JRST	AEXTRN		; GET MORE SYMBOLS

;
;    HERE IF SYMBOL IS ALREADY DEFINED, ERROR
;

EXTERR:	ERROR1	 Already defined locally 
	JRST	EXTNXT		; GET NEXT ONE
]
IFE RELCOD,[
AENTRY: AEXTRN:	ERROR1 ENDL,	In absolute assembly
]
;HANDLE REPEATS

REPEA0:				;"REPEAT" PSEUDO-OP
	AOS	VALREQ		;INSIST SYMS DEFINED.
	CALL	EXPRF		;EVALUATE EXPRESSION
	 ERROR1	.REPT: Null argument
	SOS	VALREQ
	LOCABS	.REPT ARG,1
	MOVEI	W,(V)
	HRLI	W,CL1		;LIST VALUE
	TRNN	V,100000
	CAIN	V,0		;IF LESS THAN OR EQUAL TO ZERO,
	JRST	UNSCON		;  JUST LIST
	PUSH	P,V		;STACK EXPRESSION
	CALL	ENDLR		;LIST LINE
	CALL	GETBLK		;INIT. WRITING OF BODY AS STRING.
	PUSH	P,MWPNTR	;SAVE STARTING BLOCK ADDRESS
	SETZ	S,		;ZERO LEVEL COUNT
REPEA1:	CALL	GETLIN
	CALL	GETSYM		;TEST THE FIRST SYMBOL
	 JRST	REPEA2		;  NON-SYMBOLIC
	CAMN	N,.REPTX
	AOJA	S,REPEA2	;  INCREMENT AND BRANCH
	CAMN	N,.ENDRX
	SOJL	S,REPEA3	;  DECREMENT AND BRANCH IF END
REPEA2:	RESCAN	LINPNT		;POINT TO START OF LINE
REPEA4:	CALL	GETCHR		;GET THE NEXT CHARACTER
	CALL	WCIMT		;WRITE INTO STRING
	CAIE	I,^J		;KEEP GOING TILL EOL.
	JRST	REPEA4
	CALL	ENDLR		;LIST THE LINE
	TLNN	AF,ENDFLG	;SKIP IF EOF SEEN
	JRST	REPEA1		;TRY THE NEXT LINE
	ERROR1	.ENDR Missing

REPEA3:	CALL	ENDLR		;TERMINATION, LIST LINE
	MOVEI	I,QUEMAC	;END, SET TO CLOSE
	CALL	WTIMT		;WRITE FLAG AND "REPEAT END"
	REST	A,V		;STRING'S ADDR, # TIMES TO REPEAT.
	IDPB	MP,MACPDP	;PUSH ON MACRO PDL, OUTER MACRO-READ-POINTER,
	MOVEI	B,REPEND	;WHEN FINISH READING BODY EACH TIME,
	EXCH	B,MACXIT	;REPEND IS PLACE TO CALL.
	IDPB	B,MACPDP	;SAVE OUTER STRING'S EXIT ROUTINE ADDR.
	MOVE	B,%RPCNT	;(SAVE OUTER .REPT'S .RPCNT OVER THIS ONE)
	IDPB	B,MACPDP
	IDPB	A,MACPDP	;BP -> START OF REPEAT-BODY-BLOCK.
	IDPB	V,MACPDP	;# REPETITIONS YET TO BE DONE.
	SETOM	%RPCNT		;PASS # 0 COMING UP.
	MOVEI	T1,GCHM		;NOW READING FROM MACRO-STRING.
	HRRM	T1,GETCHA

;FALLS THROUGH.
;COME HERE TO START NEXT PASS THRU .REPT OR POP OUT OF IT.
;MAY BE CALLED FROM GCHM SO DON'T CLOBBER ACS.
REPEND:	CAIA			;CALL HERE AFTER PASS THRU REPEAT.
	 SETZM	@MACPDP		;CALL HERE FROM .MEXIT, PRETEND 0 PASSES TO GO.
	HRRO	I,MACPDP
	SOSL	(I)		;1 LESS PASS STILL UNDONE,
	 JRST	REPEN1		 ;STIIL AT LEAST 1.
	SAVE	A
	SUBI	I,1		;NONE LEFT, DISCARD THE -1 ON MACPDL TOP.
	POP	I,A
	CALL	REMMAC		;FREE THE BLOCKS CONTAINING .REPT'S BODY.
	POP	I,%RPCNT	;UNBIND .RPCNT.
	POP	I,MACXIT	;UNBIND END-OF-STRING EXIT RTN.
	POP	I,MP		;UNBIND INPUT STREAM.
	HRRM	I,MACPDP	;MAKE PDL PTR -> BELOW WHAT WE POPPED.
	REST	A
	JUMPE	MP,GCHSE0	;MAYBE POPPED INTO A FILE,
	RET			;MAYBE INTO MACRO OR REPT, ETC.

REPEN1:	AOS	%RPCNT		;STARTING NEXT PASS,
	MOVE	MP,-1(I)	;RESTART READING FROM BEGINNING,
	RET

;COME HERE FOR .REPT WITH COUNT OF 0.
UNSCON:	CALL	ENDLR		;LIST THE LINE
UNSCO1:	CALL	GETLIN
	CALL	GETSYM		;CHECK THE FIRST SYMBOL
	 JRST	UNSCO2		;  NON-SYMBOLIC, LIST
	CAMN	N,.ENDRX	;"ENDR"?
	JRST	ENDLR		;  YES, LIST AND EXIT
	CAME	N,.REPTX	;NESTED?
	JRST	UNSCO2		;  NO
	CALL	UNSCO2		;YES, RECURSE
	JRST	UNSCO1		;BACK TO NORMAL

UNSCO2:	SETZ	I,
	TLNE	AF,ENDFLG	;EOF SEEN?
	JRST	ENDL		;  YES, EXIT
	CALL	ENDLR		;NO, LIST THE LINE
	JRST	UNSCO1		;TRY AGAIN
;.IF PSEUDO-OP:
;  .IF <COND-NAME> <ARGS (OPTIONAL, DEPENDS ON CONDITION)>
;    <BODY>
;   .ENDC
AIF:	CALL	CNT		;PROCESS CONDITION, SKIP IF TRUE.
	 JRST	UNCOND		;FAILED, SKIP BODY.
	JRST	STCOND		;PROCESS THE BODY.

;.IIF <CONDIT> <ARGS>, <STMT>
AIIF:	SETZM	%SUCCESS	;ZERO'D UNLESS COND IS TRUE
	CALL	CNT		;PROCESS CONDITION AND ARGS AND COMMA.
	 JRST	ENDLR		;FALSE, JUST LIST LINE.
	MOVEM	P,%SUCCESS	;SET %SUCCESS NON-ZERO
	JRST	STMNT		;HANDLE REST OF LINE.

;.LIF <CONDITION>
; <SINGLE-LINE-OF-BODY>
ALIF:	CALL	CNT		;READ IN AND TEST CONDITION,
	 JRST	ALIF1
	MOVEM	P,%SUCCESS	;COND TRUE, ASSEMBLE NEXT LINE
	JRST	ENDLR
ALIF1:	CALL	ENDLR		;SKIP NEXT LINE IF CONDITION FAILS.
	SETZM	%SUCCESS
	JRST	ENDLR

;  .ALSO
;   <BODY>
;  .ENDC
AALSO:	SKIPN	%SUCCESS
	 JRST	UNCOND		;LAST WAS FALSE, THIS FAILS ALSO
	JRST	STCOND		;TRUE, PROCESS BODY

;  .ELSE
;   <BODY>
;  .ENDC
AELSE:	SKIPE	%SUCCESS	;TEST WHETHER LAST COND WAS FALSE
	 JRST	UNCOND		;TRUE, SKIP BODY.
	JRST	STCOND		;FALSE, PROCESS THE BODY

;.IELSE <STMT>
AIELSE:	SKIPE	%SUCCESS	;REVERSE SENSE OF %SUCCESS
	 JRST	[SETZM	%SUCCESS
		 JRST	ENDLR]
	MOVEM	P,%SUCCESS	;LAST FAILED SO PROCESS <STMT>
	JRST	STMNT

;.IALSO <STMT>
AIALSO:	SKIPN	%SUCCESS
	 JRST	ENDLR
	JRST	STMNT		;PROCESS IT

;.LELSE
; <SINGLE-LINE-OF-BODY>
ALELSE:	SKIPE	%SUCCESS	;"COMPLEMENT" %SUCCESS
	 JRST	[SETZM	%SUCCESS
		 CALL	ENDLR
		 JRST	ENDLR]
	MOVEM	P,%SUCCESS	;ONLY SET LOW 16 BITS
	JRST	ENDLR

;.LALSO
; <SINGLE-LINE-OF-BODY>
ALALSO:	SKIPN	%SUCCESS
	 CALL	ENDLR		;COND WAS TRUE, SKIP A LINE
	JRST	ENDLR

;HANDLE OLD-STYLE CONDITIONALS BY TRANSLATING TO NEW STYLE.
CONDIT:	MOVE	N,CONDTB(A)	;GET NEW CONDITION NAME
	CALL	CNT0		;TEST IN USUAL WAY.
	 JRST	UNCOND		;NOT SATISFIED
STCOND:	MOVEM	P,%SUCCESS	;INDICATE TRUE CONDITIONAL
STCON3:	PUSH	P,[SIXBIT/.IFF/]
	PUSH	P,[SIXBIT/.IFT/]
STCON0:	CALL	ENDLR		;SATISFIED CONDITIONAL
STCON1:	TLNE	AF,ENDFLG	;EOF => EXIT CONDITIONAL. DON'T CALL
	 JRST	POP2J		;ENDLR SINCE OUR CALLER WILL. (WOULD GET 2 "NO END" MSGS)
	CALL	GETLIN
	CALL	GETSYM		;LOOK AT 1ST SYMBOL ON LINE.
	 JRST	STCON2		;NO SYMBOL FOUND.
	CAMN	N,.ENDCX	;IF .ENDC SEEN
	 JRST	CONDX1		;THEN END OF CONDITIONAL
STCON2:	TLNE	AF,ENDFLG	;EOF => EXIT CONDITIONAL. DON'T CALL
	 JRST	POP2J		;ENDLR SINCE OUR CALLER WILL. (WOULD GET 2 "NO END" MSGS)
	CAME	N,(P)		;IF NEXT PART WANTS CONDIT THE WAY IT WAS
	 CAMN	N,[SIXBIT/.IFTF/]
	  JRST	STCON0		;OR DOESN'T CARE, GO ON ASSEMBLING.
	CAMN	N,-1(P)		;IF NEXT PART WANTED COND. THE OTHER WAY,
	 JRST	UNCON0		;START SKIPPING OVER IT.
	RESCAN	SYMBEG		;BACK UP
	SETCHAR			;IN ORDER TO
	CALL	STMNT		;EXECUTE LINE
	JRST	STCON1

;COME HERE FOR FALSE CONDITIONAL.
UNCOND:	SETZM	%SUCCESS	;INDICATE THIS COND FAILED
	PUSH	P,[SIXBIT/.IFT/]
	PUSH	P,[SIXBIT/.IFF/]
UNCON0:	SETOM	FAICND
	PUSH	P,[0]		;THIS WD IS LEVEL CNTR.
	MOVE	A,SLNCNT
	MOVEM	A,UNCONL	;REMEMBER PAGE & LINE NUM OF 
	MOVE	A,PAGNUM	;START OF CONDITIONAL.
	MOVEM	A,UNCONP
UNCON4:	CALL	ENDLR		;UNSATISFIED CONDITIONAL
UNCON1:	CALL	GETLIN
	CALL	GETSYM		;GET SOMETHING
	 JRST	UNCON2		;NO SYMBOL
	CAMN	N,.ENDCX
	 JRST	[SOSL (P)	;DOWN ONE CONDITIONAL LEVEL.
		 JRST UNCON2	;STILL NOT AT BOTTOM.
		 JRST CONDXT]	;TERMINATED THIS CONDITIONAL.

	CAME	N,[SIXBIT/.IF/]
	 CAMN	N,[SIXBIT/.ELSE/]
	 JRST	UNCON5		;ENTERING AN INNER CONDITIONAL.
	CAMN	N,[SIXBIT /.ALSO/]
	 JRST	UNCON5
	SKIPE	(P)		;IF NOT WITHIN INNER CONDITIONALS,
	 JRST	UNCON3
	CAME	N,[SIXBIT/.IFTF/]
	CAMN	N,-1(P)		;IF WANT COND. THE WAY IT WAS,
	 JRST	[POP P,A ? SETZM FAICND ? JRST STCON0]	;START ASEMBLING STUFF.
UNCON3:	CALL	SRCH
	 JRST	UNCON2
	HLRZ	N,A
	CAIN	N,CNOP		;IS IT A CONDITIONAL?
UNCON5:	AOS	(P)		;YES, INCREM. DEPTH IN CONDITIONALS.
UNCON2:	MOVEI	I,0
	TLNN	AF,ENDFLG
	JRST	UNCON4		;UNLESS HIT END, LIST LINE & DO NEXT.
	CALL	ERRCR
	MOVEI	A,[ASCIZ/Within unsuccessful conditional at /]
	CALL	ERRSTR
	MOVE	A,UNCONP
	CALL	ERRDEC
	MOVEI	B,"-
	CALL	ERROUT
	AOS	A,UNCONL
	CALL	ERRDEC
	CALL	ERRCR
POP3J:	SUB	P,[1,,1]
POP2J:	SUB	P,[2,,2]
	RET

CONDXT:	SUB	P,[1,,1]	;POP THE LEVEL COUNT.
CONDX1:	SETZM	FAICND
	MOVE	A,(P)
	SUB	P,[2,,2]	;POP .IFT AND .IFF .
	CAMN	A,[SIXBIT /.IFT/]
	 JRST	CONDX2
	SETZM	%SUCCESS	;.ENDC OF A FALSE COND ZEROES %SUCCESS
	JRST	ENDLR
CONDX2:	MOVEM	P,%SUCCESS	;TRUE COND SETS %SUCCESS TO -1
	JRST	ENDLR

CONDTB:	PHASE	0
$IF1:: SIXBIT/P1/  ?  $IF2:: SIXBIT/P2/
IRPS X,,DF NDF B NB G GE L LE NZ Z
$IF!X::	SIXBIT/X/
TERMIN	DEPHASE
;PARALLEL TABLES: CNTTB0 HAS CONDITION NAMES (SIXBIT) IN NUMERICAL ORDER,
;CNTTB1 HAS CORRESPONDING ACTIONS.

CNTTB0:
IRP X,,[B=B,DF=DF,DIF=DIF,E N,EQ N,G LE,GE L,GT LE
IDN#DIF,L GE,LE G,LT GE,NB#B,NDF#DF,NE E,NG G,NL L
NZ E,P1=P1,P2#P1,Z N]
IRPS Y,Z,X
IFE .IRPCN,[SIXBIT/Y/	;COND. NAME IN FIRST TABLE.
IF2 [	CNTTM1==V		;DEFAULT IS >0, FOR ARITH COND.
	IFSE Z,=,CNTTM1==SETZ	;= => TRUE, CALL RTN.
	IFSE Z,#,CNTTM1==TRN	;# => REVERSED, CALL RTN.
]]
IFN .IRPCN,[IF2 [	.=.+CNTTB1-CNTTB0-1	;MOVE TO 2ND TABLE.
	CNTTM1+IFL CNTTM1,[CNT!Y]+IFGE CNTTM1,SKIP!Y
	.=.+CNTTB0-CNTTB1	;MOVE BACK TO 1ST TABLE.
]]
TERMIN TERMIN

IF1 [CNTTBL==0
REPEAT 10.,IFE CNTTBL,IFGE 1_.RPCNT-.+CNTTB0,  CNTTBL==.RPCNT
]	;(NOW CNTTBL HAS LOG BASE 2 OF TABLE SIZE, ROUNDED UP.)

CNTTB1==CNTTB0+1_CNTTBL		;MAKE TABLE SIZE NEXT POWER OF 2.
REPEAT CNTTB1-., 377777,,-1	;FILL OUT 1ST TABLE WITH LARGEST POSITIVE NUM.
CNTTB1:	BLOCK	CNTTB1-CNTTB0	;MAKE 2ND TABLE SAME SIZE AS FIRST.

;COME HERE TO READ IN THE CONDITION OF A NEW CONDITIONAL,
;SKIP-RETURN IFF CONDITION IS TRUE.
;LEAVE INPUT STREAM BEFORE BODY OF CONDITIONAL.
CNT:	CALL	GETSYM		;READ IN CONDITION-TYPE.
	 ERROR1	CPOPJ,Condition missing
CNT0:	SETZ	A,		;A IS PTR INTO TABLES FOR BINARY-SEARCHING.
REPEAT CNTTBL,[		;CNTTB0(A) WILL HOLD AONDITION NAME; CNTTB1(A), ACTION.
	CAML	N,CNTTB0+1_<CNTTBL-.RPCNT-1>(A)
	ADDI	A,1_<CNTTBL-.RPCNT-1>
]
	CAME	N,CNTTB0(A)	;IS THE COND-NAME ACTUALLY IN TABLE?
	 ERROR1	CPOPJ,Bad condition name
	SKIPGE	V,CNTTB1(A)	;IF ACTION POSITIVE, IT IS SKIP-INSTRUCTION,
	 JRST	CNTSPC		;ELSE IT IS ADDR OF RTN, GO CALL IT.
	SAVE	V
	AOS	VALREQ
	CALL	EXPRF		;ACTION IS INSN => ARITHMETIC COND, READ NUMBER.
	 ERROR1	No argument in conditional
	SOS	VALREQ
	LDB	W,[POINT ADRSIZ,V,35];PREPARE TO LIST VALUE OF ARG ALONG WITH CONDITIONAL.
	HRLI	W,CL1
	LSH	V,24		;MOVE VALUE'S SIGN INTO BIT 4.9 FOR TEST.
	REST	A		;RESTORE THE TEST INSN (A SKIP!X)
	XCT	A
	AOS	(P)
	JRST CNTCMA

;COME HERE FOR SPECIAL CONDITIONALS.
CNTSPC:	TLNN	V,200000	;BIT 4.8 OFF => TRUE CONDITION.
	 JRST	[CALL (V) ? RET ? JRST POPJ1]
	CALL	(V)		;BIT 4.8 => REVERSE THE TEST.
	AOS	(P)
	RET
;RTN FOR .IF DIF & .IF IDN, READS 2 MACRO-ARGS, SKIPS IF DIFFERENT
CNTDIF:	CALL	ARGINI		;INIT. THE FIRST ARG.
	 ERROR1	POPAJ,No argument in conditional
		 ;(RETURN NON-SKIPPING FROM CNT)
	CALL	GETBLK		;PREPARE TO COPY 1ST ARG INTO MACRO-STORAGE.
	SAVE	MWPNTR,MWPNTR
		 ;WILL ILDB -1(P) TO RE-READ ARG, USE (P) TO FREE IT AFTER.
CNTDI1:	CALL	ARGC		;GET NEXT CHAR TO WRITE IN STRING.
	 JRST	CNTDI0		;NO MORE CHARS.
	CALL	WCIMT
	JRST	CNTDI1

CNTDI0:	MOVEI	I,^C
	CALL	WCIMT		;TERMINATE STRING WITH ^C.
	CALL	ARGINI		;START READING 2ND ARG.
	 JRST	CNTDI3		;NO ARG SAME AS NULL ARG.
CNTDI2:	CALL	ARGC
	JRST	CNTDI3		;AT END OF 2ND, SEE IF END OF 1ST.
	ILDB	A,-1(P)		;GET CHAR OF 1ST,
	CAIN	A,(I)
	 JRST	CNTDI2		;THE SAME SO FAR.
CNTDI4:	CALL	ARGC		;THEY'RE DIFFERENT, SKIP REST OF 2ND ARG.
	 JRST	CNTDI5
	JRST	CNTDI4

CNTDI3:	ILDB	A,-1(P)
	CAIE	A,^C		;SKIP-RETURN IF 1ST ARG LONGER THAN 2ND, NOT EQUAL.
CNTDI5:	AOS	-2(P)
	REST	A		;GET THE OTHER SAVED COPY OF MWPNTR,
	CALL	REMMAC		;FREE 1ST ARG'S STRING STG.
	JRST	POPAJ

;RTN FOR .IF B & .IF NB, READ 1 ARG & SKIP IF BLANK.
CNTB:	CALL	ARGINI
	 JRST	POPJ1		;NO ARG COUNTS AS BLANK.
	CALL	ARGC
	 JRST	POPJ1		;ARG NULL => BLANK.
CNTB0:	CALL	ARGC		;CAN'T BE BLANK, SKIP THE ARG
	RET			;RETURN FAILURE.
	JRST	CNTB0

;RTN FOR .IF 1 & .IF 2, SKIP IF PASS 1.
CNTP1:	TLNE	AF,P1F
	AOS	(P)
	JRST CNTCMA

;RTN FOR .IF DF & .IF NDF, SKIP IF ALL SYMS IN ARG ARE DEF.
CNTDF:	SAVE	VALREQ
	SETZM	VALREQ		;DON'T WANT ERROR MSG ON UNDEF SYM!
	TLO	AF,NDSFLG	; AND DON'T WANT THEM PUT IN DICT.
	CALL	EXPRF		;READ THE ARG,
	 JFCL
	REST	VALREQ
	TLZ	AF,NDSFLG	; PUT UNDEFINEDS IN DICT. AGAIN
	TRZN	AF,ERRU		;SKIP UNLESS SAW UNDEF SYM.
	 AOS	(P)
CNTCMA:	CAIE I,",
	RET
	JRST @GETCHA
;.IRP DUMMY,<ARG1,ARG2,ARG3>
AIRP:	MOVEI	S,IRPORD	;INDICATE ORDINARY .IRP .
	JRST	AIRP0

;.IRPC DUMMY,STRING
AIRPC:	MOVEI	S,IRPCHR

AIRP0:	CALL	GETBLK	;GET START OF .IRP ARGS BLOCK.
	CALL	GETSYM		;READ DUMMY SYMBOL NAME.
	 ERROR1	[[SETO N, ? JRST .+1]]Invalid IRP
	CALL	PSOB3		;PASS COMMA, ERROR IF NONE.
	SAVE	MWPNTR
	MOVEM	N,ARGLST	;PRETEND THAT DUMMY IS 1ST MACRO ARG.
	SETZM	ARGLST+1	;AND ONLY 1 ARG. (WILL READ IN BODY AS MACRO-DEF.)
	AOS	MWPNTR		;1ST WD -> BEFORE START OF ARGLIST OR STRING.
	AOS	MWPNTR		;ARG BLOCK+1 - BP. -> AFTER LAST ARGN.
	JRST	@.(S)
PHASE 1
IRPORD::AIRP1
IRPCHR::[SETZ	I,		;MAKE A 1-CHAR-LONG MACRO ACTUAL,
	CALL	WCIMT		;EACH PASS THRU .IRPC WILL PUT THE NEXT
	CALL	WTARGT		;CHAR OF THE STRING INTO THIS ACTUAL.
	MOVE	I,[250000,,1]
	ADDM	I,MWPNTR	;BYPASS REST OF THIS WORD (3RD WD IN BLOCK).
	JRST	AIRP1]
DEPHASE
AIRP1:	MOVE	I,MWPNTR	;PUT BP TO START OF ARGS
	MOVEM	I,@(P)		;INTO BLOCK'S 1ST WORD.
	CAIN	S,IRPORD	;.IRP, PUT TERMINATOR BEFORE 1ST ARG.
	CALL	WTARGT
	CALL	ARGINI		;INIT. READING OF STRING OR ARGLIST.
	 JRST	AIRP4		 ;THERE IS NO ARGLIST.
AIRP2:	CALL	ARGC		;GET NEXT ARG CHARS_ACTER,
	 JRST	AIRP3		 ;NO MORE CHARS.
	CALL	WCIMT		;WRITE IT IN .IRP ARGS BLPCK.
	CAIN	I,",		;IN .IRP, REPLACE A COMMA
	CAIE	S,IRPORD
	 JRST	AIRP2
	HRRZ	I,ARGRET	;IF THE ARG TO "IRP" IS BRACKETED,
	CAIN	I,ARGLT1	;THEN BRACKETS INSIDE THE ARG INHIBIT COMMAS,
	 SKIPN	ARGTRM		;SO THAT ".IRP X,<FOO,<BAR,BLE>>" HAS 2 ARGS
	  CAIA			;WHICH ARE "FOO" AND "<BAR,BLE>".
	   JRST	AIRP2
	MOVEI	I,^C		;WITH A TERMINATOR QUEARG.
	DPB	I,MWPNTR
	MOVEI	I,QUEARG
	CALL	WCIMT
	JRST	AIRP2
AIRP3:	CAIN	S,IRPORD	;.IRP, FOLLOW ARGS BY TERMINATOR.
	CALL	WTARGT
AIRP4:	MOVE	A,MWPNTR
	MOVE	B,(P)
	MOVEM	A,1(B)		;STORE PTR TO END IN 2ND WD OF BLOCK.
	CALL	ENDLR		;LIST THE LINE THE .IRP IS ON.
	SAVE	S
	CALL	[CALL	GETBLK	;START IRP-BODY BLOCK.
		 SAVE	MWPNTR, [1]	;SAVE THEM SINCE DEF00 DOES.
		 SETZ	S,	;.MACR - .ENDM LEVEL COUNT.
		 MOVEI	A,3	;3 WDS SPECIAL AT START OF BLOCK.
		 ADDM	A,MWPNTR
		 JRST	DEF03]	;GO READ IN BODY OF IRP.
	SAVE	A
	CALL	ENDLR
	REST	A,S,B
	MOVEM	B,2(A)		;-> IRP BODY BLOCK RET. IN A.
	MOVE	C,MACBPT	;ALL IS READ IN, NOW PUSH MACRO PDL.
	IDPB	C,MACPDP	;SAVE OLD MACBPT.
	MOVE	C,%IRPCN	;SAVE OUTER .IRPCN .
	IDPB	C,MACPDP
	MOVE	C,AIRPXT-1(S)	;GET ADDR OF APPROPRIATE END-OF-STRING RTN.
	EXCH	C,MACXIT	;CALL IT WHEN FINISH EACH PASS.
	IDPB	C,MACPDP	;SAVE OUTER STRING'S EOS RTN.
	IDPB	MP,MACPDP	;SAVE OUTER MACRO PTR.
	IDPB	A,MACPDP	;SAVE PTR -> "MACRO DEF"
	IDPB	A,MACPDP	;MAKE SPACE FOR THIS INVOCATION'S SAVED READ PTR.
	MOVE	C,MACPDP	;(WHICH WILL BE STORED BY AIRPND)
	MOVEM	C,MACBPT	;MACBPT POINTS TO THAT WORD.
	ADDI	B,2
	HRLI	B,440700	;COME UP WITH THE "MACRO ARG" B.P.
	IDPB	B,MACPDP
	MOVEI	B,1
	IDPB	B,MACPDP	;STORE "# MACRO ARGS"
	MOVE	MP,(C)
	SETOM	%IRPCN
	CALL	GCHSET
	JRST	@MACXIT		;PRETEND -1'TH PASS THRU IRP JUST ENDED.

AIRPXT:	PHASE	1
IRPORD::AIRPON		;END-OF-PASS RTN FOR .IRP,
IRPCHR::AIRPCN		; FOR .IRPC .
	DEPHASE
;COME HERE AFTER END OF PASS THRU .IRP .
AIRPON:	CAIA			;CALL HERE AFTER PASS,
	 JRST	AIRPX		;CALL HERE FROM .MEXIT
	CALL	AIRPND		;SET READ PTR TO START OF IRP BODY.
	SAVE	A,B
	MOVE	A,MACBPT
AIRPO1:	ILDB	B,1(A)	;MOVE THRU LAST PASS'S IRP ACTUAL
	PUSHJ	P,AIRPO9	;MOVE TO NEXT BLOCK IF NEC.
	CAIE	B,^C		;UNTIL GET TO TERMINATOR.
	 JRST	AIRPO1
	ILDB	B,1(A)		;MOVE OVER TERMINATOR, NOW -> NEXT IRP ACTUAL.
	PUSHJ	P,AIRPO9
	MOVE	B,1(A)
	CAME	B,1(I)		;BUT MAYBE WE POINT TO LAST TERMINATOR?
	 JRST	POPBAJ		 ;NO, THERE'S ANOTHER IRP ACTUAL, DO NEXT PASS.
	REST	B		;YES, POP THE IRP STUFF OF MACPDL.
AIRPC1:	MOVE	A,I
	CALL	REMMAC		;FREE UP THE IRP ARGS BLOCK.
	MOVE	I,MACBPT
	MOVE	A,-1(I)
	CALL	REMMAC		;FREE THE IRP BODY BLOCK.
	MOVE	MP,-2(I)	;RESTORE THE SAVED MACRO READ PTR AND MACXIT AND MACBPT.
	MOVE	A,-3(I)
	MOVEM	A,MACXIT
	MOVE	A,-4(I)
	MOVEM	A,%IRPCN
	MOVE	A,-5(I)
	MOVEM	A,MACBPT
	MOVNI	A,8
	ADDM	A,MACPDP	;FLUSH THE WDS FROM THE STACK.
	CALL	GCHSET
	JRST	POPAJ

AIRPO9:	JUMPN	B,CPOPJ	;DO NOTHING UNLESS AT END OF MACRO-BLOCK.
	MOVE	B,@1(A)		;ELSE GET ADDR OF NEXT BLOCK,
	HRRM	B,1(A)		;MAKE BP. -> IT.
	LDB	B,1(A)		;GET NEXT CHAR FROM THAT BLOCK.
	RET

AIRPX:	CALL	AIRPND		;.MEXIT IN IRP; SET UP POINTERS,
	SAVE	A
	JRST	AIRPC1		;GO POP OFF MACPDL.

;COME HERE AFTER END OF PASS THRU .IRPC .
AIRPCN:	CAIA			;CALL HERE AT END OF PASS.
	 JRST	AIRPX		;CALL HERE FROM .MEXIT .
	CALL	AIRPND		;SET READ PTR TO START OF IRP BODY.
	SAVE	A
	MOVE	A,(I)		;GET BP INTO STRING TO IRPC ON.
	CAMN	A,1(I)		;IF -> LAST CHAR, THERE ARE NO MORE,
	 JRST	AIRPC1		 ;GO POP OUT OF THE IRP.
	ILDB	A,(I)		;ELSE GET THE NEXT CHAR.
	JUMPE	A,[	MOVE A,@(I)	;GONE PAST END OF BLOCK =>
			HRLI A,350700	;FOLLOW POINTER IN LAST WORD
			MOVEM A,(I)	;TO FIND NEXT BLOCK.
			LDB A,A		;AND FETCH ITS 1ST CHARACTER.
			JRST .+1]
	DPB	A,[350700,,2(I)]	;PUT IT IN THE PHONY MACRO ACTUAL.
	JRST	POPAJ

;COMMON RTN FOR END OF PASS THRU ANY IRP.
;SET THE MACRO READ PTR (IN MP AND `MACBPT) -> START OF IRP BODY.
;LEAVE I -> IRP ARGS BLOCK.
AIRPND:	AOS	%IRPCN
	MOVE	I,MACBPT
	MOVE	MP,-1(I)	;-> IRP BODY BLOCK.
	HRLI	MP,440700
	ADDI	MP,3		;BP -> START OF TEXT OF IRP BODY.
	MOVEM	MP,@MACBPT
	MOVE	I,-1(MP)	;-> IRP ARGS BLOCK.
	RET
;MACRO ARG READING COROUTINES.
;CALL HERE TO INIT. READING OF MACRO ARG (FROM ASSEMBLY INPUT PATH)
ARGINI:	SETCHAR
	LDB	B,C1PNTR
	CAIN	B,MACR		;1ST CHAR IS CR OR ;, NO ARG.
	 RET
	AOS	(P)		;ELSE THERE IS AN ARG.
	CAIN	I,"\		;\ - ARG IS EVALUATED & CONVERTED TO BASE 8.
	 JRST	ARGBS
	CAIN	I,"<		;< - ARG IS BRACKETED WITH < & >.
	 JRST	ARGLT
	CAIE	I,"^		;ARG IS ORDINARY UNLESS STARTS WITH ^ .
	 JRST	ARG1
	CALL	@GETCHA		;ARG USES DELIMITERS, READ THE DELIMITER.
	MOVEM	I,ARGTRM	;SAVE IT.
	JSR	ARGRET		;RETURN, ARGC CALLS AT .+1 .

	CALL	@GETCHA
	CAME	I,ARGTRM	;WAS THIS CHAR THE DELIMITER?
	 JRST	POPJ1		;NO, IT'S PART OF THE ARG.
ARGEN1:	CALL	@GETCHA
ARGEND:	LDB	B,C1PNTR	;MOVE PAST THE ARGUMENT.
	XCT	.+1(B)
PHASE	0
	ERROR1	ARGEN1,Bad macro-type argument
MASP::	JRST	ARGEN1		;PASS SPACES.   ^- PASS MOST CHARS BUT ERROR.
MACM::	JRST	@GETCHA		;COMMA, STOP ON NEXT CHAR.
MACR::	RET			;CR OR ;, STOP ON IT SO NEXT ARGINI WILL SEE IT.
DEPHASE

ARGBS:	CALL	@GETCHA		;ARG IS \<EXPR> -- READ 1ST CHAR OF EXPR.
	SAVE	S
	CALL	EXPRF
	 ERROR1 No expression after backslash
	REST	S
	MOVEM	V,ARGTRM	;SAVE VALUE OF ARG IN RH,
	MOVE	V,[220300,,ARGTRM]
ARGBS0:	HLLM	V,ARGTRM	;PUT LH OF BP INTO RH, IN LH.
	ILDB	A,V
	JUMPN	A,ARGBS1	;THEN MOVE BP PAST LEADING ZEROS.
	TLNE	V,77^4		;BUT DON'T MOVE PAST LAST DIGIT.
	 JRST	ARGBS0		;CAN PASS IT, UPDATE LH(ARGTRM)
ARGBS1:	JSR	ARGRET
;COME HERE FROM ARGC
	HLLZ	I,ARGTRM	;LH OF ARGTRM SAYS WHICH FIELD IN WORD,
	HRRI	I,ARGTRM	;THE WORD IS ARGTRM (THE RH, WHICH HAS VALUE OF ARG)
	TLNN	I,77^4		;USED ALL 6 OCTAL DIGITS?
	 JRST	[SETCHAR ? JRST ARGEND]	;YES, PASS END OF ARG.
	IBP	ARGTRM
	ILDB	I,I		;GET THE NEXT OCTAL DIGIT.
	ADDI	I,"0
	JRST	POPJ1

ARGLT:	SETZM	ARGTRM		;ARG IS BRACKETED, ARGTRM COUNTS ANGLE-BRACKET LEVEL.
	JSR	ARGRET
ARGLT1:	CALL	@GETCHA
	CAIN	I,"<
	 AOS	ARGTRM		;< - GO UP ONE LEVEL.
	CAIN	I,">
	 SOSL	ARGTRM		;> - DOWN 1 LEVEL, MAYBE END ARG.
	JRST	POPJ1		;ORDINARY CHAR IS IN ARG.
	JRST	ARGEN1		;FOUND THE MATCHING >.

;HANDLE AN ORDINARY ARG.
ARG1:	JSR	ARGRET		;THE 1ST CHAR OF ARG WAS READ ALREADY.
	SETCHAR
ARG2:	LDB	B,C1PNTR
	XCT	ARG1TB(B)	;SPACES, COMMA, CR AND ; SPECIAL.
	MOVEM	IP,SYMBEG	;IT WAS A SPACE, CHECK FORWARD
	CALL	GETNB		;IF 1ST NONSPACE IS ;,
	CAIN	I,";
	 RET			;IGNORE THE SPACE, STOP ON THE ;.
	RESCAN	SYMBEG		;SPACES NOT BEFORE ;'S ARE ORDINARY CHARS.
	SETCHAR
ARG3:	AOS	(P)
	JSR	ARGRET		;EVERY CHAR. AFTER THE 1ST HAS TO BE READ.
	CALL	@GETCHA
	JRST	ARG2		;BUT TREAT THEM THE SAME WAY.

ARG1TB:	PHASE	0
	JRST	ARG3		;ORDINARY CHAR, RETURN IT.
MASP::	JFCL			;SPACE, FALL THRU INTO SPECIAL RTN.
MACM::	JRST	@GETCHA		;COMMA, PASS IT & END OF ARG.
MACR::	RET			;CR OR ;, END OF ARG BUT STOP ON IT.
DEPHASE

;CALL HERE TO READ NEXT CHARACTER OF MACRO-ARG.
;SKIPS => CHAR IS IN I .
;ELSE ARG HAS ENDED, CALL ARGINI TO START NEXT ARG.
ARGC:	JRST	@ARGRET
;.TTYMAC ENTRY TO MACRO HANDLER
ATTYMA:	TLO	AF,TTMFLG	;WE ARE NOW DOING A .TTYMAC
	MOVNI	N,2		;LOOK LIKE DEFINING STRANGE MACRO
	CALL	GETBLK
	CALL	DEF00		;READ IN THE DEFINITION.
	SAVE	A		;REMEMBER ITS ADDRESS.
	CALL	ENDLR		;LIST LINE WITH .ENDM .
	SAVE	TTIPNT,TTICNT
	CALL	TTILN		;READ ARGS FROM TTY.
	MOVEI	B,^M		;PUT CRLF AFTER LINE READ.
	IDPB	B,TTIPNT
	MOVEI	B,^J
	IDPB	B,TTIPNT
	MOVE	B,TTIPNT	;REMEMBER LAST FILLED SLOT IN LINBUF.
	MOVEM	B,LINIP
	REST	TTICNT,TTIPNT
	RESCAN	<[350700,,LINBUF]>
	TLZ	AF,TTMFLG
	REST	A		;ENDLR DESTROTED A.
	SETCHAR
	JRST	CALLM		;NOW EXPAND MACRO WITH ARGS FROM TTY.

;.MACR PSEUDOOP.
AMACRO:
AMACR:	CALL	DEFIN0		;READ IN THE DEFINITION,
	JRST	ENDLR		;LIST THE LAST LINE & EXIT.

DEFIN0:	CALL	GETBLK		;OK, GET A BLOCK FROM STORAGE
	CALL	GETSYM		;GET MACRO'S NAME
	 ERROR1	DEFERR,Define what name?
DEF00:	CALL	SRCH		;SEE IF ALREADY DEFINED
	 SETZ	A,		;  NOT IN TABLE
	TLNE	A,LBLSYM
	 ERROR1	DEFERR,	Label made macro
	LDB	B,TYPPNT	;GET OP TYPE
	CAIE	B,MAOP		;MACRO?
	TLZA	A,-1-NCRSYM	;NO, PRETEND NOT FOUND.
	CALL	DECMAC		;  YES, DECREMENT REFERENCE
	HRRZ	A,MWPNTR	;GET POINTER TO START OF BLOCK
	HRLI	A,MAOP		;FLAG MACRO
	XCT	CRFIND		;INDIC. BEING DEFINED.
	CALL	INSRT		;INSERT IN SYMBOL TABLE
	PUSH	P,MWPNTR	;STACK POINTER TO START OF BLOCK
	MOVEI	A,2
	ADDM	A,MWPNTR	;MOVE PAST REFERENCE LEVEL AND ARG COUNT
	TDZA	S,S		;INIT ARG COUNT
DEF01:	CALL	GETCHR		;MOVE PAST COMMA
	CALL	GETSYM		;GET AN ARG
	 JRST	DEF02		;  NOT THERE
	MOVEM	N,ARGLST(S)	;STORE IN LIST
	ADDI	S,1		;BUMP POINTER
	CAIN	I,",		;ANY MORE?
	JRST	DEF01		;  YES

DEF02:	PUSH	P,S		;STACK ARG COUNT
	SETZM	ARGLST(S)	;MARK END
	CALL	ENDLR		;LIST THE LINE
	SETZ	S,		;INIT LEVEL COUNT
DEF03:	CALL	GETLIN
	CALL	GETSYM		;TEST THE FIRST SYMBOL
	 JRST	DEF04
	CAME	N,[SIXBIT/.IRP/]
	CAMN	N,[SIXBIT/.IRPC/]
	 AOJA	S,DEF04
	CAME	N,.TTYMX
	CAMN	N,.MACRX	;MACRO DEF - INCREM LEVEL COUNT.
	AOJA	S,DEF04
	CAME	N,.REPTX
	CAMN	N,.MACRY
	AOJA	S,DEF04
	CAME	N,.ENDRX
	CAMN	N,.ENDMX	;END OF DEF - DECREM COUNT.
	SOJL	S,DEF13		;END IF MINUS

DEF04:	RESCAN	LINPNT		;SET TO START OF LINE
DEF05:	CALL	GETCHR		;GET THE NEXT CHARACTER
DEF06:	CAIE	I,"'		;CONCATENATION CHARACTER?
	JRST	DEF06C		;  NO, BRANCH AROUND
DEF06A:	CALL	GETCHR		;YES, GET THE NEXT CHARACTER
	CAIE	I,"'		;MULTIPLE?
	JRST	DEF06B		;  NO
	CALL	WCIMT		;YES, SAVE ONLY ONE
	JRST	DEF06A		;TEST FOR MORE

DEF06B:	TLO	AF,CONFLG	;FLAG THE CONCATENATION CHARACTER
DEF06C:	LDB	B,ANPNTR	;MAP
	XCT	DEFT1(B)	;EXECUTE TABLE
	CALL	WCIMT		;WRITE IN TREE
	JRST	DEF05		;TRY FOR ANOTHER

DEF15:	SUBI	I,40		;LOWER CASE LETTER STARTS A SYMBOL.
DEF07:	SETZ	N,		;POSSIBLE ARGUMENT
	MOVSI	C,440600
	MOVEM	IP,SYMBEG	;SAVE START JUST IN CASE
DEF08:	SUBI	I,40		;CONVERT TO SIXBIT
DEF14:	CAME	C,[POINT 6,N,35]	;ROOM TO STORE?
	IDPB	I,C		;  YES, DO SO
	CALL	GETCHR		;GET THE NEXT CHARACTER
	LDB	B,ANPNTR	;MAP
	XCT	DEFT2(B)	;EXECUTE TABLE
	SETZ	B,		;INIT SEARCH INDEX
DEF09:	SKIPN	ARGLST(B)	;TEST FOR END
	JRST	DEF10		;  YES
	CAME	N,ARGLST(B)	;NO, HAVE WE A MATCH?
	AOJA	B,DEF09		;  NO,TRY THE NEXT SLOT
	TLZ	AF,CONFLG	;REMOVE POSSIBLE CONCATENATION CHARACTER
	MOVEI	I,101(B)	;SET DUMMY SYMBOL POINTER
	CALL	WTIMT		;WRITE IN TREE
	SETCHAR			;SED CHARACTER
	CAIN	I,"'		;CONCATENATION CHARACTER?
	JRST	DEF05		;  YES, BYPASS IT
	JRST	DEF06		;  NO, PROCESS IT
DEF10:	RESCAN	SYMBEG		;MISSED, RESET POINTER
	SETCHAR			;RESET CHARACTER
DEF11:	LDB	B,ANPNTR	;MAP
	XCT	DEFT3(B)	;EXECUTE TABLE
	CALL	WCIMT		;OK, WRITE IN TREE
	CALL	GETCHR		;GET NEXT CHAR
	JRST	DEF11		;TEST IT

DEF12:	CALL	WCIMT		;WRITE IT OUT
	CAIE	I,^J		;IF FINISHED LINE,
	JRST	DEF05
	CALL	ENDLR		;LIST IT
	TLNN	AF,ENDFLG	;SKIP IF EOF SEEN
	JRST	DEF03		;GET THE NEXT LINE

DEF13:	MOVEI	I,QUEMAC	;FINISHED, SET "END OF MACRO DEFINITION"
	CALL	WTIMT		;WRITE IT, WITH QUE, IN TREE
	POP	P,B		;RETRIEVE COUNT
	POP	P,A		;  AND POINTER TO START OF BLOCK
	SETZM	0(A)		;ZERO LEVEL COUNT
	HRRZM	B,1(A)		;STORE ARG COUNT IN SECOND RUNG
	SETCHAR			;RESTORE LAST CHARACTER
	RET

DEFERR:	MOVNI	N,1		;SKIP DEFN. BY DEFINING ______.
	JRST	DEF00

DEFT1:	PHASE	0
	JRST	DEF12
.TAB::	JFCL
.ALP::	JRST	DEF07
.NUM::	JRST	DEF07
.DOT::	JRST	DEF07
.TRM::	JRST	DEF12
.LOW::	JRST	DEF15
	DEPHASE


DEFT2:
	PHASE	0
	JFCL
.TAB::	JFCL
.ALP::	JRST	DEF08
.NUM::	JRST	DEF08
.DOT::	JRST	DEF08
.TRM::	JFCL
.LOW::	JRST	DEF14
	DEPHASE

DEFT3:	PHASE	0
	JRST	DEF06
.TAB::	JRST	DEF06
.ALP::	JFCL
.NUM::	JFCL
.DOT::	JFCL
.TRM::	JRST	DEF06
.LOW::	JFCL
	DEPHASE
;MACRO PDL FRAME FORMAT:
;WD 1	PREVIOUS MACBPT, OR 0 IN LOWEST FRAME.
;WD 2	PREVIOUS %NARG.
;WD 3	PREVIOUS MACXIT.
;WD 4	PREVIOUS READ POINTER (MP)
;WD 5	PTR TO 1ST BLOCK OF MACRO.
;WD 6	READ PTR IN MACRO SAVED AROUND DUMMY SYMBOL. MACBPT PTS HERE.
;WD 7	B.P. TO START OF 1ST ARG, ETC. FOR ALL ARGS.
;LAST	NUMBER OF ARGS. MACPDP POINTS HERE.
CALLM:	AOS	(A)		;INCR. REF. COUNT IN MACRO.
	MOVN	S,1(A)		;MAX. NUM. ARGS.
	HRLZS	S		;GET "AOBJN PTR" TO ARGUMENT.
	SAVE	A		;REMEMBER MACRO BODY ADDR.
	JUMPE	S,MAC50		;TEST FOR NO ARGS
	CALL	SETNB		;RESTORE LAST CHARACTER
	CALL	GETBLK		;BLOCK TO STORE ARGS IN.

MAC20:	CALL	ARGINI		;START READING MACRO-TYPE ARG FROM INPUT STREAM.
	 JRST	MAC50		;NO MORE ARGS, FINISH UP.
	SAVE	MWPNTR
MAC21:	CALL	ARGC		;GET NEXT CHAR OF ARG,
	 JRST	MAC40		 ;(NO MORE CHARS IN ARG)
	CALL	WCIMT		;WRITE CHAR IN MACRO-CALL-BLOCK.
	JRST	MAC21

MAC40:	CALL	WTARGT		;TERMINATE ARG.
	AOBJN	S,MAC20		;BRANCH IF MORE ARGS WANTED.

MAC50:	CALL	ENDLR		;FINISH READING LINE FROM OLD SOURCE.
	MOVE B,MACBPT	;NOW PUSH THE NEW FRAME ON MACRO PDL:
	IDPB	B,MACPDP	;OLD MACBPT.
	MOVE	B,%NARG
	IDPB	B,MACPDP	;OLD %NARG
	MOVEI	B,MACEND
	EXCH	B,MACXIT
	IDPB	B,MACPDP	;OLD MACXIT
	IDPB	MP,MACPDP	;OLD MACRO READ PTR.
	AOS	MACPDP		;WILL FILL IN PTR TO MACRO BODY LATER.
	AOS	A,MACPDP	;NEEDN'T STORE WD 6 ( IT HAS MEANING
	MOVEM	A,MACBPT	;ONLY WHILE READING DUMMIES)
	MOVEI	B,(P)
	SUBI	B,-1(S)		;ADDR OF 1ST ARG B.P. ON THE STACK.
	AOS	MACPDP		;PLACE FOR 1ST ARG B.P. TO GO.
	MOVSS	B
	HRR	B,MACPDP	;BLT PTR
	ANDI	S,-1		;# OF ARGS ACTUALLY READ = # WDS PUSHED.
	ADDM	S,MACPDP	;ADDR OF LAST WD OF FRAME
	BLT	B,@MACPDP	;(BLT'S 1 WD MORE THAN NECESSARY)
	HRRZM	S,@MACPDP	;SAVE # ARGS IN LAST WD.
	MOVEM	S,%NARG		;SO "FOO==%NARG" WILL WORK
	HRLI	S,(S)		;# ARGS,,# ARGS
	SUB	P,S		;POP ARG B.P.'S OFF STACK.
	REST	MP		;ADDR OF MACRO BODY.
	MOVEM	MP,-1(A)	;SAVE IN WD 5 OF FRAME. (A STILL HAS MACBPT)
	HRLI	MP,440700	;GET B.P. TO ILDB TEXT OF MACRO.
	ADDI	MP,2
	AOS	MACLVL
	JRST	GCHSET
;COME HERE AFTER READING ENTIRE MACRO. CALLED FROM GCHM SO DON'T CLOBBER ACS.
MACEND:	JFCL			;.MEXIT WILL CALL HERE+1
	MOVE	I,@MACPDP	;GET NUM. ARGS.
	SOS	A,MACBPT	;-> WD 3, -> MACRO.
	MOVEM	A,MACPDP
	MOVE	A,2(A)		;GET PTR -> 1ST ARG (IF ANY ARGS)
	CAIE	I,0		;IF WERE ARGS, FLUSH CALL-BLOCK.
	CALL	REMMAC		;FLUSH BLOCK HOLDING THEM.
	MOVE	A,MACPDP
	SUBI	A,5
	MOVEM	A,MACPDP	;FLUSH REMAINING WDS.
IRPS X,,MACBPT %NARG MACXIT
	MOVE	B,1+.IRPCN(A)
	MOVEM	B,X
TERMIN
	MOVE	MP,4(A)
	MOVE	A,5(A)
	CALL	DECMAC		;SOS MACRO REF-COUNT, MAYBE FREE.
	SOS	MACLVL		;DECREMENT MACRO LEVEL COUNT
	JUMPE	MP,GCHSE0	;IF POPPED TO FILE, RESET GETCHA .
	RET

;.MEXIT - POP OUT OF INNERMOST REPEAT, IRP OR MACRO.
AMEXIT:	JUMPE	MP,[ERROR1 ENDLR,.MEXIT in file
]
	CALL	ENDLR		;LIST THE LINE WITH THE .MEXIT ON IT.
	MOVE	A,MACXIT	;GET ADDR OF RTN TO END 1 PASS THRU INNERMOST STRING,
	JRST	1(A)		;CALL 1 INSN AFTER TO END ALL PASSES THRU IT.

;.NCHR SYM,ARG  SAME AS  SYM==.LENGT ARG
ANCHR:	JSP	A,ANCHR1
;.LENGT - TAKES ARG LIKE MACRO, RETURNS # CHARS IN IT.
ALENGT:	SETZ	V,
	CALL	ARGINI		;INIT. READING OF ARG.
	 RET			;NO ARG, RETURN 0.
ALENG1:	CALL	ARGC		;READ NEXT CHAR.
	 RET			;NO MORE, RETURN # COUNTED.
	AOJA	V,ALENG1

;.NTYPE SYM,ARG  SAME AS  SYM==.ADRMD ARG
ANTYPE:	JSP	A,ANCHR1
;.ADRMD ARG,  RETURNS ADDRESSING MODE OF ARG
;(EG RETURNS 64 FOR INDEX OF R4)
AADRMD:	SAVE	CEXT,OFFST	;DON'T CLOBBER INSN ARG BEING READ.
	CALL	AEXP
AADRI2:	TLZ	AF,REGFLG
	TRZ	AF,ERRU		;EVEN IF ARG INCLUDES UNDEFINED SYMS, VALUE IS NOT UNDEF
	REST	OFFST,CEXT
	JRST	CNTCMA		;RETURN WHAT AEXP RETURNED.

;.ADRIX ARG,  RETURNS THE INDEX-WORD OF ARG.  .ADRIX 1(2), RETURNS 1.
AADRIX:	SAVE	CEXT,OFFST
	CALL	AEXP
	MOVE	V,OFFST
	HRRZ	V,CEXT(V)
	JRST	AADRI2

ANARG:	CALL	GETSYM
	 JFCL
	SAVE	N
	MOVE	V,%NARG
	TLO	AF,HKLFLG
	JRST	ASGMT0


ANCHR1:	SAVE	A		;REMEMBER ADDR OF RTN TO GET VALUE,
	CALL	GETSYM		;READ NAME OF SYM TO ASSIGN.
	 JFCL
	CALL	PSOB3		;PASS COMMA, ERROR IF NONE.
	EXCH	N,(P)		;PUT NAME ON STACK FOR ASGMT0.
	CALL	@N		;CALL RTN TO READ OTHER ARGS, RETURN VALUE IN V.
	TLO	AF,HKLFLG
	JRST	ASGMT0	;ASSIGN SYM, HALF-KILLED.
;MACRO STORAGE HANDLERS

WTARGT:	MOVEI	I,QUEARG		;TERMINATE ARG.

WTIMT:				;WRITE TWO CHARACTERS IN MACRO TREE
	PUSH	P,I		;STACK CURRENT CHARACTER
	MOVEI	I,^C		;SET FLAG CHARACTER
	CALL	WCIMT		;WRITE IT
	POP	P,I		;RESTORE CHARCTER AND FALL THROUGH

WCIMT:				;WRITE CHARACTER IN MACRO TREE
	TLZE	AF,CONFLG	;CONCATENATION CHARACTER PENDING?
	JRST	WCIMT2		;  YES, WRITE IT OUT
	IBP	MWPNTR		;POINT TO ACTUAL WORD
	SKIPN	@MWPNTR		;END OF BLOCK?
	JRST	WCIMT1		;  YES, GET ANOTHER
	DPB	I,MWPNTR	;NO, STORE BYTE
	RET

WCIMT1:	PUSH	P,MWPNTR	;NEAD A NEW BLOCK, SAVE CURRENT POINTER
	CALL	GETBLK		;GET IT
	HRRZ	T1,MWPNTR	;GET START OF NEW BLOCK
	EXCH	T1,0(P)		;EXCHANGE WITH POINTER TO LAST
	POP	P,0(T1)		;STORE VECTOR
	JRST	WCIMT		;TRY AGAIN

WCIMT2:	PUSH	P,I		;STACK CURRENT CHARACTER
	MOVEI	I,"'
	CALL	WCIMT		;WRITE CONCATENATION CHARACTER
	POP	P,I		;RESTORE CHARACTER
	JRST	WCIMT		;CONTINUE

GETBLK:				;GET A BLOCK FOR MACRO STORAGE
	SKIPE	T1,NEXT		;ANY REMNANTS OF GARBAGE COLLECTION?
	JRST	GETBL1		;  YES, RE-USE
	PUSH	P,S		;  NO, SAVE REGISTER
	MOVEI	S,WPB
	ADDB	S,MACTOP	;UPDATE FREE LOCATION POINTER
	CAML	S,JOBREL	;ANY ROOM?
	CALL	GETCOR		;  NO, GET MORE CORE
	MOVEI	T1,-<WPB-1>(S)	;POINT TO START OF BLOCK
	POP	P,S		;RESTORE
	SETZM	WPB-1(T1)	;CLEAR VECTOR
GETBL1:	HRLI	T1,440700	;FORM BYTE POINTER
	MOVEM	T1,MWPNTR	;SET NEW BYTE POINTER
	HRLI	T1,-<WPB-1>	;GET SET TO INITIALIZE BLOCK
	SETOM	0(T1)		;CLEAR ENDRY
	AOBJN	T1,.-1		;SET ALL EXCEPT LAST TO -1
	PUSH	P,0(T1)		;GET TOP
	POP	P,NEXT		;SET FOR NEXT BLOCK
	SETZM	0(T1)		;CLEAR LAST WORD
	RET
READMB:				;READ MACRO BYTE
	ILDB	I,MP		;GET CHARACTER
	JUMPN	I,CPOPJ		;EXIT IF NON-NULL
	MOVE	MP,0(MP)	;END OF BLOCK, GET LINK
	HRLI	MP,440700	;SET ASCII BYTE POINTER
	JRST	READMB		;TRY AGAIN

GETDS:				;GET DUMMY SYMBOL
	ANDI	I,37
	CAMLE	I,@MACPDP	;GOT THAT MANY ARGS?
	JRST	GCHM		;NO, ARG IS NULL.
	ADD	I,MACBPT	;ELSE INDEX INTO FRAME,
	MOVEM	MP,@MACBPT	;SAVE PTR IN MACRO ITSELF IN WD 4.
	MOVE	MP,(I)		;READ FROM DS.
	JRST	GCHM		;GET 1ST CHAR OF ARG.


DSEND:				;DUMMY SYMBOL END
	MOVE	MP,@MACBPT	;RESTORE READ PTR FROM WD 4.
	RET

DECMAC:				;DECREMENT MACRO STORAGE
	SOSL	0(A)		;TEST FOR END
	RET			;  NO, EXIT

REMMAC:				;REMOVE MACRO STORAGE
	PUSH	P,A		;SAVE POINTER
	HRLS	A		;SAVE CURRENT POINTER
	HRR	A,WPB-1(A)	;GET NEXT LINK
	TRNE	A,-1		;TEST FOR END (NULL)
	JRST	.-3		;  NO
	HLRZS	A		;YES, GET RETURN POINTER
	HRL	A,NEXT		;GET CURRENT START OF CHAIN
	HLRM	A,WPB-1(A)	;STORE AT TOP
	POP	P,A		;RESTORE BORROWED REGISTER
	HRRZM	A,NEXT		;SET NEW START
	RET
;LISTING ROYTINES

PRNTA:				;PRINT BASIC LINE OCTAL
	HLRZ	R6,W		;GET CLASS TYPE
	TLNE	AF,TTYFLG	;TELETYPE (DOUBLE LINE)?
	JRST	PRNTA1		;  YES, BRANCH
	CALL	LOTAB		;LIST A TAB
	HLRZ	C,PRNTAT(R6)	;TEST FOR LEFT HALF
	CALL	0(C)	;PROCESS
	CALL	LOTAB		;OUTPUT TAB
	HRRZ	C,PRNTAT(R6)	;GET RIGHT HALF
	CALL	0(C)	;PROCESS
	CALL	LOTAB
	HLRZ	C,PRNTBT(R6)	;GET NEXT ITEM
	SKIPE	C		;SKIP IF NULL
	CALL	0(C)
	CALL	LOTAB
	HRRZ	C,PRNTBT(R6)
	SKIPE	C		;SKIP IF NULL
	CALL	0(C)	;PROCESS
	RET

PRNTA1:				;TELETYPE LINE 1
	CALL	LOSP
	CALL	LOSP
	HLRZ	C,PRNTAT(R6)
	CALL	PRNTA2
	CALL	LOSP
	HRRZ	C,PRNTAT(R6)
PRNTA2:	CAIE	C,CPOPJ
	JRST	0(C)
	MOVEI	C,6
	CALL	LOSP		;OUTPUT 6 SPACES
	SOJG	C,.-1
	RET


PRNTAT:
	PHASE	0
	XWD	CPOPJ,	CPOPJ
	XWD	CPOPJ,	LOBAS	; ASSIGNMENT
	XWD	CPOPJ,	LOBAS	; .=
	XWD	LOLOC,	LOBAS	; XXXXXX
	XWD	LOLOC,	LOLOB	;    XXX
	XWD	CPOPJ,	LOBAS	; .END
	XWD	LOLOC,	LOBAS	; XXXXXX XXXXXX
	XWD	LOLOC,	LOBAS	; XXXXXX XXXXXX XXXXXX
	DEPHASE
PRNTB:				;PRINT EXTENSION LINE OCTAL
	HLRZ	R6,W		;GET CLASS
	TLNE	AF,TTYFLG	;IF NON-TELETYPE
	SKIPN	PRNTBT(R6)	;  OR NON-MULTIPLE WORD
	RET			;  EXIT
	MOVEI	C,5		;SET FOR 5 SPACES
	CALL	LOSP		;LIST THEM
	SOJG	C,.-1
	HLRZ	C,PRNTBT(R6)	;GET OP
	CALL	0(C)	;LIST FIRST WORD
	HRRZ	C,PRNTBT(R6)	;GET RIGHT HALF
	JUMPE	C,PRNTB1	;BRANCH IF NULL
	CALL	LOSP		;LIST ANOTHER SPACE
	CALL	0(C)	;PROCESS CODE
PRNTB1:	MOVEI	B,0
	JRST	0(A)		;LIST CR AND EXIT

PRNTBT:
	PHASE	0
	0
	0			; ASSIGNMENT
	0			; .=
	0			; XXXXXX
	0			;    XXX
	0			; .END
	XWD	LOHOW,	0	; XXXXXX XXXXXX
	XWD	LOHOW,	LOLOW	; XXXXXX XXXXXX XXXXXX
	DEPHASE
LOTAB:	MOVEI	B,TAB
	JRST	0(A)

LOSP:	MOVEI	B,SPACE
	JRST	0(A)

LOLOC:	LDB	V,[POINT ADRSIZ,L,35]
IFN RELCOD,[
	PUSH	P,[0]		; PUSH EXTERNALNESS
	PUSH	P,[0]		; PUSH RELOCATION
	TLNE	AF,LCRFLG	; LOCATION COUNTER RELOCATABLE?
	AOS	0(P)		; YES - ADJUST STACK ENTRY
]
	JRST	PRNTWD			;PRINT LOCATION

LOBAS:	LDB	V,[POINT ADRSIZ,W,35]
IFN RELCOD,[
	PUSH	P,EEXTAB	; PUSH EXTERNALNESS
	PUSH	P,REXTAB	; DITTO RELOCATION
]
	JRST	PRNTWD			;PRINT BASIC

LOHOW:	LDB	V,[POINT ADRSIZ,CEXT1,35]
IFN RELCOD,[
	PUSH	P,EEXT1
	PUSH	P,REXT1
]
	JRST	PRNTWD			;PRINT HIGH ORDER WORD

LOHOB:	LDB	V,[POINT  8,CEXT1,35]
	JRST	PRNTBY			;PRINT HIGH ORDER BYTE

LOLOW:	LDB	V,[POINT ADRSIZ,CEXT2,35]
IFN RELCOD,[
	PUSH	P,EEXT2
	PUSH	P,REXT2
]
	JRST	PRNTWD			;PRINT LOW ORDER WORD

LOLOB:	LDB	V,[POINT  8,W,35]
	JRST	PRNTBY			;PRINT LOW ORDER BYTE


PRNTBY:				;PRINT BYTE
	MOVEI	B,SPACE
	CALL	0(A)		;LIST THREE SPACES
	CALL	0(A)
	CALL	0(A)
IFN RELCOD,[
	PUSH	P,[0]
	PUSH	P,[0]		; BYTES IS ABSOLUTE AND LOCAL!
]
	SKIPA	C,[POINT 3,V,26]
PRNTWD:	MOVE	C,[POINT 3,V,17]
	ILDB	B,C
	ADDI	B,"0		;CONVERT TO ASCII
	CALL	0(A)		;LIST
	TLNE	C,770000
	JRST	PRNTWD+1
IFN RELCOD,[
	POP	P,V		; GET RELOCATION
	POP	P,C		; GET EXTERNAL REF.
	JUMPN	V,PRNREL	; JUMP IF RELOCATABLE
	JUMPE	C,CPOPJ		; EXIT IF NEITHER
	MOVEI	B,"*		; WAS EXTERNAL - TYPE --
	JRST	0(A)		; -- STAR AND EXIT
PRNREL:	MOVEI	B,"'		; ASSUME ONLY RELOCATABLE
	JUMPE	C,0(A)		; TRUE IF NO EXTERNAL REF.
	MOVEI	B,"!		; ELSE IS BOTH
	JRST	0(A)
]
	RET
IFE RELCOD,[
; THIS CODE ONLY ASSEMBLED IF NOT MAKING RELOCATABLE VERSION
;OUTPUT END BLOCK, SYMBOLS.
DUMP2:	CALL	BLKDMP		;DUMP CURRENT BUFFER
	MOVE	C,[140300,,[1060]]	;OUTPUT END BLOCK:
DUMP4:	ILDB	B,C		;GET NEXT CONSTANT BYTE,
	ADDM	B,CHKSUM
	CALL	BINOUT		;OUTPUT IT,
	TLNE	C,770000	;DO ALL 4.
	JRST	DUMP4
	LDB	B,[001000,,STRTLC]
	ADDM	B,CHKSUM	;NEXT, 2 BYTES OF START ADDR.
	CALL	BINOUT
	LDB	B,[101000,,STRTLC]
	ADDM	B,CHKSUM
	CALL	BINOUT
	MOVN	B,CHKSUM	;GET CHECKSUM.
	CALL	BINOUT		; PUNCH IT.
	TLNE	F,SYMBIT
	RET
	MOVEI	B,2		;"2" IS CODE FOR "SYM-TAB BLOCK" IN 11SIM LOADER FORMAT.
	CALL	SYMOUT
	MOVN	S,SYMLEN	;GET AOBJN PTR -> SYMTAB
	HRLZ	S,S
	JUMPE	S,CPOPJ
DUMP3:	SKIPN	B,@SYMPNT	;GET NAME.
	 RET			;0 => AT END.
IFE NEWBIN,[
	CALL	SYMOUT
	MOVE	B,@VALPNT
	ANDCMI	B,600000	;DON'T LET HIGH BITS CONFUSE 11SIM.
	CALL	SYMOUT		;WRITE VALUE, TOO.
]
IFN NEWBIN,[
	CALL	RADOUT
	HLRZ	B,@VALPNT
	CALL	WRDOUT
	HRRZ	B,@VALPNT
	CALL	WRDOUT
]
	AOBJN	S,DUMP3
IFN NEWBIN,[
	MOVEI	B,0
	CALL	WRDOUT
	CALL	WRDOUT
	CALL	WRDOUT
	CALL	WRDOUT
]
	RET

IFN NEWBIN,[
WRDOUT:	PUSH	P,B
	CALL	BINOUT
	POP	P,B
	LSH	B,-8
	CALL	BINOUT
	RET

RADOUT:	MOVEI	A,0
	LSHC	A,6
	MOVE	C,RADTAB(A)
REPEAT 2,[
	IMULI	C,50
	MOVEI	A,0
	LSHC	A,6
	ADD	C,RADTAB(A)
]
	PUSH	P,B
	MOVE	B,C
	CALL	BINOUT
	MOVE	B,C
	LSH	B,-8
	CALL	BINOUT
	POP	P,B

	MOVEI	A,0
	LSHC	A,6
	MOVE	C,RADTAB(A)
REPEAT 2,[
	IMULI	C,50
	MOVEI	A,0
	LSHC	A,6
	ADD	C,RADTAB(A)
]
	MOVE	B,C
	CALL	BINOUT
	MOVE	B,C
	LSH	B,-8
	CALL	BINOUT
	RET

RADTAB:	0			;  
	0			; !
	0			; "
	0			; #
	33			; $
	35			; %
	0			; &
	0			; '
	0			; (
	0			; )
	0			; *
	0			; +
	0			; ,
	0			; -
	34			; .
	0			; /
	36			; 0
	37			; 1
	40			; 2
	41			; 3
	42			; 4
	43			; 5
	44			; 6
	45			; 7
	46			; 8
	47			; 9
	0			; :
	0			; ;
	0			; <
	0			; =
	0			; >
	0			; ?
	0			; @
	1.			; A
	2.			; B
	3.			; C
	4.			; D
	5.			; E
	6.			; F
	7.			; G
	8.			; H
	9.			; I
	10.			; J
	11.			; K
	12.			; L
	13.			; M
	14.			; N
	15.			; O
	16.			; P
	17.			; Q
	18.			; R
	19.			; S
	20.			; T
	21.			; U
	22.			; V
	23.			; W
	24.			; X
	25.			; Y
	26.			; Z
	0			; [
	0			; \
	0			; ]
	0			; ^
	0			; _
]

;OUTPUT OCTAL IF NEC, INCREM L .
DUMP:	HLRO	B,R6		;-NUM BYTES.
	TLNE	F,BINBIT
	TLNE	AF,P1F
	JRST	DUMP9		;IF NOT MAKING BIN, JUST INCR. L.
	MOVE	A,BYTCNT
	CAIGE	A,DATLEN(B)	;IF NOT ENOUGH ROOM
	CAME	L,CURADR	;OR PROFRAM BREAK,
	CALL	BLKDMP		;START NEW BLOCK.
	SUB	L,B		;INCREM L .
	MOVEM	L,CURADR
DUMP8:	LDB	B,DUMPT(R6)	;GET, OUTPUT BYTE.
	AOS	A,BYTCNT	;COUNT BYTES IN BLOCK.
	MOVEM	B,DATBLK-1(A)
	AOBJN	R6,DUMP8
	RET

DUMP9:	SUBI	L,(B)
	RET

DUMPT:	POINT	8,W,35	
	POINT	8,W,27	
	POINT	8,CEXT1,35	
	POINT	8,CEXT1,27	
	POINT	8,CEXT2,35
	POINT	8,CEXT2,27
;OUTPUT THE BLOCK WHICH HAS GROWN IN DATBLK.
BLKDMP:	SKIPN	BYTCNT		;IF NO BLOCK, JUST RE-INIT.
	JRST	BLKINI
BLKD0:	SAVE	A,B,C
	MOVEI	A,1
	MOVEM	A,DATBBL	;SET UP 1ST WD.
	MOVEI	A,6
	ADDM	A,BYTCNT	;GET TOTAL BLOCK LENGTH.
	MOVSI	A,-4		;GET LENGTH, ADDR AS BYTES:
BLKD1:	LDB	B,BLKDMT(A)
	MOVEM	B,DATBBL+2(A)
	AOBJN	A,BLKD1
	MOVNS	BYTCNT
	HRLZ	A,BYTCNT	;-<LENGTH>,,0
	SETZ	B,		;GET -<SUM OF WDS>
BLKD2:	SUB	B,DATBBL(A)
	AOBJN	A,BLKD2
	DPB	B,[001000+A,,DATBBL]	;STORE AS CHECKSUM.
	SOS	C,BYTCNT	;-<# WORDS INCL CHECKSUM>
	MOVE	B,[444400,,DATBBL]
IFN ITS,[
	TLNN	F,PSWBIT	;IF P SWITCH,
	 JRST	BLKD5
]

IFN ITS\SAIL,[		;OUTPUT WD AT A TIME
			;FOR SAIL, AND ITS PAPER TAPE.
	MOVE	A,B
BLKD3:	ILDB	B,A
	UNIOB	BIN
	AOJL	C,BLKD3
	JRST	BLKD4
]
BLKD5:			;OUTPUT WHOLE BLOCK AT ONCE
IFN ITS&NEWBIN,[
    	pushj p,outblk
]
.ELSE [
IFN ITS\TENEX,[		;FOR TENEX, AND ITS NON-PAPER-TAPE.
	OUTBFR	BIN
]
]
BLKD4:	REST	C,B,A

BLKINI:				;CODE BLOCK INITIALIZATION
	MOVEM	L,LODADR	;SET STARTING ADDRESS
	MOVEM	L,CURADR	;SAVE CURRENT ADDRESS
	SETZM	BYTCNT		;CLEAR BYTE COUNT
	SETZM	CHKSUM		;  AND CHECK-SUM
	RET


BLKDMT:				;BLOCK DUMP TABLE
	POINT	8,BYTCNT,35
	POINT	8,BYTCNT,27
	POINT	8,LODADR,35
IFE EXTEND,[
	POINT	8,LODADR,27
]
IFN EXTEND,[
	POINT	10,LODADR,27
]
]
ifn its&newbin,[
outblk: ;; BYTE POINTER TO DATBLK IN B, -<BYTE COUNT> IN C, smashes A
	hrlz   c,c      ; make into aobjn pointer
	hrr    c,b
blkd9:	move   a,(c)		; get a byte
	idpb   a,outbp
	aobjn  c,blkd9
	move   a,@outbp	; save last word in case its not complete
	move   c,outbp	; calculate number of words to output
	tlnn   c,400000	; unless we ended exaclty ona word boundary
	 sos   outbp
	hrrz   c,outbp
	subi   c,outbuf-1
	move   b,[444400,,outbuf]
	syscal siot,[movei bin ? b ? c ]
	movei  b,outbuf	; reset byte pointer to beginning of buffer
	hrrm   b,outbp	; leaving any byte offset intact
	movem  a,outbuf	; and put the last word at beginning of next buffer
	popj   p,
]
IFN RELCOD,[

; THESE ROUTINES ARE FOR THE OUTPUT OF RELOCATABLE CODE

;
;    ROUTINE TO OUTPUT CODE.
;

DUMP:	HLRO	B,R6		; - BYTES TO DUMP
	TLNE	F,BINBIT	; NOT MAKING BINARY FILE --
	TLNE	AF,P1F		; -- OR PASS ONE?
	JRST	DUMPNC		; YES - DON'T DUMP ANY CODE
	HRRZ	A,BYTCNT	; GET NUMBER OF BYTES IN BUFFER
	CAIG	A,DATLEN(B)	; NO ROOM FOR THE NEW ONES --
	TLZE	AF,LCHFLG	; -- OR PROGRAM BREAK?
	CALL	CODUMP		; YES - DUMP CURRENT BLOCK
	SUB	L,B		; UPDATE THE LOCATION COUNTER
	TRNE	B,1		; DUMPING FULL WORDS?
	JRST	DMPBYT		; NO - JUST DUMPING SINGLE BYTE
DUMPWD:	AOS	A,BYTCNT	; YES - COUNT ONE BYTE
	HRRZ	B,@WORDT(R6)	; GET THE BYTE (ACTUALLY A WORD)
	HRL	B,CODET(R6)	; GET ITS BYTE CODE
	MOVEM	B,BLKDAT-1(A)	; PUT INTO BLOCK
	MOVE	B,@RELTAB(R6)	; GET RELOCATION
	JUMPGE	B,DUMPW2	; STORE IF NO FIXUP
	MOVSI	B,200000	; FIXUP - TELL SAVBIN TO --
	IORM	B,BLKDAT-1(A)	; -- SUBTRACT LOCATION OF THIS WORD
DUMPW2:	IDPB	B,RELPNT	; SET RELOCATION
	AOBJN	R6,DUMPWD	; DO ALL THE WORDS
	RET			; RETURN

;
;    HERE TO DUMP A SINGLE BYTE (NOT RELOCATABLE)
;

DMPBYT:	AOS	A,BYTCNT	; COUNT THIS BYTE
	SETZ	B,		; DEPOSIT A ZERO --
	IDPB	B,RELPNT	; -- RELOCATION BYTE
	MOVEI	B,0(W)		; GET THE BYTE
	HRLI	B,1		; THE BYTE CODE FOR ONE BYTE
	MOVEM	B,BLKDAT-1(A)	; PUT IT INTO THE BLOCK
	RET			; RETURN

;
;    HERE IF NOT MAKING BINARY, JUST UPDATE LOCATION COUNTER.
;

DUMPNC:	SUB	L,B		; UPDATE THE LOCATION COUNTER
	RET			; RETURN


;
;    TABLE INDEXED BY BYTE NUMBER GIVING ADDRESS OF NEXT BYTE
;

WORDT:	W			; FIRST BYTE COMES FROM W
	NULWRD			; NEXT ONE IS NULL (TWO IN W)
	CEXT1			; THIRD FROM CEXT1 (TWO BYTES)
	NULWRD			; NEXT IS NULL
	CEXT2			; THEN TWO BYTES FROM CEXT2
	NULWRD			; THEN A NULL BYTE

;
;    TABLE INDEXED BY BYTE NUMBER YEILDING BYTE CODES
;

CODET:	2			; FIRST WORD HAS TWO BYTES
	-1			; NEXT WORD HAS NO BYTES
	2			; THEN TWO BYTES AGAIN
	-1			; THEN NO BYTES ONCE MORE
	2			; TWO BYTES FROM CEXT2
	-1			; THEN NONE

NULWRD:	0			; A NULL BYTE

;
;    TABLE INDEXED BY BYTE NUMBER GIVING ADDRESS OF RELOCATION
;

RELTAB:	REXTAB			; FIRST FROM REXTAB
	NULWRD			; SECOND ABSOLUTE
	REXT1			; 3RD FROM TABLE
	NULWRD
	REXT2			; 4TH FROM TABLE
	NULWRD


;    HERE TO DUMP BLOCK TYPE 1 (CODE). FIRST DATA
;  WORD IS THE LOAD ADDRESS (WHICH IS RELOCATABLE), THE
;  REST ARE CODE. ENTER AT CODINI TO INITILIZE FIRST.
;

CODUMP:	MOVEI	A,1		; PUT THE BLOCK --
	HRLM	A,BLKHED	; -- TYPE INTO HEADER
	MOVE	A,LOADRS	; PUT THE LOAD ADDRESS INTO --
	MOVEM	A,BLKDAT	; -- THE FIRST DATA WORD
	CALL	BLKDMP		; DUMP THE BLOCK

CODINI:	AOS	BYTCNT		; COUNT A BYTE FOR THE LOAD ADDRESS
	TLNN	AF,LCRFLG	; LOCATION COUNTER RELOCATABLE?
	TDZA	A,A		; NO ZERO RELOCATION
	MOVEI	A,1		; YES - RELOCATION IS ONE
	IDPB	A,RELPNT	; OUTPUT RELOCATION BYTE
	HRRZM	L,LOADRS	; SET LOAD ADDRESS
	RET			; RETURN

;
;    HERE TO DUMP THE ENTRY POINT BLOCK.
;

ENTOUT:	TLNN	F,BINBIT	; MAKING BINARY?
	RET			; NO - THEN DON'T BOTHER WITH THIS
	MOVN	S,SYMLEN	; GET - SIZE OF SYMBOL TABLE
	HRLZ	S,S		; CONVERT TO AOBJN POINTER
ENTOU2:	MOVE	N,@SYMPNT	; GET A SYMBOL
	JUMPE	N,ENTOU3	; SKIP IF NULL
	MOVE	B,@VALPNT	; YES - GET ITS VALUE
	TLNE	B,ENTSYM	; IS IT AN ENTRY POINT?
	CALL	ENTO		; YES - PUT INTO BLOCK
ENTOU3:	AOBJN	S,ENTOU2	; PROCESS ALL SYMBOLS
ENTDUN:	JRST	ENTDMP		; DUMP LAST BLOCK AND EXIT

;
;    ROUTINE TO PUT ONE SYMBOL INTO ENTRY BLOCK.
;

ENTO:	HRRZ	A,BYTCNT	; GET NUMBER ALREADY THERE
	CAIL	A,DATLEN	; ROOM FOR THIS ONE?
	CALL	ENTDMP		; NO - DUMP CURRENT BLOCK
	CALL	GRD50		; GET RADIX 50 FOR SYMBOL
	AOS	A,BYTCNT	; COUNT THIS ONE
	MOVEM	B,BLKDAT-1(A)	; PUT INTO BLOCK
	RET			; RETURN

;
;    ROUTINE TO DUMP THE ENTRY BLOCK (TYPE 4)
;

ENTDMP:	MOVEI	A,4		; SET THE BLOCK --
	HRLM	A,BLKHED	; -- TYPE IN HEADER
	JRST	BLKDMP		; DUMP BLOCK AND RETURN

;    HERE TO DUMP THE NAME BLOCK
;

NAMOUT:	TLNN	F,BINBIT	; MAKING BINARY?
	RET			; NO - THEN FORGET ABOUT THIS
	SETZ	N,		; CLEAR SYMBOL DESTINATION
	MOVSI	C,-6		; AOBJN POINTER FOR 6 CHARACTERS
	MOVE	A,[440700,,TITBUF]; POINTER TO TITLE
NAMGCH:	ILDB	I,A		; GET A CHARACTER FROM THE TITLE
	LDB	B,ANPNTR	; GET ITS TYPE
	XCT	NAMET(B)	; IS IT PART OF THE NAME?
	JRST	NAMDMP		; NO - MUST BE THE END OF IT THEN
	CAIN	B,.LOW		; YES - IS IT LOWER CASE?
	SUBI	I,40		; YES - MAKE IT UPPER
	LSH	N,6		; INSERT NEW CHARACTER --
	ADDI	N,-40(I)	; -- INTO SIXBIT SYMBOL
	AOBJN	C,NAMGCH	; DO THE WHOLE NAME

;
;    HERE WHEN NAME FOUND - DUMP A TYPE 6 (NAME) BLOCK
;

NAMDMP:	CALL	GRD501		; GET RADIX 50 (ALREADY RIGHT JUST.)
	MOVEM	B,BLKDAT	; PUT IT INTO BLOCK
	MOVEI	A,6		; PUT TYPE INTO --
	HRLM	A,BLKHED	; -- BLOCK HEAD
	AOS	BYTCNT		; COUNT THE WORD
	JRST	BLKDMP		; DUMP BLOCK AND RETURN


;
;    DECISION TABLE FOR SCANNING NAME
;

NAMET:	JFCL			; NULL -- IGNORE
	JFCL			; SPACE, TAB -- END OF NAME
	CAIA			; LETTER -- PART OF NAME
	CAIA			; NUMBER -- DITTO
	CAIA			; DOT -- DITTO AGAIN
	JFCL			; TERMINATOR -- END OF NAME
	CAIA			; LOWER CASE -- INCLUDE IN NAME

;    ROUTINE TO DUMP THE START BLOCK, SYMBOL
;  BLOCKS, AND THE END BLOCK.
;

DUMP2:	CALL	CODUMP		; DUMP LAST BLOCK OF CODE
	CALL	BLKINI		; RE-INIT BLOCK
	SKIPGE	STRTLC		; HAVE A STARTING ADDRESS?
	JRST	DUMP22		; NO - THEN NO START BLOCK
	MOVEI	A,7		; PUT TYPE OF --
	HRLM	A,BLKHED	; -- START BLOCK INTO HEADER
	HRRZ	A,STRTLC	; PUT STARTING ADDRESS --
	MOVEM	A,BLKDAT	; -- INTO BLOCK
	HLRZ	A,STRTLC	;  GET RELOCATION OF START ADDRESS
	IDPB	A,RELPNT	; SET RELOCATION OF STARTING ADDRESS
	AOS	BYTCNT		; ONE DATA WORD
	CALL	BLKDMP		; DUMP THE BLOCK

;
;    NOW DUMP THE SYMBOLS
;

DUMP22:	MOVN	S,SYMLEN	; GET NUMBER ODAF SYMBOLS
	HRLZ	S,S		; CONVERT TO AOBJN POINTER
DUMPSM:	MOVE	N,@SYMPNT	; GET A SYMBOL
	JUMPE	N,DMPSM3	; ZERO ->SKIP IT
	CALL	GRD50		; GET RADIX 50 VALUE OF SYMBOL
	MOVE	C,@VALPNT	; GET VALUE OF SYMBOL
	TLNE	C,UNDSYM+EXTSYM	; UNDEFINED OR EXTERNAL?
	JRST	DMPSME		; YES - THEY  ARE SPECIAL
	TLO	B,100000	; NO - ASSUME INTERNAL
	TLNE	C,ENTSYM	; IS IT AN ENTRY POINT?
	TLC	B,140000	; YES - SAY THAT INSTEAD
	TLNE	C,HKLSYM	; HALF KILLED?
	TLO	B,400000	; YES - SET SUPRESS BIT
DMPSM2:	MOVE	A,BYTCNT	; GET NUMBER OF WORDS IN BUFFER
	TLNE	C,INDSYM	; A SYMBOL FIXUP --
	CAIG	A,DATLEN-4	; -- AND ROOM FOR IT OR --
	CAIL	A,DATLEN	; ROOM FOR ANOTHER SYMBOL?
	CALL	DMPSYM		; NO - DUMP CURRENT BLOCK
	AOS	A,BYTCNT	; COUNT A WORD FOR THE SYMBOL
	MOVEM	B,BLKDAT-1(A)	; PUT SYMBOL IN BLOCK
	IBP	RELPNT		; A ZERO RELOCATION BYTE
	TLNE	C,INDSYM	; VALUE DEPENDENT ON EXTERNAL?
	JRST	DMPSIN		; YES - OUTPUT THAT DEPENDENCE
	AOS	A,BYTCNT	; COUNT ONE FOR THE VALUE
	HRRZM	C,BLKDAT-1(A)	; PUT VALUE INTO BLOCK
	TLNN	C,RELSYM	; GET THE --
	TDZA	C,C		; -- RELOCATION OF --
	MOVEI	C,1		; -- THE SYMBOL
	IDPB	C,RELPNT	; PUT IT IN THE RELOCATION WORD
DMPSM3:	AOBJN	S,DUMPSM	; PROCESS ALL SYMBOLS
	CALL	DMPSYM		; DUMP THE LAST SYMBOL BLOCK

;
;    NOW DUMP THE END BLOCK
;

	AOS	A,BYTCNT	; COUNT A WORD FOR PROGRAM BREAK
	MOVEI	B,1		; RELOCATION OF PROGRAM --
	IDPB	B,RELPNT	; -- BREAK IS ONE
	MOVE	B,RELLC		; GET PROGRAM BREAK
	HRRZM	B,BLKDAT-1(A)	; OUTPUT IT
	AOS	A,BYTCNT	; COUNT A WORD FOR ABSOLUTE BREAK
	MOVE	B,ABSLC		; GET ABSOLUTE BREAK
	HRRZM	B,BLKDAT-1(A)	; PUT IT INTO THE BLOCK
	MOVEI	A,5		; SET THE BLOCK --
	HRLM	A,BLKHED	; -- TYPE FOR END BLOCK
	JRST	BLKDMP		; DUMP BLOCK AND RETURN

;
;    HERE IF SYMBOL IS GLOBAL REFERENCE
;

DMPSME:	TLO	B,600000	; SAY SO
	JRST	DMPSM2		; AND PROCESS HIM
;
;    HERE IF VALUE OF SYMBOL DEPENDS ON AN EXTERNAL.
;

DMPSIN:	PUSH	P,B		; SAVE THE RADIX50 FOR LATER
	MOVE	B,INDOFF(C)	; GET THE OFFSET FROM EXTERNAL VALUE
	AOS	A,BYTCNT	; COUNT A BYTE
	MOVEM	B,BLKDAT-1(A)	; OUTPUT OFFSET AS VALUE
	TLNN	C,RELSYM	; OFFSET RELOCATABLE?
	TDZA	B,B		; NO - RELOCATION IS ZERO
	MOVEI	B,1		; YES - RELOCATION IS ONE
	IDPB	B,RELPNT	; SET RELOCATION
	MOVE	N,INDREF(C)	; GET EXTERNAL SYMBOL DEPENDENT ON
	CALL	GRD50		; GET ITS RADIX 50 REP.
	TLO	B,600000	; SAY EXTERNAL REF.
	AOS	A,BYTCNT	; COUTN BYTE .....
	IBP	RELPNT		; .....
	MOVEM	B,BLKDAT-1(A)	; .....
	POP	P,B		; GET RADIX 50 OF FIRST AGAIN
	TLO	B,500000	; SAY IS DEPENDENT
	AOS	A,BYTCNT	; COUNT BYTE .....
	IBP	RELPNT		; .....
	MOVEM	B,BLKDAT-1(A)	; .....
	JRST	DMPSM3		; GET NEXT SYMBOL


;
;    ROUTINE TO DUMP A TYPE 2 (SYMBOLS) BLOCK
;

DMPSYM:	MOVEI	A,2		; SET CORRECT --
	HRLM	A,BLKHED	; -- BLOCK TYPE
	JRST	BLKDMP		; DUMP BLOCK AND RETURN

;    ROUTINE TO CONVERT THE SIXBIT SYMBOL IN N
;  TO RADIX 50 (PDP-10 STYLE) IN B. ENTER AT GRD50
;  IF SYMBOL IS LEFT JUSTIFIED, AT GRD501 IF SYMBOL IS
;  RIGHT JUSTIFIED.
;

GRD50:	TRNE	N,77		; IS SYMBOL RIGHT JUSTIFIED?
	JRST	GRD501		; YES - THEN CONVERT IT
	LSH	N,-6		; NO - MOVE ONE CHARACTER TO THE RIGHT
	JRST	GRD50		; AND CHECK IT AGAIN
GRD501:	MOVE	A,[440600,,N]	; A BYTE POINTER INTO THE SYMBOL
	TDZA	B,B		; INITIAL RESULT IS ZIP
GRDLUP:	IMULI	B,50		; MULTIPLY PARTIAL RESULT BY 50
	ILDB	C,A		; GET A CHARACTER FROM SYMBOL
	CALL	SIXRAD		; GET ITS RADIX 50 CODE
	ADDI	B,0(C)		; INCLUDE IN RESULT
	CAME	A,[000600,,N]; IS WE AT END OF SYMBOL?
	JRST	GRDLUP		; NO - KEEP ON TRUCKIN
	RET			; YES - RETURN

;
;    ROUTINE TO CONVERT SIXBIT CHARACTER IN C TO
;  ITS RADIX 50 (PDP-10 TYPE) CODE IN C.
;

SIXRAD:	JUMPE	C,CPOPJ		; RETURN ZERO FOR NULLS
	CAIN	C,'.		; IS IT A DOT?
	JRST	RADOT		; YES RETURN  ITS CODE
	CAIN	C,'$		; NO - IS IT A DOLLAR SIGN?
	JRST	RADOLR		; YES - RETURN THAT CODE
	CAIN	C,'%		; NO - IS IT A PERCENT SIGN?
	JRST	RADPER		; YES - RETURN HIS CODE
	CAIL	C,'0		; NO - MAYBE IS A --
	CAILE	C,'9		; -- DIGIT TYPE GUY?
	JRST	RAD01		; NO - MAYBE IS LETTER
	MOVEI	C,-20+1(C)	; YES - RETURN PROPER CODE
	RET			; RETURN
RAD01:	CAIL	C,'A		; ARE IT --
	CAILE	C,'Z		; -- A LETTER?
	BUG			; NO - SOMETHING IS VERY, VERY WRONG.
	MOVEI	C,-41+13(C)	; YES - RETURN LETTER CODE
	RET			; RETURN

RADOT:	MOVEI	C,45		; CODE FOR "."
	RET
RADOLR:	MOVEI	C,46		; CODE FOR "$"
	RET
RADPER:	MOVEI	C,57		; CODE FOR "%"
	RET

;    HERE TO DUMP A RELOCATABLE BLOCK. WORD COUNT
;  MUST BE IN BYTCNT, BLOCK TYPE MUST BE IN L.H.
;  BLKHED.
;

BLKDMP:	SKIPN	BYTCNT		; ANY STUFF TO DUMP?
	JRST	BLKINI		; NO - JUST RE-INIT BLOCK
	SAVE	A,B,C		; YES - SAVE SOUT ACS
	MOVE	C,BYTCNT	; GET WORD COUNT
	HRRM	C,BLKHED	; PUT IN HEADER
	MOVNI	C,2(C)		; TOTAL BLOCK SIZE FOR SOUT
	MOVE	B,[444400,,BLKHED]; POINTER TO BLOCK
IFN SAIL,[
	MOVE	A,B
BLKD3:	ILDB	B,A
	UNIOB	BIN
	AOJL	C,BLKD3
]
.ELSE	OUTBFR	BIN
	REST	C,B,A		; RESTORE THE ACS WE CLOBBERED

BLKINI:	SETZM	BYTCNT		; RESET BYTE COUNTER
	SETZM	BLKREL		; CLEAR RELOCATION WORD
	SETZM	BLKHED		; CLEAR HEADER
	MOVE	A,[440200,,BLKREL]
	MOVEM	A,RELPNT	; NEW POINTER FOR RELOACTION
	RET			; RETURN


]
IFN ITS,[
TSINT:	0 ? 0
	SKIPL	TSINT		;ONLY ENABLED 1ST WD INT IS PDL OV.
	 JRST	TSINTP
	SAVE	A		;2ND WD INT, CHECK FOR ^S.
	MOVEI	A,TTI
	.ITYIC	A,		;A _ INT. CHARACTER.
	 JRST	TSINT1		;NONE, DO NOTHING.
	CAIE	A,^S
	 JRST	TSINT1
	SETCMM	CTLSF		;COMPLEMENT TYPEOUT SWITCH.
	SKIPE	CTLSF		;IF JUST TURNED TYPEOUT OFF,, FLUSH ALL.
	 .RESET	TTO,
TSINT1:	REST	A
	.DISMI	TSINT+1

TSINTP:	SKIPN	LINEPP
	 BUG
	MOVE	P,LINEPP	;PDL OV INSIDE "LINE": RESTART AT "LINE" AND RESTORE P.
	ERROR1	PDL Overflow
	.DISMI	[LINE]
]

IFN TENEX,[
PSICO:	MOVEM A,PSIACA		;^O INTERRUPT. SAVE AC A
	MOVE A,TTOJFN
	CFOBF			;CLEAR OUTPUT BUFFER
	SETCMM CTLSF		;COMPLEMENTS FLAG
	MOVE A,PSIACA
	DEBRK
]
GETCOR:				;GET CORE
	PUSH	P,N		;GET A COULPLE OF WORKING REGISTERS
	PUSH	P,A
IFN ITS,[
	LDB	A,[121000,,JOBREL]
	SYSCAL	CORBLK,[1000,,400000 ? 1000,,-1
		   1000,,(A) ? 1000,,400001]
]
	MOVEI	A,CORINC	;UPDATE POINTERS
	ADDB	A,JOBREL
IFN SAIL,[
	CORE A,
	JRST 4,.
]
POPANJ:	POP	P,A		;RESTORE REGISTERS
POPNJ:	POP	P,N
	RET

UUOH:	0
	SAVE	UUOH
	SAVE	A,B,C
	LDB	B,[331100,,40]
	CAIG	B,UUOMAX
	JUMPN	B,@UUODIS-1(B)
ILLUUO:	BUG
UUOXIT:	REST	C,B,A,UUOH
	JRST	2,@UUOH

UUODIS:	UERROR
	UERR1

UUOMAX==2
CRFOUT:				;OUTPUT WORD TO CREF
	CALL	CRFOU0		;OUT TYPE CHAR, SYMBOL.
	MOVEI	B,CRFSYM	;INDIC. NON-DEFINITION OCCURRENCE.
	JRST	LSTDMP

;CREF FOR DEFINING OCCURRENCE.
CRFODF:	CALL	CRFOU0		;OUTPUT TYPE, SYMBOL.
	MOVEI	B,CRFOPC	;INDIC. DEFINING OCCURRENCE.
	JRST	LSTDMP

CRFOU0:	SKIPN	NOCREF		;IS %XCREF 0?
	TLNE	A,NCRSYM
	 JRST	POPBJ
	TLNN	N,770000
	 JRST	POPBJ		;DON'T CREF LOCAL-TAGS
	SAVE	C		; SAVE VITAL AC'S
	LDB	B,TYPPNT
	XCT	CRFTBL(B)	;GET PROPER FLAG CHR IN B
	CALL	LSTDMP		;LIST CREF TYPE
	MOVSI	C,440600
CRFOU1:	ILDB	B,C		;GET A SIXBIT CHARACTER
	JUMPE	B,CRFOU2	;BRANCH IF END
	ADDI	B,40		;CONVERT TO SIXBIT
	CALL	LSTDMP		;LIST IT
	TLNE	C,770000	;END OF WORD?
	JRST	CRFOU1		;  NO, GET ANOTHER
CRFOU2:	REST	C
	RET

POPBJ:	REST	B
	RET

CRFTBL:	PHASE	0
	MOVEI	B,CRFSYM
NPOP::	MOVEI	B,CRFOPC
PSOP::	MOVEI	B,CRFOPC
CNOP::	MOVEI	B,CRFOPC
BGOP::	MOVEI	B,CRFOPC	;BASIC GROUP
OPOP::	MOVEI	B,CRFOPC	;OPERATE GROUP
SCOP::	MOVEI	B,CRFOPC
UNOP::	MOVEI	B,CRFOPC	;UNARY OP
BCOP::	MOVEI	B,CRFOPC	;BRANCH ON CONDITION OP
TROP::	MOVEI	B,CRFOPC	;TRAP OP
RTOP::	MOVEI	B,CRFOPC
FLOP::	MOVEI	B,CRFOPC
MLOP::	MOVEI	B,CRFOPC
FSOP::	MOVEI	B,CRFOPC
SPOP::	MOVEI	B,CRFOPC	;SPECIAL OPS (MARK, SOB)
MAOP::	MOVEI	B,CRFMAC
INOP::	MOVEI	B,CRFSYM	;PSEUDO-SYMS.
INVOP::	MOVEI	B,CRFOPC	;INV PSEUDO
	DEPHASE
INSRT:				;INSERT ITEM IN SYMBOL TABLE
	CAMN	N,NODEFN	;BREAK ON DEFINING TEST SYMBOL.
	BUG
	MOVEM	N,@SYMPNT	;STORE SYMBOL
	MOVEM	A,@VALPNT	;STORE VALUE
	RET

;SEARCH SYMBOL TABLE.
SRCH:	MOVM	R6,N
	IDIV	R6,SYMLEN
	HRLI	S,(S)		;MAKE AOBJN PTR STARTING AT HCODE.
	ADD	S,SYMAOB
SRCH1:	SKIPN	R6,@SYMPNT	;0 => NOT FOUND.
	 JRST	SRCH3
	CAMN	N,R6
	 JRST	SRCH2		;IF FOUND.
SRCHCT:	AOBJN	S,SRCH1		;SEARCH TILL TABLE'S END.
	AOBJN	S,SRCH1		;(IN CASE WANT TO CLOBBER PREV. INSN).
	MOVE	S,SYMAOB	;NOW SEARCH FROM FRONT.
SRCH4:	SKIPN	R6,@SYMPNT
	 JRST	SRCH3
	CAMN	R6,N
	 JRST	SRCH2
	AOBJN	S,SRCH4
	JRST	ERRTMS		;SYM. TAB. FULL.

SRCH2:	MOVE	A,@VALPNT	;IF FOUND.
	AOS	(P)
	RET

SRCH3:	MOVSI	A,UNDSYM	;NOT FOUND, SAY UNDEF.
	RET
;COMPRESS SYMBOL TABLE, ELIMINATING UNUSED ENTRIES,
;PREDEFINED SYMS AND MACROS, THEN RESET SYMLEN.
COMPRS:	MOVN	S,SYMLEN
	HRLZI	S,(S)		;AOBJN PTR -> SYM. TAB.
	HRRZ	L,SYMTBA	;RE-INSERT THRU L & V.
	HRRZ	V,VALPNT
COMPR0:	SKIPN	A,@SYMPNT	;IF NAME IS 0, SKIP IT.
	JRST	COMPR1
	MOVE	B,@VALPNT
	 TLNE	B,SUPSYM+37	;IF MACRO, OP OR PREDEF, SKIP SYMBOL.
	JRST	COMPR1
	TLNN	A,770000	;DON'T INCLUDE LOCAL TAGS
	 JRST	COMPR1
	MOVEM	A,(L)		;ELSE PUT BACK LOWER IN SYM. TAB.
	MOVEM	B,(V)
	AOJ	L,		;INCREM. RE-INSERTION PTR.
	AOJ	V,
COMPR1:	AOBJN	S,COMPR0
	SUB	L,SYMTBA	;NUM. SYMS RE-INSERTED.
	MOVEM	L,SYMLEN
	MOVNM	L,SYMAOB
	HRLZS	SYMAOB
	RET

;SORT SYMTAB INTO ALPHABETICAL ORDER.
SORT:	SKIPN	B,SYMLEN
	RET
SORT1:	AOS	B		;SORT OVER SMALLER INTERVALS.
	LSH	B,-1
SORT0:	MOVN	S,SYMLEN
	ADD	S,B
	MOVSI	S,(S)
	MOVE	L,SYMTBA
	ADDI	L,(B)
	HRRZ	V,VALPNT
	SUB	V,SYMTBA
	HRLI	V,L
SORT3:	MOVE	A,@SYMPNT
	CAMG	A,(L)		;IF EARLIER IS LARGER,
	AOJA	L,SORT2
	EXCH	A,(L)		;SWITCH THE STE'S.
	MOVEM	A,@SYMPNT
	MOVE	A,@V
	EXCH	A,@VALPNT
	MOVEM	A,@V
	TLO	L,400000	;SAY DID SOMETHING THIS PASS.
	AOJ	L,
SORT2:	AOBJN	S,SORT3
	TLZE	L,400000	;IF DID SOMETHING, TRY AGAIN.
	JRST	SORT0
	CAIE	B,1
	JRST	SORT1		;ELSE TRY SHORTER SPACING.
	RET
SYMTB:	CALL	SORT			;LIST THE SYMBOL TABLE
	MOVE	S,[[ASCIZ /***Symbol Table***      /],,STITBF]
	BLT	S,STITBF+5
	MOVE	S,[STITBF+6,,STITBF+7]
	SETZM	STITBF+6
	BLT	S,STITBF+20
	SETZ	S,		;INITIALIZE POINTER

SYMTB1:	SETOM	PAGEXT		;MOVE TO NEXT INTEGER PAGE.
	TRO	F,HDRBIT	;FLAG NEW PAGE
	MOVE	C,PAGSIZ	;SET LINE COUNT
	SUBI	C,8

SYMTB2:	SKIPE	@SYMPNT
	CAML	S,SYMLEN	;END REACHED?
	RET			;  YES, EXIT
	MOVE	R6,S		;SAVE CURRENT POINTER
	MOVEI	V,SPL		;SET "SYMBOLS PER LINE"
	TLNE	F,TTYBIT	;TTY?
	MOVEI	V,SPLTTY	;  YES, REDUCE

SYMTB3:	SKIPE	@SYMPNT
	CAML	S,SYMLEN
	JRST	SYMTB4
	CALL	LSTSTE		;LIST SYMBOL TABLE ENTRY
	ADD	S,PAGSIZ
	SUBI	S,8
	SOJG	V,SYMTB3	;TEST FOR MORE ITEMS ON LINE
	SUB	S,PAGSIZ
	ADDI	S,9

SYMTB4:	CALL	LSTCR		;END OF LINE, LIST CR/LF
	SOJLE	C,SYMTB1	;BRANCH IF END OF PAGE
	MOVEI	S,1(R6)
	JRST	SYMTB2		;OK, PROCESS ANOTHER

LSTSTE:				;LIST SYMBOL TABLE ENTRY
	CALL	LSTTAB		;LEAD OFF WITH TAB
	MOVE	A,[440600,,@SYMPNT]	;SIXBIT PTR TO SYMBOL NAME.
LSTST1:	ILDB	B,A		;GET A CHARACTER
	JUMPE	B,LSTST2	;DON'T LIST TRAILING BLANKS
	ADDI	B,40		;CONVERT TO ASCII
	CALL	LSTOUT		;LIST CHARACTER
	TLNE	A,770000	;ANY MORE CHARACTERS?
	JRST	LSTST1		;  YES
LSTST2:	CALL	LSTTAB
IFN RELCOD,[
	MOVE	T1,@VALPNT	; GET VALUE
	TLNE	T1,INDSYM	; DEPENDENT?
	SKIPA	A,[POINT 3,INDOFF(T1),17]; YES - POINT TO OFFSET
]
	MOVE	A,[POINT 3,@VALPNT,17]	;SET HEX POINTER
LSTST3:	ILDB	B,A		;GET OCTAL CHARACTER
	ADDI	B,"0		;CONVERT TO ASCII
	CALL	LSTOUT		;LIST IT
	TLNE	A,770000	;ANY MORE BYTES?
	JRST	LSTST3		;  YES
	MOVE	A,@VALPNT	;PICK UP VALUE POINTER
IFN RELCOD,[
	MOVEI	B,"'		; ASSUME RELOCATABLE
	TLNN	A,RELSYM	; GOOD GUESS?
	JRST	LSTST4		; NO - SEE IF IS EXTERNAL
	TLNE	A,INDSYM	; YES - INDIRECT TOO?
	MOVEI	B,"!		; YES - INDICATE BOTH
	CALL	LSTOUT		; OUTPUT INDICATION
	JRST	LSTST5		; FINNISH OFF
LSTST4:	MOVEI	B,"*		; ASSUME EXTERNAL
	TLNE	A,INDSYM+EXTSYM	; TRUE?
	CALL	LSTOUT		; YES - LIST THE STAR
LSTST5:	MOVEI	B,"E		; ASSUME IS ENTRY POINT
	TLNE	A,ENTSYM	; GOOD ASSUMPTION?
	CALL	LSTOUT		; YES - INDICATE WITH E
]
	MOVEI	B,"R
	TLNE	A,REGSYM	;REGISTER SYMBOL?
	CALL	LSTOUT		;YES, LIST IT
	MOVEI	B,"U
	TLNE	A,UNDSYM	;UNDEFINED?
	CALL	LSTOUT		;YES, LIST IT
	MOVEI	B,"H		;FOR HALF KILLED
	TLNE	A,HKLSYM
	CALL	LSTOUT
	JRST	LSTTAB		;OUTPUT A TAB AND EXIT
;PERMANENT SYMBOL TABLE

INITAB:
	SIXBIT /BLO/
	INISYM+BCOP,,103400

	SIXBIT /BHIS/
	INISYM+BCOP,,103000

IRP X,,[MOV,CMP,BIT,BIC,BIS]
	SIXBIT/X/
	INISYM+BGOP,,10000+.IRPCNT_12.
	SIXBIT/X!B/
	INISYM+BGOP,,110000+.IRPCNT_12.
TERMIN

IRP X,,[CLR,COM,INC,DEC,NEG,ADC,SBC,TST,ROR,ROL,ASR,ASL]
	SIXBIT/X/
	INISYM+UNOP,,5000+.IRPCNT_6
	SIXBIT/X!B/
	INISYM+UNOP,,105000+.IRPCNT_6
TERMIN

IRP X,,[BR,BNE,BEQ,BGE,BLT,BGT,BLE]
	SIXBIT/X/
	INISYM+BCOP,,.IRPCNT_10+400
TERMIN

IRP X,,[BPL,BMI,BHI,BLOS,BVC,BVS,BCC,BCS]
	SIXBIT/X/
	INISYM+BCOP,,.IRPCNT_10+100000
TERMIN

IRPS X,,HALT WAIT RTI BPT IOT RESET RTT
	SIXBIT /X/
	INISYM+OPOP,,.IRPCNT
TERMIN

IRPS X,,CLR TST ABS NEG
	SIXBIT/X!F/
	INISYM+UNOP,,170400+.IRPCN_6
	SIXBIT/X!D/
	INISYM+UNOP,,170400+.IRPCN_6
TERMIN

IRPS X,,MUL MOD ADD LD SUB CMP UNUSED DIV
IFSN X,UNUSED,[
	SIXBIT/X!F/
	INISYM+FLOP,,171000+.IRPCN_8
	SIXBIT/X!D/
	INISYM+FLOP,,171000+.IRPCN_8
]
TERMIN
DEFINE OPS B,A
IRPS X,,[A]
IFE .IRPCN&1,	SIXBIT /X/
IFN .IRPCN&1,	B,,X
TERMIN TERMIN

OPS INISYM+SPOP,[MARK 1,SOB 2]

OPS INISYM+OPOP,[CCC 257,CLC 241,CLN 250,CLV 242,CLZ 244
CNZ 254,NOP 240,SCC 277,SEC 261,SEN 270,SEV 262,SEZ 264
CFCC 170000,SETF 170001,SETD 170011,SETI 170002,SETL 170012]

OPS INISYM+SCOP,[JSR 4000,XOR 74000]

OPS INISYM+MLOP,[ASH 72000,ASHC 73000,MUL 70000,DIV 71000]

OPS INISYM+UNOP,[MTPI 6600,MTPD 106600,MFPI 6500,MFPD 106500
SXT 6700,SWAB 300,JMP 100
LDFPS 170100,STFPS 170200,STST 170300]

OPS INISYM+TROP,[EMT 104000,TRAP 104400]

OPS INISYM+RTOP,[RTS 200,SPL 230]

OPS INISYM+FLOP,[LDCDF 177400,LDCFD 177400,LDEXP 176400
LDCIF 177000,LDCID 177000,LDCLF 177000,LDCLD 177000]

OPS INISYM+FSOP,[STCFD 176000,STCDF 176000
STCFI 175400,STCFL 175400,STCDI 175400,STCDL 175400
STEXP 175000,STF 174000,STD 174000]

;LSI-11 FLOATING POINT INSTRUCTIONS
OPS INISYM+RTOP,[FADD 075000,FSUB 075010,FMUL 075020,FDIV 075030]

;LSI-11 PS-REFERENCING INSTRUCTIONS
OPS INISYM+UNOP,[MFPS 106700,MTPS 106400]

OPS INISYM+BGOP,[ADD 60000,SUB 160000]

OPS INOP,[%FNAM2 %FNAM2,%. L,%OFFSE LOCTR,%XCREF NOCREF
%XLIST TSLWRD,.RPCNT %RPCNT,.IRPCN %IRPCN,%NARG %NARG
%ABSAD %ABSAD,%COMPA %COMPA,%TTYFL %TTYFL,%SUCCE %SUCCE
%OPSYS %OPSYS
%YEAR %YEAR,%MONTH %MONTH,%DAY %DAY]

OPS NPOP,[.LENGT ALENGT,.ADRMD AADRMD,.ADRIX AADRIX]

.ENDCX:	OPS PSOP,.ENDC OPCERR

.ENDMX:	OPS PSOP,.ENDM OPCERR

.ENDRX:	OPS PSOP,.ENDR OPCERR

.MACRX:	OPS PSOP,.MACR AMACR

.MACRY:	OPS PSOP,.MACRO AMACRO

.REPTX:	OPS PSOP,.REPT REPEA0

.TTYMX:	OPS PSOP,.TTYMA ATTYMA

	OPS PSOP,[COMMEN ACOMNT,.RAD50 RAD50]
IRPS X,,[NLIST PAGE XCREF EJECT END LIST XLIST EVEN ODD BLKB BLKW
INSRT EOT OFFSE IRP IRPC MEXIT IF IIF LIF IFF IFT IFTF ALSO IALSO LALSO
ELSE IELSE LELSE NARG NTYPE NCHR MSG REM ERROR PRINT TITLE STITL SBTTL
WORD BYTE ASCII ASCIZ ENTRY EXTRN ABS FLT2 FLT4 EXPUN]
	SIXBIT /.!X/
	PSOP,,A!X
TERMIN

IRPS X,,[SEE AUXIL]
	SIXBIT /.!X/
	INVOP,,A!X
TERMIN

IRP X,,[1,2,B,NB,DF,NDF,G,GE,L,LE,Z,NZ]
	SIXBIT/.IF!X/
	CNOP,,$IF!X
TERMIN

REPEAT	10,[
	.RPCNT_30+SIXBIT/%0/
	REGSYM+SUPSYM,,.RPCNT
]			;DEFINE INITIAL REGISTER SYMBOLS.

OPS  SUPSYM+LBLSYM,[
%TKS 177560,%TKB 177562,%TKV 60
%TPS 177564,%TPB 177566,%TPV 64
%PKC 172544,%PKCSB 172542,%PKCSR 172540,%PKV 104
%PPS 177554,%PPB 177556,%PPV 74
%PRS 177550,%PRB 177552,%PRV 70
%RKDS 177400,%RKER 177402,%RKCS 177404,%RKWC 177406
%RKBA 177410,%RKDA 177412,%RKMR 177414,%RKDB 177416,%RKV 220
%LKS 177546,%LKV 100
%LPS 177514,%LPB 177516,%LPV 200
%NGCSR 164040,%NGREL 164042
%ERRV 4,%BPTV 14,%IOTV 20,%PWRV 24,%EMTV 30,%TRPV 34
%DIV 177300,%AC 177302,%MQ 177304,%MUL 177306
%SR 177310,%SC 177311,%NOR 177312,%LGS 177314,%LSH 177314,%ARS 177316,%ASH 177316
%PS 177776,%SWR 177570,%PIR 177772,%PIRV 240
%CSR 175000,%BAR 175002,%BCR 175004,%TBR 175006,%DMRV 310,%DMTV 314
%RCSR 174000,%RBUF 174002,%TSCR 174004,%TBUF 174006,%DCRV 300,%DCTV 304
%DRS 177520,%DROB 177522,%DRIB 177524,%DRV1 110,%DRV2 114
%DCS 177460,%DWC 177462,%DCA 177464,%DAR 177466
%DAE 177470,%DBR 177472,%DSA 177476,%DV 204
%WC 177462,%CMA 177464,%ADS 177476
%TCST 177340,%TCCM 177342,%TCWC 177344,%TCBA 177346,%TCDT 177350,%TCV 214
%CRS 177160,%CRB1 177162,%CRB2 177164,%CRV 230
%MTS 172520,%MTC 172522,%MTBRC 172524,%MTCMA 172526,%MTD 172530
%MTRD 172532,%MTV 224
%RCLA 177440,%RCDA 177442,%RCER 177444,%RCCS 177446,%RCWC 177450
%RCCA 177452,%RCMN 177454,%RCDB 177456,%RCV 210
%AFCS 172570,%AFBR 172572,%AFMR 172576,%AFV 134
%ADCS 176770,%ADDB 176772,%ADV 130
%DACS 176756,%DAC1 176760,%DAC2 175762,%DAC3 176704,%DAC4 176704
%DAV1 140,%DAV2 144
%UDCS 171776,%UDSR 171774,%UDV 234
]

	;STUFF FOR ANTS IMP INTERFACE, SOME TRAP VECTORS
IRP X,,[IIV,IOV
SPI,EPI,IS1,IS2,SPO,EPO,OS1,OS2]NUM,,[170,174
164000,164002,164004,164006,164010,164012,164014,164016]
	SIXBIT /%!X/
	SUPSYM+LBLSYM,,NUM
TERMIN
INILEN==.-INITAB
;CHARACTER DISPATCH ROUTINES

C1PNTR:	420200+I,,CHJTBL
C4PNTR:	360400+I,,CHJTBL
ANPNTR:	330300+I,,CHJTBL
CPNTRM:	300300+I,,CHJTBL
SQPNTR:	220600,,CHJTBL(I)	;SQUOZE CODE FOR CHAR, OR 0.

DEFINE	XBYTE	$1,$2,$3,$4,$5
	.WALGN
	$1+0?$2+0?$3+0?$4+0?$5+0
TERMIN

CHJTBL:	.BYTE	2,4,3,3,6

	XBYTE	MACR,    ,.TRM,    	;
	XBYTE	    ,    ,    ,    	;
	XBYTE	    ,    ,    ,    	;
	XBYTE	MACR,    ,.TRM,    	;
	XBYTE	    ,    ,    ,    	;
	XBYTE	    ,    ,    ,    	;
	XBYTE	    ,    ,    ,    	;
	XBYTE	    ,    ,    ,    	;

	XBYTE	    ,    ,    ,    	;
	XBYTE	MASP,    ,.TAB,TERMSP	; TAB
	XBYTE	MACR,EXND,.TRM,    	; LF
	XBYTE	    ,    ,    ,    	;
	XBYTE	    ,    ,    ,    	; FF
	XBYTE	MACR,EXND,.TRM,    	; CR

REPEAT 22,XBYTE

	XBYTE	MASP,    ,.TAB,TERMSP	; SPACE
	XBYTE	    ,EXOR,.TRM,    	; !
	XBYTE	    ,EXTM,.TRM,TERMQ2	; "
	XBYTE	    ,EXXR,.TRM,    	; #
	XBYTE	    ,EXTM,.ALP,TERMSY,33; $
	XBYTE	    ,EXTM,.ALP,TERMSY,35; %
	XBYTE	    ,EXAN,.TRM,    	; &
	XBYTE	    ,EXTM,.TRM,TERMQ1	; '

	XBYTE	    ,EXND,.TRM,    	; (
	XBYTE	    ,EXND,.TRM,    	; )
	XBYTE	    ,EXML,.TRM,    	; *
	XBYTE	    ,EXPL,.TRM,TERMSP	; +
	XBYTE	MACM,EXND,.TRM,    	; ,
	XBYTE	    ,EXMI,.TRM,TERMMI	; -
	XBYTE	    ,EXTM,.DOT,TERMSY,34; .
	XBYTE	    ,EXDV,.TRM,    	; /

REPEAT 12,XBYTE	    ,EXTM,.NUM,TERMDG,.RPCNT+36	;DIGITS.

	XBYTE	    ,    ,.TRM,    	; :
	XBYTE	MACR,EXND,.TRM,    	; ;
	XBYTE	    ,EXTM,.TRM,TERMOB	; <
	XBYTE	    ,    ,.TRM,    	; =
	XBYTE	    ,EXND,.TRM,    	; >
	XBYTE	    ,    ,    ,    	; ?
	XBYTE	    ,    ,.TRM,    	; @

REPEAT 32,XBYTE	    ,EXTM,.ALP,TERMSY,.RPCNT+1	;LETTERS

	XBYTE	    ,    ,    ,    	; [
	XBYTE	    ,    ,    ,    	; \
	XBYTE	    ,    ,    ,    	; ]
	XBYTE	    ,    ,    ,    	; ^
	XBYTE	    ,EXLA,.TRM,    	; _
	XBYTE				;LOWER CASE @.
REPEAT 32,XBYTE	    ,EXTM,.LOW,TERMSY,.RPCNT+1	;LOWER CASE LETTERS.
REPEAT 5,XBYTE				;FUNNY LOWER CASE CHARS.

	.BYTE
IFN .-CHJTBL-200,.ERR CHJTBL WRONG # ENTRIES.


	CONSTA
	VARIAB

MACPDL:	BLOCK	1000		;MACRO PDL.
	-1

JOBFFI:

;.5KILL ALL SMALL SYMBOLS EXCEPT REGS.
IRP X,,[MACR,MASP,MACM,CL1,CL2,CL3,CL4,CL5,CL6,CL7
QUEARG,QUEMAC,TAB,FF,CRR,SPACE,INDBIT,RUBOUT
TERMSP,TERMDG,TERMSY,TERMMI,TERMOB,TERMQ1,TERMQ2]
	X==X
TERMIN

	END	PALX11
