{File name: LispFPTSpec.mc
Last edited by cal 27-Dec-83 17:06:07
Last edited by Sturgis 15-Sep-83 16:40:30
Descrition: Floating point code for Lisp {modified from Cedar fpt code}
Created by H. Sturgis
}
{********************************************************************
All LISP Floating Point Opcodes have two arguments,
so all the opcodes will flow through common code which
will verify the two arguments are Floating Point numbers,
and set up for the actual execution.
}
{
save TOS and TOSH
before ReMap, set L1 ← L1.fixFV, set L3 ← L3.FloatArg2
verify FloatpType
fetch and unpack to Arg2 U registers
{may page fault}
set L3 ← L3.FloatArg1
read [S] and [S - 1]
verify FloatpType
fetch and unpack to Arg1 U registers
{may page fault}
{Opcode dependent execution}
{goto ufnZ if want to trap}
pack result, box result
return
}
{ put the 32 bits into some fixed place
find type and verify that it is a Fpt
mapping the Fpt may fault -- be prepared!
get the 32 bit value to a fixed place
return
}
@FPLUS2: opcode[350'b],
uTOS ← TT ← TOS, CALL[FptPrep],{L2 ← 10'b} c1;
@FDIFFERENCE: opcode[351'b],
uTOS ← TT ← TOS, CALL[FptPrep],{L2 ← 11'b} c1;
@FTIMES2: opcode[352'b],
uTOS ← TT ← TOS, CALL[FptPrep],{L2 ← 12'b} c1;
@FQUOTIENT: opcode[353'b],
uTOS ← TT ← TOS, CALL[FptPrep],{L2 ← 13'b} c1;
@FGREATERP: opcode[362'b],
uTOS ← TT ← TOS, CALL[FptPrep], L2 ← L2.FptCmp, c1;
FptPrep:
uTOSH ← Rx ← TOSH, L3 ← L3.FptArg2, c2;
CALL[FptUnpack], c3;
uExp2 ← Rx, ZeroBr, c3, at[L3.FptArg2, 10, FptUnpackRet];
Ybus ← Rx xor Q, ZeroBr, BRANCH[$, UP2ZeroE1], c1;
uSign2 ← TT, BRANCH[$, FprepufnA3], c2;
TT ← TOSH or 200'b, {implicit leading 1 bit} GOTO[Unpack2A], c3;
UP2ZeroE1:
uSign2 ← TT, CANCELBR[$], c2;
TT ← TOS and 177'b, {force leading bit to be 0} c3;
Unpack2A:
TOS ← TOS LRot8, c1;
Q ← ~377'b, c2;
uLowHalf2 ← TOS and Q, c3;
TOS ← TOS and 377'b, c1;
TT ← (TT LRot8 ) and Q, c2;
Ybus ← Rx, ZeroBr, {test for zero exponent again} c3;
uHighHalf2 ← TOS or TT, BRANCH[UP2A, $], c1;
TOS ← TOS or TT, c2;
TOS ← TOS or uLowHalf2, c3;
Ybus ← TOS, NZeroBr, c1;
UP2A: BRANCH[$, FprepufnB3], c2;
, c3;
MAR ← [rhS, S + 0], c1;
L3 ← L3.FptArg1, c2;
TT ← MD, c3;
MAR ← [rhS, S - 1], c1;
CANCELBR[$, 2], c2;
Rx ← MD, CALL[FptUnpack], c3;
uExp1 ← Rx, ZeroBr, c3, at[L3.FptArg1, 10, FptUnpackRet];
Ybus ← Rx xor Q, ZeroBr, BRANCH[$, UP1ZeroE1], c1;
uSign1 ← TT, BRANCH[$, FprepufnC3], c2;
TT ← TOSH or 200'b, {implicit leading 1 bit} GOTO[Unpack1A], c3;
UP1ZeroE1:
uSign1 ← TT, CANCELBR[$], c2;
TT ← TOSH and 177'b, {force leading bit to be 0} c3;
Unpack1A:
TOS ← TOS LRot8, c1;
Q ← ~377'b, c2;
uLowHalf1 ← TOS and Q, c3;
TOS ← TOS and 377'b, c1;
TT ← (TT LRot8 ) and Q, c2;
Ybus ← Rx, ZeroBr, {test for zero exponent again} c3;
uHighHalf1 ← TOS or TT, BRANCH[UP1A, $], c1;
TOS ← TOS or TT, c2;
TOS ← TOS or uLowHalf1, c3;
Ybus ← TOS, NZeroBr, c1;
UP1A:
BRANCH[$, FprepufnD3], c2;
L2Disp, c3;
RET[FptPrepRet], c1;
{ FptUnpack Subroutine }
{on entry:
Rx holds high
TT holds low
on exit:
TOSH holds high
TOS holds low
TT holds sign
Rx holds exponent
Q holds 0FF
will page fault if page holding Fpt value not resident
}
FptUnpack:
MAR ← Q ← [TT, Rx + 0], c1;{not mem ref, byte merge}
rhTT ← Rx LRot0, c2;
Rx ← Q, rhRx ← MDSTYPEspaceReal, c3;
Rx ← Rx LRot8, c1;
Rx ← Rx RShift1, SE←1, c2;
, c3;
MAR ← [rhRx, Rx], Rx ← FloatpType + 0, c1;
, c2;
Q ← MD xor Rx, c3;
, c1;
Ybus ← Q - 1, PgCarryBr, c2;
Q ← 0FF, BRANCH[$, FptNotFpt], c3;
Map ← [rhTT,TT], L0 ← L0.xRedoFpt, c1;
L1 ← L1.fixFV, c2;
Rx ← rhRx ← MD, XRefBr, c3;
MAR ← [rhRx, TT + 0], BRANCH[FptRemap, $], c1, at[L0.xRedoFpt, 10, RxMapFixCaller];
, c2;
TOSH ← MD, c3;
MAR ← [rhRx, TT + 1], c1;
TT ← LRot1 TOSH, CANCELBR[$, 2], c2;
TOS ← MD, c3;
Rx ← TT LRot8 and Q, {exponent}, L3Disp, c1;
TT ← TT and 1, {the sign bit} RET[FptUnpackRet], c2;
FptRemap:
CALL[RLxMapFix], c2;
{****************************************************************************
uSign2: [0..0]=s1, [1..15]=0
uExp2: [0..7]=0, [8..15]=exp2
uHighHalf2: [0..0]=1, [1..7]=fract2a, [8..15]=fract2b (if exp2 = 0 then [0..0] = 0)
uLowHalf2: [0..7]=fract2c, [8..15]=0
uSign1: [0..0]=s1, [1..15]=0
uExp1: [0..7]=0, [8..15]=exp1
uHighHalf1: [0..0]=1, [1..7]=fract1a, [8..15]=fract1b (if exp1 = 0 then [0..0] = 0)
uLowHalf1: [0..7]=fract1c, [8..15]=0
On Exit:
IF <x0, x1, ...> = <uHighHalf1, uLowHalf1> THEN value1 = (-1)↑uSign1 * s↑(uExp1-127) * <x0 . x1 x2 x3 ...>
IF <x0, x1, ...> = <uHighHalf2, uLowHalf2> THEN value2 = (-1)↑uSign2 * s↑(uExp2-127) * <x0 . x1 x2 x3 ...>
i.e. <uSign1, uExp1, uHighHalf1, uLowHalf1> is in proper format for immediate repacking, as is <uSign2, uExp2, uHighHalf2, uLowHalf2>
}
{****************************************************************************
Repack routine
entry:
TOS = | arg1H |
STK = | ~ |
--> | arg1L |
uSign1 holds [0..14]=0, [15..15]=sign result
uExp1 holds [0..15]=expResult, excess 127, possibly negative
(if x0, x1, ... are the bits of <uHighHalf1,uLowHalf1>, then the represented value (exclusive of sign) is <x0. x1 x2 ...>*2↑(uExp1-127))
<uHighHalf1,uLowHalf1> holding upper 32 bits of fraction part of result, may contain leading zeros.
uStickyBit is non zero if any bits to right of <uHighHalf1, uLowHalf1> are non zero
exits with:
TOS = |result1H |
STK = | ~ |
--> |result1L |
}
{Issues concerning the following algorithm are discussed in my notebook [Sturgis] for 28June82 page 3, 2 July page 6, and 7 July page 7}
{watch out for rounding issues on ZeroResult}
{in the following, nominal value is the result uncorrected for roundoff}
{nominal value = (-1)↑uSign1 * <uHighHalf1[0] . uHighHalf1[1] ... > * 2↑(uExp1-127)}
RePackC2: {delay} c2;
RePackC3: {delay} c3;
RePackC1:
T ← uHighHalf1, c1;
Q ← uLowHalf1 c2;
Ybus ← T or Q, ZeroBr, c3;
{nominal value = (-1)↑uSign1 * <T[0].T[1] ... Q[0] ...> * 2↑(uExp1-127)}
TT ← uExp1, BRANCH[$, ZeroToNorm], c1;
TT ← TT-2, c2;
Ybus ← TT, NegBr, c3;
{nominal value = (-1)↑uSign1 * <T[0].T[1] ... > * 2↑(TT+2-127)}
NormLoop:
Ybus ← T, NegBr, BRANCH[$, LowExp], c1;
TT ← TT-1, NegBr, BRANCH[$, Normed], c2;
T ← DLShift1 T, SE ← 1, BRANCH[NormLoop, SmallNumberC1], c3;
{at Normed: nominal value = (-1)↑(uSign1) * <T[0].T[1]. ...> * 2↑(TT+3-127) and T[0] = 1, therefore nominal exponent = TT+2, and nominal fraction = T[1]...Q[7]}
{at SmallNumber: nominal value = (-1)↑(uSign1) * <T[0].T[1]. ...> * 2↑(TT+2-127) and TT = -1, therefore nominal fraction = T[1]...Q[7], and nominal exponent = 1 if T[0] = 1, else 0. i.e. nominal exponent = T[0]}
{at LowExp: nominal value = (-1)↑(uSign1) * <T[0].T[1]. ...> * 2↑(TT+2-127) and TT < 0}
{*********************}
{at LowExp: nominal value = (-1)↑(uSign1) * <T[0].T[1]. ...> * 2↑(TT+2-127) and TT < 0}
{we will shift right one bit, and add 1 to TT, until TT = -1, then go to small number}
{NOTE: this code is very painful for an exponent of 1, maybe I should avoid ariving here under those conditions?}
LowExp: Rx ← 25'd, CANCELBR[$], c2;
Ybus ← TT + Rx, NegBr, c3;
Rx ← 1, BRANCH[$, VeryLowExp], c1;
Q ← ~Q, {to allow for complementing on right shifts} c2;
TT ← -TT-1, L0 ← L0.rePack1,CALL[DeNormC1] c3;
{*********************}
{at VeryLowExp, rounding to nearest can not produce any significant bits, however, fraction is known to be non zero, also Rx = 1}
VeryLowExp: GOTO[FPTrapsC3], c2;
{following is approx code if we did not trap on denormalized results
VeryLowExp: Q ← 0, c2;
T ← 0, c3;
Rx ← 200'b, GOTO[inexact], c1;}
{*********************}
{nominal value = (-1)↑(uSign1) * <T[0].T[1]. ...> * 2↑(TT+2-127) and TT = -1, therefore nominal fraction = T[1]...Q[7], and nominal exponent = 1 if T[0] = 1, else 0. i.e. nominal exponent = T[0]}
{upon entry from LowExp, TT is garbage, but above facts hold true}
{note: following code would be used if we did not trap on denormalized results, and further, even if we do trap un denormalized results, there is exactly one case that goes through this code that does not trap, namely, a number which when rounded rounds up to a non denormalized number. SInce I wrote this code before understanding that I had to provide traps on denormalized results, I have decided to keepit..}
{exit from the following has nominal exponent-3 in TT. Also a 1 bit in T[0], so that subsequent rounding will cause a carry overflow if rounding carrys into T[0]}
SmallNumberC1: {delay} c1;
SmallNumberC2: {delay} c2, at[L0.rePack1,10, DeNormRets];
SmallNumberC3:
TT ← RRot1 1, c3;
TT ← LRot1 (TT and T), {TT ← nominal exponent = T[0] } c1;
Rx ← RRot1 1, c2;
T ← T or Rx, {T[0] ← 1}, c3;
TT ← TT - 3, {normed wants TT to hold nominal exponent - 3}
c1;
GOTO[Normed], c2;
{*********************}
{nominal value = (-1)↑(uSign1) * <T[0].T[1]. ...> * 2↑(TT+3-127) and T[0] = 1, therefore nominal exponent = TT+3, and nominal fraction = T[1]...Q[7]}
{also entered from SmallNumberSmallNumber, arranged so that nominalFraction = <T[1]...>, T[0] = 1, and nominal exponent = TT+3}
Normed: CANCELBR[$], c3;
, c1;
{****************************************************************************
rounding code (rounds to nearest)
enter with
L0 prepared for return.
uSticky prepared
data in T..Q
if inexact result, will generate trap, or set sticky register bit, depending on contents of sticky register.
****************************************************************************}
Round:
Ybus ← uStickyBit, NZeroBr, c2;
Rx ← 377'b, BRANCH[RoundA, RoundB], c3;
RoundA: GOTO[RoundC], c1;
RoundB: Q ← Q or 1, GOTO[RoundC], c1;
RoundC: Ybus ← Q and Rx, ZeroBr, c2;
Rx ← 200'b, BRANCH[Inexact, RoundExit1], c3;
{in following we use TOS, which will eventually be restored}
Inexact: TOS ← uStickyReg, c1;
TOS ← TOS or 1, NegBr, c2;
uStickyReg ← TOS, BRANCH[$, inexactTrap], c3;
{now we round to nearest}
Q ← Q + Rx, CarryBr, c1;
Rx ← 177'b, BRANCH[$, inexact1], c2;
Ybus ← Q and Rx, ZeroBr, c3;
Rx ← LShift1 200'b, SE ← 0, BRANCH[RoundExit2, $], c1;
Q ← Q and ~ Rx {Q[7] ← 0}, GOTO[RoundExit], c2;
{roundoff carried across word boundary}
inexact1: T ← T + 1, CarryBr, {overflowBr since T[0]=1} c3;
BRANCH[RoundExit2A, $], c1;
TT ← TT + 1 {roundoff overflowed, adjust exponent},
GOTO[RoundExit], c2;
RoundExit2A: GOTO[RoundExit], c2;
RoundExit1: {delay} c1;
RoundExit2: , c2;
RoundExit: , c3;
{now we check for overflow and underflow}
TT ← TT+3, c1;
Rx ← 376'b, c2;
Ybus ← Rx-TT, NegBr, {branches if TT >= 377'b} c3;
Ybus ← TT, ZeroBr, BRANCH[$, FPTrapsC2], {overflow} c1;
BRANCH[finalPack, FPTrapsC3], {underflow} c2;
ZeroToNorm:
TT ← 0, GOTO[ZeroFractionC3], c2;
RepackExact0:
uStickyBit ← TT ← 0, GOTO[ZeroFraction], c3;
ZeroFractionC3: {delay} c3;
ZeroFraction:
T ← 0, c1;
Q ← 0, GOTO[finalPack], c2;
{result sign = uSign1, result exp = TT, result fraction = <T[1]...Q[7]>, T[0] = 1}
finalPack: {and prepare for entry to CCSubr }
Rx ← 377'b, c3;
Q ← Q and ~Rx, {bottom 8 bits of final result} c1;
Rx ← T and Rx, {next 8 bits of final result} c2;
Rx ← Q or Rx, c3;
Rx ← Rx LRot8, c1;
uNewValLo ← Rx, {low word of result} c2;
TT ← TT LRot8, c3;
TT ← RRot1(TT or uSign1), {top 9 bits of final result} c1;
T ← T LRot8, c2;
TOS ← T and 177'b, {next 7 bits of final result} c3;
TOS ← TOS or TT, L1 ← L1.fixFV, c1;
uNewValHi ← TOS, L3 ← L3.FptArg1{fpt}, c2;
Q ← LS4FptType, GOTO[CCSubr], c3;
{ return from compare:
TOS = 0 => args equal
TOS = +KTval => arg1 bigger
TOS = 0 => arg2 bigger
}
cmpExit3: {result not Floating point, no need to create cell }
TOSH ← 0, c3;
S ← S - 2, L2 ← L2.0, c1;
PC ← PC + PC16, IBDisp, c2;
DISPNI[OpTable], L2 ← L2.0, c3;
FPTufn: {early debugging exit}
GOTO[ufnX3], c2;
FptNotFpt: {one or more non-FloatType arg}
GOTO[ufnZ2], c1;
FprepufnA3:
GOTO[ufnZ1], c3;
FprepufnB3:
GOTO[ufnZ1], c3;
FprepufnC3:
GOTO[ufnZ1], c3;
FprepufnD3:
GOTO[ufnZ1], c3;
inexactTrap: GOTO[FPTrapsC2], c1;
FPTrapsC2: CANCELBR[ufnZ3], c2;
FPTrapsC3: GOTO[ufnZ1], c3;
{ E N D }