
*VTL-2
*V-3.6
*9-23-76
*BY GARY SHANNON
*& FRANK MCCOY
*
*COPYRIGHT 1976, THE COMPUTER STORE
*

*DISASSEMBLY BY:
*
*    SCOTT LaBOMBARD
*    labomb@rochester.rr.com
*    3/20/2007
*


*DEFINE LOCATIONS IN ALTAIR 680B MONITOR

INCH    EQU $FF00   CHAR INPUT
POLCAT  EQU $FF24   CONSOLE BREAK CHECK
OUTCH   EQU $FF81   CHAR OUTPUT
OUTS    EQU $FF82   PRINT SPACE

*GENERAL EQUATES

CR  EQU $0D      CARRIAGE RETURN
LF  EQU $0A      LINE-FEED
BS  EQU $5F      BACKSPACE CHAR
CAN EQU $40      CANCEL CHAR

*
*SET ASIDE FOUR BYTES FOR USER
*DEFINED INTERUPT ROUTINE IF NEEDED

    ORG 0

ZERO    RMB 4        INTERUPT VECTOR
AT      RMB 2        CANCEL & C-R

*GENERAL PURPOSE STORAGE
VARS    RMB 52       VARIABLES (A-Z)
BRAK    RMB 2        [
SAVE10  RMB 2        BACK SLASH
BRIK    RMB 2        ]
UP      RMB 2        UP ARROW
SAVE11  RMB 2

SAVE14  RMB 2        SPACE
EXCL    RMB 2        !
QUOTE   RMB 2        "
DOLR    RMB 2        #
DOLLAR  RMB 2        $
REMN    RMB 2        %
AMPR    RMB 2        &
QUITE   RMB 2        "
PAREN   RMB 2        (
PARIN   RMB 2        )
STAR    RMB 2        *
PLUS    RMB 2        +
COMMA   RMB 2        ,
MINS    RMB 2        -
PERD    RMB 2        .
SLASH   RMB 2        /

SAVE0   RMB 2
SAVE1   RMB 2
SAVE2   RMB 2
SAVE3   RMB 2
SAVE4   RMB 2
SAVE5   RMB 2
SAVE6   RMB 2
SAVE7   RMB 2
SAVE8   RMB 2
SAVE9   RMB 2
COLN    RMB 2        :
SEMI    RMB 2        ;
LESS    RMB 2        <
EQAL    RMB 2        =
GRAT    RMB 2        >

DECBUF  RMB 4
LASTD   RMB 1
DELIM   RMB 1
LINBUF  RMB 73       LINE LENGTH +1

    ORG $00F1

STACK   RMB 0        SPACE FOR MONITOR STORAGE

    ORG $0100

MI      RMB 4        INTERUPT VECTORS
NMI     RMB 4
PRGM    RMB 0        PROGRAM STARTS HERE

    ORG  $FC00

START LDS #STACK
    CLRA
    LDX #OKM
    BSR STRGT
LOOP CLRA
    STAA DOLR
    STAA DOLR+1
    JSR CVTLN
    BCC STMNT    NO LINE# THEN EXEC.
    BSR EXEC
    BEQ START
LOOP2 BSR FIND   FIND LINE
EQSTRT BEQ START IF END THEN STOP
    LDX $00,X    LOAD REAL LINE#
    STX DOLR     SAVE IT
    LDX SAVE11   GET LINE
    INX          BUMP PAST LINE #
    INX          "    "    "   "
    INX          BUMP PAST SPACE
    BSR EXEC     EXECUTE IT
    BEQ LOOP3    IF ZERO, CONTINUE
    LDX SAVE11   FIND LINE#
    LDX $00,X    GET IT
    CPX DOLR     HAS IT CHANGED?
    BEQ LOOP3    IF NOT GET NEXT
    INX          INCREMENT OLD LINE#
    STX EXCL     SAVE FOR RETURN
    BRA LOOP2    CONTINUE

LOOP3 BSR FND3   FIND NEXT LINE
    BRA EQSTRT   CONTINUE

EXEC STX SAVE7   EXECUTE LINE
    JSR VAR2
    INX
SKIP LDAA $00,X  GET FIRST TERM
    BSR EVIL     EVALUATE EXPRESSION
OUTX LDX DOLR    GET LINE
    RTS

EVIL CMPA #'"    IF " THEN BRANCH
    BNE EVALU
    INX
STRGT JMP STRNG  TO PRINT IT

STMNT STX SAVE8  SAVE LINE#
    STAA DOLR
    STAB DOLR+1
    LDX DOLR
    BNE SKP2     IF LINE# <> 0
    LDX #PRGM    LIST PROGRAM
LST2 CPX AMPR    END OF PROGRAM
    BEQ EQSTRT
    STX SAVE11   LINE# FOR CVDEC
    LDAA $00,X
    LDAB $01,X
    JSR PRNT2
    LDX SAVE11
    INX
    INX
    JSR PNTMSG
    JSR CRLF
    BRA LST2

NXTXT LDX SAVE11 GET POINTER
    INX          BUMP PAST LINE#
LOOKAG INX       FIND END OF LINE
    TST $00,X
    BNE LOOKAG
    INX
    RTS

FIND LDX #PRGM   FIND LINE#
FND2 STX SAVE11
    CPX AMPR
    BEQ RTS1
    LDAA $01,X
    SUBA DOLR+1
    LDAA $00,X
    SBCA DOLR
    BCC SET
FND3 BSR NXTXT
    BRA FND2

SET LDAA #$FF    SET NOT EQUAL
RTS1 RTS

EVALU JSR EVAL   EVALUATE LINE
    PSHB
    PSHA
    LDX SAVE7
    JSR CONVP
    PULA
    CMPB #'$     STRING?
    BNE AR1
    PULB
    JMP OUTCH    THEN PRINT IT

AR1 SUBB #'?     PRINT?
    BEQ PRNT     THEH DO IT
    INCB         MACHINE LANGUAGE?
    PULB
    BNE AR2
    SWI          THEN INTERUPT
AR2 STAA $00,X   STORE NEW VALUE
    STAB $01,X
    ADDB QUITE   RANDOMIZER
    ADCA QUITE+1
    STAA QUITE
    STAB QUITE+1
    RTS

SKP2 BSR FIND    FIND LINE
    BEQ INSRT    IF NOT THERE
    LDX $00,X    THEN INSERT
    CPX DOLR     NEW LINE
    BNE INSRT
    BSR NXTXT    SETUP REGISTERS
    LDS SAVE11   FOR DELETE
DELT CPX AMPR    DELETE OLD LINE
    BEQ FITIT
    LDAA $00,X
    PSHA
    INX
    INS
    INS
    BRA DELT

FITIT STS AMPR   STORE NEW END
INSRT LDX SAVE8  COUNT NEW LINE LENGTH
    LDAB #3
    TST $00,X
    BEQ GOTIT    IF NO LINE THEN STOP
CNTLN INCB
    INX
    TST $00,X
    BNE CNTLN
OPEN CLRA        CALCULATE NEW END
    ADDB AMPR+1
    ADCA AMPR
    STAA SAVE10
    STAB SAVE10+1
    SUBB STAR+1
    SBCA STAR
    BCC RSTRT    IF TOO BIG THEN STOP
    LDX AMPR
    LDS SAVE10
    STS AMPR
    INX          SLIDE OPEN GAP
SLIDE DEX
    LDAB $00,X
    PSHB
    CPX SAVE11
    BNE SLIDE
DON LDS DOLR     STORE LINE#
    STS $00,X
    LDS SAVE8    GET NEW LINE
    DES
MOVL INX         INSERT NEW LINE
    PULB
    STAB $01,X
    BNE MOVL
GOTIT LDS #STACK
    JMP LOOP

RSTRT JMP START

PRNT PULB        PRINT DECIMAL
PRNT2 LDX #DECBUF  CONVERT TO DECIMAL
    STX SAVE4
    LDX #PWRS10
CVD1 STX SAVE5
    LDX $00,X
    STX SAVE6
    LDX #SAVE6
    JSR DIVIDE
    PSHA
    LDX SAVE4
    LDAA SAVE2+1
    ADDA #'0
    STAA $00,X
    INX
    STX SAVE4
    LDX SAVE5
    PULA
    INX
    INX
    TST $01,X
    BNE CVD1
    LDX #DECBUF-1
    COM $05,X    ZERO SUPPRESS
ZRSUP INX
    LDAB $00,X
    CMPB #'0
    BEQ ZRSUP
    COM LASTD
PNTMSG CLRA        ZERO FOR DELIM
STRTMS STAA DELIM  STORE DELIMITER
OUTMSG LDAB $00,X  GENERAL PURPOSE PRINT
    INX
    CMPB DELIM
    BEQ CTLC
    JSR OUTCH
    BRA OUTMSG

CTLC JSR POLCAT  POL FOR CHARACTER
    BCC RTS2
    BSR INCH2
    CMPB #3      CONTROL -C?
    BEQ RSTRT
INCH2 JMP INCH

STRNG BSR STRTMS PRINT STRING LITERAL
    LDAA $00,X
    CMPA #$3B
    BEQ OUTD
CRLF2 JMP CRLF

EVAL BSR GETVAL  EVALUATE EXPRESSION
NXTRM PSHA
    LDAA $00,X   END OF LINE?
    BEQ OUTN
    CMPA #')
OUTN PULA
    BEQ OUTD
    BSR TERM
    LDX SAVE0
    BRA NXTRM

TERM PSHA        GET VALUE
    PSHB
    LDAA $00,X
    PSHA
    INX
    BSR GETVAL
    STAA SAVE3
    STAB SAVE3+1
    STX SAVE0
    LDX #SAVE3
    PULA
    PULB
    CMPA #'*     SEE IF *
    BNE EVAL2
    PULA         MULTIPLY
MULTIP STAA SAVE2
    STAB SAVE2+1  2'S COMPLIMENT
    LDAB #16
    STAB SAVE1
    CLRA
    CLRB
MULT LSR SAVE2
    ROR SAVE2+1
    BCC NOAD
MULTI BSR ADD
NOAD ASL $01,X
    ROL $00,X
    DEC SAVE1
    BNE MULT     LOOP TIL DONE
RTS2 RTS

GETVAL JSR CVBIN  GET VALUE
    BCC OUTV
    CMPB #'?     OF LITERAL
    BNE VAR
    STX SAVE9    OR INPUT
    JSR INLN
    BSR EVAL
    LDX SAVE9
OUTD INX
OUTV RTS

VAR CMPB #'$     OR STRING
    BNE VAR1
    BSR INCH2
    CLRA
    INX
    RTS

VAR1 CMPB #'(
    BNE VAR2
    INX
    BRA EVAL

VAR2 BSR CONVP   OR VARIABLE
    LDAA $00,X   OR ARRAY ELEMENT
    LDAB $01,X
    LDX SAVE6    LOAD OLD INDEX
    RTS

ARRAY BSR EVAL   LOCATE ARRAY ELEMENT
    ASLB
    ROLA
    ADDB AMPR+1
    ADCA AMPR
    BRA PACK

CONVP LDAB $00,X  GET LOCATION
    INX
    PSHB
    CMPB #':
    BEQ ARRAY    OF VARIABLE OR
    CLRA         ARRAY ELEMENT
    ANDB #$3F
    ADDB #2
    ASLB
PACK STX SAVE6   STORE OLD INDEX
    STAA SAVE4
    STAB SAVE4+1
    LDX SAVE4    LOAD NEW INDEX
    PULB
    RTS

EVAL2 CMPA #'+   ADDITION
    BNE EVAL3
    PULA
ADD ADDB $01,X
    ADCA $00,X
    RTS

EVAL3 CMPA #'-   SUBTRACTION
    BNE EVAL4
    PULA
SUBTR SUBB $01,X
    SBCA $00,X
    RTS

EVAL4 CMPA #'/   SEE IF IT'S DIVIDE
    BNE EVAL5
    PULA
    BSR DIVIDE
    STAA REMN
    STAB REMN+1
    LDAA SAVE2
    LDAB SAVE2+1
    RTS

EVAL5 SUBA #'=   SEE IF EQUAL TEST
    BNE EVAL6
    PULA
    BSR SUBTR
    BNE NOTEQ
    TSTB
    BEQ EQL
NOTEQ LDAB #$FF
EQL BRA COMBOUT

EVAL6 DECA       SEE IF LESS THAN TEST
    PULA
    BEQ EVAL7
SUB2 BSR SUBTR
    ROLB
COMOUT CLRA
    ANDB #1
    RTS

EVAL7 BSR SUB2   GT TEST
COMBOUT COMB
    BRA COMOUT

PWRS10 FCB $27,$10   10000
    FCB $03,$E8      1000
    FCB 0,100        100
    FCB 0,10         10
    FCB 0,1          1

DIVIDE CLR SAVE1     DIVIDE 16 BITS
GOT INC SAVE1
    ASL $01,X
    ROL $00,X
    BCC GOT
    ROR $00,X
    ROR $01,X
    CLR SAVE2
    CLR SAVE2+1
DIV2 BSR SUBTR
    BCC OK
    BSR ADD
    CLC
    FCB $9C      SKIP 'SEC' -LEAVE CY CLEAR
OK  SEC
    ROL SAVE2+1
    ROL SAVE2
    DEC SAVE1
    BEQ DONE
    LSR $00,X
    ROR $01,X
    BRA DIV2

TSTN LDAB $00,X  TEST FOR NUMERIC
    CMPB #$3A
    BPL NOTDEC
    CMPB #'0
    BGE DONE
NOTDEC SEC
    RTS

DONE CLC
DUN RTS

CVTLN BSR INLN

CVBIN BSR TSTN   CONVERT TO BINARY
    BCS DUN
CONT CLRA
    CLRB
CBLOOP ADDB $00,X
    ADCA #0
    SUBB #'0
    SBCA #0
    STAA SAVE1
    STAB SAVE1+1
    INX
    PSHB
    BSR TSTN
    PULB
    BCS DONE
    ASLB
    ROLA
    ASLB
    ROLA
    ADDB SAVE1+1
    ADCA SAVE1
    ASLB
    ROLA
    BRA CBLOOP

INLN6 CMPB #CAN  CANCEL
    BEQ NEWLIN
    INX
    CPX #74      LINE LENGTH +2
    BNE INLN2
NEWLIN BSR CRLF

INLN LDX #$02    INPUT LINE FROM TERMINAL
INLN5 DEX
    BEQ NEWLIN

INLN2 JSR INCH   INPUT CHARACTER
    STAB $87,X   STORE IT
    CMPB #BS     BACKSPACE?
    BEQ INLN5
INLN3 CMPB #CR   CARRIAGE RETURN
    BMI INLN2
    BNE INLN6
INLN4 CLR $87,X  CLEAR LAST CHAR
    LDX #LINBUF
    BRA PLF

CRLF LDAB #CR    CARR-RET
    BSR OUTCH2
PLF LDAB #LF     LINE-FEED
OUTCH2 JMP OUTCH

OKM FCB CR,LF    "OK" MESSAGE
    FCC "OK"
    FCB 0

    END
