[PATCH] remove --image-dir (failed experiment) and redo library API
Locked
[PATCH] remove --image-dir (failed experiment) and redo library API
 
|
1) About --image-dir: we can do much better, i.e. eliminate this
contortion and make the image directory the directory of the image file. The catch is that -I disables the "look up if the kernel has been updated and rebuild the image if it's the case", so I added an option to leave it enabled when -I is used. The previous gst --image-dir DIR is equivalent to the new gst -I DIR/gst.im --maybe-rebuild-image But I guess that in most cases you don't care about rebuilding the kernel or just use -i to force it, as in gst -iI DIR/gst.im For this reason the long option has no short counterpart. 2) now that we actually have two clients of the library (gst and gst-tool), it's clear that the old interface just sucks. Decoding command-line options belongs in the command line tools, not in the library. gst-tool ends up decoding command-line options --kernel-directory and -I twice! This is backwards incompatible and breaks binary compatibility, but I don't think it affects anyone in the world... The new interface is like this: - gst_smalltalk_args receives the arguments for the Smalltalk script, i.e. what "Smalltalk arguments" will return - no gst_init_smalltalk anymore; the new gst_initialize function receives the kernel directory, image file, and a few flags. The first two arguments can be NULL for default kernel directory and image file. - no gst_top_level_loop anymore, replaced by a new interface to execute files specified on the command line and to parse stdin. Other cruft is now expelled out of the library, for example Emacs process mode. It just didn't belong there too, and the gst executable can provide it easily. gst-tool.c benefits from this code, and libgst/lib.c (renamed to files.c) is much more self-contained. 3) Since client code will use more part of the API, I made all of callin.c public with a gst prefix. At the same time I established a convention that code inside libgst uses functions that are private and have _gst prefix, while the same functions are provided outside with gst prefix. This is faster for various complicated reasons related to how ELF works, and it is implemented in a new gstpub.c file. Paolo 2007-07-08 Paolo Bonzini <[hidden email]> * libgst/lib.c: Rename... * libgst/files.c: ... to this. * libgst/files.c: Change "gst_" functions to "_gst_". * libgst/callin.c: Move gst_interpreter_proxy and _gst_init_vmproxy... * libgst/gstpub.c: ... here (new file). Add "gst_*" functions. * libgst/callin.h: Rename *cobject functions to *c_object. * libgst/interp.c: Change bool_addr_index to _gst_{get,set}_var. * libgst/prims.def: Switch to new interface. * libgst/files.c: Rename find_kernel_file to _gst_find_file, drop second parameter. * libgst/input.c: Add _gst_process_stdin, _gst_process_file. * libgst/gstpub.c: Add public and VMProxy counterparts. * libgst/comp.c: Turn _gst_invoke_hook parameter into an enum. * libgst/files.c: Turn _gst_invoke_hook parameter into an enum. * libgst/save.c: Turn _gst_invoke_hook parameter into an enum. * libgst/gstpub.c: Add public and VMProxy counterparts. * libgst/input.c: Add _gst_no_tty and turn "prompt" field into char *. * libgst/files.c: Remove --emacs-process and -S handling. * libgst/files.c: Create _gst_initialize out of init_paths and _gst_init_smalltalk, remove SMALLTALK_KERNEL and SMALLTALK_IMAGE handling out of init_paths, remove option handling, always derive image path from image file. * libgst/callin.c: Change _gst_init_smalltalk calls to _gst_initialize. * libgst/gst.h: Add enums for above changes. * looking for [hidden email]--2004b/smalltalk--devo--2.2--patch-449 to compare with * comparing to [hidden email]--2004b/smalltalk--devo--2.2--patch-449 A libgst/gstpub.c M gst-tool.c M configure.ac M doc/Makefile.am M doc/gst.1 M doc/gst.texi M Makefile.am M NEWS M libgst/ChangeLog M libgst/Makefile.am M libgst/callin.c M libgst/callin.h M libgst/cint.c M libgst/gst.h M libgst/gstpriv.h M libgst/gstpub.h M libgst/comp.c M libgst/input.c M libgst/input.h M libgst/interp.c M libgst/interp.h M libgst/files.c M libgst/files.h M libgst/comp.h M libgst/save.c M main.c M libgst/prims.def => libgst/lib.c libgst/files.c => libgst/lib.h libgst/files.h * modified files --- orig/Makefile.am +++ mod/Makefile.am @@ -32,10 +32,9 @@ SUBDIRS += libgst . $(BUILT_PACKAGES) do # Running gst inside the build directory... -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" +GST_OPTS = --kernel-dir="@abs_top_srcdir@/kernel" -I "@abs_top_builddir@/gst.im" +GST = ./gst --no-user-files $(GST_OPTS) +GST_PACKAGE = ./gst-tool gst-package $(GST_OPTS) ########################################################### @@ -93,7 +92,9 @@ gst-mode.el: gst-mode.el.in AM_CPPFLAGS = -I$(top_srcdir)/libgst \ -DCMD_ZIP="\"$(ZIP)\"" \ -DCMD_INSTALL="\"$(INSTALL)\"" \ - -DCMD_LN_S="\"$(LN_S)\"" + -DCMD_LN_S="\"$(LN_S)\"" \ + -DKERNEL_PATH=\"$(pkgdatadir)/kernel\" \ + -DIMAGE_PATH=\"$(imagedir)\" bin_PROGRAMS = gst @@ -117,7 +118,7 @@ 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_tool_LDFLAGS = -export-dynamic -static GST_EXTRA_TOOLS = gst-reload gst-sunit gst-blox gst-package @@ -212,7 +213,7 @@ install-data-hook:: cd $(DESTDIR)$(imagedir) && \ $(DESTDIR)$(bindir)/gst --no-user-files -i \ --kernel-dir="$(DESTDIR)$(pkgdatadir)/kernel" \ - --image-dir="$(DESTDIR)$(imagedir)" \ + -I"$(DESTDIR)$(imagedir)/gst.im" \ -f @abs_top_srcdir@/scripts/Finish.st \ "$(pkgdatadir)" "$(imagedir)" $(MODULES) --- orig/NEWS +++ mod/NEWS @@ -36,6 +36,10 @@ o GNU Smalltalk now needs InfoZIP to b In the future, the dependency on InfoZIP will be limited to compiling GNU Smalltalk, or may be removed altogether. +o The ABI for external usage has changed. libgst.a does not know anymore + how to parse options, but exports functions to achieve the same effect + as options. + Packages improvements: --- orig/configure.ac +++ mod/configure.ac @@ -13,7 +13,7 @@ MAINTAINER="[hidden email]" dnl CURRENT:REVISION:AGE means this is the REVISION-th version of dnl the CURRENT-th interface; all the interface from CURRENT-AGE dnl to CURRENT are supported. -GST_REVISION(6:1:2) +GST_REVISION(7:0:0) AC_CONFIG_AUX_DIR([build-aux]) AC_CONFIG_MACRO_DIR([build-aux]) AC_CONFIG_SRCDIR([main.c]) --- orig/doc/Makefile.am +++ mod/doc/Makefile.am @@ -27,7 +27,7 @@ MOSTLYCLEANFILES = gst-libs.me gst-libs. ## #################################################### -$(srcdir)/gst.1: $(top_srcdir)/libgst/lib.c $(top_srcdir)/configure.ac +$(srcdir)/gst.1: $(top_srcdir)/main.c $(top_srcdir)/configure.ac $(HELP2MAN) --info-page gst \ --name "the GNU Smalltalk virtual machine" $(top_builddir)/gst >$@ --- orig/doc/gst.1 +++ mod/doc/gst.1 @@ -1,5 +1,5 @@ .\" DO NOT MODIFY THIS FILE! It was generated by help2man 1.28. -.TH SMALLTALK "1" "July 2007" "Smalltalk version 2.95a" "User Commands" +.TH SMALLTALK "1" "July 2007" "Smalltalk version 2.95b" "User Commands" .SH NAME Smalltalk \- the GNU Smalltalk virtual machine .SH DESCRIPTION @@ -33,7 +33,11 @@ Print this message and exit. \fB\-i\fR \fB\-\-rebuild\-image\fR Ignore the image file; rebuild it from scratch. .TP -\fB\-I\fR \fB\-\-image\-file\fR FILE +\fB\-\-maybe\-rebuild\-image\fR +Rebuild the image file from scratch if +any kernel file is newer. +.TP +\fB\-I\fR \fB\-\-image\fR FILE Instead of `gst.im', use FILE as the image file, and ignore the kernel files' timestamps. .TP @@ -54,14 +58,11 @@ Save a snapshot just before exiting. Print the Smalltalk version number and exit. .TP \fB\-V\fR \fB\-\-verbose\fR -Print names of loaded files and execution stats. +Show names of loaded files and execution stats. .TP \fB\-\-emacs\-mode\fR Execute as a `process' (from within Emacs) .TP -\fB\-\-image\-dir\fR DIR -Look for the image in directory DIR. -.TP \fB\-\-kernel\-dir\fR DIR Look for kernel files in directory DIR. .TP --- orig/doc/gst.texi +++ mod/doc/gst.texi @@ -353,11 +353,10 @@ This option is disabled when the dynamic translator (@pxref{Dynamic translator}) is enabled. @end ignore -@item --image-directory -@itemx --kernel-directory +@item --kernel-directory Specify, respectively, the directory in which the image file @file{gst.im} will be looked for and saved, and the directory from which the kernel -source files will be loaded. These are used mostly while compiling +source files will be loaded. This is used mostly while compiling @gst{} itself. @item --no-user-files @@ -423,11 +422,18 @@ kernel files newer than the image file, stamp out of date with respect to the Smalltalk version. After the kernel definitions have been loaded, a new image file will be saved. +@item --maybe-rebuild-image +Check for kernel files newer than the image file, or the image file's +version stamp out of date with respect to the Smalltalk version. +If these checks find the image is out of date, the kernel definitions +will be loaded and a new image file will be saved. This behavior +is the default when @option{-I} is not given, but must be specified +explicitly. + @item -I @var{file} --image-file @var{file} Use the image file named @var{file} as the image file to load. This option completely bypasses the standard image file and checking the file -dates on the kernel files. In addition, it sets the image directory -to the path of @var{file}. +dates on the kernel files. @item -l --log-changes Produce a log of the compiled Smalltalk code to st-changes.st, in the @@ -3677,6 +3683,24 @@ is the receiver, the second is the selec argument. @end deftypefun +@deftypefun OOP invokeHook (int) +Calls into Smalltalk to process a @code{ObjectMemory} hook given by +the parameter. In practice, @code{changed:} is sent to @code{ObjectMemory} +with a symbol derived from the parameter. The parameter can be one of: +@itemize +@item @code{GST_BEFORE_EVAL} +@item @code{GST_AFTER_EVAL} +@item @code{GST_ABOUT_TO_QUIT} +@item @code{GST_RETURN_FROM_SNAPSHOT} +@item @code{GST_ABOUT_TO_SNAPSHOT} +@item @code{GST_FINISHED_SNAPSHOT} +@end itemize + +All cases where the last three should be used should be covered in +@gst{}'s source code. The first three, however, can actually be useful +in user code. +@end deftypefun + The two functions that directly accept Smalltalk code are named @code{evalCode} and @code{evalExpr}, and they're basically the same. They both accept a single parameter, a pointer to the code to be @@ -4211,7 +4235,7 @@ interest. How to initialize @gst{} is most briefly and easily explained by looking at @gst{}'s own source code. For this reason, here is a snippet -from @file{main.c}. +from @file{gst-tool.c}. @example @@ -4220,13 +4244,13 @@ int main(argc, argv) int argc; char **argv; @{ - int result; - gst_smalltalk_args(argc, argv); - result = gst_init_smalltalk(); - if (result < 0) - result = 0; - else if (result == 0) - gst_top_level_loop(); + gst_set_var (GST_VERBOSITY, 1); + gst_smalltalk_args (smalltalk_argc, smalltalk_argv); + result = gst_initialize (kernel_dir, image_file, GST_NO_TTY); + if (result != 0) + exit (result < 0 ? 1 : result); + + gst_process_file (tools[i].script, GST_DIR_KERNEL_SYSTEM); exit(result); @} @@ -4235,30 +4259,45 @@ char **argv; Your initialization code will be almost the same as that in @gst{}'s @code{main()}, with the exception of the call to -@code{gst_top_level_loop}. All you'll have to do is to pass some -arguments to the @gst{} library via @code{gst_smalltalk_args}, and then -call @code{gst_init_smalltalk}. - -Note that @code{gst_init_smalltalk} will likely take some time (from a -second to 30-40 seconds), because it has to check if the image file must -be be rebuilt and, if so, it reloads and recompiles the 37000 lines of -Smalltalk code in a basic image. To avoid this check, pass a @option{-I} -flag: - -@example -char myArgv[][] = @{ "-I", "myprog.im", NULL @}; -int myArgc; -/* @dots{} */ -myArgc = sizeof(myArgv) / sizeof (char *) - 1; -smalltalkArgs(myArgc, myArgv); -@end example - -The result of @code{gst_init_smalltalk} is as follows: @code{0} means -``go on'', @code{-1} means ``don't run the top-level loop, but exit with -a zero error code'', while anything else is an error code to be passed -to @code{exit}. In practice, @code{-1} is answered when you pass the -@code{--help} or @code{--version} options: if you don't pass them, -you can safely ignore it. +@code{gst_process_file}. All you'll have to do is to pass some +arguments to the @gst{} library via @code{gst_smalltalk_args}, possibly +modify some defaults using @code{gst_get_var} and @code{gst_set_var}, +and then call @code{gst_initialize}. + +Variable indices that can be passed to @code{gst_get_var} and +@code{gst_set_var} include: + +@table @code +@item GST_DECLARE_TRACING +@item GST_EXECUTION_TRACING +@item GST_EXECUTION_TRACING_VERBOSE +@item GST_GC_MESSAGE +@item GST_VERBOSITY +@item GST_MAKE_CORE_FILE +@item GST_REGRESSION_TESTING +@end table + +While the flags that can be passed as the last parameter to +@code{gst_initialize} are any combination of these: + +@table @code +@item GST_REBUILD_IMAGE, +@item GST_MAYBE_REBUILD_IMAGE, +@item GST_IGNORE_USER_FILES, +@item GST_IGNORE_BAD_IMAGE_NAME, +@item GST_IGNORE_BAD_IMAGE_PATH, +@item GST_IGNORE_BAD_KERNEL_PATH, +@item GST_NO_TTY +@end table + +Note that @code{gst_initialize} will likely take some time (from a +tenth of a second to 3-4 seconds), because it has to check if the image +file must be be rebuilt and, if so, it reloads and recompiles the 37000 +lines of Smalltalk code in a basic image. To avoid this check, pass a +valid image file as the third argument to @code{gst_initialize}: + +The result of @code{gst_init_smalltalk} is @code{0} for success, +while anything else is an error code. If you're using @gst{} as an extension library, you might also want to disable the two @code{ObjectMemory} class methods, @code{quit} and @@ -4277,9 +4316,9 @@ your program in a less traumatic way, or exit through a call out to a C routine in your program. Also, note that it is not a problem if you develop the class libraries -for your programs within @gst{}'s environment @b{without} -@code{defineCFunc}-ing your own C call-outs, since @gst{} recalculates -the addresses of the C call-outs every time it is started. +for your programs within @gst{}'s environment (which will not call +@code{defineCFunc} for your own C call-outs), since the addresses of +the C call-outs are looked up again when an image is restored. --- orig/gst-tool.c +++ mod/gst-tool.c @@ -63,9 +63,9 @@ #include <stdio.h> const char *program_name; -const char **smalltalk_argv; -int smalltalk_argc; -int error; +const char *kernel_dir; +const char *image_file; +int flags = GST_NO_TTY; struct tool { const char *name; @@ -129,15 +129,9 @@ 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); - + fprintf (stderr, "%s: ", program_name); vfprintf (stderr, s, ap); fprintf (stderr, "\n"); va_end (ap); @@ -224,22 +218,16 @@ parse_option (int short_opt, const char if (short_opt == 'I' || (long_opt && !strcmp (long_opt, "image-file"))) { - static int found_option; - if (found_option) + if (image_file) option_error ("duplicate --image-file option"); - found_option = true; - smalltalk_argv[smalltalk_argc++] = "-I"; - smalltalk_argv[smalltalk_argc++] = arg; + image_file = arg; } if (long_opt && !strcmp (long_opt, "kernel-directory")) { - static int found_option; - if (found_option) + if (kernel_dir) option_error ("duplicate --kernel-directory option"); - found_option = true; - smalltalk_argv[smalltalk_argc++] = "--kernel-directory"; - smalltalk_argv[smalltalk_argc++] = arg; + kernel_dir = arg; } } @@ -352,6 +340,8 @@ parse_options (const char **argv) int main(int argc, const char **argv) { + int smalltalk_argc; + const char **smalltalk_argv; int i; int result; @@ -361,17 +351,15 @@ main(int argc, const char **argv) else program_name = argv[0]; + /* Check if used in the build tree. */ if (!strcmp (program_name, "gst-tool") || !strcmp (program_name, "lt-gst-tool")) { argv++, argc--; program_name = argv[0]; + flags |= GST_IGNORE_USER_FILES; } - 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); @@ -381,15 +369,18 @@ main(int argc, const char **argv) 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; + { + smalltalk_argv = alloca (sizeof (const char *) * (argc + 1)); + smalltalk_argc = argc; + smalltalk_argv[0] = tools[i].force_opt; + memcpy (&smalltalk_argv[1], &argv[1], argc * sizeof (char *)); + } + else + { + smalltalk_argv = argv + 1; + smalltalk_argc = argc - 1; + } #ifdef CMD_LN_S setenv ("LN_S", CMD_LN_S, 0); @@ -401,11 +392,12 @@ main(int argc, const char **argv) setenv ("XZIP", CMD_ZIP, 0); #endif - gst_smalltalk_args(smalltalk_argc, smalltalk_argv); - result = gst_init_smalltalk(); + gst_set_var (GST_VERBOSITY, 1); + gst_smalltalk_args (smalltalk_argc, smalltalk_argv); + result = gst_initialize (kernel_dir, image_file, flags); if (result != 0) exit (result < 0 ? 1 : result); - gst_top_level_loop(); - exit (error ? 1 : 0); + gst_process_file (tools[i].script, GST_DIR_KERNEL_SYSTEM); + exit (0); } 2007-07-05 Paolo Bonzini <[hidden email]> * libgst/prims.def: Fix "==" vs. "=" typo. --- orig/libgst/Makefile.am +++ mod/libgst/Makefile.am @@ -42,13 +42,13 @@ libgst_la_LDFLAGS = -version-info $(VERS -export-symbols-regex "^gst_.*" libgst_la_SOURCES = \ - interp.c lib.c gst-parse.c lex.c \ + gstpub.c files.c gst-parse.c lex.c \ str.c tree.c byte.c comp.c \ sym.c dict.c oop.c opt.c \ save.c cint.c heap.c input.c \ sysdep.c callin.c xlat.c events.c \ mpz.c print.c alloc.c security.c \ - re.c + re.c interp.c # definitions for genprims @@ -81,7 +81,7 @@ dist_noinst_DATA = valgrind.supp prims.d STAMP_FILES = prims.stamp match.stamp vm.stamp noinst_HEADERS = \ - gstpriv.h lib.h lex.h str.h re.h \ + gstpriv.h files.h lex.h str.h re.h \ tree.h byte.h interp.h comp.h memzero.h \ sym.h dict.h oop.h save.h cint.h xlat.h \ sysdep.h callin.h gstpub.h opt.h mpz.h \ --- orig/libgst/callin.c +++ mod/libgst/callin.c @@ -86,66 +86,17 @@ oop_array_registry; static oop_registry *oop_registry_root; static oop_array_registry *oop_array_registry_root; -VMProxy gst_interpreter_proxy = { - NULL, NULL, NULL, - - _gst_msg_send, _gst_vmsg_send, _gst_nvmsg_send, _gst_str_msg_send, - _gst_msg_sendf, - _gst_eval_expr, _gst_eval_code, - - _gst_object_alloc, _gst_basic_size, - - _gst_define_cfunc, _gst_register_oop, _gst_unregister_oop, - -/* Convert C datatypes to Smalltalk types */ - - _gst_id_to_oop, _gst_int_to_oop, _gst_float_to_oop, _gst_bool_to_oop, - _gst_char_to_oop, _gst_class_name_to_oop, - _gst_string_to_oop, _gst_byte_array_to_oop, _gst_symbol_to_oop, - _gst_c_object_to_oop, _gst_type_name_to_oop, _gst_set_c_object, - -/* Convert Smalltalk datatypes to C data types */ - - _gst_oop_to_c, _gst_oop_to_id, _gst_oop_to_int, _gst_oop_to_float, - _gst_oop_to_bool, _gst_oop_to_char, - _gst_oop_to_string, _gst_oop_to_byte_array, _gst_oop_to_cobject, - -/* Smalltalk process support */ - _gst_async_signal, _gst_sync_wait, _gst_async_signal_and_unregister, - - _gst_register_oop_array, _gst_unregister_oop_array, - -/* Convert Smalltalk datatypes to C data types (2) */ - _gst_oop_to_long_double, _gst_long_double_to_oop, - - _gst_get_object_class, _gst_get_superclass, - _gst_class_is_kind_of, _gst_object_is_kind_of, - _gst_perform, _gst_perform_with, _gst_class_implements_selector, - _gst_class_can_understand, _gst_responds_to, - _gst_oop_size, _gst_oop_at, _gst_oop_at_put, - - /* System objects. */ - NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, - NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, - - /* New in 2.3. */ - _gst_wchar_to_oop, _gst_wstring_to_oop, - _gst_oop_to_wchar, _gst_oop_to_wstring, -}; - OOP -_gst_msg_send (OOP receiver, - OOP selector, - ...) +_gst_va_msg_send (OOP receiver, + OOP selector, + va_list ap) { - va_list ap, save; + va_list save; OOP *args, anArg; int numArgs; if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); - - va_start (ap, selector); + _gst_initialize (NULL, NULL, GST_NO_TTY); #ifdef __va_copy __va_copy (save, ap); @@ -168,6 +119,17 @@ _gst_msg_send (OOP receiver, } OOP +_gst_msg_send (OOP receiver, + OOP selector, + ...) +{ + va_list ap; + + va_start (ap, selector); + return _gst_va_msg_send (receiver, selector, ap); +} + +OOP _gst_vmsg_send (OOP receiver, OOP selector, OOP * args) @@ -175,7 +137,7 @@ _gst_vmsg_send (OOP receiver, int numArgs; if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); for (numArgs = 0; args[numArgs]; numArgs++); @@ -190,54 +152,26 @@ _gst_str_msg_send (OOP receiver, const char *sel, ...) { - va_list ap, save; - OOP *args, anArg; - int numArgs; - OOP selector; - - if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); - + va_list ap; + OOP selector = _gst_symbol_to_oop (sel); va_start (ap, sel); - selector = _gst_intern_string (sel); - -#ifdef __va_copy - __va_copy (save, ap); -#else - save = ap; -#endif - - for (numArgs = 0; (anArg = va_arg (ap, OOP)) != NULL; numArgs++); - - if (numArgs != _gst_selector_num_args (selector)) - return (_gst_nil_oop); - else - { - args = (OOP *) alloca (sizeof (OOP) * numArgs); - for (numArgs = 0; (anArg = va_arg (save, OOP)) != NULL; numArgs++) - args[numArgs] = anArg; - - return _gst_nvmsg_send (receiver, selector, args, numArgs); - } + return _gst_va_msg_send (receiver, selector, ap); } /* Use like printf */ void -_gst_msg_sendf (PTR resultPtr, - const char *fmt, - ...) +_gst_va_msg_sendf (PTR resultPtr, + const char *fmt, + va_list ap) { - va_list ap; OOP selector, *args, result; int i, numArgs; const char *fp; char *s, selectorBuf[256]; inc_ptr incPtr; - va_start (ap, fmt); - if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); incPtr = INC_SAVE_POINTER (); @@ -423,6 +357,17 @@ _gst_msg_sendf (PTR resultPtr, INC_RESTORE_POINTER (incPtr); } + +void +_gst_msg_sendf (PTR resultPtr, + const char *fmt, + ...) +{ + va_list ap; + va_start (ap, fmt); + _gst_va_msg_sendf (resultPtr, fmt, ap); +} + OOP _gst_type_name_to_oop (const char *name) { @@ -440,7 +385,7 @@ void _gst_eval_code (const char *str) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); _gst_push_cstring (str); _gst_parse_stream (false); @@ -454,7 +399,7 @@ _gst_eval_expr (const char *str) OOP result; if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); _gst_push_cstring (str); _gst_parse_stream (false); @@ -503,7 +448,7 @@ _gst_class_name_to_oop (const char *name s = strdup (name); if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); result = _gst_smalltalk_dictionary; for (p = s; (prev_p = strsep (&p, ".")) != NULL; ) @@ -523,7 +468,7 @@ OOP _gst_int_to_oop (long int i) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); return (FROM_INT (i)); } @@ -532,7 +477,7 @@ OOP _gst_id_to_oop (long int i) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); return (OOP_AT (i)); } @@ -553,7 +498,7 @@ OOP _gst_bool_to_oop (int b) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); if (b) return (_gst_true_oop); @@ -566,7 +511,7 @@ OOP _gst_char_to_oop (char c) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); return (CHAR_OOP_AT (c)); } @@ -575,7 +520,7 @@ OOP _gst_wchar_to_oop (wchar_t wc) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); return (char_new (wc)); } @@ -587,7 +532,7 @@ OOP _gst_string_to_oop (const char *str) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); if (str == NULL) return (_gst_nil_oop); @@ -599,7 +544,7 @@ OOP _gst_wstring_to_oop (const wchar_t *str) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); if (str == NULL) return (_gst_nil_oop); @@ -612,7 +557,7 @@ _gst_byte_array_to_oop (const char *str, int n) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); if (str == NULL) return (_gst_nil_oop); @@ -624,7 +569,7 @@ OOP _gst_symbol_to_oop (const char *str) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); if (str == NULL) return (_gst_nil_oop); @@ -638,7 +583,7 @@ OOP _gst_c_object_to_oop (PTR co) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); if (co == NULL) return (_gst_nil_oop); @@ -650,7 +595,7 @@ void _gst_set_c_object (OOP oop, PTR co) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); SET_COBJECT_VALUE(oop, co); } @@ -668,7 +613,7 @@ long _gst_oop_to_c (OOP oop) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); if (IS_INT (oop)) return (TO_INT (oop)); @@ -695,7 +640,7 @@ long _gst_oop_to_int (OOP oop) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); return (TO_INT (oop)); } @@ -704,7 +649,7 @@ long _gst_oop_to_id (OOP oop) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); return (OOP_INDEX (oop)); } @@ -713,7 +658,7 @@ double _gst_oop_to_float (OOP oop) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); if (IS_CLASS (oop, _gst_floatd_class)) return (FLOATD_OOP_VALUE (oop)); @@ -729,7 +674,7 @@ long double _gst_oop_to_long_double (OOP oop) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); if (IS_CLASS (oop, _gst_floatd_class)) return (FLOATD_OOP_VALUE (oop)); @@ -745,7 +690,7 @@ int _gst_oop_to_bool (OOP oop) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); return (oop == _gst_true_oop); } @@ -754,7 +699,7 @@ char _gst_oop_to_char (OOP oop) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); return (CHAR_OOP_VALUE (oop)); } @@ -763,7 +708,7 @@ wchar_t _gst_oop_to_wchar (OOP oop) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); return (CHAR_OOP_VALUE (oop)); } @@ -772,7 +717,7 @@ char * _gst_oop_to_string (OOP oop) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); if (IS_NIL (oop)) return (NULL); @@ -784,7 +729,7 @@ wchar_t * _gst_oop_to_wstring (OOP oop) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); if (IS_NIL (oop)) return (NULL); @@ -796,7 +741,7 @@ char * _gst_oop_to_byte_array (OOP oop) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); if (IS_NIL (oop)) return (NULL); @@ -805,10 +750,10 @@ _gst_oop_to_byte_array (OOP oop) } PTR -_gst_oop_to_cobject (OOP oop) +_gst_oop_to_c_object (OOP oop) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); if (IS_NIL (oop)) return (NULL); @@ -820,7 +765,7 @@ OOP _gst_get_object_class (OOP oop) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); return OOP_INT_CLASS (oop); } @@ -829,7 +774,7 @@ OOP _gst_get_superclass (OOP oop) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); /* Quick tests for "class-ness". */ assert (IS_OOP (oop)); @@ -843,7 +788,7 @@ mst_Boolean _gst_class_is_kind_of (OOP candidate, OOP superclass) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); /* Quick tests for "class-ness". */ assert (IS_OOP (candidate) && IS_OOP (superclass)); @@ -865,7 +810,7 @@ _gst_object_is_kind_of (OOP candidate, O { OOP its_class; if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); if (IS_INT (candidate)) { @@ -892,7 +837,7 @@ OOP _gst_perform (OOP receiver, OOP selector) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); return _gst_nvmsg_send (receiver, selector, NULL, 0); } @@ -901,7 +846,7 @@ OOP _gst_perform_with (OOP receiver, OOP selector, OOP arg) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); return _gst_nvmsg_send (receiver, selector, &arg, 1); } @@ -910,7 +855,7 @@ mst_Boolean _gst_class_implements_selector (OOP classOOP, OOP selector) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); assert (IS_OOP (classOOP)); assert (OOP_CLASS (classOOP) == _gst_behavior_class @@ -924,7 +869,7 @@ _gst_class_can_understand (OOP classOOP, { method_cache_entry dummy; if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); /* Quick test for "class-ness". */ assert (IS_OOP (classOOP)); @@ -939,7 +884,7 @@ _gst_responds_to (OOP oop, OOP selector) { method_cache_entry dummy; if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); return _gst_find_method (OOP_INT_CLASS (oop), selector, &dummy); } @@ -948,7 +893,7 @@ size_t _gst_oop_size (OOP oop) { if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); return NUM_INDEXABLE_FIELDS (oop); } @@ -958,7 +903,7 @@ _gst_oop_at (OOP oop, size_t index) { OOP result; if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); result = index_oop (oop, index + 1); assert (result); @@ -970,7 +915,7 @@ _gst_oop_at_put (OOP oop, size_t index, { OOP old; if (!_gst_smalltalk_initialized) - gst_init_smalltalk (); + _gst_initialize (NULL, NULL, GST_NO_TTY); old = index_oop (oop, index + 1); assert (old); @@ -1158,38 +1103,3 @@ _gst_mark_registered_oops (void) MARK_OOP_RANGE (first, last); } } - -void -_gst_init_vmproxy (void) -{ - gst_interpreter_proxy.nilOOP = _gst_nil_oop; - gst_interpreter_proxy.trueOOP = _gst_true_oop; - gst_interpreter_proxy.falseOOP = _gst_false_oop; - - gst_interpreter_proxy.objectClass = _gst_object_class; - gst_interpreter_proxy.arrayClass = _gst_array_class; - gst_interpreter_proxy.stringClass = _gst_string_class; - gst_interpreter_proxy.characterClass = _gst_char_class; - gst_interpreter_proxy.smallIntegerClass = _gst_small_integer_class; - gst_interpreter_proxy.floatDClass = _gst_floatd_class; - gst_interpreter_proxy.floatEClass = _gst_floate_class; - gst_interpreter_proxy.byteArrayClass = _gst_byte_array_class; - gst_interpreter_proxy.objectMemoryClass = _gst_object_memory_class; - gst_interpreter_proxy.classClass = _gst_class_class; - gst_interpreter_proxy.behaviorClass = _gst_behavior_class; - gst_interpreter_proxy.blockClosureClass = _gst_block_closure_class; - gst_interpreter_proxy.contextPartClass = _gst_context_part_class; - gst_interpreter_proxy.blockContextClass = _gst_block_context_class; - gst_interpreter_proxy.methodContextClass = _gst_method_context_class; - gst_interpreter_proxy.compiledMethodClass = _gst_compiled_method_class; - gst_interpreter_proxy.compiledBlockClass = _gst_compiled_block_class; - gst_interpreter_proxy.fileDescriptorClass = _gst_file_descriptor_class; - gst_interpreter_proxy.fileStreamClass = _gst_file_stream_class; - gst_interpreter_proxy.processClass = _gst_process_class; - gst_interpreter_proxy.semaphoreClass = _gst_semaphore_class; - gst_interpreter_proxy.cObjectClass = _gst_c_object_class; - - /* And system objects. */ - gst_interpreter_proxy.processorOOP = _gst_processor_oop; - -} --- orig/libgst/callin.h +++ mod/libgst/callin.h @@ -58,6 +58,18 @@ /* Sends SELECTOR (which should be a Symbol, otherwise _gst_nil_oop is + returned) to RECEIVER. The message arguments pointed to by AP + should also be OOPs (otherwise, an access violation exception is + pretty likely) and are passed in a NULL-terminated list after the + selector. The value returned from the method is passed back as an + OOP to the C program as the result of the function, or _gst_nil_oop + if the number of arguments is wrong. */ +extern OOP _gst_va_msg_send (OOP receiver, + OOP selector, + va_list ap) + ATTRIBUTE_HIDDEN; + +/* Sends SELECTOR (which should be a Symbol, otherwise _gst_nil_oop is returned) to RECEIVER. The message arguments should also be OOPs (otherwise, an access violation exception is pretty likely) and are passed in a NULL-terminated list after the selector. The value @@ -91,6 +103,11 @@ extern OOP _gst_str_msg_send (OOP receiv /* See manual; basically it takes care of the conversion from C to Smalltalk data types. */ +extern void _gst_va_msg_sendf (PTR resultPtr, const char * fmt, va_list ap) + ATTRIBUTE_HIDDEN; + +/* See manual; basically it takes care of the conversion from C to + Smalltalk data types. */ extern void _gst_msg_sendf (PTR resultPtr, const char * fmt, ...) ATTRIBUTE_HIDDEN; @@ -205,7 +222,7 @@ extern wchar_t *_gst_oop_to_wstring (OOP ATTRIBUTE_HIDDEN; extern char *_gst_oop_to_byte_array (OOP oop) ATTRIBUTE_HIDDEN; -extern PTR _gst_oop_to_cobject (OOP oop) +extern PTR _gst_oop_to_c_object (OOP oop) ATTRIBUTE_HIDDEN; extern long double _gst_oop_to_long_double (OOP oop) ATTRIBUTE_HIDDEN; @@ -246,8 +263,4 @@ extern void _gst_copy_registered_oops (v extern void _gst_init_oopregistry (void) ATTRIBUTE_HIDDEN; -/* Initializes the VMProxy. */ -extern void _gst_init_vmproxy (void) - ATTRIBUTE_HIDDEN; - #endif /* GST_CALLIN_H */ --- orig/libgst/cint.c +++ mod/libgst/cint.c @@ -207,9 +207,6 @@ static OOP classify_type_symbol (OOP sym static int get_errno (void); /* Encapsulate binary incompatibilities between various C libraries. */ -static int my_utime (const char *name, - long new_atime, - long new_mtime); static int my_stat (const char *name, gst_stat * out); static int my_lstat (const char *name, @@ -439,7 +436,7 @@ get_argc (void) const char * get_argv (int n) { - return (n <= _gst_smalltalk_passed_argc + return (n >= 1 && n <= _gst_smalltalk_passed_argc ? _gst_smalltalk_passed_argv[n - 1] : NULL); } @@ -449,14 +446,14 @@ dld_open (const char *filename) { #ifdef ENABLE_DLD lt_dlhandle handle; - void (*initModule) (); + void (*initModule) (struct VMProxy *); handle = lt_dlopenext (filename); if (handle) { initModule = lt_dlsym (handle, "gst_initModule"); if (initModule) - initModule (&gst_interpreter_proxy); + initModule (_gst_get_vmproxy ()); } return (handle); --- orig/libgst/comp.c +++ mod/libgst/comp.c @@ -506,15 +506,54 @@ _gst_get_termination_method (void) return (termination_method); } +static void +invoke_hook_smalltalk (enum gst_vm_hook hook) +{ + const char *hook_name; + if (!_gst_kernel_initialized) + return; + + switch (hook) { + case GST_BEFORE_EVAL: + hook_name = "beforeEvaluation"; + break; + + case GST_AFTER_EVAL: + hook_name = "afterEvaluation"; + break; + + case GST_RETURN_FROM_SNAPSHOT: + hook_name = "returnFromSnapshot"; + break; + + case GST_ABOUT_TO_QUIT: + hook_name = "aboutToQuit"; + break; + + case GST_ABOUT_TO_SNAPSHOT: + hook_name = "aboutToSnapshot"; + break; + + case GST_FINISHED_SNAPSHOT: + hook_name = "finishedSnapshot"; + break; + + default: + return; + } + + _gst_msg_sendf (NULL, "%v %o changed: %S", + _gst_object_memory_class, hook_name); +} + void -_gst_invoke_hook (const char *hook) +_gst_invoke_hook (enum gst_vm_hook hook) { int save_execution; save_execution = _gst_execution_tracing; if (_gst_execution_tracing == 1) _gst_execution_tracing = 0; - _gst_msg_sendf (NULL, "%v %o changed: %S", - _gst_object_memory_class, hook); + invoke_hook_smalltalk (hook); _gst_execution_tracing = save_execution; } @@ -599,7 +638,6 @@ _gst_execute_statements (tree_node temps YYLTYPE loc; if (_gst_regression_testing - || _gst_emacs_process || _gst_verbosity < 2 || !_gst_get_cur_stream_prompt ()) quiet = true; @@ -657,8 +695,7 @@ _gst_execute_statements (tree_node temps getrusage (RUSAGE_SELF, &startRusage); #endif - if (_gst_kernel_initialized) - _gst_invoke_hook ("beforeEvaluation"); + _gst_invoke_hook (GST_BEFORE_EVAL); /* send a message to NIL, which will find this synthetic method definition in Object and execute it */ @@ -670,8 +707,7 @@ _gst_execute_statements (tree_node temps getrusage (RUSAGE_SELF, &endRusage); #endif - if (_gst_kernel_initialized) - _gst_invoke_hook ("afterEvaluation"); + _gst_invoke_hook (GST_AFTER_EVAL); INC_RESTORE_POINTER (incPtr); --- orig/libgst/comp.h +++ mod/libgst/comp.h @@ -318,7 +318,7 @@ extern void _gst_reset_compilation_categ /* This function will send a message to ObjectMemory (a system class) asking it to broadcast the event named HOOK. */ -extern void _gst_invoke_hook (const char *hook) +extern void _gst_invoke_hook (enum gst_vm_hook hook) ATTRIBUTE_HIDDEN; /* Prepares the compiler for execution, initializing some variables. */ --- orig/libgst/lib.c +++ mod/libgst/files.c @@ -54,7 +54,6 @@ #include "gstpriv.h" -#include "getopt.h" #ifndef MAXPATHLEN #define MAXPATHLEN 1024 /* max length of a file and path */ @@ -76,106 +75,6 @@ #define SITE_PRE_IMAGE_FILE_NAME "site-pre.st" - -static const char help_text[] = - "GNU Smalltalk usage:" - "\n" - "\n gst [ flag ... ] [ file ... ]" - "\n gst [ flag ... ] { -f | --file } file [ args ... ]" - "\n" - "\nShort flags can appear either as -xyz or as -x -y -z. If an option is" - "\nmandatory for a long option, it is also mandatory for a short one. The" - "\ncurrently defined set of flags is:" - "\n -a --smalltalk-args\t\t Pass the remaining arguments to Smalltalk." - "\n -c --core-dump\t\t Dump core on fatal signal." - "\n -D --declaration-trace\t Trace compilation of all loaded files." -#ifndef ENABLE_JIT_TRANSLATION - "\n -E --execution-trace\t\t Trace execution of all loaded files." -#endif - "\n -g --no-gc-message\t\t Do not print garbage collection messages." - "\n -H --help\t\t\t Print this message and exit." - "\n -i --rebuild-image\t\t Ignore the image file; rebuild it from scratch." - "\n -I --image-file FILE\t\t Instead of `gst.im', use FILE as the image\n\t\t\t\t file, and ignore the kernel files' timestamps.\n" - "\n -K --kernel-file FILE\t Make FILE's path relative to the image path." - "\n -q --quiet --silent\t\t Do not print execution information." - "\n -r --regression-test\t\t Run in regression test mode, i.e. make\n\t\t\t\t printed messages constant.\n" - "\n -S --snapshot\t\t Save a snapshot just before exiting." - "\n -v --version\t\t\t Print the Smalltalk version number and exit." - "\n -V --verbose\t\t\t Print names of loaded files and execution stats." - "\n --emacs-mode\t\t Execute as a `process' (from within Emacs)" - "\n --image-dir DIR\t\t Look for the image in directory DIR." - "\n --kernel-dir DIR\t\t Look for kernel files in directory DIR." - "\n --no-user-files\t\t Don't read user customization files.\n" - "\n -\t\t\t\t Read input from standard input explicitly." - "\n" - "\nFiles are loaded one after the other. After the last one is loaded," - "\nSmalltalk will exit. If no files are specified, Smalltalk reads from" - "\nthe terminal, with prompts." - "\n" - "\nIn the second form, the file after -f is the last loaded file; any" - "\nparameter after that file is passed to the Smalltalk program." - "\n" "\nReport bugs to [hidden email]\n"; - -static const char copyright_and_legal_stuff_text[] = - "GNU Smalltalk version %s" - "\nCopyright 2006 Free Software Foundation, Inc." - "\nWritten by Steve Byrne ([hidden email]) and Paolo Bonzini ([hidden email])" - "\n" - "\nGNU Smalltalk comes with NO WARRANTY, to the extent permitted by law." - "\nYou may redistribute copies of GNU Smalltalk under the terms of the" - "\nGNU General Public License. For more information, see the file named" - "\nCOPYING." - "\n" - "\nUsing default kernel path: %s" "\nUsing default image path: %s" - "\n"; - -#define OPT_KERNEL_DIR 2 -#define OPT_IMAGE_DIR 3 -#define OPT_NO_USER 4 -#define OPT_EMACS_MODE 5 - -static const struct option long_options[] = { - {"smalltalk-args", 0, 0, 'a'}, - {"core-dump", 0, 0, 'c'}, - {"declaration-trace", 0, 0, 'D'}, -#ifndef ENABLE_JIT_TRANSLATION - {"execution-trace", 0, 0, 'E'}, -#endif - {"file", 0, 0, 'f'}, - {"kernel-directory", 1, 0, OPT_KERNEL_DIR}, - {"image-directory", 1, 0, OPT_IMAGE_DIR}, - {"no-user-files", 0, 0, OPT_NO_USER}, - {"no-gc-message", 0, 0, 'g'}, - {"help", 0, 0, 'H'}, - {"rebuild-image", 0, 0, 'i'}, - {"image-file", 1, 0, 'I'}, - {"kernel-file", 1, 0, 'K'}, - {"emacs-mode", 0, 0, OPT_EMACS_MODE}, - {"quiet", 0, 0, 'q'}, - {"no-messages", 0, 0, 'q'}, - {"silent", 0, 0, 'q'}, - {"regression-test", 0, 0, 'r'}, - {"snapshot", 0, 0, 'S'}, - {"version", 0, 0, 'v'}, - {"verbose", 0, 0, 'V'}, - {NULL, 0, 0, 0} -}; - -struct loaded_file { - mst_Boolean kernel_path; - const char *file_name; -}; - -enum user_dir { - NO_USER_DIR, - KERNEL_USER_DIR, - BASE_USER_DIR -}; - -static struct loaded_file *loaded_files; -int n_loaded_files; - - /* When true, this flag suppresses the printing of execution-related * messages, such as the number of byte codes executed by the * last expression, etc. @@ -189,19 +88,19 @@ const char *_gst_image_file_path = NULL; /* The ".st" directory, in the current directory or in the user's home directory. */ -const char *_gst_user_file_base_path; +const char *_gst_user_file_base_path = NULL; /* The path to the executable, derived from argv[0]. */ -const char *_gst_executable_path; +const char *_gst_executable_path = NULL; /* Whether to look for user files. */ -static mst_Boolean no_user_files; +static mst_Boolean no_user_files = false; /* 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 default_image_name. */ -char *_gst_binary_image_name = NULL; +const char *_gst_binary_image_name = NULL; /* This is used by the callin functions to auto-initialize Smalltalk. When it's not true, initialization needs to be performed. It's set @@ -226,14 +125,6 @@ mst_Boolean _gst_regression_testing = fa * ***********************************************************************/ -/* Parse the Smalltalk source code contained in FILENAME. If QUIET - is true, for no reason show messages about the execution state (this - is turned on while loading kernel files). */ -static mst_Boolean process_file (const char *fileName); - -/* Parse the Smalltalk source code read from stdin. */ -static void process_stdin (); - /* Answer whether it is ok to load the binary image pointed to by _gst_binary_image_name. This is good is the image file is local and newer than all of the kernel files, or if the image file is @@ -246,15 +137,6 @@ static mst_Boolean ok_to_load_binary (vo for the particular file is returned, or NULL if it is not found. */ static char *find_user_file (const char *fileName); -/* Attempts to find a viable kernel Smalltalk file (.st file). - FILENAME is a simple file name, sans directory; the file name to use - for the particular kernel file is returned. - If there is a file in the .stkernel directory with name FILENAME, that is - returned; otherwise the kernel path is prepended to FILENAME (separated - by a slash, of course) and that is stored in the string that is returned. */ -static char *find_kernel_file (const char *fileName, const char *systemPrefix, - enum user_dir userDir); - /* Loads the kernel Smalltalk files. It uses a vector of file names, and loads each file individually. To provide for greater flexibility, if a one of the files exists in the current directory, @@ -263,31 +145,12 @@ static char *find_kernel_file (const cha SMALLTALK_KERNEL environment variable. */ static int load_standard_files (void); -/* Sets up the paths for the kernel source directory and for where the - saved Smalltalk binary image lives. Uses environment variables - SMALLTALK_KERNEL and SMALLTALK_IMAGE if they are set, otherwise - uses the paths passed by the makefiles. */ -static void init_paths (void); - -/* This routine scans the command line arguments, accumulating - information and setting flags. */ -static int parse_args (int argc, - const char **argv); - /* Path names for the per-user customization files, respectively init.st (loaded at every startup) and pre.st (loaded before a local image is saved. */ -static const char *user_init_file; -static const char *user_pre_image_file; -static const char *site_pre_image_file; - -/* Set by command line flag. When true, Smalltalk saves a snapshot after - loading the files on the command line, before exiting. */ -static mst_Boolean snapshot_after_load = false; - -/* If true, skip date checking of kernel files vs. binary image; pretend - that binary image does not exist. */ -static mst_Boolean ignore_image = false; +static const char *user_init_file = NULL; +static const char *user_pre_image_file = NULL; +static const char *site_pre_image_file = NULL; /* The complete list of "kernel" class and method definitions. Each of these files is loaded, in the order given below. Their last @@ -427,9 +290,8 @@ static const char standard_files[] = { /* The argc and argv that are passed to libgst via gst_smalltalk_args. The default is passing no parameters. */ -static const char *smalltalk_arg_vec[] = { "gst", NULL }; static int smalltalk_argc = 0; -static const char **smalltalk_argv = smalltalk_arg_vec; +static const char **smalltalk_argv = NULL; /* The argc and argv that are made available to Smalltalk programs through the -a option. */ @@ -439,34 +301,144 @@ const char **_gst_smalltalk_passed_argv void -gst_smalltalk_args (int argc, - const char **argv) +_gst_smalltalk_args (int argc, + const char **argv) { smalltalk_argc = argc; smalltalk_argv = argv; _gst_executable_path = _gst_find_executable (argv[0]); } - + int -gst_init_smalltalk (void) +_gst_initialize (const char *kernel_dir, + const char *image_file, + int flags) { + char *currentDirectory = _gst_get_cur_dir_name (); + const char *home = getenv ("HOME"); + char *str; mst_Boolean loadBinary, abortOnFailure; - mst_Boolean traceUserDeclarations, traceUserExecution; - int result; + int rebuild_image_flags = + flags & (GST_REBUILD_IMAGE | GST_MAYBE_REBUILD_IMAGE); /* Even though we're nowhere near through initialization, we set this to make sure we don't invoke a callin function which would recursively invoke us. */ _gst_smalltalk_initialized = true; - _gst_init_snprintfv (); - result = parse_args (smalltalk_argc, smalltalk_argv); - if (result) - return result; + /* By default, apply this kludge fpr OSes such as Windows and MS-DOS + which have no concept of home directories. */ + if (home == NULL) + home = xstrdup (currentDirectory); + + asprintf ((char **) &_gst_user_file_base_path, "%s/%s", + home, LOCAL_BASE_DIR_NAME); + + /* Check that supplied paths are readable. If they're not, fail unless + they told us in advance. */ + if (kernel_dir + && !_gst_file_is_readable (kernel_dir)) + { + if (flags & GST_IGNORE_BAD_KERNEL_PATH) + kernel_dir = NULL; + else + { + _gst_errorf ("kernel path %s not readable", kernel_dir); + exit (1); + } + } + + if (image_file + && (flags & (GST_REBUILD_IMAGE | GST_MAYBE_REBUILD_IMAGE)) == 0 + && !_gst_file_is_readable (image_file)) + { + if (flags & GST_IGNORE_BAD_IMAGE_PATH) + image_file = NULL; + else + { + _gst_errorf ("Couldn't open image file %s", image_file); + exit (1); + } + } + + if (image_file) + { + const char *p; + /* Compute the actual path of the image file */ + p = image_file + strlen (image_file); + for (;;) + if (*--p == '/' +#if defined(MSDOS) || defined(WIN32) || defined(__OS2__) + || *p == '\\' +#endif + ) + { + char *dirname; + int n = p > image_file ? p - image_file : 1; + asprintf (&dirname, "%.*s", n, image_file); + _gst_image_file_path = dirname; + + /* Remove path from image_file. */ + image_file = p + 1; + break; + } + + else if (p == image_file) + { + _gst_image_file_path = "."; + break; + } + } + else + { + /* No image file given, we use the system default but revert to the + current directory. */ + if (_gst_file_is_readable (IMAGE_PATH)) + _gst_image_file_path = IMAGE_PATH; + else + _gst_image_file_path = xstrdup (currentDirectory); + flags |= GST_IGNORE_BAD_IMAGE_PATH; + image_file = "gst.im"; + } + + if (!kernel_dir) + { + if (_gst_file_is_readable (KERNEL_PATH)) + kernel_dir = KERNEL_PATH; + else + { + char *kernel_file_path; + asprintf (&kernel_file_path, "%s/kernel", _gst_image_file_path); + kernel_dir = kernel_file_path; + } + } + + xfree (currentDirectory); + + /* Uff, we're done with the complicated part. Set variables to mirror + what we've decided in the above marathon. */ + _gst_image_file_path = _gst_get_full_file_name (_gst_image_file_path); + _gst_kernel_file_path = _gst_get_full_file_name (kernel_dir); + asprintf (&str, "%s/%s", _gst_image_file_path, image_file); + _gst_binary_image_name = str; + + _gst_smalltalk_passed_argc = smalltalk_argc; + _gst_smalltalk_passed_argv = smalltalk_argv; + no_user_files = (flags & GST_IGNORE_USER_FILES) != 0; + _gst_no_tty = (flags & GST_NO_TTY) != 0 || !isatty (0); + + site_pre_image_file = _gst_find_file (SITE_PRE_IMAGE_FILE_NAME, + GST_DIR_KERNEL_SYSTEM); + + user_pre_image_file = find_user_file (USER_PRE_IMAGE_FILE_NAME); + + if (!_gst_regression_testing) + user_init_file = find_user_file (USER_INIT_FILE_NAME); + else + user_init_file = NULL; - init_paths (); _gst_init_sysdep (); _gst_init_signals (); _gst_init_cfuncs (); @@ -480,22 +452,12 @@ gst_init_smalltalk (void) setvbuf (stdout, NULL, _IOLBF, 1024); } - traceUserDeclarations = _gst_declare_tracing; - traceUserExecution = _gst_execution_tracing; - if (_gst_declare_tracing == 1) - _gst_declare_tracing--; - if (_gst_execution_tracing == 1) - _gst_execution_tracing--; - - if (_gst_binary_image_name) + if (rebuild_image_flags == 0) loadBinary = abortOnFailure = true; else { - char *default_image_file_name; - asprintf (&default_image_file_name, "%s/gst.im", _gst_image_file_path); - - _gst_binary_image_name = default_image_file_name; - loadBinary = !ignore_image && ok_to_load_binary(); + loadBinary = (rebuild_image_flags == GST_MAYBE_REBUILD_IMAGE + && ok_to_load_binary ()); abortOnFailure = false; /* If we must create a new non-local image, but the directory is @@ -504,12 +466,14 @@ gst_init_smalltalk (void) his ".st" directory or does "gst -i". */ if (!loadBinary - && !_gst_file_is_writeable (_gst_image_file_path)) + && !_gst_file_is_writeable (_gst_image_file_path) + && (flags & GST_IGNORE_BAD_IMAGE_PATH)) { _gst_image_file_path = _gst_get_cur_dir_name (); - asprintf (&_gst_binary_image_name, "%s/gst.im", _gst_image_file_path); - loadBinary = !ignore_image && ok_to_load_binary(); - xfree (default_image_file_name); + asprintf (&str, "%s/gst.im", _gst_image_file_path); + _gst_binary_image_name = str; + loadBinary = (rebuild_image_flags == GST_MAYBE_REBUILD_IMAGE + && ok_to_load_binary ()); } } @@ -517,25 +481,23 @@ gst_init_smalltalk (void) { _gst_init_interpreter (); _gst_init_compiler (); - _gst_init_vmproxy (); + } + else if (abortOnFailure) + { + _gst_errorf ("Couldn't load image file %s", _gst_binary_image_name); + return 1; } else { mst_Boolean willRegressTest = _gst_regression_testing; - _gst_regression_testing = false; - - if (abortOnFailure) - { - _gst_errorf ("Couldn't load image file %s", _gst_binary_image_name); - return 1; - } + int result; + _gst_regression_testing = false; _gst_init_oop_table (NULL, INITIAL_OOP_TABLE_SIZE); _gst_init_mem_default (); _gst_init_dictionary (); _gst_init_interpreter (); _gst_init_compiler (); - _gst_init_vmproxy (); _gst_install_initial_methods (); @@ -549,12 +511,9 @@ gst_init_smalltalk (void) } _gst_kernel_initialized = true; - _gst_invoke_hook ("returnFromSnapshot"); + _gst_invoke_hook (GST_RETURN_FROM_SNAPSHOT); if (user_init_file) - process_file (user_init_file); - - _gst_declare_tracing = traceUserDeclarations; - _gst_execution_tracing = traceUserExecution; + _gst_process_file (user_init_file, GST_DIR_ABS); #ifdef HAVE_READLINE _gst_initialize_readline (); @@ -563,147 +522,6 @@ gst_init_smalltalk (void) return 0; } -void -gst_top_level_loop (void) -{ - struct loaded_file *file; - for (file = loaded_files; file < &loaded_files[n_loaded_files]; file++) - { - char *f; - if (file->kernel_path) - { - f = find_kernel_file (file->file_name, "../", BASE_USER_DIR); - if (!f) - { - _gst_errorf ("Couldn't open kernel file %s", file->file_name); - continue; - } - } - else - f = xstrdup (file->file_name); - - /* - by itself indicates standard input */ - if (!strcmp (f, "-")) - process_stdin (); - else - { - if (!process_file (f)) - _gst_errorf ("Couldn't open file %s", f); - } - - xfree (f); - } - - if (n_loaded_files == 0) - process_stdin (); - - xfree (loaded_files); - n_loaded_files = 0; - if (snapshot_after_load) - _gst_save_to_file (_gst_binary_image_name); - - _gst_invoke_hook ("aboutToQuit"); -} - - - -void -init_paths (void) -{ - char *currentDirectory = _gst_get_cur_dir_name (); - - const char *home = getenv ("HOME"); - - /* By default, apply this kludge fpr OSes such as Windows and MS-DOS - which have no concept of home directories. */ - if (home == NULL) - home = xstrdup (currentDirectory); - - asprintf ((char **) &_gst_user_file_base_path, "%s/%s", home, LOCAL_BASE_DIR_NAME); - - if (_gst_binary_image_name) - { - /* Compute the actual path of the image file */ - const char *p = _gst_binary_image_name + strlen (_gst_binary_image_name); - for (;;) - if (*--p == '/' -#if defined(MSDOS) || defined(WIN32) || defined(__OS2__) - || *p == '\\' -#endif - ) - { - char *dirname; - int n = p > _gst_binary_image_name ? p - _gst_binary_image_name : 1; - dirname = xmalloc (n + 1); - memcpy (dirname, _gst_binary_image_name, n); - dirname[n] = 0; - _gst_image_file_path = dirname; - break; - } - - else if (p == _gst_binary_image_name) - { - _gst_image_file_path = "."; - break; - } - } - - /* These might go away in the next release. */ - if (!_gst_kernel_file_path) - { - _gst_kernel_file_path = getenv ("SMALLTALK_KERNEL"); - if (_gst_kernel_file_path) - _gst_warningf ("SMALLTALK_KERNEL variable deprecated, " - "use --kernel-directory instead"); - if (!_gst_file_is_readable (_gst_kernel_file_path)) - _gst_kernel_file_path = NULL; - } - - if (!_gst_image_file_path) - { - _gst_image_file_path = getenv ("SMALLTALK_IMAGE"); - if (_gst_image_file_path) - _gst_warningf ("SMALLTALK_IMAGE variable deprecated, " - "use --image-directory instead"); - if (!_gst_file_is_readable (_gst_image_file_path)) - _gst_image_file_path = NULL; - } - - if (!_gst_image_file_path) - { - if (_gst_file_is_readable (IMAGE_PATH)) - _gst_image_file_path = IMAGE_PATH; - else - _gst_image_file_path = xstrdup (currentDirectory); - } - - if (!_gst_kernel_file_path) - { - if (_gst_file_is_readable (KERNEL_PATH)) - _gst_kernel_file_path = KERNEL_PATH; - else - { - char *kernel_file_path; - asprintf (&kernel_file_path, "%s/kernel", _gst_image_file_path); - _gst_kernel_file_path = kernel_file_path; - } - } - - _gst_image_file_path = _gst_get_full_file_name (_gst_image_file_path); - _gst_kernel_file_path = _gst_get_full_file_name (_gst_kernel_file_path); - - xfree (currentDirectory); - - site_pre_image_file = find_kernel_file (SITE_PRE_IMAGE_FILE_NAME, "../", - NO_USER_DIR); - - user_pre_image_file = find_user_file (USER_PRE_IMAGE_FILE_NAME); - - if (!_gst_regression_testing) - user_init_file = find_user_file (USER_INIT_FILE_NAME); - else - user_init_file = NULL; -} mst_Boolean ok_to_load_binary (void) @@ -718,7 +536,7 @@ ok_to_load_binary (void) for (fileName = standard_files; *fileName; fileName += strlen (fileName) + 1) { - char *fullFileName = find_kernel_file (fileName, "", KERNEL_USER_DIR); + char *fullFileName = _gst_find_file (fileName, GST_DIR_KERNEL); mst_Boolean ok = (imageFileTime > _gst_get_file_modify_time (fullFileName)); xfree (fullFileName); if (!ok) @@ -743,46 +561,42 @@ load_standard_files (void) for (fileName = standard_files; *fileName; fileName += strlen (fileName) + 1) { - char *fullFileName = find_kernel_file (fileName, "", KERNEL_USER_DIR); - if (!fullFileName) + if (!_gst_process_file (fileName, GST_DIR_KERNEL)) { _gst_errorf ("can't find system file '%s'", fileName); _gst_errorf ("image bootstrap failed, use option --kernel-directory"); return 1; } - else - { - mst_Boolean ok = process_file (fullFileName); - xfree (fullFileName); - if (!ok) - return 1; - } } if (site_pre_image_file) - process_file (site_pre_image_file); + _gst_process_file (site_pre_image_file, GST_DIR_ABS); if (user_pre_image_file) - process_file (user_pre_image_file); + _gst_process_file (user_pre_image_file, GST_DIR_ABS); return 0; } char * -find_kernel_file (const char *fileName, const char *systemPrefix, - enum user_dir userDir) +_gst_find_file (const char *fileName, + enum gst_file_dir dir) { char *fullFileName, *localFileName; - asprintf (&fullFileName, "%s/%s%s", _gst_kernel_file_path, systemPrefix, + if (dir == GST_DIR_ABS) + return xstrdup (fileName); + + asprintf (&fullFileName, "%s/%s%s", _gst_kernel_file_path, + dir == GST_DIR_KERNEL ? "" : "../", fileName); - if (!no_user_files && userDir != NO_USER_DIR) + if (!no_user_files && dir != GST_DIR_KERNEL_SYSTEM) { asprintf (&localFileName, "%s/%s%s", _gst_user_file_base_path, - userDir == BASE_USER_DIR ? "" : LOCAL_KERNEL_DIR_NAME "/", + dir == GST_DIR_BASE ? "" : LOCAL_KERNEL_DIR_NAME "/", fileName); if (_gst_file_is_readable (localFileName) @@ -822,203 +636,3 @@ find_user_file (const char *fileName) else return fullFileName; } - - -void -process_stdin () -{ - if (_gst_verbosity == 3 || isatty (0)) - { - printf ("GNU Smalltalk ready\n\n"); - fflush (stdout); - } - - _gst_non_interactive = false; - _gst_push_stdin_string (); - _gst_parse_stream (false); - _gst_pop_stream (true); - _gst_non_interactive = true; -} - -mst_Boolean -process_file (const char *fileName) -{ - enum undeclared_strategy old; - int fd; - - fd = _gst_open_file (fileName, "r"); - if (fd == -1) - return (false); - - if (_gst_verbosity == 3) - printf ("Processing %s\n", fileName); - - old = _gst_set_undeclared (UNDECLARED_GLOBALS); - _gst_push_unix_file (fd, fileName); - _gst_parse_stream (false); - _gst_pop_stream (true); - _gst_set_undeclared (old); - return (true); -} - - -int -parse_args (int argc, - const char **argv) -{ - int ch, prev_optind = 1, minus_a_optind = -1; - -#ifndef ENABLE_DYNAMIC_TRANSLATION -# define OPTIONS "-acDEf:ghiI:K:lL:QqrSvV" -#else -# define OPTIONS "-acDf:ghiI:K:lL:QqrSvV" -#endif - - loaded_files = - (struct loaded_file *) xmalloc (sizeof (struct loaded_file) * argc); - - /* get rid of getopt's own error reporting for invalid options */ - opterr = 1; - - while ((ch = - getopt_long (argc, (char **) argv, OPTIONS, long_options, NULL)) != -1) - { -#undef OPTIONS - -#if DEBUG_GETOPT - printf ("%c \"%s\" %d %d %d\n", ch, optarg ? optarg : "", - optind, prev_optind, minus_a_optind); -#endif - - switch (ch) - { - case 'c': - _gst_make_core_file = true; - break; - case 'D': - _gst_declare_tracing++; - break; -#ifndef ENABLE_JIT_TRANSLATION - case 'E': - _gst_execution_tracing++; - break; -#endif - case 'g': - _gst_gc_message = false; - break; - case 'i': - ignore_image = true; - break; - case OPT_EMACS_MODE: - _gst_emacs_process = true; - break; - case 'q': - case 'Q': - _gst_verbosity = 1; - break; - case 'r': - _gst_regression_testing = true; - break; - case 'S': - snapshot_after_load = true; - break; - case 'V': - _gst_verbosity = 3; - break; - - case 'f': - /* Same as -q, passing a file, and -a. */ - _gst_verbosity = 1; - loaded_files[n_loaded_files].kernel_path = false; - loaded_files[n_loaded_files++].file_name = optarg; - - case 'a': - /* "Officially", the C command line ends here. The Smalltalk - command line, instead, starts right after the parameter - containing -a. -a is handled specially by the code that - tests the minus_a_optind variable, so that ./gst -aI - xxx yyy for example interprets xxx as the image to be - loaded. */ - minus_a_optind = optind; - break; - - case 'I': - _gst_binary_image_name = optarg; - if (!_gst_file_is_readable (_gst_binary_image_name)) - { - _gst_errorf ("Couldn't open image file %s", _gst_binary_image_name); - return 1; - } - break; - - case 'K': - loaded_files[n_loaded_files].kernel_path = true; - loaded_files[n_loaded_files++].file_name = optarg; - break; - - case OPT_KERNEL_DIR: - _gst_kernel_file_path = optarg; - if (!_gst_file_is_readable (_gst_kernel_file_path)) - { - _gst_errorf ("kernel path %s not readable", _gst_kernel_file_path); - return 1; - } - break; - - case OPT_IMAGE_DIR: - _gst_image_file_path = optarg; - if (!_gst_file_is_readable (_gst_image_file_path)) - { - _gst_errorf ("image path %s not readable", _gst_image_file_path); - return 1; - } - break; - - case OPT_NO_USER: - no_user_files = true; - break; - - case 'v': - printf (copyright_and_legal_stuff_text, VERSION, KERNEL_PATH, - IMAGE_PATH); - return -1; - - case '\1': - loaded_files[n_loaded_files].kernel_path = false; - loaded_files[n_loaded_files++].file_name = optarg; - break; - - default: - /* Fall through and show help message */ - - case 'h': - printf (help_text); - return ch == 'h' ? -1 : 1; - } - - if (minus_a_optind > -1 - && (ch == '\1' - || ch == 'f' - || optind > prev_optind - || optind > minus_a_optind)) - { - /* If the first argument was not an option, undo and leave. */ - if (ch == '\1') - optind--; - - /* If the first argument after -a was not an option, or if there - is nothing after -a, or if we finished processing the argument - which included -a, leave. */ - _gst_smalltalk_passed_argc = argc - optind; - _gst_smalltalk_passed_argv = - xmalloc (sizeof (char *) * _gst_smalltalk_passed_argc); - memcpy (_gst_smalltalk_passed_argv, argv + optind, - sizeof (char *) * _gst_smalltalk_passed_argc); - break; - } - - prev_optind = optind; - } - - return 0; -} --- orig/libgst/lib.h +++ mod/libgst/files.h @@ -73,13 +73,7 @@ extern const char *_gst_executable_path; 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 default_image_name. */ -extern char *_gst_binary_image_name - ATTRIBUTE_HIDDEN; - -/* This is used by the callin functions to auto-initialize Smalltalk. - When it's not true, initialization needs to be performed. It's set - to true by gst_init_smalltalk(). */ -extern mst_Boolean _gst_smalltalk_initialized +extern const char *_gst_binary_image_name ATTRIBUTE_HIDDEN; /* This is TRUE if we are doing regression testing, and causes @@ -118,4 +112,41 @@ extern mst_Boolean _gst_kernel_initializ extern mst_Boolean _gst_verbose ATTRIBUTE_HIDDEN; +/* This is true if the image initialization has already been + started. */ +extern mst_Boolean _gst_smalltalk_initialized + ATTRIBUTE_HIDDEN; + +/* This sets the arguments to be passed to the Smalltalk library, + which are the same that are available by the `gst' executable. */ +extern void _gst_smalltalk_args (int argc, + const char **argv) + ATTRIBUTE_HIDDEN; + +/* Set the fundamental paths for the Smalltalk VM and initialize + it. */ +extern int _gst_initialize (const char *kernel_dir, + const char *image_file, + int flags) + ATTRIBUTE_HIDDEN; + +/* This processes files passed to gst_smalltalk_args and, if none + was passed, stdin is looked for input. */ +extern void _gst_top_level_loop (void) + ATTRIBUTE_HIDDEN; + +/* Returns a copy of the VMProxy. In gstpub.c. */ +extern struct VMProxy *_gst_get_vmproxy (void) + ATTRIBUTE_HIDDEN; + +/* Attempts to find a viable kernel Smalltalk file (.st file). + FILENAME is a simple file name, sans directory; the file name to use + for the particular kernel file is returned. + If there is a file in the .stkernel directory with name FILENAME, that is + returned; otherwise the kernel path is prepended to FILENAME (separated + by a slash, of course) and that is stored in the string that is returned. */ +extern char *_gst_find_file (const char *fileName, + enum gst_file_dir dir) + ATTRIBUTE_HIDDEN; + #endif /* GST_LIB_H */ --- orig/libgst/gst.h +++ mod/libgst/gst.h @@ -176,4 +176,46 @@ struct object_s #define IS_OOP(oop) \ (! IS_INT(oop) ) +/* enum types used by the public APIs. */ +enum gst_file_dir { + GST_DIR_ABS, + GST_DIR_KERNEL_SYSTEM, + GST_DIR_KERNEL, + GST_DIR_BASE +}; + +enum gst_var_index { + GST_DECLARE_TRACING, + GST_EXECUTION_TRACING, + GST_EXECUTION_TRACING_VERBOSE, + GST_GC_MESSAGE, + GST_VERBOSITY, + GST_MAKE_CORE_FILE, + GST_REGRESSION_TESTING +}; + +enum gst_init_flags { + GST_REBUILD_IMAGE = 1, + GST_MAYBE_REBUILD_IMAGE = 2, + GST_IGNORE_USER_FILES = 4, + GST_IGNORE_BAD_IMAGE_PATH = 8, + GST_IGNORE_BAD_KERNEL_PATH = 16, + GST_NO_TTY = 32, +}; + +enum gst_vm_hook { + GST_BEFORE_EVAL, + GST_AFTER_EVAL, + GST_RETURN_FROM_SNAPSHOT, + GST_ABOUT_TO_QUIT, + GST_ABOUT_TO_SNAPSHOT, + GST_FINISHED_SNAPSHOT +}; + +#define INDEXED_WORD(obj, n) ( ((long *) ((obj) + 1)) [(n)-1] ) +#define INDEXED_BYTE(obj, n) ( ((char *) ((obj) + 1)) [(n)-1] ) +#define INDEXED_OOP(obj, n) ( ((OOP *) ((obj) + 1)) [(n)-1] ) +#define ARRAY_OOP_AT(obj, n) ( ((OOP *) ((gst_object) obj)->data) [(n)-1] ) +#define STRING_OOP_AT(obj, n) ( ((char *) ((gst_object) obj)->data) [(n)-1] ) + #endif /* GST_GST_H */ --- orig/libgst/gstpriv.h +++ mod/libgst/gstpriv.h @@ -643,16 +643,15 @@ extern OOP _gst_nil_oop #include "rbtrees.h" #include "tree.h" +#include "files.h" #include "input.h" #include "callin.h" #include "cint.h" #include "dict.h" #include "events.h" -#include "gstpub.h" #include "heap.h" #include "lex.h" #include "gst-parse.h" -#include "lib.h" #include "oop.h" #include "byte.h" #include "sym.h" --- orig/libgst/gstpub.h +++ mod/libgst/gstpub.h @@ -72,104 +72,108 @@ extern "C" #include "gst.h" -#ifndef __PROTO -# ifndef __STDC__ -# define __PROTO(args) () -# else -# define __PROTO(args) args -# endif -#endif typedef struct VMProxy { OOP nilOOP, trueOOP, falseOOP; - OOP (*msgSend) __PROTO ((OOP receiver, - OOP selector, - ...)); - OOP (*vmsgSend) __PROTO ((OOP receiver, - OOP selector, - OOP * args)); - OOP (*nvmsgSend) __PROTO ((OOP receiver, - OOP selector, - OOP * args, - int nargs)); + OOP (*msgSend) (OOP receiver, + OOP selector, + ...); + OOP (*vmsgSend) (OOP receiver, + OOP selector, + OOP * args); + OOP (*nvmsgSend) (OOP receiver, + OOP selector, + OOP * args, + int nargs); - OOP (*strMsgSend) __PROTO ((OOP receiver, - const char * selector, - ...)); - void (*msgSendf) __PROTO ((PTR resultPtr, - const char *fmt, - ...)); - OOP (*evalExpr) __PROTO ((const char *str)); - void (*evalCode) __PROTO ((const char *str)); - - OOP (*objectAlloc) __PROTO ((OOP classOOP, - int size)); - int (*basicSize) __PROTO ((OOP oop)); + OOP (*strMsgSend) (OOP receiver, + const char * selector, + ...); + void (*msgSendf) (PTR resultPtr, + const char *fmt, + ...); + OOP (*evalExpr) (const char *str); + void (*evalCode) (const char *str); + + OOP (*objectAlloc) (OOP classOOP, + int size); + int (*basicSize) (OOP oop); /* Actually funcAddr is a function pointer, but we don't know the returned type so we must declare it as PTR */ - void (*defineCFunc) __PROTO ((const char *funcName, - PTR funcAddr)); - OOP (*registerOOP) __PROTO ((OOP oop)); - void (*unregisterOOP) __PROTO ((OOP oop)); + void (*defineCFunc) (const char *funcName, + PTR funcAddr); + OOP (*registerOOP) (OOP oop); + void (*unregisterOOP) (OOP oop); /* Convert C datatypes to Smalltalk types */ - OOP (*idToOOP) __PROTO ((long i)); - OOP (*intToOOP) __PROTO ((long i)); - OOP (*floatToOOP) __PROTO ((double f)); - OOP (*boolToOOP) __PROTO ((int b)); - OOP (*charToOOP) __PROTO ((char c)); - OOP (*classNameToOOP) __PROTO ((const char *name)); - OOP (*stringToOOP) __PROTO ((const char *str)); - OOP (*byteArrayToOOP) __PROTO ((const char *str, - int n)); - OOP (*symbolToOOP) __PROTO ((const char *str)); - OOP (*cObjectToOOP) __PROTO ((PTR co)); - OOP (*typeNameToOOP) __PROTO ((const char *name)); - void (*setCObject) __PROTO ((OOP oop, PTR co)); + OOP (*idToOOP) (long i); + OOP (*intToOOP) (long i); + OOP (*floatToOOP) (double f); + OOP (*boolToOOP) (int b); + OOP (*charToOOP) (char c); + OOP (*classNameToOOP) (const char *name); + OOP (*stringToOOP) (const char *str); + OOP (*byteArrayToOOP) (const char *str, + int n); + OOP (*symbolToOOP) (const char *str); + OOP (*cObjectToOOP) (PTR co); + OOP (*typeNameToOOP) (const char *name); + void (*setCObject) (OOP oop, PTR co); /* Convert Smalltalk datatypes to C data types */ - long (*OOPToC) __PROTO ((OOP oop)); /* sometimes answers a PTR */ - long (*OOPToId) __PROTO ((OOP oop)); - long (*OOPToInt) __PROTO ((OOP oop)); - double (*OOPToFloat) __PROTO ((OOP oop)); - int (*OOPToBool) __PROTO ((OOP oop)); - char (*OOPToChar) __PROTO ((OOP oop)); - char *(*OOPToString) __PROTO ((OOP oop)); - char *(*OOPToByteArray) __PROTO ((OOP oop)); - PTR (*OOPToCObject) __PROTO ((OOP oop)); + long (*OOPToC) (OOP oop); /* sometimes answers a PTR */ + long (*OOPToId) (OOP oop); + long (*OOPToInt) (OOP oop); + double (*OOPToFloat) (OOP oop); + int (*OOPToBool) (OOP oop); + char (*OOPToChar) (OOP oop); + char *(*OOPToString) (OOP oop); + char *(*OOPToByteArray) (OOP oop); + PTR (*OOPToCObject) (OOP oop); /* Smalltalk process support */ - void (*asyncSignal) __PROTO ((OOP semaphoreOOP)); - void (*syncWait) __PROTO ((OOP semaphoreOOP)); - void (*asyncSignalAndUnregister) __PROTO ((OOP semaphoreOOP)); + void (*asyncSignal) (OOP semaphoreOOP); + void (*syncWait) (OOP semaphoreOOP); + void (*asyncSignalAndUnregister) (OOP semaphoreOOP); /* Array-of-OOP registry support. Move these above when we break binary compatibility. */ - void (*registerOOPArray) __PROTO ((OOP **first, OOP **last)); - void (*unregisterOOPArray) __PROTO ((OOP **first)); + void (*registerOOPArray) (OOP **first, OOP **last); + void (*unregisterOOPArray) (OOP **first); /* More conversions. */ - long double (*OOPToLongDouble) __PROTO ((OOP oop)); - OOP (*longDoubleToOOP) __PROTO ((long double f)); + long double (*OOPToLongDouble) (OOP oop); + OOP (*longDoubleToOOP) (long double f); /* More functions, added in 2.2. */ - OOP (*getObjectClass) __PROTO ((OOP oop)); - OOP (*getSuperclass) __PROTO ((OOP oop)); - mst_Boolean (*classIsKindOf) __PROTO ((OOP oop, OOP candidate)); - mst_Boolean (*objectIsKindOf) __PROTO ((OOP oop, OOP candidate)); - OOP (*perform) __PROTO ((OOP oop, OOP selector)); - OOP (*performWith) __PROTO ((OOP oop, OOP selector, OOP arg)); - mst_Boolean (*classImplementsSelector) __PROTO ((OOP classOOP, OOP selector)); - mst_Boolean (*classCanUnderstand) __PROTO ((OOP classOOP, OOP selector)); - mst_Boolean (*respondsTo) __PROTO ((OOP oop, OOP selector)); - size_t (*OOPSize) __PROTO ((OOP oop)); - OOP (*OOPAt) __PROTO ((OOP oop, size_t index)); - OOP (*OOPAtPut) __PROTO ((OOP oop, size_t index, OOP newOOP)); + OOP (*getObjectClass) (OOP oop); + OOP (*getSuperclass) (OOP oop); + mst_Boolean (*classIsKindOf) (OOP oop, + OOP candidate); + mst_Boolean (*objectIsKindOf) (OOP oop, + OOP candidate); + OOP (*perform) (OOP oop, + OOP selector); + OOP (*performWith) (OOP oop, + OOP selector, + OOP arg); + mst_Boolean (*classImplementsSelector) (OOP classOOP, + OOP selector); + mst_Boolean (*classCanUnderstand) (OOP classOOP, + OOP selector); + mst_Boolean (*respondsTo) (OOP oop, + OOP selector); + size_t (*OOPSize) (OOP oop); + OOP (*OOPAt) (OOP oop, + size_t index); + OOP (*OOPAtPut) (OOP oop, + size_t index, + OOP newOOP); /* Some system classes. */ OOP objectClass, arrayClass, stringClass, characterClass, smallIntegerClass, @@ -183,18 +187,19 @@ typedef struct VMProxy OOP processorOOP; /* More functions, added in 2.3. */ - OOP (*wcharToOOP) __PROTO ((wchar_t wc)); - OOP (*wstringToOOP) __PROTO ((const wchar_t *str)); - wchar_t (*OOPToWChar) __PROTO ((OOP oop)); - wchar_t *(*OOPToWString) __PROTO ((OOP oop)); + OOP (*wcharToOOP) (wchar_t wc); + OOP (*wstringToOOP) (const wchar_t *str); + wchar_t (*OOPToWChar) (OOP oop); + wchar_t *(*OOPToWString) (OOP oop); + + /* 3.0+ functions. */ + void (*processStdin) (const char *); + mst_Boolean (*processFile) (const char *fileName, enum gst_file_dir dir); + int (*getVar) (enum gst_var_index index); + int (*setVar) (enum gst_var_index index, int value); + void (*invokeHook) (enum gst_vm_hook); } VMProxy; -#define INDEXED_WORD(obj, n) ( ((long *) ((obj) + 1)) [(n)-1] ) -#define INDEXED_BYTE(obj, n) ( ((char *) ((obj) + 1)) [(n)-1] ) -#define INDEXED_OOP(obj, n) ( ((OOP *) ((obj) + 1)) [(n)-1] ) -#define ARRAY_OOP_AT(obj, n) ( ((OOP *) ((gst_object) obj)->data) [(n)-1] ) -#define STRING_OOP_AT(obj, n) ( ((char *) ((gst_object) obj)->data) [(n)-1] ) - /* Compatibility section */ #define indexedWord(obj, n) INDEXED_WORD(obj, n) #define indexedByte(obj, n) INDEXED_BYTE(obj, n) @@ -210,21 +215,76 @@ typedef struct VMProxy are not meant to be called by a module, which is brought up by GNU Smalltalk when the VM is already up and running. */ -/* This loads the image and prepares the Smalltalk environment. - Return -1 if the Smalltalk main loop should not be run but - without returning an erroneous exit code, 0 if it should be - run, and >0 if there was an error (such as the inability - to bootstrap). */ -extern int gst_init_smalltalk __PROTO ((void)); - -/* This sets the arguments to be passed to the Smalltalk library, - which are the same that are available by the `gst' executable. */ -extern void gst_smalltalk_args __PROTO ((int argc, - const char **argv)); - -/* This processes files passed to gst_smalltalk_args and, if none - was passed, stdin is looked for input. */ -extern void gst_top_level_loop __PROTO ((void)); +/* These are the library counterparts of the functions in files.h. */ +extern void gst_smalltalk_args (int argc, const char **argv); +extern int gst_initialize (const char *kernel_dir, + const char *image_file, + int flags); + +/* Functions in input.h. */ +extern void gst_process_stdin (const char *prompt); +extern mst_Boolean gst_process_file (const char *fileName, enum gst_file_dir dir); + +/* Functions in interp.h. */ +extern int gst_get_var (int index); +extern int gst_set_var (int index, int value); + +/* Functions in comp.h. */ +extern void gst_invoke_hook (enum gst_vm_hook); + +/* These are the library counterparts of the functions in + gst_vm_proxy. */ +extern OOP gst_msg_send (OOP receiver, OOP selector, ...); +extern OOP gst_vmsg_send (OOP receiver, OOP selector, OOP * args); +extern OOP gst_nvmsg_send (OOP receiver, OOP selector, OOP * args, int nargs); +extern OOP gst_str_msg_send (OOP receiver, const char * selector, ...); +extern void gst_msg_sendf (PTR result_ptr, const char *fmt, ...); +extern OOP gst_eval_expr (const char *str); +extern void gst_eval_code (const char *str); +extern OOP gst_object_alloc (OOP class_oop, int size); +extern int gst_basic_size (OOP oop); +extern void gst_define_cfunc (const char *func_name, PTR func_addr); +extern OOP gst_register_oop (OOP oop); +extern void gst_unregister_oop (OOP oop); +extern OOP gst_id_to_oop (long i); +extern OOP gst_int_to_oop (long i); +extern OOP gst_float_to_oop (double f); +extern OOP gst_bool_to_oop (int b); +extern OOP gst_char_to_oop (char c); +extern OOP gst_class_name_to_oop (const char *name); +extern OOP gst_string_to_oop (const char *str); +extern OOP gst_byte_array_to_oop (const char *str, int n); +extern OOP gst_symbol_to_oop (const char *str); +extern OOP gst_c_object_to_oop (PTR co); +extern OOP gst_type_name_to_oop (const char *name); +extern void gst_set_c_o_bject (OOP oop, PTR co); +extern long gst_oop_to_c (OOP oop); /* sometimes answers a PTR */ +extern long gst_oop_to_id (OOP oop); +extern long gst_oop_to_int (OOP oop); +extern double gst_oop_to_float (OOP oop); +extern int gst_oop_to_bool (OOP oop); +extern char gst_oop_to_char (OOP oop); +extern char *gst_oop_to_string (OOP oop); +extern char *gst_oop_to_byte_array (OOP oop); +extern PTR gst_oop_to_c_object (OOP oop); +extern void gst_async_signal (OOP semaphore_oop); +extern void gst_sync_wait (OOP semaphore_oop); +extern void gst_async_signal_and_unregister (OOP semaphore_oop); +extern void gst_register_oop_array (OOP **first, OOP **last); +extern void gst_unregister_oop_array (OOP **first); +extern long double gst_oop_to_long_double (OOP oop); +extern OOP gst_long_double_to_oop (long double f); +extern OOP gst_get_object_class (OOP oop); +extern OOP gst_get_superclass (OOP oop); +extern mst_Boolean gst_class_is_kind_of (OOP oop, OOP candidate); +extern mst_Boolean gst_object_is_kind_of (OOP oop, OOP candidate); +extern OOP gst_perform_with (OOP oop, OOP selector, OOP arg); +extern mst_Boolean gst_class_implements_selector (OOP class_oop, OOP selector); +extern mst_Boolean gst_class_can_understand (OOP class_oop, OOP selector); +extern mst_Boolean gst_responds_to (OOP oop, OOP selector); +extern size_t gst_oop_size (OOP oop); +extern OOP gst_oop_at (OOP oop, size_t index); +extern OOP gst_oop_at_put (OOP oop, size_t index, OOP new_oop); /* This is exclusively for programs who link with libgst.a; plugins should not use this VMProxy but rather the one they receive in @@ -235,6 +295,4 @@ extern VMProxy gst_interpreter_proxy; } #endif -#undef __PROTO - #endif /* GST_GSTPUB_H */ --- orig/libgst/input.c +++ mod/libgst/input.c @@ -57,9 +57,6 @@ # include <readline/history.h> #endif -#define EMACS_PROCESS_MARKER '\001' /* ^A as marker -- random - choice */ - typedef struct gst_file_segment { OBJ_HEADER; @@ -105,7 +102,7 @@ typedef struct input_stream int line; int column; - mst_Boolean prompt; + const char *prompt; OOP fileNameOOP; /* the full path name for file */ const char *fileName; @@ -147,10 +144,8 @@ static int poll_and_read (int fd, char * static int change_str = -1; -/* If true, the normal execution information is supressed, and the - prompt is emitted with a special marker character ahead of it to - let the process filter know that the execution has completed. */ -mst_Boolean _gst_emacs_process = false; +/* If true, readline is disabled. */ +mst_Boolean _gst_no_tty = false; /* >= 1 if completions are enabled, < 1 if they are not. Available for completeness even if Readline is not used. */ @@ -259,7 +254,6 @@ _gst_push_unix_file (int fd, newStream->st_file.ptr = newStream->st_file.buf; newStream->st_file.end = newStream->st_file.buf; newStream->fileName = fileName; - newStream->prompt = isatty (fd); newStream->fileOffset = lseek (fd, 0, SEEK_CUR); } @@ -283,7 +277,6 @@ _gst_push_stream_oop (OOP oop) else newStream->fileName = "a Smalltalk Stream"; - newStream->prompt = false; _gst_register_oop (oop); } @@ -297,7 +290,6 @@ _gst_push_smalltalk_string (OOP stringOO newStream->st_str.strBase = (char *) _gst_to_cstring (stringOOP); newStream->st_str.str = newStream->st_str.strBase; newStream->fileName = "a Smalltalk string"; - newStream->prompt = false; } void @@ -310,7 +302,6 @@ _gst_push_cstring (const char *string) newStream->st_str.strBase = xstrdup (string); newStream->st_str.str = newStream->st_str.strBase; newStream->fileName = "a C string"; - newStream->prompt = false; } void @@ -319,7 +310,7 @@ _gst_push_stdin_string (void) #ifdef HAVE_READLINE input_stream newStream; - if (_gst_emacs_process || !isatty (0)) + if (_gst_no_tty) { #endif _gst_push_unix_file (0, "stdin"); @@ -336,7 +327,6 @@ _gst_push_stdin_string (void) newStream->st_oop.ptr = NULL; newStream->st_oop.end = NULL; newStream->fileName = "stdin"; /* that's where we get input from */ - newStream->prompt = true; #endif } @@ -353,6 +343,7 @@ push_new_stream (stream_type type) newStream->fileOffset = -1; newStream->type = type; newStream->fileName = NULL; + newStream->prompt = NULL; newStream->fileNameOOP = _gst_nil_oop; newStream->prevStream = in_stream; in_stream = newStream; @@ -431,10 +422,7 @@ my_getc (input_stream stream) case STREAM_FILE: if (in_stream->column == 0 && in_stream->prompt) { - if (_gst_emacs_process) - printf ("%c", EMACS_PROCESS_MARKER); - - printf ("st> "); + printf ("%s", in_stream->prompt); fflush(stdout); } @@ -458,7 +446,9 @@ my_getc (input_stream stream) /* Refill the buffer... */ if (stream->st_oop.ptr == stream->st_oop.end) { - char *buf = readline ((char *) "st> "); + char *buf = readline (in_stream->prompt + ? (char *) in_stream->prompt + : (char *) ""); if (!buf) return EOF; @@ -835,6 +825,53 @@ poll_and_read (int fd, char *buf, int n) return -1; } +void +_gst_process_stdin (const char *prompt) +{ + if (_gst_verbosity == 3 || isatty (0)) + { + printf ("GNU Smalltalk ready\n\n"); + fflush (stdout); + } + + _gst_non_interactive = false; + _gst_push_stdin_string (); + if (isatty (0)) + in_stream->prompt = prompt; + _gst_parse_stream (false); + _gst_pop_stream (true); + _gst_non_interactive = true; +} + +mst_Boolean +_gst_process_file (const char *fileName, enum gst_file_dir dir) +{ + enum undeclared_strategy old; + int fd; + char *f; + + f = _gst_find_file (fileName, dir); + if (!f) + return false; + + fd = _gst_open_file (f, "r"); + if (fd != -1) + { + if (_gst_verbosity == 3) + printf ("Processing %s\n", f); + + old = _gst_set_undeclared (UNDECLARED_GLOBALS); + _gst_push_unix_file (fd, f); + _gst_parse_stream (false); + _gst_pop_stream (true); + _gst_set_undeclared (old); + } + + xfree (f); + return (true); +} + + #ifdef HAVE_READLINE /* Find apostrophes and double them */ char * --- orig/libgst/input.h +++ mod/libgst/input.h @@ -66,10 +66,8 @@ typedef enum } stream_type; -/* If true, the normal execution information is supressed, and the - prompt is emitted with a special marker character ahead of it to - let the process filter know that the execution has completed. */ -extern mst_Boolean _gst_emacs_process +/* If true, readline is suppressed. */ +extern mst_Boolean _gst_no_tty ATTRIBUTE_HIDDEN; /* Pass file descriptor FD, printed as file name FILENAME, to the @@ -212,6 +210,16 @@ extern void _gst_enable_completion (void extern void _gst_disable_completion (void) ATTRIBUTE_HIDDEN; +/* Parse the Smalltalk source code read from stdin, showing the + PROMPT that is passed. */ +extern void _gst_process_stdin (const char *prompt) + ATTRIBUTE_HIDDEN; + +/* Parse the Smalltalk source code read from file FILE found within + the search path DIR. */ +extern mst_Boolean _gst_process_file (const char *fileName, + enum gst_file_dir dir) + ATTRIBUTE_HIDDEN; #endif /* GST_INPUT_H */ --- orig/libgst/interp.c +++ mod/libgst/interp.c @@ -474,11 +474,6 @@ static inline void prepare_context (gst_ status (ip, sp, _gst_this_method, _gst_self, ...). */ static void unwind_context (void); -/* Used to help minimize the number of primitives used to control the - various debugging flags, this routine maps the variable's INDEX to the - address of a boolean debug flag, which it returns. */ -static inline int *bool_addr_index (int index) ATTRIBUTE_PURE; - /* Check whether it is true that sending SENDSELECTOR to RECEIVER accepts NUMARGS arguments. Note that the RECEIVER is only used to do a quick check in the method cache before examining the selector @@ -2035,25 +2030,59 @@ create_callin_process (OOP contextOOP) return (initialProcessOOP); } -int * -bool_addr_index (int index) +int +_gst_get_var (enum gst_var_index index) { switch (index) { - case 0: - return (&_gst_declare_tracing); - case 1: - return (&_gst_execution_tracing); - case 2: - return (&verbose_exec_tracing); - case 3: - return (&_gst_gc_message); + case GST_DECLARE_TRACING: + return (_gst_declare_tracing); + case GST_EXECUTION_TRACING: + return (_gst_execution_tracing); + case GST_EXECUTION_TRACING_VERBOSE: + return (verbose_exec_tracing); + case GST_GC_MESSAGE: + return (_gst_gc_message); + case GST_VERBOSITY: + return (_gst_verbosity); + case GST_MAKE_CORE_FILE: + return (_gst_make_core_file); + case GST_REGRESSION_TESTING: + return (_gst_regression_testing); default: - return (NULL); /* index out of range, signal the error - */ + return (-1); } } +int +_gst_set_var (enum gst_var_index index, int value) +{ + int old = _gst_get_var (index); + if (value < 0) + return -1; + + switch (index) + { + case GST_DECLARE_TRACING: + _gst_declare_tracing = value; + case GST_EXECUTION_TRACING: + _gst_execution_tracing = value; + case GST_EXECUTION_TRACING_VERBOSE: + verbose_exec_tracing = value; + case GST_GC_MESSAGE: + _gst_gc_message = value; + case GST_VERBOSITY: + _gst_verbosity = value; + case GST_MAKE_CORE_FILE: + _gst_make_core_file = value; + case GST_REGRESSION_TESTING: + _gst_regression_testing = true; + default: + return (-1); + } + + return old; +} void --- orig/libgst/interp.h +++ mod/libgst/interp.h @@ -577,4 +577,17 @@ extern void _gst_set_primitive_attribute extern void _gst_init_primitives () ATTRIBUTE_HIDDEN; +/* Get the value of internal variable whose number is INDEX; the + list of valid variables is in gstpub.h. Return -1 if the index + is invalid. */ +extern int _gst_get_var (enum gst_var_index index) + ATTRIBUTE_HIDDEN; + +/* Set the value of internal variable whose number is INDEX; the + list of valid variables is in gstpub.h. Return -1 if the index + is invalid or the value is negative, otherwise return the previous + value. */ +extern int _gst_set_var (enum gst_var_index index, int value) + ATTRIBUTE_HIDDEN; + #endif /* GST_INTERP_H */ --- orig/libgst/prims.def +++ mod/libgst/prims.def @@ -3374,13 +3374,13 @@ primitive VMpr_SystemDictionary_getTrace if (IS_INT (oop2)) { intptr_t arg2; - int *varAddr; + int value; arg2 = TO_INT (oop2); - varAddr = bool_addr_index (arg2); - if (varAddr != NULL) + value = _gst_get_var (arg2); + if (value != -1) { - oop1 = (*varAddr > 1 ? FROM_INT (oop2 ) : - (*varAddr ? _gst_true_oop : _gst_false_oop)); + oop1 = (value > 1 ? FROM_INT (oop2 ) : + (value ? _gst_true_oop : _gst_false_oop)); PUSH_OOP (oop1); PRIM_SUCCEEDED; } @@ -3401,12 +3401,13 @@ primitive VMpr_SystemDictionary_setTrace oop1 = POP_OOP (); if (IS_INT (oop1)) { - int *varAddr; intptr_t arg1 = TO_INT (oop1); - varAddr = bool_addr_index (arg1); - if (varAddr != NULL) + intptr_t old_value = _gst_set_var (arg1, + IS_INT (oop2) + ? TO_INT (oop2) + : oop2 == _gst_true_oop); + if (old_value != -1) { - *varAddr = IS_INT (oop2) ? TO_INT (oop2) : (oop2 == _gst_true_oop); SET_EXCEPT_FLAG (true); PRIM_SUCCEEDED; } --- orig/libgst/save.c +++ mod/libgst/save.c @@ -270,7 +270,7 @@ _gst_save_to_file (const char *fileName) if (imageFd < 0) return (false); - _gst_invoke_hook ("aboutToSnapshot"); + _gst_invoke_hook (GST_ABOUT_TO_SNAPSHOT); _gst_global_gc (0); _gst_finish_incremental_gc (); @@ -306,7 +306,7 @@ _gst_save_to_file (const char *fileName) buffer_write_flush (imageFd); close (imageFd); - _gst_invoke_hook ("finishedSnapshot"); + _gst_invoke_hook (GST_FINISHED_SNAPSHOT); return (true); } --- orig/main.c +++ mod/main.c @@ -56,27 +56,353 @@ #endif #include "gstpub.h" +#include "getopt.h" -#if STDC_HEADERS +#include <stdio.h> #include <stdlib.h> #include <string.h> -#endif +#include <sys/stat.h> #ifdef ENABLE_DISASSEMBLER #define TRUE_FALSE_ALREADY_DEFINED #include "dis-asm.h" #endif +static const char help_text[] = + "GNU Smalltalk usage:" + "\n" + "\n gst [ flag ... ] [ file ... ]" + "\n gst [ flag ... ] { -f | --file } file [ args ... ]" + "\n" + "\nShort flags can appear either as -xyz or as -x -y -z. If an option is" + "\nmandatory for a long option, it is also mandatory for a short one. The" + "\ncurrently defined set of flags is:" + "\n -a --smalltalk-args\t\t Pass the remaining arguments to Smalltalk." + "\n -c --core-dump\t\t Dump core on fatal signal." + "\n -D --declaration-trace\t Trace compilation of all loaded files." + "\n -E --execution-trace\t\t Trace execution of all loaded files." + "\n -g --no-gc-message\t\t Do not print garbage collection messages." + "\n -H --help\t\t\t Print this message and exit." + "\n -i --rebuild-image\t\t Ignore the image file; rebuild it from scratch." + "\n --maybe-rebuild-image\t Rebuild the image file from scratch if\n\t\t\t\t any kernel file is newer." + "\n -I --image FILE\t\t Instead of `gst.im', use FILE as the image\n\t\t\t\t file, and ignore the kernel files' timestamps.\n" + "\n -K --kernel-file FILE\t Make FILE's path relative to the image path." + "\n -q --quiet --silent\t\t Do not print execution information." + "\n -r --regression-test\t\t Run in regression test mode, i.e. make\n\t\t\t\t printed messages constant." + "\n -S --snapshot\t\t Save a snapshot just before exiting." + "\n -v --version\t\t\t Print the Smalltalk version number and exit." + "\n -V --verbose\t\t\t Show names of loaded files and execution stats." + "\n --emacs-mode\t\t Execute as a `process' (from within Emacs)" + "\n --kernel-dir DIR\t\t Look for kernel files in directory DIR." + "\n --no-user-files\t\t Don't read user customization files.\n" + "\n -\t\t\t\t Read input from standard input explicitly." + "\n" + "\nFiles are loaded one after the other. After the last one is loaded," + "\nSmalltalk will exit. If no files are specified, Smalltalk reads from" + "\nthe terminal, with prompts." + "\n" + "\nIn the second form, the file after -f is the last loaded file; any" + "\nparameter after that file is passed to the Smalltalk program." + "\n" "\nReport bugs to [hidden email]\n"; + +static const char copyright_and_legal_stuff_text[] = + "GNU Smalltalk version %s" + "\nCopyright 2006 Free Software Foundation, Inc." + "\nWritten by Steve Byrne ([hidden email]) and Paolo Bonzini ([hidden email])" + "\n" + "\nGNU Smalltalk comes with NO WARRANTY, to the extent permitted by law." + "\nYou may redistribute copies of GNU Smalltalk under the terms of the" + "\nGNU General Public License. For more information, see the file named" + "\nCOPYING." + "\n" + "\nUsing default kernel path: %s" "\nUsing default image path: %s" + "\n"; + +#define OPT_KERNEL_DIR 2 +#define OPT_NO_USER 3 +#define OPT_EMACS_MODE 4 +#define OPT_MAYBE_REBUILD 5 + +#define OPTIONS "-acDEf:ghiI:K:lL:QqrSvV" + +static const struct option long_options[] = { + {"smalltalk-args", 0, 0, 'a'}, + {"core-dump", 0, 0, 'c'}, + {"declaration-trace", 0, 0, 'D'}, + {"execution-trace", 0, 0, 'E'}, + {"file", 0, 0, 'f'}, + {"kernel-directory", 1, 0, OPT_KERNEL_DIR}, + {"no-user-files", 0, 0, OPT_NO_USER}, + {"no-gc-message", 0, 0, 'g'}, + {"help", 0, 0, 'h'}, + {"maybe-rebuild-image", 0, 0, OPT_MAYBE_REBUILD}, + {"rebuild-image", 0, 0, 'i'}, + {"image-file", 1, 0, 'I'}, + {"kernel-file", 1, 0, 'K'}, + {"emacs-mode", 0, 0, OPT_EMACS_MODE}, + {"quiet", 0, 0, 'q'}, + {"no-messages", 0, 0, 'q'}, + {"silent", 0, 0, 'q'}, + {"regression-test", 0, 0, 'r'}, + {"snapshot", 0, 0, 'S'}, + {"version", 0, 0, 'v'}, + {"verbose", 0, 0, 'V'}, + {NULL, 0, 0, 0} +}; + +struct loaded_file { + mst_Boolean kernel_path; + const char *file_name; +}; + +static struct loaded_file *loaded_files; +int n_loaded_files; + + +/* These contain the default path that was picked (after looking at the + environment variables) for the kernel files and the image. */ +char *kernel_dir = NULL; + +/* Mapped to the corresponding GST variable, with additional care to + handle more than 1 occurrence of the option. */ +int declare_tracing; +int execution_tracing; + +/* Flags to be passed to gst_initialize. Set mostly from command-line + variables. */ +int flags; + +/* We implement -S ourselves. This flag is set to 1 if -S is passed. */ +mst_Boolean snapshot_after_load; + +/* 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 + default_image_name. */ +const char *image_file = NULL; + +/* Prompt; modified if --emacs-process is given to add a ^A in front of it. */ +const char *stdin_prompt = "st> "; + + +#define EMACS_PROCESS_MARKER "\001" + +void +parse_args (int argc, + const char **argv) +{ + int ch, prev_optind = 1, minus_a_optind = -1; + + /* get rid of getopt's own error reporting for invalid options */ + opterr = 1; + + while ((ch = getopt_long (argc, (char **) argv, OPTIONS, + long_options, NULL)) != -1) + { + +#if DEBUG_GETOPT + printf ("%c \"%s\" %d %d %d\n", ch, optarg ? optarg : "", + optind, prev_optind, minus_a_optind); +#endif + + switch (ch) + { + case 'c': + gst_set_var (GST_MAKE_CORE_FILE, true); + break; + case 'D': + declare_tracing++; + break; + case 'E': + execution_tracing++; + break; + case 'g': + gst_set_var (GST_GC_MESSAGE, false); + break; + case OPT_MAYBE_REBUILD: + flags |= GST_MAYBE_REBUILD_IMAGE; + break; + case 'i': + flags |= GST_REBUILD_IMAGE; + break; + case OPT_EMACS_MODE: + stdin_prompt = EMACS_PROCESS_MARKER "st> "; + gst_set_var (GST_VERBOSITY, 1); + break; + case 'q': + case 'Q': + gst_set_var (GST_VERBOSITY, 1); + break; + case 'r': + gst_set_var (GST_REGRESSION_TESTING, true); + break; + case 'S': + snapshot_after_load = true; + break; + case 'V': + gst_set_var (GST_VERBOSITY, 3); + break; + + case 'f': + /* Same as -q, passing a file, and -a. */ + gst_set_var (GST_VERBOSITY, 1); + loaded_files[n_loaded_files].kernel_path = false; + loaded_files[n_loaded_files++].file_name = optarg; + + case 'a': + /* "Officially", the C command line ends here. The Smalltalk + command line, instead, starts right after the parameter + containing -a. -a is handled specially by the code that + tests the minus_a_optind variable, so that ./gst -aI + xxx yyy for example interprets xxx as the image to be + loaded. */ + minus_a_optind = optind; + break; + + case 'I': + if (image_file) + { + fprintf (stderr, "gst: Only one -I option should be given\n"); + exit (1); + } + image_file = optarg; + break; + + case 'K': + loaded_files[n_loaded_files].kernel_path = true; + loaded_files[n_loaded_files++].file_name = optarg; + break; + + case OPT_KERNEL_DIR: + if (kernel_dir) + { + fprintf (stderr, "gst: Only one --kernel-directory option should" + " be given\n"); + exit (1); + } + kernel_dir = optarg; + break; + + case OPT_NO_USER: + flags |= GST_IGNORE_USER_FILES; + break; + + case 'v': + printf (copyright_and_legal_stuff_text, VERSION, KERNEL_PATH, + IMAGE_PATH); + exit (0); + + case '\1': + loaded_files[n_loaded_files].kernel_path = false; + loaded_files[n_loaded_files++].file_name = optarg; + break; + + default: + /* Fall through and show help message */ + + case 'h': + printf (help_text); + exit (ch == 'h' ? 1 : 0); + } + + if (minus_a_optind > -1 + && (ch == '\1' + || ch == 'f' + || optind > prev_optind + || optind > minus_a_optind)) + { + /* If the first argument was not an option, undo and leave. */ + if (ch == '\1') + optind--; + + /* If the first argument after -a was not an option, or if there + is nothing after -a, or if we finished processing the argument + which included -a, leave. */ + gst_smalltalk_args (argc - optind, argv + optind); + break; + } + + prev_optind = optind; + } +} + int main(int argc, const char **argv) { int result; - gst_smalltalk_args(argc, argv); - result = gst_init_smalltalk(); - if (result == 0) - gst_top_level_loop(); + struct loaded_file *file; + + loaded_files = + (struct loaded_file *) alloca (sizeof (struct loaded_file) * argc); + + parse_args (argc, argv); + + /* These might go away in the next release. */ + if (!kernel_dir) + { + kernel_dir = getenv ("SMALLTALK_KERNEL"); + if (kernel_dir) + { + flags |= GST_IGNORE_BAD_KERNEL_PATH; + fprintf (stderr, "gst: SMALLTALK_KERNEL variable deprecated, " + "use --kernel-directory instead\n"); + } + } + + if (!image_file) + { + const char *image_dir = getenv ("SMALLTALK_IMAGE"); + flags |= GST_MAYBE_REBUILD_IMAGE; + if (image_dir) + { + char *p; + asprintf (&p, "%s/gst.im", image_dir); + image_file = p; + flags |= GST_IGNORE_BAD_IMAGE_PATH; + fprintf (stderr, "SMALLTALK_IMAGE variable deprecated, " + "use -I instead\n"); + } + } + + gst_set_var (GST_DECLARE_TRACING, declare_tracing > 1); + gst_set_var (GST_EXECUTION_TRACING, execution_tracing > 1); + result = gst_initialize (kernel_dir, image_file, flags); + if (result) + exit (result); + + gst_set_var (GST_DECLARE_TRACING, declare_tracing > 0); + gst_set_var (GST_EXECUTION_TRACING, execution_tracing > 0); + + for (file = loaded_files; file < &loaded_files[n_loaded_files]; file++) + { + /* - by itself indicates standard input */ + if (!file->kernel_path && !strcmp (file->file_name, "-")) + gst_process_stdin (stdin_prompt); + + else + { + if (!gst_process_file (file->file_name, + file->kernel_path ? GST_DIR_BASE : GST_DIR_ABS)) + { + if (file->kernel_path) + fprintf (stderr, "gst: Couldn't open kernel file %s\n", file->file_name); + else + fprintf (stderr, "gst: Couldn't open file %s\n", file->file_name); + } + } + } + + if (n_loaded_files == 0) + gst_process_stdin (stdin_prompt); + + if (snapshot_after_load) + gst_msg_sendf (NULL, "%O snapshot: %O", + gst_class_name_to_oop ("ObjectMemory"), + gst_str_msg_send (gst_class_name_to_oop ("File"), + "image", NULL)); - exit(result <= 0 ? 0 : result); + gst_invoke_hook (GST_ABOUT_TO_QUIT); + exit (0); } #ifdef ENABLE_DISASSEMBLER * added files --- /dev/null +++ mod/libgst/gstpub.c @@ -0,0 +1,518 @@ +/******************************** -*- C -*- **************************** + * + * Public entry points + * + * This module provides public routines with a "gst_" prefix. + * These are exported by the dynamic library. + * + * + ***********************************************************************/ + + +/*********************************************************************** + * + * Copyright 2007 Free Software Foundation, Inc. + * Written by Steve Byrne. + * + * 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. + * + return ***********************************************************************/ + +#include "gstpriv.h" + +/* By not including this file anywhere else, we make sure that _gst functions + are always called, and don't create unnecessary PLA entries. */ +#include "gstpub.h" + +VMProxy gst_interpreter_proxy = { + NULL, NULL, NULL, + + _gst_msg_send, _gst_vmsg_send, _gst_nvmsg_send, _gst_str_msg_send, + _gst_msg_sendf, + _gst_eval_expr, _gst_eval_code, + + _gst_object_alloc, _gst_basic_size, + + _gst_define_cfunc, _gst_register_oop, _gst_unregister_oop, + +/* Convert C datatypes to Smalltalk types */ + + _gst_id_to_oop, _gst_int_to_oop, _gst_float_to_oop, _gst_bool_to_oop, + _gst_char_to_oop, _gst_class_name_to_oop, + _gst_string_to_oop, _gst_byte_array_to_oop, _gst_symbol_to_oop, + _gst_c_object_to_oop, _gst_type_name_to_oop, _gst_set_c_object, + +/* Convert Smalltalk datatypes to C data types */ + + _gst_oop_to_c, _gst_oop_to_id, _gst_oop_to_int, _gst_oop_to_float, + _gst_oop_to_bool, _gst_oop_to_char, + _gst_oop_to_string, _gst_oop_to_byte_array, _gst_oop_to_c_object, + +/* Smalltalk process support */ + _gst_async_signal, _gst_sync_wait, _gst_async_signal_and_unregister, + + _gst_register_oop_array, _gst_unregister_oop_array, + +/* Convert Smalltalk datatypes to C data types (2) */ + _gst_oop_to_long_double, _gst_long_double_to_oop, + + _gst_get_object_class, _gst_get_superclass, + _gst_class_is_kind_of, _gst_object_is_kind_of, + _gst_perform, _gst_perform_with, _gst_class_implements_selector, + _gst_class_can_understand, _gst_responds_to, + _gst_oop_size, _gst_oop_at, _gst_oop_at_put, + + /* System objects. */ + NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, + NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, + + /* New in 2.3. */ + _gst_wchar_to_oop, _gst_wstring_to_oop, + _gst_oop_to_wchar, _gst_oop_to_wstring, + + /* New in 3.0. */ + _gst_process_stdin, + _gst_process_file, + _gst_get_var, _gst_set_var, + _gst_invoke_hook +}; + +/* Functions in comp.h. */ +void gst_invoke_hook (enum gst_vm_hook hook) +{ + _gst_invoke_hook (hook); +} + +void +gst_smalltalk_args (int argc, + const char **argv) +{ + _gst_smalltalk_args (argc, argv); +} + +int +gst_initialize (const char *kernel_dir, + const char *image_file, + int flags) +{ + return _gst_initialize (kernel_dir, image_file, flags); +} + +void gst_process_stdin (const char *prompt) +{ + _gst_process_stdin (prompt); +} + +mst_Boolean +gst_process_file (const char *fileName, enum gst_file_dir dir) +{ + return _gst_process_file (fileName, dir); +} + +int +gst_get_var (int index) +{ + return _gst_get_var (index); +} + +int +gst_set_var (int index, int value) +{ + return _gst_set_var (index, value); +} + +OOP +gst_msg_send (OOP receiver, OOP selector, ...) +{ + va_list ap; + va_start (ap, selector); + return _gst_va_msg_send (receiver, selector, ap); +} + +OOP +gst_vmsg_send (OOP receiver, OOP selector, OOP * args) +{ + return _gst_vmsg_send (receiver, selector, args); +} + +OOP +gst_nvmsg_send (OOP receiver, OOP selector, OOP * args, int nargs) +{ + return _gst_nvmsg_send (receiver, selector, args, nargs); +} + +OOP +gst_str_msg_send (OOP receiver, const char *sel, ...) +{ + va_list ap; + OOP selector = _gst_symbol_to_oop (sel); + va_start (ap, sel); + return _gst_va_msg_send (receiver, selector, ap); +} + +void +gst_msg_sendf (PTR result_ptr, const char *fmt, ...) +{ + va_list ap; + va_start (ap, fmt); + _gst_va_msg_sendf (result_ptr, fmt, ap); +} + +OOP +gst_eval_expr (const char *str) +{ + return _gst_eval_expr (str); +} + +void +gst_eval_code (const char *str) +{ + _gst_eval_code (str); +} + +OOP +gst_object_alloc (OOP class_oop, int size) +{ + return _gst_object_alloc (class_oop, size); +} + +int +gst_basic_size (OOP oop) +{ + return _gst_basic_size (oop); +} + +void +gst_define_cfunc (const char *func_name, PTR func_addr) +{ + _gst_define_cfunc (func_name, func_addr); +} + +OOP +gst_register_oop (OOP oop) +{ + return _gst_register_oop (oop); +} + +void +gst_unregister_oop (OOP oop) +{ + _gst_unregister_oop (oop); +} + +OOP +gst_id_to_oop (long i) +{ + return _gst_id_to_oop (i); +} + +OOP +gst_int_to_oop (long i) +{ + return _gst_int_to_oop (i); +} + +OOP +gst_float_to_oop (double f) +{ + return _gst_float_to_oop (f); +} + +OOP +gst_bool_to_oop (int b) +{ + return _gst_bool_to_oop (b); +} + +OOP +gst_char_to_oop (char c) +{ + return _gst_char_to_oop (c); +} + +OOP +gst_class_name_to_oop (const char *name) +{ + return _gst_class_name_to_oop (name); +} + +OOP +gst_string_to_oop (const char *str) +{ + return _gst_string_to_oop (str); +} + +OOP +gst_byte_array_to_oop (const char *str, int n) +{ + return _gst_byte_array_to_oop (str, n); +} + +OOP +gst_symbol_to_oop (const char *str) +{ + return _gst_symbol_to_oop (str); +} + +OOP +gst_c_object_to_oop (PTR co) +{ + return _gst_c_object_to_oop (co); +} + +OOP +gst_type_name_to_oop (const char *name) +{ + return _gst_type_name_to_oop (name); +} + +void +gst_set_c_object (OOP oop, PTR co) +{ + _gst_set_c_object (oop, co); +} + +long +gst_oop_to_c (OOP oop) +{ + return _gst_oop_to_c (oop); +} /*sometimes answers a PTR */ + +long +gst_oop_to_id (OOP oop) +{ + return _gst_oop_to_id (oop); +} + +long +gst_oop_to_int (OOP oop) +{ + return _gst_oop_to_int (oop); +} + +double +gst_oop_to_float (OOP oop) +{ + return _gst_oop_to_float (oop); +} + +int +gst_oop_to_bool (OOP oop) +{ + return _gst_oop_to_bool (oop); +} + +char +gst_oop_to_char (OOP oop) +{ + return _gst_oop_to_char (oop); +} + +char * +gst_oop_to_string (OOP oop) +{ + return _gst_oop_to_string (oop); +} + +char * +gst_oop_to_byte_array (OOP oop) +{ + return _gst_oop_to_byte_array (oop); +} + +PTR +gst_oop_to_c_object (OOP oop) +{ + return _gst_oop_to_c_object (oop); +} + +void +gst_async_signal (OOP semaphore_oop) +{ + _gst_async_signal (semaphore_oop); +} + +void +gst_sync_wait (OOP semaphore_oop) +{ + _gst_sync_wait (semaphore_oop); +} + +void +gst_async_signal_and_unregister (OOP semaphore_oop) +{ + _gst_async_signal_and_unregister (semaphore_oop); +} + +void +gst_register_oop_array (OOP **first, OOP **last) +{ + _gst_register_oop_array (first, last); +} + +void +gst_unregister_oop_array (OOP **first) +{ + _gst_unregister_oop_array (first); +} + +long double +gst_oop_to_long_double (OOP oop) +{ + return _gst_oop_to_long_double (oop); +} + +OOP +gst_long_double_to_oop (long double f) +{ + return _gst_long_double_to_oop (f); +} + +OOP +gst_get_object_class (OOP oop) +{ + return _gst_get_object_class (oop); +} + +OOP +gst_get_superclass (OOP oop) +{ + return _gst_get_superclass (oop); +} + +mst_Boolean +gst_class_is_kind_of (OOP oop, OOP candidate) +{ + return _gst_class_is_kind_of (oop, candidate); +} + +mst_Boolean +gst_object_is_kind_of (OOP oop, OOP candidate) +{ + return _gst_object_is_kind_of (oop, candidate); +} + +OOP +gst_perform_with (OOP oop, OOP selector, OOP arg) +{ + return _gst_perform_with (oop, selector, arg); +} + +mst_Boolean +gst_class_implements_selector (OOP class_oop, OOP selector) +{ + return _gst_class_implements_selector (class_oop, selector); +} + +mst_Boolean gst_class_can_understand (OOP class_oop, OOP selector) +{ + return _gst_class_can_understand (class_oop, selector); +} + +mst_Boolean +gst_responds_to (OOP oop, OOP selector) +{ + return _gst_responds_to (oop, selector); +} + +size_t +gst_oop_size (OOP oop) +{ + return _gst_oop_size (oop); +} + +OOP +gst_oop_at (OOP oop, size_t index) +{ + return _gst_oop_at (oop, index); +} + +OOP +gst_oop_at_put (OOP oop, size_t index, OOP new_oop) +{ + return _gst_oop_at_put (oop, index, new_oop); +} + + +static void +init_vmproxy (void) +{ + gst_interpreter_proxy.nilOOP = _gst_nil_oop; + gst_interpreter_proxy.trueOOP = _gst_true_oop; + gst_interpreter_proxy.falseOOP = _gst_false_oop; + + gst_interpreter_proxy.objectClass = _gst_object_class; + gst_interpreter_proxy.arrayClass = _gst_array_class; + gst_interpreter_proxy.stringClass = _gst_string_class; + gst_interpreter_proxy.characterClass = _gst_char_class; + gst_interpreter_proxy.smallIntegerClass = _gst_small_integer_class; + gst_interpreter_proxy.floatDClass = _gst_floatd_class; + gst_interpreter_proxy.floatEClass = _gst_floate_class; + gst_interpreter_proxy.byteArrayClass = _gst_byte_array_class; + gst_interpreter_proxy.objectMemoryClass = _gst_object_memory_class; + gst_interpreter_proxy.classClass = _gst_class_class; + gst_interpreter_proxy.behaviorClass = _gst_behavior_class; + gst_interpreter_proxy.blockClosureClass = _gst_block_closure_class; + gst_interpreter_proxy.contextPartClass = _gst_context_part_class; + gst_interpreter_proxy.blockContextClass = _gst_block_context_class; + gst_interpreter_proxy.methodContextClass = _gst_method_context_class; + gst_interpreter_proxy.compiledMethodClass = _gst_compiled_method_class; + gst_interpreter_proxy.compiledBlockClass = _gst_compiled_block_class; + gst_interpreter_proxy.fileDescriptorClass = _gst_file_descriptor_class; + gst_interpreter_proxy.fileStreamClass = _gst_file_stream_class; + gst_interpreter_proxy.processClass = _gst_process_class; + gst_interpreter_proxy.semaphoreClass = _gst_semaphore_class; + gst_interpreter_proxy.cObjectClass = _gst_c_object_class; + + /* And system objects. */ + gst_interpreter_proxy.processorOOP = _gst_processor_oop; + +} + +struct VMProxy * +_gst_get_vmproxy (void) +{ + struct VMProxy *result; + if (!gst_interpreter_proxy.nilOOP) + init_vmproxy (); + + result = xmalloc (sizeof (struct VMProxy)); + memcpy (result, &gst_interpreter_proxy, sizeof (struct VMProxy)); + return result; +} _______________________________________________ help-smalltalk mailing list [hidden email] http://lists.gnu.org/mailman/listinfo/help-smalltalk |
«
Return to Gnu
|
1 view|%1 views
| Free forum by Nabble | Edit this page |