;*************************************************************
;   VAL - Jim Butterfield        December 12, 1988           ;
; Expression evaluator.              Run from CLI only.      ;
;*************************************************************

;         Exec calls
_LVOOpenLibrary   EQU -$0228
_LVOCloseLibrary  EQU -$019e
;         DOS calls
_LVOOutput        EQU -$003c
_LVOWrite         EQU -$0030

 MOVE.L A0,A5               ; Pointer to text
 LINK   A4,#-100            ; Gimme 100 bytes (Purity!)

 MOVE.L 4,A6                ; ExecBase
 LEA    DosName(pc),A1      ; Where's DOS?
 MOVEQ  #0,D0
 JSR    _LVOOpenLibrary(A6)
 MOVE.L D0,A6               ; DosBase
 BEQ    No_DOS

;Get Output Handle:
 JSR    _LVOOutput(A6)
 MOVE.L D0,-$10(A4)         ;OutHandle
 BEQ    EXIT

 LEA -$18(A4),A3            ;numeric stack pointer
 LEA -$40(A4),A2            ;operator stack pointer

;Scan Command Tail:
 MOVEQ  #0,D0               ;char buffer
 MOVEQ  #0,D1               ;numeric analyzer
 MOVEQ  #0,D2               ;modulo of input number
 MOVEQ  #0,D3               ;value of input number
 MOVE.L D3,-4(A4)           ;sign
 MOVE.L D3,-8(A4)           ;no parens
 MOVE.L A5,-$C(A4)          ;start-of-text pointer
 MOVE.L D3,-$14(A4)         ;overflow flag
 MOVE.W D3,-(A2)            ;end flag, operator stack


ScanLoop:
 MOVE.B (A5)+,D0            ;get character
 CMP.B  #$3F,D0             ; '?' anywhere - send prompt
 BEQ    Prompt
 MOVE.B D0,D1               ;number slot
 CMP.B  #$60,D0
 BCS.S  SmallByte
 SUB.B  #$20,D1             ;change lower to upper case
SmallByte:
 CMP.B  #$40,D1
 BCS.S  SmallerByte
 SUB.B  #$37,D1             ;change alpha to hex value
SmallerByte:
 CMP.B  #$3A,D0
 BCC.S  BigByte
 SUB.B  #$30,D1             ;change num to value
BigByte:
 CMP.B  #$10,D1             ;is it numeric/hex digit?
 BCC.S  NotNum              ;  ... no, skip ahead
; We have found a digit!  Is it the first?
 TST.B  D2                  ;Check if number in progress
 BNE.S  ModuloSet           ; yes, continue
 MOVEQ  #$A,D2              ; Set Decimal flag
ModuloSet:
 CMP.B  D1,D2               ; Digit within range (Dec/Hex?)
 BCS    Over1               ; .. nope, holler
 CMP.W  #$A,D2
 BEQ.s  Decimal             ; If decimal, skip ahead
 ASL.L  #3,D3               ;hex, times 8
 BVS.S  Over1
 ASL.L  #1,D3               ;hex, times 16
 BRA.S  AddDigit
Decimal:
 ASL.L  #1,D3               ; Former value times 2
 BCS.S  Over1
 BMI.S  Over1
 MOVE.L D3,D7               ; Save times2
 ASL.L  #2,D3               ; Times 4, to make times8
 BCS.S  Over1
 ADD.L  D7,D3               ; times2+times8 gives times10
 BCS.S  Over1
AddDigit:
 ADD.L  D1,D3               ; add in new digit
 BCC.S  ScanLoop            ; On to next character
Over1:
 BRA.S  Oops
; If we reach the following code, we have discovered
;   a non-numeric character
NotNum:
 TST.B  D2                  ;number in progress?
 BNE.S  SkipTrix            ;.. no, skip next tests
 CMP.B  #45,D0              ;unary minus?
 BNE.S  NotUM
 MOVEQ  #-1,D7
 MOVE.L D7,-4(A4)           ;set negative flag
ScanLink:
 BRA.S  ScanLoop
NotUM:
 CMP.B  #40,D0              ;left parens?
 BNE.S  NotLP               ; .. no, keep looking
 ADD.B  #$10,-8(A4)         ;yes, change hierarchy
 BRA.S  ScanLoop
NotLP:
 CMP.B  #36,D0              ;dollars hex?
 BNE.S  Oops                ; .. no, give up
HexIt:
 MOVEQ  #$10,D2             ; .. yes, change to hex
 BRA.S  ScanLink
; Any '?' makes us print prompt message
Prompt:
 LEA    Format(pc),A0
 MOVE.L A0,D2               ; Format message pointer
 MOVEQ  #FormLen,D3
 BRA.S  SayIt
; Parentheses not closed
ParenWarn:
 LEA    ParMsg(pc),A0
 MOVE.L A0,D2               ; Bad parens message pointer
 MOVEQ  #ParLen,D3
 BRA.S  SayIt
; Overflow during calculation
OverWarn:
 LEA    OvMsg(pc),A0
 MOVE.L A0,D2               ; Overflow message pointer
 MOVEQ  #OvLen,D3
 BRA.S  SayIt
; Problems.  Print input string up to glitch.
Oops:
 MOVE.B #$3F,(A5)+          ; Add '?',..
 MOVE.B #$0A,(A5)+          ; ..NewLine
 MOVE.L A5,D3               ; Current point
 MOVE.L -$C(A4),D2          ; Start of input
 SUB.L  D2,D3               ; Calc length
SayIt:
 MOVE.L -$10(A4),D1         ; OutHandle
 JSR    _LVOWrite(A6)
 BRA    EXIT
; Here, we have number in progress and
; .. non-numeric character
SkipTrix:
 CMP.B  #$21,D1             ; x?
 BNE.S  NotX
 TST.L  D3                  ; Hex if 0x...
 BEQ.S  HexIt
NotX:
 CMP.B  #41,D0              ;close parens?
 BNE.S  NotRP
 SUB.B  #$10,-8(a4)         ;drop hierarchy
 BPL.S  ScanLink
OopsLink:
 BRA.S  Oops                ; too far?
; Wrap up number, put on numeric stack
NotRP:
 TST.B  -4(A4)              ; negative?
 BEQ.S  Positv              ; no, skip
 MOVE.L D3,D7
 MOVEQ  #0,D3
 SUB.L  D7,D3
Positv:
; put D3 to Numeric stack
 MOVE.L D3,-(A3)
 MOVEQ  #0,D2               ; clear modulo
 MOVEQ  #0,D3               ; clear value
 MOVE.L D2,-4(A4)           ; reset sign flag
; Look at Operator
 LEA    Operators(pc),A0
 MOVEQ  #0,D6               ; Operator index
 MOVEQ  #1,D7               ; lowest level
 CMP.B  #$20,D0             ; end of input string?
 BCS.S  PutOper             ; .. yes, log it
 CMP.B  #$5C,D0             ; Backslash symbol?
 BNE.S  OpLoop
 MOVE.B #$25,D0
OpLoop:
 CMP.B  0(A0,D6.W),D0
 BEQ.S  OpFound
 ADDQ.B #4,D6
 CMP.B  #EndOps-Operators,D6
 BNE.S  OpLoop
 BRA.S  OopsLink
OpFound:
 MOVE.B 1(A0,D6.W),D7
 ADD.B  -8(A4),D7
; Put the symbol on the stack.  But first,
; higher/equal level symbols must be squeezed out.
PutOper:
 CMP.B  (A2),D7             ; Check level
 BHI.S  LeaveOper
 ; Squeeze out previous operator
 MOVEM.L D0/D1/D2/D6/D7,-(A7)
 MOVE.B  (A2)+,D7           ; ignore level indicator
 MOVE.B  (A2)+,D0           ; get op index
 MOVE.L  (A3)+,D6           ;last numeric from stack
 MOVE.L  (A3)+,D7           ; .. and previous
; go for the address, off D0
 LEA     Subhead(pc),A1
 MOVE.W  2(A0,D0.W),D1      ; here's the address
 JSR     0(A1,D1.W)         ; go for it

; Operation done.  Stack result, retest operator.
PutBack:
 MOVE.L  D7,-(A3)          ;result to numeric stack
 MOVEM.L (A7)+,D0/D1/D2/D6/D7
 BRA.S   PutOper
; Everything is pulled off the stack that needs it.
; Put new operator on stack, and its level.
LeaveOper:
 MOVE.B D6,-(A2)           ; Op pointer
 MOVE.B D7,-(A2)           ; Op level
MoreLoop:
 CMP.B  #$20,D0            ; End of input (NewLine)?
 BCC   ScanLoop
Finish:
; -8(A4) Check to see all parens closed
 MOVE.L -8(A4),D7          ; hierarchy
 BNE    ParenWarn
; -$14(A4) Check if overflow
 TST.B  -$14(A4)
 BNE    OverWarn
; Print value on numeric stack
 MOVE.L (A3)+,D7           ; stack value
 MOVE.B #$20,D2            ; space if positive
 MOVE.L D7,D6
 BPL.S  PositR
 MOVEQ  #0,D6
 SUB.L  D7,D6
 MOVE.B #$2D,D2            ; minus if negative
PositR:
 LEA    -$18(A4),A3
 MOVE.L A3,-4(A4)          ; Mark this spot.
 MOVEQ  #$20,D0            ; SPACE character..
 MOVE.B D0,-(A3)           ; two at end
 MOVE.B D0,-(A3)
DecLoop:
 MOVEQ  #0,D0              ;remainder
 MOVEQ  #0,D1              ;shift count
DivLoop:
 ASL.L  #1,D6
 ROXL.B #1,D0
 CMP.B  #10,D0
 BCS.s  DivCont
 SUBI.B  #10,D0
 BSET   #0,D6
DivCont:
 ADDQ.W #1,D1
 CMP.B  #32,D1
 BCS.s  DivLoop            ; 32 times
 ORI.B  #$30,d0            ; here's the character
 MOVE.B D0,-(A3)           ; stack it
; Check if anything left
 TST.L  D6                 ; more characters?
 BNE.s  DecLoop            ; .. yes, go get em
 MOVE.B D2,-(A3)
; Number is stacked in A3 - print!
 MOVE.L -4(A4),D3          ; end of string
 SUB.L  A3,D3              ; buff len
 MOVE.L A3,D2              ; buff add
 MOVE.L -$10(A4),D1        ; file handle
 JSR _LVOWrite(A6)

; Now for hex...
 MOVE.L -4(A4),A3          ; Restore A3
 MOVEQ  #$0A,D6            ; RETURN at end
 MOVE.B D6,-(A3)
HexDig:
 MOVE.B D7,D6
 LSR.L  #4,D7              ; slide those bits
 AND.B  #$0F,D6            ; slice four
 ORI.B  #$30,D6            ; make it a number
 CMP.B  #$3A,D6
 BCS.S  NotAlf
 ADD.B  #7,D6              ; ... or a letter
NotAlf:
 MOVE.B D6,-(A3)           ; stack it!
 TST.L  D7                 ; any more?
 BNE.s  HexDig             ; .. yes, get 'em
 MOVEQ  #$24,D6            ; gimme a dollar (sign)
 MOVE.B D6,-(A3)           ; stack the buck
; Hex number in A3 - print!
 MOVE.L -4(A4),D3          ; end of string
 SUB.L  A3,D3              ; buff len
 MOVE.L A3,D2              ; buff add
 MOVE.L -$10(A4),D1        ; file handle
 JSR _LVOWrite(A6)

EXIT:
; Close DOS library.

 MOVE.L A6,A1              ; DosBase
 MOVE.L 4,A6               ; ExecBase
 JSR   _LVOCloseLibrary(A6)
No_Dos:
 UNLK A4                   ; Back to Stack
 RTS
SubHead:
OrSub:
 OR.L    D6,D7
 RTS
AndSub:
 AND.L   D6,D7
 RTS
AddSub:
 ADD.L   D6,D7
 RTS
SubSub:
 SUB.L   D6,D7
 RTS
PowSub:
 MOVE.L  D6,D1              ; power
 MOVE.L  D7,D6              ; base
 MOVEQ   #1,D7              ; start value
PowLoop:
 TST.B   D1                 ; power?
 BEQ.S   PowExit            ; zero, done.
 SUB.B   #1,D1              ; one less...
 MOVE.L  D6,-(A7)
 MOVE.L  D1,-(A7)
 BSR.S   MultSub
 MOVE.L  (A7)+,D1
 MOVE.L  (A7)+,D6
 BRA.S   PowLoop
PowExit:
 RTS
; Multiply subroutine:  32 bits x 32 bits signed
; D7 times D6; uses regs D1 and D2
; Result in D7
MultSub:
 MOVEQ   #0,D1              ; sign flag
 TST.L   D7                 ; is Arg1 Positive?
 BPL.S   Arg1Pos
 MOVEQ   #0,D2
 SUB.L   D7,D2
 MOVE.L  D2,D7
 MOVEQ   #1,D1
Arg1Pos:
 TST.L   D6
 BPL.S   Arg2Pos            ; is Arg2 Positive?
 MOVEQ   #0,D2
 SUB.L   D6,D2
 MOVE.L  D2,D6
 EORI.B  #1,D1
Arg2Pos:
 MOVE.L  D7,D2              ; biggest val to D2
 CMP.L   D6,D7
 BCC.S   MultMain
 MOVE.L  D6,D2
 MOVE.L  D7,D6              ; smallest to D6
MultMain:
 MOVEQ   #0,D7              ; product area
MultLoop:
 LSR.L   #1,D6              ; multiplier to right!
 BCC.S   NomAdd
 ADD.L   D2,D7
 BCS.S   Moverf
NomAdd:
 TST.L   D6
 BEQ.S   MultDone
 LSL.L   #1,D2              ; multiplicand to left!
 BCC.S   MultLoop
Moverf:
 MOVE.B  #1,-$14(A4)        ; overflow
; How 'bout that sign?
MultDone:
 TST.L   D1                 ; product sign flag
 BEQ.S   MultExit
 MOVEQ   #0,D2
 SUB.L   D7,D2
 MOVE.L  D2,D7
MultExit:
 RTS

DivOver:
 MOVE.B  #1,-$14(A4)
 RTS
ModSub:
 MOVEQ   #0,D0      ;flags modulo
 MOVE.L  D7,D1
 BRA.S   DivJob
DivSub:
 MOVE.L  D7,D1
 EOR.L   D6,D1
DivJob:
 TST.L   D6
 BEQ.S   DivOver
 BPL.S   Darg1Pos
 MOVEQ   #0,D2
 SUB.L   D6,D2
 MOVE.L  D2,D6
Darg1Pos:
 TST.L   D7
 BPL.S   Darg2Pos
 MOVEQ   #0,D2
 SUB.L   D7,D2
 MOVE.L  D2,D7
Darg2Pos:
 MOVE.L  D1,-(A7)           ; Stack the sign
 MOVEQ   #0,D2              ; Remainder
 MOVEQ   #0,D1              ; Counter
DivdLoop:
 ASL.L  #1,D7
 ROXL.L #1,D2
 CMP.L  D6,D2
 BCS.S  DivdCont
 SUB.L  D6,D2
 BSET   #0,D7
DivdCont:
 ADDQ.W #1,D1
 CMP.B  #32,D1
 BCS.S  DivdLoop           ; 32 times
 MOVE.L (A7)+,D1           ; restore sign flag
 TST.B   D0
 BNE.S   NotModul
 MOVE.L  D2,D7             ; slip remainder in
NotModul:
 TST.L   D1
 BPL.S   ModEnd
 MOVEQ   #0,D2
 SUB.L   D7,D2
 MOVE.L  D2,D7
ModEnd:
 RTS

;                   |   &  +  -  *   %  /  ^
Operators: DC.B   $7C,2
           DC.W   OrSub-SubHead
           DC.B   $26,3
           DC.W   AndSub-SubHead
           DC.B   43,4
           DC.W   AddSub-SubHead
           DC.B   45,4
           DC.W   SubSub-SubHead
           DC.B   42,5
           DC.W   MultSub-SubHead
           DC.B   $25,5
           DC.W   ModSub-SubHead
           DC.B   47,5
           DC.W   DivSub-SubHead
           DC.B   94,6
           DC.W   PowSub-SubHead
EndOps:
DosName:   DC.B 'dos.library',0
Format:    DC.B 'Format:  Val <expression>, e.g., 2+3*4',$a
EndFormat: DC.B $20,$2A,$20,$4A,$69,$6D,$20,$42,$75,$74
FormLen = EndFormat-Format
          DC.B  $74,$65,$72,$66,$69,$65,$6C,$64,$20
          DC.B  $44,$65,$63,$2F,$38,$38,$20,$2A,$20

OvMsg:    DC.B 'Overflow',$a
EndOv:
OvLen  = EndOv-OvMsg
ParMsg:   DC.B 'Too many "("',$a
EndPar:
ParLen = EndPar-ParMsg

 END