Trailing-Edge
-
PDP-10 Archives
-
CFS_TSU04_19910205_1of1
-
update/cblsrc/dspfp.mac
There are 7 other files named dspfp.mac in the archive. Click here to see a list.
; UPD ID= 119 on 11/30/81 at 10:10 AM by NIXON
TITLE DSPFP FLOATING POINT OUTPUT
SUBTTL DMN - COBOL VERSION
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) 1972, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION
FTCOBOL==1 ;COBOL stuff
IFN FTCOBOL,<
;This code is copied from Fortran version 6 FLOUT routine.
;Code that is not required is put under the FTCOBOL feature test switch.
ENTRY DSP.FP,DSP.F2
FTKL==0 ;Extended exponent code
SEARCH LBLPRM
IFE TOPS20,<SEARCH MACTEN>
IFN TOPS20,<SEARCH MACSYM>
HISEG
.COPYRIGHT ;Put standard copyright statement in REL file
SALL
EXTERN HITEN$,LOTEN$,PTLEN$,EXP10$
SYN HITEN$,%HITEN
SYN LOTEN$,%LOTEN
SYN PTLEN$,%PTLEN
SYN EXP10$,%EXP10
;Accumulators defined the way FORPRM wants them
T0=0
T1=1
T2=2
T3=3
T4=4
T5=5
P1=6
P2=7
P3=10
P4=11
F=14
P=17
;Accumulators defined the way FLOUT wants them
AC0==T0 ;FLOATING POINT NO. ON ENTRY
AC1==T1 ;USED IN FORMING DIGITS
AC2==T2 ;DITTO. D.P. ONLY
AC3==T3 ;EXTENDED EXPONENT ONLY
AC4==T4
AC5==T5
;T3 ; NO. OF DIGITS AFTER DEC. POINT
C==T4 ;CNTR./NO. OF CHARS BEFORE DEC. POINT
XP==T5 ;DECIMAL EXPONENT
IO.INF==P4 ;Count number of 9's
;Flags
DPFLG==20 ;Number is double precision
NUMSGN==1 ;Number to be printed is negative
EQZER==10 ;Item is identically zero
;Constants
SPDEF==8 ;8 significant digits for S.P.
DPDEF==^D18 ;18 significant digits for D.P.
OPDEF PJRST [JRST]
>
IFE FTCOBOL,<
SUBTTL D. NIXON AND T. W. EGGERS
SUBTTL D. TODD /DMN/DRT/HPW/MD/JNG/CLRH/CYM 28-Oct-81
SUBTTL JLC - VERSION 6
SEARCH FORPRM
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1972,1981 BY DIGITAL EQUIPMENT CORPORATION
SEGMENT CODE
AC0==T0 ;FLOATING POINT NO. ON ENTRY
AC1==T1 ;USED IN FORMING DIGITS
AC2==T2 ;DITTO. D.P. ONLY
AC3==T3 ;EXTENDED EXPONENT ONLY
AC4==T4
AC5==T5
;T3 ; NO. OF DIGITS AFTER DEC. POINT
C==T4 ;CNTR./NO. OF CHARS BEFORE DEC. POINT
XP==T5 ;DECIMAL EXPONENT
SF==P4 ;SCALE FACTOR
DF==FREEAC ;FLOUT smashes FOROTS' free ac.
NUMSGN==1 ;NEGATIVE NUMBER
DIGEXH==2 ;DIGITS EXHAUSTED
NOSIGN==4 ;NO SPACE FOR + SIGN
EQZER==10 ;ITEM IS IDENTICALLY ZERO
DPFLG==20 ;VARIABLE IS DOUBLE PRECISION
EEFLG==40 ;VARIABLE IS EXTENDED EXPONENT DOUBLE PRECISION
NOEFLG==100 ;DO NOT PRINT "D" OR "E" IN EXPONENT
LOCFLG==NUMSGN+DIGEXH+NOSIGN+EQZER+DPFLG+EEFLG+NOEFLG
SPMAX==^D20
DPMAX==^D20 ;MAXIMUM NUMBER OF DIGITS TO PRINT
;IF WE PRINT ANY MORE, WE WILL BE LYING TO THE
;USER, AS THIS IS THE MAXIMUM PRECISION OF
;OUR SCALING FACTORS OF 10.
;WE CANNOT KNOW WHETHER THE NUMBER WE
;HAVE IN THE MACHINE IS AN EXACT REPRESENTATION
;OF WHATEVER WAS INPUT - WE MUST ASSUME THAT
;WHAT IS IN THE MACHINE IS EXACTLY WHAT IS DESIRED.
;THEREFORE THERE IS NO REASON NOT TO GIVE AS MANY
;DIGITS AS ARE ACCURATE. THE ONLY LIMITATION ON
;THIS CURRENTLY IS THE SCALING ALGORITHM.
LZALWAYS==0 ;SWITCH FOR ALWAYS PRINTING LEADING ZEROES
LZSOME==1 ;SWITCH FOR SOMETIMES - ALWAYS EXCEPT WHEN
;POSITIVE NUMBER IS PRINTED WITH ONLY ONE LEADING
;SPACE
ENTRY %FLOUT,%DOUBT,%GROUT,%EOUT
IFN FTKL,<ENTRY %EEMUL,%EEDIV,%EENRM>
EXTERN %OBYTE,%EXP10,%HITEN,%LOTEN,%PTLEN
EXTERN W.PNTR,D.PNTR,X.PNTR
EXTERN IO.ADR,IO.TYP,IO.INF,SCL.SV,%SAVE4
EXTERN %SIZTB,%BEXP,%DEXP
EXTERN %FTSER
;INSTEAD OF HAVING MANY GLOBAL FLAGS PASSED TO FLOUT, THERE ARE
;SEVERAL ENTRY POINTS WHICH SET FLAGS LOCAL TO THE ROUTINE.
%DOUBT: TXZ F,F%GTP+F%ETP ;NOT G OR E FORMAT
TXO F,F%DTP ;FLAG TO PRINT A "D"
JRST REALO
%GROUT: TXZ F,F%DTP+F%ETP ;TRY WITHOUT SCIENTIFIC NOTATION
TXO F,F%GTP
JRST REALO
%EOUT: TXZ F,F%GTP+F%DTP ;TURN OFF THE OTHER FLAGS
TXO F,F%ETP ;FLAG TO PRINT AN "E"
JRST REALO
%FLOUT: TXZ F,F%GTP+F%ETP+F%DTP
REALO: PUSHJ P,%SAVE4 ;SAVE P1-P4
MOVE DF,FLAGS(D) ;DDB flags kept in DF throughout FLOUT.
TXZ F,LOCFLG ;CLEAR LOCAL FLAGS IN F
MOVE AC1,IO.TYP ;GET VARIABLE TYPE
MOVE AC2,%SIZTB(AC1) ;GET ENTRY SIZE
CAIN AC2,2 ;IS VARIABLE DOUBLE PRECISION?
TXO F,DPFLG ;YES. SET FLAG
CAIN AC1,TP%DPX ;EXTENDED EXPONENT?
TXO F,EEFLG ;YES. SET FLAG
MOVE AC2,IO.ADR ;GET VARIABLE ADDR
MOVE AC0,(AC2) ;LOAD AC 0 WITH NUMBER
SETZ AC1, ;CLEAR LOW WORD
TXNE F,DPFLG ;DOUBLE PRECISION?
MOVE AC1,1(AC2) ;YES, GET LOW WORD ALSO
TLZ AC1,(1B0) ;ELIMINATE GARBAGE SIGN BIT
TXZ F,NUMSGN!DIGEXH!NOSIGN!EQZER
SETZ XP, ;CLEAR EXPONENT
JUMPGE AC0,FLOUT1 ;NUMBER NEGATIVE?
DMOVN AC0,AC0 ;YES. NEGATE IT
TXO F,NUMSGN ;AND - SET SIGN FLAG
>;END IFE FTCOBOL
IFN FTCOBOL,<
DSP.FP: SETZB AC1,F ;CLEAR LOW WORD AND FLAGS
JRST %FLOUT
DSP.F2: MOVX F,DPFLG ;SET DOUBLE PRECISION FLAG
TLZ AC1,(1B0) ;CLEAR JUNK SIGN
%FLOUT: SETZ XP, ;CLEAR EXPONENT
JUMPGE AC0,FLOUT1 ;NEGATIVE NUMBER?
TXO F,NUMSGN ;YES
DMOVN AC0,AC0 ;MAKE IT POSITIVE
FLOUT1: SKIPN AC0 ;OK IF NON-ZERO
JUMPE AC1,DSP.Z ;ZERO IF BOTH ZERO
>
;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.
;
;EXTENDED EXPONENT NUMBERS WHICH REQUIRE A HUGE POWER OF TEN TO SCALE
;THEM DOWN (OR UP) ARE FILTERED THROUGH A SPECIAL ROUTINE WHICH USES
;A SPARSE POWER OF TEN TABLE TO BRING THE NUMBER INTO THE "NORMAL"
;RANGE.
IFE FTCOBOL,<
FLOUT1: JUMPN AC0,FLONZ ;OK IF NON-ZERO
JUMPE AC1,FLOUT6 ;ZERO IF BOTH ZERO
FLONZ:
>
IFN FTKL,<
TXNN F,EEFLG ;EXTENDED EXPONENT?
JRST FLOU1A ;NO
PUSHJ P,EEDEC ;YES. HANDLE SEPARATELY
JRST FLOUT2
>
FLOU1A: HLRZ P1,AC0 ;EXTRACT EXPONENT
LSH P1,-9
HRREI P1,-200(P1) ;EXTEND SIGN
TLZ AC0,777000 ;GET RID OF HIGH EXP
FLOUT2: ADDI P1,^D8 ;EXPONENT IS 8 BIGGER ON NORM
MOVE AC3,AC0 ;GET THE HI FRACTION
JFFO AC3,FLOU2A ;GET HI BIT
EXCH AC0,AC1 ;NONE. SWAP LO AND HI
SUBI P1,^D35 ;AND DECR BINARY EXPONENT
MOVE AC3,AC0 ;GET NEW HI WORD
JFFO AC3,FLOU2A ;GET HI BIT
JRST FLOUT6 ;NUMBER IS ZERO
FLOU2A: ASHC AC0,-1(AC4) ;NORMALIZE NUMBER
SUBI P1,-1(AC4) ;AND MODIFY BINARY EXPONENT
FLOU2B: MOVE P2,P1 ;GET BINARY EXPONENT
IMULI P2,232 ;DEC EXP=LOG10(2)*BIN EXP=.232(OCTAL)*BIN EXP
ADDI P2,400 ;ROUND TO NEAREST INTEGER
ASH P2,-^D9 ;GET RID OF 3 OCTAL FRACTION DIGITS
;P2 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 P3,P2 ;GET MAGNITUDE OF *10 SCALER
CAIGE P3,%PTLEN ;IS THE POWER OF 10 TABLE LARGE ENOUGH
JRST FLOUT3 ;YES
SKIPL P2 ;NO, SCALE 1ST BY LARGEST ENTRY
SKIPA P2,[%PTLEN] ;GET ADR OF LARGEST POSITIVE POWER OF 10
MOVNI P2,%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
IFN FTKL,<
;EXTENDED EXPONENT NUMBERS HAVE 3 MORE BITS OF EXPONENT,
;SO WE MOVE THE MANTISSA OVER TO WHERE IT WOULD BE WERE IT
;A NORMAL FLOATING POINT NUMBER. IF THE EXPONENT IS WITHIN THE NORMAL
;FLOATING POINT RANGE, WE JUST DROP INTO THE STANDARD CODE. IF NOT,
;WE USE A SPARSE POWER OF TEN TABLE TO SCALE THE MANTISSA
;AND LOWER THE MAGNITUDE OF THE BINARY EXPONENT. THE TABLE IS ARRANGED
;SO THAT EACH POWER OF TEN WILL SCALE 2**35 MORE THAN THE NEXT,
;SO WE JUST DIVIDE THE BINARY EXPONENT BY 35 TO GET THE TABLE ENTRY
;TO USE.
;WE LEAVE THE MANTISSA ALIGNED WITH BIT 9 TO AVOID DIVIDE CHECKS. WE
;DON'T LOSE ANY PRECISION THEREBY BECAUSE FOR BOTH MULTIPLICATION
;AND DIVISION WE GET A 4-WORD RESULT. AFTER THE SCALING OPERATION,
;WE HAVE TO ALIGN THE MANTISSA ON BIT 1. THIS TIME,
;HOWEVER, IT MIGHT START ANYWHERE, SO WE CALL %EENRM.
EEDEC: LDB P1,[POINT 12,AC0,11];GET THE EXPONENT
TLZ AC0,777700 ;AND WIPE IT OUT IN MANTISSA
ASHC AC0,3 ;MAKE IT LOOK NORMAL
HRREI P1,-2000(P1) ;EXTEND SIGN OF EXPONENT
MOVM P2,P1 ;GET MAGNITUDE OF EXP
CAIGE P2,200 ;OUT OF RANGE?
POPJ P, ;NO. USE REGULAR CODE
SUBI P2,^D70 ;MODIFY FOR SPARSE 10'S TABLE
IDIVI P2,^D35 ;DERIVE INDEX FOR EXPONENT
IMULI P2,3 ;GET PROPER INDEX
JUMPL P1,EENEG ;GO DO MUL IF NEGATIVE
PUSHJ P,%EEDIV ;AND DIVIDE IF POSITIVE
SUBI P1,(P3) ;REDUCE THE BINARY EXPONENT
POPJ P,
EENEG: PUSHJ P,%EEMUL ;DO D.P. MULT
MOVNI XP,(XP) ;RECORD NEGATIVE DECIMAL EXPONENT
ADDI P1,(P3) ;REDUCE MAGNITUDE OF BINARY EXP
POPJ P,
%EEDIV: SETZB AC2,AC3 ;CLEAR LOWER AC'S
SETZB AC4,AC5 ;AND EVEN LOWER AC'S
DDIV AC0,%BEXP(P2) ;GET 2-WORD RESULT
DDIV AC2,%BEXP(P2) ;GET 4-WORD RESULT
JRST EECOM ;JOIN COMMON CODE
%EEMUL: DMOVE AC2,%BEXP(P2) ;GET POWER OF TEN
ADDI AC3,1 ;BIAS IT - IT IS TRUNCATED
DMUL AC0,AC2 ;GET 4-WORD RESULT
EECOM: PUSHJ P,%EENRM ;NORMALIZE IT
TLO AC0,(1B0) ;PREPARE FOR OVERFLOW
TLNE AC2,(1B1) ;ROUNDING BIT ON?
DADD AC0,[EXP 0,1] ;YES. ROUND UP
TLZ AC1,(1B0) ;TURN OFF LOW SIGN
TLZE AC0,(1B0) ;DID WE OVERFLOW?
JRST EEOK ;NO
TLO AC0,(1B1) ;YES. TURN HIGH BIT ON
ADDI P1,1 ;AND INCR THE BINARY EXP
EEOK: HLRZ P3,%DEXP(P2) ;GET THE BINARY EXPONENT
HRRZ XP,%DEXP(P2) ;GET DECIMAL EXPONENT
POPJ P,
%EENRM: MOVE T4,AC0 ;GET THE HIGH WORD
JFFO T4,EENZ ;LOOK FOR 1ST 1
DMOVE AC0,AC1 ;SHOVE THE NUMBER OVER
SUBI P1,^D35 ;AND MODIFY THE EXPONENT
MOVE T4,AC0 ;TRY NEXT WORD
JFFO T4,EENZ
JRST EENEND ;STILL NONE
EENZ: SOJE T5,EENEND ;LEAVE STARTING AT BIT 1, DONE IF NO SHIFT
SUB P1,T5 ;MODIFY THE BINARY EXPONENT
MOVN T4,T5 ;AND GET NEG SHIFT ALSO
JUMPL T5,RGTSFT ;DIFFERENT FOR RIGHT SHIFT
ASHC AC0,(T5) ;MOVE 1ST AND 2ND WORDS
ASH AC1,(T4) ;MOVE BACK 2ND WORD
ASHC AC1,(T5) ;MOVE 2ND AND 3RD WORD
EENEND: POPJ P,
RGTSFT: ASHC AC1,(T5) ;MOVE 2ND AND 3RD
ASH AC1,(T4) ;MOVE 2ND BACK
ASHC AC0,(T5) ;MOVE 1ST AND 2ND
POPJ P,
>;END FTKL
;SCALE DOUBLE FRACTION BY A POWER OF 10
DPMUL: JUMPE P2,CPOPJ ;IF DEC EXP IS 0, RETURN
ADD XP,P2 ;PUT DEC SCALE FACTOR INTO XP
MOVN P2,P2 ;TAKE RECIPROCAL OF EXPONENT
MOVE P3,%EXP10(P2) ;GET CORRESPONDING BIN EXP
ADD P1,P3 ;ADD POWER EXP INTO FRAC EXP
IFN FTKL,<
MOVE AC2,%HITEN(P2) ;GET DOUBLE SCALING FACTOR
MOVE AC3,%LOTEN(P2)
ADDI AC3,1 ;BIAS IT - IT IS TRUNCATED
DMUL AC0,AC2 ;GET DP PRODUCT
TLO AC1,(1B0) ;PREPARE FOR CARRY
TLNE AC2,(1B1) ;ROUNDING BIT ON?
ADDI AC1,1 ;YES. ADD 1 TO LOW WORD
>;END FTKL
IFE FTKL,<
MOVE AC3,AC1 ;COPY LOW WORD
MOVE AC4,%LOTEN(P2) ;GET LOW WORD
ADDI AC4,1 ;BIAS IT - IT IS TRUNCATED
MUL AC3,AC4 ;GET LOW PRODUCT
MUL AC1,%HITEN(P2) ;FORM FIRST CROSS PRODUCT
;LOW RESULT IN AC2
MOVE P3,AC0 ;COPY HI FRACTION
MOVE P4,%LOTEN(P2) ;GET LOW WORD
ADDI P4,1 ;BIAS IT - IT IS TRUNCATED
MUL P3,P4 ;FORM 2ND CROSS PRODUCT
;LOW RESULT IN P4
TLO P3,(1B0) ;AVOID OVERFLOW
ADD P3,AC1 ;ADD CROSS PRODUCTS
MUL AC0,%HITEN(P2) ;FORM HI PRODUCT
TLON P3,(1B0) ;DID CROSS PRODUCT OVERFLOW
ADDI AC0,1 ;YES
ADD AC1,P3 ;ADD CROSS PRODUCTS IN
TLON AC1,(1B0) ;OVERFLOW?
ADDI AC0,1 ;YES
SETZ AC4, ;CLEAR A CARRY REGISTER
TLO AC3,(1B0) ;PREVENT OVERFLOW IN LOW RESULT
ADD AC3,AC2 ;ADD 1ST LOW RESULT
TLON AC3,(1B0) ;OVERFLOW?
ADDI AC4,1 ;YES. CARRY ONE
ADD AC3,P4 ;ADD 2ND LOW RESULT
TLNN AC3,(1B0) ;OVERFLOW?
ADDI AC4,1 ;YES. CARRY ONE AGAIN
TLNE AC3,(1B1) ;NOW IS THE HIGH POSITIVE BIT SET?
ADDI AC4,1 ;YES. ROUND UP
ADDI AC1,(AC4) ;ADD IN LOW CARRIES
>;END IFE FTKL
TLZN AC1,(1B0) ;OVERFLOW
ADDI AC0,1 ;YES
TLNE AC0,(1B1) ;NORMALIZED?
POPJ P, ;YES
ASHC AC0,1 ;NO, SHIFT LEFT ONE
SOJA P1,CPOPJ ;AND ADJUST EXPONENT
FLOUT3: MOVE P3,%EXP10(P2) ;GET BIN EXP THAT MATCHES DEC EXP
CAMLE P3,P1 ;FRACTION .GT. POWER OF 10?
JRST FLOT4A ;YES
CAME P3,P1
AOJA P2,FLOT4A ;NOT IN EXPONENT
CAMGE AC0,%HITEN(P2) ;
JRST FLOT4A ;YES, IN HIGH FRACTION
CAMN AC0,%HITEN(P2)
CAML AC1,%LOTEN(P2)
ADDI P2,1 ;NO, IN FRACTION PART
FLOT4A: PUSHJ P,DPMUL ;SCALE BY POWER OF 10
ASHC AC0,(P1) ;SCALE BY ANY REMAINING POWERS OF 2
TLO T1,(1B0) ;PREVENT OVERFLOW
ADDI T1,1 ;ROUND IT UP SOME MORE
TLZN T1,(1B0) ;CARRY INTO SIGN?
ADDI T0,1 ;YES, PROPAGATE TO HIGH WORD
FLOUT6:
IFE FTCOBOL,<
LDB C,W.PNTR
LDB T3,D.PNTR
HRRE SF,SCL.SV ;GET THE SCALING FACTOR
>
JUMPN AC0,FLOU6A ;IS NUMBER ZERO?
TXO F,EQZER ;YES. SET FLAG
TXZ F,NUMSGN ;AND CLEAR ANY SIGN!
SETZ XP, ;AND THE EXPONENT!
FLOU6A:
IFE FTCOBOL,<
JUMPN C,FLOUT7
TXNE F,DPFLG ;DOUBLE PRECISION?
ADDI C,1 ;YES, INCREMENT INDEX INTO TABLE
HRRZ T3,FRMTAB(C) ;PICKUP DEFAULT FORMAT FOR T3
HLRZ C,FRMTAB(C) ;SAME FOR WIDTH
>
IFN FTCOBOL,<
MOVEI P2,SPDEF ;DEFAULT NO. OF SIGNIFICANT DIGITS
TRNE F,DPFLG ;DOUBLE PRECISION?
MOVEI P2,DPDEF ;MORE IF DOUBLE PRECISION
>
;HERE IS THE FIRST G-FORMAT NUMBER FILTER. THE NUMBER IS CHECKED
;IF IT IS "PROPER MAGNITUDE" FOR G-FORMAT. IF THE MAGNITUDE OF THE
;NUMBER IS SMALLER THAN 10**D OR GREATER THAN OR EQUAL TO 0.1,
;THE NUMBER SHOULD BE PRINTED IN F-FORMAT. SINCE THE NUMBER HAS NOT
;BEEN ROUNDED YET, WE CHECK THE NUMBER JUST USING THE DECIMAL EXPONENT XP,
;AND ALLOW NUMBERS WITH XP GREATER THAN -1 (WHICH COULD INCLUDE
;NUMBERS LESS THAN 0.1). A SECOND CHECK IS DONE AT CHKRND, AFTER
;THE NUMBER HAS BEEN ENCODED, TO SEE IF ROUNDING FORCED THE NUMBER
;INTO OR OUT OF THE F-FORMAT RANGE.
IFE FTCOBOL,<
FLOUT7: TXNN F,F%GTP ;G TYPE CONVERSION?
JRST FLOUT8 ;NO
CAML XP,[-1] ;IF EXPONENT .LT. 1
CAMLE XP,T3 ;OR .GT. # DECIMAL PLACES
TXOA F,F%ETP ;SET E CONVERSION
JRST FLOUT8 ;NOT E, JUMP
TXNE DF,D%LSD+D%NML ;NAMELIST OR LIST-DIRECTED?
SUBI T3,1 ;YES, ACCOUNT FOR DIGIT BEFORE DEC PT
;HERE WE FIGURE OUT HOW MANY SIGNIFICANT DIGITS TO GET FROM THE
;NUMBER. FOR G-FORMAT, THIS IS JUST "D" (AS IN W.D). FOR D AND
;E-FORMATS, IT DEPENDS ON THE SCALE FACTOR. FOR SCALE FACTORS
;LESS THAN ZERO, THE NUMBER OF DIGITS IS REDUCED BY THE SCALE
;FACTOR. FOR POSITIVE SCALE FACTORS, THE NUMBER OF DIGITS IS
;INCREASED BY ONE, UNLESS THE SCALE FACTOR IS MORE
;THAN ONE LARGER THAN THE NUMBER OF DECIMAL PLACES, IN WHICH
;CASE THE NUMBER OF DIGITS IS SET TO THE SCALE FACTOR ALONE.
;FOR F-FORMAT, THE SIZE OF THE NUMBER (DECIMAL EXPONENT) IS
;ADDED TO THE NUMBER OF DIGITS IN ADDITION TO THE SCALE
;FACTOR.
FLOUT8: MOVE P2,T3 ;GET # DECIMAL PLACES
TXNN F,F%ETP!F%DTP ;D OR E FORMAT?
JRST FLOU8A ;NO
JUMPLE SF,FLOUT9 ;IF NEG, JUST GO ADD SCLFCT
CAILE SF,1(T3) ;WITHIN DEFINED RANGE?
MOVEI P2,-1(SF) ;NO. SET TO SCLFCT
ADDI P2,1 ;YES. JUST ADD 1
JRST FLOU10
FLOU8A: TXNE F,F%GTP ;G-FORMAT?
JRST FLOU10 ;YES. WE'RE ALL DONE
ADD P2,XP ;NO. ADD MAGNITUDE OF NUMBER
FLOUT9: ADD P2,SF ;ADD SCLFCT TO # DIGITS DESIRED
FLOU10: JUMPN AC0,FLO10A ;IF NUMBER IS ZERO
SETZ P2, ;DON'T ENCODE ANY DIGITS
FLO10A: CAILE P2,DPMAX ;TOO MANY DECIMAL PLACES
MOVEI P2,DPMAX ;YES, REDUCE TO MAX POSSIBLE
TXNE F,DPFLG ;DOUBLE PRECISION?
JRST DIGOK ;YES
CAILE P2,SPMAX ;NO. RESTRICT TO SPMAX
MOVEI P2,SPMAX
>
DIGOK: MOVE P1,P ;MARK BOTTOM OF DIGIT STACK
PUSH P,[0] ;AND ALLOW FOR POSSIBLE OVERFLOW
SETZM IO.INF ;CLEAR 9'S COUNTER
MOVE P3,P2 ;GET # OF DIGITS
IFE FTCOBOL,<
JUMPLE P2,CHKRND ;NO DIGITS WANTED.
>
FLOU12: EXCH AC0,AC1 ;PUT HI WORD IN AC1
MULI AC1,^D10 ;MUL HI WORD BY 10
PUSH P,AC1 ;STORE DIGIT ON STACK
MULI AC0,^D10 ;MUL LOW WORD BY 10
TLO AC0,(1B0) ;STOP OVERFLOW
ADD AC0,AC2 ;ADD HI WORD BACK INTO AC0
TLZN AC0,(1B0) ;CARRY
AOS (P) ;YES, INCREMENT DIGIT ON STACK
MOVE AC2,(P) ;GET THE DIGIT
CAIN AC2,^D9 ;IS IT A 9?
AOSA IO.INF ;YES. INCR 9'S COUNT
SETZM IO.INF ;NO. CLEAR 9'S COUNT
SOJG P3,FLOU12
;FOR G-FORMAT OUTPUT, THERE IS THE POSSIBILITY THAT ROUNDING THE
;NUMBER WILL MAKE IT TOO LARGE TO PRINT IN F-FORMAT, OR THAT NUMBERS
;THAT WE LET THROUGH AT FLOUT7 WILL NOT BE ROUNDED UP, AND WILL BE
;TOO SMALL TO PRINT IN F-FORMAT. THE FOLLOWING CODE CHECKS FOR
;THESE CONDITIONS, AND SETS THE E-FORMAT FLAG IF THE NUMBER IS TOO
;LARGE OR TOO SMALL. IF THERE IS A SCALE FACTOR INVOLVED, IT MODIFIES
;THE NUMBER OF DIGITS ENCODED - NEGATIVE SCALE FACTORS REDUCE THE
;NUMBER OF DIGITS ENCODED, WHILE POSITIVE SCALE FACTORS INCREASE THE
;NUMBER OF DIGITS ENCODED BY 1 DIGIT (OR IF THE SCALE FACTOR
;IS OUTSIDE THE DEFINED RANGE, MODIFIES THE NUMBER OF DIGITS ENCODED
;TO THE SCALE FACTOR).
IFE FTCOBOL,<
CHKRND: TXNE F,F%GTP ;G-FORMAT?
TXNE F,F%ETP+F%DTP ;YES. D OR E?
JRST CHKRN2 ;D OR E OR NOT G. LEAVE
TLNE AC0,(1B1) ;ROUNDING BIT ON?
JRST TEST9 ;YES. TEST # 9'S
JUMPL XP,FGFIX ;NO. NG IF EXP STILL LOW
JRST FLOU13 ;OTHERWISE OK
TEST9: CAMN P2,IO.INF ;IS 9'S COUNT SAME AS DIGITS?
JRST TESTXP ;YES. WE GOT OVERFLOW
JUMPL XP,FGFIX ;NO. NG IF EXPONENT STILL LOW
JRST DORND ;OTHERWISE WE'RE OK
TESTXP: CAMGE XP,T3 ;IS UNINCREMENTED EXP TOO BIG?
JRST DORND ;NO. WE'RE OK
FGFIX: TXO F,F%ETP ;SET TO TYPE "E"
JUMPE SF,CHKRN2 ;NO # DIGITS CHANGE IF SF=0
JUMPG SF,FGPOS ;NEED MORE IF SF.GT.0
MOVM AC2,SF ;GET MAGNITUDE OF SCLFCT
CAMLE AC2,P2 ;.LE. # OF DIGITS?
JRST FLOU13 ;NO. WE'RE ROUNDING ON ZEROES
ADD P,SF ;NEED LESS IF SF.LT.0
ADD P2,SF ;ADJUST # DIGITS
ADDM SF,IO.INF ;AND 9'S COUNTER
SKIPGE IO.INF ;IF 9'S COUNT IS NOW .LT. 0
JRST FLOU13 ;WE HAVE NO ROUNDING
JRST DORND ;NOW ROUND WITH FEWER DIGITS
FGPOS: TXNE DF,D%LSD+D%NML ;NAMELIST OR LIST-DIRECTED?
JRST NOEXDG ;YES. NO EXTRA DIGITS NEEDED
MOVEI P3,(SF) ;ENCODE MORE DIGITS
SUBI P3,(P2) ;EITHER 1 OR (SF-P2)
CAIG SF,1(T3) ;WITHIN DEFINED RANGE?
MOVEI P3,1 ;YES. JUST ADD 1
ADDI P2,(P3) ;INCREASE RECORDED # DIGITS
JRST FLOU12 ;GO ENCODE
NOEXDG: SUBI T3,1 ;REMOVE A DIGIT FOR NMLST/LDIO
CHKRN2:
>
TLNN AC0,(1B1) ;ROUNDING BIT ON?
JRST FLOU13 ;NO
DORND: MOVEI AC2,(P) ;GET STACK POINTER
MOVE AC1,IO.INF ;GET 9'S COUNT
JUMPLE AC1,FLO12B ;INCR LAST DIG IF NO 9'S
ZERLP: SETZM (AC2) ;MAKE DIGIT ZERO
SUBI AC2,1 ;DECR POINTER
SOJG AC1,ZERLP ;DO FOR ALL CONSECUTIVE 9'S
FLO12B: AOS (AC2) ;INCR NEXT DIGIT
FLOU13: MOVEI P3,2(P1) ;GET BASE OF STACKED DIGITS
SKIPN 1(P1) ;DID OVERFLOW OCCUR?
JRST FLOU14 ;NO
SUBI P3,1 ;YES - MOVE BACK BASE POINTER
ADDI XP,1 ;INCREMENT EXPONENT
ADDI P2,1 ;ADD 1 TO # DIGITS
FLOU14: JUMPG P2,FLO14A ;ANY DIGITS?
TXZ F,NUMSGN ;NO. CLEAR ANY SIGN
FLO14A:
IFE FTCOBOL,<
TXNE F,F%GTP ;YET ANOTHER G-FORMAT TEST
TXNE F,F%ETP+F%DTP
JRST FLOU15 ;E OR D OR NOT G
SETZ SF, ;SCLFCT IS USELESS NOW FOR G-FORMAT
FLOU15: SUBI C,2(T3) ;SIGN, POINT AND CHARS. FOLLOWING
TXNE F,F%ETP!F%DTP
JRST FLOU16
>
;HERE FOR F TYPE CONVERSION
IFE FTCOBOL,<
TXNE F,EQZER ;IS NUMBER ZERO?
SETZ SF, ;YES. SET SCALE FACTOR TO 0
ADD SF,XP ;COUNT THE LEADING DIGITS
TXNE F,F%GTP
JRST [SUBI T3,(XP) ;NO, REDUCE CHAR. AFTER POINT FOR F
JRST CHEKDE] ;BUT IGNORE SCALE FACTOR IN WIDTH
JUMPLE SF,TRYFIT ;IGNORE NEG SCALING
SUBI C,(SF) ;+SCALING
JRST TRYFIT
;HERE FOR E AND D TYPE CONVERSION
FLOU16: JUMPLE SF,CHEKDE ;IF FACTOR .LE. 0, GO CHECK EXP
SUBI C,1 ;EXTRA DIGIT PRINTED
SUBI T3,-1(SF) ;REDUCE DIGITS AFTER POINT
JUMPGE T3,CHEKDE ;TO COMPENSATE FOR THOSE IN FRONT
ADD C,T3 ;HOWEVER IF NOT ENOUGH LEFT
;TAKE FROM IN FRONT
CHEKDE: LDB AC2,X.PNTR ;GET EXPONENT WIDTH
JUMPN AC2,GOTEXW ;MIGHT BE DEFAULT
MOVEI AC2,2 ;WHICH IS 2
GOTEXW: MOVEM AC2,IO.INF ;SAVE FOR LATER
TXNE F,F%DTP+F%ETP ;D OR E FORMAT?
CAIL AC2,3 ;YES. ROOM FOR LARGEST EXPONENT?
JRST EXPOK ;SURE
MOVE AC1,XP ;GET EXPONENT
SUB AC1,SF ;REDUCE BY SCALE FACTOR
MOVM AC1,AC1 ;GET MAGNITUDE
CAML AC1,EXPTAB(AC2) ;WILL EXPONENT FIT?
TXO F,NOEFLG ;MAYBE JUST BARELY WITH NO "D" OR "E"
CAML AC1,EXPTAB+1(AC2);WILL IT FIT AT ALL?
JRST NOFIT ;NO
EXPOK: SUB C,IO.INF ;REDUCE SPACE FOR NUMBER
SUBI C,2 ;ALLOW FOR E+ OR + AND 1ST DIGIT OF EXP
TRYFIT: JUMPG C,FIT1 ;WILL IT FIT?
JUMPL C,TRYF0 ;NO. SERIOUS IF .LT. 0
JUMPG SF,GO2ERF ;C=0, OK IF DIGITS BEFORE POINT
IFN LZALWAYS,<
TXNN F,NUMSGN ;IS SIGN POSITIVE?
AOJA C,POSIGN ;YES. ELIMINATE IT FOR LEADING ZERO>
JUMPG T3,GO2ERF ;NO. BUT WE'RE OK IF DIGITS AFTER POINT
TRYF0: TXNE F,NUMSGN ;NO. IS SIGN POSITIVE
JRST TRYF2 ;NO.
JUMPG T3,TRYF1 ;YES. ANY DIGITS AFTER POINT?
JUMPG SF,TRYF1 ;NO. ANY DIGITS BEFORE POINT?
JUMPL C,TRYF2 ;NO. MUST BE ROOM FOR LEADING 0
TRYF1: CAML C,[-1] ;YES. WOULD THERE BE ROOM WITHOUT SIGN?
AOJA C,POSIGN ;YES. PRINT WITHOUT SIGN
TRYF2: TXNN F,F%ETP!F%DTP ;NO. IF E FORMAT WE LOSE
TXZN F,F%GTP ;WAS IT G TO F CONVERSION?
JRST NOFIT ;E TYPE OR NOT G TO F
ADDI C,2 ;REMOVE THE "E+" TRAILING SPACES
ADD C,IO.INF ;ADD THE EXPONENT WIDTH BACK
JRST TRYFIT ;AND TRY AGAIN
>
IFE FTCOBOL,<
NOFIT: LDB AC2,W.PNTR ;GET THE WIDTH
JUMPE AC2,FIT ;ALWAYS FITS IF FREE FORMAT
IFN FTAST,<
MOVE P,P1 ;RESTORE STACK POINTER
MOVEI T1,"*" ;OUTPUT ASTERISKS
PUSHJ P,%OBYTE
SOJG AC2,.-1
PJRST %FTSER ;%Field width too small
>
IFE FTAST,<
ADD SF,C ;LESS DIGITS TO OUTPUT
ADD P2,C ;AND LESS IN STACK
>
FIT: JUMPLE C,GO2ERF ;NO LEADING BLANKS
FIT1: JUMPG SF,FIT2 ;NO 2ND CHECK IF DIGITS BEFORE POINT
CAIG C,1 ;MUST LEAVE ROOM FOR LEADING 0
JRST GO2ERF
FIT2: PUSHJ P,SPACE ;OUTPUT SPACE
SOJA C,FIT ;UNTIL ENOUGH
POSIGN: TXO F,NOSIGN ;SIGNAL ROOM FOR LEADING ZERO
; AND NO ROOM FOR + SIGN
GO2ERF: TXNN F,F%ETP!F%DTP ;TEST FLOATING POINT FLAGS
JRST FFORM ;NO, USE FIXED POINT
;FALL INTO EFORM
>
;E FORMAT
EFORM:
IFE FTCOBOL,<
SUB XP,SF ;SCALE EXPONENT
JUMPG P2,EFORMA ;ANY SIGNIFICANT DIGITS?
SETZ XP, ;NO. CLEAR THE EXPONENT
>
IFN FTCOBOL,<
;Enter here with maximun number of digits to output in P2
;However COBOL does not output trailing zeroes
;so look at the digits and reduce the size by the number of trailing digits.
;If the result is zero go to DSP.Z, if there is only one digit output two.
;Note COBOL outputs numbers with a scale factor of 1. i.e 1.234E5
MOVE T3,P ;GET BOTTOM OF STACK (LSD)
EFORM0: SKIPE (T3) ;IS IT A ZERO?
SOJA XP,EFORMA ;NO, ALL DONE, ALSO SCALE EXPONENT
SOJLE P2,DSP.Z ;YES, REDUCE COUNT OF DIGITS TO OUTPUT
SOJA T3,EFORM0 ; AND TRY NEXT
>
EFORMA:
IFE FTCOBOL,<
JUMPLE SF,EFORM1 ;JUMP IF NOT POSITIVE SCALING
PUSHJ P,SIGN ;OUTPUT SIGN
>
IFN FTCOBOL,<
CAIN P2,1 ;EXACTLY 1 DIGIT?
MOVEI P2,2 ;YES, MAKE IT TWO
TXZE F,NUMSGN ;PRINT SIGN IF NEGATIVE
PUSHJ P,MINUS
>
EFORMB: PUSHJ P,DIGIT ;OUTPUT LEADING DIGITS
IFE FTCOBOL,<
SOJG SF,EFORMB ;RETURN FOR MORE
>
PUSHJ P,PERIOD ;OUTPUT DOT
IFE FTCOBOL,<
JUMPLE T3,EFORM4 ;NO MORE IF NO DEC
>
EFORMC: PUSHJ P,DIGIT ;OUTPUT ANOTHER DIGIT
IFN FTCOBOL,<
JUMPG P2,.-1 ;LOOP UNTIL ALL DIGITS ARE PRINTED
>
IFE FTCOBOL,<
SOJG T3,EFORMC ;UNTIL DECS USED UP
JRST EFORM4 ;GO OUTPUT EXPONENT
EFORM1: PUSHJ P,SIGN ;OUTPUT SIGN
IFN LZALWAYS!LZSOME,<
JUMPLE C,EFORM2 ;IF ROOM, OUTPUT LEADING 0>
IFE LZALWAYS!LZSOME,<
JUMPG T3,EFORM2 ;OR IF NO TRAILING DIGITS>
PUSHJ P,ZERO ;OUTPUT ZERO
EFORM2: PUSHJ P,PERIOD ;AND DECIMAL POINT
JUMPLE T3,EFORM4 ;GO TO EXPONENT IF NO DIGITS
JUMPE SF,EFORM3 ;ACCOUNT FOR ZERO SCALING
MOVM SF,SF ;GET MAGNITUDE
CAIGE SF,(T3) ;SCLFCT .GE. # DECS?
JRST EFRM2A ;NO. THINGS ARE OK
CAIE SF,(T3) ;EQUAL?
MOVEI SF,1(T3) ;GREATER. SET SF=D
SUBI SF,1 ;EQUAL. SET SF=D-1
EFRM2A: SUBI T3,(SF) ;REDUCE # SIGNIFICANT DIGITS
EFRM2B: PUSHJ P,ZERO ;OUTPUT LEADING ZEROES
SOJG SF,EFRM2B
EFORM3: JUMPLE T3,EFORM4 ;LEAVE IF NO DIGITS AFTER POINT
EFRM3A: PUSHJ P,DIGIT ;OUTPUT FRACTIONAL DIGIT
SOJG T3,EFRM3A ;RETURN IF MORE DIGITS
>
EFORM4: MOVEI AC1,"E"
IFE FTCOBOL,<
TXNE F,F%DTP ;USER SPECIFY D-FORMAT?
MOVEI AC1,"D" ;YES, GIVE D INSTEAD
TXNN F,NOEFLG ;DON'T PRINT IF NO ROOM
>
PUSHJ P,%OBYTE ;OUTPUT "E" OR "D"
IFE FTCOBOL,<
JUMPGE XP,EFORM5
TXO F,NUMSGN ;TYPE MINUS IF EXPONENT NEGATIVE
EFORM5: PUSHJ P,PLUS ;PRINT SIGN
MOVE C,IO.INF ;AND SET DIGIT COUNT
TXNE F,NOEFLG ;DID WE PRINT "D" OR "E"?
ADDI C,1 ;NO. MORE ROOM FOR EXPONENT
>
IFN FTCOBOL,<
SKIPGE XP ;ONLY PRINT SIGN
PUSHJ P,MINUS ; IF EXPONENT IS NEGATIVE
>
MOVE P,P1 ;RESTORE STACK POINTER
MOVM AC0,XP ;GET EXPONENT
IFE FTCOBOL,<
JRST OUTP1 ;AND LET OUTP1 DO THE WORK
>
IFN FTCOBOL,<
IDIVI AC0,^D10 ;SPLIT INTO TWO DIGITS
JUMPE AC0,EFORM6 ;NO TENS
EXCH AC0,AC1
ADDI AC1,"0"
PUSHJ P,%OBYTE ;OUTPUT TENS DIGIT
MOVE AC1,AC0
EFORM6: ADDI AC1,"0"
JRST %OBYTE ;OUTPUT UNITS
>
;F FORMAT
IFE FTCOBOL,<
FFORM: JUMPLE SF,FFORM3 ;NO LEADING DIGITS
PUSHJ P,SIGN ;OUTPUT SIGN
FFORMA: PUSHJ P,DIGIT ;OUTPUT INTEGRAL DIGIT
SOJG SF,FFORMA ;RETURN IF MORE DIGITS
PUSHJ P,PERIOD ;PRINT DECIMAL POINT
FFORM1: JUMPE T3,FFORM2 ;TEST FOR DIG AFTER POINT
PUSHJ P,DIGIT ;OUTPUT FRACTIONAL DIGIT
SOJG T3,FFORM1 ;RETURN IF MORE DIGITS
FFORM2: MOVE P,P1 ;RESTORE STACK
TXNN F,F%GTP ;G FORMAT REQUIRES 4 BLANKS
POPJ P, ;FINISHED
LDB C,X.PNTR ;GET EXPONENT WIDTH
CAIN C,0 ;IF SET
MOVEI C,2 ;IF NOT, DEFAULT IS 4 (2+2)
ADDI C,2 ;PLUS 2 FOR E+ OR E-
FFRM2A: PUSHJ P,SPACE ;BLANKS
SOJG C,FFRM2A
POPJ P, ;FINISHED
FFORM3: PUSHJ P,SIGN ;OUTPUT SIGN
IFN LZALWAYS!LZSOME,<
JUMPLE C,NOLZ ;AND IF WE CAN,>
IFE LZALWAYS!LZSOME,<
JUMPG T3,NOLZ ;OR IF NO TRAILING DIGITS>
PUSHJ P,ZERO ;OUTPUT LEADING "0"
NOLZ: PUSHJ P,PERIOD ;OUTPUT DEC. POINT
ADD T3,SF ;REDUCE DEC BY SCLFCT
JUMPGE T3,FFRM3C ;FINISH IF OK
SUB T3,SF ;RESTORE D
MOVN SF,T3 ;USE FOR SCLFCT
SETZ T3, ;AND NO DIGITS
FFRM3C: JUMPGE SF,FFORM1 ;NOW FOR DIGITS
PUSHJ P,ZERO ;ZERO AFTER POINT
AOJA SF,FFRM3C ;LOOP ON ZEROS
>
; OUTPUT ROUTINES
PERIOD: MOVEI AC1,"." ;DECIMAL POINT
PJRST %OBYTE ;PRINT AND RETURN
IFE FTCOBOL,<
SPACE: TXNE DF,D%LSD+D%NML ;LIST-DIRECTED OR NMLST?
POPJ P, ;YES. LEAVE
MOVEI AC1," " ;SPACE
PJRST %OBYTE
>
ZERO: MOVEI AC1,"0"
JRST %OBYTE
IFE FTCOBOL,<
PLUS: MOVEI AC1,"+"
JRST SIGN1
SIGN: TXZE F,NOSIGN ;NO ROOM FOR SIGN?
POPJ P, ;JUST RETURN
MOVEI AC1," "
TXNE DF,D%SP ;FORCE PLUS SIGN?
MOVEI AC1,"+" ;YES
SIGN1: TXZE F,NUMSGN ;ALWAYS CLEAR FLAG
MOVEI AC1,"-" ;SELECT SIGN
CAIN AC1," " ;IS IT A SPACE?
TXNN DF,D%LSD+D%NML ;YES. LIST-DIRECTED OR NMLST?
PJRST %OBYTE ;NO. PRINT
POPJ P,
>
IFN FTCOBOL,<
MINUS: MOVEI AC1,"-" ;PRINT SIGN IF NEGATIVE
%OBYTE: OUTCHR AC1
POPJ PP,
>
DIGIT:
IFE FTCOBOL,<
JUMPLE P2,ZERO ;OUTPUT ZERO IF NO DIGITS
>
SUBI P2,1 ;DECR # DIGITS LEFT
MOVE AC1,(P3) ;GET NEXT DIGIT
ADDI AC1,"0" ;CONVERT TO ASCII
AOJA P3,%OBYTE ;AND PRINT
IFE FTCOBOL,<
OUTP1: MOVEI XP,1 ;SET UP DIGIT COUNT
OUTP2: IDIVI AC0,^D10 ;AND GENERATE DIGITS IN REVERSE
PUSH P,AC1 ;AND SAVE THEM ON THE STACK
JUMPE AC0,OUTP3 ;ANY LEFT?
AOJA XP,OUTP2 ;YES - COUNT AND CARRY ON
OUTP3: CAML XP,C ;ANY LEADING SPACES?
JRST OUTP4 ;NO
PUSHJ P,ZERO ;YES - PRINT ONE
SOJA C,OUTP3 ;AND DECREASE UNTIL FINISHED
OUTP4: POP P,AC1 ;POP UP DIGIT
ADDI AC1,"0" ;ADD ASCII OFFSET
PUSHJ P,%OBYTE ;AND PRINT IT
SOJN XP,OUTP4 ;REPEAT UNTIL FINISHED
>
CPOPJ: POPJ P, ; EXIT FROM ROUTINE
IFE FTCOBOL,<
FRMTAB: ^D15,,7 ;15.7 DEFAULT
^D25,,^D17 ;25.17 DEFAULT
EXPTAB: 1 ;10**0
^D10 ;10**1
^D100 ;10**2
^D1000 ;10**3
PURGE $SEG$
>
IFN FTCOBOL,<
;Number is zero
DSP.Z: OUTSTR [ASCIZ "0.0E0"]
POPJ PP,
>
PRGEND
TITLE POWTB D. P. POWER OF TEN TABLE
SUBTTL D.P. INTEGER POWER OF TEN TABLE T.W.EGGERS/DMN 6-APR-77
ENTRY HITEN$, LOTEN$, EXP10$, PTLEN$
HISEG
SALL
;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".
;THE NUMBERS IN THE TABLES ARE TRUNCATED, THAT IS, NO
;ROUNDING HAS BEEN DONEFROM THE (VIRTUAL) THIRD WORD OF
;PRECISION. THUS, ON AVERAGE, THE TABLES ARE BIASED 1/2
;BIT DOWNWARDS.
DEFINE .TAB. (A)<
REPEAT 0,<
NUMBER -246,357347511265,056017357445 ;D-50
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 ;D-40
NUMBER -201,256162766125,113301556752
NUMBER -176,331617563552,236162112545 ;D-38
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 ;D-30
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 ;D-20
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 ;D-10
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 ;D-01
A: NUMBER 001,200000000000,0 ;D+00
NUMBER 004,240000000000,0
NUMBER 007,310000000000,0
NUMBER 012,372000000000,0
NUMBER 016,234200000000,0
NUMBER 021,303240000000,0
NUMBER 024,364110000000,0
NUMBER 030,230455000000,0
NUMBER 033,276570200000,0
NUMBER 036,356326240000,0
NUMBER 042,225005744000,0 ;D+10
NUMBER 045,272207335000,0
NUMBER 050,350651224200,0
NUMBER 054,221411634520,0
NUMBER 057,265714203644,0
NUMBER 062,343277244615,0
NUMBER 066,216067446770,040000000000
NUMBER 071,261505360566,050000000000
NUMBER 074,336026654723,262000000000
NUMBER 100,212616214044,117200000000
NUMBER 103,255361657055,143040000000 ;D+20
REPEAT 0,<
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 ;D+30
NUMBER 147,374336761002,054022122623
NUMBER 153,235613266501,133413263573
NUMBER 156,305156144221,262316140531
NUMBER 161,366411575266,037001570657
NUMBER 165,232046056261,323301053415
NUMBER 170,300457471736,110161266320
NUMBER 173,360573410325,332215544004
NUMBER 177,226355145205,250330436402 ;D+38
NUMBER 202,274050376447,022416546102
NUMBER 205,353062476160,327122277522 ;D+40
NUMBER 211,222737506706,206363367623
NUMBER 214,267527430470,050060265567
NUMBER 217,345455336606,062074343124
NUMBER 223,217374313163,337245615764
NUMBER 226,263273376020,327117161361
NUMBER 231,340152275425,014743015655
NUMBER 235,214102366355,050055710514
NUMBER 240,257123064050,162071272637
NUMBER 243,332747701062,216507551406
NUMBER 247,210660730537,231114641743 ;D+50
NUMBER 252,253035116667,177340012333
>
>
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$
END