WSyntax10.Scn.Fnt ]ParcElemsAllocSyntax24b.Scn.Fnt Syntax24.Scn.Fnt4IE O;(* AMIGA *) (* Notify Ralf for maintenance of Non-FPU source *) MODULE Reals; (* 11-Jun-1994/cn, use JRs routines. *) IMPORT SYSTEM; PROCEDURE Ten* (e: INTEGER): REAL; VAR r, power: LONGREAL; BEGIN r := 1; power := 10; WHILE e > 0 DO IF ODD(e) THEN r := r * power END ; power := power * power; e := e DIV 2 END ; RETURN SHORT(r) END Ten; PROCEDURE TenL* (e: INTEGER): LONGREAL; VAR r, power: LONGREAL; BEGIN r := 1; power := 10; LOOP IF ODD(e) THEN r := r * power END ; e := e DIV 2; IF e <= 0 THEN RETURN r END ; power := power * power END END TenL; PROCEDURE Expo* (x: REAL): INTEGER; BEGIN RETURN SHORT(ASH(SYSTEM.VAL(LONGINT, x), -23) MOD 256) END Expo; PROCEDURE ExpoL* (x: LONGREAL): INTEGER; BEGIN RETURN SHORT(ASH(SYSTEM.VAL(LONGINT, x), -20) MOD 2048) END ExpoL; PROCEDURE SetExpo*(e: INTEGER; VAR x: REAL); CONST expo = {23..30}; BEGIN SYSTEM.PUT(SYSTEM.ADR(x), SYSTEM.VAL(SET, x) - expo + SYSTEM.VAL(SET, ASH(LONG(e), 23))) END SetExpo; PROCEDURE SetExpoL*(e: INTEGER; VAR x: LONGREAL); CONST expo = {52-32..62-32}; VAR h: SET; BEGIN SYSTEM.GET(SYSTEM.ADR(x), h); h := h - expo + SYSTEM.VAL(SET, ASH(LONG(e), 20)); SYSTEM.PUT(SYSTEM.ADR(x), h) END SetExpoL; PROCEDURE Convert*(x: REAL; n: INTEGER; VAR d: ARRAY OF CHAR); VAR i, k: LONGINT; BEGIN i := ENTIER(x); k := 0; WHILE k < n DO d[k] := CHR(i MOD 10 + 48); i := i DIV 10; INC(k) END END Convert; PROCEDURE ConvertL* (x: LONGREAL; n: INTEGER; VAR d: ARRAY OF CHAR); VAR i,k:INTEGER; q:INTEGER; BEGIN k:=0; WHILE x>=10.0 DO x:=x/10.0; INC(k); END; FOR i:=n TO k+1 DO d[i]:='0'; END; FOR i:=k TO 0 BY -1 DO q:=SHORT(ENTIER(x)); d[i]:=CHR(48+q); x:=(x-q)*10.0; END; END ConvertL; PROCEDURE Unpack(VAR b, d: ARRAY OF SYSTEM.BYTE); VAR i, k: SHORTINT; BEGIN i := 0; WHILE i < LEN(b) DO k := SHORT(ORD(SYSTEM.VAL(CHAR, b[i])) DIV 16); IF k > 9 THEN d[i*2] := k + 55 ELSE d[i*2] := k + 48 END ; k := SHORT(ORD(SYSTEM.VAL(CHAR, b[i])) MOD 16); IF k > 9 THEN d[i*2+1] := k + 55 ELSE d[i*2+1] := k + 48 END ; INC(i) END END Unpack; PROCEDURE ConvertH* (y: REAL; VAR d: ARRAY OF CHAR); BEGIN Unpack(y, d) END ConvertH; PROCEDURE ConvertHL* (x: LONGREAL; VAR d: ARRAY OF CHAR); BEGIN Unpack(x, d) END ConvertHL; BEGIN END Reals.