mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-18 15:22:03 -08:00
Code Issues Projects Releases Packages Wiki Activity

EXT:QUIT now stores the exit code of the program and this is returned by standalone executables.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2009-11-09 10:12:45 +01:00
parent a7088a9c13
commit a316938550
5 changed files with 21 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

18
src/c/main.d
View file

@ -722,23 +722,27 @@ cl_boot(int argc, char **argv)
cl_object p, all_threads = mp_all_processes();
for (p = all_threads; !Null(p); p = ECL_CONS_CDR(p)) {
cl_object process = ECL_CONS_CAR(p);
if (process != this) mp_process_kill(process);
if (process != this && process->process.active)
mp_process_kill(process);
}
for (p = all_threads; !Null(p); p = ECL_CONS_CDR(p)) {
cl_object process = ECL_CONS_CAR(p);
if (process != this) mp_process_join(process);
if (process != this && process->process.active)
mp_process_join(process);
}
}
#endif
the_env->nvalues = 1;
the_env->values[0] = code;
ECL_SET(@'ext::*program-exit-code*', code);
if (the_env->frs_org <= the_env->frs_top)
ecl_unwind(the_env, the_env->frs_org);
CEerror(Ct, "QUIT: there is no frame to return to. "
"Using continue will just abort.", 0);
si_exit(1, code);
}
@)
@(defun ext::exit (&optional (code ECL_SYM_VAL(ecl_process_env(),@'ext::*program-exit-code*')))
@
cl_shutdown();
exit(FIXNUMP(code)? fix(code) : 0);
}
@)
cl_object

3
src/c/symbols_list.h
View file

@ -1839,5 +1839,8 @@ cl_symbols[] = {
{EXT_ "ARRAY-RAW-DATA", EXT_ORDINARY, si_array_raw_data, 1, OBJNULL},
{EXT_ "*PROGRAM-EXIT-CODE*", EXT_SPECIAL, NULL, -1, MAKE_FIXNUM(0)},
{EXT_ "EXIT", EXT_ORDINARY, si_exit, -1, OBJNULL},
/* Tag for end of list */
{NULL, CL_ORDINARY, NULL, -1, OBJNULL}};

3
src/c/symbols_list2.h
View file

@ -1839,5 +1839,8 @@ cl_symbols[] = {
{EXT_ "ARRAY-RAW-DATA","si_array_raw_data"},
{EXT_ "*PROGRAM-EXIT-CODE*",NULL},
{EXT_ "EXIT","si_exit"},
/* Tag for end of list */
{NULL,NULL}};

14
src/cmp/cmpmain.lsp
View file

@ -267,6 +267,7 @@ main(int argc, char **argv)
read_VV(OBJNULL, ~A);
~A
} CL_CATCH_ALL_END;
si_exit(0);
}")
#+:win32
@ -284,6 +285,7 @@ WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLine, int nCmdS
read_VV(OBJNULL, ~A);
~A
} CL_CATCH_ALL_END;
si_exit(0);
}")
(defun init-function-name (s &key (kind :object))
@ -408,17 +410,7 @@ filesystem or in the database of ASDF modules."
cl_object output;
si_select_package(make_simple_base_string(\"CL-USER\"));
output = si_safe_eval(3, ecl_read_from_cstring(lisp_code), Cnil, OBJNULL);
" stream)
(when (eq target :program)
(princ "
cl_shutdown();
if (FIXNUMP(output))
return fix(output);
if (Null(output) || (output == OBJNULL))
return 0;
return 1;"
stream))
(princ #\} stream)
}" stream)
)))))
(cond ((null prologue-code)
(setf prologue-code ""))

1
src/h/external.h
View file

@ -888,6 +888,7 @@ extern ECL_API cl_object si_getenv(cl_object var);
extern ECL_API cl_object si_setenv(cl_object var, cl_object value);
extern ECL_API cl_object si_pointer(cl_object x);
extern ECL_API cl_object si_quit _ARGS((cl_narg narg, ...)) /*__attribute__((noreturn))*/;
extern ECL_API cl_object si_exit _ARGS((cl_narg narg, ...)) /*__attribute__((noreturn))*/;
typedef enum {
ECL_OPT_INCREMENTAL_GC = 0,