.sbttl	"HARD-WIRED" COMMANDS
;	=====================

; Command Execution Routines
; --------------------------
;
; This is a collection of routines that illustrate some of the types of
; things that you can do with "hard-wired" commands.  Some of them might not
; be useful to you.  You can get rid of them by editing them out completely
; (don't forget the reference string and the entries in the tables CEALST and
; RSALST) or, more simply, just remove the appropriate CEALST and RSALST
; table entries and leave the code lying around for reference.  In some cases,
; (the RNO command, for example) the command routines can be included or
; eliminated by supplying the appropriate conditional during assembly.

	.psect	uclhwc
.sbttl	.	chain, nochain

; "Set Up Exit-On-Bad Command Chain"			[NO]CHAIN file-spec
;							    =====
	.enabl	lsb
nchain::
	call	40$		;NOCHAIN enters here
	bis	#bit15,chanto
	br	30$
chain::
	call	40$
	bicb	#ucimd,pflags	;Disable UCI_MODE
	bic	#bit15,chanto	;Restore possible chaining data
	call	adjr0		;Skip leading blanks
	tstb	(r0)		;Null file name?
	beq	30$		;Branch if so

	mov	#chanto,r1	;R1 => filename buffer for CHAIN
	mov	#15.,r2		;R2 = max. length for filename
	push	r0		;Save buffer pointer
10$:	movb	(r0)+,(r1)+	;Move filename to CHAIN filename buffer...
	beq	20$
	sob	r2,10$

	pop	r4		;Oops! filename too long...
	mov	#millfn,r5
15$:	jmp	ferrx

20$:	pop	r0		;Clean up stack and
30$:	jmp	wtstbl		; go write out changes

40$:	bit	#ucfmd,status	;Running as UCF?
	bne	50$		;Go gripe if so
	return
50$:	mov	#mbad,r5	;"Invalid command -- running as UCF"...
	mov	#mrucf,r4
	br	15$
	.dsabl	lsb
.sbttl	.	display

; "Display Command Expansion"				DISPLAY command-string
;							=======	/EXECUTE
;								/NOEXECUTE
;								/FORM0
;								/NOFORM0
;								/PRINTER
;								/OUT:file-spec
;								/TERMINAL

dsplay::
	call	plinit		;Init PLINE routine
	mov	sp,dspsp	;Save current stack pointer value
	mov	#dsparl,r4	;R4 => arg. list for switches
	call	swtchs		;Check for switches
	tst	r5		;Any errors?
	bpl	10$		;Branch if not
	mov	dspsp,sp	;Clean up stack and
	jmp	@dspsea(r5)	; go handle errors

10$:	bis	#dspla,status	;Set display bit in status
	bit	#exe,swstat	;"/EXECUTE"?
	beq	20$		;Branch if not
	bis	#dsplx,status	;Set display+execute bit in status

20$:	call	adjr0
30$:	tstb	(r0)		;Command entered?
	beq	35$		;Branch if not
	push	r0		;Stash this pointer
	.getcom	#bfsav,#scrach+2,#dstmtb ;Find unmodified argument...
	call	adjr0
	mov	r0,r1		;Save this pointer
	pop	r0		;Restore BUFF pointer
	br	40$

35$:	.gtlin	#buff,#dspqry	;"Command?"
	mov	#buff,r0	;R0 => input buffer
	call	adjr0		;Skip leading blanks
	tstb	(r0)		;Null string?
	beq	35$		;Branch if so
	call	qtproc		;Do quote processing
	mov	#bfsav,r0	;Skip leading blanks in raw string...
	call	adjr0
	mov	r0,r1		;Save the pointer
	mov	#buff,r0	;Skip leading blanks in "quoted" string...
	call	adjr0

40$:	mov	#buff,r2	;Left justify remainder of input buffer...
50$:	movb	(r0)+,(r2)+
	bne	50$
	mov	#buff,r0	;R0 => "quoted" command string
	cmpb	(r1)+,#'"	;Just print the line?
	bne	90$		;Branch if not
	inc	r0		;Skip leading "
	push	r0		;Save R0
60$:	tstb	(r1)+		;Find end of unmodified text...
	bne	60$
65$:	tstb	(r0)+		;Also find end of "quoted" text...
	bne	65$
	cmpb	-2(r1),#'"	;Last character a " ?
	bne	70$		;Branch if not
	cmpb	-3(r1),#'|	;Has trailing " been quoted?
	beq	70$		;Branch if so
	clrb	-2(r0)		;Replace " with null in "quoted" string
70$:	movb	#200,-(r0)	;Replace null with 200 byte (no cr/lf)
	pop	r0		;Restore R0
	.prlin			;Print remainder of input line...
	.prlin	#0
	bic	#dspla!dsplx,status ;Zap any display bits in status word
	return

90$:	mov	#r0,savr0	;Save buffer pointer
	.getcom	,#cmd		;Cause command execution (ensure rest of
	call	clencm		; buffer pointers reset)...
	.cscan	,#rsalst
	tstb	cxslst(r5)
	bmi	100$
	jmp	baddsp
100$:	jmp	@cealst(r5)

; This routine lists a command expansion.  On entry, R0 contains the byte
; count and R1 the text address.  It forces a return to the mainline unless
; the display+execute bit is set in STATUS.

dsplst::
	push	<r0,r1,r2,r3>	;Save R0 - R3...
	mov	r0,r2		;Put byte count in r2
	mov	r1,r3		;Put input pointer in R3
	.prlin	#crlf		;Print a blank line

10$:	movb	(r3)+,r0	;Get a character
	bne	20$		;Branch if not null
	.prlin	#crlf		;Print a CR/LF...
	br	40$

20$:	mov	#ctrlch,r1	;R1 => output buffer
	call	bytasc		;Produce output character(s)
	movb	#200,(r1)	;No cr/lf
	.prlin	#ctrlch		;Print the character(s)

40$:	sob	r2,10$		;If not done, go do another

	.prlin	#crlf		;Print a blank line
	.prlin	#0		;Clean up any remaining output
	pop	<r3,r2,r1,r0>	;Restore R3 - R0...

	bit	#dsplx,status	;Go ahead and execute the command?
	bne	60$		;Branch if so

	mov	dspsp,sp	;Nope, reset stack
50$:	bic	#<dsplx!dspla!ximm>,status ;Ensure display, execute bits clear
	return			; and return

60$:	bit	#ximm,status	;Execute immediate?
	beq	50$		;Branch if not
	bic	#<dsplx!dspla>,status ;Kill display bits
	mov	dspsp,sp	;Reset stack
	jmp	sypxim		;Return via execute immediate code

	.nlist	bex
ctrlch:	.asciz	"<nnn>"		;Reserve enough room to display
	.list	bex		; eight-bit/control characters
	.even

; Switch routines:

dspexs:
	bit	#nex,swstat	;Switch conflict?
	bne	dspcsw		;Branch if so
	jmp	swbits		;Go set bit in SWSTAT otherwise

dspcsw:
	bis	#cnswer,swstat	;Set "conflicting switches" flag
	sec			;Set carry and
	return			; return

dspnxs:
	bit	#exe,swstat	;Switch conflict?
	bne	dspcsw		;Branch if so
	jmp	swbits		;Go set bit in SWSTAT otherwise

dspsp:	.word	0	;Save area for stack pointer

; Reference string address list for switches:

dsprsa:	.word	exesw
	.word	frmsw
	.word	nexsw
	.word	nfrmsw
	.word	outsw
	.word	prnsw
	.word	trmsw
	.word	0

; Switch status bit list:

dspssb:	.word	exe
	.word	fm0
	.word	nex
	.word	nf0
	.word	out
	.word	prn
	.word	trm

; String execution address list:

	.word	badopx
	.word	cnfswx
	.word	badswx
	.word	ambswx
dspsea:	.word	dspexs
	.word	lisfm0
	.word	dspnxs
	.word	lisnf0
	.word	lisout
	.word	lisprn
	.word	listrm

; Argument list for SWTCHS call:

dsparl:	.word	dsprsa
	.word	dspsea
	.word	dspssb

dstmtb:	.asciz	" "		;Terminator table for .GETCOM call
.sbttl	.	erase

; "Erase A Symbol"					ERASE sym1,sym2,...
;							===== /NOQUERY
;							      /QUERY
sbksiz	= <vznrls-sdsat>/2

erase::
	clr	wrnmad		;Clear warning message buffer
	mov	#ersarl,r4	;R4 => switch processing argument list
	call	swtchs		;Check for and flag switches
	tst	r5		;Any errors?
	bpl	er1sym		;Branch if not
	jmp	@erseal(r5)	;Go handle errors

; Erase all symbols...

eralt:	bit	#noq,swstat	;"/NOQUERY"?
	bne	10$		;Branch if set
	.print	#eraqry		;"Erase All Symbols"
	.gtlin	#buff,#rusure	;"Are You Sure?"
	bicb	#40,buff	;"Y"-for-yes?...
	cmpb	buff,#'Y
	beq	10$		;Branch if so
	return

10$:	mov	#sdsat,r0	;Clear entire symbol area...
	mov	#sbksiz,r1
20$:	clr	(r0)+
	sob	r1,20$
	mov	#sdsbfr,r0	;Insert "string deleted" bytes...
	mov	#nsyms,r1
30$:	movb	#377,(r0)
	add	#lsyms,r0
	sob	r1,30$

	call	wtstbl		;Write changes to SAV image and
	return			; return

; Erase one symbol at a time...

	.enabl	lsb
er1sym:	call	adjr0		;Skip any blanks
	cmpb	(r0),#'*	;Erase all?
	beq	eralt		;Branch if so
	mov	r0,savr0	;Save input buffer pointer
	tstb	(r0)		;Null byte?
	bne	10$		;Branch if not
	.gtlin	#buff,#er1qry	;"Symbol?"
	mov	#buff,r0
	tstb	(r0)		;Null response?
	bne	er1sym		;Branch if not
	return			;Return otherwise

10$:	.getcom	,#cmd		;Extract symbol from input string
	tstb	(r0)		;Last symbol in list?
	beq	20$		;Branch if so
	inc	r0		;Skip separator
20$:	mov	r0,savr0	;Save pointer

	.cscan	,#sdsat		;Try to find entry we want to erase
	tst	r5		;Find it?
	bpl	30$		;Branch if so
	jmp	@er1erx(r5)	;Go handle errors

30$:	tst	r3		;Find an exact match?
	beq	40$		;Branch if so
	bit	#noq,swstat	;"/NOQUERY" bit set?
	bne	60$		;Branch if it is
	mov	sdsat(r5),r1	;R1 => symbol definition string
	mov	#cmd,r2		;R2 => command buffer
	mov	#6,r3		;R3 = max. no. characters to copy
	call	ccopy		;Copy full name of symbol into command buffer
	clrb	(r2)		;Terminate with null
	br	50$		;Go ask about this

40$:	bit	#qry,swstat	;"/QUERY"?
	beq	60$		;Branch if not
50$:	.print	#ersqry		;"Erase Symbol...?"
	.print	#cmd
	.gtlin	#buff,#rusure	;"Are You Sure?"
	bicb	#40,buff	;"Y"-for-yes?...
	cmpb	buff,#'Y
	bne	eraseq		;Branch if not

60$:	add	#sdsat,r5	;R5 => symbol string address
	movb	#377,@(r5)	;Flag string entry as deleted
70$:	clr	(r5)		;Clear address entry
	cmp	r5,#sdsatl	;Last entry in table?
	beq	eraseq		;Branch if so
	mov	2(r5),(r5)+	;Shift up next address entry
	br	70$		;Go shift next one

eraseq:	call	wtstbl		;Write changes to SAV image
	tst	wrnmad		;Doing "erase by name"?
	beq	80$		;Branch if not
	call	wrngm		;"UCL-W-Erased Symbol xxxxxx"...
	.print	#cmd
	return

80$:	mov	savr0,r0	;Get pointer to next symbol name
	call	adjr0		;Skip leading blanks
	tstb	(r0)		;End of list?
	bne	10$		;Branch if not
	return

; Entry for "erase by name"...

er1sy0:	mov	#erawrn,wrnmad	;Set up for erase warning message
	br	60$		;Go do it
	.dsabl	lsb

; Error traps for ERASE

	.word	er1erx
	.word	er1er0
er1erx:	mov	#er1nfm,r5	;"Symbol Not Found..."
	br	er1er1
er1er0:	mov	#er1amm,r5	;"Ambiguous Symbol..."
er1er1:	mov	#cmd,r4
	jmp	ferrx

; Switch reference string address list for ERASE:

ersal:	.word	noqsw
	.word	qrysw
	.word	0

; Switch status bit list for ERASE:

erssbl:	.word	noq
	.word	qry

; Switch execution address list:

	.word	badopx
	.word	cnfswx
	.word	badswx
	.word	ambswx
erseal:	.word	swbits
	.word	swbits

; Argument list for SWTCHS call:

ersarl:	.word	ersal
	.word	erseal
	.word	erssbl

.sbttl	.	list

; "List Current UCL Commands"			LIST arg1,arg2,...
;						==== /OUT:file-spec ALL
;						     /PRINTER       CHAIN
;						     /TERMINAL      COMMANDS
;						     /FORM0         PATH
;						     /NOFORM0       SYMBOLS
;						                    VERSION

lister::
	call	plinit		;Init PLINE routine
	mov	#liswal,r4	;R4 => argument list for SWTCHS call
	call	swtchs		;Check for switches
	tst	r5		;Any errors?
	bpl	10$		;Branch if not
	jmp	@liswel(r5)	;Handle errors

10$:	call	adjr0		;Skip any intervening blanks in input string
	tstb	(r0)		;Null argument?
	bne	30$		;Branch if not
	call	lists		;Force default to "LIST SYMBOLS"
20$:	.prlin	#0		;Clean up any remaining output
	return			;Quit

30$:	.getcom	,#cmd		;Move argument to command buffer
	mov	r0,savr0	;Save input buffer pointer
	.cscan	,#lisal		;Look for valid argument
	tst	r5		;Invalid argument?
	bmi	40$		;Branch if so
	call	@liseal(r5)	;Go execute appropriate routine
	mov	savr0,r0	;Restore input buffer pointer
	tstb	(r0)		;Done?
	beq	20$		;Branch if so
	inc	r0		;Point at next argument
	br	30$		;Go handle it

40$:	.prlin	#0		;Clean up any remaining output
	jmp	@liseal(r5)	;Go handle errors

lista:				;"LIST ALL"...
	call	listv		;List version
	call	listc		;List commands
	call	lists		;List symbols
	call	listp		;List path
	call	listx		;List chain
	return
lists:				;"LIST SYMBOLS"...
	bit	#jrnlo,status	;Journaling active?
	bne	5$		;Branch if so
	.prlin	#listsm		;"Current Symbols"
5$:	mov	#nsyms,r5	;R5 = max. no. symbols
	mov	#sdsat,r4	;R4 => SDS addr. table
10$:	mov	(r4)+,r1	;R1 => next string address
	bne	20$		;Branch if not end of table
	bit	#jrnlo,status	;If journaling, just quit...
	bne	15$

	mov	#nsyms,r0	;R0 = max. no. symbols
	sub	r5,r0		;Make R0 = no. symbols defined
	mov	#scrach,r1	;R1 => scratch buffer (for ASCII decimal)
	call	binasc		;Convert to ASCII
	.prlin	#scrach		;"nnn Symbols Defined"...
	.prlin	#listsd
	mov	r5,r0		;R0 = no. remaining entries
	mov	#scrach,r1	;R1 => buffer for ASCII
	call	binasc		;Convert to ASCII
	.prlin	#scrach		;"nnn Entries Remain"...
	.prlin	#listse
15$:	return			;Quit

20$:	mov	#scrach,r2	;R2 => buffer for output string
	mov	#<lcccc+lssss>,r3 ;R3 = max. no. characters to copy
	mov	#-7,r0		;R0 counts no. of characters copied
	call	ccopy		;Copy symbol part to buffer
	br	40$
30$:	movb	#space,(r2)+	;Pad to 6 characters with blanks...
40$:	inc	r0
	bne	30$
50$:	movb	#'=,(r2)+	;Insert "=="...
	movb	#'=,(r2)+
	mov	r2,r1		;Put output pointer in R1
	mov	-2(r4),r2	;Copy definition part (expand non-printing
	add	#<lcccc+1>,r2	; stuff into "<nnn>" format)...
60$:	movb	(r2)+,r0
	beq	80$
	call	bytasc
	dec	r3
	bne	60$
80$:	clrb	(r1)		;Terminate with null
	.prlin	#scrach		;Print result
	dec	r5		;Adjust counter
	br	10$		;Go get next string

; Routine to convert a binary value in R0 to a decimal ASCII string.
; On entry, R1 points at the output buffer.  On return, R1 points at
; a terminating 200 byte.

binasc:
	call	10$		;Call conversion routine
	movb	#200,(r1)	;Add terminating byte
	return			;Quit
10$:	push	r0		;Binary to decimal ASCII conversion
	clr	r0		; routine...
20$:	inc	r0		;Stolen from page 2-67 of the V5
	sub	#10.,(sp)	; Programmer's Reference Manual
	bge	20$
	add	#72,(sp)
	dec	r0
	beq	30$
	call	binasc
30$:	movb	(sp)+,(r1)+
	return
	.enabl	lsb
listv:
	.prlin	#crlf		;List program name/version...
	.prlin	#vrshun
30$:	.prlin	#crlf
	return

listc:				;"LIST COMMANDS"...
	.prlin	#listcm		;"Valid Commands:"
	mov	#rsals0,r1	;R1 => Reference String Address List; skip "?"
40$:	mov	(r1)+,r0	;Point R0 at a string
	beq	30$		;Go quit if we've hit end of list
	.prlin			;Print the string
	br	40$		;Go look for the next one

listp:				;"LIST PATH"
	tstb	pthbuf		;Do we have anything to list?
	bgt	50$		;Branch if so
	mov	#listpj,r0	;Assume we are journaling
	bit	#jrnlo,status	;Journaling?
	bne	45$		;Branch if so
	mov	#listp0,r0	;Otherwise, use LIST-style test
45$:	.prlin			;"No Run-by-name path" / "NOPATH" ...
	return
50$:	bit	#jrnlo,status	;Journaling?...
	bne	55$
	.prlin	#listpm		;"Run-by-name" path:"
	.prlin	#pthbuf		;Print the path...
	br	30$
55$:	.prlin	#pthmsg		;"PATH "
	.prlin	#pthbuf		;Print the path...
	return

listx:
	bit	#jrnlo,status	;Journaling?
	bne	80$		;Branch if so

	bit	#<ucimd!ucfmd>,status ;Branch if UCF/UCI_MODE in effect...
	bne	60$
	tst	chanto		;Is CHAIN in effect?
	bgt	70$		;Branch if so

	.prlin	#listx0		;"No CHAIN In Effect"
	br	30$

60$:	.prlin	#listxu		;"Pass-Line-To-KMON In Effect..."
	mov	#listxf,r0	;Assume running as UCF
	bit	#ucimd,status	;UCI_MODE?
	beq	65$		;Go print message if not
	mov	#listxi,r0	;R0 => "(UCI_MODE)"
65$:	.prlin			;Print the text
	br	30$

70$:	.prlin	#listxm		;"CHAIN In Effect To..."
	.prlin	#chanto
	br	30$
; Journal code...
80$:
.if ne uci$c
	bit	#ucimd,status	;UCI_MODE?
	beq	90$		;Branch if not
	.prlin	#sucimd		;"UCI_MODE"
	return			;Quit
.endc
90$:	tst	chanto		;Chaining turned on?...
	ble	95$		;Branch if not
	.prlin	#chnmsg		;"CHAIN "
	.prlin	#chanto		;List chain file name
	return			; and quit
95$:	.prlin	#listxj		;"NOCHAIN"...
	return

	.dsabl	lsb

badarg:	mov	#mbadrg,r5	;Issue "?UCL-F-Invalid Argument"...
	mov	#cmd,r4
	jmp	ferrx		;Take "fatal" error exit
; Reference string address list for LIST:

lisal:	.word	star
	.word	allsw
	.word	schain
	.word	comsw
	.word	spath
	.word	symsw
	.word	versw
	.word	0

; Argument execution address list for LIST:

	.word	badopx
	.word	cnfswx
	.word	badarg
	.word	ambcom
liseal:	.word	lista
	.word	lista
	.word	listx
	.word	listc
	.word	listp
	.word	lists
	.word	listv

; Switch handling routines...

lisout:	bit	#<prn!trm>,swstat ;Any switch conflicts?
	beq	lisou0		;Branch if not
liscns:	bis	#cnswer,swstat	;Return with error
	sec
	return
lisou0:	call	outsr		;Go handle switch
	bcc	lisscp		;If no errors, go set up output file name
	return

lisscp:	push	<r0,r1>		;Save R0, R1
	mov	#outfnm,r0	;Move file name from OUTFNM to PRLFNM...
	mov	#prlfnm,r1
10$:	movb	(r0)+,(r1)+
	bne	10$
	pop	<r1,r0>		;Restore R1, R0
	return

lisprn:	bit	#<out!trm>,swstat ;Any switch conflicts?
	bne	liscns		;Branch if so
	call	prntsr		;Go handle switch
	bcc	lisscp		;If not errors, stick "LP:" in PRLFNM buffers
	return

listrm:	bit	#<out!prn>,swstat ;Any switch conflicts?
	bne	liscns		;Branch if so
	clrb	prlfnm		;Just do .PRINT's...
	clc
	return

lisfm0:	bit	#nf0,swstat	;Any switch conflicts?
	bne	liscns		;Branch if so
	jmp	frmsr		;Go handle switch otherwise

lisnf0:	bit	#fm0,swstat	;Any switch conflicts?
	bne	liscns		;Branch if so
	jmp	nfrmsr		;Go handle switch otherwise

; Switch Reference String Address List for LIST

liswrs:	.word	frmsw, nfrmsw, outsw, prnsw, trmsw, 0

; Switch Status-Bit List

liswbl:	.word	fm0, nf0, out, prn, trm

; Switch Execution Address List

	.word	badopx
	.word	cnfswx
	.word	badswx
	.word	ambswx
liswel:	.word	lisfm0
	.word	lisnf0
	.word	lisout
	.word	lisprn
	.word	listrm

; Argument List for SWTCHS call

liswal:	.word	liswrs, liswel, liswbl
.sbttl	.	nosl, slon

; "SL editor on/off"						NOSL  or  SLON
;								====      ====
; These commands turn the single-line editor off/on.
;
; If UCL is RUN directly, the effect is to toggle SL locally.  This assumes,
; of course, that SL was installed and turned on prior to running UCL and that
; SL is enabled for use by user programs.
;
; If NOSL or SLON is entered via the monitor, the effect is the same as
; typing, respectively, SET SL OFF or SET SL ON.

	.enabl	lsb
nosl::
	call	dsptst		;Check DISPLAY,RUN status
	bis	#edit$,@#jsw	;Set "disable SL" bit in JSW
	mov	#nosltx,r1	;R1 => "SET SL OFF"
10$:	bit	#runc,status	;Were we RUN?
	beq	30$		;Branch if not
20$:	.rctrlo			;Ensure JSW updated
	return

30$:	jmp	setcmd		;Pass command to monitor


slon::
	call	dsptst		;Check DISPLAY,RUN status
	bic	#edit$,@#JSW	;Allow program to use SL
	mov	#slontx,r1	;R1 => "SET SL ON"
	br	10$		;Go take appropriate action

	.nlist	bex
nosltx:	.word	50$-40$
40$:	.asciz	/SET SL OFF/
50$:	.byte	0
	.even
slontx:	.word	70$-60$
60$:	.asciz	/SET SL ON/
70$:	.byte	0
	.even
	.list	bex
	.dsabl	lsb

dsptst:	bit	#dspla,status	;DISPLAY active?
	beq	10$		;Branch if not
	bit	#runc,status	;Were we RUN?
	beq	10$		;Branch if not
	jmp	baddsp		;Complain if both true
10$:	return
.sbttl	.	pass_on

; "Pass-on Command To Next (or another) Program"      PASS_ON command
;						      ======= /TO:program-name
; This command tells UCL to pass the specified command-
; string on to the program that you specified via the
; CHAIN command.  If you specify a "program-name", then
; the command is passed to this program instead.  If
; CHAINing is not in effect, and you failed to specify
; a program to chain to, you get your hand slapped with
; "UCL-F-No CHAIN In Effect".
;
; Note that the command string is passed "UCL-style"
; (byte count at location 510, string starting at 512)
; not "run-by-name" style.

pass::
	mov	#pasarl,r4	;Check for /TO: switch...
	call	swtchs
	tst	r5		;Errors?
	bpl	10$		;Branch if not
	jmp	@passea(r5)	;Go handle errors

10$:	tst	swstat		;/TO: invoked?
	beq	50$		;Branch if not

	mov	#outfnm,r4	;R4 => file-spec
	tstb	(r4)		;Null file-spec?
	beq	30$		;Branch if so

15$:	push	r0		;Save R0 and
	mov	sp,spsav	; current stack pointer
	.csispc	#scrach,#dext,r4 ;convert filename to RAD50, lazy way
	mov	spsav,sp	;Restore stack pointer
	pop	r0		; and R0 (carry unaffected)
	bcs	20$		;Branch on error
	br	60$		;Everything looks OK, proceed

20$:	mov	#prlfnm,r4	;Oops! Bad file name...
30$:	mov	#millfn,r5
40$:	jmp	ferrx

50$:	bit	#<ucimd!ucfmd>,status ;UCF/UCI_MODE in effect?
	bne	55$		;Branch if so
	mov	#chanto,r4	;Is there a file-spec for chaining?...
	tst	(r4)
	bpl	15$		;If so, go set up the RAD50 for the chainer
55$:	clr	r4		;"No CHAIN In Effect"...
	mov	#listx0+2,r5
	br	40$

60$:	call	adjr0		;Skip any intervening blanks
	tstb	(r0)		;Null command string?
	bne	70$		;Branch if not

65$:	.gtlin	#bfsav,#dspqry	;"Command?"
	mov	#bfsav,r0	;R0 => command-string
	call	adjr0		;Skip any intervening blanks
	tstb	(r0)		;Null command string?
	beq	65$		;Branch if so
	br	75$		;Otherwise, go pass it to chainer

70$:	push	r1		;Find address of original argument text...
	call	adjr0
	.getcom	#bfsav,#scrach+2,#patmtb
	pop	r1
	call	adjr0		;Skip leading blanks
75$:	push	r0		;Put result where chain code can find it
	jmp	chanr0		;Go hand off to chainer
pasrsa:	.word	tosw		;Reference string address for switch
	.word	0

	.word	badopx		;Switch execution address list
	.word	cnfswx
	.word	badswx
	.word	ambswx
passea:	.word	outsr		;(use /OUT switch code)

passsb:	.word	1		;Switch status bit

pasarl:	.word	pasrsa		;Argument list for SWTCHS call
	.word	passea
	.word	passsb

patmtb:	.asciz	" "		;Terminator table for .GETCOM call
.sbttl	.	path, nopath

; "Set Up 'Run-by-name' Search Path"			[NO]PATH dev1,dev2,...
;							    ====
; If a command or symbol is not found, UCL follows the
; list of devices set up with the PATH command in
; attempting a "run-by-name".
; The limit is about 20 device mnemonics.

comma	= 054
	.enabl	lsb
npath::
	bisb	#bit7,pthbuf	;NOPATH enters here...
	br	45$
path::
	bicb	#bit7,pthbuf	;Restore possible path list
	call	adjr0		;Skip leading blanks
	tstb	(r0)		;Null list?
	beq	45$		;Branch if so

	mov	#20.,r4		;R4 = max. no. of devices
	mov	#pthbuf,r2	;R2 => path buffer
	mov	#80.,r3		;R3 = max. no. bytes to copy
30$:	call	adjr0		;Get a mnemonic...
	.getcom	,#cmd
	call	tstdmn		;Check it
	bcs	60$		;Branch on error
	push	r0		;Copy mnemonic to path buffer...
	call	ccopy
	pop	r0
	call	adjr0		;If end of list, go quit...
	tstb	(r0)
	beq	40$
	inc	r0		;Skip separator (comma presumably)
	dec	r4		;Adjust device count
	bne	50$		;Branch if still room
40$:	clrb	(r2)		;Add terminating null
45$:	jmp	wtstbl		;Go write changes
50$:	movb	#comma,(r2)+	;Stick in a comma
	br	30$		;Go get next device name

60$:	clr	r4		;"Illegal Device"...
	mov	#dmnerr,r5
	jmp	ferrx
	.dsabl	lsb
; Routine to check a device mnemonic and force a colon on the end.
;
; On entry:
;	R1 => device mnemonic
;
; On return:
;	R1 is unchanged
;	carry is set if mnemonic too long or too short
;	carry is clear if no error

tstdmn::
	push	<r5,r0>		;Save R5, R0
	.getcom	r1,,#tmtblc	;Trim possible ":"...
	mov	r1,r0		;Get length of mnemonic...
	call	len
	pop	r0		;Restore R0
	cmp	r5,#3		;Check for valid length...
	bgt	10$
	tst	r5
	bgt	20$

10$:	pop	r5		;Error: restore R5,
	sec			; set carry, and
	return			; return

20$:	add	r1,r5		;R5 => end of mnemonic
	movb	#':,(r5)+	;Put ":" on end and
	clrb	(r5)		; trailing null
	pop	r5		;Restore R5
	clc			; clear carry, and
	return			; return
.sbttl	.	prompt
; "Set new UCL prompt"					PROMPT prompt-text
;							======
; PROMPT replaces the current UCL+ prompt string with
; a new one.  If no prompt-text is entered the default
; ("UCL> ") is restored.

promt::
	call	adjr0		;Skip leading blanks
	push	<r0,r1,r2,r3>	;Save working registers
	cmpb	(r0),#'"	;Skip optional " mark...
	bne	20$
	inc	r0
20$:	mov	r0,r1		;R1 => prompt-text
	tstb	(r1)		;If no text, use default...
	bne	30$
	mov	#dfpmt,r1
30$:	mov	#prompt,r2	;R2 => prompt buffer
	mov	#8.,r3		;R3 = maximum allowable length
	call	ccopy		;Copy the prompt-text
	cmpb	-(r2),#'"	;Zap optional " mark...
	beq	40$
	inc	r2
40$:	movb	#200,(r2)	;Terminate with 200 byte (no cr/lf)
	pop	<r3,r2,r1,r0>	;Restore registers
	jmp	wtstbl		;Preserve changes
.sbttl	.	reload
.if ne ucl$xm

; "Reload the Global Region from the SAV Image"		RELOAD
;							======
; Loads the UCL global region from the SAV image of the program currently
; running and then restarts UCL.  Among other things, this is a sneaky way
; to load different program images into the global region without REMOVEing
; the region.

reload::
	bit	#jrnli,status	;Is dummy RELOADing during journaling?
	beq	10$		;Branch if not
	mov	#milrel,r5	;R5 => "RELOAD invalid while journaling"
	clr	r4
	jmp	ferrx		;Take fatal error exit

10$:	clr	@#bytcnt	;Keep ourselves from looping forever
	jmp	@#grl$rl	;Jump to the global loaders reload entry
				; point...
.endc
.sbttl	.	recall

; "Recall Symbol Definition and Status Tables"		RECALL file-spec
;							====== /BINARY
;							       /JOURNAL
;							       /[NO]QUIET
;
; Recalls (loads) the symbol definition and status area from a file that
; has previously been created with the STORE command.  The default device
; is DK: and the default extension is .UCL (ie, DK:filnam.UCL where "filnam"
; is the file name you specify).  The /NOQUIET switch is used to enable
; echoing of input lines to the console during journaling.  The default is
; /QUIET.
;
; If the /JOURNAL switch is in effect, the default output file extension
; is .UCJ.
;
; The XM version of UCL defaults to a .UCX extension for non-journal files.

recall::
	mov	#srcarl,r4	;R4 => argument list for SWTCHS call
	bis	#jrnlq,status	;Assume /QUIET
	call	swtchs		;Look for /JOURNAL, etc.
	tst	r5		;Any errors?
	bpl	5$		;Branch if not
	jmp	@srcsea(r5)	;Go handle switch error

5$:	call	adjr0		;Point at the file name
	clr	r5		;Open the file...
	call	opnucl
	mov	r0,savr0	;Save file name pointer
	tstb	swstat		;/JOURNAL?
	bpl	8$		;Branch if not

	bis	#jrnli,status	;Set journal mode input flag
	clr	rblksv		;Init variables for GREC routine...
	mov	#ibufr+512.,ibptr
	return			;Quit

8$:	bic	#jrnlq,status	;Remove possible /QUIET flag
	movb	vznrls,r4	;Get current version...
	clr	wblok		;Load symbol definition/status stuff from
	mov	#sdsat,wbufa	; file...
	mov	#nbloks,r5
10$:	.readw	#area,#3
	bcs	30$
	inc	wblok
	add	#512.,wbufa
	sob	r5,10$
	cmpb	vznrls,r4	;Loaded stuff same release?
	bne	20$		;Branch if not
	bitb	#uclxm,pflags	;Test for XM version bit...
.iif eq ucl$xm	bne	35$
.iif ne ucl$xm	beq	35$
	.close	#3		;Close the input channel
	jmp	wtstbl		;Go update UCL.SAV

; error traps...

20$:	mov	#vrerr,r5	;R5 => "Wrong Version..."
	br	40$		;Go take error exit
30$:	mov	#rclerr,r5	;R5 => "Read Error..."
	br	40$		;Go take error exit
35$:	mov	#minvff,r5	;"Wrong file format..."
40$:	.close	#3		;Make sure input channel closed
.if eq ucl$xm
	mov	savr0,r4	;R4 => input file name (as entered)
	bic	#runc,status	;Force an exit (tables might be screwed-up)
	jmp	ferrx		;Go complain and quit
.iff
	push	r5
	jmp	@#grl$xx	;Jump to reload code in global region loader
.endc

; This routine opens a UCL (or UCX) file.  It is used by the RECALL and STORE
; commands.
; On entry:
;	R0 points at the file name (ASCIZ string)
;	R5 =  0 to open an existing file (RECALL)
;	   = -1 to open a new file (STORE)
; The registers are undisturbed on return.
;
; OPNUCL also prompts for a file name, if necessary.

opnucl::
	push	<r0,r1,r2,r3>	;Save R0 - R3
10$:	call	adjr0		;Null file name?...
	tstb	(r0)
	bne	20$		;Branch if not
	.gtlin	#buff,#filqry	;"File?"...
	mov	#buff,r0
	br	10$
20$:	mov	r0,r1		;Copy file name to scratch area...
	mov	#scrach,r2
	mov	#14.,r3
	call	ccopy
	tst	r5		;Open old or new file?
	bpl	30$		;Branch if old
	mov	#newsfx,r1	;Stick "[22]=" after file name
	tstb	swstat		; unless we're journaling...
	bpl	25$
	mov	#maxsfx,r1	;If /JOURNAL, use "[-1]="...
25$:	mov	#6,r3
	call	ccopy
30$:	clrb	(r2)		;Add terminating null

	mov	#uclext,r1	;R1 => assumed default extension list
	tstb	swstat		;If journaling active, use other list...
	bpl	40$
	mov	#ucjext,r1
40$:	mov	sp,spsav	;Open the file..
	.csigen	dspace,r1,#scrach
	mov	spsav,sp	;Clean up the stack
	bcs	opnurx		;Branch on error
	pop	<r3,r2,r1,r0>	;Restore R3 - R0
	return

; error trap...

opnurx:
	mov	6(sp),r4	;Make R4 => file name (old R0)...
opnur0:	clr	r5		;Make R5 index to error message...
	movb	@#errbyt,r5
	asl	r5
	.purge	#0		;Ensure any open channels cleaned-up...
	.purge	#3
	mov	opnuet(r5),r5	;Point at error message
	jmp	ferrx		;Go complain and quit

; data area for OPNUCL...
.if eq ucl$xm			;Default extensions for .CSIGEN call
uclext:	.rad50	"UCL"
	.rad50	"UCL"
	.word	0,0
.iff
uclext:	.rad50	"UCX"
	.rad50	"UCX"
	.word	0,0
.endc

ucjext:	.rad50	"UCJ"
	.rad50	"UCJ"
	.word	0,0

newsfx:	.asciz	/[22]=/
maxsfx:	.asciz	/[-1]=/
	.even

opnuet:	.word	millfn		;Error message address table
	.word	dmnerr
	.word	mpfilf
	.word	mnroom
	.word	mfilnf
; Routines for STORE/RECALL switch processing

	.enabl	lsb
				;/BINARY...
bnswr:	tstb	swstat		;Switch conflict?...
	bmi	20$
	tstb	swstat+1
	bne	20$
10$:	jmp	swbits		;Otherwise, go set up switch status word

20$:	clr	swstat		;Ensure switch status reset
	bis	#cnswer,swstat	;Set "conflicting switches" bit in SWSTAT
	sec			;Flag the error
	return			; and quit

				;/JOURNAL...
jnswr:	tstb	swstat		;Did cretin ask for both modes?
	bne	20$		;If so, go say something about it
	br	10$		;Otherwise, go set switch status

				;/NOQUIET...
nqtswr:	tstb	swstat+1	;Check for switch conflict...
	bgt	20$
	tstb	swstat
	bgt	20$
	bic	#jrnlq,status	;Echo journal input lines to console...
	br	10$
				;/QUIET...
qtswr:	tstb	swstat+1	;Check for switch conflict...
	bmi	20$
	tstb	swstat
	bgt	20$
	bis	#jrnlq,status	;Tell UCL+ to journal quietly...
	br	10$
	.dsabl	lsb

; Tables for STORE/RECALL switch processing...

srcrsa:	.word	bnysw,  jnlsw,  noqtsw, qtsw, 0	;Reference string addresses

	.word	badopx, cnfswx, badswx, ambswx
srcsea:	.word	bnswr,  jnswr,  nqtswr, qtswr	;Switch execution address list

srcssb:	.word	1,      200,    100000, 400	;Switch status bit list

srcarl:	.word	srcrsa, srcsea, srcssb	;Argument list for SWTCHS call
.sbttl	.	store

; "Store Current Symbol Definition and Status Tables"	STORE file-spec
;							===== /BINARY
;							      /JOURNAL
;
; The STORE command causes the symbol/status blocks to be written to a
; specified file.  The default device is DK:, the default extension .UCL
; (DK:filnam.UCL).
;
; The /JOURNAL switch causes the default extension to be .UCJ for the
; output file.
;
; The XM version of UCL defaults to a .UCX extension for non-journal output
; files.

store::
	mov	#srcarl,r4	;R4 => argument list for SWTCHS call
	call	swtchs		;Look for /JOURNAL
	tst	r5		;Any errors?
	bpl	5$		;Branch if not
	jmp	@srcsea(r5)	;Go handle switch error

5$:	call	adjr0		;Point at filename
	mov	r0,savr0	;Save pointer to file name
	mov	#-1,r5		;Open the file...
	call	opnucl
	tstb	swstat		;/JOURNAL?
	bmi	storej		;Branch if so
	movb	#rls,vznrls	;Ensure version/release stuff current...
	movb	#vzn,vznrls+1

	clr	wblok		;Write-out the symbol/status blocks...
	mov	#sdsat,wbufa
	mov	#nbloks,r5
10$:	.writw	#area,#0
	bcs	sterx
	inc	wblok
	add	#512.,wbufa
	sob	r5,10$
	.close	#0		;Close the output channel
	return

; error trap

sterx:	mov	savr0,r4	;R4 => file name
sterx0:	mov	#strerr,r5	;R5 => "Write Error..."
	.purge	#0		;Close channel; don't make file permanent
	jmp	ferrx		;Go complain

; Here we handle STORE/JOURNAL...

storej:
	call	plinit		;Ensure PLINE initialized
	bis	#<odopn!jrnlo>,status ;Set "output dev open" & "journal out"
	clr	wblok		;Init output block and buffer pointer...
	mov	#obufr,obptr
	mov	savr0,r4	;Move filename to PLINE's buffer (for error
	mov	#prlfnm,r5	; messages)...
10$:	movb	(r4)+,(r5)+
	bne	10$

	call	lists		;List symbols,
	call	listp		; path,
	call	listx		; chaining,
	.prlin	#pmtmsg		; and prompt text...
	.prlin	#prompt
	.prlin	#crlf
	.prlin	#0		;Close out the file
	bic	#jrnlo,status	;Reset JRNLO bit
	return			; and quit
.sbttl	.	uci_mode, nouci_mode
.if ne uci$c

; "Switch UCI_MODE operation on/off"		[NO]UCI_MODE prompt-string
;						    ========
; UCI_MODE sets the "pass line to KMON" flag
; and then executes the equivalent of a
; "PROMPT=prompt-string" command.
;
; NOUCI_MODE does a "PROMPT=prompt-string".
; The "pass line to KMON" flag is cleared.

	.enabl	lsb

; UCI_MODE...

ucimod::
	tst	status		;Is this a legal command for this monitor?
	bpl	15$		;Branch if not
	bisb	#ucimd,pflags	;Set UCI_MODE flag
.if ne pfx
	call	20$		;Activate prefix for hard-wired commands
.endc
10$:	jmp	promt		;PROMPT=...

; NOUCI_MODE...

nucimd::
	tst	status		;Is this a legal command for this monitor?
	bpl	15$		;Branch if not
	bicb	#ucimd,pflags	;Clear UCI_MODE and RUN flags...
	bicb	#<ucimd!runc>,status
	br	10$		;Go do PROMPT=...

15$:	clr	r4		;Execute "...invalid for this monitor" fatal
	mov	#miluci,r5	; error exit
	jmp	ferrx

; If UCI_MODE is in effect, this routine adjusts the string pointers for the
; hard-wired commands to point at the prefix character.

ucitst:
	tstb	pflags		;UCI_MODE in effect?
	bpl	40$		;Branch if not
.if ne pfx
	tstb	status		;Prefix stuff already done?
	bmi	40$		;Branch if so

20$:	push	r0		;Save R0
	mov	#rsals0,r0	;R0 => reference string address list
30$:	dec	(r0)+		;Point at command prefix character
	tst	(r0)		;Done?
	bne	30$		;Branch if not
	pop	r0		;Restore R0
.endc
	bis	#ucimd,status	;Flag completion
40$:	return			; and quit
	.dsabl	lsb
.endc
.sbttl	.	rno
.if ne rno$c
; Runoff Command Routine			RNO/switches file-spec
;						===
;
; RNO/switches MYFILE  becomes  RUNOFF outspec/switches=MYFILE

; This set of routines and tables implements an RNO command for use with
; DECUS RUNOFF version M02.4.
;
; The command switches and the RUNOFF switches and file specifications
; that they map to are as follows:
;
;	RNO				RUNOFF
;	---				------
;	/BEGIN:n			/B:n
;	/START:n
;
;	/END:n				/E:n
;
;	/ONLY:n				/B:n/E:n
;	/PAGE:n
;
;	/FORMLENGTH:n			/F:n
;
;	/HYPHENATION			/H:YES
;
;	/NOHYPHENATION			/H:NO
;
;	/HELP				/I
;	/INFORMATION
;
;	/STRIP				/S
;
;	/NOSTRIP			ignored
;
;	/UNDERLINE			/U:L
;	/UNDERLINE:BACKSPACE		/U:B
;	          :SIMULATED		/U:S
;	          :NONE			/U:N
;
;	/NOUNDERLINE			/U:N
;
;	/VERSION			/V
;
;	/WAIT				/W
;
; output specifications:
;
;	/OUT:filename			filename...=
;
;	/PRINTER			LP:...=
;
;	/TERMINAL			TT:...=
;
;	no output spec. or		LP:...=
;	/DEFAULTS
rno::
	clrb	outfnm		;Init. output file buffer
	mov	#rnalst,r4	;R5 => switch argument list
	call	swtchs		;Process switches
	jmp	@rnovec(r5)	;Go do whatever is right

; Above jump enters at RNOOK if no problems with switches

rnook:	call	adjr0		;Skip leading blanks
	tstb	(r0)		;Null input file?
	bne	10$		;Branch if not
	bit	#4,swstat	;Input file required?
	bne	10$		;Branch if not
	.gtlin	#buff,#rnpmt	;"Input File?"...
	mov	#buff,r0
	br	rnook

10$:	push	r0		;Save R0
	clr	r0		;Actual byte count accumulates in R0
	mov	#chbuf,r2	;R2 => "chain buffer"
	mov	#chbufl,r3	;R3 = max. byte copy count
	mov	#rnotxt,r1	;Put "R RUNOFF" in chain buffer
	call	ccopy0

	bit	#2,swstat	;Any output spec. entered?
	bne	20$		;Branch if yes
	bit	#4,swstat	;Output file required?
	bne	30$		;Branch if not
	mov	#deftxt,r1	;Use "LP:" otherwise...
	call	ccopy
	br	30$

20$:	mov	#outfnm,r1	;Copy output spec...
	call	ccopy

30$:	mov	#stxbuf,r1	;Copy switches...
	call	ccopy

	mov	#eqlsin,r1	;Insert "="...
	call	ccopy

	pop	r1		;R1 => input spec. (old R0)
	call	ccopy0		;Copy it to chain buffer

	mov	#uarowc,r1	;Copy in "^C"...
	call	ccopy0

	mov	#chbuf,r1	;Pass command line to RT-11...
	jmp	setcm0
; Specialized switch routines for RNO...

; /OUT:filename

rnoutr:
	bit	#2,swstat	;Already have output spec?
	bne	confsw		;Yes
	jmp	outsr		;No

confsw:	bis	#cnswer,swstat	;Set "conflicting switches" flag
	sec			;Set carry bit
	return

; /PRINTER

rnprnr:
	bit	#2,swstat
	bne	confsw
	jmp	prntsr

; /TERMINAL

rntrmr:
	bit	#2,swstat
	bne	confsw
	jmp	termsr

; /DEFAULTS

rndefr:
	bit	#2,swstat	;Previous output specs?
	bne	confsw
	push	<r0,r1>		;Save R0, R1...
	mov	#deftxt,r0	;Copy default stuff to output-spec. buffer...
	mov	#outfnm,r1
10$:	movb	(r0)+,(r1)+
	bne	10$
	pop	<r1,r0>		;Restore R1, R0...
	jmp	swbits		;Update switch status
; /ONLY:n and /PAGE:n

rnolyr:
	mov	#rnbsrs,r1	;R1 => "/B:"
	call	ctstxb		;Append it to switch text buffer
	call	getopt		;Get the "n" part into OPBUF
	bcc	20$		;Branch if it was there
	dec	stxbp		;Zap unneeded ":"...
	clrb	@stxbp
10$:	jmp	swbits		;Go update switch status

20$:	push	r1		;Save R1 (points at the "n" part)
30$:	cmpb	(r1),#'0	;See if "n" text is entirely numeric...
	blt	40$
	cmpb	(r1)+,#'9
	bgt	40$
	tstb	(r1)
	bne	30$
	movb	#'.,(r1)+	;They're all numbers; append decimal point...
	clrb	(r1)
40$:	pop	r1		;Restore R1
	call	ctstxb		;Append the "n" to the switch text buffer

	mov	#rnesrs,r1	;R1 => "/E:"
	call	ctstxb		;Copy this part
	mov	#opbuf,r1	;R1 => "n" part again
	call	ctstxb		;Copy it
	br	10$		;Go quit
; /UNDERLINE:option

rnuswr:
	call	adjr0		;Skip leading blanks
	cmpb	(r0),#':	;Is there an option?
	beq	10$		;Yes...
	jmp	stxoly		;No, take default

10$:	call	getopt		;Put option in OPBUF
	push	<r3,r4,r5>	;Save R3 - R5
	.cscan	,#uswrsa	;Look for a match...
	mov	r5,r1		;Put offset in R1
	bpl	20$		;Branch if there was a match
	bis	#badopt,swstat	;Set "bad option" flag
	br	30$		; and branch

20$:	mov	uswsta(r1),r1	;R1 => switch text
	call	ctstxb		;Copy to STX buffer

30$:	pop	<r5,r4,r3>	;Restore R5 - R3...
	call	swbits		;Update switch status
	bit	#badopt,swstat	;Did we have bad option?
	beq	40$		;Branch if not
	sec
	return

40$:	clc			;Return with no errors...
	return

; Reference string address list for UNDERLINE options...

uswrsa:	.word	uswb, uswn, usws, 0

; Reference strings for options...

	.nlist	bex
uswb:	.asciz	/BACKSPACE/
uswn:	.asciz	/NONE/
usws:	.asciz	/SIMULATED/
	.list	bex
	.even

; UNDERLINE switch text address list...

uswsta:	.word	rnusrb, rnusrn, rnusrs
; Address lists, tables, text for RNO command...

	.nlist	bex
rnpmt:	.ascii	"Input File? "<200>
rnotxt:	.asciz	"R RUNOFF"
deftxt:	.asciz	"LP:"
eqlsin:	.asciz	"="
uarowc:	.byte	3,0

; Reference strings for switches:

rnob:	.asciz	/BEGIN/
rnosta:	.asciz	/START/
rnod:	.asciz	/DEFAULTS/
rnoe:	.asciz	/END/
rnof:	.asciz	/FORMLENGTH/
rnohy:	.asciz	/HYPHENATION/
rnonhy:	.asciz	/NOHYPHENATION/
rnoi:	.asciz	/INFORMATION/
rnoh:	.asciz	/HELP/
rnooly:	.asciz	/ONLY/
rnoout:	.asciz	/OUTPUT/
rnopag:	.asciz	/PAGE/
rnoprn:	.asciz	/PRINTER/
rnos:	.asciz	/STRIP/
rnons:	.asciz	/NOSTRIP/
rnotrm:	.asciz	/TERMINAL/
rnou:	.asciz	/UNDERLINE/
rnonu:	.asciz	/NOUNDERLINE/
rnov:	.asciz	/VERSION/
rnow:	.asciz	/WAIT/

; Switch text for output:

rnbsrs:	.asciz	"/B:"
rndsrs:	.asciz	"/D"
rnesrs:	.asciz	"/E:"
rnfsrs:	.asciz	"/F:"
rnhsry:	.asciz	"/H:YES"
rnhsrn:	.asciz	"/H:NO"
rnisrs:	.asciz	"/I"
rnssrs:	.asciz	"/S"
rnusrb:	.asciz	"/U:B"
rnusrl:	.asciz	"/U:L"
rnusrn:	.asciz	"/U:N"
rnusrs:	.asciz	"/U:S"
rnvsrs:	.asciz	"/V"
rnwsrs:	.asciz	"/W"
	.list	bex
	.even
; Switch reference string address list:

rnsrsa:	.word	rnob,   rnod,   rnoe,   rnof,   rnoh
	.word	rnohy,  rnoi,   rnonhy, rnons,  rnonu
	.word	rnooly, rnoout, rnopag, rnoprn, rnosta
	.word	rnos,   rnotrm, rnou,   rnov,   rnow
	.word	0

; Switch execution address list:

rnseal:	.word	stxotx, rndefr, stxotx, stxotx, stxoly
	.word	stxoly, stxoly, stxoly, swbits, stxoly
	.word	rnolyr, rnoutr, rnolyr, rnprnr, stxotx
	.word	stxoly, rntrmr, rnuswr, stxoly, stxoly

; Switch status bit list:

rnssbl:	.word	1, 2, 1, 1, 4
	.word	1, 4, 1, 1, 1
	.word	1, 2, 1, 2, 1
	.word	1, 2, 1, 4, 1

; Switch text address list:

rnstxa:	.word	rnbsrs, rndsrs, rnesrs, rnfsrs, rnisrs
	.word	rnhsry, rnisrs, rnhsrn, 0,      rnusrn
	.word	0,      0,      0,      0,      rnbsrs
	.word	rnssrs, 0,      rnusrl, rnvsrs, rnwsrs

; Argument list for SWTCHS call:

rnalst:	.word	rnsrsa
	.word	rnseal
	.word	rnssbl
	.word	rnstxa

; Jump table for results of switch parsing:

	.word	badopx
	.word	cnfswx
	.word	badswx
	.word	ambswx
rnovec:	.word	rnook
.endc
