level0/urforth0_w_save.asm

   1 ;; Native x86 GNU/Linux Forth System, Direct Threaded Code
   2 ;;
   3 ;; Copyright (C) 2020 Ketmar Dark // Invisible Vector
   4 ;;
   5 ;; This program is free software: you can redistribute it and/or modify
   6 ;; it under the terms of the GNU General Public License as published by
   7 ;; the Free Software Foundation, version 3 of the License ONLY.
   8 ;;
   9 ;; This program is distributed in the hope that it will be useful,
  10 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 ;; GNU General Public License for more details.
  13 ;;
  14 ;; You should have received a copy of the GNU General Public License
  15 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16
  17
  18 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  19 ;; save current image to ELF executable file
  20 ;; we're using the fact that our ELF header is loaded into memory, and is writeable
  21 ;; metacompiler will prolly need to rebuild it from scratch, but for now... meh
  22 urword_forth "(SAVE)",par_save
  23 urword_hidden
  24 ;; ( fd -- successflag )
  25   ;; just in case, check fd
  26   UF dup 0less
  27   ur_if
  28     UF drop 0 exit
  29   ur_endif
  30   ;; move fd to return stack
  31   UF rpush
  32   ;; fix code segment size
  33   ;; write code from code start to real HERE
  34   UF real_here par_code_base_addr - dup par_code_base_addr 0x84 + !
  35   UF drop  ;; do not fix virtual size
  36   ;; par_code_base_addr 0x88 + !
  37   ;; everything in our header is ok now, including entry point (it isn't changed)
  38   ;; write everything up until import table
  39   UF par_code_base_addr elfhead_size rpeek par_fwrite
  40   UF elfhead_size equal
  41   ur_ifnot
  42     UF rdrop 0 exit
  43   ur_endif
  44   ;; write zero bytes for imports: this is where import addresses will be put by ld.so
  45   ;; use HERE for this
  46   UF real_here par_code_imports_size erase
  47   UF real_here par_code_imports_size rpeek par_fwrite
  48   UF par_code_imports_size equal
  49   ur_ifnot
  50     UF rdrop 0 exit
  51   ur_endif
  52   ;; setup some variables first, so the new image will process CLI args
  53   ;; don't bother moving old values to "safe place", data stack is good enough
  54   UF arg_next
  55   UF process_cli @
  56   UF 1
  57   urto arg_next
  58   UF 1 process_cli !
  59   ;; write code from imports start to real here
  60   UF par_code_imports_end_addr real_here par_code_imports_end_addr - rpeek par_fwrite
  61   ;; restore variables, just in case (TOS is write result)
  62   UF rpush  ;; move write result to the safe place
  63   UF process_cli !
  64   urto arg_next
  65   UF rpop   ;; restore write result
  66   ur_ifnot
  67     UF rdrop 0 exit
  68   ur_endif
  69   ;; you may not believe me, but we're done!
  70   UF rdrop    ;; got rid of fd
  71   UF 1        ;; exit with success
  72 urword_end
  73
  74
  75 urword_forth "SAVE",save
  76 ;; ( addr count -- successflag )
  77   ;; create output file
  78   UF o_wronly o_creat or o_trunc or  ;; flags
  79   UF s_irwxu s_irgrp or s_ixgrp or s_iroth or s_ixoth or  ;; mode
  80   UF par_fopen
  81   ;; check success
  82   UF dup 0less
  83   ur_if
  84     UF drop 0 exit
  85   ur_endif
  86   UF dup par_save
  87   ;; ( fd successflag )
  88   UF swap par_fclose 0equal
  89   UF land
  90 urword_end