Jump to content
IGNORED

Camel99 Forth Information goes here


TheBF

Recommended Posts

DATA Structures in Forth 2012 Standard

 

Forth has a new "standard" under-development but it will not use the ANS/ISO processes as was done in 1994. Getting Forth programmers to agree on something in a language that has no syntax ( ? ) is like trying to herd cats.  However there are some good things that have come of it IMHO.

 

On of the things that people love about modern hi-level languages is data structures.  This can also be something people hate about Forth.  Forth, per its inventor, took the approach that you should just map out the memory yourself like we do in Assembler. Give the map some meaningful names and get on with the programming.  What's yer problem?

 

Forth 2012 has standardize a way to create data structures.

Here is a magic word that lets you build data structures a amazing as that may be:

: +FIELD  \ n <"name"> -- ; Exec: addr -- 'addr
   CREATE OVER , +
   DOES> @  + ;

At compile time it creates a name in the dictionary  , records an offset number in memory and adds that value to a number of the stack. The no. on the stack keeps track of the size of the data structure as we enter new fields.

 

+FIELD is normally a "primitive" and is used to make other new fields with names that are descriptive of the data.

 

Below is an implementation that runs on CAMEL99 Forth and should be portable with some tweeks to other TI-99 Forths.

Spoiler

\ Forth 2012 structures for CAMEL99 Forth
: +FIELD  \ n <"name"> -- ; Exec: addr -- 'addr
   CREATE OVER , +
   DOES> @  + ;

\ using +field you can make your own field desciptors.
: FIELD:    ( n1 "name" -- n2 ; addr1 -- addr2 ) ALIGNED 1 CELLS +FIELD ;
: 2FIELD:   ( d1 "name" -- d2 ; addr1 -- addr2 ) ALIGNED 2 CELLS +FIELD ;
: CFIELD:   ( n1 "name" -- n2 ; addr1 -- addr2 )         1 CHARS +FIELD ;

: CELLS:    ( n -- )  CELLS +FIELD ;

\ we can add string size tests for a CHARS: field
: ?STRING   ( n -- n) DUP 1 256 WITHIN 0= ABORT" bad string length" ;
: CHARS:    ( n -- ) ?STRING CHARS +FIELD ;  ( CHARS is a NOOP on 9900)

 

 

And below is some test code.

Spoiler

\ ===================================================================
\ example code: using [ ] brackets as a naming convention to
\ identify structures and fields

    0  ( zero on the stack accumulates the record size)
       FIELD: REC#]
    32 CHARS: NAME]
    32 CHARS: FAMILY]
    64 CHARS: ADDRESS]
    32 CHARS: CITY]
    15 CHARS: PROV]
    25 CHARS: COUNTRY]
( -- n) CONSTANT RECORD-SIZE   \ record the size as a constant

: BUFFER:    CREATE  ALLOT ;
: ""   ( -- addr len) S" " ;      \ a null string

RECORD-SIZE BUFFER: [BUFF         \ and make a buffer that size

: ERASE.REC
           0  [BUFF REC#] !
           "" [BUFF NAME] PLACE
           "" [BUFF FAMILY] PLACE
           "" [BUFF ADDRESS] PLACE
           "" [BUFF CITY] PLACE
           "" [BUFF PROV] PLACE
           "" [BUFF COUNTRY] PLACE
;

: LOADREC
         1    [BUFF REC#] !
 S" Robert"   [BUFF NAME] PLACE
 S" Odrowsky" [BUFF FAMILY] PLACE
 S" 116 Settlement Park Ave." [BUFF ADDRESS] PLACE
 S" Markham"  [BUFF CITY] PLACE
 S" Ontario"  [BUFF PROV] PLACE
 S" Canada"   [BUFF COUNTRY] PLACE
;

: PRINT#   ( addr --)  @ . ;
: PRINT$   ( $addr --) COUNT TYPE ;
: PRINTLN  ( $addr --) CR PRINT$ ;

: PRINT.REC
        CR ." Record#: " [BUFF REC#] PRINT#
        [BUFF FAMILY] PRINTLN  ." , " [BUFF NAME] PRINT$
        [BUFF ADDRESS] PRINTLN
        [BUFF CITY] PRINTLN
        [BUFF PROV] PRINTLN
        [BUFF COUNTRY] PRINTLN ;

 

 

Of course it's Forth so if you wanted to you could do this...?

\ using +field you can make your own field descriptors.
0 CONSTANT struct{
: int    ( n1 "name" -- n2 ; addr1 -- addr2 ) ALIGNED 1 CELLS +FIELD ;
: double ( d1 "name" -- d2 ; addr1 -- addr2 ) ALIGNED 2 CELLS +FIELD ;
: char   ( n1 "name" -- n2 ; addr1 -- addr2 )         1 CHARS +FIELD ;
: string ( n -- ) ?STRING CHARS +FIELD ;  ( CHARS is a NOOP on 9900)

: ]struct  CONSTANT ;

struct{ int x
        int y
     40 string FieldName
      }struct ADDRESS_FIELD

 

Edited by TheBF
typos
  • Like 2
Link to comment
Share on other sites

Simple Animation

 

This is so completely trivial given the level of some of the game writers in this forum, but I had never tried animating sprites in the 1980s.

So given my new automotion I wondered if I could make it easy.  The game in Forth is to write a control language to let you do the job in a self-descriptive way.

I think I have that with the phrase: GOLEFT 50 STEPS 

 

For the Forth student notice how we only needed CREATE and ','  (comma) to create data structures in memory. This is more like how it's done in Assembler than other high level languages. Of course if you wanted it to be more formal you could use the data structures from my previous post to create your character patterns and flip-books but it can all be done with primitive operations.

 

Spoiler has the code, video shows the trivial animation but the concepts should be expandable for your project in Forth.

 

Spoiler

\ SPRITE ANIMATION METHOD EXAMPLE

NEEDS DUMP     FROM DSK1.TOOLS
NEEDS SPRITE   FROM DSK1.DIRSPRIT
NEEDS ELAPSE   FROM DSK1.ELAPSE
NEEDS MOTION   FROM DSK1.AUTOMOTION



DECIMAL
\ named numbers are easier to read
10 CONSTANT LITTLEGUY   \ character #
 0 CONSTANT WALKER      \ sprite #
16 CONSTANT WHITE

\ ============================================================
\ Character patterns are just integers compiled into CPU ram
HEX
CREATE MAN0  1038 , 1038 , 5410 , 1028 , \ stationary

CREATE MANR1 1038 , 1038 , 5410 , 2848 , \ walk right
CREATE MANR2 1038 , 1038 , 5410 , 3010 ,
CREATE MANR3 1038 , 1038 , 5410 , 2840 ,

CREATE MANL1 081C , 081C , 2A08 , 1412 , \ walk left
CREATE MANL2 081C , 081C , 2A08 , 0C08 ,
CREATE MANL3 081C , 081C , 2A08 , 1402 ,

CREATE MANUP1 1038 , 1038 , 5410 , 2808 ,  \ walk up/down
CREATE MANUP2 1038 , 1038 , 5410 , 2820 ,

\ ============================================================
\ A "FLIPBOOK" can be created by putting the "pattern" addresses
\ in memory with a count field.
\                          count  img1    img2    img3  etc...
CREATE WALKRIGHT ( -- addr) 3 ,   MANR1  , MANR2  , MANR3 ,
CREATE WALKLEFT  ( -- addr) 3 ,   MANL1  , MANL2  , MANL3 ,
CREATE WALKUP/DN ( -- addr) 3 ,   MANUP1 , MANUP2 , MANUP1 ,

\ helper words
DECIMAL
: ?BREAK   ?TERMINAL
           IF STOPMOTION             \ stop the automotion
              MAN0 LITTLEGUY CHARDEF
             ." ^C" ABORT
           THEN ;

\ returns size of FLIPBOOK  and the address of 1st Pattern
: SIZEOF  ( flipbook_addr -- addr n ) DUP CELL+ SWAP @ ;

\ play a flip-book once

VARIABLE SPEED    100 SPEED !

: 1STEP ( list_addr -- )
          SIZEOF 0
          DO
             PAUSE
             ( -- addr)               \ flipbook address is on top of stack
             DUP @ LITTLEGUY CHARDEF  \ fetch pattern, write to VDP RAM
             CELL+                    \ advance to next cell of flipbook
             SPEED @ MS               \ delay in milli-seconds
             ?BREAK
          LOOP
          DROP                      \ we are finished with the pattern
;

: STEPS ( list n -- )  0 ?DO  DUP 1STEP LOOP DROP ;

\ put automotion and animated flipbooks together
: GOLEFT   ( -- list)  0 -4 WALKER MOTION  WALKLEFT  ;
: GORIGHT  ( -- list)  0  4 WALKER MOTION  WALKRIGHT ;
: GODOWN   ( -- list)  4  0 WALKER MOTION  WALKUP/DN ;
: GOUP     ( -- list) -4  0 WALKER MOTION  WALKUP/DN ;

: DEMO  ( -- )
   \     chr      colr  Y   X     Sp#
   \    ------------------------------------
        LITTLEGUY WHITE 10  0  WALKER SPRITE
        1 MAGNIFY
        SPR# @ MOVING \ tell automotion how many sprites are moving
        CLEAR
        AUTOMOTION
         GORIGHT 50 STEPS
         GODOWN  30 STEPS
         GOLEFT  50 STEPS
         GOUP    30 STEPS
         MAN0 LITTLEGUY CHARDEF
        STOPMOTION
;

 

 

  • Like 2
Link to comment
Share on other sites

  • 2 weeks later...

Surprising Editor Code

 

One of the things on the todo list for CAMEL99 Forth is a resident editor. Since CAMEL99 uses DV80 files for editing my old code for Forth BLOCK editors was not exactly what I needed.  I took look around the "inter-web" to see if there might be some Forth code I could adapt. The only editor that I found that looked interesting was one called VIBE written by Samuel Falvo.  Vibe is written in the style of VI or VIM editors first seen in UNIX. These editors have 2 modes.  A command mode which let's you do things without touching the text and an 'insert' mode that lets you type text.  It's a bit strange compared to what we normally expect but I read that many people love it especially for system work.

 

When I looked at the code it was very Forthy with short, single line definitions, that were woven together, as the code developed, to make the editor.

Typically a text editor needs a big CASE statement or a bunch of IF statements as a selector to deal with command keys versus the alphanumeric keys that we enter into the text.  However I could not find a CASE statement of any kind to deal with the keyboard inputs in VIBE.  What I found instead was fascinating.

 

The author of Forth, Chuck Moore often said that the Forth dictionary of words is a big case statement. He preferred to let the code determine what gets executed rather than setting data in variables and acting on the data. VIBE takes more of that approach. Here is how it works.

  1. Make a string variable "$$___"  where underscore is a binary zero (0)
  2. Name all the routines for the editor functions using this encoding. ( Example: "$$i0D"  is the enter key routine name, Key= hex 0D)
  3. When keys are pressed, Modify this "command string" by changing the zeros to other values to make new commands.
  4. Pass this string to the FORTH lookup routine (FIND) and if the word is found, EXECUTE it.
  5. If it's not found, beep.

Here are the comments from the code itself that explains the command string.

\ CMD name key: $ $ _ _ _
\                    | | |
\ 'c'=command mode --+ | |
\ 'i"=ins/repl mode    | |
\                      | |
\ Key code (hex#) -----+-+

I made a few changes that saved space for the TI-99 and I changed the default Forth TYPE word with a version that used VMBW for faster screen updates.

Once I figured it out,  it actually worked as you can see in the video.

The spoiler has the code.

 

Spoiler

\ VIBE Release 2.2
\ Copyright (c) 2001-2003 Samuel A. Falvo II
\ All Rights Reserved
\
\ Highly portable block editor -- works under nearly every ANS Forth
\ I can think of, and with only a single screenful of words, will
\ work under Pygmy and FS/Forth too.
\
\ USAGE: vibe ( n -- ) Edits block 'n'.  Sets SCR variable to 'n'.
\        ed ( -- ) From Pygmy.  Re-edits last edited block.
\
\
\ 2.1 -- Fixed stack overflow bugs; forgot to DROP in the non-default
\        key handlers.
\

\ 2.2 Ported to CAMEL99 Forth with Permission B. Fox 2019
\     Removed some character oonstants to save space.
\     Changed TYPE for VTYPE. Added CLIP.
\     Removed shadow block function
\     Added some block navigation commands

NEEDS DUMP   FROM DSK1.TOOLS
NEEDS 80COLS FROM DSK1.80COL
NEEDS BLOCK  FROM DSK1.BLOCKS

HERE
( Editor Constants )
CHAR i  CONSTANT 'i   \ Insert mode
\ CHAR r  CONSTANT 'r   \ Replace mode
CHAR c  CONSTANT 'c   \ Command mode

\ CHAR y  CONSTANT 'y
\ CHAR n  CONSTANT 'n
\ CHAR A  CONSTANT 'a
\ CHAR Z  CONSTANT 'z
\ CHAR $  CONSTANT '$

\ camel99 values
DECIMAL
  64 CONSTANT LWIDTH
C/L@ CONSTANT WIDTH
 80  CONSTANT MAXBLKS

( Editor State )
 VARIABLE SCR       \ Current block
 VARIABLE X         \ Cursor X position 0..LWIDTH
 VARIABLE Y         \ Cursor Y position 0..15
 VARIABLE MODE      \ current mode: INSERT or command ( 'i OR 'c

\ CMDNAME the command string, is built, found and executed
CREATE CMDNAME    5 C,  CHAR $ C, CHAR $ C,  0 C, 0 C, 0 C,

( Editor Display )
 DECIMAL
: MODE.       LWIDTH 0 AT-XY MODE @ EMIT ;
: VTYPE       ( addr len -- ) DUP >R  VPOS SWAP VWRITE  R> VCOL +! ; \ VDP fast write
: SCR.        0 0 AT-XY S" Block: " VTYPE  SCR @ . S"      " VTYPE ;
: HEADER      SCR. MODE. ;
: 8-S         S" --------" VTYPE ;
: WIDTH-S     8-S 8-S 8-S 8-S 8-S ;
: BORDER      SPACE WIDTH-S CR ;
: ROW         ( addr -- addr') DUP LWIDTH VTYPE  LWIDTH + ;   \ FAST
\ : ROW         ( addr -- addr') DUP LWIDTH TYPE  LWIDTH + ;  \ SLOW
: LINE        ." |" ROW CR ;
: 4LINES      LINE LINE LINE LINE ;
: 16LINES     SCR @ BLOCK 4LINES 4LINES 4LINES 4LINES DROP ;
: CARD        0 1 AT-XY BORDER 16LINES BORDER ;
: CURSOR      X @ 1+ Y @ 2 + AT-XY ;
: SCREEN      HEADER CARD CURSOR ;

( Editor State Control )
: INSERT     'i MODE ! ;
: REPLACE    [CHAR] r MODE ! ;
: CMD        'c MODE ! ;
: CLIP         ROT MIN MAX ;
: BOUNDED      ( addr n -- ) 0 MAXBLKS CLIP SWAP ! ;
: PREVBLOCK    SCR DUP @ 1- BOUNDED ;
: NEXTBLOCK    SCR DUP @ 1+ BOUNDED ;
\ : TOGGLESHADOW 1 SCR @ XOR SCR ! ;

( Editor Cursor Control )
: FLUSHLEFT     0 X ! ;
: BOUNDX        X @  0 LWIDTH CLIP X ! ;
: BOUNDY        Y @  0 15 CLIP Y ! ;
: BOUNDXY       BOUNDX BOUNDY ;
: LEFT          -1 X +! BOUNDXY ;
: RIGHT          1 X +! BOUNDXY ;
: UP            -1 Y +! BOUNDXY ;
: DOWN           1 Y +! BOUNDXY ;
\ : beep          7 EMIT ;
: NEXTLINE      Y @ 15 < IF FLUSHLEFT DOWN THEN ;
: NEXT          X @ LWIDTH = IF NEXTLINE EXIT THEN RIGHT ;

( Editor Insert/Replace Text )
: WIDTH*        6 LSHIFT ;  \  2* 2* 2* 2* 2* 2*
: WHERE         SCR @ BLOCK SWAP WIDTH* + SWAP + ;
: WH            X @ Y @ WHERE ;
: EOL           LWIDTH Y @ WHERE ;
: PLACE         WH C! UPDATE NEXT ;
: -EOL?         X @ LWIDTH < ;
: OPENR         WH DUP 1+ LWIDTH X @ - MOVE ;
: OPENRIGHT     -EOL? IF OPENR THEN ;
: INSERTING?    MODE @ 'i = ;
: CHR           INSERTING? IF OPENRIGHT THEN PLACE ;

( Editor Keyboard Handler CMDWORD encoding)
\ CMD name key: $ $ _ _ _
\                    | | |
\ 'c'=command mode --+ | |
\ 'i"=ins/repl mode    | |
\                      | |
\ Key code (hex#) -----+-+
\
\ Called with ( k -- ) where k is the ASCII key code.

( Editor COMMANDS: Quit, cursor, block, et. al. )
( Modified for Ti-99 keyboard )
: $$c51       DROP 0 20 AT-XY R> R> DROP >R ; \ Q -- quits main loop
: $$c30       DROP FLUSHLEFT ;         \ 0
: $$c69       DROP INSERT ;            \ i
: $$c49       DROP FLUSHLEFT INSERT ;  \ I
: $$c52       DROP REPLACE ;           \ R
: $$i0F       DROP CMD ;               \ (escape) GOTO command mode
: $$c68       DROP LEFT ;              \ h
: $$c6A       DROP DOWN ;              \ j
: $$c6B       DROP UP ;                \ k
: $$c6C       DROP RIGHT ;             \ l
: $$c5B       DROP PREVBLOCK ;         \ [
\ : $$c5C       DROP TOGGLESHADOW ;      \ \
: $$c5D       DROP NEXTBLOCK ;         \ ]

( Editor Backspace/Delete )
: PADDING     32 EOL C! UPDATE ;
: DEL         WH DUP 1+ SWAP LWIDTH X @ - MOVE ;
: DELETE      -EOL? IF DEL THEN PADDING ;
: BS          LEFT DELETE ;
: BACKSPACE   X @ 0 > IF BS THEN ;

( Editor Carriage Return )
: NEXTLN      EOL 1+ ;
: #CHRS       SCR @ BLOCK 1024 + NEXTLN - WIDTH - ;
: COPYDOWN    Y @ 14 < IF NEXTLN DUP WIDTH + #CHRS MOVE THEN ;
: BLANKDOWN   NEXTLN WIDTH 32 FILL UPDATE ;
: SPLITDOWN   WH NEXTLN 2DUP SWAP - MOVE ;
: BLANKREST   WH NEXTLN OVER - 32 FILL ;
: OPENDOWN    COPYDOWN BLANKDOWN ;
: SPLITLINE   OPENDOWN SPLITDOWN BLANKREST ;
: RETRN       INSERTING? IF SPLITLINE THEN FLUSHLEFT NEXTLINE ;
: RETURN      Y @ 15 < IF RETRN THEN ;

( Editor Wipe Block )
: MSG         0 20 AT-XY ." Are you sure? (Y/N) " ;
: VALID?      DUP [CHAR] n = OVER [CHAR] y = OR ;
: UPPERCASE?  DUP [CHAR] a [CHAR] z 1+ WITHIN ;
: LOWERCASE   DUP UPPERCASE? IF BL XOR THEN ;
: VALIDKEY    BEGIN KEY LOWERCASE VALID? UNTIL ;
: CLRMSG      0 20 AT-XY WIDTH SPACES ;
: NO?         MSG VALIDKEY CLRMSG [CHAR] n = ;
: ?CONFIRM    NO? IF R> DROP THEN ;
: WIPE        ?CONFIRM SCR @ BLOCK 1024 32 FILL UPDATE 0 X ! 0 Y ! ;

( Editor Commands: backspace, delete, et. al. )
: $$i04       DROP DELETE ;                    \ CTRL-D
: $$i08       DROP BACKSPACE ;                 \ (bs)
\ : $$i7F       DROP BACKSPACE ;                 \ DEL -- for Unix
: $$i0D       DROP RETURN ;                    \ (cr)
: $$c5A       DROP WIPE ;                      \ Z
: $$c6F       DROP OPENDOWN DOWN $$c49 ;       \ o
: $$c4F       DROP OPENDOWN ;                  \ O
\ : $$i95       DROP X OFF  Y OFF  ;             \ PC "HOME" key

HEX
  0F CONSTANT $0F
  F0 CONSTANT $F0

: KEYBOARD    KEY 7F AND ;  \ for TI-99 we need to mask upper bit

DECIMAL
: CMD?        MODE @ 'c = ;
: INS?        MODE @ 'i =   MODE @ [CHAR] r =  OR ;
: MODE!       INS? 'i AND CMD? 'c AND OR  CMDNAME 3 + C! ;
: >HEX        DUP 9 > IF 7 + THEN [CHAR] 0 + ;
: H!          DUP $F0 AND  4 RSHIFT >HEX  CMDNAME 4 + C! ;
: L!          $0F AND >HEX CMDNAME 5 + C! ;
: NAME!       MODE! H! L! ;
: NOMAPPING   DROP ['] BEEP CMD? AND   ['] CHR INS? AND  OR ;
: HANDLERWORD NAME! CMDNAME FIND 0= IF NOMAPPING THEN ;
: HANDLER     DUP HANDLERWORD EXECUTE ;
: ?BREAK      ?TERMINAL ABORT" *BREAK*" ;
: EDITOR      'c MODE !  BEGIN KEYBOARD HANDLER SCREEN ?BREAK AGAIN ;

\ BF commsnds
: VI      ( --)  PAGE SCREEN EDITOR ;
: VIBE    ( n -- ) SCR !  VI ;
: LIST    ( n -- ) SCR ! PAGE SCREEN 3 19 AT-XY ;
: >>      SCR @ 1+ LIST ;
: <<      SCR @ 1- LIST ;
: INDEX   ( from to -- )
          1+ SWAP ?DO  CR I 4 .R 2 SPACES I BLOCK 64 TYPE ?BREAK LOOP  ;

HERE SWAP - DECIMAL . .( bytes)

S" DSK3.FBLOCKS" OPEN-BLOCKS

 

 

  • Like 2
Link to comment
Share on other sites

Exploring a VDP Screen Editor

 

In another topic there is a discussion of editing screen contents that can be passed to the interpreter like the C64 does.

I have some code that is working except for the insert function so I will publish when it's all working.

 

An outcome of the work however is a simplification of the KEY word in future versions of Camel99 Forth.

I was using the interrupt timer to control the speed of the flashing cursor. That seemed to require ALC to make it work.

It was needlessly complicated. I realized that I could use the 9901 timer that I have running continuously to do the job in Forth and it saved a couple of bytes.

It is also easier to understand.

 

\ cursor flash control is done by reading the 9901 timer (thanks Tursi)
\ It counts down from >3FFF in 349mS so 1FFF is 1/2 the maximum value.
\ If the timer > 1FFF we show the cursor else we show a blank char
\ Cursor flash rate is 349 / 2 = 124ms

: KEY      ( -- char)
            BEGIN                 \ start the loop
              TMR@ 1FFF >         \ 9901>1FFF ?
              IF   CURS @         \ true? fetch the cursor char
              ELSE BL             \ false? get the screen char
              THEN VPUT           \ then put on screen
              KEY?                \ check the keyboard
              ?DUP                \ DUP IF <> 0
            UNTIL                 \ loop until a key pressed
            BL VPUT ;             \ put the space char on screen

P.S.

If ... you can cursor around and edit the VDP screen, you could also save the screen to a file. ?

 

P.P.S.

You could also spill the screen off into memory and make it a window into a big buffer with a pointer or two... I'm just saying.

 

  • Like 2
Link to comment
Share on other sites

On 9/29/2019 at 12:31 PM, TheBF said:

When I looked at the code it was very Forthy with short, single line definitions, that were woven together, as the code developed, to make the editor.

Typically a text editor needs a big CASE statement or a bunch of IF statements as a selector to deal with command keys versus the alphanumeric keys that we enter into the text.  However I could not find a CASE statement of any kind to deal with the keyboard inputs in VIBE.  What I found instead was fascinating.

 

TI Forth and fbForth 1.0 indeed do use a 16-part CASE statement for the 40-column editor. fbForth 2.0, however, is programmed in ALC and uses a jump table for all but 3 commands that have inconvenient values for the table.

 

I do love the command structure in your editor—very clever!

 

...lee

Link to comment
Share on other sites

1 hour ago, Lee Stewart said:

 

TI Forth and fbForth 1.0 indeed do use a 16-part CASE statement for the 40-column editor. fbForth 2.0, however, is programmed in ALC and uses a jump table for all but 3 commands that have inconvenient values for the table.

 

I do love the command structure in your editor—very clever!

 

...lee

I can't take credit. It's all Sam Falvo, who is a pretty big Forth programmer as far as I can determine. He has a good mind for sure.

I would never have considered that this would work fast enough. In fact I was worried that the lookup time on a TI99 Forth would make it glacial for typing.

It's not fast, but it works.

 

These are the kind of solutions people come up with when they let go of preconceptions.  I love it too.

 

Back to the more conventional, I have a working file type editor with basic functions. It started as an attempt to read Forth commands off the screen like C64 BASIC.

That part is ready to implement but I got distracted once I had an editor on the screen.

 

Because I used all the screen description variables in the kernel it seems to work fine in 80 columns or 40 columns!

I took the approach of using the screen memory as the active buffer. My hope is to slide the screen over the file buffer like a window.

I am trying to keep it simple so it will probably be a true 40 column editor on a stock TI-99. Not sure if that's usable. We shall see.

I am pretty excited about getting it loading and saving files. Almost there.

 

On of the things I wanted to solve was alternately displaying the cursor and the character under the cursor so I made a new version of KEY. Now I have to get it repeating.

: EDITKEY ( -- char)              \ non-repeating KEY
            VPOS VC@ >R           \ Read screen char & RPUSH
            BEGIN                 \ start the loop
              TMR@ 1FFF >         \ read 9901 timer. compare to >2000
              IF CURS @           \ true? fetch cursor char
              ELSE R@             \ false? fetch screen char
              THEN VPUT           \ multi-tasking friendly screen write
              KEY?                \ check the keyboard
              ?DUP                \ DUP IF <> 0
            UNTIL                 \ loop until a key pressed
            R> VPUT ;             \ RPOP the screen char, put it back

 

 

  • Like 1
Link to comment
Share on other sites

54 minutes ago, TheBF said:

On of the things I wanted to solve was alternately displaying the cursor and the character under the cursor so I made a new version of KEY. Now I have to get it repeating.

 

I do not know that it will help, but here is the ALC for RKEY , the key routine in the 40/80-column editor in fbForth 2.0.

;[*++ RKEY ++*      Get next key and repeats
*++ RKEY is key acquisition/repetition and cursor blinking routine.
*++
*++ Register usage:

RKEY   DECT R                   ; make room on return stack to...
       MOV  LINK,*R             ; ...save return

RKEYLP LIMI 0                       ; disable interrupts because KSCAN doesn't
       BLWP @KSCAN                  ; scan the keyboard (interrupts will be enabled at end)
       INC  @BLINK                  ; increment blink logger
       LI   R3,180                  ; load 180
       C    @BLINK,R3               ; has it been 180 clicks?
       JLT  RKEY01                  ; jump if not
       MOVB @CURCH,R1               ; copy character under cursor
       JMP  RKEY02                  ; restore it
RKEY01 LI   R1,>1E00                ; load cursor character
RKEY02 BL   @PCHCUR                 ; display cursor or char under cursor
       SLA  R3,1                    ; load 360
       C    @BLINK,R3               ; has it been 360 clicks?
       JNE  RKEY03                  ; jump if not
       CLR  @BLINK                  ; clear blink logger
RKEY03 CB   @KYCHAR,@CONFF          ; no key?
       JEQ  RKEY05                  ; jump if so
       
*++ We have a key!
       SZCB @CN8000,@KYCHAR         ; force KYCHAR byte to ASCII
       MOV  @KC,R3                  ; save key counter for test
       INC  @KC                     ; increment key counter for wait
       CLR  @BLINK                  ; zero blink logger
       MOV  R3,R3                   ; waiting to repeat?
       JEQ  RKEYEX                  ; finish up and exit if not

*++ waiting to repeat
       C    @RLOG,@KC               ; long enough?
       JLT  RKEY04                  ; jump if so

*++ We may not have waited long enough yet.
       CB   @OKEY,@KYCHAR           ; same key?
       JEQ  RKEYLP                  ; wait some more if same key

*++ We're outta here!
       MOV  @CON01,@KC              ; load key counter with 1
       JMP  RKEYEX                  ; finish up

*++ we've waited long enough
RKEY04 MOV  @RL,@RLOG               ; load short wait time for repeat logger
       MOV  @CON01,@KC              ; load key counter with 1
       JMP  RKEYEX                  ; clean up and back to editor loop

*++ No key was pressed.
RKEY05 MOV  @RH,@RLOG               ; re-init RLOG
       CLR  @KC                     ; zero key counter
       JMP  RKEYLP                  ; scan keyboard again

*++ End of RKEY processing
RKEYEX MOVB @KYCHAR,@OKEY           ; current key to old key
       MOVB @CURCH,R1               ; character under cursor to R1
       BL   @PCHCUR                 ; restore it to display
       MOV  *R+,LINK                ; pop return address
       B    @BKLINK           ; return to caller, possibly re-enabling interrupts

 

...lee

  • Like 2
Link to comment
Share on other sites

Here is cute little tool.  While thinking about a repeating KEY routine I was noodling on how to time the delays that are needed.  I created the counter which is a variable that decrements itself down to zero.

It's not a real time delay but it lets you count how many times you ran through a loop without thinking about it.  When the counter returns 0 you can do something.

This might make a repeating KEY easier to make...

Edit: made COUNTERs  reloadable


: COUNTER:  ( n -- <text>)
      CREATE DUP  ,    ,
      DOES> DUP @ IF -1 OVER +!  THEN @ ;

: RELOAD   '   >BODY DUP CELL+ @ SWAP ! ;

Edit2:  Making reload work for compiling will hurt my head and not really worth the trouble. I can do it with a simple 2VARIABLE and decrement to 0 word.  ?

Edited by TheBF
  • Like 1
Link to comment
Share on other sites

A Better Counter


: COUNTER:  ( n -- <text>) CREATE DUP  ,    , ;

: EXPIRED?  ( counter -- ?)  DUP @ IF -1 OVER +!  THEN @ 0= ;

: RELOAD    ( counter -- )  DUP  CELL+ @ SWAP ! ;

I find that using CREATE DOES> is best kept for special cases.   I know Chuck Moore decided to not use it in his personal Forth compilers these days.

  • Like 1
  • Thanks 1
Link to comment
Share on other sites

Repeating Key in Forth (Cleaned up version)

 

Reduced to two working words to save a little space. 

Now I can get on with finishing the editor.

 

Spoiler

\ RKEY, A repeating KEY word
\ algorithm from
\ http://www.unige.ch/medecine/nouspikel/ti99/keyboard.htm#auto-repeat

\ NEEDS DUMP FROM DSK1.TOOLS

DECIMAL
 70 CONSTANT LONG      \ Ticks before auto-repeat kicks in
  2 CONSTANT SHORT     \ Delay between repeats

\ Not very Forthy using all these variables
VARIABLE DLY           \ Current delay & "state" variable
VARIABLE NEWKEY        \ key buffer
VARIABLE OLDKEY        \ previous key buffer

HEX
: (RKEY) ( -- )
    DLY @ LONG =        \ Are we repeating?
    IF   LONG DLY !     \ No, use long delay
    THEN
    DLY @ 0
    DO
        83C8 ON          \ KSCAN will repeat
        KEY? DUP NEWKEY !
        OLDKEY @  <>    \ different than before?
        IF
          NEWKEY @  OLDKEY !  \ Memorize current key (will be >00 if no key)
          LONG DLY !    \ reload initial delay
          UNLOOP  EXIT  \ jump out of the routine (to the semi-colon )
        THEN
    LOOP
    SHORT DLY !         \ Done with waiting: load repeat delay
;

: RKEY   ( -- char)
         VPOS VC@ >R     \ store char under cursor
         BEGIN
           TMR@ 1FFF >   \ read 9901 timer. compare to >2000
           IF CURS @     \ true? fetch cursor char
           ELSE R@       \ false? fetch screen char
           THEN VPUT     \ multi-tasking friendly screen write
          (RKEY)
           NEWKEY @      \ get the newkey value
          ?DUP
         UNTIL
         R> VPUT ;       \ put the char back

\ =====[ END OF CODE ]=====

: TEST  ( -- )  BEGIN RKEY EMIT  ?TERMINAL UNTIL ;

 

 

  • Like 3
  • Thanks 1
Link to comment
Share on other sites

FYI, here is the Forth code I converted to the ALC of post #408:

Spoiler

DECIMAL
0 VARIABLE CURCHR                \ CURCHR = char under cursor

: GCH    \ get char at cursor position ( CURPOS )  ...used by: VED
    CURPOS @ VSBR CURCHR ! ;   
: PCH    \ put current char to cursor position     ...used by: RKEY
    CURCHR @ CURPOS @ VSBW ;
: PCUR   \ put cursor to cursor position           ...used by: RKEY
    30 CURPOS @ VSBW ;

\ RKEY required variables
  0 VARIABLE BLINK  
  0 VARIABLE OKEY  
 10 CONSTANT RL  
150 CONSTANT RH  
  0 VARIABLE KC 
 RH VARIABLE RLOG

: RKEY    ( -- key )  \ Used by: VED
    BEGIN 
        ?KEY -DUP 1
        BLINK +! BLINK @ DUP 60 < 
        IF 
            PCUR 
        ELSE 
            PCH 
        THEN    
        120 = 
        IF 
            0 BLINK ! 
        THEN    
        IF                                \ ...some key is pressed   
            KC @ 1 KC +! 0 BLINK !
            IF                            \ ...waiting to repeat 
                RLOG @  KC @  <           
                IF                        \ ...long enough 
                    RL RLOG ! 1 KC ! 1    \ force exit
                ELSE 
                    OKEY @ OVER = 
                    IF 
                        DROP 0            \ need to wait more 
                    ELSE 
                        1                 \ force exit 
                        DUP KC !   
                    THEN       
                THEN                                             
            ELSE                          \ new key 
                1                         \ force loop exit 
            THEN        
        ELSE                              \ no key pressed
            RH RLOG ! 0 KC !  0   
        THEN    
    UNTIL 
    DUP OKEY ! PCH  ;

 

 

...lee

  • Like 1
Link to comment
Share on other sites

Well that certainly explains my difficulties.  I struggle with those long logic trees.  I haven't written code like that for years, probably since I read "Thinking Forth".

Clearly there is a place for it  sometimes.  If I had the logic in my mind my tendency now would be to encapsulate a lot of the logic in little conditional words to help my feeble mind cope. :)

 

It is very interesting to compare the two versions.

I was struggling with the forced exits which I see in your example is handled by playing with the stack value that is controlling the BEGIN/UNTIL loop.

I was trying to avoid that but I see I could have gone there. I could have kept it simple (for me) to understand by using another variable just to get it working.

 

I haven't got firm numbers yet but a manual byte count of the Nouspikel example and my Forth version showed similar size, Forth being about 10% bigger.

A quick count on the nested IF THEN version is significantly bigger because the IF and ELSE consume 4 bytes each.

 

I believe this code is from the original TI-Forth (?)  I notice now when I review it in my old listings that the young engineers who wrote it were probably new to Forth and the code style many times is like 'C' converted to Forth.

 

Thanks for sending this along. I will play with it... after I recover from my latest marathon. :)

 

  • Like 1
Link to comment
Share on other sites

"To gain knowledge add a little every day.  To gain wisdom remove a little everyday."  Anon.

 

I always hated the if statement at the beginning of (RKEY). Turns out if you just init the DLY variable you don't need it.

It has only 2 states  LONG or SHORT.

DECIMAL
 70 CONSTANT LONG      \ Ticks before auto-repeat kicks in
  2 CONSTANT SHORT     \ Delay between repeats

\ Not very Forthy using all these variables
VARIABLE DLY           \ Current delay & "state" variable
VARIABLE NEWKEY        \ key buffer
VARIABLE OLDKEY        \ previous key buffer

LONG DLY !             \ init this variable

HEX
: (RKEY) ( -- )
    DLY @ 0
    DO
        RKEY? DUP NEWKEY !
        OLDKEY @  <>    \ different than before?
        IF
          NEWKEY @  OLDKEY !  \ Memorize current key (will be >00 if no key)
          LONG DLY !    \ reload initial delay
          UNLOOP  EXIT  \ jump out of the routine (to the semi-colon )
        THEN
    LOOP
    SHORT DLY !         \ Done with waiting: load repeat delay
;

: RKEY   ( -- char)
         VPOS VC@ >R     \ store char under cursor
         BEGIN
           TMR@ 1FFF >   \ read 9901 timer. compare to >2000
           IF CURS @     \ true? fetch cursor char
           ELSE R@       \ false? fetch screen char
           THEN VPUT     \ multi-tasking friendly screen write
          (RKEY)
           NEWKEY @      \ get the newkey value
          ?DUP
         UNTIL
         R> VPUT ;       \ put the char back

 

Link to comment
Share on other sites

3 hours ago, TheBF said:

Well that certainly explains my difficulties.  I struggle with those long logic trees.  I haven't written code like that for years, probably since I read "Thinking Forth".

Clearly there is a place for it  sometimes.  If I had the logic in my mind my tendency now would be to encapsulate a lot of the logic in little conditional words to help my feeble mind cope. :)

 

Yeah, I made only minor changes to the original code from the 64-column editor of TI Forth.  I should have made more where the stack number for UNTIL was concerned. That is a little less than satisfactory, indeed. The only real difference is the last word ( PCH ), which restores the character under the cursor before exiting RKEY . This was necessary because there is no text-mode analog to the sprite cursor in the bitmap mode of the 64-column editor.

 

3 hours ago, TheBF said:

I believe this code is from the original TI-Forth (?)  I notice now when I review it in my old listings that the young engineers who wrote it were probably new to Forth and the code style many times is like 'C' converted to Forth.

 

Here is the original RKEY from the 64-column editor by Leslie O’Hagan:

Spoiler

: RKEY 
   BEGIN 
      ?KEY -DUP 1 
      BLINK +! BLINK @ DUP 60 < 
      IF 
         6 0 SPRPAT
      ELSE 
         5 0 SPRPAT 
      ENDIF 
      120 = 
      IF 
         0 BLINK ! 
      ENDIF
      IF ( SOME KEY IS PRESSED ) 
         KC @ 1 KC +! 0 BLINK !
         IF ( WAITING TO REPEAT ) 
            RLOG @ KC @ <
            IF ( LONG ENOUGH ) 
               RL RLOG ! 1 KC ! 1 ( FORCE EXIT)
            ELSE 
               OKEY @ OVER =
               IF 
                  DROP 0 ( NEED TO WAIT MORE )
               ELSE 1 ( FORCE EXIT ) 
                  DUP KC ! 
               ENDIF
            ENDIF
         ELSE ( NEW KEY ) 
            1 ( FORCE LOOP EXIT ) 
         ENDIF
      ELSE ( NO KEY PRESSED) 
         RH RLOG ! 0 KC ! 0
      ENDIF
   UNTIL 
   DUP OKEY !  ; 

 

 

Leslie O’Hagan wrote this editor about a week after Leon Tietz wrote the 40-column editor, which, by the way, had no repeats. It simply used the TI Forth KEY routine from the TI Forth system-support routines (includes cursor blink) that the outer (text) interpreter uses.  I had often thought of changing KEY to act like RKEY to get the key repeat, but ran out of steam or patience—I forget which.

 

...lee

Link to comment
Share on other sites

So just for the sake of analysis here are some code size comparisons:

  • Nouspikel ALC                       92 bytes
  • BF translation of Nouspikel     198 bytes
  • *TI-Forth RKEY                    330 bytes

So my 10% estimate was way off.  There are about 60 bytes if LABEL and dictionary overhead in my Forth version.

 

* slightly modified to compile and work on Camel99 Forth for direct comparison

Link to comment
Share on other sites

Wow you know all the history.  I remember playing with that RKEY routine in the 64 column editor. I forget what I did to it.

I recently dumped my blocks to the serial port so here is what I have:

  ( 64 COLUMN EDITOR  15JUL82 LAO )              BASE->R DECIMAL
    0 VARIABLE BLINK  
    0 VARIABLE OKEY
    10 CONSTANT RL   
    40 CONSTANT RH  
    
     0 VARIABLE KC
    RH VARIABLE RLOG

    : GKEY BEGIN ?KEY -DUP 1 BLINK +! BLINK @ DUP 60 <
           IF CURSON
           ELSE CURSOFF  ENDIF    
            120 = IF 0 BLINK ! ENDIF
            IF ( some key is pressed ) KC @   1 KC +!  0 BLINK !
              IF ( waiting to repeat ) RLOG @  KC @  <
                 IF ( long enough ) RL RLOG ! 1 KC ! 1 ( FORCE EXT)
                 ELSE OKEY @ OVER =
                   IF ( need to wait more ) DROP 0
                   ELSE 1 ( force exit )    DUP KC !   ENDIF
                 ENDIF
              ELSE ( new key ) 1 ( force loop exit )  ENDIF
            ELSE ( no key pressed) RH RLOG ! 0 KC !   0
            ENDIF
           UNTIL DUP OKEY ! ;                       R->BASE -->

LOL!  I should have looked here first.  

 

But then I would not have made the new one.

  • Like 1
Link to comment
Share on other sites

On 10/4/2019 at 12:07 PM, TheBF said:

So just for the sake of analysis here are some code size comparisons:

  • Nouspikel ALC                       92 bytes
  • BF translation of Nouspikel     198 bytes
  • *TI-Forth RKEY                    330 bytes

So my 10% estimate was way off.  There are about 60 bytes if LABEL and dictionary overhead in my Forth version.

 

* slightly modified to compile and work on Camel99 Forth for direct comparison

Manually counting FBFORTH ALC it is in the 152 byte range, so a big improvement on the original TI-Forth version.

Link to comment
Share on other sites

ED99 Beginnings

 

I have been threatening to write an editor for CAMEL99 Forth for some time.  I reached into the archive and found an editor that wrote in 1985 for MVP Forth that I just called "ED". I ported it to HsForth in the 90s and now to CAMEL99 Forth in the 21st Century. Truth be told it's a complete re-write because I think I have learned a thing or two about Forth since writing this system.

 

As a result of ripping up and starting over it's still buggy. You can load,edit and save and file but I still have work to do.

 

The design is a little weird but it is because of the limited memory in the TI-99 for big files.  I use virtual memory file of 128 byte records to hold the file while working on it.

This uses the Forth word BLOCK which gives you 1K blocks of disk that are stored in buffers and automagically paged in and out on demand. :)

I create a swap-file on the disk that is 64Kb long and it is re-used.  This allows files of over 1000 *500 lines to be edited.  It's very crude however, If you insert a new line at the top of a 1000 line file be prepared to wait for about 8 seconds!!

* There are only 3 kinds of people. Those that can do math and those that can't)

 

The current version is to get the kinks out it and uses 80 columns because it's just easier to get started. I will add support for 40 columns later so I can use it my old IRON.

 

Something that I always loved with the TI-FORTH 64 column editor was having a Forth REPL window under the source code so I create that here. This allows me to save a ton of code because I can use the command line for things that are not "text editing" per se. 

Currently the commands are:

    LOAD   <filename>
    SAVE                   Save the loaded file with the same name
    SAVEAS   <filename>    saves loaded file as <filename>
    SWAPDEV  <DSKx.>       Sets the disk for the swapfile
    NEWBLOCKS              Create a new swapfile
    EDIT                   Enter editor window at cursor position
    ED99                   open swap-file, init the screen
    >>                     goto next page
    <<                     goto previous page
    VIEW                   scroll through the file in the editor window
    PURGE                  Erase the entire swapfile.
    

Having the interpreter means it is simple to make a config file to setup screen colors and disk selections on start-up.  I will also add SEARCH and REPLACE as text commands once things are stable.  Cut and paste will use a stack (what else in Forth) of lines that can be pasted back in difference places as needed.

 

I will eventually port it to use SAMS as the BLOCK structure instead of a file but this version will work with a 32K card.

 

Edited by TheBF
Math mistake
  • Like 4
Link to comment
Share on other sites

  • 1 month later...

I haven't posted much here because I was distracted by the SEVEN's problem.  That program pointed out that my VDP screen I/O was a little slow. This is not a surprise since much of it is written in Forth for instructional purposes.

 

I can re-compile the kernel in 5 seconds and run it, so I am always playing in CAMEL99 Forth to find what really matters for performance while trying to fit it into 8K.

 

I discovered that my SCROLL ROUTINE was a little slow. It uses Forth and a couple of Assembler routines to similar to VSBW and VMBW. It's got a bit of stack juggling in it which slows it down a bit.  You can vary the buffer size in the Kernel build from 1,2,4 or 8 lines by changing the multiplier in 2C/L and it certainly improves in speed with a bigger buffer. It looks like this.


 CODE: 2C/L ( -- n) CODE[ C/L@ 2* ] NEXT, END-CODE

: SCROLL ( -- )
           PAUSE
           2C/L DUP MALLOC ( -- n heap)
           C/SCR @
           C/L@ VTOP @ +  ( -- n heap c/scr DSTvaddr)
           DO
              I  ( -- c/scr heap vaddr)
              OVER 2DUP     2C/L VREAD
              SWAP C/L@ -   2C/L VWRITE
           2C/L +LOOP
           0 17 CLRLN
           DROP
          ( n) MFREE ;

 

I wondered what would happen if I the buffer the size the screen (minus one line) and move it all at once.  I have a way to allocate low RAM and release it again very quickly so I don't have to eat the space permanently.  I did it with the code below. It reduced the time to 43mS and takes less code space, BUT if I use 80 column mode the buffer size is 1840 bytes. Yikes.   It's pretty wasteful even it it is temporary but it does speed up screen I/O when you need scrolling.

\ 14 bytes smaller, faster, BUT uses huge malloc buffer
\ vdp2vdp byte movement with auto buffer allocation
: VCMOVE ( dest src bytes  -- )
          DUP MALLOC OVER >R DUP >R  \ r-- bytes buffer
          SWAP               \ -- dst src buffer cnt
          VREAD              \ -- dest
          R>                 \ -- dest buffer
          SWAP R@            \ -- buffer dest bytes
          VWRITE
          R> MFREE ;

: SCROLL  VTOP @  DUP C/L@ +  C/SCR @ OVER -  
         ( dst src bytes) VCMOVE
          0 17 CLRLN ; \ 43 mS

All that to say I will leave the big buffer in place.  The dirty little secret is that at any time, I can use a fast typing routine that writes to the screen at machine speeds, but does not automatically scroll. This gives me a back door for fast screen writes.

 

  • Like 2
Link to comment
Share on other sites

In Search of a Search

So one of the things an editor needs is a way to find text in a big file.  Forth 2012 has some new words added to the optional string wordset. One is called SEARCH.

https://forth-standard.org/standard/string/SEARCH

 

How convenient.  I took a run at what it would take to make a SEARCH word for my little system that would be flexible enough for use in an editor.

As is trendy in modern Forth the new SEARCH word uses stack strings that exist as a pair (address,length). This allows you to process strings of any length upto the biggest integer your Forth can handle. So for 9900 64K bytes.

 

The standard word to compare two strings in ANS/ISO Forth is:  COMPARE ( addr1 n1 addr2 n2 -- -1|0|1 )

It return 0 if the strings match, -1 if addr1<addr2 and 1 if addr1>addr2.

 

I have library file for COMPARE IN Forth, that is code published by a late pioneer of Forth named Neil Baud

(also know by the pseudonym Wil Baden)

\ Neil Baud's toolbelt: COMPARE in Forth
 : COMPARE ( a1 n1 a2 n2 -- -1|0|1 )
    ROT  2DUP - >R            ( a1 a2 n2 n1)( R: n2-n1)
    MIN                       ( a1 a2 n3)
    BOUNDS ?DO                ( a1)
        COUNT  I C@  -        ( a1 diff)
        DUP
        IF  ( there's a difference )
            NIP  0< 1 OR      ( -1|1)
            UNLOOP  R> DROP
            EXIT              ( a1 diff)
         THEN  DROP           ( a1)
    LOOP
    DROP                      ( )
    R> DUP IF  0> 1 OR  THEN   \  2's complement arith.
;                              \ 30 BYTES

This works but can be a little slow.  CAMEL Forth's kernel has a string comparison word called S= written in Assembler which is fast. 

It was originally used lookup strings in for the interpreter/compiler.

I don't use it for that purpose now, but I kept it in the kernel for just such an occasion. 

 

S=  needs the follow arguments. ( Addr1 addr2 cnt)  and it returns the same argument as COMPARE.  {this will become significant in a moment}

 

Here we can demonstrate the magic of concatenative programming.  If we look at COMPARE in the first two lines we see.

ROT   2DUP - >R
MIN

The first line rotates n1 to the top of the stack. 2DUP gives us a copy of n2 and n1.

They are subtracted and the difference is saved on the return stack for later use.

The stack now contains  ( addr1 addr2 n2 n1 )

 

MIN throws away the bigger value  of n2 and n1  leaving us with (addr1 addr2 n ) on the stack... exactly what we need for S=.   :)

 

So my fast compare becomes:

: COMPARE  ( addr1 n1 addr2 n2 -- -1|0|1 ) ROT MIN S= ; 

This is much simpler and smaller than writing the entire routine over again in Assembler and will be almost as quick.

 

Once I had a fast compare SEARCH became pretty straight forward. I took the simple route and create a temp buffer for the string we are searching for.

Seems to work as designed.

: COMPARE  ( a1 n1 a2 n2 -- -1|0|1 ) 1+ ROT MIN  S= ;  \ S= is CAMEL Forth primitive

: 2OVER   ( d d2 -- d d2 d) 3 PICK 3 PICK ;
: SAMELEN ( addr1 u1 addr2 u2 -- addr1 u1 addr2 u1) DROP OVER ;

0 VALUE SBUFF     \ temp buffer for search string
: (SRCH)  ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3)
          SBUFF PLACE
          BEGIN
             DUP
          WHILE
             SBUFF COUNT
             2OVER SAMELEN COMPARE
             0= IF  EXIT THEN    ( jump to ';')
             1 /STRING
          REPEAT
;
HEX
: SEARCH ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 flag )
          100 DUP >R MALLOC TO SBUFF
         (SRCH) DUP 0>
          R> MFREE
          0 TO SBUFF ;

 

Edited by TheBF
Added flag to SEARCH per standard
  • Like 1
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...