WeitekIeeeImplA:
PROGRAM
IMPORTS PascalNoviceFiles, WeitekIeee EXPORTS WeitekIeee =PUBLIC
BEGIN OPEN PascalBasic, PascalNoviceFiles, WeitekIeee;
Comments From Weitek File: Fred.pas:
Last modification <840120.1607>
COPYRIGHT (c) 1984 WEITEK INC
Known Bugs:
If the remainder is zero, its sign should be that of the divid}
Extended has two flavors of the smallest exponent
Unnormal zero's don't add properly
Extended not well tested
This program contains IEEE-compatable arithmetic
routines. They are externally callable, using
single, double, or Extended precision.
Entry point Operation
- - - - - - - - - - - - - - - - - - - -
ADDS Add, single precision
ADDD Add, double precision
ADDE Add, Extended precision
SUBS Subtract, single precision
SUBD Subtract, double precision
SUBE Subtract, Extended precision
MULS MULTIPLY, single precision
MULD MULTIPLY, double precision
MULE MULTIPLY, Extended precision
DIVS Divide, single precision
DIVD Divide, double precision
DIVE Divide, Extended precision
* REMS Remainder, single precision
* REMD Remainder, double precision
* REME Remainder, Extended precision
* SQRTS Square root, single precision
* SQRTD Square root, double precision
* SQRTE Square root, Extended precision
* CONSD Convert single to double precision
* CONSE Convert single to Extended precision
* CONSH Convert single to 16 bit integer
* CONSI Convert single to 32 bit integer
* CONDS Convert double to single precision
* CONDE Convert double to Extended precision
* CONDH Convert double to 16 bit integer
* CONDI Convert double to 32 bit integer
* CONES Convert Extended to single precision
* CONED Convert Extended to double precision
* CONEH Convert Extended to 16 bit integer
* CONEI Convert Extended to 32 bit integer
* CONIS Convert 32 bit integer to single
* CONID Convert 32 bit integer to double
* CONIE Convert 32 bit integer to Extended
* CONIH Convert 32 bit integer to 16 bit integer
* CONHS Convert 16 bit integer to single
* CONHD Convert 16 bit integer to double
* CONHE Convert 16 bit integer to Extended
* CONHI Convert 16 bit integer to 32 bit integer
INTS Integerize, single precision
INTD Integerize, double precision
INTE Integerize, Extended precision
* SDECBIN Convert decimal string to single precision binary
* DDECBIN Convert decimal string to double precision binary
* EDECBIN Convert decimal string to Extended precision binary
SCOMPARE Compare, single precision
DCOMPARE Compare, double precision
ECOMPARE Compare, Extended precision
* SBINDEC Convert single precision binary to decimal string
* DBINDEC Convert double precision binary to decimal string
* EBINDEC Convert Extended precision binary to decimal string
* COPYSIGN Op1 gets op2's sign
* SCALB Adds N to X's exponent
* LOGB Returns unbiased exponent of X
* NEXTAFTER Next representable X in direction of Y
* FINITE True if finite
* ISNAN True if NaN
* UNORDERED True if unordered
* CLASS 1=tNaN, 2=ntNaN, 3=-inf, 4=-norm, 5=-unnorm
6=-denorm, 7=-0, 8=+0, 9=+denorm, 10=+unnorm,
11=+norm, 12=+inf
* Not finished yet
Halt:
PROCEDURE [HaltCode: PascalInteger] = {
PascalWriteLongString[file: @Output, item: "fatal error: code="];
PascalWriteInteger[file: @Output, item: HaltCode];
PascalWriteLn[file: @Output];
ERROR Error99 };
Xor:
PROCEDURE [
A,
B: Bit]
RETURNS [XorResult: Bit] =
--Exclusive OR
{IF A = B THEN XorResult ← 0 ELSE XorResult ← 1};
Zero:
PROCEDURE [
--Returns Normal Zero, undefined sign
Result: LONG POINTER TO Number, Gvars: LONG POINTER TO Gvarstype] = {
OPEN Gvars^;
I: PascalInteger [1..MantBits];
Result^.Expon ← MinExp; --exponent is format's minimum
FOR i: INT IN [INT[1]..INT[MantPrec]] DO I ← i; Result^.Mant[I] ← 0 ENDLOOP};
Pluszero:
PROCEDURE [
--Returns Positive Normal Zero
Result: LONG POINTER TO Number, Gvars: LONG POINTER TO Gvarstype] = {
Zero[@Result^, @Gvars^];
Result^.Sign ← 0}; --0=positive
Minuszero:
PROCEDURE [
--Returns Negative Normal Zero
Result: LONG POINTER TO Number, Gvars: LONG POINTER TO Gvarstype] = {
Zero[@Result^, @Gvars^];
Result^.Sign ← 1}; --1=negative
Returns True if all significand bits are zero.
Number of significand bits checked is the current format's precision
Issignificandzero:
PROCEDURE [
N: LONG POINTER TO Number, Gvars: LONG POINTER TO Gvarstype]
RETURNS [IssignificandzeroResult: PascalBoolean] = {
OPEN N^, Gvars^;
I: PascalInteger [1..MantBitsP1];
OkSoFar: PascalBoolean;
OkSoFar ← TRUE;
I ← 1;
WHILE (
INT[
I] <= MantPrec)
AND OkSoFar
DO
OkSoFar ← OkSoFar AND (Mant[I] = 0); I ← I + 1 ENDLOOP;
IssignificandzeroResult ← OkSoFar
AND (Guard = 0)
AND (Round = 0)
AND (Sticky = 0)};
Iszero:
PROCEDURE [
--See if N zero; may be + or - or unnormal
N: LONG POINTER TO Number, Gvars: LONG POINTER TO Gvarstype]
RETURNS [IszeroResult: PascalBoolean] = {
IszeroResult ← Issignificandzero[@N^, @Gvars^] AND (N^.Expon # Gvars^.MaxExp + 1) };
not a NaN or infinity
Isnormalzero:
PROCEDURE [
--See if N is normal zero; may be positive or negative
N: LONG POINTER TO Number, Gvars: LONG POINTER TO Gvarstype]
RETURNS [IsnormalzeroResult: PascalBoolean] = {
IsnormalzeroResult ← Issignificandzero[@
N^, @Gvars^]
AND (N^.Expon = Gvars^.MinExp) };
Isinfinity:
PROCEDURE [
--See if op is infinity, ignore sign
N: LONG POINTER TO Number, Gvars: LONG POINTER TO Gvarstype]
RETURNS [IsinfinityResult: PascalBoolean] = {
IsinfinityResult ← (
N^.Expon = Gvars^.MaxExp + 1)
AND Issignificandzero[@N^, @Gvars^] };
Isnan:
PROCEDURE [
--See if op is a NaN
N: LONG POINTER TO Number, Gvars: LONG POINTER TO Gvarstype]
RETURNS [IsnanResult: PascalBoolean] = {
IsnanResult ← (
N^.Expon = Gvars^.MaxExp + 1)
AND (NOT Issignificandzero[@N^, @Gvars^]) };
Return True if op is a trapping NaN
This routine is implementation dep}ent!
Criteria used here is that most significant explicit mantissa bit
is 1 if trapping
Istrappingnan:
PROCEDURE [
N: LONG POINTER TO Number, Gvars: LONG POINTER TO Gvarstype]
RETURNS [IstrappingnanResult: PascalBoolean] = {
IF (Gvars^.Format = Single)
OR (Gvars^.Format = Double)
hidden leading
THEN IstrappingnanResult ← Isnan[@N^, @Gvars^] AND (N^.Mant[2] = 1)
explicit leading
ELSE IstrappingnanResult ←Isnan[@N^, @Gvars^] AND (N^.Mant[1] = 1)};
Isfinite:
PROCEDURE [
N: LONG POINTER TO Number, Gvars: LONG POINTER TO Gvarstype]
RETURNS [IsfiniteResult: PascalBoolean] =
{IsfiniteResult ← NOT (Isinfinity[@N^, @Gvars^] OR Isnan[@N^, @Gvars^])};
Issame:
PROCEDURE [
N1, N2: LONG POINTER TO Number, Gvars: LONG POINTER TO Gvarstype]
RETURNS [IssameResult: PascalBoolean] = {--slow
I: PascalInteger;
IssameResult ← TRUE;
IF (N1^.Sign # N2^.Sign)
OR (N1^.Expon # N2^.Expon)
THEN IssameResult ← FALSE
ELSE
FOR i:
INT
IN [
INT[1]..
INT[Gvars^.MantPrec]]
DO
I ← i; IF N1^.Mant[I] # N2^.Mant[I] THEN IssameResult ← FALSE ENDLOOP};
Return true if N is unnormalized, includes denormalized
Returns false for normal zero, true for unnormal zero
Isunnormalized:
PROCEDURE [
N: LONG POINTER TO Number, Gvars: LONG POINTER TO Gvarstype]
RETURNS [IsunnormalizedResult: PascalBoolean] =
{IsunnormalizedResult ← (N^.Mant[1] = 0) AND NOT Isnormalzero[@N^, @Gvars^]};
Return True if N is denormalized
Zero is not denormalized.
Isdenormalized:
PROCEDURE [
N: LONG POINTER TO Number, Gvars: LONG POINTER TO Gvarstype]
RETURNS [IsdenormalizedResult: PascalBoolean] =
{IsdenormalizedResult ← Isunnormalized[@
N^, @Gvars^]
AND (N^.Expon = Gvars^.MinExp)};
Return True if N is normalized.
Returns false for zero.
Isnormalized:
PROCEDURE [
N: LONG POINTER TO Number, Gvars: LONG POINTER TO Gvarstype]
RETURNS [IsnormalizedResult: PascalBoolean] =
{IsnormalizedResult ← (N^.Mant[1] = 1)};
Implementation Dependent!
Returns a trapping NaN. Definition of trapping used here is that
Most significant explicit mantissa bit is 1, all other mant bits set to zero
Gettrappingnan:
PROCEDURE [
Result: LONG POINTER TO Number, Gvars: LONG POINTER TO Gvarstype] = {
I: PascalInteger [1..MantBits];
Result^.Sign ← 0;
Result^.Expon ← Gvars^.MaxExp + 1;
FOR i:
INT
IN [
INT[1]..
INT[Gvars^.MantPrec]]
DO
I ← i; Result^.Mant[I] ← 0 ENDLOOP;
IF (Gvars^.Format = Single)
OR (Gvars^.Format = Double)
THEN Result^.Mant[2] ← 1 --most sig explicit mant bit
ELSE Result^.Mant[1] ← 1}; --most sig explicit mant bit
Implementation Dependent!
Criteria used here is that most significant explicit mantissa bit is
zero; here the following bit is set to one to distinguish from infinity
Getnontrappingnan:
PROCEDURE [
Result: LONG POINTER TO Number, Gvars: LONG POINTER TO Gvarstype] = {
I: PascalInteger [1..MantBits];
Result^.Sign ← 0;
Result^.Expon ← Gvars^.MaxExp + 1;
FOR i:
INT
IN [
INT[1]..
INT[Gvars^.MantPrec]]
DO
I ← i; Result^.Mant[I] ← 0 ENDLOOP;
IF (Gvars^.Format = Single)
OR (Gvars^.Format = Double)
THEN Result^.Mant[3] ← 1 --hidden msb
ELSE Result^.Mant[2] ← 1}; --explicit msb
Return Trapping NaN if invalid trap enabled, else Nontrapping
Getnan:
PROCEDURE [
Result: LONG POINTER TO Number, Modes: LONG POINTER TO Modestype,
Gvars: LONG POINTER TO Gvarstype] = {
IF Modes^.InvalidTrap = Enabled
THEN Gettrappingnan[@Result^, @Gvars^]
ELSE Getnontrappingnan[@Result^, @Gvars^]};
Both op's are NaN's, pick one
This routine is implementation dep}ent!
Selectnan:
PROCEDURE [
Result: LONG POINTER TO Number, Op1, Op2: LONG POINTER TO Number] =
{Result^ ← Op1^};
Return positive infinity
Plusinf:
PROCEDURE [
Result: LONG POINTER TO Number, Gvars: LONG POINTER TO Gvarstype] = {
I: PascalInteger [1..MantBits];
Result^.Sign ← 0;
Result^.Expon ← Gvars^.MaxExp + 1;
FOR i:
INT
IN [
INT[1]..
INT[Gvars^.MantPrec]]
DO
I ← i; Result^.Mant[I] ← 0 ENDLOOP};
Find left-most one, far left is 0, far right is mant←prec-1, none is -1
guard is mant←prec, round is mant←prec+1, sticky is mant←prec+2
Flmo:
PROCEDURE [
Op: LONG POINTER TO MantArray, Gvars: LONG POINTER TO Gvarstype]
RETURNS [FlmoResult: PascalInteger] = {
OPEN Gvars^;
I: PascalInteger [1..MantBits];
FlmoResult ← -1;
IF Sticky = 1 THEN FlmoResult ← MantPrec + 2;
IF Round = 1 THEN FlmoResult ← MantPrec + 1;
IF Guard = 1 THEN FlmoResult ← MantPrec;
FOR i:
INT
DECREASING
IN [
INT[1]..
INT[MantPrec]]
DO
I ← i; IF Op^[I] = 1 THEN FlmoResult ← I - 1 ENDLOOP};
Unreadable without Coonan's Implementation Guide
Oneoperandcase:
PROCEDURE [
Op: LONG POINTER TO Number,
Gvars: LONG POINTER TO Gvarstype]
RETURNS [OneoperandcaseResult: Oneoperandtype] = {
IF Isnormalzero[@Op^, @Gvars^]
THEN OneoperandcaseResult ← Pmzero
ELSE
IF Isinfinity[@Op^, @Gvars^]
THEN OneoperandcaseResult ← Pminf
ELSE
IF Isnan[@Op^, @Gvars^]
THEN OneoperandcaseResult ← Nan
ELSE OneoperandcaseResult ← W};
Unreadable without Coonan's Implementation Guide
type row = array[oneoperandtype] of twooperandtype;
tabletype = array[oneoperandtype] of row;
const TABLE = tabletype[row[a, b, c, Y],
row[d, e, f, Y],
row[g, h, i, Y],
row[X, X, X, M]];
Twooperandcase:
PROCEDURE [
Op1, Op2: LONG POINTER TO Number,
Gvars: LONG POINTER TO Gvarstype]
RETURNS [TwooperandcaseResult: Twooperandtype] = {
twooperandcase:=table[oneoperandcase(op1,gvars)][oneoperandcase(op2,gvars)]
SELECT Oneoperandcase[@Op1^, @Gvars^]
FROM
Pmzero =>
SELECT Oneoperandcase[@Op2^, @Gvars^]
FROM
Pmzero => TwooperandcaseResult ← A;
W => TwooperandcaseResult ← B;
Pminf => TwooperandcaseResult ← C;
Nan => TwooperandcaseResult ← Y;
ENDCASE;
W =>
SELECT Oneoperandcase[@Op2^, @Gvars^]
FROM
Pmzero => TwooperandcaseResult ← D;
W => TwooperandcaseResult ← E;
Pminf => TwooperandcaseResult ← F;
Nan => TwooperandcaseResult ← Y;
ENDCASE;
Pminf =>
SELECT Oneoperandcase[@Op2^, @Gvars^]
FROM
Pmzero => TwooperandcaseResult ← G;
W => TwooperandcaseResult ← H;
Pminf => TwooperandcaseResult ← I;
Nan => TwooperandcaseResult ← Y;
ENDCASE;
Nan =>
SELECT Oneoperandcase[@Op2^, @Gvars^]
FROM
Pmzero => TwooperandcaseResult ← X;
W => TwooperandcaseResult ← X;
Pminf => TwooperandcaseResult ← X;
Nan => TwooperandcaseResult ← M;
ENDCASE;
ENDCASE};
shift significand left, no exponent change, use G,R,S,carry
Shftl:
PROCEDURE [
N: LONG POINTER TO Number, D: PascalInteger,
Gvars: LONG POINTER TO Gvarstype] = {
OPEN N^, Gvars^;
I: PascalInteger [1..MantBitsM1];
Cntr: PascalInteger;
IF D > MantPrec + 3 THEN D ← MantPrec + 3; --allows shift sticky to carry
FOR i:
INT
IN [
INT[1]..
INT[
D]]
DO
Cntr ← i;
IF Carry = 1 THEN Halt[1]; --Shouldn't happen.
Carry ← Mant[1];
FOR i:
INT
IN [
INT[1]..
INT[MantPrec - 1]]
DO
I ← i; Mant[I] ← Mant[I + 1] ENDLOOP;
Mant[MantPrec] ← Guard;
Guard ← Round;
Round ← Sticky; --sticky := sticky
ENDLOOP};
shift significand right, D places, no exp change, use G,R,S,carry
Shftr:
PROCEDURE [
N: LONG POINTER TO Number, D: PascalInteger,
Gvars: LONG POINTER TO Gvarstype] = {
OPEN N^, Gvars^;
I: PascalInteger [2..MantBits];
Cntr: PascalInteger;
IF D > MantPrec + 3 THEN D ← MantPrec + 3; --allows shift carry to sticky
FOR i:
INT
IN [
INT[1]..
INT[
D]]
DO
Cntr ← i;
IF Sticky = 0 THEN Sticky ← Round;
Round ← Guard;
Guard ← Mant[MantPrec];
FOR i:
INT
DECREASING
IN [
INT[2]..
INT[MantPrec]]
DO
I ← i; Mant[I] ← Mant[I - 1] ENDLOOP;
Mant[1] ← Carry;
Carry ← 0;
ENDLOOP};
If N is trapping NaN, set Invalid
If normalizing mode, normalize denormalized operand.
Examine:
PROCEDURE [
N: LONG POINTER TO Number, Modes: LONG POINTER TO Modestype,
Indics: LONG POINTER TO Indicstype, Gvars: LONG POINTER TO Gvarstype]
RETURNS [ExamineResult: PascalBoolean] = {
OPEN Modes^, Indics^, Gvars^;
Shiftdist: PascalInteger;
IF Istrappingnan[@
N^, @Gvars^]
THEN {SetInvalid[@Indics^]; ExamineResult ← FALSE}
ELSE {
ExamineResult ← TRUE;
IF (UnderMode = Normalizing)
AND Isdenormalized[@
N^, @Gvars^]
THEN {
OPEN N^;
Shiftdist ← Flmo[@Mant, @Gvars^];
Shftl[@N^, Shiftdist, @Gvars^];
Expon ← Expon - Shiftdist} } };
Roundnum:
PROCEDURE [
N: LONG POINTER TO Number, Modes: LONG POINTER TO Modestype,
Indics: LONG POINTER TO Indicstype, Gvars: LONG POINTER TO Gvarstype]={--uses GRS
Increment:
PROCEDURE [
M:
LONG
POINTER
TO MantArray] = {
I: PascalInteger [1..MantBits];
Sum: PascalInteger [0..2];
C: Bit;
Sum ← 0;
C ← 1;
FOR i:
INT
DECREASING
IN [
INT[1]..
INT[Gvars^.MantPrec]]
DO
I ← i; Sum ← M^[I] + C; M^[I] ← Sum MOD 2; C ← Sum/2; ENDLOOP;
IF Gvars^.Carry = 1 THEN Halt[2];
Gvars^.Carry ← C}; --what if this carry's out???
BEGIN
OPEN
N^, Modes^, Indics^, Gvars^;
IF (Guard = 1)
OR (Round = 1)
OR (Sticky = 1)
THEN {
SetInexact[@Indics^];
SELECT RoundMode
FROM
Rp =>
IF (Sign = 0)
THEN {
Increment[@Mant];
IF Carry = 1 THEN {Shftr[@N^, 1, @Gvars^]; Expon ← Expon + 1} };
Rm =>
IF (Sign = 1)
THEN {
Increment[@Mant];
IF Carry = 1 THEN {Shftr[@N^, 1, @Gvars^]; Expon ← Expon + 1} };
Rz => --nada-- NULL;
Rn =>
IF (Guard = 1)
AND (((Round = 1)
OR (Sticky = 1))
OR ((Round = 0)
AND (Sticky = 0)
AND (Mant[MantPrec] = 1)))
THEN {
Increment[@Mant];
IF Carry = 1 THEN {Shftr[@N^, 1, @Gvars^]; Expon ← Expon + 1} };
ENDCASE}
END };
Addsignificands:
PROCEDURE [
Result: LONG POINTER TO MantArray, Op1, Op2: LONG POINTER TO MantArray,
Gvars: LONG POINTER TO Gvarstype] = {
OPEN Gvars^;
I, Sum: PascalInteger;
FOR i:
INT
DECREASING
IN [
INT[1]..
INT[MantPrec]]
DO
I ← i;
Sum ← Op1^[I] + Op2^[I] + Carry;
Result^[I] ← Sum MOD 2;
Carry ← Sum/2;
ENDLOOP};
Used by ADD, assumes that operands are aligned, GRS set by alignment
Addoperands:
PROCEDURE [
Result: LONG POINTER TO Number, Op1, Op2: LONG POINTER TO Number,
Gvars: LONG POINTER TO Gvarstype] = {
C: Bit;
Compl:
PROCEDURE [
N:
LONG
POINTER
TO MantArray] = {
OPEN Gvars^;
I: PascalInteger;
FOR i:
INT
DECREASING
IN [
INT[1]..
INT[MantPrec]]
DO
I ← i; N^[I] ← 1 - N^[I] ENDLOOP;
Guard ← 1 - Guard;
Round ← 1 - Round;
Sticky ← 1 - Sticky};
Addtogrs:
PROCEDURE = {
--add carry to g,r,s
OPEN Gvars^;
Sum: PascalInteger [0..2];
Sum ← Carry + Sticky;
Sticky ← Sum MOD 2;
Carry ← Sum/2;
Sum ← Carry + Round;
Round ← Sum MOD 2;
Carry ← Sum/2;
Sum ← Carry + Guard;
Guard ← Sum MOD 2;
Carry ← Sum/2};
BEGIN
OPEN Gvars^;
IF Isnormalzero[@Op1^, @Gvars^] THEN Op1^.Expon ← Op2^.Expon;
IF Isnormalzero[@Op2^, @Gvars^] THEN Op2^.Expon ← Op1^.Expon;
IF Op1^.Expon # Op2^.Expon THEN Halt[3]; --Ref: Hwang, COMPUTER ARITHMETIC
Result^.Expon ← Op1^.Expon; -- Wiley&Sons, 1979, p. 73
Extended by adding extra msb
Carry ← 0;
IF Op1^.Sign # Op2^.Sign THEN Compl[@Op2^.Mant];
Addtogrs[];
Addsignificands[@Result^.Mant, @Op1^.Mant, @Op2^.Mant, @Gvars^];
C ← (Carry + Xor[Op1^.Sign, Op2^.Sign])/2;
Carry ← (Carry + Xor[Op1^.Sign, Op2^.Sign]) MOD 2;
IF
C = 1
THEN {
Carry ← 1;
Addtogrs[];
Addsignificands[@Result^.Mant, @Op1^.Mant, @Op2^.Mant, @Gvars^];
C ← (Carry + Xor[Op1^.Sign, Op2^.Sign])/2;
Carry ← (Carry + Xor[Op1^.Sign, Op2^.Sign]) MOD 2};
IF (
C = 0)
AND (Op1^.Sign # Op2^.Sign)
THEN
{Compl[@Result^.Mant]; Carry ← 1 - Carry};
IF C = 1 THEN Result^.Sign ← Op1^.Sign ELSE Result^.Sign ← Op2^.Sign;
END};
Multsignificands:
PROCEDURE [
Result: LONG POINTER TO Number, Op1, Op2: LONG POINTER TO Number,
Gvars: LONG POINTER TO Gvarstype] = {
OPEN Result^, Gvars^;
I: PascalInteger [1..MantBits];
FOR i: INT IN [INT[1]..INT[MantPrec]] DO I ← i; Mant[I] ← 0 ENDLOOP; --clean it up
FOR i:
INT
DECREASING
IN [
INT[1]..
INT[MantPrec]]
DO
I ← i;
Shftr[@Result^, 1, @Gvars^];
IF Op2^.Mant[I] = 1 THEN Addsignificands[@Mant, @Mant, @Op1^.Mant, @Gvars^];
ENDLOOP};
Dividesignificands:
PROCEDURE [
Result: LONG POINTER TO Number, Op1, Op2: LONG POINTER TO Number,
Gvars: LONG POINTER TO Gvarstype] = {
OPEN Gvars^;
I: PascalInteger [1..MantBitsP1];
J: PascalInteger [1..MantBitsP2];
Done: PascalBoolean;
Dif: PascalInteger [0..3];
Borrow: Bit;
G, R: Bit;
Doit: PascalBoolean;
FOR i: INT IN [INT[1]..INT[MantPrec]] DO I ← i; Result^.Mant[I] ← 0 ENDLOOP; --clean up
FOR i:
INT
IN [
INT[1]..
INT[MantPrec + 2]]
DO
J ← i; --compute result[j]gr and update divid
Done ← FALSE;
I ← 1;
Doit ← TRUE;
IF J = (MantPrec + 2) THEN R ← 1
ELSE IF J = (MantPrec + 1) THEN G ← 1 ELSE Result^.Mant[J] ← 1;
WHILE (
INT[
I] <= MantPrec)
AND
NOT Done
DO
{ --see which is bigger
IF (Carry = 1)
OR (Op1^.Mant[
I] # Op2^.Mant[
I])
THEN {
Done ← TRUE;
IF (Carry = 0)
AND (
INT[Op1^.Mant[
I]] < Op2^.Mant[
I])
THEN {
IF J = (MantPrec + 2) THEN R ← 0
ELSE IF J = (MantPrec + 1) THEN G ← 0 ELSE Result^.Mant[J] ← 0;
Doit ← FALSE} };
I ← I + 1}
ENDLOOP;
IF Doit
THEN {
--subtract
Borrow ← 1;
FOR i:
INT
DECREASING
IN [
INT[1]..
INT[MantPrec]]
DO
I ← i;
Dif ← Op1^.Mant[I] + (1 - Op2^.Mant[I]) + Borrow;
Op1^.Mant[I] ← Dif MOD 2;
Borrow ← Dif/2;
ENDLOOP;
Carry ← (Carry + 1 + Borrow) MOD 2};
Shftl[@Op1^, 1, @Gvars^];
ENDLOOP;
guard:=op1.mant[1]; round:=op1.mant[2]; sticky:=op1.mant[3];
Guard ← G;
Round ← R;
Sticky ← Carry;
Carry ← 0;
FOR i:
INT
IN [
INT[1]..
INT[MantPrec]]
DO
I ← i; IF Sticky = 0 THEN Sticky ← Op1^.Mant[I] ENDLOOP};
Pack:
PROCEDURE [
Result: LONG POINTER TO Pervert, N: LONG POINTER TO Number,
Gvars: LONG POINTER TO Gvarstype] = {
OPEN Gvars^;
Temp1: Pervert;
Tempe: Pervert;
J: PascalInteger [1..MantBits];
Start: PascalInteger [1..2];
IF (((Format = Single)
OR (Format = Double))
AND (Isdenormalized[@
N^, @Gvars^]))
OR Isnormalzero[@
N^, @Gvars^]
THEN Tempe.I ← 0
ELSE Tempe.I ← N^.Expon + Bias;
BEGIN
OPEN Temp1;
FOR i:
INT
IN [
INT[1]..
INT[Expbits]]
DO
J ← i; B[Expbits + MantPrec - J] ← Tempe.B[Expbits - J + 1] ENDLOOP
END;
Temp1.B[MantPrec + Expbits] ← N^.Sign;
IF Format = Extended THEN Start ← 1 ELSE Start ← 2;
BEGIN
OPEN Temp1;
FOR i:
INT
IN [
INT[Start]..
INT[MantPrec]]
DO
J ← i; B[1 + MantPrec - J] ← N^.Mant[J] ENDLOOP
END;
Result^ ← Temp1};
Packs:
PROCEDURE [
Result: LONG POINTER TO Shortreal, N: LONG POINTER TO Number,
Gvars: LONG POINTER TO Gvarstype] = {
PackResult: Pervert;
Pack[@PackResult, @N^, @Gvars^];
Result^ ← PackResult.R};
Packd:
PROCEDURE [
Result: LONG POINTER TO Longreal, N: LONG POINTER TO Number,
Gvars: LONG POINTER TO Gvarstype] = {
PackResult: Pervert;
Pack[@PackResult, @N^, @Gvars^];
Result^ ← PackResult.L};
Packe:
PROCEDURE [
Result: LONG POINTER TO Verylongreal, N: LONG POINTER TO Number,
Gvars: LONG POINTER TO Gvarstype] = {
PackResult: Pervert;
Pack[@PackResult, @N^, @Gvars^];
Result^ ← PackResult.Vl};
Unpack:
PROCEDURE [
Result: LONG POINTER TO Number, T1: LONG POINTER TO Pervert,
Gvars: LONG POINTER TO Gvarstype] = {
Te: Pervert;
J: PascalInteger [1..MantBits];
Res: Number;
Start: PascalInteger;
BEGIN
OPEN Gvars^, Res;
Te.I ← 0;
BEGIN
OPEN Te;
FOR i:
INT
IN [
INT[1]..
INT[Expbits]]
DO
J ← i; B[Expbits - J + 1] ← T1^.B[Expbits + MantPrec - J] ENDLOOP
END;
Expon ← Te.I - Bias;
IF Format = Extended THEN Start ← 1 ELSE Start ← 2;
FOR i:
INT
IN [
INT[Start]..
INT[MantPrec]]
DO
J ← i; Mant[J] ← T1^.B[1 + MantPrec - J] ENDLOOP;
IF Format # Extended
THEN
IF Expon >= MinExp
--not denorm
THEN Mant[1] ← 1
ELSE {Mant[1] ← 0; Expon ← MinExp};
IF Format # Extended
THEN
IF Expon = MaxExp + 1
--infinity
THEN Mant[1] ← 0;
Sign ← T1^.B[Expbits + MantPrec];
Result^ ← Res;
END};
Unpacks:
PROCEDURE [
Result: LONG POINTER TO Number, N: LONG POINTER TO Shortreal,
Gvars: LONG POINTER TO Gvarstype] = {
T: Pervert;
T.R ← N^;
Unpack[@Result^, @T, @Gvars^]};
Unpackd:
PROCEDURE [
Result: LONG POINTER TO Number, N: LONG POINTER TO Longreal,
Gvars: LONG POINTER TO Gvarstype] = {
T: Pervert;
T.L ← N^;
Unpack[@Result^, @T, @Gvars^]};
Unpacke:
PROCEDURE [
Result: LONG POINTER TO Number, N: LONG POINTER TO Verylongreal,
Gvars: LONG POINTER TO Gvarstype] = {
T: Pervert;
T.Vl ← N^;
Unpack[@Result^, @T, @Gvars^]};
Add:
PROCEDURE [
Result: LONG POINTER TO Number, Op1, Op2: Number,
Modes: LONG POINTER TO Modestype, Indics: LONG POINTER TO Indicstype,
Gvars: LONG POINTER TO Gvarstype] = {
Op1ok, Op2ok, Onenormalized: PascalBoolean;
Shiftdist: PascalInteger;
Temp: Number;
Op1ok ← Examine[@Op1, @Modes^, @Indics^, @Gvars^];
Op2ok ← Examine[@Op2, @Modes^, @Indics^, @Gvars^];
IF Op1ok
AND Op2ok
THEN {
OPEN Modes^, Indics^, Gvars^;
SELECT Twooperandcase[@Op1, @Op2, @Gvars^]
FROM
A =>
IF ((RoundMode # Rm)
AND
NOT ((Op1.Sign = 1)
AND (Op2.Sign = 1)))
OR ((Op1.Sign = 0)
AND (Op2.Sign = 0))
THEN Pluszero[@Result^, @Gvars^]
ELSE Minuszero[@Result^, @Gvars^];
C, F => Result^ ← Op2; --op2 is inf & op1 is not inf or nan
G, H => Result^ ← Op1; --op1 is inf & op2 is not inf or nan
B,
D,
E => {
1
IF (
NOT Isnormalzero[@Op1, @Gvars^])
AND (NOT Isnormalzero[@Op2, @Gvars^])
AND (Op1.Expon # Op2.Expon)
THEN {
IF Op1.Expon < Op2.Expon
THEN {Temp ← Op1; Op1 ← Op2; Op2 ← Temp};
Shftr[@Op2, Op1.Expon - Op2.Expon, @Gvars^];
Op2.Expon ← Op1.Expon};
Onenormalized ← Isnormalized[@Op1, @Gvars^]
OR Isnormalized[@Op2, @Gvars^];
Addoperands[@Result^, @Op1, @Op2, @Gvars^];
2
IF Carry = 1
THEN {
Shftr[@Result^, 1, @Gvars^];
Result^.Expon ← Result^.Expon + 1};
3
IF Issignificandzero[@Result^, @Gvars^]
--a--
THEN {
IF RoundMode = Rm THEN Result^.Sign ← 1 ELSE Result^.Sign ← 0;
IF Onenormalized THEN Result^.Expon ← Gvars^.MinExp}
--b--
ELSE
IF Onenormalized
THEN {
Shiftdist ← Flmo[@Result^.Mant, @Gvars^];
Shftl[@Result^, Shiftdist, @Gvars^];
Result^.Expon ← Result^.Expon - Shiftdist};
4
CheckUnderAndRound[@Result^, @Modes^, @Indics^, @Gvars^];
CheckInvAndOv[@Result^, @Modes^, @Indics^, @Gvars^]};
I =>
IF (InfinityMode = Affine)
AND (Op1.Sign = Op2.Sign)
--both infinity
THEN Result^ ← Op1
ELSE {SetInvalid[@Indics^]; Getnan[@Result^, @Modes^, @Gvars^]};
X => Result^ ← Op1; --op1 is NaN, op2 is non-NaN
Y => Result^ ← Op2; --op2 is NaN, op1 is non-NaN
M => Selectnan[@Result^, @Op1, @Op2] --Both op's are NaN
ENDCASE}
ELSE Getnan[@Result^, @Modes^, @Gvars^]};
Subtract:
PROCEDURE [
Result: LONG POINTER TO Number, Op1, Op2: Number,
Modes: LONG POINTER TO Modestype, Indics: LONG POINTER TO Indicstype,
Gvars: LONG POINTER TO Gvarstype] = {
IF NOT Isnan[@Op2, @Gvars^] THEN Op2.Sign ← 1 - Op2.Sign;
Add[@Result^, Op1, Op2, @Modes^, @Indics^, @Gvars^]};
Multiply:
PROCEDURE [
Result: LONG POINTER TO Number, Op1, Op2: Number,
Modes: LONG POINTER TO Modestype, Indics: LONG POINTER TO Indicstype,
Gvars: LONG POINTER TO Gvarstype] = {
Op1ok, Op2ok: PascalBoolean;
Op1ok ← Examine[@Op1, @Modes^, @Indics^, @Gvars^];
Op2ok ← Examine[@Op2, @Modes^, @Indics^, @Gvars^];
IF Op1ok
AND Op2ok
THEN {
OPEN Modes^, Indics^, Gvars^;
SELECT Twooperandcase[@Op1, @Op2, @Gvars^]
FROM
A,
B,
D => {
Zero[@Result^, @Gvars^];
Result^.Sign ← Xor[Op1.Sign, Op2.Sign]};
C,
G =>
{SetInvalid[@Indics^]; Getnan[@Result^, @Modes^, @Gvars^]};
E => {
--1-- Result^.Sign ← Xor[Op1.Sign, Op2.Sign];
Result^.Expon ← Op1.Expon + Op2.Expon;
Multsignificands[@Result^, @Op1, @Op2, @Gvars^];
2--
IF Carry = 1
THEN {
Shftr[@Result^, 1, @Gvars^];
Result^.Expon ← Result^.Expon + 1};
--3-- CheckUnderAndRound[@Result^, @Modes^, @Indics^, @Gvars^];
CheckInvAndOv[@Result^, @Modes^, @Indics^, @Gvars^]};
F,
H,
I =>
IF (Iszero[@Op1, @Gvars^]
AND
NOT Isnormalzero[@Op1, @Gvars^])
OR (Iszero[@Op2, @Gvars^] AND NOT Isnormalzero[@Op2, @Gvars^]) THEN
{SetInvalid[@Indics^]; Getnan[@Result^, @Modes^, @Gvars^]; }
ELSE {
Plusinf[@Result^, @Gvars^];
Result^.Sign ← Xor[Op1.Sign, Op2.Sign]};
X => Result^ ← Op1;
Y => Result^ ← Op2;
M => Selectnan[@Result^, @Op1, @Op2];
ENDCASE}
ELSE Getnan[@Result^, @Modes^, @Gvars^]};
Divide:
PROCEDURE [
Result: LONG POINTER TO Number, Op1, Op2: Number,
Modes: LONG POINTER TO Modestype, Indics: LONG POINTER TO Indicstype,
Gvars: LONG POINTER TO Gvarstype] = {
Op1ok, Op2ok: PascalBoolean;
Op1ok ← Examine[@Op1, @Modes^, @Indics^, @Gvars^];
Op2ok ← Examine[@Op2, @Modes^, @Indics^, @Gvars^];
IF Op1ok
AND Op2ok
THEN {
OPEN Modes^, Indics^, Gvars^;
SELECT Twooperandcase[@Op1, @Op2, @Gvars^]
FROM
A,
I =>
{SetInvalid[@Indics^]; Getnan[@Result^, @Modes^, @Gvars^]};
B => {
IF Iszero[@Op2, @Gvars^]
AND
NOT Isnormalzero[@Op2, @Gvars^]
THEN {SetInvalid[@Indics^]; Getnan[@Result^, @Modes^, @Gvars^] }
ELSE {
Zero[@Result^, @Gvars^];
Result^.Sign ← Xor[Op1.Sign, Op2.Sign] } };
C,
F => {
Zero[@Result^, @Gvars^];
Result^.Sign ← Xor[Op1.Sign, Op2.Sign]};
D =>
IF Iszero[@Op1, @Gvars^]
AND
NOT Isnormalzero[@Op1, @Gvars^]
THEN {SetInvalid[@Indics^]; Getnan[@Result^, @Modes^, @Gvars^]; }
ELSE {
SetDivbyzero[@Indics^];
Plusinf[@Result^, @Gvars^];
Result^.Sign ← Xor[Op1.Sign, Op2.Sign]};
E =>
IF Isunnormalized[@Op2, @Gvars^]
THEN {SetInvalid[@Indics^]; Getnan[@Result^, @Modes^, @Gvars^] }
ELSE {
--1-- Result^.Sign ← Xor[Op1.Sign, Op2.Sign];
Result^.Expon ← Op1.Expon - Op2.Expon;
Dividesignificands[@Result^, @Op1, @Op2, @Gvars^];
2--
IF Result^.Mant[1] = 0
THEN {
Shftl[@Result^, 1, @Gvars^];
Result^.Expon ← Result^.Expon - 1};
--3-- CheckUnderAndRound[@Result^, @Modes^, @Indics^, @Gvars^];
CheckInvAndOv[@Result^, @Modes^, @Indics^, @Gvars^]};
G,
H => {
Plusinf[@Result^, @Gvars^];
Result^.Sign ← Xor[Op1.Sign, Op2.Sign];
};
X => Result^ ← Op1;
Y => Result^ ← Op2;
M => Selectnan[@Result^, @Op1, @Op2];
ENDCASE}
ELSE Getnan[@Result^, @Modes^, @Gvars^]};
Remainder:
PROCEDURE [
Result: LONG POINTER TO Number, Op1, Op2: Number,
Modes: LONG POINTER TO Modestype, Indics: LONG POINTER TO Indicstype,
Gvars: LONG POINTER TO Gvarstype] = {
Op1ok, Op2ok: PascalBoolean;
bugs - incomplete
If remainder is zero, its sigh is that of the divid}
Op1ok ← Examine[@Op1, @Modes^, @Indics^, @Gvars^];
Op2ok ← Examine[@Op2, @Modes^, @Indics^, @Gvars^];
IF Op1ok
AND Op2ok
THEN {
OPEN Modes^, Indics^, Gvars^;
SELECT Twooperandcase[@Op1, @Op2, @Gvars^]
FROM
A,
D,
G,
H,
I =>
{SetInvalid[@Indics^]; Getnan[@Result^, @Modes^, @Gvars^]};
B,
C =>
IF Isunnormalized[@Op2, @Gvars^]
THEN {SetInvalid[@Indics^]; Getnan[@Result^, @Modes^, @Gvars^]; }
ELSE Result^ ← Op1;
E => --writeln('Part e not yet implemented')-- Halt[4];
F => Result^ ← Op2;
X => Result^ ← Op1;
Y => Result^ ← Op2;
M => Selectnan[@Result^, @Op1, @Op2];
ENDCASE}
ELSE Getnan[@Result^, @Modes^, @Gvars^]};
END.