From 101065e74f8e7f6c9e29b193dee288cf60fad848 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 31 Jul 2008 21:37:39 -0700
Subject: [PATCH] Executable images
---
core/bootstrap/primitives.factor | 1 +
core/memory/memory-docs.factor | 5 +++
core/memory/memory.factor | 4 ++
vm/factor.c | 13 ++----
vm/factor.h | 3 --
vm/image.c | 75 ++++++++++++++++++++++++++------
vm/image.h | 9 +++-
vm/primitives.c | 1 +
8 files changed, 85 insertions(+), 26 deletions(-)
diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index 5d7d5e0d2c..24c1da41de 100755
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -532,6 +532,7 @@ tuple
{ "dll-valid?" "alien" }
{ "unimplemented" "kernel.private" }
{ "gc-reset" "memory" }
+ { "(save-image*)" "memory" }
}
[ >r first2 r> make-primitive ] each-index
diff --git a/core/memory/memory-docs.factor b/core/memory/memory-docs.factor
index 1213245863..b8aabd10cf 100755
--- a/core/memory/memory-docs.factor
+++ b/core/memory/memory-docs.factor
@@ -5,6 +5,7 @@ ARTICLE: "images" "Images"
"The current image can be saved; the image contains a complete dump of all data and code in the current Factor instance:"
{ $subsection save }
{ $subsection save-image }
+{ $subsection save-image* }
{ $subsection save-image-and-exit }
"To start Factor with a custom image, use the " { $snippet "-i=" { $emphasis "image" } } " command line switch; see " { $link "runtime-cli-args" } "."
{ $see-also "tools.memory" } ;
@@ -56,6 +57,10 @@ HELP: save-image ( path -- )
{ $values { "path" "a pathname string" } }
{ $description "Saves a snapshot of the heap to the given file, overwriting the file if it already exists." } ;
+HELP: save-image* ( path arguments -- )
+{ $values { "path" "a pathname string" } { "arguments" "a commandline string" } }
+{ $description "Saves a snapshot of the heap to the given file, overwriting the file if it already exists. The image is formatted so that Unix systems can execute the image directly using the shellscript #! syntax. The saved image will start the current VM with the given commandline arguments when executed." } ;
+
HELP: save-image-and-exit ( path -- )
{ $values { "path" "a pathname string" } }
{ $description "Saves a snapshot of the heap to the given file, overwriting the file if it already exists. This word compacts the code heap and immediately exits Factor, since the Factor VM cannot continue executing after compiled code blocks have been moved around." } ;
diff --git a/core/memory/memory.factor b/core/memory/memory.factor
index cb5c5bf7e4..2a702097f4 100644
--- a/core/memory/memory.factor
+++ b/core/memory/memory.factor
@@ -13,3 +13,7 @@ IN: memory
pusher [ each-object ] dip >array ; inline
: save ( -- ) image save-image ;
+
+: save-image* ( path args -- )
+ "#!" vm append swap "-shebang\n" 3array " " join
+ (save-image*) ; inline
diff --git a/vm/factor.c b/vm/factor.c
index e81152bd99..8bdf67ec18 100755
--- a/vm/factor.c
+++ b/vm/factor.c
@@ -140,13 +140,8 @@ void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded
CELL i;
- posix_argc = argc;
- posix_argv = safe_malloc(argc * sizeof(F_CHAR*));
- posix_argv[0] = safe_strdup(argv[0]);
-
for(i = 1; i < argc; i++)
{
- posix_argv[i] = safe_strdup(argv[i]);
if(factor_arg(argv[i],STR_FORMAT("-datastack=%d"),&p.ds_size));
else if(factor_arg(argv[i],STR_FORMAT("-retainstack=%d"),&p.rs_size));
else if(factor_arg(argv[i],STR_FORMAT("-generations=%d"),&p.gen_count));
@@ -160,6 +155,10 @@ void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded
p.fep = true;
else if(STRNCMP(argv[i],STR_FORMAT("-i="),3) == 0)
p.image = argv[i] + 3;
+ else if(STRCMP(argv[i],STR_FORMAT("-shebang")) == 0 && i < argc)
+ {
+ p.image = argv[--argc];
+ }
else if(STRCMP(argv[i],STR_FORMAT("-console")) == 0)
p.console = true;
else if(STRCMP(argv[i],STR_FORMAT("-no-stack-traces")) == 0)
@@ -194,10 +193,6 @@ void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded
c_to_factor_toplevel(userenv[BOOT_ENV]);
unnest_stacks();
-
- for(i = 0; i < argc; i++)
- free(posix_argv[i]);
- free(posix_argv);
}
char *factor_eval_string(char *string)
diff --git a/vm/factor.h b/vm/factor.h
index a0632c3138..3117e054d3 100644
--- a/vm/factor.h
+++ b/vm/factor.h
@@ -1,6 +1,3 @@
-int posix_argc;
-F_CHAR **posix_argv;
-
DLLEXPORT void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded);
DLLEXPORT char *factor_eval_string(char *string);
DLLEXPORT void factor_eval_free(char *result);
diff --git a/vm/image.c b/vm/image.c
index a0fa48d504..d6436573b4 100755
--- a/vm/image.c
+++ b/vm/image.c
@@ -80,6 +80,12 @@ void load_image(F_PARAMETERS *p)
F_HEADER h;
fread(&h,sizeof(F_HEADER),1,file);
+ if(h.magic_bytes[0] == '#' && h.magic_bytes[1] == '!')
+ {
+ fseek(file,IMAGE_SHEBANG_BLOCK_SIZE,SEEK_SET);
+ fread(&h,sizeof(F_HEADER),1,file);
+ }
+
if(h.magic != IMAGE_MAGIC)
fatal_error("Bad image: magic number check failed",h.magic);
@@ -101,21 +107,10 @@ void load_image(F_PARAMETERS *p)
}
/* Save the current image to disk */
-bool save_image(const F_CHAR *filename)
+static bool save_image_to_file(FILE *file)
{
- FILE* file;
- F_HEADER h;
-
- FPRINTF(stderr,"*** Saving %s...\n",filename);
-
- file = OPEN_WRITE(filename);
- if(file == NULL)
- {
- fprintf(stderr,"Cannot open image file: %s\n",strerror(errno));
- return false;
- }
-
F_ZONE *tenured = &data_heap->generations[TENURED];
+ F_HEADER h;
h.magic = IMAGE_MAGIC;
h.version = IMAGE_VERSION;
@@ -161,6 +156,49 @@ bool save_image(const F_CHAR *filename)
return true;
}
+bool save_image(const F_CHAR *filename)
+{
+ FILE* file;
+
+ FPRINTF(stderr,"*** Saving %s...\n",filename);
+
+ file = OPEN_WRITE(filename);
+ if(file == NULL)
+ {
+ fprintf(stderr,"Cannot open image file: %s\n",strerror(errno));
+ return false;
+ }
+
+
+ return save_image_to_file(file);
+}
+
+bool save_image_shebang(const F_CHAR *filename, const char *shebang)
+{
+ FILE* file;
+
+ FPRINTF(stderr,"*** Saving %s...\n",filename);
+
+ file = OPEN_WRITE(filename);
+ if(file == NULL)
+ {
+ fprintf(stderr,"Cannot open image file: %s\n",strerror(errno));
+ return false;
+ }
+
+ unsigned char shebang_block[IMAGE_SHEBANG_BLOCK_SIZE];
+ strncpy(shebang_block,shebang,IMAGE_SHEBANG_BLOCK_SIZE-1);
+ shebang_block[IMAGE_SHEBANG_BLOCK_SIZE-1] = 0;
+
+ if(fwrite(shebang_block,IMAGE_SHEBANG_BLOCK_SIZE,1,file) != 1)
+ {
+ fprintf(stderr,"Save #! block failed: %s\n",strerror(errno));
+ return false;
+ }
+
+ return save_image_to_file(file);
+}
+
DEFINE_PRIMITIVE(save_image)
{
/* do a full GC to push everything into tenured space */
@@ -169,6 +207,17 @@ DEFINE_PRIMITIVE(save_image)
save_image(unbox_native_string());
}
+DEFINE_PRIMITIVE(save_image_shebang)
+{
+ /* do a full GC to push everything into tenured space */
+ gc();
+
+ char *shebang = unbox_char_string();
+ F_CHAR *path = unbox_native_string();
+
+ save_image_shebang(path, shebang);
+}
+
DEFINE_PRIMITIVE(save_image_and_exit)
{
F_CHAR *path = unbox_native_string();
diff --git a/vm/image.h b/vm/image.h
index 9e582fc6c6..8393f73a6c 100755
--- a/vm/image.h
+++ b/vm/image.h
@@ -1,8 +1,13 @@
#define IMAGE_MAGIC 0x0f0e0d0c
#define IMAGE_VERSION 4
+#define IMAGE_SHEBANG_BLOCK_SIZE 512
+
typedef struct {
- CELL magic;
+ union {
+ CELL magic;
+ char magic_bytes[sizeof(CELL)];
+ };
CELL version;
/* all pointers in the image file are relocated from
relocation_base to here when the image is loaded */
@@ -39,8 +44,10 @@ typedef struct {
void load_image(F_PARAMETERS *p);
void init_objects(F_HEADER *h);
bool save_image(const F_CHAR *file);
+bool save_image_shebang(const F_CHAR *file, const char *shebang);
DECLARE_PRIMITIVE(save_image);
+DECLARE_PRIMITIVE(save_image_shebang);
DECLARE_PRIMITIVE(save_image_and_exit);
/* relocation base of currently loaded image's data heap */
diff --git a/vm/primitives.c b/vm/primitives.c
index b5d9403342..91f6eea0e4 100755
--- a/vm/primitives.c
+++ b/vm/primitives.c
@@ -149,4 +149,5 @@ void *primitives[] = {
primitive_dll_validp,
primitive_unimplemented,
primitive_gc_reset,
+ primitive_save_image_shebang,
};