diff --git a/compiler/mips/cell.lisp b/compiler/mips/cell.lisp index 4597ed32c61cdfc6c4957255b22fcdc6e26c42c0..f7f6317852d36d57e7af14578d5a2d617ef0073e 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.60 1992/08/16 15:09:18 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/cell.lisp,v 1.61 1992/12/13 15:23:10 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -22,63 +22,34 @@ (in-package "MIPS") -;;;; Data object definition macros. - -(define-for-each-primitive-object (obj) - (collect ((forms)) - (let ((lowtag (primitive-object-lowtag obj))) - (dolist (slot (primitive-object-slots obj)) - (let* ((name (slot-name slot)) - (offset (slot-offset slot)) - (rest-p (slot-rest-p slot)) - (slot-opts (slot-options slot)) - (ref-trans (getf slot-opts :ref-trans)) - (ref-vop (getf slot-opts :ref-vop ref-trans)) - (set-trans (getf slot-opts :set-trans)) - (setf-function-p (and (listp set-trans) - (= (length set-trans) 2) - (eq (car set-trans) 'setf))) - (setf-vop (getf slot-opts :setf-vop - (when setf-function-p - (intern (concatenate - 'simple-string - "SET-" - (string (cadr set-trans))))))) - (set-vop (getf slot-opts :set-vop - (if setf-vop nil set-trans)))) - (when ref-vop - (forms `(define-vop (,ref-vop ,(if rest-p 'slot-ref 'cell-ref)) - (:variant ,offset ,lowtag) - ,@(when ref-trans - `((:translate ,ref-trans)))))) - (when (or set-vop setf-vop) - (forms `(define-vop ,(cond ((and rest-p setf-vop) - (error "Can't automatically generate ~ - a setf VOP for :rest-p ~ - slots: ~S in ~S" - name - (primitive-object-name obj))) - (rest-p `(,set-vop slot-set)) - ((and set-vop setf-function-p) - (error "Setf functions (list ~S) must ~ - use :setf-vops." - set-trans)) - (set-vop `(,set-vop cell-set)) - (setf-function-p - `(,setf-vop cell-setf-function)) - (t - `(,setf-vop cell-setf))) - (:variant ,offset ,lowtag) - ,@(when set-trans - `((:translate ,set-trans))))))))) - (when (forms) - `(progn - ,@(forms))))) +;;;; Data object ref/set stuff. + +(define-vop (slot) + (:args (object :scs (descriptor-reg))) + (:info name offset lowtag) + (:ignore name) + (:results (result :scs (descriptor-reg any-reg))) + (:generator 1 + (loadw result object offset lowtag))) + +(define-vop (set-slot) + (:args (object :scs (descriptor-reg)) + (value :scs (descriptor-reg any-reg))) + (:info name offset lowtag) + (:ignore name) + (:results) + (:generator 1 + (storew value object offset lowtag))) ;;;; Symbol hacking VOPs: +;;; The compiler likes to be able to directly SET symbols. +;;; +(define-vop (set cell-set) + (:variant symbol-value-slot other-pointer-type)) + ;;; Do a cell ref with an error check for being unbound. ;;; (define-vop (checked-cell-ref) @@ -246,6 +217,21 @@ funcallable-instance-info-offset function-pointer-type (descriptor-reg any-reg) * %set-funcallable-instance-info) +(define-vop (closure-ref slot-ref) + (:variant closure-info-offset function-pointer-type)) + +(define-vop (closure-init slot-set) + (:variant closure-info-offset function-pointer-type)) + + +;;;; Value Cell hackery. + +(define-vop (value-cell-ref cell-ref) + (:variant value-cell-value-slot other-pointer-type)) + +(define-vop (value-cell-set cell-set) + (:variant value-cell-value-slot other-pointer-type)) + ;;;; Structure hackery: diff --git a/compiler/sparc/cell.lisp b/compiler/sparc/cell.lisp index 92e6585e0510e8e3d92080b94012ba7f8cb1647f..f2ff0027bb5e2534a726fc46e2aef1162350f640 100644 --- a/compiler/sparc/cell.lisp +++ b/compiler/sparc/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/sparc/cell.lisp,v 1.11 1992/04/14 02:58:54 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/cell.lisp,v 1.12 1992/12/13 15:24:55 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -22,63 +22,34 @@ (in-package "SPARC") -;;;; Data object definition macros. - -(vm:define-for-each-primitive-object (obj) - (collect ((forms)) - (let ((lowtag (vm:primitive-object-lowtag obj))) - (dolist (slot (vm:primitive-object-slots obj)) - (let* ((name (vm:slot-name slot)) - (offset (vm:slot-offset slot)) - (rest-p (vm:slot-rest-p slot)) - (slot-opts (vm:slot-options slot)) - (ref-trans (getf slot-opts :ref-trans)) - (ref-vop (getf slot-opts :ref-vop ref-trans)) - (set-trans (getf slot-opts :set-trans)) - (setf-function-p (and (listp set-trans) - (= (length set-trans) 2) - (eq (car set-trans) 'setf))) - (setf-vop (getf slot-opts :setf-vop - (when setf-function-p - (intern (concatenate - 'simple-string - "SET-" - (string (cadr set-trans))))))) - (set-vop (getf slot-opts :set-vop - (if setf-vop nil set-trans)))) - (when ref-vop - (forms `(define-vop (,ref-vop ,(if rest-p 'slot-ref 'cell-ref)) - (:variant ,offset ,lowtag) - ,@(when ref-trans - `((:translate ,ref-trans)))))) - (when (or set-vop setf-vop) - (forms `(define-vop ,(cond ((and rest-p setf-vop) - (error "Can't automatically generate ~ - a setf VOP for :rest-p ~ - slots: ~S in ~S" - name - (vm:primitive-object-name obj))) - (rest-p `(,set-vop slot-set)) - ((and set-vop setf-function-p) - (error "Setf functions (list ~S) must ~ - use :setf-vops." - set-trans)) - (set-vop `(,set-vop cell-set)) - (setf-function-p - `(,setf-vop cell-setf-function)) - (t - `(,setf-vop cell-setf))) - (:variant ,offset ,lowtag) - ,@(when set-trans - `((:translate ,set-trans))))))))) - (when (forms) - `(progn - ,@(forms))))) +;;;; Data object ref/set stuff. + +(define-vop (slot) + (:args (object :scs (descriptor-reg))) + (:info name offset lowtag) + (:ignore name) + (:results (result :scs (descriptor-reg any-reg))) + (:generator 1 + (loadw result object offset lowtag))) + +(define-vop (set-slot) + (:args (object :scs (descriptor-reg)) + (value :scs (descriptor-reg any-reg))) + (:info name offset lowtag) + (:ignore name) + (:results) + (:generator 1 + (storew value object offset lowtag))) ;;;; Symbol hacking VOPs: +;;; The compiler likes to be able to directly SET symbols. +;;; +(define-vop (set cell-set) + (:variant symbol-value-slot other-pointer-type)) + ;;; Do a cell ref with an error check for being unbound. ;;; (define-vop (checked-cell-ref) @@ -243,6 +214,23 @@ (:variant funcallable-instance-info-offset function-pointer-type) (:translate %set-funcallable-instance-info)) + +(define-vop (closure-ref slot-ref) + (:variant closure-info-offset function-pointer-type)) + +(define-vop (closure-set slot-set) + (:variant closure-info-offset function-pointer-type)) + + +;;;; Value Cell hackery. + +(define-vop (value-cell-ref cell-ref) + (:variant value-cell-value-slot other-pointer-type)) + +(define-vop (value-cell-set cell-set) + (:variant value-cell-value-slot other-pointer-type)) + + ;;;; Structure hackery: