   Dim Version$/"Calculator 1.0 (C) 1984 Ira D. Baxter"/
   ! Revision History
   !    12/15/84 Created program
   Dim Alphabet$/"ABCDEFGHIJKLMNOPQRSTUVWXYZ"/
   Dim Digits$/"0123456789"/,Hexdigits$/"0123456789ABCDEF"/
   Dim ValueStack(50)
   Dim Line$(132)
   Dim Variable[26]

Def Match(MatchCharacter$)
   ! advance SCANPOINTER if MatchCharacter at SCANPOINTER
   If Line$[ScanPointer,1]=MatchCharacter$
   Then
       ScanPointer=ScanPointer+1
       Return True
   Else
       Return False
   Fi
End

Def MatchFunction(MatchFunction$)
   If Find(Right$(Line$,ScanPointer),MatchFunction$)=1
   Then
       ScanPointer=ScanPointer+len(MatchFunction$)
       Return True
   Else
       Return False
   Fi
End

Def PopValue
   ValueStackPointer=ValueStackPointer-1
   Return ValueStack[ValueStackPointer]
End

Subroutine Push(PushValue)
   ValueStack[ValueStackPointer]=PushValue
   ValueStackPointer=ValueStackPointer+1
   Return Subroutine
End

Subroutine PrintHex(HexValue)
   ! Print value as 8 digit max HexNumber
   If HexValue<-(2^31) or HexValue>=2^32
   Then Return Subroutine
   ! Take 2's complement if negative
   If HexValue<0
   Then HexSign=-1\HexValue=-HexValue
   Else HexSign=0
   IntegerPart=Int(HexValue)
   FractionPart=HexValue-IntegerPart
   For i=1 to 16 do line$[i]=0
   For i=8 to 1 step -1
       If IntegerPart=0 Then Exit i
       IntegerPartDividedBy16=Int(IntegerPart/16)
       Digit=IntegerPart-16*IntegerPartDividedBy16
       Let Line$[i]=Digit
       IntegerPart=IntegerPartDividedBy16
   End
   For i=9 to 16 Until FractionPart=0 Do
       Digit=Int(FractionPart*16)
       Line$[i]=Digit
       FractionPart=FractionPart*16-Digit
   End
   If HexSign<0
   Then
       For i=1 to 16 do Line$[i]=:F-Line$[i] \ ! Takes 1's complement
       Repeat
           i=i-1
           Let Line$[i]=Line$[i]+1 \ ! Take 2's complement
           If Line$[i]>=16 Then Line$[i]=Line$[i]-16 Else i=0
       Unless i=0 End
   Fi
   Print ":";
   For i=1 to 8 do
       Print Hexdigits$[Line$[i]+1,1];
   Next i
   Print ".";
   For i=9 to 16 do Print Hexdigits$[Line$[i]+1,1];
   Return Subroutine
End

Subroutine ExecuteLine
   ! Executes Line$ as though it were a BASIC expression
   ! Two valid forms:
   !   <exp>           which means compute <exp> and print it
   !   <var>=<exp>     which means compute <exp>, print it and store
   ! Syntax error signalled if expression is malformed
   ! Various arithmetic errors are also possible
   ! Accepts operators  + - * / ^ SQR INT SIN COS ATN TAN LOG EXP and "(" ")"
   !                    !   &     COM     - (negate)
   ! Number formats are hex (of 8 digit precision) or decimal
   !
   ! Syntax equations, recursive descent:
   !
   ! GOAL = EXPRESSION / .ID '=' EXPRESSION ;
   ! EXPRESSION = PRODUCT $( ADDOP PRODUCT ) ;
   ! PRODUCT = TERM $( MULTIPLYOP TERM);
   ! TERM = PRIMARY $( "^" PRIMARY);
   ! PRIMARY = HEXCONSTANT / DECIMALFPCONSTANT /
   !           .ID / "(" EXPRESSION ")" / "-" PRIMARY /
   !           .UNARYFNNAME PRIMARY ;
   !
   ValueStackPointer=0
   ScanPointer=1 \ ! Start scanning at line start
   Line$=UpperCase$(Line$) Cat "|" \ ! So we don't have to worry about case
         ! Trailing "|" means ScanPointer cannot run off end of string
TryGoalAssignment: ! handle GOAL = .ID "=" EXPRESSION ;
   Gosub Identifier
   TargetVariable=VariableNumber \ ! Remember which variable to assign
   If Not Found then TryGoalExpression
   If Not Match("=")
   Then
       ScanPointer=1
       Goto TryGoalExpression
   Fi
   Gosub Expression
   If Not Found Then SyntaxError
   Gosub RequireEndLine
   Print Value;
   PrintHex(Value)
   Print
   Variable(TargetVariable)=Value
   Return Subroutine

TryGoalExpression: ! handle GOAL = EXPRESSION ;
   Gosub Expression
   If Not Found Then SyntaxError
   Gosub RequireEndLine
   Print Value;
   PrintHex(Value)
   Print
   Return Subroutine

Expression: ! Match to EXPRESSION = PRODUCT $( ADDOP PRODUCT ) ;
   Gosub Product
   If Not Found Then SyntaxError
   Repeat
       If Match("+")
       Then
           Push(Value)
           Gosub Product
           If Not Found Then SyntaxError
           Value=PopValue+Value
       ElseIf Match("-")
       Then
           Push(Value)
           Gosub Product
           If Not Found Then SyntaxError
           Value=PopValue-Value
       ElseIf Match("!")
       Then
           Push(Value)
           Gosub Product
           If Not Found Then SyntaxError
           Value=PopValue!Value
       Else Found=True\Return
   End

Product: ! Match to PRODUCT = TERM $( MULTIPLYOP TERM);
   Gosub Term
   If Not Found Then SyntaxError
   Repeat
       If Match("*")
       Then
           Push(Value)
           Gosub Product
           If Not Found Then SyntaxError
           Value=PopValue*Value
       ElseIf Match("/")
       Then
           Push(Value)
           Gosub Product
           If Not Found Then SyntaxError
           Value=PopValue/Value
       ElseIf Match("&")
       Then
           Push(Value)
           Gosub Product
           If Not Found Then SyntaxError
           Value=PopValue&Value
       Else Found=True\Return
   End

Term: ! Match to TERM = PRIMARY $( "^" PRIMARY);
   Gosub Primary
   If Not Found Then SyntaxError
   Repeat
       If Match("^")
       Then
           Push(Value)
           Gosub Product
           If Not Found Then SyntaxError
           Value=PopValue^Value
       Else Found=True\Return
   End

Primary: ! Match to PRIMARY = HEXCONSTANT / DECIMALFPCONSTANT /
!           .ID / "(" EXPRESSION ")" / "-" PRIMARY /
!           .UNARYFNNAME PRIMARY ;
   If Match("-")
   Then
       Gosub Primary
       If Not Found Then SyntaxError
       Let Value=-Value
       Return
   Fi
   Gosub Identifier
   If Found
   Then
       Value=Variable[VariableNumber]
       Return
   Fi
   Gosub Number
   If Found Then Return
   Gosub HexNumber
   If Found Then Return
   If Match("(")
   Then
       Gosub Expression
       If Not Found Then SyntaxError
       If Not Match(")") Then SyntaxError
       Found=True\Return
   Fi
   If MatchFunction("COM")
   Then
       Gosub Primary
       If Not Found Then SyntaxError
       Value=COM(Value)
       Return
   ElseIf MatchFunction("SQR")
   Then
       Gosub Primary
       If Not Found Then SyntaxError
       Value=SQR(Value)
       Return
   ElseIf MatchFunction("INT")
   Then
       Gosub Primary
       If Not Found Then SyntaxError
       Value=INT(Value)
       Return
   ElseIf MatchFunction("SIN")
   Then
       Gosub Primary
       If Not Found Then SyntaxError
       Value=SIN(Value)
       Return
   ElseIf MatchFunction("COS")
   Then
       Gosub Primary
       If Not Found Then SyntaxError
       Value=COS(Value)
       Return
   ElseIf MatchFunction("ATN")
   Then
       Gosub Primary
       If Not Found Then SyntaxError
       Value=ATN(Value)
       Return
   ElseIf MatchFunction("TAN")
   Then
       Gosub Primary
       If Not Found Then SyntaxError
       Value=TAN(Value)
       Return
   ElseIf MatchFunction("LOG")
   Then
       Gosub Primary
       If Not Found Then SyntaxError
       Value=LOG(Value)
       Return
   ElseIf MatchFunction("LN2")
   Then
       Gosub Primary
       If Not Found Then SyntaxError
       Value=LOG(Value)/LOG(2)
       Return
   ElseIf MatchFunction("EXP")
   Then
       Gosub Primary
       If Not Found Then SyntaxError
       Value=EXP(Value)
       Return
   Else Found=False\Return

Identifier: ! Match to .ID (a single letter), set VariableNumber
   Found=False \ ! Assume the worst
   VariableNumber=Find(Alphabet$,Line$[ScanPointer,1])
   If VariableNumber=0 Then Return
   If Not Find(Alphabet$,Line$[ScanPointer+1,1])
   Then
       ScanPointer=ScanPointer+1
       Found=True
   Fi
   Return

Number: ! Match to .NUM (floating point number)
   Found=False \ ! Assume the worst
   Value=0 \ ! Resulting value of number
   DigitsToRightOfDecimalPoint=0 \ ! Number of digits seen to right of D.P.
   Digit=Find(Digits$,Line$[ScanPointer,1])
   If Digit=0
   Then
       If Line$[ScanPointer,1]="."
       Then Found=True\Goto CollectFractionDigitsLoop
       Else Return \ ! Definitely not a number
   Fi
   Found=True
   Repeat
       Value=Value*10+Digit-1
       ScanPointer=ScanPointer+1
       Digit=Find(Digits$,Line$[ScanPointer,1])
   When Digit<>0 End
   If Line$[ScanPointer,1]<>"." Then TryPowerOfTen
CollectFractionDigitsLoop:...
&  Repeat
       ScanPointer=ScanPointer+1
       Digit=Find(Digits$,Line$[ScanPointer,1])
       If Digit=0 Then Exit CollectFractionDigitsLoop
       Value=Value*10+Digit-1
       DigitsToRightOfDecimalPoint=DigitsToRightOfDecimalPoint+1
   End
   Value=Value/10^DigitsToRightOfDecimalPoint
TryPowerOfTen: ! See if Exponential notation is used
   If Line$[ScanPointer,1]<>"E" Then Return
   ScanPointer=ScanPointer+1
   If Line$[ScanPointer,1]="+"
   Then ExponentSign=1 \ ScanPointer=ScanPointer+1
   ElseIf Line$[ScanPointer,1]="-"
   Then ExponentSign=-1 \ ScanPointer=ScanPointer+1
   Else ExponentSign=1
   Exponent=0
   Digit=Find(Digits$,Line$[ScanPointer,1])
   If Digit=0 Then Error 7 \ ! Conversion error
   Repeat
       Exponent=Exponent*10+Digit-1
       ScanPointer=ScanPointer+1
       Digit=Find(Digits$,Line$[ScanPointer,1])
   When Digit<>0 End
   Let Value=Value*10^(ExponentSign*Exponent)
   Return

HexNumber: ! Match to .HEX (8 digit hex number starting with :)
   Found=False \ ! Assume the worst
   Value=0 \ ! Resulting value of number
   DigitsToRightOfDecimalPoint=0 \ ! Number of digits to right of "hex" point
   If Line$[ScanPointer,1]<>":" Then Return
   ScanPointer=ScanPointer+1
   Digit=Find(Hexdigits$,Line$[ScanPointer,1])
   If Digit=0
   Then
       If Line$[ScanPointer,1]="."
       Then Found=True\Goto CollectHexFractionDigitsLoop
       Else Return \ ! Definitely not a number
   Fi
   Found=True
   Repeat
       Value=Value*16+Digit-1
       ScanPointer=ScanPointer+1
       Digit=Find(Hexdigits$,Line$[ScanPointer,1])
   When Digit<>0 End
   If Line$[ScanPointer,1]<>"." Then Return
CollectHexFractionDigitsLoop:...
&  Repeat
       ScanPointer=ScanPointer+1
       Digit=Find(Hexdigits$,Line$[ScanPointer,1])
       If Digit=0 Then Exit CollectHexFractionDigitsLoop
       Value=Value*16+Digit-1
       DigitsToRightOfDecimalPoint=DigitsToRightOfDecimalPoint+1
   End
   Value=Value/16^DigitsToRightOfDecimalPoint
   Return

RequireEndLine: ! Make sure SCANPOINTER is at end of line
   If ScanPointer<Len(Line$) Then SyntaxError Else Return

SyntaxError: Error 102

End

!^L
!******* BEGIN MAIN PROGRAM *********
   For i=0 to len(Variable) do Variable[i]=0 \ ! Zap all the values
   If Col(0)>0
   Then
       ! Single line computation, don't print program name
       Input "" Line$
       ExecuteLine
       Exit
   Else
       ! Multi-line computation, print program id
       Print Version$
       Repeat
           Input ">> " Line$
           If Error When
               ExecuteLine
           Then
               Print "Error ";Err
           Fi
       End
   Fi
END
