From d4b84a20584d419152793f6d20b52f64b9b9e4a6 Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Fri, 15 Jan 1993 01:33:53 +0000 Subject: [PATCH] Changed function-header-code-offset to function-code-offset. Added stuff for new var-alloc and fixed-alloc vops. --- compiler/hppa/cell.lisp | 100 ++++++++++++++++++---------------------- 1 file changed, 45 insertions(+), 55 deletions(-) diff --git a/compiler/hppa/cell.lisp b/compiler/hppa/cell.lisp index bb5fd8c6a..59f4c6f48 100644 --- a/compiler/hppa/cell.lisp +++ b/compiler/hppa/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/hppa/cell.lisp,v 1.2 1992/10/28 00:32:43 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/hppa/cell.lisp,v 1.3 1993/01/15 01:33:53 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -20,63 +20,34 @@ (in-package "HPPA") -;;;; 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) @@ -125,6 +96,9 @@ ;;;; Fdefinition (fdefn) objects. +(define-vop (fdefn-function cell-ref) + (:variant fdefn-function-slot other-pointer-type)) + (define-vop (safe-fdefn-function) (:args (object :scs (descriptor-reg) :target obj-temp)) (:results (value :scs (descriptor-reg any-reg))) @@ -149,8 +123,7 @@ (load-type type function (- function-pointer-type)) (inst addi (- function-header-type) type type) (inst comb := type zero-tn normal-fn) - (inst addi (- (ash function-header-code-offset word-shift) - function-pointer-type) + (inst addi (- (ash function-code-offset word-shift) function-pointer-type) function lip) (inst li (make-fixup "closure_tramp" :foreign) lip) NORMAL-FN @@ -231,6 +204,23 @@ (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: -- GitLab