steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix botched replace all in VM source, clean up image saving code, and fix save-image-and-exit to actually call (save-image-and-exit) instead of (save-image)

db4
Slava Pestov 2009-05-05 10:29:22 -05:00
parent 4c756a1147
commit 12de56c41e
5 changed files with 16 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
basis/tools/deploy/shaker/shaker.factor
View File

@ -346,13 +346,6 @@ IN: tools.deploy.shaker
: compress-wrappers ( -- ) : compress-wrappers ( -- )
[ wrapper? ] [ ] "wrappers" compress ; [ 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 SYMBOL: deploy-vocab
: [:c] ( -- word ) ":c" "debugger" lookup ; : [:c] ( -- word ) ":c" "debugger" lookup ;
@ -437,7 +430,8 @@ SYMBOL: deploy-vocab
"Vocabulary has no MAIN: word." print flush 1 exit "Vocabulary has no MAIN: word." print flush 1 exit
] unless ] unless
strip strip
finish-deploy "Saving final image" show
save-image-and-exit
] deploy-error-handler ] deploy-error-handler
] bind ; ] bind ;

2
core/memory/memory.factor
View File

@ -26,6 +26,6 @@ IN: memory
normalize-path native-string>alien (save-image) ; normalize-path native-string>alien (save-image) ;
: save-image-and-exit ( path -- ) : 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 ; : save ( -- ) image save-image ;

2
vm/factor.cpp
View File

@ -134,7 +134,7 @@ VM_C_API void init_factor(vm_parameters *p)
userenv[CPU_ENV] = allot_alien(F,(cell)FACTOR_CPU_STRING); userenv[CPU_ENV] = allot_alien(F,(cell)FACTOR_CPU_STRING);
userenv[OS_ENV] = allot_alien(F,(cell)FACTOR_OS_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[EXECUTABLE_ENV] = allot_alien(F,(cell)p->executable_path);
userenv[ARGS_ENV] = F; userenv[ARGS_ENV] = F;
userenv[EMBEDDED_ENV] = F; userenv[EMBEDDED_ENV] = F;

20
vm/image.cpp
View File

@ -106,14 +106,8 @@ bool save_image(const vm_char *filename)
h.bignum_pos_one = bignum_pos_one; h.bignum_pos_one = bignum_pos_one;
h.bignum_neg_one = bignum_neg_one; h.bignum_neg_one = bignum_neg_one;
cell i; for(cell i = 0; i < USER_ENV; i++)
for(i = 0; i < USER_ENV; i++) h.userenv[i] = (save_env_p(i) ? userenv[i] : F);
{
if(i < FIRST_SAVE_ENV)
h.userenv[i] = F;
else
h.userenv[i] = userenv[i];
}
bool ok = true; bool ok = true;
@ -149,12 +143,10 @@ PRIMITIVE(save_image_and_exit)
path.untag_check(); path.untag_check();
/* strip out userenv data which is set on startup anyway */ /* strip out userenv data which is set on startup anyway */
cell i; for(cell i = 0; i < USER_ENV; i++)
for(i = 0; i < FIRST_SAVE_ENV; i++) {
userenv[i] = F; if(!save_env_p(i)) userenv[i] = F;
}
for(i = LAST_SAVE_ENV + 1; i < STACK_TRACES_ENV; i++)
userenv[i] = F;
/* do a full GC + code heap compaction */ /* do a full GC + code heap compaction */
performing_compaction = true; performing_compaction = true;

7
vm/run.hpp
View File

@ -14,7 +14,7 @@ enum special_object {
BREAK_ENV = 5, /* quotation called by throw primitive */ BREAK_ENV = 5, /* quotation called by throw primitive */
ERROR_ENV, /* a marker consed onto kernel errors */ ERROR_ENV, /* a marker consed onto kernel errors */
cell_SIZE_ENV = 7, /* sizeof(cell) */ CELL_SIZE_ENV = 7, /* sizeof(cell) */
CPU_ENV, /* CPU architecture */ CPU_ENV, /* CPU architecture */
OS_ENV, /* operating system name */ OS_ENV, /* operating system name */
@ -93,6 +93,11 @@ enum special_object {
#define FIRST_SAVE_ENV BOOT_ENV #define FIRST_SAVE_ENV BOOT_ENV
#define LAST_SAVE_ENV STAGE2_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 */ /* Canonical T object. It's just a word */
extern cell T; extern cell T;