Jump to content
TheBF

Camel99 Forth Information goes here

Recommended Posts

Yup! I definitely got going very easily,with TF, but same kinda conditions exits where I stayed straight to design and my efforts were quickly realized. I found myself lurking more and more into assembly and now I'm stuck in 99 assembler and it's code. But Forth is my outlet when frustration takes over in assy. 

  • Like 1

Share this post


Link to post
Share on other sites

Back from the wife's family reunion in the Netherlands and little time in Paris and Provence.  (I could stay in Paris for a long time 🙂 )

 

CAMEL99 Forth is starting to be fun to use as I get more libraries working.

I need to get a better glossary document together so by putting together some lib files I could write a crude "GLOSSARY" utility.

The code could be re-factored a bit more but it works. 

I should also create a generic sort routine that takes a pointer and count as a library for system usage.

 

A Glossary in Forth parlance is a list of Forth words with stack comments and a text description. 

The output of this code gives me the sorted names and an empty stack comment.  Not much, but better than nothing.

 

Here is how the code looks:

Spoiler
\ GLOSSARY GENERATOR

\ This demo uses some advanced features of CAMEL99 forth
\ 1. Dynamically allocating memory in the HEAP ( MALLOC )
\ 2. Vectored execution of the comparison operator
\ 3. Combsort routine which runs about 10X faster than Bubble sort
\ 4. Measuring elapsed time using screen timeout timer value
\ 5. Text macros to improve speed of time critical routines
\ 6. Sorts an array of pointers. The actual strings do not move

\ usage:  ASCENDING SORTWORDS  -or-  DESCENDING SORTWORDS

NEEDS .ID        FROM DSK1.TOOLS
NEEDS TO         FROM DSK1.VALUES
NEEDS IS         FROM DSK1.DEFER
NEEDS ELAPSE     FROM DSK1.ELAPSE
NEEDS WRITE-LINE FROM DSK1.ANSFILES
NEEDS MORE       FROM DSK1.MORE

HEX
\ variables uses by COMBSORT
VARIABLE SFLAG
VARIABLE ITEMS
0 VALUE GAP

0 VALUE ^DATA   \ a data array pointer

: ]DATA    ( n -- ^data[n] ) CELLS ^DATA + ; \ index into ^DATA

\ load the name field address (NFA) of all words, into ^DATA
: LOAD.NAMES ( -- addr n )
             CR ." Loading names... "
             ITEMS OFF            \ reset ITEMS variable
             LATEST @             ( -- nfa )
             0 >R                 \ put a loop index on return stack
             BEGIN
                DUP [email protected] ]DATA !    ( -- nfa )
                R> 1+ >R          \ increment loop counter
                NFA>LFA @         \ goto link field, fetch next NFA
                DUP 0=            \ is it zero?
             UNTIL
             R> DUP .  ." words"
             ITEMS !  ;           \ store # items for sort to use

\ compare strings uses S= (Camel Forth word)
: COMPARE$ ( $1 $2 -- flag)  1+ SWAP COUNT S= ;
: >$       ( $1 $2 -- flag)  COMPARE$ 0> ;  \ $1 > $2
: <$       ( $1 $2 -- flag)  COMPARE$ 0< ;  \ $1 < $2


DEFER PRECEDE   \ vectored string comparison operator
: ASCENDING  ( -- )  ['] <$ IS PRECEDE ;
: DESCENDING ( -- )  ['] >$ IS PRECEDE ;

ASCENDING   \ default sort direction

: /1.3  ( n -- n/1.35 ) \ 100/135 is fastest GAP  ratio for this sort
        S" 100 135 */ 1 MAX " EVALUATE ;  IMMEDIATE

: XCHG  ( 'data[1] 'data[2] $1 $2 -- )
        S" SWAP ROT !  SWAP ! "  EVALUATE ; IMMEDIATE

HEX
: SORTWORDS ( -- )
    ^DATA 0= ABORT" No buffer allocated" 
    LOAD.NAMES
    CR ." Sorting "
    ITEMS @ TO GAP                   \ init combort gap
    BEGIN
       GAP  /1.3  TO GAP             \ compute new gap width
       SFLAG ON                      \ sort flag set to TRUE
       ITEMS @  GAP -  0             \ setup loop
       DO
           I  GAP + ]DATA  I ]DATA   ( -- data[gap] data[i]  )
           OVER @ OVER @             ( -- data[gap] data[i] nfa1 nfa2)
           2DUP                      ( -- data[gap] data[i] nfa1 nfa2 nfa1 nfa2)
           PRECEDE IF                \ compare string at nfa1,nfa2
               XCHG                  \ xchg if wrong order
               SFLAG OFF             \ we are not done yet
           ELSE
               2DROP 2DROP           \ no exchange so collapse the stack info
           THEN
       LOOP
       [CHAR] . EMIT                 \ show progress on screen
       SFLAG @  GAP 1 = AND          \ test for completion
    UNTIL
    CR  ;


\ display the words in sorted order
: .WORDS   ( -- )
            CR
            ITEMS @ 0
            DO
               I ]DATA @ .ID SPACE
               ?BREAK
            LOOP ;

: ID$     ( NFAaddr -- caddr len) COUNT 1F AND  ;

: +PLACE  ( adr n adr -- )   2DUP 2>R  COUNT +  SWAP MOVE 2R> C+! ;

DECIMAL

CREATE OUT$  82 ALLOT ;

0 VALUE #1

: PADDED ( addr$  n -- )  SWAP C!  ;
: BLANKS    BL FILL ;

\ write the words in sorted order
: WRITE-WORDS   ( -- )
            CR
            ITEMS @ 0
            DO
               OUT$ 80 BLANKS
               I ]DATA @ ID$ OUT$ PLACE
                OUT$ 20 PADDED
                S" ( -- )"  OUT$ +PLACE
                OUT$ COUNT  #1  WRITE-LINE ?FILERR
               ?BREAK
            LOOP ;

HEX
: GLOSSARY ( path$ len -- )
            TICKER OFF
            DV80 W/O OPEN-FILE ?FILERR TO #1
            1000 MALLOC TO ^DATA     \ allocate 4k space for the word names
            ASCENDING SORTWORDS
            CR ." Writing file..."
            WRITE-WORDS
            #1 CLOSE-FILE ?FILERR          
            1000 MFREE               \ release the mmeory (low ram)
            0 TO ^DATA
            CR ." Complete"
            .ELAPSED
;

PAGE
\ A little systems work in Forth
S" DSK3.GLOSS99" GLOSSARY

 

 

 

  • Like 2

Share this post


Link to post
Share on other sites

Dynamic Memory Allocation from Forth.net

http://theforth.net/package/dynamic-memory-allocation/current-view/dynamic.fs

 

I always knew that I was trying to make CAMEL99 Forth ANS/ISO compliant but today I got a pleasant surprise.

I found a dynamic memory library and it seems to work!  All I had to do was convert it to uppercase for CAMEL Forth.

 

It's way overkill (probably) for TI-99 but since I was already using Low RAM as a heap there was a place for dynamic memory anyway.

It would be pretty cool to rewrite it for SAMS.

 

Here's the code and the screen shows it working. I have not played with it much to see how it FREEs up memory.

 

Spoiler
\ DYNAMIC.FTH
\ forth-94 version of klaus schleisiek's dynamic memory allocation
\ (forml'88) uh 2016-10-28

VARIABLE ANCHOR  0 ANCHOR !

DECIMAL 050 CONSTANT WASTE

-1 1 RSHIFT CONSTANT #MAX
#MAX INVERT CONSTANT #FREE  \ sign bit

: SIZE      ( mem -- size ) 1 CELLS - @ #MAX AND ;
: ADDR&SIZE ( mem -- mem size ) DUP SIZE ;
: ABOVE     ( mem -- >mem ) ADDR&SIZE + 2 CELLS + ;
: USE       ( mem size -- ) DUP >R SWAP  2DUP 1 CELLS - !  R> #MAX AND + ! ;

: RELEASE ( mem size -- )  #FREE OR USE ;

: FITS? ( size -- mem | false ) >R ANCHOR @
   BEGIN 
      ADDR&SIZE  [email protected] U< 0=
      IF R> DROP EXIT THEN
      @ DUP ANCHOR @ =
   UNTIL 
   0= R> DROP ;

: LINK ( mem >mem <mem -- )
       >R 2DUP CELL+ !  OVER !  R> 2DUP !  SWAP CELL+ ! ;

: @LINKS ( mem -- <mem mem> )  DUP @  SWAP CELL+ @ ;
: SETANCHOR ( mem -- mem ) DUP ANCHOR @ = IF  DUP @ ANCHOR ! THEN ;
: UNLINK ( mem -- ) SETANCHOR  @LINKS 2DUP !  SWAP CELL+ ! ;

: ALLOCATE ( size -- mem ior )
   3 CELLS MAX DUP >R  FITS? ?DUP 0= IF R> -8 EXIT THEN ( "dictionary overflow" )
   ADDR&SIZE [email protected] -  DUP WASTE U<
   IF  DROP  DUP @ OVER UNLINK  OVER ADDR&SIZE USE
   ELSE 2 CELLS -   OVER [email protected] USE
        OVER ABOVE   DUP ROT RELEASE
        2DUP SWAP @LINKS LINK 
   THEN R> DROP  ANCHOR ! 0 ;

: FREE ( mem -- ior )
   ADDR&SIZE  OVER 2 CELLS -  @ DUP 0<
   IF #MAX AND 2 CELLS +  ROT OVER - ROT ROT +
   ELSE  DROP  OVER ANCHOR @  DUP CELL+ @  LINK THEN
   2DUP + CELL+ DUP @ DUP 0<
   IF  #MAX AND SWAP CELL+ UNLINK  +  2 CELLS +  RELEASE 0 EXIT THEN
   2DROP RELEASE 0 ;

: RESIZE ( mem newsize -- mem' ior )
    OVER SWAP  OVER SIZE  2DUP >
    IF ( MEM MEM SIZE NEWSIZE )  SWAP ALLOCATE ?DUP IF >R DROP 2DROP R>  EXIT THEN
        DUP >R SWAP MOVE FREE R> SWAP EXIT THEN
    2DROP DROP 0 ;

: EMPTY-MEMORY ( addr size -- )
   >R  CELL+ DUP ANCHOR !   DUP 2 CELLS USE  DUP 2DUP LINK
   DUP ABOVE  SWAP OVER  DUP LINK
   DUP R> 7 CELLS -  RELEASE  ABOVE 1 CELLS -  0 SWAP ! ;

CR
CR .( dynamic memory allocation:)
CR .( use   addr size EMPTY-MEMORY  to initialize,)
CR .( then use the standard memory allocation wordset allocate free resize to manage memory.)

\ CAMEL99 specific code uses LOW RAM for the HEAP
\ Use only 1F00 to leave room at top for Camel99 Forth SCROLL
\ MALLOC marks the new HEAP as allocated correctly in CAMEL99
  HEX 1F00 DUP MALLOC SWAP ( addr len ) EMPTY-MEMORY
  CR .( Low RAM is HEAP)

 

 

DYNAMIC.jpg

  • Like 3

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