2019-08-17 17:09:43 -04:00
|
|
|
#include <sys/types.h>
|
|
|
|
|
2019-08-09 12:00:17 -04:00
|
|
|
#include <assert.h>
|
2019-08-13 11:28:19 -04:00
|
|
|
#include <math.h>
|
2019-08-09 12:00:17 -04:00
|
|
|
#include <setjmp.h>
|
|
|
|
#include <stdarg.h>
|
2019-08-09 16:25:20 -04:00
|
|
|
#include <stdint.h>
|
2019-08-09 13:14:42 -04:00
|
|
|
#include <stdio.h>
|
2010-05-02 14:17:47 -04:00
|
|
|
#include <stdlib.h>
|
|
|
|
#include <string.h>
|
2019-08-09 12:00:17 -04:00
|
|
|
|
2019-08-26 15:12:15 -04:00
|
|
|
#include "scheme.h"
|
2010-05-02 14:17:47 -04:00
|
|
|
|
2019-09-30 10:08:51 -04:00
|
|
|
#define BOOT_ENV_NULL 0
|
|
|
|
#define BOOT_ENV_R7RS 1
|
|
|
|
#define BOOT_ENV_UNSTABLE 2
|
|
|
|
|
2019-08-25 15:39:35 -04:00
|
|
|
extern void write_defaults_indent(struct ios *f, value_t v);
|
|
|
|
|
2010-05-02 14:17:47 -04:00
|
|
|
static value_t argv_list(int argc, char *argv[])
|
|
|
|
{
|
|
|
|
int i;
|
2019-08-09 07:02:02 -04:00
|
|
|
value_t lst = FL_NIL, temp;
|
2010-05-02 14:17:47 -04:00
|
|
|
fl_gc_handle(&lst);
|
|
|
|
fl_gc_handle(&temp);
|
2019-08-09 07:02:02 -04:00
|
|
|
for (i = argc - 1; i >= 0; i--) {
|
2010-05-02 14:17:47 -04:00
|
|
|
temp = cvalue_static_cstring(argv[i]);
|
|
|
|
lst = fl_cons(temp, lst);
|
|
|
|
}
|
|
|
|
fl_free_gc_handles(2);
|
|
|
|
return lst;
|
|
|
|
}
|
|
|
|
|
2019-09-30 10:08:51 -04:00
|
|
|
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 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); }
|
|
|
|
|
|
|
|
#define VERSION_STRING "0.1.0"
|
|
|
|
|
|
|
|
static void version(void)
|
|
|
|
{
|
|
|
|
printf("(version \"%s\")\n", VERSION_STRING);
|
|
|
|
printf("(canonical-command \"upscheme\")\n");
|
|
|
|
printf("(scheme-id upscheme)\n");
|
|
|
|
printf("(languages scheme r7rs)\n");
|
|
|
|
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)
|
2010-05-02 14:17:47 -04:00
|
|
|
{
|
2019-09-30 10:08:51 -04:00
|
|
|
if (!strcmp("null", name)) {
|
|
|
|
if (value)
|
|
|
|
usage();
|
|
|
|
boot_env = BOOT_ENV_NULL;
|
|
|
|
} else if (!strcmp("r7rs", name)) {
|
|
|
|
if (value)
|
|
|
|
usage();
|
|
|
|
boot_env = BOOT_ENV_R7RS;
|
|
|
|
} else if (!strcmp("unstable", name)) {
|
|
|
|
if (value)
|
|
|
|
usage();
|
|
|
|
boot_env = BOOT_ENV_UNSTABLE;
|
|
|
|
} else if (!strcmp("debug", name)) {
|
|
|
|
if (!value)
|
|
|
|
usage();
|
|
|
|
} else if (!strcmp("search", name)) {
|
|
|
|
if (!value)
|
|
|
|
usage();
|
|
|
|
} else {
|
|
|
|
usage();
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
static void runtime_options(const char *arg)
|
|
|
|
{
|
|
|
|
char *whole;
|
|
|
|
char *name;
|
|
|
|
char *value;
|
|
|
|
char *limit;
|
|
|
|
|
|
|
|
if (!(name = whole = strdup(arg))) {
|
|
|
|
usage(); // TODO: out of memory
|
|
|
|
}
|
|
|
|
while (name[0]) {
|
|
|
|
if (!(limit = strchr(name, ','))) {
|
|
|
|
limit = strchr(name, 0);
|
|
|
|
}
|
|
|
|
if ((value = strchr(name, '='))) {
|
|
|
|
if (value < limit) {
|
|
|
|
*value++ = 0;
|
|
|
|
} else {
|
|
|
|
value = 0;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
runtime_option(name, value);
|
|
|
|
name = limit;
|
|
|
|
}
|
|
|
|
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;
|
|
|
|
case ':':
|
|
|
|
if (!argv[0])
|
|
|
|
usage();
|
|
|
|
runtime_options(*argv++);
|
|
|
|
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]) {
|
|
|
|
break;
|
|
|
|
} else {
|
|
|
|
argv++;
|
|
|
|
for (arg++; (option = *arg); arg++) {
|
|
|
|
argv = short_option(argv, option);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return argv;
|
|
|
|
}
|
|
|
|
|
|
|
|
int main(int argc, char **argv)
|
|
|
|
{
|
2019-10-02 14:41:51 -04:00
|
|
|
parse_command_line_flags(argv + 1);
|
2019-09-30 10:08:51 -04:00
|
|
|
if (helpflag) {
|
|
|
|
generic_usage(stdout, 0);
|
|
|
|
} else if (versionflag) {
|
|
|
|
version();
|
|
|
|
}
|
2019-08-09 07:02:02 -04:00
|
|
|
fl_init(512 * 1024);
|
|
|
|
{
|
2019-08-21 15:08:21 -04:00
|
|
|
FL_TRY_EXTERN
|
|
|
|
{
|
|
|
|
if (fl_load_boot_image())
|
|
|
|
return 1;
|
2010-05-02 14:17:47 -04:00
|
|
|
|
2019-08-21 15:08:21 -04:00
|
|
|
(void)fl_applyn(1, symbol_value(symbol("__start")),
|
|
|
|
argv_list(argc, argv));
|
|
|
|
}
|
|
|
|
FL_CATCH_EXTERN
|
|
|
|
{
|
|
|
|
ios_puts("fatal error:\n", ios_stderr);
|
2019-08-25 15:39:35 -04:00
|
|
|
write_defaults_indent(ios_stderr, fl_lasterror);
|
2019-08-21 15:08:21 -04:00
|
|
|
ios_putc('\n', ios_stderr);
|
|
|
|
return 1;
|
|
|
|
}
|
2010-05-02 14:17:47 -04:00
|
|
|
}
|
|
|
|
return 0;
|
|
|
|
}
|