modeco80
/
singrdk
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
singrdk/base/Kernel/Native/arm/Crt/veneer_d.asm

1116 lines
38 KiB
NASM
Raw Normal View History

RDK 2.0
2008-11-17 18:29:00 -05:00
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Microsoft Research Singularity
;;;
;;; Copyright (c) Microsoft Corporation. All rights reserved.
;;;
;;; This file contains ARM-specific assembly code.
;;;
; veneer_d.s
;
; Copyright (C) Advanced RISC Machines Limited, 1994. All rights reserved.
;
; RCS Revision: 1
; Checkin Date: 2007/06/29 02:59:16
; Revising Author
;===========================================================================
;Veneers onto the arith.asm functions.
;
;This block should be assembled multiple times, once for each function.
;The possible functions are:
;
; addsub_s double precision add and subtract
; mul_s double precision multiply
; div_s double precision divide
; fmod_s implementation of math.h's fmod() [REM]
; sqrt_s implementation of math.h's sqrt() [SQRT]
GET fpe.asm
GET kxarm.inc
;===========================================================================
; When veneering these functions we need to be able to convert from double
; to extended on entry and back again on exit. This macro provides the
; conversion function.
; *WARNING* If no ulabel is set then the next instruction is skipped in
; the case of a number that needs normalizing. This is INTENTIONAL, since
; this macro leaves the Z flag set in the case of an uncommon case, but
; might also leave it set in the case of a denorm, so the following,
; conditional, instruction is skipped. It might be better if ulabel weren't
; there at all, just to make it explicit.
; The __fp_norm_opx functions should also do the skipping, rather than
; hacking lr in the fast path. This should be fixed, but for the moment
; I'd rather not be so disgustingly vile.
MACRO
$label DoubleToInternal $op,$zlabel,$ulabel
ASSERT ($op = 1) :LOR: ($op = 2)
$label MOVS tmp,dOP$op.h,LSL #1 ;C:=sign; Z:=exp & frac.top zero
TEQEQ dOP$op.l,#0 ;C unchanged; Z:=value is a zero
[ "$zlabel" <> ""
BEQ $zlabel ;Possible early abort
]
MOV Rtmp,tmp,LSL #DExp_len-1 ;Frac.top in bits 30:11 of mhi
MOV dOP$op.h,tmp,LSR #DExp_pos ;Exponent in bits 11:1
MOV OP$op.mlo,dOP$op.l,LSL #DExp_len; OP2mhi and 31:11 of OP2mlo
ORR OP$op.mhi,Rtmp,dOP$op.l,LSR #DFhi_len+1
;Fraction in bits 30:0 of
ADDNE dOP$op.h,dOP$op.h,#(EIExp_bias - DExp_bias):SHL:1
MOV OP$op.sue,dOP$op.h,RRX ;Recombine sign and exponent
ORRNE OP$op.mhi,OP$op.mhi,#EIUnits_bit
; Gets here with the *double precision* exponent in the top 11 bits
; of tmp. (Exponent<<1+DExp_pos.) We use a sign extended shift to
; spot the "maximum exponent case" - leaves us with -1 in tmp.
MOVS tmp,tmp,ASR #1+DExp_pos
ADDEQ lr,pc,#8 ;Skip two instructions past normalise call
BEQ __fp_norm_op$op
CMP tmp,#&ffffffff
[ "$ulabel" <> ""
BEQ $ulabel
]
MEND
MACRO
InternalToDouble
BL __fp_e2d
TST a4,#Error_bit
VReturn EQ
ORR a4,a4,#Double_bit
B __fp_veneer_error
MEND
MACRO
Double $name
IMPORT __fp_e2d
IMPORT __fp_norm_op1
IMPORT __fp_norm_op2
MEND
;===========================================================================
; Veneer functions
[ :DEF: add_s
; Local stack size and offset defines
LOC_SIZE EQU 0x24 ; Size of local storage on stack
ORG_OP2h EQU 0x20 ; Original Operand 2 high half
ORG_OP2l EQU 0x1C ; Original Operand 2 high low
ORG_OP1h EQU 0x18 ; Original Operand 1 high half
ORG_OP1l EQU 0x14 ; Original Operand 1 high low
OPCODE EQU 0x10 ; Opcode (_FpAddD or _FpSubD)
ExDRESh EQU 0x0C ; Exception record default result high
ExDRESl EQU 0x08 ; Exception record default result low
ExOp2h EQU 0x04 ; Exception record operand 2 high half
ExOp2l EQU 0x00 ; Exception record operand 2 low half
ExNewResh EQU 0x14 ; Exception new result high
ExNewResl EQU 0x10 ; Exception new result low
AREA |.text|, CODE, READONLY
Double add
; This is the veneer onto __addd, _drsb and __subd.
Export __addd
IMPORT __fp_addsub_common
IMPORT __fp_addsub_uncommon
IMPORT FPE_Raise
[ :LNOT: :DEF: thumb
Export __subd
; __subd and __addd prologues must be the same.
NESTED_ENTRY __subd
;VEnter_16 ; Includes extra ARM entry point
STMFD sp!, veneer_s ; Save off non-volatiles
SUB sp, sp, #LOC_SIZE ; Local storage
PROLOG_END
MOV r5, #_FpSubD ; Double precision subtract
STR r3, [sp, #ORG_OP2h] ; Save off original args in case of exception
STR r2, [sp, #ORG_OP2l]
STR r1, [sp, #ORG_OP1h]
STR r0, [sp, #ORG_OP1l]
;For sub we just invert the sign of operand 2 and branch to add.
EOR dOP2h, dOP2h, #Sign_bit
B coreadd
ENTRY_END __subd
]
; __addd and __subd prologues must be the same.
NESTED_ENTRY __addd
;VEnter_16 ; Includes extra ARM entry point
STMFD sp!, veneer_s ; Save off non-volatiles
SUB sp, sp, #LOC_SIZE ; Local storage
PROLOG_END
MOV r5, #_FpAddD ; Double precision addition
STR r3, [sp, #ORG_OP2h] ; Save off original args in case of exception
STR r2, [sp, #ORG_OP2l]
STR r1, [sp, #ORG_OP1h]
STR r0, [sp, #ORG_OP1l]
coreadd
STR r5, [sp, #OPCODE] ; Save off operation code in case of exception
; Catch the NaNs and INFs here.
MOV r4, r1, LSL #1
MOV r4, r4, LSR #21
ADD r4, r4, #1
CMP r4, #2048
BEQ dadd_arg1_nan_inf ; Arg1 is a NaN/INF
; Arg1 is finite
MOV r4, r3, LSL #1
MOV r4, r4, LSR #21
ADD r4, r4, #1
CMP r4, #2048
BEQ dadd_arg2_nan_inf ; Arg2 is a NaN/INF
DoubleToInternal 2,,dadd_uncommon1
DoubleToInternal 1,,dadd_uncommon
BL __fp_addsub_common
dadd_return
BL __fp_e2d
dadd_check_cause
TST r3, #FPECause_mask
ADDEQ sp, sp, #LOC_SIZE
; VReturn EQ
LDMEQFD sp!,veneer_s
IF Interworking :LOR: Thumbing
BXEQ lr
ELSE
MOVEQ pc, lr
ENDIF
LDR r12, [sp, #OPCODE] ; Get saved operation code
STR r0, [sp, #ExDRESl]
STR r1, [sp, #ExDRESh]
LDR r0, [sp, #ORG_OP2l]
LDR r1, [sp, #ORG_OP2h]
STR r0, [sp, #ExOp2l]
STR r1, [sp, #ExOp2h]
LDR r2, [sp, #ORG_OP1l]
ORR r1, r3, r12
LDR r3, [sp, #ORG_OP1h]
ADD r0, sp, #ExNewResl
CALL FPE_Raise
IF Thumbing :LAND: :LNOT: Interworking
CODE16
bx pc ; switch back to ARM mode
nop
CODE32
ENDIF
LDR r0, [sp, #ExNewResl]
LDR r1, [sp, #ExNewResh]
ADD sp, sp, #LOC_SIZE
LDMFD sp!, veneer_s
IF Interworking :LOR: Thumbing
BX lr
ELSE
MOV pc, lr
ENDIF
dadd_uncommon1
ORR OP2sue,OP2sue,#Uncommon_bit
DoubleToInternal 1 ; Skips next instruction if denorm
dadd_uncommon
ORREQ OP1sue,OP1sue,#Uncommon_bit
ADR lr,dadd_return
MOV Rins,#Double_mask
B __fp_addsub_uncommon
; Arg1 is an INF or a NaN.
; If Arg1 is an SNaN, signal invalid and return a QNaN.
; Else if Arg1 is a QNaN, check Arg2 for an SNaN.
; If Arg2 is an SNaN, signal invalid.
; Return the Arg1 QNaN.
; Else it is an INF
; If Arg2 is an SNaN, signal invalid and return a QNaN version of Arg2.
; Else if Arg2 is a QNaN, return it.
; Else if Arg2 is an INF of the same sign, return it.
; Else if Arg2 is an INF of the opposite sign, set invalid and return a QNaN.
; Else return the INF.
dadd_arg1_nan_inf
ORRS r4, r0, r1, LSL #12 ; Mantissa1 == 0?
BEQ dadd_arg1_inf ; Mantissa1 == 0 so is an INF
TST r1, #dSignalBit ; Arg1 == SNaN?
ORREQ r5, r5, #IVO_bit ; If Arg1 == SNaN, signal invalid
BEQ dadd_return_qnan ; and return a QNaN version of it
MOV r4, r3, LSL #1 ; Extract exponent2
MOV r4, r4, LSR #21 ; ..
ADD r4, r4, #1 ; Exponent2 == 2047?
CMP r4, #2048 ; ..
BNE dadd_return_qnan ; If !=, cannot be an SNaN
ORRS r4, r2, r3, LSL #12 ; Mantissa2 == 0?
BEQ dadd_return_qnan ; If == 0, cannot be an SNaN
TST r3, #dSignalBit ; Arg2 is a NaN. Is it an SNaN?
ORREQ r5, r5, #IVO_bit ; If SNaN, set invalid
B dadd_return_qnan ; Return Arg1 QNaN
dadd_arg1_inf
MOVS r4, r3, LSL #1 ; Extract exponent2
MOV r4, r4, LSR #21 ; ..
ADD r4, r4, #1 ; Exponent2 == 2047?
CMP r4, #2048 ; ..
MOVNE r3, r5 ; Copy exception information
BNE dadd_check_cause ; and return the INF
ORRS r4, r2, r3, LSL #12 ; Mantissa2 == 0?
BEQ dadd_check_inf ; If == 0, have an INF
MOV r1, r3 ; Arg2 is a NaN, so we need to copy the
MOV r0, r2 ; mantissa bits to return in the QNaN.
TST r3, #dSignalBit ; Is Arg2 an SNaN?
ORREQ r5, r5, #IVO_bit ; If SNaN, set invalid
B dadd_return_qnan ; Return Arg2 QNaN
dadd_check_inf
EORS r4, r1, r3 ; Check signs
MOVPL r3, r5 ; Copy exception information
BPL dadd_check_cause ; Return the INF
ORR r5, r5, #IVO_bit
B dadd_return_qnan ; Return a QNaN
; Arg2 is a NaN or an INF. Arg1 is a finite non-zero number.
; If Arg2 is an INF, return it.
; Else if Arg2 is a QNaN, return it.
; Else if Arg2 is an SNaN, signal invalid and return a QNaN version of it.
dadd_arg2_nan_inf
MOV r1, r3 ; Arg2 is a NaN or INF. We need to copy
MOV r0, r2 ; the bits to the Arg1 registers.
ORRS r4, r2, r3, LSL #12 ; Mantissa2 == 0?
BEQ dadd_check_cause ; ..
TST r3, #dSignalBit ; Is Arg2 an SNaN?
ORREQ r5, r5, #IVO_bit ; If SNaN, set invalid
; Fall through to return QNaN
; Returns a QNaN. R1 and R0 must contain the mantissa portion
; of the QNaN. SNaNs are converted to QNaNs here.
dadd_return_qnan
ORR r1, r1, #0x7F000000 ; Set exponent = 0x7FF
ORR r1, r1, #0x00F80000 ; ... and set mantissa[MSb] = 1
MOV r3, r5 ; Move exception information
B dadd_check_cause
ENTRY_END __addd
]
;---------------------------------------------------------------------------
[ {FALSE} :LAND: :DEF: sub_s :LAND: :DEF: thumb
AREA |.text|, CODE, READONLY
Double sub
Export __subd
IMPORT __addd
__subd VEnter_16
EOR dOP2h, dOP2h, #Sign_bit
; Just do a tail call to addd. In the THUMB world, code density is
; king. (The addition skips the LDM on the __addd entry point, and
; is dangerous.)
B __addd+4
[ {FALSE}
DoubleToInternal 2,,dsub_uncommon1
DoubleToInternal 1,,dsub_uncommon
BL __fp_addsub_common
dsub_return
InternalToDouble
dsub_uncommon1
ORR OP2sue,OP2sue,#Uncommon_bit
DoubleToInternal 1 ; Skips next instruction if denorm
dsub_uncommon
ORREQ OP1sue,OP1sue,#Uncommon_bit
ADR lr,dsub_return
MOV Rins,#Double_mask
B __fp_addsub_uncommon
]
]
;---------------------------------------------------------------------------
[ :DEF: rsb_s :LAND: :DEF: thumb
CodeArea |FPL$$drsb|
Double rsb
Export _drsb
IMPORT __addd
_drsb VEnter_16
EOR dOP1h, dOP1h, #Sign_bit
; Same as above - branch to add code.
B __addd+4
[ {FALSE}
DoubleToInternal 2,,drsb_uncommon1
DoubleToInternal 1,,drsb_uncommon
BL __fp_addsub_common
drsb_return
InternalToDouble
drsb_uncommon1
ORR OP2sue,OP2sue,#Uncommon_bit
DoubleToInternal 1 ; Skips next instruction if denorm
drsb_uncommon
ORREQ OP1sue,OP1sue,#Uncommon_bit
ADR lr,drsb_return
MOV Rins,#Double_mask
B __fp_addsub_uncommon
]
]
;---------------------------------------------------------------------------
[ :DEF: mul_s
; Local stack size and offset defines
LOC_SIZE EQU 0x20 ; Size of local storage on stack
OrgOP2h EQU 0x1C ; Original Operand 2 high half
OrgOP2l EQU 0x18 ; Original Operand 2 high low
OrgOP1h EQU 0x14 ; Original Operand 1 high half
OrgOP1l EQU 0x10 ; Original Operand 1 high low
ExDRESh EQU 0x0C ; Exception record default result high
ExDRESl EQU 0x08 ; Exception record default result low
ExOp2h EQU 0x04 ; Exception record operand 2 high half
ExOp2l EQU 0x00 ; Exception record operand 2 low half
ExNewResh EQU 0x14 ; Exception new result high
ExNewResl EQU 0x10 ; Exception new result low
AREA |.text|, CODE, READONLY
Double mul
Export __muld
IMPORT __fp_mult_common
IMPORT __fp_mult_uncommon
IMPORT FPE_Raise
NESTED_ENTRY __muld
; VEnter_16
STMFD sp!, veneer_s ; Save off non-volatiles
SUB sp, sp, #LOC_SIZE ; Local storage
PROLOG_END
STR r3, [sp, #OrgOP2h] ; Save off original args in case of exception
STR r2, [sp, #OrgOP2l]
STR r1, [sp, #OrgOP1h]
STR r0, [sp, #OrgOP1l]
; Catch the NaNs, INFs, and Zeros here.
MOV r5, #0 ; Exception information initialized to none.
ORRS r4, r0, r1, LSL #1
BEQ dmul_arg1_zero ; Arg1 is zero
MOV r4, r1, LSL #1
MOV r4, r4, LSR #21
ADD r4, r4, #1
CMP r4, #2048
BEQ dmul_arg1_nan_inf ; Arg1 is a NaN/INF
; Arg1 is non-zero and finite
ORRS r4, r2, r3, LSL #1
BEQ dmul_return_zero ; Arg2 is zero so just return a zero
MOV r4, r3, LSL #1
MOV r4, r4, LSR #21
ADD r4, r4, #1
CMP r4, #2048
BEQ dmul_arg2_nan_inf ; Arg2 is a NaN/INF
DoubleToInternal 2,,dmul_uncommon1
DoubleToInternal 1,,dmul_uncommon
BL __fp_mult_common
dmul_return
BL __fp_e2d
dmul_check_cause
TST r3, #FPECause_mask
ADDEQ sp, sp, #LOC_SIZE
; VReturn EQ
LDMEQFD r13!,veneer_s
IF Interworking :LOR: Thumbing
BXEQ lr
ELSE
MOVEQ pc, lr
ENDIF
STR r0, [sp, #ExDRESl]
STR r1, [sp, #ExDRESh]
LDR r0, [sp, #OrgOP2l]
LDR r1, [sp, #OrgOP2h]
STR r0, [sp, #ExOp2l]
STR r1, [sp, #ExOp2h]
LDR r2, [sp, #OrgOP1l]
ORR r1, r3, #_FpMulD
LDR r3, [sp, #OrgOP1h]
ADD r0, sp, #ExNewResl
CALL FPE_Raise
IF Thumbing :LAND: :LNOT: Interworking
CODE16
bx pc ; switch back to ARM mode
nop
CODE32
ENDIF
LDR r0, [sp, #ExNewResl]
LDR r1, [sp, #ExNewResh]
ADD sp, sp, #LOC_SIZE
LDMFD sp!, veneer_s
IF Interworking :LOR: Thumbing
BX lr
ELSE
MOV pc, lr
ENDIF
dmul_uncommon1
ORR OP2sue,OP2sue,#Uncommon_bit
DoubleToInternal 1 ; Skips next instruction if denorm
dmul_uncommon
ORREQ OP1sue,OP1sue,#Uncommon_bit
ADR lr,dmul_return
MOV Rins,#Double_mask
B __fp_mult_uncommon
; Arg1 is a zero. If Arg2 isn't a NaN or an INF, we return a zero.
; If Arg2 is an INF, we have an invalid operation and return a QNaN.
; If Arg2 is a QNaN, we return the QNaN.
; If Arg2 is an SNaN, we return a QNaN and signal invalid operation.
dmul_arg1_zero
MOV r4, r3, LSL #1 ; Extract exponent2
MOV r4, r4, LSR #21 ; ..
ADD r4, r4, #1 ; Exponent2 == 2047?
CMP r4, #2048 ; ..
BNE dmul_return_zero ; If != 2047, return 0
ORRS r4, r2, r3, LSL #12 ; Else if mantissa2==0
ORREQ r5, r5, #IVO_bit ; If ==, invalid op
BEQ dmul_return_qnan ; return QNaN
MOV r1, r3 ; Else have a NaN so copy mantissas to
MOV r0, r2 ; return QNaN and ...
TST r1, #dSignalBit ; check for an SNaN
ORREQ r5, r5, #IVO_bit ; If clear, have SNaN so invalid operation
B dmul_return_qnan
; Arg1 is an INF or a NaN.
; If it is an SNaN, signal invalid and return a QNaN.
; else if it is a QNaN, check Arg2 for an SNaN.
; If Arg2 is an SNaN, signal invalid.
; Return the Arg1 QNaN.
; Else it is an INF
; If Arg2 is an SNaN, signal invalid and return a QNaN version of Arg2.
; Else if Arg2 is a QNaN, return it.
; Else if Arg2 is an INF, return an INF.
; Else if Arg2 is a zero, signal invalid and return a QNaN.
dmul_arg1_nan_inf
ORRS r4, r0, r1, LSL #12 ; Mantissa1 == 0?
BEQ dmul_arg1_inf ; Mantissa1 == 0 so is an INF
TST r1, #dSignalBit ; Arg1 == SNaN?
ORREQ r5, r5, #IVO_bit ; If Arg1 == SNaN, signal invalid
BEQ dmul_return_qnan ; and return a QNaN version of it
MOV r4, r3, LSL #1 ; Extract exponent2
MOV r4, r4, LSR #21 ; ..
ADD r4, r4, #1 ; Exponent2 == 2047?
CMP r4, #2048 ; ..
BNE dmul_return_qnan ; If !=, cannot be an SNaN
ORRS r4, r2, r3, LSL #12 ; Mantissa2 == 0?
BEQ dmul_return_qnan ; If == 0, cannot be an SNaN
TST r3, #dSignalBit ; Arg2 is a NaN. Is it an SNaN?
ORREQ r5, r5, #IVO_bit ; If SNaN, set invalid
B dmul_return_qnan ; Return Arg1 QNaN
dmul_arg1_inf
ORRS r4, r2, r3, LSL #1 ; Arg2 == 0?
ORREQ r5, r5, #IVO_bit ; If == 0, signal invalid, return
BEQ dmul_return_qnan ; return a QNaN
MOVS r4, r3, LSL #1 ; Extract exponent2
MOV r4, r4, LSR #21 ; ..
ADD r4, r4, #1 ; Exponent2 == 2047?
CMP r4, #2048 ; ..
BNE dmul_return_inf ; If !=, cannot be a NaN or INF
ORRS r4, r2, r3, LSL #12 ; Mantissa2 == 0?
BEQ dmul_return_inf ; If == 0, cannot be a NaN
MOV r1, r3 ; Arg2 is a NaN, so we need to copy the
MOV r0, r2 ; mantissa bits to return in the QNaN.
TST r3, #dSignalBit ; Is Arg2 an SNaN?
ORREQ r5, r5, #IVO_bit ; If SNaN, set invalid
B dmul_return_qnan ; Return Arg2 QNaN
; Arg2 is a NaN or an INF. Arg1 is a finite non-zero number.
; If Arg2 is an INF, return it.
; Else if Arg2 is a QNaN, return it.
; Else if Arg2 is an SNaN, signal invalid and return a QNaN version of it.
dmul_arg2_nan_inf
ORRS r4, r2, r3, LSL #12 ; Mantissa2 == 0?
BEQ dmul_return_inf ; If == 0, Arg2 is an INF, so return it.
MOV r1, r3 ; Arg2 is a NaN, so we need to copy the
MOV r0, r2 ; mantissa bits to return in the QNaN.
TST r3, #dSignalBit ; Is Arg2 an SNaN?
ORREQ r5, r5, #IVO_bit ; If SNaN, set invalid
B dmul_return_qnan ; Return Arg2 QNaN
; Returns a QNaN. R1 and R0 must contain the mantissa portion
; of the QNaN. SNaNs are converted to QNaNs here.
dmul_return_qnan
ORR r1, r1, #0x7F000000 ; Set exponent = 0x7FF
ORR r1, r1, #0x00F80000 ; ... and set mantissa[MSb] = 1
MOV r3, r5 ; Move exception information
B dmul_check_cause
; Returns a properly signed INF. r1 and r3 must contain the
; sign bits in the MSb.
dmul_return_inf
EORS r4, r1, r3 ; Check signs of Arg1 and Arg2
MOV r0, #0 ; Clear mantissa2 ...
MOV r1, #0x7F000000 ; ... and set exponent = 0x7FF
ORR r1, r1, #0x00F00000 ; ..
ORRMI r1, r1, #0x80000000 ; Set sign bit if negative
MOV r3, r5 ; Move exception information
B dmul_check_cause
; Returns a properly signed zero. r1 and r3 must contain the
; sign bits in the MSb.
dmul_return_zero
EORS r4, r1, r3 ; Check signs of Arg1 and Arg2
MOV r0, #0 ; Clear sign, exponent, and mantissa
MOV r1, #0 ; ..
ORRMI r1, r1, #0x80000000 ; Set sign bit if negative
MOV r3, r5 ; Move exception information
B dmul_check_cause
ENTRY_END __muld
]
;---------------------------------------------------------------------------
[ :DEF: div_s
; Local stack size and offset defines
LOC_SIZE EQU 0x20 ; Size of local storage on stack
OrgOP2h EQU 0x1C ; Original Operand 2 high half
OrgOP2l EQU 0x18 ; Original Operand 2 high low
OrgOP1h EQU 0x14 ; Original Operand 1 high half
OrgOP1l EQU 0x10 ; Original Operand 1 high low
ExDRESh EQU 0x0C ; Exception record default result high
ExDRESl EQU 0x08 ; Exception record default result low
ExOp2h EQU 0x04 ; Exception record operand 2 high half
ExOp2l EQU 0x00 ; Exception record operand 2 low half
ExNewResh EQU 0x14 ; Exception new result high
ExNewResl EQU 0x10 ; Exception new result low
AREA |.text|, CODE, READONLY
Double div
Export __divd
IMPORT FPE_Raise
IMPORT __fp_div_common
IMPORT __fp_div_uncommon
IMPORT __fp_veneer_error ; RDCFix: Get rid of this.
NESTED_ENTRY __divd
; VEnter_16
STMFD r13!, veneer_s ; Save off non-volatiles
SUB sp, sp, #LOC_SIZE ; Local storage
PROLOG_END
STR r3, [sp, #OrgOP2h] ; Save off original args in case of exception
STR r2, [sp, #OrgOP2l]
STR r1, [sp, #OrgOP1h]
STR r0, [sp, #OrgOP1l]
; Catch the NaNs, INFs, and Zeros here.
MOV r5, #0 ; Exception information initialized to none.
ORRS r4, r0, r1, LSL #1
BEQ ddiv_arg1_zero ; Arg1 is zero
MOV r4, r1, LSL #1
MOV r4, r4, LSR #21
ADD r4, r4, #1
CMP r4, #2048
BEQ ddiv_arg1_nan_inf ; Arg1 is a NaN/INF
; Arg1 is non-zero and finite
ORRS r4, r2, r3, LSL #1
BEQ ddiv_zero_divide ; Arg2 is zero so have zero divide
MOV r4, r3, LSL #1
MOV r4, r4, LSR #21
ADD r4, r4, #1
CMP r4, #2048
BEQ ddiv_arg2_nan_inf ; Arg2 is a NaN/INF
DoubleToInternal 2,ddiv_zero2,ddiv_uncommon1
DoubleToInternal 1,ddiv_zero1,ddiv_uncommon
MOV Rins,#Double_mask
BL __fp_div_common
ddiv_return
BL __fp_e2d
ddiv_check_cause
TST r3, #FPECause_mask
ADDEQ sp, sp, #LOC_SIZE
; VReturn EQ
LDMEQFD r13!,veneer_s
IF Interworking :LOR: Thumbing
BXEQ lr
ELSE
MOVEQ pc, lr
ENDIF
STR r0, [sp, #ExDRESl]
STR r1, [sp, #ExDRESh]
LDR r0, [sp, #OrgOP2l]
LDR r1, [sp, #OrgOP2h]
STR r0, [sp, #ExOp2l]
STR r1, [sp, #ExOp2h]
LDR r2, [sp, #OrgOP1l]
ORR r1, r3, #_FpDivD
LDR r3, [sp, #OrgOP1h]
ADD r0, sp, #ExNewResl
CALL FPE_Raise
IF Thumbing :LAND: :LNOT: Interworking
CODE16
bx pc ; switch back to ARM mode
nop
CODE32
ENDIF
LDR r0, [sp, #ExNewResl]
LDR r1, [sp, #ExNewResh]
ADD sp, sp, #LOC_SIZE
LDMFD r13!, veneer_s
IF Interworking :LOR: Thumbing
BX lr
ELSE
MOV pc, lr
ENDIF
ddiv_uncommon1
ORR OP2sue,OP2sue,#Uncommon_bit
DoubleToInternal 1,ddiv_zero3
ddiv_uncommon
ORREQ OP1sue,OP1sue,#Uncommon_bit
ADR lr,ddiv_return
MOV Rins,#Double_mask
B __fp_div_uncommon
ddiv_zero3
; Op1 is a zero, Op2 is an uncommon non-zero. Op2 is in the converted form.
; Op2 is an infinity if all bits are zero (result is a signed zero). Otherwise
; a quiet NaN/exception.
ORRS tmp,OP2mlo,OP2mhi,LSL #1
BEQ ddiv_zero1
MOVS OP2mhi,OP2mhi,LSL #1
BPL ddiv_ivo
; return any old quiet NaN
; RDCFix: Get rid of this stuff.
;ddiv_return_qnan
; MOV dOPh,#-1
; VReturn
ddiv_zero2
; Op2 is a zero. If operand 1 is a zero or a SNaN, this is an invalid
; operation, otherwise it is a divide by zero.
MOVS tmp, dOP1h, LSL #1
TEQEQ dOP1l, #0 ; Z <- zero
BEQ ddiv_ivo
MVNS tmp, tmp, ASR #32-DExp_len-1 ; Z <- QNaN
VReturn EQ ; Return Op1 (QNaN)
; tmp==1 and mantissa==0 => Inf (Inf)
; tmp==1 and mantissa!=0 => SNaN (IVO)
TEQ tmp, #1
BNE ddiv_dvz
ORRS tmp, dOP1l, dOP1h, LSL #DExp_len+1 ; Z <- zero mantissa (Inf)
; MLS 2890
; Infinty/Zero returns appropriately signed infinity.
; Given the representations of Infinty and Zero, we can get
; this sign in a single instruction.
EOREQ dOP1h, dOP1h, dOP2h
VReturn EQ ; Return Op1 (Inf)
ddiv_ivo
MOV a4, #IVO_bit:OR:Double_bit
B __fp_veneer_error
ddiv_dvz
MOV a4, #DVZ_bit:OR:Double_bit
; MLS report 2899
; division by -0.0 should return inversely signed infinity.
EOR dOP1h, dOP1h, dOP2h
B __fp_veneer_error
ddiv_zero1
; Op1 is a zero, Op2 is in the extended form, and can't be an "uncommon".
EOR dOP1h, dOP1h, OP2sue
AND dOP1h, dOP1h, #Sign_bit
VReturn
; Arg1 is a zero.
; If Arg2 is a zero, set invalid operation and return a QNaN.
; Else if Arg2 is an SNaN, set invalid and return a QNaN version of the SNaN.
; Else if Arg2 is a QNaN, return it.
; Else return a zero.
ddiv_arg1_zero
ORRS r4, r2, r3, LSL #1 ; If Arg2 == 0
ORREQ r5, r5, #IVO_bit ; set invalid
BEQ ddiv_return_qnan ; return a QNaN
MOV r4, r3, LSL #1 ; Extract exponent2
MOV r4, r4, LSR #21 ; ..
ADD r4, r4, #1 ; If exponent2 == 2047
CMP r4, #2048 ; ..
BNE ddiv_return_zero ; Arg2 finite, return a zero
ORRS r4, r2, r3, LSL #12 ; Mantissa2 == 0?
BEQ ddiv_return_zero ; Have an INF, return a zero
TST r3, #dSignalBit ; SNaN?
ORREQ r5, r5, #IVO_bit ; If SNaN, set invalid
MOV r0, r2 ; Copy mantissa2 for QNaN return
MOV r1, r3 ; ..
B ddiv_return_qnan ; Return QNaN
; Arg1 is a NaN or an INF.
; If Arg1 is an INF
; If Arg2 is an SNaN, set invalid operation and return a QNaN version of
; the SNaN.
; If Arg2 is a QNaN, return it.
; If Arg2 is an INF, set invalid operation and return a QNaN.
; Else return an INF.
; Else if Arg1 is an SNaN, set invalid operation and return a QNaN version
; of the SNaN.
; Else if Arg1 is a QNaN.
; If Arg2 is an SNaN, set invalid and return the QNaN.
; Else return the QNaN.
ddiv_arg1_nan_inf
ORRS r4, r0, r1, LSL #12 ; Mantissa1 == 0?
BEQ ddiv_arg1_inf ; If ==0, have an INF
TST r1, #dSignalBit ; Check if Arg1 is an SNaN
ORREQ r5, r5, #IVO_bit ; If is an SNaN, signal invalid
BEQ ddiv_return_qnan ; and return a QNaN version of it
MOV r4, r3, LSL #1 ; Extract exponent2
MOV r4, r4, LSR #21 ; ..
ADD r4, r4, #1 ; If exponent2 == 2047
CMP r4, #2048 ; ..
BNE ddiv_return_qnan ; If !=, Arg2 finite, so return the QNaN
ORRS r4, r2, r3, LSL #12 ; Mantissa2 == 0?
BEQ ddiv_return_qnan ; If ==, Arg2 is INF, so return the QNaN
TST r3, #dSignalBit ; Check for SNaN
ORREQ r5, r5, #IVO_bit ; If == 0, set invalid operation
B ddiv_return_qnan
ddiv_arg1_inf
MOV r4, r3, LSL #1 ; Extract exponent2
MOV r4, r4, LSR #21 ; ..
ADD r4, r4, #1 ; If exponent2 == 2047
CMP r4, #2048 ; ..
BNE ddiv_return_inf ; If !=, Arg2 is finite, so return an INF
ORRS r4, r2, r3, LSL #12 ; Mantissa2 == 0?
ORREQ r5, r5, #IVO_bit ; If ==, have an INF, so set invalid
BEQ ddiv_return_qnan ; and return a QNaN
MOV r0, r2 ; Copy mantissa2 for QNaN return
MOV r1, r3 ; ..
TST r3, #dSignalBit ; Is Arg2 an SNaN
ORREQ r5, r5, #IVO_bit ; If it is, set invalid operation
B ddiv_return_qnan ; Return QNaN
; Arg2 is a NaN or INF. Arg1 is finite, possibly zero.
; If Arg2 is an INF, return zero.
; Else if Arg2 is an SNaN, set invalid operation and return a QNaN version of the SNaN.
; Else if Arg2 is a QNaN, return it.
ddiv_arg2_nan_inf
ORRS r4, r2, r3, LSL #12 ; If Arg2 == INF
BEQ ddiv_return_zero ; Then return zero
TST r3, #dSignalBit ; Have a NaN, check for SNaN
ORREQ r5, r5, #IVO_bit ; If == 0, set invalid
MOV r1, r3 ; Copy mantissa2 for QNaN return
MOV r0, r2 ; ..
B ddiv_return_qnan ; Return QNaN
; Returns a QNaN. R1 and R0 must contain the mantissa portion
; of the QNaN. SNaNs are converted to QNaNs here.
ddiv_return_qnan
ORR r1, r1, #0x7F000000 ; Set exponent = 0x7FF
ORR r1, r1, #0x00F80000 ; ... and set mantissa[MSb] = 1
MOV r3, r5 ; Move exception information
B ddiv_check_cause
; Sets the divide-by-zero exception and falls through to return an INF.
ddiv_zero_divide
ORR r5, r5, #DVZ_bit ; Set zero divide
; Returns a properly signed INF. r1 and r3 must contain the
; sign bits in the MSb.
ddiv_return_inf
EORS r4, r1, r3 ; Check signs of Arg1 and Arg2
MOV r0, #0 ; Clear mantissa2 ...
MOV r1, #0x7F000000 ; ... and set exponent = 0x7FF
ORR r1, r1, #0x00F00000 ; ..
ORRMI r1, r1, #0x80000000 ; Set sign bit if negative
MOV r3, r5 ; Move exception information
B ddiv_check_cause
; Returns a properly signed zero. r1 and r3 must contain the
; sign bits in the MSb.
ddiv_return_zero
EORS r4, r1, r3 ; Check signs of Arg1 and Arg2
MOV r0, #0 ; Clear sign, exponent, and mantissa
MOV r1, #0 ; ..
ORRMI r1, r1, #0x80000000 ; Set sign bit if negative
MOV r3, r5 ; Move exception information
B ddiv_check_cause
ENTRY_END __divd
]
;---------------------------------------------------------------------------
[ :DEF: rdv_s
CodeArea |FPL$$drdv|
Double rdv
IMPORT __fp_rdv_common
IMPORT __fp_rdv_uncommon
IMPORT __fp_veneer_error
;Export _drdv
Export _drdiv
;_drdv
_drdiv VEnter_16
DoubleToInternal 2,drdv_zero2,drdv_uncommon1
DoubleToInternal 1,drdv_dvz,drdv_uncommon
MOV Rins,#Double_mask :OR: Reverse
BL __fp_rdv_common
drdv_return
InternalToDouble
drdv_uncommon1
ORR OP2sue,OP2sue,#Uncommon_bit
DoubleToInternal 1,drdv_zero1
drdv_uncommon
ORREQ OP1sue,OP1sue,#Uncommon_bit
ADR lr,drdv_return
MOV Rins,#Double_mask:OR:Reverse
B __fp_rdv_uncommon
drdv_zero1
; Op2 is uncommon, but Op1 is a zero. Return Inf for Op2=Inf, IVO for
; Op2=SNaN or a QNaN for Op2=QNaN
MOVS tmp, dOP2h, LSL #DExp_len+1 ; N <- QNaN
TEQEQ dOP1l, #0 ; Z <- Inf
MOVMIS tmp, #0 ; Z <- N
BNE drdv_ivo
MOV dOP1h, dOP2h ; Return a QNaN/Inf
MOV dOP1l, dOP2l
VReturn
drdv_zero2
; Op2 is a zero. If Op1 is a zero or SNaN, this is an invalid operation,
; otherwise it is an appropiately signed zero unless Op1=QNaN
MOVS tmp, dOP1h, LSL #1
TEQEQ dOP1l, #0 ; Z <- Op1=0
BEQ drdv_ivo
MVNS tmp, tmp, ASR #32-DExp_len-1 ; Z <- Op1=QNaN
VReturn EQ ; Return QNaN
ORRS dOP1l, dOP1l, dOP1h, LSL #DExp_len+1
; Z <- zero mantissa
BEQ drdv_return_zero
TEQ tmp, #1 ; Z <- SNaN
BEQ drdv_ivo
drdv_return_zero
EOR dOP1h, dOP1h, dOP2h
AND dOP1h, dOP1h, #Sign_bit
MOV dOP1l, #0
VReturn
drdv_dvz
MOV a4,#DVZ_bit:OR:Double_bit
B __fp_veneer_error
drdv_ivo
MOV a4,#IVO_bit:OR:Double_bit
B __fp_veneer_error
]
;---------------------------------------------------------------------------
[ :DEF: fmod_s
CodeArea |FPL$$dfmod|
Double fmod
EXPORT fmod
Import_32 __fp_edom
fmod VEnter
DoubleToInternal 2,fmod_divide_by_zero,fmod_uncommon1
DoubleToInternal 1,fmod_Op1Zero,fmod_uncommon
BL Rem_Common
fmod_return
InternalToDouble
fmod_Op1Zero
; Op1 is zero => result is Op1. Op1h/Op1l hasn't been changed.
VReturn
fmod_uncommon1
ORR OP2sue,OP2sue,#Uncommon_bit
DoubleToInternal 1
fmod_uncommon
ORREQ OP1sue,OP1sue,#Uncommon_bit
ADR lr,fmod_return
MOV Rins,#Double_mask
B Rem_Uncommon
fmod_divide_by_zero
; We return -HUGE_VAL and set errno=EDOM
VPull
MOV a1, #Sign_bit
MOV a2, #1 ; true
B_32 __fp_edom
GET arith.asm
]
;---------------------------------------------------------------------------
[ :DEF: sqrt_s
CodeArea |FPL$$dsqrt|
Double sqrt
EXPORT sqrt
IMPORT __fp_sqrt_common
IMPORT __fp_sqrt_uncommon
sqrt VEnter
DoubleToInternal 1,sqrt_Zero,sqrt_uncommon
MOV Rins,#Double_mask
BL __fp_sqrt_common
sqrt_return
BL __fp_e2d
TST a4, #Error_bit
VReturn EQ
; error - set errno to EDOM and return -HUGE_VAL
MOV a1, #Sign_bit
MOV a2, #1 ; something non-zero
sqrt_edom
Import_32 __fp_edom
; tail call
VPull
B_32 __fp_edom
sqrt_Zero
; C contains the sign bit - if set, record a domain error,
; but return -0.0 (which is what's in a1/a2 already)
[ :DEF: SqrtMinusZeroGivesEDOM
VReturn CC
B sqrt_edom ; save a few bytes in error case
|
; Otherwise, just return the zero passed in
VReturn
]
sqrt_uncommon
ORR OP1sue,OP1sue,#Uncommon_bit
ADR lr,sqrt_return
MOV Rins,#Double_mask
B __fp_sqrt_uncommon
]
;===========================================================================
END