OPT PRT
* fig-FORTH FOR 6809, converted by unintelligent conversion from 6800 source.
+
+* To do:
+* 4 IO routines -- OK?
+* adjust ram locations -- OK?
+* then add trace routines
+* then try in emulator
+
* ASSEMBLY SOURCE LISTING
* RELEASE 1
* PEMIT ( word # 182 )
* PKEY ( 183 )
* PQTERM ( 184 )
+* Note: PCR, also. (PRTCR)
*
* The FORTH words for disc related I/O follow the model
* of the FORTH Interest Group, but have not been
*
-NBLK EQU 4 ; # of disc buffer blocks for virtual memory
-MEMEND EQU 132*NBLK+$3000 ; end of ram
+NBLK EQU 4 # of disc buffer blocks for virtual memory
+* MEMEND EQU 132*NBLK+$3000 end of ram
+MEMEND EQU 132*NBLK+$5000+132 end of ram with some breathing room (32K Coco)
* each block is 132 bytes in size,
* holding 128 characters
*
-MEMTOP EQU $3FFF ; absolute end of all ram
-ACIAC EQU $FBCE ; the ACIA control address and
-ACIAD EQU ACIAC+1 ; data address for PROTO
+* MEMTOP EQU $3FFF absolute end of all ram
+MEMTOP EQU $7FFF putative absolute end of all ram (32K Coco)
+* No ACIA in Coco (how sad).
+* ACIAC EQU $FBCE the ACIA control address and
+* ACIAD EQU ACIAC+1 data address for PROTO
PAGE
-* MEMORY MAP for this 16K system:
+* MEMORY MAP for this 16K system (32K Coco):
* ( positioned so that systems with 4k byte write-
* protected segments can write protect FORTH )
*
+* Read below and calculate it yourself:
* addr. contents pointer init by
* **** ******************************* ******* ******
* 3FFF HI
* <== W
* the VIRTUAL FORTH MACHINE
*
-* 1004 <<< WARM START ENTRY >>>
-* 1000 <<< COLD START ENTRY >>>
+* 1004 (3004) <<< WARM START ENTRY >>>
+* 1000 (3000) <<< COLD START ENTRY >>>
*
* >>>>>> memory from here down must be RAM <<<<<<
* FFE RETURN STACK base <== RP RINIT
* RP points to second free byte (first free word) in return stack
* SP (hardware SP) points to first free byte in data stack
*
-* when A ANDB hold one 16 bit FORTH data word,
+* when A AND B hold one 16 bit FORTH data word,
* A contains the high byte, B, the low byte.
***
- ORG $E0 ; variables
+* ORG $E0 variables
+ ORG $1300 variables
+PGBASE EQU *
+PGBDP EQU PGBASE/$100
+ SETDP PGBDP
-N RMB 10 ; used as scratch by (FIND),ENCLOSE,CMOVE,EMIT,KEY,
+N RMB 10 used as scratch by (FIND),ENCLOSE,CMOVE,EMIT,KEY,
* SP@,SWAP,DOES>,COLD
* These locations are used by the TRACE routine :
-TRLIM RMB 1 ; the count for tracing without user intervention
-TRACEM RMB 1 ; non-zero = trace mode
-BRKPT RMB 2 ; the breakpoint address at which
-* ; the program will go into trace mode
-VECT RMB 2 ; vector to machine code
+TRLIM RMB 1 the count for tracing without user intervention
+TRACEM RMB 1 non-zero = trace mode
+BRKPT RMB 2 the breakpoint address at which
+* the program will go into trace mode
+VECT RMB 2 vector to machine code
* (only needed if the TRACE routine is resident)
* Starting at $OOFO:
-W RMB 2 ; the instruction register points to 6800 code
-IP RMB 2 ; the instruction pointer points to pointer to 6800 code
-RP RMB 2 ; the return stack pointer
-UP RMB 2 ; the pointer to base of current user's 'USER' table
+W RMB 2 the instruction register points to 6800 code
+IP RMB 2 the instruction pointer points to pointer to 6800 code
+RP RMB 2 the return stack pointer
+UP RMB 2 the pointer to base of current user's 'USER' table
* ( altered during multi-tasking )
*
+* For the tracer:
+ RMB 4
+TRASP RMB 2
+TRAVEC RMB 2
+TRAA RMB 1
+TRAB RMB 1
+*
PAGE
* This system is shown with one user, but additional users
* may be added by allocating additional user tables:
* COLD start and WARM start:
* [ names correspond to FORTH words of similar (no X) name ]
*
- ORG $100
-UORIG RMB 6 ; 3 reserved variables
-XSPZER RMB 2 ; initial top of data stack for this user
-XRZERO RMB 2 ; initial top of return stack
-XTIB RMB 2 ; start of terminal input buffer
-XWIDTH RMB 2 ; name field width
-XWARN RMB 2 ; warning message mode (0 = no disc)
-XFENCE RMB 2 ; fence for FORGET
-XDP RMB 2 ; dictionary pointer
-XVOCL RMB 2 ; vocabulary linking
-XBLK RMB 2 ; disc block being accessed
-XIN RMB 2 ; scan pointer into the block
-XOUT RMB 2 ; cursor position
-XSCR RMB 2 ; disc screen being accessed ( O=terminal )
-XOFSET RMB 2 ; disc sector offset for multi-disc
-XCONT RMB 2 ; last word in primary search vocabulary
-XCURR RMB 2 ; last word in extensible vocabulary
-XSTATE RMB 2 ; flag for 'interpret' or 'compile' modes
-XBASE RMB 2 ; number base for I/O numeric conversion
-XDPL RMB 2 ; decimal point place
+* ORG $100
+ ORG $1400
+UORIG RMB 6 3 reserved variables
+XSPZER RMB 2 initial top of data stack for this user
+XRZERO RMB 2 initial top of return stack
+XTIB RMB 2 start of terminal input buffer
+XWIDTH RMB 2 name field width
+XWARN RMB 2 warning message mode (0 = no disc)
+XFENCE RMB 2 fence for FORGET
+XDP RMB 2 dictionary pointer
+XVOCL RMB 2 vocabulary linking
+XBLK RMB 2 disc block being accessed
+XIN RMB 2 scan pointer into the block
+XOUT RMB 2 cursor position
+XSCR RMB 2 disc screen being accessed ( O=terminal )
+XOFSET RMB 2 disc sector offset for multi-disc
+XCONT RMB 2 last word in primary search vocabulary
+XCURR RMB 2 last word in extensible vocabulary
+XSTATE RMB 2 flag for 'interpret' or 'compile' modes
+XBASE RMB 2 number base for I/O numeric conversion
+XDPL RMB 2 decimal point place
XFLD RMB 2
-XCSP RMB 2 ; current stack position, for compile checks
+XCSP RMB 2 current stack position, for compile checks
XRNUM RMB 2
XHLD RMB 2
-XDELAY RMB 2 ; carriage return delay count
-XCOLUM RMB 2 ; carriage width
-IOSTAT RMB 2 ; last acia status from write/read
- RMB 2 ; ( 4 spares! )
+XDELAY RMB 2 carriage return delay count
+XCOLUM RMB 2 carriage width
+IOSTAT RMB 2 last acia status from write/read
+ RMB 2 ( 4 spares! )
RMB 2
RMB 2
RMB 2
*
XUSE RMB 2
XPREV RMB 2
- RMB 4 ; ( spares )
+ RMB 4 ( spares )
PAGE
* These things, up through the lable 'REND', are overwritten
* at time of cold load and should have the same contents
* as shown here:
*
- FCB $C5 ; immediate
- FCC 4,FORTH
+ FCB $C5 immediate
+ FCC 'FORT' ; 'FORTH'
FCB $C8
FDB NOOP-7
FORTH FDB DODOES,DOVOC,$81A0,TASK-7
FCC "(C) Forth Interest Group, 1979"
FCB $84
- FCC 3,TASK
+ FCC 'TAS' ; 'TASK'
FCB $CB
FDB FORTH-8
TASK FDB DOCOL,SEMIS
REND EQU * ( first empty location in dictionary )
PAGE
+* Check the addresses yourself:
* The FORTH program ( address $1000 to $27FF ) is written
* so that it can be in a ROM, or write-protected if desired
- ORG $1000
+ ORG $3000
* ######>> screen 3 <<
*
** W A R M E N T R Y **
***************************
NOP
- JMP WENT ; warm-start code, keeps current dictionary intact
+ JMP WENT warm-start code, keeps current dictionary intact
*
******* startup parmeters **************************
*
- FDB $6800,0000 ; cpu & revision
- FDB 0 ; topmost word in FORTH vocabulary
-BACKSP FDB $7F ; backspace character for editing
-UPINIT FDB UORIG ; initial user area
-SINIT FDB ORIG-$D0 ; initial top of data stack
-RINIT FDB ORIG-2 initial top of return stack
- FDB ORIG-$D0 terminal input buffer
- FDB 31 ; initial name field width
- FDB 0 ; initial warning mode (0 = no disc)
-FENCIN FDB REND ; initial fence
-DPINIT FDB REND ; cold start value for DP
+RPTIB EQU $200 Give us more room to breath.
+SBUMPR EQU $10 Bumper area for stacks.
+*
+ FDB $6800,6809 cpu & revision
+ FDB 0 topmost word in FORTH vocabulary
+BACKSP FDB $7F backspace character for editing
+UPINIT FDB UORIG initial user area
+* SINIT FDB ORIG-$D0 initial top of data stack
+SINIT FDB ORIG-RPTIB-SBUMPR*2
+* RINIT FDB ORIG-2 initial top of return stack
+RINIT FDB ORIG-SBUMPR
+* FDB ORIG-$D0 terminal input buffer
+ FDB ORIG-RPTIB-SBUMPR
+ FDB 31 initial name field width
+ FDB 0 initial warning mode (0 = no disc)
+FENCIN FDB REND initial fence
+DPINIT FDB REND cold start value for DP
VOCINT FDB FORTH+8
-COLINT FDB 132 ; initial terminal carriage width
-DELINT FDB 4 ; initial carriage return delay
+COLINT FDB 132 initial terminal carriage width
+DELINT FDB 4 initial carriage return delay
****************************************************
*
PAGE
*
* ######>> screen 13 <<
-PULABX PULS A ; 24 cycles until 'NEXT'
+* Calculate the cycles yourself:
+PULABX PULS A 24 cycles until 'NEXT'
PULS B
-STABX STA 0,X ; 16 cycles until 'NEXT'
+STABX STA 0,X 16 cycles until 'NEXT'
STB 1,X
BRA NEXT
-GETX LDA 0,X ; 18 cycles until 'NEXT'
+GETX LDA 0,X 18 cycles until 'NEXT'
LDB 1,X
-PUSHBA PSHS B ; 8 cycles until 'NEXT'
+PUSHBA PSHS B 8 cycles until 'NEXT'
PSHS A
*
* "NEXT" takes 38 cycles if TRACE is removed,
*
-* and 95 cycles if NOT tracing.
+* and 95 cycles if NOT tracing. (Way bogus numbers by now.)
*
* = = = = = = = t h e v i r t u a l m a c h i n e = = = = =
* =
NEXT LDX IP
- LEAX 1,X ; pre-increment mode
+ LEAX 1,X pre-increment mode
LEAX 1,X
STX IP
-NEXT2 LDX 0,X ; get W which points to CFA of word to be done
+NEXT2 LDX 0,X get W which points to CFA of word to be done
NEXT3 STX W
- LDX 0,X ; get VECT which points to executable code
+ LDX 0,X get VECT which points to executable code
* =
* The next instruction could be patched to JMP TRACE =
* if a TRACE routine is available: =
* =
- JMP 0,X
+* Or add the TRACE routine in-line, since we are assembling it.
+ TST TRACEM
+ BEQ NEXTGO
+ STX TRAVEC
+ TFR S,X ; Mechanical! Mechanical! (So the funn 6800 stack didn't beach us.)
+ STX TRASP
+ LDA #':'
+ JSR PEMIT
+ LDA #' '
+ JSR PEMIT
+ LDX W
+ LEAX -1,X
+ LEAX -1,X ; allocation link
+ LEAX -1,X ; last char
+ LDA #31
+NAMTST LEAX -1,X ; length byte?
+ LDB 0,X
+ BMI NAMTDN
+ DECA
+ BNE NAMTST
+NAMTDN ANDB #31 ; It's the length byte whether it wants to be or not.
+NAMSHW LEAX 1,X
+ LDA 0,X
+ JSR PEMIT
+ DECB
+ BNE NAMSHW
+* show the virtual registers
+* TOO MUCH OUTPUT! Have to trim this.
+ LDA #' '
+ JSR PEMIT
+ LDA #'@'
+ LDX #TRAVEC
+ JSR PHEX4F
+ TFR DP,A
+ LDB #(W-PGBASE)
+ TFR D,X
+ LDA #'W'
+ JSR PHEX4F
+ LDA #'I'
+ JSR PHEX4F
+ LDA #'R'
+ JSR PHEX4F
+ LDA #'U'
+ JSR PHEX4F
+ TFR DP,A
+ LDB #(W-TRASP)
+ TFR D,X
+ LDA #'S'
+ BSR PHEX4F
+ LDA #'>'
+ TFR S,X
+ BSR PHEX4F
+ LDA #' '
+ BSR PHEX4F
+*
+ JSR PCR
+ LDX TRAVEC
+*
+NEXTGO JMP 0,X
NOP
-* JMP TRACE ; ( an alternate for the above )
+* JMP TRACE ( an alternate for the above )
+* =
* =
+*DBG
+PHEX4F JSR PEMIT
+ BSR PHEXX2
+ BSR PHEXX2
+ LDA #' '
+ JSR PEMIT
+ RTS
+PHEXX2 LDA 0,X
+ LSRA
+ LSRA
+ LSRA
+ LSRA
+ JSR PHEXD
+ LDA 0,X
+ JSR PHEXD
+ LEAX 1,X
+ RTS
+PHEXD ANDA #$0F
+ CMPA #10
+ BLO PHEXDH
+ ADDA #7 ; 'A'-'9'+1
+PHEXDH ADDA #'0'
+ JSR PEMIT
+ RTS
+*DBG
* = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
*
* ======>> 1 <<
FCB $83
- FCC 2,LIT ; NOTE: this is different from LITERAL
+ FCC 'LI' ; 'LIT' : NOTE: this is different from LITERAL
FCB $D4
- FDB 0 ; link of zero to terminate dictionary scan
+ FDB 0 link of zero to terminate dictionary scan
LIT FDB *+2
LDX IP
LEAX 1,X
*
* ######>> screen 14 <<
* ======>> 2 <<
-CLITER FDB *+2 ; (this is an invisible word, with no header)
+CLITER FDB *+2 (this is an invisible word, with no header)
LDX IP
LEAX 1,X
STX IP
*
* ======>> 3 <<
FCB $87
- FCC 6,EXECUTE
+ FCC 'EXECUT' ; 'EXECUTE'
FCB $C5
FDB LIT-6
EXEC FDB *+2
TFR S,X
- LDX 0,X ; get code field address (CFA)
- LEAS 1,S ; pop stack
+ LDX 0,X get code field address (CFA)
+ LEAS 1,S pop stack
LEAS 1,S
JMP NEXT3
*
* ######>> screen 15 <<
* ======>> 4 <<
FCB $86
- FCC 5,BRANCH
+ FCC 'BRANC' ; 'BRANCH'
FCB $C8
FDB EXEC-10
-BRAN FDB ZBYES ; Go steal code in ZBRANCH
+BRAN FDB ZBYES Go steal code in ZBRANCH
*
* ======>> 5 <<
FCB $87
- FCC 6,0BRANCH
+ FCC '0BRANC' ; '0BRANCH'
FCB $C8
FDB BRAN-9
ZBRAN FDB *+2
* End of unintelligent ABA conversion.
BNE ZBNO
BCS ZBNO
-ZBYES LDX IP ; Note: code is shared with BRANCH, (+LOOP), (LOOP)
+ZBYES LDX IP Note: code is shared with BRANCH, (+LOOP), (LOOP)
LDB 3,X
LDA 2,X
ADDB IP+1
STB IP+1
STA IP
JMP NEXT
-ZBNO LDX IP ; no branch. This code is shared with (+LOOP), (LOOP).
- LEAX 1,X ; jump over branch delta
+ZBNO LDX IP no branch. This code is shared with (+LOOP), (LOOP).
+ LEAX 1,X jump over branch delta
LEAX 1,X
STX IP
JMP NEXT
* ######>> screen 16 <<
* ======>> 6 <<
FCB $86
- FCC 5,(LOOP)
+ FCC '(LOOP' ; '(LOOP)'
FCB $A9
FDB ZBRAN-10
XLOOP FDB *+2
CLRA
- LDB #1 ; get set to increment counter by 1
- BRA XPLOP2 ; go steal other guy's code!
+ LDB #1 get set to increment counter by 1
+ BRA XPLOP2 go steal other guy's code!
*
* ======>> 7 <<
FCB $87
- FCC 6,(+LOOP)
+ FCC '(+LOOP' ; '(+LOOP)'
FCB $A9
FDB XLOOP-9
-XPLOOP FDB *+2 ; Note: +LOOP has an un-signed loop counter
- PULS A ; get increment
+XPLOOP FDB *+2 Note: +LOOP has an un-signed loop counter
+ PULS A get increment
PULS B
XPLOP2 TSTA
- BPL XPLOF ; forward looping
+ BPL XPLOF forward looping
BSR XPLOPS
ORCC #1
SBCB 5,X
SBCA 4,X
BPL ZBYES
- BRA XPLONO ; fall through
+ BRA XPLONO fall through
*
* the subroutine :
XPLOPS LDX RP
- ADDB 3,X ; add it to counter
+ ADDB 3,X add it to counter
ADCA 2,X
- STB 3,X ; store new counter value
+ STB 3,X store new counter value
STA 2,X
RTS
*
SBCA 4,X
BMI ZBYES
*
-XPLONO LEAX 1,X ; done, don't branch back
+XPLONO LEAX 1,X done, don't branch back
LEAX 1,X
LEAX 1,X
LEAX 1,X
STX RP
- BRA ZBNO ; use ZBRAN to skip over unused delta
+ BRA ZBNO use ZBRAN to skip over unused delta
*
* ######>> screen 17 <<
* ======>> 8 <<
FCB $84
- FCC 3,(DO)
+ FCC '(DO' ; '(DO)'
FCB $A9
FDB XPLOOP-10
-XDO FDB *+2 ; This is the RUNTIME DO, not the COMPILING DO
+XDO FDB *+2 This is the RUNTIME DO, not the COMPILING DO
LDX RP
LEAX -1,X
LEAX -1,X
* ######>> screen 18 <<
* ======>> 10 <<
FCB $85
- FCC 4,DIGIT
+ FCC 'DIGI' ; 'DIGIT'
FCB $D4
FDB I-4
-DIGIT FDB *+2 ; NOTE: legal input range is 0-9, A-Z
+DIGIT FDB *+2 NOTE: legal input range is 0-9, A-Z
TFR S,X
LDA 3,X
- SUBA #$30 ; ascii zero
- BMI DIGIT2 ; IF LESS THAN '0', ILLEGAL
+ SUBA #$30 ascii zero
+ BMI DIGIT2 IF LESS THAN '0', ILLEGAL
CMPA #$A
- BMI DIGIT0 ; IF '9' OR LESS
+ BMI DIGIT0 IF '9' OR LESS
CMPA #$11
- BMI DIGIT2 ; if less than 'A'
+ BMI DIGIT2 if less than 'A'
CMPA #$2B
- BPL DIGIT2 ; if greater than 'Z'
- SUBA #7 ; translate 'A' thru 'F'
+ BPL DIGIT2 if greater than 'Z'
+ SUBA #7 translate 'A' thru 'F'
DIGIT0 CMPA 1,X
- BPL DIGIT2 ; if not less than the base
- LDB #1 ; set flag
- STA 3,X ; store digit
-DIGIT1 STB 1,X ; store the flag
+ BPL DIGIT2 if not less than the base
+ LDB #1 set flag
+ STA 3,X store digit
+DIGIT1 STB 1,X store the flag
JMP NEXT
DIGIT2 CLRB
LEAS 1,S
- LEAS 1,S ; pop bottom number
+ LEAS 1,S pop bottom number
TFR S,X
- STB 0,X ; make sure both bytes are 00
+ STB 0,X make sure both bytes are 00
BRA DIGIT1
*
* ######>> screen 19 <<
*
* ======>> 11 <<
FCB $86
- FCC 5,(FIND)
+ FCC '(FIND' ; '(FIND)'
FCB $A9
FDB DIGIT-8
PFIND FDB *+2
NOP
NOP
-PD EQU N ; ptr to dict word being checked
+PD EQU N ptr to dict word being checked
PA0 EQU N+2
PA EQU N+4
PCT EQU N+6 ; PC in 6800 source
LDX #PD
LDB #4
-PFIND0 PULS A ; loop to get arguments
+PFIND0 PULS A loop to get arguments
STA 0,X
LEAX 1,X
DECB
BNE PFIND0
*
LDX PD
-PFIND1 LDB 0,X ; get count dict count
+PFIND1 LDB 0,X get count dict count
STB PCT
ANDB #$3F
LEAX 1,X
- STX PD ; update PD
+ STX PD update PD
LDX PA0
- LDA 0,X ; get count from arg
+ LDA 0,X get count from arg
LEAX 1,X
- STX PA ; intialize PA
+ STX PA intialize PA
PSHS B ; sim CBA
- CMPA ,S+ ; compare lengths
+ CMPA ,S+ compare lengths
BNE PFIND4
PFIND2 LDX PA
LDA 0,X
LDB 0,X
LEAX 1,X
STX PD
- TSTB ; is dict entry neg. ?
+ TSTB is dict entry neg. ?
BPL PFIND8
- ANDB #$7F ; clear sign
+ ANDB #$7F clear sign
PSHS B ; sim CBA
CMPA ,S+
BEQ FOUND
-PFIND3 LDX 0,X ; get new link
- BNE PFIND1 ; continue if link not=0
+PFIND3 LDX 0,X get new link
+ BNE PFIND1 continue if link not=0
*
* not found :
*
CMPA ,S+
BEQ PFIND2
PFIND4 LDX PD
-PFIND9 LDB 0,X ; scan forward to end of this name
+PFIND9 LDB 0,X scan forward to end of this name
LEAX 1,X
BPL PFIND9
BRA PFIND3
*
* found :
*
-FOUND LDA PD ; compute CFA
+FOUND LDA PD compute CFA
LDB PD+1
ADDB #4
ADCA #0
* ######>> screen 20 <<
* ======>> 12 <<
FCB $87
- FCC 6,ENCLOSE
+ FCC 'ENCLOS' ; 'ENCLOSE'
FCB $C5
FDB PFIND-9
* NOTE :
* NC " " to Next Character to start next enclose at
ENCLOS FDB *+2
LEAS 1,S
- PULS B ; now, get the low byte, for an 8-bit delimiter
+ PULS B now, get the low byte, for an 8-bit delimiter
TFR S,X
LDX 0,X
CLR N
ENCL2 LDA 0,X
BEQ ENCL6
PSHS B ; sim CBA
- CMPA ,S+ ; CHECK FOR DELIM
+ CMPA ,S+ CHECK FOR DELIM
BNE ENCL3
LEAX 1,X
INC N
ENCL3 LDA N found first char.
PSHS A
CLRA
- PSHS A
+ PSHS A
* wait for a delimiter or a NUL
ENCL4 LDA 0,X
BEQ ENCL7
PSHS B ; sim CBA
- CMPA ,S+ ; ckech for delim.
+ CMPA ,S+ ckech for delim.
BEQ ENCL5
LEAX 1,X
INC N
*
* ======>> 13 <<
FCB $84
- FCC 3,EMIT
+ FCC 'EMI' ; 'EMIT'
FCB $D4
FDB ENCLOS-10
EMIT FDB *+2
*
* ======>> 14 <<
FCB $83
- FCC 2,KEY
+ FCC 'KE' ; 'KEY'
FCB $D9
FDB EMIT-7
KEY FDB *+2
*
* ======>> 15 <<
FCB $89
- FCC 8,?TERMINAL
+ FCC '?TERMINA' ; '?TERMINAL'
FCB $CC
FDB KEY-6
QTERM FDB *+2
*
* ======>> 16 <<
FCB $82
- FCC 1,CR
+ FCC 'C' ; 'CR'
FCB $D2
FDB QTERM-12
CR FDB *+2
* ######>> screen 22 <<
* ======>> 17 <<
FCB $85
- FCC 4,CMOVE source, destination, count
+ FCC 'CMOV' ; 'CMOVE' : source, destination, count
FCB $C5
FDB CR-5
CMOVE FDB *+2 takes ( 43+47*count cycles )
* ######>> screen 23 <<
* ======>> 18 <<
FCB $82
- FCC 1,U*
+ FCC 'U' ; 'U*'
FCB $AA
FDB CMOVE-8
USTAR FDB *+2
* ######>> screen 24 <<
* ======>> 19 <<
FCB $82
- FCC 1,U/
+ FCC 'U' ; 'U/'
FCB $AF
FDB USTAR-5
USLASH FDB *+2
* ######>> screen 25 <<
* ======>> 20 <<
FCB $83
- FCC 2,AND
+ FCC 'AN' ; 'AND'
FCB $C4
FDB USLASH-5
AND FDB *+2
*
* ======>> 21 <<
FCB $82
- FCC 1,OR
+ FCC 'O' ; 'OR'
FCB $D2
FDB AND-6
OR FDB *+2
*
* ======>> 22 <<
FCB $83
- FCC 2,XOR
+ FCC 'XO' ; 'XOR'
FCB $D2
FDB OR-5
XOR FDB *+2
* ######>> screen 26 <<
* ======>> 23 <<
FCB $83
- FCC 2,SP@
+ FCC 'SP' ; 'SP@'
FCB $C0
FDB XOR-6
SPAT FDB *+2
*
* ======>> 24 <<
FCB $83
- FCC 2,SP!
+ FCC 'SP' ; 'SP!'
FCB $A1
FDB SPAT-6
SPSTOR FDB *+2
LDX UP
LDX XSPZER-UORIG,X
-* Potential problem area? ******
- TFR X,S watch it ! X and S are not equal.
+* Potential problem area? No. ******
+ TFR X,S watch it ! X and S are not equal -- on 6800.
+* But they are on 6809, and that's what we want here.
JMP NEXT
* ======>> 25 <<
FCB $83
- FCC 2,RP!
+ FCC 'RP' ; 'RP!'
FCB $A1
FDB SPSTOR-6
RPSTOR FDB *+2
*
* ======>> 26 <<
FCB $82
- FCC 1,;S
+ FCC ';' ; ';S'
FCB $D3
FDB RPSTOR-6
SEMIS FDB *+2
* ######>> screen 27 <<
* ======>> 27 <<
FCB $85
- FCC 4,LEAVE
+ FCC 'LEAV' ; 'LEAVE'
FCB $C5
FDB SEMIS-5
LEAVE FDB *+2
*
* ======>> 28 <<
FCB $82
- FCC 1,>R
+ FCC '>' ; '>R'
FCB $D2
FDB LEAVE-8
TOR FDB *+2
*
* ======>> 29 <<
FCB $82
- FCC 1,R>
+ FCC 'R' ; 'R>'
FCB $BE
FDB TOR-5
FROMR FDB *+2
* ######>> screen 28 <<
* ======>> 31 <<
FCB $82
- FCC 1,0=
+ FCC '0' ; '0='
FCB $BD
FDB R-4
ZEQU FDB *+2
*
* ======>> 32 <<
FCB $82
- FCC 1,0<
+ FCC '0' ; '0<'
FCB $BC
FDB ZEQU-5
ZLESS FDB *+2
*
* ======>> 34 <<
FCB $82
- FCC 1,D+
+ FCC 'D' ; 'D+'
FCB $AB
FDB PLUS-4
DPLUS FDB *+2
*
* ======>> 35 <<
FCB $85
- FCC 4,MINUS
+ FCC 'MINU' ; 'MINUS'
FCB $D3
FDB DPLUS-5
MINUS FDB *+2
*
* ======>> 36 <<
FCB $86
- FCC 5,DMINUS
+ FCC 'DMINU' ; 'DMINUS'
FCB $D3
FDB MINUS-8
DMINUS FDB *+2
* ######>> screen 30 <<
* ======>> 37 <<
FCB $84
- FCC 3,OVER
+ FCC 'OVE' ; 'OVER'
FCB $D2
FDB DMINUS-9
OVER FDB *+2
*
* ======>> 38 <<
FCB $84
- FCC 3,DROP
+ FCC 'DRO' ; 'DROP'
FCB $D0
FDB OVER-7
DROP FDB *+2
*
* ======>> 39 <<
FCB $84
- FCC 3,SWAP
+ FCC 'SWA' ; 'SWAP'
FCB $D0
FDB DROP-7
SWAP FDB *+2
*
* ======>> 40 <<
FCB $83
- FCC 2,DUP
+ FCC 'DU' ; 'DUP'
FCB $D0
FDB SWAP-7
DUP FDB *+2
* ######>> screen 31 <<
* ======>> 41 <<
FCB $82
- FCC 1,+!
+ FCC '+' ; '+!'
FCB $A1
FDB DUP-6
PSTORE FDB *+2
*
* ======>> 42 <<
FCB $86
- FCC 5,TOGGLE
+ FCC 'TOGGL' ; 'TOGGLE'
FCB $C5
FDB PSTORE-5
TOGGLE FDB DOCOL,OVER,CAT,XOR,SWAP,CSTORE
*
* ======>> 44 <<
FCB $82
- FCC 1,C@
+ FCC 'C' ; 'C@'
FCB $C0
FDB AT-4
CAT FDB *+2
*
* ======>> 46 <<
FCB $82
- FCC 1,C!
+ FCC 'C' ; 'C!'
FCB $A1
FDB STORE-4
CSTORE FDB *+2
* ######>> screen 34 <<
* ======>> 49 <<
FCB $88
- FCC 7,CONSTANT
+ FCC 'CONSTAN' ; 'CONSTANT'
FCB $D4
FDB SEMI-4
CON FDB DOCOL,CREATE,SMUDGE,COMMA,PSCODE
*
* ======>> 50 <<
FCB $88
- FCC 7,VARIABLE
+ FCC 'VARIABL' ; 'VARIABLE'
FCB $C5
FDB CON-11
VAR FDB DOCOL,CON,PSCODE
*
* ======>> 51 <<
FCB $84
- FCC 3,USER
+ FCC 'USE' ; 'USER'
FCB $D2
FDB VAR-11
USER FDB DOCOL,CON,PSCODE
*
* ======>> 56 <<
FCB $82
- FCC 1,BL
+ FCC 'B' ; 'BL'
FCB $CC
FDB THREE-4
BL FDB DOCON ascii blank
*
* ======>> 57 <<
FCB $85
- FCC 4,FIRST
+ FCC 'FIRS' ; 'FIRST'
FCB $D4
FDB BL-5
FIRST FDB DOCON
*
* ======>> 58 <<
FCB $85
- FCC 4,LIMIT ( the end of memory +1 )
+ FCC 'LIMI' ; 'LIMIT' : ( the end of memory +1 )
FCB $D4
FDB FIRST-8
LIMIT FDB DOCON
*
* ======>> 59 <<
FCB $85
- FCC 4,B/BUF (bytes/buffer)
+ FCC 'B/BU' ; 'B/BUF' : (bytes/buffer)
FCB $C6
FDB LIMIT-8
BBUF FDB DOCON
*
* ======>> 60 <<
FCB $85
- FCC 4,B/SCR (blocks/screen)
+ FCC 'B/SC' ; 'B/SCR' : (blocks/screen)
FCB $D2
FDB BBUF-8
BSCR FDB DOCON
*
* ======>> 61 <<
FCB $87
- FCC 6,+ORIGIN
+ FCC '+ORIGI' ; '+ORIGIN'
FCB $CE
FDB BSCR-8
PORIG FDB DOCOL,LIT,ORIG,PLUS
* ######>> screen 36 <<
* ======>> 62 <<
FCB $82
- FCC 1,S0
+ FCC 'S' ; 'S0'
FCB $B0
FDB PORIG-10
SZERO FDB DOUSER
*
* ======>> 63 <<
FCB $82
- FCC 1,R0
+ FCC 'R' ; 'R0'
FCB $B0
FDB SZERO-5
RZERO FDB DOUSER
*
* ======>> 64 <<
FCB $83
- FCC 2,TIB
+ FCC 'TI' ; 'TIB'
FCB $C2
FDB RZERO-5
TIB FDB DOUSER
*
* ======>> 65 <<
FCB $85
- FCC 4,WIDTH
+ FCC 'WIDT' ; 'WIDTH'
FCB $C8
FDB TIB-6
WIDTH FDB DOUSER
*
* ======>> 66 <<
FCB $87
- FCC 6,WARNING
+ FCC 'WARNIN' ; 'WARNING'
FCB $C7
FDB WIDTH-8
WARN FDB DOUSER
*
* ======>> 67 <<
FCB $85
- FCC 4,FENCE
+ FCC 'FENC' ; 'FENCE'
FCB $C5
FDB WARN-10
FENCE FDB DOUSER
*
* ======>> 68 <<
FCB $82
- FCC 1,DP points to first free byte at end of dictionary
+ FCC 'D' ; 'DP' : points to first free byte at end of dictionary
FCB $D0
FDB FENCE-8
DICPT FDB DOUSER ; DP in 6800 source
*
* ======>> 68.5 <<
FCB $88
- FCC 7,VOC-LINK
+ FCC 'VOC-LIN' ; 'VOC-LINK'
FCB $CB
FDB DICPT-5
VOCLIN FDB DOUSER
*
* ======>> 69 <<
FCB $83
- FCC 2,BLK
+ FCC 'BL' ; 'BLK'
FCB $CB
FDB VOCLIN-11
BLK FDB DOUSER
*
* ======>> 70 <<
FCB $82
- FCC 1,IN scan pointer for input line buffer
+ FCC 'I' ; 'IN' : scan pointer for input line buffer
FCB $CE
FDB BLK-6
IN FDB DOUSER
*
* ======>> 71 <<
FCB $83
- FCC 2,OUT
+ FCC 'OU' ; 'OUT'
FCB $D4
FDB IN-5
OUT FDB DOUSER
*
* ======>> 72 <<
FCB $83
- FCC 2,SCR
+ FCC 'SC' ; 'SCR'
FCB $D2
FDB OUT-6
SCR FDB DOUSER
*
* ======>> 73 <<
FCB $86
- FCC 5,OFFSET
+ FCC 'OFFSE' ; 'OFFSET'
FCB $D4
FDB SCR-6
OFSET FDB DOUSER
*
* ======>> 74 <<
FCB $87
- FCC 6,CONTEXT points to pointer to vocab to search first
+ FCC 'CONTEX' ; 'CONTEXT' : points to pointer to vocab to search first
FCB $D4
FDB OFSET-9
CONTXT FDB DOUSER
*
* ======>> 75 <<
FCB $87
- FCC 6,CURRENT points to ptr. to vocab being extended
+ FCC 'CURREN' ; 'CURRENT' : points to ptr. to vocab being extended
FCB $D4
FDB CONTXT-10
CURENT FDB DOUSER
*
* ======>> 76 <<
FCB $85
- FCC 4,STATE 1 if compiling, 0 if not
+ FCC 'STAT' ; 'STATE' : 1 if compiling, 0 if not
FCB $C5
FDB CURENT-10
STATE FDB DOUSER
*
* ======>> 77 <<
FCB $84
- FCC 3,BASE number base for all input & output
+ FCC 'BAS' ; 'BASE' : number base for all input & output
FCB $C5
FDB STATE-8
BASE FDB DOUSER
*
* ======>> 78 <<
FCB $83
- FCC 2,DPL
+ FCC 'DP' ; 'DPL'
FCB $CC
FDB BASE-7
DPL FDB DOUSER
*
* ======>> 79 <<
FCB $83
- FCC 2,FLD
+ FCC 'FL' ; 'FLD'
FCB $C4
FDB DPL-6
FLD FDB DOUSER
*
* ======>> 80 <<
FCB $83
- FCC 2,CSP
+ FCC 'CS' ; 'CSP'
FCB $D0
FDB FLD-6
CSP FDB DOUSER
*
* ======>> 81 <<
FCB $82
- FCC 1,R#
+ FCC 'R' ; 'R#'
FCB $A3
FDB CSP-6
RNUM FDB DOUSER
*
* ======>> 82 <<
FCB $83
- FCC 2,HLD
+ FCC 'HL' ; 'HLD'
FCB $C4
FDB RNUM-5
HLD FDB DOCON
*
* ======>> 82.5 <<== SPECIAL
FCB $87
- FCC 6,COLUMNS line width of terminal
+ FCC 'COLUMN' ; 'COLUMNS' : line width of terminal
FCB $D3
FDB HLD-6
COLUMS FDB DOUSER
* ######>> screen 38 <<
* ======>> 83 <<
FCB $82
- FCC 1,1+
+ FCC '1' ; '1+'
FCB $AB
FDB COLUMS-10
ONEP FDB DOCOL,ONE,PLUS
*
* ======>> 84 <<
FCB $82
- FCC 1,2+
+ FCC '2' ; '2+'
FCB $AB
FDB ONEP-5
TWOP FDB DOCOL,TWO,PLUS
*
* ======>> 85 <<
FCB $84
- FCC 3,HERE
+ FCC 'HER' ; 'HERE'
FCB $C5
FDB TWOP-5
HERE FDB DOCOL,DICPT,AT
*
* ======>> 86 <<
FCB $85
- FCC 4,ALLOT
+ FCC 'ALLO' ; 'ALLOT'
FCB $D4
FDB HERE-7
ALLOT FDB DOCOL,DICPT,PSTORE
*
* ======>> 88 <<
FCB $82
- FCC 1,C,
+ FCC 'C' ; 'C,'
FCB $AC
FDB COMMA-4
CCOMM FDB DOCOL,HERE,CSTORE,ONE,ALLOT
*
* ======>> 93 <<
FCB $83
- FCC 2,ROT
+ FCC 'RO' ; 'ROT'
FCB $D4
FDB GREAT-4
ROT FDB DOCOL,TOR,SWAP,FROMR,SWAP
*
* ======>> 94 <<
FCB $85
- FCC 4,SPACE
+ FCC 'SPAC' ; 'SPACE'
FCB $C5
FDB ROT-6
SPACE FDB DOCOL,BL,EMIT
*
* ======>> 95 <<
FCB $83
- FCC 2,MIN
+ FCC 'MI' ; 'MIN'
FCB $CE
FDB SPACE-8
MIN FDB DOCOL,OVER,OVER,GREAT,ZBRAN
*
* ======>> 96 <<
FCB $83
- FCC 2,MAX
+ FCC 'MA' ; 'MAX'
FCB $D8
FDB MIN-6
MAX FDB DOCOL,OVER,OVER,LESS,ZBRAN
*
* ======>> 97 <<
FCB $84
- FCC 3,-DUP
+ FCC '-DU' ; '-DUP'
FCB $D0
FDB MAX-6
DDUP FDB DOCOL,DUP,ZBRAN
* ######>> screen 39 <<
* ======>> 98 <<
FCB $88
- FCC 7,TRAVERSE
+ FCC 'TRAVERS' ; 'TRAVERSE'
FCB $C5
FDB DDUP-7
TRAV FDB DOCOL,SWAP
*
* ======>> 99 <<
FCB $86
- FCC 5,LATEST
+ FCC 'LATES' ; 'LATEST'
FCB $D4
FDB TRAV-11
LATEST FDB DOCOL,CURENT,AT,AT
*
* ======>> 100 <<
FCB $83
- FCC 2,LFA
+ FCC 'LF' ; 'LFA'
FCB $C1
FDB LATEST-9
LFA FDB DOCOL,CLITER
*
* ======>> 101 <<
FCB $83
- FCC 2,CFA
+ FCC 'CF' ; 'CFA'
FCB $C1
FDB LFA-6
CFA FDB DOCOL,TWO,SUB
*
* ======>> 102 <<
FCB $83
- FCC 2,NFA
+ FCC 'NF' ; 'NFA'
FCB $C1
FDB CFA-6
NFA FDB DOCOL,CLITER
*
* ======>> 103 <<
FCB $83
- FCC 2,PFA
+ FCC 'PF' ; 'PFA'
FCB $C1
FDB NFA-6
PFA FDB DOCOL,ONE,TRAV,CLITER
* ######>> screen 40 <<
* ======>> 104 <<
FCB $84
- FCC 3,!CSP
+ FCC '!CS' ; '!CSP'
FCB $D0
FDB PFA-6
SCSP FDB DOCOL,SPAT,CSP,STORE
*
* ======>> 105 <<
FCB $86
- FCC 5,?ERROR
+ FCC '?ERRO' ; '?ERROR'
FCB $D2
FDB SCSP-7
QERR FDB DOCOL,SWAP,ZBRAN
*
* ======>> 106 <<
FCB $85
- FCC 4,?COMP
+ FCC '?COM' ; '?COMP'
FCB $D0
FDB QERR-9
QCOMP FDB DOCOL,STATE,AT,ZEQU,CLITER
*
* ======>> 107 <<
FCB $85
- FCC 4,?EXEC
+ FCC '?EXE' ; '?EXEC'
FCB $C3
FDB QCOMP-8
QEXEC FDB DOCOL,STATE,AT,CLITER
*
* ======>> 108 <<
FCB $86
- FCC 5,?PAIRS
+ FCC '?PAIR' ; '?PAIRS'
FCB $D3
FDB QEXEC-8
QPAIRS FDB DOCOL,SUB,CLITER
*
* ======>> 109 <<
FCB $84
- FCC 3,?CSP
+ FCC '?CS' ; '?CSP'
FCB $D0
FDB QPAIRS-9
QCSP FDB DOCOL,SPAT,CSP,AT,SUB,CLITER
*
* ======>> 110 <<
FCB $88
- FCC 7,?LOADING
+ FCC '?LOADIN' ; '?LOADING'
FCB $C7
FDB QCSP-7
QLOAD FDB DOCOL,BLK,AT,ZEQU,CLITER
* ######>> screen 41 <<
* ======>> 111 <<
FCB $87
- FCC 6,COMPILE
+ FCC 'COMPIL' ; 'COMPILE'
FCB $C5
FDB QLOAD-11
COMPIL FDB DOCOL,QCOMP,FROMR,TWOP,DUP,TOR,AT,COMMA
*
* ======>> 114 <<
FCB $86
- FCC 5,SMUDGE
+ FCC 'SMUDG' ; 'SMUDGE'
FCB $C5
FDB RBRAK-4
SMUDGE FDB DOCOL,LATEST,CLITER
*
* ======>> 115 <<
FCB $83
- FCC 2,HEX
+ FCC 'HE' ; 'HEX'
FCB $D8
FDB SMUDGE-9
HEX FDB DOCOL
*
* ======>> 116 <<
FCB $87
- FCC 6,DECIMAL
+ FCC 'DECIMA' ; 'DECIMAL'
FCB $CC
FDB HEX-6
DEC FDB DOCOL
* ######>> screen 42 <<
* ======>> 117 <<
FCB $87
- FCC 6,(;CODE)
+ FCC '(;CODE' ; '(;CODE)'
FCB $A9
FDB DEC-10
PSCODE FDB DOCOL,FROMR,TWOP,LATEST,PFA,CFA,STORE
*
* ======>> 118 <<
FCB $C5 immediate
- FCC 4,;CODE
+ FCC ';COD' ; ';CODE'
FCB $C5
FDB PSCODE-10
SEMIC FDB DOCOL,QCSP,COMPIL,PSCODE,SMUDGE,LBRAK,QSTACK
* ######>> screen 43 <<
* ======>> 119 <<
FCB $87
- FCC 6,<BUILDS
+ FCC '<BUILD' ; '<BUILDS'
FCB $D3
FDB SEMIC-8
BUILDS FDB DOCOL,ZERO,CON
*
* ======>> 120 <<
FCB $85
- FCC 4,DOES>
+ FCC 'DOES' ; 'DOES>'
FCB $BE
FDB BUILDS-10
DOES FDB DOCOL,FROMR,TWOP,LATEST,PFA,STORE
* ######>> screen 44 <<
* ======>> 121 <<
FCB $85
- FCC 4,COUNT
+ FCC 'COUN' ; 'COUNT'
FCB $D4
FDB DOES-8
COUNT FDB DOCOL,DUP,ONEP,SWAP,CAT
*
* ======>> 122 <<
FCB $84
- FCC 3,TYPE
+ FCC 'TYP' ; 'TYPE'
FCB $C5
FDB COUNT-8
TYPE FDB DOCOL,DDUP,ZBRAN
*
* ======>> 123 <<
FCB $89
- FCC 8,-TRAILING
+ FCC '-TRAILIN' ; '-TRAILING'
FCB $C7
FDB TYPE-7
DTRAIL FDB DOCOL,DUP,ZERO,XDO
*
* ======>> 124 <<
FCB $84
- FCC 3,(.")
+ FCC '(."' ; '(.")'
FCB $A9
FDB DTRAIL-12
PDOTQ FDB DOCOL,R,TWOP,COUNT,DUP,ONEP
*
* ======>> 125 <<
FCB $C2 immediate
- FCC 1,."
+ FCC '.' ; '."'
FCB $A2
FDB PDOTQ-7
DOTQ FDB DOCOL
* ######>> screen 45 <<
* ======>> 126 <<== MACHINE DEPENDENT
FCB $86
- FCC 5,?STACK
+ FCC '?STAC' ; '?STACK'
FCB $CB
FDB DOTQ-5
QSTACK FDB DOCOL,CLITER
* ######>> screen 46 <<
* ======>> 128 <<
FCB $86
- FCC 5,EXPECT
+ FCC 'EXPEC' ; 'EXPECT'
FCB $D4
FDB QSTACK-9
EXPECT FDB DOCOL,OVER,PLUS,OVER,XDO
*
* ======>> 129 <<
FCB $85
- FCC 4,QUERY
+ FCC 'QUER' ; 'QUERY'
FCB $D9
FDB EXPECT-9
QUERY FDB DOCOL,TIB,AT,COLUMS
* ######>> screen 47 <<
* ======>> 133 <<
FCB $84
- FCC 3,FILL
+ FCC 'FIL' ; 'FILL'
FCB $CC
FDB NULL-4
FILL FDB DOCOL,SWAP,TOR,OVER,CSTORE,DUP,ONEP
*
* ======>> 134 <<
FCB $85
- FCC 4,ERASE
+ FCC 'ERAS' ; 'ERASE'
FCB $C5
FDB FILL-7
ERASE FDB DOCOL,ZERO,FILL
*
* ======>> 135 <<
FCB $86
- FCC 5,BLANKS
+ FCC 'BLANK' ; 'BLANKS'
FCB $D3
FDB ERASE-8
BLANKS FDB DOCOL,BL,FILL
*
* ======>> 136 <<
FCB $84
- FCC 3,HOLD
+ FCC 'HOL' ; 'HOLD'
FCB $C4
FDB BLANKS-9
HOLD FDB DOCOL,LIT,$FFFF,HLD,PSTORE,HLD,AT,CSTORE
*
* ======>> 137 <<
FCB $83
- FCC 2,PAD
+ FCC 'PA' ; 'PAD'
FCB $C4
FDB HOLD-7
PAD FDB DOCOL,HERE,CLITER
* ######>> screen 48 <<
* ======>> 138 <<
FCB $84
- FCC 3,WORD
+ FCC 'WOR' ; 'WORD'
FCB $C4
FDB PAD-6
WORD FDB DOCOL,BLK,AT,ZBRAN
* ######>> screen 49 <<
* ======>> 139 <<
FCB $88
- FCC 7,(NUMBER)
+ FCC '(NUMBER' ; '(NUMBER)'
FCB $A9
FDB WORD-7
PNUMB FDB DOCOL
*
* ======>> 140 <<
FCB $86
- FCC 5,NUMBER
+ FCC 'NUMBE' ; 'NUMBER'
FCB $D2
FDB PNUMB-11
NUMB FDB DOCOL,ZERO,ZERO,ROT,DUP,ONEP,CAT,CLITER
*
* ======>> 141 <<
FCB $85
- FCC 4,-FIND
+ FCC '-FIN' ; '-FIND'
FCB $C4
FDB NUMB-9
DFIND FDB DOCOL,BL,WORD,HERE,CONTXT,AT,AT
* ######>> screen 50 <<
* ======>> 142 <<
FCB $87
- FCC 6,(ABORT)
+ FCC '(ABORT' ; '(ABORT)'
FCB $A9
FDB DFIND-8
PABORT FDB DOCOL,ABORT
*
* ======>> 143 <<
FCB $85
- FCC 4,ERROR
+ FCC 'ERRO' ; 'ERROR'
FCB $D2
FDB PABORT-10
ERROR FDB DOCOL,WARN,AT,ZLESS
*
* ======>> 144 <<
FCB $83
- FCC 2,ID.
+ FCC 'ID' ; 'ID.'
FCB $AE
FDB ERROR-8
IDDOT FDB DOCOL,PAD,CLITER
* ######>> screen 51 <<
* ======>> 145 <<
FCB $86
- FCC 5,CREATE
+ FCC 'CREAT' ; 'CREATE'
FCB $C5
FDB IDDOT-6
CREATE FDB DOCOL,DFIND,ZBRAN
* ######>> screen 52 <<
* ======>> 146 <<
FCB $C9 immediate
- FCC 8,[COMPILE]
+ FCC '[COMPILE' ; '[COMPILE]'
FCB $DD
FDB CREATE-9
BCOMP FDB DOCOL,DFIND,ZEQU,ZERO,QERR,DROP,CFA,COMMA
*
* ======>> 147 <<
FCB $C7 immediate
- FCC 6,LITERAL
+ FCC 'LITERA' ; 'LITERAL'
FCB $CC
FDB BCOMP-12
LITER FDB DOCOL,STATE,AT,ZBRAN
*
* ======>> 148 <<
FCB $C8 immediate
- FCC 7,DLITERAL
+ FCC 'DLITERA' ; 'DLITERAL'
FCB $CC
FDB LITER-10
DLITER FDB DOCOL,STATE,AT,ZBRAN
* ######>> screen 53 <<
* ======>> 149 <<
FCB $89
- FCC 8,INTERPRET
+ FCC 'INTERPRE' ; 'INTERPRET'
FCB $D4
FDB DLITER-11
INTERP FDB DOCOL
* ######>> screen 54 <<
* ======>> 150 <<
FCB $89
- FCC 8,IMMEDIATE
+ FCC 'IMMEDIAT' ; 'IMMEDIATE'
FCB $C5
FDB INTERP-12
IMMED FDB DOCOL,LATEST,CLITER
*
* ======>> 151 <<
FCB $8A
- FCC 9,VOCABULARY
+ FCC 'VOCABULAR' ; 'VOCABULARY'
FCB $D9
FDB IMMED-12
VOCAB FDB DOCOL,BUILDS,LIT,$81A0,COMMA,CURENT,AT,CFA
*
* ======>> 153 <<
FCB $8B
- FCC 10,DEFINITIONS
+ FCC 'DEFINITION' ; 'DEFINITIONS'
FCB $D3
FDB VOCAB-13
DEFIN FDB DOCOL,CONTXT,AT,CURENT,STORE
* ######>> screen 55 <<
* ======>> 155 <<
FCB $84
- FCC 3,QUIT
+ FCC 'QUI' ; 'QUIT'
FCB $D4
FDB PAREN-4
QUIT FDB DOCOL,ZERO,BLK,STORE
FDB QUIT3-*
FDB PDOTQ
FCB 3
- FCC 3, OK
+ FCC ' OK' ; ' OK'
QUIT3 FDB BRAN
FDB QUIT2-*
* FDB SEMIS ( never executed )
*
* ======>> 156 <<
FCB $85
- FCC 4,ABORT
+ FCC 'ABOR' ; 'ABORT'
FCB $D4
FDB QUIT-7
ABORT FDB DOCOL,SPSTOR,DEC,QSTACK,DRZERO,CR,PDOTQ
* bootstrap code... moves rom contents to ram :
* ======>> 157 <<
FCB $84
- FCC 3,COLD
+ FCC 'COL' ; 'COLD'
FCB $C4
FDB ABORT-8
COLD FDB *+2
-CENT LDS #REND-1 top of destination
+* CENT LDS #REND-1 top of destination on 6800
+CENT LDA #PGBDP
+ TFR A,DP
+ LDS #REND top of destination on 6809
LDX #ERAM top of stuff to move
COLD2 LEAX -1,X
LDA 0,X
CMPX #RAM
BNE COLD2
*
- LDS #XFENCE-1 put stack at a safe place for now
+* LDS #XFENCE-1 put stack at a safe place for now -- 6800
+* But only matters if we're interrupted.
+ LDS #XFENCE put stack at a safe place for now -- 6809
LDX COLINT
STX XCOLUM
LDX DELINT
STX XFENCE
-WENT LDS #XFENCE-1 top of destination
+* WENT LDS #XFENCE-1 top of destination -- 6800
+WENT LDS #XFENCE top of destination -- 6809
LDX #FENCIN top of stuff to move
WARM2 LEAX -1,X
LDA 0,X
CMPX #SINIT
BNE WARM2
*
+* Don't get faked out.
+* This is just a safe place for the stack if we're interrupted.
+* ABORT sends us through RP! and then SP!
+* And SP! loads S through X, which is just fine for the 6809, too.
LDS SINIT
LDX UPINIT
STX UP init user ram pointer
* ======>> (152) <<
FCB $C5 immediate
- FCC 4,FORTH
+ FCC 'FORT' ; 'FORTH'
FCB $C8
FDB NOOP-7
RFORTH FDB DODOES,DOVOC,$81A0,TASK-7
FDB 0
FCC "(C) Forth Interest Group, 1979"
FCB $84
- FCC 3,TASK
+ FCC 'TAS' ; 'TASK'
FCB $CB
FDB FORTH-8
RTASK FDB DOCOL,SEMIS
* ######>> screen 57 <<
* ======>> 158 <<
FCB $84
- FCC 3,S->D
+ FCC 'S->' ; 'S->D'
FCB $C4
FDB COLD-7
STOD FDB DOCOL,DUP,ZLESS,MINUS
*
* ======>> 160 <<
FCB $84
- FCC 3,/MOD
+ FCC '/MO' ; '/MOD'
FCB $C4
FDB STAR-4
SLMOD FDB DOCOL,TOR,STOD,FROMR,USLASH
*
* ======>> 162 <<
FCB $83
- FCC 2,MOD
+ FCC 'MO' ; 'MOD'
FCB $C4
FDB SLASH-4
MOD FDB DOCOL,SLMOD,DROP
*
* ======>> 163 <<
FCB $85
- FCC 4,*/MOD
+ FCC '*/MO' ; '*/MOD'
FCB $C4
FDB MOD-6
SSMOD FDB DOCOL,TOR,USTAR,FROMR,USLASH
*
* ======>> 164 <<
FCB $82
- FCC 1,*/
+ FCC '*' ; '*/'
FCB $AF
FDB SSMOD-8
SSLASH FDB DOCOL,SSMOD,SWAP,DROP
*
* ======>> 165 <<
FCB $85
- FCC 4,M/MOD
+ FCC 'M/MO' ; 'M/MOD'
FCB $C4
FDB SSLASH-5
MSMOD FDB DOCOL,TOR,ZERO,R,USLASH
*
* ======>> 166 <<
FCB $83
- FCC 2,ABS
+ FCC 'AB' ; 'ABS'
FCB $D3
FDB MSMOD-8
ABS FDB DOCOL,DUP,ZLESS,ZBRAN
*
* ======>> 167 <<
FCB $84
- FCC 3,DABS
+ FCC 'DAB' ; 'DABS'
FCB $D3
FDB ABS-6
DABS FDB DOCOL,DUP,ZLESS,ZBRAN
* Disc primatives :
* ======>> 168 <<
FCB $83
- FCC 2,USE
+ FCC 'US' ; 'USE'
FCB $C5
FDB DABS-7
USE FDB DOCON
FDB XUSE
* ======>> 169 <<
FCB $84
- FCC 3,PREV
+ FCC 'PRE' ; 'PREV'
FCB $D6
FDB USE-6
PREV FDB DOCON
FDB XPREV
* ======>> 170 <<
FCB $84
- FCC 3,+BUF
+ FCC '+BU' ; '+BUF'
FCB $C6
FDB PREV-7
PBUF FDB DOCOL,CLITER
*
* ======>> 171 <<
FCB $86
- FCC 5,UPDATE
+ FCC 'UPDAT' ; 'UPDATE'
FCB $C5
FDB PBUF-7
UPDATE FDB DOCOL,PREV,AT,AT,LIT,$8000,OR,PREV,AT,STORE
*
* ======>> 172 <<
FCB $8D
- FCC 12,EMPTY-BUFFERS
+ FCC 'EMPTY-BUFFER' ; 'EMPTY-BUFFERS'
FCB $D3
FDB UPDATE-9
MTBUF FDB DOCOL,FIRST,LIMIT,OVER,SUB,ERASE
*
* ======>> 173 <<
FCB $83
- FCC 2,DR0
+ FCC 'DR' ; 'DR0'
FCB $B0
FDB MTBUF-16
DRZERO FDB DOCOL,ZERO,OFSET,STORE
*
* ======>> 174 <<== system dependant word
FCB $83
- FCC 2,DR1
+ FCC 'DR' ; 'DR1'
FCB $B1
FDB DRZERO-6
DRONE FDB DOCOL,LIT,$07D0,OFSET,STORE
* ######>> screen 59 <<
* ======>> 175 <<
FCB $86
- FCC 5,BUFFER
+ FCC 'BUFFE' ; 'BUFFER'
FCB $D2
FDB DRONE-6
BUFFER FDB DOCOL,USE,AT,DUP,TOR
* ######>> screen 60 <<
* ======>> 176 <<
FCB $85
- FCC 4,BLOCK
+ FCC 'BLOC' ; 'BLOCK'
FCB $CB
FDB BUFFER-9
BLOCK FDB DOCOL,OFSET,AT,PLUS,TOR
* ######>> screen 61 <<
* ======>> 177 <<
FCB $86
- FCC 5,(LINE)
+ FCC '(LINE' ; '(LINE)'
FCB $A9
FDB BLOCK-8
PLINE FDB DOCOL,TOR,CLITER
*
* ======>> 178 <<
FCB $85
- FCC 4,.LINE
+ FCC '.LIN' ; '.LINE'
FCB $C5
FDB PLINE-9
DLINE FDB DOCOL,PLINE,DTRAIL,TYPE
*
* ======>> 179 <<
FCB $87
- FCC 6,MESSAGE
+ FCC 'MESSAG' ; 'MESSAGE'
FCB $C5
FDB DLINE-8
MESS FDB DOCOL,WARN,AT,ZBRAN
FDB MESS4-*
MESS3 FDB PDOTQ
FCB 6
- FCC 6,err #
+ FCC 'err # ' ; 'err # '
FDB DOT
MESS4 FDB SEMIS
*
* ======>> 180 <<
FCB $84
- FCC 3,LOAD input:scr #
+ FCC 'LOA' ; 'LOAD' : input:scr #
FCB $C4
FDB MESS-10
LOAD FDB DOCOL,BLK,AT,TOR,IN,AT,TOR,ZERO,IN,STORE
*
* ======>> 181 <<
FCB $C3
- FCC 2,-->
+ FCC '--' ; '-->'
FCB $BE
FDB LOAD-7
ARROW FDB DOCOL,QLOAD,ZERO,IN,STORE,BSCR
* called by words 13 through 16 in the dictionary.
*
* ======>> 182 << code for EMIT
-PEMIT STB N save B
- STX N+1 save X
- LDB ACIAC
- BITB #2 check ready bit
- BEQ PEMIT+4 if not ready for more data
- STA ACIAD
- LDX UP
- STB IOSTAT-UORIG,X
- LDB N recover B & X
- LDX N+1
- RTS only A register may change
+* character to output in A
+* Coco:
+PEMIT PSHS Y,U,DP
+ CLRB
+ TFR B,DP
+ JSR [$A002]
+ PULS Y,U,DP,PC
+*
+* PEMIT STB N save B
+* STX N+1 save X
+* LDB ACIAC
+* BITB #2 check ready bit
+* BEQ PEMIT+4 if not ready for more data
+* STA ACIAD
+* LDX UP
+* STB IOSTAT-UORIG,X
+* LDB N recover B & X
+* LDX N+1
+* RTS only A register may change
* PEMIT JMP $E1D1 for MIKBUG
* PEMIT FCB $3F,$11,$39 for PROTO
* PEMIT JMP $D286 for Smoke Signal DOS
*
* ======>> 183 << code for KEY
-PKEY STB N
- STX N+1
- LDB ACIAC
- ASRB
- BCC PKEY+4 no incoming data yet
- LDA ACIAD
- ANDA #$7F strip parity bit
- LDX UP
- STB IOSTAT+1-UORIG,X
- LDB N
- LDX N+1
- RTS
+* Returns input character in A
+* Coco:
+PKEY PSHS Y,U,DP
+ CLRB
+ TFR B,DP
+ LDA #$CF a cursor
+ LDB [$0088] (locate) save
+ STA [$0088]
+PKEYBZ JSR [$A000]
+ BEQ PKEYBZ
+ STB [$0088] restore
+ PULS Y,U,DP,PC
+*
+* PKEY STB N
+* STX N+1
+* LDB ACIAC
+* ASRB
+* BCC PKEY+4 no incoming data yet
+* LDA ACIAD
+* ANDA #$7F strip parity bit
+* LDX UP
+* STB IOSTAT+1-UORIG,X
+* LDB N
+* LDX N+1
+* RTS
* PKEY JMP $E1AC for MIKBUG
* PKEY FCB $3F,$14,$39 for PROTO
* PKEY JMP $D289 for Smoke Signal DOS
*
* ######>> screen 64 <<
* ======>> 184 << code for ?TERMINAL
-PQTER LDA ACIAC Test for 'break' condition
- ANDA #$11 mask framing error bit and
-* input buffer full
- BEQ PQTER2
- LDA ACIAD clear input buffer
- LDA #01
-PQTER2 RTS
+* Returns flag in A (non-zero if BREAK).
+* Coco:
+PQTER PSHS Y,U,DP
+ CLRB
+ TFR B,DP
+ JSR [$A000]
+ CLRB
+ CMPA #3 break key
+ BNE PQTERN
+ INCB
+ EXG A,B
+PQTERN PULS Y,U,DP,PC
+*
+* PQTER LDA ACIAC Test for 'break' condition
+* ANDA #$11 mask framing error bit and
+** input buffer full
+* BEQ PQTER2
+* LDA ACIAD clear input buffer
+* LDA #01
+*PQTER2 RTS
PAGE
*
* ======>> 185 << code for CR
+* Coco:
PRTCR LDA #$D carriage return ; PCR in 6800 source
- BSR PEMIT
- LDA #$A line feed
- BSR PEMIT
- LDA #$7F rubout
- LDX UP
- LDB XDELAY+1-UORIG,X
-PCR2 DECB
- BMI PQTER2 return if minus
- PSHS B save counter
- BSR PEMIT print RUBOUTs to delay.....
- PULS B
- BRA PCR2 repeat
+ BRA PEMIT Let PEMIT return
+*
+* BSR PEMIT
+* LDA #$A line feed
+* BSR PEMIT
+* LDA #$7F rubout
+* LDX UP
+* LDB XDELAY+1-UORIG,X
+* PCR2 DECB
+* BMI PQTER2 return if minus
+* PSHS B save counter
+* BSR PEMIT print RUBOUTs to delay.....
+* PULS B
+* BRA PCR2 repeat
PAGE
* ######>> screen 66 <<
* ======>> 187 <<
FCB $85
- FCC 4,?DISC
+ FCC '?DIS' ; '?DISC'
FCB $C3
FDB ARROW-6
QDISC FDB *+2
* ######>> screen 67 <<
* ======>> 189 <<
FCB $8B
- FCC 10,BLOCK-WRITE
+ FCC 'BLOCK-WRIT' ; 'BLOCK-WRITE'
FCB $C5
FDB QDISC-8
BWRITE FDB *+2
* ######>> screen 68 <<
* ======>> 190 <<
FCB $8A
- FCC 9,BLOCK-READ
+ FCC 'BLOCK-REA' ; 'BLOCK-READ'
FCB $C4
FDB BWRITE-14
BREAD FDB *+2
* mass memory,located between $3210 & $3FFF in ram.
* ======>> 190.1 <<
FCB $82
- FCC 1,LO
+ FCC 'L' ; 'LO'
FCB $CF
FDB BREAD-13
LO FDB DOCON
*
* ======>> 190.2 <<
FCB $82
- FCC 1,HI
+ FCC 'H' ; 'HI'
FCB $C9
FDB LO-5
HI FDB DOCON
* ######>> screen 69 <<
* ======>> 191 <<
FCB $83
- FCC 2,R/W
+ FCC 'R/' ; 'R/W'
FCB $D7
FDB HI-5
RW FDB DOCOL,TOR,BBUF,STAR,LO,PLUS,DUP,HI,GREAT,ZBRAN
FDB RW2-*
FDB PDOTQ
FCB 8
- FCC 8, Range ?
+ FCC ' Range ?' ; ' Range ?'
FDB QUIT
RW2 FDB FROMR,ZBRAN
FDB RW3-*
*
* ======>> 193 <<
FCB $86
- FCC 5,FORGET
+ FCC 'FORGE' ; 'FORGET'
FCB $D4
FDB TICK-4
FORGET FDB DOCOL,CURENT,AT,CONTXT,AT,SUB,CLITER
* ######>> screen 73 <<
* ======>> 194 <<
FCB $84
- FCC 3,BACK
+ FCC 'BAC' ; 'BACK'
FCB $CB
FDB FORGET-9
BACK FDB DOCOL,HERE,SUB,COMMA
*
* ======>> 195 <<
FCB $C5
- FCC 4,BEGIN
+ FCC 'BEGI' ; 'BEGIN'
FCB $CE
FDB BACK-7
BEGIN FDB DOCOL,QCOMP,HERE,ONE
*
* ======>> 196 <<
FCB $C5
- FCC 4,ENDIF
+ FCC 'ENDI' ; 'ENDIF'
FCB $C6
FDB BEGIN-8
ENDIF FDB DOCOL,QCOMP,TWO,QPAIRS,HERE
*
* ======>> 197 <<
FCB $C4
- FCC 3,THEN
+ FCC 'THE' ; 'THEN'
FCB $CE
FDB ENDIF-8
THEN FDB DOCOL,ENDIF
*
* ======>> 198 <<
FCB $C2
- FCC 1,DO
+ FCC 'D' ; 'DO'
FCB $CF
FDB THEN-7
DO FDB DOCOL,COMPIL,XDO,HERE,THREE
*
* ======>> 199 <<
FCB $C4
- FCC 3,LOOP
+ FCC 'LOO' ; 'LOOP'
FCB $D0
FDB DO-5
LOOP FDB DOCOL,THREE,QPAIRS,COMPIL,XLOOP,BACK
*
* ======>> 200 <<
FCB $C5
- FCC 4,+LOOP
+ FCC '+LOO' ; '+LOOP'
FCB $D0
FDB LOOP-7
PLOOP FDB DOCOL,THREE,QPAIRS,COMPIL,XPLOOP,BACK
*
* ======>> 201 <<
FCB $C5
- FCC 4,UNTIL ( same as END )
+ FCC 'UNTI' ; 'UNTIL' : ( same as END )
FCB $CC
FDB PLOOP-8
UNTIL FDB DOCOL,ONE,QPAIRS,COMPIL,ZBRAN,BACK
* ######>> screen 74 <<
* ======>> 202 <<
FCB $C3
- FCC 2,END
+ FCC 'EN' ; 'END'
FCB $C4
FDB UNTIL-8
END FDB DOCOL,UNTIL
*
* ======>> 203 <<
FCB $C5
- FCC 4,AGAIN
+ FCC 'AGAI' ; 'AGAIN'
FCB $CE
FDB END-6
AGAIN FDB DOCOL,ONE,QPAIRS,COMPIL,BRAN,BACK
*
* ======>> 204 <<
FCB $C6
- FCC 5,REPEAT
+ FCC 'REPEA' ; 'REPEAT'
FCB $D4
FDB AGAIN-8
REPEAT FDB DOCOL,TOR,TOR,AGAIN,FROMR,FROMR
*
* ======>> 205 <<
FCB $C2
- FCC 1,IF
+ FCC 'I' ; 'IF'
FCB $C6
FDB REPEAT-9
IF FDB DOCOL,COMPIL,ZBRAN,HERE,ZERO,COMMA,TWO
*
* ======>> 206 <<
FCB $C4
- FCC 3,ELSE
+ FCC 'ELS' ; 'ELSE'
FCB $C5
FDB IF-5
ELSE FDB DOCOL,TWO,QPAIRS,COMPIL,BRAN,HERE
*
* ======>> 207 <<
FCB $C5
- FCC 4,WHILE
+ FCC 'WHIL' ; 'WHILE'
FCB $C5
FDB ELSE-7
WHILE FDB DOCOL,IF,TWOP
* ######>> screen 75 <<
* ======>> 208 <<
FCB $86
- FCC 5,SPACES
+ FCC 'SPACE' ; 'SPACES'
FCB $D3
FDB WHILE-8
SPACES FDB DOCOL,ZERO,MAX,DDUP,ZBRAN
*
* ======>> 209 <<
FCB $82
- FCC 1,<#
+ FCC '<' ; '<#'
FCB $A3
FDB SPACES-9
BDIGS FDB DOCOL,PAD,HLD,STORE
*
* ======>> 210 <<
FCB $82
- FCC 1,#>
+ FCC '#' ; '#>'
FCB $BE
FDB BDIGS-5
EDIGS FDB DOCOL,DROP,DROP,HLD,AT,PAD,OVER,SUB
*
* ======>> 211 <<
FCB $84
- FCC 3,SIGN
+ FCC 'SIG' ; 'SIGN'
FCB $CE
FDB EDIGS-5
SIGN FDB DOCOL,ROT,ZLESS,ZBRAN
*
* ======>> 213 <<
FCB $82
- FCC 1,#S
+ FCC '#' ; '#S'
FCB $D3
FDB DIG-4
DIGS FDB DOCOL
* ######>> screen 76 <<
* ======>> 214 <<
FCB $82
- FCC 1,.R
+ FCC '.' ; '.R'
FCB $D2
FDB DIGS-5
DOTR FDB DOCOL,TOR,STOD,FROMR,DDOTR
*
* ======>> 215 <<
FCB $83
- FCC 2,D.R
+ FCC 'D.' ; 'D.R'
FCB $D2
FDB DOTR-5
DDOTR FDB DOCOL,TOR,SWAP,OVER,DABS,BDIGS,DIGS,SIGN
*
* ======>> 216 <<
FCB $82
- FCC 1,D.
+ FCC 'D' ; 'D.'
FCB $AE
FDB DDOTR-6
DDOT FDB DOCOL,ZERO,DDOTR,SPACE
* ######>> screen 77 <<
* ======>> 219 <<
FCB $84
- FCC 3,LIST
+ FCC 'LIS' ; 'LIST'
FCB $D4
FDB QUEST-4
LIST FDB DOCOL,DEC,CR,DUP,SCR,STORE,PDOTQ
*
* ======>> 220 <<
FCB $85
- FCC 4,INDEX
+ FCC 'INDE' ; 'INDEX'
FCB $D8
FDB LIST-7
INDEX FDB DOCOL,CR,ONEP,SWAP,XDO
*
* ======>> 221 <<
FCB $85
- FCC 4,TRIAD
+ FCC 'TRIA' ; 'TRIAD'
FCB $C4
FDB INDEX-8
TRIAD FDB DOCOL,THREE,SLASH,THREE,STAR
* ######>> screen 78 <<
* ======>> 222 <<
FCB $85
- FCC 4,VLIST
+ FCC 'VLIS' ; 'VLIST'
FCB $D4
FDB TRIAD-8
VLIST FDB DOCOL,CLITER
*
* ======>> XX <<
FCB $84
- FCC 3,NOOP
+ FCC 'NOO' ; 'NOOP'
FCB $D0
FDB VLIST-8
NOOP FDB NEXT a useful no-op
OSDN Git Service
