Skip to content
Snippets Groups Projects
Commit cd7bd4c0 authored by ram's avatar ram
Browse files

structure => instance, add raw-{set,ref}-{single,double}, fix local call...

structure => instance, add raw-{set,ref}-{single,double}, fix local call callee-nfp, increment fasl version.
parent 84a32efd
No related branches found
No related tags found
No related merge requests found
......@@ -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/array.lisp,v 1.3 1992/10/13 13:14:47 wlott Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/hppa/array.lisp,v 1.4 1993/03/01 14:59:51 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -329,6 +329,27 @@
(unless (location= result value)
(inst funop :copy value result))))
;;; These VOPs are used for implementing float slots in structures (whose raw
;;; data is an unsigned-32 vector.
;;;
(define-vop (raw-ref-single data-vector-ref/simple-array-single-float)
(:translate %raw-ref-single)
(:arg-types simple-array-unsigned-byte-32 positive-fixnum))
;;;
(define-vop (raw-set-single data-vector-set/simple-array-single-float)
(:translate %raw-set-single)
(:arg-types simple-array-unsigned-byte-32 positive-fixnum single-float))
;;;
(define-vop (raw-ref-double data-vector-ref/simple-array-double-float)
(:translate %raw-ref-double)
(:arg-types simple-array-unsigned-byte-32 positive-fixnum))
;;;
(define-vop (raw-set-double data-vector-set/simple-array-double-float)
(:translate %raw-set-double)
(:arg-types simple-array-unsigned-byte-32 positive-fixnum double-float))
;;; These vops are useful for accessing the bits of a vector irrespective of
;;; what type of vector it is.
;;;
......
......@@ -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/call.lisp,v 1.6 1993/02/07 18:48:20 wlott Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/hppa/call.lisp,v 1.7 1993/03/01 14:59:53 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -478,7 +478,7 @@ default-value-8
(store-stack-tn nfp-save cur-nfp))
(let ((callee-nfp (callee-nfp-tn callee)))
(when callee-nfp
(move nfp callee-nfp)))
(maybe-load-stack-tn nfp callee-nfp)))
(maybe-load-stack-tn cfp-tn cfp)
(inst compute-lra-from-code code-tn label temp
(callee-return-pc-tn callee))
......@@ -516,7 +516,7 @@ default-value-8
(store-stack-tn nfp-save cur-nfp))
(let ((callee-nfp (callee-nfp-tn callee)))
(when callee-nfp
(move nfp callee-nfp)))
(maybe-load-stack-tn nfp callee-nfp)))
(maybe-load-stack-tn cfp-tn cfp)
(inst compute-lra-from-code code-tn label temp
(callee-return-pc-tn callee))
......@@ -559,7 +559,7 @@ default-value-8
(store-stack-tn nfp-save cur-nfp))
(let ((callee-nfp (callee-nfp-tn callee)))
(when callee-nfp
(move nfp callee-nfp)))
(maybe-load-stack-tn nfp callee-nfp)))
(maybe-load-stack-tn cfp-tn cfp)
(inst compute-lra-from-code code-tn label temp
(callee-return-pc-tn callee))
......@@ -1227,6 +1227,8 @@ default-value-8
c::%argument-count-error nargs)
(frob type-check-error object-not-type-error c::%type-check-error
object type)
(frob layout-invalid-error layout-invalid-error c::%layout-invalid-error
object layout)
(frob odd-keyword-arguments-error odd-keyword-arguments-error
c::%odd-keyword-arguments-error)
(frob unknown-keyword-argument-error unknown-keyword-argument-error
......
......@@ -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.3 1993/01/15 01:33:53 wlott Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/hppa/cell.lisp,v 1.4 1993/03/01 14:59:55 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -222,35 +222,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 res)))
(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)
......
......@@ -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/parms.lisp,v 1.2 1992/10/13 13:17:01 wlott Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/hppa/parms.lisp,v 1.3 1993/03/01 14:59:56 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -31,7 +31,7 @@
(setf (backend-fasl-file-type *target-backend*) "hpf")
(setf (backend-fasl-file-implementation *target-backend*)
hppa-fasl-file-implementation)
(setf (backend-fasl-file-version *target-backend*) 1)
(setf (backend-fasl-file-version *target-backend*) 2)
(setf (backend-register-save-penalty *target-backend*) 3)
(setf (backend-byte-order *target-backend*) :big-endian)
(setf (backend-page-size *target-backend*) 4096)
......
......@@ -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/type-vops.lisp,v 1.2 1992/10/28 16:13:11 wlott Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/hppa/type-vops.lisp,v 1.3 1993/03/01 14:59:57 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -227,8 +227,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)
......
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