fs2fb

Descripción del contenido de la página

Conversor de ficheros fuente de Forth en ficheros de bloques o ficheros TAP para ZX Spectrum.

Etiquetas:

Esta utilidad permite convertir ficheros de código fuente de Forth del formato de texto estándar (cuya extensión en Gforth es «.fs», por «Forth stream») al formato clásico de bloques («.fb», «Forth blocks»). También crea una variante de los ficheros de bloque: un fichero de cinta virtual («.tap») preparado para el sistema Abersoft Forth de ZX Spectrum.

El programa, una vez cargado en Gforth, muestra la sintaxis de los comandos disponibles.

Este programa está superado por dos herramientas más potentes y versátiles: fsb y fsb2.

Código fuente

#! /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

Descargas

Páginas relacionadas

fsb
Convertidor de fuentes de Forth.
fsb2
Convertidor de fuentes de Forth.
Ftaper
Utilidad escrita Forth para convertir ficheros fuente de Forth en ficheros de cinta virtual para ZX Spectrum.