Jump to content
TheBF

Camel99 Forth Information goes here

Recommended Posts

2 hours ago, TheBF said:

       EQ  UNTIL,        \ jump back if no carry flag set

 

<nit picking>

       Should not your comment be “\  jump back if no equal flag set”?

</nit picking>

 

...lee

Share this post


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

 

<nit picking>

       Should not your comment be “\  jump back if no equal flag set”?

</nit picking>

 

...lee

Yes.  Comment creep. :)

  • Like 1

Share this post


Link to post
Share on other sites

I thought I knew something about Forth but no...

 

I was reading comp.lang.forth and read that the ANS Forth word

WITHIN ( n lo hi -- ?)

 

can be used with the lo,hi arguments reversed to reverse the logic.

WITHIN ( n hi lo -- inverted-logic)  

I would never have tried this.

 

Good to know.

 

 

WITHINLOGIC.png

Share this post


Link to post
Share on other sites

Slowly making some progress with the DV80 file editor that uses Forth virtual memory blocks. Currently it's not the fastest in the world by any means but it does have some fun features.  I hated the fact that when typing in the EA editor the screen jumps to deal with the 80 column line length. So this one just slides to the left as you type. :)

And I didn't want to be restricted to blocks of 16 lines so this one now can scroll up and down freely like a normal text editor as well.

 

Currently it can hold 512 lines in a 64K swap file. Inserting lines will not be particularly fast but I want to get it working pretty solidly before going to something like a GAP format for dealing with inserts.

 

It wastes space in the virtual memory because the lines internally are 128 bytes each. This gives me some room to play with inserting into a line but I have not thought that through yet.

 

This is the "worst" form of the editor. The upgrade path is to replace the swap file with SAMS memory blocks since I have a card in my TI-99.

But the swap file method means it could work on a couple of floppy drives with reasonable performance. 

Currently 3K of file is held in low memory at any given time so editing a local buffer is RAM.

 

The video shows how it looks at the moment.

 

  • Like 4

Share this post


Link to post
Share on other sites

Strings and Things

 

It was a 4 hr flight back from Dominican Republic and I found some Forth code on my laptop.  :)

It was a version of my string library that I tested on SwiftForth for OS/X.

 

According to an old source file I wrote the first version of a set of string words for TI Forth in 1987.  It was pretty crude because I was still learning Forth but I wanted to be able to the do the things I did in BASIC with Forth.  I developed a "string stack" that was used to keep the intermediate results of every string operation. This meant that when you did SEG$ for example,  it copied the input string onto the string stack, did the operation and then returned the address of that new temp string  not the original.

 

This meant that you could do interesting things like the BASIC code below;  Pass the arguments from one string operation to another string operation.

100 A$="DSK1.TESTFILE"
110 PRINT SEG$(A$,1,POS(A$,".",1))

(This returns "DSK1.")

 

However it always disturbed me that I was doing all that copying, especially after I learned about Forth "stack strings". These are a data pair that has the address and the length of the string on the data stack.  It sounds weird, but this makes cutting strings almost instantaneous. For example to make LEFT$ you just DROP the length value (throw it away) and replace it with the one you want.  No copying strings willy nilly. The other big advantage is that the results are sitting there on the Forth stack for the next string operation!

 

Edit: I should note that when we save to string variable in this system it is saved as a byte counted string. 1st byte is the length. When we use that string it knows how to return its address and length as a stack string. (see DIM in the code)

 

So on the flight I got the beginnings of a system that only uses stack strings.  It is smaller and faster that code than I had before and it interfaces with standard Forth better because stack strings are the norm now in modern Forth.  So the old 99 is moving forward. :)

 

And the advantage of coding in standard Forth is that if you are careful it even runs on 32bit and 64 bit implementations as you can see in the Gforth screen capture.

 

Here is the new library file:

 
\ Faster/smaller "TI BASIC" string library for CAMEL99   Jan 28 2020 B Fox

\ No string stack. Data stack used for intermediate results
\ Uses stack strings for processing, counted string storage
\ PAD buffer used for concatenation only
\ "Copy on write" (COW) with store string operator. (!$)

\    TI BASIC                      Forth
\ ----------------            ------------------
\ DIM A$(100)                  100 DIM A$
\ DIM B$(100)                  100 DIM B$
\ A$=LEFT$(A$,5)               A$ 5 LEFT$ A$ !$   ( modify, store)
\ PRINT SEG$(A$,4,4)           A$ 4 4 SEG$ PRINT  ( process, print)
\ PRINT A$&B$&C$               A$ B$ & C$ & PRINT ( concatenate, print)
\ A$=B$                        A$ B$ !$           ( store string)

\ ----------------------------------------------------
\ INCLUDE DSK1.TOOLS
HERE
NEEDS -TRAILING FROM DSK1.TRAILING
NEEDS COMPARE   FROM DSK1.COMPARE

DECIMAL
      255 CONSTANT MXLEN   \ 255 bytes is longest string

: ?$IZE    ( n -- ) MXLEN > ABORT" $ too big!" ;

\ convert stack string to its counted string address
: >COUNTED ( addr len -- caddr) DROP [ 1 CHARS ] LITERAL - ;

\ ====[ create a named string of size n ]====
\ When a DIM string is executed it returns a stack string.
: DIM     ( n -- )
          DUP ?$IZE
	  CREATE 0 C, ALLOT ALIGN       \ prepare a counted string
	  DOES>  COUNT ; ( -- addr len) \ returns stack string

\ ==== From Wil Baden's Tool Belt [R.I.P. Wil] ====
: PLACE       ( addr n dst$ -- ) 2DUP C! 1+ SWAP CMOVE ;
\ : C+!         ( n addr -- )      DUP >R  [email protected] +  R> C! ; \ in Kernel 2.5
: +PLACE      ( addr n $ -- )    2DUP 2>R  COUNT + SWAP CMOVE  2R> C+! ;
: APPEND-CHAR ( char caddr -- )  DUP >R COUNT DUP 1+ R> C! + C! ;

\ ==== Replicate TI BASIC string functions ====
: LEN      ( addr len -- addr len c ) DUP ;
\ : LEFT$    ( addr len n -- addr len') NIP ;
\ : RIGHT$   ( addr len n -- addr len) /STRING ;
: SEG$     ( addr len n1 n2 -- addr len) >R /STRING  R> NIP ;
: POS$     ( char $ -- c) ROT SCAN NIP ;
: STR$     ( n -- adr len) DUP ABS 0 <# #S ROT SIGN #> ;
: ASC$     ( addr len -- c) DROP [email protected] ;

\ : -LEADING ( addr len -- addr' len') BL SKIP ;   \ trim leading spaces
\ : CLEAN$   ( addr len -- addr len) -LEADING -TRAILING  ;

: &        ( addr len addr len -- addr len )
           2SWAP PAD DUP >R PLACE  
           [email protected] +PLACE
           R> COUNT LEN ?$IZE  ;  \ abort if string len >255

: ?NUMBER  ( addr len -- n ?)  \ convert to single, 0 flag is good conversion
             OVER [email protected] [CHAR] - =
             IF   TRUE >R  1 /STRING
             ELSE FALSE >R
             THEN 0 0  2SWAP >NUMBER NIP NIP
             R> IF SWAP NEGATE SWAP THEN ;

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

\ compare stack strings
: =$       ( addr len addr len -- flag) COMPARE 0= ;
: >$       ( addr len addr len -- flag) COMPARE 0< ;  \ $1 > $2
: <$       ( addr len addr len -- flag) COMPARE 0> ;  \ $1 < $2

\ *WARNING* You are protected from trying to store a 255 byte string.
\ If the destination string is too small it will crash!
: !$      ( addr len addr len -- ) >COUNTED OVER ?$IZE PLACE ;

\ compile time string assignment
: ="       ( addr len -- <text> )  [CHAR] " PARSE 2SWAP !$ ;

: =""      ( addr len -- ) >COUNTED OFF ; \ sets string length to zero

: PRINT  ( addr len -- ) CR TYPE ;  \ more like BASIC'S print

HERE SWAP - DECIMAL .  .( Bytes)

 

 

And here is the test code used in the short video:

 
\ camel99 string test suite

NEEDS ELAPSE FROM DSK1.ELAPSE

DECIMAL
\ string variable creation and assignment at compile time
255 DIM A$ A$ =" Now is the time "
255 DIM B$ B$ =" for all good men "
255 DIM C$ C$ =" to come to the aid of their country."
255 DIM Q$ 

\ string literal creation is ISO Forth
: D$  S" This is a string literal. Don't change it!" ;
: E$  S"        *I need cleaning*          " ;

\ we can use ISO Forth words on DIM strings
: CLEAN$   ( addr len -- addr len) BL SKIP -TRAILING  ;

: CONCAT1000 ( -- )
         CR ." Concatenate 3 strings and store"
         A$ PRINT  B$ PRINT C$ PRINT
         CR ." 1000 times..."
         1000 0 DO
            A$ B$ &  C$ & Q$ !$
         LOOP
         CR
         Q$ PRINT
         CR ;

: CLEAN1000 ( -- )
         CR ." Clean string & store
         CR ." ->'" E$ TYPE ." '"
         CR ." 1000 times..."
         1000 0
         DO
           E$ CLEAN$ Q$ !$
         LOOP
         CR
         CR ." ->'" Q$ TYPE ." '"
         CR ;

: SEG1000
        CR ." SEG$ test"
        CR ." C$ =" C$ TYPE
        CR ." Perform C$ 14 3 SEG$ Q$ !$"
        CR ." 1000 times..."
        1000 0
        DO
          C$ 14 3 SEG$ Q$ !$
        LOOP
        Q$ PRINT ;

 

 

 

 

GFORTHSTRINGS.png

Edited by TheBF
Added spoilers
  • Like 1

Share this post


Link to post
Share on other sites

It funny how you can stare at code for along time and not see what needs improving and them bang! It's clear as vodka. :)

 

Original Camel Forth "convert a counted string to a number" code:  

(Note: T[CHAR] is the cross-compiler version of [CHAR] , converts a letter to ascii value.)

: ?SIGN      ( adr n -- adr' n' ?)
             OVER [email protected]
             2C - DUP ABS 1 = AND
             DUP IF 1+
                    >R 1 /STRING R>
             THEN ;

: ?NUMBER    ( c-addr -- n -1 )
\ ;Z                  -- c-addr 0         \ if convert error
             DUP  0 0 ROT COUNT
             OVER [email protected] T[CHAR] - = >R
             >NUMBER
             IF    R> 2DROP 2DROP FALSE
             ELSE  2DROP NIP R>
                IF NEGATE THEN TRUE
             THEN ;

Meanwhile I created a version that took a stack string and delivered a false flag on successful conversion:

( which I improved a little this afternoon)

: NUMBER?  ( addr  len -- n ?)  \ convert to single, 0 flag is good conversion
              OVER [email protected] T[CHAR] - =  DUP >R    \ save flag for later
             IF   1 /STRING THEN               \ remove minus sign
             0 0  2SWAP >NUMBER NIP NIP    \ convert the number
             R> IF SWAP NEGATE SWAP THEN  \ negate if needed
 ;

Which means to get the same functionality as the Camel Forth code I only need:

: ?NUMBER  ( c-addr -- n ?)  COUNT NUMBER? 0= ;

Replacing the old code with NUMBER? and adding COUNT and 0=  in the INTERPRET loop saves me 40 bytes in the kernel and is even a tiny bit faster.

 

I am slowly moving away from the original Camel Forth but it makes sense for our favourite machine.

 

 

  • Like 2

Share this post


Link to post
Share on other sites

In the above post I missed the fact that ?NUMBER has a different output depending on if the string converted correctly.

This affects the way the Error message works when conversion fails.  DRAT!  😡

 

So I have more work to do but I like the space savings just the same. Time for supper...

  • Like 1

Share this post


Link to post
Share on other sites

?NUMBER vs NUMBER?

 

So I have netted out at 8126 bytes using ?NUMBER in the INTERPRET loop versus using a much simpler NUMBER? and adding a few extra noise words in the INTERPRET loop and reducing the kernel size to 8092, a saving of 34 bytes.  It literally is four additions to the REPL.  ( DUP COUNT DROP NIP )

So the interpreter/compiler looks like this. A little bit uglier in the number conversion perhaps but more efficient. :)

AND... I don't need to create a special number converter to create VAL$ in the string package.

I am happy with the comprises.

: <INTERPRET>  ( i*x c-addr u -- j*x )
          'SOURCE 2!  >IN OFF
           BEGIN
              BL WORD DUP [email protected] ( -- addr len)
           WHILE
              FIND
              ?DUP IF ( it's a word)
                   1+ STATE @ 0= OR
                   IF   EXECUTE
                   ELSE COMPILE,
                   THEN
              ELSE ( it's a number)
                   DUP COUNT NUMBER? ( caddr n  ? )
                   IF   DROP TRUE SWAP COUNT ?ABORT
                   ELSE NIP  t[COMPILE] LITERAL
                   THEN
              THEN
              ?STACK
          REPEAT
          DROP ;

 

 

Edited by TheBF
minor edit
  • Like 2

Share this post


Link to post
Share on other sites

LOL!

 

How can I stare at something all day and miss the obvious.  I guess it's one of the problems of "meta-programming" where you make the language as you go.

YOU GOTTA REMEMBER WHAT YOU WROTE :)

 

Or maybe it an example of why Fred Brooks wrote, in his book about S/W failure, the Mythical Man Month:

 

               "It takes nine months to have a baby no matter how many women you put on the job."

 

I have an error handler called ?FIND ...

: ?FIND    ( ? -- )  0=   HERE COUNT ?ABORT ;

... which I wrote to handle lookups with tick. ( ' )

: '        ( -- xt) BL WORD FIND ?FIND ;

So all that stack noise goes away! :) 

And I save 6 more bytes! Kernel is now 8082 Bytes.

: <INTERPRET>  ( i*x c-addr u -- j*x )
          'SOURCE 2!  >IN OFF
           BEGIN
              BL WORD DUP [email protected] ( -- addr len)
           WHILE
              FIND ?DUP 
              IF ( it's a word)
                   1+ STATE @ 0= OR
                   IF   EXECUTE
                   ELSE COMPILE,
                   THEN
              ELSE ( it's a number)
                   COUNT NUMBER? ( caddr n  ? )
                   IF   FALSE ?FIND
                   ELSE t[COMPILE] LITERAL
                   THEN
              THEN
              ?STACK
          REPEAT
          DROP ;

EDIT: 

But then I realized that using a "trap" (ABORT) like ?FIND means I don't need the IF statement. ?FIND protects the system from compiling a bad number.

And that saves 8 more bytes so we are at 8074 bytes. Total saving:  52 bytes

: <INTERPRET>  ( i*x c-addr u -- j*x )
          'SOURCE 2!  >IN OFF
           BEGIN
              BL WORD DUP [email protected] ( -- addr len)
           WHILE
              FIND ?DUP 
              IF ( it's a word)
                   1+ STATE @ 0= OR
                   IF   EXECUTE
                   ELSE COMPILE,
                   THEN
              ELSE ( it's a number)
                   COUNT NUMBER? ( caddr n  ? )
                   0= ?FIND  t[COMPILE] LITERAL
              THEN
              ?STACK
          REPEAT
          DROP ;

 

 

Edited by TheBF
  • Like 3

Share this post


Link to post
Share on other sites

Once you start looking...

 

Long ago i added DEPTH to the kernel, but then I didn't use it to check for stack underflow in the the word ?STACK so that saved bytes. (I am sensing a pattern here...)

Then I realized I only used ?STACK once, so that had to go and I put the error check and message inside the <INTERPRET> loop.

I changed the name of ?FIND to ?ERR because it is the most fundamental error check in the system. Failed lookup of a word.

: <INTERPRET>  ( i*x c-addr u -- j*x )
          'SOURCE 2!  >IN OFF
           BEGIN
              BL WORD DUP [email protected] ( -- addr len)
           WHILE
              FIND ?DUP
              IF ( it's a word)
                   1+ STATE @ 0= OR
                   IF   EXECUTE
                   ELSE COMPILE,
                   THEN
              ELSE ( it's a number)
                   COUNT NUMBER? ?ERR
                   t[COMPILE] LITERAL
              THEN
              DEPTH 0< TS" Empty stack" ?ABORT
          REPEAT
          DROP ;

Then I realized I had more compile time testing in my BEGIN WHILE AGAIN REPEAT  loops than I needed so that had to go.

So I decided to take a few bytes back and added the fORTH 2012 word PERFORM which is like @ and EXECUTE together.

This makes INTERPRET run a bit faster because I use a variable for interpret to deal with a forward reference in the compile process.

 

( QUIT needs INTERPRET and ABORT, but ABORT needs QUIT :) )

Forth doesn't do that kind of thing out of the box. And now I realize I can improve that whole thing too...

 

All that to say I am down to a kernel of 8032 bytes.

 

v259 compile screen.png

  • Like 1

Share this post


Link to post
Share on other sites

The creativity of people is amazing!

 

I was reading Reddit today and found this.

Believe it or not, this is compilable Forth code for a a couple of keyboard translation tables. :)  

( https://github.com/davazp/eulex/blob/master/kernel/keyboard.fs#L135 )

 

A neat example of alternative paradigm programming IMHO.

 

CREATE TBLSC-QWERTY
( )
( ) 0 c, ESC c,
( )       | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 0 | - | =     BACK c,
( ) TAB c,  | q | w | e | r | t | y | u | i | o | p | [ | ]    RET c,
( ) CTRL c,  | a | s | d | f | g | h | j | k | l | ; | ' | `
( ) SHIFT c,  | \ | z | x | c | v | b | n | m | , | . | /    SHIFT c,
( ) PRSCR c, ALT c,     ______SPACE______ c,       CAPSLOCK c,
( )
( ) TBLSC-SPECIAL
( )
TBLSC-QWERTY END.

CREATE TBLSC-QWERTY-SHIFT
( )
( ) 0 c, ESC c,
( )       | ! | @ | # | $ | % | ^ | & | * | ( | ) | _ | +     BACK c,
( ) TAB c,  | Q | W | E | R | T | Y | U | I | O | P | { | }    RET c,
( ) CTRL c,  | A | S | D | F | G | H | J | K | L | : | " | ~
( ) SHIFT c,  | | | Z | X | C | V | B | N | M | < | > | ?    SHIFT c,
( ) PRSCR c, ALT c,     ______SPACE______ c,      CAPSLOCK c,
( )
( ) TBLSC-SPECIAL
( )
TBLSC-QWERTY-SHIFT END.

 

Share this post


Link to post
Share on other sites

Armed with a new "slimmer" build of Camel99 Forth, V2.59,  I desperately wanted to get it ported to TTY (RS232) I/O.  I much prefer using the PC and a terminal when I am playing with the real Iron at least for testing Forth things. 

 

Speaking of testing things I have come to rely on Lees' Seven's problem code as a general "will it work" program since it exercises a few key library files and screen I/O stuff. 

I did take the liberty of replacing the CONSTANT changing method with VALUES and I found I got a good speed-up by printing the A1 buffer directly versus loading into into Forth's PAD buffer and then printing it.  I did this as a result of looking at a BASIC version that I had upgraded a while back.  If it works in BASiC... :)

 

So here is the code and a video of the result.  It's not too shabby.  This version of Camel99 /TTY Forth has vectored I/O so I should be able to re-direct output to the other RS232 port, VDP screen and even memory buffers.  More work on that but the EMIT word is a vector currently holding the code routine CEMIT that outputs to RS232/1.

 

 
\ Lee Stewart's mod of Lucien2's code for the sevens problem...
\ for CAMEL99 /TTY  V2.59

\ 1. Used VALUES
\ 2. Used UM/MOD , native division
\ 3. >DIGIT for digit conversion
\ 4. Print A1 directly, no PAD buffer

NEEDS ELAPSE FROM DSK1.ELAPSE
NEEDS VALUE  FROM DSK1.VALUES
NEEDS MALLOC FROM DSK1.MALLOC

DECIMAL
\ ------------------------------------
180 CONSTANT SIZE
SIZE MALLOC CONSTANT A1  \ A1 digit array

0 VALUE LENGTH    \ current number of digits in result

\ HEX  \ Using 7* reduces time of "RUN" & "FASTRUN" by ~1 second
\ CODE 7*   C044 , 0A34 , 6101 , NEXT, ENDCODE

DECIMAL
: A1*7->A1 ( -- ) \ perform 7 * last result
   0              \ initialize carried digit on stack
   1 +TO LENGTH   \ assume we will increase length by 1 digit
   A1 LENGTH BOUNDS
   DO
      I [email protected]         \ get cur digit as next higher digit
      7 *          \ cur digit * 7
      +            \ add carried digit from stack
      0 10 UM/MOD  \ make result ud..unsigned divide by 10
      SWAP I C!    \ store rem as cur digit..carry on stack
   LOOP
   DROP            \ clean up stack
 \ eliminate leading 0
   A1 LENGTH 1- + [email protected] 0=    \ highest digit = 0?
   IF
      -1 +TO LENGTH  \ correct digit count
   THEN  ;

: A1$ ( -- addr len)
   PAD DUP              \ PAD & COPY for string storage
   A1 1- DUP LENGTH +
   DO
      I [email protected] >DIGIT    \ fetch integer,convert to ASCII
      OVER C!        \ store ASCII digit in PAD
      1+             \ next PAD location
   -1 +LOOP
    DROP             \ clean up stack
   ( PAD) LENGTH ;
   

: A1$.TYPE ( -- addr len)
   A1 LENGTH 1- OVER +
   DO
      I [email protected] >DIGIT EMIT
   -1 +LOOP ;


: 7COUNTER ( -- ? )  \ Brian Fox's technique
   0                 \ initialize counter
   A1 LENGTH BOUNDS  \ DO A1 to A1 + length
   DO
      1+             \ increment counter
      I [email protected] 7 = AND   \ test char, AND with counter.
      DUP 6 =
      IF            \ more than '77777'?
         LEAVE      \ yup..we're done
      THEN
   LOOP
;

: .POWER ( n -- ) ." SEVEN TO THE POWER OF " .  ." IS" ;

DECIMAL
: RUN      \ V2.58 1:26 , v2.59 1:08
   PAGE
   A1 SIZE 0 FILL
   7 A1 C!
   1 TO LENGTH
   2                 \ starting power
   BEGIN
      A1*7->A1
      DUP            \ dup power for display
      CR .POWER
      1+             \ increment power
      CR A1$.TYPE
      CR
     7COUNTER 6 =
   UNTIL
   DROP
;

DECIMAL
: NOSCROLL
   PAGE
   A1 SIZE 0 FILL
   7 A1 C!
   1 TO LENGTH
   2                 \ starting power
   BEGIN
      A1*7->A1
      DUP            \ dup power for display
      0 0 AT-XY .POWER
      1+             \ increment power
     CR CR A1$ TYPE    \ 39:08
     7COUNTER  6 =
   UNTIL
   0 7 AT-XY
;

DECIMAL
: FASTRUN         ( 16.1 seconds)
   PAGE ." Working..."
   A1  SIZE 0 FILL
   PAD SIZE 0 FILL
   7 A1 C!
   1 TO LENGTH
   2                 \ starting power
   BEGIN
     7COUNTER 5 <
   WHILE
      A1*7->A1
      1+             \ increment power
   REPEAT
   1- CR .POWER
   CR A1$ TYPE
   0 7 AT-XY
;

CR .( TYPE:  RUN   or FASTRUN ) CR
DECIMAL

 

 

 

 

Edited by TheBF
Added spoilers
  • Like 2

Share this post


Link to post
Share on other sites

The downside of working from the PC over RS232 has been very long times to get finished programs onto the floppy drives as DV80 files.

I had two options:

  1. Magic file manipulator which runs under xBasic, so that was painful since CAMEL99 runs with the E/A cartridge.
  2. Slowly send programs directly to Forth over RS232 and run them directly.

The slow speed  is because when sending text with Terra term I have to put a 1mS delay after each character and a 300 mS delay after each carriage return.  The character delay could be much less but Terra term has a minimum of 1ms. :(  And Forth has to interpret or compile each line after a <return> character so that takes a bit of time so we have to wait.

 

I had started a project that loaded files into a low RAM but it had some bugs and the CAMEL99 /TTY program was not as stable as I would like.

I could get the text reliably into the buffer using Forth Assembler with an idea from POLYFORTH called STRAIGHT.  STRAIGHT reads the input stream into a buffer with no extras. Just slam it in and timeout when it stops, or we hit the end of the length argument.

 

I had to strip the >0D off the end of each line to write records correctly to DV80 file.  I got that working using the all powerful SCAN and /STRING. 

The rest was integrating it with some prompts for the user. It still took a long time working on the floppy drives.  Wow I forgot how slow that it.

 

So now I have a text-file upload utility. This means I can test code on Classic99 and then send the file over serial to floppy disk immediately. What a pleasure!

The video shows it accepting it's own source code and saving it to disk.

 

Edit: This video shows text pasted into Teraterm.  It seems to go much faster when I used the SEND menu.

It actually takes longer to write it to floppy disk than to send the file over RS232. :)

 

 

 
\ Accept chars into a buffer with no echo
\ capable of reading continuous data at 9600 bps

NEEDS MARKER    FROM DSK1.MARKER
\ NEEDS MOV,      FROM DSK1.ASM9900
NEEDS OPEN-FILE FROM DSK1.ANSFILES

CR .( Compiling UPLOAD Utility )
MARKER REMOVE
.( .)
VARIABLE FHNDL

HEX
0D CONSTANT ^M
2000 CONSTANT 8K

: HEAP ( -- addr)  H @ ;
: ERASE  ( addr len --)  0 FILL ;

HEX  .( .)
CREATE ALLDONE   \ branch here to exit readcom
  020C , 1300 , 1E07 , C337 ,
  0300 , 0002 , C101 , NEXT,

\      R12 RS232/1 LI,
\      7 SBZ,       \ turn off LED
\      R12 RPOP,
\      2 LIMI,      \ interrupts back on
\      R1 TOS MOV,  \ get the char count to Forth TOS
\      NEXT,

HEX   .( .)
CODE READCOM ( addr n -- n' )
 0300 , 0000 , 0647 , C5CC , 
 020C , 1300 , 1D07 , C320 ,
 B09C , C236 , A108 , 0700 , 
 04C1 , 1F15 , 1605 , 3638 ,
 1D12 , 0700 , 0581 , 1004 , 
 0600 , 1602 ,
 0460 , ALLDONE ,
 8108 , 16F3 ,
 0460 , ALLDONE ,
.( .)
\         0 LIMI,              \ we need full attention
\         R12 RPUSH,
\         R12 RS232/1 LI,      \ select the CARD
\         7 SBO,               \ turn on LED
\         PORT @@ R12 MOV,     \ select the 9902 port
\        *SP+ W MOV,           \ addr ->W   (ie: R8)
\         W TOS ADD,           \ calc last address ->TOS
\         R0 SETO,             \ set timeout register >FFFF
\         R1 CLR,              \ reset char counter
\         BEGIN,
\            21 TB,            \ test if char in uart
\            EQ IF,
\               *W+ 8 STCR,    \ put char in buf & inc W
\                18 SBO,       \ clr rcv buffer
\                R0 SETO,      \ reset timeout to 0FFFF
\                R1 INC,       \ count char
\            ELSE,
\                R0 DEC,       \ no char, dec TIMEDOUT
\                EQ IF,
\                    ALLDONE @@ B,
\                ENDIF,
\            ENDIF,
\            W TOS CMP,        \ end of buffer ?
\         EQ UNTIL,
\         ALLDONE @@ B,
\         ENDCODE

.( .)
DECIMAL
\ STRAIGHT from PolyForth. Read n chars into addr or timeout
: STRAIGHT ( addr len -- n)
       1 /STRING OVER 1- ( -- addr+1 len' addr)
       KEY SWAP C!      \ WAIT for 1st Char & store
       READCOM ;

\ extract a line from buffer delimited by ^M (0D)
: /LINE ( addr len -- str1 len1 )
         2DUP ^M SCAN  NIP - 0 MAX  ;

: NEXTLINE ( addr len -- remainder len line len )
         2DUP /LINE 2SWAP 2 PICK 1+  /STRING  2SWAP ;

.( .)
: SAVE-BUFFER ( buffer len -- )
      LINES OFF
      BEGIN
        DUP -1 <>
      WHILE
        NEXTLINE FHNDL @ WRITE-LINE ?FILERR
        LINES 1+!
      REPEAT
      FHNDL DUP @ CLOSE-FILE ?FILERR
      OFF
      DROP
      DECIMAL
      CR LINES @ .  ." lines saved"
;
.( .)
: UPLOAD ( -- addr len)
      8K DUP H !                     \ START of HEAP=>2000
      CR ." Erasing 8K HEAP"
      HEAP 8K  2DUP ERASE
      CR ." Send TEXT file now..."
      STRAIGHT ( -- bytes-recd)       \ get data
      CR   ." Upload complete"
      DECIMAL
      CR DUP . ." bytes received."
;

.( .)
: SAVETTY ( file len -- ) \ s" dsk1.test" SAVE
      CR ." Opening file..."
      DV80 R/W CREATE-FILE ?FILERR FHNDL ! \ create the file
      UPLOAD ( addr len --) 
      CR ." Saving buffer..."  SAVE-BUFFER
      CR ." Save complete"
      DROP
;

 

 

 

 

Edited by TheBF
  • Like 1

Share this post


Link to post
Share on other sites

So I bit the bullet I ventured into the world of YouTube Channels. I know next to nothing about it but I thought it would help save space on the Atariage servers if I maintained the videos somewhere else. So over time I will be adding videos about the system and the cross-compiler just in case there is someone in the universe who might desperately need to know this. 😂

 

I have re-worked the commands now so that UPLOAD and SAVE can be used independently and it seems to work pretty well.  I am chasing one bug that seems to break my file system after I do a large upload and save. I have to restart Forth in order to load the files from disk. So two steps forward and one step back. :)

 

But its pretty fast and waaay better than swapping carts and disks to use magic file utility, albeit I cannot transfer program files yet.

This is making me wonder about coding an Xmodem protocol that would allow real file transfers from within Forth.  Hmmm...

 

So without further "adieu" here is the first entry on the CAMEL99 Forth channel

 

 

  • Like 4

Share this post


Link to post
Share on other sites

An Alternative Way to Compile Code

Apologies in advance. This is bit long but perhaps some will find it interesting. I wanted to understand this 30 years ago. :)

 

As anyone who has tried to write a compiler knows, it is not a trivial project. The conventional way compilers operate can be understood as a sequence of steps that refine the original text of the source code to something the machine can run. The textbook set of steps for a modern compiler are:

  1.   Lexical analyzer  ( extract language tokens, remove white-space & comments)
  2.   Syntax analyzer   ( check if syntax is correct
  3.   Semantic analyzer (extract the meaning)
  4.   Intermediate code generator  ( code for a virtual machine)
  5.   Code Optimizer               ( make it smaller, faster)
  6.   Target code generation       ( Make code for the target CPU)

The results, in the case of C, with an assembly language program that is further processed by the assembler and the then by the linker.  After all that you get a binary to run on your computer. Simple right?

 

While away I was reading some blogs by Samuel Falvo and I found some work he did for the new RISC-V CPU.

https://kestrelcomputer.github.io/kestrel/2015/03/11/why-not-machine-forth

 

RISC-v is a pure RISC machine with a far simpler instruction set that the 9900.  Samuel had ported an invention of Charles (Chuck) Moore's called "machine forth".  I knew what it was in theory but I had never seen a complete implementation.  He had instructions for both x86 and RISC-V and is contrasting the challenges of implementing machine Forth on this slightly more obtuse RISC-V machine. It wasn't a good fit but it made me realize the 9900 was a pretty good candidate.

 

What is machine Forth?  It was created around the time that Chuck Moore started building CPUs modelled after the Forth virtual machine. The original Forth CPUs were very simple per Chuck Moore's philosophy on computers.


They typically consisted of:

  • Program counter register (PC)
  • Data stack register
  • Return stack register
  • Top of stack register (TOS)
  • Next on stack register (NOS)
  • 'A' register (later designs)

In later research Chuck found it handy to also include a scratch register he called 'A' for caching addresses. The CPUs he designed typically had about 30 instructions or so.

From what I can see, his work on CPUs influenced his thinking on Forth programs because I noticed machine Forth appears around this time and it seems to emulate those simple CPUs. So using Sam Falvo's examples I made 9900 code that adds Machine Forth to the TI-FORTH Assembler. It is just a set of macros that compile one, two or three instructions into memory for each keyword. (keywords end in a comma to prevent name conflicts with Forth words)

 

The big difference with Machine Forth and standard Forth is that the language primitives do not automatically DROP items off the stack for you. The big one is with IF. Conventional Forth IF takes value from the top of stack and if it is 0, it jumps to a label called THEN or in this case ENDIF.  Standard IF cleans that value off the stack for you.  Machine Forth does not because Chuck realized that many times you want that value later in the code so you DROP if and when you need to.


Full Disclosure:
This is not "pure" machine Forth. I did not implement the branching and looping per the Machine Forth method.
Machine Forth uses only two instructions to make branching and looping.
IF   branch if top of stack is <> 0
-IF  branch if top of stack = 0 ( called NOT IF)

I am using the TI-Forth assembler code for this purpose for convenience.

 

I also am running this from within CAMEL99 Forth. It is possible to make a Forth interpreter in Machine Forth from the ground up.

 

I will put the code and a short example program in the next post.

 

 

 

  • Like 2

Share this post


Link to post
Share on other sites

9900 Machine Forth (with a little cheating)

 

Here is the example Machine Forth program:

M: LOOPER
        FFFF #,     \ put a literal into TOS register
        BEGIN,      \ mark point to jump back to
          1-,       \ dec TOS register
        0=, UNTIL,  \ loop until TOS=0
        DROP,       \ drop the TOS (refill from stack)
;M

Here is the code that it created (thanks Tursi) with added comments

\ generated code
   D258  0646  dect R6         ; make room on stack
   D25A  C584  mov  R4,*R6     ; push TOS reg to stack
   D25C  0204  li   R4,>ffff   ; load TOS with FFFF
         FFFF
   D260  0604  dec  R4         ; dec TOS
   D262  16FE  jne  >d260      ;
   D264  C136  mov  *R6+,R4    ; drop TOS
   D266  045A  b    *R10       ; run Forth

And here is an un-tested Machine Forth for 9900 on Camel99 Forth. (TOS is alias for R4 in Camel99 Forth)

\ TMS9900 machine Forth Extensions for CAMEL99 Assembler

NEEDS MOV, FROM DSK1.ASM9900

\ For this demo, R13 is the 'A' register (address register)
: *R13+   R13 *+ ;   \ make it look like TI Assembler :)

\ OPCODE # Shown for reference to original document
( 0) : [;]    @@ B, ;   \ 0  Jump to word ie: tail recursion

( 2) :  CALL, ( label -- )  \ call a label
            R11 RPUSH,
           ( label) @@ BL,
            R11 RPOP, ;

( 26) : DUP,  ( n -- n n) TOS PUSH,  ;         \ Dup TOS -or- make room for new
( 10) : #,    ( n -- ) DUP, TOS SWAP LI, ;     \ compile literal number
(  8) : @,    ( addr -- n) #, *TOS TOS MOV, ;  \ Fetch from address on stack
( 30) : DROP, ( n -- ) *SP+ TOS MOV, ;         \ Discard TOS; (refills TOS)
(  9) : @+,   ( -- n)  DUP, *R13+ TOS MOV, ;   \ Fetch address in A; A++
( 11) : @R,   ( -- n ) DUP,  *RP TOS MOV, ;    \ Fetch from address in R
( 29) : A!,   ( addr -- ) TOS R13 MOV,  ;      \  Store stack into A register

( 12) : !,  ( n addr -- )     \ Store to address on stack
             A!,              \ update A register per machine Forth norm
            *SP+ R13 ** MOV,  \ pop n into address in 'A' register
             DROP, ;          \ refill TOS from stack memory

( 14) : !+,  ( n -- )   TOS *R13+ MOV, ; \ Store to address in A; increment A
( 15) : !R,  ( n -- )   TOS *RP+ MOV,  ; \ Store to address in R; increment R
( 16) : 2*,  ( n -- n ) TOS 1 SLA,  ;     \ Shift stack left
( 17) : 2/,  ( n -- n)  TOS 1 SRA,        \ Shift stack right, propagate sign
( 18) : -,   ( n -- )   TOS INV, ;        \ Ones complement stack

( 19) : AND, ( n mask -- n) *SP INV, *SP+ TOS SZC, ; \ (option 1) And to # on stack
( 19b) : #AND,  ( n n -- n ) TOS SWAP ANDI,  ;  \ (option 2 ) AND with a literal

( 21) : XOR,  ( n n -- n)  *SP+ TOS XOR, ;  \ Exclusive-or to stack (option 1)
( 22) : +,    ( n n -- n)  *SP+ TOS ADD, ;  \ Add to stack (option 1)
( 22b) : #+,  ( n n -- )    TOS SWAP AI, ;  \ (option 2) Compile n into code.

( 24) : PUSH, ( n -- )      TOS RPUSH,  ;          \ Push stack onto Return (DUP >R)
( 25) : A,    ( -- addr)    DUP,  R13 TOS MOV, ;   \ Put A register onto stack
( 27) : OVER, ( n1 n2 -- n1 n2 n1) DUP,  2 (SP) TOS MOV, ;
( 28) : POP,  ( -- n)       DUP, TOS RPOP, ;       \ Pop Return onto stack (R>)
( 29) : A!,   ( addr -- )   TOS R13 MOV,  DROP, ;  \ Store stack into A register
( 31) : NOP,  ( -- )        0 JMP, ;               \ short delay for hardware
( 32) : NIP,  ( n1 n2 -- n2)  SP INCT, ;           \ DROP 2nd stack item

\ 9900 extras by BF
: 1+,  ( n -- n')   TOS INC, ;
: 2+,  ( n -- n')   TOS INCT, ;
: 1-,  ( n -- n')   TOS DEC, ;
: 2-,  ( n -- n')   TOS DECT, ;

\ ================================================================
\ label creators
: SUB:    CREATE   ;        \ CREATE a sub-routine label
: ;SUB     RT,   ;          \ compile Return psuedo instruction

: M:     CODE ;              \ create CODE routine label
: ;M     NEXT,  ENDCODE ;    \ compile code to return to Forth, check for errors

\ change names of assembler comparisons
: 0=,   EQ ;
: 0<>,  NE ;
: >=,   GTE ;
: <=,   LTE ;
: >,    GT ;
: <,    LT ; 

 

  • Like 2

Share this post


Link to post
Share on other sites

LOL.  I thought getting the TI-99 to swallow RS232 data reliably at 9600 baud would be hard.

I had to work a little harder than I realized to reliably save a buffer to a DV80 file on floppy disk.

It turns out the old girl really really really doesn't like it if you write a control character like a carriage return into a DISPLAY file. :)

 

I don't have a way to handshake the PC to stop sending so I don't try do any processing. I might miss something. I just put each byte into the next byte in the buffer.

When you send text from a PC to buffer in the TI-99 the lines are of random length. This can put the start of a record on the "wrong byte"...

 

The solution for me was to cut the line of text from the big buffer and copy it to a cleared temp buffer. This gave me a clean string starting on a even address. Seems to work much better.

I used the opportunity to test for empty lines and replaced them with a null string, the kind TI-99 uses in DV80 files. (A string with length=1 and the content is a binary zero)

 

Here is the new version of the code to save the big buffer. 

NEXTLINE chomps through the buffer returning both the next line and leaving the remainder of the buffer on the stack for the next execution of NEXTLINE.

The end user word is SAVE.

 

\ extract a line from buffer delimited by ^M (>0D)
: /LINE    ( addr len -- str1 len1 )
           2DUP ^M SCAN NIP - 0 MAX ;

: NEXTLINE ( addr len -- addr' len' record len )
           2DUP /LINE 2SWAP 2 PICK 1+  /STRING 2SWAP ;

: MASSAGE  ( addr len -- addr' len')
           DUP 0=
           IF    2DROP PAD DUP OFF 1 \ return a null string

           ELSE  PAD 60 ERASE   \ fill pad with zeros
                 PAD PLACE      \ write data to PAD, aligns string, strips ^m
                 PAD COUNT      \ return stack string
           THEN ;

.( .)
: SAVE-BUFFER ( buffer len -- )
      LINES OFF
      BEGIN
        NEXTLINE MASSAGE  #1 WRITE-LINE ?FILERR
        LINES 1+!
        DUP 0=  \ test remaining buffer length
      UNTIL
      2DROP
      DECIMAL
      CR LINES @ .  ." lines saved"
;

.( .)
: SAVE ( addr len -- ) \ S" DSK1.TESTFILE" SAVE
      DUP ?FILE
      RCVD 0= ABORT" BUFFER empty. Nothing to save"
      CR ." Opening file..."
      DV80 R/W CREATE-FILE ?FILERR TO #1

      CR ." Saving buffer..." COMBUFF RCVD SAVE-BUFFER
      CR ." Save complete"
      CR ." Closing file" #1 CLOSE-FILE ?FILERR  0 TO #1
      BUFFSIZE MFREE
      0 TO RCVD
;

 

 

  • Like 2

Share this post


Link to post
Share on other sites

I've said it before, but dam this is humbling pass-time! :)

 

I got this uploader working but had real reliability troubles. I was sidetracked into thinking it had something to do with larger files. (>2K bytes)

Well... that was not the problem. The problem was that I was not making a proper "newline" in the file.  Turns out that I need to write a string with "blank" as Forth calls it with length of 1.  In ANS FORTH that is just:

S"  "

(Forth the non-forther the 1st space delimits the keyword S"  the next space is the payload of the string, which is ended with the double quote. It's not a mistake) :)

 

So when I encounter an empty string in the buffer, I just throw it away and replace it with that string. (see -NULLS)

 

I decided to stop the madness with using malloc and releasing memory.  The program just assumes it has the Low RAM buffer for itself.

And I did something I've never done before. Using a colon definition to create a kind of union on the data buffer.

: RCVBUFFER ( -- addr len) 8K BUFFSIZE ;
: OUTBUFFER ( -- addr len) 8K RCVD ;

8K is just a constant that is the top of LOW RAM (>2000).  But for receiving the length returned is the buffer size.  For sending it to disk, we use the RCVD value which holds the number of bytes we got from the PC file that was "uploaded".  It reads much better and never screws up.

Of course it got much simpler once I understood things properly.

 

So with this code I can upload an 8K file in seconds and save it to disk in few more seconds and nothing seems to blow up now.

( the CODE words are machine code so the utility doesn't need the assembler to compile)

 

\ TTY UPLOAD Utility for text files. v1.0 WORKS OK
\ Accept chars into a buffer with no echo at 9600 bps, no delays, save to file
\ *** THIS VERSION USES THE ENTIRE 8k LOW RAM AS BUFFER ***
NEEDS DUMP FROM DSK1.TOOLS
NEEDS MARKER    FROM DSK1.MARKER
NEEDS OPEN-FILE FROM DSK1.ANSFILES
NEEDS VALUE     FROM DSK1.VALUES

CR .( Compiling UPLOAD Utility )
MARKER REMOVE
.( .)
HEX
000D CONSTANT ^M
2000 CONSTANT 8K
1FF0 CONSTANT BUFFSIZE

0 VALUE #1
0 VALUE RCVD

: RCVBUFFER ( -- addr len) 8K BUFFSIZE ;
: OUTBUFFER ( -- addr len) 8K RCVD ;

: ERASE  ( addr len --)  0 FILL ;

HEX  .( .)
CREATE ALLDONE   \ branch here to exit readcom
  020C , 1300 ,
  1E07 ,
  C337 ,
  0300 , 0002 ,
  C101 ,
  NEXT,

.( .)
HEX
CODE READCOM ( addr n -- n' )
 0300 , 0000 ,
 0647 , C5CC ,
 020C , 1300 ,
 1D07 ,
 C320 , PORT ,
 C236 , A108 , 0700 ,
 04C1 , 1F15 , 1605 , 3638 ,
 1D12 , 0700 , 0581 , 1004 ,
 0600 , 1602 ,
 0460 , ALLDONE ,
 8108 , 16F3 ,
 0460 , ALLDONE ,

 .( .)
DECIMAL
\ STRAIGHT from PolyForth. Read n chars into addr or timeout
: STRAIGHT ( addr len -- n)
       1 /STRING OVER 1- ( -- addr+1 len' addr)
       KEY SWAP C!      \ WAIT for 1st Char & store
       READCOM ;

.( .)
: UPLOAD ( -- )
      CR ." Erasing buffer"         RCVBUFFER ERASE
      CR ." Send TEXT file now..."  RCVBUFFER STRAIGHT TO RCVD
      DECIMAL
      CR ." Upload complete, " RCVD . ." bytes received."
      CR ." Press enter a few times to see OK"
;

\ extract a line from buffer delimited by ^M (0D)
: /LINE ( addr len -- str1 len1 )
         2DUP ^M SCAN  NIP - 0 MAX  ;

: NEXTLINE ( addr len -- remainder len line len )
         2DUP /LINE 2SWAP 2 PICK 1+  /STRING  2SWAP ;

: -NULLS ( addr len -- addr' len')
         DUP 0= IF  2DROP  S"  "  THEN ;  \ replace with a null string

.( .)
: WRITE-FILE ( buffer len -- )
      LINES OFF
      BEGIN
        DUP -1 >
      WHILE
        NEXTLINE -NULLS #1 WRITE-LINE ?FILERR
        LINES 1+!
      REPEAT
      S"  "  #1 WRITE-LINE ?FILERR
      2DROP
;
.( .)
: SAVE ( addr len -- ) \ S" DSK1.TESTFILE" SAVE
      DUP ?FILE
      RCVD 0= ABORT" OUTBUFFER empty"
      DV80 R/W CREATE-FILE ?FILERR TO #1
      CR ." Saving buffer..."
      OUTBUFFER WRITE-FILE
      CR ." Save complete"
      DECIMAL
      CR LINES @ .  ." lines saved"
      CR ." Closing file"
      #1 CLOSE-FILE ?FILERR  0 TO #1  ;

 

  • Like 2

Share this post


Link to post
Share on other sites

There is nothing that spruces up your code like being forced to use it yourself. ;)

 

I been ignoring a few weird bugs in my ANS Forth file words. I was pretty sure it was in the file handle server and selection system. I had not put much effort into error prevention and detection so it was not a surprise. I believe the system is now much better due to two simple fixes.

  1. Consider any problem to be a FATAL error and reset all the ]FID array values to zero when we abort back to Forth. The ]FID array takes a handle and returns a PAB.
  2. Put error detection on ]FID and do a FATAL ABORT on an invalid handle

The new word FATAL resets the file I.D.s  (FIDS) and returns a TRUE flag so it can be used with ABORT" . 

 Code is below

CREATE FIDS ( -- addr) 0 , 0 , 0 , 0 , 0 ,

: FATAL   ( -- true) FIDS  #FILES @ CELLS  0 FILL   TRUE ;
: ?HNDL   ( n -- )  #FILES @ 1+  1 WITHIN IF FATAL ABORT" Bad handle" THEN  ;
: ]FID    ( hndl -- PAB_addr ) DUP ?HNDL  CELLS FIDS + ;

 

I decided I needed more insight into what happened when there was a file error. This is harder to get at on real iron so I added the word DUMP] which works with the word [PAB.   [PAB returns the VDP address of the PAB in use.  So [PAB DUMP] gives you a report on the file in use.  I needed a couple of VDP string words to make this happen.

 

I re-wrote the ?FILERR word to incorporate these changes and so far the file system seems rock solid. (With a user base of 1) :)

: VCOUNT  ( vdp$adr -- vdpadr len ) DUP 1+ SWAP [email protected] ;
: .FNAME  ( padaddr -- ) FNAME] VCOUNT BOUNDS DO  I [email protected] EMIT LOOP ;

: DUMP]   ( vaddr -- ) \ dump contents of a PAB
         DUP >R
         HEX
         CR ." PAB:" .  ." FAM=" [email protected] FLG] [email protected] 1F AND .
            ."  Rec#="   [email protected] REC#]  [email protected] .
            ."  Fstat= " [email protected] STAT] [email protected] .
         CR ." Dev: " R> .FNAME ;

: ?FILERR  ( ior -- )
       ?DUP IF
           CR
           CR ." Err# " .   ."  Hndl=" LASTH @ .
           [PAB DUMP]
           FATAL ABORT" All files closed"
        THEN ;

 

I might remove the dump to save space in the future.

This file already compiles to over 1,300 bytes much of which is due to words used to emulate TI-BASIC file description words.

 

For example than rather than saying all this to use a DV80 file...

UPDATE DISPLAY SEQUENTIAL 50 VARI

I could replace it with...

 

HEX
: DV80  14 FAM ! ;  \ set file access mode for DV80 R/W text files

I could write a few descriptors like this for the commonly used file types and save a lot of memory.

And so it goes...

 

Keep the Forth

 

 
\ Ansfiles  for Camel99 v2.1 bjf  Feb 2020

HERE  
CR .( ANS Files V2.1 ..)
HEX
VARIABLE #FILES
VARIABLE LASTH

CREATE FIDS ( -- addr) 0 , 0 , 0 , 0 , 0 ,
: FATAL   ( -- true) FIDS  #FILES @ CELLS  0 FILL   TRUE ;
: ?HNDL   ( n -- )  #FILES @ 1+  1 WITHIN IF FATAL ABORT" Bad handle" THEN  ;
: ]FID    ( hndl -- PAB_addr ) DUP ?HNDL  CELLS FIDS + ;

: NEWHNDL ( -- hndl) 0  BEGIN   1+ DUP ]FID @   WHILE REPEAT ;

: NEWPAB  ( hndl -- ) DUP PSZ * VDPTOP SWAP - ( -- addr hndl) SWAP ]FID ! ;
: RELEASE ( hndl -- ) ]FID OFF ;
: SELECT  ( hndl -- ) DUP ]FID @ ^PAB !  LASTH ! ;

: VCOUNT  ( vdp$adr -- vdpadr len ) DUP 1+ SWAP [email protected] ;
: .FNAME  ( padaddr -- ) FNAME] VCOUNT BOUNDS DO  I [email protected] EMIT LOOP ;

: DUMP]   ( vaddr -- ) \ dump contents of a PAB
         DUP >R
         HEX
         CR ." PAB:" .  ." FAM=" [email protected] FLG] [email protected] 1F AND .
            ."  Rec#="   [email protected] REC#]  [email protected] .
            ."  Fstat= " [email protected] STAT] [email protected] .
         CR ." Dev: " R> .FNAME ;

: ?FILERR  ( ior -- )
       ?DUP IF
           CR
           CR ." Err# " .   ."  Hndl=" LASTH @ .
           [PAB DUMP]
           FATAL ABORT" All files closed"
        THEN ;

: FILES   ( n -- ) DUP 3 > ABORT" too many files"  #FILES ! ;

.( ..)
VARIABLE FAM

: AND!   ( mask addr -- ) TUCK @ AND SWAP ! ;
: OR!    ( mask addr -- ) TUCK @  OR SWAP ! ;

\ TI-99 file access mode modifiers
 2 BASE !  \        *ctrl bits*
: DISPLAY    ( -- ) 11110111 FAM AND! ;
: SEQUENTIAL ( -- ) 11111110 FAM AND! ;
: RELATIVE   ( -- ) 00000001 FAM OR! ;

: UPDATE     ( -- )        11111001 FAM AND! ;
: INPUT      ( -- ) UPDATE 00000100 FAM OR! ;
: OUTPUT     ( -- ) UPDATE 00000010 FAM OR! ;
: APPEND     ( -- )        00000110 FAM OR! ;

VARIABLE B/REC
: VARI  ( size -- fam) B/REC ! 00010000 FAM  OR! ;
: FIXED ( size -- fam) B/REC ! 11101111 FAM AND! ;

.( ..)
 HEX
: R/W   ( -- fam)  UPDATE  FAM @ ;
: R/O   ( -- fam)  INPUT   FAM @ ;
: W/O   ( -- fam)  OUTPUT  FAM @ ;

\ ANS Forth BIN replaces TI-99 "INTERNAL"
: BIN   ( fam -- fam') 8 OR ;
: DV80  ( -- ) UPDATE DISPLAY SEQUENTIAL 50 VARI ;

.( ..)
HEX
: OPEN-FILE ( $addr len fam -- fid ior)
      ( fam) DUP FF00 AND OVER  0=  OR ABORT" Bad file mode"
       -ROT
       DEPTH 3 < ABORT" OPEN-FILE args"
       NEWHNDL DUP >R
       DUP NEWPAB
       ( hndl) SELECT
       ( fam $adr len) INITPAB
       ( fam) [PAB FLG] VC!
       B/REC @ [PAB RECLEN] VC!
       B/REC OFF
       0 FILEOP ( -- err#)
       DUP
       IF   R> RELEASE 0 SWAP
       ELSE R> SWAP
       THEN ;

.( ..)
: CLOSE-FILE      ( fid -- ior) DUP SELECT  1 FILEOP  SWAP RELEASE ;
: EOF             ( fid -- c) SELECT (EOF) ;
: CREATE-FILE     ( caddr len fam -- fid ior ) F9 AND  OPEN-FILE ;
: FILE-POSITION   ( fid -- rec# ior) SELECT  [PAB REC#] [email protected]  [PAB FLG] [email protected] ;
: REPOSITION-FILE ( rec# fid -- ior) SELECT  [PAB REC#] V!  4 FILEOP ;
: DELETE-FILE     ( caddr len -- ior) OPEN-FILE  7 FILEOP SWAP CLOSE-FILE OR ;

.( ..)
: READ-LINE ( addr u1 fid -- u2 flag ior )
       NIP SELECT  2 FILEOP ?DUP
       IF NIP 0 FALSE  ROT EXIT  THEN ( -- addr )

       [PAB CHARS] [email protected] TUCK
       [PAB FBUFF] [email protected]  -ROT VREAD
       (EOF) 0=
         0
;

: WRITE-LINE ( c-addr u fileid -- ior )
       SELECT
       DUP [PAB CHARS] VC!
      [PAB FBUFF] [email protected] SWAP VWRITE
       3 FILEOP ( -- ior)
;

\ ===================================
3 FILES             \ set the #FILES now
DECIMAL
CR .( Max files set to ) #FILES @ .
CR HERE SWAP - . .( bytes used)
HEX

 

 

ANSFILES2DEMO.png

Edited by TheBF
Added spoilers
  • Like 2

Share this post


Link to post
Share on other sites

I have often thought of doing something similar to this for fbForth, but opted in favor of compatibility with TI Forth. One day I may still do it, but, more likely, as an adjunct rather than a replacement—something loadable from FBLOCKS, perhaps.

 

...lee

Share this post


Link to post
Share on other sites

Your holding to the intent of TI-Forth is a very valid specification IMHO.  It still make the most sense to use blocks on these little machines.

My editor project is showing me how much more involved a text file editor is than a block editor.

 

This handle file system been a good exercise for me and of course I don't have much choice since the my system is supposed to depend on files. :)

It gives me much deeper appreciation for what's involved in a bigger shell program but it's also cool to see how to do it with less resources.

 

I have not attempted to access the file card sub-programs to date, but I must confess it intrigues me to try and create a DOS like file system on raw sectors.

I hardly seems worth it though without a bigger drive.  I really should investigate a way to get a hard drive on the old machine.

 

Edited by TheBF
typo

Share this post


Link to post
Share on other sites

I gotta run but I just found out I can receive 9600bps into a buffer OVER RS232 without using Assembly language.

Pretty cool!

 

Not fully tested for errors but the printed text looks correct. :)

\ STRAIGHT in Forth

: CKEY   ( -- char) BEGIN  CKEY? ?DUP  UNTIL ;

HEX
: TIMEKEY ( wait-time -- 0 | c )  \ waits for a key until counter hits zero
      BEGIN
         1- DUP
      WHILE
         CKEY? ?DUP IF  NIP   EXIT THEN
      REPEAT
;

VARIABLE RCVD

: STRAIGHT ( addr len -- n)
       RCVD OFF
       OVER >R 
       1 /STRING  BOUNDS  ( -- end start)
       R>                 ( -- end start addr)
       CKEY SWAP  C!      ( -- )
       DO
          2000 TIMEKEY 
          DUP 0= IF  LEAVE  THEN
          I C!
          RCVD 1+!
       LOOP
       DROP
       RCVD @
;

 

  • Like 1

Share this post


Link to post
Share on other sites

I have removed the gratuitous variable RCVD and simply count the bytes on the data stack. This makes the loop even a bit quicker and saves 12 bytes too.

\ STRAIGHT in Forth. Rcv bytes into buffer, no echo. bjf Feb 2020
HERE
: CKEY   ( -- char) BEGIN  CKEY? ?DUP  UNTIL ;

HEX
: TIMEKEY ( wait-time -- 0 | c )  \ waits for a key until counter hits zero
      BEGIN
         1- DUP
      WHILE
         CKEY? ?DUP IF  NIP   EXIT THEN
      REPEAT
;

: STRAIGHT ( addr len -- n)
       0 -ROT             \ char counter under address
       OVER >R            \ save the 1st buffer location
       1 /STRING  BOUNDS  ( -- end start)
       R>                 ( -- end start addr)
       CKEY SWAP  C!      \ wait for 1st key & store
       DO
          2000 TIMEKEY
          DUP 0=
          IF  DROP LEAVE
          THEN I C!
          1+
       LOOP
;
HERE SWAP - SPACE DECIMAL . .( bytes)
HEX

Yesterday I partitioned this file uploader project into two files. STRAIGHT.FTH which is the rs232 reader and UPLOAD.FTH which provides the disk words UPLOAD and SAVE.

 

I tested the Forth version of STRAIGHT by sending my ASM9900.FTH file with no delays into the TI-99. ( 6378 bytes)

Then I TYPEed the buffer contents to the terminal so it was on the screen in the Teraterm buffer,

I copied the terminal screen into the clipboard and pasted the text back into my editor

Then pasted the resulting text back into the TTY Forth at slow speed. If any characters would have been missing there would have been compile time errors.

There was not.

 

I then UPLOADed the new STRAIGHT Forth version to ti-99 buffer and saved it to floppy disk.

Then I loaded that saved file into CAMEL99 Forth with INCLUDE. It also compiled perfectly.

 

So even without disabling interrupts I seem to be getting all the characters over the com port into the buffer. Not sure why but it works.

If there was ever a problem I could write a small word to do LIMI 0  in Forth but so far it seems to work.

 

Curiously both versions of STRAIGHT, the code version and the Forth version, compile to 132 bytes.  However the Forth version does not turn on the RS232 board LED so it would be a bit bigger if I did that.

Yet another attestation to the power of the 9900 instruction set.

 

 

  • Like 2

Share this post


Link to post
Share on other sites

Adding the LED control in Forth doubles the size of the compiled code. And I cheated a bit by using machine code versions to flip the bit on and off.

It is kind of neat that I can access registers in any Forth's workspace with CAMEL99 Forth as user variables. That's because these USER variables are relative to the workspace pointer (WP) in the CPU so the first 16 are the workspace registers. :)

 

EDIT: The reason I am not missing characters is because CKEY?  in the kernel code disables interrupts when it starts, keeps them off until it has tested for a key and stored the result in the TOS register.  So in a tight loop like TIMEKEY there is very little time for an interrupt to occur. It is possible but not likely at 9600bps because a new character is received every millisecond.

\ STRAIGHT in Forth. Rcv bytes into buffer, no echo. bjf Feb 2020
HERE
DECIMAL 12 2* USER 'R12  \ register 12 is a user variable :)

HEX
CODE 7SBO  1D07 , NEXT, ENDCODE
CODE 7SBZ  1E07 , NEXT, ENDCODE

: LEDON    'R12 @  RS232/1 'R12 !  7SBO   'R12 ! ;
: LEDOFF   'R12 @  RS232/1 'R12 !  7SBZ   'R12 ! ;


: CKEY   ( -- char) BEGIN  CKEY? ?DUP  UNTIL ;

HEX
: TIMEKEY ( wait-time -- 0 | c )  \ waits for a key until counter hits zero
      BEGIN
         1- DUP
      WHILE
         CKEY? ?DUP IF  NIP   EXIT THEN
      REPEAT
;

: STRAIGHT ( addr len -- n)
       LEDON
       0 -ROT             \ char counter under address
       OVER >R            \ save the 1st buffer location
       1 /STRING  BOUNDS  ( -- end start)
       R>                 ( -- end start addr)
       CKEY SWAP  C!      \ wait for 1st key & store
       DO
          2000 TIMEKEY
          DUP 0=
          IF  DROP LEAVE
          THEN I C!
          1+
       LOOP
       LEDOFF
;
HERE SWAP - SPACE DECIMAL . .( bytes)
HEX

 

Edited by TheBF
  • Like 2

Share this post


Link to post
Share on other sites

I think I found a faster C!  for my Forth. So far it's working...

 

Old version used a SWPB instruction.

CODE: C!     ( c addr -- )
             *SP SWPB,        
             *SP *TOS MOVB,  
              SP INCT, 
              TOS POP,  
              NEXT,      
              END-CODE

New one just reads memory with indexed addressing

CODE: C!     ( c addr -- )
              1 (SP) *TOS MOVB,  
              SP INCT,  
              TOS POP,  
              NEXT,  
              END-CODE

One less instruction is always good on the 9900. :)

 

Edit just checked and this is how FbForth does it. No prize for me.

 

Edited by TheBF
  • Like 1
  • Haha 1

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