Added libscsh.a and renamed former libscsh.a to libscshvm.a.

Makefile.in

@@ -104,7 +104,8 @@ CIG = cig/cig
 CIGOBJS = cig/libcig.o cig/libcig1.o
 
 #scsh-lib
-LIBSCSH = scsh/lib$(VM).a
+LIBSCSHVM = scsh/lib$(VM).a
+LIBSCSH = scsh/libscsh.a
 SCSHVMHACKS = scsh/proc2.o
 
 # 	
@@ -120,21 +121,22 @@ SCSHOBJS = \
 	scsh/machine/libansi.o \
 	scsh/network.o scsh/network1.o \
 	scsh/putenv.o \
-	scsh/rx/re-low.o scsh/rx/re1.o \
+	scsh/rx/re1.o \
 	scsh/select.o scsh/select1.o \
 	scsh/sleep1.o \
 	scsh/syscalls.o scsh/syscalls1.o \
 	scsh/time.o scsh/time1.o \
 	scsh/tty.o scsh/tty1.o \
 	scsh/userinfo1.o \
-	scsh/sighandlers1.o scsh/sighandlers.o \
+	scsh/sighandlers1.o \
 	scsh/regexp/libregex.a
 
 UNIX_OBJS = c/unix/misc.o c/unix/io.o c/unix/fd-io.o c/unix/event.o
 
 
 S48OBJS = c/scheme48vm.o c/scheme48heap.o c/extension.o c/external.o 
-OBJS = scsh/process_args.o $(S48OBJS) $(CIGOBJS) $(SCSHOBJS) $(SCSHVMHACKS)
+OBJS = scsh/process_args.o c/init.o $(S48OBJS) $(CIGOBJS) $(SCSHOBJS) \
+	$(SCSHVMHACKS)
 
 FAKEHS	= c/fake/dlfcn.h c/fake/sigact.h c/fake/strerror.h \
 		c/fake/sys-select.h
@@ -148,7 +150,7 @@ CONFIG_FILES = scheme/interfaces.scm scheme/low-packages.scm \
 
 # The following is the first rule and therefore the "make" command's
 # default target.
-enough: $(VM) $(IMAGE) go $(LIBCIG) scsh $(LIBSCSH) 
+enough: $(VM) $(IMAGE) go $(LIBCIG) scsh $(LIBSCSH) $(LIBSCSHVM) 
 #JMG: no manpages at the moment $(MANPAGE)
 #JMG no notify at the moment... .notify
 
@@ -156,14 +158,16 @@ enough: $(VM) $(IMAGE) go $(LIBCIG) scsh $(LIBSCSH)
 # External code to include in the VM
 # After changing any of these you should delete `scheme48vm' and remake it.
 
-CIGGED = flock network  select syscalls tty time sighandlers re_low
+CIGGED = flock network  select syscalls tty time
 CIGGEDOBJ = $(patsubst %,scsh/%.o, $(CIGGED))
 CIGGEDINIT = $(patsubst %,s48_init_%, $(CIGGED))
 
 EXTERNAL_OBJECTS = $(SOCKET_OBJECTS) $(LOOKUP_OBJECTS)
 EXTERNAL_FLAGS = $(SOCKET_FLAGS)
-EXTERNAL_INITIALIZERS = $(SOCKET_INITIALIZERS) $(LOOKUP_INITIALIZERS) \
+EXTERNAL_INITIALIZERS = $(ADDITIONAL_INITIALIZER) $(SOCKET_INITIALIZERS) 	\
-	s48_init_cig $(CIGGEDINIT) s48_init_userinfo 
+	$(LOOKUP_INITIALIZERS) 							\
+	s48_init_cig $(CIGGEDINIT) s48_init_userinfo s48_init_sighandlers 	\
+	s48_init_re_low
 
 
 # Rules for any external code.
@@ -186,10 +190,16 @@ LOOKUP_OBJECTS = c/unix/dynamo.o
 LOOKUP_INITIALIZERS = 	s48_init_external_lookup
 
 # End of lookup rules
+
+# Initializer for s48_add_external_init
+
+ADDITIONAL_INITIALIZER = s48_init_additional_inits
+
 # End of external rules
 # --------------------
 
 # The developers are curious to know.  Don't be concerned if this fails.
+# TODO: change this to scsh-notifications 
 .notify: build/minor-version-number
 	touch .notify
 	-echo Another 0.`cat $(srcdir)/build/minor-version-number` \
@@ -216,16 +226,17 @@ scsh/syscalls1.o  scsh/syscalls.o: scsh/syscalls1.h
 scsh/time1.o	  scsh/time.o:	   scsh/time1.h
 scsh/tty1.o       scsh/tty.o:	   scsh/tty1.h
 
-scsh/rx/re1.o	  scsh/rx/re-low.o:	   scsh/rx/re1.h
+# Not really, but making regexp/libregex.a makes the regexp/regex.h file that
+# re1.c actually does need.
+# TODO: This is broken at the moment: regex.h is not made after checkout
+scsh/rx/re1.o:    scsh/rx/re1.h scsh/regexp/libregex.a
 
 scsh/syscalls.o:  scsh/syscalls1.h scsh/dirstuff1.h scsh/fdports1.h \
 		  scsh/select1.h   scsh/userinfo1.h
 
-scsh/sighandlers1.o scsh/sighandlers.o: scsh/sighandlers1.h
+scsh/sighandlers1.o: scsh/sighandlers1.h
+
 
-# Not really, but making regexp/libregex.a makes the regexp/regex.h file that
-# re-low.c actually does need.
-scsh/rx/re-low.o: scsh/regexp/libregex.a
 
 include $(srcdir)/scsh/machine/Makefile.inc
 # Berkeley make wants to see this instead: (or use GNU make on BSD. -bri)
@@ -251,16 +262,33 @@ $(LIBCIG): c/main.o $(OBJS)
 	$(AR) $@ c/main.o  $(OBJS)
 	$(RANLIB) $@
 
-$(LIBSCSH): c/smain.o $(OBJS)
+$(LIBSCSHVM): c/smain.o $(OBJS)
 	$(RM) $@
 	$(AR) $@ c/smain.o $(OBJS) 
 	$(RANLIB) $@
 
-c/main.o: c/main.c c/scheme48vm.h c/scheme48heap.h
+$(LIBSCSH): $(OBJS) $(OBJS) $(UNIX_OBJS) $(LIBOBJS) $(EXTERNAL_OBJECTS)
+	$(RM) $@								\
+	rm -f /tmp/s48_external_$$$$.c &&					\
+	build/build-external-modules /tmp/s48_external_$$$$.c			\
+		$(EXTERNAL_INITIALIZERS) &&					\
+	$(CC) -c $(CFLAGS) -o  /tmp/s48_external_$$$$.o				\
+			/tmp/s48_external_$$$$.c &&				\
+	$(AR) $@ $(OBJS) $(OBJS) $(UNIX_OBJS) $(LIBOBJS) $(EXTERNAL_OBJECTS)	\
+		/tmp/s48_external_$$$$.o &&					\
+	$(RANLIB) $@ &&								\
+	rm -f /tmp/s48_external_$$$$.{c,o}	
+
+c/main.o: c/main.c
 	$(CC) -c $(CFLAGS) -o $@ \
 		-DDEFAULT_IMAGE_NAME=\"$(LIB)/$(IMAGE)\" \
 		$(CPPFLAGS) $(DEFS) c/main.c
 
+c/init.o: c/init.c c/scheme48vm.h c/scheme48heap.h
+	$(CC) -c $(CFLAGS) -o $@ \
+		-DDEFAULT_IMAGE_NAME=\"$(LIB)/$(IMAGE)\" \
+		$(CPPFLAGS) $(DEFS) c/init.c
+
 c/scheme48vm.o: c/prescheme.h c/scheme48vm.h c/scheme48heap.h c/event.h \
 			c/io.h c/fd-io.h c/scheme48vm-prelude.h
 c/scheme48heap.o: c/prescheme.h c/scheme48vm.h c/scheme48heap.h c/event.h \
@@ -387,9 +415,7 @@ clean-cig:
 
 clean-scm2c:
 	rm -f scsh/flock.c  scsh/network.c \
-	scsh/select.c scsh/syscalls.c scsh/tty.c scsh/time.c \
+	scsh/select.c scsh/syscalls.c scsh/tty.c scsh/time.c 
-	scsh/sighandlers.c scsh/rx/re-low.c
-
 
 #JMG: moved config.cache to distclean for easier debugging
 distclean: clean
@@ -873,7 +899,7 @@ scsh/scsh.image: $(VM) $(SCHEME) $(CIG).image
 scsh/regexp/libregex.a:
 	cd ./scsh/regexp; $(MAKE) lib
 
-scsh/scsh.vm: $(LIBSCSH) $(VM) scsh/scsh.image
+scsh/scsh.vm: $(LIBSCSHVM) $(VM) scsh/scsh.image
 	./$(VM) -o ./$(VM) -h 8000000 -i scsh/scsh.image \
 		-lm ./vm/ps-interface.scm \
 		-lm ./vm/interfaces.scm \
@@ -887,6 +913,7 @@ install-scsh: scsh
 	$(RM) $(bindir)/$(RUNNABLE)
 	$(INSTALL_PROGRAM) $(srcdir)/scsh/scsh $(bindir)/$(RUNNABLE)
 	$(INSTALL_PROGRAM) $(srcdir)/scsh/scsh.image $(LIB)/scsh.image
+	$(INSTALL_PROGRAM) $(srcdir)/$(LIBSCSHVM) $(libdir)/$(LIBSCSHVM)
 	$(INSTALL_PROGRAM) $(srcdir)/$(LIBSCSH) $(libdir)/$(LIBSCSH)
 	$(RANLIB) $(libdir)/$(LIBSCSH)
 	for f in $(srcdir)/scsh/*.scm; \
@@ -895,7 +922,7 @@ install-scsh: scsh
 clean-scsh:
 	$(RM) scsh/*.o scsh/regexp/*.o scsh/rx/*.o scsh/machine/*.o 
 	$(RM) scsh/*.image 
-	$(RM) $(LIBSCSH) scsh/scsh$(EXEEXT) scsh/scsh.vm
+	$(RM) $(LIBSCSHVM) $(LIBSCSH) scsh/scsh$(EXEEXT) scsh/scsh.vm
 	-cd scsh/regexp; $(MAKE) clean
 
 

c/external.c

@@ -1010,3 +1010,54 @@ s48_length(s48_value list)
   return S48_UNSAFE_ENTER_FIXNUM(i);
 }
 
+////////////////////////////////////////////////////////////////////////////////
+// 
+//  Support for libscsh.a: add external initializers without the Makefile
+//
+////////////////////////////////////////////////////////////////////////////////
+
+struct simple_list{
+  void (*init)();          // pointer to init-function
+  struct  simple_list* next;
+};
+
+struct simple_list* additional_inits = 0;
+
+/*
+ * This function is part of EXTERNAL_INITIALIZERS in the scsh Makefile.
+ * It calls the init-functions in additional_inits.
+ */
+
+void s48_init_additional_inits(){
+
+  struct simple_list* ptr = additional_inits;
+  struct simple_list* free_me;
+  
+  while (ptr != 0){
+    ptr->init();
+    free_me = ptr;
+    ptr = ptr->next;
+    free (free_me);
+  }
+}
+
+/* 
+ * Actual API function: argument is an init-function.  You have to
+ * ensure, that all s48_add_external_inits are called before you call
+ * s48_main. 
+ */
+
+int s48_add_external_init(void (*init)()){
+
+  struct simple_list *new_list;
+
+  new_list = (struct simple_list *) malloc(sizeof (struct simple_list));
+
+  if (new_list == 0) return 0;
+
+  new_list->init = init;
+  new_list->next = additional_inits;
+  additional_inits = new_list;
+
+  return 1;
+}

c/init.c

@@ -0,0 +1,137 @@
+/* Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees.
+   See file COPYING. */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <unistd.h>
+#include "scheme48vm.h"
+#include "scheme48heap.h"
+
+/* I bumped this up from 1.5 Mcell because the debugging info put us over
+** the top. -Olin
+*/
+#if !defined(DEFAULT_HEAP_SIZE)
+/* 4 megacell = 16 megabytes (8 meg per semispace) */
+#define DEFAULT_HEAP_SIZE 4000000L
+#endif
+
+#if !defined(DEFAULT_STACK_SIZE)
+/* 2500 cells = 10000 bytes */
+#define DEFAULT_STACK_SIZE 2500L
+#endif
+
+#if defined(STATIC_AREAS)
+#define DEFAULT_IMAGE_NAME NULL
+#else
+
+/* DEFAULT_IMAGE_NAME should be defined using the -D switch to cc. */
+#if !defined(DEFAULT_IMAGE_NAME)
+#define DEFAULT_IMAGE_NAME "scheme48.image"
+#endif
+
+#endif /* STATIC_AREAS */
+
+extern void	s48_sysdep_init(void);
+extern void	s48_initialize_external_modules(void);
+
+// JMG: s48_object_file is obsolete according to s48 manual
+char *s48_object_file;   /* specified via a command line argument */
+
+char *s48_reloc_file;    /* dynamic loading will set this */
+
+char *prog_name;
+
+int s48_main (long heap_size, long stack_size,
+	      char *image_name, int argc, char** argv)
+{
+  return internal_s48_main(heap_size, stack_size, "libscsh", "libscsh", 
+			   image_name, argc, argv);
+}
+    
+int
+internal_s48_main(long heap_size, long stack_size, char * _prog_name, 
+		  char* object_file, char *image_name, int argc, char** argv)
+{
+  long return_value;
+  void *heap, *stack;
+  long required_heap_size;
+  int warn_undefined_imported_bindings_p = 1;
+
+#if defined(STATIC_AREAS)
+  extern long static_entry;
+  extern long static_symbol_table;
+  extern long static_imported_binding_table, static_exported_binding_table;
+  extern long p_count, *p_areas[], p_sizes[];
+  extern long i_count, *i_areas[], i_sizes[];
+#endif
+
+  prog_name = _prog_name;
+
+  s48_object_file = object_file;
+  s48_reloc_file = NULL;
+
+
+  s48_sysdep_init();
+  s48_heap_init();
+  s48_init();
+
+  if (image_name == NULL)
+    required_heap_size = 0;
+  else {
+    /* check_image_header returns number of bytes; required_heap_size
+       is number of cells. */
+    required_heap_size =
+      s48_check_image_header((unsigned char *)image_name) >> 2;
+    if (-1 == required_heap_size) {
+      fprintf(stderr, "Image file \"%s\" is unusable.\n", image_name);
+      return 1; }
+  }
+
+  /* two semi-spaces, plus we want some room to maneuver */
+  if (heap_size < 4 * required_heap_size) {
+    fprintf(stderr, "heap size %ld is too small, using %ld\n",
+	    heap_size, 4 * required_heap_size);
+    heap_size = 4 * required_heap_size; }
+
+  heap = (void *) malloc(heap_size * sizeof(long));
+  stack = (void *) malloc(stack_size * sizeof(long));
+    
+  if (!heap || !stack) {
+    fprintf(stderr, "system is out of memory\n");
+    return 1; }
+
+  s48_initialize_heap((long)heap, heap_size);
+
+#if defined(STATIC_AREAS)
+  if (image_name == NULL) {
+    s48_register_static_areas(p_count, p_areas, p_sizes,
+			      i_count, i_areas, i_sizes);
+    s48_set_image_valuesB(static_entry,
+			  static_symbol_table,
+			  static_imported_binding_table,
+			  static_exported_binding_table);
+  } else if (s48_read_image() == -1) {
+    fprintf(stderr, "Image file \"%s\" is unusable.\n", image_name);
+    return 1; }
+#else
+  if (s48_read_image() == -1) {
+    fprintf(stderr, "Image file \"%s\" is unusable.\n", image_name);
+    return 1; }
+#endif
+
+  s48_initialize_vm(stack, stack_size);
+
+  s48_initialize_external_modules();
+  
+  if (warn_undefined_imported_bindings_p)
+    s48_warn_about_undefined_imported_bindings();
+  
+  return_value = s48_call_startup_procedure(argv, argc);
+  
+  if (s48_reloc_file != NULL)
+    if (0 != unlink(s48_reloc_file))
+      fprintf(stderr, "unable to delete file %s\n", s48_reloc_file);
+
+  return(return_value);
+}
+

c/main.c

@@ -4,8 +4,6 @@
 #include <stdlib.h>
 #include <stdio.h>
 #include <unistd.h>
-#include "scheme48vm.h"
-#include "scheme48heap.h"
 
 /* I bumped this up from 1.5 Mcell because the debugging info put us over
 ** the top. -Olin
@@ -31,19 +29,18 @@
 
 #endif /* STATIC_AREAS */
 
-extern void	s48_sysdep_init(void);
-extern void	s48_initialize_external_modules(void);
 
-char *s48_object_file;   /* specified via a command line argument */
-char *s48_reloc_file;    /* dynamic loading will set this */
-
-char *prog_name;
 
 char ** process_args(char **argv,
 		     long *heap_size,
 		     long *stack_size,
 		     char **object_file,
 		     char **image_name);
+
+int internal_s48_main(long heap_size, long stack_size, 
+		      char* prog_name, char* object_file, char* image_name, 
+		      int argc, char** argv);
+
 int
 main(argc, argv)
      int argc; char **argv;
@@ -52,11 +49,8 @@ main(argc, argv)
   char *image_name = DEFAULT_IMAGE_NAME;
   long heap_size = DEFAULT_HEAP_SIZE;    /* in numbers of cells */
   long stack_size = DEFAULT_STACK_SIZE;  /* in numbers of cells */
-  int errors = 0;
+  char *object_file = NULL;   /* specified via a command line argument */
-  long return_value;
+  char *prog_name;
-  void *heap, *stack;
-  long required_heap_size;
-  int warn_undefined_imported_bindings_p = 1;
 
 #if defined(STATIC_AREAS)
   extern long static_entry;
@@ -70,128 +64,9 @@ main(argc, argv)
   char *me = *argv;		/* Save program name. */
   prog_name = *argv++;
 
-  s48_object_file = s48_reloc_file = NULL;
   argv=process_args(argv, 		
 		    &heap_size, &stack_size,
-		    &s48_object_file, &image_name);
+		    &object_file, &image_name);
   for(argc=0, argp=argv; *argp; argc++, argp++); /* Recompute argc. */
-
+  return internal_s48_main(heap_size, stack_size, prog_name, object_file, image_name, argc, argv);
-  /* argv++; argc--;		 Skip program name. 
-
-  for (; argc > 0; argc--, argv++)
-    if (argv[0][0] == '-')
-      switch (argv[0][1]) {
-      case 'h':
-	argc--; argv++;
-	if (argc == 0) { errors++; break; }
-	heap_size = atoi(*argv);
-	if (heap_size <= 0) errors++;
-	break;
-      case 's':
-	argc--; argv++;
-	if (argc == 0) { errors++; break; }
-	stack_size = atoi(*argv);
-	if (stack_size <= 0) errors++;
-	break;
-      case 'i':
-	argc--; argv++;
-	if (argc == 0) { errors++; break; }
-	image_name = *argv;
-	break;
-      case 'a':
-	argc--;
-	vm_argc = argc;     remaining args are passed to the VM 
-	argc = 0;
-	break;
-      case 'o':
-        argc--; argv++;
-	if (argc == 0) { errors++; break; }
-        s48_object_file = *argv;
-	break;
-      case 'u':
-        argc--; argv++;
-	warn_undefined_imported_bindings_p = 0;
-	break;
-      default:
-	fprintf(stderr, "Invalid argument: %s\n", *argv);
-	errors++;
-      }
-    else
-      if (argv[0][0] != '\0') {
-	fprintf(stderr, "Invalid argument: %s\n", *argv);
-	errors++; }
-  if (errors != 0) {
-    fprintf(stderr,
-"Usage: %s [options] [-a arguments]\n\
-Options: -h <total heap size in words>\n\
-	 -s <stack buffer size in words>\n\
-         -i <image file name>\n\
-         -o <object file name>\n\
-         -u [don't warn on unbound external identifiers]",
-	    me);
-    return 1;
-  } */
-
-  s48_sysdep_init();
-  s48_heap_init();
-  s48_init();
-
-  if (image_name == NULL)
-    required_heap_size = 0;
-  else {
-    /* check_image_header returns number of bytes; required_heap_size
-       is number of cells. */
-    required_heap_size =
-      s48_check_image_header((unsigned char *)image_name) >> 2;
-    if (-1 == required_heap_size) {
-      fprintf(stderr, "Image file \"%s\" is unusable.\n", image_name);
-      return 1; }
-  }
-
-  /* two semi-spaces, plus we want some room to maneuver */
-  if (heap_size < 4 * required_heap_size) {
-    fprintf(stderr, "heap size %ld is too small, using %ld\n",
-	    heap_size, 4 * required_heap_size);
-    heap_size = 4 * required_heap_size; }
-
-  heap = (void *) malloc(heap_size * sizeof(long));
-  stack = (void *) malloc(stack_size * sizeof(long));
-    
-  if (!heap || !stack) {
-    fprintf(stderr, "system is out of memory\n");
-    return 1; }
-
-  s48_initialize_heap((long)heap, heap_size);
-
-#if defined(STATIC_AREAS)
-  if (image_name == NULL) {
-    s48_register_static_areas(p_count, p_areas, p_sizes,
-			      i_count, i_areas, i_sizes);
-    s48_set_image_valuesB(static_entry,
-			  static_symbol_table,
-			  static_imported_binding_table,
-			  static_exported_binding_table);
-  } else if (s48_read_image() == -1) {
-    fprintf(stderr, "Image file \"%s\" is unusable.\n", image_name);
-    return 1; }
-#else
-  if (s48_read_image() == -1) {
-    fprintf(stderr, "Image file \"%s\" is unusable.\n", image_name);
-    return 1; }
-#endif
-
-  s48_initialize_vm(stack, stack_size);
-
-  s48_initialize_external_modules();
-  
-  if (warn_undefined_imported_bindings_p)
-    s48_warn_about_undefined_imported_bindings();
-  
-  return_value = s48_call_startup_procedure(argv, argc);
-
-  if (s48_reloc_file != NULL)
-    if (0 != unlink(s48_reloc_file))
-      fprintf(stderr, "unable to delete file %s\n", s48_reloc_file);
-
-  return(return_value);
 }