Camel99 Forth Information goes here

[+TheBF]

I found a problem with my SAVESYS code.  I thought I had fixed it a while back but I was wrong. 

I had been seeing a weird problem where saved programs seemed to lose the dictionary. 

I thought I was not saving the dictionary pointers correctly but could not understand what I was doing wrong.

Turns out that FIND would randomly encounter a zero that was erroneously added to the image, stopping the search. 

 

I recently rebuilt the ED99 editor to use the new kernel and found the saved version died when I hit the HOME key.

My debugging had me looking at a HEX dump and the HOME function was on the 8K boundary. That's a big clue.

 

Guess what I found there:  0000,0000,0000 

Oops. That looks like a file header.

I wrote a simple checksum to compare the the Forth system after compiling and the saved image.

They were different.

With the checksum tool I could fix my previous complicated "fix" that broke it.

 

Checksums agree now and I feel much better about this.

I was having weird problems with the MachForth compiler saved image too so I am optimistic about that.

 

I suppose if I wanted to be "rigorous" I would encode the checksum in the image and test it on start up.

Maybe another day.

 

Please replace your DSK1.SAVESYS  file with the code below if you use Camel99 Forth.

Spoiler

CR .( SAVESYS.FTH  creates EA5 program Jun 2022 B Fox)
\ creates a binary program E/A 5 format.
\ Makes as many files as needed to save the system
\ Jun 2022 version fixed section overlap. Tested with check sum.

\ Usage example:
\  INCLUDE DSK2.MYPOGRAM   ( load all your code)
\  : COLDSTART     WARM   CR ." Myprogram ready"  ABORT" ;
\  LOCK   ( this locks the dictionary to this new )
\  INCLUDE DSK1.SAVESYS
\  ' COLDSTART SAVESYS DSK3.MYFILENAME

NEEDS DUMP      FROM DSK1.TOOLS
NEEDS LOCK      FROM DSK1.MARKER
NEEDS LOAD-FILE FROM DSK1.LOADSAVE  \ we use SAVE-FILE from this library

HERE
HEX
A000 CONSTANT 'ORG     \ start of Camel99 Forth program in CPU RAM
1000 CONSTANT VDPBUFF  \ Programs write to file from VDP Ram
2000 CONSTANT 8K
  13 CONSTANT PROG     \ file mode for Program files

\ define the file header fields. *THESE ARE VDP ADDRESSES*
VDPBUFF            CONSTANT MULTIFLAG
VDPBUFF  1 CELLS + CONSTANT PROGSIZE
VDPBUFF  2 CELLS + CONSTANT LOADADDR
VDPBUFF  3 CELLS + CONSTANT CODEORG     \ COPY 8K program chunks to here
           3 CELLS CONSTANT HEADLEN

: END  ( -- addr )
  ORGDP @ DUP C000 < IF HONK CR ." WARNING: missing LOCK directive" THEN ;

\ words to compute Forth system properties
: SYS-SIZE    ( -- n)  'ORG  END  SWAP - ;
: #FILES      ( -- n)  SYS-SIZE 8K /MOD SWAP IF 1+ THEN ;
: CODECHUNK   ( n -- addr) 8K *  'ORG + ;
: CHUNKSIZE   ( n -- n ) END SWAP CODECHUNK -  8K MIN ;
: LASTCHAR++  ( Caddr len --)  1- +  1 SWAP C+! ;

: ?PATH  ( addr len -- addr len )
         2DUP  [CHAR] . SCAN NIP 0= ABORT" Path expected" ;

HEX
: SAVESYS ( XT -- <textpath> )
    BOOT !
    BL PARSE-WORD ?PATH  ( caddr len ) PAD PLACE
    #FILES 0
    ?DO
      \ Init file header in VDP RAM
       I 1+ #FILES <>  MULTIFLAG V!
       I CHUNKSIZE     PROGSIZE V!
       I CODECHUNK     LOADADDR V!
      \ Copy to VDP & write to disk"
       CR ." Writing file "  PAD COUNT TYPE
       LOADADDR V@  CODEORG  PROGSIZE V@  HEADLEN + VWRITE
       PAD COUNT    VDPBUFF  PROGSIZE V@  HEADLEN + PROG SAVE-FILE
       PAD COUNT  LASTCHAR++   \ Update file name
    LOOP
    CR ." System size=" DECIMAL SYS-SIZE U. ." bytes"
    CR ." Saved in " #FILES .  ." EA5 files"
    CR
;

\  ** TEST CODE **
\ : COLD   WARM ABORT ;
\ : CHK    ( start end -- n) SWAP 0 -ROT  DO  I @ +  2 +LOOP ;
\ LOCK
\ ' COLD SAVESYS DSK2.FORTH
HERE SWAP - CR DECIMAL . .( bytes)

\ 'ORG ' COLD CHK HEX .  ( this number should be the same in the saved image)

 

 

 

Edited June 4, 2022 by TheBF
Updated code

[+TheBF]

No surprise but the SAVESYS program now works for DTC Forth as well.

Amazing what happens when you make a proper binary image.  LOL!   

[atrax27407]

thanks for the update - I have incorporated it in my CAMELforth system.

[+TheBF]

Some sad news in the Forth world. 

Dr. C. H. Ting has passed away.

 

I had the pleasure of meeting him at a Forth conference but I did not know him personally.

 

Dr. Ting was a prolific writer on topics in Forth technology and the author of eForth, a minimal Forth written for educational purposes that used only 32 coded primitives. The rest was Forth.

 

I have a copy of his book on Chuck Moore's NC4000 CPU with the most interesting title "Footsteps in an Empty Valley".  I will have to crack it open again.

I am also in his debt for his wonderful paper called "Inside F83"  a detailed description of the F83 Forth system for MS DOS. 

 

And just now in looking for his papers online I found "Forth for the Complete Idiot"   

Sounds like he wrote that one for me. 

http://www.forth.org/Ting/Forth-for-the-Complete-Idiot/Forth-for-the-Complete-Idiot.pdf

 

Rest in Peace Dr. Ting.

[+TheBF]

I always wondered how hard it would be to make Camel99 case insensitive.

Since the interpreter is vectored through a variable, something I had to do because it is a forward reference in a typical Forth system, it was pretty easy.

 

Put this code as NOCASE.FTH on your disk and include it and you can switch back and forth with case sensitivity.

\ NOCASE.FTH  make Camel99 case insensitive   Jun 5 2022    Brian Fox

: LOWER?  ( char -- ?) [CHAR] a  [CHAR] z  1+ WITHIN ;
HEX
: UCASE   ( char -- char ) DUP LOWER? IF  05F AND  THEN ;

DECIMAL
: UCASE!  ( byte-addr -- ) DUP C@  UCASE  SWAP C! ;
: TOUPPER ( addr len -- ) BOUNDS ?DO  I UCASE!  LOOP ;

\ new interpreter loop process SOURCE string first
: <CASEINTERP> ( addr u -- )  2DUP TOUPPER  <INTERP> ;

\ replace interpreter vector with the new one
: NOCASE     ['] <CASEINTERP>  'IV ! ;
: CAPS       ['] <INTERP>      'IV ! ;

 

[+TheBF]

On 6/4/2022 at 2:59 PM, atrax27407 said:

thanks for the update - I have incorporated it in my CAMELforth system.

Hi Bob, @atrax27407

 

and the legions of Camel99 users out there.

 

I just realized that I left the in the debugging line at the top of DSK1.SAVESYS that pulls in DSK1.TOOLS

NEEDS DUMP      FROM DSK1.TOOLS

You can comment that whole line out in the file with \   or  (   )  as you prefer.

I needed DSK1.TOOLS to fix the thing but the programmer doesn't need TOOLS to use SAVESYS. 

 

 

[atrax27407]

Done -thanks!

[+TheBF]

I have another update for the Camel99 Libraries

 

A while back I made some changes to WORDLISTS to save some memory but it was not worth the space saving as it makes it impossible to completely remove the FORTH-WORDLIST from the dictionary search. Sometimes, like in a cross-compiler, you don't want the program to see any standard Forth words, only your new replacements that have the same name. For that situation you must have a way to remove Forth-wordlist from the search order.

 

Explanation:

In the old version I removed the ROOT wordlist to save a bit of space and replaced it with a copy of FORTH-WORDLIST.

ROOT is the "safety" wordlist that lets you recover after you removed all the wordlists from the search usually by accident.

I figured FORTH-WORDLIST was good enough. Wrong!   

 

Changes 

1. The minimum search order (which I called ROOT like GForth) "shall have" FORTH-WORDLIST  and SET-CONTEXT at the minimum in the 2012 spec.

    I also added FORTH  ROOT ONLY  and ORDER  to the ROOT list just to cover my ASSetts. 

 

2. I also added a word INIT-WORDLISTS  that can be used to reset the wordlists when you save an EA5 program. It seems ok for now.

 

3. I added a new word because the code was duplicated 3 times.

   WID-NAME!  takes the latest word defined and patches that name into the name field of a wordlist. No biggy. Just gives a name to something used often.

 

Here is the new file DSK1.WORDLISTS

 It works for the regular CAMEL99 ITC version and the DTC version as well.

When I think back to when I first wrote this I had NO idea how this worked I can see  a little progress in this old head.  

 

 

Spoiler

\ wordlist.fth   for CAMEL99 FORTH    Oct 2020 Brian Fox
\ Code adapted from Web: https://forth-standard.org/standard/search
\ Dec 2020: Removed SET-CURRENT to save precious bytes
\ Jan 5, 2020: back migrated some enhancements from CODEX work
\ Jun 4, 2021: Changed order of patching to work with TTY version
\ Sep 25, 2021: Corrected SET-CONTEXT, Removed ROOT to save space.
\ Jun  8, 2022: Put ROOT back. Added INIT-WORDLISTS for program startup
\ --------
\ 'wid' is a word-list ID.
\ In Camel Forth, wid is a pointer to a Name Field Address (NFA)
\ ie: a counted string of the last word defined in the wordlist.

\ The kernel program has a pre-defined CONTEXT array to hold the
\ Forth wordlist plus 8 user defined wordlists.

\ NEEDS .S   FROM DSK1.TOOLS ( Debugging)

HERE
DECIMAL
CREATE #ORDER  1 ,  \ No. of active wordlists starts at 1
VARIABLE WID-LINK   \ Pointer to the most recently defined wordlist

: WORDLIST ( -- wid)
   HERE
   0 ,               \ init nfa of last word in wordlist
   WID-LINK @ ,      \ compile link to previous wordlist
   DUP WID-LINK !    \ link to previous wordlist
   0 ,               \ name of this wordlist. Must be patched with WID-NAME!
;

\ patch LASTEST NFA into wordlist name fld
: WID-NAME! ( wid -- )  LATEST @ SWAP 4 + ! ;

CREATE ROOT            WORDLIST  WID-NAME!
CREATE FORTH-WORDLIST  WORDLIST  WID-NAME!

HEX
: .WID  ( wid -- )
  [ 2 CELLS ] LITERAL + @
  ?DUP 0= IF EXIT THEN   \ name field is empty.
  COUNT 1F AND TYPE SPACE ;

\ : ]CONTEXT ( n -- addr) CELLS CONTEXT + ; \ context as array
HEX ( Machine code is same size but faster)
CODE ]CONTEXT ( n -- addr)
     0A14 ,            \ TOS 1 SLA,  ( tos = n x 2 )
     0224 , CONTEXT ,  \ TOS CONTEXT AI,
     NEXT,
     ENDCODE

.( .)
: GET-ORDER ( -- widn ... wid1 n ) \ *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  ROOT FORTH-WORDLIST 2  THEN
     DUP #ORDER !  0 ?DO  I ]CONTEXT !  LOOP
;

: ONLY ( -- ) TRUE SET-ORDER ;  \ set search order to FORTH FORTH

: SET-CONTEXT ( wid -- )    \ place 'wid' at beginning of search order
     >R GET-ORDER NIP       \ remove 1st wordlist
     R> SWAP SET-ORDER      \ put 'wid' first
;

\ User API
: ALSO ( -- ) GET-ORDER OVER SWAP 1+ SET-ORDER ;
: PREVIOUS    ( -- ) GET-ORDER NIP 1- SET-ORDER ;
: DEFINITIONS ( -- ) CONTEXT @ CURRENT ! ;
.( .)
\ non-standard but nice to have
: VOCABULARY  ( wid -- )
   CREATE
   WORDLIST   WID-NAME!   \ update wordlist name field
   DOES> SET-CONTEXT ;

: ORDER ( -- )
   CR  GET-ORDER 0 DO   .WID   LOOP
   CR ." Current: " CURRENT @ .WID CR ;

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

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

\ set the new search order and current vocabulary
ONLY FORTH DEFINITIONS

\ Forth 2012 6.1.1550, Extend FIND to search all active wordlists
: FIND12 ( FIND12) ( c-addr -- c-addr 0 | xt 1 | xt -1 )
      FALSE   \ default flag
      CONTEXT #ORDER @ CELLS ( -- addr size)
      BOUNDS
      ?DO
          OVER I @ @ (FIND)
          ?DUP
          IF
              2SWAP 2DROP
              LEAVE
          THEN
          DROP
      2 +LOOP ;

' FIND12 'FIND !

 ROOT CURRENT !  \ compile into ROOT-WORDLIST
\ " minimum search order shall include the words FORTH-WORDLIST & SET-ORDER"
: FORTH-WORDLIST  FORTH-WORDLIST ;
: SET-ORDER       SET-ORDER ;
: FORTH  FORTH ;
: ROOT   ROOT  ;
: ONLY   ONLY  ;
: ORDER  ORDER ;
\ : ALSO   ALSO  ;
\ : DEFINITIONS  DEFINITIONS ;

: INIT-WORDLISTS
    ['] FIND12 'FIND !
    CONTEXT @ @ FORTH-WORDLIST !
    ONLY FORTH DEFINITIONS
;

 INIT-WORDLISTS

CR HERE SWAP - DECIMAL SPACE . .( bytes)
HEX

 

 

 

 

Edited June 9, 2022 by TheBF
typo

[+TheBF]

I was watching a video on the GO language and saw a thing called a channel that looks like a queue used for inter-process communication.

This made me review some code in the Camel99 Library.

 

I am a big fan of using binary wrapping queue pointers rather than IF statements.

My current queue did not check that the programmer entered a proper "power of two" sized memory so I wondered about the best way to determine if a number is a power of two.

Some people suggested using loops but then...

 

I found this C code

bool is_power_of_2(int x) {
    return x > 0 && !(x & (x−1));
}

If we can ignore testing for 0 >  it becomes very simple in Forth. 

: POT?   ( n -- ?)  DUP 1- AND 0= ;

 

If we need the test for 0> then we can do this.

: POT?  ( n -- ?)  DUP 0>  SWAP    DUP 1- AND AND 0=  ; 

 

All that to say the byte queue library file will get this addition.  

[+Lee Stewart]

1 hour ago, TheBF said:

If we can ignore testing for 0 >  it becomes very simple in Forth. 

: POT?   ( n -- ?)  DUP 1- AND 0= ;

 

 

 

I don’t get it.   [I do now! I obviously confused “power of 2” with “divisible by 2”...doh!  ]

 

This should be all you need to test for a power of two, i.e., will test for an even number, if that were the only concern:

: POT?  ( n -- ? )  1 AND 0= ;

...lee

Edited June 14, 2022 by Lee Stewart
painful correction

[+TheBF]

I am thinking about the application where you make a circular buffer and you want to wrap to the beginning when you get to the end by just using AND.

The valid buffer sizes would then be 2^X ,  in other words 2,4,8,16,32,64 etc.

The mask required would then be X-1.

 

 

 

 

 

[+Lee Stewart]

31 minutes ago, TheBF said:

I am thinking about the application where you make a circular buffer and you want to wrap to the beginning when you get to the end by just using AND.

The valid buffer sizes would then be 2^X ,  in other words 2,4,8,16,32,64 etc.

The mask required would then be X-1.

 

Yeah—don’t mind me. I was confusing “divisible by 2” with “power of 2”!  

 

...lee

[+TheBF]

Here is the byte queue code where I used this power of two thing.

 

Spoiler

( Circular byte queue for general purpose stuff  21MAR94 FOX )
( Uses power of 2 size buffers only!.  2 4 8 16 32 64 etc.
( Ported to Camel99 forth  11JUN2020, revised for ISO compliance June 13 2022 )

: ?POT ( n --) DUP 0> SWAP DUP 1- AND AND  ABORT" Not power of 2" ;  

HEX
: BYTEQ: ( n -- <text>)
    DUP ?POT 
    CREATE
        0 ,          ( write pointer {TAIL} )
        0 ,          ( read  pointer {HEAD} )
        DUP 1- ,     ( mask value    )
        ALLOT        ( data field    )
;

(Field offsets to the Queue data structure )
: ->HEAD ( q -- adr )      ;  \ syntax sugar
: ->TAIL ( q -- adr ) [ 1 CELLS ] LITERAL + ;
: ->MSK  ( q -- adr ) [ 2 CELLS ] LITERAL + ;
: ->DATA ( q -- adr ) [ 3 CELLS ] LITERAL + ;

\ Circular pointer incrementing
: HEAD++ ( q -- )  DUP>R ->HEAD @ 1+  R@ ->MSK @ AND R> ->HEAD ! ;
: TAIL++ ( q -- )  DUP>R ->TAIL @ 1+  R@ ->MSK @ AND R> ->TAIL ! ;
: QMORE? ( q -- ?) 2@ <> ; 

: QC@    ( q -- c )
       DUP>R TAIL++
       R@ ->DATA
       R> ->TAIL @ +       \ [data+tail]= adr
       C@ ;                \ fetch the byte

: QC!    ( c q -- )
       DUP >R HEAD++
       R@ ->DATA
       R> ->HEAD @ +       \ [data+head]= adr
       C! ;                \ store the byte

: WRITEQ  ( addr len queue -- )
          -ROT BOUNDS
          ?DO
             I C@ OVER QC!
          LOOP
          DROP ;

: PRINTQ  ( queue -- )
        BEGIN
           DUP QMORE?  \ 2@ reads head & tail. If not = we have data
        WHILE
           DUP QC@ EMIT
        REPEAT
        DROP ;

\ DEMO code
DECIMAL 256 BYTEQ: Q1
  
: TEST
      BEGIN
        S" Now is the time for all good men..." Q1 WRITEQ
        S" to come to the aid of their country." Q1 WRITEQ
        Q1 PRINTQ 3 SPACES
        KEY?
      UNTIL ;
  
      
      
      

 

 

[+TheBF]

4 hours ago, Lee Stewart said:

 

Yeah—don’t mind me. I was confusing “divisible by 2” with “power of 2”!  

 

...lee

A friend of mind calls that a "brain fart"

 

[+TheBF]

The GO language inter-task channel creator is very neat and can be configured to be just 1 byte or 2 bytes or whatever you need.

 

I went into the library and found the equivalent for Forth without the fancy extras and here is all the code it required.

 

One user variable is used for the "mailbox" . This means you can use it for a byte or an integer message. 

The simplicity is what I like. I found this in an old Forth Dimensions magazine.

Edit: simplified GET-MAIL 

\ mailbox.fth  inter-task communication for HSF2000  04JAN94
\ base on article in F.D. vol7 #4 by R. W. Dobbins. Columbia ML.
\ For CAMEL99 Forth Jun 2022

DECIMAL
\ Concept:
\ Block on "SEND" until the mailbox is cleared by the receiver
\ It's like a TRANSPUTER com-link for FORTH tasks.

NEEDS TASK:  FROM DSK1.MTASK99

HEX
50 USER MAILBOX  \ one 16 bit mailbox per task

: SEND-MAIL  ( n PID --) \ PID (process ID) is task workspace address
        BEGIN
           DUP @     \ wait while mailbox is not empty
        WHILE
           PAUSE
        REPEAT
        MAILBOX LOCAL ! ; \ store n into PID's mailbox

: GET-MAIL ( -- n ) \ read mailbox of the active task
        BEGIN
          PAUSE
          MAILBOX @ ?DUP
        UNTIL
        MAILBOX OFF ;

 

 

[+TheBF]

The GO language inter-task channel creator is very neat and can be configured to be just 1 byte or 2 bytes or whatever you need.

 

I went into the library and found the equivalent for Forth without the fancy extras and here is all the code it required.

 

One user variable is used for the "mailbox" . This means you can use it for a byte or an integer message. 

The simplicity is what I like. I found this in an old Forth Dimensions magazine.

 

Edit:  It seems I never tested this with Camel99 Forth. Duh!  Testing underway

 

Correct mailbox code:

Spoiler

\ mailbox.fth  inter-task communication for HSF2000  04JAN94
\ base on article in F.D. vol7 #4 by R. W. Dobbins. Columbia ML.
\ For CAMEL99 Forth Jun 2022

DECIMAL
\ Concept:
\ Block on "SEND" until the mailbox is cleared by the receiver
\ It's like a TRANSPUTER com-link for FORTH tasks.

NEEDS FORK  FROM DSK1.MTASK99

HEX
50 USER MAILBOX  \ one 16 bit mailbox per task

: SEND-MAIL  ( n PID --) \ PID (process ID) is task's workspace address
        BEGIN
           DUP MAILBOX LOCAL @   \ check PID mailbox is empty
        WHILE
           PAUSE                 \ if not pass control to the next task
        REPEAT
        MAILBOX LOCAL ! ;        \ store n into PID's mailbox

: GET-MAIL ( -- n ) \ read mailbox of the active task
        BEGIN
          PAUSE
          MAILBOX @ ?DUP
        UNTIL
        MAILBOX OFF ;

 

 

Test program that sends messages to another task.

The task stores the message in a variable.

The console has a viewer to "scope" the variable.

 

Spoiler

\ inter-task communication demo    Jun 2022  Brian Fox
\ Objective:
\ Send messages to tasks-to-task. Monitor messages from console

\ INCLUDE DSK1.TOOLS
INCLUDE DSK1.MAILBOX


CREATE TASK1    USIZE ALLOT    TASK1 FORK
CREATE TASK2    USIZE ALLOT    TASK2 FORK

VARIABLE VIEWPORT  \ a place to store message, viewed by console task

: READER
        BEGIN
           GET-MAIL  VIEWPORT !
        AGAIN ;
HEX
: SENDER
        BEGIN
           100 0
           DO
              I TASK2 SEND-MAIL
           LOOP
        AGAIN ;

: GETXY ( -- col row) VROW 2@  ;

: VIEWER
    GETXY
    BEGIN
      2DUP AT-XY
      VIEWPORT @ .
      ?TERMINAL
    UNTIL
    2DROP ;

' SENDER TASK1 ASSIGN
' READER TASK2 ASSIGN

MULTI

TASK1 WAKE
TASK2 WAKE

 

 

[+TheBF]

If you wanted to compare a search string in a CPU RAM to a list of strings in VDP RAM how would you do it?

 

My first thought was the obvious, copy each string, one by one, from VDP to a 2nd RAM buffer and compare the search string to the buffer.

 

I remembered that I had a COMPARE ( adr1 len adr2 len -- ?)  routine written by Neil Baud that was pretty efficient.

I wondered how hard it would be to modify it for the task.

I only needed to change one word!

Replace C@   with  VC@  and it works.

 

HEX
CODE RDROP   05C7 , NEXT, ENDCODE  \ INCT R7

DECIMAL
: VCOMPARE  ( adr u1 Vadr u2 -- -1|0|1 )
    ROT  2DUP - >R            ( a1 a2 n2 n1) ( R: n2-n1)
    MIN                       ( a1 a2 n3)
    BOUNDS  ( loop index I becomes the VDP address)
    DO                        ( a1)
        COUNT  I VC@ -        ( a1 diff)
        DUP IF
            NIP 0< 1 OR       ( -1|1)
            UNLOOP
            RDROP
            EXIT
        THEN                  ( a1 diff)
        DROP                  ( a1)
    LOOP
    DROP                      ( )
    R> DUP IF  0> 1 OR  THEN   \  2's complement arith.
;

 

[+TheBF]

I am noodling on how to provide some form of higher level memory management for data structures like arrays in SAMS memory.

This has been an ongoing process in taming that dang card.  

 

Over in the SAMS discussion thread I created a FAR-ARRAY word but I saw a big bug in that first version because it did not record the segment number for the array.

This code is better and runs a bit quicker as well, about 13%,  so a nice improvement.

 

The key was recording the address as  (virtual-address, segment)  pair for each array. Also refactoring PAGED into >REAL and PAGED.

 

Spoiler

\ SAMS arrays using 2 window BLOCK manager  Jun 2022

NEEDS DUMP FROM DSK1.TOOLS
NEEDS BLOCK  FROM DSK1.SBLOCKS

VARIABLE SEG     \ holds current 64K segment
1000 CONSTANT 4K
\ SAMS static Forth style memory allocation
VARIABLE SDP  \ sams dictionary pointer for 1 64K segment

: SHERE  ( -- addr) SDP @ ;    \ return end of SAMS dictionary
: SALLOT ( n -- )   SDP +! ;   \ move dictionary pointer ( pos or neg)

: >REAL  ( addr seg -- addr )  4K UM/MOD BLOCK + ;
: PAGED  ( virtual-addr -- real-addr) SEG @ >REAL ;

: ?SEGMENT ( n -- ) 255 1 WITHIN ABORT" Bad segment" ;

\ create arrays in a specifc segment
\ The return virtual addresses so are used with !L  @L  C!l C@l
: FAR-ARRAY ( cells segment -- <name>)
     DUP ?SEGMENT
     CREATE     ,  ,   \ compile SEGMENT and base address
             SALLOT    \ allocate memory in the SAMS space

     DOES> 2@  >R SWAP CELLS + R>  >REAL ;

: FAR-CARRAY ( bytes segment -- <name<)
     DUP ?SEGMENT
     CREATE     ,  ,   \ compile SEGMENT and base address
             SALLOT    \ allocate memory in the SAMS space

     DOES> 2@ >R + R>  >REAL ;

 

 

Notice that we give these arrays a size and a segment number (0..15) 

With this design we can use fetch and store just like normal memory because it IS normal memory once the page is brought into a  RAM window.

 

 

Here is the same test code with timings.

\ EXAMPLE: 40K byte array of integers in SAMS.
INCLUDE DSK1.ELAPSE
INCLUDE DSK1.BREAK

20000 1 FAR-ARRAY ]BIG

: BIGERASE  20000 0 DO   I BLOCK 4K 0 FILL  4K +LOOP ; \ < 0.5 seconds
: BIGFILL   20000 0 DO  I I ]BIG !    LOOP  ;  \ 18.5 seconds 
: BIGSEE    20000 0 DO    I ]BIG @ . ?BREAK  LOOP ;

 

An offshoot of the creation of >REAL is that !L and @L  can now be converted to true 32 bit ( double) address words. 

With these words we can access all SAMS memory sequentially from 0 to 16Mbytes 

If I re-write >REAL so that it is all CODE it would even be reasonably quick. 

\ True "FAR" memory access words operate on 32 bit address
: !L    ( n Daddr --)  >REAL ! ;   \ store int
: C!L   ( c Daddr --)  >REAL C! ;  \ store char
: 2!L   ( d Daddr --)  >REAL 2@ ;  \ store double

: @L    ( Daddr -- n)  >REAL @ ;
: C@L   ( Daddr -- c)  >REAL C@ ;
: 2@L   ( Daddr -- d)  >REAL 2@ ;

 

 

I am beginning to think I should use some tricks from HsForth which was a DOS Forth that used Intel segments. 

The concept is for each segment the programmer wants to use, they create a named data structure that contains something like:

• first SAMS page of the memory block
• the next free memory in the block ( a local HERE)           ( field(0), field(1)  can be read with 2@ and fed to >REAL) 
• no. of SAMS pages allocated 
• link to the previous memory block created  

The word SEGMENT ( 1stpage #pages -- addr)  does the job.

 

1 4 SEGMENT DATASEG 

 

Then you create words to read the fields and all "FAR" data structures go through the SEGMENT structure and update it as needed. 

Something to think about.

 

Edited June 29, 2022 by TheBF
typo

[+TheBF]

While playing around with all these double numbers and the SAMS card it was getting awkward because Camel Forth was built for simplicity

and so the interpreter doesn't automatically detect double integers.

 

Fortunately it does have the standard primitive for making number convertors and it is 32bit capable.

So instead of re-writing the kernel I added a prefix number parser that converts a string to a double.

 

It was easier than I thought with >NUMBER at the core of it.

D#  is "STATE smart" so it can also compile doubles into a definition as a double literal.

 

(confession: I peeked at GForth for 2LITERAL.  It needs the SWAP and I missed that at first.  

 

:  2LITERAL ( D -- ) SWAP POSTPONE LITERAL POSTPONE LITERAL ; IMMEDIATE

: D#  ( "number" -- D )
    0 0                           \ D# 0  on stack for >NUMBER
    PARSE-NAME >NUMBER  NIP ABORT" Bad number"
    STATE @ IF POSTPONE 2LITERAL  THEN 
; IMMEDIATE

 

To use it just preface your number anytime you need a double. An of course you can use it with all your favourite mixed-math operators as well.

 

[+TheBF]

Just to keep me humble I forgot about negative numbers.

The code got a "bit" bigger but it now converts negative numbers correctly to.

 

Using the EXIT method to jump out early simplified some stackrobatics to handle the bad conversion condition.

I made a lot of use of .S  and interactive testing to get this right.   

 

 INCLUDE DSK1.TOOLS   \ debugging
 INCLUDE DSK1.DOUBLE  \ needed for testing with D. to print doubles

: 2LITERAL ( D -- ) SWAP POSTPONE LITERAL POSTPONE LITERAL ; IMMEDIATE
: DNEGATE  ( d1 -- d2 ) SWAP INVERT SWAP INVERT 1 M+ ;

: SIGN?   ( addr len -- addr' len' ?) \ true means negative number
  OVER C@ [CHAR] -  =  DUP>R IF 1 /STRING THEN   R> ;

: DNUMBER?  ( addr len -- D ?)      \ ?=0 is good conversion
            SIGN? >R
            0 0  2SWAP >NUMBER
            DUP IF ( error)
                  R> DROP
                  2DROP TRUE
                  EXIT  THEN
            ( success)
            2DROP
            R> IF  DNEGATE  THEN   \ negate if needed
            FALSE
;

: D#  ( "number" -- D )
    PARSE-NAME DNUMBER? ABORT" Bad Double#"
    STATE @ IF POSTPONE 2LITERAL  THEN ; IMMEDIATE

 

[+TheBF]

While reviewing my library code I found these two monsters that I translated from TI-Forth.

CODE LDCR ( data bits CRU-- )
     C304 ,        \ TOS   R12 MOV,
     C076 ,        \ *SP+   R1 MOV,  \ bits -> R1
     C036 ,        \ *SP+   R0 MOV,  \ data -> R0
     0241 , 0F ,   \ R1 000F ANDI,  \ instruction built in R1
     1304 ,        \ NE IF,
     0281 , 08 ,   \     R1 8 CI,
     1501 ,        \     LTE IF,
     06C0 ,        \          R0 SWPB,   \ swap the data byte
                   \     ENDIF,
                   \ ENDIF,
     0A61 ,        \ R1 06 SLA,
     0261 , 3000 , \ R1 3000 ORI,   \ create: R0 bits LDCR,
     0481 ,        \ R1 X,          \ execute the intruction
     C136 ,        \ TOS POP,
     NEXT,
     ENDCODE

\ Performs the TMS9900 STCR instruction
CODE STCR ( bits cru --- n )
     C304 ,        \  TOS R12 MOV,
     C076 ,        \ *SP+ R1  MOV,   \ bits ->R1
     04C0 ,        \      R0  CLR,       \
     0241 , 0F ,   \ R1   0F  ANDI,
     C081 ,        \ R1   R2  MOV,
     0A61 ,        \ R1   06  SLA,
     0261 , 3400 , \ R1 3400  ORI,  \ create R0 bits STCR,
     0481 ,        \       R1 X,    \ execute the intruction
     C082 ,        \ R2    R2 MOV,
     1304 ,        \ NE IF,
     0282 , 08 ,   \     R2 08 CI,
     1501 ,        \     LTE IF,
     06C0 ,        \          R0 SWPB,
                   \     ENDIF,
                   \ ENDIF,
     C100 ,        \ R0 TOS MOV,
     NEXT,
     ENDCODE

In Z80 and Intel Forths there are a pair of I/O words called PC@ and PC!.

Can anybody think of why I couldn't replace those huge pieces of code with these?

CODE PC@  ( CRUaddr -- c)
            R12 RPUSH,    \ save R12
            TOS R12 MOV,  \ set new CRU address
            TOS 8 LDCR,
            TOS 8 SRA,
            R12 RPOP,     \ restore R12
            NEXT,
ENDCODE

CODE PC!  ( c CRUaddr --)
            R12 RPUSH,    \ save R12
            TOS R12 MOV,  \ set new CRU address
            TOS POP,      \ get c into TOS register
            TOS SWPB,
            TOS 8 STCR,   \ write eight bits
            R12 RPOP,     \ restore R12
            TOS POP,      \ refill TOS register from memory stack
            NEXT,
ENDCODE

(Because R12 could be used by other words (SAMS for example) inside the Forth workspace I save and restore it for these I/O words)

(I haven't actually tested this code either) 

[+Lee Stewart]

On 7/4/2022 at 7:53 PM, TheBF said:

Can anybody think of why I couldn't replace those huge pieces of code with these?

 

Looks OK to me.

 

And, by the way, the monstrosities to which you refer,

Spoiler

ASM: LDCR ( n bits CRUdisp --- )
   *SP+ R12 MOV,        \ pop CRU displacement
   R12 R12 A,           \ shift left for proper handling by LDCR
   *SP+ R1 MOV,         \ pop # of bits to load
   *SP+ R0 MOV,         \ pop source number
   R1 000F ANDI,        \ force # of bits to 0-15 (0=16)
   NE IF,               \ if 1-15 bits
      R1 0008 CI,       \ byte?
      LTE IF,           \ yes
         R0 SWPB,       \ transferring from MSB
      THEN,
   THEN,
   R1 06 SLA,           \ compose..
   R1 3000 ORI,         \ ..LDCR instruction
   R1 X,                \ execute composed LDCR R0,R1
;ASM 

ASM: STCR ( bits CRUdisp --- n )
   *SP+ R12 MOV,        \ pop CRU displacement
   R12 R12 A,           \ shift left for proper handling by STCR
   *SP R1 MOV,          \ pop # of bits to store
   R0 CLR,              \ clear destination register
   R1 000F ANDI,        \ force # of bits to 0-15 0=16)
   R1 R2 MOV,           \ save # of bits for later test
   R1 06 SLA,           \ compose..
   R1 3400 ORI,         \ ..STCR instruction
   R1 X,                \ execute composed STCR R0,R1
   R2 R2 MOV,           \ 1-15 bits?
   NE IF,               \ yes
      R2 0008 CI,       \ byte?
      LTE IF,           \ yes
         R0 SWPB,       \ MSB to LSB for stack   
      THEN, 
   THEN,
   R0 *SP MOV,          \ number to stack
;ASM

 

actually needed all of that code except for what builds the LCDR and STCR instructions for X, (never could figure out why that was done—maybe one of the programmers just learned about X) because it allows for both byte and word transfers. Your code, on the other hand, knows only bytes will be transferred, so it is justifiably shorter.

 

Here is the fbForth code (untested!) without building instructions for X, :

Spoiler

ASM: LDCR ( n bits CRUdisp --- )
   *SP+ R12 MOV,        \ pop CRU displacement
   R12 R12 A,           \ shift left for proper handling by LDCR
   *SP+ R1 MOV,         \ pop # of bits to load
   *SP+ R0 MOV,         \ pop source number
   R1 000F ANDI,        \ force # of bits to 0-15 (0=16)
   NE IF,               \ if 1-15 bits
      R1 0008 CI,       \ byte?
      LTE IF,           \ yes
         R0 SWPB,       \ transferring from MSB
      THEN,
   THEN,
   R0 R1 LDCR,          \ load CRU bits from R0
;ASM 

ASM: STCR ( bits CRUdisp --- n )
   *SP+ R12 MOV,        \ pop CRU displacement
   R12 R12 A,           \ shift left for proper handling by STCR
   *SP R1 MOV,          \ pop # of bits to store
   R0 CLR,              \ clear destination register
   R1 000F ANDI,        \ force # of bits to 0-15 0=16)
   R0 R1 STCR,          \ store CRU bits to R0
   R1 R1 MOV,           \ 1-15 bits?
   NE IF,               \ yes
      R1 0008 CI,       \ byte?
      LTE IF,           \ yes
         R0 SWPB,       \ MSB to LSB for stack   
      THEN, 
   THEN,
   R0 *SP MOV,          \ number to stack
;ASM

 

As you can see and though it pains me to no end, for compatibility, it still has the CRU shift that was in TI Forth. Why the TI Forth developers insisted on using the true CRU bit address, instead of the programmer-shifted address we were all accustomed to supplying in R12 for Assembler, is beyond me!

 

...lee

[+TheBF]

 

Thanks Lee. 

I am thinking about re-writing the 9902 RS232 direct code all in Forth using some simple primitives.

I did this years ago with TI-FORTH but I was pretty green. Nevertheless I did have TI-Forth with an editor running over an old terminal I found at the local surplus store.

I thought I had the world by the ass running downhill when I could use my 99 with an 80 col. terminal!

 

The logical addition to PC! is of course a TTY-TYPE word to send a bunch of bytes in one blast so I might make stripped down (PC!) that doesn't push and pop R12.

I remember seeing that X instruction a couple of years back. I didn't know 9900 could do that. It is cool, but seems like a waste of cycles these days.

 

You have of course again educated me with your FB-Forth version.  I didn't realize that R1 has a special role in these instruction so I will take that into consideration. 

 

 

[+TheBF]

Going over my demos I had a clock that ran as a background task.

The original used the little byte counter at  >8379 as the timer. 

 

I thought it would be cooler to hook the interrupt and run a 32 bit counter.  That gives a count in video frames.

It took me couple of runs to get the mixed math working to convert hrs:minutes:seconds to frames but it works now. 

 

Features in the Demo:

• The Assembler and tools are loaded as TRANSIENT code, in LOW RAM, and "DETACHed" (removed) when compilation is finished. (DSK1.LOWTOOLS)  
• The counter is free running as an ISR using ISR'   and INSTALL 
• Printing the number on the screen is background task under Forth
• Printing is handled by the neat trick in Starting Forth.  Using a mix of DECIMAL and SEXTAL number conversion to print time values.
  This works for minutes, seconds and since there are 60 frames in a second (in North America) it works for frames too.
• 9901 MS timer is used to prevent the CLOCK task from taking too much CPU time. MS passes control to the other tasks while waiting.
• Mixed math operators UM* and D+  let us convert time to frames as a 32bit integer without floating point. 

It only took me 5 years to get this #@$! system working the way I wanted.

 

Transient tools:

Spoiler

CR .( LowTools are Utility words loaded into LOW RAM  Mar 22 2022)
CR
NEEDS TRANSIENT FROM DSK1.TRANSIENT

TRANSIENT
  NEEDS ELAPSE FROM DSK1.ELAPSE
  NEEDS DUMP   FROM DSK1.TOOLS
  NEEDS MOVE   FROM DSK1.ASM9900
PERMANENT

.FREE
DECIMAL

 

 

CLOCK demo ( I should make it more user friendly and reverse the order of the SETCLOCK args.  ) 

Spoiler

CR .( Clock based on the TI-99 Interrupt counter)
CR .( Updated 5JUL2022  B Fox)
CR .( Uses ISR and background task)

NEEDS FORK    FROM DSK1.MTASK99
NEEDS MALLOC  FROM DSK1.MALLOC
NEEDS INSTALL FROM DSK1.ISRSUPPORT

\ LOWTOOLS uses TRANSIENT/PERMANENT
INCLUDE DSK1.LOWTOOLS

\ isr routine increments the double integer FRAMES
CREATE FRAMES  0 , 0 ,

CODE FRAMES++ ( -- ) \ this is the ISR
        FRAMES 2+ @@ INC,
        OC IF,
           FRAMES @@ INC,
        ENDIF,
        RT,
ENDCODE

DECIMAL
: SEXTAL   6 BASE ! ;
: <:>     [CHAR] : HOLD ;
: ##:     DECIMAL # SEXTAL #  <:> ;

: .TIME   ( d -- )
          FRAMES 2@
          BASE @ >R
        \     frm sec min     hrs
          <#  ##: ##: ##: DECIMAL #S #> TYPE
          R> BASE ! ;

\ the background time printer task
DECIMAL
: CLOCK  ( -- )
         BEGIN
            30 MS
            28 0 AT-XY  .TIME
         AGAIN
;

\ convert time format to seconds as double int.
DECIMAL
: TIME>D  (  sec min hr -- d)
          60 * +  ( sec mins')  \ hrs > mins + mins
        3600  UM*  2>R          \ Mins to frames & push
          60  UM*               \ seconds to frames
          2R> D+  ;             \ frames + frames

: SETCLOCK  ( sec min hr -- ) TIME>D  FRAMES 2! ;

: COLD    0 INSTALL  COLD ;     \ disable ISR before restarting

DETACH  \ removes tools & Assembler from low-memory

USIZE MALLOC CONSTANT BGCLOCK  \ allocate memory in HEAP and name our task
BGCLOCK FORK                   \ duplicate Forth's user area into BGCLOCK

' CLOCK BGCLOCK ASSIGN         \ Assign execution token of CLOCK to our task

ISR' FRAMES++ INSTALL          \ start the counter
MULTI                          \ enable mutlti-tasker

CR .( Set clock with:  SETCLOCK )
CR .( Start clock with BGCLOCK WAKE )

 

 

(Windows froze Classic99 in the video LOL!)

 

Edited July 7, 2022 by TheBF

[+TheBF]

I am going over my library files for Github with fresh eyes. Slowly I am learning...

 

I saw this code for a thing called STRAIGHT, a word from POLYFORTH.

It's better as a CODE word but I had a test version in Forth

My first version used a DO LOOP with IF in the middle and LEAVE to get out. Kind of Ugly. 

 

Since I have added these ISO Forth loop structures things look different. (should I be on medication?)  

 

Lee may not be happy with that BEGIN WHILE UNTIL THEN thing,

but these words are way simpler now, when you can jump out of a loop like in assembler.

I confess that I did spend a lot of time inside the console to see what the heck was really happening

My hope is that copious comments might help me remember it the next time I look but the code seems more solid now. 

I will have to test this on RS232 and see how fast it can receive continuous bytes 

 

\ STRAIGHT in Forth. Rcv bytes into buffer, no echo. bjf Feb 2020
\ re-write with ISO WHILE loops Jul 2022
HERE

DECIMAL
: TIMEKEY ( wait-time -- c ?)  \ 1000 ~= 1000mS on TI-99
\ waits for a key until counter hits zero
      BEGIN 1-    \ decrement wait-time
        DUP WHILE ( wait-time > 0 )
        KEY?
        ?DUP
      UNTIL
      ( -- cntr key)
      NIP        \ key was detected, remove the counter

      THEN       \ timer elaped before key pressed.
      DUP 0>     \ add the true/false flag
;

: STRAIGHT ( addr len -- addr len)
       BOUNDS TUCK  ( -- start end start )
       KEY OVER C! 1+  \ wait & store 1st key, bump address
       BEGIN 2DUP >    WHILE ( end>start) \ continue else jump to THEN
          1000 TIMEKEY WHILE ( key<>0)
          OVER C! 1+   \ store & bump address
       REPEAT          \ and keep going
       THEN            \ jump out point. resolves 1st WHILE
       DROP OVER -     \ compute the length
;

HERE SWAP - SPACE DECIMAL . .( bytes)

 

Edited July 14, 2022 by TheBF
dumb typos