summaryrefslogtreecommitdiffstats
path: root/scm.c
diff options
context:
space:
mode:
authorJames LewisMoss <dres@debian.org>2000-03-12 09:04:17 -0500
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:26 -0800
commit8cfce36c6a4fc2e0a0ab6ef2db66a23cbe462693 (patch)
tree17427e4f777ca85990a449fe939fbae29770b346 /scm.c
parenta47af30d2f0e96afcd1f14b1984575c359faa3d6 (diff)
parent3278b75942bdbe706f7a0fba87729bb1e935b68b (diff)
downloadscm-8cfce36c6a4fc2e0a0ab6ef2db66a23cbe462693.tar.gz
scm-8cfce36c6a4fc2e0a0ab6ef2db66a23cbe462693.zip
Import Debian changes 5d2-3debian/5d2-3
scm (5d2-3) unstable frozen; urgency=low * Fix libncurses4-dev -> libncurses5-dev build depend (Closes: #58435) * Fix libreadline2-dev -> libreadline4-dev build depend. * Fix license location in copyright file (lintian warning) * Add tetex-bin as a build depend (needs makeinfo) (Closes: #53197) * Add -isp option to dpkg-gencontrol (lintian error) * Move scm to section interpreters. scm (5d2-2) unstable; urgency=low * Apply patch from upstream for bug in eval.c. (Picked up from comp.lang.scheme) * Add Build-Depends on slib, librx1g-dev, libncurses4-dev, libreadlineg2-dev. * Up standards version. * Correct description: this is an R5RS implementation now * Make sure no optimizations are done on m68k. (Closes: #52434) scm (5d2-1) unstable; urgency=low * New upstream. scm (5d1-2) unstable; urgency=low * Remove TAGS on clean (cut the diff back down to reasonable size). scm (5d1-1) unstable; urgency=low * New upstream. * move stuff to /usr/share. scm (5d0-3) unstable; urgency=low * Change scmlit call to ./scmlit call (missed one) (Fixes bugs #37455 and #35545) * Change man file permissions to 644 (fixes lintian warning) scm (5d0-2) unstable; urgency=low * Removed call to add_final in init_crs. lendwin doesn't do anything and scm was crashing when quit everytime in final_scm. * Changed copyright to reflect new source. scm (5d0-1) unstable; urgency=low * New upstream. * Changed (terms) to access "/usr/doc/copyright/GPL". * Changed regex to use -lrx scm (5c3-6) unstable; urgency=low * New maintainer.
Diffstat (limited to 'scm.c')
-rw-r--r--scm.c455
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);