Add support for RECORD objects.

diff --git a/v7/src/compiler/base/make.scm b/v7/src/compiler/base/make.scm
index a6fae92a5a8788bbf5f675f5f71d92f9c8778a18..99e159772a16183db8761841de9e2b1755dfe2a7 100644 (file)
--- 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 15df5fdcfcb7f5f60593bc8b2665474460336397..54667b002de9bb512f76b42d41a77c91e1dacc5a 100644 (file)
--- 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 75ee251a3ce4d763bfec79248981c138588a78bf..c85f178fa4083554e1b349808e3c4135863af0bd 100644 (file)
--- 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 13523cc2a70325a43c682da7016e69abf4d1cda3..fcd35abdf6bb7621f68f6910b6417fbbb13ab3fe 100644 (file)
--- 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 13523cc2a70325a43c682da7016e69abf4d1cda3..fcd35abdf6bb7621f68f6910b6417fbbb13ab3fe 100644 (file)
--- 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