mkepr

Priskribo de la ĉi-paĝa enhavo

Kreilo de dosieroj de kartoj EPROM kaj Intel Flash por Z88-emuliloj, verkita en Fortho.

Projekto verkita de 2015-12-05 ĝis 2015-12-17.

Etikedoj:

mkepr estas komand-linia ilo kiu kreas EPROM-dosierojn uzeblajn de emuliloj de Z88.

mkepr estas verkita en Fortho per Gforth kaj uzas uno modjulon de Forth Foundation Library. La fontkodo kaj la inkludita dosiero README.adoc (legebla ankaŭ sur la anglalingva paĝo de mkepr) enhavas plian detalon kaj instrukciojn por instalo.

Fontkodo

#! /usr/bin/env gforth

\ mkepr.fs

: version  s" 0.4.1+20151217"  ;  \ after http://semver.org

\ ==============================================================
\ Description

\ mkepr is a command line tool that creates EPROM and Intel
\ Flash image files containing files from the host system, ready
\ to be used by the Cambridge Z88 emulators ZEsarUX and OZvm.

\ mkepr webpage:
\ http://programandala.net/en.program.mkepr.html

\ mkepr is written in Forth for Gforth (tested on version
\ 0.7.3):
\ http://gnu.org/software/gforth

\ ==============================================================
\ Author and license

\ Copyright (C) 2015 Marcos Cruz (programandala.net)
\
\ You may do whatever you want with this work, so long as you
\ retain the copyright notice(s) and this license in all
\ redistributed copies and derived works. There is no warranty.

\ ==============================================================
\ Acknowledgments

\ The testings were done on the following Z88 emulators:
\
\ ZEsarUX (snapshot version 3.2-SN), by César Hernández:
\ http://sourceforge.net/projects/zesarux/
\
\ OZvm (version 1.1.5), by Gunter Strube:
\ https://cambridgez88.jira.com/wiki/display/OZVM

\ Thanks to César Hernández for the location of the information
\ about the File Card format, on the website of the Z88
\ Development Team.
\
\ https://cambridgez88.jira.com/wiki/display/DN/Miscellaneous+useful+information#Miscellaneoususefulinformation-FileCardformat

\ Thanks to Garry Lancaster for confirming the format of
\ Intel Flash cards:
\
\ https://www.mail-archive.com/forth-sinclair@yahoogroups.com/msg00038.html

\ Thanks to Anton Erlt for the example how to do `bye` returning an
\ error code to the OS shell:
\
\ http://lists.gnu.org/archive/html/gforth/2015-12/msg00004.html
\ http://www.mail-archive.com/gforth@gnu.org/msg00540.html

\ ==============================================================
\ History

\ See at the end of the file.

\ ==============================================================
\ Installation

\ Make sure the <mkepr.fs> is executable.  Then copy, move or
\ link it to a directory on your path.

\ Example for single-user installation:

\     chmod u+x mkepr.fs
\     ln mkepr.fs ~/bin/mkepr

\ Example for system-wide installation:

\     chmod ugo+x mkepr.fs
\     ln mkepr.fs /usr/local/bin/mkepr

\ ==============================================================
\ Documentation on the File Card format

\ From
\ https://cambridgez88.jira.com/wiki/display/DN/Miscellaneous+useful+information#Miscellaneoususefulinformation-FileCardformat

\ $0000       File entry
\ ...         File entry
\ ... 
\ ...         Latest file entry
\ ...         $FF's until
\ $3FC0       $00's until
\ $3FF7       $01
\ $3FF8       4 byte random id
\ $3FFC       size of card in banks (in units of 16 KiB)
\ $3FFD       sub-type:
\               $7E for 32 KiB cards
\               $7C for 128 KiB (or larger) cards
\ $3FFE       'o'
\ $3FFF       'z' (file eprom identifier, lower case 'oz')

\ A file entry has the form:

\ 1 byte      n           length of filename
\ 1 byte      x           '/' for latest version
\                         $00 for old version (deleted)
\ n-1 bytes   '...'       filename
\ 4 bytes     m           length of file
\                         (least significant byte first)
\ m bytes                 body of file


\ From the source of FlashStore
\ (https://cambridgez88.jira.com/wiki/display/ZFS/FlashStore+%28Z88+popdown%29+Home):
\
\ ____
\ Due to a strange side effect with Intel Flash Chips, a
\ special "NULL" file is saved as the first file to the Card.
\ These bytes occupies the first bytes that otherwise could be
\ interpreted as a random boot command for the Intel chip -
\ the behaviour is an Intel chip suddenly gone into command
\ mode for no particular reason. The NULL file prevents this
\ behaviour by saving a file that avoids any kind of boot
\ commands which sends the chip into command mode when the
\ card has been inserted into a Z88 slot.
\ ____

\ ==============================================================
\ Requirements

only forth definitions
warnings off

\ ----------------------------------------------
\ From Gforth

require string.fs  \ dynamic strings
require random.fs  \ random number generator

\ ----------------------------------------------
\ From the Forth Foundation Library
\ (http://irdvo.github.io/ffl/)

require ffl/arg.fs  \ arguments parser
require ffl/chr.fs  \ char data type

\ ----------------------------------------------
\ From the Galope library
\ (http://programandala.net/en.program.galope.html)

: unslurp-file  ( ca1 len1 ca2 len2 -- )
  w/o create-file throw >r
  r@ write-file throw
  r> close-file throw  ;
  \ Save memory region _ca1 len1_ to file _ca2 len2_.

: $variable  ( "name" -- )
  variable  0 latestxt execute $!len  ;
  \ Create and initialize a dynamic string variable "name".

: d>str  ( d -- ca len )
  tuck dabs <# #s rot sign #>  ;
  \ Convert a double number _d_ to a string _ca len_.

: n>str  ( n -- ca len )
  s>d d>str  ;
  \ Convert number _n_ to a string _ca len_.

: c>str  ( c -- ca len )
  1 allocate throw  tuck c! 1  ;
  \ Convert an ASCII char to a string.

variable (any?)

: any?  ( x0 x1..xn n -- f )
  dup 1+ roll (any?) !  0 swap 0 do  swap (any?) @ = or  loop  ;
  \ Is any _x1..xn_ equal to _x0_?

: sides  { ca1' len1' ca1 len1 len2 -- ca3 len3 ca4 len4 }
  ca1  len1 len1' -             \ left side
  ca1' len2 +  len1' len2 -  ;  \ right side
  \ Convert the result returned by 'search': divide the searched
  \ string at the substring that was searched to.
  \ ca1' len1' = string searched, starting with the first (ca2 len2)
  \ ca1 len1 = original string, before the search
  \ len2 = length of the substring searched for
  \ ca1' len2 = substring found in ca1 len1
  \ ca3 len3 = left side of ca1 len1, until and excluding ca1' len2
  \ ca4 len4 = right side of ca1 len1, after ca1' len2

: /sides  { ca1 len1 ca2 len2 -- ca1 len1' ca3 len3 f }
  ca1 len1 ca2 len2 search dup >r
  if    ca1 len1 len2 sides
  else  over 0  \ fake right side
  then  r>  ;
  \ Search a string _ca1 len1_
  \ for the first occurence of a substring _ca2 len2_.
  \ Divide the string _ca1 len1_ in two parts: return both sides
  \ of the substring _ca2 len2_ (first occurence), excluding the
  \ substring _ca2 len2_ itself.
  \
  \ ca1 len1  = string
  \ ca2 len2  = substring
  \ ca1 len1' = left side (or whole string if not found)
  \ ca3 len3  = right side (or empty string if not found)
  \ f = found?
  \
  \ Note: _ca3 len3_ can be empty also when _f_ is true.

: /slash  ( ca len -- ca#1 len#1 ... ca#n len#n n )
  depth >r
  begin  s" /" /sides 0=  until  2drop
  depth r> 2 - - 2/  ;
  \ Divide a slash separated values string.

: -prefix  ( ca1 len1 ca2 len2 -- ca1' len1' )
  dup >r 2over 2swap string-prefix? r> and /string  ;
  \ Remove a prefix _ca2 len2_ from a string _ca1 len1_.

: typecr ( ca len -- )  type cr  ;

: ?error-bye ( f ca len -- )
  rot if
    ['] typecr stderr outfile-execute 1 (bye)
  then  2drop  ;

\ ==============================================================
\ Card

false value flash-card?
  \ Flag: Create a Flash card instead of an EPROM card?
  \ Default is false.

$variable card-filename

: card-filename!  ( ca len -- )
  card-filename $!  ;

: card-base-filename    ( -- ca len )  s" output"  ;
: flash-card-extension  ( -- ca len )  s" .flash"  ;
: eprom-card-extension  ( -- ca len )  s" .epr"    ;

: default-eprom-card-filename  ( -- ca len )
  card-base-filename eprom-card-extension s+  ;
  \ Default filename for EPROM cards.

: default-flash-card-filename  ( -- ca len )
  card-base-filename flash-card-extension s+  ;
  \ Default filename for Flash cards.

: card-extension  ( -- ca len )
  flash-card? if    flash-card-extension
              else  eprom-card-extension  then  ;
  \ Default card filename extension for the current
  \ type of card.

: default-card-filename  ( -- ca len )
  card-base-filename card-extension s+  ;
  \ Default card filename for the current type of card.

: card-filename@  ( -- ca len )
  card-filename $@len if    card-filename $@
                      else  default-card-filename  then  ;
  \ If the card filename has been set by the command line
  \ option, return it; else return the default filename.

16 constant /filename
  \ Max length of OZ filenames.

: KiB  ( n1 -- n2 )  1024 *  ;
: KiB/  ( n1 -- n2 )  1024 /  ;

 16 KiB constant  16KiB
128 KiB constant 128KiB
512 KiB constant 512KiB

0 value card
  \ Address of the card space (0 if not allocated).

variable >card  0 >card !
  \ Pointer to the current free address in the card.

: string>card  ( ca len  -- )
  dup >r  >card @ swap move  r> >card +!  ;
  \ Add the string _ca len_ to the card;
  \ the length is not saved, only the contents.

: byte>card  ( b -- )
  >card @ c! 1 >card +!  ;
  \ Add _b_ to the card.

 32 KiB constant eprom-card-default-size
512 KiB constant flash-card-default-size

eprom-card-default-size value default-card-size
  \ Default size of the card in bytes.

0 value /card
  \ Size of the card in bytes.

0 value card-header
  \ Address of the card header
  \ (the header is at the end of the file).

64 constant /card-header
  \ Length of the card header in bytes
  \ (the header is at the end of the file).

\ Fields of the card header:
: card-header-1          ( -- ca )  card-header 55 +  ;
: card-header-random-id  ( -- ca )  card-header 56 +  ;
: card-header-size       ( -- ca )  card-header 60 +  ;
: card-header-subtype    ( -- ca )  card-header 61 +  ;
: card-header-oz-id      ( -- ca )  card-header 62 +  ;

: allocate-card  ( -- a )
  /card ?dup 0= if  default-card-size dup to /card  then
  allocate throw  ;
  \ Allocate memory for the card and return its address.

: erase-card  ( -- )
  card /card $FF fill  ;
  \ Erase the card, filling it with $FF.

: erase-card-header  ( -- )
  card-header /card-header erase  ;
  \ Erase the card header, filling it with zeroes.

: calculate-card-header  ( -- )
  card /card + /card-header - to card-header  ;
  \ Calculate the address of the card header.

: random-id  ( -- b1 b2 b3 b4 )
  4 0 do  256 random  loop  ;
  \ Return a card random id: four random bytes.

: store-card-random-id  ( -- )
  random-id card-header-random-id >r
  r@     c!
  r@ 1+  c!
  r@ 2 + c!
  r> 3 + c!  ;
  \ Store the card random id.

: store-card-banks  ( -- )
  /card 16KiB / card-header-size c!  ;
  \ Store the number of 16 KiB banks of the card.

: large-card?  ( -- f )
  /card [ 128KiB 1- ] literal >  ;
  \ Is the card 128 KiB or larger?

: store-card-subtype  ( -- )
  large-card?
  if  $7C  else  $7E  then  card-header-subtype c!  ;
  \ Store the card subtype, depending on its size.

: store-card-oz-id  ( -- )
  'o' card-header-oz-id    c!
  'z' card-header-oz-id 1+ c!  ;
  \ Store the OZ card identifier.

: init-card-header  ( -- )
  erase-card-header  1 card-header-1 c!
  store-card-random-id  store-card-banks
  store-card-subtype  store-card-oz-id  ;
  \ Init the card header, located at the end of the card.

: null-file  ( -- )
  1 byte>card 0 byte>card 0 byte>card
  0 byte>card 0 byte>card 0 byte>card  ;
  \ Create a "null" file, a file entry with a null filename
  \ and zero length.

: format-card  ( -- )
  erase-card init-card-header
  flash-card? if  null-file  then  ;

: create-card  ( -- )
  allocate-card  dup to card  >card !
  calculate-card-header  format-card  ;

: card-needed  ( -- )
  card ?exit create-card  ;
  \ Create a card, if not done yet.

: unused-card  ( -- n )
  card-header >card @ -  ;
  \ Unused space in the card, in bytes.

: save-card  ( -- )
  card /card card-filename@ unslurp-file  ;
  \ Save the card to a file.

: ?card-size-number  ( ca len -- )
  nip 0<> s" Wrong size: not a valid number." ?error-bye  ;
  \ Error if the card size number is wrong.
  \ _ca len_ is the string left by `>number`, and its
  \ length must be zero if the conversion was successful.

: ?card-size-pages  ( n -- )
  16 mod s" Wrong size: it must be a multiple of 16" ?error-bye  ;
  \ Error if the card size _n_ (in KiB) is not a multiple of 16.

: eprom-card-sizes  ( -- x0..xn n )
  32 128 256 3  ;
  \ Return the proper sizes (in Kib) for an EPROM card,
  \ and their count.

: flash-card-sizes  ( -- x0..xn n )
  512 1024  2  ;
  \ Return the proper sizes (in Kib) for a Intel Flash card,
  \ and their count.

: ?card-size-range  ( n -- )
  flash-card? if    flash-card-sizes
              else  eprom-card-sizes  then
  any? 0= s" Wrong size for the card type." ?error-bye  ;
  \ Error if the card size _n_ (in KiB) is not in the range
  \ allowed by the card type.

: check-card-size  ( d ca len -- n )
  ?card-size-number d>s dup ?card-size-pages  dup ?card-size-range  ;
  \ Check if the card size, specified by the `--size` option,
  \ is right.  _d ca len_ are the result of `>number`.
  \ If no error is found, return the size _n_ (in KiB).

: ?no-card-yet  ( -- )
  card s" Invalid option: the card is already created." ?error-bye  ;
  \ Error if the card is already created.

: set-card-size  ( ca len -- )
  ?no-card-yet
  0. 2swap >number check-card-size KiB to /card  ;
  \ Set the card size in KiB, as found in the string _ca len_.

: flash-card  ( -- )
  ?no-card-yet
  true to flash-card?
  flash-card-default-size to default-card-size  ;
  \ Create a Flash card instead of an EPROM.

\ ==============================================================
\ Input files

2variable filename
  \ Address and length of the current input file name.

2variable file-contents
  \ Address and length of the contents of the current input
  \ file.

: get-file  ( ca len -- )
  slurp-file file-contents 2!  ;
  \ Get the contents of input file _ca len_ and store it.

: file-length  ( -- len )
  file-contents @  ;
  \ Length of the current input file.

: free-file  ( -- )
  file-contents 2@ drop free throw  ;
  \ Free the allocated space of the the current input file.

variable files  \ counter

\ ==============================================================
\ Copying a file

: full-card?  ( -- f )
  unused-card file-length <  ;
  \ Is the card full?

: ?space-left  ( -- )
  full-card? s" No space left in the card." ?error-bye  ;
  \ Error if there's no space left in the card.

: valid-char?  ( c -- )
  >r  r@ chr-alnum?
      r@ '-' = or
      r@ '.' = or
      r> chr-ascii? and  ;
  \ Is _c_ a valid filename char?

: ?valid-char  ( c -- )
  dup >r valid-char? 0=
  s" Invalid filename character '" r> c>str s+ s" '." s+ ?error-bye  ;
  \ Error if _c_ is not a valid char.

: ?segment-chars  ( ca len -- )
  bounds ?do  i c@ ?valid-char  loop  ;
  \ Error if any filename char in invalid.

: ?segment-length  ( ca len -- )
  nip /filename > s" Segment too long." ?error-bye  ;
  \ Error if filename length is too long.

: ?segment-dot  ( ca len -- +n | -1 )
  -1 -rot  over swap  ( -1 ca ca len )
  bounds ?do
    i c@ '.' =
    if  over -1 > s" More than one dot in the filename." ?error-bye
        nip i swap - dup  ( +n +n )  then
  loop  drop  ;
  \ Error if filename contains two or more dots.
  \ Return the position _+n_ of the dot (0..len-1), or -1 if
  \ there's no dot.

: ?segment-extension  ( len n )
  - 1- dup 3 > s" Segment extension is too long." ?error-bye
            0= s" Segment extension is empty." ?error-bye  ;
  \ Error if the filename extension is too long or empty; _len_
  \ is the length of the filename and _n_ is the position of the
  \ dot (0...len-1).

: ?segment-without-extension  ( len n -- )
  nip dup 12 > s" Segment without extension is too long." ?error-bye
            0= s" Segment without extension is empty." ?error-bye  ;
  \ Error if the filename without the extension is too long or
  \ empty.  _len_ is the length of the filename and _n_ is the
  \ position of the dot (0...len-1).

: ?segment-format  ( ca len n -- )
  rot drop  dup -1 = if  2drop exit  then  \ exit if no extension
  ( len n ) 2dup ?segment-extension
  ?segment-without-extension  ;
  \ Error if the filename format is not "12.3".
  \ The filename length is supposed to be under 17.
  \ _n_ is the position of the dot (0...len-1); or -1
  \ if there's no dot.

: ?segment  ( ca len -- )
  2dup ?segment-length
  2dup ?segment-chars
  2dup ?segment-dot
       ?segment-format  ;
  \ Error if the segment _ca len_ is invalid.
  \ A segment is each part of a explicit filename divided
  \ by slashes.

: ?filename  ( ca len -- )
  /slash 0 ?do  ?segment  loop  ;
  \ Error if the filename _ca len_ is invalid.

: check-file  ( ca len -- )
  ?filename ?space-left  ;

: /filename  ( -- len )
  filename @  ;
  \ Length of the current input file name.

: filename>card  ( -- )
  /filename 1+ byte>card  '/' byte>card
  filename 2@ string>card  ;
  \ Copy the input file name.

: file-length>card  ( -- )
  file-length dup dup dup
                        256 mod byte>card
                          256 / byte>card
        [ 256 256 * ] literal / byte>card
  [ 256 256 256 * * ] literal / byte>card  ;
  \ Store the length of the current input file on the card;
  \ least significant byte first.

: file-contents>card  ( -- )
  file-contents 2@ string>card  ;
  \ Store the contents of the current input file on the card.

: current-file>card  ( -- )
  filename>card file-length>card  file-contents>card  ;
  \ Store the current input file on the card.

true value verbose?
  \ List the processed input files?

: echo  ( ca len -- )
  verbose? if  type cr  else  2drop  then  ;
  \ Print the string _ca len_, if verbose mode is on,
  \ else discard it.

: adjust-path  ( ca len -- ca' len' )
  s" ./" -prefix  ;
  \ Remove the "./" prefix from filename _ca len_, if present.

: ?file-exists  ( ca len -- )
  2dup file-status s" No such file: " 2rot s+ ?error-bye drop  ;
  \ Error if file _ca len_ does not exist.

: file>card  ( ca len -- )
  2dup ?file-exists
  1 files +!  card-needed
  adjust-path  2dup filename 2!
  2dup get-file  2dup echo
  check-file current-file>card free-file  ;
  \ Copy file _ca len_ to the card, if possible.

\ ==============================================================
\ Argument parser

: KiBs+  ( ca len n -- ca' len' )
  KiB/ n>str s+ s"  KiB" s+  ;
  \ Concatenate the value of _n_ bytes in KiB, including the
  \ unit, to the string _ca len_, giving the result string _ca'
  \ len'_.

\ Program data:
s" mkepr"                              \ name
s" [options] [files]"                  \ usage
version                                \ version
s" Report bugs via programandala.net"  \ extra info
arg-new value mkepr-arguments

\ Add the default help and version options:
mkepr-arguments arg-add-help-option
mkepr-arguments arg-add-version-option

\ Add the -f/--flash option switch:
'f'                                   \ short option
s" flash"                             \ long option
s" create an Intel Flash card instead of an EPROM card"
                                      \ description
true                                  \ a switch
4 dup constant arg.flash-option       \ option id
mkepr-arguments arg-add-option

\ Add the -o/--output option parameter:
'o'                                   \ short option
s" output=FILE"                       \ long option
s" set output file; default: "
  default-eprom-card-filename s+ s"  (or " s+
  default-flash-card-filename s+ s" )" s+

                                      \ description
false                                 \ a parameter
5 dup constant arg.output-option      \ option id
mkepr-arguments arg-add-option

\ Add the -s/--size option parameter:
's'                                   \ short option
s" size=KiB"                          \ long option
s" set the card size; defaults: "
  eprom-card-default-size KiBs+ s"  (EPROM), " s+
  flash-card-default-size KiBs+ s"  (Flash)" s+
                                      \ description
false                                 \ a parameter
6 dup constant arg.size-option        \ option id
mkepr-arguments arg-add-option

\ Add the -q/--quiet option switch:
'q'                                   \ short option
s" quiet"                             \ long option
s" quiet mode: input files will not be listed"  \ description
true                                  \ a switch
7 dup constant arg.quiet-option       \ option id
mkepr-arguments arg-add-option

: show-help  ( -- )
  mkepr-arguments arg-print-help bye  ;

: show-version  ( -- )
  mkepr-arguments arg-print-version  ;

: be-quiet  ( -- )
  false to verbose?  ;
  \ Deactivate the verbose mode.

: option? ( -- ca len n f | n f )
  mkepr-arguments arg-parse  ( ca len n | n )
  dup arg.done <> over arg.error <> and  ;
  \ Parse the next command line option. Return its value _ca
  \ len_, if any; and its number _n_; _f_ is true when the
  \ option is valid.

: option  ( ca len n | n -- )
  case
    arg.non-option      of  file>card       endof
    arg.output-option   of  card-filename!  endof
    arg.size-option     of  set-card-size   endof
    arg.flash-option    of  flash-card      endof
    arg.quiet-option    of  be-quiet        endof
    arg.help-option     of  show-help       endof
    arg.version-option  of  show-version    endof
  endcase  ;
  \ Manage command line option _n_ and its value _ca len_.

: parse-options  ( -- )
  begin  option?  while  option  repeat  ;
  \ Parse and manage all command line options.

\ ==============================================================
\ Boot

' noop is dobacktrace
  \ Don't show the return stack backtrace after an error.

: mkepr  ( -- )
  files off  parse-options
  files @ if  save-card  else  show-help  then  ;

mkepr bye

\ ==============================================================
\ History

\ 2015-12-05: Start. Documentation on the File Card format.
\
\ 2015-12-08: Version 0.0.0. Main structure.
\
\ 2015-12-09: Version 0.0.1. First working version.
\
\ 2015-12-10: Version 0.1.0. New option `--flash` to create
\ Intel Flash cards instead of EPROM cards.
\
\ 2015-12-11: Version 0.2.0. Filenames are checked.
\
\ 2015-12-11: Version 0.3.1.  - Added card size check depending
\ on the card type.  - Fixed the format of file length (only
\ files larger than 16 MiB were affected).  - Fixed the default
\ size of Flash cards.  - Removed the check of maximum file
\ length.  - Improved the help.
\
\ 2015-12-15: Version 0.3.2. Added the explanation about the
\ "null" file required by Intel Flash cards and renamed one word
\ accordingly.
\
\ 2015-12-16: Version 0.4.0. Added support for directories.  No
\ backtrace shown on errors.
\
\ 2015-12-17: Version 0.4.1. No internal information shown on
\ errors. Missing files are detected, right at the start.
\ Improved error on invalid characters. Fixed and improved
\ installation instructions.

\ vim: tw=64

Deŝuto

Ankaŭ: mkepr en GitHub.