From c0b857e3e29eb3b8c74ed769dec70caed0452b1d Mon Sep 17 00:00:00 2001
From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Sat, 8 Jul 1995 15:01:34 +0000
Subject: [PATCH] NEW-DBG-PROCEDURE now keeps the lambda-list implicitly in the
 SCode.

---
 v8/src/compiler/midend/dbgstr.scm | 74 +++++++++++++++++--------------
 v8/src/compiler/midend/inlate.scm |  7 +--
 2 files changed, 42 insertions(+), 39 deletions(-)

diff --git a/v8/src/compiler/midend/dbgstr.scm b/v8/src/compiler/midend/dbgstr.scm
index 046531da0..d04d48891 100644
--- a/v8/src/compiler/midend/dbgstr.scm
+++ b/v8/src/compiler/midend/dbgstr.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: dbgstr.scm,v 1.14 1995/07/04 17:54:55 adams Exp $
+$Id: dbgstr.scm,v 1.15 1995/07/08 15:01:24 adams Exp $
 
 Copyright (c) 1994-1995 Massachusetts Institute of Technology
 
@@ -33,7 +33,7 @@ promotional, or sales literature without prior written consent from
 MIT in each case. |#
 
 (declare (usual-integrations))
-
+
 (define-structure
     (new-dbg-expression
      (conc-name new-dbg-expression/)
@@ -44,8 +44,9 @@ MIT in each case. |#
 	(lambda (expr port)
 	  (write-char #\Space port)
 	  (display (new-dbg-expression/expr expr) port)))))
-  (expr false read-only true)
-  (block false read-only false))
+  (block false read-only false)
+  (label false read-only true)
+  (expr false read-only true))
 
 
 (define (new-dbg-expression/new-block dbg-expr block*)
@@ -55,21 +56,21 @@ MIT in each case. |#
 (define-structure
     (new-dbg-procedure
      (conc-name new-dbg-procedure/)
-     (constructor new-dbg-procedure/make (lam-expr lambda-list))
+     (constructor new-dbg-procedure/make (lam-expr))
      (constructor new-dbg-procedure/%make))
-  (lam-expr false read-only true)
-  (lambda-list false read-only true)
-  (block false read-only false))
+  (block false read-only false)
+  (label false read-only false)
+  (lam-expr false read-only true))
 
 (define (new-dbg-procedure/copy dbg-proc)
-  (new-dbg-procedure/%make (new-dbg-procedure/lam-expr dbg-proc)
-			   (new-dbg-procedure/lambda-list dbg-proc)
-			   (new-dbg-procedure/block dbg-proc)))
+  (new-dbg-procedure/%make (new-dbg-procedure/block dbg-proc)
+			   (new-dbg-procedure/label dbg-proc)
+			   (new-dbg-procedure/lam-expr dbg-proc)))
 
 (define (new-dbg-procedure/new-block dbg-proc block*)
-  (new-dbg-procedure/%make (new-dbg-procedure/lam-expr dbg-proc)
-			   (new-dbg-procedure/lambda-list dbg-proc)
-			   block*))
+  (new-dbg-procedure/%make block*
+			   (new-dbg-procedure/label dbg-proc)
+			   (new-dbg-procedure/lam-expr dbg-proc)))
 
 (define-structure
     (new-dbg-continuation
@@ -125,7 +126,10 @@ MIT in each case. |#
 		(for-each-vector-element vars
 		  (lambda (var)
 		    (write-char #\Space port)
-		    (write (new-dbg-variable/name var) port))))))))))
+		    (write (if (new-dbg-variable? var)
+			       (new-dbg-variable/name var)
+			       var)
+			   port))))))))))
   ;; TYPE is one of 'NESTED, 'FIRST-CLASS
   (type false read-only false)
   ;; PARENT is either
@@ -157,25 +161,27 @@ MIT in each case. |#
 	label)))
 
 (define (new-dbg-procedure->old-dbg-procedure label type new-info)
-  (and new-info				; (lam-expr lambda-list block)
-       (call-with-values
-	(lambda ()
-	  (if (not (new-dbg-procedure? new-info))
-	      (internal-error "Not a new-dbg-procedure" new-info))
-	  (lambda-list/parse (new-dbg-procedure/lambda-list new-info)))
-	(lambda (required optional rest aux)
-	  ;; This does not set the external label!
-	  (make-dbg-procedure
-	   (new-dbg-block->old-dbg-block
-	    (new-dbg-procedure/block new-info))
-	   label			; internal-label
-	   type
-	   (car required)		; name
-	   (cdr required)		; true required
-	   optional
-	   rest
-	   aux
-	   (new-dbg-procedure/lam-expr new-info))))))
+  (and new-info
+       (begin
+	 (if (not (new-dbg-procedure? new-info))
+	     (internal-error "Not a new-dbg-procedure" new-info))
+	 (let ((source-lambda (new-dbg-procedure/lam-expr new-info)))
+	   (lambda-components source-lambda
+	     (lambda (name required optional rest auxiliary block-decls body)
+	       block-decls body		; ignored
+	       (pp `(,source-lambda))
+	       ;; This does not set the external label!
+	       (make-dbg-procedure
+		(new-dbg-block->old-dbg-block
+		 (new-dbg-procedure/block new-info))
+		label			; internal-label
+		type
+		name
+		required
+		optional
+		rest
+		auxiliary
+		source-lambda)))))))
 
 (define (new-dbg-continuation->old-dbg-continuation label frame-size new-info)
   (and new-info
diff --git a/v8/src/compiler/midend/inlate.scm b/v8/src/compiler/midend/inlate.scm
index b56b08d1b..5340858a7 100644
--- a/v8/src/compiler/midend/inlate.scm
+++ b/v8/src/compiler/midend/inlate.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: inlate.scm,v 1.4 1995/04/29 00:57:15 adams Exp $
+$Id: inlate.scm,v 1.5 1995/07/08 15:01:34 adams Exp $
 
 Copyright (c) 1994-1995 Massachusetts Institute of Technology
 
@@ -111,10 +111,7 @@ MIT in each case. |#
 			(beginnify
 			 (list `(DECLARE ,@decls)
 			       body)))))))
-	(inlate/remember new
-			 (new-dbg-procedure/make
-			  form
-			  (cons name lambda-list)))))))
+	(inlate/remember new (new-dbg-procedure/make form))))))
 #|
 (define (inlate/lambda* name req opt rest aux decls sbody)
   name					; ignored
-- 
2.25.1