INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit

DEFINE PTR="CARD"
DEFINE BUFFER_SIZE="60"
DEFINE ENTRY_SIZE="6"
DEFINE MAX_SIZE="10"
BYTE ARRAY stack(BUFFER_SIZE)
BYTE stackSize=[0]

BYTE FUNC IsEmpty()
  IF stackSize=0 THEN
    RETURN (1)
  FI
RETURN (0)

PTR FUNC GetPtr(BYTE i)
RETURN (stack+i*ENTRY_SIZE)

PROC Push(REAL POINTER v)
  REAL POINTER p

  IF stackSize=MAX_SIZE THEN
    PrintE("Error: stack is full!")
    Break()
  FI
  p=GetPtr(stackSize)
  RealAssign(v,p)
  stackSize==+1
RETURN

PROC Pop(REAL POINTER v)
  REAL POINTER p

  IF IsEmpty() THEN
    PrintE("Error: stack is empty!")
    Break()
  FI
  stackSize==-1
  p=GetPtr(stackSize)
  RealAssign(p,v)
RETURN

PROC PrintStack()
  INT i
  REAL POINTER p

  FOR i=0 TO stackSize-1
  DO
    p=GetPtr(i)
    PrintR(p) Put(32)
  OD
  PutE()
RETURN

BYTE FUNC GetToken(CHAR ARRAY s BYTE start CHAR ARRAY t)
  BYTE pos

  pos=start
  WHILE pos<=s(0) AND s(pos)#'
  DO
    pos==+1
  OD
  SCopyS(t,s,start,pos-1)
RETURN (pos)

PROC MyPower(REAL POINTER base,exp,res)
  INT i,expI
  REAL tmp

  expI=RealToInt(exp)
  IF expI<0 THEN Break() FI

  IntToReal(1,res)
  FOR i=1 TO expI
  DO
    RealMult(res,base,tmp)
    RealAssign(tmp,res)
  OD
RETURN

PROC Process(CHAR ARRAY s)
  DEFINE Pop21="Pop(v2) Pop(v1)"
  CHAR ARRAY t(100)
  BYTE i,j
  CHAR c
  REAL v1,v2,v3

  i=1
  WHILE i<=s(0)
  DO
    WHILE i<=s(0) AND s(i)='
    DO i==+1 OD
    IF i>s(0) THEN EXIT FI

    i=GetToken(s,i,t)
    IF SCompare(t,"+")=0 THEN
      Pop21 RealAdd(v1,v2,v3)
      Print("calc +: ")
    ELSEIF SCompare(t,"-")=0 THEN
      Pop21 RealSub(v1,v2,v3)
      Print("calc -: ")
    ELSEIF SCompare(t,"*")=0 THEN
      Pop21 RealMult(v1,v2,v3)
      Print("calc *: ")
    ELSEIF SCompare(t,"/")=0 THEN
      Pop21 RealDiv(v1,v2,v3)
      Print("calc /: ")
    ELSEIF SCompare(t,"^")=0 THEN
      Pop21 MyPower(v1,v2,v3)
      Print("calc ^: ")
    ELSE
      ValR(t,v3)
      PrintF("push %S: ",t)
    FI
    Push(v3)
    PrintStack()
  OD
RETURN

PROC Test(CHAR ARRAY s)
  PrintE(s) PutE()
  Process(s)
RETURN

PROC Main()
  Put(125) PutE() ;clear the screen
  Test("3 4 2 * 1 5 - 2 3 ^ ^ / +")
RETURN