CWRET.MAC
.Title	CWRET - (C) Write 1/precis real number in E format to terminal
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1A	26-Jul-83	CVLLIB Routine
;Correct carg offsets
.Sbttl	V1	1-Apr-83	CVLLIB Routine

.Globl	wret,csvr,carg

			.If eq 1
Called by
		CWRET(f,iwidth,idigits);

	where	f	is the floating-point number (single-precision)
		iwidth	is the field width of the output field
	&	idigits	is the number of digits precision (after decimal)

The output is in the form	-.nnnnne-mm
If the field width be zero, spare spaces in the exponent field will be
squeezed out.
			.Endc

CWRET::
	call	csvr
	mov	carg+0(sp),r2
	mov	carg+2(sp),r3
	mov	carg+4(sp),r0
	mov	carg+6(sp),r4
	jmp	wret
.end

CWRGT.MAC
.Title	CWRGT - (C) Write real number in G format to terminal
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1A	26-Jul-83	CVLLIB Routine
;Correct carg offsets
.Sbttl	V1	1-Apr-83	CVLLIB Routine

.Globl	wrgt,csvr,carg

			.If eq 1
Called by
		CWRGT(f,iwidth,idigits);

	where	f	is the floating-point number (single-precision)
		iwidth	is the field width of the output field
	&	idigits	is the number of digits precision (after decimal)

The output will be in S (scientific or engineering) format if the number
be >=1e6 or <1e-3, and in F format otherwise.  In F format, 4 spaces
will be left to the right of the number (if the field width be non-zero)
to allow columns of numbers to line up.
			.Endc

CWRGT::
	call	csvr
	mov	carg+0(sp),r2
	mov	carg+2(sp),r3
	mov	carg+4(sp),r0
	mov	carg+6(sp),r4
	jmp	wrgt
.end

CWRST.MAC
.Title	CWRST - (C) Write 1/precis real number in S format to terminal
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1A	26-Jul-83	CVLLIB Routine
;Correct carg offsets
.Sbttl	V1	1-Apr-83	CVLLIB Routine

.Globl	wrst,csvr,carg

			.If eq 1
Called by
		CWRST(f,iwidth,idigits);

	where	f	is the floating-point number (single-precision)
		iwidth	is the field width of the output field
	&	idigits	is the number of digits precision (after decimal)

The output will be in S (scientific or engineering) format - ie with
from 1 to 3 digits before the decimal point, and an exponent which
will be a multiple of 3.  Should the exponent be zero, 4 spaces will
be left to the right of the number (unless the field width be non-zero)
to allow columns of numbers to line up.
			.Endc

CWRST::
	call	csvr
	mov	carg+0(sp),r2
	mov	carg+2(sp),r3
	mov	carg+4(sp),r0
	mov	carg+6(sp),r4
	jmp	wrst
.end

CWRFT.MAC
.Title	CWRFT - (C) Write 1/precis real number in F format to terminal
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1A	26-Jul-83	CVLLIB Routine
;Correct carg offsets
.Sbttl	V1	1-Apr-83	CVLLIB Routine

.Globl	wrft,csvr,carg

			.If eq 1
Called by
		CWRFT(f,iwidth,idigits);

	where	f	is the floating-point number (single-precision)
		iwidth	is the field width of the output field
	&	idigits	is the number of digits precision (after decimal)

The output is in the form	-nnn.nnnnn
If the field width be zero, there will be no leading spaces, and trailing
zeroes will be trimmed off.
			.Endc

CWRFT::
	call	csvr
	mov	carg+0(sp),r2
	mov	carg+2(sp),r3
	mov	carg+4(sp),r0
	mov	carg+6(sp),r4
	jmp	wrft
.end

CWRE.MAC
.Title	CWRE - (C) Write 1/precis real number in E format
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	26-Jul-83	CVLLIB Routine
;Adjust CARG offsets
.Sbttl	V1	1-Apr-83	CVLLIB Routine

.Globl	cw$adj,wre,csvr,carg

			.If eq 1
Called by
		CWRE(&strpnt,f,iwidth,idigits);

	where	f	is the floating-point number (single-precision)
		strpnt	points to string into which the number is assembled.
			(it is returned pointing to the next free byte).
		iwidth	is the field width of the output field
	&	idigits	is the number of digits precision (after decimal)

The output is in the form	-.nnnnne-mm
If the field width be zero, spare spaces in the exponent field will be
squeezed out.
			.Endc

CWRE::
	call	csvr
	mov	carg+2(sp),r2
	mov	carg+4(sp),r3
	mov	carg+6(sp),r0	;Field width
	mov	carg+10(sp),r4	;Number of digits after decimal point
	call	cw$adj
	.word	wre
.end

CWRG.MAC
.Title	CWRG - (C) Write 1/precis real number in G format
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	26-Jul-83	CVLLIB Routine
;Adjust CARG offsets
.Sbttl	V1	1-Apr-83	CVLLIB Routine

.Globl	cw$adj,wrg,csvr,carg

			.If eq 1
Called by
		CWRG(&strpnt,f,iwidth,idigits);

	where	f	is the floating-point number (single-precision)
		strpnt	points to string into which the number is assembled.
			(it is returned pointing to the next free byte).
		iwidth	is the field width of the output field
	&	idigits	is the number of digits precision (after decimal)

The output will be in S (scientific or engineering) format if the number
be >=1e6 or <1e-3, and in F format otherwise.  In F format, 4 spaces
will be left to the right of the number (if the field width be non-zero)
to allow columns of numbers to line up.
			.Endc

CWRG::
	call	csvr
	mov	carg+2(sp),r2
	mov	carg+4(sp),r3
	mov	carg+6(sp),r0	;Field width
	mov	carg+10(sp),r4	;Number of digits after decimal point
	call	cw$adj
	.word	wrg
.end

CWRS.MAC
.Title	CWRS - (C) Write 1/precis real number in S format
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	26-Jul-83	CVLLIB Routine
;Adjust CARG offsets
.Sbttl	V1	1-Apr-83	CVLLIB Routine

.Globl	cw$adj,wrs,csvr,carg

			.If eq 1
Called by
		CWRS(&strpnt,f,iwidth,idigits);

	where	f	is the floating-point number (single-precision)
		strpnt	points to string into which the number is assembled.
			(it is returned pointing to the next free byte).
		last	is increased by the number of bytes written
		iwidth	is the field width of the output field
	&	idigits	is the number of digits precision (after decimal)

The output will be in S (scientific or engineering) format - ie with
from 1 to 3 digits before the decimal point, and an exponent which
will be a multiple of 3.  Should the exponent be zero, 4 spaces will
be left to the right of the number (unless the field width be non-zero)
to allow columns of numbers to line up.
			.Endc

CWRS::
	call	csvr
	mov	carg+2(sp),r2
	mov	carg+4(sp),r3
	mov	carg+6(sp),r0
	mov	carg+10(sp),r4
	call	cw$adj
	.word	wrs
.end

CWRF.MAC
.Title	CWRF - (C) Write 1/precis real number in F format
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	26-Jul-83	CVLLIB Routine
;Adjust CARG offsets
.Sbttl	V1	1-Apr-83	CVLLIB Routine

.Globl	cw$adj,wrf,csvr,carg

			.If eq 1
Called by
		CWRF(&strpnt,f,iwidth,idigits);

	where	f	is the floating-point number (single-precision)
		strpnt	points to string into which the number is assembled.
			(it is returned pointing to the next free byte).
		last	is increased by the number of bytes written
		iwidth	is the field width of the output field
	&	idigits	is the number of digits precision (after decimal)

The output is in the form	-nnn.nnnnn
If the field width be zero, there will be no leading spaces, and trailing
zeroes will be trimmed off.
			.Endc

CWRF::
	call	csvr
	mov	carg+2(sp),r2
	mov	carg+4(sp),r3
	mov	carg+6(sp),r0
	mov	carg+10(sp),r4
	call	cw$adj
	.word	wrf
.end

CRRT.MAC
.Title	CRRT - (C) Read Real Number from Terminal
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	1-Apr-83	CVLLIB Routine

.Globl	rrt,cr$2t,csvr,carg

			.If eq 1
Called by
		i=crrt(&strpnt,&f)
where
		i	returns zero if OK, negative if overflow or underflow
		f	is the real number returned
&		strpnt	receives a pointer to the delimiting character.
			.Endc

CRRT::
	call	csvr
	call	cr$2t	;Common path for 2-word values read from terminal
	.word	rrt
.end

CRR.MAC
.Title	CRR - (C) Read Real Number
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	1-Apr-83	CVLLIB Routine

.Globl	rr,cr$2,csvr,carg

			.If eq 1
Called by
		i=crr(&strpnt,&f)
where
		i	returns zero if OK, negative if overflow or underflow
		f	is the real number returned
&		strpnt	receives a pointer to the delimiting character.
			.Endc

CRR::
	call	csvr
	call	cr$2		;Common path for 2-word values
	.word	rr
.end

LWRET.MAC
.Title	LWRET - (Fortran) Write 1/precis real number in E format to terminal
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	6-Feb-82	CVLLIB Routine

.Globl	wret

;Fortran Interface - CALL LWRET(f,iwidth,idigits)

; where		f	is the floating-point number (single-precision)
;		iwidth	is the field width of the output field
; &		idigits	is the number of digits precision (after decimal)

;The output is in the form	-.nnnnne-mm
;If the field width be zero, spare spaces in the exponent field will be
; squeezed out.

LWRET::
	mov	2(r5),r0
	mov	(r0)+,r2
	mov	(r0),r3
	mov	@4(r5),r0
	mov	@6(r5),r4
	jmp	wret
.end

LWRGT.MAC
.Title	LWRGT - (Fortran) Write real number in G format to terminal
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	6-Feb-82	CVLLIB Routine

.Globl	wrgt

;Fortran Interface - CALL LWRGT(f,iwidth,idigits)

; where		f	is the floating-point number (single-precision)
;		iwidth	is the field width of the output field
; &		idigits	is the number of digits precision (after decimal)

;The output will be in S (scientific or engineering) format if the number
; be >=1e6 or <1e-3, and in F format otherwise.  In F format, 4 spaces
; will be left to the right of the number (if the field width be non-zero)
; to allow columns of numbers to line up.

LWRGT::
	mov	2(r5),r0
	mov	(r0)+,r2
	mov	(r0),r3
	mov	@4(r5),r0
	mov	@6(r5),r4
	jmp	wrgt
.end

LWRST.MAC
.Title	LWRST - (Fortran) Write 1/precis real number in S format to terminal
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	6-Feb-82	CVLLIB Routine

.Globl	wrst

;Fortran Interface - CALL LWRST(f,iwidth,idigits)

; where		f	is the floating-point number (single-precision)
;		iwidth	is the field width of the output field
; &		idigits	is the number of digits precision (after decimal)

;The output will be in S (scientific or engineering) format - ie with
; from 1 to 3 digits before the decimal point, and an exponent which
; will be a multiple of 3.  Should the exponent be zero, 4 spaces will
; be left to the right of the number (unless the field width be non-zero)
; to allow columns of numbers to line up.

LWRST::
	mov	2(r5),r0
	mov	(r0)+,r2
	mov	(r0),r3
	mov	@4(r5),r0
	mov	@6(r5),r4
	jmp	wrst
.end

LWRFT.MAC
.Title	LWFRT - (Fortran) Write 1/precis real number in F format to terminal
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	6-Feb-82	CVLLIB Routine

.Globl	wrft

;Fortran Interface - CALL LWRFT(f,iwidth,idigits)

; where		f	is the floating-point number (single-precision)
;		iwidth	is the field width of the output field
; &		idigits	is the number of digits precision (after decimal)

;The output is in the form	-nnn.nnnnn
;If the field width be zero, there will be no leading spaces, and trailing
; zeroes will be trimmed off.

LWRFT::
	mov	2(r5),r0
	mov	(r0)+,r2
	mov	(r0),r3
	mov	@4(r5),r0
	mov	@6(r5),r4
	jmp	wrft
.end

LWRE.MAC
.Title	LWRE - (Fortran) Write 1/precis real number in E format
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	6-Feb-82	CVLLIB Routine

.Globl	lw$adj,wre

;Fortran Interface - CALL LWRE(f,string,last,iwidth,idigits)

; where		f	is the floating-point number (single-precision)
;		string	is the string into which the number is assembled.
;		last	is increased by the number of bytes written
;		iwidth	is the field width of the output field
; &		idigits	is the number of digits precision (after decimal)

;The output is in the form	-.nnnnne-mm
;If the field width be zero, spare spaces in the exponent field will be
; squeezed out.

LWRE::
	mov	2(r5),r0
	mov	(r0)+,r2	;Hi-order floating-point number
	mov	(r0),r3		;Lo-order	"
	mov	@10(r5),r0	;Field width
	mov	@12(r5),r4	;Number of digits after decimal point
	call	lw$adj
	.word	wre
.end

LWRG.MAC
.Title	LWRG - (Fortran) Write 1/precis real number in G format
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	6-Feb-82	CVLLIB Routine

.Globl	lw$adj,wrg

;Fortran Interface - CALL LWRG(f,string,last,iwidth,idigits)

; where		f	is the floating-point number (single-precision)
;		string	is the string into which the number is assembled.
;		last	is increased by the number of bytes written
;		iwidth	is the field width of the output field
; &		idigits	is the number of digits precision (after decimal)

;The output will be in S (scientific or engineering) format if the number
; be >=1e6 or <1e-3, and in F format otherwise.  In F format, 4 spaces
; will be left to the right of the number (if the field width be non-zero)
; to allow columns of numbers to line up.

LWRG::
	mov	2(r5),r0
	mov	(r0)+,r2	;Hi-ord floating point number
	mov	(r0),r3		;Lo-ord	"
	mov	@10(r5),r0	;Field width
	mov	@12(r5),r4	;Number of digits after decimal point
	call	lw$adj
	.word	wrg
.end

LWRS.MAC
.Title	LWRS - (Fortran) Write 1/precis real number in S format
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	6-Feb-82	CVLLIB Routine

.Globl	lw$adj,wrs

;Fortran Interface - CALL LWRS(f,string,last,iwidth,idigits)

; where		f	is the floating-point number (single-precision)
;		string	is the string into which the number is assembled.
;		last	is increased by the number of bytes written
;		iwidth	is the field width of the output field
; &		idigits	is the number of digits precision (after decimal)

;The output will be in S (scientific or engineering) format - ie with
; from 1 to 3 digits before the decimal point, and an exponent which
; will be a multiple of 3.  Should the exponent be zero, 4 spaces will
; be left to the right of the number (unless the field width be non-zero)
; to allow columns of numbers to line up.

LWRS::
	mov	2(r5),r0
	mov	(r0)+,r2	;Hi-ord floating point number
	mov	(r0),r3		;Lo-ord	"
	mov	@10(r5),r0	;Field width
	mov	@12(r5),r4	;Number of digits after decimal
	call	lw$adj
	.word	wrs
.end

LWRF.MAC
.Title	LWRF - (Fortran) Write 1/precis real number in F format
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	6-Feb-82	CVLLIB Routine

.Globl	lw$adj,wrf

;Fortran Interface - CALL LWRF(f,string,last,iwidth,idigits)

; where		f	is the floating-point number (single-precision)
;		string	is the string into which the number is assembled.
;		last	is increased by the number of bytes written
;		iwidth	is the field width of the output field
; &		idigits	is the number of digits precision (after decimal)

;The output is in the form	-nnn.nnnnn
;If the field width be zero, there will be no leading spaces, and trailing
; zeroes will be trimmed off.

LWRF::
	mov	2(r5),r0
	mov	(r0)+,r2	;Hi-ord floating point number
	mov	(r0),r3		;Lo-ord	"
	mov	@10(r5),r0	;Field width
	mov	@12(r5),r4	;Number of digits after decimal
	call	lw$adj
	.word	wrf
.end

LRRT.MAC
.Title	LRRT - (FORTRAN) Read Real Number from Terminal
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	8-Feb-82	CVLLIB Routine

.Globl	rrt,lr$2t

		.If eq 1
Called by
		I = LRRT(f,char)
where
		I	returns zero if OK, negative if overflow or underflow
		f	is the real number returned
&		char	returns the delimiting character
		.Endc

LRRT::
	call	rrt
	jmp	lr$2t	;Common path for 2-word values read from terminal
.end

LRR.MAC
.Title	LRR - (FORTRAN) Read Real Number
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	8-Feb-82	CVLLIB Routine

.Globl	rr,lr$2

		.If eq 1
Called by
		I = LRR(f,string,last)
where
		I	returns zero if OK, negative if overflow or underflow
		f	is the real number returned
		string	is the string from which the number is to be read
&		last	is increased by the number of bytes read.
		.Endc

LRR::
	call	lr$2		;Common path for 2-word values
	.word	rr
.end

WRET.MAC
.Title	WRET - Write single-precision real number in E format to terminal
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	6-Feb-82	CVLLIB Routine

.Globl	w$t,wre

		.If eq 1
Called by:
		Mov	<field width>,R0
		Mov	<hi-ord f/point #>,R2
		Mov	<lo-ord f/point #>,R3
		Mov	<# of digits after decimal point>,R4
		CALL	WRET

The output format is	.nnnnne-mm	to the user's terminal

If the field width be zero, trailing zeroes will be deleted.
		.Endc

WRET::
	call	w$t
	.word	wre
.end

WRGT.MAC
.Title	WRGT - Write 1/precis real number in G format to terminal
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	6-Feb-82	CVLLIB Routine

.Globl	w$t,wrg

		.If eq 1
Called by:
		Mov	<field width>,R0
		Mov	<hi-ord f/point #>,R2
		Mov	<lo-ord f/point #>,R3
		Mov	<# of digits after decimal point>,R4
		CALL	WRGT


The output will be to the user's terminal in S (scientific or engineering)
format if the number be >=1e6 or <1e-3, and in F format otherwise.  In F
format, 4 spaces will be left to the right of the number (if the field width
be non-zero) to allow columns of numbers to line up.
		.Endc

WRGT::
	call	w$t
	.word	wrg
.end

WRST.MAC
.Title	WRST - Write 1/precis real number in S format to terminal
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	6-Feb-82	CVLLIB Routine

.Globl	w$t,wrs
		.If eq 1
Write floating-point number in Scientific (Engineering) format to the user's
terminal.

	Called by:
		Mov	<field width>,R0
		Mov	<hi-ord f/point #>,R2
		Mov	<lo-ord f/point #>,R3
		Mov	<# of digits after decimal point>,R4
		CALL	WRST

If the field width be zero, trailing zeroes will be deleted.

The formats used attempt to get the exponent into powers of 3, and do not
print any exponent if it is zero.  (Prints as four spaces if a non-zero
field width is specified).

---------------------------------------------------------------------
FORMATS:
-------
			Exponents, mod 3:

0				1				2

nnn.m <exp>		   n.m <exp>			   nn.m <exp>

----------------------------------------------------------------------
		.Endc
WRST::
	call	w$t
	.word	wrs
.end

WRFT.MAC
.Title	WRFT - Write 1/precis real number in F format to terminal
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	6-Feb-82	CVLLIB Routine

.Globl	w$t,wrf

		.If eq 1
	Called by:
		Mov	<field width>,R0
		Mov	<hi-ord f/point #>,R2
		Mov	<lo-ord f/point #>,R3
		Mov	<# of digits after decimal point>,R4
		CALL	WRFT

Output is in the form		nnn.mmm		to the user's terminal

If the field width be zero, trailing zeroes will be deleted.
		.Endc
WRFT::
	call	w$t
	.word	wrf
.end

WRE.MAC
.Title	WRE - Write single-precision real number in E format
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	6-Feb-82	CVLLIB Routine

.Globl	wrsav,w$2p,r$rnd,r$set,r$dig,r$tz,wdp,.xr0

		.If eq 1
Called by:
		Mov	<field width>,R0
		Mov	#<string>,R1
		Mov	<hi-ord f/point #>,R2
		Mov	<lo-ord f/point #>,R3
		Mov	<# of digits after decimal point>,R4
		CALL	WRE

The output format is	.nnnnne-mm

If the field width be zero, trailing zeroes will be deleted.
		.Endc

WRE::
	call	w$2p		;Always use field width routine.
	.word	wre$


wre$:
	call	wrsav		;Saves ac's, puts leading "-", reduces
				; number to 0.1<=n<1.0, returns exponent
	mov	r0,-(sp)	; in R0.

	movb	#'.,(r1)+	;Initial decimal point

	call	r$rnd		;Round, using (r4) as index
	add	r0,(sp)		;Reset exponent if overflow
	
	call	r$set		;Reorganize number ready for extracting digits
40$:
	call	r$dig		;Return next digit in r0
	movb	r0,(r1)+
	dec	r4
	bgt	40$

	mov	#3,r2		;Field width for exponent
	tst	.xr0+2(sp)	;(unless total field width=0)
	bne	50$
	clr	r2
	call	r$tz		;Also trim trailing zeroes
50$:
	movb	#'e,(r1)+
	mov	(sp)+,r0	;Exponent
	jmp	wdp
.end

WRG.MAC
.Title	WRG - Write 1/precis real number in G format
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	6-Feb-82	CVLLIB Routine

.Globl	wrf,wrs,r$red

		.If eq 1
Called by:
		Mov	<field width>,R0
		Mov	#<string>,R1
		Mov	<hi-ord f/point #>,R2
		Mov	<lo-ord f/point #>,R3
		Mov	<# of digits after decimal point>,R4
		CALL	WRG


The output will be in S (scientific or engineering) format if the number
be >=1e6 or <1e-3, and in F format otherwise.  In F format, 4 spaces
will be left to the right of the number (if the field width be non-zero)
to allow columns of numbers to line up.
		.Endc

WRG::
	mov	r0,-(sp)	;Save field width for fiddling

	mov	r2,-(sp)
	mov	r3,-(sp)
	call	r$red		;Reduces number to 0.1<=n<1.0 (or zero), and
	mov	(sp)+,r3
	mov	(sp)+,r2

	cmp	r0,#6		; provides exponent in R0.
	bgt	20$
	cmp	r0,#-3
	ble	20$

	mov	(sp),r0		;Unless already using field width of zero,
	beq	10$
	sub	#4,r0		; shrink field width by 4 for F format
	bgt	10$		; but make sure don't get facilities
	mov	#1,r0		; other than deliberately.
10$:
	call	wrf		;If number within range, use F format
	tst	(sp)		; and follow with 4 spaces if width non-zero
	beq	30$
	mov	#' ,r0
	movb	r0,(r1)+	; so
	movb	r0,(r1)+	;   can
	movb	r0,(r1)+	;      line
	movb	r0,(r1)+	;	 columns.
	br	30$
20$:
	mov	(sp),r0		;Restore field width
	call	wrs		;Else use scientific.
30$:
	mov	(sp)+,r0
	return

.end

WRS.MAC
.Title	WRS - Write 1/precis real number in S format
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1A	26-Jul-83	CVLLIB Routine
;Bug fix where 0 printed as 0.e-3
.Sbttl	V1	6-Feb-82	CVLLIB Routine

.Globl	w$2p,wrsav,.xr0,r$rnd,r$tz,wr$$,wdp

;Write floating-point number in Scientific (Engineering) format

		.If eq 1
	Called by:
		Mov	<field width>,R0
		Mov	#<string>,R1
		Mov	<hi-ord f/point #>,R2
		Mov	<lo-ord f/point #>,R3
		Mov	<# of digits after decimal point>,R4
		CALL	WRS

If the field width be zero, trailing zeroes will be deleted.

The formats used attempt to get the exponent into powers of 3, and do not
print any exponent if it is zero.  (Prints as four spaces if a non-zero
field width is specified).

---------------------------------------------------------------------
FORMATS:
-------
			Exponents, mod 3:

0				1				2

nnn.m <exp>		   n.m <exp>			   nn.m <exp>

----------------------------------------------------------------------
		.Endc

WRS::
	call	w$2p		;Always use field width routine.
	.word	wrs$


wrs$:
	call	wrsav		;Saves ac's, provides leading "-",
	mov	r0,-(sp)	; reduces number to 0.1<=n<1.0 (or zero)
				; and returns exponent in r0.

	mov	r4,-(sp)
	clr	r4
	mov	r0,r5		;Set up exponent for division by 3
	bge	20$
	dec	r4		;(Negative left half prn)
20$:	div	#3,r4
	mov	(sp)+,r4

	tst	r5		;If remainder negative, add 3
	bge	30$
	add	#3,r5
30$:
	bne	40$


;Zero remainder - exponent multiple of 3
;	use nnn.m format

	mov	#3,r5

;Non-zero remainder.  Use n.nn or nn.n depending upon remainder.

40$:
	sub	r5,(sp)		;Reset exponent

	mov	r4,-(sp)
	add	r5,r4		;Get position for rounding
	call	r$rnd
	mov	(sp)+,r4
	add	r5,r0		;In case rounded up to 1.0

	cmp	r0,#4		;See if overflowed field
	bne	50$
	mov	#1,r0		;If so, reset to n.nnn
	add	#3,(sp)
50$:
	tst	r2		;If number zero, make exponent for wf$$ zero
	bne	60$
	clr	r0
	clr	(sp)		; and exponent for actual printing zero too.
60$:

;This is a horrible kludge for calling part of the floating-point F format
; output routine.  The stack must be set up as per a call to wrsav,
; missing the call parts on the top (ie only 1 return address, r0, and r2-r5)
; with garbage in the bits we don't need.  Exponent must be on top of stack.

	mov	#1,-(sp)	;Field width (in r0 position)
	sub	#10,sp		;r2,r3,r4,r5
	mov	#70$,-(sp)	;Return address
	mov	r0,-(sp)	;Exponent
	jmp	wr$$		;Print floating-point number
70$:
	add	#12,sp		;Clean stack (Exp & addr have gone)

	tst	.xr0+2(sp)	;Check field width.
	bne	80$		;If zero, trim trailing zeroes
	call	r$tz
80$:
	mov	(sp)+,r0	;If exponent zero, don't print it
	beq	100$

	movb	#'e,(r1)+
	mov	#3,r2		;Field width for exponent
	tst	.xr0(sp)	; but not if field width=0
	bne	90$
	clr	r2
90$:	call	wdp
	br	110$
100$:
	tst	.xr0(sp)	;Check field width
	beq	110$
	mov	#' ,r0
	movb	r0,(r1)+	;If exponent zero, and
	movb	r0,(r1)+	; non-zero field width,
	movb	r0,(r1)+	; put in 4 spaces
	movb	r0,(r1)+
110$:
	return
.end

WRF.MAC
.Title	WRF - Write 1/precis real number in F format
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	6-Feb-82	CVLLIB Routine

.Globl	w$2p,wrsav,.xr0,.xr4,r$rnd,r$set,r$dig,r$tz

		.If eq 1
	Called by:
		Mov	<field width>,R0
		Mov	#<string>,R1
		Mov	<hi-ord f/point #>,R2
		Mov	<lo-ord f/point #>,R3
		Mov	<# of digits after decimal point>,R4
		CALL	WRF

Output is in the form		nnn.mmm

If the field width be zero, trailing zeroes will be deleted.
		.Endc
WRF::
	call	w$2p		;Always use standard field width routine.
	.word	wrf$


wrf$:
	call	wrsav		;Saves ac's, provides leading "-",
				; reduces number to 0.1<=n<1.0 (or zero),
	mov	r0,-(sp)	; and provides exponent in r0.

	add	r0,r4		;For rounding, use item from rounding
	call	r$rnd		;table <# places after decimal> + exponent
	add	r0,(sp)		;Vary exponent if rounding took above 1.0

	mov	.xr4+2(sp),r4	;Restore digits after decimal count

;WR$$ - Entry point from WRS routine.  Note stack must be set up as per
;	wrsav

WR$$::
	mov	#'.,r5		;Decimal point for when needed
	call	r$set		;Set up number for digit extraction
10$:
	tst	(sp)		;Check exponent
	beq	20$
	blt	50$

;Positive exponent - keep sending numbers

	call	r$dig
	movb	r0,(r1)+
	dec	(sp)
	br	10$

;Zero exponent

20$:
	tst	r5
	beq	30$
	movb	r5,(r1)+	;Put in decimal point
30$:
	tst	r4		;Check for having finished # digits reqd.
40$:	ble	80$
	call	r$dig
	movb	r0,(r1)+
	dec	r4
	br	40$

;Negative Exponent

50$:
	tst	r5		;Put in decimal point if not already in
	beq	60$
	movb	r5,(r1)+
	clr	r5
60$:
	tst	r4
70$:	ble	80$
	movb	#'0,(r1)+	;Put in leading zeroes for .000<etc>000123
	inc	(sp)		;Increment exponent
	dec	r4		;Decrease count of digits after point
	br	10$

80$:
	tst	(sp)+		;Scrub exponent
	mov	.xr0(sp),r0	;Field width
	bne	90$

	call	r$tz		;If null field, trim trailing zeroes
90$:
	return
.end

RRT.MAC
.Title	RRT - Read Real Number from terminal
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	8-Feb-82	CVLLIB Routine

.Globl	rr,r$t

		.If eq 1
Called by
		Call	RRT
		R2/	hi-ord floating-point number
		R3/	lo-ord		"
		R1/	pointer to delimiter
		Returns with CS if overflow or underflow occurred.
		.Endc

RRT::
	call	r$t
	.word	rr
.end

RR.MAC
.Title	RR - Read Real Number
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	8-Feb-82	CVLLIB Routine

.Globl	r1d,flt2,rds,rsgn,f$mulf

		.If eq 1
Called by
		Mov	#<string>,R1
		Call	RR
		R2/	hi-ord floating-point number
		R3/	lo-ord		"
		R1/	pointer to delimiter
		Returns with CS if overflow or underflow occurred.
		.Endc

RR::
	mov	r5,-(sp)
	mov	r4,-(sp)
	mov	r0,-(sp)

	call	rsgn		;See if positive or negative
	mov	r0,-(sp)	; and hold result (0 pos, -1 neg)

	clr	r5		;Used as a flag: low-ord byte non-zero if
				; number other than leading zero found;
				; sign bit set if after decimal point.
	clr	r4		;Used for exponent
	mov	#9.,-(sp)	;Digit counter
	clr	r2		;Result
	clr	r3
10$:
	call	r1d		;Read a digit, returning its value in r0,
	bcc	30$		; and CS if not a digit.

;Non-digit

	cmpb	(r1),#'.	;Decimal point?
	bne	20$

;Decimal point

	tst	r5		;Not allowed two!
	bmi	90$
	inc	r1		;Skip it
	bis	#100000,r5	;Signify "." found.
	br	10$

;Check for "E", "e", "D", and "d"

20$:
	movb	(r1),r0
	bic	#40,r0		;Allow lower case
	cmpb	r0,#'E
	beq	80$
	cmpb	r0,#'D
	beq	80$
	br	90$		;Neither - must be terminator.

;Digit

30$:
	tst	r0		;Check for zero
	bne	40$

;Zero

	tstb	r5		;Number found yet?
	bne	50$		;Yes
	tst	r5		;After decimal point?
	beq	10$		;No - skip leading zeroes
	dec	r4		;Yes - decrement exponent
	br	10$

;Non-zero

40$:
	bisb	r0,r5		;Non-zero byte in r5 indicates number has
50$:				; started.
	tst	(sp)		;See if have filled quota of 9 digits
	ble	60$		;Yes - don't add this one in.

;Multiply result to date by 10. and add in this digit

	ashc	#1,r2		;*2
	mov	r2,-(sp)
	mov	r3,-(sp)
	ashc	#2,r2		;*8
	add	(sp)+,r3
	adc	r2
	add	(sp)+,r2	;*10.

	add	r0,r3
	adc	r2

	tst	r5		;See if we are after the decimal point.
	bpl	70$		;If so, decrement the accumulated exponent
	dec	r4		; if we have added this digit in.
	br	70$

60$:
	tst	r5		;If before the decimal point, increment the
	bmi	70$		; accumulated exponent only if we do not add
	inc	r4		; this digit in.
70$:
	dec	(sp)		;Adjust digit count
	br	10$
.Sbttl	End of Number

;Exponent

80$:
	inc	r1		;Exponent - skip letter,
	call	rds		; read number, and
	add	r0,r4		; add it to exponent.

;Unknown character - terminator

90$:
	call	flt2		;Float the number
	tst	(sp)+		;Scrub digit counter

	tst	r2		;Don't negate if zero
	beq	100$
	bic	#77777,(sp)
	bis	(sp),r2
100$:	tst	(sp)+		;Scrub sign value

	mov	#tabplu,r0	;Table of positive exponent multipliers
	tst	r4
	bpl	110$
	mov	#tabmin,r0	;Use reducing values if negative
	neg	r4
110$:
	cmp	#77,r4		;Check range of exponent values
	blo	160$		;Carry set if out of range
120$:
	asr	r4		;See what next bit has to show
	bcs	130$
	beq	150$		;Out of bits - go home
	br	140$		;More to go, but this one not set.
130$:
	call	f$mulf
	bcs	160$		;If overflow or underflow, quit
140$:
	cmp	(r0)+,(r0)+
	br	120$

150$:
	clc
160$:
	mov	(sp)+,r0
	mov	(sp)+,r4
	mov	(sp)+,r5
	return
.Sbttl	Tables for Floating-Point Exponent Setting

tabmin:
	.flt2	0.1
	.flt2	0.01
	.flt2	1e-4
	.flt2	1e-8
	.flt2	1e-16
	.flt2	1e-32

tabplu:
	.flt2	10.
	.flt2	100.
	.flt2	1e4
	.flt2	1e8
	.flt2	1e16
	.flt2	1e32

.end

CCMPR.MAC
.Title	CCMPR - (C) Compare 2-word reals
.Enabl	lc
.Nlist	bex,toc
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	26-Jul-83	CVLLIB Routine
;Adjust CARG offsets
.Sbttl	V1	1-Apr-83	CVLLIB Routine

			.If eq 1
Called by
		i=ccmpr(f1,f2);
returns
		-1 if f1 < f2
		 0 if f1 = f2
	and	 1 if f1 > f2

			.Endc

.Globl	cmpr,csvr,carg

CCMPR::
	call	csvr
	mov	carg+0(sp),r2
	mov	carg+2(sp),r3
	mov	sp,r0
	add	#carg+4,r0
	call	cmpr
	bgt	10$
	blt	20$
	clr	r0
	return
10$:
	mov	#1,r0
	return
20$:
	mov	#-1,r0
	return
.end

CFRAC.MAC
.Title	CFRAC - (C) Return fractional part of real number
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1A	26-Jul-83	CVLLIB Routine
;Correct CARG offsets
.Sbttl	V1	1-Apr-83	CVLLIB Routine

.Globl	frac,csvr,carg
		.If eq 1
Called by
		x=cfrac(real);

returns the fractional part of <real>
		.Endc

CFRAC::
	call	csvr
	mov	carg+0(sp),r2
	mov	carg+2(sp),r3
	call	frac
	mov	r2,r0
	mov	r3,r1
	return
.end

CINT1.MAC
.Title	CINT1 - (C) Convert real to single-precision integer
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1A	26-Jul-83	CVLLIB Routine
;Correct CARG offsets
.Sbttl	V1	1-Apr-83	CVLLIB Routine

.Globl	int1,lretc,csvr,carg
		.If eq 1
Called by
		i = cint1(real,&int);

returns in <int> a single-precision integer being the integral part of <real>.
<i> receives 0 if all was well, and is non-zero if the result could not be
contained within a single-precision integer.
		.Endc

CINT1::
	call	csvr
	mov	carg+0(sp),r2
	mov	carg+2(sp),r3
	call	int1
	mov	r0,@carg+4(sp)
	jmp	lretc		;Return r0=0 if CC, -1 if CS
.end

CINT2.MAC
.Title	CINT2 - (C) Convert real to double-precision integer
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1A	26-Jul-83	CVLLIB Routine
;Correct CARG offsets
.Sbttl	V1	1-Apr-83	CVLLIB Routine

.Globl	int2,lretc,csvr,carg
		.If eq 1
Called by
		i = cint2(real,&long);

returns in <long> a double-precision integer being the integral part
of <real>.  <i> receives 0 if all was well, and is non-zero if the
result could not be contained within a single-precision integer.
		.Endc

CINT2::
	call	csvr
	mov	carg+0(sp),r2
	mov	carg+2(sp),r3
	call	int2
	mov	carg+4(sp),r0
	mov	r2,(r0)+
	mov	r3,(r0)
	jmp	lretc		;Return r0=0 if CC, -1 if CS
.end

CINTC1.MAC
.Title	CINTC1 - (C) Convert real to single-precision integer truncated
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1A	26-Jul-83	CVLLIB Routine
;Correct CARG offsets
.Sbttl	V1	1-Apr-83	CVLLIB Routine

.Globl	intc1,lretc,csvr,carg
		.If eq 1
Called by
		i = cintc1(real,&int);

returns in <int> a single-precision integer being the integral part of <real>.
<i> receives 0 if all was well, and is non-zero if the result could not be
contained within a single-precision integer.

The result is chopped (truncated) rather than rounded.
		.Endc

CINTC1::
	call	csvr
	mov	carg+0(sp),r2
	mov	carg+2(sp),r3
	call	intc1
	mov	r0,@carg+4(sp)
	jmp	lretc		;Return r0=0 if CC, -1 if CS
.end

CINTC2.MAC
.Title	CINTC2 - (C) Convert real to double-precision integer truncated
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1A	26-Jul-83	CVLLIB Routine
;Correct CARG offsets
.Sbttl	V1	1-Apr-83	CVLLIB Routine

.Globl	intc2,lretc,csvr,carg
		.If eq 1
Called by
		i = cintc2(real,&long);

returns in <long> a double-precision integer being the integral part
of <real>.  <i> receives 0 if all was well, and is non-zero if the
result could not be contained within a single-precision integer.

The result is chopped (truncated) rather than rounded.
		.Endc

CINTC2::
	call	csvr
	mov	carg+0(sp),r2
	mov	carg+2(sp),r3
	call	intc2
	mov	carg+4(sp),r0
	mov	r2,(r0)+
	mov	r3,(r0)
	jmp	lretc		;Return r0=0 if CC, -1 if CS
.end

CFLT1.MAC
.Title	CFLT1 - (C) Convert single precision integer to real
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1A	26-Jul-83	CVLLIB Routine
;Correct CARG offsets
.Sbttl	V1	1-Apr-83	CVLLIB Routine

.Globl	flt1,csvr,carg
		.If eq 1
Called by
		x = cflt1(int);

returns the real equivalent of <int>, a single-precision integer.
		.Endc

CFLT1::
	call	csvr
	mov	carg+0(sp),r0
	call	flt1
	mov	r2,r0
	mov	r3,r1
	return
.end

CFLT2.MAC
.Title	CFLT2 - (C) Convert double precision integer to real
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1A	26-Jul-83	CVLLIB Routine
;Correct CARG offsets
.Sbttl	V1	1-Apr-83	CVLLIB Routine

.Globl	flt2,csvr,carg
		.If eq 1
Called by
		x = cflt2(long);

returns the real equivalent of <long>, a double-precision integer.

		.Endc

CFLT2::
	call	csvr
	mov	carg+0(sp),r2
	mov	carg+2(sp),r3
	call	flt2
	mov	r2,r0
	mov	r3,r1
	return
.end

LCMPR.MAC
.Title	LCMPR - (Fortran) Compare 2-word reals
.Enabl	lc
.Nlist	bex,toc
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	1-Apr-83	CVLLIB Routine

			.If eq 1
Called by
		i=lcmpr(f1,f2)
returns
		-1 if f1 < f2
		 0 if f1 = f2
	and	 1 if f1 > f2

			.Endc

.Globl	cmpr

LCMPR::
	mov	2(r5),r0
	mov	(r0)+,r2
	mov	(r0),r3

	mov	4(r5),r0
	call	cmpr
	bgt	10$
	blt	20$
	clr	r0
	return
10$:
	mov	#1,r0
	return
20$:
	mov	#-1,r0
	return
.end

RFRAC.MAC
.Title	RFRAC - (Fortran) Return fractional part of real number
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	7-Feb-82	CVLLIB Routine

.Globl	frac
		.If eq 1
Called by
		X=RFRAC(real)

returns the fractional part of <real>
		.Endc

RFRAC::
	mov	2(r5),r0
	mov	(r0)+,r2
	mov	(r0),r3
	call	frac
	mov	r2,r0
	mov	r3,r1
	return
.end

LINT1.MAC
.Title	LINT1 - (Fortran) Convert real to single-precision integer
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	7-Feb-82	CVLLIB Routine

.Globl	int1,lretc
		.If eq 1
Called by
		I = LINT1(real,int)

returns in <int> a single-precision integer being the integral part of <real>.
I receives 0 if all was well, and is non-zero if the result could not be
contained within a single-precision integer.
		.Endc

LINT1::
	mov	2(r5),r0
	mov	(r0)+,r2
	mov	(r0),r3
	call	int1
	mov	r0,@4(r5)
	jmp	lretc		;Return r0=0 if CC, -1 if CS
.end

LINTC1.MAC
.Title	LINTC1 - (Fortran) Convert real to single-precision integer truncated
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	7-Feb-82	CVLLIB Routine

.Globl	intc1,lretc
		.If eq 1
Called by
		I = LINTC1(real,int)

returns in <int> a single-precision integer being the integral part of <real>.
I receives 0 if all was well, and is non-zero if the result could not be
contained within a single-precision integer.

The result is chopped (truncated) rather than rounded.
		.Endc

LINTC1::
	mov	2(r5),r0
	mov	(r0)+,r2
	mov	(r0),r3
	call	intc1
	mov	r0,@4(r5)
	jmp	lretc		;Return r0=0 if CC, -1 if CS
.end

LINT2.MAC
.Title	LINT2 - (Fortran) Convert real to double-precision integer
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	7-Feb-82	CVLLIB Routine

.Globl	int2,lretc
		.If eq 1
Called by
		I = LINT2(real,2.int)

returns in <2.int> a double-precision integer being the integral part
of <real>.  <I> receives 0 if all was well, and is non-zero if the
result could not be contained within a single-precision integer.
		.Endc

LINT2::
	mov	2(r5),r0
	mov	(r0)+,r2
	mov	(r0),r3
	call	int2
	mov	4(r5),r0
	mov	r2,(r0)+
	mov	r3,(r0)
	jmp	lretc		;Return r0=0 if CC, -1 if CS
.end

LINTC2.MAC
.Title	LINTC2 - (Fortran) Convert real to double-precision integer truncated
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	7-Feb-82	CVLLIB Routine

.Globl	intc2,lretc
		.If eq 1
Called by
		I = LINTC2(real,2.int)

returns in <2.int> a double-precision integer being the integral part
of <real>.  <I> receives 0 if all was well, and is non-zero if the
result could not be contained within a single-precision integer.

The result is chopped (truncated) rather than rounded.
		.Endc

LINTC2::
	mov	2(r5),r0
	mov	(r0)+,r2
	mov	(r0),r3
	call	intc2
	mov	4(r5),r0
	mov	r2,(r0)+
	mov	r3,(r0)
	jmp	lretc		;Return r0=0 if CC, -1 if CS
.end

RFLT1.MAC
.Title	RFLT1 - (Fortran) Convert single precision integer to real
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V2	1-Apr-83	CVLLIB Routine
.Sbttl	V1	7-Feb-82	CVLLIB Routine

.Globl	flt1
		.If eq 1
Called by
		X = RFLT1(int)

returns the real equivalent of <int>, a single-precision integer.

[V2	1-Apr-83]
Bug fix
		.Endc

RFLT1::
	mov	@2(r5),r0
	call	flt1
	mov	r2,r0
	mov	r3,r1
	return
.end

RFLT2.MAC
.Title	RFLT2 - (Fortran) Convert double precision integer to real
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V2	1-Apr-83	CVLLIB Routine
.Sbttl	V1	7-Feb-82	CVLLIB Routine

.Globl	flt2
		.If eq 1
Called by
		X = RFLT2(2.int)

returns the real equivalent of <2.int>, a double-precision integer.

[V2	1-Apr-83]
Bug fix
		.Endc

RFLT2::
	mov	2(r5),r0
	mov	(r0)+,r2
	mov	(r0),r3
	call	flt2
	mov	r2,r0
	mov	r3,r1
	return
.end

FRAC.MAC
.Title	FRAC - Return fractional part of real
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	7-Feb-82	CVLLIB Routine

		.If eq 1
Returns fractional part of real number in R2,R3 as a real number in the
same registers.  A number with magnitude <1 will be returned unchanged.
		.Endc

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

	mov	r2,r0		;Extract exponent
	rol	r0
	swab	r0
	bic	#^c377,r0
	sub	#200,r0
	bgt	10$

	mov	(sp)+,r2	;Exponent indicates <1 - return unchanged
	br	50$
10$:
	ashc	r0,r2		;Shift integral portion out
	bic	#^c377,r2	;Clear out remains of exponent and integer

	mov	r2,-(sp)	;If zero, leave as zero
	bis	r3,(sp)+
	beq	40$

	mov	#40000,-(sp)	;Brand new exponent
20$:
	bit	#200,r2		;Check normalization bit
	bne	30$
	ashc	#1,r2
	sub	#200,(sp)
	br	20$
30$:
	bic	#200,r2		;Clear normalization bit
	bis	(sp)+,r2

	tst	(sp)		;Negate if originally negative
	bge	40$
	bis	#100000,r2
40$:
	tst	(sp)+
50$:	mov	(sp)+,r0
	return

.end

INT1.MAC
.Title	INT1 - Convert real to single-precision integer
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	7-Feb-82	CVLLIB Routine

		.If eq 1
Called with real number in R2,R3.  Returns with result in R0, and R2,R3
unchanged.  Returns zero if out of range, and carry set if the result
would be >32767.
		.Endc

INT1::
	mov	r2,-(sp)
	mov	r3,-(sp)

	mov	r2,r0		;Extract the exponent
	rol	r0
	swab	r0
	bic	#^c377,r0
	sub	#200,r0
	bge	10$

	clr	r0		;Underflow
	br	30$
10$:
	bic	#^c177,r2	;Remove exponent from real
	bis	#200,r2		;Set normalization bit
	sub	#30,r0		;Fixed point number, binary point at bit 30
	ashc	r0,r2
	bvs	50$
	adc	r3		;Round to next number above if last bit 1
	adc	r2
	bne	50$		;High order word must be zero
20$:
	mov	r3,r0
	bmi	50$		;Low order word must be positive
30$:
	mov	(sp)+,r3
	mov	(sp)+,r2
	bpl	40$
	neg	r0
40$:	clc
	return


50$:
	clr	r0		;Error return
	sec
	mov	(sp)+,r3
	mov	(sp)+,r2
	return

.end

INTC1.MAC
.Title	INTC1 - Convert real to single-precision integer (truncating)
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	7-Feb-82	CVLLIB Routine

		.If eq 1
Called with real number in R2,R3.  Returns with result in R0, and R2,R3
unchanged.  Returns zero if out of range, and carry set if the result
would be >32767.  The result is truncated rather than rounded
		.Endc

INTC1::
	mov	r2,-(sp)
	mov	r3,-(sp)

	mov	r2,r0		;Extract the exponent
	rol	r0
	swab	r0
	bic	#^c377,r0
	sub	#200,r0
	bgt	10$

	clr	r0		;Underflow
	br	30$
10$:
	bic	#^c177,r2	;Remove exponent from real
	bis	#200,r2		;Set normalization bit
	sub	#30,r0		;Fixed point number, binary point at bit 30
	ashc	r0,r2
	bvs	50$
20$:
	tst	r2		;High order word must be zero
	bne	50$
	mov	r3,r0
	bmi	50$		;Low order word must be positive
30$:
	mov	(sp)+,r3
	mov	(sp)+,r2
	bpl	40$
	neg	r0
40$:	clc
	return


50$:
	clr	r0		;Error return
	sec
	mov	(sp)+,r3
	mov	(sp)+,r2
	return

.end

INT2.MAC
.Title	INT2 - Convert real to 2/precis integer
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	7-Feb-82	CVLLIB Routine

		.If eq 1
Called with the real number in R2,R3 returns the converted number in
R2,R3.  Returns zero if out of range, and carry set if above number which
can be accomodated in double-precision integer.
		.Endc

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

	mov	r2,r0
	rol	r0		;Separate out the exponent
	swab	r0
	bic	#^c377,r0
	sub	#200,r0
	bge	10$

	tst	(sp)+		;If zero or less, return zero
	clr	r2
	clr	r3
	br	20$
10$:
	bic	#^c177,r2	;Clear exponent out of number
	bis	#200,r2		; and set normalization bit.
	sub	#30,r0		;Fixed-point number, binary point at bit 30
	ashc	r0,r2		;Shift till binary point at far right.
	bvs	30$

	adc	r3		;Round.
	adc	r2

	mov	r2,-(sp)	;If zero here, or negative, overflow
	bmi	40$
	bis	r3,(sp)+
	beq	30$

	tst	(sp)+
	bpl	20$
	neg	r2		;Negate result if originally negative
	neg	r3
	sbc	r2
20$:
	mov	(sp)+,r0	;Normal return
	clc
	return

30$:				;Out-of-range return
	tst	(sp)+
40$:
	tst	(sp)+
	clr	r2
	clr	r3
	sec
	return
.end

INTC2.MAC
.Title	INTC2 - Convert real to 2/precis integer (truncating)
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	7-Feb-82	CVLLIB Routine

		.If eq 1
Called with the real number in R2,R3 returns the converted number in
R2,R3.  Returns zero if out of range, and carry set if above number which
can be accomodated in double-precision integer.

The result is chopped (truncated) rather than rounded.
		.Endc

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

	mov	r2,r0
	rol	r0		;Separate out the exponent
	swab	r0
	bic	#^c377,r0
	sub	#200,r0
	bgt	10$

	tst	(sp)+		;If zero or less, return zero
	clr	r2
	clr	r3
	br	20$
10$:
	bic	#^c177,r2	;Clear exponent out of number
	bis	#200,r2		; and set normalization bit.
	sub	#30,r0		;Fixed-point number, binary point at bit 30
	ashc	r0,r2		;Shift till binary point at far right.
	bvs	30$		;Out of range

	mov	r2,-(sp)	;If zero here, or negative, overflow
	bmi	40$
	bis	r3,(sp)+
	beq	30$

	tst	(sp)+
	bpl	20$
	neg	r2		;Negate result if originally negative
	neg	r3
	sbc	r2
20$:
	mov	(sp)+,r0	;Normal return
	clc
	return

30$:				;Out-of-range return
	tst	(sp)+
40$:
	tst	(sp)+
	clr	r2
	clr	r3
	sec
	return
.end

FLT1.MAC
.Title	FLT1 - Convert single-precision integer to real
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	7-Feb-82	CVLLIB Routine

		.If eq 1
Converts single-precision integer in R0 into real number in R2,R3.
R0 is returned unchanged.
		.Endc

FLT1::
	clr	r2		;In case zero
	clr	r3

	mov	r0,-(sp)
	beq	30$
	mov	r0,-(sp)	;Save for setting sign
	bgt	10$
	neg	r0		;Work with positive number
	bic	#100000,r0
	bne	10$		;Allow for (-0).
	tst	(sp)+
	br	30$
10$:
	mov	r0,r3		;Put in as fixed point number
	clr	r0
20$:
	ashc	#1,r2
	dec	r0
	bit	#^c177,r2	;Shift until normalization bit set
	beq	20$

	bic	#200,r2
	add	#230,r0		;Excess, plus change in binary point position
	swab	r0
	rol	(sp)+		;Get sign bit from original number
	ror	r0
	bis	r0,r2
30$:
	mov	(sp)+,r0
	return
.end

FLT2.MAC
.Title	FLT2 - Convert 2/precis integer to real
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	7-Feb-82	CVLLIB Routine

		.If eq 1
Called with 2/precis integer in R2,R3 and returns real in the same registers.
		.Endc

FLT2::
	mov	r0,-(sp)

	mov	r2,-(sp)
	bis	r3,(sp)+
	beq	zero		;If zero, return zero

	mov	r2,-(sp)
	bpl	10$
	neg	r2		;Work with positive numbers
	neg	r3
	sbc	r2
	bvs	zero		;In case undefined variable (-0)
10$:
	mov	#30,r0		;Integer is fixed point number with point at
15$:				; bit 0.  Need to adjust to bit 30.
	bit	#^c377,r2	;See if bits above normalization bit set
	beq	30$		;No - may need to shift left.

;Need to shift right:

20$:
	ashc	#-1,r2
	inc	r0
	bit	#^c377,r2
	bne	20$
	adc	r3		;Round to next if last bit out set
	adc	r2
	br	15$

;Need to shift left

30$:
	bit	#^c177,r2	;Must shift until normalization bit set
	bne	40$
	ashc	#1,r2
	dec	r0
	br	30$

;Finished shifting.  Clear normalization bit and insert exponent

40$:
	bic	#200,r2
	add	#200,r0
	swab	r0
	rol	(sp)+		;Check sign bit on orig number
	ror	r0
	bis	r0,r2
	mov	(sp)+,r0
	return

;Zero result

zero:
	clr	r3
	tst	(sp)+
	return

.end

CFXXX.MAC
.Title	CFXXX - C single-precision floating point routines.
.Enabl	lc
.Nlist	bex,toc
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1A	26-Jul-83	CVLLIB Routine
;Correct CARG offsets, & bug fix
.Sbttl	V1	1-Apr-83	CVLLIB Routine

.globl	f$mulf,f$divf,f$addf,f$subf,csvr,carg

			.If eq 1
Contains the routines:

	multiplication		cfmul (f1,f2,&f3);	f3=f1*f2
	division		cfdiv (f1,f2,&f3);	f3=f1/f2
	addition		cfadd (f1,f2,&f3);	f3=f1+f2
	subtraction		cfsub (f1,f2,&f3);	f3=f1-f2

The value returned by these functions is zero if all went well, and
-1 if overflow or underflow occurred.
			.Endc

cfmul::
	call	csvr
	call	argset
	call	f$mulf
	br	result

cfdiv::
	call	csvr
	call	argset
	call	f$divf
	br	result

cfadd::
	call	csvr
	call	argset
	call	f$addf
	br	result

cfsub::
	call	csvr
	call	argset
	call	f$subf
	br	result



argset:
	mov	carg+0+2(sp),r2	;hi-ord dividend, multiplicand, subtrahend etc
	mov	carg+2+2(sp),r3	;lo-ord, ibid.
	mov	sp,r0
	add	#carg+4+2,r0	;pointer to divisor, multiplier, etc.
	return

result:
	mov	carg+10(sp),r0	;Address of result
	mov	r2,(r0)+
	mov	r3,(r0)
	return
.end

CMPR.MAC
.Title	CMPR - Compare real (2-precis) values
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	27-May-82	CVLLIB Routine

			.If eq 1
CMPR compares two real (2-precis floating point) numbers supplied in
R2,R3 and pointed to by R0 in the sense

		CMP	R2,(R0)

setting the flags as relevant taking into account the double precision
and sign bit plus magnitude storage format of these numbers.


	[There are problems with floating-point comparisons.
	Fortran gets around this by subtraction and testing
	the result - probably faster but suffering the problem
	of how to cope with floating-point underflow.
	This does however remove problems caused by very small
	differences.  I am undecided on the best way of
	coping with this, and any comments would be appreciated.]

			.Endc

clnv=cln!clv	;Instruction to clear both N and V flags.


CMPR::
	tst	(r0)		;Comparison sense must be reversed if both
	bpl	posnum		; numbers are negative.  If the signs
	tst	r2		; differ, there's no problem of course.
	bpl	posnum

;Both numbers are negative.  Reverse the sense of the comparison, and
; ignore the sign bit.

	cmp	(r0),r2
	bne	freset
	cmp	2(r0),r3
	br	freset

;At least one of the numbers is positive.  Compare more significant halves
; and if they are the same (both numbers positive) check the lower halves
; using magnitude (rather than signed value) for result.

posnum:
	cmp	r2,(r0)
	bne	ret
	cmp	r3,2(r0)


;Set the condition codes for comparison of magnitude quantities

freset:
	bhi	20$
	beq	10$

	sen			; lo implies lt, so set N
	clv
10$:
	return

20$:
	clnv			; hi implies gt, so clear N
ret:
	return
.end

WRSUBS.MAC
.Title	WRSUBS - Subroutines for aiding writing real numbers
.Enabl	lc
.Nlist	bex,toc
.Dsabl	gbl

.psect	cvllib

.Sbttl	V1	6-Feb-82	CVLLIB Routine

.Globl	f$addf,f$mulf,cmp2
.Globl	.xr0,.xr2,.xr3,.xr4,.xr5

.xr0=12		;WRSAV globals
.xr2=10
.xr3=6
.xr4=4
.xr5=2
		.If eq 1

This module contains the routines

R$RED		Reduce single-precision floating-point number in R2,R3
		to within the range 0.1<=n<1.0, or zero.  The exponent
		required for this adjustment is returned in R0, and
		the returned number in R2,R3 is positive.

R$SET		Reorganizes an adjusted floating-point number in R2,R3 in the
		range 0.1<=n<1.0 (or zero) into a form whereby it is
		simple to extract decimal digits from that number.


R$DIG		From a number in R2,R3 already processed by R$SET returns
		the next digit in R0 (not in ascii).

R$RND		Using an index (from 1 through 8) in R4, adds a rounding
		value <.5 * 10^-(r4)> to a floating-point number in R2,R3.
		If R4 contain a number greater than 8, no rounding is
		performed.

R$TZ		Deletes trailing zeroes from the string pointed to in R1.
		If a decimal point be encountered, a single zero following
		it will be left in situ.

WRSAV		This routine performs housekeeping and initialization for
		real number writing routines.  It:

			Saves r0, r2-r5
			Puts in a leading "-" to the output string if
				the number in R2,R3 be negative
			Calls R$RED, reducing the R2,R3 number to the
				range 0.1<=n<1.0 (or zero), returning
				the exponent adjustment in r0.

		Stack offsets (.xr%) are defined, allowing restoration of
		the registers in the manner

			mov	.xr0(sp),r0

		if the stack has not been altered on "return" from WRSAV.
			.Endc
.Sbttl	R$red - Reduce single-precision floating-point number

		.If eq 1
	Called by
		Mov	<hi-ord fp #>,R2
		Mov	<lo-ord fp #>,R3
		Call	r$red
		R0/	(Decimal) exponent for reduced number
		R2/	<hi-ord fp #> ... 0.1<=n<1, or n=0
		R3/	<lo-ord fp #>
		.Endc

;TABLES:

;First Comparison Table:

Fx1:
	.flt2	1.0
	.flt2	10.0
	.flt2	100.0
	.flt2	10000.0
	.flt2	1e8
	.flt2	1e16
	.flt2	1e32

;First Multiplier Table:

Fm1:
	.flt2	0.1
	.flt2	0.01
	.flt2	0.001
	.flt2	1e-5
	.flt2	1e-9
	.flt2	1e-17
	.flt2	1e-33

;Second Comparison Table:

Fx2:
	.flt2	0.1
	.flt2	0.01
	.flt2	1e-4
	.flt2	1e-8
	.flt2	1e-16
	.flt2	1e-32

;Second Multiplier Table:

Fm2:
	.flt2	10.
	.flt2	100.
	.flt2	10000.
	.flt2	1e8
	.flt2	1e16
	.flt2	1e32

;Interlaced exponent variation table (interlaced to keep
; table indices the same as comparison & multiplier tables)

If1:	1
If2:		-1
	2
		-2
	3
		-4
	5
		-8.
	9.
		-16.
	17.
		-32.
	33.
R$RED::
	bic	#100000,r2	;Remove sign
	bit	#^c177,r2	;See if zero (clean or dirty)
	bne	10$

	clr	r2		;Zero - just return a clean zero
	clr	r3
	clr	r0
	return
10$:
	mov	r1,-(sp)
	mov	r4,-(sp)
	clr	r4		;Use r4 for exponent
20$:
	cmp	r2,#40200	;Compare with 1.0 (adequate to compare high
	bge	30$		; order words only here)

	mov	#fx2,r0		;And with 0.1
	call	cmp2
	blt	60$

	mov	r4,r0		;Home when within range 0.1<=n<1.0
	mov	(sp)+,r4
	mov	(sp)+,r1
	return

;Loop for numbers greater than or equal to 1.0

30$:
	mov	#6*4,r1		;Up to 7 comparisons, 4 bytes per word
40$:
	mov	#fx1,r0
	add	r1,r0		;Next word in comparison table
	call	cmp2
	blt	50$

	mov	#fm1,r0		;Multiply by reducing factor
	add	r1,r0
	call	f$mulf

	add	if1(r1),r4	;Add in exponent of multiplier
50$:
	sub	#4,r1
	bge	40$
	br	20$

;Loop for numbers less than 0.1

60$:
	mov	#5*4,r1		;Up to 6 comparisons
70$:
	mov	#fx2,r0		;Comparison table
	add	r1,r0
	call	cmp2
	bge	80$

	mov	#fm2,r0
	add	r1,r0
	call	f$mulf

	add	if2(r1),r4
80$:
	sub	#4,r1
	bge	70$
	br	20$
.Sbttl	R$set - Set up R2,R3 so can easily extract next digit

r$set::
	mov	r0,-(sp)

	mov	r2,r0		;Convert adjusted floating point number
	beq	30$		; to exponent and fixed-point number
	bic	#^c177,r2
	bis	#200,r2		;Add in hidden normalization bit
10$:
	rol	r0		;Separate out exponent, and offset by 3
	swab	r0		; places for initial digit extraction
	sub	#200,r0
	movb	r0,r0		;(for machines without SXT)
	add	#3,r0
20$:
	beq	30$		;Shift until powers of two allow for first
	ashc	#1,r2		; digit already in place in left-hand byte
	dec	r0		; (if shift right first, can lose bits at
	br	20$		; right hand end)
30$:
	mov	r2,-(sp)	;Multiplication by 10. to extract first digit
	mov	r3,-(sp)	; As already have effectively multiplied by 8
	ashc	#-2,r2		; move right 2 and add in.
	add	(sp)+,r3
	adc	r2
	add	(sp)+,r2

	mov	(sp)+,r0
	return			;Ready for first digit on call to r$dig.
.Sbttl	R$dig - Return next digit from R2,R3

r$dig::
	mov	r2,-(sp)	;Next digit now in left-hand byte
	bic	#^c377,r2	;Clear out last one
	swab	(sp)
	add	#'0,(sp)

	ashc	#1,r2		;Multiply by 10. to set up next digit
	mov	r2,-(sp)
	mov	r3,-(sp)
	ashc	#2,r2
	add	(sp)+,r3
	adc	r2
	add	(sp)+,r2

	movb	(sp)+,r0
	return
.Sbttl	R$rnd - Round number in r2,r3 according to index in r4

r$rnd::
	mov	r4,-(sp)	;Save number of digits after decimal point
	clr	r0		;Return exponent variation

	dec	r4
	cmp	r4,#7		;Check range
	bhi	30$		;No rounding if out of range

	asl	r4		;Convert to index for ADJ table
	asl	r4
	tst	r2
	beq	20$		;If zero, don't add anything

	mov	#adj,r0
	add	r4,r0
	call	f$addf
20$:
	call	r$red		;Allow for possible overflow
30$:				; of number > 1.0
	mov	(sp)+,r4
	return

;Table of rounding adjustments:

Adj:
	.flt2	.05
	.flt2	.005
	.flt2	.0005
	.flt2	.00005
	.flt2	.000005
	.flt2	.0000005
	.flt2	.00000005
	.flt2	.000000005
.Sbttl	R$tz - delete trailing zeroes

r$tz::
	cmpb	-1(r1),#'0
	bne	30$
10$:
	cmpb	-(r1),#'0
	beq	10$

	cmpb	(r1),#'.	;If hit decimal point, leave one in.
	bne	20$
	inc	r1
20$:
	inc	r1
30$:
	return
WRSAV::
	mov	r0,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)
	mov	r4,-(sp)
	mov	r5,-(sp)

	tst	r2
	bge	10$
	movb	#'-,(r1)+
10$:
	call	r$red

	call	@12(sp)		;Call calling routine as subroutine

	mov	(sp)+,r5
	mov	(sp)+,r4
	mov	(sp)+,r3
	mov	(sp)+,r2
	mov	(sp)+,r0
	tst	(sp)+		;Scrub old calling address
	return
.end

FP.MAC
.Title	FP - Floating point routines for FIS and FPU machines
.Enabl	lc
.Nlist	bex,toc,sym
.Dsabl	gbl

.psect	cvllib

.Sbttl	V3A	19-Feb-86	CVLLIB Routine
;Bug fixes
.Sbttl	V3	20-Feb-82	CVLLIB Routine

.Mcall	.sfpa,.print,.ttyou,.gval

		.If eq 1
Routines are:
	FINSET		Set up so can trap for floating-point interrupts
	LINSET(n)	ibid, for FORTRAN, using <n> for F$MESG
			[These routines set up the appropriate routines
			for either FIS or FPU use.  One or other must
			be used before trying to do anything with floating
			point numbers.]

	F$MULF		Multiplication
	F$DIVF		Division
	F$ADDF		Addition
	F$SUBF		Subtraction

	M$MESG		Prints error message using the message pointed to in
			$MESG$ with location specified in R0

The trap routine is
	F$TRAP

Other globals available are:
	F$MESG		 0  if no message on fp trap;
			-1  if message from trap routine proper;
			 1 if message from F$...F routines (default).
	F$ERRF		After error contains code (same values as FPU FEC)
	F$SUB		Address of user subroutine to call on error if reqd.

These are single-precision routines, designed to allow program independence
of FIS and FPU machines.  The calling sequence is:

	mov	<hi-order arg1>,r2	;Dividend, subtrahend etc
	mov	<lo-order arg1>,r3
	mov	#<arg2>,r0		;Divisor, subtractor etc
	call	F$...F (whichever)
	bcs	<overflow, underflow error routine if required>
	r2/	hi-order result
	r3/	lo-order result

The sequence is <arg1><op><arg2> eg <arg1> <divided by> <arg2>

Floating-point exception trapping is handled in these routines.  An initial
call to FINSET is required to enable this, as the overhead of doing it on
every floating-point instruction seemed too great!

Error messages may be suppressed (see F$MESG), or may be printed from the
trap routine itself (in that case specifying the address of the instruction
which caused the trap) or from the F$...F routine, in which case the address
printed will be that of the call to F$...F.

On return, overflow is set if overflow, underflow, or divide-by-zero occurred.
		.Endc

fltvec=244		;Trap vector

b.c=1			;Status bits
b.v=2
b.z=4
b.n=10

config=300		;Configuration word in monitor
b.fpu=100		;Bit set in configuration word if FPU hardware


;Define FPU status bits for reference:

b.fer=100000		;Error has occurred if set
b.fid=40000		;Interrupt disable if set
b.fiuv=4000		;Interrupt if set on fetching -0
b.fiu=2000		;Interrupt if set on underflow
b.fiv=1000		;Interrupt if set on overflow
b.fic=400		;Interrupt if set on integer conversion error

b.fd=200		;Double precision floating point if set
b.fl=100		;Long integers if set
b.ft=40			;Truncate (chop) rather than round if set

b.fn=10			;Condition codes
b.fz=4
b.fv=2
b.fc=1
.Sbttl	Arithmetic Routines

;Common prefix code for Arithmetic Operations

fset:
	mov	r3,-(sp)	;Stack values for floating instructions
	mov	r2,-(sp)

$f1:	br	10$		;******************************

	stfps	-(sp)		;FPU - Make sure single precision, rounding
	bic	#b.ft!b.fd,(sp)	;FPU
	ldfps	(sp)+		;FPU
				;FPU
	ldf	(sp)+,r0	;FPU -Load first argument into floating ac
	jmp	@(sp)		;FPU
10$:
	mov	2(r0),-(sp)	;FIS - Stack second argument
	mov	(r0),-(sp)	;FIS
	jmp	@10(sp)		;FIS

;Arithmetic Routines Themselves:

F$MULF::
	call	fset
.f1:	br	10$	;Changed to NOP for FIS machines ****************
	fmul	sp	;FIS instructions
	br	fend
10$:
	mulf	(r0),r0	;FPU instructions
	br	fend

F$DIVF::
	call	fset
.f2:	br	10$		;******************************
	fdiv	sp
	br	fend
10$:
	divf	(r0),r0
	br	fend

F$ADDF::
	call	fset
.f3:	br	10$		;******************************
	fadd	sp
	br	fend
10$:
	addf	(r0),r0
	br	fend

F$SUBF::
	call	fset
.f4:	br	10$		;******************************
	fsub	sp
	br	fend
10$:
	subf	(r0),r0

;End of Arithmetic Operation

fend:
	bvs	fovl

$f2:	br	10$		;******************************
	stf	r0,-(sp)	;If FPU, stack FPU reg R0
10$:
	mov	(sp)+,r2
	mov	(sp)+,r3	;Reset returned value

	tst	(sp)+		;Scrub call to fset
	return			;Return with carry and overflow clear.
.Sbttl	Overflow routine

fovl:

$f3:	br	10$		;******************************
	stf	r0,-(sp)	;FPU - stack result
10$:
	mov	(sp)+,r2	;Unstack result
	mov	(sp)+,r3

	tst	f$mesg		;See if want error message from here
	ble	20$		;No.

	mov	r0,-(sp)	;Yes - set up address in r0
	mov	4(sp),r0
	cmp	-(r0),-(r0)	;Made address of call rather than return addr
	call	m$mesg
	mov	(sp)+,r0
20$:	
	tst	(sp)+		;Scrub fset call
	sec
	return
.Sbttl	Error Messages and Locations

mestab:	.word	10$,20$,30$,40$,50$,60$,70$,80$

10$:	.ascii	/error/<200>		;Undefined error
20$:	.ascii	/opcode error/<200>
30$:	.ascii	/divide-by-0/<200>
40$:	.ascii	/to integer conversion error/<200>
50$:	.ascii	/overflow/<200>
60$:	.ascii	/underflow/<200>
70$:	.ascii	/undefined variable/<200>
80$:	.ascii	/maintenance/<200>

fltmes:	.ascii	/?-Floating /<200>
frmmes:	.ascii	/ from location /<200>
nulmes:	.byte	0
	.even

f$mesg::1		; 0 no message; 1 message from f$...f routine; -1
			; message from trap routine.
f$errf::0		;Error flags in format of FPU FEC register (v.s.)

$mesg$::0		;Location for error message

f$addr::0		;FPU - Address of instruction which caused exception


f$sub::0		;Optional user subroutine
.Sbttl	Trap Routines and Locations

			.If eq 1
On entry to the trap routine, the stack is as follows:

		status on interrupt
		address for return from interrupt

		FPU - FEA register (exception address)
		FPU - FEC register (exception code)

		[r0 added by interrupt routine]
			.Endc
.Enabl	lsb

f$trap::

$f4:	br	10$		;******************************

	bis	#b.v,6(sp)	;FPU - make sure overflow set on return
	mov	(sp)+,f$errf	;FPU - set up exception code
	mov	(sp)+,f$addr	;FPU - set up exception address
	br	40$
10$:
	bit	#b.c,2(sp)	;FIS - Carry set?
	beq	20$		;FIS
	mov	#4,f$errf	;FIS - Divide-by-zero
	br	40$		;FIS
20$:				;FIS
	bit	#b.n,2(sp)	;FIS - N set?
	beq	30$		;FIS
	mov	#12,f$errf	;FIS - Underflow
	br	40$		;FIS
30$:				;FIS
	mov	#10,f$errf	;FIS - Overflow
40$:
	mov	#mestab,$mesg$	;Set up error message location
	add	f$errf,$mesg$
	mov	@$mesg$,$mesg$

	tst	f$sub		;See if user wanted own s/r
	beq	50$
	call	@f$sub
50$:
	mov	r0,-(sp)

	tst	f$mesg		;Want message from here?
	bge	70$		;No.

	mov	f$addr,r0	;Address in f$addr?
	bne	60$		;Yes - must have come from FPU trap
	mov	2(sp),r0
	tst	-(r0)		;Set up address of instruction
60$:
	call	m$mesg
70$:
	mov	#sblk,r0	;Reset trap details
	.sfpa

$f5:	br	80$		;******************************

	mov	(sp)+,r0	;FPU
	rti			;FPU

80$:
	mov	#7,r0		;FIS - Reset IMPURE CODE locations following
	bic	r0,x1		;FIS -   to allow for whatever register the FP
	bic	r0,x2		;FIS -   instruction utilized
	bic	r0,x3		;FIS
				;FIS
	mov	2(sp),r0	;FIS - Get the instruction
	mov	-(r0),r0	;FIS
	bic	#^c7,r0		;FIS - Trim to register section
	bis	r0,x1		;FIS - Put in destination field of
	bis	r0,x2		;FIS -   instructions.
	bis	r0,x3		;FIS
				;FIS
	cmp	r0,#6		;FIS - Extra instructions required if SP
	blo	90$		;FIS
				;FIS
	clr	14(sp)		;FIS - Clear returned value
	clr	12(sp)		;FIS
	mov	4(sp),10(sp)	;FIS - Re-order stack over second argument
	mov	2(sp),6(sp)	;FIS
	mov	(sp)+,r0	;FIS
	cmp	(sp)+,(sp)+	;FIS
	rti			;FIS
90$:				;FIS
	mov	(sp)+,r0	;FIS
x1:	add	#4,r0		;FIS - Reset argument pointer
x2:	clr	2(r0)		;FIS - Clear returned value
x3:	clr	(r0)		;FIS
	rti			;FIS

.Dsabl	lsb
.Sbttl	LINSET & FINSET - Set up to trap interrupts

;LINSET - called by FORTRAN 		CALL LINSET(n)
;		sets up interrupts a la finset, and inserts the value
;		of <n> in f$mesg.  This should be 0 for no error messages,
;		1 for using CVLLIB routines, and -1 for using FORTRAN

;FINSET - Sets up floating point exception (interrupt) trapping, and
;		adjusts locations in the code of these routines to set up
;		for either FIS or FPU instructions.  Thus FINSET or LINSET
;		must be called before trying to perform floating point
;		arithmetic with these routines.  Calling them to excess
;		does not matter.


linset::
	mov	@2(r5),f$mesg

finset::
	mov	r0,-(sp)
	mov	#sblk,r0
	.sfpa

	cmp	@#fltvec+2,#340	;See if have floating-point support
	beq	10$		;Have.

	mov	#f$trap,@#fltvec ;Haven't.  Set it up ourselves
	clr	@#fltvec+2
10$:
	mov	#gblk,r0	;Check machine configuration
	.gval
	bic	#^c<b.fpu>,r0	;See if have FPU or not
	bne	20$		;If not, assume FIS

	mov	#NOP,r0
	mov	r0,.f1		;FIS - Set up locations to NOP's as relevant
	mov	r0,.f2
	mov	r0,.f3
	mov	r0,.f4
	br	30$
20$:
	mov	#NOP,r0
	mov	r0,$f1		;FPU - Set up locations to NOP's as relevant
	mov	r0,$f2
	mov	r0,$f3
	mov	r0,$f4
	mov	r0,$f5
30$:
	mov	(sp)+,r0
	return

sblk:	.byte	0,30
	.word	f$trap

gblk:	.byte	0,34
	.word	CONFIG
.Sbttl	M$MESG - Print floating point exception message


m$mesg::
	mov	r0,-(sp)
	.print	#fltmes
	.print	$mesg$
	.print	#frmmes
	mov	(sp),r0

	mov	#6,-(sp)	;6 digits
	mov	r0,-(sp)	;Address
	clr	r0
	br	20$
10$:
	clr	r0
	rol	(sp)		;Shift out next digit
	rol	r0
	rol	(sp)
	rol	r0
20$:	rol	(sp)
	rol	r0
	add	#'0,r0
	.ttyou
	dec	2(sp)
	bgt	10$

	.print	#nulmes

	cmp	(sp)+,(sp)+	;Clean the stack
	mov	(sp)+,r0
	return
.end

