Import Upstream version 5d2upstream/5d2

1 files changed, 205 insertions, 250 deletions

diff --git a/scm.c b/scm.c
index fc26a6f..d5c1755 100644
--- a/scm.c
+++ b/scm.c
@@ -1,18 +1,18 @@
-/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
- * 
+/* Copyright (C) 1990-1999 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
  * the Free Software Foundation; either version 2, or (at your option)
  * any later version.
- * 
+ *
  * This program is distributed in the hope that it will be useful,
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  * GNU General Public License for more details.
- * 
+ *
  * You should have received a copy of the GNU General Public License
  * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ * 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.
@@ -36,10 +36,10 @@
  *
  * If you write modifications of your own for GUILE, it is your choice
  * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.  
+ * If you do not wish that, delete this exception notice.
  */
 
-/* "scm.c" top level and interrupt code.
+/* "scm.c" Initialization and interrupt code.
    Author: Aubrey Jaffer */
 
 #include <signal.h>
@@ -50,6 +50,8 @@
 # include <io.h>
 #endif
 
+/* See scm.h for definition of P */
+
 #ifndef STDC_HEADERS
 	int alarm P((unsigned int));
 	int pause P((void));
@@ -60,9 +62,13 @@
 # ifdef SVR4
 #  include <unistd.h>
 # endif
+# ifdef __amigados__
+#  include <unistd.h>
+# endif
 #endif
 
-void	final_repl P((void));
+void	init_sbrk P((void));
+
 void	init_dynl P((void));
 void	init_edline P((void));
 void	init_eval P((void));
@@ -86,12 +92,11 @@ void	init_time P((void));
 void	init_types P((void));
 void	init_unif P((void));
 void	reset_time P((void));
+void	final_repl P((void));
 
 void init_banner()
 {
-  fputs("SCM version ", stderr);
-  fputs(SCMVERSION, stderr);
-  fputs(", Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997 \
+  fputs("SCM version "SCMVERSION", Copyright (C) 1990-1999 \
 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\
@@ -101,9 +106,10 @@ under certain conditions; type `(terms)' for details.\n", stderr);
 SCM scm_init_extensions()
 {
 #ifdef COMPILED_INITS
-    COMPILED_INITS;		/* initialize statically linked add-ons */
+  COMPILED_INITS;		/* initialize statically linked add-ons */
 #endif
-    return UNSPECIFIED;
+  init_user_scm();
+  return UNSPECIFIED;
 }
 
 #if (__TURBOC__==1)
@@ -141,24 +147,25 @@ SCM scm_init_extensions()
 /* PROF_SIGNAL appears below because it is the last signal
    defined in scm.h and in errmsgs in repl.c  */
 static struct {
-  int signo; SIGRETTYPE (*osig)(); SIGRETTYPE (*nsig)(); 
+  int signo; SIGRETTYPE (*osig)(); SIGRETTYPE (*nsig)();
 } sigdesc[PROF_SIGNAL - SIGNAL_BASE + 1];
 void process_signals()
 {
-  int i = NUM_SIGNALS;
-  unsigned long mask = (1L << (i-1));
+  int i, n;
+  unsigned long mask = 1L;
   if (output_deferred) {
     output_deferred = 0;
     lflush(sys_errp);
   }
-  if (SIG_deferred)
-    while (i--) {
-      if (SIG_deferred & mask) {
-	SIG_deferred &= ~mask;
-	handle_it(i + SIGNAL_BASE);
-      }      
-      mask >>= 1;
+  for (n = 0; SIG_deferred && n < NUM_SIGNALS; n++) {
+    if (SIG_deferred & mask) {
+      i = n + SIGNAL_BASE;
+      SIG_deferred &= ~mask;
+      if (i != handle_it(i))
+	wta(UNDEFINED, (char *)i, "");
     }
+    mask <<= 1;
+  }
   deferred_proc = 0;
 }
 static char s_unksig[] = "unknown signal";
@@ -189,7 +196,7 @@ static SIGRETTYPE scmable_signal(sig)
     sigset_t set;
     sigemptyset(&set);
     sigaddset(&set, sig);
-    sigprocmask(SIG_UNBLOCK, &set, 0);
+    sigprocmask(SIG_UNBLOCK, &set, 0L);
 #endif
     SIG_deferred &= ~(1L << i);
     i += SIGNAL_BASE;
@@ -213,12 +220,12 @@ static SIGRETTYPE scmable_signal(sig)
 #ifdef atarist
 # undef SIGALRM			/* only available via MiNT libs */
 #endif
-#ifdef GO32
-# undef SIGALRM
-#endif
 #ifdef __HIGHC__
 # undef SIGALRM
 #endif
+#ifdef LACK_SETITIMER
+# undef SIGPROF
+#endif
 #ifdef SIGALRM
 static char s_alarm[] = "alarm";
 SCM lalarm(i)
@@ -231,26 +238,53 @@ SCM lalarm(i)
 }
 # ifdef SIGPROF
 #  include <sys/time.h>
-static char s_proftimer[] = "profile-timer";
-SCM scm_proftimer(interval)
-     SCM interval;
+static char s_setitimer[] = "setitimer";
+static SCM setitimer_iv[3];
+/* VALUE and INTERVAL are milliseconds */
+SCM scm_setitimer(which, value, interval)
+     SCM which, value, interval;
 {
   struct itimerval tval, oval;
   int w;
-  if (UNBNDP(interval))
-    SYSCALL(w = getitimer(ITIMER_PROF, &oval););
+#  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;
+  }
+#  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, ARG2, s_proftimer);
+    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;
-    tval.it_value.tv_sec = tval.it_interval.tv_sec;
-    tval.it_value.tv_usec = tval.it_interval.tv_usec;
-    SYSCALL(w = setitimer(ITIMER_PROF, &tval, &oval););
+    SYSCALL(w = setitimer(w, &tval, &oval););
   }
   if (w) return BOOL_F;
-  return MAKINUM(oval.it_interval.tv_usec/1000 + 
-		 oval.it_interval.tv_sec*1000);
+  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
@@ -290,34 +324,32 @@ SCM l_sleep(i)
 #endif
 
 #ifndef _WIN32
-# ifndef GO32
-#  ifndef sun
-#   ifndef THINK_C
+# ifndef sun
+#  ifndef THINK_C
 /* 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 vms
   return MAKINUM(gsignal((int)INUM(sig)));
-#    else
-#     ifndef __TURBOC__
-#      ifdef STDC_HEADERS
-#       ifndef __MWERKS__
+#   else
+#    ifndef __TURBOC__
+#     ifdef STDC_HEADERS
+#      ifndef __MWERKS__
   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
+#    else
+  return raise((int)INUM(sig)) ? BOOL_F : BOOL_T;
 #    endif
-}
 #   endif
+}
 #  endif
 # endif
 #endif
@@ -346,9 +378,6 @@ static SIGRETTYPE (*oldpipe) ();
 #endif
 
 int dumped = 0;			/* Is this an invocation of unexec exe? */
-#ifndef LACK_SBRK
-long scm_init_brk, scm_dumped_brk;
-#endif
 
 #ifdef SHORT_ALIGN
 typedef short STACKITEM;
@@ -358,7 +387,7 @@ typedef long STACKITEM;
 /* See scm.h for definition of P */
 void  init_storage P((STACKITEM *stack_start_ptr, long init_heap_size));
 
-void init_scm( iverbose, buf0stdin, init_heap_size )
+void init_scm(iverbose, buf0stdin, init_heap_size)
      int iverbose;
      int buf0stdin;
      long init_heap_size;
@@ -370,8 +399,8 @@ void init_scm( iverbose, buf0stdin, init_heap_size )
     init_tables();
     init_storage(&i, init_heap_size); /* CONT(rootcont)->stkbse gets set here */
   }
-  if (buf0stdin) CAR(def_inp) |= BUF0;
-  else CAR(def_inp) &= ~BUF0;
+  if (buf0stdin) SCM_PORTFLAGS(def_inp) |= BUF0;
+  else SCM_PORTFLAGS(def_inp) &= ~BUF0;
   if (!dumped) {
     init_features();
     init_subrs();
@@ -379,11 +408,18 @@ void init_scm( iverbose, buf0stdin, init_heap_size )
     init_scl();
     init_eval();
     init_time();
-    init_repl( iverbose );
+    init_repl(iverbose);
     init_unif();
   }
-  else {
-    reset_time();
+  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
   }
 }
 
@@ -419,6 +455,9 @@ void init_signals()
 # ifdef SIGPROF
   init_sig1(PROF_SIGNAL, SIGPROF, scmable_signal);
 # endif
+# ifdef SIGVTALRM
+  init_sig1(VTALRM_SIGNAL, SIGVTALRM, scmable_signal);
+# endif
 #endif
 #ifdef SIGPIPE
   oldpipe = signal(SIGPIPE, SIG_IGN);
@@ -461,7 +500,7 @@ void ignore_signals()
   {
     sigset_t set;
     sigfillset(&set);
-    sigprocmask(SIG_UNBLOCK, &set, 0);
+    sigprocmask(SIG_UNBLOCK, &set, 0L);
   }
 #endif
 }
@@ -469,7 +508,7 @@ void ignore_signals()
 void unignore_signals()
 {
   int i = NUM_SIGNALS;
-  while (i--) 
+  while (i--)
     if (sigdesc[i].signo)
       signal(sigdesc[i].signo, sigdesc[i].nsig);
 #ifdef ultrix
@@ -482,7 +521,7 @@ void unignore_signals()
 
 void restore_signals()
 {
-  int i = NUM_SIGNALS;
+  int i;
 #ifdef ultrix
   siginterrupt(SIGINT, 0);
   siginterrupt(SIGALRM, 0);
@@ -490,75 +529,65 @@ void restore_signals()
   siginterrupt(SIGPIPE, 0);
 #endif /* ultrix */
 #ifdef SIGALRM
+# ifndef SIGPROF
   alarm(0);			/* kill any pending ALRM interrupts */
-# ifdef SIGPROF
-  scm_proftimer(BOOL_F);	/* Turn off interval timer interrupt */
+# else
+  i = sizeof(setitimer_iv)/sizeof(SCM);
+  while (i--)
+    scm_setitimer(setitimer_iv[i], BOOL_F, BOOL_F);
 # endif
 #endif
+  i = NUM_SIGNALS;
   while (i--)
-    if (sigdesc[i].signo) 
+    if (sigdesc[i].signo)
       signal(sigdesc[i].signo, sigdesc[i].osig);
 #ifdef SIGPIPE
   oldpipe = signal(SIGPIPE, SIG_IGN);
 #endif
 }
-int run_scm(argc, argv, iverbose, buf0stdin, initpath)
+
+void scm_init_from_argv(argc, argv, script_arg, iverbose, buf0stdin)
      int argc;
      char **argv;
+     char *script_arg;
      int iverbose;
      int buf0stdin;
-     char *initpath;
 {
-  SCM i;
-  do {
-    i = 0L;
-    if ((2 <= argc) && argv[1] && (0==strncmp("-a", argv[1], 2))) {
-      char *str = (0==argv[1][2] && 3 <= argc && argv[2]) ?argv[2]:&argv[1][2];
-      do {
-	switch (*str) {
-	case DIGITS:
-	  i = i * 10 + (*str - '0');
-	  if (i <= 10000L) continue; /* the size limit should match Init.scm */
-	default:
-	  i = 0L;
-	}
-	break;
-      } while (* ++str);
-    }
-    init_scm(iverbose, buf0stdin, (0 >= i) ? 0L : 1024L * i); /* size in Kb */
-    progargs = EOL;
-    progargs = makfromstrs(argc, argv);
-
-#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
-    }
-    init_signals();
-    i = repl_driver(initpath);
-    restore_signals();
+  long i = 0L;
+  if ((2 <= argc) && argv[1] && (0==strncmp("-a", argv[1], 2))) {
+    char *str = (0==argv[1][2] && 3 <= argc && argv[2]) ?argv[2]:&argv[1][2];
+    do {
+      switch (*str) {
+      case DIGITS:
+	i = i * 10 + (*str - '0');
+	if (i <= 10000L) continue; /* the size limit should match Init.scm */
+      default:
+	i = 0L;
+      }
+      break;
+    } while (* ++str);
+  }
+  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);
+}
+void final_scm(freeall)
+     int freeall;
+{
 #ifdef TICKS
-    ticken = 0;
+  ticken = 0;
 #endif
 #ifdef FINALS
-    FINALS;			/* call shutdown of extensions files */
+  FINALS;			/* call shutdown of extensions files */
 #endif /* for compatability with older modules */
-    /* call finalization of user extensions */
-    while (num_finals--) (finals[num_finals])();
-    final_repl();
-    free_storage();		/* free all allocated memory */
-    if (i) break;
-    dumped = 0;
-    if (2 <= iverbose) fputs(";RESTART\n", stderr);
-  } while (!0);
-  if (2 <= iverbose) fputs(";EXIT\n", stderr);
-  fflush(stderr);
-  return (int)INUM(i);
+  /* call finalization of user extensions */
+  {
+    int k = num_finals;
+    while (k--) (finals[k])();
+  }
+  final_repl();
+  if (freeall) free_storage();	/* free all allocated memory */
 }
 
 #ifdef __CYGWIN32__
@@ -623,162 +652,84 @@ int run_scm(argc, argv, iverbose, buf0stdin, initpath)
 #ifdef nosve
 # define DIRSEP "."
 #endif
+#ifdef __amigados__
+# define SYSTNAME "amiga"
+# define DIRSEP "/"
+#endif
+const char dirsep[] = DIRSEP;
 
 SCM softtype()
 {
 #ifdef nosve
-  return CAR(intern("nosve", 5));
+  return CAR(sysintern("nosve", UNDEFINED));
 #else
-  return CAR(intern(SYSTNAME, sizeof SYSTNAME/sizeof(char) -1));
+  return CAR(sysintern(SYSTNAME, UNDEFINED));
 #endif
 }
 
-/* The argument giving the location of a script file, or NULL. */
-static char *script_arg = 0;
-/* The original argv[0], used to find executable. */
-static char *arg0 = 0;
-char *execpath = 0;
-
-#ifndef RTL
-
-# ifndef DIRSEP
-#  define DIRSEP "/"
-# endif
-# ifndef GENERIC_NAME
-#  define GENERIC_NAME "scm"
-# endif
-
-int main(argc, argv)
-     int argc;
-     char **argv;
+int init_buf0(inport)
+     FILE *inport;
 {
-  int retval, buf0stdin = 0, nargc;
-  char *getenvpath, *implpath = 0, **nargv;
-# ifdef macintosh
-  char *foo[] = { "scm" };
-  if (argc == 0) {
-    argc = 1;
-    argv = foo;
-  }
-# endif
-  execpath = 0;
-  arg0 = argv[0];
-  /*{
-    char ** argvv = argv;
-    for (;*argvv;argvv++) {
-      fputs(*argvv,stderr);
-      fputs(" ",stderr);
-    }
-    fputs("\n",stderr);
-    }*/
-  /* The following applies only to SCSH style scripts, execpath
-     does not (cannot?) work properly for simple #! scripts */
-  if ((nargv = script_process_argv(argc, argv))) {
-    script_arg = argv[2];
-    nargc = script_count_argv(nargv);
-  }
-  else {
-    nargv = argv;
-    nargc = argc;
-  }
-# ifndef LACK_SBRK
-  if (dumped)
-    scm_dumped_brk = (long)sbrk(0);
-  else
-    scm_init_brk = (long)sbrk(0);
-# endif
-  if (!dumped) {
-# ifndef nosve
-    getenvpath = getenv("SCM_INIT_PATH");
-    if (getenvpath) implpath = scm_cat_path(0L, getenvpath, 0L);
-    if (implpath) {
-      /* The value of the environment variable supersedes other
-	 locations, as long as the file exists. */
-      implpath = scm_try_path(implpath);
-      if (!implpath) {
-	fputs("Value of SCM_INIT_PATH (=\"", stderr);
-	fputs(getenvpath, stderr);
-	fputs("\") not found; Trying elsewhere\n", stderr);
-      }
-    }
-# endif
-    if (!implpath) {
-      execpath = scm_find_executable();
-      if (execpath) {
-	implpath = scm_find_impl_file(execpath,
-				      GENERIC_NAME, INIT_FILE_NAME, DIRSEP);
-	/* fprintf(stderr, "scm_find_impl_file returned \"%s\"\n", implpath); fflush(stderr); */
-      }
-    }
-# ifdef IMPLINIT
-    /* Should IMPLINIT somehow be visible if we've been dumped? */
-    if (!implpath) implpath = scm_cat_path(0L, IMPLINIT, 0L);
-# endif
-  }
-# ifndef GO32
-  if (isatty(fileno(stdin))) {
-    buf0stdin = !0;		/* stdin gets marked BUF0 in init_scm() */
-#  ifndef NOSETBUF
-#   ifndef _DCC
-#    ifndef ultrix
-#     ifndef __WATCOMC__
-#      ifndef macintosh
-#       if (__TURBOC__ != 1)
-#        ifndef _Windows
-    setbuf(stdin, 0);		/* Often setbuf isn't actually required */
-#        endif
-#       endif
+  if (isatty(fileno(inport))) {
+#ifndef NOSETBUF
+# ifndef _DCC
+#  ifndef ultrix
+#   ifndef __WATCOMC__
+#    ifndef macintosh
+#     if (__TURBOC__ != 1)
+#      ifndef _Windows
+    setbuf(inport, 0L);		/* Often setbuf isn't actually required */
 #      endif
 #     endif
 #    endif
 #   endif
-  }
 #  endif
 # endif
-  retval = run_scm(nargc, nargv,
-		   (isatty(fileno(stdin)) && isatty(fileno(stdout)))
-		   ? (nargc <= 1) ? 2 : 1 : 0,
-		   buf0stdin,
-		   implpath ? implpath : "");
-  if (implpath) free(implpath);
+    return !0;			/* stdin gets marked BUF0 in init_scm() */
+  }
+#endif
+  return 0;
+}
+
+char *execpath = 0;
+char s_no_execpath[] = "no execpath";
+#define s_execpath (s_no_execpath+3)
+SCM scm_execpath(newpath)
+     SCM newpath;
+{
+  SCM retval = execpath ? makfrom0str(execpath) : BOOL_F;
+  if (UNBNDP(newpath))
+    return retval;
+  if (FALSEP(newpath)) {
+    if (execpath) free(execpath);
+    execpath = 0;
+    return retval;
+  }
+  ASSERT(NIMP(newpath) && STRINGP(newpath), newpath, ARG1, s_execpath);
   if (execpath) free(execpath);
-  execpath = 0;
+  execpath = (char *)malloc((sizet)(LENGTH(newpath) + 1));
+  ASSERT(execpath, newpath, NALLOC, s_execpath);
+  strncpy(execpath, CHARS(newpath), LENGTH(newpath) + 1);
   return retval;
 }
-#endif
-
-char *scm_find_executable()
+char *scm_find_execpath(argc, argv, script_arg)
+     int argc;
+     char **argv;
+     char *script_arg;
 {
-  char *execpath = 0;
+  char *exepath = 0;
 #ifndef macintosh
 # ifdef unix
 #  ifndef MSDOS
-  if (script_arg)
-    execpath = script_find_executable(script_arg);
+  if (script_arg) exepath = script_find_executable(script_arg);
 #  endif
 # endif
-  if (!execpath && arg0) execpath = dld_find_executable(arg0);
-  /* fprintf(stderr, "scm_find_executable: execpath = %s\n", execpath); fflush(stderr); */
+  if (!exepath && argv[0]) exepath = dld_find_executable(argv[0]);
+/*fprintf(stderr, "scm_find_execpath: argv[0] = %s; script_arg = %s; exepath = %s\n", argv[0], script_arg, exepath); fflush(stderr); */
 #endif
-  return execpath;
-}
-
-/* Initialized in repl.c */
-char s_scm_find_impl[] = "find-init-file";
-SCM scm_find_impl(execpath)
-     SCM execpath;
-{
-  SCM res;
-  char *implpath = 0;
-  ASSERT(NIMP(execpath) && STRINGP(execpath), execpath, ARG1, "find-init-file");
-  implpath = scm_find_impl_file(CHARS(execpath),
-				GENERIC_NAME, INIT_FILE_NAME, DIRSEP);
-  res = (implpath ? makfrom0str(implpath) : BOOL_F);
-  if (implpath) free(implpath);
-  return res;
+  return exepath;
 }
 
-
 #ifndef _Windows
 char s_system[] = "system";
 SCM lsystem(cmd)
@@ -859,20 +810,15 @@ static iproc subr1s[] = {
 #endif
 #ifdef SIGALRM
 	{s_alarm, lalarm},
-# ifdef SIGPROF
-	{s_proftimer, scm_proftimer},
-# endif
 #endif
 #ifndef AMIGA
 # ifndef _Windows
 	{s_sleep, l_sleep},
 # endif
 #endif
-#ifndef GO32
-# ifndef sun
-#  ifndef _WIN32
+#ifndef sun
+# ifndef _WIN32
 	{s_raise, l_raise},
-#  endif
 # endif
 #endif
 	{0, 0}};
@@ -881,13 +827,22 @@ SCM *loc_features;
 void add_feature(str)
      char* str;
 {
-  *loc_features = cons(CAR(intern(str, strlen(str))), *loc_features);
+  *loc_features = cons(CAR(sysintern(str, UNDEFINED)), *loc_features);
 }
 void init_features()
 {
   loc_features = &CDR(sysintern("*features*", EOL));
   init_iprocs(subr0s, tc7_subr_0);
   init_iprocs(subr1s, tc7_subr_1);
+  make_subr(s_execpath, tc7_subr_1o, scm_execpath);
+#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));
+# endif
+#endif
 #ifdef TICKS
   loc_tick_signal = &CDR(sysintern("ticks-interrupt", UNDEFINED));
   make_subr(s_ticks, tc7_subr_1o, lticks);