<> <> <> DIRECTORY PascalBasic, PascalNoviceFiles, WeitekIeee; WeitekIeeeImplA: PROGRAM IMPORTS PascalNoviceFiles, WeitekIeee EXPORTS WeitekIeee =PUBLIC BEGIN OPEN PascalBasic, PascalNoviceFiles, WeitekIeee; <> <>> <> <<>> <> <> <> <> <> <<>> <<>> <> <> <> <<>> <<>> <> <<- - - - - - - - - - - - - - - - - - - ->> <> <> <> <> <> <> <> <> <> <> <> <> <<* 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>> <> <> <> <<* SDECBIN Convert decimal string to single precision binary>> <<* DDECBIN Convert decimal string to double precision binary>> <<* EDECBIN Convert decimal string to Extended precision binary>> <> <> <> <<* 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 <> <> 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) }; <> 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^]) }; <> <> <> <> Istrappingnan: PROCEDURE [ N: LONG POINTER TO Number, Gvars: LONG POINTER TO Gvarstype] RETURNS [IstrappingnanResult: PascalBoolean] = { IF (Gvars^.Format = Single) OR (Gvars^.Format = Double) <> THEN IstrappingnanResult _ Isnan[@N^, @Gvars^] AND (N^.Mant[2] = 1) <> 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}; <> <> 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^]}; <> <> Isdenormalized: PROCEDURE [ N: LONG POINTER TO Number, Gvars: LONG POINTER TO Gvarstype] RETURNS [IsdenormalizedResult: PascalBoolean] = {IsdenormalizedResult _ Isunnormalized[@N^, @Gvars^] AND (N^.Expon = Gvars^.MinExp)}; <> <> Isnormalized: PROCEDURE [ N: LONG POINTER TO Number, Gvars: LONG POINTER TO Gvarstype] RETURNS [IsnormalizedResult: PascalBoolean] = {IsnormalizedResult _ (N^.Mant[1] = 1)}; <> <> <> 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 <> <> <> 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 <> 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^]}; <> <> Selectnan: PROCEDURE [ Result: LONG POINTER TO Number, Op1, Op2: LONG POINTER TO Number] = {Result^ _ Op1^}; <> 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}; <> <> 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}; <> 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}; <> <<>> <> <> <<>> <> <> <> <> Twooperandcase: PROCEDURE [ Op1, Op2: LONG POINTER TO Number, Gvars: LONG POINTER TO Gvarstype] RETURNS [TwooperandcaseResult: Twooperandtype] = { <> 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}; <> 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}; <> 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}; <> <> 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}; <> 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 <> 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 _ 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; <> <> 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.