#include #include #include #include #include #include #include #include #include #include #include "scheme.h" #define BOOT_ENV_NULL 0 #define BOOT_ENV_R7RS 1 #define BOOT_ENV_UNSTABLE 2 static value_t get_features_list(void) { static struct accum acc; static int initialized; if (!initialized) { initialized = 1; accum_init(&acc); #ifdef BITS64 accum_elt(&acc, symbol("64-bit")); #endif #if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ accum_elt(&acc, symbol("big-endian")); #endif #if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ accum_elt(&acc, symbol("little-endian")); #endif accum_elt(&acc, symbol("r7rs")); } return acc.list; } static value_t build_c_type_bits_list(void) { struct accum acc; accum_init(&acc); accum_name_value1(&acc, "int", fixnum(sizeof(int) * CHAR_BIT)); accum_name_value1(&acc, "long", fixnum(sizeof(long) * CHAR_BIT)); accum_name_value1(&acc, "float", fixnum(sizeof(float) * CHAR_BIT)); accum_name_value1(&acc, "double", fixnum(sizeof(double) * CHAR_BIT)); accum_name_value1(&acc, "pointer", fixnum(sizeof(void *) * CHAR_BIT)); accum_name_value1(&acc, "size_t", fixnum(sizeof(size_t) * CHAR_BIT)); accum_name_value1(&acc, "value_t", fixnum(sizeof(value_t) * CHAR_BIT)); return acc.list; } static value_t build_platform_list(void) { struct accum acc; const char *kernel; const char *userland; const char *computer; const char *endian; // kernel = userland = computer = endian = "unknown"; #ifdef __FreeBSD__ kernel = userland = "freebsd"; #endif #ifdef __FreeBSD_kernel__ kernel = "freebsd"; #endif #ifdef __GLIBC__ userland = "gnu"; #endif #ifdef __OpenBSD__ userland = kernel = "openbsd"; #endif #ifdef __NetBSD__ userland = kernel = "netbsd"; #endif #ifdef __DragonFly__ userland = kernel = "dragonfly"; #endif #ifdef __sun userland = kernel = "solaris"; #endif #ifdef __minix userland = kernel = "minix"; #endif #ifdef __HAIKU__ userland = "beos"; kernel = "haiku"; #endif #ifdef __APPLE__ userland = kernel = "darwin"; #endif #ifdef _WIN32 kernel = userland = "windows-nt"; #endif #ifdef __i386 computer = "x86"; #endif #ifdef _M_IX86 computer = "x86"; #endif #ifdef __X86__ computer = "x86"; #endif #ifdef __I86__ computer = "x86"; #endif #ifdef __amd64 computer = "x86-64"; #endif #ifdef __x86_64 computer = "x86-64"; #endif #ifdef _M_AMD64 computer = "x86-64"; #endif #ifdef __ppc__ computer = "ppc"; #endif #ifdef _M_PPC computer = "ppc"; #endif #ifdef __PPC64__ computer = "ppc-64"; #endif #ifdef __mips64__ computer = "mips-64"; #endif #ifdef __arm__ computer = "arm"; #endif #ifdef __aarch64__ computer = "arm"; #endif #ifdef __sparc computer = "sparc"; #endif #ifdef __sparc__ computer = "sparc"; #endif #ifdef __sparc64__ computer = "sparc"; #endif #ifdef __mips__ computer = "mips"; #endif #ifdef __mips64__ computer = "mips"; #endif #if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ endian = "big"; #endif #if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ endian = "little"; #endif accum_init(&acc); accum_name_value1(&acc, "kernel", symbol(kernel)); accum_name_value1(&acc, "userland", symbol(userland)); accum_name_value1(&acc, "computer", symbol(computer)); accum_name_value1(&acc, "endian", symbol(endian)); return acc.list; } static value_t get_version_alist(void) { static struct accum acc; static int initialized; if (!initialized) { initialized = 1; accum_init(&acc); accum_name_value1(&acc, "command", string_from_cstr("upscheme")); accum_name_value1(&acc, "scheme-id", symbol("upscheme")); accum_name_value( &acc, "language", fl_cons(symbol("scheme"), fl_cons(symbol("r7rs"), FL_NIL))); accum_name_value(&acc, "features", get_features_list()); accum_name_value(&acc, "platform", build_platform_list()); accum_name_value(&acc, "c-type-bits", build_c_type_bits_list()); accum_name_value( &acc, "c-compiler-version", fl_list2(string_from_cstr(SCHEME_C_COMPILER_NAME), string_from_cstr(SCHEME_C_COMPILER_VERSION))); accum_name_value1(&acc, "c-compiler-command", string_from_cstr(env_build_cc)); accum_name_value1(&acc, "c-compiler-flags", string_from_cstr(env_build_cflags)); accum_name_value1(&acc, "c-linker-flags", string_from_cstr(env_build_lflags)); accum_name_value1(&acc, "revision", string_from_cstr(env_build_revision)); accum_name_value1(&acc, "build-date", string_from_cstr(env_build_date)); accum_name_value1(&acc, "release", string_from_cstr(env_release)); accum_name_value1(&acc, "release-date", string_from_cstr(env_release_date)); } return acc.list; } value_t builtin_features(value_t *args, uint32_t nargs) { (void)args; argcount("features", nargs, 0); return get_features_list(); } value_t builtin_version_alist(value_t *args, uint32_t nargs) { (void)args; argcount("version-alist", nargs, 0); return get_version_alist(); } static value_t argv_list(int argc, char *argv[]) { int i; value_t lst = FL_NIL, temp; fl_gc_handle(&lst); fl_gc_handle(&temp); for (i = argc - 1; i >= 0; i--) { temp = cvalue_static_cstring(argv[i]); lst = fl_cons(temp, lst); } fl_free_gc_handles(2); return lst; } static const char usage_message[] = "usage: upscheme -h|--help" "\n" "usage: upscheme -V|--version" "\n" "usage: upscheme [options]" "\n" "usage: upscheme [options] -e expression..." "\n" "usage: upscheme [options] script-file [script-arg...]" "\n"; static const char runtime_usage_message[] = "usage: upscheme [-:option,option...] ..." "\n" "The -: flag sets Up Scheme runtime options. An option is one of:" "\n" "\n" "null start in an environment with only import and cond-expand" "\n" "r7rs start in R7RS environment with no Up Scheme extensions" "\n" "unstable start with the very latest in-development Up Scheme extensions" "\n" "debug set debugging options" "\n" "search set module search path" "\n" "version show version information" "\n" "help show this help" "\n"; static int evalflag; static int helpflag; static int versionflag; static int boot_env; static void generic_usage(FILE *out, int status) { fprintf(out, "%s", usage_message); exit(status); } static void usage(void) { generic_usage(stderr, 2); } static void generic_runtime_usage(FILE *out, int status) { fprintf(out, "%s", runtime_usage_message); exit(status); } static void runtime_usage(void) { generic_runtime_usage(stderr, 2); } static void version(void) { value_t list; for (list = get_version_alist(); iscons(list); list = cdr_(list)) { write_simple_defaults(ios_stdout, car_(list)); ios_putc('\n', ios_stdout); } exit(0); } static char **long_option(char **argv, const char *option) { if (!strcmp(option, "--help")) { helpflag = 1; } else if (!strcmp(option, "--version")) { versionflag = 1; } else { usage(); } return argv; } static void runtime_option(const char *name, const char *value) { if (!strcmp("null", name)) { if (value) runtime_usage(); boot_env = BOOT_ENV_NULL; } else if (!strcmp("r7rs", name)) { if (value) runtime_usage(); boot_env = BOOT_ENV_R7RS; } else if (!strcmp("unstable", name)) { if (value) runtime_usage(); boot_env = BOOT_ENV_UNSTABLE; } else if (!strcmp("debug", name)) { if (!value) runtime_usage(); } else if (!strcmp("search", name)) { if (!value) runtime_usage(); } else if (!strcmp("version", name)) { versionflag = 1; } else if (!strcmp("help", name)) { generic_runtime_usage(stdout, 0); } else { runtime_usage(); } } static void runtime_options(const char *arg) { char *name; char *value; char *whole; char *limit; if (!(whole = strdup(arg))) { runtime_usage(); // TODO: out of memory } for (name = whole; name; name = limit) { if ((limit = strchr(name, ','))) { *limit++ = 0; } if ((value = strchr(name, '='))) { *value++ = 0; } if (*name) { runtime_option(name, value); } else if (value) { runtime_usage(); } } free(whole); } static char **short_option(char **argv, int option) { switch (option) { case 'e': evalflag = 1; break; case 'h': helpflag = 1; break; case 'V': versionflag = 1; break; default: usage(); break; } return argv; } static char **parse_command_line_flags(char **argv) { char *arg; int option; while ((arg = *argv)) { if (arg[0] == '-') { if (arg[1] == '-') { if (arg[2] == '-') { usage(); } else if (!arg[2]) { break; } else { argv++; argv = long_option(argv, arg); } } else if (arg[1] == ':') { argv++; runtime_options(&arg[2]); } else if (!arg[1]) { break; } else { argv++; for (arg++; (option = *arg); arg++) { argv = short_option(argv, option); } } } else { break; } } return argv; } int main(int argc, char **argv) { parse_command_line_flags(argv + 1); if (helpflag) { generic_usage(stdout, 0); } fl_init(512 * 1024); { FL_TRY_EXTERN { if (versionflag) { version(); } if (fl_load_boot_image()) return 1; (void)fl_applyn(1, symbol_value(symbol("__start")), argv_list(argc, argv)); } FL_CATCH_EXTERN { ios_puts("fatal error:\n", ios_stderr); write_defaults_indent(ios_stderr, fl_lasterror); ios_putc('\n', ios_stderr); return 1; } } return 0; }