Source code that runs VTL-2 in Joe H. Allen's EXORsim, and should run it in the EXORciser. Can be assembled with my asm68c. Be sure, after you get it running, to set the & and * variables appropriately -- something like &=300 and *=8192.
- * VTL-2
- * V-3.6
- * 9-23-76
- * BY GARY SHANNON
- * & FRANK MCCOY
- * COPYWRIGHT 1976, THE COMPUTER STORE
- *
- * Modifications for exorsim by Joel Matthew Rees
- * Copyright 2022
- *
- * DEFINE LOCATIONS IN MONITOR
- * INCH EQU $FF00 ; per VTL.ASM
- EINCH EQU $F012 ; exorsim mdos Input byte with echo unless AECHO is set
- * INCH EQU $F015 ; exorsim mdos Input char with echo (F012 -> strip bit 7)
- * POLCAT EQU $FF24 ; from VTL.ASM
- * OUTCH EQU $FF81 ; from VTL.ASM
- EOUTCH EQU $F018 ; exorsim mdos Output character with NULs
- * OUTS EQU $FF82 ; from VTL.ASM
- EPCRLF EQU $F021 ; Primarily for forced initialization in exorsim.
- *
- * FOR SBC6800
- BREAK EQU $1B ; BREAK KEY
- * For exorsim
- ACIACS EQU $FCF4 ; exorcisor
- ACIADA EQU $FCF5 ; exorcisor
- *
- * SET ASIDE FOUR BYTES FOR USER
- * DEFINED INTERUPT ROUTINE IF NEEDED
- ORG $0000
- ZERO RMB 4 ; INTERUPT VECTOR
- AT RMB 2 ; CANCEL & C-R
- *
- * GENERAL PURPOSE STORRGE
- VARS RMB 52 ; VARIABLES(A-Z)
- BRAK RMB 2 ; [
- SAVE10 RMB 2 ; BACK SLASH
- BRIK RMB 2 ; ]
- UP RMB 2 ; ^
- 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 ; +
- COMA 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 ; =
- GRRT RMB 1 ; >
- DECB_1 RMB 1
- *
- DECBUF RMB 4
- LASTD RMB 1
- DELIM RMB 1
- LINBUF RMB 73 ; LINE LENGTH +1
- *
- ORG $00F1
- STACK RMB 1
- *
- ORG $0100
- MI RMB 4 ; INTERUPT VECTORS
- NMI RMB 4
- PRGM EQU * ; PROGRAM STARTS HERE
- *
- ORG $7800
- *
- COLD LDS #STACK ; S on 6800 is first free byte on stack.
- JSR TRMINI
- 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 0,X ; LOAD REAL LINE #
- STX DOLR ; SAVE IT
- LDX SAVE11 ; GET LINE
- INX ; BUMP PAST LINE #
- INX ; BUMP PAST LINE #
- INX ; BUMP PAST SPACE
- BSR EXEC ; EXECUTE IT
- BEQ LOOP3 ; IF ZERO, CONTINUE
- LDX SAVE11 ; FIND LINE
- LDX 0,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 0,X ; GET FIRST TERM
- BSR EVIL ; EVALUATE EXPRESSION
- OUTX LDX DOLR ; GET LINE #
- RTS
- *
- EVIL CMPA #$22 ; IF " THEN BRANCH
- BNE EVALU
- INX
- STRGT JMP STRING ; 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 0,X
- LDAB 1,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 0,X
- BNE LOOKAG
- INX
- RTS
- *
- FIND LDX #PRGM ; FIND LINE
- FND2 STX SAVE11
- CPX AMPR
- BEQ RTS1
- LDAA 1,X
- SUBA DOLR+1
- LDAA 0,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 ; THEN DO IT
- INCB ; MACHINE LANGUAGE?
- PULB
- BNE AR2
- SWI ; THEN INTERUPT
- *
- AR2 STAA 0,X ; STORE NEW VALUE
- STAB 1,X
- ADDB QUITE ; RANDOMIZER
- ADCA QUITE+1
- STAA QUITE
- STAB QUITE+1
- RTS
- *
- SKP2 BSR FIND ; FIND LINE
- BEQ INSRT ; IF NOT THERE
- LDX 0,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 0,X
- PSHA
- INX
- INS
- INS
- BRA DELT
- *
- FITIT STS AMPR ; STORE NEW END
- *
- INSRT LDX SAVE8 ; COUNT NEW LINE LENGTH
- LDAB #$03
- TST 0,X
- BEQ GOTIT ; IF NO LINE THEN STOP
- CNTLN INCB
- INX
- TST 0,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 0,X
- PSHB
- CPX SAVE11
- BNE SLIDE
- *
- DON LDS DOLR ; STORE LINE #
- STS 0,X
- LDS SAVE8 ; GET NEW LINE
- DES
- *
- MOVL INX ; INSERT NEW LINE
- PULB
- STAB 1,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 0,X
- STX SAVE6
- LDX #SAVE6
- JSR DIVIDE
- PSHA
- LDX SAVE4
- LDAA SAVE2+1
- ADDA #'0
- STAA 0,X
- INX
- STX SAVE4
- LDX SAVE5
- PULA
- INX
- INX
- TST 1,X
- BNE CVD1
- *
- LDX #DECB_1
- COM 5,X ; ZERO SUPPRESS
- ZRSUP INX
- LDAB 0,X
- CMPB #'0
- BEQ ZRSUP
- COM LASTD
- *
- PNTMSG CLRA ; ZERO FOR DELIM
- STRTMS STAA DELIM ; STORE DELIMTER
- *
- OUTMSG LDAB 0,X ; GENERAL PURPOSE PRINT
- INX
- CMPB DELIM
- BEQ CTLC
- JSR OUTCH
- BRA OUTMSG
- *
- CTLC JSR POLCAT ; POL FOR CHARACTER
- BCC RTS2
- BSR INCH2
- CMPB #BREAK ; BREAK KEY?
- BEQ RSTRT
- *
- INCH2 JMP INCH
- *
- STRING BSR STRTMS ; PRINT STRING LITERAL
- LDAA 0,X
- CMPA #';
- BEQ OUTD
- JMP CRLF
- *
- EVAL BSR GETVAL ; EVALUATE EXPRESSION
- *
- NXTRM PSHA
- LDAA 0,X ; END OF LINE?
- BEQ OUTN
- CMPA #')
- OUTN PULA
- BEQ OUTD
- BSR TERM
- LDX SAVE0
- BRA NXTRM
- *
- TERM PSHA ; GET VALUE
- PSHB
- LDAA 0,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 COMPLEMENT
- LDAB #$10
- STAB SAVE1
- CLRA
- CLRB
- *
- MULT LSR SAVE2
- ROR SAVE2+1
- BCC NOAD
- MULTI BSR ADD
- NOAD ASL 1,X
- ROL 0,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 0,X ; OR ARRAY ELEMENT
- LDAB 1,X
- LDX SAVE6 ; LOAD OLD INDEX
- RTS
- *
- ARRAY BSR EVAL ; LOCATE ARRAY ELEMENT
- ASLB
- ROLA
- ADDB AMPR+1
- ADCA AMPR
- BRA PACK
- *
- CONVP LDAB 0,X ; GET LOCATION
- INX
- PSHB
- CMPB #':
- BEQ ARRAY ; OF VARIABLE OR
- CLRA ; ARRAY ELEMENT
- ANDB #$3F
- ADDB #$02
- 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 1,X
- ADCA 0,X
- RTS
- *
- EVAL3 CMPA #'- ; SUBTRACTION
- BNE EVAL4
- PULA
- SUBTR SUBB 1,X
- SBCA 0,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 #$01
- RTS
- *
- EVAL7 BSR SUB2 ; GT TEST
- COMBOUT COMB
- BRA COMOUT
- *
- PWRS10 FCB $27 ; 10000
- FCB $10
- FCB $03 ; 1000
- FCB $E8
- FCB $00 ; 100
- FCB $64
- FCB $00 ; 10
- FCB $0A
- FCB $00 ; 1
- FCB $01
- *
- DIVIDE CLR SAVE1 ; DEVIDE 16-BITS
- GOT INC SAVE1
- ASL 1,X
- ROL 0,X
- BCC GOT
- ROR 0,X
- ROR 1,X
- CLR SAVE2
- CLR SAVE2+1
- DIV2 BSR SUBTR
- BCC OK
- BSR ADD
- CLC
- FCB $9C ; WHAT?
- OK SEC
- ROL SAVE2+1
- ROL SAVE2
- DEC SAVE1
- BEQ DONE
- LSR 0,X
- ROR 1,X
- BRA DIV2
- *
- TSTN LDAB 0,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 0,X
- ADCA #$00
- SUBB #'0
- SBCA #$00
- 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 #'@ ; CANCEL
- BEQ NEWLIN
- INX ; '.'
- CPX #74 ; LINE LENGTH +2
- BNE INLN2
- NEWLIN BSR CRLF
- *
- INLN LDX #2 ; INPUT LINE FROM TERMINAL
- INLN5 DEX
- BEQ NEWLIN
- INLN2 JSR INCH ; INPUT CHARACTER
- STAB $87,X ; STORE IT
- CMPB #$5F ; BACKSPACE?
- BEQ INLN5
- *
- INLIN3 CMPB #$0D ; CARRIAGE RETURN
- BMI INLN2
- BNE INLN6
- *
- INLIN4 CLR $87,X ; CLEAR LAST CHAR
- LDX #LINBUF
- BRA LF
- *
- * CRLF JSR EPCRLF
- CRLF LDAB #$0D ; CARR-RET
- BSR OUTCH2
- LF LDAB #$0A ; LINE FEED
- OUTCH2 JMP OUTCH
- *
- OKM FCB $0D
- FCB $0A
- FCC 'OK'
- FCB $00
- *
- TRMINI LDAB #40
- TRMILP JSR EPCRLF
- DECB
- BNE TRMILP
- RTS
- *
- * RECEIVER POLLING
- POLCAT LDAB ACIACS
- ASRB
- RTS
- *
- * INPUT ONE CHAR INTO B ACCUMULATOR
- INCH PSHA
- JSR EINCH
- TAB
- PULA
- RTS
- *
- * OUTPUT ONE CHAR
- OUTCH PSHA
- TBA
- JSR EOUTCH
- PULA
- RTS
- *
- ORG COLD
- *
- END
reiisi
