home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / program / 18 / forthsup / bundle.fth < prev    next >
Encoding:
Text File  |  1986-09-18  |  1.2 KB  |  44 lines
  1. \ Bundle - create a "Forth Archive" file that contains several other files.
  2. \ The Forth Archive file may be later processed so that the other files
  3. \ are recreated.  The archive file itself contains the Forth program used
  4. \ to unbundle, so the unbundling is achieved simply by loading the archive
  5. \ file.
  6. \
  7. \ Usage:
  8. \
  9. \ bundling archive-filename    \ Start a new Forth archive file called
  10. \                \ "archive-filename". Suggested extension: .FAR
  11. \ adding filename        \ Add a file to the archive
  12. \ end-bundle            \ Close the archive file
  13.  
  14. variable bundle-buf
  15. decimal
  16. : append-file ( -- )
  17.    begin
  18.         bundle-buf @  4096  ifd @   fgets  ( #bytes-read)
  19.         dup 0>
  20.    while
  21.         bundle-buf @  swap  ofd @  fputs
  22.    repeat
  23. ;
  24. : adding  \ filename ( -- )
  25.    [compile] ""
  26.    dup        ( name name)
  27.    read-open  ( name)
  28.    " extract " ofd @ fputs   count ofd @ fputs   newline ofd @ fputc
  29.    append-file
  30.    ascii `  ofd @ fputc   newline ofd @ fputc
  31.    ifd @ close
  32. ;
  33. : bundling  \ archive-filename  ( -- )
  34.    writing
  35.    [""] extract.fth  read-open
  36.    append-file
  37.    ifd @ close
  38.    4096 alloc-mem  bundle-buf !        \ Grab some memory
  39. ;
  40. : end-bundle ( -- )
  41.    ofd @ close
  42.    bundle-buf @  4096  free-mem        \ Give back the memory
  43. ;
  44.