Import Upstream version 5d9upstream/5d9

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);