From 155dfa49574ffbd8048a477a27920f666e73462f Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 24 Feb 1990 04:01:42 +0000
Subject: [PATCH] Open-code vector-8b ref and set operations.

---
 v7/src/compiler/rtlgen/opncod.scm | 28 +++++++++++++++++++++++++++-
 1 file changed, 27 insertions(+), 1 deletion(-)

diff --git a/v7/src/compiler/rtlgen/opncod.scm b/v7/src/compiler/rtlgen/opncod.scm
index c08584604..bfe39e141 100644
--- a/v7/src/compiler/rtlgen/opncod.scm
+++ b/v7/src/compiler/rtlgen/opncod.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/opncod.scm,v 4.34 1990/01/18 22:46:50 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/opncod.scm,v 4.35 1990/02/24 04:01:42 cph Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -465,6 +465,10 @@ MIT in each case. |#
   (rtl:make-cons-pointer (rtl:make-machine-constant (ucode-type character))
 			 (rtl:make-fetch locative)))
 
+(define (rtl:vector-8b-fetch locative)
+  (rtl:make-cons-pointer (rtl:make-machine-constant (ucode-type fixnum))
+			 (rtl:make-fetch locative)))
+
 (define (rtl:string-assignment locative value)
   (rtl:make-assignment locative (rtl:make-char->ascii value)))
 
@@ -486,6 +490,9 @@ MIT in each case. |#
 
 (define finish-string-assignment
   (assignment-finisher rtl:string-assignment rtl:string-fetch))
+
+(define finish-vector-8b-assignment
+  (assignment-finisher rtl:make-assignment rtl:vector-8b-fetch))
 
 ;;;; Open Coders
 
@@ -743,6 +750,16 @@ MIT in each case. |#
    (or compiler:generate-type-checks?
        compiler:generate-range-checks?)))
 
+(define-open-coder/value 'VECTOR-8B-REF
+  (simple-open-coder
+   (string-memory-reference 'VECTOR-8B-REF false
+     (lambda (locative expressions finish)
+       expressions
+       (finish (rtl:vector-8b-fetch locative))))
+   '(0 1)
+   (or compiler:generate-type-checks?
+       compiler:generate-range-checks?)))
+
 (define-open-coder/effect 'STRING-SET!
   (simple-open-coder
    (string-memory-reference 'STRING-SET! (ucode-type character)
@@ -751,6 +768,15 @@ MIT in each case. |#
    '(0 1 2)
    (or compiler:generate-type-checks?
        compiler:generate-range-checks?)))
+
+(define-open-coder/effect 'VECTOR-8B-SET!
+  (simple-open-coder
+   (string-memory-reference 'VECTOR-8B-SET! (ucode-type fixnum)
+     (lambda (locative expressions finish)
+       (finish-vector-8b-assignment locative (caddr expressions) finish)))
+   '(0 1 2)
+   (or compiler:generate-type-checks?
+       compiler:generate-range-checks?)))
 
 ;;;; Fixnum Arithmetic
 
-- 
2.25.1