.Title	UclCvl - Charleville UCL facility with Macros
.Dsabl	gbl
.Nlist	bex

					.psect
					.psect	mesage	con
vermes:	.asciz	/UCL (Aust) V4a 9-Aug-86 ($HELP is the help command)/
					.psect

.Sbttl	V4a	9-Aug-86
;%9 Allow UCLCVL to chain to DEC or (if TSX) S & H UCL if it does not
;%9 recognize a command.  This may be disabled/enabled by $[NO]DEC.
;%9 Change UDEFIN to UCLDEF as it looks less ugly!
;%9 Add $[NO]CVL to enable/disable use of this UCL
;%9 Add tt CURON/CUROFF

.Sbttl	V4	28-Jul-86
;%8 Change TSX to use a local region "UCL" for its data storage rather than
;%8 a disc file, and to use UCL:NAME.TMP (or DK:NAME.TMP if no UCL device)
;%8 for temporary output if insufficient room in the KMON chain area.
;%8 Scrub all the control-C trapping.
;%8 Make $reset reset $ffile and the timer to zero.

.Sbttl	V3D	11-Mar-86
;%7 Change TSX to use user name (default XXXXXX) for both UCL & TMP file
;%7 Add debugging commands $TFILE & $FFILE
;%7 Make TT CLEAR (& TT default) also set TT ASCII
;%7 Add interlock for TSX, and multiple TIMER slots for different jobs.
;%7	Include ^C trap in interlock.

.Sbttl	V3C	17-Feb-86
;%6 Add UDEF, UDEFIN [later UCLDEF] (== DEF, DEFINE) for TSX-plus version 6
;%6 (the old commands still work from a command file)

.Sbttl	V3B	8-Feb-86
;%5 Restore default RU SY: in TRYTAB sequence for TSX, which doesn't!
;%5 Add IFTSX, IFRT
;%5 Add HELP message

.Sbttl	V3A	2-Nov-85
;%4 Bug fixes to TSX code
;%4 Add RESET command

.Sbttl	V3	26-Jun-84
;%3 Add TSX support
;%3 Correct bug in date rollover
;%3 Add DEFLIN

.Sbttl	V2A	 7-Mar-84
;%2 Bugs in TT area (tt noorigin, <cr> after help message)

.Sbttl	V2	 5-Feb-84
;%1 Add IFIN and IFNIN
;%1 Add DEF for temporary definitions
;%1 Add ability to insert control characters
;%1 Add IFCSOK and IFCSER, and IFELSE
;%1 Fix bug in multi-line argument insertion
;%1 Fix bug which sent "^A" at end of DEFWRD listing with MACTYP or MACLST

.Sbttl	V1	19-Oct-83

; C G Wilson, 71 Galatea St, Charleville, Australia

.Mcall	.module
.module	uclcvl,3,2,title=no,audit=yes

.Mcall	.gtlin,.settop,.print,.ttyou,.exit,.csispc,.scca,.readw,.writw,.rctrlo
.Mcall	.ttyin,.csigen,.csispc,.lock,.unlock,.close,.wait,.enter,.purge
.Mcall	.date,.gtim,.gval,.fetch,.serr,.dstatus,.lookup,.twait,.chain

			.If eq 1
This programme provides a UCL (User Command Linkage) for RT-11 V5 with
macro facilities.  The order in which commands will be tried is:

	[RT-11 has already tried to run SY:filename]
	1) commands within table (DEFINE, DEFSTR, etc)
	2) macros defined by the user
	3) RUN DK:file.SAV
	4) @DK:file.COM
	5) @SY:file.COM
	6) EDIT DK:file
			.Endc

.Sbttl	Macro Definitions for Programme Use

.Macro	Type	arg		;Type a string to the user's terminal
	mov	r0,-(sp)
	.save
	.psect	mesage
	$$$=.
	.ascii	arg
	.restore
	.print	#$$$
	mov	(sp)+,r0
.endm	Type

.Macro	Error	arg		;Send an error message to the user's terminal
	call	ermsg
	ref	<'arg'>
.endm	Error

.Macro	Ref	string		;Provide a reference to a string
	.save
	.psect	mesage	con
	$$$=.
	.asciz	string
	.restore
	.word	$$$
.endm	Ref

.Macro	C	string,address,alter	;Provide clear command definitions
	.psect	mesage	con
	$$$=.
	.asciz	string
	.psect	cmtab$
	.word	$$$
	.psect	actab$
;;;    .if b alter		;%8 forget about ALTER
	.word	address
;;;    .iff
;;;	.word	address+1
;;;    .endc
	.psect	cmtab$
.endm	c

.Macro	T	cmd,string	;Define TT commands
	.psect	tcmd
	.asciz	/cmd/
	.psect	ttab
	.ascii	string'<200>
	.psect
.endm	T

.Macro	Ts	ext,prefix,comand ;Table for selection of actions
	.word	1
	.if b ext
		.word	0
	.iff
		.rad50	/ext/
	.endc
	.if b prefix
		.word	0
	.iff
		.word	prefix
	.endc
	.word	comand
.endm	Ts
.Sbttl	Miscellaneous Definitions

;Types of macros

m.norm=0	;Normal macro
m.temp=1	;Temporary macro
m.tty=2		;String to be typed
m.bad=3		;Swear word
m.word=4	;Single word substitution
m.line=5	;Single line substitution

;Characters:

tab=11
lf=12
ff=14
cr=15
esc=33
larrow='<
rarrow='>
semic=73		;Semicolon
space=40		;Guess?

jsw=44			;Job Status Word.
 b.ttlc=40000		; TT lower case (why isn't it always?)
 b.kmon=4000		; Exit passing string to KMON.
 b.ovl=1000		; Set if job (appears to be) overlayed.
 b.chn=400		; Set if job chained to.
 b.spx=40		; Set for passing KMON string to allow nesting

sysptr=54		;Monitor base pointer
 l.cfg=300		;Offset to first configuration word
  b.clok=40		;Set in config word if 50 Hz clock

errbyt=52		;Monitor error byte

userrb=53		;User error byte
 warn$=2		; Warning	-I-
 error$=4		; Error		-E-
 sever$=10		; Severe error	-F-
 fatal$=20		; Fatal error	-U-

	.asect
.=42
.word	1000		;Stack pointer

.=jsw			;Make job appear to be overlayed to make channel
.word	b.ovl!b.ttlc	; 17 set up for I/O to programme file.

	.psect			;General programme psect
	.psect	data	con	;Data area
	.psect	mesage	con	;Message strings
	.psect	tcmd	con	;TT commands
tcstrt::
	.psect	ttab	con	;TT strings corresponding to TT commands
tsstrt::
	.psect	data

;Pointers to dynamically allocated storage

outbuf::0			;Output buffer
inbuf::	0			;Input buffer
tmpbuf::0			;Temporary macro buffer
tmpend::0			;End of TMPBUF
maclin::0			;Macro - another temporary buffer
asmlin::0			;Macro final line assembly buffer
line::	0			;For input line.

;Other storage

linpnt::0			;Pointer within input line.
cmdlin::.blkb	8.		;Receives command word or macro name.
wdelim::0			;Word delimiter.

outpnt::0			;Pointer for output block
outcnt::0			;Count, ibid
outblk::0			;Block number for output
outfil::.rad50	/sy ucl   tmp/	;Output file if too much for KMON area	
outcmd::.asciz	/@sy:ucl.tmp/	;Command string if RT

outtmp:	.rept	15.		;Block in which output command assembled prn
	0			;(RT=@sy:ucl.tmp; TSX=@ucl:name.tmp)
	.endr

tsxflg:	0			;Non-zero if running under TSX

inpnt::	0			;Pointer for input block
incnt::	0			;Count, ibid
inblk::	0			;Block number for input
				; ($tfile & $ffile commands)
chgmac::0			;Set non-zero if macro buffer area altered.

limit::	.limit			;Low & high job memory limits at start.

files::	.blkw	15.		;CSISPC block, output files -
filein::.blkw	24.		; and the input files.

defext::.rad50	/sav/		;For trying to run files.
zdefext:.word	0,0,0,0
fdefext:.rad50	/uclucl      /	;For UCLCOM and MACLST commands.

area::	.blkw	7		;General EMT area
tsw::	0			;For SCCA
timblk::.blkw	2		;For timer functions
.Sbttl	Command and action tables

	.psect	actab$
actab::
	.psect	cmtab$
cmtab::

c </UCLCOM/>,uclcom,alter	;Read a command file
c </DEFINR/>,definr,alter	;Define a macro regardless of previous define
c </DEFINE/>,define,alter	;Define a macro
c </UCLDEF/>,define,alter	;ibid, tsx-+
c </DEF/>,def,alter		;Define a temporary macro
c </UDEF/>,def,alter		;ibid, tsx-+
c </DEFWRD/>,defwrd,alter	;Define a word
c </DEFSTR/>,defstr,alter	;Define a terminal string
c </DEFLIN/>,deflin,alter	;Define a command to be followed by a line
c </DEFBAD/>,defbad,alter	;Define a swear word (sigh)
c </PURGE/>,purge,alter		;Purge a macro
c </MACTYP/>,mactyp		;Tell details of macros to terminal
c </MACLST/>,maclst		;List macros to output file
c </TT/>,tt			;TT commands for VT100.
c </TTY/>,tty			;Simply type string to tty.
c </PAUSE/>,pause		;Wait for user action.
c </ERROR/>,error		;Set user error byte values
c </TIMER/>,timer		;Timer functions
c </EXIT/>,exit			;Exit, for running in command mode.
c </FUCK/>,fswear		;Dungeon strikes again.
c </$RESET/>,reset,alter	;Reset UCL to empty (not if chained to)
c </$TFILE/>,tfile,alter	;%6 Force file output
c </$FFILE/>,ffile,alter	;%6 Allow normal chain if room
c </$DEC/>,decon,alter		;%9 Allow chaining to DEC UCL
c </$NODEC/>,decoff,alter	;%9 Disallow above
c </$CVL/>,cvlon,alter		;%9 Allow UCLCVL
c </$NOCVL/>,cvloff,alter	;%9 Disallow UCLCVL
c </$HELP/>,help		;%5 Type help text specific to UCLCVL

.word	0			;Terminate table

.Sbttl	 Prompts

	.psect	mesage

cmprmt::.ascii	/#/<200>	;Command prompt

lnprmt::.ascii	/>/<200>	;Prompt for additional lines.
.Sbttl	Help Text

.macro	x string
.if b <'string'>
.byte	cr,lf
.iff
.ascii	|'string'|<cr><lf>
.endc
.endm
	.psect	mesage
hmes1::
x
x <Commands built into UCLCVL are:>
x
x <UCLCOM file	Read a file of definitions for UCLCVL>
x <UCLDEF		Define a macro (error returned if previously defined)>
x <DEFINR		Define a macro, regardless of a previous definition>
x <UDEF		Define a temporary macro>
x <DEFWRD		Define a single word>
x <DEFSTR		Define a string to be typed>
x <DEFLIN		Define a single line command>
x <DEFBAD		(Forget it!)>
x <PURGE name	Delete a macro (if name omitted, purge temporaries)>
x <MACTYP name	Type a particular macro>
x <MACLST file	Send the complete set of macros currently defined to the file>
x <TT		Set characteristics of VT100-type terminals>
x <TTY string	Type the string (even if SET TT QUIET)>
x <PAUSE		Wait for the user to type a RETURN>
x <ERROR		Set the user error flag in monitor>
x <TIMER		Start/stop/read a timer>
x <$RESET		Clean out the WHOLE macro table>
x <$TFILE		Use temp file if necessary>
x <$FFILE		Force temp file every time>
x <$DEC/$NODEC	Allow/disallow chaining to DEC UCL>
x <$CVL/$NOCVL	Allow/disallow use of this UCL>
.byte	200

hmes2:
x <Defining a macro:>
x <---------------->
x <	.ucldef name arg1, arg2, ... argn { lines>
x <	of arg1 commands>
x <	for arg2 purposes }>
x <eg>
x <	.ucldef rno file {>
x <	r runoff>
x <	file=file>
x <	^C   (this is up-arrow, C, and will be used as control-C)>
x <	}>
x
x <Error levels:>
x <------------>
x <ERROR	warn, error, severe, fatal>
x
x <Timer options:>
x <------------->
x <TIMER	zero		Clears timer>
x <	reset		Types present timer value then clears it>
x <			[No option merely types value since last>
x <			zero or reset]>
.byte	0

hmes3:
x <VT100 Terminal Options:>
x <---------------------->
x <80, 132, dark, light, clear, vt52, vt100, origin, noorig>
x <jump, smooth, reset, ascii, uk, graph, altchr altgrp, number>
x <applic, cursor, curapp, nv, rv, bold, blink, us, fv, scroll>
x <leds, awrp, nwrp, arpt, nrpt, curon, curoff>
x
x <"IF" options:>
x <------------>
x <ifbl,   ifnbl  {arg1}{arg2}		Include arg2 if arg1 (not) blank>
x <ifcsam, ifcnsa {arg1}{arg2}{arg3}	Include arg3 if first chars of arg1>
x <					and arg2 are (not) same ignoring case>
x <ifsam,  ifnsam {arg1}{arg2}{arg3}	Include arg3 if arg1 and arg2 are>
x <					(not) the same ignoring case>
x <ifidn,  ifnidn {arg1}{arg2}{arg3}	Include arg3 if arg1 and arg2 are>
x <					(not) identical>
x <ifscok, ifcser {arg1}{arg2}		Include arg2 if arg1 used as CSI>
x <					string returns ok (error)>
x <ifin,   ifnin  {arg1}{arg2}{arg3}	Include arg3 if arg1 is (not)>
x <					contained within arg2 (ignoring case)>
x <iftsx {arg1}				Include arg1 if running under TSX>
x <ifrt {arg1}				Ibid, not under TSX>
.byte 0

hmes4:
x <System Macros:>
x <------------->
x <sxdd, sxmm, sxyy	Day, month, year (two digits each)>
x <sxm			Month, as a hex digit>
x <sxhr, sxmn, sxsc	Hour, minute, second (two digits each)>
x
.byte 0
.Sbttl	Macro Storage Information
				.If eq 1
MACRO STORAGE:
-------------

The macros are stored in MACBUF sequentially in order of definition,
from the lowest address up.

The format is:
		.word		pointer to next defined macro
		.blkb	6	name of macro (in upper case)
		.blkb	1	flag word: 0 if normal, 1 if type, 2 if swear.
		.blkb	n	text of macro, with nulls as end of lines,
				arguments as bytes of <200+argument #>
				(ie first arg = 201, etc),
				and a <377> byte terminates the macro.

MACPNT points to the next available macro area.  The first word in MACBUF
starts the pointer list to the macros.



MACRO EXPANSION:
---------------

Macro expansion is done above the programme memory image.  Each macro called
is expanded fully with its arguments (to allow nested macros).
Three pointers are used: MACIPT, which points to the next character
position for programme input, and is stored prior to each argument list
for each new macro expansion; MACTOP, which points to the top of the macro
expansion area; and MACBOT, which points to the current bottom of the
available macro expansion area.

A further byte has been added to facilitate the IFELSE command (MACIFB).
This may have either the value 0 (last IF test failed) or 1 (successful).
It is stored as a byte with each expansion, to attempt to allow some form
of structuring (? stricturing) of macro use.

The pattern of usage for macro expansions is:

	(0)	.word	0 (pointer word, rubbish first one for MACBOT links)

	(2)	.word	old version of MACIPT (zero on first one)
	(4)	.byte	old version of MACIFB (macro last IF byte)
	(5+)	bytes of arguments for this macro, each <177> terminated,
			with a <200> after the last <177>.
		bytes of expanded macro text, null terminating each line.
		byte of <-1> (two of them if required to make even word
			boundary)
		.word	old version of MACBOT (points to top null on first)
				.Endc
.Sbttl	Macro Storage Area

.psect	data

.Sbttl	(MACSIZ word buffer)
.Iif ndf macsiz, macsiz==2000.	;Size of macro buffer in words

Macipt::0			;Macro insertion pointer
Macifb::0			;Macro "last IF result" (0=fail, 1=success).
Mactop::0			;Macro expansion top
Macbot::0			;Macro expansion bottom
Brccnt::0			;Brace depth, for embedded raw strings.

.asect				;PUT STARTING AT LOC 1000 FOR EASE OF DISC I/O
.=1000				;*********************************************

Macpnt::.word	macbuf		;Pointer to place for next macro to go.
Macbuf::0			;Macro buffer itself
	.rept	macsiz		;Have to do it this way or monitor bitmap
	.word	0		;(in locs 360-377 of .SAV file) has blocks
	.endr			;marked as unused!
Macend::.blkw	5		;End of macro buffer (room for error)
Fileon::.word	0		;Non-zero if forcing file output
Decucl::.word	0		;Non-zero if forbidding chaining to DEC UCL
Cvlucl::.word	0		;Non-zero if forbidding use of UCLCVL

Oldtim::0,0			;Time timer was last zeroed

macroom=<<<.-macpnt>+777>/1000>*1000	;Area involved in file block
					; in even block quantities.
macread=<.-macpnt>			;Area to be read should not include
					; programme (under TSX).
.iif gt macread-8190., .error		;Can't exceed one PAR region
.Sbttl	Start of Programme

.Enabl	lsb
	.psect
Start::
	.serr			;(Needed on TSX checking, or get ILL EMT)

				;INITIALIZE MACRO DATA AREA
	mov	limit+2,r0	;Initial high limit
	mov	r0,outbuf	;Output buffer pointer
	add	#1000,r0	;1000 bytes long.
	mov	r0,inbuf	;Input buffer pointer, same length (1 block)
	add	#1000,r0
	clr	inpnt		;So know there's not an input file yet.
	mov	r0,tmpbuf	;Temp buffer for macro argument assembly
	add	#84.,r0
	mov	r0,tmpend	;Store end of temp buffer for checking.
	mov	r0,line		;Terminal input line
	add	#84.,r0
	mov	r0,maclin	;Macro line assembly buffer
	add	#100.,r0
	mov	r0,asmlin	;Macro final line assembly buffer
	add	#100.,r0
	mov	r0,macbot	;Bottom of macro expansion area
	.lock			;Grab USR so leave room for it to swap
	.settop	#-2
	mov	r0,mactop	;Top thereof.
	.unlock

	mov	mactop,r0	;See that we have some room!
	sub	macbot,r0
	bcs	nomem		;Whoops.
	cmp	r0,#1000	;Minimum allowable
	bhi	20$
Nomem:
	error	</Insufficient memory/<0>>
	.exit
20$:
	call	datim		;Set up date & time system macros

	call	tsxset		;Set up for TSX if operating under it.

	call	chkucl		;%9 See if allowed to use this UCL or not
				;%9 (have to do this AFTER tsxset!)
	clr	chgmac		;No changes to macro area - yet!
	bit	#b.chn,@#jsw	;Chained to?
	beq	comand		;No - command mode.
	tst	@#510		;Yes.  Anything to decode?
	bne	30$		;Command to decode.
vertyp::
	.print	#vermes
	clr	@#510
	jmp	comand
30$:
	mov	@#510,r0	;Count of user's bytes
	mov	#512,r1		;Start of them
	mov	line,r2		;Normal command line
40$:	movb	(r1)+,(r2)+
	dec	r0
	bne	40$
	clrb	(r2)		;Put into line buffer, null terminated.
	clr	@#510		;No command for .EXIT to take on, so far...
	br	cmd1
.Dsabl	lsb
.Sbttl	Rerun - Run Through Again if Not Chained To

Rerun::
	mov	#1000,sp	;Just in case?
	bit	#b.chn,@#jsw	;Chained to?
	beq	comand		;No - just keep going.
	tst	inpnt		;Running from a command file?
	bne	comand		;Yes - keep going here also.
	call	wrtmac		;Rewrite macro area pro re nata.
	tst	@#510		;No alterations.  Any command for execution?
	beq	10$		;No.  Just exit.
	bis	#b.kmon!b.spx,@#jsw	;Yes - tell Kmon
	clr	r0
10$:	.exit

Exit::
	call	wrtmac
	.exit


.Sbttl	.	Wrtmac - Rewrite Macro Area to SAV file

.Enabl	lsb

Wrtmac::
	tst	chgmac
	beq	10$
	tst	tsxflg
	bne	5$
	.writw	#area,#17,#1000,#macroom/2,#1
	bcc	10$
	error	</Error Rewriting Macro & Timer Information/<0>>
	br	10$
5$:	call	wrtsx
10$:	clr	chgmac
	return

.Dsabl	lsb


.Sbttl	.	Ermsg - Type error messages, setting bit for KMON

Ermsg::
	mov	r0,-(sp)
	.rctrlo
	type	</?UCLCVL-E-/<200>>
	.print	@2(sp)
	clr	inpnt		;Abort command file
	bisb	#error$,@#userrb
	clr	@#510		;Scrub any KMON commands set up.
	mov	(sp)+,r0
	add	#2,(sp)
	return
.Sbttl	Read a command

.Enabl	lsb

Comand::			;READ A COMMAND FROM THE USER
	tst	inpnt		;From a command file?
	beq	40$		;No - from the terminal.
10$:
	call	inlin
	bcc	20$
	  clr	inpnt		;End of command file.
	  br	rerun
20$:	bit	#b.chn,@#jsw	;Don't type lines if chained to.
	bne	30$
	.print	#cmprmt		;Type input lines with prompts.
	.print	line
30$:	tstb	@line		;Blank lines in command files are ignored.
	beq	10$
	br	cmd1
40$:
	.rctrlo
	.gtlin	line,#cmprmt	;From terminal.
	tstb	@line		;Blank?
	bne	cmd1
	  jmp	vertyp		;Yes - type version message.
cmd1:
	mov	line,linpnt
	clr	macipt		;Get input from TT, not stray remnants of
	clr	macifb		; macros, and clear "last IF result" flag.
	cmpb	@linpnt,#'!	;Allow comments if they begin with "!"
	bne	44$		; but only at command level.
	  jmp	rerun
44$:	cmpb	@linpnt,#'@	;Allow "@file" == "uclcom file" for
	bne	45$		; convenience at command level.
	  inc	linpnt
	  jmp	uclcom
45$:
	clr	r1		;Haven't first char for wrdget.
	call	wrdget		;Get first word of line into CMDLIN

	mov	#cmtab,r2
	clr	r3
50$:
	mov	#cmdlin,r0	;User's typed line
	mov	(r2)+,r1	;Next possible command

	call	scmp		;Compare r0 & r1 strings
	beq	hvcmd		;Found.
60$:	inc	r3
	tst	(r2)		;Try next possible command
	bne	50$
	jmp	trymac		;Invalid command - try macro name.

.Dsabl	lsb

Hvcmd::				;HAVE A COMMAND - GO AND EXECUTE IT
	asl	r3
	jmp	@actab(r3)
.Sbttl	Define a Macro - DEFINR, DEF (UDEF), DEFINE (UCLDEF), DEFSTR, DEFBAD

.Enabl	lsb

Definr::			;Define regardless
	clr	r1
	call	findmcn
	bcs	10$
	tst	r1		;See if IF or SX
	beq	70$		;Whoops.
	call	purg1		;Purge it if it exist.
10$:	mov	#m.norm,r5	;Normal macro
	br	60$

Def::				;Temporary macro
	clr	r1
	call	findmcn		;See if already existing
	bcs	20$		;No.
	cmpb	10(r1),#m.temp	;Yes - make sure it's a temporary only
	bne	50$		;(Error otherwise)
	call	purg1
20$:	mov	#m.temp,r5
	br	60$


Define::			;Macro proper
	mov	#m.norm,r5
	br	30$
Defstr::			;String to be typed to terminal
	mov	#m.tty,r5
	br	30$
Defbad::			;Swearing - ignore rest of macro.
	clr	r1
	call	findmcn
	bcc	40$
	mov	#'{,wdelim	;Pretend delimited by "{"
	mov	#swdef,linpnt
		.psect	mesage
swdef:		.asciz	/}/
		.psect
	mov	#m.bad,r5	;Flag as swear word.
	br	60$

Defwrd::			;Define a single word substitution
	mov	#m.word,r5
	br	30$

Deflin::			;Define a command to be followed by a line
	mov	#m.line,r5
30$:
	clr	r1
	call	findmcn		;See if already have macro
	bcs	60$		;No - ok to put it in.
40$:
	cmp	cmdlin,#"IF	;Check for trying to overwrite conditionals
	beq	70$
	cmp	cmdlin,#"SX	; or system macros
	beq	70$
50$:
	error	</Macro exists - Please PURGE before replacing: /<200>>
	br	80$
60$:
	call	macget		;Error messages typed within macget.
	inc	chgmac		;Macro area altered.
	jmp	rerun

70$:
	error	</Macro Name Illegal (May not commence with IF or SX): /<200>>
80$:	.print	#cmdlin
	jmp	rerun

.Dsabl	lsb


.Sbttl	$RESET the whole of UCL

;Due to the preceding "$", which is not passed across from monitor, this
; command can only be executed in non-chained mode (for safety!).
;Mind you, in TSX-plus it gets straight across.  C'est la vie!

reset::
	mov	#macbuf,macpnt	;Point to first spare space in buffer
	clr	macbuf		; which then points to nothing.

	clr	fileon		;%8 Clear $ffile
	.gtim	#area,#oldtim	;%8 Reset timer to zero

	clr	decucl		;%9 Allow chaining to DEC ucl
	clr	cvlucl

	inc	chgmac
	jmp	rerun
.Sbttl	PURGE a Macro

.Enabl	lsb

Purge::
	tstb	wdelim		;Any arguments?
	beq	purtmp		;No - purge temporary macros only.

	clr	r1
	call	findmcn
	bcc	10$
	tst	inpnt		;No error message if do this from command file
	bne	20$
	tst	cmdlin		;Ignore null names.
	beq	20$
	type	</?UCL-W-Macro not found to purge - /<200>>
	.print	#cmdlin
	br	20$
10$:
	call	purg1
20$:
	tstb	wdelim		;Any more?
	bne	purge		;Might be.
	jmp	rerun

.Dsabl	lsb


.Sbttl	.	Purtmp - Purge temporary macros

Purtmp::
	mov	#macbuf,r1	;Start of macro chain
	br	20$
10$:
	mov	(r1),r1		;Look at next macro
20$:	tst	(r1)
	beq	60$		;End of the whole lot.
	cmpb	10(r1),#m.temp	;Temporary?
	bne	10$

	bit	#b.chn,@#jsw	;Yes - scrub it, typing its name if not
	bne	50$		; chained to.

	mov	r1,-(sp)
	mov	#6,-(sp)
	tst	(r1)+
30$:	movb	(r1)+,r0
	beq	40$
	.ttyou
	dec	(sp)
	bne	30$
40$:	call	tcrlf
	tst	(sp)+
	mov	(sp)+,r1

50$:
	call	purg1		;Purge the macro
	br	20$
60$:
	jmp	rerun


.Sbttl	.	Purg1 - Purge one macro, pointed to in R1

Purg1::
	mov	r0,-(sp)
	mov	r1,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)
	mov	r4,-(sp)

	tst	r1		;If conditional, R1/0
	beq	50$		; & don't do anything.

	mov	(r1),r2		;r1 - shuffling to, r2 - shuffling from
	mov	r2,r3
	sub	r1,r3		;Distance shuffling
	mov	r2,r4		;Pointer to next macro
20$:
	mov	(r4),r0		;End of linked list?
	beq	30$		;Yes - pointers all reset.  Shuffle.
	sub	r3,(r4)
	mov	r0,r4
	br	20$
30$:
	mov	macpnt,r4	;Top of shuffling region
	sub	r3,macpnt
40$:
	mov	(r2)+,(r1)+	;Shuffle all above down.
	cmp	r2,r4
	blos	40$

	inc	chgmac		;Macro area altered
50$:
	mov	(sp)+,r4
	mov	(sp)+,r3
	mov	(sp)+,r2
	mov	(sp)+,r1
	mov	(sp)+,r0

	return
.Sbttl	Read from a Command File - UCLCOM

.Enabl	lsb

Uclcom::
	call	ltrim		;Read name of input file
	mov	linpnt,r2	;Get pointer to filename
	dec	r2

	mov	sp,r1
	.csigen	macbot,#fdefext,r2
	mov	r1,sp
	mov	r0,macbot
	.wait	#3		;Input file area
	bcc	10$

	error	</Illegal Command File: /<200>>
	.print	r2
	jmp	rerun
10$:
	mov	inbuf,inpnt
	clr	incnt
	clr	inblk
	jmp	rerun

.Dsabl	lsb


Inlin::				;READ A LINE FROM THE COMMAND FILE.
	tst	incnt
	bpl	10$
	sec			;EOF on reading previous line.
	return
10$:
	mov	r2,-(sp)
	mov	line,r2
20$:
	call	inchr
	bcs	30$		;Make sure he gets last line even if no crlf.
	tstb	r1		
	beq	20$		;Ignore nulls.
	cmpb	r1,#cr
	beq	40$		;End of line.
	movb	r1,(r2)+
	br	20$
30$:
	mov	#-1,incnt	;Signify end of file for next call to inlin.
40$:
	call	inchr		;(Assume <cr><lf>)
50$:
	clrb	(r2)
	mov	(sp)+,r2
	return
	

Inchr::				;READ A CHARACTER FROM THE COMMAND FILE
	dec	incnt
	bmi	10$
	movb	@inpnt,r1
	inc	inpnt
	clc
	return
10$:
	.readw	#area,#3,inbuf,#400,inblk
	bcs	20$
	mov	#1000,incnt
	mov	inbuf,inpnt
	inc	inblk
	br	inchr
20$:
	cmpb	@#errbyt,#1
	beq	30$
	sec
	return
30$:
	error	</Error Reading Command File/<0>>
	clr	inpnt
	jmp	rerun
.Sbttl	Type Details of a Macro - MACTYP

.Enabl	lsb

Mactyp::
	mov	#ptt,r5		;Output to terminal from MACTEL
	br	90$

Tell1::
	clr	r1
	call	findmcn
	bcs	80$

	tst	r1		;Either IF or SX
	bne	70$

	cmp	cmdlin,#"IF	;Ignore IF's
	beq	90$		;If not IF, must be SX

	call	macput
	type	</System Macro /<200>>
	mov	#cmdlin,r1
20$:	movb	(r1)+,r0
	beq	30$
	.ttyou
	br	20$
30$:
	type	</ {/<200>>
40$:
	call	fin
	bcs	60$		;End of expanded SX macro
	mov	r1,r0
	beq	50$
	.ttyou
	br	40$
50$:	call	tcrlf		;Null = crlf
	br	40$
60$:	type	</}/<0>>
	br	90$


70$:				;Normal macro for printing.
	call	prnmac
	br	90$
80$:
	tst	cmdlin
	beq	90$
	error	</Macro not found - /<200>>
	.print	#cmdlin
90$:
	tstb	wdelim		;Any more?
	bne	tell1		;Could be.

	type	<<cr><lf><lf>/Number of free bytes: /<200>>
	mov	#macend,r0
	sub	macpnt,r0	;Calculate # free bytes.
	mov	#ptt,r5		;Output to terminal
	call	pwd
	call	tcrlf
	jmp	rerun

.Dsabl	lsb
.Sbttl	List all Macros to a File - MACLST

.Enabl	lsb

Maclst::
	mov	#ptt,r5		;If MACLST alone, use TT output.
	tstb	wdelim
	beq	20$

	mov	#pfil,r5	;Output to output file
	call	ltrim		;Get filename
	dec	linpnt		;(use input line area)
	mov	linpnt,r1
10$:	tstb	(r1)+		;Skip to end of line, and put "=<nul>"
	bne	10$		; for CSI use.
	movb	#'=,-1(r1)
	clrb	(r1)

	mov	sp,r1
	.csispc	#files,#defext,linpnt
	mov	r1,sp
	bcs	15$
	.fetch	macbot,#files
	bcs	15$
	mov	r0,macbot
	.purge	#16
	.enter	#area,#16,#files,files+10
	bcc	20$
15$:	  error	</Cannot write requested MACLST file/<0>>
	  jmp	rerun
20$:
	clr	outblk		;Set up output block number, and
	call	pset		; parameters.
	mov	#macbuf,r1	;Start of linked list of macros
30$:
	tst	(r1)
	beq	40$		;End of linked list
	call	prnmac
	mov	(r1),r1
	br	30$
40$:
	cmp	r5,#ptt		;Are we sending to the terminal?
	beq	70$		; Yes - no file handling.

	clr	r0		;Send nulls till buffer written
50$:	cmp	outcnt,#1000
	beq	60$
	call	(r5)
	br	50$
60$:
	.close	#16
70$:	jmp	rerun

.Dsabl	lsb
.Sbttl	Expand and use a Macro

.Enabl	lsb

Trymac::
	call	findmac
	bcc	10$
	  jmp	notmac
10$:
	call	macput
	tst	r1		;See if conditional rather than true macro
	bne	15$
	cmp	cmdlin,#"SX	;If system macro, just type it.
	bne	usemac		;Conditional - use it.
12$:	call	type1l		;System - type it
	bcc	12$		;(Allow for the fact that we might expand
	call	tcrlf		; system macros later)
	jmp	enduse

15$:
	cmpb	10(r1),#m.norm	;See what type of macro
	beq	usemac		;Normal
	cmpb	10(r1),#m.temp
	beq	usemac		;Temporary
	cmpb	10(r1),#m.word
	beq	usemac		;Word substitution?
	cmpb	10(r1),#m.line
	beq	usemac		;Command plus line?
	cmpb	10(r1),#m.tty
	beq	20$		;String to type?
	  jmp	swear		;Swearing at us, is he?

;String to be typed to the terminal.

20$:
	call	type1l		;Type a line, with macro conversion prn.
	bcs	40$
	cmpb	r1,#'|		;May however have vertical bars here.
	bne	30$
	.ttyou	r1
30$:	br	20$
40$:	jmp	rerun

.Dsabl	lsb


;Ordinary Macro -
; use expanded macro, expanding macros called therein as encountered.

.Enabl	lsb

Usemac::
	.purge	#16		;Occasionally left in use when chaining!
	tst	macipt		;See if any actually available
	bne	10$		; (if unsatisfied IF, may be nothing)
	  jmp	rerun
10$:	mov	outbuf,outpnt	;See up output buffer details, in case
	mov	#1000,outcnt	; need for oversize command string.
	clr	r5		;<last char> marker (0=cr)

	tst	fileon		;Want to force file output?
	beq	usenxt		;No - let it take its course.
	mov	#700-510,@#510	;Yes - make him think the area's full

usenxt:
	call	fin
	bcs	enduse		;End of information.
	cmpb	r1,#'~		;Calling a macro?
	bne	40$

	call	fin		;See if just want line typed.
	cmpb	r1,#'~
	beq	typlin
30$:
	call	findmcn		;FIND A CALLED MACRO
	bcs	nomac
	call	macput
	br	usenxt
40$:
	tst	r1		;See if end-of-line.
	bne	45$		;No - no problems.
	tstb	r5		;Yes.  Was last time eol?
	beq	usenxt		;	Yes - no multiple blank lines thanks.
45$:	movb	r1,r5		;Hold for checking next character.

	bit	#b.chn,@#jsw	;Chained to?
	bne	60$		;Yes - use for KMON and don't print it.
				;No - type it to him.
	tst	r1		;Check for end of line
	bne	50$
	call	tcrlf		;If so, give him <cr><lf>
	br	usenxt
50$:
	cmpb	r1,#tab		;Tabs not treated as control characters
	beq	55$
	cmpb	r1,#40		;See if control character
	bhis	55$
	.ttyou	#'^
	add	#100,r1
55$:
	.ttyou	r1
	br	usenxt
60$:
	call	inschr		;Use character for KMON.
	br	usenxt

.Dsabl	lsb

Typlin::
	call	type1l		;Type one line.
	bcs	enduse		;End of macro.
	br	usenxt		;End of line


;Type one line to terminal

Type1l::
	call	fin		;TYPE LINE TO TERMINAL
	bcs	30$
	tstb	r1
	beq	20$
	cmpb	r1,#'~		;Want embedded macro?
	bne	10$
	  call	fin
	  bcs	30$
	  cmpb	r1,#'~		;Want ~ itself printed?
	  beq	15$
	  call	findmcn
	  bcs	nomac
	  call	macput
	  br	type1l
10$:
	cmpb	r1,#'|		;If vertical bar, terminate as per macro call
	beq	30$
15$:	.ttyou	r1
	br	type1l
20$:
	call	tcrlf
	clc
30$:	return

Nomac:
	error	</Undefined Macro Called: /<200>>
	.print #cmdlin
	call	tcrlf
	jmp	rerun

.Enabl	lsb			;END OF INSERTION/TYPING OF MACRO INFORMATION
				;--------------------------------------------
Enduse::			;End of insertion.
	tstb	r5		;See if have terminated command string
	beq	10$
	clr	r1
	call	inschr
10$:
	bit	#b.chn,@#jsw
	bne	20$		;If not chained to, just extra <cr><lf>
	  call	tcrlf		; then try again.
	  br	60$
20$:
	.wait	#16		;Using an output file?
	bcs	60$		;No.

	clr	r0
30$:	cmp	outcnt,#1000
	beq	40$
	call	pfil		;Fill buffer with nulls and send it.
	br	30$
40$:
	.close	#16

	mov	#outtmp,r0	;Set up @SY:UCL.TMP or @UCL:nnnnnn.TMP
	mov	#510,r1		; in KMON area
	mov	(r0)+,(r1)+
50$:	movb	(r0)+,(r1)+
	bne	50$
60$:
	jmp	rerun

.Dsabl	lsb
.Enabl	lsb

Inschr::			;Insert character into KMON area
	movb	r1,r0		;Put into output file area in case exceed
	bne	10$		; available KMON area.
	mov	#cr,r0		;Null gives <cr><lf> in command output file.
	call	pfil
	mov	#lf,r0
10$:	call	pfil

	cmp	@#510,#700-510
	bhi	30$
	bne	20$
	.enter	#area,#16,#outfil,#0	;Write commands to SY:UCL.TMP
	bcs	40$			;(if SY: needs a fetch, we're in
	br	25$			; trouble!)
20$:
	mov	@#510,-(sp)
	add	#512,(sp)
	movb	r1,@(sp)+
25$:	inc	@#510
30$:	return

40$:
	error	</Error writing SY:UCL.TMP or UCL:name.TMP/<0>>
	jmp	rerun
.Sbttl	Failed to Find a Macro - Try Other Possibilities

.Enabl	lsb

Notmac::
	mov	line,r1		;Put up to space or tab into ASMLIN for
	mov	asmlin,r2	; testing whether first segment is a valid
1$:				; CSI command.
	movb	(r1)+,r0
	beq	2$
	cmpb	r0,#space
	beq	2$
	cmpb	r0,#tab
	beq	2$
	movb	r0,(r2)+
	br	1$
2$:
	clrb	(r2)

	mov	sp,r1		;See if line is a valid CSI command line.
	.csispc	#files,#zdefext,asmlin
	mov	r1,sp
	bcs	illcmd
	tst	files		;Make sure no output file specification
	bne	illcmd
	tst	files+2
	bne	illcmd

	tst	filein+6	;See if deliberate extension
	beq	20$		;If not, try default sequence.

	mov	#trytab,r5	;Otherwise try to fit in with available
10$:				; actions within the table.
	tst	(r5)+		;End of list should be picked up below, but
	beq	illcmd		; leave it in for table hackers!

	tst	(r5)		;Up to null extension (default edit) in table?
	beq	40$		;Yes.
	cmp	filein+6,(r5)	;See if extensions match.
	beq	40$		;They do. Start at this point in table

	add	#6,r5		;Otherwise keep on trying.
	br	10$


20$:
	mov	#trytab,r5	;Now try the table in the order desired
30$:
	tst	(r5)+		;Null = end of table
	beq	illcmd
40$:
	mov	(r5)+,defext	;Default extension
	mov	tmpbuf,r2
	mov	(r5)+,r1	;Prefix before .CSIGEN
	beq	60$		; (none)
50$:
	movb	(r1)+,(r2)+
	bne	50$
	dec	r2
60$:
	call	tstfil		;See if the file exist or nay
	bcc	80$		;Yay.
70$:	tst	(r5)+		;Skip command pointer
	br	30$
80$:
	tst	filein+6	;Was an extension specified?
	beq	90$		;No - the default suffices.
	tst	-4(r5)		;See if up to null default filename.  At this
	beq	90$		; point anything goes.
	cmp	-4(r5),filein+6	;If not, check that it matches the one for
	bne	70$		; this particular action.  If not, try next.
90$:
	mov	(r5),r3		;String to prefix command with before exit
	mov	tmpbuf,r1

.Dsabl	lsb
.Enabl	lsb

Fixa::
	mov	#510,r2		;Area for commands for execution.  Count word.
	mov	r2,r1		;Get pointer for text.
	clr	(r1)+		;Clear count.
10$:
	movb	(r3)+,(r1)+	;Transfer prefix string
	beq	20$
	inc	(r2)
	br	10$
20$:
	dec	r1
	mov	line,r0		;Transfer user's line
30$:
	inc	(r2)
	movb	(r0)+,(r1)+	;(want to keep the null from here)
	bne	30$

	bit	#b.chn,@#jsw	;If not chained to, type the line.
	bne	40$
	.print	#512
40$:	jmp	rerun



Illcmd::
	tst	decucl		;%9 Allowing DEC UCL chaining?
	beq	50$		;%9 Yes

	error	</Illegal Command: /<200>>
	.print	line
	jmp	rerun
50$:
	mov	#500,r1
	mov	#^rSY,(r1)+
	mov	#^rUCL,(r1)+
	mov	#^rDEC,r0
	tst	tsxflg
	beq	60$
	mov	#^rSNH,r0
60$:	mov	r0,(r1)+
	mov	#^rSAV,(r1)
	.chain


.Dsabl	lsb

trytab::
	ts	sav,,rdk	;file.SAV	to	RU file
	ts	sav,tsy,rsy	;SY:file.SAV	to	RU SY:file	%5
	ts	com,,rda	;file.COM	to	@file
	ts	com,tsy,rsa	;SY:file.COM	to	@SY:file
;The default edit should probably be last in the list
	ts	,,rde		;file		to	RU SY:KED file
	0

	.psect	mesage
tsy:	.asciz	/SY:/
rdk:	.asciz	/RU /
rsy:	.asciz	/RU SY:/
rda:	.asciz	/@/
rsa:	.asciz	/@SY:/
rde:	.asciz	/RU SY:KED /
	.psect

.Dsabl	lsb

.Sbttl	.	TSTFIL - see if line is a valid CSI command

.Enabl	lsb

Tstfil::
	mov	asmlin,r1		;Use line up to space or tab
10$:	movb	(r1)+,(r2)+
	bne	10$
	mov	sp,r1
	.csigen	macbot,#defext,tmpbuf	;Use macro expansion buffer for
	mov	r1,sp			; handlers if needed.
	return

.Dsabl	lsb
.Sbttl	TTY - Type a line to the Terminal

TTY::
	call	ltrim		;Scrub leading spaces etc (go to next line
	mov	linpnt,r0	; if he just uses naked TTY)
	dec	r0
	.print
	jmp	rerun


.Sbttl	PAUSE - Wait for User Response

PAUSE::
	type	</Pause:/<200>>
10$:	.ttyin
	cmp	r0,#lf
	bne	10$
	jmp	rerun


.Sbttl	TCRLF - Type a <cr><lf> to the terminal

TCRLF::
	type	<<0>>
	return


.Sbttl	SCMP - Compare two strings pointed to in R0 and R1

SCMP::
	cmpb	(r0)+,(r1)+
	bne	10$
	tstb	(r0)
	bne	scmp
	tstb	(r1)
10$:	return			;Returns EQ if equal, NE otherwise.
.Sbttl	ERROR - Set user error bits

	.psect	mesage
Ertab:
	.asciz	/WARN/
	.asciz	/ERROR/
	.asciz	/SEVERE/
	.asciz	/FATAL/
	.byte	-1

Erval:
	.byte	warn$,error$,sever$,fatal$

	.psect

.Enabl	lsb

Error::
	clr	r1		;(no first char ready in r1)
	call	wrdget		;Check out next word.

	mov	#ertab,r4
	mov	#erval,r3
10$:
	tstb	(r4)
	bmi	40$		;End of list, and haven't found match.
	mov	#cmdlin,r0
	mov	r4,r1
	call	scmp
	beq	30$		;Have a match.
20$:
	tstb	(r4)+		;Skip to next possible option
	bne	20$
	inc	r3		; and next possible value.
	br	10$

30$:				;Found suitable ERROR command
	bisb	(r3),@#userrb
	br	50$

40$:
	error	</Unrecognized ERROR option: /<200>>
	.print	#cmdlin
50$:
	jmp	rerun

.Dsabl	lsb
.Sbttl	TIMER - Timer printing and zeroing facility

	.psect	data
Time50::
	.word	101,165400	;(=4,320,000) Ticks per day
	.word	2,137440	;(=180000) Ticks per hour
	.word	0,3000.		; per minute
	.word	0,50.		; per second.
Time60::
	.word	117,15000
	.word	3,45700
	.word	0,3600.
	.word	0,60.
Timtab:
	.word	hrs,mins,secs,0

	.psect	mesage
hrs:	.ascii	/ hour/<200>
mins:	.ascii	/ minute/<200>
lsec:	.ascii	/<1/
secs:	.ascii	/ second/<200>
	.psect

.Enabl	lsb

Timer::
	clr	cmdlin
	tstb	wdelim		;See if TIMER alone
	beq	timtyp		; Yes - type the time difference.

	clr	r1
	call	wrdget		;Otherwise check what he typed.
	mov	#cmdlin,r0
	mov	(pc)+,r1
	ref	</RESET/<0>>
	call	scmp
	beq	timtyp		;Reset - tells time then resets.

	mov	#cmdlin,r0
	mov	(pc)+,r1
	ref	</ZERO/<0>>
	call	scmp
	beq	timzero		;Zero - just zeroes time.

	error	</Illegal TIMER option: /<200>>
	.print	#cmdlin
	br	100$

Timtyp::
	.gtim	#area,#timblk

	sub	oldtim+2,timblk+2
	sbc	timblk
	sub	oldtim,timblk

	clr	r2		;For checking for zero time.
	mov	#timtab,r4	;Table of names of units (hours etc)
	mov	#ptt,r5		;For TT output from PWD

	mov	#time50+4,r3	;Get conversion factor for particular
	.gval	#area,#l.cfg	; machine (50 or 60 Hz)
	bit	#b.clok,r0
	bne	10$
	mov	#time60+4,r3
10$:
	clr	r0
20$:
	sub	2(r3),timblk+2	;Division by repeated subtraction
	sbc	timblk
	sub	(r3),timblk
	bmi	30$
	inc	r0
	br	20$
30$:
	add	(r3)+,timblk	;Have gone one too far here.
	add	(r3)+,timblk+2
	adc	timblk
	bis	r0,r2		;Check for all zero

	tst	r0		;If zero, don't print it.
	beq	60$

	call	pwd

	mov	r0,r1
	.print	(r4)		;Text with particular unit.

	cmp	r1,#1
	beq	50$
	.ttyou	#'s		;Make plural if not 1.
50$:
	tst	2(r4)		;Space between elements
	beq	60$
	.ttyou	#space
60$:
	tst	(r4)+
	tst	(r4)		;End of table?
	bne	10$
	
	tst	r2		;If nothing typed, put in
	bne	90$		; "<1 second"
	.print	#lsec
90$:
	call	tcrlf
	cmp	cmdlin,#"RE
	bne	100$		;If RESET, fall through to zeroing stored time

Timzero::
	mov	#oldtim,r1	;Put current time into OLDTIM or relevant
	.gtim	#area,r1
	inc	chgmac		;Make sure rewrite buffer
100$:	jmp	rerun

.Dsabl	lsb
.Sbttl	Set up Date and Time System Macros

Datim::
	mov	r2,-(sp)
	mov	r3,-(sp)
	mov	r4,-(sp)
	mov	r5,-(sp)
10$:
	.date			;Get date and time
	mov	r0,r2		; making sure we don't get any crossover
	.gtim	#area,#timblk	; at 24-hour boundary (? too bloody fussy?)
	.date
	cmp	r0,r2
	bne	10$

	bic	#^c37,r0	;Clear off all but year bits
	tst	r2		;If sign bit set, add another 32.
	bpl	20$
	add	#32.,r0
20$:	add	#72.,r0		;Year = year - 1972
	cmp	r0,#100.
	blo	30$
	sub	#100,r0		;Just the last two digits please.
30$:	mov	#sxyy,r1	;Put into YY section.
	call	w2
	inc	r1		;Skip terminating null.

	asr	r2		;Shift
	asr	r2		; out the
	asr	r2		;  year so we
	asr	r2		;   can deal with
	asr	r2		;    the day.

	mov	r2,r0
	bic	#^c37,r0
	call	w2
	inc	r1

	asr	r2		;Shift
	asr	r2		; out the
	asr	r2		;  day so we
	asr	r2		;   can deal with
	asr	r2		;    the month.

	bic	#^c37,r2
	mov	r2,r0
	call	w2		;Month as two digit number
	inc	r1
	cmp	r0,#9.
	blos	40$
	add	#'A-'0-10.,r0
40$:	add	#'0,r0		;Month as hex digit
	movb	r0,(r1)+
	inc	r1



	mov	#timtab,r4	;Table of names of units (hours etc)

	mov	#time50+4,r3	;Get conversion factor for particular
	.gval	#area,#l.cfg	; machine (50 or 60 Hz)
	bit	#b.clok,r0
	bne	50$
	mov	#time60+4,r3
50$:
	clr	r0
60$:
	sub	2(r3),timblk+2	;Division by repeated subtraction
	sbc	timblk
	sub	(r3),timblk
	bmi	70$
	inc	r0
	br	60$
70$:
	add	(r3)+,timblk	;Have gone one too far here.
	add	(r3)+,timblk+2
	adc	timblk

	call	w2		;Put in two digit number

	inc	r1		;Skip trailing null.
	tst	(r4)+
	tst	(r4)		;End of table?
	bne	50$

	mov	(sp)+,r5
	mov	(sp)+,r4
	mov	(sp)+,r3
	mov	(sp)+,r2

	return

.Sbttl	.	W2 - Insert 2 digit no. from R0 into string pointed to in R1

W2::
	mov	r0,-(sp)
	mov	r2,-(sp)

	clr	r2
10$:
	sub	#10.,r0		;Divide by repeated subtraction of 10.
	bmi	20$
	inc	r2
	br	10$
20$:
	bis	#'0,r2
	movb	r2,(r1)+
	add	#10.+'0,r0
	movb	r0,(r1)+

	mov	(sp)+,r2
	mov	(sp)+,r0
	return
.Sbttl	Swear at us, will he?

SWEAR::
	type	<<esc>/[?4l/<esc>/[?7h/<200>>
	mov	line,r0
10$:	tstb	(r0)+
	bne	10$
	movb	#space,-(r0)
	movb	#200,1(r0)
	mov	#500.,r1	;Repeat the line 500 times.
	mov	line,r0
20$:
	.print
	dec	r1
	bne	20$

	.rctrlo			;Reset VT100 characteristics.
	type <<ff><ff><ff><ff><esc>/[?4h/<esc>/[H/<esc>/[J/<esc>/[24B/<200>>
	jmp	rerun

.Enabl	lsb

FSWEAR::
	type	</You're not playing DUNGEON now./<CR><LF><LF>/./<200>>
10$:	.scca	#area,#tsw
	mov	line,r1
15$:
	.rctrlo
	.ttyin			;Use TTYIN's, as ^C causes funnies with SL ON
	movb	r0,(r1)+
	cmpb	r0,#3
	beq	20$
	cmpb	r0,#cr
	bne	15$
	.ttyin
	clrb	-(r1)		;Terminate line with null, not <cr>

	mov	line,r0
	tstb	(r0)
	bne	25$		;Null line - just print "."
20$:	  type	<<cr><lf>/./<200>>
	  br	10$
25$:
	movb	(r0),r1
	beq	30$
	call	toupper		;Convert to upper case
	movb	r1,(r0)+
	br	25$
30$:
	mov	line,r0
	mov	(pc)+,r1
	ref	</SORRY/<0>>
	call	scmp
	beq	fok
	type	</?KMON-F-Up yours too, sport!/<CR><LF><LF>/./<200>>
	br	10$
fok:
	type	<<lf>/?UCL-!-Apology accepted./<0>>
	.scca	#area,#0
	jmp	rerun

.Dsabl	lsb
.Sbttl	TT Options:

T	80,<<esc>/[?3l/<esc>/[H/<esc>/[J/> ;%5 Bloody PRO doesn't clear screen
T	132,<<esc>/[?3h/<esc>/[H/<esc>/[J/>
T	DARK,<<esc>/[?5l/>
T	LIGHT,<<esc>/[?5h/>
T	CLEAR,<<esc>/[H/<esc>/[J/<esc>/(B/<'O-100>>
T	BLANK,<<esc>/[r/<esc>/[H/<esc>/[J/<lf><esc>/#3/<esc>/[H/>
T	LOCK,<<'S-100>>
T	UNLOCK,<<'Q-100>>
T	VT52,<<esc>/[?2l/>
T	VT100,<<esc><LARROW>>
T	ORIGIN,<<esc>/[?6h/>
T	NOORIG,<<esc>/[?6l/>
T	JUMP,<<esc>/[?4l/>
T	SMOOTH,<<esc>/[?4h/>
T	RESET,<<esc>/c/>
T	ASCII,<<esc>/(B/<'O-100>>
T	UK,<<esc>/)A/<'N-100>>
T	GRAPH,<<esc>/)0/<'N-100>>
T	ALTCHR,<<esc>/)1/<'N-100>>
T	ALTGRP,<<esc>/)2/<'N-100>>
T	NUMBER,<<esc><RARROW>>
T	APPLIC,<<esc>/=/>
T	CURSOR,<<esc>/[?1l/>
T	CURAPP,<<esc>/[?1h/>
T	AWRP,<<esc>/[?7h/>
T	NWRP,<<esc>/[?7l/>
T	ARPT,<<esc>/[?8h/>
T	NRPT,<<esc>/[?8l/>
T	NV,<<esc>/[m/<esc>/[?5l/>
T	RV,<<esc>/[7m/>
T	BOLD,<<esc>/[1m/>
T	BLINK,<<esc>/[5m/>
T	US,<<esc>/[4m/>
T	FV,<<esc>/[7m/<esc>/[?5h/>
T	CUROFF,<<esc>/[?25l/>
T	CURON,<<esc>/[?25h/>
T	SCROLL,<<-1>>
T	LEDS,<<-2>>
T	HELP,<<-3>>

.psect	tcmd
tcend:
.psect
.Sbttl	TT Decoding:

TT::
	tstb	wdelim		;Any option specified?
	beq	tdeflt		;No - use default string.
tt0:
	tstb	wdelim		;See if at end of line
	beq	tecom		;End of options.
	clr	r1		;No first char for wrdget.
	call	wrdget		;Get next option
	tst	cmdlin		;Null option?
	beq	tt0		;Yes - look at next.

	mov	#tcstrt,r4	;Start of TT commands
	mov	#tsstrt,r3	;Start of TT strings
10$:
	mov	#cmdlin,r0	;Option typed by user
	mov	r4,r1		;Next option to try in table
	call	scmp		;Look at next option
	bne	20$		;Try for next one.
	tstb	(r3)		;See if special rather than typed string
	blt	ttspcl
	.print	r3
	br	tt0
20$:
	cmpb	(r3)+,#200	;Skip to next string
	bne	20$
30$:
	tstb	(r4)+		;Skip to next command
	bne	30$

	cmp	r4,#tcend	;Tried all the commands?
	blo	10$

	jmp	ttnrec		;Yes - unrecognized command.

tdeflt:
	.print	#dfmes
tecom:
	jmp	rerun

.psect	mesage
dfmes:
	.ascii	<esc><larrow><esc>/[?5l/<esc>/[m/<esc>/[H/<esc>/[J/
	.ascii	<esc>/(B/<'O-100><esc>/[?25h/<200>
tthmes:
	.ascii /80,132,dark,light,clear,vt52,vt100,origin,noorig/<cr><lf>
	.ascii /jump,smooth,reset,ascii,uk,graph,altchr,altgrp,number/<cr><lf>
	.ascii /applic,cursor,curapp,nv,rv,bold,blink,us,fv,scroll/<cr><lf>
	.ascii /leds,awrp,nwrp,arpt,nrpt,curon,curoff/<0>
.psect

ttspcl::			;Special commands - SCROLL and LEDS, & HELP
	cmpb	(r3),#-3
	beq	tthelp
	cmpb	(r3),#-1	;(check character after leading <esc>)
	bne	ttled
ttscr:				;SCROLL top,bottom
	mov	tmpbuf,r5	;Set up string
	movb	#esc,(r5)+
	movb	#'[,(r5)+
	tstb	wdelim		;End of input line?
	beq	40$		;Yes.
10$:
	call	fin1ch		;Try next character
	movb	r1,(r5)+
	beq	ttnarg
	call	chkdlm
	bne	10$

	movb	#semic,-1(r5)
20$:
	call	fin1ch
	movb	r1,(r5)+
	beq	30$
	call	chkdlm
	bne	20$
30$:
	dec	r5
40$:
	movb	#'r,(r5)+
	inc	r2
tss:
	movb	#200,(r5)
	.print	tmpbuf
	type	<<esc>/[25B/<200>>
	br	tt0

.enabl	lsb

tthelp::
	.print	#tthmes
	jmp	rerun

ttled::
	clr	r4
	clr	r5

	tstb	wdelim		;See if any command
	beq	15$

	call	fin1ch		;Check for first digit
	call	chkoct		;Is it octal?
	bcs	ttilrg
	mov	r1,r5		;(in case only 1 digit)
	call	fin1ch		;Try for a second
	call	chkdlm		;Mightn't be one.  Is this a delimiter?
	beq	15$		;Yes - one digit only.
	call	chkoct		;No - hope it's another digit.
	bcs	ttilrg
	mov	r5,r4		;First digit
	mov	r1,r5		;Second.
	call	fin1ch		;Make sure delimiter follows.
	call	chkdlm
	bne	ttilrg
15$:
	type	<<esc>/[0/<200>>
	bit	#1,r4
	beq	20$
	type	</;1/<200>>
20$:	bit	#4,r5
	beq	30$
	type	</;2/<200>>
30$:	bit	#2,r5
	beq	40$
	type	</;3/<200>>
40$:	bit	#1,r5
	beq	50$
	type	</;4/<200>>
50$:	.ttyou	#'q
	jmp	tt0
.dsabl	lsb

ttnrec:
	error	</Unrecognized TT option:  /<200>>
	br	ttcer
ttnarg:
	error	</Missing TT SCROLL argument: /<200>>
	br	ttcer
ttilrg:
	error	</Illegal TT argument: /<200>>
ttcer:
	.print	line
	jmp	rerun

chkoct::
	cmpb	r1,#'8
	bhis	10$
	cmpb	r1,#'0
	blo	10$
	clc
	return
10$:
	sec
	return

chkdlm::
	tstb	r1
	beq	10$
	cmpb	r1,#space
	beq	10$
	cmpb	r1,#tab
	beq	10$
	cmpb	r1,#',
10$:	return
.Sbttl	$TFILE/$FFILE commands

.Enabl	lsb

tfile::
	clr	fileon		;Allow temp file if warranted
	br	10$

ffile::				;Force temp file every time
	inc	fileon
	br	10$



.Sbttl	$DEC/$NODEC - Allow/Disallow chaining to DEC (or S & H ) UCL

decon::
	clr	decucl		;Allow chaining to DEC UCL
	br	10$
decoff::
	inc	decucl		;Disallow
	br	10$

.Sbttl	$CVL/$NOCVL - Allow/Disallow use of UCLCVL

cvlon::
	clr	cvlucl		;Allow use of UCLCVL
	br	10$

cvloff::
	inc	cvlucl		;Disallow UCLCVL
	clr	decucl		; but allow chaining to other UCL

10$:
	inc	chgmac
	jmp	rerun

.Dsabl	lsb
.Sbttl	Findmac - Find a macro in the table

.Enabl	lsb

;FINDMCN entered with R1 containing first char of name, 0 if haven't got one.

;Returns CC with pointer to table entry in R1 if all's well
; and CS if can't find macro.

Findmcn::			;Entry point if don't have macro name
	call	wrdget
Findmac::			;Entry point if macro name in cmdlin
	mov	r2,-(sp)
	mov	r3,-(sp)

	cmp	cmdlin,#"IF	;See if conditional rather than true macro
	beq	10$
	cmp	cmdlin,#"SX	; or system macro.
	bne	20$
10$:	clr	r1		;Conditional or system - clear r1
	br	70$
20$:
	mov	#macbuf,r1	;Start of linked list of macros
	br	40$
30$:
	mov	(r1),r1
40$:	tst	(r1)
	beq	60$		;Null terminates list - not found.
	mov	r1,r2
	tst	(r2)+		;Skip pointer word.
	mov	#cmdlin,r3
50$:	cmp	(r2)+,(r3)+	;Check name against list
	bne	30$		;Not equal.
	cmp	(r2)+,(r3)+
	bne	30$
	cmp	(r2),(r3)
	bne	30$
	br	70$
60$:
	sec
70$:
	mov	(sp)+,r3
	mov	(sp)+,r2
	return

.Dsabl	lsb
.Sbttl	Prnmac - Print details of a macro

;Given	R1/pointer to macro in macro buffer
;	R5/address of routine to send one character.

; Arguments are printed as ARGn, and are not listed in the calling sequence.

.Enabl	lsb

prntab:
	ref	</Ucldef /<200>>
	ref	</Udef /<200>>
	ref	</Defstr /<200>>
	ref	</Defbad /<200>>
	ref	</Defwrd /<200>>
	ref	</Deflin /<200>>

Prnmac::
	mov	r0,-(sp)
	mov	r1,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)
	mov	r4,-(sp)

	call	pcrlf
	movb	10(r1),r0		;Macro type
	asl	r0
	mov	prntab(r0),r0
	call	pstr

	tst	(r1)+
	mov	#5,r2			;Macro name
10$:	movb	(r1)+,r0
	beq	20$
	call	(r5)
	dec	r2
	bge	10$
	br	30$
20$:
	add	r2,r1
30$:
	cmpb	(r1),#m.bad	;If just swearing, omit args and text
	bne	40$
	  jmp	260$
40$:	movb	(r1)+,r0
	cmpb	r0,#m.word	;If DEFWRD, type text line only
	beq	50$		;(Skip TYPE byte with (r1)+)
	cmpb	r0,#m.line	;DEFLIN similarly.
	bne	60$
50$:	jmp	230$

60$:
	mov	r1,r2		;Determine highest character so far
	clr	r3		; so can put arguments as ARG1,ARG2,...,ARGn	
	clr	r4		;Counter of braces: {=+1, }=-1.
70$:
	movb	(r2)+,r0
	bmi	90$		;Argument or terminator.
	cmpb	r0,#'{		;Check for { and } to know how many to
	bne	80$		; quote on final output.
	inc	r4
	br	70$
80$:	cmpb	r0,#'}
	bne	70$
	dec	r4
	br	70$
90$:
	cmpb	r0,#-1		;-1 terminator.
	beq	100$
	bic	#^c177,r0	;Negative=argument.
	cmp	r0,r3
	blos	70$
	mov	r0,r3		;Highest macro argument so far
	br	70$
100$:
	mov	#space,r0
	call	(r5)
	mov	#1,r2
	tst	r3
	beq	120$		;No arguments
110$:
	mov	(pc)+,r0
	ref	</ARG/<200>>
	call	pstr
	mov	r2,r0
	call	pwd
	inc	r2
	cmp	r2,r3
	bgt	120$
	mov	#space,r0
	call	(r5)
	br	110$
120$:
	mov	#'{,r0
	call	(r5)
130$:
	movb	(r1)+,r0
	bne	140$		;Null = end of line
	call	pcrlf
	br	130$
140$:
	bmi	190$		;Arguments are negative
	cmpb	r0,#'_		;Underscores always quoted.
	beq	160$
	tst	r4
	beq	170$		;No quoted braces required (balanced)
	bmi	150$		;Negative - excess }
	cmpb	r0,#'{		;Positive - excess {
	bne	170$		;Prefix excess {, }, and _ by a "_".
	dec	r4
	br	160$
150$:	cmpb	r0,#'}
	bne	170$
	inc	r4
	br	160$
160$:
	mov	r0,-(sp)	;Quote character
	mov	#'_,r0
	call	(r5)
	mov	(sp)+,r0
170$:
	cmpb	r0,#tab		;Tab not treated as other control character
	beq	180$
	cmpb	r0,#40		;Control character?
	bhis	180$		;No.

	mov	r0,-(sp)
	mov	#'^,r0
	call	(r5)		;Yes - precede with "^"
	mov	(sp)+,r0
	add	#100,r0
180$:
	call	(r5)		;Normal character
	br	130$

190$:				;ARGUMENT.
	cmpb	r0,#-1		;-1 terminates macro
	beq	250$

	mov	r0,-(sp)
	mov	r1,-(sp)
	movb	-2(r1),r1	;Check preceding character
	bmi	200$		;Argument
	call	alfnum		;Precede with quote if other arg or alphanum
	bcs	210$
200$:	movb	#'',r0
	call	(r5)
210$:
	mov	(pc)+,r0
	ref	</ARG/<200>>
	call	pstr
	mov	2(sp),r0
	bic	#^c177,r0
	call	pwd

	mov	(sp),r1
	movb	(r1),r1		;If followed by alphanumeric, quote it also.
	call	alfnum
	bcs	220$
	mov	#'',r0
	call	(r5)
220$:	mov	(sp)+,r1
	mov	(sp)+,r0
	br	130$

230$:				;DEFWRD & DEFLIN - only type text as a line.
	movb	#space,r0
	call	(r5)
240$:	movb	(r1)+,r0
	ble	260$		;DEFWRD terminated by <201> byte as one arg.
	call	(r5)		;DEFLIN terminated by <0> byte as end of line.
	br	240$

250$:				;Terminate macro text.
	mov	#'},r0
	call	(r5)
260$:
	call	pcrlf
	mov	(sp)+,r4
	mov	(sp)+,r3
	mov	(sp)+,r2
	mov	(sp)+,r1
	mov	(sp)+,r0
	return

.Dsabl	lsb


;Send a string to the output file

pstr::
	mov	r0,-(sp)
	mov	r1,-(sp)
	mov	r0,r1		;Address of string to be typed
10$:
	movb	(r1)+,r0
	beq	20$		;<nul> - <cr><lf>
	bmi	30$		;<200> - terminate.
	call	(r5)
	br	10$
20$:
	call	pcrlf
30$:
	mov	(sp)+,r1
	mov	(sp)+,r0
	return

;Send a <cr><lf> to the output file

pcrlf::
	mov	r0,-(sp)
	mov	#cr,r0
	call	(r5)
	mov	#lf,r0
	call	(r5)
	mov	(sp)+,r0
	return

;Send a decimal number to the output file

.Enabl	lsb

dectab:	.word	10.,100.,1000.,10000.,-1

pwdu::				;Unsigned
	mov	r0,-(sp)
	br	10$
pwd::				;Signed
	mov	r0,-(sp)
	bge	10$

	mov	#'-,r0
	call	(r5)
	mov	(sp),r0
	neg	r0
	bic	#100000,r0
10$:
	mov	r3,-(sp)
	mov	r2,-(sp)
	mov	r0,r2

	clr	-(sp)
	mov	#dectab,r3
20$:
	cmp	r0,(r3)		;Compare value with subtractors
	blo	40$
	mov	(r3)+,-(sp)	;Stack next subtractor if relevant
	br	20$
40$:
	mov	(sp)+,r3	;Get next subtractor
	beq	70$		;Last one zero, in case number = 0.
	mov	#60,r0		;Initalize digit
50$:
	sub	r3,r2
	bcs	60$
	inc	r0
	br	50$
60$:
	add	r3,r2
	call	(r5)
	br	40$
70$:
	add	#60,r2
	mov	r2,r0
	call	(r5)

	mov	(sp)+,r2
	mov	(sp)+,r3
	mov	(sp)+,r0
	return

.Dsabl	lsb

;Send one character to the output file

.Enabl	lsb

pfil::
	movb	r0,@outpnt	;(Ever seen a routine like this before?)
	inc	outpnt
	dec	outcnt		;Room for another?
	bne	10$		;Yes.

	.writw	#area,#16,outbuf,#400,outblk
	bcs	20$
	inc	outblk
pset:	mov	#1000,outcnt	;Reset output buffer details
	mov	outbuf,outpnt
10$:	return

20$:	error	</Error Writing Output File/<200>>
	jmp	rerun

.Dsabl	lsb


;Send a character to the terminal

ptt::
	.ttyou
	return
.Sbttl	Wrdget - Set up next word in command buffer

;Entered with first character of word in R1 (0 if don't have one).

Wrdget::
	mov	r2,-(sp)
	mov	r3,-(sp)
	mov	#cmdlin,r2
	clr	(r2)+		;Clear out first 3 words as may be used
	clr	(r2)+		; for macro name, and allow for null at
	clr	(r2)+		; end for printing.
	clr	(r2)
	mov	#cmdlin,r2
	mov	#6,r3		;Only read six characters of word.
	tst	r1		;See if have first char already.
	bne	20$
	call	ltrim		;Scrub leading spaces & tabs
	br	20$
10$:
	call	fin		;Extract command from line
20$:	call	toupper
	cmpb	r1,#'$		;%4 Allow "$" for RESET command
	beq	25$
	call	alfnum		;(alphanumerics only)
	bcs	40$
25$:	dec	r3
	bmi	30$
	movb	r1,(r2)+
30$:	br	10$
40$:
	mov	r1,wdelim	;Save word delimiter
	clrb	(r2)
	mov	(sp)+,r3
	mov	(sp)+,r2
	return
.Sbttl	Fin - Get an input character from Macro or Terminal

;Returns character from input or macro expansion in R1
;CS return if:
;		hit end of macro expansions, or
;		tried to access undefined macro (in this latter case
;			MACIPT will be non-zero).

.Enabl	lsb

Fin::
	tst	macipt		;Input from macros?
	beq	frlin		;No.
	  call	macchr		;Yes - get from macro routines themselves.
	  bcc	5$
	  mov	#extra,linpnt	;None left.  Give him a few terminators
				; in case numerous }}} nested macros.

frlin:				;Input from input line.
	movb	@linpnt,r1
	ble	10$		;End of this line?
	inc	linpnt		;No - just normal character
	clc
5$:	return

10$:	blt	20$		;Yes.  Return him 0 before trying new line,
	mov	#eolstr,linpnt
	sec			; with carry set.
	return
20$:
	cmpb	r1,#-2		;Hit end of extra list?
	beq	50$

	cmpb	r1,#200		;Additional terminators
	bne	25$
	  clr	r1
	  sec
	  return
25$:
	tst	inpnt		;From command file?
	bne	30$
	.rctrlo
	.gtlin	line,#lnprmt	;Read a new line, prompting him.
	mov	line,linpnt
	br	frlin
30$:
	call	inlin
	bcs	40$
	mov	line,linpnt
	bit	#b.chn,@#jsw	;Don't "echo" if chained to.
	bne	frlin
	.print	#lnprmt
	.print	line
	br	frlin
40$:
	error	</Unexpected end of Command File/<0>>
	clr	inpnt
	jmp	rerun

50$:
	error	</Unexpected end of Macro - ? unbalanced {braces}/<0>>
	jmp	rerun

.Dsabl	lsb

	.psect	mesage
eolstr:	.byte	-1,0
extra:	.rept	15.
	.byte	200
	.endr
	.byte	-2
	.psect


.Sbttl	.	FIN1CH - Get only from present line, keeping "word delimiter"

Fin1ch:
	movb	@linpnt,r1
	ble	10$
	inc	linpnt
10$:	mov	r1,wdelim	;Keep this character as "word delimiter"
	return
.Sbttl	Macget - Read and store a macro

;Called with the macro name in CMDLIN, and a byte indicating the type of
; macro in R5.

.Enabl	lsb

Macget::
	mov	r1,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)
	mov	r4,-(sp)
	mov	r5,-(sp)
	
	clr	brccnt		;Clear brace depth counter
	mov	tmpbuf,r4	;Use temp buffer for argument string
	clr	(r4)		;Clear in case no arguments
	mov	macpnt,r5	;Pointer to next macro area
	tst	(r5)+		;Skip pointer to next macro
	mov	#cmdlin,r3	;Contains macro name
	mov	(r3)+,(r5)+	;Put into space in macro buffer
	mov	(r3)+,(r5)+
	mov	(r3),(r5)+
	movb	(sp),(r5)+	;Put TYPE byte from old R5 into buffer

	movb	cmdlin,r1
	call	alph
	bcc	10$
	  error	</Illegal Name for Macro: /<200>>
	  .print #cmdlin
	  br	macerr
10$:
	cmpb	(sp),#m.word	;Is it a DEFWRD statement?
	beq	20$		;Yes - use only rest of line.
	cmpb	(sp),#m.line	;DEFLIN similarly.
	bne	60$
20$:
	call	ltrim		;Yes.  Just insert the rest of the line.
30$:	tstb	r1
	beq	50$
	cmp	r5,#macend
	blo	40$
	  jmp	macnor
40$:	movb	r1,(r5)+
	call	fin
	br	30$
50$:
	cmpb	(sp),#m.line	;DEFLIN puts user's line on next line.
	bne	55$
	clrb	(r5)+
55$:
	movb	#201,(r5)+
	clrb	(r5)+
	br	em


60$:
	mov	wdelim,r1	;Word delimiter - delimited macro name.
	cmpb	r1,#'{		;See if terminated by brace
	beq	140$		;Yes - no arguments. Get text.

	cmpb	r1,#space	;Check for other legal delimiters - space
	beq	70$
	cmpb	r1,#tab		; tab,
	beq	70$
	tstb	r1		; and end of line.
	beq	70$

	  error	</Illegal delimiter for macro name: /<200>>
	  .ttyou r1
	  br	macerr		;Else have boobed.

; Read macro argument

70$:
	call	ltrim		;No.  Scrub any leading spaces or tabs
	tstb	r1		; or blank lines.
	beq	70$
	call	alph		;First char must be alphabetic
	bcc	90$
	  cmp	r1,#'{		;Or start of text
	  beq	140$
	  error	</First character of argument not alphabetic: /<200>>
	  .ttyou r1
	  br	macerr		; Wasn't.
80$:
	call	fin		;Read argument character

	call	alfnum		;Make sure alphanumeric
	bcs	100$
90$:
	call	toupper
	mov	r1,r0
	call	tmput		;Store character in temp buffer
	br	80$


100$:
	clrb	r0		;Non-alpha.  Terminate this one.
	call	tmput
110$:
	cmpb	r1,#space	;May have spaces and tabs
	beq	120$		; after each argument.
	cmpb	r1,#tab
	bne	130$
120$:	call	fin
	br	110$
130$:
	cmpb	r1,#'{		;Brace starts text
	beq	140$
	cmpb	r1,#',		;Comma is other permitted delimiter.
	beq	70$		; and get next argument.
	tst	r1		;(or blank line)
	beq	70$
	call	alph		;If alpha, have hit next argument.
	bcc	90$
	
	error	</Illegal argument delimiter: /<200>>
	.ttyou r1
macerr::
	call	tcrlf
	jmp	mretcs		;Return with carry set.

140$:
	movb	#200,r0		;Signify end of the lot.
	call	tmput

.Dsabl	lsb
.Enabl	lsb

; Read the text of a macro.

10$:
	call	rdmlin		;Reads line of macro checking for {}'s in
				; raw text.  If finds delimiting }, replaces
				; it by <200+'}>
				;Returns R4/pointer to start of null-
				; terminated line.
20$:
	call	token		;Finds token - alpha followed by alphanumerics
	  bcs	60$		; Returns CS if hits terminating } or eol.
				; R4 is advanced to next non-alphanumeric.
				; R2 start of token in text, R3 end of token.
	call	argchk		;Checks this token against argument list.
	  bcs	60$		; Returns CS if not found.
				; If found, CC return, R1 argument number,
	cmpb	-1(r2),#''	;Check for concatenation operator.
	bne	30$
	  dec	r2		;Include within name of arg
30$:	cmpb	1(r3),#''
	bne	40$
	  inc	r3
	  inc	r4
40$:
	add	#201,r1		;Convert arg number to code for it in text
	movb	r1,(r2)+
50$:
	cmp	r2,r3		;Scrub characters of name by replacing
	bhi	60$		; with <200>
	movb	#200,(r2)+
	br	50$
60$:
	cmpb	(r4),#'}+200	;See if up to end of macro
	beq	70$		;Yep.
	tstb	(r4)		;No.  See if end of line instead.
	bne	20$		;No.  Go and get another token.

	call	lmins		;Yes. Insert line into macro buffer
	bcc	10$		; and get another line.
	  br	macnor		;Overflowed available room

70$:
	call	lmins		;End of macro.  Insert this line, returning
	bcs	macnor		; r5 pointing to terminating null.
em:
	movb	#-1,(r5)+	;Signal end of whole macro.
	inc	r5
	bic	#1,r5		;Make even for setting up next macro pointer
	tst	(r5)+

	mov	r5,@macpnt	;Pointer word in this macro points to next.
	mov	r5,macpnt	;Area for next macro to commence.
	clr	(r5)		;Null pointer word at end of linked list.
	jmp	mretcc		;Return with carry clear.


Tmput::
	cmp	r4,tmpend	;Is there room for character?
	bhis	90$		;No.
	movb	r0,(r4)+	;Yes.
	return
90$:
	error	</Too many Arguments in /<200>>
	br	100$

Macnor::
	error	</Insufficient Storage Space for Macro /<200>>
100$:	.print	#cmdlin
	call	tcrlf
	jmp	rerun

.Dsabl	lsb
.Sbttl	.	RDMLIN - Read a line of macro text

; Checks for embedded {}'s.  Returns them unscathed, but returns the
;	terminating } as <200+'}>.
; Returns R4 pointing to the start of the (null terminated) line.

.Enabl	lsb

Rdmlin::
	mov	maclin,r4	;Line stored in maclin.
10$:
	call	fin		;Read next character from input file.
	tstb	r1		;End of line is <null>
	beq	70$

	cmpb	r1,#'_		;See if literal character
	bne	40$
	  call	fin		; and put it straight in.
	  tstb	r1		;(Unless end of line!)
	  beq	70$
	  br	60$
40$:
	cmpb	r1,#'^		;Control character?
	bne	45$

	call	fin
	tstb	r1		;End of line?
	beq	70$
	call	toupper
	sub	#100,r1
	bpl	60$
	br	10$		;(Illegal character for control)
45$:
	cmpb	r1,#'{		;Check for {} pairs.
	bne	50$
	inc	brccnt		;Increase depth counter.
50$:
	cmpb	r1,#'}
	bne	60$
	dec	brccnt		;Decrease depth counter.
	bge	60$
	movb	#<'}+200>,(r4)+	;If hit zero, end of macro.
	br	70$
60$:
	movb	r1,(r4)+
	br	10$
70$:
	clrb	(r4)		;Null line terminator.
	mov	maclin,r4	;Return line address
	return

.Dsabl	lsb
.Sbttl	.	TOKEN - Find alphanumeric token

; Requires R4 pointing to current position in text

; Returns R4 pointing to byte after token,
;	R2 pointing to first byte of token,
;	R3 pointing to last  byte of token,
;	CC if a token found.
;	CS if found terminating } or end of line.

.Enabl	lsb

Token::
	movb	(r4)+,r1	;Check next character
	bgt	10$		;OK if not zero or negative.
	  dec	r4		;If hit null or special terminator, point to
	  sec			; it, and set carry for error return
	  return
10$:
	call	alph		;Check for first being alpha
	bcs	token		;Wasn't.  Try next.

	mov	r4,-(sp)	;Was.  Save start of token.
20$:
	movb	(r4)+,r1	;Check next character
	call	alfnum
	bcc	20$		;Ok thus far.

	dec	r4		;Back to delimiting character
	mov	(sp)+,r2	;Return start of token in r2
	dec	r2		;(Jumped one earlier)
	mov	r4,r3		;and end of token
	dec	r3		;(again overenthusiastic by 1)

	clc
	return

.Dsabl	lsb
.Sbttl	.	ARGCHK - Check argument list against token

; Requires:
;	R2/start of token
;	R3/end of token
;	R4/points 1 byte past end of token

; Returns:
;	R2-R4 unchanged;
;	CS if no match
;	CC if match, with R1/argument number (0 to <n-1>)

Argchk::
	mov	r4,-(sp)
	mov	r5,-(sp)

	mov	tmpbuf,r4	;Start of argument list
	clr	r5		;For argument number
10$:
	tstb	(r4)		;See if out of arguments
	bmi	20$		;Yes - no match.
	call	cmps		;Compare strings R2/ & R4/.
	beq	30$		;Equality
	inc	r5		;Inequality.  Try next.
	br	10$
20$:
	sec
30$:
	mov	r5,r1		;Argument number

	mov	(sp)+,r5
	mov	(sp)+,r4
	return
.Sbttl	.	CMPS - Compare strings

;Requires:
;	R4/start of upper case string (null terminated)
;	R2/start of string to be compared
;	R3/end of string pointed to in R2
;Returns:
;	NE if inequality
;	EQ if equality
;	R4 advanced to point to byte after null terminator; R2, R3 unchanged.

Cmps::
	clr	-(sp)		;Used for equality flag at end
	mov	r2,-(sp)
10$:
	movb	(r2)+,r1	;Next byte from string of either case
	call	toupper		;R4 string is all upper case
	cmpb	r1,(r4)+
	bne	20$		;Inequality.
	tstb	(r4)		;Check for terminating null
	bne	10$		;Not at end of string yet.

;Equality to terminating byte.  Check that whole R2/R3 string covered

	dec	r2
	cmp	r2,r3
	beq	30$		;Full equality

;Inequality

20$:
	inc	2(sp)		;Make flag non-zero

;Equality

30$:	tstb	(r4)+		;Take R4 up to 1 past terminating null
	bne	30$

	mov	(sp)+,r2	;Restore r2
	tst	(sp)+		;Check equality flag
	return
.Sbttl	.	LTRIM - Trim off leading blanks or spaces

; Reads characters from the input file, ignoring spaces or blanks.

Ltrim::
	call	fin
Ltrim1:	cmpb	r1,#space	;(Enter here if already have char in R1)
	beq	ltrim
	cmpb	r1,#tab
	beq	ltrim
	return




.Sbttl	.	TOUPPER - Convert character in R1 to upper case.

Toupper::
	cmpb	r1,#'z
	bhi	10$
	cmpb	r1,#'a
	blo	10$
	bic	#40,r1
10$:	return


.Sbttl	.	ALFNUM	- Return CC if R1 contain alphanumeric character
.Sbttl	.	ALPH	- Return CC if R1 contain alphabetic   character

	.enabl	lsb
Alfnum::
	cmpb	r1,#'0		;blo=bcs, bhis=bcc
	blo	10$
	cmpb	#'9,r1
	bhis	10$
Alph::
	cmpb	r1,#'A
	blo	10$
	cmpb	#'Z,r1
	bhis	10$

	cmpb	r1,#'a
	blo	10$
	cmpb	#'z,r1
10$:	return

	.dsabl	lsb
.Sbttl	.	Lmins - insert line from Maclin into macro itself

Lmins::
	mov	maclin,r1	;Source of bytes, null terminated
	clc
10$:				; with <200> bytes to scrap.
	movb	(r1)+,r0
	beq	30$		;Terminating null.
	bpl	20$		;Normal character.

	cmpb	r0,#200		;See if byte to scrap (also clears carry
	beq	10$		; as must be .HI. 200).
20$:
	cmpb	r0,#'}+200	;See if special terminator
	beq	40$		; End of macro.
	movb	r0,(r5)+	;Put it into the macro

	cmp	#macend,r5	;See if any room left in buffer
	bhis	10$		;Ok.  Sets carry if .LO. ie no room.
30$:
	movb	#0,(r5)+	;Don't upset carry bit.
40$:
	return
.Sbttl	Macput - Expand Macros

.Enabl	lsb

;Entered with R1/pointer to macro to expand.

Macput::
	mov	r1,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)
	mov	r4,-(sp)
	mov	r5,-(sp)

	mov	r1,r4
	beq	10$		;If conditional, don't have pointer here.
	add	#11,r4		;Point to text of macro
10$:	mov	macbot,r5	;Macro expansion area
	tst	(r5)+		;Contains MACBOT link series (set up with
	mov	r5,r3		; last macro)
	tst	(r3)+		;Will contain old MACIPT pointer
	movb	macifb,(r3)+	;Store "last IF result" for this level.

	mov	#'|,r2		;Flag for termination with <cr> (0 if |)

	mov	wdelim,r1	;Get delimiter of name
	beq	120$		;None.
	cmpb	r1,#'|
	beq	130$

	tst	r4
	beq	30$
	cmpb	-1(r4),#m.word	;See if only a word substitution
	beq	20$		;Yes - use whole rest of line as one argument.
	cmpb	-1(r4),#m.line	;Similarly for DEFLIN.
	bne	30$
	call	ltrim1		;Scrub leading spaces if DEFLIN
20$:	  call	rdb1
	  call	fin
	  tst	r1
	  bne	20$
	  br	120$
30$:
	call	chkdlm		;If not usual delimiter, use as 1st arg char
	bne	50$

;Get arguments into top of expanded macro area

40$:
	call	ltrim		;Get rid of leading spaces & tabs
50$:	cmpb	r1,#'{		;Argument enclosed in {}'s?
	bne	70$
	  call	rdbrar		;Read bracketed argument
	  movb	#177,r1		;Delimit argument
	  call	rdb1
	  call	ltrim		;See what follows
	  tstb	r1		;End of line?
	  beq	120$
	  cmpb	r1,#',		;Comma may also delimit
	  beq	40$
	  br	50$
60$:
	call	fin		;Next character
70$:	cmpb	r1,#'_		;See if literal for braces.
	bne	80$
	  call	fin		;Use it exactly
	  tstb	r1		; apart from end of line (use braces if really
	  beq	120$		; want <cr><lf>)
	  br	90$
80$:	cmpb	r1,#space	;Space delimits, expecting more arguments,
	  beq	100$		; and may have <space><,><more>
	cmpb	r1,#',		;Comma delimits, expecting more arguments.
	  beq	110$
	cmpb	r1,#'|		;Macro call delimited by | or <cr>
	  beq	130$
	tstb	r1		;End of line?
	  beq	120$
90$:	call	rdb1
	br	60$
100$:
	movb	#177,r1		;Space - delimit argument, and see if comma
	call	rdb1		; in there too.
	call	ltrim
	cmpb	r1,#',
	beq	40$
	br	50$
110$:
	movb	#177,r1		;Space delimiter.
	call	rdb1		;Delimit this argument
	br	40$		; and return for more.
120$:
	clr	r2		;Remember <cr> delimiter, now removed
130$:
	movb	#177,r1
	call	rdb1		;Delimit this argument
	movb	#200,r1
	call	rdb1		; and terminate the list.

; At this stage:
;	r4 points to unexpanded macro text, null terminated
;	r5 points to start of macro expansion block + 2 (MACIPT storage loc)
;	r3 points to start of expanded text

	tst	r4		;See if conditional rather than true macro
	beq	ifmacs		;Check out conditional or system

	mov	macipt,(r5)+	;Save MACIPT for end of this macro
	inc	r5		;Skip IF byte (already set up)
150$:
	movb	(r4)+,r1	;Move macro byte to expanded macro area
	bmi	160$		;Negative argument indicator
	call	rdb1
	br	150$

; Negative byte = argument within macro

160$:
	cmpb	r1,#-1		;-1 = end of macro
	beq	200$
	bic	#177600,r1	;Contains <201+arg #>
	mov	r5,r0		;Pointer to argument list
170$:
	dec	r1
	ble	190$		;Found argument
180$:
	tstb	(r0)		;End of all provided arguments?
	bmi	150$		;Yes - don't insert anything for this one.
	cmpb	(r0)+,#177	;End of this argument?
	bne	180$		;No.
	br	170$		;Yes - try next one.


190$:
	movb	(r0)+,r1	;Move argument bytes into place.
	bmi	150$		;Whoops - up to end of all he gave us.
	cmpb	r1,#177		;End of argument
	beq	150$
	call	rdb1
	br	190$


200$:
	movb	r2,r1		;If <cr> terminated macro, restore it for
	bne	210$		; input or get lines crammed upon each other.
	call	rdb1		;Put in <cr>
210$:	jmp	macset		;Terminate macro

.Dsabl	lsb
.Sbttl	.	IFMAC - Handle conditionals

	.psect	mesage
Iftab:
	.asciz	/BL/
	.asciz	/NBL/
	.asciz	/CSAM/
	.asciz	/CNSA/
	.asciz	/SAM/
	.asciz	/NSAM/
	.asciz	/IDN/
	.asciz	/NIDN/
	.asciz	/CSOK/
	.asciz	/CSER/
	.asciz	/IN/
	.asciz	/NIN/
	.asciz	/TSX/
	.asciz	/RT/
	.asciz	/ELSE/
	.byte	-1

	.psect	data
Ifact:
	ifbl
	ifnbl
	ifcsam
	ifcnsa
	ifsam
	ifnsam
	ifidn
	ifnidn
	ifcsok
	ifcser
	ifin
	ifnin
	iftsx
	ifrt
	ifelse

	.psect

.Enabl	lsb

Ifmacs::
	cmp	cmdlin,#"IF
	beq	20$
	  jmp	sxmac		;System macro
20$:
	mov	#iftab,r4	;Table of IF options
	mov	#ifact,r2	;Table of IF actions
30$:
	tstb	(r4)		;Terminated by -1
	bmi	50$
	mov	#cmdlin+2,r0
	mov	r4,r1
	call	scmp
	beq	60$		;Found option in table.
35$:
	tstb	(r4)+		;Move on to next option
	bgt	35$
	tst	(r2)+		; and next action.
	br	30$

50$:
	error	</Unrecognized IF: /<200>>
	.print	#cmdlin+2
	call	tcrlf		;(In case <200> terminator)
	jmp	rerun

60$:
	mov	r5,r4
	add	#3,r4		;Reset argument pointer to point to first
	jmp	@(r2)		; argument.

.Dsabl	lsb


Ifbl::				;IFBL arg1,arg2 - include arg2 if arg1 blank
	cmpb	(r4),#177
	beq	ins2nd
	br	failif

Ifnbl::				;IFNBL arg1,arg2 - inc arg2 if arg1 not blank
	cmpb	(r4),#177
	bne	ins2nd
	br	failif


Ifcsam::			;IFCSAM arg1,arg2,arg2 - include arg3 if first
	call	argccp		;	chars of arg1 and arg2 are the same
	beq	insert		;	ignoring case.
	br	failif

Ifcnsa::			;IFCNSA arg1,arg2,arg3 - include arg3 if first
	call	argccp		;	chars of arg1 and arg2 are different
	bne	insert
	br	failif


Ifidn::				;IFIDN arg1,arg2,arg3
	call	argcmp		;	include arg3 if arg1 & arg2 identical
	beq	insert
	br	failif

Ifnidn::			;IFNIDN arg1,arg2,arg3
	call	argcmp		;	include arg3 if arg1 & arg2 not ident
	bne	insert
	br	failif

Ifsam::				;IFSAM arg1,arg2,arg3 - include arg3 if
	call	argcmc		;	arg1 & arg2 same apart from case diffs
	call	argcmp
	beq	insert
	br	failif

Ifnsam::			;IFNSAM arg1,arg2,arg3 - include arg3 if arg1
	call	argcmc		;	& arg2 different apart from case diffs
	call	argcmp
	bne	insert
	br	failif


Ifcsok::			;IFCSOK arg1,arg2 - include arg2 if CSIGEN on
	call	csigen		;	arg1 returns CC
	bcc	ins2nd
	br	failif

Ifcser::			;IFSCOK arg1,arg2 - include arg2 if CSIGEN on
	call	csigen		;	arg1 returns CS
	bcs	ins2nd
	br	failif

Ifin::
	call	argcmc		;IFIN arg1,arg2,arg3 - include arg3 if arg1
	call	subcmp		;	is contained in arg2 (ignoring case)
	beq	insert
	br	failif

Ifnin::
	call	argcmc		;IFNIN arg1,arg2,arg3 - include arg3 if arg1
	call	subcmp		;	is not contained in arg2 (ignoring
	bne	insert		;	case)
	br	failif


Iftsx::
	tst	tsxflg		;IFTSX arg1 - include arg1 if running under
	bne	insert		;	TSX (plus)
	br	failif

Ifrt::
	tst	tsxflg		;IFRT arg1 - include arg1 if not running
	beq	insert		;	under TSX (plus)
	br	failif

Ifelse::
	tstb	2(r5)		;Was last IF successful? (Use this as MACIFB
				; may change as read ends of stored strings)
	bne	failif		;Yes - therefore fail this one.
	br	insert		;No  - therefore succeed.

ins2nd:
	tstb	(r4)		;Take pointer up to second argument.
	bmi	insert		;(end of arguments provided)
	cmpb	(r4)+,#177	;End of this arg?
	bne	ins2nd		;No.  Keep trying.
insert:
	movb	#1,macifb	;Indicate successful IF

	tstb	(r4)
	bmi	mret		;If end of args, nothing to insert anyway.

	mov	macipt,(r5)+	;Set up MACIPT chain pointer,
	movb	macifb,(r5)	; and store IF result.
10$:
	movb	(r4)+,r1	;Transfer final argument.
	bmi	macset		;Jump off for final pointer resetting.
	cmpb	r1,#177		;Only transfer one argument
	beq	macset
	call	rdb1
	br	10$



Failif::			;This IF has failed.
	clr	macifb		;Remember it in case of IFELSE
	br	mret



.Sbttl	.	CSIGEN  - Check argument with a .CSIGEN request

csigen:
	mov	r4,r1
10$:
	cmpb	(r1)+,#177
	bne	10$

	clrb	-(r1)		;Make arg null terminated for csi.

	mov	sp,r2
	.serr
	.csigen	macbot,#zdefext,r4
	mov	r2,sp

	movb	#177,(r1)

	return
.Sbttl	.	SXMAC - Handle system macros

	.psect	mesage
Sxtab:
	.asciz	/YY/		;Note that the ordering of these is used
	.asciz	/DD/		; in the DATIM subroutine!
	.asciz	/MM/
	.asciz	/M/
	.asciz	/HR/
	.asciz	/MN/
	.asciz	/SC/
	.byte	-1

sxyy:	.asciz	/yy/
sxdd:	.asciz	/dd/
sxmm:	.asciz	/mm/
sxm:	.asciz	/m/
sxhr:	.asciz	/hr/
sxmn:	.asciz	/mn/
sxsc:	.asciz	/sc/

	.psect


.Enabl	lsb

Sxmac::
	mov	#sxtab,r4	;Table of SX options
	mov	#sxyy,r2	;Table of SX string pointers
30$:
	tstb	(r4)		;Terminated by -1
	bmi	50$
	mov	#cmdlin+2,r0
	mov	r4,r1
	call	scmp
	beq	60$		;Found option in table.
35$:
	tstb	(r4)+		;Move on to next option
	bgt	35$
40$:	tstb	(r2)+		; and next action.
	bgt	40$
	br	30$

50$:
	error	</Unrecognized System Macro: /<200>>
	.print	#cmdlin
	call	tcrlf		;(In case <200> terminator)
	jmp	rerun

60$:
	mov	macipt,(r5)+	;Set up MACIPT chain pointer
	inc	r5		;Skip previously stored IF byte
70$:
	movb	(r2)+,r1
	beq	macset
	call	rdb1
	br	70$

.Dsabl	lsb
.Sbttl	.	MACSET - Terminate expanded macro and reset pointers

.Enabl	lsb

Macset::
	mov	#-1,r1		;Terminate macro
	call	rdb1
	call	rdb1
	bic	#1,r3		;Set to word boundary

	cmp	r3,mactop	;See if above top of macro space
	blos	10$
	  jmp	macszr		;Whoops.
10$:
	mov	macbot,(r3)	;Reset bottom pointer
20$:
	tstb	(r5)+		;Skip over argument list to get pointer
	bpl	20$		; to this macro's text

	mov	r5,macipt
	mov	r3,macbot
mretcc::
	clc
	br	mret


macszr:
	error	</Insufficient Room to Expand Macro /<200>>
	.print	#cmdlin
mretcs::
	sec
mret::
	mov	(sp)+,r5
	mov	(sp)+,r4
	mov	(sp)+,r3
	mov	(sp)+,r2
	mov	(sp)+,r1
	return

.Dsabl	lsb
.Sbttl	.	Argument comparison routines

;These routines are entered with a pointer to the first of the
; arguments to be compared in R4.  R4 is advanced to point to the
; start of the argument after the arguments being compared.


Argcmc::			;Compare arguments regardless of case
	mov	r4,r0
10$:	movb	(r0),r1
	bmi	40$
	cmpb	r1,#177
	beq	20$
	call	toupper		;Set first argument to upper case
	movb	r1,(r0)+
	br	10$
20$:
	inc	r0
30$:
	movb	(r0),r1
	bmi	40$
	cmpb	r1,#177
	beq	40$
	call	toupper		;Same for second
	movb	r1,(r0)+
	br	30$
40$:
	return



Argcmp::			;Compare arguments taking notice of case
	call	argr01		;Set up addresses of two arg strings in r0,r1
10$:
	cmpb	(r0)+,(r1)+
	bne	20$
	cmpb	(r0),#177	;End of first string?
	bne	10$
	cmpb	(r1),#177
20$:	return


Argccp::			;Compare first two characters of next args.
	call	argr01
	movb	(r1),r1
	call	toupper		;Ignore case.
	mov	r1,-(sp)
	movb	(r0),r1
	call	toupper
	cmpb	r1,(sp)+
	return


Argr01:				;Set up addresses of next arguments in r0 and
	mov	r4,r0		; r1 respectively.
10$:
	cmpb	(r4),#177	;End of this arg?
	beq	15$		;Yes.
	tstb	(r4)+		;No - move R4 on pointing to next macro
	bpl	10$		;<200> means no more arguments
	mov	r4,r1		;So second arg is null.
	dec	r1
	br	25$
15$:
	inc	r4
	mov	r4,r1
20$:
	cmpb	(r4),#177
	beq	30$
	tstb	(r4)+		;Now skip the next argument also.
	bpl	20$
25$:
	dec	r4		;If hit <200>, need to back up one.
	return
30$:
	inc	r4
	return


Subcmp:				;Check for substring arg1 of arg2
	call	argr01

	clr	-(sp)
	mov	r0,-(sp)	;(This is not saving registers for return.)
	mov	r1,-(sp)

	cmpb	(r0),#177	;Any arg1?  If null, always successful.
	beq	40$
	cmpb	(r1),#177	;Any arg2?  If null, always unsuccessful.
	beq	15$
10$:
	cmpb	(r0),(r1)+	;Look for possible start of arg1 within arg2
	beq	20$		;Could be one.
	cmpb	(r1),#177	;Isn't.  Any more arg2 to consider?
	bne	10$		;Yes.
15$:	inc	4(sp)		;No - search has failed.
	br	40$
20$:
	inc	r0
	mov	r1,(sp)		;If search fails, start again from here.
30$:
	cmpb	(r0),#177	;Any more arg1?
	beq	40$		;No - count as successful search
	cmpb	(r0)+,(r1)+
	beq	30$

	mov	2(sp),r0	;Failed.  Try again.
	mov	(sp),r1
	br	10$

40$:
	cmp	(sp)+,(sp)+
	tst	(sp)+		;Flag - non-zero if not equal
	return
.Sbttl	.	RDBRAR - Read macro argument enclosed in braces

rdbrar::
	clr	brccnt		;Brace depth counter
10$:
	call	fin

	cmpb	r1,#'{		;Further brace depth?
	bne	20$
	  inc	brccnt		;Yes - keep track.
	  br	40$
20$:
	cmpb	r1,#'}		;Up one level?
	bne	30$
	  dec	brccnt		;Yes.  See if at top level again -
	  bpl	40$		; ie end of argument.
	  return
30$:
	cmpb	r1,#'_		;Allow for literal '{ and '}
	bne	40$
	  call	fin
40$:
	call	rdb1		;Insert in buffer (if there's room)
	br	10$

	
.Sbttl	.	RDB1 - Insert character in macro argument area if there's room

rdb1::
	cmp	mactop,r3
	blo	10$		;Don't enter if no room, and return with CS
	movb	r1,(r3)+
10$:	return
.Sbttl	.	Macchr - return character from current macro

;The current macro pointer is in MACIPT.

Macchr::
	movb	@macipt,r1
	cmpb	r1,#-1		;End of macro?
	beq	10$

	inc	macipt		;Point to next, and give him this one.
	clc
	return
10$:
	mov	@macbot,r1	;Pointer to end of expanded macro table
				; points to pointer after expanded macro
	mov	r1,macbot	; area, which is followed by old MACIPT value.
	movb	4(r1),macifb	;Old "last IF result" value.
	mov	2(r1),macipt
	bne	macchr		;If non-zero, return to previous macro.

	clr	r1
	sec			;Signify end of macros
	return
.Sbttl	TSXSET - Check for running under TSX

		.If eq 1
TSX features & logic:

Are we working under TSX?  If not, just assume we can modify the UCL
	version via the normal mechanism of having access to it
	on the overlay channel, channel 17.  Use SY:UCL.TMP as file if
	exceed room in chain area.

If under TSX, use for input of macro data the local region "UCL".  If
	none, create it (empty).  Use UCL:name.TMP for output if the KMON
	chain area is inadequate, or DK:name.TMP if no UCL device has been
	assigned.
		.Endc

	.psect	data

linemt:	.byte	0,110		;TSX line number EMT area
namemt:	.byte	0,147		;TSX name EMT area.
	.word	namestring
	0			;Precede name by zero as have to trim
namestring: .blkb 12.		; trailing spaces.
namend:	.word	0

ufil:	.rad50	/ucl/		;To check with DSTATUS

havucl:	0			;%8 0 if UCL: assigned
havreg:	0			;%8 non-zero once have writeable region
stack:	0			;Gets thoroughly scrunched

;%8 Data areas concerning region control

.Mcall	.rdbbk,.wdbbk,.crrg,.craw,.gval,.elrg

mread=<macread+63.>/64.
glbblk:	.rdbbk	mread,rs.cgr!rs.gbl,ucl	;Global region set by primary job
regblk:	.rdbbk	mread,rs.cgr!1,ucl	;Local region for each subjob
winblk:	.wdbbk	7,mread,0,0,0,ws.map	;Window into PAR 7
eliblk:	.rdbbk	0,0,0			;Elimination block

	.psect	mesage	con

ucl:	.asciz	/@ucl:/
dk:	.asciz	/@dk:/
tmp:	.asciz	/.tmp/

	.psect

.Enabl	lsb


Tsxset::
	mov	r0,-(sp)
	mov	r1,-(sp)
	mov	r2,-(sp)
	mov	r5,-(sp)

	mov	sp,stack

	mov	#linemt,r0
	emt	375
	bcc	tsx
	  jmp	rt11		;Not running under TSX

;---------------------------------------------------------------------------
; TSX
;---------------------------------------------------------------------------

tsx:	inc	tsxflg		;Remember we're running under TSX
	clr	havreg		;%8 Zero till have writeable region

	clr	havucl		;%8
	.dstatus #area,#ufil	;%8 If no UCL device, use DK instead
	bcc	10$		;%8
	inc	havucl		;%8
10$:

;%8 Set up the potential output filename UCL:name.TMP
;%8 ---------------------------------------------------

	mov	#namemt,r0	;%8
	emt	375		;%8 Get the name string
	mov	#namend,r0	;%8 Trim trailing spaces
20$:	cmpb	-(r0),#40	;%8
	bne	30$		;%8
	clrb	(r0)		;%8
	br	20$		;%8
30$:	tstb	namestring	;%8 If no name, put in XXXXXX
	bne	40$		;%8
	mov	#"XX,namestring	;%8
	mov	#"XX,namestring+2 ;%8
	mov	#"XX,namestring+4 ;%8
40$:
	clrb	namestring+6	;%8 Trim to 6 characters

	mov	#outtmp,r1	;%8
	mov	r1,r2		;%8
	mov	#1,(r1)+	;%8 Start count at 1 for terminating null
	mov	#ucl,r0		;%8
	tst	havucl		;%8
	beq	50$		;%8
	mov	#dk,r0		;%8
50$:	call	puts		;%8 Insert string

	mov	#namestring,r0	;%8
	call	puts		;%8 Then name

	mov	#tmp,r0		;%8
	call	puts		;%8

	.csispc	#files,#zdefext,#outtmp+3	;%8 Decode filename

	mov	#filein,r0	;%8 Get filename in radix50
	mov	#outfil,r1	;%8
	mov	(r0)+,(r1)+	;%8 Device
	mov	(r0)+,(r1)+	;%8  file
	mov	(r0)+,(r1)+	;%8   name
	mov	(r0)+,(r1)+	;%8    extension

;----------------------------------------------------------------------------
; Try to attach to the local "UCL" region				;%8
;----------------------------------------------------------------------------

;Logic:
;	If primary job, use region UCLn where n is the job number.
;		This is a global region.  If it has been set up, use it.
;		Otherwise set it up empty.

;	If subjob, see if a local region has been set up.  If not, try
;		to read global region UCLn.  If available, read it;
;		if not, just leave things empty.
;	    If writing out is required, then set up a local region.


	.gval	#area,#-2		;Get the job number
	mov	r0,r2
	.gval	#area,#-22.		;Get the primary job number
	mov	r0,r1
	bne	subjob			;Subjob


; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Here, we are driving a primary job.
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

	mov	r2,r0			;Get the job number back
	call	r53			;Convert to radix50
	mov	r0,glbblk+r.gnam+2	;Place as second half of name

	.crrg	#area,#glbblk		;Attempt to create the global region
	bcc	60$
	  jmp	grcer
60$:
	mov	glbblk+r.gsts,r1	;Hold region status
	mov	glbblk+r.gid,winblk+w.nrid ;Get region ident for mapping

	.craw	#area,#winblk
	bcc	70$
	  jmp	gmaper
70$:
	bit	#rs.nal,r1		;See if it is a new region.
	beq	80$

	call	wrtsx1			;New region: set it up null.
80$:
	call	rdtsx			;Old region: get its data.
	inc	havreg			;Have region to write into
	jmp	120$


; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Subjob
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -


subjob:
	.crrg	#area,#regblk		;Set up local region
	bcc	81$
	  jmp	lrcer
81$:	bit	#rs.nal,regblk+r.gsts	;See if new one created
	bne	90$

	mov	regblk+r.gid,winblk+w.nrid ;Get region ident for mapping
	.craw	#area,#winblk
	bcc	82$
	  jmp	lmaper
82$:	call	rdtsx			;Already exists - use it.
	inc	havreg			;Able to write into it too.
	jmp	120$

;Local region does not exist.  Look for a global one.

90$:
	mov	r1,r0			;Set up global region
	call	r53
	mov	r0,glbblk+r.gnam+2
	.crrg	#area,#glbblk
	bcs	grcer

	bit	#rs.nal,glbblk+r.gsts	;See if new global region
	beq	100$			;No: just use it

;New global region inadvertently created.  Scrub it fast!  Zero the local one.

	mov	glbblk+r.gid,eliblk+r.gid
;;;	.elrg	#area,#eliblk
;;;	bcs	grder
;;;
;;;As I CANNOT get the region to be eliminated, try zeroing it anyway
	mov	glbblk+r.gid,winblk+w.nrid		;;;
	.craw	#area,#winblk				;;;
	bcs	gmaper					;;;
	call	wrtsx1					;;;


	mov	regblk+r.gid,winblk+w.nrid ;Get region ident for mapping
	.craw	#area,#winblk
	bcs	lmaper
	inc	havreg
	call	wrtsx1
	br	120$

;Old global region.  Scrub our new local one.  Use global data.

100$:
	mov	regblk+r.gid,eliblk+r.gid

;;;	.elrg	#area,#eliblk
;;;	bcs	lrder
;;;AGAIN CANNOT GET THE SCRUBBING TO WORK.  PUT DATA INTO LOCAL ONE

	mov	glbblk+r.gid,winblk+w.nrid ;Get region ident for mapping
	.craw	#area,#winblk
	bcs	gmaper

	call	rdtsx

	mov	regblk+r.gid,winblk+w.nrid	;;;
	.craw	#area,#winblk			;;;
	bcs	lmaper				;;;
	call	wrtsx1				;;;
	inc	havreg				;;;

	br	120$

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

;Set up regions if have to write data under TSX

wrtsx:	mov	r0,-(sp)
	mov	r1,-(sp)
	mov	r2,-(sp)

	tst	havreg
	bne	wrtsx2

	.crrg	#area,#regblk
	bcs	lrcer
	mov	regblk+r.gid,winblk+w.nrid	;Get ident
	.craw	#area,#winblk
	bcs	lmaper
	br	wrtsx2

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

grcer:	error	</Cannot locate UCL region for primary job/<0>>
	.exit
lrcer:	error	</Cannot locate local UCL region/<0>>
	.exit
grder:	error	</Cannot erase global UCL region/<0>>
	.exit
lrder:	error	</Cannot erase local UCL region/<0>>
	.exit
gmaper:	error	</Cannot access global UCL region/<0>>
	.exit
lmaper:	error	</Cannot access local UCL region/<0>>
	.exit


;---------------------------------------------------------------------------
; RT-11
;---------------------------------------------------------------------------
;Set up command for output if insufficient room in chain area.  Filename is
; already set up on start of programme.

rt11:
	mov	#outcmd,r0
	mov	#outtmp,r1
	mov	r1,r2
	clr	(r1)+
110$:	inc	(r2)
	movb	(r0)+,(r1)+
	bne	110$
;---------------------------------------------------------------------------

120$:
	mov	stack,sp
	mov	(sp)+,r5
	mov	(sp)+,r2
	mov	(sp)+,r1
	mov	(sp)+,r0
	return

.Dsabl	lsb

;---------------------------------------------------------------------------
; TSX Data I/O routines							;%8
;---------------------------------------------------------------------------

.Enabl	lsb

rdtsx::
	mov	r0,-(sp)
	mov	r1,-(sp)
	mov	r2,-(sp)

	mov	#160000,r0
	mov	#1000,r1
	br	10$

wrtsx1::
	mov	r0,-(sp)
	mov	r1,-(sp)
	mov	r2,-(sp)
wrtsx2::
	mov	#1000,r0
	mov	#160000,r1
10$:
	mov	#macread/2,r2
20$:
	mov	(r0)+,(r1)+
	sob	r2,20$

	mov	(sp)+,r2
	mov	(sp)+,r1
	mov	(sp)+,r0
	return

.Dsabl	lsb

;----------------------------------------------------------------------------


;Routine to enter data into area suitable for KMON chain

puts:	movb	(r0)+,(r1)+	;Transfer character
	beq	10$		;End of string
	inc	(r2)		;Increment count
	br	puts
10$:	dec	r1		;Forget last null
	return

;Routine called by PWD to put bytes into string

nput:	movb	r0,(r1)+
	return
.Sbttl	Chkucl - See if allowed to use UCLCVL or not

Chkucl::
	tst	cvlucl
	beq	30$

	mov	#512,r1		;Look at command chain area
	cmpb	(r1)+,#'$
	bne	40$

	mov	#uclstr,r2
20$:
	movb	(r1)+,r0
	call	lcase
	cmpb	r0,(r2)+
	bne	40$

	tstb	r0
	bne	20$

30$:	return			;Command will be processed by normal means

40$:	jmp	illcmd		;Organizes chain to other UCL


lcase:
	cmpb	r0,#'Z
	bhi	10$
	cmpb	r0,#'A
	blo	10$
	bis	#40,r0
10$:	return

	.save
	.psect	mesage
uclstr:	.asciz	/cvl/
	.restore
.Sbttl	r53 - get a decimal digit as 3 radix50 characters

;Expects	r0 / number

;Returns	r0 / .rad50 /num/	eg /12/ if r0/12.

r53::
	mov	r1,-(sp)
	mov	r5,-(sp)

	mov	#area,r1
	mov	#nput,r5
	call	pwd
	clrb	(r1)

	movb	area,r1
	sub	#'0,r1
	ble	20$
	mov	#^r0  ,r0
10$:	add	#<^r1  -^r0  >,r0
	sob	r1,10$
20$:
	movb	area+1,r1
	beq	40$
	sub	#'0,r1
	add	#^r 0 ,r0
30$:	add	#<^r 1 -^r 0 >,r0
	sob	r1,30$

	movb	area+2,r1
	beq	40$
	sub	#'0,r1
	add	#^r  0,r0
	add	r1,r0
40$:
	mov	(sp)+,r5
	mov	(sp)+,r1
	return
.Sbttl	HELP message typing:

help::
	.print	#hmes1
	call	hwait
	.print	#hmes2
	call	hwait
	.print	#hmes3
	call	hwait
	.print	#hmes4
	jmp	rerun


hwait:
	type <<tab><tab><tab><tab><tab><tab>/... type RETURN for more/<200>>
10$:	.ttyin
	cmp	r0,#lf
	bne	10$
	return
.Sbttl	W3n - Write 3 Octal Digits

Dtab:	.word	100,10,1,-1

;Expects:	String address in R1
;		Number (1 byte only) in R0

;Returns:	3-digit number wih leading zeroes in string starting at (r1)
;		R1 advanced to next position

W3n:
	mov	r0,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)

	bic	#^c377,r0	;Scrub anything in the high order word
	mov	#dtab,r2
10$:
	mov	(r2)+,r3	;Next subtractor
	bmi	40$		;End = -1
	movb	#'0,(r1)	;Set up for next digit
20$:
	sub	r3,r0		;Does this subtractor go again?
	bmi	30$		;No.
	incb	(r1)		;Yes - must be 1 higher.
	br	20$
30$:
	add	r3,r0		;End of this subtractor - try the next.
	inc	r1		;Next subtractor = next digit.
	br	10$
40$:
	mov	(sp)+,r3
	mov	(sp)+,r2
	mov	(sp)+,r0
	return

.end	start