Fleet Forth design considerations

[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> ;

[JimBoyd]

Fleet Forth had a word named TEXT= . This was a nonstandard primitive which took an address of a string, a count, and an address of a second string. It returned TRUE if the two strings were equal, otherwise it returned FALSE.

Code: Select all

CODE TEXT=  ( ADR1 +N ADR2 -- F )
   HERE 1+
   $BAD JSR
   0= NOT IF
      ' FALSE @ JMP
   THEN
   ' TRUE @ JMP
   HERE SWAP!
   3 # LDA  SETUP JSR
   BEGIN
      BEGIN
         N 2+ LDA  N 3 + ORA
      0= NOT WHILE
         N 4 + )Y LDA  N )Y CMP
         0= NOT IF
            RTS
         THEN
         N 2+ LDA
         0= IF  N 3 + DEC  THEN
         N 2+ DEC
         INY
      0= UNTIL  CS-SWAP
      N 5 + INC  N 1+ INC
   REPEAT
   RTS  END-CODE

The definition looks a little odd because I wrote it so I could reuse the subroutine portion of TEXT= to define -TEXT , a word from the Uncontrolled Reference Words in the Forth-83 Standard.
I decided to replace TEXT= with -TEXT .

Code: Select all

CODE -TEXT  ( ADR1 +N ADR2 -- F )
   3 # LDA  SETUP JSR
   BEGIN
      BEGIN
         N 2+ LDA  N 3 + ORA
      0= NOT WHILE
         N 4 + )Y LDA  N )Y CMP
         0= NOT IF
            CS IF
               ' 1 @ JMP
            THEN
            ' TRUE @ JMP
         THEN
         N 2+ LDA
         0= IF  N 3 + DEC  THEN
         N 2+ DEC
         INY
      0= UNTIL  CS-SWAP
      N 5 + INC  N 1+ INC
   REPEAT
   ' FALSE @ JMP
   END-CODE

This version of -TEXT takes an address of a string, a length, and an address of another string. It returns FALSE if the strings are equal. If the strings are not equal it returns TRUE if the first non matching character in the first string has a lower PETSCII (Commodore's version of ASCII) value than the first non matching character in the second string, otherwise it returns ONE . This is a little different from the Standard.

Code: Select all

 -TEXT        addr1 +n1 addr2 -- n2                   "dash-text"
      Compare two strings over the length +n1 beginning at addr1
      and addr2.  Return zero if the strings are equal.  If
      unequal, return n2, the difference between the last
      characters compared:  addr1(i) - addr2(i).

The use of -TEXT will require changes to the source in five places in the system loader.

[GARTHWILSON]

JimBoyd wrote:

Fleet Forth had a word named TEXT= . This was a nonstandard primitive which took an address of a string, a count, and an address of a second string. It returned TRUE if the two strings were equal, otherwise it returned FALSE.

On the HP-71 where I started in Forth, it's called S= .

[JimBoyd]

Replacing TEXT= with -TEXT only affected three words in Fleet Forth's system loader: MATCH , the nameless word used by COMMENT: , and the nameless word used by [ELSE] .

MATCH is Fleet Forth's word to find a search string within a larger string. I will refer to this larger string as a buffer. The parameters for MATCH are: The address and length of the buffer and the address and length of the search string. If the search string is not found, MATCH returns the length of the buffer and FALSE . If the search string is found, MATCH returns the offset into the buffer one byte past where the last matching character is found and TRUE .

Replacing TEXT= with -TEXT 0= made MATCH take about ten percent longer. This version of MATCH also has two problems. It uses a ?DO LOOP written to loop through every address in the buffer. The first problem with this approach is when a possible match is found. The offset needs tested against the length of the buffer to insure a match is not found which extends past the buffer. Although this is not a serious problem, more of a nuisance, it seems inelegant.
The other problem is more serious. Because the loop works through all the addresses in the buffer, if a match is not found as the loop index nears the end of the buffer, -TEXT ( and originally TEXT= ) will read past the buffer. If the buffer in question is adjacent to a section of I/O, the devices mapped to that address will be inadvertently read. On the Commodore 64 this does not seem to be a big problem as the first addresses in the I/O section return the coordinates of video sprites; nonetheless, I/O should not be read unintentionally. The source below is for an improved MATCH which does not read past the search buffer. It does require the buffer length to be a signed positive number. The size of this version, not counting the code field, is fifty eight (58) bytes.

Code: Select all

: MATCH  ( ADR1 LEN1 ADR2 LEN2 -- OFFSET FLAG )
   2OVER  2PICK - 1+ 0 MAX BOUNDS  \ Limit the search range to the buffer length
   ?DO                             \ plus one minus the search string length
      2DUP I -TEXT 0=              \ test if address I holds search string
      IF                           \ if so
         I 2NIP + SWAP - TRUE      \ add address I to search string length and
                                   \ subtract buffer address to obtain offset
                                   \ discarding other parameters. Place TRUE on
                                   \ data stack.
         UNLOOP EXIT               \ discard loop parameters and exit.
      THEN
   LOOP
   2DROP NIP FALSE ;               \ Drop all parameters save the buffer length
                                   \ and place FALSE on data stack.

The following version works with unsigned lengths. The size of this version is sixty six (66) bytes.

Code: Select all

: MATCH  ( ADR1 LEN1 ADR2 LEN2 -- OFFSET FLAG )
   2PICK OVER U< 0=                \ If buffer is big enough to contain     
   IF                              \ the search string 
      2OVER  2PICK - 1+ BOUNDS     \ Limit the search range to the buffer length
      ?DO                          \ plus one minus the search string length
         2DUP I -TEXT 0=           \ test if address I holds search string
         IF                        \ if so
            I 2NIP + SWAP - TRUE   \ add address I to search string length and
                                   \ subtract buffer address to obtain offset
                                   \ discarding other parameters. Place TRUE on
                                   \ data stack.
            UNLOOP EXIT            \ discard loop parameters and exit.
         THEN
      LOOP
   THEN
   2DROP NIP FALSE ;               \ Drop all parameters save the buffer length
                                   \ and place FALSE on data stack.

With a buffer size of one kilobyte, both of these versions take about the same amount of time as the original using -TEXT . All take ten percent longer than the original using TEXT= because of the extra primitive ( 0= ).
As long as -TEXT does not find a match, the following primitives are executed in the loop.

Code: Select all

2DUP I -TEXT 0= ?BRANCH LOOP

Since both of these versions eliminate reading past the end of the buffer, they both eliminate the need to test a match to eliminate false positives.
And yet there is a better version.
By not using a ?DO LOOP, the following version of MATCH is about an order of magnitude faster. Its size is sixty four (64) bytes.

Code: Select all

: MATCH  ( ADR1 LEN1 ADR2 LEN2 -- OFFSET FLAG )
   2OVER                      \ Preserve copy of original buffer length
   BEGIN
      2PICK OVER SWAP U<      \ Is remaining buffer too small to hold string?
      IF                      \ If so
         D= ROT DROP  EXIT    \ convert top four numbers to FALSE, discard
      THEN                    \ buffer address and exit.
      2OVER 2OVER DROP -TEXT  \ Test for a match. FALSE = match.
   WHILE                      \ While no match
      1 /STRING               \ reduce buffer size by one
      3 PICK C@ SCAN          \ Scan for first character of search string
   REPEAT
   ROT 2NIP - - NIP TRUE ;    \ subtract search string length from remaining
                              \ buffer size then subtract that from original
                              \ buffer size to obtain offset. Discard the
                              \ three addresses.

A copy of the original buffer address and length is made with 2OVER . As long as the search string is not found, this copy is reduced by incrementing its address and decrementing its length.

At the start of the BEGIN loop, the size of the buffer is compared to the size of the search string. If the buffer is too small, the search failed. The buffer address and length will not be equal to the search string address and length (the buffer is smaller than the search string) so D= converts these four numbers to FALSE. The original address of the buffer is rotated to the top of the stack and dropped. MATCH exits with the original buffer size and FALSE on the stack.

If the buffer is not too small, the search string address and length as well as the buffer address are copied to the top of the data stack. -TEXT consumes all three of its parameters and returns a FALSE flag if there is a match.
If the search string is not found, the buffer size is reduced by one byte with /STRING . This is an Ans Forth word I've found useful.

SCAN is a Fleet Forth primitive which is used by WORD and 'TEXT . It scans for a character within a buffer (or string) SCAN takes the address of a buffer, its length and a character. If the character is not found in the buffer, SCAN returns the address just past the buffer and a length of zero. If the character is found, SCAN returns the address in the buffer where the character is found and the remaining length of the buffer.

MATCH copies the address of the search string to the top of the stack and fetches the first character of the search string for use by SCAN. SCAN might not change the buffer size which is why /STRING is used to reduce its size after -TEXT and before SCAN .

If the search string was found by -TEXT , the loop exits. The search string length is subtracted from the remaining buffer size, this is subtracted from the original buffer size. The three addresses are discarded. TRUE is placed on the stack and MATCH exits with the offset to just past the search string and TRUE on the data stack.
At first glance, it looks like this version would be slow; however, the use of SCAN to scan ahead reduces the number of high level loop iterations, resulting in MATCH taking about one tenth the time. I've seen it take closer to one thirteenth the time.
There is one case where this version is much slower, but that is a case not likely to be seen in practice.
For example:

Code: Select all

100 BLOCK B/BUF ASCII L FILL
100 BLOCK B/BUF " LOOP" COUNT MATCH

With a one kilobyte buffer filled with the character 'L' and a search for any word which begins with 'L', this version of MATCH takes about 2.4 times as long as the other versions.
Edit: accidentally omitted B/BUF in that last example with MATCH .

[JimBoyd]

To put things in perspective, Fleet Forth's new MATCH was used to find DECIMAL in the following screen from Blazin' Forth's system loader.

Code: Select all

( I/O EXTENSIONS PADDLE PADDLE BUTTON                SDBJUN85 )
HEX
CODE PADDLE   SEI, DC02 LDA, PHA, 0C0 # LDA, DC02 STA,
     BOT LDA, .A LSR, 80 # LDA, TAY, CS IF, .A LSR, THEN,
     DC00 STA, BEGIN, NOP, DEY, 0< UNTIL,
     BOT LDA, 1 # EOR, TAY, D419 ,Y LDA,
     BOT STA, PLA, DC02 STA, CLI, NEXT JMP, END-CODE
CODE PADDLEBUTTON  BOT LDA, 2 # CMP, CS
     IF, DC01 LDA, ELSE, DC00 LDA, THEN, PHA,
     BOT LDA, .A LSR, PLA, CS IF, 8 # AND, ELSE, 4 # AND, THEN,
     0= IF, DEY, THEN, TYA, PHA, PUT JMP, END-CODE
DECIMAL

To obtain more acurate timing data, MATCH was run in a test word to get it to run the same match one thousand times. The times were on a Commodore 64 simulation running at 1 MHz.

Code: Select all

: TIMEIT
   ' 0 0 JIFFY!  EXECUTE  JIFFY@ CR D. ;
DEFER TESTWORD
: TESTIT
   0
   DO
      TESTWORD
   LOOP ;

On the Commodore 64 sixty (60) jiffies are in one second.
Running the following testword took 36 jiffies.

Code: Select all

: TEST
   2OVER 2OVER
   2DROP
   2DROP ;
' TEST IS TESTWORD
17 BLOCK B/BUF " DECIMAL" COUNT
1000 TIMEIT TESTIT
2DROP 2DROP

Running MATCHTEST took 5867 jiffies.

Code: Select all

: MATCHTEST
   2OVER 2OVER MATCH 2DROP ;
' MATCHTEST IS TESTWORD
17 BLOCK B/BUF " DECIMAL" COUNT
1000 TIMEIT TESTIT
2DROP 2DROP

Subtracting the overhead of duplicating parameters and dropping results, running MATCH 1000 times took around 5831 jiffies or about 0.0972 seconds to run once to find DECIMAL in this dense screen of Blazin' Forth system loader source.
MATCH took closer to 0.04185 seconds to find MAL in that same screen.

[JimBoyd]

The Commodore 64 kernal routine CHRIN is called in a loop to return one character at a time. This routine is the Commodore 64's screen editor so it does not return any characters until after it receives a carriage return. So that the Commodore's screen editor could be used by Fleet Forth while still allowing multitasking and avoid "stuffing" a carriage return into the keyboard buffer (which introduces problems of its own), Fleet Forth's (KEY) , the vector for the deferred word KEY , was split into two parts.

Code: Select all

NH CODE WKEY  ( -- )
   BLINK.ENABLE STY
   >FORTH
      BEGIN  PAUSE #KBD C@  UNTIL
   >ASSEM   // LEAVES Y-REG=0
   INY  BLINK.TIMER STY
   BEGIN
      BLINK.ON? LDA
   0= UNTIL
   BLINK.ENABLE STY
   NEXT JMP  END-CODE

CODE ?KEY  ( -- C )
   XSAVE STX
   $FFE4 JSR  // GETIN
   XSAVE LDX
   APUSH JMP  END-CODE

: (KEY)  ( -- C )
   WKEY  ?KEY ;

' (KEY) IS KEY

NH is a metacompiler word used to switch off header creation.
(EXPECT) , the vector for the deferred word EXPECT , uses both halves of (KEY) , WKEY and ?KEY . WKEY switches on cursor blinking and waits in a loop for a key press, but does not read and remove a character from the keyboard buffer. It also executes the task switcher, PAUSE , while in the loop.
After there is a character available in the keyboard buffer, (EXPECT) checks if the character is a carriage return. If it is not, (EXPECT) uses ?KEY to get the character from the buffer. (EXPECT) echoes the character to the screen. If the character is a carriage return, (EXPECT) shifts to low level and uses the Commodore 64 kernal routine CHRIN to read the characters from the line on the screen and return them one character at a time with each call to CHRIN .
When I wanted to add a the ability to intercept function keys, to support an experimental editor, that capability was added directly to (EXPECT) because it used the components of (KEY) but did not use KEY .
KEY was not used to avoid additional delay in reading keys from the keyboard buffer.
A slight modification to the headerless word WKEY overcomes this problem.

Code: Select all

NH CODE WKEY  ( -- )
   #KBD LDA
   0= IF
      BLINK.ENABLE STY
      >FORTH
         BEGIN  PAUSE #KBD C@  UNTIL
      >ASSEM   // LEAVES Y-REG=0
      INY  BLINK.TIMER STY
      BEGIN
         BLINK.ON? LDA
      0= UNTIL
      BLINK.ENABLE STY
   THEN
   NEXT JMP  END-CODE

Now if a character is in the keyboard buffer, WKEY branches directly to the jump to NEXT . Enabling cursor blinking or pausing for another task is only done if the keyboard buffer is empty. With this improvement there is no real penalty when following WKEY with KEY rather than ?KEY ; therefore, ?KEY was replaced with KEY in (EXPECT) .
Since KEY is a deferred word, it can be set to a version of (KEY) capable of intercepting function keys. Since (EXPECT) now uses KEY , Function key interception can take place in (EXPECT) through KEY ; therefore, that functionality was removed from Fleet Forth's (EXPECT) .

Here is one possible way of implementing that functionality.

Code: Select all

: FKEY  ( -- CHAR )
   BEGIN
      (KEY)
      7 OVER #133 - U< ?EXIT
      #63 +  4 /MOD SWAP 2* +
      " F0KEY" TUCK 2+ C!
      FIND
      IF  DUP EXECUTE  THEN
      DROP
   AGAIN ;

' FKEY IS KEY

Since KEY is supposed to return a key press even if it is intercepting function keys, FKEY is in a loop until a non-function key is received.
Here is a trivial test case.

Code: Select all

CODE BORDER?  ( -- CHAR )
   $D020 LDA  $F # AND
   AYPUSH JMP
   END-CODE

: F1KEY  ( -- )  BORDER? 1+ BORDER ;
: F2KEY  ( -- )  BORDER? 1- BORDER ;

BORDER is a Fleet Forth word which takes a number and sets the border color on the Commodore 64.

Keep in mind that removing this functionality from (EXPECT) means that it doesn't have to exist at all! It can be added later, through a new vector for the deferred word KEY *IF* and only if the functionality is actually desired.