.Title WA - Request diverter
.Nlist	bex,toc
.Enabl	lc

.Sbttl	V2	27-Apr-86

	.psect	wadvr
	.psect	program
	.psect	mesage	con

Vermes:	.asciz	/WA Handler for DU munging.  V2 27-Apr-86/


			.if eq 1
History:
V2	27-Apr-86	Put in ability to handle unmapped DU
			Add /W:OFF
V1	29-Mar-86
			.endc

.mcall	.module,.drdef,.addr,.assume,.serr,.print

.module	wa,release=0,version=0,audit=yes

.drdef	wa,50,filst$!spfun$!varsz$,0,0,0

.iif eq tsx$p, .error	;WA may only be used with TSX-plus
.iif eq mmg$t, .error	;WA may only be used with TSX-plus
.iif ne erl$g, .error	;WA may only be used with TSX-plus
;(as in RT there is no spare queue element word to send information in)

p5=172352			;Par 5 register address
.iif ndf $duvec, $duvec=154	;DU vector

hdcqe= 120000 + wacqe - wastrt	;Offsets into a mapped TSX handler
hdlqe= 120000 + walqe - wastrt
hdbeg= 120000 + wabeg - wastrt

.assume	<hdlqe + 2> eq <hdcqe>

sp.psz=373			;Partition Size SPFUN

			.If eq 1
Aim of this handler:
-------------------

This handler allows access in a fairly rigid way to DU partitions, allowing
access to an additional eight partitions of a DU disc.  It is designed to
be used with the Webster/Wilson DU handler (DUCM.MAC source), as it is
essential for its function that both this handler and the DU handler be
mapped devices.

WA should be defined in TSGEN as DEVDEF <WA>,MAPH,HANBUF,DMA

A request for access to WA is munged by this handler to reflect the required
physical unit and partition (optionally with an offset and a fixed size).
The DU handler must be assembled with "$XLINK" defined.  This allows the
handler to test the value of the Q$UMRX (unibus mapping register block
address), and, if it is non-zero, to assume that it contains

	.byte	<physical unit>,<partition>

for the current request.  This of course restricts this handler's usefulness
to Q-bus systems, as Q$UMRX will be used for its intended purpose on
unibus systems.

The information concerning how to mung this handler is installed into the
handler by SET commands.  These SET commands are only accessible under
RT-11, returning an error if used under TSX-plus (for safety)!

The available SET commands are:

	set wa help		types a list of available commands
	set wa tsx		allows SET's from TSX (risky!!!)
	set wa notsx		(default) do not allow SET's from TSX
	set wa duvec=nnn	sets required DU vector address
				[required for determining par 5 address
				of DU handler]
	set wan unit=u		sets physical unit u for logical unit n
	set wan part=p		sets partition for logical unit n
(the next two are only used in smaller systems as a sort of "permanent"
 LD unit facility)
	set wan offset=x	sets a starting offset within logical unit n
	set wan size=x		restricts the size of logical unit n
				[if set to zero, merely passes request to
				DU as per all other requests]
			.endc
.Sbttl	Installation Code

.drins	wa
	return
	return

.Sbttl	Subroutines for SET code

gettbb:				;Get table entry, after checking value
	cmp	r0,#377
	bhi	g.bad		;Only room for 1 byte
gettab:
	asl	r1		;4 bytes per entry in FILTAB.
	asl	r1
	mov	r1,-(sp)
	.addr	#filtab,r1,add
	clr	(r1)+		;(Clear FILTAB on any SET)
	clr	(r1)
	mov	(sp)+,r1
	asl	r1		;8 bytes per entry in PARTAB.
	.addr	#partab,r1,add
	return
g.bad:
	tst	(sp)
	sec
	return

o.hmes:
	.asciz	/SET WA duvec, part, unit, offset, size, (no)tsx, (no)write/
	.even

.assume	. le 376
.Sbttl	SET Code

.drset	TSX,1,o.tsx,no		;Allow/Disallow TSX access
.drset	DUVEC, 1,o.vec,oct	;Set the DU vector value
.drset	PART,1,o.part,num	;Set the partition number for a unit
.drset	UNIT,1,o.unit,num	;Set the physical unit number
.drset	OFFSET,1,o.off,num	;Set an offset
.drset	SIZE,1,o.size,num	;Set size of a unit
.drset	HELP,1,o.help		;Lest we forget.
.drset	WRITE,100000,o.write,no	;Write/NOWrite

o.tsx:
	clr	r3		;set wa tsx
	nop
o.notsx:call	tsttsx
	mov	r3,tsxflg	;non-zero if NO TSX
	return

o.write:
	clr	r3		;set wa write
	nop
o.nowri:call	tsttsx		;set wa nowrite
	call	gettab
	.assume	unit eq 0
	bic	#100000,(r1)
	bis	r3,(r1)		;(has 100000 if NO WRITE)
	return

o.help:
	.addr	#o.hmes,r0	;Allowed under either operating system
	.print
	return

o.vec:	call	tsttsx		;Set the vector to be used to access the
	bit	#^c774,r0	; DU handler by.
	bne	o.bad
	mov	r0,duvec
	return

o.unit:	call	tsttsx		;Set physical unit for this logical unit
	call	gettbb		;Get offset to unit table
	.assume	unit eq 0
	mov	r0,(r1)
	bmi	o.bad		;Can't have high-order bit set, as used for
	return			; NO WRITE flag.

o.part:	call	tsttsx		;Set partition for this unit
	call	gettbb		;Get offset to unit table
	mov	r0,part(r1)
	return

o.off:	call	tsttsx		;Set offset for this unit
	call	gettab
	mov	r0,offset(r1)
	return

o.size:	call	tsttsx		;Set size for this unit
	call	gettab
	mov	r0,size(r1)
	return


tsttsx:
	mov	r0,-(sp)	;See whether we're running under TSX or not.
	.serr		
	mov	sp,stack	;Seems to get scrunched sometimes.
	.addr	#linemt,r0
	emt	375
	bcs	10$
	tst	tsxflg
	bne	whoops
10$:	mov	stack,sp	;RT-11 - always valid.  TSX - valid if flag 0
	mov	(sp)+,r0
	return
whoops:
	mov	stack,sp
	mov	(sp)+,r0
	tst	(sp)+		;Scrub return address
o.bad:	sec
	return

linemt:	.byte	0,110		;TSX line area EMT block
stack:	0

.assume	. le 1000
.Sbttl	Handler Entry Point

	.drbeg	wa
wabeg::				;Handler entry point.
	br	entry		;Need room for tables

;----------------------------------------------------------------------
partab:				;Partition table
	unit=0			;Define offsets to each word
	part=2			;(Note that high-order bit of UNIT used
	offset=4		; for signifying NO WRITE)
	size=6
		filnam=10	;(only used as offset in WORKSP)
.rept	8.
	.word	0,0,0,0		;Eight units.
.endr

filtab:	.rept	8.
	.word	0,0		;Up to eight filenames.
	.endr

duvec:	$duvec			;Address of DU vector
tsxflg:	0			;Non-zero won't allow SETs under TSX
				; Start allowing it, then stop it.

.assume .-wastrt le 1000	;Must still be in SETtable area.
;----------------------------------------------------------------------

Entry:

;Get the unit number of the request

	mov	wacqe,r4
	movb	q$unit(r4),r5
	bic	#^c7,r5

	asl	r5		;Set it up as a table offset.
	asl	r5
	asl	r5
	.addr	#partab,r5,add

	bicb	#7,q$unit(r4)

;Modify the values in the request as per the values in the tables

	.assume unit eq 0
	mov	(r5)+,r0
	bpl	5$
	tst	q$wcnt(r4)	;If NO WRITE, see if it is a write.
	bmi	waerr		;Whoops.
5$:	mov	r0,q$umrx(r4)
	.assume part eq 2
	mov	(r5)+,r0
	movb	r0,q$umrx+1(r4)

;Set up the offset.  Check size against unit size.

	.assume q$blkn eq 0
	mov	(r4),r3		;Hold original block number
	add	(r5)+,(r4)	;If overshoot partition, error.
	bcs	waerr
	tst	(r5)		;If size set up, use for size checking
	beq	30$		;Not set up: leave this to the DU handler
	mov	q$wcnt(r4),r0
	bpl	10$
	neg	r0
10$:	add	#377,r0
	bic	#377,r0
	swab	r0		;Number of blocks for I/O
	add	r3,r0		;Add original starting block
	bcs	waerr
	cmp	r0,(r5)
	bhi	waerr


;See if SPFUN for size.  If so, and the size is set in the tables,
; put it in directly rather than passing the SPFUN across.

	cmpb	q$func(r4),#sp.psz
	bne	30$
.if ne mmg$t
	mov	(r5),-(sp)
	call	@$ptwrd
.iff
	mov	(r5),@q$buff(r4)
.endc
	br	wahome
30$:

;Transfer the queue element across to the DU handler.

;Get the DU par 5 address from the vector

	mov	@duvec,r0		;Need to make sure the code is
	cmp	2(r0),#p5		; compatible with another mapped
	bne	notmap			; handler.
	cmp	10(r0),#p5
	bne	notmap
	mov	6(r0),r0		;Required par 5 value.

;Set up the code for the transfer on the stack

	mov	#<stend-stcode>/2,r1
	.addr	#stend,r2

	mov	r5,-(sp)

40$:	mov	-(r2),-(sp)	;Put code for handler shuffling on stack
	dec	r1
	bne	40$

	mov	#hdlqe,r1	;Address of LQE in either handler
	mov	#p5,r2		;Address of par5 register
	mov	wacqe,r4	;Pointer to queue element
	mov	sp,r5		;Pointer to MARK instruction

	call	2(r5)
	br	watst
.Sbttl	Action if Handler Not Mapped

notmap::			;Entered with DUVEC in R0
	sub	-4(r0),r0	;Subtract offset to get address of DULQE

	tst	2(r0)		;Is handler in use?
	bne	waerr		;Yes.

	mov	walqe,(r0)+	;No - give it our element
	mov	wacqe,(r0)+
	clr	walqe
	clr	wacqe

	.assume	wabeg eq walqe+4
	call	(r0)
watst:
	mov	wacqe,r4	;Did he dispose of it?
	bne	waerr		;No - return an error
	return
waerr:
	bis	#1,@-(r4)
	br	wahome

	.drast	wa,4
wahome:
	.drfin	wa
.Sbttl	Code which has to go on stack

;Expects:
;		R0 / par5 address of required handler
;		R1 / pointer to hdlqe
;		R2 / address of par5 register
;		R4 / pointer to queue element
;		R5 / pointer to MARK instruction

stcode:
	mark	< < <stend - stcode> / 2 > - 1 >

	mov	r5,-(sp)	;Save as will be destroyed in handler
	mov	(r2),-(sp)	;Save current par5 value
	mov	r0,(r2)		;R0 contains par5 address required
	tst	@#hdcqe		;Is handler in use?
	bne	inuse		;Yes.  Just return.

	mov	(sp),(r2)	;Not in use.  Reset so can clear our handler
	clr	(r1)+		; - hdlqe
	clr	(r1)		; - hdcqe
	mov	r0,(r2)		;Reset to other handler
	mov	r4,(r1)		; Into hdcqe of second handler
	mov	r4,-(r1)	; - and hdlqe
	call	@#hdbeg
inuse:
	mov	(sp)+,@#p5	;Restore WA par5 (r2 may have be destroyed)
	mov	(sp)+,r5	; and address for MARK instruction
	rts	r5
stend:

.drend	wa
.Sbttl	TSX Queue Element Definitions

; For use within monitor

q.link	==: 0		;Link to next queue entry
q.csw	==: 2		;Address of CSW for channel making request
q.blkn	==: 4		;Physical block number of request
q.func	==: 6		;Special function code
q.unit	==: 7		;Device unit number (bits 0 through 2)
q.jnum	==: 7		;Job number issuing request (bits 3 through 7)
q.buff	==: 10		;User buffer address relative to Q.PAR
q.wcnt	==: 12		;Word count (+ = read, 0 = seek, - = write)
q.comp	==: 14		;Address of completion routine for request
q.par	==: 16		;PAR relocation bias for buffer address
q.pa5	==: 20		;Mapping value for kernel PAR 5
q.umrx	==: 22		;Address of UMR block assigned for I/O
q.chan	==: 24		;User channel # associated with I/O request
q.devx	==: 26		;Device index number 
q.flag	==: 27		;Device control flags
q.job	==: 30		;Number of job that is making request
q.umvb	==: 31		;Unibus UMR base register number
q.umpb	==: 32		;Original value of Q.BUFF when I/O was initiated
q.umpp	==: 34		;Original value of Q.PAR when I/O was initiated
q.pa6	==: 36		;Mapping value for kernel PAR 6
q.ucsw	==: 40		;Virtual address of user's channel block
q.icsw	==: 42		;Copy of user's channel block (12 bytes)


;For use within handlers

q$link	==: -4		;Link to next queue entry
q$csw	==: -2		;Address of CSW for channel making request
q$blkn	==: 0		;Physical block number of request
q$func	==: 2		;Special function code
q$unit	==: 3		;Device unit number (bits 0 through 2)
q$jnum	==: 3		;Job number issuing request (bits 3 through 7)
q$buff	==: 4		;User buffer address relative to Q$PAR
q$wcnt	==: 6		;Word count (+ = read, 0 = seek, - = write)
q$comp	==: 10		;Address of completion routine for request
q$par	==: 12		;PAR relocation bias for buffer address
q$pa5	==: 14		;Mapping value for kernel PAR 5
q$umrx	==: 16		;Address of UMR block assigned for I/O
q$chan	==: 20		;User channel # associated with I/O request
q$devx	==: 22		;Device index number 
q$flag	==: 23		;Device control flags
q$job	==: 24		;Number of job that is making request
q$umvb	==: 25		;Unibus UMR base register number
q$umpb	==: 26		;Original value of Q$BUFF when I/O was initiated
q$umpp	==: 30		;Original value of Q$PAR when I/O was initiated
q$pa6	==: 32		;Mapping value for kernel PAR 6
q$ucsw	==: 34		;Virtual address of user's channel block
q$icsw	==: 36		;Copy of user's channel block (12 bytes)
.Sbttl	Programme Portion

.mcall	.sreset,.csispc,.writw,.print,.exit,.br,.ttyou,.serr,.fetch,.lookup
.mcall	.savest,.purge,.releas

.macro	type	arg
	.save
	.psect	mesage	con
	$$$=.
	.ascii	arg
	.restore
	mov	r0,-(sp)
	mov	#$$$,r0
	emt	^o351
	mov	(sp)+,r0
.endm	type

.asect
userrb=53
	error$=4
jsw=44
	ovly$=1000

.=jsw
	.word	ovly$
cr=15
lf=12

.psect	data

files::	.blkw	15.	;For .CSISPC
infile::.blkw	24.
defext::.rad50	/dsk         /
line::	.blkb	84.
lintsx::.byte	0,110	;TSX line area EMT block
xstack::0
worksp::.blkw	6	;Work space
area::	.blkw	7	;General EMT area
save::	.blkw	5	;Savestatus space
limit::	.limit
fwrite::0		;100000 if /W:OFF

.psect	program

.Enabl	lsb

Write::
	mov	xstack,sp
	.writw	#area,#17,#1000,#256.,#1
	bcc	start
	type	</?WA-E-Error rewriting handler information/<0>>
Badrun::
	mov	xstack,sp
	bisb	#error$,@#userrb
Start::
	mov	sp,xstack	;Seems to get scrunched sometimes.
	.serr
	tst	tsxflg		;See if allowed to run it from TSX
	beq	rerun
	.addr	#lintsx,r0	;See if running under TSX
	emt	375
	bcs	rerun
	call	listab
	.exit
Rerun::
	mov	xstack,sp
	.csispc	#files,#defext,,#line
	tstb	line		;Anything typed?
	bne	20$
	.print	#vermes
	br	rerun
20$:
	mov	(sp)+,r5	;Get number of switches
	beq	noswt		;No switches specified - clear entry.

	mov	#worksp,r4
	mov	r4,r3
	clr	(r3)+		;Clear out workspace
	clr	(r3)+		; (5 locations)
	clr	(r3)+
	clr	(r3)+
	clr	(r3)+		;(include 2 for filename)
	clr	(r3)
	clr	fwrite
switch::
	clr	r2		;In case no value specified
	mov	(sp)+,r1	;Get next switch
	bpl	30$
	mov	(sp)+,r2
30$:
	bisb	#40,r1		;Make all switches lower case

;----------------------------------------------------------------------
	cmpb	r1,#'u		;UNIT
	bne	40$

	mov	r2,unit(r4)
	br	nexswt
;----------------------------------------------------------------------
40$:	cmpb	r1,#'p		;PARTITION
	bne	50$

	mov	r2,part(r4)
	br	nexswt
;----------------------------------------------------------------------
50$:	cmpb	r1,#'o		;OFFSET
	bne	60$

	mov	r2,offset(r4)
	br	nexswt
;----------------------------------------------------------------------
60$:	cmpb	r1,#'s		;SIZE
	bne	70$

	mov	r2,size(r4)
	br	nexswt
;----------------------------------------------------------------------
70$:	cmpb	r1,#'h		;HELP
	bne	80$

	.print	#vermes
	.print	#hmes
	jmp	rerun
;----------------------------------------------------------------------
80$:	cmpb	r1,#'l		;LIST
	bne	90$

	call	listab
	jmp	rerun
;----------------------------------------------------------------------
90$:	cmpb	r1,#'f		;FILE
	bne	100$

	call	filset
	br	nexswt
;----------------------------------------------------------------------
100$:	cmpb	r1,#'t		;TSX allowed to use it
	bne	110$

	clr	tsxflg
	jmp	write
;----------------------------------------------------------------------
110$:	cmpb	r1,#'n		;TSX not allowed to use it
	bne	120$

	mov	#1,tsxflg
	jmp	write
;----------------------------------------------------------------------
120$:	cmpb	r1,#'r		;Read only
	bne	illswt

	mov	#100000,fwrite
	.br	nexswt
;----------------------------------------------------------------------

nexswt::
	dec	r5
	bne	switch

	mov	#infile,r1	;See which unit he wants us to work on
	call	getunt
	bis	fwrite,(r4)	;Set NO WRITE if requested
	mov	(r4)+,(r0)+	;Transfer data into PARTAB
	mov	(r4)+,(r0)+	; ready for writing to disc
	mov	(r4)+,(r0)+	;(Do it this way so that if an error
	mov	(r4)+,(r0)	; be found it doesn't muck up PARTAB)
	mov	(r4)+,(r1)+	;Transfer filename if used
	mov	(r4),(r1)
	jmp	write

noswt::				;No switches specified: clear entry
	mov	#infile,r1
	call	getunt		;Unit may be specified as WA0:, WA0, or 0
	clr	(r0)+		;Clear unit,
	clr	(r0)+		; partition,
	clr	(r0)+		;  offset, and
	clr	(r0)		;   size.
	clr	(r1)+		;Filename.
	clr	(r1)
	jmp	write

.Dsabl	lsb

;**** GETUNT - Get unit from wherever it be
; Address of file area must br provided in R1.  R0 returns with pointer
; to relevant area in PARTAB, and R1 returns with pointer to relevant
; area in FILTAB.

getunt::
	cmp	(r1),#^rDK	;If device is DK, pretend it wasn't specified
	beq	5$
	mov	(r1),r0
	bne	10$		;Have a device
5$:	mov	2(r1),r0	;Haven't.  Try for filename
	beq	illunt		;None.  Too bad.
	tst	4(r1)		;Make sure only 3 chars if filename
	bne	illunt
	br	chkunt
10$:
	tst	2(r1)		;If device, must not specify file.
	bne	illunt
	.br	chkunt		;Fall through into chkunt.


;**** CHKUNT - Check value in R0 for validity as WA device

;Must be a radix50 digit from 0 through 7.

chkunt::
	cmp	r0,#^r0
	blo	illunt
	cmp	r0,#^r7
	bhi	illunt
	sub	#^r0,r0			;If Rad50 /0/ etc, need to allow
	mov	r0,-(sp)		; for the fact that mere subtraction
	clr	r0			; is not enough to perform the
20$:	sub	#<^r1>-<^r0>,(sp)	; radix50 to binary conversion.
	bmi	30$			;Division by repeated subtraction.
	inc	r0
	br	20$
30$:	tst	(sp)+

40$:	asl	r0
	asl	r0
	mov	r0,r1
	add	#filtab,r1
	asl	r0
	add	#partab,r0
	return
.Sbttl	Error & Help Messages

illswt::
	type	<#?WA-E-Illegal switch specified: #<200>>
	.ttyou	r1
	type	<<cr><lf>#Type /H for help.#<0>>
	br	ill

illunt::
	type	</?WA-E-Illegal logical unit specified/<0>>
ill:	jmp	badrun

	.psect	mesage
hmes::
.ascii	<cr><lf>/Commands for WA are:/<cr><lf><lf>
.ascii	#	*unit/switches:values#<cr><lf><lf>
.ascii	#where unit is a digit 0 through 7,#<cr><lf>
.ascii	#and the switches are:#<cr><lf><lf>
.ascii	#	/u:n	physical unit n#<cr><lf>
.ascii	#	/p:n	partition n#<cr><lf>
.ascii	#	/o:n	offset n#<cr><lf>
.ascii	#	/s:n	size n (in blocks)#<cr><lf><lf>
.ascii	#The first two are for use with large discs, and the#<cr><lf>
.ascii	#latter two with the "fixed LD" technique.#<cr><lf><lf>
.ascii	#	/l	list present partitions#<cr><lf>
.ascii	#	/f	use second file in spec for offset & size details#
.ascii	<cr><lf><lf>
.ascii	#	/r	set unit READ ONLY (no writes allowed)#<cr><lf><lf>
.ascii	#	/t	allow setting up under TSX#<cr><lf>
.ascii	#	/n	not allow setting up under TSX#<cr><lf>
.byte	0

	.psect	program
.Sbttl	List Contents of Partab

.Enabl	lsb

Listab:
	type	</Logical    Physical   Partition	   	Offset		Size		 File/<0>>
	type	</ Unit	     Unit/<0>>

	mov	#partab,r5
	mov	#filtab,r3
	mov	#0,r4
10$:
	type	</  /<200>>
	mov	r4,r0		;Logical Unit
	call	wdt

	mov	(r5)+,r0	;See if NO WRITE
	bpl	15$		;WRITE, right?

	type	<#/nowrite    #<200>>
	bic	#100000,r0
	br	17$
15$:
	type	</	       /<200>>
17$:
	call	wdt		;Physical Unit
	type	</	 /<200>>

	mov	(r5)+,r0	;Partition
	call	wdt
	type	</		/<200>>

	mov	(r5)+,r0	;Offset
	beq	20$
	call	wdt
20$:	type	</		/<200>>

	mov	(r5)+,r0	;Size
	beq	30$
	call	wdt
30$:	type	</		/<200>>

	mov	(r3)+,r0	;Filename
	beq	40$
	call	w50t
	mov	(r3)+,r0
	call	w50t
	br	50$
40$:	tst	(r3)+

50$:
	type	<<0>>

	inc	r4
	cmp	r4,#7
	blos	10$

	return

.Dsabl	lsb
.Sbttl	File Details

.Enabl	lsb

Filset::
	tst	infile			;See that a file was specified
	beq	nofile

	.fetch	limit+2,#infile+<4*2>
	bcs	nofetch
	.purge	#0
	.lookup	#area,#0,#infile+<4*2>
	bcs	nolook

	mov	r0,-(sp)		;Hold size

	.savest	#area,#0,#save
	bcs	nosave
	.releas	#infile+<4*2>

	mov	(sp)+,worksp+size	;Put in size,
	mov	save+2,worksp+offset	; offset,
	mov	infile+<4*2>+2,worksp+filnam ; and filename.
	mov	infile+<4*2>+4,worksp+filnam+2
	return

.Dsabl	lsb

nosave:	type	<#?WA-E-Illegal device specified with /F file#<0>>
	br	.badrun
nolook:	type	<#?WA-E-Cannot find file specified with /F#<0>>
	br	.badrun
nofetch:type	<#?WA-E-Cannot fetch handler for /F file#<0>>
	br	.badrun
nofile:	type	<#?WA-E-No file specified as second file with /F switch#<0>>
.badrun:jmp	badrun
.Sbttl	WDT - Write an unsigned decimal number to the terminal

			.If eq 1
Called by:
		mov	number,r0
		call	wdt
			.endc

DECTAB:	.WORD	10.,100.,1000.,10000.,-1

WDT:
	mov	r0,-(sp)
	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
	tst	(r3)
	bpl	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
	.ttyou
	br	40$
70$:
	add	#60,r2
	mov	r2,r0
	.ttyou

	mov	(sp)+,r2
	mov	(sp)+,r3
	mov	(sp)+,r0
	return
.Sbttl	W50T - Write 3 radix50 characters to the terminal

;(taken from CVLLIB.  Not the most elegant, but saves re-inventing wheels!)

;Expects R0/value of three radix50 characters

W50T::
	mov	r0,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)

	clr	r2		;Force unsigned division for first step.
	mov	r0,r3		;DIV21 expects dividend in R2,R3 divisor in R0
	mov	#50,r0
	call	div21
	call	c50a		; and returns remainder in R0
	mov	r0,-(sp)

	mov	#50,r0
	call	div21		; and quotient in R2 ready for next time.
	call	c50a
	mov	r0,-(sp)

	mov	r3,r0
	call	c50a

	.ttyou
	.ttyou	(sp)+
	.ttyou	(sp)+

	mov	(sp)+,r3
	mov	(sp)+,r2
	mov	(sp)+,r0
	return
.Sbttl	C50A - Convert Radix50 char to Ascii

		.If eq 1
Expects a Radix50 character in R0.  Returns the corresponding Ascii value
in R0, destroying no other registers.  The unassigned Radix50 character,
35, is returned as "*", and any illegal value is returned as "?", with CS.
		.Endc

C50A::
	cmp	#47,r0		;See that it's within range.
	bcc	10$		;==bhis
	mov	#50,r0		;Return this for error char. with carry set.
10$:	movb	r50tab(r0),r0
	return


r50tab:
	.ascii	/ abcdefghijklmnopqrstuvwxyz$.*0123456789?/
	.even
.Sbttl	DIV21 - Signed <double-precision>/<single-precision> integer divide

;(taken from CVLLIB)

		.if eq 1
Called by
	MOV	<hi-ord dividend>,R2
	MOV	<lo-ord dividend>,R3
	MOV	<divisor>,R0
	CALL	DIV21
Returns
	R2/hi-order quotient
	R3/lo-order quotient
	R0/remainder

If divide-by-zero is attempted, the arguments are unaltered, and both
C (carry) and V (overflow) are set.  Normally carry is clear on return.
		.endc
DIV21::
	MOV	R0,-(SP)	;Quotient gets XOR of signs
	BEQ	70$		;Whoops - don't like this!
	BGT	10$
	NEG	R0		;But work internally with positive numbers
10$:	BIC	#77777,(SP)
	ADD	R2,(SP)

	MOV	R2,-(SP)
	BGE	20$
	NEG	R2
	NEG	R3
	SBC	R2
20$:
	MOV	#32.,-(SP)
	MOV	R0,-(SP)	;Save on stack for subtractions
	CLR	R0
30$:
	ASL	R3
	ROL	R2
	ROL	R0
	CMP	R0,(SP)
	BLO	40$
	SUB	(SP),R0		;Subtract out as shift numbers across
	INC	R3		; and mark subtraction in quotient
40$:
	DEC	2(SP)
	BGT	30$

	CMP	(SP)+,(SP)+

	TST	(SP)+
	BGE	50$
	NEG	R0		;Remainder gets sign of dividend
50$:
	TST	(SP)+
	BGE	60$
	NEG	R2
	NEG	R3
	SBC	R2
60$:
	.WORD	CLC!CLV
	RETURN

70$:
	TST	(SP)+
	.WORD	SEC!SEV		;Set both error flags
	RETURN

.end	start
