From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Sat, 30 Oct 1993 03:04:27 +0000 (+0000)
Subject: Two major changes to the C back end:
X-Git-Tag: 20090517-FFI~7644
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3e2820090791ae4f0bc87c43cc2b7db7fa372e77;p=mit-scheme.git

Two major changes to the C back end:
- Redo the way that descriptors are done to improve speed.
  The default clause in each switch statement is now the only way to
  get out of a block.
  All JUMPs merely jump back to the dispatch point.

- Divide initialization code into code and data, to allow splitting
  of the sources into two components.
---

diff --git a/v7/src/microcode/cmpint.c b/v7/src/microcode/cmpint.c
index cb7be4dca..16f2d8138 100644
--- a/v7/src/microcode/cmpint.c
+++ b/v7/src/microcode/cmpint.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: cmpint.c,v 1.73 1993/10/26 02:57:43 gjr Exp $
+$Id: cmpint.c,v 1.74 1993/10/30 03:04:27 gjr Exp $
 
 Copyright (c) 1989-1993 Massachusetts Institute of Technology
 
@@ -133,7 +133,8 @@ typedef instruction * utility_result;
 extern void EXFUN (C_to_interface, (void *));
 extern utility_result interface_to_C_hook;
 
-static long C_return_value;
+extern long C_return_value;
+long C_return_value;
 
 /* Convenience macros */
 
@@ -3041,6 +3042,10 @@ utility_table_entry utility_table[] =
   UTE(comutil_compiled_code_bkpt),		/* 0x3c */
   UTE(comutil_compiled_closure_bkpt)		/* 0x3d */
   };
+
+extern long MAX_TRAMPOLINE;
+long MAX_TRAMPOLINE = ((sizeof (utility_table))
+		       / (sizeof (utility_table_entry)));
 
 /* Support for trap handling. */
 
diff --git a/v7/src/microcode/compinit.c b/v7/src/microcode/compinit.c
index 491c9bb5c..ca0166981 100644
--- a/v7/src/microcode/compinit.c
+++ b/v7/src/microcode/compinit.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: compinit.c,v 1.2 1993/06/09 20:36:38 jawilson Exp $
+$Id: compinit.c,v 1.3 1993/10/30 03:02:11 gjr Exp $
 
 Copyright (c) 1992-1993 Massachusetts Institute of Technology
 
@@ -35,20 +35,31 @@ MIT in each case. */
 #include "liarc.h"
 
 #undef DECLARE_COMPILED_CODE
+#undef DECLARE_COMPILED_DATA
 
-#define DECLARE_COMPILED_CODE(name, decl, code) do			\
+#define DECLARE_COMPILED_CODE(name, nentries, decl_code, code) do	\
 {									\
-  extern void EXFUN (decl, (void));					\
-  extern SCHEME_OBJECT * EXFUN (code, (SCHEME_OBJECT *));		\
-  if ((declare_compiled_code (name, decl, code)) == 0)			\
-    lose_big_1 ("DECLARE_COMPILED_CODE: duplicate tag", name);		\
+  extern int EXFUN (decl_code, (void));					\
+  extern SCHEME_OBJECT * EXFUN (code,					\
+				(SCHEME_OBJECT *, unsigned long));	\
+  int result =								\
+    (declare_compiled_code (name, nentries, decl_code, code));		\
+  if (result != 0)							\
+    return (result);							\
 } while (0)
 
-extern void EXFUN (lose_big_1, (char *, char *));
+#define DECLARE_COMPILED_DATA(name, decl_data, data) do			\
+{									\
+  extern int EXFUN (decl_data, (void));					\
+  extern SCHEME_OBJECT * EXFUN (data, (unsigned long));			\
+  int result = (declare_compiled_data (name, decl_data, data));		\
+  if (result != 0)							\
+    return (result);							\
+} while (0)
 
-void
+int
 DEFUN_VOID (initialize_compiled_code_blocks)
 {
 #include "compinit.h"
-  return;
+  return (0);
 }
diff --git a/v7/src/microcode/comutl.c b/v7/src/microcode/comutl.c
index 03c6b3c7c..bfc89309b 100644
--- a/v7/src/microcode/comutl.c
+++ b/v7/src/microcode/comutl.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: comutl.c,v 1.28 1993/10/26 02:58:01 gjr Exp $
+$Id: comutl.c,v 1.29 1993/10/30 03:04:19 gjr Exp $
 
 Copyright (c) 1987-1993 Massachusetts Institute of Technology
 
@@ -170,7 +170,8 @@ DEFINE_PRIMITIVE ("BUILTIN-INDEX->NAME", Prim_builtin_index_to_name, 1, 1,
 
 /* This is only meaningful for the C back end. */
 
-DEFINE_PRIMITIVE ("INITIALIZE-C-COMPILED-BLOCK", Prim_initialize_C_compiled_block, 1, 1,
+DEFINE_PRIMITIVE ("INITIALIZE-C-COMPILED-BLOCK",
+		  Prim_initialize_C_compiled_block, 1, 1,
   "Given the tag of a compiled object, return the object.")
 {
 #ifdef NATIVE_CODE_IS_C
diff --git a/v7/src/microcode/liarc.h b/v7/src/microcode/liarc.h
index 7651537e0..5d07ac54a 100644
--- a/v7/src/microcode/liarc.h
+++ b/v7/src/microcode/liarc.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: liarc.h,v 1.6 1993/10/28 04:45:25 gjr Exp $
+$Id: liarc.h,v 1.7 1993/10/30 03:02:05 gjr Exp $
 
 Copyright (c) 1992-1993 Massachusetts Institute of Technology
 
@@ -76,8 +76,6 @@ union machine_word_u
 
 typedef union machine_word_u machine_word;
 
-#define ERROR_UNKNOWN_DISPATCH( pc ) lose_big ("Unknown tag.")
-
 #define ADDRESS_UNITS_PER_OBJECT	(sizeof (SCHEME_OBJECT))
 #define ADDRESS_UNITS_PER_FLOAT		(sizeof (double))
 
@@ -113,9 +111,9 @@ typedef union machine_word_u machine_word;
   double num = (src);							\
   SCHEME_OBJECT * val;							\
 									\
-  ALIGN_FLOAT (free_pointer);						\
-  val = free_pointer;							\
-  free_pointer += (1 + (BYTES_TO_WORDS (sizeof (double))));		\
+  ALIGN_FLOAT (Rhp);							\
+  val = Rhp;								\
+  Rhp += (1 + (BYTES_TO_WORDS (sizeof (double))));			\
   * val = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR,				\
 			(BYTES_TO_WORDS (sizeof (double)))));		\
   (* ((double *) (val + 1))) = num;					\
@@ -134,10 +132,10 @@ typedef union machine_word_u machine_word;
 
 #ifdef USE_GLOBAL_VARIABLES
 
-#define value_reg Val
-#define free_pointer Free
-#define register_block Regs
-#define stack_pointer Stack_Pointer
+#define Rvl Val
+#define Rhp Free
+#define Rrb Regs
+#define Rsp Stack_Pointer
 
 #define DECLARE_VARIABLES() int unsed_variable_to_keep_C_happy
 #define UNCACHE_VARIABLES() do {} while (0)
@@ -147,110 +145,47 @@ typedef union machine_word_u machine_word;
 
 #define REGISTER register
 
-#define register_block Regs
+#define Rrb Regs
 
 #define DECLARE_VARIABLES()						\
-REGISTER SCHEME_OBJECT value_reg = Val;					\
-REGISTER SCHEME_OBJECT * free_pointer = Free;				\
-REGISTER SCHEME_OBJECT * stack_pointer = Stack_Pointer
+REGISTER SCHEME_OBJECT Rvl = Val;					\
+REGISTER SCHEME_OBJECT * Rhp = Free;					\
+REGISTER SCHEME_OBJECT * Rsp = Stack_Pointer
 
 #define UNCACHE_VARIABLES() do						\
 {									\
-  Stack_Pointer = stack_pointer;					\
-  Free = free_pointer;							\
-  Val = value_reg;							\
+  Stack_Pointer = Rsp;							\
+  Free = Rhp;								\
+  Val = Rvl;								\
 } while (0)
 
 #define CACHE_VARIABLES() do						\
 {									\
-  value_reg = Val;							\
-  free_pointer = Free;							\
-  stack_pointer = Stack_Pointer;					\
+  Rvl = Val;								\
+  Rhp = Free;								\
+  Rsp = Stack_Pointer;							\
 } while (0)
 
 #endif /* USE_GLOBAL_VARIABLES */
 
-#define REPEAT_DISPATCH() do						\
-{									\
-  if ((LABEL_PROCEDURE (my_pc)) != current_C_proc)			\
-  {									\
-    UNCACHE_VARIABLES ();						\
-    return (my_pc);							\
-  }									\
-  /* fall through. */							\
-} while (0)
-
-#ifdef USE_SHORTCKT_JUMP
-
 #define JUMP(destination) do						\
 {									\
-  my_pc = (destination);						\
-  goto repeat_dispatch;							\
+  Rpc = (destination);							\
+  goto perform_dispatch;						\
 } while(0)
 
-#define JUMP_EXTERNAL(destination) do					\
-{									\
-  my_pc = (destination);						\
-  if ((LABEL_PROCEDURE (my_pc)) == current_C_proc)			\
-  {									\
-    CACHE_VARIABLES ();							\
-    goto perform_dispatch;						\
-  }									\
-  return (my_pc);							\
-} while (0)
-
-#define JUMP_EXECUTE_CHACHE(entry) do					\
-{									\
-  my_pc = ((SCHEME_OBJECT *) current_block[entry]);			\
-  goto repeat_dispatch;							\
-} while (0)
-
-#define POP_RETURN() goto pop_return_repeat_dispatch
-
-#define POP_RETURN_REPEAT_DISPATCH() do					\
-{									\
-  my_pc = (OBJECT_ADDRESS (*stack_pointer++));				\
-  /* fall through to repeat_dispatch */					\
-} while (0)
-
-#else /* not USE_SHORTCKT_JUMP */
-
-#define JUMP(destination) do						\
-{									\
-  UNCACHE_VARIABLES ();							\
-  return (destination);							\
-} while (0)
-
-#define JUMP_EXTERNAL(destination) return (destination)
-
-#define JUMP_EXECUTE_CHACHE(entry) do					\
-{									\
-  SCHEME_OBJECT* destination						\
-    = ((SCHEME_OBJECT *) current_block[entry]);				\
-									\
-  JUMP (destination);							\
-} while (0)
+#define JUMP_EXECUTE_CHACHE(label)					\
+  JUMP ((SCHEME_OBJECT *) (current_block[label]))
 
-#define POP_RETURN() do							\
-{									\
-    SCHEME_OBJECT target = *stack_pointer++;				\
-    SCHEME_OBJECT destination = (OBJECT_ADDRESS (target));		\
-    JUMP (destination);							\
-} while (0)
+#define POP_RETURN() goto pop_return
 
-#define POP_RETURN_REPEAT_DISPATCH() do					\
-{									\
-} while (0)
-
-#endif /* USE_SHORTCKT_JUMP */
-
 #define INVOKE_PRIMITIVE(prim, nargs) do				\
 {									\
   primitive = (prim);							\
   primitive_nargs = (nargs);						\
   goto invoke_primitive;						\
 } while (0)
-
+
 #define INVOKE_PRIMITIVE_CODE() do					\
 {									\
   SCHEME_OBJECT * destination;						\
@@ -259,7 +194,8 @@ REGISTER SCHEME_OBJECT * stack_pointer = Stack_Pointer
   PRIMITIVE_APPLY (Val, primitive);					\
   POP_PRIMITIVE_FRAME (primitive_nargs);				\
   destination = (OBJECT_ADDRESS (STACK_POP ()));			\
-  JUMP_EXTERNAL (destination);						\
+  CACHE_VARIABLES ();							\
+  JUMP (destination);							\
 } while(0)
 
 #define INVOKE_INTERFACE_CODE() do					\
@@ -267,48 +203,49 @@ REGISTER SCHEME_OBJECT * stack_pointer = Stack_Pointer
   SCHEME_OBJECT * destination;						\
 									\
   UNCACHE_VARIABLES ();							\
-  destination = (invoke_utility (subtmp_code, subtmp_1, subtmp_2,	\
-				 subtmp_3, subtmp_4));			\
-  JUMP_EXTERNAL (destination);						\
+  destination = (invoke_utility (utlarg_code, utlarg_1, utlarg_2,	\
+				 utlarg_3, utlarg_4));			\
+  CACHE_VARIABLES ();							\
+  JUMP (destination);							\
 } while (0)
 
 #define INVOKE_INTERFACE_4(code, one, two, three, four) do		\
 {									\
-  subtmp_4 = ((long) (four));						\
-  subtmp_3 = ((long) (three));						\
-  subtmp_2 = ((long) (two));						\
-  subtmp_1 = ((long) (one));						\
-  subtmp_code = (code);							\
+  utlarg_4 = ((long) (four));						\
+  utlarg_3 = ((long) (three));						\
+  utlarg_2 = ((long) (two));						\
+  utlarg_1 = ((long) (one));						\
+  utlarg_code = (code);							\
   goto invoke_interface_4;						\
 } while (0)
 
 #define INVOKE_INTERFACE_3(code, one, two, three) do			\
 {									\
-  subtmp_3 = ((long) (three));						\
-  subtmp_2 = ((long) (two));						\
-  subtmp_1 = ((long) (one));						\
-  subtmp_code = (code);							\
+  utlarg_3 = ((long) (three));						\
+  utlarg_2 = ((long) (two));						\
+  utlarg_1 = ((long) (one));						\
+  utlarg_code = (code);							\
   goto invoke_interface_3;						\
 } while (0)
 
 #define INVOKE_INTERFACE_2(code, one, two) do				\
 {									\
-  subtmp_2 = ((long) (two));						\
-  subtmp_1 = ((long) (one));						\
-  subtmp_code = (code);							\
+  utlarg_2 = ((long) (two));						\
+  utlarg_1 = ((long) (one));						\
+  utlarg_code = (code);							\
   goto invoke_interface_2;						\
 } while (0)
 
 #define INVOKE_INTERFACE_1(code, one) do				\
 {									\
-  subtmp_1 = ((long) (one));						\
-  subtmp_code = (code);							\
+  utlarg_1 = ((long) (one));						\
+  utlarg_code = (code);							\
   goto invoke_interface_1;						\
 } while (0)
 
 #define INVOKE_INTERFACE_0(code) do					\
 {									\
-  subtmp_code = (code);							\
+  utlarg_code = (code);							\
   goto invoke_interface_0;						\
 } while (0)
 
@@ -352,63 +289,98 @@ REGISTER SCHEME_OBJECT * stack_pointer = Stack_Pointer
  : (((source1) >= 0)							\
     ? (- ((source1) / (- (source2))))					\
     : ((- (source1)) / (- (source2)))))
-
+
+#define INTERRUPT_CHECK(code, entry_point) do				\
+{									\
+  if (((long) Rhp) >= ((long) (Rrb[REGBLOCK_MEMTOP])))			\
+    INVOKE_INTERFACE_1 (code, &current_block[entry_point]);		\
+} while (0)
+
+#define DLINK_INTERRUPT_CHECK(code, entry_point) do			\
+{									\
+  if (((long) Rhp) >= ((long) (Rrb[REGBLOCK_MEMTOP])))			\
+    INVOKE_INTERFACE_2 (code, &current_block[entry_point], Rdl);	\
+} while (0)
+
 #define CLOSURE_HEADER(offset) do					\
 {									\
-  SCHEME_OBJECT * entry = ((SCHEME_OBJECT *) my_pc[1]);			\
+  SCHEME_OBJECT * entry = ((SCHEME_OBJECT *) Rpc[1]);			\
   current_block = (entry - offset);					\
-  *--stack_pointer = (MAKE_POINTER_OBJECT (TC_COMPILED_ENTRY, my_pc));	\
+  *--Rsp = (MAKE_POINTER_OBJECT (TC_COMPILED_ENTRY, Rpc));		\
 } while (0)
 
 #define CLOSURE_INTERRUPT_CHECK(code) do				\
 {									\
-  if (((long) free_pointer)						\
-      >= ((long) (register_block[REGBLOCK_MEMTOP])))			\
+  if (((long) Rhp) >= ((long) (Rrb[REGBLOCK_MEMTOP])))			\
     INVOKE_INTERFACE_0 (code);						\
 } while (0)
+
+/* Linking and initialization */
 
-#define INTERRUPT_CHECK(code, entry_point) do				\
+#define DECLARE_SUBCODE(name, nentries, decl_code, code) do		\
 {									\
-  if (((long) free_pointer)						\
-      >= ((long) (register_block[REGBLOCK_MEMTOP])))			\
-    INVOKE_INTERFACE_1 (code, &current_block[entry_point]);		\
+  int result = (declare_compiled_code (name, nentries,			\
+				       decl_code, code));		\
+									\
+  if (result != 0)							\
+    return (result);							\
 } while (0)
 
-#define DLINK_INTERRUPT_CHECK(code, entry_point) do			\
+#define DECLARE_SUBDATA(name, decl_data, data) do			\
 {									\
-  if (((long) free_pointer)						\
-      >= ((long) (register_block[REGBLOCK_MEMTOP])))			\
-    INVOKE_INTERFACE_2 (code, &current_block[entry_point],		\
-			dynamic_link);					\
+  int result = (declare_compiled_data (name, decl_data, data));		\
+									\
+  if (result != 0)							\
+    return (result);							\
 } while (0)
 
-struct compiled_file
-{
-  int number_of_procedures;
-  char ** names;
-  void * EXFUN ((**procs), (void));
-};
+#ifndef COMPILE_FOR_DYNAMIC_LOADING
 
 /* This does nothing in the sources. */
 
-#ifndef COMPILE_FOR_DYNAMIC_LOADING
+# define DECLARE_COMPILED_CODE(name, nentries, decl_code, code)		\
+  extern int EXFUN (decl_code, (void));					\
+  extern SCHEME_OBJECT * EXFUN (code, (SCHEME_OBJECT *, unsigned long));
 
-# define DECLARE_COMPILED_CODE(string, decl, code)			\
-  extern void EXFUN (decl, (void));					\
-  extern SCHEME_OBJECT * EXFUN (code, (SCHEME_OBJECT *));
+# define DECLARE_COMPILED_DATA(name, decl_data, data)			\
+  extern int EXFUN (decl_data, (void));					\
+  extern SCHEME_OBJECT * EXFUN (data, (unsigned long));
+
+# define DECLARE_DYNAMIC_INITIALIZATION()
 
 #else /* COMPILE_FOR_DYNAMIC_LOADING */
 
-# define DECLARE_COMPILED_CODE(string, decl, code)			\
-  extern void EXFUN (dload_initialize_file, (void));			\
+# define DECLARE_COMPILED_CODE(name, nentries, decl_code, code)		\
+  static int								\
+  DEFUN_VOID (dload_initialize_code)					\
+  {									\
+    int EXFUN (decl_code, (void));					\
+    SCHEME_OBJECT * EXFUN (code, (SCHEME_OBJECT *, unsigned long));	\
 									\
-  void									\
-  DEFUN_VOID (dload_initialize_file)					\
+    return (declare_compiled_code (name, nentries,			\
+				   decl_code, code));			\
+  }
+
+# define DECLARE_COMPILED_DATA(name, decl_data, data)			\
+  static int								\
+  DEFUN_VOID (dload_initialize_data)					\
   {									\
-    void EXFUN (decl, (void));						\
-    SCHEME_OBJECT * EXFUN (code, (SCHEME_OBJECT *));			\
+    int EXFUN (decl_data, (void));					\
+    SCHEME_OBJECT * EXFUN (data, (unsigned long));			\
+									\
+    return (declare_compiled_data (name, decl_data, data));		\
+  }
+
+# define DECLARE_DYNAMIC_INITIALIZATION()				\
+  extern int EXFUN (dload_initialize_file, (void));			\
 									\
-    declare_compiled_code (string, decl, code);				\
+  int									\
+  DEFUN_VOID (dload_initialize_file)					\
+  {									\
+    int result = (dload_initialize_code ());				\
+    if (result != 0)							\
+      return (result);							\
+    return (dload_initialize_data ());					\
   }
 
 #endif /* COMPILE_FOR_DYNAMIC_LOADING */
@@ -422,20 +394,21 @@ struct compiled_file
 extern RCONSM_TYPE(rconsm);
 
 extern int
+  EXFUN (multiply_with_overflow, (long, long, long *)),
   EXFUN (declare_compiled_code,
 	 (char *,
-	  void EXFUN ((*), (void)),
-	  SCHEME_OBJECT * EXFUN ((*), (SCHEME_OBJECT *)))),
-  EXFUN (multiply_with_overflow, (long, long, long *));
+	  unsigned long,
+	  int EXFUN ((*), (void)),
+	  SCHEME_OBJECT * EXFUN ((*), (SCHEME_OBJECT *, unsigned long)))),
+  EXFUN (declare_compiled_data,
+	 (char *,
+	  int EXFUN ((*), (void)),
+	  SCHEME_OBJECT * EXFUN ((*), (unsigned long)))),
+  EXFUN (NO_SUBBLOCKS, (void));
 
 extern SCHEME_OBJECT
   EXFUN (initialize_subblock, (char *)),
-   * EXFUN (invoke_utility, (int, long, long, long, long));
-
-extern void
-  EXFUN (NO_SUBBLOCKS, (void)),
-  EXFUN (lose_big, (char *)),
-  EXFUN (error_band_already_built, (void));
+  * EXFUN (invoke_utility, (int, long, long, long, long));
 
 extern double
   EXFUN (acos, (double)),
diff --git a/v7/src/microcode/unxutl/ymkfile b/v7/src/microcode/unxutl/ymkfile
index e7aa224e0..55628622f 100644
--- a/v7/src/microcode/unxutl/ymkfile
+++ b/v7/src/microcode/unxutl/ymkfile
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: ymkfile,v 1.81 1993/10/27 20:40:36 gjr Exp $
+$Id: ymkfile,v 1.82 1993/10/30 03:01:57 gjr Exp $
 
 Copyright (c) 1989-1993 Massachusetts Institute of Technology
 
@@ -285,6 +285,8 @@ compinit.h : $(COMPILED_SOURCES) liarc.tch xmkfile
 	rm -f $@
 	fgrep DECLARE_COMPILED_CODE liarc.tch $(COMPILED_SOURCES) | \
 	sed -e 's/.*:/  /' -e 's/)/);/' > $@
+	fgrep DECLARE_COMPILED_DATA liarc.tch $(COMPILED_SOURCES) | \
+	sed -e 's/.*:/  /' -e 's/)/);/' >> $@
 
 foo $(COMPILED_OBJECTS) : liarc.tch
 liarc.tch: liarc.h $(LIARC_HEAD_FILES)
diff --git a/v8/src/microcode/cmpint.c b/v8/src/microcode/cmpint.c
index cb7be4dca..16f2d8138 100644
--- a/v8/src/microcode/cmpint.c
+++ b/v8/src/microcode/cmpint.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: cmpint.c,v 1.73 1993/10/26 02:57:43 gjr Exp $
+$Id: cmpint.c,v 1.74 1993/10/30 03:04:27 gjr Exp $
 
 Copyright (c) 1989-1993 Massachusetts Institute of Technology
 
@@ -133,7 +133,8 @@ typedef instruction * utility_result;
 extern void EXFUN (C_to_interface, (void *));
 extern utility_result interface_to_C_hook;
 
-static long C_return_value;
+extern long C_return_value;
+long C_return_value;
 
 /* Convenience macros */
 
@@ -3041,6 +3042,10 @@ utility_table_entry utility_table[] =
   UTE(comutil_compiled_code_bkpt),		/* 0x3c */
   UTE(comutil_compiled_closure_bkpt)		/* 0x3d */
   };
+
+extern long MAX_TRAMPOLINE;
+long MAX_TRAMPOLINE = ((sizeof (utility_table))
+		       / (sizeof (utility_table_entry)));
 
 /* Support for trap handling. */
 
diff --git a/v8/src/microcode/liarc.h b/v8/src/microcode/liarc.h
index 7651537e0..5d07ac54a 100644
--- a/v8/src/microcode/liarc.h
+++ b/v8/src/microcode/liarc.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: liarc.h,v 1.6 1993/10/28 04:45:25 gjr Exp $
+$Id: liarc.h,v 1.7 1993/10/30 03:02:05 gjr Exp $
 
 Copyright (c) 1992-1993 Massachusetts Institute of Technology
 
@@ -76,8 +76,6 @@ union machine_word_u
 
 typedef union machine_word_u machine_word;
 
-#define ERROR_UNKNOWN_DISPATCH( pc ) lose_big ("Unknown tag.")
-
 #define ADDRESS_UNITS_PER_OBJECT	(sizeof (SCHEME_OBJECT))
 #define ADDRESS_UNITS_PER_FLOAT		(sizeof (double))
 
@@ -113,9 +111,9 @@ typedef union machine_word_u machine_word;
   double num = (src);							\
   SCHEME_OBJECT * val;							\
 									\
-  ALIGN_FLOAT (free_pointer);						\
-  val = free_pointer;							\
-  free_pointer += (1 + (BYTES_TO_WORDS (sizeof (double))));		\
+  ALIGN_FLOAT (Rhp);							\
+  val = Rhp;								\
+  Rhp += (1 + (BYTES_TO_WORDS (sizeof (double))));			\
   * val = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR,				\
 			(BYTES_TO_WORDS (sizeof (double)))));		\
   (* ((double *) (val + 1))) = num;					\
@@ -134,10 +132,10 @@ typedef union machine_word_u machine_word;
 
 #ifdef USE_GLOBAL_VARIABLES
 
-#define value_reg Val
-#define free_pointer Free
-#define register_block Regs
-#define stack_pointer Stack_Pointer
+#define Rvl Val
+#define Rhp Free
+#define Rrb Regs
+#define Rsp Stack_Pointer
 
 #define DECLARE_VARIABLES() int unsed_variable_to_keep_C_happy
 #define UNCACHE_VARIABLES() do {} while (0)
@@ -147,110 +145,47 @@ typedef union machine_word_u machine_word;
 
 #define REGISTER register
 
-#define register_block Regs
+#define Rrb Regs
 
 #define DECLARE_VARIABLES()						\
-REGISTER SCHEME_OBJECT value_reg = Val;					\
-REGISTER SCHEME_OBJECT * free_pointer = Free;				\
-REGISTER SCHEME_OBJECT * stack_pointer = Stack_Pointer
+REGISTER SCHEME_OBJECT Rvl = Val;					\
+REGISTER SCHEME_OBJECT * Rhp = Free;					\
+REGISTER SCHEME_OBJECT * Rsp = Stack_Pointer
 
 #define UNCACHE_VARIABLES() do						\
 {									\
-  Stack_Pointer = stack_pointer;					\
-  Free = free_pointer;							\
-  Val = value_reg;							\
+  Stack_Pointer = Rsp;							\
+  Free = Rhp;								\
+  Val = Rvl;								\
 } while (0)
 
 #define CACHE_VARIABLES() do						\
 {									\
-  value_reg = Val;							\
-  free_pointer = Free;							\
-  stack_pointer = Stack_Pointer;					\
+  Rvl = Val;								\
+  Rhp = Free;								\
+  Rsp = Stack_Pointer;							\
 } while (0)
 
 #endif /* USE_GLOBAL_VARIABLES */
 
-#define REPEAT_DISPATCH() do						\
-{									\
-  if ((LABEL_PROCEDURE (my_pc)) != current_C_proc)			\
-  {									\
-    UNCACHE_VARIABLES ();						\
-    return (my_pc);							\
-  }									\
-  /* fall through. */							\
-} while (0)
-
-#ifdef USE_SHORTCKT_JUMP
-
 #define JUMP(destination) do						\
 {									\
-  my_pc = (destination);						\
-  goto repeat_dispatch;							\
+  Rpc = (destination);							\
+  goto perform_dispatch;						\
 } while(0)
 
-#define JUMP_EXTERNAL(destination) do					\
-{									\
-  my_pc = (destination);						\
-  if ((LABEL_PROCEDURE (my_pc)) == current_C_proc)			\
-  {									\
-    CACHE_VARIABLES ();							\
-    goto perform_dispatch;						\
-  }									\
-  return (my_pc);							\
-} while (0)
-
-#define JUMP_EXECUTE_CHACHE(entry) do					\
-{									\
-  my_pc = ((SCHEME_OBJECT *) current_block[entry]);			\
-  goto repeat_dispatch;							\
-} while (0)
-
-#define POP_RETURN() goto pop_return_repeat_dispatch
-
-#define POP_RETURN_REPEAT_DISPATCH() do					\
-{									\
-  my_pc = (OBJECT_ADDRESS (*stack_pointer++));				\
-  /* fall through to repeat_dispatch */					\
-} while (0)
-
-#else /* not USE_SHORTCKT_JUMP */
-
-#define JUMP(destination) do						\
-{									\
-  UNCACHE_VARIABLES ();							\
-  return (destination);							\
-} while (0)
-
-#define JUMP_EXTERNAL(destination) return (destination)
-
-#define JUMP_EXECUTE_CHACHE(entry) do					\
-{									\
-  SCHEME_OBJECT* destination						\
-    = ((SCHEME_OBJECT *) current_block[entry]);				\
-									\
-  JUMP (destination);							\
-} while (0)
+#define JUMP_EXECUTE_CHACHE(label)					\
+  JUMP ((SCHEME_OBJECT *) (current_block[label]))
 
-#define POP_RETURN() do							\
-{									\
-    SCHEME_OBJECT target = *stack_pointer++;				\
-    SCHEME_OBJECT destination = (OBJECT_ADDRESS (target));		\
-    JUMP (destination);							\
-} while (0)
+#define POP_RETURN() goto pop_return
 
-#define POP_RETURN_REPEAT_DISPATCH() do					\
-{									\
-} while (0)
-
-#endif /* USE_SHORTCKT_JUMP */
-
 #define INVOKE_PRIMITIVE(prim, nargs) do				\
 {									\
   primitive = (prim);							\
   primitive_nargs = (nargs);						\
   goto invoke_primitive;						\
 } while (0)
-
+
 #define INVOKE_PRIMITIVE_CODE() do					\
 {									\
   SCHEME_OBJECT * destination;						\
@@ -259,7 +194,8 @@ REGISTER SCHEME_OBJECT * stack_pointer = Stack_Pointer
   PRIMITIVE_APPLY (Val, primitive);					\
   POP_PRIMITIVE_FRAME (primitive_nargs);				\
   destination = (OBJECT_ADDRESS (STACK_POP ()));			\
-  JUMP_EXTERNAL (destination);						\
+  CACHE_VARIABLES ();							\
+  JUMP (destination);							\
 } while(0)
 
 #define INVOKE_INTERFACE_CODE() do					\
@@ -267,48 +203,49 @@ REGISTER SCHEME_OBJECT * stack_pointer = Stack_Pointer
   SCHEME_OBJECT * destination;						\
 									\
   UNCACHE_VARIABLES ();							\
-  destination = (invoke_utility (subtmp_code, subtmp_1, subtmp_2,	\
-				 subtmp_3, subtmp_4));			\
-  JUMP_EXTERNAL (destination);						\
+  destination = (invoke_utility (utlarg_code, utlarg_1, utlarg_2,	\
+				 utlarg_3, utlarg_4));			\
+  CACHE_VARIABLES ();							\
+  JUMP (destination);							\
 } while (0)
 
 #define INVOKE_INTERFACE_4(code, one, two, three, four) do		\
 {									\
-  subtmp_4 = ((long) (four));						\
-  subtmp_3 = ((long) (three));						\
-  subtmp_2 = ((long) (two));						\
-  subtmp_1 = ((long) (one));						\
-  subtmp_code = (code);							\
+  utlarg_4 = ((long) (four));						\
+  utlarg_3 = ((long) (three));						\
+  utlarg_2 = ((long) (two));						\
+  utlarg_1 = ((long) (one));						\
+  utlarg_code = (code);							\
   goto invoke_interface_4;						\
 } while (0)
 
 #define INVOKE_INTERFACE_3(code, one, two, three) do			\
 {									\
-  subtmp_3 = ((long) (three));						\
-  subtmp_2 = ((long) (two));						\
-  subtmp_1 = ((long) (one));						\
-  subtmp_code = (code);							\
+  utlarg_3 = ((long) (three));						\
+  utlarg_2 = ((long) (two));						\
+  utlarg_1 = ((long) (one));						\
+  utlarg_code = (code);							\
   goto invoke_interface_3;						\
 } while (0)
 
 #define INVOKE_INTERFACE_2(code, one, two) do				\
 {									\
-  subtmp_2 = ((long) (two));						\
-  subtmp_1 = ((long) (one));						\
-  subtmp_code = (code);							\
+  utlarg_2 = ((long) (two));						\
+  utlarg_1 = ((long) (one));						\
+  utlarg_code = (code);							\
   goto invoke_interface_2;						\
 } while (0)
 
 #define INVOKE_INTERFACE_1(code, one) do				\
 {									\
-  subtmp_1 = ((long) (one));						\
-  subtmp_code = (code);							\
+  utlarg_1 = ((long) (one));						\
+  utlarg_code = (code);							\
   goto invoke_interface_1;						\
 } while (0)
 
 #define INVOKE_INTERFACE_0(code) do					\
 {									\
-  subtmp_code = (code);							\
+  utlarg_code = (code);							\
   goto invoke_interface_0;						\
 } while (0)
 
@@ -352,63 +289,98 @@ REGISTER SCHEME_OBJECT * stack_pointer = Stack_Pointer
  : (((source1) >= 0)							\
     ? (- ((source1) / (- (source2))))					\
     : ((- (source1)) / (- (source2)))))
-
+
+#define INTERRUPT_CHECK(code, entry_point) do				\
+{									\
+  if (((long) Rhp) >= ((long) (Rrb[REGBLOCK_MEMTOP])))			\
+    INVOKE_INTERFACE_1 (code, &current_block[entry_point]);		\
+} while (0)
+
+#define DLINK_INTERRUPT_CHECK(code, entry_point) do			\
+{									\
+  if (((long) Rhp) >= ((long) (Rrb[REGBLOCK_MEMTOP])))			\
+    INVOKE_INTERFACE_2 (code, &current_block[entry_point], Rdl);	\
+} while (0)
+
 #define CLOSURE_HEADER(offset) do					\
 {									\
-  SCHEME_OBJECT * entry = ((SCHEME_OBJECT *) my_pc[1]);			\
+  SCHEME_OBJECT * entry = ((SCHEME_OBJECT *) Rpc[1]);			\
   current_block = (entry - offset);					\
-  *--stack_pointer = (MAKE_POINTER_OBJECT (TC_COMPILED_ENTRY, my_pc));	\
+  *--Rsp = (MAKE_POINTER_OBJECT (TC_COMPILED_ENTRY, Rpc));		\
 } while (0)
 
 #define CLOSURE_INTERRUPT_CHECK(code) do				\
 {									\
-  if (((long) free_pointer)						\
-      >= ((long) (register_block[REGBLOCK_MEMTOP])))			\
+  if (((long) Rhp) >= ((long) (Rrb[REGBLOCK_MEMTOP])))			\
     INVOKE_INTERFACE_0 (code);						\
 } while (0)
+
+/* Linking and initialization */
 
-#define INTERRUPT_CHECK(code, entry_point) do				\
+#define DECLARE_SUBCODE(name, nentries, decl_code, code) do		\
 {									\
-  if (((long) free_pointer)						\
-      >= ((long) (register_block[REGBLOCK_MEMTOP])))			\
-    INVOKE_INTERFACE_1 (code, &current_block[entry_point]);		\
+  int result = (declare_compiled_code (name, nentries,			\
+				       decl_code, code));		\
+									\
+  if (result != 0)							\
+    return (result);							\
 } while (0)
 
-#define DLINK_INTERRUPT_CHECK(code, entry_point) do			\
+#define DECLARE_SUBDATA(name, decl_data, data) do			\
 {									\
-  if (((long) free_pointer)						\
-      >= ((long) (register_block[REGBLOCK_MEMTOP])))			\
-    INVOKE_INTERFACE_2 (code, &current_block[entry_point],		\
-			dynamic_link);					\
+  int result = (declare_compiled_data (name, decl_data, data));		\
+									\
+  if (result != 0)							\
+    return (result);							\
 } while (0)
 
-struct compiled_file
-{
-  int number_of_procedures;
-  char ** names;
-  void * EXFUN ((**procs), (void));
-};
+#ifndef COMPILE_FOR_DYNAMIC_LOADING
 
 /* This does nothing in the sources. */
 
-#ifndef COMPILE_FOR_DYNAMIC_LOADING
+# define DECLARE_COMPILED_CODE(name, nentries, decl_code, code)		\
+  extern int EXFUN (decl_code, (void));					\
+  extern SCHEME_OBJECT * EXFUN (code, (SCHEME_OBJECT *, unsigned long));
 
-# define DECLARE_COMPILED_CODE(string, decl, code)			\
-  extern void EXFUN (decl, (void));					\
-  extern SCHEME_OBJECT * EXFUN (code, (SCHEME_OBJECT *));
+# define DECLARE_COMPILED_DATA(name, decl_data, data)			\
+  extern int EXFUN (decl_data, (void));					\
+  extern SCHEME_OBJECT * EXFUN (data, (unsigned long));
+
+# define DECLARE_DYNAMIC_INITIALIZATION()
 
 #else /* COMPILE_FOR_DYNAMIC_LOADING */
 
-# define DECLARE_COMPILED_CODE(string, decl, code)			\
-  extern void EXFUN (dload_initialize_file, (void));			\
+# define DECLARE_COMPILED_CODE(name, nentries, decl_code, code)		\
+  static int								\
+  DEFUN_VOID (dload_initialize_code)					\
+  {									\
+    int EXFUN (decl_code, (void));					\
+    SCHEME_OBJECT * EXFUN (code, (SCHEME_OBJECT *, unsigned long));	\
 									\
-  void									\
-  DEFUN_VOID (dload_initialize_file)					\
+    return (declare_compiled_code (name, nentries,			\
+				   decl_code, code));			\
+  }
+
+# define DECLARE_COMPILED_DATA(name, decl_data, data)			\
+  static int								\
+  DEFUN_VOID (dload_initialize_data)					\
   {									\
-    void EXFUN (decl, (void));						\
-    SCHEME_OBJECT * EXFUN (code, (SCHEME_OBJECT *));			\
+    int EXFUN (decl_data, (void));					\
+    SCHEME_OBJECT * EXFUN (data, (unsigned long));			\
+									\
+    return (declare_compiled_data (name, decl_data, data));		\
+  }
+
+# define DECLARE_DYNAMIC_INITIALIZATION()				\
+  extern int EXFUN (dload_initialize_file, (void));			\
 									\
-    declare_compiled_code (string, decl, code);				\
+  int									\
+  DEFUN_VOID (dload_initialize_file)					\
+  {									\
+    int result = (dload_initialize_code ());				\
+    if (result != 0)							\
+      return (result);							\
+    return (dload_initialize_data ());					\
   }
 
 #endif /* COMPILE_FOR_DYNAMIC_LOADING */
@@ -422,20 +394,21 @@ struct compiled_file
 extern RCONSM_TYPE(rconsm);
 
 extern int
+  EXFUN (multiply_with_overflow, (long, long, long *)),
   EXFUN (declare_compiled_code,
 	 (char *,
-	  void EXFUN ((*), (void)),
-	  SCHEME_OBJECT * EXFUN ((*), (SCHEME_OBJECT *)))),
-  EXFUN (multiply_with_overflow, (long, long, long *));
+	  unsigned long,
+	  int EXFUN ((*), (void)),
+	  SCHEME_OBJECT * EXFUN ((*), (SCHEME_OBJECT *, unsigned long)))),
+  EXFUN (declare_compiled_data,
+	 (char *,
+	  int EXFUN ((*), (void)),
+	  SCHEME_OBJECT * EXFUN ((*), (unsigned long)))),
+  EXFUN (NO_SUBBLOCKS, (void));
 
 extern SCHEME_OBJECT
   EXFUN (initialize_subblock, (char *)),
-   * EXFUN (invoke_utility, (int, long, long, long, long));
-
-extern void
-  EXFUN (NO_SUBBLOCKS, (void)),
-  EXFUN (lose_big, (char *)),
-  EXFUN (error_band_already_built, (void));
+  * EXFUN (invoke_utility, (int, long, long, long, long));
 
 extern double
   EXFUN (acos, (double)),