NSVTL Not So Very Tiny Language

Fork

*	VTL-2
*	V-3.6
*	9-23-76
*	BY GARY SHANNON
*	& FRANK MCCOY
*	Original version COPYRIGHT 1976, THE COMPUTER STORE
*
*	Modified 2022 by Joel Rees
*
*	For more general hardware --
*
*	Many of the devices you might want to run this on 
* 	will use the direct page for all sorts of things.
*
*	That will seriously conflict with all the 
* 	variables and stuff originally allocated
*	in the direct page.
*
***********
*
* The goal of this rewrite is 
* to make the language correct
* and portable (within 6800-based hardware).
*
* The result should be easily optimized to the 6801,
* and easily ported to the 6805 and 6809.
*
* The memory map will change as follows:
*
* ******
* Virtual registers in the direct page,
* Can be moved to avoid areas in use by platform of choice.
*
* ****** At some point beyond the direct page:
* Global variables, 
* including the variables the user sees.
*
* ****** After the global variables:
* Input and output buffers (actually, a type of global).
LBUFSZ	EQU 128		; hypothetical
* 
* ****** After the buffers:
* Parameter/local stack
* because I'm that kind of weird.
USTKSZ	EQU 16		; just a guess before I go
*
* ******
* Return address stack (mostly).
RSTKSZ	EQU 24		; 2 bytes per call, room for interrupts
*
* ******
* Code
*
*


*	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
* POLCAT	EQU	POLCATROB	; dummy return, assume INCH takes care of things
* 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.
******* Want to define these at bottom because of POLCAT, but ...
*
*	FOR SBC6800
BREAK	EQU	$1B	; BREAK KEY
ACIACS  EQU     $FCF4	; exorcisor
ACIADA  EQU     $FCF5	; exorcisor
*


* Set somewhere non-conflicting in direct page:
	ORG $C0		; virtual registers
vACCM	RMB 2		; virtual double accumulator
vOVER	RMB 2		; virtual overflow register
*Don't do this. It hurts.
* vRSTMPX	RMB 2		; temporary holder for X during push/pop
vUSP	RMB 2		; parameter stack pointer
vTASK	RMB 2		; global variables segment base


	ORG $200	; 
GLOBASE	EQU *
* What CPU was this?
* Or, rather, what monitor was it for?
* Figure out what to do about this for the monitor you are using:
*	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	LBUFSZ+1	; LINE LENGTH +1
STATLIM	EQU	*
STATSZ	EQU	STATLIM-GLOBASE


*	ORG	$00F1
*STACK	RMB	1
*
* As an example:
* Make sure there is enough room for the stacks above GLOBASE
*	ORG	$0100
* Many assemblers can't handle something like this:
*	ORG	$0400-(RSTKSZ-USTKSZ-24)
* Hand calculate it:
	ORG	$03C0
* And check the listing to make sure you got it right.
*
ALLIMIT	EQU *
	RMB	8		; buffer zone
USTKLIM	RMB	USTKSZ
USTKINI	EQU *
	RMB	8		; buffer zone

RSTKLIM	RMB	RSTKSZ
RSTKINI	EQU *
STACK	EQU 	RSTKINI-1	; See TSX/TXS op-code for why.
	RMB	8		; buffer zone

STALTOP	EQU *


* Most early assemblers are scared of address calculations,
* So do this in your head:
* 	IF STATLIM >= ALLIMIT
*	ERROR "Move stack allocations higher!"
*	ENDIF
* ... and check the listing, to be sure.

	
	ORG	$400	; greater than or equal to STALTOP
CODE	EQU *
* Check this in your head and in the listing, as well:
* 	IF STALTOP > CODE
*	ERROR "Move code higher or stacks lower!"
*	ENDIF


* Also, figure out what the monitor you are using wants to do about this:
* 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
	LDX	#GLOBASE
	STX	vTASK
START
	LDS	#STACK	; reset the stack
	LDX	#USTKINI	; U stack will be top byte (last pushed).
	STX	vUSP
*
	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 #
*POLCATROB
	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
	BNE	AR1NP
	JMP	PRNT
AR1NP	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
ARRAY	JSR	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	vTASK	;#2	; INPUT LINE FROM TERMINAL
	INX
*************
INLN5	DEX
	CPX
	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	'              DONE'
	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