*	VTL-2
*	V-3.6
*	9-23-76
*	BY GARY SHANNON
*	& FRANK MCCOY
*	COPYWRIGHT 1976, THE COMPUTER STORE
*
*	MODIFIED FOR STAND-ALONE BY RYU-STUDIO
*	AND AGAIN BY DAVE HASSLER FOR
*	HM-68 HOMEMADE 6800 COMPUTER
*
*	COMPILE WITH HERB JOHNSON'S A68 ASSEMBLER:
*	a68 VTL2s.ASM -l vtl2s.lst -s VTL2-1C00.S19
*				  (-o for HEX output)
*
*	DEFINE LOCATIONS IN MONITOR
*INCH	EQU	$FF00
*PLCAT	EQU	$FF24
*OUTCH	EQU	$FF81
*OUTS	EQU	$FF82
*
*	FOR HM-68 DBC COMPUTER
BREAK	EQU	$1B	;BREAK KEY
STACK	EQU	$00F1
ACIACS  EQU     $8018
ACIADA  EQU     $8019
*
*	SET ASIDE FOUR BYTES FOR USER-
*	DEFINED INTERRUPT ROUTINE, IF NEEDED
	ORG	$0000
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	;^
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	$0100
MI	RMB	4	;INTERRUPT VECTORS
NMI	RMB	4
PRGM	EQU	*	;PROGRAM STARTS HERE
*
	ORG	$1C00
*
	LDX	#$1BFF	;set top of user RAM
	STX	STAR	; gives 6.9 KB
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 INTERRUPT
*
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	;DIVIDE 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	LDAB	#$0D	;CARR-RET
	BSR	OUTCH2
LF	LDAB	#$0A	;LINE FEED
OUTCH2	JMP	OUTCH
*
OKM	FCB	$0D
	FCB	$0A
	FCC	'OK'
	FCB	$00

*
*	RECEIVE POLLING
POLCAT	LDAB	ACIACS
	ASRB
	RTS
*
*	INPUT ONE CHAR INTO B-REGISTER
INCH	BSR	POLCAT
	BCC	INCH	;RECEIVE NOT READY
	LDAB	ACIADA	;INPUT CHARACTER
	ANDB	#$7F	;RESET PARITY BIT
	CMPB	#$7F
	BEQ	INCH	;IF RUBOUT, GET NEXT CHAR
	BSR	OUTCH
	RTS
*
*	OUTPUT ONE CHAR 
OUTCH	PSHB
OUTCH1	BSR	POLCAT
	ASRB
	BCC	OUTCH1
	PULB
	STAB	ACIADA
	RTS
*
*	RESET ENTRY
ENTRY	LDAB	#$03	;RESET CODE
	STAB	ACIACS
	LDAB	#$15	;8N1 NON INTERRUPT
        STAB	ACIACS
	JMP	START
*
*	DUMMY VECTOR
DUMMY	RTI
*
*	VECTOR
*	ORG	$FFF8
*	FDB	DUMMY
*	FDB	DUMMY
*	FDB	DUMMY
*	FDB	ENTRY
*
	END
