From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Wed, 22 Feb 1995 05:32:50 +0000 (+0000)
Subject: Added %internal-apply-unchecked
X-Git-Tag: 20090517-FFI~6607
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2f048e18a38666513ca19682626b3a15bba4bb5f;p=mit-scheme.git

Added %internal-apply-unchecked
---

diff --git a/v8/src/compiler/midend/compat.scm b/v8/src/compiler/midend/compat.scm
index 14ed6c710..897ee37f2 100644
--- a/v8/src/compiler/midend/compat.scm
+++ b/v8/src/compiler/midend/compat.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: compat.scm,v 1.5 1995/02/14 00:58:08 adams Exp $
+$Id: compat.scm,v 1.6 1995/02/22 05:32:39 adams Exp $
 
 Copyright (c) 1994 Massachusetts Institute of Technology
 
@@ -378,10 +378,11 @@ MIT in each case. |#
        (invocation+2-handler (compat/invocation-cookie 2)))
 
   ;; These are kinds of calls which have extra arguments like arity or cache
-  (define-rewrite/compat %invoke-operator-cache invocation+2-handler)
-  (define-rewrite/compat %invoke-remote-cache   invocation+2-handler)
-  (define-rewrite/compat %internal-apply        invocation+2-handler)
-  (define-rewrite/compat %invoke-continuation   compat/standard-call-handler))
+  (define-rewrite/compat %invoke-operator-cache     invocation+2-handler)
+  (define-rewrite/compat %invoke-remote-cache       invocation+2-handler)
+  (define-rewrite/compat %internal-apply            invocation+2-handler)
+  (define-rewrite/compat %internal-apply-unchecked  invocation+2-handler)
+  (define-rewrite/compat %invoke-continuation    compat/standard-call-handler))
 
 
 (define-rewrite/compat %vector-index
diff --git a/v8/src/compiler/midend/fakeprim.scm b/v8/src/compiler/midend/fakeprim.scm
index cd4d0ce69..219ba879b 100644
--- a/v8/src/compiler/midend/fakeprim.scm
+++ b/v8/src/compiler/midend/fakeprim.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: fakeprim.scm,v 1.4 1994/12/08 16:48:37 adams Exp $
+$Id: fakeprim.scm,v 1.5 1995/02/22 05:32:50 adams Exp $
 
 Copyright (c) 1994 Massachusetts Institute of Technology
 
@@ -477,10 +477,19 @@ MIT in each case. |#
   ;;   NARGS = number of <value> expressions
   ;;   Introduced by applicat.scm.
   (make-operator "#[internal-apply]"))
-
 (cookie-call %internal-apply cont 'NARGS procedure #!REST values)
 
 
+(define %internal-apply-unchecked
+  ;; (CALL ',%internal-apply-unchecked <continuation> 'NARGS <procedure>
+  ;;        <value>*)
+  ;; Note:
+  ;;   NARGS = number of <value> expressions
+  ;;   Like %internal-apply, but assumes that the procedure is compiled and
+  ;;   of the correct arity.
+  (make-operator "#[internal-apply-unchecked]"))
+(cookie-call %internal-apply-unchecked cont 'NARGS procedure #!REST values)
+
 (define %primitive-apply
   ;; (CALL ',%primitive-apply <continuation>
   ;;       'NARGS '<primitive-object> <value>*) 
@@ -914,42 +923,42 @@ MIT in each case. |#
   ;; (CALL ',%call/convention <cont> <convention> <op> <value*>)
   ;; Note:
   ;;   Introduced by compat.scm from CALL
-  (make-operator "#[call 2]"))
+  (make-operator "#[call/convention]"))
 
 (define %invoke-operator-cache/convention
   ;; (CALL ',%invoke-operator-cache/convention <cont> <convention>
   ;;      '(NAME NARGS) <cache> <value>*)
   ;; Note:
   ;;   Introduced by compat.scm from %invoke-operator-cache
-  (make-operator "#[invoke-operator-cache 2]"))
+  (make-operator "#[invoke-operator-cache/convention]"))
 
 (define %invoke-remote-cache/convention
   ;; (CALL ',%invoke-remote-cache/convention <cont> <convention>
   ;;       '(NAME NARGS) <cache> <value>*)
   ;; Note:
   ;;   Introduced by compat.scm from %invoke-remote-cache
-  (make-operator "#[invoke-remote-cache 2]"))
+  (make-operator "#[invoke-remote-cache/convention]"))
 
 (define %internal-apply/convention
   ;; (CALL ',%interna-apply/convention <cont> <convention>
   ;;       'NARGS <procedure> <value>*)
   ;; Note:
   ;;   Introduced by compat.scm from %internal-apply
-  (make-operator "#[internal-apply 2]"))
+  (make-operator "#[internal-apply/convention]"))
 
 (define %primitive-apply/convention
   ;; (CALL ',%primitive-apply/convention <cont> <convention>
   ;;       'NARGS '<primitive-object> <value>*)
   ;; Note:
   ;;   Introduced by compat.scm from %primitive-apply
-  (make-operator "#[primitive-apply 2]"))
+  (make-operator "#[primitive-apply/convention]"))
 
 (define %invoke-continuation/convention
   ;; (CALL ',%invoke-continuation/convention <cont> <convention>
   ;;       <value>*)
   ;; Note:
   ;;   Introduced by compat.scm from %invoke-continuation
-  (make-operator "#[invoke-continuation 2]"))
+  (make-operator "#[invoke-continuation/convention]"))
 
 (define %fetch-parameter-frame
   ;; (CALL ',%fetch-parameter-frame '#F <convention>)