Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/srtsrc/srtflt.mac
There are 8 other files named srtflt.mac in the archive. Click here to see a list.
; UPD ID= 57 on 2/14/83 at 9:15 AM by NIXON                             
TITLE	SRTFLT - FLOATING POINT KEY DECODING PART OF SORT/MERGE
SUBTTL	S.L. COVITZ/DMN			19-Oct-82

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) 1979, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH	SRTPRM
	XSEARCH			;SEARCH OTHER UNIVERSALS
IFN FTPRINT,<PRINTX [Entering SRTFLT.MAC]>

	.COPYRIGHT		;Put standard copyright statement in REL file
	SEGMENT	HPURE
SUBTTL	TABLE OF CONTENTS FOR SRTFLT



;                    Table of Contents for SRTFLT
;
;
;                             Section                             Page
;
;   1  FLOATING POINT KEY DECODING PART OF SORT/MERGE ...........   1
;   2  TABLE OF CONTENTS FOR SRTFLT .............................   2
;   3  DEFINITIONS ..............................................   3
;   4  ENTRY POINT ..............................................   4
;   5  TABLES ...................................................  13
SUBTTL	INTERNAL/EXTERNAL DEFINITIONS

;INTERNAL ROUTINES
INTERN	FLIRT

;DEFINED IN SORT
EXTERN	%ERMSG,%TOCTW,%TSTRG

;DEFINED IN SRTSTA
EXTERN	DIE

;DEFINED IN SRTCMD
EXTERN	.NMUL
SUBTTL	FLOATING POINT KEY DECODER

	SEGMENT	LPURE		;[C20]

;THE SYNTAX ANALYSIS FOR THE SINGLE AND DOUBLE PRECISION INPUT
;IS STATE TABLE DRIVEN. EACH NEW INPUT CHARACTER IS CONVERTED TO
;A CHARACTER TYPE AND COMBINED WITH THE OLD "STATE". THIS RESULT
;IS THEN LOOKED UP IN THE TABLE "NXTSTA" TO GET THE NEW STATE AND
;AN INDEX INTO THE "XCTTAB" TABLE TO DISPATCH FOR THE INPUT
;CHARACTER. THE STATE TABLE LOGIC AND THE DISPATCH ROUTINES BUILD
;THREE RESULTS: A DOUBLE PRECISION INTEGER(IN T1,T2) FOR THE FRACTIONAL
;PART OF THE RESULT, AN INTEGER(IN T5) FOR THE EXPONENT AFTER
;"D" OR "E", AND A COUNTER(IN "P5") TO KEEP TRACK OF THE DECIMAL POINT.
;WHEN A TERMINATING CHARACTER IS FOUND, THE DOUBLE PRECISION INTEGER
;IS NORMALIZED TO THE LEFT TO GIVE A DOUBLE PRECISION FRACTION.
;THE DECIMAL POINT POSITION(FROM "P5")OR THE IMPLIED DECIMAL POINT
;POSITION FROM THE FORMAT STATEMENT, THE "D" OR "E" EXPONENT, AND ANY
;SCALING FROM THE FORMAT STATEMENT ARE COMBINED INTO A DECIMAL
;EXPONENT. THIS DECIMAL EXPONENT IS USED AS AN INDEX INTO A POWER
;OF TEN TABLE (KEPT IN DOUBLE PRECISION INTEGER PLUS EXPONENT FORM
;SO INTERMEDIATE RESULTS WILL HAVE 8 MORE BITS OF PRECISION THAN
;FINAL RESULTS) TO MULTIPLY THE DOUBLE PRECISION FRACTION. THIS
;RESULT IS THEN ROUNDED TO GIVE A SINGLE PRECISION,
;PDP6/KI10 DOUBLE PRECISION RESULT.
;OVERFLOWS RETURN THE LARGEST POSSIBLE
;NUMBER (WITH CORRECT SIGN), WHILE UNDERFLOWS RETURN 0. NO ERROR
;MESSAGE IS GIVEN FOR  EITHER OVER OR UNDERFLOW.
;OLD ACCUMULATOR DEFINITIONS

;T0=T0			;FIELD WIDTH
;T1==T0+1		;RESULT RETURNED IN T0 OR T0 AND T1
;T2==T1+1		;T1,T2, AND T3 ARE USED AS A MULTIPLE PRECISION
;T3==T2+1		;  REGISTER FOR DOUBLE PRECISION OPERATIONS
;T4==T3+1		;EXTRA AC
T5==P1			;EXPONENT AFTER D OR E
;P2==P2			;BINARY EXPONENT OR STATES
;P3==P3			;TEMPORARY
;P4==P4			;TEMPORARY
P5==J			;COUNTS DIGITS AFTER POINT
P6==U			;SOURCE BYTE POINTER
P7==S			;SOURCE BYTE COUNT
;F==F			;FLAG AC
;L==L			;POINTS TO CALLING ARGUMENTS


;RIGHT HALF FLAGS IN AC "F"
DOTFL==1		;DOT SEEN
MINFR==2		;NEGATIVE FRACTION
MINEXP==4		;NEGATIVE EXPONENT
EXPFL==10		;EXPONENT SEEN IN DATA (MAY BE 0)
DPFLG==20		;VARIABLE IS DOUBLE PRECISION
EEFLG==40		;VARIABLE IS EXTENDED EXPONENT
UNSFLG==100		;[511] WAN'T UNSIGNED RESULT
BNFLG==200		;[511] TREAT BLANK AS NULL NOT ZERO (BN FORMAT)

LOCFLG==DOTFL+MINFR+MINEXP+EXPFL+DPFLG+EEFLG

;INPUT CHARACTER TYPES
NULTYP==1	;[511] NULL
DOTTYP==2	;DECIMAL POINT
DIGTYP==3	;DIGITS 0-9
SPCTYP==4	;SPACE OR TAB
EXPTYP==5	;D OR E
PLSTYP==6	;PLUS SIGN (+)
MINTYP==7	;MINUS SIGN (-)
		;ANYTHING ELSE IS TYPE 0
;	MOVEI	L,     [SOURCE BYTE POINTER
;			SOURCE BYTE COUNT
;			FIELD WIDTH (-1 INDICATES FREE FORMAT)
;			FIELD DECIMAL PLACES
;			FLAGS,,SCALING FACTOR
;			OBJECT BYTE POINTER (WORD ALIGNED ASSUMED)]
;	PUSHJ	P,FLIRT

FLIRT:				;INPUT
	PUSH	P,T5		;SAVE T5
	PUSH	P,P2		;SAVE P2-P7
	PUSH	P,P3
	PUSH	P,P4
	PUSH	P,P5
	PUSH	P,P6
	PUSH	P,P7
	PUSH	P,F		;SAVE F
	MOVE	P6,0(L)		;[OK] LOAD SOURCE BYTE POINTER INTO P6
	MOVE	P7,1(L)		;[OK] WITH ITS COUNT
	SETZB	F,P5		;CLEAR FLAGS IN F AND INIT "DIGITS AFTER POINT" COUNTER
	SKIPGE	T2,4(L)		;[511] IS IT DOUBLE PRECISION?
	TXO	F,DPFLG		;YES. SET FLAG
	TXNE	T2,KY%FUN	;[511] UNSIGNED RESULT WANTED?
	TXO	F,UNSFLG	;[511] YES, SET FLAG
	TXNE	T2,KY%FBN	;[511] BN FORMAT SPECIFIED?
	TXO	F,BNFLG		;[511] YES, COPY FLAG
	TXNE	T2,KY%FGF	;EXTENDED EXPONENT?
	TXO	F,EEFLG		;YES. SET FLAG
	MOVE	T0,2(L)		;[OK] GET THE FIELD WIDTH
	SETZB	T2,T3		;INIT D.P. FRACTION
	SETZB	P2,T5		;INIT STATE AND DECIMAL EXPONENT
	JUMPG	T0,GETCH1	;FIELD SPECIFIED
	SETO	T0,		;SET FREE FORMAT FLAG
	PUSHJ	P,%SKIP		;FREE FORMAT - SKIP SPACES
	  JRST	ENDF1		;COMMA OR EOL = NULL FIELD
	JRST	GETCH2		;PROCESS FIELD

GETNXT:
GETCHR:	JUMPE	T0,ENDF1	;END OF FIELD
	LSH	P2,-^D30	;MOVE STATE TO BITS 30-32
GETCH1:	PUSHJ	P,%IBYTE	;GET NEXT CHARACTER
GETCH2:	JUMPE	T1,GOTNUL	;[511] GO SET NULL FLAG FOR NULL
	CAIL	T1,"0"		;CHECK FOR NUMBER
	CAILE	T1,"9"
	JRST	CHRTYP		;NO, TRY OTHER
	SUBI	T1,"0"		;CONVERT TO NUMBER
GOT1:	IORI	P2,DIGTYP	;SET TYPE
GOTST:	LSHC	P2,-2		;DIVIDE BY NUMBER OF BYTES IN WORD
	HRRZ	P4,P2		;[C20] GET A INDEXABLE P2
	TLNE	P3,(1B0)	;TEST WHICH HALF
	SKIPA	P2,NXTSTA(P4)	;[C20] RIGHT HALF (BYTES 2 OR 3)
	HLRZ	P2,NXTSTA(P4)	;[C20] UNFORTUNATELY BYTES 0 OR 1
	TLNN	P3,(1B1)	;WHICH QUADRANT
	LSH	P2,-9		;BYTES 0 OR 2
	ANDI	P2,777		;LEAVE ONLY RIGHT MOST QUARTER
	ROT	P2,-3		;PUT DISPATCH ADDRESS IN BITS 32-35
				; AND NEW STATE IN BITS 0-2
	HRRZ	P4,P2		;[C20] DISPATCH OR EXECUTE
	XCT	XCTTAB(P4)	;[C20]   ..
	SOJA	T0,GETNXT	;RETURN FOR NEXT CHAR.

GOTNUL:	IORI	P2,NULTYP	;[511] FLAG GOT NULL
	JRST	GOTST		;[511] BACK FOR DISPATCH
XCTTAB:	JRST	ILLCH		; (00) ILLEGAL CHAR
	JRST	NULLIN		; (01) NULL [511]
	IORI	F,DOTFL		; (02) PERIOD
	JRST	DIG		; (03) DIGIT BEFORE POINT
	JRST	BLNKIN		; (04) BLANK OR TAB
	SOJA	T0,GETNXT	; (05) RETURN FOR NEXT CHAR.
	IORI	F,MINFR		; (06) NEGATIVE FRACTION
	IORI	F,MINEXP	; (07) NEGATIVE EXP
	SOJA	P5,DIG		; (10) DIGIT AFTER POINT
	JRST	DIGEXP		; (11) EXPONENT
	JRST	DELCK		; (12) DELIMITER TO BACK UP OVER

CHRTYP:	CAIN	T1,"+"		;CONVERT INPUT CHARS TO CHARACTER TYPE
	IORI	P2,PLSTYP
	CAIN	T1,"-"
	IORI	P2,MINTYP
	CAIE	T1," "		;SPACE
	CAIN	T1,"	"	;TAB
	IORI	P2,SPCTYP
	CAIN	T1,"."		;DECIMAL POINT?
	IORI	P2,DOTTYP
	CAIE	T1,"D"
	CAIN	T1,"E"
	JRST	GOTEXP
	CAIE	T1,"d"		;LOWER CASE D?
	CAIN	T1,"e"		;LOWER CASE E?
	JRST	GOTEXP		;YES
	JRST	GOTST		;[511] NO

GOTEXP:	IORI	P2,EXPTYP	;SET STATUS FOR EXPONENT
	JRST	GOTST		;GO DISPATCH ON OLD STATE AND CHAR TYPE
DIG:	JUMPN	T2,DPDIG	;NEED D.P. YET?
	CAMLE	T3,MAGIC	;NO, WILL MUL AND ADD CAUSE OVERFLOW?
	JRST	DPDIG		;MAYBE, SO DO IT IN DOUBLE PRECISION
	IMULI	T3,12		;NO, MULTIPLY BY 10 SINGLE PRECISION
	ADD	T3,T1		;ADD DIGIT INTO NUMBER
	SOJA	T0,GETNXT	;GO GET NEXT CHARACTER

DPDIG:	CAMLE	T2,MAGIC	;WILL MULTIPLY AND ADD CAUSE OVERFLOW?
	AOJA	P5,DIGRET	;YES
	IMULI	T2,12		;MULTIPLY HIGH D.P. FRACTION BY 10
	MULI	T3,12		;MULTIPLY LOW D.P. FRACTION BY 10
	ADD	T2,T3		;ADD HI PART OF LO PRODUCT INTO RESULT
	MOVE	T3,T4		;GET LO PART OF LO PRODUCT
	TLO	T3,(1B0)	;STOP OVERFLOW IF CARRY INTO HI WORD
	ADD	T3,T1		;ADD DIGIT INTO FRACTION
	TLZN	T3,(1B0)	;SKIP IF NO CARRY INTO HI WORD
	ADDI	T2,1		;PROPOGATE CARRY INTO HI WORD
DIGRET:	SOJA	T0,GETNXT	;DECREMENT FIELD WIDTH AND GET NEXT CHAR

MAGIC:	<377777777777-9>/^D10	;LARGEST NUM PRIOR TO MULTIPLY AND ADD

DIGEXP:	IORI	F,EXPFL		;SET FLAG TO SAY WE'VE SEEN EXPONENT
	IMULI	T5,12		;MULTIPLY BY TEN
	ADD	T5,T1		;ADD IN NEXT DIGIT
	SOJA	T0,GETNXT	;DECREMENT FIELD WIDTH AND GET NEXT CHAR

;	 ? ,CR , . ,0-9,   ,D E, + , - ,
NXTSTA:	BYTE (9)
	000,010,022,031,050,000,051,061,
	000,011,022,031,041,053,054,074,
	000,012,120,102,042,053,054,074,
	000,013,120,114,043,000,054,074,
	000,014,120,114,044,000,120,120
	
ILLCH:
DELCK:	CAME	T0,[-1]		;FIRST ILLEGAL CHAR IN FREE FORMAT
	JUMPL	T0,ENDF		;NO - DELIMITER OF FREE FORMAT
	$ERROR	(%,IFC,<Illegal floating point character found.>)	;[511]
	JRST	ERROR1		;THROW AWAY REST AND RESULT=0

;[511] NULL IS A LEGAL CHARACTER, TREATED AS IF IT WERE A BLANK WITH
;[511]  BLANK='NULL' SPECIFIED.
NULLIN:	JUMPL	T0,ENDF		;[511] DONE IF FREE FORMAT
	SOJA	T0,GETNXT	;[511] OTHERWISE JUST SKIP IT

;[511] THE STATE IS NOT DISTURBED BY BLANKS, THUS IF BZ IS ON (BLANK=ZERO)
;[511] WE CAN MIMIC THE CODE AT GETNXT (MOVING THE STATE TO BITS 30-32) AND
;[511] JUMP TO THE PLACE WHERE A DIGIT WOULD HAVE GONE.
BLNKIN:	SETZ	T1,		;SET TO NULL CHAR
	JUMPL	T0,ENDF		;FREE FORMAT
	TXNE	F,BNFLG		;[511] BN (BLANK='NULL') FORMAT ON?
	SOJA	T0,GETNXT	;[511] YES, SKIP THE SPACE
	LSH	P2,-^D30	;[511] NO, DEFAULT TO BLANK='ZERO'
	JRST	GOT1		;[511] PUT STATE IN BITS 30-32 AND USE IT

ERROR1:	JUMPLE	P7,ZERO0	;GIVE BACK ZERO WHEN NO MORE CHARS
	PUSHJ	P,%IBYTE	;THROW AWAY CHAR
	JRST	ERROR1
ADDCNT:
ENDF:
ENDF1:	DMOVE	T0,T2		;MOVE 2-WORD RESULT TO BOTTOM AC'S
	TXNE	F,DOTFL		;HAS DECIMAL POINT BEEN INPUT?
	JRST	ENDF2		;YES
	MOVE	T3,3(L)		;[OK] NO, GET DIGITS AFTER POINT FROM FORMAT
	SUB	P5,T3		;  AND MODIFY DECIMAL EXPONENT
ENDF2:	HRRE	T3,4(L)		;[OK] GET SCALE FACTOR
	TXNN	F,EXPFL		;EXPONENT IN DATA?
	SUB	P5,T3		;NO, ADD INTO EXPONENT
	TXNE	F,MINEXP	;WAS D OR E EXPONENT NEGATIVE?
	MOVNS	T5		;YES, SO NEGATE IT
	ADD	P5,T5		;ADD EXPONENT FROM D OR E
NORM:	MOVEI	P2,106		;INIT BINARY EXPON FOR D.P. INTEGER
	JUMPN	T0,NORM1	;XFER IF AT LEAST ONE 1 IN HIGH HALF
	EXCH	T0,T1		;HIGH HALF ZERO, MOVE LOW HALF TO HIGH,
				;AND CLEAR LOW HALF
	SUBI	P2,^D35		;AND ADJUST EXPONENT FOR 35 SHIFTS
NORM1:	JUMPE	T0,ZERO0	;LEAVE IF BOTH WORDS ZERO
	MOVE	T3,T0		;COPY 1ST WORD
	JFFO	T3,NORM2	;JUST IN CASE
	JRST	ZERO0		;EE CLEARS OUT EVERYTHING
NORM2:	ASHC	T0,-1(T4)	;[OK] NORMALIZE D.P. INTEGER WITH BIN POINT
				;BETWEEN BITS 0 AND 1 IN HIGH WORD
	SUBI	P2,-1(T4)	;[OK] AND ADJUST EXPON TO ALLOW FOR SHIFTING
	JUMPE	P5,ENDF6	;IF DECIMAL EXP=0, NO MUL BY 10 NEEDED
ENDF3:	MOVM	T3,P5		;GET MAG OF DEC EXP
	CAILE	T3,%HIMAX	;LESS THAN MAX TABLE ENTRY?
	JRST	BADXP2		;NO. MUCH TOO BIG!
IFN FTKL10,<
	PUSHJ	P,EETST		;GO TEST FOR BIG SCALING
>
	MOVM	T3,P5		;GET MAGNITUDE OF DECIMAL EXPONENT
	CAILE	T3,%PTLEN	;BETWEEN 0 AND MAX. TABLE ENTRY?
	MOVEI	T3,%PTLEN	;NO, MAKE IT SO
	SKIPGE	P5		;AND RESTORE CORRECT SIGN
	MOVNS	T3
	SUB	P5,T3		;LEAVE ANY EXCESS EXPONENT IN P5
DPMUL:	MUL	T1,%HITEN(T3)	;[OK] LO FRAC TIMES HI POWER OF TEN(RESULT IN T1,T2)
	MOVE	T4,T1		;GET HI PART OF PREVIOUS PRODUCT OUT OF WAY
	MOVE	T1,T0		;COPY HI PART OF FRACTION
	MUL	T1,%LOTEN(T3)	;[OK] HI FRAC TIMES LO POWER OF TEN
	TLO	T4,(1B0)
	ADD	T4,T1		;SUM OF HI PARTS OF CROSS PRODUCTS TO AC T
	MUL	T0,%HITEN(T3)	;[OK] HI FRACTION TIMES HI POWER OF TEN
	TLON	T4,(1B0)	;DID CARRY OCCUR?  ALLOW FOR NEXT CARRY
	ADDI	T0,1		;CARRY FROM ADDING CROSS PRODUCTS
	ADD	T1,T4		;ADD CROSS PRODUCTS TO LO PART
				;  OF (HI FRAC TIMES HI POW TEN)
	TLZN	T1,(1B0)
	AOJA	T0,ENDF5	;AND PROPOGATE A CARRY, IF ANY
ENDF5:	TLNE	T0,(1B1)	;NORMALIZED? 1.0 > RESULT >= 0.25
	JRST	ENDF5A		;YES, RESULT >= 0.5
	ASHC	T0,1		;NO, SHIFT LEFT ONE PLACE
	SUBI	P2,1		;AND ADJUST EXPONENT
ENDF5A:	MOVE	T3,%EXP10(T3)	;[OK] GET BINARY EXPONENT
	ADD	P2,T3		;ADJUST BINARY EXPONENT
	JUMPN	P5,ENDF3	;CONTINUE IF ANY MORE DEC EXP LEFT
ENDF6:	TLO	T0,(1B0)	;START ROUNDING (ALLOW FOR OVERFLOW)
	TXNE	F,DPFLG		;DOUBLE PRECISION?
	JRST	DPRND		;TO DPRND
SPRND:	ADDI	T0,200		;NO, ROUND IN HIGH WORD
	TRZ	T0,377		;GET RID OF USELESS (UNUSED) BITS
	MOVEI	T1,0		; DITTO
ENDF7:	TLZE	T0,(1B0)	;CARRY PROPOGATE TO BIT 0?
	JRST	ENDF7A		;NO
	ASHC	T0,-1		;YES, RENORMALIZE TO RIGHT
	ADDI	P2,1		;AND ADJUST BINARY EXPONENT
	TLO	T0,(1B1)	;AND TURN ON HI FRACTION BIT
ENDF7A:	TXNE	F,EEFLG		;EXTENDED EXPONENT?
	JRST	EERET		;YES. RETURN DIFFERENT FORMAT
	CAIGE	P2,200		;OUT OF RANGE
	CAMGE	P2,[-200]
	JRST	BADEXP		;YES. RETURN ZERO OR INFINITY
	ADDI	P2,200		;ADD IN EXCESS 200
	ASHC	T0,-8		;NO, LEAVE ROOM FOR EXPONENT
	DPB	P2,[POINT 9,T0,8] ;INSERT EXPONENT INTO HI WORD
RETFLT:	TXNE	F,UNSFLG	;[511] WANT UNSIGNED RESULT?
	JRST	RETFL1		;[511] YES, IGNORE SIGN TEST
	TXNE	F,MINFR		;RESULT NEGATIVE?
	DMOVN	T0,T0		;YES. SO NEGATE RESULT
RETFL1:	MOVE	T3,5(L)		;[511] [C20] GET VARIABLE BYTE POINTER
	IDPB	T0,T3		;[C20] STORE IN USER AREA
	TXNE	F,DPFLG		;DOUBLE PRECISION?
	IDPB	T1,T3		;[C20] YES, STORE LOW ALSO
	POP	P,F		;RESTORE F
	POP	P,P7		;RESTORE P2-P7
	POP	P,P6
	POP	P,P5
	POP	P,P4
	POP	P,P3
	POP	P,P2
	POP	P,T5		;RESTORE T5
	POPJ	P,		;RETURN TO USER

EERET:	CAIGE	P2,2000		;OUT OF RANGE?
	CAMGE	P2,[-2000]
	JRST	BADEXP		;YES. RETURN ZERO OR INFINITY
	ADDI	P2,2000		;ADD IN EXCESS 2000
	ASHC	T0,-^D11	;SHIFT TO MAKE ROOM FOR EXP
	DPB	P2,[POINT 12,T0,11] ;DEPOSIT THE EXPONENT
	JRST	RETFLT

BADEXP:	HRLOI	T0,377777	;SET NUMBER TO LARGEST POSSIBLE
	HRLOI	T1,377777 	;FOR PDP-6 OR KI10
	JUMPG	P2,RETFLT	;DONE IF EXPONENT .GT. ZERO
ZERO0:	SETZB	T0,T1		;IF NEGATIVE, SET TO ZERO
	JRST	RETFLT

BADXP2:	JUMPL	P5,ZERO0		;RETURN ZERO IF DEC EXP NEGATIVE
	HRLOI	T0,377777		;GET LARGEST FRACTION
	HRLOI	T1,377777
	JRST	RETFLT
IFN FTKL10,<
;IF RUNNING ON A KL10, WE CAN USE THE SPARSE POWER OF TEN TABLE TO SCALE THE NUMBER.
;IT IS ABSOLUTELY NECESSARY FOR EXTENDED EXPONENT NUMBERS.
EETST:	MOVM	P3,P5		;GET MAGNITUDE OF DECIMAL EXPONENT
	CAIG	P3,%PTLEN	;WITHIN NORMAL RANGE?
	POPJ	P,		;YES. JUST DO IT NORMALLY
	ASHC	T0,-1		;PREVENT DIVIDE CHECK
	ADDI	P2,1		;AND MODIFY BINARY EXPONENT
	ASH	P3,1		;CALCULATE FACTOR OF TEN TO USE
	IDIVI	P3,^D21		;IN SPARSE TABLE
	SUBI	P3,2		;STARTS WITH 10**21
	IMULI	P3,3		;AND EACH ENTRY IS 3 LOCS
	JUMPL	P5,EENEG	;GO DO DIVIDE IF EXP NEGATIVE
	PUSHJ	P,%EEMUL	;OR MULTIPLY IF POSITIVE
	SUB	P5,T5		;[C20] REDUCE THE DECIMAL EXP
	ADD	P2,P4		;[C20] AND ADD THE BINARY EXP FOUND
	POPJ	P,

EENEG:	PUSHJ	P,%EEDIV	;DO D.P. DIVIDE
	ADD	P5,T5		;[C20] REDUCE MAGNITUDE OF P5
	SUB	P2,P4		;[C20] MODIFY BINARY EXPONENT
	POPJ	P,

%EEDIV:	SETZB	T2,T3		;CLEAR LOWER AC'S
	SETZB	T4,T5		;AND EVEN LOWER AC'S
	DDIV	T0,%BEXP(P3)	;[OK] GET 2-WORD RESULT
	DDIV	T2,%BEXP(P3)	;[OK] GET 4-WORD RESULT
	JRST	EECOM		;JOIN COMMON CODE

%EEMUL:	DMUL	T0,%BEXP(P3)	;[OK] GET 4-WORD RESULT
EECOM:	PUSHJ	P,%EENRM	;NORMALIZE IT
	TLO	T0,(1B0)	;PREPARE FOR OVERFLOW
	TLNE	T2,(1B1)	;ROUNDING BIT ON?
	DADD	T0,[EXP 0,1]	;YES. ROUND UP
	TLZ	T1,(1B0)	;TURN OFF LOW SIGN
	TLZE	T0,(1B0)	;DID WE OVERFLOW?
	JRST	EEOK		;NO
	TLO	T0,(1B1)	;YES. TURN HIGH BIT ON
	ADDI	P2,1		;AND INCR THE BINARY EXP
EEOK:	HLRZ	P4,%DEXP(P3)	;[OK] GET THE BINARY EXPONENT
	HRRZ	T5,%DEXP(P3)	;[OK] GET DECIMAL EXPONENT
	POPJ	P,

%EENRM:	MOVE	T4,T0		;GET THE HIGH WORD
	JFFO	T4,EENZ		;LOOK FOR 1ST 1
	DMOVE	T0,T1		;SHOVE THE NUMBER OVER
	SUBI	P2,^D35		;AND MODIFY THE EXPONENT
	MOVE	T4,T0		;TRY NEXT WORD
	JFFO	T4,EENZ
	JRST	EENEND		;STILL NONE

EENZ:	SOJE	T5,EENEND	;LEAVE STARTING AT BIT 1, DONE IF NO SHIFT
	SUB	P2,T5		;MODIFY THE BINARY EXPONENT
	MOVN	T4,T5		;AND GET NEG SHIFT ALSO
	JUMPL	T5,RGTSFT	;DIFFERENT FOR RIGHT SHIFT
	ASHC	T0,(T5)		;[OK] MOVE 1ST AND 2ND WORDS
	ASH	T1,(T4)		;[OK] MOVE BACK 2ND WORD
	ASHC	T1,(T5)		;[OK] MOVE 2ND AND 3RD WORD
EENEND:	POPJ	P,

RGTSFT:	ASHC	T1,(T5)		;[OK] MOVE 2ND AND 3RD
	ASH	T1,(T4)		;[OK] MOVE 2ND BACK
	ASHC	T0,(T5)		;[OK] MOVE 1ST AND 2ND
	POPJ	P,
>;END FTKL10
;HERE FOR DOUBLE PRECISION ROUNDING 

DPRND:	TLO	T1,(1B0)	;START ROUNDING (ALLOW FOR CARRYS)
	TXNE	F,EEFLG		;EXTENDED EXPONENT?
	ADDI	T1,2000		;YES. DO SPECIAL ROUNDING
	TXNN	F,EEFLG		;CHECK AGAIN
	ADDI	T1,200	 	;LOW WORD ROUNDING FOR PDP-6 OR KI10
	TLZN	T1,(1B0)	;DID CARRY PROPOGATE TO SIGN?
	AOJA	T0,ENDF7	;YES, ADD CARRY INTO HIGH WORD
	JRST	ENDF7		;AND GO RENORMALIZE IF NECESSARY
;HERE TO EAT LEADING SPACES AND TABS

%SKIP:	PUSHJ	P,%IBYTE	;GET A CHAR
	CAIE	T1," "		;BLANK
	CAIN	T1,"	"	;OR TAB
	JRST	SKIP0		;YES SKIP
	CAIE	T1,","		;COMMA
	AOS	(P)
CPOPJ:	POPJ	P,

SKIP0:	JUMPG	P7,%SKIP	;CONTINUE
	POPJ	P,		;FINISHED, NON SKIP RETURN

;HERE FOR A BYTE

%IBYTE:	JUMPLE	P7,[SETZ T1,		;IF OUT OF BYTES?
		POPJ	P,]		;JUST RETURN A <NULL>
	ILDB	T1,P6		;OTHERWISE GET NEXT BYTE
	SOJA	P7,CPOPJ	;REMEMBER THIS
	;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 (EXCESS 200) FOR THE 70 BIT
	;FRACTION IS STORED IN THE SHORT TABLE CALLED "EXPTEN".
DEFINE .TAB. (A)<
	NUMBER 732-1000,357347511265,056017357445	;D-50
	NUMBER 736-1000,225520615661,074611525567
	NUMBER 741-1000,273044761235,213754053126
	NUMBER 744-1000,351656155504,356747065753
	NUMBER 750-1000,222114704413,025260341563
	NUMBER 753-1000,266540065515,332534432117
	NUMBER 756-1000,344270103041,121263540542
	NUMBER 762-1000,216563051724,322660234336
	NUMBER 765-1000,262317664312,007434303426
	NUMBER 770-1000,337003641374,211343364333
	NUMBER 774-1000,213302304735,325716130611	;D-40
	NUMBER 777-1000,256162766125,113301556754
	NUMBER 002,331617563552,236162112546	;D-38
	NUMBER 006,210071650242,242707256537
	NUMBER 011,252110222313,113471132270
	NUMBER 014,324532266776,036407360744
	NUMBER 020,204730362276,323044526460
	NUMBER 023,246116456756,207655654173
	NUMBER 026,317542172552,051631227232
	NUMBER 032,201635314542,132077636440
	NUMBER 035,242204577672,360517606150	;D-30
	NUMBER 040,312645737651,254643547601
	NUMBER 043,375417327624,030014501541
	NUMBER 047,236351506674,217007711035
	NUMBER 052,306044030453,262611673245
	NUMBER 055,367455036566,237354252117
	NUMBER 061,232574123152,043523552261
	NUMBER 064,301333150004,254450504735
	NUMBER 067,361622002005,327562626124
	NUMBER 073,227073201203,246647575664
	NUMBER 076,274712041444,220421535242	;D-20
	NUMBER 101,354074451755,264526064512
	NUMBER 105,223445672164,220725640716
	NUMBER 110,270357250621,265113211102
	NUMBER 113,346453122766,042336053323
	NUMBER 117,220072763671,325412633104
	NUMBER 122,264111560650,112715401725
	NUMBER 125,341134115022,135500702312
	NUMBER 131,214571460113,172410431376
	NUMBER 134,257727774136,131112537676
	NUMBER 137,333715773165,357335267655	;D-10
	NUMBER 143,211340575011,265512262714
	NUMBER 146,253630734214,043034737477
	NUMBER 151,326577123257,053644127417
	NUMBER 155,206157364055,173306466552
	NUMBER 160,247613261070,332170204304
	NUMBER 163,321556135307,020626245365
	NUMBER 167,203044672274,152375747331
	NUMBER 172,243656050753,205075341217
	NUMBER 175,314631463146,146314631463	;D-01
A:	NUMBER 201,200000000000,0	;D00
	NUMBER 204,240000000000,0
	NUMBER 207,310000000000,0
	NUMBER 212,372000000000,0
	NUMBER 216,234200000000,0
	NUMBER 221,303240000000,0
	NUMBER 224,364110000000,0
	NUMBER 230,230455000000,0
	NUMBER 233,276570200000,0
	NUMBER 236,356326240000,0
	NUMBER 242,225005744000,0	;D+10
	NUMBER 245,272207335000,0
	NUMBER 250,350651224200,0
	NUMBER 254,221411634520,0
	NUMBER 257,265714203644,0
	NUMBER 262,343277244615,0
	NUMBER 266,216067446770,040000000000
	NUMBER 271,261505360566,050000000000
	NUMBER 274,336026654723,262000000000
	NUMBER 300,212616214044,117200000000
	NUMBER 303,255361657055,143040000000	;D+20
	NUMBER 306,330656232670,273650000000
	NUMBER 312,207414740623,165311000000
	NUMBER 315,251320130770,122573200000
	NUMBER 320,323604157166,147332040000
	NUMBER 324,204262505412,000510224000
	NUMBER 327,245337226714,200632271000
	NUMBER 332,316627074477,241000747200
	NUMBER 336,201176345707,304500460420
	NUMBER 341,241436037271,265620574524
	NUMBER 344,311745447150,043164733651	;D+30
	NUMBER 347,374336761002,054022122623
	NUMBER 353,235613266501,133413263574
	NUMBER 356,305156144221,262316140533
	NUMBER 361,366411575266,037001570662
	NUMBER 365,232046056261,323301053417
	NUMBER 370,300457471736,110161266323
	NUMBER 373,360573410325,332215544010
	NUMBER 377,226355145205,250330436405	;D+38
	NUMBER 402,274050376447,022416546106
	NUMBER 405,353062476160,327122277527	;D+40
	NUMBER 411,222737506706,206363367627
	NUMBER 414,267527430470,050060265574
	NUMBER 417,345455336606,062074343133
	NUMBER 423,217374313163,337245615771
	NUMBER 426,263273376020,327117161367
	NUMBER 431,340152275425,014743015665
	NUMBER 435,214102366355,050055710521
	NUMBER 440,257123064050,162071272646
	NUMBER 443,332747701062,216507551417
	NUMBER 447,210660730537,231114641751	;D+50
	NUMBER 452,253035116667,177340012344
>
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-200>

	.TAB. %EXP10
	DEFINE	HITABL <
%%EXP==0
 HIEXP  21, 0106, 330656232670, 273650000000
 HIEXP  31, 0147, 374336761002, 054022122623
 HIEXP  42, 0214, 267527430470, 050060265574
 HIEXP  52, 0255, 325644342445, 137230015035
 HIEXP  63, 0322, 233446460731, 230310256731
 HIEXP  73, 0363, 265072116565, 045110433533
 HIEXP  84, 0430, 203616042160, 325266273336
 HIEXP  94, 0471, 231321375525, 337205744040
 HIEXP 105, 0535, 337172572336, 007545174114
 HIEXP 115, 0577, 201742476560, 254305755624
 HIEXP 126, 0643, 275056630405, 050037577756
 HIEXP 136, 0704, 334103204270, 352046213536
 HIEXP 147, 0751, 240125245530, 066753037575
 HIEXP 158, 1015, 351045347212, 074316542737
 HIEXP 168, 1057, 207525153773, 310102120644
 HIEXP 179, 1123, 305327273020, 343641442602
 HIEXP 189, 1164, 345647674501, 121102720144
 HIEXP 200, 1231, 247161432765, 330455055455
 HIEXP 210, 1272, 302527746114, 232735577633
 HIEXP 221, 1337, 215510706516, 363467704427
 HIEXP 231, 1400, 244711331533, 105545654076
 HIEXP 242, 1444, 357747123347, 374251221667
 HIEXP 252, 1506, 213527073575, 262011603207
 HIEXP 263, 1552, 313176275662, 023427342311
 HIEXP 273, 1613, 354470426352, 214122564267
 HIEXP 284, 1660, 254120203313, 021677205125
 HIEXP 295, 1724, 372412614644, 074374052054
 HIEXP 305, 1766, 221645055640, 266335117623
 HIEXP 316, 2032, 324146136354, 344313410130
 HIEXP 326, 2073, 367020634251, 325055547056
>

%HIMAX==^D326

DEFINE	HIEXP	(DEXP,BEXP,HIWRD,LOWRD) <
	XWD	BEXP,^D<DEXP>
	EXP	HIWRD
	EXP	LOWRD
	%%EXP==%%EXP+1
>


%DEXP:	HITABL
%BEXP==%DEXP+1

	END