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

[+Schmitzi]

hey matt,

 

check out the ustream.tv broadcast of Lee doing a fbForth/Turboforth comparison (from yesterday at the TI Faire)

 

http://www.ustream.tv/recorded/76712901

 

 

aahhhhrgg if I had known.... was it live on UStream ?

[Opry99er]

It was... And now it is archived. You can watch the whole thing on ustream now.

[+Schmitzi]

yeah, already watching Berry. Sad that I did not get that live.

[+jedimatt42]

I have another gift for you Lee,

 

Try loading the CPYBLK from the the 20151026 FBLOCKS file. I'm getting a compilation error at the word BFLNAM. The error location is 586 on block 4.

 

-M@

 

 

Looking at the manual, that code didn't change in fbForth2.0:3 in the FBLOCKS file. And BFLNAM is supposed to be resident. I'll check my module and see if BFLNAM shows up.

[+jedimatt42]

 

Looking at the manual, that code didn't change in fbForth2.0:3 in the FBLOCKS file. And BFLNAM is supposed to be resident. I'll check my module and see if BFLNAM shows up.

 

and by 'supposed to be' I just mean that is what the manual says... Is this where we got the space to include VLIST?

Other blockfile words like MKBFL and USEBFL appear to work fine.

[+Lee Stewart]

I have another gift for you Lee,

 

Try loading the CPYBLK from the the 20151026 FBLOCKS file. I'm getting a compilation error at the word BFLNAM. The error location is 586 on block 4.

 

-M@

 

 

My bad! I will fix this when I get home tonight after a wonderful time at the Chicago International TI Faire. I had forgotten using BFLNAM in a definition in FBLOCKS. While cogitating on how to define TurboForth's S" in fbForth, I decided to define a new word, TOKEN , to use in several state-smart words that interpret/compile strings. I never liked my definition of BFLNAM ; so, I basically replaced it with TOKEN and used TOKEN in the two resident words that used BFLNAM .

 

As always, Matt, I really appreciate these bug reports and, even more, the fact that fbForth is getting some significant use!

 

...lee

[+Lee Stewart]

...

There was a brief story of porting between TurboForth and fbForth, with the suggestion that the right thing to do is redefine the words, instead of rewriting the app that is being ported. I think this was treated once in this thread already, but as language features go, that is a pretty powerful aspect of Forth. Compilation binds to the definitions available at that time, and they stick. So the system stays coherent, even if you redefine something as integral as EMIT or CR.

 

...and words defined before the re-defined word use the previous definition because they reference the cfa (code field address) of the previous definition. The re-definition works because the interpreter searches the dictionary from the most recently defined word back toward the first word, which is EXECUTE in fbForth. The interpreter finds the most recent definition and executes the new word or compiles its cfa, depending on the value of STATE .

 

 

It seems to me that variables are also in the same definition stack, so they can be overridden as well with the same protections... Is that correct? I'll have to go do some learning

 

Yup! VARIABLE is easily re-defined in the TurboForth way as follows:

 

: VARIABLE ( --- )

0 VARIABLE

;

 

...lee

[+Lee Stewart]

I have posted the new FBLOCKS_20151102.zip file in post #1. I re-defined GBFL without BFLNAM , which made it a little longer:

 

: GBFL ( addrvar -- ) ( Input Stream: <blocks file> )

BL WORD ( get blocks file to HERE)

HERE DUP ( HERE to stack and dup it)

C@ 1+ =CELLS ALLOT ( allot space in dictionary for filename string on even address boundary)

SWAP ! ( store string address in variable whose address was passed to GBFL)

;

 

I still managed to get everything into one block.

 

...lee

[+jedimatt42]

Nice! Thanks, I'm back in business

-M@

[+Lee Stewart]

I rewrote SCROLL and its supporting routines mentioned in post #993ff. I converted @Willsy's TurboForth source code to Forth ALC. SCROLL now approaches TurboForth's speed. The direction parameter SCROLL requires on the stack is ANDed with 6 to prevent it from exceeding 6 and to force it to an even number. Here is the Forth code:

 

 

 

0 VARIABLE WRAP ( default is 0)

( PANWIN stores panel height, width and screen position)

0 VARIABLE PANWIN 4 ALLOT

ASM: PANEL ( x y w h --- )

R2 PANWIN LI, ( load address)

*SP+ *R2+ MOV, ( height)

*SP+ *R2+ MOV, ( width)

*SP+ R0 MOV, ( row start)

SCRN_WIDTH @() R0 MPY, ( panel position)

*SP+ R1 A, ( + column start)

SCRN_START @() R1 A, ( adjust to screen image start)

R1 *R2 MOV, ( store panel position)

;ASM

HEX

( Left scroll...)

ASM: _LEFT

BEGIN,

( read a line from screen into buffer...)

R6 R0 MOV, ( vdp address)

R3 R2 MOV, ( number of bytes to read)

DP @() R1 MOV, ( cpu buffer at HERE)

36FA @() BLWP, ( read a line via VMBR)

DP @() R0 MOV, ( start of buffer)

R0 R1 MOV, ( one character to the right)

R1 INC, ( one character to the right)

R7 R7 MOV, ( check WRAP)

EQ IF, ( wrap=off)

R11 2000 LI, ( else load a space character for the wrap-around)

ELSE, ( wrap=on)

*R0 R11 MOVB, ( save leftmost char for wrap around)

THEN,

R3 R2 MOV, ( x count)

R2 DEC, ( point to end of line for wrap-around)

BEGIN,

*R1+ *R0+ MOVB, ( copy character to the left)

R2 DEC, ( reduce x count)

EQ UNTIL, ( loop if not finished)

R11 *R0 MOVB, ( copy saved character for wrap around)

R6 R0 MOV, ( set screen address)

DP @() R1 MOV, ( source)

R3 R2 MOV, ( count)

36F2 @() BLWP, ( write to screen via VMBW)

R4 DEC, ( finished?)

NE WHILE,

R12 R6 A, ( move down one line)

REPEAT,

2 LIMI, ( restore interrupts disabled by SCROLL)

;ASM

HEX

( right scroll...)

ASM: _RIGHT

BEGIN,

( read a line from screen into buffer...)

R6 R0 MOV, ( vdp address)

R3 R2 MOV, ( number of bytes to read)

DP @() R1 MOV, ( cpu buffer)

36FA @() BLWP, ( read a line via VMBR)

DP @() R0 MOV, ( start of buffer)

R3 R0 A, ( end of buffer +1)

R0 DEC, ( correct to point to end of buffer)

R0 R1 MOV, ( r1 will hold...)

R1 DEC, ( ...end of buffer -1)

R7 R7 MOV, ( check WRAP)

EQ IF, ( wrap=off)

R11 2000 LI, ( else load a space character for the wrap-around)

ELSE, ( wrap=on)

*R0 R11 MOVB, ( save rightmost char for wrap around)

THEN,

R3 R2 MOV, ( x count)

R2 DEC, ( point to end of line for wrap-around)

BEGIN,

*R1 *R0 MOVB, ( copy character to the left)

R0 DEC, ( decrement pointer)

R1 DEC, ( decrement pointer)

R2 DEC, ( reduce x count)

EQ UNTIL, ( loop if not finished)

R11 *R0 MOVB, ( copy saved character for wrap around)

R6 R0 MOV, ( set screen address)

DP @() R1 MOV, ( source)

R3 R2 MOV, ( count)

36F2 @() BLWP, ( write to screen via VMBW)

R4 DEC, ( finished?)

NE WHILE,

R12 R6 A, ( move down one line)

REPEAT,

2 LIMI, ( restore interrupts disabled by SCROLL)

;ASM

( up scroll...)

ASM: _UP

R7 R7 MOV, ( check wrap)

NE IF, ( jump if no wrap)

R6 R0 MOV, ( top left address)

R3 R2 MOV, ( x count)

R5 R1 MOV, ( we'll use the TIB for storage)

36FA @() BLWP, ( read a line via VMBR)

THEN,

R6 R0 MOV, ( top left screen address to r0)

BEGIN,

R12 R0 A, ( move down one line)

DP @() R1 MOV, ( buffer address)

R3 R2 MOV, ( x count)

36FA @() BLWP, ( read a line via VMBR)

R12 R0 S, ( move up a line)

DP @() R1 MOV, ( buffer address)

R3 R2 MOV, ( number of bytes to write [x count])

36F2 @() BLWP, ( write to screen via VMBW)

R4 DEC, ( decrement counter)

NE WHILE, ( finished?)

R12 R0 A, ( move down a line)

REPEAT, ( repeat)

R7 R7 MOV, ( check wrap for whether to write blank line)

NE IF,

R5 R1 MOV, ( get ready to write the buffered line from TIB)

R3 R2 MOV, ( x count)

36F2 @() BLWP, ( write to screen via VMBW)

ELSE,

R0 R2 MOV, ( VDP address for VFILL)

R0 2000 LI, ( write a blank line)

R3 R1 MOV, ( x count)

319E @() BL, ( write it via VFILL)

THEN,

R4 28 LI, ( clear 40 cells [80 bytes])

BEGIN, ( clear TIB)

*R5+ CLR,

R4 DEC,

EQ UNTIL,

2 LIMI, ( restore interrupts disabled by SCROLL)

;ASM

( down scroll...)

ASM: _DOWN

R4 DEC,

R4 R0 MOV, ( y length)

R12 R0 MPY, ( convert to address (result in r1)

R6 R1 A, ( add top of panel offset)

R1 R0 MOV, ( vdp address in r0)

R7 R7 MOV, ( check wrap)

NE IF, ( we need to wrap)

R5 R1 MOV, ( we'll use the TIB for storage)

R3 R2 MOV, ( x count)

36FA @() BLWP, ( read a line via VMBR)

THEN,

BEGIN,

R12 R0 S, ( move up a line)

DP @() R1 MOV, ( buffer address)

R3 R2 MOV, ( x count)

36FA @() BLWP, ( read a line via VMBR)

R12 R0 A, ( move down a line)

DP @() R1 MOV, ( buffer address)

R3 R2 MOV, ( x count)

36F2 @() BLWP, ( write to screen via VMBW)

R4 DEC, ( decrement line count)

NE WHILE, ( repeat if not finished)

R12 R0 S, ( otherwise move up a line)

REPEAT, ( and repeat)

R12 R0 S, ( up a line)

R7 R7 MOV, ( check wrap)

NE IF, ( we're wrapping)

R5 R1 MOV, ( source [TIB])

R3 R2 MOV, ( x count)

36F2 @() BLWP, ( write to screen via VMBW)

ELSE, ( blank line)

R0 R2 MOV, ( VDP address for VFILL)

R0 2000 LI, ( write a blank line)

R3 R1 MOV, ( x count)

319E @() BL, ( write it via VFILL)

THEN,

R4 28 LI, ( clear 40 cells [80 bytes])

BEGIN, ( clear TIB)

*R5+ CLR,

R4 DEC,

EQ UNTIL,

2 LIMI, ( restore interrupts disabled by SCROLL)

;ASM

( SCRLUT--- lookup table for directional scrolling routines)

' _LEFT VARIABLE SCRLUT 6 ALLOT

' _RIGHT SCRLUT 2+ !

' _UP SCRLUT 4 + !

' _DOWN SCRLUT 6 + !

( SCROLL...) ( direction -- )

( scrolls the screen, according to the coodinates in PANEL)

( 0=left 2=right 4=up 6=down)

HEX

ASM: SCROLL ( dir --- )

R0 PANWIN LI, ( load address)

*R0+ R4 MOV, ( height)

*R0+ R3 MOV, ( width)

*R0 R6 MOV, ( screen address to start)

TIB @() R5 MOV, ( get TIB address in a register)

WRAP @() R7 MOV, ( get WRAP in a register)

SCRN_WIDTH @() R12 MOV, ( get xmax in a register)

( check direction and call appropriate routine...)

R0 SCRLUT LI, ( address of look up table )

*SP+ R1 MOV, ( pop direction)

R1 6 ANDI, ( insure dir <= 6 and even)

R1 R0 A, ( adjust to routine address pointer)

*R0 R0 MOV, ( get the address in a register)

0 LIMI, ( disable interrupts before calling VDP access routines)

*R0 B, ( call the routine)

;ASM

 

 

 

and, here is the machine code that obviates needing to load the Assembler:

 

 

 

HEX

0 VARIABLE WRAP ( default is 0)

( PANWIN stores panel height, width and screen position)

0 VARIABLE PANWIN 4 ALLOT

CODE PANEL 0202 , PANWIN , CCB9 , CCB9 , C039 , 3820 , 3690 ,

A079 , A060 , 3692 , C481 , NEXT,

CODE _LEFT C006 , C083 , C060 , 3672 , 0420 , 36FA , C020 ,

3672 , C040 , 0581 , C1C7 , 1603 , 020B , 2000 , 1001 ,

D2D0 , C083 , 0602 , DC31 , 0602 , 16FD , D40B , C006 ,

C060 , 3672 , C083 , 0420 , 36F2 , 0604 , 1302 , A18C ,

10E0 , 0300 , 0002 , NEXT,

CODE _RIGHT C006 , C083 , C060 , 3672 , 0420 , 36FA , C020 ,

3672 , A003 , 0600 , C040 , 0601 , C1C7 , 1603 , 020B ,

2000 , 1001 , D2D0 , C083 , 0602 , D411 , 0600 , 0601 ,

0602 , 16FB , D40B , C006 , C060 , 3672 , C083 , 0420 ,

36F2 , 0604 , 1302 , A18C , 10DC , 0300 , 0002 , NEXT,

CODE _UP C1C7 , 1305 , C006 , C083 , C045 , 0420 , 36FA ,

C006 , A00C , C060 , 3672 , C083 , 0420 , 36FA , 600C ,

C060 , 3672 , C083 , 0420 , 36F2 , 0604 , 1302 , A00C ,

10F0 , C1C7 , 1305 , C045 , C083 , 0420 , 36F2 , 1006 ,

C080 , 0200 , 2000 , C043 , 06A0 , 319E , 0204 , 0028 ,

04F5 , 0604 , 16FD , 0300 , 0002 , NEXT,

CODE _DOWN 0604 , C004 , 380C , A046 , C001 , C1C7 , 1304 ,

C045 , C083 , 0420 , 36FA , 600C , C060 , 3672 , C083 ,

0420 , 36FA , A00C , C060 , 3672 , C083 , 0420 , 36F2 ,

0604 , 1302 , 600C , 10F0 , 600C , C1C7 , 1305 , C045 ,

C083 , 0420 , 36F2 , 1006 , C080 , 0200 , 2000 , C043 ,

06A0 , 319E , 0204 , 0028 , 04F5 , 0604 , 16FD , 0300 ,

0002 , NEXT,

( SCRLUT--- lookup table for directional scrolling routines)

' _LEFT VARIABLE SCRLUT 6 ALLOT

' _RIGHT SCRLUT 2+ !

' _UP SCRLUT 4 + !

' _DOWN SCRLUT 6 + !

CODE SCROLL 0200 , PANWIN , C130 , C0F0 , C190 , C160 ,

366E , C1E0 , WRAP , C320 , 3690 , 0200 , SCRLUT , C079 ,

0241 , 0006 , A001 , C010 , 0300 , 0000 , 0450 , NEXT,

 

 

 

I will add these routines to FBLOCKS in the near future.

 

In the meantime, I will post an updated DARKSTAR blocks file that includes these new SCROLL routines.

 

...lee

[+Lee Stewart]

Here is the revised Darkstar blocks file with the new definition of SCROLL : DarkStar_fbForth2_x3.zip

 

...lee

[atrax27407]

Lee now has in his possession the FBForth files for the HSGPL Card. There are two versions ; one for the Tony Knerr GROM0 and another for the Winfred Winkler GROM0. I'm sure he will be glad to post them or email them.

Edited November 7, 2015 by atrax27407

[+jedimatt42]

I'm trying to get a grip on the ISR support in fbForth.

Looking at the example in chapter 10.2 of the fbForth manual, the definition of DOWN seems odd, in that ALLOT doesn't leave anything on the stack. So I'm trying to better understand why the UP and DOWN, and the asymmetry..

The example goes like this ( From Lee's book ):

0 VARIABLE TIMER
: UP 100 ALLOT ;
: DOWN -100 ALLOT DROP ;
: DEMO UP
1 TIMER +! TIMER @ (s:1) (value of timer)
PAD DUP 5 + (s:3) (value of timer, pad, pad + 5)
DO (s:1) (value of timer)
0 10 U/ (s:2) (rem, quot) Timer gets coerced to a couple with the zero? and then remainder is our digit
SWAP 48 + (s:2) (quot, ascii digit)
I C! (s:1) (quot)
-1 +LOOP (s:1) (quot) (is this leaking with every loop iteration then?)
PAD 1+ SCRN_START @ 5 VMBW (s:1) (quot)
DOWN ; (s:0) ( now drop cleaned up our straggling quotient from the earlier division. )

And then DEMO is installed as the ISR.

I've annotated the code above with (s:n) where n is the number of items on the stack logically at the end of that line. I'm sure there is some funny business with interpretting that across the DO loop... but that shouldn't matter for this conversation.

I've annotated what I think is on the stack at each step as well. I think that the DROP shouldn't be in the DOWN definition, but should be in the end of the +LOOP, cleaning up the unused quotient with each iteration.

Is that correct?

The UP and DOWN routines seem to be about creating a safe buffer for rendering the character string. So was shifting the use of 100 as the value to shift PAD based on PAD usage in this routine, or PAD usage in whatever code might have been interrupted by the ISR?

All insights appreciated.
-M@

[+Lee Stewart]

It looks like you got all the stack effects correct.

 

The DROP is properly outside the loop. You want the decimated quotient to be there for the next go-round. Adding the 0 to the stack each time through the loop makes the 16-bit quotient a 32-bit double number, which is required by U/ for the dividend. The divisor is a 16-bit number (10). It doesn't matter where the DROP is, as long as it is executed once outside the loop. I agree that it makes more sense for it not to be part of DOWN ; but, it definitely should be after the loop!

 

You are correct about shifting HERE to create a safe buffer space for the timer string. PAD floats 68 bytes above HERE . That is why 100 was chosen to temporarily move the ISR's HERE 32 bytes above the interrupted program's PAD , which puts the ISR's PAD 100 bytes above the interrupted program's PAD . It might be safer to offset it even more. An interrupted program can be using both HERE and PAD for temporary stuff. Most of the time, 100 bytes is probably safe, but you never know.

 

...lee

[+jedimatt42]

Oh, right. I get it now. The quotient from each pass of the loop is the input into the next pass at the loop, with only the last quotient left on the stack. Thanks!

-M@

[+Lee Stewart]

Latest build is fbForth 2.0:4 and is posted in post #1. It includes the facility to load FBLOCKS from any DSK by holding down the desired disk number while booting up. You can also hold <ENTER> to bypass the autoloading of FBLOCKS. This was ported from TurboForth. The new DSK persists as the default location for FBLOCKS, even through executing COLD . Reaching the title screen restores the location to DSK1.

 

DEFBF has been redefined to leave the address of the low RAM location of the default FBLOCKS string. If you want to type that string, the following commands will do it:

 

DEFBF COUNT TYPE

 

The latest FBLOCKS file is also posted. It contains new words DATA[ , ]DATA , DCHAR , SPDCHAR , SCROLL , WRAP and PANEL , all ported from TurboForth.

 

I have left the files for fbForth 2.0:3 because this build is not a bug fix, but rather, an enhancement.

 

Soon, I will post the HSGPL files from Bob Carmany (@atrax27407).

 

As always, please test these files and let me know of any trouble you have with them.

 

...lee

Edited November 9, 2015 by Lee Stewart

[atrax27407]

Anyone have a copy of FBLOCKS on a physical disk that they would be willing to mail to me? For some reason, I am having trouble getting a clean download from the Atariage site. Send me a message for the address. Thanks.

[atrax27407]

Cancel the request. I was able to use my magic incantation and get the FBLOCKS file to comply with my wishes.

[+Lee Stewart]

I am beginning to work on a block browser/copier for TI Forth that will allow browsing and copying blocks from TI Forth disks to an fbForth blocks file. I don't plan to have it work the other way. Any suggestions or wishes about how it should work?

 

...lee

[Opry99er]

Very cool idea. I do not have any suggestions (yet) but how many TI Forth disks are out there with games/applications on them? I ask because (while I have many Super4th disks) I do not have any TI Forth disks.

Edited November 11, 2015 by Opry99er

[+Lee Stewart]

Very cool idea. I do not have any suggestions (yet) but how many TI Forth disks are out there with games/applications on them? I ask because (while I have many Super4th disks) I do not have any TI Forth disks.

 

There are a fair number, but they are scattered among user group libraries, The Cyc, newsletters, ....

 

...lee

[+Lee Stewart]

More thoughts on the TI Forth browser/copier I am working on:

• Browser
  • Browser only (separate program from copier) or
  • Browse, with option to copy currently viewed TI Forth block and the following options:
    • Copy to displayed blocks file
    • Copy to different blocks file
    • Copy to displayed block #
    • Copy to different block #
    • Auto-increment block # between copies
    • Copy a range of blocks
• Copier
  • Part of browser as noted above or
  • Copy a range of blocks only
    • Separate program from browser
    • Command-line utility like CPYBLK

Any suggestions?

 

...lee

[+Lee Stewart]

Here is a first pass at a browser:

 

 

 

( Read and display TI Forth blocks)

HEX

1154 CONSTANT VTIbuf ( VRAM sector buffer address)

0110 VARIABLE TIPAB ( 2-byte, level 1, read/write sector PAB contents)

1 VARIABLE Dsk ( 1-based disk #, i.e., 1 for DSK1)

0 VARIABLE BlkBuf 3FE ALLOT ( 1KiB RAM block buffer)

( Trap read error)

: RdErr? ( err -- ) -DUP IF CR ." Disk I/O error " BASE->R

[COMPILE] HEX . R->BASE ABORT THEN ;

: DSRLNK10 0A 0E SYSTEM 8350 C@ RdErr? ; ( DSR suprogram link)

: getTIblock ( blk# -- )

TIPAB VTIbuf 2- 2 VMBW ( copy PAB to VRAM)

VTIbuf 834E ! ( VRAM buffer address to transfer block)

Dsk @ SWPB 1+ 834C ! ( disk# and read to )

2 SLA ( sec#) ( calculate starting sector#)

BlkBuf DUP 400 + SWAP DO ( RAM buffer max and start of DO index to stack)

DUP 8350 ! ( sector# to transfer block)

1+ ( sec#+1) ( increment sector# for next go-round)

VTIbuf 2- 8356 ! ( PAB address to subprogram pointer)

DSRLNK10 ( get the sector contents to VRAM)

VTIbuf I 100 VMBR ( coipy 256 bytes to next slot in RAM buffer)

100 +LOOP ( get next sector)

DROP ; ( drop leftover sector#)

: dnLeft CURPOS @ SCRN_WIDTH @ MOD ( cursor at beginning of line?)

IF CR THEN ; ( move text cursor to start of next line if so)

: dspLine ( line# -- ) 40 * BlkBuf + 40 TYPE ; ( type 1 line)

: TIFBLK ( dsk# blk# -- ) ( type TI Forth block)

SWAP Dsk ! ( store disk# for getTIblock)

getTIblock ( get the block to RAM buffer)

PAGE ( clear screen with cursor to screen start)

10 0 DO ( process 16 lines)

dnLeft ( cursor to beginning of current/next line)

I 2 .R ." | " ( type line#)

I dspLine ( type next line)

PAUSE IF LEAVE THEN ( check for pause or <BREAK> key)

LOOP ;

: TIFIDX ( dsk# blk# cnt -- ) ( type index lines of 1 or more TI Forth blocks)

ROT Dsk ! ( store disk# for getTIblock)

PAGE ( clear screen with cursor to screen start)

0 DO ( process cnt# index lines)

DUP I + DUP ( calculate next block# and copy for next go-round)

getTIblock ( get the block to RAM buffer)

CURPOS @ 40 + SCRN_END @ > ( check for full page)

IF

KEY DROP PAGE ( wait for keystroke before displaying next page)

THEN

dnLeft ( cursor to beginning of current/next line)

3 .R ." | " ( type block#)

0 dspLine ( type block's line 0 [index line])

PAUSE IF LEAVE THEN ( check for pause or <BREAK> key)

LOOP

DROP ( drop excess block#)

CR ." ...done" ; ( announce completion)

DECIMAL

 

The following will display TI Forth block# 1 from DSK2:

 

2 1 TIFBLK

 

The following will display the index lines (line# 0) of the first 40 TI Forth blocks on DSK3:

 

3 0 40 TIFIDX

 

...lee

[+Lee Stewart]

I now have a working TIF2FBF word that copies a range of blocks from a TI Forth disk to an fbForth blocks file. It requires an input stream similar to CPYBLK :

 

TIF2FBF 2 5 DSK2 30 DSK1.MYBLOCKS

 

will copy blocks 2 – 5 from DSK2 to blocks 30 – 33 of DSK1.MYBLOCKS.

 

I also changed the definitions of TIFBLK and TIFIDX from the last post to take similar information from the input stream:

 

TIFBLK 1 DSK2

TIFIDX 0 40 DSK3

 

I will post the code later today after I get some shut-eye.

 

...lee

[+Lee Stewart]

Here is the code for TIF2FBF and the new code for TIFBLK and TIFIDX :

 

 

 

( Read and display TI Forth blocks)

HEX

1154 CONSTANT VTIbuf ( VRAM sector buffer address)

0110 VARIABLE TIPAB ( 2-byte, level 1, read/write sector PAB contents)

1 VARIABLE Dsk ( 1-based disk #, i.e., 1 for DSK1)

0 VARIABLE DFL ( pointer to destination filename string)

: GNUM BL WORD HERE NUMBER DROP ; ( get number from terminal)

( Get DO limit and index to stack from input stream [iS])

: getDOidx ( --- limit index ) ( IS: startBlk# endBlk#)

GNUM GNUM OVER OVER ( get start & end block#s and dup them)

> IF SWAP THEN ( if start# > end#, swap them)

1+ ( increment limit)

SWAP ; ( get in index order for DO ... LOOP)

: BlkBuf PREV @ 2+ ; ( use last accessed block buffer)

: getDsk ( IS:DSKn) BL WORD HERE 4 + C@ 30 - Dsk ! ; ( get source disk#)

( Trap read error)

: RdErr? ( err -- ) -DUP IF CR ." Disk I/O error " BASE->R

[COMPILE] HEX . R->BASE ABORT THEN ;

: DSRLNK10 0A 0E SYSTEM 8350 C@ RdErr? ; ( DSR suprogram link)

: getTIblock ( blk# -- )

FLUSH ( flush any dirty buffers)

TIPAB VTIbuf 2- 2 VMBW ( copy PAB to VRAM)

VTIbuf 834E ! ( VRAM buffer address to transfer block)

Dsk @ SWPB 1+ 834C ! ( disk# and read opcode to transfer block)

2 SLA ( sec#) ( calculate starting sector#)

BlkBuf DUP 400 + SWAP DO ( RAM buffer max and start of DO index to stack)

DUP 8350 ! ( sector# to transfer block)

1+ ( sec#+1) ( increment sector# for next go-round)

VTIbuf 2- 8356 ! ( PAB address to subprogram pointer)

DSRLNK10 ( get the sector contents to VRAM)

VTIbuf I 100 VMBR ( coipy 256 bytes to next slot in RAM buffer)

100 +LOOP ( get next sector)

DROP ; ( drop leftover sector#)

: dnLeft CURPOS @ SCRN_WIDTH @ MOD ( cursor at beginning of line?)

IF CR THEN ; ( move text cursor to start of next line if so)

: dspLine ( line# -- ) 40 * BlkBuf + 40 TYPE ; ( type 1 line)

: 64page? ( check that next 64 chars will stay on screen)

CURPOS @ 40 + SCRN_END @ > ( check for full screen)

IF

KEY DROP PAGE ( wait for keystroke before continuing display)

THEN ;

: TIFBLK ( IS:blk# DSKn ) ( type TI Forth block)

GNUM ( get block# from IS)

getDsk ( store disk# for getTIblock)

getTIblock ( get the block to RAM buffer)

PAGE ( clear screen with cursor to screen start)

10 0 DO ( process 16 lines)

64page? ( check for end of page)

dnLeft ( cursor to beginning of current/next line)

I 2 .R ." | " ( type line#)

I dspLine ( type next line)

PAUSE IF LEAVE THEN ( check for pause or <BREAK> key)

LOOP ;

( Type index lines of 1 or more TI Forth blocks)

: TIFIDX ( IS:startblk endblk DSKn)

getDOidx ( get DO limit and index from IS)

getDsk ( store disk# for getTIblock)

PAGE ( clear screen with cursor to screen start)

DO ( process startBlock – endBlock index lines)

I getTIblock ( get the block to RAM buffer)

64page? ( check for end of page)

dnLeft ( cursor to beginning of current/next line)

I 3 .R ." | " ( type block#)

0 dspLine ( type block's line 0 [index line])

PAUSE IF LEAVE THEN ( check for pause or <BREAK> key)

LOOP

CR ." ...done" ; ( announce completion)

( GBFL gets HERE to stack; stores filename at HERE; establishes new HERE;)

( stores string address in variable passed on stack)

: GBFL ( addrvar -- ) BL WORD HERE DUP C@ 1+ =CELLS ALLOT SWAP ! ;

: TIF2FBF ( IS:srcStartBlock srcEndBlock DSKn dstStartBlock dstBlocksFile)

HERE ( save address where we'll copy current blocks filename)

BPB BPOFF @ + 9 + ( get address of blocks filename's char-count byte)

DUP VSBR 1+ ( get count byte and increment it for copy count)

( Get current blocks name to HERE and move HERE past it.)

HERE SWAP DUP =CELLS ALLOT VMBR

getDOidx ( get DO limit and index from IS)

getDsk ( get source disk#)

GNUM ( get destination start block#)

DFL GBFL ( dst filename to HERE; store address, moving HERE)

DFL @ (UB) ( open destination blocks file)

ROT ROT ( get limit and index to top of stack)

DO ( endBlock+1 startBlock DO)

I . ( type src)

I getTIblock ( load next TI Forth src block)

DUP ( dup dst block#)

PREV @ ! ( store dst block# at head of block buffer)

UPDATE FLUSH ( write block to destination blocks file)

1+ ( calculate next dst block#)

LOOP

DROP ( drop the leftover dst block#)

DUP ( DUP old HERE)

(UB) ( restore original blocks file to 'current' status)

DP ! ( restore dictionary pointer)

;

DECIMAL

 

 

 

The format for each command is

 

TIFBLK <srcBlock#> DSKn

 

Example to display block #2 from TI Forth disk, DSK2:

TIFBLK 2 DSK2

 

TIFIDX <startBlock#> <endBlock#> DSKn

Example to display index lines (line #0) of blocks #0 – #89 from TI Forth disk, DSK3:

TIFIDX 0 89 DSK3

TIF2FBF <srcStartBlock#> <srcEndBlock#> DSKn <dstStartBlock#> <dstBlocksFilename>

Example to copy blocks #2 – #6 from TI Forth, DSK2, to fbForth, DSK1.MYBLOCKS, starting at block #30:

TIF2FBF 2 6 DSK2 30 DSK1.MYBLOCKS

...lee

 

[NOTE: Note 64page? edits in the above code, marked with the same color as this note. This will pause the display at the end of the screen when there are more lines to display.]

Edited November 17, 2015 by Lee Stewart