Source code that runs VTL-2 on my fake 6801 simulator based on Joe H. Allen's EXORsim. Should be modifiable to run on a variety of hardware, but uses stack blasting, which will play hob with interrupts. Can be assembled with my asm68c. The & and * variables are set automatically now because of the variable relocation (initialization code corrected for fix for CPX in EXORsim).

形式
Asm
投稿日時
2022-09-03 17:34
公開期間
無期限
  1. OPT 6801
  2. * VTL-2 for 6801
  3. * V-3.6
  4. * 9-23-76
  5. * BY GARY SHANNON
  6. * & FRANK MCCOY
  7. * COPYWRIGHT 1976, THE COMPUTER STORE
  8. *
  9. * Modifications for 6801 fake on exorsim
  10. * and for moving variables out of direct page
  11. * by Joel Matthew Rees
  12. * Copyright 2022, Joel Matthew Rees
  13. * Starting with low-hanging fruit.
  14. * Modifications explained at
  15. * https://joels-programming-fun.blogspot.com/2022/08/vtl-2-part-3-optimizing-for-6801.html
  16. *
  17. * DEFINE LOCATIONS IN MONITOR
  18. * INCH EQU $FF00 ; per VTL.ASM
  19. EINCH EQU $F012 ; exorsim mdos Input byte with echo unless AECHO is set
  20. * INCH EQU $F015 ; exorsim mdos Input char with echo (F012 -> strip bit 7)
  21. * POLCAT EQU $FF24 ; from VTL.ASM
  22. * OUTCH EQU $FF81 ; from VTL.ASM
  23. EOUTCH EQU $F018 ; exorsim mdos Output character with NULs
  24. * OUTS EQU $FF82 ; from VTL.ASM
  25. EPCRLF EQU $F021 ; Primarily for forced initialization in exorsim.
  26. *
  27. * FOR SBC6800:
  28. BREAK EQU $1B ; BREAK KEY
  29. * For exorsim
  30. ACIACS EQU $FCF4 ; exorcisor
  31. ACIADA EQU $FCF5 ; exorcisor
  32. *
  33. * A few interpreter variables in the direct page won't hurt.
  34. * (Yes, I can hear voices of complaint that it's not as "tight" as it could be.)
  35. * (This allows us to save more ROM space and uses DP that would otherwise go wasted.)
  36. * (Trade-offs.)
  37. * (It also helps us understand the code, so we can do a better 6809 transliteration.)
  38. * (I hope the names are meaningful.)
  39. ORG $80 ; Move this according to your environment's needs.
  40. PARSET RMB 2 ; Instead of SAVE0 in TERM/NXTRM
  41. CVTSUM RMB 2 ; Instead of SAVE1 in CBLOOP
  42. MLDVCT EQU CVTSUM ; Instead of SAVE1 in mul/div (1 byte only)
  43. DIVQUO RMB 2 ; Instead of SAVE2 in DIV
  44. MPLIER EQU DIVQUO ; Instead of SAVE2 in MULTIP
  45. EVALPT RMB 2 ; Instead of SAVE3
  46. CNVPTR RMB 2 ; Instead of SAVE4
  47. VARADR RMB 2 ; Instead of SAVE6
  48. OPRLIN RMB 2 ; Instead of SAVE7
  49. EDTLIN RMB 2 ; Instead of SAVE8
  50. INSPTR RMB 2 ; Instead of SAVE10 (maybe? Will some VTL programs want it back?)
  51. SAVLIN RMB 2 ; Instead of SAVE11
  52. *
  53. * SET ASIDE FOUR BYTES FOR USER
  54. * DEFINED INTERUPT ROUTINE IF NEEDED
  55. ORG $0200
  56. * ZERO must be set at even $100 boundary for address math to work.
  57. ZERO RMB 4 ; INTERUPT VECTOR
  58. AT RMB 2 ; CANCEL & C-R
  59. *
  60. * GENERAL PURPOSE STORRGE
  61. VARS RMB 52 ; VARIABLES(A-Z)
  62. BRAK RMB 2 ; [
  63. * SAVE10 has me worried about implicit linkage in VTL programs. Might need to leave it here.
  64. SAVE10 RMB 2 ; BACK SLASH
  65. BRIK RMB 2 ; ]
  66. UP RMB 2 ; ^
  67. SAVE11 RMB 2 ; Need something in each SAVE to reserve space
  68. * ; to keep the math straight.
  69. * ; Leave the SAVEs declared as they are.
  70. *
  71. SAVE14 RMB 2 ; SPACE (originally unused)
  72. EXCL RMB 2 ; !
  73. QUOTE RMB 2 ; "
  74. DOLR RMB 2 ; #
  75. DOLLAR RMB 2 ; $
  76. REMN RMB 2 ; %
  77. AMPR RMB 2 ; &
  78. QUITE RMB 2 ; '
  79. PAREN RMB 2 ; (
  80. PARIN RMB 2 ; )
  81. STAR RMB 2 ; *
  82. PLUS RMB 2 ; +
  83. COMA RMB 2 ; ,
  84. MINS RMB 2 ; -
  85. PERD RMB 2 ; .
  86. SLASH RMB 2 ; /
  87. *
  88. SAVE0 RMB 2 ; unused
  89. SAVE1 RMB 2 ; unused
  90. SAVE2 RMB 2 ; unused
  91. SAVE3 RMB 2 ; unused
  92. SAVE4 RMB 2 ; unused
  93. SAVE5 RMB 2 ; unused (PSH/PULX)
  94. SAVE6 RMB 2 ; unused
  95. SAVE7 RMB 2 ; unused
  96. SAVE8 RMB 2 ; unused
  97. SAVE9 RMB 2 ; unused (PSH/PULX)
  98. COLN RMB 2 ; :
  99. SEMI RMB 2 ; ;
  100. LESS RMB 2 ; <
  101. EQAL RMB 2 ; =
  102. GRRT RMB 1 ; >
  103. DECB_1 RMB 1
  104. *
  105. DECBUF RMB 4
  106. LASTD RMB 1
  107. DELIM RMB 1
  108. LINLEN EQU 72
  109. LINBUF RMB LINLEN+1
  110. BUFOFF EQU LINBUF-ZERO ; Unmagic 87. Some assemblers will cough at this.
  111. *
  112. ORG $02F1
  113. STACK RMB 1
  114. *
  115. ORG $0300
  116. MI RMB 4 ; INTERUPT VECTORS
  117. NMI RMB 4
  118. PRGM EQU * ; PROGRAM STARTS HERE
  119. * Must have some RAM here.
  120. *
  121. ORG $7800
  122. *
  123. * The COLD boot can be removed or ignored to restore the original behavior,
  124. * but if you do that don't forget to set & (AMPR) and * (STAR) values
  125. * by hand immediately after STARTing.
  126. *
  127. * Also, instead of PROBEing, if you know the limits for a particular ROM
  128. * application, you can set STAR directly:
  129. * LDX #PRGM
  130. * STX AMPR
  131. * LDX #RAMLIM
  132. * STX STAR
  133. * START ...
  134. *
  135. COLD LDS #STACK ; S on 6800 is first free byte on stack.
  136. JSR TRMINI
  137. LDX #PRGM ; initialize program area base
  138. STX AMPR
  139. LDAA #$5A ; Probe RAM limit
  140. LDAB #$A5
  141. BRA PROBET
  142. PROBE STAA 0,X
  143. CMPA 0,X
  144. BNE NOTRAM
  145. STAB 0,X
  146. CMPB 0,X
  147. BNE NOTRAM
  148. INX ; all bits seem to be R/W.
  149. PROBET CPX #COLD
  150. BLO PROBE ; CPX on 6801 works right.
  151. NOTRAM DEX
  152. STX STAR
  153. START LDS #STACK ; re-initialize at beginning of each evaluate
  154. CLRA ; NUL delimiter
  155. LDX #OKM
  156. BSR STRGT
  157. *
  158. LOOP CLRA
  159. STAA DOLR
  160. STAA DOLR+1
  161. JSR CVTLN
  162. BCC STMNT ; NO LINE# THEN EXEC
  163. BSR EXEC
  164. BEQ START
  165. *
  166. LOOP2 BSR FIND ; FIND LINE
  167. EQSTRT BEQ START ; IF END THEN STOP
  168. LDX 0,X ; LOAD REAL LINE #
  169. STX DOLR ; SAVE IT
  170. LDX SAVLIN ; GET LINE
  171. INX ; BUMP PAST LINE #
  172. INX ; BUMP PAST LINE #
  173. INX ; BUMP PAST SPACE
  174. BSR EXEC ; EXECUTE IT
  175. BEQ LOOP3 ; IF ZERO, CONTINUE
  176. LDX SAVLIN ; FIND LINE
  177. LDX 0,X ; GET IT
  178. CPX DOLR ; HAS IT CHANGED?
  179. BEQ LOOP3 ; IF NOT GET NEXT
  180. *
  181. INX ; INCREMENT OLD LINE#
  182. STX EXCL ; SAVE FOR RETURN
  183. BRA LOOP2 ; CONTINUE
  184. *
  185. LOOP3 BSR FND3 ; FIND NEXT LINE
  186. BRA EQSTRT ; CONTINUE
  187. *
  188. EXEC STX OPRLIN ; EXECUTE LINE
  189. JSR VAR2
  190. INX
  191. *
  192. SKIP LDAA 0,X ; GET FIRST TERM
  193. BSR EVIL ; EVALUATE EXPRESSION
  194. OUTX LDX DOLR ; GET LINE #
  195. RTS
  196. *
  197. EVIL CMPA #$22 ; IF " THEN BRANCH
  198. BNE EVALU
  199. INX
  200. STRGT JMP STRING ; TO PRINT IT
  201. *
  202. STMNT STX EDTLIN ; SAVE LINE #
  203. STD DOLR
  204. LDX DOLR
  205. BNE SKP2 ; IF LINE# <> 0
  206. *
  207. LDX #PRGM ; LIST PROGRAM
  208. LST2 CPX AMPR ; END OF PROGRAM
  209. BEQ EQSTRT
  210. STX SAVLIN ; LINE # FOR CVDEC
  211. LDD 0,X
  212. JSR PRNT2
  213. LDX SAVLIN
  214. INX
  215. INX
  216. JSR PNTMSG
  217. JSR CRLF
  218. BRA LST2
  219. *
  220. NXTXT LDX SAVLIN ; GET POINTER
  221. INX ; BUMP PAST LINE#
  222. LOOKAG INX ; FIND END OF LINE
  223. TST 0,X
  224. BNE LOOKAG
  225. INX
  226. RTS
  227. *
  228. FIND LDX #PRGM ; FIND LINE
  229. FND2 STX SAVLIN
  230. CPX AMPR
  231. BEQ RTS1
  232. * LDAA 1,X ; almost missed this.
  233. * SUBA DOLR+1 ; This was necessary because no SUBD
  234. * LDAA 0,X ; and CPX does not affect C flag on 6800
  235. * SBCA DOLR
  236. * PSHB ; B does not seem to be in use.
  237. LDD 0,X ; Use D because we think we want to keep X.
  238. SUBD DOLR
  239. * PULB
  240. BCC SET
  241. FND3 BSR NXTXT
  242. BRA FND2
  243. *
  244. SET LDAA #$FF ; SET NOT EQUAL
  245. RTS1 RTS
  246. *
  247. EVALU JSR EVAL ; EVALUATE LINE
  248. PSHB
  249. PSHA
  250. LDX OPRLIN
  251. JSR CONVP
  252. PULA
  253. CMPB #'$ ; STRING?
  254. BNE AR1
  255. PULB
  256. JMP OUTCH ; THEN PRINT IT
  257. AR1 SUBB #'? ; PRINT?
  258. * BNE AR11 ; was out of range.
  259. * JMP PRNT ; THEN DO IT
  260. BEQ PRNT ; Now back within range.
  261. AR11 INCB ; MACHINE LANGUAGE?
  262. PULB
  263. BNE AR2
  264. SWI ; THEN INTERUPT
  265. *
  266. AR2 STD 0,X ; STORE NEW VALUE
  267. ADDD QUITE ; RANDOMIZER
  268. STD QUITE
  269. RTS
  270. *
  271. SKP2 BSR FIND ; FIND LINE
  272. BEQ INSRT ; IF NOT THERE
  273. LDX 0,X ; THEN INSERT
  274. CPX DOLR ; NEW LINE
  275. BNE INSRT
  276. *
  277. BSR NXTXT ; SETUP REGISTERS
  278. LDS SAVLIN ; FOR DELETE
  279. *
  280. DELT CPX AMPR ; DELETE OLD LINE
  281. BEQ FITIT
  282. LDAA 0,X
  283. PSHA
  284. INX
  285. INS
  286. INS
  287. BRA DELT
  288. *
  289. FITIT STS AMPR ; STORE NEW END
  290. *
  291. INSRT LDX EDTLIN ; COUNT NEW LINE LENGTH
  292. LDAB #$03
  293. TST 0,X
  294. BEQ GOTIT ; IF NO LINE THEN STOP
  295. CNTLN INCB
  296. INX
  297. TST 0,X
  298. BNE CNTLN
  299. *
  300. OPEN CLRA ; CALCULATE NEW END
  301. ADDD AMPR
  302. STD INSPTR
  303. SUBD STAR
  304. BCC RSTRT ; IF TOO BIG THEN STOP
  305. LDX AMPR
  306. LDS INSPTR ; remember that the 6800/6801 stack is postdecrement push.
  307. STS AMPR
  308. *
  309. INX ; SLIDE OPEN GAP
  310. SLIDE DEX ; going down
  311. LDAB 0,X
  312. PSHB ; stack blast it
  313. CPX SAVLIN
  314. BNE SLIDE
  315. *
  316. DON LDS DOLR ; STORE LINE #
  317. STS 0,X
  318. LDS EDTLIN ; GET NEW LINE
  319. DES ; postdecrement
  320. *
  321. MOVL INX ; INSERT NEW LINE
  322. PULB
  323. STAB 1,X
  324. BNE MOVL
  325. *
  326. GOTIT LDS #STACK
  327. JMP LOOP
  328. *
  329. RSTRT JMP START
  330. *
  331. PRNT PULB ; PRINT DECIMAL
  332. PRNT2 LDX #DECBUF ; CONVERT TO DECIMAL
  333. STX CNVPTR
  334. LDX #PWRS10
  335. CVD1 PSHX
  336. LDX 0,X
  337. STX VARADR
  338. LDX #VARADR
  339. JSR DIVIDE
  340. PSHA
  341. LDX CNVPTR
  342. LDAA DIVQUO+1
  343. ADDA #'0
  344. STAA 0,X
  345. PULA
  346. INX
  347. STX CNVPTR
  348. PULX
  349. INX
  350. INX
  351. TST 1,X
  352. BNE CVD1
  353. *
  354. LDX #DECB_1
  355. COM 5,X ; ZERO SUPPRESS
  356. ZRSUP INX
  357. LDAB 0,X
  358. CMPB #'0
  359. BEQ ZRSUP
  360. COM LASTD
  361. *
  362. PNTMSG CLRA ; ZERO FOR DELIM
  363. STRTMS STAA DELIM ; STORE DELIMTER
  364. *
  365. OUTMSG LDAB 0,X ; GENERAL PURPOSE PRINT
  366. INX
  367. CMPB DELIM
  368. BEQ CTLC
  369. JSR OUTCH
  370. BRA OUTMSG
  371. *
  372. CTLC JSR POLCAT ; POL FOR CHARACTER
  373. BCC RTS2
  374. BSR INCH2
  375. CMPB #BREAK ; BREAK KEY?
  376. BEQ RSTRT
  377. *
  378. INCH2 JMP INCH
  379. *
  380. STRING BSR STRTMS ; PRINT STRING LITERAL
  381. LDAA 0,X
  382. CMPA #';
  383. BEQ OUTD
  384. JMP CRLF
  385. *
  386. EVAL BSR GETVAL ; EVALUATE EXPRESSION
  387. *
  388. NXTRM PSHA
  389. LDAA 0,X ; END OF LINE?
  390. BEQ OUTN
  391. CMPA #')
  392. OUTN PULA
  393. BEQ OUTD
  394. BSR TERM
  395. LDX PARSET
  396. BRA NXTRM
  397. *
  398. TERM PSHA ; GET VALUE
  399. PSHB
  400. LDAA 0,X
  401. PSHA
  402. INX
  403. BSR GETVAL
  404. STD EVALPT
  405. STX PARSET
  406. LDX #EVALPT
  407. PULA
  408. PULB
  409. *
  410. CMPA #'* ; SEE IF *
  411. BNE EVAL2
  412. PULA ; MULTIPLY
  413. MULTIP STD MPLIER ; 2'S COMPLEMENT
  414. LDAB #$10
  415. STAB MLDVCT
  416. CLRA
  417. CLRB
  418. *
  419. MULT LSR MPLIER
  420. ROR MPLIER+1
  421. BCC NOAD
  422. MULTI ADDD 0,X
  423. NOAD ASL 1,X
  424. ROL 0,X
  425. DEC MLDVCT
  426. BNE MULT ; LOOP TIL DONE
  427. RTS2 RTS
  428. *
  429. GETVAL JSR CVBIN ; GET VALUE
  430. BCC OUTV
  431. CMPB #'? ; OF LITERAL
  432. BNE VAR
  433. PSHX ; OR INPUT
  434. JSR INLN
  435. BSR EVAL
  436. PULX
  437. OUTD INX
  438. OUTV RTS
  439. *
  440. VAR CMPB #'$ ; OR STRING
  441. BNE VAR1
  442. BSR INCH2
  443. CLRA
  444. INX
  445. RTS
  446. *
  447. VAR1 CMPB #'(
  448. BNE VAR2
  449. INX
  450. BRA EVAL
  451. *
  452. VAR2 BSR CONVP ; OR VARIABLE
  453. LDD 0,X ; OR ARRAY ELEMENT
  454. LDX VARADR ; LOAD OLD INDEX
  455. RTS
  456. *
  457. ARRAY JSR EVAL ; LOCATE ARRAY ELEMENT
  458. ASLD
  459. ADDD AMPR
  460. BRA PACK
  461. *
  462. CONVP LDAB 0,X ; GET LOCATION
  463. INX
  464. PSHB
  465. CMPB #':
  466. BEQ ARRAY ; OF VARIABLE OR
  467. CLRA ; ARRAY ELEMENT
  468. ANDB #$3F ; mask out-of-variable-range
  469. ADDB #$02 ; bump past "interrupt vectors"
  470. ASLB ; make into offset (would be address in DP in original)
  471. ADDD #ZERO ; The 6801 can do this right.
  472. *
  473. PACK STX VARADR ; STORE OLD INDEX
  474. STD CNVPTR
  475. LDX CNVPTR ; LOAD NEW INDEX
  476. PULB
  477. RTS
  478. *
  479. EVAL2 CMPA #'+ ; ADDITION
  480. BNE EVAL3
  481. PULA
  482. ADD ADDD 0,X
  483. RTS
  484. *
  485. EVAL3 CMPA #'- ; SUBTRACTION
  486. BNE EVAL4
  487. PULA
  488. SUBTR SUBD 0,X
  489. RTS
  490. *
  491. EVAL4 CMPA #'/ ; SEE IF IT'S DIVIDE
  492. BNE EVAL5
  493. PULA
  494. BSR DIVIDE
  495. STD REMN
  496. LDD DIVQUO
  497. RTS
  498. *
  499. EVAL5 SUBA #'= ; SEE IF EQUAL TEST
  500. BNE EVAL6
  501. PULA
  502. BSR SUBTR
  503. BNE NOTEQ
  504. TSTB
  505. BEQ EQL
  506. NOTEQ LDAB #$FF
  507. EQL BRA COMBOUT
  508. *
  509. EVAL6 DECA ; SEE IF LESS THAN TEST
  510. PULA
  511. BEQ EVAL7
  512. *
  513. SUB2 BSR SUBTR
  514. ROLB
  515. COMOUT CLRA
  516. ANDB #$01
  517. RTS
  518. *
  519. EVAL7 BSR SUB2 ; GT TEST
  520. COMBOUT COMB
  521. BRA COMOUT
  522. *
  523. PWRS10 FCB $27 ; 10000
  524. FCB $10
  525. FCB $03 ; 1000
  526. FCB $E8
  527. FCB $00 ; 100
  528. FCB $64
  529. FCB $00 ; 10
  530. FCB $0A
  531. FCB $00 ; 1
  532. FCB $01
  533. *
  534. DIVIDE CLR MLDVCT ; DEVIDE 16-BITS
  535. GOT INC MLDVCT
  536. ASL 1,X
  537. ROL 0,X
  538. BCC GOT
  539. ROR 0,X
  540. ROR 1,X
  541. CLR DIVQUO
  542. CLR DIVQUO+1
  543. DIV2 BSR SUBTR
  544. BCC OK
  545. ADDD 0,X
  546. CLC
  547. BRA DIVNOC ; instead of the trick
  548. * The 6801 CPX affects all relevant flags, can't use this trick.
  549. * FCB $9C ; CPX
  550. OK SEC ; $0D
  551. DIVNOC ROL DIVQUO+1
  552. ROL DIVQUO
  553. DEC MLDVCT
  554. BEQ DONE
  555. LSR 0,X
  556. ROR 1,X
  557. BRA DIV2
  558. *
  559. TSTN LDAB 0,X ; TEST FOR NUMERIC
  560. CMPB #$3A
  561. BPL NOTDEC
  562. CMPB #'0
  563. BGE DONE
  564. NOTDEC SEC
  565. RTS
  566. DONE CLC
  567. DUN RTS
  568. *
  569. CVTLN BSR INLN
  570. *
  571. CVBIN BSR TSTN ; CONVERT TO BINARY
  572. BCS DUN
  573. CONT CLRA
  574. CLRB
  575. CBLOOP ADDB 0,X
  576. ADCA #$00
  577. SUBB #'0
  578. SBCA #$00
  579. STD CVTSUM
  580. INX
  581. PSHB
  582. BSR TSTN
  583. PULB
  584. BCS DONE
  585. ASLD
  586. ASLD
  587. ADDD CVTSUM
  588. ASLD
  589. BRA CBLOOP
  590. *
  591. INLN6 CMPB #'@ ; CANCEL
  592. BEQ NEWLIN
  593. INX ; '.'
  594. CPX #ZERO+LINLEN+2 ; (Here's part of what we had to fix for moving the variables.)
  595. BNE INLN2
  596. NEWLIN BSR CRLF
  597. *
  598. INLN LDX #ZERO+2 ; INPUT LINE FROM TERMINAL
  599. INLN5 DEX
  600. CPX #ZERO ; Make this explicit to enable variables moved out of DP.
  601. BEQ NEWLIN ; (Was implicit zero compare X from DEX, now explicit.)
  602. INLN2 JSR INCH ; INPUT CHARACTER
  603. STAB BUFOFF-1,X ; STORE IT
  604. CMPB #$5F ; BACKSPACE?
  605. BEQ INLN5
  606. *
  607. INLIN3 CMPB #$0D ; CARRIAGE RETURN
  608. BMI INLN2
  609. BNE INLN6
  610. *
  611. INLIN4 CLR BUFOFF-1,X ; CLEAR LAST CHAR
  612. LDX #LINBUF
  613. BRA LF
  614. *
  615. * CRLF JSR EPCRLF
  616. CRLF LDAB #$0D ; CARR-RET
  617. BSR OUTCH2
  618. LF LDAB #$0A ; LINE FEED
  619. OUTCH2 BRA OUTCH
  620. *
  621. OKM FCB $0D
  622. FCB $0A
  623. FCC 'OK'
  624. FCB $00
  625. *
  626. TRMINI LDAB #40
  627. TRMILP JSR EPCRLF
  628. DECB
  629. BNE TRMILP
  630. RTS
  631. *
  632. * RECEIVER POLLING
  633. POLCAT LDAB ACIACS
  634. ASRB
  635. RTS
  636. *
  637. * INPUT ONE CHAR INTO B ACCUMULATOR
  638. INCH PSHA
  639. JSR EINCH
  640. TAB
  641. PULA
  642. RTS
  643. *
  644. * OUTPUT ONE CHAR
  645. OUTCH PSHA
  646. TBA
  647. JSR EOUTCH
  648. PULA
  649. RTS
  650. *
  651. ORG COLD
  652. *
  653. END
ダウンロード 印刷用表示

このコピペの URL

JavaScript での埋め込み

iframe での埋め込み

元のテキスト