Camel99 Forth Information goes here

[+TheBF]

I thought it was about time that I create a goto place (no pun intended) for all things Camel99.

 

So from now on I will put updates here.

 

This update is my first Pong Game. It's a little quirky but it uses sound and sprites with no interrupts or multi-tasking.

It's not that easy to win. The computer player is very crude but it make enough mistakes so that you can win. :-)

 

Since I never spent much time writing games this has been educational for me.

 

I have added a new simple word to CAMEL99 to create named character patterns. It's called PATTERN:

"PATTERN:" words return the address (ie: a pointer) to the data that loads into VDP very fast using VWRITE.

 

If you wanted to add PATTERN: to another Forth the code is:

\ PATTERN: lets us define named character patterns

\ usage: 
\  HEX 3C42 A581 A599 423C PATTERN: HAPPY_FACE
\      3C42 A581 99A5 423C PATTERN: SAD_FACE

\ DECIMAL
\ SAD_FACE  159 CHARDEF

: PATTERN: ( u u u u  -- )
           CREATE
           >R >R >R              \ push 3 values so we can reverse order
           ,  R> , R> , R> ,     \ compile 4 ints in VDP useable order
;

The PONG code is in the spoiler. You have to load CAMEL99 with EA5 option and then paste PONG it into the emulator.

When the codes finishes compiling type RUN.

 

Latest version of CAMEL99 is on GitHub at the URL in the signature.

 

 

\ simple pong DEMO for CAMEL99      Dec 30 2017 B Fox

\ ======================================================
\ direct SPRITE control lexicon. (no auto-motion)
HEX
8802   CONSTANT VDPSTS         \ vdp status register memory mapped address

300    CONSTANT SDT            \ sprite descriptor table address in VDP RAM
20 4*  CONSTANT SDTsize        \ size of the table, 32 sprites x 4 bytes/record
1F     CONSTANT MAX.SP         \ 32 sprites, 0 .. 31
8364   CONSTANT SPR#           \ sprite counter is kept in FAST RAM

\ Sprite descriptor table array
: ]SDT     ( char# -- sdt[n])  4* SDT + ;  

\ named fields for sprite record.  Usage:  12 ]SDT ->PAT
: ->PAT   ( addr -- addr+2) 2+  ;
: ->COLR  ( addr -- addr+3) 3 + ;

\ finger trouble protection. Runtime array index test.
: ?NDX  ( n -- n ) MAX.SP  OVER U< ABORT" SPR#>31"  ;

\ INIT SPRITES: You must run DELALL before using sprites*
: DELALL  ( -- )
          1 ?MODE               \ test for graphics mode
          1 6 VWTR              \ vdp reg 6 = 1, puts ]PDT @ $800
          SDT SDTsize BL VFILL  \ init the sprite desc. table with blanks
          SPR# OFF ;            \ #sprites=0

\ The following words are named like Extended BASIC
\ (remove ?NDX if you need more speed, but you have no protection)
: POSITION  ( sprt# -- dx dy ) ?NDX  ]SDT V@ SPLIT  ;     \ read 2 bytes, split them
: LOCATE    ( dx dy sprt# -- ) ?NDX  >R FUSE R> ]SDT V! ; \ store 2 fused bytes
: PATTERN   ( char sprt# -- )  ?NDX  ]SDT ->PAT VC! ;
: SP.COLOR  ( col sprt# -- )   ?NDX  >R 1- R> ]SDT ->COLR VC! ; \ uses TI BASIC color #s

: SPRITE  ( char colr x y sp# -- )     \ create a SPRITE, sp# = 0..31
             DUP >R                   \ copy spr# to rstack
                LOCATE                \ set screen position
             R@ SP.COLOR              \ set the sprite color
             R@ PATTERN               \ set the character pattern to use
             R> SPR# @ >              \ is this sprite# > last sprite made
             IF 1 SPR# +!             \ if so, increment the sprite counter
             THEN ;

\ faster access to Sprite descriptor table X,Y bytes than using LOCATE and Position
\ ** NO sprite# limits, be careful **

: SP.X   ( spr# -- vdp_addr) ]SDT 1+ ; \ returns VDP sprite Decriptor X address
: SP.Y   ( spr# -- vdp_addr) ]SDT ;    \ returns VDP sprite Decriptor Y address

: SP.X@  ( spr# -- sprx) SP.X VC@ ; \ fetch X
: SP.Y@  ( spr# -- spry) SP.Y VC@ ;    \ fetch Y

: SP.X!  ( n spr# -- ) SP.X VC! ;   \ store X
: SP.Y!  ( n spr# -- ) SP.Y VC! ;      \ store Y

\ like Extended BASIC Magnify
: MAGNIFY  ( mag-factor -- ) 83D4 C@ 0FC AND + DUP 83D4 C!  1 VWTR ;

HEX
: 2(X^2)   ( n -- 2(n^2)  DUP * 2* ; 

( factored DIST out from SPRDISTXY in TI-Forth)
: DIST     ( x2 y2 x1 y1 -- distance^2) \ distance between 2 coordinates
            DXY 2DUP +                  \ sum the squares (DXY is code word)
            DUP >R                      \ push a copy
            OR OR 8000 AND              \ check out of range
            IF R> DROP 7FFF             \ throw away the copy, return 32K
            ELSE R>                     \ otherwise return the calculation
            THEN ;

: SP.DIST   ( #1 #2 -- dist^2 )         \ distance between 2 sprites
            POSITION ROT POSITION DIST ;

: SP.DISTXY ( x y # -- dist^2 ) POSITION DIST ;

: <=        ( n n -- ? ) 1- < ;  

: COINC     ( sp#1 sp#2 tol -- ? ) 2(X^2) >R SP.DIST  R> <= ; ( 0 = no coinc  )

: COINCXY   ( dx dy sp# tol -- ? )
            2(X^2) >R                   \ convert tolerance  to squares, push to rstack
            SP.DISTXY                   \ compute sprite dist from dx dy
            R> <= ;                     \ compare dist to tolerance

: COINCALL  ( -- ? ) VDPSTS C@ 20 AND ; \ bit set if any two sprites overlap

\ ===============================================================
\ channel 1 sound control lexicon (no interrupts used)
DECIMAL
: f(clk) ( -- d) 46324 1  ;   \ this is 111,860 as 32 bit int.

\ >FCODE re-arranges freq. value nibbles (4bits) for the TMS9919
HEX
: >FCODE   ( 0abc -- 0cab)    \ ASM would make this much faster
           DUP 0F AND SWAP      ( -- 000c 0abc)
           4 RSHIFT             ( -- 000c 00ab)
           SWAP ><  ( SWPB)     ( -- 00ab 0c00)
           + ;

: HZ>CODE  ( freq -- fcode )  f(clk) ROT UM/MOD NIP >FCODE 8000 OR  ;

\ [HZ] is macro that calcs 9919 chip frequency code at compile time
\  and then compiles it as a literal 16 bit number.
: [HZ] ( freq -- fcode ) S" HZ>CODE ] LITERAL" EVALUATE ;

\ sound channel #1 control words
: FREQ!    ( fcode -- ) SPLIT SND! SND! ;
: ]HZ      ( freq -- ) [HZ]  COMPILE FREQ! ;  \ pre-calculates fcode
: DB       ( n -- )    90 OR SND! ;
: MUTE     ( -- )      9F SND! ;

 HEX
: WAIT     ( n -- )      0 ?DO LOOP ;   \ 100us delay
: DECAY    ( speed -- )  10  0  DO  I DB  DUP WAIT  LOOP DROP  ;


\ ===============================================================
\ random number generation
HEX
83C0 CONSTANT SEED   \ RAM where TI has a number incrementing in main menu
1045 CONSTANT GEN#   \ GForth uses $10450405, we take the 1st 16 bits

: RNDW      ( -- n )   SEED @ GEN# UM* DROP 1+ DUP SEED ! ;
: RANDOMIZE ( n -- )   SEED ! ;
: RND       ( n -- n') RNDW ABS SWAP MOD ;


\ ===============================================================
\                 ***  PONG  BEGINS HERE ***
\         ==============================================
DECIMAL
: CLINK   ( -- ) [ 1650 ]HZ  0 DB  50 DECAY ;
: CLUNK   ( -- ) [ 1400 ]HZ  2 DB  50 DECAY ;

VARIABLE HUMAN              \ POINTS variables
VARIABLE COMPUTER

HEX
\ screen boundary patterns
0000 00FF FF00 0000 PATTERN: HLINE
1818 1818 1818 1818 PATTERN: VLINE
0000 001F 1F18 1818 PATTERN: ULEFT
0000 00F8 F818 1818 PATTERN: URIGHT
1818 18F8 F800 0000 PATTERN: LRIGHT
1818 181F 1F00 0000 PATTERN: LLEFT

3C7E FFFF FFFF 7E3C PATTERN: BALL
1818 1818 1818 1818 PATTERN: PADDLE

DECIMAL
: ModifyChars ( -- )
         HLINE    0 CHARDEF
         VLINE    1 CHARDEF
         ULEFT    2 CHARDEF
         URIGHT   3 CHARDEF
         LRIGHT   4 CHARDEF
         LLEFT    5 CHARDEF
         BALL   127 CHARDEF
         PADDLE 126 CHARDEF ;

: Boundary ( -- )
           0  1  2   1 HCHAR
           1  1  0  30 HCHAR
          31  1  3   1 HCHAR
           0  2  1  21 VCHAR
           1 23  0  30 HCHAR
          31  2  1  21 VCHAR
           0 23  5   1 HCHAR
          31 23  4   1 HCHAR ;

: MakeSprites ( -- )
   DELALL
 ( pat colr  x   y  sp# )
   127 16   128 96   0  SPRITE  \ Ball
   126 16     9 96   1  SPRITE  \ human paddle
   126 16   240 96   2  SPRITE  \ computer paddle
;

HEX
: ?KEY   ( -- c|0)  \ repeating key scanner
         0 83C8 !   \ clear previous scan codes
         0 (KEY?)   \ call KSCAN
         IF KVAL C@ \ read key value at >8375
         ELSE 0     \ else return zero
         THEN ;

: UpDown ( -- -3,0,3 ) \ return a value to move the paddle
         ?KEY
         [CHAR] E OVER = IF  -4 ELSE
         [CHAR] X OVER = IF   4 ELSE
                              0   ( default value)
         THEN THEN NIP ;

: CLIP    ( n min max -- n ) ROT MIN MAX ; \ clip n to within min & max

DECIMAL
 13 CONSTANT TOPWALL
177 CONSTANT BOTWALL

: MovePaddle ( paddle# -- )
           DUP >R SP.Y@ UpDown +  TOPWALL BOTWALL CLIP  R> SP.Y! ;

VARIABLE XVEC
VARIABLE YVEC

\ compute VDP address from col,row
: >VADDR    ( col row -- vdp_addr)  C/L@ * + ; 

: EraseLine ( col row cnt -- ) >R >VADDR R> BL VFILL ;

\ clear top line and place cursor at (0,0)
: Prompt  ( -- ) 0 0 2DUP 32 EraseLine   AT-XY ;

: WaitKey  ( char -- )  \ wait until key pressed = char on stack
           BEGIN
             BEGIN
               KEY?
             UNTIL
             KVAL C@ OVER =
           UNTIL 
           DROP ;

: MoveBall ( -- ) \ uses direct sprite X,Y read/write
           0 SP.X DUP VC@ ( -- Xaddr x) XVEC @ + SWAP VC!
           0 SP.Y DUP VC@ ( -- Yaddr y) YVEC @ + SWAP VC! ;

: BallSpeed ( Yvec Xvec -- )  XVEC !  YVEC ! ;

: PlaceBall ( Y X - ) 0 LOCATE ;

: NEGATE!  ( addr -- )  DUP @ NEGATE SWAP ! ;

: PaddleHit   ( spr# -- )
              XVEC NEGATE!
              0 SP.DIST 20 / -4 4 CLIP YVEC +!
              MoveBall CLINK ;

: WallBounce ( -- )   YVEC NEGATE!  MoveBall CLUNK ;

: TopWall ( sprY -- ) TOPWALL < IF  WallBounce THEN ;
: BotWall ( sprY -- ) BOTWALL > IF  WallBounce THEN ;
: WallTest  ( -- )    0 SP.Y@ DUP  TopWall BotWall ;

: FollowBall ( spr# -- ) \ match computer paddle to ball Y coordinate
             0 SP.Y@  SWAP  SP.Y! ;
             
: ScoreBoard ( -- )
    2 0 AT-XY ." Human      " HUMAN ?  ." | "  COMPUTER ? ."     TI-99" ;

: Opening ( -- )
         BEGIN
            MoveBall WallTest
            0 1 4 COINC IF 1 PaddleHit THEN 2 FollowBall
            0 2 4 COINC IF 2 PaddleHit THEN 1 FollowBall
            KEY?
          UNTIL ;

VARIABLE OFFSET 
: RandUpDown  ( -- -10 .. 10 )   50 RND 25 - ;

: ComputerPlayer ( -- )
         0 SP.Y@  RandUpDown +  TOPWALL BOTWALL CLIP 2 SP.Y! ;

: OffBoard? ( ballX -- ?) 1  253 WITHIN 0= ;

: PlayGame ( -- )
         BEGIN
            MoveBall 
            WallTest
            0 1 5 COINC IF 1 PaddleHit THEN
            1 MovePaddle
            0 2 5 COINC IF 2 PaddleHit THEN
            ComputerPlayer
            0 SP.X@ OffBoard?
         UNTIL
\ ball went OffBoard...
         XVEC @ 0>        \ positive direction means human played the ball
         IF   1 HUMAN +!
         ELSE 1 COMPUTER +!
         THEN HONK ;

: RandY ( -- n|-n) BEGIN  3 RND 1-  DUP 0 <> UNTIL ;

: RandX ( -- n )   RandY 3 * ;

: ServeBall ( -- )
         8 21 AT-XY  ." Press ENTER to serve"
         13 WaitKey
         8 21 20 EraseLine
         128 96 PlaceBall
          RandY RandX BallSpeed
          1000 RND MS 
          CLUNK ;         \ wait for it ...

: .WINNER ( -- )
         8 17 AT-XY
         HUMAN @ 5 =
         IF  ." Hey you won!"
         ELSE ." Sorry you lost :-(
         THEN ;

: EndGame? ( -- ? )
         8 19 AT-XY ." Play Again? (Y/N)"
         KEY [CHAR] N =  ( -- ?)
         8 19 22 EraseLine
         8 17 22 EraseLine ;

: Winner? ( -- ?)
          HUMAN @ 5 =
          COMPUTER @ 5 = 
          OR ;      \ if either play get to 5 they win

: RUN    GRAPHICS
         ModifyChars
         2 SCREEN
         0 16  16 1 COLORS
         Boundary  MakeSprites
         1 -3 BallSpeed
         200 96 PlaceBall
         Prompt ."   PONG! Press any key to begin"
         Opening
         Prompt
         BEGIN  ( play the game )
            HUMAN OFF   COMPUTER OFF
            ScoreBoard
            BEGIN
              ServeBall
              PlayGame
              ScoreBoard
              Winner?
            UNTIL
           .WINNER
            EndGame?
         UNTIL
         GRAPHICS ;

 

 

Edited January 4, 2018 by TheBF

[+Lee Stewart]

This thread is a good idea!

 

Sorry, I have not been very responsive lately. First it was getting settled down here in FL, then the holiday season with a week of some of the kids and grandkids, then a week of friends staying with us and now I am a bit under the weather with some bug or other and not much energy. Of course, the beach and horseshoes got in the way a lot! I haven’t even updated the fbForth thread or my website in quite a while—needed too large a block of time. That is my excuse and I am sticking to it.

 

Anyway, I need to download Camel99 Forth to test PONG and then, of course, see about porting it to you-know-what.

 

...lee

[+TheBF]

I actually think of you when I concoct these programs.

 

This one has one text macro in it that could be replaced for FigForth.

I have grown fond of these things in ANS Forth because they put the low level code into your definitions directly but you can use a high level name.

No COMPILE [COMPILE] POSTPONE confusion.

: [HZ] ( freq -- fcode ) S" HZ>CODE ] LITERAL" EVALUATE ;

\ I think it could be this in FigForth (untested)
: [HZ] ( freq -- fcode ) 
       COMPILE HZ>CODE  
       COMPILE ] 
       [COMPILE] LITERAL ; IMMEDIATE 

[+Lee Stewart]

 

I actually think of you when I concoct these programs.

 

This one has one text macro in it that could be replaced for FigForth.

I have grown fond of these things in ANS Forth because they put the low level code into your definitions directly but you can use a high level name.

No COMPILE [COMPILE] POSTPONE confusion.

: [HZ] ( freq -- fcode ) S" HZ>CODE ] LITERAL" EVALUATE ;

\ I think it could be this in FigForth (untested)
: [HZ] ( freq -- fcode ) 
       COMPILE HZ>CODE  
       COMPILE ] 
       [COMPILE] LITERAL ; IMMEDIATE 

 

My head always hurts when I work with COMPILE ! I always have to test that sort of code extensively until it works and I actually understand it. That figForth code won’t work! Declaring it immediate will cause LITERAL to execute during the definition of ]HZ , but you want it to execute while defining words that use ]HZ after they have been temporarily set to execution mode by [ . This definition appears to work:

: [HZ] ( freq -- fcode ) 
       HZ>CODE  
       [COMPILE] ] 
       [COMPILE] LITERAL ; 

I may eventually implement EVALUATE for fbForth, but I would need to define a different string word that would append a couple of nulls and not leave a character count on the stack. The spoiler below is for those craving an explanation.

 

fbForth’s INTERPRET does not use a character count and does not know how to terminate its infinite loop—that is the job of a word whose name is an ASCII 0. When INTERPRET finds a null as the next word in the input stream, it looks it up in the dictionary, finds it as a legitimate word and executes it. That null-named word is the only way to exit from the infinite loop in INTERPRET and it does so by adjusting the return stack to return one level higher than the next word within INTERPRET , which happens to be the word following INTERPRET .

 

 

...lee

[+TheBF]

 

My head always hurts when I work with COMPILE ! I always have to test that sort of code extensively until it works and I actually understand it. That figForth code won’t work! Declaring it immediate will cause LITERAL to execute during the definition of ]HZ , but you want it to execute while defining words that use ]HZ after they have been temporarily set to execution mode by [ . This definition appears to work:

: [HZ] ( freq -- fcode ) 
       HZ>CODE  
       [COMPILE] ] 
       [COMPILE] LITERAL ; 

I may eventually implement EVALUATE for fbForth, but I would need to define a different string word that would append a couple of nulls and not leave a character count on the stack. The spoiler below is for those craving an explanation.

 

fbForth’s INTERPRET does not use a character count and does not know how to terminate its infinite loop—that is the job of a word whose name is an ASCII 0. When INTERPRET finds a null as the next word in the input stream, it looks it up in the dictionary, finds it as a legitimate word and executes it. That null-named word is the only way to exit from the infinite loop in INTERPRET and it does so by adjusting the return stack to return one level higher than the next word within INTERPRET , which happens to be the word following INTERPRET .

 

 

...lee

 

 

Wow. I learned something. I am so long away from FigForth and I never did know about the ASCII 0 thing.

I think the ANS group did a few good things for Forth. The interpreter mechanism might be one.

 

I bet you are happy to be in Florida right now. Up here it was -4 F overnight and it came up above 0 F in the day time!

Woohoo! Its heat wave.

 

And we got 9..10 " of snow and it's still coming down :-)

 

But the east coast of the US is way worse than the Detroit/Toronto corridor.

[+TheBF]

Adding 80 Columns to Camel99 Forth

 

Finally got around to adding this functionality for the F18A.

 

Thanks to Willsy for the register data.

 

You can only toggle between 40 column and 80 column after this code is loaded.

GRAPHICS will just give you a warning.

 

Added the simple word TINT so you can change text and screen color.

(uses machine values for colors to keep it simply)

\ 80 column mode for F18A video card (tested on Classic99)
\ Register DATA taken from Turbo Forth by Mark Wills
( default colors changed to green on black screen)

HEX
CREATE 40COL
       00 C, F0 C, 00 C, 0E C, 01 C, 06 C, 02 C, 20 C,

CREATE 80COL
       04 C, 70 C, 03 C, E8 C, 01 C, 06 C, 00 C, 20 C,
       88 C, 00 C, 00 C, 00 C, 94 C, 10 C, 00 C,

: VREGS  ( addr n -- )  0 DO  DUP I + C@  I VWTR  LOOP DROP ;

DECIMAL
: 80COLS ( -- )   80COL 15 VREGS  80 C/L!  PAGE  80 VMODE ! ;

\ we have to over-write the old versions to handle 80cols
: TEXT    ( -- ) 40COL   8 VREGS  TEXT  ;
: COLD    ( -- ) TEXT  COLD ;
: TINT    ( fg bg -- ) SWAP 4 LSHIFT +  7 VWTR ;

: GRAPHICS ( -- ) -1 ABORT" Needs restart" ;

[+TheBF]

*New and Improved* 80 Columns to Camel99 Forth

 

It didn't sit well with me that I could not change screen modes freely.

After I played around I found out that if I reset to TEXT mode, I could jump to a 80cols or GRAPHICS

mode with no problem. It takes just a few milli-seconds longer but you can jump from 80cols

to GRAPHICS and back. Classic99 does not seem to be able to record the 80COLS screens

so you will have to load this code yourself for proof that it works.

 

Here is the new code: -EDIT- Added count bytes to the data strings which saves a few bytes in the definitions

\ 80 column mode for F18A video card (tested on Classic99)
\ Register DATA taken from Turbo Forth by Mark Wills
( default colors changed to green on black screen)

HEX
CREATE 40COL
       08 C, 00 C, F0 C, 00 C, 0E C, 01 C, 06 C, 02 C, 20 C,

CREATE 80COL
       15 C, 04 C, 70 C, 03 C, E8 C, 01 C, 06 C, 00 C, 
       20 C, 88 C, 00 C, 00 C, 00 C, 94 C, 10 C, 00 C,

: VREGS    ( addr n -- ) 0 DO  DUP I + C@  I VWTR  LOOP DROP ;

DECIMAL
\ we have to over-write the old versions to handle 80cols
: TEXT     ( -- ) 40COL COUNT VREGS  TEXT  ;
: COLD     ( -- ) TEXT  COLD ;
: TINT     ( fg bg -- ) SWAP 4 LSHIFT +  7 VWTR ;

: 80COLS   ( -- ) TEXT 80COL COUNT VREGS  80 C/L!  PAGE  80 VMODE ! ;
: GRAPHICS ( -- ) TEXT GRAPHICS ;

Edited January 25, 2018 by TheBF

[+TheBF]

Adding Elapsed Time Timer

 

When you are trying to find out if one way to code something is faster than another method this little tool is soooo handy.

 

The code uses the fact that the TI-99 is running a countdown timer for the screen timeout at address >83D6.

Each tick of this timer is .008333 seconds so it will run for about 9 minutes. That is the maximum time we can measure with this method.

 

The first time I saw this word ELAPSE was in FPC Forth by Tom Zimmer. I have moved it to other Forth systems since then.

 

The video shows ELAPSE in action.

\ ELAPSE.FTH  elapsed time measurment words
\ Thanks to Tom Zimmer for the good ideas in FPC circa 1990
\ Ported to HsForth 08MAR91  Brian Fox Canada

\ Ported to CAMEL99 Nov 29 2017
\ Good for 9 minutes maximum duration

\ *** YOU CANNOT CALL KSCAN WHILE TIMING ***

HEX
83D6 CONSTANT TICKER   \ screen timeout counter increments by 2 /16mS

DECIMAL
: ##      ( n -- )  0 <#  # #  #> TYPE ;

: .MINS   ( h S M  -- )
          BASE @ >R   
          DECIMAL  ## [CHAR] : EMIT  ##  [CHAR] . EMIT ##
          R> BASE ! ;

\ 1 TICK = .008333 mS
: REALTIME ( -- n )  TICKER @  5 6  */ ;  \ changed to 5/6 ratio from input by Lee Stewart. Better now

: >TIME  ( n -- .hh secs mins  )  \ convert n to time
          6000 /MOD   ( -- rem mins) >R  \ push minutes
          100  /MOD   ( -- ms secs)      \ calculate seconds & hundredths
          R> ;                           \ pop minutes

: .ELAPSED ( -- ) CR ." Elapsed time ="  REALTIME >TIME .MINS ;

: ELAPSE  ( -- <forth words> )
           1 PARSE   \ BF edit to allow timing a line of code
           TICKER OFF
           EVALUATE
          .ELAPSED ;

ELAPSEDEMO.mp4

Edited January 15, 2018 by TheBF

[+Lee Stewart]

I don’t know if the accuracy of the result is really improved due to truncation, but the following definition of REALTIME uses 0.833... as the multiplier, exactly:

: REALTIME ( -- n )  TICKER @  5 6 */ ; 

...lee

[+TheBF]

Well done.

 

Yes it does make a difference. I ran this code on FB-Forth and CAMEL99 and they go out of sync pretty quickly.

: TEST ( start end -- )
  SWAP 
  DO
     CR  I U.  SPACE  I  5 6 */ U.  SPACE  I 83 100 */  U.
  LOOP ;
  

Thanks. I will fix it in the original post.

 

 

B

[+TheBF]

I don’t know if the accuracy of the result is really improved due to truncation, but the following definition of REALTIME uses 0.833... as the multiplier, exactly:

: REALTIME ( -- n )  TICKER @  5 6 */ ; 

...lee

 

Looking at it again I saw another bug for ANS Forth only.

: ELAPSE  ( -- <forth words> )
           1 PARSE
           TICKER OFF
           EVALUATE
          .ELAPSED ;

I had used BL PARSE, which of course parsed a space delimited word in the input.

1 PARSE will never find a delimiter and so will take in an entire line of text.

 

You help me find bugs without even looking at them.

 

You're a wizard.

 

B

[+Lee Stewart]

...

You help me find bugs without even looking at them.

 

You're a wizard.

 

B

 

Hah!

 

...lee

[+Lee Stewart]

Here it is ported to fbForth 2.0:

 

 

 

\ ELAPSE.FTH  elapsed time measurment words
\ Thanks to Tom Zimmer for the good ideas in FPC circa 1990
\ Ported to HsForth 08MAR91  Brian Fox Canada

\ Ported to CAMEL99 Nov 29 2017
\ Good for 9 minutes maximum duration

\ Ported to fbForth 2.0 by Lee Stewart 15JAN2018

\ *** YOUR CODE CANNOT CALL KSCAN WHILE TIMING ***

HEX
83D6 CONSTANT TICKER   \ screen timeout counter increments by 2 /16mS
: OFF  ( addr -- )      \ store 0 in addr
   0 SWAP !  ;

DECIMAL
: ##      ( n -- )  0 <#  # #  #> TYPE ;

: .MINS   ( h S M  -- )
   BASE->R   
   DECIMAL  ## ASCII : EMIT  ##  ASCII . EMIT ##
   R->BASE ;

\ 1 TICK = 8.333 ms
: REALTIME ( -- n )  TICKER @  5 6 */ ;

: >TIME  ( n -- .hh secs mins  )    \ convert n to time
   6000 /MOD   ( -- rem mins) >R    \ push minutes
   100  /MOD   ( -- ms secs)        \ calculate seconds & hundredths
   R> ;                           \ pop minutes

: .ELAPSED ( -- ) CR ." Elapsed time = "  REALTIME >TIME .MINS ;

\ Below, "IS:" is "Input Stream:"
: ELAPSE  ( -- ) ( IS:<Forth words> )
   TICKER OFF
   INTERPRET
   .ELAPSED  ;

 

 

 

I had to define OFF and make changes in .MINS and ELAPSE . Two changes I made in .MINS were gratuitous ( BASE->R and R->BASE ).

 

...lee

[+TheBF]

Cool!

 

It's much handier than using a stop-watch.

[+TheBF]

Latest additions to CAMEL99 Forth on GitHub:

 

Just in case anybody cares...

https://github.com/bfox9900/CAMEL99

 

To /DEMO added:

PONG.FTH simple PONG game
QUICKSORT.FTH recursive quicksort integer demo. (about 2..3X faster than COMBSORT)
DUTCHFLAG7.FTH on screen combsort demo with multiple inputs

To /LIB added:

80COL.FTH for F18A hardware or emulators that support it
ASM9900.FTH TMS9900 RPN assembler that loads above the dictionary
ATTYPE.FTH 10X faster type to screen location with error checking
BOOLEAN.FTH to create BIT arrays. Slower but space efficient.
DATABYTE.FTH changed to be more like TI-Assembler syntax
DEFER99.FTH Forth 2012 deferred words and support words
FASTCASE.FTH creates VECTOR tables easily. (Like "ON GOSUB" for BASIC programmers)
MARKER.FTH ANS Forth MARKER word.
UDOTR.FTH print un-signed right justified numbers
VALUES.FTH create ANS Forth VALUE type

TINYHEAP.FTH fixes to ANS Forth ALLOCATE implementation in TI Low-mem

Edited January 26, 2018 by TheBF

[+TheBF]

The most minimal memory manager.

 

Many times when you are coding you need some memory to hold temporary data.

ANS Forth provides a rather complex memory manager that is a linked list of memory blocks.

It is really inappropriate for a little machine like the TI-99.

 

I had a simple revelation today to manage a memory block for temp storage for people playing with Forth.

 

I have always had a variable called H that points to the LOW MEMORY in the expansion card.

Here is all I need to do make use of that memory in the simplest way.

\ minimalist HEAP memory manager
VARIABLE H   HEX 2100 H !  \ set H to your heap memory block 

: MALLOC      ( n -- addr ) H @  SWAP H +! ;  \ allocate heap and return pointer
: FREE       ( n -- ) NEGATE H +! ;           \ free heap memory

If you type 64 MALLOC you get a pointer (address) of a memory block.

 

Then when you are done with it you type 64 FREE and it goes back to the pool of memory.

 

It is VERY simplistic. But many times that is all I need.

​

Edited January 28, 2018 by TheBF

[Willsy]

It's nice and simple for perhaps a little bit too simplistic.

 

I'd like to be able to reserve memory areas A, B, C & D (they may or may not be of different sizes). Then, perhaps I want to free memory area B, such that the next MALLOC will use that free area, providing that it is large enough to accommodate the amount of memory being requested.

 

I think I know how to do it, I've just not been very motivated lately when it comes to programming. I'm a bit burnt out

 

On the plus side, I'm finally getting to grips with Open E major slide-blues on my strat, so things are looking up!

[+TheBF]

It is very simple. It's just managing another memory space the same way as the dictionary.

Doing a re-sizeable memory manager will mean you need to garbage collect at some point.

Since most Forth projects do static memory allocation this still gives more more than that with

out the complexity . :-)

 

I did it for a screen scroll mechanism where I just wanted a buffer at the beginning of the routine

and then destroy it when I was done. So I didn't even need to give it a name.

Just the put the address on the stack, thank you.

 

This routine was only about 12% slower than copying the entire screen to a big buffer with CODE and writing it back.

I was surprised. The reason I did it was because in 80 column mode that buffer became 1920 bytes! :-)

 

Notes;

I had a change of heart on 'FREE' and changed it to MFREE to avoid conflict with the ANS name.

C/L@ is fast variable as you call them, created manually. (chars per line)

: SCROLL      ( -- )
              C/L@ MALLOC ( -- heap)          \ allocate heap for 1 line
              L/SCR 1                         \ loops from 1 to 24
              DO
                 PAUSE
                 I  C/L@ * OVER     ( -- VDPaddr heap)
                 2DUP          C/L@  VREAD    \ read line to heap
                 SWAP C/L@ -   C/L@  VWRITE   \ write HEAP to line above
              LOOP
              0 17 AT-XY  VPOS C/L@ BL VFILL  \ place cursr & clear last line
              DROP                            \ drop heap pointer
              C/L@ MFREE ;                    \ de-allocate heap memory

Open tunings are fun. I went through brief periods playing with a couple.

Always ended up back home.

 

This reminds me... my son borrowed my Strat a year ago and I haven't got it back yet.

[+TheBF]

Background Sound List Player

 

​​I finally got around to finishing a sound list player that does not use interrupts. ​I always wondered how the cooperative task system would work with music ​which is hard real-time. This one seems to work ok. I am sure you could ​drag it down if you had a lot of unfriendly tasks running, but with the console ​and a little task that incremented a variable continuously it seemed very happy. Each string of a sound list is played without interruption so the delays will always be at the end of string which may be why it sounds ok.

 

​A very nice feature is the sound-list FiFO (1st in /1st out) queue that feeds the player. ​This lets you "Q" up as many as 16 sound lists and they kick them off.

Another nice thing is that as soon as the Q is empty the TASK goes to sleep so it takes very little servicing from the main program (3 ALC instructions)

 

​You can paste this code into CAMEL99 V1.99 located here:

 

https://github.com/bfox9900/CAMEL99/tree/master/bin

​

I would not trust it to work with older versions of the system.

(As usual I found a bug in an "improvement" I made to the "MS" time delay word and reverted back to a previous version

Such a humbling activity)

 

I have update the way I make sound lists so they are very close to assembler now. The only difference is there is no '>' in front of numbers so you would have to search and replace that character from any other lists you would like to try. There are also a few other examples in the SOUNDS folder on GITHUB.

 

Edit: to have more fun I made the Queue 32 cells long. It works better

​You can run this code:

: QALL   MUNCHMAN >Q  PACMAN >Q
         SMACK >Q  SMACK >Q
         SHPSND >Q 
         FIRE >Q FIRE2 >Q EXPLODE >Q
         CHIME >Q  SW1SND >Q    
         SW2SND >Q
         SND123 >Q  SND4 >Q
         FUEL >Q  ;

BGPLAY  \ it plays all the sounds

 

 

\ BACKGROUND TI sound list player in CAMEL99 Forth

\ 1. This player uses a final '0' to mark the end of the sound data
\ 2. It turns off all sounds when the data is ended
\ 3. Uses the TMS9901 timer to control sound duration
\ 4. It can Queue up to 16 sound lists to play
\ 5. Player goes to sleep when sound Queue is empty
\ 6. Only two end user commands:  >Q  BGPLAY

\ MARKER BGSOUND
\ ========================================================
\ sound list player
HEX
: >MS    ( n -- n')  4 LSHIFT ;  \ n*16, converts ISR delay value to milliseconds

: NEXTSND  ( snd$ -- snd$' ) COUNT + 1+ ; \ next_string = startaddr+length+1

: SILENT ( --)  9F SND!  BF SND!  DF SND! FF SND! ;  \ turn off all sounds

: PLAY$ ( sound_string -- ) \ play 1 sound string
       COUNT               \ -- addr len
       2DUP + C@  >MS >R   \ get duration at end of string, to milli-secs & Rpush
       BOUNDS              \ convert addr/len to end-addr. start-addr.
       DO  I C@ SND! LOOP  \ feed bytes to sound chip
       R> MS ;             \ use the delay from Rstack

: PLAYLIST   ( addr -- )    \ play a TI sound list
         BEGIN  DUP C@
         WHILE              \ while the length is not 0
            PAUSE
            DUP PLAY$       \ play a single string
            NEXTSND         \ advance to the next sound string
         REPEAT
         SILENT
         DROP ;             \ mom said always clean up after yourself
\ ========================================================
HEX
\ create a 32 cell fifo to feed the sound player
VARIABLE SHEAD
VARIABLE STAIL

CREATE SOUNDQ   20 CELLS ALLOT
\ circular Q access words
: Q+!    ( fifo -- n) DUP @ 2+ 1F AND DUP ROT ! ;
: Q@     ( fifo -- n) STAIL Q+! + @ ;      \ bump tail and fetch data
: Q!     ( n fifo --) SHEAD Q+! + ! ;      \ bump head and add to FIFO
: Q?     ( fifo -- ?) SHEAD @ STAIL @ <> ; \ is data ready?

\ BackgroundPlayer
: BGPLAYER ( -- )   \ play all lists in the Q then goto sleep
           BEGIN 
           Q? WHILE
             SOUNDQ Q@ PLAYLIST
           REPEAT
           MYSELF SLEEP
           PAUSE ;      \ hand-off to next task


\ === MULTI-TASKING SET-UP ===
INIT-MULTI

CREATE TASK1  USIZE ALLOT  ( task in dictionary space)
TASK1 FORK
' BGPLAYER TASK1 ASSIGN

 : RESTART ( pid -- )
           DUP DUP JOB LOCAL  SWAP 'IP LOCAL !  \ JOB->local IP register
           WAKE ;                               \ pid wake

\ ===============================================
\ end user commands
\ Usage:  MUNCHMAN >Q  PACMAN >Q  BGPLAY

: >Q      ( list -- ) SOUNDQ Q! ;
: BGPLAY  ( addr -- ) TASK1 RESTART ;

\ ===============================================
\ sound list examples
: BYTE ( -- )
         BEGIN  [CHAR] , PARSE-NAME DUP
         WHILE
            EVALUATE  DUP FF00 AND  ABORT" Not a byte"
            C,
         REPEAT
         2DROP ;

: /END   0 C,  ALIGN  ;   \ compile zero, force even memory boundary

HEX
CREATE MUNCHMAN
       BYTE 08,85,2A,90,A6,08,B0,CC,1F,12
       BYTE 08,85,2A,90,A4,1C,B0,C9,0A,12
/END

CREATE PACMAN
       BYTE 06,86,0D,97,AC,1A,B7,08
       BYTE 02,8F,08,02
       BYTE 02,AB,23,05
       BYTE 02,86,0D,04
       BYTE 01,BF,03
       BYTE 02,8E,0B,08
       BYTE 02,8A,0A,02
       BYTE 03,AC,1A,B7,08
/END

 

 

Edited January 30, 2018 by TheBF

[+TheBF]

Background Sound List Player *UPDATE*

 

​While putting this thing through repeated tests I found out that my RESTART command was leaving the address of the program on the return stack.

 

​That created some very "interesting" sounds indeed when the return stack over-flowed!

 

​So RESTART now cleans that up.

 

​You will also see that just because I could, the MEMORY for TASK1 in the new version was created with MALLOC. This allocates memory in LOW-MEM.

​I just wanted to see it work but it is very handy in a memory constrained machine to have the extra space for misc blocks of memory.

 

​Also realized that if my Hardware timer has a 1/60 of a second interval it would simplify working with TI-99 stuff that assumes an interrupt happened.

​I called this unit of time a "jiff' as in it happens in a jiffy.

​This also works better with the cooperative tasker because in 1/60 of a second it can service 4 or 5 simple tasks before the hardware timer expires.

​This means that while some task is running the JIFFY timer, the cooperative tasks are still running smoothly.

 

​All these changes and a new Binary version are on GitHub now.

 

https://github.com/bfox9900/CAMEL99

Edited January 31, 2018 by TheBF

[+TheBF]

TUTORAL: Sound Lists in VDP RAM

 

So with all this infra-structure created to play sound lists It becomes clear that good sound lists take up memory.

In CAMEL99 Forth running in Expansion RAM, memory is at a premium. But there are kilo-bytes free to use in VDP RAM. So what does it take to play sound lists from VDP memory?

 

The following code makes that happen by new making primitive routines that work in VDP RAM while keeping the same structure for the hi-level routines that do the work.

 

ALL references to C@ (char fetch) are replaced with VC@ ( VDP char fetch)

which fetches bytes from VDP RAM. (these are both ASM words)

Also we create a set of VDP memory manager words that ultimately let us make VCREATE.

 

VCREATE puts a name in Forth dictionary and is really just a CONSTANT. The CONSTANT returns the VDP address that is next in line to use when we VCREATE the new name. Simple.

 

We also replicate the Forth word COUNT as VCOUNT which converts a counted string in memory

(a string with the first byte holding the length of the string ) into a memory address and length

on the Forth data stack. All this of course now must be done from VDP RAM.

 

We make the appropriate replacements in VPLAY$ and VPLAYLIST and we're done.

The player has a different name because it won't work on sound lists in EXPANSION Ram.

(It's possible to used vectored operations (DEFER) to make the player work from either but that's an exercise for somebody ambitious)

 

Next the code makes a BYTE string compiler and with that completed we can compile sound lists into VDP ram.

 

---

Porting Information:

I made use of EVALUATE for the VBYTE routine which is an ANS Forth thing.

If you port this code to FB-Forth or TURBO Forth you could at minimum just replace the commas in the lists

with VC, and let Forth drop each byte into VDP RAM this way:

 

VCREATE SNDLIST1 02 VC, 45 VC, 03 VC, 10 VC,

 

HEX

: SND! 8400 C! ; ( you need this little word)

 

You will also make a little delay word to replace JIFFS.

 

And FB-Forth VARIABLE needs a leading number:

 

HEX 1000 VARIABLE VP

---

 

So if you want to play sound lists and save Expansion memory this will do it.

 

 

 

\ TI sound list player using VDP RAM        CAMEL99 Forth V1.99
\ ========================================================
\ vdp memory manager words
VARIABLE VP

HEX 1000 VP !   \ start of free VDP RAM

: VHERE   ( -- addr) VP @ ;   \ FETCH the value in VDP pointer
: VALLOT  ( n -- )   VP +! ;  \ add n to the value in VDP pointer
: VC,     ( n -- )   VHERE VC!  1 VALLOT ;
: VCOUNT  ( vdp$adr -- vdpadr len ) DUP 1+ SWAP VC@ ; \ convert counted string to addr,len
: VCREATE ( <text> -- addr) VHERE CONSTANT ;

\ ========================================================
\ sound list player
HEX
: SILENT ( --)  9F SND!  BF SND!  DF SND! FF SND! ;  \ turn off all sounds

: VPLAY$ ( sound_string -- ) \ play 1 sound string from VDP memory
       VCOUNT                \ -- addr len
       2DUP + VC@  >R        \ get duration at end of string, Rpush
       BOUNDS                \ convert addr/len to end-addr. start-addr.
       DO  I VC@ SND! LOOP   \ feed bytes to sound chip
       R> JIFFS ;            \ use the delay from Rstack (JIFF=1/60)

: VPLAYLIST   ( addr -- )    \ play a TI sound list
         BEGIN DUP VC@ WHILE \ while the length is not 0
            PAUSE            \ give somebody else some time
            DUP VPLAY$       \ play a single string
            VCOUNT + 1+      \ advance to the next sound string
         REPEAT
         SILENT
         DROP ;
\ ========================================================
\ VDP byte string compiler
: ?BYTE ( n -- ) FF00 AND  ABORT" Not a byte" ;

: VBYTE ( -- )
         BEGIN  [CHAR] , PARSE-NAME DUP
         WHILE
            EVALUATE DUP ?BYTE
            VC,
         REPEAT
         2DROP ;

: /END   0 VC, 0 VC, ;   \ end the list with 2 bytes

\ ========================================================
\ VDP sound lists
HEX
VCREATE MUNCHMAN
       VBYTE 08,85,2A,90,A6,08,B0,CC,1F,12
       VBYTE 08,85,2A,90,A4,1C,B0,C9,0A,12
/END

VCREATE PACMAN
       VBYTE 06,86,0D,97,AC,1A,B7,08
       VBYTE 02,8F,08,02
       VBYTE 02,AB,23,05
       VBYTE 02,86,0D,04
       VBYTE 01,BF,03
       VBYTE 02,8E,0B,08
       VBYTE 02,8A,0A,02
       VBYTE 03,AC,1A,B7,08
/END

VCREATE NOKIA
       VBYTE 01,9F,20
       VBYTE 03,90,85,05,09
       VBYTE 02,8F,05,09
       VBYTE 02,87,09,12
       VBYTE 02,87,08,12
       VBYTE 02,85,06,09
       VBYTE 02,81,07,09
       VBYTE 02,8E,0B,12
       VBYTE 02,8A,0A,12
       VBYTE 02,81,07,09
       VBYTE 02,8F,07,09
       VBYTE 02,8A,0C,12
       VBYTE 02,8A,0A,12
       VBYTE 02,8F,07,24
       VBYTE 01,9F,00
/END

 

 

Edited February 1, 2018 by TheBF

[+TheBF]

Extending Forth to Make the SAMS Card Easy to use for DATA

 

I read in another thread that some people feel the SAMS card was a pain in the backside, so I thought I would see what I could do using Forth to try and tame the beast.

 

I translated the >MAP word in TurboForth from ALC to Forth using the CRU words that I re-worked from TI-Forth.

\ CRU words in CAMEL99 Forth
CRU!   sets the CRU base address
SBO    sets the current base address bit 0 to one
SBZ    sets the current base address bit 0 to zero.

With those I could create 'MAP'. Of course the ALC version is much faster but I wanted to replicate it in Forth.

\ Forth translation of >MAP in TurboForth
: MAP  ( bank addr -- ) \ ASM converted to Forth
         F000 AND  0B RSHIFT 4000 + \ Compute SAMS register to use
         SWAP 00FF AND  DUP >< OR   \ Hi & lo bytes are now identical
         SWAP ( -- bank address)
         1E00 CRU! SBO              \ enable SAMS card
         !                          \ store bank in SAMS register
         SBZ ;                      \ disable SAMS card. (CRU not changed)

This is a nice word that Willsy created to let you "map any SAMS block of memory into a 4K space in the expansion RAM.

 

Now reading and writing 1Mbyte of memory means that you need 20bit addresses. This reminded me of the original IBM PC.

The 8086 CPU was a 16 bit machine but you could access extra memory by reading many 64K segments. When the 8086 working with this extended memory it as called a "long address" and it took 2 16 bit registers to hold a long address.

 

The common way the Forth interacted with that memory system was to create a "long address" fetch operator and store operator. They were called '@L' and '!L' respectively.

 

So for a first attempt this is what I intended to do.

 

The first word created was >BANK. This word takes a 32bit address (2 16bit no.s on the stack) and computes the MAPPED address. It makes use of a nice "mixed" number function call "unsigned-mixed-slash-mod" or UM/MOD.

 

(Note: This Forth operation is just the 9900 DIV instruction! Nice CPU )

 

This standard Forth word takes a 32 bit number and divides it by a 16 bit number giving you the dividend and the remainder.

So if we divide a 32 bit address by "bytes-per-bank" (B/BANK) or 4096 (>1000) we automatically get the bank# to use and the remainder gives us the offset to use in the 4K block. How easy is that.

 

Example: HEX 2F0BB 1000 UM/MOD

Will return: BB 2F

 

Note: 2F0BB is shown as an example. CAMEL99 Forth must split 32 bit numbers into 2 stack items.

In FB-Forth and many other Forth systems adding a '.' to the end (2F0BB. ) will do this automatically for you.

 

Where 2F is the bank# to use and BB is the OFFSET address in expansion RAM where we mapped the SAMS card.

 

I added an offset to the bank# of >10 (1stbank) so that we don't play with the lowest 64K. I got strange results with trying to use the lower 64K.

 

Because mapping the block with Forth is a slower than ASM code >BANK also checks to see if we are using the called for bank already. If not, it records the new bank# in the variable BANK# (what else would you call it?) and then does the MAP into >2000 low expansion RAM.

(MBLOCK is CONSTANT = >2000)

 

If we are already using that bank# >BANK just drops the number.

Then... it has to OR >2000 with the remainder so that the mapped address is correctly shown inside the 4K memory block that starts at >2000

     VARIABLE BANK#      \ current mapped bank
  10 CONSTANT 1STBANK    \ we don't use the lower 64K
1000 CONSTANT B/BANK     \ bytes per bank = 4K
2000 CONSTANT MBLOCK     \ mapped memory block used is >2000

: >BANK  ( 32bit -- addr)           \ must have 32bit address!!
         B/BANK UM/MOD  1STBANK +   \ -- 'addr bank#+1STBANK
         BANK# @ OVER <>            \ do we need to change banks?
         IF   DUP BANK# !           \ update bank#
              MBLOCK MAP            \ map in the SAMS block

         ELSE DROP                  \ not needed. Drop the bank#

         THEN MBLOCK OR             \ return the address in mapped block
;

So now to read and write SAMS memory from bank >10 to bank >FF (948K bytes) is just this easy.

\ FINAL API:  direct access to 900K memory space
: @L     ( 32addr -- n)  >BANK @ ;    \ fetch an int
: !L     ( n 32addr -- ) >BANK ! ;    \ store an int

: C@L    ( 32addr -- char) >BANK C@ ;   \ fetch a byte
: C!L    ( char 32addr --) >BANK C! ;   \ store a byte

Since the 32bit address is translated into regular memory by >BANK, we read and write integers with '@' and '!' (fetch and store) just like normal Forth.

And of course we read and write bytes with 'C@' and 'C!' .

 

Next I will try and create data structures in SAMS memory.

 

Using the Forth method of extending the language has made using the banked memory pretty simple for basic stuff.

 

>BF

Edited February 15, 2018 by TheBF

[+Lee Stewart]

If I were to port this to fbForth 2.0, I could not use your representation of 32-bit numbers. Entering “2F0BB” would lop off the ‘2’ because, without help, only 16-bit numbers are accepted. By “help” I mean an embedded ‘.’ anywhere in the number. Entering “2F0BB.” would do the trick. Of course, I could also enter that number as two 16-bit halves: F0BB 2 (the MSW must be most accessible on the stack).

 

Before I discuss SAMS memory handling in fbForth 2.0, I think I need to revisit my own explanation in my manual under >MAP and also write some words that actually use it to be sure I actually understand it. I should probably do this before I release fbForth 2.0:11.

 

...lee

[+TheBF]

I mis-lead the reader a little in an attempt to simplify the explanation on the slim chance that an Assembly language programmer looked at this for some ideas. (optimist )

 

Yes 2F0BB should have a trailing '.' to be a double in most Forths. Camel Forth is a minimal system and does not even have support for doubles in the interpreter. That's also on my "to do" list.

 

However the next post will have some tricks to create data structures in SAMS memory and removes the need to manage the 32 bit addresses manually.

 

Standby...

[+TheBF]

Making DATA Structures in SAMS

 

So managing 32 bit pointers in a 16 bit environment is a pain in the butt. Do we really have to do it that way?

 

The SAMS memory is mapped into our local 16 bit space so we can reach it with 16 bit operations no problem. In this next example, we manage the entire SAMS space the same way as the Forth compiler manages its dictionary. The difference is we need to use a 32 bit pointer to keep track of what we allocated rather than a 16 bit pointer. The mapper does the rest.

 

CAMEL99 does not have 32 bit variables but we can make one by combining some primitives operations. (Other Forths may have the word 2VARIABLE for doubles)

EDIT: correction to D,
: D,     ( d -- )   \ compile a 32bit DOUBLE into dictionary
         SWAP , ,  ;   \ change order and compile each single
          
\ create 32bit variable and initialize to zero
CREATE SAMS    0 0 D,

Next we make a word like HERE in Forth that returns the next available memory space except the new word will track SAMS. Let's call it SHERE. All it has to do is fetch the 32bit value in the SAMS variable.

 

And with that we need a way to bump the SAMS variable whenever we want to allocate more SAMS memory. We call that SALLOT. SALLOT uses a nice word called M+ which can take a 32 bit number and add it to a 16 bit number, giving us a 32bit result. Because we use M+ the maximum size we can allocate at one time is 64K (>FFFF).

\ == simple memory manager ==
\ return the 32bit pointer to next available SAMS memory location
: SHERE   ( -- d)  SAMS 2@ ;

\ allocate n bytes in the SAMS memory space (max 64K)
: SALLOT  ( n -- ) SHERE ROT M+ SAMS 2! ;

With these simple tools we can use CREATE DOES> to make some data types.

Here is an integer.

: SAMS-INT: (  -- <text>)
\ compile time action:
           CREATE           \ create a word in dictionary
              SHERE D,      \ compile the 32bit SAMS location into the word
              2 SALLOT      \ allot 2 bytes of SAMS space

\ runtime action:  ( -- addr)
           DOES> 2@ >BANK ; \ fetch the 32bit from myself, convert to a bank address

The cool thing now is that even though the SAMS-INT: is in SAMS memory, we can read and write it like a normal Forth variable.

 

Here is a SAMS buffer.

: SAMS-BUFFER: ( n -- <text>) ( 64K is the largest buffer we can allocate)
\ compile time action:
           CREATE           \ create a word in dictionary
              SHERE D,    \ compile the 32bit SAMS location into the word
              SALLOT        \ allot n bytes of SAMS space

\ runtime action: ( -- addr)
           DOES> 2@ >BANK ; \ fetch the 32bit from myself, convert to a bank address

​

Have you ever wanted to create a continuous array on the TI-99 that can hold 32K integers?

Well now you can.

: SAMS-ARRAY: ( n -- <text>)
\ compile time action:
           CREATE           \ create a word in dictionary
              SHERE D,      \ compile the 32bit SAMS location into the word
              CELLS SALLOT  \ allot n * 2 bytes of SAMS space (int = 2bytes)

\ runtime action:  ( n -- addr)
           DOES> 2@            \ fetch the 32bit base address from myself
                 ROT CELLS M+  \ rotate the index 'n' to top, multiply by cell size & add to base
                 >BANK ;       \ convert to a bank address

And here is how these data structures could be used.

SAMS-INT: X     99 X !
SAMS-INT: Y    100 Y !
SAMS-INT: Z    101 Z ! 

FFFF SAMS-BUFFER: BIGBUFF    
S" This string is the first thing to go into the large buffer in SAMS memory space" BIGBUFF PLACE 

7FFF SAMS-ARRAY: []BIGARRAY

: FILLARRAY
        7FFF 0
        DO
           I  I []BIGARRAY !
        LOOP ;

There are things we could do to speed this up by using code, but it all works as expected and it is pretty cool to have over 900K of continuous data space on the little TI-99! If we really needed it, we could use the double number word set to access contiguous memory blocks greater than 64K, but at the moment I still don't have a use for memory this big!

 

>BF

Edited February 15, 2018 by TheBF