urflibs/urasm/writers/raw.f

   1 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; and now for something completely different...
   3 ;; UrForth/C Forth Engine!
   4 ;; Copyright (C) 2023 Ketmar Dark // Invisible Vector
   5 ;; GPLv3 ONLY
   6 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   7 ;; RAW chunks writer
   8 ;; trashes PAD
   9 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10
  11
  12 : (write-raw-chunk)  ( staddr fh -- )
  13   >r asm-emit:find-used if
  14     dup asm-emit:find-unused " wtf?!" ?not-error  ( staddr endaddr )
  15     2dup swap -  ( staddr endaddr len )
  16     rot asm-emit:zx-mem + swap r@ files:write " error writing raw chunk" ?not-error
  17     drop
  18   endif rdrop
  19 ;
  20
  21
  22 ;; pass base file name with extension
  23 : write-raw  ( addr count -- )
  24   string:>pad
  25   string:pad-remove-ext string:pad-len@ >r  ( | base-name-len )
  26   0 begin asm-emit:find-used while
  27     r@ string:pad-len!  ;; restore base name length
  28     base @ hex over <# # # # # [char] _ hold #> string:pad+cc base !
  29     " .bin" string:pad+cc
  30     ." OUTPUT: " string:pad-cc@ xtype cr
  31     string:pad-cc@ files:create ifnot
  32       ." cannot create file '" pad count xtype ." '" cr
  33       " file writing error" error
  34     endif
  35     2dup (write-raw-chunk) files:close drop
  36     asm-emit:find-unused
  37   not-until rdrop
  38 ;