Club Amiga de Montreal - CAM/CAM_CD_1.iso/files/229.lha/Calc_v1.01/sources/CalcBrains.mod

Text File | 1989-04-04 | 4KB | 197 lines

IMPLEMENTATION MODULE CalcBrains;


FROM SYSTEM      IMPORT TERMPROC;
FROM Stacks      IMPORT CreateStack, DisposeStack, PushB, PopB, PushL, PopL,
                         ClearStack, Stack;
FROM CalcGadgets  IMPORT resetValue;
FROM CalcValidate IMPORT Addition, Subtraction, Multiplication, Division,
                         errorString;
FROM CalcDisplay  IMPORT DoLCDStr;


TYPE
  OpSet = SET OF OpType;


CONST
  HiPriorityOps = OpSet{OpTimes,OpDivide,OpAnd,OpOr,OpXor};


VAR
  opStack   : Stack;
  numStack  : Stack;
  openCount : CARDINAL;


(*$L+*)
PROCEDURE PushOp(op:OpType);
BEGIN
  PushB(opStack,op);
END PushOp;


PROCEDURE PopOp(): OpType;
BEGIN
  RETURN OpType(PopB(opStack));
END PopOp;


PROCEDURE PushNum(num:LONGCARD);
BEGIN
  PushL(numStack,num);
END PushNum;


PROCEDURE PopNum(): LONGCARD;
BEGIN
  RETURN LONGCARD(PopL(numStack));
END PopNum;


(*$L-*)
PROCEDURE ProcessParenthesis();
VAR
  tos       : OpType;
  val1,val2 : LONGCARD;
BEGIN
  tos:=PopOp();
  IF tos=OpLeftParen THEN
    value:=PopNum();
    RETURN;
  END;

  LOOP
    val1:=PopNum();
    val2:=PopNum();
    CASE tos OF
      |OpPlus  : IF NOT Addition(val1,val2) THEN
                   EXIT;
                 END;
                 value:=val1+val2;
      |OpMinus : IF NOT Subtraction(val2,val1) THEN
                   EXIT;
                 END;
                 value:=val2-val1;
      |OpTimes : IF NOT Multiplication(val1,val2) THEN
                   EXIT;
                 END;
                 value:=val1*val2;
      |OpDivide: IF NOT Division(val2,val1) THEN
                   EXIT;
                 END;
                 value:=val2 DIV val1;
      |OpAnd   : value:=LONGCARD(LONGBITSET(val1) * LONGBITSET(val2));
      |OpOr    : value:=LONGCARD(LONGBITSET(val1) + LONGBITSET(val2));
      |OpXor   : value:=LONGCARD(LONGBITSET(val1) / LONGBITSET(val2));
    ELSE
    END;

    tos:=PopOp();
    IF tos=OpLeftParen THEN
      RETURN;
    END;
    PushNum(value);
  END;

  DoLCDStr(errorString^);
END ProcessParenthesis;


PROCEDURE EnterOperation(op:OpType);
VAR
  tos      : OpType;        (* Top Of Stack *)
  tosValue : LONGCARD;
  backup   : LONGCARD;
BEGIN
  resetValue:=TRUE;

  IF (op # OpLeftParen) & (op # OpRightParen) & (op # OpClearAll) THEN
    LOOP
      tos:=PopOp();
      IF NOT (tos IN HiPriorityOps) THEN
        PushOp(tos);
        EXIT;
      END;

      tosValue:=PopNum();
      CASE tos OF
        |OpTimes : IF NOT Multiplication(value,tosValue) THEN
                     DoLCDStr(errorString^);
                     EXIT;
                   END;
                   value:=value*tosValue;
        |OpDivide: IF NOT Division(tosValue,value) THEN
                     DoLCDStr(errorString^);
                     EXIT;
                   END;
                   value:=tosValue DIV value;
        |OpAnd   : value:=LONGCARD(LONGBITSET(tosValue) * LONGBITSET(value));
        |OpOr    : value:=LONGCARD(LONGBITSET(tosValue) + LONGBITSET(value));
        |OpXor   : value:=LONGCARD(LONGBITSET(tosValue) / LONGBITSET(value));
      END;
    END;
  END;

  CASE op OF
    |OpLeftParen : PushOp(OpLeftParen);
                   INC(openCount);

    |OpRightParen: DEC(openCount);
                   PushNum(value);
                   ProcessParenthesis();

    |OpEqual     : WHILE openCount>0 DO
                     EnterOperation(OpRightParen); (* will decrement openCount *)
           END;
                   EnterOperation(OpClearAll);
    |OpPlus,
     OpMinus     : PushNum(value);
                   ProcessParenthesis();
                   PushOp(OpLeftParen);
                   PushNum(value);
                   PushOp(op);

    |OpTimes,
     OpDivide,
     OpAnd,
     OpOr,
     OpXor     : PushOp(op);
                   PushNum(value);

    |OpClearAll     : ClearStack(opStack);
                   ClearStack(numStack);
                   PushOp(OpLeftParen);
                   openCount:=1;
  ELSE
  END;
END EnterOperation;


PROCEDURE TerminateCalcBrains;
BEGIN
  DisposeStack(opStack);
  DisposeStack(numStack);
END TerminateCalcBrains;


PROCEDURE InitBrains(): BOOLEAN;
BEGIN
  IF CreateStack(opStack,2000) THEN
    IF CreateStack(numStack,4000) THEN
      EnterOperation(OpClearAll);
      TERMPROC(TerminateCalcBrains);
      RETURN TRUE;
    END;
    DisposeStack(opStack);
  END;

  RETURN FALSE;
END InitBrains;


BEGIN
  value:=0;
  stoValue:=0;
END CalcBrains.