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  ( addr )
  27     asm-emit:find-used
  28   while
  29     r@ string:pad-len!  ;; restore base name length
  30     base @ hex over <# # # # # [char] _ hold #> string:pad+cc base !
  31     " .bin" string:pad+cc
  32     pad count files:create ifnot
  33       ." cannot create file '" pad count xtype ." '" cr
  34       " file writing error" error
  35     endif
  36     2dup (write-raw-chunk) files:close drop
  37     asm-emit:find-unused
  38   not-until rdrop
  39 ;