TF, camel, FB Forth fun

[Willsy]

Wow that's great! I learned something about my own Forth system! 

 

I actually had to type it in to TF and try it. Worked like a charm 

Edited August 3, 2023 by Willsy

[+TheBF]

I used to read Jeff Fox talking about you can do things in Forth with 10X less code. I didn't believe it because "I" couldn't do it.  

 

Over the years I am "starting" to get how you do it but it means really exploring what all these little trivial words do in a Forth system and what else you could use them for.

It seems to be more like an instruction set for a CPU where it takes time to figure out the best way to use the instructions for different situations. 

It's just not obvious what "else" you can do with the wee beasties. 

 

One that made say "WHAT?!"  was using COUNT to index into a stack string. (not a byte counted string)

 

: TYPE   ( addr len -- )  0 DO  COUNT EMIT  LOOP  DROP ; 

 

[Willsy]

Yep. That works too. Though I'll need to study the code to understand why. I'm somewhat rusty! I've never seen COUNT used in a loop like that, so my eyebrows are on the ceiling right now!

[+Lee Stewart]

On 8/2/2023 at 9:49 PM, TheBF said:

I just saw something on comp.lang.forth that I would have never thought of but apparently others have used it. It is not guaranteed to work on all Forth systems.  You need the Forth83 style word CREATE so it doesn't work in FbForth without making that word.

 

Let's say you wanted to create a vector table of these actions that you have written up. 

 

: FIZZ  ;
: BUZZ ;
: BLEEP ; 
: HALT ; 

 

In many Forth systems you can do this to make the table of executable "tokens" (addresses) 

 

CREATE TABLE  ] FIZZ BUZZ BLEEP HALT [ 

For the Forth student: How does it work? Because ] turns on the compiler so the token for each word is looked up in the dictionary and is compiled into memory as each word is parsed.

Then [  turns off the compiler ie: turns on the interpreter again

 

And then to run them you might do something like this.

: DOIT  ( n -- ) CELLS TABLE +  @ EXECUTE ; 

\ Usage: 0 DOIT 1 DOIT  etc. 

(no protection on this example so you can blow up the system if you type 4 DOIT. )   ( I will leave it to the reader to implement protection ) (always wanted to say that)  

 

More stuff you'll probably never need but now you know. 

 

Yeah... CREATE in Forth83 and beyond is virtually the same as VARIABLE , with the difference that VARIABLE reserves and zeroes one cell for the parameter field. Words created with both of those defining words leave the parameter field address of the defined word on the stack when executed. Whereas, in figForth-based Forths like fbForth, CREATE creates the new word with the same kind of header, viz., no parameter field is reserved. The difference is that fbForth’s CREATE stashes the new word’s pfa into its code field, meaning that, upon execution of the new word, its parameter field (nonexistent, unless you defined it separately) will be executed—not usually what you want to happen when trying to use CREATE on the command line. Furthermore, fbForth’s CREATE sets the new word’s smudge bit ( hides the word from -FIND ). The above two functions of fbForth’s CREATE presume CREATE will only be used by other defining words that will modify the contents of the new word’s code field and toggle its smudge bit before concluding the new word’s definition. fbForth’s VARIABLE differs only in that it expects the initial value of the parameter field on the stack instead of automatically zeroing it.

 

For what it’s worth, here is a definition of CREATE83 for fbForth that will function as the CREATE for Forth83 (and beyond):

: CREATE83  <BUILDS DOES> ;

 

 That said, we can kill two birds with one stone by using fbForth’s VARIABLE to store the number of entries in TABLE in the first cell and use that in DOIT for bounds checking (the leave-it-to-the-reader poser):

: CELLS  ( n -- 2n ) 1 SLA ;  \ double n (word not yet in fbForth)

\ Set up TABLE with count as first word in parameter field followed by
\ count cfas to flesh out TABLE.
4 VARIABLE TABLE  ] FIZZ BUZZ BLEEP HALT [ 

: DOIT  ( n -- ) 
   DUP 1 <                    \ n < 1?
   OVER TABLE @ >             \ n > TABLE count?
   OR ABORT" TABLE range!"    \ abort if either test TRUE
   CELLS TABLE +  @ EXECUTE   \ execute nth cfa in TABLE
;

\ Usage: 1 DOIT 2 DOIT  etc. 

 

...lee

[+TheBF]

Very slick using the extra cell. 

[+TheBF]

Over on comp.lang.forth I fellow posted a link to this site. 

It is aruably the cleanest source code to describe a Forth kernel I have ever seen.

Primitives are in intel Assembler and then another file shows the high level words as Forth source. 

 

T3XFORTH - T3X.ORG

 

(I may just try to cross-compile it on TI99 if I get some time) 

[+TheBF]

Over in another thread @InsaneMultitasker posted some code to detect the presence of a SAMS Card.

I am always curious about comparing Assembly Language to Forth.

 

In this case, at least for Camel99 Forth, a couple of extra words are needed from the SAMS library to do this in Forth. 

 

For the Forth curious, here is what I came up with. (un tested at time of posting)

Edit: Tested and it works. 

       But SAMSINI in the DSK1.SAMS file runs when the file compiles and it burps with an error if SAMS is not present.

 

Again I see the low level semantic power of 9900 Assembly language is about the same as Forth primitives.

The gap widens only when we begin making higher level words that we can concatenate to make yet higher level words. 

 

Original code

H0101  data >0101
SAMSDT DATA PLAYWS,$+2
       clr    @0(R13)
       li    r12,>1E00
       sbo 0
       mov    @>4008,R2      ;save whatever was in the mapper for >4000-4fff
       a      @H0101,@>4008  ;change the value    
       c      r2,@>4008      ;is it still the same? 
       jeq    noams          ;yes. can't be SAMS
       seto   @0(R13)        ;no, assume SAMS
       mov    r2,@>4008      ;restore, for futureproofing
noams  sbz 0 
       rtwp

A Forth version

\ For Camel99 Forth 

NEEDS 'R12 FROM DSK1.SAMS

HEX       
: SAMSDT ( -- ?)       \ returns true FLAG if present      
       1E00 'R12 !     \ set CRU to SAMS card
       0SBO            \ Enable the card
       4008 @ >R       \ save whatever was in the mapper on RETURN stack 
       0101 4008 +!    \ change the value 
       R@ 4008 @ <>    \ is it different? (compared to top Rstack)
       R> 4008 !       \ restore previous value to SAMS card
       0SBZ            \ disable the card
;

 

[+TheBF]

While doing some housekeeping on the Direct threaded version of Camel99 I found that I did not have a version of the tail-call optimizing semi-colon. ( -; ) 

I loaded up the one for the indirect threaded system and loaded the bench mark program to see what the debugger would tell me, expecting a big crash. 

 

I was surprised to see that it worked unaltered.  I suspect therefore that it might be easily modified to work in other Forth systems. 

Warning: This version only works if the last word in your definition is a "colon definition" .  It will crash on CODE words, variables and constants. 

 

Background: 

In Chuck Moore's machine Forth he added this -;  operator for the programmer to remove the "call" to the last word in a colon definition and replace it with "jump" to it. 

This removes any use of the return stack for that last word and speeds up the definition. 

 

Here is the code that works on Camel99. 

The GOTO word has to be changed to use the correct "IP" register for a different Forth.

POSTPONE can be replaced with COMPILE in  TurboForth and FbForth

>BODY will need to be defined  or replaced with  the correct math for FbForth. 

 

HEX
 CODE GOTO    C259 , ( *IP IP MOV, ) NEXT, ENDCODE

\ -; does not end with EXIT because it is branching directly to another
\ list of tokens. That other list will end in EXIT or NEXT.
: -;  ( -- ) \ programmer controlled
      HERE 2- @  >BODY      \ get previous XT, compute PFA
     -2 ALLOT               \ erase the previous XT
      POSTPONE GOTO  ,      \ compile GOTO and the PFA
      POSTPONE [            \ turn off compiler
      REVEAL
      ?CSP
; IMMEDIATE

 

Here is a program I used to test the operation of tail-call optimizing. Source: The ultimate Forth Benchmark (theultimatebenchmark.org)  

Spoiler

INCLUDE DSK1.ELAPSE 

: BOTTOM ;
: 1st BOTTOM BOTTOM ;  : 2nd 1st 1st ;      : 3rd 2nd 2nd ;
: 4th 3rd 3rd ;        : 5th 4th 4th ;      : 6th 5th 5th ;
: 7th 6th 6th ;        : 8th 7th 7th ;      : 9th 8th 8th ;
: 10th 9th 9th ;       : 11th 10th 10th ;   : 12th 11th 11th ;
: 13th 12th 12th ;     : 14th 13th 13th ;   : 15th 14th 14th ;
: 16th 15th 15th ;     : 17th 16th 16th ;   : 18th 17th 17th ;
: 19th 18th 18th ;     : 20th 19th 19th ;   


:  1MILLION   CR ."  1 million nest/unnest operations"  20th ;

CR .( start demo like this: )
\ ELAPSE 1MILLION 

INCLUDE DSK1.TAILCALL 
\ recompile with tailcall optimization operator ( -; )
: BOTTOM  ;  \ can't optimze this one because there is no function in it. 
: 1ST BOTTOM BOTTOM -;  : 2ND 1ST 1ST -;      : 3RD 2ND 2ND -;
: 4TH 3RD 3RD -;        : 5TH 4TH 4TH -;      : 6TH 5TH 5TH -;
: 7TH 6TH 6TH -;        : 8TH 7TH 7TH -;      : 9TH 8TH 8TH -;
: 10TH 9TH 9TH -;       : 11TH 10TH 10TH -;   : 12TH 11TH 11TH -;
: 13TH 12TH 12TH -;     : 14TH 13TH 13TH -;   : 15TH 14TH 14TH -;
: 16TH 15TH 15TH -;     : 17TH 16TH 16TH -;   : 18TH 17TH 17TH -;
: 19TH 18TH 18TH -;     : 20TH 19TH 19TH -;   


:  1MILLIONTC  CR ." Optimized 1M nest/unnest operations" 20TH ;

 

 

Here are the results rounded up to nearest second.

Camel99 Forth ITC         Nesting 1Mil  2:31
      w/tail-call optimization          1.55

Camel99 Forth DTC   Nesting 1Mil        2:17
      w/tail-call optimization          1.38

 

[+Lee Stewart]

2 hours ago, TheBF said:

>BODY will need to be defined  or replaced with  the correct math for fbForth. 

 

The fbForth equivalent of >BODY is 2+ in this context.

 

...lee

[+TheBF]

19 minutes ago, Lee Stewart said:

 

The fbForth equivalent of >BODY is 2+ in this context.

 

...lee

Thanks. I thought so, but could not recall the exact dictionary structure. 

 

[+Lee Stewart]

Oh...and another thing:

 

I don’t know the exact definition of REVEAL in CAMEL99 Forth, but similar (identical?) definitions in TurboForth ( HIDDEN ) and fbForth ( SMUDGE ) toggle the hidden/smudge bit and would need to replace REVEAL in the definition of the tail-call optimizing semicolon ( -; ).

 

...lee

[+TheBF]

4 hours ago, Lee Stewart said:

Oh...and another thing:

 

I don’t know the exact definition of REVEAL in CAMEL99 Forth, but similar (identical?) definitions in TurboForth ( HIDDEN ) and fbForth ( SMUDGE ) toggle the hidden/smudge bit and would need to replace REVEAL in the definition of the tail-call optimizing semicolon ( -; ).

 

...lee

Ah yes. 

Brad chose the words HIDE and REVEAL to set/reset the smudge bit. I just kept them as part of the Camel Forth tradition. 

[+TheBF]

I just found this bookmark that I had forgotten about.

If I posted it before my apologies but it has some nice small code solutions.

 

 

https://forth.sourceforge.net/algorithm/

[+TheBF]

I promised @Switch1995 that I would demo some simple words to make strings a little easier to use without a big library.

 

The underlying assumptions here are strings exist on the data stack as a pair: (address, length) I call these a "stack string" 

They are stored in memory as a byte counted string, where the 1st byte holds the length. (max size=255 bytes)

To store a stack string to memory we use PLACE. 

To convert a stored string from memory back to a "stack string" we use COUNT. 

Albert VanderHorst, of CIFORTH calls the $@ (string fetch)  That is a good name in this case. 

 

If you prefer $@ might want to call PLACE  $! .  But PLACE has become the un-official "standard" name for it. 

 

The interesting thing about stack strings is that if you make string functions that leave a stack string on the stack

you don't need a "string stack" where you copy things back and forth from one string to another.

You only need to copy back to memory when you want to retain the result for future use.

 

Here is some code that runs on TurboForth.

\ amazingly versatile string cutter
: /STRING ( caddr1 u1 n - caddr2 u2 ) TUCK - >R + R> ;

\ "place" a string into memory as a byte counted string
: PLACE       ( addr n dst$ -- ) 2DUP C! 1+ SWAP CMOVE ;

\ increment the byte at addr by c
: C+!         ( c addr -- ) DUP C@ ROT + $00FF AND SWAP C! ;

\ append the string addr,n onto the byte counted string $
: +PLACE      ( addr n $addr -- ) 2DUP >R >R  COUNT + SWAP CMOVE  R> R> C+! ;

\ append a single char onto the byte counted string
: APPEND-CHAR ( char $addr -- )  DUP >R COUNT DUP 1+ R> C! + C! ;

\ Since strings live on the stack as addr,len, DUP is all we need
: LEN      ( addr len -- addr len c ) DUP ;

\ emulating TI BASIC SEG$ is this simple
: SEG$     ( addr len n1 n2 -- addr len) >R /STRING  R> NIP ;

 

And if you prefer MS BASIC LEFT$ and RIGHT$ ...

Edit: Oops  I named these backwards the first time. 

: RIGHT$   ( addr len n -- addr len) /STRING ;  \ 🙂
: LEFT$  ( addr len n -- addr len) NIP ;      \ :-)   

 

Example code

\ creating strings is easy
CREATE A$    80 ALLOT
CREATE B$    80 ALLOT
CREATE C$    80 ALLOT

\ assign text to strings with PLACE
S" TI-99 is the ideal gift" A$ PLACE
S" , for the Christmas season" B$ PLACE

\ use PAD as temp storage and append A$ and B$
\ without changing either A$ or B$
A$ COUNT PAD PLACE   B$ COUNT  PAD +PLACE

\ Type the new combined string
PAD COUNT CR TYPE

 

More to come...

[+TheBF]

And a bit more stack string magic for TurbForth

 

SKIP and SCAN come from the intel x86 Forth systems where they used intel strings instructions.

They turned out to be very handy and although not part of the ANS/ISO Standard, most modern systems have them these days. 

On Camel99 they are written in Forth Assembler for speed, but they still perform well in Forth because of the power of stack strings.  

 

\ These look funny because they use WHILE twice.
\ This structure let's us jump out of loops like we do in BASIC and Assembler
\ THEN resolves the 1st WHILE and REPEAT resolves the 2nd WHILE 

\ scan stack string for char. Return a string that starts with CHAR
: SCAN (  adr len char -- adr' len')
        >R                 \ remember char
        BEGIN
          DUP
        WHILE ( len<>0)
          OVER C@ R@ <>    \ test 1st char
        WHILE ( R@<>char)
            1 /STRING      \ cut off 1st char
        REPEAT
        THEN
        R> DROP            \ Rdrop char
;

: SKIP (  adr len char -- adr' len')
        >R     \ remember char
        BEGIN
          DUP
        WHILE ( len<>0)
          OVER C@ R@ =    \ test 1st char
        WHILE ( R@=char)
            1 /STRING      \ cut off 1st char
        REPEAT
        THEN
        R> DROP            \ Rdrop char
;

 

Test code 

\ String literal in colon def. returns a stack string
: A$ ( -- addr len) S" ***********Clean this up!" ;


A$  CR TYPE
\ skip the leading stars in the string, return remaining text
A$  ASCII * SKIP CR TYPE

: B$ S" I wonder where my * went?" ;

\ find * in B$ and return the string from * to end
B$ ASCII * SCAN CR TYPE

 

One my favourites.

: VALIDATE ( char addr len -- ?) ROT SCAN NIP 0<> ;
: PUNCTUATION? ( char -- ?)  S" !@#$%^&,./?';:|[]{}" VALIDATE ;

\ test code
 ASCII : PUNCTUATION? .

 

Edited December 20, 2023 by TheBF
Fixed comment per Lee's input

[Switch1995]

Thanks @TheBF!!  Looking forward to trying this out over the holidays.  Appreciate it 

[+TheBF]

4 minutes ago, Switch1995 said:

Thanks @TheBF!!  Looking forward to trying this out over the holidays.  Appreciate it 

My pleasure.

Note: I labeled left$ and right$ backwards in the first post.  I have edited them.

[+Lee Stewart]

3 hours ago, TheBF said:

: SKIP (  adr len char -- adr' len')
        >R     \ remember char
        BEGIN
          DUP
        WHILE ( len<>0)
          OVER C@ R@ =    \ test 1st char
( *** ) WHILE ( R@<>char)                   ( *** )
            1 /STRING      \ cut off 1st char
        REPEAT
        THEN
        R> DROP            \ Rdrop char
;

 

 

Undoubtedly a victim of “cut and paste”, but the line I bracketed with “( *** )” should read

 

        WHILE ( R@=char)

 

...lee

[+TheBF]

9 hours ago, Lee Stewart said:

 

Undoubtedly a victim of “cut and paste”, but the line I bracketed with “( *** )” should read

 

        WHILE ( R@=char)

 

...lee

Yup. Comment creep.

Thanks Lee.

[GDMike]

I just started playing with the 2Mb ramdisk

It is partitioned as 15 segments of 2024 bytes I believe. 

And the labeling of each drive is using a letter at the tail end, as in, DSKG, DSKH, etc..

Turboforth doesn't seem to like,

S" DSKN.BLOCKS" USE

 

Neither does my SNP filing

But both like numbers 1-3

As in DSK3.

 

BUT the editor/ assembler has no issues loading raw files from the "lettered" drives at all.

Any ideas?

[+TheBF]

2 hours ago, GDMike said:

I just started playing with the 2Mb ramdisk

It is partitioned as 15 segments of 2024 bytes I believe. 

And the labeling of each drive is using a letter at the tail end, as in, DSKG, DSKH, etc..

Turboforth doesn't seem to like,

S" DSKN.BLOCKS" USE

 

Neither does my SNP filing

But both like numbers 1-3

As in DSK3.

 

BUT the editor/ assembler has no issues loading raw files from the "lettered" drives at all.

Any ideas?

Is the word USE in the kernel or is it loaded from disk at startup?

If it's source code we can change it on the disk.

Or we might have to find out what it's doing and write a new one.

 

[+Lee Stewart]

11 minutes ago, TheBF said:

Is the word USE in the kernel or is it loaded from disk at startup?

If it's source code we can change it on the disk.

Or we might have to find out what it's doing and write a new one.

 

It is in the kernel, but I don’t see anything unusual in the code. Nothing checks what comes after “DSK”. The only place bothering with that would be the DSR for the RAMdisk. DSRLNK searches CRU addresses from >1000 to >1F00, which is the same as the E/A DSRLNK.

 

We can write code to read the list in >4000 DSR space for the CRU address where “DSK1” was found to see if “DSKN” exists. There really should be no difference between TurboForth and E/A. We are missing some information from @GDMike, I think.

 

...lee

[GDMike]

9 hours ago, Lee Stewart said:

 

It is in the kernel, but I don’t see anything unusual in the code. Nothing checks what comes after “DSK”. The only place bothering with that would be the DSR for the RAMdisk. DSRLNK searches CRU addresses from >1000 to >1F00, which is the same as the E/A DSRLNK.

 

We can write code to read the list in >4000 DSR space for the CRU address where “DSK1” was found to see if “DSKN” exists. There really should be no difference between TurboForth and E/A. We are missing some information from @GDMike, I think.

 

...lee

I'll Play with it some more and make sure that the "USE" is properly set as I just went off the top of my head on its format syntax, but I'm not sure until I look at the book again.

I'll also try creating, I think it's (makeblock)? Or makedisk? And make sure that's ok as well.

TBD thx lee

Edited December 21, 2023 by GDMike

[GDMike]

9 hours ago, TheBF said:

Is the word USE in the kernel or is it loaded from disk at startup?

If it's source code we can change it on the disk.

Or we might have to find out what it's doing and write a new one.

 

Sorry for replying late, yes, USE is part of boot up words in the kernel.

Edited December 21, 2023 by GDMike

[GDMike]

10 hours ago, Lee Stewart said:

 

It is in the kernel, but I don’t see anything unusual in the code. Nothing checks what comes after “DSK”. The only place bothering with that would be the DSR for the RAMdisk. DSRLNK searches CRU addresses from >1000 to >1F00, which is the same as the E/A DSRLNK.

 

We can write code to read the list in >4000 DSR space for the CRU address where “DSK1” was found to see if “DSKN” exists. There really should be no difference between TurboForth and E/A. We are missing some information from @GDMike, I think.

 

...lee

Everything works! No changes needed.

My problem was the FinalGrom was goofed up and after reloading it then everything in tf was ok.

Sorry for that confusion. Screenshot shows success on creating a block file, and I tested the 'USE" word successfully as well.

 

@shift838 and I have been trying to diagnose an issue with my FG and it turned out to be a incompatible SD card that seemed to work but didn't. 

 

Edited December 21, 2023 by GDMike