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