* 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