From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 2 Jun 1994 19:13:16 +0000 (+0000)
Subject: Patch to fix long-standing bug in forcing of promises.
X-Git-Tag: 20090517-FFI~7166
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2686badd1e45b2076068ed04343d24d0a7864629;p=mit-scheme.git

Patch to fix long-standing bug in forcing of promises.
---

diff --git a/v7/src/microcode/interp.c b/v7/src/microcode/interp.c
index 6d5266db9..559c62281 100644
--- a/v7/src/microcode/interp.c
+++ b/v7/src/microcode/interp.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: interp.c,v 9.83 1994/06/02 19:03:31 cph Exp $
+$Id: interp.c,v 9.84 1994/06/02 19:13:16 cph Exp $
 
 Copyright (c) 1988-94 Massachusetts Institute of Technology
 
@@ -2242,12 +2242,14 @@ Primitive_Internal_Apply:
     case RC_SNAP_NEED_THUNK:
       /* Don't snap thunk twice; evaluation of the thunk's body might
 	 have snapped it already.  */
-      if ((MEMORY_REF ((Fetch_Expression ()), THUNK_SNAPPED)) == SHARP_F)
+      if ((MEMORY_REF ((Fetch_Expression ()), THUNK_SNAPPED)) == SHARP_T)
+	Val = (MEMORY_REF ((Fetch_Expression ()), THUNK_VALUE));
+      else
 	{
 	  MEMORY_SET ((Fetch_Expression ()), THUNK_SNAPPED, SHARP_T);
 	  MEMORY_SET ((Fetch_Expression ()), THUNK_VALUE, Val);
 	}
-      break;
+     break;
 
     case RC_AFTER_MEMORY_UPDATE:
     case RC_BAD_INTERRUPT_CONTINUE:
diff --git a/v8/src/microcode/interp.c b/v8/src/microcode/interp.c
index 6d5266db9..559c62281 100644
--- a/v8/src/microcode/interp.c
+++ b/v8/src/microcode/interp.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: interp.c,v 9.83 1994/06/02 19:03:31 cph Exp $
+$Id: interp.c,v 9.84 1994/06/02 19:13:16 cph Exp $
 
 Copyright (c) 1988-94 Massachusetts Institute of Technology
 
@@ -2242,12 +2242,14 @@ Primitive_Internal_Apply:
     case RC_SNAP_NEED_THUNK:
       /* Don't snap thunk twice; evaluation of the thunk's body might
 	 have snapped it already.  */
-      if ((MEMORY_REF ((Fetch_Expression ()), THUNK_SNAPPED)) == SHARP_F)
+      if ((MEMORY_REF ((Fetch_Expression ()), THUNK_SNAPPED)) == SHARP_T)
+	Val = (MEMORY_REF ((Fetch_Expression ()), THUNK_VALUE));
+      else
 	{
 	  MEMORY_SET ((Fetch_Expression ()), THUNK_SNAPPED, SHARP_T);
 	  MEMORY_SET ((Fetch_Expression ()), THUNK_VALUE, Val);
 	}
-      break;
+     break;
 
     case RC_AFTER_MEMORY_UPDATE:
     case RC_BAD_INTERRUPT_CONTINUE: