diff options
Diffstat (limited to 'scm.c')
| -rw-r--r-- | scm.c | 284 |
1 files changed, 197 insertions, 87 deletions
@@ -15,26 +15,26 @@ * the Free Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111, USA. * * As a special exception, the Free Software Foundation gives permission - * for additional uses of the text contained in its release of GUILE. + * for additional uses of the text contained in its release of SCM. * - * The exception is that, if you link the GUILE library with other files + * The exception is that, if you link the SCM library with other files * to produce an executable, this does not by itself cause the * resulting executable to be covered by the GNU General Public License. * Your use of that executable is in no way restricted on account of - * linking the GUILE library code into it. + * linking the SCM library code into it. * * This exception does not however invalidate any other reasons why * the executable file might be covered by the GNU General Public License. * * This exception applies only to the code released by the - * Free Software Foundation under the name GUILE. If you copy + * Free Software Foundation under the name SCM. If you copy * code from other Free Software Foundation releases into a copy of - * GUILE, as the General Public License permits, the exception does + * SCM, as the General Public License permits, the exception does * not apply to the code that you add in this way. To avoid misleading * anyone as to the status of such modified files, you must delete * this exception notice from them. * - * If you write modifications of your own for GUILE, it is your choice + * If you write modifications of your own for SCM, it is your choice * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ @@ -42,7 +42,11 @@ /* "scm.c" Initialization and interrupt code. Author: Aubrey Jaffer */ -#include <signal.h> +#ifdef PLAN9 +# define signal(a,b) 0/* no signals in Plan 9 */ +#else +# include <signal.h> +#endif #include "scm.h" #include "patchlvl.h" @@ -62,7 +66,10 @@ # ifdef SVR4 # include <unistd.h> # endif -# ifdef __amigados__ +# ifdef __OpenBSD__ +# include <unistd.h> +# endif +# ifdef __amigaos__ # include <unistd.h> # endif #endif @@ -91,6 +98,7 @@ void init_tables P((void)); void init_time P((void)); void init_types P((void)); void init_unif P((void)); +void init_debug P((void)); void reset_time P((void)); void final_repl P((void)); @@ -103,12 +111,27 @@ This is free software, and you are welcome to redistribute it\n\ under certain conditions; type `(terms)' for details.\n", stderr); } +void scm_init_INITS() +{ + if (!dumped) { +#ifdef INITS + INITS; /* call initialization of extension files */ +#endif + } +} SCM scm_init_extensions() { #ifdef COMPILED_INITS COMPILED_INITS; /* initialize statically linked add-ons */ #endif init_user_scm(); +#ifndef HAVE_DYNL + /* No more init_*s, so trim gra[]s */ + scm_trim_gra(&subrs_gra); + scm_trim_gra(&ptobs_gra); + scm_trim_gra(&smobs_gra); + scm_trim_gra(&finals_gra); +#endif return UNSPECIFIED; } @@ -166,6 +189,10 @@ void process_signals() } mask <<= 1; } + if (gc_hook_pending) { + gc_hook_pending = 0; + scm_gc_hook(); + } deferred_proc = 0; } static char s_unksig[] = "unknown signal"; @@ -239,52 +266,40 @@ SCM lalarm(i) # ifdef SIGPROF # include <sys/time.h> static char s_setitimer[] = "setitimer"; -static SCM setitimer_iv[3]; +static struct {SCM sym; int which;} setitimer_tab[3] = { + {UNDEFINED, 0}, {UNDEFINED, 0}, {UNDEFINED, 0}}; /* VALUE and INTERVAL are milliseconds */ SCM scm_setitimer(which, value, interval) SCM which, value, interval; { struct itimerval tval, oval; int w; -# ifdef ITIMER_REAL - if (which==setitimer_iv[0]) { - w = ITIMER_REAL; - goto doit; - } -# endif -# ifdef ITIMER_VIRTUAL - if (which==setitimer_iv[1]) { - w = ITIMER_VIRTUAL; - goto doit; - } -# endif -# ifdef ITIMER_PROF - if (which==setitimer_iv[2]) { - w = ITIMER_PROF; - goto doit; + int i = sizeof(setitimer_tab)/sizeof(setitimer_tab[0]); + while (i--) { + if (which==setitimer_tab[i].sym) { + w = setitimer_tab[i].which; + if (BOOL_T==value) + SYSCALL(w = getitimer(w, &oval);); + else { + if (BOOL_F==value) value = INUM0; + ASSERT(INUMP(value), value, ARG2, s_setitimer); + if (BOOL_F==interval) interval = INUM0; + ASSERT(INUMP(interval), interval, ARG3, s_setitimer); + tval.it_value.tv_sec = INUM(value) / 1000; + tval.it_value.tv_usec = (INUM(value) % 1000)*1000; + tval.it_interval.tv_sec = INUM(interval) / 1000; + tval.it_interval.tv_usec = (INUM(interval) % 1000)*1000; + SYSCALL(w = setitimer(w, &tval, &oval);); + } + if (w) return BOOL_F; + return cons2(MAKINUM(oval.it_value.tv_usec/1000 + + oval.it_value.tv_sec*1000), + MAKINUM(oval.it_interval.tv_usec/1000 + + oval.it_interval.tv_sec*1000), + EOL); + } } -# endif return BOOL_F; - doit: - if (BOOL_T==value) - SYSCALL(w = getitimer(w, &oval);); - else { - if (BOOL_F==value) value = INUM0; - ASSERT(INUMP(value), value, ARG2, s_setitimer); - if (BOOL_F==interval) interval = INUM0; - ASSERT(INUMP(interval), interval, ARG3, s_setitimer); - tval.it_value.tv_sec = INUM(value) / 1000; - tval.it_value.tv_usec = (INUM(value) % 1000)*1000; - tval.it_interval.tv_sec = INUM(interval) / 1000; - tval.it_interval.tv_usec = (INUM(interval) % 1000)*1000; - SYSCALL(w = setitimer(w, &tval, &oval);); - } - if (w) return BOOL_F; - return cons2(MAKINUM(oval.it_value.tv_usec/1000 + - oval.it_value.tv_sec*1000), - MAKINUM(oval.it_interval.tv_usec/1000 + - oval.it_interval.tv_sec*1000), - EOL); } # endif # ifndef AMIGA @@ -301,6 +316,9 @@ SCM l_pause() #ifdef _WIN32 # include <windows.h> #endif +#ifdef __IBMC__ +# include <os2.h> +#endif #ifndef AMIGA # ifndef _Windows static char s_sleep[] = "sleep"; @@ -313,9 +331,13 @@ SCM l_sleep(i) SYSCALL(sleep(INUM(i));); # else # ifdef _WIN32 - Sleep(INUM(i)); + Sleep(INUM(i) * 1000); # else +# ifdef __IBMC__ + DosSleep(INUM(i) * 1000); +# else SYSCALL(j = sleep(INUM(i));); +# endif # endif # endif return MAKINUM(j); @@ -323,36 +345,60 @@ SCM l_sleep(i) # endif #endif +#ifdef PLAN9 +int raise(sig) + int sig; +{ + char *str; + int len; + char ibuf[12]; + char pidbuf[32]; + int fd; + int res; + sprint(ibuf, "%ld", sig); + len = strlen(ibuf); + sprint(pidbuf, "/proc/%d/note", getpid()); + fd = open(pidbuf, OWRITE); + res = write(fd, ibuf, len); + close (fd); + return res==len; +} +#endif + #ifndef _WIN32 # ifndef sun # ifndef THINK_C +# ifndef __TURBOC__ +# ifdef STDC_HEADERS +# ifndef __MWERKS__ +# ifndef __IBMC__ +# ifndef PLAN9 +# define LACK_RAISE +# endif +# endif +# endif +# endif +# endif +# endif +# endif +#endif /* int raise P((int sig)); */ static char s_raise[] = "raise"; SCM l_raise(sig) SCM sig; { ASSERT(INUMP(sig), sig, ARG1, s_raise); -# ifdef vms +#ifdef LACK_RAISE +# ifdef vms return MAKINUM(gsignal((int)INUM(sig))); -# else -# ifndef __TURBOC__ -# ifdef STDC_HEADERS -# ifndef __MWERKS__ +# else return kill(getpid (), (int)INUM(sig)) ? BOOL_F : BOOL_T; -# else - return raise((int)INUM(sig)) ? BOOL_F : BOOL_T; -# endif -# else - return raise((int)INUM(sig)) ? BOOL_F : BOOL_T; -# endif -# else - return raise((int)INUM(sig)) ? BOOL_F : BOOL_T; -# endif -# endif -} -# endif # endif +#else + return raise((int)INUM(sig)) ? BOOL_F : BOOL_T; #endif +} + #ifdef TICKS unsigned int tick_count = 0, ticken = 0; SCM *loc_tick_signal; @@ -404,23 +450,20 @@ void init_scm(iverbose, buf0stdin, init_heap_size) if (!dumped) { init_features(); init_subrs(); - init_io(); init_scl(); - init_eval(); + init_unif(); init_time(); + init_io(); + init_eval(); /* call to scm_evstr switches INTS discipline */ + init_debug(); + init_rope(); init_repl(iverbose); - init_unif(); } else reset_time(); #ifdef HAVE_DYNL /* init_dynl() must check dumped to avoid redefining subrs */ init_dynl(); #endif - if (!dumped) { -#ifdef INITS - INITS; /* call initialization of extension files */ -#endif - } } static void init_sig1(scm_err, signo, handler) @@ -436,7 +479,9 @@ static void init_sig1(scm_err, signo, handler) } void init_signals() { +#ifdef SIGINT init_sig1(INT_SIGNAL, SIGINT, scmable_signal); +#endif #ifdef SIGHUP init_sig1(HUP_SIGNAL, SIGHUP, scmable_signal); #endif @@ -532,9 +577,10 @@ void restore_signals() # ifndef SIGPROF alarm(0); /* kill any pending ALRM interrupts */ # else - i = sizeof(setitimer_iv)/sizeof(SCM); + i = sizeof(setitimer_tab)/sizeof(setitimer_tab[0]); while (i--) - scm_setitimer(setitimer_iv[i], BOOL_F, BOOL_F); + if (NIMP(setitimer_tab[i].sym)) + scm_setitimer(setitimer_tab[i].sym, BOOL_F, BOOL_F); # endif #endif i = NUM_SIGNALS; @@ -567,7 +613,7 @@ void scm_init_from_argv(argc, argv, script_arg, iverbose, buf0stdin) break; } while (* ++str); } - init_scm(iverbose, buf0stdin, (0 >= i) ? 0L : 1024L * i); /* size in Kb */ + init_scm(iverbose, buf0stdin, (0 >= i) ? 0L : 1024L * i); /* size in kB */ progargs = EOL; progargs = makfromstrs(argc, argv); sysintern("*script*", script_arg ? makfrom0str(script_arg) : BOOL_F); @@ -578,6 +624,7 @@ void final_scm(freeall) #ifdef TICKS ticken = 0; #endif + scm_run_finalizers(!0); #ifdef FINALS FINALS; /* call shutdown of extensions files */ #endif /* for compatability with older modules */ @@ -590,6 +637,14 @@ void final_scm(freeall) if (freeall) free_storage(); /* free all allocated memory */ } +#ifdef PLAN9 +# define SYSTNAME "plan9" +# define DIRSEP "/" +#endif +#ifdef __MACH__ +# define SYSTNAME "unix" +# define DIRSEP "/" +#endif #ifdef __CYGWIN32__ # define SYSTNAME "unix" # define DIRSEP "/" @@ -597,7 +652,7 @@ void final_scm(freeall) #ifdef vms # define SYSTNAME "vms" #endif -#ifdef unix +#ifdef HAVE_UNIX # define DIRSEP "/" # ifndef MSDOS /* DJGPP defines both */ # define SYSTNAME "unix" @@ -613,7 +668,7 @@ void final_scm(freeall) #else # ifdef MSDOS # define SYSTNAME "ms-dos" -# ifndef unix +# ifndef HAVE_UNIX # define DIRSEP "\\" # endif # endif @@ -642,17 +697,13 @@ void final_scm(freeall) # define SYSTNAME "atarist" # define DIRSEP "\\" #endif -#ifdef mach -# define SYSTNAME "mach" -# define DIRSEP "/" -#endif #ifdef ARM_ULIB # define SYSTNAME "acorn" #endif #ifdef nosve # define DIRSEP "." #endif -#ifdef __amigados__ +#ifdef __amigaos__ # define SYSTNAME "amiga" # define DIRSEP "/" #endif @@ -667,6 +718,36 @@ SCM softtype() #endif } +#ifdef PLAN9 +/* This code is adapted from /sys/src/ape/lib/ap/plan9/isatty.c. */ +int isatty (int fd) +{ + Dir d1, d2; + char buf[40]; + int t; + if (dirfstat(fd, &d1) < 0) return 0; + if (strncmp(d1.name, "ptty", 4) == 0) return 1; + if (dirstat("/dev/cons", &d2) < 0) return 0; + /* If we came in through con, /dev/cons is probably #d/0, which won't + * match stdin. Opening #d/0 and fstating it gives the values of the + * underlying channel */ + if (d2.type == 'd') { + strcpy(buf, "#d/"); + strcpy(buf+3, d2.name); + if ((t = open(buf, 0)) < 0) return 0; + if (dirfstat(t, &d2) < 0) { + close(t); + return 0; + } + close(t); + } + return (d1.type == d2.type) && (d1.dev == d2.dev); +} + +/* A temporary hack: give SCM our own errno. */ +int errno; +#endif + int init_buf0(inport) FILE *inport; { @@ -719,7 +800,7 @@ char *scm_find_execpath(argc, argv, script_arg) { char *exepath = 0; #ifndef macintosh -# ifdef unix +# ifdef HAVE_UNIX # ifndef MSDOS if (script_arg) exepath = script_find_executable(script_arg); # endif @@ -730,6 +811,26 @@ char *scm_find_execpath(argc, argv, script_arg) return exepath; } +#ifdef PLAN9 +int system(command) + const char *command; +{ + int sts; + int pid = fork(); + if (pid) { + Waitmsg wm; + sts = -1; + while (wait(&wm) != -1) { + if (pid==atoi(wm.pid)) { + sts = 0; + break; + } + } + } else sts = execl("/bin/rc", "/bin/rc", "-c", command, nil); + return sts; +} +#endif + #ifndef _Windows char s_system[] = "system"; SCM lsystem(cmd) @@ -838,9 +939,18 @@ void init_features() #ifdef SIGALRM # ifdef SIGPROF make_subr(s_setitimer, tc7_subr_3, scm_setitimer); - setitimer_iv[0] = CAR(sysintern("real", UNDEFINED)); - setitimer_iv[1] = CAR(sysintern("virtual", UNDEFINED)); - setitimer_iv[2] = CAR(sysintern("profile", UNDEFINED)); +# ifdef ITIMER_REAL + setitimer_tab[0].sym = CAR(sysintern("real", UNDEFINED)); + setitimer_tab[0].which = ITIMER_REAL; +# endif +# ifdef ITIMER_VIRTUAL + setitimer_tab[1].sym = CAR(sysintern("virtual", UNDEFINED)); + setitimer_tab[1].which = ITIMER_VIRTUAL; +# endif +# ifdef ITIMER_PROF + setitimer_tab[2].sym = CAR(sysintern("profile", UNDEFINED)); + setitimer_tab[2].which = ITIMER_PROF; +# endif # endif #endif #ifdef TICKS @@ -856,5 +966,5 @@ void init_features() #ifdef vms add_feature(s_ed); #endif - sysintern("*scm-version*", makfrom0str(SCMVERSION)); + sysintern("*scm-version*", CAR(sysintern(SCMVERSION, UNDEFINED))); } |