+Lee Stewart Posted September 18, 2023 Author Share Posted September 18, 2023 On 9/16/2023 at 8:43 PM, Lee Stewart said: I need to parse one of them very carefully to make more descriptive comments as a starting point for fleshing out what I want to do. FLGPTR is a prime example of what I intend to clarify in this commented code: FLGPTR DATA 0 Pointer to Flag in PAB (Byte 1 in PAB) * ⋮ MOV @SCNAME,R0 Fetch pointer into PAB MOV R0,R9 Save pointer MOV R0,@FLGPTR Save again pointer to PAB+1 * for DSRLNK DATA 8 AI R9,-8 Adjust pointer to flag byte * ⋮ * NOW CHECK IF ANY DSR ERROR OCCURRED LWPI DLNKWS Load back LOADER workspace MOV @FLGPTR,R0 Get back pointer to PAB+1 JMP FRMDSR - 2008.8.15 - Keep on as * - 2008.8.15 - with a Normal DSRLNK As far as I can tell, nowhere is FLGPTR updated to point to the flag byte (PAB+1). It actually, always points to the file-descriptor length byte (PAB+9). The only pointer to the flag byte is R9 in the DSRLNK workspace. In fact the last move above from FLGPTR to R0 cannot possibly work when the branch to FRMDSR is taken. I definitely have work to do! ...lee Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 18, 2023 Share Posted September 18, 2023 Your efforts made me stare at mine again today. Sometimes I feel like I should cut it up into separate CODE words for clarity... ... but then I lay down until the feeling goes away. 1 2 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted September 20, 2023 Author Share Posted September 20, 2023 Perhaps I should move this in-depth DSRLNK discussion to its own topic, seeing as how it is almost exclusively ALC (Assembly Language Code) in nature. We would likely get more participation from ALC and DSR experts who may not be that interested in keeping up with our Forth antics. Thoughts? ...lee Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 20, 2023 Share Posted September 20, 2023 9 hours ago, Lee Stewart said: Perhaps I should move this in-depth DSRLNK discussion to its own topic, seeing as how it is almost exclusively ALC (Assembly Language Code) in nature. We would likely get more participation from ALC and DSR experts who may not be that interested in keeping up with our Forth antics. Thoughts? ...lee I like it. 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted September 22, 2023 Author Share Posted September 22, 2023 (edited) I just finished compressing (RLE per @Tursi) FBFONT from 1024 bytes to 700 bytes. I wrote a 58-byte decompression and PDT-loading routine, which together makes 758 bytes going into bank #3 of the fbForth 3.0 cartridge. The first 256 bytes of the font are >FFs , so I could have stored 768 bytes of the remainder of the font and written a 56-byte loading routine that would have loaded those leading >FFs and copied the remainder of the font for a total of 824 bytes—only 66 bytes more. However, I had a lot of fun porting @Tursi’s C program to TMS9900 Assembler to do the RLE compression and, after all, it did save 66 bytes! The ALC payload of the Forth word for doing the RLE compression is in the spoiler: Spoiler ;[*** RLEWRITE *** ( srcaddr dstaddr count -- size ) * Run Length Encoded Write... * ++Destination buffer should be larger than source buffer to accommodate * worst case scenario of no compression: * * dstsize = srcsize + srcsize/127 +1 * * ++Each run of 3..127 repeated bytes has a length byte with MSb=1 * followed by the repeated byte. * ++Each stretch of 1..127 differing (<3 repeats) bytes has a length * byte followed by that length of bytes. * *++ Register usage: *++ R0: source and run/data start address *++ R1: destination address *++ R2: source+count address = endsrc *++ R3: run/data current addr *++ R4: work *++ R5: work *++ R6: save dst start address *++ * DATA TOMP_N * RLEW_N .name_field 8, 'RLEWRITE ' * RLEWRT DATA $+2 * BL @BLF2A * DATA _RLEWT->6000+BANK3 *++ _RLEWT code currently in fbForth311_RLEWRITE.a99 _RLEWT MOV *SP+,R2 pop count MOV *SP+,R1 pop dstaddr MOV *SP,R0 get srcaddr (leave space on stack for size) MOV R1,R6 save dst start address A R0,R2 make 1 past end of src MOV R0,R3 current run/data address * Decide whether run or data RLEWT1 C R0,R2 done with src buffer? JHE RLEOUT yup, we're outta here INC R3 set current to 2nd byte CB *R0,*R3+ 1st 2 bytes same? JNE RLEDAT no run here CB *R0,*R3+ 3rd byte same? JNE RLEDAT still no run * Doing a run RLERUN CB *R0,*R3 next byte same? JNE RLERN1 nope INC R3 set to next byte C R3,R2 exhausted src buffer? JHE RLERN1 we're outta here MOV R0,R4 save run start addr AI R4,127 get max run C R3,R4 >= 127? JL RLERUN nope, get another RLERN1 MOV R3,R4 save run current address S R0,R4 get run length ORI R4,128 OR run flag SWPB R4 get run length to MSB MOVB R4,*R1+ store run length byte MOVB *R0,*R1+ store repeated byte MOV R3,R0 new run/data start address JMP RLEWT1 get next run/data * Doing a string of data RLEDAT MOV R0,R3 set data current address INC R3 correct current to 2nd byte RLEDT1 CB *R3,@1(R3) 1st 2 bytes same? JNE RLEDT2 nope, next window CB *R3,@2(R3) 2nd 2 bytes also the same? JEQ RLEDT3 yup, we're done RLEDT2 INC R3 next window C R3,R2 exhausted src buffer? JHE RLEDT3 we're outta here MOV R0,R4 save data start addr AI R4,127 get max data C R3,R4 >= 127? JL RLEDT1 nope, get another RLEDT3 MOV R3,R4 save data end address S R0,R4 get data length SWPB R4 get length to MSB MOVB R4,*R1+ copy length byte to destination SWPB R4 restore length MOV R0,R5 save data start addr * Copy data string to destination buffer RLEDT4 MOVB *R5+,*R1+ copy next byte DEC R4 done? JNE RLEDT4 no, copy another byte MOV R3,R0 new run/data start address JMP RLEWT1 get next run/data * Exit RLEOUT S R6,R1 compression size MOV R1,*SP save compression size to stack B @RTNEXT back to inner interpreter ;] Here is my current fbForth 3.0 TODO list, with bytes-left/bank at the end: fbForth300_TODO.txt ...lee Edited September 22, 2023 by Lee Stewart updated RLEWRITE in spoiler 4 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 22, 2023 Share Posted September 22, 2023 Somebody is back at work. Very neat. Here is a thought. One of the justifications for having an interpreter is to save space by using higher level "instructions". As you have heard me say often the darn 9900 is already at the same level as Forth primitives. Makes me wonder if a Forth version would be smaller albeit slower, but still have an acceptable runtime delay at startup. : RLD ( src dst len -- ) ... ; Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 22, 2023 Share Posted September 22, 2023 Over 2 cups of coffee I got this to work. I don't think I understand all the details of the encoding method because I didn't study it, but I took a stab at making some test data. In this code the RLETYPE and TYPE could be replaced VMBW and VFILL and it would be pretty fast. \ run length decoder \ Run Length Encoded Write... \ ++Each run of 3..127 repeated bytes has a length byte with MSb=1 \ followed by the repeated byte. \ ++Each stretch of 1..127 differing (<3 repeats) bytes has a length \ byte followed by that length of bytes. \ NEEDS DUMP FROM DSK1.TOOLS \ test data HEX : RLE, ( char len -- ) 80 OR C, C, ; DECIMAL CREATE RLEDATA ( -- addr) CHAR A 10 RLE, CHAR B 16 RLE, CHAR C 4 RLE, CHAR D 22 RLE, CHAR E 10 RLE, CHAR F 11 RLE, CHAR G 12 RLE, CHAR H 13 RLE, S" This is a string in the middle" S, CHAR I 19 RLE, CHAR J 18 RLE, CHAR K 17 RLE, CHAR L 16 RLE, CHAR M 15 RLE, CHAR N 14 RLE, CHAR O 88 RLE, 0 , \ delimit end of data \ --------------------- HEX : RLE? ( byte -- byte len) DUP 80 AND 0> ; : RLETYPE ( addr len -- addr') 7F AND \ mask the RLE bit gives the repeat# OVER C@ SWAP ( -- addr char len ) 0 DO DUP EMIT LOOP DROP 1+ ; \ bump address ahead : DECODE ( addr -- ) \ type to screen for testing BEGIN COUNT ( addr len ) DUP WHILE CR RLE? ( addr len ?) IF RLETYPE ELSE 2DUP TYPE + ALIGNED \ type and advance address THEN REPEAT 2DROP ; 3 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted September 22, 2023 Author Share Posted September 22, 2023 1 hour ago, TheBF said: Over 2 cups of coffee I got this to work. I don't think I understand all the details of the encoding method because I didn't study it, but I took a stab at making some test data. In this code the RLETYPE and TYPE could be replaced VMBW and VFILL and it would be pretty fast. Very nice! I think I can make only one improvement: : RLE? ( byte -- byte len) DUP 80 AND ; Because you are not using its value, you don’t need the 0> because any nonzero value tests true. I am, however, confused about why you used ALIGNED . We’re parsing bytes here, so even addresses should not be a concern, n’est-ce pas? ...lee 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 22, 2023 Share Posted September 22, 2023 36 minutes ago, Lee Stewart said: Very nice! I think I can make only one improvement: : RLE? ( byte -- byte len) DUP 80 AND ; Because you are not using its value, you don’t need the 0> because any nonzero value tests true. I am, however, confused about why you used ALIGNED . We’re parsing bytes here, so even addresses should not be a concern, n’est-ce pas? ...lee You are quite right on both counts. 1. I was being "formal" with 0>. (well formed expression and all that) 2. The ALIGNED was because the string compiled could be an odd length and my word S, always aligns the address for Forth. It is not needed if you don't compile VDP data with aligning. I am noodling on how to make the encoder side in Forth. That's seems to be a bit trickier but I think I can get something going. 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 23, 2023 Share Posted September 23, 2023 I think I have it. I love these stack string pairs in combination the multiple condition loops for strings. The secret is to make all the string functions return a new stack string so you can loop the functions until the string is empty. I made a version of SCAN but for VDP memory. Since /STRING is a code word the loop is pretty quick. There is a test harness here that puts stuff in VDP RAM. The video shows the speed to do the 342 bytes of test data. It takes 3.5 seconds to process 2K of font memory on my machine from >800. Not blazing but not terrible. It compiles in 256 bytes. Edit: Fixed error that did not limit chunks to 127 bytes. Spoiler \ vdpencoder.fth compress VDP as run length encoded data in RAM NEEDS DUMP FROM DSK1.TOOLS NEEDS VCOUNT FROM DSK1.VDPMEM \ vdp memory comma allot etc. \ =================[ test setup ]==================== \ compile data into VDP RAM HEX 1000 VP ! \ start of VDP data VHERE 1000 FF VFILL \ init VDP ram so we can see what changed : RPT$, ( char len -- ) 0 DO DUP VC, LOOP DROP ; : V$, ( addr len ) TUCK VHERE VPLACE 1+ VALLOT ; DECIMAL VHERE CHAR A 100 RPT$, CHAR B 125 RPT$, CHAR C 137 RPT$, CHAR D 22 RPT$, CHAR E 10 RPT$, CHAR F 11 RPT$, CHAR G 12 RPT$, CHAR H 13 RPT$, S" This is a string in the middle" V$, CHAR I 19 RPT$, CHAR J 18 RPT$, CHAR K 17 RPT$, CHAR L 16 RPT$, S" This is the second string" V$, CHAR M 15 RPT$, CHAR N 14 RPT$, CHAR O 88 RPT$, VHERE SWAP - CONSTANT VDATA-SIZE .S \ ===================================================== \ ========[ RUN LENGTH ENCODE VDP RAM to LOW RAM ]================== \ low ram memory managers: c, allot etc. HERE : HEAP H @ ; : HALLOT H +! ; : HC, HEAP C! 1 HALLOT ; VARIABLE BYTES \ used to limit the chunks to max 127 bytes \ scan for c until there are no more. Return new stack string : VDPSKIP ( Vaddr len c -- Vaddr' n') >R BYTES OFF BEGIN DUP WHILE \ len<>0 BYTES @ 127 < WHILE OVER VC@ R@ = WHILE 1 /STRING BYTES 1+! REPEAT THEN THEN R> DROP ; : FINDDUPS ( Vaddr len -- NextAddr len Vaddr len) 2DUP OVER VC@ ( -- Vaddr len Vaddr len char ) VDPSKIP ( -- Vaddr len Vddr' len' ) 2SWAP 2 PICK - ; HEX : HRLE, ( Vaddr len -- ) 80 OR HC, VC@ HC, ; : HRLE-$, ( Vaddr len ) TUCK HEAP SWAP VREAD HALLOT ; \ result is a stack string in low RAM. Can save as a program image. : VDP-COMPRESS ( Vaddr len -- Heap len) HEAP >R BEGIN DUP WHILE FINDDUPS ( -- NextAddr len Vaddr len) DUP 2 > IF HRLE, ELSE HRLE-$, THEN REPEAT 2DROP R> H @ OVER - ; HERE SWAP - DECIMAL . .( bytes) \ ================================================== \ reset and erase the heap HEX 2000 H ! HEAP 1000 FF FILL \ HEX 1000 VDATA-SIZE VDP-COMPRESS VDP RL ENCODER in Forth.mp4 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 23, 2023 Share Posted September 23, 2023 I woke up this morning (my most important job these days) and realized I had not limited the compressed packets to 127 bytes. This new code fixes that by adding a bytes variable to VDPSKIP and and extra WHILE condition. It compresses 1K of VDP RAM, filled with the same byte, into 8 cells. I will change the code in the previous post. 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 25, 2023 Share Posted September 25, 2023 On 9/19/2023 at 10:49 PM, Lee Stewart said: Perhaps I should move this in-depth DSRLNK discussion to its own topic, seeing as how it is almost exclusively ALC (Assembly Language Code) in nature. We would likely get more participation from ALC and DSR experts who may not be that interested in keeping up with our Forth antics. Thoughts? ...lee I didn't want to contaminate your DSR thread with Forth stuff so I am back here. I took a brief look at my DSR code to see how it could be factored and recode parts of it in Forth to save space. The decisions made by Pablo in Assembler are very different than how I would approach the problem in Forth. This section always bugged me since it runs every time. \ setup to copy VDP FNAME ->namebuf to '.' character R1 R3 MOVB, \ DUP length byte to R3 R3 08 SRL, \ swap the byte to other side R2 NAMBUF LI, \ R2 is ^namebuf R4 SETO, \ length counter, R4 = -1 BEGIN, R0 INC, \ point to next fname VDP address R4 INC, \ counter starts at -1 R4 R3 CMP, \ is counter = fnamelength 1 $ JEQ, \ if true goto @@1: R0 VDPWA, \ set VDP address VDPRD @@ R1 MOVB, \ read next VDP char from fname R1 *R2+ MOVB, \ copy to namebuf & inc pointer R1 PERIOD @@ CMPB, \ is it a '.' EQ UNTIL, \ until '.' found 1 $: R4 R4 MOV, \ test R4(device name length)=0 6 $ JEQ, \ if so, goto ERROR6 R4 07 CI, \ is dev name length>7 6 $ JGT, \ if so, goto 6$ (ERROR6) This about 50 bytes of code. (VDPWA, is 4 instruction macro) I would write this word. : DELIMIT ( addr len char -- addr len') >R 2DUP R> SCAN NIP - 1+ ; Then I could do the job with this phrase. PAD [PAB FNAME] OVER 15 VREAD [CHAR] . DELIMIT ( -- addr len) I am starting to get the sense that we could load up the DSR workspace from Forth with ! and set the magic addresses also, then BLWP into code to do the operations. Scanning for cards and ROM devices is all simple in Forth and should only be needed on OPEN if we record the file info at that time. I had something like this early on but it didn't work on real iron. There was some magic stuff I didn't understand. Maybe that aligns with your thinking or maybe it's just some food for thought. 2 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted September 25, 2023 Author Share Posted September 25, 2023 1 hour ago, TheBF said: Maybe that aligns with your thinking or maybe it's just some food for thought. Definitely food for thought. One thing I am trying to clarify is the multiple uses of “filename” to mean “full pathname”, “device/subprogram name”, and actual “filename”. NAMEBUF, for example, is only for storing the device/subprogram name (up to and including the ‘.’ after device name for level 3, but only subprogram name for levels 1 & 2). I also want to make it easy to do multiple calls for more than one PAB without searching the CRU and device/subprogram lists every time. ...lee 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 27, 2023 Share Posted September 27, 2023 Ignore this at your leisure Lee. I am just noodling. I went back into my archives and found a 1/2 baked file on finding the code address for a device. I had to do some work on it but it works now. So this is just some material for your decision to do your DSRLINK in all ALC or does Forth make some stuff easier/smaller. However this is already 434 bytes and we have not called the code yet. But that "should" be straightforward since we have the entry address. ?? 🙄 I was able to test it on my TTY Forth on real iron. Waaaay easier than editing floppy files. I am of a mixed mind on how best to do the card management. It would seem that a small array of 3 cells would hold the CRU addresses for floppy card, IDE card and TIPI. You run the FINDCARD 3 times at boot time and fill the array and that's it. Or am I missing something? Spoiler NEEDS DUMP FROM DSK1.TOOLS NEEDS MARKER FROM DSK1.MARKER NEEDS COMPARE FROM DSK1.COMPARE MARKER REMOVE HERE HEX \ TI-99 magic addresses: treat these like variables with @ and ! 83D0 CONSTANT LASTCARD ( -- 'CRU) \ holds CRU of last disk card used 83D2 CONSTANT LASTDEV ( -- 'list) \ last ROM device used \ *set the CRU address in 'R12 before using these words* CODE 0SBO ( -- ) 1D00 , NEXT, ENDCODE CODE 0SBZ ( -- ) 1E00 , NEXT, ENDCODE 4000 CONSTANT 'ROM \ base address card ROM 00AA CONSTANT 'AA' \ id byte for TI-99 cards DECIMAL 24 USER 'R12 \ address of R12 in any Camel99 Forth task \ alternative for FbForth & Turbo Forth \ HEX 8300 DECIMAL 12 CELLS + CONSTANT 'R12 HEX : CARDON ( CRU -- ) 'R12 ! 0SBO ; : CARDOFF ( CRU -- ) 'R12 ! 0SBZ ; : FINDCARD ( startCRU -- CRU ? ) \ ?=0 if card not found DUP 'R12 ! 'ROM C@ IF 0SBZ THEN \ turn off card if activated BEGIN DUP 2000 < WHILE 100 + DUP CARDON \ select card and turn on 'ROM C@ 'AA' <> \ test for card header WHILE 0SBZ \ turn off active card REPEAT THEN DUP 2000 <> ; : /DSK ( addr len -- addr len ) 2DUP [CHAR] . SCAN NIP - ; DECIMAL \ words to access fields in card ROM : >DEVLIST ( 'rom -- disklist) 8 + ; : >DEV$ ( 'link -- Caddr) 4 + ; \ counted string : >CODEADDR ( 'link -- codeaddr) CELL+ @ ; HEX \ DSRFIND sets 83D0 (LASTCARD) and 83D2 (LASTDEV) system variables : DSRFIND ( $addr len -- codeaddr|0 ) /DSK DUP 0= ABORT" path expected" PAD PLACE ( if string is in VDP use VPLACE ) 1000 FINDCARD 0= ABORT" Card not found" DUP LASTCARD ! CARDON 'ROM >DEVLIST @ ( 1stlink ) BEGIN DUP WHILE ( link<>0) DUP >DEV$ COUNT PAD COUNT COMPARE WHILE ( dev$<>pad$) @ \ fetch next link REPEAT THEN DUP IF >CODEADDR THEN LASTCARD @ CARDOFF ; HERE SWAP - DECIMAL . .( bytes) TI-99 VT100 DSRFIND.mp4 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted November 3, 2023 Author Share Posted November 3, 2023 I have cleaned up the speech routines a bit, particularly the code reading a byte from the Speech Synthesizer. This has recovered 48 bytes in bank #2. I may work on the sound routines before returning to DSRLNK—particularly, the FIFO sound table stack. Currently, this stack grows upward and is moved up one cell for each new last-out entry. I want to change those inefficient dynamics to avoid moving the whole stack each time a new entry is added. I guess this FIFO “stack” is really a queue and what I want to do is make it a circular queue, much like the fbForth block buffers, which, of course, limits its size. I need to limit size, anyway, because I may be adding DSR/subprogram lists adjacent to it. Now arises the question of sound table queue size. Each entry is only a one-cell pointer to a sound table awaiting its turn to play. Is 10 entries (20 bytes) enough? Here is the current TODO list: fbForth300_TODO.txt ...lee 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 3, 2023 Share Posted November 3, 2023 7 minutes ago, Lee Stewart said: I have cleaned up the speech routines a bit, particularly the code reading a byte from the Speech Synthesizer. This has recovered 48 bytes in bank #2. I may work on the sound routines before returning to DSRLNK—particularly, the FIFO sound table stack. Currently, this stack grows upward and is moved up one cell for each new last-out entry. I want to change those inefficient dynamics to avoid moving the whole stack each time a new entry is added. I guess this FIFO “stack” is really a queue and what I want to do is make it a circular queue, much like the fbForth block buffers, which, of course, limits its size. I need to limit size, anyway, because I may be adding DSR/subprogram lists adjacent to it. Now arises the question of sound table queue size. Each entry is only a one-cell pointer to a sound table awaiting its turn to play. Is 10 entries (20 bytes) enough? Here is the current TODO list: fbForth300_TODO.txt ...lee Whatever size you need I would stick to a power of 2, so you can wrap the index with a binary mask. Start with 16 cells and see if it overflows is would be a way to test I suppose. 1 Quote Link to comment Share on other sites More sharing options...
+FarmerPotato Posted November 3, 2023 Share Posted November 3, 2023 1 hour ago, Lee Stewart said: I have cleaned up the speech routines a bit, particularly the code reading a byte from the Speech Synthesizer. This has recovered 48 bytes in bank #2. I may work on the sound routines before returning to DSRLNK—particularly, the FIFO sound table stack. Currently, this stack grows upward and is moved up one cell for each new last-out entry. I want to change those inefficient dynamics to avoid moving the whole stack each time a new entry is added. I guess this FIFO “stack” is really a queue and what I want to do is make it a circular queue, much like the fbForth block buffers, which, of course, limits its size. I need to limit size, anyway, because I may be adding DSR/subprogram lists adjacent to it. Now arises the question of sound table queue size. Each entry is only a one-cell pointer to a sound table awaiting its turn to play. Is 10 entries (20 bytes) enough? Here is the current TODO list: fbForth300_TODO.txt ...lee Yesterday, I found an intriguing concept in the XINU source (it's a little operating system, I'm reading the PDP-11 version.) It's the Delta Queue. In XINU, Queues are doubly-linked lists, using nodes from a global pool for all queues. An integer identifies a node q[i] (not a pointer.) A node has 4 words: PREV, NEXT, KEY, and a pointer to content. (For a FIFO, you can omit PREV.) Nothing is ever relocated, only indexes are changed. Free nodes are stored on a free queue. One TAIL node is permanent, it serves as a sentry value. HEAD is one integer and initially equals TAIL. There's the basic queue in 12 lines: insert.c. Then, new to me, insertd.c is their delta queue. It is ideal for a FIFO of schedule time events. When a new item is inserted, it sifts up starting at HEAD and a delta-time is stored. I had imagined a queue of timed events to hold absolute time value. That gets weird when the clock rolls over. But the delta thing is: the KEY value holds the delta between each element. Insertion means: find the elements bracketing the event, then split the delta between them. To process the FIFO, decrement the HEAD delta til zero, remove and execute HEAD, then reinsert it. The insertd algorithm is: insertd (node, key) next = head While next.key < key key = key - next.key next = next.next Finally: Insert node, in front of next. (Details omitted) Subtract key from next.key That is, you count intervals to the right on a number line, end up in some interval, then split that interval with the new node. I immediately thought of timed events like blending sound lists. If each sound event had a node, you'd put the countdown delay inside the node.key. Then insertd. Your ISR decrements the head.key until it's zero. Then node = head head = head.next Play one more line of node's sound list, copy the new delay to node, then call insertd(node) . If there are no more lines, you put node on the free list. (Or somewhere) This might be widely known (or obvious, duh!) but it was new to me. 4 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted November 4, 2023 Share Posted November 4, 2023 That Delta queue is very clever but it seems like a lot of over head in data storage. If you needed a 1K queue it would use 4K of space or do I have that wrong? I use two variables HEAD and TAIL. They hold the indices into the queue The data space is always a power of two number of data units. Example: VARIABLE HEAD VARIABLE TAIL 32 CELLS CONSTANT SIZE CREATE QUEUE SIZE ALLOT SIZE 1- CONSTANT MASK : HEAD@+ ( -- ndx) HEAD @ DUP CELL+ MASK AND HEAD ! ; : TAIL@+ ( -- ndx) TAIL @ DUP CELL+ MASK AND TAIL ! ; : Q! ( n -- ) HEAD@+ QUEUE + ! ; : Q@ ( n -- ) TAIL@+ QUEUE + @ ; : EMPTYQ HEAD OFF TAIL OFF ; \ init the queue EMPTYQ \ TEST : FILLQ 32 0 DO I Q! LOOP ; : SEEQ 32 0 DO I Q@ . LOOP ; And if you write this as CODE words you can use indexed addressing and and it's pretty fast. 1 1 Quote Link to comment Share on other sites More sharing options...
apersson850 Posted November 4, 2023 Share Posted November 4, 2023 On 9/8/2020 at 3:15 AM, Lee Stewart said: I think I found a problem with COINC and COINCXY in TI Forth, which I converted to ALC for fbForth. and would, of course, still be a problem! Here is the high-level Forth code from TI Forth: : COINC ( spr#1 spr#2 tol --- f ) ( 0= no coinc 1= coinc ) DUP * DUP + >R ( STACK: spr#1 spr#2 R: tol*tol+tol*tol) SPRDIST R> ( STACK: dist^2 2*tol^2) > 0= ; ( within tolerance? STACK: flag) As you can see the test, for distance d of the top left corners of two sprites from each other with a tolerance t, is d2 <= 2t2. I have no idea why the TI gurus doubled t2. It's good old Pythagoras. Distance² = xdistance² + ydistance². Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted November 5, 2023 Author Share Posted November 5, 2023 (edited) On 11/4/2023 at 6:07 PM, apersson850 said: It's good old Pythagoras. Distance² = xdistance² + ydistance². I know what d2 is. I would like to know why the TI programmers chose to compare d2 to 2t2 instead of the square of the actual tolerance, t2. Their comparison is effectively that of |d| to |t|√2, which is a ~41 % larger tolerance radius than that supplied by the user. ...lee Edited November 6, 2023 by Lee Stewart clarification Quote Link to comment Share on other sites More sharing options...
apersson850 Posted November 5, 2023 Share Posted November 5, 2023 The only reason I could see is that they want the tolerance to be the radius, not the X or Y distance only. But I've not seen the code/processing preceeding the code you showed, so maybe I'm completely off. Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted November 6, 2023 Author Share Posted November 6, 2023 (edited) 4 hours ago, apersson850 said: The only reason I could see is that they want the tolerance to be the radius, not the X or Y distance only. I agree completely. This figure, displaying 8x8 sprites as colored squares, shows what I think it should be: A tolerance t of 4 pixels is the radius of a tolerance circle (broken blue circle) for the black sprite. All red sprites are within the tolerance circle of the black sprite and would compute as coincident in my scenario. All green sprites are outside the tolerance circle and would compute as not coincident. Extended Basic’s (XB’s) CALL COINC() uses a tolerance square rather than a tolerance circle, even though XB has CALL DISTANCE() (returns d2). This was probably done because it is faster. CALL COINC() would find the above green sprites coincident with the black sprite. My objection to the TI Forth COINC is that, even though it uses a tolerance circle, it is worse (in my opinion) than XB’s CALL COINC() tolerance square in that it changes the user-supplied tolerance radius to be the diagonal of the XB tolerance square, viz., t becomes t√2, such that the XB tolerance square is now inscribed in the new tolerance circle rather than the other way round. I should note that fbForth now uses the XB tolerance square. Though I am contemplating using the tolerance circle, it is difficult to argue with the former’s speed and inclusion of the full distance range (because, traditionally, 16-bit, signed integers are involved, using d2 limits d to 181 pixels, even though screen corner-to-corner distance is 318+ pixels). ...lee Edited November 6, 2023 by Lee Stewart 1 Quote Link to comment Share on other sites More sharing options...
apersson850 Posted November 7, 2023 Share Posted November 7, 2023 (edited) TI probably designed the Forth function with speed in mind as well. Calculating 2X is quick in assembly, X² reasonably quick, √X is not. Edited November 7, 2023 by apersson850 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted November 13, 2023 Author Share Posted November 13, 2023 OK... I now have a circular queue for sequential playing of up to 16 sound tables. It is zeroed by COLD , which executes at bootup. There is no check for overrunning the head of the queue. Entries over 16 will merely overwrite the earliest entries, which will be lost. The queue is located at SQUEUE and the sound workspace is SNDWS (described in spoiler). Spoiler * * Sound Table Workspace, including ST#1 and ST#2 workspaces * SNDWS * * Sound Table #1 (ST#1) Workspace for sound variables. Only using R0..R3 * SND1WS SND1ST DATA 0 ; R0 (ST#1 R0) (sound table status) 0=no table.. ; ..1=loading sound bytes..-1=counting SND1DS DATA SOUND ; R1 (ST#1 R1) (sound-table byte destination).. ; ..initialized to sound chip SND1AD DATA 0 ; R2 (ST#1 R2) (sound table address) SND1CT DATA 0 ; R3 (ST#1 R3) (# of sound bytes to load or.. * ; ..sound count = seconds * 60) * * Sound Table #2 (ST#2) Workspace for sound variables. Only using R0..R3 * SND2WS SND2ST DATA 0 ; R4 (ST#2 R0) (sound table status) 0=no table.. ; ..1=loading sound bytes..-1=counting SND2DS DATA SOUND ; R5 (ST#2 R1) (sound-table byte destination).. * ; ..initialized to sound chip SND2AD DATA 0 ; R6 (ST#2 R2) (sound table address) SND2CT DATA 0 ; R7 (ST#2 R3) (# of sound bytes to load or.. * ; ..sound count = seconds * 60) * * The following DATA are necessary to initialize last 3 registers: * DATA 0,0,0,0,0 ; R8..R12 DATA 0 ; R13 (index to current head of Sound Queue) DATA 0 ; R14 (index to next entry at tail of Sound Queue) DATA >FFE0 ; R15 (ones' complement of queue size mask, >001F.. * ; ..currently, queue size = 16 cells) Here is the code that adds a sound table address at the end of the queue if either sound table is playing: * * Add sound table's address to sound queue to await its turn * MOV R10,@SQUEUE(R14) copy new ST address to end of Sound Queue INCT R14 increment Sound Queue tail index for next go-round SZC R15,R14 wrap index if too high JMP PLAYEX exit And here is the ISR code that removes the sound table address at the head of the queue and starts it playing: LWPI SNDWS switch to Sound workspace MOV @SQUEUE(R13),R2 next Sound Table address in queue as ST#1 JEQ PRSPS1 if none..exit sound queue processing CLR @SQUEUE(R13) clear queue entry INCT R13 next queue entry to process SZC R15,R13 wrap queue, if necessary INC R0 kick off sound processing of ST#1 (R0=1) PRSPS1 LWPI GPLWS switch back to GPL WS ...lee 2 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted November 14, 2023 Author Share Posted November 14, 2023 3 hours ago, Lee Stewart said: OK... I now have a circular queue for sequential playing of up to 16 sound tables. It is zeroed by COLD , which executes at bootup. There is no check for overrunning the head of the queue. Entries over 16 will merely overwrite the earliest entries, which will be lost. The queue is located at SQUEUE and the sound workspace is SNDWS (described in spoiler). I wasted (I think) 8 bytes of bank#2 (where resides the code for COLD ) to also re-initialize R13 and R14 of SNDWS to 0, just in case. The reason I say, “wasted”, is that every time the sound queue is finished, both indices are the same. They may not be 0, but as long as they both point to the same place in the circular queue, I should only need to insure that the queue is all zeros. It is definitely safer, but I don’t think necessary. So far, I can afford the space, so I guess I should keep it—for now, at least. ...lee 1 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.