From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Tue, 21 Aug 1990 02:20:55 +0000 (+0000)
Subject: Replace internal code words with return address code words so the
X-Git-Tag: 20090517-FFI~11236
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=7bf61b9f75d083a046ebbaaca4d8f3b63f57b42a;p=mit-scheme.git

Replace internal code words with return address code words so the
debugger will not get confused about internal procedures and interrupt
frames in compiled code.
---

diff --git a/v7/src/compiler/machines/bobcat/make.scm-68040 b/v7/src/compiler/machines/bobcat/make.scm-68040
index ae1878096..7e7a0493c 100644
--- a/v7/src/compiler/machines/bobcat/make.scm-68040
+++ b/v7/src/compiler/machines/bobcat/make.scm-68040
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.74 1990/06/26 22:07:13 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.75 1990/08/21 02:20:43 jinx Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -41,4 +41,4 @@ MIT in each case. |#
 	    ((package/reference (find-package name) 'INITIALIZE-PACKAGE!)))
 	  '((COMPILER MACROS)
 	    (COMPILER DECLARATIONS)))
-(add-system! (make-system "Liar (Motorola MC68020)" 4 74 '()))
\ No newline at end of file
+(add-system! (make-system "Liar (Motorola MC68020)" 4 75 '()))
\ No newline at end of file
diff --git a/v7/src/compiler/machines/bobcat/rules3.scm b/v7/src/compiler/machines/bobcat/rules3.scm
index f99ca5bb3..48710fbb0 100644
--- a/v7/src/compiler/machines/bobcat/rules3.scm
+++ b/v7/src/compiler/machines/bobcat/rules3.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 4.24 1990/05/03 15:17:33 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 4.25 1990/08/21 02:20:55 jinx Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -323,9 +323,12 @@ MIT in each case. |#
 (define internal-entry-code-word
   (make-code-word #xff #xfe))
 
-(define (frame-size->code-word offset)
+(define internal-continuation-code-word
+  (make-code-word #xff #xfc))
+
+(define (frame-size->code-word offset default)
   (cond ((not offset)
-	 (make-code-word #xff #xfc))
+	 default)
 	((< offset #x2000)
 	 ;; This uses up through (#xff #xdf).
 	 (let ((qr (integer-divide offset #x80)))
@@ -338,7 +341,13 @@ MIT in each case. |#
   (frame-size->code-word
    (if label
        (rtl-continuation/next-continuation-offset (label->object label))
-       0)))
+       0)
+   internal-continuation-code-word))
+
+(define (internal-procedure-code-word rtl-proc)
+  (frame-size->code-word
+   (rtl-procedure/next-continuation-offset rtl-proc)
+   internal-entry-code-word))
 
 ;;;; Procedure headers
 
@@ -405,7 +414,7 @@ MIT in each case. |#
 	    (lambda (code-word label)
 	      (simple-procedure-header code-word label
 				       entry:compiler-interrupt-procedure)))
-	internal-entry-code-word
+	(internal-procedure-code-word rtl-proc)
 	internal-label))))
 
 (define-rule statement
@@ -429,14 +438,15 @@ MIT in each case. |#
 (define-rule statement
   (CLOSURE-HEADER (? internal-label) (? nentries) (? entry))
   nentries				; ignored
-  (let ((procedure (label->object internal-label)))
+  (let ((rtl-proc (label->object internal-label)))
     (let ((gc-label (generate-label))
-	  (external-label (rtl-procedure/external-label procedure)))
+	  (external-label (rtl-procedure/external-label rtl-proc)))
       (if (zero? nentries)
 	  (LAP (EQUATE ,external-label ,internal-label)
-	       ,@(simple-procedure-header internal-entry-code-word
-					  internal-label
-					  entry:compiler-interrupt-procedure))
+	       ,@(simple-procedure-header
+		  (internal-procedure-code-word rtl-proc)
+		  internal-label
+		  entry:compiler-interrupt-procedure))
 	  (LAP (LABEL ,gc-label)
 	       ,@(let ((distance (* 10 entry)))
 		   (cond ((zero? distance)