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

[+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 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)