From 862e560eb0bec70305a19ef5717f83978244889c Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Thu, 14 Jan 1993 21:02:57 +0000 Subject: [PATCH] *** empty log message *** --- compiler/generic/objdef.lisp | 16 +++++++-------- compiler/generic/vm-fndb.lisp | 22 +++++++++++++------- compiler/generic/vm-tran.lisp | 38 ++++++++--------------------------- compiler/generic/vm-type.lisp | 6 ++---- compiler/mips/cell.lisp | 34 +++++++++++++++---------------- compiler/mips/type-vops.lisp | 6 +++--- 6 files changed, 53 insertions(+), 69 deletions(-) diff --git a/compiler/generic/objdef.lisp b/compiler/generic/objdef.lisp index 10f2632e2..9ea83894a 100644 --- a/compiler/generic/objdef.lisp +++ b/compiler/generic/objdef.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/objdef.lisp,v 1.23 1992/12/16 21:36:27 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/objdef.lisp,v 1.23.1.1 1993/01/14 21:02:38 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -21,7 +21,7 @@ (export '(lowtag-bits lowtag-mask lowtag-limit type-bits type-mask target-most-positive-fixnum target-most-negative-fixnum even-fixnum-type function-pointer-type other-immediate-0-type - list-pointer-type odd-fixnum-type structure-pointer-type + list-pointer-type odd-fixnum-type instance-pointer-type other-immediate-1-type other-pointer-type bignum-type ratio-type single-float-type double-float-type complex-type simple-array-type simple-string-type simple-bit-vector-type @@ -38,7 +38,7 @@ dylan-function-header-type value-cell-header-type symbol-header-type base-char-type sap-type unbound-marker-type weak-pointer-type - structure-header-type funcallable-instance-header-type + instance-header-type funcallable-instance-header-type fdefn-type vector-normal-subtype vector-valid-hashing-subtype vector-must-rehash-subtype forwarding-pointer-type scavenger-hook-type)) @@ -93,7 +93,7 @@ other-immediate-0 list-pointer odd-fixnum - structure-pointer + instance-pointer other-immediate-1 other-pointer) @@ -141,7 +141,7 @@ sap unbound-marker weak-pointer - structure-header + instance-header fdefn #+gengc scavenger-hook ) @@ -163,9 +163,9 @@ (car :ref-trans car :set-trans c::%rplaca :init :arg) (cdr :ref-trans cdr :set-trans c::%rplacd :init :arg)) -(define-primitive-object (structure :lowtag structure-pointer-type - :header structure-header-type - :alloc-trans make-structure) +(define-primitive-object (instance :lowtag instance-pointer-type + :header instance-header-type + :alloc-trans %make-instance) (slots :rest-p t)) (define-primitive-object (bignum :lowtag other-pointer-type diff --git a/compiler/generic/vm-fndb.lisp b/compiler/generic/vm-fndb.lisp index 27567617e..613d61b13 100644 --- a/compiler/generic/vm-fndb.lisp +++ b/compiler/generic/vm-fndb.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-fndb.lisp,v 1.47 1992/12/17 09:30:26 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-fndb.lisp,v 1.47.1.1 1993/01/14 21:02:46 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -47,7 +47,7 @@ ;;; into non-standard unary predicates. (defknown (fixnump bignump ratiop short-float-p single-float-p double-float-p - long-float-p base-char-p %string-char-p %standard-char-p structurep + long-float-p base-char-p %string-char-p %standard-char-p %instancep array-header-p simple-array-p simple-array-unsigned-byte-2-p simple-array-unsigned-byte-4-p simple-array-unsigned-byte-8-p simple-array-unsigned-byte-16-p simple-array-unsigned-byte-32-p @@ -89,18 +89,26 @@ (unsafe)) -(defknown make-structure (structure-index) structure +(defknown %make-instance (instance-index) instance (unsafe)) -(defknown structure-type (structure) t +(defknown %instance-layout (instance) layout (foldable flushable)) -(defknown structure-length (structure) structure-index +(defknown %instance-length (instance) instance-index (foldable flushable)) -(defknown structure-ref (structure structure-index) t +(defknown %instance-ref (instance instance-index) t (flushable)) -(defknown structure-set (structure structure-index t) t +(defknown (setf %instance-ref) (t instance instance-index) t (unsafe)) +(defknown %raw-ref-single (t index) single-float + (foldable flushable)) +(defknown %raw-ref-double (t index) double-float + (foldable flushable)) +(defknown %raw-set-single (t index single-float) single-float + (unsafe)) +(defknown %raw-set-double (t index double-float) double-float + (unsafe)) (defknown %raw-bits (t fixnum) (unsigned-byte 32) (foldable flushable)) diff --git a/compiler/generic/vm-tran.lisp b/compiler/generic/vm-tran.lisp index a706fc9bb..c8e289c7e 100644 --- a/compiler/generic/vm-tran.lisp +++ b/compiler/generic/vm-tran.lisp @@ -7,12 +7,10 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-tran.lisp,v 1.27 1992/10/20 23:38:21 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-tran.lisp,v 1.27.1.1 1993/01/14 21:02:52 ram Exp $") ;;; ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-tran.lisp,v 1.27 1992/10/20 23:38:21 wlott Exp $ -;;; ;;; This file contains impelemtentation-dependent transforms. ;;; ;;; Written by Rob MacLachlan @@ -35,6 +33,13 @@ (deftransform abs ((x) (rational)) '(if (< x 0) (- x) x)) +;;; For now, the layout is stored in slot 0. +;;; +(def-source-transform %instance-layout (x) + `(truly-the layout (%instance-ref ,x 0))) +;;; +(def-source-transform %set-instance-layout (x val) + `(%instance-set ,x 0 (the layout ,val))) (macrolet ((frob (name primitive) @@ -50,23 +55,6 @@ (def-source-transform %verify-argument-count (&rest foo) `(%primitive verify-argument-count ,@foo)) - - -;;; Let these pass for now. - -(def-primitive-translator header-ref (obj slot) - (warn "Someone used HEADER-REF.") - `(%primitive data-vector-ref/simple-vector ,obj ,slot)) - -(def-primitive-translator header-set (obj slot value) - (warn "Someone used HEADER-SET.") - `(%primitive data-vector-set/simple-vector ,obj ,slot ,value)) - -(def-primitive-translator header-length (obj) - (warn "Someone used HEADER-LENGTH.") - `(%primitive vector-length ,obj)) - - ;;;; Charater support. @@ -75,14 +63,6 @@ (def-source-transform characterp (obj) `(base-char-p ,obj)) -;;; Keep this around in case someone uses it. -;;; -(def-source-transform %string-char-p (obj) - (warn "Someone used %string-char-p.") - `(base-char-p ,obj)) - - - ;;;; Transforms for data-vector-ref for strange array types. @@ -153,8 +133,6 @@ (frob (simple-array (unsigned-byte 2) (*)) 2) (frob (simple-array (unsigned-byte 4) (*)) 4)) - - ;;;; Simple string transforms: diff --git a/compiler/generic/vm-type.lisp b/compiler/generic/vm-type.lisp index 57a2c815a..77b01e8a8 100644 --- a/compiler/generic/vm-type.lisp +++ b/compiler/generic/vm-type.lisp @@ -7,12 +7,10 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-type.lisp,v 1.28 1991/12/16 10:09:55 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-type.lisp,v 1.28.1.1 1993/01/14 21:02:57 ram Exp $") ;;; ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-type.lisp,v 1.28 1991/12/16 10:09:55 wlott Exp $ -;;; ;;; This file contains implementation-dependent parts of the type support ;;; code. This is stuff which deals with the mapping from types defined in ;;; Common Lisp to types actually supported by an implementation. @@ -86,7 +84,7 @@ (deftype bignum-type () 'bignum) (deftype bignum-index () 'index) -(deftype structure-index () `(unsigned-byte ,(- vm:word-bits vm:type-bits))) +(deftype instance-index () `(unsigned-byte ,(- vm:word-bits vm:type-bits))) ;;;; Hooks into type system: diff --git a/compiler/mips/cell.lisp b/compiler/mips/cell.lisp index bec195201..68abac5fb 100644 --- a/compiler/mips/cell.lisp +++ b/compiler/mips/cell.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/cell.lisp,v 1.64 1992/12/16 14:11:52 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/cell.lisp,v 1.64.1.1 1993/01/14 21:01:52 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -246,35 +246,35 @@ -;;;; Structure hackery: +;;;; Instance hackery: -(define-vop (structure-length) +(define-vop (%instance-length) (:policy :fast-safe) - (:translate structure-length) + (:translate instance-length) (:args (struct :scs (descriptor-reg))) (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 4 - (loadw res struct 0 structure-pointer-type) + (loadw res struct 0 instance-pointer-type) (inst srl res type-bits))) -(define-vop (structure-ref slot-ref) - (:variant structure-slots-offset structure-pointer-type) +(define-vop (instance-ref slot-ref) + (:variant instance-slots-offset instance-pointer-type) (:policy :fast-safe) - (:translate structure-ref) - (:arg-types structure (:constant index))) + (:translate %instance-ref) + (:arg-types instance (:constant index))) -(define-vop (structure-set slot-set) +(define-vop (instance-set slot-set) (:policy :fast-safe) - (:translate structure-set) - (:variant structure-slots-offset structure-pointer-type) - (:arg-types structure (:constant index) *)) + (:translate %instance-set) + (:variant instance-slots-offset instance-pointer-type) + (:arg-types instance (:constant index) *)) -(define-full-reffer structure-index-ref * structure-slots-offset - structure-pointer-type (descriptor-reg any-reg) * structure-ref) +(define-full-reffer instance-index-ref * instance-slots-offset + instance-pointer-type (descriptor-reg any-reg) * %instance-ref) -(define-full-setter structure-index-set * structure-slots-offset - structure-pointer-type (descriptor-reg any-reg) * structure-set) +(define-full-setter instance-index-set * instance-slots-offset + instance-pointer-type (descriptor-reg any-reg) * %instance-set) diff --git a/compiler/mips/type-vops.lisp b/compiler/mips/type-vops.lisp index 77216fae6..5855065ab 100644 --- a/compiler/mips/type-vops.lisp +++ b/compiler/mips/type-vops.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/type-vops.lisp,v 1.39 1993/01/13 16:00:02 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/type-vops.lisp,v 1.39.1.1 1993/01/14 21:02:02 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -252,8 +252,8 @@ (def-type-vops listp check-list list object-not-list-error list-pointer-type) -(def-type-vops structurep check-structure structure object-not-structure-error - structure-pointer-type) +(def-type-vops %instancep check-instance instance object-not-instance-error + instance-pointer-type) (def-type-vops bignump check-bigunm bignum object-not-bignum-error bignum-type) -- GitLab