From 959df0b72edd55a067be17e5c57cb8326dad1be9 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 2 Dec 1992 19:36:41 +0000
Subject: [PATCH] Add support for RECORD objects.

---
 v7/src/compiler/base/make.scm     |  4 ++--
 v7/src/compiler/rtlgen/opncod.scm | 28 +++++++++++++++++++++-------
 v7/src/sf/gconst.scm              |  6 +++++-
 v7/src/sf/make.scm                |  4 ++--
 v8/src/sf/make.scm                |  4 ++--
 5 files changed, 32 insertions(+), 14 deletions(-)

diff --git a/v7/src/compiler/base/make.scm b/v7/src/compiler/base/make.scm
index a6fae92a5..99e159772 100644
--- a/v7/src/compiler/base/make.scm
+++ b/v7/src/compiler/base/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 4.94 1992/10/19 19:34:26 jinx Exp $
+$Id: make.scm,v 4.95 1992/12/02 19:35:10 cph Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -46,5 +46,5 @@ MIT in each case. |#
     (initialize-package! '(COMPILER DECLARATIONS)))
   (add-system!
    (make-system (string-append "Liar (" architecture-name ")")
-		4 94
+		4 95
 		'())))
\ No newline at end of file
diff --git a/v7/src/compiler/rtlgen/opncod.scm b/v7/src/compiler/rtlgen/opncod.scm
index 15df5fdcf..54667b002 100644
--- a/v7/src/compiler/rtlgen/opncod.scm
+++ b/v7/src/compiler/rtlgen/opncod.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: opncod.scm,v 4.48 1992/11/18 00:47:21 gjr Exp $
+$Id: opncod.scm,v 4.49 1992/12/02 19:34:48 cph Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -612,6 +612,19 @@ MIT in each case. |#
 		false)
 	(values false false false))))
 
+(define-open-coder/value '%RECORD
+  (lambda (operands)
+    (if (< 1 (length operands) 32)
+	(values (lambda (combination expressions finish)
+		  combination
+		  (finish
+		   (rtl:make-typed-cons:vector
+		    (rtl:make-machine-constant (ucode-type record))
+		    expressions)))
+		(all-operand-indices operands)
+		false)
+	(values false false false))))
+
 (define (all-operand-indices operands)
   (let loop ((operands operands) (index 0))
     (if (null? operands)
@@ -663,6 +676,7 @@ MIT in each case. |#
 	    internal-close-coding-for-type-checks)))))
   (user-ref 'CELL-CONTENTS rtl:make-fetch (ucode-type cell) 0)
   (user-ref 'VECTOR-LENGTH rtl:length-fetch (ucode-type vector) 0)
+  (user-ref '%RECORD-LENGTH rtl:length-fetch (ucode-type record) 0)
   (user-ref 'SYSTEM-VECTOR-SIZE rtl:vector-length-fetch false 0)
   (user-ref 'STRING-LENGTH rtl:length-fetch (ucode-type string) 1)
   (user-ref 'BIT-STRING-LENGTH rtl:length-fetch (ucode-type vector-1b) 1)
@@ -696,6 +710,7 @@ MIT in each case. |#
 	    '(0 1)
 	    internal-close-coding-for-type-or-range-checks)))))
   (make-ref 'VECTOR-REF (ucode-type vector))
+  (make-ref '%RECORD-REF (ucode-type record))
   (make-ref 'SYSTEM-VECTOR-REF false))
 
 (define-open-coder/value 'PRIMITIVE-OBJECT-REF
@@ -707,9 +722,9 @@ MIT in each case. |#
    '(0 1)
    false))
 
-;; For now SYSTEM-XXXX side effect procedures are considered
-;; dangerous to the garbage collector's health.  Some day we will
-;; again be able to enable them.
+;; For now SYSTEM-XXXX side effect procedures are considered dangerous
+;; to the garbage collector's health.  Some day we will again be able
+;; to enable them.
 
 (let ((fixed-assignment
        (lambda (name type index)
@@ -751,9 +766,8 @@ MIT in each case. |#
 	    '(0 1 2)
 	    internal-close-coding-for-type-or-range-checks)))))
   (make-assignment 'VECTOR-SET! (ucode-type vector))
-  #|
-  (make-assignment 'SYSTEM-VECTOR-SET! false)
-  |#)
+  (make-assignment '%RECORD-SET! (ucode-type record))
+  #|(make-assignment 'SYSTEM-VECTOR-SET! false)|#)
 
 (define-open-coder/effect 'PRIMITIVE-OBJECT-SET!
   (simple-open-coder
diff --git a/v7/src/sf/gconst.scm b/v7/src/sf/gconst.scm
index 75ee251a3..c85f178fa 100644
--- a/v7/src/sf/gconst.scm
+++ b/v7/src/sf/gconst.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: gconst.scm,v 4.14 1992/11/08 04:23:45 jinx Exp $
+$Id: gconst.scm,v 4.15 1992/12/02 19:36:26 cph Exp $
 
 Copyright (c) 1987-1992 Massachusetts Institute of Technology
 
@@ -43,6 +43,10 @@ MIT in each case. |#
 
 (define global-constant-objects
   '(
+    %RECORD
+    %RECORD-LENGTH
+    %RECORD-REF
+    %RECORD-SET!
     *THE-NON-PRINTING-OBJECT*
     ASCII->CHAR
     BIT-STRING->UNSIGNED-INTEGER
diff --git a/v7/src/sf/make.scm b/v7/src/sf/make.scm
index 13523cc2a..fcd35abdf 100644
--- a/v7/src/sf/make.scm
+++ b/v7/src/sf/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 4.24 1992/11/04 10:17:31 jinx Exp $
+$Id: make.scm,v 4.25 1992/12/02 19:36:41 cph Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -39,4 +39,4 @@ MIT in each case. |#
 (package/system-loader "sf" '() 'QUERY)
 ((package/reference (find-package '(SCODE-OPTIMIZER))
 		    'USUAL-INTEGRATIONS/CACHE!))
-(add-system! (make-system "SF" 4 24 '()))
\ No newline at end of file
+(add-system! (make-system "SF" 4 25 '()))
\ No newline at end of file
diff --git a/v8/src/sf/make.scm b/v8/src/sf/make.scm
index 13523cc2a..fcd35abdf 100644
--- a/v8/src/sf/make.scm
+++ b/v8/src/sf/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 4.24 1992/11/04 10:17:31 jinx Exp $
+$Id: make.scm,v 4.25 1992/12/02 19:36:41 cph Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -39,4 +39,4 @@ MIT in each case. |#
 (package/system-loader "sf" '() 'QUERY)
 ((package/reference (find-package '(SCODE-OPTIMIZER))
 		    'USUAL-INTEGRATIONS/CACHE!))
-(add-system! (make-system "SF" 4 24 '()))
\ No newline at end of file
+(add-system! (make-system "SF" 4 25 '()))
\ No newline at end of file
-- 
2.25.1