Trailing-Edge
-
PDP-10 Archives
-
BB-JF18A-BM
-
sources/rms/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