Camel99 Forth Information goes here

[+TheBF]

It doesn't really.  The primitives have to be written so they do the proper housekeeping. So anything that uses the TOS must push R4 onto the "real stack" first and anything that wants to clear the stack after use must POP the stack into R4. (ie: refill the TOS)

So  !  is:

CODE: !      ( n addr -- )
             *SP+ *TOS MOV, 
              TOS POP,     ( CLEAN UP HERE)
              NEXT,         
              END-CODE

 

[+TheBF]

Been a while since I posted here.  

I have been working on the Native code cross-compiler off and on and part of that work has led me to look at changing the ASM9900 Assembler that is part of Camel Forth.

It was heavily based on the TI-Forth assembler but I was never happy with the unnecessary complexity in the IF/ELSE/ENDIF  and looping words.  

Since the Forth Assembler is running in interpreter mode there was no need for immediate words and the original TI version did not factor out some common code elements IMHO.

 

So I replaced this spoiler:

Spoiler

: CJMP CASE
         LT OF 1101 , 0 ENDOF
         GT OF 1501 , 0 ENDOF
         NO OF 1901 , 0 ENDOF
         OP OF 1C01 , 0 ENDOF
         DUP 0< OVER 10 > ABORT" IF, BAD jump token"
       ENDCASE >< 1000 + , ;

CR .( Structured branching and looping )
\ *These words do compile time error catching with ?PAIRS *
: IF,    ?EXEC ( only useable in immediate mode)
         CJMP HERE  2-  42 ; IMMEDIATE

: ENDIF,  ?EXEC
          42 ?PAIRS
          HERE OVER - 2- 2/ SWAP CHAR+ C! ; IMMEDIATE

: ELSE,   ?EXEC
          42 ?PAIRS
          0  CJMP HERE 2- SWAP
          42 POSTPONE ENDIF,  42 ; IMMEDIATE

: BEGIN,  ?EXEC      HERE 41 ; IMMEDIATE

: UNTIL,   ?EXEC
           SWAP 41 ?PAIRS
           CJMP HERE - 2/ 00FF AND
           HERE 1- C! ; IMMEDIATE

: AGAIN,  ?EXEC   0 POSTPONE UNTIL, ; IMMEDIATE

: REPEAT,  ?EXEC
           >R >R    POSTPONE AGAIN,
           R> R> 2- POSTPONE ENDIF, ; IMMEDIATE

: WHILE,   ?EXEC    POSTPONE IF,  CELL+ ; IMMEDIATE

 

 

with:

: AJUMP,  ( token --) >< 1000 + , ;  \ Use token & compile a jump instruction
: RESOLVE ( byte --)  2- 2/ SWAP 1+ C! ; \ compute offset & compile into a jump
: <BACK   ( addr addr' -- ) TUCK -  RESOLVE ;

: IF,     ( token -- addr) HERE SWAP AJUMP, ;
: ENDIF,  ( addr --)  HERE OVER -  RESOLVE ;
: ELSE,   ( -- addr ) HERE 0 JMP, SWAP ENDIF, ;

: BEGIN,  ( -- addr)  HERE ;
: WHILE,  ( token --) IF, SWAP ;
: AGAIN,  ( addr --)  HERE  0 JMP, <BACK ;
: UNTIL,  ( addr token --) HERE SWAP AJUMP, <BACK ;
: REPEAT, ( addr -- ) AGAIN, ENDIF, ;

The TI Assembler also added some extra jump tokens by doing a bit of compiler magic. I removed that and so we are left with only the CPU conditional jumps.

This can be confusing however because the name of the token is the opposite of the instruction that it compiles.

This is because the IF,  jumps over your code to ENDIF, when the status flag is true for the specific jump.

CR .( Jump tokens)
HEX                  \ Action if TRUE
 01 CONSTANT GTE     \ JLT to ENDIF,
 02 CONSTANT HI      \ JLE to ENDIF,
 03 CONSTANT NE      \ JEQ to ENDIF,
 04 CONSTANT LO      \ JHE to ENDIF,
 05 CONSTANT LTE     \ JGT to ENDIF,
 06 CONSTANT EQ      \ JNE to ENDIF,
 07 CONSTANT OC      \ JNC to ENDIF,
 08 CONSTANT NC      \ JOC to ENDIF,
 09 CONSTANT OO      \ JNO to ENDIF,
 0A CONSTANT HE      \ JLO to ENDIF,
 0B CONSTANT LE      \ JH  to ENDIF,
 0C CONSTANT NP      \ JOP to ENDIF,

This version is about 240 bytes smaller than the original. I will use it for while to see if I miss they extra jump tokens.

 

 

[Willsy]

Those structured jump tokens are the jewel in the crown of the Forth assembler (for me)!

 

Merry Christmas!

 

Mark

[+TheBF]

5 minutes ago, Willsy said:

Those structured jump tokens are the jewel in the crown of the Forth assembler (for me)!

 

Merry Christmas!

 

Mark

And a Happy Christmas to you sir.

Yes they are pretty magical aren't they.

[+Lee Stewart]

8 hours ago, TheBF said:

This version is about 240 bytes smaller than the original. I will use it for while to see if I miss they extra jump tokens.

 

Very nice!

 

FYI: If you do return to using your previous ASM9900, CJMP is missing an OR before ABORT" .

 

...lee

[+TheBF]

Lol. Thanks.

 

I noticed that too.

 

I need a can of RAID.

 

[+TheBF]

6 hours ago, Lee Stewart said:

 

Very nice!

 

FYI: If you do return to using your previous ASM9900, CJMP is missing an OR before ABORT" .

 

...lee

And if you wanted to reduce the size of the old code this seems to work fine.

 

EDIT: Repaired with Lee's eagle eyes.  I  replaced the  error detection with OR to use WITHIN which is a CODE word in CAMEL99.

 

: CJMP CASE
         LT OF 1101 , 0 ENDOF
         GT OF 1501 , 0 ENDOF
         NO OF 1901 , 0 ENDOF
         OP OF 1C01 , 0 ENDOF
         DUP 11 0 WITHIN ABORT" BAD jump token"
         DUP
       ENDCASE >< 1000 + , ;

: IF,      CJMP HERE  2-  42 ;

: ENDIF,  42 ?PAIRS
          HERE OVER - 2- 2/ SWAP CHAR+ C! ;

: ELSE,   42 ?PAIRS
          0  CJMP HERE 2- SWAP
          42 ENDIF,  42 ;

: BEGIN,   HERE 41 ;

: UNTIL,   SWAP 41 ?PAIRS
           CJMP HERE - 2/ 00FF AND
           HERE 1- C! ;

: AGAIN,   0  UNTIL, ;

: REPEAT,  >R >R     AGAIN,
           R> R> 2-  ENDIF, ;

: WHILE,   IF,  CELL+ ;

 

[+Lee Stewart]

2 hours ago, TheBF said:

EDIT: Tried this on some longer test code and it failed.

 

Sorry, I forgot why your original CJMP appeared to work without the OR ! You also forgot the DUP after the ABORT" message so ENDCASE has something innocuous to drop from the stack. This was unnecessary with 2 unORred values on the stack, which was wrong because trapping only numbers greater than 10 allowed negative jump tokens.

 

...lee

[+TheBF]

2 hours ago, Lee Stewart said:

 

Sorry, I forgot why your original CJMP appeared to work without the OR ! You also forgot the DUP after the ABORT" message so ENDCASE has something innocuous to drop from the stack. This was unnecessary with 2 unORred values on the stack, which was wrong because trapping only numbers greater than 10 allowed negative jump tokens.

 

...lee

Thanks. That's super.

[+TheBF]

I replaced the code in the previous post with some that works. Thanks again Lee!?

[+TheBF]

Introducing the CODEX

 

Ever since I got the ANS/ISO Forth wordlists working for Camel99 I had been wondering if somehow I could marry that concept to managing SAMS memory with Forth code compiled into it.

SAMS memory for DATA was pretty simple in hindsight but managing how you search through extended memory with the Forth compiler was a bigger challenge.

I am not sure this is the ideal but I will play with it. My hope is to get to place where the search order of wordlists controls what the system can see at any given time.

 

Summary:

The CODEX is modified VOCABULARY that creates modules of code to be compiled into SAMS memory.

Each module is its own name space that can be linked to the dictionary by invoking its name.

 

I had the word VOCABULARY which is named wordlist that puts itself at the front of the compiler's name space search order.

What could I call such that thing that lived in SAMS memory and contained code? I settled on the word CODEX which is what bound books were called when they were first invented. 

Since I was stuffing "code" into them the name stuck with me.

 

How it works:

The normal wordlist has 4 fields:

• Pointer to the wordlist
• Name field address of the last word in the wordlist
• link field to the previous wordlist in the system
• name field address of the name of the this wordlist (ie: pointer to a counted string) 
  
  To this I added:
• SAMS page# that this wordlist uses
• Pointer to the Dictionary variable for this wordlist ( ie: where we compile new code in SAMS memory space)  
   

Currently the rules are:

• You pre-define the CODEX that you want to use in the Forth vocabulary before you begin to compile code into it.
• The code page is at >E000
• A VOCABULARY now resets SAMS to the pass through value for >E000
• When you define a new CODEX you give it the SAMS page# as a parameter, which it remembers. 
• A CODEX automatically maps in its page# when it's name is invoked and changes the compiler's dictionary pointer to that of the CODEX
   
• You need to bracket your SAM definitions with SAMS:   ;SAMS  
  • SAMS: currently remembers the Forth dictionary pointer
  • ;SAMS  updates the CODEX dictionary pointer after you have added code to it, puts FORTH at the front of the search order and restores Forth's previous dictionary pointer.

Here is how the code looks when you use it:

 

Spoiler

\ CODEX tests.

\ create the CODICES
ONLY FORTH DEFINITIONS
HEX
F0 CODEX MISC   
F1 CODEX FILES
F2 CODEX TOOLS
F3 CODEX ASM

ONLY FORTH ALSO MISC DEFINITIONS
SAMS:
DECIMAL
  : STAR    42 EMIT ;
  : STARS   0 ?DO  STAR LOOP ;
  : HI      CR ." Hello world from SAMS memory!" ;
;SAMS

ONLY FORTH ALSO FILES DEFINITIONS
SAMS:
   INCLUDE DSK1.ANSFILES
   INCLUDE DSK1.DIR
   INCLUDE DSK1.CATALOG
   INCLUDE DSK1.MORE
   INCLUDE DSK1.BLOCKS
;SAMS

ONLY FORTH ALSO TOOLS DEFINITIONS
SAMS:
   INCLUDE DSK1.TOOLS
   INCLUDE DSK1.ELAPSE
;SAMS

ONLY FORTH ALSO ASM DEFINITIONS
SAMS:
    INCLUDE DSK1.ASM9900
;SAMS

 

 

Limitations in this version:

You cannot nest definitions across SAMS pages. You can only really work with Forth + 1 CODEX at a time. (not totally cool, but it's a start)

When you put new definitions in a CODEX the search order must also contain Forth. 

The only use case for this I can think of is as an integrated development system with the Forth compiler, Assembler, editor and misc tools all available instantly on real iron.
This code only works on KERNEL 2.66 which I have not released yet.  2.66 contains a CONTEXT array of 9 elements for search order control and a CURRENT variable.

 

Future

This seems waaay to complicated way to accomplish this job with the only advantage being sealed name spaces. It also takes 1K of code just for the extended wordlist system.

I can imagine using a pre-allocated set of SAMS pages, at the top of SAMS, make them a linked list that we search through from highest lowest until we find the Forth word we are looking for

FIND would only need a SAMS scanning section and then fall into the normal FORTH dictionary search. Sounds much simpler.

 

But I had to try.  

 

For those with a masochistic bent...

Spoiler

\ wordlist+.fth   for CAMEL99 FORTH    Oct 2020 Brian Fox
\ Dec 28, 2020: Added CODEX: to create wordlists in SAMS page

\ Code adapted from Web: https://forth-standard.org/standard/search
\
\ 'wid' is a word-list ID.
\ Holds the address of the last Forth word in the list
\ In Camel Forth terms, wid is a pointer to a Name field address (NFA)

\ This implementation uses a pre-defined CONTEXT array to hold the
\ ROOT wordlist plus 8 user defined wordlists

\ Dec 2020: Removed SET-CURRENT to save precious bytes

\ NEEDS .S     FROM DSK1.TOOLS
NEEDS SAMSCARD FROM DSK1.SAMSFTH

HERE
DECIMAL
  VARIABLE #ORDER       \ No. of active wordlists
  1 #ORDER !            \ init the #order to 1
  VARIABLE WID-LINK     \ Pointer to the most recently defined wordlist.

\ *NEW STUFF*
\ =============================================
\ SAMS memory management for code
HEX              E000 CONSTANT CSEG      \ CPU RAM window for SAMS code
4000 CSEG 0B RSHIFT + CONSTANT CREG      \ compute CSEG SAMS register
CSEG 4 RSHIFT         CONSTANT PASSTHRU  \ default SAMS page for >E000

\ "CMAP"  brings pages of code into the window called CSEG
\ *should be CODE for best speed
: CMAP ( bank# -- )    \ ** bank# must be in low byte**
      SAMSCARD 0SBO     \ turn on the card
      ( bank#) CREG !   \ store bank# in SAMS register
      0SBZ ;            \ turn off card

HEX
: WORDLIST ( -- wid)  \ 5 cell expanded wordlist data structure
   HERE  0 ,                \ nfa of last word defined in wordlist
   WID-LINK @ , WID-LINK !  \ link to previous wordlist
   LATEST @ ,               \ Name field. NFA of the name of this wordlist
   PASSTHRU ,               \ code page field. Default is PASSTHRU
   DP ,                     \ Pointer to Forth's DP
;
\ *NOTE*  We use a pointer to DP so that every vocabulary can see the actual
\         FORTH DP variable via it's own local pointer

CREATE FORTH-WORDLIST  WORDLIST
CREATE ROOT   WORDLIST

HEX ( Index into CONTEXT array. Code is same size but faster)
CODE ]CONTEXT ( n -- addr)   \ CELLS CONTEXT + ;
           A104 ,            \  TOS TOS ADD,
           0224 , CONTEXT ,  \  TOS CONTEXT AI,
           NEXT,
           ENDCODE

: GET-ORDER ( -- widn ... wid1 n ) \ *Note* reversed order on stack
   #ORDER @ 0
   ?DO
     #ORDER @ I - 1- ]CONTEXT @
   LOOP
  #ORDER @
;

DECIMAL
: SET-ORDER ( wid1x ... wid1 n -- )  \ n cannot be 0
   DUP TRUE =
   IF
     DROP           \ drop flag, push default wordlists
     ROOT DUP 2     \ 2 copies of ROOT so it's always there
   THEN
   DUP  9 1 WITHIN ABORT" #ORDER range[1..8]"
   DUP #ORDER !
   0 ?DO  I ]CONTEXT !  LOOP
;

: ALSO ( -- ) GET-ORDER OVER SWAP 1+ SET-ORDER ;
: ONLY ( -- ) TRUE SET-ORDER ;  \ sets default search order
: PREVIOUS    ( -- ) GET-ORDER NIP 1- SET-ORDER ;

\ extra fields in a CODEX type wordlist are referenced by CONTEXT
\ Use them like variables
: CELLS+   ( n -- n')  CELLS + ;
: SAMSPAGE ( -- addr)  CONTEXT @ 3 CELLS+ ;
: SAMSDP   ( -- addr)  CONTEXT @ 4 CELLS+ @ ;

: SET-CONTEXT ( wid -- ) \  place 'wid' at beginning of search order
       >R
       GET-ORDER NIP       \ remove 1st 'wid'
       R>                  \ put this 'wid in the order
       SWAP SET-ORDER      \ make it so
       SAMSPAGE @ CMAP     \ map sams page for this codex
;

: DEFINITIONS ( -- ) CONTEXT @ CURRENT ! ;

: VOCABULARY  ( wid -- )   \ create a named vocabulary
      CREATE
          HERE CELL+ ,        \ pointer to the wordlist structure
          WORDLIST            \ create the wordlist structure
      DOES> @ SET-CONTEXT
;

: CODEX  ( page# -- )     \ A special wordlist in SAMS memory
    CREATE
      HERE CELL+ ,             \ pointer to the wordlist structure
      HERE  0 ,                \ nfa of last word defined in wordlist
      WID-LINK @ , WID-LINK !  \ link to previous wordlist
      LATEST @ ,               \ compile NFA of the name of this wordlist
      ><  ,                   \ SAMS page field (swapped bytes)
\ *codex difference: has a pointer to a local DP variable
      HERE CELL+ ,            \ pointer to a local DP variable
      CSEG ,                  \ CODEX local DP field, defaults to >E000
    DOES> @ SET-CONTEXT
          SAMSDP @ DP !
;

HEX
: .WID  ( wid -- ) 2 CELLS+ @ COUNT 1F AND TYPE ;
: ORDER ( -- )  \ display search order by wordlist name
   CR ." Order: "
   GET-ORDER 0 DO   .WID  SPACE   LOOP
   CR ." Current: " CURRENT @ .WID CR ;

\ 6.1.1550 Extend FIND to search all active wordlists
\ *NEW*
\ Map in the correct CSEG for each vocabulary then search for the string
: FIND12 ( c-addr -- c-addr 0 | xt 1 | xt -1 )
      FALSE             \ default flag
      CONTEXT #ORDER @ CELLS ( -- addr size)
      BOUNDS  \ compute: end-address,start-address
      ?DO
          OVER I @              \ get context for this vocabulary
          @ (FIND)              \ now we can try and find the string
          ?DUP
           IF
              2SWAP 2DROP
              UNLOOP
              EXIT
           THEN
           DROP
       2 +LOOP
;

: FORTH  ( -- ) FORTH-WORDLIST SET-CONTEXT ;
  CONTEXT @ @  FORTH-WORDLIST !  \ patch FORTH-WORDLIST to existing dictionary

  FORTH   \ Forth is now the "CONTEXT" wordlist , using passthru RAM

\ "minimum search order shall include the words FORTH-WORDLIST & SET-ORDER"
ROOT CURRENT !  \ Add these definitions go to the ROOT WORDLIST
: FORTH-WORDLIST  FORTH-WORDLIST ;
: SET-ORDER       SET-ORDER ;
: FORTH  FORTH ;
: ONLY   ONLY  ;
: ALSO   ALSO  ;
: ORDER  ORDER ;
: DEFINITIONS  DEFINITIONS ;

ONLY FORTH DEFINITIONS

VARIABLE TEMP
: SAMS:  ( -- addr)   DP @ TEMP ! ;

: ;SAMS   ( addr --)
          DP @ SAMSDP !     \ UPDATE codex DP field
          FORTH             \ switch back to Forth
          TEMP @ SAMSDP !   \ restores actual DP variable via FORTH-WORDLIST
;

\ patch FIND to become FIND12
 ' FIND12 'FIND !
HERE SWAP - DECIMAL SPACE . .( bytes) CR
HEX

 

 

 

[+TheBF]

So I have been noodling away on different strategies to use SAMS for Code and had an insight in how to map in a page a bit faster than what I was doing before.

 

HEX              E000 CONSTANT CSEG \ CODE SEG
CSEG 0B RSHIFT 4000 + CONSTANT CREG \ compute CSEG SAMS register

VARIABLE PAGE#    1000 PAGE# !
CODE MAPPED ( addr -- offset-addr)
         TOS R0 MOV,
         TOS FFF ANDI,
         R0 F000 ANDI,
         R0 PAGE# @@ CMP,
         NE IF,
              R12 1E00 LI,
              0 SBO,
              R0 PAGE# @@ MOV,
              R0 CREG @@ MOV,
              0 SBZ,
         ENDIF,
         TOS CSEG AI,
         NEXT,
ENDCODE

This code assumes you are starting at SAMS page >10. I like to have contiguous blocks of SAM memory so I avoid the low pages.

I also assumes you are using one 4K window in the CPU RAM memory map.

It probably should add >1000 to input addr argument.

But as is it takes 11 instructions with no DIV and my old code use 14 instructions with a DIV instruction.

It might be useful to someone out there who hasn't already discovered this.

 

 

 

 

[+Lee Stewart]

11 hours ago, TheBF said:

So I have been noodling away on different strategies to use SAMS for Code and had an insight in how to map in a page a bit faster than what I was doing before.

 

I am really not sure I understand what you are doing here. It looks like addr is a 64-KiB address in only the lowest 64 KiB of SAMS in use:

       R0 F000 ANDI,
         ...
       R0 CREG @@ MOV,

I also do not see how it avoids the pass-through pages.

 

...lee

[+TheBF]

1 hour ago, Lee Stewart said:

 

I am really not sure I understand what you are doing here. It looks like addr is a 64-KiB address in only the lowest 64 KiB of SAMS in use:

       R0 F000 ANDI,
         ...
       R0 CREG @@ MOV,

I also do not see how it avoids the pass-through pages.

 

...lee

You are correct, to avoid pass through pages you would have to add a line at the top

TOS 1000 AI,

This would automatically avoid pass-through pages but also limit using a full 64K address.

 

 

The thing that jumped out at me was that give an address >3456 :

• The SAMS page number to feed into the register is >3000  
• The remaining digits >0456  are the offset into the "window" , as I call it, in CPU RAM.

Now to be fair this might only work with 4Mbyte cards on real iron, but it works on Classic99.

On a 1Mbyte real card I might have to convert >3000 to >3030 .  Have not tested it yet.

 

Anyway it was just a little light bulb that went off and the code worked.  I am not using it in the real application yet.

 

I am working only in Forth to get things going which is getting close... 

 

Forth code in SAMS memory, as named modules, that can be arranged in a search order for the  system to find the names.

Coming soon ... I hope.

 

[+Lee Stewart]

51 minutes ago, TheBF said:

. . . to avoid pass through pages you would have to add a line at the top

TOS 1000 AI,

This would automatically avoid pass-through pages but also limit using a full 64K address.

 

Would it? Would not >F123 + >1000 = >0123 due to loss of the MSb, which would expose a pass-through page, I think.

 

...lee

[+TheBF]

1 minute ago, Lee Stewart said:

 

Would it? Would not >F123 + >1000 = >0123 due to loss of the MSb, which would expose the pass-through page, I think.

 

...lee

Yes.  But >E123 +>1000 would still work...

 

It's clearly not an ideal solution.

In my defense it was very late. That's my story and I'm sticking to it.

 

 

[+TheBF]

4 hours ago, TheBF said:

Yes.  But >E123 +>1000 would still work...

 

It's clearly not an ideal solution.

In my defense it was very late. That's my story and I'm sticking to it.

 

 

Happy 2021 Lee.  It can only get better.

 

[+Lee Stewart]

3 minutes ago, TheBF said:

Happy 2021 Lee.  It can only get better.

 

Likewise, My Friend!  

 

...lee

[+TheBF]

Forth Code in SAMS: CODEX II 

 

I had been so close to success with the idea of using a Forth  WORDLIST and the Forth 2012 search order management idea that I thought I would try and see it through.

This took much longer than I ever thought it would but I am very excited about the possibilities. 

 

Currently I can compile code into Forth + 7 other CODEXs (CODICES?)

So this gives me an extra 28K of code space.  If I change to using 8K code segments that will expand to 56K of extra code space.

If I want to expand the size of the context array from 8 to whatever I could go bigger still. 

 

Review

Forth 2012 standardized a way to manage "wordlists". These are name spaces for the compiler. A standard system is supposed to provide a minimum of 8 wordlists in the search order. 

The newest Camel99 kernel does this plus one "root" wordlist that is the default wordlist with a hand-full of commands in it.

Each wordlist provides what is called a  "context" for the system to search.

Forth words are found by the compiler/interpreter by searching each "context" in the search order array until the word is found or we hit the end of the last wordlist.

 

The thing that made the difference

I have finally cracked the nut on adding Forth code in SAMS memory and giving the interpreter access to all the routines that are in the search order, even if the code is in SAMS memory.

It turned out the secret was in correctly modifying the FIND code which I left to the last, thinking it was not that important.  

 

Actually this version lets you compile new code in a SAMS CODEX that uses routines from other SAMS pages ( with some limitations) and I am not sure how that is really happening!  

It has a lot to do, I am pretty sure, with the fact that I use the Forth return stack to save the state of the dictionary when I enter the search word FINDCDX.

 

FINDCDX is therefore more complicated than the earlier version.

: FINDCDX ( c-addr -- c-addr 0 | xt 1 | xt -1 )
      DP @  CONTEXT @ 2>R   \ push dictionary pointers

      FALSE                  \ default flag
      CONTEXT #ORDER @ CELLS ( -- addr size)
      BOUNDS
      ?DO
          OVER I @  ( -- wid)
          DUP >MYPAGE @ CMAP   \ map context SAMS page
          DUP >MYDP @ DP !     \ set DP to local DP
          @ (FIND)             \ search the linked list
          ?DUP
           IF
              2SWAP 2DROP
              LEAVE
           THEN
           DROP
       2 +LOOP
       2R> CONTEXT ! DP ! ;  \ restore dictionary

 

 

A CODEX structure needs 2 more fields than a wordlist:

1. SAMS page number
2. pointer to a local dictionary pointer variable for the CODEX. (this variable is one cell at the end of the 4K SAMs page.
    

I will prepare a little demo video to show how it works but here is some code that illustrates that it is pretty seamless ANS Forth.  

 

\ CODEX tests.

HEX
 CODEX MISC
 CODEX FILES
 CODEX TOOLS
 CODEX ASM


 ONLY FORTH ALSO TOOLS DEFINITIONS
 INCLUDE DSK1.TOOLS
 INCLUDE DSK1.ELAPSE

 ONLY FORTH ALSO ASM DEFINITIONS
 INCLUDE DSK1.ASM9900

ONLY FORTH ALSO FILES DEFINITIONS
INCLUDE DSK1.ANSFILES
INCLUDE DSK1.DIR

\  All compiler to search all wordlists
ONLY FORTH  ALSO FILES  ALSO TOOLS  ALSO ASM ALSO MISC DEFINITIONS
  : STAR    42 EMIT ;
  : STARS   0 ?DO  STAR LOOP ;
  : HI      CR ." Hello world from SAMS memory!" ;

\ Use DIR from external CODEX   :)
  : NEWDIR   CR ." My directory"  CR DIR  ;

Here is the version that I am beating up right now.

 

Spoiler

\ CODEXII.fth   for CAMEL99 FORTH    Jan 2, 2021 Brian Fox
\ Code adapted from Web: https://forth-standard.org/standard/search

\ ************************************************************************
\ *                >>CANNOT BE USED WITH WORDLISTS.FTH<<                 *
\ * In this system all wordlist live in SAMS memory in a window at >E000 *
\ * Wordlists cannot exceed 4K of code.                                  *
\ ************************************************************************

\ 'wid' is a word-list ID.
\ Holds the address of the last Forth word in the list
\ In Camel Forth terms, wid is a pointer to a Name field address (NFA)

\ This implementation uses a pre-defined CONTEXT array to hold the
\ ROOT wordlist plus 8 user defined wordlists. (Camel99 V2.66 and after)

\ Dec 2020: Removed SET-CURRENT to save precious bytes

NEEDS .S     FROM DSK1.TOOLS
NEEDS 0SBO   FROM DSK1.SAMSFTH

MARKER REMOVE
HERE
\ HERE
\ *NEW STUFF*
\ =============================================
\ SAMS memory management for code
HEX              E000 CONSTANT CSEG      \ CPU RAM window for SAMS code
                 000E CONSTANT PASSTHRU  \ default sams page
4000 CSEG 0B RSHIFT + CONSTANT CREG      \ compute CSEG SAMS register
CSEG 0FFE +           CONSTANT MYDP      \ dp local storage for each page


 EF CREATE PAGE# ,     \ sams page pointer starts at >EF
: NEWPAGE ( - n)  PAGE# 1+! PAGE# @ ;

\ "CMAP"  brings pages of code into the window called CSEG
\ *should be CODE for best speed
: CMAP ( page# -- )
      ><
      SAMSCARD 0SBO     \ turn on the card
      ( bank#) CREG !   \ store bank# in SAMS register
      0SBZ ;            \ turn off card

HEX ( Machine code is same size but faster)
CODE ]CONTEXT ( n -- addr)   \ CELLS CONTEXT + ;
      A104 ,            \  TOS TOS ADD,
      0224 , CONTEXT ,  \  TOS CONTEXT AI,
      NEXT,
      ENDCODE

CODE CELLS+ ( addr n -- addr') \  2* +
      A104 ,  A136 ,  NEXT,
ENDCODE

DECIMAL
  VARIABLE #ORDER       \ No. of active wordlists
  1 #ORDER !            \ init the #order to 1
  VARIABLE WID-LINK     \ Pointer to the most recently defined wordlist.

HEX
: WORDLIST ( -- wid)
   HERE
   0 ,                      \ *NFA* of last word defined in wordlist
   WID-LINK @ , WID-LINK !  \ link to previous wordlist
   LATEST @ ,               \ compile NFA of the name of this wordlist
;

DECIMAL
\ Added fields                  SAMS page   dictionary variable
CREATE FORTH-WORDLIST  WORDLIST  PASSTHRU ,  DP ,
CREATE ROOT            WORDLIST  PASSTHRU ,  DP ,

: GET-ORDER ( -- widn ... wid1 n ) \ *Notice reversed order on stack
   #ORDER @ 0
   ?DO
     #ORDER @ I - 1- ]CONTEXT @
   LOOP
  #ORDER @
;

DECIMAL
: SET-ORDER ( wid1x ... wid1 n -- )  \ n cannot be 0
   DUP TRUE =
   IF
     DROP           \ drop flag, push default wordlists
     ROOT DUP 2     \ 2 copies of ROOT so it's always there
   THEN
   DUP  9 1 WITHIN ABORT" #ORDER range[1..8]"
   DUP #ORDER !
   0 ?DO  I ]CONTEXT !  LOOP
;

DECIMAL
: ALSO ( -- ) GET-ORDER OVER SWAP 1+ SET-ORDER ;
: ONLY ( -- ) TRUE SET-ORDER ;  \ sets default search order
: PREVIOUS    ( -- ) GET-ORDER NIP 1- SET-ORDER ;
: SET-CONTEXT ( wid -- ) \  place 'wid' at beginning of search order
       >R
       GET-ORDER NIP       \ remove 1st 'wid'
       R>                  \ put this 'wid in the order
       SWAP SET-ORDER ;    \ make it so

: DEFINITIONS ( -- ) CONTEXT @ CURRENT ! ;

\ named access to the CODEX fields
: >MYPAGE ( wid -- addr) 3 CELLS+ ;
: >MYDP   ( wid -- addr) 4 CELLS+ @ ; \ field is a pointer to a variable

: CODEX ( -- )   \ create a vocabulary in SAMS memory
    CREATE
      WORDLIST
      NEWPAGE CMAP    \ pull in my page right now for setup
      CSEG MYDP !     \ init local DP for this SAMS page
( 3)   PAGE# @ ,      \ compile my SAMS page
( 4)   MYDP  ,        \ compile my DP variable address (in SAMS page)
       PASSTHRU CMAP  \ return to normal RAM

    DOES> SET-CONTEXT
;

HEX
: .WID  ( wid -- ) [ 2 CELLS ] LITERAL + @ COUNT 1F AND TYPE ;

: ORDER ( -- )  \ display search order by wordlist name
   CR ." Order: "
   GET-ORDER 0 DO   .WID  SPACE   LOOP
   CR ." Current: " CURRENT @ .WID CR ;

\ The secret is FINDCDX saves dictionary context on return stack
\ As it goes through each wordlist in the search ORDER it enables
\ the SAMS page and and moves DP up to the SAMS window.
\ It restores the dictionary when it completes.
: FINDCDX ( c-addr -- c-addr 0 | xt 1 | xt -1 )
      DP @  CONTEXT @ 2>R   \ push dictionary pointers

      FALSE                  \ default flag
      CONTEXT #ORDER @ CELLS ( -- addr size)
      BOUNDS
      ?DO
          OVER I @  ( -- wid)
          DUP >MYPAGE @ CMAP   \ map context SAMS page
          DUP >MYDP @ DP !     \ set DP to local DP
          @ (FIND)             \ search the linked list
          ?DUP
           IF
              2SWAP 2DROP
              LEAVE
           THEN
           DROP
       2 +LOOP
       2R> CONTEXT ! DP ! ;  \ restore dictionary

: FORTH  ( -- ) FORTH-WORDLIST SET-CONTEXT ;

  CONTEXT @ @  FORTH-WORDLIST !  \ patch FORTH-WORDLIST to existing dictionary

  FORTH   \ Forth is now the "CONTEXT" wordlist

\ "minimum search order shall include the words FORTH-WORDLIST & SET-ORDER"
ROOT CURRENT !  \ Add these definitions to the ROOT WORDLIST
: FORTH-WORDLIST  FORTH-WORDLIST ;
: SET-ORDER       SET-ORDER ;
: FORTH  FORTH ;
: ONLY   ONLY  ;
: ALSO   ALSO  ;
: ORDER  ORDER ;
: DEFINITIONS  DEFINITIONS ;

ONLY FORTH DEFINITIONS

\ patch FIND to become FIND12
 ' FINDCDX 'FIND !
HERE SWAP - DECIMAL SPACE . .( bytes) CR
HEX

 

 

 

[+TheBF]

Well all my excitement and another $3.50 will get you a coffee at Star Bucks.

 

After posting, yesterday evening I started looking for how the CODEX code could compile words from another codex and work correctly.

The reason was because the code was all compiling into CPU RAM!  Duh!

 

In my first version I used the SAMS:   ;SAMS  words to make everything compile into the SAMS page.

After fixing FIND everything worked so well I thought I was a wizard but really I'm a dunce.

 

I think I can fix it by enhancing DEFINITIONS so that it sets the SAMS page by using the CURRENT wordlist and setting its SAMS page. 

The Forth wordlist has been given the pass-thru page and it's own DP value so it will behave normally when selected.

After that FIND can dance around inside the matrix of pages but will restore the CURRENT page when it's done because it uses the return stack to save the CURRENT page.

 

That's the theory. I will let you know.

 

A humbling hobby...

[+Lee Stewart]

 From post #1230 of the Assembly on the 99/4A thread:

2 hours ago, TheBF said:

Here is the result on vanilla TI-99/4A.     By way of explaining the code:

• PUSH, is macro that pushes a register onto the Forth stack 
• R4 is the top of stack cache register.
• So what you are seeing left to right in the video is  R0,R1,R2,R4

HEX
CODE TEST
      8300 LWPI,
      R0 STWP,
      R1 CLR,
      R2 CLR,
      R0 *+ R0 *+ MOV,
      R0 PUSH,
      R1 PUSH,
      R2 PUSH,
      NEXT,
ENDCODE

 

I did not want to pollute the Assembly thread any more than necessary, so I put my question here. This result of running the above code confuses me:

HEX
0 TEST .S |8304 8302 0 0  ok

I do not see the need of the initial ‘0’ on the stack, but, more to the point, I would expect .S to produce

HEX
0 TEST .S |0 8304 8302 0  ok

...lee

[+TheBF]

12 minutes ago, Lee Stewart said:

 

 

Testing...

 

...lee

Lol.

Well... I thought I was.  It was double-blind testing.  Both my eyes must have been closed.

 

[+TheBF]

17 minutes ago, Lee Stewart said:

 From post #1230 of the Assembly on the 99/4A thread:

I did not want to pollute the Assembly thread any more than necessary, so I put my question here. This result of running the above code confuses me:

HEX
0 TEST .S |8304 8302 0 0  ok

I do not see the need of the initial ‘0’ on the stack, but, more to the point, I would expect .S to produce

HEX
0 TEST .S |0 8304 8302 0  ok

...lee

I was trying to see what happened on a TI-99 versus the Geneve that was tested in the post. (looks like the same result)

 

So I started the test with   "0 TEST"

That puts a 0 in R4 (my top of stack cache)

 

Then test code runs as posted.

 

When we do .S  The right side is top of stack which is always R4 on my system.

The other registers were push onto the stack in memory so they show up in the order they were pushed.

 

 

Does that help?
 

 

 

[+Lee Stewart]

4 minutes ago, TheBF said:

So I started the test with   "0 TEST".  That puts a 0 in R4 (my top of stack cache).  Then test code runs as posted.  When we do .S  The right side is top of stack which is always R4 on my system.  The other registers were push onto the stack in memory so they show up in the order they were pushed.

 

Does that help?

 

Not really. My understanding(?) of the Camel99 Forth stack is that it is like any other Forth stack except that the number on top of the stack is actually in TOS (R4) and nowhere else and that pushing another number copies that number to a newly reserved spot on the actual stack and puts the new number in TOS. I also thought that .S simply handled that situation to print out the stack, bottom to top (left to right) with the rightmost number coming from TOS. From what you have said, it looks like PUSH, does nothing to TOS, which is counterintuitive.

 

...lee

 

[+TheBF]

1 minute ago, Lee Stewart said:

 

Not really. My understanding(?) of the Camel99 Forth stack is that it is like any other Forth stack except that the number on top of the stack is actually in TOS (R4) and nowhere else and that pushing another number copies that number to a newly reserved spot on the actual stack and puts the new number in TOS. I also thought that .S simply handled that situation to print out the stack, bottom to top (left to right) with the rightmost number coming from TOS. From what you have said, it looks like PUSH, does nothing to TOS, which is counterintuitive.

 

...lee

 

I posted an expansion of the code in the Assembly forum since if I confused you then I was making trouble.

The PUSH, macro is for any register.  So in this case I did not PUSH R4 into memory stack. I only "pushed" R0 R1 & R2.