Fleet Forth design considerations

[JimBoyd]

In my post describing how Fleet Forth handles the text stream I did not show the source for Fleet Forth's WORD . I thought it might be a distraction. Here is the source for Fleet Forth's WORD .

Code: Select all

2VARIABLE HISTORY
: WORD  ( C -- HERE )
   'STREAM                  \ Return address and count of remaining text stream.
   BLK 2@ HISTORY 2!        \ Save the contents of BLK and >IN to HISTORY.
   DUP >IN +!               \ Use count from 'STREAM to push >IN past text stream.
   2PICK SKIP               ( delimiter address count )
   ROT 2PICK -ROT SCAN      ( address address2 count2 )
   1- 0 MAX NEGATE >IN +!   \ Use count from SCAN to pull >IN to correct offset.
   OVER - >HERE ;

'STREAM returns the address and length of the remaining text stream.
After the history is saved for use by WHERE and THRU , >IN is set to point just past the text stream.
SKIP returns the address in the text stream of the sought after text and the length of the remaining text stream.
A copy of this address is saved under the address length and delimiter needed by SCAN .
SCAN returns the address of the delimiter after the sought after text and the length of the remaining text stream. One is subtracted from the length. The maximum of this value and zero is subtracted from >IN to put the offset past the delimiter but no further than the end of the text stream.
All that remains are the addresses of the start of the sought text and the address of the delimiter after the sought text. These are converted to the address and count.
Before >HERE is executed, the address of the string and count are on the stack. The address in the text stream, just like Ansi Forth's PARSE-WORD .
>HERE stores this string at HERE as a counted string with a trailing blank. >HERE is a code word for speed.
I could have defined WORD like this:

Code: Select all

2VARIABLE HISTORY
: PARSE-WORD  ( C -- ADR CNT )
   'STREAM                  \ Return address and count of remaining text stream.
   BLK 2@ HISTORY 2!        \ Save the contents of BLK and >IN to HISTORY.
   DUP >IN +!               \ Use count from 'STREAM to push >IN past text stream.
   2PICK SKIP               ( delimiter address count )
   ROT 2PICK -ROT SCAN      ( address address2 count2 )
   1- 0 MAX NEGATE >IN +!   \ Use count from SCAN to pull >IN to correct offset.
   OVER - ;
: WORD  ( C -- HERE )
   PARSE-WORD >HERE ;

However, I saw no need for PARSE-WORD . Fleet Forth's find primitives require the address of a counted string rather than the address of a string and a count and CREATE needs a counted string at HERE .
Fleet Forth's 'TEXT returns the address of the string in the text stream and the length. It is like Ansi Forth's PARSE with one difference. If the delimiter is not found in the text stream 'TEXT aborts with an error message.

Code: Select all

: 'TEXT  ( C -- ADR CNT )
   DUP>R LIT [ HERE >A 0 , ] C!  \ Store delimiter in ABORT" string.
   'STREAM 2DUP R>               ( ADR LEN ADR LEN C )
   SCAN 0=                       ( ADR LEN ADR2 FLAG )
   [ HERE 3 + A> ! ]             \ If text stream exhausted after SCAN
   ABORT"   MISSING"             \ then the delimiter was not found
   NIP OVER -                    ( ADR CNT )
   DUP 1+ >IN +! ;

'STREAM returns the address and length of the remaining text stream. A copy of the delimiter is stored in the inline string used by ABORT" . After SCAN executes, the address and length 'STREAM placed on the data stack is still there as well as the address of the first occurrence of the delimiter and the length of the text stream after this point. If this length is zero, the delimiter was not found so abort with an error message.
The length returned by 'STREAM is no longer needed so it is NIPped off the data stack and the two addresses are used to calculate the length of the string returned by 'TEXT . A copy of this length plus one is added to >IN .

[Edit: Corrected an error.]

[JimBoyd]

An error in one of the machine states in a demo for A Finite State Machine Engine in Forth revealed a shortcoming in Fleet Forth's error handling.
My initial assumption was that words run as background tasks would be fully debugged before set as background tasks. That assumption was in error. When a background task is a word to run through a list of finite state machines, every machine state for every machine installed must be error free. Ideally, a finite state machine should be fully tested before it is installed as one of the machines running in the background, but mistakes do happen.
I've improved Fleet Forth's error handling. Since error reporting uses WHERE to report the location of the error, WHERE was modified to include SINGLE and UNLINK .

Code: Select all

: WHERE
   ['] EXIT (IS) RECURSE
   SINGLE UNLINK            \ <- This line was added to switch
                            \ off multitasking and reset
                            \ the user pointer and user area's
                            \ first six user variables.
   HISTORY 2@ TUCK  BLK 2!
    ...

SINGLE switches off multitasking and UNLINK points UP (the user pointer) back at the main user area and resets the first six user variables to their boot-up values from the boot area. This causes the main user area's ENTRY to point back to itself, make sure the main task is awake and reset the default stack bases for the return, data, and auxiliary stacks.

With these changes, an ABORT" in one of the machine states for a finite state machine running in the background no longer causes problems in Fleet Forth.

[JimBoyd]

One version of the Finite State Machine Engine runs the chain of state machines in the background as a background task. It had the word FSM to initialize the background machine chain and link it into the loop of round robin tasks.

Code: Select all

: FSM  ( -- )
   [ ' <FSM> >BODY ] LITERAL
   BACKGROUND-MACHINE-CHAIN ACTIVATE
   BACKGROUND-MACHINE-CHAIN LINK-TASK
   MULTI ;

This word could not be executed more than once or the task for the background machine chain would be linked more than once, breaking the loop. I saw this as a design flaw in Fleet Forth's multitasker so I fixed it.
I added the word LINKED? to test if a task is already linked. Rather than burden the user with testing if a task is linked, I added this word to LINK-TASK , the word which links tasks. If a task is already linked, LINK-TASK does not try to link it again. It is idempotent.

Code: Select all

: LINKED?  ( TADR -- FLAG )
   ENTRY
   BEGIN
      @ DUP 2PICK <>
   WHILE
      DUP ENTRY =
   UNTIL
      0=
   THEN
   0<>  NIP ;

: LINK-TASK  ( TADR -- )
   DUP LINKED?
   IF  DROP EXIT  THEN
   ENTRY 2DUP @ SWAP! ! ;

[JimBoyd]

JimBoyd wrote:

Here is DOWN-COUNTER for Fleet Forth.

Code: Select all

: DOWN-COUNTER
   2VARIABLE  ( -- )
   DOES>  ( -- ADR )
      JIFFY@ DROP
      OVER 2+ @
      OVER -  0 MIN
      2PICK +!
      OVER 2+ ! ;

That '0 MIN' is to handle the case when the jiffy timer resets to zero when it reaches twenty four hours.
A down-counter, a child word of DOWN-COUNTER , has two cells of storage. The first cell holds a value. The second cell holds the low cell of the Commodore 64 jiffy clock from the last time the down-counter was executed. Each time a down-counter is executed the amount of time, in jiffies, which passed from the last time is subtracted from the value in the first cell.

Code: Select all

DOWN-COUNTER DELAY1 OK
300 DELAY1 ! OK
DELAY1 ? 209  OK
DELAY1 ? 118  OK
DELAY1 ? 5  OK
DELAY1 ? -445  OK

Of course, the values returned each time I type "DELAY1 ?" depends on how long I wait.

Here is a slightly improved version of DOWN-COUNTER .

Code: Select all

: DOWN-COUNTER
   2VARIABLE  ( ++ )
   DOES>  ( -- ADR )
      JIFFY@ DROP           \ Only need low cell of jiffy clock
      OVER 2@ SWAP 2PICK -  \ new.time value -delta.time
      0 MIN                 \ Compensate for reset at midnight.
      +  2PICK 2! ;         \ add negative time difference to
                            \ old value and store new time
                            \ and new value to down-counter
                            \ variable and leave address.

JIFFY@ leaves the value of the Commodore 64 jiffy clock on the stack as a double number. Yes the jiffy clock resets to zero after twenty four hours.
2PICK is syntactically equivalent to 2 PICK .

Code: Select all

CODE 2PICK  ( N1 N2 N3 -- N1 N2 N3 N1 )
   4 ,X LDA  5 ,X LDY
   AYPUSH JMP  END-CODE

A DOWN-COUNTER is used when some code is run periodically, but there is a portion which must be run less often.

Code: Select all

DOWN-COUNTER DELAY

     .
     .
     .
   DOWN-COUNTER @ 0<          \
   IF                         \ If this code fragment is run often enough
      #3600 DOWN-COUNTER !    \ <DO.SOMETHING> only runs
      <DO.SOMETHING>          \ once a minute.
   THEN                       \
     .
     .
     .

[JimBoyd]

Fleet Forth is not a multi user Forth system. It was designed for one person to use at a time on a Commodore 64. Fleet Forth supports multitasking with background tasks. With this in mind the Fleet Forth system has only ten user variables. More user variables can be added.
The user area for the foreground task is not part of the loadable image, it is in a section of unused memory on the Commodore 64; therefore, the first eight user variables need initialized at bootup. Fleet Forth's boot area holds the bootup values for the first seven user variables.

Code: Select all

ENTRY  -- Points to next task's user area or itself if no other tasks.
READY  -- Flag. TRUE - task is awake. FALSE - task is asleep.
TOS    -- Holds the return stack pointer when a task is switched out.
RP0    -- Base of return stack.
SP0    -- Base of data stack.
AP0    -- Base of auxiliary stack.
DP     -- Dictionary Pointer.

The first six user variables are initialized by the word UNLINK , which also sets the user pointer UP to the address of the foreground task's user area. This unlinks all background tasks and restores control to the main task. UNLINK is included in a routine included in the coldstart and warmstart routines.
The word EMPTY initializes DP from this bootup area and branches into the body of FORGET to handle any necessary pruning. EMPTY is included in the coldstart routine.
These are the next three user variables:

Code: Select all

BASE   -- Base for numeric conversion to or from text.
DPL    -- Decimal place.
HLD    -- Holds the address for the next character during conversion
          from text to a double number.

DECIMAL , which sets BASE to decimal, is included in the routine which is included in the coldstart and warmstart routines.

DPL and HLD are not initialized during coldstart or warmstart. It is not required. NUMBER? initializes DPL and <# initializes HLD .
The Fleet Forth system has only ten user variables. The other variables in the system are not user variables as they should not be needed in background tasks.

As I mentioned, Fleet Forth allows the defining of new user variables. The word for this is USER . It takes a number and is followed by a name.

Code: Select all

<USER.AREA.OFFSET> USER <NAME.OF.USER.VARIABLE>

For example:

Code: Select all

#20 USER STOOGES

To make defining new user variables easier (some may be defined in different sources), Fleet Forth has a 'system value' or 'soft constant' #USER .
The source for Fleet Forth's USER .

Code: Select all

: USER  ( N -- )
   DUP 2+ #USER UMAX (IS) #USER
   CREATE C,
   ;CODE  ( -- N )
      2 # LDY  CLC
      W )Y LDA  UP ADC
      UP 1+ LDY  CS IF  INY  THEN
      AYPUSH JMP  END-CODE

If #USER has the value #20, the following:

Code: Select all

#USER USER LARRY
#USER USER CURLY
#USER USER MOE

will create the user variable LARRY with the user area offset #20, the user variable CURLY with the user area offset #22, and the user variable MOE with the user area offset #24.
To set aside more of the user area for a particular user variable, the following can be done.

Code: Select all

#USER USER LAUREL
#USER 8 + USER HARDY

This will 'allot' eight more bytes in the user area for the user variable LAUREL .

[JimBoyd]

JimBoyd wrote:

I've just streamlined DJIFFIES , the word that takes a positive double number and waits that many jiffies ( 1/60th of a second on the Commodore 64 ) . It is also used by JIFFIES , the word that takes an unsigned single number and waits that many jiffies.
DJIFFIES works by keeping the number of jiffies to delay on the stack as well as the latest jiffy clock value. Each time through the loop, it subtracts the difference from the amount of time to wait. The idea came from DOWN-COUNTER on page 130 ( 140 of the PDF ) in the book Real Time Forth by Tim Hendtlass.
When I was testing my multitasker, I noticed that the loop in DJIFFIES runs several times per jiffy. With three background tasks, two using DJIFFIES ( actually JIFFIES ) for a delay and one counting how many times it runs, the entire round robin runs several times a jiffy. I realized that when the difference between the current jiffy clock value and the previous one is subtracted from the amount of time to delay, either 0 or -1 is added to the remaining time. I only needed to use the lower cell of the jiffy clock value. Here is the code:

Code: Select all

SCR# 41 
// DJIFFIES
HEX
// TAKES POSITIVE DOUBLE NUMBER
// AND DELAYS THAT MANY JIFFIES
: DJIFFIES  ( D+ -- )
   JIFFY@ DROP
   BEGIN
      PAUSE
      JIFFY@ DROP  DUP>R -
// COMPENSATE FOR RESET AT 24 HOURS
      0 MIN
      S>D D+  R> OVER 0<
   UNTIL
   DROP 2DROP ;

SCR# 42 
// JIFFIES
HEX
: JIFFIES  ( U -- )
   0 DJIFFIES ;

JIFFIES takes an unsigned number and has a maximum delay of:
18 minutes 12 seconds and 15 jiffies.
DJIFFIES takes a positive double number and has a maximum delay of:
414 days 6 hours 3 minutes 14 seconds and 7 jiffies or
2,147,483,647 jiffies.

Because DJIFFIES waits until the count goes negative, DJIFFIES and JIFFIES wait one jiffy more than what is requested. Not a big problem. There is an easy solution. Just subtract one from the initial value returned by JIFFY@ DROP .

Code: Select all

// DJIFFIES JIFFIES
// TAKES POSITIVE DOUBLE NUMBER
// AND DELAYS THAT MANY JIFFIES
: DJIFFIES  ( D+ -- )
   JIFFY@ DROP 1-
   BEGIN
      PAUSE
      JIFFY@ DROP  DUP>R -
      // COMPENSATE FOR DAILY RESET
      0 MIN
      S>D D+  R> OVER 0<
   UNTIL
   DROP 2DROP ;
: JIFFIES  ( U -- )
   0 DJIFFIES ;

Now DJIFFIES and JIFFIES will wait the requested number of jiffies.
Note: // (double forward slash) is a Commodore 64 Forth alias for \ (backslash) .

[JimBoyd]

In a previous post I showed the source for Fleet Forth's word USER , the word to create new user variables. I also mentioned #USER. The only user variables I've ever defined other than the ones defined in the kernel are the three user variables used for multitasking. They have the offsets 0, 2, and 4.

Code: Select all

0 USER ENTRY   2 USER READY
4 USER TOS

Other than these three, I have never defined new user variables; therefore, I simplified the source for USER and removed #USER from Fleet Forth's kernel.

Code: Select all

: USER  ( N ++ )
   CREATE
      C,
   ;CODE  ( -- ADR )
      2 # LDY  CLC
      W )Y LDA  UP ADC
      UP 1+ LDY  CS IF  INY  THEN
      AYPUSH JMP  END-CODE

I also had to change the source for the multitasker's task creation word TASK .

Code: Select all

// TASK CREATION AND ACTIVATION
: TASK  ( U AP0 SP0 RP0 -- )
   CREATE
        ( -- TADR )
      HERE RP0 LOCAL !
      HERE SP0 LOCAL !
      HERE AP0 LOCAL !
      [ ' STOP >BODY ] LITERAL
      HERE ACTIVATE
      // OPTIONAL
      #10 HERE BASE LOCAL !
      [ 0 HLD LOCAL 2+ ] LITERAL
      HERE +  HERE DP LOCAL !
      #12 UMAX ALLOT ;

Note that HLD is the last user variable defined in the kernel. It has an offset of eighteen. The line

Code: Select all

      [ 0 HLD LOCAL 2+ ] LITERAL

compiles a literal decimal twenty. Since there are a total of ten user variables, this points the task's DP just past the area used by the last user variable. Setting a task's DP to point twenty bytes into a task's user area is done so data stored at a background task's HERE will not overwrite any of the task's user variables.

[JimBoyd]

JimBoyd wrote:

Here is my find and replace function.

Code: Select all

: FR
   BEGIN F R AGAIN ; -2 ALLOT

There was one flaw in the editor word FR . As I mentioned, FR can be used to find all occurrences of a given string in a screen and replace them.

Code: Select all

FR HEX^DECIMAL

and used in another screen without specifying the strings to perform the same search and replace.

Code: Select all

FR

When the editor word F searches for a string, it first parses the text stream for a search string delimited by the caret character to place in the find buffer. If the text stream is exhausted, the old search string remains in the find buffer. Whatever string is in the find buffer is used for the search. Likewise, the editor word I , which is used by R , parses the text stream for a string to insert and places this string in the insert buffer.
If the search string was not found when FR was used with the search and replacement strings specified, the replacement string was never placed in the insert buffer. When FR was then used without specifying the search and replace strings, the string to be found would be replaced with garbage (whatever was in the insert buffer).
The following improvement to FR places the search string in the find buffer and the replacement string in the insert buffer before the first search attempt.

Code: Select all

: FR
   >FBUF  >IBUF
   BEGIN  F R  AGAIN -;

>FBUF and >IBUF are the words which parse the text stream and place a string in the find buffer and insert buffer respectively.
With this modification, I no longer have a problem with FR .

Quote:

Unlike S , F ( find) and R ( replace) are limited to one screen at a time. If F can't find the string it aborts. I'm changing that to QUIT so it will not clear the data and auxiliary stacks.

I made that change.

[JimBoyd]

Fleet Forth is an ITC Forth for the Commodore 64 and has to compensate for the indirect jump bug; therefore, when I mentioned defining multi code field words with Fleet Forth, I mentioned a word named CFA-ALIGN to make sure the other CFA's of a multi code field word don't straddle a page boundary by forcing an even address alignment for these CFA's by adding a pad byte before the header is created. The need to define CFA-ALIGN whenever I wished to experiment with adding an extra Code field or two contributed to my reluctance to add extra code fields.
This will no longer be a problem. Fleet Forth's CREATE would compute the address of the yet to be created word's code field. If the code field would start on an address ending in $FF, it would allot a byte before creating the header. This test in CREATE has been modified so that if the CFA would start on an address ending in $FF, $FD, $FB, $F9 or $F7 CREATE will allot a byte before the header is created.
Removing the out of memory check from the code below for clarity, the old test was something like this:
Compute the address of the code field.

Code: Select all

   HERE COUNT + 2+  VIEW @ TUCK
   IF  2+  THEN

and allot one byte if it ends with $FF.

Code: Select all

   1+ SPLIT DROP
   0= ABS ALLOT

The code to compute the address of the code field is unchanged.

Code: Select all

   HERE COUNT + 2+  VIEW @ TUCK
   IF  2+  THEN

but the test is now this.

Code: Select all

   DUP 9 + SPLIT DROP
   9 U< AND  2 MOD ALLOT

This change only added twelve bytes to CREATE . Fleet Forth can now support words with up to five code fields without the need to perform any address check other than what CREATE now does.

I think three code fields are typical with multi code field words. Supporting five gives a little extra just in case.

There is one other case where the improved CREATE is helpful. When modifying Blazin' Forth's utilities for Fleet Forth, it was necessary to test the body of the variable SYSIRQ for page crossing.

Code: Select all

HEX
// BUG FIX
" SYSIRQ" C@ HERE + 1+
2+ 2+         // SIZE OF LINK
              // & CODE FIELDS
SPLIT DROP 0FF = // WILL PFA BE ON
              // PAGE BOUNDARY?
ABS ALLOT     // IF SO BUMP IT PAST
VARIABLE SYSIRQ

The variable SYSIRQ is used to hold the address of the last part of the Commodore 64's interrupt service routine which is vectored through address $314. Blazin' Forth's interrupt service routine jumps to the Commodore 64's routine by indirectly jumping through the parameter field of the variable SYSIRQ . If this address straddles a page boundary, the indirect jump bug strikes.
With Fleet Forth's new CREATE , the test before defining SYSIRQ is no longer needed.

[GARTHWILSON]

I lay the name field down first, and then do ALIGN which makes sure the LFA, CFA, and PFA are aligned.  It probably makes L>NAME a little more complex, but I allow characters above $7F anyway for the special characters in the DOS/ANSI (code page 437) characters, and it makes CREATE a little simpler.

[JimBoyd]

If roughly half the words would have a code field on an odd address then those half would need an extra byte. On a system with lots of words, that's a lot of bytes.
The fields of a word in Fleet Forth are in the following order: Link field, Name field, Code field and Parameter Field. A word's link field points to the previous word's link field.

[GARTHWILSON]

Since the last-compiled word tends to be an unnest (compiled by ;) and word-aligned, the beginning of my name fields is almost always aligned; so in that case, there are many cases when I know I can add another letter to the name if I want to, if it would make it more descriptive, without any memory penalty.

[JimBoyd]

In Fleet Forth nothing is word aligned. The only address adjustment is to make sure a page boundary is not straddled by the code field, and now the next four cells, of a word. I've not had any problems in Fleet Forth due to this lack of alignment.

[JimBoyd]

JimBoyd wrote:

I've removed the words <LIST <L LIST> L> and their editor words 0[ through F[ and 0] through F] because they were unsatisfactory.
I also mentioned a solution which seems satisfactory.
A new LIST word which use an editing window VALUE for a displacement to the right, EW , and a corresponding set of editing words 0[ through F[ which also use EW.

I must admit I have not been using this new Fleet Forth screen editor.
When I was trying to figure out how to implement the IsoPod's finite state machine engine, I was writing ideas in a regular text file on my computer. When I had something which seemed to be going in the right direction, I copied and pasted it into VICE, the Commodore 64 simulator rather than copy it to screens on blocks. I have since then gotten into the habit of just pasting code I want to test into the simulator and using plain text files for source. The simulator treats pasted text as if it is being typed in at the keyboard, which is why I wrote PURGE .
It seems for big things, like the source for Fleet Forth or the system loader and utilities, I still use screens in blocks (the simulator can not handle having the entire source for Fleet Forth's kernel pasted in at one time). For small projects I have been using text files.
The backslashes in the source for the Finite State Machine Engine in Forth were not added just for posting the source. A backslash pasted into VICE appears as the pound character so I defined a word with the backslash character as the name. This word is an alias for Fleet Forth's double forward slash ( // ).

[JimBoyd]

I've already mentioned Fleet Forth's TRACE , which was inspired by Blazin' Forth's TRACE .
As I mentioned, while tracing a word the Commodore key and 'P' key can be pressed to allow pausing the trace and interpreting commands. I previously stated that it was the Control key and the 'P' key. This was because VICE maps the Commodore key to my computer's left Control key. The Run/Stop key is mapped to my computer's escape key. Tracing resumes when the word CONT is typed. This is useful to examine the value of variables or other memory areas. An immediate word can also be traced even when that word is used while compiling. Pausing the trace to execute commands will not work when STATE is compiling. Open bracket ( [ ) would need typed first. In this instance the following would need to be typed to resume tracing.

Code: Select all

CONT ]

However, ] should only be typed after CONT to resume tracing when STATE is compiling.
I've made an improvement to TRACE to eliminate the need to alter STATE when pausing a trace to enter commands. STEP now saves the value of STATE , along with the value of HLD to the return stack near the beginning of STEP . STATE and HLD are restored near the end of STEP . If the trace is paused to enter commands, state is set to interpreting to allow executing commands rather than have the commands compiled.
After executing a command while tracing, the system does not respond with 'OK'. It responds with 'OKAY' so it is obvious that a trace is suspended.
TRACE and WATCH are now more efficient as well.
TRACE is used like this.

Code: Select all

TRACE <SOMEWORD>

Nothing happens initially. When <SOMEWORD> executes, it is traced.
WATCH is used like this.

Code: Select all

ADDRESS WATCH

If the value at the two consecutive memory locations at address change, the system will abort with the message 'WATCHED MEMORY ALTERED'.
This is the complete source for the new TRACE and WATCH .

Code: Select all

VARIABLE <IP
VARIABLE IP>
CODE >NEXT ( ADR -- )
   // POINTS NEXT TO ADR
   $4C # LDA  NEXT 2+ STA
   0 ,X LDA  NEXT 3 + STA
   1 ,X LDA  NEXT 4 + STA
   POP JMP  END-CODE
: +PAD
   $FF ?MEM
   [ ' PAD >BODY 4 + ] LITERAL C! ;
: -PAD
   $55
   BRANCH [ ' +PAD >BODY 5 + , ] -;

VARIABLE CON
: CONT   CON ON ;
: NOTRACE
   NEXT>  -PAD
   ." TRACING OFF"  QUIT -;
DEFER .STEP
: (.ST1)  ( IP -- )
   @ .NAME TAB .S ;
' (.ST1) IS .STEP
: (.ST2)  ( IP -- )
   (.ST1)  CR TAB .AS ;
: (.ST3)  ( IP -- )
   (.ST2)  RP0 @ RP@ 2+ 2+
   BRANCH [ ' .RS >BODY 6 + , ] -;

SUBR STEP
   <IP LDA  IP CMP
   <IP 1+ LDA  IP 1+ SBC
   CS NOT IF
      IP> LDA  IP CMP
      IP> 1+ LDA  IP 1+ SBC
      CS IF
         >FORTH
         NEXT>
         R@ HLD @ STATE @ 2>R +PAD
         CR .STEP
         KEY DUP ASCII" {RUN/STOP}" =
         IF  DROP NOTRACE  THEN
         ASCII" {COMMODORE P}" =
         IF
            CON OFF  [COMPILE] [
            BEGIN
               QUERY INTERPRET
               STATE @ 0=
               IF  ."  OKAY" THEN
               CON @
            UNTIL
         THEN
         -PAD  2R> STATE ! HLD !
         RECURSE >NEXT
         >ASSEM
         INY
      THEN
   THEN
   HERE >A         \ Save this address on the Aux stack.
   IP )Y LDA  W 1+ STA
   NEXT 6 + JMP
END-CODE

: TRACE  ( ++ )
   NEXT>
   ' AFIND NIP  IP> ! <IP !
   STEP >NEXT ;

VARIABLE EYE
SUBR LOOK
   TRUE LDA EYE CMP
   0= IF
      TRUE LDA EYE 1+ CMP
      A> 0= BRAN   \ Branch to the address saved on Aux stack.
   THEN
   INY                        \ Restore NEXT.
   BEGIN                      \ 
      NEXT 7 + ,Y LDA         \
      NEXT 2+ ,Y STA  DEY     \
   0< UNTIL                   \
   >FORTH
   .RS  TRUE
   ABORT" WATCHED MEMORY ALTERED" -;

: WATCH ( ADR -- )
   DUP @ EYE !
   // PATCH LOOK
   DUP LOOK 1+ !
   1+ LOOK 9 + !
   LOOK >NEXT ;

NEXT> the word to restore NEXT is in Fleet Forth's kernel.

Code: Select all

   LABEL NEXT
   1 # LDY
   LABEL NEXT1
   IP )Y LDA  W 1+ STA  DEY
   LABEL NEXT2
   IP )Y LDA  W STA
   1 # LDA
   SEC  IP ADC  IP STA
   CS NOT IF
      W 1- JMP
   THEN
   IP 1+ INC
   W 1- JMP  END-CODE

CODE NEXT>  ( -- )  // RESTORE NEXT
   2 # LDY
   BEGIN
      NEXT2 ,Y LDA
      NEXT1 ,Y STA   DEY
   0< UNTIL
   NEXT JMP  END-CODE

The word AFIND is defined in Fleet Forth's system loader.

Code: Select all

CODE (AFIND)  ( ADR VOC -- LFA2 LFA1 )
   DEY  N 1+ STY
   BEGIN
      0 X) LDA  PHA  0 ,X INC
      0= IF  1 ,X INC  THEN
      0 X) LDA  1 ,X STA
      PLA  0 ,X STA
      2 ,X LDA  0 ,X CMP
      3 ,X LDA  1 ,X SBC
   CS NOT WHILE
      0 ,X LDA  N    STA
      1 ,X LDA  N 1+ STA
   REPEAT
   N LDA  2 ,X STA  N 1+ LDA  3 ,X STA
   NEXT JMP  END-CODE

: AFIND  ( ADR -- ADR LFA1 LFA2 )
   HERE 0 2>R  VOC-LINK @
   BEGIN
      2DUP 2- 2-
      (AFIND)
      R> UMAX SWAP R> UMIN >R >R
      @ ?DUP 0=
   UNTIL
   R> R> ;