home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / reals.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  3KB  |  100 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. MODULE Reals; (** JT, RC, Bernd Moesli, cn, JR; 26-May-96 RD *)
  4. IMPORT HostSYS, S:=SYSTEM;
  5.     H: LONGINT;
  6. PROCEDURE Expo* (x: REAL): INTEGER;
  7. BEGIN
  8.     RETURN SHORT(ASH(S.VAL(LONGINT, x), -23) MOD 256)
  9. END Expo;
  10. PROCEDURE ExpoL* (x: LONGREAL): INTEGER;
  11.     VAR i: LONGINT;
  12. BEGIN
  13.     S.GET(S.ADR(x) + H, i); RETURN SHORT(ASH(i, -20) MOD 2048)
  14. END ExpoL;
  15. PROCEDURE SetExpo*(e: INTEGER; VAR x: REAL);
  16.     CONST expo = {23..30};
  17. BEGIN
  18.     x := S.VAL(REAL, S.VAL(SET, x) - expo + S.VAL(SET, ASH(LONG(e), 23)))
  19. END SetExpo;
  20. PROCEDURE SetExpoL*(e: INTEGER; VAR x: LONGREAL);
  21.     CONST expo = {52-32..62-32};
  22.     VAR h: SET;
  23. BEGIN
  24.     S.GET(S.ADR(x)+H, h);
  25.     h := h - expo + S.VAL(SET, ASH(LONG(e), 20));
  26.     S.PUT(S.ADR(x)+H, h)
  27. END SetExpoL;
  28. PROCEDURE Ten*(e: INTEGER): REAL;
  29.     VAR r, power: LONGREAL;
  30. BEGIN
  31.     r := 1.0;
  32.     power := 10.0;
  33.     WHILE e > 0 DO
  34.         IF ODD(e) THEN r := r * power END;
  35.         power := power * power; e := e DIV 2
  36.     END;
  37.     RETURN SHORT(r)
  38. END Ten;
  39. PROCEDURE TenL*(e: INTEGER): LONGREAL;
  40.     VAR r, power: LONGREAL;
  41. BEGIN
  42.     r := 1.0;
  43.     power := 10.0;
  44.     LOOP
  45.         IF ODD(e) THEN r := r * power END;
  46.         e := e DIV 2;
  47.         IF e <= 0 THEN RETURN r END;
  48.         power := power * power
  49. END TenL;
  50. PROCEDURE Convert*(x: REAL; n: INTEGER; VAR d: ARRAY OF CHAR);
  51.     VAR i: LONGINT; k: INTEGER;
  52. BEGIN
  53.     i := ENTIER(x); k := 0;
  54.     WHILE k < n DO
  55.         d[k] := CHR(i MOD 10 + 48); i := i DIV 10; INC(k)
  56. END Convert;
  57. PROCEDURE ConvertL* (x: LONGREAL; n: INTEGER; VAR d: ARRAY OF CHAR);
  58.     VAR i, k, q: INTEGER;
  59. BEGIN
  60.     k:=0;
  61.     WHILE x>=10.0 DO x:=x/10.0; INC(k) END;
  62.     FOR i:=n TO k+1 DO d[i]:='0' END;
  63.     FOR i:=k TO 0 BY -1 DO
  64.         q:=SHORT(ENTIER(x));
  65.         d[i]:=CHR(48+q);
  66.         x:=(x-q)*10.0
  67. END ConvertL;
  68. PROCEDURE Unpack(VAR b, d: ARRAY OF S.BYTE);
  69.     VAR i, len: LONGINT; k: SHORTINT;
  70. BEGIN
  71.     i := 0; len := LEN(b);
  72.     IF HostSYS.BigEndianMachine THEN    (* big endian *)
  73.         WHILE i < len DO
  74.             k := SHORT(ORD(S.VAL(CHAR, b[i])) DIV 16);
  75.             IF k > 9 THEN d[i*2] := k + 55 ELSE d[i*2] := k + 48 END;
  76.             k := SHORT(ORD(S.VAL(CHAR, b[i])) MOD 16);
  77.             IF k > 9 THEN d[i*2+1] := k + 55 ELSE d[i*2+1] := k + 48 END;
  78.             INC(i)
  79.         END
  80.     ELSE    (* little endian *)
  81.         WHILE i < len DO
  82.             k := SHORT(ORD(S.VAL(CHAR, b[len - i - 1])) DIV 16);
  83.             IF k > 9 THEN d[i*2] := k + 55 ELSE d[i*2] := k + 48 END;
  84.             k := SHORT(ORD(S.VAL(CHAR, b[len - i - 1])) MOD 16);
  85.             IF k > 9 THEN d[i*2+1] := k + 55 ELSE d[i*2+1] := k + 48 END;
  86.             INC(i)
  87.         END
  88. END Unpack;
  89. PROCEDURE ConvertH*(y: REAL; VAR d: ARRAY OF CHAR);
  90.     TYPE Array4 = ARRAY 4 OF CHAR;    (* to avoid warning 1 *)
  91. BEGIN Unpack(S.VAL(Array4, y), d)
  92. END ConvertH;
  93. PROCEDURE ConvertHL*(x: LONGREAL; VAR d: ARRAY OF CHAR);
  94.     TYPE Array8 = ARRAY 8 OF CHAR;    (* to avoid warning 1 *)
  95. BEGIN Unpack(S.VAL(Array8, x), d)
  96. END ConvertHL;
  97. BEGIN
  98.     IF HostSYS.BigEndianMachine THEN H:=0 ELSE H:=4 END
  99. END Reals.
  100.