*
* CALC: Simple Programmers Desk Calculator
*
* ?COPY.TXT 1983-2005 Dave Dunfield
* **See COPY.TXT**.
*
    ORG OSUTIL
CALC    STS SAVSTK      SAVE STACK POINTER
    SSR 4       TEST FOR OPERAND
    BNE OPSUP       OPERAND WAS SUPPLIED
    DEC FLAG        SET INTERACTIVE FLAG
CALC1   SSR 24      OUTPUT PROMPT
    FCCZ    'Calc>'     STRING TO OUTPUT
    SSR 3       GET LINE OF INPUT
    SSR 4       TEST FOR OPERAND SUPPLIED
    BEQ CLEND       IF NOT, QUIT
    BSR OPSUP1      CALCULATE AND DISPLAY
    BRA CALC1       BACK FOR MORE
* AN OPERAND WAS SUPPLIED
OPSUP   CMPA    #'?'        HELP WANTED?
    BEQ HELP        IF SO, GIVE IT TO HIM
* EVALUATE EXPRESSIONS, AND DISPLAY RESULTS
OPSUP1  LBSR    EVAL        EVALUATE OPERANDS
    PSHS    A,B     SAVE RESULT
    SSR 26      OUTPUT RESULT IN DCIMAL
    SSR 24      OUTPUT MESSAGE
    FCCZ    ' $'        MESSAGE TO OUTPUT
    PULS    A,B     RESTORE VALUE
    SSR 27      OUTPUT IN HEX
    SSR 22      NEW LINE
    SSR 4       TEST MORE
    BNE OPSUP1      AND CONTINUE
CLEND   CLRA
    RTS
* DISPLAY HELP MESSAGE
HELP    SSR 25       DISPLAY MESSAGE
    FCCZ    'Use: CALC [expression ...]'
    CLRA
    RTS
*
* GET A VALUE FROM THE COMMAND LINE, RETURN IN 'D'
*
GETVAL  LDA ,Y+     GET PRECEDING SYMBOL?
* TEST FOR '=' SWAP HIGH AND LOW BYTES
    CMPA    #'='        IS IT A REVERSE CHARACTER?
    BNE GETV1       IF NO, NOTHING SPECIAL TO DO
    BSR GETVAL      EVALUATE NEXT VALUE ELEMENT
    EXG A,B     SWAP HIGH AND LOW
    BRA GETEN1      AND EXIT
* TEST FOR '-' NEGATE VALUE
GETV1   CMPA    #'-'        IS IT NEGATE?
    BNE GETV2       NO, ITS OK
    BSR GETVAL      EVALUATE NEXT
    CLRA
    CLRB
    SUBD    VAL1        CALCULATE NEGATE
    BRA GETEN1      AND EXIT
* TEST FOR '~' ONE'S COMPLEMENT
GETV2   CMPA    #'~'        COMPLEMENT?
    BNE GETHEX      NO, ITS OK
    BSR GETVAL      EVALUATE NEXT
    COMA            COMPLEMENT HIGH
    COMB            COMPLEMENT LOW
GETEN1  STD VAL1        SAVE RESULT
    RTS
* TEST FOR HEXIDECIMAL NUMBER
GETHEX  PSHS    X       SAVE 'X'
    LDX #0      START WITH ZERO
    CMPA    #'$'        IS IT A HEX NUMBER?
    BNE GETBIN      NOT A HEX NUMBER, TRY BINARY
GETH1   LBSR    TSTEXP      TEST FOR TERMINATOR
    BEQ GETEND      IF SO, LAST CHARACTER
    SUBA    #'0'        CONVERT TO BINARY
    CMPA    #10     0-9?
    BLO GETH2       IF SO, IT'S OK
    CMPA    #$11        < 'A'?
    BLT SYNERR      IF SO, IT'S BAD
    SUBA    #7      CONVERT TO HEX
    CMPA    #$10        IS IT 0-F?
    BHS SYNERR      IF SO, IT'S BAD
GETH2   STA TEMP        SAVE FOR TEMPORARY VALUE
    LDD #16     MULTIPLY BY 16 (SHIFT FOUR BITS)
    SSR 107     D=D*X
    ORB TEMP        INCLUDE EXTRA DIGIT
    TFR D,X     REPLACE IN 'X'
    BRA GETH1       DO NEXT
* TEST FOR BINARY NUMBER
GETBIN  CMPA    #'%'        IS IT BINARY?
    BNE GETOCT      NO, TRY OCTAL
GETB1   LBSR    TSTEXP      TEST FOR A TERMINATOR
    BEQ GETEND      IF END, CONTINUE WITH EXPRESSION
    SUBA    #'0'        CONVERT TO BINARY
    CMPA    #1      TEST FOR IN RANGE
    BHI SYNERR      IF INVALID, SAY SO
    PSHS    A       SAVE THIS VALUE
    TFR X,D     COPY TO ACCUMULATOR
    LEAX    D,X     SHIFT BY ONE BIT
    PULS    B       RESTORE VALUE
    ABX         INSERT THIS BIT
    BRA GETB1       CONTINUE LOOKING
* END OF EXPRESSION, EXIT
GETEND  TFR X,D     D = VALUE
    STD VAL1        SET VALUE
    PULS    X,PC        RESTORE & RETURN
* TEST FOR OCTAL NUMBER
GETOCT  CMPA    #'@'        IS IT OCTAL?
    BNE GETCHR      NO, TRY CHARACTER
GETO1   LBSR    TSTEXP      TEST FOR TERMINATOR
    BEQ GETEND      IF END, CONTINUE
    SUBA    #'0'        CONVERT TO BINARY
    CMPA    #7      IN RANGE?
    BHI SYNERR      INVALID
    STA TEMP        SAVE TEMP
    LDD #8      MUL BY 8
    SSR 107     DO MULTIPLY
    ORB TEMP        INCLUDE
    TFR D,X     COPY BACK
    BRA GETO1       CONTINUE
* INVALID HEX DIGIT
SYNERR  SSR 25      OUTPUT MESSAGE
    FCCZ    'Syntax Error.'
EVARET  LDS SAVSTK      GET STACK VALUE
    LDA FLAG        GET INTERACTIVE FLAG
    LBNE    CALC1       AND CONTINUE
    LDA #1      INDICATE INVALID OPERAND
    RTS
* TEST FOR QUOTED STRING
GETCHR  CMPA    #$27        IS IT A QUOTE?
    BNE GETDEC      NO, TRY DECIMAL NUMBER
GETC1   LDA ,Y+     GET CHAR
    BEQ SYNERR      END OF LINE
    CMPA    #$0D        END OF LINE MEANS SCREWUP
    BEQ SYNERR      INVALID STRING
    CMPA    #$27        CLOSING QUOTE
    BEQ GETEND      OF SO, THATS IT
    STA TEMP        SAVE CHAR
    TFR X,D     COPY TO ACCUMULATOR
    TFR B,A     SHIFT UP
    LDB TEMP        INCLUDE LOWER CHAR
    TFR D,X     REPLACE OLD VALUE
    BRA GETC1       GET NEXT CHARACTER
* TEST FOR DECIMAL NUMBER
GETDEC  CMPA    #'0'        IS IT < '0'?
    BLO SYNERR      NO, IT'S NOT DECIMAL
    CMPA    #'9'        IS IT > '9'
    BHI SYNERR      NO, NOT DECIMAL
    LEAY    -1,Y        BACKUP TO START OF LINE
GETD1   LBSR    TSTEXP      TEST FOR END OF DIGIT STRING
    BEQ GETEND      IF SO, QUIT
    SUBA    #'0'        CONVERT TO BINARY
    CMPA    #9      ARE WE DECIMAL?
    BHI SYNERR      IF NOT, GET UPSET
    STA TEMP        SAVE DIGIT
    LDD #10     MULTIPLY BY 10
    SSR 107     D=D*X
    ADDB    TEMP        ADD IN DIGIT
    ADCA    #0      INSURE HIGH INCS
    TFR D,X     SAVE IN X FOR NEXT ITERATION
    BRA GETD1       KEEP GOING
*
* EVALUATE ANY OPERANDS
*
EVAL    PSHS    X       SAVE 'X'
    LBSR    GETVAL      GET VALUE
EVAL1   TFR D,X     SAVE OLD VALUE
EVAL2   SSR 5       GET NEXT CHAR
    BNE TRYADD      TRY ADD
    TFR X,D     GET VALUE
EVEXIT  STD VAL1        SET VALUE
    PULS    X,PC        RESTORE & RETURN
* TEST FOR ADDITION
TRYADD  CMPA    #'+'        IS THIS ADDITION?
    BNE TRYSUB      NO, TRY SUBTRACTION
    LBSR    GETVAL      GET NEW OPERAND VALUE
    TFR X,D     COPY TO ACCUMULATOR
    ADDD    VAL1        ADD TO OLD VALUE
    BRA EVAL1       BACK TO CALLER
* TRY SUBTRACTION
TRYSUB  CMPA    #'-'        SUBTRACT?
    BNE TRYMUL      NO, TRY MULTIPLICATION
    LBSR    GETVAL      EVALUATE NEXT EXPRESSION
    TFR X,D     COPY TO ACCUMULATOR FOR ARITHMITIC
    SUBD    VAL1        SUBTRACT NEW VALUE
    BRA EVAL1       ALL DONE
* MULTIPLY OPERANDS
TRYMUL  CMPA    #'*'        IS IT A MULTIPLY?
    BNE TRYDIV      NO, TRY LOGICAL OR
    LBSR    GETVAL      EVALUATE SECOND OPERAND
    SSR 107     DO MULTIPLY
    BRA EVAL1       ALL DONE
* DIVIDE OPERATION
TRYDIV  CMPA    #'/'        DIVISION?
    BNE TRYMOD      NO, TRY MODULUS
    LBSR    GETVAL      GET OPERAND
    SSR 108     X=X/D
    BRA EVAL2       AND KEEP RESULT
* MODULUS OPERATION
TRYMOD  CMPA    #'\'        MODULUS?
    BNE TRYOR       NO, TRY OR
    LBSR    GETVAL      GET OPERAND
    SSR 108     X=X/D
    BRA EVAL1       RETURN REMAINDER
* LOGICAL OR OF OPERANDS
TRYOR   CMPA    #'|'        IS IT OR?
    BNE TRYAND      NO, TRY LOGICAL AND
    LBSR    GETVAL      CALCULATE OPERAND VALUE
    TFR X,D     GET OLD VALUE
    ORA VAL1        PERFORM OR
    ORB VAL1+1      ON BOTH BYTES
    BRA EVAL1       CONTINUE
* LOGICAL AND OF OPERANDS
TRYAND  CMPA    #'&'        IS IT AND?
    BNE TRYXOR      NO, TRY XOR
    LBSR    GETVAL      EVALUATE OPERANDS
    TFR X,D     GET OLD VALUE
    ANDA    VAL1        AND WITH OLD
    ANDB    VAL1+1      AND SECOND BYTE
    BRA EVAL1       CONTINUE
* EXCLUSIVE OR OPERATION
TRYXOR  CMPA    #'^'        IS IT XOR?
    LBNE    SYNERR      NO, ERROR
    LBSR    GETVAL      EVALUATE OPERANDS
    TFR X,D     GET OLD VALUE
    EORA    VAL1        XOR WITH OLD
    EORB    VAL1+1      XOR SECOND BYTE
    BRA EVAL1       CONTINUE
*
* TEST FOR VALID EXPRESSION ELEMENT TERMINATOR
*
TSTEXP  LDA ,Y      GET CHARACTER
    BEQ TSTEND      TERMINATOR
    CMPA    #'+'        PLUS SIGN
    BEQ TSTEND      OK
    CMPA    #'-'        MINUS SIGN
    BEQ TSTEND      IS ALSO OK
    CMPA    #'&'        LOCAIAL AND?
    BEQ TSTEND      IF SO, IT'S OK
    CMPA    #'|'        LOGICAL OR?
    BEQ TSTEND      IF SO, IT'S OK
    CMPA    #'^'        EXCLUSIVE OR?
    BEQ TSTEND      YES, ITS OK
    CMPA    #'*'        MULTIPLY?
    BEQ TSTEND      YES, ITS OK
    CMPA    #'/'        DIVIDE?
    BEQ TSTEND      YES, ITS OK
    CMPA    #'\'        MODULUS?
    BEQ TSTEND      YES, ITS OK
    CMPA    #' '        SPACE IS VALID
    BEQ TSTEND      IF SO, QUIT
    CMPA    #$0D        CARRIAGE RETURN IS LAST
    BEQ TSTEND      IF NOT, SAY SO
    LEAY    1,Y     DON'T SKIP END OF LINE
TSTEND  RTS
* TEMPORARY STORAGE
TEMP    FDB 0       TEMP STORAGE
VAL1    FDB 0       TEMP STORAGE
FLAG    FCB 0       INTERACTIVE FLAG
SAVSTK  RMB 2       SAVED STACK POINTER
