From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 17 May 2003 20:56:57 +0000 (+0000)
Subject: Eliminate use of returned structure in compiled-code interface.  This
X-Git-Tag: 20090517-FFI~1901
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b8c65147c55255ba5b6cee0d74cc227d085ca8c8;p=mit-scheme.git

Eliminate use of returned structure in compiled-code interface.  This
has historically been a source of much trouble, and for little gain.
Instead, pass the structure pointer as an argument.
---

diff --git a/v7/src/microcode/cmpauxmd/i386.m4 b/v7/src/microcode/cmpauxmd/i386.m4
index 20cd480f9..1c8d03e9c 100644
--- a/v7/src/microcode/cmpauxmd/i386.m4
+++ b/v7/src/microcode/cmpauxmd/i386.m4
@@ -1,8 +1,9 @@
 ### -*-Midas-*-
 ###
-### $Id: i386.m4,v 1.61 2003/02/14 18:28:25 cph Exp $
+### $Id: i386.m4,v 1.62 2003/05/17 20:55:45 cph Exp $
 ###
-### Copyright (c) 1992-2002 Massachusetts Institute of Technology
+### Copyright 1992,1997,1998,2000,2001 Massachusetts Institute of Technology
+### Copyright 2002,2003 Massachusetts Institute of Technology
 ###
 ### This file is part of MIT/GNU Scheme.
 ###
@@ -98,38 +99,15 @@
 ###
 ### WIN32
 ###	If defined, expand to run under Win32; implies DASM.
-### OS2
-###	If defined, expand to run under OS/2.  This macro does nothing
-###	more than define SUPPRESS_LEADING_UNDERSCORE and
-###	CALLER_ALLOCS_STRUCT_RETURN, which are the conventions used to
-###	call OS/2 API procedures; note that EMX/GCC doesn't define
-###	these symbols because it thinks it's running under unix.
-###
-### If none of { WIN32, OS2 } is defined, expansion is for unix.
 ###
 ### SUPPRESS_LEADING_UNDERSCORE
 ###	If defined, external symbol names are generated as written;
 ###	otherwise, they have an underscore prepended to them.
-### CALLER_ALLOCS_STRUCT_RETURN
-### STATIC_STRUCT_RETURN
-###	Controls the conventions used to return 8-byte structs from C
-###	procedures.  If CALLER_ALLOCS_STRUCT_RETURN is defined, the
-###	caller allocates space on the stack and passes a pointer to
-###	that space on the top of the stack.  If STATIC_STRUCT_RETURN
-###	is defined, the callee returns a pointer to a static struct in
-###	EAX.  Otherwise, the callee returns the struct in EAX/EDX.
-### CALLEE_POPS_STRUCT_RETURN
-###	Modifies the CALLER_ALLOCS_STRUCT_RETURN calling convention.
-###	Under the modified convention, the callee pops the pointer to
-###	the allocated space, so the caller doesn't have to.  This
-###	convention is used by GCC 2.9.x.
 ### WCC386
 ###	Should be defined when using Watcom assembler.
 ### WCC386R
 ###	Should be defined when using Watcom assembler and generating
 ###	code to use the Watcom register-based argument conventions.
-### LINUX_ELF
-###	If defined, expand to run under Linux ELF.
 ### TYPE_CODE_LENGTH
 ###	Normally defined to be 6.  Don't change this unless you know
 ###	what you're doing.
@@ -144,14 +122,6 @@ ifdef(`WIN32',
       `define(IF_WIN32,`$1')',
       `define(IF_WIN32,`')')
 
-ifdef(`OS2',
-      `define(IFOS2,`$1')',
-      `define(IFOS2,`')')
-
-ifdef(`LINUX_ELF',
-      `define(IF_LINUX_ELF,`$1')',
-      `define(IF_LINUX_ELF,`')')
-
 ifdef(`DISABLE_387',
       `define(IF387,`')',
       `define(IF387,`$1')')
@@ -191,14 +161,9 @@ IFNDASM(`define(popad,`popa')')
 IFNDASM(`define(pushfd,`pushf')')
 IFNDASM(`define(popfd,`popf')')
 
-IFOS2(`define(`SUPPRESS_LEADING_UNDERSCORE',1)')
-IF_LINUX_ELF(`define(`SUPPRESS_LEADING_UNDERSCORE',1)')
-
-ifdef(`WCC386R',
-      `define(EVR,`_$1')',
-      `ifdef(`SUPPRESS_LEADING_UNDERSCORE',
-	     `define(EVR,`$1')',
-	     `define(EVR,`_$1')')')
+ifdef(`SUPPRESS_LEADING_UNDERSCORE',
+       `define(EVR,`$1')',
+       `define(EVR,`_$1')')
 
 # When using the Watcom C compiler with register-based calling
 # conventions, source-code function names normally expand to `FOO_',
@@ -386,11 +351,6 @@ allocate_longword(C_Stack_Pointer)
 define_data(C_Frame_Pointer)
 allocate_longword(C_Frame_Pointer)
 
-IFOS2(`define(CALLER_ALLOCS_STRUCT_RETURN,1)')
-IF_LINUX_ELF(`define(CALLER_ALLOCS_STRUCT_RETURN,1)')
-
-IF_WIN32(`ifdef(`WCC386', `define(`STATIC_STRUCT_RETURN',1)')')
-
 define_data(ia32_cpuid_supported)
 allocate_longword(ia32_cpuid_supported)
 
@@ -578,20 +538,16 @@ scheme_to_interface_proceed:
 	OP(mov,l)	TW(EVR(C_Stack_Pointer),REG(esp))
 	OP(mov,l)	TW(EVR(C_Frame_Pointer),REG(ebp))
 
-ifdef(`CALLER_ALLOCS_STRUCT_RETURN',`
-	OP(sub,l)	TW(IMM(8),REG(esp))	# alloc space for struct return
-')
-	OP(push,l)	LOF(REGBLOCK_UTILITY_ARG4(),regs) # Utility args
+	OP(sub,l)	TW(IMM(8),REG(esp))	# alloc struct return
 
+	OP(push,l)	LOF(REGBLOCK_UTILITY_ARG4(),regs) # push utility args
 	OP(push,l)	REG(ebx)
 	OP(push,l)	REG(edx)
 	OP(push,l)	REG(ecx)
 
-ifdef(`CALLER_ALLOCS_STRUCT_RETURN',`
-	OP(mov,l)	TW(REG(esp),REG(ecx))	# push pointer to struct return
+	OP(mov,l)	TW(REG(esp),REG(ecx))	# push ptr to struct return
 	OP(add,l)	TW(IMM(16),REG(ecx))
 	OP(push,l)	REG(ecx)
-')
 
 	OP(xor,l)	TW(REG(ecx),REG(ecx))
 	OP(mov,b)	TW(REG(al),REG(cl))
@@ -599,22 +555,10 @@ ifdef(`CALLER_ALLOCS_STRUCT_RETURN',`
 	call		IJMP(REG(eax))
 
 define_debugging_label(scheme_to_interface_return)
-ifdef(`CALLER_ALLOCS_STRUCT_RETURN',`
-ifdef(`CALLEE_POPS_STRUCT_RETURN',`',`
-	OP(add,l)	TW(IMM(4),REG(esp))	# pop pointer to struct return
-')')
-	OP(add,l)	TW(IMM(16),REG(esp))		# Pop utility args
-
-ifdef(`STATIC_STRUCT_RETURN',`
-	OP(mov,l)	TW(LOF(4,REG(eax)),REG(edx))
-	OP(mov,l)	TW(IND(REG(eax)),REG(eax))
-')
-
-ifdef(`CALLER_ALLOCS_STRUCT_RETURN',`
-	OP(pop,l)	REG(eax)	# Pop struct return into registers
+	OP(add,l)	TW(IMM(20),REG(esp))	# pop utility args
+	OP(pop,l)	REG(eax)		# pop struct return
 	OP(pop,l)	REG(edx)
-')
-	jmp		IJMP(REG(eax))			# Invoke handler
+	jmp		IJMP(REG(eax))		# Invoke handler
 
 define_c_label(interface_to_scheme)
 IF387(`
diff --git a/v7/src/microcode/cmpint.c b/v7/src/microcode/cmpint.c
index 7e657b425..50525077f 100644
--- a/v7/src/microcode/cmpint.c
+++ b/v7/src/microcode/cmpint.c
@@ -1,8 +1,9 @@
 /* -*-C-*-
 
-$Id: cmpint.c,v 1.100 2003/02/14 18:28:18 cph Exp $
+$Id: cmpint.c,v 1.101 2003/05/17 20:55:31 cph Exp $
 
-Copyright (c) 1989-2002 Massachusetts Institute of Technology
+Copyright 1989,1990,1991,1992,1993,1994 Massachusetts Institute of Technology
+Copyright 1995,1996,2000,2001,2002,2003 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -99,7 +100,7 @@ USA.
 
 #ifdef HAS_COMPILER_SUPPORT
 
-/* ASM_ENTRY_POINT, EXFNX, and DEFNX are for OS/2.  The IBM C Set++/2
+/* ASM_ENTRY_POINT and EXFNX are for OS/2.  The IBM C Set++/2
    compiler has several different external calling conventions.  The
    default calling convention is called _Optlink, uses a combination
    of registers and the stack, and is complicated.  The calling
@@ -122,132 +123,183 @@ USA.
 #  define ASM_ENTRY_POINT(name) name
 #endif
 
-#ifdef STDC_HEADERS
-#define EXFNX(name, proto) ASM_ENTRY_POINT (name) proto
-#define DEFNX(name, arglist, args) ASM_ENTRY_POINT (name) (args)
-#define DEFNX_VOID(name) ASM_ENTRY_POINT (name) (void)
-#else
-#define EXFNX(name, proto) ASM_ENTRY_POINT (name) ()
-#define DEFNX(name, arglist, args) ASM_ENTRY_POINT (name) arglist args;
-#define DEFNX_VOID(name) ASM_ENTRY_POINT (name) ()
-#endif
+#define EXFNX(name, proto) EXFUN (ASM_ENTRY_POINT (name), proto)
 
 /* Make noise words invisible to the C compiler. */
 
 #define C_UTILITY
 #define C_TO_SCHEME
-#define SCHEME_UTILITY
+
+#define DEFINE_SCHEME_UTILITY_0(pname)					\
+void									\
+DEFUN (ASM_ENTRY_POINT (pname),						\
+       (DSU_result, ignore1, ignore2, ignore3, ignore4),		\
+       utility_result * DSU_result					\
+       AND long ignore1							\
+       AND long ignore2							\
+       AND long ignore3							\
+       AND long ignore4)
+
+#define DEFINE_SCHEME_UTILITY_1(pname, av1)				\
+void									\
+DEFUN (ASM_ENTRY_POINT (pname),						\
+       (DSU_result, av1, ignore2, ignore3, ignore4),			\
+       utility_result * DSU_result					\
+       AND long av1							\
+       AND long ignore2							\
+       AND long ignore3							\
+       AND long ignore4)
+
+#define DEFINE_SCHEME_UTILITY_2(pname, av1, av2)			\
+void									\
+DEFUN (ASM_ENTRY_POINT (pname),						\
+       (DSU_result, av1, av2, ignore3, ignore4),			\
+       utility_result * DSU_result					\
+       AND long av1							\
+       AND long av2							\
+       AND long ignore3							\
+       AND long ignore4)
+
+#define DEFINE_SCHEME_UTILITY_3(pname, av1, av2, av3)			\
+void									\
+DEFUN (ASM_ENTRY_POINT (pname),						\
+       (DSU_result, av1, av2, av3, ignore4),				\
+       utility_result * DSU_result					\
+       AND long av1							\
+       AND long av2							\
+       AND long av3							\
+       AND long ignore4)
+
+#define DEFINE_SCHEME_UTILITY_4(pname, av1, av2, av3, av4)		\
+void									\
+DEFUN (ASM_ENTRY_POINT (pname),						\
+       (DSU_result, av1, av2, av3, av4),				\
+       utility_result * DSU_result					\
+       AND long av1							\
+       AND long av2							\
+       AND long av3							\
+       AND long av4)
 
 /* For clarity */
 
 typedef char instruction;
+
+#ifdef CMPINT_USE_STRUCS
+
+#ifdef C_FUNC_PTR_IS_CLOSURE
+#  define REFENTRY(name) (name)
+#  define VARENTRY(name) instruction * name
+#  define EXTENTRY(name) extern instruction * name
+#else
+#  define REFENTRY(name) ((void EXFUN ((*), (void))) name)
+#  define VARENTRY(name) void EXFUN ((*name), (void))
+#  define EXTENTRY(name) extern void EXFNX (name, (void))
+#endif
 
-#ifndef CMPINT_USE_STRUCS
+/* Structure returned by SCHEME_UTILITYs */
 
-typedef instruction * utility_result;
+typedef struct
+{
+  VARENTRY (interface_dispatch);
+  union additional_info
+    {
+      long code_to_interpreter;
+      instruction * entry_point;
+    } extra;
+} utility_result;
 
 /* Imports from assembly language */
 
-extern void EXFNX (C_to_interface, (void *));
-extern utility_result interface_to_C_hook;
+extern long EXFNX (C_to_interface, (PTR));
 
-extern long C_return_value;
-long C_return_value;
+EXTENTRY (interface_to_C);
+EXTENTRY (interface_to_scheme);
 
 /* Convenience macros */
 
 #define RETURN_TO_C(code) do						\
 {									\
-  C_return_value = (code);						\
-  return (interface_to_C_hook);						\
-} while (false)
-
-#define RETURN_TO_SCHEME(ep)	return ((utility_result) (ep))
+  (DSU_result -> interface_dispatch) = (REFENTRY (interface_to_C));	\
+  ((DSU_result -> extra) . code_to_interpreter) = (code);		\
+  return;								\
+} while (0)
 
-#define ENTER_SCHEME(ep) do						\
+#define RETURN_TO_SCHEME(ep) do						\
 {									\
-  C_to_interface ((void *) (ep));					\
-  return (C_return_value);						\
-} while (false)
-
-#else /* CMPINT_USE_STRUCS */
-
-#ifdef C_FUNC_PTR_IS_CLOSURE
-#  define REFENTRY(name) (name)
-#  define VARENTRY(name) instruction *name
-#  define EXTENTRY(name) extern instruction *name
-#else
-#  define REFENTRY(name) ((void (*)()) name)
-#  define VARENTRY(name) void (*name)()
-#  define EXTENTRY(name) extern void EXFNX (name, (void))
-#endif
+  (DSU_result -> interface_dispatch)					\
+    = (REFENTRY (interface_to_scheme));					\
+  ((DSU_result -> extra) . entry_point)					\
+    = ((instruction *) (ep));						\
+  return;								\
+} while (0)
 
-/* Structure returned by SCHEME_UTILITYs */
+#define ENTER_SCHEME(ep) return (C_to_interface ((PTR) (ep)))
 
-struct utility_result_s
-{
-  VARENTRY (interface_dispatch);
-  union additional_info
-  {
-    long                code_to_interpreter;
-    instruction        *entry_point;
-  } extra;
-};
+#else /* CMPINT_USE_STRUCS */
 
-typedef struct utility_result_s utility_result;
+typedef instruction * utility_result;
 
 /* Imports from assembly language */
 
-extern long EXFNX (C_to_interface, (void *));
+extern void EXFNX (C_to_interface, (PTR));
+extern utility_result interface_to_C_hook;
 
-EXTENTRY (interface_to_C);
-EXTENTRY (interface_to_scheme);
+extern long C_return_value;
+long C_return_value;
 
 /* Convenience macros */
 
 #define RETURN_TO_C(code) do						\
 {									\
-  struct utility_result_s temp;						\
-									\
-  temp.interface_dispatch = (REFENTRY (interface_to_C));		\
-  temp.extra.code_to_interpreter = (code);				\
-									\
-  return (temp);							\
-} while (false)
+  (*DSU_result) = interface_to_C_hook;					\
+  C_return_value = (code);						\
+  return;								\
+} while (0)
 
 #define RETURN_TO_SCHEME(ep) do						\
 {									\
-  struct utility_result_s temp;						\
-									\
-  temp.interface_dispatch = (REFENTRY (interface_to_scheme));		\
-  temp.extra.entry_point = ((instruction *) (ep));			\
-									\
-  return (temp);							\
-} while (false)
+  (*DSU_result) = (ep);							\
+  return;								\
+} while (0)
 
-#define ENTER_SCHEME(ep)	return (C_to_interface ((void *) (ep)))
+#define ENTER_SCHEME(ep) do						\
+{									\
+  C_to_interface ((PTR) (ep));						\
+  return (C_return_value);						\
+} while (0)
 
-#endif /* CMPINT_USE_STRUCS */
+#endif /* not CMPINT_USE_STRUCS */
 
 /* utility table entries. */
 
-typedef utility_result EXFUN
-  ((*ASM_ENTRY_POINT(utility_table_entry)), (long, long, long, long));
+typedef void EXFUN
+  ((* (ASM_ENTRY_POINT (utility_table_entry))),
+   (utility_result *, long, long, long, long));
 
-#define RETURN_UNLESS_EXCEPTION(code, entry_point)                      \
-{                                                                       \
-  int return_code;                                                      \
-                                                                        \
-  return_code = (code);                                                 \
-  if (return_code == PRIM_DONE)                                         \
-  {                                                                     \
-    RETURN_TO_SCHEME (entry_point);                                     \
-  }                                                                     \
-  else                                                                  \
-  {                                                                     \
-    RETURN_TO_C (return_code);                                          \
-  }                                                                     \
-}
+#define RETURN_UNLESS_EXCEPTION(code, entry_point) do			\
+{									\
+  int return_code = (code);						\
+  if (return_code == PRIM_DONE)						\
+    {									\
+      RETURN_TO_SCHEME (entry_point);					\
+    }									\
+  else									\
+    {									\
+      RETURN_TO_C (return_code);					\
+    }									\
+} while (0)
+
+#define TAIL_CALL_1(pname, a1) do					\
+{									\
+  pname (DSU_result, (a1), 0, 0, 0);					\
+  return;								\
+} while (0)
+
+#define TAIL_CALL_2(pname, a1, a2) do					\
+{									\
+  pname (DSU_result, (a1), (a2), 0, 0);					\
+  return;								\
+} while (0)
 
 #define MAKE_CC_BLOCK(block_addr)					\
   (MAKE_POINTER_OBJECT (TC_COMPILED_CODE_BLOCK, block_addr))
@@ -777,11 +829,7 @@ DEFUN (compiled_with_stack_marker, (thunk), SCHEME_OBJECT thunk)
   trampoline storage block (empty) to it.
  */
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_return_to_interpreter,
-       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR tramp_data_raw
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_return_to_interpreter, tramp_data_raw)
 {
   RETURN_TO_C (PRIM_DONE);
 }
@@ -793,14 +841,20 @@ DEFNX (comutil_return_to_interpreter,
 
 #else /* COMPILER_IA32_TYPE */
 
-static utility_result
-  EXFUN (compiler_interrupt_common, (SCHEME_ADDR, SCHEME_OBJECT));
+static void EXFUN
+  (compiler_interrupt_common, (utility_result *, SCHEME_ADDR, SCHEME_OBJECT));
+
+#define COMPILER_INTERRUPT_COMMON(a1, a2) do				\
+{									\
+  compiler_interrupt_common (DSU_result, (a1), (a2));			\
+  return;								\
+} while (0)
 
 #define INVOKE_RETURN_ADDRESS() do					\
 {									\
   if (((long) (ADDR_TO_SCHEME_ADDR (Free)))				\
       >= ((long) (Registers[REGBLOCK_MEMTOP])))				\
-    return (compiler_interrupt_common (0, val_register));		\
+    COMPILER_INTERRUPT_COMMON (0, val_register);			\
   else									\
     RETURN_TO_SCHEME (OBJECT_ADDRESS (STACK_POP ()));			\
 } while (0)
@@ -818,11 +872,7 @@ static utility_result
   of the stack.
  */
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_primitive_apply,
-       (primitive, ignore_2, ignore_3, ignore_4),
-       SCHEME_OBJECT primitive
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_primitive_apply, primitive)
 { 
   PRIMITIVE_APPLY (val_register, primitive);
   POP_PRIMITIVE_FRAME (PRIMITIVE_ARITY (primitive));
@@ -837,11 +887,7 @@ DEFNX (comutil_primitive_apply,
   of the register block.
  */
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_primitive_lexpr_apply,
-       (primitive, ignore_2, ignore_3, ignore_4),
-       SCHEME_OBJECT primitive
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_primitive_lexpr_apply, primitive)
 {
   PRIMITIVE_APPLY (val_register, primitive);
   POP_PRIMITIVE_FRAME (((long) (Registers[REGBLOCK_LEXPR_ACTUALS])));
@@ -854,12 +900,7 @@ DEFNX (comutil_primitive_lexpr_apply,
   expects the procedure to invoke, and the number of arguments (+ 1).
  */
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_apply,
-       (procedure, nactuals, ignore_3, ignore_4),
-       SCHEME_OBJECT procedure
-       AND unsigned long nactuals
-       AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_2 (comutil_apply, procedure, nactuals)
 {
   SCHEME_OBJECT orig_proc = procedure;
 
@@ -921,7 +962,7 @@ loop:
 
       arity = (PRIMITIVE_ARITY (procedure));
       if (arity == ((long) (nactuals - 1)))
-        return (comutil_primitive_apply (procedure, 0, 0, 0));
+	TAIL_CALL_1 (comutil_primitive_apply, procedure);
 
       if (arity != LEXPR)
       {
@@ -936,7 +977,7 @@ loop:
 
       /* "Lexpr" primitive. */
       (Registers[REGBLOCK_LEXPR_ACTUALS]) = ((SCHEME_OBJECT) (nactuals - 1));
-      return (comutil_primitive_lexpr_apply (procedure, 0, 0, 0));
+      TAIL_CALL_1 (comutil_primitive_lexpr_apply, procedure);
     }
 
     callee_is_interpreted:
@@ -955,16 +996,10 @@ loop:
   stack, and is passed the number of arguments (+ 1).
 */
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_error,
-       (nactuals, ignore_2, ignore_3, ignore_4),
-       long nactuals AND
-       long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_error, nactuals)
 {
-  SCHEME_OBJECT error_procedure;
-
-  error_procedure = (Get_Fixed_Obj_Slot (Compiler_Err_Procedure));
-  return (comutil_apply (error_procedure, nactuals, 0, 0));
+  TAIL_CALL_2
+    (comutil_apply, (Get_Fixed_Obj_Slot (Compiler_Err_Procedure)), nactuals);
 }
 
 /*
@@ -977,11 +1012,7 @@ DEFNX (comutil_error,
   number of arguments (the compiler checked it), and will not check.
  */
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_lexpr_apply,
-       (entry_address_raw, nactuals, ignore_3, ignore_4),
-       SCHEME_ADDR entry_address_raw AND long nactuals
-       AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_2 (comutil_lexpr_apply, entry_address_raw, nactuals)
 {
   instruction * entry_address
     = ((instruction *) (SCHEME_ADDR_TO_ADDR (entry_address_raw)));
@@ -1226,13 +1257,8 @@ exit_proc:
   processing is done.
 */
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_link,
-       (ret_add_raw, block_address_raw, constant_address_raw, sections),
-       SCHEME_ADDR ret_add_raw
-       AND SCHEME_ADDR block_address_raw
-       AND SCHEME_ADDR constant_address_raw
-       AND long sections)
+DEFINE_SCHEME_UTILITY_4 (comutil_link, ret_add_raw, block_address_raw,
+			 constant_address_raw, sections)
 {
   instruction * ret_add
     = ((instruction *) (SCHEME_ADDR_TO_ADDR (ret_add_raw)));
@@ -1317,96 +1343,50 @@ DEFUN_VOID (comp_link_caches_restart)
    with.
 */
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_operator_apply_trap,
-       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR tramp_data_raw
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_operator_apply_trap, tramp_data_raw)
 {
-  SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
-
   /* Used by coerce_to_compiled.  TRAMPOLINE_K_APPLY */
-
-  return (comutil_apply ((tramp_data[0]),
-			 (OBJECT_DATUM (tramp_data[1])),
-			 0, 0));
+  SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
+  TAIL_CALL_2 (comutil_apply, (tramp_data[0]), (OBJECT_DATUM (tramp_data[1])));
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_operator_arity_trap,
-       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR tramp_data_raw
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_operator_arity_trap, tramp_data_raw)
 {
-  SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
-
   /* Linker saw an argument count mismatch. TRAMPOLINE_K_ARITY */
-
-  return (comutil_apply ((tramp_data[0]),
-			 (OBJECT_DATUM (tramp_data[1])),
-			 0, 0));
+  SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
+  TAIL_CALL_2 (comutil_apply, (tramp_data[0]), (OBJECT_DATUM (tramp_data[1])));
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_operator_entity_trap,
-       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR tramp_data_raw
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_operator_entity_trap, tramp_data_raw)
 {
-  SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
-
   /* Linker saw an entity to be applied. TRAMPOLINE_K_ENTITY */
-
-  return (comutil_apply ((tramp_data[0]),
-			 (OBJECT_DATUM (tramp_data[1])),
-			 0, 0));
+  SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
+  TAIL_CALL_2 (comutil_apply, (tramp_data[0]), (OBJECT_DATUM (tramp_data[1])));
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_operator_interpreted_trap,
-       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR tramp_data_raw
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_operator_interpreted_trap, tramp_data_raw)
 {
-  SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
-
   /* Linker saw an interpreted procedure or a procedure that it cannot
-     link directly.  TRAMPOLINE_K_INTERPRETED
-   */
-
-  return (comutil_apply ((tramp_data[0]),
-			 (OBJECT_DATUM (tramp_data[1])),
-			 0, 0));
+     link directly.  TRAMPOLINE_K_INTERPRETED */
+  SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
+  TAIL_CALL_2 (comutil_apply, (tramp_data[0]), (OBJECT_DATUM (tramp_data[1])));
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_operator_lexpr_trap,
-       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR tramp_data_raw
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_operator_lexpr_trap, tramp_data_raw)
 {
-  SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
-
   /* Linker saw a primitive of arbitrary number of arguments.
-     TRAMPOLINE_K_LEXPR_PRIMITIVE
-   */
-
+     TRAMPOLINE_K_LEXPR_PRIMITIVE */
+  SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
   (Registers[REGBLOCK_LEXPR_ACTUALS]) =
     ((SCHEME_OBJECT) ((OBJECT_DATUM (tramp_data[1])) - 1));
-  return (comutil_primitive_lexpr_apply ((tramp_data[0]), 0, 0, 0));
+  TAIL_CALL_1 (comutil_primitive_lexpr_apply, (tramp_data[0]));
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_operator_primitive_trap,
-       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR tramp_data_raw
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_operator_primitive_trap, tramp_data_raw)
 {
-  SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
-
   /* Linker saw a primitive of fixed matching arity. TRAMPOLINE_K_PRIMITIVE */
-
-  return (comutil_primitive_apply ((tramp_data[0]), 0, 0, 0));
+  SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
+  TAIL_CALL_1 (comutil_primitive_apply, (tramp_data[0]));
 }
 
 /* The linker either couldn't find a binding or the binding was
@@ -1421,13 +1401,7 @@ DEFNX (comutil_operator_primitive_trap,
    tramp_data contains extension, code_block, offset.  TRAMPOLINE_K_LOOKUP
 */
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_operator_lookup_trap,
-       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR tramp_data_raw AND
-       long ignore_2 AND
-       long ignore_3 AND
-       long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_operator_lookup_trap, tramp_data_raw)
 {
   SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
   SCHEME_OBJECT cache = (tramp_data[0]);
@@ -1441,7 +1415,7 @@ DEFNX (comutil_operator_lookup_trap,
 
   EXTRACT_EXECUTE_CACHE_ARITY (nargs, cache_cell);
   if (code == PRIM_DONE)
-    return (comutil_apply (true_operator, nargs, 0, 0));
+    TAIL_CALL_2 (comutil_apply, true_operator, nargs);
   /* Error or interrupt */
   {
     SCHEME_OBJECT trampoline;
@@ -1495,11 +1469,7 @@ DEFUN_VOID (comp_op_lookup_trap_restart)
    Scheme stack.
  */
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_operator_1_0_trap,
-       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR tramp_data_raw
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_operator_1_0_trap, tramp_data_raw)
 {
   SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
 
@@ -1507,11 +1477,7 @@ DEFNX (comutil_operator_1_0_trap,
   RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_operator_2_1_trap,
-       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR tramp_data_raw
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_operator_2_1_trap, tramp_data_raw)
 {
   SCHEME_OBJECT Top;
   SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
@@ -1522,11 +1488,7 @@ DEFNX (comutil_operator_2_1_trap,
   RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_operator_2_0_trap,
-       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR tramp_data_raw
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_operator_2_0_trap, tramp_data_raw)
 {
   SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
 
@@ -1535,11 +1497,7 @@ DEFNX (comutil_operator_2_0_trap,
   RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_operator_3_2_trap,
-       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR tramp_data_raw
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_operator_3_2_trap, tramp_data_raw)
 {
   SCHEME_OBJECT Top, Next;
   SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
@@ -1552,11 +1510,7 @@ DEFNX (comutil_operator_3_2_trap,
   RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_operator_3_1_trap,
-       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR tramp_data_raw
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_operator_3_1_trap, tramp_data_raw)
 {
   SCHEME_OBJECT Top;
   SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
@@ -1568,11 +1522,7 @@ DEFNX (comutil_operator_3_1_trap,
   RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_operator_3_0_trap,
-       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR tramp_data_raw
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_operator_3_0_trap, tramp_data_raw)
 {
   SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
 
@@ -1582,11 +1532,7 @@ DEFNX (comutil_operator_3_0_trap,
   RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_operator_4_3_trap,
-       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR tramp_data_raw
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_operator_4_3_trap, tramp_data_raw)
 {
   SCHEME_OBJECT Top, Middle, Bottom;
   SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
@@ -1602,11 +1548,7 @@ DEFNX (comutil_operator_4_3_trap,
   RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_operator_4_2_trap,
-       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR tramp_data_raw
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_operator_4_2_trap, tramp_data_raw)
 {
   SCHEME_OBJECT Top, Next;
   SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
@@ -1620,11 +1562,7 @@ DEFNX (comutil_operator_4_2_trap,
   RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_operator_4_1_trap,
-       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR tramp_data_raw
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_operator_4_1_trap, tramp_data_raw)
 {
   SCHEME_OBJECT Top;
   SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
@@ -1637,14 +1575,9 @@ DEFNX (comutil_operator_4_1_trap,
   RETURN_TO_SCHEME (OBJECT_ADDRESS (tramp_data[0]));
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_operator_4_0_trap,
-       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR tramp_data_raw
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_operator_4_0_trap, tramp_data_raw)
 {
   SCHEME_OBJECT * tramp_data = (SCHEME_ADDR_TO_ADDR (tramp_data_raw));
-
   STACK_PUSH (UNASSIGNED_OBJECT);
   STACK_PUSH (UNASSIGNED_OBJECT);
   STACK_PUSH (UNASSIGNED_OBJECT);
@@ -1675,18 +1608,19 @@ DEFNX (comutil_operator_4_0_trap,
     REQUEST_INTERRUPT (INT_Stack_Overflow);				\
 }
 
-static utility_result
-DEFUN (compiler_interrupt_common, (entry_point_raw, state),
-       SCHEME_ADDR entry_point_raw AND
-       SCHEME_OBJECT state)
+static void
+DEFUN (compiler_interrupt_common, (DSU_result, entry_point_raw, state),
+       utility_result * DSU_result
+       AND SCHEME_ADDR entry_point_raw
+       AND SCHEME_OBJECT state)
 {
   MAYBE_REQUEST_INTERRUPTS ();
   if (entry_point_raw != ((SCHEME_ADDR) 0))
-  {
-    instruction * entry_point
-      = ((instruction *) (SCHEME_ADDR_TO_ADDR (entry_point_raw)));
-    STACK_PUSH (ENTRY_TO_OBJECT (entry_point));
-  }
+    {
+      instruction * entry_point
+	= ((instruction *) (SCHEME_ADDR_TO_ADDR (entry_point_raw)));
+      STACK_PUSH (ENTRY_TO_OBJECT (entry_point));
+    }
   STACK_PUSH (state);
   exp_register = SHARP_F;
   Store_Return (RC_COMP_INTERRUPT_RESTART);
@@ -1694,76 +1628,41 @@ DEFUN (compiler_interrupt_common, (entry_point_raw, state),
   RETURN_TO_C (PRIM_INTERRUPT);
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_interrupt_closure, (ignore_1, ignore_2, ignore_3, ignore_4),
-       long ignore_1 AND
-       long ignore_2 AND
-       long ignore_3 AND
-       long ignore_4)
+DEFINE_SCHEME_UTILITY_0 (comutil_interrupt_closure)
 {
-  return (compiler_interrupt_common (0, SHARP_F));
+  COMPILER_INTERRUPT_COMMON (0, SHARP_F);
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_interrupt_dlink,
-       (entry_point_raw, dlink_raw, ignore_3, ignore_4),
-       SCHEME_ADDR entry_point_raw AND
-       SCHEME_ADDR dlink_raw AND
-       long ignore_3 AND
-       long ignore_4)
+DEFINE_SCHEME_UTILITY_2 (comutil_interrupt_dlink, entry_point_raw, dlink_raw)
 {
   SCHEME_OBJECT * dlink = (SCHEME_ADDR_TO_ADDR (dlink_raw));
-  return
-    (compiler_interrupt_common
-     (entry_point_raw, (MAKE_POINTER_OBJECT (TC_STACK_ENVIRONMENT, dlink))));
+  COMPILER_INTERRUPT_COMMON
+    (((PTR) entry_point_raw),
+     (MAKE_POINTER_OBJECT (TC_STACK_ENVIRONMENT, dlink)));
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_interrupt_procedure,
-       (entry_point_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR entry_point_raw AND
-       long ignore_2 AND
-       long ignore_3 AND
-       long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_interrupt_procedure, entry_point_raw)
 {
-  return (compiler_interrupt_common (entry_point_raw, SHARP_F));
+  COMPILER_INTERRUPT_COMMON (((PTR) entry_point_raw), SHARP_F);
 }
 
 /* val_register has live data, and there is no entry address on the stack */
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_interrupt_continuation,
-       (return_address_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR return_address_raw AND
-       long ignore_2 AND
-       long ignore_3 AND
-       long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_interrupt_continuation, return_address_raw)
 {
-  return (compiler_interrupt_common (return_address_raw, val_register));
+  COMPILER_INTERRUPT_COMMON (((PTR) return_address_raw), val_register);
 }
 
 /* env_register has live data; no entry point on the stack */
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_interrupt_ic_procedure,
-       (entry_point_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR entry_point_raw AND
-       long ignore_2 AND
-       long ignore_3 AND
-       long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_interrupt_ic_procedure, entry_point_raw)
 {
-  return (compiler_interrupt_common (entry_point_raw, env_register));
+  COMPILER_INTERRUPT_COMMON (((PTR) entry_point_raw), env_register);
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_interrupt_continuation_2,
-       (ignore_1, ignore_2, ignore_3, ignore_4),
-       long ignore_1 AND
-       long ignore_2 AND
-       long ignore_3 AND
-       long ignore_4)
+DEFINE_SCHEME_UTILITY_0 (comutil_interrupt_continuation_2)
 {
-  return (compiler_interrupt_common (0, val_register));
+  COMPILER_INTERRUPT_COMMON (0, val_register);
 }
 
 C_TO_SCHEME long
@@ -1779,13 +1678,8 @@ DEFUN_VOID (comp_interrupt_restart)
 
 /* Assigning a variable that has a trap in it (except unassigned) */
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_assignment_trap,
-       (return_address_raw, cache_addr_raw, value, ignore_4),
-       SCHEME_ADDR return_address_raw AND
-       SCHEME_ADDR cache_addr_raw AND
-       SCHEME_OBJECT value AND
-       long ignore_4)
+DEFINE_SCHEME_UTILITY_3 (comutil_assignment_trap,
+			 return_address_raw, cache_addr_raw, value)
 {
   instruction * return_address
     = ((instruction *) (SCHEME_ADDR_TO_ADDR (return_address_raw)));
@@ -1832,13 +1726,8 @@ DEFUN_VOID (comp_assignment_trap_restart)
     }
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_cache_lookup_apply,
-       (cache_addr_raw, block_address_raw, nactuals, ignore_4),
-       SCHEME_ADDR cache_addr_raw AND
-       SCHEME_ADDR block_address_raw AND
-       long nactuals AND
-       long ignore_4)
+DEFINE_SCHEME_UTILITY_3 (comutil_cache_lookup_apply,
+			 cache_addr_raw, block_address_raw, nactuals)
 {
   SCHEME_OBJECT cache
     = (MAKE_POINTER_OBJECT
@@ -1846,7 +1735,7 @@ DEFNX (comutil_cache_lookup_apply,
   SCHEME_OBJECT value;
   long code = (compiler_lookup_trap (cache, (&value)));
   if (code == PRIM_DONE)
-    return (comutil_apply (value, nactuals, 0, 0));
+    TAIL_CALL_2 (comutil_apply, value, nactuals);
   {
     SCHEME_OBJECT block
       = (MAKE_CC_BLOCK (SCHEME_ADDR_TO_ADDR (block_address_raw)));
@@ -1894,13 +1783,7 @@ DEFUN_VOID (comp_cache_lookup_apply_restart)
    fluid or an error (unassigned / unbound).  */
 
 #define CMPLR_REF_TRAP(name, c_trap, ret_code, restart, c_lookup)	\
-SCHEME_UTILITY utility_result						\
-DEFNX (name,								\
-       (return_address_raw, cache_addr_raw, ignore_3, ignore_4),	\
-       SCHEME_ADDR return_address_raw AND				\
-       SCHEME_ADDR cache_addr_raw AND					\
-       long ignore_3 AND						\
-       long ignore_4)							\
+DEFINE_SCHEME_UTILITY_2 (name, return_address_raw, cache_addr_raw)	\
 {									\
   instruction * return_address						\
     = ((instruction *) (SCHEME_ADDR_TO_ADDR (return_address_raw)));	\
@@ -1972,16 +1855,10 @@ CMPLR_REF_TRAP(comutil_unassigned_p_trap,
  */
 
 #define COMPILER_ARITH_PRIM(name, fobj_index, arity)			\
-SCHEME_UTILITY utility_result						\
-DEFNX (name,								\
-       (ignore_1, ignore_2, ignore_3, ignore_4),			\
-       long ignore_1 AND long ignore_2					\
-       AND long ignore_3 AND long ignore_4)				\
+DEFINE_SCHEME_UTILITY_0 (name)						\
 {									\
-  SCHEME_OBJECT handler;						\
-									\
-  handler = (Get_Fixed_Obj_Slot (fobj_index));				\
-  return (comutil_apply (handler, (arity), 0, 0));			\
+  TAIL_CALL_2								\
+    (comutil_apply, (Get_Fixed_Obj_Slot (fobj_index)), (arity));	\
 }
 
 COMPILER_ARITH_PRIM (comutil_decrement, GENERIC_TRAMPOLINE_PREDECESSOR, 2)
@@ -2009,32 +1886,25 @@ COMPILER_ARITH_PRIM (comutil_zero, GENERIC_TRAMPOLINE_ZERO_P, 2)
 */
 
 #define CMPLR_REFERENCE(util_name, c_proc, ret_code, restart_name)	\
-SCHEME_UTILITY utility_result						\
-DEFNX (util_name,							\
-       (ret_add_raw, environment, variable, ignore_4),			\
-       SCHEME_ADDR ret_add_raw						\
-       AND SCHEME_OBJECT environment AND SCHEME_OBJECT variable		\
-       AND long ignore_4)						\
+DEFINE_SCHEME_UTILITY_3 (util_name, ret_add_raw, environment, variable)	\
 {									\
   instruction * ret_add							\
     = ((instruction *) (SCHEME_ADDR_TO_ADDR (ret_add_raw)));		\
-  long code;								\
-									\
-  code = (c_proc (environment, variable, (&val_register)));		\
+  long code = (c_proc (environment, variable, (&val_register)));	\
   if (code == PRIM_DONE)						\
-  {									\
-    RETURN_TO_SCHEME (ret_add);						\
-  }									\
+    {									\
+      RETURN_TO_SCHEME (ret_add);					\
+    }									\
   else									\
-  {									\
-    STACK_PUSH (ENTRY_TO_OBJECT (ret_add));				\
-    STACK_PUSH (variable);						\
-    STACK_PUSH (environment);						\
-    exp_register = SHARP_F;						\
-    Store_Return (ret_code);						\
-    Save_Cont ();							\
-    RETURN_TO_C (code);							\
-  }									\
+    {									\
+      STACK_PUSH (ENTRY_TO_OBJECT (ret_add));				\
+      STACK_PUSH (variable);						\
+      STACK_PUSH (environment);						\
+      exp_register = SHARP_F;						\
+      Store_Return (ret_code);						\
+      Save_Cont ();							\
+      RETURN_TO_C (code);						\
+    }									\
 }									\
 									\
 C_TO_SCHEME long							\
@@ -2063,32 +1933,25 @@ DEFUN_VOID (restart_name)						\
 }
 
 #define CMPLR_ASSIGNMENT(util_name, c_proc, ret_code, restart_name)	\
-SCHEME_UTILITY utility_result						\
-DEFNX (util_name,							\
-       (ret_add_raw, environment, variable, value),			\
-       SCHEME_ADDR ret_add_raw						\
-       AND SCHEME_OBJECT environment					\
-       AND SCHEME_OBJECT variable					\
-       AND SCHEME_OBJECT value)						\
+DEFINE_SCHEME_UTILITY_4 (util_name,					\
+			 ret_add_raw, environment, variable, value)	\
 {									\
   instruction * ret_add							\
     = ((instruction *) (SCHEME_ADDR_TO_ADDR (ret_add_raw)));		\
-  long code;								\
-									\
-  code = (c_proc (environment, variable, value));			\
+  long code = (c_proc (environment, variable, value));			\
   if (code == PRIM_DONE)						\
     RETURN_TO_SCHEME (ret_add);						\
   else									\
-  {									\
-    STACK_PUSH (ENTRY_TO_OBJECT (ret_add));				\
-    STACK_PUSH (value);							\
-    STACK_PUSH (variable);						\
-    STACK_PUSH (environment);						\
-    exp_register = SHARP_F;						\
-    Store_Return (ret_code);						\
-    Save_Cont ();							\
-    RETURN_TO_C (code);							\
-  }									\
+    {									\
+      STACK_PUSH (ENTRY_TO_OBJECT (ret_add));				\
+      STACK_PUSH (value);						\
+      STACK_PUSH (variable);						\
+      STACK_PUSH (environment);						\
+      exp_register = SHARP_F;						\
+      Store_Return (ret_code);						\
+      Save_Cont ();							\
+      RETURN_TO_C (code);						\
+    }									\
 }									\
 									\
 C_TO_SCHEME long							\
@@ -2170,15 +2033,11 @@ CMPLR_ASSIGNMENT(comutil_definition,
 		 RC_COMP_DEFINITION_RESTART,
 		 comp_definition_restart)
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_lookup_apply,
-       (environment, variable, nactuals, ignore_4),
-       SCHEME_OBJECT environment AND SCHEME_OBJECT variable
-       AND long nactuals AND long ignore_4)
+DEFINE_SCHEME_UTILITY_3 (comutil_lookup_apply, environment, variable, nactuals)
 {
   long code = (lookup_variable (environment, variable, (&val_register)));
   if (code == PRIM_DONE)
-    return (comutil_apply (val_register, nactuals, 0, 0));
+    TAIL_CALL_2 (comutil_apply, val_register, nactuals);
   {
     STACK_PUSH (LONG_TO_UNSIGNED_FIXNUM (nactuals));
     STACK_PUSH (variable);
@@ -2218,12 +2077,7 @@ DEFUN_VOID (comp_lookup_apply_restart)
     }
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_primitive_error,
-       (ret_add_raw, primitive, ignore_3, ignore_4),
-       SCHEME_ADDR ret_add_raw
-       AND SCHEME_OBJECT primitive
-       AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_2 (comutil_primitive_error, ret_add_raw, primitive)
 {
   instruction * ret_add =
     ((instruction *) (SCHEME_ADDR_TO_ADDR (ret_add_raw)));
@@ -2919,11 +2773,8 @@ DEFUN (bkpt_proceed, (ep, handle, state),
 }
 #endif /* HAVE_BKPT_SUPPORT */
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_compiled_code_bkpt,
-       (entry_point_raw, state_raw, ignore_3, ignore_4),
-       SCHEME_ADDR entry_point_raw AND SCHEME_ADDR state_raw
-       AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_2 (comutil_compiled_code_bkpt,
+			 entry_point_raw, state_raw)
 {
   long type_info[3];
   instruction * entry_point_a
@@ -2945,10 +2796,10 @@ DEFNX (comutil_compiled_code_bkpt,
 
   compiled_entry_type (entry_point, &type_info[0]);
   if ((type_info[0] == KIND_OTHER) && (type_info[1] == OTHER_CLOSURE))
-  {
-    entry_point_a = ((instruction *) (SCHEME_ADDR_TO_ADDR (state_raw)));
-    state = (ENTRY_TO_OBJECT (entry_point_a));
-  }
+    {
+      entry_point_a = ((instruction *) (SCHEME_ADDR_TO_ADDR (state_raw)));
+      state = (ENTRY_TO_OBJECT (entry_point_a));
+    }
   else if (type_info[0] != KIND_CONTINUATION)
     state = SHARP_F;
   else if (type_info[1] == CONTINUATION_DYNAMIC_LINK)
@@ -2961,15 +2812,11 @@ DEFNX (comutil_compiled_code_bkpt,
   STACK_PUSH (state);		/* state to preserve */
   STACK_PUSH (stack_ptr);	/* "Environment" pointer */
   STACK_PUSH (entry_point);	/* argument to handler */
-  return (comutil_apply ((Get_Fixed_Obj_Slot (COMPILED_CODE_BKPT_HANDLER)),
-			 4, ignore_3, ignore_4));
+  TAIL_CALL_2
+    (comutil_apply, (Get_Fixed_Obj_Slot (COMPILED_CODE_BKPT_HANDLER)), 4);
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_compiled_closure_bkpt,
-       (entry_point_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR entry_point_raw
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_compiled_closure_bkpt, entry_point_raw)
 {
   instruction * entry_point_a
     = ((instruction *) (SCHEME_ADDR_TO_ADDR (entry_point_raw)));
@@ -2982,15 +2829,11 @@ DEFNX (comutil_compiled_closure_bkpt,
   STACK_PUSH (SHARP_F);		/* state to preserve */
   STACK_PUSH (stack_ptr);	/* "Environment" pointer */
   STACK_PUSH (entry_point);	/* argument to handler */
-  return (comutil_apply ((Get_Fixed_Obj_Slot (COMPILED_CODE_BKPT_HANDLER)),
-			 4, ignore_3, ignore_4));
+  TAIL_CALL_2
+    (comutil_apply, (Get_Fixed_Obj_Slot (COMPILED_CODE_BKPT_HANDLER)), 4);
 }
 
-SCHEME_UTILITY utility_result
-DEFNX (comutil_reflect_to_interface,
-       (tramp_data_raw, ignore_2, ignore_3, ignore_4),
-       SCHEME_ADDR tramp_data_raw
-       AND long ignore_2 AND long ignore_3 AND long ignore_4)
+DEFINE_SCHEME_UTILITY_1 (comutil_reflect_to_interface, tramp_data_raw)
 {
   SCHEME_OBJECT code = (STACK_POP ());
 
@@ -3000,8 +2843,7 @@ DEFNX (comutil_reflect_to_interface,
     {
       long frame_size = (OBJECT_DATUM (STACK_POP ()));
       SCHEME_OBJECT procedure = (STACK_POP ());
-      
-      return (comutil_apply (procedure, frame_size, ignore_3, ignore_4));
+      TAIL_CALL_2 (comutil_apply, procedure, frame_size);
     }
 
     case REFLECT_CODE_RESTORE_INTERRUPT_MASK:
@@ -3028,7 +2870,7 @@ DEFNX (comutil_reflect_to_interface,
       {
 	STACK_PUSH (FIXNUM_ZERO + REFLECT_CODE_CC_BKPT);
 	STACK_PUSH (reflect_to_interface);
-	return (compiler_interrupt_common (0, SHARP_F));
+	COMPILER_INTERRUPT_COMMON (0, SHARP_F);
       }
 
       if (do_bkpt_proceed (& value))
diff --git a/v7/src/microcode/configure.in b/v7/src/microcode/configure.in
index fa00a8bae..b6bb3aaee 100644
--- a/v7/src/microcode/configure.in
+++ b/v7/src/microcode/configure.in
@@ -19,7 +19,7 @@ dnl along with MIT/GNU Scheme; if not, write to the Free Software
 dnl Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 dnl 02111-1307, USA.
 
-AC_REVISION([$Id: configure.in,v 11.22 2003/05/17 02:21:09 cph Exp $])
+AC_REVISION([$Id: configure.in,v 11.23 2003/05/17 20:55:37 cph Exp $])
 AC_INIT(boot.c)
 AC_CONFIG_HEADER(config.h)
 
@@ -617,25 +617,7 @@ return 1;
 	[scheme_cv_linux_elf=no])
     AC_MSG_RESULT(${scheme_cv_linux_elf})
     if test "${scheme_cv_linux_elf}" = "yes"; then
-	M4_FLAGS="${M4_FLAGS} -P LINUX_ELF,1"
-    fi
-    if test "${GCC}" = "yes"; then
-	AC_MSG_CHECKING([for GCC version >= 2.95])
-	AC_TRY_RUN(
-[int
-main ()
-{
-#if ((__GNUC__ > 2) || ((__GNUC__ == 2) && (__GNUC_MINOR__ >= 95)))
-return 0;
-#endif
-return 1;
-}],
-	[scheme_cv_gcc3=yes],
-	[scheme_cv_gcc3=no])
-	AC_MSG_RESULT(${scheme_cv_gcc3})
-	if test "${scheme_cv_gcc3}" = "yes"; then
-	    M4_FLAGS="${M4_FLAGS} -P CALLEE_POPS_STRUCT_RETURN,1"
-	fi
+	M4_FLAGS="${M4_FLAGS} -P SUPPRESS_LEADING_UNDERSCORE,1"
     fi
 fi
 
diff --git a/v7/src/microcode/os2utl/makefile.gcc b/v7/src/microcode/os2utl/makefile.gcc
index 4188ee2d7..9caf24c1f 100644
--- a/v7/src/microcode/os2utl/makefile.gcc
+++ b/v7/src/microcode/os2utl/makefile.gcc
@@ -1,6 +1,6 @@
 ### -*- Fundamental -*-
 ###
-### $Id: makefile.gcc,v 1.9 2003/02/14 18:28:31 cph Exp $
+### $Id: makefile.gcc,v 1.10 2003/05/17 20:56:44 cph Exp $
 ###
 ### Copyright (c) 1995, 1999, 2000 Massachusetts Institute of Technology
 ###
@@ -39,7 +39,7 @@ CC = gcc -Uunix -U__unix__ -U__unix -D__GCC2__
 CFLAGS = $(GCCFLAGS) -DMIT_SCHEME
 LDFLAGS = $(GCCFLAGS)
 M4 = m4
-M4FLAGS = -DOS2
+M4FLAGS = -DSUPPRESS_LEADING_UNDERSCORE
 AS = as
 ASFLAGS = -I
 
diff --git a/v7/src/microcode/os2utl/makefile.vac b/v7/src/microcode/os2utl/makefile.vac
index bd0b5748a..4f9e7c4da 100644
--- a/v7/src/microcode/os2utl/makefile.vac
+++ b/v7/src/microcode/os2utl/makefile.vac
@@ -1,6 +1,6 @@
 ### -*- Fundamental -*-
 ###
-### $Id: makefile.vac,v 1.9 2003/02/14 18:28:31 cph Exp $
+### $Id: makefile.vac,v 1.10 2003/05/17 20:56:53 cph Exp $
 ###
 ### Copyright (c) 1994-2000 Massachusetts Institute of Technology
 ###
@@ -44,7 +44,7 @@ CC = icc
 CFLAGS = $(ICCFLAGS) /DMIT_SCHEME
 LDFLAGS = $(ICCFLAGS) /B"/EXEPACK"
 M4 = m4
-M4FLAGS = -DOS2
+M4FLAGS = -DSUPPRESS_LEADING_UNDERSCORE
 AS = as
 ASFLAGS = -Zomf
 
diff --git a/v7/src/microcode/os2utl/makefile.wcc b/v7/src/microcode/os2utl/makefile.wcc
index c05f2a1f0..11dbebde8 100644
--- a/v7/src/microcode/os2utl/makefile.wcc
+++ b/v7/src/microcode/os2utl/makefile.wcc
@@ -1,6 +1,6 @@
 ### -*- Fundamental -*-
 ###
-### $Id: makefile.wcc,v 1.10 2003/02/14 18:28:31 cph Exp $
+### $Id: makefile.wcc,v 1.11 2003/05/17 20:56:57 cph Exp $
 ###
 ### Copyright (c) 1994-2000 Massachusetts Institute of Technology
 ###
@@ -83,7 +83,7 @@ LDFLAGS := debug all option caseexact option quiet option symfile
 #		 * OS/2 _System calling convention.
 # -DDASM	Select Intel assembly language.
 # -DWCC386R	Select Watcom 386 register-based conventions.
-M4FLAGS = -DOS2 -DDASM -DWCC386R
+M4FLAGS = -DDASM -DWCC386R
 
 # Assembler options.
 #