From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 12 Feb 2008 19:09:44 +0000 (+0000)
Subject: Fix bug: setup_compiled_invocation_from_primitive wasn't calling
X-Git-Tag: 20090517-FFI~328
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=bcc5d025eb000b47aa39e235bf09d699d635d5c0;p=mit-scheme.git

Fix bug: setup_compiled_invocation_from_primitive wasn't calling
PRIMITIVE_ABORT when it should have been.
---

diff --git a/v7/src/microcode/cmpint.c b/v7/src/microcode/cmpint.c
index 1d15ea1b2..050065301 100644
--- a/v7/src/microcode/cmpint.c
+++ b/v7/src/microcode/cmpint.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: cmpint.c,v 1.114 2008/02/12 00:16:57 riastradh Exp $
+$Id: cmpint.c,v 1.115 2008/02/12 19:09:44 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -142,7 +142,7 @@ static SCHEME_OBJECT make_compiler_utilities (void);
 static void open_stack_gap (unsigned long, unsigned long);
 static void close_stack_gap (unsigned long, unsigned long);
 static void recover_from_apply_error (SCHEME_OBJECT, unsigned long);
-static bool setup_compiled_invocation_from_primitive 
+static void setup_compiled_invocation_from_primitive 
   (SCHEME_OBJECT, unsigned long);
 static long link_remaining_sections (link_cc_state_t *);
 static void start_linking_cc_block (void);
@@ -545,30 +545,30 @@ compiled_with_interrupt_mask (unsigned long old_mask,
   STACK_PUSH (ULONG_TO_FIXNUM (old_mask));
   PUSH_REFLECTION (REFLECT_CODE_RESTORE_INTERRUPT_MASK);
   STACK_PUSH (ULONG_TO_FIXNUM (new_mask));
-  if (setup_compiled_invocation_from_primitive (receiver, 1))
-    /* Pun: receiver is being invoked as a return address.  */
-    STACK_PUSH (receiver);
+  setup_compiled_invocation_from_primitive (receiver, 1);
+  /* Pun: receiver is being invoked as a return address.  */
+  STACK_PUSH (receiver);
 }
 
 void
 compiled_with_stack_marker (SCHEME_OBJECT thunk)
 {
   PUSH_REFLECTION (REFLECT_CODE_STACK_MARKER);
-  if (setup_compiled_invocation_from_primitive (thunk, 0))
-    /* Pun: thunk is being invoked as a return address.  */
-    STACK_PUSH (thunk);
+  setup_compiled_invocation_from_primitive (thunk, 0);
+  /* Pun: thunk is being invoked as a return address.  */
+  STACK_PUSH (thunk);
 }
 
-static bool
+static void
 setup_compiled_invocation_from_primitive (SCHEME_OBJECT procedure,
 					  unsigned long n_args)
 {
   long code = (setup_compiled_invocation (procedure, n_args));
   if (code == PRIM_DONE)
-    return (true);
-  else if (code != PRIM_APPLY_INTERRUPT)
+    return;
+  if (code != PRIM_APPLY_INTERRUPT)
     PUSH_REFLECTION (REFLECT_CODE_INTERNAL_APPLY);
-  return (false);
+  PRIMITIVE_ABORT (code);
 }
 
 /* SCHEME_UTILITY procedures
@@ -1402,8 +1402,7 @@ DEFINE_SCHEME_ENTRY (comp_error_restart)
 }
 
 void
-apply_compiled_from_primitive (unsigned long n_args,
-			       SCHEME_OBJECT procedure)
+apply_compiled_from_primitive (unsigned long n_args, SCHEME_OBJECT procedure)
 {
   while ((OBJECT_TYPE (procedure)) == TC_ENTITY)
     {