program stackdemo (infile1,output);

  {stackdemo uses two stacks to evaluate arithmetic expressions.
   operators are limited to add and multiply and operands are limited to
   single digits.

 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      LIST ADT (a LINKED LIST (with header cell) implementation)

NOTES:-    1. NO ERROR CHECKING is performed in this implementation.
              The caller has responsibility for ensuring that the
              position to be RETRIEVE'd or DELETED actually exists.

           2. The position operated on by RETRIEVE, INSERT and DELETE
              is the position FOLLOWING the one pointed to by the
              position pointer (ENDLIS returns a pointer to the last
              element, and FIRST to the header cell (NOT the first element)).}


type
  infotype = integer;
  list = ^listype;
  position = list;
  listype = record
              info: infotype;
              next: list
            end;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

var
  infile1: text;
  valstk, opstk: list;
  c: char;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

       LIST ADT  -  CODE}

function FIRST (L: list): position;
  begin
    FIRST:= L
  end;
function ENDLIS (L: list): position;
  var
    p: position;
  begin
    p:= L;
    while p^.next <> nil do
      p:= p^.next;
    ENDLIS:= p
  end;
function NEXT (p: position; L:list): position;
  begin
    NEXT:= p^.next
  end;
function RETRIEVE (p: position; L: list): infotype;
  begin
    RETRIEVE:= p^.next^.info
  end;
procedure DELETE (p: position; L: list);
  begin
    p^.next:= p^.next^.next
  end;
procedure MAKENULLST (var L: list);
  begin
    new(L);
    L^.next:=nil;
  end;
procedure INSERT (x: infotype; p: position; var L: list);
  var
    q: position;
  begin
    q:= p^.next;
    new(p^.next);
    p^.next^.info:=x;
    p^.next^.next:=q
  end;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      STACK ADT (requires a general LIST ADT)  -  CODE}

procedure MAKENULL (var S: list);
  begin
    MAKENULLST(S)
  end;
function TOP (S: list): infotype;
  begin
    TOP:= RETRIEVE (FIRST(S), S)
  end;
procedure POP (S: list);
  begin
    DELETE (FIRST(S), S)
  end;
procedure PUSH (x: infotype; S: list);
  begin
    INSERT (x, FIRST(S), S)
  end;
function EMPTY (S: list): boolean;
  begin
    EMPTY:= FIRST(S) = ENDLIS(S)
  end;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

procedure ERROR;
  begin
  { * * COMPILER SPECIFIC FEATURE FOLLOWS * *}
  abort('INPUT ERROR',0,0);
  { * * END CSF * *}
  end;
procedure calcit (O,V: list);
  {calcit removes an operator from O and two operands from V, performs
   the operation, and places the result back on V}
  var
    oper1, oper2: integer;
  begin
    oper1:= TOP (V);
    POP (V);
    oper2:= TOP (V);
    POP (V);
    if TOP (O) = 2
      then {OPERATION IS ADD}
        oper1 := oper1 + oper2
      else
        if TOP (O) = 3
          then {OPERATION IS MULTIPLY}
            oper1 := oper1 * oper2
          else
            ERROR; {INCORRECT PARENTHESIS PLACEMENT}
    POP (O);
    PUSH (oper1, V) {PUT RESULT ON V}
  end;

{     *  *  *     MAIN PROGRAM CODE STARTS HERE    *  *  *}

begin
  reset(infile1);
  writeln;
  MAKENULL(valstk);
  MAKENULL(opstk);
  read (infile1, c);
  while not eof(infile1) do
    begin
      if (((ord(c)-ord('0'))<0) or ((ord(c)-ord('0'))>9))
        then {CHARACTER IS NOT A NUMBER}
          begin

{ ASSIGN A NUMBER TO EACH POSSIBLE ENTRY FOR OPERATIONS STACK (BOTH STACKS
  CAN THEN HAVE ELEMENTS OF INTEGER TYPE)

      1 = (
      2 = +
      3 = *
}
            case c of
              '*': begin
                     {PROCESS AND REMOVE ANY MULTIPLY OPERATIONS BEFORE STORING}
                     while TOP(opstk)=3 do
                       calcit (opstk, valstk);
                     PUSH (3,opstk)
                   end;
              '+': begin
                     {PROCESS AND REMOVE ANY MULTIPY OR ADD OPERATIONS BEFORE
                      STORING}
                     while ((TOP(opstk)=2) or (TOP(opstk)=3)) do
                       calcit (opstk, valstk);
                     PUSH (2,opstk)
                   end;
              '(': PUSH (1,opstk); {STORE IMMEDIATELY}
              ')': begin
                     {PROCESS AND REMOVE EVERYTHING BACK TO THE OPENING
                      PARENTHESIS, THEN REMOVE THE PARENTHESIS}
                     while TOP(opstk)<>1 do
                       calcit (opstk, valstk);
                     POP (opstk)
                   end
  { * * COMPILER SPECIFIC FEATURE FOLLOWS * *}
              otherwise
                ERROR  {ILLEGAL CHARACTER IN INPUT STREAM}
  { * * END CSF * *}
            end
          end
        else  {CHARACTER IS A NUMBER, SO PUT IT ON VALUE STACK}
          PUSH (ord(c)-ord('0'),valstk);
      write (c);
      read (infile1, c)
    end;
  while not EMPTY (opstk) do
    calcit (opstk, valstk);
  write ('  = ',TOP(valstk):3);
  writeln
end.