Jump to content
TheBF

Camel99 Forth Information goes here

Recommended Posts

An interesting variation that I think has better long term potential

I think this is in the realm of an 'open" hash-table.

  1. HASH the string using a smaller PRIMEDIV constant (501) to MOD the result
  2. If the bucket is empty use it 
  3. If the bucket is occupied add the PRIMEDIV to the hash# and test that bucket
  4. repeat until an empty memory location is found
 509 CONSTANT PRIMEDIV

: DJB2A ( addr len -- hash)
       5381 -ROT  \ initial long hash seed goes under string
       BOUNDS
       DO
          33 *  I [email protected] XOR
       LOOP
       PRIMEDIV MOD  \ "lazy" mod limits hash table size
;

: HASHNAME  ( addr len -- ndx)
         2DUP CR TYPE  \ debug
         DJB2A
         DEEP OFF    \ debug line
         BEGIN
         DUP ]BUCKET @ WHILE ( bucket<>0)
         \ **we have a collision**
           COLLISION 1+!   \ debug count the collisions
           DEEP 1+!
           PRIMEDIV +      \ *NEW* test 509 buckets away
           DUP ."  :" .    \ debug
         REPEAT
;

 

The results with the first method ( increment bucket by 1)  gave far less collisions initially but near the end collisions were more frequent and there was one word with a 4 collision list.  

It seemed to degrade fast after we go beyond 300 words.

 

The new method have more total collisions but they are more randomly distributed and the longest search list was 2.

Seem like a better strategy.

  • Like 1

Share this post


Link to post
Share on other sites
14 hours ago, TheBF said:
  1. Hash the dictionary use Bernstein DJB2A string hashing method.  The hashing word uses 2039 prime number to MOD the output hash value to limit the number of buckets in the hash table to stay in a table of 4K bytes.
DECIMAL
2031 CONSTANT PRIMEDIV
: DJB2A ( addr len -- hash)
       5381 -ROT  \ initial long hash seed goes under string
       BOUNDS
       DO
          33 *  I [email protected] XOR
       LOOP
       PRIMEDIV MOD  \ "lazy" mod limits hash table size
;

 

Though I understand the use of a prime number for the starting hash, I am not sure that extends to the modulus for limiting the hash table size. I would think you could use the actual table size of 2048, which you could then more efficiently calculate with

DECIMAL
2047 CONSTANT TABLESIZ  \ hex 07FF table size mask
: DJB2A ( addr len -- hash)
       5381 -ROT  \ initial long hash seed goes under string
       BOUNDS
       DO
          33 *  I [email protected] XOR
       LOOP
       TABLESIZ AND  \ "lazy" AND limits hash table size
;

By the way, 2031 is not prime, having 3 and 677 as factors. Perhaps you meant to use 2039, the highest prime less than 2 KiB.

 

...lee

Share this post


Link to post
Share on other sites

Yes that is a mistake.  I am working too fast ... again. :)

 

I didn't think it would matter either using a prime for the modulus divide but it actually did make a difference.  It's really non-linear which I guess is what we want.

 

I will try your version and see what I get. Have to run out to do some errands so it may have to wait until tomorrow.

Share this post


Link to post
Share on other sites

To show you want I mean by non-linear here are some sample methods and results.

So far I am liking 509 because it seems stable. I need to try adding more words and watch where it starts to die.

I am calling it open Hashing where the table grows outside of the primary modulus limit. 

 

Weird how 2047 MOD does better than 2039 MOD when I thought prime numbers worked best always. Clearly not so.

But MOD seems better than AND at least as far as I have tested.

 

The FNV1 page mentions that you can use MOD but they recommended XOR folding with 32bit values to limit the size of the hash#.

Not sure that would help in 16bit space.

I will try with a partial number of bits:    >BEEF  DUP 5 RSHIFT XOR    ( something like that)  replacing the MOD)

 

EDIT: lol  That method of XOR folding still needs limiting to stay inside the 4K byte limit.

 

Wrap method Words Collisions Collision handler Max List Len. Last Address
#2047 AND 403 62 1+ 10 >2FFE
#2047 MOD 403 49 1+ 3 >2FFC
#2039 MOD 403 51 1+ 6 >2FE8
Open Hashing          
#509 MOD 403 139 509 + 2 >2BD6
#1019 MOD 403 142 1019 + 3 >3086
#521 MOD 403 160 521 + 5 >3436

Share this post


Link to post
Share on other sites

Experimental Version of a Hashed Dictionary

 

I spent some time making this work to see what would happen. The HFIND (hashed-find) code is very ugly and the hashing computation is done in Forth and I am tracking some statistics too.

That's clearly not optimal but testing with a pretty big file (DSK1.ANSFILE) the compile time is faster by 40%.  When I consider that my entire linked-list FIND is written in Assembler except for the the parameter passing we can see how hashing the dictionary really speeds things up since Forth code is beating the Assembler version.

 

CONS

This consumes 4K of Low RAM for the hash table and 1168 bytes for this (slightly pregnant) code so it's not a good fit for the TI 99.

 

I think the F83/PolyForth method that uses multiple strands of linked-lists to shorten the searches is a better fit. Back to the drawing board.  :) 

 

Note: In the end I used 2047 MOD to limit the hash table size and simple incrementing to handle a collision.

 

Spoiler
\ HASHED dictionary lookup using DJB2 for Camel99 Forth    Mar 22 2021 Fox
NEEDS DUMP    FROM DSK1.TOOLS
NEEDS ELAPSE  FROM DSK1.ELAPSE

HERE
NEEDS VALUE   FROM DSK1.VALUES
NEEDS COMPARE FROM DSK1.COMPARE
HEX
  2000 CONSTANT BUCKETS  \ hash table base address

DECIMAL
2047 CONSTANT PRIMEDIV
: DJB2A ( addr len -- hash)
       5381 -ROT  \ initial long hash seed goes under string
       BOUNDS
       DO
          33 *  I [email protected] XOR
       LOOP
       PRIMEDIV MOD  \ "lazy" mod limits hash table size
;

HEX
: CLRTABLE ( -- ) BUCKETS 2000 0 FILL   3000 H !  ;  \ MOVE
: ]BUCKET ( -- )  CELLS BUCKETS +  ; \ hash table as array

\ ==================================
VARIABLE WORDCNT
VARIABLE COLLISION

\ analysis code records highest address used in the table & lastbucket
VARIABLE MAXADDR
VARIABLE LASTBUCKET

: KEEPMAX  MAXADDR @ MAX MAXADDR !  ;
: ]BUCKET!  ( cfa ndx -- ) ( DUP . )
          ]BUCKET DUP LASTBUCKET !  DUP KEEPMAX ! ;

: NAME$ ( nfa -- addr len ) COUNT 1F AND  ;

\ track maximum list lengths for a given hash
VARIABLE DEEP
VARIABLE LISTLEN
VARIABLE LASTNFA

: LISTLEN!  LISTLEN @  DEEP @ MAX LISTLEN ! ;

: HASHNAME  ( addr len -- ndx)
\         2DUP CR TYPE  \ debug
         DJB2A DUP LASTNFA !
         DEEP OFF       \ debug line: count list depth
         BEGIN
         DUP ]BUCKET @ WHILE ( bucket<>0)
            COLLISION 1+!   \ debug count the collisions
            DEEP 1+!
            1+              \  try next bucket
\            DUP ."  :" .    \ debug
         REPEAT
;

: HASHEM
           COLLISION OFF
           MAXADDR OFF
           CONTEXT @ @ ( nfa)
           BEGIN
             ( nfa) DUP
             DUP NAME$ HASHNAME ( nfa Hash# ) ]BUCKET!
             KEY? IF KEY DROP THEN  \ debug, stop scroll
             NFA>LFA @ DUP          \ fetch next nfa
           WHILE
             WORDCNT 1+!         \ nice to know
             LISTLEN!           \ debug line
           REPEAT
           DROP
           DECIMAL
           CR WORDCNT @ . SPACE ." words hashed"
           CR COLLISION @ .  ."  collisions"
           CR ." Max Address  = "  HEX MAXADDR @ .
           CR ." Longest list = "  DECIMAL LISTLEN @ .
           CR ." "
           CR ." ---"
;

: HASHDICT (  -- )  CLRTABLE  WORDCNT OFF HASHEM ;

\ gratuitous variables made it much simpler. Mea Culpa :)
VARIABLE HASH#
VARIABLE NFA
: 2OVER  3 PICK 3 PICK ;

: IMMED? ( nfa -- ?) 1- [email protected] 1 AND 0= ;

: HFIND ( Caddr  -- xt  0  if not found)
\                   xt  1  if immediate
\                   xt -1  if "normal"
        NFA OFF
        DUP
        COUNT
        2DUP DJB2A HASH# !
      ( addr len )
        BEGIN
           HASH# @ ]BUCKET @ DUP NFA ! DUP WHILE \ while nfa<>0
    ( nfa) NAME$ 2OVER COMPARE WHILE \ and while the strings <>
           HASH# 1+!             \ try the next bucket
        REPEAT
        THEN
        2DROP
        NFA @ 0= IF DROP THEN NFA @
        DUP IF
           NIP DUP NFA>CFA       \ -- nfa xt
           SWAP IMMED?           \ -- xt iflag
           1 OR                  \ -- xt 1/-1
        THEN ;

 ======================================================================
\ D I C T I O N A R Y   C R E A T I O N
\ *wid is "wordlist identifier"

: HASHHEAD, ( addr len --)
      ALIGN
      CURRENT @  DUP>R   \ Fetch CURRENT wid, make a copy for later
      \ === compile the header fields ===
      @ ,                \ wid @ gives NFA, compile into new LFA field
      0 C,               \ compile the precedence byte (immediate flag)
      HERE DUP LATEST !  \ HERE is now a new NFA, store NFA in LATEST
               R>  !     \ also store in current 'WID' we saved earlier
      2DUP  HERE -ROT HASHNAME ]BUCKET!
      S, ;               \ compile the (addr len) string as the name.

: HEADER ( <text> --)  BL PARSE-WORD HASHHEAD, ;

\ ======================================================================
\ D E F I N I N G   W O R D S
\                    text    runtime-action   parameter
\                   -------  --------------- -----------
: CONSTANT  ( n --)  HEADER  POSTPONE DOCON    COMPILE, ;
: USER      ( n --)  HEADER  POSTPONE DOUSER   COMPILE, ;
: CREATE    ( -- )   HEADER  POSTPONE DOVAR             ;
: VARIABLE  ( -- )   CREATE                  0 COMPILE, ;

\ control find to use hash table or linked list
: HASH-ON   ['] HFIND  'FIND ! ;
: HASH-OFF  ['] <FIND> 'FIND ! ;
HERE .S 
\ CR HERE SWAP - DECIMAL . .( bytes)
CR .( Hashing dictionary ...)
HASHDICT HASH-OFF

 

 

 

HASHED COMPILE TEST.png

  • Like 2

Share this post


Link to post
Share on other sites

I have been spending more time trying to remove bytes from my system.  I managed to re-work the primitive file reader in the 8K kernel with:

FOPEN ( $ len b/rec mode --)

and

FGET   ( buffer -- len)

These became common factors to simplify the rather verbose file access word-set required by ANS 94 Forth.

The ANSFILES library compiles, after my reductions, to 1,200ish bytes instead of 1360ish bytes before so a nice improvement.

 

But... I was staring at the ANS Forth file words and thought how hard would it be to make something simpler, more like BASIC?

Turns out not too hard and it only required 608 bytes of code space! 

 

Terrible dilemma this.  Write standard compliant code or TI-99 specific code.

I guess having both let's me choose.

 

By the way, I feel that with efficient VDP read/write routines for bytes, integers and blocks of memory that are as easily used as CPU RAM operators there is little need to build the PAB in RAM and block write it into VDP.

Some of this is because Forth is not as fast as native code so the speed difference in Forth to read/write RAM  vs VDP RAM is not very big. 

I think this is why this implementation was simpler to create.  

 

For those not familiar with the Camel99 Kernel (almost everybody) The [PAB FLG] words and others like that create a [base-address + offset] syntax to make navigating the PAB easier for people like me. :) 

 

Spoiler
\ SIMPLEFILE.FTH  NON ANS Files for the low-fat computing    Mar 27 2021 FOX

HERE
\ pab definer uses PSZ (pab size = 300 bytes) to compute the PAB address
: PAB: ( n -- )  CREATE  PSZ * VDPTOP SWAP - ,   DOES> @ ^PAB ! ;

\ make 3 predefined peripheral access blocks.
\ Each one sets the current PAB as active in the ^PAB variable
1 PAB: #1   2 PAB: #2   3 PAB: #3

\ modify the pab flag field directly
: VOR!  ( c --)  [PAB FLG] TUCK [email protected]   OR SWAP VC! ;
: VAND! ( c --)  [PAB FLG] TUCK [email protected]  AND SWAP VC! ;

\ Primary access mode words must be used first
2 BASE !
: UPDATE  ( --) [PAB BL 0 VFILL   11111001 [PAB FLG] VC! ;
: INPUT   ( --) UPDATE 00000100  VOR! ;
: OUTPUT  ( --) UPDATE 00000010  VOR! ;
: APPEND  ( --) UPDATE 00000110  VOR! ;

\ TI-99 file access mode modifiers are used second
: DISPLAY    ( --) 11110111 VAND! ;
: SEQUENTIAL ( --) 11111110 VAND! ;
: RELATIVE   ( --) 00000001 VOR!  ;
: INTERNAL   ( --) 00001000 VOR!  ;

VARIABLE B/REC
: VARI  ( size --) [PAB RECLEN] VC! 00010000 VOR!  ;
: FIXED ( size --) [PAB RECLEN] VC! 11101111 VAND! ;

DECIMAL
: DV80  ( -- ) UPDATE DISPLAY SEQUENTIAL 80 VARI ;
: DF128 ( -- ) UPDATE INTERNAL RELATIVE 128 FIXED ;

: OPEN   ( $addr len -- )
          [PAB FNAME] DUP           \ -- addr len Vaddr Vaddr
          32 + [PAB FBUFF] V!       \ FBUFF=32 bytes past fname
          VPLACE                    \ write string to [PAB FNAME]
          0 FILEOP ?FILERR ;        \ open the file, return err code

: READ   ( buffer -- len ) 2 FILEOP ?FILERR  FGET ;
: CLOSE  ( -- ) 1 FILEOP ?FILERR ;
: WRITE  ( addr len --)
         DUP [PAB CHARS] VC!
         [PAB FBUFF] [email protected] SWAP VWRITE
         3 FILEOP ?FILERR ;

: EOF     ( -- c)    (EOF) ;
: RECORD# ( -- rec#) [PAB REC#] [email protected]  [PAB FLG] [email protected] ?FILERR ;
: SEEK    ( rec# --) [PAB REC#] V!  4 FILEOP ?FILERR ;
: DELETE  ( caddr len -- ior) OPEN  7 FILEOP ?FILERR CLOSE  ;
HERE SWAP - DECIMAL .

 

 

Using these words is about as simple as BASIC. 

The use of #1 repeatedly below is not actually needed if you are only working with one file.

It would probably be a good habit however.

 

CREATE A$  80 ALLOT

: SEEFILE ( addr len )
          #1 DV80 OPEN
          BEGIN
            A$ DUP #1 READ CR TYPE
            #1 EOF  
          UNTIL
          #1 CLOSE 
;

Usage:  S" DSK1.MYFILE" SEEFILE 

  • Like 2

Share this post


Link to post
Share on other sites

I have been noodling over this concept for a while and I finally figured out how to do in a way that makes more sense to me.

The concept is using numbered labels for Forth Assembler.  I don't want to use them all the time but it can really reduce complexity when you know that all you want to do is jump out of loop on an error condition or save some space by jumping into the middle of a code word.

 

I have something that works similarly in the XFC99 cross-compiler but it has the limitation of each forward jump must be matched by a matching label.  You cannot have for example three different jumps to the same place in the code unless you add three labels there. Yuk!

 

I reviewed some code from DxForth but found it difficult to follow so I re-wrote it with a push down stack to handle all the jump locations. The key to the whole thing was to push not only the address of the jump instruction but also index number. Then use the pushed index number to reference the label later when you are resolving the jumps. Like most things it was trivial once I understood it.

 

This version is for a Forth cross-assembler for TI-99.  You can replace THERE with HERE for normal Forth Assemblers.

The ultimate goal is to cross-compile the Camel99 Kernel with Camel99. :)

I need some labels to use the existing source code.  (I may back migrate these to the cross-compiler because they are better)

 

Here is the kind of code that can be assembled with this system.  Source is in the spoiler.

 

HEX 2020 ORG
CODE TEST2
1 $:     R7 1000 AI,          \ BEGIN
         R7 R1 CMP,
         2 $ JLT,             \ GTE IF
         R4 CLR,
         R5 CLR,
         R6 CLR,
         R8 R7 SUB,
2 $:     1 $ JMP,
         NEXT,
ENDCODE
2000 50 DUMP


2040 ORG
CODE TEST3
      TOS TOS MOV,
      1 $ JNE,        \ THERE >FS  1 >FS
      R0 R0 MOV,
      1 $ JEQ,        \ THERE >FS  1 >FS
      R1 R1 CMP,
      1 $ JNO,        \ THERE >FS  1 >FS
      R5 R1 ADD,
      R1 R2 ADD,
1 $:  NEXT,           \ THERE [1]LABL !
ENDCODE
2040 30 DUMP

 

Spoiler
\ Numbered assembler labels for Camel99  Mar 2021 Fox
\ Concept first seen in DxForth. Thanks Ed.
\ Complete re-write using a push down stack

\                      *** for cross-assembler ***

NEEDS DUMP FROM DSK1.TOOLS
NEEDS MOV, FROM DSK1.XASM9900

MARKER /LABELS

DECIMAL
25 CONSTANT #FWD
20 CONSTANT #LABELS

\ Make a stack to handle jumps
CREATE FS0    #FWD CELLS ALLOT
FS0 CREATE FSP ,   \ fwd stack pointer, initialzed to FS0
: FSDEPTH ( -- n) FS0 FSP @ -  2/ ;
: >FS     ( addr --) 2 FSP +!   FSP @ ! ;
: FS>     ( -- addr)
          FSP @  DUP FS0 = ABORT" Label stack empty"
          @  -2 FSP +!  ;

CREATE LABELS   #LABELS CELLS ALLOT
: ]LBL  ( n -- addr) CELLS LABELS + ;  \ array of label addresses

: NEWLABELS  ( -- )
    LABELS  #LABELS CELLS 0 FILL  \ clear label array
    FS0 FSP !   \ reset fwd stack pointer to base address
;

: $:  ( n -- )  THERE SWAP ]LBL !   ;
: $   ( n -- 0) THERE >FS  >FS   0  ;  \ push address and index. Return zero

: ?LABEL  ( addr -- addr) DUP 0= ABORT" Un-resolved forward jump" ;

: RESOLVER ( -- )
       BEGIN
       FSDEPTH
       WHILE
           FS> ]LBL @ ?LABEL ( lbladdress )
           FS> TUCK - ( jmpaddr offset) RESOLVE
       REPEAT ;

: +CODE   ( <name> ) CODE ;       \ used to jump across CODE words
: CODE    ( <name> ) CODE NEWLABELS ;
: ENDCODE ( -- ) ?CSP RESOLVER  ;

 

 

This word is in the XASM9900 assembler, you need it for RESOLVER

: RESOLVE ( addr offset --)  2- 2/ SWAP 1+ C! ;


 

  • Like 2

Share this post


Link to post
Share on other sites
14 hours ago, TheBF said:

Here is the kind of code that can be assembled with this system.

 

TEST2 appears to me to be an infinite loop. Was that your intent or is my analysis flawed?

 

...lee

  • Like 1

Share this post


Link to post
Share on other sites

You are correct. The code was just nonsense to let me monitor if the jumps were being computed correctly forward and backwards :)

 

I have been stewing on how to do this for quite a while. It was a relief to see the jumps compile properly.

I think it is pretty transportable too and it's actually smaller than what I used before.

 

The hand made stack is an idea from Camel Forth. Brad did this for the LEAVE stack. (without error detection)

I tried my library version of a stack and it was more complicated to reset and the error message was generic on underflow so  another case where libraries are not always the answer.

  • Like 2

Share this post


Link to post
Share on other sites

In case you want to try it on FbForth here is the RESOLVE word from my assembler.

I think that is the only missing piece.

 

: RESOLVE ( addr offset --)  2- 2/ SWAP 1+ C! ;

 

  • Like 1

Share this post


Link to post
Share on other sites
14 hours ago, TheBF said:

Source is in the spoiler.

 

A couple of stack-effect nits:

  1. FS>  ( -- addr )            \ addr is left on the stack rather than consumed
  2. ?LABEL  ( addr -- addr )    \ addr is not consumed

...lee

  • Like 1

Share this post


Link to post
Share on other sites
Just now, Lee Stewart said:

 

A couple of stack-effect nits:

  1. FS>  ( -- addr )            \ addr is left on the stack rather than consumed
  2. ?LABEL  ( addr -- addr )    \ addr is not consumed

...lee

Thank you sir.  I will ammend the code.

  • Like 1

Share this post


Link to post
Share on other sites
7 minutes ago, TheBF said:

In case you want to try it on fbForth here is the RESOLVE word from my assembler.

I think that is the only missing piece.

: RESOLVE ( addr offset --)  2- 2/ SWAP 1+ C! ;

 

 

Thanks for that! :) RESOLVER certainly did not work with the code I had found, which was for resolving branching code.

 

,,,lee

  • Like 2

Share this post


Link to post
Share on other sites

On comp.lang.forth there was a discussion on how to write a reference implementation of TYPE for the Forth Standard web site.

 

A creative use of the word COUNT was presented. I would have never thought of this.

Of course PAUSE is not needed in single thread systems.

: TYPE     ( addr cnt -- ) PAUSE 0 ?DO  COUNT EMIT  LOOP DROP ;

 

Edit: The new version above of TYPE is 8% faster than what I used before

: TYPE   ( addr cnt -- ) PAUSE  BOUNDS ?DO  I [email protected] EMIT  LOOP ;

 

  • Like 2

Share this post


Link to post
Share on other sites
4 hours ago, TheBF said:

A creative use of the word COUNT was presented. I would have never thought of this.  Of course PAUSE is not needed in single thread systems.

: TYPE     ( addr cnt -- ) PAUSE 0 ?DO  COUNT EMIT  LOOP DROP ;

 

 

Though the use of COUNT is certainly clever, I should think the figForth version of the loop contents used in TI Forth and fbForth is faster because COUNT requires an additional word, SWAP :

: TYPE     ( addr cnt -- ) PAUSE 0 ?DO  DUP [email protected] EMIT 1+  LOOP DROP ;

...lee

  • Like 1

Share this post


Link to post
Share on other sites
4 minutes ago, Lee Stewart said:

 

Though the use of COUNT is certainly clever, I should think the figForth version of the loop contents used in TI Forth and fbForth is faster because COUNT requires an additional word, SWAP :

: TYPE     ( addr cnt -- ) PAUSE 0 ?DO  DUP [email protected] EMIT 1+  LOOP DROP ;

...lee

 

Yes for certain if COUNT is written in Forth it's not advisable.

 

In my case I wrote COUNT in CODE and actually sandwiched it with [email protected]  :) 

CODE: COUNT  ( addr -- addr' u)
              TOS PUSH,              \ make a copy of addr
             *SP INC,                \ inc. past the count byte
l: [email protected]       *TOS TOS MOVB,          \ put [email protected] inline to save space
              TOS 8 SRL,
              NEXT,
              END-CODE

CODE: [email protected]     [email protected]  CFA! END-CODE      \ give [email protected] a dictionary header

 

  • Like 2

Share this post


Link to post
Share on other sites
44 minutes ago, TheBF said:

Yes for certain if COUNT is written in Forth it's not advisable.

 

In my case I wrote COUNT in CODE and actually sandwiched it with [email protected]  :) 

 

Very nice!

 

...lee

  • Thanks 1

Share this post


Link to post
Share on other sites

Lee just posted Tombstone city in another thread and I saw the sound lists so I tested out my conversion to Camel99 VDP sound lists.

The Assembler code works with just a few search and replace jobs and adding the speed equates as constants.

 

VBYTE uses EVALUATE on the line of comma delimited text so it correctly interprets constants and any valid Forth expression.

 

Sidebar:

As a musician and having done some orchestration I hear/see the opportunity to condense this data.

There are some repeated sections that could be managed by making each MEASURE comment below a separate FORTH word and then sequencing them using loop structures for each section of the tune.

This is how music notation works to save paper and reduce page-turns by the musicians. 

 

Spoiler
DECIMAL
80 CONSTANT SPEED1
20 CONSTANT SPEED2
10 CONSTANT SPEED3
40 CONSTANT SPEED4

HEX
VCREATE HELLINTEXAS  \  SOUND LIST.
\       TEXASDUMP
        VBYTE 4,9F,BF,DF,FF,01
\  MEASURE:  0001
        VBYTE 04,80,0F,90,BF,SPEED3
        VBYTE 04,80,0F,90,BF,SPEED3
\  MEASURE:  0002
        VBYTE 06,86,0D,90,AF,2C,B0,SPEED2
        VBYTE 06,80,0F,90,AB,23,B0,SPEED2
        VBYTE 06,80,0F,90,A0,1E,B0,SPEED2
        VBYTE 06,80,0F,90,AF,2C,B0,SPEED2
        VBYTE 06,8D,11,90,AB,23,B0,SPEED2
        VBYTE 06,8D,11,90,A0,1E,B0,SPEED2
\  MEASURE:  0003
        VBYTE 06,80,14,90,AF,2C,B0,SPEED2
        VBYTE 06,88,16,90,AB,23,B0,SPEED2
        VBYTE 06,8D,11,90,A0,1E,B0,SPEED2
        VBYTE 06,80,0F,90,AF,2C,B0,SPEED2
        VBYTE 06,80,0F,90,AB,23,B0,SPEED2
        VBYTE 06,80,0F,90,A0,1E,B0,SPEED2
\  MEASURE:  0004
        VBYTE 06,8C,1A,90,A7,35,B0,SPEED2
        VBYTE 06,88,16,90,AF,2C,B0,SPEED2
        VBYTE 06,88,16,90,AB,23,B0,SPEED2
        VBYTE 06,80,14,90,A7,35,B0,SPEED2
        VBYTE 06,88,16,90,AF,2C,B0,SPEED2
        VBYTE 06,80,14,90,AB,23,B0,SPEED2
\  MEASURE:  0005
        VBYTE 06,8D,11,90,AF,2C,B0,SPEED2
        VBYTE 06,80,0F,90,AB,23,B0,SPEED2
        VBYTE 06,80,0F,90,A0,1E,B0,SPEED2
        VBYTE 06,80,0F,90,AF,2C,B0,SPEED2
        VBYTE 06,80,0F,90,AB,23,B0,SPEED2
        VBYTE 06,80,0F,90,A0,1E,B0,SPEED2
\  MEASURE:  0006
        VBYTE 06,86,0D,90,AF,2C,B0,SPEED2
        VBYTE 06,80,0F,90,AB,23,B0,SPEED2
        VBYTE 06,80,0F,90,A0,1E,B0,SPEED2
        VBYTE 06,80,0F,90,AF,2C,B0,SPEED2
        VBYTE 06,8D,11,90,AB,23,B0,SPEED2
        VBYTE 06,8D,11,90,A0,1E,B0,SPEED2
\  MEASURE:  0007
        VBYTE 06,80,14,90,AF,2C,B0,SPEED2
        VBYTE 06,88,16,90,AB,23,B0,SPEED2
        VBYTE 06,8D,11,90,A0,1E,B0,SPEED2
        VBYTE 06,80,0F,90,AF,2C,B0,SPEED2
        VBYTE 06,80,0F,90,AB,23,B0,SPEED2
        VBYTE 06,80,0F,90,A0,1E,B0,SPEED3
        VBYTE 06,80,0F,90,A0,1E,B0,SPEED3
\  MEASURE:  0008
        VBYTE 06,8C,1A,90,A7,35,B0,SPEED2
        VBYTE 06,88,16,90,AF,2C,B0,SPEED2
        VBYTE 06,88,16,90,AB,23,B0,SPEED2
        VBYTE 06,80,14,90,A7,35,B0,SPEED2
        VBYTE 06,88,16,90,AF,2C,B0,SPEED2
        VBYTE 06,80,14,90,AB,23,B0,SPEED2
\  MEASURE:  0009
        VBYTE 06,8D,11,90,AF,2C,B0,SPEED2
        VBYTE 06,88,16,90,AB,23,B0,SPEED2
        VBYTE 06,80,14,90,A0,1E,B0,SPEED2
        VBYTE 06,88,16,90,AF,2C,B0,SPEED2
        VBYTE 06,88,16,90,AB,23,B0,SPEED2
        VBYTE 06,88,16,90,A0,1E,B0,SPEED2
\  MEASURE:  0010
        VBYTE 06,8C,1A,90,A7,35,B0,SPEED2
        VBYTE 06,88,16,90,AF,2C,B0,SPEED2
        VBYTE 06,88,16,90,AB,23,B0,SPEED2
        VBYTE 06,8C,1A,90,A7,35,B0,SPEED2
        VBYTE 06,88,16,90,AF,2C,B0,SPEED2
        VBYTE 06,88,16,90,AB,23,B0,SPEED2
\  MEASURE:  0011
        VBYTE 06,8D,17,90,AA,2F,B0,SPEED2
        VBYTE 06,88,16,90,AF,2C,B0,SPEED2
        VBYTE 06,88,16,90,AF,2C,B0,SPEED2
        VBYTE 06,80,0F,90,AB,23,B0,SPEED2
        VBYTE 06,80,0F,90,AB,23,B0,SPEED2
        VBYTE 06,80,0F,90,A0,1E,B0,SPEED3
        VBYTE 06,80,0F,90,A0,1E,B0,SPEED3
\  MEASURE:  0012
        VBYTE 06,8C,1A,90,A7,35,B0,SPEED2
        VBYTE 06,88,16,90,AF,2C,B0,SPEED2
        VBYTE 06,88,16,90,AB,23,B0,SPEED2
        VBYTE 06,80,14,90,A7,35,B0,SPEED2
        VBYTE 06,88,16,90,AF,2C,B0,SPEED2
        VBYTE 06,80,14,90,AB,23,B0,SPEED2
\  MEASURE:  0013
        VBYTE 06,8D,11,90,AF,2C,B0,SPEED2
        VBYTE 06,80,0F,90,AB,23,B0,SPEED2
        VBYTE 06,80,0F,90,A0,1E,B0,SPEED2
        VBYTE 06,80,0F,90,AF,2C,B0,SPEED2
        VBYTE 06,80,0F,90,AB,23,B0,SPEED2
        VBYTE 06,80,0F,90,A0,1E,B0,SPEED3
        VBYTE 06,80,0F,90,A0,1E,B0,SPEED3
\ MEASURE:  0014
        VBYTE 06,86,0D,90,AF,2C,B0,SPEED2
        VBYTE 06,80,0F,90,AB,23,B0,SPEED2
        VBYTE 06,80,0F,90,A0,1E,B0,SPEED2
        VBYTE 06,80,0F,90,AF,2C,B0,SPEED2
        VBYTE 06,8D,11,90,AB,23,B0,SPEED2
        VBYTE 06,8D,11,90,A0,1E,B0,SPEED2
\ MEASURE:  0015
        VBYTE 06,80,14,90,AF,2C,B0,SPEED2
        VBYTE 06,88,16,90,AB,23,B0,SPEED2
        VBYTE 06,8D,11,90,A0,1E,B0,SPEED2
        VBYTE 06,80,0F,90,AF,2C,B0,SPEED2
        VBYTE 06,80,0F,90,AB,23,B0,SPEED2
        VBYTE 06,80,0F,90,A0,1E,B0,SPEED2
\ MEASURE:  0016
        VBYTE 06,8C,1A,90,A7,35,B0,SPEED2
        VBYTE 06,88,16,90,AF,2C,B0,SPEED2
        VBYTE 06,88,16,90,AB,23,B0,SPEED2
        VBYTE 06,80,14,90,A7,35,B0,SPEED2
        VBYTE 06,88,16,90,AF,2C,B0,SPEED2
        VBYTE 06,80,14,90,AB,23,B0,SPEED2
\ MEASURE:  0017
        VBYTE 06,8D,11,90,AF,2C,B0,SPEED2
        VBYTE 06,88,16,90,AB,23,B0,SPEED2
        VBYTE 06,80,14,90,A0,1E,B0,SPEED2
        VBYTE 06,88,16,90,AB,23,B0,SPEED4
        VBYTE 06,88,16,90,AB,23,B0,SPEED2
\ MEASURE:  0018
        VBYTE 04,88,16,90,BF,SPEED2
        VBYTE 00,10,1A
/VEND

 

 

  • Like 2

Share this post


Link to post
Share on other sites

Ahhh yes.

 

And when I play the same data with the ISRPLAY library it has a continuous repeat built into it.

Its starting to get on my nerves about now :)

 

NEEDS VHERE  FROM DSK1.VDPMEM
HEX
 83C2 CONSTANT AMSQ      \ interrupt DISABLE bits
\ AMSQ bit meaning:
\ 80 all interrupts disabled
\ 40 motion disabled
\ 20 Sound disabled
\ 10 quit key disabled

\ VDP byte string compiler
: ?BYTE ( n -- ) FF00 AND  ABORT" Not a byte" ;

: VBYTE ( -- )
         BEGIN  [CHAR] , PARSE-WORD DUP
         WHILE
            EVALUATE DUP ?BYTE
            VC,
         REPEAT
         2DROP ;

: /VEND   0 VC, 0 VC, ;   \ end the list with 2 bytes

CODE 0LIMI ( -- )  0300 , 0000 , NEXT, ENDCODE
CODE 2LIMI ( -- )  0300 , 0002 , NEXT, ENDCODE

\ ........................................
\  ISR Sound List Player
HEX
: ISRPLAY ( vaddr -- )
            0LIMI                     \ interrupts off
            83CC !                    \ Vaddr -> sound table
            AMSQ [email protected]  5 AND AMSQ C!    \ enable sound interrupts
            01 83CE C!                \ trigger sound list processing
            83FD [email protected]  01 OR 83FD C!    \ set "VRAM is source" flag
            2LIMI ;                   \ interrupts on

1000 VP !    \ reset VDP memory heap

 

  • Like 1

Share this post


Link to post
Share on other sites

I may have found a good way to use Super Cart.

 

How about you put all your programming tools in there and leave the rest of RAM for your program.

CR .( Developer Tools to SUPER CART @>6000 )

HEX
: ?SUPERCART  BEEF 6000 !  6000 @ BEEF <> ABORT" Super Cart not found" ;

?SUPERCART

\ SAVEDP holds the LINK field of the 1st new word we will create in HI RAM
VARIABLE SAVEDP
LATEST @ CONSTANT KEEP  \ remember latest name field address

CR .( Set up low ram compiling ...)
  HERE SAVEDP !      \ save the dictionary pointer.
  6000 DP !          \ DP points to SUPER cart

HERE   ( to compute space used in SuperCart)
  INCLUDE DSK1.WORDLISTS

ONLY FORTH DEFINITIONS
  INCLUDE DSK1.ELAPSE
  INCLUDE DSK1.TOOLS

VOCABULARY ASSEMBLER
ALSO ASSEMBLER DEFINITIONS
  INCLUDE DSK1.ASM9900
  INCLUDE DSK1.ASMLABELS

HERE SWAP - DECIMAL CR  . .( bytes in super cart)
CR
CR .( Restore high ram compiling ...)
SAVEDP @ DP !     \ restore DP back to original address

FORTH DEFINITIONS
HEX
: REMOVE-TOOLS ( -- )
         KEEP SAVEDP @ !  \ relink the dictionary
         2000 H ! ;       \ init-the heap to low RAM

DECIMAL
.FREE

 

  • Like 2

Share this post


Link to post
Share on other sites

So I found this benchmark.  Tried it on GForth 32bit (Windows 10, Dell i7 3.4GHz) and it returned ok immediately after I pressed return.

 

I defined CARRAY like this for Camel99 Forth 

: CARRAY ( n -- ) CREATE  ALLOT ALIGN   DOES> ( n -- addr) + ;

... and the results are on the screen capture. 

And that is for only 1 iteration because 2 iterations exceeded my 9 minute screen timer. 

:) 

 

Note: 

Changing CARRAY to this:

: CARRAY  ( n -- )
         CREATE  ALLOT ALIGN
         ;CODE ( n -- addr)
                 W TOS ADD,
                 NEXT,
         ENDCODE

reduced the time to  5:27.23   

 

Spoiler
\ ********************
\ Eight queens problem
\ ********************
\ Taken from SP-Forth 4 - samples\bench\queens.f
\ Al.Chepyzhenko

DECIMAL
8  CARRAY Gori
8  CARRAY Verti
15 CARRAY Dio1
15 CARRAY Dio2

: Clear ( -- )
   8 0 DO 0 I Verti C! LOOP
  15 0 DO 0 I Dio1  C! LOOP
  15 0 DO 0 I Dio2  C! LOOP ;
  

: Check ( n -- f )
  Clear TRUE SWAP 1+ 0
  DO
      I Gori [email protected]
      DUP Verti DUP [email protected]
      IF
          DROP DROP DROP FALSE
      ELSE
          TRUE SWAP C!
          DUP I + Dio1 DUP [email protected]
          IF
              DROP DROP DROP FALSE
          ELSE
              TRUE SWAP C!
              DUP 7 + I - Dio2 DUP [email protected]
              IF
                  DROP DROP DROP FALSE
              ELSE
                  TRUE SWAP C! DROP TRUE AND
              THEN
          THEN
      THEN
  LOOP ;

: Print ( -- )
  8 0
  DO
   I Gori [email protected] .
  LOOP CR ;

: TRYTO ( n )
  8 0
  DO
      I OVER Gori C!
      DUP Check
      IF
          DUP 7 <
          IF   DUP 1+ RECURSE  THEN
      THEN
  LOOP
  DROP
  ;

2 CONSTANT /QUEENS

: $QUEENS$      \ --
  CR ." Eight Queens Problem"
  /QUEENS 0 DO  0 TRYTO  LOOP  /QUEENS 
;

 

 

8queensCamelForth.png

Share this post


Link to post
Share on other sites

For another reference point Turbo Forth, with all those primitives in 16 bit RAM did the 8 Queens in 6:45 

Not to shabby Mark.

 

I have figure out what I need to do to compile this in Machine Forth. :?

Share this post


Link to post
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.

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...