tmtt
/
chez-openbsd
Archived
1
0
Fork 0
Code Issues Pull Requests Releases 1 Activity
You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.
main
v9.5.9
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from 'main'
${ noResults }
chez-openbsd/c/main.c

377 lines
14 KiB
C
Raw Permalink Blame History

/* main.c
* Copyright 1984-2017 Cisco Systems, Inc.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing, software
* distributed under the License is distributed on an "AS IS" BASIS,
* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
* See the License for the specific language governing permissions and
* limitations under the License.
*/
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#include "scheme.h"
#include "config.h"
/****
CUSTOM_INIT may be defined as a function with the signature shown to
perform boot-time initialization, e.g., registering foreign symbols.
****/
#ifndef CUSTOM_INIT
#define CUSTOM_INIT ((void (*)(void))0)
#endif /* CUSTOM_INIT */
/****
ABNORMAL_EXIT may be defined as a function with the signature shown to
take some action, such as printing a special error message or performing
a nonlocal exit with longjmp, when the Scheme system exits abnormally,
i.e., when an unrecoverable error occurs. If left null, the default
is to call exit(1).
****/
#ifndef ABNORMAL_EXIT
#define ABNORMAL_EXIT ((void (*)(void))0)
#endif /* ABNORMAL_EXIT */
#ifndef SCHEME_SCRIPT
#define SCHEME_SCRIPT "scheme-script"
#endif
static const char *path_last(const char *p) {
const char *s;
#ifdef WIN32
char c;
if ((c = *p) >= 'a' && c <= 'z' || c >= 'A' && c <= 'Z')
if (*(p + 1) == ':')
p += 2;
for (s = p; *s != 0; s += 1)
if ((c = *s) == '/' || c == '\\') p = ++s;
#else /* WIN32 */
for (s = p; *s != 0; s += 1) if (*s == '/') p = ++s;
#endif /* WIN32 */
return p;
}
#if defined(WIN32) && !defined(__MINGW32__)
#define GETENV Sgetenv
#define GETENV_FREE free
int wmain(int argc, wchar_t* wargv[], wchar_t* wenvp[]) {
const char** argv = (char**)malloc((argc + 1) * sizeof(char*));
int i;
for (i = 0; i < argc; i++) {
wchar_t* warg = wargv[i];
if (NULL == (argv[i] = Swide_to_utf8(warg))) {
fprintf_s(stderr, "Invalid argument: %S\n", warg);
exit(1);
}
}
argv[argc] = NULL;
#else /* WIN32 */
#define GETENV getenv
#define GETENV_FREE (void)
int main(int argc, const char *argv[]) {
#endif /* WIN32 */
int n, new_argc = 1;
#ifdef SAVEDHEAPS
int compact = 1, savefile_level = 0;
const char *savefile = (char *)0;
#endif /* SAVEDHEAPS */
const char *execpath = argv[0];
const char *scriptfile = (char *)0;
const char *programfile = (char *)0;
const char *libdirs = (char *)0;
const char *libexts = (char *)0;
int status;
const char *arg;
int quiet = 0;
int eoc = 0;
int optlevel = 0;
int debug_on_exception = 0;
int import_notify = 0;
int compile_imported_libraries = 0;
#ifdef FEATURE_EXPEDITOR
int expeditor_enable = 1;
const char *expeditor_history_file = ""; /* use "" for default location */
#endif /* FEATURE_EXPEDITOR */
if (strcmp(Skernel_version(), VERSION) != 0) {
(void) fprintf(stderr, "unexpected shared library version %s for %s version %s\n", Skernel_version(), execpath, VERSION);
exit(1);
}
Sscheme_init(ABNORMAL_EXIT);
if (strcmp(path_last(execpath), SCHEME_SCRIPT) == 0) {
if (argc < 2) {
(void) fprintf(stderr,"%s requires program-path argument\n", execpath);
exit(1);
}
argv[0] = programfile = argv[1];
n = 1;
while (++n < argc) argv[new_argc++] = argv[n];
} else {
/* process command-line arguments, registering boot and heap files */
for (n = 1; n < argc; n += 1) {
arg = argv[n];
if (strcmp(arg,"--") == 0) {
while (++n < argc) argv[new_argc++] = argv[n];
} else if (strcmp(arg,"-b") == 0 || strcmp(arg,"--boot") == 0) {
if (++n == argc) {
(void) fprintf(stderr,"%s requires argument\n", arg);
exit(1);
}
Sregister_boot_file(argv[n]);
} else if (strcmp(arg,"--eedisable") == 0) {
#ifdef FEATURE_EXPEDITOR
expeditor_enable = 0;
#endif /* FEATURE_EXPEDITOR */
} else if (strcmp(arg,"--eehistory") == 0) {
if (++n == argc) {
(void) fprintf(stderr,"%s requires argument\n", arg);
exit(1);
}
#ifdef FEATURE_EXPEDITOR
if (strcmp(argv[n], "off") == 0)
expeditor_history_file = (char *)0;
else
expeditor_history_file = argv[n];
#endif /* FEATURE_EXPEDITOR */
} else if (strcmp(arg,"-q") == 0 || strcmp(arg,"--quiet") == 0) {
quiet = 1;
} else if (strcmp(arg,"--retain-static-relocation") == 0) {
Sretain_static_relocation();
} else if (strcmp(arg,"--enable-object-counts") == 0) {
eoc = 1;
#ifdef SAVEDHEAPS
} else if (strcmp(arg,"-c") == 0 || strcmp(arg,"--compact") == 0) {
compact = !compact;
} else if (strcmp(arg,"-h") == 0 || strcmp(arg,"--heap") == 0) {
if (++n == argc) {
(void) fprintf(stderr,"%s requires argument\n", arg);
exit(1);
}
Sregister_heap_file(argv[n]);
} else if (strncmp(arg,"-s",2) == 0 &&
(savefile_level = -2,
*(arg+2) == 0 ||
*(arg+3) == 0 &&
((savefile_level = *(arg+2) - '+' - 1) == -1 ||
(savefile_level = *(arg+2) - '0') >= 0 &&
savefile_level <= 9)) ||
strncmp(arg,"--saveheap",10) == 0 &&
(savefile_level = -2,
*(arg+10) == 0 ||
*(arg+11) == 0 &&
((savefile_level = *(arg+2) - '+' - 1) == -1 ||
(savefile_level = *(arg+10) - '0') >= 0 &&
savefile_level <= 9))) {
if (++n == argc) {
(void) fprintf(stderr,"%s requires argument\n", arg);
exit(1);
}
savefile = argv[n];
#else /* SAVEDHEAPS */
} else if (strcmp(arg,"-c") == 0 || strcmp(arg,"--compact") == 0) {
fprintf(stderr, "-c and --compact options are not presently supported\n");
exit(1);
} else if (strcmp(arg,"-h") == 0 || strcmp(arg,"--heap") == 0) {
fprintf(stderr, "-h and --heap options are not presently supported\n");
exit(1);
} else if (strncmp(arg,"-s",2) == 0 || strncmp(arg,"--saveheap",10) == 0) {
fprintf(stderr, "-s and --saveheap options are not presently supported\n");
exit(1);
#endif /* SAVEDHEAPS */
} else if (strcmp(arg,"--script") == 0) {
if (++n == argc) {
(void) fprintf(stderr,"%s requires argument\n", arg);
exit(1);
}
scriptfile = argv[n];
while (++n < argc) argv[new_argc++] = argv[n];
} else if (strcmp(arg,"--optimize-level") == 0) {
const char *nextarg;
if (++n == argc) {
(void) fprintf(stderr,"%s requires argument\n", arg);
exit(1);
}
nextarg = argv[n];
if (strcmp(nextarg,"0") == 0)
optlevel = 0;
else if (strcmp(nextarg,"1") == 0)
optlevel = 1;
else if (strcmp(nextarg,"2") == 0)
optlevel = 2;
else if (strcmp(nextarg,"3") == 0)
optlevel = 3;
else {
(void) fprintf(stderr,"invalid optimize-level %s\n", nextarg);
exit(1);
}
} else if (strcmp(arg,"--debug-on-exception") == 0) {
debug_on_exception = 1;
} else if (strcmp(arg,"--import-notify") == 0) {
import_notify = 1;
} else if (strcmp(arg,"--libexts") == 0) {
if (++n == argc) {
(void) fprintf(stderr,"%s requires argument\n", arg);
exit(1);
}
libexts = argv[n];
} else if (strcmp(arg,"--libdirs") == 0) {
if (++n == argc) {
(void) fprintf(stderr,"%s requires argument\n", arg);
exit(1);
}
libdirs = argv[n];
} else if (strcmp(arg,"--compile-imported-libraries") == 0) {
compile_imported_libraries = 1;
} else if (strcmp(arg,"--program") == 0) {
if (++n == argc) {
(void) fprintf(stderr,"%s requires argument\n", arg);
exit(1);
}
programfile = argv[n];
while (++n < argc) argv[new_argc++] = argv[n];
} else if (strcmp(arg,"--help") == 0) {
fprintf(stderr,"usage: %s [options and files]\n", execpath);
fprintf(stderr,"options:\n");
fprintf(stderr," -q, --quiet suppress greeting and prompt\n");
fprintf(stderr," --script <path> run as shell script\n");
fprintf(stderr," --program <path> run rnrs program as shell script\n");
#ifdef WIN32
#define sep ";"
#else
#define sep ":"
#endif
fprintf(stderr," --libdirs <dir>%s... set library directories\n", sep);
fprintf(stderr," --libexts <ext>%s... set library extensions\n", sep);
fprintf(stderr," --compile-imported-libraries compile libraries before loading\n");
fprintf(stderr," --import-notify enable import search messages\n");
fprintf(stderr," --optimize-level <0 | 1 | 2 | 3> set optimize-level\n");
fprintf(stderr," --debug-on-exception on uncaught exception, call debug\n");
fprintf(stderr," --eedisable disable expression editor\n");
fprintf(stderr," --eehistory <off | path> expression-editor history file\n");
fprintf(stderr," --enable-object-counts have collector maintain object counts\n");
fprintf(stderr," --retain-static-relocation keep reloc info for compute-size, etc.\n");
fprintf(stderr," -b <path>, --boot <path> load boot file\n");
// fprintf(stderr," -c, --compact toggle compaction flag\n");
// fprintf(stderr," -h <path>, --heap <path> load heap file\n");
// fprintf(stderr," -s[<n>] <path>, --saveheap[<n>] <path> save heap file\n");
fprintf(stderr," --verbose trace boot/heap search process\n");
fprintf(stderr," --version print version and exit\n");
fprintf(stderr," --help print help and exit\n");
fprintf(stderr," -- pass through remaining args\n");
exit(0);
} else if (strcmp(arg,"--verbose") == 0) {
Sset_verbose(1);
} else if (strcmp(arg,"--version") == 0) {
fprintf(stderr,"%s\n", VERSION);
exit(0);
} else {
argv[new_argc++] = arg;
}
}
}
/* must call Sbuild_heap after registering boot and heap files.
* Sbuild_heap() completes the initialization of the Scheme system
* and loads the boot or heap files. If no boot or heap files have
* been registered, the first argument to Sbuild_heap must be a
* non-null path string; in this case, Sbuild_heap looks for
* a heap or boot file named <name>.boot, where <name> is the last
* component of the path. If no heap files are loaded and
* CUSTOM_INIT is non-null, Sbuild_heap calls CUSTOM_INIT just
* prior to loading the boot file(s). */
Sbuild_heap(execpath, CUSTOM_INIT);
#define CALL0(who) Scall0(Stop_level_value(Sstring_to_symbol(who)))
#define CALL1(who, arg) Scall1(Stop_level_value(Sstring_to_symbol(who)), arg)
#ifdef FunCRepl
{
ptr p;
for (;;) {
CALL1("display", Sstring("* "));
p = CALL0("read");
if (Seof_objectp(p)) break;
p = CALL1("eval", p);
if (p != Svoid) CALL1("pretty-print", p);
}
CALL0("newline");
status = 0;
}
#else /* FunCRepl */
if (quiet) {
CALL1("suppress-greeting", Strue);
CALL1("waiter-prompt-string", Sstring(""));
}
if (eoc) {
CALL1("enable-object-counts", Strue);
}
if (optlevel != 0) {
CALL1("optimize-level", Sinteger(optlevel));
}
if (debug_on_exception != 0) {
CALL1("debug-on-exception", Strue);
}
if (import_notify != 0) {
CALL1("import-notify", Strue);
}
if (libdirs == 0) {
char *cslibdirs = GETENV("CHEZSCHEMELIBDIRS");
if (cslibdirs != 0) {
CALL1("library-directories", Sstring_utf8(cslibdirs, -1));
GETENV_FREE(cslibdirs);
}
} else {
CALL1("library-directories", Sstring_utf8(libdirs, -1));
}
if (libexts == 0) {
char *cslibexts = GETENV("CHEZSCHEMELIBEXTS");
if (cslibexts != 0) {
CALL1("library-extensions", Sstring_utf8(cslibexts, -1));
GETENV_FREE(cslibexts);
}
} else {
CALL1("library-extensions", Sstring_utf8(libexts, -1));
}
if (compile_imported_libraries != 0) {
CALL1("compile-imported-libraries", Strue);
}
#ifdef FEATURE_EXPEDITOR
/* Senable_expeditor must be called before Scheme_start/Scheme_script (if at all) */
if (!quiet && expeditor_enable) Senable_expeditor(expeditor_history_file);
#endif /* FEATURE_EXPEDITOR */
if (scriptfile != (char *)0)
/* Sscheme_script invokes the value of the scheme-script parameter */
status = Sscheme_script(scriptfile, new_argc, argv);
else if (programfile != (char *)0)
/* Sscheme_program invokes the value of the scheme-program parameter */
status = Sscheme_program(programfile, new_argc, argv);
else {
/* Sscheme_start invokes the value of the scheme-start parameter */
status = Sscheme_start(new_argc, argv);
}
#endif /* FunCRepl */
#ifdef SAVEDHEAPS
if (status == 0 && savefile != (char *)0) {
if (compact) Scompact_heap();
Ssave_heap(savefile, savefile_level);
}
#endif /* SAVEDHEAPS */
/* must call Scheme_deinit after saving the heap and before exiting */
Sscheme_deinit();
exit(status);
}
Reference in New Issue View Git Blame Copy Permalink