summaryrefslogtreecommitdiffstats
path: root/scm.c
diff options
context:
space:
mode:
authorSteve Langasek <vorlon@debian.org>2004-12-07 23:23:48 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:28 -0800
commit37f2f5e0bb11a18deecf48c7ad6bcbf7bd932db2 (patch)
tree692caebb60ec5f80ce528a403b69351ca756d530 /scm.c
parente21d47d7813159bb71e0671df9b52ec0470c358d (diff)
parentc7d035ae1a729232579a0fe41ed5affa131d3623 (diff)
downloadscm-37f2f5e0bb11a18deecf48c7ad6bcbf7bd932db2.tar.gz
scm-37f2f5e0bb11a18deecf48c7ad6bcbf7bd932db2.zip
Import Debian changes 5d9-4.1debian/5d9-4.1
scm (5d9-4.1) unstable; urgency=high * Non-maintainer upload. * High-urgency upload for sarge-targetted RC bugfix. * Revert upstream "CAUTIOUS" define, which causes the scm build to fail its test suite on alpha (and, it appears, powerpc as well). Closes: #245810. scm (5d9-4) unstable; urgency=low * Apply patch from 144062 to fix hppa build (Closes: #144062) * Change scm.1 section from Jan 4 200 to 1. (lintian) scm (5d9-3) unstable; urgency=low * Properly clean up info files. * Make and install Xlibscm.info. scm (5d9-2) unstable; urgency=low * Fix path problem in slibcat. Hack at mklibcat.scm. (Closes: #241510) scm (5d9-1) unstable; urgency=low * New upstream release * Merge NMU sparc changes (Closes: #191171, #191356) * SHORT_INT is defined for ia64 upstream (Closes: #141928) * Scheme imps now grouped in info file (has been for a while) (Closes: #115452)
Diffstat (limited to 'scm.c')
-rw-r--r--scm.c122
1 files changed, 106 insertions, 16 deletions
diff --git a/scm.c b/scm.c
index b939b6b..d4506e8 100644
--- a/scm.c
+++ b/scm.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1990-1999 Free Software Foundation, Inc.
+/* Copyright (C) 1990-2002 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -50,6 +50,10 @@
#include "scm.h"
#include "patchlvl.h"
+#ifdef _WIN32
+#include <io.h>
+#endif
+
#ifdef __IBMC__
# include <io.h>
#endif
@@ -66,6 +70,9 @@
# ifdef SVR4
# include <unistd.h>
# endif
+# ifdef __NetBSD__
+# include <unistd.h>
+# endif
# ifdef __OpenBSD__
# include <unistd.h>
# endif
@@ -104,7 +111,7 @@ void final_repl P((void));
void init_banner()
{
- fputs("SCM version "SCMVERSION", Copyright (C) 1990-1999 \
+ fputs("SCM version "SCMVERSION", Copyright (C) 1990-2002 \
Free Software Foundation.\n\
SCM comes with ABSOLUTELY NO WARRANTY; for details type `(terms)'.\n\
This is free software, and you are welcome to redistribute it\n\
@@ -119,6 +126,8 @@ void scm_init_INITS()
#endif
}
}
+
+void (*init_user_scm) P((void));
SCM scm_init_extensions()
{
#ifdef COMPILED_INITS
@@ -195,6 +204,71 @@ void process_signals()
}
deferred_proc = 0;
}
+
+
+#ifdef WINSIGNALS
+SCM_EXPORT HANDLE scm_hMainThread;
+HANDLE scm_hMainThread;
+static SIGRETTYPE scmable_signal(int sig);
+# ifdef __MINGW32__
+static void sigintstub();
+__asm(".globl _sigintstub");
+__asm("_sigintstub:");
+__asm(" pushl $2");
+__asm(" call _scmable_signal");
+__asm(" addl $4, %esp");
+__asm(" popal");
+__asm(" popfl");
+__asm(" ret");
+# else /* works for Microsoft VC++ */
+static __declspec(naked) void sigintstub()
+{
+ scmable_signal(SIGINT);
+ __asm popad;
+ __asm popfd;
+ __asm ret;
+}
+# endif /* def __MINGW32__ */
+
+/* control-c signal handler */
+SIGRETTYPE win32_sigint(int sig)
+{
+ CONTEXT ctx;
+ DWORD *Stack;
+
+ if(-1 == SuspendThread(scm_hMainThread))
+ return;
+
+ ctx.ContextFlags = CONTEXT_FULL;
+ if(0 == GetThreadContext(scm_hMainThread, &ctx))
+ {
+ ResumeThread(scm_hMainThread);
+ return;
+ }
+
+ Stack = (DWORD *)ctx.Esp;
+
+ *--Stack = ctx.Eip;
+ *--Stack = ctx.EFlags;
+ *--Stack = ctx.Eax;
+ *--Stack = ctx.Ecx;
+ *--Stack = ctx.Edx;
+ *--Stack = ctx.Ebx;
+ *--Stack = ctx.Esp;
+ *--Stack = ctx.Ebp;
+ *--Stack = ctx.Esi;
+ *--Stack = ctx.Edi;
+ ctx.Esp = (DWORD)Stack;
+
+ ctx.Eip = (DWORD)sigintstub;
+
+ SetThreadContext(scm_hMainThread, &ctx);
+ ResumeThread(scm_hMainThread);
+}
+
+#endif /*def WINSIGNALS*/
+
+
static char s_unksig[] = "unknown signal";
static SIGRETTYPE err_signal(sig)
int sig;
@@ -205,6 +279,7 @@ static SIGRETTYPE err_signal(sig)
if (sig == sigdesc[i].signo) break;
wta(MAKINUM(sig), (i < 0 ? s_unksig : (char *)(i + SIGNAL_BASE)), "");
}
+
static SIGRETTYPE scmable_signal(sig)
int sig;
{
@@ -212,7 +287,12 @@ static SIGRETTYPE scmable_signal(sig)
int i = NUM_SIGNALS;
while (i--)
if (sig == sigdesc[i].signo) break;
- ASSERT(i >= 0, MAKINUM(sig), s_unksig, "");
+ ASRTER(i >= 0, MAKINUM(sig), s_unksig, "");
+#ifdef WINSIGNALS
+ if(SIGINT == sig)
+ signal(sig, win32_sigint);
+ else
+#endif
signal(sig, scmable_signal);
if (ints_disabled) {
deferred_proc = process_signals;
@@ -235,6 +315,8 @@ static SIGRETTYPE scmable_signal(sig)
errno = oerr;
}
+
+
/* If doesn't have SIGFPE, disable FLOATS for the rest of this file. */
#ifndef SIGFPE
@@ -259,7 +341,7 @@ SCM lalarm(i)
SCM i;
{
unsigned int j;
- ASSERT(INUMP(i) && (INUM(i) >= 0), i, ARG1, s_alarm);
+ ASRTER(INUMP(i) && (INUM(i) >= 0), i, ARG1, s_alarm);
SYSCALL(j = alarm(INUM(i)););
return MAKINUM(j);
}
@@ -282,9 +364,9 @@ SCM scm_setitimer(which, value, interval)
SYSCALL(w = getitimer(w, &oval););
else {
if (BOOL_F==value) value = INUM0;
- ASSERT(INUMP(value), value, ARG2, s_setitimer);
+ ASRTER(INUMP(value), value, ARG2, s_setitimer);
if (BOOL_F==interval) interval = INUM0;
- ASSERT(INUMP(interval), interval, ARG3, s_setitimer);
+ ASRTER(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;
@@ -326,7 +408,7 @@ SCM l_sleep(i)
SCM i;
{
unsigned int j = 0;
- ASSERT(INUMP(i) && (INUM(i) >= 0), i, ARG1, s_sleep);
+ ASRTER(INUMP(i) && (INUM(i) >= 0), i, ARG1, s_sleep);
# ifdef __HIGHC__
SYSCALL(sleep(INUM(i)););
# else
@@ -387,7 +469,7 @@ static char s_raise[] = "raise";
SCM l_raise(sig)
SCM sig;
{
- ASSERT(INUMP(sig), sig, ARG1, s_raise);
+ ASRTER(INUMP(sig), sig, ARG1, s_raise);
#ifdef LACK_RAISE
# ifdef vms
return MAKINUM(gsignal((int)INUM(sig)));
@@ -472,15 +554,19 @@ static void init_sig1(scm_err, signo, handler)
SIGRETTYPE (*handler)();
{
int i = scm_err - SIGNAL_BASE;
- ASSERT(i < NUM_SIGNALS, MAKINUM(i), OUTOFRANGE, "init_sig1");
+ ASRTER(i < NUM_SIGNALS, MAKINUM(i), OUTOFRANGE, "init_sig1");
sigdesc[i].signo = signo;
sigdesc[i].nsig = handler;
sigdesc[i].osig = signal(signo, handler);
}
void init_signals()
{
-#ifdef SIGINT
+#ifdef WINSIGNALS
+ init_sig1(INT_SIGNAL, SIGINT, win32_sigint);
+#else
+# ifdef SIGINT
init_sig1(INT_SIGNAL, SIGINT, scmable_signal);
+# endif
#endif
#ifdef SIGHUP
init_sig1(HUP_SIGNAL, SIGHUP, scmable_signal);
@@ -707,6 +793,10 @@ void final_scm(freeall)
# define SYSTNAME "amiga"
# define DIRSEP "/"
#endif
+#ifdef __NetBSD__
+# define SYSTNAME "unix"
+# define DIRSEP "/"
+#endif
const char dirsep[] = DIRSEP;
SCM softtype()
@@ -766,9 +856,9 @@ int init_buf0(inport)
# endif
# endif
# endif
+#endif
return !0; /* stdin gets marked BUF0 in init_scm() */
}
-#endif
return 0;
}
@@ -786,10 +876,10 @@ SCM scm_execpath(newpath)
execpath = 0;
return retval;
}
- ASSERT(NIMP(newpath) && STRINGP(newpath), newpath, ARG1, s_execpath);
+ ASRTER(NIMP(newpath) && STRINGP(newpath), newpath, ARG1, s_execpath);
if (execpath) free(execpath);
execpath = (char *)malloc((sizet)(LENGTH(newpath) + 1));
- ASSERT(execpath, newpath, NALLOC, s_execpath);
+ ASRTER(execpath, newpath, NALLOC, s_execpath);
strncpy(execpath, CHARS(newpath), LENGTH(newpath) + 1);
return retval;
}
@@ -836,7 +926,7 @@ char s_system[] = "system";
SCM lsystem(cmd)
SCM cmd;
{
- ASSERT(NIMP(cmd) && STRINGP(cmd), cmd, ARG1, s_system);
+ ASRTER(NIMP(cmd) && STRINGP(cmd), cmd, ARG1, s_system);
ignore_signals();
# ifdef AZTEC_C
cmd = MAKINUM(Execute(CHARS(cmd), 0, 0));
@@ -854,7 +944,7 @@ SCM lgetenv(nam)
SCM nam;
{
char *val;
- ASSERT(NIMP(nam) && STRINGP(nam), nam, ARG1, s_getenv);
+ ASRTER(NIMP(nam) && STRINGP(nam), nam, ARG1, s_getenv);
val = getenv(CHARS(nam));
if (!val) return BOOL_F;
return makfrom0str(val);
@@ -868,7 +958,7 @@ SCM ed(fname)
SCM fname;
{
struct dsc$descriptor_s d;
- ASSERT(NIMP(fname) && STRINGP(fname), fname, ARG1, s_ed);
+ ASRTER(NIMP(fname) && STRINGP(fname), fname, ARG1, s_ed);
d.dsc$b_dtype = DSC$K_DTYPE_T;
d.dsc$b_class = DSC$K_CLASS_S;
d.dsc$w_length = LENGTH(fname);