fbForth fbForth—TI Forth with File-based Block I/O [Post #1 UPDATED: 06/05/2024]

[+Lee Stewart]

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

[+TheBF]

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. 

 

[+Lee Stewart]

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

[+TheBF]

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. 

[+Lee Stewart]

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

[+TheBF]

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 -- )  ...   ;

[+TheBF]

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 
;

 

 

 

[+Lee Stewart]

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

[+TheBF]

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. 

 

 

[+TheBF]

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 

 

 

 

 

 

[+TheBF]

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. 

[+TheBF]

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. 

[+Lee Stewart]

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

[+TheBF]

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)

 

 

 

 

[+Lee Stewart]

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

[+TheBF]

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.

[+FarmerPotato]

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. 

[+TheBF]

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. 

 

[apersson850]

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 d² <= 2t². I have no idea why the TI gurus doubled t².

It's good old Pythagoras. Distance² = xdistance² + ydistance².

[+Lee Stewart]

On 11/4/2023 at 6:07 PM, apersson850 said:

It's good old Pythagoras. Distance² = xdistance² + ydistance².

 

I know what d² is. I would like to know why the TI programmers chose to compare d² to 2t² instead of the square of the actual tolerance, t². 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

[apersson850]

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.

[+Lee Stewart]

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 d²). 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 d² limits d to 181 pixels, even though screen corner-to-corner distance is 318+ pixels).

 

...lee

Edited November 6, 2023 by Lee Stewart

[apersson850]

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

[+Lee Stewart]

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

[+Lee Stewart]

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