• R/O
  • HTTP
  • SSH
  • HTTPS

Tags
No Tags

Frequently used words (click to add to your profile)

javac++androidcocoaobjective-cc#誰得gamephpbathyscapheqtrubyclinuxomegat翻訳pythontwitterwindowsbtronvb.nettestframeworkgui計画中(planning stage)directxpreviewerpukiwikidommruby

Functions for working with the idealized calendar of Planet Xhilr


File Info

Rev. c9ca731a29c3838146d1e7e85626e1273ae7ca7f
Size 75,694 bytes
Time 2017-06-17 10:35:04
Author Joel Matthew Rees
Log Message

UD/MOD double integer division in M6800 assembler within figForth.
The assembler I use to assemble it is here:
https://sourceforge.net/p/asm68c/wiki/Home/
and it can be run on Joe H Allen's exorsim v. 1.1.
Surprisingly, the High-level Forth version is only around twice as slow as the assembler-level version (because it only uses right-shifts).

Content

  1. * OPT PRT
  2. * fig-FORTH FOR 6800
  3. * ASSEMBLY SOURCE LISTING
  4. * RELEASE 1
  5. * MAY 1979
  6. * WITH COMPILER SECURITY
  7. * AND VARIABLE LENGTH NAMES
  8. * RELEASE 1.00.01
  9. * May 2013
  10. * Modified for Joe Allen's EXORSIM, JMR
  11. * This public domain publication is provided
  12. * through the courtesy of:
  13. * FORTH
  14. * INTEREST
  15. * GROUP
  16. * fig
  17. * P.O. Box 8231 - San Jose, CA 95155 - (408) 277-0668
  18. * Further distribution must include this notice.
  19. PAGE
  20. NAM Copyright:FORTH Interest Group
  21. OPT GEN,PAG
  22. * filename FTH7.21
  23. * === FORTH-6800 06-06-79 21:OO
  24. * The following constitutes the original license:
  25. *=====================LICENSE====================
  26. * This listing is in the PUBLIC DOMAIN and
  27. * may be freely copied or published with the
  28. * restriction that a credit line is printed
  29. * with the material, crediting the
  30. * authors and the FORTH INTEREST GROUP.
  31. * === by Dave Lion,
  32. * === with help from
  33. * === Bob Smith,
  34. * === LaFarr Stuart,
  35. * === The Forth Interest Group
  36. * === PO Box 1105
  37. * === San Carlos, CA 94070
  38. * === and
  39. * === Unbounded Computing
  40. * === 1134-K Aster Ave.
  41. * === Sunnyvale, CA 94086
  42. *===================END-LICENSE==================
  43. * Note that the assertion of attribution terms contradicts with a
  44. * pure assignment to the public domain.
  45. * Because of the terms, copyright should be understood
  46. * to be asserted by the authors.
  47. * Attribution, according to the above, should be understood
  48. * to be required.
  49. *
  50. * === Modifications for Joe Allen's EXORSIM by Joel Rees, Reiisi Kenkyuu
  51. * Modifications copyright Joel Rees, 2013.
  52. * Permission to use, modify, distribute, and publish the modifications
  53. * is extended under the attribution terms given above,
  54. * with the explicitly affirmed obligation to retain intact
  55. * all authorship and copyright notices, and license notices.
  56. *
  57. * Note that, under my (Joel Rees) recollection and understanding of the
  58. * legal/political context of the original context of publication,
  59. * right to use source code in one's possession was not considered
  60. * deniable in any practical or meaningful sense.
  61. * (Laws such as the DMCA had been proposed by certain advocates for
  62. * the concept of intellectual property under other names,
  63. * but were considered unenforceable and impracticable,
  64. * thus contrary to the purpose of law,
  65. * a waste of resources, and the height of discourtesy
  66. * by the general community of software practicioners at the time,
  67. * to the best of my understanding and recollection.)
  68. * Thus, the lack of explicit mention of a right to use in the terms of
  69. * the effective license should in no wise be considered to imply a
  70. * witholding thereof.
  71. * ===
  72. *
  73. * This version was developed on an AMI EVK 300 PROTO
  74. * system using an ACIA for the I/O. All terminal 1/0
  75. * is done in three subroutines:
  76. * PEMIT ( word # 182 )
  77. * PKEY ( 183 )
  78. * PQTERM ( 184 )
  79. *
  80. * The FORTH words for disc related I/O follow the model
  81. * of the FORTH Interest Group, but have not been
  82. * tested using a real disc.
  83. *
  84. * Addresses in this implementation reflect the fact that,
  85. * on the development system, it was convenient to
  86. * write-protect memory at hex 1000, and leave the first
  87. * 4K bytes write-enabled. As a consequence, code from
  88. * location $1000 to lable ZZZZ could be put in ROM.
  89. * Minor deviations from the model were made in the
  90. * initialization and words ?STACK and FORGET
  91. * in order to do this.
  92. *
  93. *
  94. NBLK EQU 4 # of disc buffer blocks for virtual memory
  95. * MEMEND EQU 132*NBLK+$3000 end of ram
  96. MEMEND EQU 132*NBLK+$4000+132 end of ram with some breathing room
  97. * each block is 132 bytes in size,
  98. * holding 128 characters
  99. *
  100. * MEMTOP EQU $3FFF absolute end of all ram
  101. MEMTOP EQU $7FFF putative absolute end of all ram
  102. * ACIAC EQU $FBCE the ACIA control address and
  103. ACIAC EQU $FCF4 the ACIA control address and
  104. ACIAD EQU ACIAC+1 data address for PROTO
  105. PAGE
  106. * MEMORY MAP for this (not) 16K system:
  107. * ( positioned so that systems with 4k byte write-
  108. * protected segments can write protect FORTH )
  109. *
  110. * addr. contents pointer init by
  111. * **** ******************************* ******* ******
  112. * 3FFF (6FFF) HI
  113. * substitute for disc mass memory
  114. * 3210 (5294) LO,MEMEND
  115. * 320F (5293)
  116. * 4 buffer sectors of VIRTUAL MEMORY
  117. * 3000 (5084) FIRST
  118. * >>>>>> memory from here up must be RAM <<<<<<
  119. *
  120. * 27FF (37FF, but 38XX, with debugging code included the the "ROMable" image.)
  121. * 6k of romable "FORTH" <== IP ABORT
  122. * <== W
  123. * the VIRTUAL FORTH MACHINE
  124. *
  125. * 1004 <<< WARM START ENTRY >>> (2004)
  126. * 1000 <<< COLD START ENTRY >>> (2000)
  127. *
  128. * >>>>>> memory from here down must be RAM <<<<<<
  129. * FFE (1FF0) RETURN STACK base <== RP RINIT
  130. *
  131. * FB4 (less than 1EB4)
  132. * INPUT LINE BUFFER
  133. * holds up to 132 characters
  134. * and is scanned upward by IN
  135. * starting at TIB
  136. * F30 (1E00) <== IN TIB
  137. * F2F (1DF0) DATA STACK <== SP SP0,SINIT
  138. * | grows downward from F2F
  139. * v
  140. * - -
  141. * |
  142. * I DICTIONARY grows upward
  143. *
  144. * 183 (183) end of ram-dictionary. <== DP DPINIT
  145. * "TASK"
  146. *
  147. * 150 (150) "FORTH" ( a word ) <=, <== CONTEXT
  148. * `==== CURRENT
  149. * 148 (148) start of ram-dictionary.
  150. *
  151. * 100 (100) user #l table of variables <= UP DPINIT
  152. * F0 (B0) registers & pointers for the virtual machine
  153. * scratch area used by various words
  154. * E0 (A0) lowest address used by FORTH
  155. *
  156. * 0000
  157. PAGE
  158. ***
  159. *
  160. * CONVENTIONS USED IN THIS PROGRAM ARE AS FOLLOWS :
  161. *
  162. * IP points to the current instruction ( pre-increment mode )
  163. * RP points to second free byte (first free word) in return stack
  164. * SP (hardware SP) points to first free byte in data stack
  165. *
  166. * when A and B hold one 16 bit FORTH data word,
  167. * A contains the high byte, B, the low byte.
  168. ***
  169. * ORG $E0 variables
  170. ORG $A0 variables
  171. N RMB 10 used as scratch by (FIND),ENCLOSE,CMOVE,EMIT,KEY,
  172. * SP@,SWAP,DOES>,COLD
  173. * These locations are used by the TRACE routine :
  174. TRLIM RMB 1 the count for tracing without user intervention
  175. TRACEM RMB 1 non-zero = trace mode
  176. BRKPT RMB 2 the breakpoint address at which
  177. * the program will go into trace mode
  178. VECT RMB 2 vector to machine code
  179. * (only needed if the TRACE routine is resident)
  180. * Registers used by the FORTH virtual machine:
  181. * Starting at $OOFO ($00B0):
  182. W RMB 2 the instruction register points to 6800 code
  183. IP RMB 2 the instruction pointer points to pointer to 6800 code
  184. RP RMB 2 the return stack pointer
  185. UP RMB 2 the pointer to base of current user's 'USER' table
  186. * ( altered during multi-tasking )
  187. *
  188. * For the tracer:
  189. RMB 4
  190. TRASP RMB 2
  191. TRAVEC RMB 2
  192. TRAA RMB 1
  193. TRAB RMB 1
  194. *
  195. PAGE
  196. * This system is shown with one user, but additional users
  197. * may be added by allocating additional user tables:
  198. * UORIG2 RMB 64 data table for user #2
  199. *
  200. *
  201. * Some of this stuff gets initialized during
  202. * COLD start and WARM start:
  203. * [ names correspond to FORTH words of similar (no X) name ]
  204. *
  205. ORG $100
  206. * ORG $1100
  207. UORIG RMB 6 3 reserved variables
  208. XSPZER RMB 2 initial top of data stack for this user
  209. XRZERO RMB 2 initial top of return stack
  210. XTIB RMB 2 start of terminal input buffer
  211. XWIDTH RMB 2 name field width
  212. XWARN RMB 2 warning message mode (0 = no disc)
  213. XFENCE RMB 2 fence for FORGET
  214. XDP RMB 2 dictionary pointer
  215. XVOCL RMB 2 vocabulary linking
  216. XBLK RMB 2 disc block being accessed
  217. XIN RMB 2 scan pointer into the block
  218. XOUT RMB 2 cursor position
  219. XSCR RMB 2 disc screen being accessed ( O=terminal )
  220. XOFSET RMB 2 disc sector offset for multi-disc
  221. XCONT RMB 2 last word in primary search vocabulary
  222. XCURR RMB 2 last word in extensible vocabulary
  223. XSTATE RMB 2 flag for 'interpret' or 'compile' modes
  224. XBASE RMB 2 number base for I/O numeric conversion
  225. XDPL RMB 2 decimal point place
  226. XFLD RMB 2
  227. XCSP RMB 2 current stack position, for compile checks
  228. XRNUM RMB 2
  229. XHLD RMB 2
  230. XDELAY RMB 2 carriage return delay count
  231. XCOLUM RMB 2 carriage width
  232. IOSTAT RMB 2 last acia status from write/read
  233. RMB 2 ( 4 spares! )
  234. RMB 2
  235. RMB 2
  236. RMB 2
  237. *
  238. *
  239. * end of user table, start of common system variables
  240. *
  241. *
  242. *
  243. XUSE RMB 2
  244. XPREV RMB 2
  245. RMB 4 ( spares )
  246. PAGE
  247. * These things, up through the lable 'REND', are overwritten
  248. * at time of cold load and should have the same contents
  249. * as shown here:
  250. *
  251. FCB $C5 immediate
  252. FCC 4,FORTH
  253. FCB $C8
  254. FDB NOOP-7
  255. FORTH FDB DODOES,DOVOC,$81A0,TASK-7
  256. FDB 0
  257. *
  258. FCC "(C) Forth Interest Group, 1979"
  259. FCB $84
  260. FCC 3,TASK
  261. FCB $CB
  262. FDB FORTH-8
  263. TASK FDB DOCOL,SEMIS
  264. *
  265. REND EQU * ( first empty location in dictionary )
  266. PAGE
  267. * The FORTH program ( address $1000 ($2000) to $27FF (37FF?) ) is written
  268. * so that it can be in a ROM, or write-protected if desired
  269. ORG $2000
  270. * ######>> screen 3 <<
  271. *
  272. ***************************
  273. ** C O L D E N T R Y **
  274. ***************************
  275. ORIG NOP
  276. JMP CENT
  277. ***************************
  278. ** W A R M E N T R Y **
  279. ***************************
  280. NOP
  281. JMP WENT warm-start code, keeps current dictionary intact
  282. *
  283. ******* startup parmeters **************************
  284. *
  285. FDB $6800,0000 cpu & revision
  286. FDB 0 topmost word in FORTH vocabulary
  287. BACKSP FDB $7F backspace character for editing
  288. UPINIT FDB UORIG initial user area
  289. *SINIT FDB ORIG-$D0 initial top of data stack
  290. SINIT FDB ORIG-$210 initial top of data stack
  291. *RINIT FDB ORIG-2 initial top of return stack
  292. RINIT FDB ORIG-$10 initial top of return stack
  293. * FDB ORIG-$D0 terminal input buffer
  294. FDB ORIG-$200 terminal input buffer
  295. FDB 31 initial name field width
  296. * FDB 0 initial warning mode (0 = no disc)
  297. FDB 1 initial warning mode (because we're simulating disc)
  298. FENCIN FDB REND initial fence
  299. DPINIT FDB REND cold start value for DP
  300. VOCINT FDB FORTH+8
  301. COLINT FDB 132 initial terminal carriage width
  302. DELINT FDB 4 initial carriage return delay
  303. ****************************************************
  304. *
  305. PAGE
  306. *
  307. * ######>> screen 13 <<
  308. PULABX PUL A 24 cycles until 'NEXT'
  309. PUL B
  310. STABX STA A 0,X 16 cycles until 'NEXT'
  311. STA B 1,X
  312. BRA NEXT
  313. GETX LDA A 0,X 18 cycles until 'NEXT'
  314. LDA B 1,X
  315. PUSHBA PSH B 8 cycles until 'NEXT'
  316. PSH A
  317. *
  318. * "NEXT" takes 38 cycles if TRACE is removed,
  319. *
  320. * and 95 cycles if NOT tracing.
  321. *
  322. * = = = = = = = t h e v i r t u a l m a c h i n e = = = = =
  323. * =
  324. NEXT LDX IP
  325. INX pre-increment mode
  326. INX
  327. STX IP
  328. NEXT2 LDX 0,X get W which points to CFA of word to be done
  329. NEXT3 STX W
  330. LDX 0,X get VECT which points to executable code
  331. * =
  332. * The next instruction could be patched to JMP TRACE =
  333. * if a TRACE routine is available: =
  334. * =
  335. * Or add the TRACE routine in-line, since we are assembling it.
  336. TST TRACEM
  337. BEQ NEXTGO
  338. STX TRAVEC
  339. TSX ; So the funn 6800 stack doesn't beach us.
  340. STX TRASP
  341. LDA A #':'
  342. JSR PEMIT
  343. LDA A #' '
  344. JSR PEMIT
  345. LDX W
  346. DEX
  347. DEX ; allocation link
  348. DEX ; last char
  349. LDA A #31
  350. NAMTST DEX ; length byte?
  351. LDA B 0,X
  352. BMI NAMTDN
  353. DEC A
  354. BNE NAMTST
  355. NAMTDN AND B #31 ; It's the length byte whether it wants to be or not.
  356. NAMSHW INX
  357. LDA A 0,X
  358. JSR PEMIT
  359. DEC B
  360. BNE NAMSHW
  361. * show the virtual registers
  362. LDA A #' '
  363. JSR PEMIT
  364. LDA A #'@'
  365. LDX #TRAVEC
  366. JSR PHEX4F
  367. LDA A #'W'
  368. LDX #W
  369. JSR PHEX4F
  370. LDA A #'I'
  371. JSR PHEX4F
  372. LDA A #'R'
  373. JSR PHEX4F
  374. LDA A #'U'
  375. JSR PHEX4F
  376. LDA A #'S'
  377. LDX #TRASP
  378. BSR PHEX4F
  379. LDA A #'>'
  380. TSX
  381. BSR PHEX4F
  382. LDA A #' '
  383. BSR PHEX4F
  384. *
  385. JSR PCR
  386. LDX TRAVEC
  387. *
  388. NEXTGO JMP 0,X
  389. NOP
  390. * JMP TRACE ( an alternate for the above )
  391. * =
  392. *DBG
  393. PHEX4F JSR PEMIT
  394. BSR PHEXX2
  395. BSR PHEXX2
  396. LDA A #' '
  397. JSR PEMIT
  398. RTS
  399. PHEXX2 LDA A 0,X
  400. LSR A
  401. LSR A
  402. LSR A
  403. LSR A
  404. JSR PHEXD
  405. LDA A 0,X
  406. JSR PHEXD
  407. INX
  408. RTS
  409. PHEXD AND A #$0F
  410. CMP A #10
  411. BLO PHEXDH
  412. ADD A #7 ; 'A'-'9'+1
  413. PHEXDH ADD A #'0'
  414. JSR PEMIT
  415. RTS
  416. *DBG
  417. * = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
  418. PAGE
  419. *
  420. * ======>> 1 <<
  421. FCB $83
  422. FCC 2,LIT NOTE: this is different from LITERAL
  423. FCB $D4
  424. FDB 0 link of zero to terminate dictionary scan
  425. LIT FDB *+2
  426. LDX IP
  427. INX
  428. INX
  429. STX IP
  430. LDA A 0,X
  431. LDA B 1,X
  432. JMP PUSHBA
  433. *
  434. * ######>> screen 14 <<
  435. * ======>> 2 <<
  436. *DBG
  437. FCB $85
  438. FCC 4,XCLIT ; for debugging
  439. FCB $D4
  440. FDB LIT-6 ; should never link
  441. *DBG
  442. CLITER FDB *+2 (this is an invisible word, with no header)
  443. LDX IP
  444. INX
  445. STX IP
  446. CLR A
  447. LDA B 1,X
  448. JMP PUSHBA
  449. *
  450. * ======>> 3 <<
  451. FCB $87
  452. FCC 6,EXECUTE
  453. FCB $C5
  454. FDB LIT-6
  455. EXEC FDB *+2
  456. TSX
  457. LDX 0,X get code field address (CFA)
  458. INS pop stack
  459. INS
  460. JMP NEXT3
  461. *
  462. * ######>> screen 15 <<
  463. * ======>> 4 <<
  464. FCB $86
  465. FCC 5,BRANCH
  466. FCB $C8
  467. FDB EXEC-10
  468. BRAN FDB ZBYES Go steal code in ZBRANCH
  469. *
  470. * ======>> 5 <<
  471. FCB $87
  472. FCC 6,0BRANCH
  473. FCB $C8
  474. FDB BRAN-9
  475. ZBRAN FDB *+2
  476. PULA
  477. PULB
  478. ABA
  479. BNE ZBNO
  480. BCS ZBNO
  481. ZBYES LDX IP Note: code is shared with BRANCH, (+LOOP), (LOOP)
  482. LDA B 3,X
  483. LDA A 2,X
  484. ADD B IP+1
  485. ADC A IP
  486. STA B IP+1
  487. STA A IP
  488. JMP NEXT
  489. ZBNO LDX IP no branch. This code is shared with (+LOOP), (LOOP).
  490. INX jump over branch delta
  491. INX
  492. STX IP
  493. JMP NEXT
  494. *
  495. * ######>> screen 16 <<
  496. * ======>> 6 <<
  497. FCB $86
  498. FCC 5,(LOOP)
  499. FCB $A9
  500. FDB ZBRAN-10
  501. XLOOP FDB *+2
  502. CLR A
  503. LDA B #1 get set to increment counter by 1
  504. BRA XPLOP2 go steal other guy's code!
  505. *
  506. * ======>> 7 <<
  507. FCB $87
  508. FCC 6,(+LOOP)
  509. FCB $A9
  510. FDB XLOOP-9
  511. XPLOOP FDB *+2 Note: +LOOP has an un-signed loop counter
  512. PUL A get increment
  513. PUL B
  514. XPLOP2 TST A
  515. BPL XPLOF forward looping
  516. BSR XPLOPS
  517. SEC
  518. SBC B 5,X
  519. SBC A 4,X
  520. BPL ZBYES
  521. BRA XPLONO fall through
  522. *
  523. * the subroutine :
  524. XPLOPS LDX RP
  525. ADD B 3,X add it to counter
  526. ADC A 2,X
  527. STA B 3,X store new counter value
  528. STA A 2,X
  529. RTS
  530. *
  531. XPLOF BSR XPLOPS
  532. SUB B 5,X
  533. SBC A 4,X
  534. BMI ZBYES
  535. *
  536. XPLONO INX done, don't branch back
  537. INX
  538. INX
  539. INX
  540. STX RP
  541. BRA ZBNO use ZBRAN to skip over unused delta
  542. *
  543. * ######>> screen 17 <<
  544. * ======>> 8 <<
  545. FCB $84
  546. FCC 3,(DO)
  547. FCB $A9
  548. FDB XPLOOP-10
  549. XDO FDB *+2 This is the RUNTIME DO, not the COMPILING DO
  550. LDX RP
  551. DEX
  552. DEX
  553. DEX
  554. DEX
  555. STX RP
  556. PUL A
  557. PUL B
  558. STA A 2,X
  559. STA B 3,X
  560. PUL A
  561. PUL B
  562. STA A 4,X
  563. STA B 5,X
  564. JMP NEXT
  565. *
  566. * ======>> 9 <<
  567. FCB $81 I
  568. FCB $C9
  569. FDB XDO-7
  570. I FDB *+2
  571. LDX RP
  572. INX
  573. INX
  574. JMP GETX
  575. *
  576. * ######>> screen 18 <<
  577. * ======>> 10 <<
  578. FCB $85
  579. FCC 4,DIGIT
  580. FCB $D4
  581. FDB I-4
  582. DIGIT FDB *+2 NOTE: legal input range is 0-9, A-Z
  583. TSX
  584. LDA A 3,X
  585. SUB A #$30 ascii zero
  586. BMI DIGIT2 IF LESS THAN '0', ILLEGAL
  587. CMP A #$A
  588. BMI DIGIT0 IF '9' OR LESS
  589. CMP A #$11
  590. BMI DIGIT2 if less than 'A'
  591. CMP A #$2B
  592. BPL DIGIT2 if greater than 'Z'
  593. SUB A #7 translate 'A' thru 'F'
  594. DIGIT0 CMP A 1,X
  595. BPL DIGIT2 if not less than the base
  596. LDA B #1 set flag
  597. STA A 3,X store digit
  598. DIGIT1 STA B 1,X store the flag
  599. JMP NEXT
  600. DIGIT2 CLR B
  601. INS
  602. INS pop bottom number
  603. TSX
  604. STA B 0,X make sure both bytes are 00
  605. BRA DIGIT1
  606. *
  607. * ######>> screen 19 <<
  608. *
  609. * The word format in the dictionary is:
  610. *
  611. * char-count + $80 lowest address
  612. * char 1
  613. * char 2
  614. *
  615. * char n + $80
  616. * link high byte \___point to previous word
  617. * link low byte /
  618. * CFA high byte \___pnt to 6800 code
  619. * CFA low byte /
  620. * parameter fields
  621. * "
  622. * "
  623. * "
  624. *
  625. * ======>> 11 <<
  626. FCB $86
  627. FCC 5,(FIND)
  628. FCB $A9
  629. FDB DIGIT-8
  630. PFIND FDB *+2
  631. NOP
  632. NOP
  633. PD EQU N ptr to dict word being checked
  634. PA0 EQU N+2
  635. PA EQU N+4
  636. PC EQU N+6
  637. LDX #PD
  638. LDA B #4
  639. PFIND0 PUL A loop to get arguments
  640. STA A 0,X
  641. INX
  642. DEC B
  643. BNE PFIND0
  644. *
  645. LDX PD
  646. PFIND1 LDA B 0,X get count dict count
  647. STA B PC
  648. AND B #$3F
  649. INX
  650. STX PD update PD
  651. LDX PA0
  652. LDA A 0,X get count from arg
  653. INX
  654. STX PA intialize PA
  655. CBA compare lengths
  656. BNE PFIND4
  657. PFIND2 LDX PA
  658. LDA A 0,X
  659. INX
  660. STX PA
  661. LDX PD
  662. LDA B 0,X
  663. INX
  664. STX PD
  665. TST B is dict entry neg. ?
  666. BPL PFIND8
  667. AND B #$7F clear sign
  668. CBA
  669. BEQ FOUND
  670. PFIND3 LDX 0,X get new link
  671. BNE PFIND1 continue if link not=0
  672. *
  673. * not found :
  674. *
  675. CLR A
  676. CLR B
  677. JMP PUSHBA
  678. PFIND8 CBA
  679. BEQ PFIND2
  680. PFIND4 LDX PD
  681. PFIND9 LDA B 0,X scan forward to end of this name
  682. INX
  683. BPL PFIND9
  684. BRA PFIND3
  685. *
  686. * found :
  687. *
  688. FOUND LDA A PD compute CFA
  689. LDA B PD+1
  690. ADD B #4
  691. ADC A #0
  692. PSH B
  693. PSH A
  694. LDA A PC
  695. PSH A
  696. CLR A
  697. PSH A
  698. LDA B #1
  699. JMP PUSHBA
  700. *
  701. PSH A
  702. CLR A
  703. PSH A
  704. LDA B #1
  705. JMP PUSHBA
  706. *
  707. * ######>> screen 20 <<
  708. * ======>> 12 <<
  709. FCB $87
  710. FCC 6,ENCLOSE
  711. FCB $C5
  712. FDB PFIND-9
  713. * NOTE :
  714. * FC means offset (bytes) to First Character of next word
  715. * EW " " to End of Word
  716. * NC " " to Next Character to start next enclose at
  717. ENCLOS FDB *+2
  718. INS
  719. PUL B now, get the low byte, for an 8-bit delimiter
  720. TSX
  721. LDX 0,X
  722. CLR N
  723. * wait for a non-delimiter or a NUL
  724. ENCL2 LDA A 0,X
  725. BEQ ENCL6
  726. CBA CHECK FOR DELIM
  727. BNE ENCL3
  728. INX
  729. INC N
  730. BRA ENCL2
  731. * found first character. Push FC
  732. ENCL3 LDA A N found first char.
  733. PSH A
  734. CLR A
  735. PSH A
  736. * wait for a delimiter or a NUL
  737. ENCL4 LDA A 0,X
  738. BEQ ENCL7
  739. CBA ckech for delim.
  740. BEQ ENCL5
  741. INX
  742. INC N
  743. BRA ENCL4
  744. * found EW. Push it
  745. ENCL5 LDA B N
  746. CLR A
  747. PSH B
  748. PSH A
  749. * advance and push NC
  750. INC B
  751. JMP PUSHBA
  752. * found NUL before non-delimiter, therefore there is no word
  753. ENCL6 LDA B N found NUL
  754. PSH B
  755. PSH A
  756. INC B
  757. BRA ENCL7+2
  758. * found NUL following the word instead of SPACE
  759. ENCL7 LDA B N
  760. PSH B save EW
  761. PSH A
  762. ENCL8 LDA B N save NC
  763. JMP PUSHBA
  764. PAGE
  765. *
  766. * ######>> screen 21 <<
  767. * The next 4 words call system dependant I/O routines
  768. * which are listed after word "-->" ( lable: "arrow" )
  769. * in the dictionary.
  770. *
  771. * ======>> 13 <<
  772. FCB $84
  773. FCC 3,EMIT
  774. FCB $D4
  775. FDB ENCLOS-10
  776. EMIT FDB *+2
  777. PUL A
  778. PUL A
  779. JSR PEMIT
  780. LDX UP
  781. INC XOUT+1-UORIG,X
  782. BNE *+4
  783. INC XOUT-UORIG,X
  784. JMP NEXT
  785. *
  786. * ======>> 14 <<
  787. FCB $83
  788. FCC 2,KEY
  789. FCB $D9
  790. FDB EMIT-7
  791. KEY FDB *+2
  792. JSR PKEY
  793. PSH A
  794. CLR A
  795. PSH A
  796. JMP NEXT
  797. *
  798. * ======>> 15 <<
  799. FCB $89
  800. FCC 8,?TERMINAL
  801. FCB $CC
  802. FDB KEY-6
  803. QTERM FDB *+2
  804. JSR PQTER
  805. CLR B
  806. JMP PUSHBA stack the flag
  807. *
  808. * ======>> 16 <<
  809. FCB $82
  810. FCC 1,CR
  811. FCB $D2
  812. FDB QTERM-12
  813. CR FDB *+2
  814. JSR PCR
  815. JMP NEXT
  816. *
  817. * ######>> screen 22 <<
  818. * ======>> 17 <<
  819. FCB $85
  820. FCC 4,CMOVE source, destination, count
  821. FCB $C5
  822. FDB CR-5
  823. CMOVE FDB *+2 takes ( 43+47*count cycles )
  824. LDX #N
  825. LDA B #6
  826. CMOV1 PUL A
  827. STA A 0,X move parameters to scratch area
  828. INX
  829. DEC B
  830. BNE CMOV1
  831. CMOV2 LDA A N
  832. LDA B N+1
  833. SUB B #1
  834. SBC A #0
  835. STA A N
  836. STA B N+1
  837. BCS CMOV3
  838. LDX N+4
  839. LDA A 0,X
  840. INX
  841. STX N+4
  842. LDX N+2
  843. STA A 0,X
  844. INX
  845. STX N+2
  846. BRA CMOV2
  847. CMOV3 JMP NEXT
  848. *
  849. * ######>> screen 23 <<
  850. * ======>> 18 <<
  851. FCB $82
  852. FCC 1,U*
  853. FCB $AA
  854. FDB CMOVE-8
  855. USTAR FDB *+2
  856. BSR USTARS
  857. INS
  858. INS
  859. JMP PUSHBA
  860. *
  861. * The following is a subroutine which
  862. * multiplies top 2 words on stack,
  863. * leaving 32-bit result: high order word in A,B
  864. * low order word in 2nd word of stack.
  865. *
  866. USTARS LDA A #16 bits/word counter
  867. PSH A
  868. CLR A
  869. CLR B
  870. TSX
  871. USTAR2 ROR 5,X shift multiplier
  872. ROR 6,X
  873. DEC 0,X done?
  874. BMI USTAR4
  875. BCC USTAR3
  876. ADD B 4,X
  877. ADC A 3,X
  878. USTAR3 ROR A
  879. ROR B shift result
  880. BRA USTAR2
  881. USTAR4 INS dump counter
  882. RTS
  883. *
  884. * ######>> screen 23.1 <<
  885. * ======>> 18.1 << *** NEW DOUBLES
  886. FCB $82
  887. FCC 1,2*
  888. FCB $AA
  889. FDB USTAR-5
  890. U2STAR FDB *+2
  891. TSX
  892. LSL 1,X
  893. ROL 0,X
  894. JMP NEXT
  895. * Want to keep the carry!
  896. * Maybe like this:
  897. * TPA
  898. * AND A #1
  899. * TAB
  900. * JMP PUSHBA
  901. * or like this;
  902. * LDA A #0 ; CLR would clear the carry
  903. * LDA B #0
  904. * BCC U2STAL
  905. * COM B
  906. * COM A
  907. *U2STAL JMP NEXT
  908. *
  909. * ======>> 18.3 << *** NEW DOUBLES
  910. FCB $83
  911. FCC 2,U2/
  912. FCB $AF
  913. FDB U2STAR-5
  914. U2SLAH FDB *+2
  915. TSX
  916. LSR 0,X
  917. ROR 1,X
  918. JMP NEXT
  919. * Want to keep the carry!
  920. *
  921. * ######>> screen 24 <<
  922. * ======>> 19 <<
  923. FCB $82
  924. FCC 1,U/
  925. FCB $AF
  926. FDB U2SLAH-6
  927. USLASH FDB *+2
  928. * Avoid extra shifts for 32 bit dividend by just doing one cell of dividend.
  929. * Expanding the dividend is straightforward, unlike the divisor.
  930. LDA A #17
  931. PSH A
  932. TSX
  933. LDA A 3,X
  934. LDA B 4,X
  935. USL1 CMP A 1,X
  936. BHI USL3
  937. BCS USL2
  938. CMP B 2,X
  939. BCC USL3
  940. USL2 CLC
  941. BRA USL4
  942. USL3 SUB B 2,X
  943. SBC A 1,X
  944. SEC
  945. USL4 ROL 6,X
  946. ROL 5,X
  947. DEC 0,X
  948. BEQ USL5
  949. ROL B
  950. ROL A
  951. BCC USL1
  952. BRA USL3
  953. USL5 INS
  954. INS
  955. INS
  956. INS
  957. INS
  958. JMP SWAP+4 reverse quotient & remainder
  959. *
  960. * ######>> screen 25 <<
  961. * ======>> 20 <<
  962. FCB $83
  963. FCC 2,AND
  964. FCB $C4
  965. FDB USLASH-5
  966. AND FDB *+2
  967. PUL A
  968. PUL B
  969. TSX
  970. AND B 1,X
  971. AND A 0,X
  972. JMP STABX
  973. *
  974. * ======>> 21 <<
  975. FCB $82
  976. FCC 1,OR
  977. FCB $D2
  978. FDB AND-6
  979. OR FDB *+2
  980. PUL A
  981. PUL B
  982. TSX
  983. ORA B 1,X
  984. ORA A 0,X
  985. JMP STABX
  986. *
  987. * ======>> 22 <<
  988. FCB $83
  989. FCC 2,XOR
  990. FCB $D2
  991. FDB OR-5
  992. XOR FDB *+2
  993. PUL A
  994. PUL B
  995. TSX
  996. EOR B 1,X
  997. EOR A 0,X
  998. JMP STABX
  999. *
  1000. * ######>> screen 26 <<
  1001. * ======>> 23 <<
  1002. FCB $83
  1003. FCC 2,SP@
  1004. FCB $C0
  1005. FDB XOR-6
  1006. SPAT FDB *+2
  1007. TSX
  1008. STX N scratch area
  1009. LDX #N
  1010. JMP GETX
  1011. *
  1012. * ======>> 24 <<
  1013. FCB $83
  1014. FCC 2,SP!
  1015. FCB $A1
  1016. FDB SPAT-6
  1017. SPSTOR FDB *+2
  1018. LDX UP
  1019. LDX XSPZER-UORIG,X
  1020. TXS watch it ! X and S are not equal.
  1021. JMP NEXT
  1022. * ======>> 25 <<
  1023. FCB $83
  1024. FCC 2,RP!
  1025. FCB $A1
  1026. FDB SPSTOR-6
  1027. RPSTOR FDB *+2
  1028. LDX RINIT initialize from rom constant
  1029. STX RP
  1030. JMP NEXT
  1031. *
  1032. * ======>> 26 <<
  1033. FCB $82
  1034. FCC 1,;S
  1035. FCB $D3
  1036. FDB RPSTOR-6
  1037. SEMIS FDB *+2
  1038. LDX RP
  1039. INX
  1040. INX
  1041. STX RP
  1042. LDX 0,X get address we have just finished.
  1043. JMP NEXT+2 increment the return address & do next word
  1044. *
  1045. * ######>> screen 27 <<
  1046. * ======>> 27 <<
  1047. FCB $85
  1048. FCC 4,LEAVE
  1049. FCB $C5
  1050. FDB SEMIS-5
  1051. LEAVE FDB *+2
  1052. LDX RP
  1053. LDA A 2,X
  1054. LDA B 3,X
  1055. STA A 4,X
  1056. STA B 5,X
  1057. JMP NEXT
  1058. *
  1059. * ======>> 28 <<
  1060. FCB $82
  1061. FCC 1,>R
  1062. FCB $D2
  1063. FDB LEAVE-8
  1064. TOR FDB *+2
  1065. LDX RP
  1066. DEX
  1067. DEX
  1068. STX RP
  1069. PUL A
  1070. PUL B
  1071. STA A 2,X
  1072. STA B 3,X
  1073. JMP NEXT
  1074. *
  1075. * ======>> 29 <<
  1076. FCB $82
  1077. FCC 1,R>
  1078. FCB $BE
  1079. FDB TOR-5
  1080. FROMR FDB *+2
  1081. LDX RP
  1082. LDA A 2,X
  1083. LDA B 3,X
  1084. INX
  1085. INX
  1086. STX RP
  1087. JMP PUSHBA
  1088. *
  1089. * ======>> 30 <<
  1090. FCB $81 R
  1091. FCB $D2
  1092. FDB FROMR-5
  1093. R FDB *+2
  1094. LDX RP
  1095. INX
  1096. INX
  1097. JMP GETX
  1098. *
  1099. * ######>> screen 28 <<
  1100. * ======>> 31 <<
  1101. FCB $82
  1102. FCC 1,0=
  1103. FCB $BD
  1104. FDB R-4
  1105. ZEQU FDB *+2
  1106. TSX
  1107. CLR A
  1108. CLR B
  1109. LDX 0,X
  1110. BNE ZEQU2
  1111. INC B
  1112. ZEQU2 TSX
  1113. JMP STABX
  1114. *
  1115. * ======>> 32 <<
  1116. FCB $82
  1117. FCC 1,0<
  1118. FCB $BC
  1119. FDB ZEQU-5
  1120. ZLESS FDB *+2
  1121. TSX
  1122. LDA A #$80 check the sign bit
  1123. AND A 0,X
  1124. BEQ ZLESS2
  1125. CLR A if neg.
  1126. LDA B #1
  1127. JMP STABX
  1128. ZLESS2 CLR B
  1129. JMP STABX
  1130. *
  1131. * ######>> screen 29 <<
  1132. * ======>> 33 <<
  1133. FCB $81 '+'
  1134. FCB $AB
  1135. FDB ZLESS-5
  1136. PLUS FDB *+2
  1137. PUL A
  1138. PUL B
  1139. TSX
  1140. ADD B 1,X
  1141. ADC A 0,X
  1142. JMP STABX
  1143. *
  1144. * ======>> 34 <<
  1145. FCB $82
  1146. FCC 1,D+
  1147. FCB $AB
  1148. FDB PLUS-4
  1149. DPLUS FDB *+2
  1150. TSX
  1151. CLC
  1152. LDA B #4
  1153. DPLUS2 LDA A 3,X
  1154. ADC A 7,X
  1155. STA A 7,X
  1156. DEX
  1157. DEC B
  1158. BNE DPLUS2
  1159. INS
  1160. INS
  1161. INS
  1162. INS
  1163. JMP NEXT
  1164. *
  1165. * ======>> 35 <<
  1166. FCB $85
  1167. FCC 4,MINUS
  1168. FCB $D3
  1169. FDB DPLUS-5
  1170. MINUS FDB *+2
  1171. TSX
  1172. NEG 1,X
  1173. BCC MINUS2
  1174. NEG 0,X
  1175. BRA MINUS3
  1176. MINUS2 COM 0,X
  1177. MINUS3 JMP NEXT
  1178. *
  1179. * ======>> 36 <<
  1180. FCB $86
  1181. FCC 5,DMINUS
  1182. FCB $D3
  1183. FDB MINUS-8
  1184. DMINUS FDB *+2
  1185. TSX
  1186. COM 0,X
  1187. COM 1,X
  1188. COM 2,X
  1189. NEG 3,X
  1190. BNE DMINX
  1191. INC 2,X
  1192. BNE DMINX
  1193. INC 1,X
  1194. BNE DMINX
  1195. INC 0,X
  1196. DMINX JMP NEXT
  1197. *
  1198. * ######>> screen 30 <<
  1199. * ======>> 37 <<
  1200. FCB $84
  1201. FCC 3,OVER
  1202. FCB $D2
  1203. FDB DMINUS-9
  1204. OVER FDB *+2
  1205. TSX
  1206. LDA A 2,X
  1207. LDA B 3,X
  1208. JMP PUSHBA
  1209. *
  1210. * ======>> 38 <<
  1211. FCB $84
  1212. FCC 3,DROP
  1213. FCB $D0
  1214. FDB OVER-7
  1215. DROP FDB *+2
  1216. INS
  1217. INS
  1218. JMP NEXT
  1219. *
  1220. * ======>> 39 <<
  1221. FCB $84
  1222. FCC 3,SWAP
  1223. FCB $D0
  1224. FDB DROP-7
  1225. SWAP FDB *+2
  1226. PUL A
  1227. PUL B
  1228. TSX
  1229. LDX 0,X
  1230. INS
  1231. INS
  1232. PSH B
  1233. PSH A
  1234. STX N
  1235. LDX #N
  1236. JMP GETX
  1237. *
  1238. * ======>> 40 <<
  1239. FCB $83
  1240. FCC 2,DUP
  1241. FCB $D0
  1242. FDB SWAP-7
  1243. DUP FDB *+2
  1244. PUL A
  1245. PUL B
  1246. PSH B
  1247. PSH A
  1248. JMP PUSHBA
  1249. *
  1250. * ######>> screen 31 <<
  1251. * ======>> 41 <<
  1252. FCB $82
  1253. FCC 1,+!
  1254. FCB $A1
  1255. FDB DUP-6
  1256. PSTORE FDB *+2
  1257. TSX
  1258. LDX 0,X
  1259. INS
  1260. INS
  1261. PUL A get stack data
  1262. PUL B
  1263. ADD B 1,X add & store low byte
  1264. STA B 1,X
  1265. ADC A 0,X add & store hi byte
  1266. STA A 0,X
  1267. JMP NEXT
  1268. *
  1269. * ======>> 42 <<
  1270. FCB $86
  1271. FCC 5,TOGGLE
  1272. FCB $C5
  1273. FDB PSTORE-5
  1274. TOGGLE FDB DOCOL,OVER,CAT,XOR,SWAP,CSTORE
  1275. FDB SEMIS
  1276. *
  1277. * ######>> screen 32 <<
  1278. * ======>> 43 <<
  1279. FCB $81 @
  1280. FCB $C0
  1281. FDB TOGGLE-9
  1282. AT FDB *+2
  1283. TSX
  1284. LDX 0,X get address
  1285. INS
  1286. INS
  1287. JMP GETX
  1288. *
  1289. * ======>> 44 <<
  1290. FCB $82
  1291. FCC 1,C@
  1292. FCB $C0
  1293. FDB AT-4
  1294. CAT FDB *+2
  1295. TSX
  1296. LDX 0,X
  1297. CLR A
  1298. LDA B 0,X
  1299. INS
  1300. INS
  1301. JMP PUSHBA
  1302. *
  1303. * ======>> 45 <<
  1304. FCB $81
  1305. FCB $A1
  1306. FDB CAT-5
  1307. STORE FDB *+2
  1308. TSX
  1309. LDX 0,X get address
  1310. INS
  1311. INS
  1312. JMP PULABX
  1313. *
  1314. * ======>> 46 <<
  1315. FCB $82
  1316. FCC 1,C!
  1317. FCB $A1
  1318. FDB STORE-4
  1319. CSTORE FDB *+2
  1320. TSX
  1321. LDX 0,X get address
  1322. INS
  1323. INS
  1324. INS
  1325. PUL B
  1326. STA B 0,X
  1327. JMP NEXT
  1328. PAGE
  1329. *
  1330. * ######>> screen 33 <<
  1331. * ======>> 47 <<
  1332. FCB $C1 : immediate
  1333. FCB $BA
  1334. FDB CSTORE-5
  1335. COLON FDB DOCOL,QEXEC,SCSP,CURENT,AT,CONTXT,STORE
  1336. FDB CREATE,RBRAK
  1337. FDB PSCODE
  1338. * Here is the IP pusher for allowing
  1339. * nested words in the virtual machine:
  1340. * ( ;S is the equivalent un-nester )
  1341. DOCOL LDX RP make room in the stack
  1342. DEX
  1343. DEX
  1344. STX RP
  1345. LDA A IP
  1346. LDA B IP+1
  1347. STA A 2,X Store address of the high level word
  1348. STA B 3,X that we are starting to execute
  1349. LDX W Get first sub-word of that definition
  1350. JMP NEXT+2 and execute it
  1351. *
  1352. * ======>> 48 <<
  1353. FCB $C1 ; imnediate code
  1354. FCB $BB
  1355. FDB COLON-4
  1356. SEMI FDB DOCOL,QCSP,COMPIL,SEMIS,SMUDGE,LBRAK
  1357. FDB SEMIS
  1358. *
  1359. * ######>> screen 34 <<
  1360. * ======>> 49 <<
  1361. FCB $88
  1362. FCC 7,CONSTANT
  1363. FCB $D4
  1364. FDB SEMI-4
  1365. CON FDB DOCOL,CREATE,SMUDGE,COMMA,PSCODE
  1366. DOCON LDX W
  1367. LDA A 2,X
  1368. LDA B 3,X A & B now contain the constant
  1369. JMP PUSHBA
  1370. *
  1371. * ======>> 50 <<
  1372. FCB $88
  1373. FCC 7,VARIABLE
  1374. FCB $C5
  1375. FDB CON-11
  1376. VAR FDB DOCOL,CON,PSCODE
  1377. DOVAR LDA A W
  1378. LDA B W+1
  1379. ADD B #2
  1380. ADC A #0 A,B now contain the address of the variable
  1381. JMP PUSHBA
  1382. *
  1383. * ======>> 51 <<
  1384. FCB $84
  1385. FCC 3,USER
  1386. FCB $D2
  1387. FDB VAR-11
  1388. USER FDB DOCOL,CON,PSCODE
  1389. DOUSER LDX W get offset into user's table
  1390. LDA A 2,X
  1391. LDA B 3,X
  1392. ADD B UP+1 add to users base address
  1393. ADC A UP
  1394. JMP PUSHBA push address of user's variable
  1395. *
  1396. * ######>> screen 35 <<
  1397. * ======>> 52 <<
  1398. FCB $81
  1399. FCB $B0 0
  1400. FDB USER-7
  1401. ZERO FDB DOCON
  1402. FDB 0000
  1403. *
  1404. * ======>> 53 <<
  1405. FCB $81
  1406. FCB $B1 1
  1407. FDB ZERO-4
  1408. ONE FDB DOCON
  1409. FDB 1
  1410. *
  1411. * ======>> 54 <<
  1412. FCB $81
  1413. FCB $B2 2
  1414. FDB ONE-4
  1415. TWO FDB DOCON
  1416. FDB 2
  1417. *
  1418. * ======>> 55 <<
  1419. FCB $81
  1420. FCB $B3 3
  1421. FDB TWO-4
  1422. THREE FDB DOCON
  1423. FDB 3
  1424. *
  1425. * ======>> 56 <<
  1426. FCB $82
  1427. FCC 1,BL
  1428. FCB $CC
  1429. FDB THREE-4
  1430. BL FDB DOCON ascii blank
  1431. FDB $20
  1432. *
  1433. * ======>> 57 <<
  1434. FCB $85
  1435. FCC 4,FIRST
  1436. FCB $D4
  1437. FDB BL-5
  1438. FIRST FDB DOCON
  1439. FDB MEMEND-528 (132 * NBLK)
  1440. *
  1441. * ======>> 58 <<
  1442. FCB $85
  1443. FCC 4,LIMIT ( the end of memory +1 )
  1444. FCB $D4
  1445. FDB FIRST-8
  1446. LIMIT FDB DOCON
  1447. FDB MEMEND
  1448. *
  1449. * ======>> 59 <<
  1450. FCB $85
  1451. FCC 4,B/BUF (bytes/buffer)
  1452. FCB $C6
  1453. FDB LIMIT-8
  1454. BBUF FDB DOCON
  1455. FDB 128
  1456. *
  1457. * ======>> 60 <<
  1458. FCB $85
  1459. FCC 4,B/SCR (blocks/screen)
  1460. FCB $D2
  1461. FDB BBUF-8
  1462. BSCR FDB DOCON
  1463. FDB 8
  1464. * blocks/screen = 1024 / "B/BUF" = 8
  1465. *
  1466. * ======>> 61 <<
  1467. FCB $87
  1468. FCC 6,+ORIGIN
  1469. FCB $CE
  1470. FDB BSCR-8
  1471. PORIG FDB DOCOL,LIT,ORIG,PLUS
  1472. FDB SEMIS
  1473. *
  1474. * ######>> screen 36 <<
  1475. * ======>> 62 <<
  1476. FCB $82
  1477. FCC 1,S0
  1478. FCB $B0
  1479. FDB PORIG-10
  1480. SZERO FDB DOUSER
  1481. FDB XSPZER-UORIG
  1482. *
  1483. * ======>> 63 <<
  1484. FCB $82
  1485. FCC 1,R0
  1486. FCB $B0
  1487. FDB SZERO-5
  1488. RZERO FDB DOUSER
  1489. FDB XRZERO-UORIG
  1490. *
  1491. * ======>> 64 <<
  1492. FCB $83
  1493. FCC 2,TIB
  1494. FCB $C2
  1495. FDB RZERO-5
  1496. TIB FDB DOUSER
  1497. FDB XTIB-UORIG
  1498. *
  1499. * ======>> 65 <<
  1500. FCB $85
  1501. FCC 4,WIDTH
  1502. FCB $C8
  1503. FDB TIB-6
  1504. WIDTH FDB DOUSER
  1505. FDB XWIDTH-UORIG
  1506. *
  1507. * ======>> 66 <<
  1508. FCB $87
  1509. FCC 6,WARNING
  1510. FCB $C7
  1511. FDB WIDTH-8
  1512. WARN FDB DOUSER
  1513. FDB XWARN-UORIG
  1514. *
  1515. * ======>> 67 <<
  1516. FCB $85
  1517. FCC 4,FENCE
  1518. FCB $C5
  1519. FDB WARN-10
  1520. FENCE FDB DOUSER
  1521. FDB XFENCE-UORIG
  1522. *
  1523. * ======>> 68 <<
  1524. FCB $82
  1525. FCC 1,DP points to first free byte at end of dictionary
  1526. FCB $D0
  1527. FDB FENCE-8
  1528. DP FDB DOUSER
  1529. FDB XDP-UORIG
  1530. *
  1531. * ======>> 68.5 <<
  1532. FCB $88
  1533. FCC 7,VOC-LINK
  1534. FCB $CB
  1535. FDB DP-5
  1536. VOCLIN FDB DOUSER
  1537. FDB XVOCL-UORIG
  1538. *
  1539. * ======>> 69 <<
  1540. FCB $83
  1541. FCC 2,BLK
  1542. FCB $CB
  1543. FDB VOCLIN-11
  1544. BLK FDB DOUSER
  1545. FDB XBLK-UORIG
  1546. *
  1547. * ======>> 70 <<
  1548. FCB $82
  1549. FCC 1,IN scan pointer for input line buffer
  1550. FCB $CE
  1551. FDB BLK-6
  1552. IN FDB DOUSER
  1553. FDB XIN-UORIG
  1554. *
  1555. * ======>> 71 <<
  1556. FCB $83
  1557. FCC 2,OUT
  1558. FCB $D4
  1559. FDB IN-5
  1560. OUT FDB DOUSER
  1561. FDB XOUT-UORIG
  1562. *
  1563. * ======>> 72 <<
  1564. FCB $83
  1565. FCC 2,SCR
  1566. FCB $D2
  1567. FDB OUT-6
  1568. SCR FDB DOUSER
  1569. FDB XSCR-UORIG
  1570. * ######>> screen 37 <<
  1571. *
  1572. * ======>> 73 <<
  1573. FCB $86
  1574. FCC 5,OFFSET
  1575. FCB $D4
  1576. FDB SCR-6
  1577. OFSET FDB DOUSER
  1578. FDB XOFSET-UORIG
  1579. *
  1580. * ======>> 74 <<
  1581. FCB $87
  1582. FCC 6,CONTEXT points to pointer to vocab to search first
  1583. FCB $D4
  1584. FDB OFSET-9
  1585. CONTXT FDB DOUSER
  1586. FDB XCONT-UORIG
  1587. *
  1588. * ======>> 75 <<
  1589. FCB $87
  1590. FCC 6,CURRENT points to ptr. to vocab being extended
  1591. FCB $D4
  1592. FDB CONTXT-10
  1593. CURENT FDB DOUSER
  1594. FDB XCURR-UORIG
  1595. *
  1596. * ======>> 76 <<
  1597. FCB $85
  1598. FCC 4,STATE 1 if compiling, 0 if not
  1599. FCB $C5
  1600. FDB CURENT-10
  1601. STATE FDB DOUSER
  1602. FDB XSTATE-UORIG
  1603. *
  1604. * ======>> 77 <<
  1605. FCB $84
  1606. FCC 3,BASE number base for all input & output
  1607. FCB $C5
  1608. FDB STATE-8
  1609. BASE FDB DOUSER
  1610. FDB XBASE-UORIG
  1611. *
  1612. * ======>> 78 <<
  1613. FCB $83
  1614. FCC 2,DPL
  1615. FCB $CC
  1616. FDB BASE-7
  1617. DPL FDB DOUSER
  1618. FDB XDPL-UORIG
  1619. *
  1620. * ======>> 79 <<
  1621. FCB $83
  1622. FCC 2,FLD
  1623. FCB $C4
  1624. FDB DPL-6
  1625. FLD FDB DOUSER
  1626. FDB XFLD-UORIG
  1627. *
  1628. * ======>> 80 <<
  1629. FCB $83
  1630. FCC 2,CSP
  1631. FCB $D0
  1632. FDB FLD-6
  1633. CSP FDB DOUSER
  1634. FDB XCSP-UORIG
  1635. *
  1636. * ======>> 81 <<
  1637. FCB $82
  1638. FCC 1,R#
  1639. FCB $A3
  1640. FDB CSP-6
  1641. RNUM FDB DOUSER
  1642. FDB XRNUM-UORIG
  1643. *
  1644. * ======>> 82 <<
  1645. FCB $83
  1646. FCC 2,HLD
  1647. FCB $C4
  1648. FDB RNUM-5
  1649. HLD FDB DOCON
  1650. FDB XHLD
  1651. *
  1652. * ======>> 82.5 <<== SPECIAL
  1653. FCB $87
  1654. FCC 6,COLUMNS line width of terminal
  1655. FCB $D3
  1656. FDB HLD-6
  1657. COLUMS FDB DOUSER
  1658. FDB XCOLUM-UORIG
  1659. *
  1660. * ######>> screen 38 <<
  1661. * ======>> 83 <<
  1662. FCB $82
  1663. FCC 1,1+
  1664. FCB $AB
  1665. FDB COLUMS-10
  1666. ONEP FDB DOCOL,ONE,PLUS
  1667. FDB SEMIS
  1668. *
  1669. * ======>> 84 <<
  1670. FCB $82
  1671. FCC 1,2+
  1672. FCB $AB
  1673. FDB ONEP-5
  1674. TWOP FDB DOCOL,TWO,PLUS
  1675. FDB SEMIS
  1676. *
  1677. * ======>> 85 <<
  1678. FCB $84
  1679. FCC 3,HERE
  1680. FCB $C5
  1681. FDB TWOP-5
  1682. HERE FDB DOCOL,DP,AT
  1683. FDB SEMIS
  1684. *
  1685. * ======>> 86 <<
  1686. FCB $85
  1687. FCC 4,ALLOT
  1688. FCB $D4
  1689. FDB HERE-7
  1690. ALLOT FDB DOCOL,DP,PSTORE
  1691. FDB SEMIS
  1692. *
  1693. * ======>> 87 <<
  1694. FCB $81 ; , (COMMA)
  1695. FCB $AC
  1696. FDB ALLOT-8
  1697. COMMA FDB DOCOL,HERE,STORE,TWO,ALLOT
  1698. FDB SEMIS
  1699. *
  1700. * ======>> 88 <<
  1701. FCB $82
  1702. FCC 1,C,
  1703. FCB $AC
  1704. FDB COMMA-4
  1705. CCOMM FDB DOCOL,HERE,CSTORE,ONE,ALLOT
  1706. FDB SEMIS
  1707. *
  1708. * ======>> 89 <<
  1709. FCB $81 ; -
  1710. FCB $AD
  1711. FDB CCOMM-5
  1712. SUB FDB DOCOL,MINUS,PLUS
  1713. FDB SEMIS
  1714. *
  1715. * ======>> 90 <<
  1716. FCB $81 =
  1717. FCB $BD
  1718. FDB SUB-4
  1719. EQUAL FDB DOCOL,SUB,ZEQU
  1720. FDB SEMIS
  1721. *
  1722. * ======>> 91 <<
  1723. FCB $81 <
  1724. FCB $BC
  1725. FDB EQUAL-4
  1726. LESS FDB *+2
  1727. PUL A
  1728. PUL B
  1729. TSX
  1730. CMP A 0,X
  1731. INS
  1732. BGT LESST
  1733. BNE LESSF
  1734. CMP B 1,X
  1735. BHI LESST
  1736. LESSF CLR B
  1737. BRA LESSX
  1738. LESST LDA B #1
  1739. LESSX CLR A
  1740. INS
  1741. JMP PUSHBA
  1742. *
  1743. * ======>> 92 <<
  1744. FCB $81 >
  1745. FCB $BE
  1746. FDB LESS-4
  1747. GREAT FDB DOCOL,SWAP,LESS
  1748. FDB SEMIS
  1749. *
  1750. * ======>> 93 <<
  1751. FCB $83
  1752. FCC 2,ROT
  1753. FCB $D4
  1754. FDB GREAT-4
  1755. ROT FDB DOCOL,TOR,SWAP,FROMR,SWAP
  1756. FDB SEMIS
  1757. *
  1758. * ======>> 94 <<
  1759. FCB $85
  1760. FCC 4,SPACE
  1761. FCB $C5
  1762. FDB ROT-6
  1763. SPACE FDB DOCOL,BL,EMIT
  1764. FDB SEMIS
  1765. *
  1766. * ======>> 95 <<
  1767. FCB $83
  1768. FCC 2,MIN
  1769. FCB $CE
  1770. FDB SPACE-8
  1771. MIN FDB DOCOL,OVER,OVER,GREAT,ZBRAN
  1772. FDB MIN2-*
  1773. FDB SWAP
  1774. MIN2 FDB DROP
  1775. FDB SEMIS
  1776. *
  1777. * ======>> 96 <<
  1778. FCB $83
  1779. FCC 2,MAX
  1780. FCB $D8
  1781. FDB MIN-6
  1782. MAX FDB DOCOL,OVER,OVER,LESS,ZBRAN
  1783. FDB MAX2-*
  1784. FDB SWAP
  1785. MAX2 FDB DROP
  1786. FDB SEMIS
  1787. *
  1788. * ======>> 97 <<
  1789. FCB $84
  1790. FCC 3,-DUP
  1791. FCB $D0
  1792. FDB MAX-6
  1793. DDUP FDB DOCOL,DUP,ZBRAN
  1794. FDB DDUP2-*
  1795. FDB DUP
  1796. DDUP2 FDB SEMIS
  1797. *
  1798. * ######>> screen 39 <<
  1799. * ======>> 98 <<
  1800. FCB $88
  1801. FCC 7,TRAVERSE
  1802. FCB $C5
  1803. FDB DDUP-7
  1804. TRAV FDB DOCOL,SWAP
  1805. TRAV2 FDB OVER,PLUS,CLITER
  1806. FCB $7F
  1807. FDB OVER,CAT,LESS,ZBRAN
  1808. FDB TRAV2-*
  1809. FDB SWAP,DROP
  1810. FDB SEMIS
  1811. *
  1812. * ======>> 99 <<
  1813. FCB $86
  1814. FCC 5,LATEST
  1815. FCB $D4
  1816. FDB TRAV-11
  1817. LATEST FDB DOCOL,CURENT,AT,AT
  1818. FDB SEMIS
  1819. *
  1820. * ======>> 100 <<
  1821. FCB $83
  1822. FCC 2,LFA
  1823. FCB $C1
  1824. FDB LATEST-9
  1825. LFA FDB DOCOL,CLITER
  1826. FCB 4
  1827. FDB SUB
  1828. FDB SEMIS
  1829. *
  1830. * ======>> 101 <<
  1831. FCB $83
  1832. FCC 2,CFA
  1833. FCB $C1
  1834. FDB LFA-6
  1835. CFA FDB DOCOL,TWO,SUB
  1836. FDB SEMIS
  1837. *
  1838. * ======>> 102 <<
  1839. FCB $83
  1840. FCC 2,NFA
  1841. FCB $C1
  1842. FDB CFA-6
  1843. NFA FDB DOCOL,CLITER
  1844. FCB 5
  1845. FDB SUB,ONE,MINUS,TRAV
  1846. FDB SEMIS
  1847. *
  1848. * ======>> 103 <<
  1849. FCB $83
  1850. FCC 2,PFA
  1851. FCB $C1
  1852. FDB NFA-6
  1853. PFA FDB DOCOL,ONE,TRAV,CLITER
  1854. FCB 5
  1855. FDB PLUS
  1856. FDB SEMIS
  1857. *
  1858. * ######>> screen 40 <<
  1859. * ======>> 104 <<
  1860. FCB $84
  1861. FCC 3,!CSP
  1862. FCB $D0
  1863. FDB PFA-6
  1864. SCSP FDB DOCOL,SPAT,CSP,STORE
  1865. FDB SEMIS
  1866. *
  1867. * ======>> 105 <<
  1868. FCB $86
  1869. FCC 5,?ERROR
  1870. FCB $D2
  1871. FDB SCSP-7
  1872. QERR FDB DOCOL,SWAP,ZBRAN
  1873. FDB QERR2-*
  1874. FDB ERROR,BRAN
  1875. FDB QERR3-*
  1876. QERR2 FDB DROP
  1877. QERR3 FDB SEMIS
  1878. *
  1879. * ======>> 106 <<
  1880. FCB $85
  1881. FCC 4,?COMP
  1882. FCB $D0
  1883. FDB QERR-9
  1884. QCOMP FDB DOCOL,STATE,AT,ZEQU,CLITER
  1885. FCB $11
  1886. FDB QERR
  1887. FDB SEMIS
  1888. *
  1889. * ======>> 107 <<
  1890. FCB $85
  1891. FCC 4,?EXEC
  1892. FCB $C3
  1893. FDB QCOMP-8
  1894. QEXEC FDB DOCOL,STATE,AT,CLITER
  1895. FCB $12
  1896. FDB QERR
  1897. FDB SEMIS
  1898. *
  1899. * ======>> 108 <<
  1900. FCB $86
  1901. FCC 5,?PAIRS
  1902. FCB $D3
  1903. FDB QEXEC-8
  1904. QPAIRS FDB DOCOL,SUB,CLITER
  1905. FCB $13
  1906. FDB QERR
  1907. FDB SEMIS
  1908. *
  1909. * ======>> 109 <<
  1910. FCB $84
  1911. FCC 3,?CSP
  1912. FCB $D0
  1913. FDB QPAIRS-9
  1914. QCSP FDB DOCOL,SPAT,CSP,AT,SUB,CLITER
  1915. FCB $14
  1916. FDB QERR
  1917. FDB SEMIS
  1918. *
  1919. * ======>> 110 <<
  1920. FCB $88
  1921. FCC 7,?LOADING
  1922. FCB $C7
  1923. FDB QCSP-7
  1924. QLOAD FDB DOCOL,BLK,AT,ZEQU,CLITER
  1925. FCB $16
  1926. FDB QERR
  1927. FDB SEMIS
  1928. *
  1929. * ######>> screen 41 <<
  1930. * ======>> 111 <<
  1931. FCB $87
  1932. FCC 6,COMPILE
  1933. FCB $C5
  1934. FDB QLOAD-11
  1935. COMPIL FDB DOCOL,QCOMP,FROMR,TWOP,DUP,TOR,AT,COMMA
  1936. FDB SEMIS
  1937. *
  1938. * ======>> 112 <<
  1939. FCB $C1 [ immediate
  1940. FCB $DB
  1941. FDB COMPIL-10
  1942. LBRAK FDB DOCOL,ZERO,STATE,STORE
  1943. FDB SEMIS
  1944. *
  1945. * ======>> 113 <<
  1946. FCB $81 ]
  1947. FCB $DD
  1948. FDB LBRAK-4
  1949. RBRAK FDB DOCOL,CLITER
  1950. FCB $C0
  1951. FDB STATE,STORE
  1952. FDB SEMIS
  1953. *
  1954. * ======>> 114 <<
  1955. FCB $86
  1956. FCC 5,SMUDGE
  1957. FCB $C5
  1958. FDB RBRAK-4
  1959. SMUDGE FDB DOCOL,LATEST,CLITER
  1960. FCB $20
  1961. FDB TOGGLE
  1962. FDB SEMIS
  1963. *
  1964. * ======>> 115 <<
  1965. FCB $83
  1966. FCC 2,HEX
  1967. FCB $D8
  1968. FDB SMUDGE-9
  1969. HEX FDB DOCOL
  1970. FDB CLITER
  1971. FCB 16
  1972. FDB BASE,STORE
  1973. FDB SEMIS
  1974. *
  1975. * ======>> 116 <<
  1976. FCB $87
  1977. FCC 6,DECIMAL
  1978. FCB $CC
  1979. FDB HEX-6
  1980. DEC FDB DOCOL
  1981. FDB CLITER
  1982. FCB 10 note: hex "A"
  1983. FDB BASE,STORE
  1984. FDB SEMIS
  1985. *
  1986. * ######>> screen 42 <<
  1987. * ======>> 117 <<
  1988. FCB $87
  1989. FCC 6,(;CODE)
  1990. FCB $A9
  1991. FDB DEC-10
  1992. PSCODE FDB DOCOL,FROMR,TWOP,LATEST,PFA,CFA,STORE
  1993. FDB SEMIS
  1994. *
  1995. * ======>> 118 <<
  1996. FCB $C5 immediate
  1997. FCC 4,;CODE
  1998. FCB $C5
  1999. FDB PSCODE-10
  2000. SEMIC FDB DOCOL,QCSP,COMPIL,PSCODE,SMUDGE,LBRAK,QSTACK
  2001. FDB SEMIS
  2002. * note: "QSTACK" will be replaced by "ASSEMBLER" later
  2003. *
  2004. * ######>> screen 43 <<
  2005. * ======>> 119 <<
  2006. FCB $87
  2007. FCC 6,<BUILDS
  2008. FCB $D3
  2009. FDB SEMIC-8
  2010. BUILDS FDB DOCOL,ZERO,CON
  2011. FDB SEMIS
  2012. *
  2013. * ======>> 120 <<
  2014. FCB $85
  2015. FCC 4,DOES>
  2016. FCB $BE
  2017. FDB BUILDS-10
  2018. DOES FDB DOCOL,FROMR,TWOP,LATEST,PFA,STORE
  2019. FDB PSCODE
  2020. DODOES LDA A IP
  2021. LDA B IP+1
  2022. LDX RP make room on return stack
  2023. DEX
  2024. DEX
  2025. STX RP
  2026. STA A 2,X push return address
  2027. STA B 3,X
  2028. LDX W get addr of pointer to run-time code
  2029. INX
  2030. INX
  2031. STX N stash it in scratch area
  2032. LDX 0,X get new IP
  2033. STX IP
  2034. CLR A get address of parameter
  2035. LDA B #2
  2036. ADD B N+1
  2037. ADC A N
  2038. PSH B and push it on data stack
  2039. PSH A
  2040. JMP NEXT2
  2041. *
  2042. * ######>> screen 44 <<
  2043. * ======>> 121 <<
  2044. FCB $85
  2045. FCC 4,COUNT
  2046. FCB $D4
  2047. FDB DOES-8
  2048. COUNT FDB DOCOL,DUP,ONEP,SWAP,CAT
  2049. FDB SEMIS
  2050. *
  2051. * ======>> 122 <<
  2052. FCB $84
  2053. FCC 3,TYPE
  2054. FCB $C5
  2055. FDB COUNT-8
  2056. TYPE FDB DOCOL,DDUP,ZBRAN
  2057. FDB TYPE3-*
  2058. FDB OVER,PLUS,SWAP,XDO
  2059. TYPE2 FDB I,CAT,EMIT,XLOOP
  2060. FDB TYPE2-*
  2061. FDB BRAN
  2062. FDB TYPE4-*
  2063. TYPE3 FDB DROP
  2064. TYPE4 FDB SEMIS
  2065. *
  2066. * ======>> 123 <<
  2067. FCB $89
  2068. FCC 8,-TRAILING
  2069. FCB $C7
  2070. FDB TYPE-7
  2071. DTRAIL FDB DOCOL,DUP,ZERO,XDO
  2072. DTRAL2 FDB OVER,OVER,PLUS,ONE,SUB,CAT,BL
  2073. FDB SUB,ZBRAN
  2074. FDB DTRAL3-*
  2075. FDB LEAVE,BRAN
  2076. FDB DTRAL4-*
  2077. DTRAL3 FDB ONE,SUB
  2078. DTRAL4 FDB XLOOP
  2079. FDB DTRAL2-*
  2080. FDB SEMIS
  2081. *
  2082. * ======>> 124 <<
  2083. FCB $84
  2084. FCC 3,(.")
  2085. FCB $A9
  2086. FDB DTRAIL-12
  2087. PDOTQ FDB DOCOL,R,TWOP,COUNT,DUP,ONEP
  2088. FDB FROMR,PLUS,TOR,TYPE
  2089. FDB SEMIS
  2090. *
  2091. * ======>> 125 <<
  2092. FCB $C2 immediate
  2093. FCC 1,."
  2094. FCB $A2
  2095. FDB PDOTQ-7
  2096. DOTQ FDB DOCOL
  2097. FDB CLITER
  2098. FCB $22 ascii quote
  2099. FDB STATE,AT,ZBRAN
  2100. FDB DOTQ1-*
  2101. FDB COMPIL,PDOTQ,WORD
  2102. FDB HERE,CAT,ONEP,ALLOT,BRAN
  2103. FDB DOTQ2-*
  2104. DOTQ1 FDB WORD,HERE,COUNT,TYPE
  2105. DOTQ2 FDB SEMIS
  2106. *
  2107. * ######>> screen 45 <<
  2108. * ======>> 126 <<== MACHINE DEPENDENT
  2109. FCB $86
  2110. FCC 5,?STACK
  2111. FCB $CB
  2112. FDB DOTQ-5
  2113. QSTACK FDB DOCOL,CLITER
  2114. FCB $12
  2115. FDB PORIG,AT,TWO,SUB,SPAT,LESS,ONE
  2116. FDB QERR
  2117. * prints 'empty stack'
  2118. *
  2119. QSTAC2 FDB SPAT
  2120. * Here, we compare with a value at least 128
  2121. * higher than dict. ptr. (DP)
  2122. FDB HERE,CLITER
  2123. FCB $80
  2124. FDB PLUS,LESS,ZBRAN
  2125. FDB QSTAC3-*
  2126. FDB TWO
  2127. FDB QERR
  2128. * prints 'full stack'
  2129. *
  2130. QSTAC3 FDB SEMIS
  2131. *
  2132. * ======>> 127 << this word's function
  2133. * is done by ?STACK in this version
  2134. * FCB $85
  2135. * FCC 4,?FREE
  2136. * FCB $C5
  2137. * FDB QSTACK-9
  2138. *QFREE FDB DOCOL,SPAT,HERE,CLITER
  2139. * FCB $80
  2140. * FDB PLUS,LESS,TWO,QERR,SEMIS
  2141. *
  2142. * ######>> screen 46 <<
  2143. * ======>> 128 <<
  2144. FCB $86
  2145. FCC 5,EXPECT
  2146. FCB $D4
  2147. FDB QSTACK-9
  2148. EXPECT FDB DOCOL,OVER,PLUS,OVER,XDO
  2149. EXPEC2 FDB KEY,DUP,CLITER
  2150. FCB $0E
  2151. FDB PORIG,AT,EQUAL,ZBRAN
  2152. FDB EXPEC3-*
  2153. FDB DROP,CLITER
  2154. FCB 8 ( backspace character to emit )
  2155. FDB OVER,I,EQUAL,DUP,FROMR,TWO,SUB,PLUS
  2156. FDB TOR,SUB,BRAN
  2157. FDB EXPEC6-*
  2158. EXPEC3 FDB DUP,CLITER
  2159. FCB $D ( carriage return )
  2160. FDB EQUAL,ZBRAN
  2161. FDB EXPEC4-*
  2162. FDB LEAVE,DROP,BL,ZERO,BRAN
  2163. FDB EXPEC5-*
  2164. EXPEC4 FDB DUP
  2165. EXPEC5 FDB I,CSTORE,ZERO,I,ONEP,STORE
  2166. EXPEC6 FDB EMIT,XLOOP
  2167. FDB EXPEC2-*
  2168. FDB DROP
  2169. FDB SEMIS
  2170. *
  2171. * ======>> 129 <<
  2172. FCB $85
  2173. FCC 4,QUERY
  2174. FCB $D9
  2175. FDB EXPECT-9
  2176. QUERY FDB DOCOL,TIB,AT,COLUMS
  2177. FDB AT,EXPECT,ZERO,IN,STORE
  2178. *DBG
  2179. * FDB MNOP
  2180. *DBG
  2181. FDB SEMIS
  2182. *
  2183. * ======>> 130 <<
  2184. FCB $C1 immediate < carriage return >
  2185. FCB $80
  2186. FDB QUERY-8
  2187. NULL FDB DOCOL,BLK,AT,ZBRAN
  2188. FDB NULL2-*
  2189. FDB ONE,BLK,PSTORE
  2190. FDB ZERO,IN,STORE,BLK,AT,BSCR,MOD
  2191. FDB ZEQU
  2192. * check for end of screen
  2193. FDB ZBRAN
  2194. FDB NULL1-*
  2195. FDB QEXEC,FROMR,DROP
  2196. NULL1 FDB BRAN
  2197. FDB NULL3-*
  2198. NULL2 FDB FROMR,DROP
  2199. NULL3 FDB SEMIS
  2200. *
  2201. * ######>> screen 47 <<
  2202. * ======>> 133 <<
  2203. FCB $84
  2204. FCC 3,FILL
  2205. FCB $CC
  2206. FDB NULL-4
  2207. FILL FDB DOCOL,SWAP,TOR,OVER,CSTORE,DUP,ONEP
  2208. FDB FROMR,ONE,SUB,CMOVE
  2209. FDB SEMIS
  2210. *
  2211. * ======>> 134 <<
  2212. FCB $85
  2213. FCC 4,ERASE
  2214. FCB $C5
  2215. FDB FILL-7
  2216. ERASE FDB DOCOL,ZERO,FILL
  2217. FDB SEMIS
  2218. *
  2219. * ======>> 135 <<
  2220. FCB $86
  2221. FCC 5,BLANKS
  2222. FCB $D3
  2223. FDB ERASE-8
  2224. BLANKS FDB DOCOL,BL,FILL
  2225. FDB SEMIS
  2226. *
  2227. * ======>> 136 <<
  2228. FCB $84
  2229. FCC 3,HOLD
  2230. FCB $C4
  2231. FDB BLANKS-9
  2232. HOLD FDB DOCOL,LIT,$FFFF,HLD,PSTORE,HLD,AT,CSTORE
  2233. FDB SEMIS
  2234. *
  2235. * ======>> 137 <<
  2236. FCB $83
  2237. FCC 2,PAD
  2238. FCB $C4
  2239. FDB HOLD-7
  2240. PAD FDB DOCOL,HERE,CLITER
  2241. FCB $44
  2242. FDB PLUS
  2243. FDB SEMIS
  2244. *
  2245. * ######>> screen 48 <<
  2246. * ======>> 138 <<
  2247. FCB $84
  2248. FCC 3,WORD
  2249. FCB $C4
  2250. FDB PAD-6
  2251. WORD FDB DOCOL,BLK,AT,ZBRAN
  2252. FDB WORD2-*
  2253. FDB BLK,AT,BLOCK,BRAN
  2254. FDB WORD3-*
  2255. WORD2 FDB TIB,AT
  2256. WORD3 FDB IN,AT,PLUS,SWAP,ENCLOS,HERE,CLITER
  2257. FCB 34
  2258. FDB BLANKS,IN,PSTORE,OVER,SUB,TOR,R,HERE
  2259. FDB CSTORE,PLUS,HERE,ONEP,FROMR,CMOVE
  2260. FDB SEMIS
  2261. *
  2262. * ######>> screen 49 <<
  2263. * ======>> 139 <<
  2264. FCB $88
  2265. FCC 7,(NUMBER)
  2266. FCB $A9
  2267. FDB WORD-7
  2268. PNUMB FDB DOCOL
  2269. PNUMB2 FDB ONEP,DUP,TOR,CAT,BASE,AT,DIGIT,ZBRAN
  2270. FDB PNUMB4-*
  2271. FDB SWAP,BASE,AT,USTAR,DROP,ROT,BASE
  2272. FDB AT,USTAR,DPLUS,DPL,AT,ONEP,ZBRAN
  2273. FDB PNUMB3-*
  2274. FDB ONE,DPL,PSTORE
  2275. PNUMB3 FDB FROMR,BRAN
  2276. FDB PNUMB2-*
  2277. PNUMB4 FDB FROMR
  2278. FDB SEMIS
  2279. *
  2280. * ======>> 140 <<
  2281. FCB $86
  2282. FCC 5,NUMBER
  2283. FCB $D2
  2284. FDB PNUMB-11
  2285. NUMB FDB DOCOL,ZERO,ZERO,ROT,DUP,ONEP,CAT,CLITER
  2286. FCC "-" minus sign
  2287. FDB EQUAL,DUP,TOR,PLUS,LIT,$FFFF
  2288. NUMB1 FDB DPL,STORE,PNUMB,DUP,CAT,BL,SUB
  2289. FDB ZBRAN
  2290. FDB NUMB2-*
  2291. FDB DUP,CAT,CLITER
  2292. FCC "."
  2293. FDB SUB,ZERO,QERR,ZERO,BRAN
  2294. FDB NUMB1-*
  2295. NUMB2 FDB DROP,FROMR,ZBRAN
  2296. FDB NUMB3-*
  2297. FDB DMINUS
  2298. NUMB3 FDB SEMIS
  2299. *
  2300. * ======>> 141 <<
  2301. FCB $85
  2302. FCC 4,-FIND
  2303. FCB $C4
  2304. FDB NUMB-9
  2305. DFIND FDB DOCOL,BL,WORD,HERE,CONTXT,AT,AT
  2306. *DBG
  2307. FDB MNOP
  2308. *DBG
  2309. FDB PFIND
  2310. *DBG
  2311. FDB MNOP
  2312. *DBG
  2313. FDB DUP,ZEQU,ZBRAN
  2314. FDB DFIND2-*
  2315. FDB DROP,HERE,LATEST,PFIND
  2316. DFIND2 FDB SEMIS
  2317. *
  2318. * ######>> screen 50 <<
  2319. * ======>> 142 <<
  2320. FCB $87
  2321. FCC 6,(ABORT)
  2322. FCB $A9
  2323. FDB DFIND-8
  2324. PABORT FDB DOCOL,ABORT
  2325. FDB SEMIS
  2326. *
  2327. * ======>> 143 <<
  2328. FCB $85
  2329. FCC 4,ERROR
  2330. FCB $D2
  2331. FDB PABORT-10
  2332. ERROR FDB DOCOL,WARN,AT,ZLESS
  2333. FDB ZBRAN
  2334. * note: WARNING is -1 to abort, 0 to print error #
  2335. * and 1 to print error message from disc
  2336. FDB ERROR2-*
  2337. FDB PABORT
  2338. ERROR2 FDB HERE,COUNT,TYPE,PDOTQ
  2339. FCB 4,7 ( bell )
  2340. FCC " ? "
  2341. FDB MESS,SPSTOR,IN,AT,BLK,AT,QUIT
  2342. FDB SEMIS
  2343. *
  2344. * ======>> 144 <<
  2345. FCB $83
  2346. FCC 2,ID.
  2347. FCB $AE
  2348. FDB ERROR-8
  2349. IDDOT FDB DOCOL,PAD,CLITER
  2350. FCB 32
  2351. FDB CLITER
  2352. FCB $5F ( underline )
  2353. FDB FILL,DUP,PFA,LFA,OVER,SUB,PAD
  2354. FDB SWAP,CMOVE,PAD,COUNT,CLITER
  2355. FCB 31
  2356. FDB AND,TYPE,SPACE
  2357. FDB SEMIS
  2358. *
  2359. * ######>> screen 51 <<
  2360. * ======>> 145 <<
  2361. FCB $86
  2362. FCC 5,CREATE
  2363. FCB $C5
  2364. FDB IDDOT-6
  2365. CREATE FDB DOCOL,DFIND,ZBRAN
  2366. FDB CREAT2-*
  2367. FDB DROP,PDOTQ
  2368. FCB 8
  2369. FCB 7 ( bel )
  2370. FCC "redef: "
  2371. FDB NFA,IDDOT,CLITER
  2372. FCB 4
  2373. FDB MESS,SPACE
  2374. CREAT2 FDB HERE,DUP,CAT,WIDTH,AT,MIN
  2375. FDB ONEP,ALLOT,DUP,CLITER
  2376. FCB $A0
  2377. FDB TOGGLE,HERE,ONE,SUB,CLITER
  2378. FCB $80
  2379. FDB TOGGLE,LATEST,COMMA,CURENT,AT,STORE
  2380. FDB HERE,TWOP,COMMA
  2381. FDB SEMIS
  2382. *
  2383. * ######>> screen 52 <<
  2384. * ======>> 146 <<
  2385. FCB $C9 immediate
  2386. FCC 8,[COMPILE]
  2387. FCB $DD
  2388. FDB CREATE-9
  2389. BCOMP FDB DOCOL,DFIND,ZEQU,ZERO,QERR,DROP,CFA,COMMA
  2390. FDB SEMIS
  2391. *
  2392. * ======>> 147 <<
  2393. FCB $C7 immediate
  2394. FCC 6,LITERAL
  2395. FCB $CC
  2396. FDB BCOMP-12
  2397. LITER FDB DOCOL,STATE,AT,ZBRAN
  2398. FDB LITER2-*
  2399. FDB COMPIL,LIT,COMMA
  2400. LITER2 FDB SEMIS
  2401. *
  2402. * ======>> 148 <<
  2403. FCB $C8 immediate
  2404. FCC 7,DLITERAL
  2405. FCB $CC
  2406. FDB LITER-10
  2407. DLITER FDB DOCOL,STATE,AT,ZBRAN
  2408. FDB DLITE2-*
  2409. FDB SWAP,LITER,LITER
  2410. DLITE2 FDB SEMIS
  2411. *
  2412. * ######>> screen 53 <<
  2413. * ======>> 149 <<
  2414. FCB $89
  2415. FCC 8,INTERPRET
  2416. FCB $D4
  2417. FDB DLITER-11
  2418. INTERP FDB DOCOL
  2419. INTER2 FDB DFIND
  2420. *DBG
  2421. * FDB MNOP
  2422. * FDB OVER,OVER,HEX,DOT,DOT,DEC
  2423. *DBG
  2424. FDB ZBRAN
  2425. FDB INTER5-*
  2426. FDB STATE,AT,LESS
  2427. FDB ZBRAN
  2428. FDB INTER3-*
  2429. FDB CFA,COMMA,BRAN
  2430. FDB INTER4-*
  2431. INTER3 FDB CFA,EXEC
  2432. INTER4 FDB BRAN
  2433. FDB INTER7-*
  2434. INTER5 FDB HERE,NUMB,DPL,AT,ONEP,ZBRAN
  2435. FDB INTER6-*
  2436. FDB DLITER,BRAN
  2437. FDB INTER7-*
  2438. INTER6 FDB DROP,LITER
  2439. INTER7 FDB QSTACK,BRAN
  2440. FDB INTER2-*
  2441. * FDB SEMIS never executed
  2442. *
  2443. * ######>> screen 54 <<
  2444. * ======>> 150 <<
  2445. FCB $89
  2446. FCC 8,IMMEDIATE
  2447. FCB $C5
  2448. FDB INTERP-12
  2449. IMMED FDB DOCOL,LATEST,CLITER
  2450. FCB $40
  2451. FDB TOGGLE
  2452. FDB SEMIS
  2453. *
  2454. * ======>> 151 <<
  2455. FCB $8A
  2456. FCC 9,VOCABULARY
  2457. FCB $D9
  2458. FDB IMMED-12
  2459. VOCAB FDB DOCOL,BUILDS,LIT,$81A0,COMMA,CURENT,AT,CFA
  2460. FDB COMMA,HERE,VOCLIN,AT,COMMA,VOCLIN,STORE,DOES
  2461. DOVOC FDB TWOP,CONTXT,STORE
  2462. FDB SEMIS
  2463. *
  2464. * ======>> 152 <<
  2465. *
  2466. * Note: FORTH does not go here in the rom-able dictionary,
  2467. * since FORTH is a type of variable.
  2468. *
  2469. *
  2470. * ======>> 153 <<
  2471. FCB $8B
  2472. FCC 10,DEFINITIONS
  2473. FCB $D3
  2474. FDB VOCAB-13
  2475. DEFIN FDB DOCOL,CONTXT,AT,CURENT,STORE
  2476. FDB SEMIS
  2477. *
  2478. * ======>> 154 <<
  2479. FCB $C1 immediate (
  2480. FCB $A8
  2481. FDB DEFIN-14
  2482. PAREN FDB DOCOL,CLITER
  2483. FCC ")"
  2484. FDB WORD
  2485. FDB SEMIS
  2486. *
  2487. * ######>> screen 55 <<
  2488. * ======>> 155 <<
  2489. FCB $84
  2490. FCC 3,QUIT
  2491. FCB $D4
  2492. FDB PAREN-4
  2493. QUIT FDB DOCOL,ZERO,BLK,STORE
  2494. FDB LBRAK
  2495. *
  2496. * Here is the outer interpretter
  2497. * which gets a line of input, does it, prints " OK"
  2498. * then repeats :
  2499. QUIT2 FDB RPSTOR,CR,QUERY,INTERP,STATE,AT,ZEQU
  2500. FDB ZBRAN
  2501. FDB QUIT3-*
  2502. FDB PDOTQ
  2503. FCB 3
  2504. FCC 3, OK
  2505. QUIT3 FDB BRAN
  2506. FDB QUIT2-*
  2507. * FDB SEMIS ( never executed )
  2508. *
  2509. * ======>> 156 <<
  2510. FCB $85
  2511. FCC 4,ABORT
  2512. FCB $D4
  2513. FDB QUIT-7
  2514. ABORT FDB DOCOL,SPSTOR,DEC,QSTACK,DRZERO,CR,PDOTQ
  2515. FCB 8
  2516. FCC "Forth-68"
  2517. FDB FORTH,DEFIN
  2518. *DBG
  2519. * FDB TRCON
  2520. * FDB LIT
  2521. * FDB ABORT-8
  2522. * FDB IDDOT
  2523. * FDB LIT
  2524. * FDB NULL-4
  2525. * FDB IDDOT
  2526. * FDB LIT
  2527. * FDB MNOP-7
  2528. * FDB IDDOT
  2529. * FDB LIT
  2530. * FDB TRCON-10
  2531. * FDB IDDOT
  2532. * FDB LIT
  2533. * FDB TRCOFF-11
  2534. * FDB IDDOT
  2535. *DBG
  2536. FDB QUIT
  2537. * FDB SEMIS never executed
  2538. PAGE
  2539. *
  2540. * ######>> screen 56 <<
  2541. * bootstrap code... moves rom contents to ram :
  2542. * ======>> 157 <<
  2543. FCB $84
  2544. FCC 3,COLD
  2545. FCB $C4
  2546. FDB ABORT-8
  2547. COLD FDB *+2
  2548. CENT LDS #REND-1 top of destination
  2549. LDX #ERAM top of stuff to move
  2550. COLD2 DEX
  2551. LDA A 0,X
  2552. PSH A move TASK & FORTH to ram
  2553. CPX #RAM
  2554. BNE COLD2
  2555. *
  2556. LDS #XFENCE-1 put stack at a safe place for now
  2557. LDX COLINT
  2558. STX XCOLUM
  2559. LDX DELINT
  2560. STX XDELAY
  2561. LDX VOCINT
  2562. STX XVOCL
  2563. LDX DPINIT
  2564. STX XDP
  2565. LDX FENCIN
  2566. STX XFENCE
  2567. WENT LDS #XFENCE-1 top of destination
  2568. LDX #FENCIN top of stuff to move
  2569. WARM2 DEX
  2570. LDA A 0,X
  2571. PSH A
  2572. CPX #SINIT
  2573. BNE WARM2
  2574. *
  2575. LDS SINIT
  2576. LDX UPINIT
  2577. STX UP init user ram pointer
  2578. LDX #ABORT
  2579. STX IP
  2580. NOP Here is a place to jump to special user
  2581. NOP initializations such as I/0 interrups
  2582. NOP
  2583. *
  2584. * For systems with TRACE:
  2585. LDX #00
  2586. STX TRLIM clear trace mode
  2587. LDX #0
  2588. STX BRKPT clear breakpoint address
  2589. JMP RPSTOR+2 start the virtual machine running !
  2590. *
  2591. * Here is the stuff that gets copied to ram :
  2592. * at address $140:
  2593. *
  2594. * Thus, MAGIC numbers that initialize USE and PREV, magically! (JMR)
  2595. * RAM FDB $3000,$3000,0,0
  2596. RAM FDB $4000+132,$4000+132,0,0
  2597. * ======>> (152) <<
  2598. FCB $C5 immediate
  2599. FCC 4,FORTH
  2600. FCB $C8
  2601. FDB MNOP-7
  2602. RFORTH FDB DODOES,DOVOC,$81A0,TASK-7
  2603. FDB 0
  2604. FCC "(C) Forth Interest Group, 1979"
  2605. FCB $84
  2606. FCC 3,TASK
  2607. FCB $CB
  2608. FDB FORTH-8
  2609. RTASK FDB DOCOL,SEMIS
  2610. ERAM FCC "David Lion"
  2611. PAGE
  2612. *
  2613. * ######>> screen 57 <<
  2614. * ======>> 158 <<
  2615. FCB $84
  2616. FCC 3,S->D
  2617. FCB $C4
  2618. FDB COLD-7
  2619. STOD FDB DOCOL,DUP,ZLESS,MINUS
  2620. FDB SEMIS
  2621. *
  2622. * ======>> 159 <<
  2623. FCB $81 ; *
  2624. FCB $AA
  2625. FDB STOD-7
  2626. STAR FDB *+2
  2627. JSR USTARS
  2628. INS
  2629. INS
  2630. JMP NEXT
  2631. *
  2632. * ======>> 159.5 << *** NEW DOUBLES
  2633. FCB $82
  2634. FCC 1,D*
  2635. FCB $AA
  2636. FDB STAR-4
  2637. DSTAR FDB *+2
  2638. JSR JSTARS
  2639. INX
  2640. INX
  2641. INX
  2642. INX
  2643. TXS ; drop the high 2 cells
  2644. JMP NEXT
  2645. *
  2646. * ======>> 160 <<
  2647. FCB $84
  2648. FCC 3,/MOD
  2649. FCB $C4
  2650. FDB DSTAR-5
  2651. SLMOD FDB DOCOL,TOR,STOD,FROMR,USLASH
  2652. FDB SEMIS
  2653. *
  2654. * ======>> 161 <<
  2655. FCB $81 ; /
  2656. FCB $AF
  2657. FDB SLMOD-7
  2658. SLASH FDB DOCOL,SLMOD,SWAP,DROP
  2659. FDB SEMIS
  2660. *
  2661. * ======>> 162 <<
  2662. FCB $83
  2663. FCC 2,MOD
  2664. FCB $C4
  2665. FDB SLASH-4
  2666. MOD FDB DOCOL,SLMOD,DROP
  2667. FDB SEMIS
  2668. *
  2669. * ======>> 163 <<
  2670. FCB $85
  2671. FCC 4,*/MOD
  2672. FCB $C4
  2673. FDB MOD-6
  2674. SSMOD FDB DOCOL,TOR,USTAR,FROMR,USLASH
  2675. FDB SEMIS
  2676. *
  2677. * ======>> 164 <<
  2678. FCB $82
  2679. FCC 1,*/
  2680. FCB $AF
  2681. FDB SSMOD-8
  2682. SSLASH FDB DOCOL,SSMOD,SWAP,DROP
  2683. FDB SEMIS
  2684. *
  2685. * ======>> 165 <<
  2686. FCB $85
  2687. FCC 4,M/MOD
  2688. FCB $C4
  2689. FDB SSLASH-5
  2690. MSMOD FDB DOCOL,TOR,ZERO,R,USLASH
  2691. FDB FROMR,SWAP,TOR,USLASH,FROMR
  2692. FDB SEMIS
  2693. *
  2694. * ======>> 166 <<
  2695. FCB $83
  2696. FCC 2,ABS
  2697. FCB $D3
  2698. FDB MSMOD-8
  2699. ABS FDB DOCOL,DUP,ZLESS,ZBRAN
  2700. FDB ABS2-*
  2701. FDB MINUS
  2702. ABS2 FDB SEMIS
  2703. *
  2704. * ======>> 167 <<
  2705. FCB $84
  2706. FCC 3,DABS
  2707. FCB $D3
  2708. FDB ABS-6
  2709. DABS FDB DOCOL,DUP,ZLESS,ZBRAN
  2710. FDB DABS2-*
  2711. FDB DMINUS
  2712. DABS2 FDB SEMIS
  2713. *
  2714. * ######>> screen 57.1 <<
  2715. * ======>> 167.1 << *** NEW DOUBLES
  2716. FCB $83
  2717. FCC 2,D2*
  2718. FCB $AA
  2719. FDB DABS-7
  2720. UD2STA FDB *+2
  2721. TSX
  2722. LSL 3,X
  2723. ROL 2,X
  2724. ROL 1,X
  2725. ROL 0,X
  2726. JMP NEXT
  2727. * Want to keep the overflow!
  2728. *
  2729. * ======>> 167.2 << *** NEW DOUBLES
  2730. FCB $84
  2731. FCC 3,UD2/
  2732. FCB $AF
  2733. FDB UD2STA-6
  2734. UD2SLA FDB *+2
  2735. TSX
  2736. LSR 0,X
  2737. ROR 1,X
  2738. ROR 2,X
  2739. ROR 3,X
  2740. JMP NEXT
  2741. * Want to keep the carry!
  2742. *
  2743. * ######>> screen 57.2 <<
  2744. * ======>> 167.3 << *** NEW DOUBLES
  2745. FCB $83
  2746. FCC 2,UD*
  2747. FCB $AA
  2748. FDB UD2SLA-7
  2749. UDSTAR FDB *+2
  2750. BSR JSTARS
  2751. TXS ; drop the multiplicand temp area
  2752. JMP NEXT
  2753. *
  2754. * The following is a subroutine which
  2755. * multiplies top 2 double words on stack,
  2756. * leaving 64-bit result on stack.
  2757. * I suppose I should compare 32 times through this loop
  2758. * with the shorter 16 bit multiply done 4 times with less data movement.
  2759. * The shorter loop is about 36 cycles times 16 == 576 plus preamble/cleanup.
  2760. * This loop is about 86 cycles times 32 == 2752 plus preamble/cleanup.
  2761. * 576 * 4 == 2304. Does moving the halves around cost 450 cycles?
  2762. * And would it save code space?
  2763. *
  2764. * : UMD* ( ud1 ud2 --- uq )
  2765. * ( AL ) 3 LC@ ( BL ) 2 LC@ UM* 0 ( QL QML QMH : low cells product, ready to sum into QML QMH )
  2766. * ( AH ) 5 LC@ ( BL ) 5 LC@ UM* >R 0 D+ ( inner product low int QML and carry )
  2767. * ( AL ) 6 LC@ ( BH ) 4 LC@ UM* >R 0 D+ ( again, QML complete. )
  2768. * 0 ( zero to QH, ready to sum into QMH QH )
  2769. * R> 0 D+ R> 0 D+ ( QL QML QMH QH : inner product high into QMH and carry )
  2770. * ( AH ) 6 LC@ ( BH ) 5 LC@ UM* D+ ( Product complete, now store it. )
  2771. * 3 LC! 3 LC! 3 LC! 3 LC!
  2772. * ;
  2773. *
  2774. * I might be able to save a hundred or so cycles.
  2775. *
  2776. * On S when we come here: ML:8 MH:6 NL:4 NH:2 PC:0
  2777. * We need a four byte work area, this time we'll use the stack.
  2778. *
  2779. *
  2780. JSTARS PUL A ; PC-HI 1
  2781. PUL B ; PC-LO 2
  2782. DES ; 3 Loop would be more expensive here.
  2783. DES ; 4
  2784. DES ; 5
  2785. DES ; 6
  2786. TSX ; 7 "protect" the PC
  2787. PSH B ; PC-LO 8 (Not strictly necessary, just safer.)
  2788. PSH A ; PC-HI 9
  2789. * ML:10 MH:8 NL:6 NH:4 TL:2 TH: 0 PC:-2
  2790. LDA A 7,X ; move things around for easy exit
  2791. STA A 3,X
  2792. LDA A 6,X
  2793. STA A 2,X
  2794. LDA A 5,X
  2795. STA A 1,X
  2796. LDA A 4,X
  2797. STA A 0,X
  2798. * ML:10 MH:8 SL:6 SH:4 NL:2 NH: 0 PC:-2
  2799. * Except, we'll use 7,X for counter and A for least significant byte.
  2800. CLR 6,X ; clear the summing area
  2801. CLR 5,X
  2802. CLR 4,X
  2803. LDA A #32 bits/word counter
  2804. STA A 7,X count
  2805. CLR A ; least significant sum
  2806. JSTAR2 ROR 8,X shift multiplier, keeping result in carry
  2807. ROR 9,X
  2808. ROR 10,X
  2809. ROR 11,X
  2810. DEC 7,X done? keep carry result!
  2811. BMI JSTAR4
  2812. BCC JSTAR3
  2813. ADD A 3,X
  2814. LDA B 6,X
  2815. ADC B 2,X
  2816. STA B 6,X
  2817. LDA B 5,X
  2818. ADC B 1,X
  2819. STA B 5,X
  2820. LDA B 4,X
  2821. ADC B 0,X
  2822. STA B 4,X
  2823. JSTAR3 ROR 4,X ; shift sum
  2824. ROR 5,X
  2825. ROR 6,X
  2826. ROR A ; into result
  2827. BRA JSTAR2
  2828. JSTAR4 STA A 7,X ; save least significant byte
  2829. INX ; Get ready to dunp the temps
  2830. INX
  2831. INX
  2832. INX ; Let the caller decide how much to dump.
  2833. RTS
  2834. *
  2835. * ######>> screen 57.3 <<
  2836. * ======>> 167.4 <<
  2837. FCB $86
  2838. FCC 5,UD/MOD ( qdividend ddivisor -- dremainder dquotient )
  2839. FCB $C4
  2840. FDB UDSTAR-6
  2841. UDSLAM FDB *+2
  2842. * Doing the columns game like the 16 bit division.
  2843. LDA A #33 ; count
  2844. TSX
  2845. LDA B 4,X ; cache dividend MSB
  2846. STA A 4,X ; uncache count in dividend MSB
  2847. UDSLM1 CMP B 0,X ; Jumping out early allows saving time.
  2848. BHI UDSLM3 ; quotient higher, can subtract
  2849. BCS UDSLM2 ; quotient lower, skip to next
  2850. LDA A 5,X ; loop unrolled
  2851. CMP A 1,X
  2852. BHI UDSLM3
  2853. BCS UDSLM2
  2854. LDA A 6,X
  2855. CMP A 2,X
  2856. BHI UDSLM3
  2857. BCS UDSLM2
  2858. LDA A 7,X ; low byte
  2859. CMP A 3,X
  2860. BCC UDSLM3 ; (BHS==BCC) Not less, can subtract
  2861. UDSLM2 CLC ; less, skip subtracting
  2862. BRA UDSLM4
  2863. UDSLM3 LDA A 7,X ; do the subtraction
  2864. SUB A 3,X
  2865. STA A 7,X
  2866. LDA A 6,X
  2867. SBC A 2,X
  2868. STA A 6,X
  2869. LDA A 5,X
  2870. SBC A 1,X
  2871. STA A 5,X
  2872. SBC B 0,X ; Carry has to be clear by now.
  2873. SEC ; record the subtraction in the quotient
  2874. UDSLM4 ROL 11,X ; drop down the scale, next binary column
  2875. ROL 10,X
  2876. ROL 9,X
  2877. ROL 8,X
  2878. DEC 4,X ; leaves carry alone
  2879. BEQ UDSLM5
  2880. ROL 7,X ; move the rest (remainder) of the dividend for the next bit
  2881. ROL 6,X
  2882. ROL 5,X
  2883. ROL B
  2884. BCC UDSLM1
  2885. BRA UDSLM3 ; may need to force next in corner case
  2886. UDSLM5 INX ; drop divisor
  2887. INX
  2888. INX
  2889. INX
  2890. BRA UDSELF ; make this rob-able by 2SWAP
  2891. UDSWAP LDA B 0,X ; swap remainder and quotient, high byte
  2892. UDSELF LDA A 4,X ; quotient high byte
  2893. STA B 4,X ; remainder high byte
  2894. STA A 0,X
  2895. LDA B 1,X ; mid-high byte
  2896. LDA A 5,X
  2897. STA B 5,X
  2898. STA A 1,X
  2899. LDA B 2,X ; mid-low byte
  2900. LDA A 6,X
  2901. STA B 6,X
  2902. STA A 2,X
  2903. LDA B 3,X ; low byte
  2904. LDA A 7,X
  2905. STA B 7,X
  2906. STA A 3,X
  2907. TXS
  2908. JMP NEXT
  2909. *
  2910. * ######>> screen 58 <<
  2911. * Disc primatives :
  2912. * ======>> 168 <<
  2913. FCB $83
  2914. FCC 2,USE
  2915. FCB $C5
  2916. FDB UDSLAM-9
  2917. USE FDB DOCON
  2918. FDB XUSE
  2919. * ======>> 169 <<
  2920. FCB $84
  2921. FCC 3,PREV
  2922. FCB $D6
  2923. FDB USE-6
  2924. PREV FDB DOCON
  2925. FDB XPREV
  2926. * ======>> 170 <<
  2927. FCB $84
  2928. FCC 3,+BUF
  2929. FCB $C6
  2930. FDB PREV-7
  2931. PBUF FDB DOCOL,CLITER
  2932. FCB $84
  2933. FDB PLUS,DUP,LIMIT,EQUAL,ZBRAN
  2934. FDB PBUF2-*
  2935. FDB DROP,FIRST
  2936. PBUF2 FDB DUP,PREV,AT,SUB
  2937. FDB SEMIS
  2938. *
  2939. * ======>> 171 <<
  2940. FCB $86
  2941. FCC 5,UPDATE
  2942. FCB $C5
  2943. FDB PBUF-7
  2944. UPDATE FDB DOCOL,PREV,AT,AT,LIT,$8000,OR,PREV,AT,STORE
  2945. FDB SEMIS
  2946. *
  2947. * ======>> 172 <<
  2948. FCB $8D
  2949. FCC 12,EMPTY-BUFFERS
  2950. FCB $D3
  2951. FDB UPDATE-9
  2952. MTBUF FDB DOCOL,FIRST,LIMIT,OVER,SUB,ERASE
  2953. FDB SEMIS
  2954. *
  2955. * ======>> 173 <<
  2956. FCB $83
  2957. FCC 2,DR0
  2958. FCB $B0
  2959. FDB MTBUF-16
  2960. DRZERO FDB DOCOL,ZERO,OFSET,STORE
  2961. FDB SEMIS
  2962. *
  2963. * ======>> 174 <<== system dependant word
  2964. FCB $83
  2965. FCC 2,DR1
  2966. FCB $B1
  2967. FDB DRZERO-6
  2968. *DRONE FDB DOCOL,LIT,$07D0,OFSET,STORE
  2969. DRONE FDB DOCOL,LIT,RAMDSZ,OFSET,STORE
  2970. FDB SEMIS
  2971. *
  2972. * ######>> screen 59 <<
  2973. * ======>> 175 <<
  2974. FCB $86
  2975. FCC 5,BUFFER
  2976. FCB $D2
  2977. FDB DRONE-6
  2978. BUFFER FDB DOCOL,USE,AT,DUP,TOR
  2979. BUFFR2 FDB PBUF,ZBRAN
  2980. FDB BUFFR2-*
  2981. FDB USE,STORE,R,AT,ZLESS
  2982. FDB ZBRAN
  2983. FDB BUFFR3-*
  2984. FDB R,TWOP,R,AT,LIT,$7FFF,AND,ZERO,RW
  2985. BUFFR3 FDB R,STORE,R,PREV,STORE,FROMR,TWOP
  2986. FDB SEMIS
  2987. *
  2988. * ######>> screen 60 <<
  2989. * ======>> 176 <<
  2990. FCB $85
  2991. FCC 4,BLOCK
  2992. FCB $CB
  2993. FDB BUFFER-9
  2994. BLOCK FDB DOCOL,OFSET,AT,PLUS,TOR
  2995. FDB PREV,AT,DUP,AT,R,SUB,DUP,PLUS,ZBRAN
  2996. FDB BLOCK5-*
  2997. BLOCK3 FDB PBUF,ZEQU,ZBRAN
  2998. FDB BLOCK4-*
  2999. FDB DROP,R,BUFFER,DUP,R,ONE,RW,TWO,SUB
  3000. BLOCK4 FDB DUP,AT,R,SUB,DUP,PLUS,ZEQU,ZBRAN
  3001. FDB BLOCK3-*
  3002. FDB DUP,PREV,STORE
  3003. BLOCK5 FDB FROMR,DROP,TWOP
  3004. FDB SEMIS
  3005. *
  3006. * ######>> screen 61 <<
  3007. * ======>> 177 <<
  3008. FCB $86
  3009. FCC 5,(LINE)
  3010. FCB $A9
  3011. FDB BLOCK-8
  3012. PLINE FDB DOCOL,TOR,CLITER
  3013. FCB $40
  3014. FDB BBUF,SSMOD,FROMR,BSCR,STAR,PLUS,BLOCK,PLUS,CLITER
  3015. FCB $40
  3016. FDB SEMIS
  3017. *
  3018. * ======>> 178 <<
  3019. FCB $85
  3020. FCC 4,.LINE
  3021. FCB $C5
  3022. FDB PLINE-9
  3023. DLINE FDB DOCOL,PLINE,DTRAIL,TYPE
  3024. FDB SEMIS
  3025. *
  3026. * ======>> 179 <<
  3027. FCB $87
  3028. FCC 6,MESSAGE
  3029. FCB $C5
  3030. FDB DLINE-8
  3031. MESS FDB DOCOL,WARN,AT,ZBRAN
  3032. FDB MESS3-*
  3033. FDB DDUP,ZBRAN
  3034. FDB MESS3-*
  3035. FDB CLITER
  3036. FCB 4
  3037. FDB OFSET,AT,BSCR,SLASH,SUB,DLINE,BRAN
  3038. FDB MESS4-*
  3039. MESS3 FDB PDOTQ
  3040. FCB 6
  3041. FCC 6,err # ; Make sure there's a space there at the end.
  3042. FDB DOT
  3043. MESS4 FDB SEMIS
  3044. *
  3045. * ======>> 180 <<
  3046. FCB $84
  3047. FCC 3,LOAD input:scr #
  3048. FCB $C4
  3049. FDB MESS-10
  3050. LOAD FDB DOCOL,BLK,AT,TOR,IN,AT,TOR,ZERO,IN,STORE
  3051. FDB BSCR,STAR,BLK,STORE
  3052. FDB INTERP,FROMR,IN,STORE,FROMR,BLK,STORE
  3053. FDB SEMIS
  3054. *
  3055. * ======>> 181 <<
  3056. FCB $C3
  3057. FCC 2,-->
  3058. FCB $BE
  3059. FDB LOAD-7
  3060. ARROW FDB DOCOL,QLOAD,ZERO,IN,STORE,BSCR
  3061. FDB BLK,AT,OVER,MOD,SUB,BLK,PSTORE
  3062. FDB SEMIS
  3063. PAGE
  3064. *
  3065. *
  3066. * ######>> screen 63 <<
  3067. * The next 4 subroutines are machine dependent, and are
  3068. * called by words 13 through 16 in the dictionary.
  3069. *
  3070. * ======>> 182 << code for EMIT
  3071. * PEMIT JMP $F018 ; EXBUG outch, rob the RTS.
  3072. PEMIT STA B N+1 save B
  3073. STX N+2 save X
  3074. LDA B ACIAC
  3075. BIT B #2 check ready bit
  3076. BEQ PEMIT+4 if not ready for more data
  3077. STA A N
  3078. AND A #$7F
  3079. STA A ACIAD
  3080. LDX UP
  3081. STA B IOSTAT-UORIG,X
  3082. LDA A N
  3083. LDA B N+1 recover B & X
  3084. LDX N+2
  3085. RTS only A register may change
  3086. * PEMIT JMP $E1D1 for MIKBUG
  3087. * PEMIT FCB $3F,$11,$39 for PROTO
  3088. * PEMIT JMP $D286 for Smoke Signal DOS
  3089. *
  3090. * ======>> 183 << code for KEY
  3091. PKEY CLR $FF53
  3092. INC $FF53 ; shut off echo
  3093. JMP $F015 ; EXBUG inch, rob the RTS.
  3094. * PKEY STA B N
  3095. * STX N+1
  3096. * LDA B ACIAC
  3097. * ASR B
  3098. * BCC PKEY+4 no incoming data yet
  3099. * LDA A ACIAD
  3100. * AND A #$7F strip parity bit
  3101. * LDX UP
  3102. * STA B IOSTAT+1-UORIG,X
  3103. * LDA B N
  3104. * LDX N+1
  3105. * RTS
  3106. * PKEY JMP $E1AC for MIKBUG
  3107. * PKEY FCB $3F,$14,$39 for PROTO
  3108. * PKEY JMP $D289 for Smoke Signal DOS
  3109. *
  3110. * ######>> screen 64 <<
  3111. * ======>> 184 << code for ?TERMINAL
  3112. PQTER LDA A ACIAC Test for 'break' condition
  3113. AND A #$11 mask framing error bit and
  3114. * input buffer full
  3115. BEQ PQTER2
  3116. LDA A ACIAD clear input buffer
  3117. LDA A #01
  3118. PQTER2 RTS
  3119. PAGE
  3120. *
  3121. * ======>> 185 << code for CR
  3122. PCR JMP $F021 ; EXBUG pcrlf, rob the RTS.
  3123. * PCR LDA A #$D carriage return
  3124. * BSR PEMIT
  3125. * LDA A #$A line feed
  3126. * BSR PEMIT
  3127. * LDA A #$7F rubout
  3128. * LDX UP
  3129. * LDA B XDELAY+1-UORIG,X
  3130. * PCR2 DEC B
  3131. * BMI PQTER2 return if minus
  3132. * PSH B save counter
  3133. * BSR PEMIT print RUBOUTs to delay.....
  3134. * PUL B
  3135. * BRA PCR2 repeat
  3136. PAGE
  3137. *
  3138. * ######>> screen 66 <<
  3139. * ======>> 187 <<
  3140. FCB $85
  3141. FCC 4,?DISC
  3142. FCB $C3
  3143. FDB ARROW-6
  3144. QDISC FDB *+2
  3145. JMP NEXT
  3146. *
  3147. * ######>> screen 67 <<
  3148. * ======>> 189 <<
  3149. FCB $8B
  3150. FCC 10,BLOCK-WRITE
  3151. FCB $C5
  3152. FDB QDISC-8
  3153. BWRITE FDB *+2
  3154. JMP NEXT
  3155. *
  3156. * ######>> screen 68 <<
  3157. * ======>> 190 <<
  3158. FCB $8A
  3159. FCC 9,BLOCK-READ
  3160. FCB $C4
  3161. FDB BWRITE-14
  3162. BREAD FDB *+2
  3163. JMP NEXT
  3164. *
  3165. *The next 3 words are written to create a substitute for disc
  3166. * mass memory,located between $3210 & $3FFF in ram.
  3167. * ======>> 190.1 <<
  3168. FCB $82
  3169. FCC 1,LO
  3170. FCB $CF
  3171. FDB BREAD-13
  3172. LO FDB DOCON
  3173. FDB MEMEND a system dependent equate at front
  3174. *
  3175. * ======>> 190.2 <<
  3176. FCB $82
  3177. FCC 1,HI
  3178. FCB $C9
  3179. FDB LO-5
  3180. HI FDB DOCON
  3181. * FDB MEMTOP ( $3FFF ($7FFF) in this version )
  3182. FDB RAMDEN
  3183. *
  3184. * ######>> screen 69 <<
  3185. * ======>> 191 <<
  3186. FCB $83
  3187. FCC 2,R/W
  3188. FCB $D7
  3189. FDB HI-5
  3190. RW FDB DOCOL,TOR,BBUF,STAR,LO,PLUS,DUP,HI,GREAT,ZBRAN
  3191. FDB RW2-*
  3192. FDB PDOTQ
  3193. FCB 8
  3194. FCC 8, Range ?
  3195. FDB QUIT
  3196. RW2 FDB FROMR,ZBRAN
  3197. FDB RW3-*
  3198. FDB SWAP
  3199. RW3 FDB BBUF,CMOVE
  3200. FDB SEMIS
  3201. *
  3202. * ######>> screen 72 <<
  3203. * ======>> 192 <<
  3204. FCB $C1 immediate
  3205. FCB $A7 ' ( tick )
  3206. FDB RW-6
  3207. TICK FDB DOCOL,DFIND,ZEQU,ZERO,QERR,DROP,LITER
  3208. FDB SEMIS
  3209. *
  3210. * ======>> 193 <<
  3211. FCB $86
  3212. FCC 5,FORGET
  3213. FCB $D4
  3214. FDB TICK-4
  3215. FORGET FDB DOCOL,CURENT,AT,CONTXT,AT,SUB,CLITER
  3216. FCB $18
  3217. FDB QERR,TICK,DUP,FENCE,AT,LESS,CLITER
  3218. FCB $15
  3219. FDB QERR,DUP,ZERO,PORIG,GREAT,CLITER
  3220. FCB $15
  3221. FDB QERR,DUP,NFA,DP,STORE,LFA,AT,CONTXT,AT,STORE
  3222. FDB SEMIS
  3223. *
  3224. * ######>> screen 73 <<
  3225. * ======>> 194 <<
  3226. FCB $84
  3227. FCC 3,BACK
  3228. FCB $CB
  3229. FDB FORGET-9
  3230. BACK FDB DOCOL,HERE,SUB,COMMA
  3231. FDB SEMIS
  3232. *
  3233. * ======>> 195 <<
  3234. FCB $C5
  3235. FCC 4,BEGIN
  3236. FCB $CE
  3237. FDB BACK-7
  3238. BEGIN FDB DOCOL,QCOMP,HERE,ONE
  3239. FDB SEMIS
  3240. *
  3241. * ======>> 196 <<
  3242. FCB $C5
  3243. FCC 4,ENDIF
  3244. FCB $C6
  3245. FDB BEGIN-8
  3246. ENDIF FDB DOCOL,QCOMP,TWO,QPAIRS,HERE
  3247. FDB OVER,SUB,SWAP,STORE
  3248. FDB SEMIS
  3249. *
  3250. * ======>> 197 <<
  3251. FCB $C4
  3252. FCC 3,THEN
  3253. FCB $CE
  3254. FDB ENDIF-8
  3255. THEN FDB DOCOL,ENDIF
  3256. FDB SEMIS
  3257. *
  3258. * ======>> 198 <<
  3259. FCB $C2
  3260. FCC 1,DO
  3261. FCB $CF
  3262. FDB THEN-7
  3263. DO FDB DOCOL,COMPIL,XDO,HERE,THREE
  3264. FDB SEMIS
  3265. *
  3266. * ======>> 199 <<
  3267. FCB $C4
  3268. FCC 3,LOOP
  3269. FCB $D0
  3270. FDB DO-5
  3271. LOOP FDB DOCOL,THREE,QPAIRS,COMPIL,XLOOP,BACK
  3272. FDB SEMIS
  3273. *
  3274. * ======>> 200 <<
  3275. FCB $C5
  3276. FCC 4,+LOOP
  3277. FCB $D0
  3278. FDB LOOP-7
  3279. PLOOP FDB DOCOL,THREE,QPAIRS,COMPIL,XPLOOP,BACK
  3280. FDB SEMIS
  3281. *
  3282. * ======>> 201 <<
  3283. FCB $C5
  3284. FCC 4,UNTIL ( same as END )
  3285. FCB $CC
  3286. FDB PLOOP-8
  3287. UNTIL FDB DOCOL,ONE,QPAIRS,COMPIL,ZBRAN,BACK
  3288. FDB SEMIS
  3289. *
  3290. * ######>> screen 74 <<
  3291. * ======>> 202 <<
  3292. FCB $C3
  3293. FCC 2,END
  3294. FCB $C4
  3295. FDB UNTIL-8
  3296. END FDB DOCOL,UNTIL
  3297. FDB SEMIS
  3298. *
  3299. * ======>> 203 <<
  3300. FCB $C5
  3301. FCC 4,AGAIN
  3302. FCB $CE
  3303. FDB END-6
  3304. AGAIN FDB DOCOL,ONE,QPAIRS,COMPIL,BRAN,BACK
  3305. FDB SEMIS
  3306. *
  3307. * ======>> 204 <<
  3308. FCB $C6
  3309. FCC 5,REPEAT
  3310. FCB $D4
  3311. FDB AGAIN-8
  3312. REPEAT FDB DOCOL,TOR,TOR,AGAIN,FROMR,FROMR
  3313. FDB TWO,SUB,ENDIF
  3314. FDB SEMIS
  3315. *
  3316. * ======>> 205 <<
  3317. FCB $C2
  3318. FCC 1,IF
  3319. FCB $C6
  3320. FDB REPEAT-9
  3321. IF FDB DOCOL,COMPIL,ZBRAN,HERE,ZERO,COMMA,TWO
  3322. FDB SEMIS
  3323. *
  3324. * ======>> 206 <<
  3325. FCB $C4
  3326. FCC 3,ELSE
  3327. FCB $C5
  3328. FDB IF-5
  3329. ELSE FDB DOCOL,TWO,QPAIRS,COMPIL,BRAN,HERE
  3330. FDB ZERO,COMMA,SWAP,TWO,ENDIF,TWO
  3331. FDB SEMIS
  3332. *
  3333. * ======>> 207 <<
  3334. FCB $C5
  3335. FCC 4,WHILE
  3336. FCB $C5
  3337. FDB ELSE-7
  3338. WHILE FDB DOCOL,IF,TWOP
  3339. FDB SEMIS
  3340. *
  3341. * ######>> screen 75 <<
  3342. * ======>> 208 <<
  3343. FCB $86
  3344. FCC 5,SPACES
  3345. FCB $D3
  3346. FDB WHILE-8
  3347. SPACES FDB DOCOL,ZERO,MAX,DDUP,ZBRAN
  3348. FDB SPACE3-*
  3349. FDB ZERO,XDO
  3350. SPACE2 FDB SPACE,XLOOP
  3351. FDB SPACE2-*
  3352. SPACE3 FDB SEMIS
  3353. *
  3354. * ======>> 209 <<
  3355. FCB $82
  3356. FCC 1,<#
  3357. FCB $A3
  3358. FDB SPACES-9
  3359. BDIGS FDB DOCOL,PAD,HLD,STORE
  3360. FDB SEMIS
  3361. *
  3362. * ======>> 210 <<
  3363. FCB $82
  3364. FCC 1,#>
  3365. FCB $BE
  3366. FDB BDIGS-5
  3367. EDIGS FDB DOCOL,DROP,DROP,HLD,AT,PAD,OVER,SUB
  3368. FDB SEMIS
  3369. *
  3370. * ======>> 211 <<
  3371. FCB $84
  3372. FCC 3,SIGN
  3373. FCB $CE
  3374. FDB EDIGS-5
  3375. SIGN FDB DOCOL,ROT,ZLESS,ZBRAN
  3376. FDB SIGN2-*
  3377. FDB CLITER
  3378. FCC "-"
  3379. FDB HOLD
  3380. SIGN2 FDB SEMIS
  3381. *
  3382. * ======>> 212 <<
  3383. FCB $81 #
  3384. FCB $A3
  3385. FDB SIGN-7
  3386. DIG FDB DOCOL,BASE,AT,MSMOD,ROT,CLITER
  3387. FCB 9
  3388. FDB OVER,LESS,ZBRAN
  3389. FDB DIG2-*
  3390. FDB CLITER
  3391. FCB 7
  3392. FDB PLUS
  3393. DIG2 FDB CLITER
  3394. FCC "0" ascii zero
  3395. FDB PLUS,HOLD
  3396. FDB SEMIS
  3397. *
  3398. * ======>> 213 <<
  3399. FCB $82
  3400. FCC 1,#S
  3401. FCB $D3
  3402. FDB DIG-4
  3403. DIGS FDB DOCOL
  3404. DIGS2 FDB DIG,OVER,OVER,OR,ZEQU,ZBRAN
  3405. FDB DIGS2-*
  3406. FDB SEMIS
  3407. *
  3408. * ######>> screen 76 <<
  3409. * ======>> 214 <<
  3410. FCB $82
  3411. FCC 1,.R
  3412. FCB $D2
  3413. FDB DIGS-5
  3414. DOTR FDB DOCOL,TOR,STOD,FROMR,DDOTR
  3415. FDB SEMIS
  3416. *
  3417. * ======>> 215 <<
  3418. FCB $83
  3419. FCC 2,D.R
  3420. FCB $D2
  3421. FDB DOTR-5
  3422. DDOTR FDB DOCOL,TOR,SWAP,OVER,DABS,BDIGS,DIGS,SIGN
  3423. FDB EDIGS,FROMR,OVER,SUB,SPACES,TYPE
  3424. FDB SEMIS
  3425. *
  3426. * ======>> 216 <<
  3427. FCB $82
  3428. FCC 1,D.
  3429. FCB $AE
  3430. FDB DDOTR-6
  3431. DDOT FDB DOCOL,ZERO,DDOTR,SPACE
  3432. FDB SEMIS
  3433. *
  3434. * ======>> 217 <<
  3435. FCB $81 .
  3436. FCB $AE
  3437. FDB DDOT-5
  3438. DOT FDB DOCOL,STOD,DDOT
  3439. FDB SEMIS
  3440. *
  3441. * ======>> 218 <<
  3442. FCB $81 ?
  3443. FCB $BF
  3444. FDB DOT-4
  3445. QUEST FDB DOCOL,AT,DOT
  3446. FDB SEMIS
  3447. *
  3448. * ######>> screen 77 <<
  3449. * ======>> 219 <<
  3450. FCB $84
  3451. FCC 3,LIST
  3452. FCB $D4
  3453. FDB QUEST-4
  3454. LIST FDB DOCOL,DEC,CR,DUP,SCR,STORE,PDOTQ
  3455. FCB 6
  3456. FCC "SCR # "
  3457. FDB DOT,CLITER
  3458. FCB $10
  3459. FDB ZERO,XDO
  3460. LIST2 FDB CR,I,THREE
  3461. FDB DOTR,SPACE,I,SCR,AT,DLINE,XLOOP
  3462. FDB LIST2-*
  3463. FDB CR
  3464. FDB SEMIS
  3465. *
  3466. * ======>> 220 <<
  3467. FCB $85
  3468. FCC 4,INDEX
  3469. FCB $D8
  3470. FDB LIST-7
  3471. INDEX FDB DOCOL,CR,ONEP,SWAP,XDO
  3472. INDEX2 FDB CR,I,THREE
  3473. FDB DOTR,SPACE,ZERO,I,DLINE
  3474. FDB QTERM,ZBRAN
  3475. FDB INDEX3-*
  3476. FDB LEAVE
  3477. INDEX3 FDB XLOOP
  3478. FDB INDEX2-*
  3479. FDB SEMIS
  3480. *
  3481. * ======>> 221 <<
  3482. FCB $85
  3483. FCC 4,TRIAD
  3484. FCB $C4
  3485. FDB INDEX-8
  3486. TRIAD FDB DOCOL,THREE,SLASH,THREE,STAR
  3487. FDB THREE,OVER,PLUS,SWAP,XDO
  3488. TRIAD2 FDB CR,I
  3489. FDB LIST,QTERM,ZBRAN
  3490. FDB TRIAD3-*
  3491. FDB LEAVE
  3492. TRIAD3 FDB XLOOP
  3493. FDB TRIAD2-*
  3494. FDB CR,CLITER
  3495. FCB $0F
  3496. FDB MESS,CR
  3497. FDB SEMIS
  3498. *
  3499. * ######>> screen 78 <<
  3500. * ======>> 222 <<
  3501. FCB $85
  3502. FCC 4,VLIST
  3503. FCB $D4
  3504. FDB TRIAD-8
  3505. VLIST FDB DOCOL,CLITER
  3506. FCB $80
  3507. FDB OUT,STORE,CONTXT,AT,AT
  3508. VLIST1 FDB OUT,AT,COLUMS,AT,CLITER
  3509. FCB 32
  3510. FDB SUB,GREAT,ZBRAN
  3511. FDB VLIST2-*
  3512. FDB CR,ZERO,OUT,STORE
  3513. VLIST2 FDB DUP
  3514. * FDB TRCON
  3515. FDB IDDOT,SPACE,SPACE,PFA,LFA,AT
  3516. FDB DUP,ZEQU,QTERM,OR
  3517. * FDB TRCOFF
  3518. FDB ZBRAN
  3519. FDB VLIST1-*
  3520. FDB DROP
  3521. FDB SEMIS
  3522. *
  3523. * ======>> XX <<
  3524. FCB $84
  3525. FCC 3,NOOP
  3526. FCB $D0
  3527. FDB VLIST-8
  3528. NOOP FDB NEXT a useful no-op
  3529. *
  3530. * ======>> XX1 <<
  3531. FDB $87
  3532. FCC 6,TRACEON
  3533. FCB $CE
  3534. FDB NOOP-7
  3535. TRCON FDB *+2
  3536. CLR TRACEM
  3537. INC TRACEM
  3538. JMP NEXT
  3539. *
  3540. * ======>> XX2 <<
  3541. FDB $88
  3542. FCC 7,TRACEOFF
  3543. FCB $C6
  3544. FDB TRCON-10
  3545. TRCOFF FDB *+2
  3546. CLR TRACEM
  3547. JMP NEXT
  3548. *
  3549. * ======>> XXX <<
  3550. FDB $84
  3551. FCC 3,MNOP
  3552. FCB $D0
  3553. FDB TRCOFF-11
  3554. MNOP FDB *+2
  3555. NOP a place to insert a machine-level breakpoint.
  3556. JMP NEXT
  3557. *
  3558. ZZZZ FDB 0,0,0,0,0,0,0,0 end of rom program
  3559. *
  3560. ORG MEMEND simulating disc on-line
  3561. * SCREEN 0
  3562. FCC "0) Index to BIF HI-LEVEL disk "
  3563. FCC "1) "
  3564. FCC "2) Title page, Copr. notice "
  3565. FCC "3) MONITOR CALL TO DEBUG "
  3566. FCC "4) ERROR MESSAGES "
  3567. FCC "5) "
  3568. FCC "6) "
  3569. FCC "7) "
  3570. FCC "8) "
  3571. FCC "9) "
  3572. FCC "10) "
  3573. FCC "11) "
  3574. FCC "12) "
  3575. FCC "13) "
  3576. FCC "14) "
  3577. FCC "15) "
  3578. * SCREEN 1
  3579. FCC "16) "
  3580. FCC "17) "
  3581. FCC "18) "
  3582. FCC "19) "
  3583. FCC "20) "
  3584. FCC "21) "
  3585. FCC "22) "
  3586. FCC "23) "
  3587. FCC "24) "
  3588. FCC "25) "
  3589. FCC "26) "
  3590. FCC "27) "
  3591. FCC "28) "
  3592. FCC "29) "
  3593. FCC "30) "
  3594. FCC "31) "
  3595. * SCREEN 2
  3596. FCC " ( FORTH 68 RAM resident utilities and testing stuff ) " 0
  3597. FCC " ( Copyright 2013 Joel Rees ) " 1
  3598. FCC " " 2
  3599. FCC " " 3
  3600. FCC " " 4
  3601. FCC " " 5
  3602. FCC " " 6
  3603. FCC " " 7
  3604. FCC " " 8
  3605. FCC " " 9
  3606. FCC " " 10
  3607. FCC " " 11
  3608. FCC " " 12
  3609. FCC " " 13
  3610. FCC " " 14
  3611. FCC " " 15
  3612. * SCREEN 3
  3613. FCC " ( No need to call the monitor in exorsim, just ctrl-c. ) " 0
  3614. FCC " ( But maybe we can put some other useful stuff here. ) " 1
  3615. FCC " " 2
  3616. FCC " 1 WARNING ! " 3
  3617. FCC " " 4
  3618. FCC " VOCABULARY DEBUG DEFINITIONS " 5
  3619. FCC " ( addr n -- ) " 6
  3620. FCC " : DUMPHEX BASE @ >R HEX " 7
  3621. FCC " 0 DO DUP I + C@ 0 <# # # #> TYPE SPACE LOOP " 8
  3622. FCC " DROP R> BASE ! ; " 9
  3623. FCC " " 10
  3624. FCC " " 11
  3625. FCC " " 12
  3626. FCC " " 13
  3627. FCC " " 14
  3628. FCC " FORTH DEFINITIONS " 15
  3629. * SCREEN 4
  3630. FCC "( ERROR MESSAGES ) " 0
  3631. FCC "DATA STACK UNDERFLOW " 1
  3632. FCC "DICTIONARY FULL " 2
  3633. FCC "ADDRESS RESOLUTION ERROR " 3
  3634. FCC "HIDES DEFINITION IN " 4
  3635. FCC "NULL VECTOR WRITTEN " 5
  3636. FCC "DISC RANGE? " 6
  3637. FCC "DATA STACK OVERFLOW " 7
  3638. FCC "DISC ERROR! " 8
  3639. FCC "CAN'T EXECUTE A NULL! " 9
  3640. FCC "CONTROL STACK UNDERFLOW " 10
  3641. FCC "CONTROL STACK OVERFLOW " 11
  3642. FCC "ARRAY REFERENCE OUT OF BOUNDS " 12
  3643. FCC "ARRAY DIMENSION NOT VALID " 13
  3644. FCC "NO PROCEDURE TO ENTER " 14
  3645. FCC " ( WAS REGISTER ) " 15
  3646. * SCREEN 5
  3647. FCC " " 0
  3648. FCC "COMPILATION ONLY, USE IN DEF " 1
  3649. FCC "EXECUTION ONLY " 2
  3650. FCC "CONDITIONALS NOT PAIRED " 3
  3651. FCC "DEFINITION INCOMPLETE " 4
  3652. FCC "IN PROTECTED DICTIONARY " 5
  3653. FCC "USE ONLY WHEN LOADING " 6
  3654. FCC "OFF CURRENT EDITING SCREEN " 7
  3655. FCC "DECLARE VOCABULARY " 8
  3656. FCC "DEFINITION NOT IN VOCABULARY " 9
  3657. FCC "IN FORWARD BLOCK " 10
  3658. FCC "ALLOCATION LIST CORRUPTED: LOST " 11
  3659. FCC "CAN'T REDEFINE nul! " 12
  3660. FCC "NOT FORWARD REFERENCE " 13
  3661. FCC " ( WAS IMMEDIATE ) " 14
  3662. FCC " " 15
  3663. * SCREEN 6
  3664. FCC "( MORE ERROR MESSAGES asm6809 ) " 0
  3665. FCC "HAS INCORRECT ADDRESS MODE " 1
  3666. FCC "HAS INCORRECT INDEX MODE " 2
  3667. FCC "OPERAND NOT REGISTER " 3
  3668. FCC "HAS ILLEGAL IMMEDIATE " 4
  3669. FCC "PC OFFSET MUST BE ABSOLUTE " 5
  3670. FCC "ACCUMULATOR OFFSET REQUIRED " 6
  3671. FCC "ILLEGAL MEMORY INDIRECTION (6809) " 7
  3672. FCC "ILLEGAL INDEX BASE (6809) " 8
  3673. FCC "ILLEGAL TARGET SPECIFIED " 9
  3674. FCC "CAN'T STACK ON SELF (6809) " 10
  3675. FCC "DUPLICATE IN LIST " 11
  3676. FCC "REGISTER NOT STACK (6809) " 12
  3677. FCC "EMPTY REGISTER LIST (6809) " 13
  3678. FCC "IMMEDIATE OPERAND REQUIRED " 14
  3679. FCC "REQUIRES CONDITION " 15
  3680. *
  3681. * SCREEN 7
  3682. FCC " " 0
  3683. FCC "COMPILE-TIME STACK UNDERFLOW " 1
  3684. FCC "COMPILE-TIME STACK OVERFLOW " 2
  3685. FCC " " 3
  3686. FCC " " 4
  3687. FCC " " 5
  3688. FCC " " 6
  3689. FCC " " 7
  3690. FCC " " 8
  3691. FCC " " 9
  3692. FCC " " 10
  3693. FCC " " 11
  3694. FCC " " 12
  3695. FCC " " 13
  3696. FCC " " 14
  3697. FCC " " 15
  3698. *
  3699. * SCREEN 8
  3700. FCC " ( Crude editing facilities. -- one byte characters ) " 0
  3701. FCC " " 1
  3702. FCC " VOCABULARY EDITOR DEFINITIONS " 2
  3703. FCC " " 3
  3704. FCC " ( n -- nb nc ) ( convert line number to block, count offset ) " 4
  3705. FCC " : L2BLOCK 64 * B/BUF /MOD ; ( 64 characters per line magic # ) " 5
  3706. FCC " " 6
  3707. FCC " ( n -- n ) ( convert screen number to block number ) " 7
  3708. FCC " : S2BLOCK B/SCR * ; ( magic numbers hidden in B/SCR ) " 8
  3709. FCC " " 9
  3710. FCC " ( ns nl -- addr ) ( screen, line to address in block ) " 10
  3711. FCC " : SL2BB SWAP S2BLOCK SWAP L2BLOCK SWAP >R + BLOCK R> + ; " 11
  3712. FCC " " 12
  3713. FCC " ( ns nl -- ) ( show one line of the screen ) " 13
  3714. FCC " : SHOWLINE SL2BB CR 64 TYPE ; ( list just one line ) " 14
  3715. FCC " --> " 15
  3716. *
  3717. * SCREEN 9
  3718. FCC " ( More crude editing facilities. -- one byte characters ) " 0
  3719. FCC " " 1
  3720. FCC " 0 VARIABLE LNEDBUF 62 ALLOT ( buffer for line editing ) " 2
  3721. FCC " " 3
  3722. FCC " ( ns nl -- ) ( overwrite one line of the screen ) " 4
  3723. FCC " : PUTLINE LNEDBUF 64 BLANKS ( just enough to write to disc ) " 5
  3724. FCC " CR LNEDBUF 64 EXPECT CR ( just enough to write ) " 6
  3725. FCC " SL2BB LNEDBUF SWAP 64 CMOVE UPDATE ; " 7
  3726. FCC " ( Full screen editing requires keyboard control codes. ) " 8
  3727. FCC " " 9
  3728. FCC " " 10
  3729. FCC " " 11
  3730. FCC " " 12
  3731. FCC " " 13
  3732. FCC " " 14
  3733. FCC " " 15
  3734. *
  3735. * I don't know enough about the EXORciser, and don't want to take the time
  3736. * to try to work through the disk simulation in exorsim to get real simulated
  3737. * disk access running.
  3738. * This gives me enough to check my understanding of forth, to help me figure
  3739. * out my bif-c project or whatever my next step is.
  3740. *
  3741. * Going farther with the exorsim version of the fig-FORTH 6800 model would be
  3742. * a good student exercise, maybe? (For what coursework?)
  3743. * But I think I need to move on.
  3744. *
  3745. * SCREEN 10
  3746. FCC " " 0
  3747. FCC " " 1
  3748. FCC " " 2
  3749. FCC " " 3
  3750. FCC " " 4
  3751. FCC " " 5
  3752. FCC " " 6
  3753. FCC " " 7
  3754. FCC " " 8
  3755. FCC " " 9
  3756. FCC " " 10
  3757. FCC " " 11
  3758. FCC " " 12
  3759. FCC " " 13
  3760. FCC " " 14
  3761. FCC " " 15
  3762. *
  3763. * SCREEN 11
  3764. FCC " " 0
  3765. FCC " " 1
  3766. FCC " " 2
  3767. FCC " " 3
  3768. FCC " " 4
  3769. FCC " " 5
  3770. FCC " " 6
  3771. FCC " " 7
  3772. FCC " " 8
  3773. FCC " " 9
  3774. FCC " " 10
  3775. FCC " " 11
  3776. FCC " " 12
  3777. FCC " " 13
  3778. FCC " " 14
  3779. FCC " " 15
  3780. *
  3781. * SCREEN 12
  3782. FCC " " 0
  3783. FCC " " 1
  3784. FCC " " 2
  3785. FCC " " 3
  3786. FCC " " 4
  3787. FCC " " 5
  3788. FCC " " 6
  3789. FCC " " 7
  3790. FCC " " 8
  3791. FCC " " 9
  3792. FCC " " 10
  3793. FCC " " 11
  3794. FCC " " 12
  3795. FCC " " 13
  3796. FCC " " 14
  3797. FCC " " 15
  3798. *
  3799. RAMDEN EQU *
  3800. RAMDSZ EQU RAMDEN-MEMEND
  3801. *
  3802. ORG ORIG ; set the COLD entry address
  3803. PAGE
  3804. OPT L
  3805. END