m3middle/src/TInt.m3


 Copyright (C) 1993, Digital Equipment Corporation           
 All rights reserved.                                        
 See the file COPYRIGHT for a full description.              
                                                             
 File: TInt.m3                                               
 Last Modified On Tue Jul 12 08:31:56 PDT 1994 By kalsow     
      Modified On Thu May 20 08:46:32 PDT 1993 By muller     

MODULE TInt;

IMPORT Word, TWord, Text;
FROM Target IMPORT Int, IByte, IBytes;

CONST (* IMPORTS *)
  RShift = Word.RightShift;
  LShift = Word.LeftShift;
  And    = Word.And;

CONST
  Mask     = RShift (Word.Not (0), Word.Size - BITSIZE (IByte));
  SignMask = LShift (1, BITSIZE (IByte) - 1);
  Base     = Mask + 1;
  Digits   = ARRAY [0..9] OF CHAR { '0','1','2','3','4','5','6','7','8','9'};

PROCEDURE FromInt (x: INTEGER;  n: CARDINAL;  VAR r: Int): BOOLEAN =
  BEGIN
    <*ASSERT n # 0*>
    r.n := n;
    FOR i := 0 TO n-1 DO
      r.x[i] := And (x, Mask);
      x := x DIV Base;
    END;
    RETURN (n > 0) AND (x = 0 OR x = -1);
  END FromInt;

TYPE Sign = {Bad, Neg, Pos};

PROCEDURE CheckSign (READONLY r: Int;  n: CARDINAL): Sign =
  BEGIN
    <*ASSERT n # 0*>
    IF And (r.x[r.n-1], SignMask) = 0 THEN
      IF n < r.n THEN
        IF And (r.x[n-1], SignMask) # 0 THEN RETURN Sign.Bad END;
        FOR i := n TO r.n-1 DO
          IF r.x[i] # 0 THEN RETURN Sign.Bad END;
        END;
      END;
      RETURN Sign.Pos;
    ELSE
      IF n < r.n THEN
        IF And (r.x[n-1], SignMask) = 0 THEN RETURN Sign.Bad END;
        FOR i := n TO r.n-1 DO
          IF r.x[i] # Mask THEN RETURN Sign.Bad END;
        END;
      END;
      RETURN Sign.Neg;
    END;
  END CheckSign;

PROCEDURE IntI (READONLY r: Int;  n: CARDINAL;  VAR x: Int): BOOLEAN =
  VAR sign := CheckSign (r, n);  j := 0;  result := TRUE;
  BEGIN
    CASE sign OF
    | Sign.Bad => result := FALSE;
    | Sign.Pos => j := 0;
    | Sign.Neg => j := Mask;
    END;
    x.n := n;
    FOR i := 0 TO r.n-1 DO x.x[i] := r.x[i] END;
    FOR i := r.n TO n-1 DO x.x[i] := j END;
    RETURN result;
  END IntI;

PROCEDURE ToInt (READONLY r: Int;  VAR x: INTEGER): BOOLEAN =
  VAR sign := CheckSign (r, BITSIZE (INTEGER) DIV BITSIZE (IByte));
      result := TRUE;
  BEGIN
    (* ensure the result has the right sign extension *)
    CASE sign OF
    | Sign.Bad => result := FALSE;
    | Sign.Pos => x := 0;
    | Sign.Neg => x := Word.Not (0);
    END;

    (* finally, pack the bits *)
    FOR i := r.n-1 TO 0 BY -1  DO
      x := Word.Or (LShift (x, BITSIZE (IByte)), r.x[i]);
    END;

    RETURN result;
  END ToInt;

PROCEDURE New (READONLY x: ARRAY OF CHAR;  n: CARDINAL;  VAR r: Int): BOOLEAN =
  CONST ZERO = ORD ('0');   ZEROZERO = 10 * ZERO + ZERO;
  VAR tmp, digit: Int;
  BEGIN
    <*ASSERT n # 0*>
    r := Int{n};
    IF (NUMBER (x) = 1) THEN
      r.x[0] := ORD (x[0]) - ZERO;
    ELSIF (NUMBER (x) = 2) THEN
      r.x[0] := 10 * ORD (x[0]) + ORD (x[1]) - ZEROZERO;
    ELSE
      digit := Int{n};
      FOR i := FIRST (x) TO LAST (x) DO
        digit.x[0] := ORD (x[i]) - ZERO;
        IF NOT Multiply (r, Ten, tmp) THEN RETURN FALSE; END;
        IF NOT Add (tmp, digit, r)    THEN RETURN FALSE; END;
      END;
    END;
    RETURN TRUE;
  END New;

PROCEDURE Add (READONLY a, b: Int;  VAR r: Int): BOOLEAN =
  (* It is safe for r to alias a or b *)
  VAR n := MIN (a.n, b.n);  carry := 0;  r_sign := Sign.Bad;
      a_sign := CheckSign (a, n);  b_sign := CheckSign (b, n);
  BEGIN
    IF a_sign = Sign.Bad THEN RETURN FALSE END;
    IF b_sign = Sign.Bad THEN RETURN FALSE END;
    r.n := n;
    FOR i := 0 TO n-1 DO
      carry := a.x[i] + b.x[i] + carry;
      r.x[i] := And (carry, Mask);
      carry := RShift (carry, BITSIZE (IByte));
    END;
    r_sign := CheckSign (r, n);  <*ASSERT r_sign # Sign.Bad*>
    RETURN (a_sign # b_sign) OR (a_sign = r_sign);
  END Add;

PROCEDURE Subtract (READONLY a, b: Int;  VAR r: Int): BOOLEAN =
  (* It is safe for r to alias a or b *)
  VAR n := MIN (a.n, b.n);  borrow := 0; r_sign := Sign.Bad;
      a_sign := CheckSign (a, n);  b_sign := CheckSign (b, n);
  BEGIN
    IF a_sign = Sign.Bad THEN RETURN FALSE END;
    IF b_sign = Sign.Bad THEN RETURN FALSE END;
    r.n := n;
    FOR i := 0 TO n-1 DO
      borrow := a.x[i] - b.x[i] - borrow;
      r.x[i] := And (borrow, Mask);
      borrow := And (RShift (borrow, BITSIZE (IByte)), 1);
    END;
    r_sign := CheckSign (r, n);  <*ASSERT r_sign # Sign.Bad*>
    RETURN (a_sign = b_sign) OR (a_sign = r_sign);
  END Subtract;

PROCEDURE Negate (READONLY a: Int;  VAR r: Int): BOOLEAN =
  (* It is safe for r to alias a *)
  BEGIN
    RETURN Subtract(Zero, a, r);
  END Negate;

PROCEDURE Abs (READONLY a: Int;  VAR r: Int): BOOLEAN =
  (* It is safe for r to alias a *)
  BEGIN
    IF GE(a, Zero) THEN
      r := a;
      RETURN TRUE;
    END;
    RETURN Negate(a, r);
  END Abs;

PROCEDURE Multiply (READONLY a, b: Int;  VAR r: Int): BOOLEAN =
  VAR
    n := MIN (a.n, b.n);  k, carry: INTEGER;  q: Int;
    p := ARRAY [0.. 2 * NUMBER (IBytes) - 1] OF IByte {0, ..};
    a_sign := CheckSign (a, n);  b_sign := CheckSign (b, n);
  BEGIN
    IF a_sign = Sign.Bad THEN RETURN FALSE END;
    IF b_sign = Sign.Bad THEN RETURN FALSE END;
    FOR i := 0 TO n-1 DO
      FOR j := 0 TO n-1 DO
        k := i + j;
        carry := Word.Times (a.x[i], b.x[j]);
        WHILE carry # 0 DO
          carry := carry + p[k];
          p[k] := And (carry, Mask);
          carry := RShift (carry, BITSIZE (IByte));
          INC (k);
        END;
      END;
    END;

    r.n := n; FOR i := 0 TO n-1 DO r.x[i] := p[i]; END;
    q.n := n; FOR i := 0 TO n-1 DO q.x[i] := p[i+n]; END;

    (* compute the top half *)
    IF And (a.x[n-1], SignMask) # 0 THEN EVAL Subtract (q, b, q); END;
    IF And (b.x[n-1], SignMask) # 0 THEN EVAL Subtract (q, a, q); END;

    (* there is overflow if the top half is not equal to
       to the sign bit of the low half *)
    CASE CheckSign (r, n) OF
    | Sign.Bad => <*ASSERT FALSE*>
    | Sign.Pos => carry := 0;
    | Sign.Neg => carry := Mask;
    END;
    FOR i := 0 TO n-1 DO
      IF q.x[i] # carry THEN RETURN FALSE; END;
    END;

    RETURN TRUE;
  END Multiply;

PROCEDURE Div (READONLY num, den: Int;  VAR q: Int): BOOLEAN =
  VAR r: Int;
  BEGIN
    RETURN DivMod (num, den, q, r);
  END Div;

PROCEDURE Mod (READONLY num, den: Int;  VAR r: Int): BOOLEAN =
  VAR q: Int;
  BEGIN
    RETURN DivMod (num, den, q, r);
  END Mod;

PROCEDURE DivMod (READONLY a, b: Int;  VAR q, r: Int): BOOLEAN =
  (*  a DIV b  ==  FLOOR (FLOAT (a) / FLOAT (b)) *)
  (*  a MOD b  ==  a - b * (a DIV b)  *)
  VAR
    num     := a;
    den     := b;
    num_neg: BOOLEAN;
    den_neg: BOOLEAN;
    n := MIN (a.n, b.n);
    a_sign := CheckSign (a, n);
    b_sign := CheckSign (b, n);
    min: Int;
  BEGIN
    IF a_sign = Sign.Bad THEN RETURN FALSE END;
    IF b_sign = Sign.Bad THEN RETURN FALSE END;

    IF EQ (b, Zero) THEN  RETURN FALSE;  END;
    IF EQ (a, Zero) THEN  q := Zero;  r := Zero;  RETURN TRUE;  END;

    (* grab the signs *)
    num_neg := a_sign = Sign.Neg;
    den_neg := b_sign = Sign.Neg;

    (* check for the only possible overflow:  FIRST DIV -1 *)
    IF num_neg AND den_neg THEN
      TWord.Shift (MOne, n * BITSIZE (IByte) - 1, min);
      IF EQ (a, min) AND EQ (b, MOne) THEN
        RETURN FALSE;
      END;
    END;

    (* convert the operands to unsigned.  *)
    IF num_neg THEN  EVAL Subtract (Zero, a, num);  END;
    IF den_neg THEN  EVAL Subtract (Zero, b, den);  END;

    (* compute the unsigned quotient and remainder *)
    TWord.DivMod (num, den, q, r);

    (* fix-up the results to match the signs (see note below) *)
    IF EQ (r, Zero) THEN
      IF (num_neg # den_neg) THEN EVAL Subtract (Zero, q, q); END;
    ELSIF num_neg AND den_neg THEN
      EVAL Subtract (Zero, r, r);
    ELSIF num_neg THEN
      EVAL Subtract (Zero, q, q);
      EVAL Subtract (q, One, q);
      EVAL Subtract (den, r, r);
    ELSIF den_neg THEN
      EVAL Subtract (Zero, q, q);
      EVAL Subtract (q, One, q);
      EVAL Subtract (r, den, r);
  (*ELSE everything's already ok *)
    END;

    RETURN TRUE;
  END DivMod;
DIV and MOD notes:
          Modula-3 defines  "a DIV b" to be  "FLOOR(a/b)"
                       and  "a MOD b" to be  "a - b * (a DIV b)".
      
          Given a >= 0, b > 0, q = a DIV b, and r = a MOD b
          we get the following conversions:
      
              x    y     x DIV y     x MOD y
            ----------------------------------
              a    b        q           r
             -a   -b        q          -r
      
             -a    b       -q           0
             -a    b      -q-1         b-r  (r # 0)
      
              a   -b       -q           0
              a   -b      -q-1         r-b  (r # 0)


PROCEDURE EQ (READONLY a, b: Int): BOOLEAN =
  VAR n := MIN (a.n, b.n);
  BEGIN
    IF CheckSign (a, n) = Sign.Bad THEN RETURN FALSE END;
    IF CheckSign (b, n) = Sign.Bad THEN RETURN FALSE END;
    FOR i := 0 TO n-1 DO
      IF a.x[i] # b.x[i] THEN RETURN FALSE; END;
    END;
    RETURN TRUE;
  END EQ;

PROCEDURE LT (READONLY a, b: Int): BOOLEAN =
  VAR a_sign := CheckSign (a, a.n);
      b_sign := CheckSign (b, b.n);
      n := MIN (a.n, b.n);
  BEGIN
    <*ASSERT a_sign # Sign.Bad*>
    <*ASSERT b_sign # Sign.Bad*>
    IF (a_sign # b_sign) THEN RETURN (a_sign = Sign.Neg); END;

    IF CheckSign (a, n) = Sign.Bad THEN RETURN a_sign = Sign.Neg END;
    IF CheckSign (b, n) = Sign.Bad THEN RETURN b_sign = Sign.Pos END;

    FOR i := n-1 TO 0 BY -1 DO
      IF    a.x[i] < b.x[i] THEN  RETURN TRUE;
      ELSIF a.x[i] > b.x[i] THEN  RETURN FALSE;
      END;
    END;

    RETURN FALSE;
  END LT;

PROCEDURE LE (READONLY a, b: Int): BOOLEAN =
  BEGIN
    RETURN EQ (a, b) OR LT (a, b);
  END LE;

PROCEDURE NE (READONLY a, b: Int): BOOLEAN =
  BEGIN
    RETURN NOT EQ (a, b);
  END NE;

PROCEDURE GT (READONLY a, b: Int): BOOLEAN =
  BEGIN
    RETURN LT (b, a);
  END GT;

PROCEDURE GE (READONLY a, b: Int): BOOLEAN =
  BEGIN
    RETURN LE(b, a);
  END GE;

PROCEDURE ToText (READONLY r: Int): TEXT =
  VAR result  : ARRAY [0..BITSIZE (IByte) * NUMBER (IBytes)] OF CHAR;
  BEGIN
    RETURN Text.FromChars(SUBARRAY(result, 0, ToChars(r, result)));
  END ToText;

PROCEDURE ToChars (READONLY r: Int;  VAR buf: ARRAY OF CHAR): INTEGER =
  VAR
    nDigits : INTEGER := 0;
    minus   : BOOLEAN := FALSE;
    bump    : BOOLEAN := FALSE;
    i, j    : INTEGER;
    result  : ARRAY [0..BITSIZE (IByte) * NUMBER (IBytes)] OF CHAR;
    rr      := r;
    quo, rem, min: Int;
    n := r.n;
  BEGIN
    IF EQ (r, Zero) THEN
      result [0] := '0';
      INC (nDigits);

    ELSE (* handle a non-zero number *)

      (* get rid of negative numbers *)
      IF And (r.x[n-1], SignMask) # 0 THEN
        TWord.Shift (MOne, n * BITSIZE (IByte) - 1, min);
        IF EQ (r, min) THEN
          (* 2's complement makes FIRST a special case *)
          bump := TRUE;
	  EVAL Add (rr, One, rr);
        END;
        minus := TRUE;
        EVAL Subtract (Zero, rr, rr);
      END;

      (* convert the bulk of the digits *)
      WHILE LT (Zero, rr) DO
        TWord.DivMod (rr, Ten, quo, rem);
        result [nDigits] := Digits [rem.x [0]];
        rr := quo;
        INC (nDigits);
      END;

      (* fixup FIRST *)
      IF (bump) THEN
        result [nDigits] := '0';
        j := 0;
        LOOP
          i := ORD (result [j]) - ORD ('0');
          INC (i);
	  IF (i < 10) THEN
            result [j] := Digits [i];
            EXIT;
          END;
	  result [j] := '0';
	  INC (j);
        END;
        nDigits := MAX (nDigits, j+1);
      END;
    END;

    (* make sure we've got room for the result *)
    j := nDigits;
    IF minus THEN INC (j); END;
    IF (j > NUMBER (buf)) THEN RETURN -1; END;

    (* build the result buffer *)
    j := 0;
    IF (minus)  THEN
      buf [0] := '-';
      j := 1; END;
    FOR k := nDigits-1 TO 0 BY -1 DO
      buf [j] := result [k];  INC (j);
    END;

    RETURN j;
  END ToChars;

PROCEDURE ToBytes (READONLY r: Int;  VAR buf: ARRAY OF [0..255]): INTEGER =
  VAR n := r.n;  j := 0;  k := n;
  BEGIN
    (* strip the sign extension *)
    IF And (r.x[n-1], SignMask) # 0 THEN j := Mask END;
    FOR i := n-1 TO 0 BY -1 DO
      IF r.x[i] # j THEN EXIT END;
      DEC (k);
    END;
    IF k > NUMBER (buf) THEN RETURN -1 END;
    (* unpack the bytes *)
    FOR i := 0 TO k-1 DO buf[i] := r.x[i] END;
    RETURN k;
  END ToBytes;

BEGIN
END TInt.