: compress-wrappers ( -- )
[ wrapper? ] [ ] "wrappers" compress ;
-: finish-deploy ( final-image -- )
- "Finishing up" show
- V{ } set-namestack
- V{ } set-catchstack
- "Saving final image" show
- save-image-and-exit ;
-
SYMBOL: deploy-vocab
: [:c] ( -- word ) ":c" "debugger" lookup ;
"Vocabulary has no MAIN: word." print flush 1 exit
] unless
strip
- finish-deploy
+ "Saving final image" show
+ save-image-and-exit
] deploy-error-handler
] bind ;
normalize-path native-string>alien (save-image) ;
: save-image-and-exit ( path -- )
- normalize-path native-string>alien (save-image) ;
+ normalize-path native-string>alien (save-image-and-exit) ;
: save ( -- ) image save-image ;
userenv[CPU_ENV] = allot_alien(F,(cell)FACTOR_CPU_STRING);
userenv[OS_ENV] = allot_alien(F,(cell)FACTOR_OS_STRING);
- userenv[cell_SIZE_ENV] = tag_fixnum(sizeof(cell));
+ userenv[CELL_SIZE_ENV] = tag_fixnum(sizeof(cell));
userenv[EXECUTABLE_ENV] = allot_alien(F,(cell)p->executable_path);
userenv[ARGS_ENV] = F;
userenv[EMBEDDED_ENV] = F;
h.bignum_pos_one = bignum_pos_one;
h.bignum_neg_one = bignum_neg_one;
- cell i;
- for(i = 0; i < USER_ENV; i++)
- {
- if(i < FIRST_SAVE_ENV)
- h.userenv[i] = F;
- else
- h.userenv[i] = userenv[i];
- }
+ for(cell i = 0; i < USER_ENV; i++)
+ h.userenv[i] = (save_env_p(i) ? userenv[i] : F);
bool ok = true;
path.untag_check();
/* strip out userenv data which is set on startup anyway */
- cell i;
- for(i = 0; i < FIRST_SAVE_ENV; i++)
- userenv[i] = F;
-
- for(i = LAST_SAVE_ENV + 1; i < STACK_TRACES_ENV; i++)
- userenv[i] = F;
+ for(cell i = 0; i < USER_ENV; i++)
+ {
+ if(!save_env_p(i)) userenv[i] = F;
+ }
/* do a full GC + code heap compaction */
performing_compaction = true;
BREAK_ENV = 5, /* quotation called by throw primitive */
ERROR_ENV, /* a marker consed onto kernel errors */
- cell_SIZE_ENV = 7, /* sizeof(cell) */
+ CELL_SIZE_ENV = 7, /* sizeof(cell) */
CPU_ENV, /* CPU architecture */
OS_ENV, /* operating system name */
#define FIRST_SAVE_ENV BOOT_ENV
#define LAST_SAVE_ENV STAGE2_ENV
+inline static bool save_env_p(cell i)
+{
+ return (i >= FIRST_SAVE_ENV && i <= LAST_SAVE_ENV) || i == STACK_TRACES_ENV;
+}
+
/* Canonical T object. It's just a word */
extern cell T;