Camel99 Forth Information goes here

[GDMike]

That area >6000 sure comes in handy!

[+TheBF]

Sometimes I wonder why I ever thought I could make my own tools.  

 

I finally re-organized my source code with a new "make" file that is written in Forth that creates a normal RAM version and a SuperCart version.

 

There is a weird gremlin that I have not actually caught yet that sometimes causes my builds to not interpret the DSK1.START file when the kernel boots on hardware. ???

I just found a couple of missing compiler directives in a file so maybe I was compiling code for the wrong Forth system into the image.   (That's a guess right now)

Anyway this one builds and loads and runs on real iron. 

Edit: I believe this "gremlin" was caused by making RAKE immediate in my DO LOOP code. Time will tell.

 

It's easier to understand the order of things without all the source code in the way.

Here is what it takes to make Camel99 Forth for the many thousands that are dying to know. 

• ITCTYPES.HSF extends the compiler to understand how to compile indirect threaded dictionary headers for variable, constants, colon words etc.
• Then load the Forth primitive words, written in Forth Assembler. These are the backbone of the system.
• At this stage the compiler does not know how to do FORTH looping and branching because it needed a couple of those primitives, so we compile BOOTSTRX.HSF
  • These words do not run on TI-99. They just work in the compiler so we can build the rest of the system.   We "bootstrap" the compiler so to speak.
     
• Compile the TI-99 specific I/O primitives, which are also Forth Assembler word
• Finally compile the CORE ANS Forth words plus the screen and keyboard words. 
  • Inside HILEVEL.HSF there are a few other includes:
    • TICKTOCK.HSF  9901 timer words
    • DSRLINKA.HSF  dsrlink word of course
    • FILESYX2.HSF   file system primitives (just enough to extend the system later) 
    • And finally we add ISOLOOPS.HSF which teach the TI-99 Forth how to do IF ELSE THEN BEGIN UNTIL etc.

It's a primitive compiler so once the compiling is done we use the compiler's Forth interpreter to patch some important addresses in the target memory image.

Then we save the the image as an EA5 program. 

 

I also realized, after all this time, that I was not doing a full "COLD" boot of the system when you typed COLD. That's fixed and will be in the next release.

 

Spoiler

\ MAKE CAMEL99 ITC Forth                            Mar 2022 B Fox

CROSS-COMPILING
\ **********************************************************************
\ compiler switches control HOW the system will be built
\ **********************************************************************
TRUE  VALUE ITC          \ used to prevent directly compiling HILEVEL.HSF
FALSE VALUE SLOWER       \ TRUE saves 28 bytes
FALSE VALUE HASHING      \ Not working yet

TRUE \ true= standard kernel ;  false=non-standard kernel
[IF]
    A000 VALUE KERNORG
    2000 VALUE HEAPORG
[ELSE]
	6000 VALUE KERNORG  \ the specific alternate load address to use
	2000 VALUE HEAPORG  \ initial HEAP address when kernel boots
[THEN]

\ *******************************************************************
\ Cross-compiler extensions, load threading mechanism words

 [CC] INCLUDE CC9900\SRC.ITC\ITCTYPES.HSF   \ CROSS-Compiler Extensions


\ *******************************************************************
\ Make Forth kernel
 [CC] INCLUDE CC9900\SRC.ITC\9900CODE.HSF  \ ASM primitives for TMS9900

 [CC] INCLUDE CC9900\SRC.ITC\BOOTSTRX.HSF  \ cross-compiler looping & branching

 [CC] INCLUDE CC9900\SRC.ITC\TI99IO.HSF    \ VDP primitives & KEY
 [CC] INCLUDE CC9900\SRC.ITC\HILEVEL.HSF   \ CORE Forth words

 \ ======================================================================
 \  P A T C H   T H E   T A R G E T  S Y S T E M   V A R I A B L E S
 [CC]

 XLATEST @ DUP LATEST T! ORGLAST T! ( align TARGET dictionary to compiler)

 T' CAMEL99  BOOT T!  ( set the boot word to run )

 KERNORG A000 <>
  [IF]
    THERE DP T!
    HEX A000 ORGDP T!   ( SUPERCART must start dictionary in HI RAM )
  [ELSE]
     THERE 2+ DUP DP T!  ORGDP T!
  [THEN]

 \ ======================================================================
 \ P A T C H   T A R G E T   I M A G E  F I L E   H E A D E R

 T' COLD >BODY BOOT-ADDRESS T!

 [CC] KERNORG A000 <>
 [IF]
      FILENAME: CAML99SC
 [ELSE]
      FILENAME: CAMEL99
 [THEN]
      END.       ( report compile time and stats)

 \ ======================================================================
 \ S A V E   B I N A R Y  I M A G E   F I L E

  FILENAME$ $SAVE-EA5.     ( FILENAME$ was set by FILENAME: )

 \ ======================================================================
 \  C O P Y   T O   T I - 9 9   V I R T U A L   D I S K
 .( copying binary file to TI-99 Emulator DSK1.)

 \ build the copy command in host Forth PAD memory by appending strings
 S" COPY " PAD PLACE
 FILENAME$ COUNT PAD +PLACE
 S"  cc9900\CAMEL99.WIP\dsk1.itc\" PAD +PLACE

 CR PAD COUNT 2DUP TYPE SYSTEM  \ SYSTEM calls DOS, gives it the string

 CROSS-COMPILING

  CR ." === COMPILE ENDED PROPERLY ==="
 QUIT

 \ BYE  ( un-comment this to return to DOS)

 

 

 

 

 

[+TheBF]

Sometimes it's interesting to compare our favourite computer to other machines of similar power.

I found this Forth benchmark website with posts made on many different machines.

The ultimate Forth Benchmark (theultimatebenchmark.org) 

 

Here are some of the benchmark programs written in Camel99 Forth with results from other machines with similar vintage or clock frequency.

It's interesting to me that on some benchmarks TI-99 indirect threaded Forth is beating 6502 sub-routine threaded Forth. 

 

It also looks like the 63C09 is very efficient at running Forth.

 

Spoiler

\ 12.16 Deliano
\ Ein Benchmark für 8bit Mikrocontroller, angeregt in Vierte Dimension 03/93
\ von Rafael Deliano
\ A-ONE (Apple 1 Clone) mit 65C02	TaliForth 2 (STC)   Deliano 0:29.0  1x
\ Z79Forth (Hitachi HD63C09 3 Mhz)	                	Deliano 7:53.0	50x
\                                                             = 0:09.46 1x
\ TI-99                         Camel99 Forth (ITC)    Deliano 0:26.5  1x

HEX
5 CONSTANT FIVE
0 VARIABLE BVAR

: BENCH
  100 0 DO
    1 BEGIN
        DUP SWAP
        DUP ROT DROP
        1 AND IF
          FIVE +
        ELSE
          1-
        THEN
        BVAR ! BVAR @
        DUP 0100 AND
     UNTIL DROP
   LOOP ;

 

 

Spoiler

\ Ultimate Forth Benchmark web site
\ C64	DurexForth 1.6.1 (STC)        Sieve/Prime	0:10.00  1x
\ C64 6510	Audiogenic Forth-64	    Sieve Bench	0:18.10  1x
\ Amstrad 6128+ Z80A 4Mhz	Uniforth	Sieve Bench	0:12.00  1x
\ TI99 Camel99 Forth  (ITC)         Sieve/Prime	0:12:53  1x

\ [BENCHMARK] Glibreath's fixed algorithm:
\ Eratosthenes' sieve from ORNL/TM10656 (Martin Marietta).

INCLUDE DSK1.ELAPSE
\ Camel99 doesn't have <= 
: <=   S" 1- <" EVALUATE ; IMMEDIATE

DECIMAL
8190 CONSTANT SIZE
VARIABLE FLAGS SIZE 1+ ALLOT

: DO-PRIME
  FLAGS SIZE 1+ 1 FILL
  0 SIZE 0 DO
    FLAGS I + C@ IF
      I DUP + 3 + DUP I +
      BEGIN
        DUP SIZE <=
      WHILE
        0 OVER FLAGS + C! OVER +
      REPEAT
      DROP DROP 1+
    THEN
  LOOP DROP ;

\ ELAPSE DO-PRIME

 

 

 

Spoiler

\ for camel99 Forth

\	Amstrad 6128+ Z80A 4Mhz	Uniforth  Nesting 1Mil 3:26
\ ZX Spectrum 2+	FIG-Forth 1.1a    Nesting 1Mil 3:15
\ C64 (normal)	    Forth64	          Nesting 1Mil 6:20
\ PDP11             FIG-Forth 1.3     Nesting 1Mil 0:49
\ TI99              Camel99 Forth     Nesting 1Mil 2:30

INCLUDE DSK1.ELAPSE


DECIMAL
: BOTTOM ;
: 1ST BOTTOM BOTTOM ;  : 2ND 1ST 1ST ;      : 3RD 2ND 2ND ;
: 4TH 3RD 3RD ;        : 5TH 4TH 4TH ;      : 6TH 5TH 5TH ;
: 7TH 6TH 6TH ;        : 8TH 7TH 7TH ;      : 9TH 8TH 8TH ;
: 10TH 9TH 9TH ;       : 11TH 10TH 10TH ;   : 12TH 11TH 11TH ;
: 13TH 12TH 12TH ;     : 14TH 13TH 13TH ;   : 15TH 14TH 14TH ;
: 16TH 15TH 15TH ;     : 17TH 16TH 16TH ;   : 18TH 17TH 17TH ;
: 19TH 18TH 18TH ;     : 20TH 19TH 19TH ;   : 21TH 20TH 20TH ;
: 22TH 21TH 21TH ;     : 23TH 22TH 22TH ;   : 24TH 23TH 23TH ;
: 25TH 24TH 24TH ;

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

\ ELAPSE 1MILLION 

 

 

Spoiler

\ Amstrad NC100 Z80 4.606Mhz	VolksForth CP/M (ITC)	Integer Calc	0:06.23
\ 8086 5Mhz	Laxen/Perry F83	                    Integer Calc         0:09.0
\ C64	DurexForth 1.6.1 (STC)                	Integer	Calc         0:37.0
\ Rockwell R1200-14, 2Mhz 65F12	RSC-Forth	    Integer Calc	     0:31.0
\ Amstrad 6128+ Z80A 4Mhz	Uniforth	        Integer Calc	     0:17.0
\ TI99 Camel99 Forth (ITC)                      Integer Calc         0:14.7

\ MSP430FR5739, 8Mhz CamelForth                 Integer Calc 100x   02'45':10
\                                               Scaled to 1X         0:01.65

INCLUDE DSK1.ELAPSE

DECIMAL
32000 CONSTANT INTMAX 

VARIABLE INTRESULT

: DOINT
  1 DUP INTRESULT DUP >R !
  BEGIN
    DUP INTMAX <
  WHILE
    DUP NEGATE R@ +! 1+
    DUP R@ +! 1+
    R@ @ OVER * R@ ! 1+
    R@ @ OVER / R@ ! 1+
  REPEAT
  R> DROP DROP
;

\ ELAPSE DOINT

 

Spoiler

\ Yodabashi Formula 1 Z80 4Mhz	   VolksForth CP/M (ITC)  Takeuchi 0:46.0 200X
\ Hitachi HD63C09     3 Mhz	       Z79Forth	              Takeuchi 0:55.0 200X
\ TI99   3.3Mhz                    Camel99 Forth  (ITC)   Takeuchi 2:07.2 200x

INCLUDE DSK1.ELAPSE

DECIMAL
 : 3DUP 2 PICK 2 PICK 2 PICK ;

 : TAK ( X Y Z -- T )
   OVER 3 PICK < NEGATE IF NIP NIP EXIT THEN
   3DUP ROT  1- -ROT RECURSE >R
   3DUP SWAP 1- -ROT SWAP RECURSE >R
             1- -ROT RECURSE
   R> SWAP R> -ROT RECURSE ;

 : TAKBENCH ( -- )
   0 1000 0 DO   DROP 18 12 6 TAK   LOOP DROP ;

: 200X   200 0 DO  TAKBENCH  LOOP ;

\ ELAPSE 200X 

 

 

[+TheBF]

While reading comp.lang.forth this morning there was a link to Forth site I had never seen.

I was aware of Leo Wong and some of his program postings from years ago.

 

This page has a very nicely made tutorial for those inclined to learn some Forth.

Simple Forth (murphywong.net)

 

I also found this word to make text macros which does some things I had never considered.

(I shouldn't be too shocked it was written by the late Wil Baden a Forth Guru)

• Passes the delimiting character argument to PARSE in interpret mode
• Defines words that make themselves immediate 

 

And... it forced me to figure out how to define SLITERAL which is a word I avoided up until now.  

SLITERAL - STRING (forth-standard.org)

 

: SLITERAL ( ca u --) \ Not in Camel99 Forth kernel
  POSTPONE (S")  S,  ; IMMEDIATE 

: MACRO  \ BY WIL BADEN
   : CHAR PARSE  POSTPONE SLITERAL  POSTPONE EVALUATE POSTPONE ;
   IMMEDIATE ;

And with MACRO Leo then defines a FOR NEXT loop word set like this:

\ Leo Wong  21 June 02004 02003 fyj +
\ fexit fleave for next

MACRO FOR " ( +U -- )  BEGIN ?DUP WHILE 1- >R"
MACRO NEXT " ( -- )   R> REPEAT"
MACRO FEXIT  " ( -- )  R> DROP EXIT"
MACRO FLEAVE " ( -- )   R> DROP 0 >R"

Pretty slick. 

You use R@ to get the loop index. 

 

 

[+Lee Stewart]

16 hours ago, TheBF said:

I also found this word [ SLITERAL ] to make text macros which does some things I had never considered.

(I shouldn't be too shocked it was written by the late Wil Baden a Forth Guru)

• Passes the delimiting character argument to PARSE in interpret mode

 

A similar word, WLITERAL , exists in fbForth (inherited and modified from TI Forth), except that it leaves the address of a packed (counted) string on the stack:

 

 

fbForth definitions follow in the spoiler:

Spoiler

: SLIT   ( --- addr )
   R> DUP C@ 1+ =CELLS OVER + >R  ;

: WLITERAL  ( --- [] | [addr] )  ( IS: <blank-delimited string>)
   BL STATE @
   IF
      COMPILE SLIT TOKEN
   ELSE
      TOKEN
   THEN
;  IMMEDIATE

 

 

...lee

[+TheBF]

16 minutes ago, Lee Stewart said:

 

A similar word, WLITERAL , exists in fbForth (inherited and modified from TI Forth), except that it leaves the address of a packed (counted) string on the stack:

fbForth definitions follow in the spoiler:

  Hide contents

: SLIT   ( --- addr )
   R> DUP C@ 1+ =CELLS OVER + >R  ;

: WLITERAL  ( --- [] | [addr] )  ( IS: <blank-delimited string>)
   BL STATE @
   IF
      COMPILE SLIT TOKEN
   ELSE
      TOKEN
   THEN
;  IMMEDIATE

 

 

...lee

Cool.

 

The definition of (S") is like SLIT but modified to return a stack string pair.  The name is probably not ideal since it now has more uses than just in S". 

: (S")    ( -- c-addr u) R>  COUNT  2DUP + ALIGNED >R ;

And S, looks like this

: S, ( c-addr u -- ) HERE OVER 1+ ALLOT PLACE ALIGN ;

It's interesting how many different ways you can slice these things up.

I remember it took me a while to get how the heck these things worked. I can't remember now how much of this is stock Camel Forth and where I changed things based on ideas I saw in other Forth systems.

 

[+Lee Stewart]

1 minute ago, TheBF said:

I remember it took me a while to get how the heck these things worked.

 

You and me both!

 

...lee

[HOME AUTOMATION]

I second that emotion!

[+TheBF]

After looking at Rich's RXB 2022 Demo and the amazing speed he is getting out of his BASIC for HCHAR and VCHAR I had to see if the Camel could run with the big dog.

 

So I wrote the demo code and promptly discovered my HCHAR and VCHAR were not properly protected.  

Fortunately with micro kernel, a sloppy programmer (who shall remain nameless),  can fix the external code library relatively easily.  

 

Anyway here is the result.  My VCHAR is pretty slow because it is mostly Forth with a tiny wrap word written in CODE and that can be seen clearly.

Since Rich's BASIC program used ONGOSUB I added one to Forth.  

\ 100 REM Randomize and RND test from RXB 2022
\ 110 RANDOMIZE
\ 120 ON INT(RND*2)+1 GOSUB 1000,1100
\ 130 GOTO 120
\ 1000 CALL HCHAR(INT(RND*24+1),INT(RND*32+1),INT(RND*255),INT(RND*767)+1):: RETURN
\ 1100 CALL VCHAR(INT(RND*24+1),INT(RND*32+1),INT(RND*255),INT(RND*767)+1):: RETURN

INCLUDE DSK1.GRAFIX
INCLUDE DSK1.RANDOM
INCLUDE DSK1.FASTCASE

DECIMAL
: RNDCOL   31 RND ;
: RNDROW   23 RND ;
: RNDCHAR  255 RND ;
: RNDSIZE  C/SCR @ 1-  RND 1+ ;

CASE: ONGOSUB  | HCHAR | VCHAR  ;CASE  \ :-) couldn't resist

: RUN
    CLEAR
    RANDOMIZE
    BEGIN
       RNDCOL RNDROW RNDCHAR RNDSIZE
       2 RND ONGOSUB
       ?TERMINAL
    UNTIL
;

 

Here are the revised HCHAR and VCHAR 

Spoiler

: HCHAR   ( col row char cnt -- ) \ *new* added automatic size protection
          2SWAP >VPOS   ( -- char cnt vdp1)
          DUP>R         ( -- char cnt vdp1)  ( r: vdp1)
          OVER +        ( -- char cnt vdp_end)
          C/SCR @ 1- -   0 MAX - ( char cnt' )
          R> -ROT SWAP VFILL ;

HEX
CODE VWRAP   \ 4x faster than Forth
  02A1 ,               \ R1 STWP,
  0202 , C/SCR @ 1- ,  \ R2 C/SCR @ 1- LI,
  A121 , 002E ,        \ 2E R1 () TOS ADD,  ( C/L@ TOS + )
  8084 ,               \ TOS  R2 CMP,
  1201 ,               \ HI IF,
  6102 ,               \    R2 TOS SUB,
                       \ ENDIF,
  NEXT,
ENDCODE

: VCHAR ( col row char cnt --)
      2SWAP >VPOS
      1 MAX SWAP 0
      DO  2DUP VC!  VWRAP  LOOP
      2DROP
;

 

 

 

[+TheBF]

Over here @apersson850 mentioned making the cursor the inverted character on the screen.

I had wondered about that but was always fighting with other bugs.  I thought I would try dropping it into the repeating key code and it works.

 

I was able to make the pattern copy pretty quick by copying 2 VDP bytes at once with V@ and since I had a full 16 bits INVERT makes quick work of the inversion process. 

 

There was a BLINK routine in the RKEY code that becomes the "key" (pun intended) to making this work.

Where before if the 9901 time was in the upper range,  it simply replace the input char (from the screen) with the cursor char,  now it copies the screen char's pattern over into the cursor char's pattern and inverts that pattern and then puts the cursor char on the screen 

: BLINK  ( char -- )
      TMR@ 1FFF >                         \ test 9901 timer
      IF
         ]PDT PAT-BUFFER 8 VREAD          \ char pattern -> RAM buffer
         PAT-BUFFER  CURS @ ]PDT 8 VWRITE \ copy buffer cursor pattern
         CURS @ DUP INVERT-CHAR           \ invert cursor pattern
      THEN VPUT ;                         \ put char on the screen

The only other wrinkle was to select a new cursor character so that you don't mess up the pattern of the ones you like to keep.

 

Full source with test routine below

Spoiler

\ Repeating key based on Nouspikel TI-99 tech pages heavily modified  Brian Fox
\ Apr 2002 Experimental verison with inverted char cursor

\ INCLUDE DSK1.TOOLS
INCLUDE DSK1.BUFFER

HERE
DECIMAL
VARIABLE OUTKEY     \ key buffer
VARIABLE OLDKEY     \ previous key buffer
CREATE RPT  10 ,    \ initial delay
VARIABLE SCHAR      \ screen character
VARIABLE INVERTED

8 BUFFER: PAT-BUFFER

HEX
: ]PDT   ( char -- Vaddr) 8* 800 + ; \ pattern descriptor array

: INVERT-CHAR ( char --)
      ]PDT 8 BOUNDS ( -- Vaddr-end Vaddr-start )
      DO
         I V@ INVERT I V!  \ read 16bit VDP data, invert, store back to VDP
      2 +LOOP
;

: BLINK  ( char -- )
      TMR@ 1FFF >                         \ test 9901 timer
      IF
         ]PDT PAT-BUFFER 8 VREAD          \ char pattern -> RAM buffer
         PAT-BUFFER  CURS @ ]PDT 8 VWRITE \ copy buffer cursor pattern
         CURS @ DUP INVERT-CHAR           \ invert cursor pattern
      THEN VPUT ;                         \ put char on the screen

: RKEY?  ( -- char)
    SCHAR @ BLINK
    RPT @ >R    \ delay counter to rstack
    BEGIN
        R> 1- DUP>R        \ dec counter
    WHILE ( not expired)
        83C8 ON  83CA ON   \ clear key buffers
        700 TICKS          \ sets the speed of the loop
        KEY? DUP OUTKEY !
        OLDKEY @ =         \ compare to oldkey
    WHILE ( key is same)
        2 RPT !  \ set fast repeats
    REPEAT
    0A RPT !     \ set long delay (initial delay)
    THEN         \ end time expired loop
    R> DROP
    OUTKEY @
    DUP OLDKEY !
    OUTKEY OFF
;

: RKEY ( -- char)
   VPOS VC@ SCHAR !
   BEGIN
      RKEY? DUP
   0= WHILE
     PAUSE
     DROP
   REPEAT
   SCHAR @ VPUT
;

HERE SWAP - DECIMAL SPACE .
HEX
: TEST
    001B CURS !  \ unused character for the cursor
    BEGIN
       RKEY EMIT  ?TERMINAL
    UNTIL
    5F CURS ! ;  \ Restore underline cursor

 

 

[apersson850]

Here's a link to the Programbiten newsletter from 1985, where my implementation of an adaptable cursor was published.

 

Look at page 25. There you'll see the DEF FLIP, NOFLIP command. These two procedures enable and disable the adaptable cursor under Extended BASIC.

Note that due to the daisy wheel on the printer, a command like CLR @THIS is printed as CLR 'THIS.

[+TheBF]

3 hours ago, apersson850 said:

Here's a link to the Programbiten newsletter from 1985, where my implementation of an adaptable cursor was published.

 

Look at page 25. There you'll see the DEF FLIP, NOFLIP command. These two procedures enable and disable the adaptable cursor under Extended BASIC.

Note that due to the daisy wheel on the printer, a command like CLR @THIS is printed as CLR 'THIS.

Very nice code.  I like the use of XOR to toggle the pattern. I will incorporate that idea and some in others in my implementation like the special case for the space character.

I could probably take a lot of "as is" if I re-write in Forth Assembler. 

 

I assume that the printer char-set was for Swedish and therefore English ASCII "@" was the apostrophe to make room for the special characters?

 

 

 

[GDMike]

3 hours ago, TheBF said:

Very nice code.  I like the use of XOR to toggle the pattern. I will incorporate that idea and some in others in my implementation like the special case for the space character.

I could probably take a lot of "as is" if I re-write in Forth Assembler. 

 

I assume that the printer char-set was for Swedish and therefore English ASCII "@" was the apostrophe to make room for the special characters?

 

 

 

I think it was Lee that explained XOR to me once upon a time as well, as I never knew. 

Edited April 16, 2022 by GDMike

[apersson850]

5 hours ago, TheBF said:

I assume that the printer char-set was for Swedish and therefore English ASCII "@" was the apostrophe to make room for the special characters?

No matter what we did back then, we couldn't find a daisy wheel for our printer that would print both Swedish text and various program's source code properly. This was before laser printers, so to get a nice looking print, the newsletter was printed with a "pretty-printer".

Nice to read that you appreciated the program. The rest of it was used to give a simple word processor, written in Extended BASIC, the ability to store strings in 8 K RAM. It also allows for saving these strings as a memory image. That made it possible to do some kind of word processing with TI Extended BASIC, 32 K RAM expansion and cassette player. And a printer, preferably.

The DSRLNK procedure is enhanced a bit, since it can handle DSR's in both ROM and GROM. Thus it doesn't matter what kind of file name you'll throw at it. DSK2.TEXTFILE or CS1 will work just as well. It was developed for Programbiten Forth (to close the Forth circle), in order to allow that to load from cassette just as from diskette.

The BASIC program was written so that it contained CALL LOAD statements to make a simple file loader. After doing OLD CS1 and RUN, the program used the CALL LOAD statements to place an assembly routine in memory. That program was called, and it immediately loaded another assembly program, the one you see in that newsletter, into memory. Then the BASIC program could start doing what it should. It was the first program I developed on the TI 99 where more than one person was working on the same project.

Edited April 16, 2022 by apersson850

[+TheBF]

Unfinished DTC Business

 

A long while back I gave up trying to maintain a direct threaded system and focus on the core ITC system.

As I added improvements to the kernel it became impossible to compile them into the DTC kernel "as is" so last week I started the process of re-learning all the things I forgot about how to make DTC work.  I am still not convinced it's the right fit for TI-99 but it REALLY bugged me that I couldn't compile a DTC system.

 

One of things that is not obvious is how to best use the SCRATCH-PAD RAM to hold fast primitives. 

With ITC it's easy. The first address of every ITC Forth word is a pointer to some native code.

So you just patch the fast RAM address into the first cell of a definition and the Forth interpreter will branch to it when the time comes.

 

Not so with Direct threading.  In the direct threading model, the actual location address of the code must be compiled into a Forth definition.

 

I now have the following words coded in fast RAM in the DTC code and I also updated the ITC code for the next release.

( I realized today that I could squeak in the code for ! which gave me DROP for free by just adding a label) 

l: _exit     *RP+ IP MOV,
l: _next*
@@9:         *IP+ W MOV,
                 *W B,

 l: _?branch
              TOS DEC,
              TOS POP,
              @@2 JOC,
 l: _branch   *IP IP ADD,
              @@9 JMP,
 @@2:         IP INCT,
              @@9 JMP,

l: _docol     IP RPUSH,
              R11 IP MOV,
              @@9 JMP,
l: _lit       TOS     PUSH,
             *IP+ TOS MOV,
              @@9 JMP,

l: _@        *R4 R4 MOV,
              @@9 JMP,

l: _!        *SP+ *TOS MOV,

L: _DROP      TOS POP,
              @@9 JMP,

l: _DUP      TOS PUSH,
             @@9 JMP,

l: _PLUS    *SP+ TOS ADD,
             @@9 JMP,

It turns out that for some of these it is not too hard because they are always "compiled" by the Forth compiler.

The words  ?BRANCH, BRANCH and LIT are not typically used by the programmer, rather the compiler uses them to do the work of IF, ELSE, WHILE, UNTIL etc. and LIT is compiled by the word LITERAL. 

( EXIT is mostly compiled by the semi-colon, but there are some ways to use it in a program so it needs to be accessible too)

 

The other programmer words @, ! , DUP , DROP and +  must be able to be both interpreted and also the fast RAM address needs to compile into new definitions.

In my previous DTC kernel I resorted to using a branch instruction to the fast RAM address.  This negates most of the benefits of having the fast RAM code.  

 

Example:

CODE  DUP    _DUP >HSRAM @@ B,  ENDCODE  

* >HSRAM computes the location in fast RAM at compile time. 

 

So in this new version with my better understanding, I wrote normal RAM versions of the words for the kernel.

These appear like normal code words when you boot the Forth system. 

 

I hear you asking "Does that mean the kernel is using the slow versions?"

Well no. The cross-compiler has some secret incantations that let me compile the fast addresses in the kernel code as well.

 

Once you are running the DTC kernel you need to "extend the compiler" so it knows how to decide what to do for compiling or interpreting the code in 16 bit RAM.  The only answer I came up was to make "state-smart" versions of these words that do the right thing depending the "state" of the compiler.  (compiling/interpreting)

 

The first versions were naïve:

: +     STATE @ IF   _HSPLUS , ELSE +    THEN ; IMMEDIATE

 

Then I realized each word was doing the same thing!

How about we make a way to run the same code for different fast RAM addresses.

Forth can do that.  (It took me a minute to realize I had to add IMMEDIATE  when the words are created)  

\ HSPRIMS.FTH  Optimizing compilers for fast RAM code primitives

: HSPRIM:  ( addr -- ) \ <name>
  CREATE    ,  IMMEDIATE    \ remember the address. Make new word IMMEDIATE 
  DOES>  @       \ fetch the address
        STATE @  \ what is the compiler state ?
        IF    COMPILE, 
        ELSE  EXECUTE
        THEN  ; 

\ Address       Name
\ -------       -----
_HSDUP  HSPRIM: DUP
_HSPLUS HSPRIM: +
_HS@    HSPRIM: @
_HS!    HSPRIM: !
_HSDROP HSPRIM: DROP

 

 

The DTC kernel is not much faster at compiling but on some benchmarks it shows some nice improvements.

For example on this benchmark:

DECIMAL
32000 CONSTANT INTMAX

VARIABLE INTRESULT

: DOINT
  1 DUP INTRESULT DUP >R !
  BEGIN
    DUP INTMAX <
  WHILE
    DUP NEGATE R@ +! 1+
    DUP R@ +! 1+
    R@ @ OVER * R@ ! 1+
    R@ @ OVER / R@ ! 1+
  REPEAT
  R> DROP DROP
;

ITC  14.61 seconds 

DTC 12.38 seconds 

That's 18% faster!  

 

 

 

 

Edited April 19, 2022 by TheBF
fixed typos

[+TheBF]

DTC System Update

 

My big issue with DTC Forth on TI-99 was the extra 8 bytes used for the entry code to each hi-level Forth word.

Something that mitigates that problem a little is the SuperCart. This system now has a version that runs at >6000 nicely.

 

There are a few things that are bugging out,  but because I used the ANS Forth method of referring to memory in CELLS and using >BODY to access the data field, many things work "as is" from the ITC library. I can even do the TRANSIENT tool loading into low RAM because the dictionary structure is the same.

 

I have one big bug to kill at the moment that involves the I word, in a DO LOOP, but only after I have loaded some other stuff first. ???

 

And of course wordlists and vocabularies are not working so that will be an ordeal to fix I am sure.  

But mostly I think this could become a useable system especially with SuperCart.

 

The other thing DTC Forth is good for is as a way to link code words together and in that case DTC is a net memory saving.

So if a project can be written in Forth Assembler mostly DTC is the preferred way to go.

 

In theory one should be able to replace the Assembler with a Machine Forth Assembler the CODE words would still look like hi-level Forth.

Things that make me say hmm...?

 

 

 

 

 

[+TheBF]

Well this is a good feeling. I think I found the DO LOOP bug and I am now able to begin compiling the same demo programs on both systems.

This Dutch Flag Demo using the Dijkstra algorithm is only about 9% faster.

The demo runs in VDP RAM directly. 

 

 

 

[+TheBF]

If you spend some time turning over stones ...

... yer gonna find a bug.

 

I thought I had fixed my DO LOOP  'I'  bug but I had not.

Deeper dive revealed that I had made a word immediate that should not have been for a LONG time.

There a bit of a comedy (tragedy?) of errors here. 

The reason it worked in the ITC version because I forced the initialization of the LEAVE stack when ABORT called the interpreter ( QUIT ) to make it work.

The reason it acted up in the DTC version was because somehow the WARM boot word did not include a line to init the stack pointer. DUH!

So it showed up in earlier in the DTC system. Bit of luck I guess since it made the old system more robust now too. 

 

Anyway, the problem word was RAKE

RAKE is the word that resets the LEAVE stack, so the stack would overflow after a couple of DO LOOPs were compiled.

So I now have a pretty solid DTC system (finally) and aside from fixing a few CODE words, 

that need to skip past those extra four bytes to get to the PFA,  it works really well. 

 

Here is the code file with the word that was not supposed to be IMMEDIATE.

One difference with this new system is that I don't try to shoehorn all the loops builders into the kernel.

This file compiles when the system boots. It only takes three seconds extra and I load a few other words at start up anyway.

 

Spoiler

CR .( ANS/ISO Loop & Branch)
\ special compilers needed for hi-speed code in scratch-pad RAM
: ?BRANCH  _?HSBRANCH , ; IMMEDIATE
: BRANCH    _HSBRANCH , ; IMMEDIATE

: AHEAD    ( -- addr) HERE   0 , ;
: <BACK ( addr --) HERE -  , ;

: THEN   ( addr -- ) HERE OVER - SWAP ! ;     IMMEDIATE
: BEGIN   HERE ;                              IMMEDIATE
: IF      POSTPONE ?BRANCH AHEAD ;            IMMEDIATE
: ELSE    POSTPONE BRANCH  AHEAD SWAP POSTPONE THEN ; IMMEDIATE
: UNTIL   POSTPONE ?BRANCH <BACK ;  IMMEDIATE
: AGAIN   POSTPONE BRANCH  <BACK ;  IMMEDIATE
: WHILE   POSTPONE IF SWAP ;        IMMEDIATE
: REPEAT  POSTPONE AGAIN POSTPONE THEN ; IMMEDIATE

\ CAMEL Forth LEAVE stack pointer is initialized by WARM
 : >L       ( x -- ) ( L: -- x )  2 LP +!  LP @ ! ;
 : L>       ( -- x )  ( L: x -- ) LP @ @   -2 LP +! ;

\                      -compile this-  - run this now-
: DO      ( -- ) ?COMP POSTPONE <DO>     HERE 0 >L ;  IMMEDIATE
: ?DO     ( -- ) ?COMP POSTPONE <?DO>    HERE 0 >L ;  IMMEDIATE
: LEAVE   ( -- ) ( L: -- addr )
   POSTPONE UNLOOP   POSTPONE BRANCH AHEAD >L ; IMMEDIATE

: RAKE   ( -- ) ( L: 0 a1 a2 .. aN -- )
   BEGIN  L> ?DUP       \ read leave stack, dup if <>0
   WHILE  POSTPONE THEN \ resolve branch in LEAVE
   REPEAT
   L0 LP ! ;  \ reset the leave stack

: LOOP    ( -- )  POSTPONE <LOOP> <BACK  RAKE ; IMMEDIATE
: +LOOP   ( -- )  POSTPONE <+LOOP> <BACK RAKE ; IMMEDIATE

 

 

[+TheBF]

Direct Threaded Code is more fun than I realized.

 

It turns out that reducing the size of the NEXT routine from 3 instructions to 2 instructions opens up new possibilities.

 

For those not intimately familiar with the "innards" of Forth, NEXT is the name of a very small interpreter that can read a list of addresses in memory.

It is cleverly organized to use the return stack so that it can read an address in memory, jump to the address to run some code there and then find it's way back to the next memory location.

Thus the name "NEXT".

 

In all the other Forth systems that I know of on TI-99 the internals used something called Indirect Threaded Code. (ITC)

This means that each address in these lists is actually the address... of the address ... of some code.  Thus it is "indirect". 

There are many advantages to this system but it does cost a bit of speed. 

 

Camel99 Forth code to do the ITC "interpreter" that reads the list of addresses is similar to all the others.

; IP is the interpreter pointer register (points to where the list is located) 
; W is the "working register" kind of like a temp but also has other uses

NEXT    MOV *IP+,W       ; Read the data at the IP location and bump the IP 
        MOV  *W+,R5      ; Read the data at the address in W into R5 (that's the indirect part) 
        B       *R5      ; finally we can jump to the address we have in R5. 

 

Every Forth routine must run this bit of code when it is finished executing.

You could copy this code at the end of every Forth routine but that's 6 bytes and it gets big fast.

On 9900 we mostly put the code in 16 bit RAM and put the address of NEXT in a spare register and branch through that register. Camel99 uses R10.

That means we only need 2 bytes (one instruction at the end of every Forth word and NEXT runs a full CPU speed. 

 

Direct threaded code has a smaller "interpreter"

       MOV  *IP+,W
       B    *W

This changes things in ways I didn't expect.  We can now decide: Do we want to branch through a register like before or just copy this code inline after every routine?

I chose to do both. 

 

I replaced the branch through R10 code in the kernel in every Assembly language word with the inline NEXT.  This adds 1 extra instruction per word but DTC saves an address in the header.

I also have a copy of NEXT in 16 bit RAM and since we are using direct threading I can simply copy that fast address into the end of Forth words with the semi-colon operator.

How neat is that?

 

So what you may ask?

Well getting back to our little integer benchmark:

DECIMAL
32000 CONSTANT INTMAX

VARIABLE INTRESULT

: DOINT
  1 DUP INTRESULT DUP >R !
  BEGIN
    DUP INTMAX <
  WHILE
    DUP NEGATE R@ +! 1+
    DUP R@ +! 1+
    R@ @ OVER * R@ ! 1+
    R@ @ OVER / R@ ! 1+
  REPEAT
  R> DROP DROP
;

Timings

TI99 Camel99 Forth (ITC)       Integer Calc        0:14.7
                             (DTC)                                0:12.4

 (DTC)   with inline next                                   0:11.98

 

22.7% speed up over ITC 

 

Full disclaimer: 

There is no free lunch, The DTC code is bigger if you write hi-level Forth. There is a 4 byte entry ( a BL instruction in my case) into every Forth word.

For example to load my Graphics library file ( COLOR, SCREEN, HCHAR etc) on the ITC version uses 858 bytes.

On the DTC kernel running almost identical source code uses 930 bytes.
However if you only write ALC code words you save 2 bytes on entry with every word using DTC so the extra instruction in NEXT is a wash.

I am liking it more now that it is stable. 

If I was having any more fun it would probably be illegal in some states.   (that shall remain nameless) 

 

 

 

 

 

 

Edited April 21, 2022 by TheBF
typo

[+TheBF]

I forgot to link in the fast primitives that are in scratch-pad RAM.

\ HSPRIMS.FTH  Optimizing compilers for fast RAM code primitives
 
: HSPRIM: ( addr -- ) \ <name>
  CREATE  , IMMEDIATE    \ remember the address. Make new word IMMEDIATE
  DOES> @      \ fetch the address
        STATE @ \ what is the compiler state ?
        IF   COMPILE,
        ELSE EXECUTE
        THEN  ;
 
\ Address       Name
\ -------       -----
_HSDUP  HSPRIM: DUP
_HSPLUS HSPRIM: +
_HS@    HSPRIM: @
_HS!    HSPRIM: !
_HSDROP HSPRIM: DROP
 

That took the time on DOINT down to 11.75.

That gives DTC a 25% speed improvement on this benchmark.

 

[+TheBF]

In the topic called Benchmarking languages Lee demonstrated how much little bits of extra code, inside an inner loop really affect program speed.

 

While working on this DTC version I wondered what would happen if I could optimize the comparison operator in the byte sieve benchmark.

Early on when building the Forth system I was struggling to fit it all in an 8K program space so I made the comparison operators branch to little code snippets to either set TOS to zero or set TOS to TRUE.

 

This saved 8 bytes but it meant that the comparison operators did not end with NEXT. 

Not ending with NEXT meant the optimizer could not figure out where the code ended and so you could not use INLINE[ ]  with <, >, U<, or U> .

 

So I changed those comparison operators today and on the Sieve benchmark in my regular ITC Forth, the time went from 80.8 seconds to 76 seconds just by including the '<' symbol in the inlining brackets.

This effectively removed only one extra pass through the 3 instruction interpreter.

 

It made a 6% improvement because that comparison is made on every pass through the inner loop.

 

By comparison replacing  DUP +   with 2*  and replacing DROP DROP with 2DROP only improved the time by 0.5 seconds.

 

For reference this code here:

: DO-PRIME2
   FLAGS SIZE 1 FILL  ( set array )
   0        ( counter )
   SIZE 0
   DO INLINE[ FLAGS I + C@ ]
     IF INLINE[ I DUP + 3 +  DUP I + ]
        BEGIN INLINE[ DUP SIZE < ]    \ <<< this is the line
        WHILE INLINE[ 0  OVER FLAGS +  C!  OVER + ]
        REPEAT
       INLINE[ DROP DROP 1+ ]
     THEN
   LOOP
   CR SPACE . ." Primes"  ;

 

 

 

[+TheBF]

Direct Threaded Forth System Update 

 

I have most of the system support libraries working now on the DTC system. Turns out that things like WORDLISTs which I thought would be difficult just worked once I had all the bugs out of the kernel. That was a nice surprise.

 

Much of the changes were around some of the recent optimizations made to graphics and sprites. 

I now have "TABLES" that let me define sections of memory as arrays even VDP RAM. The address calculations are in machine code using the ;CODE word.

 

The 'W' register in DTC holds the CFA (code field address). The DATA is 4 bytes past that. So where before I could get to the data with W TOS MOV,

If I used W with DTC Forth,  I would have to have W 4 ADDI,   W TOS MOV,

But I have a secret weapon. Since all Forth words in this DTC system are called by BL, R11 automagically holds the DATA field address. (4 bytes ahead)

So R11 TOS MOV,  is all I needed to change. 

 

Example:

Here we make TABLE4: that let's us define all the sprite data fields as byte arrays accessed with VC@ or VC!.

If I had written TABLE4: with Forth CREATE/DOES>  they would not need to be changed but I like the performance of these versions.

 

ITC

: TABLE4: ( Vaddr -- )  \ create a table of 4 byte records
         CREATE    ,
        ;CODE ( n -- Vaddr')
             0A24 ,  \ TOS 2 SLA,  ( tos = n x 4 )
             A118 ,  \ *W TOS ADD,
             NEXT,
ENDCODE

SAT     TABLE4: SP.Y
SAT 1+  TABLE4: SP.X
SAT 2+  TABLE4: SP.PAT
SAT 3 + TABLE4: SP.COLR

 

DTC

: TABLE4: ( Vaddr -- )  \ create a table of 4 byte records
    CREATE    ,
    ;CODE
      0A24 ,    \ TOS 2 SLA,  ( tos = n x 4 )
      A11B ,    \ *R11 TOS ADD,  ( add base address to index in TOS)
      NEXT,
    ENDCODE

SAT     TABLE4: SP.Y
SAT 1+  TABLE4: SP.X
SAT 2+  TABLE4: SP.PAT
SAT 3 + TABLE4: SP.COLR

ANSFILES just worked with no changes

ARRAYS were also optimized with ;CODE so the they needed the R11 tweek.

ASM9900 works the same since I decided to go with NEXT in R10. (you can add inline NEXT in your own CODE words as you wish anyway.)

 

Today was test the multi-tasker day. It required a kernel change to the word PAUSE and changes to the words SINGLE and MULTI.

PAUSE now uses 4 bytes of space and by default holds the code for DTC NEXT which is SINGLE task mode.  (2 instructions)

For MULTI mode PAUSE is patched to hold the instruction:  BL @YIELD. 

\ code snippets that are copied into PAUSE enable/disable multi-tasking
 HEX
 CREATE 'ILNEXT'   *IP+ R5 MOV,   R5 ** B,
 CREATE  BL@YIELD  'YIELD @@ BL,

\ turn multi-tasking on or off by patching the code in PAUSE
: SINGLE   ( -- ) 'ILNEXT' 2@  ['] PAUSE 2! ;  \ disable multi-tasking
: MULTI    ( -- ) BL@YIELD 2@  ['] PAUSE 2! ;  \ enable multi-tasking.

After that it worked!  

The last big thing I need to fix (I think) is SAVESYS that creates E/A5 programs. 

 

 

Here is a cute the demo running on DTC Forth and the program source that spawns three new tasks in empty memory.

 

Spoiler

\ MYSTERIOUS EYES II                                         Jan 21 2021 Fox
\ demonstrates sprites, DATA statement, multi-tasking and saving binary program
 
\ INCLUDE DSK1.TOOLS  \ debug only
 
INCLUDE DSK1.DATABYTE
INCLUDE DSK1.MARKER         \ needed for LOCK
INCLUDE DSK1.MALLOC
INCLUDE DSK1.GRAFIX
INCLUDE DSK1.RANDOM
INCLUDE DSK1.DIRSPRIT
\ INCLUDE DSK1.MTASK99
 
DECIMAL
: CHARDEF4 ( data[] ascii# -- ) PAUSE  ]PDT 32 VWRITE ;
 
\ ****************************************
\ * Sprite Patterns
\ ****************************************
HEX
CREATE EYELIDS
  DATA 030C,1020,4040,8080    \ 0 Wide open
  DATA 8080,4040,2010,0C03
  DATA C030,0804,0202,0101
  DATA 0101,0202,0408,30C0
 
  DATA 030F,1F3F,4040,8080
  DATA 8080,4040,2010,0C03
  DATA C0F0,F8FC,0202,0101
  DATA 0101,0202,0408,30C0
 
  DATA 030F,1F3F,7F7F,8080
  DATA 8080,4040,2010,0C03
  DATA C0F0,F8FC,FEFE,0101
  DATA 0101,0202,0408,30C0
 
  DATA 030F,1F3F,7F7F,FFFF
  DATA 8080,4040,2010,0C03
  DATA C0F0,F8FC,FEFE,FFFF
  DATA 0101,0202,0408,30C0
 
  DATA 030F,1F3F,7F7F,FFFF
  DATA FFFF,4040,2010,0C03
  DATA C0F0,F8FC,FEFE,FFFF
  DATA FFFF,0202,0408,30C0
 
  DATA 030F,1F3F,7F7F,FFFF
  DATA FFFF,7F7F,2010,0C03
  DATA C0F0,F8FC,FEFE,FFFF
  DATA FFFF,FEFE,0408,30C0
 
  DATA 030F,1F3F,7F7F,FFFF
  DATA FFFF,7F7F,3F1F,0C03
  DATA C0F0,F8FC,FEFE,FFFF
  DATA FFFF,FEFE,FCF8,30C0
 
  DATA 030F,1F3F,7F7F,FFFF
  DATA FFFF,7F7F,3F1F,0F03
  DATA C0F0,F8FC,FEFE,FFFF
  DATA FFFF,FEFE,FCF8,F0C0    \ 7 FULLY CLOSED
 
DECIMAL
: ]EYELID  32 * EYELIDS + ;
 
CREATE PUPIL
HEX
  DATA 0000,0000,0001,0307
  DATA 0707,0301,0000,0000
  DATA 0000,0000,00C0,E0F0
  DATA F0F0,E0C0,0000,0000
 
 
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
DECIMAL
 
128 CONSTANT LEFTEYE
132 CONSTANT RIGHTEYE
 
136 CONSTANT LEFTPUPIL
140 CONSTANT RIGHTPUPIL
 
144 CONSTANT SCLERA     ( the white part of the eye)
 
VARIABLE FATIGUE    10 FATIGUE !
VARIABLE CALM       90 CALM    !
 
: BLINKER   FATIGUE @ MS  ;
: CLOSE2  ( -- )
    8 0 DO
        I ]EYELID DUP
        LEFTEYE  CHARDEF4
        RIGHTEYE CHARDEF4
        BLINKER
    LOOP ;
 
: OPEN2  ( -- )
    0 7 DO
        I ]EYELID DUP
        LEFTEYE  CHARDEF4
        RIGHTEYE CHARDEF4
        BLINKER
    -1 +LOOP ;
 
: BLINK2     CLOSE2 OPEN2 ;
 
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
CREATE EYE-XY  0 , 0 ,
EYE-XY    CONSTANT EROW
EYE-XY 2+ CONSTANT ECOL
 
: PIX.COL ( -- n)   ECOL @ 8* ;
: PIX.ROW ( -- n)   EROW @ 8* 1- ;
 
CHAR * CONSTANT '*'
CHAR ! CONSTANT '!'
 
: DEF.CHARS
  0 ]EYELID  LEFTEYE  CHARDEF4
  0 ]EYELID  RIGHTEYE CHARDEF4
 
  PUPIL LEFTPUPIL  CHARDEF4
  PUPIL RIGHTPUPIL CHARDEF4
 
  7 ]EYELID SCLERA CHARDEF4   ( define a white circle in 4 chars )
   SCLERA SET# 16 1 COLOR     ( make it white)
  2 MAGNIFY
  '*' SET# 13 1 COLOR
  '!' SET# 9  1 COLOR ;
 
: .EYELIDS
( char  colr    x             y       sp# -- )
    CLOSE2
   128   2    PIX.COL      PIX.ROW    0  SPRITE \ left eye
   132   2    PIX.COL 32 +  PIX.ROW   1  SPRITE \ left right
;
 
: .PUPILS
( char  colr     x             y      sp# -- )
   136   2     PIX.COL      PIX.ROW    2  SPRITE \ left pupil
   140   2     PIX.COL 32 +  PIX.ROW   3  SPRITE \ right pupil
;
 
: .SCLERA  ( col row --)
       2DUP AT-XY  144 EMIT 146 EMIT
         1+ AT-XY  145 EMIT 147 EMIT ;
 
: .2SCLERA  ( --)
        VROW 2@ 2>R  \ save cursor position
        EYE-XY 2@  2DUP .SCLERA
        SWAP 4 + SWAP .SCLERA
        2R> AT-XY  ; \ restore
 
: .EYES   ( col row -- ) EYE-XY 2! .2SCLERA  .EYELIDS  .PUPILS ;
: HORZ    ( offset -- )  DUP 2 SP.X VC!  32 +  3 SP.X VC! ;
: VERT    ( height -- )  DUP 2 SP.Y VC!  3 SP.Y VC! ;
 
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ TASKS
: BLINKING ( -- )
         BEGIN
           3000 RND FATIGUE @ + MS
           BLINK2
         AGAIN ;
 
: LEFT/RIGHT
         BEGIN
           2000 RND CALM @ + MS
           PIX.COL  9 RND 4 - +  HORZ
         AGAIN ;
 
DECIMAL
C/SCR @ 1-  CONSTANT N  \ chars per screen - 1
 
: THING
     BEGIN
        CLOSE2
        PAGE
        10 10 OPEN2 .EYES
        N 2/  0
        DO
           '!'     I   VC!
           '*'  N  I - VC!
           40 MS
        LOOP
     AGAIN
;
 
: UP/DOWN
     BEGIN
        3000 RND CALM @ + MS
        PIX.COL  9 RND 4 - +  VERT
        ?TERMINAL
     UNTIL ;
     
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ combine multi-tasking primitives to dynamically create a task
: SPAWN  ( xt -- )  USIZE MALLOC DUP FORK DUP WAKE  ASSIGN ;
 
HEX 83D6 CONSTANT NO-TIMEOUT
 
DECIMAL
: GO
      ( WARM) 
      GRAPHICS
      NO-TIMEOUT ON
      1 SCREEN
      INIT-MULTI
      ['] BLINKING  SPAWN
      ['] LEFT/RIGHT SPAWN
      ['] THING SPAWN
      DEF.CHARS
      MULTI
      UP/DOWN   \ console task
      BYE
;
 

 

 

 

 

 

[+TheBF]

Approaching Bug-for-Bug Compatibility  

 

I threw something harder at the DTC multi-tasker.  Five tasks + console task. 

Still runs correctly.

(This stability of the cross-compiler now that I have fixed the RAKE word is so refreshing.

  I used to get these weird bugs that I could not understand)

 

Spoiler

\ BILLYBALL XB256 DEMO by @Retrospect on atariage.com   Nov 1 2021
\ Test harness for Camel99 forth  B Fox

INCLUDE DSK1.LOWTOOLS  \ DEBUG ONLY
INCLUDE DSK1.MARKER
INCLUDE DSK1.MALLOC
INCLUDE DSK1.GRAFIX
INCLUDE DSK1.RANDOM
INCLUDE DSK1.SOUND
INCLUDE DSK1.DIRSPRIT \ direct control sprites
INCLUDE DSK1.MTASK99
INCLUDE DSK1.MTOOLS
INCLUDE DSK1.AUTOMOTION
INCLUDE DSK1.RANDOM



DECIMAL
 1 CONSTANT Transparent
 5 CONSTANT Blue
 9 CONSTANT Red
11 CONSTANT Yellow
15 CONSTANT Gray
16 CONSTANT White

\ ***********************
\ task creation
\ ***********************
: TASK: ( n -- ) USIZE MALLOC DUP FORK CONSTANT  ; \ returns PID (address)

DECIMAL
TASK: JOB1    \ Billy ball rotator
TASK: JOB2    \ Bill ball  mover
TASK: JOB3    \ Bobby ball rotator
TASK: JOB4    \ Bobby ball mover
TASK: JOB5    \ cannon


\ ***********************
\ CHAR DEFINITION HELPERS
\ ***********************
DECIMAL
: CHARDEF32 ( data[] ascii# -- ) ]PDT 32 VWRITE ; \ def 2 chars (32 bytes)

\ convert long text string to 16 bit HEX numbers and
\ compile each number into memory sequentially
: HEX#, ( addr len  --)
        BASE @ >R        \ save radix
        HEX              \ converting string to hex numbers
        BEGIN DUP
        WHILE            \ while len<>0
           OVER 4        \ used 4 digits from left end of string
           NUMBER? ?ERR  \ convert string to number
           ,             \ compile the integer into memory
           4 /STRING     \ cut 4 digits off left side of string
        REPEAT           \ keep going until string is exhausted
        2DROP
        R> BASE !        \ restore radix
;

\ *********************
\ * ASTEROID PATTERNS *
\ *********************
DECIMAL
CREATE ASTEROIDS
S" 000F191032434964504C23100C0700000000C020501098CC1272941CF0000000" HEX#,
S" 000000050A10121410181C13110D03000000F008104844CC9A12648418600000" HEX#,
S" 00000001020509181F10100E07000000000000F02804E4063EE2020CF0000000" HEX#,
S" 00000000031C382E212018070000000000000070888C5262828C90E000000000" HEX#,
S" 0000000007182F2524150E000000000000000000E01078C4042CD80000000000" HEX#,
S" 00000000000F18282F28311E0000000000000000E05844C43C0428F000000000" HEX#,
S" 000000000304041D161414181108070000000000789412729A06024438C08000" HEX#,
: ]ASTEROID ( n -- addr) 32 * ASTEROIDS + ; \ 0 TO 5 asteriods

\ ****************************************************************
\ * NOW TO HAVE AN ARRAY WITH 4 ELEMENTS, FOR THE FOUR ASTEROIDS *
\ ****************************************************************
\ these will keep a pattern number in them, and each one will be different
CREATE AST[]  74 , 80 , 84 , 88 ,
: ]AST ( n -- addr) CELLS AST[] + ;


\ ************************
\ * THE GROUND TO SCROLL *
\ ************************
251 CONSTANT DIRT.CHAR
CREATE EARTH
S" 10183C3C7E7EFFFF0000001010387CFF0000000000000FFF08080818387C7EFF" HEX#,
EARTH DIRT.CHAR CHARDEF32

\ ***********************
\ * BALL ANIMATION DEFS *
\ ***********************
\ Compile contiguos data for each frame of Ball animation
CREATE BALLS ( patterns for 23 chars )
S" 00030F1F3F3C787A787F7F3C3E1F0F0300E0F8FCFE9E8FAF8FFFFF1E3EFCF8E0" HEX#,
S" 00030F1F3F397175717F7F383C1F0F0300E0F8FCFE3E1F5F1FFFFF3E7EFCF8E0" HEX#,
S" 00030F1F3F32626A627F7F30381F0F0300E0F8FCFE7E3FBF3FFFFF7EFEFCF8E0" HEX#,
S" 00030F1F3F244455447F7F20311F0F0300E0F8FCFEFE7F7F7FFFFFFEFEFCF8E0" HEX#,
S" 00030F1F3F09082A087F7F01231F0F0300E0F8FCFEFEFFFFFFFFFFFEFEFCF8E0" HEX#,
S" 00030F1F3F131155117F7F03071F0F0300E0F8FCFEFEFFFFFFFFFFFEFEFCF8E0" HEX#,
S" 00030F1F3F27232B237F7F070F1F0F0300E0F8FCFEFEFFFFFFFFFFFEFEFCF8E0" HEX#,
S" 00030F1F3F0F4757477F7F0F3F1F0F0300E0F8FCFEFEFFFFFFFFFFFEFEFCF8E0" HEX#,
S" 00030F1F3F1F0F2F0F7F7F1F3F1F0F0300E0F8FCFEFEFFFFFFFFFFFEFEFCF8E0" HEX#,
S" 00030F1F3F1F1F5F1F7F7F3F3F1F0F0300E0F8FCFEFEFFFFFFFFFFFEFEFCF8E0" HEX#,
S" 00030F1F3F3F7F7F7F7F7F3F3F1F0F0300E0F8FCFEFEFFFFFFFFFFFEFEFCF8E0" HEX#,
S" 00030F1F3F3F7F7F7F7F7F3F3F1F0F0300E0F8FCFEFEFFFFFFFFFFFEFEFCF8E0" HEX#,
S" 00030F1F3F3F7F7F7F7F7F3F3F1F0F0300E0F8FCFEFEFFFFFFFFFFFEFEFCF8E0" HEX#,
S" 00030F1F3F3F7F7F7F7F7F3F3F1F0F0300E0F8FCFEFEFFFFFFFFFFFEFEFCF8E0" HEX#,
S" 00030F1F3F3F7F7F7F7F7F3F3F1F0F0300E0F8FCFEFCFCFDFCFFFFFEFEFCF8E0" HEX#,
S" 00030F1F3F3F7F7F7F7F7F3F3F1F0F0300E0F8FCFEFCF8FAF8FFFFFCFEFCF8E0" HEX#,
S" 00030F1F3F3F7F7F7F7F7F3F3F1F0F0300E0F8FCFEF8F1F5F1FFFFF8FEFCF8E0" HEX#,
S" 00030F1F3F3F7F7F7F7F7F3F3F1F0F0300E0F8FCFEF2E2EAE2FFFFF0F8FCF8E0" HEX#,
S" 00030F1F3F3F7F7F7F7F7F3F3F1F0F0300E0F8FCFEE4C4D5C4FFFFE0F0FCF8E0" HEX#,
S" 00030F1F3F3F7F7F7F7F7F3F3F1F0F0300E0F8FCFEC888AA88FFFFC0E2FCF8E0" HEX#,
S" 00030F1F3F3F7F7F7F7F7F3F3F1F0F0300E0F8FCFE92115511FFFF82C6FCF8E0" HEX#,
S" 00030F1F3F3F7E7E7E7F7F3F3F1F0F0300E0F8FCFE2623AB23FFFF068EFCF8E0" HEX#,
S" 00030F1F3F3E7C7D7C7F7F3E3F1F0F0300E0F8FCFE4E475747FFFF0E1EFCF8E0" HEX#,

\ expose BALLS as an array of 32 byte records
\ Animate the BALL by sequencing from 0 ]BALL  to 22 ]BALL OR reverse
: ]BALL ( n -- addr )  32 * BALLS +  ;


CREATE EXPLOSION
S" 0030787C3E1C0070FCF8F83103030100000E1E1C382000071F0F8680C0E08000" HEX#,

\ ********************************
\ * BILLY BALL'S MAGICAL MISSILE *
\ ********************************
S" 0000000000000211AF02000000000000000000000034FDDFEFF6280000000000"
136 CALLCHAR

\ **************
\ * STAR CHR'S *
\ **************
DECIMAL
CREATE STARS  160 , 168 , 176 , 184 , 192 , 200 , 208 ,
: ]STAR ( n -- addr) CELLS STARS + ;

PAD CHAR . CHARPAT     \ read '.' char pattern
PAD  0 ]STAR CHARDEF   \ assign to star characters
PAD  1 ]STAR CHARDEF
PAD  2 ]STAR CHARDEF
PAD  3 ]STAR CHARDEF
PAD  4 ]STAR CHARDEF
PAD  5 ]STAR CHARDEF
PAD  6 ]STAR CHARDEF

\ *********************
\ Multi-Task actions must be in an endless loop. Control with WAKE/SLEEP
\ *********************
HEX
50 USER SPIN   \ user variable for rotation speed
52 USER SPEED  \ speed of motion

DECIMAL
: ROTATOR ( char speed -- )
     SPIN !
     BEGIN
       23 0 DO
         I ]BALL OVER CHARDEF32
         SPIN @ MS
        PAUSE
       LOOP
     AGAIN ;

\ *****************************
\ MAKE SPRITES
\ *****************************
DECIMAL
2 MAGNIFY
128 CONSTANT Billy
132 CONSTANT Bobby
136 CONSTANT Missle

 0  CONSTANT Bill
 1  CONSTANT Bob
 02 CONSTANT WEAPON

DECIMAL
: BOUNCER ( spr# speed --)
     SPEED !  \ each task has it's own bound speed
     BEGIN
       130 10 DO   I OVER SP.Y VC!   SPEED @ MS      LOOP
       10 130 DO   I OVER SP.Y VC!   SPEED @ MS  -1 +LOOP
     AGAIN ;

\ INC/DEC byte in VDP RAM
: +!V   ( n Vaddr -- ) S" TUCK VC@ +  SWAP VC!" EVALUATE ; IMMEDIATE

: STOP  ( pid -- ) SLEEP PAUSE ;

DECIMAL
: LASER-ON    GEN1 121 HZ 12 DB     GEN2 125 HZ 12 DB ;
: LASER-OFF   GEN1 MUTE             GEN2 MUTE ;

: FADE-BLAST
          31 6
          DO
             GEN4 I DB
             50 MS
          LOOP ;

DECIMAL
: EXPLODE ( -- )
      4 NOISE 0 DB         \ impact sound
      LASER-OFF            \ kill the laser beam
      100 MS
      5 NOISE
      16 0 DO
         PAUSE
         I DB              \ fade impact noise
         I Bob SP.COLR VC!   \ change Bobby's color
         70 MS
      LOOP
      Blue Bob SP.COLOR
      SILENT
;

: SP.X++    ( n spr# -- ) SP.X +!V  ;
: SPIN-RATE ( n spr# -- ) SPIN LOCAL ! ;

: LAUNCHER   ( sp.X sp.Y -- )
      Bill POSITION WEAPON LOCATE  \ Put weapon inside sprite 0
      6 NOISE  0 DB               \ initial shot
      LASER-ON
      100 TICKS                   \ brief ontime
      GEN4 14 DB                  \ reduce noise to cruise volume.
      BEGIN
        PAUSE
        Red WEAPON SP.COLOR       \ give it a color
        4 WEAPON SP.X++           \ move the flaming shot

        Bob WEAPON 10 COINC       \ test for collision
        IF ( we hit Bobby)
           Transparent WEAPON SP.COLOR      \ weapon goes invisible
           5 JOB3 SPIN-RATE       \ change Bobby's spin rate
           EXPLODE                \ make some sound and change Bobby's color
           60 JOB3 SPIN-RATE      \ make Bobby slowdown again
           MYSELF STOP
        THEN

        Yellow WEAPON SP.COLOR   \ change color while fire travels

        WEAPON SP.X VC@ 250 >    \ test for WEAPON at edge of screen
      UNTIL
      LASER-OFF
      FADE-BLAST
      60 JOB3 SPIN-RATE          \ make Bobby slowdown again
      Transparent WEAPON SP.COLOR
      Blue Bob SP.COLOR           \ reset Bobby's color
      MYSELF STOP
;

: SPIN-BILL   Billy 60 ROTATOR ;
: SPIN-BOB    Bobby 60 ROTATOR ;

: BOUNCE-BILL  Bill 25 BOUNCER ;
: BOUNCE-BOB   Bob  15 BOUNCER ; \ faster movement, harder to hit

' SPIN-BILL   JOB1 ASSIGN
' BOUNCE-BILL JOB2 ASSIGN
' SPIN-BOB    JOB3 ASSIGN
' BOUNCE-BOB  JOB4 ASSIGN
' LAUNCHER    JOB5 ASSIGN

: GO
  CLEAR
  Gray SCREEN
( char colr      x   y   sp# -- )
  Billy  White   10  10  Bill  SPRITE
  Missle  1      20  20 WEAPON SPRITE
  JOB1 WAKE JOB2 WAKE
  2500 MS

  Bobby  Blue   215  10  Bob   SPRITE
  JOB3 WAKE JOB4 WAKE ;

: FIRE   CLEAR  JOB5 RESTART 100 MS    ;

MULTI

 

 

Edited April 29, 2022 by TheBF
Added code spoiler

[+TheBF]

What about SAMS in DTC you ask?

 

SAMSINI works without changes 

PAGED  which converts a virtual address to a real address in CPU RAM, works without changes.

 

 

FAR:  and  ;FAR    that compile definitions into SAMS memory; That required changes but due to the magic of R11 it was minimal.

 

It really comes down to changing FARCOL that replaces DOCOL in SAMS definitions and the fact that we have have to BL to FARCOL rather than putting the address in after the HEADER of the Forth word.

CREATE FARCOL   \ run time executor for SAMS *DTC* colon words.
     IP RPUSH,
     R11 IP MOV, \ <<< Replace W with R11 
     RP DECT,
     LASTBNK @@ *RP MOV,  \ Rpush the active bank
     *IP+ R1 MOV,         \ fetch bank# from DATA FIELD -> R1, inc IP
     _CMAP @@ BL,         \ & switch to SAMS page for this word
     *IP IP MOV,          \ get SAMS DP & set new IP
     NEXT,

 

: FAR: ( -- ) \ special *DTC* colon for words in FAR memory
     !CSP
     HEADER             \ compile Forth header with name
     FARCOL @@ BL,      \ <<< compile bl to farcol *DTC change*
     BANK# @ DUP ,      \ compile bank# as the DATA field
      DUP ]DP @ ,       \ compile this word's SAMS address ( ie: FAR XT)

     HERE SAVHERE !     \ save "normal here"

     DUP ]DP @ DP !     \ set dp to CSEG. Compiling goes here now
     ( bank#) CMAP      \ map SAMS for compiling
     HIDE
     ]                  \ turn on the compiler
;

 

Two lines changed and it worked as the screenshot shows.  

 

 

 

 

Edited April 29, 2022 by TheBF
Wrong screen shot.

[GDMike]

Well, I was wondering about that, and also how cool it'd be to have a forth app running in the background on my TIPI that I could send mp3 requests from the TI and back from the pi, now that we have a pi in their and able to handle long filenames..