+TheBF Posted March 19, 2021 Author Share Posted March 19, 2021 An interesting variation that I think has better long term potential I think this is in the realm of an 'open" hash-table. HASH the string using a smaller PRIMEDIV constant (501) to MOD the result If the bucket is empty use it If the bucket is occupied add the PRIMEDIV to the hash# and test that bucket repeat until an empty memory location is found 509 CONSTANT PRIMEDIV : DJB2A ( addr len -- hash) 5381 -ROT \ initial long hash seed goes under string BOUNDS DO 33 * I C@ XOR LOOP PRIMEDIV MOD \ "lazy" mod limits hash table size ; : HASHNAME ( addr len -- ndx) 2DUP CR TYPE \ debug DJB2A DEEP OFF \ debug line BEGIN DUP ]BUCKET @ WHILE ( bucket<>0) \ **we have a collision** COLLISION 1+! \ debug count the collisions DEEP 1+! PRIMEDIV + \ *NEW* test 509 buckets away DUP ." :" . \ debug REPEAT ; The results with the first method ( increment bucket by 1) gave far less collisions initially but near the end collisions were more frequent and there was one word with a 4 collision list. It seemed to degrade fast after we go beyond 300 words. The new method have more total collisions but they are more randomly distributed and the longest search list was 2. Seem like a better strategy. 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted March 19, 2021 Share Posted March 19, 2021 14 hours ago, TheBF said: Hash the dictionary use Bernstein DJB2A string hashing method. The hashing word uses 2039 prime number to MOD the output hash value to limit the number of buckets in the hash table to stay in a table of 4K bytes. DECIMAL 2031 CONSTANT PRIMEDIV : DJB2A ( addr len -- hash) 5381 -ROT \ initial long hash seed goes under string BOUNDS DO 33 * I C@ XOR LOOP PRIMEDIV MOD \ "lazy" mod limits hash table size ; Though I understand the use of a prime number for the starting hash, I am not sure that extends to the modulus for limiting the hash table size. I would think you could use the actual table size of 2048, which you could then more efficiently calculate with DECIMAL 2047 CONSTANT TABLESIZ \ hex 07FF table size mask : DJB2A ( addr len -- hash) 5381 -ROT \ initial long hash seed goes under string BOUNDS DO 33 * I C@ XOR LOOP TABLESIZ AND \ "lazy" AND limits hash table size ; By the way, 2031 is not prime, having 3 and 677 as factors. Perhaps you meant to use 2039, the highest prime less than 2 KiB. ...lee Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 19, 2021 Author Share Posted March 19, 2021 Yes that is a mistake. I am working too fast ... again. I didn't think it would matter either using a prime for the modulus divide but it actually did make a difference. It's really non-linear which I guess is what we want. I will try your version and see what I get. Have to run out to do some errands so it may have to wait until tomorrow. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 19, 2021 Author Share Posted March 19, 2021 To show you want I mean by non-linear here are some sample methods and results. So far I am liking 509 because it seems stable. I need to try adding more words and watch where it starts to die. I am calling it open Hashing where the table grows outside of the primary modulus limit. Weird how 2047 MOD does better than 2039 MOD when I thought prime numbers worked best always. Clearly not so. But MOD seems better than AND at least as far as I have tested. The FNV1 page mentions that you can use MOD but they recommended XOR folding with 32bit values to limit the size of the hash#. Not sure that would help in 16bit space. I will try with a partial number of bits: >BEEF DUP 5 RSHIFT XOR ( something like that) replacing the MOD) EDIT: lol That method of XOR folding still needs limiting to stay inside the 4K byte limit. Wrap method Words Collisions Collision handler Max List Len. Last Address #2047 AND 403 62 1+ 10 >2FFE #2047 MOD 403 49 1+ 3 >2FFC #2039 MOD 403 51 1+ 6 >2FE8 Open Hashing #509 MOD 403 139 509 + 2 >2BD6 #1019 MOD 403 142 1019 + 3 >3086 #521 MOD 403 160 521 + 5 >3436 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 22, 2021 Author Share Posted March 22, 2021 Experimental Version of a Hashed Dictionary I spent some time making this work to see what would happen. The HFIND (hashed-find) code is very ugly and the hashing computation is done in Forth and I am tracking some statistics too. That's clearly not optimal but testing with a pretty big file (DSK1.ANSFILE) the compile time is faster by 40%. When I consider that my entire linked-list FIND is written in Assembler except for the the parameter passing we can see how hashing the dictionary really speeds things up since Forth code is beating the Assembler version. CONS This consumes 4K of Low RAM for the hash table and 1168 bytes for this (slightly pregnant) code so it's not a good fit for the TI 99. I think the F83/PolyForth method that uses multiple strands of linked-lists to shorten the searches is a better fit. Back to the drawing board. :) Note: In the end I used 2047 MOD to limit the hash table size and simple incrementing to handle a collision. Spoiler \ HASHED dictionary lookup using DJB2 for Camel99 Forth Mar 22 2021 Fox NEEDS DUMP FROM DSK1.TOOLS NEEDS ELAPSE FROM DSK1.ELAPSE HERE NEEDS VALUE FROM DSK1.VALUES NEEDS COMPARE FROM DSK1.COMPARE HEX 2000 CONSTANT BUCKETS \ hash table base address DECIMAL 2047 CONSTANT PRIMEDIV : DJB2A ( addr len -- hash) 5381 -ROT \ initial long hash seed goes under string BOUNDS DO 33 * I C@ XOR LOOP PRIMEDIV MOD \ "lazy" mod limits hash table size ; HEX : CLRTABLE ( -- ) BUCKETS 2000 0 FILL 3000 H ! ; \ MOVE : ]BUCKET ( -- ) CELLS BUCKETS + ; \ hash table as array \ ================================== VARIABLE WORDCNT VARIABLE COLLISION \ analysis code records highest address used in the table & lastbucket VARIABLE MAXADDR VARIABLE LASTBUCKET : KEEPMAX MAXADDR @ MAX MAXADDR ! ; : ]BUCKET! ( cfa ndx -- ) ( DUP . ) ]BUCKET DUP LASTBUCKET ! DUP KEEPMAX ! ; : NAME$ ( nfa -- addr len ) COUNT 1F AND ; \ track maximum list lengths for a given hash VARIABLE DEEP VARIABLE LISTLEN VARIABLE LASTNFA : LISTLEN! LISTLEN @ DEEP @ MAX LISTLEN ! ; : HASHNAME ( addr len -- ndx) \ 2DUP CR TYPE \ debug DJB2A DUP LASTNFA ! DEEP OFF \ debug line: count list depth BEGIN DUP ]BUCKET @ WHILE ( bucket<>0) COLLISION 1+! \ debug count the collisions DEEP 1+! 1+ \ try next bucket \ DUP ." :" . \ debug REPEAT ; : HASHEM COLLISION OFF MAXADDR OFF CONTEXT @ @ ( nfa) BEGIN ( nfa) DUP DUP NAME$ HASHNAME ( nfa Hash# ) ]BUCKET! KEY? IF KEY DROP THEN \ debug, stop scroll NFA>LFA @ DUP \ fetch next nfa WHILE WORDCNT 1+! \ nice to know LISTLEN! \ debug line REPEAT DROP DECIMAL CR WORDCNT @ . SPACE ." words hashed" CR COLLISION @ . ." collisions" CR ." Max Address = " HEX MAXADDR @ . CR ." Longest list = " DECIMAL LISTLEN @ . CR ." " CR ." ---" ; : HASHDICT ( -- ) CLRTABLE WORDCNT OFF HASHEM ; \ gratuitous variables made it much simpler. Mea Culpa :) VARIABLE HASH# VARIABLE NFA : 2OVER 3 PICK 3 PICK ; : IMMED? ( nfa -- ?) 1- C@ 1 AND 0= ; : HFIND ( Caddr -- xt 0 if not found) \ xt 1 if immediate \ xt -1 if "normal" NFA OFF DUP COUNT 2DUP DJB2A HASH# ! ( addr len ) BEGIN HASH# @ ]BUCKET @ DUP NFA ! DUP WHILE \ while nfa<>0 ( nfa) NAME$ 2OVER COMPARE WHILE \ and while the strings <> HASH# 1+! \ try the next bucket REPEAT THEN 2DROP NFA @ 0= IF DROP THEN NFA @ DUP IF NIP DUP NFA>CFA \ -- nfa xt SWAP IMMED? \ -- xt iflag 1 OR \ -- xt 1/-1 THEN ; ====================================================================== \ D I C T I O N A R Y C R E A T I O N \ *wid is "wordlist identifier" : HASHHEAD, ( addr len --) ALIGN CURRENT @ DUP>R \ Fetch CURRENT wid, make a copy for later \ === compile the header fields === @ , \ wid @ gives NFA, compile into new LFA field 0 C, \ compile the precedence byte (immediate flag) HERE DUP LATEST ! \ HERE is now a new NFA, store NFA in LATEST R> ! \ also store in current 'WID' we saved earlier 2DUP HERE -ROT HASHNAME ]BUCKET! S, ; \ compile the (addr len) string as the name. : HEADER ( <text> --) BL PARSE-WORD HASHHEAD, ; \ ====================================================================== \ D E F I N I N G W O R D S \ text runtime-action parameter \ ------- --------------- ----------- : CONSTANT ( n --) HEADER POSTPONE DOCON COMPILE, ; : USER ( n --) HEADER POSTPONE DOUSER COMPILE, ; : CREATE ( -- ) HEADER POSTPONE DOVAR ; : VARIABLE ( -- ) CREATE 0 COMPILE, ; \ control find to use hash table or linked list : HASH-ON ['] HFIND 'FIND ! ; : HASH-OFF ['] <FIND> 'FIND ! ; HERE .S \ CR HERE SWAP - DECIMAL . .( bytes) CR .( Hashing dictionary ...) HASHDICT HASH-OFF 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 29, 2021 Author Share Posted March 29, 2021 I have been spending more time trying to remove bytes from my system. I managed to re-work the primitive file reader in the 8K kernel with: FOPEN ( $ len b/rec mode --) and FGET ( buffer -- len) These became common factors to simplify the rather verbose file access word-set required by ANS 94 Forth. The ANSFILES library compiles, after my reductions, to 1,200ish bytes instead of 1360ish bytes before so a nice improvement. But... I was staring at the ANS Forth file words and thought how hard would it be to make something simpler, more like BASIC? Turns out not too hard and it only required 608 bytes of code space! Terrible dilemma this. Write standard compliant code or TI-99 specific code. I guess having both let's me choose. By the way, I feel that with efficient VDP read/write routines for bytes, integers and blocks of memory that are as easily used as CPU RAM operators there is little need to build the PAB in RAM and block write it into VDP. Some of this is because Forth is not as fast as native code so the speed difference in Forth to read/write RAM vs VDP RAM is not very big. I think this is why this implementation was simpler to create. For those not familiar with the Camel99 Kernel (almost everybody) The [PAB FLG] words and others like that create a [base-address + offset] syntax to make navigating the PAB easier for people like me. Spoiler \ SIMPLEFILE.FTH NON ANS Files for the low-fat computing Mar 27 2021 FOX HERE \ pab definer uses PSZ (pab size = 300 bytes) to compute the PAB address : PAB: ( n -- ) CREATE PSZ * VDPTOP SWAP - , DOES> @ ^PAB ! ; \ make 3 predefined peripheral access blocks. \ Each one sets the current PAB as active in the ^PAB variable 1 PAB: #1 2 PAB: #2 3 PAB: #3 \ modify the pab flag field directly : VOR! ( c --) [PAB FLG] TUCK VC@ OR SWAP VC! ; : VAND! ( c --) [PAB FLG] TUCK VC@ AND SWAP VC! ; \ Primary access mode words must be used first 2 BASE ! : UPDATE ( --) [PAB BL 0 VFILL 11111001 [PAB FLG] VC! ; : INPUT ( --) UPDATE 00000100 VOR! ; : OUTPUT ( --) UPDATE 00000010 VOR! ; : APPEND ( --) UPDATE 00000110 VOR! ; \ TI-99 file access mode modifiers are used second : DISPLAY ( --) 11110111 VAND! ; : SEQUENTIAL ( --) 11111110 VAND! ; : RELATIVE ( --) 00000001 VOR! ; : INTERNAL ( --) 00001000 VOR! ; VARIABLE B/REC : VARI ( size --) [PAB RECLEN] VC! 00010000 VOR! ; : FIXED ( size --) [PAB RECLEN] VC! 11101111 VAND! ; DECIMAL : DV80 ( -- ) UPDATE DISPLAY SEQUENTIAL 80 VARI ; : DF128 ( -- ) UPDATE INTERNAL RELATIVE 128 FIXED ; : OPEN ( $addr len -- ) [PAB FNAME] DUP \ -- addr len Vaddr Vaddr 32 + [PAB FBUFF] V! \ FBUFF=32 bytes past fname VPLACE \ write string to [PAB FNAME] 0 FILEOP ?FILERR ; \ open the file, return err code : READ ( buffer -- len ) 2 FILEOP ?FILERR FGET ; : CLOSE ( -- ) 1 FILEOP ?FILERR ; : WRITE ( addr len --) DUP [PAB CHARS] VC! [PAB FBUFF] V@ SWAP VWRITE 3 FILEOP ?FILERR ; : EOF ( -- c) (EOF) ; : RECORD# ( -- rec#) [PAB REC#] V@ [PAB FLG] VC@ ?FILERR ; : SEEK ( rec# --) [PAB REC#] V! 4 FILEOP ?FILERR ; : DELETE ( caddr len -- ior) OPEN 7 FILEOP ?FILERR CLOSE ; HERE SWAP - DECIMAL . Using these words is about as simple as BASIC. The use of #1 repeatedly below is not actually needed if you are only working with one file. It would probably be a good habit however. CREATE A$ 80 ALLOT : SEEFILE ( addr len ) #1 DV80 OPEN BEGIN A$ DUP #1 READ CR TYPE #1 EOF UNTIL #1 CLOSE ; Usage: S" DSK1.MYFILE" SEEFILE 2 Quote Link to comment Share on other sites More sharing options...
GDMike Posted March 29, 2021 Share Posted March 29, 2021 3 minutes ago, TheBF said: almost everybody) Lol 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 30, 2021 Author Share Posted March 30, 2021 I have been noodling over this concept for a while and I finally figured out how to do in a way that makes more sense to me. The concept is using numbered labels for Forth Assembler. I don't want to use them all the time but it can really reduce complexity when you know that all you want to do is jump out of loop on an error condition or save some space by jumping into the middle of a code word. I have something that works similarly in the XFC99 cross-compiler but it has the limitation of each forward jump must be matched by a matching label. You cannot have for example three different jumps to the same place in the code unless you add three labels there. Yuk! I reviewed some code from DxForth but found it difficult to follow so I re-wrote it with a push down stack to handle all the jump locations. The key to the whole thing was to push not only the address of the jump instruction but also index number. Then use the pushed index number to reference the label later when you are resolving the jumps. Like most things it was trivial once I understood it. This version is for a Forth cross-assembler for TI-99. You can replace THERE with HERE for normal Forth Assemblers. The ultimate goal is to cross-compile the Camel99 Kernel with Camel99. I need some labels to use the existing source code. (I may back migrate these to the cross-compiler because they are better) Here is the kind of code that can be assembled with this system. Source is in the spoiler. HEX 2020 ORG CODE TEST2 1 $: R7 1000 AI, \ BEGIN R7 R1 CMP, 2 $ JLT, \ GTE IF R4 CLR, R5 CLR, R6 CLR, R8 R7 SUB, 2 $: 1 $ JMP, NEXT, ENDCODE 2000 50 DUMP 2040 ORG CODE TEST3 TOS TOS MOV, 1 $ JNE, \ THERE >FS 1 >FS R0 R0 MOV, 1 $ JEQ, \ THERE >FS 1 >FS R1 R1 CMP, 1 $ JNO, \ THERE >FS 1 >FS R5 R1 ADD, R1 R2 ADD, 1 $: NEXT, \ THERE [1]LABL ! ENDCODE 2040 30 DUMP Spoiler \ Numbered assembler labels for Camel99 Mar 2021 Fox \ Concept first seen in DxForth. Thanks Ed. \ Complete re-write using a push down stack \ *** for cross-assembler *** NEEDS DUMP FROM DSK1.TOOLS NEEDS MOV, FROM DSK1.XASM9900 MARKER /LABELS DECIMAL 25 CONSTANT #FWD 20 CONSTANT #LABELS \ Make a stack to handle jumps CREATE FS0 #FWD CELLS ALLOT FS0 CREATE FSP , \ fwd stack pointer, initialzed to FS0 : FSDEPTH ( -- n) FS0 FSP @ - 2/ ; : >FS ( addr --) 2 FSP +! FSP @ ! ; : FS> ( -- addr) FSP @ DUP FS0 = ABORT" Label stack empty" @ -2 FSP +! ; CREATE LABELS #LABELS CELLS ALLOT : ]LBL ( n -- addr) CELLS LABELS + ; \ array of label addresses : NEWLABELS ( -- ) LABELS #LABELS CELLS 0 FILL \ clear label array FS0 FSP ! \ reset fwd stack pointer to base address ; : $: ( n -- ) THERE SWAP ]LBL ! ; : $ ( n -- 0) THERE >FS >FS 0 ; \ push address and index. Return zero : ?LABEL ( addr -- addr) DUP 0= ABORT" Un-resolved forward jump" ; : RESOLVER ( -- ) BEGIN FSDEPTH WHILE FS> ]LBL @ ?LABEL ( lbladdress ) FS> TUCK - ( jmpaddr offset) RESOLVE REPEAT ; : +CODE ( <name> ) CODE ; \ used to jump across CODE words : CODE ( <name> ) CODE NEWLABELS ; : ENDCODE ( -- ) ?CSP RESOLVER ; This word is in the XASM9900 assembler, you need it for RESOLVER : RESOLVE ( addr offset --) 2- 2/ SWAP 1+ C! ; 2 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted March 30, 2021 Share Posted March 30, 2021 14 hours ago, TheBF said: Here is the kind of code that can be assembled with this system. TEST2 appears to me to be an infinite loop. Was that your intent or is my analysis flawed? ...lee 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 30, 2021 Author Share Posted March 30, 2021 You are correct. The code was just nonsense to let me monitor if the jumps were being computed correctly forward and backwards I have been stewing on how to do this for quite a while. It was a relief to see the jumps compile properly. I think it is pretty transportable too and it's actually smaller than what I used before. The hand made stack is an idea from Camel Forth. Brad did this for the LEAVE stack. (without error detection) I tried my library version of a stack and it was more complicated to reset and the error message was generic on underflow so another case where libraries are not always the answer. 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 30, 2021 Author Share Posted March 30, 2021 In case you want to try it on FbForth here is the RESOLVE word from my assembler. I think that is the only missing piece. : RESOLVE ( addr offset --) 2- 2/ SWAP 1+ C! ; 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted March 30, 2021 Share Posted March 30, 2021 14 hours ago, TheBF said: Source is in the spoiler. A couple of stack-effect nits: FS> ( -- addr ) \ addr is left on the stack rather than consumed ?LABEL ( addr -- addr ) \ addr is not consumed ...lee 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted March 30, 2021 Author Share Posted March 30, 2021 Just now, Lee Stewart said: A couple of stack-effect nits: FS> ( -- addr ) \ addr is left on the stack rather than consumed ?LABEL ( addr -- addr ) \ addr is not consumed ...lee Thank you sir. I will ammend the code. 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted March 30, 2021 Share Posted March 30, 2021 7 minutes ago, TheBF said: In case you want to try it on fbForth here is the RESOLVE word from my assembler. I think that is the only missing piece. : RESOLVE ( addr offset --) 2- 2/ SWAP 1+ C! ; Thanks for that! RESOLVER certainly did not work with the code I had found, which was for resolving branching code. ,,,lee 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 3, 2021 Author Share Posted April 3, 2021 On comp.lang.forth there was a discussion on how to write a reference implementation of TYPE for the Forth Standard web site. A creative use of the word COUNT was presented. I would have never thought of this. Of course PAUSE is not needed in single thread systems. : TYPE ( addr cnt -- ) PAUSE 0 ?DO COUNT EMIT LOOP DROP ; Edit: The new version above of TYPE is 8% faster than what I used before : TYPE ( addr cnt -- ) PAUSE BOUNDS ?DO I C@ EMIT LOOP ; 2 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted April 3, 2021 Share Posted April 3, 2021 4 hours ago, TheBF said: A creative use of the word COUNT was presented. I would have never thought of this. Of course PAUSE is not needed in single thread systems. : TYPE ( addr cnt -- ) PAUSE 0 ?DO COUNT EMIT LOOP DROP ; Though the use of COUNT is certainly clever, I should think the figForth version of the loop contents used in TI Forth and fbForth is faster because COUNT requires an additional word, SWAP : : TYPE ( addr cnt -- ) PAUSE 0 ?DO DUP C@ EMIT 1+ LOOP DROP ; ...lee 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 3, 2021 Author Share Posted April 3, 2021 4 minutes ago, Lee Stewart said: Though the use of COUNT is certainly clever, I should think the figForth version of the loop contents used in TI Forth and fbForth is faster because COUNT requires an additional word, SWAP : : TYPE ( addr cnt -- ) PAUSE 0 ?DO DUP C@ EMIT 1+ LOOP DROP ; ...lee Yes for certain if COUNT is written in Forth it's not advisable. In my case I wrote COUNT in CODE and actually sandwiched it with C@. CODE: COUNT ( addr -- addr' u) TOS PUSH, \ make a copy of addr *SP INC, \ inc. past the count byte l: _C@ *TOS TOS MOVB, \ put C@ inline to save space TOS 8 SRL, NEXT, END-CODE CODE: C@ _C@ CFA! END-CODE \ give _C@ a dictionary header 2 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted April 3, 2021 Share Posted April 3, 2021 44 minutes ago, TheBF said: Yes for certain if COUNT is written in Forth it's not advisable. In my case I wrote COUNT in CODE and actually sandwiched it with C@. Very nice! ...lee 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 6, 2021 Author Share Posted April 6, 2021 Lee just posted Tombstone city in another thread and I saw the sound lists so I tested out my conversion to Camel99 VDP sound lists. The Assembler code works with just a few search and replace jobs and adding the speed equates as constants. VBYTE uses EVALUATE on the line of comma delimited text so it correctly interprets constants and any valid Forth expression. Sidebar: As a musician and having done some orchestration I hear/see the opportunity to condense this data. There are some repeated sections that could be managed by making each MEASURE comment below a separate FORTH word and then sequencing them using loop structures for each section of the tune. This is how music notation works to save paper and reduce page-turns by the musicians. Spoiler DECIMAL 80 CONSTANT SPEED1 20 CONSTANT SPEED2 10 CONSTANT SPEED3 40 CONSTANT SPEED4 HEX VCREATE HELLINTEXAS \ SOUND LIST. \ TEXASDUMP VBYTE 4,9F,BF,DF,FF,01 \ MEASURE: 0001 VBYTE 04,80,0F,90,BF,SPEED3 VBYTE 04,80,0F,90,BF,SPEED3 \ MEASURE: 0002 VBYTE 06,86,0D,90,AF,2C,B0,SPEED2 VBYTE 06,80,0F,90,AB,23,B0,SPEED2 VBYTE 06,80,0F,90,A0,1E,B0,SPEED2 VBYTE 06,80,0F,90,AF,2C,B0,SPEED2 VBYTE 06,8D,11,90,AB,23,B0,SPEED2 VBYTE 06,8D,11,90,A0,1E,B0,SPEED2 \ MEASURE: 0003 VBYTE 06,80,14,90,AF,2C,B0,SPEED2 VBYTE 06,88,16,90,AB,23,B0,SPEED2 VBYTE 06,8D,11,90,A0,1E,B0,SPEED2 VBYTE 06,80,0F,90,AF,2C,B0,SPEED2 VBYTE 06,80,0F,90,AB,23,B0,SPEED2 VBYTE 06,80,0F,90,A0,1E,B0,SPEED2 \ MEASURE: 0004 VBYTE 06,8C,1A,90,A7,35,B0,SPEED2 VBYTE 06,88,16,90,AF,2C,B0,SPEED2 VBYTE 06,88,16,90,AB,23,B0,SPEED2 VBYTE 06,80,14,90,A7,35,B0,SPEED2 VBYTE 06,88,16,90,AF,2C,B0,SPEED2 VBYTE 06,80,14,90,AB,23,B0,SPEED2 \ MEASURE: 0005 VBYTE 06,8D,11,90,AF,2C,B0,SPEED2 VBYTE 06,80,0F,90,AB,23,B0,SPEED2 VBYTE 06,80,0F,90,A0,1E,B0,SPEED2 VBYTE 06,80,0F,90,AF,2C,B0,SPEED2 VBYTE 06,80,0F,90,AB,23,B0,SPEED2 VBYTE 06,80,0F,90,A0,1E,B0,SPEED2 \ MEASURE: 0006 VBYTE 06,86,0D,90,AF,2C,B0,SPEED2 VBYTE 06,80,0F,90,AB,23,B0,SPEED2 VBYTE 06,80,0F,90,A0,1E,B0,SPEED2 VBYTE 06,80,0F,90,AF,2C,B0,SPEED2 VBYTE 06,8D,11,90,AB,23,B0,SPEED2 VBYTE 06,8D,11,90,A0,1E,B0,SPEED2 \ MEASURE: 0007 VBYTE 06,80,14,90,AF,2C,B0,SPEED2 VBYTE 06,88,16,90,AB,23,B0,SPEED2 VBYTE 06,8D,11,90,A0,1E,B0,SPEED2 VBYTE 06,80,0F,90,AF,2C,B0,SPEED2 VBYTE 06,80,0F,90,AB,23,B0,SPEED2 VBYTE 06,80,0F,90,A0,1E,B0,SPEED3 VBYTE 06,80,0F,90,A0,1E,B0,SPEED3 \ MEASURE: 0008 VBYTE 06,8C,1A,90,A7,35,B0,SPEED2 VBYTE 06,88,16,90,AF,2C,B0,SPEED2 VBYTE 06,88,16,90,AB,23,B0,SPEED2 VBYTE 06,80,14,90,A7,35,B0,SPEED2 VBYTE 06,88,16,90,AF,2C,B0,SPEED2 VBYTE 06,80,14,90,AB,23,B0,SPEED2 \ MEASURE: 0009 VBYTE 06,8D,11,90,AF,2C,B0,SPEED2 VBYTE 06,88,16,90,AB,23,B0,SPEED2 VBYTE 06,80,14,90,A0,1E,B0,SPEED2 VBYTE 06,88,16,90,AF,2C,B0,SPEED2 VBYTE 06,88,16,90,AB,23,B0,SPEED2 VBYTE 06,88,16,90,A0,1E,B0,SPEED2 \ MEASURE: 0010 VBYTE 06,8C,1A,90,A7,35,B0,SPEED2 VBYTE 06,88,16,90,AF,2C,B0,SPEED2 VBYTE 06,88,16,90,AB,23,B0,SPEED2 VBYTE 06,8C,1A,90,A7,35,B0,SPEED2 VBYTE 06,88,16,90,AF,2C,B0,SPEED2 VBYTE 06,88,16,90,AB,23,B0,SPEED2 \ MEASURE: 0011 VBYTE 06,8D,17,90,AA,2F,B0,SPEED2 VBYTE 06,88,16,90,AF,2C,B0,SPEED2 VBYTE 06,88,16,90,AF,2C,B0,SPEED2 VBYTE 06,80,0F,90,AB,23,B0,SPEED2 VBYTE 06,80,0F,90,AB,23,B0,SPEED2 VBYTE 06,80,0F,90,A0,1E,B0,SPEED3 VBYTE 06,80,0F,90,A0,1E,B0,SPEED3 \ MEASURE: 0012 VBYTE 06,8C,1A,90,A7,35,B0,SPEED2 VBYTE 06,88,16,90,AF,2C,B0,SPEED2 VBYTE 06,88,16,90,AB,23,B0,SPEED2 VBYTE 06,80,14,90,A7,35,B0,SPEED2 VBYTE 06,88,16,90,AF,2C,B0,SPEED2 VBYTE 06,80,14,90,AB,23,B0,SPEED2 \ MEASURE: 0013 VBYTE 06,8D,11,90,AF,2C,B0,SPEED2 VBYTE 06,80,0F,90,AB,23,B0,SPEED2 VBYTE 06,80,0F,90,A0,1E,B0,SPEED2 VBYTE 06,80,0F,90,AF,2C,B0,SPEED2 VBYTE 06,80,0F,90,AB,23,B0,SPEED2 VBYTE 06,80,0F,90,A0,1E,B0,SPEED3 VBYTE 06,80,0F,90,A0,1E,B0,SPEED3 \ MEASURE: 0014 VBYTE 06,86,0D,90,AF,2C,B0,SPEED2 VBYTE 06,80,0F,90,AB,23,B0,SPEED2 VBYTE 06,80,0F,90,A0,1E,B0,SPEED2 VBYTE 06,80,0F,90,AF,2C,B0,SPEED2 VBYTE 06,8D,11,90,AB,23,B0,SPEED2 VBYTE 06,8D,11,90,A0,1E,B0,SPEED2 \ MEASURE: 0015 VBYTE 06,80,14,90,AF,2C,B0,SPEED2 VBYTE 06,88,16,90,AB,23,B0,SPEED2 VBYTE 06,8D,11,90,A0,1E,B0,SPEED2 VBYTE 06,80,0F,90,AF,2C,B0,SPEED2 VBYTE 06,80,0F,90,AB,23,B0,SPEED2 VBYTE 06,80,0F,90,A0,1E,B0,SPEED2 \ MEASURE: 0016 VBYTE 06,8C,1A,90,A7,35,B0,SPEED2 VBYTE 06,88,16,90,AF,2C,B0,SPEED2 VBYTE 06,88,16,90,AB,23,B0,SPEED2 VBYTE 06,80,14,90,A7,35,B0,SPEED2 VBYTE 06,88,16,90,AF,2C,B0,SPEED2 VBYTE 06,80,14,90,AB,23,B0,SPEED2 \ MEASURE: 0017 VBYTE 06,8D,11,90,AF,2C,B0,SPEED2 VBYTE 06,88,16,90,AB,23,B0,SPEED2 VBYTE 06,80,14,90,A0,1E,B0,SPEED2 VBYTE 06,88,16,90,AB,23,B0,SPEED4 VBYTE 06,88,16,90,AB,23,B0,SPEED2 \ MEASURE: 0018 VBYTE 04,88,16,90,BF,SPEED2 VBYTE 00,10,1A /VEND Hell InTexas.mp4 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 6, 2021 Author Share Posted April 6, 2021 Ahhh yes. And when I play the same data with the ISRPLAY library it has a continuous repeat built into it. Its starting to get on my nerves about now NEEDS VHERE FROM DSK1.VDPMEM HEX 83C2 CONSTANT AMSQ \ interrupt DISABLE bits \ AMSQ bit meaning: \ 80 all interrupts disabled \ 40 motion disabled \ 20 Sound disabled \ 10 quit key disabled \ VDP byte string compiler : ?BYTE ( n -- ) FF00 AND ABORT" Not a byte" ; : VBYTE ( -- ) BEGIN [CHAR] , PARSE-WORD DUP WHILE EVALUATE DUP ?BYTE VC, REPEAT 2DROP ; : /VEND 0 VC, 0 VC, ; \ end the list with 2 bytes CODE 0LIMI ( -- ) 0300 , 0000 , NEXT, ENDCODE CODE 2LIMI ( -- ) 0300 , 0002 , NEXT, ENDCODE \ ........................................ \ ISR Sound List Player HEX : ISRPLAY ( vaddr -- ) 0LIMI \ interrupts off 83CC ! \ Vaddr -> sound table AMSQ C@ 5 AND AMSQ C! \ enable sound interrupts 01 83CE C! \ trigger sound list processing 83FD C@ 01 OR 83FD C! \ set "VRAM is source" flag 2LIMI ; \ interrupts on 1000 VP ! \ reset VDP memory heap 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 6, 2021 Author Share Posted April 6, 2021 I may have found a good way to use Super Cart. How about you put all your programming tools in there and leave the rest of RAM for your program. CR .( Developer Tools to SUPER CART @>6000 ) HEX : ?SUPERCART BEEF 6000 ! 6000 @ BEEF <> ABORT" Super Cart not found" ; ?SUPERCART \ SAVEDP holds the LINK field of the 1st new word we will create in HI RAM VARIABLE SAVEDP LATEST @ CONSTANT KEEP \ remember latest name field address CR .( Set up low ram compiling ...) HERE SAVEDP ! \ save the dictionary pointer. 6000 DP ! \ DP points to SUPER cart HERE ( to compute space used in SuperCart) INCLUDE DSK1.WORDLISTS ONLY FORTH DEFINITIONS INCLUDE DSK1.ELAPSE INCLUDE DSK1.TOOLS VOCABULARY ASSEMBLER ALSO ASSEMBLER DEFINITIONS INCLUDE DSK1.ASM9900 INCLUDE DSK1.ASMLABELS HERE SWAP - DECIMAL CR . .( bytes in super cart) CR CR .( Restore high ram compiling ...) SAVEDP @ DP ! \ restore DP back to original address FORTH DEFINITIONS HEX : REMOVE-TOOLS ( -- ) KEEP SAVEDP @ ! \ relink the dictionary 2000 H ! ; \ init-the heap to low RAM DECIMAL .FREE 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 6, 2021 Author Share Posted April 6, 2021 So I found this benchmark. Tried it on GForth 32bit (Windows 10, Dell i7 3.4GHz) and it returned ok immediately after I pressed return. I defined CARRAY like this for Camel99 Forth : CARRAY ( n -- ) CREATE ALLOT ALIGN DOES> ( n -- addr) + ; ... and the results are on the screen capture. And that is for only 1 iteration because 2 iterations exceeded my 9 minute screen timer. Note: Changing CARRAY to this: : CARRAY ( n -- ) CREATE ALLOT ALIGN ;CODE ( n -- addr) W TOS ADD, NEXT, ENDCODE reduced the time to 5:27.23 Spoiler \ ******************** \ Eight queens problem \ ******************** \ Taken from SP-Forth 4 - samples\bench\queens.f \ Al.Chepyzhenko DECIMAL 8 CARRAY Gori 8 CARRAY Verti 15 CARRAY Dio1 15 CARRAY Dio2 : Clear ( -- ) 8 0 DO 0 I Verti C! LOOP 15 0 DO 0 I Dio1 C! LOOP 15 0 DO 0 I Dio2 C! LOOP ; : Check ( n -- f ) Clear TRUE SWAP 1+ 0 DO I Gori C@ DUP Verti DUP C@ IF DROP DROP DROP FALSE ELSE TRUE SWAP C! DUP I + Dio1 DUP C@ IF DROP DROP DROP FALSE ELSE TRUE SWAP C! DUP 7 + I - Dio2 DUP C@ IF DROP DROP DROP FALSE ELSE TRUE SWAP C! DROP TRUE AND THEN THEN THEN LOOP ; : Print ( -- ) 8 0 DO I Gori C@ . LOOP CR ; : TRYTO ( n ) 8 0 DO I OVER Gori C! DUP Check IF DUP 7 < IF DUP 1+ RECURSE THEN THEN LOOP DROP ; 2 CONSTANT /QUEENS : $QUEENS$ \ -- CR ." Eight Queens Problem" /QUEENS 0 DO 0 TRYTO LOOP /QUEENS ; Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 6, 2021 Author Share Posted April 6, 2021 For another reference point Turbo Forth, with all those primitives in 16 bit RAM did the 8 Queens in 6:45 Not to shabby Mark. I have figure out what I need to do to compile this in Machine Forth. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 18, 2021 Author Share Posted April 18, 2021 I finally got a Super Cart version of Camel99 Forth running with all the VDP I/O changes and other changes I have made to the cross-compiler. ( I am slowly improving the cross compiler so that cross-compiled Forth uses fewer non-standard words although cross-compiled Forth always needs a few extra words to make it work) One thing that I just hit today was what to do when you start up Forth in SuperCart and then the user types INCLUDE DSK1.SUPERTOOLS Not good. This will try to compile the developer tools into SuperCart on top of the Forth kernel! Here is the new version of SUPERTOOLS which will prevent this catastrophic failure and also detects if the SuperCart really there or not. CR .( Developer Tools to SUPER CART @>6000 ) HEX MARKER /SCTEST : ?SUPERCART ['] EXIT A000 U< ABORT" SUPERCART in use!" BEEF 6000 ! 6000 @ BEEF <> ABORT" SuperCart not found" ; ?SUPERCART /SCTEST \ remove test code \ SAVEDP holds the LINK field of the 1st new word we will create in HI RAM VARIABLE SAVEDP LATEST @ CONSTANT KEEP \ remember latest name field address CR .( Set up low ram compiling ...) HERE SAVEDP ! \ save the dictionary pointer. 6000 DP ! \ DP points to SUPER cart HERE ( to compute space used in SuperCart) INCLUDE DSK1.WORDLISTS ONLY FORTH DEFINITIONS INCLUDE DSK1.ELAPSE INCLUDE DSK1.TOOLS VOCABULARY ASSEMBLER ALSO ASSEMBLER DEFINITIONS INCLUDE DSK1.ASM9900 INCLUDE DSK1.ASMLABELS HERE SWAP - DECIMAL CR . .( bytes in super cart) CR CR .( Restore high ram compiling ...) SAVEDP @ DP ! \ restore DP back to original address FORTH DEFINITIONS HEX : REMOVE-TOOLS ( -- ) KEEP SAVEDP @ ! \ relink the dictionary 2000 H ! ; \ init-the heap to low RAM DECIMAL .FREE CR CR ." Search Order:" ORDER 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted April 19, 2021 Author Share Posted April 19, 2021 When you turn over stones you always find a worm. I am cleaning up old code that I plan to zip up for this distribution. I came across this: \ VECTOR.FTH faster deferred words Apr 2021 B Fox \ vector creates words that START faster than using EXECUTE or PERFORM \ You can use IS to change their run-time action like a deferred word NEEDS MOV, FROM DSK1.ASM9900 NEEDS WORDS FROM DSK1.TOOLS NEEDS TO FROM DSK1.DEFER : VECTOR ( xt -- ) CREATE , ;CODE *W W MOV, \ fetch address in W->W *W+ R5 MOV, \ move contents of the XT to temp R5 ** B, \ branch to the address ENDCODE Just a curiosity really but I wondered how many less instruction run compared to using DOES> ? (used by DEFER) So you made a quick test and set a break-point in the Classi99 debugger. Now I been using DOES> in it's current form for about 2 years or so... I run the test and trace the instructions and as I enter "DODOES" I see: A *R12,R2 What the #$%@# ? It turns out my entry address was off by 1 cell. (homemade cross-compilers. you gotta love 'em!) I was doing a BL to the code-field-address (used by Forth) and not the 'CODE address', where some real code is living. Fortunately the code-field address contained A09C ( A *R12,R2) which didn't do any harm but it could have at a different address. What a hobby. Stamp collecting must be less troublesome. 3 Quote Link to comment Share on other sites More sharing options...
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.