gforth/dumpimage.fs - diff

Return to dumpimage.fs CVS log

Up to [gforth] / gforth

-version 1.3, 1995/07/25 15:28:06
+version 1.4, 1995/10/11 19:39:33
  Line 4  Create magic  s" gforth00" here over all
  '1 1 cells + 0 pad ! -1 pad c! pad @ 0< +  magic 7 chars + c!
- : dump-fi ( addr u -- )  w/o bin create-file throw >r
+ : save-string-dict { addr1 u -- addr2 u }
-   magic 8 r@ write-file throw
+     here { addr2 }
-   forthstart here over - dup forthstart cell+ !
+     u allot
+     addr1 addr2 u move
+     addr2 u ;
+ : update-image-included-files ( -- )
+     included-files 2@ { addr cnt }
+     image-included-files 2@ { old-addr old-cnt }
+     align here { new-addr }
+     cnt 2* cells allot
+     new-addr cnt image-included-files 2!
+     old-addr new-addr old-cnt 2* cells move
+     cnt old-cnt
+     U+DO
+         addr i 2* cells + 2@ save-string-dict
+         new-addr i 2* cells + 2!
+     LOOP ;
+ : dump-fi ( addr u -- )
+     w/o bin create-file throw >r
+     magic 8 r@ write-file throw
+     update-image-included-files
+     forthstart here over - dup forthstart cell+ !
                           r@ write-file throw
  \  relinfo here forthstart - 1- 8 cells / 1+ r@ write-file throw
    r> close-file throw ;
- : savesystem ( "name" -- )  name dump-fi ;
+ : savesystem ( "name" -- ) \ gforth
+     name dump-fi ;