コミット: 9de7be94eefefd8d5868b6b3edd54937b1e16a5e - nsvtl (git)

Deriving a new dialect of Very Tiny Language from VTL-2 6800 version

コミットメタ情報

• リビジョン: 9de7be94eefefd8d5868b6b3edd54937b1e16a5e (tree)
• 日時: 2022-09-25 20:11:06
• 作者: Joel Matthew Rees <joel.rees@gmai...>
• コミッター: Joel Matthew Rees

ログメッセージ

Moving the VTL variables out of the direct page for stability

変更サマリ

• add: VTL_6800_exorsim_clr_dp.ASM

差分

--- /dev/null
+++ b/VTL_6800_exorsim_clr_dp.ASM
@@ -0,0 +1,623 @@
+*	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, Joel Matthew Rees
+*
+*	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	$0200
+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	$02F1
+STACK	RMB	1
+*
+	ORG	$0300
+MI	RMB	4	; INTERUPT VECTORS
+NMI	RMB	4
+PRGM	EQU	*	; PROGRAM STARTS HERE
+* Must have some RAM here.
+*
+	ORG	$7800
+*
+COLD	LDS	#STACK	; S on 6800 is first free byte on stack.
+	JSR	TRMINI
+	LDX	#PRGM	; initialize program area base
+	STX	AMPR
+	LDAA	#$5A	; Probe RAM limit
+	LDAB	#$A5
+	BRA	PROBET
+PROBE	STAA	0,X
+	CMPA	0,X
+	BNE	NOTRAM
+	STAB	0,X
+	CMPB	0,X
+	BNE	NOTRAM
+	INX		; all bits seem to be R/W.
+PROBET	CPX	#COLD
+	BNE	PROBE	; CPX on 6800 doesn't do less/greater very well.
+NOTRAM	DEX
+	STX	STAR
+START	LDS	#STACK	; re-initialize at beginning of each evaluate
+	CLRA		; delimiter
+	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?
+	BNE	AR11
+	JMP	PRNT	; THEN DO IT
+AR11	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	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? (Waste CPX <$0D to skip SEC.)
+OK	SEC		; $0D
+	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 (Here's part of what we have to fix for moving the variables.)
+	BNE	INLN2
+NEWLIN	BSR	CRLF
+*
+INLN	LDX	#ZERO+2	; INPUT LINE FROM TERMINAL
+INLN5	DEX
+	BEQ	NEWLIN	; implicit zero compare X
+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