Google
 

Trailing-Edge - PDP-10 Archives - bb-h138f-bm - 7-sources/rmsflo.mac
There are 3 other files named rmsflo.mac in the archive. Click here to see a list.
TITLE RMSFLO - Floating point conversion routines for RMS
;++++
;
;	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1984, 1986.
;	ALL RIGHTS RESERVED.
;
;	THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED  AND
;	COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
;	THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS  SOFTWARE  OR
;	ANY  OTHER  COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
;	AVAILABLE TO ANY OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE
;	SOFTWARE IS HEREBY TRANSFERRED.
;
;	THE INFORMATION IN THIS SOFTWARE IS  SUBJECT  TO  CHANGE  WITHOUT
;	NOTICE  AND  SHOULD  NOT  BE CONSTRUED AS A COMMITMENT BY DIGITAL
;	EQUIPMENT CORPORATION.
;
;	DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF
;	ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
;
;
;
;   FUNCTIONAL DESCRIPTION
;
;	Floating-point conversion and output routines.
;	Stolen from FOROTS, partly via DATATRIEVE.
;
;   VERSION NUMBER
;	1
;
;----
TWOSEG
RELOC 400000

; Register symbols
AC0=0
AC1=1
AC2=2
AC3=3
AC4=4
AC5=5
AC6=6
AC7=7
AC10=10
AC11=11
P=17

XP==0
VREG==1
Q1==2
Q2==3
Q3==4
Q4==5
BXP==6
SIGN==7

P1==10
P2==11

DEFINE DEFLCL (A,N),<DEFINE A,<N(P)>>		; Define names for stack cells

DEFINE PARAMS(A),<..NPARAMS==0
		  IRP A,<..NPARAMS==..NPARAMS+1>
		  ..COUNT==0
		  IRP A,<DEFLCL(A,\<..COUNT-..NPARAMS-..NSAVED>)
		         ..COUNT==..COUNT+1>>

DEFINE SAVE(A),<IRP <A>,<PUSH P,A
		       ..NSAVED==..NSAVED+1>>

DEFINE RESTORE(A),<IRP <A>,<POP P,A
			  ..NSAVED==..NSAVED-1>>

DEFINE RET,<IFN <..NSAVED>,<PRINTX SAVE/RESTORE MISMATCH>
	    POPJ P,>
;
;	P C
;
;	Returns PC of caller so that similar errors signalled from
;	different places can be traced more easily.

PC::	MOVE AC0,0(P)		;Address of the caller + 1
	AND AC0,[37,,777777]	;30 bit Address + 1 only
	SUBI AC0,1		;30 bit Address
	POPJ P,			;Return
;
;	M A C C H F
;
;	Return PC flags, since BLISS won't allow MACHOP to build SFM correctly

MACCHF:: JRST 14,AC0		;Get the flags
	POPJ P,			;And return
;
;	C V T L D
;
;	Convert a double precision integer to a double precision
;	floating point number
;
;	This code was stolen from FORCNV.MAC, Fortran V7. 
;


	%HIMAX=^D255


CVTLD::	; Convert Long to Double
	; First arg:	Addr of Long Integer
	; Second arg:	Decimal Scale factor
	; Third arg:	Addr to return double float

	SAVE	<AC0,AC6,AC7,P1>	; Save Preserved ACs 
	PARAMS	<LONG,SCALE,DOUBLE> ; Name the arguments

	MOVE	Q3,LONG	; Address of double integer
	DMOVE	Q1,(Q3)	; Get the integer itself
	MOVE	XP,SCALE	; Decimal scale factor
	PUSHJ	P,CVTLX		; Do common part of conversion
	JUMPE	VREG,CVTXIT	; returns 1: success, 0: overflo, 3: underflo
	 PUSHJ	P,%FLDPR	; And make into Double floating
CVTXIT:
	MOVE	Q3,DOUBLE	; Get addr to store floating point number
	DMOVEM	Q1,(Q3)	; Store it

	RESTORE <P1,AC7,AC6,AC0> ; Restore preserved ACs	
	RET			; Return


CVTLG::	; Convert Long to G Floating
	; First arg:	Addr of Long Integer/Addr to return double float
	; Second arg:	Decimal Scale factor


	SAVE	<AC0,AC6,AC7,P1> ; Save Preserved ACs 
	PARAMS	<LONG,SCALE,DOUBLE> ; Name the arguments

	MOVE	Q3,LONG	; Address of double integer
	DMOVE	Q1,(Q3)	; Get the integer
	MOVE	XP,SCALE	; Decimal scale factor

	PUSHJ	P,CVTLX		; Do common part of conversion
	JUMPE	VREG,CVTXIT	; Get out if we already lost
	PUSHJ	P,%FLGPR	; And make into G-floating
	JRST	CVTXIT		; Store result, restore & return
	
	..NSAVED==0		; Common exit will restore things



CVTLX::		; Input:	Floating number in Q1,Q2 
		; 		Decimal Exponent in XP
		; Output:	Binary Fraction in Q1,Q2
		;		Binary Exponent in BXP

	SETZ	SIGN,		; Sign flag
	JUMPGE	Q1,NORM		; It was positive
	 SETO	SIGN,		; Set sign flag
	 DMOVN	Q1,Q1		; Get the absolute value
NORM:	MOVEI	BXP,106		;INIT BINARY EXPON FOR D.P. INTEGER
	JUMPN	Q1,NORM1	;XFER IF AT LEAST ONE 1 IN HIGH HALF
	EXCH	Q1,Q2		;HIGH HALF ZERO, MOVE LOW HALF TO HIGH,
				;AND CLEAR LOW HALF
	SUBI	BXP,^D35	;AND ADJUST EXPONENT FOR 35 SHIFTS
NORM1:	JUMPE	Q1,ZERO		;LEAVE IF BOTH WORDS ZERO
	MOVE	Q3,Q1		;COPY 1ST WORD
	JFFO	Q3,NORM2	;FIND 1ST BIT
NORM2:	ASHC	Q1,-1(Q4)	;NORMALIZE D.P. INTEGER WITH BIN POINT
				;BETWEEN BITS 0 AND 1 IN HIGH WORD
	SUBI	BXP,-1(Q4)	;AND ADJUST EXPON TO ALLOW FOR SHIFTING
	JUMPE	XP,ENDF6	;IF DECIMAL EXP=0, NO MUL BY 10 NEEDED
ENDF3:	CAILE	XP,%HIMAX	;WITHIN ABSOLUTE G-FLOAT BOUNDS?
	 JRST	EXPTB		;NO. TOO BIG
	CAMGE	XP,[-%HIMAX]
	 JRST	EXPTS		;NO. TOO SMALL
	MOVM	P1,XP		;GET MAGNITUDE OF DECIMAL EXPONENT
	CAILE	P1,%PTLEN	;BETWEEN 0 AND MAX. TABLE ENTRY?
	MOVEI	P1,%PTLEN	;NO, MAKE IT SO
	SKIPGE	XP		;AND RESTORE CORRECT SIGN
	 MOVNS	P1
	SUB	XP,P1		;LEAVE ANY EXCESS EXPONENT IN X
	MUL	Q2,%HITEN(P1)	;LO FRAC TIMES HI POWER OF TEN TO Q2,Q3
	MOVE	Q4,Q2		;GET HI PART OF PREVIOUS PRODUCT OUT OF WAY
	MOVE	Q2,Q1		;COPY HI PART OF FRACTION
	MOVE	Q3,%LOTEN(P1)	;GET LOW POWER OF TEN
	ADDI	Q3,1		;BIAS IT - IT IS TRUNCATED
	MUL	Q2,Q3		;HI FRAC TIMES LO POWER OF TEN
	TLO	Q4,(1B0)
	ADD	Q4,Q2		;SUM OF HI PARTS OF CROSS PRODUCTS TO AC Q4
	MUL	Q1,%HITEN(P1)	;HI FRACTION TIMES HI POWER OF TEN
	TLON	Q4,(1B0)	;DID CARRY OCCUR?  ALLOW FOR NEXT CARRY
	 ADDI	Q1,1		;CARRY FROM ADDING CROSS PRODUCTS
	ADD	Q2,Q4		;ADD CROSS PRODUCTS TO LO PART
				;  OF (HI FRAC TIMES HI POW TEN)
	TLZN	Q2,(1B0)
	 AOJA	Q1,ENDF5	;AND PROPOGATE A CARRY, IF ANY
ENDF5:	TLNE	Q1,(1B1)	;NORMALIZED? 1.0 > RESULT >= 0.25
	JRST	ENDF5A		;YES, RESULT >= 0.5
	ASHC	Q1,1		;NO, SHIFT LEFT ONE PLACE
	SUBI	BXP,1		;AND ADJUST EXPONENT
ENDF5A:	MOVE	P1,%EXP10(P1)	;GET BINARY EXPONENT
	ADD	BXP,P1		;ADJUST BINARY EXPONENT
	JUMPN	XP,ENDF3	;CONTINUE IF ANY MORE DEC EXP LEFT
ENDF6:	MOVEI	VREG,1		;NO OVERFLOW
	POPJ	P,

; Overflow has occured!
EXPTB:	MOVEI	VREG,0		; Signal an overflow
	POPJ	P,		; Return

; Underflow has occured
EXPTS:	MOVEI	VREG,3		; Signal an underflow
	SETZB	Q1,Q2		; Make it zero
ZERO:	SETZ	BXP,
	POPJ	P,
%FLDPR:	; Q1,Q2:	Double precision binary fraction
	; BXP:		Binary exponent
	; Returns Double float in Q1,Q2
	; 	  Success: AC1=1,  Overflow: AC1=0,  Underflow: AC1=3

	JUMPE	Q1,DPZERO	;IF ZERO, RETURN ZERO
	TLO	Q1,(1B0)		;START ROUNDING (ALLOW FOR OVERFLOW)
	TLO	Q2,(1B0)		;START ROUNDING (ALLOW FOR CARRYS)
	ADDI	Q2,200	 	;LOW WORD ROUNDING FOR PDP-6 OR KI10
	TLZN	Q2,(1B0)		;DID CARRY PROPOGATE TO SIGN?
	 ADDI	Q1,1		;YES, ADD CARRY INTO HIGH WORD
	TLZE	Q1,(1B0)		;CARRY PROPOGATE TO BIT 0?
	 JRST	DPRET		;NO
	ASHC	Q1,-1		;YES, RENORMALIZE TO RIGHT
	ADDI	BXP,1		;AND ADJUST BINARY EXPONENT
	TLO	Q1,(1B1)		;AND TURN ON HI FRACTION BIT
DPRET:	CAIL	BXP,200		;OUT OF RANGE
	 JRST	EXPTB
	CAMGE	BXP,[-200]
	 JRST	EXPTS		;YES. RETURN ZERO OR INFINITY
	ADDI	BXP,200		;ADD IN EXCESS 200
	ASHC	Q1,-8		;NO, LEAVE ROOM FOR EXPONENT
	DPB	BXP,[POINT 9,Q1,8] ;INSERT EXPONENT INTO HI WORD
CDRET:	SKIPGE	SIGN		;RESULT NEGATIVE?
	DMOVN	Q1,Q1	;YES. SO NEGATE RESULT
DPZERO:	MOVEI	AC1,1		; Return ok
	POPJ	P,		;RETURN TO USER


; G-Floating

%FLGPR:	; Q1,Q2:	Double precision binary fraction
	; BXP:		Binary exponent
	; Returns Gfloat in Q1,Q2
	; 	  Success: AC1=1,  Overflow: AC1=0,  Underflow: AC1=3

	JUMPE	Q1,DPZERO	;IF ZERO, RETURN ZERO
	TLO	Q1,(1B0)		;START ROUNDING (ALLOW FOR OVERFLOW)
	TLO	Q2,(1B0)		;START ROUNDING (ALLOW FOR CARRYS)
	ADDI	Q2,2000		;YES. DO SPECIAL ROUNDING
	TLZN	Q2,(1B0)		;DID CARRY PROPOGATE TO SIGN?
	 ADDI	Q1,1		;YES, ADD CARRY INTO HIGH WORD
	TLZE	Q1,(1B0)		;CARRY PROPOGATE TO BIT 0?
	 JRST	GPRET		;NO
	ASHC	Q1,-1		;YES, RENORMALIZE TO RIGHT
	ADDI	BXP,1		;AND ADJUST BINARY EXPONENT
	TLO	Q1,(1B1)		;AND TURN ON HI FRACTION BIT
GPRET:	CAIL	BXP,2000	;OUT OF RANGE?
	 JRST	EXPTB		;YES. TOO BIG
	CAMGE	BXP,[-2000]
	 JRST	EXPTS		;YES. TOO SMALL
	ADDI	BXP,2000		;ADD IN EXCESS 2000
	ASHC	Q1,-^D11		;SHIFT TO MAKE ROOM FOR EXP
	DPB	BXP,[POINT 12,Q1,11];DEPOSIT THE EXPONENT
	JRST	CDRET		;Negate result if we should, store it & return
;
;	C V T D L
;
;	Convert double precision floating number
;	to double precision integer.
;


; Convert Double to Long
; Scale factor returned in AC0 and XP
CVTDL::

	SAVE	<AC0,AC6,AC7,AC10,AC11>
	PARAMS	<DOUBLE,LONG>
	SETZ	SIGN,
	MOVE	Q3,DOUBLE	;GET VARIABLE ADDR
	DMOVE	Q1,(Q3)		;LOAD AC 0 WITH NUMBER
	TLZ	Q2,(1B0)	;ELIMINATE GARBAGE SIGN BIT
	JUMPGE	Q1,FLOUT1	;NUMBER NEGATIVE?
	 DMOVN	Q1,Q1		;YES. NEGATE IT
	 SETO	SIGN,
FLOUT1:	JUMPN	Q1,FLOU1A	;OK IF NON-ZERO
	JUMPE	Q2,FLOUT6	;ZERO IF BOTH ZERO

FLOU1A:	HLRZ	BXP,Q1		;EXTRACT EXPONENT
	LSH	BXP,-9
	HRREI	BXP,-200(BXP)	;EXTEND SIGN
	TLZ	Q1,777000	;GET RID OF HIGH EXP
	JRST	FLOCOM

..NSAVED==0		; Prevent multiple entry points from confusing macro

; Convert G-Floating to Long
; Scale Factor returned in AC0 and XP

CVTGL::
	SAVE	<AC0,AC6,AC7,AC10,AC11>
	PARAMS	<GFLOAT,LONG>

	SETZ	SIGN,
	MOVE	Q3,GFLOAT	;GET VARIABLE ADDR
	DMOVE	Q1,(Q3)		;LOAD AC 0 WITH NUMBER
	TLZ	Q2,(1B0)	;ELIMINATE GARBAGE SIGN BIT
	JUMPN	Q1,CVTGL1	;OK IF NON-ZERO
	  JUMPE	Q2,FLOUT6	;ZERO IF BOTH ZERO
CVTGL1:	JUMPGE	Q1,CVTGL2	;NUMBER NEGATIVE?
	  DMOVN	Q1,Q1		;YES. NEGATE IT
	  SETO	SIGN,
CVTGL2:	LDB	BXP,[POINT 12,Q1,11] ;GET EXPONENT
	HRREI	BXP,-2000(BXP)	;EXPONENT IS EXCESS 2000
	TLZ	Q1,777700	;CLEAR THE EXPONENT
	ASHC	Q1,3		;MAKE MANTISSA LOOK LIKE REAL
;THE INTENTION IN THE CODE FOLLOWING IS TO LEFT-JUSTIFY THE MANTISSA
;AFTER EXTRACTING THE BINARY EXPONENT, AND THEN TO "SCALE" THE NUMBER
;BY ONE OR MORE POWERS OF TEN SO THAT IT ENDS UP WITH VALUE LESS
;THAN 1.0 BUT GREATER THAN OR EQUAL TO 0.1, KEEPING TRACK OF THE
;POWERS OF TEN USED IN THE SCALING PROCESS. THESE POWERS OF TEN
;ARE ACCUMULATED INTO A DECIMAL EXPONENT, KEPT IN XP.

FLOCOM:
	SETZ	XP,		;CLEAR EXPONENT
;	CAMG	BXP,%PMEXP	;WITHIN NORMAL RANGE?
;	 CAMGE	BXP,%NMEXP
;	  PUSHJ	P,EEDEC		;NO. REDUCE EE NUMBER TO NORMAL RANGE
	MOVE	Q3,Q1		;GET THE HI FRACTION
	JFFO	Q3,FLOU2A	;GET HI BIT
	EXCH	Q1,Q2		;NONE. SWAP LO AND HI
	SUBI	BXP,^D35	;AND DECR BINARY EXPONENT
	MOVE	Q3,Q1		;GET NEW HI WORD
	JFFO	Q3,FLOU2A	;GET HI BIT
	JRST	FLOUT6		;NUMBER IS ZERO
FLOU2A:	ASHC	Q1,-1(Q4)	;NORMALIZE NUMBER
	SUBI	BXP,-^D9(Q4)	;AND ADJUST BINARY EXPONENT
				;8 MORE ADDED TO EXPONENT BECAUSE
				;IT WAS NORMALIZED ON BIT 9
FLOU2B:	MOVE	P1,BXP		;GET BINARY EXPONENT
	IMULI	P1,232		;DEC EXP=LOG10(2)*BIN EXP=.232(OCTAL)*BIN EXP
	ADDI	P1,400		;ROUND TO NEAREST INTEGER
	ASH	P1,-^D9		;GET RID OF 3 OCTAL FRACTION DIGITS
				;THE ABOVE WORKS FOR NEGATIVE EXPONENTS BECAUSE
				;THE ASH EFFECTIVELY ADDS -1000 FOR NEGATIVE
				;VALUES

;P1 HOLDS A FIRST TRIAL DECIMAL EXPONENT. IT MAY BE
;ONE (BUT NO MORE) TOO SMALL TO DIVIDE THE BINARY NUM
;BY TO GET THE RANGE 1.0 .GT. NUM .GE. 0.1

	MOVM	P2,P1		;GET MAGNITUDE OF *10 SCALER
	CAIGE	P2,%PTLEN	;IS THE POWER OF 10 TABLE LARGE ENOUGH
	JRST	FLOUT3		;YES
	SKIPL	P1		;NO, SCALE 1ST BY LARGEST ENTRY
	SKIPA	P1,[%PTLEN]	;GET ADR OF LARGEST POSITIVE POWER OF 10
	MOVNI	P1,%PTLEN	;GET ADR OF LARGEST NEG POWER OF 10
	PUSHJ	P,DPMUL		;SCALE BY LARGE POWER OF 10
	JRST	FLOU2B		;AND GO DO THE SECOND SCALING
FLOUT3:	MOVE	P2,%EXP10(P1)	;GET BIN EXP THAT MATCHES DEC EXP
	CAMLE	P2,BXP		;FRACTION .GT. POWER OF 10?
	JRST	FLOT4A		;YES
	CAME	P2,BXP
	AOJA	P1,FLOT4A	;NOT IN EXPONENT
	CAMGE	Q1,%HITEN(P1)	;
	JRST	FLOT4A		;YES, IN HIGH FRACTION
	CAMN	Q1,%HITEN(P1)
	CAML	Q2,%LOTEN(P1)
	ADDI	P1,1		;NO, IN FRACTION PART
FLOT4A:	PUSHJ	P,DPMUL		;SCALE BY POWER OF 10
	ASHC	Q1,(BXP)	;SCALE BY ANY REMAINING POWERS OF 2
	TLO	Q2,(1B0)	;PREVENT OVERFLOW
	ADDI	Q2,1		;ROUND IT UP SOME MORE
	TLZN	Q2,(1B0)	;CARRY INTO SIGN?
	  ADDI	Q1,1		;YES, PROPAGATE TO HIGH WORD
FLOUT6:	JUMPN	Q1,FLOU6A	;IS NUMBER ZERO?
	SETZ	SIGN,
	SETZ	XP,		;AND THE EXPONENT!

FLOU6A:	SUBI	XP,^D20

	DMUL	Q1,[25536,,165705 ; Multiply by 10**20
		     254304,,0]	;Convert fraction to integer
	SKIPGE	Q3		;Round?
	DADD	Q1,[0
		      1]
;	MOVE	Q3,LONG		;Get addr to store result
	MOVE	Q3,-6(P)	;Fancy macro above does not work right
	SKIPE	SIGN
	 DMOVNM	Q1,0(Q3)	;Store negative result
	SKIPN	SIGN
	 DMOVEM	Q1,0(Q3)	;Store positive result

	MOVE	VREG,XP		;Return Scale factor as value
	
	RESTORE <AC11,AC10,AC7,AC6,AC0>
	
	..NSAVED==0		; Common exit will restore things

	RET
		;SCALE DOUBLE FRACTION BY A POWER OF 10 - POWER IN P1
DPMUL:	JUMPE	P1,CPOPJ	;IF DEC EXP IS 0, RETURN
	ADD	XP,P1		;PUT DEC SCALE FACTOR INTO XP
	MOVN	P1,P1		;TAKE RECIPROCAL OF EXPONENT
	MOVE	P2,%EXP10(P1)	;GET CORRESPONDING BIN EXP
	ADD	BXP,P2		;ADD POWER EXP INTO FRAC EXP

	MOVE	Q3,%HITEN(P1) ;GET DOUBLE SCALING FACTOR
	MOVE	Q4,%LOTEN(P1)
	ADDI	Q4,1		;BIAS IT - IT IS TRUNCATED
	DMUL	Q1,Q3	;GET DP PRODUCT

	TLO	Q2,(1B0)	;PREPARE FOR CARRY
	TLNE	Q3,(1B1)	;ROUNDING BIT ON?
	 ADDI	Q2,1		;YES. ADD 1 TO LOW WORD

	TLZN	Q2,(1B0)	;OVERFLOW
	 ADDI	Q1,1		;YES
	TLNE	Q1,(1B1)	;NORMALIZED?
	 POPJ	P,		;YES
	ASHC	Q1,1		;NO, SHIFT LEFT ONE
	SUBI	BXP,1		;AND ADJUST EXPONENT
CPOPJ:	POPJ	P,		;RETURN
	;POWER OF TEN TABLE IN DOUBLE PRECISION
	;INTEGER FORMAT. EACH ENTRY CONSISTS OF TWO WORDS,
	;EACH WITH 35 BITS OF FRACTION (SIGNS ARE EXCLUDED).
	;THE BINARY POINT IS BETWEEN BITS 0 AND 1 OF THE
	;HI ORDER WORD. THE EXPONENT FOR THE 70 BIT
	;FRACTION IS STORED IN THE SHORT TABLE CALLED "EXPTEN".
	;FOLLOWING THE STANDARD TABLE IS ATHE EXTENDED EXPONENT
	;TABLE, WHICH IS A SPARSE POWER OF TEN TABLE RANGING FROM
	;10**21 TO 10**326, FOR USE IN ENCODING AND DECODING G-FLOATING
	;NUMBERS.

	;THE NUMBERS IN BOTH TABLES ARE TRUNCATED, THAT IS, NO
	;ROUNDING HAS BEEN DONE FROM THE (VIRTUAL) THIRD WORD OF
	;PRECISION. THUS, ON AVERAGE, THE TABLES ARE BIASED 1/2 BIT
	;DOWNWARDS.
DEFINE .TAB. (A)<
	NUMBER -246,357347511265,056017357445
	NUMBER -242,225520615661,074611525567
	NUMBER -237,273044761235,213754053125
	NUMBER -234,351656155504,356747065752
	NUMBER -230,222114704413,025260341562
	NUMBER -225,266540065515,332534432117
	NUMBER -222,344270103041,121263540543
	NUMBER -216,216563051724,322660234335
	NUMBER -213,262317664312,007434303425
	NUMBER -210,337003641374,211343364332
	NUMBER -204,213302304735,325716130610
	NUMBER -201,256162766125,113301556752
	NUMBER -176,331617563552,236162112545
	NUMBER -172,210071650242,242707256537
	NUMBER -167,252110222313,113471132267
	NUMBER -164,324532266776,036407360745
	NUMBER -160,204730362276,323044526457
	NUMBER -155,246116456756,207655654173
	NUMBER -152,317542172552,051631227231
	NUMBER -146,201635314542,132077636440
	NUMBER -143,242204577672,360517606150
	NUMBER -140,312645737651,254643547602
	NUMBER -135,375417327624,030014501542
	NUMBER -131,236351506674,217007711035
	NUMBER -126,306044030453,262611673245
	NUMBER -123,367455036566,237354252116
	NUMBER -117,232574123152,043523552261
	NUMBER -114,301333150004,254450504735
	NUMBER -111,361622002005,327562626124
	NUMBER -105,227073201203,246647575664
	NUMBER -102,274712041444,220421535242
	NUMBER -077,354074451755,264526064512
	NUMBER -073,223445672164,220725640716
	NUMBER -070,270357250621,265113211102
	NUMBER -065,346453122766,042336053323
	NUMBER -061,220072763671,325412633103
	NUMBER -056,264111560650,112715401724
	NUMBER -053,341134115022,135500702312
	NUMBER -047,214571460113,172410431376
	NUMBER -044,257727774136,131112537675
	NUMBER -041,333715773165,357335267655
	NUMBER -035,211340575011,265512262714
	NUMBER -032,253630734214,043034737477
	NUMBER -027,326577123257,053644127417
	NUMBER -023,206157364055,173306466551
	NUMBER -020,247613261070,332170204303
	NUMBER -015,321556135307,020626245364
	NUMBER -011,203044672274,152375747331
	NUMBER -006,243656050753,205075341217
	NUMBER -003,314631463146,146314631463
A:	NUMBER 001,200000000000,000000000000
	NUMBER 004,240000000000,000000000000
	NUMBER 007,310000000000,000000000000
	NUMBER 012,372000000000,000000000000
	NUMBER 016,234200000000,000000000000
	NUMBER 021,303240000000,000000000000
	NUMBER 024,364110000000,000000000000
	NUMBER 030,230455000000,000000000000
	NUMBER 033,276570200000,000000000000
	NUMBER 036,356326240000,000000000000
	NUMBER 042,225005744000,000000000000
	NUMBER 045,272207335000,000000000000
	NUMBER 050,350651224200,000000000000
	NUMBER 054,221411634520,000000000000
	NUMBER 057,265714203644,000000000000
	NUMBER 062,343277244615,000000000000
	NUMBER 066,216067446770,040000000000
	NUMBER 071,261505360566,050000000000
	NUMBER 074,336026654723,262000000000
	NUMBER 100,212616214044,117200000000
	NUMBER 103,255361657055,143040000000
	NUMBER 106,330656232670,273650000000
	NUMBER 112,207414740623,165311000000
	NUMBER 115,251320130770,122573200000
	NUMBER 120,323604157166,147332040000
	NUMBER 124,204262505412,000510224000
	NUMBER 127,245337226714,200632271000
	NUMBER 132,316627074477,241000747200
	NUMBER 136,201176345707,304500460420
	NUMBER 141,241436037271,265620574524
	NUMBER 144,311745447150,043164733651
	NUMBER 147,374336761002,054022122623
	NUMBER 153,235613266501,133413263574
	NUMBER 156,305156144221,262316140533
	NUMBER 161,366411575266,037001570661
	NUMBER 165,232046056261,323301053417
	NUMBER 170,300457471736,110161266322
	NUMBER 173,360573410325,332215544007
	NUMBER 177,226355145205,250330436404
	NUMBER 202,274050376447,022416546105
	NUMBER 205,353062476160,327122277527
	NUMBER 211,222737506706,206363367626
	NUMBER 214,267527430470,050060265574
	NUMBER 217,345455336606,062074343133
	NUMBER 223,217374313163,337245615771
	NUMBER 226,263273376020,327117161367
	NUMBER 231,340152275425,014743015665
	NUMBER 235,214102366355,050055710521
	NUMBER 240,257123064050,162071272645
	NUMBER 243,332747701062,216507551417
	NUMBER 247,210660730537,231114641751
	NUMBER 252,253035116667,177340012343
>
DEFINE NUMBER (A,B,C) <B>

TENTAB:	.TAB. %HITEN
DEFINE NUMBER (A,B,C) <C>

	.TAB. %LOTEN
%PTLEN==%HITEN-TENTAB	;CALCULATE NUMBER OF TABLE ENTRIES BEFORE "TENS"

DEFINE	NUMBER	(A,B,C) <A>

	.TAB. %EXP10
;
;	M A C B A D
;
;	Add two double precision integers, checking for overflow.
;	If no overflow return true, else return false.

MACBAD:: PUSHJ P,MACCLF		; Clear PC flags
	MOVE AC1,0(ARG)		; Address of first arg
	DMOVE AC3,0(AC1)	; First double integer
	MOVE AC1,1(ARG)		; Address of second arg
	DADD AC3,0(AC1)		; Add the second double integer
	PUSHJ P,MACCHF		; Get the PC flags
	TLNE AC0,400000		; Fixed overflow?
	JRST BADRET		; Return false
	MOVE AC1,2(ARG)		; Address of result
	DMOVEM AC3,0(AC1)	; Store the result
	MOVEI AC0,1		; No overflow means true
	POPJ P,

BADRET:	SETZ AC0,
	POPJ P,
;
;	M A C B S U
;
;	Subtract one double precision integer from another,
;	checking for overflow. If it overflowed, return false,
;	otherwise return true.

MACBSU:: PUSHJ P,MACCLF		; Clear PC flags
	MOVE AC1,0(ARG)		; Address of first arg
	DMOVE AC3,0(AC1)	; First double integer
	MOVE AC1,1(ARG)		; Address of second arg
	DSUB AC3,0(AC1)		; Sub the second double integer
	PUSHJ P,MACCHF		; Get the PC flags
	TLNE AC0,400000		; Fixed overflow?
	JRST BADRET		; Return false
	MOVE AC1,2(ARG)		; Address of result
	DMOVEM AC3,0(AC1)	; Store the result
	MOVEI AC0,1		; No overflow means true
	POPJ P,
;
;	M A C B M U
;
;	Multiply two integers together, checking for overflow.
;	If overflow occurs, return false, else return true.

MACBMU:: PUSHJ P,MACCLF		; Clear the PC flags
	MOVE AC1,0(ARG)		; Address of first arg
	DMOVE AC4,0(AC1)	; Get the first argument
	MOVE AC1,1(ARG)		; Address of second arg
	DMUL AC4,0(AC1)		; Multiply by the second arg
	SETZ AC1,		; Assume result is positive
	CAMLE AC1,AC7		; Is it?
	HRREI AC1,-1		; No
	CAMN AC1,AC4		; Overflow?
	CAME AC1,AC5		; Overflow?
	JRST BADRET		; Yes
	PUSHJ P,MACCHF		; Get PC flags
	TLNE AC0,400000		; Fixed overflow?
	JRST BADRET		; Yes
	MOVE AC1,2(ARG)		; Address of result
	DMOVEM AC6,0(AC1)	; Store result
	MOVEI AC0,1		; Return true
	POPJ P,

;
;	M A C B D I
;
;	Divide two double precision integers, checking for
;	overflow.

MACBDI:: PUSHJ P,MACCLF		; Clear the PC flags
	MOVE AC1,0(ARG)		; Address of first arg
	DMOVE AC5,0(AC1)	; Get numerator
	SETZ AC3,		; Assume positive
	CAMLE AC3,AC5		; Was it?
	SETO AC3,		; No
	MOVE AC4,AC3		; High order part of quadruple number
	MOVE AC1,1(ARG)		; Address of second arg
	DDIV AC3,0(AC1)		; Divide
	PUSHJ P,MACCHF		; Check for NO_DIVIDE
	TLNE AC0,40		; Error?
	JRST BADRET		; Yes
	MOVE AC1,2(ARG)		; Address of result
	DMOVEM AC3,0(AC1)	; Result
	MOVE AC1,3(ARG)		; Address of remainder
	DMOVEM AC5,0(AC1)	; Remainder
	MOVEI AC0,1		; Return true
	POPJ P,

;
;	M A C C L F
;
;	Clear the PC flags.

MACCLF:: SETZ AC0,		; Clear AC0
	POP P,AC1		; Return address
	JRST 5,AC0		; Return and clear flags

	END