This should give you vtl-2 running on the Tandy/Radio Shack Color computer 1 or 2 in a 16K or better RAM configuration. You can assemble it with lwasm from lwtools. It's a transliteration, and barely uses any of the resources specific to the 6809, mostly done as proof that it can be done.

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

このコピペの URL

JavaScript での埋め込み

iframe での埋め込み

元のテキスト