mirror of
https://github.com/elliotnunn/sys7.1-doc-wip.git
synced 2024-06-13 21:29:27 +00:00
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
|
||
|
||
|