From 83d7a858dd89b26b795fd7f1160efd9e6fe9ea7f Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Thu, 14 Apr 2016 19:57:11 -0400 Subject: [PATCH] Raw slot interleaving on Alpha + 2 bugfixes. 1. build was broken due to a duplicate defun 2. SAP-REF-DOUBLE was broken since forever ago and failure was exposed by tests for #!+interleaved-raw-slots. The 1.0.28 release binary shows the behavior: * (sb-sys:sap-ref-double (sb-sys:int-sap (sb-kernel:get-lisp-obj-address pi)) 1) 3.141592653589793d0 * ((lambda () (sb-sys:sap-ref-double (sb-sys:int-sap (sb-kernel:get-lisp-obj-address pi)) 1))) 3.523839999645837d-312 --- NEWS | 2 +- make-config.sh | 2 +- src/compiler/alpha/cell.lisp | 80 ++++++------------------------------------- src/compiler/alpha/insts.lisp | 27 --------------- src/compiler/alpha/sap.lisp | 5 +-- 5 files changed, 13 insertions(+), 103 deletions(-) diff --git a/NEWS b/NEWS index 32d73971d..72481882a 100644 --- a/NEWS +++ b/NEWS @@ -5,7 +5,7 @@ changes relative to sbcl-1.3.4: * enhancement: speed up debug info creation for highly nested functions. (lp#1563355) * enhancement: the interleaved structure slot optimization from - release 1.2.6 has been ported to 32-bit ARM and MIPS. + release 1.2.6 has been ported to Alpha, 32-bit ARM and MIPS. * bug fix: better wording in missed optimization note. (lp#1003265) * bug fix: interpreted (CAS SVREF) was broken * bug fix: support CLISP as build host for ARM (lp#1568256, thanks to Tomas diff --git a/make-config.sh b/make-config.sh index ef17883ca..00711a784 100755 --- a/make-config.sh +++ b/make-config.sh @@ -717,7 +717,7 @@ elif [ "$sbcl_arch" = "sparc" ]; then printf ' :stack-allocatable-closures :stack-allocatable-lists' >> $ltf printf ' :interleaved-raw-slots' >> $ltf elif [ "$sbcl_arch" = "alpha" ]; then - printf ' :cheneygc' >> $ltf + printf ' :cheneygc :interleaved-raw-slots' >> $ltf printf ' :64-bit-registers' >> $ltf printf ' :stack-allocatable-closures :stack-allocatable-lists' >> $ltf printf ' :stack-allocatable-fixed-objects' >> $ltf diff --git a/src/compiler/alpha/cell.lisp b/src/compiler/alpha/cell.lisp index 8039849a6..bcb0b2527 100644 --- a/src/compiler/alpha/cell.lisp +++ b/src/compiler/alpha/cell.lisp @@ -407,16 +407,10 @@ (index :scs (any-reg))) (:arg-types * positive-fixnum) (:results (value :scs (unsigned-reg))) - (:temporary (:scs (non-descriptor-reg)) offset) (:temporary (:scs (interior-reg)) lip) (:result-types unsigned-num) (:generator 5 - (loadw offset object 0 instance-pointer-lowtag) - (inst srl offset n-widetag-bits offset) - (inst sll offset 2 offset) - (inst subq offset index offset) - (inst subq offset n-word-bytes offset) - (inst addq object offset lip) + (inst addq object index lip) (inst ldl value (- (* instance-slots-offset n-word-bytes) @@ -432,16 +426,10 @@ (value :scs (unsigned-reg))) (:arg-types * positive-fixnum unsigned-num) (:results (result :scs (unsigned-reg))) - (:temporary (:scs (non-descriptor-reg)) offset) (:temporary (:scs (interior-reg)) lip) (:result-types unsigned-num) (:generator 5 - (loadw offset object 0 instance-pointer-lowtag) - (inst srl offset n-widetag-bits offset) - (inst sll offset 2 offset) - (inst subq offset index offset) - (inst subq offset n-word-bytes offset) - (inst addq object offset lip) + (inst addq object index lip) (inst stl value (- (* instance-slots-offset n-word-bytes) @@ -456,16 +444,10 @@ (index :scs (any-reg))) (:arg-types * positive-fixnum) (:results (value :scs (single-reg))) - (:temporary (:scs (non-descriptor-reg)) offset) (:temporary (:scs (interior-reg)) lip) (:result-types single-float) (:generator 5 - (loadw offset object 0 instance-pointer-lowtag) - (inst srl offset n-widetag-bits offset) - (inst sll offset 2 offset) - (inst subq offset index offset) - (inst subq offset n-word-bytes offset) - (inst addq object offset lip) + (inst addq object index lip) (inst lds value (- (* instance-slots-offset n-word-bytes) @@ -480,16 +462,10 @@ (value :scs (single-reg))) (:arg-types * positive-fixnum single-float) (:results (result :scs (single-reg))) - (:temporary (:scs (non-descriptor-reg)) offset) (:temporary (:scs (interior-reg)) lip) (:result-types single-float) (:generator 5 - (loadw offset object 0 instance-pointer-lowtag) - (inst srl offset n-widetag-bits offset) - (inst sll offset 2 offset) - (inst subq offset index offset) - (inst subq offset n-word-bytes offset) - (inst addq object offset lip) + (inst addq object index lip) (inst sts value (- (* instance-slots-offset n-word-bytes) @@ -505,16 +481,10 @@ (index :scs (any-reg))) (:arg-types * positive-fixnum) (:results (value :scs (double-reg))) - (:temporary (:scs (non-descriptor-reg)) offset) (:temporary (:scs (interior-reg)) lip) (:result-types double-float) (:generator 5 - (loadw offset object 0 instance-pointer-lowtag) - (inst srl offset n-widetag-bits offset) - (inst sll offset 2 offset) - (inst subq offset index offset) - (inst subq offset (* 2 n-word-bytes) offset) - (inst addq object offset lip) + (inst addq object index lip) (inst ldt value (- (* instance-slots-offset n-word-bytes) @@ -529,16 +499,10 @@ (value :scs (double-reg))) (:arg-types * positive-fixnum double-float) (:results (result :scs (double-reg))) - (:temporary (:scs (non-descriptor-reg)) offset) (:temporary (:scs (interior-reg)) lip) (:result-types double-float) (:generator 5 - (loadw offset object 0 instance-pointer-lowtag) - (inst srl offset n-widetag-bits offset) - (inst sll offset 2 offset) - (inst subq offset index offset) - (inst subq offset (* 2 n-word-bytes) offset) - (inst addq object offset lip) + (inst addq object index lip) (inst stt value (- (* instance-slots-offset n-word-bytes) @@ -554,16 +518,10 @@ (index :scs (any-reg))) (:arg-types * positive-fixnum) (:results (value :scs (complex-single-reg))) - (:temporary (:scs (non-descriptor-reg)) offset) (:temporary (:scs (interior-reg)) lip) (:result-types complex-single-float) (:generator 5 - (loadw offset object 0 instance-pointer-lowtag) - (inst srl offset n-widetag-bits offset) - (inst sll offset 2 offset) - (inst subq offset index offset) - (inst subq offset (* 2 n-word-bytes) offset) - (inst addq object offset lip) + (inst addq object index lip) (inst lds (complex-double-reg-real-tn value) (- (* instance-slots-offset n-word-bytes) @@ -583,16 +541,10 @@ (value :scs (complex-single-reg))) (:arg-types * positive-fixnum complex-single-float) (:results (result :scs (complex-single-reg))) - (:temporary (:scs (non-descriptor-reg)) offset) (:temporary (:scs (interior-reg)) lip) (:result-types complex-single-float) (:generator 5 - (loadw offset object 0 instance-pointer-lowtag) - (inst srl offset n-widetag-bits offset) - (inst sll offset 2 offset) - (inst subq offset index offset) - (inst subq offset (* 2 n-word-bytes) offset) - (inst addq object offset lip) + (inst addq object index lip) (let ((value-real (complex-single-reg-real-tn value)) (result-real (complex-single-reg-real-tn result))) (inst sts @@ -619,16 +571,10 @@ (index :scs (any-reg))) (:arg-types * positive-fixnum) (:results (value :scs (complex-double-reg))) - (:temporary (:scs (non-descriptor-reg)) offset) (:temporary (:scs (interior-reg)) lip) (:result-types complex-double-float) (:generator 5 - (loadw offset object 0 instance-pointer-lowtag) - (inst srl offset n-widetag-bits offset) - (inst sll offset 2 offset) - (inst subq offset index offset) - (inst subq offset (* 4 n-word-bytes) offset) - (inst addq object offset lip) + (inst addq object index lip) (inst ldt (complex-double-reg-real-tn value) (- (* instance-slots-offset n-word-bytes) @@ -648,16 +594,10 @@ (value :scs (complex-double-reg))) (:arg-types * positive-fixnum complex-double-float) (:results (result :scs (complex-double-reg))) - (:temporary (:scs (non-descriptor-reg)) offset) (:temporary (:scs (interior-reg)) lip) (:result-types complex-double-float) (:generator 5 - (loadw offset object 0 instance-pointer-lowtag) - (inst srl offset n-widetag-bits offset) - (inst sll offset 2 offset) - (inst subq offset index offset) - (inst subq offset (* 4 n-word-bytes) offset) - (inst addq object offset lip) + (inst addq object index lip) (let ((value-real (complex-double-reg-real-tn value)) (result-real (complex-double-reg-real-tn result))) (inst stt diff --git a/src/compiler/alpha/insts.lisp b/src/compiler/alpha/insts.lisp index e040e0400..ca4493c37 100644 --- a/src/compiler/alpha/insts.lisp +++ b/src/compiler/alpha/insts.lisp @@ -480,33 +480,6 @@ (define-instruction imb (segment) (:emitter (emit-lword segment #x00000086))) -(defun snarf-error-junk (sap offset &optional length-only) - (let* ((length (sap-ref-8 sap offset)) - (vector (make-array length :element-type '(unsigned-byte 8)))) - (declare (type system-area-pointer sap) - (type (unsigned-byte 8) length) - (type (simple-array (unsigned-byte 8) (*)) vector)) - (cond (length-only - (values 0 (1+ length) nil nil)) - (t - (copy-ub8-from-system-area sap (1+ offset) vector 0 length) - (collect ((sc-offsets) - (lengths)) - (lengths 1) ; the length byte - (let* ((index 0) - (error-number (read-var-integer vector index))) - (lengths index) - (loop - (when (>= index length) - (return)) - (let ((old-index index)) - (sc-offsets (read-var-integer vector index)) - (lengths (- index old-index)))) - (values error-number - (1+ length) - (sc-offsets) - (lengths)))))))) - (defun bugchk-trap-control (chunk inst stream dstate) (declare (ignore inst)) (flet ((nt (x) (if stream (note x dstate)))) diff --git a/src/compiler/alpha/sap.lisp b/src/compiler/alpha/sap.lisp index a46db40e7..6da873b79 100644 --- a/src/compiler/alpha/sap.lisp +++ b/src/compiler/alpha/sap.lisp @@ -219,10 +219,7 @@ (:single '((inst lds result offset object))) (:double - '((inst ldt - result - (+ offset n-word-bytes) - object)))))) + '((inst ldt result offset object)))))) (define-vop (,set-name) (:translate ,set-name) (:policy :fast-safe) -- 2.11.4.GIT