(****************************************************************************) (* *) (* Modula-2 Cross System V4.0 *) (* *) (* *) (* author: Dieter Jaeger *) (****************************************************************************) IMPLEMENTATION MODULE ConLR; FROM Strings IMPORT Assign; FROM SYSTEM IMPORT UNSIGNED_32, ADR; FROM Moves IMPORT Fill; TYPE line = ARRAY[0..79] OF CHAR; TYPE LReal = RECORD CASE BOOLEAN OF TRUE: R : LONGREAL; |FALSE: H,L : UNSIGNED_32; END; END; CONST LMaxDigit = 16; LMaxExp = 307; LMinExp = -308; VAR lpower : ARRAY [0..8] OF LONGREAL; (* power[i] = 10^(2^i) *) lpw : LReal; one,null : LONGREAL; LMaxMant : LONGREAL; half : LONGREAL; PROCEDURE lpten(e:INTEGER):LONGREAL; VAR result : LONGREAL; i : CARDINAL; neg : BOOLEAN; BEGIN IF e < LMinExp THEN RETURN null; END; result := one; i := 0; neg := e < 0; e := ABS(e); WHILE e > 0 DO IF ODD(e) THEN result := result * lpower[i]; END; INC(i); e := e DIV 2; END; IF neg THEN result := one/result; END; RETURN result; END lpten; PROCEDURE StrToLReal(str:ARRAY OF CHAR; ?? ^66 VAR lreal:LONGREAL; VAR success:BOOLEAN); PROCEDURE negpos; BEGIN sign := s[i]='-'; IF (s[i]='+') OR sign THEN INC(i); END; END negpos; PROCEDURE sDigit():BOOLEAN; BEGIN ch := s[i]; INC(i); RETURN (ch>='0') AND (ch<='9'); END sDigit; VAR s : line; ch : CHAR; i : CARDINAL; sign : BOOLEAN; r,mant : LONGREAL; digits,exp,mexp,wexp : INTEGER; BEGIN (* StrToLReal *) success := TRUE; Assign(str,s); i := 0; negpos; mant := null; mexp := 0; exp := 0; r := one; digits := 0; WHILE sDigit() DO IF (digits=LMaxDigit THEN r := r/lpower[0]; mant := mant + r * VAL(LONGREAL,ORD(ch)-30H); INC(mexp); END; END; IF ch='.' THEN WHILE sDigit() DO IF (digits=LMaxDigit THEN r := r/lpower[0]; mant := mant + r * VAL(LONGREAL,ORD(ch)-30H); ELSE DEC(mexp); END; END; END; IF sign THEN mant:=-mant; END; IF CAP(ch)='E' THEN negpos; WHILE sDigit() DO exp := exp * 10 + VAL(INTEGER,ch)-30H; END; IF sign THEN exp:=-exp; END; END; exp := exp + mexp; wexp := exp+digits; IF (wexp>LMaxExp) OR (ch>' ') OR (i=1) THEN success := FALSE; RETURN; ELSIF wexp=LMaxExp THEN IF mant * lpten(LMaxDigit - digits) >= LMaxMant THEN success := FALSE; RETURN; END; ELSIF wexp0 THEN lreal := mant * lpten(exp); ELSIF exp<0 THEN IF exp < LMinExp+1 THEN mant := mant / lpten(LMinExp + 1 - exp); exp := LMinExp + 1; END; lreal := mant / lpten(-exp); ELSE lreal := mant; END; END StrToLReal; PROCEDURE LRealToStr(lreal:LONGREAL; decPlaces:INTEGER; ?? ^66 VAR str:ARRAY OF CHAR); VAR i,digit : CARDINAL; s : line; exp : INTEGER; PROCEDURE rDigit(n: CARDINAL); BEGIN s[i] := VAL(CHAR,n+30H); INC(i); END rDigit; PROCEDURE OneDigit; VAR n:CARDINAL; BEGIN n := VAL(CARDINAL,lreal); s[i] := VAL(CHAR,n+30H); INC(i); lreal := (lreal-VAL(LONGREAL,n)) * lpower[0]; END OneDigit; PROCEDURE Exponent; BEGIN IF lreal= lpower[0] THEN lreal := lreal / lpower[0]; INC(exp); END; END; OneDigit; s[i]:='.'; INC(i); WHILE decPlaces > 0 DO OneDigit; DEC(decPlaces); END; s[i]:='E'; INC(i); IF exp < 0 THEN s[i] := '-'; exp := ABS(exp); ELSE s[i] := '+'; END; INC(i); rDigit(exp DIV 100); exp := exp MOD 100; rDigit(exp DIV 10); rDigit(exp MOD 10); END Scientific; PROCEDURE Decimal; BEGIN IF lreal=null THEN exp := 0; ELSE lreal := lreal + half * lpten(-decPlaces); Exponent; END; IF exp<0 THEN s[i]:='0'; INC(i);END; WHILE exp >= 0 DO digit := VAL(CARDINAL,lreal * lpten(-exp)); rDigit(digit); lreal := lreal - VAL(LONGREAL,digit) * lpten(exp); DEC(exp); END; IF decPlaces#0 THEN s[i]:='.'; INC(i); END; lreal := lreal * lpower[0]; WHILE decPlaces>0 DO OneDigit; DEC(decPlaces); END; END Decimal; BEGIN (* RealToStr *) Fill(ADR(s),HIGH(s)+1,0C); i := 0; IF lrealLMaxDigit THEN decPlaces:=LMaxDigit; END; Scientific; ELSE IF decPlaces>LMaxDigit THEN decPlaces:=LMaxDigit; END; Decimal; END; Assign(s,str); END LRealToStr; BEGIN (* ConReal *) (* 1 *) lpw.H := 03FF00000H; lpw.L := 000000000H; one := lpw.R; (* 0 *) lpw.H := 000000000H; lpw.L := 000000000H; null := lpw.R; (* LMaxMant = 89884656743115795.3; *) lpw.H := 0433FEEF6H; lpw.L := 03F97D79BH; LMaxMant:= lpw.R; (* 1/2 *) lpw.H := 03fe00000H; lpw.L := 000000000H; half := lpw.R; (* 10 ^ 1 *) lpw.H := 040240000H; lpw.L := 000000000H; lpower[0] := lpw.R; (* 10 ^ 2 *) lpw.H := 040590000H; lpw.L := 000000000H; lpower[1] := lpw.R; (* 10 ^ 4 *) lpw.H := 040C38800H; lpw.L := 000000000H; lpower[2] := lpw.R; (* 10 ^ 8 *) lpw.H := 04197D784H; lpw.L := 000000000H; lpower[3] := lpw.R; (* 10 ^ 16 *) lpw.H := 04341C379H; lpw.L := 037E08000H; lpower[4] := lpw.R; (* 10 ^ 32 *) lpw.H := 04693B8B5H; lpw.L := 0B5056E16H; lpower[5] := lpw.R; (* 10 ^ 64 *) lpw.H := 04D384F03H; lpw.L := 0E93FF9F4H; lpower[6] := lpw.R; (* 10 ^ 128 *) lpw.H := 05A827748H; lpw.L := 0F9301D31H; lpower[7] := lpw.R; (* 10 ^ 256 *) lpw.H := 075154FDDH; lpw.L := 07F73BF3BH; lpower[8] := lpw.R; END ConLR.