Jump to content
TheBF

Camel99 Forth Information goes here

Recommended Posts

Yup! I definitely got going very easily,with TF, but same kinda conditions exits where I stayed straight to design and my efforts were quickly realized. I found myself lurking more and more into assembly and now I'm stuck in 99 assembler and it's code. But Forth is my outlet when frustration takes over in assy. 

  • Like 1

Share this post


Link to post
Share on other sites

Back from the wife's family reunion in the Netherlands and little time in Paris and Provence.  (I could stay in Paris for a long time 🙂 )

 

CAMEL99 Forth is starting to be fun to use as I get more libraries working.

I need to get a better glossary document together so by putting together some lib files I could write a crude "GLOSSARY" utility.

The code could be re-factored a bit more but it works. 

I should also create a generic sort routine that takes a pointer and count as a library for system usage.

 

A Glossary in Forth parlance is a list of Forth words with stack comments and a text description. 

The output of this code gives me the sorted names and an empty stack comment.  Not much, but better than nothing.

 

Here is how the code looks:

Spoiler
\ GLOSSARY GENERATOR

\ This demo uses some advanced features of CAMEL99 forth
\ 1. Dynamically allocating memory in the HEAP ( MALLOC )
\ 2. Vectored execution of the comparison operator
\ 3. Combsort routine which runs about 10X faster than Bubble sort
\ 4. Measuring elapsed time using screen timeout timer value
\ 5. Text macros to improve speed of time critical routines
\ 6. Sorts an array of pointers. The actual strings do not move

\ usage:  ASCENDING SORTWORDS  -or-  DESCENDING SORTWORDS

NEEDS .ID        FROM DSK1.TOOLS
NEEDS TO         FROM DSK1.VALUES
NEEDS IS         FROM DSK1.DEFER
NEEDS ELAPSE     FROM DSK1.ELAPSE
NEEDS WRITE-LINE FROM DSK1.ANSFILES
NEEDS MORE       FROM DSK1.MORE

HEX
\ variables uses by COMBSORT
VARIABLE SFLAG
VARIABLE ITEMS
0 VALUE GAP

0 VALUE ^DATA   \ a data array pointer

: ]DATA    ( n -- ^data[n] ) CELLS ^DATA + ; \ index into ^DATA

\ load the name field address (NFA) of all words, into ^DATA
: LOAD.NAMES ( -- addr n )
             CR ." Loading names... "
             ITEMS OFF            \ reset ITEMS variable
             LATEST @             ( -- nfa )
             0 >R                 \ put a loop index on return stack
             BEGIN
                DUP [email protected] ]DATA !    ( -- nfa )
                R> 1+ >R          \ increment loop counter
                NFA>LFA @         \ goto link field, fetch next NFA
                DUP 0=            \ is it zero?
             UNTIL
             R> DUP .  ." words"
             ITEMS !  ;           \ store # items for sort to use

\ compare strings uses S= (Camel Forth word)
: COMPARE$ ( $1 $2 -- flag)  1+ SWAP COUNT S= ;
: >$       ( $1 $2 -- flag)  COMPARE$ 0> ;  \ $1 > $2
: <$       ( $1 $2 -- flag)  COMPARE$ 0< ;  \ $1 < $2


DEFER PRECEDE   \ vectored string comparison operator
: ASCENDING  ( -- )  ['] <$ IS PRECEDE ;
: DESCENDING ( -- )  ['] >$ IS PRECEDE ;

ASCENDING   \ default sort direction

: /1.3  ( n -- n/1.35 ) \ 100/135 is fastest GAP  ratio for this sort
        S" 100 135 */ 1 MAX " EVALUATE ;  IMMEDIATE

: XCHG  ( 'data[1] 'data[2] $1 $2 -- )
        S" SWAP ROT !  SWAP ! "  EVALUATE ; IMMEDIATE

HEX
: SORTWORDS ( -- )
    ^DATA 0= ABORT" No buffer allocated" 
    LOAD.NAMES
    CR ." Sorting "
    ITEMS @ TO GAP                   \ init combort gap
    BEGIN
       GAP  /1.3  TO GAP             \ compute new gap width
       SFLAG ON                      \ sort flag set to TRUE
       ITEMS @  GAP -  0             \ setup loop
       DO
           I  GAP + ]DATA  I ]DATA   ( -- data[gap] data[i]  )
           OVER @ OVER @             ( -- data[gap] data[i] nfa1 nfa2)
           2DUP                      ( -- data[gap] data[i] nfa1 nfa2 nfa1 nfa2)
           PRECEDE IF                \ compare string at nfa1,nfa2
               XCHG                  \ xchg if wrong order
               SFLAG OFF             \ we are not done yet
           ELSE
               2DROP 2DROP           \ no exchange so collapse the stack info
           THEN
       LOOP
       [CHAR] . EMIT                 \ show progress on screen
       SFLAG @  GAP 1 = AND          \ test for completion
    UNTIL
    CR  ;


\ display the words in sorted order
: .WORDS   ( -- )
            CR
            ITEMS @ 0
            DO
               I ]DATA @ .ID SPACE
               ?BREAK
            LOOP ;

: ID$     ( NFAaddr -- caddr len) COUNT 1F AND  ;

: +PLACE  ( adr n adr -- )   2DUP 2>R  COUNT +  SWAP MOVE 2R> C+! ;

DECIMAL

CREATE OUT$  82 ALLOT ;

0 VALUE #1

: PADDED ( addr$  n -- )  SWAP C!  ;
: BLANKS    BL FILL ;

\ write the words in sorted order
: WRITE-WORDS   ( -- )
            CR
            ITEMS @ 0
            DO
               OUT$ 80 BLANKS
               I ]DATA @ ID$ OUT$ PLACE
                OUT$ 20 PADDED
                S" ( -- )"  OUT$ +PLACE
                OUT$ COUNT  #1  WRITE-LINE ?FILERR
               ?BREAK
            LOOP ;

HEX
: GLOSSARY ( path$ len -- )
            TICKER OFF
            DV80 W/O OPEN-FILE ?FILERR TO #1
            1000 MALLOC TO ^DATA     \ allocate 4k space for the word names
            ASCENDING SORTWORDS
            CR ." Writing file..."
            WRITE-WORDS
            #1 CLOSE-FILE ?FILERR          
            1000 MFREE               \ release the mmeory (low ram)
            0 TO ^DATA
            CR ." Complete"
            .ELAPSED
;

PAGE
\ A little systems work in Forth
S" DSK3.GLOSS99" GLOSSARY

 

 

 

  • Like 3
  • Thanks 1

Share this post


Link to post
Share on other sites

Dynamic Memory Allocation from Forth.net

http://theforth.net/package/dynamic-memory-allocation/current-view/dynamic.fs

 

I always knew that I was trying to make CAMEL99 Forth ANS/ISO compliant but today I got a pleasant surprise.

I found a dynamic memory library and it seems to work!  All I had to do was convert it to uppercase for CAMEL Forth.

 

It's way overkill (probably) for TI-99 but since I was already using Low RAM as a heap there was a place for dynamic memory anyway.

It would be pretty cool to rewrite it for SAMS.

 

Here's the code and the screen shows it working. I have not played with it much to see how it FREEs up memory.

 

Spoiler
\ DYNAMIC.FTH
\ forth-94 version of klaus schleisiek's dynamic memory allocation
\ (forml'88) uh 2016-10-28

VARIABLE ANCHOR  0 ANCHOR !

DECIMAL 050 CONSTANT WASTE

-1 1 RSHIFT CONSTANT #MAX
#MAX INVERT CONSTANT #FREE  \ sign bit

: SIZE      ( mem -- size ) 1 CELLS - @ #MAX AND ;
: ADDR&SIZE ( mem -- mem size ) DUP SIZE ;
: ABOVE     ( mem -- >mem ) ADDR&SIZE + 2 CELLS + ;
: USE       ( mem size -- ) DUP >R SWAP  2DUP 1 CELLS - !  R> #MAX AND + ! ;

: RELEASE ( mem size -- )  #FREE OR USE ;

: FITS? ( size -- mem | false ) >R ANCHOR @
   BEGIN 
      ADDR&SIZE  [email protected] U< 0=
      IF R> DROP EXIT THEN
      @ DUP ANCHOR @ =
   UNTIL 
   0= R> DROP ;

: LINK ( mem >mem <mem -- )
       >R 2DUP CELL+ !  OVER !  R> 2DUP !  SWAP CELL+ ! ;

: @LINKS ( mem -- <mem mem> )  DUP @  SWAP CELL+ @ ;
: SETANCHOR ( mem -- mem ) DUP ANCHOR @ = IF  DUP @ ANCHOR ! THEN ;
: UNLINK ( mem -- ) SETANCHOR  @LINKS 2DUP !  SWAP CELL+ ! ;

: ALLOCATE ( size -- mem ior )
   3 CELLS MAX DUP >R  FITS? ?DUP 0= IF R> -8 EXIT THEN ( "dictionary overflow" )
   ADDR&SIZE [email protected] -  DUP WASTE U<
   IF  DROP  DUP @ OVER UNLINK  OVER ADDR&SIZE USE
   ELSE 2 CELLS -   OVER [email protected] USE
        OVER ABOVE   DUP ROT RELEASE
        2DUP SWAP @LINKS LINK 
   THEN R> DROP  ANCHOR ! 0 ;

: FREE ( mem -- ior )
   ADDR&SIZE  OVER 2 CELLS -  @ DUP 0<
   IF #MAX AND 2 CELLS +  ROT OVER - ROT ROT +
   ELSE  DROP  OVER ANCHOR @  DUP CELL+ @  LINK THEN
   2DUP + CELL+ DUP @ DUP 0<
   IF  #MAX AND SWAP CELL+ UNLINK  +  2 CELLS +  RELEASE 0 EXIT THEN
   2DROP RELEASE 0 ;

: RESIZE ( mem newsize -- mem' ior )
    OVER SWAP  OVER SIZE  2DUP >
    IF ( MEM MEM SIZE NEWSIZE )  SWAP ALLOCATE ?DUP IF >R DROP 2DROP R>  EXIT THEN
        DUP >R SWAP MOVE FREE R> SWAP EXIT THEN
    2DROP DROP 0 ;

: EMPTY-MEMORY ( addr size -- )
   >R  CELL+ DUP ANCHOR !   DUP 2 CELLS USE  DUP 2DUP LINK
   DUP ABOVE  SWAP OVER  DUP LINK
   DUP R> 7 CELLS -  RELEASE  ABOVE 1 CELLS -  0 SWAP ! ;

CR
CR .( dynamic memory allocation:)
CR .( use   addr size EMPTY-MEMORY  to initialize,)
CR .( then use the standard memory allocation wordset allocate free resize to manage memory.)

\ CAMEL99 specific code uses LOW RAM for the HEAP
\ Use only 1F00 to leave room at top for Camel99 Forth SCROLL
\ MALLOC marks the new HEAP as allocated correctly in CAMEL99
  HEX 1F00 DUP MALLOC SWAP ( addr len ) EMPTY-MEMORY
  CR .( Low RAM is HEAP)

 

 

DYNAMIC.jpg

  • Like 4

Share this post


Link to post
Share on other sites

Catching up on Reddit after vacation showed me this very nice video that explains why Forth is called a "threaded" language.

For anyone who ever wondered how this crazy language actually works "behind the curtain" it's fun to watch.

 

 

 

  • Like 3

Share this post


Link to post
Share on other sites

Sound Lists in VDP RAM Played in a Separate Task

 

I am always looking for good uses for the VDP RAM which is a valuable resource in our little machines.

I had this code sitting in the can for quite a while but I couldn't get it working well.  I found the Forth interpreter was dragging down the speed of the music too much.

Tuning a cooperative multi-tasker can be a bit of an art, but with only 2 tasks running I thought it should do better.  Turns out I had broken a rule in my own kernel!

 

The primitive routine that puts a character on the screen was not playing nice in the sandbox.  The key to the Forth multi-tasker is a routine called PAUSE.

PAUSE does a fast context switch to the next task in the round robin queue of tasks. Using work-spaces makes the 9900 pretty quick at switching tasks. (about 20uS)

The secret to making it work seamlessly is to put a PAUSE before or after each low-level I/O operation. This way I/O always run to a logical completion and then give the machine to the next task.

 

I had re-written VPUT and forgot to have PAUSE built into it.  Here is the I/O code to put bytes on the screen In Forth.

Everything is built up from VPUT so it MUST use PAUSE. Duh!


: VPUT   ( char -- ) PAUSE  VPOS VC! ;

: (EMIT) ( char -- )
          VPUT
          OUT  1+!
          VCOL 1+!
          ?CR ;

: BS  ( --)  VCOL DUP @ 1- 0 MAX  SWAP !
             OUT 1-! ;

: EMIT      ( char -- )  \ shows how to handle control characters
            DUP 0D = IF  DROP CR   EXIT THEN
            DUP 08 = IF  DROP BS   EXIT THEN
            (EMIT)  ;

 

 

It takes a little more overhead to read sound lists out of VDP RAM so I did some things to optimize the transfer while staying in Forth.

I wrote a little routine to set the VDP ADDRESS, so I could read VDP in Forth with auto-incrmenting.

I also used low level char store (C!) to write directly to >8400 to feed the sound chip rather than taking the overhead to call SND!

 

I used the CAMEL99 Forth VDP memory manager library to make it easy to compile bytes into VDP RAM sequentially. 

VBYTE lets you create sound lists than work like the Assembler BYTE directive but the data goes into VDP RAM. 🙂

 

There is also a sound queue that can hold 16  20 sound lists. You can add a list to the queue while the music is playing.

If the queue is empty the task puts itself to sleep and hands control to another task. (see: BGPLAYER)

 

Here is the code with demo sound lists and the video demonstrates how you use it.

Spoiler
\ BACKGROUND TI sound list player in CAMEL99 Forth V2

NEEDS DUMP   FROM DSK1.TOOLS
NEEDS FORK   FROM DSK1.MTASK99
NEEDS VCOUNT FROM DSK1.VDPMEM

\ 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 16 sound lists to play
\ 5. Player puts itself to sleep when sound Queue is empty
\ 6. Only two end user comands:  >SNDQ  PLAYQ

\ ========================================================
\ VDP byte string compiler
HEX
: ?BYTE ( n -- ) FF00 AND  ABORT" Not a byte" ;

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

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

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

\ play 1 string with
: VPLAY$ ( VDP_sound_string -- )  \ play 1 sound string from VDP memory
       PAUSE              \ give somebody else some time
       DUP
       VCOUNT + [email protected]  >R        \ get duration at end of string, Rpush
       DUP 1+ VDPRDA           \ set vdp address to read, 1 past count
       [email protected] 0                   \ read count byte for loop
       DO                      \
         8800 [email protected]               \ Read VDP byte+autoinc,
         8400 C!               \ send to sound chip
       LOOP
       R> JIFFS ;              \ use the delay from Rstack (JIFF=1/60)

: VPLAYLIST   ( Vaddr -- )     \ play a TI sound list from VDP memory
         BEGIN DUP [email protected] 
         WHILE                 \ while the length is not 0
            DUP VPLAY$         \ play a single string
            VCOUNT + 1+        \ advance to the next sound string
         REPEAT
         DROP
         SILENT
;

\ ========================================================
HEX
\ create a 16 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 ! ;
: [email protected]     ( 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 [email protected] VPLAYLIST
           REPEAT
           MYSELF SLEEP
           PAUSE ;      \ hand-off to next task


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

CREATE PLAYER   USIZE ALLOT  PLAYER FORK

' BGPLAYER PLAYER ASSIGN

\ ===============================================
\ end user commands
\ Usage:  MUNCHMAN BGPLAY  PACMAN BGPLAY  BGPLAY
: >SNDQ  ( list -- ) SOUNDQ Q! ;
: PLAYQ  ( list -- ) PLAYER RESTART ;
: KILLQ  ( -- )      PLAYER SLEEP  SILENT   SHEAD @ STAIL ! ;

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

\ *--------------------------------------------------------------
\ * Resource 'sound3'
\ * Dump of binary file 'test/resources/sound/gg_bassline.bin'
\ *--------------------------------------------------------------
HEX
VCREATE GG_BASS
        VBYTE  05,C7,08,DF,E3,F0,02,01
        VBYTE  F2,06,01,FF,02,03,C1,07
        VBYTE  F0,02,01,F2,06,01,FF,02
        VBYTE  03,CA,05,F0,02,01,F2,06
        VBYTE  01,FF,02,03,C4,0B,F0,02
        VBYTE  01,F2,06,01,FF,02,03,C7
        VBYTE  08,F0,02,01,F2,06,01,FF
        VBYTE  02,03,CA,05,F0,02,01,F2
        VBYTE  06,01,FF,02,01,F0,02,01
        VBYTE  F2,10,01,FF,02,03,C7,08
        VBYTE  F0,02,01,F2,06,01,FF,02
        VBYTE  03,C1,07,F0,02,01,F2,06
        VBYTE  01,FF,02,03,CA,05,F0,02
        VBYTE  01,F2,06,01,FF,02,03,C4
        VBYTE  0B,F0,02,01,F2,06,01,FF
        VBYTE  02,03,C7,08,F0,02,01,F2
        VBYTE  06,01,FF,02,03,CA,05,F0
        VBYTE  02,01,F2,06,01,FF,02,01
        VBYTE  F0,02,01,F2,10,01,FF,02
        VBYTE  03,CF,08,F0,02,01,F2,06
        VBYTE  01,FF,02,03,C8,07,F0,02
        VBYTE  01,F2,06,01,FF,02,03,CA
        VBYTE  05,F0,02,01,F2,06,01,FF
        VBYTE  02,03,C4,0B,F0,02,01,F2
        VBYTE  06,01,FF,02,03,C7,08,F0
        VBYTE  02,01,F2,06,01,FF,02,03
        VBYTE  CA,05,F0,02,01,F2,06,01
        VBYTE  FF,02,01,F0,02,01,F2,10
        VBYTE  01,FF,02,03,CF,08,F0,02
        VBYTE  01,F2,06,01,FF,02,03,C8
        VBYTE  07,F0,02,01,F2,06,01,FF
        VBYTE  02,03,CA,05,F0,02,01,F2
        VBYTE  06,01,FF,02,03,C4,0B,F0
        VBYTE  02,01,F2,06,01,FF,02,03
        VBYTE  C7,08,F0,02,01,F2,06,01
        VBYTE  FF,02,03,CA,05,F0,02,01
        VBYTE  F2,06,01,FF,02,01,F0,02
        VBYTE  01,F2,10,01,FF,02,05,C7
        VBYTE  08,DF,E3,F0,02,01,F2,06
        VBYTE  01,FF,02,03,C1,07,F0,02
        VBYTE  01,F2,06,01,FF,02,03,CA
        VBYTE  05,F0,02,01,F2,06,01,FF
        VBYTE  02,03,C4,0B,F0,02,01,F2
        VBYTE  06,01,FF,02,03,C7,08,F0
        VBYTE  02,01,F2,06,01,FF,02,03
        VBYTE  CA,05,F0,02,01,F2,06,01
        VBYTE  FF,02,01,F0,02,01,F2,10
        VBYTE  01,FF,02,03,C7,08,F0,02
        VBYTE  01,F2,06,01,FF,02,03,C1
        VBYTE  07,F0,02,01,F2,06,01,FF
        VBYTE  02,03,CA,05,F0,02,01,F2
        VBYTE  06,01,FF,02,03,C4,0B,F0
        VBYTE  02,01,F2,06,01,FF,02,03
        VBYTE  C7,08,F0,02,01,F2,06,01
        VBYTE  FF,02,03,CA,05,F0,02,01
        VBYTE  F2,06,01,FF,02,01,F0,02
        VBYTE  01,F2,10,01,FF,02,03,CF
        VBYTE  08,F0,02,01,F2,06,01,FF
        VBYTE  02,03,C8,07,F0,02,01,F2
        VBYTE  06,01,FF,02,03,CA,05,F0
        VBYTE  02,01,F2,06,01,FF,02,03
        VBYTE  C4,0B,F0,02,01,F2,06,01
        VBYTE  FF,02,03,C7,08,F0,02,01
        VBYTE  F2,06,01,FF,02,03,CA,05
        VBYTE  F0,02,01,F2,06,01,FF,02
        VBYTE  01,F0,02,01,F2,10,01,FF
        VBYTE  02,03,CF,08,F0,02,01,F2
        VBYTE  06,01,FF,02,03,C8,07,F0
        VBYTE  02,01,F2,06,01,FF,02,03
        VBYTE  CA,05,F0,02,01,F2,06,01
        VBYTE  FF,02,03,C4,0B,F0,02,01
        VBYTE  F2,06,01,FF,02,03,C7,08
        VBYTE  F0,02,01,F2,06,01,FF,02
        VBYTE  03,CA,05,F0,02,01,F2,06
        VBYTE  01,FF,02,01,F0,02,01,F2
        VBYTE  10,01,FF,02,05,C7,08,DF
        VBYTE  E3,F0,02,01,F2,06,01,FF
        VBYTE  02,03,C1,07,F0,02,01,F2
        VBYTE  06,01,FF,02,03,CA,05,F0
        VBYTE  02,01,F2,06,01,FF,02,03
        VBYTE  C4,0B,F0,02,01,F2,06,01
        VBYTE  FF,02,03,C7,08,F0,02,01
        VBYTE  F2,06,01,FF,02,03,C1,07
        VBYTE  F0,02,01,F2,06,01,FF,02
        VBYTE  03,CA,05,F0,02,01,F2,06
        VBYTE  01,FF,02,03,C4,0B,F0,02
        VBYTE  01,F2,06,01,FF,02,03,C7
        VBYTE  08,F0,02,01,F2,06,01,FF
        VBYTE  02,03,C5,06,F0,02,01,F2
        VBYTE  06,01,FF,02,03,C5,05,F0
        VBYTE  02,01,F2,06,01,FF,02,03
        VBYTE  CA,0C,F0,02,01,F2,06,01
        VBYTE  FF,02,03,C7,08,F0,02,01
        VBYTE  F2,06,01,FF,02,03,C5,06
        VBYTE  F0,02,01,F2,06,01,FF,02
        VBYTE  03,C5,05,F0,02,01,F2,06
        VBYTE  01,FF,02,03,CA,0C,F0,02
        VBYTE  01,F2,06,01,FF,02,03,C7
        VBYTE  08,F0,02,01,F2,06,01,FF
        VBYTE  02,03,C5,05,F0,02,01,F2
        VBYTE  06,01,FF,02,03,C3,04,F0
        VBYTE  02,01,F2,06,01,FF,02,03
        VBYTE  CA,0C,F0,02,01,F2,06,01
        VBYTE  FF,02,03,C7,08,F0,02,01
        VBYTE  F2,06,01,FF,02,03,C5,05
        VBYTE  F0,02,01,F2,06,01,FF,02
        VBYTE  03,C3,04,F0,02,01,F2,06
        VBYTE  01,FF,02,03,CA,0C,F0,02
        VBYTE  01,F2,06,01,FF,02,03,C7
        VBYTE  08,F0,02,01,F2,06,01,FF
        VBYTE  02,03,C5,05,F0,02,01,F2
        VBYTE  06,01,FF,02,03,C3,04,F0
        VBYTE  02,01,F2,06,01,FF,02,03
        VBYTE  CE,0B,F0,02,01,F2,06,01
        VBYTE  FF,02,03,C7,08,F0,02,01
        VBYTE  F2,06,01,FF,02,03,C5,05
        VBYTE  F0,02,01,F2,06,01,FF,02
        VBYTE  03,C3,04,F0,02,01,F2,06
        VBYTE  01,FF,02,03,CE,0B,F0,02
        VBYTE  01,F2,06,01,FF,02,05,C8
        VBYTE  07,DF,E3,F0,02,01,F2,06
        VBYTE  01,FF,02,01,F0,02,01,F2
        VBYTE  06,01,FF,02,01,F0,02,01
        VBYTE  F2,10,01,FF,02,03,CF,08
        VBYTE  F0,02,01,F2,06,01,FF,02
        VBYTE  03,C8,07,F0,02,01,F2,06
        VBYTE  01,FF,02,03,C4,0B,F0,02
        VBYTE  01,F2,10,01,FF,02,03,C8
        VBYTE  07,F0,02,01,F2,06,01,FF
        VBYTE  02,01,F0,02,01,F2,06,01
        VBYTE  FF,02,01,F0,02,01,F2,10
        VBYTE  01,FF,02,03,C7,08,F0,02
        VBYTE  01,F2,06,01,FF,02,03,C1
        VBYTE  07,F0,02,01,F2,06,01,FF
        VBYTE  02,03,C4,0B,F0,02,01,F2
        VBYTE  10,01,FF,02,03,CF,08,F0
        VBYTE  02,01,F2,06,01,FF,02,01
        VBYTE  F0,02,01,F2,06,01,FF,02
        VBYTE  01,F0,02,01,F2,20,01,FF
        VBYTE  02,01,F0,02,01,F2,06,01
        VBYTE  FF,02,01,F0,02,01,F2,06
        VBYTE  01,FF,02,03,C4,0B,F0,02
        VBYTE  01,F2,06,01,FF,02,01,F0
        VBYTE  02,01,F2,06,01,FF,02,03
        VBYTE  CA,0A,F0,02,01,F2,06,01
        VBYTE  FF,02,03,C0,0A,F0,02,01
        VBYTE  F2,06,01,FF,02,03,C7,09
        VBYTE  F0,02,01,F2,06,01,FF,02
        VBYTE  03,CF,08,F0,02,01,F2,06
        VBYTE  01,FF,02,03,C7,08,F0,02
        VBYTE  01,F2,06,01,FF,02,03,CF
        VBYTE  08,F0,02,01,F2,06,01,FF
        VBYTE  02,05,C7,08,DF,E3,F0,02
        VBYTE  01,F2,06,01,FF,0C,03,CA
        VBYTE  05,F0,02,01,F2,06,01,FF
        VBYTE  02,03,CA,05,F0,02,01,F2
        VBYTE  06,01,FF,0C,03,C7,08,F0
        VBYTE  02,01,F2,06,01,FF,02,03
        VBYTE  C1,07,F0,02,01,F2,06,01
        VBYTE  FF,02,03,CA,05,F0,02,01
        VBYTE  F2,06,01,FF,02,03,C7,08
        VBYTE  F0,02,01,F2,06,01,FF,0C
        VBYTE  03,CA,05,F0,02,01,F2,06
        VBYTE  01,FF,02,03,CA,05,F0,02
        VBYTE  01,F2,06,01,FF,0C,03,C7
        VBYTE  08,F0,02,01,F2,06,01,FF
        VBYTE  02,03,C1,07,F0,02,01,F2
        VBYTE  06,01,FF,02,03,CA,05,F0
        VBYTE  02,01,F2,06,01,FF,02,03
        VBYTE  CF,08,F0,02,01,F2,06,01
        VBYTE  FF,0C,03,CA,05,F0,02,01
        VBYTE  F2,06,01,FF,02,03,CA,05
        VBYTE  F0,02,01,F2,06,01,FF,0C
        VBYTE  03,CF,08,F0,02,01,F2,06
        VBYTE  01,FF,02,03,CA,05,F0,02
        VBYTE  01,F2,06,01,FF,02,03,CA
        VBYTE  05,F0,02,01,F2,06,01,FF
        VBYTE  02,03,CF,08,F0,02,01,F2
        VBYTE  06,01,FF,0C,03,CA,05,F0
        VBYTE  02,01,F2,06,01,FF,02,03
        VBYTE  CA,05,F0,02,01,F2,06,01
        VBYTE  FF,0C,03,CF,08,F0,02,01
        VBYTE  F2,06,01,FF,02,03,CF,05
        VBYTE  F0,02,01,F2,06,01,FF,02
        VBYTE  03,CA,05,F0,02,01,F2,06
        VBYTE  01,FF,02,03,CA,0A,F0,02
        VBYTE  01,F2,06,01,FF,0C,03,C1
        VBYTE  07,F0,02,01,F2,06,01,FF
        VBYTE  02,03,C1,07,F0,02,01,F2
        VBYTE  06,01,FF,0C,03,CA,0A,F0
        VBYTE  02,01,F2,06,01,FF,02,03
        VBYTE  C8,07,F0,02,01,F2,06,01
        VBYTE  FF,02,03,C1,07,F0,02,01
        VBYTE  F2,06,01,FF,02,03,CA,0A
        VBYTE  F0,02,01,F2,06,01,FF,0C
        VBYTE  03,C1,07,F0,02,01,F2,06
        VBYTE  01,FF,02,03,C1,07,F0,02
        VBYTE  01,F2,06,01,FF,0C,03,CA
        VBYTE  0A,F0,02,01,F2,06,01,FF
        VBYTE  02,03,C8,07,F0,02,01,F2
        VBYTE  06,01,FF,02,03,C1,07,F0
        VBYTE  02,01,F2,06,01,FF,02,03
        VBYTE  CF,08,F0,02,01,F2,06,01
        VBYTE  FF,0C,03,CA,05,F0,02,01
        VBYTE  F2,06,01,FF,02,03,CA,05
        VBYTE  F0,02,01,F2,06,01,FF,0C
        VBYTE  03,CF,08,F0,02,01,F2,06
        VBYTE  01,FF,02,03,CA,05,F0,02
        VBYTE  01,F2,06,01,FF,02,03,CA
        VBYTE  05,F0,02,01,F2,06,01,FF
        VBYTE  02,03,C5,06,F0,02,01,F2
        VBYTE  06,01,FF,02,03,CA,05,F0
        VBYTE  02,01,F2,06,01,FF,02,03
        VBYTE  CF,05,F0,02,01,F2,06,01
        VBYTE  FF,02,03,C5,06,F0,02,01
        VBYTE  F2,06,01,FF,02,03,CB,06
        VBYTE  F0,02,01,F2,06,01,FF,02
        VBYTE  03,C1,07,F0,02,01,F2,06
        VBYTE  01,FF,02,03,C8,07,F0,02
        VBYTE  01,F2,06,01,FF,02,03,CF
        VBYTE  08,F0,02,01,F2,06,01,FF
        VBYTE  02,01,9F,00
/END

 

 

 

 

 

Edited by TheBF
TYPO and duplicate video
  • Like 2

Share this post


Link to post
Share on other sites

The obvious optimization to the VDP sound list player is to use the power of the 9900 and move data directly from the VDP port to the 9919 sound chip port.

The 9900 can do this in 1 instruction.  This makes the do loop 4X faster.  VPLAY$ spends most of it's time running the time delay JIFFS, but programming the sound chip faster leaves more CPU time for other tasks. JIFFS runs PAUSE until the 9901 timer has ticked off 16mS.

 

Note: I am running an old version of CLASSIC99 that Tursi changed to handle my use of the 9901 timer.  (Version Q1394)

 

CODE VDP>SND
     8800 @@ 8400 @@ MOVB,    \ mem to mem move from VDP to sound ship
     NEXT,
     ENDCODE

\ play 1 string with
: VPLAY$ ( VDP_sound_string -- )  \ play 1 sound string from VDP memory
       PAUSE                   \ give somebody else some time
       DUP VCOUNT + [email protected]  >R    \ get duration at end of string, Rpush
       DUP 1+ VDPRDA           \ set vdp address to read, 1 past count
       [email protected] 0 DO  VDP>SND LOOP  \ write the sound data
       R> JIFFS ;              \ use the delay from Rstack (JIFF=1/60)

While we're at it if we really wanted to improve the data movement, we could remove the Forth DO/LOOP as well. It's about 10X slower than an ALC loop.

The ALC version uses less memory than the do/loop version as well.  We simply pass the loop count to the routine in the TOS register (R4) and move bytes until it's equal to zero.


CODE MVDP>SND ( n -- ) \ multiple VDP to sound write
       BEGIN,
          8800 @@ 8400 @@ MOVB,
          TOS DEC,
       EQ UNTIL,
       TOS POP,
       NEXT,
       ENDCODE

\ play 1 string with
: VPLAY$ ( VDP_sound_string -- )  \ play 1 sound string from VDP memory
       PAUSE                   \ give somebody else some time
       DUP VCOUNT + [email protected]  >R    \ get duration at end of string, Rpush
       DUP 1+ VDPRDA           \ set vdp address to read, 1 past count
       [email protected] MVDP>SND
       R> JIFFS ;              \ use the delay from Rstack (JIFF=1/60)

 

  • Like 1

Share this post


Link to post
Share on other sites

Managing VDP Memory Better

 

A while back I created a simple memory manager for VDP space that mimics the way Forth manages memory. It is a single pointer that is set to a base address and  is advanced upwards normally. (It can be moved backwards if you are carefull)

 

This worked well for example when creating sound lists in VDP RAM however after taking all that time to compile those long lists into memory, wouldn't it be great if your could save them as a file and bring them back into VDP ram in one second?  I answered the same as you. 😉

 

So the I have decided to expand the simple VDPMEM library file to include a way to say 8K of VDP RAM using opcodes 5 and 6.  I could make a slower way to save and load the entire amount but for now I will stick with 8K.

 

The little challenge was how do you remember the value of the VDP pointer between saving and loading. I opted for a very simple mechanism. The first 2 bytes of the VDP "heap" are reserved to hold that pointer.  Every time you move the pointer with the VALLOT routine, behind the scenes you are also updating these 2 bytes like it was a second Forth variable.  This way when you load the heap back into VDP ram the LOAD-VDP word simply has to read the first "cell" (2 bytes) as an integer and store the value in the Forth VP variable.  Seems to work ok.

 

Spoiler
\ vdp memory manager lexicon V2              Sept 2 2019  BJF

\ This version keeps a record of the VDP memory used at in the first VDP cell.
\ This allows us to save and restore the entire 8K VDP heap in 1 second
\ and restore the size of the heap as well.
\ *Advanced data stuctures could use a linked list of data that begins at
\ the contents of VDP>1000

\ VDP Memory Usage in Camel99 Forth when this file is loaded
\ |  VDP screen   |
\ + --------------|
\ |   RESERVED    |    sprites, patterns color tables
\ |               |
\ +---------------+  HEX 1000, VDP HEAP start
\ |    VHERE      |  VDP heap moves upwards
\ |      .        |
\ |      .        |
\ |      .        |
\ |      .        |
\ |               |
\ |               |
\ |               |
\ |   ^^^^^^^     |  move downwards
\ |  PAB stack    |  PABs start here
\ +---------------+ <-- VDPTOP returns this address
\ | 99 O/S space  |
\ |---------------|

\ INCLUDE DSK1.TOOLS   ( debug)

VARIABLE VP

HEX
1000 CONSTANT VDPSTART
2000 CONSTANT 8K

VDPSTART VP !   \ "VDP pointer" start of free VDP RAM

: VHERE   ( -- addr) VP @ ;   \ FETCH the value in VDP pointer
: VALLOT  ( n -- )
          DUP VP +!                    \ add n to the value in VDP pointer
          VDPSTART [email protected] + VDPSTART V! ;  \ update local VDP variable also

: VC,     ( n -- )   VHERE VC!  1 VALLOT ;
: V,      ( n -- )   VHERE V!   2 VALLOT ;
: VCOUNT  ( vdp$adr -- vdpadr len ) DUP 1+ SWAP [email protected] ;
: VCREATE ( <text>) (  -- Vaddr) VHERE CONSTANT  ; 

: INIT-VDP  ( -- )  VDPSTART VP !   0 VHERE V!  2 VALLOT  ;

HEX
\ Integrate VDP load/save because they need each other :-)
13 CONSTANT PRGRM   \ program format identifier used by E/A Module

: NEWPAB   (  file$ len VDPaddr #bytes mode -- )
           -30 ^PAB +!         \ create new pab in VDP RAM below the current paB
           [PAB 30 0 VFILL     \ erase PAB and file name
        80 [PAB RECLEN] VC!    \ set reclen to HEX 80 like E/A module
          \ pulls params from the stack to init the PAB
           [PAB FLG] VC!       \ set file access mode byte
           [PAB REC#]  V!      \ set #bytes to save (integer)
           [PAB FBUFF] V!      \ set where the file will load VDP Ram
           [PAB FNAME] VPLACE  \ set file name
;

: POPPAB  ( -- ) 30 ^PAB +! ;

: VDPUSED ( -- Vaddr size)
          VDPSTART  VHERE OVER -  DUP 8K > ABORT" VDP>8K" ;

: SAVE-VDP ( file$ len  -- )
          VDPUSED   PRGRM NEWPAB  6 FILEOP ?FILERR
          POPPAB ;

: LOAD-VDP ( file$ len VDPaddr #bytes mode -- )
          VDPUSED 8K MAX  PRGRM NEWPAB  5 FILEOP ?FILERR
          VDPSTART [email protected] VP !
          POPPAB ;

INIT-VDP  
CR .( 8k VDP Heap at HEX) VDPSTART .

HEX

 

 

 

  • Like 1

Share this post


Link to post
Share on other sites

Managing TI-99 File Paths Without String Copying In Forth

I want to improve my SHELL program so that it remembers the current disk like MS DOS did. In order to do that I need a robust way to derive the device name from a path and set a string variable to that device.  Forth systems on the x86 platform began showing two routines back the '80s called SKIP and SCAN. They leverage the string instructions in the x86 CPUs but they are still quite effective at managing strings on the Forth stack.  This is done without a buffer but rather by simply returning a new string address and the new length.

These words did not make it into ANS 94 Forth but they are in CAMEL Forth and many other systems because of their utility.  They are normally coded in ALC and I wrote them in cross-compiler Forth Assembler. Using SCAN to find the '.' in a filename is a perfect use. Here is SCAN. It takes three arguments and returns two.

CODE: SCAN   ( adr len char -- adr' len' )   \ find matching char
              TOS SWPB,                       \ fix byte order of char
              2 (SP) W MOV,                   \ get address->w
             *SP+ R1 MOV,                     \ POP count into R1, char is already in TOS
              NE IF,                          \ R1<>0 ?
                  BEGIN,
                    TOS *W CMPB,              \ does character match?
                    @@2 JEQ,                  \ YES, we are done, JUMP OUT
                     W INC,                   \ next character
                     R1 DEC,                  \ dec. loop counter
                  EQ UNTIL,                   \ hit end of string, jmp out
              ENDIF,
@@2:          W *SP  MOV,                     \ store updated address on stack
              R1 TOS MOV,                     \ updated count to TOS
              NEXT,
             END-CODE

 

  Another simple but effective routine is called /STRING. ( pronounced "cut string")  It is kind of like RIGHT$ in MS BASIC but it works backwards to RIGHT$. The length argument 'n' is the amount you want to remove from the front of the string. Again it is very fast since there is no string copying.

\ Forth version
: /STRING ( c-addr1 u1 n -- c-addr2 u2 ) ROT OVER + -ROT - ;

\ In Forth 9900 Assembler it is smaller and 15X faster
CODE: /STRING ( c-addr1 u1 n -- c-addr2 u2 ) \ ~20uS!!       Clks
              TOS *SP SUB,                                  \ 18
              TOS 2 (SP) ADD,                               \ 22
              TOS POP,                         \ refill TOS   22
              NEXT,                            \ 8 bytes      62 
              END-CODE

By using these two micro routines in a few new routines we can cut a path into device and filename like magic.

I added some runtime error checking for null strings in these versions.  The screen capture shows how they are used given a correct FILE$ and two "BAD$"

Notice the Forth style factoring so that the intermediate routines can be used separately if needed.

\ file path cutters
: /.        ( caddr len -- caddr' len' ) 
            [CHAR] . SCAN DUP 0= ABORT" '.' was expected" ;

: DEV./     ( caddr len -- dev. len' )
            2DUP /. NIP - 1+ ;

: /FILENAME ( caddr len -- filename len')
             /. 1 /STRING DUP 1 < ABORT" Missing file name" ;

: DEV/NAME  ( path len -- dev len file len)
            2DUP DEV./ 2SWAP /FILENAME ;

 

Classic99 9_4_2019 11_08_49 PM.png

  • Like 1

Share this post


Link to post
Share on other sites
On 8/28/2019 at 5:48 AM, TheBF said:

Note: I am running an old version of CLASSIC99 that Tursi changed to handle my use of the 9901 timer.  (Version Q1394)

Um... why? Is it broken in the current release? I thought I finally had that resolved?

 

Share this post


Link to post
Share on other sites
6 hours ago, Tursi said:

Um... why? Is it broken in the current release? I thought I finally had that resolved?

 

A while back there was a version that Lee was using that was one or maybe two past Q1394. 

He wanted to experiment with CAMEL99 and when he tried it, it froze on the boot-up BEEP which uses the 9901 timer for the on time delay. I didn't push the issue forward because you were working on another bug and it kind of slipped my mind to follow up.  I had tested on real hardware so I knew it worked there.

 

I will double check with the very latest release today and report back here on what I find.

 

Thanks for asking

Share this post


Link to post
Share on other sites
9 hours ago, TheBF said:

I will double check with the very latest release today and report back here on what I find.

Thanks. I was aware of the lockup, and I investigated it. There was a conflict with the way I did the 9901 wherein either CS1 or your timer usage worked, but eventually I figured out my misunderstanding and both should be fine. I /thought/ I even found your original test app to verify it. ;)

 

Looks like 399.006 and later SHOULD have it... ;)

 

  • Like 1

Share this post


Link to post
Share on other sites

Sorry to say that Q1399.007 doe lock up when I try to read the 9901 timer, which happens right at boot up to run the BEEP routine.

 

"Black screamer"  as Lee called it,  is 1st video running on 1399.007

2nd one is Q1394 running the same DSK1.CAMEL99

I zipped up my working disk.   E/A Option 5, run:  DSK1.CAMEL99

 

I really hate being the odd one in the class,  😒 but hey I'm writing Forth code so go figure. 🙂

 

 

camel99dsk1.zip

Edited by TheBF
Typos
  • Like 1

Share this post


Link to post
Share on other sites
On 9/4/2019 at 11:15 PM, TheBF said:

Managing TI-99 File Paths Without String Copying In Forth

. . .

 

This looked so interesting I just had to attempt an fbForth port.

 

Aside from needing to either write words for 2DUP 2SWAP NIP , load block 41 from FBLOCKS (I added 2SWAP to it today), or include their code in the relevant words, I have the problem that fbForth uses counted strings for the most part. I even defined S" to push to the stack only the address of the length byte of a counted string rather than the address of a string and its length. It is a simple enough matter to use COUNT to get the address and length to the stack, but the substrings of a counted string will not be counted strings. I am probably overthinking this because your string-cutting words always produce address/length pairs.

 

Anyway, here is my port of SCAN and /STRING to fbForth. You will note that I had to rework the logic in SCAN because fbForth’s Assembler does not have Camel99 Forth’s simple jump-to-label mechanism. Also, the lack of TOS in fbForth needed accommodation in both words:

\ fbForth port from Camel99 Forth...

ASM: SCAN  ( adr len char -- adr' len' )  \ find matching char
   *SP+ R0 MOV,         \ pop char->R0
   R0 SWPB,             \ fix byte order of char
   2 @(SP) W MOV,       \ get address->W
   *SP R1 MOV,          \ get count->R1..char is now in R0
   NE IF,               \ R1<>0?
      BEGIN,            \ yes..parse string
         R0 *W CB,      \ compare characters
         NE IF,         \ match?..if yes, skip this
            W INC,      \ no..next character
            R1 DEC,     \ dec loop counter
         ENDIF,
      EQ UNTIL,         \ match or hit end of string? if yes, quit loop
   ENDIF,               
   W 2 @(SP) MOV,       \ store updated address 1 cell below top of stack
   R1 *SP MOV,          \ updated count to top of stack
;ASM

ASM: /STRING ( c-addr1 u1 n -- c-addr2 u2 ) 
   *SP+ R0 MOV,         \ pop n to R0
   R0 *SP S,            \ u2 = u1 - n
   R0 2 @(SP) A,        \ c-addr2 = c-addr1 + n
;ASM

At first, I thought I was going to need some rather convoluted logic in SCAN because I could not jump out of the main loop with a match, but then I remembered that the status of a given instruction can be tested as many times as needed just as long as there are no intervening status-setting instructions. This allows for the EQ UNTIL, instruction to test the R0 *W CB, status when  the NE IF, fails as well as the R1 DEC, status when it succeeds!

 

...lee

  • Like 2

Share this post


Link to post
Share on other sites

Very nice. I am happy to have presented something of interest to someone else in the world. 

 

Yes I find myself fascinated with these 2 element stack strings and their efficiency.  I of course used counted string exclusively years ago and was not really convinced that these new fangled things were worth the trouble. But for certain types of string processing they certainly strip out some clock cycles.

There are still applications however where I find managing 2 elements on the stack for multiple string to be un-natural in Forth, but a couple of double variables can help that along when the stack thrashing gets too tricky. 

 

I have been busy with some other projects so I have not had time to focus on some of the big things on my Forth to do list but I will get back to it soon.

 

For the record in no particular order:

1. I need a resident editor.  I am wondering about making something like VI or VIM making use of the Forth interpreter for the command line part.

2. Make Binary save utility to E/A5 file(s) Add to that an overlay system so that big utilities can be loaded fast like you do with your assembler

3. Improve shell (disk utility) commands to add default disk drive prompt, create a piping operator and some filters and for fun add SPAWN command so that these things can work in the background. (I can dream 😙)  Even if not practical it would be fun to watch the old 99 do it. 

 

Longer term (unless I can't resist working on them)

1. Continue the Native code compiler and trying re-compiling the Camel Forth kernel in native code. (ambitious)

2. Create a "FAR" memory 'SAMS:'  ';SAMS' (?)  that compile code in SAMS pages and knows how to pull the correct page in for those words.

 I will need to think about how I search that dictionary space...

 

And... make all this work on the TTY version of the system.

 

That should keep me busy for a while.

 

 

 

 

  • Like 1

Share this post


Link to post
Share on other sites

For the record here is SKIP

 

CODE: SKIP  ( c-addr u char -- c-addr' u')    \ skip matching chars
              TOS SWPB,                       \ fix byte order
              2 (SP) W MOV,                   \ get address->w, leave space on stack
             *SP+ R1 MOV,                     \ POP count into R1, char is already in TOS
              NE IF,                          \ if r1=0 get out
                  BEGIN,
                    TOS *W+ CMPB,             \ does character match? &  auto-incr. address
                    @@2 JNE,                  \ NO MATCH jump out
                    R1 DEC,                   \ decr loop counter
                  EQ UNTIL,                   \ loop until R1=0
@@2:              W DEC,                      \ correct result address after auto-inc.
              ENDIF,
              W *SP  MOV,                     \ store updated address on stack
              R1 TOS MOV,                     \ updated count to TOS
              NEXT,
              END-CODE

 

  • Like 1

Share this post


Link to post
Share on other sites
On 9/5/2019 at 5:31 PM, TheBF said:

Sorry to say that Q1399.007 doe lock up when I try to read the 9901 timer, which happens right at boot up to run the BEEP routine.

...

I really hate being the odd one in the class,  😒 but hey I'm writing Forth code so go figure. 🙂

 

Well, no, you're using the hardware, and that is supposed to work. I can't fix problems I don't know about, so please, when you find issues, let me know, don't just roll back to the older version. It's way easier to tell what I broke shortly after breaking it than a year later. ;)

 

Let me grab the info you posted there and see what I can do. ;)

 

  • Like 3

Share this post


Link to post
Share on other sites

So... oddly, 399.007 works here, which makes me wonder if I just never released the fix. I'll publish 399.008 tonight just to be sure (there was a bug in the history dropdown for disk paths anyway ;) ).

 

(Edit: confirmed. I fixed it in April but never published it...)

 

 

Edited by Tursi
  • Like 3

Share this post


Link to post
Share on other sites

Another Use for Scan

 

There are many times in a program that processes text where you want to compare a character to specific list of other characters. Many times this has to do with finding any of the punctuation marks in a string.  SCAN to the rescue.

 

I posted this definition in a post about making a VALIDATE type key input but the concept could be used for any text processing job.

 

: VALIDATE ( char addr$ len -- ?)  \ returns 1 or false (0)
           ROT SCAN  NIP ;    \ NIP removes the address leaving only the count
\ Usage examples

: UALPHA? ( char -- n)  S" ABCDEFGHIJKLMNOPQRSTUVWXYZ" VALIDATE ;  \ Never do this in real code :-)
: PUNCTUATION? ( char -- n) S" [email protected]#$%^&*()_+[]\,./{}|<>?;':" VALIDATE ; 

Caveat:

If we wanted to include the double quote char in the punctuation string, we would have to add it to the string with lower level code.

(append double quote to a string variable that contains all the punctuation chars for example)

 

How handy is that? 

 

For the Forth student: "Never do this in real code"   

Why?

Looping to compare 1 character to a list of consecutive characters is a waste of CPU time when all you need to do is check if the character is within the range of ASCII A to ASCII Z so just use 2 comparisons. Many Forths and CAMEL99 have a word to do this written in Assembly Language.  This would be about 100X faster (not measured)

: UALPHA?  ( c -- ? )  [CHAR] A  [CHAR] Z 1+ WITHIN ;

For legacy reasons WITHIN needs the 1+ after the 'Z' value.  If you wanted something cleaner, MPE Forth has BETWEEN.

: BETWEEN ( n low hi -- ?) 1+ WITHIN ;

It's Forth do it your way.

 

 

  • Like 1

Share this post


Link to post
Share on other sites

There is common mistake you make in Forth... and it's not the stack

 

I have been trying to find an instability in the TTY version of CAMEL99 Forth. My dream has been to program the VDP interface from the comfort of Terra Term having the graphics programs running as a separate thread. But everytime I started something up a task it crashed. I finally dug in using the Forth console to dump the workspace on the screen.

BTW here is all it takes to make such a tool in Forth.

: WKSP  ( addr -- )
     PAGE
     BEGIN
        0 0 AT-XY
         DUP 80 CELLS DUMP
        ?TERMINAL
     UNTIL 
     DROP ;

 

What I saw surprised me!  R15 was incrementing by some amount each time the screen refreshed. ???

 

By trying a few different things and examining only R15 I narrowed it down to the RS232 output word called CEMIT.

CEMIT had to update some variables that are local to the task ( USER VARIABLES) that count the no. of chars output and move the column variable.

These are in a big array and are referenced by an index number.  In the KERNEL I use  RADIX Hexadecimal almost exclusively and in code words I use HEX numbers to reference the USER variables.

In the 9902 code I found it easier to use the chip's bit numbers in DECIMAL arithmetic so the numbers matched the documentation and in the CEMIT word I accidently used the HEX numbers in the code while the RADIX was set to DECIMAL.

 

This mistake is easy to make in simple Forth systems that rely on the system variable BASE to compile numbers in your program.

A recent trend is to add a feature to the interpreter to mark numbers as HEX or decimal with a prefix character. FbForth and Turbo Forth have these.

Rather than complicate my interpreter I may just add a few words that parse numbers and convert them in different bases.

 

How about  0x  for HEX. 🙂   The only difference would be it needs a space before the number. ( 0x DEAD 0x BEEF )

 

 

The attached video shows the results of my sleuthing. It finally works... mostly.  Got a few more cans of RAID to buy but its stable now.

Excuse the one hand typing.  There is a little MSG variable that shuts off the VDP task and runs CHARSET. You can see me send that MSG on the TTY.

 

Spoiler shows the code:

Spoiler
\ Demo from TI-BASIC USER'S REFERENCE GUIDE
\ /TTY camel forth version Multi-tasking on the VDP display

\ Random Color Dots
NEEDS .S       FROM DSK1.TOOLS
NEEDS RND      FROM DSK1.RANDOM
NEEDS COLOR    FROM DSK1.GRAFIX
NEEDS HZ       FROM DSK1.SOUND
NEEDS CHARSET  FROM DSK1.CHARSET
NEEDS ASSIGN   FROM DSK1.MTASK99

DECIMAL
: SET-COLORS ( -- )
     BL SET# 2 1 COLOR
     20 5 DO   I I I COLOR   LOOP ;  \ Forth has different color sets

: Y   ( -- n ) 1000 RND 110 + ;
: CHR ( -- n )   80 RND 40 + ;
: ROW ( -- n )   24 RND  ;
: COL ( -- n )   32 RND  ;

\ We create a SOUND word from the primitives: HZ DB MS MUTE
: SOUND  ( dur freq att --) PAUSE DB  HZ  MS MUTE ;

HEX VARIABLE MSG

: HALT  ( PID -- ) SLEEP  PAUSE ;

DECIMAL
: RNDCOLOR ( -- )
      GRAPHICS
      2 SCREEN
      SET-COLORS
      MSG OFF
      BEGIN
         PAUSE
         COL ROW CHR 1 HCHAR
         GEN1 75 Y -2 SOUND
         MSG @
      UNTIL
      8 SCREEN
      4 19 2 1 COLORS
      CHARSET
      MSG OFF
      MYSELF HALT
;

USIZE MALLOC CONSTANT TASK1

TASK1 FORK

' RNDCOLOR TASK1 ASSIGN

 

 

 

 

 

 

  • Like 1

Share this post


Link to post
Share on other sites
2 hours ago, TheBF said:

A recent trend is to add a feature to the interpreter to mark numbers as HEX or decimal with a prefix character. FbForth and Turbo Forth have these.

 

Actually, fbForth does not have these. I have thought about it, but that is as far as I got. :)

 

...lee

Share this post


Link to post
Share on other sites

Ahh.  My mistake.  

While working on the native code compiler, I needed a way to compile literal numbers and it was much simpler to just make a new word (H#) to convert Hex numbers in the input stream.  It occurred to me that there really is no need for a Forth system Interpreter loop to deal with literal numbers except for the fact that we expect a number to be understood "as is" in the program code.

 

The downsize of making parsing literal number words in conventional Forth is that they would need to be STATE smart to deal with compiling a literal into a colon definition but if you can stomach that and both of us do currently, then it's pretty straightforward.

 

 

Edited by TheBF
typo
  • Like 1

Share this post


Link to post
Share on other sites

16 Timers on the ISR

 

I have some ideas on making a multi-channel music player that will require 8 timers.  I wanted to see if I could put all the timers in registers in a workspace to make it more efficient.

I used some old code I wrote to INSTALL and ISR sub-routine and made all the registers as timers; 8 incrementing and 8 decrementing.

It works great!

 

 

\ create multple timers in a new workspace
CREATE TIMERS   16 CELLS ALLOT

CODE MULTITIMER
       TIMERS LWPI,  \ make timer array the workspace
       R0 INC,       \ inc the registers
       R1 INC,
       R2 INC,
       R3 INC,
       R4 INC,       \ inc the registers
       R5 INC,
       R6 INC,
       R7 INC,
       R8  DEC,      \ inc the registers
       R9  DEC,
       R10 DEC,
       R11 DEC,
       R12 DEC,       \ inc the registers
       R13 DEC,
       R14 DEC,
       R15 DEC,
       83E0 LWPI,    \ restore GPL workspace
       RT,
       ENDCODE


: ?CODE ( cfa -- ) DUP @ 2- - ABORT" Not code word" ;

\ API
: ISR'  ( -- code-address)
        BL WORD  FIND  0= ABORT" ISR not found"
        DUP ?CODE >BODY ;

: INSTALL   83C4 ! ;

\ Usage:   ISR' MULTITIMER INSTALL

 

  • Like 1

Share this post


Link to post
Share on other sites

You Gotta Love the 9900

 

In order to manage musical note sound, the way I want to,  I need a timer for on-time and one for off-time.

With four voices in the 9919 chip that means 8 timers.  By using two registers for each timer I get the fastest way to manage this in ALC when interfacing to Forth.

One register is the status and the other is a counter which is perpetually decrementing.

 

The code sets the status to -1 if the counter hits zero.

To "set" the counter from an external language you simply reset the status register in the timer workspace and set the counter to the value you want.

 

This lets you read the timer anytime you want from the external language knowing that it will be correct.
 

In the final code the on-time timer will also mute the appropriate 9919 voice when the clock hits zero.

New notes will not be sent to the 9919 until the off-time timer also expires.

 

The spoiler shows the test code for the concept.  It is so handy to read registers as memory.

 

\ MUSIC TIMERS

\ Timers are a double cell variable. <STATUS>,<COUNTER>
\ Timers are managed in a workspace for maximum speed.

\ ODD registers are decremented by the ISR non-stop
\ EVEN registers are the true/false flag, set to true when counter hits zero.

\ In Forth we can set the timers with fast:  "value" false WORKKSPACE 2!

\ READ the EVEN registers to see if timer has expired (true means expired)

\ Read timer status with '@'
\ Example: TIMER1 @ returns true when expired

NEEDS DUMP FROM DSK1.TOOLS
NEEDS MOV, FROM DSK1.ASM9900

DECIMAL
CREATE MTIMERS   16 CELLS ALLOT

HEX
CODE TIMERISR
     MTIMERS LWPI,
     R1  DEC,  EQ IF,  R0  SETO,  ENDIF,
     R3  DEC,  EQ IF,  R2  SETO,  ENDIF,
     R5  DEC,  EQ IF,  R4  SETO,  ENDIF,
     R7  DEC,  EQ IF,  R6  SETO,  ENDIF,
     R9  DEC,  EQ IF,  R8  SETO,  ENDIF,
     R11 DEC,  EQ IF,  R10 SETO,  ENDIF,
     R13 DEC,  EQ IF,  R12 SETO,  ENDIF,
     R15 DEC,  EQ IF,  R14 SETO,  ENDIF,
     83E0 LWPI,
     RT,
     ENDCODE

\ Declare timer status registers as constants for fast reading
MTIMERS          CONSTANT TIMER1   \ Soprano voice ontime
TIMER1 2 CELLS + CONSTANT TIMER2   \ Soprano voice offime
TIMER2 2 CELLS + CONSTANT TIMER3   \ Alto voice ontime
TIMER3 2 CELLS + CONSTANT TIMER4   \ Alto voice offime
TIMER4 2 CELLS + CONSTANT TIMER5   \ Tenor voice ontime
TIMER5 2 CELLS + CONSTANT TIMER6   \ Tenor voice offtime
TIMER6 2 CELLS + CONSTANT TIMER7   \ Percussion ontime
TIMER7 2 CELLS + CONSTANT TIMER8   \ Percussion offtime

: SET  ( TIMERaddr -- ) FALSE SWAP 2! ;

: ?CODE ( cfa -- ) DUP @ 2- - ABORT" Not code word" ;

\ API
: ISR'  ( -- code-address)
        BL WORD  FIND  0= ABORT" ISR not found"
        DUP ?CODE >BODY ;

: INSTALL   83C4 ! ;

\ test code
DECIMAL
: WAIT ( value timer# -- )
        DUP -ROT SET
        BEGIN
           DUP @ ABORT" Timer expired!"
        AGAIN
;

 

Share this post


Link to post
Share on other sites

General Purpose Byte Queues in VDP RAM

 

My crazy idea that has captured my attention is to use a music notation that, when run, sends the data into four queues, one for each voice.

Then by reading each queue I should be able to parallel play each voice. That's the theory anyway.

 

Anyway I now have the music scripts like this:

: TWINKLE
     SOPRANO
     NORMAL
     GEN1   1/8  A3 A3 E4 E4 F#4 F#4   1/4 E4
            1/8  D4 D4 C#4 C#4  B3 B3  1/4 A3
            STACCATTO
            1/8  E4 E4 D4 D4 C#4 C#4   1/4 B3
            NORMAL
            1/8  E4 E4 D4 D4 C#4 C#4   1/4 B3
            MARCATO
            1/8  A3 A3 E4 E4 F#4 F#4   1/4 E4
            1/8  RIT. D4 D4  RIT. C#4  C#4
                 RIT. B3  RIT. B3   RIT. 1/2. A3 ;

...generating bytes that go into either the SOPRANO, ALTO or TENOR queue.  (Percussion queue comes later)

The plan is to create a player that reads the queues, a packet at a time and sends them to the sound chip and then use the ISR timers to shut off the sound.

 

It occurred to me that I could use the VDP RAM for the byte queues.

If the VDP queues can keep up the data rate it is awfully handy to have all that memory outside the CPU.

It was challenging to make these things work correctly and simply. I did it in assembler as well which is about 2X faster easier to access the data structure too, but I wanted to see how Forth handled it.

 

The spoiler code uses the CAMEL99 VDPMEM library file which gives you a simple memory manager analogous to the Forth dictionary management words.

There are no direct access words for the VBYTEQ: data structure. I didn't see a need for it after the 2nd re-write.

By putting the tail and head in adjacent cells I can get them both quickly with [email protected]  I liked that.

 

Spoiler
\ VBYTEQ.FTH                           Sept 15 2019 B Fox
\ use VDP memory to create BYTE Queues that are
\ managed by a structure in CPU RAM

\ NEEDS .S      FROM DSK1.TOOLS ( testing only)
\ NEEDS ELAPSE FROM DSK1.ELAPSE
 
 NEEDS VALLOT  FROM DSK1.VDPMEM

HEX
\ create data structure *SIZE MUST BE POWER OF 2*
: VBYTEQ: ( size -- addr )  \ define a queue
         CREATE
\           tail  head  size   mask    VDP Addr
\           ----  ----  ----   ----    --------
             0 ,  0 ,   DUP , DUP 1- ,  VHERE , 
          VALLOT ;

: ^TAIL ( fifo -- vaddr) DUP  8 + @  SWAP @ + ;
: ^HEAD ( fifo -- vaddr) DUP  8 + @  SWAP CELL+ @ + ;

\ circular BYTE Q access words
: TAIL+!  ( FIFOaddr --)
           DUP  @ 1+
           OVER 6 + @ AND
           SWAP ! ;

: HEAD+!  ( FIFOaddr --)
           CELL+
           DUP  @ 1+
           OVER 4 + @ AND
           SWAP ! ;

: [email protected]     ( fifo -- n)
            DUP [email protected] = ABORT" Byte Q underflow"
            DUP ^HEAD [email protected] SWAP HEAD+! ;

: QLEN   ( fifo -- n) [email protected] - ABS ;

: Q?     ( fifo -- ?) [email protected] <> ;

: Q!     ( n fifo -- )
\           DUP QLEN OVER 6 + @ 2- > ABORT" Queue full"
           TUCK ^TAIL VC!  TAIL+! ;

: QRST   ( fifo -- ) 0 0 ROT 2! ;

\ ==============================================
\ TEST CODE

400 VBYTEQ: X
400 VBYTEQ: Y
400 VBYTEQ: Z

: Q$!  ( caddr len fifo -- ) -ROT BOUNDS DO  I [email protected] OVER Q! LOOP DROP ;

: PRINTQ  ( fifo -- ) 
           DEPTH 0= ABORT" Q expected"
           BEGIN DUP Q? WHILE  DUP [email protected] EMIT  REPEAT DROP ;

: 3DUP     2 PICK 2 PICK 2 PICK ;

: FILLQ  ( cadr len FIFO -- )  20 0 DO   3DUP Q$!  LOOP   2DROP DROP ;

 

 

Edited by TheBF
Spoiler has final code version
  • Like 1

Share this post


Link to post
Share on other sites

ISR Timers Re-Think

 

I had logic errors in my ISR multiple timer code for playing music.

  1. I only need one timer per sound channel because the ontime and offtimes are sequential
  2. I cannot continuously decrement the down counter in the ISR because it will re-trigger itself. DUH!
     

So with that said here is the re-worked code that does what I want.

And since I only need 4 timers now I pre-load some work space registers with the MUTE values for each sound channel on the 9919.

That save a little time in the muting instructions means I don't need to declare 4 variables.

I have a new version of the SET work that resets the flag register and loads the down-counter register..

And there is now word called WAITING that give a TIMER name will block until the timer returns a true flag.

The ISR is now more complicated but I think I can't think of a way to do the job with less code.

 

On the queue side I have successfully played music read out of the VDP queues just using the MS timer Forth word to delay for each note.

All that remains is to marry this new ISR timer code with the rest of it to see how it works.

 

Here is what playing 1 note from the Queue and feeding these timers should look like. I will use a separate note player for each voice because the timers and not index-able and since there is a one to one relationship with the timers to the voices it is better that way.

: PLAY1 ( -- ) \ play 1 packet from the soprano queue
           SOPRANOQ [email protected] SND!  SOPRANOQ [email protected] SND!            \ freq code
           SOPRANOQ [email protected] SND!                              \ volume
           SOPRANOQ [email protected] SOPRANOQ [email protected] SWAP FUSE TIMER1 SET  \ set ontime
           TIMER1 WAITING                                \ wait...
           SOPRANOQ [email protected] SOPRANOQ [email protected] SWAP FUSE TIMER1 SET  \ set offtime
           TIMER1 WAITING                                \ wait...
;

So in theory I should be able to run each packet player sequentially in a loop and get multi-voice music from text scripts.

 

Edit: I will probably have to change from using WAITING to using a conditional SND! word that only sends data to the sound chip when it's TIMER is expired.

 

 

Spoiler

NEEDS DUMP  FROM DSK1.TOOLS
NEEDS MOV,  FROM DSK1.ASM9900

DECIMAL
CREATE MTIMERS   16 CELLS ALLOT
\ register allocation for 4 TIMER workspace
\  R0  FLAG
\  R1  DECREMENTER
\  R2  FLAG
\  R3  DECREMENTER
\  R4  FLAG
\  R5  DECREMENTER
\  R6  FLAG
\  R7  DECREMENTER
\  R8  MUTE1 value   ( used instead of variable)
\  R9  MUTE2 value
\ R10  MUTE3 value
\ R11  MUTE4 value
\ R12
\ R13
\ R14
\ R15

HEX
: ]MTIMERS!  ( n ndx  -- ) CELLS MTIMERS +  ! ;

: RST-TIMERS ( -- )  \ preload the workspace :-)
        MTIMERS 8 CELLS 0 FILL
        9F00  8 ]MTIMERS!
        BF00  9 ]MTIMERS!
        DF00 0A ]MTIMERS!
        FF00 0B ]MTIMERS!
;

RST-TIMERS

HEX
CODE TIMERISR       ( 75 bytes + 32 byte workspace)
    MTIMERS LWPI,
\ Soprano timer
    R1 R1 MOV,
    NE IF,
         R1 DEC,
         EQ IF,
              R0 SETO,               \ r0=true
              R8  8400 @@ MOVB, \ mute the channel
         ENDIF,
     ENDIF,
\ Alto timer
    R3 R3 MOV,
    NE IF,
         R3 DEC,
         EQ IF,
              R2 SETO,               \ r0=true
              R9  8400 @@ MOVB, \ mute the channel
         ENDIF,
     ENDIF,
\ Tenor timer
    R5 R5 MOV,
    NE IF,
         R5 DEC,
         EQ IF,
              R4 SETO,               \ r0=true
              R10  8400 @@ MOVB, \ mute the channel
         ENDIF,
     ENDIF,
\ Percussion timer
    R7 R7 MOV,
    NE IF,
         R7 DEC,
         EQ IF,
              R6 SETO,               \ r0=true
              R11  8400 @@ MOVB, \ mute the channel
         ENDIF,
    ENDIF,
    83E0 LWPI,
    RT,
    ENDCODE

\ Declare timer status registers as constants for fast reading
MTIMERS           CONSTANT TIMER1   \ Soprano voice timer
MTIMERS 2 CELLS + CONSTANT TIMER2   \ Alto voice timer
MTIMERS 4 CELLS + CONSTANT TIMER3   \ Tenor voice timer
MTIMERS 6 CELLS + CONSTANT TIMER4   \ Noise voice timer

: ?CODE ( cfa -- ) DUP @ 2- - ABORT" Not code word" ;

\ ====================================================
\ TIMER API
: ISR'  ( -- code-address)
        BL WORD  FIND  0= ABORT" ISR not found"
        DUP ?CODE >BODY ;
HEX
: INSTALL ( sub-routine -- )  83C4 ! ;

\                      rst flag    load counter
\                     ----------   ------------
: SET   ( TIMERaddr -- ) DUP OFF   CELL+ ! ;

: WAITING ( timer -- ) BEGIN  PAUSE DUP @ UNTIL ;

( And also:  RST-TIMERS)



 

 

Edited by TheBF
  • Like 1

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...

  • Recently Browsing   0 members

    No registered users viewing this page.

×
×
  • Create New...