1 /*===========================================================================
2 * Filename : main.c
3 * About : main function
4 *
5 * Copyright (C) 2005 Kazuki Ohta <mover AT hct.zaq.ne.jp>
6 * Copyright (C) 2005 Jun Inoue <jun.lambda AT gmail.com>
7 * Copyright (C) 2005-2006 YAMAMOTO Kengo <yamaken AT bp.iij4u.or.jp>
8 * Copyright (c) 2007-2008 SigScheme Project <uim-en AT googlegroups.com>
9 *
10 * All rights reserved.
11 *
12 * Redistribution and use in source and binary forms, with or without
13 * modification, are permitted provided that the following conditions
14 * are met:
15 *
16 * 1. Redistributions of source code must retain the above copyright
17 * notice, this list of conditions and the following disclaimer.
18 * 2. Redistributions in binary form must reproduce the above copyright
19 * notice, this list of conditions and the following disclaimer in the
20 * documentation and/or other materials provided with the distribution.
21 * 3. Neither the name of authors nor the names of its contributors
22 * may be used to endorse or promote products derived from this software
23 * without specific prior written permission.
24 *
25 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
26 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
27 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
28 * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
29 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
30 * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
31 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
32 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
33 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
34 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
35 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
36 ===========================================================================*/
37
38 #include <config.h>
39
40 #if BREW_MAJ_VER /* FIXME: inappropriate detection method */
41 #include "sigscheme-combined.c"
42 #endif
43
44 #include <stdlib.h>
45
46 #include <unistd.h>
47 #include <sys/param.h>
48
49 #if BREW_MAJ_VER /* FIXME: inappropriate detection method */
50 #include "AEEAppGen.h"
51 #include "AEEStdLib.h"
52 #endif
53
54 #include "sigscheme.h"
55 #include "sigschemeinternal.h"
56 #include "scmport-config.h"
57 #include "scmport.h"
58
59 /*=======================================
60 File Local Macro Definitions
61 =======================================*/
62 #define PROMPT_STR "sscm> "
63
64 #if SCM_COMPAT_SIOD
65 #define FEATURE_ID_SIOD "siod"
66 #endif
67
68 #if !defined(MAXPATHLEN)
69 #define MAXPATHLEN 1024 /* GNU Hurd doesn't have MAXPATHLEN */
70 #endif
71
72 /*=======================================
73 File Local Type Definitions
74 =======================================*/
75 struct g_sscm {
76 #if SCM_COMPAT_SIOD
77 ScmObj feature_id_siod;
78 #endif
79 char lib_path[MAXPATHLEN + sizeof("")];
80 };
81
82 #if BREW_MAJ_VER /* FIXME: inappropriate detection method */
83 /* experimental, broken and existing for technical example */
84
85 #define SCM_BREW_USER_APPLET_T CSSCMApplet
86 typedef struct _CSSCMApplet CSSCMApplet;
87 struct _CSSCMApplet {
88 AEEApplet a;
89 struct scm_g_aggregated m_scm_g_aggregated_instance;
90
91 struct g_sscm m_sscm;
92 };
93
94 #define sscm (((CSSCMApplet *)GETAPPINSTANCE())->m_sscm)
95 #endif /* BREW_MAJ_VER */
96
97 /*=======================================
98 Variable Definitions
99 =======================================*/
100 /* Don't use any global variable other than the 'sscm' */
101 #if !BREW_MAJ_VER /* FIXME: inappropriate detection method */
102 static struct g_sscm sscm;
103 #endif /* !BREW_MAJ_VER */
104
105 /*=======================================
106 File Local Function Declarations
107 =======================================*/
108 static void *repl(void *dummy);
109 static void repl_loop(void);
110 static scm_bool show_promptp(void);
111
112 /*=======================================
113 Function Definitions
114 =======================================*/
115 static void *
repl(void * dummy)116 repl(void *dummy)
117 {
118 repl_loop();
119 return NULL;
120 }
121
122 static void
repl_loop(void)123 repl_loop(void)
124 {
125 ScmObj sexp, result;
126 #if SCM_USE_SRFI34
127 ScmEvalState eval_state;
128 ScmBaseCharPort *cport;
129 ScmBytePort *bport;
130 ScmObj cond_catch, proc_read, proc_eval, err;
131
132 proc_read = scm_symbol_value(scm_intern("read"), SCM_INTERACTION_ENV);
133 proc_eval = scm_symbol_value(scm_intern("eval"), SCM_INTERACTION_ENV);
134 err = CONS(SCM_UNDEF, SCM_UNDEF); /* unique ID */
135
136 /* prepare the constant part of the form to get the loop fast */
137 scm_intern("guard");
138 cond_catch = LIST_2(scm_intern("err"),
139 LIST_3(scm_intern("else"),
140 LIST_2(scm_intern("%%inspect-error"),
141 scm_intern("err")),
142 LIST_2(SCM_SYM_QUOTE, err)));
143 #endif /* SCM_USE_SRFI34 */
144
145 for (;;) {
146 if (show_promptp())
147 scm_port_puts(scm_out, PROMPT_STR);
148
149 #if SCM_USE_SRFI34
150 /* error-proof read */
151 SCM_EVAL_STATE_INIT1(eval_state, SCM_INTERACTION_ENV);
152 sexp = scm_s_srfi34_guard(cond_catch,
153 LIST_1(LIST_2(proc_read, scm_in)),
154 &eval_state);
155 sexp = SCM_FINISH_TAILREC_CALL(sexp, &eval_state);
156 if (EOFP(sexp))
157 break;
158
159 /* parse error */
160 if (EQ(sexp, err)) {
161 cport = SCM_CHARPORT_DYNAMIC_CAST(ScmBaseCharPort,
162 SCM_PORT_IMPL(scm_in));
163 if (cport) {
164 bport = cport->bport;
165 /* discard all available input */
166 while (SCM_BYTEPORT_BYTE_READYP(bport))
167 SCM_BYTEPORT_GET_BYTE(bport);
168 continue;
169 }
170 PLAIN_ERR("unrecoverable parse error");
171 }
172
173 /*
174 * Error-proof evaluation
175 *
176 * (guard (err
177 * (else
178 * (%%inspect-error err)
179 * #<err>))
180 * (eval (quote sexp) (interaction-environment)))
181 *
182 * To allow redefinition of 'guard' and '%%inspect-err', surely access
183 * them via symbol instead of prepared syntax or procedure object.
184 */
185 SCM_EVAL_STATE_INIT1(eval_state, SCM_INTERACTION_ENV);
186 result = scm_s_srfi34_guard(cond_catch,
187 LIST_1(LIST_3(proc_eval,
188 LIST_2(SYM_QUOTE, sexp),
189 SCM_INTERACTION_ENV)),
190 &eval_state);
191 result = SCM_FINISH_TAILREC_CALL(result, &eval_state);
192
193 if (!EQ(result, err)) {
194 SCM_WRITE_SS(scm_out, result);
195 scm_port_newline(scm_out);
196 }
197 #else /* SCM_USE_SRFI34 */
198 sexp = scm_read(scm_in);
199 if (EOFP(sexp))
200 break;
201
202 result = EVAL(sexp, SCM_INTERACTION_ENV);
203 SCM_WRITE_SS(scm_out, result);
204 scm_port_newline(scm_out);
205 #endif /* SCM_USE_SRFI34 */
206 }
207 }
208
209 static scm_bool
show_promptp(void)210 show_promptp(void)
211 {
212 #if SCM_COMPAT_SIOD
213 return (FALSEP(scm_p_providedp(sscm.feature_id_siod))
214 || scm_get_verbose_level() >= 2);
215 #else
216 return scm_true;
217 #endif
218 }
219
220 int
main(int argc,char ** argv)221 main(int argc, char **argv)
222 {
223 const char *filename;
224 char **rest_argv;
225
226 rest_argv = scm_initialize(NULL, (const char *const *)argv);
227 filename = rest_argv[0];
228
229 /* Explicitly allow current directory-relative path. The sscm command is
230 * supposed to neither setuid'ed nor setgid'ed. So the privilege escalation
231 * problem for C plugins shall not occur. -- YamaKen 2006-03-25 */
232 /*
233 * FIXME:
234 * - add multiple path capability to libsscm
235 * - add library path specifying way for users
236 * - support non-UNIX platforms
237 */
238 if (!getcwd(sscm.lib_path, MAXPATHLEN + sizeof("")))
239 return EXIT_FAILURE;
240 scm_set_lib_path(sscm.lib_path);
241
242 #if SCM_USE_SRFI34
243 scm_require_module("srfi-34");
244 #endif
245
246 #if SCM_COMPAT_SIOD
247 scm_gc_protect_with_init(&sscm.feature_id_siod,
248 CONST_STRING(FEATURE_ID_SIOD));
249 #endif
250
251 if (filename) {
252 scm_load(filename);
253 } else {
254 scm_call_with_gc_ready_stack(repl, NULL);
255 /* ERR("usage: sscm <filename>"); */
256 }
257
258 scm_finalize();
259 return EXIT_SUCCESS;
260 }
261