mirror of
https://github.com/elliotnunn/mac-rom.git
synced 2024-07-22 13:28:57 +00:00
Resource forks are included only for .rsrc files. These are DeRezzed into their data fork. 'ckid' resources, from the Projector VCS, are not included. The Tools directory, containing mostly junk, is also excluded.
2293 lines
57 KiB
Plaintext
2293 lines
57 KiB
Plaintext
;
|
|
; File: FPHWB2DC.a
|
|
;
|
|
; Contains: Floating Point HW Binary-to-decimal and decimal-to-binary conversion routines
|
|
;
|
|
; Written by: Apple Numerics Group, DSG
|
|
;
|
|
; Copyright: © 1985-1991 by Apple Computer, Inc., all rights reserved.
|
|
;
|
|
; Change History (most recent first):
|
|
;
|
|
; <1> 10/24/91 SAM/KSM Rolled in Regatta file.
|
|
;
|
|
; Terror Change History:
|
|
;
|
|
; <2> 2/11/91 BG Rolled in changes from Jon Okada.
|
|
; <1> 01/06/90 BG Added to TERROR/BBS for the time.
|
|
;
|
|
|
|
;-----------------------------------------------------------
|
|
; File: FP881b2dc.a
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; Binary-to-decimal and decimal-to-binary conversions
|
|
;
|
|
; Copyright Apple Computer, Inc., 1983,1984,1985,1989,1990
|
|
; All rights reserved
|
|
;
|
|
; 09 Mar 90 Correctly rounded conversion algorithms written
|
|
; by Kenton Hanson completed
|
|
; 13 Mar 90 Conversion routines installed into ½SANE harness
|
|
; by Jon Okada
|
|
; 21 Mar 90 KLH Corrected zero NaN anomaly, & Dec2Int setting of
|
|
; inexact, overlow and invalid simultaneously
|
|
; 22 Mar 90 KLH Corrected 68881/2 unnormal result when denormal
|
|
; singel precision number is delivered to extended
|
|
; while precision control is set to single
|
|
; 27 Mar 90 KLH Updated Leo's no &TRAPS version
|
|
; 30 Mar 90 KLH Put tighter limits on decform.digits
|
|
; 02 Apr 90 KLH corrected case of df.digits = -32000 while style = fixed
|
|
; 11 Apr 90 KLH corrected bcc.s -> bhi.s on 'divide will succeed' statements
|
|
; 12 May 90 SMcD changed file name to reflect 881 version
|
|
; 13 May 90 SMcD changed NoRound's unused env bit '0080' to use FPState, not FPU's
|
|
; 22 May 90 SMcD goes alpha for waimea.
|
|
; 30 May 90 KLH corrected backwards branch 2 lines after DivWS
|
|
; 20 Aug 90 KLH corrected Calculator DA problem, i.e., short decimal record
|
|
; 27 Aug 90 SMcD incorporated QX2DEC96 and QDEC2X96 entry points <SMcD 27aug90>
|
|
; 06 Sep 90 SMcD Dec2Num now sets env before calling user's handler <SMcD 06sep90>
|
|
; 29 Sep 90 SMcD Missed a case in the "13 May 90" changes <9/29/90-SMcD>
|
|
; 30 Sep 90 SMcD Goes final for Terror alpha.
|
|
; 2 Dec 90 KLH corrected Ôtst.w d2Õ to Ôtst.w d4Õ in DivWS <2dec90-KLH>
|
|
; 25 Jan 91 KLH corrected test of NoRoundÕs unused env bit Ô0080Õ to bpl.s from beq.s
|
|
;
|
|
;-----------------------------------------------------------
|
|
|
|
|
|
LCLA &BACKPATCH
|
|
&BACKPATCH SETA 1 ; set if using back patch code
|
|
LCLA &TRAPS
|
|
&TRAPS SETA 1 ; set if using traps
|
|
LCLA &AAA5
|
|
&AAA5 SETA 0 ; set this if 3318 bytes of space exist at (a5)
|
|
LCLA &A68881
|
|
&A68881 SETA 0 ; set if using MC68881 size extendeds
|
|
LCLA &Dec19
|
|
&Dec19 SETA 1 ; set if using 'brain dead' 19 digit max decimal point
|
|
|
|
;-----------------------------------------------------------
|
|
; MACROs for quickly accessing other PACK4 routines
|
|
;-----------------------------------------------------------
|
|
|
|
IF &BACKPATCH THEN
|
|
|
|
MACRO
|
|
BDPROCENTRY
|
|
BSR QPROCENTRY
|
|
ENDM
|
|
|
|
MACRO
|
|
BDSETENV
|
|
BSR QSETENV
|
|
ENDM
|
|
|
|
MACRO
|
|
BDSETXCP
|
|
BSR QSETXCP
|
|
ENDM
|
|
|
|
MACRO
|
|
BDGETENV
|
|
BSR QGETENV
|
|
ENDM
|
|
|
|
MACRO
|
|
BDGETHV
|
|
BSR QGETHV
|
|
ENDM
|
|
|
|
|
|
ELSE
|
|
|
|
|
|
MACRO
|
|
BDPROCENTRY
|
|
FPROCENTRY
|
|
ENDM
|
|
|
|
MACRO
|
|
BDSETENV
|
|
FSETENV
|
|
ENDM
|
|
|
|
MACRO
|
|
BDSETXCP
|
|
FSETXCP
|
|
ENDM
|
|
|
|
MACRO
|
|
BDGETENV
|
|
FGETENV
|
|
ENDM
|
|
|
|
MACRO
|
|
BDGETHV
|
|
FGETHV
|
|
ENDM
|
|
|
|
IF &TRAPS THEN
|
|
IF &TYPE('InitMe') = 'UNDEFINED' THEN
|
|
INCLUDE 'Traps.a' ; already included in installer
|
|
ENDIF
|
|
IF &A68881 THEN
|
|
INCLUDE 'SANEMacs881.a'
|
|
ELSE
|
|
IF &TYPE('InitMe') = 'UNDEFINED' THEN
|
|
INCLUDE 'SANEMacs.a' ; already included in installer
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
|
|
SEG 'Humm' ; case sensitive
|
|
|
|
ENDIF
|
|
|
|
|
|
|
|
IF &BACKPATCH THEN
|
|
|
|
MACRO
|
|
BDFP68K
|
|
BSR FP68K
|
|
ENDM
|
|
|
|
MACRO
|
|
BDMULI
|
|
MOVE.W #$2004,-(SP)
|
|
BSR FP68K
|
|
ENDM
|
|
|
|
ELSE
|
|
|
|
MACRO
|
|
BDFP68K
|
|
_FP68K
|
|
ENDM
|
|
|
|
MACRO
|
|
BDMULI
|
|
FMULI
|
|
ENDM
|
|
|
|
ENDIF
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
;; PROCEDURE Num2Dec(f: decform;x: Extended;VAR d: decimal);
|
|
;; { d <-- x according to format f }
|
|
;; _____________________________________
|
|
;; | |
|
|
;; | address of df (decform) |
|
|
;; |_____________________________________|
|
|
;; | |
|
|
;; | address of x (extended) |
|
|
;; |_____________________________________|
|
|
;; | |
|
|
;; | address decimal record |
|
|
;; |_____________________________________|
|
|
;; | |
|
|
;; | return address |
|
|
;; |_____________________________________|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
|
|
|
|
dcAdN2D EQU 4*15 ;address decimal record address
|
|
exAdN2D EQU dcAdN2D+4 ;extended address
|
|
dfAdN2D EQU exAdN2D+4 ;address decform record address
|
|
MaxDigs EQU 19
|
|
|
|
EnvSave EQU -2 ; address of Environment
|
|
Env2 EQU -4 ; overlaps with MISCRec
|
|
MISCRec EQU -10 ; MISC record (for Halt Handler)
|
|
XTemp EQU -16 ; Intermediate location for Extended
|
|
|
|
IF &BACKPATCH THEN
|
|
QL2DEC:
|
|
ELSE
|
|
QL2DEC proc export
|
|
export QX2DEC
|
|
export QX2DEC2
|
|
|
|
export QDEC2X
|
|
export QDEC22X
|
|
|
|
EXPORT BIGD2X
|
|
EXPORT BIGX2S
|
|
ENDIF
|
|
|
|
IF &TRAPS THEN
|
|
|
|
export QI2DEC
|
|
export QC2DEC
|
|
export QS2DEC
|
|
export QD2DEC
|
|
export QDEC2L
|
|
export QDEC2I
|
|
export QDEC2C
|
|
export QDEC2S
|
|
export QDEC2D
|
|
movem.l A0-A4/D0-D7,-(SP) ; save registers
|
|
link a6,#-16
|
|
|
|
MOVE.W #FFLNG,d7
|
|
bra.s N2Dec
|
|
|
|
QI2DEC:
|
|
movem.l A0-A4/D0-D7,-(SP) ; save registers
|
|
link a6,#-16
|
|
|
|
MOVE.W #FFINT,d7
|
|
bra.s N2Dec
|
|
|
|
QC2DEC:
|
|
movem.l A0-A4/D0-D7,-(SP) ; save registers
|
|
link a6,#-16
|
|
|
|
MOVE.W #FFCOMP,d7
|
|
bra.s N2Dec
|
|
|
|
QS2DEC:
|
|
movem.l A0-A4/D0-D7,-(SP) ; save registers
|
|
link a6,#-16
|
|
|
|
MOVE.W #FFSGL,d7
|
|
bra.s N2Dec
|
|
|
|
QD2DEC:
|
|
movem.l A0-A4/D0-D7,-(SP) ; save registers
|
|
link a6,#-16
|
|
|
|
MOVE.W #FFDBL,d7
|
|
bra.s N2Dec
|
|
|
|
ENDIF
|
|
|
|
QX2DEC96: ; <SMcD 27aug90>
|
|
movem.l A0-A4/D0-D7,-(SP) ; save registers <SMcD 27aug90>
|
|
link a6,#-16 ; <SMcD 27aug90>
|
|
|
|
MOVEQ #$20,d7 ; d7 := FFEXT96 <SMcD 27aug90>
|
|
bra.s N2Dec ; <SMcD 27aug90>
|
|
|
|
QX2DEC2:
|
|
QX2DEC:
|
|
movem.l A0-A4/D0-D7,-(SP) ; save registers
|
|
link a6,#-16
|
|
|
|
IF &TRAPS THEN
|
|
|
|
MOVE.W #FFEXT,d7
|
|
|
|
N2Dec pea EnvSave(a6) ; push address to store environment
|
|
BDPROCENTRY ; procedure entry
|
|
bclr #7,FPState+1 ; clear NoRound's unused env bit '0080' <5/13/90-SMcD>
|
|
move.w EnvSave(a6),d3 ; put environment into D3
|
|
and.w #$6000,d3
|
|
beq.s @0 ; default rounding direction
|
|
|
|
move.w d3,Env2(a6) ; set rounding direction
|
|
pea Env2(a6)
|
|
BDSETENV
|
|
|
|
@0 move.l exAdN2D(a6),a3 ; save original source address in A3
|
|
* cmpi.w #FFEXT,d7 ; Écommented out (need fallthrough) <SMcD 27aug90>
|
|
* beq.s @1 ; Écommented out (need fallthrough) <SMcD 27aug90>
|
|
|
|
lea XTemp(a6),a0
|
|
move.l a0,exAdN2D(a6) ; move current dst to 'exAdN2D(a6)'
|
|
move.l a3,-(sp) ; put address of type onto stack
|
|
move.l a0,-(sp)
|
|
MOVE.W d7,-(SP) ; move op to stack
|
|
add.W #FOZ2X,(SP) ; move op to stack
|
|
BDFP68K
|
|
|
|
IF &A68881 THEN
|
|
move.l XTemp+6(a6),XTemp+8(a6)
|
|
move.l XTemp+2(a6),XTemp+4(a6)
|
|
ELSE
|
|
TST.B D7 ; 96-bit extended in temp? <SMcD 27aug90>
|
|
BEQ.S @1 ; no <SMcD 27aug90>
|
|
|
|
MOVE.L XTemp+4(A6),XTemp+2(A6) ; yes; convert to 80-bit format <SMcD 27aug90>
|
|
MOVE.L XTemp+8(A6),XTemp+6(A6) ; in place <SMcD 27aug90>
|
|
ENDIF
|
|
ENDIF
|
|
|
|
@1 movea.l dfAdN2D(a6),A1 ; get decform into D2
|
|
move.l (A1),D2
|
|
movea.l dcAdN2D(a6),A1 ; get address of decimal record
|
|
* movea.l exAdN2D(a6),A0 ; get address of x Éfallthru set it <SMcD 27aug90>
|
|
|
|
IF &A68881 THEN
|
|
move.L (a0)+,d0 ; get sign and exponent from memory
|
|
swap d0
|
|
ELSE
|
|
move.w (a0)+,d0 ; get sign and exponent from memory
|
|
ENDIF
|
|
clr.w (a1)
|
|
BCLR #15,D0 ; strip sign from exponent
|
|
beq.s @4
|
|
MOVE.b #1,(a1) ; set decimal sign
|
|
@4 move.L (a0)+,d4 ; get high 32 bits of extended from memory
|
|
move.L (a0),d5 ; get low 32 bits of extended from memory
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; ENUM TYPE: SET DEFAULT
|
|
; STRING LENGTH TO 1, USEFUL JUST BELOW AND LATER WHEN
|
|
; SCALED FIXED-PT RESULT OVERFLOWS TO '?'.
|
|
;-----------------------------------------------------------
|
|
MOVE.B #1,4(A1) ; LENGTH TO 1
|
|
|
|
;-----------------------------------------------------------
|
|
; NOW PICK OUT NAN, INF, ZERO CASES...
|
|
;-----------------------------------------------------------
|
|
cmp.w #$7fff,d0 ; d0 - $7fff
|
|
bne.s @10 ; zero denorm or normal
|
|
move.l d4,d0
|
|
ANDI.L #$7FFFFFFF,D0 ; test fractional part of significand
|
|
bne.s @28 ; NaN found
|
|
tst.l d5
|
|
bne.s @28 ; NaN found
|
|
MOVEQ #'I',D0 ; Infinity found
|
|
@16:
|
|
MOVE.B D0,5(A1) ; SAVE 1-CHAR FIELD
|
|
BRA BDFIN ; GO TO END OF CONVERSION
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
; CHECK FOR 0, INF, OR (GASP) AN HONEST NUMBER.
|
|
;-----------------------------------------------------------
|
|
@10:
|
|
TST.L D4 ; IF-SPECIAL-NUMBER
|
|
bne.S BD1 ; --> FINITE, NONZERO
|
|
TST.L D5 ; IF-SPECIAL-NUMBER
|
|
bne.S BD1 ; --> FINITE, NONZERO
|
|
|
|
MOVEQ #'0',D0 ; ASSUME IT'S ZERO
|
|
bra.s @16
|
|
|
|
@28
|
|
IF &TRAPS THEN
|
|
bset #30,d4 ; test for signaling NaN
|
|
bne.s @29 ; quiet NaN found
|
|
move.w #FBINVALID,-(SP)
|
|
pea (sp)
|
|
BDSETXCP
|
|
lea 2(sp),sp ; clean up stack
|
|
@29
|
|
ENDIF
|
|
|
|
;-----------------------------------------------------------
|
|
; PUT NXXXX... FOR 16 HEXITS OF A NAN, REGARDLESS OF FORMAT
|
|
; SINCE TRAILING ZEROS WILL BE STRIPPED LATER. NOTE THAT
|
|
; NAN STRUCT IS 22 BYTES LONG: 2 WORDS FOR SIGN AND EXP,
|
|
; AND 18 BYTES FOR LENGTH, N, AND 16 HEXITS.
|
|
;-----------------------------------------------------------
|
|
ADDQ.L #4,A1 ; POINT TO RESULT STRING
|
|
MOVE.B #17,(A1)+ ; LENGTH = N PLUS 2 SETS OF 8
|
|
MOVE.B #'N',(A1)+ ; FIRST CHAR
|
|
|
|
BSR.S @31 ; FIRST 8 HEXITS FROM D4
|
|
MOVE.L D5,D4 ; MOVE LOW 8 HEXITS
|
|
BSR.S @31 ; AND CONVERT
|
|
|
|
SUBA.W #22,A1 ; POINT TO HEAD OF STRUCT
|
|
BRA BDFIN
|
|
|
|
;-----------------------------------------------------------
|
|
; ROUTINE TO DISPLAY D4 IN 0-9, A-F.
|
|
;-----------------------------------------------------------
|
|
@31:
|
|
MOVEQ #8,D0 ; LOOP COUNT
|
|
@33:
|
|
ROL.L #4,D4 ; PRINT FROM HI TO LO
|
|
MOVEQ #$0F,D1 ; NIBBLE MASK
|
|
AND.B D4,D1 ; STRIP NIBBLE
|
|
OR.B #'0',D1 ; '0' IS $30
|
|
CMPI.B #'9',D1 ; HEX LETTER?
|
|
BLE.S @35
|
|
|
|
ADDQ.B #7,D1 ; TRANSLATE TO A-F
|
|
@35:
|
|
MOVE.B D1,(A1)+ ; STUFF CHARACTER
|
|
SUBQ.W #1,D0
|
|
BNE.S @33
|
|
RTS
|
|
|
|
;-----------------------------------------------------------
|
|
; NEED NORMALIZED FORM OF NUMBER (EVEN WHEN VALUE IS
|
|
; EXTENDED DENORMALIZED) IN ORDER TO COMPUTE
|
|
; FLOOR( LOG10 ( | X | ) ).
|
|
; AS EXPLAINED IN THE B-D PAPER, WE CAN APPROXIMATE
|
|
; LOG2 ( | X | ) BY EXP.FRAC .
|
|
; SO WE PUT THIS INFORMATION TOGETHER BEFORE STORING THE
|
|
; SIGNED EXTENDED VALUE AT THE TOP OF THE STACK FRAME (A3).
|
|
; FOR CONVENIENCE, THIS INFORMATION IS KEPT EVEN IN THE
|
|
; CASE OF FIXED CONVERSIONS, IN WHICH IT IS IRRELEVENT.
|
|
;-----------------------------------------------------------
|
|
BD1:
|
|
|
|
tst.l d4
|
|
bmi.s @2 ; x normal
|
|
|
|
@1 subq.w #1,d0 ; normalize x
|
|
add.l d5,d5
|
|
addx.l d4,d4
|
|
bpl.s @1 ; x denormal
|
|
|
|
@2 MOVE.L D4,D1 ; INTEGER-BIT.FRAC
|
|
MOVE.W D0,D1 ; EXP IN LOW WORD
|
|
SUBI.W #$3FFF,D1 ; UNBIAS EXP
|
|
SWAP D1 ; ALIGN EXP AND INT.FRAC
|
|
ADD.W D1,D1 ; FINALLY HAVE EXP.FRAC
|
|
|
|
|
|
MOVE.L #$4D104D42,D0 ; FLOOR( LOG10 (2) )
|
|
TST.L D1 ; EXP NEGATIVE?
|
|
BPL.S @7
|
|
|
|
ADDQ.W #1,D0 ; BUMP LOG TO ASSURE FLOOR
|
|
@7:
|
|
|
|
;-----------------------------------------------------------
|
|
; COMPUTE LOG10(2) * LOG2(X) INTO D4.W. THIS IS A 32*32
|
|
; SIGNED MULTIPLY SO CANNOT USE CORE ROUTINE OF THE MULT
|
|
; OPERATION. SINCE ONLY THE LEADING 16 BITS ARE OF
|
|
; INTEREST, IT IS NOT NECESSARY TO CARRY OUT THE LOW ORDER
|
|
; 16*16 PARTIAL PRODUCT. THE SCHEME IS:
|
|
;
|
|
; A B = D0 = FLOOR( LOG10 (2) ) > 0
|
|
; * X Y = D1 = FLOOR( LOG2 |X| )
|
|
; -------
|
|
; A--Y
|
|
; B--X
|
|
; + A--X
|
|
; ------------
|
|
; ???????? = D4.W, KEEPING ONLY 16 BITS
|
|
;-----------------------------------------------------------
|
|
MOVE.L D0,D4
|
|
SWAP D4 ; D4.W = A
|
|
MULU D1,D4 ; D4.L = A--Y
|
|
CLR.W D4
|
|
SWAP D4 ; D4.W = A--Y.HI
|
|
|
|
SWAP D1 ; D1.W = X
|
|
MOVE.W D1,D5
|
|
MULS D0,D5 ; D5.L = B--X
|
|
SWAP D5
|
|
EXT.L D5 ; D5.W = B--X.HI WITH SIGN
|
|
ADD.L D5,D4 ; CANNOT CARRY OR BORROW
|
|
|
|
SWAP D0 ; D0.W = A
|
|
MULS D1,D0 ; D0.L = A--X
|
|
ADD.L D0,D4
|
|
SWAP D4 ; D4.W = FLOOR(LOG10(X))
|
|
|
|
;-----------------------------------------------------------
|
|
; ADD 1 TO D4.W YIELDING THE NUMBER OF DIGITS LEFT OF THE
|
|
; DECIMAL POINT WHEN X IS WRITTEN OUT, A HANDY VALUE.
|
|
;-----------------------------------------------------------
|
|
|
|
;if (f.style = FloatDecimal) and (f.digits < 1) then f.digits := 1;
|
|
move.w d2,d1 ; contains decform.digits <30mar90>
|
|
|
|
bmi.s @8 ; <30mar90>
|
|
cmpi.w #$2000,d1 ; d1 - 8k <30mar90>
|
|
blt.s @9 ; <30mar90>
|
|
move.w #$2000,d1 ; <30mar90>
|
|
bra.s @9 ; <30mar90>
|
|
|
|
@8 cmpi.w #$e000,d1 ; d1 + 8k <30mar90>
|
|
bgt.s @9 ; <30mar90>
|
|
move.w #$e000,d1 ; <30mar90>
|
|
@9 ; <30mar90>
|
|
swap d2 ; contains decform.style
|
|
ror.w #8,d2 ; word --> byte
|
|
tst.b d2 ; nonzero --> fixed
|
|
bne.s loop
|
|
tst.w d1
|
|
bgt.s loop ; f.digts >= 0
|
|
moveq #1,d1 ; f.digits := 1
|
|
|
|
loop addq.w #1,d4 ; logx := logx + 1
|
|
move.w d1,d5 ; len := f.digits
|
|
tst.b d2 ; nonzero --> fixed
|
|
beq.s @1
|
|
add.w d4,d5 ; len := len + (logx + 1)
|
|
@1 cmpi.w #MaxDigs,d5 ; len - MaxDigs
|
|
ble.s @2
|
|
move.w #MaxDigs,d5 ; len := MaxDigs
|
|
@2 move.w d5,2(a1) ; d.exp := len
|
|
sub.w d4,2(a1) ; d.exp := d.exp - (logx + 1)
|
|
tst.w d5
|
|
bgt.s @3
|
|
moveq #1,d5 ; len := 1
|
|
|
|
@3 move.l exAdN2D(a6),-(sp)
|
|
move.l a1,-(sp)
|
|
|
|
move.b d5,4(a1) ; <klh 20aug90>, requested # of digits
|
|
|
|
jsr BIGX2S
|
|
|
|
cmp.b 4(a1),d5 ; len - length (d.sig)
|
|
bcs.s loop
|
|
|
|
neg.w 2(a1) ; d.exp := -d.exp
|
|
|
|
BDFIN
|
|
IF &TRAPS THEN
|
|
pea Env2(A6)
|
|
BDGETENV ; Get current environment.
|
|
move.w Env2(A6),d0 ; current environment word
|
|
andi.w #$1f00,d0 ; current exceptions
|
|
or.w d0,EnvSave(a6) ; set current exceptions in saved environment
|
|
; step one of cooked procexit
|
|
pea EnvSave(a6) ; push address of saved environment
|
|
BDSETENV ; step two of cooked procexit
|
|
|
|
ror.w #8,d0 ; align pending exceptions into halt position
|
|
and.w EnvSave(a6),d0 ; exceptions causing halts
|
|
beq.s NoHalts
|
|
|
|
move.l 4(a6),MISCRec+4(a6) ; original d0 saved on stack
|
|
move.w d0,MISCRec(a6) ; pending halt exceptions
|
|
|
|
pea MISCRec(a6)
|
|
move.l dfAdN2D(a6),-(sp) ; get decform
|
|
move.l a3,-(sp) ; get address of source
|
|
move.l dcAdN2D(a6),-(sp) ; get address of decimal record
|
|
move.w d7,-(sp) ; type
|
|
addi.w #FOB2D,(sp) ; add opcode to type
|
|
|
|
pea Env2(A6)
|
|
BDGETHV
|
|
move.l Env2(A6),a0
|
|
jsr (a0)
|
|
|
|
ENDIF
|
|
|
|
NoHalts
|
|
unlk a6
|
|
movem.l (sp)+,A0-A4/D0-D7 ; restore registers
|
|
move.l (sp),12(sp) ; move rts address to proper location
|
|
lea 12(sp),sp ; clean up stack
|
|
rts ; return
|
|
|
|
|
|
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
;; FUNCTION Dec2Num(d: decimal): Extended; { Dec2Num <-- d }
|
|
;; _____________________________________
|
|
;; | |
|
|
;; | d address decimal record |
|
|
;; |_____________________________________|
|
|
;; | |
|
|
;; | address of x (extended) |
|
|
;; |_____________________________________|
|
|
;; | |
|
|
;; | return address |
|
|
;; |_____________________________________|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
|
|
exAddr EQU 4*15 ; extended address
|
|
dcAddr EQU exAddr+4 ; address decimal record
|
|
MxDgs EQU 19 ; 'brain dead' limit for decimal point on decimal record
|
|
; input. Scheme is backwards compatible for previous
|
|
; routines
|
|
IF &TRAPS THEN
|
|
|
|
QDEC2L:
|
|
movem.l A0-A4/D0-D7,-(SP) ; save registers
|
|
link a6,#-16
|
|
|
|
MOVE.W #FFLNG,d7
|
|
MOVE.W #$6000,d0 ; mask for rounding direction
|
|
bra.s NoRound
|
|
|
|
QDEC2I:
|
|
movem.l A0-A4/D0-D7,-(SP) ; save registers
|
|
link a6,#-16
|
|
|
|
MOVE.W #FFINT,d7
|
|
MOVE.W #$6000,d0 ; mask for rounding direction
|
|
bra.s NoRound
|
|
|
|
QDEC2C:
|
|
movem.l A0-A4/D0-D7,-(SP) ; save registers
|
|
link a6,#-16
|
|
|
|
MOVE.W #FFCOMP,d7
|
|
MOVE.W #$6000,d0 ; mask for rounding direction
|
|
bra.s NoRound
|
|
|
|
QDEC2S:
|
|
movem.l A0-A4/D0-D7,-(SP) ; save registers
|
|
link a6,#-16
|
|
|
|
MOVE.W #FFSGL,d7
|
|
MOVE.W #$6040,d0 ; mask for rounding precision and direction
|
|
bra.s NoRound
|
|
|
|
QDEC2D:
|
|
movem.l A0-A4/D0-D7,-(SP) ; save registers
|
|
link a6,#-16
|
|
|
|
MOVE.W #FFDBL,d7
|
|
MOVE.W #$6060,d0 ; mask for rounding precision and direction
|
|
|
|
NoRound
|
|
pea EnvSave(a6) ; push address to store environment
|
|
BDPROCENTRY ; procedure entry
|
|
move.w EnvSave(a6),d3 ; put environment into D3
|
|
and.w d0,d3
|
|
or.w #$0080,FPState ; special bit to tell rounding routine <5/13/90-SMcD>
|
|
; to set sticky bit but don't round since
|
|
; FOX2Z will do the proper rounding, i.e.,
|
|
; this gimick avoids double rounding.
|
|
bra.s SetIt
|
|
|
|
ENDIF
|
|
|
|
QDEC2X96: ; <SMcD 27aug90>
|
|
movem.l A0-A4/D0-D7,-(SP) ; save registers <SMcD 27aug90>
|
|
link a6,#-16 ; <SMcD 27aug90>
|
|
|
|
MOVEQ #$20,D7 ; d7 := FFEXT96 <SMcD 27aug90>
|
|
MOVE.W #$6060,d0 ; <SMcD 27aug90>
|
|
BRA.S Dec2N ; continue below <SMcD 27aug90>
|
|
|
|
QDEC22X:
|
|
QDEC2X:
|
|
movem.l A0-A4/D0-D7,-(SP) ; save registers
|
|
link a6,#-16
|
|
|
|
IF &TRAPS THEN
|
|
|
|
MOVE.W #FFEXT,d7
|
|
MOVE.W #$6060,d0
|
|
|
|
Dec2N pea EnvSave(a6) ; push address to store environment
|
|
BDPROCENTRY ; procedure entry
|
|
bclr #7,FPState+1 ; clear NoRound's unused env bit '0080' <9/29/90-SMcD>
|
|
move.w EnvSave(a6),d3 ; prt environment into D3
|
|
and.w d0,d3
|
|
beq.s drpad ; default rounding precision and direction
|
|
|
|
SetIt move.w d3,Env2(a6) ; set rounding precision and direction
|
|
pea Env2(a6)
|
|
BDSETENV
|
|
|
|
drpad move.l exAddr(a6),a3 ; save orig. dest address in A3 <SMcD 27aug90>
|
|
cmpi.w #FFEXT96,d7 ; ext. result (80- or 96-bit?) <SMcD 27aug90>
|
|
ble.s @1 ; yes <SMcD 27aug90>
|
|
|
|
lea XTemp(a6),a0
|
|
move.l a0,exAddr(a6) ; move XTemp(a6) to 'exAdN2D(a6)'
|
|
|
|
@1
|
|
ENDIF
|
|
move.l dcAddr(a6),A2 ; get address of decimal record
|
|
LEA 4(A2),A4 ; PTR TO STRING
|
|
|
|
;-----------------------------------------------------------
|
|
; CLEAR OUT DIGIT ACCUMULATOR AND INITIALIZE COUNTERS.
|
|
;-----------------------------------------------------------
|
|
CLR.L D4 ; DIGIT BUFFER
|
|
MOVE.L D4,D5
|
|
|
|
MOVE.B (A4)+,D6 ; DIGIT STRING LENGTH COUNT
|
|
BEQ.S DBZSTO ; ZERO LENGTH --> 0.0
|
|
|
|
;-----------------------------------------------------------
|
|
; GET FIRST CHARACTER BUT DON'T AUTOINCREMENT.
|
|
;-----------------------------------------------------------
|
|
MOVE.B (A4),D0 ; FIRST CHAR
|
|
|
|
;-----------------------------------------------------------
|
|
; CHECK FOR 'I' -- INFINITY.
|
|
;-----------------------------------------------------------
|
|
CMPI.B #$49,D0 ; IS IT 'I'?
|
|
BEQ.S DBNFIN
|
|
|
|
;-----------------------------------------------------------
|
|
; CHECK FOR 'N', IF SO GET HEXITS FOR SIGNIFICAND. IF THERE
|
|
; ARE FEWER THAN THREE, FORCE LEAD ZEROS.
|
|
;-----------------------------------------------------------
|
|
CMPI.B #'N',D0 ; ALLOW ONLY CAPITAL N
|
|
BNE.S DBZER
|
|
|
|
MOVE.B -1(A4),D2 ; CHARACTER COUNT
|
|
ADDQ.L #1,A4 ; POINT TO FIRST HEXIT
|
|
SUBQ.B #1,D2 ; DON'T COUNT 'N'
|
|
|
|
MOVEQ #8,D0 ; ASSUME 8 DIGITS
|
|
CMPI.B #4,D2 ; OK IF AT LEAST 4
|
|
BGE.S @31
|
|
SUBQ.B #4,D0 ; FOUR 0'S AND WHAT'S THERE
|
|
ADD.B D2,D0
|
|
@31:
|
|
BSR.S @35
|
|
MOVE.L D5,D4
|
|
CLR.L D5
|
|
MOVEQ #8,D0
|
|
BSR.S @35
|
|
BRA.S @39
|
|
|
|
;-----------------------------------------------------------
|
|
; ROUTINE TO GET D0 DIGITS TO D5, UP TO COUNT IN D2
|
|
;-----------------------------------------------------------
|
|
@35:
|
|
ROL.L #4,D5 ; ALIGN BITS SO FAR
|
|
SUBQ.B #1,D2 ; DEC STRING COUNT
|
|
BMI.S @37
|
|
|
|
MOVE.B (A4)+,D1
|
|
CMPI.B #'9',D1
|
|
BLE.S @36
|
|
ADDI.B #9,D1 ; TRUE NIBBLE VALUE
|
|
@36:
|
|
ANDI.B #$0F,D1 ; NIBBLE MASK
|
|
OR.B D1,D5
|
|
@37:
|
|
SUBQ.W #1,D0
|
|
BNE.S @35
|
|
RTS
|
|
|
|
;-----------------------------------------------------------
|
|
; TEST FOR NONZERO NaN code.
|
|
;-----------------------------------------------------------
|
|
@39:
|
|
BSET #30,D4 ; MAKE IT QUIET <26MAR85>
|
|
move.l d4,d0
|
|
swap d0
|
|
andi.b #$ff,d0 ; test for zero NaN code
|
|
|
|
BNE.S DBNFIN ; non zero nan code, done
|
|
ori.w #$15,D0 ; insert Zero NaN code code
|
|
SWAP D0
|
|
move.l d0,d4
|
|
;-----------------------------------------------------------
|
|
; CONSTANT TO TWEAK NAN BIT IN HIGH LONG WORD OF SIG FIELD <26MAR85>
|
|
;-----------------------------------------------------------
|
|
;QNANBIT EQU 30 ; 1-QUIET 0-SIGNALING <26MAR85>
|
|
|
|
DBNFIN:
|
|
MOVE.W #$7FFF,D0 ; STORE HUGE EXP
|
|
BRA.S DBSSTO
|
|
|
|
;-----------------------------------------------------------
|
|
; GET HERE IF ALL DIGITS ZERO: FORCE SIGNED 0 AND STORE
|
|
;-----------------------------------------------------------
|
|
DBZER:
|
|
CMPI.B #$30,D0 ; IS IT '0'?
|
|
BNE.S SIGDIGS
|
|
DBZSTO:
|
|
CLR.L D0
|
|
DBSSTO:
|
|
;-----------------------------------------------------------
|
|
; DECIMAL.SGN ENUM TYPE TEST USES HI BYTE ONLY
|
|
;-----------------------------------------------------------
|
|
TST.B (A2) ; CHECK OPERAND SIGN
|
|
BEQ.S @1
|
|
BSET #15,D0
|
|
@1:
|
|
move.l exAddr(a6),A0
|
|
MOVE.W D0,(A0)+
|
|
MOVE.L D4,(A0)+
|
|
MOVE.L D5,(A0)
|
|
bra.s NoDigs
|
|
|
|
IF &Dec19 THEN
|
|
BrnDd ;save exponent, adjust exponent, call bigd2x, restore exponent
|
|
|
|
; move.l dcAddr(a6),A2 ; get address of decimal record
|
|
move.w 2(a2),-(sp) ; save original decimal.exp
|
|
|
|
moveq #0,d0
|
|
move.b d6,d0
|
|
subi.w #MxDgs,d0
|
|
sub.w d0,2(a2) ; adjust decimal.exp for brain dead 19 digit max
|
|
|
|
move.l exAddr(a6),-(sp)
|
|
move.l dcAddr(a6),-(sp)
|
|
jsr BIGD2X
|
|
|
|
move.w (sp)+,2(a2) ; restore original decimal.exp
|
|
bra.s NoDigs ; normal finish
|
|
ENDIF
|
|
|
|
SIGDIGS
|
|
|
|
IF &Dec19 THEN
|
|
cmpi.b #MxDgs,d6
|
|
bhi.s BrnDd
|
|
ENDIF
|
|
|
|
move.l exAddr(a6),-(sp)
|
|
move.l dcAddr(a6),-(sp)
|
|
jsr BIGD2X
|
|
|
|
NoDigs
|
|
|
|
IF &TRAPS THEN
|
|
|
|
cmpi.w #FFEXT96,d7 ; check DST format
|
|
blt.s @1 ; no conversion if 80-bit extended type
|
|
IF &A68881 THEN
|
|
move.l XTemp+4(a6),XTemp+2(a6)
|
|
move.l XTemp+8(a6),XTemp+6(a6)
|
|
ELSE
|
|
bgt.s @4 ; convert to non-extended format <SMcD 27aug90>
|
|
|
|
MOVE.L 6(A3),8(A3) ; 96-bit ext. is created in place <SMcD 27aug90>
|
|
MOVE.L 2(A3),4(A3) ; from 80-bit result <SMcD 27aug90>
|
|
bra.s @1 ; continue below <SMcD 27aug90>
|
|
|
|
@4: ; <SMcD 27aug90>
|
|
ENDIF
|
|
pea XTemp(a6)
|
|
move.l a3,-(sp) ; put address of dest onto stack
|
|
MOVE.W d7,-(SP) ; move op to stack
|
|
add.W #FOX2Z,(SP) ; move op to stack
|
|
BDFP68K
|
|
|
|
pea Env2(A6)
|
|
BDGETENV ; Get current environment.
|
|
move.w Env2(A6),d0 ; current environment word
|
|
btst #8,d0 ; test for invalid exception
|
|
beq.s @2 ; invalid not set
|
|
andi.w #$e1ff,d0 ; clear spurious exceptions
|
|
bra.s @3
|
|
|
|
@2 cmpi.w #FFSGL,d7 ; type - single type
|
|
ble.s @3 ; single, double or extended type
|
|
andi.w #$fdff,d0 ; clear underflow exception
|
|
bra.s @3
|
|
|
|
@1
|
|
pea Env2(A6)
|
|
BDGETENV ; Get current environment.
|
|
move.w Env2(A6),d0 ; current environment word
|
|
@3 andi.w #$1f00,d0 ; current exceptions
|
|
or.w d0,EnvSave(a6) ; set current exceptions in saved environment
|
|
; step one of cooked procexit
|
|
pea EnvSave(a6) ; push address of saved environment <SMcD 06sep90>
|
|
BDSETENV ; step two of cooked procexit <SMcD 06sep90>
|
|
|
|
ror.w #8,d0 ; align pending exceptions into halt position
|
|
and.w EnvSave(a6),d0 ; exceptions causing halts
|
|
beq.s NoHlts
|
|
|
|
move.l 4(a6),MISCRec+4(a6) ; original d0 saved on stack
|
|
move.w d0,MISCRec(a6) ; pending halt exceptions
|
|
|
|
pea MISCRec(a6)
|
|
suba.w #4,sp ; add garbage to stack
|
|
move.l dcAddr(a6),-(sp) ; get address of decimal record
|
|
move.l a3,-(sp) ; get address of destination
|
|
move.w d7,-(sp) ; type
|
|
addi.w #FOD2B,(sp) ; add opcode to type
|
|
|
|
pea Env2(A6)
|
|
BDGETHV
|
|
move.l Env2(A6),a0
|
|
jsr (a0)
|
|
|
|
ENDIF
|
|
|
|
NoHlts
|
|
unlk a6
|
|
movem.l (sp)+,A0-A4/D0-D7 ; restore registers
|
|
move.l (sp),8(sp) ; move rts address to proper location
|
|
lea 8(sp),sp ; clean up stack
|
|
rts ; return
|
|
|
|
|
|
BIGD2X:
|
|
bgSz equ 784 ; 780.1=(256*21)*(Ln(5)/Ln(2)/16)
|
|
lclSz equ 4*bgSz+160
|
|
ParamSize EQU 8 ; size of all the passed parameters
|
|
MinSpace EQU 3316 ; minimum stack space in bytes
|
|
rtnAd EQU 4*13 ; rtnAd(a6) contains the return address
|
|
s EQU rtnAd+4 ; s(a6) contains the address of string or decimal record
|
|
x EQU s+4 ; x(a6) contains the address of x
|
|
|
|
AAdr equ -4 ; contains the address of aReg
|
|
BAdr equ AAdr-4 ; contains the address of bReg
|
|
CAdr equ BAdr-4 ; contains the address of cReg
|
|
DAdr equ CAdr-4 ; contains the address of dReg
|
|
EAdr equ DAdr-4 ; contains the address of Environment
|
|
xreg equ EAdr-4 ; xReg(A6) address of xReg
|
|
areg equ xreg-16 ; aReg(A6) address of aReg
|
|
|
|
|
|
MoveM.L A1-A4/D0-D7,-(SP)
|
|
link a6,#-160
|
|
|
|
movea.L s(a6),a0
|
|
addq #2,a0
|
|
move.w (a0),D0 ; hi part of D0 never used!!
|
|
blt SigDiv
|
|
|
|
bsr SizeExt
|
|
bsr a2b
|
|
bsr StoD
|
|
move.L DAdr(A6),CAdr(A6)
|
|
bsr cXb2a
|
|
movea.L a1,a3
|
|
|
|
move.w #$4f,d6 ; 63 + 16
|
|
move.w d1,d2
|
|
movea.l a3,a2
|
|
@1 subi.w #16,d6 ; find first non zero word
|
|
move.w (a2)+,d0
|
|
bne.s @3 ; found first non zero word
|
|
dbra d2,@1
|
|
|
|
@2 addq.w #1,d6 ; find first bit
|
|
lsl.w #1,d0
|
|
@3 bpl.s @2 ; location of first bit not found
|
|
|
|
moveq #-1,d5 ; d5 < 0 => decimal to binary
|
|
bsr Roundit ; Roundit likes address of register in a3
|
|
|
|
move.w d1,d7
|
|
asl.w #4,d7 ; times 16 = number of bits
|
|
movea.L s(a6),a0
|
|
addq #2,a0
|
|
add.w (a0),d7
|
|
addi.w #$400e,d7 ; add extended bias
|
|
|
|
bsr StuffIt
|
|
|
|
tst.l d4
|
|
bmi.s @5
|
|
|
|
@4 subq.w #1,d7 ; decrement exponent
|
|
asl.l #1,d6
|
|
roxl.l #1,d5
|
|
roxl.l #1,d4
|
|
bpl.s @4
|
|
|
|
@5 move.l x(a6),a0
|
|
cmp.w #$7fff,d7 ; d7 - $7fff
|
|
bcc.s OverFlo
|
|
asl.w #1,d7
|
|
PICont asl.w (a0) ; put sign bit in 'X'
|
|
roxr.w #1,d7 ; put sign into exponent word
|
|
IF &A68881 THEN
|
|
swap d7
|
|
move.L d7,(a0)+ ; put sign and exponent into memory
|
|
ELSE
|
|
move.w d7,(a0)+ ; put sign and exponent into memory
|
|
ENDIF
|
|
move.L d4,(a0)+ ; put high 32 bits of extended into memory
|
|
move.L d5,(a0) ; put low 32 bits of extended into memory
|
|
|
|
bra DoneB2X
|
|
|
|
OverFlo
|
|
IF &TRAPS THEN
|
|
|
|
move.w #FBOFLOW,-(SP)
|
|
pea (sp)
|
|
BDSETXCP
|
|
move.w #FBINEXACT,(SP)
|
|
pea (sp)
|
|
BDSETXCP
|
|
lea 2(sp),sp ; clean up stack
|
|
|
|
pea EAdr(A6)
|
|
BDGETENV ; Get environment.
|
|
lea EAdr(A6),A4 ; A0 gets address of xreg(a6)
|
|
MOVE.W (A4),D2
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
BTST #14,D2 ; bit for +/-infinity rounding directions
|
|
BNE.S DnOrTZ ; DOWNWARD or TOWARDZERO
|
|
BTST #13,D2
|
|
BEQ.S RtrnInf ; TONEAREST
|
|
|
|
MOVE.L x(A6),A4 ; UPWARD
|
|
MOVE.W (A4),D2 ; contains sign and biased exponent
|
|
BPL.S RtrnInf ; + & UPWARD, bumpit
|
|
BRA.S RtrnMax ; - & UPWARD, don't bumpit
|
|
|
|
DnOrTZ BTST #13,D2 ; DOWNWARD or TOWARDZERO
|
|
BNE.S RtrnMax ; TOWARD-ZERO
|
|
MOVE.L x(A6),A4 ; x(A6) contains the address of x
|
|
MOVE.W (A4),D2 ; contains sign and biased exponent
|
|
BMI.S RtrnInf ; - & DOWNWARD, bumpit
|
|
; + & DOWNWARD, don't bumpit
|
|
RtrnMax move.w #$fffc,d7 ; return Max
|
|
moveq #-1,d4
|
|
moveq #-1,d5
|
|
bra.s PICont
|
|
|
|
ENDIF
|
|
RtrnInf move.w #$fffe,d7 ; return infinity
|
|
moveq #0,d4
|
|
moveq #0,d5
|
|
bra.s PICont
|
|
|
|
StuffIt moveq #0,d4 ; clear significand
|
|
moveq #0,d5 ; clear significand
|
|
moveq #0,d6 ; clear significand
|
|
tst.w d1
|
|
bgt.s @4
|
|
move.w (a3)+,d4 ; 1 significant word
|
|
swap d4
|
|
rts
|
|
|
|
@4 move.l (a3)+,d4 ; 2 or more significant words
|
|
subq.w #2,d1 ; d1 - 2
|
|
bgt.s @5
|
|
blt NormIt
|
|
move.w (a3)+,d5 ; 3 significant words
|
|
swap d5
|
|
rts
|
|
|
|
@5 move.l (a3)+,d5 ; 4 or more significant words
|
|
subq.w #2,d1 ; d1 - 2 (d1 - 4)
|
|
bgt.s @6
|
|
blt NormIt
|
|
move.w (a3)+,d6 ; 5 significant words
|
|
swap d6
|
|
rts
|
|
|
|
@6 move.l (a3)+,d6 ; 6 or more significant words
|
|
rts
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
DivWS move.w d1,d4 ; d4 := max {d1, d3} <klh 11apr90>
|
|
cmp.w d3,d1 ; d1 - d3 <klh 11apr90>
|
|
bge.s @1 ; d1 >= d3 ********* <klh 30may90> **********
|
|
move.w d3,d4 ; d4 := max {d1, d3} <klh 11apr90>
|
|
; @1 tst.w d2 ; <klh 02dec90> - removed <klh 02dec90> <T2>
|
|
@1 tst.w d4 ; <klh 02dec90> <T2>
|
|
beq.s RtDvWS ; only one word in A1 & A3 <klh 11apr90>
|
|
lea 2(a1),a2 ; <klh 11apr90>
|
|
lea 2(a3),a4 ; <klh 11apr90>
|
|
moveq #0,d2 ; <klh 11apr90>
|
|
@2 addq.w #1,d2 ; <klh 11apr90>
|
|
cmp.w d2,d1 ; d1 - d2 <klh 11apr90>
|
|
bge.s @3 ; d1 >= d2, don't clear (a2) <klh 11apr90>
|
|
clr.w (a2) ; <klh 11apr90>
|
|
@3 cmp.w d2,d3 ; d3 - d2 <klh 11apr90>
|
|
bge.s @4 ; d3 >= d2, don't clear (a4) <klh 11apr90>
|
|
clr.w (a4) ; <klh 11apr90>
|
|
@4 cmpm.w (a4)+,(a2)+ ; <klh 11apr90>
|
|
bne.s RtDvWS ; <klh 11apr90>
|
|
cmp.w d2,d4 ; d4 - d2 <klh 11apr90>
|
|
bgt.s @2 ; d4 > d2, keep looking <klh 11apr90>
|
|
bra.s RtDvWS ; note: condition code will be Z, values identical
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
SigDiv bsr SizeExtN
|
|
bsr StoD ; D3.w = # words - 1 in (A3)
|
|
bsr Nrmlz10 ; D7.w = # bits to the right of (A1) word
|
|
movea.l a4,a3 ; a4 set by StoD
|
|
|
|
moveq #4,d6 ; D6.W + 1 = # of DIVU steps required
|
|
CMP.W (A3),D0 ; DO - (A3)
|
|
beq.s DivWS ; need further investigation <klh 11apr90>
|
|
RtDvWS Bhi.S @1 ; Divide will succeed, no padding necessary <11apr90>
|
|
ADDQ.w #1,D3 ; append a zero word to A3
|
|
CLR.W -(A3)
|
|
moveq #5,d6 ; D6.W + 1 = # of DIVU steps required
|
|
|
|
@1 move.w d3,d2
|
|
asl.w #4,d2 ; times 16
|
|
sub.w d7,d2
|
|
addi.w #$3FFE,d2 ; add extended bias
|
|
move.w d2,-(SP) ; (d3*16 - d7) + $3FFE -> stack
|
|
|
|
bsr BgnDiv
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; MakeX transforms contents of software register in a3 (d1.w = length)
|
|
; into and extended value in D0.W (sign & exponent) &
|
|
; D4/D5 (64-bit significand).
|
|
; first the register is rounded and checked for overflow and underflow
|
|
|
|
;
|
|
; find leading significant bit
|
|
;
|
|
moveq #0,d6 ;
|
|
move.w (a3),d0
|
|
bra.s @3
|
|
|
|
@2 addq.w #1,d6 ; find first bit
|
|
lsl.w #1,d0
|
|
@3 bpl.s @2 ; location of first bit not found
|
|
|
|
move.w (SP)+,d7
|
|
move.l d7,a1 ; Roundit DOESN'T USE a1
|
|
sub.w d6,d7 ; if negative, necessary '0' bits appended to left
|
|
bmi.s Dnrml
|
|
|
|
addi.w #63,d6 ; <klh 11apr90>
|
|
|
|
moveq #-1,d5 ; d5 < 0 => decimal to binary
|
|
bsr Roundit ; Roundit likes address of register in a3
|
|
|
|
move.l a1,d7
|
|
|
|
bsr.s StuffIt
|
|
|
|
NormIt tst.l d4
|
|
bmi.s @2
|
|
|
|
@1 subq.w #1,d7 ; decrement exponent
|
|
asl.l #1,d6
|
|
roxl.l #1,d5
|
|
roxl.l #1,d4
|
|
bpl.s @1
|
|
|
|
@2 move.l x(a6),a0
|
|
asl.w #1,d7
|
|
asl.w (a0) ; put sign bit in 'X'
|
|
roxr.w #1,d7 ; put sign into exponent word
|
|
IF &A68881 THEN
|
|
swap d7
|
|
move.L d7,(a0)+ ; put sign and exponent into memory
|
|
ELSE
|
|
move.w d7,(a0)+ ; put sign and exponent into memory
|
|
ENDIF
|
|
move.L d4,(a0)+ ; put high 32 bits of extended into memory
|
|
move.L d5,(a0) ; put low 32 bits of extended into memory
|
|
|
|
bra DoneB2X
|
|
|
|
NeedWrd tst.w d0
|
|
bge.s @1
|
|
clr.w -(a3)
|
|
addq #1,d1
|
|
addi.w #16,d6
|
|
subi.w #16,d7
|
|
addi.w #16,d0
|
|
@1 rts
|
|
|
|
Dnrml move.l a1,d0
|
|
cmpi.w #-66,d0 ; iscale(a6) - (-66)
|
|
bpl.s @0 ; not an extreme denormalized case
|
|
move.w #-66,d7
|
|
move.w d7,d0
|
|
sub.w d6,d7
|
|
|
|
@0 add.w d7,d6
|
|
bsr.s NeedWrd
|
|
bsr.s NeedWrd
|
|
bsr.s NeedWrd
|
|
bsr.s NeedWrd
|
|
bsr.s NeedWrd
|
|
addi.w #63,d6
|
|
|
|
move.w d0,-(SP)
|
|
moveq #-1,d5 ; d5 < 0 => decimal to binary
|
|
movea.l a3,a1 ; save a3
|
|
bsr Roundit ; Roundit likes address of register in a3
|
|
movea.l a1,a3 ; restore a3
|
|
|
|
move.w (SP)+,d7
|
|
|
|
bsr StuffIt
|
|
|
|
tst.l d4
|
|
bmi.s @2
|
|
|
|
@1 tst.w d7
|
|
ble.s @2 ; min exponent, no further normalization
|
|
subq.w #1,d7 ; decrement exponent
|
|
asl.l #1,d6
|
|
roxl.l #1,d5
|
|
roxl.l #1,d4
|
|
bpl.s @1
|
|
|
|
@2 move.l x(a6),a0
|
|
asl.w #1,d7
|
|
asl.w (a0) ; put sign bit in 'X'
|
|
roxr.w #1,d7 ; put sign into exponent word
|
|
IF &A68881 THEN
|
|
swap d7
|
|
move.L d7,(a0)+ ; put sign and exponent into memory
|
|
ELSE
|
|
move.w d7,(a0)+ ; put sign and exponent into memory
|
|
ENDIF
|
|
move.L d4,(a0)+ ; put high 32 bits of extended into memory
|
|
move.L d5,(a0) ; put low 32 bits of extended into memory
|
|
|
|
IF &TRAPS THEN
|
|
|
|
; Note: any power of ten that turns a pascal string into a denormalized
|
|
; number will not do it exactly. Therefore it is not necessary to check
|
|
; for inexact. All denormalized results cause underflow in Decimal to Binary
|
|
|
|
tst.L d4
|
|
bmi.s noUF ; not denormalized
|
|
move.w #FBUFLOW,-(SP)
|
|
pea (sp)
|
|
FSETXCP
|
|
move.w #FBINEXACT,(SP)
|
|
pea (sp)
|
|
FSETXCP
|
|
lea 2(sp),sp ; clean up stack
|
|
|
|
|
|
ENDIF
|
|
|
|
noUF bra DoneB2X
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
StoD moveq #0,d3 ; initialize length
|
|
move.L DAdr(A6),A3
|
|
subq.l #2,a3 ; starting address of integer
|
|
clr.w (A3)+ ; clear initial word for integer
|
|
MOVE.L s(A6),A0 ; s(A6) contains the address of decimal record
|
|
MOVE.L x(A6),A4 ; address of x for directed roundings
|
|
;-----------------------------------------------------------
|
|
; DECIMAL.SGN ENUM TYPE TEST USES HI BYTE ONLY
|
|
;-----------------------------------------------------------
|
|
TST.B (A0) ; CHECK OPERAND SIGN
|
|
BEQ.S @10
|
|
BSET.B #7,(a4) ; store decimal.sig in x for directed roundings
|
|
bra.s @11
|
|
|
|
@10 BCLR.B #7,(a4) ; store decimal.sig in x for directed roundings
|
|
|
|
@11 addq.L #4,A0 ; address of decimal.sig
|
|
moveq #0,d0
|
|
move.b (a0)+,d0 ; length of string
|
|
bra.s @3
|
|
;
|
|
; Loop through string, successively multiplying by 10 and adding
|
|
; in the low nibble of the character.
|
|
;
|
|
@1 MOVEQ #$0F,D7
|
|
AND.B (A0)+,D7 ; GET LOW NIBBLE
|
|
movea.l a3,a4
|
|
move.w d3,d4
|
|
|
|
@2 move.w -(a4),d6 ; get word for multiply
|
|
mulu #10,d6
|
|
add.l d6,d7 ; add previous overflow or decimal digit
|
|
move.w d7,(a4) ; move word back into memory register
|
|
clr.w d7 ; clear non overflow part
|
|
swap d7 ; put overflow part in low word
|
|
dbra d4,@2 ; condition codes not affected
|
|
|
|
beq.s @3
|
|
move.w d7,-(a4) ; add new word to memory register
|
|
addq.w #1,d3
|
|
|
|
@3 dbra d0,@1
|
|
rts
|
|
|
|
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
; Binary to String routines modified from JTC's BINDEC.a
|
|
; procedure BigX2S (var x: extended; iscale: integer; var s: string);
|
|
;
|
|
;;
|
|
;;
|
|
;; _________________________________________________________________
|
|
;;
|
|
;; after 'Link' instruction the stack should look like:
|
|
;;
|
|
;; _____________________________________
|
|
;; | |
|
|
;; | address of x (extended)|
|
|
;; |_____________________________________|
|
|
;; | |
|
|
;; | s address decimal record |
|
|
;; |_____________________________________|
|
|
;; | |
|
|
;; | return address |
|
|
;; |_____________________________________|
|
|
;; | |
|
|
;; | address (20 bytes) |
|
|
;; |_____________________________________|
|
|
;; | |
|
|
;; | xreg (12 bytes) |
|
|
;; |_____________________________________|
|
|
;; | |
|
|
;; | areg (1456 bytes) |
|
|
;; |_____________________________________|
|
|
;; | |
|
|
;; | breg (728 bytes) |
|
|
;; |_____________________________________|
|
|
;; | |
|
|
;; | creg (728 bytes) |
|
|
;; |_____________________________________|
|
|
;; | |
|
|
;; | dreg (108 bytes) |
|
|
;; |_____________________________________|
|
|
;;
|
|
;; _________________________________________________________________
|
|
;;
|
|
;-----------------------------------------------------------
|
|
;-----------------------------------------------------------
|
|
|
|
BIGX2S
|
|
MoveM.L A1-A4/D0-D7,-(SP)
|
|
link a6,#-160
|
|
|
|
movea.L s(a6),a0
|
|
addq #2,a0
|
|
move.w (a0),D0 ;hi part of D0 never used!!
|
|
|
|
ble.s DivCase
|
|
|
|
bsr SizeExt
|
|
bsr XbyA
|
|
bra.s MStr
|
|
|
|
DivCase bsr SizeExtN
|
|
bsr GetX
|
|
bsr DivX
|
|
moveq #0,d5 ; d5 >= 0 => binary to decimal
|
|
bsr Roundit
|
|
|
|
MStr bsr MakeStr
|
|
|
|
Done UNLK A6 ; destroy the link
|
|
MoveM.L (SP)+,A1-A4/D0-D7 ; restore registers & return address
|
|
MOVEA.L (SP)+,A0 ; pull off the return address
|
|
LEA ParamSize(SP),SP ; strip all of the caller's parameters
|
|
JMP (A0) ; return to the caller
|
|
|
|
DoneB2X ; special backend to check for rounding precision
|
|
IF &TRAPS THEN
|
|
pea EAdr(A6)
|
|
BDGETENV ; Get environment.
|
|
lea EAdr(A6),A0 ; A0 gets address of EAdr(a6)
|
|
MOVE.W (A0),D4
|
|
andi.w #$0060,d4 ; check for rounding precision
|
|
beq.s Done
|
|
|
|
pea Tbl1 ; address of integer value 1
|
|
MOVE.L x(a6),-(SP) ; push address of extended
|
|
BDMULI ; forces rounding precision control
|
|
|
|
; Now, since the 68881/2 can produce unnormal results
|
|
; when a single precision denormal result occurs,
|
|
; we must do a second multiply with precision control off.
|
|
; However, since the first multiply may have caused exceptions
|
|
; we cannot simlpy set the environment to default, but must
|
|
; only turn of precision control. ProcExit will restore it.
|
|
|
|
|
|
pea EAdr(A6)
|
|
BDGETENV ; Get environment.
|
|
lea EAdr(A6),A0 ; A0 gets address of EAdr(a6)
|
|
MOVE.W (A0),D4
|
|
andi.w #$ff9f,d4 ; turn off rounding precision
|
|
MOVE.W D4,(A0)
|
|
pea EAdr(A6)
|
|
BDSETENV
|
|
|
|
pea Tbl1 ; address of integer value 1
|
|
MOVE.L x(a6),-(SP) ; push address of extended
|
|
BDMULI ; forces normalization
|
|
|
|
ENDIF
|
|
|
|
bra.s Done
|
|
|
|
|
|
|
|
MakeStr movea.L CAdr(A6),A1 ; initialize bcd string address
|
|
CLR.L (A1) ; initialize string
|
|
MOVEQ #0,D3 ; initialize bcd string length
|
|
TST.W D6
|
|
MOVE.L A1,A2
|
|
BMI.s RtnZero
|
|
|
|
ADDQ.W #1,D1
|
|
BinLoop MOVEQ #15,D5
|
|
CMP.W D5,D6 ; D6 - D5
|
|
BGE.S @2
|
|
MOVE.W D6,D5
|
|
|
|
@2 SUBQ.W #1,D1 ; decrement number of words remaining
|
|
BLT.S bcdAddr
|
|
MOVE.W (A3)+,D2
|
|
|
|
bcdAddr MOVE.L A1,A2 ; reset bcd string address
|
|
ADD.W D2,D2 ; generate X if appropriate
|
|
MOVE.L D3,D7
|
|
LEA 4(A2),A2
|
|
@5 MOVE.L -(A2),D0 ; put long word of string into D0
|
|
ABCD D0,D0
|
|
ROR.L #8,D0
|
|
ABCD D0,D0
|
|
ROR.L #8,D0
|
|
ABCD D0,D0
|
|
ROR.L #8,D0
|
|
ABCD D0,D0
|
|
ROR.L #8,D0
|
|
MOVE.L D0,(A2) ; put it back
|
|
DBRA D7,@5 ; end of long word string loop
|
|
|
|
MOVEQ #0,D0
|
|
ABCD D0,D0
|
|
BEQ.S @6 ; no X condition found
|
|
ADDQ.L #1,D3 ; add new long word to string
|
|
MOVE.L D0,-(A2)
|
|
@6 DBRA D5,bcdAddr
|
|
SUBI.W #16,D6 ; number of binary digits - 1 remaining
|
|
BGE.S BinLoop
|
|
|
|
MOVE.L s(A6),A0 ; s(A6) contains the address of decimal record
|
|
addq #4,a0 ; address of string
|
|
LEA 1(A0),A1 ; pointer to string of characters
|
|
moveq.l #0,d5 ; <klh 20aug90>
|
|
move.b (a0),d5 ; <klh 20aug90>
|
|
;
|
|
; The hard part is delivering the ascii digits, stripping leading
|
|
; zeros. Use D6 as a marker: if minus then skipping leading zeros; if
|
|
; plus print any digit.
|
|
;
|
|
@7 BSR.S BD1OUT
|
|
BSR.S BD1OUT
|
|
BSR.S BD1OUT
|
|
BSR.S BD1OUT
|
|
DBRA D3,@7 ; end of long word string loop
|
|
|
|
;
|
|
; Finally, stuff the string length, restore the registers, and exit.
|
|
; A0 points to the length byte, A1 points to the next character after
|
|
; the string; so (A1 - A0 - 1) is the true length.
|
|
;
|
|
;BDFIN
|
|
MOVE.W A1,D0
|
|
SUB.W A0,D0
|
|
SUBQ.B #1,D0
|
|
BEQ.S RtnZero
|
|
MOVE.B D0,(A0)
|
|
RTS
|
|
|
|
RtnZero MOVE.L s(A6),A0 ; s(A6) contains the address of decimal record
|
|
addq #4,a0
|
|
MOVE.W #$0130,(A0) ; Return the following string, '0'
|
|
RTS
|
|
|
|
;
|
|
; Utility routine to print two digits from nibbles in D1, skipping
|
|
; leading zeros, according to sign of D6. Recall that ascii digits
|
|
; have the hex form $3x.
|
|
;
|
|
BD1OUT
|
|
MOVEQ #0,D1
|
|
MOVE.B (A2)+,D1
|
|
ROR.W #4,D1 ; ALIGN D1: $0000L00H
|
|
BSR.S BD1DIGOUT
|
|
ROL.W #4,D1 ; ALIGN D1: $0000000L
|
|
; FALL THROUGH AND RETURN
|
|
;
|
|
; Place a character from D1.B into the string (A1).
|
|
; Skip a leading 0 if D6.W is negative.
|
|
;
|
|
BD1DIGOUT
|
|
TST.W D6
|
|
BPL.S BDDOIT
|
|
|
|
TST.B D1 ; 0 NIBBLE?
|
|
BEQ.S BDSKIPIT
|
|
|
|
MOVEQ #0,D6 ; MARK NONZERO FOUND
|
|
BDDOIT
|
|
|
|
subq.l #1,d5 ; <klh 20aug90, last valid location - length (d.sig)>
|
|
bmi.s @1 ; <klh 20aug90>
|
|
ORI.B #$30,D1 ; MAKE ASCII DIGIT
|
|
MOVE.B D1,(A1) ; <klh 20aug90>
|
|
@1 addq.l #1,a1 ; <klh 20aug90>
|
|
SUB.B D1,D1 ; CLEAR FOR NEXT ROTATE
|
|
BDSKIPIT
|
|
RTS
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
XbyA movea.L s(a6),a0
|
|
addq #2,a0
|
|
move.w (a0),D6 ; d.exp
|
|
MOVE.L x(A6),A0 ; x(A6) contains the address of x
|
|
IF &A68881 THEN
|
|
MOVE.L (A0)+,D7 ; contains sign and biased exponent
|
|
SWAP D7 ; FP 6888x version
|
|
ELSE
|
|
MOVE.W (A0)+,D7 ; contains sign and biased exponent
|
|
ENDIF
|
|
BCLR.L #15,D7 ; test and clear sign bit
|
|
SUBI.W #$403f,D7 ; subtract extended (bias + 64)
|
|
ADD.W D6,D7 ; location of binary point to the right
|
|
|
|
MOVE.W (A0)+,D3 ; contains 1st word of significand
|
|
MOVE.W (A0)+,D4 ; contains 2nd word of significand
|
|
MOVE.W (A0)+,D5 ; contains 3rd word of significand
|
|
MOVE.W (A0)+,D6 ; contains 4th word of significand
|
|
movea.L AAdr(A6),A3
|
|
adda.L #16,A3
|
|
movea.L AAdr(A6),A1
|
|
subq.L #2,A1
|
|
movea.L CAdr(A6),A4
|
|
subq.L #2,A4 ; use this as a scratch location to assist ADDX
|
|
|
|
MOVE.W (A1),D0
|
|
MOVE.W D0,D2
|
|
MULU D6,D2
|
|
MOVE.L D2,(A3) ; A3
|
|
|
|
MOVE.W D0,D2
|
|
MULU D4,D2
|
|
MOVE.L D2,-(A3) ; A3-4
|
|
CLR.w -(A3) ; A3-6 clears high word
|
|
LEA 4(A3),A3 ; A3-2
|
|
|
|
MOVE.W D0,D2
|
|
MULU D5,D2
|
|
ADD.L D2,(A3) ; A3-2
|
|
|
|
MULU D3,D0
|
|
MOVE.L D0,(A4)+ ; Silly but necessary
|
|
ADDX.L -(A4),-(A3) ; A3-6
|
|
|
|
MOVE.L D1,A2 ; save length & use D1 as loop counter
|
|
SUBQ.W #1,D1
|
|
BMI.s @2
|
|
|
|
@1 LEA 4(A3),A3 ; A3-2
|
|
MOVE.W -(A1),D0
|
|
MOVE.W D0,D2
|
|
MULU D6,D2
|
|
ADD.L D2,(A3) ; A3-2
|
|
|
|
MOVE.W D0,D2
|
|
MULU D4,D2
|
|
MOVE.L D2,(A4)+ ; Silly but necessary
|
|
ADDX.L -(A4),-(A3); A3-6
|
|
bcc.s @98
|
|
MOVE.w #1,-(A3) ; A3-8 clears high word
|
|
BRA.S @99
|
|
@98 MOVE.w #0,-(A3) ; A3-8 clears high word
|
|
@99 LEA 4(A3),A3 ; A3-4
|
|
|
|
MOVE.W D0,D2
|
|
MULU D5,D2
|
|
ADD.L D2,(A3) ; A3-4
|
|
|
|
MULU D3,D0
|
|
MOVE.L D0,(A4)+ ; Silly but necessary
|
|
ADDX.L -(A4),-(A3) ; A3-8
|
|
|
|
DBRA D1,@1
|
|
|
|
@2 MOVE.L A2,D1 ; restore length of loop
|
|
ADDQ.w #4,D1 ; number of words
|
|
MOVE.W D1,D6
|
|
ADDQ.w #1,D6
|
|
ASL.W #4,D6 ; # bits = 16 * # words
|
|
ADD.W D7,D6 ; # number of integer bits
|
|
moveq #0,d5 ; d5 >= 0 => binary to decimal
|
|
|
|
Roundit
|
|
TST.W D6
|
|
bge.s @2 ; at least one digit to the left of binary point
|
|
;
|
|
; Make sure at least one digit is to the left of the binary point
|
|
;
|
|
cmpi.w #-66,d6 ; d6 + 66
|
|
bpl.s @1
|
|
move.w #-66,d6
|
|
@1 clr.w -(a3) ; add zero word
|
|
addQ.w #1,D1 ; adjust length (number of words)
|
|
addI.W #16,D6 ; number - 1 of bits left of the binary point
|
|
blt.s @1 ; no digits to the left of binary point
|
|
|
|
@2 BSR RndStk
|
|
TST.W D5
|
|
BEQ @8 ; no round or sticky => no rounding
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;
|
|
; Determines if least significant bit is set
|
|
; sets lsb of D5 if lsb of significand is set
|
|
; D3 = bit location in word (A2) of lsb
|
|
|
|
MOVE.W D6,D2
|
|
LSR.W #4,D2 ; divide by 16, (round bit word location)
|
|
LSL.W #1,D2 ; multiply by 2, to obtain byte offset
|
|
LEA 0(A3,D2.W),A2
|
|
MOVE.W (A2),D4 ; put word into D4 reg for BTST
|
|
MOVE.W D6,D3 ; # of bits in significand
|
|
ANDI.W #15,D3 ; location of round bit within word
|
|
MOVE.W #$8000,D0 ; initialize mask
|
|
ROR.W D3,D0 ; align mask to round bit
|
|
AND.W D0,D4
|
|
BEQ.S @3 ; least significant bit clear
|
|
ADDQ.W #1,D5
|
|
@3
|
|
|
|
IF &TRAPS THEN
|
|
move.w #FBINEXACT,-(sp)
|
|
pea (sp)
|
|
BDSETXCP
|
|
lea 2(sp),sp ; clean up stack
|
|
|
|
pea EAdr(A6)
|
|
BDGETENV ; Get environment.
|
|
lea EAdr(A6),A0 ; A0 gets address of environment
|
|
MOVE.W (A0),D2
|
|
|
|
bclr #7,d2 ; prepare to copy bit <5/14/90-SMcD>
|
|
tst.b FPState+1 ; is NoRound's unused env bit '0080' set? <5/14/90-SMcD>
|
|
bpl.s @90 ; if not, skip next instruction <1/25/91-klh><T2>
|
|
bset #7,d2 ; <5/14/90-SMcD>
|
|
@90 ; <5/14/90-SMcD>
|
|
move.w d2,d4
|
|
and.w #$00e0,d4 ; check for rounding precision or type coercion '0080'
|
|
beq.s @91
|
|
or.W D0,(A2) ; or in sticky bit
|
|
bra.s @8
|
|
|
|
@91 BTST #14,D2 ; bit for +/-infinity rounding directions
|
|
BNE.S @10 ; DOWNWARD or TOWARDZERO
|
|
BTST #13,D2
|
|
BNE.S @11 ; UPWARD
|
|
ENDIF
|
|
|
|
CMP.W #5,D5 ; D5 - 5
|
|
BLT.S @8 ; no rounding
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;
|
|
; Increment the significand (BumpIt)
|
|
|
|
@4 ADD.W D0,(A2) ; test for least significant bit
|
|
BCC.S @8
|
|
|
|
@5 cmpa.L A2,A3
|
|
beq.s @6 ; register overflowed
|
|
ADDQ.W #1,-(A2)
|
|
BCS.S @5
|
|
bra.s @8
|
|
|
|
; MAKE SURE THIS GETS EXCERCISED ALL FOUR WAYS (bin <--> dec & mul | div)
|
|
|
|
@6 move.w #1,-(a3) ; add overflow word
|
|
addQ.w #1,D1 ; adjust length (number of words)
|
|
addI.W #16,D6 ; number - 1 of bits left of the binary point
|
|
lea 16(a1),a1 ; for DivD case
|
|
|
|
@8 TST.W (A3)
|
|
BNE.S @9
|
|
LEA 2(A3),A3 ; location of first word - 1
|
|
SUBQ #1,D1 ; number of words
|
|
SUBI.W #16,D6 ; number - 1 of bits left of the binary point
|
|
@9 RTS
|
|
|
|
@10 BTST #13,D2 ; DOWNWARD or TOWARDZERO
|
|
BNE.S @8 ; TOWARD-ZERO
|
|
MOVE.L x(A6),A4 ; x(A6) contains the address of x
|
|
MOVE.W (A4),D2 ; contains sign and biased exponent
|
|
BMI.S @4 ; - & DOWNWARD, bumpit
|
|
BRA.S @8 ; + & DOWNWARD, don't bumpit
|
|
|
|
@11 MOVE.L x(A6),A4 ; UPWARD
|
|
MOVE.W (A4),D2 ; contains sign and biased exponent
|
|
BPL.S @4 ; + & UPWARD, bumpit
|
|
BRA.S @8 ; - & UPWARD, don't bumpit
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;
|
|
; Determines if round or sticky bits exist
|
|
; D5 = 0 => no round & no sticky
|
|
; D5 = 2 => no round & sticky
|
|
; D5 = 4 => round & no sticky
|
|
; D5 = 6 => round & sticky
|
|
|
|
RndStk clr.w d5 ; initialize D5
|
|
MOVE.W D6,D3 ; # of bits in significand
|
|
ADDQ.W #1,D3 ; round bit location w.r.t. left of significand
|
|
MOVE.L D3,D4
|
|
LSR.W #4,D4 ; divide by 16, (round bit word location)
|
|
CMP.W D1,D4 ; D4 - D1
|
|
BLE.S @1
|
|
RTS ; no round or sticky bits, no rounding
|
|
|
|
@1 ANDI.W #15,D3 ; location of round bit within word
|
|
MOVE.W #$8000,D0 ; initialize mask
|
|
ROR.W D3,D0 ; align mask to round bit
|
|
MOVE.W D4,D2
|
|
LSL.W #1,D2 ; multiply by 2, to obtain byte offset
|
|
LEA 0(A3,D2.W),A2
|
|
AND.W (A2),D0 ; test for round bit
|
|
BEQ.S @2 ; no round bit found
|
|
MOVEQ #4,D5
|
|
|
|
@2 MOVE.W #$7FFF,D0 ; initialize mask
|
|
LSR.W D3,D0 ; align mask to sticky bits
|
|
AND.W (A2)+,D0 ; test for sticky bits
|
|
BEQ.S @5 ; sticky bits not found yet
|
|
@3 ADDQ.W #2,D5
|
|
RTS
|
|
|
|
@4 TST.W (A2)+
|
|
BNE.S @3 ; sticky bit found
|
|
@5 ADDQ.W #1,D4
|
|
CMP.W D1,D4 ; D4 - D1
|
|
BLE.S @4 ; keep looking for sticky bits
|
|
RTS ; no sticky bits found
|
|
|
|
GetX MOVE.L x(A6),A0 ; x(A6) contains the address of x
|
|
IF &A68881 THEN
|
|
MOVE.L (A0)+,D6 ; contains sign and biased exponent
|
|
SWAP D6 ; FP 6888x version
|
|
ELSE
|
|
MOVE.W (A0)+,D6 ; contains sign and biased exponent
|
|
ENDIF
|
|
BCLR.L #15,D6 ; test and clear sign bit
|
|
SUBI.W #$400C,D6 ; adjusted location of binary point
|
|
movea.L DAdr(A6),A3
|
|
suba.w #52,A3
|
|
MOVE.L (A0)+,(A3) ; get significand of extended
|
|
MOVE.L (A0)+,4(A3) ; get significand of extended
|
|
MOVEQ #3,D3 ; initial length of D3
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;
|
|
; Extended input located at (A3), length of D3 + 1 words,
|
|
; binary point D6 bits to the right of word (A3)
|
|
;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;
|
|
; We must first normalize the power of ten.
|
|
; Then align extended value such that the last 16 bit divide will
|
|
; yield the round bit in the least significant bit.
|
|
; Then do the divide.
|
|
|
|
Nrmlz10 MOVE.W D1,D7
|
|
ASL.W #4,D7 ; times 16
|
|
movea.L s(a6),a0
|
|
addq #2,a0
|
|
SUB.W (A0),D7 ; location of binary point to the right
|
|
; of first word (address (A1))
|
|
MOVE.W D1,D5 ; get word displacement
|
|
ASL.W #1,D5 ; set byte displacement, save for FinDiv
|
|
MOVE.W (A1),D0 ; get most significant word of divisor
|
|
BMI.S @3 ; power of ten normalized
|
|
@1 SUBQ.W #1,D7 ; adjust binary point
|
|
MOVE.W D1,D4 ; set counter
|
|
LEA 2(A1,D5.W),A0
|
|
MOVE.W #0,CCR ; clear 'X'
|
|
@2 ROXL.W -(A0) ; normalize power of ten
|
|
DBRA D4,@2
|
|
BPL.S @1 ; power of ten still not normalized
|
|
MOVE.W (A1),D0 ; get most significant word of divisor
|
|
@3 RTS
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;
|
|
; Power of ten located at (A1), length of D1 + 1 words,
|
|
; binary point D7 bits to the right of word (A1)
|
|
;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
DivX SUB.W D7,D6 ; # bits to generate
|
|
BLE noDiv
|
|
|
|
MOVE.W D6,D4
|
|
ASR.W #4,D6 ; D6.W + 1 = # of DIVU steps required
|
|
ANDI.W #15,D4 ; # of shifts necessary to align final answer
|
|
BEQ.S BeginD
|
|
|
|
ADDQ.w #1,D3 ; append a zero word to A3
|
|
CLR.W -(A3)
|
|
|
|
SUBQ #1,D4 ; adjust counter for DBRA below
|
|
@4 ASL.W 8(A3)
|
|
ROXL.W 6(A3)
|
|
ROXL.W 4(A3)
|
|
ROXL.W 2(A3)
|
|
ROXL.W (A3)
|
|
DBRA D4,@4
|
|
BRA.S BgnDiv
|
|
|
|
BeginD CMP.W (A3),D0 ; DO - (A3)
|
|
Bhi.S @1 ; Divide will succeed, no padding necessary <klh 11apr90>
|
|
ADDQ.w #1,D3 ; append a zero word to A3
|
|
CLR.W -(A3)
|
|
BRA.S BgnDiv
|
|
|
|
@1 SUBQ #1,D6 ; D6.W + 1 = # of DIVU steps required
|
|
BgnDiv BSR.s PadIt
|
|
|
|
|
|
MOVEA.L A3,A0
|
|
DivLoop MOVE.L (A0),D2 ; Address of quotient
|
|
DIVU D0,D2
|
|
BVS divOver
|
|
SWAP D2
|
|
MOVE.L D2,(A0) ; put result and rem back into (A3)
|
|
SWAP D2 ; used in FinDiv
|
|
LEA 2(A0),A0
|
|
CMPI.W #2,D5 ; byte offset of last word of divisor
|
|
BLT.S CtnDv
|
|
|
|
BEQ.S OneDiv
|
|
MOVE.W D5,D7 ; number of bytes - 2
|
|
BCLR.L #1,D7
|
|
BSR.s MandS
|
|
MOVEQ #0,D4
|
|
MOVE.W -(A4),D1
|
|
SUBX.W D4,D1
|
|
MOVE.W D1,(A4) ; 'C' Cleared, 'X' not affected.
|
|
NEGX.W D7 ; test 'X' bit, 'X' - D7
|
|
TST.W D7
|
|
BNE.S OneDiv ; no 'X' bit
|
|
|
|
BSR.s DecrIt
|
|
|
|
OneDiv MOVE.W D5,D7
|
|
BTST.L #1,D7
|
|
BNE.S @1
|
|
SUBQ.W #2,D7
|
|
@1 BSR.S MandS
|
|
NEGX.W D7 ; test 'X' bit, 'X' - D7
|
|
TST.W D7
|
|
BNE.S CtnDv ; no 'X' bit
|
|
|
|
BSR.s DecrIt
|
|
|
|
CtnDv DBRA D6,DivLoop
|
|
|
|
DvFin SUBA.L A3,A0
|
|
MOVE.W A0,D6
|
|
MOVE.W D3,D1
|
|
ASL.W #3,D6 ; multiply by 8
|
|
SUBQ #3,D6 ; # number of integer bits
|
|
rts
|
|
|
|
noDiv MOVEA.L A3,A0
|
|
CLR.W -(A3)
|
|
BRA.S DvFin
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;
|
|
; PadIt
|
|
; D1 length of divisor
|
|
; D3 length of dividend
|
|
; D6 necessary length of DIVU required (similar to length i.e, 0 => 1
|
|
;
|
|
; Extended input located at (A3), length of D3 + 1 words,
|
|
; binary point D5 bits to the right of word (A3)
|
|
;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
PadIt MOVE.W D1,D7
|
|
ADD.W D6,D7
|
|
ADDQ.W #1,D7 ; number of words necessary for dividend
|
|
SUB.W D3,D7 ; (D1 + D6 + 1) - D3
|
|
BLE.S @2 ; quotient has sufficent length
|
|
|
|
move.w d3,d2
|
|
asl.w #1,d2 ; times 2
|
|
LEA 2(A3,D2.W),A2 ; address of first block to be cleared
|
|
|
|
ADD.W D7,D3 ; adjust length
|
|
ASR.W #1,D7 ; divide by 2
|
|
@1
|
|
CLR.L (A2)+
|
|
DBRA D7,@1
|
|
|
|
@2 RTS
|
|
|
|
MandS LEA 2(A1,D7.W),A2
|
|
LEA 2(A0,D7.W),A4
|
|
SUBQ.W #2,D7
|
|
ASR.W #2,D7 ; use as a counter for DBRA
|
|
MOVE.W #0,CCR ; clear 'X'
|
|
@1 MOVE.L -(A2),D4
|
|
MULU D2,D4
|
|
MOVE.L -(A4),D1
|
|
SUBX.L D4,D1
|
|
MOVE.L D1,(A4) ; 'C' Cleared, 'X' not affected.
|
|
DBRA D7,@1
|
|
RTS
|
|
|
|
DecrIt SUBQ.W #1,-2(A0)
|
|
MOVE.L D5,D1 ; #of bytes - 2 in divisor
|
|
LEA 2(A1,D1.W),A2
|
|
LEA 2(A0,D1.W),A4
|
|
ASR.W #1,D1 ; use as a counter for DBRA
|
|
MOVE.W #0,CCR ; clear 'X'
|
|
@1 ADDX.W -(A2),-(A4)
|
|
DBRA D1,@1
|
|
BCC.S DecrIt
|
|
RTS
|
|
|
|
divOver
|
|
CLR.W (A0)+
|
|
MOVE.W D5,D7 ; #of bytes - 2 in divisor
|
|
beq.s DecrIt
|
|
LEA 2(A1,D7.W),A2
|
|
LEA 0(A0,D7.W),A4
|
|
ASR.W #1,D7 ; use as a counter for DBRA
|
|
subq.w #1,D7
|
|
MOVE.W #0,CCR ; clear 'X'
|
|
@1 SUBX.W -(A2),-(A4)
|
|
DBRA D7,@1
|
|
|
|
BSR.S DecrIt
|
|
|
|
BRA CtnDv
|
|
|
|
SizeExtN
|
|
neg.w D0
|
|
cmpi.w #5208,D0 ; D0 - 5208
|
|
bcs.s allct ; D0 < 5208
|
|
MOVE.W #5207,D0 ; initialize mask
|
|
move.w d0,d1 ; <2apr90>
|
|
neg.w d1 ; <2apr90>
|
|
move.w d1,(a0) ; reset s(a6) <2apr90>
|
|
bra.s allct
|
|
|
|
SizeExt
|
|
cmpi.w #5008,D0 ; D0 - 5008
|
|
bcs.s allct ; D0 < 5008
|
|
MOVE.W #5007,D0 ; initialize mask
|
|
move.w d0,(a0) ; reset s(a6) <2apr90>
|
|
allct
|
|
|
|
IF &AAA5 THEN
|
|
IMPORT ABlock: Data
|
|
lea ABlock(a5),A0
|
|
adda.L #130+(4*bgSz),A0
|
|
lea -16(A0),A1
|
|
move.L A1,AAdr(A6)
|
|
|
|
move.w #-(2*bgSz),d1
|
|
lea -16(A0,d1.w),A1
|
|
move.L A1,BAdr(A6)
|
|
|
|
move.w #-(3*bgSz),d1
|
|
lea -16(A0,d1.w),A1
|
|
move.L A1,CAdr(A6)
|
|
|
|
move.w #-(4*bgSz),d1
|
|
lea -16(A0,d1.w),A1
|
|
move.L A1,DAdr(A6)
|
|
ELSE
|
|
moveq #0,d4 ; zero d4 (for longword comparison below)
|
|
move.w d0,d4 ;
|
|
add.w #527,d4 ; minimum value for d4
|
|
and.b #$f8,d4 ; force multiple of 8
|
|
cmpi.w #4*bgSz,d4 ; d5 - #4*bgSz, check for max value
|
|
bcs.s @1
|
|
move.w #4*bgSz,d4
|
|
@1 move.w d4,d5
|
|
asr.w #2,d5 ; divide by 4 [*** result must be even ***]
|
|
|
|
IF &TRAPS THEN
|
|
move.l d0,d1 ; save d0
|
|
_StackSpace ; results will be in A0 and D0
|
|
CMP.L d4,D0 ; do we have enough StackSpace?
|
|
BPL.S @2
|
|
MOVEQ #28,D0 ; Stack overflow error. The stack has expanded into the heap
|
|
_SysError
|
|
@2 move.l d1,d0 ; restore d0
|
|
ENDIF
|
|
|
|
move.l (sp)+,a1 ; save return address
|
|
suba.w d4,sp ; allocate more space on the stack
|
|
move.l a1,-(sp) ; restore return address
|
|
|
|
lea areg(A6),A1
|
|
move.L A1,AAdr(A6)
|
|
|
|
suba.w d4,a1 ; -4*d5
|
|
move.L A1,DAdr(A6)
|
|
|
|
adda.w d5,a1 ; -3*d5
|
|
move.L A1,CAdr(A6)
|
|
|
|
adda.w d5,a1 ; -2*d5
|
|
move.L A1,BAdr(A6)
|
|
ENDIF
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;
|
|
; Algorithm for generating powers of ten. D0 intially contains
|
|
; the requested power of ten. On completion areg (see description
|
|
; below) will contain the actual integer power of 5.
|
|
;
|
|
|
|
Ten2AReg
|
|
movea.L AAdr(A6),A1
|
|
MOVEQ #0,D2 ; make sure hi part of D2 is clear
|
|
MOVE.W D0,D2
|
|
DIVU #21,D2
|
|
MOVE.W D2,D0
|
|
SWAP D2 ; get remainder into D2.LO
|
|
CMPI.W #7,D2 ; D2 - 7
|
|
BLT.S Frst7
|
|
CMPI.W #14,D2 ; D2 - 14
|
|
BGE.S Third7
|
|
|
|
MOVEQ #1,D1 ; set length word
|
|
LEA Tbl2,A2
|
|
SUBQ.W #7,D2
|
|
ASL.W #2,D2 ; times 4, byte offset
|
|
MOVE.L 0(A2,D2.W),-(A1)
|
|
BRA.S GotTen2
|
|
|
|
Third7 MOVEQ #2,D1 ; set length word
|
|
LEA Tbl3,A2
|
|
SUBI.W #14,D2
|
|
MULU #6,D2 ; times 6, byte offset
|
|
MOVE.L 2(A2,D2.W),-(A1)
|
|
BRA.S GotTen
|
|
|
|
|
|
Frst7 MOVEQ #0,D1 ; set length word
|
|
LEA Tbl1,A2
|
|
ASL.W #1,D2 ; times 2, byte offset
|
|
GotTen MOVE.W 0(A2,D2.W),-(A1)
|
|
|
|
GotTen2 TST.W D0
|
|
BNE.S MakeTen
|
|
RTS
|
|
|
|
MakeTen BSR.s a2c
|
|
|
|
MOVEQ #3,D2 ; initialize length of 10^21
|
|
movea.L BAdr(A6),A2
|
|
subq.L #4,A2
|
|
MOVE.L #$4D6E2EF5,(A2)
|
|
MOVE.L #$0001B1AE,-(A2)
|
|
|
|
bra.s BigLoop
|
|
|
|
DoItAgn bsr.s a2c
|
|
notOdd bsr.s bXb2b
|
|
BigLoop asr.w #1,d0
|
|
bcc.s notOdd
|
|
bsr.s cXb2a
|
|
tst.w d0
|
|
bgt.s DoItAgn
|
|
rts
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;
|
|
; a, b & c reside in locations areg2(A6), breg2(A6), creg2(A6),
|
|
; respectively. They are stored in a string of words counting backwards
|
|
; from their starting location. The higher order words are appended
|
|
; to the lower address. D1, D2 & D3 contain their respective word
|
|
; lengths - 1.
|
|
;
|
|
|
|
cXb2a move.w d2,d1
|
|
add.w d3,d1
|
|
addq.w #1,d1 ; maximum length for areg
|
|
move.w d3,d7 ; use as counter
|
|
addq.w #1,d7 ; initial length for areg
|
|
lsr.w #1,d7 ; divide by 2, (clear 2 words at a time)
|
|
movea.L AAdr(A6),A1
|
|
@2
|
|
clr.l -(a1) ; zero out areg(a6)
|
|
dbra d7,@2
|
|
|
|
movea.L AAdr(A6),A4
|
|
subq.L #2,A4
|
|
movea.L BAdr(A6),A2
|
|
subq.L #2,A2
|
|
move.w d2,d5 ; set outer counter
|
|
bra.s @4
|
|
|
|
@3
|
|
clr.w -(a1)
|
|
subq.L #2,a2
|
|
subq.L #2,a4
|
|
@4 move.L a4,a1
|
|
movea.L CAdr(A6),A3
|
|
move.w d3,d6 ; set inner loop counter for C
|
|
@5 move.w -(a3),d7
|
|
mulu (a2),d7
|
|
suba.w #2,a1 ; adjust address of a1
|
|
add.l d7,(a1)
|
|
bcc.s @7 ; check for carry propagation
|
|
|
|
move.l a1,a0
|
|
@6
|
|
addq.l #1,-(a0) ; propagate carry
|
|
bcs.s @6
|
|
|
|
@7 dbra d6,@5
|
|
dbra d5,@3
|
|
|
|
tst.w (a1)
|
|
bne.s @10
|
|
lea 2(a1),a1 ; adjust address of a1
|
|
subq.w #1,d1 ; adjust length
|
|
@10 rts
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
a2c move.w d1,d3 ; areg -> creg
|
|
movea.L AAdr(A6),A1
|
|
movea.L CAdr(A6),A3
|
|
lsr.w #1,d1 ; divide by 2
|
|
@1 move.l -(a1),-(a3)
|
|
dbra d1,@1
|
|
rts
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
bXb2b move.w d2,d1
|
|
move.w d1,d7 ; use as counter
|
|
asl.w #1,d1 ; double it
|
|
addq.w #1,d1 ; new length
|
|
movea.L AAdr(A6),A1
|
|
@2
|
|
clr.l -(a1) ; zero out areg(a6)
|
|
dbra d7,@2
|
|
|
|
move.w d2,d5 ; set counter for cross products of square
|
|
subq.w #1,d5
|
|
bmi.s doSqrs ; no cross products
|
|
movea.L AAdr(A6),A4 ; save address
|
|
subq.L #4,A4
|
|
movea.L BAdr(A6),A2
|
|
subq.L #2,A2
|
|
bra.s @4
|
|
|
|
@3 suba.w #2,a2
|
|
suba.w #4,a4
|
|
@4 move.l a4,a1
|
|
move.l a2,a3
|
|
move.w d5,d6 ; set inner loop counter for C
|
|
@5 move.w -(a3),d7
|
|
mulu (a2),d7
|
|
suba.w #2,a1 ; adjust address of a1
|
|
add.l d7,(a1)
|
|
bcc.s @7
|
|
|
|
move.l a1,a0 ; COULD PUSH & RESTORE FROM STACK!!!
|
|
@6
|
|
addq.l #1,-(a1)
|
|
bcs.s @6
|
|
move.l a0,a1 ; restore
|
|
|
|
@7 dbra d6,@5
|
|
@8 dbra d5,@3
|
|
|
|
dblIt movea.L AAdr(A6),A1
|
|
move.w #0,CCR ; clear 'X'
|
|
move.w d1,d7 ; use as counter
|
|
|
|
@1
|
|
roxl.w -(a1)
|
|
dbra d7,@1
|
|
|
|
doSqrs movea.L AAdr(A6),A1
|
|
movea.L BAdr(A6),A2
|
|
@5 move.w -(a2),d7
|
|
mulu d7,d7
|
|
add.l d7,-(a1)
|
|
bcc.s @7
|
|
|
|
move.l a1,a0 ; COULD PUSH & RESTORE FROM STACK!!!
|
|
@6
|
|
addq.l #1,-(a1)
|
|
bcs.s @6
|
|
move.l a0,a1 ; restore
|
|
|
|
@7 dbra d2,@5
|
|
|
|
tst.w (a1)
|
|
bne.s @10
|
|
lea 2(a1),a1 ; adjust address of a1
|
|
subq.w #1,d1 ; adjust length
|
|
|
|
@10 tst.w d0
|
|
bne.s a2b
|
|
rts
|
|
|
|
a2b move.w d1,d2 ; areg -> breg
|
|
movea.L AAdr(A6),A1
|
|
movea.L BAdr(A6),A2
|
|
lsr.w #1,d1 ; divide by 2
|
|
@1 move.l -(a1),-(a2)
|
|
dbra d1,@1
|
|
rts
|
|
|
|
Tbl1 DC.W $0001 ; 5^0
|
|
DC.W $0005 ; 5^1
|
|
DC.W $0019 ; 5^2
|
|
DC.W $007D ; 5^3
|
|
DC.W $0271 ; 5^4
|
|
DC.W $0C35 ; 5^5
|
|
DC.W $3D09 ; 5^6
|
|
|
|
|
|
Tbl2 DC.W $0001
|
|
DC.W $312D ; 5^7
|
|
DC.W $0005
|
|
DC.W $F5E1 ; 5^8
|
|
DC.W $001D
|
|
DC.W $CD65 ; 5^9
|
|
DC.W $0095
|
|
DC.W $02F9 ; 5^10
|
|
DC.W $02E9
|
|
DC.W $0EDD ; 5^11
|
|
DC.W $0E8D
|
|
DC.W $4A51 ; 5^12
|
|
DC.W $48C2
|
|
DC.W $7395 ; 5^13
|
|
|
|
|
|
Tbl3 DC.W $0001
|
|
DC.W $6BCC
|
|
DC.W $41E9 ; 5^14
|
|
DC.W $0007
|
|
DC.W $1AFD
|
|
DC.W $498D ; 5^15
|
|
DC.W $0023
|
|
DC.W $86F2
|
|
DC.W $6FC1 ; 5^16
|
|
DC.W $00B1
|
|
DC.W $A2BC
|
|
DC.W $2EC5 ; 5^17
|
|
DC.W $0378
|
|
DC.W $2DAC
|
|
DC.W $E9D9 ; 5^18
|
|
DC.W $1158
|
|
DC.W $E460
|
|
DC.W $913D ; 5^19
|
|
DC.W $56BC
|
|
DC.W $75E2
|
|
DC.W $D631 ; 5^20
|
|
|
|
|
|
IF NOT &BACKPATCH THEN
|
|
endproc
|
|
ENDIF
|
|
|
|
|