fs2fb

Description of the page content

Converter of Forth source files to blocks files or ZX Spectrum TAP files.

Tags:

This tool converts Forth source files to blocks files or ZX Spectrum TAP files, ready to be used by Abersoft Forth. When the program is loaded into Gforth it shows its commands.

fs2fb was superseded by fsb and fsb2, more powerful and versatile tools.

Source code

#! /usr/bin/env gforth
\ --------------------------------------------------------
\ fs2fb

\ Copyright (C) 2009,2011,2014 Marcos Cruz (programandala.net)
\ License: http://programandala.net/license

\ This program converts a Forth stream file (.fs)
\ to a Forth blocks file (.fb),
\ or to a ZX Spectrum TAP file
\ containing an Abersofth Forth's RAM-disc file.

\ This program is written in Forth with Gforth.
\ (http://gnu.org/software/gforth)

\ --------------------------------------------------------

\ History

\ 2009-06-04: First draft.
\ 2009-06-14: First working version.
\ 2011-12-23: The format of the source code was modifed.
\ 2014-10-26: Little changes.
\ 2014-11-02: Strange things happened during some tests. Bugs.

\ --------------------------------------------------------

forth definitions
marker fs2fb
base @  hex

\ Files

variable fs_fid
variable tap_fid

: open_fb ( ca u -- )
  open-blocks
  ;
: open_fs ( ca u -- )
  r/o open-file abort" open stream file error"
  fs_fid !
  ;
: open_tap  ( ca u -- )
  w/o create-file abort" create tap file error"
  tap_fid !
  ;
: close ( fid -- )
  close-file abort" close file error"
  ;
: close_fs  ( -- )
  fs_fid @ close
  ;
: close_fb  ( -- )
  get-block-fid close
  ;
: close_tap  ( -- )
  tap_fid @ close
  ;

\ Text lines

ff constant /line
create 'line  /line 2 + chars allot
9 constant tab

: valid-char?  ( c -- f )
  dup tab <> swap bl <> and
  ;
: next-char  ( ca1 -- ca2 c )
  char+ dup c@
  ;
: -leading_init  ( ca u -- ca u ca1 )
  over 1 chars -
  ;
: -leading_result  ( ca u ca2 -- ca2 u2 )
  dup >r  rot - - r> swap
  ;
: -leading  ( ca u -- ca1 u1 )
  -leading_init
  begin  next-char valid-char?  until
  -leading_result
  ;
: +space  ( ca u1 -- ca u2 )
  2dup + bl swap c! 1+
  ;
: no_\  ( ca u1 -- ca u2 )
  2dup s"  \ " search
  if  nip -  else  2drop  then
  ;
: no_()  ( ca u1 -- ca u2 )
  ;
: -comments  ( ca u1 -- ca u2 )
  no_\ no_()
  ;
: trim  ( ca u -- ca1 u1 )
  -trailing -leading +space
  ;
: clean_line  ( ca u -- ca1 u1 )
  trim -comments
  ;
: >line  ( -- ca u f )
  \ u = bytes read
  \ f = end of file?
  'line dup /line fs_fid @
  read-line abort" stream read error"
  ;

\ Blocks file

1 block-offset !  \ start counting at block 1...
\ ...otherwise Gforth 0.6.2 doesn't update the first block...
\ ...(but fills it with zeroes) (bug?)
2 constant first_block#
400 constant /block
variable block#  \ number of the current block
variable >block  \ address of the current position into the current block

: 'block  ( -- ca )
  block# @ block
  ;
: chars_left  ( -- u )
  /block >block @ 'block - -
  ;
: too_long?  ( u -- f )
  4 + chars_left >
  ;
: to_block  ( ca u -- )
  >block @ swap chars move
  ;
: (line>)  ( ca u -- )
  dup >r  to_block  r> >block +! update
  ;
: .-->  ( -- ca u )
  s" -->" (line>)
  ;
: clean_buffer  ( u -- )
  block /block blank
  ;
: is_block  ( u -- )
  dup clean_buffer  dup block# ! buffer >block !
  ;
: next_block  ( -- )
  block# @ 1+ is_block
  ;
: line>  ( ca u -- )
  clean_line 2dup cr type  dup too_long?
  if  .--> next_block  then  (line>)
  ;
: first_block  ( -- )
  1 is_block update  2 is_block
  ;

: .debug  ( -- )
  cr ." block# = " block# ?
  ." 'block = " 'block .
  ." >block = " >block ?
  ." chars_left " chars_left .
  cr .s cr block# @ list
  ;
: wait  ( -- )
  key drop
  ;

: (fs>fb)  ( -- )
  first_block
  begin  .debug >line  while  line>  repeat
  2drop flush
  ;

\ File extensions

create "fb" char f c, char b c,
create "tap" char t c, char a c, char p c,
create filename 255 chars allot
: >filename  ( ca u -- ca1 u )
  dup rot filename rot cmove  filename swap
  ;
: >"fb"  ( ca u -- ca1 u )
  >filename 2dup 2 - + "fb" swap 2 cmove
  ;
: >"tap"  ( ca u -- ca1 u1 )
  >filename 2dup 2 - + "tap" swap 3 cmove  1+
  ;

\ TAP file

18 constant /tap_header
create 'tap_header
13 c, 00 c, 00 c, 03 c,
char D c, char I c, char S c, char C c, bl c, bl c, bl c, bl c, bl c, bl c,
ff c, 2b c, 00 c, d0 c, 20 c, 20 c, 1a c, 01 c, 2c c, ff c,

: tap_write  ( ca u -- )
  tap_fid @ write-file abort" tap write error"
  ;
: checksum  ( ca u -- x )
  0 rot rot  bounds  do  i c@ xor  loop
  ;
: header_checksum  ( -- )
  'tap_header dup /tap_header checksum
  ;
: block_checksum  ( x1 u -- x2 )
  \ x1 = current checksum
  \ u = block
  block /block checksum xor
  ;
: tap_header  ( -- )
   header_checksum
  ;
: block>tap  ( x1 u -- x2 )
  \ x1 = current checksum
  \ u = block
  swap over block_checksum  block /block tap_write
  ;
: byte>tap  ( b -- )
  pad c!  pad 1 tap_write
  ;
: (fb>tap)  ( ca1 u1 ca2 u2 -- )
  tap_header  0  12 1  do  i block>tap  loop  byte>tap
  ;

\ User interface

: fs>fb ( ca u -- )
  2dup >"fb" open_fb open_fs (fs>fb)
  close_fb close_fs
  ;
: fb>tap ( ca u -- )
  2dup >"tap" open_tap open_fb (fb>tap)
  close_tap close_fb
  ;
: fs>tap ( ca u -- )
  2dup fs>fb >"fb" fb>tap
  ;

\ End

base !

\ debug
: s2b fs2fb s" /home/marcos/forth/fs2fb.fs" included ;
: test s" /home/marcos/forth/test.fs" fs>fb ;

cr
cr .( Usage: )
cr .( s" program.fs" fs>fb)
cr .( s" program.fb" fb>tap)
cr .( s" program.fs" fs>tap)
cr cr

Downloads

Related pages

fsb
Converter for Forth sources.
fsb2
Converter for Forth sources.