summaryrefslogtreecommitdiffstats
path: root/scmmain.c
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:25 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:25 -0800
commit3278b75942bdbe706f7a0fba87729bb1e935b68b (patch)
treedcad4048dfc0b38367047426b2b14501bf5ff257 /scmmain.c
parentdb04688faa20f3576257c0fe41752ec435beab9a (diff)
downloadscm-3278b75942bdbe706f7a0fba87729bb1e935b68b.tar.gz
scm-3278b75942bdbe706f7a0fba87729bb1e935b68b.zip
Import Upstream version 5d2upstream/5d2
Diffstat (limited to 'scmmain.c')
-rw-r--r--scmmain.c145
1 files changed, 145 insertions, 0 deletions
diff --git a/scmmain.c b/scmmain.c
new file mode 100644
index 0000000..3f920dd
--- /dev/null
+++ b/scmmain.c
@@ -0,0 +1,145 @@
+/* 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, 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.
+ *
+ * The exception is that, if you link the GUILE 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.
+ *
+ * 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
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, 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
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.
+ */
+
+/* "scmmain.c" main() for SCM.
+ Author: Aubrey Jaffer */
+
+#include "scm.h"
+#include "patchlvl.h"
+
+#ifndef GENERIC_NAME
+# define GENERIC_NAME "scm"
+#endif
+#ifndef INIT_GETENV
+# define INIT_GETENV "SCM_INIT_PATH"
+#endif
+
+char *scm_find_implpath(execpath)
+ char *execpath;
+{
+ char *implpath = 0;
+#ifndef nosve
+ char *getenvpath = getenv(INIT_GETENV);
+ /* fprintf(stderr, "%s=%s\n", INIT_GETENV, getenvpath); fflush(stderr); */
+ if (getenvpath) implpath = scm_cat_path(0L, getenvpath, 0L);
+ if (implpath) {/* The value of the environment variable supersedes
+ other locations, only if the file exists. */
+ implpath = scm_try_path(implpath);
+ if (!implpath) {
+ fputs("Value of "INIT_GETENV" (=\"", stderr);
+ fputs(getenvpath, stderr);
+ fputs("\") not found; Trying elsewhere\n", stderr);
+ }
+ }
+#endif
+ if (!implpath && execpath)
+ implpath = find_impl_file(execpath, GENERIC_NAME, INIT_FILE_NAME, dirsep);
+#ifdef IMPLINIT
+ if (!implpath) implpath = scm_cat_path(0L, IMPLINIT, 0L);
+#endif
+ return implpath;
+}
+char *generic_name[] = { GENERIC_NAME };
+
+int main(argc, argv)
+ int argc;
+ char **argv;
+{
+ char *script_arg = 0; /* location of SCSH style script file or 0. */
+ char *implpath = 0, **nargv;
+ int nargc, iverbose = 0, buf0stdin;
+ int freeall = 1; /* Free storage when we're done. */
+ SCM retval;
+
+/* {char ** argvv = argv; */
+/* for (;*argvv;argvv++) {fputs(*argvv,stderr); fputs(" ",stderr);} */
+/* fputs("\n",stderr);} */
+
+ if (0==argc) {argc = 1; argv = generic_name;} /* for macintosh */
+#ifndef LACK_SBRK
+ init_sbrk(); /* Do this before malloc()s. */
+#endif
+ execpath = 0; /* even when dumped */
+ if ((nargv = script_process_argv(argc, argv))) { /* SCSH style scripts */
+ script_arg = argv[2]; /* Save for scm_find_execpath() call */
+ nargc = script_count_argv(nargv);
+ }
+ else {nargv = argv; nargc = argc;}
+ /* execpath must be set to executable's path in order to use DUMP or DLD. */
+ execpath = scm_find_execpath(nargc, nargv, script_arg);
+ implpath = scm_find_implpath(execpath);
+ if (isatty(fileno(stdin)) && isatty(fileno(stdout)))
+ iverbose = (nargc <= 1) ? 2 : 1;
+ buf0stdin = init_buf0(stdin);
+ do { /* You must call scm_init_from_argv()
+ or init_scm() to initialize SCM */
+ scm_init_from_argv(nargc, nargv, script_arg, iverbose, buf0stdin);
+ init_signals(); /* signals are optional */
+ /* Now we are ready to run Scheme code! */
+ retval = scm_top_level(implpath, 0L);
+ restore_signals(); /* signals are optional */
+ /* final_scm() when you are done with SCM. */
+ if (retval) break;
+ dumped = 0;
+ if (2 <= iverbose) fputs(";RESTART\n", stderr);
+ final_scm(!0);
+ } while (!0);
+ final_scm(
+#ifdef CAREFUL_INTS
+ 1
+#else
+ freeall || (2 <= verbose)
+#endif
+ );
+ if (2 <= iverbose) fputs(";EXIT\n", stderr);
+ fflush(stderr);
+ if (implpath) free(implpath);
+ if (execpath) free(execpath);
+ execpath = 0;
+ return (int)INUM(retval);
+}
+
+/* init_user_scm() is called by the scheme procedure
+ SCM_INIT_EXTENSIONS in "Init5xx.scm" */
+void init_user_scm()
+{
+ /* Put calls to your C initialization routines here. */
+}