DragonFPImpl:
CEDAR
PROGRAM
IMPORTS Basics, BitOps, Dragon, IO
EXPORTS DragonFP =
BEGIN OPEN DragonFP;
SetMode:
PUBLIC
PROC[mode: Mode, function: Function]
RETURNS[Mode] = {
word: BitOps.BitWord ← LOOPHOLE[mode];
word ← BitOps.ICIW[function MOD 16, word,16, ((function MOD 64)/16)*4, 4];
RETURN[ LOOPHOLE[word]] };
ALU:
PUBLIC
PROC [aHDW, bHDW: HexDblWord, func: Function, mode: Mode]
RETURNS [cHDW: HexDblWord, status: Dragon.PBusFaults] = {
resDbl: BOOL ← func MOD 2 = 1;
Dragon.Assert[mode.required = requiredMode];
func ← func MOD 64;
SELECT func/2
FROM
IN [0..24) => {
aFP,bFP:FP;
aFP ← HDWtoFP[aHDW];
bFP ← HDWtoFP[bHDW];
IF (func
MOD 8)
IN [6..7]
THEN
{
IF (func/8) MOD 2 =1 THEN aFP.exp ← aFP.exp - WrapBias[aFP];
IF (func/16) MOD 2 =1 THEN bFP.exp ← bFP.exp - WrapBias[bFP];
[cHDW, status] ← FDiv[aFP, bFP, resDbl, mode]}
ELSE {
IF (func MOD 16) >7 THEN bFP ← HDWtoFP[[0,0,FALSE]];
IF (func MOD 8)/2=2 THEN aFP.sign ← bFP.sign ← FALSE;
IF func/2 = 4 THEN aFP.sign ← NOT aFP.sign;
IF func < 6 THEN bFP.sign ← NOT bFP.sign;
IF func <32
THEN [cHDW, status] ← FAdd[aFP, bFP, resDbl, mode]
ELSE [cHDW, status] ← FCmp[aFP, bFP, resDbl, mode]} };
24 => [cHDW, status] ← UtoD [aHDW, mode, TRUE];
25 => [cHDW, status] ← DtoW [aHDW, mode];
26 => [cHDW, status] ← UtoD [aHDW, mode, FALSE];
28 => [cHDW, status] ← FtoI [aHDW, mode];
29 => [cHDW, status] ← ItoF [aHDW, mode, resDbl];
30 => [cHDW, status] ← FtoF [aHDW, mode, resDbl];
ENDCASE => Dragon.Assert[FALSE, "Strange FP Function"];
RETURN[cHDW, status]};
MUL:
PUBLIC
PROC [aHDW,bHDW: HexDblWord, function: Function, mode: Mode]
RETURNS [cHDW: HexDblWord, status: Dragon.PBusFaults] = {
acc: ARRAY[0..8) OF CARDINAL ← ALL[0];
resDbl: BOOL ← (function MOD 2)/1 = 1;
aWraped: BOOL ← (function MOD 4)/2 = 1;
bWraped: BOOL ← (function MOD 8)/4 = 1;
aMagnitude: BOOL ← (function MOD 16)/8 = 1;
bMagnitude: BOOL ← (function MOD 32)/16 = 1;
compResult: BOOL ← (function MOD 64)/32 = 1;
a: FP ← HDWtoFP[aHDW];
b: FP ← HDWtoFP[bHDW];
Dragon.Assert[mode.required = requiredMode];
IF (function MOD 8)/2 = 2 THEN a.sign ← b.sign ← FALSE;
IF (function MOD 64)/2 = 4 THEN a.sign ← TRUE;
IF (function MOD 64) >=32 THEN b.sign ← NOT b.sign;
IF compResult THEN a.sign ← NOT a.sign;
IF a.type = nan AND b.type = nan THEN RETURN[FPtoHDW[a], FPabNaN];
IF a.type = nan THEN RETURN[FPtoHDW[a], FPaNaN];
IF b.type = nan THEN RETURN[FPtoHDW[b], FPaNaN];
IF a.double AND NOT resDbl THEN RETURN[FPtoHDW[a], FPinvalid];
IF b.double AND NOT resDbl THEN RETURN[FPtoHDW[b], FPinvalid];
IF a.exp<MinExp[a] AND mode.fast THEN SetToZero[a];
IF b.exp<MinExp[b] AND mode.fast THEN SetToZero[b];
IF a.type = zero
AND b.type = inf
OR
b.type = zero AND a.type = inf THEN{a.type←nan; RETURN[FPtoHDW[a], FPinvalid]};
IF a.type = inf THEN {a.sign ← a.sign#b.sign; RETURN[FPtoHDW[a], FPlsInfE]};
IF b.type = inf THEN {b.sign ← a.sign#b.sign; RETURN[FPtoHDW[b], FPlsInfE]};
IF b.type = zero THEN {b.sign ← a.sign#b.sign; RETURN[FPtoHDW[b], FPeqZeroE]};
IF a.type = zero THEN {a.sign ← a.sign#b.sign; RETURN[FPtoHDW[a], FPeqZeroE]};
IF a.exp<MinExp[a] AND b.exp<MinExp[b] THEN RETURN[FPtoHDW[a], FPabDeNorm];
IF a.exp<MinExp[a] THEN RETURN[FPtoHDW[a], FPaDeNorm];
IF b.exp<MinExp[b]
THEN
RETURN[FPtoHDW[b], FPbDeNorm];
a and b are normal and non-zero
IF aWraped THEN a.exp ← a.exp - WrapBias[a];
IF bWraped THEN a.exp ← a.exp - WrapBias[b];
a.exp ← a.exp - FPExpBias + b.exp +1;
a.sign ← a.sign # b.sign;
FOR i:
CARDINAL
DECREASING
IN [0..4)
DO
-- acc[1-7] ← a*b, acc[0] ← carry
cy:CARDINAL ← 0;
FOR j:
CARDINAL
DECREASING
IN [0..4)
DO
long:Basics.LongNumber;
long.lc ← Basics.LongMult[a.m[i], b.m[j]];
[cy, acc[i+j+1]] ← ADC3[long.lowbits, acc[i+j+1], cy];
cy ← cy + long.highbits;
ENDLOOP;
FOR j:
CARDINAL
DECREASING
IN [0..i]
WHILE cy#0
DO [cy, acc[j]] ← ADC3[acc[j], cy, 0]
ENDLOOP;
ENDLOOP;
WHILE acc[0] < 100000B
DO
a.exp ← a.exp - 1;
FOR i:
CARDINAL
IN [0..7)
DO
acc[i] ← acc[i]*2;
IF acc[i+1] > 100000B THEN acc[i] ← acc[i] + 1;
ENDLOOP;
acc[7] ← acc[7]*2
ENDLOOP;
FOR i:CARDINAL IN [0..3] DO a.m[i] ← acc[i] ENDLOOP;
FOR i:
CARDINAL
DECREASING
IN [4..7]
WHILE (a.m[3]
MOD 2) = 0
DO
IF acc[i]#0 THEN a.m[3] ← a.m[3] +1 ENDLOOP;
status ← RoundMult[a, mode];
RETURN [FPtoHDW[a], status] };
PutHexFP:
PUBLIC
PROC[st:
IO.
STREAM, hdw: HexDblWord] = {
fp: FP ← HDWtoFP[hdw];
hexChar: ARRAY [0..16) OF CHARACTER ← ['0,'1,'2,'3,'4,'5,'6,'7,'8,'9,'A,'B,'C,'D,'E,'F];
charVal: ARRAY [0..16) OF CHARACTER ← ALL['0];
nonZeroCnt: CARDINAL ← 0;
val, cy: CARDINAL ← 0;
SELECT fp.type
FROM
zero => {IO.PutF[st, IF fp.sign THEN "-0.0" ELSE "+0.0"]; RETURN};
inf => {IO.PutF[st, IF fp.sign THEN "-INF" ELSE "+INF"]; RETURN};
nan => {IO.PutF[st, "NaN"]; RETURN};
ENDCASE;
FOR i:
CARDINAL
DECREASING
IN [0..4)
DO
val ← (fp.m[i] MOD 100000B)*2 + cy;
cy ← fp.m[i] / 100000B;
FOR j:
CARDINAL
DECREASING
IN [0..4)
DO
charVal[i*4+j] ← hexChar[val MOD 16];
val ← val / 16;
IF charVal[i*4+j] = '0 AND nonZeroCnt=0 THEN LOOP;
nonZeroCnt ← nonZeroCnt+1;
ENDLOOP;
ENDLOOP;
IF fp.sign THEN IO.PutF[st, "-" ];
IO.PutF[st, "1." ];
FOR i:CARDINAL IN [0..MAX[1, nonZeroCnt]) DO st.PutChar[charVal[i]] ENDLOOP;
IF fp.exp # FPExpBias
THEN
IF fp.exp>FPExpBias
THEN {IO.PutF[st, "e"]; val ← fp.exp-FPExpBias}
ELSE {IO.PutF[st, "e-"]; val ← FPExpBias-fp.exp};
nonZeroCnt ← 0;
FOR div:
CARDINAL �, div/16
WHILE div#0
DO
IF (val/div) = 0 AND nonZeroCnt=0 THEN LOOP;
st.PutChar[hexChar[val/div]];
nonZeroCnt ← nonZeroCnt+1;
val ← val MOD div;
ENDLOOP};
Private:
FP: TYPE = REF FPRec;
FPType: TYPE = {norm, zero, den, inf, nan};
FPExpBias: CARDINAL = 16383;
FPRec:
TYPE =
RECORD [
double: BOOL ← FALSE,
type: FPType ← norm,
sign: BOOL ← FALSE,
exp: CARDINAL ← 0,
m: ARRAY[0..4) OF CARDINAL ← ALL[0]];
FDiv:
PROC [rem,dvsr:
FP, dblRes:
BOOL, mode:Mode]
RETURNS [c:HexDblWord, status:Dragon.PBusFaults] = {
FPComp:
PROC[x, y:
FP]
RETURNS[comp: {gr,ls,eq}] = {
comp ← eq;
FOR i:
CARDINAL
IN [0..4)
DO
IF x.m[i] = y.m[i] THEN LOOP;
RETURN[IF x.m[i]>y.m[i] THEN gr ELSE ls] ENDLOOP };
q: FP ← HDWtoFP[[0,0,NOT dblRes]];
IF rem.type=nan AND dvsr.type=nan THEN RETURN[FPtoHDW[rem], FPabNaN];
IF rem.type=nan THEN RETURN[FPtoHDW[rem], FPaNaN];
IF dvsr.type=nan THEN RETURN[FPtoHDW[dvsr], FPbNaN];
IF rem.double AND NOT dblRes THEN RETURN[FPtoHDW[rem], FPinvalid];
IF dvsr.double AND NOT dblRes THEN RETURN[FPtoHDW[dvsr], FPinvalid];
IF dvsr.type=zero THEN RETURN[FPtoHDW[dvsr], FPdivByZero];
rem.double ← dvsr.double ← dblRes;
rem.sign ← dvsr.sign ← rem.sign#dvsr.sign;
IF rem.type=zero THEN RETURN[FPtoHDW[rem], FPeqZeroE];
IF rem.type=inf AND dvsr.type=inf THEN
{SetToNaN[rem]; RETURN[FPtoHDW[rem], FPinvalid]};
IF rem.type=inf THEN RETURN[FPtoHDW[rem], FPlsInfE] ;
IF dvsr.type=inf THEN
{SetToZero[dvsr]; RETURN[FPtoHDW[dvsr], FPeqZeroE]};
q.sign ← rem.sign; rem.sign ← FALSE; dvsr.sign ← TRUE;
q.exp ← FPExpBias + 60 + rem.exp - dvsr.exp;
dvsr.exp ← rem.exp;
FOR i:
CARDINAL
IN [1..60]
DO
ShiftLt[q];
SELECT FPComp[rem, dvsr]
FROM
gr, eq => {
cy: CARDINAL ← 1;
[cy, rem.m[3]] ← ADC3[rem.m[3], Basics.BITNOT[dvsr.m[3]], cy];
[cy, rem.m[2]] ← ADC3[rem.m[2], Basics.BITNOT[dvsr.m[2]], cy];
[cy, rem.m[1]] ← ADC3[rem.m[1], Basics.BITNOT[dvsr.m[1]], cy];
[cy, rem.m[0]] ← ADC3[rem.m[0], Basics.BITNOT[dvsr.m[0]], cy];
IF SignificantBitsZero[rem] THEN SetToZero[rem] ELSE Normalize[rem];
q.m[3] ← q.m[3] + 1};
ENDCASE;
dvsr.exp ← dvsr.exp - 1
ENDLOOP;
Normalize[q];
status ← RoundFP[q, mode.rnd];
RETURN [ FPtoHDW[q], status ] };
FAdd:
PROC [a, b:
FP, dblRes:
BOOL, mode: Mode]
RETURNS [c: HexDblWord, status: Dragon.PBusFaults] = {
FPComp:
PROC[x, y:
FP]
RETURNS[r: {gr,ls,eq}] = {
r ← eq;
FOR i:
CARDINAL
IN [0..4)
DO
IF x.m[i] = y.m[i] THEN LOOP;
RETURN[IF x.m[i]>y.m[i] THEN gr ELSE ls] ENDLOOP };
IF a.type=nan AND b.type=nan THEN RETURN[FPtoHDW[a], FPabNaN];
IF a.type=nan THEN RETURN[FPtoHDW[a], FPaNaN];
IF b.type=nan THEN RETURN[FPtoHDW[b], FPbNaN];
IF a.double AND NOT dblRes THEN RETURN[FPtoHDW[a], FPinvalid];
IF b.double AND NOT dblRes THEN RETURN[FPtoHDW[b], FPinvalid];
a.double ← dblRes;
b.double ← dblRes;
IF a.type=inf
AND b.type=inf
THEN
IF a.sign = b.sign
THEN {a.double ← dblRes; RETURN[FPtoHDW[a], FPlsInfE]}
ELSE {SetToNaN[a]; RETURN[FPtoHDW[a], FPinvalid]};
IF a.type=inf THEN RETURN[FPtoHDW[a], FPlsInfE];
IF b.type=inf THEN RETURN[FPtoHDW[b], FPlsInfE];
IF a.type=zero
AND b.type=zero
THEN {
IF a.sign#b.sign THEN a.sign ← (mode.rnd=rm);
RETURN[FPtoHDW[a], FPeqZeroE]};
IF a.type=zero THEN RETURN[FPtoHDW[b], FPgrNEZeroE];
IF b.type=zero THEN RETURN[FPtoHDW[a], FPgrNEZeroE];
IF a.exp >= b.exp
THEN DeNormalize[b, a.exp - b.exp]
ELSE {DeNormalize[a, b.exp - a.exp]; a.exp ← b.exp};
IF a.sign = b.sign
THEN {
cy:CARDINAL ← 0;
[cy, a.m[3]] ← ADC3[a.m[3], b.m[3], cy];
[cy, a.m[2]] ← ADC3[a.m[2], b.m[2], cy];
[cy, a.m[1]] ← ADC3[a.m[1], b.m[1], cy];
[cy, a.m[0]] ← ADC3[a.m[0], b.m[0], cy];
IF cy # 0 THEN {DeNormalize[a,1]; a.m[0] ← a.m[0]+ 100000B} }
ELSE {
cy:CARDINAL ← 1;
IF FPComp[a,b]=ls THEN {c:FP ← a; a ← b; b ← c; a.exp ← b.exp};
[cy, a.m[3]] ← ADC3[a.m[3], Basics.BITNOT[b.m[3]], cy];
[cy, a.m[2]] ← ADC3[a.m[2], Basics.BITNOT[b.m[2]], cy];
[cy, a.m[1]] ← ADC3[a.m[1], Basics.BITNOT[b.m[1]], cy];
[cy, a.m[0]] ← ADC3[a.m[0], Basics.BITNOT[b.m[0]], cy];
IF SignificantBitsZero[a]
THEN {a.sign←mode.rnd=rm; SetToZero[a]}
ELSE Normalize[a]};
status ← RoundFP[a, mode.rnd];
RETURN [ FPtoHDW[a], status ] };
FCmp:
PROC [a, b:
FP, dblRes:
BOOL, mode: Mode]
RETURNS[c: HexDblWord, status: Dragon.PBusFaults] = {
status ←
SELECT
TRUE
FROM
a.double AND NOT dblRes => FPinvalid,
b.double AND NOT dblRes => FPinvalid,
a.type=nan OR b.type=nan => FPinvalid,
a.type=inf AND b.type=inf =>
(IF a.sign=b.sign THEN FPeqZeroE ELSE (IF a.sign THEN FPlsInfE ELSE FPgrNEZeroE)),
a.type=zero AND b.type=zero => FPeqZeroE,
a.type=zero OR b.type=inf => IF b.sign THEN FPgrNEZeroE ELSE FPlsInfE,
b.type=zero OR a.type=inf => IF a.sign THEN FPlsInfE ELSE FPgrNEZeroE,
a.sign#b.sign => IF a.sign THEN FPlsInfE ELSE FPgrNEZeroE,
ENDCASE => FPres4;
IF status # FPres4 THEN RETURN[[0, 0, NOT dblRes], status];
a.double ← b.double ← dblRes;
IF a.exp#b.exp
THEN RETURN[[0, 0, NOT dblRes], (IF ((a.exp>b.exp)=a.sign) THEN FPlsInfE ELSE FPgrNEZeroE)];
FOR i:
CARDINAL
IN [0..3]
DO
IF a.m[i]=b.m[i] THEN LOOP;
RETURN[[0, 0, NOT dblRes], (IF ((a.m[i]>b.m[i])=a.sign) THEN FPlsInfE ELSE FPgrNEZeroE)];
ENDLOOP;
RETURN[[0, 0, NOT dblRes], FPeqZeroE] };
UtoD:
PROC [a: HexDblWord, mode: Mode, exact:
BOOL]
RETURNS [c: HexDblWord, status: Dragon.PBusFaults] = {
fp: FP ← HDWtoFP[a];
IF fp.type#norm
THEN
{Dragon.Assert[FALSE, "Undefined"]; RETURN[[0, 0, a.single], FPinvalid]};
fp.exp ← fp.exp - WrapBias[fp];
IF fp.exp >= MinExp[fp]
THEN
{Dragon.Assert[FALSE, "Undefined"]; RETURN[[0, 0, a.single], FPinvalid]};
status ← RoundFP[fp, mode.rnd];
RETURN[FPtoHDW[fp], status] };
DtoW:
PROC [a: HexDblWord, mode: Mode]
RETURNS [c: HexDblWord, status: Dragon.PBusFaults] = {
fp: FP ← HDWtoFP[a];
IF fp.type#den
THEN
{Dragon.Assert[FALSE, "Undefined"]; RETURN[[0, 0, a.single], FPinvalid]};
fp.exp ← fp.exp + WrapBias[fp];
status ← RoundFP[fp, mode.rnd];
RETURN[FPtoHDW[fp], status] };
FtoI:
PROC [a: HexDblWord, mode: Mode]
-- Always returns I32
RETURNS [c: HexDblWord, status: Dragon.PBusFaults] = {
minInt: HexDblWord = [20000000000B, 0, FALSE];
maxInt: HexDblWord = [17777777777B, 0, FALSE];
long: Basics.LongNumber;
fp: FP ← HDWtoFP[a];
rnd: FPRndMode ← IF mode.fixRZ THEN rz ELSE mode.rnd;
exact: BOOL;
SELECT fp.type
FROM
zero => RETURN[ [0, 0, FALSE], FPeqZeroE];
nan, inf =>
IF fp.sign
THEN RETURN[minInt, FPoFlowI]
ELSE RETURN[maxInt, FPoFlowI];
ENDCASE => { };
DeNormalize[fp, FPExpBias+64-3-fp.exp]; -- rs on right
exact ← Fix[fp, rnd];
fp.m[3] ← Basics.BITAND[fp.m[3], 177774B]; -- Clear RS
ShiftRt[fp, 2];
IF exact THEN status𡤏PgrNEZeroE ELSE status𡤏PneZeroI;
IF fp.m[0]#0
OR fp.m[1]#0
OR fp.m[2]>=100000B
THEN
IF fp.sign
THEN RETURN[ minInt, FPoFlowI]
ELSE RETURN[ maxInt, FPoFlowI];
IF fp.m[2]=0
AND fp.m[3]=0
THEN RETURN[ [0, 0, FALSE], (IF exact THEN FPeqZeroE ELSE FPuFlowI)];
long.highbits ← fp.m[2]; long.lowbits ← fp.m[3];
IF fp.sign THEN long.li ← -long.li;
RETURN[[long.lc, 0, FALSE], status] };
ItoF:
PROC [a: HexDblWord, mode: Mode, resDbl:
BOOL]
RETURNS [c: HexDblWord, status: Dragon.PBusFaults] = {
long: Basics.LongNumber;
fp: FP ← NEW[FPRec ← []];
long.lc ← a.h;
IF long.lc = 0 THEN RETURN[ [0,0,NOT resDbl], FPeqZeroE];
fp.sign ← long.li < 0;
IF fp.sign THEN long.li ← -long.li;
fp.m[1] ← long.lowbits;
fp.m[0] ← long.highbits;
fp.exp ← FPExpBias + 31;
fp.double ← resDbl;
Normalize[fp];
status ← RoundFP[fp, mode.rnd];
RETURN[FPtoHDW[fp], status] };
FtoF:
PROC [a: HexDblWord, mode: Mode, resDbl:
BOOL]
RETURNS [c: HexDblWord, status: Dragon.PBusFaults] = {
fp: FP ← HDWtoFP[a];
fp.double ← resDbl;
status ← RoundFP[fp, mode.rnd];
RETURN[FPtoHDW[fp], status] };
HDWtoFP:
PROC[hdw: HexDblWord]
RETURNS[fp:
FP] = {
lo: BitOps.BitDWord ← Dragon.LTD[hdw.l];
hi: BitOps.BitDWord ← Dragon.LTD[hdw.h];
bitsZero: BOOL;
fp ← NEW[FPRec ← []];
fp.double ← NOT hdw.single;
IF fp.double
THEN {
fp.sign ← BitOps.EBFD[hi, 32, 0];
fp.exp ← BitOps.ECFD[hi, 32, 1, 11] + MinExp[fp] -1;
fp.m[0] ← BitOps.ECFD[hi, 32, 12, 16];
fp.m[1] ← BitOps.ECFD[hi, 32, 28, 4]*4096 + BitOps.ECFD[lo, 32, 0, 12];
fp.m[2] ← BitOps.ECFD[lo, 32, 12, 16];
fp.m[3] ← BitOps.ECFD[lo, 32, 28, 4]*4096 }
ELSE {
fp.sign ← BitOps.EBFD[hi, 32, 0];
fp.exp ← BitOps.ECFD[hi, 32, 1, 8] + MinExp[fp]-1;
fp.m[0] ← BitOps.ECFD[hi, 32, 9, 16];
fp.m[1] ← BitOps.ECFD[hi, 32, 25, 7]*512 };
bitsZero ← TRUE;
FOR i:CARDINAL IN [0..3] DO IF fp.m[i]#0 THEN bitsZero ← FALSE ENDLOOP;
SELECT
TRUE
FROM
fp.exp > MaxExp[fp] AND bitsZero => {fp.type ← inf; fp.exp ← 32585};
fp.exp > MaxExp[fp] AND NOT bitsZero => {fp.type ← nan; fp.exp ← 32585};
fp.exp < MinExp[fp] AND bitsZero => {fp.type ← zero; fp.exp ← 0};
fp.exp < MinExp[fp] AND NOT bitsZero => {fp.type ← den; Normalize[fp]};
ENDCASE => {
fp.type ← norm;
DeNormalize[fp, 1];
fp.exp ← fp.exp-1;
fp.m[0] ← fp.m[0]+100000B} };
FPtoHDW:
PROC[fp:
FP]
RETURNS[hdw: HexDblWord] = {
DblShiftLt:
PROC[a, b, n:
CARDINAL]
RETURNS[
CARDINAL] = {
THROUGH (0..n] DO a ← a*2 + b/32768; b ← b*2 ENDLOOP;
RETURN[a]};
exp: CARDINAL;
eSize: CARDINAL ← IF fp.double THEN 11 ELSE 8;
lo, hi: BitOps.BitDWord ← [0,0];
IF fp.exp
IN (0..MinExp[fp])
THEN {
-- denormalized, assume already rounded
fp.type ← den;
DeNormalize[fp, MinExp[fp]-1-fp.exp]};
SELECT fp.type
FROM
nan, inf => exp ← MaxExp[fp]+1-FPExpBias;
zero, den => exp ← 0;
ENDCASE => {
-- type=norm, hide msb which should be 1
IF fp.m[0]<100000B THEN ERROR;
ShiftLt[fp]; fp.exp ← fp.exp+1; -- undo decrement of exp
exp ← fp.exp-(MinExp[fp]-1) };
IF fp.type=zero OR fp.type=inf THEN fp.m ← ALL[0];
IF fp.type=nan THEN fp.m ← ALL[177777B];
hi ← BitOps.IBID[fp.sign, hi, 32, 0];
hi ← BitOps.ICID[exp, hi, 32, 1, eSize];
hi ← BitOps.ICID[DblShiftLt[0, fp.m[0], 15-eSize], hi, 32, eSize+1, 15-eSize];
hi ← BitOps.ICID[DblShiftLt[fp.m[0], fp.m[1], 15-eSize], hi, 32, 16, 16];
lo ← BitOps.ICID[DblShiftLt[fp.m[1], fp.m[2], 15-eSize], lo, 32, 0, 16];
lo ← BitOps.ICID[DblShiftLt[fp.m[2], fp.m[3], 15-eSize], lo, 32, 16, 16];
hdw.single ← NOT fp.double;
hdw.h ← BitOps.ELFD[hi,32,0,32];
hdw.l ← IF fp.double THEN BitOps.ELFD[lo,32,0,32] ELSE 0 };
RoundMult:
PROC [fp:
FP, mode: Mode]
RETURNS[status: Dragon.PBusFaults] = {
fp normalized, (not zero, not inf, not nan)
saveFP: FPRec ← fp^;
exact: BOOL ← Round[fp, mode.rnd];
IF exact THEN status𡤏PgrNEZeroE ELSE status𡤏PneZeroI;
IF fp.exp < MinExp[fp]
THEN
IF mode.fast
THEN {SetToZero[fp]; exact ← TRUE; RETURN[FPeqZeroE]}
ELSE {
fp^ ← saveFP;
fp.exp ← fp.exp + WrapBias[fp];
IF exact THEN RETURN[FPuFlow] ELSE RETURN[FPuFlowI] };
IF fp.exp > MaxExp[fp] THEN {RETURN[OverFlow[fp, mode.rnd]]} };
RoundFP:
PROC [fp:
FP, rnd: FPRndMode]
RETURNS[status: Dragon.PBusFaults] = {
Possible results: FPeqZeroE, FPlsInfE, FPgrNEZeroE, FPneZeroI, FPoFlowI, FPuFlow, FPuFlowI, FPinvalid
exact: BOOL;
SELECT
TRUE
FROM
fp.type=nan => RETURN[FPinvalid];
fp.type=zero => RETURN[FPeqZeroE];
fp.type=inf => RETURN[FPlsInfE];
ENDCASE;
exact ← Round[fp, rnd];
IF exact THEN status𡤏PgrNEZeroE ELSE status𡤏PneZeroI;
IF fp.exp < MinExp[fp] THEN IF exact THEN RETURN[FPuFlow] ELSE RETURN[FPuFlowI];
IF fp.exp > MaxExp[fp] THEN RETURN[OverFlow[fp, rnd]] };
Round:
PROC[fp:
FP, rnd: FPRndMode]
RETURNS[exact:
BOOL] = {
IF fp.exp<MinExp[fp] THEN DeNormalize[fp, MinExp[fp]-fp.exp];
DeNormalize[fp, (IF fp.double THEN (11-2) ELSE (32+8-2))]; -- rs on right
exact ← Fix[fp, rnd];
fp.m[3] ← Basics.BITAND[fp.m[3], 177774B]; -- Clear RS
Normalize[fp];
RETURN[exact]};
Fix:
PROC[fp:
FP, rnd: FPRndMode]
RETURNS[exact:
BOOL] = {
Add:
PROC[cy:
CARDINAL] = {
FOR i:
CARDINAL
DECREASING
IN [0..3]
DO
[cy, fp.m[i]] ← ADC3[fp.m[i], 0, cy] ENDLOOP };
lrs:CARDINAL ← fp.m[3] MOD 8;
IF lrs#0
THEN
SELECT rnd
FROM
rz => { };
rn => IF lrs=3 OR lrs=6 OR lrs=7 THEN Add[4];
rp => IF NOT fp.sign THEN Add[3];
rm => IF fp.sign THEN Add[3];
ENDCASE;
RETURN[lrs MOD 4 = 0]};
OverFlow:
PROC[fp:
FP, rnd: FPRndMode]
RETURNS[status: Dragon.PBusFaults] = {
SELECT rnd
FROM
rn => SetToInf[fp];
rz => SetToMax[fp];
rp => IF fp.sign THEN SetToMax[fp] ELSE SetToInf[fp];
rm => IF fp.sign THEN SetToInf[fp] ELSE SetToMax[fp];
ENDCASE;
RETURN[FPoFlowI] };
Normalize:
PROC [fp:
FP] = {
IF fp.m[0] = 0
AND fp.m[1] = 0
AND fp.m[2] = 0
AND fp.m[3]/2 = 0
THEN
{SetToZero[fp]; RETURN};
WHILE fp.m[0] = 0
DO
fp.m[0] ← fp.m[1]; fp.m[1] ← fp.m[2]; fp.m[2] ← fp.m[3]; fp.m[3] ← 0;
IF (fp.m[2] MOD 2 = 1) THEN {fp.m[2] ← fp.m[2] - 1; fp.m[3] ← 1};
fp.exp ← fp.exp-16;
ENDLOOP;
WHILE fp.m[0] < 100000B
DO
ShiftLt[fp];
IF (fp.m[3] MOD 4 = 2) THEN fp.m[3] ← fp.m[3] - 1;
ENDLOOP };
ShiftLt:
PROC [fp:
FP] = {
FOR i:
CARDINAL
IN [0..2]
DO
fp.m[i] ← fp.m[i]*2;
IF fp.m[i+1] > 77777B THEN fp.m[i] ← fp.m[i] + 1;
ENDLOOP;
fp.m[3] ← fp.m[3]*2;
DeNormalize:
PROC [fp:
FP, count:
INTEGER] = {
WHILE count/16 # 0
DO
fp.m[3] ← fp.m[2] + (IF (fp.m[3]#0) AND ((fp.m[2] MOD 2)=0) THEN 1 ELSE 0);
fp.m[2] ← fp.m[1]; fp.m[1] ← fp.m[0]; fp.m[0] ← 0;
fp.exp ← fp.exp+16;
count ← count-16
ENDLOOP;
THROUGH (0..count]
DO
IF (fp.m[3] MOD 3 = 1) THEN fp.m[3] ← fp.m[3] + 2;
ShiftRt[fp, 1];
ENDLOOP };
ShiftRt:
PROC [fp:
FP, count:
CARDINAL] = {
THROUGH (0..count]
DO
FOR i:
CARDINAL
DECREASING
IN [1..3]
DO
fp.m[i] ← fp.m[i]/2;
IF fp.m[i-1] MOD 2 = 1 THEN fp.m[i] ← fp.m[i] + 100000B;
ENDLOOP;
fp.m[0] ← fp.m[0]/2;
fp.exp ← fp.exp+1;
ENDLOOP };
ADC3:
PROC[a, b, c:
CARDINAL]
RETURNS[cy, sum:
CARDINAL] = {
ln: Basics.LongNumber;
ln.lc ← LONG[a] + LONG[b] + LONG[c];
RETURN[ln.highbits, ln.lowbits] };
SignificantBitsZero:
PROC[fp:
FP]
RETURNS[zero:
BOOL] = {
IF fp.double
THEN RETURN[fp.m[0]=0 AND fp.m[1]=0 AND fp.m[2]=0 AND fp.m[3]/2048=0]
ELSE RETURN[fp.m[0]=0 AND fp.m[1]/256=0]};
SetToZero: PROC[fp:FP] = {fp.type←zero; fp.exp𡤀 fp.m←ALL[0]};
SetToNaN:
PROC[fp:
FP] =
{fp^ ← [fp.double, nan, fp.sign, MaxExp[fp]+1, ALL[177777B]]};
SetToInf:
PROC[fp:
FP] =
{fp^ ← [fp.double, inf, fp.sign, MaxExp[fp]+1, ALL[0]]};
SetToMax:
PROC[fp:
FP] =
{fp^ ← [fp.double, norm, fp.sign, MaxExp[fp], ALL[0]];
IF fp.double
THEN {fp.m[0]𡤏p.m[1]𡤏p.m[2]� fp.m[3]�}
ELSE {fp.m[0]� fp.m[1]�}};
MinExp:
PROC[fp:
FP]
RETURNS[
CARDINAL] = {
RETURN[(IF fp.double THEN FPExpBias-1022 ELSE FPExpBias-126)]};
MaxExp:
PROC[fp:
FP]
RETURNS[
CARDINAL] = {
RETURN[(IF fp.double THEN FPExpBias+1022 ELSE FPExpBias+126)]};
WrapBias:
PROC[fp:
FP]
RETURNS[
CARDINAL] = {
RETURN[IF fp.double THEN 2048 ELSE 256]};
END.