Commit 5e7d7c3b authored by Erick Gallesio's avatar Erick Gallesio

Changed all the atexit stuff

parent f27ec451
Erick Gallesio <eg@unice.fr>
main author: Erick Gallesio <eg@unice.fr>
LURC support: Stephane Epardaud <Stephane.Epardaud@sophia.inria.fr>
2006-04-15 Erick Gallesio <eg@essi.fr>
* src/fport.c, src/system.c
* lib/repl.stk (main-repl): Changed the way buffer are flushed.
Bonus: when programs exits normally in interactive mode, the
exit functions are executed.
* utils/stklos-config.in: Added the option --threads to know what
thread system is compiled in.
......
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 4-Jun-2000 15:07 (eg)
;;;; Last file update: 2-Jan-2006 10:41 (eg)
;;;; Last file update: 15-Apr-2006 12:27 (eg)
;;;;
;; This file defines the REPL module. This module does not export anything
......@@ -189,7 +189,8 @@ doc>
"Copyright 1999-2006 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>\n"
'normal)
(current-error-port)))
(repl))
(repl)
(%pre-exit 0))
)
......
This diff is collapsed.
This diff is collapsed.
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 8-Jan-2000 14:48 (eg)
* Last file update: 12-Apr-2006 16:06 (eg)
* Last file update: 15-Apr-2006 11:53 (eg)
*
* This implementation is built by reverse engineering on an old SUNOS 4.1.1
* stdio.h. It has been simplified to fit the needs for STklos. In particular
......@@ -100,11 +100,11 @@ static void unregister_port(SCM port)
}
}
static void close_all_ports(void)
void STk_close_all_ports(void)
{
struct port_list *tmp, *cur;
SCM eport = STk_current_error_port();
SCM oport = STk_current_output_port(); //FIXME:PORT
SCM oport = STk_current_output_port();
for (cur = all_file_ports; cur ; cur = cur->next) {
tmp = GET_FAKE_POINTER(cur->port);
......@@ -867,8 +867,6 @@ int STk_init_fport(void)
STk_current_filename = ""; /* "" <=> stdin */
// ADD_PRIMITIVE(dbg);
// FIXME: put this back
// atexit(close_all_ports);
return TRUE;
}
......
......@@ -15,7 +15,7 @@
*
* Author: Erick Gallesio [eg@kaolin.unice.fr]
* Creation date: ??-???-1994 ??:??
* Last file update: 15-Apr-2006 11:06 (eg)
* Last file update: 15-Apr-2006 11:56 (eg)
*
* Code for Win32 conributed by (Paul Anderson <paul@grammatech.com> and
* Sarah Calvo <sarah@grammatech.com>) has been deleted for now. It should be
......@@ -403,7 +403,7 @@ DEFINE_PRIMITIVE("fork", fork, subr01, (SCM thunk))
case 0: /* CHILD */
if (thunk) {
STk_C_apply(thunk, 0);
STk_quit(0);
STk_exit(0);
}
return STk_false;
default: /* PARENT */
......
......@@ -22,7 +22,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 10-Oct-1995 07:55
* Last file update: 4-Jan-2006 13:52 (eg)
* Last file update: 15-Apr-2006 11:33 (eg)
*
*/
......@@ -134,7 +134,7 @@ static void sighup(int i)
{
/* FIXME: perhaps we should be more verbose */
fprintf(stderr, "Received a SIGHUP signal.\n");
exit(0);
STk_exit(0);
}
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 28-Dec-1999 22:58 (eg)
* Last file update: 14-Apr-2006 20:17 (eg)
* Last file update: 15-Apr-2006 11:53 (eg)
*/
#ifndef STKLOS_H
......@@ -837,6 +837,7 @@ int STk_init_fport(void);
SCM STk_current_input_port(void);
SCM STk_current_output_port(void);
SCM STk_current_error_port(void);
void STk_close_all_ports(void);
/****
......
......@@ -16,7 +16,7 @@
*
* Author: Erick Gallesio [eg@kaolin.unice.fr]
* Creation date: 29-Mar-1994 10:57
* Last file update: 4-Apr-2006 19:26 (eg)
* Last file update: 15-Apr-2006 12:27 (eg)
*/
#include <unistd.h>
......@@ -556,8 +556,9 @@ DEFINE_PRIMITIVE("temporary-file-name", tmp_file, subr0, (void))
*
* This function registers |proc| as an exit function. This function will
* be called when the program exits. When called, |proc| will be passed one
* parmater which is the status given to the |exit| function. The result of
* |register-exit-function!| is undefined.
* parmater which is the status given to the |exit| function (or 0 if the
* programe terminates normally). The result of |register-exit-function!|
* is undefined.
* @lisp
* (let* ((tmp (temporary-file-name))
* (out (open-output-file tmp)))
......@@ -577,6 +578,31 @@ DEFINE_PRIMITIVE("register-exit-function!", at_exit, subr1, (SCM proc))
}
DEFINE_PRIMITIVE("%pre-exit", pre_exit, subr1, (SCM retcode))
{
/* Execute the at-exit handlers */
for ( ; !NULLP(exit_procs); exit_procs = CDR(exit_procs))
STk_C_apply(CAR(exit_procs), 1, retcode);
/* Flush all bufers */
STk_close_all_ports();
#ifdef FIXME
//EG: /* Execute all the terminal thunks of pending dynamic-wind */
//EG: STk_unwind_all();
//EG:
//EG: /* call user finalization code */
//EG: STk_user_cleanup();
//EG:
//EG:#if defined(WIN32) && defined(USE_SOCKET)
//EG: /* Unregister the interpreter from Winsock */
//EG: WSACleanup();
//EG:#endif
#endif
return STk_void;
}
/*
<doc EXT exit
* (exit)
......@@ -584,11 +610,11 @@ DEFINE_PRIMITIVE("register-exit-function!", at_exit, subr1, (SCM proc))
*
* Exits the program with the specified integer return code. If |ret-code|
* is omitted, the program terminates with a return code of 0.
* If program has registerd exit functions with |register-exit-function!|,
* If program has registered exit functions with |register-exit-function!|,
* they are called (in an order which is the reverse of their call order).
doc>
*/
DEFINE_PRIMITIVE("exit", quit, subr01, (SCM retcode))
DEFINE_PRIMITIVE("exit", exit, subr01, (SCM retcode))
{
long ret = 0;
......@@ -596,28 +622,12 @@ DEFINE_PRIMITIVE("exit", quit, subr01, (SCM retcode))
ret = STk_integer_value(retcode);
if (ret == LONG_MIN) STk_error("bad return code ~S", retcode);
} else {
retcode = MAKE_INT(ret);
retcode = MAKE_INT(0);
}
/* Execute the at-exit handlers */
for ( ; !NULLP(exit_procs); exit_procs = CDR(exit_procs))
STk_C_apply(CAR(exit_procs), 1, retcode);
#ifdef FIXME
//EG: /* Execute all the terminal thunks of pending dynamic-wind */
//EG: STk_unwind_all();
//EG:
//EG: /* call user finalization code */
//EG: STk_user_cleanup();
//EG:
//EG:#if defined(WIN32) && defined(USE_SOCKET)
//EG: /* Unregister the interpreter from Winsock */
//EG: WSACleanup();
//EG:#endif
#endif
STk_pre_exit(retcode);
exit(ret);
return STk_void; /* never reached */
}
......@@ -1088,7 +1098,8 @@ int STk_init_system(void)
ADD_PRIMITIVE(rename_file);
ADD_PRIMITIVE(copy_file);
ADD_PRIMITIVE(tmp_file);
ADD_PRIMITIVE(quit);
ADD_PRIMITIVE(pre_exit);
ADD_PRIMITIVE(exit);
ADD_PRIMITIVE(at_exit);
ADD_PRIMITIVE(machine_type);
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 1-Mar-2000 19:51 (eg)
* Last file update: 14-Apr-2006 20:33 (eg)
* Last file update: 15-Apr-2006 11:55 (eg)
*/
// INLINER values
......@@ -135,7 +135,7 @@ vm_thread_t *STk_allocate_vm(int stack_size)
if (!vm->stack) {
fprintf(stderr, "cannot allocate a stack with a size of %d cells\n", stack_size);
fflush(stderr);
exit(1);
STk_exit(1);
}
/* Initialize the VM registers */
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment