Pastebin: vtl-2_6800_exorsim_clr_dp.asm

Source code that moves the variables out of the direct page and runs VTL-2 in Joe H. Allen's EXORsim, should run in the EXORciser, and should be modifiable to run on a variety of systems. Can be assembled with my asm68c. The & and * variables are set automatically now because of the variable relocation.

Format: Asm
Post date: 2022-08-13 10:09
Publication Period: Unlimited

 *       VTL-2
 *       V-3.6
 *       9-23-76
 *       BY GARY SHANNON
 *       & FRANK MCCOY
 *       COPYWRIGHT 1976, THE COMPUTER STORE
 *
 *       Modifications for exorsim 
 *       and for moving variables out of direct page
 *       by Joel Matthew Rees
 *       Copyright 2022, Joel Matthew Rees
 *       Modifications explained at 
 *       https://joels-programming-fun.blogspot.com/2022/08/vtl-2-part-2-moving-variables-out-of-direct-page.html
 *
 *       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 must be set at even $100 boundary for address math to work.
 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
 * SAVOFF        RMB     2       ; This is the only place I dare put this yet.
 LASTD   RMB     1
 DELIM   RMB     1
 LINLEN  EQU     72
 LINBUF  RMB     LINLEN+1
 BUFOFF  EQU     LINBUF-ZERO     ; Unmagic 87. Some assemblers will cough at this.
 *
         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
 *
 * The COLD boot can be removed or ignored to restore the original behavior, 
 * but if you do that don't forget to set & (AMPR) and * (STAR) values
 * by hand immediately after STARTing.
 *
 * Also, instead of PROBEing, if you know the limits for a particular ROM
 * application, you can set STAR directly:
 *       LDX     #PRGM
 *       STX     AMPR
 *       LDX     #RAMLIM
 *       STX     STAR
 * START ...
 * 
 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    ; mask out-of-variable-range
         ADDB    #$02    ; bump past "interrupt vectors"
         ASLB            ; make into offset (would be address in DP)
 * Assemblers get funny about the syntax we need here.
 * I need to fix my assembler, too -- add some (now) standard syntax.
 * For now:
 *       ADDB    #(ZERO)MOD$100  ; ZERO must be on $100 boundary so we don't need this!
 *       ADCA    #ZERO/$100
         LDAA    #ZERO/$100      ; override CLRA above. Some assemblers will cough here.
 *
 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     #ZERO+LINLEN+2  ; (Here's part of what we had to fix for moving the variables.)
         BNE     INLN2
 NEWLIN  BSR     CRLF
 *
 INLN    LDX     #ZERO+2 ; INPUT LINE FROM TERMINAL
 INLN5   DEX
         CPX     #ZERO   ; Make this explicit to enable variables moved out of DP.
         BEQ     NEWLIN  ; (Was implicit zero compare X from DEX, now explicit.)
 INLN2   JSR     INCH    ; INPUT CHARACTER
         STAB    BUFOFF-1,X      ; STORE IT
         CMPB    #$5F    ; BACKSPACE?
         BEQ     INLN5
 *
 INLIN3  CMPB    #$0D    ; CARRIAGE RETURN
         BMI     INLN2
         BNE     INLN6
 *
 INLIN4  CLR     BUFOFF-1,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

Download Printable view

URL of this paste

Embed with JavaScript

Embed with iframe

Raw text

*	VTL-2
*	V-3.6
*	9-23-76
*	BY GARY SHANNON
*	& FRANK MCCOY
*	COPYWRIGHT 1976, THE COMPUTER STORE
*
*	Modifications for exorsim 
*	and for moving variables out of direct page
*	by Joel Matthew Rees
*	Copyright 2022, Joel Matthew Rees
*	Modifications explained at 
*	https://joels-programming-fun.blogspot.com/2022/08/vtl-2-part-2-moving-variables-out-of-direct-page.html
*
*	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 must be set at even $100 boundary for address math to work.
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
* SAVOFF	RMB	2	; This is the only place I dare put this yet.
LASTD	RMB	1
DELIM	RMB	1
LINLEN	EQU	72
LINBUF	RMB	LINLEN+1
BUFOFF	EQU	LINBUF-ZERO	; Unmagic 87. Some assemblers will cough at this.
*
	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
*
* The COLD boot can be removed or ignored to restore the original behavior, 
* but if you do that don't forget to set & (AMPR) and * (STAR) values
* by hand immediately after STARTing.
*
* Also, instead of PROBEing, if you know the limits for a particular ROM
* application, you can set STAR directly:
*	LDX	#PRGM
*	STX	AMPR
* 	LDX	#RAMLIM
*	STX	STAR
* START	...
* 
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	; mask out-of-variable-range
	ADDB	#$02	; bump past "interrupt vectors"
	ASLB		; make into offset (would be address in DP)
* Assemblers get funny about the syntax we need here.
* I need to fix my assembler, too -- add some (now) standard syntax.
* For now:
*	ADDB	#(ZERO)MOD$100	; ZERO must be on $100 boundary so we don't need this!
*	ADCA	#ZERO/$100
	LDAA	#ZERO/$100	; override CLRA above. Some assemblers will cough here.
*
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	#ZERO+LINLEN+2	; (Here's part of what we had to fix for moving the variables.)
	BNE	INLN2
NEWLIN	BSR	CRLF
*
INLN	LDX	#ZERO+2	; INPUT LINE FROM TERMINAL
INLN5	DEX
	CPX	#ZERO	; Make this explicit to enable variables moved out of DP.
	BEQ	NEWLIN	; (Was implicit zero compare X from DEX, now explicit.)
INLN2	JSR	INCH	; INPUT CHARACTER
	STAB	BUFOFF-1,X	; STORE IT
	CMPB	#$5F	; BACKSPACE?
	BEQ	INLN5
*
INLIN3	CMPB	#$0D	; CARRIAGE RETURN
	BMI	INLN2
	BNE	INLN6
*
INLIN4	CLR	BUFOFF-1,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

Pastebin: vtl-2_6800_exorsim_clr_dp.asm

URL of this paste

Embed with JavaScript

Embed with iframe

Raw text

Confirm the deletion

Download Ranking