GDMike Posted July 27, 2019 Share Posted July 27, 2019 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. 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted August 17, 2019 Author Share Posted August 17, 2019 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 R@ ]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 MAKEGLOSSARY.mp4 3 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted August 17, 2019 Author Share Posted August 17, 2019 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 R@ 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 R@ - DUP WASTE U< IF DROP DUP @ OVER UNLINK OVER ADDR&SIZE USE ELSE 2 CELLS - OVER R@ 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) 4 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted August 26, 2019 Author Share Posted August 26, 2019 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. 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted August 28, 2019 Author Share Posted August 28, 2019 (edited) 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 + VC@ >R \ get duration at end of string, Rpush DUP 1+ VDPRDA \ set vdp address to read, 1 past count VC@ 0 \ read count byte for loop DO \ 8800 C@ \ 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 VC@ 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 ! ; : 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@ 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 VDP BG SOUND LISTS.mp4 Edited August 28, 2019 by TheBF TYPO and duplicate video 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted August 28, 2019 Author Share Posted August 28, 2019 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 + VC@ >R \ get duration at end of string, Rpush DUP 1+ VDPRDA \ set vdp address to read, 1 past count VC@ 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 + VC@ >R \ get duration at end of string, Rpush DUP 1+ VDPRDA \ set vdp address to read, 1 past count VC@ MVDP>SND R> JIFFS ; \ use the delay from Rstack (JIFF=1/60) 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 3, 2019 Author Share Posted September 3, 2019 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 V@ + 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 VC@ ; : 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 V@ VP ! POPPAB ; INIT-VDP CR .( 8k VDP Heap at HEX) VDPSTART . HEX 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 5, 2019 Author Share Posted September 5, 2019 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 ; 1 Quote Link to comment Share on other sites More sharing options...
Tursi Posted September 5, 2019 Share Posted September 5, 2019 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? Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 5, 2019 Author Share Posted September 5, 2019 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 Quote Link to comment Share on other sites More sharing options...
Tursi Posted September 5, 2019 Share Posted September 5, 2019 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... 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 6, 2019 Author Share Posted September 6, 2019 (edited) 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. ? Classic99 Q1399.007.mp4 Classic99 Q1394 .mp4 camel99dsk1.zip Edited September 6, 2019 by TheBF Typos 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted September 6, 2019 Share Posted September 6, 2019 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 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 6, 2019 Author Share Posted September 6, 2019 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. 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 6, 2019 Author Share Posted September 6, 2019 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 1 Quote Link to comment Share on other sites More sharing options...
Tursi Posted September 7, 2019 Share Posted September 7, 2019 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. 3 Quote Link to comment Share on other sites More sharing options...
Tursi Posted September 7, 2019 Share Posted September 7, 2019 (edited) 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 September 7, 2019 by Tursi 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 7, 2019 Author Share Posted September 7, 2019 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" !@#$%^&*()_+[]\,./{}|<>?;':" 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. 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 11, 2019 Author Share Posted September 11, 2019 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 VDP TASK.MOV 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted September 11, 2019 Share Posted September 11, 2019 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 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 11, 2019 Author Share Posted September 11, 2019 (edited) 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 September 11, 2019 by TheBF typo 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 14, 2019 Author Share Posted September 14, 2019 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 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 14, 2019 Author Share Posted September 14, 2019 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 ; Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 16, 2019 Author Share Posted September 16, 2019 (edited) 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 2@. 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 ! ; : Q@ ( fifo -- n) DUP 2@ = ABORT" Byte Q underflow" DUP ^HEAD VC@ SWAP HEAD+! ; : QLEN ( fifo -- n) 2@ - ABS ; : Q? ( fifo -- ?) 2@ <> ; : 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 C@ OVER Q! LOOP DROP ; : PRINTQ ( fifo -- ) DEPTH 0= ABORT" Q expected" BEGIN DUP Q? WHILE DUP Q@ EMIT REPEAT DROP ; : 3DUP 2 PICK 2 PICK 2 PICK ; : FILLQ ( cadr len FIFO -- ) 20 0 DO 3DUP Q$! LOOP 2DROP DROP ; Edited September 19, 2019 by TheBF Spoiler has final code version 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 17, 2019 Author Share Posted September 17, 2019 (edited) ISR Timers Re-Think I had logic errors in my ISR multiple timer code for playing music. I only need one timer per sound channel because the ontime and offtimes are sequential 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 Q@ SND! SOPRANOQ Q@ SND! \ freq code SOPRANOQ Q@ SND! \ volume SOPRANOQ Q@ SOPRANOQ Q@ SWAP FUSE TIMER1 SET \ set ontime TIMER1 WAITING \ wait... SOPRANOQ Q@ SOPRANOQ Q@ 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 September 17, 2019 by TheBF 1 Quote Link to comment Share on other sites More sharing options...
Like us on Facebook
Follow us on Twitter
AtariAge on Instagram
Watch us on YouTube
Chat on Discord
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.