1 /*
2 * execenv.c - housekeeping execution environment
3 *
4 * Copyright (c) 2020 Shiro Kawai <shiro@acm.org>
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 *
13 * 2. Redistributions in binary form must reproduce the above copyright
14 * notice, this list of conditions and the following disclaimer in the
15 * documentation and/or other materials provided with the distribution.
16 *
17 * 3. Neither the name of the authors nor the names of its contributors
18 * may be used to endorse or promote products derived from this
19 * software without specific prior written permission.
20 *
21 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
27 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32 */
33
34 /*
35 * Sets up various bindings and parameters to access runtime environment
36 */
37
38
39 #define LIBGAUCHE_BODY
40 #include "gauche.h"
41
42 static const ScmPrimitiveParameter *command_line = NULL;
43 static const ScmPrimitiveParameter *os_command_line = NULL;
44 static const ScmPrimitiveParameter *script_file = NULL;
45
46 /*=============================================================
47 * Command line arguments
48 */
49
50 /*
51 * Scm_InitCommandLine is to be called by an application to initialize
52 * *program-name*, *argv* and (command-line). argv[0] becomes *program-name*,
53 * and *argv* gets the rest of arguments.
54 *
55 * Note that this is likely to be called before VM loop starts.
56 * Scm_Error isn't much useful yet.
57 */
58 #if GAUCHE_API_VERSION < 1000
Scm_InitCommandLine(int argc,const char * argv[])59 ScmObj Scm_InitCommandLine(int argc, const char *argv[])
60 {
61 return Scm_InitCommandLine2(argc, argv, SCM_COMMAND_LINE_SCRIPT);
62 }
Scm_InitCommandLine2(int argc,const char * argv[],int kind)63 ScmObj Scm_InitCommandLine2(int argc, const char *argv[], int kind)
64 #else /* GAUCHE_API_VERSION >= 1000 */
65 ScmObj Scm_InitCommandLine(int argc, const char *argv[], int kind)
66 #endif /* GAUCHE_API_VERSION >= 1000 */
67 {
68 ScmObj args = Scm_CStringArrayToList(argv, argc, SCM_STRING_IMMUTABLE);
69
70 if (kind & SCM_COMMAND_LINE_OS) {
71 Scm_PrimitiveParameterSet(Scm_VM(), os_command_line, args);
72 }
73 if (kind & SCM_COMMAND_LINE_SCRIPT) {
74 Scm_PrimitiveParameterSet(Scm_VM(), command_line, args);
75
76 /* For the backward compatibility */
77 SCM_DEFINE(Scm_UserModule(), "*program-name*",
78 SCM_NULLP(args)? SCM_FALSE : SCM_CAR(args));
79 SCM_DEFINE(Scm_UserModule(), "*argv*",
80 SCM_NULLP(args)? SCM_NIL : SCM_CDR(args));
81
82 }
83 return args;
84 }
85
86 /*=============================================================
87 * Runtime introspection
88 */
89
90 #define PATH_ALLOC(n) SCM_MALLOC_ATOMIC(n)
91 #define PATH_ERROR(...) Scm_Error(__VA_ARGS__)
92 #include "paths.c"
93 #include "paths_arch.c" /* generated by genconfig */
94
Scm_HostArchitecture()95 const char *Scm_HostArchitecture()
96 {
97 return gauche_arch;
98 }
99
Scm_LibraryDirectory()100 ScmObj Scm_LibraryDirectory()
101 {
102 static ScmObj dir = SCM_UNBOUND;
103 if (SCM_UNBOUNDP(dir)) {
104 dir = SCM_MAKE_STR_IMMUTABLE(replace_install_dir(gauche_lib_dir));
105 }
106 return dir;
107 }
108
Scm_ArchitectureDirectory()109 ScmObj Scm_ArchitectureDirectory()
110 {
111 static ScmObj dir = SCM_UNBOUND;
112 if (SCM_UNBOUNDP(dir)) {
113 dir = SCM_MAKE_STR_IMMUTABLE(replace_install_dir(gauche_arch_dir));
114 }
115 return dir;
116 }
117
Scm_SiteLibraryDirectory()118 ScmObj Scm_SiteLibraryDirectory()
119 {
120 static ScmObj dir = SCM_UNBOUND;
121 if (SCM_UNBOUNDP(dir)) {
122 dir = SCM_MAKE_STR_IMMUTABLE(replace_install_dir(gauche_site_lib_dir));
123 }
124 return dir;
125 }
126
Scm_SiteArchitectureDirectory()127 ScmObj Scm_SiteArchitectureDirectory()
128 {
129 static ScmObj dir = SCM_UNBOUND;
130 if (SCM_UNBOUNDP(dir)) {
131 dir = SCM_MAKE_STR_IMMUTABLE(replace_install_dir(gauche_site_arch_dir));
132 }
133 return dir;
134 }
135
Scm_RuntimeDirectory()136 ScmObj Scm_RuntimeDirectory()
137 {
138 static ScmObj dir = SCM_UNBOUND;
139 if (SCM_UNBOUNDP(dir)) {
140 const char *d = get_install_dir();
141 if (d == NULL) dir = SCM_FALSE;
142 else dir = SCM_MAKE_STR_IMMUTABLE(d);
143 }
144 return dir;
145 }
146
Scm_LibgauchePath()147 ScmObj Scm_LibgauchePath()
148 {
149 static ScmObj path = SCM_UNBOUND;
150 if (SCM_UNBOUNDP(path)) {
151 const char *p = get_libgauche_path();
152 if (p == NULL) path = SCM_FALSE;
153 else path = SCM_MAKE_STR_IMMUTABLE(p);
154 }
155 return path;
156 }
157
Scm_ExecutablePath()158 ScmObj Scm_ExecutablePath()
159 {
160 static ScmObj path = SCM_UNBOUND;
161 if (SCM_UNBOUNDP(path)) {
162 const char *p = get_executable_path();
163 if (p == NULL) path = SCM_FALSE;
164 else path = SCM_MAKE_STR_IMMUTABLE(p);
165 }
166 return path;
167 }
168
169 /* TRANSIENT: For ABI Compatibility. Remove on 1.0 release. */
170 #if GAUCHE_API_VERSION < 1000
Scm__RuntimeDirectory()171 ScmObj Scm__RuntimeDirectory()
172 {
173 return Scm_RuntimeDirectory();
174 }
175 #endif
176
177 /*
178 * Initialization
179 */
180
181 #include "gauche/priv/parameterP.h"
182
Scm__InitExecenv(void)183 void Scm__InitExecenv(void)
184 {
185 /* (command-line) is R7RS. We realize it as a a parameter. */
186 ScmObj defaultval = SCM_LIST1(SCM_MAKE_STR_IMMUTABLE(""));
187 command_line = Scm_BindPrimitiveParameter(Scm_GaucheModule(),
188 "command-line",
189 defaultval, 0);
190 os_command_line = Scm_BindPrimitiveParameter(Scm_GaucheModule(),
191 "os-command-line",
192 defaultval, 0);
193 /* script-file is set by 'load'. */
194 script_file = Scm_BindPrimitiveParameter(Scm_GaucheModule(),
195 "script-file",
196 SCM_FALSE, 0);
197 }
198
199