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