+TheBF Posted February 22 Author Share Posted February 22 Coincidence again... While reviewing files I found a lot of Forth code looking back at me in COINC. My last version of the DIRSPRIT library (I don't know where the 'e' went either) use only high level Forth. Rather than using advanced math I went with subtracting the two coordinates and comparison the different to a tolerance. Old version \ 0 in all these words means no coincidence : COINC ( spr#1 spr#2 tol -- ?) >R POSITION ROT POSITION ( -- x1 y1 x2 y2 ) ROT - ABS R@ < -ROT - ABS R> < AND ; : COINCXY ( x1 y1 sp# tol -- ? ) >R POSITION ( -- x1 y1 x2 y2 ) ROT - ABS R@ < -ROT - ABS R> < AND ; I realized a very short code word would improve it rather than all the ROTating that I had before. Here is the business end. Seems to work well. Man I love the 9900 instruction set. \ ABS VECT- FASTER than Forth version CODE |VECT-| ( x y x y -- |dx| |dy|) *SP+ W MOV, *SP+ TOS SUB, W *SP SUB, TOS ABS, *SP ABS, NEXT, ENDCODE : COINC ( spr#1 spr#2 tol -- ?) >R POSITION ROT POSITION ( -- x1 y1 x2 y2 ) |VECT-| R@ < SWAP R> < AND ; : COINCXY ( x1 y1 sp# tol -- ? ) >R POSITION ( -- x1 y1 x2 y2 ) |VECT-| R@ < SWAP R> < AND ; 3 Quote Link to comment Share on other sites More sharing options...
Willsy Posted February 22 Share Posted February 22 It's been fun catching up with all this SAMS shenanigans! I remember my Eureka moment when I did that SAMS library for TF. I thought it was pretty neat. You've taken it even further which is really great . Will any of this run on TF? 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted February 22 Author Share Posted February 22 1 hour ago, Willsy said: It's been fun catching up with all this SAMS shenanigans! I remember my Eureka moment when I did that SAMS library for TF. I thought it was pretty neat. You've taken it even further which is really great . Will any of this run on TF? It is pretty neat to be sure. My code has too much ASM code for it to work out of the box in TF. I keep TOS cached in R4. But the concepts are valid so just some register re-arranging I think. My efforts were centered on reducing the footprint. 1. Move the saved dictionary pointers to the last cell of each SAMS page. 2. Remove the SAMS stack, use Rstack 3. Change DOCOL to push IP and the SAMS page no. onto Rstack 4. Compile the SAMS EXIT code in SAMS to save dictionary space. 5. simplified map because we predefine where code pages will map. 6. Select only upper SAMS pages for code. The normal RAM dictionary limits how much SAMS code we could actually have unless we create a paged dictionary as well. * Once you lock down a set of SAMS pages for code, it is simple to keep incrementing the SAMS pages as they fill so you don't need to select them at all. : ?FULL ( addr --) SAMSEND > IF CR ." >> Page " CPAGE @ DECIMAL . ." full" \ ABORT CPAGE 1+! THEN ; There are still problems with my version using CREATE DOES>. I think because I have modified the header of every SAMS word to include a page no. and a dictionary pointer, I need a new DODOES for SAMS pages since their PFA is 2 cells further. Not sure I want to go there. To honest I have kept a TF compatible version of your code because yours works seamlessly. Here is a Camel99 Forth version of your code. I made a few consolidations that would be backward compatible I think. Spoiler \ TURBOForth compatible compile to SAMS for Camel99 Jan 2023 Fox \ minor size reductions \ HEADER size = 26 bytes \ Version X1A - sets range of SAMS pages for 64K of CODE SPACE \ HARNESS for CAMEL99 =================================================== NEEDS DUMP FROM DSK1.TOOLS \ debug only NEEDS SAMSINI FROM DSK1.SAMSINI NEEDS VALUE FROM DSK1.VALUES HERE HEX 1000 CONSTANT 4K \ Compute SAMS CARD numbers at compile time. HEX 3000 CONSTANT CSEG \ CPU RAM window for SAMS code 4000 CSEG 0B RSHIFT + CONSTANT CREG \ pre-compute CSEG SAMS register CSEG 0C RSHIFT CONSTANT PASSTHRU \ default page for CSEG window -1 VALUE _BANK \ current bank \ this is smaller than a code word and still quite fast : CMAP ( bank# -- ) \ "code map" SAMSCARD 0SBO \ turn on the card >< CREG ! \ swap bytes & store bank# in SAMS register 0SBZ \ turn off card ; \ GOTO lets us do a direct JUMP to a literal address in the Forth code HEX CODE GOTO ( addr -- ) C259 , ( *IP IP MOV,) NEXT, ENDCODE \ ===================================================================== DECIMAL CREATE _BNKSTK 24 CELLS ALLOT \ bank stack HEX PASSTHRU _BNKSTK ! \ force first entry on bank stack to passthru bank _BNKSTK VALUE _BSP \ pointer into bank stack : >BANK ( BANK -- ) 2 +TO _BSP DUP _BSP ! CMAP ; : BANK> ( -- ) -2 +TO _BSP _BSP @ CMAP ; 0 VALUE HERES[] \ array of "here" addresss for each bank 0 VALUE _NHERE \ "normal" here CREATE CODEPAGES 0 , 0 , \ create un-named array for here pointers in free memory : BANKS ( 1st last -- ) 2DUP CODEPAGES 2! HERE TO HERES[] \ record the start of the array 2DUP 1+ SWAP DO CSEG , \ init "here" for each bank to CSEG LOOP CR SWAP - 1+ 4K UM* UD. ." bytes for SAMS code" CR ; : SAMSDP ( -- addr) _BANK CELLS HERES[] + ; : RAM? ( -- ? ) _BANK -1 = ; : B: ( bank -- ) \ compile a SAMS definition : \ compile this stuff into the new word POSTPONE LIT _BANK , POSTPONE >BANK POSTPONE GOTO SAMSDP @ DUP , \ run this code now HERE TO _NHERE \ save "normal here" DP ! \ set dp to _bank's "here" _BANK CMAP \ map in the CODE bank ; : .BFREE ( -- ) \ determine free memory in the bank... BASE @ >R DECIMAL CSEG 4K + SAMSDP @ - . ." bytes free" CR R> BASE ! ; : ?BFULL ( addr -- ) [ CSEG 0FF0 + ] LITERAL > ABORT" Bank full" ; : ;B ( -- ) \ end banked compilation POSTPONE GOTO _NHERE , HERE DUP ?BFULL SAMSDP ! \ test and update here for bank _NHERE DP ! \ restore dp to "normal" memory POSTPONE BANK> POSTPONE ; ; IMMEDIATE ( had to add immediate for CAMEL99 ) : ?BANK ( n -- ) CODEPAGES 2@ 1+ WITHIN 0= ABORT" Bad code page" ; : SETBANK ( bank -- ) \ sets bank number that will receive colon definitions DUP ?BANK TO _BANK RAM? IF EXIT THEN CR ." Bank " _BANK . SPACE .BFREE ; : : ( -- ) RAM? IF : ELSE B: THEN ; : ; ( -- ) RAM? IF POSTPONE ; ELSE POSTPONE ;B THEN ; IMMEDIATE CR HERE SWAP - DECIMAL CR . .( bytes used ) HERE 240 255 BANKS HERE SWAP - DECIMAL CR . .( bytes for HERE array) And here is where I left off with the alternate version. Have at it. Spoiler \ SAMSCODE.FTH for Camel99 Forth Brian Fox \ Code in SAMS memory based on concept in TurboForth by Mark Wills \ Ported to Camel99 Forth with changes Oct 13, 2021, \ Concept: \ FAR: word headers are in the normal Forth memory space so all SAMS words \ can be found. \ FAR: word data structure has two extra fields \ <link> < HEADER> <imm> <len NAME..> <FARCOL> <BANK#> <IP> \ FAR: compiles a "fat" header that contains SAMS BANK# and SAMS IP \ <LINK> \ <PRECENDCE> \ <NAME> \ <CODEPAGE> \ extra field \ <SAMSPFA> \ extra field \ ;FAR compiles FAREXIT in SAMS memory, not in RAM to save space. \ Compile time check: ;FAR tests end of SAMS memory \ HISTORY \ Update Nov 2022: removed array of SAMS DP variables. \ - Each SAMS page uses last memory cell to hold its own DP. \ - Can now compile code to any SAMS page. \ - You must use <1st> <last> CODEPAGES to initialize SAMS code pages \ Feb 2024: Pass codepage via Rstack to CMAP, FARCOL 1 less instruction \ NEEDS DUMP FROM DSK1.TOOLS NEEDS TRANSIENT FROM DSK1.TRANSIENT NEEDS SAMSINI FROM DSK1.SAMSINI \ common code for SAMS card TRANSIENT NEEDS MOV, FROM DSK1.ASM9900 PERMANENT HERE HEX \ **************[ CHANGE CSEG to your requirements ]****************** HEX 3000 CONSTANT CSEG \ CODE window in CPU RAM \ SAMS memory addresses for code CSEG 0FFE + CONSTANT SAMSDP \ variable at end of SAMS page CSEG 0F00 + CONSTANT SAMSEND \ leave room for scroll buffer 4000 CSEG 0B RSHIFT + CONSTANT CREG \ compute CSEG SAMS register CSEG 0C RSHIFT CONSTANT PASSTHRU \ default RAM page VARIABLE SAVHERE \ temp holder for RAM Dictionary pointer VARIABLE BANK# \ last SAMS bank# selected VARIABLE CPAGE \ active code page used for compiling CREATE CODEPAGES 0 , 0 , \ valid CODEPAGES HEX \ **LEAF SUB-ROUTINE** CREATE R>CMAP ( -- ) ( R: page# -- ) R0 RPOP, R0 BANK# @@ MOV, \ update the last bank used R0 SWPB, \ swap bytes R12 1E00 LI, \ set SAMS card CRU address 0 SBO, \ turn on the card R0 CREG @@ MOV, \ map it 0 SBZ, \ turn off card RT, CODE CMAP ( page# --) \ Forth word to map SAMS pages TOS RPUSH, \ need parameter on Rstack TOS POP, \ refill TOS R>CMAP @@ BL, \ call it NEXT, ENDCODE \ run time executor for SAMS colon words. CREATE FARCOL IP RPUSH, \ save current IP BANK# @@ RPUSH, \ save active code page \ read the extra data fields with W register *W+ RPUSH, \ fetch codepage >R, autoinc W R>CMAP @@ BL, \ call R>CMAP (uses RSTACK parameter) *W IP MOV, \ fetch SAMSDP & set as IP NEXT, CODE FAREXIT \ exit for SAMS word R>CMAP @@ BL, \ restore previous codepage & map it in IP RPOP, \ do normal Forth EXIT NEXT, ENDCODE : FAR: ( -- ) \ special colon for words in FAR memory !CSP HEADER FARCOL , \ compile the new executor as CFA \ compile code page and SAMSDP for FARCOL to use at runtime CPAGE @ DUP , \ compile codepage as the DATA field CMAP \ map in the SAMS page to compile code SAMSDP @ DUP , \ compile SAMSDP & return a copy HERE SAVHERE ! \ save FORTH here DP ! \ set Forth DP to SAMSDP HIDE ] \ turn on the compiler ; HEX : ?FULL ( addr --) SAMSEND > IF CR ." >> Page " CPAGE @ DECIMAL . ." full" \ ABORT CPAGE 1+! THEN ; CODE GOTO ( addr -- ) C259 , ( *IP IP MOV,) NEXT, ENDCODE : ;FAR ( -- ) \ end SAMS compilation. *NEW* compile time memory test POSTPONE FAREXIT \ restore previous page and exit HERE DUP ?FULL SAMSDP ! \ update HERE for this bank, keep a copy SAVHERE @ DP ! \ restore DP to CPU RAM REVEAL ?CSP POSTPONE [ ; IMMEDIATE : CODEPAGE ( samspage -- ) \ select SAMS page for compiling DUP CODEPAGES 2@ 1+ WITHIN 0= ABORT" Not a code page" DUP CPAGE ! CMAP ; HEX \ Initialize the SAMS memory that we want to use for CODE \ ** USE THIS COMMAND ONLY ONCE OR MACHINE WILL CRASH ** : CODEPAGES ( 1st last -- ) 2DUP CODEPAGES 2! 1+ SWAP DO I CODEPAGE I CMAP \ I . CSEG 1000 FF FILL \ for debugging ONLY CSEG SAMSDP ! \ INIT the local CSEG DP variable to start of CSEG LOOP CODEPAGES @ DUP CODEPAGE CMAP \ return to RAM memory page ; : RAM? ( -- ?) BANK# @ PASSTHRU = ; : >SAMS CPAGE @ CMAP ; : >RAM PASSTHRU CMAP ; >RAM : ; RAM? IF POSTPONE ; ELSE POSTPONE ;FAR THEN ; IMMEDIATE : : RAM? IF : ELSE FAR: THEN ; \ DETACH ( remove the assembler) HERE SWAP - DECIMAL CR . .( bytes) 240 255 CODEPAGES \ 16 pages=64K of SAMS space >RAM 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted February 28 Author Share Posted February 28 It Only Took Five Years Way back in 2019 (five years ago OMG) I tried creating interrupt driven RS232 receive for Camel99 Forth on real iron. I leveraged all the work done by the talented people that invented the method of tricking TI-99 into doing this. I used an Assembly language file from @InsaneMultitasker as the starting point. It's as close to magic as I'll ever get. Way stranger than when I was doing the same thing on IBM PCs 30 years ago. The communication worked perfectly once I got my head around it and broke it into Forth words, but it died whenever disk was accessed. I tried lots of stuff could not make it reliable so I gave up and went with polling the port for input and handshaking on every character. Only recently did I get more input from smarter people ( @InsaneMultitasker ) that DSRLINK must handle R15 correctly. DOH! I had stripped my DSRLINK down to save as many bytes as possible and R15 was part of that pruning. So with that fixed I can now show you the version of ISR driven RS232 input that works. In fact it works so well that it compiles code faster than from floppy disk! I have a 94 line catalog program that includes two files. If I send it over RS232 at 19,200 it compiles in 14 seconds. If I load the same thing from floppy drive it takes 17 seconds. One of things that I had to change was how I manage the RTS/CTS handshaking. The method here is: ISR will accept data into the queue until it hits the half-full point At that point the clear-to-send (CTS) line disables further input from the sender. The Queue reader QKEY? reads data out of the queue but does not re-open the CTS line until the queue is empty start over This is, from what I understand, a way to keep data reception reliable and it seems to be true so far. There are a few Camel99isms in this code but a lot of it is transportable to the other Forth systems if it was useful. I am going to remove the need for MALLOC and just put a smaller buffer/queue in the dictionary for simplicity. I can also simplify QKEY? but this is the version that has been running all day without a single incident. Spoiler \ RS232/1 Interrupt Handler for CAMEL99 Forth B Fox Feb 14 2019 \ Feb 2024- make this run on CAMELTTY Forth NEEDS DUMP FROM DSK1.TOOLS \ DEBUG ONLY NEEDS MOV, FROM DSK1.ASM9900 NEEDS TO FROM DSK1.VALUES NEEDS MALLOC FROM DSK1.MALLOC NEEDS FORGET FROM DSK1.FORGET \ MARKER /ISRTTY \ ************************************************************************* \ * Adaptation of Jeff Brown / Thierry Nouspikel (sp) idea to leverage \ * the ROM-based ISR to service external interrupts (RS232 in our case) \ * within the VDP interrupt framework. \ * Based on code by Insanemultitasker ATARIAGE \ Changes: \ Use a 512 buffer (power of 2) for binary wrapping efficiency HEX 83C0 CONSTANT ISRWKSP CARD @ UART @ + CONSTANT COM1 : (R4) R4 () ; \ syntax sugar for Forth Assembler \ ************************************************************ \ Queue pointers, Initialized during setup VARIABLE QHEAD VARIABLE QTAIL \ simple circular Q management 0 VALUE Q \ holds Q base address 0 VALUE QSIZE 0 VALUE QMASK \ circular mask value \ build a queue in low RAM and set all the pointers : QUEUE ( size -- ) \ must be power of 2 DUP MALLOC TO Q \ set address of Q DUP TO QSIZE 1- TO QMASK QHEAD OFF \ clear the head QTAIL OFF ; \ clear the tail : QCLEAR Q QSIZE 0 FILL QHEAD OFF QTAIL OFF ; HEX 200 QUEUE \ 512 byte queue \ ************************************************************ \ * QKEY? - Read character from 'Q' at index 'QHEAD' HEX CODE QKEY? ( -- c | 0 ) \ 0 means queue empty TOS PUSH, \ make space in the TOS cache register TOS CLR, \ FLAG to say no char ready QHEAD @@ QTAIL @@ CMP, NE IF, \ head<>tail means char waiting QHEAD @@ W MOV, \ get queue head index to W Q (W) TOS MOVB, \ get char from Q -> TOS TOS SWPB, \ move to other side of register W INC, \ inc the index W QMASK ANDI, \ wrap the index W QHEAD @@ MOV, \ save the new index ENDIF, QHEAD @@ QTAIL @@ CMP, EQ IF, \ ONLY if Q is empty send Clear to send CARD @@ R12 MOV, \ select the card 5 SBZ, \ set -CTS line LOW ENDIF, NEXT, ENDCODE \ ************************************************************** \ * ISR is in workspace 83C0. ONLY R3 & R4 are free to use!!! DECIMAL CREATE TTY1-ISR ( *isr with hardware handshake * ) ISRWKSP LWPI, \ 10 R12 CLR, \ select 9901 chip CRU address \ 10 2 SBZ, \ Disable VDP int prioritization \ 12 R11 SETO, \ 3.5.16 hinder screen timeout \ 10 R12 COM1 LI, \ faster \ 12 QTAIL @@ R4 MOV, \ Queue tail pointer ->R4 \ 22 16 TB, \ interrupt received? \ 12 EQ IF, \ Yes; enqueue char \ 10 Q (R4) 8 STCR, \ read byte into Q \ 52 \ *** manage Queue pointer *** R4 INC, \ bump the index 10 R4 QMASK ANDI, \ wrap the index 14 R4 QTAIL @@ MOV, \ save index in QTAIL 22 \ *** test buffer status *** QHEAD @@ R4 SUB, \ R4 has Qtail 22 R4 ABS, \ R4 has byte count in Q 12 R4 QSIZE 2/ CI, \ 1/2 full? 14 GTE IF, \ 10 \ we can change CTS line by using a negative bit value -27 SBO, \ CTS line HIGH. I am busy! 12 ENDIF, ENDIF, 18 SBO, \ clr rcv buffer, enable interrupts 12 R12 CLR, \ select 9901 chip CRU address 10 3 SBO, \ reset timer int 12 RTWP, \ Return 14 \ 314 \ ******************************************************************* \ * Configure ROM ISR to pass through external interrupts as VDP interrupts \ * (Jeff Brown/Thierry) HEX \ get address Forth's tos register (R4) so we can transfer ISR handler \ to the ISR workspace 8300 4 CELLS + CONSTANT 'TOS CODE INSTALL ( ISR_address -- ) \ TOS HANDLER @@ MOV, 0 LIMI, 83E0 LWPI, \ select GPL workspace R14 CLR, \ Disable cassette interrupt; protect 8379 R15 877B LI, \ disable VDPST reading; protect 837B ISRWKSP LWPI, \ switch to ISR workspace R1 SETO, \ [83C2] Disable all VDP interrupt processing 'TOS @@ R2 MOV, \ [83C4] set our interrupt vector from Forth R4 R11 SETO, \ Disable screen timeouts R12 CLR, \ Set to 9901 CRU base BEGIN, 2 TB, \ check for VDP int NE UNTIL, \ loop until <> 0 1 SBO, \ Enable external interrupt prioritization 2 SBZ, \ Disable VDP interrupt prioritization 3 SBZ, \ Disable Timer interrupt prioritization 8300 LWPI, \ return to the FORTH WS TOS POP, \ refill stack cache register 2 LIMI, \ 3.2 [rs232 ints now serviced!] NEXT, \ and return to Forth ENDCODE DECIMAL CODE ISRON ( uart -- ) \ * Turn on the 9902 interrupts 0 LIMI, TOS R12 MOV, 18 SBO, \ Enable rs232 RCV int TOS POP, 2 LIMI, NEXT, ENDCODE CODE ISROFF ( uart -- ) \ * Turn off the 9902 interrupts 0 LIMI, TOS R12 MOV, \ i.e., >1340 18 SBZ, \ Disable rs232 rcv int TOS POP, 2 LIMI, NEXT, ENDCODE : ISR-I/O QCLEAR \ reset Queue pointers, erase data KEY? DROP \ clear any char from 9902 COM1 ISROFF \ just to be safe TTY1-ISR INSTALL ['] QKEY? >BODY ['] KEY? ! \ patch KEY?' to read the queue COM1 ISRON ; 3 Quote Link to comment Share on other sites More sharing options...
D-Type Posted February 28 Share Posted February 28 Great achievement! It's been 25+ years since I programmed ring buffers. For my Vectrex running CamelForth 6809 I used a UM245R, which connects to USB, has built-in Tx/Rx buffers and a Data Available signal that the CPU polls via a 6522 VIA. The KEY, KEY? and EMIT code words are just half a dozen instructions and it can DUMP the full 64K address space to TeraTerm in a couple of seconds. In fact it's so fast that the 1.5MHz 6809 can't actually overflow the buffer! Quote Link to comment Share on other sites More sharing options...
+TheBF Posted February 28 Author Share Posted February 28 6 minutes ago, D-Type said: Great achievement! It's been 25+ years since I programmed ring buffers. For my Vectrex running CamelForth 6809 I used a UM245R, which connects to USB, has built-in Tx/Rx buffers and a Data Available signal that the CPU polls via a 6522 VIA. The KEY, KEY? and EMIT code words are just half a dozen instructions and it can DUMP the full 64K address space to TeraTerm in a couple of seconds. In fact it's so fast that the 1.5MHz 6809 can't actually overflow the buffer! Thanks Phil. Wow! That pretty neat. I remember years ago when one of our hardware engineers mentioned these FIFO chips to me. I thought, that's cheating. It's fun to finally have this thing working. It was painful pasting large files into the terminal with 1mS per character delay. I could not get Teraterm to wait for the echo back from Forth, which would have been way faster. Anyway there's more than one way to skin cats. 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted February 29 Author Share Posted February 29 I did some experiments to see how small I could make the queue buffer. I reduced in steps down to 64 bytes, which means it fills up to 32 bytes with 32 more for over runs in case the sender doesn't recognize the handshake fast enough. The TI did not drop one character. The video shows it compiling a pretty large file over the terminal with the small buffer. Here is what I will call a final version. It has greatly simplified Q creation and a few instructions less. BTW I tried writing QKEY? in Forth and it is a few bytes bigger. I have to make a good machine Forth using the power of the 9900 inline code. Spoiler \ RS232/1 Interrupt Handler for CAMEL99 Forth B Fox Feb 14 2019 \ Feb 2024- make this run on CAMELTTY Forth NEEDS DUMP FROM DSK1.TOOLS \ DEBUG ONLY NEEDS MOV, FROM DSK1.ASM9900 \ ************************************************************************* \ * Adaptation of Jeff Brown / Thierry Nouspikel (sp) idea to leverage \ * the ROM-based ISR to service external interrupts (RS232 in our case) \ * within the VDP interrupt framework. \ * Based on code by Insanemultitasker ATARIAGE \ Changes: HEX 83C0 CONSTANT ISRWKSP CARD @ UART @ + CONSTANT COM1 : (R4) R4 () ; \ syntax sugar for Forth Assembler \ ************************************************************ \ simple circular Q management 40 CONSTANT QSIZE QSIZE 1- CONSTANT QMASK \ circular mask value CREATE Q ( -- addr) QSIZE CELL+ ALLOT \ Queue pointers VARIABLE QHEAD VARIABLE QTAIL : QCLEAR Q QSIZE 0 FILL QHEAD OFF QTAIL OFF ; \ ************************************************************ \ * QKEY? - Read character from 'Q' at index 'QHEAD' HEX CODE QKEY? ( -- c | 0 ) \ 0 means queue empty TOS PUSH, \ make space in the TOS cache register TOS CLR, \ FLAG to say no char ready QHEAD @@ QTAIL @@ CMP, NE IF, \ head<>tail means char waiting QHEAD @@ W MOV, \ get queue head index to W Q (W) TOS MOVB, \ get char from Q -> TOS TOS SWPB, \ move to other side of register W INC, \ inc the index W QMASK ANDI, \ wrap the index W QHEAD @@ MOV, \ save the new index ELSE, \ queue is empty... CARD @@ R12 MOV, \ make sure to select the card 5 SBZ, \ set -CTS line LOW to get more data ENDIF, NEXT, ENDCODE \ ************************************************************** \ * ISR is in workspace 83C0. ONLY R3 & R4 are free to use!!! DECIMAL CREATE TTY1-ISR ( *isr with hardware handshake * ) ISRWKSP LWPI, \ 10 R12 CLR, \ select 9901 chip CRU address \ 10 2 SBZ, \ Disable VDP int prioritization \ 12 R11 SETO, \ 3.5.16 hinder screen timeout \ 10 R12 COM1 LI, \ select card1+uart1 \ 12 QTAIL @@ R4 MOV, \ Queue tail pointer ->R4 \ 22 16 TB, \ interrupt received? \ 12 EQ IF, \ Yes; enqueue char \ 10 Q (R4) 8 STCR, \ read byte into Q \ 52 \ *** manage Queue pointer *** R4 INC, \ bump the index 10 R4 QMASK ANDI, \ wrap the index 14 R4 QTAIL @@ MOV, \ save index in QTAIL 22 \ *** test buffer status *** QHEAD @@ R4 SUB, \ R4 has Qtail 22 R4 ABS, \ R4 has byte count in Q 12 R4 QSIZE 2/ CI, \ 1/2 full? 14 GTE IF, \ 10 \ we can change CTS line by using a negative bit value -27 SBO, \ CTS line HIGH. I am busy! 12 ENDIF, ENDIF, 18 SBO, \ clr rcv buffer, enable interrupts 12 R12 CLR, \ select 9901 chip CRU address 10 3 SBO, \ reset timer int 12 RTWP, \ Return 14 \ 104.6 uS 314 \ ******************************************************************* \ * Configure ROM ISR to pass through external interrupts as VDP interrupts \ * (Jeff Brown/Thierry) HEX \ get address Forth's tos register (R4) so we can transfer ISR handler \ to the ISR workspace 8300 4 CELLS + CONSTANT 'TOS CODE INSTALL ( ISR_address -- ) 0 LIMI, 83E0 LWPI, \ select GPL workspace R14 CLR, \ Disable cassette interrupt; protect 8379 R15 877B LI, \ disable VDPST reading; protect 837B ISRWKSP LWPI, \ switch to ISR workspace R1 SETO, \ [83C2] Disable all VDP interrupt processing 'TOS @@ R2 MOV, \ [83C4] set our interrupt vector from Forth R4 R11 SETO, \ Disable screen timeouts R12 CLR, \ Set to 9901 CRU base BEGIN, 2 TB, \ check for VDP int NE UNTIL, \ loop until <> 0 1 SBO, \ Enable external interrupt prioritization 2 SBZ, \ Disable VDP interrupt prioritization 3 SBZ, \ Disable Timer interrupt prioritization 8300 LWPI, \ return to the FORTH WS TOS POP, \ refill stack cache register 2 LIMI, \ 3.2 [rs232 ints now serviced!] NEXT, \ and return to Forth ENDCODE DECIMAL CODE ISRON ( uart -- ) \ * Turn on the 9902 interrupts 0 LIMI, TOS R12 MOV, 18 SBO, \ Enable rs232 RCV int TOS POP, 2 LIMI, NEXT, ENDCODE CODE ISROFF ( uart -- ) \ * Turn off the 9902 interrupts 0 LIMI, TOS R12 MOV, \ i.e., >1340 18 SBZ, \ Disable rs232 rcv int TOS POP, 2 LIMI, NEXT, ENDCODE : ISR-I/O QCLEAR \ reset Queue pointers, erase data KEY? DROP \ clear any char from 9902 COM1 ISROFF \ just to be safe TTY1-ISR INSTALL ['] QKEY? >BODY ['] KEY? ! \ patch KEY?' to read the queue COM1 ISRON ; CR .( Intalling ISR on port TTY1 ...) ISR-I/O CR .( ISR recieve enabled) CR COM1_19200bps - TI-99 VT100 VT 2024-02-28 23-19-03.mp4 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 3 Author Share Posted March 3 You know it's a wonder I don't have a much flatter forehead. I was thinking about how to transfer binary data over RS232 now that I have this reliable com port receiver. I realized that the way I implement KEY? would be a problem because my version tests for a key and returns the ASCII value pressed OR returns a zero if no key was pressed. But binary data can contain zeros. So I started wondering how does Forth handle that? I went to the Standard and see this: 10.6.1.1755 KEY? key-question ( -- flag ) If a character is available, return true. Otherwise, return false. Oops! I implemented this incorrectly. KEY? is just the test. KEY is what reads the character. I thought I would be "efficient" and while I was checking, just read the character as well. By using KEY? and KEY together you can collect binary data no problem. If you do it my way... not so much. Time for some kernel fixing. 2 Quote Link to comment Share on other sites More sharing options...
D-Type Posted March 3 Share Posted March 3 (edited) On 2/28/2024 at 9:12 PM, TheBF said: Thanks Phil. Wow! That pretty neat. I remember years ago when one of our hardware engineers mentioned these FIFO chips to me. I thought, that's cheating. It's fun to finally have this thing working. It was painful pasting large files into the terminal with 1mS per character delay. I could not get Teraterm to wait for the echo back from Forth, which would have been way faster. Anyway there's more than one way to skin cats. Ha! Not only does the Vectrex have no available IRQ lines to use, it also has 1k of RAM, some of which is used by the BIOS, so adding ring buffers to the stack, pad etc. wouldn't leave you with much dictionary space, there's only ~#750 bytes as it is, from memory. Thus cheating is permissable! 🙂 Here are my Forth and equivalent assembly I/O words (pics). Edited March 3 by D-Type 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 3 Author Share Posted March 3 That makes for nice light work for the Forth system. Very nice. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 4 Author Share Posted March 4 I promise I didn't pay anybody but Camel99 Forth is listed among the systems at the Forth Standard site. I believe it may be because I joined a Forth group on Github and Lars Brinkhof probably stuck the link in the list. ?? Systems (forth-standard.org) The things that can happen on the interweb with these kids nowadays. 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 4 Author Share Posted March 4 Part of the innards of a Forth system is some way to "parse" through source, extracting one space delimited word at a time. Traditionally this was done with BL WORD. Looks simple but if you peek behind on the curtain on any Forth system there is fair bit of code behind WORD. Here is a modern way to code PARSE-NAME that I found on the Forth Standard site. PARSE-NAME is what they use these days instead of BL WORD. This code is note-worthy to me because of the word XT-SKIP which is like SKIP but instead of testing for a character match, XT-SKIP runs a piece of code so it can compare any range of characters. In this case any character less than a space is white space and anything not white space is a valid character but we could put any code in there. This appears to be a lot less code than I used in CAMEL99 Forth but on the other hand I have WORD PARSE and PARSE-WORD and I make PARSE-NAME with: : PARSE-NAME BL PARSE-WORD ; Anyway I thought some folks might want to see how modern languages are influencing Forth thought leaders and how Forth can replicate those "mapping" features without much trouble. (this code compiles on Camel99 FORTH) \ PARSE-NAME from https://forth-standard.org/standard/core/PARSE-NAME : white? ( c -- f ) BL 1+ U< ; \ space and below are white chars : -white? ( c -- f ) white? 0= ; \ everything above are not : xt-skip ( addr1 n1 xt -- addr2 n2 ) \ skip all characters satisfying xt ( c -- f ) >R BEGIN DUP WHILE OVER C@ R@ EXECUTE WHILE 1 /STRING REPEAT THEN R> DROP ; : PARSE-NAME ( "name" -- c-addr u ) SOURCE >IN @ /STRING ['] white? xt-skip OVER >R ['] -white? xt-skip ( -- end-word restlen) ( r: start-word ) 2DUP 1 MIN + SOURCE DROP - >IN ! DROP R> TUCK - ; 1 Quote Link to comment Share on other sites More sharing options...
D-Type Posted March 4 Share Posted March 4 (edited) On 2/29/2024 at 5:23 AM, TheBF said: The TI did not drop one character. The video shows it compiling a pretty large file over the terminal with the small buffer. COM1_19200bps - TI-99 VT100 VT 2024-02-28 23-19-03.mp4 That looks like a very usable compilation, faster than my CamelForth 6809, though I do have 100+ extra BIOS interface words in the dictionary. I have an end of line delay inserted to get a reliable compile over serial. I have no optimisations yet for the dictionary, because I don't code on the target, only debug, but I have looked into removing headers and replacing with a minimal perfect hash for the pre-compiled dictionary words, which could make compilation a magnitude quicker. I reckon the hashes would take up less space than the headers, I don't have SEE and don't really have need for it, so hashed names would work fine. The gotcha then is how do you know if the word you're using interactively is in the dictionary? You don't, but I don't think that's a big issue and I figure you could make a recognizer that would override the dictionary search, maybe an underscore at the start of the word for all hashed words, it is only for interactive use, after all. Alternatively, there are techniques for storing a dictionary in the lowest number of characters, but then you're back to using more ROM space and slowing things down again. Always compromises! Edited March 4 by D-Type Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 4 Author Share Posted March 4 When I first got the system running it compiled very slowly. I did a little test typing 1 to 9 with a space between each digit and hitting enter. This was a worst case search and it was something like 3 or 4 seconds. I wrote (FIND) in Assembler and the same test takes just under 1 second. Brad made Camel Forth for small size so somethings suffer. Interesting stuff on the hashing. PolyForth used to limit the dictionary to the length, three characters and a hash value for the rest. I can't remember the details but that was for compact size. F83 created 4 search threads and put each word in a different thread by hashing the 1st character. This speeds up the average search time by 4. Forth Inc. uses 8 search threads. I have considered doing a 4 way hashed dictionary. I did make a hash table of the entire dictionary to compare search times using only Forth code and it was 3 times faster than what I have now. Hashing is amazing when you find the right one. 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 14 Author Share Posted March 14 Continuing to review library files and I found something that was incomplete so I fixed it. Turbo Forth and FbForth have DATA[ ]DATA directives. I have made something that makes it easier to port projects with those words into Camel99 Forth. FbForth can handle comments in between DATA[ and ]DATA. The simplest way for me to handle that is to make new interpreter loop and plug it into the interpreter vector 'IV. So here is the result in 192 170 bytes. HERE \ simplified interpreter loop : (DATA) ( i*x c-addr u -- j*x ) 'SOURCE 2! >IN OFF BEGIN BL WORD DUP C@ ( -- addr len) WHILE FIND IF ( it's a word) EXECUTE ELSE ( it's a number: compile it) COUNT NUMBER? ?ERR , THEN DEPTH 0< ABORT" DATA: underflow" REPEAT DROP ; : DATA[ ( -- addr) ?COMP ['] (DATA) 'IV ! HERE ; : ]DATA ( -- addr len ) HERE OVER - ['] <INTERP> 'IV ! ; : 2CONSTANT ( d -- ) CREATE , , DOES> 2@ ; HERE SWAP - DECIMAL . .( bytes) \ Example \ HEX \ DATA[ \ 0018 1818 3C7E 7E42 \ we can include comments \ 427E 7E3C 1818 1800 \ 0007 0E7E 7E0E 0700 \ 00E0 707E 7E70 E000 \ ]DATA 2CONSTANT SCHOONERS 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 19 Author Share Posted March 19 So I started work on an Xmodem transfer system for my Forth the runs over RS232, inspired by the work of @Vorticon. The low level primitive I created to read the RS232 port is CKEY? which returns a character OR zero. See the problem. If you send it a binary "0" you don't know you have it. So I have to recompile the kernel. There are a number of ways to do this. KEY? in ANS Forth is just supposed to ONLY return a flag to indicate that a character is available or not, so I broke the rule. But in a polled communication you want to grab the character and save it so you don't miss it. I tried having CKEY? return a character and a FLAG. ( -- char ?) That works ok but is not standard. I hate wasting memory for such a trivial thing but I guess I will have to make a key buffer. One thing I can do is make sure that STCR puts the byte on the correct side of a 2 byte variable so I can fetch it with @ which is faster that C@. So on it goes. Edit: Change of heart. I will keep CKEY? ( -- char ?) but also define KEY? to keep compliant. : KEY? ( -- ?) CKEY? NIP ; 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 20 Author Share Posted March 20 So when you run Forth over RS232 and are trying to debug an XMODEM connection on the same RS232 channel you have a problem. But... I have the VDP screen just sitting there so I made an alternate set of Forth I/O words that talk to VDP but with no scrolling for simplicity. With these you can output stuff to the other screen to seen what's happening. CR .( TMS9918 driver in Forth for debugging TTY code) NEEDS MARKER FROM DSK1.MARKER HERE MARKER /VDPIO DECIMAL VARIABLE COL VARIABLE ROW : >VADDR ( col row -- Vaddr) 32 * + ; : /AT-XY ( col row -- ) ROW ! COL ! ; \ wrap to top of screen : COL+! ( n -- ) COL @ + DUP 768 > IF DROP COL OFF EXIT THEN COL ! ; : ROW+! ( n -- ) ROW @ + DUP 23 > IF DROP ROW OFF EXIT THEN ROW ! ; \ renamed versions to avoid name conflicts : /EMIT ( c --) COL @ ROW @ >VADDR VC! 1 COL+! ; : /SPACE BL /EMIT ; : /SPACES 0 MAX 0 ?DO /SPACE LOOP ; : /CR ( -- ) 1 ROW+! COL OFF ; : /TYPE ( addr len -- ) BOUNDS DO I C@ /EMIT LOOP ; : /. ( n -- ) (.) /TYPE /SPACE ; : /PAGE 0 768 BL VFILL 0 0 /AT-XY ; HERE SWAP - DECIMAL . .( bytes) \ 350 bytes /PAGE S" VDP debug language loaded" /TYPE 3 Quote Link to comment Share on other sites More sharing options...
+Vorticon Posted March 20 Share Posted March 20 You've got to love Forth's flexibility. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 20 Author Share Posted March 20 1 hour ago, Vorticon said: You've got to love Forth's flexibility. Ya it makes everything else feel like a straight-jacket. But I think it's harder to get things done at least in the beginning. Once you have your domain specific language working then it's fun. At least that's how my brain works. 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 28 Author Share Posted March 28 I have something working that has me quite excited. I knew it was possible but I couldn't quite get my brain around it for all this time. The idea is to leverage the ANS Forth "wordlist" system, used to implement vocabularies, to make "overlays" ( and in future SAMS modules) Overlays will let you have pre-compiled blocks for code for a specific purpose on disk, that you can bring into the system quickly. This is similar to the BSAVE/BLOAD function in FbForth. In ANS/ISO Forth each vocabulary is a "stand-alone" dictionary that ends with a null string. ( a zero) The way you add them to the search is by putting them in short list of other vocabularies. Forth then searches those lists one at a time, in the order you placed them. The commands to control the search order are: ONLY which clears the search order to a short list of words and FORTH ALSO which ads vocabularies to the search-order list. For example, the following commands put the vocabularies called FORTH, EDITOR, ASSEMBLER and MYSTUFF into the search list, in the reverse order that you read them. (of course. It's Forth. It's kind of like a stack of wordlists, last one is on top) ONLY FORTH ALSO EDITOR ALSO ASSEMBLER ALSO MYSTUFF If we added the word DEFINITIONS then all new definitions that we make would compile into MYSTUFF. What I wanted was a way to make a vocabulary that worked just like the normal ANS version but the wordlist and Forth code lived in Low RAM. When invoked this overlay vocabulary has to put itself in the search order but then also save the Forth dictionary pointer and switch it to the dictionary in LOW RAM. Doing that meant I had to revisit wordlists and really understand how all this stuff works and I finally got it. The overlay "vocabulary" is called OVERLAY. Here is the very "green" code Spoiler \ OVERLAY.FTH Mar 27 2024 Brian Fox \ With limited memory TI-99 can benefit from more program space \ wordlist overlays create an external dictionary that works like a wordlist. \ ANS Forth wordlists are separate from the main dictionary. \ They are used by putting them into the search order with the word ALSO. \ We removed them from the dictionary with PREVIOUS NEEDS .S FROM DSK1.TOOLS NEEDS LOAD-FILE FROM DSK1.LOADSAVE NEEDS MARKER FROM DSK1.MARKER NEEDS VOCABULARY FROM DSK1.WORDLISTS HERE MARKER /OVERLAYS \ How it works. \ OVERLAY creates a data structure like a wordlist but in LOW RAM \ It has extra fields at the end to remember the DP of the overlay and the file name \ This structure is copied into the 1st 4 cells of low RAM so that \ the structure is saved in the overlay image file. \ HEX ( ** Overlay memory structure ** ) \ 2000: <OL-NFA> , <WIDLINK> , <OL-NAME> , <OL-DP> \ header \ 2008: <10> "DSK1.EDITOR" \ 2020: <1st-nfa> , <1st-dp> ... \ A helper : FIELD: DUP CONSTANT CELL+ ; \ OVERLAY HEADER DATA RECORD 32 bytes HEX 2000 \ base address of overlay header \ 1st 3 fields same as wordlst FIELD: OL-WID FIELD: OL-LINK FIELD: OL-NAME \ additional fields FIELD: OL-DP FIELD: OL-PATH 16 + ( 16 BYTES for path string ) FIELD: OL-DICTIONARY \ Forth code starts at >2020) DROP HEX \ set up the fields in the overlay header to look like a word list : INIT-OVERLAY ( -- wid) OL-WID 20 0 FILL OL-DICTIONARY OL-WID ! \ field0: nfa of last word in wordlist WID-LINK @ OL-LINK ! \ field1: link to previous wordlist DUP WID-LINK ! \ 0000 OL-NAME ! \ field2: name of this wordlist OL-DICTIONARY CELL+ OL-DP ! \ field3: DP of this OVERLAY OL-PATH OFF \ null file path string ; VARIABLE OLD-DP VARIABLE OLD-LATEST : SAVE-DICTIONARY DP @ OLD-DP ! LATEST @ OLD-LATEST ! ; : CHANGE-DICTIONARY OL-DP @ DP ! OL-WID @ LATEST ! ; \ OVERLAY creates and overlay word that puts itself in the search order \ saves the current dictionary pointers and changes to the overlay memory dictionary \ FUTURE: \ - This word could take a different data structure address as an argument \ - This word could test if the correct overlay is loaded and pull it in. : OVERLAY: CREATE INIT-OVERLAY OL-WID , LATEST @ OL-NAME ! \ updata header NFA DOES> @ SET-CONTEXT SAVE-DICTIONARY CHANGE-DICTIONARY ; OVERLAY: OVERLAY \ strange but we made an overlay called OVERLAY \ *************** DISK FUNCTIONS ***************** \ read/write RAM image to/from disk \ dsk1.loadsave library contains the following words: \ save binary image in VDP RAM to DISK \ : SAVE-FILE ( file$ len VDPaddr size mode -- ) \ read binary image from disk into VDP RAM \ : LOAD-FILE ( file$ len VDPaddr count mode -- ) \ PRE-FAB file access mode selectors for binary file read/write \ 0B CONSTANT W/O100 \ WRITE ONLY, binary, relative, fixed >100 \ 0D CONSTANT R/O100 \ READ ONLY, binary, relative, fixed >100 HEX 1000 CONSTANT VBUFF 1000 CONSTANT 4K : SAVE-SIZE ( -- ) DP @ DUP OL-DP ! H ! ; \ update low ram usage in header & H : OLSIZE OL-DP @ 2000 - ; : SAVE-OVERLAY ( file$ u --) 2DUP OL-PATH PLACE \ put the file name in the overlay header SAVE-SIZE 2000 VBUFF OLSIZE VWRITE \ move OVERLAY from RAM to VDP RAM 1000 OLSIZE W/O100 SAVE-FILE ; \ save VDP RAM to file : LOAD-OVERLAY ( file$ u --) VBUFF 4K R/O100 LOAD-FILE \ load file to VDP RAM VBUFF 2000 4K VREAD ; \ transfer VDP RAM to CPU RAM HERE SWAP - DECIMAL . .( bytes) The video shows it in action. 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 4 Author Share Posted April 4 I found a Forth system on my disk that I had kept since I don't know when. It is from 1991, called ZenForth, by Martin Tracy. I has this definitions to read keys into memory without echo. : (keys) ( a +n) >R 0 ( a o) \ read upto +n chars into address without echo; stop at #EOL BEGIN DUP R@ < WHILE KEY DUP #EOL = IF R> 2DROP DUP >R ( early out) ELSE BL MAX >R 2DUP + R> SWAP C! 1+ THEN REPEAT SPAN ! R> 2DROP ; I found this to be hard to understand and wondered could it be simpler. Here is what I came up with. \ Like ACCEPT but no echo nor backspace : KEYS ( a +n -- n ) TUCK ( -- n a n) BEGIN DUP WHILE KEY DUP 13 <> WHILE \ BL MAX \ optional character filtration 2 PICK C! \ store key 1 /STRING \ move to next address, dec count REPEAT DROP \ drop the 'cr' THEN NIP - ; 19 words versus 28 Forth words (I removed the BL MAX from mine so we could remove it from Martin's version) Now to be fair Martin could not do multiple WHILE statements in ZenForth and I am not sure the the clever word /STRING was on the scene yet. Amazing what can happen in 33 years with a "dead" language. 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 9 Author Share Posted April 9 When you see Forth code written by a master it's always an eye-opener to me. Here is number convertor written by Mitch Bradley for his CForth which is a Forth system based on his Open Firmware. Open Firmware is a byte-code Forth that was used to boot Apple Power PC computers and Sun workstations. I think some Linux distros use it too. Mitch has been writing Forth a looooong time. I made one of these and it was only for HEX and used way more code. I am putting this on in my system with the license info. EDIT: I have to find out what COMPILE-WORD does in Cforth. Spoiler The following license terms apply to the FirmWorks C Forth system contained in this directory tree. ----------------------------------------------------------------- Copyright (c) 2008 FirmWorks Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. \ -------------------- \ H# ( "hexnumber" -- n ) \ Get the next word in the input stream as an unsigned hex \ single-number literal. (Adopted from Open Firmware.) \ Temporary hex, and temporary decimal. "h#" interprets the next word \ as though the base were hex, regardless of what the base happens to be. \ "d#" interprets the next word as though the base were decimal. \ "o#" interprets the next word as though the base were octal. \ "b#" interprets the next word as though the base were binary. DECIMAL : #: \ name ( base -- ) \ Define a temporary-numeric-mode word CREATE , IMMEDIATE DOES> BASE @ >R @ BASE ! PARSE-WORD COMPILE-WORD R> BASE ! ; 16 #: H# \ Hex number 10 #: D# \ Decimal number 8 #: O# \ Octal number 2 #: B# \ Binary number Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 10 Author Share Posted April 10 In the mean time... I finally got something working that I knew was possible but I just didn't get all the pieces right before now. Maybe I am still learning... Long ago I made a "language" to write music as text where notes are Forth words that know how to play themselves. I added an "expression" feature where you could set how the music was played as in legato (notes connected) staccatto (notes are separated) etc. It has dynamics to control the volume. You can set the time signature. (I don't have a key signature feature and that might just make it more complicated) And you can use ||: <music notes> :|| to cause a section to repeat which is like real music notation. The fractions select the note type. quarter-note, half-note, eighth-note etc. Here is Twinkle Twinkle Little Star in the key of A major. : TWINKLE 120 BPM SOPRANO 4/4 NORMAL forte | 1/4 A4 A4 E5 E5 | F#5 F#5 1/2 E5 | | 1/4 D5 D5 C#5 C#5 | B4 B4 1/2 A4 | mf | 1/4 E5 E5 D5 D5 | C#5 C#5 1/2 B4 | | 1/4 E5 E5 D5 D5 | C#5 C#5 1/2 B4 | ff | 1/4 A4 A4 E5 E5 | F#5 F#5 1/2 E5 | | 1/4 D5 D5 C#5 C#5 | B4 B4 1/2. A4 || ; Anyway that was the easy part. The hard part was that I could never write three parts (melody, harmony, bass for example) and have them all play via the multi-tasker. They would always run out of sync. But this week I finally got it. The secret was something I had tried before but over-complicated it a bit. The idea is to let an interrupt service routine do the timing of the notes and automagically "mute" the sound channel when its timer has expired. The 2nd helpful thing was to send all the sound bytes for each voice un-interrupted for each voice, meaning don't put a PAUSE in between which changes tasks. Then a DELAY function that waits in a loop calling PAUSE to give the other voices time. This helped keep everything synchronized. Here is the code for the four muting isr timers Spoiler NEEDS DUMP FROM DSK1.TOOLS NEEDS MOV, FROM DSK1.ASM9900 HERE DECIMAL \ isr timer workspace is called MASTER CREATE MASTER 16 CELLS ALLOT MASTER 16 CELLS 0 FILL \ register allocation for 4 TIMER workspace \ R0 MASTER CLOCK \ R1 DECREMENTER \ R2 DECREMENTER \ R3 DECREMENTER \ R4 DECREMENTER \ R5 MUTE1 value ( used instead of variable) \ R6 MUTE2 value \ R7 MUTE3 value \ R8 MUTE4 value HEX \ Declare timer status registers as constants \ Use them just like normal variables in Forth. (9900 special feature) : REGISTER: DUP CONSTANT CELL+ ; \ enumerator MASTER REGISTER: T0 REGISTER: T1 \ Soprano voice timer REGISTER: T2 \ Alto voice timer REGISTER: T3 \ Tenor voice timer REGISTER: T4 \ Noise voice timer REGISTER: MUTE1 REGISTER: MUTE2 REGISTER: MUTE3 REGISTER: MUTE4 : WAIT ( timer -- ) BEGIN DUP @ WHILE PAUSE REPEAT DROP ; : RESET-TIMERS ( -- ) \ preload the workspace :-) T1 OFF T2 OFF T3 OFF T4 OFF \ mute values kept in registers 9F00 MUTE1 ! BF00 MUTE2 ! DF00 MUTE3 ! FF00 MUTE4 ! ; HEX CREATE TIMERISR ( -- address) MASTER LWPI, R0 DEC, \ continous counter for future \ Soprano timer R1 0 CI, NE IF, R1 DEC, EQ IF, R5 8400 @@ MOVB, \ mute the channel ENDIF, ENDIF, \ Alto timer R2 0 CI, NE IF, R2 DEC, EQ IF, R6 8400 @@ MOVB, \ mute the channel ENDIF, ENDIF, \ Tenor timer R3 0 CI, NE IF, R3 DEC, EQ IF, R7 8400 @@ MOVB, \ mute the channel ENDIF, ENDIF, \ Noise timer R4 0 CI, NE IF, R4 DEC, EQ IF, R8 8400 @@ MOVB, \ mute the channel ENDIF, ENDIF, 83E0 LWPI, RT, HEX : INSTALL ( sub-routine -- ) 83C4 ! ; : COLD 0 INSTALL COLD ; \ disable interrupts before restarting Forth HERE SWAP - . .( bytes) RESET-TIMERS TIMERISR INSTALL Here is a descant and bassline for Twinkle Spoiler : DESCANT 120 BPM ALTO 4/4 LEGATO mf | 1/8 A3 C#4 B3 A3 E4 A3 C#4 E4 | | F#4 A4 G#4 F#4 E4 A3 C#4 E4 | | D4 F#4 E4 D4 C#4 E4 D4 C#4 | | B3 A4 B4 F#4 E4 F#4 E4 F#4 | piano | C#4 E4 C#4 E4 D4 E4 D4 E4 | | C#4 E4 C#4 E4 D4 B3 D4 E4 | | C#4 E4 C#4 E4 D4 E4 D4 E4 | | C#4 E4 C#4 E4 D4 B3 D4 E4 | forte | A3 C#4 B3 A3 E4 A3 C#4 E4 | | F#4 A4 G#4 F#4 E4 A3 C#4 E4 | | D4 F#4 E4 D4 C#4 E4 D4 C#4 | | B3 E4 F#4 G#4 A4 G#4 1/2 C#4 || ; : BASSLINE 120 BPM TENOR 4/4 MARCATO forte | 1/2 A2 C#3 | D3 A2 | | E3 A2 | E3 A2 | piano | 1/4 A2 A2 D3 D3 | E3 E3 1/2 E3 | | 1/4 A2 A2 D3 D3 | E3 E3 1/2 E3 | ff | 1/2 A2 C#3 | D3 A2 | | E3 A2 | E3 1/2. A2 || ; And here is what happens when you run the Forth words in three separate tasks. Twinkle Music script.mp4 Here is the music script player code Spoiler \ music lexicon to control the TMS9919 with ISR timers Apr 2024 B Fox \ ********************************************************************** \ music code MUST be assigned to a task. \ USER variables will crash console task \ ********************************************************************* NEEDS DUMP FROM DSK1.TOOLS NEEDS HZ FROM DSK1.SOUND NEEDS MASTER FROM DSK1.MUTINGISR \ ISR does timing and mutes sounds \ =============== MULTI-TASKING STUFF ======================= INCLUDE DSK1.MALLOC INCLUDE DSK1.MTASK99 HEX 2000 H ! \ reset the heap for testing purposes \ create a task in heap, fork it, assign Execution token & name : SPAWN ( xt -- pid) USIZE MALLOC DUP>R FORK R@ ASSIGN R> ; : TASK: ( xt -- ) ['] PAUSE SPAWN CONSTANT ; TASK: TASK1 TASK: TASK2 TASK: TASK3 TASK: TASK4 \ =========================================================== DECIMAL \ duration control variables and values VARIABLE TEMPO VARIABLE TIMESIG \ 2/4 3/4 4/4 6/4 VARIABLE MEASURE \ 1 muscial measure of time in ticks (1/60 SECS) 48 USER VOICE \ thread local variable 50 USER ON_TIME 52 USER OFF_TIME 54 USER FEEL \ controls the on/off time ratio 56 USER VOLUME : ]T ( timer# --) CELLS MASTER + ; \ WAIT is in MUTINGISR.FTH . Waits unto a timer hits zero : DELAY ( n -- ) VOICE @ ]T DUP>R ! R> WAIT ; : ]DB ( voice -- ) CELLS MUTE4 + ; \ 1..4 are valid \ need to create a64 bit integer. Forth has the words to do it. \ convert a string to double int. 64bits) : >DOUBLE ( addr len -- d ) 0 0 2SWAP >NUMBER 2DROP ; \ now we create a double int variable called timebase from primitive words S" 3600" >DOUBLE CREATE TIMEBASE , , \ no pause for harder realtime control : .HEX ( c) BASE @ >R HEX . R> BASE ! ; VARIABLE DEBUG DEBUG ON HEX 8400 CONSTANT SND_PORT DECIMAL \ no pause for harder realtime control : SND! ( c --) S" SND_PORT C!" EVALUATE ; IMMEDIATE : WHOLENOTE ( -- ticks) \ using tempo set the bpm for 1 whole note TEMPO @ TIMEBASE 2@ ROT UM/MOD NIP ( -- ticks for 1 beat ) TIMESIG @ * DUP MEASURE ! ; ( times beats in a bar ) \ Music needs notes to start and end in different ways. \ this word adjust the on:off ratio using n : EXPRESSION ( note_dur n --) OVER SWAP - TUCK - ( -- on-ms off-ms ) ( 1 MAX) OFF_TIME ! ( 1 MAX) ON_TIME ! ; \ store times in variables \ return full duration of current note : NOTE ( -- MS ) ON_TIME @ OFF_TIME @ + ; : DURATION! ( MS -- ) FEEL @ EXPRESSION ; : 5% ( -- ) 5 / ; : 10% ( n -- n ) 10 / ; : 20% ( n -- n ) 20 / ; : 50% ( N -- N/2) POSTPONE 2/ ; IMMEDIATE : % ( N N2 -- N%) 100 */ ; \ calculate n2% of n : 50%+ ( N -- N+50%) DUP 50% + ; \ dotted notes have 50% more time \ === BAR LINES === : | ; ( noop at this times ) : || MYSELF SLEEP PAUSE ; \ DOUBLE bar line ends the music : PLAY ( fcode -- ) OSC @ OR SPLIT SND! SND! \ send frequency VOLUME @ ATT @ OR SND! \ send volume \ Note is now playing... \ DELAY function loads timer register. ISR begins decrementing. \ DELAY monitors timer register and runs PAUSE while waiting ON_TIME @ DELAY \ set the ISR timer, which auto mutes OFF_TIME @ DELAY \ time between notes ; \ note object creator : NOTE: ( freq -- ) CREATE \ compile time: create a name in the dictionary HZ>CODE , \ compile the 9919 code into the note DOES> @ PLAY ; \ run time: fetch the number, play the note \ ================[ API ]============================== : SOPRANO 1 VOICE ! GEN1 ; SOPRANO : ALTO 2 VOICE ! GEN2 ; : TENOR 3 VOICE ! GEN3 ; : 4/4 4 TIMESIG ! ; 4/4 : 3/4 3 TIMESIG ! ; : 2/4 2 TIMESIG ! ; : 2X 2 0 ; \ repeat bars : ||: POSTPONE 2X POSTPONE DO ; IMMEDIATE : :|| POSTPONE LOOP ; IMMEDIATE \ dynamics : ff 0 VOLUME ! ; : forte 2 VOLUME ! ; : mf 4 VOLUME ! ; : piano 6 VOLUME ! ; : pp 8 VOLUME ! ; \ FREQ NATURAL FREQ ACCIDENTAL EN-HARMONIC \ ------------- ---------------- ---------------- 110 NOTE: A2 117 NOTE: A#2 : Bb2 A#2 ; 131 NOTE: C3 139 NOTE: C#3 : DB3 C#3 ; 147 NOTE: D3 156 NOTE: D#3 : Eb3 D#3 ; 165 NOTE: E3 175 NOTE: F3 185 NOTE: F#3 : Gb3 F#3 ; 196 NOTE: G3 208 NOTE: G#3 : Ab3 G#3 ; 220 NOTE: A3 233 NOTE: A#3 : Bb3 A#3 ; 247 NOTE: B3 262 NOTE: C4 277 NOTE: C#4 : Db4 C#4 ; 294 NOTE: D4 311 NOTE: D#4 : Eb4 D#4 ; 330 NOTE: E4 349 NOTE: F4 370 NOTE: F#4 : Gb4 F#4 ; 392 NOTE: G4 415 NOTE: G#4 : Ab4 G#4 ; 440 NOTE: A4 466 NOTE: A#4 : Bb4 A#4 ; 494 NOTE: B4 523 NOTE: C5 554 NOTE: C#5 : Db5 C#5 ; 587 NOTE: D5 622 NOTE: D#5 : Eb5 D#5 ; 659 NOTE: E5 698 NOTE: F5 740 NOTE: F#5 : Gb5 F#5 ; 784 NOTE: G5 831 NOTE: G#5 : Ab5 G#5 ; 880 NOTE: A5 932 NOTE: A#5 : Bb5 A#5 ; 988 NOTE: B5 1047 NOTE: C6 : BPM ( BPM -- ) \ set tempo in beats per minute TEMPO ! WHOLENOTE DURATION! ; : NORMAL NOTE 4 % FEEL ! ; : LEGATO NOTE 0 FEEL ! ; \ notes run together : STACCATTO NOTE 9 % FEEL ! ; \ short notes : MARCATO NOTE 6 % FEEL ! ; \ march feel : RIT. NOTE DUP 20% + DURATION! ; : 1/1 WHOLENOTE DURATION! ; : 1/2 WHOLENOTE 50% DURATION! ; : 1/2. 1/2 NOTE 50%+ DURATION! ; : 1/4 1/2 NOTE 50% DURATION! ; : 1/4. 1/4 NOTE 50%+ DURATION! ; : 1/8 1/4 NOTE 50% DURATION! ; : 1/8. 1/8 NOTE 50%+ DURATION! ; : 1/16 1/8 NOTE 50% DURATION! ; : 164 1/16 NOTE 50% DURATION! ; : REST NOTE DELAY ; \ ================================================================= \ Usage Demonstrations \ This system makes sense if you understand traditional music notation. : TWINKLE 120 BPM SOPRANO 4/4 NORMAL forte | 1/4 A4 A4 E5 E5 | F#5 F#5 1/2 E5 | | 1/4 D5 D5 C#5 C#5 | B4 B4 1/2 A4 | mf | 1/4 E5 E5 D5 D5 | C#5 C#5 1/2 B4 | | 1/4 E5 E5 D5 D5 | C#5 C#5 1/2 B4 | ff | 1/4 A4 A4 E5 E5 | F#5 F#5 1/2 E5 | | 1/4 D5 D5 C#5 C#5 | B4 B4 1/2. A4 || ; : DESCANT 120 BPM ALTO 4/4 LEGATO mf | 1/8 A3 C#4 B3 A3 E4 A3 C#4 E4 | | F#4 A4 G#4 F#4 E4 A3 C#4 E4 | | D4 F#4 E4 D4 C#4 E4 D4 C#4 | | B3 A4 B4 F#4 E4 F#4 E4 F#4 | piano | C#4 E4 C#4 E4 D4 E4 D4 E4 | | C#4 E4 C#4 E4 D4 B3 D4 E4 | | C#4 E4 C#4 E4 D4 E4 D4 E4 | | C#4 E4 C#4 E4 D4 B3 D4 E4 | forte | A3 C#4 B3 A3 E4 A3 C#4 E4 | | F#4 A4 G#4 F#4 E4 A3 C#4 E4 | | D4 F#4 E4 D4 C#4 E4 D4 C#4 | | B3 E4 F#4 G#4 A4 G#4 1/2 C#4 || ; : BASSLINE 120 BPM TENOR 4/4 MARCATO forte | 1/2 A2 C#3 | D3 A2 | | E3 A2 | E3 A2 | piano | 1/4 A2 A2 D3 D3 | E3 E3 1/2 E3 | | 1/4 A2 A2 D3 D3 | E3 E3 1/2 E3 | ff | 1/2 A2 C#3 | D3 A2 | | E3 A2 | E3 1/2. A2 || ; ' TWINKLE TASK1 ASSIGN ' DESCANT TASK2 ASSIGN ' BASSLINE TASK3 ASSIGN MULTI : TEST3 TASK1 RESTART TASK2 RESTART TASK3 RESTART ; : WITHBASS TASK1 RESTART TASK3 RESTART ; 4 Quote Link to comment Share on other sites More sharing options...
Elia Spallanzani fdt Posted April 11 Share Posted April 11 (edited) Very well executed. Just a small thing: is "staccato" Edited April 11 by Elia Spallanzani fdt Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 11 Author Share Posted April 11 8 hours ago, Elia Spallanzani fdt said: Very well executed. Just a small thing: is "staccato" Gracie mille segnore. 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.