help-smalltalk
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Help-smalltalk] [PATCH] Eliminate shell script wrappers for gst-*


From: Paolo Bonzini
Subject: [Help-smalltalk] [PATCH] Eliminate shell script wrappers for gst-*
Date: Thu, 05 Jul 2007 11:18:11 +0200
User-agent: Thunderbird 2.0.0.4 (Macintosh/20070604)

These are replaced by a single wrapper written in C (it is needed to handle -I and --kernel-directory). The same wrapper is used also for gst-blox for portability (on Windows we don't rely on #! anymore). In the build tree, gst-package will be invoked as (for example) "./gst-tool gst-package"; no more complications with the GST and GST_ARGUMENTS environment variables, and no contortions using "eval" in the shell scripts.

The C wrapper gst-tool.c also subsumes scripts/Getopt.st, which is gone. It implements an option parser compatible with the Smalltalk one (in the Getopt class), though lacking a few features that are not needed by the wrapper.

This prompted to add a couple more features to the File class, most notably "File executable" (path to the current executable). This is needed to merge --load and --test into scripts/Package.st (they were handled by the shell script wrapper).

In the relative near future, scripts/Convert.st will also be handled by the same mechanism.

This more or less concludes the package implementation for 3.0 (I still may add a couple things from Mike Anderson's PackageUtils code).

Paolo
* looking for address@hidden/smalltalk--devo--2.2--patch-445 to compare with
* comparing to address@hidden/smalltalk--devo--2.2--patch-445
D  gst-load.in
D  gst-package.in
D  gst-reload.in
D  gst-sunit.in
A  build-aux/setenv.m4
A  gst-tool.c
A  lib-src/setenv.c
M  scripts/Package.st
M  configure.ac
M  Makefile.am
M  scripts/Browser.st
M  NEWS
M  kernel/File.st
M  scripts/Load.st
M  scripts/Test.st
M  libgst/lib.c
M  libgst/lib.h
M  libgst/dict.c
M  libgst/sysdep.c
M  libgst/sysdep.h
=> gst-blox.in  scripts/Browser.st

* modified files

2007-07-05  Paolo Bonzini  <address@hidden>

        * scripts/Load.st: Add --kernel-directory.
        * scripts/Test.st: Add --kernel-directory.
        * scripts/Package.st: Add --kernel-directory, --load, --test.
        * scripts/Browser.st: Move gst-blox.in here, remove shebang.

        * kernel/File.st: Add #executable and #directory.

        * lib-src/setenv.c: New.

        * libgst/lib.c: Add _gst_executable_path.
        * libgst/lib.h: Set it in gst_smalltalk_args.
        * libgst/dict.c: Set CSymbols.ExecutableFileName.
        * libgst/sysdep.c: Add _gst_find_executable.
        * libgst/sysdep.h: Declare _gst_find_executable.

 


--- orig/Makefile.am
+++ mod/Makefile.am
@@ -32,10 +32,10 @@ SUBDIRS += libgst . $(BUILT_PACKAGES) do
 
 # Running gst inside the build directory...
 
-GST_ARGUMENTS = --no-user-files --kernel-dir="@abs_top_srcdir@/kernel" \
-          --image-dir="@abs_top_builddir@"
-GST = ./gst $(GST_ARGUMENTS)
-GST_PACKAGE = GST=./gst GSTARGS='$(GST_ARGUMENTS)' ./gst-package -I gst.im 
+GST = ./gst --no-user-files --kernel-dir="@abs_top_srcdir@/kernel" \
+       --image-dir="@abs_top_builddir@"
+GST_PACKAGE = ./gst-tool gst-package \
+       -I gst.im --kernel-dir="@abs_top_srcdir@/kernel"
 
 
 ###########################################################
@@ -72,7 +72,7 @@ nodist_lisp_LISP += gst-mode.el
 endif
 endif
 
-bin_SCRIPTS = gst-package gst-config gst-load gst-reload gst-sunit gst-blox
+bin_SCRIPTS = gst-config
 DISTCLEANFILES = termbold termnorm smalltalk-mode.el gst-mode.el pkgrules.tmp
 CLEANFILES = gst.im $(lisp_LISP)
 
@@ -90,12 +90,16 @@ gst-mode.el: gst-mode.el.in
 #
 ###########################################################
 
+AM_CPPFLAGS = -I$(top_srcdir)/libgst           \
+       -DCMD_ZIP="\"$(ZIP)\""                  \
+       -DCMD_INSTALL="\"$(INSTALL)\""          \
+       -DCMD_LN_S="\"$(LN_S)\""
+
 bin_PROGRAMS = gst
 
 gst_SOURCES = main.c
 gst_LDADD = libgst/libgst.la @ICON@
 gst_DEPENDENCIES = libgst/libgst.la @ICON@
-AM_CPPFLAGS = -I$(top_srcdir)/libgst
 
 if ENABLE_DISASSEMBLER
 gst_LDADD += opcode/libdisass.la
@@ -107,6 +111,29 @@ endif
 # a bit slower, and on x86 we also exchange the PIC register for the frame
 gst_LDFLAGS = -export-dynamic -static
 
+# The single gst-tool executable is installed with multiple names, hence
+# we use noinst here.
+noinst_PROGRAMS = gst-tool
+gst_tool_SOURCES = gst-tool.c
+gst_tool_LDADD = libgst/libgst.la
+gst_tool_DEPENDENCIES = libgst/libgst.la
+gst_tool_LDFLAGS = -export-dynamic
+
+GST_EXTRA_TOOLS = gst-reload gst-sunit gst-blox gst-package
+
+uninstall-local::
+       @for i in gst-load $(GST_EXTRA_TOOLS); do \
+         echo rm -f "$(DESTDIR)$(bindir)/$$i"; \
+         rm -f "$(DESTDIR)$(bindir)/$$i"; \
+       done
+
+install-exec-hook::
+       $(INSTALL_PROGRAM_ENV) $(LIBTOOL) --mode=install $(INSTALL) gst-tool 
"$(DESTDIR)$(bindir)/gst-load"
+       @for i in $(GST_EXTRA_TOOLS); do \
+         echo $(LN) -f "$(DESTDIR)$(bindir)/gst-load" 
"$(DESTDIR)$(bindir)/$$i"; \
+         $(LN) -f "$(DESTDIR)$(bindir)/gst-load" "$(DESTDIR)$(bindir)/$$i"; \
+       done
+
 nodist_noinst_HEADERS = config.h
 DISTCLEANFILES += config.h
 
@@ -189,7 +216,7 @@ install-data-hook::
            -f @abs_top_srcdir@/scripts/Finish.st \
            "$(pkgdatadir)" "$(imagedir)" $(MODULES)
 
-uninstall-local:: gst-package
+uninstall-local:: gst-tool
        $(GST_PACKAGE) \
          --uninstall --destdir="$(DESTDIR)" --target-dir="$(pkgdatadir)" \
          --srcdir=$(srcdir) $(DESTDIR)$(pkgdatadir)/packages.xml


--- orig/NEWS
+++ mod/NEWS
@@ -96,14 +96,14 @@ o   Processes that are garbage collected
 o   Startup time and quit time were improved widely (the time for running
     a simple "Hello, World" program is about one fifth of 2.3.x).
 
+o   The "<category: 'bar'>" pragma can be used to set the category
+    of a method.
+
 o   The graphical browser can now be started just by typing "gst-blox".
 
 o   The image is now installed in /usr/local/var/lib/smalltalk (which in
     most distributions will map to /var/lib/smalltalk).
 
-o   A pragma like "<category: 'bar'>" can be used to set the category
-    of a method.
-
 o   Since they are not portable outside Unix systems, the `archive' virtual
     filesystems (deb, lslR, mailfs, patchfs, uar, urar, uzoo, ulha, ucpio, 
utar)
     are now available only if the VFSAddOns package is loaded.  Without the


--- orig/configure.ac
+++ mod/configure.ac
@@ -217,13 +217,14 @@ AC_FUNC_OBSTACK
 
 AC_CHECK_LIB(m, atan)
 GST_REPLACE_POLL
+gt_FUNC_SETENV
 AC_REPLACE_FUNCS(putenv strdup strerror strsignal mkstemp getpagesize \
        getdtablesize strstr ftruncate floorl ceill sqrtl frexpl ldexpl asinl \
        acosl atanl logl expl tanl sinl cosl truncl lrintl strsep strpbrk)
 AC_CHECK_FUNCS_ONCE(gethostname memcpy memmove sighold uname sbrk usleep lstat 
\
        grantpt popen getrusage gettimeofday fork strchr utimes utime readlink \
        sigsetmask alarm select mprotect madvise waitpid \
-       setsid spawnl nanosleep pread pwrite)
+       setsid spawnl nanosleep pread pwrite _NSGetExecutablePath)
 
 GST_FUNC_STRTOUL
 GST_FUNC_LOCALTIME
@@ -389,11 +390,6 @@ AC_SUBST(LTLIBOBJS)
 dnl Scripts & data files
 AC_CONFIG_FILES(gnu-smalltalk.pc)
 AC_CONFIG_FILES(gst-config, chmod +x gst-config)
-AC_CONFIG_FILES(gst-package, chmod +x gst-package)
-AC_CONFIG_FILES(gst-load, chmod +x gst-load)
-AC_CONFIG_FILES(gst-reload, chmod +x gst-reload)
-AC_CONFIG_FILES(gst-sunit, chmod +x gst-sunit)
-AC_CONFIG_FILES(gst-blox, chmod +x gst-blox)
 AC_CONFIG_FILES(tests/gst, chmod +x tests/gst)
 AC_CONFIG_FILES(libc.la)
 


--- orig/kernel/File.st
+++ mod/kernel/File.st
@@ -302,6 +302,11 @@ isAccessible: fileName
 
 !File class methodsFor: 'reading system defaults'!
 
+executable
+    "Answer the full path to the executable being run."
+    ^ExecutableFileName
+!
+
 image
     "Answer the full path to the image being used."
     ^ImageFileName
@@ -471,6 +476,11 @@ stripPath
     ^File stripPathFrom: self name
 !
 
+directory
+    "Answer the Directory object for the receiver's path"
+    ^Directory name: (File pathFor: self name)
+!
+
 path
     "Answer the path (if any) of the receiver"
     ^File pathFor: self name





--- orig/libgst/dict.c
+++ mod/libgst/dict.c
@@ -1057,12 +1057,10 @@ init_runtime_objects (void)
   add_smalltalk ("UserFileBasePath", _gst_string_new 
(_gst_user_file_base_path));
   add_smalltalk ("ModulePath", _gst_string_new (MODULE_PATH));
   add_smalltalk ("LibexecPath", _gst_string_new (LIBEXEC_PATH));
-  add_smalltalk ("ImageFilePath",
-                _gst_string_new (_gst_image_file_path));
-  add_smalltalk ("ImageFileName",
-                _gst_string_new (_gst_binary_image_name));
-  add_smalltalk ("OutputVerbosity",
-                FROM_INT (_gst_verbosity));
+  add_smalltalk ("ImageFilePath", _gst_string_new (_gst_image_file_path));
+  add_smalltalk ("ExecutableFileName", _gst_string_new (_gst_executable_path));
+  add_smalltalk ("ImageFileName", _gst_string_new (_gst_binary_image_name));
+  add_smalltalk ("OutputVerbosity", FROM_INT (_gst_verbosity));
   add_smalltalk ("RegressionTesting",
                 _gst_regression_testing ? _gst_true_oop : _gst_false_oop);
 


--- orig/libgst/lib.c
+++ mod/libgst/lib.c
@@ -191,6 +191,9 @@ const char *_gst_image_file_path = NULL;
    home directory.  */
 const char *_gst_user_file_base_path;
 
+/* The path to the executable, derived from argv[0].  */
+const char *_gst_executable_path;
+
 /* Whether to look for user files.  */
 static mst_Boolean no_user_files;
 
@@ -441,6 +444,7 @@ gst_smalltalk_args (int argc,
 {
   smalltalk_argc = argc;
   smalltalk_argv = argv;
+  _gst_executable_path = _gst_find_executable (argv[0]);
 }
 
 


--- orig/libgst/lib.h
+++ mod/libgst/lib.h
@@ -66,6 +66,9 @@ extern const char *_gst_image_file_path 
    home directory.  */
 extern const char *_gst_user_file_base_path;
 
+/* The path to the executable.  */
+extern const char *_gst_executable_path;
+
 /* This is the name of the binary image to load.  If it is not NULL after the
    command line is parsed, the checking of the dates of the kernel source files
    against the image file date is overridden.  If it is NULL, it is set to


--- orig/libgst/sysdep.c
+++ mod/libgst/sysdep.c
@@ -95,6 +95,12 @@
 # include <windows.h>
 #endif
 
+/* Get declaration of _NSGetExecutablePath on MacOS X 10.2 or newer.  */
+#if HAVE_MACH_O_DYLD_H
+# define ENUM_DYLD_BOOL
+# include <mach-o/dyld.h>
+#endif
+
 #if defined MAP_ANONYMOUS && !defined MAP_ANON
 # define MAP_ANON MAP_ANONYMOUS
 #endif
@@ -967,6 +973,159 @@ _gst_file_is_executable (const char *fil
 {
   return (access (fileName, X_OK) == 0);
 }
+
+#ifdef __linux__
+/* File descriptor of the executable, used for double checking.  */
+static int executable_fd = -1;
+#endif
+
+/* Tests whether a given pathname may belong to the executable.  */
+static mst_Boolean
+maybe_executable (const char *filename)
+{
+  if (!_gst_file_is_executable (filename))
+    return false;
+
+#ifdef __linux__
+  if (executable_fd >= 0)
+    {
+      /* If we already have an executable_fd, check that filename points to
+        the same inode.  */
+      struct stat statexe, statfile;
+
+      if (fstat (executable_fd, &statexe) < 0
+         || stat (filename, &statfile) < 0
+         && !(statfile.st_dev
+              && statfile.st_dev == statexe.st_dev
+              && statfile.st_ino == statexe.st_ino))
+       return false;
+
+      close (executable_fd);
+      executable_fd = -1;
+    }
+#endif
+
+  return true;
+}
+
+/* Determine the full pathname of the current executable, freshly allocated.
+   Return NULL if unknown.  Guaranteed to work on Linux and Win32, Mac OS X.
+   Likely to work on the other Unixes (maybe except BeOS), under most
+   conditions.  */
+char *
+_gst_find_executable (const char *argv0)
+{
+#if defined WIN32
+  char location[MAX_PATH];
+  int length = GetModuleFileName (NULL, location, sizeof (location));
+  if (length <= 0)
+    return NULL;
+
+#if defined __CYGWIN__
+  {
+    /* On Cygwin, we need to convert paths coming from Win32 system calls
+       to the Unix-like slashified notation.  */
+    static char location_as_posix_path[2 * MAX_PATH];
+
+    /* There's no error return defined for cygwin_conv_to_posix_path.
+       See cygwin-api/func-cygwin-conv-to-posix-path.html.
+       Does it overflow the buffer of expected size MAX_PATH or does it
+       truncate the path?  I don't know.  Let's catch both.  */
+    cygwin_conv_to_posix_path (location, location_as_posix_path);
+    location_as_posix_path[MAX_PATH - 1] = '\0';
+    if (strlen (location_as_posix_path) >= MAX_PATH - 1)
+      /* A sign of buffer overflow or path truncation.  */
+      return NULL;
+
+    return _gst_get_full_file_name (location_as_posix_path);
+  }
+#else
+  return xstrdup (location);
+#endif
+
+#else /* Unix && !Cygwin */
+#ifdef PATH_MAX
+  int path_max = PATH_MAX;
+#else
+  int path_max = pathconf (name, _PC_PATH_MAX);
+  if (path_max <= 0)
+    path_max = 1024;
+#endif
+
+#if HAVE_MACH_O_DYLD_H && HAVE__NSGETEXECUTABLEPATH
+  char *location = alloca (path_max);
+  uint32_t length = path_max;
+  if (_NSGetExecutablePath (location, &length) == 0 && location[0] == '/')
+    return _gst_get_full_file_name (location);
+
+#elif defined __linux__
+  /* The executable is accessible as /proc/<pid>/exe.  In newer Linux
+     versions, also as /proc/self/exe.  Linux >= 2.1 provides a symlink
+     to the true pathname; older Linux versions give only device and ino,
+     enclosed in brackets, which we cannot use here.  */
+  {
+    char buf[6 + 10 + 5];
+    char *location = alloca (path_max);
+
+    sprintf (buf, "/proc/%d/exe", getpid ());
+    location = xreadlink (buf);
+    n = readlink (buf, location, path_max);
+    if (n > 0 && location[0] != '[')
+      return location;
+    if (executable_fd < 0)
+      executable_fd = open (buf, O_RDONLY, 0);
+  }
+#endif
+
+  if (*argv0 == '-')
+    argv0++;
+
+  /* Guess the executable's full path.  We assume the executable has been
+     called via execlp() or execvp() with properly set up argv[0].
+     exec searches paths without slashes in the directory list given
+     by $PATH.  */
+  if (!strchr (argv0, '/'))
+    {
+      const char *path = getenv ("PATH");
+      const char *p;
+      const char *p_next;
+
+      for (p = path; p; p = p_next + 1)
+       {
+         char *concat_name;
+
+         p_next = strchr (p, ':');
+         /* An empty PATH element designates the current directory.  */
+         if (p_next == p + 1)
+           concat_name = xstrdup (argv0);
+         else if (!p_next)
+           asprintf (&concat_name, "%s/%s", p, argv0);
+         else
+           asprintf (&concat_name, "%.*s/%s", p_next - p, p, argv0);
+
+         if (maybe_executable (concat_name))
+           {
+             char *full_path = _gst_get_full_file_name (concat_name);
+             free (concat_name);
+             return full_path;
+           }
+
+         free (concat_name);
+       }
+      /* Not found in the PATH, assume the current directory.  */
+    }
+
+  if (maybe_executable (argv0))
+    return _gst_get_full_file_name (argv0);
+
+  /* No way to find the executable.  */
+#ifdef __linux__
+  close (executable_fd);
+  executable_fd = -1;
+#endif
+  return NULL;
+#endif
+}
 
 
 /* Code to use PTY's did not work on Mac OS.  I'm keeping the Unix code,


--- orig/libgst/sysdep.h
+++ mod/libgst/sysdep.h
@@ -186,6 +186,10 @@ extern mst_Boolean _gst_file_is_writeabl
 extern mst_Boolean _gst_file_is_executable (const char *fileName)
   ATTRIBUTE_HIDDEN;
 
+/* Return a path to the executable given argv[0].  */
+extern char *_gst_find_executable (const char *argv0)
+  ATTRIBUTE_HIDDEN;
+
 /* Answer true if the file descriptor FD is associated to a pipe
    (it cannot be seeked through).  */
 extern mst_Boolean _gst_is_pipe (int fd)


--- orig/gst-blox.in
+++ mod/scripts/Browser.st
@@ -1,5 +1,3 @@
-#! @bindir@/gst -f
-
 "======================================================================
 |
 |   Smalltalk GUI launching script


--- orig/scripts/Load.st
+++ mod/scripts/Load.st
@@ -51,13 +51,14 @@ Options:
     -n --dry-run          don''t save the image after loading
     -t --test             run SUnit tests if available
     -I --image-file=FILE  load into the specified image
+       --kernel-dir=PATH  use the specified kernel directory
     -h --help             show this message
 '.
 
 "Parse the command-line arguments."
 Smalltalk
     arguments: '-h|--help -q|--quiet -v|-V|--verbose -n|--dry-run -f|--force
-               -t|--test -I|--image-file:'
+               -t|--test -I|--image-file: --kernel-directory:'
     do: [ :opt :arg |
 
     opt = 'help' ifTrue: [


--- orig/scripts/Package.st
+++ mod/scripts/Package.st
@@ -182,7 +182,7 @@ Directory extend [
     emitMkdir [
        | doThat |
        self exists ifTrue: [ ^self ].
-       Command execute: [ (Directory name: self path) emitMkdir ].
+       Command execute: [ self directory emitMkdir ].
        ('mkdir %1' % { self }) displayNl.
        Command execute: [ Directory create: self name ].
     ]
@@ -348,12 +348,19 @@ Command subclass: PkgInstall [
 
     run [
         "Create the installation directory."
-       | script result |
         self installDir emitMkdir.
        [ super run ] ensure: [
            tmpDir isNil ifFalse: [ tmpDir remove ] ].
 
-       (self isOption: 'test') ifFalse: [ ^self ].
+       (Command dryRun not and: [ self isOption: 'load' ])
+           ifTrue: [ ^self loadPackages ].
+
+       (self isOption: 'test') ifTrue: [ self runTests ]
+    ]
+
+    runTests [
+       "Run SUnit tests, used unless --load is given too."
+       | script result |
        script := ''.
        self packages do: [ :each || pkg |
            pkg := each.
@@ -371,6 +378,30 @@ Command subclass: PkgInstall [
            ifFalse: [ ObjectMemory quit: 1 ]
     ]
 
+    loadPackages [
+       "Call gst-load, needed because we added our code to the image."
+       | gstPackage execDir gstLoad pat packageList |
+       gstPackage := File name: File executable.
+       gstPackage stripPath = 'gst-tool'
+           ifTrue: [
+               gstLoad := gstPackage.
+               pat := '%1 gst-load -I %2 --kernel-directory %3 %4 %5' ]
+           ifFalse: [
+               gstLoad := gstPackage directory fileAt: 'gst-load'.
+               pat := '%1 -I %2 --kernel-directory %3 %4 %5' ].
+
+       packageList := ''.
+       self packages
+           do: [ :each | packageList := packageList, ' ', each name ].
+
+       Smalltalk system: (pat % {
+           gstLoad.
+           File name: File image.
+           Directory name: Directory kernel.
+           (self isOption: 'test') ifTrue: [ '--test' ] ifFalse: [ '' ].
+           packageList })
+    ]
+
     tmpDir [
        tmpDir isNil ifTrue: [
             tmpDir := Directory createTemporary: Directory temporary, 
'/gstar-'.
@@ -462,18 +493,23 @@ helpString := 
 'Usage:
     gst-package [OPTION]... FILES...
 
-    -n, --dry-run               print commands rather than running them
+Operation modes:
+        --install               make or install STAR packages (default)
         --uninstall             remove the packages mentioned in the FILES
         --dist                  copy files instead of creating STAR files.
         --list-files PKG        just output the list of files in the package
         --list-packages         just output the list of packages in the files
+       --help                  display this message and exit
+       --version               print version information and exit
+
+Common suboptions:
+    -n, --dry-run               print commands without running them
        --srcdir DIR            look for non-built files in directory DIR
        --distdir DIR           for --dist, place files in directory DIR
        --destdir DIR           prefix the destination directory with DIR
         --target-directory DIR  install the files in DIR (unused for --dist)
-
-       --help                  display this message and exit
-       --version               print version information and exit
+    -I, --image-file=FILE       load into the specified image
+        --kernel-dir=PATH       use the specified kernel directory
 
 --install suboptions:
        --test                  run unit tests after merging
@@ -495,13 +531,13 @@ The default target directory is ', Direc
 
 [
     Smalltalk
-        "--load and --image-file are processed by gst-package.
+        "--kenrel-directory and --image-file are processed by gst-tool.
         --no-load present for backwards compatibility, it is now the default.
         --no-install is also present for backwards compatibility."
         arguments: '-h|--help --no-load --test --load --no-install --uninstall
             --dist -t|--target-directory: --list-files: --list-packages
             --srcdir: --distdir|--destdir: -n|--dry-run --all-files
-           --vpath --copy -I|--image-file:'
+           --vpath --copy -I|--image-file: --kernel-directory:'
 
         do: [ :opt :arg |
             opt = 'help' ifTrue: [


--- orig/scripts/Test.st
+++ mod/scripts/Test.st
@@ -46,13 +46,14 @@ Options:
     -f --file=FILE        load file before running subsequent tests
     -p --package=PACKAGE  load package and run its tests
     -I --image-file=FILE  run tests on the specified image file
+       --kernel-dir=PATH  use the specified kernel directory
     -h --help             show this message
 '.
 
 "Parse the command-line arguments."
 Smalltalk
     arguments: '-h|--help -q|--quiet -v|-V|--verbose -f|--file: -p|--package:
-               -I|--image-file:'
+               -I|--image-file: --kernel-directory:'
     do: [ :opt :arg |
 
     opt = 'help' ifTrue: [



* added files

--- /dev/null
+++ mod/build-aux/setenv.m4
@@ -0,0 +1,30 @@
+# setenv.m4 serial 6
+dnl Copyright (C) 2001-2004, 2006 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gt_FUNC_SETENV],
+[
+  AC_REPLACE_FUNCS(setenv)
+  gt_CHECK_VAR_DECL([#include <unistd.h>], environ)
+])
+
+# Check if a variable is properly declared.
+# gt_CHECK_VAR_DECL(includes,variable)
+AC_DEFUN([gt_CHECK_VAR_DECL],
+[
+  define([gt_cv_var], [gt_cv_var_]$2[_declaration])
+  AC_MSG_CHECKING([if $2 is properly declared])
+  AC_CACHE_VAL(gt_cv_var, [
+    AC_TRY_COMPILE([$1
+      extern struct { int foo; } $2;],
+      [$2.foo = 1;],
+      gt_cv_var=no,
+      gt_cv_var=yes)])
+  AC_MSG_RESULT($gt_cv_var)
+  if test $gt_cv_var = yes; then
+    AC_DEFINE([HAVE_]translit($2, [a-z], [A-Z])[_DECL], 1,
+              [Define if you have the declaration of $2.])
+  fi
+])
--- /dev/null
+++ mod/gst-tool.c
@@ -0,0 +1,410 @@
+/***********************************************************************
+ *
+ *     Option handling and dispatching to installed .st scripts
+ *
+ *
+ ***********************************************************************/
+
+/***********************************************************************
+ *
+ * Copyright 2007 Free Software Foundation, Inc.
+ * Written by Paolo Bonzini.
+ *
+ * This file is part of GNU Smalltalk.
+ *
+ * GNU Smalltalk is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by the Free
+ * Software Foundation; either version 2, or (at your option) any later 
+ * version.
+ * 
+ * Linking GNU Smalltalk statically or dynamically with other modules is
+ * making a combined work based on GNU Smalltalk.  Thus, the terms and
+ * conditions of the GNU General Public License cover the whole
+ * combination.
+ *
+ * In addition, as a special exception, the Free Software Foundation
+ * give you permission to combine GNU Smalltalk with free software
+ * programs or libraries that are released under the GNU LGPL and with
+ * independent programs running under the GNU Smalltalk virtual machine.
+ *
+ * You may copy and distribute such a system following the terms of the
+ * GNU GPL for GNU Smalltalk and the licenses of the other code
+ * concerned, provided that you include the source code of that other
+ * code when and as the GNU GPL requires distribution of source code.
+ *
+ * Note that people who make modified versions of GNU Smalltalk are not
+ * obligated to grant this special exception for their modified
+ * versions; it is their choice whether to do so.  The GNU General
+ * Public License gives permission to release a modified version without
+ * this exception; this exception also makes it possible to release a
+ * modified version which carries forward this exception.
+ *
+ * GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 
+ * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+ * more details.
+ * 
+ * You should have received a copy of the GNU General Public License along with
+ * GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
+ * Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  
+ *
+ ***********************************************************************/
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+
+#include "gstpub.h"
+
+#include <ctype.h>
+#include <stdlib.h>
+#include <string.h>
+#include <stdarg.h>
+#include <stdio.h>
+
+const char *program_name;
+const char **smalltalk_argv;
+int smalltalk_argc;
+int error;
+
+struct tool {
+  const char *name;
+  const char *script;
+  const char *options;
+  const char *force_opt;
+};
+
+struct tool tools[] = {
+  {
+    "gst-load", "scripts/Load.st",
+    "-h|--help -q|--quiet -v|-V|--verbose -n|--dry-run -f|--force \
+       -t|--test -I|--image-file: --kernel-directory:",
+    NULL
+  },
+  {
+    "gst-reload", "scripts/Load.st",
+    "-h|--help -q|--quiet -v|-V|--verbose -n|--dry-run -f|--force \
+       -t|--test -I|--image-file: --kernel-directory:",
+    "--force"
+  },
+  {
+    "gst-package", "scripts/Package.st",
+    "-h|--help --version --load --no-load --no-install --uninstall --dist \
+        --test -t|--target-directory: --list-files: --list-packages \
+        --srcdir: --distdir|--destdir: --copy --all-files --vpath \
+        -n|--dry-run -I|--image-file: --kernel-directory:",
+    NULL
+  },
+  {
+    "gst-sunit", "scripts/Test.st",
+    "-h|--help -q|--quiet -v|-V|--verbose -f|--file: -p|--package: \
+       -I|--image-file: --kernel-directory:",
+    NULL
+  },
+  {
+    "gst-blox", "scripts/Browser.st",
+    "-I|--image-file: --kernel-directory:",
+    NULL
+  },
+  { NULL, NULL, NULL, NULL }
+};
+
+/* An option parser compatible with the one in the Getopt class.
+   Does not support canonical option names, otherwise it is pretty
+   complete.  */
+ 
+struct option {
+  char arg;
+  const char *name;
+  struct option *next;
+};
+
+#define OPT_NONE       0
+#define OPT_MANDATORY  1
+#define OPT_OPTIONAL   2
+
+char short_opts[1 << (sizeof (char) * 8)];
+struct option *long_opts;
+
+void
+option_error (const char *s, ...)
+{
+  static int first;
+  va_list ap;
+  if (!first)
+    return;
+
+  error = 1;
+  first = 1;
+  va_start (ap, s);
+
+  vfprintf (stderr, s, ap);
+  fprintf (stderr, "\n");
+  va_end (ap);
+  exit (1);
+}
+
+void
+setup_option (char *p, char *end)
+{
+  int arg = 0;
+  if (*p != '-')
+    abort ();
+
+  while (*end == ':')
+    {
+      *end-- = '\0';
+      arg++;
+    }
+
+  if (arg > 2)
+    abort ();
+
+  while (p)
+    {
+      unsigned char short_opt = 0;
+      const char *long_opt = NULL;
+
+      if (*p++ != '-')
+       abort ();
+      if (*p == '-')
+       {
+         ++p;
+         long_opt = strsep (&p, "|");
+       }
+      else
+       {
+         short_opt = *p++;
+         if (!*p)
+           p = NULL;
+         else if (*p++ != '|')
+           abort ();
+       }
+
+      if (long_opt)
+       {
+         struct option *opt = malloc (sizeof (struct option));
+         opt->name = strdup (long_opt);
+         opt->arg = arg;
+         opt->next = long_opts;
+         long_opts = opt;
+       }
+      else
+       short_opts[(unsigned char) short_opt] = arg;
+    }
+}
+
+void
+setup_options (const char *str)
+{
+  char *copy = strdup (str);
+  char *p = copy;
+
+  memset (short_opts, -1, sizeof (short_opts));
+  do
+    {
+      while (isspace (*p))
+        p++;
+      if (*p)
+       {
+          char *begin, *end;
+          begin = strsep (&p, " \t\n");
+          end = begin + strlen (begin) - 1;
+          setup_option (begin, end);
+       }
+    }
+  while (p && *p);
+
+  free (copy);
+}
+
+void
+parse_option (int short_opt, const char *long_opt, const char *arg)
+{
+  if (short_opt == 'I'
+      || (long_opt && !strcmp (long_opt, "image-file")))
+    {
+      static int found_option;
+      if (found_option)
+       option_error ("duplicate --image-file option");
+      found_option = true;
+      smalltalk_argv[smalltalk_argc++] = "-I";
+      smalltalk_argv[smalltalk_argc++] = arg;
+    }
+
+  if (long_opt && !strcmp (long_opt, "kernel-directory"))
+    {
+      static int found_option;
+      if (found_option)
+       option_error ("duplicate --kernel-directory option");
+      found_option = true;
+      smalltalk_argv[smalltalk_argc++] = "--kernel-directory";
+      smalltalk_argv[smalltalk_argc++] = arg;
+    }
+}
+
+int
+parse_short_options (const char *name, const char *arg)
+{
+  while (*name)
+    {
+      unsigned char short_opt = (unsigned char) *name++;
+      int have_arg = short_opts[short_opt];
+      if (have_arg == -1)
+        option_error ("invalid option -%c", short_opt);
+
+      if (have_arg == OPT_NONE || (have_arg == OPT_OPTIONAL && !*name))
+        parse_option (short_opt, NULL, NULL);
+
+      else if (*name || arg)
+        {
+          parse_option (short_opt, NULL, *name ? name : arg);
+          return *name ? 1 : 2;
+        }
+
+      else /* if (have_arg == OPT_MANDATORY) */
+        option_error ("expected argument for option -%s", name[-1]);
+    }
+
+  return 1;
+}
+
+int
+parse_long_option (const char *name, const char *arg)
+{
+  struct option *all_opts, *opt = NULL;
+  int num_matches = 0;
+  int len;
+  const char *p = strchr (name, '=');
+
+  if (!p)
+    len = strlen (name);
+  else
+    len = p++ - name;
+
+  for (all_opts = long_opts; all_opts; all_opts = all_opts->next)
+    if (!memcmp (name, all_opts->name, len))
+      {
+       opt = all_opts;
+       if (opt->name[len] == '\0')
+         {
+           /* Exact match!  */
+           num_matches = 1;
+           break;
+         }
+       else
+         num_matches++;
+      }
+
+  if (!opt)
+    option_error ("invalid option --%.*s", len, name);
+
+  if (num_matches > 1)
+    option_error ("ambiguous option --%.*s", len, name);
+
+  if (opt->arg == OPT_NONE && p)
+    option_error ("unexpected argument for option --%s", opt->name);
+
+  else if (p || opt->arg != OPT_MANDATORY)
+    {
+      parse_option (0, opt->name, p);
+      return 1;
+    }
+
+  else if (!arg)
+    option_error ("expected argument for option --%s", opt->name);
+
+  else
+    {
+      parse_option (0, opt->name, arg);
+      return 2;
+    }
+
+  return 1;
+}
+
+void
+parse_options (const char **argv)
+{
+  int at_end = 0;
+  while (*argv)
+    {
+      if (at_end || argv[0][0] != '-')
+       {
+         parse_option (0, NULL, argv[0]);
+         argv++;
+       }
+
+      else if (argv[0][1] != '-')
+       argv += parse_short_options (&argv[0][1], argv[1]);
+
+      else if (argv[0][2] == '\0')
+       {
+         at_end = true;
+         argv++;
+       }
+
+      else
+       argv += parse_long_option (&argv[0][2], argv[1]);
+    }
+}
+
+int
+main(int argc, const char **argv)
+{
+  int i;
+  int result;
+
+  program_name = strrchr (argv[0], '/');
+  if (program_name)
+    program_name++;
+  else
+    program_name = argv[0];
+
+  if (!strcmp (program_name, "gst-tool"))
+    {
+      argv++, argc--;
+      program_name = argv[0];
+    }
+
+  smalltalk_argv = alloca (sizeof (const char *) * (argc + 9));
+  smalltalk_argc = 1;
+  smalltalk_argv[0] = argv[0];
+
+  for (i = 0; ; i++)
+    if (!tools[i].name)
+      exit (127);
+    else if (!strcmp (tools[i].name, program_name))
+      break;
+
+  setup_options (tools[i].options);
+  parse_options (&argv[1]);
+
+  smalltalk_argv[smalltalk_argc++] = "--no-user-files";
+  smalltalk_argv[smalltalk_argc++] = "-qK";
+  smalltalk_argv[smalltalk_argc++] = tools[i].script;
+  smalltalk_argv[smalltalk_argc++] = "-a";
+  if (tools[i].force_opt)
+    smalltalk_argv[smalltalk_argc++] = tools[i].force_opt;
+
+  memcpy (&smalltalk_argv[smalltalk_argc], &argv[1], argc * sizeof (char *));
+  smalltalk_argc += argc - 1;
+
+#ifdef CMD_LN_S
+  setenv ("LN_S", CMD_LN_S, 0);
+#endif
+#ifdef CMD_INSTALL
+  setenv ("INSTALL", CMD_INSTALL, 0);
+#endif
+#ifdef CMD_ZIP
+  setenv ("XZIP", CMD_ZIP, 0);
+#endif
+
+  gst_smalltalk_args(smalltalk_argc, smalltalk_argv);
+  result = gst_init_smalltalk();
+  if (result != 0)
+    exit (result < 0 ? 1 : result);
+    
+  gst_top_level_loop();
+  exit (error ? 1 : 0);
+}
--- /dev/null
+++ mod/lib-src/setenv.c
@@ -0,0 +1,120 @@
+/* Copyright (C) 1992,1995-1999,2000-2003,2005,2006 Free Software Foundation, 
Inc.
+   This file is part of the GNU C Library.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License along
+   with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+
+#include <config.h>
+#include <alloca.h>
+
+#include <errno.h>
+#ifndef __set_errno
+# define __set_errno(ev) ((errno) = (ev))
+#endif
+
+#include <stdlib.h>
+#include <string.h>
+#if HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+
+#ifndef HAVE_ENVIRON_DECL
+extern char **environ;
+#endif
+
+
+/* If this variable is not a null pointer we allocated the current
+   environment.  */
+static char **last_environ;
+
+
+/* This function is used by `setenv' and `putenv'.  The difference between
+   the two functions is that for the former must create a new string which
+   is then placed in the environment, while the argument of `putenv'
+   must be used directly.  This is all complicated by the fact that we try
+   to reuse values once generated for a `setenv' call since we can never
+   free the strings.  */
+int
+setenv (const char *name, const char *value, int replace)
+{
+  register char **ep;
+  register size_t size;
+  const size_t namelen = strlen (name);
+  const size_t vallen = value != NULL ? strlen (value) + 1 : 0;
+
+  /* We have to get the pointer now that we have the lock and not earlier
+     since another thread might have created a new environment.  */
+  ep = environ;
+
+  size = 0;
+  if (ep != NULL)
+    {
+      for (; *ep != NULL; ++ep)
+       if (!strncmp (*ep, name, namelen) && (*ep)[namelen] == '=')
+         break;
+       else
+         ++size;
+    }
+
+  if (ep == NULL || *ep == NULL)
+    {
+      char **new_environ;
+
+      /* We allocated this space; we can extend it.  */
+      new_environ =
+       (char **) (last_environ == NULL
+                  ? malloc ((size + 2) * sizeof (char *))
+                  : realloc (last_environ, (size + 2) * sizeof (char *)));
+      if (new_environ == NULL)
+       return -1;
+
+      new_environ[size] = (char *) malloc (namelen + 1 + vallen);
+      if (new_environ[size] == NULL)
+       {
+         __set_errno (ENOMEM);
+         return -1;
+       }
+
+      memcpy (new_environ[size], name, namelen);
+      new_environ[size][namelen] = '=';
+      memcpy (&new_environ[size][namelen + 1], value, vallen);
+
+      if (environ != last_environ)
+       memcpy ((char *) new_environ, (char *) environ,
+               size * sizeof (char *));
+
+      new_environ[size + 1] = NULL;
+
+      last_environ = environ = new_environ;
+    }
+  else if (replace)
+    {
+      char *np;
+
+      np = malloc (namelen + 1 + vallen);
+      if (np == NULL)
+       {
+         __set_errno (ENOMEM);
+         return -1;
+       }
+
+      memcpy (np, name, namelen);
+      np[namelen] = '=';
+      memcpy (&np[namelen + 1], value, vallen);
+
+      *ep = np;
+    }
+
+  return 0;
+}


reply via email to

[Prev in Thread] Current Thread [Next in Thread]