home *** CD-ROM | disk | FTP | other *** search
/ Merciful 3 / Merciful_Release_3.bin / software / e / excalcv1.2reg.lha / ExCalcV1.2 / Source / ExIntegers.mod < prev    next >
Text File  |  1995-10-07  |  14KB  |  576 lines
  1. MODULE ExIntegers;
  2.  
  3. (*  Some Functions to perform bit manipulation on ExNumbers.
  4.     This module deals with integral ExNumbers in the range
  5.     from -5.9863E51 to 5.9863E51.  Any numbers outside this
  6.     range are represented with the maximum (or minimum)
  7.     ExNumber from this range.
  8. *)
  9.  
  10. IMPORT io, Cnv := Conversions, Str := Strings, X := ExNumbers,
  11.        XM := ExMathLib0, SYSTEM;
  12.  
  13. TYPE
  14.   BaseType * = SHORTINT;
  15.  
  16.  
  17. CONST
  18.   MaxBase2Bits = 172;    (* ln(9.99E51) / ln(2) *)
  19.   LogicalSize  = MaxBase2Bits DIV 16;
  20.   Left         = FALSE;
  21.   Right        = TRUE;
  22.  
  23. TYPE
  24.   LogicalType = ARRAY LogicalSize+1 OF SET;
  25.   LogicalProc = PROCEDURE(a,b: SET) : SET;
  26.   ExNumbProc  = PROCEDURE(VAR a: X.ExNumType; b,c: X.ExNumType);
  27.  
  28. VAR
  29.   LogZero   : LogicalType; (* All bits cleared or 0  *)
  30.   MaxNumber : X.ExNumType;   (*  2 ** MaxBase2Bits - 1 *)
  31.   MinNumber : X.ExNumType;   (* -2 ** MaxBase2Bits + 1 *)
  32.   Two       : X.ExNumType;   (* The value "2" *)
  33.   Cnt       : INTEGER;
  34.  
  35.  
  36. (*--------------------------------------*)
  37. (* Local bit manipulations functions.   *)
  38.  
  39. PROCEDURE And (op1, op2 : SET) : SET;
  40. BEGIN
  41.   RETURN op1 * op2;
  42. END And;
  43.  
  44. PROCEDURE AndNot (op1, op2 : SET) : SET;
  45. BEGIN
  46.   RETURN op1 - op2;
  47. END AndNot;
  48.  
  49. PROCEDURE Or (op1, op2 : SET) : SET;
  50. BEGIN
  51.   RETURN op1 + op2;
  52. END Or;
  53.  
  54. PROCEDURE Xor (op1, op2 : SET) : SET;
  55. BEGIN
  56.   RETURN op1 / op2;
  57. END Xor;
  58.  
  59.  
  60. (*--------------------------------------*)
  61. (* Miscellaneous local procedures       *)
  62.  
  63. PROCEDURE Max (x, y : INTEGER) : INTEGER;
  64. BEGIN
  65.   IF x > y THEN
  66.     RETURN x;
  67.   ELSE
  68.     RETURN y;
  69.   END;
  70. END Max;
  71.  
  72.  
  73. PROCEDURE ConstrainExNum (VAR Number : X.ExNumType);
  74. (* Limit Number to be within MinNumber to MaxNumber and
  75.    eliminate any fractional portions. *)
  76. BEGIN
  77.   X.ExMin(Number, MaxNumber, Number);
  78.   X.ExMax(Number, MinNumber, Number);
  79.   X.ExTrunc(Number);
  80. END ConstrainExNum;
  81.  
  82.  
  83. PROCEDURE ExNumToLogical (Numb        : X.ExNumType;
  84.                           VAR Logical : LogicalType);
  85. VAR
  86.   DivScale : X.ExNumType;
  87.   Scale    : X.ExNumType;
  88.   Temp     : X.ExNumType;
  89.   Temp2    : X.ExNumType;
  90.   LogCnt   : INTEGER;
  91. BEGIN
  92.   (* Constrain op1, op2 to be within the logical number set *)
  93.   ConstrainExNum(Numb);
  94.  
  95.   (* translation scaling factor *)
  96.   X.ExNumb(65536, 0, 0, Scale);
  97.   X.ExDiv(DivScale, X.Ex1, Scale);
  98.  
  99.   (* perform conversion *)
  100.   LogCnt  := 0;
  101.   Logical := LogZero;
  102.   WHILE NOT X.IsZero(Numb) DO
  103.     X.ExMult(Temp2, Numb, DivScale);
  104.     X.ExTrunc(Temp2);
  105.     X.ExMult(Temp, Temp2, Scale);
  106.     X.ExSub(Temp, Numb, Temp);
  107.     IF LogCnt > LogicalSize THEN RETURN END;
  108.     (* $RangeChk- *)
  109.     Logical[LogCnt] := SYSTEM.VAL(SET, SHORT(X.ExToLongInt(Temp)));
  110.     (* $RangeChk= *)
  111.     Numb := Temp2;
  112.     INC(LogCnt);
  113.   END;
  114. END ExNumToLogical;
  115.  
  116. PROCEDURE LogicalToExNum (Logical  : LogicalType;
  117.                           VAR Numb : X.ExNumType);
  118. VAR
  119.   Scale  : X.ExNumType;
  120.   Temp   : X.ExNumType;
  121.   LogCnt : INTEGER;
  122.   INumb  : LONGINT;
  123. BEGIN
  124.   (* translation scaling factor *)
  125.   X.ExNumb(65536, 0, 0, Scale);
  126.  
  127.   (* perform conversion *)
  128.   Numb := X.Ex0;
  129.   FOR LogCnt := LogicalSize TO 0 BY -1 DO
  130.     X.ExMult(Numb, Numb, Scale);
  131.     INumb := SYSTEM.VAL(INTEGER, Logical[LogCnt]);
  132.     IF INumb < 0 THEN INC(INumb, 10000H) END;
  133.     X.ExNumb(INumb, 0, 0, Temp);
  134.     X.ExAdd(Numb, Numb, Temp);
  135.   END;
  136. END LogicalToExNum;
  137.  
  138.  
  139. (*--------------------------------------*)
  140. (* Local procedure to perform general   *)
  141. (* logical operations on ExNumbers.     *)
  142.  
  143. PROCEDURE LOp (VAR Result : X.ExNumType;
  144.                op1        : X.ExNumType;
  145.                Oper       : LogicalProc;
  146.                op2        : X.ExNumType);
  147. VAR
  148.   i : INTEGER;
  149.   Lop1, Lop2 : LogicalType;
  150. BEGIN
  151.   (* Translate to logicals *)
  152.   ExNumToLogical(op1, Lop1);
  153.   ExNumToLogical(op2, Lop2);
  154.  
  155.   (* Operate on Lop1 and Lop2 one quad at a time *)
  156.   FOR i := 0 TO LogicalSize DO
  157.     Lop2[i] := Oper(Lop1[i], Lop2[i]);
  158.   END;
  159.  
  160.   (* Translate back the result *)
  161.   LogicalToExNum(Lop2, Result);
  162. END LOp;
  163.  
  164.  
  165. (*--------------------------------------*)
  166. (* Local procedure to perform general   *)
  167. (* single bit operations on ExNumbers.  *)
  168.  
  169. PROCEDURE LBit (VAR Result : X.ExNumType;
  170.                 number     : X.ExNumType;
  171.                 Oper       : LogicalProc;
  172.                 bitnum     : INTEGER);
  173. VAR
  174.   Temp : X.ExNumType;
  175. BEGIN
  176.   (* Constrain number to be within the logical number set *)
  177.   ConstrainExNum(number);
  178.  
  179.   (* constrain bitnum from 0 to MaxBase2Bits *)
  180.   IF bitnum > MaxBase2Bits THEN
  181.     (* no bits are changed *)
  182.     Result := number;
  183.     RETURN;
  184.   END;
  185.  
  186.   (* calculate 2**bitnum *)
  187.   XM.xtoi(Temp, Two, bitnum);
  188.  
  189.   (* set the bitnum bit position *)
  190.   LOp(Result, number, Oper, Temp);
  191. END LBit;
  192.  
  193.  
  194. PROCEDURE ExSetBit *(VAR Result : X.ExNumType;
  195.                      number     : X.ExNumType;
  196.                      bitnum     : INTEGER);
  197. BEGIN
  198.   LBit(Result, number, Or, bitnum);
  199. END ExSetBit;
  200.  
  201.  
  202. PROCEDURE ExClearBit *(VAR Result : X.ExNumType;
  203.                        number     : X.ExNumType;
  204.                        bitnum     : INTEGER);
  205. BEGIN
  206.   LBit(Result, number, AndNot, bitnum);
  207. END ExClearBit;
  208.  
  209.  
  210. PROCEDURE ExToggleBit *(VAR Result : X.ExNumType;
  211.                         number     : X.ExNumType;
  212.                         bitnum     : INTEGER);
  213. BEGIN
  214.   LBit(Result, number, Xor, bitnum);
  215. END ExToggleBit;
  216.  
  217.  
  218. PROCEDURE^ ExAnd *(VAR Result : X.ExNumType;
  219.                    op1, op2   : X.ExNumType);
  220.  
  221.  
  222. (*--------------------------------------*)
  223. (* Local function to extract a bit from *)
  224. (* an ExNumber.                         *)
  225.  
  226. PROCEDURE Bit (number : X.ExNumType;
  227.                bitnum : INTEGER) : BOOLEAN;
  228. VAR
  229.   Temp : X.ExNumType;
  230. BEGIN
  231.   (* Constrain number to be within the logical number set *)
  232.   ConstrainExNum(number);
  233.  
  234.   (* constrain bitnum from 0 to MaxBase2Bits - 1 *)
  235.   IF bitnum >= MaxBase2Bits THEN
  236.     (* assume FALSE *)
  237.     RETURN FALSE;
  238.   END;
  239.  
  240.   (* calculate 2**bitnum *)
  241.   XM.xtoi(Temp, Two, bitnum);
  242.  
  243.   (* extract the bitnum bit *)
  244.   ExAnd(number, number, Temp);
  245.  
  246.   (* translate to boolean *)
  247.   RETURN NOT X.IsZero(number);
  248. END Bit;
  249.  
  250.  
  251. (*--------------------------------------*)
  252. (* Local procedure to perform general   *)
  253. (* bit shifting operations on ExNumbers.*)
  254.  
  255. PROCEDURE LShift (VAR Result : X.ExNumType;
  256.                   number     : X.ExNumType;
  257.                   ExOper     : ExNumbProc;
  258.                   bits       : INTEGER);
  259. VAR
  260.   Temp : X.ExNumType;
  261. BEGIN
  262.   (* Constrain number to be within the logical number set *)
  263.   ConstrainExNum(number);
  264.  
  265.   (* constrain bitnum from 0 to MaxBase2Bits *)
  266.   IF bits > MaxBase2Bits THEN
  267.     (* shifted out of range *)
  268.     Result := X.Ex0;
  269.     RETURN;
  270.   END;
  271.  
  272.   (* calculate 2**bits *)
  273.   XM.xtoi(Temp, Two, bits);
  274.  
  275.   (* shift the number *)
  276.   ExOper(Result, number, Temp);
  277.  
  278.   (* Constrain number to be within the logical number set *)
  279.   ConstrainExNum(Result);
  280. END LShift;
  281.  
  282.  
  283. (*--------------------------------------*)
  284. (* Local procedure to perform general   *)
  285. (* bit rotation operations on ExNumbers.*)
  286.  
  287. PROCEDURE LRotate (VAR Result : X.ExNumType;
  288.                    number     : X.ExNumType;
  289.                    Shiftright : BOOLEAN;
  290.                    bits       : INTEGER);
  291. VAR
  292.   ShiftCnt : INTEGER;
  293.   SavedBit : BOOLEAN;
  294.   Half     : X.ExNumType;
  295. BEGIN
  296.   (* Constrain number to be within the logical number set *)
  297.   ConstrainExNum(number);
  298.  
  299.   (* constrain bitnum from 0 to MaxBase2Bits *)
  300.   bits := bits MOD (MaxBase2Bits + 1);
  301.   X.ExNumb(0, 5, 0, Half);
  302.  
  303.   FOR ShiftCnt := 1 TO bits DO
  304.     IF Shiftright THEN
  305.       (* save the bit to be shifted *)
  306.       SavedBit := Bit(number, 0);
  307.  
  308.       (* shift the number right *)
  309.       X.ExMult(number, number, Half);
  310.       X.ExTrunc(number);
  311.       IF SavedBit THEN
  312.         ExSetBit(number, number, MaxBase2Bits-1);
  313.       END;
  314.     ELSE
  315.       (* save the bit to be shifted *)
  316.       SavedBit := Bit(number, MaxBase2Bits-1);
  317.  
  318.       (* shift the number left *)
  319.       X.ExMult(number, number, Two);
  320.  
  321.       (* restore the saved bit *)
  322.       IF SavedBit THEN
  323.         ExSetBit(number, number, 0);
  324.       END;
  325.     END;
  326.  
  327.   END;
  328.  
  329.   (* Constrain number to be within the logical number set *)
  330.   Result := number;
  331.   ConstrainExNum(Result);
  332. END LRotate;
  333.  
  334.  
  335. (*--------------------------------------*)
  336. (* Exported procedures.                 *)
  337.  
  338. PROCEDURE ExAnd *(VAR Result : X.ExNumType;
  339.                   op1, op2   : X.ExNumType);
  340. BEGIN
  341.   LOp(Result, op1, And, op2);
  342. END ExAnd;
  343.  
  344.  
  345. PROCEDURE ExOr *(VAR Result : X.ExNumType;
  346.                  op1, op2   : X.ExNumType);
  347. BEGIN
  348.   LOp(Result, op1, Or, op2);
  349. END ExOr;
  350.  
  351.  
  352. PROCEDURE ExXor *(VAR Result : X.ExNumType;
  353.                   op1, op2   : X.ExNumType);
  354. BEGIN
  355.   LOp(Result, op1, Xor, op2);
  356. END ExXor;
  357.  
  358.  
  359. PROCEDURE ExIntDiv *(VAR Result : X.ExNumType;
  360.                      op1, op2   : X.ExNumType);
  361. BEGIN
  362.   (* Constrain inputs to be integers *)
  363.   ConstrainExNum(op1); ConstrainExNum(op2);
  364.   X.ExDiv(Result, op1, op2);
  365.   X.ExTrunc(Result);
  366. END ExIntDiv;
  367.  
  368.  
  369. PROCEDURE ExMod *(VAR Result : X.ExNumType;
  370.                   op1, op2   : X.ExNumType);
  371. BEGIN
  372.   (* Result := op1 - (op1 DIV op2) * op2 *)
  373.   ConstrainExNum(op1); ConstrainExNum(op2);
  374.   ExIntDiv(Result, op1, op2);
  375.   X.ExMult(Result, Result, op2);
  376.   X.ExSub(Result, op1, Result);
  377. END ExMod;
  378.  
  379.  
  380. PROCEDURE ExOnesComp *(VAR Result : X.ExNumType;
  381.                        number     : X.ExNumType);
  382. BEGIN
  383.   (* Constrain number to be within the logical number set *)
  384.   ConstrainExNum(number);
  385.   IF number.Sign = X.positive THEN
  386.     (* Subtract from the maximum number *)
  387.     X.ExSub(Result, MaxNumber, number);
  388.   ELSE
  389.     (* Subtract from the minimum number *)
  390.     X.ExSub(Result, MinNumber, number);
  391.   END;
  392.  
  393.   (* Complement the sign bit *)
  394.   X.ExChgSign(Result);
  395. END ExOnesComp;
  396.  
  397.  
  398. PROCEDURE ExShl *(VAR Result : X.ExNumType;
  399.                   number     : X.ExNumType;
  400.                   numbits    : INTEGER);
  401. BEGIN
  402.   LShift(Result, number, X.ExMult, numbits);
  403.  
  404.   (* Determine the resultant sign *)
  405.   X.ExAbs(Result);
  406.   IF Bit (Result, MaxBase2Bits-1) THEN
  407.     X.ExChgSign(Result); (* negate *)
  408.   END;
  409. END ExShl;
  410.  
  411.  
  412. PROCEDURE ExRol *(VAR Result : X.ExNumType;
  413.                   number     : X.ExNumType;
  414.                   numbits    : INTEGER);
  415. BEGIN
  416.   LRotate(Result, number, Left, numbits);
  417. END ExRol;
  418.  
  419.  
  420. PROCEDURE ExShr *(VAR Result : X.ExNumType;
  421.                   number     : X.ExNumType;
  422.                   numbits    : INTEGER);
  423. BEGIN
  424.   LShift(Result, number, X.ExDiv, numbits);
  425.   X.ExAbs(Result);  (* clear the sign *)
  426. END ExShr;
  427.  
  428.  
  429. PROCEDURE ExAshr *(VAR Result : X.ExNumType;
  430.                    number     : X.ExNumType;
  431.                    numbits    : INTEGER);
  432. VAR
  433.   ShiftCnt : INTEGER;
  434.   SavedBit : BOOLEAN;
  435. BEGIN
  436.   (* Constrain number to be within the logical number set *)
  437.   ConstrainExNum(number);
  438.  
  439.   (* constrain bitnum from 0 to MaxBase2Bits *)
  440.   IF numbits > MaxBase2Bits THEN
  441.     (* shifted out of range *)
  442.     Result := X.Ex0;
  443.     RETURN;
  444.   END;
  445.  
  446.   (* set the SavedBit to the current sign *)
  447.   SavedBit := number.Sign = X.negative;
  448.  
  449.   (* shift the number *)
  450.   FOR ShiftCnt := 1 TO numbits DO
  451.     (* shift the number right *)
  452.     X.ExDiv(number, number, Two);
  453.  
  454.     (* restore the saved bit *)
  455.     IF SavedBit THEN
  456.       ExSetBit(number, number, MaxBase2Bits-1);
  457.     END;
  458.   END;
  459.  
  460.   (* truncate any fraction *)
  461.   Result := number;
  462.   X.ExTrunc(Result);
  463. END ExAshr;
  464.  
  465.  
  466. PROCEDURE ExRor *(VAR Result : X.ExNumType;
  467.                   number     : X.ExNumType;
  468.                   numbits    : INTEGER);
  469. BEGIN
  470.   LRotate(Result, number, Right, numbits);
  471. END ExRor;
  472.  
  473.  
  474. (* $CopyArrays- *)
  475. PROCEDURE StrToExInt *(S     : ARRAY OF CHAR;
  476.                        Base  : BaseType;
  477.                        VAR A : X.ExNumType);
  478. VAR
  479.   EndCnt, InCnt : LONGINT;
  480.   Multiplier    : INTEGER;
  481.   Scale, Temp   : X.ExNumType;
  482.  
  483.   PROCEDURE DigitIs() : LONGINT;
  484.   VAR
  485.     Str : ARRAY 2 OF CHAR;
  486.     Digits : LONGINT;
  487.   BEGIN
  488.     (* Extract a digit *)
  489.     Str[0] := S[InCnt]; Str[1] := 0X;
  490.     INC(InCnt);
  491.  
  492.     IF ~Cnv.StrToInt(Str, Digits, Base) THEN
  493.       X.ExStatus := X.IllegalNumber;
  494.       RETURN 0;
  495.     END;
  496.     RETURN Digits;
  497.   END DigitIs;
  498.  
  499. BEGIN
  500.   A := X.Ex0;
  501.   InCnt := 0;
  502.   EndCnt := Str.Length(S);
  503.   X.ExNumb(Base, 0, 0, Scale);
  504.  
  505.   (* skip leading blanks *)
  506.   WHILE (InCnt < EndCnt) & (S[InCnt] = ' ') DO INC(InCnt) END;
  507.  
  508.   WHILE (InCnt < EndCnt) & (X.ExStatus # X.IllegalNumber) DO
  509.     X.ExNumb(DigitIs(), 0, 0, Temp);
  510.     X.ExMult(A, A, Scale);
  511.     X.ExAdd(A, A, Temp);
  512.   END;
  513. END StrToExInt;
  514.  
  515.  
  516. PROCEDURE ExIntToStr*(A     : X.ExNumType;
  517.                       Base  : BaseType;
  518.                       VAR S : ARRAY OF CHAR);
  519. VAR
  520.   InCnt : INTEGER;
  521.   InvScale, Scale, Temp, Temp2 : X.ExNumType;
  522.  
  523.   PROCEDURE PutDigits(Numb : LONGINT);
  524.   VAR
  525.     Res : ARRAY 81 OF CHAR;
  526.     Ok  : BOOLEAN;
  527.   BEGIN
  528.     Ok := Cnv.IntToStr(Numb, Res, Base, 4, '0');
  529.     Str.Insert(S, 0, Res);
  530.   END PutDigits;
  531.  
  532. BEGIN
  533.   (* Constrain number to be within the logical number set *)
  534.   ConstrainExNum(A);
  535.  
  536.   S := "";
  537.   InCnt := 0;
  538.   X.ExNumb(Base, 0, 0, Scale);
  539.   XM.xtoi(Scale, Scale, 4);
  540.   X.ExDiv(InvScale, X.Ex1, Scale);
  541.  
  542.   (* translate number to a string *)
  543.   REPEAT
  544.     (* Temp := A MOD Scale *)
  545.     X.ExMult(Temp2, A, InvScale);
  546.     X.ExTrunc(Temp2);
  547.     X.ExMult(Temp, Temp2, Scale);
  548.     X.ExSub(Temp, A, Temp);
  549.  
  550.     (* Translate to character *)
  551.     PutDigits(X.ExToLongInt(Temp));
  552.  
  553.     (* Reduce A by scaling factor *)
  554.     A := Temp2;
  555.   UNTIL X.IsZero(A);
  556. END ExIntToStr;
  557.  
  558.  
  559. BEGIN
  560.   (* create the number 2 *)
  561.   X.ExNumb(2, 0, 0, Two);
  562.  
  563.   (* Initialize the maximum number *)
  564.   XM.xtoi(MaxNumber, Two, MaxBase2Bits);
  565.   X.ExSub(MaxNumber, MaxNumber, X.Ex1);
  566.  
  567.   (* Initialize the minimum number *)
  568.   MinNumber := MaxNumber;
  569.   X.ExChgSign(MinNumber);
  570.  
  571.   (* Initialize the zero logical *)
  572.   FOR Cnt := 0 TO LogicalSize DO
  573.     LogZero[Cnt] := {};
  574.   END;
  575. END ExIntegers.
  576.