Skip to content
Snippets Groups Projects
Commit de7eb828 authored by wlott's avatar wlott
Browse files

Removed the define-for-each-primitive-object. Added slot and set-slot

which are used by (the new) vm-ir2tran to do the stuff that was previously
handled by define-for-each-primitive-object.  Added set, closure-ref,
closure-init, value-cell-ref, and value-cell-set because the compiler
expects those vops to exist.
parent 29d1bf3e
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -22,63 +22,34 @@
(in-package "MIPS") (in-package "MIPS")
;;;; Data object definition macros. ;;;; Data object ref/set stuff.
(define-for-each-primitive-object (obj) (define-vop (slot)
(collect ((forms)) (:args (object :scs (descriptor-reg)))
(let ((lowtag (primitive-object-lowtag obj))) (:info name offset lowtag)
(dolist (slot (primitive-object-slots obj)) (:ignore name)
(let* ((name (slot-name slot)) (:results (result :scs (descriptor-reg any-reg)))
(offset (slot-offset slot)) (:generator 1
(rest-p (slot-rest-p slot)) (loadw result object offset lowtag)))
(slot-opts (slot-options slot))
(ref-trans (getf slot-opts :ref-trans)) (define-vop (set-slot)
(ref-vop (getf slot-opts :ref-vop ref-trans)) (:args (object :scs (descriptor-reg))
(set-trans (getf slot-opts :set-trans)) (value :scs (descriptor-reg any-reg)))
(setf-function-p (and (listp set-trans) (:info name offset lowtag)
(= (length set-trans) 2) (:ignore name)
(eq (car set-trans) 'setf))) (:results)
(setf-vop (getf slot-opts :setf-vop (:generator 1
(when setf-function-p (storew value object offset lowtag)))
(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)))))
;;;; Symbol hacking VOPs: ;;;; 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. ;;; Do a cell ref with an error check for being unbound.
;;; ;;;
(define-vop (checked-cell-ref) (define-vop (checked-cell-ref)
...@@ -246,6 +217,21 @@ ...@@ -246,6 +217,21 @@
funcallable-instance-info-offset function-pointer-type funcallable-instance-info-offset function-pointer-type
(descriptor-reg any-reg) * %set-funcallable-instance-info) (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: ;;;; Structure hackery:
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -22,63 +22,34 @@
(in-package "SPARC") (in-package "SPARC")
;;;; Data object definition macros. ;;;; Data object ref/set stuff.
(vm:define-for-each-primitive-object (obj) (define-vop (slot)
(collect ((forms)) (:args (object :scs (descriptor-reg)))
(let ((lowtag (vm:primitive-object-lowtag obj))) (:info name offset lowtag)
(dolist (slot (vm:primitive-object-slots obj)) (:ignore name)
(let* ((name (vm:slot-name slot)) (:results (result :scs (descriptor-reg any-reg)))
(offset (vm:slot-offset slot)) (:generator 1
(rest-p (vm:slot-rest-p slot)) (loadw result object offset lowtag)))
(slot-opts (vm:slot-options slot))
(ref-trans (getf slot-opts :ref-trans)) (define-vop (set-slot)
(ref-vop (getf slot-opts :ref-vop ref-trans)) (:args (object :scs (descriptor-reg))
(set-trans (getf slot-opts :set-trans)) (value :scs (descriptor-reg any-reg)))
(setf-function-p (and (listp set-trans) (:info name offset lowtag)
(= (length set-trans) 2) (:ignore name)
(eq (car set-trans) 'setf))) (:results)
(setf-vop (getf slot-opts :setf-vop (:generator 1
(when setf-function-p (storew value object offset lowtag)))
(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)))))
;;;; Symbol hacking VOPs: ;;;; 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. ;;; Do a cell ref with an error check for being unbound.
;;; ;;;
(define-vop (checked-cell-ref) (define-vop (checked-cell-ref)
...@@ -243,6 +214,23 @@ ...@@ -243,6 +214,23 @@
(:variant funcallable-instance-info-offset function-pointer-type) (:variant funcallable-instance-info-offset function-pointer-type)
(:translate %set-funcallable-instance-info)) (: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: ;;;; Structure hackery:
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment