IO2.MAC
.Title	IO2 - General purpose double buffered I/O routine for RT11
.enabl	lc
.nlist	bex,toc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	 4-Aug-83	CVLLIB Routine
;Rewrite input side of routines as didn't always work properly.
;Change INB, OUB, and OUCLR to INBYT, OUBYT, OUCLRB to prevent library clash
.Sbttl	V1A	16-Apr-83
;Include CMAC definitions to allow automatic assembly with CVLLIB
.SBTTL	V1	13-Jun-82



		.If eq 1
Author:	C G Wilson, 71 Galatea St., Charleville 4470, Australia.

Provides a general-purpose I/O template for RT11 users, with double-buffered
I/O on output to channel 0 and on input sequentially from channels 3-10.


Globals required from the user are:

	Area	>=6 word block for EMT requests
	Error	Routine to print error message and restart
	Errnam	Ascii string to prefix an error message
		.Endc

.Globl	area,error,errnam

.mcall	.wait,.readc,.writc,.rctrlo,.print

.macro	ref	string
	.save
	.psect	mesage	con
	$$$=.
	.ascii	string
	.restore
	.word	$$$
.endm	ref

errbyt=52	;Monitor error byte
userrb=53	;User error byte
error$=4	;Error bit within userrb
b.eof=20000	;Channel status end of file bit
b.hderr=1	;Hard error bit in channel status word
.Sbttl	Double-buffering data:

;The buffer structure consists of a header (6 words long) for each pair
; of buffers, and a buffer detail section (5 words long) for each buffer.

ichan::	0		;Input channel #
numbuf::0		;Number of blocks per buffer

;INPUT BUFFERS:

;Buffer Header:
ibh::	0		;Pointer to current buffer detail block
ibhc::	0		;Byte count for current buffer
ibhp::	0		;Pointer within current buffer (if 0, eof or error)
ibhb::	0		;Next block to be read
ibhf::	0		;Pointer to buffer to be used by next READ request

;Buffer Detail sections:
b.lnk=:0		;Link word to next detail section
b.siz=:2		;Word containing size in words of buffer data area
b.nus=:4		;Word containing actual number of words in use
b.flg=:6		;Flag word: 1 ready for user,
			;	    0 ready for monitor to process
			;		(or being processed, on write)
			;	  400 being processed by monitor (on read)
			;	   -1 eof, -2 error.
b.pnt=:10		;Pointer to data area of buffer.
b.crt=:12		;Pointer to coroutine for this buffer.

ib1h::	.word	ib2h	;First detail section
	.blkw	4
	.word	rdcrt1

ib2h::	.word	ib1h	;Second.
	.blkw	4
	.word	rdcrt2

;OUTPUT BUFFER BLOCKS:

obh::	0
obhc::	0
obhp::	0
obhb::	0
obhf::	0
obhr::	0
ob1h::	.word	ob2h
	.blkw	4
ob2h::	.word	ob1h
	.blkw	4
.SBTTL	SETIBF - Set up Input Buffers

; SETIBF: Entry conditions:
;		R1/	address to start buffers at
;		R2/	number of blocks per buffer
;	Returns:
;		R1 updated to next free loc past buffers
;		CC if OK, CS if insufficient room.

SETIBF::
	mov	r2,-(sp)

	mov	#ib2h,ibh	;Initially point to LAST buffer detail block
	mov	#1,ibhc		;Count (tested after decrementing for zero)
	mov	sp,ibhp		;Must be non-zero or flag as error
	clr	ibhb		;Next input block
	mov	#ib1h,ibhf	;Set "next buffer" for input
	mov	#3,ichan	;Initial input channel.

	swab	r2		;Convert number of blocks to number of words.
	  bne	10$		;Must be within limits!
	mov	r2,ib1h+b.siz	;Both buffers same size at present.
	mov	r2,ib2h+b.siz

	mov	r1,ib1h+b.pnt	;First buffer address
	asl	r2		;Words to bytes
	add	r2,r1		;Move pointer past it, checking for overflow
	  bcs	20$
	mov	r1,ib2h+b.pnt	;Second buffer address
	add	r2,r1
	  bcs	20$

	clr	ib1h+b.flg	;Signify empty buffers
	clr	ib2h+b.flg

	br	20$
10$:
	sec
20$:
	mov	(sp)+,r2
	return
.SBTTL	SETOBF - Set up Output Buffers

; SETOBF: Entry conditions:
;		R1/	address to start buffers at
;		R2/	number of blocks per buffer
;	Returns:
;		R1 updated to next free loc past buffers
;		CC if OK, CS if insufficient room.


SETOBF::
	mov	r2,-(sp)

	mov	#ob1h,obh	;Set header to point to first detail block
	swab	r2		;Blocks to words
	  bne	10$
	mov	r2,obhc		;Set up byte count
	asl	obhc
	inc	obhc		;(Need INC as DEC then BEQ)

	clr	obhb		;Next block for output
	mov	r1,obhp		;Output buffer pointer to data area

	mov	#ob1h,obhf	;Next buffer for write and coroutine
	mov	#ob1h,obhr	; use

	mov	r2,ob1h+b.siz	;Buffer size (same at present)
	mov	r2,ob2h+b.siz
	mov	r2,ob1h+b.nus	;Same as number of words in use
	mov	r2,ob2h+b.nus

	mov	#1,ob1h+b.flg	;Set flag saying ready for programme use
	mov	#1,ob2h+b.flg

	mov	r1,ob1h+b.pnt	;First buffer address
	asl	r2		;Words to bytes
	add	r2,r1		;Point past this buffer
	  bcs	20$
	mov	r1,ob2h+b.pnt
	add	r2,r1
	br	20$
10$:
	sec
20$:
	mov	(sp)+,r2
	return
.SBTTL	File Input

;**** INBYT **** Actual Byte-by-byte Input.  Returns CS if error or eof.

.enabl	lsb

INBYT::
	tst	ibhp
	beq	40$		;Zero count = previous eof or error

	dec	ibhc		;Any more?
	beq	10$		;No - try next buffer.
	movb	@ibhp,r0
	inc	ibhp
	bic	#177600,r0
	beq	inbyt
	clc
	return
10$:
	mov	ibh,r0		;Set pointers for next buffer
	clr	b.flg(r0)	;So can be filled by RDBUF
	mov	(r0),r0
	mov	r0,ibh

	cmp	b.flg(r0),#-1	;Hit EOF on next buffer?
	bne	15$		; No - all's well.

	cmp	ichan,#10	; Yes.  See if end of all files
	bhi	40$		;EOF proper.
	clr	b.flg(r0)	;Try next file.
	br	10$		;Refuel this buffer too.

15$:
	call	rdbuf		;Set to read succeeding bufferloads.
20$:
	cmp	#1,b.flg(r0)	;See if this buffer's ready for use.
	beq	25$		;Yes.
	tst	b.flg(r0)
	  blt	30$		;Error.
	br	20$		;Wait for it.
25$:
	mov	b.nus(r0),ibhc	;Number of words filled in buffer
	asl	ibhc
	inc	ibhc		;Reset byte count in header
	mov	b.pnt(r0),ibhp	;and pointer
	br	inbyt

30$:				;Must be ERROR to get here.
	cmp	b.flg(r0),#-2	;INPUT ERROR - only give message once
	bne	40$
	mov	#-1,b.flg(r0)
	mov	ichan,r0
	add	#'0,r0		;Set up digit for input channel #
	movb	r0,ierm
	.rctrlo
	.print	#errnam
	.print	#iermes
	bisb	#error$,@#userrb
40$:
	clr	ibhp		;So gets error at top level of input routines
	clr	r0
	sec
	return

.dsabl	lsb

		.save
		.psect	mesage	con
iermes:	.ascii	/Input Error on Channel /
ierm:	.byte	0,0
		.restore
.SBTTL	RDBUF - Read next input buffer

.enabl	lsb

RDBUF::
	mov	r0,-(sp)
	mov	r1,-(sp)
rdnxb:
	mov	ibhf,r1		;Address of subheader for next read
	  beq	50$		;(if zero, no more - previous error or eof)
	tst	b.flg(r1)	;See if ready for filling.
	  bne	50$		;Not.  Just quit.
rdb:
	mov	#400,b.flg(r1)	;Signify queued.

	.readc	#area,ichan,b.pnt(r1),b.siz(r1),b.crt(r1),ibhb
	  bcs	10$
	
	mov	r0,b.nus(r1)	;Number of words actually read
	swab	r0		;Number of blocks
	add	r0,ibhb
	mov	@ibhf,ibhf	;Reset block for next read
	br	rdnxb		;See if next buffer ready

;End of file (or error) on one read:

10$:
	cmpb	@#errbyt,#1	;See what returned error code was
	  beq	30$		;Whoops - Error!
	cmp	ichan,#10	;See if have tried all channels
	bhi	20$		;Yes - complete EOF.

	clr	ibhb		;Try next channel.
	inc	ichan
	clr	b.flg(r1)	;(In case coroutine has run)
	br	rdb



;EOF on last input channel:

20$:
	mov	#-1,b.flg(r1)	;Set EOF in flag word
;;	br	40$
	BR	50$

;ERROR on input:

30$:
	mov	#-2,b.flg(r1)	;Error set in flag word
40$:
	clr	ibhf		;Either EOF or error clears read block link
50$:
	mov	(sp)+,r1
	mov	(sp)+,r0
	return
.dsabl	lsb
.SBTTL	File Output Routines

.enabl	lsb

;**** OUBYT **** Actual Byte-by-byte Output

OUBYT::				;Expects character in R0
	dec	obhc
	beq	10$
	movb	r0,@obhp
	inc	obhp
	clc
	return
10$:
	mov	r0,-(sp)	;Save character for output while swapping
	call	wrbuf		; pointers.  Queue last buffer for output.
	mov	@obh,r0
	mov	r0,obh
20$:
	tst	b.flg(r0)	;See if next buffer free for writing into
	beq	20$		;Not yet, wait on.
	  blt	oerr		;Whoops.
	call	reseto		;Reset output buffer pointers.
	mov	(sp)+,r0
	br	oubyt


;**** RESETO **** Reset output buffer pointers etc

RESETO:
	mov	b.siz(r0),b.nus(r0) ;Reset # in use.
	mov	b.siz(r0),obhc	;Set output byte count from word size of buf
	asl	obhc
	inc	obhc
	mov	b.pnt(r0),obhp	;and buffer data area pointer
	return


;**** OUCLRB **** Flush current output buffer "ring":

OUCLRB::
	mov	r0,-(sp)
	mov	r1,-(sp)

	clr	r1		;Prepare to insert a zero into the buffer
	bit	#1,obhp		;If pointing to odd address, need zero
	beq	30$
	call	oubyt
30$:
	mov	obhc,r0		;Determine number of words used
	asr	r0
	mov	obh,r1
	mov	b.siz(r1),-(sp)
	sub	r0,(sp)
	mov	(sp)+,b.nus(r1)
	beq	40$
	call	wrbuf
	mov	@obh,obh	;Advance current buffer pointer
40$:
	mov	obh,r0
	call	reseto		;Reset output buffer parameters

	.wait	#0
	  bcs	oerr
	mov	(sp)+,r1
	mov	(sp)+,r0
	return

;Output Error

OERR:
	call	error
	ref	</Output Error/<0>>

.dsabl	lsb
.SBTTL	WRBUF - Queue buffer for output

.enabl	lsb

WRBUF::
	mov	r0,-(sp)
	mov	r1,-(sp)

	mov	obhf,r1		;Next buffer detail section for writing
	  beq	20$		;(Zero if previous error)
	clr	b.flg(r1)	;Signify buffer not ready for user.
wrb:
	.writc	#area,#0,b.pnt(r1),b.nus(r1),#wrcrt,obhb
	  bcs	10$
	add	#377,r0		;Round number of blocks as OUCLRB can foul it.
	bic	#377,r0
	swab	r0		;Actual number of words written
	add	r0,obhb		;converted to blocks and added to block #
	mov	@obhf,obhf
	br	20$
.dsabl	lsb

;Output Error

10$:
	mov	#-2,b.flg(r1)	;Set so he'll get error message
	clr	obhf		; and won't try for another buffer
20$:
	mov	(sp)+,r1
	mov	(sp)+,r0
	return
.SBTTL	WRCRT, RDCRT - Write/Read Coroutines

WRCRT::
	mov	obhr,r1		;Next segment for coroutine use
	mov	(r1),obhr	;reset for next time
	br	crt

RDCRT1::
	mov	#ib1h,r1
	br	crt

RDCRT2::
	mov	#ib2h,r1
crt:
	bit	#b.eof!b.hderr,r0	;Test for EOF or Error
	beq	10$		;OK.

	bic	#^c<b.hderr>,r0	;Boob.  Set result to -1 or -2 as appropriate
	com	r0		;WARNING - Relies on B.HDERR=1
	br	20$
10$:
	mov	#1,r0		;If all's well, tell him buffer's ready.
20$:
	mov	r0,b.flg(r1)
	return

.end

N12FIL.MAC
.TITLE	N12FIL - Set up Fortran I/O
.ENABL	LC
.NLIST	BEX,TOC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	2-Mar-80	CVLLIB Routine

	.IF EQ 1
Author:	C G Wilson, 71 Galatea St, Charleville, Australia 4470.

Purpose: To set up a fortran input and output file using a standard CSI
	command string, checking that it is possible to read & write the
	specified files and asking again for them if it is not.

	Called by	I=N12FIL(INFLG,OUFLG,DEFEXT,'Version Message')
		(where DEFEXT is the RAD50 default extensions)

	returns
		INFLG	zero (.FALSE.) if no input file specified
			-1   (.TRUE.)  if input file set up on FORTRAN unit 1
		OUFLG	ibid, for output file on FORTRAN unit 2

		I	0 if all is well, -1 if error (eg units 1 or 2 in
			use, extra channel for internal use not available)
	.ENDC

.GLOBL	N12FIL,IGETC,$AOTS,$FCHNL,$SYSLB
.MCALL	.CSISPC,.PRINT,.PURGE,.ENTER,.LOOKUP

;Offsets from (R5) for arguments:

INFLG=2
OUFLG=4
DEFEXT=6
VERMES=10

BADGO:				;Error return
	MOV	#-1,R0
	RTS	PC
.PAGE
N12FIL::
	MOV	#1,R2		;Ask for FORTRAN unit 1
	MOV	$AOTS,R3
	JSR	PC,$FCHNL
	BIT	#4000,(R0)	;See if already in use
	  BNE	BADGO
	MOV	R0,IN		;Save pointer till ready.

	MOV	#2,R2		;Now for FORTRAN unit 2
	MOV	$AOTS,R3
	JSR	PC,$FCHNL
	BIT	#4000,(R0)
	  BNE	BADGO
	MOV	R0,OUT

	JSR	PC,IGETC	;Get a spare channel for doing our own access.
	TST	R0
	  BLT	BADGO		;Whoops - there ain't one.
	MOVB	R0,LKPBK
	MOVB	R0,ENTBK
REACMD:
	CLR	@INFLG(R0)	;Clear user flags
	CLR	@OUFLG(R0)

	MOV	SP,R1		;No switches yet.
	.CSISPC	#FILBLK,DEFEXT(R5),#0
	MOV	R1,SP
	BCC	10$
	  .PRINT #CSIERR
	  BR	REACMD
10$:
	TST	FILBLK		;See if output file specified
	BNE	30$		;Yes.
	  TST	FILBLK+<15.*2>	;And input file.
	  BNE	50$		;If neither, just print version message.
	.PRINT	VERMES(R5)
	BR	REACMD

30$:
	MOV	#FILBLK+2,R1	;Check for null output filename
	TST	(R1)
	BNE	40$
	  MOV	(PC)+,(R1)
	  .RAD50 /OUT/
40$:
	MOV	FILBLK+<4*2>,LENGTH
	.PURGE	ENTBK
	MOV	#ENTBK,R0
	.ENTER
	BCC	50$
	  .PRINT #ENTERR
	  BR	REACMD
50$:
	TST	FILBLK+<15.*2>	;Check for input file
	  BEQ	70$
	.PURGE	LKPBK
	MOV	#LKPBK,R0
	.LOOKUP
	BCC	70$
	  .PRINT #LKPERR
	  BR	REACMD
70$:
	.PURGE	LKPBK
	MOV	$AOTS,R3	;Do an IFREEC
	MOVB	LKPBK,R0	;Bit corresponding to channel use is 2^channel
	CLR	R1		; in (($AOTS)+20)
	SEC
80$:
	ROL	R1
	DEC	R0
	BPL	80$

	BIC	R1,20(R3)
.PAGE
;Transfer file information from CSI block to FORTRAN system area

SETIF:
	TST	FILBLK+<15.*2>	;Any input file?
	BEQ	SETOF		;No.

	MOV	IN,R0		;Address of fortran area
	MOV	#FILBLK+<15.*2>,R2 ;Transfer dev+filename to fortran system
	ADD	#6,R0
	MOV	(R2)+,(R0)+	;Device
	MOV	(R2)+,(R0)+	;File-
	MOV	(R2)+,(R0)+	; name
	MOV	(R2)+,(R0)	;Extension

	MOV	#2,4(R0)	;Double buffering
	DEC	@INFLG(R5)	;Set flag for user.
SETOF:
	TST	FILBLK		;Any output file?
	BEQ	RETURN

	MOV	OUT,R0		;Fortran area
	MOV	#FILBLK,R2
	BIS	#20,(R0)	;Bit specifying always expand carriage control
	ADD	#6,R0
	MOV	(R2)+,(R0)+
	MOV	(R2)+,(R0)+
	MOV	(R2)+,(R0)+
	MOV	(R2)+,(R0)

	MOV	(R2),14(R0)	;Size specification
	MOV	#2,4(R0)	;Double buffering
	DEC	@OUFLG(R5)
RETURN:
	CLR	R0
	RTS	PC
.PAGE
.SBTTL	Data Area

IN:	0			;For storage of pointers to fortran file areas
OUT:	0

LKPBK:				;Lookup block
	.BYTE	0,1
	.WORD	FILBLK+<15.*2>,0

ENTBK:				;Enter block
	.BYTE	0,2
	.WORD	FILBLK
LENGTH:	.WORD	0,0

FILBLK:	.BLKW	39.

CSIERR:	.ASCIZ	/?CSI-W-Syntax Error/
ENTERR:	.ASCIZ	/?CSI-W-Cannot Write Output File/
LKPERR:	.ASCIZ	/?CSI-W-Input File Not Found/

.END

IO.MAC
.TITLE	IO - General Purpose RT-11 Byte I/O
.NLIST	BEX,TOC
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.Sbttl	V1C	27-Mar-86	CVLLIB Routine
;Fix PSECT's to cope with CVLLIB being all in 1 psect with Release 4
.SBTTL	V1B	10-Apr-80	CVLLIB Routine

	.IF EQ 1
Author:	C G Wilson, 71 Galatea St, Charleville 4470, Australia.

Subroutines:
	IOSET:		(R0, R1, & R2 destroyed)
	IOSETX:
	IOSETS:
		Called by JSR PC,IOSET(X) - does a CSIGEN setting up the
		handlers at (HLIMIT), then getting all available memory
		for setting up buffers ( 1 for input & 1 for output),
		resetting HLIMIT accordingly.  Returns CS if no space for
		even 1000 byte buffers.

		IOSET does a .SRESET, and resets HLIMIT from LIMIT+2.
		IOSETX does no .SRESET and uses current HLIMIT.
		IOSETS allows the user to do his own CSIGEN and switch handling,
			but requires other restrictions because of this:
			(1) R0 must contain the new high core limit such
				as would have been returned by CSIGEN,
			(2) A call to IOCHK should have been made to check for
				no files specified.  Otherwise on finding no
				files specified the <prognam> <vermes> message
				will be typed and the routine re-entered at
				IOSETX, thereby getting a new command line
				without the controlling programme knowing of it.

		One output file only is set up in this version.  Up to 6 input
		files may be specified, but will be read sequentially on calls
		to INB.

	INB:		(R0 returns value)
		Returns a byte from the input, with no editing.
		CS return if EOF or error (contents of @#ERRBYT are
		stored in IOERB)
	OUB:		(No registers altered)
		Transfers byte in R0 to output, returning CS on error.
	OUS:		(No registers altered)
		Sends string pointed to in R0 as per .PRINT request to terminal
		(ie null terminator gives <cr><lf>, <200> gives nothing extra).
	OUCLR:		(R0 cleared)
		Sends current characters in a null-filled buffer up to the
		current 1000-char (256. word) boundary.
	IOCHK:		(R0 destroyed)
		Checks for existence of an input and an output file on channels
		3 and 0 respectively, setting up INFIL and OUFIL suitably.
		If neither channel is in use, the <pname> <vermes> message
		is typed and the CS return taken.

Globals:
	INFIL (byte) non-zero if input file specified
	OUFIL (byte) ibid, output file
	(if neither file is specified, VERMES is printed and another file
		specification is sought)
	IOERB	gets monitor error byte on read & write errors
	LIMIT	a .LIMIT area
	HLIMIT	loc above last loc in use.  To be set before entry to IOSET
	INBUF	pointer to input buffer
	INSIZ	contains size of input buffer (bytes)
	INPNT	pointer within input buffer
	INCNT	input buffer byte count
	INBLK	input block number for next READ
	OUBUF	(corresponding locs for output)
	OUSIZ
	OUPNT
	OUCNT
	OUBLK

(required by IO):

	PNAME	Ascii string (terminated by <200>) of programme name for error
		messages on input and output error.  Eg:
		PNAME::	.ascii	/Prognam/<200>
		produces an error message in the form
		?Prognam-F-Input Error #1
		should a hardware error occur on the input channel.

	DEFEXT	four-word block of radix50 default file extensions for CSIGEN

	VERMES	asciz string for printing version on null command
		(PNAME is printed first)
.ENDC

; These lines and the macros may be useful for programmes

.GLOBL	IOSET,IOSETX,IOSETS,IOCHK,INB,OUB,OUCLR,OUS
.GLOBL	INFIL,OUFIL,IOERB,LIMIT,HLIMIT,INBUF,INSIZ,INPNT,INCNT,INBLK
.GLOBL	OUBUF,OUSIZ,OUPNT,OUCNT,OUBLK,PNAME,DEFEXT,VERMES

.MACRO	OUTB	A
	.IF NB A
	MOV	A,R0
	.ENDC
	JSR	PC,OUB
.ENDM

.MACRO	OUTS	A
	.IF NB A
	MOV	A,R0
	.ENDC
	JSR	PC,OUS
.ENDM


.MCALL	.SRESET,.CSIGEN,.SETTOP,.PRINT,.READW,.WRITW,.WAIT,.TTYOU

CR=15
LF=12

ERRBYT=52
.PAGE
; **** IOSET - Initialize I/O

IOSET::
	.SRESET
	MOV	LIMIT+2,HLIMIT
IOSETX::
IOSET1:
	MOV	SP,R1		;No switches supported at present
	.CSIGEN	HLIMIT,#DEFEXT
	MOV	R1,SP
IOSETS::
	MOV	R0,R1		;Save new high limit after handlers loaded
	MOV	R0,R2		;Also for pointer to first buffer

	JSR	PC,IOCHK	;Check for I/O files
	BCS	IOSET1		;If none, try again.

	.SETTOP	#-2
	TST	(R0)+		;One word past last loc in use
	SUB	R1,R0		;Number of bytes available
	MOV	R0,R1
	BIC	#1777,R0	;Round to multiples of 2*1000 bytes
	BNE	5$
	  SEC			;If no room, CS return
	  RTS	PC
5$:	CLC
	ROR	R0		;Halve for 1 buffer
	MOV	R0,INSIZ	;And store for reference
	SUB	R0,R1		;Remainder of space for other buffer
	BIC	#777,R1		;Multiple of 1000 bytes
	MOV	R1,OUSIZ

	MOV	R2,INBUF	;Pointer to start of input buffer
	ADD	R0,R2		;Add size to point to start of output buffer
	MOV	R2,OUBUF
	ADD	R1,R2		;Then point to first free
	TST	-(R2)		;To last used
	.SETTOP	R2		;Keep tidy in case he uses it
	TST	(R0)+
	MOV	R0,HLIMIT

	MOVB	#3,READ		;Initial input channel
	CLR	IOERB		;Error byte goes here
	CLR	INBLK
	CLR	INCNT
	CLR	OUBLK
	MOV	OUBUF,OUPNT	;Set up ready for first output
	MOV	OUSIZ,OUCNT
	RTS	PC


; **** IOCHK - Check for input & output files having been specified

IOCHK:
	CLR	FILES		;Clear INFIL & OUFIL
	.WAIT	#0
	BCS	10$		;No output file
	INCB	OUFIL
10$:	.WAIT	#3
	BCS	20$		;No input file
	INCB	INFIL
20$:
	TST	FILES		;Any file specified?
	BNE	GOGOOD		;Carry clear return
	.PRINT	#PNAME
	.TTYOU	#40
	.PRINT	#VERMES
	SEC
	RTS	PC
.PAGE
; **** INB - Read an input byte into R0

	.ENABL	LSB
INB::
	TST	INCNT		;Any more?
	BNE	10$		;Yes.
5$:
	CLRB	@#ERRBYT	;In case don't actually use .READ
	MOV	INSIZ,R0	;Calculate word count for buffer
	CLC
	ROR	R0		;Bytes to words
	MOV	R0,INWCT
	TSTB	INFIL		;Is there an input file?
	BEQ	RDER		;No - CS return
	MOV	#READ,R0
	.READW
	BCS	RDER
	ROL	R0		;Words read to bytes
	MOV	R0,INCNT
	SWAB	R0		;Calculate number of blocks read
	BIC	#177400,R0	;Just in case
	ASR	R0
	ADD	R0,INBLK	;And add in to current position in file.
	MOV	INBUF,INPNT	;Reset pointer
10$:
	DEC	INCNT
	MOVB	@INPNT,R0
	INC	INPNT
	BR	GOGOOD
RDER:
	CMPB	@#ERRBYT,#1	;If hard error, prang him.  Ignore EOF, or
	BEQ	RDHER		; channel not in use.
	CLR	INBLK		;Back to block 0
	INCB	READ		;Next channel
	CMPB	READ,#10	;See if used all up.
	BLOS	5$
	CLRB	@#ERRBYT
RDHER:
	CLRB	INFIL		;So doesn't try again
	MOVB	@#ERRBYT,IOERB
	BEQ	GOBAD
	.TTYOU	#'?
	.PRINT	#PNAME
	.PRINT	#RDER.
	BR	GOBAD

	.save
	.PSECT	MESAGE	CON
RDER.:	.ASCII	/-F-Input Error./<200>
	.restore

	.DSABL	LSB
.PAGE
; **** OUB - Send byte in R0 to output file

OUB::
	TSTB	OUFIL		;Make sure there is an output file.
	BEQ	GOBAD
	MOVB	R0,@OUPNT
	INC	OUPNT
	DEC	OUCNT
	BLE	OUX
	BR	GOGOOD
OUX:				;Extra routine for sending current buffer
	MOV	R0,-(SP)	;Don't change his argument
	CLRB	@#ERRBYT	;In case don't actually .WRITE
	TSTB	OUFIL		;See if there is an output file
	BEQ	GOBAD		;Whoops.
	MOV	OUSIZ,R0	;Actually calculate word count in case not full
	SUB	OUCNT,R0
	CLC
	ROR	R0
	BEQ	10$		;Don't write if there's nothing to write.
	MOV	R0,OUWCT
	MOV	#WRITE,R0
	.WRITW
	BCS	WRER

	SWAB	R0		;Calculate # blocks written
	ADD	R0,OUBLK	; and reset OUBLK accordingly.
10$:	MOV	OUBUF,OUPNT
	MOV	OUSIZ,OUCNT
	MOV	(SP)+,R0
GOGOOD:	CLC
	RTS	PC
WRER:
	CLRB	OUFIL
	MOVB	@#ERRBYT,IOERB
	.TTYOU	#'?
	.PRINT	#PNAME
	MOV	#60,R0
	ADD	IOERB,R0	;Set up to type error code.
	MOVB	R0,ER.
	.PRINT	#WRER.
	MOV	(SP)+,R0
GOBAD:	SEC
	RTS	PC

	.save
	.PSECT	MESAGE
WRER.:	.ASCII	/-F-Output Error #/
ER.:	.BYTE	0,0
	.restore

; **** OUCLR - Send whatever output is ready, to the end of a 256. word block

OUCLR::
	CLR	R0		;To null fill
	BIT	#777,OUCNT	;Test for block boundary
	BEQ	OUX
	JSR	PC,OUB
	BR	OUCLR
.PAGE
; **** OUS - Send string to output file

OUS:
	MOV	R0,-(SP)	;Don't bugger his arguments
	MOV	R1,-(SP)

	MOV	R0,R1
10$:
	MOVB	(R1)+,R0
	BEQ	20$
	BIC	#177600,R0	;Check for null or <200> terminator
	BEQ	30$
	OUTB
	BCS	40$		;Return CS if get it back from OUB
	BR	10$
20$:
	OUTB	#CR
	OUTB	#LF
30$:
	CLC
	BR	50$
40$:
	SEC
50$:
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RTS	PC
.PAGE
.SBTTL	Data Area

LIMIT::	.LIMIT			;For monitor-defined limits
HLIMIT::0			;For user-defined limits

IOERB::	0			;For contents of @#ERRBYT

FILES:				;For access as a word
INFIL::	.BYTE	0		;Non zero if input file specified
OUFIL::	.BYTE	0		;ibid, output file

;Read & Write Blocks:

READ:	.BYTE	3,10		;Channel, READ request
INBLK::	0			;Input block #
INBUF::	0			;Pointer to Input Buffer
INWCT:	0			;Input word count
	0			;To make it .readW

INSIZ::	0			;Size in bytes of input buffer
INPNT::	0			;Pointer within input buffer
INCNT::	0			;Count of remaining bytes

WRITE:	.BYTE	0,11
OUBLK::	0
OUBUF::	0
OUWCT:	0
	0

OUSIZ::	0
OUPNT::	0
OUCNT::	0

.END

CVLVER.MAC
.TITLE	CVLLIB - Print release number of CVLLIB
.Enabl	lc
.Nlist	bex,toc
.dsabl	gbl

.psect	cvllib

.Sbttl	V4	27-Mar-86	CVLLIB Routine
.Sbttl	V3D	30-May-85
.Sbttl	V3C	26-Sep-84
.Sbttl	V3B	16-Oct-83

.Mcall	.print,.exit

CVLLIB::
	.print	#cvlv
	.exit

.save
.psect	mesage	con
cvlv:
	.asciz	/CVLLIB Release 4/
.restore
.end	cvllib

TODAYT.MAC
.Title	TODAYT - Type today's day & date to the terminal
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V3	1-Mar-81	CVLLIB Routine

.globl	w$ct,today
		.If eq 1
Called by
		MOV	#dateblock,R2
		CALL	TODAYT

Types today's day & date to the terminal eg "Tuesday 6-Jan-81", returning
today's date information in <dateblock>.

On return Carry is set if there is no system date set up.  Under these
circumstances, nothing will have been typed.
		.Endc

TODAYT::
	call	w$ct
	.word	today
.end

TODAY.MAC
.Title	TODAY - Type today's day & date to a string
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V5	1-Mar-81	CVLLIB Routine

.globl	rsdat,crdatw,iday,wdat,wday

		.If eq 1
Called by
		MOV	#dateblock,R2
		MOV	#string,R1
		CALL	TODAY

Types today's day & date to a string in the form "Monday 5-Jan-81".
The string pointer is in R1.  <dateblock> receives information concerning
today's date.

On return Carry is set if no system date has been set up.  Nothing will have
been sent to the string.
		.Endc

TODAY::
	MOV	R0,-(SP)

	CALL	RSDAT		;Put system date into RTDAT
	BCS	40$		;If not set up, CS return

	CALL	CRDATW		;Convert Rt11 date to words
	CALL	IDAY		;Find day of week
	CALL	WDAY		;Move name of day into string.
	MOVB	#40,(R1)+	;Separate with a space

	CLR	R0		;No space required before date if day<10
	CALL	WDAT		;Write the date
40$:
	MOV	(SP)+,R0
	RETURN
.END

WDAYT.MAC
.Title	WDAYT - Write name of day to terminal
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	21-Jan-81	CVLLIB Routine

.globl	w$t,wday

		.If eq 1
Called by
		MOV	<day>,R0
		CALL	WDAYT

writes the name of the day corresponding to the number in R0 to the
user's terminal.  Numbers from 1 to 7 produce "Sunday" through
"Saturday" respectively; anything else produces "Illegal".
		.Endc

WDAYT::
	call	w$t
	.word	wday
.end

WDAY.MAC
.Title	WDAY - Write name of day to string
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1A	11-Mar-81	CVLLIB Routine

		.If eq 1
Called by
		MOV	<day>,R0
		MOV	<string>,R1
		CALL	WDAY

Writes the name of the day corresponding to the number in R0 into the
string pointed to in R1.  Day numbers are 1-7 for Sunday to Saturday
respectively.  An illegal day name causes "Illegal" to be typed.
		.Endc

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

	cmp	r0,#7
	blos	5$
	clr	r0		;Illegal value
5$:
	mov	#namstr,r2	;Day in R0, string of daynames in R2
10$:
	dec	r0
	blt	30$
20$:
	tstb	(r2)+		;Skip over days till get to today
	bne	20$
	br	10$
30$:
	movb	(r2)+,(r1)+	;Move name of day into string
	bne	30$
	dec	r1		;Point back to terminating null

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

	.save
	.psect	mesage	con
namstr:
	.asciz	/Illegal/
	.asciz	/Sunday/
	.asciz	/Monday/
	.asciz	/Tuesday/
	.asciz	/Wednesday/
	.asciz	/Thursday/
	.asciz	/Friday/
	.asciz	/Saturday/
	.restore
.end

WSDATT.MAC
.Title	WSDATT - Write system date to the terminal
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V3A	18-Mar-81	CVLLIB Routine

.globl	w$ct,wsdat

		.If eq 1
Called by
		MOV	#dateblock,R2
		MOV	#flag,R0
		CALL	WSDATT

Uses R0 as a flag to determine whether or not to include a leading
space should the day be <10.  Does not include a leading space if (R0) >= 0.

<dateblock> receives date information relevant to the system date.

On return, Carry is set if no system date has been set up.  Under these
circumstances, nothing will have been written.
		.Endc

WSDATT::
	call	w$ct
	.word	wsdat
.end

WSDAT.MAC
.Title	WSDAT - Write system date to a string
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V3A	18-Mar-81	CVLLIB Routine

.globl	rsdat,crdatw,wdat

		.If eq 1
Called by
		MOV	#dateblock,R2
		MOV	#string,R1
		MOV	#flag,R0
		CALL	WSDAT

Writes the date from the system to a string pointed to in R1.
Uses R0 as a flag as to whether or not to have a space should the
day be <10.  If R0 >= zero, no leading space will be included.

<datblock> receives date information relevant to today's date.

On return Carry is set if no system date has been set up.  Under these
circumstances, nothing will have been written.
		.Endc

WSDAT::
	call	rsdat		;Get system date
	bcs	10$		; (if set up)
	call	crdatw		;Convert to words DAY, MONTH, & YEAR
	jmp	wdat
10$:	return
.end

WDATT.MAC
.Title	WDATT - Write date to user's terminal
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V3A	18-Mar-81	CVLLIB Routine

.globl	w$t,wdat

		.If eq 1
Called by
		MOV	#dateblock,R2
		MOV	#<value>,R0
		CALL	WDATT

R0 is used as a flag to decide whether or not to place a leading space
before the day digit if it be less than ten.  If R0 >= 0, no space will
be printed; otherwise eg "2-Jan-80" will be printed as " 2-Jan-80".

The date information is expected to be available in <dateblock>.
It is NOT checked for validity.  An illegal month produces "XXX".
No registers are altered.
		.endc

WDATT::
	call	w$t
	.word	wdat
.end

WDAT.MAC
.Title	WDAT - Write the date into string pointed to in R1
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V5	18-Mar-81	CVLLIB Routine

.globl	wd

		.If eq 1
Called by
	MOV	#dateblock,R2
	MOV	#string,R1
	MOV	#flag,R0 [if negative, print a space before first digit (day)
				if it is less than 10 - ie " 2-Jan-80"
				rather than "2-Jan-80".]
	CALL	WDAT

No registers are altered.

WDAT expects the day, month, and year information to be available in
the <dateblock>.  It is not checked for validity, an invalid month
producing the name "XXX".
		.endc
;--------------------------------------------------------
; Description of DATE BLOCK format:
;
; The block required for Date routines comprises
; 5 words sequentially as follows (defined as offsets) -

DAY=0		; day of month (1-31)
MONTH=2		; month of year (1-12)
YEAR=4		; either actual, or less 1900
DYEAR=6		; day of year (1-365)
RTDAT=10	; date in RT-11 format
		;  {ie 1b;5b<month>;5b<day>;5b<year-1972>}

; A block is provided in this library for convenience.  It
; may be utilized in Macro by MOV #DATBLK,R2 or through
; Fortran in the form
;	COMMON/DATBLK/DAY,MONTH,YEAR,DYEAR,RTDAT
;	CALL FTODAT(DAY) {for example}
; All the locations are labelled respectively with those
; names as globals.
;---------------------------------------------------------

WDAT::
	mov	r0,-(sp)	;Save flag value
	bge	10$
	cmp	day(r2),#10.	;If non-zero, and day<10, precede by space
	bhis	10$
	movb	#' ,(r1)+
10$:
	mov	day(r2),r0
	call	wd

	movb	#'-,(r1)+

	mov	#montab,r0
	mov	month(r2),-(sp)	;Check month
	cmp	(sp),#12.
	blos	20$
	clr	(sp)		;Make XXX if invalid
20$:	add	(sp),r0
	add	(sp),r0
	add	(sp)+,r0
	movb	(r0)+,(r1)+
	movb	(r0)+,(r1)+
	movb	(r0)+,(r1)+

	movb	#'-,(r1)+

	mov	year(r2),r0
	call	wd

	mov	(sp)+,r0
	clc			;Need CC return for some calling routines
	return

montab:	.ascii	/XXXJanFebMarAprMayJunJulAugSepOctNovDec/
.end

RSDAT.MAC
.Title	RSDAT - Move System date into RTDAT
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V4	23-May-81	CVLLIB Routine

.mcall	.date
.globl	crdatw
		.If eq 1
Called by
		MOV	#dateblock,R2
		CALL	RSDAT

places the system date information in the RTDAT offset in <dateblock>
returning CS if no system date has been set up.
If the system date has been set up, calls CRDATW to convert the date
to DAY, MONTH, and YEAR for the relevant <dateblock> offsets.
		.Endc

;--------------------------------------------------------
; Description of DATE BLOCK format:
;
; The block required for Date routines comprises
; 5 words sequentially as follows (defined as offsets) -

DAY=0		; day of month (1-31)
MONTH=2		; month of year (1-12)
YEAR=4		; either actual, or less 1900
DYEAR=6		; day of year (1-365)
RTDAT=10	; date in RT-11 format
		;  {ie 1b;5b<month>;5b<day>;5b<year-1972>}

; This block is provided in this library for convenience.  It
; may be utilized in Macro by MOV #DATBLK,R2 or through
; Fortran in the form
;	COMMON/DATBLK/DAY,MONTH,YEAR,DYEAR,RTDAT
;	CALL FTODAT(DAY) {for example}
; All the locations are labelled respectively with those
; names as globals.
;---------------------------------------------------------

RSDAT::
	mov	r0,-(sp)
	.date
	sec
	mov	r0,rtdat(r2)
	beq	10$
	call	crdatw
	clc
10$:	mov	(sp)+,r0
	return
.end

RDATT.MAC
.Title	RDATT - Read date from terminal
.nlist	bex,sym,toc
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V3	9-Jan-82	CVLLIB Routine

.globl	r$t,rdat

		.If eq 1
Called by
		MOV	#dateblock,R2
		MOV	flag,R0
		CALL	RDATT

Reads the date from the terminal, storing it in <dateblock> (also setting
the offsets DYEAR & RTDAT), and returning the day of the week (-1 if
invalid, 1-7 = Sunday through Saturday respectively) in R0.
An invalid day also causes return with Carry set.

<flag> is an indication of the expected date format.  If <flag> be zero, the
month must be alphabetic, and be between the day and the year.  If positive,
the British convention of day/month/year (numeric month) is permitted, and
if <flag> be negative, the American convention of month/day/year may be used.

		.Endc

RDATT::
	call	r$t
	.word	rdat
.end

RDAT.MAC
.Title	RDAT - For converting a string to a date.
.enabl	lc
.nlist	bex,toc,sym
.dsabl	gbl

.psect	cvllib

.Sbttl	V8	9-Jan-82	CVLLIB Routine

.globl	cwdatr		;Routine to convert word date to RT-11
.globl	iday,rd		;RD = read decimal # from string

		.If eq 1
Called by
		MOV	#dateblock,R2
		MOV	#string,R1
		MOV	flag,R0
		CALL	RDAT

Places the day, month, and year in <dateblock> offsets DAY, MONTH, and
YEAR, the day of the year in the offset DYEAR, and the RT-11 format
representing that date in the offset RTDAT.

This subroutine returns through a jump to IDAY, which checks the
validity of the date, returning in R0 -1 if invalid, otherwise the number
of the day of the week (1 to 7, Sunday to Saturday).

An illegal day also causes Carry to be set on return.

<flag> is an indication of the expected date format.  If <flag> be zero, the
month must be alphabetic, and be between the day and the year.  If positive,
the British convention of day/month/year (numeric month) is permitted, and
if <flag> be negative, the American convention of month/day/year may be used.

The <string> should be a null terminated ascii string in any of the following
forms (the examples all being the same, with <flag> positive):

	3-Feb-80
	3/2/1980
	3.feb.80
	3 FEBRUARY 1980
	3Feb80
		.Endc
;--------------------------------------------------------
; Description of DATE BLOCK format:
;
; The block required for Date routines comprises
; 5 words sequentially as follows (defined as offsets) -

DAY=0		; day of month (1-31)
MONTH=2		; month of year (1-12)
YEAR=4		; either actual, or less 1900
DYEAR=6		; day of year (1-365)
RTDAT=10	; date in RT-11 format
		;  {ie 1b;5b<month>;5b<day>;5b<year-1972>}

; A block is provided in this library for convenience.  It
; may be utilized in Macro by MOV #DATBLK,R2 or through
; Fortran in the form
;	COMMON/DATBLK/DAY,MONTH,YEAR,DYEAR,RTDAT
;	CALL FTODAT(DAY) {for example}
; All the locations are labelled respectively with those
; names as globals.
;---------------------------------------------------------

.save
.PSECT	CALEND	RW,D,GBL,REL,OVR
	.If eq 1
This is designed for use as the Fortran Common block CALEND
	REAL DAYNAM,MONNAM
	BYTE MONTHS,MOFSET
	COMMON /CALEND/ DAYNAM(7),MONNAM(12),MONTHS(12),MOFSET(12)
	.Endc
DAYNAM:	.ASCII	/Sun Mon Tue Wed Thu Fri Sat /
MONNAM:	.ASCII	/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec /
MONTHS:	.BYTE	31.,28.,31.,30.,31.,30.,31.,31.,30.,31.,30.,31.
;Mofset contains offset of day of week depending upon month
MOFSET:	.BYTE	0,3,3,6,1,4,6,2,5,0,3,5
.restore
RDAT::
	mov	r0,-(sp)	;Save flag value

	call	rd		;Read a decimal number
	mov	r0,day(r2)
	call	delim		;skip recognizer delimiters

	cmpb	(r1),#'A	;See if numeric or alpha month
	bhis	10$

	call	rd		;Numeric month
	mov	r0,month(r2)
	tst	(sp)		;Test flag
	beq	error		;If zero, month must be alphabetic
	bpl	50$		;If positive, British dd/mm/yy
	mov	day(r2),month(r2);If negative, American mm/dd/yy
	mov	r0,day(r2)
	br	50$
10$:
	mov	r3,-(sp)
	mov	r4,-(sp)
	mov	r5,-(sp)

	clr	month(r2)
	mov	#monnam-4,r5	;Pointer to table of 3-character month names
20$:
	add	#4,r5		;Point to next month
	inc	month(r2)
	cmp	month(r2),#12.	;See if over the odds
	bhi	err3
	mov	#3,r3		;Only look at first 3 chars
	mov	r1,r4		;Save string pointer
	mov	r5,r0		;And start of this month name
30$:
	movb	(r4)+,-(sp)	;Allow either case
	bic	#^c137,(sp)
	movb	(r0)+,-(sp)
	bic	#^c137,(sp)
	cmp	(sp)+,(sp)+
	bne	20$		;Mismatch - try for next month

	dec	r3
	bne	30$		;Try for next character

	mov	(sp)+,r5
	mov	(sp)+,r4	;Found month
	mov	(sp)+,r3
40$:
	cmpb	(r1),#'A	;Scrub any remaining alphabetics
	blo	50$
	cmpb	(r1),#'z
	bhi	50$
	cmpb	(r1),#'Z
	blos	45$
	cmpb	(r1),#'a
	blo	50$
45$:
	inc	r1
	br	40$

50$:
	call	delim		;Skip recognized delimiters

	movb	(r1),r0		;Make sure at least 1 digit for year.
	bic	#177600,r0
	sub	#'0,r0
	cmp	r0,#9.
	bhi	error

	call	rd
	cmp	r0,#100.	;If year <100, add 1900.
	bgt	60$
	add	#1900.,r0
60$:	mov	r0,year(r2)

	call	cwdatr		;Convert date to RT11 format
	tst	(sp)+
	jmp	iday		;Go and verify the date

err3:
	mov	(sp)+,r5
	mov	(sp)+,r4
	mov	(sp)+,r3
error:
	tst	(sp)+		;Scrap flag word
	mov	#-1,r0
	sec
	return
.page
;DELIM - skips recognizer delimiters (anything with value <'0)

	.enabl	lsb
10$:
	inc	r1
DELIM:
	cmpb	(r1),#40	;Spaces and tabs ignored
	beq	10$
	cmpb	(r1),#11
	beq	10$
	tstb	(r1)
	beq	30$

	cmpb	(r1),#'0	;Allow anything <'0
	bhis	30$
20$:
	inc	r1		;Point past delimiter
	cmpb	(r1),#40	;Ignore more spaces or tabs
	beq	20$
	cmpb	(r1),#11
	beq	20$
30$:
	return

.end

CRDATW.MAC
.Title	CRDATW - Convert RT11 Date to Words
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V3	16-Feb-81	CVLLIB Routine

		.If eq 1
Called by
		MOV	#dateblock,R2
		CALL	CRDATW

Converts the RT11 format date (in the <dateblock> offset RTDAT) into
separate words of day, month, and year, storing these in the relevant
offsets in <dateblock>.

There is no error detection on illegal dates.
		.endc
;--------------------------------------------------------
; Description of DATE BLOCK format:
;
; The block required for Date routines comprises
; 5 words sequentially as follows (defined as offsets) -

DAY=0		; day of month (1-31)
MONTH=2		; month of year (1-12)
YEAR=4		; either actual, or less 1900
DYEAR=6		; day of year (1-365)
RTDAT=10	; date in RT-11 format
		;  {ie 1b;5b<month>;5b<day>;5b<year-1972>}

; A block is provided in this library for convenience.  It
; may be utilized in Macro by MOV #DATBLK,R2 or through
; Fortran in the form
;	COMMON/DATBLK/DAY,MONTH,YEAR,DYEAR,RTDAT
;	CALL FTODAT(DAY) {for example}
; All the locations are labelled respectively with those
; names as globals.
;---------------------------------------------------------

CRDATW::
	mov	r0,-(sp)
	mov	rtdat(r2),r0
	bic	#^c37,r0	;Split off year
	add	#1972.,r0
	mov	r0,year(r2)

	mov	rtdat(r2),r0
	clc			;Allow for sign bit set in case ever extend
	ror	r0		; date format by another 32 years.
	asr	r0
	asr	r0
	asr	r0
	asr	r0
	bic	#^c37,r0
	mov	r0,day(r2)

	mov	rtdat(r2),r0	;And now for month
	swab	r0
	asr	r0
	asr	r0
	bic	#^c37,r0
	mov	r0,month(r2)

	mov	(sp)+,r0
	return
.end

CWDATR.MAC
.Title	CWDATR - Convert date in day, month & year words into RT11 format
.nlist	bex,toc,sym
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	16-Feb-81	CVLLIB Routine

		.If eq 1
Called by
		MOV	#dateblock,R2
		CALL	CWDATR

Converts the values from the DAY, MONTH & YEAR offsets in <dateblock>
into the RT11 format for the date, storing this in the RTDAT offset.
{The Rt11 date format is (1b;5b<month>;5b<day>;5b<year-1972>).}
The year may be in full (eg 1981) or part (eg 81).  If before 1972
the year field will be left zero.

There is no error detection on illegal dates.
		.Endc
;--------------------------------------------------------
; Description of DATE BLOCK format:
;
; The block required for Date routines comprises
; 5 words sequentially as follows (defined as offsets) -

DAY=0		; day of month (1-31)
MONTH=2		; month of year (1-12)
YEAR=4		; either actual, or less 1900
DYEAR=6		; day of year (1-365)
RTDAT=10	; date in RT-11 format
		;  {ie 1b;5b<month>;5b<day>;5b<year-1972>}

; A block is provided in this library for convenience.  It
; may be utilized in Macro by MOV #DATBLK,R2 or through
; Fortran in the form
;	COMMON/DATBLK/DAY,MONTH,YEAR,DYEAR,RTDAT
;	CALL FTODAT(DAY) {for example}
; All the locations are labelled respectively with those
; names as globals.
;---------------------------------------------------------

CWDATR::
	mov	r0,-(sp)
	mov	month(r2),r0
	asl	r0
	asl	r0
	asl	r0
	asl	r0
	asl	r0

	add	day(r2),r0
	asl	r0
	asl	r0
	asl	r0
	asl	r0
	asl	r0

	mov	year(r2),-(sp)
	cmp	(sp),#100.
	bge	10$
	add	#1900.,(sp)
10$:	sub	#1972.,(sp)
	ble	20$		;All right - it doesn't cater for 2004+!
	add	(sp),r0
20$:	tst	(sp)+
	mov	r0,rtdat(r2)

	mov	(sp)+,r0
	return
.end

DATDIF.MAC
.Title	DATDIF - For calculating differences between dates
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2A	4-Mar-82	CVLLIB Routine

.globl	iday

		.If eq 1
Called by
		MOV	#<dateblock-1>,R0
		MOV	#<dateblock-2>,R2
		CALL	DATDIF
Returns		R2,R3/<2.precis> difference in days between dates
		or CS if either of the dates were invalid.

The calculation is <dateblock-2> - <dateblock-1> and will produce a
negative result if necessary.
		.Endc
;--------------------------------------------------------
; Description of DATE BLOCK format:
;
; The block required for Date routines comprises
; 5 words sequentially as follows (defined as offsets) -

DAY=0		; day of month (1-31)
MONTH=2		; month of year (1-12)
YEAR=4		; either actual, or less 1900
DYEAR=6		; day of year (1-365)
RTDAT=10	; date in RT-11 format
		;  {ie 1b;5b<month>;5b<day>;5b<year-1972>}

; This block is provided in this library for convenience.  It
; may be utilized in Macro by MOV #DATBLK,R2 or through
; Fortran in the form
;	COMMON/DATBLK/DAY,MONTH,YEAR,DYEAR,RTDAT
;	CALL FTODAT(DAY) {for example}
; All the locations are labelled respectively with those
; names as globals.
;---------------------------------------------------------


DATDIF::
	mov	r5,-(sp)
	mov	r4,-(sp)
	mov	r0,-(sp)
	clr	-(sp)		;Used as flag for negative date diff

	mov	r0,r4		;Lesser year pointed to in R4, greater in R5
	mov	r2,r5
	cmp	year(r4),year(r5)
	ble	10$
	inc	(sp)		;Set negative difference flag
	mov	r2,r4
	mov	r0,r5
10$:
	clr	r0		;Used for higher-order result as R2 in use

	mov	r5,r2		;Check out greater date
	call	$iday
	  bcs	error
	mov	dyear(r2),r3

	mov	r4,r2		;and lesser
	call	$iday
	  bcs	error
	sub	dyear(r2),r3
	sbc	r0		;Propagate carry to R0

	mov	year(r4),tmpyr	;Keep year in block for incrementing prn.
	mov	#tmpblk,r2
20$:
	cmp	tmpyr,year(r5)	;Have we looked at all the years between?
	beq	30$
	call	$iday		;Calculate number of days in the year
	add	tmpdy,r3
	adc	r0
	inc	tmpyr
	br	20$
30$:
	tst	(sp)+		;See if negative result required
	beq	40$
	neg	r0
	neg	r3
	sbc	r0
40$:
	clc
	br	ret

error:
	tst	(sp)+
	sec
ret:
	mov	r0,r2		;Put high-order result where we want it
	mov	(sp)+,r0
	mov	(sp)+,r4
	mov	(sp)+,r5
	return

tmpblk:	31.			;Dateblock with 31-Dec-?? in it.
	12.
tmpyr:	0
tmpdy:	0
	0
$iday:
	mov	r0,-(sp)
	call	iday
	mov	(sp)+,r0
	return
.end

DATCAL.MAC
.Title	DATCAL - Calculate dates from YEAR & DYEAR
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	5-Apr-81	CVLLIB Routine

.globl	iday
		.If eq 1
Called by
		MOV	#<dateblock>,R2
			(with a YEAR and DYEAR [day of year] already
			set up)
		CALL	DATCAL
Returns
		CS if invalid date, or if calculations took date back
			before 1600
		DAY, MONTH, YEAR, and DYEAR offsets in <dateblock>
			set to date corresponding to original DYEAR.

The original value for DYEAR may be positive or negative.  Note however
that 1-Jan is counted as day 1, thereby making 0 the 31-Dec of the previous
year, and -1 the 30-Dec of the previous year.
		.Endc
;--------------------------------------------------------
; Description of DATE BLOCK format:
;
; The block required for Date routines comprises
; 5 words sequentially as follows (defined as offsets) -

DAY=0		; day of month (1-31)
MONTH=2		; month of year (1-12)
YEAR=4		; either actual, or less 1900
DYEAR=6		; day of year (1-365)
RTDAT=10	; date in RT-11 format
		;  {ie 1b;5b<month>;5b<day>;5b<year-1972>}

; This block is provided in this library for convenience.  It
; may be utilized in Macro by MOV #DATBLK,R2 or through
; Fortran in the form
;	COMMON/DATBLK/DAY,MONTH,YEAR,DYEAR,RTDAT
;	CALL FTODAT(DAY) {for example}
; All the locations are labelled respectively with those
; names as globals.
;---------------------------------------------------------

.save
.PSECT	CALEND	RW,D,GBL,REL,OVR
	.If eq 1
This is designed for use as the fortran common block CALEND and is modified
(to reflect the number of days in the year) in IDAY.
	REAL DAYNAM,MONNAM
	BYTE MONTHS,MOFSET
	COMMON /CALEND/ DAYNAM(7),MONNAM(12),MONTHS(12),MOFSET(12)
	.Endc
DAYNAM:	.ASCII	/Sun Mon Tue Wed Thu Fri Sat /
MONNAM:	.ASCII	/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec /
MONTHS:	.BYTE	31.,28.,31.,30.,31.,30.,31.,31.,30.,31.,30.,31.
;Mofset contains offset of day of week depending upon month
MOFSET:	.BYTE	0,3,3,6,1,4,6,2,5,0,3,5
.restore

DATCAL::
	mov	r3,-(sp)	;Use R3 for <dateblock> pointer internally
	mov	r2,r3
	mov	r0,-(sp)
	mov	#tmpblk,r2

	tst	dyear(r3)	;See if positive or negative day of year
	bgt	tstlep

;Negative day of year

TSTLPN:
	mov	year(r3),tmpyr
	dec	tmpyr		;Get number of days in last year
	call	iday
	  bcs	reterr
	movb	months+1,r0	;Days in February of that year
	add	#365.-28.,r0
	dec	year(r3)
	add	r0,dyear(r3)
	ble	tstlpn		;If still negative, go back a further year
	br	thisyr

;Positive day of year

TSTLEP:
	mov	year(r3),tmpyr
	call	iday		;Get number of days in this year
	  bcs	reterr
	movb	months+1,r0
	add	#365.-28.,r0
	cmp	dyear(r3),r0	;See if within this year
	ble	thisyr

;Positive, but not within this year

	inc	year(r3)
	sub	r0,dyear(r3)
	br	tstlep

;Positive, within this year

THISYR:
	mov	#months,r2	;Table of (byte) days per month
	mov	dyear(r3),day(r3) ;DYEAR now ok. Use as basis for DAY
	clr	month(r3)
NEXMON:
	inc	month(r3)
	movb	(r2)+,r0
	cmp	day(r3),r0
	ble	retok
	sub	r0,day(r3)
	br	nexmon

;Returns - error & ok

RETERR:
	sec
	br	ret
RETOK:
	clc
RET:	mov	(sp)+,r0
	mov	r3,r2
	mov	(sp)+,r3
	return

;Temporary year block for getting number of days in year:

TMPBLK:	1	;First
	1	; of January
TMPYR:	0	; whatever year
	0	;Day of this year doesn't matter
	0	; and RT11 format date is ignored.

.end

AGE.MAC
.Title	AGE - Calculate age given date of birth and date
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	5-Apr-81	CVLLIB Routine

		.If eq 1
Called by
		MOV	#<dateblock-1>,R0 {date of birth}
		MOV	#<dateblock-2>,R2 {date to calculate age on}
		CALL	AGE
		CS return if not born yet
		R0/age in years
		R2/and months.
.Endc
;--------------------------------------------------------
; Description of DATE BLOCK format:
;
; The block required for Date routines comprises
; 5 words sequentially as follows (defined as offsets) -

DAY=0		; day of month (1-31)
MONTH=2		; month of year (1-12)
YEAR=4		; either actual, or less 1900
DYEAR=6		; day of year (1-365)
RTDAT=10	; date in RT-11 format
		;  {ie 1b;5b<month>;5b<day>;5b<year-1972>}

; This block is provided in this library for convenience.  It
; may be utilized in Macro by MOV #DATBLK,R2 or through
; Fortran in the form
;	COMMON/DATBLK/DAY,MONTH,YEAR,DYEAR,RTDAT
;	CALL FTODAT(DAY) {for example}
; All the locations are labelled respectively with those
; names as globals.
;---------------------------------------------------------


AGE::
	mov	year(r2),-(sp)
	sub	year(r0),(sp)		;Age in years at birthday this year
	blt	er2			;Not bloody born yet

	mov	month(r2),-(sp)
	sub	month(r0),(sp)
	bgt	20$			;Past his birthday - all's well
	blt	10$			;Before his birthday - year too big

	cmp	day(r2),day(r0)
	bge	20$			;Past or on his birthday.
	dec	(sp)			;Before his birthday.  Back a month
	bgt	20$			;OK if after January
10$:
	add	#12.,(sp)		;Otherwise head to other end of
	dec	2(sp)			; last year.
	blt	er1			;Whoops - negative age again.
20$:
	mov	(sp)+,r2
	mov	(sp)+,r0
	clc
	return

er1:	tst	(sp)+
er2:	tst	(sp)+
	sec
	return
.end

IDAY.MAC
.Title	IDAY - Return Day of Week given date.
.enabl	lc
.nlist	bex,toc,sym
.dsabl	gbl

.psect	cvllib

.Sbttl	V5	1-Mar-81	CVLLIB Routine

		.If eq 1
Called by
		MOV	#dateblock,R2
		CALL	IDAY

Returns (in R0) -1 if the date were invalid, or 1-7 for Sunday through
Saturday respectively, with Carry set on return also for illegal dates.

The date is expected in the relevant offsets in <dateblock>.

The DYEAR offset gets the number of that day in the year (eg 1-Jan-80 = 1).

A common block, /CALEND/, provides ascii names of days and months,
number of days in each month (with February adjusted to correspond
with the last year specified in a call to IDAY), and an extra table
with offsets of days of the week from the first day of the year.

This subroutine only works on dates after 1600.
		.Endc
;--------------------------------------------------------
; Description of DATE BLOCK format:
;
; The block required for Date routines comprises
; 5 words sequentially as follows (defined as offsets) -

DAY=0		; day of month (1-31)
MONTH=2		; month of year (1-12)
YEAR=4		; either actual, or less 1900
DYEAR=6		; day of year (1-365)
RTDAT=10	; date in RT-11 format
		;  {ie 1b;5b<month>;5b<day>;5b<year-1972>}

; A block is provided in this library for convenience.  It
; may be utilized in Macro by MOV #DATBLK,R2 or through
; Fortran in the form
;	COMMON/DATBLK/DAY,MONTH,YEAR,DYEAR,RTDAT
;	CALL FTODAT(DAY) {for example}
; All the locations are labelled respectively with those
; names as globals.
;---------------------------------------------------------

.save
.PSECT	CALEND	RW,D,GBL,REL,OVR
	.If eq 1
This is designed for use as the fortran common block CALEND
	REAL DAYNAM,MONNAM
	BYTE MONTHS,MOFSET
	COMMON /CALEND/ DAYNAM(7),MONNAM(12),MONTHS(12),MOFSET(12)
	.Endc
DAYNAM:	.ASCII	/Sun Mon Tue Wed Thu Fri Sat /
MONNAM:	.ASCII	/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec /
MONTHS:	.BYTE	31.,28.,31.,30.,31.,30.,31.,31.,30.,31.,30.,31.
;Mofset contains offset of day of week depending upon month
MOFSET:	.BYTE	0,3,3,6,1,4,6,2,5,0,3,5
.restore
IDAY::
	mov	r1,-(sp)	;Save all regs used bar R0
	mov	r3,-(sp)
	mov	r4,-(sp)
	mov	r5,-(sp)

	mov	year(r2),r4	;Get year and make 19xx if < 100.
	cmp	r4,#100.
	bge	5$
	add	#1900.,r4
5$:
	tst	month(r2)	;Test for negative or zero arguments
	ble	error
	tst	day(r2)
	ble	error

	sub	#1600.,r4	;Work from 1600.  Check range of year and
	blt	error		; month.  (Day must wait till after leap
	cmp	month(r2),#12.	; year check).
	bgt	error

	movb	#28.,months+1	;Set non-leap year till proved otherwise.
	clr	r1		;Used as flag for being past leap day.
	bit	#3,r4		;Divisible by 4?
	bne	25$		;No - can't be a leap year.
	mov	r4,r3
10$:	sub	#400.,r3	;Get remainder after div by 400
	bge	10$
	add	#400.,r3
	beq	20$		;Even 400 years are leap years
15$:	sub	#100.,r3
	bge	15$
	add	#100.,r3
	beq	25$		;Other centuries aren't.
20$:
	incb	months+1	;LEAP YEAR - reset days/month in Feb
	cmp	month(r2),#2	; and check if past leap day
	ble	25$
	inc	r1		;Yes - will need an extra day at the end.
25$:
	mov	month(r2),r3	;Get pointer to MONTHS table for checking days
	cmpb	day(r2),months-1(r3)
	bhi	error

	mov	r4,r3		;Calculate how many leap years there would
	add	#3,r3		; be if all years divisible by 4 were leap
	asr	r3		; years (as per Julian Calendar).
	asr	r3

	mov	r4,r5		;Calculate the number of century years
	dec	r5		; included in the above.
	clr	r0
30$:	inc	r0
	sub	#100.,r5
	bge	30$
	dec	r0

	mov	r0,r5		;Apply correction for 400 year leaps
	asr	r0
	asr	r0
	sub	r5,r0
	add	r3,r0		;Number of leap years since 1600 now in R0.

	add	#5,r0		;Day before 1-Jan-1600 was a Friday.
	add	r4,r0		;One day for each year.
	add	day(r2),r0	;Days in this month to date.
	add	r1,r0		;Add in leap day if necessary

	mov	month(r2),r3	;Get offset for particular month.
	movb	mofset-1(r3),r5
	add	r5,r0

35$:	sub	#7,r0
	bge	35$
	add	#8.,r0		;Make from 1 to 7 rather than 0 to 6

	mov	day(r2),dyear(r2) ;Start with day of month, then add in
	mov	month(r2),r1	; days of each preceding month.
40$:
	dec	r1
	beq	ret
	movb	months-1(r1),-(sp)
	bic	#^c377,(sp)	;Make sure high order byte also clear!
	add	(sp)+,dyear(r2)
	br	40$

error:
	mov	#-1,r0
	sec
	br	rx
ret:
	clc
rx:
	mov	(sp)+,r5
	mov	(sp)+,r4
	mov	(sp)+,r3
	mov	(sp)+,r1
	return
.end

WSTIMT.MAC
.Title	WSTIMT - Write system time to the terminal
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2A	18-Mar-81	CVLLIB Routine

.globl	w$t,wstim

		.If eq 1
Called by
		MOV	#timeblock,R2
		MOV	#flag,R0
		CALL	WSTIMT

Uses R0 as a flag to determine whether or not to include seconds in the
string.  Does not include them if low order byte of R0 is zero.
If the sign bit is set in R0, a space will precede the hours digit
if the hours value be less than 10.

System time information is placed in the relevant offsets in <timeblock>.
		.Endc

WSTIMT::
	call	w$t
	.word	wstim
.end

WSTIM.MAC
.Title	WSTIM - Write system time to a string
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2A	18-Mar-81	CVLLIB Routine

.globl	rstim,crtimw,wtim

		.If eq 1
Called by
		MOV	#timeblock,R2
		MOV	#string,R1
		MOV	#flag,R0
		CALL	WSTIM

Writes the time from the system clock to a string pointed to in R1, using R0
as a flag to determine whether or not to include seconds in the string.
Does not include them if the low-order byte in R0 is zero.
If the sign bit in R0 is set, a space will precede the hours digit
if the hours value be less than 10.

System time information is returned in the relevant offsets in <timeblock>.
		.Endc

WSTIM::
	call	rstim		;Get system time
	call	crtimw		;Convert to offsets HOURS, MINS, & SECS
	jmp	wtim
.end

WTIMT.MAC
.Title	WTIMT - Write time to the terminal
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2A	18-Mar-81	CVLLIB Routine

.globl	w$t,wtim

		.If eq 1
Called by
		MOV	#timeblock,R2
		MOV	#flag,R0
		CALL	WTIMT

Writes the time from the <timeblock> to the user's terminal.

R0 is used as a flag to determine how much is to be printed.
If the low-order byte in R0 be zero, seconds will be suppressed.
If the sign bit be set, a space will precede the hours digit if
the hours value be less than 10.  Minutes & seconds will always
comprise two digits.
		.Endc

WTIMT::
	call	w$t
	.word	wtim
.end

WTIM.MAC
.Title WTIM - Write time to string pointed to in R1
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V4	18-Mar-81	CVLLIB Routine

.globl	wd,w2d

		.If eq 1
Called by
		MOV	#timeblock,R2
		MOV	#string,R1
		MOV	#flag,R0
		CALL	WTIM

Writes the time from <timeblock> into the string pointed to in R1.

R0 is used as a flag to determine how much is to be printed.
If its low-order byte be zero, only hh:mm will be printed; otherwise
hh:mm:ss will be printed.  If the sign bit be set, a space will precede
the hours value if this be less than 10.  Minutes and seconds will always
comprise two digits.

R1 is expected to point to a string into which the time is to be written.
It will point to the next avilable byte on return.
		.endc
;--------------------------------------------------------
; Description of TIME BLOCK format:
;
; The block required for Time routines comprises
; 7 words sequentially as follows (defined as offsets) -

HOURS=0		; hours (in 24-hour format)
MINS=2		; minutes
SECS=4		; seconds
TICKS=6		; clock ticks
RTIM1=10	; RT-11 format time, high order word
RTIM2=12	; RT-11 format time, low  order word
		; (together forming a double-precision
		; integer with the number of clock ticks
		; since the previous midnight)
TCLOCK=14	; number of clock ticks per second
		; in this system (default 50; set by
		; RSTIM or by the user)

; A block is provided in this library for convenience.  It
; may be used in either the form MOV #TIMBLK,R2 (for macro
; routines) or as
;	COMMON/TIMBLK/HOURS,MINS,SECS,TICKS,RTIM1,RTIM2,TCLOCK
;	CALL FRSTIM(HOURS) ! for example
; All the locations are labelled respectively with those
; names as globals.
;---------------------------------------------------------

WTIM::
	mov	r0,-(sp)
	bge	10$		;Doesn't want any leading blanks
	cmp	hours(r2),#10.	;If flag negative, and hours <10, add space
	bhis	10$
	movb	#' ,(r1)+
10$:
	mov	hours(r2),r0
	call	wd
	movb	#':,(r1)+
	mov	mins(r2),r0
	call	w2d		;Two digits, leading zero if necessary
	tstb	(sp)
	beq	20$
	movb	#':,(r1)+	;Print seconds if R0 was non-zero
	mov	secs(r2),r0
	call	w2d
20$:
	mov	(sp)+,r0
	return
.end

RSTIM.MAC
.Title	RSTIM - Read system time into RTIM1 & RTIM2 <timeblock> offsets
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V4	23-May-81	CVLLIB Routine

.mcall	.gtim
.globl	crtimw

sysptr=54
config=300
b.clk=40	;Set if 50Hz clock

		.If eq 1
Called by
		MOV	#timeblock,R2
		CALL	RSTIM

Reads the system time into the offsets RTIM1 & RTIM2 in <timeblock>.
Also sets the TCLOCK offset to either 50 or 60 depending upon the setting of
B.CLK in CONFIG(SYSPTR).  Performs conversion of the RT11 time into HOURS,
MINS, SECS, and TICKS, placing these values in the relevant <timeblock>
offsets.
		.Endc
;--------------------------------------------------------
; Description of TIME BLOCK format:
;
; The block required for Time routines comprises
; 7 words sequentially as follows (defined as offsets) -

HOURS=0		; hours (in 24-hour format)
MINS=2		; minutes
SECS=4		; seconds
TICKS=6		; clock ticks
RTIM1=10	; RT-11 format time, high order word
RTIM2=12	; RT-11 format time, low  order word
		; (together forming a double-precision
		; integer with the number of clock ticks
		; since the previous midnight)
TCLOCK=14	; number of clock ticks per second
		; in this system (default 50; set by
		; RSTIM or by the user)

; A block is provided in this library for convenience.  It
; may be used in either the form MOV #TIMBLK,R2 (for macro
; routines) or as
;	COMMON/TIMBLK/HOURS,MINS,SECS,TICKS,RTIM1,RTIM2,TCLOCK
;	CALL FRSTIM(HOURS) ! for example
; All the locations are labelled respectively with those
; names as globals.
;---------------------------------------------------------

RSTIM::
	mov	r0,-(sp)
	mov	#50.,tclock(r2)
	mov	@#sysptr,r0
	bit	#b.clk,config(r0)
	bne	5$
	mov	#60.,tclock(r2)
5$:
	mov	r2,20$
	add	#rtim1,20$	;Set up pointer to RTIM1 offset
	mov	#10$,r0
	.gtim
	mov	(sp)+,r0
	call	crtimw
	return
10$:
	.byte	0,21		;Block for .GTIM
20$:	.word	0
.end

RTIMT.MAC
.Title	RTIMT - Read time from the terminal
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	16-Feb-81	CVLLIB Routine

.globl	r$t,rtim

		.If eq 1
Called by
		MOV	#timeblock,R2
		CALL	RTIMT

Reads the time in hours, mins, secs, and ticks from the terminal into
<timeblock> offsets of the same names.  A carry clear
return is taken if all went well, and carry is set if an error in the
specification was found.

Note - the TCLOCK offset contains the number of ticks/second.  Should the
user type a value greater than this an error will be reported.

For further details (including interpretation of AM and PM) see RTIM.MAC
		.Endc

RTIMT::
	call	r$t
	.word	rtim
.end

RTIM.MAC
.Title	RTIM - Read time from a string
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V3	 6-May-83	CVLLIB Routine
;	Allow "1230" shorthand time.
.Sbttl	V2	16-Feb-81	CVLLIB Routine

.globl	rd,cwtimr,div11

		.If eq 1
Called by
		MOV	#timeblock,R2
		MOV	#string,R1
		CALL	RTIM

Returns	carry clear if all OK, carry set if an error was detected.

Reads the time from the string as a series of numbers representing
hours, mins, secs, and ticks into <timeblock> offsets of the same name.
Delimiters between the numbers may be any non-alpha characters as desired.

Terminating the number at any stage with a null or an alphabetic character
stops the scan at that point.  Remaining fields will contain zero.
Should the termination be AM or PM (or lower case equivalents) appropriate
action will be taken.  (Note that the M is optional).

A shorthand version of the time without delimiters (eg 1230pm) is allowed,
but seconds and ticks will not be read in this format.
		.Endc
;--------------------------------------------------------
; Description of TIME BLOCK format:
;
; The block required for Time routines comprises
; 7 words sequentially as follows (defined as offsets) -

HOURS=0		; hours (in 24-hour format)
MINS=2		; minutes
SECS=4		; seconds
TICKS=6		; clock ticks
RTIM1=10	; RT-11 format time, high order word
RTIM2=12	; RT-11 format time, low  order word
		; (together forming a double-precision
		; integer with the number of clock ticks
		; since the previous midnight)
TCLOCK=14	; number of clock ticks per second
		; in this system (default 50; set by
		; RSTIM or by the user)

; A block is provided in this library for convenience.  It
; may be used in either the form MOV #TIMBLK,R2 (for macro
; routines) or as
;	COMMON/TIMBLK/HOURS,MINS,SECS,TICKS,RTIM1,RTIM2,TCLOCK
;	CALL FRSTIM(HOURS) ! for example
; All the locations are labelled respectively with those
; names as globals.
;---------------------------------------------------------

RTIM::
	mov	r0,-(sp)
	mov	r3,-(sp)
	mov	r4,-(sp)

	mov	r2,r3
	clr	(r3)+
	clr	(r3)+		;Clear out answers in advance
	clr	(r3)+
	clr	(r3)
	mov	r2,r3
	mov	#4,r4		;Counter of fields

	call	rd		;Check the first field.
	cmp	r0,#100.	;If >=100 assume shorthand time
	blo	15$

	mov	r2,-(sp)
	mov	r0,r2		;Dividend - divide by 100.
	mov	#100.,r0
	call	div11
	mov	r2,(r3)+	;Hours
	mov	r0,(r3)		;Minutes
	mov	(sp)+,r2
	br	20$

10$:
	call	rd		;Read a decimal number from the string
15$:	mov	r0,(r3)+	;Fill next field with it
	tstb	(r1)		;If null terminator, nothing left to get
	beq	20$
	cmpb	(r1),#'A	;Otherwise allow anything less than alpha
	bhis	20$
	inc	r1		;Skip delimiter
	dec	r4
	bgt	10$
20$:
	movb	(r1),r4		;Check delimiting character
	bic	#177640,r4	;Clear lower case bit also
	cmp	r4,#'A		;And check for AM or PM
	beq	30$
	cmp	r4,#'P
	bne	50$
				;PM - add 12 if hours <12
	cmp	hours(r2),#12.
	bhis	40$
	add	#12.,hours(r2)
	br	40$
30$:				;AM - Only conversion is 12:xxAM to 00:xx
	cmp	hours(r2),#12.
	bne	40$
	clr	hours(r2)
40$:
	inc	r1		;A? or P? - see is ? = M
	movb	(r1),r4
	bic	#177640,r4
	cmp	r4,#'M
	bne	50$		;If not M, leave as next char for him to use.
	inc	r1
50$:
	cmp	hours(r2),#23.	;Check values.
	bhi	60$
	cmp	mins(r2),#59.
	bhi	60$
	cmp	secs(r2),#59.
	bhi	60$
	cmp	ticks(r2),tclock(r2)
	bhis	60$

	call	cwtimr		;Convert time to RT11 format
	clc
	br	70$
60$:				;Error code - set carry
	sec
70$:
	mov	(sp)+,r4
	mov	(sp)+,r3
	mov	(sp)+,r0
	return
.end

CRTIMW.MAC
.Title CRTIMW - Convert RT11 time to words
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	16-Feb-81	CVLLIB Routine

.globl	div21

		.if eq 1
Called by
		MOV	#timeblock,R2
		CALL	CRTIMW

Converts the two-word RT11 time stored in <timeblock> offsets RTIM1 (hi-ord)
and RTIM2 (lo-ord), using the ticks-per-second supplied in the TCLOCK offset,
into ticks, seconds, minutes, and hours, storing these back in <timeblock>.
		.endc
;--------------------------------------------------------
; Description of TIME BLOCK format:
;
; The block required for Time routines comprises
; 7 words sequentially as follows (defined as offsets) -

HOURS=0		; hours (in 24-hour format)
MINS=2		; minutes
SECS=4		; seconds
TICKS=6		; clock ticks
RTIM1=10	; RT-11 format time, high order word
RTIM2=12	; RT-11 format time, low  order word
		; (together forming a double-precision
		; integer with the number of clock ticks
		; since the previous midnight)
TCLOCK=14	; number of clock ticks per second
		; in this system (default 50; set by
		; RSTIM or by the user)

; A block is provided in this library for convenience.  It
; may be used in either the form MOV #TIMBLK,R2 (for macro
; routines) or as
;	COMMON/TIMBLK/HOURS,MINS,SECS,TICKS,RTIM1,RTIM2,TCLOCK
;	CALL FRSTIM(HOURS) ! for example
; All the locations are labelled respectively with those
; names as globals.
;---------------------------------------------------------

CRTIMW::
	mov	r0,-(sp)
	mov	r3,-(sp)
	mov	r5,-(sp)
	mov	r2,r5		;Save in R5 as R2 needed for arithmetic

	mov	rtim1(r5),r2	;Time word high order portion
	mov	rtim2(r5),r3	; ibid, low-order.
	mov	tclock(r5),r0	;Ticks per second - user supplied
	call	div21		;Divide R2,R3 by R0, leaving quotient in R2,R3
	mov	r0,ticks(r5)	; and remainder in R0

	mov	#60.,r0
	call	div21
	mov	r0,secs(r5)

	mov	#60.,r0
	call	div21
	mov	r0,mins(r5)

	mov	r3,hours(r5)

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

	return
.end

CWTIMR.MAC
.Title CWTIMR - Convert time in hours, mins, seconds & ticks to RT11 format
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	16-Feb-81	CVLLIB Routine

.globl	mul21

		.if eq 1
Called by
		MOV	#timeblock,R2
		CALL	CWTIMR

Converts the integers in the <timeblock> offsets HOURS, MINS, SECS & TICKS
into the two-word integer time format of ticks after midnight of RT11.
The contents of the offset TCLOCK is used for ticks per second, and the
result is stored in offsets RTIM1 (hi-ord) and RTIM2 (lo-ord).
		.endc
;--------------------------------------------------------
; Description of TIME BLOCK format:
;
; The block required for Time routines comprises
; 7 words sequentially as follows (defined as offsets) -

HOURS=0		; hours (in 24-hour format)
MINS=2		; minutes
SECS=4		; seconds
TICKS=6		; clock ticks
RTIM1=10	; RT-11 format time, high order word
RTIM2=12	; RT-11 format time, low  order word
		; (together forming a double-precision
		; integer with the number of clock ticks
		; since the previous midnight)
TCLOCK=14	; number of clock ticks per second
		; in this system (default 50; set by
		; RSTIM or by the user)

; A block is provided in this library for convenience.  It
; may be used in either the form MOV #TIMBLK,R2 (for macro
; routines) or as
;	COMMON/TIMBLK/HOURS,MINS,SECS,TICKS,RTIM1,RTIM2,TCLOCK
;	CALL FRSTIM(HOURS) ! for example
; All the locations are labelled respectively with those
; names as globals.
;---------------------------------------------------------

CWTIMR::
	mov	r0,-(sp)
	mov	r3,-(sp)
	mov	r5,-(sp)
	mov	r2,r5		;Save in R5 as R2 needed for arithmetic

	clr	r2		;Set up for double-precision multiply
	mov	hours(r5),r3
	mov	#60.,r0
	call	mul21

	add	mins(r5),r3
	call	mul21

	add	secs(r5),r3
	adc	r2

	mov	tclock(r5),r0
	call	mul21

	add	ticks(r5),r3
	adc	r2

	mov	r2,rtim1(r5)
	mov	r3,rtim2(r5)

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

	return
.end

WFT.MAC
.Title	WFT - Write a filename to the terminal
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2A	18-Mar-81	CVLLIB Routine

.globl	w$t,wf

		.If eq 1
Requires a fileblock (pointed to in R2) in the format
		.RAD50	/device/	up to 3 characters	;1 word
		.RAD50	/filename/	up to 6 characters	;2 words
		.RAD50	/extension/	up to 3 characters	;1 word
		.WORD	size					;1 word

and a pair of flags (in R0):

	Low order byte =  0 - No size printed
		       <> 0 - size printed
	Sign bit clear -  no spaces in subfields
		 set   -  spaces in subfields
		For example:
		if R0 were negative, "DK :TEST  .TMP" could be output, whereas
		when it is positive "DK:TEST.TMP" would result.

Called by
		MOV	#<fileblock>,R2
		MOV	#<flags>,R0
		CALL	WFT
No registers are altered.
		.Endc

WFT::
	call	w$t
	.word	wf
.end

WF.MAC
.Title	WF - Write a filename to a string
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V4	9-Jan-82	CVLLIB Routine

.globl	w50f,rtrim,wd

		.If eq 1
Requires a fileblock (pointed to in R2) in the format
		.RAD50	/device/	up to 3 characters	;1 word
		.RAD50	/filename/	up to 6 characters	;2 words
		.RAD50	/extension/	up to 3 characters	;1 word
		.WORD	size					;1 word

and a pair of flags (in R0):

	Low order byte =  0 - No size printed
		       <> 0 - size printed
	Sign bit clear -  no spaces in subfields
		 set   -  spaces in subfields
		For example:
		if R0 be negative, "DK: TEST  .TMP" could be output, whereas
		when it is positive "DK:TEST.TMP" would result.

Called by
		MOV	#<fileblock>,R2
		MOV	#<string to receive ascii filename>,R1
		MOV	#<flags>,R0
		CALL	WF
No registers are altered.

Wildcard characters "*" (unassigned Rad50 code) and "%" (Rad50 ".")
are permitted.
		.Endc

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

	mov	(r2)+,r0	;Device

	call	w50f		;Convert to 3 characters
	tst	(sp)		;See if want space suppression
	bpl	10$		;Yes.

	movb	#' ,(r1)+	;No.  Allow room for colon.
	tst	-2(r2)		;See if was null device
	beq	30$		;Was null - just leave as spaces
	mov	r1,-(sp)	;Trim back to char but keep track
	call	rtrim		; of where columns will line up
	movb	#':,(r1)
	mov	(sp)+,r1
	br	30$
10$:
	tst	-2(r2)		;Want space suppression.  If null, not even :
	bne	20$
	sub	#3,r1
	br	30$
20$:
	call	rtrim		;Suppress spaces and append colon.
	movb	#':,(r1)+

30$:
	mov	(r2)+,r0	;First filename word
	mov	r0,-(sp)	;Save to check for null filename
	call	w50f
	mov	(r2)+,r0	;Second filename word
	bis	r0,(sp)
	call	w50f
	tst	2(sp)		;Again, trim spaces if necessary
	bmi	40$
	call	rtrim
40$:
	movb	#'.,r0
	bis	(r2),(sp)+	;All bits which were set in filename or ext
	bne	45$
	movb	#' ,r0		;Space if completely null
45$:	movb	r0,(r1)+

	mov	(r2)+,r0	;Extension
	call	w50f
	tst	(sp)
	bmi	50$
	call	rtrim
50$:
	tstb	(sp)		;Want file size printed?
	beq	60$
	movb	#'[,(r1)+
	mov	(r2),r0
	call	wd
	movb	#'],(r1)+
60$:
	mov	(sp)+,r0
	mov	(sp)+,r2
	return
.end

W50FT.MAC
.Title	W50FT - Write a RADIX50 word (Filename set)
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	9-Jan-82	CVLLIB Routine

.globl	w$t,w50f

		.If eq 1
Writes to the terminal the Radix50 word contained in R0.  No registers
are altered.  The unused Radix50 code, 35, is typed as an "*".
The "." character will be interpreted in filename mode as "%".
		.Endc

W50FT::
	call	w$t
	.word	w50f
.end

W50F.MAC
.Title	W50F - Write a RADIX50 word to a string (filename set)
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	9-Jan-82	CVLLIB Routine

.globl	div21,c50a

		.If eq 1
Writes to the string pointed to in R1 the Radix50 word contained in R0.
No registers other than R1 are altered.  The unused Radix50 code, 35,
is typed as an "*".  The Radix50 "." is interpreted as the filename
wildcard "%".
		.Endc

W50F::
	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

	movb	r0,(r1)+
	movb	(sp)+,(r1)+
	movb	(sp)+,(r1)+

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


$c50a:	call	c50a
	cmp	r0,#'.		;Convert . to %
	bne	10$
	mov	#'%,r0
10$:	return

.end

W50T.MAC
.Title	W50T - Write a RADIX50 word
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1A	9-Jan-82	CVLLIB Routine

.globl	w$t,w50

		.If eq 1
Writes to the terminal the Radix50 word contained in R0.  No registers
are altered.  The unused Radix50 code, 35, is typed as an "*".
		.Endc

W50T::
	call	w$t
	.word	w50
.end

W50.MAC
.Title	W50 - Write a RADIX50 word to a string
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1A	9-Jan-82	CVLLIB Routine

.globl	div21,c50a

		.If eq 1
Writes to the string pointed to in R1 the Radix50 word contained in R0.
No registers other than R1 are altered.  The unused Radix50 code, 35,
is typed as an "*".
		.Endc

W50::
	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

	movb	r0,(r1)+
	movb	(sp)+,(r1)+
	movb	(sp)+,(r1)+

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

RFT.MAC
.Title	RFT - Read filename from the terminal
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	1-Mar-81	CVLLIB Routine

.globl	r$t,rf,rfd

		.If eq 1
Reads a filename from the terminal into a block of 5 words pointed to in R2.
(.word device,first-filename-word,second-filename-word,extension,size).
R1 is left pointing to the delimiting character.

A CS return is taken if the filename syntax cannot be interpreted.

RFT clears the fileblock befor use.
RFDT does not clear the device or extension, so that these may be set up
	as defaults.
		.Endc

RFT::
	call	r$t
	.word	rf

RFDT::
	call	r$t
	.word	rfd
.end

RF.MAC
.Title	RF - Read filename from the string pointed to in R1
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V3	8-Mar-81	CVLLIB Routine

.globl	r50f,rds,ltrim

		.If eq 1
Reads a filename from a string pointed to in R1 into a block of 5 words
pointed to in R2.  This block is used as:
	.word device,first-filename-word,second-filename-word,extension,size

R1 is left pointing to the delimiting character.

A CS return is taken if the filename syntax cannot be interpreted.

RF clears the fileblock before using it.
RFD clears only the filename and size, leaving the device and extention
	available for defaults.
		.Endc

RFD::				; **** RFD **** Read file, allowing defaults
	mov	r0,-(sp)
	mov	r2,r0
	tst	(r0)+		;Leave device as is
	clr	(r0)+		;Clear filename
	clr	(r0)
	clr	10(r2)		; and file size
	br	rfc

RF::				; **** RF **** Read file, clearing block first
	mov	r0,-(sp)

	mov	r2,r0		;Clear out the fileblock
	clr	(r0)+
	clr	(r0)+
	clr	(r0)+
	clr	(r0)+
	clr	(r0)
RFC:
	call	ltrim		;Scrub any leading spaces.
	call	r50f		;Read up to 3 radix50 characters
	bcc	10$		;If carry clear, didn't hit ":"
	cmpb	(r1),#':	;If it wasn't a colon, hopefully it was a "."
	sec			; so make it look like a delimiter.
	bne	10$

	mov	r0,(r2)		;Device
	inc	r1
	call	r50f		;Read first filename word
10$:
	mov	r0,2(r2)
	bcs	20$		;Don't try for a second if there isn't one

	call	r50f		;Read second filename word
	mov	r0,4(r2)
	bcc	ferr		;If didn't get delimiter then, it ain't right.
20$:
	cmpb	(r1),#'.	;See if dot for extension
	bne	30$		;No - try out for file size

	inc	r1		;Skip the dot
	call	r50f		;And read the extension
	mov	r0,6(r2)
	bcc	ferr		;Should have hit a delimiter here.
30$:
	cmpb	(r1),#'[	;See if size specified
	bne	40$		;No - just give him whatever the delim was

	inc	r1
	call	rds		;Read size as signed decimal integer
	mov	r0,10(r2)
	cmpb	(r1),#']
	bne	ferr
	inc	r1
40$:
	clc
	br	ret

ferr:
	sec
ret:
	mov	(sp)+,r0
	return
.end

R50T.MAC
.Title	R50T - Read up to 3 Radix50 Characters into R0 from the terminal
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	20-Jan-81	CVLLIB Routine

.globl	r$t,r50s,r50f,r50

		.If eq 1
Reads up to 3 ascii characters from the user's terminal, converting
them to radix50 and returning them in R0.  Returns CS if NEXT character is
not a valid radix50 character (even if three characters have been read),
and CC otherwise.  R1 is left pointing to the next character typed.

There are three routines here: R50ST, R50FT and R50T.
R50T  - all radix50 characters, including full stop and space.
R50ST - symbol set, dot OK, space acts as a delimiter.
R50FT - filename set, dot and space act as delimiters.
		.Endc

R50ST::
	call	r$t
	.word	r50s
R50FT::
	call	r$t
	.word	r50f
R50T::
	call	r$t
	.word	r50
.end

R50.MAC
.Title	R50 - Read up to 3 Radix50 Characters into R0
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	20-Jan-81	CVLLIB Routine

.globl	mul11,ca50

		.If eq 1
Reads up to 3 ascii characters from the string pointed to in R1, converting
them to radix50 and returning them in R0.  Returns CS if NEXT character is
not a valid radix50 character (even if three characters have been read),
and CC otherwise.  R1 is left pointing to the next character.

There are three routines here: R50S, R50F and R50.
R50  - all radix50 characters including full stop and space.
R50S - symbol set, dot OK, space acts as a delimiter.
R50F - filename set, dot and space act as delimiters.
		.Endc

	.ENABL	LSB
R50S::
	mov	r2,-(sp)
	mov	#-1,-(sp)	;Flag for dot/space recognition.
	br	10$
R50F::
	mov	r2,-(sp)	;Save 1 ac first as need scrap heap at end
	mov	#1,-(sp)
	br	10$
R50::
	mov	r2,-(sp)
	clr	-(sp)
10$:
	mov	r3,-(sp)

	clr	-(sp)		;For result

	call	rnc		;Read next character from R1, converted to R50
	bcs	20$		;Hit a delimiter
	mov	#50*50,r2
	call	mul11		;Multiplier in R0, multiplicand in R2, returns
	mov	r3,(sp)		; double-length result in R2,R3

	call	rnc		;Second character
	bcs	20$
	mov	#50,r2
	call	mul11
	add	r3,(sp)

	call	rnc		;Third character
	bcs	20$
	add	r0,(sp)

	call	rnc		;And an extra just to check whether valid R50
20$:				; coming up next (but don't skip it)
	dec	r1
	mov	(sp)+,r0	;Result

	mov	(sp)+,r3
	mov	(sp)+,r2	;Scrap flag without affecting carry
	mov	(sp)+,r2
	return

rnc:
	movb	(r1)+,r0
	bic	#^c177,r0
	call	ca50		;Converts ascii to rad50, returning CS if
	bcs	30$		; invalid, and ZS if . or space.
	bne	30$
	tst	6(sp)		;See if he wants dot and space returned OK
	beq	30$		;Yes
	tst	r0		;Otherwise see if just "." is OK
	beq	25$		;Space always sets carry here
	tst	6(sp)
	blt	30$		;But get away with dot in R50S
25$:	sec			;No - mark them as delimiters
30$:	return

	.dsabl	lsb
.end

WM3PT.MAC
.TITLE	WM3PT - Write triple-precision money to terminal, spec # places
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1A	9-Jan-82	CVLLIB Routine

.GLOBL	W$T,WM3P,WM3DP

		.If eq 1
Writes a triple-precision integer pointed to in R0, taking it as cents,
in the format ddddddd.cc as dollars and cents.  The number is written to
the user's terminal.

The minimum number of places is taken from R2.  The number will be right-
justified within this field.

WM3DPT - includes a leading dollar sign
WM3PT  - no leading dollar sign.

Any sign of the number itself will precede the dollar sign.
		.Endc
WM3DPT::
	CALL	W$T
	.WORD	WM3DP

WM3PT::
	CALL	W$T
	.WORD	WM3P
.END

WM3T.MAC
.TITLE	WM3T - Write triple-precision money to terminal.
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	19-Jan-81	CVLLIB Routine

.GLOBL	W$T,WM3,WM3D

		.If eq 1
Writes a triple-precision integer pointed to in R0, taking it as cents,
in the format ddddddd.cc as dollars and cents.  The number is written to
the user's terminal.

WM3DT - includes a leading dollar sign
WM3T  - no leading dollar sign.

Any sign of the number itself will precede the dollar sign.
		.Endc
WM3DT::
	CALL	W$T
	.WORD	WM3D

WM3T::
	CALL	W$T
	.WORD	WM3
.END

WM3P.MAC
.TITLE	WM3P - Write triple-precision money to string, spec # places
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1A	9-Jan-82	CVLLIB Routine

.GLOBL	W$P,WM3,WM3D

		.If eq 1
Writes a triple-precision integer pointed to in R0, taking it as cents,
in the format ddddddd.cc as dollars and cents.  The number is written into
the string pointed to in R1.

The minimum number of places is taken from R2.  The number will be right-
justified within this field.

WM3DP - includes a leading dollar sign
WM3P  - no leading dollar sign.

Any sign of the number itself will precede the dollar sign.
		.Endc
WM3DP::
	CALL	W$P
	.WORD	WM3D

WM3P::
	CALL	W$P
	.WORD	WM3
.END

WM3.MAC
.TITLE	WM3 - Write triple-precision money to string
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	19-Jan-81	CVLLIB Routine

.GLOBL	NEG3,DIV31,WD3,W2D

		.If eq 1
Writes a triple-precision integer pointed to in R0, taking it as cents,
in the format ddddddd.cc as dollars and cents.  The number is written into
the string pointed to in R1.

WM3D - includes a leading dollar sign
WM3  - no leading dollar sign.

Any sign of the number itself will precede the dollar sign.
		.Endc

	.ENABL	LSB
WM3D::
	MOVB	#'$,-(SP)
	BR	10$
WM3::
	CLR	-(SP)
10$:
	MOV	R0,-(SP)
	MOV	R2,-(SP)

	MOV	#BLK,R2		;Use a temporary block for division
	MOV	(R0)+,(R2)+
	MOV	(R0)+,(R2)+	; by 100 to extract cents.
	MOV	(R0),(R2)
	CMP	-(R2),-(R2)
	MOV	R2,R0

	TST	(R0)		;If negative, make positive
	BGE	20$
	CALL	NEG3
	MOVB	#'-,(R1)+
20$:
	MOVB	4(SP),(R1)+	;See if dollar sign required
	BNE	30$
	DEC	R1		;No - scrub it.
30$:
	MOV	#100.,R0
	CALL	DIV31
	MOV	R0,-(SP)	;Remainder = cents.

	MOV	R2,R0
	CALL	WD3
	MOVB	#'.,(R1)+

	MOV	(SP)+,R0
	CALL	W2D

	MOV	(SP)+,R2
	MOV	(SP)+,R0
	TST	(SP)+
	RETURN

BLK:	.BLKW	3

.END

RM3T.MAC
.TITLE	RM3T - Read triple-precision monetary value from the terminal
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	16-Feb-81	CVLLIB Routine

.GLOBL	R$T,RM3

		.If eq 1
Reads a monetary value from the user's terminal, returning a
triple-length integer value in cents into the 3-word block pointed to
in R0.  A leading dollar sign may be present, as may a sign (either before
or after the dollar sign).  Thus $3.56 will return the value 356, but
note that $4.5 will return 450.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan or the input string may have been terminated before the
end of the number.
		.Endc

RM3T::
	CALL	R$T
	.WORD	RM3
.END

RM3.MAC
.TITLE	RM3 - Read triple-precision monetary value from string
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.Sbttl	V2a	27-Mar-86	CVLLIB Routine
;Repair bug where R0 altered upon return
.SBTTL	V2	16-Feb-81	CVLLIB Routine

.GLOBL	RSGN,RD3,R2D,NEG3,MUL31

		.If eq 1
Reads a monetary value from the string pointed to in R1, returning a
triple-length integer value in cents into the 3-word block pointed to
in R0.  A leading dollar sign may be present, as may a sign (either before
or after the dollar sign).  Thus $3.56 will return the value 356, but
note that $4.5 will return 450.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan or the input string may have been terminated before the
end of the number.
		.Endc

RM3::
	MOV	R2,-(SP)
	MOV	R0,R2
	CALL	RSGN		;Check out sign
	MOV	R0,-(SP)	;Save sign value for later
	CMPB	(R1),#'$
	BNE	10$
	INC	R1		;If leading dollar skip it & recheck sign
	CALL	RSGN
	TST	R0
	BEQ	10$
	COM	(SP)		;XOR of signs
10$:
	MOV	R2,R0
	CALL	RD3
	BCS	40$		;(Overflow)
	MOV	#100.,R0
	CALL	MUL31		;Dollars to cents
	BCS	40$		;(Overflow)
	CMPB	(R1),#'.
	BNE	20$
	INC	R1		;Skip "." and get cents
	CALL	R2D
	ADD	R0,4(R2)
	ADC	2(R2)
	ADC	(R2)
	BVS	40$		;(Overflow)
20$:
	MOV	R2,R0
	TST	(SP)+
	BGE	30$
	CALL	NEG3		;Negate as necessary
30$:
	CLC
	MOV	(SP)+,R2
	RETURN
40$:				;Overflow - carry set on return
	TST	(SP)+
	MOV	(SP)+,R2
	SEC
	RETURN
.END

WD3PT.MAC
.TITLE	WD3PT - Write triple-precision signed decimal # to terminal (# places)
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	15-Jan-81	CVLLIB Routine

.GLOBL	W$T,WD3P

		.If eq 1
Writes a triple-precision integer to the user's terminal from a
block of three words pointed to by R0.  (R0) provides the highest order
result, and 4(R0) provides the lowest.  No registers are altered.
R2 must be set to contain the least number of spaces for the number to
occupy.
		.Endc

WD3PT::
	CALL	W$T
	.WORD	WD3P
.END

WD3T.MAC
.TITLE	WD3T - Write triple-precision signed decimal integer to terminal
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	15-Jan-81	CVLLIB Routine

.GLOBL	W$T,WD3

		.If eq 1
Writes a triple-precision integer to the user's terminal from a
block of three words pointed to by R0.  (R0) provides the highest order
result, and 4(R0) provides the lowest.  No registers are altered.
		.Endc

WD3T::
	CALL	W$T
	.WORD	WD3
.END

WD3P.MAC
.TITLE	WD3P - Write triple-precision signed decimal to string (spec # places)
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	15-Jan-81	CVLLIB Routine

.GLOBL	W$P,WD3

		.If eq 1
Writes a triple-precision integer into the string pointed to in R1 from a
block of three words pointed to by R0.  (R0) provides the highest order
result, and 4(R0) provides the lowest.  No registers except R1 are altered,
and R1 is left pointing to the next free byte.

R2 must have been set to contain the least number of spaces to be occupied
by the number.  Should it require fewer, the field will be filled on the
left with spaces.
		.Endc

WD3P::
	CALL	W$P
	.WORD	WD3
.END

WD3.MAC
.TITLE	WD3 - Write triple-precision signed decimal integer to string
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	15-Jan-81	CVLLIB Routine

.GLOBL	NEG3,DIV31,CMP3

		.If eq 1
Writes a triple-precision integer into the string pointed to in R1 from a
block of three words pointed to by R0.  (R0) provides the highest order
result, and 4(R0) provides the lowest.  No registers except R1 are altered,
and R1 is left pointing to the next free byte.
		.Endc

WD3::
	MOV	R0,-(SP)
	MOV	R2,-(SP)
	MOV	R4,-(SP)

	CLR	R4		;Digit counter
	MOV	#BLK,R2		;Work block for quotients from DIV31
	MOV	(R0)+,(R2)+	;Put original word there.
	MOV	(R0)+,(R2)+
	MOV	(R0),(R2)

	MOV	#BLK,R0		;Negate if negative
	TST	(R0)
	BGE	10$
	MOVB	#'-,(R1)+
	CALL	NEG3
	BIC	#100000,(R0)	;In case sign bit only set.
10$:
	MOV	#BLK,R2		;For dividend for DIV31
	MOV	#10.,R0		;For divisor (single-precision)
	CALL	DIV31
	ADD	#'0,R0		;Make quotient a digit
	MOV	R0,-(SP)
	INC	R4

	MOV	#ZERO,R0
	CALL	CMP3		;Compare two triple-precision words
	BNE	10$
20$:
	MOVB	(SP)+,(R1)+	;Move digits back into place in string
	DEC	R4
	BGT	20$

	MOV	(SP)+,R4
	MOV	(SP)+,R2
	MOV	(SP)+,R0
	RETURN

BLK:	.BLKW	3
ZERO:	.WORD	0,0,0		;For comparison purposes with 3-precis #

.END

RD3T.MAC
.TITLE	RD3T - Read a triple-precision integer from the terminal
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2A	6-May-83	CVLLIB Routine

.GLOBL	R$T,RD3

		.If eq 1
Reads a triple-precision integer from the user's terminal into a
block of three words pointed to by R0.  (R0) receives the highest order
result, and 4(R0) receives the lowest.  No registers are altered except R1,
which is left pointing to the terminating character.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan of the input string is continued to the end of the number.
		.Endc

RD3T::
	call	r$t
	.word	rd3
.end

RD3.MAC
.TITLE	RD3 - Read a triple-precision integer from a string
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V3A	 4-Oct-83	CVLLIB Routine
;Bug fix
.Sbttl	V3	 6-May-83	CVLLIB Routine
;	Rewrite to continue scan despite overflow.
.SBTTL	V2	16-Feb-81	CVLLIB Routine

.GLOBL	RSGN,NEG3

		.If eq 1
Reads a triple-precision integer from the string pointed to in R1 into a
block of three words pointed to by R0.  (R0) receives the highest order
result, and 4(R0) receives the lowest.  No registers except R1 are altered,
and R1 is left pointing to the terminating character.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan of the input string is continued to the end of the number.
		.Endc

RD3::
	mov	r0,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)
	mov	r4,-(sp)
	mov	r5,-(sp)

	clr	r2		;For overflow indication.

	clr	r3		;Use R3, R4, R5 as triple-precision result
	clr	r4
	clr	r5

	call	rsgn
	mov	r0,-(sp)	;Allow signs.
10$:
	movb	(r1)+,r0	;Next digit
	bic	#177600,r0
	sub	#'0,r0
	cmp	r0,#9.
	bhi	20$		;Here have hit delimiter.

	asl	r5		;Shift multiply triple by 10
	rol	r4
	rol	r3
	rol	r2
	mov	r3,-(sp)	;Hold * 2
	mov	r4,-(sp)
	mov	r5,-(sp)
	asl	r5
	rol	r4
	rol	r3
	rol	r2
	asl	r5
	rol	r4
	rol	r3
	rol	r2
	add	(sp)+,r5
	adc	r4
	adc	r3		;Add *2 and *8, propagating carry fully
	adc	r2
	add	(sp)+,r4
	adc	r3
	adc	r2
	add	(sp)+,r3
	adc	r2

	add	r0,r5		;And finally the last digit
	adc	r4
	adc	r3
	adc	r2
	beq	10$
	mov	#1,r2		;Prevent overflow overflowing past recognition
	br	10$

20$:
	dec	r1		;Point at, not past, delimiter

	tst	r3		;If negative, must have overflowed.
	bpl	25$
	inc	r2
25$:
	mov	12(sp),r0	;(Orig R0)
	mov	r3,(r0)+	;Move number into place
	mov	r4,(r0)+
	mov	r5,(r0)

	tst	(sp)+		;See whether ought be negative
	bge	30$
	cmp	-(r0),-(r0)	;Go back to point to start of number
	call	neg3
30$:				;Common return routine
	mov	(sp)+,r5
	mov	(sp)+,r4
	mov	(sp)+,r3

	tst	r2		;Any overflow?
	beq	40$
	sec
40$:
	mov	(sp)+,r2
	mov	(sp)+,r0
	return
.end

MUL31.MAC
.TITLE	MUL31 - <triple-precision> * <single-precision> signed multiply
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	14-Feb-81	CVLLIB Routine
.GLOBL	NEG32

		.If eq 1
Multiplies a triple-precision integer pointed to in R2 (3 consecutive words,
containing highest to lowest significant bits) by a single-precision
integer in R0.  The result replaces the original 3-word multiplicand
(pointed to in R2).
Overflow is indicated by return with the carry bit set.  In this case,
the returned result may be garbage.
		.Endc

MUL31::
	MOV	R1,-(SP)	;Used as indication of overflow
	CLR	R1
	MOV	R0,-(SP)
	BGE	10$		;Use positive multiplier always
	NEG	R0
10$:
	MOV	R3,-(SP)	;Set up the multiplicand for left shifting
	MOV	R4,-(SP)	; in R3, R4, R5.
	MOV	R5,-(SP)

	MOV	(R2),R3
	CLR	(R2)+
	MOV	(R2),R4
	CLR	(R2)+
	MOV	(R2),R5
	CLR	(R2)
	CMP	-(R2),-(R2)	;Reset R2
	BR	30$
20$:
	ASL	R5		;Left shift multiplicand
	ROL	R4
	ROL	R3
	BVS	50$		;Overflow
30$:
	CLC
	ROR	R0		;Right shift multiplier
	BCC	40$

	ADD	R5,4(R2)
	ADC	2(R2)
	ADC	(R2)
	BVS	50$
	ADD	R4,2(R2)
	ADC	(R2)
	BVS	50$
	ADD	R3,(R2)
	BVS	50$
40$:
	TST	R0
	BNE	20$
	BR	60$
50$:
	INC	R1		;Overflow end point
60$:
	MOV	(SP)+,R5
	MOV	(SP)+,R4
	MOV	(SP)+,R3

	MOV	(SP)+,R0	;If multipler negative, negate result
	BGE	70$
	CALL	NEG32
70$:
	TST	R1
	BEQ	80$
	SEC
80$:
	MOV	(SP)+,R1
	RETURN
.END

MUL33.MAC
.TITLE	MUL33 - Triple-precision * triple-precision signed integer multiply
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	14-Feb-81	CVLLIB Routine
.GLOBL	NEG3

		.If eq 1
Called by
		MOV	<pointer to 3/precis integer1>,R0
		MOV	<pointer to 3/precis integer2>,R2
		MOV	<pointer to 6-word block for result>,R3
		CALL	MUL33
Returns
		CS if result cannot be expressed in 3/precis number

Multiplies two triple-precision integers pointed to in R0 and R2 (each in 3
consecutive words of diminishing order of significance) to provide a
6-word result in locations pointed to by R3.

"From ghoulies & ghosties & all other beasties, and things that go bump
in the night, Lord deliver us"  (? misquotation, Old English Prayer Book)

"Wonder if it'll ever be used?" - the Author.
		.Endc

MUL33::
	MOV	R1,-(SP)	;Used to keep track of "overflow"
	CLR	R1		;Also for filler to left of multiplicand
	TST	(R2)
	BGE	5$
	DEC	R1
5$:
	MOV	R4,-(SP)
	MOV	#MND,R4		;In here place the multiplicand for repeated
	MOV	R1,(R4)+	; left shifting
	MOV	R1,(R4)+	; (filled to the left as appropriate)
	MOV	R1,(R4)+
	CLR	R1
	MOV	(R2),(R4)+
	MOV	2(R2),(R4)+
	MOV	4(R2),(R4)+

	MOV	R5,-(SP)
	MOV	R4,R5		;Next three words take multiplier, for
	MOV	(R0),(R4)+	; repeated right shifting.
	MOV	2(R0),(R4)+
	MOV	4(R0),(R4)

	MOV	R0,-(SP)
	MOV	R5,R0
	TST	(R0)		;Make sure we work with a positive multiplier
	BGE	10$
	CALL	NEG3
10$:
	MOV	R3,-(SP)
	CLR	(R3)+		;Clear out
	CLR	(R3)+
	CLR	(R3)+		; locations to receive
	CLR	(R3)+
	CLR	(R3)+		; the result.  Put comments like this
	CLR	(R3)		; so KED doesn't give you eye strain!
	MOV	R3,-(SP)	;And hold last address.

	BR	40$

20$:
	MOV	R5,R4		;Left shift
	ASL	-(R4)
	ROL	-(R4)		; multiplicand, checking
	ROL	-(R4)		; for flow across
	BVC	30$		; the half-way
	INC	R1
30$:	ROL	-(R4)		; mark, as if this occurs
	ROL	-(R4)		; result cannot be expressed in a
	ROL	-(R4)		; triple-precision number.
40$:
	CLC			;Shift multiplier to see whether to add in
	ROR	(R5)
	ROR	2(R5)
	ROR	4(R5)
	BCC	80$

	MOV	R5,R4		;Address past last word of multiplicand
	MOV	(SP),R3		;Address of last word of result

	ADD	-(R4),(R3)	;Lowest order word
	ADC	-(R3)
	MOV	R3,-(SP)
	ADC	-(R3)		;Propagate
	BVC	50$					;Check for overflow
	INC	R1					; half way
50$:	ADC	-(R3)		; carry
	ADC	-(R3)		;  RIGHT
	ADC	-(R3)		;   THROUGH!
	MOV	(SP)+,R3

	ADD	-(R4),(R3)	;Word 5
	ADC	-(R3)
	BVC	60$					;More overflow checks
	INC	R1
60$:	MOV	R3,-(SP)
	ADC	-(R3)
	ADC	-(R3)		;Getting dizzy yet?
	ADC	-(R3)
	MOV	(SP)+,R3

	ADD	-(R4),(R3)	;Word 4
	BVC	70$					;More bloody overflow
	INC	R1
70$:	ADC	-(R3)
	ADC	-2(R3)
	ADC	-4(R3)

	ADD	-(R4),(R3)	;Word 3
	ADC	-(R3)
	ADC	-2(R3)

	ADD	-(R4),(R3)	;Word 2
	ADC	-(R3)

	ADD	-(R4),(R3)	;Word 1 at bloody last.
80$:
	MOV	R5,R4
	TST	(R4)+		;See if multiplier has been completely
	BNE	20$
	TST	(R4)+		; shifted out yet.
	BNE	20$
	TST	(R4)
	BNE	20$

	TST	(SP)+		;Scrap pointer to end of result
	MOV	(SP)+,R3

	MOV	(SP)+,R0	;If negative multiplier originally,
	TST	(R0)		; need to negate whole bloody result.
	BGE	90$
	COM	(R3)+
	COM	(R3)+		;Through all
	COM	(R3)+		; six
	COM	(R3)+		; words.
	COM	(R3)+
	COM	(R3)
	ADD	#1,(R3)		;(need ADD to get carry right)
	ADC	-(R3)
	ADC	-(R3)		; and propagate
	ADC	-(R3)		; carry
	ADC	-(R3)		; right
	ADC	-(R3)		; back again.
90$:
	MOV	(SP)+,R5
	MOV	(SP)+,R4

	TST	R1		;And check for overflow
	BEQ	100$
	SEC
100$:	MOV	(SP)+,R1

	RETURN

MND:	.BLKW	9.		;First 6 words get multiplicand for
				; left-shifting.  Next three words get
				; multiplier for right-shifting.
.END

DIV31.MAC
.TITLE	DIV31 - <triple-precision>/<single-precision> signed integer divide
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	16-Jan-81	CVLLIB Routine

.GLOBL	NEG32

		.If eq 1
Divides a triple-precision number pointed to by R2 (three consecutive words
in decreasing order of significance) by a single-precision integer in R0.
Returns the quotient replacing the original dividend, and the remainder in R0.
A normal return has carry & overflow clear; divide-by-zero causes return with
carry & overflow set.
		.Endc

DIV31::
	MOV	R0,-(SP)	;Quotient has to get XOR of signs
	BEQ	70$		;Not if divide-by-zero!
	BGT	10$
	NEG	R0
10$:
	BIC	#77777,(SP)
	ADD	(R2),(SP)	;Now have XOR of sign bits.

	MOV	(R2),-(SP)	;Keep dividend sign for remainder
	BGE	20$
	CALL	NEG32		;Negates triple-precis # pointed to by R2
20$:
	MOV	#48.,-(SP)
	MOV	R0,-(SP)	;Save for loop subtraction
	CLR	R0
30$:
	ASL	4(R2)		;Shift bits left from dividend to remainder
	ROL	2(R2)
	ROL	(R2)
	ROL	R0
	CMP	R0,(SP)		;See if subtract possible
	BLO	40$
	SUB	(SP),R0
	INC	4(R2)		;Indicate subtraction in quotient
40$:
	DEC	2(SP)
	BGT	30$

	CMP	(SP)+,(SP)+
	TST	(SP)+		;Remainder sign
	BGE	50$
	NEG	R0
50$:
	TST	(SP)+		;Ibid, quotient
	BGE	60$
	CALL	NEG32
60$:
	.WORD	CLC!CLV
	RETURN

70$:
	TST	(SP)+		;Error return on divide-by-zero
	.WORD	SEC!SEV
	RETURN
.END

DIV33.MAC
.TITLE	DIV33 - Triple-precision signed integer division
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	16-Jan-81	CVLLIB Routine

.GLOBL	NEG3,NEG32,CMP3,SUB3

		.If eq 1
Divides a triple-precision integer pointed to by R2 (stored as 3 consecutive
words of decreasing order of significance) by a triple-precision integer
pointed to in R0, returning the quotient in the place of the original
dividend and the remainder in place of the original divisor.
		.Endc

DIV33::
	MOV	(R0),-(SP)	;Need XOR of signs for quotient
	BGE	10$
	CALL	NEG3		;Negate so as work with only positive nos.
10$:	BIC	#77777,(SP)
	ADD	(R2),(SP)	;Now have XOR of sign bits.

	MOV	(R2),-(SP)	;Need sign of dividend for remainder
	BGE	20$
	CALL	NEG32
20$:
	MOV	R3,-(SP)	;Set up argument pointers to work with CMP3
	MOV	R2,R3		; and SUB3 (need R0 & R2 for their args)
	MOV	R0,R2
	MOV	(R0),BLK	;Store divisor, and clear quotient
	CLR	(R0)+
	MOV	(R0),BLK+2
	CLR	(R0)+
	MOV	(R0),BLK+4
	CLR	(R0)
	MOV	#BLK,R0		;Check for divide-by-zero
	CALL	CMP3
	BEQ	70$

	MOV	#48.,-(SP)
30$:
	ASL	4(R3)		;Shift bits out of dividend
	ROL	2(R3)		; into (impending) quotient
	ROL	(R3)
	ROL	4(R2)
	ROL	2(R2)
	ROL	(R2)
	CALL	CMP3		;See if subtraction possible
	BHI	40$
	CALL	SUB3		;If it is, do it and
	INC	4(R3)		; indicate it in the quotient
40$:
	DEC	(SP)
	BGT	30$

	MOV	R2,R0
	MOV	R3,R2
	TST	(SP)+
	MOV	(SP)+,R3

	TST	(SP)+		;Remainder sign
	BGE	50$
	CALL	NEG3
50$:
	TST	(SP)+		;ibid, quotient
	BGE	60$
	CALL	NEG32
60$:
	.WORD	CLC!CLV
	RETURN

70$:
	MOV	(SP)+,R3	;Divide-by-zero error return
	CMP	(SP)+,(SP)+
	.WORD	SEC!SEV
	RETURN

BLK:	.BLKW	3

.END

NEG3.MAC
.TITLE	NEG3 - Negate triple-precision integer pointed to in R0
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	16-Jan-81	CVLLIB Routine

NEG3::
	COM	(R0)+
	COM	(R0)+
	COM	(R0)
	ADD	#1,(R0)		;Must use ADD to get carry right
	ADC	-(R0)
	ADC	-(R0)
	RETURN
.END

NEG32.MAC
.TITLE	NEG32 - Negate triple-precision integer pointed to in R2
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	16-Jan-81	CVLLIB Routine

NEG32::
	COM	(R2)+
	COM	(R2)+
	COM	(R2)
	ADD	#1,(R2)		;Must use ADD to get carry right
	ADC	-(R2)
	ADC	-(R2)
	RETURN
.END

CMP3.MAC
.TITLE	CMP3 - Compare triple-precision numbers
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V3	8-Mar-81	CVLLIB Routine

		.If eq 1
Called by
		MOV	<pointer to 3/precis integer1>,R0
		MOV	<pointer to 3/precis integer2>,R2

		CALL	CMP3

Returns flags equivalent to CMP (R0),(R2) taking into account the triple-
precision nature of the values concerned.
		.Endc

CMP3::
	CMP	(R0),(R2)
	BNE	20$		;If unequal, all's well
	CMP	2(R0),2(R2)
	BHI	30$		;HI implies GT, so clear N
	BLO	10$		;LO implies LT, so set N
	CMP	4(R0),4(R2)
	BHI	30$
	BEQ	20$
10$:
	SEN
	CLV
20$:
	RETURN
30$:
	.word	CLN!CLV
	RETURN
.END

ADD3.MAC
.TITLE	ADD3 - Adds two triple-precision integers
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	8-Mar-81	CVLLIB Routine

		.If eq 1
Adds a triple-precision integer pointed to by R0 to a triple-precision integer
pointed to by R2, storing the result in the place of the original number
pointed to by R2.  Overflow is set on return if it occurred.
		.Endc

ADD3::
	ADD	4(R0),4(R2)
	ADC	2(R2)
	ADC	(R2)
	BVS	10$
	ADD	2(R0),2(R2)
	ADC	(R2)
	BVS	20$
	ADD	(R0),(R2)
	RETURN
10$:
	ADD	2(R0),2(R2)
	ADC	(R2)
20$:	ADD	(R0),(R2)
	SEV
	RETURN
.END

SUB3.MAC
.TITLE	SUB3 - Subtract two triple-precision integers
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	8-Mar-81	CVLLIB Routine

		.If eq 1
Subtracts a triple-precision integer pointed to in R0 from a triple-precision
integer pointed to in R2, storing the result in the place of the number
pointed to in R2.  Overflow is set on return if it occurred.
		.Endc

SUB3::
	SUB	4(R0),4(R2)
	SBC	2(R2)
	SBC	(R2)
	BVS	10$
	SUB	2(R0),2(R2)
	SBC	(R2)
	BVS	20$
	SUB	(R0),(R2)
	RETURN
10$:
	SUB	2(R0),2(R2)
	SBC	(R2)
20$:	SUB	(R0),(R2)
	SEV
	RETURN
.END

WMPT.MAC
.TITLE	WMPT - Write money, (without $ sign), set # positions, to terminal
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	20-Jan-81	CVLLIB Routine

.GLOBL	W$T,WMP,WMDP

		.If eq 1
Writes a double-length integer (cents) from R2,R3 to the terminal as nnn.mm
The minimum number of places for the result to occupy, right-justified,
is taken from R0.

WMDPT - Writes leading dollar sign
WMPT  - No leading dollar
		.endc

WMDPT::
	CALL	W$T
	.WORD	WMDP
WMPT::
	CALL	W$T
	.WORD	WMP
.END

WMT.MAC
.TITLE	WMT - Write money, (without $ sign), to terminal
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	31-Dec-80	CVLLIB Routine

.GLOBL	W$T,WM,WMD

		.If eq 1
Writes a double-length integer (cents) from R2,R3 to the terminal as nnn.mm

WMDT - Provides a leading dollar sign
WMT  - No leading dollar
		.endc

WMDT::
	CALL	W$T
	.WORD	WMD
WMT::
	CALL	W$T
	.WORD	WM
.END

WMP.MAC
.TITLE	WMP - Write money, (without $ sign), set # positions, to string
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	31-Dec-80	CVLLIB Routine

.GLOBL	W$2P,WM,WMD

		.If eq 1
Writes a double-length integer (cents) from R2,R3 to the string pointed to
in R1 as nnn.mm
The minimum number of places for the result to occupy, right justified, is
taken from R0.

WMDP - Provides a leading dollar sign
WMP  - No leading dollar
		.endc

WMDP::
	CALL	W$2P
	.WORD	WMD
WMP::
	CALL	W$2P
	.WORD	WM
.END

WM.MAC
.TITLE WM - Write money to string
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	20-Jan-81	CVLLIB Routine

.GLOBL	DIV21,WD2,W2D

		.If eq 1
Writes a double-length integer from R2,R3 taking it as a number of cents,
in the format dddd.cc as dollars and cents.  The number is written into
the string pointed to in R1.

WMD - includes a leading dollar sign
WM  - no leading dollar sign.

Any sign of the integer itself will be inserted after the dollar sign.
No registers are altered.
		.Endc

	.ENABL	LSB
WMD::
	MOVB	#'$,-(SP)	;For dollar sign.
	BR	5$
WM::
	CLR	-(SP)		;No dollar sign here.
5$:
	MOV	R0,-(SP)
	MOV	R2,-(SP)
	MOV	R3,-(SP)

	TST	R2		;If neg, deal with it here.
	BGE	10$
	NEG	R2
	NEG	R3
	SBC	R2
	MOVB	#'-,(R1)+
10$:
	MOVB	6(SP),(R1)+	;See if he wanted a dollar sign
	BNE	15$		;He did.
	DEC	R1		;If he didn't, back up over it.
15$:
	MOV	#100.,R0	;Divisor for DIV21 (double length/single
	CALL	DIV21		; length signed division)

	CALL	WD2		;Write signed quotient from R2,R3

	MOVB	#'.,(R1)+
	CALL	W2D		;Write 2-digit number

	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	(SP)+,R0
	TST	(SP)+

	RETURN
.END

RMT.MAC
.TITLE	RMT - Read money value from the terminal
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	16-Feb-81	CVLLIB Routine

.GLOBL	RM,R$T

		.If eq 1
Reads a monetary value typed by the user at his terminal.  Leading signs
(+, -, & $) are allowed.  The value is returned in cents as a double-
precision integer in R2, R3.

NOTE: $34.56 will return 3456, but $34.5 will return 3450.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan or the input string may have been terminated before the
end of the number.
		.endc

RMT::
	CALL	R$T
	.WORD	RM
.END

RM.MAC
.TITLE	RM - Read money value
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	16-Feb-81	CVLLIB Routine

.GLOBL	RSGN,RD2,MUL21,R2D

		.If eq 1
Reads a monetary value from the string pointed to in R1, returning a
double-length integer value in cents in R2,R3.  A leading Dollar
sign may be present, as may a sign, either before or after the dollar
sign.  $3.56 will thus return the value 356, but NOTE that the value
$4.5 will return 450.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan or the input string may have been terminated before the
end of the number.
		.endc

RM::
	MOV	R0,-(SP)	;Only saving a register.
	CALL	RSGN		;See if sign before dollar sign
	MOV	R0,-(SP)	;Save value of sign
	CMPB	(R1),#'$
	BNE	10$
	INC	R1
	CALL	RSGN		;Allow sign after dollar
	TST	R0
	BEQ	10$		;If has one in both camps, sort it out!
	COM	(SP)
10$:
	CALL	RD2		;Read a long number into R2,R3
	BCS	40$		;(Overflow)
	MOV	#100.,R0
	CALL	MUL21		;Dollars into cents
	BCS	40$		;(Overflow)

	CMPB	(R1),#'.	;If decimal point, look for more
	BNE	20$

	INC	R1		;Skip the dot
	CALL	R2D		;Read 2-digit number
	ADD	R0,R3
	ADC	R2
	BVS	40$
20$:
	TST	(SP)+		;Check sign
	BGE	30$
	NEG	R2
	NEG	R3
	SBC	R2
30$:
	CLC
	MOV	(SP)+,R0
	RETURN
40$:				;Overflow return
	TST	(SP)+
	MOV	(SP)+,R0
	SEC
	RETURN
.END

WD2PT.MAC
.TITLE WD2PT - Print decimal (signed) d/precis # on terminal, spec # places
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1A	20-Jan-81	CVLLIB Routine

		.If eq 1
Called by
		MOV	<No of places to occupy (min)>,R0
		MOV	<hi-ord 16 bits>,R2
		MOV	<lo-ord 16 bits>,R3
		CALL	WD2PT

No registers are altered.
If more spaces are required, they are used with no error indication.
		.ENDC

.GLOBL	W$T,WD2P

WD2PT::
	CALL	W$T
	.WORD	WD2P
.END

WD2T.MAC
.TITLE WD2T - Print decimal (signed) double-precis number on terminal
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	21-Dec-80	CVLLIB Routine

		.If eq 1
Called by
		MOV	<hi-ord 16 bits>,R2
		MOV	<lo-ord 16 bits>,R3
		CALL	WD2T

No registers are altered.
		.ENDC

.GLOBL	W$T,WD2

WD2T::
	CALL	W$T
	.WORD	WD2
.END

WD2P.MAC
.TITLE WD2P - Convert decimal (signed) d/precis # to string, spec # places
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	21-Dec-80	CVLLIB Routine

		.If eq 1
Called by
		MOV	<address of character string>,R1
		MOV	<No of places to occupy (min)>,R0
		MOV	<hi-ord 16 bits>,R2
		MOV	<lo-ord 16 bits>,R3
		CALL	WD2P

No registers are altered.
If more spaces are required, they are used with no error indication.
		.ENDC

.GLOBL	W$2P,WD2

WD2P::
	CALL	W$2P
	.WORD	WD2
.END

WD2.MAC
.TITLE WD2 - Write a decimal double-precis number
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1A	16-Feb-81	CVLLIB Routine

.GLOBL	DIV21
		.if eq 1
Converts a double-precision integer in R2 (hi-ord) and R3 (lo-ord) into
a string of digits in the string pointed to by R1.  R1 is the only
register altered, and is left pointing to the next free byte.
		.endc

WD2::
	MOV	R0,-(SP)
	MOV	R4,-(SP)
	CLR	R4
	MOV	R3,-(SP)
	MOV	R2,-(SP)
	BGE	10$
	NEG	R2		;If negative, make positive!
	NEG	R3
	SBC	R2
	BIC	#100000,R2	;In case 100000
	MOVB	#'-,(R1)+
10$:
	INC	R4		;Digit counter
	MOV	#10.,R0		;Divisor for DIV21
	CALL	DIV21
	MOV	R0,-(SP)	;Remainder
	TST	R2
	BNE	10$		;Stop when zero
	TST	R3
	BNE	10$
20$:
	ADD	#'0,(SP)
	MOVB	(SP)+,(R1)+
	DEC	R4
	BGT	20$

	MOV	(SP)+,R2
	MOV	(SP)+,R3
	MOV	(SP)+,R4
	MOV	(SP)+,R0
	RETURN
.END

W82SPT.MAC
.TITLE W82SPT - Print signed octal d/precis # on terminal, spec # places
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	21-Dec-80	CVLLIB Routine

		.If eq 1
Called by
		MOV	<No of places to occupy (min)>,R0
		MOV	<hi-ord 16 bits>,R2
		MOV	<lo-ord 16 bits>,R3
		CALL	W82SPT

No registers are altered.
If more spaces are required, they are used with no error indication.
		.ENDC

.GLOBL	W$T,W82SP

W82SPT::
	CALL	W$T
	.WORD	W82SP
.END

W82PT.MAC
.TITLE W82PT - Print unsigned octal d/precis # on terminal, spec # places
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	21-Dec-80	CVLLIB Routine

		.If eq 1
Called by
		MOV	<No of places to occupy (min)>,R0
		MOV	<hi-ord 16 bits>,R2
		MOV	<lo-ord 16 bits>,R3
		CALL	W82PT

No registers are altered.
If more spaces are required, they are used with no error indication.
		.ENDC

.GLOBL	W$T,W82P

W82PT::
	CALL	W$T
	.WORD	W82P
.END

W82ST.MAC
.TITLE W82ST - Print signed octal double-precis number on terminal
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	21-Dec-80	CVLLIB Routine

		.If eq 1
Called by
		MOV	<hi-ord 16 bits>,R2
		MOV	<lo-ord 16 bits>,R3
		CALL	W82ST

No registers are altered.
		.ENDC

.GLOBL	W$T,W82S

W82ST::
	CALL	W$T
	.WORD	W82S
.END

W82T.MAC
.TITLE W82T - Print unsigned octal double-precis number on terminal
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	21-Dec-80	CVLLIB Routine

		.If eq 1
Called by
		MOV	<hi-ord 16 bits>,R2
		MOV	<lo-ord 16 bits>,R3
		CALL	W82T

No registers are altered.
		.ENDC

.GLOBL	W$T,W82

W82T::
	CALL	W$T
	.WORD	W82
.END

W82SP.MAC
.TITLE W82SP - Convert signed octal d/precis # to string, spec # places
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	21-Dec-80	CVLLIB Routine

.GLOBL	W$2P,W82S

		.If eq 1
Called by
		MOV	<address of character string>,R1
		MOV	<No of places to occupy (min)>,R0
		MOV	<hi-ord 16 bits>,R2
		MOV	<lo-ord 16 bits>,R3
		CALL	W82SP

No registers are altered.
If more spaces are required, they are used with no error indication.
		.ENDC

W82SP::
	CALL	W$2P
	.WORD	W82S
.END

W82P.MAC
.TITLE W82P - Convert unsigned octal d/precis # to string, spec # places
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	21-Dec-80	CVLLIB Routine

.GLOBL	W$2P,W82

		.If eq 1
Called by
		MOV	<address of character string>,R1
		MOV	<No of places to occupy (min)>,R0
		MOV	<hi-ord 16 bits>,R2
		MOV	<lo-ord 16 bits>,R3
		CALL	W82P

No registers are altered.
If more spaces are required, they are used with no error indication.
		.ENDC

W82P::
	CALL	W$2P
	.WORD	W82
.END

W82S.MAC
.TITLE W82S - Write signed octal double precision number
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	21-Dec-80	CVLLIB Routine

.GLOBL	W82
		.if eq 1
Writes a double-precision integer in R2 (hi-ord) and R3 (lo-ord) as a string
of octal digits, signed, into the string pointed to in R1.  R1 is the only
register altered, being updated to the next free byte.
		.endc
W82S::
	MOV	R3,-(SP)	;Save in case need to negate if negative
	MOV	R2,-(SP)
	BGE	10$
	NEG	R2
	NEG	R3
	SBC	R2
	BIC	#100000,R2
	MOVB	#'-,(R1)+
10$:
	CALL	W82
	MOV	(SP)+,R2
	MOV	(SP)+,R3
	RETURN
.END

W82.MAC
.TITLE W82 - Write unsigned double-precision integer
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	21-Dec-80	CVLLIB Routine

		.if eq 1
Converts a double-precision integer in R2 (hi-ord) and R3 (lo-ord) into
a string of octal digits into the string pointed to in R1.  R1 is updated
to point to the next free byte.  No other registers are altered.
		.endc
W82::
	MOV	R0,-(SP)
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	CLR	R0
10$:
	INC	R0		;Digit counter
	MOV	R3,-(SP)	;Stack low-order word
	CLC			;Shift both words 3 bits to the right
	ROR	R2
	ROR	R3
	ASR	R2
	ROR	R3
	ASR	R2
	ROR	R3
	BNE	10$		;If non-zero, go back for more.
	TST	R2
	BNE	10$
20$:
	BIC	#177770,(SP)	;Use just rightmost digit
	ADD	#'0,(SP)
	MOVB	(SP)+,(R1)+
	DEC	R0
	BNE	20$

	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	(SP)+,R0
	RETURN
.END

WH2PT.MAC
.Title	WH2PT - Print hexadecimal d/precis # on terminal, spec # places
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	15-Apr-83	CVLLIB Routine

		.If eq 1
Called by
		mov	<No of places to occupy (min)>,r0
		mov	<hi-ord 16 bits>,r2
		mov	<lo-ord 16 bits>,r3
		call	wh2pt (or whl2pt)

No registers are altered.
If more spaces are required, they are used with no error indication.

Two entry points are provided:	WH2PT uses capital letters A-F, and
				WHL2PT uses lower case.
		.endc

.globl	w$t,wh2p,whl2p

wh2pt::
	call	w$t
	.word	wh2p

whl2pt::
	call	w$t
	.word	whl2p
.end

WH2T.MAC
.Title	WH2T - Print hexadecimal double-precis number on terminal
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	15-Apr-83	CVLLIB Routine

		.If eq 1
Called by
		mov	<hi-ord 16 bits>,r2
		mov	<lo-ord 16 bits>,r3
		call	wh2t (or whl2t)

No registers are altered.

Two entry points are provided:	WH2T uses capital letters A-F, and
				WHL2T uses lower case.
		.endc

.globl	w$t,wh2,whl2

wh2t::
	call	w$t
	.word	wh2

whl2t::
	call	w$t
	.word	whl2
.end

WH2P.MAC
.Title	WH2P - Convert hex d/precis # to string, spec # places
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	15-Apr-83	CVLLIB Routine

.globl	w$2p,wh2,whl2

		.If eq 1
Called by
		mov	<address of character string>,r1
		mov	<No of places to occupy (min)>,r0
		mov	<hi-ord 16 bits>,r2
		mov	<lo-ord 16 bits>,r3
		call	wh2p (or whl2p)

No registers are altered.
If more spaces are required, they are used with no error indication.

Two entry points are provided:	WH2P uses capitals A-F, and
				WHL2P uses lower case.
		.endc

wh2p::
	call	w$2p
	.word	wh2

whl2p::
	call	w$2p
	.word	whl2
.end

WH2.MAC
.Title	WH2 - Write hexadecimal double-precision integer
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	 8-May-83	CVLLIB Routine
;	Use hex prefix and suffix characters.
.Sbttl	V1	15-Apr-83	CVLLIB Routine

.Globl	hexpre,hexsuf
		.if eq 1
Converts a double-precision integer in R2 (hi-ord) and R3 (lo-ord) into
a string of hex digits into the string pointed to in R1.  R1 is updated
to point to the next free byte.  No other registers are altered.

Two entry points are provided:  WH2, which uses upper case A-F, and
				WHL2, which uses lower case.
		.endc
WH2::
	mov	#'A-10.-'0,hex	;Set for capital letters
	br	whex
WHL2::
	mov	#'a-10.-'0,hex	;Set for lower case letters
whex:
	mov	r0,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)
	clr	r0

	tstb	hexpre		;Any hex prefix?
	beq	10$		;No.
	movb	hexpre,(r1)+	;Yes - use it.
10$:
	inc	r0		;Digit counter
	mov	r3,-(sp)	;Stack low-order word
	clc			;Shift both words 4 bits to the right
	ror	r2
	ror	r3
	asr	r2
	ror	r3
	asr	r2
	ror	r3
	asr	r2
	ror	r3
	bne	10$		;If non-zero, go back for more.
	tst	r2
	bne	10$
20$:
	bic	#177760,(sp)	;Use just rightmost digit
	cmpb	(sp),#9.
	blos	25$		;Numeric.

	add	hex,(sp)	;Alpha
25$:
	add	#'0,(sp)	;Convert to ascii
	movb	(sp)+,(r1)+
	dec	r0
	bne	20$

	tstb	hexsuf		;Any suffix?
	beq	30$		;No.
	movb	hexsuf,(r1)+	;Yes - append it.
30$:
	mov	(sp)+,r3
	mov	(sp)+,r2
	mov	(sp)+,r0
	return

hex:	0

.end

RD2ST.MAC
.TITLE RD2ST - Read signed decimal double-precis number from the terminal
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2A	6-May-83	CVLLIB Routine

		.if eq 1
Reads signed decimal number from terminal into R2 (hi-ord) and R3 (lo-ord).
R1 is left pointing to the delimiting character.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan of the input string is continued to the end of the number.
		.endc

.GLOBL	RD2S,R$T

RD2ST::
	CALL	R$T
	.WORD	RD2S
.END

RD2T.MAC
.Title	RD2T - Read unsigned decimal double-precis number from the terminal
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2A	6-May-83	CVLLIB Routine

.globl	rd2,r$t
		.if eq 1
Reads unsigned decimal number from terminal into R2 (hi-ord) and R3 (lo-ord).
R1 is left pointing to the delimiting character.

Overflow is counted as 32-bit overflow, not 31+sign, the result being counted
as an unsigned integer.  If negative, there has been signed overflow.
Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan of the input string will be continued until the
end of the number.
		.endc


RD2T::
	call	r$t
	.word	rd2
.end

RD2S.MAC
.TITLE	RD2S - Read signed double-precis decimal number
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2A	6-May-83	CVLLIB Routine

.GLOBL	RSGN,RD2

		.if eq 1
Reads a double-precision decimal integer from the string pointed to by R1.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan of the input string will be continued to the end of the
number.

The number is returned in R2 (hi-ord) and R3 (lo-ord).  R1 is reset to
point to the delimiting character.  No other registers are altered.
		.endc

RD2S::
	MOV	R0,-(SP)
	CALL	RSGN		;See what sign he specified
	CLR	-(SP)		;Use as flag for CS/CC return from R10L
	MOV	R0,-(SP)	;Save sign returned from RSGN

	CALL	RD2
	BCC	10$
	INC	2(SP)		;Remember CS return
10$:
	TST	R2		;If negative, too big for signed result
	BGE	15$
	INC	2(SP)
15$:
	TST	(SP)+		;Check required sign
	BEQ	20$
	NEG	R2		;Negate if that's how he wanted it.
	NEG	R3
	SBC	R2
20$:
	TST	(SP)+		;Want CS return?
	BEQ	30$
	SEC			;Yes.
30$:
	MOV	(SP)+,R0
	RETURN
.END

RD2.MAC
.TITLE	RD2 - Read unsigned double-precis decimal number
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V3A	 4-Oct-83	CVLLIB Routine
;Bug fix
.Sbttl	V3	 6-May-83	CVLLIB Routine
;	Rewrite to cope with continuing scan after overflow.
.SBTTL	V2	16-Feb-81	CVLLIB Routine

.GLOBL	LTRIM

		.if eq 1
Reads a double-precision decimal integer from the string pointed to by R1.

Overflow is counted as 32-bit overflow, not 31+sign, the result being counted
as an unsigned integer.  If negative, there has been signed overflow.
Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan of the input string will be continued to the end of the
number.

The number is returned in R2 (hi-ord) and R3 (lo-ord).  R1 is reset to
point to the delimiting character.  No other registers are altered.
		.endc

RD2::
	MOV	R0,-(SP)
	MOV	R5,-(SP)
	clr	r5		;To track carry.

	CALL	LTRIM		;Ignore leading tabs/spaces
	CLR	R2
	CLR	R3
10$:
	MOVB	(R1)+,R0
	BIC	#^C177,R0
	SUB	#'0,R0		;Convert next character to numeric value
	CMP	R0,#9.		; and check range
	BHI	20$

	ASL	R3
	ROL	R2		; * 2
	adc	r5
	mov	r2,-(sp)
	mov	r3,-(sp)

	ASL	R3
	ROL	R2		; * 4
	adc	r5

	ASL	R3
	ROL	R2		; * 8
	adc	r5

	add	(sp)+,r3	; * 10
	adc	r2
	adc	r5
	add	(sp)+,r2
	adc	r5

	ADD	R0,R3
	ADC	R2		;Plus this digit
	adc	r5
	beq	10$
	mov	#1,r5		;In case he's REALLY keen!
	br	10$

20$:
	DEC	R1		;Point back to delimiting character

	tst	r5		;Overflow?
	beq	30$		;No.
	sec			;Yes.
30$:
	MOV	(SP)+,R5
	MOV	(SP)+,R0
	RETURN
.END

R82ST.MAC
.TITLE R82ST - Read signed octal double-precis number from the terminal
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	21-Dec-80	CVLLIB Routine

		.if eq 1
Reads signed octal number from terminal into R2 (hi-ord) and R3 (lo-ord).
R1 is left pointing to the delimiting character.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan of the input string will be continued to the
end of the number.
		.endc

.GLOBL	R82S,R$T

R82ST::
	CALL	R$T
	.WORD	R82S
.END

R82T.MAC
.TITLE R82T - Read unsigned octal double-precis number from the terminal
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	16-Feb-81	CVLLIB Routine

		.if eq 1
Reads unsigned octal number from terminal into R2 (hi-ord) and R3 (lo-ord).
R1 is left pointing to the delimiting character.

Overflow is counted as 32-bit overflow, not 31+sign, the result being counted
as an unsigned integer.  If negative, there has been signed overflow.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan of the input string will have been continued to the
end of the number.
		.endc

.GLOBL	R82,R$T

R82T::
	CALL	R$T
	.WORD	R82
.END

R82S.MAC
.TITLE	R82S - Read signed double-precis octal number
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	16-Feb-81	CVLLIB Routine

.GLOBL	RSGN,R82

		.if eq 1
Reads a double-precision octal integer from the string pointed to by R1.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan of the input string will have been continued to the
end of the number.

The number is returned in R2 (hi-ord) and R3 (lo-ord).  R1 is reset to
point to the delimiting character.  No other registers are altered.
		.endc

R82S::
	MOV	R0,-(SP)
	CALL	RSGN		;See what sign he specified
	CLR	-(SP)		;Use as flag for CS/CC return from R82
	MOV	R0,-(SP)	;Save sign returned from RSGN

	CALL	R82
	BCC	10$
	INC	2(SP)		;Remember CS return
10$:
	TST	R2		;If negative, signed overflow
	BGE	15$
	INC	2(SP)
15$:
	TST	(SP)+		;Check required sign
	BEQ	20$
	NEG	R2		;Negate if that's how he wanted it.
	NEG	R3
	SBC	R2
20$:
	TST	(SP)+		;Want CS return?
	BEQ	30$
	SEC			;Yes.
30$:
	MOV	(SP)+,R0
	RETURN
.END

R82.MAC
.TITLE	R82 - Read unsigned double-precis octal number
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.SBTTL	V3	 6-May-83	CVLLIB Routine
;	Rewrite to cope with continuing scan after overflow.
.SBTTL	V2	16-Feb-81	CVLLIB Routine

.GLOBL	LTRIM

		.if eq 1
Reads a double-precision octal integer from the string pointed to by R1.

Overflow is counted as 32-bit overflow, not 31+sign, the result being counted
as an unsigned integer.  If negative, there has been signed overflow.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan of the input string will have been continued to the
end of the number.

The number is returned in R2 (hi-ord) and R3 (lo-ord).  R1 is reset to
point to the delimiting character.  No other registers are altered.
		.endc

R82::
	mov	r5,-(sp)	;For overflow indication.
	MOV	R4,-(SP)
	CALL	LTRIM		;Ignore leading tabs/spaces
	CLR	R2
	CLR	R3
	clr	r5
10$:
	MOVB	(R1)+,R4
	BIC	#^C177,R4
	SUB	#'0,R4		;Convert next character to numeric value
	CMP	R4,#7		; and check range
	BHI	20$

	ASL	R3
	ROL	R2		; * 2
	adc	r5
	ASL	R3
	ROL	R2		; * 4
	adc	r5
	ASL	R3
	ROL	R2		; * 8
	adc	r5

	ADD	R4,R3
	ADC	R2		;Plus this digit
	adc	r5
	beq	10$
	mov	#1,r5
	br	10$

20$:
	MOV	(SP)+,R4
	DEC	R1		;Point back to delimiting character
	tst	r5		;Check for overflow.
	beq	30$		;None.
	sec			;Some.
30$:
	mov	(sp)+,r5
	RETURN
.END

RH2T.MAC
.Title	RH2T - Read double precision hex number from terminal
.Nlist	bex,toc
.Enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	14-Apr-83	CVLLIB Routine

.Globl	rh2,r$t

		.If eq 1
Reads a signed hex number from the user's terminal, returning the
number in R2,R3.  Carry is set if overflow occurred out of the SIGN bit only.
		.Endc

RH2T::
	call	r$t
	.word	rh2
.end

RH2.MAC
.Title	RH2 - Read double precision hex number from string in R1
.Nlist	bex,toc
.Enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2B	 5-Oct-83	CVLLIB Routine
;Bug fix
.Sbttl	V2A	12-May-83	CVLLIB Routine
; A - Use HEXCMP for prefix/suffix comparison

.Globl	rsgn,hexx,hexpre,hexsuf,hexcmp

		.If eq 1
Reads a signed hex number from the string pointed to in R1, returning the
number in R2,R3.  Carry is set if overflow occurred out of the SIGN bit only.

Any hex prefix character will be skipped, and signs on either side of it will
be taken into account.  Any hex suffix character will be skipped also.
		.Endc

RH2::
	mov	r0,-(sp)
	mov	r5,-(sp)
	clr	r5		;For overflow indication
	call	rsgn		;Read any sign
	mov	r0,-(sp)	; and store it.

	tstb	(r1)		;If at end of line, scram.
	beq	20$

	movb	hexpre,r0	;See if prefix character
	call	hexcmp
	bne	5$		;Not this one.
	inc	r1		;Skip it.
	call	rsgn		;Signs may come after it
	tst	r0		;If negative, complement first sign.
	bpl	5$
	com	(sp)
5$:
	clr	r2		;For result
	clr	r3
10$:
	movb	(r1)+,r0
	call	hexx		;See if valid hex character, and get value
	bcs	25$		;Not hex any more.

	asl	r3		;Shift the previous value
	rol	r2
	adc	r5
	asl	r3		;	four places left, checking
	rol	r2
	adc	r5
	asl	r3		;		for carry out of the top.
	rol	r2
	adc	r5
	asl	r3
	rol	r2
	adc	r5

	add	r0,r3
	adc	r2
	adc	r5
	br	10$
20$:
	dec	r1		;Point back to delimiting character.
25$:
	tst	(sp)+		;Negative requested?
	beq	30$
	neg	r2		;Yes.
	neg	r3
	sbc	r2
30$:
	movb	hexsuf,r0	;Any hex suffix character defined?
	beq	35$		;No.
	call	hexcmp		;Is this it?
	bne	35$		;No.
	inc	r1		;Yes.
35$:
	tst	r5
	beq	40$		;No overflow.
	sec
40$:
	mov	(sp)+,r5
	mov	(sp)+,r0
	return
.end

RN2T.MAC
.Title	RN2T - Read 2/precis number (octal, hex or decimal) from the terminal
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	6-May-83	CVLLIB Routine

.globl	r$t,rn2
		.If eq 1
Called by
		CALL	RN2

Returns a signed number in R2/R3, with CS if overflow occurred.
R1 points to the terminating character in the terminal buffer.

For the discrimination between types of numbers, see RN.MAC.
		.Endc

RN2T::
	call	r$t
	.word	rn2
.end

RN2.MAC
.TITLE	RN2 - Read 2/precis number (octal, decimal or hex) from a string
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1B	12-May-83	CVLLIB Routine
; B - Use HEXCMP to check prefix/suffix
; A - Bug fix

.globl	r82s,rd2s,rh2,hexpre,hexsuf,rsgn,hexx,hexcmp

		.If eq 1
Called by
		MOV	<string>,R1
		CALL	RN2

Returns a signed number in R0, with CS if overflow occurred.

A number is deemed to be hexadecimal if it commence with the character in
the global variable HEXPRE (in this library available with the value "0",
or a leading zero) or if it be suffixed by the character in HEXSUF, or
if it contain the characters A-F (or a-f).  Leading plus or minus signs may
be before or after (or both!) the prefix character.
Any hex suffix character will be skipped before return from RN after reading
a hex number.

Otherwise a number is deemed to be decimal if it contain the digits 8 or 9,
or it be terminated by a full stop.  In this last case, R1 will be left
pointing to the character following the full stop.
		.Endc

RN2::
	mov	r0,-(sp)
	mov	r1,-(sp)	;Hold on to string pointer while checking.

	call	rsgn		;Scrub leading spaces, tabs, + & - signs.
	tstb	(r1)		;See if hit null
	beq	octal2		;Yes - he'll get zero returned.
	movb	hexpre,r0	;Check hex prefix.
	call	hexcmp
	beq	hex2		;Yes, read as hex.

	clr	-(sp)		;Flag for highest character.
10$:
	movb	(r1),r0		;Hit the end yet?
	beq	20$

	cmpb	r0,#'.		;Decimal terminator
	beq	decimal
	movb	hexsuf,r0	;Check hex terminator
	call	hexcmp
	beq	hex1

	movb	(r1)+,r0
	call	hexx		;See if valid hex character
	bcs	20$		;Isn't - assume delimiter.

	cmpb	r0,(sp)		;See if highest so far
	blos	10$
	mov	r0,(sp)
	br	10$

20$:
	cmp	(sp),#7		;See what digit we got to.
	blos	octal1
	cmp	(sp),#9.
	blos	decimal
hex1:
	tst	(sp)+
hex2:
	mov	(sp)+,r1
	mov	(sp)+,r0
	jmp	rh2

octal1:
	tst	(sp)+
octal2:
	mov	(sp)+,r1
	mov	(sp)+,r0
	jmp	r82s


decimal:
	tst	(sp)+
	mov	(sp)+,r1
	mov	(sp),r0
	clr	(sp)		;For overflow.
	call	rd2s
	adc	(sp)		;Remember overflow.
	cmpb	(r1),#'.	;Skip decimal point if terminated number.
	bne	10$
	inc	r1
10$:
	tst	(sp)+		;Check for overflow.
	beq	20$
	sec
20$:	return

.end

WDSPT.MAC
.TITLE	WDSPT - Print decimal (signed) number on terminal, spec # places
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	27-Mar-86	CVLLIB Routine

		.if eq 1
Called by
		MOV	<No of places to occupy (min)>,R2
		MOV	NUMBER,R0
		CALL	WDSPT

No registers are altered.
If more spaces are required, they are used with no error indication.
		.ENDC

.GLOBL	WDSP,W$T

WDSPT::
	CALL	W$T
	.WORD	WDSP
.END

WDPT.MAC
.TITLE	WDPT - Print decimal (unsigned) number on terminal, spec # places
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	27-Mar-86	CVLLIB Routine
;Make WDPT unsigned
.SBTTL	V1A	21-Dec-80	CVLLIB Routine

		.if eq 1
Called by
		MOV	<No of places to occupy (min)>,R2
		MOV	NUMBER,R0
		CALL	WDPT

No registers are altered.
If more spaces are required, they are used with no error indication.
		.ENDC

.GLOBL	WDP,W$T

WDPT::
	CALL	W$T
	.WORD	WDP
.END

WDST.MAC
.TITLE	WDST - Print decimal (signed) number on user's terminal
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	27-Mar-86	CVLLIB Routine

		.If eq 1
Called by MOV NUMBER,R0
	  CALL WDST

No registers are altered.
		.ENDC

.GLOBL	WDS,W$T

WDST::
	CALL	W$T
	.WORD	WDS
.END

WDT.MAC
.TITLE WDT - Print decimal (unsigned) number on user's terminal
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	27-Mar-86	CVLLIB Routine
;Make WDT unsigned
.SBTTL	V1	24-Oct-80	CVLLIB Routine

		.If eq 1
Called by MOV NUMBER,R0
	  CALL WDT

No registers are altered.
		.ENDC

.GLOBL	WD,W$T

WDT::
	CALL	W$T
	.WORD	WD
.END

WDSP.MAC
.TITLE	WDSP - Write signed decimal number to set no of places
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	27-Mar-86	CVLLIB Routine

.GLOBL	WDS,W$P

		.If eq 1
Called by
		MOV	<value>,R0
		MOV	<no of places (min) [left filled with spaces]>,R2
		MOV	#STRING,R1
		CALL	WDP

		Returns with R1 pointing to next free byte in string.
		If more places than specified in R2 are required, they are
			used with no error indication.
		.endc
WDSP::
	CALL	W$P
	.WORD	WDS
.END

WDP.MAC
.TITLE	WDP - Write unsigned decimal number to set no of places
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.Sbttl	V3	27-Mar-86	CVLLIB Routine
;Make WDP unsigned
.SBTTL	V2	21-Dec-80	CVLLIB Routine

.GLOBL	WD,W$P

		.If eq 1
Called by
		MOV	<value>,R0
		MOV	<no of places (min) [left filled with spaces]>,R2
		MOV	#STRING,R1
		CALL	WDP

		Returns with R1 pointing to next free byte in string.
		If more places than specified in R2 are required, they are
			used with no error indication.
		.endc
WDP::
	CALL	W$P
	.WORD	WD
.END

WD.MAC
.TITLE	WD - Write a signed or unsigned decimal number
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	27-Mar-86	CVLLIB Routine
;Make WD unsigned, and WDS signed
.SBTTL	V1A	21-Dec-80	CVLLIB Routine

		.If eq 1
Called by MOV #STRING,R1
	  MOV NUMBER,R0
	  JSR PC,WD
or	  JSR PC,WDS

Converts the number into a string of decimal digits, signed if WDS, unsigned
if WD, with no leading zeroes or spaces, placing it into the string pointed
to in R1.
		.ENDC

DECTAB:	.WORD	10.,100.,1000.,10000.,-1

.Enabl	lsb

WDS::
	MOV	R0,-(SP)
	BGE	10$

	MOVB	#'-,(R1)+
	MOV	(SP),R0
	NEG	R0
	BIC	#100000,R0
	BR	10$
WD::
	MOV	R0,-(SP)
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
	MOVB	R0,(R1)+
	BR	40$
70$:
	ADD	#60,R2
	MOV	R2,R0
	MOVB	R0,(R1)+

	MOV	(SP)+,R2
	MOV	(SP)+,R3
	MOV	(SP)+,R0
	RETURN
.END

W8SPT.MAC
.TITLE W8SPT - Print octal (signed) number on terminal, spec # places
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	7-Nov-80	CVLLIB Routine

		.If eq 1
Called by
		MOV	<No of places to occupy (min)>,R2
		MOV	NUMBER,R0
		CALL	W8SPT

No registers are altered.
If more spaces are required, they are used with no error indication.
		.ENDC

.GLOBL	W8SP,W$T

W8SPT::
	CALL	W$T
	.WORD	W8SP
.END

W8PT.MAC
.TITLE W8PT - Print octal (unsigned) number on terminal, spec # places
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	7-Nov-80	CVLLIB Routine

		.If eq 1
Called by
		MOV	<No of places to occupy (min)>,R2
		MOV	NUMBER,R0
		CALL	W8PT

No registers are altered.
If more spaces are required, they are used with no error indication.
		.ENDC

.GLOBL	W8P,W$T

W8PT::
	CALL	W$T
	.WORD	W8P
.END

W8ST.MAC
.TITLE W8ST - Print octal signed number on user's terminal
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	24-Oct-80	CVLLIB Routine

		.If eq 1
Called by MOV NUMBER,R0
	  CALL W8ST

No registers are altered.
		.ENDC

.GLOBL	W8S,W$T

W8ST::
	CALL	W$T
	.WORD	W8S
.END

W8T.MAC
.TITLE W8T - Print octal unsigned number on user's terminal
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	24-Oct-80	CVLLIB Routine

		.If eq 1
Called by MOV NUMBER,R0
	  CALL W8T

No registers are altered.
		.ENDC

.GLOBL	W8,W$T

W8T::
	CALL	W$T
	.WORD	W8
.END

W8SP.MAC
.TITLE	W8SP - Write signed octal number to set no of places
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	21-Dec-80	CVLLIB Routine

.GLOBL	W8S,W$P

		.If eq 1
Called by
		MOV	<no of places (min) [left filled with spaces]>,R2
		MOV	#STRING,R1
		MOV	<value>,R0
		CALL	W8SP

		Returns with R1 pointing to next free byte in string.
		If more places than specified in R2 are required, they are
			used with no error indication.
		.endc
W8SP::
	CALL	W$P
	.WORD	W8S
.END

W8P.MAC
.TITLE	W8P - Write unsigned octal number to set no of places
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	21-Dec-80	CVLLIB Routine

.GLOBL	W8,W$P

		.If eq 1
Called by
		MOV	<no of places (min) [left filled with spaces]>,R2
		MOV	#STRING,R1
		MOV	<value>,R0
		CALL	W8P

		Returns with R1 pointing to next free byte in string.
		If more places than specified in R2 are required, they are
			used with no error indication.
		.endc

W8P::
	CALL	W$P
	.WORD	W8
.END

W8S.MAC
.TITLE W8S - Write an octal number, signed
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	24-Oct-80	CVLLIB Routine

.GLOBL	WSGN,W8

		.If eq 1
Called by MOV #STRING,R1
	  MOV NUMBER,R0
	  JSR PC,W8S

Converts the number to a string of octal digits, signed, with no leading
zeroes or spaces, and places it into the string pointed to by R1.
		.ENDC

W8S::
	MOV	R0,-(SP)	;Save, as WSGN may negate number
	CALL	WSGN
	CALL	W8
	MOV	(SP)+,R0
	RETURN
.END

W8.MAC
.TITLE	W8 - Write an unsigned octal number
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	21-Dec-80	CVLLIB Routine

		.if eq 1
Called by MOV #STRING,R1
	  MOV NUMBER,R0
	  JSR PC,W8
Converts the number into a string of octal digits, unsigned, with no
leading zeroes, storing it in the string pointed to in R1.
		.ENDC
W8::
	MOV	R0,-(SP)
	BNE	10$
	  MOVB	#'0,(R1)+	;Send a zero if it is.
	  BR	40$
10$:
	CLR	-(SP)		;Flag for when finished with stack
20$:
	MOV	R0,-(SP)
	CLC			;In case negative
	ROR	R0
	ASR	R0
	ASR	R0
	BNE	20$
30$:
	MOV	(SP)+,R0
	BEQ	40$
	BIC	#177770,R0
	BIS	#60,R0
	MOVB	R0,(R1)+
	BR	30$
40$:
	MOV	(SP)+,R0
	RETURN
.END

WHPT.MAC
.Title	WHPT - Print hexadecimal number on terminal, spec # places
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	15-Apr-83	CVLLIB Routine

		.If eq 1
Called by
		mov	<No of places to occupy (min)>,r2
		mov	number,r0
		call	whpt (or whlpt)

No registers are altered.
If more spaces are required, they are used with no error indication.

Two entry points are provided:	WHPT uses capital letters A-F, and
				WHLPT uses lower case.
		.endc

.globl	whp,whlp,w$t

whpt::
	call	w$t
	.word	whp

whlpt::
	call	w$t
	.word	whlp
.end

WHT.MAC
.Title	WHT - Print hexadecimal number on user's terminal
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	15-Apr-83	CVLLIB Routine

		.If eq 1
Called by
		mov	number,r0
		call	wht (or whlt)

No registers are altered.

Two entry points are provided:	WHT, which uses the capital letters A-F, and
				WHLT, which uses lower case.
		.endc

.globl	wh,whl,w$t

wht::
	call	w$t
	.word	wh

whlt::
	call	w$t
	.word	whl
.end

WHP.MAC
.Title	WHP - Write hexadecimal number to set no of places
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	15-Apr-83	CVLLIB Routine

.globl	wh,whl,w$p

		.If eq 1
Called by
		mov	<no of places (min) [left filled with spaces]>,R2
		mov	#string,r1
		mov	<value>,r0
		call	whp (or whlp)

		Returns with R1 pointing to next free byte in string.
		If more places than specified in R2 are required, they are
			used with no error indication.

Two entry points are provided:	WHP uses capital letters A-F, and
				WHLP uses lower case.
		.endc

WHP::
	call	w$p
	.word	wh

WHLP::
	call	w$p
	.word	whl
.end

WH.MAC
.TITLE	WH - Write a hexdecimal number
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	 8-May-83	CVLLIB Routine
;	Use hex prefix & suffix characters
.Sbttl	V1	15-Apr-83	CVLLIB Routine

.Globl	hexpre,hexsuf
		.if eq 1

Called by
		mov	#string,r1
		mov	number,r0
		call	wh

Converts the number into a string of hexadecimal digits, unsigned, with no
leading zeroes, storing it in the string pointed to in R1.

There are two entry points: WH, which uses capital letters A-F for digits, and
			    WHL, which uses lower case a-f.
		.endc
WH::
	mov	#'A-10.-'0,hex	;If capital, clear bit in letters
	br	whex
WHL::
	mov	#'a-10.-'0,hex	;If not capitals, leave as is.
whex:
	tstb	hexpre		;Any hex prefix?
	beq	5$		;No.
	movb	hexpre,(r1)+	;Yes - send it.
5$:
	mov	r0,-(sp)
	bne	10$
	  movb	#'0,(r1)+	;Send a zero if it is.
	  br	60$
10$:
	clr	-(sp)		;Flag for when finished with stack
20$:
	mov	r0,-(sp)	;Stack number so far.
	clc			;In case negative
	ror	r0		;Shift over four places
	asr	r0
	asr	r0
	asr	r0
	bne	20$
30$:
	mov	(sp)+,r0	;Extract last digit.
	beq	60$
	bic	#177760,r0	;Chop off all but last hex digit.
	cmpb	r0,#9.
	blos	40$
	add	hex,r0		;Letter
40$:
	add	#'0,r0		;Convert to ascii.
	movb	r0,(r1)+
	br	30$
60$:
	tstb	hexsuf		;Any suffix?
	beq	70$		;No.
	movb	hexsuf,(r1)+	;Yes - use it.
70$:
	mov	(sp)+,r0
	return

hex:	0

.end

RNT.MAC
.Title	RNT - Read a number (octal, hex or decimal) from the terminal
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	6-May-83	CVLLIB Routine
;Include hex
.Sbttl	V1	1-Mar-81

.globl	r$t,rn
		.If eq 1
Called by
		CALL	RN

Returns a signed number in R0, with CS if overflow occurred.  R1 points to the
terminating character in the terminal buffer.

For the discrimination between types of numbers, see RN.MAC.
		.Endc

RNT::
	call	r$t
	.word	rn
.end

RN.MAC
.TITLE	RN - Read a number (octal, decimal or hex) from a string
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2B	12-May-83	CVLLIB Routine
; B - Use HEXCMP for prefix/suffix comparison
; A - Bug Fix
; 2 - Include hexadecimal
.SBTTL	V1	1-Mar-81

.globl	r8s,rds,rh,hexpre,hexsuf,rsgn,hexx,hexcmp

		.If eq 1
Called by
		MOV	<string>,R1
		CALL	RN

Returns a signed number in R0, with CS if overflow occurred.

A number is deemed to be hexadecimal if it commence with the character in
the global variable HEXPRE (in this library available with the value "0",
or a leading zero) or if it be suffixed by the character in HEXSUF, or
if it contain the characters A-F (or a-f).  Leading plus or minus signs may
be before or after (or both!) the prefix character.
Any hex suffix character will be skipped before return from RN after reading
a hex number.

Otherwise a number is deemed to be decimal if it contain the digits 8 or 9,
or it be terminated by a full stop.  In this last case, R1 will be left
pointing to the character following the full stop.
		.Endc

RN::
	mov	r1,-(sp)	;Hold on to string pointer while checking.

	call	rsgn		;Scrub leading spaces, tabs, + & - signs.
	tstb	(r1)		;See if hit null
	beq	octal2		;Yes - he'll get zero returned.
	movb	hexpre,r0	;Check hex prefix
	call	hexcmp
	beq	hex2		;Yes, read as hex.

	clr	-(sp)		;Flag for highest character.
10$:
	movb	(r1),r0		;Hit the end yet?
	beq	20$

	cmpb	r0,#'.		;Decimal terminator
	beq	decimal

	movb	hexsuf,r0	;Check hex suffix
	call	hexcmp
	beq	hex1

	movb	(r1)+,r0	;Restore character
	call	hexx		;See if valid hex character
	bcs	20$		;Isn't - assume delimiter.

	cmpb	r0,(sp)		;See if highest so far
	blos	10$
	mov	r0,(sp)
	br	10$

20$:
	cmp	(sp),#7		;See what digit we got to.
	blos	octal1
	cmp	(sp),#9.
	blos	decimal
hex1:
	tst	(sp)+
hex2:
	mov	(sp)+,r1
	jmp	rh

octal1:
	tst	(sp)+
octal2:
	mov	(sp)+,r1
	jmp	r8s


decimal:
	tst	(sp)+
	mov	(sp),r1
	clr	(sp)		;For overflow.
	call	rds
	adc	(sp)		;Remember overflow.
	cmpb	(r1),#'.	;Skip decimal point if terminated number.
	bne	10$
	inc	r1
10$:
	tst	(sp)+		;Check for overflow.
	beq	20$
	sec
20$:	return

.end

RDST.MAC
.TITLE RDST - Read signed decimal number from the terminal
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	16-Feb-81	CVLLIB Routine

		.If eq 1
Reads signed decimal number from terminal into R0.  R1 is left
pointing to the delimiting character.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan of the input string will have been continued to the
end of the number.
		.Endc

.GLOBL	RDS,R$T

RDST::
	CALL	R$T
	.WORD	RDS
.END

RDT.MAC

.TITLE RDT - Read unsigned decimal number from the terminal
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	16-Feb-81	CVLLIB Routine

		.If eq 1
Reads unsigned decimal number from terminal into R0.  R1 is left
pointing to the delimiting character.

Overflow is counted as 16-bit overflow, not 15+sign, the result being counted
as an unsigned integer.  If negative, there has been signed overflow.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan of the input string will have been continued to the
end of the number.
		.Endc

.GLOBL	RD,R$T

RDT::
	CALL	R$T
	.WORD	RD
.END

RDS.MAC
.TITLE	RDS - Read a signed single-precision decimal number
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	16-Feb-81	CVLLIB Routine

		.If eq 1
Called by
		MOV	#string,R1
		CALL	RDS

Returns the number in R0, and R1 points to the delimiter of the number.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan of the input string will have been continued to the
end of the number.
		.Endc

.GLOBL	RSGN,RD

RDS::
	CLR	-(SP)		;For overflow indication
	CALL	RSGN		;Read any sign specified
	MOV	R0,-(SP)	;Zero if positive, negative if negative
	CALL	RD		;Read unsigned number
	BCC	10$
	INC	2(SP)
10$:
	TST	R0		;If negative, too big for signed number
	BGE	20$
	INC	2(SP)
20$:
	TST	(SP)+
	BEQ	30$
	NEG	R0
30$:
	TST	(SP)+		;Overflow?
	BEQ	40$
	SEC
40$:
	RETURN

.END

RD.MAC
.TITLE	RD - Read an unsigned single-precision decimal number
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V5	 6-May-83	CVLLIB Routine
;	Rewrite to cope with continued scan after overflow.
.Sbttl	V4	28-Aug-82	CVLLIB Routine
;	Repair bug
.SBTTL	V3	16-Feb-81	CVLLIB Routine

.GLOBL	LTRIM
		.if eq 1
Called by
		MOV	#string,R1
		CALL	RD

Returns the number in R0, and R1 points to the delimiter of the number.

Overflow is counted as 16-bit overflow, not 15+sign, the result being counted
as an unsigned integer.  If negative, there has been signed overflow.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan of the input string will have been continued to the
end of the number.
		.endc

RD::
	mov	r2,-(sp)
	mov	r3,-(sp)
	clr	r2		;For overflow detection.
	clr	-(sp)

	call	ltrim
	clr	r0		;For result
10$:
	movb	(r1)+,r3	;Next character
	bic	#^c177,r3
	sub	#'0,r3
	cmp	r3,#9.
	bhi	20$

	asl	r0		; * 2
	adc	r2
	mov	r0,(sp)

	asl	r0
	adc	r2		; * 4

	asl	r0		; * 8
	adc	r2

	add	(sp),r0		; * 10
	adc	r2

	add	r3,r0
	adc	r2
	beq	10$
	mov	#1,r2
	br	10$

20$:
	dec	r1		;Point at delimiter
	tst	(sp)+
	mov	(sp)+,r3
	tst	r2		;Any overflow?
	beq	30$		;No.
	sec			;Yes.
30$:
	mov	(sp)+,r2
	return
.end

R8ST.MAC
.TITLE R8ST - Read signed octal number from the terminal
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	16-Feb-81	CVLLIB Routine

		.If eq 1
Reads signed octal number from terminal into R0.  R1 is left
pointing to the delimiting character.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan of the input string will have been continued to the
end of the number.
		.Endc

.GLOBL	R8S,R$T

R8ST::
	CALL	R$T
	.WORD	R8S
.END

R8T.MAC
.TITLE R8T - Read unsigned octal number from the terminal
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	16-Feb-81	CVLLIB Routine

		.If eq 1
Reads unsigned octal number from terminal into R0.  R1 is left
pointing to the delimiting character.

Overflow is counted as 16-bit overflow, not 15+sign, the result being counted
as an unsigned integer.  If negative, there has been signed overflow.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan of the input string will have been continued to the
end of the number.
		.Endc

.GLOBL	R8,R$T

R8T::
	CALL	R$T
	.WORD	R8
.END

R8S.MAC
.TITLE	R8S - Read a signed single-precision octal number
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	16-Feb-81	CVLLIB Routine

.GLOBL	RSGN,R8

		.If eq 1
Called by
		MOV	#string,R1
		CALL	R8S

Returns the number in R0, and R1 points to the delimiter of the number.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan of the input string will have been continued to the
end of the number.
		.Endc

R8S::
	CLR	-(SP)		;For overflow indication
	CALL	RSGN		;Read any sign specified
	MOV	R0,-(SP)	;Zero if positive, negative if negative
	CALL	R8		;Read unsigned number
	BCC	10$
	INC	2(SP)
10$:
	TST	R0
	BGE	20$		;If negative returned, signed overflow
	INC	2(SP)		; has occurred
20$:
	TST	(SP)+
	BEQ	30$
	NEG	R0
30$:
	TST	(SP)+		;Was there overflow?
	BEQ	40$
	SEC
40$:
	RETURN

.END

R8.MAC
.TITLE	R8 - Read an unsigned single-precision octal number
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V3	16-Feb-81	CVLLIB Routine

.GLOBL	LTRIM
		.if eq 1
Called by
		MOV	#string,R1
		CALL	R8

Returns the number in R0, and R1 points to the delimiter of the number.

Overflow is counted as 16-bit overflow, not 15+sign, the result being counted
as an unsigned integer.  If negative, there has been signed overflow.

Overflow is indicated by return with the carry bit set.  Should overflow
occur, the scan of the input string will have been continued to the
end of the number.
		.endc

R8::
	MOV	R2,-(SP)	;For overflow indication
	CLR	R2
	CALL	LTRIM
	CLR	R0
10$:
	MOVB	(R1)+,-(SP)
	BIC	#^C177,(SP)
	SUB	#'0,(SP)	;Convert to number
	CMP	(SP),#7
	BHI	20$
	ASL	R0
	ADC	R2
	ASL	R0
	ADC	R2
	ASL	R0
	ADC	R2
	ADD	(SP)+,R0
	ADC	R2
	BR	10$
20$:
	TST	(SP)+
	TST	R2
	BEQ	30$
	SEC
30$:
	MOV	(SP)+,R2
	DEC	R1
	RETURN
.END

RHT.MAC
.Title	RHT - Read hex number from terminal
.Nlist	bex,toc
.Enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	14-Apr-83	CVLLIB Routine

.Globl	rh,r$t

		.If eq 1
Reads a signed hex number from the user's terminal, returning the
number in R0.  Carry is set if overflow occurred out of the SIGN bit only.
		.Endc

RHT::
	call	r$t
	.word	rh
.end

RH.MAC
.Title	RH - Read hex number from string in R1
.Nlist	bex,toc
.Enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1A	12-May-83	CVLLIB Routine
; A - Use HEXCMP to check prefix/suffix

.Globl	rsgn,hexx,hexpre,hexsuf,hexcmp

		.If eq 1
Reads a signed hex number from the string pointed to in R1, returning the
number in R0.  Carry is set if overflow occurred out of the SIGN bit only.

Any hex prefix will be skipped.  Signs may be on either side of the prefix.
Any hex suffix will be skipped.
		.Endc

RH::
	mov	r3,-(sp)
	mov	r2,-(sp)
	clr	r3		;For overflow indication
	call	rsgn		;Read any sign
	mov	r0,-(sp)	; and store it.

	clr	r2		;For result

	tstb	(r1)
	beq	25$		;End of line - zero result

	movb	hexpre,r0	;Hex prefix?
	call	hexcmp
	bne	10$		;No.

	inc	r1		;Yes - skip it.
	call	rsgn		;See if sign follows
	tst	r0
	bpl	10$
	com	(sp)		;Negative sign.
10$:
	movb	(r1)+,r0
	call	hexx		;See if valid hex character, and get value
	bcs	20$		;Not hex any more.
	asl	r2		;Shift the previous value
	adc	r3
	asl	r2		;	four places left, checking
	adc	r3
	asl	r2		;		for carry out of the top.
	adc	r3
	asl	r2
	adc	r3

	add	r0,r2
	br	10$
20$:
	dec	r1		;Point at delimiter, not past it.
25$:
	mov	r2,r0
	tst	(sp)+		;Negative requested?
	beq	30$
	neg	r0		;Yes.
30$:
	mov	r0,-(sp)	;Check for hex suffix.
	movb	hexsuf,r0
	beq	35$		;None defined.
	call	hexcmp
	bne	35$
	inc	r1		;Yes - skip it.
35$:	mov	(sp)+,r0

	tst	r3
	beq	40$		;No overflow.
	sec
40$:
	mov	(sp)+,r2
	mov	(sp)+,r3
	return
.end

SCG.MAC
.Title	SCG - String Compare (General)
.Enabl	lc
.Nlist	bex,toc,sym
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	22-Feb-82	CVLLIB Routine

.globl	case$
		.If eq 1
Called by
	Mov	#<string1>,R0
	Mov	#<string2>,R1
	Call	SCG
	Flags set as per CMP (r0),(r1)
		but as the string, null or <200>
		terminated.
	R0/	points to byte after last examined
	R1/	points to byte after last examined

Upper and lower case alphabetic characters are taken to be the same,
and the parity bit is ignored.

To match, the strings must be the same length.
		.Endc

SCG::
	movb	(r1)+,-(sp)	;byte from second string
	call	case$
	movb	(r0)+,-(sp)
	call	case$

	tst	(sp)		;See if null - ie end of string
	beq	10$
	tst	2(sp)
	beq	10$

	cmp	(sp)+,(sp)+	;Compare each byte, and
	beq	scg		; return if find inequality.
	return
10$:
	cmp	(sp)+,(sp)+	;When find null, return.
	return
.end

SCX.MAC
.Title	SCX - String Compare (Exact)
.Enabl	lc
.Nlist	bex,toc,sym
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	22-Feb-82	CVLLIB Routine

		.If eq 1
Called by
	Mov	#<string1>,R0
	Mov	#<string2>,R1
	Call	SCX
	Flags set as per CMP (r0),(r1)
		but as the string, null or <200>
		terminated.
	R0/	points to byte after last examined
	R1/	points to byte after last examined

Upper and lower case alphabetic characters are taken to be different,
but the parity bit is ignored.

To match, the strings must be the same length.
		.Endc

SCX::
	movb	(r1)+,-(sp)	;byte from second string
	bic	#^c177,(sp)
	movb	(r0)+,-(sp)
	bic	#^c177,(sp)

	tst	(sp)		;See if null - ie end of string
	beq	10$
	tst	2(sp)
	beq	10$

	cmp	(sp)+,(sp)+	;Compare each byte, and
	beq	scx		; return if find inequality.
	return
10$:
	cmp	(sp)+,(sp)+	;When find null, return.
	return
.end

SCGV.MAC
.Title	SCGV - String Compare (General, Differing Lengths)
.Enabl	lc
.Nlist	bex,toc,sym
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	22-Feb-82	CVLLIB Routine

.globl	case$
		.If eq 1
Called by
	Mov	#<string1>,R0
	Mov	#<string2>,R1
	Call	SCGV
	Flags set as per CMP (r0),(r1)
		but as the string, null or <200>
		terminated.
	R0/	points to byte after last examined
	R1/	points to byte after last examined

Upper and lower case alphabetic characters are taken to be the same,
and the parity bit is ignored.

The string pointed to by R0 may be shorter than the string pointed to
in R1, and as long as all the characters up to the end of the R0 string
match, equality will be returned.
		.Endc

SCGV::
	movb	(r1)+,-(sp)	;byte from second string
	call	case$
	movb	(r0)+,-(sp)
	call	case$

	tst	(sp)		;See if null - ie end of string
	beq	10$
	tst	2(sp)
	beq	20$

	cmp	(sp)+,(sp)+	;Compare each byte, and
	beq	scgv		; return if find inequality.
	return
10$:
	clr	2(sp)		;If end of (r0) string, force equality
20$:
	cmp	(sp)+,(sp)+	;When find null, return.
	return
.end

SCXV.MAC
.Title	SCXV - String Compare (Exact, Differing Lengths)
.Enabl	lc
.Nlist	bex,toc,sym
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	22-Feb-82	CVLLIB Routine

		.If eq 1
Called by
	Mov	#<string1>,R0
	Mov	#<string2>,R1
	Call	SCXV
	Flags set as per CMP (r0),(r1)
		but as the string, null or <200>
		terminated.
	R0/	points to byte after last examined
	R1/	points to byte after last examined

Upper and lower case alphabetic characters are taken to be different,
but the parity bit is ignored.

The string pointed to by R0 may be shorter than the string pointed to
in R1, and as long as all the characters up to the end of the R0 string
match, equality will be returned.
		.Endc

SCXV::
	movb	(r1)+,-(sp)	;byte from second string
	bic	#^c177,(sp)
	movb	(r0)+,-(sp)
	bic	#^c177,(sp)

	tst	(sp)		;See if null - ie end of string
	beq	10$
	tst	2(sp)
	beq	20$

	cmp	(sp)+,(sp)+	;Compare each byte, and
	beq	scxv		; return if find inequality.
	return
10$:
	clr	2(sp)		;If end of (r0) string, force equality
20$:
	cmp	(sp)+,(sp)+	;When find null, return.
	return
.end

WAT.MAC
.Title	WAT - Write an ASCII character to the terminal
.Nlist	bex,toc
.Enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1A	6-May-83	CVLLIB Routine

.globl	wa,w$t
			.If eq 1
Called by

		mov	<character>,r0
		call	wat

sends the relevant character to the user's terminal.  If the character
be a control character, it is sent in the form "<bel=7>", with the name and
the octal value of the character concerned.  The more common characters
(tab [rather than "ht"], lf,ff,cr, esc, and rubout [rather than "del"] do
not get their octal values printed.  Characters with the parity bit set are
sent in the form "<200+A>", "<200+<bel=7>>".
				.Endc

WAT::
	call	w$t
	.word	wa
.end

WA.MAC
.Title	WA - Write an ASCII character
.Nlist	bex,toc
.Enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1C	17-Jul-83	CVLLIB Routine
; Bug fix
.Sbttl	V1B	 6-May-83	CVLLIB Routine

.globl	w8
			.If eq 1
Called by

		mov	#string,r1
		mov	<character>,r0
		call	wa

sends the relevant character to the string pointed to in r1.  If the character
be a control character, it is sent in the form "<bel=7>", with the name and
the octal value of the character concerned.  The more common characters
(tab [rather than "ht"], lf,ff,cr, esc, and rubout [rather than "del"] do
not get their octal values printed.  Characters with the parity bit set are
sent in the form "<200+<bel=7>>", "<200+A>".
				.Endc

WA::
	mov	r0,-(sp)
	tstb	r0
	bpl	10$

	mov	#str200,r0	;200 bit set.  Copy in string "<200+"
5$:	movb	(r0)+,(r1)+
	bne	5$
	dec	r1
	mov	(sp),r0
	bic	#^c177,r0
	call	wa		;Try again without that bit set.
	movb	#'>,(r1)+
	mov	(sp)+,r0
	return

10$:
	bic	#^c177,r0
	cmp	r0,#177
	bne	20$		;Rubout

	  mov	#40,r0		;Rubout is dealt with at end of table
	  br	30$
20$:
	cmp	r0,#40
	bhis	80$		;Normal printing character
30$:

; Here have a control character to print.

	movb	#'<,(r1)+

	mov	r2,-(sp)	;For pointer to string
	mov	#control,r2
40$:
	dec	r0
	bmi	60$		;Skip over <value> strings
50$:	tstb	(r2)+
	bgt	50$
	br	40$
60$:
	movb	(r2)+,(r1)+
	bgt	60$

	bmi	70$		;<200> terminator  - don't print value

	dec	r1		;Forget terminator
	movb	#'=,(r1)+
	mov	2(sp),r0
	bic	#^c177,r0
	call	w8
	br	75$
70$:
	dec	r1		;Forget terminator.
75$:
	mov	(sp)+,r2

	movb	#'>,(r1)+
	br	90$

; Normal character - just put it in string

80$:
	movb	r0,(r1)+
90$:
	mov	(sp)+,r0
	return


;Table of codes to print

Control:
	.ascii	/nul/<0>
	.ascii	/soh/<0>
	.ascii	/stx/<0>
	.ascii	/etx/<0>
	.ascii	/eot/<0>
	.ascii	/enq/<0>
	.ascii	/ack/<0>
	.ascii	/bel/<0>
	.ascii	/bs/<0>
	.ascii	/tab/<200>
	.ascii	/lf/<200>
	.ascii	/vt/<0>
	.ascii	/ff/<200>
	.ascii	/cr/<200>
	.ascii	/so/<0>
	.ascii	/si/<0>
	.ascii	/dle/<0>
	.ascii	/dc1/<0>
	.ascii	/dc2/<0>
	.ascii	/dc3/<0>
	.ascii	/dc4/<0>
	.ascii	/nak/<0>
	.ascii	/syn/<0>
	.ascii	/etb/<0>
	.ascii	/can/<0>
	.ascii	/em/<0>
	.ascii	/sub/<0>
	.ascii	/esc/<200>
	.ascii	/fs/<0>
	.ascii	/gs/<0>
	.ascii	/rs/<0>
	.ascii	/us/<0>

	.ascii	/rubout/<200>	;Tack rubout on the end

str200:	.asciz	#<200+#

.end

CASE.MAC
.Title	CASE - Convert alpha characters to upper case
.Enabl	lc
.Nlist	bex,toc,sym
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	22-Feb-82	CVLLIB Routine

		.If eq 1
Called by
		Mov	<character>,-(sp)
		Call	CASE$
		Returns (sp) with the parity bit stripped
			off, and if the character were a lower
			case letter, it has been converted to the
			upper case equivalent.
		.Endc

CASE$::
	bic	#^c177,2(sp)	;Clear all but character bits
	cmp	2(sp),#'z
	bhi	10$
	cmp	2(sp),#'a
	blo	10$
	sub	#40,2(sp)
10$:	return

.end

R2D.MAC
.TITLE	R2D - Read a pair of digits
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1A	20-Jan-81	CVLLIB Routine

.GLOBL	R1D

;Reads a pair of digits usually after a decimal point (designed for
; use with quantities of money).  If only one digit is found, it
; will produce an answer of ten times the value of that digit.
;Thus used to read the portion of 34.56 after the decimal point,
; R2D will produce the value 56, but if used with 34.5 will produce
; the value 50.

R2D::
	CLR	-(SP)		;For result
	CALL	R1D
	BCS	10$		;Not a digit at all - return zero.
	ASL	R0		;Multiply by 10.
	ADD	R0,(SP)
	ASL	R0
	ASL	R0
	ADD	R0,(SP)

	CALL	R1D
	BCS	10$		;No second digit - just return 10.*first
	ADD	R0,(SP)
10$:
	MOV	(SP)+,R0
	RETURN
.END

R1D.MAC
.TITLE	R1D - Read a digit
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1A	20-Jan-81	CVLLIB Routine

;Reads a digit from the string pointed to in R1.  Returns the numeric
; value of that digit, with carry clear.  Returns carry set if the
; character is not a digit, and does not advance R1 past that character.

R1D::
	MOVB	(R1)+,R0
	BIC	#^C177,R0
	SUB	#'0,R0

	CMP	#9.,R0
	BHIS	10$		;Carry clear if succeeds
	DEC	R1
10$:
	RETURN
.END

HEXX.MAC
.Title	HEXX - Determine whether R0 character valid hex value
.Nlist	bex,toc
.Enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	12-May-83	CVLLIB Routine
;Add HEXCMP for prefix/suffix comparison.
.Sbttl	V1	14-Apr-83	CVLLIB Routine

			.If eq 1
Called by
		mov	<char>,r0
		call	hexx
Returns
		r0/ value from 0 to 15 (octal) [undefined if carry set]
		CC  if ok,
		CS  if not valid hex character.

			.Endc

HEXX::
	cmpb	r0,#'0
	blt	nothex
	cmpb	r0,#'9
	ble	number

	cmpb	r0,#'A
	blt	nothex
	cmpb	r0,#'F
	ble	alpha

	cmpb	r0,#'a
	blt	nothex
	cmpb	r0,#'f
	ble	alpha
nothex:
	sec
	return
number:
	sub	#'0,r0
	return
alpha:
	bic	#40,r0
	sub	#<'A-10.>,r0
	return
.Sbttl	HEXCMP - Compare prefix/suffix with char in (R1)

; Called by
;		Mov	hexpre (or hexsuf), R0
;		Call	HEXCMP
; Returns
;		EQ if char in R0 = char in (R1) regardless of case
;		NE otherwise.

.globl	CASE$

Hexcmp::
	mov	r0,-(sp)
	call	case$		;Convert to upper case if needed.
	movb	(r1),-(sp)
	call	case$
	cmp	(sp)+,(sp)+
	return

.end

HEXPRE.MAC
.Title	HEXPRE - define hex lead-in character
.nlist	bex,toc
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	8-May-83	CVLLIB Routine

			.If eq 1
This defines the location into which is placed the hex prefix
character for reading numbers either octal, decimal or hex with
the RN routine.  This location may be altered by the user.
It is also used for writing hex numbers.

If a prefix be defined, any number commencing with this character will
be taken as hex.  For example, if it be ":", then the numbers :34,
-:34, and :-34 will be taken as hex.  Any numbers containing obviously
hex strings (eg 34c9) will be taken as hex also.

[See sister file HEXSUF.MAC]
If a suffix be defined, any number terminated by this suffix will be
taken as hex.  Thus if the suffix is defined as "H", 34H will be taken
as hex regardless of the prefix.

The default is a leading zero ("0" - eg "0a34"), with the suffix defined
as null.
			.Endc

Hexpre::
	.asciz	/0/
.end

HEXSUF.MAC
.Title	HEXSUF - define hex suffix character
.nlist	bex,toc
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	8-May-83	CVLLIB Routine

			.If eq 1
This defines the location into which is placed the hex suffix
character for reading numbers either octal, decimal or hex with
the RN routine.  This location may be altered by the user.
It is also used for writing hex numbers.

[See sister file HEXPRE.MAC]
If a prefix be defined, any number commencing with this character will
be taken as hex.  For example, if it be ":", then the numbers :34,
-:34, and :-34 will be taken as hex.  Any numbers containing obviously
hex strings (eg 34c9) will be taken as hex also.

If a suffix be defined, any number terminated by this suffix will be
taken as hex.  Thus if the suffix is defined as "H", 34H will be taken
as hex regardless of the prefix.

The default is a leading zero ("0" - eg "0a34"), with the suffix defined
as null.
			.Endc

Hexsuf::
	0
.end

WT.MAC
.Title W$T - Common path output section for WxT
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V3	 1-Apr-83	CVLLIB Routine
.Sbttl	V2	21-Dec-80	CVLLIB Routine

		.If eq 1
Called from routines requiring terminal output from R1 string setting
routines eg W8T, W8ST, and WDT.  Saves and resets R1 to point to
buffer TLOUB, calls the required routine, then prints the answer.

There is no preservation of carry across this routine.  Should this be
necessary, use W$CT instead.

The calling sequence is:

	CALL W$T
	.word ROUTINE required.

[V3	1-Apr-83]
Change from TLINB to TLOUB to separate TT input & output.
		.endc

.globl	tloub
.mcall	.print

W$T::
	mov	@(sp),(sp)	;Put address of ROUTINE instead of return addr
	mov	r1,-(sp)
	mov	#tloub,r1	;Address of temporary buffer for ROUTINE
	call	@2(sp)		;Address of ROUTINE here
	movb	#200,(r1)	;Make so prints with no crlf
	mov	(sp)+,r1
	mov	r0,(sp)		;Obliterate first level return address
	.print	#tloub
	mov	(sp)+,r0
	return
.end

WCT.MAC
.Title W$CT - Common path output section for WxT requiring Carry returned
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	1-Apr-83	CVLLIB Routine
.Sbttl	V1	1-Mar-81	CVLLIB Routine

		.If eq 1
Called from routines requiring terminal output from R1 string setting
routines but with carry from those routines preserved (eg WSDATT).
Saves and resets R1 to point to buffer TLOUB, calls the required routine,
then prints the answer.

If preservation of carry from the writing routine is not required, the routine
W$T would be sufficient.

The calling sequence is:

	CALL W$CT
	.word ROUTINE required.

[V2	1-Apr-83]
Make separate TT input & output buffers - TLOUB for output.
		.endc
.globl	tloub
.mcall	.print

W$CT::
	mov	@(sp),(sp)	;Put address of ROUTINE instead of return addr
	mov	r1,-(sp)
	mov	#tloub,r1	;Address of temporary buffer for ROUTINE
	call	@2(sp)		;Address of ROUTINE here
	mov	#0,2(sp)	;Hold for CARRY flag, without upsetting carry.
	bcc	10$
	inc	2(sp)
10$:
	movb	#200,(r1)	;Make so prints with no crlf
	mov	(sp),r1
	mov	r0,(sp)
	.print	#tloub
	mov	(sp)+,r0

	tst	(sp)+		;See if need to set carry as from the routine
	beq	20$
	sec
20$:	return
.end

W2P.MAC
.Title	W$2P - Common path handling of W82P, W82SP, WD2P
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	21-Dec-80	CVLLIB Routine

.globl	srjust

		.If eq 1
Called from double-precision routines requiring right justification
within a set of string positions.

Calling sequence is:
	CALL W$2P
	.word ROUTINE required.

		.ENDC

W$2P::
	mov	@(sp),(sp)	;Put address of ROUTINE instead of return addr
	mov	r1,-(sp)
	call	@2(sp)		;Address of ROUTINE here
	mov	r3,2(sp)	;SRJUST requires R3 with start addr of string
	mov	(sp)+,r3
	mov	r2,-(sp)	; and R2 with number of positions
	mov	r0,r2
	call	srjust
	mov	(sp)+,r2	;Restore orig d/precis no.
	mov	(sp)+,r3
	return
.end

WP.MAC
.Title	W$P - Common path handling of W8P,W8SP,WDP
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	21-Dec-80	CVLLIB Routine

.globl	srjust

		.If eq 1
Called from single-precision routines requiring right justification
within a set of string positions.

Calling sequence is:
	CALL W$P
	.word ROUTINE required.

		.ENDC

W$P::
	mov	@(sp),(sp)	;Put address of ROUTINE instead of return addr
	mov	r1,-(sp)
	call	@2(sp)		;Address of ROUTINE here
	mov	r3,2(sp)	;SRJUST requires R3 with start addr of string
	mov	(sp)+,r3
	call	srjust
	mov	(sp)+,r3
	return
.end

RG.MAC
.Title R$G - Common path output section for R8T,R8ST,R10T,R10ST with .GTLIN
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	 1-Apr-83	CVLLIB Routine
.Sbttl	V1	 3-Feb-81	CVLLIB Routine

.globl	tlinb
.mcall	.gtlin

		.If eq 1
Called from routines requiring terminal input from R1 string using
routines R8X, R8SX, R10X, and R10SX.  Leaves R1 pointing to delimiter in
buffer TLINB, after calling the required routine.

This is equivalent to RT.MAC but uses .GTLIN instead of .TTYIN
It must be specifically loaded with the LINK/INCLUDE option, including R$G
in the load sequence.

[V2	 1-Apr-83]
The routine TLIN included here also uses the .GTLIN instead of .TTYIN.

Calling sequence is:
	CALL R$T
	.word ROUTINE required.

		.endc
R$T::
R$G::
	mov	#tlinb,r1
	mov	r0,-(sp)	;.gtlin SCRUBS r0, SO SAVE IT
	.gtlin	r1
	mov	(sp)+,r0
	mov	@(sp),(sp)	;Swap return address for address of
	return			; routine required.
.Sbttl	TLIN - For reading a teletype line

		.if eq 1
Called by MOV #STRING,R1
	  JSR PC,TLIN

Returns the line null-terminated (no crlf) in STRING, with R1 unchanged
and R0 pointing to the terminating null.

CS is returned if ^C terminated the line (the ^C is left in the input line
for use by the programmer).
		.endc

con.c=3

TLIN::
	mov	r1,-(sp)

	.gtlin	r1
10$:
	tstb	(r1)
	beq	30$
	cmpb	(r1)+,#con.c
	bne	10$

	sec
30$:
	mov	r1,r0
	mov	(sp)+,r1
	return
.end

RT.MAC
.Title	R$T - Common path output section for R8T,R8ST,R10T,R10ST
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	21-Dec-80	CVLLIB Routine

.globl	tlin,tlinb

		.If eq 1
Called from routines requiring terminal input from R1 string using
routines R8X, R8SX, R10X, and R10SX.  Leaves R1 pointing to delimiter in
buffer TLINB, after calling the required routine.

Calling sequence is:
	CALL R$T
	.word ROUTINE required.

		.Endc


R$T::
	mov	r0,-(sp)	;TLIN scrubs R0, so save it
	mov	#tlinb,r1
	call	tlin
	mov	(sp)+,r0
	mov	@(sp),(sp)	;Swap return address for address of
	return			; routine required.
.end

SRJUST.MAC
.Title	SRJUST - Right justify string
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1A	21-Dec-80	CVLLIB Routine

		.If eq 1
Called by
		MOV	<first loc in string>,R3
		MOV	<no. of places to be filled>,R2
		MOV	<end of string, not R justified>,R1
		CALL	SRJUST
	Returns R1 with new end of string
		.endc

SRJUST::
	mov	r0,-(sp)	;Save all regs bar R1
	mov	r3,-(sp)
	mov	r1,r0
	sub	r3,r0		;Number of characters in string now.
	add	r2,r3		;Final end position of string
	cmp	r3,r1		;See if actually took more than specified
	blos	30$		;If so, do nothing.

	mov	r3,-(sp)	;Need final value to return in R1
10$:
	movb	-(r1),-(r3)	;Transfer characters of string
	dec	r0
	bne	10$
20$:
	movb	#40,-(r3)	;Precede by spaces
	cmp	r1,r3
	bne	20$

	mov	(sp)+,r1
30$:
	mov	(sp)+,r3
	mov	(sp)+,r0
	return
.end

W2D.MAC
.Title	W2D - Write 2-digit decimal number with 1 leading zero if necessary
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	21-Dec-80	CVLLIB Routine

.globl	wd

W2D::
	cmp	r0,#10.
	bhis	10$
	movb	#'0,(r1)+
10$:	jmp	wd
.end

WBD.MAC
.Title	WBD - Write 2-digit decimal number with 1 leading blank if necessary
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	21-Dec-80	CVLLIB Routine

.globl	wd

WBD::
	cmp	r0,#10.
	bhis	10$
	movb	#' ,(r1)+	;Leading blank if <10.
10$:	jmp	wd
.end

WSGN.MAC
.Title	WSGN - For writing the sign of a number
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1A	21-Dec-80	CVLLIB Routine

		.If eq 1
Called by MOV #STRING,R1
	  MOV NUMBER,R0
	  JSR PC,WSGN

Inserts a minus sign into the string if the number is negative,
nothing if it is positive.  The contents of R0 are negated if the
number were negative, and cleared if 100000 octal.
		.ENDC

WSGN::
	tst	r0
	bge	10$
	movb	#'-,(r1)+
	neg	r0
	bic	#100000,r0
10$:	return

.end

RSGN.MAC
.Title	RSGN - For reading the sign preceding a number
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1A	21-Dec-80	CVLLIB Routine

		.if eq 1
Called by MOV #STRING,R1
	  JSR PC,RSGN

Ignores any leading spaces, tabs, or plus signs, and returns 0 in R0 if
the number of minus signs is even, -1 in R0 if odd.
		.ENDC

RSGN::
	clr	r0
10$:
	cmpb	(r1),#40
	beq	30$
	cmpb	(r1),#11
	beq	30$
	cmpb	(r1),#'+
	beq	30$

	cmpb	(r1),#'-
	beq	20$

	return

20$:
	com	r0
30$:
	inc	r1
	br	10$
.end

TCRLF.MAC
.Title	TCRLF	Teletype routine for VT100
.Nlist	bex,toc,sym
.Enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1D	17-Jul-83	CVLLIB Routine
; Make ".print nul" ".print #nul".
.Sbttl	V1C	16-May-81	CVLLIB Routine

.mcall	.print
esc=33


TCRLF::			;Print a carriage-return line-feed
	mov	r0,-(sp)
	.print	#nul
	mov	(sp)+,r0
	return

	.save
	.psect	mesage	con
nul:	.byte	0
	.restore

.end

YES.MAC
.TITLE	YES - Request Yes or other answer from terminal
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	17-May-81	CVLLIB Routine

.GLOBL	TLINB,TLIN
		.If eq 1
Called by
		CALL YES

Waits for a line from the user, and returns with carry clear if the
first character of the user's line were "Y" or "y".  Otherwise returns
with carry set.
		.Endc

YES::
	MOV	R0,-(SP)
	MOV	R1,-(SP)

	MOV	#TLINB,R1
	CALL	TLIN
	MOVB	(R1),R0		;First character
	BIC	#177600,R0
	CMPB	R0,#140
	BLO	10$
	SUB	#40,R0		;Lower case to upper
10$:
	CMP	R0,#'Y
	BEQ	20$
	SEC
20$:
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RETURN
.END

YESNO.MAC
.TITLE	YESNO - Request Yes or No answer from terminal
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	17-May-81	CVLLIB Routine

.MCALL	.PRINT
.GLOBL	TLINB,TLIN
		.If eq 1
Called by
		CALL YESNO

Waits for a line from the user, and returns with carry clear if the
first character of the user's line were "Y" or "y".  Returns with carry
set if the first character were "N" or "n".  For any other response it
prompts the user to try again.
		.Endc

YESNO::
	MOV	R0,-(SP)
	MOV	R1,-(SP)
10$:
	MOV	#TLINB,R1
	CALL	TLIN
	MOVB	(R1),R0		;First character
	BIC	#177600,R0
	CMPB	R0,#140
	BLO	20$
	SUB	#40,R0		;Lower case to upper
20$:
	CMP	R0,#'Y
	BEQ	40$
	CMP	R0,#'N
	BEQ	30$

	.PRINT	#AGAIN
	BR	10$
30$:
	SEC
40$:	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RETURN

	.save
	.PSECT	MESAGE	CON
AGAIN:	.ASCII	#Please answer Yes or No (Y or N): #<200>
	.restore
.END

TLIN.MAC
.TITLE TLIN - For reading a teletype line
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	3-Jan-81	CVLLIB Routine

		.if eq 1
Called by MOV #STRING,R1
	  JSR PC,TLIN

Returns the line null-terminated (no crlf) in STRING, with R1 unchanged
and R0 pointing to the terminating null.

CS is returned if ^C terminated the line (the ^C is left in the input line
for use by the programmer).
		.ENDC
.MCALL	.TTYIN
CR=15
LF=12
CON.C=3

TLIN::
	MOV	R1,-(SP)
10$:
	.TTYIN
	CMP	R0,#CR
	BEQ	10$
	CMP	R0,#LF
	BEQ	20$
	MOVB	R0,(R1)+
	CMPB	R0,#CON.C
	BNE	10$
	CLRB	(R1)
	SEC
	BR	30$
20$:
	CLRB	(R1)
30$:	MOV	R1,R0
	MOV	(SP)+,R1
	RETURN
.END

TLINB.MAC
.TITLE	TLINB	- Input Buffer for TT output
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	 1-Apr-83	CVLLIB Routine
.SBTTL	V1	21-Dec-80	CVLLIB Routine

		.If eq 1
[V2	1-Apr-83]
Separate TLINB & TLOUB
		.Endc

TLINB::	.blkb	90.
	.end

TLOUB.MAC
.TITLE	TLOUB	- Output Buffer for TT output
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	1-Apr-83	CVLLIB Routine

TLOUB::	.blkb	140.		;Allow for a printer line
	.end

TUC.MAC
.TITLE TUC & TLC - Teletype upper & lower case setting
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	14-Jan-81	CVLLIB Routine

JSW=44
B.TTLC=40000

TUC::				;Disable lower case
	BIC	#B.TTLC,@#JSW
	RETURN

TLC::				;Enable lower case
	BIS	#B.TTLC,@#JSW
	RETURN
.END

TSPM.MAC
.Title	TSPM & TNSPM - Teletype special mode setting
.Nlist	bex,toc,sym
.Enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	18-Jul-83	CVLLIB Routine

jsw=44
b.tspm==10000

TNSPM::				;Disable special mode
	bic	#b.tspm,@#jsw
	return

TSPM::				;Enable special mode
	bis	#b.tspm,@#jsw
	return
.end

TIOW.MAC
.Title	TIOW & TNIOW - Teletype wait inhibit bit set/clear
.Nlist	bex,toc,sym
.Enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	18-Jul-83	CVLLIB Routine

jsw=44
b.tinh==100

TIOW::				;I/O wait rather than immediate return
	bic	#b.tinh,@#jsw
	return

TNIOW::				;I/O immediate return
	bis	#b.tinh,@#jsw
	return
.end

DATBLK.MAC
.TITLE	DATBLK - Common block for date routines
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	16-Feb-81	CVLLIB Routine

		.if eq 1
This is set up for use as a fortran common block if desired.
		.endc
;--------------------------------------------------------
; Description of DATE BLOCK format:
;
; The block required for Date routines comprises
; 5 words sequentially as follows (defined as offsets) -

; DAY=0		; day of month (1-31)
; MONTH=2		; month of year (1-12)
; YEAR=4		; either actual, or less 1900
; DYEAR=6		; day of year (1-365)
; RTDAT=10	; date in RT-11 format
		;  {ie 1b;5b<month>;5b<day>;5b<year-1972>}

; This block is provided in this library for convenience.  It
; may be utilized in Macro by MOV #DATBLK,R2 or through
; Fortran in the form
;	COMMON/DATBLK/DAY,MONTH,YEAR,DYEAR,RTDAT
;	CALL FTODAT(DAY) {for example}
; All the locations are labelled respectively with those
; names as globals.
;---------------------------------------------------------

.PSECT	DATBLK	RW,D,GBL,REL,OVR

DATBLK::
	DAY::	0
	MONTH::	0
	YEAR::	0
	DYEAR::	0	;For day of year
	RTDAT::	0	;RT11 format date -
			; b1 b5<month> b5<day> b5<year-1972.>
.END

TIMBLK.MAC
.TITLE	TIMBLK - Common locations for use with time functions
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	16-Feb-81	CVLLIB Routine

		.if eq 1
This is set up so it may be used as a fortran common block if desired.
		.endc
;--------------------------------------------------------
; Description of TIME BLOCK format:
;
; The block required for Time routines comprises
; 7 words sequentially as follows (defined as offsets) -

; HOURS=0		; hours (in 24-hour format)
; MINS=2		; minutes
; SECS=4		; seconds
; TICKS=6		; clock ticks
; RTIM1=10		; RT-11 format time, high order word
; RTIM2=12		; RT-11 format time, low  order word
			; (together forming a double-precision
			; integer with the number of clock ticks
			; since the previous midnight)
; TCLOCK=14		; number of clock ticks per second
			; in this system (default 50; set by
			; RSTIM or by the user)

; A block is provided in this library for convenience.  It
; may be used in either the form MOV #TIMBLK,R2 (for macro
; routines) or as
;	COMMON/TIMBLK/HOURS,MINS,SECS,TICKS,RTIM1,RTIM2,TCLOCK
;	CALL FRSTIM(HOURS) ! for example
; All the locations are labelled respectively with those
; names as globals.
;---------------------------------------------------------

.PSECT	TIMBLK	RW,D,GBL,REL,OVR

TIMBLK::
	HOURS::	0
	MINS::	0
	SECS::	0
	TICKS::	0
	RTIM1::	0	;RT11 format time - 2-word integer
	RTIM2::	0
	TCLOCK::50.	;Used as divisor or multiplier for tick conversion
.END

C12.MAC
.TITLE C12	- Convert single to double-precision
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	16-Feb-81	CVLLIB Routine

		.if eq 1
Expects a single-precision integer in R0.  Returns a double-precision
equivalent in R2 (hi-ord, either 0 or -1) and R3 (lo-ord).  R0 is unchanged.
		.endc

C12::
	CLR	R2
	MOV	R0,R3
	BGE	10$
	COM	R2
10$:
	RETURN
.END

C13.MAC
.TITLE C13	- Convert single to triple-precision
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	16-Feb-81	CVLLIB Routine

		.if eq 1
Expects a single-precision integer in R0.  Returns a triple-precision
equivalent in the locations pointed to in R2.  R0 is unchanged.
		.endc

C13::
	CLR	(R2)+
	CLR	(R2)+
	MOV	R0,(R2)
	CMP	-(R2),-(R2)
	TST	R0
	BGE	10$
	DEC	(R2)
	DEC	2(R2)
10$:
	RETURN
.END

C23.MAC
.TITLE C23	- Convert double to triple-precision
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	16-Feb-81	CVLLIB Routine

		.if eq 1
Expects a double-precision integer in R2,R3.  Returns a triple-precision
equivalent in the locations pointed to in R0.  All registers are unaltered.
		.endc

C23::
	CLR	(R2)+
	MOV	R2,(R0)+
	MOV	R3,(R0)
	CMP	-(R2),-(R2)
	TST	R2
	BGE	10$
	DEC	(R0)
10$:
	RETURN
.END

C21.MAC
.TITLE	C21 - Convert double precision to single precision
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	16-Feb-81	CVLLIB Routine

		.If eq 1
Called by
		MOV	#hi-ord double-precis number,R2
		MOV	#lo-ord double-precis number,R3
		CALL	C21

Returns a single-precision number in R0.  Should it not be possible to
express the number within the confines of single-precision, the carry bit
is set on return.
		.Endc

C21::
	MOV	R3,R0		;Low order word
	BMI	10$
	TST	R0		;If positive, must have zero high order word
	BNE	30$
	BR	20$
10$:
	CMP	R2,#-1		; and if negative, must have -1 high order.
	BNE	30$
20$:
	CLC
	RETURN
30$:
	SEC
	RETURN
.END

C32.MAC
.TITLE	C32	- Convert triple precision to double precision
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	16-Feb-81	CVLLIB Routine

		.If eq 1
Called by
		MOV	<address of triple-precision integer>,R0
		CALL	C32

returns a double-precision integer in R2,R3.  Should it not be possible to
express the triple-precision number within the confines of a double-precision
one, the carry bit will be set on return.
		.Endc

C32::
	MOV	4(R0),R3	;Lowest-order word
	MOV	2(R0),R2	;Intermediate word
	BMI	10$

	TST	(R0)		;If positive, must have zero high-order word
	BNE	30$
	BR	20$
10$:
	CMP	(R0),#-1	;If negative, hi-ord must be -1
	BNE	30$
20$:
	CLC
	RETURN
30$:
	SEC
	RETURN
.END

C31.MAC
.TITLE	C31 - Convert triple-precision to single
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	16-Feb-81	CVLLIB Routine

		.If eq 1
Called by
		MOV	<address of triple-precision integer>,R2
		CALL	C31

returns a single-precision number in R0.  Should it not be possible to express
the triple precision integer within the confines of a single-precision word,
the carry bit will be set on return.
		.Endc

C31::
	MOV	4(R2),R0	;Lowest order word
	BMI	10$

	TST	2(R2)		;If positive, must have higher-order
	BNE	30$		; words zero
	TST	(R2)
	BNE	30$
	BR	20$
10$:
	CMP	2(R2),#-1	;If negative, higher-order words must be -1
	BNE	30$
	CMP	(R2),#-1
	BNE	30$
20$:
	CLC
	RETURN
30$:
	SEC
	RETURN
.END

CA50.MAC
.Title	CA50 - Convert Ascii to Radix50
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	9-Jan-82	CVLLIB Routine

		.If eq 1
Converts a character in R0 from ascii to radix50.  The unused radix50
character, 35, is assigned to the character "*".  The wildcard "%"
character becomes the same as the character ".".  Illegal characters
cause a CS return.  In addition, the characters space and full-stop
(invalid within filenames) cause a CC but ZS return.
		.Endc

CA50::
	CMP	R0,#'z		;Convert lower case to upper case
	BHI	20$		;At this end, out of bounds anyway.
	CMP	R0,#'a
	BLO	10$
	SUB	#40,R0
10$:
	CMP	R0,#'Z
	BHI	20$		;Illegal
	CMP	R0,#'A
	BHIS	80$		;Alpha
	CMP	R0,#'9
	BHI	20$		;Illegal
	CMP	R0,#'0
	BHIS	70$		;Numeric

	CMP	R0,#40		;Space
	BEQ	40$
	CMP	R0,#'%		;Wildcard %
	BEQ	35$
	CMP	R0,#'*		;Asterisk
	BEQ	50$
	CMP	R0,#'$
	BEQ	60$
	CMP	R0,#'.
	BEQ	30$
20$:
	SEC			;Illegal Character - CS return
	RETURN

30$:
	MOV	#34,R0		;Full stop
	CLC
	SEZ
	RETURN

35$:	SUB	#11-40,R0	;% becomes .
40$:	SUB	#40-15,R0	;Space
50$:	SUB	#15-11,R0	;*
60$:	SUB	#11-22,R0	;$
70$:	SUB	#22-100,R0	;Numeric
80$:	SUB	#100,R0		;Alpha
	CLC			;Note space returns ZS from the subtraction
	RETURN
.END

C50A.MAC
.Title	C50A - Convert Radix50 char to Ascii
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V3	3-Apr-83	CVLLIB Routine
; Rewrite to use table lookup - shorter, faster, & easier to read!
.Sbttl	V2	9-Jan-82	CVLLIB Routine

		.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?/

.end

DIG3.MAC
.Title	DIG3 - Provide 3 Rad50 Digits from Number
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1A	1-Aug-81	CVLLIB Routine

.globl	mul11,div11

		.If eq 1
Called by
		MOV	#<number>,R0
		CALL	DIG3
		CS if R0 >= 1000.
		R0/ Radix50 3 digit number

This is for use with temporary files requiring generation in a numeric
sequence, eg TMP001.TMP, TMP002.TMP etc.
		.Endc

DIG3::
	cmp	r0,#1000.	;See if within permitted range
	blo	10$
	  sec
	  return
10$:
	mov	r2,-(sp)
	mov	r3,-(sp)

	mov	r0,r2
	mov	#10.,r0		;Split off digits.
	call	div11
	mov	r0,-(sp)	;Save remainder (rightmost digit)
	mov	#10.,r0
	call	div11
	mov	r0,-(sp)

	mov	#50,r0		;3 digits (in R2 and on the stack) for Rad50
	call	mul11		; conversion.  MUL11 returns 2.precis result
	add	(sp)+,r3	; in R2,R3
	mov	r3,r2
	call	mul11
	add	(sp)+,r3
	add	#<^r000>,r3
	mov	r3,r0

	mov	(sp)+,r3
	mov	(sp)+,r2
	return
.end

LTRIM.MAC
.TITLE LTRIM - Skip over leading spaces & tabs
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	22-Dec-80	CVLLIB Routine

		.if eq 1
Expects a pointer to a string in R1.  Updates this pointer to point past
any spaces or tabs.
		.endc

SPC=40
TAB=11

L:
	INC	R1
LTRIM::
	CMPB	(R1),#SPC
	BEQ	L
	CMPB	(R1),#TAB
	BEQ	L
	RETURN
.END

RTRIM.MAC
.TITLE RTRIM - Delete trailing spaces & tabs
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	22-Dec-80	CVLLIB Routine

		.if eq 1
Expects a pointer to a string in R1.  Backs up this pointer to point to
before any spaces or tabs.
		.endc

SPC=40
TAB=11

R:
	DEC	R1
RTRIM::
	CMPB	-1(R1),#SPC
	BEQ	R
	CMPB	-1(R1),#TAB
	BEQ	R
	RETURN
.END

MUL11.MAC
.TITLE	MUL11 - single * single and double * single signed multiply
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V3	14-Feb-81	CVLLIB Routine

		.if eq 1
Called by
		MOV	<single precis integer1>,R0
		MOV	<single precis integer2>,R2

		CALL	MUL11
Returns
		R2/hi-ord 2/precis result
		R3/lo-ord 2/precis result

		CS if result cannot be expressed in a single-precision no.

Multiplies two single-precision integers (in R0 and R2) returning
a double-precision result in R2 (hi-ord) and R3 (lo-ord).
R0 is unaltered.
		.endc

MUL11::
	MOV	R1,-(SP)	;Used to hold overflow from single-precis
	CLR	R1

	MOV	R0,-(SP)	;Hold multiplier, and use positive form
	BGE	10$
	NEG	R0
10$:
	MOV	R4,-(SP)	;Put double-precis multiplicand in R4,R5 for
	MOV	R5,-(SP)	; left-shifting.
	CLR	R4
	MOV	R2,R5
	BGE	20$
	DEC	R4
20$:
	CLR	R2
	CLR	R3
	BR	50$

30$:
	ASL	R5		;Shift multiplicand to left for next
	BVC	40$		; (potential) addition.  If overflow, remember
	INC	R1
40$:	ROL	R4

50$:	CLC
	ROR	R0		;Right-shift multiplier
	BCC	70$
	ADD	R5,R3
	BVC	60$
	INC	R1		;Again, keep track of overflow on addition
60$:	ADC	R2
	ADD	R4,R2

70$:	TST	R0
	BNE	30$

	MOV	(SP)+,R5
	MOV	(SP)+,R4
	MOV	(SP)+,R0
	BGE	80$
	NEG	R2		;If negative multiplier, negate result
	NEG	R3
	SBC	R2
80$:
	TST	R1		;Check for overflow into high-order word
	BEQ	90$
	SEC
90$:	MOV	(SP)+,R1
	RETURN
.END

DIV11.MAC
.TITLE DIV11 - Signed single-precision integer divide
.NLIST	BEX,TOC,SYM
.ENABLE	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	15-Jan-81	CVLLIB Routine

		.if eq 1
Called by
	MOV	<dividend>,R2
	MOV	<divisor>,R0
	CALL	DIV11
Returns
	R2/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
DIV11::
	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

20$:
	MOV	#16.,-(SP)
	MOV	R0,-(SP)	;Save on stack for subtractions
	CLR	R0
30$:
	ASL	R2
	ROL	R0
	CMP	R0,(SP)
	BLO	40$
	SUB	(SP),R0		;Subtract out as shift numbers across
	INC	R2		; 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
60$:
	.WORD	CLC!CLV
	RETURN

70$:
	TST	(SP)+
	.WORD	SEC!SEV		;Set both error flags
	RETURN
.END

MUL21.MAC
.TITLE	MUL21 - Multiply double * single precision
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	14-Feb-81	CVLLIB Routine

		.If eq 1
Called by
		MOV	<hi-ord 2/precis integer1>,R2
		MOV	<lo-ord 2/precis integer1>,R3

		MOV	<lo-ord 2/precis integer2>,R0

		CALL	MUL21
Returns
		R2/hi-ord 2/precis result
		R3/lo-ord 2/precis result

		CS if overflow occurred
		(R0 is unchanged)
{If overflow occurred, R2,R3 may contain only garbage}.
		.Endc

MUL21::
	CLR	-(SP)		;For checking for overflow
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R0,-(SP)	;Stack multiplier for right shifting
	BGE	10$		; and keep it positive
	NEG	(SP)
10$:
	MOV	R2,R0		;Use R0,R1 for the left shifting multiplicand
	MOV	R3,R1
	CLR	R2
	CLR	R3
	BR	30$

20$:
	ASL	R1		;Left shift multiplicand
	ROL	R0
	BVS	50$		;Overflow
30$:
	CLC
	ROR	(SP)
	BCC	40$
	ADD	R1,R3
	ADC	R2
	BVS	50$
	ADD	R0,R2
	BVS	50$
40$:
	TST	(SP)
	BNE	20$
	BR	60$
50$:
	INC	6(SP)		;Set overflow flag
60$:
	TST	(SP)+		;Scrap remains of multiplier
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	BGE	70$		;If negative multiplier, negate result
	NEG	R2
	NEG	R3
	SBC	R2
70$:
	TST	(SP)+		;Any Overflow, Clancy?
	BEQ	80$
	SEC
80$:
	RETURN
.END

MUL22.MAC
.TITLE	MUL22 - Multiply double-precis * double-precis
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	26-Mar-81	CVLLIB Routine

		.If eq 1
Called by
		MOV	<hi-ord 2/precis integer1>,R2
		MOV	<lo-ord 2/precis integer1>,R3
		MOV	#<addr of 2.precis-2>,R0
		CALL	MUL22
Returns
		R2/hi-ord 2/precis result
		R3/lo-ord 2/precis result

		CS if overflow occurred
R0 is unchanged.  If overflow occurred, R2,R3 may contain garbage.
		.Endc

MUL22::
	CLR	-(SP)		;Used as indicator for overflow
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	R4,-(SP)
	MOV	R5,-(SP)
	MOV	(R0)+,R4	;Low order multiplicand
	MOV	(R0),R5		;High order, ibid.

	MOV	R3,R1		;Use R0,R1 for multiplier (for right shifting)
	MOV	R2,R0
	BGE	10$
	NEG	R0		;Make sure it's positive
	NEG	R1
	SBC	R0
10$:
	CLR	R2
	CLR	R3
	BR	30$

20$:
	ASL	R5		;Left shift multiplicand
	ROL	R4
	BVS	50$		;Overflow.
30$:
	CLC
	ROR	R0		;Right shift multiplier
	ROR	R1
	BCC	40$
	ADD	R5,R3		;Add in shifted multiplicand
	ADC	R2
	BVS	50$		;More overflow
	ADD	R4,R2
	BVS	50$
40$:
	TST	R0
	BNE	20$
	TST	R1
	BNE	20$
	BR	60$
50$:
	INC	12(SP)		;Record overflow
60$:
	MOV	(SP)+,R5
	MOV	(SP)+,R4
	TST	(SP)+		;If negative multiplier, negate result
	BGE	70$
	NEG	R2
	NEG	R3
	SBC	R2
70$:
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	TST	(SP)+
	BEQ	80$		;Test for overflow, and tell him if it
	SEC			; happened
80$:
	RETURN
.END

DIV21.MAC
.TITLE DIV21 - Signed <double-precision>/<single-precision> integer divide
.NLIST	BEX,TOC,SYM
.ENABLE	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	16-Jan-81	CVLLIB Routine

		.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

ADD2.MAC
.TITLE	ADD2	- Double-precision addition
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	26-Mar-81	CVLLIB Routine

		.If eq 1
Called by
		MOV	#hi-ord d/precis #1,R2
		MOV	#lo-ord d/precis #1,R3
		MOV	#<addr of 2.precis-2>,R0
		CALL	ADD2

returning flags as relevant to the addition, and the result in the
double precision words pointed to in R0.
		.Endc

ADD2::
	ADD	R3,2(R0)
	ADC	(R0)
	BVS	10$		;If overflow here, could lose it on next instr
	ADD	R2,(R0)
	RETURN
10$:
	ADD	R2,(R0)
	SEV			; so make sure he gets it here.
	RETURN
.END

SUB2.MAC
.TITLE	SUB2	- Double-precision subtraction
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V2	26-Mar-81	CVLLIB Routine

		.If eq 1
Called by
		MOV	#hi-ord d/precis #1,R2
		MOV	#lo-ord d/precis #1,R3
		MOV	#<addr of 2.precis-2>,R0
		CALL	SUB2

subtracts the double precis number in R2,R3 from the double precis number
pointed to in R0, returning flags as relevant to the subtraction.  The result
replaces the number pointed to in R0.
		.Endc

SUB2::
	SUB	R3,2(R0)
	SBC	(R0)
	BVS	10$		;If overflow here, could lose it on next instr
	SUB	R2,(R0)
	RETURN
10$:
	SUB	R2,(R0)
	SEV			; so make sure he gets it here.
	RETURN
.END

CMP2.MAC
.TITLE	CMP2	 - Compare two double-precision numbers
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V3	26-Mar-81	CVLLIB Routine

		.If eq 1
Called by
		MOV	<hi-ord 2/precis integer1>,R2
		MOV	<lo-ord 2/precis integer1>,R3
		MOV	#<addr of 2.precis-2>,R0
		CALL	CMP22

Returns flags suitable for comparison of the two quantities equivalent
to single-precision CMP R2,(R0) but taking into account the double nature
of the quantities.
		.Endc

CMP2::
	CMP	R2,(R0)
	BNE	20$
	CMP	R3,2(R0)		;HI implies GT, so clear N
	BHI	30$		;LO implies LT, so set N
	BEQ	20$
10$:
	SEN
	CLV
20$:
	RETURN
30$:
	.word	CLN!CLV
	RETURN
.END

MULX.MAC
.TITLE	MULX - Unsigned multiplication
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	28-Jul-81	CVLLIB Routine

	.If eq 1

Called by:
		MOV	<multiplicand>,R0
		MOV	<multiplier>,R2
		CALL	MULX
		R2/	Single-precision product
		R0/	Unchanged
	.Endc


MULX::
	MOV	R0,-(SP)	;Save multiplicand
	CLR	-(SP)		;For single-precision result
10$:
	CLC
	ROR	R2		;Look at next bit in multiplier
	BCC	20$
	ADD	R0,(SP)		;If not zero, add in next to result
	CLC
20$:	ROL	R0
	TST	R2
	BNE	10$

	MOV	(SP)+,R2	;Result into R2
	MOV	(SP)+,R0	;and restore multiplicand
	RETURN
.END

DIVX.MAC
.TITLE	DIVX	- Unsigned Division
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	28-Jul-81	CVLLIB Routine

	.If eq 1
Called by:
		MOV	<dividend>,R2
		MOV	<divisor>,R0
		CALL	DIVX
		R0/	remainder
		R2/	quotient
	.Endc


DIVX::
	MOV	#16.,-(SP)	;Iteration count - 16 bits
	MOV	R0,-(SP)	;Save divisor for subtractions
	CLR	R0
10$:
	ASL	R2		;Double left shift
	ROL	R0
	CMP	R0,(SP)
	BLO	20$
	SUB	(SP),R0		;Subtract if relevant, and
	INC	R2		; add in to quotient
20$:
	DEC	2(SP)
	BGT	10$
	CMP	(SP)+,(SP)+
	RETURN
.END

SCOP.MAC
.TITLE	SCOP - Copy a string from (R0) to (R1)
.NLIST	BEX,TOC,SYM
.ENABL	LC
.dsabl	gbl

.psect	cvllib

.SBTTL	V1	18-Jan-81	CVLLIB Routine

		.if eq 1
Copies a string pointed to in R0 to a string pointed to in R1.  Parity
bits are cleared, and the R0 string may be null or <200> terminated.
R1 is left pointing to the next available (and also cleared to 0) byte.
		.Endc

SCOP::
	MOVB	(R0)+,-(SP)
	BIC	#177600,(SP)
	MOVB	(SP)+,(R1)+
	BNE	SCOP
	DEC	R1
	RETURN
.END

IRAN.MAC
.Title	IRAN - Random Number Generator
.enabl	lc
.nlist	bex,toc,sym
.dsabl	gbl

.psect	cvllib

.Sbttl	V5	28-Aug-82	CVLLIB Routine
;	Allow production of unsigned integers up to 177777
.SBTTL	V4	17-Sep-81	CVLLIB Routine

.globl	mul21,divx

		.If eq 1
Based (hopefully) on Knuth "Seminumerical Algorithms", with but little
understanding!

Called by
		MOV	<integer to be top limit of random numbers>,R0
		CALL	IRAN

Returns a number from 0 to <integer-1> in R0.
If <integer> were zero, any number from 0 to 177777 may be returned.

The "seed" is available to users in the global RAN$NM
		.Endc

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

	clr	r2
	mov	ran$nm,r3	;RAN$NM=2635*RAN$NM+13849.
	mov	#2635,r0
	call	mul21

	add	#13849.,r3
	mov	r3,ran$nm
	mov	r3,r2
	call	30$		;Rotate right 3 places or get
	call	30$		; regular series of odd and
	call	30$		; even numbers.

	mov	(sp)+,r0
	beq	10$
	call	divx		;Use remainder for limiting number
	br	20$
10$:
	mov	r2,r0		;If zero requested, use full number
20$:
	mov	(sp)+,r3
	mov	(sp)+,r2
	return

30$:
	clc			;Rotate right but without carry bit
	bit	#1,r2		; in sequence.
	beq	40$
	sec
40$:	ror	r2
	return

ran$nm::0

.end

LWADJ.MAC
.Title	LW$ADJ - (Fortran) Common pathways for string I/O
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V3	28-Jul-81	CVLLIB Routine

		.If eq 1
Provides a mechanism for Fortran routines with calling sequences
in the form
		CALL ROUTINE(value,string,last[,nplaces])

which after reading from or writing to <string>, need to calculate the byte
count to be added to <last>.

LW$ADJ - should be entered with a pointer to the routine to be used on the
		stack, and registers other than R1 (string pointer) already
		set up.  It sets up the string pointer, calls the routine,
		clears the next byte, then adjusts <last>.

LR$ADJ - purely sets the value for <last>.  R1 is altered, but R0
		may be used to return a value to the calling programme.
		.Endc

LW$ADJ::
	mov	4(r5),r1	;String pointer
	mov	@(sp),(sp)	;Get address of desired routine on to stack
	call	@(sp)+
	clrb	(r1)
LR$ADJ::
	sub	4(r5),r1	;Calculate length of used portion of string
	add	r1,@6(r5)
	return
.end

LR2T.MAC
.Title	LR$2T - (Fortran) Common pathway for LRx2T
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V3	11-Jul-81	CVLLIB Routine

.globl	lr$adj,lretc

		.If eq 1
Final common pathway for fortran routines reading double-precision
integers from the user's terminal.
These have a calling sequence in the form

	I = LRx2T (value,char)

where <value> is the double-precision integer to be read, and
<char> receives the value of the byte which delimited the number.

The value returned (I) is zero unless carry has been set by the
number-reading routine, in which case it is -1.

The calling sequence is

	JMP	LR$2T
with the number-reading routine already having been called.
		.Endc

LR$2T::
	movb	(r1),@4(r5)	;Delimiting character.
	mov	2(r5),r0	;Put double-precision value in place
	mov	r2,(r0)+
	mov	r3,(r0)
	jmp	lretc		;Set R0 according to carry.
.end

LR2.MAC
.Title	LR$2 - (Fortran) Common pathway for LRx2
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V3	11-Jul-81	CVLLIB Routine

.globl	lr$adj,lretc

		.If eq 1
Final common pathway for fortran routines reading double-precision
integers from strings.
These have a calling sequence in the form

	I = LRx2 (value,string,last)

where <value> is the double-precision integer to be read,
<string> is the string from which the number is to be read, and
<last> is to receive an index to the byte which delimited the number read.

The value returned is zero unless carry is returned set from the
number-reading routine, in which case -1 is returned.

The calling sequence is

	JSR	PC,LR$2
	.WORD	<address of routine to use to read number>

Return is made not to this call but to the original calling sequence.

[V4	1-Apr-83]
Bug fix for incorrect string address calculation.
		.Endc

LR$2::
	mov	4(r5),r1	;Address of string
	mov	@(sp),(sp)	;Move address of read routine to stack top
	call	@(sp)+
	mov	2(sp),r0	;Transfer value from R2,R3
	mov	r2,(r0)+
	mov	r3,(r0)
	call	lretc		;Set up R0 according to carry
	jmp	lr$adj		;Calculates value for <last>, and returns.
.end

CWADJ.MAC
.Title	CW$ADJ - (C) Common pathways for string output
.Nlist	bex,toc,sym
.Enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	1-Apr-83	CVLLIB Routine

.globl	carg

		.If eq 1
Provides a mechanism for C routines with calling sequences
in the form
		routine(&strpnt,value[, ...])

which after reading or writing using strpnt, need to reset it to point
to the next free byte.

The register saving routine CSVR should have been called before the call to
this routine.

CW$ADJ should be entered with a pointer to the routine to be used on the
stack, and registers other than R1 (string pointer) already set up. It sets up
the string pointer, calls the routine, clears the next byte, then adjusts
strpnt.
		.Endc

CW$ADJ::
	mov	@carg+2(sp),r1	;String pointer
	mov	@(sp),(sp)	;Get address of desired routine on to stack
	call	@(sp)+
	clrb	(r1)
	mov	r1,@carg(sp)
	return
.end

CR2.MAC
.TITLE CR$2 - (C) Common pathway for CRx2 & CRx2T
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	1-Apr-83	CVLLIB Routine

.globl	lretc,carg

		.If eq 1
Final common pathway for C routines reading double-precision integers from
strings.  These have a calling sequence in the form

	i = CRx2 (&strpnt,&long);
or	i = CRx2T(&strpnt,&long);

where <long> is the double-precision integer to be read, and on CRx2 routines
<strpnt> points to the string from which the number is to be read.  On return
<strpnt> points to the delimiting characer.

The value returned is zero unless carry is returned set from the reading
routine, in which case -1 is returned.

The register saving routine CSVR should have been called before calling
this routine.

The calling sequence is

	JSR	PC,CR$2 (or CR$2T)
	.WORD	<address of routine to use to read number>

Return is made not to this call but to the original calling sequence.
		.Endc

CR$2::
	mov	@carg+2(sp),r1	;Get string address
CR$2T::
	mov	@(sp),(sp)	;Move address of read routine to stack top
	call	@(sp)+
	mov	carg+2(sp),r0	;Transfer value from R2,R3
	mov	r2,(r0)+
	mov	r3,(r0)
	mov	r1,@carg(sp)	;Set up <strpnt>
	jmp	lretc		;Set up R0 according to carry
.end

LRETC.MAC
.Title	LRETC - Return R0/0 if carry clear, -1 if carry set
.nlist	bex,toc,sym
.enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	11-Jul-81	CVLLIB Routine

LRETC::
	bic	r0,r0		;Clear R0 without affecting carry
	bcc	10$
	dec	r0
10$:	return
.end

CSVR.MAC
.Title	CSVR - (C) Register save & restore
.Nlist	bex,toc
.Enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1A	17-Jul-83	CVLLIB Routine
; Bug fix
.Sbttl	V1	18-Apr-83	CVLLIB Routine

		.If eq 1
Called at the start of any C routine which uses registers R2, R3, or R4.
CSVR calls the routine again as a subroutine and upon its return restores
the registers.

The C library CSV$ is unsuitable for use with CVLLIB as it requires a
JMP CRET$ return rather than an RTS PC.
		.Endc

CSVR::
	mov	r4,-(sp)
	mov	r3,-(sp)
	mov	r2,-(sp)
	call	@6(sp)

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

	tst	(sp)+
	return

CARG==14			;Offset for programmes to access start of
				; argument area on stack.
				;Stack contains:
				;	Arguments
				;	Call to routine from C programme
				;	Call to CSVR from routine
				;	R4
				;	R3
				;	R2
				;	Call back to routine from CSVR
.end

CGTLIN.MAC
.Title CGTLIN - .GTLIN request from C programme
.Enabl	lc
.Nlist	bex,toc,sym
.dsabl	gbl

.psect	cvllib

.Sbttl	V2	 9-Aug-83
;Add prompt
.Sbttl	V1	13-Apr-82

.Mcall	.gtlin

		.If eq 1
Called by
		char line[82];
		cgtlin(line,"prompt\200");
Returns the line, null terminated, in line.
		.Endc

cgtlin::
	mov	2(sp),r1
	mov	4(sp),r0	
	.gtlin	r1,r0
	return
.end

CSERR.MAC
.Title	CSERR - Trap serious RT-11 Errors
.Nlist	bex,toc,sym
.Enabl	lc
.dsabl	gbl

.psect	cvllib

.Sbttl	V1	21-Sep-84	TTLIB Routine

.mcall	.serr

cserr::
	.serr
	return

.end

COMPRS.C
/* COMPRS - For compressing & expanding multiple library files

	V1	13-Sep-84	C G Wilson, Charleville, Australia.

This is a simple programme for combining multiple tiny files into one
large file to save space and make handling convenient.  The compressed
file may be edited with any ordinary editor, but two control characters
are used within the compressed file.  These characters may not be
present within any of the files comprising the compressed file.

The format is:
		(^A is control-A, [ascii 1], and ^Z is control-Z [ascii 32])


		^Afilename
		<text of file, following <cr><lf> after filename>
		^Z (with a <cr><lf> following the ^Z.

		^Anext filename
		etc


If one of the files provided in the list of files to be compressed is
already a compressed file itself, it will not have its name included in
the new compressed file.  The new compressed file will contain the contents
of the old compressed file as though the names of the individual files
had been used.
*/

#include <stdio.h>

#define a_control 1
#define z_control 032
#define tab 011
#define cr 015
#define lf 012

#define userrb 053
#define error_ 4

FILE *inputfile, *outputfile;

char	infilename[30],		/* Input file name */
	outfilename[30],	/* Output file name */
	line[120],		/* User's input line */
	segmentname[30],	/* Input filename without the device */
	*filpnt,		/* Pointer within "line" to filename */
	device[20],		/* Used in filename decoding */
	filename[20],		/* ibid */
	extension[20],		/* ibid */
	defdev[4],		/* Default input device */
	defext[4],		/* Default input extension */
	*p1,*p2;

int	debug;			/* Lists programmes transferred if TRUE */

$$narg=1;			/* Suppress ARGV message */


main()
{
    for(;;)
    {	cgtlin(&line,"COMPRS V1: Compress or Expand? (C or E): \200");
	debug = toupper(*(line+1)) == 'D';
	if(toupper(*line)=='C')compress();
	if(toupper(*line)=='E')expand();
	if(toupper(*line)=='X')exit();
    }
}
/* *************************** C O M P R E S S **************************** */

char promp1[]="Input files (blank line when finished):> \200";
char promp2[]="> \200";


compress()
{
	int	acompressed,	/* TRUE if input file already compressed */
		ch;		/* Needs to be INT for <EOF> */
	char *prompt;		/* Prompt for input files */

	prompt=promp1;

	*defdev=0;		/* Default device is DK (ie null) */
	*defext=0;		/* Default extension is nothing */

	cgtlin(&line,"Output File: \200");
	if(*line==0)return;

	if( (outputfile=fopen(line,"wn"))==0 )
	{	printf("?Comprs-F-Cannot write file %s\n",line);
			goto x;
	} else
	{
		for(;;)
		{	cgtlin(&line,prompt);
			prompt=promp2;
			if(*line==0){fend(outputfile); return;};
			filpnt=line;

			for(;;)
			{
				while ( (*filpnt==' ') || (*filpnt=='\t') ) filpnt++; /* Scrub spaces & tabs */
				if(*filpnt==0)break;

				/* Note that the device names and extensions are "sticky" - ie remain as the
				defaults for subsequent files */

				for(p1=filename ; isfile(*filpnt) ; ) *(p1++)=*(filpnt++); /* Get next filename */
				*p1=0;
				if(*filpnt == ':') /* if ":" delimited, then have device rather than filename */
				{	filpnt++;  /* so copy it across then go for the filename itself */
					for(p1=filename, p2=device ; 0 != (*p2=*p1) ; p1++, p2++);
					for(p1=filename ; isfile(*filpnt) ; ) *(p1++) = *(filpnt++);
					*p1=0;
				}
				if(*filpnt == '.') /* If "." extension has been specified */
				{	filpnt++;
					for(p1=extension ; isfile(*filpnt) ; ) *(p1++) = *(filpnt++);
					*p1=0;
				}
				if(*filpnt==',') filpnt++; /* Skip "," delimiter */

				/* Set up filename for FOPEN by concatenating the three fields */
				p1=infilename;
				if(*device != 0)
				{	for(p2=device ; *p2 != 0 ; *(p1++)=*(p2++) );
					*(p1++)=':';
				}
				for(p2=filename ; *p2 != 0 ; *(p1++) = *(p2++) );
				*(p1++)='.';
				for(p2=extension ; 0 != ( *(p1++) = *(p2++) ) ; );

				/* Set up filename sans device for insertion into compressed file */
				p1=segmentname;
				for(p2=filename ; *p2 != 0 ; *(p1++) = *(p2++) );
				*(p1++)='.';
				for(p2=extension ; 0 != ( *(p1++) = *(p2++) ) ; );

				if(*segmentname==0)
				{	printf("?Comprs-F-File must not have a null name\n");
					goto x;
				}
				if(debug) {printf("%s\n",segmentname); fflush(stdout);};

				if( (inputfile=fopen(infilename,"rn")) == 0 )
				{	printf("?Comprs-F-Cannot find file %s\n",infilename);
					goto x;
				} else
				{	ch = getcnz(inputfile);
					if(ch==EOF)
					{	printf("?Comprs-I-Empty File %s\n",infilename);
						goto x;
					}
					acompressed = (ch == a_control);
					putc(a_control,outputfile);
					if ( ! acompressed)	/* If not compressed file, put the segment name header in */
					{	p1=segmentname;
						while(*p1 != 0) putc (*(p1++),outputfile);
						putc(cr,outputfile); putc(lf,outputfile);
						putc(ch,outputfile);
					}
					for(;;)
					{	ch = getcnz(inputfile);		/* Now transfer the file contents */
						if (ch == EOF) break;
						putc(ch,outputfile);
						if ( (ch == a_control) && acompressed && debug )
						{	putc(tab,stdout);	/* Type routine names if DEBUG */
							do
							{	ch=getcnz(inputfile);
								putc(ch,outputfile);
								putc(ch,stdout);
							} while ((ch!=EOF) && (ch!=lf));
							fflush(stdout);
						}
					}

					if ( ! acompressed)
					{	putc(z_control,outputfile);	/* Control-z terminates segment */
						putc(cr,outputfile); putc(lf,outputfile);
					}
					fclose(inputfile);
				}
			}
		}
	}
x:	fflush(stdout);
	fclose(inputfile);
	fend(outputfile);
	bad();
	return;
}
/* ***************************** E X P A N D ****************************** */

expand()
{
	register int i,c;

	cgtlin(&line,"Input file: \200");
	if( 0 == (inputfile = fopen(line,"rn") ) )
	{	printf("?Comprs-F-Cannot read file %s\n",line);
		goto x;
	} else
	{	cgtlin(&line,"Onto device: \200");
		for(i=0;line[i]!=0;i++)
		{	if(line[i]==':')break;
		}
		if(i!=0)
		{	line[i++]=':';		/* Get device name terminated by a colon unless null */
			line[i]=0;
		}

		for(;;)
		{
			c = getcnz(inputfile);
			if(c!=EOF)
			{
				if(c!=a_control) /* Require first character to be control-A */
				{	printf("?Comprs-F-Input file not in proper format\n");
					goto x;
				} else
				{	for(i=0,p1=outfilename; line[i]!=0; i++,p1++) *p1=line[i];
					while ( cr != (c = getcnz(inputfile) ) ) *(p1++)=c;
					*p1=0;
					getcnz(inputfile); /* Scrub <lf> after <cr> */
					if(debug) {printf("%s\n",outfilename); fflush(stdout);};

					if ( 0 == (outputfile = fopen(outfilename,"wn") ) )
					{	printf("?Comprs-F-Cannot write file %s\n",outfilename);
						goto x;
					} else
					{	while ( c=getcnz(inputfile), ((c!=z_control) && (c!=EOF)) ) putc (c,outputfile);
						getcnz(inputfile); getcnz(inputfile);
						fend(outputfile);
					}
				}
			} else
			{	fclose(inputfile);
				return;
			}
		}
	}
x:	fflush(stdout);
	fclose(inputfile);
	fend(outputfile);
	bad();
	return;
}
/* Assorted subroutines */

getcnz(afile) FILE *afile;		/* Get a non-zero character from file */
{
	register int c;

	while ( 0== (c=getc(afile)) );
	return(c);
}


isfile(c) char c;	/* Return TRUE if  character valid in filename */
{
	return	( ( (c>='A') && (c<='Z') ) || ( (c>='a') && (c<='z') ) ||
		  ( (c>='0') && (c<='9') ) );
}


bad()	/* Set the monitor ERROR bit for RT-11 */
{
	* (char *) userrb = ( * (char *) userrb )  | error_ ;
}

fend(afile) FILE *afile;		/* Needed due to bug in Conroy C */
{
	fflush(afile);
	fclose(afile);		/* otherwise if STDOUT it doesn't get done */
}

