Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_Alpha_31-jul-86
-
fltgen.mac
There are 12 other files named fltgen.mac in the archive. Click here to see a list.
TITLE FLTGEN - FLOATING POINT CONSTANT GENERATOR
SUBTTL GENERATE FLOATING POINT CONSTANTS
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 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 WHICH IS NOT SUPPLIED BY DIGITAL.
; Author: TFV
INTERN FLTGEV
FLTGEV= BYTE (3)0(9)6(6)0(18)^D101 ; Version Date: 22-Jul-81
SUBTTL REVISION HISTORY
Comment \
***** Begin Revision History *****
***** Begin Version 6 *****
2 761 TFV 1-Mar-80 -----
Routine has been totally rewritten. The algorithm is
the same as in FLIRT in FOROTS
100 1006 TFV 1-Jul-80 ------
Give warning on overflow.
101 1116 JLC 26-Jul-81
Rework the tables and some code to be more accurate
and conform to FLIRT.
***** End Revision History *****
\
;FLOATING POINT CONSTANT GENERATOR
;CONVERTS AN INTEGER CONSTANT TO A DOUBLE PRECISION
;FLOATING POINT CONSTANT FOR THE KL
EXTERNAL LOAC,HIAC,DECEXP,F2
ENTRY FLTGEN
TWOSEG
RELOC 400000
;This routine expects three inputs:
; HIAC - the high order fraction
; LOAC - the low order fraction
; DECEXP - the decimal exponent
;
;The result is built as either a GFLOATING DP or a KL DP number
;depending upon the GFLOATING bit in F2
;
; THE 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,
;KL or KS 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
; ACCUMULATOR DEFINITIONS
X==01
F==02
T0==04
T1==05
T2==06
T3==07
T4==10
T5==11
P1==12
P2==13
P3==14
P==17 ;STACK REGISTER
AC0==T0
AC1==T1
AC2==T2
AC3==T3
AC4==T4
AC5==T5
A==T0
B==T1
C==T2
D==T3
E==T4
XP==T5
BXP==P1
GFLOAT==1B0 ;MASK FOR GFLOAT FLAG
FLTGEN:
PUSH P,01 ;SAVE 01
PUSH P,02 ;SAVE 02
MOVE F,F2
MOVE X,DECEXP
SETZM FL.RBX
SETZM FL.RFR
SETZM FL.RFR+1
MOVE A,HIAC ;GET HIGH ORDER MANTISSA
MOVE B,LOAC ;GET LOW ORDER MANTISSA
NORM: MOVEI BXP,106 ;INIT BINARY EXPON FOR D.P. INTEGER
JUMPN A,NORM1 ;XFER IF AT LEAST ONE 1 IN HIGH HALF
EXCH A,B ;HIGH HALF ZERO, MOVE LOW HALF TO HIGH,
;AND CLEAR LOW HALF
SUBI BXP,^D35 ;AND ADJUST EXPONENT FOR 35 SHIFTS
NORM1: JUMPE A,RETURN ;LEAVE IF BOTH WORDS ZERO
MOVE D,A ;COPY 1ST WORD
JFFO D,NORM2 ;JUST IN CASE
JRST ZERO ;EE CLEARS OUT EVERYTHING
NORM2: ASHC A,-1(E) ;NORMALIZE D.P. INTEGER WITH BIN POINT
;BETWEEN BITS 0 AND 1 IN HIGH WORD
SUBI BXP,-1(E) ;AND ADJUST EXPON TO ALLOW FOR SHIFTING
JUMPE X,ENDF6 ;IF DECIMAL EXP=0, NO MUL BY 10 NEEDED
ENDF3: MOVM D,X ;GET MAG OF DEC EXP
CAILE D,%HIMAX ;LESS THAN MAX TABLE ENTRY?
JRST BADXP2 ;NO. MUCH TOO BIG!
PUSHJ P,EETST ;GO TEST FOR BIG SCALING
MOVM D,X ;GET MAGNITUDE OF DECIMAL EXPONENT
CAILE D,%PTLEN ;BETWEEN 0 AND MAX. TABLE ENTRY?
MOVEI D,%PTLEN ;NO, MAKE IT SO
SKIPGE X ;AND RESTORE CORRECT SIGN
MOVNS D
SUB X,D ;LEAVE ANY EXCESS EXPONENT IN X
DPMUL: MUL B,%HITEN(D) ;LO FRAC TIMES HI POWER OF TEN(RESULT IN B,C)
MOVE E,B ;GET HI PART OF PREVIOUS PRODUCT OUT OF WAY
MOVE B,A ;COPY HI PART OF FRACTION
MOVE C,%LOTEN(D) ;GET LOW POWER OF TEN
ADDI C,1 ;BIAS IT - IT IS TRUNCATED
MUL B,C ;HI FRAC TIMES LO POWER OF TEN
TLO E,(1B0)
ADD E,B ;SUM OF HI PARTS OF CROSS PRODUCTS TO AC T
MUL A,%HITEN(D) ;HI FRACTION TIMES HI POWER OF TEN
TLON E,(1B0) ;DID CARRY OCCUR? ALLOW FOR NEXT CARRY
ADDI A,1 ;CARRY FROM ADDING CROSS PRODUCTS
ADD B,E ;ADD CROSS PRODUCTS TO LO PART
; OF (HI FRAC TIMES HI POW TEN)
TLZN B,(1B0)
AOJA A,ENDF5 ;AND PROPOGATE A CARRY, IF ANY
ENDF5: TLNE A,(1B1) ;NORMALIZED? 1.0 > RESULT >= 0.25
JRST ENDF5A ;YES, RESULT >= 0.5
ASHC A,1 ;NO, SHIFT LEFT ONE PLACE
SUBI BXP,1 ;AND ADJUST EXPONENT
ENDF5A: MOVE D,%EXP10(D) ;GET BINARY EXPONENT
ADD BXP,D ;ADJUST BINARY EXPONENT
JUMPN X,ENDF3 ;CONTINUE IF ANY MORE DEC EXP LEFT
ENDF6: DMOVEM A,FL.RFR ;SAVE THE RAW LEFT-JUSTIFIED FRACTION
MOVEM BXP,FL.RBX ;AND THE RAW BINARY EXPONENT
TLO A,(1B0) ;START ROUNDING (ALLOW FOR OVERFLOW)
JRST DPRND ;TO DPRND
ENDF7: TLZE A,(1B0) ;CARRY PROPOGATE TO BIT 0?
JRST ENDF7A ;NO
ASHC A,-1 ;YES, RENORMALIZE TO RIGHT
ADDI BXP,1 ;AND ADJUST BINARY EXPONENT
TLO A,(1B1) ;AND TURN ON HI FRACTION BIT
ENDF7A: TXNE F,GFLOAT ;EXTENDED EXPONENT?
JRST EERET ;YES. RETURN DIFFERENT FORMAT
CAIGE BXP,200 ;OUT OF RANGE
CAMGE BXP,[-200]
JRST BADEXP ;YES. RETURN ZERO OR INFINITY
ADDI BXP,200 ;ADD IN EXCESS 200
ASHC A,-8 ;NO, LEAVE ROOM FOR EXPONENT
DPB BXP,[POINT 9,A,8] ;INSERT EXPONENT INTO HI WORD
RETURN: MOVEM A,HIAC ; move into result
MOVEM B,LOAC
POP P,02 ; restore the saved registers
POP P,01
POPJ P, ; return
EERET: CAIGE BXP,2000 ;OUT OF RANGE?
CAMGE BXP,[-2000]
JRST BADEXP ;YES. RETURN ZERO OR INFINITY
ADDI BXP,2000 ;ADD IN EXCESS 2000
ASHC A,-^D11 ;SHIFT TO MAKE ROOM FOR EXP
DPB BXP,[POINT 12,A,11];DEPOSIT THE EXPONENT
JRST RETURN
BADEXP: HRLOI A,377777 ;SET NUMBER TO LARGEST POSSIBLE
HRLOI B,377777 ;FOR KL or KS
JUMPG BXP,WARN ;DONE IF EXPONENT .GT. ZERO
ZERO: SETZB A,B ;IF NEGATIVE, SET TO ZERO
JRST WARN
WARN: MOVEM A,HIAC ; return zero or infinity
MOVEM B,LOAC
POP P,02 ; restore the saved registers
POP P,01
PUSH P,[E64##] ; constant overflow or underflow warning
PUSHJ P,WARNLEX##
SUB P,[1,,1] ; pop E64## off stack
POPJ P, ; return
BADXP2: JUMPL X,ZERO ;RETURN ZERO IF DEC EXP NEGATIVE
HRLOI A,377777 ;[1006] GET LARGEST number
HRLOI B,377777
JRST WARN ;[1006] give warning
;IF RUNNING ON A KL, WE CAN USE THE SPARSE POWER
;OF TEN TABLE TO SCALE THE NUMBER. IT IS ABSOLUTELY NECESSARY
;FOR EXTENDED EXPONENT NUMBERS
EETST: MOVM P2,X ;GET MAGNITUDE OF DECIMAL EXPONENT
CAIG P2,%PTLEN ;WITHIN NORMAL RANGE?
POPJ P, ;YES. JUST DO IT NORMALLY
ASHC A,-1 ;PREVENT DIVIDE CHECK
ADDI BXP,1 ;AND MODIFY BINARY EXPONENT
ASH P2,1 ;CALCULATE FACTOR OF TEN TO USE
IDIVI P2,^D21 ;IN SPARSE TABLE
SUBI P2,2 ;STARTS WITH 10**21
IMULI P2,3 ;AND EACH ENTRY IS 3 LOCS
JUMPL X,EENEG ;GO DO DIVIDE IF EXP NEGATIVE
PUSHJ P,%EEMUL ;OR MULTIPLY IF POSITIVE
SUBI X,(XP) ;REDUCE THE DECIMAL EXP
ADDI BXP,(P3) ;AND ADD THE BINARY EXP FOUND
POPJ P,
EENEG: PUSHJ P,%EEDIV ;DO D.P. DIVIDE
ADDI X,(XP) ;REDUCE MAGNITUDE OF X
SUBI BXP,(P3) ;MODIFY BINARY EXPONENT
POPJ P,
;HERE FOR DOUBLE PRECISION ROUNDING
DPRND: TLO B,(1B0) ;START ROUNDING (ALLOW FOR CARRYS)
TXNE F,GFLOAT ;EXTENDED EXPONENT?
ADDI B,2000 ;YES. DO SPECIAL ROUNDING
TXNN F,GFLOAT ;CHECK AGAIN
ADDI B,200 ;LOW WORD ROUNDING FOR PDP-6 OR KI10
TLZN B,(1B0) ;DID CARRY PROPOGATE TO SIGN?
AOJA A,ENDF7 ;YES, ADD CARRY INTO HIGH WORD
JRST ENDF7 ;AND GO RENORMALIZE IF NECESSARY
%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: SUBI T5,1 ;LEAVE STARTING AT BIT 1
JUMPE T5,EENEND ;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,
;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
DEFINE HITABL <
%%EXP==0
HIEXP 21, 0106, 330656232670, 273650000000
HIEXP 31, 0147, 374336761002, 054022122623
HIEXP 42, 0214, 267527430470, 050060265574
HIEXP 52, 0255, 325644342445, 137230015034
HIEXP 63, 0322, 233446460731, 230310256730
HIEXP 73, 0363, 265072116565, 045110433532
HIEXP 84, 0430, 203616042160, 325266273336
HIEXP 94, 0471, 231321375525, 337205744037
HIEXP 105, 0535, 337172572336, 007545174113
HIEXP 115, 0577, 201742476560, 254305755623
HIEXP 126, 0643, 275056630405, 050037577755
HIEXP 136, 0704, 334103204270, 352046213535
HIEXP 147, 0751, 240125245530, 066753037574
HIEXP 158, 1015, 351045347212, 074316542736
HIEXP 168, 1057, 207525153773, 310102120644
HIEXP 179, 1123, 305327273020, 343641442602
HIEXP 189, 1164, 345647674501, 121102720143
HIEXP 200, 1231, 247161432765, 330455055455
HIEXP 210, 1272, 302527746114, 232735577632
HIEXP 221, 1337, 215510706516, 363467704427
HIEXP 231, 1400, 244711331533, 105545654076
HIEXP 242, 1444, 357747123347, 374251221667
HIEXP 252, 1506, 213527073575, 262011603206
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, 344313410127
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
DEFINE DEFTX (Y,Z) <
IRP Y,<IRP Z,<
DEFINE TX'Y'Z (AC,E) <
IFE <<E>&777777000000>,<TR'Y'Z AC,<E> ;>
IFE <<E>&000000777777>,<TL'Y'Z AC,(E) ;>
TD'Y'Z AC,[E]
>
>>
>
DEFTX (<N,Z,O,C>,<N,E,A,>)
LIT ;1006 Deposit literals in high seg
RELOC 0
FL.RBX: BLOCK 1 ;RAW BINARY EXPONENT
FL.RFR: BLOCK 2 ;RAW FRACTION
END FLTGEN