File:  [gforth] / gforth / Attic / dumpimage.fs
Revision 1.4: download - view: text, annotated - select for diffs
Wed Oct 11 19:39:33 1995 UTC (25 years, 9 months ago) by anton
Branches: MAIN
CVS tags: HEAD
Now gforth.fi is a nonrelocatable image containing all of startup.fs etc.
savesystem now saves `included-files', too (so require does not start from
 scratch)
added/fixed stack effect and wordset documentation for many words in kernal.fs
some reformatting in kernal.fs
fixed some wordset info in primitives
added strsignal

    1: \ image dump                                           15nov94py
    2: 
    3: Create magic  s" gforth00" here over allot swap move
    4: 
    5: '1 1 cells + 0 pad ! -1 pad c! pad @ 0< +  magic 7 chars + c!
    6: 
    7: : save-string-dict { addr1 u -- addr2 u }
    8:     here { addr2 }
    9:     u allot
   10:     addr1 addr2 u move
   11:     addr2 u ;
   12: 
   13: : update-image-included-files ( -- )
   14:     included-files 2@ { addr cnt }
   15:     image-included-files 2@ { old-addr old-cnt }
   16:     align here { new-addr }
   17:     cnt 2* cells allot
   18:     new-addr cnt image-included-files 2!
   19:     old-addr new-addr old-cnt 2* cells move
   20:     cnt old-cnt
   21:     U+DO
   22:         addr i 2* cells + 2@ save-string-dict
   23: 	new-addr i 2* cells + 2!
   24:     LOOP ;
   25: 
   26: : dump-fi ( addr u -- )
   27:     w/o bin create-file throw >r
   28:     magic 8 r@ write-file throw
   29:     update-image-included-files
   30:     forthstart here over - dup forthstart cell+ !
   31:                          r@ write-file throw
   32: \  relinfo here forthstart - 1- 8 cells / 1+ r@ write-file throw
   33:   r> close-file throw ;
   34: 
   35: : savesystem ( "name" -- ) \ gforth
   36:     name dump-fi ;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>