
\ Save a copy of the current Forth core with all contents of the user flash

\ -----------------------------------------------------------------------------
\ Write file via syscall interface                      uh 2015-09-26

\ ( a0 a1 a2 a3 Syscall# -- result )

56 constant #openat

8 base !
00444 constant S_IRUSR
00222 constant S_IWUSR
00111 constant S_IXUSR

00001 constant O_WRONLY
00002 constant O_RDWR
00100 constant O_CREAT
01000 constant O_TRUNC

decimal

-100 constant AT_FDCWD

: 0terminate ( addr len -- ) + 0 swap c! ;

: syscall-creat ( addr len mode -- fd )
  >r
  dup >r here swap move here r> 0terminate here

  AT_FDCWD                      \ Directory File Descriptor
  swap                           \ 0-terminated string for filename
  O_CREAT O_WRONLY O_TRUNC or or  \ OFLAG
  r>                               \ Mode

  #openat syscall
;

\ ssize_t write(int fd, const void *buf, size_t count);
64 constant #write
: syscall-write ( adr len fd -- len' )  -rot 0 #write syscall ;

\ int close(int fd)
57 constant #close
: syscall-close ( fd -- ior ) 0 0 0 #close syscall ;

0 variable logfile

: open-log ( addr len -- )
   S_IRUSR S_IWUSR or syscall-creat  logfile ! ;

: open-log-executable ( addr len -- )
   S_IRUSR S_IWUSR or S_IXUSR or syscall-creat  logfile ! ;

: write-log ( addr len -- )
   logfile @ syscall-write drop ;

: close-log ( -- )  logfile @ syscall-close drop ;

\ -----------------------------------------------------------------------------

0 variable writebuffer

:  log, ( x -- ) writebuffer ! writebuffer 8 write-log ;
: wlog, ( x -- ) writebuffer ! writebuffer 4 write-log ;
: hlog, ( x -- ) writebuffer ! writebuffer 2 write-log ;
: clog, ( x -- ) writebuffer ! writebuffer 1 write-log ;

\ -----------------------------------------------------------------------------

: save ( addr len -- ) \ Save a copy of the whole Forth core with flash dictionary contents
                        \ With many thanks to Robert Clausecker
  open-log-executable
  compiletoram? compiletoflash

    \ ELF-Header
    \ http://www.sco.com/developers/gabi/latest/ch4.eheader.html

    $7F clog, [char] E clog, [char] L clog, [char] F clog,  \ Magische Zahl
    2 clog,                    \ ELF-Klasse: 32 Bit
    1 clog,                    \ Byte-Reihenfolge: little endian
    1 clog,                    \ ELF-Version: 1
    0 clog,                    \ ABI: GNU Linux
    0 clog,                    \ ABI-Version: 0
    0 clog, 0 clog, 0 clog, 0 clog,
    0 clog, 0 clog, 0 clog,    \ Padding Bytes, um auf 8-gerade zu kommen

    2 hlog,                    \ ELF-Typ: ausführbare Datei
    $F3 hlog,                  \ Architektur: 80386 (für ARM: 40 für MIPS: 8 für RISC-V: $F3)
    1 wlog,                    \ ELF-Version: 1 (nochmal)
    $10000             log,    \ Einsprungpunkt
    64                 log,    \ Anfang des Programm-Headers in der Datei
    0                  log,    \ Anfang des Section-Headers (haben wir nicht)
    1  wlog,                   \ Flags: RVC
    64 hlog,                   \ Größe des ELF-Headers: 64 Bytes
    56 hlog,                   \ Größe eines Programm-Headers: 56 Bytes
    1  hlog,                   \ Anzahl der Programm-Header: 1
    64 hlog,                   \ Größe eines Sektions-Headers: 64 Bytes
    0  hlog,                   \ Anzahl der Sektions-Header: 0 (keine)
    0  hlog,                   \ Offset der Sektions-String-Tafel (keine)

    \ Program header, beginnt bei Offset 0x40 in der Datei

    1         wlog,            \ Segment-Typ: LOAD
    7         wlog,            \ Flags: RWX (lesen, schreiben, ausführen)

    $1000          log,        \ Adresse, zu der der Header geladen wird
    $10000         log,        \ physikalische Adresse (egal)
    $10000         log,        \ VirtAddr
    here $10000 -  log,        \ Länge des Segmentes in der Datei
    $00210000      log,        \ Länge des Segmentes im Speicher
    4096           log,        \ Alignment

  4096 64 - 56 - 0 do 0 wlog, 4 +loop \ Align on 4096
  $10000 here $10000 - write-log      \ Write a copy of the Forth core and the flash dictionary content
  close-log

  if compiletoram then
;

: save" ( -- ) [char] " parse save ;

\ -----------------------------------------------------------------------------

