Skip to content
Snippets Groups Projects
Commit 824b7e1e authored by pw's avatar pw
Browse files

initial post 1.3.7 merge

parent 5ced0fdf
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/x86/arith.lisp,v 1.1 1997/01/18 14:31:24 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/arith.lisp,v 1.2 1997/02/05 15:34:11 pw Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -779,18 +779,20 @@ ...@@ -779,18 +779,20 @@
(def-source-transform 32bit-logical-andc2 (x y) (def-source-transform 32bit-logical-andc2 (x y)
`(32bit-logical-and ,x (32bit-logical-not ,y))) `(32bit-logical-and ,x (32bit-logical-not ,y)))
;;; Only the lower 5 bits of the shift amount are significant.
(define-vop (shift-towards-someplace) (define-vop (shift-towards-someplace)
(:policy :fast-safe) (:policy :fast-safe)
(:args (num :scs (unsigned-reg) :target r) (:args (num :scs (unsigned-reg) :target r)
(amount :scs (unsigned-reg signed-reg) :target ecx)) (amount :scs (signed-reg) :target ecx))
(:arg-types unsigned-num positive-fixnum) (:arg-types unsigned-num tagged-num)
(:temporary (:sc dword-reg :offset ecx-offset :from (:argument 1)) ecx) (:temporary (:sc dword-reg :offset ecx-offset :from (:argument 1)) ecx)
(:results (r :scs (unsigned-reg))) (:results (r :scs (unsigned-reg) :from (:argument 0)))
(:result-types unsigned-num)) (:result-types unsigned-num))
(define-vop (shift-towards-start shift-towards-someplace) (define-vop (shift-towards-start shift-towards-someplace)
(:translate shift-towards-start) (:translate shift-towards-start)
(:note "SHIFT-TOWARDS-START")
(:generator 1 (:generator 1
(move r num) (move r num)
(move ecx amount) (move ecx amount)
...@@ -798,12 +800,12 @@ ...@@ -798,12 +800,12 @@
(define-vop (shift-towards-end shift-towards-someplace) (define-vop (shift-towards-end shift-towards-someplace)
(:translate shift-towards-end) (:translate shift-towards-end)
(:note "SHIFT-TOWARDS-END")
(:generator 1 (:generator 1
(move r num) (move r num)
(move ecx amount) (move ecx amount)
(inst shl r :cl))) (inst shl r :cl)))
;;;; Bignum stuff. ;;;; Bignum stuff.
......
...@@ -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/x86/array.lisp,v 1.1 1997/01/18 14:31:24 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.2 1997/02/05 15:34:13 pw Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -16,6 +16,7 @@ ...@@ -16,6 +16,7 @@
;;; Written by William Lott ;;; Written by William Lott
;;; ;;;
;;; Debugged by Paul F. Werkowski Spring/Summer 1995. ;;; Debugged by Paul F. Werkowski Spring/Summer 1995.
;;; Enhancements/debugging by Douglas T. Crosher 1996,1997.
;;; ;;;
(in-package :x86) (in-package :x86)
...@@ -296,6 +297,22 @@ ...@@ -296,6 +297,22 @@
:disp (- (* vm:vector-data-offset vm:word-bytes) :disp (- (* vm:vector-data-offset vm:word-bytes)
vm:other-pointer-type)))))) vm:other-pointer-type))))))
(define-vop (data-vector-ref-c/simple-array-single-float)
(:note "inline array access")
(:translate data-vector-ref)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg)))
(:info index)
(:arg-types simple-array-single-float (:constant (signed-byte 30)))
(:results (value :scs (single-reg)))
(:result-types single-float)
(:generator 4
(with-empty-tn@fp-top(value)
(inst fld (make-ea :dword :base object
:disp (- (+ (* vm:vector-data-offset vm:word-bytes)
(* 4 index))
vm:other-pointer-type))))))
(define-vop (data-vector-set/simple-array-single-float) (define-vop (data-vector-set/simple-array-single-float)
(:note "inline array store") (:note "inline array store")
(:translate data-vector-set) (:translate data-vector-set)
...@@ -307,29 +324,67 @@ ...@@ -307,29 +324,67 @@
(:results (result :scs (single-reg))) (:results (result :scs (single-reg)))
(:result-types single-float) (:result-types single-float)
(:generator 5 (:generator 5
(if (zerop (tn-offset value)) (cond ((zerop (tn-offset value))
(progn ;; Value is in ST0
;; Value is in ST0 (inst fst (make-ea :dword :base object :index index :scale 1
(inst fst (make-ea :dword :base object :index index :scale 1 :disp (- (* vm:vector-data-offset vm:word-bytes)
:disp (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type)))
vm:other-pointer-type))) (unless (zerop (tn-offset result))
(unless (zerop (tn-offset result)) ;; Value is in ST0 but not result.
;; Value is in ST0 but not result. (inst fst result)))
(inst fst result))) (t
(progn ;; Value is not in ST0.
;; Value is not in ST0. (inst fxch value)
(inst fxch value) (inst fst (make-ea :dword :base object :index index :scale 1
(inst fst (make-ea :dword :base object :index index :scale 1 :disp (- (* vm:vector-data-offset vm:word-bytes)
:disp (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type)))
vm:other-pointer-type))) (cond ((zerop (tn-offset result))
(if (zerop (tn-offset result)) ;; The result is in ST0.
;; The result is in ST0. (inst fst value))
(inst fst value) (t
(progn ;; Neither value or result are in ST0
;; Neither value or result are in ST0 (unless (location= value result)
(unless (location= value result) (inst fst result))
(inst fst result)) (inst fxch value)))))))
(inst fxch value)))))))
(define-vop (data-vector-set-c/simple-array-single-float)
(:note "inline array store")
(:translate data-vector-set)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(value :scs (single-reg) :target result))
(:info index)
(:arg-types simple-array-single-float (:constant (signed-byte 30))
single-float)
(:results (result :scs (single-reg)))
(:result-types single-float)
(:generator 4
(cond ((zerop (tn-offset value))
;; Value is in ST0
(inst fst (make-ea :dword :base object
:disp (- (+ (* vm:vector-data-offset
vm:word-bytes)
(* 4 index))
vm:other-pointer-type)))
(unless (zerop (tn-offset result))
;; Value is in ST0 but not result.
(inst fst result)))
(t
;; Value is not in ST0.
(inst fxch value)
(inst fst (make-ea :dword :base object
:disp (- (+ (* vm:vector-data-offset
vm:word-bytes)
(* 4 index))
vm:other-pointer-type)))
(cond ((zerop (tn-offset result))
;; The result is in ST0.
(inst fst value))
(t
;; Neither value or result are in ST0
(unless (location= value result)
(inst fst result))
(inst fxch value)))))))
(define-vop (data-vector-ref/simple-array-double-float) (define-vop (data-vector-ref/simple-array-double-float)
(:note "inline array access") (:note "inline array access")
...@@ -346,6 +401,22 @@ ...@@ -346,6 +401,22 @@
:disp (- (* vm:vector-data-offset vm:word-bytes) :disp (- (* vm:vector-data-offset vm:word-bytes)
vm:other-pointer-type)))))) vm:other-pointer-type))))))
(define-vop (data-vector-ref-c/simple-array-double-float)
(:note "inline array access")
(:translate data-vector-ref)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg)))
(:info index)
(:arg-types simple-array-double-float (:constant (signed-byte 30)))
(:results (value :scs (double-reg)))
(:result-types double-float)
(:generator 6
(with-empty-tn@fp-top(value)
(inst fldd (make-ea :dword :base object
:disp (- (+ (* vm:vector-data-offset vm:word-bytes)
(* 8 index))
vm:other-pointer-type))))))
(define-vop (data-vector-set/simple-array-double-float) (define-vop (data-vector-set/simple-array-double-float)
(:note "inline array store") (:note "inline array store")
(:translate data-vector-set) (:translate data-vector-set)
...@@ -357,49 +428,102 @@ ...@@ -357,49 +428,102 @@
(:results (result :scs (double-reg))) (:results (result :scs (double-reg)))
(:result-types double-float) (:result-types double-float)
(:generator 20 (:generator 20
(if (zerop (tn-offset value)) (cond ((zerop (tn-offset value))
(progn ;; Value is in ST0
;; Value is in ST0 (inst fstd (make-ea :dword :base object :index index :scale 2
(inst fstd (make-ea :dword :base object :index index :scale 2 :disp (- (* vm:vector-data-offset vm:word-bytes)
:disp (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type)))
vm:other-pointer-type))) (unless (zerop (tn-offset result))
(unless (zerop (tn-offset result)) ;; Value is in ST0 but not result.
;; Value is in ST0 but not result. (inst fstd result)))
(inst fstd result))) (t
(progn ;; Value is not in ST0.
;; Value is not in ST0. (inst fxch value)
(inst fxch value) (inst fstd (make-ea :dword :base object :index index :scale 2
(inst fstd (make-ea :dword :base object :index index :scale 2 :disp (- (* vm:vector-data-offset vm:word-bytes)
:disp (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type)))
vm:other-pointer-type))) (cond ((zerop (tn-offset result))
(if (zerop (tn-offset result)) ;; The result is in ST0.
;; The result is in ST0. (inst fstd value))
(inst fstd value) (t
(progn ;; Neither value or result are in ST0
;; Neither value or result are in ST0 (unless (location= value result)
(unless (location= value result) (inst fstd result))
(inst fstd result)) (inst fxch value)))))))
(inst fxch value)))))))
(define-vop (data-vector-set-c/simple-array-double-float)
(:note "inline array store")
(:translate data-vector-set)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(value :scs (double-reg) :target result))
(:info index)
(:arg-types simple-array-double-float (:constant (signed-byte 30))
double-float)
(:results (result :scs (double-reg)))
(:result-types double-float)
(:generator 19
(cond ((zerop (tn-offset value))
;; Value is in ST0
(inst fstd (make-ea :dword :base object
:disp (- (+ (* vm:vector-data-offset
vm:word-bytes)
(* 8 index))
vm:other-pointer-type)))
(unless (zerop (tn-offset result))
;; Value is in ST0 but not result.
(inst fstd result)))
(t
;; Value is not in ST0.
(inst fxch value)
(inst fstd (make-ea :dword :base object
:disp (- (+ (* vm:vector-data-offset
vm:word-bytes)
(* 8 index))
vm:other-pointer-type)))
(cond ((zerop (tn-offset result))
;; The result is in ST0.
(inst fstd value))
(t
;; Neither value or result are in ST0
(unless (location= value result)
(inst fstd result))
(inst fxch value)))))))
;;; These VOPs are used for implementing float slots in structures (whose raw ;;; These VOPs are used for implementing float slots in structures (whose raw
;;; data is an unsigned-32 vector. ;;; data is an unsigned-32 vector.
;;; pfw-copied from hppa ;;;
(define-vop (raw-ref-single data-vector-ref/simple-array-single-float) (define-vop (raw-ref-single data-vector-ref/simple-array-single-float)
(:translate %raw-ref-single) (:translate %raw-ref-single)
(:arg-types simple-array-unsigned-byte-32 positive-fixnum)) (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
(define-vop (raw-ref-single-c data-vector-ref-c/simple-array-single-float)
(:translate %raw-ref-single)
(:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))))
;;; ;;;
(define-vop (raw-set-single data-vector-set/simple-array-single-float) (define-vop (raw-set-single data-vector-set/simple-array-single-float)
(:translate %raw-set-single) (:translate %raw-set-single)
(:arg-types simple-array-unsigned-byte-32 positive-fixnum single-float)) (:arg-types simple-array-unsigned-byte-32 positive-fixnum single-float))
(define-vop (raw-set-single-c data-vector-set-c/simple-array-single-float)
(:translate %raw-set-single)
(:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))
single-float))
;;; ;;;
(define-vop (raw-ref-double data-vector-ref/simple-array-double-float) (define-vop (raw-ref-double data-vector-ref/simple-array-double-float)
(:translate %raw-ref-double) (:translate %raw-ref-double)
(:arg-types simple-array-unsigned-byte-32 positive-fixnum)) (:arg-types simple-array-unsigned-byte-32 positive-fixnum))
(define-vop (raw-ref-double-c data-vector-ref-c/simple-array-double-float)
(:translate %raw-ref-double)
(:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))))
;;; ;;;
(define-vop (raw-set-double data-vector-set/simple-array-double-float) (define-vop (raw-set-double data-vector-set/simple-array-double-float)
(:translate %raw-set-double) (:translate %raw-set-double)
(:arg-types simple-array-unsigned-byte-32 positive-fixnum double-float)) (:arg-types simple-array-unsigned-byte-32 positive-fixnum double-float))
(define-vop (raw-set-double-c data-vector-set-c/simple-array-double-float)
(:translate %raw-set-double)
(:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30))
double-float))
;;; These vops are useful for accessing the bits of a vector irrespective of ;;; These vops are useful for accessing the bits of a vector irrespective of
...@@ -483,7 +607,8 @@ ...@@ -483,7 +607,8 @@
(value :scs (unsigned-reg unsigned-stack signed-reg signed-stack) (value :scs (unsigned-reg unsigned-stack signed-reg signed-stack)
:target eax)) :target eax))
(:info index) (:info index)
(:arg-types simple-array-unsigned-byte-8 (:constant (signed-byte 30)) positive-fixnum) (:arg-types simple-array-unsigned-byte-8 (:constant (signed-byte 30))
positive-fixnum)
(:temporary (:sc dword-reg :offset eax-offset :target result (:temporary (:sc dword-reg :offset eax-offset :target result
:from (:argument 1) :to (:result 0)) :from (:argument 1) :to (:result 0))
eax) eax)
......
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