1 /******************************** -*- C -*- ****************************
2  *
3  *	Public library entry points
4  *
5  *
6  ***********************************************************************/
7 
8 /***********************************************************************
9  *
10  * Copyright 1988,89,90,91,92,94,95,99,2000,2001,2002,2003,2006,2007,2008,2009
11  * Free Software Foundation, Inc.
12  * Written by Steve Byrne.
13  *
14  * This file is part of GNU Smalltalk.
15  *
16  * GNU Smalltalk is free software; you can redistribute it and/or modify it
17  * under the terms of the GNU General Public License as published by the Free
18  * Software Foundation; either version 2, or (at your option) any later
19  * version.
20  *
21  * Linking GNU Smalltalk statically or dynamically with other modules is
22  * making a combined work based on GNU Smalltalk.  Thus, the terms and
23  * conditions of the GNU General Public License cover the whole
24  * combination.
25  *
26  * In addition, as a special exception, the Free Software Foundation
27  * give you permission to combine GNU Smalltalk with free software
28  * programs or libraries that are released under the GNU LGPL and with
29  * independent programs running under the GNU Smalltalk virtual machine.
30  *
31  * You may copy and distribute such a system following the terms of the
32  * GNU GPL for GNU Smalltalk and the licenses of the other code
33  * concerned, provided that you include the source code of that other
34  * code when and as the GNU GPL requires distribution of source code.
35  *
36  * Note that people who make modified versions of GNU Smalltalk are not
37  * obligated to grant this special exception for their modified
38  * versions; it is their choice whether to do so.  The GNU General
39  * Public License gives permission to release a modified version without
40  * this exception; this exception also makes it possible to release a
41  * modified version which carries forward this exception.
42  *
43  * GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
44  * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
45  * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
46  * more details.
47  *
48  * You should have received a copy of the GNU General Public License along with
49  * GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
50  * Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
51  *
52  ***********************************************************************/
53 
54 
55 
56 #include "gstpriv.h"
57 
58 #ifndef MAXPATHLEN
59 #define MAXPATHLEN		1024	/* max length of a file and path */
60 #endif
61 
62 
63 /* Define to debug the getopt code.  */
64 /* #define DEBUG_GETOPT */
65 
66 #ifdef MSDOS
67 #define LOCAL_BASE_DIR_NAME		"_st"
68 #else
69 #define LOCAL_BASE_DIR_NAME		".st"
70 #endif
71 
72 #define USER_INIT_FILE_NAME		"init.st"
73 #define USER_PRE_IMAGE_FILE_NAME	"pre.st"
74 #define LOCAL_KERNEL_DIR_NAME		"kernel"
75 #define SITE_PRE_IMAGE_FILE_NAME	"site-pre.st"
76 
77 
78 /* When true, this flag suppresses the printing of execution-related
79  * messages, such as the number of byte codes executed by the
80  * last expression, etc.
81  */
82 int _gst_verbosity = 2;
83 
84 /* These contain the default path that was picked (after looking at the
85    environment variables) for the kernel files and the image.  */
86 const char *_gst_kernel_file_path = NULL;
87 const char *_gst_image_file_path = NULL;
88 
89 /* The ".st" directory, in the current directory or in the user's
90    home directory.  */
91 const char *_gst_user_file_base_path = NULL;
92 
93 /* Whether to look for user files.  */
94 static mst_Boolean no_user_files = false;
95 
96 /* This is the name of the binary image to load.  If it is not NULL after the
97    command line is parsed, the checking of the dates of the kernel source files
98    against the image file date is overridden.  If it is NULL, it is set to
99    default_image_name.  */
100 const char *_gst_binary_image_name = NULL;
101 
102 /* This is used by the callin functions to auto-initialize Smalltalk.
103    When it's not true, initialization needs to be performed.  It's set
104    to true by gst_init_smalltalk().  */
105 mst_Boolean _gst_smalltalk_initialized = false;
106 
107 /* This is used to avoid doing complicated things (currently, this
108    includes call-ins before and after _gst_execute_statements) before
109    the system is ready to do them.  */
110 mst_Boolean _gst_kernel_initialized = false;
111 
112 /* This is TRUE if we are doing regression testing, and causes
113    whatever sources of variance to be suppressed (such as printing out
114    execution statistics).  */
115 mst_Boolean _gst_regression_testing = false;
116 
117 
118 
119 /***********************************************************************
120  *
121  *	Private declarations
122  *
123  ***********************************************************************/
124 
125 /* Answer whether it is ok to load the binary image pointed to by
126    _gst_binary_image_name.  This is good is the image file is local
127    and newer than all of the kernel files, or if the image file is
128    global, newer than all of the global kernel files, and no local
129    kernel file is found.  */
130 static mst_Boolean ok_to_load_binary (void);
131 
132 /* Attempts to find a viable Smalltalk file for user-level customization.
133    FILENAME is a simple file name, sans directory; the file name to use
134    for the particular file is returned, or NULL if it is not found.  */
135 static char *find_user_file (const char *fileName);
136 
137 /* Loads the kernel Smalltalk files.  It uses a vector of file names,
138    and loads each file individually.  To provide for greater
139    flexibility, if a one of the files exists in the current directory,
140    that is used in preference to one in the default location.  The
141    default location can be overridden at runtime by setting the
142    SMALLTALK_KERNEL environment variable.  */
143 static int load_standard_files (void);
144 
145 /* Path names for the per-user customization files, respectively
146    init.st (loaded at every startup) and pre.st (loaded before a local
147    image is saved.  */
148 static const char *user_init_file = NULL;
149 static const char *user_pre_image_file = NULL;
150 static const char *site_pre_image_file = NULL;
151 
152 /* The complete list of "kernel" class and method definitions.  Each
153    of these files is loaded, in the order given below.  Their last
154    modification dates are compared against that of the image file; if
155    any are newer, the image file is ignored, these files are loaded,
156    and a new image file is created.
157 
158    As a provision for when we'll switch to a shared library, this
159    is not an array but a list of consecutive file names.  */
160 static const char standard_files[] = {
161   "Builtins.st\0"
162   "SysDict.st\0"
163   "Object.st\0"
164   "Message.st\0"
165   "DirMessage.st\0"
166   "Boolean.st\0"
167   "False.st\0"
168   "True.st\0"
169   "Magnitude.st\0"
170   "LookupKey.st\0"
171   "DeferBinding.st\0"
172   "Association.st\0"
173   "HomedAssoc.st\0"
174   "VarBinding.st\0"
175   "Integer.st\0"
176   "Date.st\0"
177   "Time.st\0"
178   "Number.st\0"
179   "Float.st\0"
180   "FloatD.st\0"
181   "FloatE.st\0"
182   "FloatQ.st\0"
183   "Fraction.st\0"
184   "LargeInt.st\0"
185   "SmallInt.st\0"
186   "Character.st\0"
187   "UniChar.st\0"
188   "Link.st\0"
189   "Process.st\0"
190   "CallinProcess.st\0"
191   "Iterable.st\0"
192   "Collection.st\0"
193   "SeqCollect.st\0"
194   "LinkedList.st\0"
195   "Semaphore.st\0"
196   "ArrayColl.st\0"
197   "CompildCode.st\0"
198   "CompildMeth.st\0"
199   "CompiledBlk.st\0"
200   "Array.st\0"
201   "ByteArray.st\0"
202   "CharArray.st\0"
203   "String.st\0"
204   "Symbol.st\0"
205   "UniString.st\0"
206   "Interval.st\0"
207   "OrderColl.st\0"
208   "SortCollect.st\0"
209   "HashedColl.st\0"
210   "Set.st\0"
211   "IdentitySet.st\0"
212   "Dictionary.st\0"
213   "LookupTable.st\0"
214   "IdentDict.st\0"
215   "MethodDict.st\0"
216   "BindingDict.st\0"
217   "AbstNamespc.st\0"
218   "RootNamespc.st\0"
219   "Namespace.st\0"
220   "Stream.st\0"
221   "PosStream.st\0"
222   "ReadStream.st\0"
223   "WriteStream.st\0"
224   "RWStream.st\0"
225   "UndefObject.st\0"
226   "ProcSched.st\0"
227   "ContextPart.st\0"
228   "MthContext.st\0"
229   "BlkContext.st\0"
230   "BlkClosure.st\0"
231   "Behavior.st\0"
232   "ClassDesc.st\0"
233   "Class.st\0"
234   "Metaclass.st\0"
235   "Continuation.st\0"
236   "Memory.st\0"
237   "MethodInfo.st\0"
238   "FileSegment.st\0"
239   "FileDescr.st\0"
240   "SymLink.st\0"
241   "Security.st\0"
242   "WeakObjects.st\0"
243   "ObjMemory.st\0"
244 
245   /* More core classes */
246   "Bag.st\0"
247   "MappedColl.st\0"
248   "Delay.st\0"
249   "SharedQueue.st\0"
250   "Random.st\0"
251   "RecursionLock.st\0"
252   "Transcript.st\0"
253   "Point.st\0"
254   "Rectangle.st\0"
255   "RunArray.st\0"
256   "AnsiDates.st\0"
257   "ScaledDec.st\0"
258   "ValueAdapt.st\0"
259   "OtherArrays.st\0"
260 
261   /* C call-out facilities */
262   "CObject.st\0"
263   "CType.st\0"
264   "CCallable.st\0"
265   "CFuncs.st\0"
266   "CCallback.st\0"
267   "CStruct.st\0"
268 
269   /* Exception handling and ProcessEnvironment */
270   "ProcEnv.st\0"
271   "ExcHandling.st\0"
272   "SysExcept.st\0"
273 
274   /* Virtual filesystem layer */
275   "FilePath.st\0"
276   "File.st\0"
277   "Directory.st\0"
278   "VFS.st\0"
279   "VFSZip.st\0"
280   "URL.st\0"
281   "FileStream.st\0"
282 
283   /* Goodies */
284   "DynVariable.st\0"
285   "DLD.st\0"
286   "Getopt.st\0"
287   "Generator.st\0"
288   "StreamOps.st\0"
289   "ObjDumper.st\0"
290   "Regex.st\0"
291   "PkgLoader.st\0"
292   "Autoload.st\0"
293 };
294 
295 /* The argc and argv that are passed to libgst via gst_smalltalk_args.
296    The default is passing no parameters.  */
297 static int smalltalk_argc = 0;
298 static const char **smalltalk_argv = NULL;
299 
300 /* The argc and argv that are made available to Smalltalk programs
301    through the -a option.  */
302 int _gst_smalltalk_passed_argc = 0;
303 const char **_gst_smalltalk_passed_argv = NULL;
304 
305 
306 
307 void
_gst_smalltalk_args(int argc,const char ** argv)308 _gst_smalltalk_args (int argc,
309 		     const char **argv)
310 {
311   smalltalk_argc = argc;
312   smalltalk_argv = argv;
313 }
314 
315 
316 int
_gst_initialize(const char * kernel_dir,const char * image_file,int flags)317 _gst_initialize (const char *kernel_dir,
318 		 const char *image_file,
319 		 int flags)
320 {
321   char *currentDirectory = _gst_get_cur_dir_name ();
322   const char *home = getenv ("HOME");
323   char *str;
324   mst_Boolean loadBinary, abortOnFailure;
325   int rebuild_image_flags =
326     flags & (GST_REBUILD_IMAGE | GST_MAYBE_REBUILD_IMAGE);
327 
328   /* Even though we're nowhere near through initialization, we set this
329      to make sure we don't invoke a callin function which would recursively
330      invoke us.  */
331   _gst_smalltalk_initialized = true;
332   _gst_init_snprintfv ();
333 
334   if (!_gst_executable_path)
335     _gst_executable_path = DEFAULT_EXECUTABLE;
336 
337   /* By default, apply this kludge fpr OSes such as Windows and MS-DOS
338      which have no concept of home directories.  */
339   if (home == NULL)
340     home = xstrdup (currentDirectory);
341 
342   asprintf ((char **) &_gst_user_file_base_path, "%s/%s",
343 	    home, LOCAL_BASE_DIR_NAME);
344 
345   /* Check that supplied paths are readable.  If they're not, fail unless
346      they told us in advance.  */
347   if (kernel_dir
348       && !_gst_file_is_readable (kernel_dir))
349     {
350       if (flags & GST_IGNORE_BAD_KERNEL_PATH)
351 	kernel_dir = NULL;
352       else
353 	{
354           _gst_errorf ("kernel path %s not readable", kernel_dir);
355           exit (1);
356 	}
357     }
358 
359   /* For the image file, it is okay to find none if we can/should rebuild
360      the image file.  */
361   if (image_file
362       && (flags & (GST_REBUILD_IMAGE | GST_MAYBE_REBUILD_IMAGE)) == 0
363       && !_gst_file_is_readable (image_file))
364     {
365       if (flags & GST_IGNORE_BAD_IMAGE_PATH)
366 	image_file = NULL;
367       else
368 	{
369 	  _gst_errorf ("Couldn't open image file %s", image_file);
370 	  exit (1);
371 	}
372     }
373 
374   /* The image path can be used as the default kernel path, so we split
375      it anyway into directory+filename.  */
376   if (image_file)
377     {
378       const char *p;
379       /* Compute the actual path of the image file */
380       p = image_file + strlen (image_file);
381       for (;;)
382 	if (*--p == '/'
383 #if defined(MSDOS) || defined(WIN32) || defined(__OS2__)
384 	    || *p == '\\'
385 #endif
386 	   )
387 	  {
388 	    char *dirname;
389 	    int n = p > image_file ? p - image_file : 1;
390 	    asprintf (&dirname, "%.*s", n, image_file);
391 	    _gst_image_file_path = dirname;
392 
393 	    /* Remove path from image_file.  */
394 	    image_file = p + 1;
395 	    break;
396 	  }
397 
398 	else if (p == image_file)
399 	  {
400 	    _gst_image_file_path = ".";
401 	    break;
402 	  }
403     }
404   else
405     {
406       /* No image file given, we use the system default or revert to the
407 	 current directory.  */
408       str = _gst_relocate_path (IMAGE_PATH);
409       if (_gst_file_is_readable (str))
410         _gst_image_file_path = str;
411       else
412 	{
413           free (str);
414           _gst_image_file_path = xstrdup (currentDirectory);
415 	}
416 
417       flags |= GST_IGNORE_BAD_IMAGE_PATH;
418       image_file = "gst.im";
419     }
420 
421   if (!kernel_dir)
422     {
423       str = _gst_relocate_path (KERNEL_PATH);
424       if (!_gst_file_is_readable (str))
425 	{
426           free (str);
427 	  asprintf (&str, "%s/kernel", _gst_image_file_path);
428 	}
429 
430       kernel_dir = str;
431     }
432 
433   xfree (currentDirectory);
434 
435   /* Uff, we're done with the complicated part.  Set variables to mirror
436      what we've decided in the above marathon.  */
437   _gst_image_file_path = _gst_get_full_file_name (_gst_image_file_path);
438   _gst_kernel_file_path = _gst_get_full_file_name (kernel_dir);
439   asprintf (&str, "%s/%s", _gst_image_file_path, image_file);
440   _gst_binary_image_name = str;
441 
442   _gst_smalltalk_passed_argc = smalltalk_argc;
443   _gst_smalltalk_passed_argv = smalltalk_argv;
444   no_user_files = (flags & GST_IGNORE_USER_FILES) != 0;
445   _gst_no_tty = (flags & GST_NO_TTY) != 0 || !isatty (0);
446 
447   site_pre_image_file = _gst_find_file (SITE_PRE_IMAGE_FILE_NAME,
448 					GST_DIR_KERNEL_SYSTEM);
449 
450   user_pre_image_file = find_user_file (USER_PRE_IMAGE_FILE_NAME);
451 
452   if (!_gst_regression_testing)
453     user_init_file = find_user_file (USER_INIT_FILE_NAME);
454   else
455     user_init_file = NULL;
456 
457   _gst_init_sysdep ();
458   _gst_init_signals ();
459   _gst_init_cfuncs ();
460   _gst_init_sockets ();
461   _gst_init_primitives ();
462 
463   if (_gst_regression_testing)
464     {
465       _gst_declare_tracing = 0;
466       _gst_execution_tracing = 0;
467       _gst_verbosity = 2;
468       setvbuf (stdout, NULL, _IOLBF, 1024);
469     }
470 
471   if (rebuild_image_flags == 0)
472     loadBinary = abortOnFailure = true;
473   else
474     {
475       loadBinary = (rebuild_image_flags == GST_MAYBE_REBUILD_IMAGE
476 		    && ok_to_load_binary ());
477       abortOnFailure = false;
478 
479       /* If we must create a new non-local image, but the directory is
480          not writeable, we must resort to the current directory.  In
481          practice this is what happens when a "normal user" puts stuff in
482 	 his ".st" directory or does "gst -i".  */
483 
484       if (!loadBinary
485           && !_gst_file_is_writeable (_gst_image_file_path)
486 	  && (flags & GST_IGNORE_BAD_IMAGE_PATH))
487         {
488           _gst_image_file_path = _gst_get_cur_dir_name ();
489           asprintf (&str, "%s/gst.im", _gst_image_file_path);
490 	  _gst_binary_image_name = str;
491           loadBinary = (rebuild_image_flags == GST_MAYBE_REBUILD_IMAGE
492 		        && ok_to_load_binary ());
493         }
494     }
495 
496   if (loadBinary && _gst_load_from_file (_gst_binary_image_name))
497     {
498       _gst_init_interpreter ();
499       _gst_init_compiler ();
500       _gst_init_vmproxy ();
501     }
502   else if (abortOnFailure)
503     {
504       _gst_errorf ("Couldn't load image file %s", _gst_binary_image_name);
505       return 1;
506     }
507   else
508     {
509       mst_Boolean willRegressTest = _gst_regression_testing;
510       int result;
511 
512       _gst_regression_testing = false;
513       _gst_init_oop_table (NULL, INITIAL_OOP_TABLE_SIZE);
514       _gst_init_mem_default ();
515       _gst_init_dictionary ();
516       _gst_init_interpreter ();
517       _gst_init_compiler ();
518       _gst_init_vmproxy ();
519 
520       _gst_install_initial_methods ();
521 
522       result = load_standard_files ();
523       _gst_regression_testing = willRegressTest;
524       if (result)
525 	return result;
526 
527       if (!_gst_save_to_file (_gst_binary_image_name))
528 	_gst_errorf ("Couldn't open file %s", _gst_binary_image_name);
529     }
530 
531   _gst_kernel_initialized = true;
532   _gst_invoke_hook (GST_RETURN_FROM_SNAPSHOT);
533   if (user_init_file)
534     _gst_process_file (user_init_file, GST_DIR_ABS);
535 
536 #ifdef HAVE_READLINE
537   _gst_initialize_readline ();
538 #endif /* HAVE_READLINE */
539 
540   return 0;
541 }
542 
543 
544 mst_Boolean
ok_to_load_binary(void)545 ok_to_load_binary (void)
546 {
547   const char *fileName;
548 
549   if (!_gst_file_is_readable (_gst_binary_image_name))
550     return (false);
551 
552   for (fileName = standard_files; *fileName; fileName += strlen (fileName) + 1)
553     {
554       char *fullFileName = _gst_find_file (fileName, GST_DIR_KERNEL);
555       mst_Boolean ok = _gst_file_is_newer (_gst_binary_image_name,
556 					   fullFileName);
557       xfree (fullFileName);
558       if (!ok)
559         return (false);
560     }
561 
562   if (site_pre_image_file
563       && !_gst_file_is_newer (_gst_binary_image_name, site_pre_image_file))
564     return (false);
565 
566   if (user_pre_image_file
567       && !_gst_file_is_newer (_gst_binary_image_name, user_pre_image_file))
568     return (false);
569 
570   return (true);
571 }
572 
573 int
load_standard_files(void)574 load_standard_files (void)
575 {
576   const char *fileName;
577 
578   for (fileName = standard_files; *fileName; fileName += strlen (fileName) + 1)
579     {
580       if (!_gst_process_file (fileName, GST_DIR_KERNEL))
581 	{
582 	  _gst_errorf ("couldn't load system file '%s': %s", fileName,
583 		       strerror (errno));
584 	  _gst_errorf ("image bootstrap failed, use option --kernel-directory");
585 	  return 1;
586 	}
587     }
588 
589   _gst_msg_sendf (NULL, "%v %o relocate", _gst_file_segment_class);
590 
591   if (site_pre_image_file)
592     _gst_process_file (site_pre_image_file, GST_DIR_ABS);
593 
594   if (user_pre_image_file)
595     _gst_process_file (user_pre_image_file, GST_DIR_ABS);
596 
597   return 0;
598 }
599 
600 
601 char *
_gst_find_file(const char * fileName,enum gst_file_dir dir)602 _gst_find_file (const char *fileName,
603 		enum gst_file_dir dir)
604 {
605   char *fullFileName, *localFileName;
606 
607   if (dir == GST_DIR_ABS)
608     return xstrdup (fileName);
609 
610   asprintf (&fullFileName, "%s/%s%s", _gst_kernel_file_path,
611 	    dir == GST_DIR_KERNEL ? "" : "../",
612 	    fileName);
613 
614   if (!no_user_files && dir != GST_DIR_KERNEL_SYSTEM)
615     {
616       asprintf (&localFileName, "%s/%s%s",
617 		_gst_user_file_base_path,
618 		dir == GST_DIR_BASE ? "" : LOCAL_KERNEL_DIR_NAME "/",
619 		fileName);
620 
621       if (_gst_file_is_newer (localFileName, fullFileName))
622 	{
623 	  xfree (fullFileName);
624 	  return localFileName;
625 	}
626       else
627 	xfree (localFileName);
628     }
629 
630   if (_gst_file_is_readable (fullFileName))
631     return fullFileName;
632 
633   xfree (fullFileName);
634   return NULL;
635 }
636 
637 
638 char *
find_user_file(const char * fileName)639 find_user_file (const char *fileName)
640 {
641   char *fullFileName;
642   if (no_user_files)
643     return NULL;
644 
645   asprintf (&fullFileName, "%s/%s", _gst_user_file_base_path, fileName);
646   if (!_gst_file_is_readable (fullFileName))
647     {
648       xfree (fullFileName);
649       return NULL;
650     }
651   else
652     return fullFileName;
653 }
654