Camel99 Forth Information goes here

+TheBF · January 12

Heresy of Heresies

Over on Reddit Forth there was a discussion on local variables.

Stephen Pelc of VFX Forth said that their experiments show as much as 50% slowdown using locals instead of the data stack.

One of the posts was made by a Forth implementer (Zeptoforth) who said that he has switched to using locals a lot and it has NO effect on the speed of his programs.

His thinking is that locals would only be much slower on a compiler that converts stack data into register assignments but on regular Forth compilers it is neutral.

That made me wonder...

I had one version of "cheap" locals that I knew was not optimal and one that used 9900 index addressing into the return stack.

The downsize of the indexing version was you needed to create two names: 1 to fetch and 1 to store.

In my past tests the Forth version of BENCHIE using a fast VALUE ran in 24.3 seconds.

The non-optimal locals version ran in 48 seconds... but I had never done the test with the better version.

Turns out that guy on Reddit was correct. In fact the locals version ran a bit faster on Camel99 Forth.

I think this is because of the 9900 property that less instructions is almost always faster.

In this case local fetch is:

MOV n(RP),TOS

Store to local is

MOV TOS,n(RP)

That's about as good as it can get.

So it makes me think I could make some kind of defining word that creates a double CFA word.

By default the local does a fetch from return stack to the data stack.

Then make a word like TO for values that compiles the store code address when we assign to a local.

Here is the experiment code.

Spoiler

\ Benchie.fth from the internet

\ tForth (20 MHz T8): 196 bytes 0.198 sec
\ iForth (33 MHz '386): 175 bytes 0.115 sec
\ iForth (40 MHz '486DLC): 172 bytes 0.0588 sec
\ iForth (66 MHz '486): 172 bytes 0.0323 sec
\ RTX2000: 89 bytes 0.098 sec (no Headers)
\ HSF2000 (1.6GHz AMD Sempron) ?? bytes  0.22 secs
\ 8051 ANS Forth (12 MHz 80C535): 126 bytes 15,8 sec (met uservariabelen)
\ HSF2000 2014 with a 2.1 Ghz Intel  0.05 seconds.
\         increased loop size X10   0.16

\ CAMEL99 v2.7    
\ W/FAST VALUES      24.21
\ W/locals           24.08 
\ TurboForth V1.2.1  24.6  (for reference)

NEEDS ELAPSE FROM DSK1.ELAPSE
NEEDS DUMP   FROM DSK1.TOOLS
NEEDS VALUE  FROM DSK1.VALUES 


HERE
HEX
CODE LOCALS ( n --) \ build a stack frame n cells deep
\ *pushes the original RP onto top of rstack for fast collapse
\ RP R0 MOV, TOS 1 SLA, TOS RP SUB,   R0 RPUSH,     TOS POP,
  C007 ,    0A14 ,   61C4 ,    0647 , C5C0 ,  C136 ,  NEXT,  
ENDCODE

CODE /LOCALS  ( -- ) \ collapse stack frame
    C1D7 , NEXT, \ *RP RP MOV, NEXT,
ENDCODE

\ Local variable compilers make named code words
: GETTER  ( n --) \ create name that returns a contents of a local
\           TOS PUSH,  ( n) 2* (RP) TOS MOV,  NEXT,  ;
  CODE     0646 , C584 , C127 , CELLS ,       NEXT,  ;

: SETTER ( n --) \ create name that sets contents of a local
\      TOS SWAP CELLS (RP) MOV, TOS POP, 
  CODE    C9C4 ,   CELLS ,    C136 ,  NEXT,  ;

: ADDER  ( n -- ) \ defines a local for +! operation
\      TOS SWAP CELLS (RP) ADD, TOS POP, 
  CODE    A9C4 ,   CELLS ,    C136 ,   NEXT,  ;

\ defines a "setter" and a "getter"   
: LOCAL:  ( n ) DUP GETTER  SETTER  ;


\ conventional BENCHIE 
HEX
100 CONSTANT MASK
  5 CONSTANT FIVE
    VALUE BVAR
: BENCHIE
        MASK 0
        DO       \ locals work inside do loop   
            1
            BEGIN
              DUP SWAP DUP ROT DROP 1 AND
              IF FIVE +
              ELSE 1-
              THEN TO BVAR
              BVAR DUP MASK AND
            UNTIL
            DROP
        LOOP
;  \ 24.21 seconds 

\ BENCHIE with locals 
\ create two names. one to fetch, one to store 
\        fetch   store  
1 LOCAL: BVAR    BVAR! 
2 LOCAL: NDX     NDX! 

: BENCHIE2 
        1 LOCALS \ define outside do loop  
        MASK 0
        DO       \ locals work inside do loop   
            1
            BEGIN
              DUP SWAP DUP ROT DROP 1 AND
              IF FIVE +
              ELSE 1-
              THEN BVAR!
              BVAR DUP MASK AND
            UNTIL
            DROP
        LOOP
        /LOCALS
;  \ 24.08 seconds

+TheBF · January 17

I made the mistake of trying to use the Camel99 Linker. Homemade software. Amateur coder.

What can I say.

Anyway I had to dig in and make external references work properly. Turns out I had not tested that functionality enough.

Currently I only can handle relocatable code. AORG programs may not be possible with this method. (?)

Explanation:

All the DEF references in a "library" become words in the DEFS vocabulary when the object file is linked.

The DEFS words become Forth CONSTANTs.

They just return the entry address of the external code, where it sits in TI-99 low RAM after linking.

When your program has REF to an external DEF the object code, it has strings embedded in it at the end that are

"tagged" with a '3' if it is a RELOCATABLE reference.

Like this:

30016VFILL 30026VMBW

After the '3' the next 4 chars are a number which is the offset in memory (from the current load point) where there is a missing address.

The next 6 characters are the text name of the missing program.

Using Forth's FIND function, which we restrict to looking only in the DEFS vocabulary, we get the missing address and store it (with !)

in low RAM at the offset+BASE-MEM. Simple!

Here is the business end of the code for TAG 3 written "linker Forth"

This made it pretty simple to create the functionality once I got my head around it.

: RELOCATE ( addr -- addr')  BASE-MEM + ;

: ?REF
    0= IF
       CR
       CR ." ? External REF not loaded"
       CR ." >>> " PAD COUNT TYPE
       ABORT
    THEN ;

: FIND-EXT  
    ONLY DEFS FIND         \ search only the defs vocabulary
    ONLY FORTH ALSO DEFS ; \ restore normal searching 

: TAG3
   PARSE# RELOCATE >R          \ External address to Rstack 
   GETLABEL PAD PLACE          \ store label in PAD    
   PAD FIND-EXT NIP ?REF       \ check the dictionary  
   PAD COUNT EVALUATE          \ evaluate DEF word to generate the address 
   ( defaddr ) R> !            \ store the def addr in Extern memory
;

So here is LINKERIII.

It still does not let you save a binary version of your program but you can explore and run sub-routines and programs

and change data in your assembly language programs all from within Camel99 Forth.

CAMEL99-ITC/UTILS/LINKER at master · bfox9900/CAMEL99-ITC (github.com)

And here is a video of how you might use it.

+TheBF · January 18

I proposed the idea of using Intel HEX format for transforming binary files to a Pascal program over in another thread.

I reached back into my archive and found the program I used to get the a binary image of my MaxForth programs sent to the terminal.

I would send this code to Maxforth over RS232.

Then I would turn on the file capture on the terminal and type something like

HEX 0 2000 INTELHEX

to capture an 8K of RAM at address >0000.

Then I could send the intelHEX file to my ROM burner. Ah.. the good old days.

The output from the program is in the video. I am working on a parser and loader so that I can transfer data to my hardware TTY Forth.

Here is the code for Camel99 Forth.

Spoiler

( INTELHEX  dump data in INTEL-HEX FORMAT )

( Written by the late Randy Dumsy for Maxforth )
( *** This program was used with the MOTOROLA 68HC11 *******)
( Ported to Camel99 Forth Jan 17 2024)

( INSTRUCTIONS:                        )
( Load this program by sending it to the new-micros computer board )
( PLace your terminal program in the capture mode)
( Then type in the start address, the number of bytes and the command )
( INTELHEX  ( Example:  HEX 000 800 INTELHEX )
( MAX-FORTH will then transmit the INTEL format to you!)


\ ** for camel99 forth **

INCLUDE DSK1.OUTFILE  \ echoes emit, cr, type, to a file
INCLUDE DSK1.TOOLS 
HEX

VARIABLE CHKSUM
( convert and emit)
: .DIGIT  ( char -- ) DUP 0A < IF [CHAR] 0  ELSE [CHAR] 7 THEN + EMIT ; 
: 2.R     ( c --) FF AND 10 /MOD .DIGIT .DIGIT ;
: 4.R     ( n --) 0  100 UM/MOD  2.R  2.R ;

\ convert address to 16 byte boundary (for DOS memory) :-)))
: 16'S    ( addr -- addr')  10 /  1+ 10 * ; 

\ size constants 
 400 CONSTANT 1K
 800 CONSTANT 2K
1000 CONSTANT 4K
2000 CONSTANT 8K

\ we must use S" and TYPE for the redirection to file to work. 
: INTELHEX ( addr count -- )
    OVER + SWAP
    BEGIN
        CR
        2DUP 10 + MIN   \ make line of output upto 16 bytes long
        SWAP
        S" :" TYPE               \ 
        2DUP -              \ calc number of bytes in file)
        DUP CHKSUM !        \ initialize the chksum )
        2.R
        DUP >< FF AND  OVER  FF AND +  CHKSUM +! ( PFM!)
        DUP 4.R             \ print it   
        S" 00" TYPE               \ need some zeros 
        >R DUP R>           \ 
        DO
            I C@ DUP 2.R    \ print out a byte ... 
            CHKSUM +!       \ ... also put it in the CHKSUM
        LOOP
        CHKSUM 1+ C@ NEGATE 2.R
        2DUP =
    UNTIL
    CR S" :00000001FF" TYPE  CR      ( print end of file record)
    2DROP ;

+TheBF · January 19

Ok this took me longer to get working than it should have but here is an Intel HEX loader.

I got a bit cheeky.

Since the data consists of lines of text we need some kind of parser.

I wondered if could use the approach we see in string words that take address,length pairs and return a new string pair.

So the secret of this method is CHOP. CHOP takes a string and CHOPs at an index but it returns both the chopped string AND the remaining string underneath.

\ renamed for clarity of purpose 
: LEFT$  ( addr len n -- addr len' ) NIP ;
: RIGHT$ ( addr len m -- addr' len') /STRING ;

: CHOP  ( addr len n -- addr1 len1 addr2 len2 )
    >R                 \ we need n twice, use return stack 
    2DUP  R@ LEFT$     \ substring 
    2SWAP R> RIGHT$    \ "RIGHT$" is remainder
    2SWAP ;            \ substring back on top
;

Armed with this powerful tool we can make field "tags" that chop the correct number of bytes from the string and convert them to a number.

: $VAL  ( addr len -- n) NUMBER? ABORT" Bad number" ;

: <?START>  ( addr len -- addr' len') 
   1 CHOP DROP  C@ [CHAR] : <> ABORT" Start code not found" ; 

: <RECLEN>  ( addr len -- addr' len' n ) 2 CHOP $VAL ;
: <ADDRESS> ( addr len -- addr' len' n ) 4 CHOP $VAL ; 
: <RECTYPE> ( addr len -- addr' len' n ) 2 CHOP $VAL ;
: <DATA>    ( addr len -- addr' len' n ) 4 CHOP $VAL ;

\ This is the last tag. It consumes the string. 
: </CHKSUM>  ( addr len --  n ) $VAL CHKSUM ! ;

This becomes our little language for parsing the lines of text.

I think this is a very different way to make a parser that we might see in another language.

This all culminates with LOADHEX that reads an IntelHEX file and loads it into memory per the addresses in the file.

It's a bit like TI object code but with only one function. ie: put these numbers in memory.

The rest was just getting the whole thing organized into a loop structure.

Again I resorted to the double WHILE construct because we need to test two conditions.

Is the file empty and is this the "end of data: record.

The entire file is here. I have not implemented computing the checksum on the file data as it is read.

I should be able to use Randy's code from the IntelHEX encoder to make that work and add the calculation to the <DATALINE> tag.

That's a follow up job.

Spoiler

\ HEXLOADER.FTH  loads intel hex files into memory   Fox 2024 

INCLUDE DSK1.TOOLS 
INCLUDE DSK1.ANSFILES 
INCLUDE DSK1.VALUES 

VARIABLE CHKSUM

HEX 
\ renamed for clarity of purpose 
: LEFT$  ( addr len n -- addr len' ) NIP ;
: RIGHT$ ( addr len m -- addr' len') /STRING ;

: CHOP  ( addr len n -- addr1 len1 addr2 len2 )
    >R                 \ we need n twice, use return stack 
    2DUP  R@ LEFT$     \ substring 
    2SWAP R> RIGHT$    \ "RIGHT$" is remainder
    2SWAP ;            \ substring back on top
;

: $VAL  ( addr len -- n) NUMBER? ABORT" Bad number" ;

\           *** data management tags ***
\ Words that are in angle brackets operate on a string.
\ They take a part of the string convert it to a number
\ and leave the remainder of the string on the data stack 
\ for the next function to use. 

\ aborts if start code not found 
: <?START>  ( addr len -- addr' len') 
   1 CHOP DROP  C@ [CHAR] : <> ABORT" Start code not found" ; 

: <RECLEN>  ( addr len -- addr' len' n ) 2 CHOP $VAL ;
: <ADDRESS> ( addr len -- addr' len' n ) 4 CHOP $VAL ; 
: <RECTYPE> ( addr len -- addr' len' n ) 2 CHOP $VAL ;
: <DATA>    ( addr len -- addr' len' n ) 4 CHOP $VAL ;

\ This is the last tag. It consumes the string. 
: </CHKSUM>  ( addr len --  n ) $VAL CHKSUM ! ; 

DECIMAL 
0 VALUE #1  \ file handle holder 

: OPEN     ( fam -- )  OPEN-FILE ?FILERR ;
: READLN   ( addr -- addr size ?) DUP 80 #1 READ-LINE NIP 0= ;

: <DATALINE> ( addr len -- ) BOUNDS DO  <DATA> I !  2 +LOOP ;

: LOADHEX ( path$ len -- )
    HEX 
    DV80 R/O OPEN TO #1 
    BEGIN 
       PAD READLN  ( -- addr len ?)
    WHILE ( read=true)
       <?START>      \ TEST for start code. Abort if wrong
       <RECLEN>  >R  \ use this later 
       <ADDRESS> >R  \ use this later ( r: -- len addr)
       <RECTYPE> 0=  \ 0 means a data record  
    WHILE     
       R> R>       ( -- addr len )    
       <DATALINE>  \ parse the data and write to memory 
       </CHKSUM>   \ clean up what's left, record chksum
    REPEAT 
     UNLOOP        \ first time I ever used this word :-)
    THEN 
    2DROP
    #1 CLOSE-FILE ?FILERR
;

Edited January 19 by TheBF
removed debug code lines

+TheBF · January 19

So LOADHEX is not a speed demon. 27 seconds to parse and load a 4K test file to memory.

I think a big part of speed is in the word >NUMBER which is written for double number conversion.

If we wrote a bespoke 16 bit number convertor we might get it a bit faster. But I am ok with it.

The alternative is to do what @VORTICON did and write the output to a binary file that the file system can inhale.

Hmmm. INHALE might be good name for that file function.

+Vorticon · January 20

4 hours ago, TheBF said:

So LOADHEX is not a speed demon. 27 seconds to parse and load a 4K test file to memory.

I think a big part of speed is in the word >NUMBER which is written for double number conversion.

If we wrote a bespoke 16 bit number convertor we might get it a bit faster. But I am ok with it.

The alternative is to do what @VORTICON did and write the output to a binary file that the file system can inhale.

Hmmm. INHALE might be good name for that file function.

Can you post that text HEX file? I'd like to use it as a test as well.

+TheBF · January 20

Sure.

4KHEXDUMP

+TheBF · January 20

I supposed it's worth showing how I made the file.

I used a little fill memory loop and then used my OUTFILE library to capture the output of INTELHEX to a file.

Here is the "script".

INCLUDE DSK1.OUTFILE
INCLUDE DSK2.INTELHEX

\ FILLMEMORY 
HEX 
: FILLMEM ( ADDR #cells -- ) 
  0 DO
       I OVER ! 
       CELL+
  LOOP 
;

HEX 2000 1000 FILLMEM

S" DSK2.4KHEXDUMP" MAKE-OUTPUT 
2000 1000 INTELHEX 
CLOSE-OUTPUT

Is not perfect because it has one empty line at the top so I just loaded it into the editor and removed the top line and re-saved.

+Vorticon · January 20

11 hours ago, TheBF said:

Sure.

4KHEXDUMP 13.13 kB · 2 downloads

I think the formatting is wrong here. The data length entry is half of what it should be. Per my understanding of the Intel Hex specification, each hex character is counted, not each hex digit pair. Also it looks like you are using a field of 4 for each data item where it should be only 2.

I assumed that each data record will be on a separate line but can't find documentation on this. If not I will need to make modifications to my conversion program...

+TheBF · January 20

Interesting.

The encoder that I am using is a hand me down from the MaxForth development system but Randy, the author, died in 2022 so we can't ask him.

It is possible that there is a dependancy in his code for Motorola 6811 CPU. A byte order thing would not surprise me given the 9900's personality.

I see he does the checksum computation at the byte level by taking each byte in a integer adding them together and adding that sum to the CHKSUM.

DUP >< FF AND  OVER  FF AND +  CHKSUM +!

There are a number of data length options for IntelHEX. In the Wikipedia article it shows what looks like extensions for larger word size for new CPUs.

What I know is that this program output a file that worked perfectly with an old EPROM burner that I had so I had no reason to question it.

I may be able to find my old 68hc11 dev board and get a sample output of the same data from this code.

I will review the spec too and see if it gives me any insights.

On we go.

+TheBF · January 20

From what I can see this file complies with DATA record type "00"

Randy's code seems to be the simplest version that only handle record type 00 and 01.

"Special names are sometimes used to denote the formats of HEX files that employ specific subsets of record types. For example:

I8HEX (aka HEX-80) files use only record types 00 and 01"

https://en.wikipedia.org/wiki/Intel_HEX

+TheBF · January 20

4 hours ago, Vorticon said:

The data length entry is half of what it should be.

Record type 0 has a byte sized count so it's length is limited to 255.

4 hours ago, Vorticon said:

Also it looks like you are using a field of 4 for each data item where it should be only 2.

Randy's encoder is reading memory a byte at time and outputting the byte value to the record.

4 hours ago, Vorticon said:

I assumed that each data record will be on a separate line but can't find documentation on this. If not I will need to make modifications to my conversion program...

From Wikipedia:

"Programs that create HEX records typically use line termination characters that conform to the conventions of their operating systems. For example, Linux programs use a single LF (line feed, hex value 0A) character to terminate lines, whereas Windows programs use a CR (carriage return, hex value 0D) followed by a LF."

+TheBF · January 20

On 1/20/2024 at 9:17 AM, TheBF said:
I see he does the checksum computation at the byte level by taking each byte in a integer adding them together and adding that sum to the CHKSUM.
DUP >< FF AND  OVER  FF AND +  CHKSUM +! 

~~My mistake. Summing these bytes is used only to initialize the CHKSUM variable.~~

As I built the loader program I began to understand what Randy's code was doing on the encoding side.

The code above was used for an integer argument. It is split into two bytes and the bytes are added together.

The resulting byte is then added to the checksum.

34 years ago I didn't take the time to figure this out. I just used the program.

In CAMEL99 Forth this becomes: SPLIT +

(SPLIT is a code word that I made to solve some problem in the Graphics code way back when.

It has a reciprocal called FUSE, which fuses two bytes into an integer.)

Edited January 24 by TheBF
Understanding

+TheBF · January 21

While looking for something else I found this question by @FarmerPotato.

"Does anyone know of a FORTH implementation of the TI tagged object file loader?

I found some old assembly code for a game. It would be nice if there were a way to use the assembled code so far in FORTH wrappers.

And continue to develop in FORTH. Changes to the assembly code would be assembled outside, then imported to the project. Ultimately the whole thing gets BSAVEd and run out of a FORTH prompt."

Well my latest linker seems more practical and I can save a binary program that also loads LOW ram with the set of files so I think I could get this going.

Do you still have those files Erik?

+TheBF · January 24

Here is a version of of LOADHEX that calculates a checksum as the file records are parsed and compares it to the checksum at the end of each record.

The checksum addition is embedded in each parsing word that cuts the record string and converts to a number.

If you type CHECKSUM OFF the loader will ignore the checksum byte at the end of each record.

CHECKSUM ON will cause the program to halt with an error and a line no. if the checksums do not match.

The MaxForth encoder seems to do something tricky. I have not figured out if it is compliant with the checksum specification

Randy's code adds each binary byte to a variable.

But the value it puts at the end of each record is that total, taking only the lower order bits , NEGATE that byte and mask with >FF.

(see CHKSUM@ below)

Anyway this loader uses what it was given. I will review the spec. and see if there is something wrong.

(I suspect Randy was smarter that I am in this area)

Spoiler

\ HEXLOADER.FTH  loads intel hex files into memory   Fox 2024 

INCLUDE DSK1.TOOLS 
INCLUDE DSK1.ANSFILES 
INCLUDE DSK1.VALUES 

VARIABLE CHKSUM     \ Accumulator for to compute check sum
VARIABLE CHECKSUM   \ flag:. halts on checksum error if CHECKSUM=TRUE

HEX 
\ renamed for clarity of purpose 
: LEFT$  ( addr len n -- addr len' ) NIP ;
: RIGHT$ ( addr len m -- addr' len') /STRING ;

: CHOP  ( addr len n -- addr1 len1 addr2 len2 )
    >R                 \ we need n twice, use return stack 
    2DUP  R@ LEFT$     \ substring 
    2SWAP R> RIGHT$    \ "RIGHT$" is remainder
    2SWAP ;            \ substring back on top
;

: $VAL  ( addr len -- n) NUMBER? ABORT" Bad number" ;

\           *** data management tags ***
\ Words that are in angle brackets operate on a string.
\ They take a part of the string convert it to a number
\ and leave the remainder of the string on the data stack 
\ for the next function to use. 

\ aborts if start code not found 
: <?START>  ( addr len -- addr' len') 
   1 CHOP DROP  C@ [CHAR] : <> ABORT" Start code not found" ; 

\ field parsers update the chksum variable
: <RECLEN>   ( addr len -- C ) 2 CHOP $VAL DUP CHKSUM +!  ;
: <ADDRESS>  ( addr len -- n ) 4 CHOP $VAL DUP SPLIT + CHKSUM +! ; 
: <RECTYPE>  ( addr len -- C ) 2 CHOP $VAL DUP CHKSUM +! ;
: <DATABYTE> ( addr len -- C ) 2 CHOP $VAL DUP CHKSUM +! ;


\ This is the last tag. It consumes the string. Returns file's chksum
: </CHKSUM>  ( addr len --  n ) $VAL ; 

0 VALUE #1  \ file handle holder 

: OPEN     ( fam -- )  OPEN-FILE ?FILERR ;
: READLN   ( addr -- addr size ?) DUP 80 #1 READ-LINE NIP 0=  ;

: <DATALINE> ( addr len -- ) BOUNDS DO  <DATABYTE> I C!  LOOP ;

\ This matches the checksum calc used by MaxForth's intel HEX save. 
: CHKSUM@  ( -- c) CHKSUM 1+ C@ NEGATE 0FF AND ;

: .DEC        BASE @ >R  DECIMAL  .  R> BASE ! ;

: ?ABORT  CHECKSUM @ ABORT" LOADHEX halted" ;

: ?CHECKSUM  ( n -- ) 
   CHKSUM@ <> 
   IF  
      CR ." >>> Checksum error Line: " LINES @ .DEC
      ?ABORT
   THEN  ;

: LOADHEX ( path$ len -- )
    LINES OFF 
    HEX 
    DV80 R/O OPEN TO #1 
    BEGIN 
       PAD READLN  ( -- addr len ?)
       LINES 1+!       
    WHILE ( read=true)
       CHKSUM OFF 
       <?START>      \ TEST for start code. Abort if wrong
       <RECLEN>  >R  \ use this later 
       <ADDRESS> >R  \ use this later ( r: -- len addr)
       <RECTYPE> 0=  \ 0 means a data record  
    WHILE     
       R> R>       ( -- addr len )    
       <DATALINE>  \ parse the data and write to memory 
       </CHKSUM>   \ clean up what's left. Return file line chksum 
       ?CHECKSUM   \ compare to computed chksum from file load
    REPEAT 
     UNLOOP        \ first time I ever used this word :-)
    THEN 
    2DROP
    #1 CLOSE-FILE ?FILERR
;

\ HEX 2000 2000 FF FILL \ for testing 
CHECKSUM ON

+TheBF · January 26

Back 2021 I needed a way to capture text output from programs.

I threw something together but it was not ideal. For example if you sent strings to the screen without a CR now and then it would fail.

This updated version is more robust and bettered factored.

>> If you have a Camel99 system disk, please replace DSK1.OUTFILE with this file.

Of note to the student of Forth on TI-99, I am accessing the PAB, in VDP memory, just as easily as CPU RAM by using the VDP operators V@ V! VC@ and VC!.

The do the same things as their regular Forth namesakes.

The various fields of PAB are accessed referenced to the "SELECTed" file PAB with a syntax using the active PAB with a field selector word.

The field selector simply adds an offset to the base address of the PAB. These are the words that have square brackets.

To use this file you INCLUDE DSK1.OUTFILE first. Then any program loaded afterwords will use the dual output versions of the text output words.

If you MAKE-OUTPUT or OPEN-OUTPUT (append mode) the program text will go to the screen and echo to the file.

Kernel words that use the kernel output words will not echo to the file.

In future I might patch the kernel words which would make everything to echo but at this time I don't need that.

Spoiler

\ OUTFILE.FTH   echo screen output to text file      May 2021  Brian Fox
\ updated Jan 2024 

\ Method: Write data directly into PAB file buffer
\ Use the PAB char count in the PAB as pointer into the PAB when we write.
\ ie: the buffer address= [PAB FBUFF] V@  + [PAB CHARS] VC@ 
\ Only write to disk when CR is encountered or if buffer will overflow.
\ No control characters allowed. Use spaces for DV80 files

\                   *** THIS VERSION WORKS **** 
NEEDS WRITE-FILE  FROM DSK1.ANSFILES
NEEDS VALUE       FROM DSK1.VALUES
 
DECIMAL
0 VALUE OUTH   \ output file handle
VARIABLE FOUT  \ byte counter for outfile 

: MAKE-OUTPUT ( a u -- ) \ *G creates a new output file
    DV80 W/O CREATE-FILE ?FILERR  TO OUTH 
    FOUT OFF ;
 
\ : W/A   APPEND FAM @ ;  \ Moved to DSK1.ANSFILES
: .OUT  ( -- ) FOUT @ U. ." bytes output"  ; 

: OPEN-OUTPUT  ( a u -- ) \ open output file in APPEND mode
    OUTH ABORT" Output file is already open"
    DV80 W/A OPEN-FILE ?FILERR  TO OUTH 
    FOUT OFF ;
 
: CLOSE-OUTPUT ( -- )
    OUTH CLOSE-FILE DROP   0 TO OUTH 
    .OUT ;
 
: WRITE-PAB ( handle -- ) SELECT  3 FILEOP ?FILERR ;

: [PABCHARS]+! ( n -- ) [PAB CHARS] VC@  +  [PAB CHARS] VC! ; 
: [OUTBUFF]    ( -- Vaddr) [PAB FBUFF] V@   [PAB CHARS] VC@ + ;

: FLUSH-BUFFER ( -- ) OUTH WRITE-PAB    0 [PAB CHARS] VC! ;
 
: OVERFLOW?  ( n -- ?)  \ test n bytes will overflow buffer
    [PAB CHARS] VC@ +   \ add n to chars in the buffer 
    [PAB RECLEN] VC@ >  \ compare to the maximum size 
;

: >>OUT ( caddr len -- )
    OUTH 0= ABORT" Output file not open"
    OUTH SELECT 
    DUP OVERFLOW? IF  FLUSH-BUFFER  THEN 
    TUCK  ( -- len caddr len )         \ get a copy of the length
    [OUTBUFF] SWAP VWRITE              \ write string to PAB buffer
    ( len) DUP [PABCHARS]+!  FOUT +! ; \ update Char count
 
\ ==========================================
\ redefine standard output words to echo to file if output handle<>0
: EMIT  ( c --)   OUTH IF DUP HERE C!  HERE 1 >>OUT  THEN EMIT ;
: TYPE  ( a u --) OUTH IF 2DUP  >>OUT  THEN TYPE ;

: ."  (  ccc" -- )
    POSTPONE S" 
    STATE @ IF POSTPONE TYPE   EXIT   THEN TYPE ; IMMEDIATE

: SPACE   BL EMIT ;
: SPACES  ( n -- ) 0 MAX  0 ?DO  SPACE LOOP ;
 
: CR   ( -- )
    OUTH IF \ file is open
       [PAB CHARS] VC@  0= IF SPACE THEN FLUSH-BUFFER
    THEN CR  ;
 
\ number output with echo
: UD.  ( d -- ) <#  #S  #> TYPE SPACE ;
: U.   ( u -- ) 0 UD. ;
: .    ( n -- ) DUP ABS 0 <#  #S ROT SIGN  #> TYPE SPACE ;

OUTFILE

+TheBF · January 30

OH I do go down rabbit holes.

While doing some housecleaning I found a failed attempt to make timers.

I had to make it work.

So these timers use the ISR to run a master 32 bit counter.

When you create a timer is records 2 things:

The number of seconds it will run before expiring
The value of the counter + the number of seconds

When you call the timer by name, it compares the master counter to the number it has stored inside of itself.

If the master counter is greater than it returns TRUE, meaning the timer expired.

The advantage here is that you do RESET <TIMER_name> and then your program can do whatever is needed and test the timer when it can.

The overhead of the IST is almost nothing since it is just 3 instructions max + return.

Here is an example program:

\ test
4 TIMER: Q 

: TEST 
    PAGE 
    RESET Q 
    BEGIN 
      BEGIN Q UNTIL           \ wait until  Q expires 
      CR ." 4 sec. elapsed " 
      CR
      RESET Q  
      ?TERMINAL               \ test for break key 
    UNTIL       
;

OK now I can get on with something important.

Spoiler

\ ISR BASED TIMERS  

INCLUDE DSK1.LOWTOOLS  \ assembler, dump, Vdump, .S , elapse 

HEX 
: INSTALL  ( isr-addr -- ) 83C4 ! ; 

: STOPTIMER  0 INSTALL ;
 
  STOPTIMER  

\ 32 bit variable holds the master clock time
CREATE TIME  0 , 0 ,

\ ISR increments the 32bit variable every 16mS
HEX
CODE TIME++ ( -- ) 
  TIME CELL+ @@ INC,
  OC IF,
      TIME @@ INC, 
  ENDIF,
  RT,
ENDCODE

\ start/stop the ISR timer 
: RUNTIMER   ['] TIME++ INSTALL ;

\ debug words 
: TIME@   TIME 2@ ;
: .TIME   TIME@ UD. ;

: DU<  ( d d -- ?) ROT U> IF 2DROP -1  ELSE U<  THEN ;

\ reset a timer's using it's data field address 
: (TRESET) ( addr -- )
    DUP  >R             \ dup timer base address & Rpush 
    @ TIME@ ROT M+       \ read the timers' delay, add to TIME 
    R> CELL+ 2!         \ store new time in the timer 
;

DECIMAL 
: SECONDS  ( n --- n') 1000 16 */  ; \ convert seconds to ticks 

: TIMER: ( n )
    CREATE  
        SECONDS DUP ,  \ compile the time delay in ticks 
        TIME@ ROT M+   \ add delay to current time 
        , ,            \ compile the double into memory 

    DOES> ( -- ?)      \ return true if timer expired 
        CELL+ 2@  TIME@  DU< ; \ compare timer to master


\ reset a timer by name. state smart
: RESET ( timer )  
  '  >BODY 
  STATE @ 
  IF POSTPONE LITERAL  POSTPONE (TRESET) 
  ELSE  (TRESET)
  THEN ; IMMEDIATE  

\ reset master clock to 0 
: MASTER-RESET ( -- ) 0 S>D TIME 2! ;

\ disable the ISR before resarting Forth 
: COLD     STOPTIMER COLD ;

RUNTIMER

+TheBF · February 5

Well the next demo I looked at was putting Forth code into SAMS RAM.

I had always been P___d-off that CREATE DOES> words did not work.

I finally figured out why.

I had started with Mark's ( @Willsy ) excellent example from Turbo Forth. It allowed me to get my head around a method to do this.

Mark's code uses the normal ':' and ';' operators with some very clever use of COMPILE.

But you know, I had to try some ideas. I wanted to reduce the size of the headers and also move the ';' (EXIT) code over to the SAM memory.

So I made some ALC for FARCOL and FAREXIT. This means that my 'FAR:' for SAMS is specific.

The reason why CREATE DOES> fails in my version is that I need to make 'FARCREATE' to be compatible with what I did.

So I spent along time last week trying to fix something that wasn't broken, just not finished!

But at least I have what seems like a solid version for Camel99 Forth. Actually I have two. One is a TURBOFORTH compatible file and then my version.

As a test I did this:

DECIMAL
240 CODEPAGE 
\ 1 SETBANK ( for TurboForth version) 
HERE 
: HELLO   CR ." Hello SAMS World!"  ;
HERE SWAP - . 

INCLUDE DSK1.ANSFILES
INCLUDE DSK1.DIR
INCLUDE DSK1.MORE 
INCLUDE DSK1.CATALOG

So I still have to make FARCREATE but I think I have achieved my original goal of making things a bit smaller.

\ SAMS CODE  TF    CF
\ headers  = 1290   850 
\ code     = 1684  1594 
\ total      2974  2444

Spoiler

\ SAMSCODE.FTH                for Camel99 Forth  Brian Fox
\ Code in SAMS memory based on concept in TurboForth by Mark Wills
\ Ported to Camel99 Forth with changes Oct 13, 2021,

\ Concept:
\ FAR: word headers are in the normal Forth memory space so all SAMS words
\ can be found.
\ FAR: word data structure has two extra fields
\ <link> < HEADER> <imm> <len NAME..> <FARCOL> <BANK#> <IP>

\ FAR: compiles a "fat" header that contains SAMS BANK# and SAMS IP
\  <LINK> 
\  <PRECENDCE> 
\  <NAME> 
\  <CODEPAGE> \ extra field
\  <SAMSPFA>  \ extra field 


\ ;FAR compiles FAREXIT in SAMS memory, not in RAM to save space.

\ Compile time check: ;FAR tests end of SAMS memory

\ HISTORY
\ Update Nov 2022: removed array of SAMS DP variables.
\ - Each SAMS page uses last memory cell to hold its own DP.
\ - Can now compile code to any SAMS page.
\ - You must use <1st> <last> CODEPAGES to initialize SAMS code pages 
\ Feb 2024: Pass codepage via Rstack to CMAP, cleanup & testing 


NEEDS TRANSIENT FROM DSK1.TRANSIENT
TRANSIENT
NEEDS MOV,  FROM  DSK1.ASM9900

PERMANENT
NEEDS DUMP      FROM DSK1.TOOLS
NEEDS SAMSINI   FROM DSK1.SAMSINI  \ common code for SAMS card

HERE
HEX
\ **************[ CHANGE CSEG to your requirements ]******************

HEX              3000 CONSTANT CSEG      \ CODE window in CPU RAM

\ ********************************************************************

\ SAMS memory addresses for code
          CSEG 0FFE + CONSTANT SAMSDP    \ variable at end of SAMS page
          CSEG 0F00 + CONSTANT SAMSEND   \ leave room for scroll buffer      
4000 CSEG 0B RSHIFT + CONSTANT CREG      \ compute CSEG SAMS register
     CSEG 0C RSHIFT   CONSTANT PASSTHRU  \ default RAM page

VARIABLE SAVHERE   \ temp holder for RAM Dictionary pointer
VARIABLE BANK#     \ last SAMS bank# selected
VARIABLE CPAGE     \ active code page used for compiling
CREATE CODEPAGES 0 , 0 ,   \ valid CODEPAGES 

HEX
\ **LEAF SUB-ROUTINE**
CREATE R>CMAP ( -- ) ( R: page# -- )
      R0 RPOP,
      R0 BANK# @@ MOV,   \ update the last bank used
      R0 SWPB,           \ swap bytes
      R12 1E00 LI,       \ set SAMS card CRU address
      0 SBO,             \ turn on the card
      R0 CREG @@ MOV,    \ map it
      0 SBZ,             \ turn off card
      RT,

CODE CMAP  ( page# --) \ Forth word to map SAMS pages
      TOS RPUSH,    \ need parameter on Rstack
      R>CMAP @@ BL,  \ call it
      TOS POP,      \ refill TOS
      NEXT,
ENDCODE

\ run time executor for SAMS colon words.
CREATE FARCOL
     IP RPUSH,
     W IP MOV,            \ IP = DATA cell of this word
     BANK# @@ RPUSH,      \ Save active code page
     *IP+ RPUSH,          \ get codepage to rstack, autoinc IP 
      R>CMAP @@ BL,       \ call R>CMAP (uses RSTACK parameter)
     *IP+ IP MOV,         \ get SAMSDP & set as IP, autoinc IP  
     NEXT,

CODE FAREXIT             \ exit for SAMS word
     R>CMAP @@ BL,       \ restore old codepage & map it in
     IP RPOP,            \ Regular FORTH EXIT
     NEXT,
ENDCODE

\ \\\\\\\\\\\\\\\\ code words end  //////////////////

\ change dictionary pointer to SAMS memory
: SAMSDP! ( addr -- ) 
     HERE SAVHERE !     \ save FORTH here
     ( samsdp) DP !     \ set Forth DP to SAMSDP
;

: FAR: ( -- ) \ special colon for words in FAR memory
     !CSP
     HEADER             \ compile Forth header with name
\ RUNTIME ACTION 
     FARCOL ,           \ compile the new executor as CFA

\ compile code page and SAMSDP for FARCOL to use at runtime 
     CPAGE @ DUP ,      \ compile codepage as the DATA field
     CMAP               \ map in the SAMS page to compile code
     SAMSDP @ DUP ,     \ compile SAMSDP 
     SAMSDP!            \ and switch dictionary to SAMSDP     
     HIDE 
     ]                  \ turn on the compiler
;

: ;FAR ( -- ) \ end SAMS compilation. *NEW* compile time memory test
     POSTPONE FAREXIT    \ compiles at end of SAMS code
     POSTPONE [          \ turn compiler off
     REVEAL ?CSP
     HERE DUP SAMSDP !   \ update HERE for this bank, keep a copy
     SAVHERE @ DP !      \ restore DP to CPU RAM
     SAMSEND > 
     IF 
       CR ." >> Page " CPAGE @ DECIMAL . ." full"
       ABORT 
     THEN 
; IMMEDIATE

: CODEPAGE ( bank# -- ) \ select SAMS page for compiling
  DUP CODEPAGES 2@  1+ WITHIN 0= ABORT" Not a code page" 
  CPAGE ! ; 

HEX
\ Initialize the SAMS memory that we want to use for CODE 
\ ** USE THIS COMMAND ONLY ONCE OR MACHINE WILL CRASH ** 
: CODEPAGES ( 1st last -- ) 
     2DUP CODEPAGES 2! 
     1+ SWAP 
     DO 
       I CODEPAGE
       I CMAP
     \  I . CSEG 1000 FF FILL \ for debugging ONLY 
       CSEG SAMSDP !     \ INIT the local CSEG DP variable to start of CSEG    
    LOOP  
    CODEPAGES @ DUP CODEPAGE CMAP  \ return to RAM memory page
;

: >SAMS  CPAGE @ CMAP ;
: >RAM   PASSTHRU CMAP ; 

>RAM 
: ;   
     BANK# @ PASSTHRU = 
     IF POSTPONE ;  
     ELSE POSTPONE ;FAR 
     THEN ; IMMEDIATE 

: :  BANK# @ PASSTHRU = IF :   ELSE  FAR:  THEN ;


                            DETACH 
HERE SWAP -
DECIMAL CR . .( bytes)

240 255 CODEPAGES \ 16 pages=64K of SAMS space

+TheBF · February 6

Thought I would beat this thing up. I used the Ultimate Benchmarks 1Million Nesting test with a twist.

Every call is too a different SAMS page. Totally brutal.

So it looks like calling a paged Forth word takes about 4 times longer than a regular call.

Not too bad. I removed the instructions that test if the SAMS page is already in memory because it added 2 instructions to skip 6 instructions.

In a test like this it makes things even slower. It might still be worth having for code that uses lots of stuff in the same block.

I am going to see if it compiles and runs on real iron. <scary music here>

Here are the results

\ Normal Forth nesting   
\  TurboForth 1.21     Nesting 1Mil  2:29
\  Camel99 Forth ITC   Nesting 1Mil  2:30
\  Camel99 SAMS card   Nesting 1Mil ~10:00  !!!

Here's the code:

Spoiler

\ Source:  https://www.theultimatebenchmark.org/

\ Normal Forth nesting   
\  TurboForth 1.21     Nesting 1Mil  2:29
\  Camel99 Forth ITC   Nesting 1Mil  2:30
\  Camel99 SAMS card   Nesting 1Mil ~10:00  !!!

>RAM 
INCLUDE DSK1.ELAPSE 

>SAMS 
DECIMAL 
240 CODEPAGE  : BOTTOM ;

241 CODEPAGE : 1st BOTTOM BOTTOM ;  
242 CODEPAGE : 2nd 1st 1st ;      
243 CODEPAGE : 3rd 2nd 2nd ;
244 CODEPAGE : 4th 3rd 3rd ;   
245 CODEPAGE : 5th 4th 4th ;      
246 CODEPAGE : 6th 5th 5th ;
247 CODEPAGE : 7th 6th 6th ; 
248 CODEPAGE : 8th 7th 7th ;      
249 CODEPAGE : 9th 8th 8th ;
250 CODEPAGE : 10th 9th 9th ;
251 CODEPAGE : 11th 10th 10th ;   
252 CODEPAGE : 12th 11th 11th ;
253 CODEPAGE : 13th 12th 12th ;     
254 CODEPAGE : 14th 13th 13th ;   
255 CODEPAGE : 15th 14th 14th ; \ Highest page with 1M SAMS
241 CODEPAGE : 16th 15th 15th ;     
242 CODEPAGE : 17th 16th 16th ;   
243 CODEPAGE : 18th 17th 17th ;
244 CODEPAGE : 19th 18th 18th ;    
245 CODEPAGE : 20th 19th 19th ;   


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

Edited February 6 by TheBF
typo

+TheBF · February 6

It works on real iron.

+TheBF · February 7

OK here's a lesson for stupid people like me.

Make sure you understand what you are testing. 🤦‍♂️

I have been fighting forever to try and duplicate the seamless functionality of Mark's code with the changes I made.

I could never get CREATE to work properly.

Here is the test code. Looks simple enough.

HEX 
CREATE DATA   AAAA , BBBB , CCCC , DDDD ,

I thought somehow magically Mark's code was putting those HEX numbers into SAMS memory.

I NEVER CHECKED that this was true! The problem seems to have been that my "semi-colon" for SAMS was not doing one magic thing.

I thought because I was so clever and using the return stack to nest SAMS calls, that I didn't need one line of code.

So here is the @#$!@ word that has taken years off my life.

: ;FAR ( -- ) \ end SAMS compilation. *NEW* compile time memory test
    POSTPONE GOTO  SAVHERE @ ,  \ get Forth IP back home  *CRITICAL* 
    
    HERE DUP ?FULL SAMSDP !     \ update HERE for this bank, keep a copy
    SAVHERE @ DP !              \ restore DP to CPU RAM
    REVEAL 
    POSTPONE FAREXIT            \ restore previous page and exit 
    ?CSP
    POSTPONE [
; IMMEDIATE

This is complicated because the word is immediate. All the stuff that says POSTPONE doesn't happen until you make new word and that word RUNS.

That first line with the GOTO in it restores the Forth interpreter pointer to normal RAM at RUNTIME. It happens when the SAMS word run & finishes.

All the rest the normal code runs when you compile the new word. Meaning at COMPILE TIME.

But the order is critical because the dictionary pointer has to be correct for each situation. My head hurts.

I will put the new version up in the repository later today as LIB.ITC\DSK1.SAMSCODE

The changes, for reference are:

Remove the need for a separate stack. Use the return stack to nest SAMS pages
Remove the array of dictionary pointers. Record SAMS dictionary pointers in the last cell of each page.
Replace DOCOL with FARCOL that pushes the IP and pushes the current SAMS page and reads two extra data fields
Replace EXIT with FAREXIT that pops the save SAMS page and maps it into memory, and then does Forth EXIT

My idea is to treat CODE and DATA separately in SAMS so this system forces you to decide on a range of SAMS pages for CODE.

I chose the upper 64K. ( you could initialize more if you want, but keeping them contiguous is easiest)

The rest can be used for data. I have a pretty good virtual memory system for that.

Edited February 7 by TheBF
typo

GDMike · February 7

Yes,words take years off my life I found.

You're still a forth guru even in willsy code.

Edited February 7 by GDMike

+TheBF · February 7

33 minutes ago, GDMike said:

Yes,words take years off my life I found.

You're still a forth guru even in willsy code.

As long we use the word "guru" loosely.

+TheBF · February 19

One of the problems with the Forth 94 Standard and more so in 2012, is the stuff that is dependent on other stuff.

For example the word REFILL which behaves one way for reading the console device, (like QUERY with a returned flag)

but it you have the optional "File wordset" it has to behave differently.

"When parsing from a text file, if the end of the parse area is reached before a right parenthesis is found,

refill the input buffer from the next line of the file, set >IN to zero, and resume parsing,

repeating this process until either a right parenthesis is found or the end of the file is reached."

So here are the results of that revelation and today's work.

** You can add the MULTILINE file to your Camel99 Forth system disk if you have room. **

Edit: Fixed a bug in this file. See next post.

+TheBF · February 22

Deeper testing in the real world showed that my multi-line comment worked fine as long as we don't put other brackets into the mix.

I needed to add an extra test for the end of line to trigger a refill. That seemed to fix it.

I also use the new standard word PARSE-NAME. I tend to forget I have it.

It is just

 : PARSE-NAME  ( -- addr len)  BL PARSE-WORD  ;

but it loads from DSK1.SYSTEM at boot time and it takes 2 bytes less if you use it in definitions.

And I realized I didn't need anything as fancy as COMPARE since I am looking for one character.

New version

Spoiler

\ MULTILINE.FTH  comments can extend across many lines 21 FEB 2024
HERE
DECIMAL
\ Standard: 11.6.2.2125 FILE EXT 
: REFILL ( -- ?) \ len=0 means no input
  TIB DUP    
  SOURCE-ID @ ( console=0, file=1,2 or 3)
  IF  ( text from file )  
     2 FILEOP ?FILERR FGET 
  ELSE ( text from console ) 
     80 ACCEPT 
  THEN 
  ( -- addr len)
  DUP IF  
       'SOURCE 2!  >IN OFF  TRUE
        EXIT  
  THEN NIP 
;

: (
    BEGIN
      PARSE-NAME ( -- adr len) 
      IF   C@  [CHAR] ) <> 
      ELSE TRUE  \ no text, force a refill 
      THEN 
    WHILE 
      REFILL   
    REPEAT 
;  IMMEDIATE
HERE SWAP - DECIMAL . .( bytes)

Please delete the previous file and replace with the TI-99 DV80 file below.

MULTILINE

Camel99 Forth Information goes here

Recommended Posts

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Join the conversation

Recently Browsing 0 members