Gold Fish 3/goldfish_volume_3.bin/files/misc/math/excalc/source/exintegers.mod

Text File | 1995-05-08 | 14KB | 585 lines

(*********************************************************************)
(*                                                                   *)
(* Module ExIntegers Copyright © 1995 by Computer Inspirations       *)
(*                                                                   *)
(* Design : Michael Griebling                                        *)
(* Change : Original                                                 *)
(*                                                                   *)
(*********************************************************************)

MODULE ExIntegers;

(*  Some Functions to perform bit manipulation on ExNumbers.
    This module deals with integral ExNumbers in the range
    from -5.9863E51 to 5.9863E51.  Any numbers outside this
    range are represented with the maximum (or minimum)
    ExNumber from this range.
*)

IMPORT io, Cnv := Conversions, Str := Strings, X := ExNumbers,
       XM := ExMathLib0, SYSTEM;

TYPE
  BaseType * = SHORTINT;


CONST
  MaxBase2Bits = 172;    (* ln(9.99E51) / ln(2) *)
  LogicalSize  = MaxBase2Bits DIV 16;
  Left         = FALSE;
  Right        = TRUE;

TYPE
  LogicalType = ARRAY LogicalSize+1 OF SET;
  LogicalProc = PROCEDURE(a,b: SET) : SET;
  ExNumbProc  = PROCEDURE(VAR a: X.ExNumType; b,c: X.ExNumType);

VAR
  LogZero   : LogicalType; (* All bits cleared or 0  *)
  MaxNumber : X.ExNumType;   (*  2 ** MaxBase2Bits - 1 *)
  MinNumber : X.ExNumType;   (* -2 ** MaxBase2Bits + 1 *)
  Two       : X.ExNumType;   (* The value "2" *)
  Cnt       : INTEGER;


(*--------------------------------------*)
(* Local bit manipulations functions.   *)

PROCEDURE And (op1, op2 : SET) : SET;
BEGIN
  RETURN op1 * op2;
END And;

PROCEDURE AndNot (op1, op2 : SET) : SET;
BEGIN
  RETURN op1 - op2;
END AndNot;

PROCEDURE Or (op1, op2 : SET) : SET;
BEGIN
  RETURN op1 + op2;
END Or;

PROCEDURE Xor (op1, op2 : SET) : SET;
BEGIN
  RETURN op1 / op2;
END Xor;


(*--------------------------------------*)
(* Miscellaneous local procedures       *)

PROCEDURE Max (x, y : INTEGER) : INTEGER;
BEGIN
  IF x > y THEN
    RETURN x;
  ELSE
    RETURN y;
  END;
END Max;


PROCEDURE ConstrainExNum (VAR Number : X.ExNumType);
(* Limit Number to be within MinNumber to MaxNumber and
   eliminate any fractional portions. *)
BEGIN
  X.ExMin(Number, MaxNumber, Number);
  X.ExMax(Number, MinNumber, Number);
  X.ExTrunc(Number);
END ConstrainExNum;


PROCEDURE ExNumToLogical (Numb        : X.ExNumType;
                          VAR Logical : LogicalType);
VAR
  DivScale : X.ExNumType;
  Scale    : X.ExNumType;
  Temp     : X.ExNumType;
  Temp2    : X.ExNumType;
  LogCnt   : INTEGER;
BEGIN
  (* Constrain op1, op2 to be within the logical number set *)
  ConstrainExNum(Numb);

  (* translation scaling factor *)
  X.ExNumb(65536, 0, 0, Scale);
  X.ExDiv(DivScale, X.Ex1, Scale);

  (* perform conversion *)
  LogCnt  := 0;
  Logical := LogZero;
  WHILE NOT X.IsZero(Numb) DO
    X.ExMult(Temp2, Numb, DivScale);
    X.ExTrunc(Temp2);
    X.ExMult(Temp, Temp2, Scale);
    X.ExSub(Temp, Numb, Temp);
    IF LogCnt > LogicalSize THEN RETURN END;
    (* $RangeChk- *)
    Logical[LogCnt] := SYSTEM.VAL(SET, SHORT(X.ExToLongInt(Temp)));
    (* $RangeChk= *)
    Numb := Temp2;
    INC(LogCnt);
  END;
END ExNumToLogical;

PROCEDURE LogicalToExNum (Logical  : LogicalType;
                          VAR Numb : X.ExNumType);
VAR
  Scale  : X.ExNumType;
  Temp   : X.ExNumType;
  LogCnt : INTEGER;
  INumb  : LONGINT;
BEGIN
  (* translation scaling factor *)
  X.ExNumb(65536, 0, 0, Scale);

  (* perform conversion *)
  Numb := X.Ex0;
  FOR LogCnt := LogicalSize TO 0 BY -1 DO
    X.ExMult(Numb, Numb, Scale);
    INumb := SYSTEM.VAL(INTEGER, Logical[LogCnt]);
    IF INumb < 0 THEN INC(INumb, 10000H) END;
    X.ExNumb(INumb, 0, 0, Temp);
    X.ExAdd(Numb, Numb, Temp);
  END;
END LogicalToExNum;


(*--------------------------------------*)
(* Local procedure to perform general   *)
(* logical operations on ExNumbers.     *)

PROCEDURE LOp (VAR Result : X.ExNumType;
               op1        : X.ExNumType;
               Oper       : LogicalProc;
               op2        : X.ExNumType);
VAR
  i : INTEGER;
  Lop1, Lop2 : LogicalType;
BEGIN
  (* Translate to logicals *)
  ExNumToLogical(op1, Lop1);
  ExNumToLogical(op2, Lop2);

  (* Operate on Lop1 and Lop2 one quad at a time *)
  FOR i := 0 TO LogicalSize DO
    Lop2[i] := Oper(Lop1[i], Lop2[i]);
  END;

  (* Translate back the result *)
  LogicalToExNum(Lop2, Result);
END LOp;


(*--------------------------------------*)
(* Local procedure to perform general   *)
(* single bit operations on ExNumbers.  *)

PROCEDURE LBit (VAR Result : X.ExNumType;
                number     : X.ExNumType;
                Oper       : LogicalProc;
                bitnum     : INTEGER);
VAR
  Temp : X.ExNumType;
BEGIN
  (* Constrain number to be within the logical number set *)
  ConstrainExNum(number);

  (* constrain bitnum from 0 to MaxBase2Bits *)
  IF bitnum > MaxBase2Bits THEN
    (* no bits are changed *)
    Result := number;
    RETURN;
  END;

  (* calculate 2**bitnum *)
  XM.xtoi(Temp, Two, bitnum);

  (* set the bitnum bit position *)
  LOp(Result, number, Oper, Temp);
END LBit;


PROCEDURE ExSetBit *(VAR Result : X.ExNumType;
                     number     : X.ExNumType;
                     bitnum     : INTEGER);
BEGIN
  LBit(Result, number, Or, bitnum);
END ExSetBit;


PROCEDURE ExClearBit *(VAR Result : X.ExNumType;
                       number     : X.ExNumType;
                       bitnum     : INTEGER);
BEGIN
  LBit(Result, number, AndNot, bitnum);
END ExClearBit;


PROCEDURE ExToggleBit *(VAR Result : X.ExNumType;
                        number     : X.ExNumType;
                        bitnum     : INTEGER);
BEGIN
  LBit(Result, number, Xor, bitnum);
END ExToggleBit;


PROCEDURE^ ExAnd *(VAR Result : X.ExNumType;
                   op1, op2   : X.ExNumType);


(*--------------------------------------*)
(* Local function to extract a bit from *)
(* an ExNumber.                         *)

PROCEDURE Bit (number : X.ExNumType;
               bitnum : INTEGER) : BOOLEAN;
VAR
  Temp : X.ExNumType;
BEGIN
  (* Constrain number to be within the logical number set *)
  ConstrainExNum(number);

  (* constrain bitnum from 0 to MaxBase2Bits - 1 *)
  IF bitnum >= MaxBase2Bits THEN
    (* assume FALSE *)
    RETURN FALSE;
  END;

  (* calculate 2**bitnum *)
  XM.xtoi(Temp, Two, bitnum);

  (* extract the bitnum bit *)
  ExAnd(number, number, Temp);

  (* translate to boolean *)
  RETURN NOT X.IsZero(number);
END Bit;


(*--------------------------------------*)
(* Local procedure to perform general   *)
(* bit shifting operations on ExNumbers.*)

PROCEDURE LShift (VAR Result : X.ExNumType;
                  number     : X.ExNumType;
                  ExOper     : ExNumbProc;
                  bits       : INTEGER);
VAR
  Temp : X.ExNumType;
BEGIN
  (* Constrain number to be within the logical number set *)
  ConstrainExNum(number);

  (* constrain bitnum from 0 to MaxBase2Bits *)
  IF bits > MaxBase2Bits THEN
    (* shifted out of range *)
    Result := X.Ex0;
    RETURN;
  END;

  (* calculate 2**bits *)
  XM.xtoi(Temp, Two, bits);

  (* shift the number *)
  ExOper(Result, number, Temp);

  (* Constrain number to be within the logical number set *)
  ConstrainExNum(Result);
END LShift;


(*--------------------------------------*)
(* Local procedure to perform general   *)
(* bit rotation operations on ExNumbers.*)

PROCEDURE LRotate (VAR Result : X.ExNumType;
                   number     : X.ExNumType;
                   Shiftright : BOOLEAN;
                   bits       : INTEGER);
VAR
  ShiftCnt : INTEGER;
  SavedBit : BOOLEAN;
  Half     : X.ExNumType;
BEGIN
  (* Constrain number to be within the logical number set *)
  ConstrainExNum(number);

  (* constrain bitnum from 0 to MaxBase2Bits *)
  bits := bits MOD (MaxBase2Bits + 1);
  X.ExNumb(0, 5, 0, Half);

  FOR ShiftCnt := 1 TO bits DO
    IF Shiftright THEN
      (* save the bit to be shifted *)
      SavedBit := Bit(number, 0);

      (* shift the number right *)
      X.ExMult(number, number, Half);
      X.ExTrunc(number);
      IF SavedBit THEN
        ExSetBit(number, number, MaxBase2Bits-1);
      END;
    ELSE
      (* save the bit to be shifted *)
      SavedBit := Bit(number, MaxBase2Bits-1);

      (* shift the number left *)
      X.ExMult(number, number, Two);

      (* restore the saved bit *)
      IF SavedBit THEN
        ExSetBit(number, number, 0);
      END;
    END;

  END;

  (* Constrain number to be within the logical number set *)
  Result := number;
  ConstrainExNum(Result);
END LRotate;


(*--------------------------------------*)
(* Exported procedures.                 *)

PROCEDURE ExAnd *(VAR Result : X.ExNumType;
                  op1, op2   : X.ExNumType);
BEGIN
  LOp(Result, op1, And, op2);
END ExAnd;


PROCEDURE ExOr *(VAR Result : X.ExNumType;
                 op1, op2   : X.ExNumType);
BEGIN
  LOp(Result, op1, Or, op2);
END ExOr;


PROCEDURE ExXor *(VAR Result : X.ExNumType;
                  op1, op2   : X.ExNumType);
BEGIN
  LOp(Result, op1, Xor, op2);
END ExXor;


PROCEDURE ExIntDiv *(VAR Result : X.ExNumType;
                     op1, op2   : X.ExNumType);
BEGIN
  (* Constrain inputs to be integers *)
  ConstrainExNum(op1); ConstrainExNum(op2);
  X.ExDiv(Result, op1, op2);
  X.ExTrunc(Result);
END ExIntDiv;


PROCEDURE ExMod *(VAR Result : X.ExNumType;
                  op1, op2   : X.ExNumType);
BEGIN
  (* Result := op1 - (op1 DIV op2) * op2 *)
  ConstrainExNum(op1); ConstrainExNum(op2);
  ExIntDiv(Result, op1, op2);
  X.ExMult(Result, Result, op2);
  X.ExSub(Result, op1, Result);
END ExMod;


PROCEDURE ExOnesComp *(VAR Result : X.ExNumType;
                       number     : X.ExNumType);
BEGIN
  (* Constrain number to be within the logical number set *)
  ConstrainExNum(number);
  IF number.Sign = X.positive THEN
    (* Subtract from the maximum number *)
    X.ExSub(Result, MaxNumber, number);
  ELSE
    (* Subtract from the minimum number *)
    X.ExSub(Result, MinNumber, number);
  END;

  (* Complement the sign bit *)
  X.ExChgSign(Result);
END ExOnesComp;


PROCEDURE ExShl *(VAR Result : X.ExNumType;
                  number     : X.ExNumType;
                  numbits    : INTEGER);
BEGIN
  LShift(Result, number, X.ExMult, numbits);

  (* Determine the resultant sign *)
  X.ExAbs(Result);
  IF Bit (Result, MaxBase2Bits-1) THEN
    X.ExChgSign(Result); (* negate *)
  END;
END ExShl;


PROCEDURE ExRol *(VAR Result : X.ExNumType;
                  number     : X.ExNumType;
                  numbits    : INTEGER);
BEGIN
  LRotate(Result, number, Left, numbits);
END ExRol;


PROCEDURE ExShr *(VAR Result : X.ExNumType;
                  number     : X.ExNumType;
                  numbits    : INTEGER);
BEGIN
  LShift(Result, number, X.ExDiv, numbits);
  X.ExAbs(Result);  (* clear the sign *)
END ExShr;


PROCEDURE ExAshr *(VAR Result : X.ExNumType;
                   number     : X.ExNumType;
                   numbits    : INTEGER);
VAR
  ShiftCnt : INTEGER;
  SavedBit : BOOLEAN;
BEGIN
  (* Constrain number to be within the logical number set *)
  ConstrainExNum(number);

  (* constrain bitnum from 0 to MaxBase2Bits *)
  IF numbits > MaxBase2Bits THEN
    (* shifted out of range *)
    Result := X.Ex0;
    RETURN;
  END;

  (* set the SavedBit to the current sign *)
  SavedBit := number.Sign = X.negative;

  (* shift the number *)
  FOR ShiftCnt := 1 TO numbits DO
    (* shift the number right *)
    X.ExDiv(number, number, Two);

    (* restore the saved bit *)
    IF SavedBit THEN
      ExSetBit(number, number, MaxBase2Bits-1);
    END;
  END;

  (* truncate any fraction *)
  Result := number;
  X.ExTrunc(Result);
END ExAshr;


PROCEDURE ExRor *(VAR Result : X.ExNumType;
                  number     : X.ExNumType;
                  numbits    : INTEGER);
BEGIN
  LRotate(Result, number, Right, numbits);
END ExRor;


(* $CopyArrays- *)
PROCEDURE StrToExInt *(S     : ARRAY OF CHAR;
                       Base  : BaseType;
                       VAR A : X.ExNumType);
VAR
  EndCnt, InCnt : LONGINT;
  Multiplier    : INTEGER;
  Scale, Temp   : X.ExNumType;

  PROCEDURE DigitIs() : LONGINT;
  VAR
    Str : ARRAY 2 OF CHAR;
    Digits : LONGINT;
  BEGIN
    (* Extract a digit *)
    Str[0] := S[InCnt]; Str[1] := 0X;
    INC(InCnt);

    IF ~Cnv.StrToInt(Str, Digits, Base) THEN
      X.ExStatus := X.IllegalNumber;
      RETURN 0;
    END;
    RETURN Digits;
  END DigitIs;

BEGIN
  A := X.Ex0;
  InCnt := 0;
  EndCnt := Str.Length(S);
  X.ExNumb(Base, 0, 0, Scale);

  (* skip leading blanks *)
  WHILE (InCnt < EndCnt) & (S[InCnt] = ' ') DO INC(InCnt) END;

  WHILE (InCnt < EndCnt) & (X.ExStatus # X.IllegalNumber) DO
    X.ExNumb(DigitIs(), 0, 0, Temp);
    X.ExMult(A, A, Scale);
    X.ExAdd(A, A, Temp);
  END;
END StrToExInt;


PROCEDURE ExIntToStr*(A     : X.ExNumType;
                      Base  : BaseType;
                      VAR S : ARRAY OF CHAR);
VAR
  InCnt : INTEGER;
  InvScale, Scale, Temp, Temp2 : X.ExNumType;

  PROCEDURE PutDigits(Numb : LONGINT);
  VAR
    Res : ARRAY 81 OF CHAR;
    Ok  : BOOLEAN;
  BEGIN
    Ok := Cnv.IntToStr(Numb, Res, Base, 4, '0');
    Str.Insert(S, 0, Res);
  END PutDigits;

BEGIN
  (* Constrain number to be within the logical number set *)
  ConstrainExNum(A);

  S := "";
  InCnt := 0;
  X.ExNumb(Base, 0, 0, Scale);
  XM.xtoi(Scale, Scale, 4);
  X.ExDiv(InvScale, X.Ex1, Scale);

  (* translate number to a string *)
  REPEAT
    (* Temp := A MOD Scale *)
    X.ExMult(Temp2, A, InvScale);
    X.ExTrunc(Temp2);
    X.ExMult(Temp, Temp2, Scale);
    X.ExSub(Temp, A, Temp);

    (* Translate to character *)
    PutDigits(X.ExToLongInt(Temp));

    (* Reduce A by scaling factor *)
    A := Temp2;
  UNTIL X.IsZero(A);
END ExIntToStr;


BEGIN
  (* create the number 2 *)
  X.ExNumb(2, 0, 0, Two);

  (* Initialize the maximum number *)
  XM.xtoi(MaxNumber, Two, MaxBase2Bits);
  X.ExSub(MaxNumber, MaxNumber, X.Ex1);

  (* Initialize the minimum number *)
  MinNumber := MaxNumber;
  X.ExChgSign(MinNumber);

  (* Initialize the zero logical *)
  FOR Cnt := 0 TO LogicalSize DO
    LogZero[Cnt] := {};
  END;
END ExIntegers.