Author: yamakenz
Date: Fri Jul 13 04:10:15 2007
New Revision: 4722
Modified:
sigscheme-trunk/NEWS
sigscheme-trunk/QALog
sigscheme-trunk/TODO
sigscheme-trunk/lib/srfi-55.scm
sigscheme-trunk/runbench.sh
sigscheme-trunk/runtest-tail-rec.sh
sigscheme-trunk/runtest.sh
sigscheme-trunk/src/load.c
sigscheme-trunk/src/main.c
sigscheme-trunk/src/module-srfi1.c
sigscheme-trunk/src/module-srfi55.c
sigscheme-trunk/src/module-sscm-ext.c
sigscheme-trunk/src/sigscheme.c
sigscheme-trunk/src/sigscheme.h
sigscheme-trunk/src/sigschemeinternal.h
Log:
* This commit add --system-load-path option to sscm to allow non-installed
execution
* src/sigscheme.h
- (scm_initialize):
* Add 2nd arg 'argv' to specify options
* Return option-removed argv
- (scm_set_system_load_path, scm_p_system_load_path): New function decl
- (scm_p_scmlibdir): Removed
* src/sigscheme.c
- (scm_initialize):
* Add 2nd arg 'argv' to specify options
* Return option-removed argv
- (scm_initialize_internal):
* Ditto
* Add scm_interpret_argv() invocation
* Move scm_init_port() to after the scm_interpret_argv() invocation
* Rewrite with scm_load_system_file()
- (argv_err): New static function
- (scm_interpret_argv):
* Add new option --system-load-path
* Simplify with argv_err()
* src/sigschemeinternal.h
- (SCM_PREPEND_SCMLIBDIR): Removed
- (scm_load_system_file): New function decl
* src/load.c
- (l_scm_system_load_path): New static variable
- (scm_fin_load): Add l_scm_system_load_path handlings
- (scm_load_system_file, scm_set_system_load_path, scm_p_system_load_path):
New function
* src/module-srfi1.c
- (scm_initialize_srfi1): Rewrite with scm_load_system_file()
* src/module-srfi55.c
- (scm_initialize_srfi55): Ditto
* src/module-sscm-ext.c
- (scm_p_scmlibdir): Removed
* src/main.c
- (main): Follow the change of scm_initialize()
* lib/srfi-55.scm
- (%require-sysfile): Rewrite with %%system-load-path
* runtest.sh
* runtest-tail-rec.sh
* runbench.sh
- Add --system-load-path $PWD/lib for sscm to allow non-installed execution
* QALog
* NEWS
* TODO
- Update
Modified: sigscheme-trunk/NEWS
==============================================================================
--- sigscheme-trunk/NEWS (original)
+++ sigscheme-trunk/NEWS Fri Jul 13 04:10:15 2007
@@ -15,6 +15,9 @@
- %%require-module and scm_require_module(). 'use' and scm_use() have been
deprecated and will be removed in SigScheme 0.9
+ - System-installed libraries written in Scheme are introduced. And to manage
+ them, scm_set_system_load_path() and %%system-load-path have been added
+
- New character codec procedures %%current-char-codec,
%%set-current-char-codec! and with-char-codec
@@ -39,6 +42,9 @@
- make-string, string-fill! and vector-fill! now returns SCM_UNDEF instead of
the modified object
+
+ - Second argument argv is added to scm_initialize() and thus incompatible
+ with 0.7.x.
* Fixes
Modified: sigscheme-trunk/QALog
==============================================================================
--- sigscheme-trunk/QALog (original)
+++ sigscheme-trunk/QALog Fri Jul 13 04:10:15 2007
@@ -707,7 +707,7 @@
file: sigscheme.c
category: core
-spec by eyes: [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED],
[EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED]
+spec by eyes: [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED],
[EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED]
spec by tests:
general review: [EMAIL PROTECTED]
64-bit by eyes: [EMAIL PROTECTED]
@@ -751,7 +751,7 @@
file: load.c
category: semicore
-spec by eyes: [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED]
+spec by eyes: [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED],
[EMAIL PROTECTED]
spec by tests:
general review: [EMAIL PROTECTED]
64-bit by eyes: [EMAIL PROTECTED]
@@ -1097,6 +1097,11 @@
* module-srfi55.c
* srfi-55.scm
- QA done @r4713 with test-srfi55.scm
+
+ * load.c
+ * sigscheme.c
+ - system load-path related functions are added, and 2nd arg is added
+ to scm_initialize(). Checked by eyes and tests
2007-07-01 YamaKen <yamaken AT bp.iij4u.or.jp>
* module-srfi1.c
Modified: sigscheme-trunk/TODO
==============================================================================
--- sigscheme-trunk/TODO (original)
+++ sigscheme-trunk/TODO Fri Jul 13 04:10:15 2007
@@ -1,11 +1,6 @@
==============================================================================
Requirements and critical bugs:
-* Make lib/ files loadable before install
- - sscm --sys-load-path $PWD/lib
- - scm_set_system_load_path()
- - Rename %%scmlibdir -> %%sys-load-path
-
* grep "FIXME" and fix them
==============================================================================
Modified: sigscheme-trunk/lib/srfi-55.scm
==============================================================================
--- sigscheme-trunk/lib/srfi-55.scm (original)
+++ sigscheme-trunk/lib/srfi-55.scm Fri Jul 13 04:10:15 2007
@@ -15,7 +15,7 @@
(lambda (ext-id)
(or (provided? ext-id)
(let* ((file (string-append ext-id ".scm"))
- (path (string-append (%%scmlibdir) "/" file)))
+ (path (string-append (%%system-load-path) "/" file)))
(load path)
(provide ext-id)))))
Modified: sigscheme-trunk/runbench.sh
==============================================================================
--- sigscheme-trunk/runbench.sh (original)
+++ sigscheme-trunk/runbench.sh Fri Jul 13 04:10:15 2007
@@ -1,6 +1,6 @@
#!/bin/sh
-SSCM=src/sscm
+SSCM="src/sscm --system-load-path $PWD/lib"
for bench in bench/bench-*.scm
do
Modified: sigscheme-trunk/runtest-tail-rec.sh
==============================================================================
--- sigscheme-trunk/runtest-tail-rec.sh (original)
+++ sigscheme-trunk/runtest-tail-rec.sh Fri Jul 13 04:10:15 2007
@@ -1,6 +1,6 @@
#!/bin/sh
-SSCM=src/sscm
+SSCM="src/sscm --system-load-path $PWD/lib"
TEST=test/test-tail-rec.scm
ulimit -s 128 && ulimit -d 2048 && $SSCM $TEST \
Modified: sigscheme-trunk/runtest.sh
==============================================================================
--- sigscheme-trunk/runtest.sh (original)
+++ sigscheme-trunk/runtest.sh Fri Jul 13 04:10:15 2007
@@ -1,6 +1,6 @@
#!/bin/sh
-SSCM=src/sscm
+SSCM="src/sscm --system-load-path $PWD/lib"
if test "x$1" != "x"; then
while test "$#" -ne 0; do
Modified: sigscheme-trunk/src/load.c
==============================================================================
--- sigscheme-trunk/src/load.c (original)
+++ sigscheme-trunk/src/load.c Fri Jul 13 04:10:15 2007
@@ -73,10 +73,11 @@
SCM_GLOBAL_VARS_BEGIN(static_load);
#define static
-static char *l_scm_lib_path;
+static char *l_scm_lib_path, *l_scm_system_load_path;
#undef static
SCM_GLOBAL_VARS_END(static_load);
-#define l_scm_lib_path SCM_GLOBAL_VAR(static_load, l_scm_lib_path)
+#define l_scm_lib_path SCM_GLOBAL_VAR(static_load, l_scm_lib_path)
+#define l_scm_system_load_path SCM_GLOBAL_VAR(static_load,
l_scm_system_load_path)
SCM_DEFINE_STATIC_VARS(static_load);
/*=======================================
@@ -105,6 +106,9 @@
scm_fin_load(void)
{
free(l_scm_lib_path);
+ free(l_scm_system_load_path);
+
+ l_scm_system_load_path = NULL;
SCM_GLOBAL_VARS_FIN(static_load);
}
@@ -133,6 +137,40 @@
DECLARE_FUNCTION("load-path", procedure_fixed_0);
return CONST_STRING(l_scm_lib_path);
+}
+
+SCM_EXPORT void
+scm_load_system_file(const char *file)
+{
+ ScmObj path;
+ DECLARE_INTERNAL_FUNCTION("scm_load_system_file");
+
+ path = scm_p_string_append(LIST_3(scm_p_system_load_path(),
+ CONST_STRING("/"),
+ CONST_STRING(file)));
+ scm_p_load(path);
+}
+
+SCM_EXPORT void
+scm_set_system_load_path(const char *path)
+{
+ DECLARE_INTERNAL_FUNCTION("scm_set_system_load_path");
+
+ if (!ABSOLUTE_PATHP(path))
+ ERR("library path must be absolute but got: ~S", path);
+
+ free(l_scm_system_load_path);
+ l_scm_system_load_path = (path) ? scm_strdup(path) : NULL;
+}
+
+SCM_EXPORT ScmObj
+scm_p_system_load_path(void)
+{
+ const char *path;
+ DECLARE_FUNCTION("%%system-load-path", procedure_fixed_0);
+
+ path = (l_scm_system_load_path) ? l_scm_system_load_path : SCMLIBDIR;
+ return CONST_STRING(path);
}
/*===========================================================================
Modified: sigscheme-trunk/src/main.c
==============================================================================
--- sigscheme-trunk/src/main.c (original)
+++ sigscheme-trunk/src/main.c Fri Jul 13 04:10:15 2007
@@ -219,11 +219,8 @@
const char *filename;
char **rest_argv;
- /* must be done before scm_initialize() */
- rest_argv = scm_interpret_argv(argv);
+ rest_argv = scm_initialize(NULL, (const char *const *)argv);
filename = rest_argv[0];
-
- scm_initialize(NULL);
/* Explicitly allow current directory-relative path. The sscm command is
* supposed to neither setuid'ed nor setgid'ed. So the privilege escalation
Modified: sigscheme-trunk/src/module-srfi1.c
==============================================================================
--- sigscheme-trunk/src/module-srfi1.c (original)
+++ sigscheme-trunk/src/module-srfi1.c Fri Jul 13 04:10:15 2007
@@ -69,7 +69,7 @@
SCM_EXPORT void
scm_initialize_srfi1(void)
{
- scm_load(SCM_PREPEND_SCMLIBDIR("srfi-1.scm"));
+ scm_load_system_file("srfi-1.scm");
scm_define_alias("srfi-1:for-each", "for-each");
scm_define_alias("srfi-1:member", "member");
Modified: sigscheme-trunk/src/module-srfi55.c
==============================================================================
--- sigscheme-trunk/src/module-srfi55.c (original)
+++ sigscheme-trunk/src/module-srfi55.c Fri Jul 13 04:10:15 2007
@@ -74,7 +74,7 @@
l_sym_require_extension = scm_intern("%require-extension");
scm_require_module("sscm-ext"); /* for 'provided?' and 'provide' */
- scm_load(SCM_PREPEND_SCMLIBDIR("srfi-55.scm"));
+ scm_load_system_file("srfi-55.scm");
}
SCM_EXPORT ScmObj
Modified: sigscheme-trunk/src/module-sscm-ext.c
==============================================================================
--- sigscheme-trunk/src/module-sscm-ext.c (original)
+++ sigscheme-trunk/src/module-sscm-ext.c Fri Jul 13 04:10:15 2007
@@ -116,14 +116,6 @@
}
SCM_EXPORT ScmObj
-scm_p_scmlibdir(void)
-{
- DECLARE_FUNCTION("%%scmlibdir", procedure_fixed_0);
-
- return CONST_STRING(SCMLIBDIR);
-}
-
-SCM_EXPORT ScmObj
scm_p_current_environment(ScmEvalState *eval_state)
{
DECLARE_FUNCTION("%%current-environment", procedure_fixed_tailrec_0);
Modified: sigscheme-trunk/src/sigscheme.c
==============================================================================
--- sigscheme-trunk/src/sigscheme.c (original)
+++ sigscheme-trunk/src/sigscheme.c Fri Jul 13 04:10:15 2007
@@ -184,10 +184,11 @@
/*=======================================
File Local Function Declarations
=======================================*/
-static void *scm_initialize_internal(void *dummy);
+static char **scm_initialize_internal(const char *const *argv);
#if SCM_USE_EVAL_C_STRING
static void *scm_eval_c_string_internal(const char *exp);
#endif
+static void argv_err(char **argv, const char *err_msg);
/*=======================================
Function Definitions
@@ -198,23 +199,30 @@
* @param storage_conf Storage configuration parameters. NULL instructs
* default.
*/
-SCM_EXPORT void
-scm_initialize(const ScmStorageConf *storage_conf)
+SCM_EXPORT char **
+scm_initialize(const ScmStorageConf *storage_conf, const char *const *argv)
{
+ char **rest_argv;
+
SCM_AGGREGATED_GLOBAL_VARS_INIT();
scm_encoding_init();
scm_init_storage(storage_conf);
- scm_call_with_gc_ready_stack(scm_initialize_internal, NULL);
+ rest_argv =
scm_call_with_gc_ready_stack((ScmGCGateFunc)scm_initialize_internal, (void
*)argv);
l_scm_initialized = scm_true;
+
+ return rest_argv;
}
-static void *
-scm_initialize_internal(void *dummy)
+static char **
+scm_initialize_internal(const char *const *argv)
{
const char *const *feature;
+ char **rest_argv;
+
+ rest_argv = (char **)argv;
/* size constraints */
/* FIXME: check at compile-time */
@@ -242,9 +250,6 @@
scm_set_debug_categories(SCM_DBG_ERRMSG | SCM_DBG_BACKTRACE
| scm_predefined_debug_categories());
-#if SCM_USE_PORT
- scm_init_port();
-#endif
#if SCM_USE_WRITER
scm_init_writer();
#endif
@@ -338,9 +343,17 @@
if (SCM_PTR_BITS == 64)
scm_provide(CONST_STRING("64bit-addr"));
+ if (argv)
+ rest_argv = scm_interpret_argv((char **)argv); /* safe cast */
+
+#if SCM_USE_PORT
+ /* To apply -C <encoding> option for scm_{in,out,err} ports, this
+ * invocation is placed after scm_interpret_argv() */
+ scm_init_port();
+#endif
#if SCM_USE_LOAD
/* Load additional procedures written in Scheme */
- scm_load(SCM_PREPEND_SCMLIBDIR("sigscheme-init.scm"));
+ scm_load_system_file("sigscheme-init.scm");
#endif
/* require-extension is enabled by default */
@@ -348,7 +361,7 @@
scm_require_module("srfi-55");
#endif
- return NULL;
+ return rest_argv;
}
SCM_EXPORT void
@@ -391,20 +404,36 @@
}
#endif /* SCM_USE_EVAL_C_STRING */
+static void
+argv_err(char **argv, const char *err_msg)
+{
+ DECLARE_INTERNAL_FUNCTION("scm_interpret_argv");
+
+ if (l_scm_initialized) {
+ scm_free_argv(argv);
+ ERR(err_msg);
+ } else {
+ fputs(SCM_ERR_HEADER, stderr);
+ fputs(err_msg, stderr);
+ fputs("\n", stderr);
+ exit(EXIT_FAILURE);
+ }
+}
+
/* TODO: parse properly */
/* don't access ScmObj if (!l_scm_initialized) */
SCM_EXPORT char **
scm_interpret_argv(char **argv)
{
char **argp, **rest;
- const char *encoding;
+ const char *encoding, *sys_load_path;
#if SCM_USE_MULTIBYTE_CHAR
ScmCharCodec *specified_codec;
ScmObj err_obj;
#endif
DECLARE_INTERNAL_FUNCTION("scm_interpret_argv");
- encoding = NULL;
+ encoding = sys_load_path = NULL;
argp = &argv[0];
if (strcmp(argv[0], "/usr/bin/env") == 0)
argp++;
@@ -416,19 +445,18 @@
if ((*argp)[0] != '-')
break; /* script name appeared */
- /* character encoding */
if (strcmp(*argp, "-C") == 0) {
+ /* character encoding */
encoding = *++argp;
- if (!encoding) {
- if (l_scm_initialized) {
- scm_free_argv(argv);
- ERR("no encoding name specified");
- } else {
- fputs(SCM_ERR_HEADER "no encoding name specified\n",
- stderr);
- exit(EXIT_FAILURE);
- }
- }
+ if (!encoding)
+ argv_err(argv, "no encoding name specified");
+ } else if (strcmp(*argp, "--system-load-path") == 0) {
+ /* system load path */
+ sys_load_path = *++argp;
+ if (!sys_load_path)
+ argv_err(argv, "no system load path specified");
+ } else {
+ argv_err(argv, "invalid option");
}
}
rest = argp;
@@ -451,14 +479,12 @@
}
scm_current_char_codec = specified_codec;
#else
- if (l_scm_initialized) {
- scm_free_argv(argv);
- PLAIN_ERR(ERRMSG_CODEC_SW_NOT_SUPPORTED);
- } else {
- fprintf(stderr, SCM_ERR_HEADER ERRMSG_CODEC_SW_NOT_SUPPORTED "\n");
- exit(EXIT_FAILURE);
- }
+ argv_err(argv, ERRMSG_CODEC_SW_NOT_SUPPORTED);
#endif
+ }
+
+ if (sys_load_path) {
+ scm_set_system_load_path(sys_load_path);
}
return rest;
Modified: sigscheme-trunk/src/sigscheme.h
==============================================================================
--- sigscheme-trunk/src/sigscheme.h (original)
+++ sigscheme-trunk/src/sigscheme.h Fri Jul 13 04:10:15 2007
@@ -1241,7 +1241,8 @@
SigScheme: Core Functions
===========================================================================*/
/* sigscheme.c */
-SCM_EXPORT void scm_initialize(const ScmStorageConf *storage_conf);
+SCM_EXPORT char **scm_initialize(const ScmStorageConf *storage_conf,
+ const char *const *argv);
SCM_EXPORT void scm_finalize(void);
#if SCM_USE_EVAL_C_STRING
SCM_EXPORT ScmObj scm_eval_c_string(const char *exp);
@@ -1624,8 +1625,10 @@
/* load.c */
#if SCM_USE_LOAD
SCM_EXPORT void scm_set_lib_path(const char *path);
+SCM_EXPORT void scm_set_system_load_path(const char *path);
SCM_EXPORT void scm_load(const char *filename);
SCM_EXPORT ScmObj scm_p_load_path(void);
+SCM_EXPORT ScmObj scm_p_system_load_path(void);
SCM_EXPORT ScmObj scm_p_load(ScmObj filename);
#endif /* SCM_USE_LOAD */
@@ -1647,7 +1650,6 @@
SCM_EXPORT void scm_require(const char *filename);
SCM_EXPORT ScmObj scm_p_symbol_boundp(ScmObj sym, ScmObj rest);
SCM_EXPORT ScmObj scm_p_sscm_version(void);
-SCM_EXPORT ScmObj scm_p_scmlibdir(void);
SCM_EXPORT ScmObj scm_p_current_environment(ScmEvalState *eval_state);
SCM_EXPORT ScmObj scm_p_current_char_codec(void);
SCM_EXPORT ScmObj scm_p_set_current_char_codecx(ScmObj encoding);
Modified: sigscheme-trunk/src/sigschemeinternal.h
==============================================================================
--- sigscheme-trunk/src/sigschemeinternal.h (original)
+++ sigscheme-trunk/src/sigschemeinternal.h Fri Jul 13 04:10:15 2007
@@ -267,9 +267,6 @@
#define SCM_LISTLEN_ENCODE_CIRCULAR(len) (SCM_INT_T_MIN)
#define SCM_LISTLEN_ENCODE_ERROR SCM_LISTLEN_ENCODE_CIRCULAR
-/* only string literal is allowed for the arg 'file' */
-#define SCM_PREPEND_SCMLIBDIR(file) (SCMLIBDIR "/" file)
-
/*=======================================
Utils for Procedure Implementation
=======================================*/
@@ -771,6 +768,7 @@
#if SCM_USE_LOAD
SCM_EXPORT void scm_init_load(void);
SCM_EXPORT void scm_fin_load(void);
+SCM_EXPORT void scm_load_system_file(const char *file);
#endif /* SCM_USE_LOAD */
/* module.c */
