diff --git a/c/libraries.c b/c/libraries.c index 0fdce33..7761128 100644 --- a/c/libraries.c +++ b/c/libraries.c @@ -45,6 +45,7 @@ struct builtin_library { #define SRFI_13 (1 << 9) // String Libraries #define SRFI_170 (1 << 10) // POSIX API #define SRFI_175 (1 << 11) // ASCII character library +#define SRFI_176 (1 << 11) // Version flag // Up Scheme libraries #define UP_2019 (1 << 20) @@ -57,6 +58,9 @@ static struct builtin_procedure builtin_procedures[] = { { "make-string", string_make_string, SRFI_13 | UP_2019 }, #endif + { "features", builtin_features, R7RS_BASE | UP_2019 }, + { "version-alist", builtin_version_alist, SRFI_176 | UP_2019 }, + { "string?", fl_stringp, SRFI_13 | R7RS_BASE | UP_2019 }, { "string-reverse", fl_string_reverse, SRFI_13 | UP_2019 }, { "string-split", builtin_string_split, UP_2019 }, @@ -144,6 +148,7 @@ static struct builtin_library builtin_libraries[] = { { "srfi/13", SRFI_13 }, { "srfi/170", SRFI_170 }, { "srfi/175", SRFI_175 }, + { "srfi/176", SRFI_176 }, { "upscheme/2019/unstable", UP_2019 }, { 0, 0 }, }; diff --git a/c/main.c b/c/main.c index a9f5200..60d416e 100644 --- a/c/main.c +++ b/c/main.c @@ -15,6 +15,59 @@ #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 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()); + } + 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[]) { @@ -82,14 +135,14 @@ static void generic_runtime_usage(FILE *out, int status) static void runtime_usage(void) { generic_runtime_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"); + 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); } @@ -216,13 +269,14 @@ int main(int argc, char **argv) parse_command_line_flags(argv + 1); if (helpflag) { generic_usage(stdout, 0); - } else if (versionflag) { - version(); } fl_init(512 * 1024); { FL_TRY_EXTERN { + if (versionflag) { + version(); + } if (fl_load_boot_image()) return 1; diff --git a/c/scheme.h b/c/scheme.h index 6448165..8a82639 100644 --- a/c/scheme.h +++ b/c/scheme.h @@ -1010,6 +1010,9 @@ value_t builtin_import(value_t *args, uint32_t nargs); //// #include "builtins.h" +value_t builtin_features(value_t *args, uint32_t nargs); +value_t builtin_version_alist(value_t *args, uint32_t nargs); + value_t builtin_pid(value_t *args, uint32_t nargs); value_t builtin_parent_pid(value_t *args, uint32_t nargs); value_t builtin_process_group(value_t *args, uint32_t nargs);