*
-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
* 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
+ACIAC EQU $FBCE ; the ACIA control address and
+ACIAD EQU ACIAC+1 ; data address for PROTO
PAGE
* MEMORY MAP for this 16K system:
* ( positioned so that systems with 4k byte write-
- ORG $E0 variables
+ ORG $E0 ; variables
-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 )
*
PAGE
* [ 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
+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
+ FCB $C5 ; immediate
FCC 4,FORTH
FCB $C8
FDB NOOP-7
** 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
+ 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
+ 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'
+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
* = = = = = = = 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
NOP
-* JMP TRACE ( an alternate for the above )
+* JMP TRACE ; ( an alternate for the above )
* =
* = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
*
* ======>> 1 <<
FCB $83
- FCC 2,LIT NOTE: this is different from LITERAL
+ FCC 2,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
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
*
FCC 5,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
* 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
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)
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 <<
FCC 3,(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
FCC 4,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 <<
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
* 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
OSDN Git Service
