From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Mon, 20 Mar 1995 02:02:02 +0000 (+0000)
Subject: Modified to treat %internal-apply-unchecked like %internal-apply.
X-Git-Tag: 20090517-FFI~6523
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c3fc179675956012044b8f28a814a4844739d5d5;p=mit-scheme.git

Modified to treat %internal-apply-unchecked like %internal-apply.
---

diff --git a/v8/src/compiler/midend/dataflow.scm b/v8/src/compiler/midend/dataflow.scm
index a3f1cd22e..c4be44629 100644
--- a/v8/src/compiler/midend/dataflow.scm
+++ b/v8/src/compiler/midend/dataflow.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: dataflow.scm,v 1.8 1995/02/11 02:04:02 adams Exp $
+$Id: dataflow.scm,v 1.9 1995/03/20 02:02:02 adams Exp $
 
 Copyright (c) 1994 Massachusetts Institute of Technology
 
@@ -377,7 +377,8 @@ MIT in each case. |#
                (use dataflow/handler/%stack-closure-ref))
 	      ((eq? operator %heap-closure-set!)
 	       (use dataflow/handler/%heap-closure-set!))
-              ((eq? operator %internal-apply)
+              ((or (eq? operator %internal-apply)
+		   (eq? operator %internal-apply-unchecked))
                (use dataflow/handler/%internal-apply))
 	      ((eq? operator %fetch-stack-closure)
                (use dataflow/handler/%fetch-stack-closure))
@@ -608,8 +609,9 @@ MIT in each case. |#
 
 
 (define (dataflow/handler/%internal-apply env graph form rator cont rands)
-  ;; (CALL ',%internal-apply <continuation> 'NARGS <procedure> <value>*)
-  ;;       ------rator------ -----cont----- ----------rands------------
+  ;; (CALL ',%internal-apply           <cont> 'NARGS <procedure> <value>*)
+  ;; (CALL ',%internal-apply-unchecked <cont> 'NARGS <procedure> <value>*)
+  ;;       ------rator------           -cont- ----------rands------------
   ;;
   ;; Treated like a normal call
   rator					; ignore
diff --git a/v8/src/compiler/midend/split.scm b/v8/src/compiler/midend/split.scm
index cca2a69ab..f1c23d82d 100644
--- a/v8/src/compiler/midend/split.scm
+++ b/v8/src/compiler/midend/split.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: split.scm,v 1.3 1994/11/25 23:06:58 adams Exp $
+$Id: split.scm,v 1.4 1995/03/20 02:01:39 adams Exp $
 
 Copyright (c) 1994 Massachusetts Institute of Technology
 
@@ -168,8 +168,9 @@ MIT in each case. |#
 	       (for-every mutable-call-sites
 		 (lambda (site)
 		   (let ((form (application/text site)))
-		     ;; FORM is (CALL ',%internal-apply <continuation>
-		     ;;               <nargs> <operator> <operand>...)
+		     ;; FORM is (CALL ',%internal-apply[-unchecked]
+		     ;;               <continuation> <nargs>
+		     ;;               <operator> <operand>...)
 		     ;; The debugging information previously associated
 		     ;; with the whole call must now be associated with
 		     ;; _both_ the BEGIN and the inner CALL.
@@ -219,7 +220,7 @@ MIT in each case. |#
 		     ;; direct to the top-level LAMBDA
 		     (let ((form (application/text site)))
 		       ;; FORM is
-		       ;;   (CALL ',%internal-apply <continuation>
+		       ;;   (CALL ',%internal-apply[-unchecked] <continuation>
 		       ;;         <nargs> <operator> <operand>...)
 		       (form/rewrite! form
 			 (case format
diff --git a/v8/src/compiler/midend/triveval.scm b/v8/src/compiler/midend/triveval.scm
index 253d8300c..7fbe0fd22 100644
--- a/v8/src/compiler/midend/triveval.scm
+++ b/v8/src/compiler/midend/triveval.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: triveval.scm,v 1.3 1994/11/26 16:55:36 gjr Exp $
+$Id: triveval.scm,v 1.4 1995/03/20 02:01:28 adams Exp $
 
 Copyright (c) 1994 Massachusetts Institute of Technology
 
@@ -428,6 +428,7 @@ MIT in each case. |#
     (declare-operator %stack-closure-ref stack-closure-ref)
     (declare-operator %fetch-stack-closure fetch-stack-closure)
     (declare-operator %internal-apply funcall)
+    (declare-operator %internal-apply-unchecked funcall)
     (declare-operator %primitive-apply funcall)
     ; (declare-operator %invoke-continuation identity-procedure)
     (declare-operator %vector-index vector-index)
diff --git a/v8/src/compiler/midend/widen.scm b/v8/src/compiler/midend/widen.scm
index eb86b2fa8..3b906e22b 100644
--- a/v8/src/compiler/midend/widen.scm
+++ b/v8/src/compiler/midend/widen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: widen.scm,v 1.6 1995/02/27 21:33:26 adams Exp $
+$Id: widen.scm,v 1.7 1995/03/20 02:01:15 adams Exp $
 
 Copyright (c) 1994 Massachusetts Institute of Technology
 
@@ -606,13 +606,15 @@ MIT in each case. |#
 
 (define (widen/handler/%internal-apply
 	 graph name-map form rator cont rands)
-  ;; (CALL ',%internal-apply <continuation> 'NARGS <procedure> <value>*)
-  ;;       ------ rator ---- ------cont --- --------- rands -----------
+  ;; (CALL ',%internal-apply           <cont> 'NARGS <procedure> <value>*)
+  ;; (CALL ',%internal-apply-unchecked <cont> 'NARGS <procedure> <value>*)
+  ;;       ------ rator ----           -cont- --------- rands -----------
   form					; Not used
   (let ((widened-operands
 	 (widen/flatten-expr* graph name-map (cddr rands))))
     (widen/simple-rewrite
-     `(CALL ,rator ,(widen->expr graph name-map cont)
+     `(CALL ,rator
+	    ,(widen->expr graph name-map cont)
 	    ',(length widened-operands)
 	    ,(widen->expr graph name-map (second rands))
 	    . ,widened-operands)
@@ -668,7 +670,8 @@ MIT in each case. |#
                (use widen/handler/%heap-closure-ref))
               ((eq? operator %stack-closure-ref)
                (use widen/handler/%stack-closure-ref))
-              ((eq? operator %internal-apply)
+              ((or (eq? operator %internal-apply)
+		   (eq? operator %internal-apply-unchecked))
                (use widen/handler/%internal-apply))
 	      ((eq? operator %fetch-stack-closure)
                (use widen/handler/%fetch-stack-closure))