Add stuff for the command-line pre-SRFI

c/env.c

@@ -278,6 +278,91 @@ value_t builtin_version_alist(value_t *args, uint32_t nargs)
     return get_version_alist();
 }
 
+value_t builtin_script_file(value_t *args, uint32_t nargs)
+{
+    (void)args;
+    argcount("script-file", nargs, 0);
+    return script_file ? string_from_cstr(script_file) : FL_F;
+}
+
+value_t builtin_script_directory(value_t *args, uint32_t nargs)
+{
+    char *path;
+    char *pathslash;
+    value_t obj;
+
+    (void)args;
+    argcount("script-directory", nargs, 0);
+    if (!script_file) {
+        return FL_F;
+    }
+    path = strdup(script_file);
+    path_to_dirname(path);
+    pathslash = calloc(1, strlen(path) + 2);
+    memcpy(pathslash, path, strlen(path));
+    pathslash[strlen(path)] = '/';
+    obj = string_from_cstr(pathslash);
+    free(pathslash);
+    free(path);
+    return obj;
+}
+
+value_t builtin_command_name(value_t *args, uint32_t nargs)
+{
+    char *path;
+    char *p;
+
+    (void)args;
+    argcount("command-name", nargs, 0);
+    if (!script_file) {
+        return FL_F;
+    }
+    path = strdup(script_file);
+    for (p = strchr(path, 0); p > path; p--) {
+        if (p[-1] == '/')
+            break;
+    }
+    return string_from_cstr(p);
+}
+
+value_t builtin_command_args(value_t *args, uint32_t nargs)
+{
+    value_t v;
+    int i;
+
+    (void)args;
+    argcount("command-args", nargs, 0);
+    if (command_line_offset < 1) {
+        return FL_NIL;
+    }
+    v = os_command_line;
+    for (i = 0; i < command_line_offset + 1; i++) {
+        v = cdr(v);
+    }
+    return v;
+}
+
+value_t builtin_command_line(value_t *args, uint32_t nargs)
+{
+    value_t cmdname, cmdargs;
+
+    (void)args;
+    argcount("command-line", nargs, 0);
+    cmdname = builtin_command_name(0, 0);
+    cmdargs = builtin_command_args(0, 0);
+    if (cmdname == FL_F) {
+        cmdname = string_from_cstr("");
+    }
+    return fl_cons(cmdname, cmdargs);
+}
+
+value_t builtin_os_command_line(value_t *args, uint32_t nargs)
+{
+    (void)args;
+    argcount("os-command-line", nargs, 0);
+    return os_command_line;
+}
+
 value_t builtin_os_executable_file(value_t *args, uint32_t nargs)
 {
     (void)args;

c/libraries.c

@@ -63,6 +63,12 @@ static struct builtin_procedure builtin_procedures[] = {
 
     { "features", builtin_features, R7RS_BASE | UP_2019 },
     { "version-alist", builtin_version_alist, SRFI_176 | UP_2019 },
+    { "script-file", builtin_script_file, UP_2019 },
+    { "script-directory", builtin_script_directory, UP_2019 },
+    { "command-name", builtin_command_name, UP_2019 },
+    { "command-args", builtin_command_args, UP_2019 },
+    { "command-line", builtin_command_line, UP_2019 },
+    { "os-command-line", builtin_os_command_line, UP_2019 },
     { "os-executable-file", builtin_os_executable_file, UP_2019 },
 
     { "string?", fl_stringp, SRFI_13 | R7RS_BASE | UP_2019 },

c/main.c

@@ -15,7 +15,7 @@
 #define BOOT_ENV_R7RS 1
 #define BOOT_ENV_UNSTABLE 2
 
-static value_t argv_list(int argc, char *argv[])
+static value_t argv_list(int argc, const char **argv)
 {
     int i;
     value_t lst = FL_NIL, temp;
@@ -62,6 +62,10 @@ static const char runtime_usage_message[] =
 "help      show this help"
 "\n";
 
+const char *script_file;
+value_t os_command_line;
+int command_line_offset;
+
 static int evalflag;
 static int helpflag;
 static int versionflag;
@@ -216,12 +220,17 @@ static const char **parse_command_line_flags(const char **argv)
 
 int main(int argc, char **argv)
 {
-    parse_command_line_flags((const char **)(argv + 1));
+    const char **command_line;
+
+    command_line = parse_command_line_flags((const char **)(argv + 1));
     if (helpflag) {
         generic_usage(stdout, 0);
     }
     fl_init(512 * 1024);
     {
+        fl_gc_handle(&os_command_line);
+        os_command_line = argv_list(argc, (const char **)argv);
+        command_line_offset = (command_line - (const char **)argv) / sizeof(*argv);
         FL_TRY_EXTERN
         {
             if (versionflag) {
@@ -229,9 +238,12 @@ int main(int argc, char **argv)
             }
             if (fl_load_boot_image())
                 return 1;
-
+            script_file = command_line[0];
+            if (script_file) {
+                script_file = realpath(command_line[0], 0);
+            }
             (void)fl_applyn(1, symbol_value(symbol("__start")),
-                            argv_list(argc, argv));
+                            os_command_line);
         }
         FL_CATCH_EXTERN
         {

c/scheme.h

@@ -1010,6 +1010,12 @@ value_t envst_language_c(void);
 value_t get_version_alist(void);
 value_t builtin_features(value_t *args, uint32_t nargs);
 value_t builtin_version_alist(value_t *args, uint32_t nargs);
+value_t builtin_script_file(value_t *args, uint32_t nargs);
+value_t builtin_script_directory(value_t *args, uint32_t nargs);
+value_t builtin_command_name(value_t *args, uint32_t nargs);
+value_t builtin_command_args(value_t *args, uint32_t nargs);
+value_t builtin_command_line(value_t *args, uint32_t nargs);
+value_t builtin_os_command_line(value_t *args, uint32_t nargs);
 value_t builtin_os_executable_file(value_t *args, uint32_t nargs);
 
 // env_*.c
@@ -1026,6 +1032,12 @@ extern const char *env_build_git_modified[];
 extern const char env_release[];
 extern const char env_release_date[];
 
+// main.c
+
+extern const char *script_file;
+extern value_t os_command_line;
+extern int command_line_offset;
+
 //// #include "libraries.h"
 
 extern const int upscheme_stable_specs[];