From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Sun, 14 May 1995 00:53:04 +0000 (+0000)
Subject: Added %car %cdr %set-car! %set-cdr! %vector-ref %vector-set!
X-Git-Tag: 20090517-FFI~6313
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1ada2ce5fe7c615027533fa78e4386106745fdee;p=mit-scheme.git

Added %car %cdr %set-car! %set-cdr! %vector-ref %vector-set!
%vector-length unchecked pair and vector operators.
---

diff --git a/v8/src/compiler/midend/fakeprim.scm b/v8/src/compiler/midend/fakeprim.scm
index 92f6fed83..c26074e60 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.13 1995/04/19 22:53:02 adams Exp $
+$Id: fakeprim.scm,v 1.14 1995/05/14 00:53:04 adams Exp $
 
 Copyright (c) 1994 Massachusetts Institute of Technology
 
@@ -541,16 +541,49 @@ MIT in each case. |#
 
 (cookie-call %cons '#F car-value cdr-value)
 
+
+;; Unchecked operations on pairs.  Result is unspecified if the pair
+;; argument is not a pair.
+(define %car
+  ;; (CALL ',%car '#F <pair>)
+  (make-operator/effect-sensitive "#[car]"))
+
+(define %cdr
+  ;; (CALL ',%cdr '#F <pair>)
+  (make-operator/effect-sensitive "#[cdr]"))
+
+(define %set-car!
+  ;; (CALL ',%set-car '#F <pair> <value>)
+  (make-operator/simple* "#[set-car!]" '(UNSPECIFIC-RESULT)))
+
+(define %set-cdr!
+  ;; (CALL ',%set-cdr '#F <pair> <value>)
+  (make-operator/simple* "#[set-cdr!]" '(UNSPECIFIC-RESULT)))
+
+
 (define %make-entity
   ;; (CALL ',%make-entity '#F <value> <value>)
   (make-operator/simple "#[make-entity]"))
 
+
 (define %vector
   ;; (CALL ',%vector '#F <value>*)
   ;; Note:
   ;;   Introduced by expand.scm for DEFINE-MULTIPLE
   (make-operator/simple "#[vector]"))
 
+(define %vector-length
+  ;; (CALL ',%vector-length '#F <vector>)
+  (make-operator/simple "#[vector-length]"))
+
+(define %vector-ref
+  ;; (CALL ',%vector-ref '#F <vector> <index>)
+  (make-operator/effect-sensitive "#[vector-ref]"))
+
+(define %vector-set!
+  ;; (CALL ',%vector-set! '#F <vector> <index> <value>)
+  (make-operator/simple* "#[vector-set!]" '(UNSPECIFIC-RESULT)))
+
 (cookie-call %vector '#F #!rest values)
 
 (define %make-promise