Jump to content
IGNORED

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


Lee Stewart

Recommended Posts

I am having flashbacks reviewing your new Forth 2.0 in the 64 col. Editor.

 

Thanks for all your hard work Lee. It's a beautiful thing.

 

Thanks! It really was a lot of fun.

 

I spent a lot of time in that editor over the years. Not until I rewrote the 40-column editor in ALC to be the 40/80-column editor, so I could use 80 columns, did I begin to neglect its use. Of course, the first thing I did was change TI's horrible color scheme for it—white on black, I think it was. It was all the more horrible with the 3x7 character matrix. I would get a headache trying to read it through the TV flicker.

 

Thanks again.

 

...lee

Link to comment
Share on other sites

My first FB Forth program:

 

I cheated a little bit. ;-)

 

I took a CAMEL99 program and added a small set of translation words.

And guess what? It works just fine.

 

For those who are just learning Forth it demonstrates how to use the interrupt timer for a precise delay and how to use the number formatting words.

 

Just paste this code into FB Forth and it puts little clock on the screen.

\ A simple Clock in FB Forth  (FIG Forth dialect)

\ Tiny HARNESS for FBFORTH->CAMEL99 translation
: 2DROP      DROP DROP ;
: 2DUP       OVER OVER ;
: VARIABLE   0  VARIABLE  ;
: AT-XY     ( n n -- )  GOTOXY ;
: OFF       ( addr -- ) 0 SWAP ! ;
: ^C?       ?TERMINAL ;

\ CAMEL99 version can now compile
HEX
8379 CONSTANT TICKER

DECIMAL
VARIABLE HRS
VARIABLE MINS
VARIABLE SECS
VARIABLE TICKS

58 CONSTANT ':'        \ character we will need

\ increment no. in the address
: 1+!   ( addr -- ) 1 SWAP +! ;

\ FB FORTH and CAMEL99 Forth run with interrupts enabled
\ so the ticker is changing every 1/60 of a second.
\ We can wait until ticker changes and know it's 1/60 of a second
: 1/60  ( -- )
        TICKER DUP @   \ dup ticker & fetch initial timer value
        BEGIN
             OVER @   \ read it again
             OVER -   \ subtract initial value
        UNTIL         \ loop until result is not zero
        2DROP ;       \ drop the initial value

: 1SEC   ( -- )  60 0 DO 1/60 LOOP ;

: KEEPTIME
         1SEC SECS 1+!
         SECS @ 60 = IF SECS OFF  MINS 1+! THEN
         MINS @ 60 = IF MINS OFF  HRS 1+!  THEN ;

\ formatted output
: ##  ( n -- )  0 <# # # #> TYPE ;
: :## ( n -- )  0 <# # # ':' HOLD #> TYPE ;

: .TIME ( -- )  SECS @ MINS @ HRS @  ## :## :## ;

: SETCLOCK ( hrs mins secs -- ) SECS ! MINS !  HRS ! ;

: CLOCK  ( row col -- )
         BEGIN
            2DUP AT-XY .TIME
            KEEPTIME
            ^C?        \ waits for function clear in FB Forth
         UNTIL
         2DROP ;
         
1 59 50 SETCLOCK
PAGE  10 10 CLOCK
         
Edited by TheBF
  • Like 3
Link to comment
Share on other sites

  • 2 weeks later...

What do you do on a Sunday afternoon when you want to get into trouble? The first thing is to pick up the FbFORTH 2.0 manual and read a bit of it. Then, customize the FbFORTH boot a bit. I noticed that the single column of MENU options was nearing capacity of what it would display on the acreen. Any more options were going to be problematic.

So, I decided to use the full screen width in the 80-column mode and create a two column menu display (if I still need more space, I can go to four columns).I haven't optimized the code to conserve space on the two BLOCKS that are free for use by MENU but it works fine for now. I'm still toying around with the idea of using the unused portion of BLOCK 1 and having MENU display at boot but, for now, I'm satisfied to be able to select a two column MENU.

 

Next up? Since SAMS detection is attomatic and resident, I will probably have the presence (or absence) of the SAMS card noted at start up. Maybe next Sunday.

  • Like 2
Link to comment
Share on other sites

I also changed the printer access in BLOCK 19. It seems that the "fix" is the same as the original one published in "The Smart Programmer" and by TI-FORTH guru Lutz Winkler. Simply change the references to RS232 to PIO.

 

Actually, the only thing that needs to be changed is

F-D" RS232.BA=9600"

to

F-D" PIO"

The instances of >RS232 only reference the device and could be anything, usually mnemonic. Obviously, >PIO makes more sense as a reference to the parallel port, but something like PRNTR (as in §8.8 in the fbForth 2.0 Manual) would be logical for both.

 

...lee

Link to comment
Share on other sites

A while ago I started to port BLK>FILE and FILE>BLK from TurboForth to fbForth 2.0, but somehow got sidetracked. I just finished BLK>FILE , which is used to copy a range of blocks from a blocks file to a DV80 file. In Classic99, you can copy to the Windows clipboard by including CLIP as the output file:

\ BLK>FILE utility ported from TurboForth to fbForth 2.0
CR ." BLK>FILE - dumps a range of blocks to a text file." CR
." e.g. 1 21 BLK>FILE DSK2.BLKDUMP" CR

-1 CONSTANT cswtch               \ switch for printing block header
: NOT ( n1 --- n2 )  -1 XOR ;    \ bitwise NOT
." HDR toggles headers on and off." CR
: HDR  cswtch NOT DUP ' cswtch !    \ toggle header off/on
   IF ." On" ELSE ." Off" THEN CR ;
0 VARIABLE OUTBUF 78 ALLOT    \ 80-byte RAM buffer for output file
PABS @ 2+         \ VRAM address for PAB
OUTBUF            \ RAM addres for PAB-BUF
PABS @ 72 +       \ VRAM address for PAB-VBUF
FILE OUTFIL       \ associate above 3 addresses with OUTFIL
: BAR  ( blk# --- )
   BL OUTBUF C! 1 WRT         \ write a record with 1 blank
   S" --BLOCK---------------"       \ header string
   DUP C@ >R 1+ OUTBUF R CMOVE            \ header to OUTBUF
   0 <# # # # # # #> OUTBUF 8 + SWAP CMOVE   \ block# to OUTBUF
   R> WRT ;                               \ write header record
: BLK>FILE ( start end --- ) ( IS:outfilename )
   DEPTH 2 < IF                  \ at least 2 numbers on stack?
      ." Syntax error!" ABORT    \ no..we're outta here!
   ELSE
      OUTFIL SET-PAB VRBL 80 REC-LEN   \ set up OUTFIL as DV80
      BL WORD HERE DUP C@ 1+ PAB-ADDR @ 9 + SWAP VMBW  \ filename->PAB
      OUTPT OPN                  \ open file for output
      1+ SWAP DO                 \ end+1 start DO
         I cswtch IF             \ output block header?
            BAR                  \ yes
         ELSE
            DROP                 \ no..drop block#
         THEN
         I BLOCK                 \ load next block and get buffer address
         16 0 DO                 \ 16 lines/block
            DUP OUTBUF 64 CMOVE  \ copy next line to OUTBUF
            OUTBUF 64 -TRAILING  \ trim trailing blanks
            -DUP IF              \ anything left?
               WRT               \ yes..write line to file
            ELSE
               BL OUTBUF C! 1 WRT   \ no..write a blank line
            THEN
            DROP                 \ drop OUTBUF address
            64 +                 \ address of next line
         LOOP
         DROP                    \ clean up stack
      LOOP
      CLSE                       \ close file
   THEN ;

After I get FILE>BLK ported, I will add it to FBLOCKS and post it here and on my website.

 

...lee

  • Like 1
Link to comment
Share on other sites

And, here is FILE>BLK :

 

 

 

\ FILE>BLK utility ported from TurboForth to fbForth 2.0
." FILE>BLK - imports a text file into a   block file."
." e.g. 50 FILE>BLK DSK2.STUFF imports to  block 50 onwards"
 
0 VARIABLE lc              \ block line counter
0 VARIABLE blknum          \ block number
0 VARIABLE blkaddr         \ block address
0 VARIABLE INBUF 78 ALLOT  \ 80-byte RAM buffer for input file
PABS @ 2+         \ VRAM address for PAB
INBUF             \ RAM addres for PAB-BUF
PABS @ 72 +       \ VRAM address for PAB-VBUF
FILE INFIL        \ associate above 3 addresses with INFIL
: clrbuf INBUF 80 BLANKS ;    \ clear INBUF
: new-blk   
   blknum @ BUFFER      \ get new block buffer, flushing first
   DUP blkaddr !        \ save new block address
   B/BUF BLANKS         \ clear block buffer
   1 blknum +! ;        \ set up next block#
: read-line 
   clrbuf            \ clear INBUF
   RD                \ read line from file
   DROP ;            \ drop # chars read
: put-line 
   lc @ 0= IF           \ if just starting this block
      blknum @ 1- .     \ track # to display
   THEN
   INBUF blkaddr @ 64 CMOVE   \ copy 64 chars to block buffer 
   1 lc +!                    \ increment line counter
   64 blkaddr +!              \ incr block addr to next line
   UPDATE ;                   \ mark block as dirty
: EOF? STAT 1 AND ;     \ get EOF from file status
: flush-blk 
   lc @ 16 = IF         \ if last line just copied to block
      FLUSH             \ flush block to current blocks file
      0 lc !            \ reset line counter
      new-blk           \ set up for next block
   THEN ;
: really?  CR ." Current blocks file: "
   BPB BPOFF @ + 9 +          \ current blocks filename VRAM addr
   DUP VSBR                   \ filename char count
   1+ PAD SWAP VMBR           \ filename packed string to PAD
   PAD COUNT TYPE CR          \ type it
   ." Continue(y/n)? " KEY    \ type warning..wait for user
   95 AND ASCII Y =  ;        \ user response..force uppercase
: FILE>BLK  ( blk# --- ) ( IS:infilename ) 
   really? 0= IF        \ really want to do this?
      ."  Copy cancelled!" ABORT    \ no..we're outta here!
   THEN
   blknum !             \ block# from stack
   0 lc !               \ init line counter
   INFIL SET-PAB        \ set up INFIL
   BL WORD              \ filename from input to HERE
   HERE DUP C@          \ filename char count
   1+                   \ copy count, includes char count
   PAB-ADDR @ 9 +       \ PAB location of char count
   SWAP VMBW            \ filename->PAB
   VRBL INPT OPN        \ open DV file for input
   new-blk              \ set up for first block
   BEGIN                \ loop thru lines in file
      EOF? 0=           \ not EOF?
   WHILE                \ still more to read
      read-line         \ read next line to INBUF
      put-line          \ copy line to block buffer
      flush-blk         \ flush block if done..set up next one
   REPEAT               \ back to BEGIN
   CLSE                 \ close file
   16 lc !              \ force lc to end
   flush-blk ;          \ flush block if dirty

 

 

 

I modified its functionality a bit. Because this word is so dangerous, I have it showing the user the current blocks file they are about to overwrite and ask if s/he wants to continue.

 

Other modifications of its TurboForth actions:

  • Displays the block numbers written so the user can track copy progress.
  • Flushes only blocks written by marking the block dirty with UPDATE only after lines are actually copied. (The TF version writes an extra blank block if the last chunk from the file is exactly 16 lines.)

 

I also added copy tracking to BLK>FILE :

 

 

 

\ BLK>FILE utility ported from TurboForth to fbForth 2.0
." BLK>FILE - dumps a range of blocks to a text file."
." e.g. 1 21 BLK>FILE DSK2.BLKDUMP"

-1 CONSTANT cswtch               \ switch for printing block header
: NOT ( n1 --- n2 )  -1 XOR ;    \ bitwise NOT
." HDR toggles headers on and off." CR
: HDR  cswtch NOT DUP ' cswtch !    \ toggle header off/on
   IF ." On" ELSE ." Off" THEN CR ;
0 VARIABLE OUTBUF 78 ALLOT    \ 80-byte RAM buffer for output file
PABS @ 2+         \ VRAM address for PAB
OUTBUF            \ RAM addres for PAB-BUF
PABS @ 72 +       \ VRAM address for PAB-VBUF
FILE OUTFIL       \ associate above 3 addresses with OUTFIL
: BAR  ( blk# --- )
   BL OUTBUF C! 1 WRT         \ write a record with 1 blank
   S" --BLOCK---------------"       \ header string
   DUP C@ >R 1+ OUTBUF R CMOVE            \ header to OUTBUF
   0 <# # # # # # #> OUTBUF 8 + SWAP CMOVE   \ block# to OUTBUF
   R> WRT ;                               \ write header record
: BLK>FILE ( start end --- ) ( IS:outfilename )
   DEPTH 2 < IF                  \ at least 2 numbers on stack?
      ." Syntax error!" ABORT    \ no..we're outta here!
   ELSE
      OUTFIL SET-PAB VRBL 80 REC-LEN   \ set up OUTFIL as DV80
      BL WORD HERE DUP C@ 1+ PAB-ADDR @ 9 + SWAP VMBW  \ filename->PAB
      OUTPT OPN                  \ open file for output
      1+ SWAP DO                 \ end+1 start DO
         I .                     \ log block# to display
         I cswtch IF             \ output block header?
            BAR                  \ yes
         ELSE
            DROP                 \ no..drop block#
         THEN
         I BLOCK                 \ load next block and get buffer address
         16 0 DO                 \ 16 lines/block
            DUP OUTBUF 64 CMOVE  \ copy next line to OUTBUF
            OUTBUF 64 -TRAILING  \ trim trailing blanks
            -DUP IF              \ anything left?
               WRT               \ yes..write line to file
            ELSE
               BL OUTBUF C! 1 WRT   \ no..write a blank line
            THEN
            DROP                 \ drop OUTBUF address
            64 +                 \ address of next line
         LOOP
         DROP                    \ clean up stack
      LOOP
      CLSE                       \ close file
   THEN ; 

 

 

 

...lee

  • Like 1
Link to comment
Share on other sites

The latest FBLOCKS ZIP file is posted in “Downloads-->System Files” on my website (see signature below), as well as in post #1 here. Updates include

  • Block #1 (Welcome Screen) modifications:
    • Allows changing text colors to White on Blue
    • Displays
      • SAMS availability
      • Bytes of free Low Memory (Return Stack grows down in this space from R0 )
      • Bytes of free High Memory (Dictionary grows up from HERE ; Stack grows down from S0)
  • BLK>FILE—Current Blocks File to DV80 File export utility—ported from TurboForth with permission from Mark Wills
  • FILE>BLK—DV80 File to Current Blocks File import utility—ported from TurboForth with permission from Mark Wills

Soon I will post a video of the open screen on my website.

 

..lee

  • Like 1
Link to comment
Share on other sites

  • 2 weeks later...

While trying to port the game Battlestar by J. Volk from TI Forth to fbForth 2.0, I discovered a bug in a few graphics primitives that, as it turns out, I had introduced in fbForth 2.0:8 when I consolidated how interrupts were re-enabled. Interrupts in fbForth 2.0 are always enabled except for routines that cannot tolerate that condition, e.g., routines that write to the display screen. I used to restore interrupts within most routines that disabled them before they returned. But, when I started work on sound and speech processing through the fbForth ISR, I realized that I should probably not issue a LIMI 2 if a user ISR were active. It was at this point I remembered that all system calls to low-level ALC routines use a common return called BKLINK whose sole function is to check that a user ISR is not active before restoring interrupts and returning via R11. If a user ISR is active, interrupts are not re-enabled.

 

Since there are two types of returns from ALC routines in fbForth 2.0, I figured I could handle all such returns from ALC where interrupts had been disabled by adding the user ISR test to RTNEXT (the return to high-level Forth from ALC) and using BKLINK for those routines returning to another ALC routine through R11. Everything was fine except for routines that used R7 to save R11 before a BL branch to another routine that used BKLINK to return. You see, BKLINK copies the user ISR flag to R7 to test it and thus destroys the saved return for the calling routine, which now “returns” to console location >0000 and hangs! :_( This happens in more than one graphics primitive that uses BKLINK, unfortunately.

 

The solution was to simply leave interrupts disabled and return to the calling routine through R11, where the eventual return to high-level Forth through RTNEXT would re-enable interrupts in the absence of an active user ISR. This results in interrupts being disabled only a little while longer, which is acceptable.

 

I need to check for the same R7 problem with all the other routines I changed to returning from ALC through BKLINK before I release fbForth 2.0:11.

 

I have also discovered a slight problem with PLAY when flag = 0 for playing a new sound list only if none is currently playing. I will post those details later along with a couple of possible solutions. Right now I need to get some shuteye!

 

...lee

  • Like 1
Link to comment
Share on other sites

OK...The problem with “ <addr> 0 PLAY ” is that, when the previous sound table has not yet finished, the sound table servicing routine (STSR) just exits. There are two problems with this behavior:

  1. The address of the sound table to be played is left on the stack, polluting the stack;
  2. The sound table to be played is never played.

This renders “flag = 0” kind of useless. At this point, I am not sure how I intended “ <addr> 0 PLAY ” to work, but I surely must fix its current action. I am debating whether to simply remove the sound table address from the stack or to set up a small sound table stack such that “ <addr> 0 PLAY ” pushes the sound table address to that stack and have the STSR manage that stack. If I implement such a stack, I need to decide whether to collapse it when an unconditional “ <addr> 1 PLAY ” is encountered or to leave it intact so that servicing it continues following the interruption. I am inclined to go with the stack idea, but I am open to suggestions.

 

...lee

Link to comment
Share on other sites

  • 2 weeks later...

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.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...