+TheBF Posted May 29, 2019 Author Share Posted May 29, 2019 (edited) "Everything is easy if you understand it. If it isn't easy, you don't understand it" Old Arabic saying Well this compiler building is a bigger deal than i thought it was but I have come to a more or less a stable format for programs which is shown here. I have created a number interpreter (H#) to compile a literal number into the code, because I have not yet created a full compiler loop that reads the program. I still using vanilla PC Forth as an interpreter to compile the text into machine code. I have yet to fully grok the potential of using the literal stack for arguments so the emitted code is not as optimal as it Thomas Almy's white paper describes, but it seems to compile a lot of different things now. The NATIVE99 compiler, at startup, now dynamically compiles the compiling words, intrinsic routines (inline 1 to 4 instruction stuff) and the new versions of colon and semi-colon that compile 9900 sub-routines. This allows me to tweak them when I break them without re-compiling the whole compiler. The foundation stuff is pretty solid because it came from CAMEL99 Forth. You can do a lot of computing without the runtime library but you can't put it on the screen. I have KSCAN and from that KEY and KEY? I need to beat up the VDP routines and create EMIT, CR, TYPE, etc. so that I can hit the screen. It's rather daunting to consider tweaking all my programs so the goal it is make this thing swallow them as they are as much as possible. My next challenge is to create a very small HELLO WORLD. I have one here in HsForth "meta-compiler" that compiles to 127 bytes as a .COM file. That's the benchmark. Edit: fixed un-cropped screen save \ Native99 test format CROSS-COMPILING START. \ sets a timer NEW. \ init target memory to FFFF A000 ORIGIN. TI-99.EA5 REPORT ON \ STAY ON \ OPTIMIZE ON [CC] HEX CROSS-ASSEMBLING VARIABLE X VARIABLE Z : MAIN H# 2 X ! BEGIN H# 100 FOR X @ I * Z ! NEXT AGAIN ; PROGRAM: NCMULT \ we are interpreting at this point 8300 WORKSPACE FF00 RSTACK \ make the Forth VM FF80 DSTACK MAIN RUN \ call the main program BYE END. [CC] \ switch to cross-compiler vocabulary, do some commands SAVE.EA5 \ *optional commands can go here. Copy image , show memory dump etc... // copy NCMULT cc9900\clssic99\dsk1\ HEX A000 50 TDUMP STOP. Edited May 29, 2019 by TheBF 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 29, 2019 Author Share Posted May 29, 2019 (edited) Hello World from a Compiler in 160 154 bytes Although I have not got the push/pop optimizer on (found some bug conditions) we have a very small hello world binary. It could of course be a bit smaller but it's not too bad. EDIT: Found an unnecessary DUP and DROP in my TYPE routine. \ Small hello world in Native 99 Forth CROSS-COMPILING HEX \ Compiler pre-amble START. \ sets a timer NEW. \ init target memory to FFFF A000 ORIGIN. TI-99.EA5 REPORT ON \ print final report CROSS-ASSEMBLING \ simple VDP write driver 8C00 CONSTANT VDPWD \ vdp ram write data 8C02 CONSTANT VDPWA \ vdp ram read/write address VARIABLE VPOS \ screen position tracker : TYPE ( addr len -- ) VPOS @ h# 4000 + \ convert to vdp write address DUP VDPWA C! \ write low byte VDPWA ! \ write high byte 1+ FOR DUP C@ VDPWD C! \ VDP auto increments address, so write away! 1+ \ advance to next char in string NEXT VPOS +! \ update screen tracker ; \ ========================================== : MAIN S" Hello World!" TYPE ; PROGRAM: HELLO 8300 WORKSPACE \ setup Forth VM FFFF RSTACK FF00 DSTACK MAIN RUN BEGIN AGAIN END. [CC] SAVE.EA5 \ FILENAME$ was set by PROGRAM: // copy HELLO cc9900\clssic99\dsk1\ STOP. Edited May 29, 2019 by TheBF 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted June 3, 2019 Author Share Posted June 3, 2019 Nope! I didn't over complicate it While pondering the ins and outs of turning Forth source code into native 9900 code I was concerned that I was missing something, some secret sauce that made it all simple. "I wonder if Tom Almy is still around..." thought I last night He sure is and after one email he sent me the source code for CF86 which he wrote in 1985 and improved until 1995. After studying the source code, which is a little bit tricky, (ok very tricky) I came to some conclusions: Using the literal stack during compilation requires using conditionals like I started doing to make decisions about how best to compile the arguments. There are no short-cuts short of making Forth into a compiler language that you understand to abstract some detail. I have a pretty good foundation using HsForth for DOS, the TI-Forth based cross-assembler and the cross-compiler built for CAMEL99. (Tom used LMI Forth which was a competitor to HsForth at the time) I will have many opportunities to play with/invent optimization once the compiler is reliable And OMG the 9900 is so much nicer to use than Intel 86! So it looks like there are no short cuts just a lot of editing of Forth primitives so they get some smarts about when to grab args at compile time and when to do it at run time. So much code, so little time... 0xBF 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted June 3, 2019 Author Share Posted June 3, 2019 (edited) It is remarkable how much freedom I have with this native code concept. I was writing a screen clearing routine and I thought I can write this all in Forth now. I noticed that using the Forth operators to write a byte took extra instructions so I used ALC inside a Forth FOR/NEXT loop! Heresy I hear you say but look at the tight loop. ( I omitted the code that calls VDPWA!) Original code: (Edit: corrected VDPWD address in R1) : PAGE ( -- ) VTOP @ VDPWA! \ set the VDP write address R0 2000 LI, \ use free registers :-) R1 8C00 LI, H# 300 \ bytes in 32 column mode screen FOR R0 *R1 MOVB, NEXT ; Compiled code: A076 0200 li R0,>2000 A07A 0201 li R1,>8C00 A07E 0646 dect R6 A080 C584 mov R4,*R6 A082 0204 li R4,>0300 \ >300 to Forth TOS register A086 0647 dect R7 \ FOR... sets the index register A088 C5C9 mov R9,*R7 \ push current loop index to rstack A08A C244 mov R4,R9 \ load new index register A08C C136 mov *R6+,R4 \ refill Forth TOS register * >>This is the entire loop<< > A08E D440 movb R0,*R1 \ move the byte to VDP screen A090 0609 dec R9 \ decrement loop counter A092 1301 jeq >a096 \ this exits the loop A094 10FC jmp >a08e \ NEXT Edited June 4, 2019 by TheBF 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted June 4, 2019 Author Share Posted June 4, 2019 Looking at those 2 jumps in the FOR NEXT loop woke me up early. :-) I had modeled the NEXT code on the WHILE REPEAT loop in the TI-Forth Assembler. That is waaay over complicated for NEXT. So the code that compiles NEXT changed from: : NEXT R9 DEC, NE CJMP AHEAD 2+ \ while *RP<>0 >R BACK JMP, R> 2- RESOLVE R9 RPOP, ; To this: : NEXT R9 DEC, BACK JNE, R9 RPOP, ; Now I can go back to sleep. 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted June 8, 2019 Author Share Posted June 8, 2019 (edited) Implementing DO/LOOP in Native Code. (Edit: added final code) After making a decision to use R9 as the system loop index register, similar to the way ECX is used in x86 code, it came time to implement the DO/LOOP. It was much simpler than I thought. Since R9 is used by FOR/NEXT and DO/LOOP the Forth word I is very simple. Push the TOS register and move R9 into the TOS register. HOST: I ( -- n) ?TOSPUSH, \ optimizer decides is we push or not R9 TOS MOV, ;HOST FOR/NEXT is simple because it decrements R9 to zero. DO/LOOP has to increment I until it hits a LIMIT value. Fortunately we have the return stack to hold the LIMIT value and the 9900 lets us compare memory to register very easily. So we "RPUSH" the limit value but we must first "RPUSH" the current value in R0 because some earlier loop might be using it. All that considered and "DO" compiles this code. the HOST: means this ALC will be compiled inline (ie DO is a macro) HOST: DO ( limit index -- ) ( r: -- limit old-R9) R9 RPUSH, TOS R9 MOV, *SP+ RPUSH, TOS POP, BEGIN ;HOST And LOOP does this: HOST: LOOP ( -- ) R9 INC, R9 *RP CMP, \ test LIMIT vs value on return stack BACK JNE, RP INCT, \ drop the limit on the return stack R9 RPOP, \ restore prev. R9 value ;HOST However thIs simple native code loop runs 64k loops at about the same speed as CAMEL Forth's DO/LOOP because of a trick used by Camel Forth.(about 3 seconds) So when I incorporate that trick of using the JNO instruction this improved version runs 64k loops in < 1 second. :-) Here is the ANS Forth version of the do loop in native code. (DO) is a sub-routine to save space on very use but the concept works great. LOOP is a macro that codes the 4 instructions inline. I will have to give some thought about how best to make LOOP work as a sub-routine because the address to jump back to is calculate as the code compiles. The spoiler has the final code CROSS-ASSEMBLING \ This is a subroutine. Reduces code size of using do/loops : (DO) ( limit indx -- ) \ sub-rotuine that sets up the DO loop R0 8000 LI, \ load "fudge factor" to RO *SP+ R0 SUB, \ Pop limit, compute 8000h-limit "fudge factor" R0 TOS ADD, \ loop ctr = index+fudge R9 RPUSH, \ save current R9 R0 RPUSH, \ rpush limit TOS R9 MOV, \ index to R9 TOS POP, \ refill TOS ; \ macro the runs the setup and returns the start address of the loop HOST: DO ( -- loopaddr) (DO) BEGIN ;HOST \ Inline Macro gives full speed but takes 10 bytes. HOST: LOOP ( loopaddr -- ) R9 INC, \ increment loop BACK JNO, \ if no overflow then loop again RP INCT, R9 RPOP, ;HOST \ *warning* used with DO/LOOP only! : I ( -- n) ?TOSPUSH, R9 TOS MOV, *RP TOS SUB, \ index = loopindex - fudge ; : J ( -- n) ?TOSPUSH, 2 (RP) TOS MOV, 4 (RP) TOS SUB, \ index = loopindex - fudge ; HOST: I+! ( n -- ) \ NON-STANDARD: allows changing the loop index LDEPTH CASE 0 OF TOS R9 ADD, TOS POP, ENDOF POPARG @@ R9 ADD, ENDCASE ;HOST Edited June 9, 2019 by TheBF 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted June 9, 2019 Author Share Posted June 9, 2019 (edited) I updated the previous post with the final DO/LOOP code. It is working very well now. With this I can complete my VDPIO library and will be able to write quite normal Forth programs. One of the challenges with a native code Forth compiler that I see with Tom Almy's version is: How can the compiler know how many arguments are input to a sub-routine and how many outputs are returned? Why is this is hard in Forth? The reason is because arguments are un-named and simply reside on the data stack as do outputs. So the compiler has no idea how to handle this in Forth.Contrast this to a conventional language that uses named variables where the compiler knows what goes in by name and typically can only return one value. That is easy to compile. Tom created a "compiler directive" call IN/OUT. You give it 2 numbers. For example '+' would be defined as 2 1 IN/OUT : + ( ...code to add numbers... ) ; I don't want to have to do that for every word so I am looking into commandeering the bracketed stack diagram to compute these values for the compiler. This would mean that the codeMUST have a stack picture for every definition but this is considered good Forth coding practice and it means existing code would compile as expected... if the stack comments are correct! So I prefer that the code looks like this: : + ( n n -- n) ( ...code to add numbers... ) ; That is a design goal for NATIVE99. Edited June 9, 2019 by TheBF 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted June 10, 2019 Author Share Posted June 10, 2019 (edited) Compiling Forth IF is a Dilemma Traditional Forth uses the top of stack value as the condition flag. Zero if false, -1 is a proper true flag but usually any non-zero value is considered true.The 9900 of course uses the status register and jump instructions. If I implemented the Forth mechanism of setting or resetting the top of stack it takes a compare instruction, the conditional jump, the TOS CLR, the TOS SETO, and another JMP, instruction.That's 4 instructions if compiled inline or I can call the comparison operations as a sub-routine. This felt so wrong when the object of the native code is to go faster.Nevertheless a standard Forth program expects to be able to manipulate the top of stack value with comparison operations, so I may have to relent BUT... In the meantime, I have figured out how to compile native 9900 branching using Forth's "IF/ELSE/THEN" syntax and preliminary testing shows the code is pretty much what I would code by hand. :-) The key was to use a variable to hold a value that leverages a little compiler from the TI-Forth assembler call CJMP.There were two challenges: how to deal with the legal syntax of using IF without '=' or '>' etc. How to code 0=, 0> etc. The solution is not hard when you can do work at compile time.For problem one we can simply test the COMPARATOR variable when we compile 'IF' and if is not set, default to 0<>.For problem two we simply push a zero onto the stack (TOS CLR,) and then set the appropriate operation in COMPARATOR. Here is a short test program: VARIABLE FLAG : MAIN ." Equal Operator test:" H# 1 H# FFFF < IF FLAG ON ELSE FLAG OFF THEN KEY DROP ; And here is the resulting code: A362 0646 DECT R6 * TOS PUSH A364 C584 MOV R4,*R6 A366 0204 LI R4,>0001 * H# 1 A36A 0646 DECT R6 * TOS PUSH A36C C584 MOV R4,*R6 A36E 0204 LI R4,>FFFF * H# FFFF A372 8136 C *R6+,R4 A374 1501 JGT >A378 * < IF A378 0720 SETO @>A330 * FLAG ON A37C 1002 JMP >A382 * ELSE A37E 04E0 CLR @>A330 * FLAG OFF A382 C136 MOV *R6+,R4 * THEN A384 06A0 BL @>A2FA * KEY A388 C136 MOV *R6+,R4 * DROP A38A C2F7 MOV *R7+,R11 * ; A38C 045B B *R11 Spoiler shows how it was done. Note: The big optimization will come later when I figure out how to reference more stack arguments in 9900 registers vs only one register at this time. \ NCIFTHEN.FTH \ *** For Reference *** \ Assembler jump tokens used with CJMP \ NOTE: They are opposite of what the mnemonic says because IF jumps if the \ condition is NOT true. :-) \ HEX \ 0 Unconditional jump \ 1 CONSTANT GTE \ if GT OR EQUAL \ 2 CONSTANT HI \ if HI \ 3 CONSTANT NE \ if NOT equal \ 4 CONSTANT LO \ if low \ 5 CONSTANT LTE \ if less than or equal \ 6 CONSTANT EQ \ if equal \ 7 CONSTANT OC \ if on carry flag set \ 8 CONSTANT NC \ if no carry flag set \ 9 CONSTANT OO \ if on overflow \ A CONSTANT HE \ if high or equal \ B CONSTANT LE \ if low or equal \ C CONSTANT NP \ if no parity \ D CONSTANT LT \ if less than (SIGNED) \ E CONSTANT GT \ if greater than (SIGNED) \ F CONSTANT NO \ if no overflow \ 10 CONSTANT OP \ if ODD parity CROSS-COMPILING VARIABLE COMPARATOR \ holds the comparison operator [1..F] host: comparator! COMPARATOR ! ;host \ called "comparators" They control which JUMP operation is compiled by 'IF' CROSS-ASSEMBLING HOST: = EQ COMPARATOR! ;HOST HOST: <> NE COMPARATOR! ;HOST HOST: > GT COMPARATOR! ;HOST HOST: < LT COMPARATOR! ;HOST HOST: U>= GTE COMPARATOR! ;HOST HOST: <= LTE COMPARATOR! ;HOST HOST: U> HI COMPARATOR! ;HOST HOST: U< LO COMPARATOR! ;HOST HOST: U<= LE COMPARATOR! ;HOST HOST: U>= HE COMPARATOR! ;HOST \ these compile a zero to TOS and then compare host: 0= ?tospush, tos clr, = ;HOST host: 0<> ?tospush, tos clr, <> ;HOST \ 9900 specific comparisons HOST: .OP. OP COMPARATOR! ;HOST HOST: .NO. NO COMPARATOR! ;HOST HOST: .NP. NP COMPARATOR! ;HOST HOST: .OVR. OO COMPARATOR! ;HOST HOST: .OC. OC COMPARATOR! ;HOST HOST: .NC. NC COMPARATOR! ;HOST \ ===================================== \ define IF,ELSE,THEN for the compiler HOST: IF ( n n --) \ arg>tos *SP+ TOS CMP, \ compile comparison code [CC] COMPARATOR @ 0= \ is a comparator set? IF 0<> THEN \ no, so default to 0<> COMPARATOR @ CJMP AHEAD \ compile correct jump for the operation COMPARATOR OFF \ reset the comparator ;HOST HOST: ELSE ( -- ) 0 CJMP AHEAD \ compile a JMP instruction to THEN SWAP RESOLVE \ resolve the IF jump ;HOST HOST: THEN ( addr -- ) RESOLVE \ resolve the IF or ELSE jump TOS POP, \ refill TOS ;HOST Edited June 10, 2019 by TheBF 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted June 14, 2019 Author Share Posted June 14, 2019 (edited) CREATE DOES> in a directed threaded code (DTC) Forth My head was hurting with the native code project so I re-visited a "hanging chad" in my code. I had never figured out how to make CREATE DOES> work with CAMEL99 DTC version. There are not many people who will care to grok this but I put it here for that wayward soul who decides to make their own. I am starting with a simple example. This an example defining word that let's you make a Forth constant: : CONS CREATE , DOES> @ ; \ This is the "defining word" And this is how it could be used: 99 CONS X \ This is the "defined word" When X is invoked it will return the value 99 by 'fetching' it with the operator '@' that we see after DOES>. Here is a step by step explanation of what has to happen in my implementation where I use the BL instruction to call direct threaded Forth words. When the defined word (X) is invoked is does a BL to the DOES> part of CONS The Forth IP (interpreter pointer) has not moved at this point After X runs via BL instruction , R11 points to the address just past the BL instruction and address. (X's data field address) We just push that onto the Forth stack We push the current IP onto the return stack (edit: this was out of order & removed confusing duplicate line) We decrement R11 by 2 to point to the address of DOES> in CONS Edit: indexed addressing removed "R11 DECT" Make that address our new IP Advance the new IP past the branch instruction in DOES> which points to the "payload" in DOES> which is the execution token of '@' Now we run NEXT, the Forth interpreter, which runs fetch (@) which takes the value of the address on the TOS. And when NEXT runs again, we are back at the IP address we save previouslyWhew! Here's the code. l: _DODOES ( -- a-addr) TOS PUSH, \ save TOS reg on data stack R11 TOS MOV, \ After BL R11 has defined word's PFA. Move to TOS IP RPUSH, \ save current IP on return stack \ B @@ _dodoes ^ \ R11 now points to just after defining word code: >>>>>>>>>^ -2 (R11) IP MOV, \ get the address of _dodoes as Forth IP. IP 4 ADDI, \ advance past branch to defining word's PFA NEXT, For the insanely curious: My problem was that I was using BL inside DOES> . When invoked, X did a BL to DOES> which did a 2nd BL to _DODOES and that corrupted the value in R11 that I really needed. By changing DOES> to do a simple BRANCH to _DODOES, R11 was maintained when I entered _dodoes and it let me find a way to the DOES> part later by computation. Edited June 15, 2019 by TheBF 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted June 15, 2019 Author Share Posted June 15, 2019 So now that DTC Forth is completely working. Well it's not quite that simple. I had to make a new version of DSK1.SYSTEM, because things like >BODY are offset by 4 bytes instead of 2 bytes. And CODE words don't have a code field. The machine code starts right after the Dictionary header. However once that was fixed many programs just worked, as long as I had stuck to standard Forth. That's an improvement over the old days in Forth. Anyway here is a pair of shoot-out videos of the Dijkstra Dutch flag problem using his Algorithm with various randomization as the starting points. In this test, DTC Forth versus vanilla ITC CAMEL Forth, the DTC version is ~15% faster. Spoiler has the source code that was compiled un-changed in both systems \ Dutch flag DEMO using CAMEL99 Forth using Dijkstra's Algorithm \ *SORTS IN PLACE FROM Video MEMORY* \ INCLUDE DSK1.TOOLS.F ( for debugging) INCLUDE DSK1.GRAFIX INCLUDE DSK1.RANDOM INCLUDE DSK1.CASE INCLUDE DSK1.ELAPSE \ TMS9918 Video chip Specific code HEX FFFF FFFF FFFF FFFF PATTERN: SQUARE \ define colors and characters DECIMAL 24 32 * CONSTANT SIZE \ flag will fill GRAPHICS screen SIZE 3 / CONSTANT #256 \ 256 chars per segment of flag 1 CONSTANT REDSQR \ red character 9 CONSTANT WHTSQR \ white character 19 CONSTANT BLUSQR \ blue character 28 CONSTANT PTR1 \ color constants 1 CONSTANT TRANS 7 CONSTANT RED 5 CONSTANT BLU 16 CONSTANT WHT SQUARE REDSQR CHARDEF SQUARE BLUSQR CHARDEF SQUARE WHTSQR CHARDEF SQUARE PTR1 CHARDEF \ charset FG BG 0 RED TRANS COLOR 1 WHT TRANS COLOR 2 BLU TRANS COLOR \ screen fillers : RNDI ( -- n ) SIZE 1+ RND ; \ return a random VDP screen address : NOTRED ( -- n ) \ return rnd index that is not RED BEGIN RNDI DUP VC@ REDSQR = WHILE DROP REPEAT ; : NOTREDWHT ( -- n ) \ return rnd index that is not RED or BLU BEGIN RNDI DUP VC@ DUP REDSQR = SWAP WHTSQR = OR WHILE DROP REPEAT ; : RNDRED ( -- ) \ Random RED on VDP screen #256 0 DO REDSQR NOTRED VC! LOOP ; : RNDWHT ( -- ) \ place white where there is no red or white #256 0 DO WHTSQR NOTREDWHT VC! LOOP ; : BLUSCREEN ( -- ) 0 768 BLUSQR VFILL ; \ load the screen with random red,white&blue squares : RNDSCREEN ( -- ) BLUSCREEN RNDRED RNDWHT ; : CHECKERED ( -- ) \ red,wht,blue checker board SIZE 0 DO BLUSQR I VC! WHTSQR I 1+ VC! REDSQR I 2+ VC! 3 +LOOP ; : RUSSIAN \ Russian flag 0 0 WHTSQR 256 HCHAR 0 8 BLUSQR 256 HCHAR 0 16 REDSQR 256 HCHAR ; : FRENCH \ kind of a French flag 0 0 BLUSQR 256 VCHAR 10 16 WHTSQR 256 VCHAR 21 8 REDSQR 256 VCHAR ; \ Algorithm Dijkstra(A) \ A is an array of three colors \ begin \ r <- 1; \ b <- n; \ w <- n; \ while (w>=r) \ check the color of A[w] \ case 1: red \ swap(A[r],A [w]); \ r<-r+1 \ case 2: white \ w<-w-1 \ case 3: blue \ swap(A[w],A[b]); \ w<-w-1; \ b<-b-1 \ end : XCHG ( adr1 adr2 -- ) OVER VC@ OVER VC@ \ read the chars in VDP RAM SWAP ROT VC! SWAP VC! ; \ exchange the characters \ address pointer variables VARIABLE R VARIABLE B VARIABLE W : DIJKSTRA ( -- ) 0 R ! SIZE 1- DUP B ! W ! BEGIN W @ R @ 1- > WHILE W @ VC@ CASE REDSQR OF R @ W @ XCHG 1 R +! ENDOF WHTSQR OF -1 W +! ENDOF BLUSQR OF W @ B @ XCHG -1 W +! -1 B +! ENDOF ENDCASE REPEAT ; : WAIT 11 11 AT-XY ." Finished!" 1500 MS ; : TITLE ( -- ) PAGE CR ." DIJKSTRA DUTCHFLAG DEMO" CR ." -----------------------" CR CR ." Using the 3 colour algorithm" CR ." translated to hi-level Forth" CR CR ." Sorted in-place in Video RAM" 0 23 AT-XY ." Press any key to begin" KEY DROP ; : RUN ( -- ) \ test with different input patterns TITLE TICKER OFF RNDSCREEN DIJKSTRA \ WAIT CHECKERED DIJKSTRA \ WAIT RUSSIAN DIJKSTRA \ WAIT FRENCH DIJKSTRA \ WAIT 0 23 AT-XY .ELAPSED CR ." Completed" ; ITC FORTH DEMO.mp4 DTC FORTH DEMO.mp4 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted June 20, 2019 Author Share Posted June 20, 2019 Trying the new Artiage UI I was wondering how hard it would be to use MIDI values to play notes on Forth. Although I have used MIDI for many years for music production I never looked under the hood. So as an exercise I found a table on a web site, stuck the table in Excel and then re-worked the columns to give me what I needed and pasted it into a source file. ? With a little Forth compiler word called MIDI, I compiled the table of notes from midi 45 to midi 108, a usable musical range. The fastest way I have found to get values from the table is with indexed addressing so the word MIDI takes a midi# and returns the 9919 code that plays the note. I tested it with a little play routine to play the entire table in sequence and it works well. \ fastest array access on 9900 uses indexed addressing CODE MIDI ( midi# -- Fcode) TOS TOS ADD, \ compute midi#->table_offset MIDI-TABLE (TOS) TOS MOV, \ fetch the value NEXT, ENDCODE And to test out my screen capture routine I wrote a MIDI-DUMP that output the data as Assembly language data statements for anybody who might find this useful. \ dump midi data as text table : <####> ( n -- ) ( ud n --) 0 <# # # # # #> ; : .FCODE ( i --) MIDI ." >" <####> TYPE ; : DUMP-MIDI CR 109 45 DO ." DATA " I 3 + I DO I .FCODE ." , " LOOP I .FCODE CR 4 +LOOP ; The spoiler has the table Forth code. Spoiler \ Notes by midi number in the range of the TMS9919 chip \ NEEDS DUMP FROM DSK1.TOOLS ( debugging only) NEEDS MOV, FROM DSK1.ASM9900 NEEDS HZ FROM DSK1.SOUND \ word to pre-calculate 9919 freq. code and compile into memory : MIDI, ( freq -- ) HZ>CODE , ; \ Create midi table that can hold all 127 midi notes. DECIMAL CREATE MIDI-TABLE 127 CELLS ALLOT \ ******************************** \ * BEGIN COMPILE TIME MAGIC * \ ******************************** \ pre-fill entire table ZERO \ in case we try to access an invalid note for the 9919 MIDI-TABLE 127 CELLS 0 FILL \ Save the current dictionary address on data stack HERE \ Set the dictionary pointer (DP) to midi[45] in the table MIDI-TABLE 45 CELLS + DP ! \ Now fill in the table with notes from #45 to #108 \ *Freq Midi# Note \ ----- ----- ------------ 110 MIDI, \ 45 A2 117 MIDI, \ 46 A#2/Bb2 123 MIDI, \ 47 B2 131 MIDI, \ 48 C3 139 MIDI, \ 49 C#3/Db3 147 MIDI, \ 50 D3 156 MIDI, \ 51 D#3/Eb3 165 MIDI, \ 52 E3 175 MIDI, \ 53 F3 185 MIDI, \ 54 F#3/Gb3 196 MIDI, \ 55 G3 208 MIDI, \ 56 G#3/Ab3 220 MIDI, \ 57 A3 233 MIDI, \ 58 A#3/Bb3 247 MIDI, \ 59 B3 262 MIDI, \ 60 C4 (middle C) 277 MIDI, \ 61 C#4/Db4 294 MIDI, \ 62 D4 311 MIDI, \ 63 D#4/Eb4 330 MIDI, \ 64 E4 349 MIDI, \ 65 F4 370 MIDI, \ 66 F#4/Gb4 392 MIDI, \ 67 G4 415 MIDI, \ 68 G#4/Ab4 440 MIDI, \ 69 A4 concert pitch 466 MIDI, \ 70 A#4/Bb4 494 MIDI, \ 71 B4 523 MIDI, \ 72 C5 554 MIDI, \ 73 C#5/Db5 587 MIDI, \ 74 D5 622 MIDI, \ 75 D#5/Eb5 659 MIDI, \ 76 E5 698 MIDI, \ 77 F5 740 MIDI, \ 78 F#5/Gb5 784 MIDI, \ 79 G5 831 MIDI, \ 80 G#5/Ab5 880 MIDI, \ 81 A5 932 MIDI, \ 82 A#5/Bb5 988 MIDI, \ 83 B5 1047 MIDI, \ 84 C6 1109 MIDI, \ 85 C#6/Db6 1175 MIDI, \ 86 D6 1245 MIDI, \ 87 D#6/Eb6 1319 MIDI, \ 88 E6 1397 MIDI, \ 89 F6 1480 MIDI, \ 90 F#6/Gb6 1568 MIDI, \ 91 G6 1661 MIDI, \ 92 G#6/Ab6 1760 MIDI, \ 93 A6 1865 MIDI, \ 94 A#6/Bb6 1976 MIDI, \ 95 B6 2093 MIDI, \ 96 C7 2217 MIDI, \ 97 C#7/Db7 2349 MIDI, \ 98 D7 2489 MIDI, \ 99 D#7/Eb7 2637 MIDI, \ 100 E7 2794 MIDI, \ 101 F7 2960 MIDI, \ 102 F#7/Gb7 3136 MIDI, \ 103 G7 3322 MIDI, \ 104 G#7/Ab7 3520 MIDI, \ 105 A7 3729 MIDI, \ 106 A#7/Bb7 3951 MIDI, \ 107 B7 4186 MIDI, \ 108 C8 \ ----------- END -------------- \ *frequencies have been rounded up/down to closest integer \ Note values from: \ http://www.inspiredacoustics.com/en/MIDI_note_numbers_and_center_frequencies \ restore the old dictionary pointer DP ! \ fastest array access on 9900 uses indexed addressing CODE MIDI ( midi# -- Fcode) TOS TOS ADD, \ compute midi#->table_offset MIDI-TABLE (TOS) TOS MOV, \ fetch the value NEXT, ENDCODE mididata.asm 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted July 15, 2019 Author Share Posted July 15, 2019 Checking in I have been distracted lately by nice weather, grandchildren and a cousin with a bunch of vintage vacuum tube guitar amplifiers that need serious attention. I have been trying to find out why my RS232 Forth does not like to have the output vectored to other devices on real hardware. That is proving to be a challenge. All that to say I am still lurking but have a few other things to deal with. Hope to get a current copy of the system up on Github before end of July. (no promises) ? 0xBF 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted July 22, 2019 Author Share Posted July 22, 2019 Things that make me say Hmmm? On the weekend I was reviewing code and found this cute little XB demo. It's very clever IMHO. 1 ! Smart Programming Guide for Sprites 2 ! by Craig Miller 3 !(c) 1983 by Miller Graphics 100 CALL CLEAR 110 CALL SCREEN(2) 120 CALL CHAR(46,"0000001818") 130 CALL SPRITE(#2,94,16,180,1,0,5) 140 FOR N=0 TO 25 150 X=RND*192+1 160 Y=RND*255+1 170 CALL SPRITE(#3,65+N,16,Y/2+1,X+1) 180 CALL SOUND(-60,660,8) 190 CALL POSITION(#3,Y,X,#2,R,C) 200 CALL SPRITE(#1,46,16,R,C,(Y-R)*.49,(X-C)*.49) 210 CALL SOUND(476,-3,14) 220 CALL SOUND(120,110,6) 230 CALL DELSPRITE(#1) 240 CALL PATTERN(#3,35) 250 CALL SOUND(100,220,6) 260 NEXT N 270 GOTO 140 I took a run at it using directly controlled sprites in Forth and it was "challenging". I wondered, how hard would it be to use the interrupt driven motion control anyway? After all it's sitting there in the ROMs. After a bit I had working code... kind of. I had sprites moving on the screen with "AUTOMOTION" but for some reason the bottom of my screen image, which starts at VDP >0000 was contaminating the sprite motion table after I turned on the AUTOMOTION. I checked all my VDP register settings for Graphics mode and they seem ok. I am really at a loss as to what is going on. Here is all it took to use automotion in Forth after loading the grafix and dirsprit libraries. Spoiler \ Interrupt Driven Sprite motion (like Extended BASIC) BJF July 21 2019 NEEDS SPRITE FROM DSK1.DIRSPRIT HEX 0780 CONSTANT SMT \ SPRITE motion table VDP address 83C2 CONSTANT AMSQ \ interrupt software DISABLE bits \ AMSQ bit meaning: \ 80 all interrupts disabled \ 40 motion disabled \ 20 Sound disabled \ 10 quit key disabled \ access the sprite tables in VDP like arrays : ]SMT ( spr# -- VDP-addr) 4* SMT + ; : ]SAT ( spr# -- VDP-addr) 4* SAT + ; : MOVING ( n -- ) 837A C! ; \ # of sprites moving automatically : INITMOTION ( -- ) 0 MOVING \ no moving sprites 20 0 DO D000 I ]SAT V! LOOP ; \ init all sprites : STOPMOTION ( -- ) AMSQ C@ 40 OR AMSQ C! ; \ stop all sprite motion : AUTOMOTION ( -- ) SPR# @ 1+ MOVING AMSQ C@ 7 AND 30 AND AMSQ C! ; : >SCHAR ( c -- c') FF AND ; \ convert c to signed CHAR : MOTION ( spx spy spr# -- ) >R >SCHAR SWAP >SCHAR FUSE R> ]SMT V! ; 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted July 22, 2019 Share Posted July 22, 2019 I will need to peruse your DIRSPRIT code before I can attempt to divine what might be the problem, but I am curious about the need for >SCHAR here. In fbForth, only the LSB of the stack value is used by single-byte write words like C! and VSBW , so a word like >SCHAR would be unnecessary. ...lee Quote Link to comment Share on other sites More sharing options...
+TheBF Posted July 22, 2019 Author Share Posted July 22, 2019 It's academic really. Just a reminder to me that signed chars are used in the motion control table and protection from non-byte values getting used by FUSE which "fuses" bytes together into a CELL. Here is the sprite control code (but it doesn't do anything special) So I included the GRAFIX file too which dirsprit uses. But I just noticed a difference between my CLEAR word(for BASIC friendliness) and PAGE. It's no doubt something very stupid that I did long ago. ? Spoiler NEEDS HCHAR FROM DSK1.GRAFIX \ must be in Graphics 1 mode HERE CR .( compiling direct sprite control) HEX 8802 CONSTANT VDPSTS \ vdp status register memory mapped address 300 CONSTANT SAT \ sprite descriptor table VDP RAM base address 20 4* CONSTANT SATsize \ size of the table, 32 sprites x 4 bytes/record 1F CONSTANT MAX.SP \ 32 sprites, 0 .. 31 \ hi speed memory addresses are actually variables 83D4 CONSTANT VDPR1 \ MEMORY for VDP Register 1, TI SYSTEM address VARIABLE SPR# \ holds the last sprite defined by SPRITE \ Sprite descriptor table array CODE word is 2X faster, same size as Forth \ *** SP.Y is the base address of the 4 byte sprite record CODE SP.Y ( spr# -- vaddr) \ 4* SAT + 0A24 , \ TOS 2 SLA, 0224 , SAT , \ TOS SAT AI, NEXT, ENDCODE CODE SP.X ( spr# -- vaddr) \ 4* SAT + 1+ 0A24 , \ TOS 2 SLA, 0224 , SAT , \ TOS SAT AI, 0584 , \ TOS INC, NEXT, ENDCODE \ These words are the fastest way access sprite decr. table : SP.X@ ( spr# -- sprx) SP.X VC@ ; \ fetch X : SP.Y@ ( spr# -- spry) SP.Y VC@ ; \ fetch Y : SP.X! ( n spr# -- ) SP.X VC! ; \ store X : SP.Y! ( n spr# -- ) SP.Y VC! ; \ store Y : SP.PAT ( n spr# -- vaddr) SP.X 1+ ; \ address of pattern byte : SP.COLR ( n spr# -- vaddr) SP.X 2+ ; \ address of colr byte \ finger trouble protection. Runtime array index test. : ?NDX ( n -- n ) MAX.SP OVER < ABORT" Bad SPR#" ; CR .( .) \ INIT SPRITES: You must run DELALL before using sprites* : DELALL ( -- ) 1 ?MODE \ test for graphics mode 1 6 VWTR \ vdp reg 6 = 1, puts ]PDT @ $800 SAT SATsize BL VFILL \ init the sprite desc. table with blanks SPR# OFF ; \ #sprites=0 \ The following words are named like Extended BASIC \ (remove ?NDX if you need more speed, but you loose protection) : POSITION ( sprt# -- dx dy ) SP.Y V@ SPLIT ; : LOCATE ( dx dy sprt# -- ) ( ?NDX) SP.Y >R FUSE R> V! ; : PATTERN ( char sprt# -- ) ( ?NDX) SP.PAT VC! ; : SP.COLOR ( col sprt# -- ) ( ?NDX) SP.COLR >R 1- R> VC! ; \ CODE DUP>R ( n -- ) ( r-- n) \ 0647 , C5C4 , \ TOS RPUSH, \ NEXT, \ ENDCODE .( .) : SPRITE ( char colr x y sp# -- ) \ create a SPRITE, sp# = 0..31 ?NDX DUP >R \ copy spr# to rstack LOCATE \ set screen position R@ SP.COLOR \ set the sprite color R@ PATTERN \ set the character pattern to use R> SPR# @ MAX SPR# ! ; \ update last spr# \ like Extended BASIC Magnify : MAGNIFY ( mag-factor -- ) VDPR1 C@ 0FC AND + DUP 1 VWTR VDPR1 C! ; .( .) HEX CODE RANGE? ( n n n -- n') \ FORTH: OR OR 8000 AND E136 , \ *SP+ TOS SOC, E136 , \ *SP+ TOS SOC, 0244 , 8000 , \ TOS 8000 ANDI, NEXT, ENDCODE CODE DXY ( x2 y2 x1 y1 --- dx dy ) \ Common factor for SP.DIST,SP.DISTXY C036 , \ *SP+ R0 MOV, \ pop x1->R0 6136 , \ *SP+ TOS SUB, \ pop y1-y2->tos 6016 , \ *SP R0 SUB, \ x1-x2->R0, keep stack location C0C4 , \ TOS R3 MOV, \ dup tos in r3, MPY goes into R4 38C4 , \ TOS R3 MPY, \ r3^2, result->r4 (tos) C080 , \ R0 R2 MOV, \ dup R0 3802 , \ R2 R0 MPY, \ RO^2 C581 , \ R1 *SP MOV, \ result to stack NEXT, \ 16 bytes ENDCODE .( .) \ factored DIST out for re-use \ With new machine code words and no Rstack operations it is 2X faster : DIST ( x2 y2 x1 y1 -- distance^2) \ distance between 2 coordinates DXY 2DUP + \ sum the squares DUP RANGE? \ check if out of range IF DROP 7FFF \ throw away the copy, return 32K THEN ; \ otherwise return the calculation : SP.DIST ( spr#1 spr#2 -- dist^2 ) POSITION ROT POSITION DIST ; : SP.DISTXY ( x y spr# -- dist^2 ) POSITION DIST ; .( .) \ text macros for clarity and speed of coicidence detection : 2(X^2) ( n -- 2(n^2) S" DUP * 2*" EVALUATE ; IMMEDIATE : <= ( n n -- ? ) S" 1- <" EVALUATE ; IMMEDIATE \ VDP status bit set if any two sprites overlap : COINCALL ( -- ? ) VDPSTS C@ 20 AND ; \ 0 means no coincidence : COINC ( sp#1 sp#2 tol -- ? ) 2(X^2) -ROT SP.DIST > ; : COINCXY ( dx dy sp# tol -- ? ) 2(X^2) >R \ convert tolerance to squares, push to rstack SP.DISTXY \ compute sprite dist from dx dy R> <= ; \ compare dist to tolerance HERE SWAP - CR CR .( Sprites used ) DECIMAL . .( bytes) Spoiler \ GRAPHIX.FTH for CAMEL99 V2 \ define vdp tables as arrays HEX 0380 CONSTANT CTAB \ colour table 0800 CONSTANT PDT \ "pattern descriptor table" \ access VDP tables like arrays. Usage: 9 ]CTAB returns VDP addr : ]CTAB ( set# -- 'ctab[n]) CTAB + ; \ 1 byte fields : ]PDT ( char# -- 'pdt[n] ) 8* PDT + ; \ 8 byte fields \ ABORT to Forth with a msg if input is bad : ?MODE ( n -- ) VMODE @ <> ABORT" Bad mode" ; : ?COLOR ( n -- n ) DUP 16 U> ABORT" Bad Color" ; : ?SCR ( vdpadr -- ) C/SCR @ CHAR+ > ABORT" too many chars" ; ( takes fg nibble, bg nibble, convert to TI hardware #s) ( test for legal values, and combine into 1 byte) : >COLR ( fg bg -- byte) 1- ?COLOR SWAP 1- ?COLOR 04 LSHIFT + ; \ TI-BASIC SUB-PROGRAMS BEGIN : CLEAR ( -- ) PAGE 0 17 AT-XY ; ( just because you love it ) : COLOR ( character-set fg-color bg-color -- ) 1 ?MODE >COLR SWAP ]CTAB VC! ; \ ascii value SET# returns the character set no. : SET# ( ascii -- set#) 3 RSHIFT ; ( *NEW* change contiguous character sets at once) : COLORS ( set1 set2 fg bg -- ) 1 ?MODE >COLR >R SWAP ]CTAB SWAP ]CTAB OVER - R> VFILL ; : SCREEN ( color -- ) 1 ?MODE \ check for MODE 1 1- ?COLOR ( -- n) \ TI-BASIC color to VDP color and test 7 VWTR ; \ set screen colour in Video register 7 : GRAPHICS ( -- ) 1 VMODE ! \ call this video mode 1 0 380 0 VFILL \ erase the entire 40 col. screen space E0 DUP 83D4 C! \ KSCAN re-writes VDP Reg1 with this byte ( -- E0) 1 VWTR \ VDP register 1 bit3 = 0 = Graphics Mode 0E 3 VWTR 01 4 VWTR 06 5 VWTR 01 6 VWTR \ set sprite descriptor table to 1x$800=$800 CTAB 10 10 VFILL \ color table: black on transparent [1,0] 8 SCREEN \ cyan SCREEN 20 C/L! \ 32 chars/line CLEAR ; \ CHAR sub-program is renamed to CHARDEF : CHARDEF ( addr char# --) ]PDT 8 VWRITE ; \ ti basic call char : CHARPAT ( addr char# --) ]PDT SWAP 8 VREAD ; \ ti basic call charpat : PATTERN: ( u u u u -- ) \ USAGE: HEX 0000 FF00 AABB CCDD PATTERN: SHAPE1 CREATE >R >R >R , R> , R> , R> , ; : GCHAR ( col row -- char) VROW 2@ >VPOS VC@ ; \ NOTES: \ 1. Unlike BASIC HCHAR & VCHAR must have the cnt parameter \ 2. col and row do not affect AT-XY, VCOL or VROW : HCHAR ( col row char cnt -- ) SWAP 2>R \ swap char & cnt, push to return stack >VPOS \ ( -- vdp_addr) R> 2DUP + ?SCR \ add count to Vadr and test R> VFILL ; \ get char, FILL Vmemory : VCHAR ( col row char cnt -- ) \ parameter order not ideal so we shuffle 2>R \ ( -- x y ) >VPOS \ ( -- vdp_addr) C/SCR @ 1- SWAP \ ( -- lim vdpaddr) R> SWAP \ ( -- lim char vadr) R> 0 \ ( -- lim char vadr ?DO \ ( -- lim char vadr) 2DUP VC! C/L@ + VCLIP LOOP 2DROP DROP ; GRAPHICS CR .( GRAPHICS 1 Mode READY) Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted July 22, 2019 Share Posted July 22, 2019 Other than that CLEAR puts the cursor at the beginning of the last screen line and that PAGE does nothing with the cursor, I do not see anything untoward yet. ...lee Quote Link to comment Share on other sites More sharing options...
+TheBF Posted July 23, 2019 Author Share Posted July 23, 2019 Ya it's a head scratcher. I had to move back to the amp repair so I did nothing else with it. Gotta be something I am configuring wrong in the 9918. Anyway. It was a good exercise making the automotion work. Thanks for your help. B Quote Link to comment Share on other sites More sharing options...
+TheBF Posted July 23, 2019 Author Share Posted July 23, 2019 1 hour ago, Lee Stewart said: Other than that CLEAR puts the cursor at the beginning of the last screen line and that PAGE does nothing with the cursor, I do not see anything untoward yet. ...lee Here is the code for PAGE. It actually does work on the cursor position. : PAGE ( -- ) VTOP @ DUP C/SCR @ OVER - BL VFILL 0 SWAP C/L@ / AT-XY ; Quote Link to comment Share on other sites More sharing options...
+TheBF Posted July 23, 2019 Author Share Posted July 23, 2019 (edited) Classic99 2019-07-23 15-35-36.mp4 EDIT: The video here has audio on it but it doesn't play on Firefox here. ?? So even though there is a bug in my CLEAR routine when AUTOMOTION is engaged I was able to make a working replica of the Miller Graphics XB sprite demo program. This was an exercise for me to enable automotion after all this time but it can double as a tutor for BASIC coders who want to see a Forth equivalent program. A few important things to notice that are different in the Forth version: Forth is based on cutting up programs and functions to atomic levels so SPRITE creation does not include setting motion vectors. That is only done with the MOTION word. A good example of this atomic factoring is that CAMEL99 Forth has no SOUND word. It is cut up into components to select the generator: GEN1,GEN2,GEN3 and NOISE. The parameters are set with DB and HZ and the timing is controlled by MS. (millisecond delay) To turn off the active generator we use MUTE. (To kill all sound we use SILENT) I took the luxury of naming the SPRITES and some colors to aid in understanding the code. This is more important in Forth because there are no brackets to delimit parameters. The CAMEL99 Forth kernel is 8K and has only the CORE words in Forth and a word to INCLUDE more source code. Everything else must be added into the system if you need it. I have added line numbers in the Forth version so you can see what is what compared to the BASIC code. Of course all the TI-99 specific words are not standard Forth. I have tried, where it made sense to follow XB naming, but there are are other commands "behind the curtain" that are available to the programmer as needed. The program has been organized like the BASIC version but in reality a Forth program would have broken up even this short program into a few well chosen sub-routines so it could be tested piece by piece interactively. Forth has not "BREAK" KEY per-se but we created one just the same. ?TERMINAL calls the same code in ROM that BASIC uses to detect FCTN 4. We then can do whatever we want if it returns a true signal. Spoiler \ EXTENDED BASIC to CAMEL99 Forth demo BJFox 2019 \ Source: Smart Programming Guide for Sprites \ by Craig Miller \ (c) 1983 by Miller Graphics \ 100 CALL CLEAR \ 110 CALL SCREEN(2) \ 120 CALL CHAR(46,"0000001818") \ 130 CALL SPRITE(#2,94,16,180,1,0,5) \ 140 FOR N=0 TO 25 \ 150 X=RND*192+1 \ 160 Y=RND*255+1 \ 170 CALL SPRITE(#3,65+N,16,Y/2+1,X+1) \ 180 CALL SOUND(-60,660,8) \ 190 CALL POSITION(#3,Y,X,#2,R,C) \ 200 CALL SPRITE(#1,46,16,R,C,(Y-R)*.49,(X-C)*.49) \ 210 CALL SOUND(476,-3,14) \ 220 CALL SOUND(120,110,6) \ 230 CALL DELSPRITE(#1) \ 240 CALL PATTERN(#3,35) \ 250 CALL SOUND(100,220,6) \ 260 NEXT N \ 270 GOTO 140 NEEDS .S FROM DSK1.TOOLS NEEDS MOTION FROM DSK1.AUTOMOTION NEEDS RND FROM DSK1.RANDOM NEEDS DB FROM DSK1.SOUND VARIABLE X VARIABLE Y VARIABLE RR VARIABLE CC HEX 0000 0018 1800 0000 PATTERN: ABULLET : DELSPRITE ( spr# -- ) 0 SWAP SP.PAT VC! ; DECIMAL \ name sprites and colors for convenience 1 CONSTANT AMMO 2 CONSTANT TURRET 3 CONSTANT TARGET 2 CONSTANT BLACK 5 CONSTANT BLUE 16 CONSTANT WHITE \ functions to assist understanding : (Y-CC)/2 ( -- n) Y @ CC @ - 2/ ; : (X-RR)/2 ( -- n) X @ RR @ - 2/ ; : RUN ( 100) CLEAR ( 110) BLUE SCREEN 10 0 AT-XY ." Camel99 Forth" ( 120) ABULLET [CHAR] . CHARDEF ( 130) [CHAR] ^ WHITE 1 180 TURRET SPRITE 0 5 TURRET MOTION AUTOMOTION ( 140) BEGIN 25 0 DO ( 150) 192 RND 1+ X ! ( 160) 255 RND 1+ Y ! ( 170) [CHAR] A I + WHITE Y @ 2/ X @ 1+ TARGET SPRITE ( 180) GEN1 660 HZ 8 DB 50 MS MUTE ( 190) TARGET POSITION X ! Y ! TURRET POSITION RR ! CC ! ( 200) [CHAR] . WHITE CC @ RR @ AMMO SPRITE (X-RR)/2 (Y-CC)/2 AMMO MOTION ( 210) 2 NOISE -14 DB 430 MS MUTE ( 220) GEN1 110 HZ -6 DB 120 MS ( 230) AMMO DELSPRITE ( 240) [CHAR] # 3 PATTERN ( 250) GEN1 220 HZ -6 DB 100 MS MUTE ?TERMINAL IF STOPMOTION CR ." BREAK" ABORT THEN ( 260) LOOP ( 270) AGAIN ; Edited July 23, 2019 by TheBF Missing sound on video clip 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted July 24, 2019 Author Share Posted July 24, 2019 (edited) So I found it impossible not to play around with this little demo. ? So I re-wrote it using more appropriate Forth style, breaking up the program into pieces for testing but also making each piece so simple that it's harder to create bugs. And then I had some fun using the sound control words to create some better sound effects. It's worth noting that I removed the variables and simply read the sprite table coordinates directly with the Forth words SP.Y@ and SP.X@ After we create the sprite, the numbers are already stored in VDP RAM so why not use them. Coolsprite demo2.mp4 Spoiler \ Forth Progamming style demo BJFox 2019 \ Concept: Smart Programming Guide for Sprites \ Re-worked to show: \ 1. Factoring for testing each piece \ 2. Removing CPU variables, passing data on the stack instead. NEEDS MOTION FROM DSK1.AUTOMOTION NEEDS RND FROM DSK1.RANDOM NEEDS DB FROM DSK1.SOUND HEX 0000 0018 1800 0000 PATTERN: ABULLET \ return random coordinate : RNDX ( -- x ) 192 RND 1+ ; : RNDY ( -- y ) 255 RND 1+ ; : DELSPRITE ( spr# -- ) 0 SWAP PATTERN ; DECIMAL \ name sprites and colors for convenience 1 CONSTANT AMMO 2 CONSTANT TURRET 3 CONSTANT TARGET 2 CONSTANT BLACK 5 CONSTANT BLUE 16 CONSTANT WHITE : uS ( delay -- ) 0 ?DO LOOP ; \ ~100uS loop speed : DECAY ( delay start end --) SWAP ?DO I DB DUP uS LOOP MUTE DROP ; \ Why consume CPU RAM with variables? The numbers are in VDP RAM! \ We can read the data directly with some CAMEL99 words, compute the motion vectors \ and put the results on the stack for another routine to use. : AIMXY ( -- motiony motionx ) TARGET SP.Y@ TURRET SP.Y@ - 2/ TARGET SP.X@ TURRET SP.X@ - 2/ ; : SHOOT ( -- ) [CHAR] . WHITE TURRET POSITION AMMO SPRITE AIMXY AMMO MOTION 4 NOISE 0 DB 500 uS \ hi freq shot noise 5 NOISE 200 2 30 DECAY \ low freq decay ; : HIT ( -- ) GEN3 1000 HZ -30 DB \ GEN3 is silent 3 NOISE 0 DB 700 uS MUTE \ Freq controlled by GEN3 ; : RUMBLE ( -- ) 6 NOISE 900 10 30 DECAY ; : CONTACT HIT AMMO DELSPRITE [CHAR] # TARGET PATTERN RUMBLE 100 MS MUTE ; : ?BREAK ( -- ) ?TERMINAL IF STOPMOTION CR CR ." *BREAK*" HONK ABORT THEN ; : RUN CLEAR BLUE SCREEN 5 0 AT-XY ." Camel99 Forth Demo II" ABULLET [CHAR] . CHARDEF [CHAR] ^ WHITE 1 180 TURRET SPRITE 0 5 TURRET MOTION AUTOMOTION BEGIN 25 0 DO [CHAR] A I + WHITE RNDY 2/ RNDX 1+ TARGET SPRITE SHOOT 150 MS CONTACT ?BREAK LOOP AGAIN ; Edited July 24, 2019 by TheBF Wrong comment in code 3 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted July 25, 2019 Author Share Posted July 25, 2019 Long long ago in a post far far away... I saw this neat trick performed by sometimes99er. He coupled the big letters to Quasi particles, another very pretty effect. I tried to duplicate that effect with my sprite library and mutli-tasking but the effect was not as cool.? So armed with my new automotion code I revisIted this one. I realize now that my method for big characters is not the same as the original. Sometimes99er stretched characters horizontally but I stretched them vertically so I have more work to do. However here is the new code. It's very pretty. Thank you sometimes99er. Spoiler \ BIG characters and Quasi-particles in TI BASIC by sometimes99er \ Converted to Camel99 Forth with Automotion July 24 2019 \ A very clever character pattern method to create large characters \ Pattern bytes are stretch vertically and two patterns are created \ One for the upper case letter and one for the lower case letter. \ When the re-structured upper/lower case letters are printed on \ alternate lines, a large character appears. \ The original version in TI-XBASIC made extensive use of string functions \ to manipulate the character patterns. \ 100 CALL CLEAR::CALL SCREEN(5)::FOR A=5 TO 12::CALL COLOR(A,16,1)::NEXT A \ 110 N$="00030C0F30333C3FC0C300000000000000CCCFF0F3FCFF"::FOR A=65 TO 90 \ 120 CALL CHARPAT(A,C$)::PRINT CHR$(A)&CHR$(A+32);::FOR C=0 TO 1:: D$="" \ 130 FOR R=0 TO 7::D$=D$&SEG$(N$,(ASC(SEG$(C$,C+R*2+1,1))-48)*2+1,2)::NEXT R \ 140 CALL CHAR(A+C*32,D$)::NEXT C::NEXT A::PRINT::PRINT::N$="QUASIPARTICLES" \ 150 FOR A=1 TO LEN(N$)::PRINT SEG$(N$,A,1)&CHR$(ASC(SEG$(N$,A,1))+32);::NEXT A \ 160 FOR A=1 TO 28::CALL SPRITE(#A,46,16,1,124,8,RND*10-5)::NEXT A::GOTO 160 \ \ This alternative method reads data from VDP ram as HEX integers and cuts and \ recombines the integers to create the new patterns. \ Compile the libraries that we need. \ INCLUDE DSK1.TOOLS INCLUDE DSK1.AUTOMOTION ( brings in grafix and sprites) INCLUDE DSK1.RANDOM INCLUDE DSK1.CHARSET HEX : ?BREAK ?TERMINAL IF STOPMOTION 8 SCREEN DELALL CHARSET 4 19 2 1 COLORS CR ." *BREAK*" HONK ABORT THEN ; \ Manipulate bytes with SPLIT (integer->2 bytes) and FUSE (2 bytes->integer) : STRETCH1 ( 00AA -- AAAA) SPLIT DROP DUP FUSE ; \ removes top pixels : STRETCH ( AABB -- AAAA BBBB) SPLIT DUP FUSE SWAP DUP FUSE ; \ Chop a pattern into 2 patterns. Top half & lower half : SPLITPAT ( n n n n -- n n n n n n n n ) >R >R >R \ push 3 args to rstack STRETCH1 \ 1st arg is special R> STRETCH \ pop rstack & stretch R> STRETCH R> STRETCH 0000 ; \ CHARDEF need 4 args. \ read and write character patterns to/from Forth data stack : PATTERN@ ( ascii -- n n n n) ]PDT 8 BOUNDS DO I V@ 2 +LOOP ; : PATTERN! ( n n n n ascii -- ) ]PDT 8 BOUNDS SWAP 2- DO I V! -2 +LOOP ; HEX : UPPER? ( char -- ?) [CHAR] A [CHAR] Z 1+ WITHIN ; : LOWER ( c -- c ) DUP UPPER? IF 020 OR THEN ; \ create new patterns and re-write pattern description table : CHANGE-PATTERNS ( -- ) [CHAR] z [CHAR] A DO I PATTERN@ SPLITPAT ( -- n n n n n n n n ) I LOWER PATTERN! \ write lower case letter I PATTERN! \ write upper case letter LOOP ; \ got fancy here and made a word to print strings BIG : TYPE.LOW ( adr len -- ) OVER + SWAP DO I C@ LOWER EMIT LOOP ; : TYPE.BIG ( addr len -- ) 2DUP TYPE CR TYPE.LOW ; DECIMAL : QUASI ( -- ) AUTOMOTION MAX.SP MOVING \ make all sprites auto movers BEGIN MAX.SP 0 DO [CHAR] . 16 128 0 I SPRITE 15 14 RND 7 - I MOTION 100 MS ?BREAK LOOP AGAIN ; : RUN CLEAR 4 19 16 1 COLORS 5 SCREEN CR S" GENERATING PATTERNS" TYPE.BIG CR CR CHANGE-PATTERNS CR S" ABCDEFGHIJKLMNOPQRSTUVWXYZ" TYPE.BIG CR CR S" FORTH. NO STRINGS ATTACHED" TYPE.BIG CR QUASI ; QUASIPARTICLES.mp4 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted July 26, 2019 Author Share Posted July 26, 2019 One of the problems with building programming systems is that you don't have enough time to program applications with them. Long ago I had ideas that you could do some interesting sounds without resorting to sound lists. I thought it should be possible to use a lexicon of Forth commands instead. So the sometimes99er demo gave me a working platform to try some ideas. By creating an ATTACK and DECAY command with variable parameters, adding a fast delay ("uS") and using the HZ, DB words you can create some interesting sounds. Currently it is all running in the foreground so you have to break up attacks, on times and decays to integrate them into the other running code. Spoiler \ sound envelope control demo INCLUDE DSK1.TOOLS INCLUDE DSK1.AUTOMOTION ( brings in grafix and sprites) INCLUDE DSK1.RANDOM INCLUDE DSK1.CHARSET HEX INCLUDE DSK1.SOUND HEX : ?BREAK ?TERMINAL IF STOPMOTION SILENT 8 SCREEN DELALL CHARSET 4 19 2 1 COLORS CR ." *BREAK*" HONK ABORT THEN ; \ Manipulate bytes with SPLIT (integer->2 bytes) and FUSE (2 bytes->integer) : STRETCH1 ( 00AA -- AAAA) SPLIT DROP DUP FUSE ; \ removes top pixels : STRETCH ( AABB -- AAAA BBBB) SPLIT DUP FUSE SWAP DUP FUSE ; \ Chop a pattern into 2 patterns. Top half & lower half : SPLITPAT ( n n n n -- n n n n n n n n ) >R >R >R \ push 3 args to rstack STRETCH1 \ 1st arg is special R> STRETCH \ pop rstack & stretch R> STRETCH R> STRETCH 0000 ; \ CHARDEF need 4 args. \ read and write character patterns to/from Forth data stack : PATTERN@ ( ascii -- n n n n) ]PDT 8 BOUNDS DO I V@ 2 +LOOP ; : PATTERN! ( n n n n ascii -- ) ]PDT 8 BOUNDS SWAP 2- DO I V! -2 +LOOP ; HEX : UPPER? ( char -- ?) [CHAR] A [CHAR] Z 1+ WITHIN ; : LOWER ( c -- c ) DUP UPPER? IF 020 OR THEN ; \ create new patterns and re-write pattern description table : CHANGE-PATTERNS ( -- ) [CHAR] z [CHAR] A DO I PATTERN@ SPLITPAT ( -- n n n n n n n n ) I LOWER PATTERN! \ write lower case letter I PATTERN! \ write upper case letter LOOP ; \ got fancy here and made a word to print strings BIG : TYPE.LOW ( adr len -- ) BOUNDS DO I C@ LOWER EMIT LOOP ; : TYPE.BIG ( addr len -- ) 2DUP TYPE CR TYPE.LOW ; DECIMAL : uS ( delay -- ) 0 ?DO LOOP ; \ ~100uS loop speed : ATTACK ( delay endDB --) 30 ?DO I DB DUP uS -2 +LOOP DROP ; : DECAY ( delay startDB --) 32 SWAP ?DO I DB DUP uS 2 +LOOP DROP ; : SQUIRT 4 NOISE 300 RND 300 + 14 ATTACK MUTE GEN1 112 3 RND + HZ 2 DB 180 uS \ on time 60 2 DECAY ; : SQUIRTS ( N -- ) 0 ?DO SQUIRT [CHAR] . 13 10 RND - 128 0 I SPRITE 8 6 RND 3 - I MOTION 100 RND 50 + MS ?BREAK LOOP ; : TINKON GEN1 3700 500 RND + HZ ; : TINKOFF 30 4 DECAY ; : TINKS ( N -- ) 0 ?DO TINKON [CHAR] . 16 128 0 I SPRITE 18 16 RND 8 - I MOTION TINKOFF ?BREAK LOOP ; : PINGON GEN2 1100 HZ 0 DB ; : PINGOFF 700 uS 1200 2 DECAY ; : PINGS ( N -- ) 0 ?DO PINGON [CHAR] @ 16 128 0 I SPRITE 9 20 RND 10 - I MOTION PINGOFF ?BREAK LOOP ; DECIMAL 20 CONSTANT SPRITE# : QUASI ( -- ) AUTOMOTION SPRITE# MOVING \ make all sprites auto movers 0 MAGNIFY BEGIN SPRITE# RND SQUIRTS DELALL SPRITE# RND TINKS 5 RND PINGS AGAIN ; : RUN CLEAR 4 19 16 1 COLORS 2 SCREEN CHANGE-PATTERNS CR S" CAMEL 9 FORTH" TYPE.BIG CR CR CR S" SOUND ENVELOPES " TYPE.BIG CR CR S" WITHOUT SOUND LISTS!" TYPE.BIG CR QUASI ; soundevelopes.mp4 1 Quote Link to comment Share on other sites More sharing options...
D-Type Posted July 26, 2019 Share Posted July 26, 2019 2 hours ago, TheBF said: One of the problems with building programming systems is that you don't have enough time to program applications with them. This is the sad fact for Forth in modern times, everyone's so busy building their own Forth for the sake of building their own Forth, that there's no showcase applications being made! I decided not to build my own Forth, I'm adapting CamelForth 6809 to make a game or two that people can play on the Vectrex. I have to stop myself fiddling with the core Forth system every five minutes to make it better - that's the most difficult part! 2 Quote Link to comment Share on other sites More sharing options...
+FarmerPotato Posted July 26, 2019 Share Posted July 26, 2019 I have never, and am not writing my own FORTH. However, I have spent most of two years building hardware to run FORTH. So I'm guilty in a different way. I did manage to write a good amount of application code though (SD card FAT filesystem and a music compiler/player.) SVFIG demonstrates several showcase applications at each meeting (4th Saturday of the month at Stanford.) It's streamed on YouTube. One member built a slide show program in FORTH, based on his work on a font package, so that he could talk about FORTH using FORTH, not PowerPoint. Dr Ting is a regular presenter, and Charles Moore occasionally. Dr. Ting is the author of "Zen and the FORTH language" and others.. As for making new personal FORTHs, I know Dr. Ting makes several for tiny microprocessors like AVR, but especially MSP430 and the TI LaunchPad with FRAM. 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted July 27, 2019 Author Share Posted July 27, 2019 16 hours ago, D-Type said: This is the sad fact for Forth in modern times, everyone's so busy building their own Forth for the sake of building their own Forth, that there's no showcase applications being made! I decided not to build my own Forth, I'm adapting CamelForth 6809 to make a game or two that people can play on the Vectrex. I have to stop myself fiddling with the core Forth system every five minutes to make it better - that's the most difficult part! Guilty as charged. I also used Camel Forth for the high level code but I wrote the low level primitives and of course although you only need 35 or so it goes so much faster if you write 100 or more! :-) Adding more charges to my case, I wanted to see if I could write the compiler first on a different machine! A truly masochistic enterprise is writing a cross-compiler. It really is an exercise in pulling your self up by your own bootstraps. ( but it feels sooo good when the damned thing works) Did I mention that my obsession then led me to make two other cross-compilers after the first one worked. ... and of course they all need libraries and demo programs and... Gotta go now. There is more code to write! 3 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.