aSyntax10.Scn.FntSyntax10b.Scn.Fnt2AHistoryElemsAllocHistory#Syntax10.Scn.FntPP"1996-06-17 degner@pallas.amp.uni-hannover.de" Created first unified version.     7$ ) ! ,  1G K >; ?  ^ MODULE Reals; (** JT, RC, Bernd Moesli, cn, JR; 1996-06-17 RD *)  IMPORT S:=SYSTEM, HostSYS; (* Returns exponent of a REAL *) PROCEDURE Expo* (x: REAL): INTEGER; BEGIN RETURN SHORT(ASH(S.VAL(LONGINT, x), -23) MOD 256) END Expo; (* Returns exponent of a LONGREAL *) PROCEDURE ExpoL* (x: LONGREAL): INTEGER; VAR i: LONGINT; BEGIN IF HostSYS.BigEndianMachine THEN S.GET(S.ADR(x),i) ELSE S.GET(S.ADR(x)+4,i) END; RETURN SHORT(ASH(i, -20) MOD 2048) END ExpoL; (* Sets exponent of a REAL *) PROCEDURE SetExpo*(e: INTEGER; VAR x: REAL); VAR i: LONGINT; BEGIN S.GET(S.ADR(x), i); i:= ASH(ASH(ASH(i, -31), 8) + e MOD 256, 23) + i MOD ASH(1, 23); S.PUT(S.ADR(x), i) END SetExpo; (* Sets exponent of a LONGREAL *) PROCEDURE SetExpoL*(e: INTEGER; VAR x: LONGREAL); VAR i: LONGINT; BEGIN IF HostSYS.BigEndianMachine THEN S.GET(S.ADR(x),i) ELSE S.GET(S.ADR(x)+4,i) END; i:= ASH(ASH(ASH(i, -31), 11) + e MOD 2048, 20) + i MOD ASH(1, 20); IF HostSYS.BigEndianMachine THEN S.PUT(S.ADR(x),i) ELSE S.PUT(S.ADR(x)+4,i) END END SetExpoL; (* Returns 10^e as REAL *) PROCEDURE Ten*(e: INTEGER): REAL; VAR r, power: LONGREAL; BEGIN r := 1.0; power := 10.0; 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; (* Returns 10^e as LONGREAL *) PROCEDURE TenL*(e: INTEGER): LONGREAL; VAR r, power: LONGREAL; BEGIN r := 1.0; power := 10.0; 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; (* Converts REAL x to n chars long string d using the decimal system *) PROCEDURE Convert*(x: REAL; n: INTEGER; VAR d: ARRAY OF CHAR); VAR i: LONGINT; k: INTEGER; 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; (* Converts LONGREAL x to n chars long string d using the decimal system *) PROCEDURE ConvertL* (x: LONGREAL; n: INTEGER; VAR d: ARRAY OF CHAR); VAR i, k, 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; (* Converts anything to string using the hexadecimal system *) PROCEDURE Unpack(VAR b, d: ARRAY OF S.BYTE); VAR i, len: LONGINT; k: SHORTINT; BEGIN i := 0; len := LEN(b); IF HostSYS.BigEndianMachine THEN (* big endian *) WHILE i < len DO k := SHORT(ORD(S.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(S.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 ELSE (* little endian *) WHILE i < len DO k := SHORT(ORD(S.VAL(CHAR, b[len - i - 1])) DIV 16); IF k > 9 THEN d[i*2] := k + 55 ELSE d[i*2] := k + 48 END; k := SHORT(ORD(S.VAL(CHAR, b[len - i - 1])) MOD 16); IF k > 9 THEN d[i*2+1] := k + 55 ELSE d[i*2+1] := k + 48 END; INC(i) END END END Unpack; (* Converts REAL x string d using the hexadecimal system *) PROCEDURE ConvertH*(y: REAL; VAR d: ARRAY OF CHAR); TYPE Array4 = ARRAY 4 OF CHAR; (* to avoid warning 1 *) BEGIN Unpack(S.VAL(Array4, y), d) END ConvertH; (* Converts LONGREAL x string d using the hexadecimal system *) PROCEDURE ConvertHL*(x: LONGREAL; VAR d: ARRAY OF CHAR); TYPE Array8 = ARRAY 8 OF CHAR; (* to avoid warning 1 *) BEGIN Unpack(S.VAL(Array8, x), d) END ConvertHL; END Reals.