• R/O
  • HTTP
  • SSH
  • HTTPS

Commit

Tags
No Tags

Frequently used words (click to add to your profile)

javaandroidc++objective-cc#cocoa誰得gamephpbathyscapherubyqtlinuxcomegat翻訳pythontwitterwindowsbtronvb.nettestframeworkgui計画中(planning stage)directxpreviewerpukiwikidommruby

Functions for working with the idealized calendar of Planet Xhilr


Commit MetaInfo

Revisionc9ca731a29c3838146d1e7e85626e1273ae7ca7f (tree)
Time2017-06-17 10:35:04
AuthorJoel Matthew Rees <joel.rees@gmai...>
CommiterJoel 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).

Change Summary

Incremental Difference

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