This version is pretty much assured not to function as it is. It should be fairly straightforward to converti it to a functioning non-optimal fig Forth, or a little harder to a somewhat optimal fig Forth, but no promises.

形式
Asm
投稿日時
2018-09-17 20:06
公開期間
無期限
  1. OPT PRT
  2. * fig-FORTH FOR 6800 => 6809, ***** Not yet functioning!!! *****
  3. * ASSEMBLY SOURCE LISTING
  4. * RELEASE 1
  5. * MAY 1979
  6. * WITH COMPILER SECURITY
  7. * AND VARIABLE LENGTH NAMES
  8. * This (not reallly) public domain publication is provided
  9. * through the courtesy of:
  10. * FORTH
  11. * INTEREST
  12. * GROUP
  13. * fig
  14. * P.O. Box 8231 - San Jose, CA 95155 - (408) 277-0668
  15. * Further distribution must include this notice.
  16. PAGE
  17. NAM Copyright:FORTH Interest Group
  18. OPT NOG,PAG
  19. * filename FTH7.21
  20. * === FORTH-6800 06-06-79 21:OO
  21. * This listing is NOT in the PUBLIC DOMAIN but
  22. * may be freely copied or published with the
  23. * restriction that a credit line is printed
  24. * with the material, crediting the
  25. * authors and the FORTH INTEREST GROUP,
  26. * and all risk of use is ENTIRELY assumed by the user.
  27. * === by Dave Lion,
  28. * === with help from
  29. * === Bob Smith,
  30. * === LaFarr Stuart,
  31. * === The Forth Interest Group
  32. * === PO Box 1105
  33. * === San Carlos, CA 94070
  34. * === and
  35. * === Unbounded Computing
  36. * === 1134-K Aster Ave.
  37. * === Sunnyvale, CA 94086
  38. *
  39. * ++++ Brain-dead conversion to non-optimal 6809 source by Joel Matthew Rees
  40. * ++++ using a perl script published elsewhere in his pastebin on OSDN.
  41. *
  42. * This version was developed on an AMI EVK 300 PROTO
  43. * system using an ACIA for the I/O. All terminal 1/0
  44. * is done in three subroutines:
  45. * PEMIT ( word # 182 )
  46. * PKEY ( 183 )
  47. * PQTERM ( 184 )
  48. *
  49. * The FORTH words for disc related I/O follow the model
  50. * of the FORTH Interest Group, but have not been
  51. * tested using a real disc.
  52. *
  53. * Addresses in this implementation reflect the fact that,
  54. * on the development system, it was convenient to
  55. * write-protect memory at hex 1000, and leave the first
  56. * 4K bytes write-enabled. As a consequence, code from
  57. * location $1000 to lable ZZZZ could be put in ROM.
  58. * Minor deviations from the model were made in the
  59. * initialization and words ?STACK and FORGET
  60. * in order to do this.
  61. *
  62. *
  63. NBLK EQU 4 # of disc buffer blocks for virtual memory
  64. MEMEND EQU 132*NBLK+$3000 end of ram
  65. * each block is 132 bytes in size,
  66. * holding 128 characters
  67. *
  68. MEMTOP EQU $3FFF absolute end of all ram
  69. ACIAC EQU $FBCE the ACIA control address and
  70. ACIAD EQU ACIAC+1 data address for PROTO
  71. PAGE
  72. * MEMORY MAP for this 16K system:
  73. * ( positioned so that systems with 4k byte write-
  74. * protected segments can write protect FORTH )
  75. *
  76. * addr. contents pointer init by
  77. * **** ******************************* ******* ******
  78. * 3FFF HI
  79. * substitute for disc mass memory
  80. * 3210 LO,MEMEND
  81. * 320F
  82. * 4 buffer sectors of VIRTUAL MEMORY
  83. * 3000 FIRST
  84. * >>>>>> memory from here up must be RAM <<<<<<
  85. *
  86. * 27FF
  87. * 6k of romable "FORTH" <== IP ABORT
  88. * <== W
  89. * the VIRTUAL FORTH MACHINE
  90. *
  91. * 1004 <<< WARM START ENTRY >>>
  92. * 1000 <<< COLD START ENTRY >>>
  93. *
  94. * >>>>>> memory from here down must be RAM <<<<<<
  95. * FFE RETURN STACK base <== RP RINIT
  96. *
  97. * FB4
  98. * INPUT LINE BUFFER
  99. * holds up to 132 characters
  100. * and is scanned upward by IN
  101. * starting at TIB
  102. * F30 <== IN TIB
  103. * F2F DATA STACK <== SP SP0,SINIT
  104. * | grows downward from F2F
  105. * v
  106. * - -
  107. * |
  108. * I DICTIONARY grows upward
  109. *
  110. * 183 end of ram-dictionary. <== DP DPINIT
  111. * "TASK"
  112. *
  113. * 150 "FORTH" ( a word ) <=, <== CONTEXT
  114. * `==== CURRENT
  115. * 148 start of ram-dictionary.
  116. *
  117. * 100 user #l table of variables <= UP DPINIT
  118. * F0 registers & pointers for the virtual machine
  119. * scratch area used by various words
  120. * E0 lowest address used by FORTH
  121. *
  122. * 0000
  123. PAGE
  124. ***
  125. *
  126. * CONVENTIONS USED IN THIS PROGRAM ARE AS FOLLOWS :
  127. *
  128. * IP points to the current instruction ( pre-increment mode )
  129. * RP points to second free byte (first free word) in return stack
  130. * SP (hardware SP) points to first free byte in data stack
  131. *
  132. * when A and B hold one 16 bit FORTH data word,
  133. * A contains the high byte, B, the low byte.
  134. ***
  135. ORG $E0 variables
  136. N RMB 10 used as scratch by (FIND),ENCLOSE,CMOVE,EMIT,KEY,
  137. * SP@,SWAP,DOES>,COLD
  138. * These locations are used by the TRACE routine :
  139. TRLIM RMB 1 the count for tracing without user intervention
  140. TRACEM RMB 1 non-zero = trace mode
  141. BRKPT RMB 2 the breakpoint address at which
  142. * the program will go into trace mode
  143. VECT RMB 2 vector to machine code
  144. * (only needed if the TRACE routine is resident)
  145. * Registers used by the FORTH virtual machine:
  146. * Starting at $OOFO:
  147. W RMB 2 the instruction register points to 6800 code
  148. IP RMB 2 the instruction pointer points to pointer to 6800 code
  149. RP RMB 2 the return stack pointer
  150. UP RMB 2 the pointer to base of current user's 'USER' table
  151. * ( altered during multi-tasking )
  152. *
  153. PAGE
  154. * This system is shown with one user, but additional users
  155. * may be added by allocating additional user tables:
  156. * UORIG2 RMB 64 data table for user #2
  157. *
  158. *
  159. * Some of this stuff gets initialized during
  160. * COLD start and WARM start:
  161. * [ names correspond to FORTH words of similar (no X) name ]
  162. *
  163. ORG $100
  164. UORIG RMB 6 3 reserved variables
  165. XSPZER RMB 2 initial top of data stack for this user
  166. XRZERO RMB 2 initial top of return stack
  167. XTIB RMB 2 start of terminal input buffer
  168. XWIDTH RMB 2 name field width
  169. XWARN RMB 2 warning message mode (0 = no disc)
  170. XFENCE RMB 2 fence for FORGET
  171. XDP RMB 2 dictionary pointer
  172. XVOCL RMB 2 vocabulary linking
  173. XBLK RMB 2 disc block being accessed
  174. XIN RMB 2 scan pointer into the block
  175. XOUT RMB 2 cursor position
  176. XSCR RMB 2 disc screen being accessed ( O=terminal )
  177. XOFSET RMB 2 disc sector offset for multi-disc
  178. XCONT RMB 2 last word in primary search vocabulary
  179. XCURR RMB 2 last word in extensible vocabulary
  180. XSTATE RMB 2 flag for 'interpret' or 'compile' modes
  181. XBASE RMB 2 number base for I/O numeric conversion
  182. XDPL RMB 2 decimal point place
  183. XFLD RMB 2
  184. XCSP RMB 2 current stack position, for compile checks
  185. XRNUM RMB 2
  186. XHLD RMB 2
  187. XDELAY RMB 2 carriage return delay count
  188. XCOLUM RMB 2 carriage width
  189. IOSTAT RMB 2 last acia status from write/read
  190. RMB 2 ( 4 spares! )
  191. RMB 2
  192. RMB 2
  193. RMB 2
  194. *
  195. *
  196. * end of user table, start of common system variables
  197. *
  198. *
  199. *
  200. XUSE RMB 2
  201. XPREV RMB 2
  202. RMB 4 ( spares )
  203. PAGE
  204. * These things, up through the lable 'REND', are overwritten
  205. * at time of cold load and should have the same contents
  206. * as shown here:
  207. *
  208. FCB $C5 immediate
  209. FCC 'FORT' ; 'FORTH'
  210. FCB $C8
  211. FDB NOOP-7
  212. FORTH FDB DODOES,DOVOC,$81A0,TASK-7
  213. FDB 0
  214. *
  215. FCC "(C) Forth Interest Group, 1979"
  216. FCB $84
  217. FCC 'TAS' ; 'TASK'
  218. FCB $CB
  219. FDB FORTH-8
  220. TASK FDB DOCOL,SEMIS
  221. *
  222. REND EQU * ( first empty location in dictionary )
  223. PAGE
  224. * The FORTH program ( address $1000 to $27FF ) is written
  225. * so that it can be in a ROM, or write-protected if desired
  226. ORG $1000
  227. * ######>> screen 3 <<
  228. *
  229. ***************************
  230. ** C O L D E N T R Y **
  231. ***************************
  232. ORIG NOP
  233. JMP CENT
  234. ***************************
  235. ** W A R M E N T R Y **
  236. ***************************
  237. NOP
  238. JMP WENT warm-start code, keeps current dictionary intact
  239. *
  240. ******* startup parmeters **************************
  241. *
  242. FDB $6800,0000 cpu & revision
  243. FDB 0 topmost word in FORTH vocabulary
  244. BACKSP FDB $7F backspace character for editing
  245. UPINIT FDB UORIG initial user area
  246. SINIT FDB ORIG-$D0 initial top of data stack
  247. RINIT FDB ORIG-2 initial top of return stack
  248. FDB ORIG-$D0 terminal input buffer
  249. FDB 31 initial name field width
  250. FDB 0 initial warning mode (0 = no disc)
  251. FENCIN FDB REND initial fence
  252. DPINIT FDB REND cold start value for DP
  253. VOCINT FDB FORTH+8
  254. COLINT FDB 132 initial terminal carriage width
  255. DELINT FDB 4 initial carriage return delay
  256. ****************************************************
  257. *
  258. PAGE
  259. *
  260. * ######>> screen 13 <<
  261. PULABX PULS A ; 24 cycles until 'NEXT'
  262. PULS B ;
  263. STABX STA 0,X 16 cycles until 'NEXT'
  264. STB 1,X
  265. BRA NEXT
  266. GETX LDA 0,X 18 cycles until 'NEXT'
  267. LDB 1,X
  268. PUSHBA PSHS B ; 8 cycles until 'NEXT'
  269. PSHS A ;
  270. *
  271. * "NEXT" takes 38 cycles if TRACE is removed,
  272. *
  273. * and 95 cycles if NOT tracing.
  274. *
  275. * = = = = = = = t h e v i r t u a l m a c h i n e = = = = =
  276. * =
  277. NEXT LDX IP
  278. LEAX 1,X ; pre-increment mode
  279. LEAX 1,X ;
  280. STX IP
  281. NEXT2 LDX 0,X get W which points to CFA of word to be done
  282. NEXT3 STX W
  283. LDX 0,X get VECT which points to executable code
  284. * =
  285. * The next instruction could be patched to JMP TRACE =
  286. * if a TRACE routine is available: =
  287. * =
  288. JMP 0,X
  289. NOP
  290. * JMP TRACE ( an alternate for the above )
  291. * =
  292. * = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
  293. PAGE
  294. *
  295. * ======>> 1 <<
  296. FCB $83
  297. FCC 'LI' ; 'LIT' : NOTE: this is different from LITERAL
  298. FCB $D4
  299. FDB 0 link of zero to terminate dictionary scan
  300. LIT FDB *+2
  301. LDX IP
  302. LEAX 1,X ;
  303. LEAX 1,X ;
  304. STX IP
  305. LDA 0,X
  306. LDB 1,X
  307. JMP PUSHBA
  308. *
  309. * ######>> screen 14 <<
  310. * ======>> 2 <<
  311. CLITER FDB *+2 (this is an invisible word, with no header)
  312. LDX IP
  313. LEAX 1,X ;
  314. STX IP
  315. CLRA ;
  316. LDB 1,X
  317. JMP PUSHBA
  318. *
  319. * ======>> 3 <<
  320. FCB $87
  321. FCC 'EXECUT' ; 'EXECUTE'
  322. FCB $C5
  323. FDB LIT-6
  324. EXEC FDB *+2
  325. TFR S,X ; TSX :
  326. LDX 0,X get code field address (CFA)
  327. LEAS 1,S ; pop stack
  328. LEAS 1,S ;
  329. JMP NEXT3
  330. *
  331. * ######>> screen 15 <<
  332. * ======>> 4 <<
  333. FCB $86
  334. FCC 'BRANC' ; 'BRANCH'
  335. FCB $C8
  336. FDB EXEC-10
  337. BRAN FDB ZBYES Go steal code in ZBRANCH
  338. *
  339. * ======>> 5 <<
  340. FCB $87
  341. FCC '0BRANC' ; '0BRANCH'
  342. FCB $C8
  343. FDB BRAN-9
  344. ZBRAN FDB *+2
  345. PULS A ;
  346. PULS B ;
  347. PSHS B ; ** emulating ABA:
  348. ADDA ,S+ ;
  349. BNE ZBNO
  350. BCS ZBNO
  351. ZBYES LDX IP Note: code is shared with BRANCH, (+LOOP), (LOOP)
  352. LDB 3,X
  353. LDA 2,X
  354. ADDB IP+1
  355. ADCA IP
  356. STB IP+1
  357. STA IP
  358. JMP NEXT
  359. ZBNO LDX IP no branch. This code is shared with (+LOOP), (LOOP).
  360. LEAX 1,X ; jump over branch delta
  361. LEAX 1,X ;
  362. STX IP
  363. JMP NEXT
  364. *
  365. * ######>> screen 16 <<
  366. * ======>> 6 <<
  367. FCB $86
  368. FCC '(LOOP' ; '(LOOP)'
  369. FCB $A9
  370. FDB ZBRAN-10
  371. XLOOP FDB *+2
  372. CLRA ;
  373. LDB #1 get set to increment counter by 1
  374. BRA XPLOP2 go steal other guy's code!
  375. *
  376. * ======>> 7 <<
  377. FCB $87
  378. FCC '(+LOOP' ; '(+LOOP)'
  379. FCB $A9
  380. FDB XLOOP-9
  381. XPLOOP FDB *+2 Note: +LOOP has an un-signed loop counter
  382. PULS A ; get increment
  383. PULS B ;
  384. XPLOP2 TSTA ;
  385. BPL XPLOF forward looping
  386. BSR XPLOPS
  387. ORCC #$01 ; SEC :
  388. SBCB 5,X
  389. SBCA 4,X
  390. BPL ZBYES
  391. BRA XPLONO fall through
  392. *
  393. * the subroutine :
  394. XPLOPS LDX RP
  395. ADDB 3,X add it to counter
  396. ADCA 2,X
  397. STB 3,X store new counter value
  398. STA 2,X
  399. RTS
  400. *
  401. XPLOF BSR XPLOPS
  402. SUBB 5,X
  403. SBCA 4,X
  404. BMI ZBYES
  405. *
  406. XPLONO LEAX 1,X ; done, don't branch back
  407. LEAX 1,X ;
  408. LEAX 1,X ;
  409. LEAX 1,X ;
  410. STX RP
  411. BRA ZBNO use ZBRAN to skip over unused delta
  412. *
  413. * ######>> screen 17 <<
  414. * ======>> 8 <<
  415. FCB $84
  416. FCC '(DO' ; '(DO)'
  417. FCB $A9
  418. FDB XPLOOP-10
  419. XDO FDB *+2 This is the RUNTIME DO, not the COMPILING DO
  420. LDX RP
  421. LEAX -1,X ;
  422. LEAX -1,X ;
  423. LEAX -1,X ;
  424. LEAX -1,X ;
  425. STX RP
  426. PULS A ;
  427. PULS B ;
  428. STA 2,X
  429. STB 3,X
  430. PULS A ;
  431. PULS B ;
  432. STA 4,X
  433. STB 5,X
  434. JMP NEXT
  435. *
  436. * ======>> 9 <<
  437. FCB $81 I
  438. FCB $C9
  439. FDB XDO-7
  440. I FDB *+2
  441. LDX RP
  442. LEAX 1,X ;
  443. LEAX 1,X ;
  444. JMP GETX
  445. *
  446. * ######>> screen 18 <<
  447. * ======>> 10 <<
  448. FCB $85
  449. FCC 'DIGI' ; 'DIGIT'
  450. FCB $D4
  451. FDB I-4
  452. DIGIT FDB *+2 NOTE: legal input range is 0-9, A-Z
  453. TFR S,X ; TSX :
  454. LDA 3,X
  455. SUBA #$30 ascii zero
  456. BMI DIGIT2 IF LESS THAN '0', ILLEGAL
  457. CMPA #$A
  458. BMI DIGIT0 IF '9' OR LESS
  459. CMPA #$11
  460. BMI DIGIT2 if less than 'A'
  461. CMPA #$2B
  462. BPL DIGIT2 if greater than 'Z'
  463. SUBA #7 translate 'A' thru 'F'
  464. DIGIT0 CMPA 1,X
  465. BPL DIGIT2 if not less than the base
  466. LDB #1 set flag
  467. STA 3,X store digit
  468. DIGIT1 STB 1,X store the flag
  469. JMP NEXT
  470. DIGIT2 CLRB ;
  471. LEAS 1,S ;
  472. LEAS 1,S ; pop bottom number
  473. TFR S,X ; TSX :
  474. STB 0,X make sure both bytes are 00
  475. BRA DIGIT1
  476. *
  477. * ######>> screen 19 <<
  478. *
  479. * The word format in the dictionary is:
  480. *
  481. * char-count + $80 lowest address
  482. * char 1
  483. * char 2
  484. *
  485. * char n + $80
  486. * link high byte \___point to previous word
  487. * link low byte /
  488. * CFA high byte \___pnt to 6800 code
  489. * CFA low byte /
  490. * parameter fields
  491. * "
  492. * "
  493. * "
  494. *
  495. * ======>> 11 <<
  496. FCB $86
  497. FCC '(FIND' ; '(FIND)'
  498. FCB $A9
  499. FDB DIGIT-8
  500. PFIND FDB *+2
  501. NOP
  502. NOP
  503. PD EQU N ptr to dict word being checked
  504. PA0 EQU N+2
  505. PA EQU N+4
  506. PC EQU N+6
  507. LDX #PD
  508. LDB #4
  509. PFIND0 PULS A ; loop to get arguments
  510. STA 0,X
  511. LEAX 1,X ;
  512. DECB ;
  513. BNE PFIND0
  514. *
  515. LDX PD
  516. PFIND1 LDB 0,X get count dict count
  517. STB PC
  518. ANDB #$3F
  519. LEAX 1,X ;
  520. STX PD update PD
  521. LDX PA0
  522. LDA 0,X get count from arg
  523. LEAX 1,X ;
  524. STX PA intialize PA
  525. PSHS B ; ** emulating CBA:
  526. CMPA ,S+ ; compare lengths
  527. BNE PFIND4
  528. PFIND2 LDX PA
  529. LDA 0,X
  530. LEAX 1,X ;
  531. STX PA
  532. LDX PD
  533. LDB 0,X
  534. LEAX 1,X ;
  535. STX PD
  536. TSTB ; is dict entry neg. ?
  537. BPL PFIND8
  538. ANDB #$7F clear sign
  539. PSHS B ; ** emulating CBA:
  540. CMPA ,S+ ;
  541. BEQ FOUND
  542. PFIND3 LDX 0,X get new link
  543. BNE PFIND1 continue if link not=0
  544. *
  545. * not found :
  546. *
  547. CLRA ;
  548. CLRB ;
  549. JMP PUSHBA
  550. PFIND8 PSHS B ; ** emulating CBA:
  551. CMPA ,S+ ;
  552. BEQ PFIND2
  553. PFIND4 LDX PD
  554. PFIND9 LDB 0,X scan forward to end of this name
  555. LEAX 1,X ;
  556. BPL PFIND9
  557. BRA PFIND3
  558. *
  559. * found :
  560. *
  561. FOUND LDA PD compute CFA
  562. LDB PD+1
  563. ADDB #4
  564. ADCA #0
  565. PSHS B ;
  566. PSHS A ;
  567. LDA PC
  568. PSHS A ;
  569. CLRA ;
  570. PSHS A ;
  571. LDB #1
  572. JMP PUSHBA
  573. *
  574. PSHS A ;
  575. CLRA ;
  576. PSHS A ;
  577. LDB #1
  578. JMP PUSHBA
  579. *
  580. * ######>> screen 20 <<
  581. * ======>> 12 <<
  582. FCB $87
  583. FCC 'ENCLOS' ; 'ENCLOSE'
  584. FCB $C5
  585. FDB PFIND-9
  586. * NOTE :
  587. * FC means offset (bytes) to First Character of next word
  588. * EW " " to End of Word
  589. * NC " " to Next Character to start next enclose at
  590. ENCLOS FDB *+2
  591. LEAS 1,S ;
  592. PULS B ; now, get the low byte, for an 8-bit delimiter
  593. TFR S,X ; TSX :
  594. LDX 0,X
  595. CLR N
  596. * wait for a non-delimiter or a NUL
  597. ENCL2 LDA 0,X
  598. BEQ ENCL6
  599. PSHS B ; ** emulating CBA:
  600. CMPA ,S+ ; CHECK FOR DELIM
  601. BNE ENCL3
  602. LEAX 1,X ;
  603. INC N
  604. BRA ENCL2
  605. * found first character. Push FC
  606. ENCL3 LDA N found first char.
  607. PSHS A ;
  608. CLRA ;
  609. PSHS A ;
  610. * wait for a delimiter or a NUL
  611. ENCL4 LDA 0,X
  612. BEQ ENCL7
  613. PSHS B ; ** emulating CBA:
  614. CMPA ,S+ ; ckech for delim.
  615. BEQ ENCL5
  616. LEAX 1,X ;
  617. INC N
  618. BRA ENCL4
  619. * found EW. Push it
  620. ENCL5 LDB N
  621. CLRA ;
  622. PSHS B ;
  623. PSHS A ;
  624. * advance and push NC
  625. INCB ;
  626. JMP PUSHBA
  627. * found NUL before non-delimiter, therefore there is no word
  628. ENCL6 LDB N found NUL
  629. PSHS B ;
  630. PSHS A ;
  631. INCB ;
  632. BRA ENCL7+2
  633. * found NUL following the word instead of SPACE
  634. ENCL7 LDB N
  635. PSHS B ; save EW
  636. PSHS A ;
  637. ENCL8 LDB N save NC
  638. JMP PUSHBA
  639. PAGE
  640. *
  641. * ######>> screen 21 <<
  642. * The next 4 words call system dependant I/O routines
  643. * which are listed after word "-->" ( lable: "arrow" )
  644. * in the dictionary.
  645. *
  646. * ======>> 13 <<
  647. FCB $84
  648. FCC 'EMI' ; 'EMIT'
  649. FCB $D4
  650. FDB ENCLOS-10
  651. EMIT FDB *+2
  652. PULS A ;
  653. PULS A ;
  654. JSR PEMIT
  655. LDX UP
  656. INC XOUT+1-UORIG,X
  657. BNE *+4 ;
  658. ****WARNING**** HARD OFFSET: *+4 ****
  659. INC XOUT-UORIG,X
  660. JMP NEXT
  661. *
  662. * ======>> 14 <<
  663. FCB $83
  664. FCC 'KE' ; 'KEY'
  665. FCB $D9
  666. FDB EMIT-7
  667. KEY FDB *+2
  668. JSR PKEY
  669. PSHS A ;
  670. CLRA ;
  671. PSHS A ;
  672. JMP NEXT
  673. *
  674. * ======>> 15 <<
  675. FCB $89
  676. FCC '?TERMINA' ; '?TERMINAL'
  677. FCB $CC
  678. FDB KEY-6
  679. QTERM FDB *+2
  680. JSR PQTER
  681. CLRB ;
  682. JMP PUSHBA stack the flag
  683. *
  684. * ======>> 16 <<
  685. FCB $82
  686. FCC 'C' ; 'CR'
  687. FCB $D2
  688. FDB QTERM-12
  689. CR FDB *+2
  690. JSR PCR
  691. JMP NEXT
  692. *
  693. * ######>> screen 22 <<
  694. * ======>> 17 <<
  695. FCB $85
  696. FCC 'CMOV' ; 'CMOVE' : source, destination, count
  697. FCB $C5
  698. FDB CR-5
  699. CMOVE FDB *+2 takes ( 43+47*count cycles )
  700. LDX #N
  701. LDB #6
  702. CMOV1 PULS A ;
  703. STA 0,X move parameters to scratch area
  704. LEAX 1,X ;
  705. DECB ;
  706. BNE CMOV1
  707. CMOV2 LDA N
  708. LDB N+1
  709. SUBB #1
  710. SBCA #0
  711. STA N
  712. STB N+1
  713. BCS CMOV3
  714. LDX N+4
  715. LDA 0,X
  716. LEAX 1,X ;
  717. STX N+4
  718. LDX N+2
  719. STA 0,X
  720. LEAX 1,X ;
  721. STX N+2
  722. BRA CMOV2
  723. CMOV3 JMP NEXT
  724. *
  725. * ######>> screen 23 <<
  726. * ======>> 18 <<
  727. FCB $82
  728. FCC 'U' ; 'U*'
  729. FCB $AA
  730. FDB CMOVE-8
  731. USTAR FDB *+2
  732. BSR USTARS
  733. LEAS 1,S ;
  734. LEAS 1,S ;
  735. JMP PUSHBA
  736. *
  737. * The following is a subroutine which
  738. * multiplies top 2 words on stack,
  739. * leaving 32-bit result: high order word in A,B
  740. * low order word in 2nd word of stack.
  741. *
  742. USTARS LDA #16 bits/word counter
  743. PSHS A ;
  744. CLRA ;
  745. CLRB ;
  746. TFR S,X ; TSX :
  747. USTAR2 ROR 5,X shift multiplier
  748. ROR 6,X
  749. DEC 0,X done?
  750. BMI USTAR4
  751. BCC USTAR3
  752. ADDB 4,X
  753. ADCA 3,X
  754. USTAR3 RORA ;
  755. RORB ; shift result
  756. BRA USTAR2
  757. USTAR4 LEAS 1,S ; dump counter
  758. RTS
  759. *
  760. * ######>> screen 24 <<
  761. * ======>> 19 <<
  762. FCB $82
  763. FCC 'U' ; 'U/'
  764. FCB $AF
  765. FDB USTAR-5
  766. USLASH FDB *+2
  767. LDA #17
  768. PSHS A ;
  769. TFR S,X ; TSX :
  770. LDA 3,X
  771. LDB 4,X
  772. USL1 CMPA 1,X
  773. BHI USL3
  774. BCS USL2
  775. CMPB 2,X
  776. BCC USL3
  777. USL2 ANDCC #~$01 ; CLC :
  778. BRA USL4
  779. USL3 SUBB 2,X
  780. SBCA 1,X
  781. ORCC #$01 ; SEC :
  782. USL4 ROL 6,X
  783. ROL 5,X
  784. DEC 0,X
  785. BEQ USL5
  786. ROLB ;
  787. ROLA ;
  788. BCC USL1
  789. BRA USL3
  790. USL5 LEAS 1,S ;
  791. LEAS 1,S ;
  792. LEAS 1,S ;
  793. LEAS 1,S ;
  794. LEAS 1,S ;
  795. JMP SWAP+4 reverse quotient & remainder
  796. *
  797. * ######>> screen 25 <<
  798. * ======>> 20 <<
  799. FCB $83
  800. FCC 'AN' ; 'AND'
  801. FCB $C4
  802. FDB USLASH-5
  803. AND FDB *+2
  804. PULS A ;
  805. PULS B ;
  806. TFR S,X ; TSX :
  807. ANDB 1,X
  808. ANDA 0,X
  809. JMP STABX
  810. *
  811. * ======>> 21 <<
  812. FCB $82
  813. FCC 'O' ; 'OR'
  814. FCB $D2
  815. FDB AND-6
  816. OR FDB *+2
  817. PULS A ;
  818. PULS B ;
  819. TFR S,X ; TSX :
  820. ORB 1,X
  821. ORA 0,X
  822. JMP STABX
  823. *
  824. * ======>> 22 <<
  825. FCB $83
  826. FCC 'XO' ; 'XOR'
  827. FCB $D2
  828. FDB OR-5
  829. XOR FDB *+2
  830. PULS A ;
  831. PULS B ;
  832. TFR S,X ; TSX :
  833. EORB 1,X
  834. EORA 0,X
  835. JMP STABX
  836. *
  837. * ######>> screen 26 <<
  838. * ======>> 23 <<
  839. FCB $83
  840. FCC 'SP' ; 'SP@'
  841. FCB $C0
  842. FDB XOR-6
  843. SPAT FDB *+2
  844. TFR S,X ; TSX :
  845. STX N scratch area
  846. LDX #N
  847. JMP GETX
  848. *
  849. * ======>> 24 <<
  850. FCB $83
  851. FCC 'SP' ; 'SP!'
  852. FCB $A1
  853. FDB SPAT-6
  854. SPSTOR FDB *+2
  855. LDX UP
  856. LDX XSPZER-UORIG,X
  857. TFR X,S ; TXS : watch it ! X and S are not equal.
  858. JMP NEXT
  859. * ======>> 25 <<
  860. FCB $83
  861. FCC 'RP' ; 'RP!'
  862. FCB $A1
  863. FDB SPSTOR-6
  864. RPSTOR FDB *+2
  865. LDX RINIT initialize from rom constant
  866. STX RP
  867. JMP NEXT
  868. *
  869. * ======>> 26 <<
  870. FCB $82
  871. FCC ';' ; ';S'
  872. FCB $D3
  873. FDB RPSTOR-6
  874. SEMIS FDB *+2
  875. LDX RP
  876. LEAX 1,X ;
  877. LEAX 1,X ;
  878. STX RP
  879. LDX 0,X get address we have just finished.
  880. JMP NEXT+2 increment the return address & do next word
  881. *
  882. * ######>> screen 27 <<
  883. * ======>> 27 <<
  884. FCB $85
  885. FCC 'LEAV' ; 'LEAVE'
  886. FCB $C5
  887. FDB SEMIS-5
  888. LEAVE FDB *+2
  889. LDX RP
  890. LDA 2,X
  891. LDB 3,X
  892. STA 4,X
  893. STB 5,X
  894. JMP NEXT
  895. *
  896. * ======>> 28 <<
  897. FCB $82
  898. FCC '>' ; '>R'
  899. FCB $D2
  900. FDB LEAVE-8
  901. TOR FDB *+2
  902. LDX RP
  903. LEAX -1,X ;
  904. LEAX -1,X ;
  905. STX RP
  906. PULS A ;
  907. PULS B ;
  908. STA 2,X
  909. STB 3,X
  910. JMP NEXT
  911. *
  912. * ======>> 29 <<
  913. FCB $82
  914. FCC 'R' ; 'R>'
  915. FCB $BE
  916. FDB TOR-5
  917. FROMR FDB *+2
  918. LDX RP
  919. LDA 2,X
  920. LDB 3,X
  921. LEAX 1,X ;
  922. LEAX 1,X ;
  923. STX RP
  924. JMP PUSHBA
  925. *
  926. * ======>> 30 <<
  927. FCB $81 R
  928. FCB $D2
  929. FDB FROMR-5
  930. R FDB *+2
  931. LDX RP
  932. LEAX 1,X ;
  933. LEAX 1,X ;
  934. JMP GETX
  935. *
  936. * ######>> screen 28 <<
  937. * ======>> 31 <<
  938. FCB $82
  939. FCC '0' ; '0='
  940. FCB $BD
  941. FDB R-4
  942. ZEQU FDB *+2
  943. TFR S,X ; TSX :
  944. CLRA ;
  945. CLRB ;
  946. LDX 0,X
  947. BNE ZEQU2
  948. INCB ;
  949. ZEQU2 TFR S,X ; TSX :
  950. JMP STABX
  951. *
  952. * ======>> 32 <<
  953. FCB $82
  954. FCC '0' ; '0<'
  955. FCB $BC
  956. FDB ZEQU-5
  957. ZLESS FDB *+2
  958. TFR S,X ; TSX :
  959. LDA #$80 check the sign bit
  960. ANDA 0,X
  961. BEQ ZLESS2
  962. CLRA ; if neg.
  963. LDB #1
  964. JMP STABX
  965. ZLESS2 CLRB ;
  966. JMP STABX
  967. *
  968. * ######>> screen 29 <<
  969. * ======>> 33 <<
  970. FCB $81 '+'
  971. FCB $AB
  972. FDB ZLESS-5
  973. PLUS FDB *+2
  974. PULS A ;
  975. PULS B ;
  976. TFR S,X ; TSX :
  977. ADDB 1,X
  978. ADCA 0,X
  979. JMP STABX
  980. *
  981. * ======>> 34 <<
  982. FCB $82
  983. FCC 'D' ; 'D+'
  984. FCB $AB
  985. FDB PLUS-4
  986. DPLUS FDB *+2
  987. TFR S,X ; TSX :
  988. ANDCC #~$01 ; CLC :
  989. LDB #4
  990. DPLUS2 LDA 3,X
  991. ADCA 7,X
  992. STA 7,X
  993. LEAX -1,X ;
  994. DECB ;
  995. BNE DPLUS2
  996. LEAS 1,S ;
  997. LEAS 1,S ;
  998. LEAS 1,S ;
  999. LEAS 1,S ;
  1000. JMP NEXT
  1001. *
  1002. * ======>> 35 <<
  1003. FCB $85
  1004. FCC 'MINU' ; 'MINUS'
  1005. FCB $D3
  1006. FDB DPLUS-5
  1007. MINUS FDB *+2
  1008. TFR S,X ; TSX :
  1009. NEG 1,X
  1010. BCC MINUS2
  1011. NEG 0,X
  1012. BRA MINUS3
  1013. MINUS2 COM 0,X
  1014. MINUS3 JMP NEXT
  1015. *
  1016. * ======>> 36 <<
  1017. FCB $86
  1018. FCC 'DMINU' ; 'DMINUS'
  1019. FCB $D3
  1020. FDB MINUS-8
  1021. DMINUS FDB *+2
  1022. TFR S,X ; TSX :
  1023. COM 0,X
  1024. COM 1,X
  1025. COM 2,X
  1026. NEG 3,X
  1027. BNE DMINX
  1028. INC 2,X
  1029. BNE DMINX
  1030. INC 1,X
  1031. BNE DMINX
  1032. INC 0,X
  1033. DMINX JMP NEXT
  1034. *
  1035. * ######>> screen 30 <<
  1036. * ======>> 37 <<
  1037. FCB $84
  1038. FCC 'OVE' ; 'OVER'
  1039. FCB $D2
  1040. FDB DMINUS-9
  1041. OVER FDB *+2
  1042. TFR S,X ; TSX :
  1043. LDA 2,X
  1044. LDB 3,X
  1045. JMP PUSHBA
  1046. *
  1047. * ======>> 38 <<
  1048. FCB $84
  1049. FCC 'DRO' ; 'DROP'
  1050. FCB $D0
  1051. FDB OVER-7
  1052. DROP FDB *+2
  1053. LEAS 1,S ;
  1054. LEAS 1,S ;
  1055. JMP NEXT
  1056. *
  1057. * ======>> 39 <<
  1058. FCB $84
  1059. FCC 'SWA' ; 'SWAP'
  1060. FCB $D0
  1061. FDB DROP-7
  1062. SWAP FDB *+2
  1063. PULS A ;
  1064. PULS B ;
  1065. TFR S,X ; TSX :
  1066. LDX 0,X
  1067. LEAS 1,S ;
  1068. LEAS 1,S ;
  1069. PSHS B ;
  1070. PSHS A ;
  1071. STX N
  1072. LDX #N
  1073. JMP GETX
  1074. *
  1075. * ======>> 40 <<
  1076. FCB $83
  1077. FCC 'DU' ; 'DUP'
  1078. FCB $D0
  1079. FDB SWAP-7
  1080. DUP FDB *+2
  1081. PULS A ;
  1082. PULS B ;
  1083. PSHS B ;
  1084. PSHS A ;
  1085. JMP PUSHBA
  1086. *
  1087. * ######>> screen 31 <<
  1088. * ======>> 41 <<
  1089. FCB $82
  1090. FCC '+' ; '+!'
  1091. FCB $A1
  1092. FDB DUP-6
  1093. PSTORE FDB *+2
  1094. TFR S,X ; TSX :
  1095. LDX 0,X
  1096. LEAS 1,S ;
  1097. LEAS 1,S ;
  1098. PULS A ; get stack data
  1099. PULS B ;
  1100. ADDB 1,X add & store low byte
  1101. STB 1,X
  1102. ADCA 0,X add & store hi byte
  1103. STA 0,X
  1104. JMP NEXT
  1105. *
  1106. * ======>> 42 <<
  1107. FCB $86
  1108. FCC 'TOGGL' ; 'TOGGLE'
  1109. FCB $C5
  1110. FDB PSTORE-5
  1111. TOGGLE FDB DOCOL,OVER,CAT,XOR,SWAP,CSTORE
  1112. FDB SEMIS
  1113. *
  1114. * ######>> screen 32 <<
  1115. * ======>> 43 <<
  1116. FCB $81 @
  1117. FCB $C0
  1118. FDB TOGGLE-9
  1119. AT FDB *+2
  1120. TFR S,X ; TSX :
  1121. LDX 0,X get address
  1122. LEAS 1,S ;
  1123. LEAS 1,S ;
  1124. JMP GETX
  1125. *
  1126. * ======>> 44 <<
  1127. FCB $82
  1128. FCC 'C' ; 'C@'
  1129. FCB $C0
  1130. FDB AT-4
  1131. CAT FDB *+2
  1132. TFR S,X ; TSX :
  1133. LDX 0,X
  1134. CLRA ;
  1135. LDB 0,X
  1136. LEAS 1,S ;
  1137. LEAS 1,S ;
  1138. JMP PUSHBA
  1139. *
  1140. * ======>> 45 <<
  1141. FCB $81
  1142. FCB $A1
  1143. FDB CAT-5
  1144. STORE FDB *+2
  1145. TFR S,X ; TSX :
  1146. LDX 0,X get address
  1147. LEAS 1,S ;
  1148. LEAS 1,S ;
  1149. JMP PULABX
  1150. *
  1151. * ======>> 46 <<
  1152. FCB $82
  1153. FCC 'C' ; 'C!'
  1154. FCB $A1
  1155. FDB STORE-4
  1156. CSTORE FDB *+2
  1157. TFR S,X ; TSX :
  1158. LDX 0,X get address
  1159. LEAS 1,S ;
  1160. LEAS 1,S ;
  1161. LEAS 1,S ;
  1162. PULS B ;
  1163. STB 0,X
  1164. JMP NEXT
  1165. PAGE
  1166. *
  1167. * ######>> screen 33 <<
  1168. * ======>> 47 <<
  1169. FCB $C1 : immediate
  1170. FCB $BA
  1171. FDB CSTORE-5
  1172. COLON FDB DOCOL,QEXEC,SCSP,CURENT,AT,CONTXT,STORE
  1173. FDB CREATE,RBRAK
  1174. FDB PSCODE
  1175. * Here is the IP pusher for allowing
  1176. * nested words in the virtual machine:
  1177. * ( ;S is the equivalent un-nester )
  1178. DOCOL LDX RP make room in the stack
  1179. LEAX -1,X ;
  1180. LEAX -1,X ;
  1181. STX RP
  1182. LDA IP
  1183. LDB IP+1
  1184. STA 2,X Store address of the high level word
  1185. STB 3,X that we are starting to execute
  1186. LDX W Get first sub-word of that definition
  1187. JMP NEXT+2 and execute it
  1188. *
  1189. * ======>> 48 <<
  1190. FCB $C1 ; imnediate code
  1191. FCB $BB
  1192. FDB COLON-4
  1193. SEMI FDB DOCOL,QCSP,COMPIL,SEMIS,SMUDGE,LBRAK
  1194. FDB SEMIS
  1195. *
  1196. * ######>> screen 34 <<
  1197. * ======>> 49 <<
  1198. FCB $88
  1199. FCC 'CONSTAN' ; 'CONSTANT'
  1200. FCB $D4
  1201. FDB SEMI-4
  1202. CON FDB DOCOL,CREATE,SMUDGE,COMMA,PSCODE
  1203. DOCON LDX W
  1204. LDA 2,X
  1205. LDB 3,X A & B now contain the constant
  1206. JMP PUSHBA
  1207. *
  1208. * ======>> 50 <<
  1209. FCB $88
  1210. FCC 'VARIABL' ; 'VARIABLE'
  1211. FCB $C5
  1212. FDB CON-11
  1213. VAR FDB DOCOL,CON,PSCODE
  1214. DOVAR LDA W
  1215. LDB W+1
  1216. ADDB #2
  1217. ADCA #0 A,B now contain the address of the variable
  1218. JMP PUSHBA
  1219. *
  1220. * ======>> 51 <<
  1221. FCB $84
  1222. FCC 'USE' ; 'USER'
  1223. FCB $D2
  1224. FDB VAR-11
  1225. USER FDB DOCOL,CON,PSCODE
  1226. DOUSER LDX W get offset into user's table
  1227. LDA 2,X
  1228. LDB 3,X
  1229. ADDB UP+1 add to users base address
  1230. ADCA UP
  1231. JMP PUSHBA push address of user's variable
  1232. *
  1233. * ######>> screen 35 <<
  1234. * ======>> 52 <<
  1235. FCB $81
  1236. FCB $B0 0
  1237. FDB USER-7
  1238. ZERO FDB DOCON
  1239. FDB 0000
  1240. *
  1241. * ======>> 53 <<
  1242. FCB $81
  1243. FCB $B1 1
  1244. FDB ZERO-4
  1245. ONE FDB DOCON
  1246. FDB 1
  1247. *
  1248. * ======>> 54 <<
  1249. FCB $81
  1250. FCB $B2 2
  1251. FDB ONE-4
  1252. TWO FDB DOCON
  1253. FDB 2
  1254. *
  1255. * ======>> 55 <<
  1256. FCB $81
  1257. FCB $B3 3
  1258. FDB TWO-4
  1259. THREE FDB DOCON
  1260. FDB 3
  1261. *
  1262. * ======>> 56 <<
  1263. FCB $82
  1264. FCC 'B' ; 'BL'
  1265. FCB $CC
  1266. FDB THREE-4
  1267. BL FDB DOCON ascii blank
  1268. FDB $20
  1269. *
  1270. * ======>> 57 <<
  1271. FCB $85
  1272. FCC 'FIRS' ; 'FIRST'
  1273. FCB $D4
  1274. FDB BL-5
  1275. FIRST FDB DOCON
  1276. FDB MEMEND-528 (132 * NBLK)
  1277. *
  1278. * ======>> 58 <<
  1279. FCB $85
  1280. FCC 'LIMI' ; 'LIMIT' : ( the end of memory +1 )
  1281. FCB $D4
  1282. FDB FIRST-8
  1283. LIMIT FDB DOCON
  1284. FDB MEMEND
  1285. *
  1286. * ======>> 59 <<
  1287. FCB $85
  1288. FCC 'B/BU' ; 'B/BUF' : (bytes/buffer)
  1289. FCB $C6
  1290. FDB LIMIT-8
  1291. BBUF FDB DOCON
  1292. FDB 128
  1293. *
  1294. * ======>> 60 <<
  1295. FCB $85
  1296. FCC 'B/SC' ; 'B/SCR' : (blocks/screen)
  1297. FCB $D2
  1298. FDB BBUF-8
  1299. BSCR FDB DOCON
  1300. FDB 8
  1301. * blocks/screen = 1024 / "B/BUF" = 8
  1302. *
  1303. * ======>> 61 <<
  1304. FCB $87
  1305. FCC '+ORIGI' ; '+ORIGIN'
  1306. FCB $CE
  1307. FDB BSCR-8
  1308. PORIG FDB DOCOL,LIT,ORIG,PLUS
  1309. FDB SEMIS
  1310. *
  1311. * ######>> screen 36 <<
  1312. * ======>> 62 <<
  1313. FCB $82
  1314. FCC 'S' ; 'S0'
  1315. FCB $B0
  1316. FDB PORIG-10
  1317. SZERO FDB DOUSER
  1318. FDB XSPZER-UORIG
  1319. *
  1320. * ======>> 63 <<
  1321. FCB $82
  1322. FCC 'R' ; 'R0'
  1323. FCB $B0
  1324. FDB SZERO-5
  1325. RZERO FDB DOUSER
  1326. FDB XRZERO-UORIG
  1327. *
  1328. * ======>> 64 <<
  1329. FCB $83
  1330. FCC 'TI' ; 'TIB'
  1331. FCB $C2
  1332. FDB RZERO-5
  1333. TIB FDB DOUSER
  1334. FDB XTIB-UORIG
  1335. *
  1336. * ======>> 65 <<
  1337. FCB $85
  1338. FCC 'WIDT' ; 'WIDTH'
  1339. FCB $C8
  1340. FDB TIB-6
  1341. WIDTH FDB DOUSER
  1342. FDB XWIDTH-UORIG
  1343. *
  1344. * ======>> 66 <<
  1345. FCB $87
  1346. FCC 'WARNIN' ; 'WARNING'
  1347. FCB $C7
  1348. FDB WIDTH-8
  1349. WARN FDB DOUSER
  1350. FDB XWARN-UORIG
  1351. *
  1352. * ======>> 67 <<
  1353. FCB $85
  1354. FCC 'FENC' ; 'FENCE'
  1355. FCB $C5
  1356. FDB WARN-10
  1357. FENCE FDB DOUSER
  1358. FDB XFENCE-UORIG
  1359. *
  1360. * ======>> 68 <<
  1361. FCB $82
  1362. FCC 'D' ; 'DP' : points to first free byte at end of dictionary
  1363. FCB $D0
  1364. FDB FENCE-8
  1365. DP FDB DOUSER
  1366. FDB XDP-UORIG
  1367. *
  1368. * ======>> 68.5 <<
  1369. FCB $88
  1370. FCC 'VOC-LIN' ; 'VOC-LINK'
  1371. FCB $CB
  1372. FDB DP-5
  1373. VOCLIN FDB DOUSER
  1374. FDB XVOCL-UORIG
  1375. *
  1376. * ======>> 69 <<
  1377. FCB $83
  1378. FCC 'BL' ; 'BLK'
  1379. FCB $CB
  1380. FDB VOCLIN-11
  1381. BLK FDB DOUSER
  1382. FDB XBLK-UORIG
  1383. *
  1384. * ======>> 70 <<
  1385. FCB $82
  1386. FCC 'I' ; 'IN' : scan pointer for input line buffer
  1387. FCB $CE
  1388. FDB BLK-6
  1389. IN FDB DOUSER
  1390. FDB XIN-UORIG
  1391. *
  1392. * ======>> 71 <<
  1393. FCB $83
  1394. FCC 'OU' ; 'OUT'
  1395. FCB $D4
  1396. FDB IN-5
  1397. OUT FDB DOUSER
  1398. FDB XOUT-UORIG
  1399. *
  1400. * ======>> 72 <<
  1401. FCB $83
  1402. FCC 'SC' ; 'SCR'
  1403. FCB $D2
  1404. FDB OUT-6
  1405. SCR FDB DOUSER
  1406. FDB XSCR-UORIG
  1407. * ######>> screen 37 <<
  1408. *
  1409. * ======>> 73 <<
  1410. FCB $86
  1411. FCC 'OFFSE' ; 'OFFSET'
  1412. FCB $D4
  1413. FDB SCR-6
  1414. OFSET FDB DOUSER
  1415. FDB XOFSET-UORIG
  1416. *
  1417. * ======>> 74 <<
  1418. FCB $87
  1419. FCC 'CONTEX' ; 'CONTEXT' : points to pointer to vocab to search first
  1420. FCB $D4
  1421. FDB OFSET-9
  1422. CONTXT FDB DOUSER
  1423. FDB XCONT-UORIG
  1424. *
  1425. * ======>> 75 <<
  1426. FCB $87
  1427. FCC 'CURREN' ; 'CURRENT' : points to ptr. to vocab being extended
  1428. FCB $D4
  1429. FDB CONTXT-10
  1430. CURENT FDB DOUSER
  1431. FDB XCURR-UORIG
  1432. *
  1433. * ======>> 76 <<
  1434. FCB $85
  1435. FCC 'STAT' ; 'STATE' : 1 if compiling, 0 if not
  1436. FCB $C5
  1437. FDB CURENT-10
  1438. STATE FDB DOUSER
  1439. FDB XSTATE-UORIG
  1440. *
  1441. * ======>> 77 <<
  1442. FCB $84
  1443. FCC 'BAS' ; 'BASE' : number base for all input & output
  1444. FCB $C5
  1445. FDB STATE-8
  1446. BASE FDB DOUSER
  1447. FDB XBASE-UORIG
  1448. *
  1449. * ======>> 78 <<
  1450. FCB $83
  1451. FCC 'DP' ; 'DPL'
  1452. FCB $CC
  1453. FDB BASE-7
  1454. DPL FDB DOUSER
  1455. FDB XDPL-UORIG
  1456. *
  1457. * ======>> 79 <<
  1458. FCB $83
  1459. FCC 'FL' ; 'FLD'
  1460. FCB $C4
  1461. FDB DPL-6
  1462. FLD FDB DOUSER
  1463. FDB XFLD-UORIG
  1464. *
  1465. * ======>> 80 <<
  1466. FCB $83
  1467. FCC 'CS' ; 'CSP'
  1468. FCB $D0
  1469. FDB FLD-6
  1470. CSP FDB DOUSER
  1471. FDB XCSP-UORIG
  1472. *
  1473. * ======>> 81 <<
  1474. FCB $82
  1475. FCC 'R' ; 'R#'
  1476. FCB $A3
  1477. FDB CSP-6
  1478. RNUM FDB DOUSER
  1479. FDB XRNUM-UORIG
  1480. *
  1481. * ======>> 82 <<
  1482. FCB $83
  1483. FCC 'HL' ; 'HLD'
  1484. FCB $C4
  1485. FDB RNUM-5
  1486. HLD FDB DOCON
  1487. FDB XHLD
  1488. *
  1489. * ======>> 82.5 <<== SPECIAL
  1490. FCB $87
  1491. FCC 'COLUMN' ; 'COLUMNS' : line width of terminal
  1492. FCB $D3
  1493. FDB HLD-6
  1494. COLUMS FDB DOUSER
  1495. FDB XCOLUM-UORIG
  1496. *
  1497. * ######>> screen 38 <<
  1498. * ======>> 83 <<
  1499. FCB $82
  1500. FCC '1' ; '1+'
  1501. FCB $AB
  1502. FDB COLUMS-10
  1503. ONEP FDB DOCOL,ONE,PLUS
  1504. FDB SEMIS
  1505. *
  1506. * ======>> 84 <<
  1507. FCB $82
  1508. FCC '2' ; '2+'
  1509. FCB $AB
  1510. FDB ONEP-5
  1511. TWOP FDB DOCOL,TWO,PLUS
  1512. FDB SEMIS
  1513. *
  1514. * ======>> 85 <<
  1515. FCB $84
  1516. FCC 'HER' ; 'HERE'
  1517. FCB $C5
  1518. FDB TWOP-5
  1519. HERE FDB DOCOL,DP,AT
  1520. FDB SEMIS
  1521. *
  1522. * ======>> 86 <<
  1523. FCB $85
  1524. FCC 'ALLO' ; 'ALLOT'
  1525. FCB $D4
  1526. FDB HERE-7
  1527. ALLOT FDB DOCOL,DP,PSTORE
  1528. FDB SEMIS
  1529. *
  1530. * ======>> 87 <<
  1531. FCB $81 ; , (COMMA)
  1532. FCB $AC
  1533. FDB ALLOT-8
  1534. COMMA FDB DOCOL,HERE,STORE,TWO,ALLOT
  1535. FDB SEMIS
  1536. *
  1537. * ======>> 88 <<
  1538. FCB $82
  1539. FCC 'C' ; 'C,'
  1540. FCB $AC
  1541. FDB COMMA-4
  1542. CCOMM FDB DOCOL,HERE,CSTORE,ONE,ALLOT
  1543. FDB SEMIS
  1544. *
  1545. * ======>> 89 <<
  1546. FCB $81 ; -
  1547. FCB $AD
  1548. FDB CCOMM-5
  1549. SUB FDB DOCOL,MINUS,PLUS
  1550. FDB SEMIS
  1551. *
  1552. * ======>> 90 <<
  1553. FCB $81 =
  1554. FCB $BD
  1555. FDB SUB-4
  1556. EQUAL FDB DOCOL,SUB,ZEQU
  1557. FDB SEMIS
  1558. *
  1559. * ======>> 91 <<
  1560. FCB $81 <
  1561. FCB $BC
  1562. FDB EQUAL-4
  1563. LESS FDB *+2
  1564. PULS A ;
  1565. PULS B ;
  1566. TFR S,X ; TSX :
  1567. CMPA 0,X
  1568. LEAS 1,S ;
  1569. BGT LESST
  1570. BNE LESSF
  1571. CMPB 1,X
  1572. BHI LESST
  1573. LESSF CLRB ;
  1574. BRA LESSX
  1575. LESST LDB #1
  1576. LESSX CLRA ;
  1577. LEAS 1,S ;
  1578. JMP PUSHBA
  1579. *
  1580. * ======>> 92 <<
  1581. FCB $81 >
  1582. FCB $BE
  1583. FDB LESS-4
  1584. GREAT FDB DOCOL,SWAP,LESS
  1585. FDB SEMIS
  1586. *
  1587. * ======>> 93 <<
  1588. FCB $83
  1589. FCC 'RO' ; 'ROT'
  1590. FCB $D4
  1591. FDB GREAT-4
  1592. ROT FDB DOCOL,TOR,SWAP,FROMR,SWAP
  1593. FDB SEMIS
  1594. *
  1595. * ======>> 94 <<
  1596. FCB $85
  1597. FCC 'SPAC' ; 'SPACE'
  1598. FCB $C5
  1599. FDB ROT-6
  1600. SPACE FDB DOCOL,BL,EMIT
  1601. FDB SEMIS
  1602. *
  1603. * ======>> 95 <<
  1604. FCB $83
  1605. FCC 'MI' ; 'MIN'
  1606. FCB $CE
  1607. FDB SPACE-8
  1608. MIN FDB DOCOL,OVER,OVER,GREAT,ZBRAN
  1609. FDB MIN2-*
  1610. FDB SWAP
  1611. MIN2 FDB DROP
  1612. FDB SEMIS
  1613. *
  1614. * ======>> 96 <<
  1615. FCB $83
  1616. FCC 'MA' ; 'MAX'
  1617. FCB $D8
  1618. FDB MIN-6
  1619. MAX FDB DOCOL,OVER,OVER,LESS,ZBRAN
  1620. FDB MAX2-*
  1621. FDB SWAP
  1622. MAX2 FDB DROP
  1623. FDB SEMIS
  1624. *
  1625. * ======>> 97 <<
  1626. FCB $84
  1627. FCC '-DU' ; '-DUP'
  1628. FCB $D0
  1629. FDB MAX-6
  1630. DDUP FDB DOCOL,DUP,ZBRAN
  1631. FDB DDUP2-*
  1632. FDB DUP
  1633. DDUP2 FDB SEMIS
  1634. *
  1635. * ######>> screen 39 <<
  1636. * ======>> 98 <<
  1637. FCB $88
  1638. FCC 'TRAVERS' ; 'TRAVERSE'
  1639. FCB $C5
  1640. FDB DDUP-7
  1641. TRAV FDB DOCOL,SWAP
  1642. TRAV2 FDB OVER,PLUS,CLITER
  1643. FCB $7F
  1644. FDB OVER,CAT,LESS,ZBRAN
  1645. FDB TRAV2-*
  1646. FDB SWAP,DROP
  1647. FDB SEMIS
  1648. *
  1649. * ======>> 99 <<
  1650. FCB $86
  1651. FCC 'LATES' ; 'LATEST'
  1652. FCB $D4
  1653. FDB TRAV-11
  1654. LATEST FDB DOCOL,CURENT,AT,AT
  1655. FDB SEMIS
  1656. *
  1657. * ======>> 100 <<
  1658. FCB $83
  1659. FCC 'LF' ; 'LFA'
  1660. FCB $C1
  1661. FDB LATEST-9
  1662. LFA FDB DOCOL,CLITER
  1663. FCB 4
  1664. FDB SUB
  1665. FDB SEMIS
  1666. *
  1667. * ======>> 101 <<
  1668. FCB $83
  1669. FCC 'CF' ; 'CFA'
  1670. FCB $C1
  1671. FDB LFA-6
  1672. CFA FDB DOCOL,TWO,SUB
  1673. FDB SEMIS
  1674. *
  1675. * ======>> 102 <<
  1676. FCB $83
  1677. FCC 'NF' ; 'NFA'
  1678. FCB $C1
  1679. FDB CFA-6
  1680. NFA FDB DOCOL,CLITER
  1681. FCB 5
  1682. FDB SUB,ONE,MINUS,TRAV
  1683. FDB SEMIS
  1684. *
  1685. * ======>> 103 <<
  1686. FCB $83
  1687. FCC 'PF' ; 'PFA'
  1688. FCB $C1
  1689. FDB NFA-6
  1690. PFA FDB DOCOL,ONE,TRAV,CLITER
  1691. FCB 5
  1692. FDB PLUS
  1693. FDB SEMIS
  1694. *
  1695. * ######>> screen 40 <<
  1696. * ======>> 104 <<
  1697. FCB $84
  1698. FCC '!CS' ; '!CSP'
  1699. FCB $D0
  1700. FDB PFA-6
  1701. SCSP FDB DOCOL,SPAT,CSP,STORE
  1702. FDB SEMIS
  1703. *
  1704. * ======>> 105 <<
  1705. FCB $86
  1706. FCC '?ERRO' ; '?ERROR'
  1707. FCB $D2
  1708. FDB SCSP-7
  1709. QERR FDB DOCOL,SWAP,ZBRAN
  1710. FDB QERR2-*
  1711. FDB ERROR,BRAN
  1712. FDB QERR3-*
  1713. QERR2 FDB DROP
  1714. QERR3 FDB SEMIS
  1715. *
  1716. * ======>> 106 <<
  1717. FCB $85
  1718. FCC '?COM' ; '?COMP'
  1719. FCB $D0
  1720. FDB QERR-9
  1721. QCOMP FDB DOCOL,STATE,AT,ZEQU,CLITER
  1722. FCB $11
  1723. FDB QERR
  1724. FDB SEMIS
  1725. *
  1726. * ======>> 107 <<
  1727. FCB $85
  1728. FCC '?EXE' ; '?EXEC'
  1729. FCB $C3
  1730. FDB QCOMP-8
  1731. QEXEC FDB DOCOL,STATE,AT,CLITER
  1732. FCB $12
  1733. FDB QERR
  1734. FDB SEMIS
  1735. *
  1736. * ======>> 108 <<
  1737. FCB $86
  1738. FCC '?PAIR' ; '?PAIRS'
  1739. FCB $D3
  1740. FDB QEXEC-8
  1741. QPAIRS FDB DOCOL,SUB,CLITER
  1742. FCB $13
  1743. FDB QERR
  1744. FDB SEMIS
  1745. *
  1746. * ======>> 109 <<
  1747. FCB $84
  1748. FCC '?CS' ; '?CSP'
  1749. FCB $D0
  1750. FDB QPAIRS-9
  1751. QCSP FDB DOCOL,SPAT,CSP,AT,SUB,CLITER
  1752. FCB $14
  1753. FDB QERR
  1754. FDB SEMIS
  1755. *
  1756. * ======>> 110 <<
  1757. FCB $88
  1758. FCC '?LOADIN' ; '?LOADING'
  1759. FCB $C7
  1760. FDB QCSP-7
  1761. QLOAD FDB DOCOL,BLK,AT,ZEQU,CLITER
  1762. FCB $16
  1763. FDB QERR
  1764. FDB SEMIS
  1765. *
  1766. * ######>> screen 41 <<
  1767. * ======>> 111 <<
  1768. FCB $87
  1769. FCC 'COMPIL' ; 'COMPILE'
  1770. FCB $C5
  1771. FDB QLOAD-11
  1772. COMPIL FDB DOCOL,QCOMP,FROMR,TWOP,DUP,TOR,AT,COMMA
  1773. FDB SEMIS
  1774. *
  1775. * ======>> 112 <<
  1776. FCB $C1 [ immediate
  1777. FCB $DB
  1778. FDB COMPIL-10
  1779. LBRAK FDB DOCOL,ZERO,STATE,STORE
  1780. FDB SEMIS
  1781. *
  1782. * ======>> 113 <<
  1783. FCB $81 ]
  1784. FCB $DD
  1785. FDB LBRAK-4
  1786. RBRAK FDB DOCOL,CLITER
  1787. FCB $C0
  1788. FDB STATE,STORE
  1789. FDB SEMIS
  1790. *
  1791. * ======>> 114 <<
  1792. FCB $86
  1793. FCC 'SMUDG' ; 'SMUDGE'
  1794. FCB $C5
  1795. FDB RBRAK-4
  1796. SMUDGE FDB DOCOL,LATEST,CLITER
  1797. FCB $20
  1798. FDB TOGGLE
  1799. FDB SEMIS
  1800. *
  1801. * ======>> 115 <<
  1802. FCB $83
  1803. FCC 'HE' ; 'HEX'
  1804. FCB $D8
  1805. FDB SMUDGE-9
  1806. HEX FDB DOCOL
  1807. FDB CLITER
  1808. FCB 16
  1809. FDB BASE,STORE
  1810. FDB SEMIS
  1811. *
  1812. * ======>> 116 <<
  1813. FCB $87
  1814. FCC 'DECIMA' ; 'DECIMAL'
  1815. FCB $CC
  1816. FDB HEX-6
  1817. DEC FDB DOCOL
  1818. FDB CLITER
  1819. FCB 10 note: hex "A"
  1820. FDB BASE,STORE
  1821. FDB SEMIS
  1822. *
  1823. * ######>> screen 42 <<
  1824. * ======>> 117 <<
  1825. FCB $87
  1826. FCC '(;CODE' ; '(;CODE)'
  1827. FCB $A9
  1828. FDB DEC-10
  1829. PSCODE FDB DOCOL,FROMR,TWOP,LATEST,PFA,CFA,STORE
  1830. FDB SEMIS
  1831. *
  1832. * ======>> 118 <<
  1833. FCB $C5 immediate
  1834. FCC ';COD' ; ';CODE'
  1835. FCB $C5
  1836. FDB PSCODE-10
  1837. SEMIC FDB DOCOL,QCSP,COMPIL,PSCODE,SMUDGE,LBRAK,QSTACK
  1838. FDB SEMIS
  1839. * note: "QSTACK" will be replaced by "ASSEMBLER" later
  1840. *
  1841. * ######>> screen 43 <<
  1842. * ======>> 119 <<
  1843. FCB $87
  1844. FCC '<BUILD' ; '<BUILDS'
  1845. FCB $D3
  1846. FDB SEMIC-8
  1847. BUILDS FDB DOCOL,ZERO,CON
  1848. FDB SEMIS
  1849. *
  1850. * ======>> 120 <<
  1851. FCB $85
  1852. FCC 'DOES' ; 'DOES>'
  1853. FCB $BE
  1854. FDB BUILDS-10
  1855. DOES FDB DOCOL,FROMR,TWOP,LATEST,PFA,STORE
  1856. FDB PSCODE
  1857. DODOES LDA IP
  1858. LDB IP+1
  1859. LDX RP make room on return stack
  1860. LEAX -1,X ;
  1861. LEAX -1,X ;
  1862. STX RP
  1863. STA 2,X push return address
  1864. STB 3,X
  1865. LDX W get addr of pointer to run-time code
  1866. LEAX 1,X ;
  1867. LEAX 1,X ;
  1868. STX N stash it in scratch area
  1869. LDX 0,X get new IP
  1870. STX IP
  1871. CLRA ; get address of parameter
  1872. LDB #2
  1873. ADDB N+1
  1874. ADCA N
  1875. PSHS B ; and push it on data stack
  1876. PSHS A ;
  1877. JMP NEXT2
  1878. *
  1879. * ######>> screen 44 <<
  1880. * ======>> 121 <<
  1881. FCB $85
  1882. FCC 'COUN' ; 'COUNT'
  1883. FCB $D4
  1884. FDB DOES-8
  1885. COUNT FDB DOCOL,DUP,ONEP,SWAP,CAT
  1886. FDB SEMIS
  1887. *
  1888. * ======>> 122 <<
  1889. FCB $84
  1890. FCC 'TYP' ; 'TYPE'
  1891. FCB $C5
  1892. FDB COUNT-8
  1893. TYPE FDB DOCOL,DDUP,ZBRAN
  1894. FDB TYPE3-*
  1895. FDB OVER,PLUS,SWAP,XDO
  1896. TYPE2 FDB I,CAT,EMIT,XLOOP
  1897. FDB TYPE2-*
  1898. FDB BRAN
  1899. FDB TYPE4-*
  1900. TYPE3 FDB DROP
  1901. TYPE4 FDB SEMIS
  1902. *
  1903. * ======>> 123 <<
  1904. FCB $89
  1905. FCC '-TRAILIN' ; '-TRAILING'
  1906. FCB $C7
  1907. FDB TYPE-7
  1908. DTRAIL FDB DOCOL,DUP,ZERO,XDO
  1909. DTRAL2 FDB OVER,OVER,PLUS,ONE,SUB,CAT,BL
  1910. FDB SUB,ZBRAN
  1911. FDB DTRAL3-*
  1912. FDB LEAVE,BRAN
  1913. FDB DTRAL4-*
  1914. DTRAL3 FDB ONE,SUB
  1915. DTRAL4 FDB XLOOP
  1916. FDB DTRAL2-*
  1917. FDB SEMIS
  1918. *
  1919. * ======>> 124 <<
  1920. FCB $84
  1921. FCC '(."' ; '(.")'
  1922. FCB $A9
  1923. FDB DTRAIL-12
  1924. PDOTQ FDB DOCOL,R,TWOP,COUNT,DUP,ONEP
  1925. FDB FROMR,PLUS,TOR,TYPE
  1926. FDB SEMIS
  1927. *
  1928. * ======>> 125 <<
  1929. FCB $C2 immediate
  1930. FCC '.' ; '."'
  1931. FCB $A2
  1932. FDB PDOTQ-7
  1933. DOTQ FDB DOCOL
  1934. FDB CLITER
  1935. FCB $22 ascii quote
  1936. FDB STATE,AT,ZBRAN
  1937. FDB DOTQ1-*
  1938. FDB COMPIL,PDOTQ,WORD
  1939. FDB HERE,CAT,ONEP,ALLOT,BRAN
  1940. FDB DOTQ2-*
  1941. DOTQ1 FDB WORD,HERE,COUNT,TYPE
  1942. DOTQ2 FDB SEMIS
  1943. *
  1944. * ######>> screen 45 <<
  1945. * ======>> 126 <<== MACHINE DEPENDENT
  1946. FCB $86
  1947. FCC '?STAC' ; '?STACK'
  1948. FCB $CB
  1949. FDB DOTQ-5
  1950. QSTACK FDB DOCOL,CLITER
  1951. FCB $12
  1952. FDB PORIG,AT,TWO,SUB,SPAT,LESS,ONE
  1953. FDB QERR
  1954. * prints 'empty stack'
  1955. *
  1956. QSTAC2 FDB SPAT
  1957. * Here, we compare with a value at least 128
  1958. * higher than dict. ptr. (DP)
  1959. FDB HERE,CLITER
  1960. FCB $80
  1961. FDB PLUS,LESS,ZBRAN
  1962. FDB QSTAC3-*
  1963. FDB TWO
  1964. FDB QERR
  1965. * prints 'full stack'
  1966. *
  1967. QSTAC3 FDB SEMIS
  1968. *
  1969. * ======>> 127 << this word's function
  1970. * is done by ?STACK in this version
  1971. * FCB $85
  1972. * FCC 4,?FREE
  1973. * FCB $C5
  1974. * FDB QSTACK-9
  1975. *QFREE FDB DOCOL,SPAT,HERE,CLITER
  1976. * FCB $80
  1977. * FDB PLUS,LESS,TWO,QERR,SEMIS
  1978. *
  1979. * ######>> screen 46 <<
  1980. * ======>> 128 <<
  1981. FCB $86
  1982. FCC 'EXPEC' ; 'EXPECT'
  1983. FCB $D4
  1984. FDB QSTACK-9
  1985. EXPECT FDB DOCOL,OVER,PLUS,OVER,XDO
  1986. EXPEC2 FDB KEY,DUP,CLITER
  1987. FCB $0E
  1988. FDB PORIG,AT,EQUAL,ZBRAN
  1989. FDB EXPEC3-*
  1990. FDB DROP,CLITER
  1991. FCB 8 ( backspace character to emit )
  1992. FDB OVER,I,EQUAL,DUP,FROMR,TWO,SUB,PLUS
  1993. FDB TOR,SUB,BRAN
  1994. FDB EXPEC6-*
  1995. EXPEC3 FDB DUP,CLITER
  1996. FCB $D ( carriage return )
  1997. FDB EQUAL,ZBRAN
  1998. FDB EXPEC4-*
  1999. FDB LEAVE,DROP,BL,ZERO,BRAN
  2000. FDB EXPEC5-*
  2001. EXPEC4 FDB DUP
  2002. EXPEC5 FDB I,CSTORE,ZERO,I,ONEP,STORE
  2003. EXPEC6 FDB EMIT,XLOOP
  2004. FDB EXPEC2-*
  2005. FDB DROP
  2006. FDB SEMIS
  2007. *
  2008. * ======>> 129 <<
  2009. FCB $85
  2010. FCC 'QUER' ; 'QUERY'
  2011. FCB $D9
  2012. FDB EXPECT-9
  2013. QUERY FDB DOCOL,TIB,AT,COLUMS
  2014. FDB AT,EXPECT,ZERO,IN,STORE
  2015. FDB SEMIS
  2016. *
  2017. * ======>> 130 <<
  2018. FCB $C1 immediate < carriage return >
  2019. FCB $80
  2020. FDB QUERY-8
  2021. NULL FDB DOCOL,BLK,AT,ZBRAN
  2022. FDB NULL2-*
  2023. FDB ONE,BLK,PSTORE
  2024. FDB ZERO,IN,STORE,BLK,AT,BSCR,MOD
  2025. FDB ZEQU
  2026. * check for end of screen
  2027. FDB ZBRAN
  2028. FDB NULL1-*
  2029. FDB QEXEC,FROMR,DROP
  2030. NULL1 FDB BRAN
  2031. FDB NULL3-*
  2032. NULL2 FDB FROMR,DROP
  2033. NULL3 FDB SEMIS
  2034. *
  2035. * ######>> screen 47 <<
  2036. * ======>> 133 <<
  2037. FCB $84
  2038. FCC 'FIL' ; 'FILL'
  2039. FCB $CC
  2040. FDB NULL-4
  2041. FILL FDB DOCOL,SWAP,TOR,OVER,CSTORE,DUP,ONEP
  2042. FDB FROMR,ONE,SUB,CMOVE
  2043. FDB SEMIS
  2044. *
  2045. * ======>> 134 <<
  2046. FCB $85
  2047. FCC 'ERAS' ; 'ERASE'
  2048. FCB $C5
  2049. FDB FILL-7
  2050. ERASE FDB DOCOL,ZERO,FILL
  2051. FDB SEMIS
  2052. *
  2053. * ======>> 135 <<
  2054. FCB $86
  2055. FCC 'BLANK' ; 'BLANKS'
  2056. FCB $D3
  2057. FDB ERASE-8
  2058. BLANKS FDB DOCOL,BL,FILL
  2059. FDB SEMIS
  2060. *
  2061. * ======>> 136 <<
  2062. FCB $84
  2063. FCC 'HOL' ; 'HOLD'
  2064. FCB $C4
  2065. FDB BLANKS-9
  2066. HOLD FDB DOCOL,LIT,$FFFF,HLD,PSTORE,HLD,AT,CSTORE
  2067. FDB SEMIS
  2068. *
  2069. * ======>> 137 <<
  2070. FCB $83
  2071. FCC 'PA' ; 'PAD'
  2072. FCB $C4
  2073. FDB HOLD-7
  2074. PAD FDB DOCOL,HERE,CLITER
  2075. FCB $44
  2076. FDB PLUS
  2077. FDB SEMIS
  2078. *
  2079. * ######>> screen 48 <<
  2080. * ======>> 138 <<
  2081. FCB $84
  2082. FCC 'WOR' ; 'WORD'
  2083. FCB $C4
  2084. FDB PAD-6
  2085. WORD FDB DOCOL,BLK,AT,ZBRAN
  2086. FDB WORD2-*
  2087. FDB BLK,AT,BLOCK,BRAN
  2088. FDB WORD3-*
  2089. WORD2 FDB TIB,AT
  2090. WORD3 FDB IN,AT,PLUS,SWAP,ENCLOS,HERE,CLITER
  2091. FCB 34
  2092. FDB BLANKS,IN,PSTORE,OVER,SUB,TOR,R,HERE
  2093. FDB CSTORE,PLUS,HERE,ONEP,FROMR,CMOVE
  2094. FDB SEMIS
  2095. *
  2096. * ######>> screen 49 <<
  2097. * ======>> 139 <<
  2098. FCB $88
  2099. FCC '(NUMBER' ; '(NUMBER)'
  2100. FCB $A9
  2101. FDB WORD-7
  2102. PNUMB FDB DOCOL
  2103. PNUMB2 FDB ONEP,DUP,TOR,CAT,BASE,AT,DIGIT,ZBRAN
  2104. FDB PNUMB4-*
  2105. FDB SWAP,BASE,AT,USTAR,DROP,ROT,BASE
  2106. FDB AT,USTAR,DPLUS,DPL,AT,ONEP,ZBRAN
  2107. FDB PNUMB3-*
  2108. FDB ONE,DPL,PSTORE
  2109. PNUMB3 FDB FROMR,BRAN
  2110. FDB PNUMB2-*
  2111. PNUMB4 FDB FROMR
  2112. FDB SEMIS
  2113. *
  2114. * ======>> 140 <<
  2115. FCB $86
  2116. FCC 'NUMBE' ; 'NUMBER'
  2117. FCB $D2
  2118. FDB PNUMB-11
  2119. NUMB FDB DOCOL,ZERO,ZERO,ROT,DUP,ONEP,CAT,CLITER
  2120. FCC "-" minus sign
  2121. FDB EQUAL,DUP,TOR,PLUS,LIT,$FFFF
  2122. NUMB1 FDB DPL,STORE,PNUMB,DUP,CAT,BL,SUB
  2123. FDB ZBRAN
  2124. FDB NUMB2-*
  2125. FDB DUP,CAT,CLITER
  2126. FCC "."
  2127. FDB SUB,ZERO,QERR,ZERO,BRAN
  2128. FDB NUMB1-*
  2129. NUMB2 FDB DROP,FROMR,ZBRAN
  2130. FDB NUMB3-*
  2131. FDB DMINUS
  2132. NUMB3 FDB SEMIS
  2133. *
  2134. * ======>> 141 <<
  2135. FCB $85
  2136. FCC '-FIN' ; '-FIND'
  2137. FCB $C4
  2138. FDB NUMB-9
  2139. DFIND FDB DOCOL,BL,WORD,HERE,CONTXT,AT,AT
  2140. FDB PFIND,DUP,ZEQU,ZBRAN
  2141. FDB DFIND2-*
  2142. FDB DROP,HERE,LATEST,PFIND
  2143. DFIND2 FDB SEMIS
  2144. *
  2145. * ######>> screen 50 <<
  2146. * ======>> 142 <<
  2147. FCB $87
  2148. FCC '(ABORT' ; '(ABORT)'
  2149. FCB $A9
  2150. FDB DFIND-8
  2151. PABORT FDB DOCOL,ABORT
  2152. FDB SEMIS
  2153. *
  2154. * ======>> 143 <<
  2155. FCB $85
  2156. FCC 'ERRO' ; 'ERROR'
  2157. FCB $D2
  2158. FDB PABORT-10
  2159. ERROR FDB DOCOL,WARN,AT,ZLESS
  2160. FDB ZBRAN
  2161. * note: WARNING is -1 to abort, 0 to print error #
  2162. * and 1 to print error message from disc
  2163. FDB ERROR2-*
  2164. FDB PABORT
  2165. ERROR2 FDB HERE,COUNT,TYPE,PDOTQ
  2166. FCB 4,7 ( bell )
  2167. FCC " ? "
  2168. FDB MESS,SPSTOR,IN,AT,BLK,AT,QUIT
  2169. FDB SEMIS
  2170. *
  2171. * ======>> 144 <<
  2172. FCB $83
  2173. FCC 'ID' ; 'ID.'
  2174. FCB $AE
  2175. FDB ERROR-8
  2176. IDDOT FDB DOCOL,PAD,CLITER
  2177. FCB 32
  2178. FDB CLITER
  2179. FCB $5F ( underline )
  2180. FDB FILL,DUP,PFA,LFA,OVER,SUB,PAD
  2181. FDB SWAP,CMOVE,PAD,COUNT,CLITER
  2182. FCB 31
  2183. FDB AND,TYPE,SPACE
  2184. FDB SEMIS
  2185. *
  2186. * ######>> screen 51 <<
  2187. * ======>> 145 <<
  2188. FCB $86
  2189. FCC 'CREAT' ; 'CREATE'
  2190. FCB $C5
  2191. FDB IDDOT-6
  2192. CREATE FDB DOCOL,DFIND,ZBRAN
  2193. FDB CREAT2-*
  2194. FDB DROP,PDOTQ
  2195. FCB 8
  2196. FCB 7 ( bel )
  2197. FCC "redef: "
  2198. FDB NFA,IDDOT,CLITER
  2199. FCB 4
  2200. FDB MESS,SPACE
  2201. CREAT2 FDB HERE,DUP,CAT,WIDTH,AT,MIN
  2202. FDB ONEP,ALLOT,DUP,CLITER
  2203. FCB $A0
  2204. FDB TOGGLE,HERE,ONE,SUB,CLITER
  2205. FCB $80
  2206. FDB TOGGLE,LATEST,COMMA,CURENT,AT,STORE
  2207. FDB HERE,TWOP,COMMA
  2208. FDB SEMIS
  2209. *
  2210. * ######>> screen 52 <<
  2211. * ======>> 146 <<
  2212. FCB $C9 immediate
  2213. FCC '[COMPILE' ; '[COMPILE]'
  2214. FCB $DD
  2215. FDB CREATE-9
  2216. BCOMP FDB DOCOL,DFIND,ZEQU,ZERO,QERR,DROP,CFA,COMMA
  2217. FDB SEMIS
  2218. *
  2219. * ======>> 147 <<
  2220. FCB $C7 immediate
  2221. FCC 'LITERA' ; 'LITERAL'
  2222. FCB $CC
  2223. FDB BCOMP-12
  2224. LITER FDB DOCOL,STATE,AT,ZBRAN
  2225. FDB LITER2-*
  2226. FDB COMPIL,LIT,COMMA
  2227. LITER2 FDB SEMIS
  2228. *
  2229. * ======>> 148 <<
  2230. FCB $C8 immediate
  2231. FCC 'DLITERA' ; 'DLITERAL'
  2232. FCB $CC
  2233. FDB LITER-10
  2234. DLITER FDB DOCOL,STATE,AT,ZBRAN
  2235. FDB DLITE2-*
  2236. FDB SWAP,LITER,LITER
  2237. DLITE2 FDB SEMIS
  2238. *
  2239. * ######>> screen 53 <<
  2240. * ======>> 149 <<
  2241. FCB $89
  2242. FCC 'INTERPRE' ; 'INTERPRET'
  2243. FCB $D4
  2244. FDB DLITER-11
  2245. INTERP FDB DOCOL
  2246. INTER2 FDB DFIND,ZBRAN
  2247. FDB INTER5-*
  2248. FDB STATE,AT,LESS
  2249. FDB ZBRAN
  2250. FDB INTER3-*
  2251. FDB CFA,COMMA,BRAN
  2252. FDB INTER4-*
  2253. INTER3 FDB CFA,EXEC
  2254. INTER4 FDB BRAN
  2255. FDB INTER7-*
  2256. INTER5 FDB HERE,NUMB,DPL,AT,ONEP,ZBRAN
  2257. FDB INTER6-*
  2258. FDB DLITER,BRAN
  2259. FDB INTER7-*
  2260. INTER6 FDB DROP,LITER
  2261. INTER7 FDB QSTACK,BRAN
  2262. FDB INTER2-*
  2263. * FDB SEMIS never executed
  2264. *
  2265. * ######>> screen 54 <<
  2266. * ======>> 150 <<
  2267. FCB $89
  2268. FCC 'IMMEDIAT' ; 'IMMEDIATE'
  2269. FCB $C5
  2270. FDB INTERP-12
  2271. IMMED FDB DOCOL,LATEST,CLITER
  2272. FCB $40
  2273. FDB TOGGLE
  2274. FDB SEMIS
  2275. *
  2276. * ======>> 151 <<
  2277. FCB $8A
  2278. FCC 'VOCABULAR' ; 'VOCABULARY'
  2279. FCB $D9
  2280. FDB IMMED-12
  2281. VOCAB FDB DOCOL,BUILDS,LIT,$81A0,COMMA,CURENT,AT,CFA
  2282. FDB COMMA,HERE,VOCLIN,AT,COMMA,VOCLIN,STORE,DOES
  2283. DOVOC FDB TWOP,CONTXT,STORE
  2284. FDB SEMIS
  2285. *
  2286. * ======>> 152 <<
  2287. *
  2288. * Note: FORTH does not go here in the rom-able dictionary,
  2289. * since FORTH is a type of variable.
  2290. *
  2291. *
  2292. * ======>> 153 <<
  2293. FCB $8B
  2294. FCC 'DEFINITION' ; 'DEFINITIONS'
  2295. FCB $D3
  2296. FDB VOCAB-13
  2297. DEFIN FDB DOCOL,CONTXT,AT,CURENT,STORE
  2298. FDB SEMIS
  2299. *
  2300. * ======>> 154 <<
  2301. FCB $C1 immediate (
  2302. FCB $A8
  2303. FDB DEFIN-14
  2304. PAREN FDB DOCOL,CLITER
  2305. FCC ")"
  2306. FDB WORD
  2307. FDB SEMIS
  2308. *
  2309. * ######>> screen 55 <<
  2310. * ======>> 155 <<
  2311. FCB $84
  2312. FCC 'QUI' ; 'QUIT'
  2313. FCB $D4
  2314. FDB PAREN-4
  2315. QUIT FDB DOCOL,ZERO,BLK,STORE
  2316. FDB LBRAK
  2317. *
  2318. * Here is the outer interpretter
  2319. * which gets a line of input, does it, prints " OK"
  2320. * then repeats :
  2321. QUIT2 FDB RPSTOR,CR,QUERY,INTERP,STATE,AT,ZEQU
  2322. FDB ZBRAN
  2323. FDB QUIT3-*
  2324. FDB PDOTQ
  2325. FCB 3
  2326. FCC ' OK' ; ' OK'
  2327. QUIT3 FDB BRAN
  2328. FDB QUIT2-*
  2329. * FDB SEMIS ( never executed )
  2330. *
  2331. * ======>> 156 <<
  2332. FCB $85
  2333. FCC 'ABOR' ; 'ABORT'
  2334. FCB $D4
  2335. FDB QUIT-7
  2336. ABORT FDB DOCOL,SPSTOR,DEC,QSTACK,DRZERO,CR,PDOTQ
  2337. FCB 8
  2338. FCC "Forth-68"
  2339. FDB FORTH,DEFIN
  2340. FDB QUIT
  2341. * FDB SEMIS never executed
  2342. PAGE
  2343. *
  2344. * ######>> screen 56 <<
  2345. * bootstrap code... moves rom contents to ram :
  2346. * ======>> 157 <<
  2347. FCB $84
  2348. FCC 'COL' ; 'COLD'
  2349. FCB $C4
  2350. FDB ABORT-8
  2351. COLD FDB *+2
  2352. CENT LDS #REND-1 top of destination
  2353. LDX #ERAM top of stuff to move
  2354. COLD2 LEAX -1,X ;
  2355. LDA 0,X
  2356. PSHS A ; move TASK & FORTH to ram
  2357. CMPX #RAM
  2358. BNE COLD2
  2359. *
  2360. LDS #XFENCE-1 put stack at a safe place for now
  2361. LDX COLINT
  2362. STX XCOLUM
  2363. LDX DELINT
  2364. STX XDELAY
  2365. LDX VOCINT
  2366. STX XVOCL
  2367. LDX DPINIT
  2368. STX XDP
  2369. LDX FENCIN
  2370. STX XFENCE
  2371. WENT LDS #XFENCE-1 top of destination
  2372. LDX #FENCIN top of stuff to move
  2373. WARM2 LEAX -1,X ;
  2374. LDA 0,X
  2375. PSHS A ;
  2376. CMPX #SINIT
  2377. BNE WARM2
  2378. *
  2379. LDS SINIT
  2380. LDX UPINIT
  2381. STX UP init user ram pointer
  2382. LDX #ABORT
  2383. STX IP
  2384. NOP Here is a place to jump to special user
  2385. NOP initializations such as I/0 interrups
  2386. NOP
  2387. *
  2388. * For systems with TRACE:
  2389. LDX #00
  2390. STX TRLIM clear trace mode
  2391. LDX #0
  2392. STX BRKPT clear breakpoint address
  2393. JMP RPSTOR+2 start the virtual machine running !
  2394. *
  2395. * Here is the stuff that gets copied to ram :
  2396. * at address $140:
  2397. *
  2398. RAM FDB $3000,$3000,0,0
  2399. * ======>> (152) <<
  2400. FCB $C5 immediate
  2401. FCC 'FORT' ; 'FORTH'
  2402. FCB $C8
  2403. FDB NOOP-7
  2404. RFORTH FDB DODOES,DOVOC,$81A0,TASK-7
  2405. FDB 0
  2406. FCC "(C) Forth Interest Group, 1979"
  2407. FCB $84
  2408. FCC 'TAS' ; 'TASK'
  2409. FCB $CB
  2410. FDB FORTH-8
  2411. RTASK FDB DOCOL,SEMIS
  2412. ERAM FCC "David Lion"
  2413. PAGE
  2414. *
  2415. * ######>> screen 57 <<
  2416. * ======>> 158 <<
  2417. FCB $84
  2418. FCC 'S->' ; 'S->D'
  2419. FCB $C4
  2420. FDB COLD-7
  2421. STOD FDB DOCOL,DUP,ZLESS,MINUS
  2422. FDB SEMIS
  2423. *
  2424. * ======>> 159 <<
  2425. FCB $81 ; *
  2426. FCB $AA
  2427. FDB STOD-7
  2428. STAR FDB *+2
  2429. JSR USTARS
  2430. LEAS 1,S ;
  2431. LEAS 1,S ;
  2432. JMP NEXT
  2433. *
  2434. * ======>> 160 <<
  2435. FCB $84
  2436. FCC '/MO' ; '/MOD'
  2437. FCB $C4
  2438. FDB STAR-4
  2439. SLMOD FDB DOCOL,TOR,STOD,FROMR,USLASH
  2440. FDB SEMIS
  2441. *
  2442. * ======>> 161 <<
  2443. FCB $81 ; /
  2444. FCB $AF
  2445. FDB SLMOD-7
  2446. SLASH FDB DOCOL,SLMOD,SWAP,DROP
  2447. FDB SEMIS
  2448. *
  2449. * ======>> 162 <<
  2450. FCB $83
  2451. FCC 'MO' ; 'MOD'
  2452. FCB $C4
  2453. FDB SLASH-4
  2454. MOD FDB DOCOL,SLMOD,DROP
  2455. FDB SEMIS
  2456. *
  2457. * ======>> 163 <<
  2458. FCB $85
  2459. FCC '*/MO' ; '*/MOD'
  2460. FCB $C4
  2461. FDB MOD-6
  2462. SSMOD FDB DOCOL,TOR,USTAR,FROMR,USLASH
  2463. FDB SEMIS
  2464. *
  2465. * ======>> 164 <<
  2466. FCB $82
  2467. FCC '*' ; '*/'
  2468. FCB $AF
  2469. FDB SSMOD-8
  2470. SSLASH FDB DOCOL,SSMOD,SWAP,DROP
  2471. FDB SEMIS
  2472. *
  2473. * ======>> 165 <<
  2474. FCB $85
  2475. FCC 'M/MO' ; 'M/MOD'
  2476. FCB $C4
  2477. FDB SSLASH-5
  2478. MSMOD FDB DOCOL,TOR,ZERO,R,USLASH
  2479. FDB FROMR,SWAP,TOR,USLASH,FROMR
  2480. FDB SEMIS
  2481. *
  2482. * ======>> 166 <<
  2483. FCB $83
  2484. FCC 'AB' ; 'ABS'
  2485. FCB $D3
  2486. FDB MSMOD-8
  2487. ABS FDB DOCOL,DUP,ZLESS,ZBRAN
  2488. FDB ABS2-*
  2489. FDB MINUS
  2490. ABS2 FDB SEMIS
  2491. *
  2492. * ======>> 167 <<
  2493. FCB $84
  2494. FCC 'DAB' ; 'DABS'
  2495. FCB $D3
  2496. FDB ABS-6
  2497. DABS FDB DOCOL,DUP,ZLESS,ZBRAN
  2498. FDB DABS2-*
  2499. FDB DMINUS
  2500. DABS2 FDB SEMIS
  2501. *
  2502. * ######>> screen 58 <<
  2503. * Disc primatives :
  2504. * ======>> 168 <<
  2505. FCB $83
  2506. FCC 'US' ; 'USE'
  2507. FCB $C5
  2508. FDB DABS-7
  2509. USE FDB DOCON
  2510. FDB XUSE
  2511. * ======>> 169 <<
  2512. FCB $84
  2513. FCC 'PRE' ; 'PREV'
  2514. FCB $D6
  2515. FDB USE-6
  2516. PREV FDB DOCON
  2517. FDB XPREV
  2518. * ======>> 170 <<
  2519. FCB $84
  2520. FCC '+BU' ; '+BUF'
  2521. FCB $C6
  2522. FDB PREV-7
  2523. PBUF FDB DOCOL,CLITER
  2524. FCB $84
  2525. FDB PLUS,DUP,LIMIT,EQUAL,ZBRAN
  2526. FDB PBUF2-*
  2527. FDB DROP,FIRST
  2528. PBUF2 FDB DUP,PREV,AT,SUB
  2529. FDB SEMIS
  2530. *
  2531. * ======>> 171 <<
  2532. FCB $86
  2533. FCC 'UPDAT' ; 'UPDATE'
  2534. FCB $C5
  2535. FDB PBUF-7
  2536. UPDATE FDB DOCOL,PREV,AT,AT,LIT,$8000,OR,PREV,AT,STORE
  2537. FDB SEMIS
  2538. *
  2539. * ======>> 172 <<
  2540. FCB $8D
  2541. FCC 'EMPTY-BUFFER' ; 'EMPTY-BUFFERS'
  2542. FCB $D3
  2543. FDB UPDATE-9
  2544. MTBUF FDB DOCOL,FIRST,LIMIT,OVER,SUB,ERASE
  2545. FDB SEMIS
  2546. *
  2547. * ======>> 173 <<
  2548. FCB $83
  2549. FCC 'DR' ; 'DR0'
  2550. FCB $B0
  2551. FDB MTBUF-16
  2552. DRZERO FDB DOCOL,ZERO,OFSET,STORE
  2553. FDB SEMIS
  2554. *
  2555. * ======>> 174 <<== system dependant word
  2556. FCB $83
  2557. FCC 'DR' ; 'DR1'
  2558. FCB $B1
  2559. FDB DRZERO-6
  2560. DRONE FDB DOCOL,LIT,$07D0,OFSET,STORE
  2561. FDB SEMIS
  2562. *
  2563. * ######>> screen 59 <<
  2564. * ======>> 175 <<
  2565. FCB $86
  2566. FCC 'BUFFE' ; 'BUFFER'
  2567. FCB $D2
  2568. FDB DRONE-6
  2569. BUFFER FDB DOCOL,USE,AT,DUP,TOR
  2570. BUFFR2 FDB PBUF,ZBRAN
  2571. FDB BUFFR2-*
  2572. FDB USE,STORE,R,AT,ZLESS
  2573. FDB ZBRAN
  2574. FDB BUFFR3-*
  2575. FDB R,TWOP,R,AT,LIT,$7FFF,AND,ZERO,RW
  2576. BUFFR3 FDB R,STORE,R,PREV,STORE,FROMR,TWOP
  2577. FDB SEMIS
  2578. *
  2579. * ######>> screen 60 <<
  2580. * ======>> 176 <<
  2581. FCB $85
  2582. FCC 'BLOC' ; 'BLOCK'
  2583. FCB $CB
  2584. FDB BUFFER-9
  2585. BLOCK FDB DOCOL,OFSET,AT,PLUS,TOR
  2586. FDB PREV,AT,DUP,AT,R,SUB,DUP,PLUS,ZBRAN
  2587. FDB BLOCK5-*
  2588. BLOCK3 FDB PBUF,ZEQU,ZBRAN
  2589. FDB BLOCK4-*
  2590. FDB DROP,R,BUFFER,DUP,R,ONE,RW,TWO,SUB
  2591. BLOCK4 FDB DUP,AT,R,SUB,DUP,PLUS,ZEQU,ZBRAN
  2592. FDB BLOCK3-*
  2593. FDB DUP,PREV,STORE
  2594. BLOCK5 FDB FROMR,DROP,TWOP
  2595. FDB SEMIS
  2596. *
  2597. * ######>> screen 61 <<
  2598. * ======>> 177 <<
  2599. FCB $86
  2600. FCC '(LINE' ; '(LINE)'
  2601. FCB $A9
  2602. FDB BLOCK-8
  2603. PLINE FDB DOCOL,TOR,CLITER
  2604. FCB $40
  2605. FDB BBUF,SSMOD,FROMR,BSCR,STAR,PLUS,BLOCK,PLUS,CLITER
  2606. FCB $40
  2607. FDB SEMIS
  2608. *
  2609. * ======>> 178 <<
  2610. FCB $85
  2611. FCC '.LIN' ; '.LINE'
  2612. FCB $C5
  2613. FDB PLINE-9
  2614. DLINE FDB DOCOL,PLINE,DTRAIL,TYPE
  2615. FDB SEMIS
  2616. *
  2617. * ======>> 179 <<
  2618. FCB $87
  2619. FCC 'MESSAG' ; 'MESSAGE'
  2620. FCB $C5
  2621. FDB DLINE-8
  2622. MESS FDB DOCOL,WARN,AT,ZBRAN
  2623. FDB MESS3-*
  2624. FDB DDUP,ZBRAN
  2625. FDB MESS3-*
  2626. FDB CLITER
  2627. FCB 4
  2628. FDB OFSET,AT,BSCR,SLASH,SUB,DLINE,BRAN
  2629. FDB MESS4-*
  2630. MESS3 FDB PDOTQ
  2631. FCB 6
  2632. FCC 'err # ' ; 'err # '
  2633. FDB DOT
  2634. MESS4 FDB SEMIS
  2635. *
  2636. * ======>> 180 <<
  2637. FCB $84
  2638. FCC 'LOA' ; 'LOAD' : input:scr #
  2639. FCB $C4
  2640. FDB MESS-10
  2641. LOAD FDB DOCOL,BLK,AT,TOR,IN,AT,TOR,ZERO,IN,STORE
  2642. FDB BSCR,STAR,BLK,STORE
  2643. FDB INTERP,FROMR,IN,STORE,FROMR,BLK,STORE
  2644. FDB SEMIS
  2645. *
  2646. * ======>> 181 <<
  2647. FCB $C3
  2648. FCC '--' ; '-->'
  2649. FCB $BE
  2650. FDB LOAD-7
  2651. ARROW FDB DOCOL,QLOAD,ZERO,IN,STORE,BSCR
  2652. FDB BLK,AT,OVER,MOD,SUB,BLK,PSTORE
  2653. FDB SEMIS
  2654. PAGE
  2655. *
  2656. *
  2657. * ######>> screen 63 <<
  2658. * The next 4 subroutines are machine dependent, and are
  2659. * called by words 13 through 16 in the dictionary.
  2660. *
  2661. * ======>> 182 << code for EMIT
  2662. PEMIT STB N save B
  2663. STX N+1 save X
  2664. LDB ACIAC
  2665. BITB #2 check ready bit
  2666. BEQ PEMIT+4 if not ready for more data
  2667. STA ACIAD
  2668. LDX UP
  2669. STB IOSTAT-UORIG,X
  2670. LDB N recover B & X
  2671. LDX N+1
  2672. RTS only A register may change
  2673. * PEMIT JMP $E1D1 for MIKBUG
  2674. * PEMIT FCB $3F,$11,$39 for PROTO
  2675. * PEMIT JMP $D286 for Smoke Signal DOS
  2676. *
  2677. * ======>> 183 << code for KEY
  2678. PKEY STB N
  2679. STX N+1
  2680. LDB ACIAC
  2681. ASRB ;
  2682. BCC PKEY+4 no incoming data yet
  2683. LDA ACIAD
  2684. ANDA #$7F strip parity bit
  2685. LDX UP
  2686. STB IOSTAT+1-UORIG,X
  2687. LDB N
  2688. LDX N+1
  2689. RTS
  2690. * PKEY JMP $E1AC for MIKBUG
  2691. * PKEY FCB $3F,$14,$39 for PROTO
  2692. * PKEY JMP $D289 for Smoke Signal DOS
  2693. *
  2694. * ######>> screen 64 <<
  2695. * ======>> 184 << code for ?TERMINAL
  2696. PQTER LDA ACIAC Test for 'break' condition
  2697. ANDA #$11 mask framing error bit and
  2698. * input buffer full
  2699. BEQ PQTER2
  2700. LDA ACIAD clear input buffer
  2701. LDA #01
  2702. PQTER2 RTS
  2703. PAGE
  2704. *
  2705. * ======>> 185 << code for CR
  2706. PCR LDA #$D carriage return
  2707. BSR PEMIT
  2708. LDA #$A line feed
  2709. BSR PEMIT
  2710. LDA #$7F rubout
  2711. LDX UP
  2712. LDB XDELAY+1-UORIG,X
  2713. PCR2 DECB ;
  2714. BMI PQTER2 return if minus
  2715. PSHS B ; save counter
  2716. BSR PEMIT print RUBOUTs to delay.....
  2717. PULS B ;
  2718. BRA PCR2 repeat
  2719. PAGE
  2720. *
  2721. * ######>> screen 66 <<
  2722. * ======>> 187 <<
  2723. FCB $85
  2724. FCC '?DIS' ; '?DISC'
  2725. FCB $C3
  2726. FDB ARROW-6
  2727. QDISC FDB *+2
  2728. JMP NEXT
  2729. *
  2730. * ######>> screen 67 <<
  2731. * ======>> 189 <<
  2732. FCB $8B
  2733. FCC 'BLOCK-WRIT' ; 'BLOCK-WRITE'
  2734. FCB $C5
  2735. FDB QDISC-8
  2736. BWRITE FDB *+2
  2737. JMP NEXT
  2738. *
  2739. * ######>> screen 68 <<
  2740. * ======>> 190 <<
  2741. FCB $8A
  2742. FCC 'BLOCK-REA' ; 'BLOCK-READ'
  2743. FCB $C4
  2744. FDB BWRITE-14
  2745. BREAD FDB *+2
  2746. JMP NEXT
  2747. *
  2748. *The next 3 words are written to create a substitute for disc
  2749. * mass memory,located between $3210 & $3FFF in ram.
  2750. * ======>> 190.1 <<
  2751. FCB $82
  2752. FCC 'L' ; 'LO'
  2753. FCB $CF
  2754. FDB BREAD-13
  2755. LO FDB DOCON
  2756. FDB MEMEND a system dependent equate at front
  2757. *
  2758. * ======>> 190.2 <<
  2759. FCB $82
  2760. FCC 'H' ; 'HI'
  2761. FCB $C9
  2762. FDB LO-5
  2763. HI FDB DOCON
  2764. FDB MEMTOP ( $3FFF in this version )
  2765. *
  2766. * ######>> screen 69 <<
  2767. * ======>> 191 <<
  2768. FCB $83
  2769. FCC 'R/' ; 'R/W'
  2770. FCB $D7
  2771. FDB HI-5
  2772. RW FDB DOCOL,TOR,BBUF,STAR,LO,PLUS,DUP,HI,GREAT,ZBRAN
  2773. FDB RW2-*
  2774. FDB PDOTQ
  2775. FCB 8
  2776. FCC ' Range ?' ; ' Range ?'
  2777. FDB QUIT
  2778. RW2 FDB FROMR,ZBRAN
  2779. FDB RW3-*
  2780. FDB SWAP
  2781. RW3 FDB BBUF,CMOVE
  2782. FDB SEMIS
  2783. *
  2784. * ######>> screen 72 <<
  2785. * ======>> 192 <<
  2786. FCB $C1 immediate
  2787. FCB $A7 ' ( tick )
  2788. FDB RW-6
  2789. TICK FDB DOCOL,DFIND,ZEQU,ZERO,QERR,DROP,LITER
  2790. FDB SEMIS
  2791. *
  2792. * ======>> 193 <<
  2793. FCB $86
  2794. FCC 'FORGE' ; 'FORGET'
  2795. FCB $D4
  2796. FDB TICK-4
  2797. FORGET FDB DOCOL,CURENT,AT,CONTXT,AT,SUB,CLITER
  2798. FCB $18
  2799. FDB QERR,TICK,DUP,FENCE,AT,LESS,CLITER
  2800. FCB $15
  2801. FDB QERR,DUP,ZERO,PORIG,GREAT,CLITER
  2802. FCB $15
  2803. FDB QERR,DUP,NFA,DP,STORE,LFA,AT,CONTXT,AT,STORE
  2804. FDB SEMIS
  2805. *
  2806. * ######>> screen 73 <<
  2807. * ======>> 194 <<
  2808. FCB $84
  2809. FCC 'BAC' ; 'BACK'
  2810. FCB $CB
  2811. FDB FORGET-9
  2812. BACK FDB DOCOL,HERE,SUB,COMMA
  2813. FDB SEMIS
  2814. *
  2815. * ======>> 195 <<
  2816. FCB $C5
  2817. FCC 'BEGI' ; 'BEGIN'
  2818. FCB $CE
  2819. FDB BACK-7
  2820. BEGIN FDB DOCOL,QCOMP,HERE,ONE
  2821. FDB SEMIS
  2822. *
  2823. * ======>> 196 <<
  2824. FCB $C5
  2825. FCC 'ENDI' ; 'ENDIF'
  2826. FCB $C6
  2827. FDB BEGIN-8
  2828. ENDIF FDB DOCOL,QCOMP,TWO,QPAIRS,HERE
  2829. FDB OVER,SUB,SWAP,STORE
  2830. FDB SEMIS
  2831. *
  2832. * ======>> 197 <<
  2833. FCB $C4
  2834. FCC 'THE' ; 'THEN'
  2835. FCB $CE
  2836. FDB ENDIF-8
  2837. THEN FDB DOCOL,ENDIF
  2838. FDB SEMIS
  2839. *
  2840. * ======>> 198 <<
  2841. FCB $C2
  2842. FCC 'D' ; 'DO'
  2843. FCB $CF
  2844. FDB THEN-7
  2845. DO FDB DOCOL,COMPIL,XDO,HERE,THREE
  2846. FDB SEMIS
  2847. *
  2848. * ======>> 199 <<
  2849. FCB $C4
  2850. FCC 'LOO' ; 'LOOP'
  2851. FCB $D0
  2852. FDB DO-5
  2853. LOOP FDB DOCOL,THREE,QPAIRS,COMPIL,XLOOP,BACK
  2854. FDB SEMIS
  2855. *
  2856. * ======>> 200 <<
  2857. FCB $C5
  2858. FCC '+LOO' ; '+LOOP'
  2859. FCB $D0
  2860. FDB LOOP-7
  2861. PLOOP FDB DOCOL,THREE,QPAIRS,COMPIL,XPLOOP,BACK
  2862. FDB SEMIS
  2863. *
  2864. * ======>> 201 <<
  2865. FCB $C5
  2866. FCC 'UNTI' ; 'UNTIL' : ( same as END )
  2867. FCB $CC
  2868. FDB PLOOP-8
  2869. UNTIL FDB DOCOL,ONE,QPAIRS,COMPIL,ZBRAN,BACK
  2870. FDB SEMIS
  2871. *
  2872. * ######>> screen 74 <<
  2873. * ======>> 202 <<
  2874. FCB $C3
  2875. FCC 'EN' ; 'END'
  2876. FCB $C4
  2877. FDB UNTIL-8
  2878. END FDB DOCOL,UNTIL
  2879. FDB SEMIS
  2880. *
  2881. * ======>> 203 <<
  2882. FCB $C5
  2883. FCC 'AGAI' ; 'AGAIN'
  2884. FCB $CE
  2885. FDB END-6
  2886. AGAIN FDB DOCOL,ONE,QPAIRS,COMPIL,BRAN,BACK
  2887. FDB SEMIS
  2888. *
  2889. * ======>> 204 <<
  2890. FCB $C6
  2891. FCC 'REPEA' ; 'REPEAT'
  2892. FCB $D4
  2893. FDB AGAIN-8
  2894. REPEAT FDB DOCOL,TOR,TOR,AGAIN,FROMR,FROMR
  2895. FDB TWO,SUB,ENDIF
  2896. FDB SEMIS
  2897. *
  2898. * ======>> 205 <<
  2899. FCB $C2
  2900. FCC 'I' ; 'IF'
  2901. FCB $C6
  2902. FDB REPEAT-9
  2903. IF FDB DOCOL,COMPIL,ZBRAN,HERE,ZERO,COMMA,TWO
  2904. FDB SEMIS
  2905. *
  2906. * ======>> 206 <<
  2907. FCB $C4
  2908. FCC 'ELS' ; 'ELSE'
  2909. FCB $C5
  2910. FDB IF-5
  2911. ELSE FDB DOCOL,TWO,QPAIRS,COMPIL,BRAN,HERE
  2912. FDB ZERO,COMMA,SWAP,TWO,ENDIF,TWO
  2913. FDB SEMIS
  2914. *
  2915. * ======>> 207 <<
  2916. FCB $C5
  2917. FCC 'WHIL' ; 'WHILE'
  2918. FCB $C5
  2919. FDB ELSE-7
  2920. WHILE FDB DOCOL,IF,TWOP
  2921. FDB SEMIS
  2922. *
  2923. * ######>> screen 75 <<
  2924. * ======>> 208 <<
  2925. FCB $86
  2926. FCC 'SPACE' ; 'SPACES'
  2927. FCB $D3
  2928. FDB WHILE-8
  2929. SPACES FDB DOCOL,ZERO,MAX,DDUP,ZBRAN
  2930. FDB SPACE3-*
  2931. FDB ZERO,XDO
  2932. SPACE2 FDB SPACE,XLOOP
  2933. FDB SPACE2-*
  2934. SPACE3 FDB SEMIS
  2935. *
  2936. * ======>> 209 <<
  2937. FCB $82
  2938. FCC '<' ; '<#'
  2939. FCB $A3
  2940. FDB SPACES-9
  2941. BDIGS FDB DOCOL,PAD,HLD,STORE
  2942. FDB SEMIS
  2943. *
  2944. * ======>> 210 <<
  2945. FCB $82
  2946. FCC '#' ; '#>'
  2947. FCB $BE
  2948. FDB BDIGS-5
  2949. EDIGS FDB DOCOL,DROP,DROP,HLD,AT,PAD,OVER,SUB
  2950. FDB SEMIS
  2951. *
  2952. * ======>> 211 <<
  2953. FCB $84
  2954. FCC 'SIG' ; 'SIGN'
  2955. FCB $CE
  2956. FDB EDIGS-5
  2957. SIGN FDB DOCOL,ROT,ZLESS,ZBRAN
  2958. FDB SIGN2-*
  2959. FDB CLITER
  2960. FCC "-"
  2961. FDB HOLD
  2962. SIGN2 FDB SEMIS
  2963. *
  2964. * ======>> 212 <<
  2965. FCB $81 #
  2966. FCB $A3
  2967. FDB SIGN-7
  2968. DIG FDB DOCOL,BASE,AT,MSMOD,ROT,CLITER
  2969. FCB 9
  2970. FDB OVER,LESS,ZBRAN
  2971. FDB DIG2-*
  2972. FDB CLITER
  2973. FCB 7
  2974. FDB PLUS
  2975. DIG2 FDB CLITER
  2976. FCC "0" ascii zero
  2977. FDB PLUS,HOLD
  2978. FDB SEMIS
  2979. *
  2980. * ======>> 213 <<
  2981. FCB $82
  2982. FCC '#' ; '#S'
  2983. FCB $D3
  2984. FDB DIG-4
  2985. DIGS FDB DOCOL
  2986. DIGS2 FDB DIG,OVER,OVER,OR,ZEQU,ZBRAN
  2987. FDB DIGS2-*
  2988. FDB SEMIS
  2989. *
  2990. * ######>> screen 76 <<
  2991. * ======>> 214 <<
  2992. FCB $82
  2993. FCC '.' ; '.R'
  2994. FCB $D2
  2995. FDB DIGS-5
  2996. DOTR FDB DOCOL,TOR,STOD,FROMR,DDOTR
  2997. FDB SEMIS
  2998. *
  2999. * ======>> 215 <<
  3000. FCB $83
  3001. FCC 'D.' ; 'D.R'
  3002. FCB $D2
  3003. FDB DOTR-5
  3004. DDOTR FDB DOCOL,TOR,SWAP,OVER,DABS,BDIGS,DIGS,SIGN
  3005. FDB EDIGS,FROMR,OVER,SUB,SPACES,TYPE
  3006. FDB SEMIS
  3007. *
  3008. * ======>> 216 <<
  3009. FCB $82
  3010. FCC 'D' ; 'D.'
  3011. FCB $AE
  3012. FDB DDOTR-6
  3013. DDOT FDB DOCOL,ZERO,DDOTR,SPACE
  3014. FDB SEMIS
  3015. *
  3016. * ======>> 217 <<
  3017. FCB $81 .
  3018. FCB $AE
  3019. FDB DDOT-5
  3020. DOT FDB DOCOL,STOD,DDOT
  3021. FDB SEMIS
  3022. *
  3023. * ======>> 218 <<
  3024. FCB $81 ?
  3025. FCB $BF
  3026. FDB DOT-4
  3027. QUEST FDB DOCOL,AT,DOT
  3028. FDB SEMIS
  3029. *
  3030. * ######>> screen 77 <<
  3031. * ======>> 219 <<
  3032. FCB $84
  3033. FCC 'LIS' ; 'LIST'
  3034. FCB $D4
  3035. FDB QUEST-4
  3036. LIST FDB DOCOL,DEC,CR,DUP,SCR,STORE,PDOTQ
  3037. FCB 6
  3038. FCC "SCR # "
  3039. FDB DOT,CLITER
  3040. FCB $10
  3041. FDB ZERO,XDO
  3042. LIST2 FDB CR,I,THREE
  3043. FDB DOTR,SPACE,I,SCR,AT,DLINE,XLOOP
  3044. FDB LIST2-*
  3045. FDB CR
  3046. FDB SEMIS
  3047. *
  3048. * ======>> 220 <<
  3049. FCB $85
  3050. FCC 'INDE' ; 'INDEX'
  3051. FCB $D8
  3052. FDB LIST-7
  3053. INDEX FDB DOCOL,CR,ONEP,SWAP,XDO
  3054. INDEX2 FDB CR,I,THREE
  3055. FDB DOTR,SPACE,ZERO,I,DLINE
  3056. FDB QTERM,ZBRAN
  3057. FDB INDEX3-*
  3058. FDB LEAVE
  3059. INDEX3 FDB XLOOP
  3060. FDB INDEX2-*
  3061. FDB SEMIS
  3062. *
  3063. * ======>> 221 <<
  3064. FCB $85
  3065. FCC 'TRIA' ; 'TRIAD'
  3066. FCB $C4
  3067. FDB INDEX-8
  3068. TRIAD FDB DOCOL,THREE,SLASH,THREE,STAR
  3069. FDB THREE,OVER,PLUS,SWAP,XDO
  3070. TRIAD2 FDB CR,I
  3071. FDB LIST,QTERM,ZBRAN
  3072. FDB TRIAD3-*
  3073. FDB LEAVE
  3074. TRIAD3 FDB XLOOP
  3075. FDB TRIAD2-*
  3076. FDB CR,CLITER
  3077. FCB $0F
  3078. FDB MESS,CR
  3079. FDB SEMIS
  3080. *
  3081. * ######>> screen 78 <<
  3082. * ======>> 222 <<
  3083. FCB $85
  3084. FCC 'VLIS' ; 'VLIST'
  3085. FCB $D4
  3086. FDB TRIAD-8
  3087. VLIST FDB DOCOL,CLITER
  3088. FCB $80
  3089. FDB OUT,STORE,CONTXT,AT,AT
  3090. VLIST1 FDB OUT,AT,COLUMS,AT,CLITER
  3091. FCB 32
  3092. FDB SUB,GREAT,ZBRAN
  3093. FDB VLIST2-*
  3094. FDB CR,ZERO,OUT,STORE
  3095. VLIST2 FDB DUP,IDDOT,SPACE,SPACE,PFA,LFA,AT
  3096. FDB DUP,ZEQU,QTERM,OR,ZBRAN
  3097. FDB VLIST1-*
  3098. FDB DROP
  3099. FDB SEMIS
  3100. *
  3101. * ======>> XX <<
  3102. FCB $84
  3103. FCC 'NOO' ; 'NOOP'
  3104. FCB $D0
  3105. FDB VLIST-8
  3106. NOOP FDB NEXT a useful no-op
  3107. ZZZZ FDB 0,0,0,0,0,0,0,0 end of rom program
  3108. PAGE
  3109. OPT L
  3110. END
ダウンロード 印刷用表示

このコピペの URL

JavaScript での埋め込み

iframe での埋め込み

元のテキスト