summaryrefslogtreecommitdiffstats
path: root/scm.c
diff options
context:
space:
mode:
authorLaMont Jones <lamont@debian.org>2003-05-07 08:36:40 -0600
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:27 -0800
commite21d47d7813159bb71e0671df9b52ec0470c358d (patch)
tree3c7770ea846123c291f599044e9f234ac17616bb /scm.c
parent8cfce36c6a4fc2e0a0ab6ef2db66a23cbe462693 (diff)
parentdeda2c0fd8689349fea2a900199a76ff7ecb319e (diff)
downloadscm-e21d47d7813159bb71e0671df9b52ec0470c358d.tar.gz
scm-e21d47d7813159bb71e0671df9b52ec0470c358d.zip
Import Debian changes 5d6-3.2debian/5d6-3.2
scm (5d6-3.2) unstable; urgency=low * Fix hppa compile. Closes: #144062 scm (5d6-3.1) unstable; urgency=low * NMU with patch from James Troup, to fix FTBFS on sparc. Closes: #191171 scm (5d6-3) unstable; urgency=low * Add build depend on xlibs-dev (Closes: #148020) scm (5d6-2) unstable; urgency=low * Remove libregexx-dev from build-depends. * Change build to use ./scmlit rather than scmlit (should fix some build problems) (looks like alpha is mostly building) * New release (Closes: #140175) * Built with turtlegraphics last time (Closes: #58515) scm (5d6-1) unstable; urgency=low * New upstream. * Add xlib and turtlegr to requested list of features. (closes some bug) * Make clean actually clean most everything up. * Remove hacks renaming build to something else and just set build as a .PHONY target in debian/rules. * Add the turtlegr code. scm (5d5-1) unstable; urgency=low * New upstream * Has fixes for 64 bit archs. May fix alpha compile problem. Does fix (Closes: #140175) * Take out -O2 arg. scm (5d4-3) unstable; urgency=low * Don't link with regexx, but just use libc6's regular expression functions. * Define (terms) to output /usr/share/common-licenses/GPL (Closes: #119321) scm (5d4-2) unstable; urgency=low * Add texinfo to build depends (Closes: #107011) scm (5d4-1) unstable; urgency=low * New upstream release. * Move install-info --remove to prerm. scm (5d3-5) unstable; urgency=low * Move scm info files to section "The Algorithmic Language Scheme" to match up with guile. scm (5d3-4) unstable; urgency=low * Fix build depends (Closes: #76691) scm (5d3-3) unstable; urgency=low * Fix path in scm dhelp file. scm (5d3-2) unstable; urgency=low * Actually put the header files in the package. Oops. scm (5d3-1) unstable; urgency=low * New upstream. (Closes: #74761) * Make (terms) use new license location. * Make use libregexx rather than librx. * Fix build depends for above. * Using new regex lib seems to fix crash (Closes: #66787) * Consider adding scm-dev package with headers, but instead just add the headers to the scm package. (Closes: #70787) * Add doc-base support.
Diffstat (limited to 'scm.c')
-rw-r--r--scm.c284
1 files changed, 197 insertions, 87 deletions
diff --git a/scm.c b/scm.c
index d5c1755..b939b6b 100644
--- a/scm.c
+++ b/scm.c
@@ -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)));
}