<> <> <> <> <> <> <<>> <<>> DIRECTORY Basics, Basics32, FloatOps, Real, RealFns USING [Power]; FloatOpsImpl: <> PROGRAM IMPORTS Basics32, Real, RealFns EXPORTS FloatOps = BEGIN <> <<>> checking: BOOL = FALSE; princOps: BOOL = BITS[WORD] = 16; <> signStart: NAT = IF princOps THEN 16 ELSE 0; signEnd: NAT = signStart; expStart: NAT = signEnd+1; expEnd: NAT = expStart+BITS[ExpRange]-1; m1Start: NAT = expEnd+1; m1End: NAT = m1Start+6; m2Start: NAT = IF princOps THEN 0 ELSE 16; m2End: NAT = m2Start+15; Float: TYPE = FloatOps.Float; PosZero: Float = Float[sign: FALSE, exp: 0, m1: 0, m2: 0]; NegZero: Float = Float[sign: TRUE, exp: 0, m1: 0, m2: 0]; ExpRange: TYPE = INTEGER[0..377B]; nanExpon: ExpRange = ExpRange.LAST; maxExpon: ExpRange = nanExpon.PRED; hiddenBit: Float = [m2: 0, sign: FALSE, exp: 1, m1: 0]; hiddenBitAsCard: CARD32 = LOOPHOLE[hiddenBit, CARD32]; signBit: Float = [m2: 0, sign: TRUE, exp: 0, m1: 0]; signBitAsCard: CARD32 = LOOPHOLE[signBit, CARD32]; maxExponDelta: ExpRange = 24; expBias: NAT = 127; <> <> FloatAnd: PROC [x: Float, y: Float] RETURNS [Float] = INLINE { RETURN [LOOPHOLE[Basics32.BITAND[LOOPHOLE[x, CARD32], LOOPHOLE[y, CARD32]]]]; }; QuickAbs: PROC [x: Float] RETURNS [Float] = INLINE { RETURN [LOOPHOLE[(LOOPHOLE[x, CARD32]*2)/2]]; }; QuickGt: PROC [x, y: Float] RETURNS [BOOL] = INLINE { <> RETURN [LOOPHOLE[x, INT32] > LOOPHOLE[y, INT32]]; }; QuickGe: PROC [x, y: Float] RETURNS [BOOL] = INLINE { <> RETURN [LOOPHOLE[x, INT32] >= LOOPHOLE[y, INT32]]; }; QuickLt: PROC [x, y: Float] RETURNS [BOOL] = INLINE { <> RETURN [LOOPHOLE[x, INT32] <= LOOPHOLE[y, INT32]]; }; QuickLe: PROC [x, y: Float] RETURNS [BOOL] = INLINE { <> RETURN [LOOPHOLE[x, INT32] < LOOPHOLE[y, INT32]]; }; QuickEq: PROC [x, y: Float] RETURNS [BOOL] = INLINE { <> RETURN [LOOPHOLE[x, INT32] = LOOPHOLE[y, INT32]]; }; <> ExternalNames: PROC [] = TRUSTED MACHINE CODE { "^ExternalNames\n"; "SoftSub XR_RealSub\n"; "SoftAdd XR_RealAdd\n"; "SoftMul XR_RealMul\n"; "SoftDiv XR_RealDiv\n"; "FloatInt XR_FloatInt\n"; "FloatCard XR_FloatCard\n"; "SoftFix XR_REAL32_Fix\n"; "SoftRnd XR_REAL32_Round\n"; "SoftFloor XR_REAL32_Floor\n"; "SoftCeiling XR_REAL32_Ceiling\n"; "SoftAbs XR_RealAbs\n"; "RealMin XR_RealMin\n"; "RealMax XR_RealMax\n"; <> "SoftGt XR_RealGt\n"; "SoftGe XR_RealGe\n"; "SoftEq XR_RealEq\n"; "SoftLt XR_RealLt\n"; "SoftLe XR_RealLe\n"; "SignedPwr XR_SignedPwr\n"; "UnsignedPwr XR_UnsignedPwr\n"; "RealPwr XR_RealPwr\n"; "SoftNeg XR_RealNeg\n"; }; <> SoftSub: PUBLIC SAFE PROC [r0, r1: Float] RETURNS [Float] = TRUSTED { sMask: CARD32 Ź LOOPHOLE[Float[m2: 0, sign: TRUE, exp: 0, m1: 0]]; r1 Ź LOOPHOLE[Basics32.BITXOR[LOOPHOLE[r1, CARD32], sMask]]; <> IF Basics32.BITOR[LOOPHOLE[r0, CARD32], sMask] < Basics32.BITOR[LOOPHOLE[r1, CARD32], sMask] THEN { temp: Float Ź r0; r0 Ź r1; r1 Ź temp; }; <> { guard: CARD32 Ź 0; r0s: CARD32 = Basics32.BITAND[LOOPHOLE[r0, CARD32], sMask]; r1s: CARD32 = Basics32.BITAND[LOOPHOLE[r1, CARD32], sMask]; resExp: NAT Ź r0.exp; dExp: NAT Ź resExp-r1.exp; SELECT TRUE FROM resExp = nanExpon => RETURN [RaiseFloatError[nan]]; dExp > maxExponDelta => RETURN [r0]; ENDCASE => { mnr: CARD32 Ź hiddenBitAsCard; mMask: CARD32 Ź hiddenBitAsCard-1; r0m: CARD32 Ź Basics32.BITAND[LOOPHOLE[r0, CARD32], mMask]; mant: CARD32 Ź Basics32.BITAND[LOOPHOLE[r1, CARD32], mMask] + mnr; IF dExp = resExp THEN { < denormalized number>> IF resExp > maxExponDelta THEN RETURN [r0]; mant Ź Basics32.BITAND[mant, mMask]; IF resExp = 0 THEN { <> IF r0s = r1s THEN mant Ź r0m + mant ELSE mant Ź r0m - mant; RETURN [LOOPHOLE[mant + r0s]]; }; mant Ź mant + mant; }; r0m Ź Basics32.BITOR[r0m, mnr]; IF dExp # 0 THEN { guard Ź Basics32.BITLSHIFT[mant, 32-dExp]; mant Ź Basics32.BITRSHIFT[mant, dExp]; }; IF r0s = r1s THEN { <> mant Ź mant + r0m; IF mant >= mnr+mnr THEN { <> guard Ź Basics32.BITRSHIFT[guard, 1] + Basics32.BITLSHIFT[mant, 32-1]; mant Ź Basics32.BITRSHIFT[mant, 1]; resExp Ź resExp + 1; }; } ELSE { <> mant Ź r0m - mant; IF guard # 0 THEN {mant Ź mant - 1; guard Ź 0 - guard}; IF mant < mnr THEN { <> shift: NAT Ź 0; temp: CARD32 Ź 12; IF mant = 0 THEN RETURN [PosZero]; IF Basics32.BITRSHIFT[mant, 12] # 0 THEN shift Ź 12; IF Basics32.BITRSHIFT[mant, shift+8] # 0 THEN shift Ź shift+8; IF Basics32.BITRSHIFT[mant, shift+4] # 0 THEN shift Ź shift+4; IF Basics32.BITRSHIFT[mant, shift+2] # 0 THEN shift Ź shift+2; IF Basics32.BITRSHIFT[mant, shift+1] # 0 THEN shift Ź shift+1; shift Ź 23-shift; mant Ź Basics32.BITLSHIFT[mant, shift] + Basics32.BITRSHIFT[guard, 32-shift]; guard Ź Basics32.BITLSHIFT[guard, shift]; resExp Ź resExp - shift; IF resExp <= 0 THEN { <> shift: NAT Ź 1-resExp; guard Ź Basics32.BITRSHIFT[guard, shift] + Basics32.BITLSHIFT[mant, 32-shift]; mant Ź Basics32.BITRSHIFT[mant, shift]; resExp Ź 0; }; }; }; IF LOOPHOLE[guard, INT32] < 0 THEN { <> IF LOOPHOLE[guard, INT32] = INT32.FIRST THEN mant Ź mant + Basics32.BITAND[mant, 1] ELSE mant Ź mant + 1; resExp Ź resExp + BYTE[Basics32.BITRSHIFT[mant, 24]]; <> }; IF resExp > maxExpon THEN RETURN [RaiseFloatError[overflow]]; RETURN [LOOPHOLE[Basics32.BITAND[mant, mMask] + resExp*hiddenBitAsCard + r0s]]; }; }; }; SoftAdd: PUBLIC SAFE PROC [r0, r1: Float] RETURNS [Float] = TRUSTED { sMask: CARD32 Ź LOOPHOLE[Float[m2: 0, sign: TRUE, exp: 0, m1: 0]]; IF Basics32.BITOR[LOOPHOLE[r0, CARD32], sMask] < Basics32.BITOR[LOOPHOLE[r1, CARD32], sMask] THEN { temp: Float Ź r0; r0 Ź r1; r1 Ź temp; }; <> { guard: CARD32 Ź 0; r0s: CARD32 = Basics32.BITAND[LOOPHOLE[r0, CARD32], sMask]; r1s: CARD32 = Basics32.BITAND[LOOPHOLE[r1, CARD32], sMask]; resExp: NAT Ź r0.exp; dExp: NAT Ź resExp-r1.exp; SELECT TRUE FROM resExp = nanExpon => RETURN [RaiseFloatError[nan]]; dExp > maxExponDelta => RETURN [r0]; ENDCASE => { mnr: CARD32 Ź hiddenBitAsCard; mMask: CARD32 Ź hiddenBitAsCard-1; r0m: CARD32 Ź Basics32.BITAND[LOOPHOLE[r0, CARD32], mMask]; mant: CARD32 Ź Basics32.BITAND[LOOPHOLE[r1, CARD32], mMask] + mnr; IF dExp = resExp THEN { < denormalized number>> IF resExp > maxExponDelta THEN RETURN [r0]; mant Ź Basics32.BITAND[mant, mMask]; IF resExp = 0 THEN { <> IF r0s = r1s THEN mant Ź r0m + mant ELSE mant Ź r0m - mant; RETURN [LOOPHOLE[mant + r0s]]; }; mant Ź mant + mant; }; r0m Ź Basics32.BITOR[r0m, mnr]; IF dExp # 0 THEN { guard Ź Basics32.BITLSHIFT[mant, 32-dExp]; mant Ź Basics32.BITRSHIFT[mant, dExp]; }; IF r0s = r1s THEN { <> mant Ź mant + r0m; IF mant >= mnr+mnr THEN { <> guard Ź Basics32.BITRSHIFT[guard, 1] + Basics32.BITLSHIFT[mant, 32-1]; mant Ź Basics32.BITRSHIFT[mant, 1]; resExp Ź resExp + 1; }; } ELSE { <> mant Ź r0m - mant; IF guard # 0 THEN {mant Ź mant - 1; guard Ź 0 - guard}; IF mant < mnr THEN { <> shift: NAT Ź 0; temp: CARD32 Ź 12; IF mant = 0 THEN RETURN [PosZero]; IF Basics32.BITRSHIFT[mant, 12] # 0 THEN shift Ź 12; IF Basics32.BITRSHIFT[mant, shift+8] # 0 THEN shift Ź shift+8; IF Basics32.BITRSHIFT[mant, shift+4] # 0 THEN shift Ź shift+4; IF Basics32.BITRSHIFT[mant, shift+2] # 0 THEN shift Ź shift+2; IF Basics32.BITRSHIFT[mant, shift+1] # 0 THEN shift Ź shift+1; shift Ź 23-shift; mant Ź Basics32.BITLSHIFT[mant, shift] + Basics32.BITRSHIFT[guard, 32-shift]; guard Ź Basics32.BITLSHIFT[guard, shift]; resExp Ź resExp - shift; IF resExp <= 0 THEN { <> shift: NAT Ź 1-resExp; guard Ź Basics32.BITRSHIFT[guard, shift] + Basics32.BITLSHIFT[mant, 32-shift]; mant Ź Basics32.BITRSHIFT[mant, shift]; resExp Ź 0; }; }; }; IF LOOPHOLE[guard, INT32] < 0 THEN { <> IF LOOPHOLE[guard, INT32] = INT32.FIRST THEN mant Ź mant + Basics32.BITAND[mant, 1] ELSE mant Ź mant + 1; resExp Ź resExp + BYTE[Basics32.BITRSHIFT[mant, 24]]; }; IF resExp > maxExpon THEN RETURN [RaiseFloatError[overflow]]; RETURN [LOOPHOLE[Basics32.BITAND[mant, mMask] + resExp*hiddenBitAsCard + r0s]]; }; }; }; SoftMul: PUBLIC SAFE PROC [r0, r1: Float] RETURNS [Float] = TRUSTED { sign: CARD32 = Basics32.BITAND[signBitAsCard, Basics32.BITXOR[LOOPHOLE[r0, CARD32], LOOPHOLE[r1, CARD32]]]; r0exp: INTEGER = r0.exp; r1exp: INTEGER = r1.exp; resExp: INTEGER Ź r0exp+r1exp - expBias; mMask: CARD32 Ź hiddenBitAsCard-1; <> r0Mant: CARD32 Ź Basics32.BITAND[mMask, LOOPHOLE[r0, CARD32]]; r1Mant: CARD32 Ź Basics32.BITAND[mMask, LOOPHOLE[r1, CARD32]]; mant: CARD32 Ź 0; guard: CARD32 Ź 0; IF r0exp = nanExpon THEN RETURN [RaiseFloatError[nan]]; IF r1exp = nanExpon THEN RETURN [RaiseFloatError[nan]]; IF r0exp = 0 THEN { <> IF r0Mant = 0 THEN RETURN [LOOPHOLE[sign]]; DO r0Mant Ź r0Mant + r0Mant; IF r0Mant >= hiddenBitAsCard THEN EXIT; resExp Ź resExp - 1; ENDLOOP; }; IF r1exp = 0 THEN { <> IF r1Mant = 0 THEN RETURN [LOOPHOLE[sign]]; DO r1Mant Ź r1Mant + r1Mant; IF r1Mant >= hiddenBitAsCard THEN EXIT; resExp Ź resExp - 1; ENDLOOP; }; r0Mant Ź Basics32.BITOR[r0Mant, hiddenBitAsCard]; r1Mant Ź Basics32.BITOR[r1Mant, hiddenBitAsCard]; <<>> <> <> <> { umul: PROC [x: BYTE] RETURNS [CARD32] = INLINE { RETURN [IF x = 0 THEN 0 ELSE x*r1Mant]; }; pLo: CARD32 = umul[Basics32.BITAND[r0Mant, 255]]; pMid: CARD32 = umul[Basics32.BITAND[Basics32.BITRSHIFT[r0Mant, 8], 255]]; pHi: CARD32 = Basics32.BITRSHIFT[r0Mant, 16] * r1Mant; sumLo: CARD32 = Basics32.BITLSHIFT[Basics32.BITAND[377B, pHi], 16] + Basics32.BITLSHIFT[Basics32.BITAND[177777B, pMid], 8] + Basics32.BITAND[77777777B, pLo]; mant Ź Basics32.BITRSHIFT[pHi, 8] + Basics32.BITRSHIFT[pMid, 16] + Basics32.BITRSHIFT[pLo, 24] + Basics32.BITRSHIFT[sumLo, 24]; guard Ź Basics32.BITLSHIFT[sumLo, 8]; IF mant < hiddenBitAsCard THEN { mant Ź mant + mant + Basics32.BITRSHIFT[guard, 32-1]; guard Ź guard + guard; IF checking AND mant < hiddenBitAsCard THEN ERROR; } ELSE { resExp Ź resExp + 1; IF checking AND mant >= hiddenBitAsCard*2 THEN ERROR; }; }; IF resExp <= 0 THEN { <> shift: NAT Ź 1-resExp; IF shift > 24 THEN RETURN [LOOPHOLE[sign]] ELSE { guardOut: CARD32 Ź Basics32.BITLSHIFT[guard, 32-shift]; guard Ź Basics32.BITRSHIFT[guard, shift] + Basics32.BITLSHIFT[mant, 32-shift]; IF guardOut # 0 THEN guard Ź Basics32.BITOR[guard, 1]; mant Ź Basics32.BITRSHIFT[mant, shift]; resExp Ź 0; }; }; IF LOOPHOLE[guard, INT32] < 0 THEN { <> IF guard = signBitAsCard THEN mant Ź mant + Basics32.BITAND[mant, 1] ELSE mant Ź mant + 1; resExp Ź resExp + BYTE[Basics32.BITRSHIFT[mant, 24]]; }; IF resExp > maxExpon THEN RETURN [RaiseFloatError[overflow]]; RETURN [LOOPHOLE[Basics32.BITAND[mant, mMask] + Basics32.BITLSHIFT[resExp, 23] + sign]]; }; SoftDiv: PUBLIC SAFE PROC [r0, r1: Float] RETURNS [Float] = TRUSTED { guard: CARD32 Ź 0; sign: CARD32 = Basics32.BITAND[signBitAsCard, Basics32.BITXOR[LOOPHOLE[r0, CARD32], LOOPHOLE[r1, CARD32]]]; r0exp: NAT = r0.exp; r1exp: NAT = r1.exp; resExp: INTEGER Ź (r0exp - r1exp) + expBias; mMask: CARD32 Ź hiddenBitAsCard-1; <> r0Mant: CARD32 Ź Basics32.BITAND[mMask, LOOPHOLE[r0, CARD32]]; r1Mant: CARD32 Ź Basics32.BITAND[mMask, LOOPHOLE[r1, CARD32]]; mant: CARD32 Ź 0; IF r0exp = nanExpon THEN RETURN [RaiseFloatError[nan]]; IF r1exp = nanExpon THEN RETURN [RaiseFloatError[nan]]; IF r1exp = 0 THEN { <> IF r1Mant = 0 THEN RETURN [RaiseFloatError[divByZero]]; DO r1Mant Ź r1Mant + r1Mant; IF r1Mant >= hiddenBitAsCard THEN EXIT; resExp Ź resExp - 1; ENDLOOP; }; IF r0exp = 0 THEN { <> IF r0Mant = 0 THEN RETURN [LOOPHOLE[sign]]; DO r0Mant Ź r0Mant + r0Mant; IF r0Mant >= hiddenBitAsCard THEN EXIT; resExp Ź resExp - 1; ENDLOOP; }; r0Mant Ź Basics32.BITOR[r0Mant, hiddenBitAsCard]; r1Mant Ź Basics32.BITOR[r1Mant, hiddenBitAsCard]; { bit: CARD32 Ź hiddenBitAsCard; mant Ź hiddenBitAsCard; IF r0Mant < r1Mant THEN { r0Mant Ź r0Mant + r0Mant; resExp Ź resExp - 1; }; r0Mant Ź r0Mant - r1Mant; IF r0Mant = 0 THEN GO TO earlyExit; DO r0Mant Ź r0Mant + r0Mant; IF bit = 1 THEN { IF r0Mant >= r1Mant THEN { <> IF r0Mant = r1Mant THEN mant Ź mant + Basics32.BITAND[mant, 1] ELSE mant Ź mant + 1; IF mant = hiddenBitAsCard+hiddenBitAsCard THEN { mant Ź hiddenBitAsCard; resExp Ź resExp + 1; }; }; EXIT; }; bit Ź Basics32.BITRSHIFT[bit, 1]; IF r0Mant >= r1Mant THEN { mant Ź mant + bit; r0Mant Ź r0Mant - r1Mant; IF r0Mant = 0 THEN GO TO earlyExit; }; ENDLOOP; EXITS earlyExit => {}; }; <<>> IF resExp <= 0 THEN { <> DO guard Ź Basics32.BITOR[ Basics32.BITAND[guard, 1], Basics32.BITRSHIFT[guard, 1] + Basics32.BITLSHIFT[mant, 32-1]]; mant Ź Basics32.BITRSHIFT[mant, 1]; IF resExp = 0 THEN EXIT; resExp Ź resExp + 1; ENDLOOP; }; IF LOOPHOLE[guard, INT32] < 0 THEN { <> IF guard = signBitAsCard THEN mant Ź mant + Basics32.BITAND[mant, 1] ELSE mant Ź mant + 1; resExp Ź resExp + BYTE[Basics32.BITRSHIFT[mant, 24]]; }; IF resExp > maxExpon THEN RETURN [RaiseFloatError[overflow]]; RETURN [LOOPHOLE[Basics32.BITAND[mant, mMask] + Basics32.BITLSHIFT[resExp, 23] + sign]]; }; FloatInt: PUBLIC SAFE PROC [i: INT32] RETURNS [Float] ~ TRUSTED { sign: CARD32 Ź 0; c: CARD32 Ź LOOPHOLE[i]; shift: NAT Ź 0; temp: CARD32 Ź 0; guard: CARD32; exp: NAT; mMask: CARD32 Ź hiddenBitAsCard-1; IF i = 0 THEN RETURN[LOOPHOLE[PosZero]]; IF i < 0 THEN {c Ź -i; sign Ź signBitAsCard}; <> IF Basics32.BITRSHIFT[c, 16] # 0 THEN shift Ź 16; IF Basics32.BITRSHIFT[c, shift+8] # 0 THEN shift Ź shift+8; IF Basics32.BITRSHIFT[c, shift+4] # 0 THEN shift Ź shift+4; IF Basics32.BITRSHIFT[c, shift+2] # 0 THEN shift Ź shift+2; IF Basics32.BITRSHIFT[c, shift+1] # 0 THEN shift Ź shift+1; exp Ź shift+expBias; IF shift <= 23 THEN { <> temp Ź Basics32.BITLSHIFT[c, 23-shift]; } ELSE { <> temp Ź Basics32.BITRSHIFT[c, shift-23]; guard Ź Basics32.BITLSHIFT[c, 32-shift]; IF LOOPHOLE[guard, INT32] < 0 THEN { <> IF LOOPHOLE[guard, INT32] = INT32.FIRST THEN temp Ź temp + Basics32.BITAND[temp, 1] ELSE temp Ź temp + 1; exp Ź exp + BYTE[Basics32.BITRSHIFT[temp, 24]]; }; }; RETURN [LOOPHOLE[Basics32.BITAND[temp, mMask] + exp*hiddenBitAsCard+sign]]; }; FloatCard: PUBLIC SAFE PROC [c: CARD32] RETURNS [Float] ~ TRUSTED { shift: NAT Ź 0; temp: CARD32 Ź 0; exp: NAT; guard: CARD32; mMask: CARD32 Ź hiddenBitAsCard-1; IF c = 0 THEN RETURN[LOOPHOLE[PosZero]]; <> IF Basics32.BITRSHIFT[c, 16] # 0 THEN shift Ź 16; IF Basics32.BITRSHIFT[c, shift+8] # 0 THEN shift Ź shift+8; IF Basics32.BITRSHIFT[c, shift+4] # 0 THEN shift Ź shift+4; IF Basics32.BITRSHIFT[c, shift+2] # 0 THEN shift Ź shift+2; IF Basics32.BITRSHIFT[c, shift+1] # 0 THEN shift Ź shift+1; exp Ź expBias+shift; IF shift <= 23 THEN { <> temp Ź Basics32.BITLSHIFT[c, 23-shift]; } ELSE { <> temp Ź Basics32.BITRSHIFT[c, shift-23]; guard Ź Basics32.BITLSHIFT[c, 32-shift]; IF LOOPHOLE[guard, INT32] < 0 THEN { <> IF LOOPHOLE[guard, INT32] = INT32.FIRST THEN temp Ź temp + Basics32.BITAND[temp, 1] ELSE temp Ź temp + 1; exp Ź exp + BYTE[Basics32.BITRSHIFT[temp, 24]]; }; }; RETURN [LOOPHOLE[Basics32.BITAND[temp, mMask] + exp*hiddenBitAsCard]]; }; SoftFix: PUBLIC SAFE PROC [c: Float] RETURNS [INT32] ~ TRUSTED { exponent: NAT Ź c.exp; newInt: INT32; neg0: Float Ź NegZero; IF c = neg0 OR c = PosZero THEN RETURN[0]; IF exponent = nanExpon THEN RETURN[LOOPHOLE[RaiseFloatError[nan]]]; IF exponent > expBias+31 THEN RETURN[LOOPHOLE[RaiseFloatError[overflow]]]; <> IF exponent < expBias THEN RETURN[0]; <> newInt Ź c.m2 + Basics32.BITLSHIFT[c.m1, 16] + hiddenBitAsCard; newInt Ź (IF exponent >= expBias+maxExponDelta THEN Basics32.BITLSHIFT[newInt, exponent-expBias-23] ELSE Basics32.BITRSHIFT[newInt, 23-(exponent-expBias)]); RETURN[IF LOOPHOLE[c, INT32] < 0 THEN -newInt ELSE newInt]; }; SoftRnd: PUBLIC SAFE PROC [c: Float] RETURNS [INT32] ~ TRUSTED { half: Float Ź Float[sign: FALSE, exp: expBias-1, m1: 0, m2: 0]; abs: Float = QuickAbs[c]; fix: INT32 Ź SoftFix[abs]; flt: Float = FloatInt[fix]; delta: Float = SoftSub[abs, flt]; SELECT TRUE FROM QuickLt[delta, half] => {}; QuickGt[delta, half] => fix Ź fix + 1; (LOOPHOLE[fix, CARD32] MOD 2) = 1 => fix Ź fix + 1; ENDCASE; IF abs # c THEN fix Ź - fix; RETURN [fix]; }; SoftFloor: PUBLIC SAFE PROC [c: REAL] RETURNS [INT32] ~ TRUSTED { temp: INT32 = SoftFix[LOOPHOLE[c, Float]]; IF c >= 0 THEN RETURN [temp]; IF c = temp THEN RETURN [temp] ELSE RETURN [temp-1]; }; SoftCeiling: PUBLIC SAFE PROC [c: REAL] RETURNS [INT32] ~ TRUSTED { temp: INT32 = SoftFix[LOOPHOLE[c, Float]]; IF c <= 0 THEN RETURN [temp]; IF c = temp THEN RETURN [temp] ELSE RETURN [temp+1]; }; SoftNeg: PUBLIC SAFE PROC [a: Float] RETURNS [Float] ~ TRUSTED { IF a.exp = nanExpon THEN RETURN [RaiseFloatError[nan]]; RETURN [LOOPHOLE[Basics32.BITXOR[LOOPHOLE[a, CARD32], signBitAsCard], Float]]; }; SoftAbs: PUBLIC SAFE PROC [a: Float] RETURNS [Float] ~ TRUSTED { bogus: CARD32 = LOOPHOLE[Float[sign: FALSE, exp: nanExpon, m1: 0, m2: 0]]; c: CARD32 Ź (LOOPHOLE[a, CARD32]*2)/2; IF c >= bogus THEN RETURN [RaiseFloatError[nan]]; RETURN [LOOPHOLE[c]]; }; RealMin: PUBLIC SAFE PROC [a, b: Float] RETURNS [Float] ~ TRUSTED { neg0: Float Ź NegZero; nanLow: Float Ź Float[sign: FALSE, exp: nanExpon, m1: 0, m2: 0]; IF a = neg0 THEN a Ź PosZero; IF b = neg0 THEN b Ź PosZero; IF FloatAnd[a, nanLow] = nanLow OR FloatAnd[b, nanLow] = nanLow THEN RETURN [RaiseFloatError[nan]]; IF LOOPHOLE[FloatAnd[a, b], INT32] < 0 THEN RETURN [(IF LOOPHOLE[a, INT32] > LOOPHOLE[b, INT32] THEN a ELSE b)]; IF LOOPHOLE[a, INT32] > LOOPHOLE[b, INT32] THEN RETURN[b] ELSE RETURN[a]; }; RealMax: PUBLIC SAFE PROC [a, b: Float] RETURNS [Float] ~ TRUSTED { neg0: Float Ź NegZero; nanLow: Float Ź Float[sign: FALSE, exp: nanExpon, m1: 0, m2: 0]; IF a = neg0 THEN a Ź PosZero; IF b = neg0 THEN b Ź PosZero; IF FloatAnd[a, nanLow] = nanLow OR FloatAnd[b, nanLow] = nanLow THEN RETURN [RaiseFloatError[nan]]; IF LOOPHOLE[FloatAnd[a, b], INT32] < 0 THEN RETURN [(IF LOOPHOLE[a, INT32] > LOOPHOLE[b, INT32] THEN b ELSE a)]; IF LOOPHOLE[a, INT32] > LOOPHOLE[b, INT32] THEN RETURN [a] ELSE RETURN [b]; }; SoftGt: PUBLIC SAFE PROC [r0, r1: Float] RETURNS [BOOL] = TRUSTED { neg0: Float Ź NegZero; nanLow: Float Ź Float[sign: FALSE, exp: nanExpon, m1: 0, m2: 0]; IF r0 = neg0 THEN r0 Ź PosZero; IF r1 = neg0 THEN r1 Ź PosZero; IF FloatAnd[r0, nanLow] = nanLow OR FloatAnd[r1, nanLow] = nanLow THEN { [] Ź RaiseFloatError[nan]; RETURN [FALSE]; }; IF LOOPHOLE[FloatAnd[r0, r1], INT32] < 0 THEN RETURN[LOOPHOLE[r0, INT32] < LOOPHOLE[r1, INT32]]; RETURN [LOOPHOLE[r0, INT32] > LOOPHOLE[r1, INT32]]; }; SoftGe: PUBLIC SAFE PROC [r0, r1: Float] RETURNS [BOOL] = TRUSTED { neg0: Float Ź NegZero; nanLow: Float Ź Float[sign: FALSE, exp: nanExpon, m1: 0, m2: 0]; IF r0 = neg0 THEN r0 Ź PosZero; IF r1 = neg0 THEN r1 Ź PosZero; IF FloatAnd[r0, nanLow] = nanLow OR FloatAnd[r1, nanLow] = nanLow THEN { [] Ź RaiseFloatError[nan]; RETURN [FALSE]; }; IF LOOPHOLE[FloatAnd[r0, r1], INT32] < 0 THEN RETURN[LOOPHOLE[r0, INT32] <= LOOPHOLE[r1, INT32]]; RETURN [LOOPHOLE[r0, INT32] >= LOOPHOLE[r1, INT32]]; }; SoftEq: PUBLIC SAFE PROC [r0, r1: Float] RETURNS [BOOL] = TRUSTED { neg0: Float Ź NegZero; nanLow: Float Ź Float[sign: FALSE, exp: nanExpon, m1: 0, m2: 0]; IF r0 = neg0 THEN r0 Ź PosZero; IF r1 = neg0 THEN r1 Ź PosZero; IF FloatAnd[r0, nanLow] = nanLow OR FloatAnd[r1, nanLow] = nanLow THEN { [] Ź RaiseFloatError[nan]; RETURN [FALSE]; }; RETURN [LOOPHOLE[r0, INT32] = LOOPHOLE[r1, INT32]]; }; SoftCmp: PUBLIC SAFE PROC [r0, r1: Float] RETURNS [Basics.PartialComparison] = TRUSTED { neg0: Float Ź NegZero; nanLow: Float Ź Float[sign: FALSE, exp: nanExpon, m1: 0, m2: 0]; IF r0 = neg0 THEN r0 Ź PosZero; IF r1 = neg0 THEN r1 Ź PosZero; IF FloatAnd[r0, nanLow] = nanLow OR FloatAnd[r0, nanLow] = nanLow THEN RETURN [incomparable]; IF LOOPHOLE[FloatAnd[r0, r1], INT32] < 0 THEN { IF LOOPHOLE[r0, INT32] < LOOPHOLE[r1, INT32] THEN RETURN [greater]; IF LOOPHOLE[r1, INT32] < LOOPHOLE[r0, INT32] THEN RETURN [less]; RETURN [equal]; }; IF LOOPHOLE[r0, INT32] < LOOPHOLE[r1, INT32] THEN RETURN [less]; IF LOOPHOLE[r1, INT32] < LOOPHOLE[r0, INT32] THEN RETURN [greater]; RETURN [equal]; }; SoftLt: PUBLIC SAFE PROC [r0, r1: Float] RETURNS [BOOL] = TRUSTED { neg0: Float Ź NegZero; nanLow: Float Ź Float[sign: FALSE, exp: nanExpon, m1: 0, m2: 0]; IF r0 = neg0 THEN r0 Ź PosZero; IF r1 = neg0 THEN r1 Ź PosZero; IF FloatAnd[r0, nanLow] = nanLow OR FloatAnd[r1, nanLow] = nanLow THEN { [] Ź RaiseFloatError[nan]; RETURN [FALSE]; }; IF LOOPHOLE[FloatAnd[r0, r1], INT32] < 0 THEN RETURN[LOOPHOLE[r0, INT32] > LOOPHOLE[r1, INT32]]; RETURN [LOOPHOLE[r0, INT32] < LOOPHOLE[r1, INT32]]; }; SoftLe: PUBLIC SAFE PROC [r0, r1: Float] RETURNS [BOOL] = TRUSTED { neg0: Float Ź NegZero; nanLow: Float Ź Float[sign: FALSE, exp: nanExpon, m1: 0, m2: 0]; IF r0 = neg0 THEN r0 Ź PosZero; IF r1 = neg0 THEN r1 Ź PosZero; IF FloatAnd[r0, nanLow] = nanLow OR FloatAnd[r1, nanLow] = nanLow THEN { [] Ź RaiseFloatError[nan]; RETURN [FALSE]; }; IF LOOPHOLE[FloatAnd[r0, r1], INT32] < 0 THEN RETURN[LOOPHOLE[r0, INT32] >= LOOPHOLE[r1, INT32]]; RETURN [LOOPHOLE[r0, INT32] <= LOOPHOLE[r1, INT32]]; }; SignedPwr: PUBLIC SAFE PROC [base, exp: INT32] RETURNS [INT32] ~ TRUSTED { p: INT32 Ź 1; b: INT32 Ź base; e: INT32 Ź exp; SELECT b FROM 0 => {IF e <= 0 THEN RETURN[LOOPHOLE[RaiseFloatError[other]]]; RETURN[0];}; 1 => RETURN[1]; -1 => IF Basics.OddInt[e] THEN RETURN[-1] ELSE RETURN[1]; ENDCASE => NULL; IF e < 0 THEN RETURN[0]; <> WHILE TRUE DO IF Basics.OddInt[e] THEN { p Ź p*b; e Ź e-1;}; IF e ~= 0 THEN { b Ź b*b; e Ź e/2; } ELSE { IF base ~= 0 THEN RETURN[p]; RETURN[LOOPHOLE[RaiseFloatError[other]]]; }; ENDLOOP; RETURN[0]; -- keep compiler happy }; UnsignedPwr: PUBLIC SAFE PROC [base, exp: CARD32] RETURNS [CARD32] ~ TRUSTED { p: CARD32 Ź 1; b: CARD32 Ź base; e: CARD32 Ź exp; <> WHILE TRUE DO IF Basics.OddCard[e] THEN { p Ź p*b; e Ź e-1;}; IF e ~= 0 THEN { b Ź b*b; e Ź e/2; } ELSE { IF base ~= 0 THEN RETURN[p]; RETURN[LOOPHOLE[RaiseFloatError[other]]]; }; ENDLOOP; RETURN[0]; -- keep compiler happy }; RealPwr: PUBLIC SAFE PROC [base, exp: REAL32] RETURNS [REAL32] ~ TRUSTED { RETURN[RealFns.Power[base, exp]]; }; <> FloatErrorKind: TYPE = {none, nan, overflow, underflow, divByZero, other}; floatErrorCount: CARD Ź 0; floatErrorFlags: Real.ExceptionFlags; SetExceptionFlag: PROC [which: FloatErrorKind] RETURNS [fault: Real.ExceptionFlags Ź Real.NoExceptions] ~ { SELECT which FROM none => NULL; nan => fault[invalidOperation] Ź TRUE; overflow => fault[overflow] Ź TRUE; underflow => fault[underflow] Ź TRUE; divByZero => fault[divisionByZero] Ź TRUE; other => fault[invalidOperation] Ź TRUE; ENDCASE => ERROR; }; RaiseFloatError: PROC [kind: FloatErrorKind] RETURNS [Float] = { <> floatErrorCount Ź floatErrorCount + 1; IF SIGNAL Real.RealException[SetExceptionFlag[kind], NIL] THEN ERROR; RETURN [PosZero]; }; GetStickyFlags: PROC RETURNS [Real.ExceptionFlags] ~ { RETURN [floatErrorFlags]; }; SetStickyFlags: PROC [new: Real.ExceptionFlags Ź Real.NoExceptions] RETURNS [old: Real.ExceptionFlags] ~ { old Ź floatErrorFlags; floatErrorFlags Ź new; }; ExternalNames[]; <<>> END.