array.lisp 4.42 KB
Newer Older
cwang's avatar
cwang committed
1 2 3 4 5 6 7 8 9
;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Package: x86 -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of CMU Common Lisp, please contact
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
10
 "$Header: src/assembly/amd64/array.lisp $")
cwang's avatar
cwang committed
11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34
;;;
;;; **********************************************************************
;;;
;;; This file contains various array operations that are too expensive
;;; (in space) to do inline.
;;;
;;; Written by William Lott.
;;;
;;; Debugged by Paul F. Werkowski -- Spring 1995.
;;;
(in-package :amd64)


;;;; Allocation

(define-assembly-routine (allocate-vector
			  (:policy :fast-safe)
			  (:translate allocate-vector)
			  (:arg-types positive-fixnum
				      positive-fixnum
				      positive-fixnum))
			 ((:arg type unsigned-reg rax-offset)
			  (:arg length any-reg rbx-offset)
			  (:arg words any-reg rcx-offset)
35
			  (:temp temp any-reg r11-offset)
cwang's avatar
cwang committed
36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
			  (:res result descriptor-reg rdx-offset))
  ;; compute the number of bytes
  ;; words is a fixnum
  (inst lea result (make-ea :byte :base words :index words :disp
			    (+ 15 (* vector-data-offset word-bytes))))
  (inst and result (lognot 15)) ; alignment
  (pseudo-atomic
   (allocation result result temp)
   (inst lea result (make-ea :byte :base result :disp other-pointer-type))
   (storew type result 0 other-pointer-type)
   (storew length result vector-length-slot other-pointer-type))
  (inst ret))



;;;; Hash primitives

(define-assembly-routine (sxhash-simple-string
			  (:translate %sxhash-simple-string)
			  (:policy :fast-safe)
			  (:result-types positive-fixnum))
			 ((:arg string descriptor-reg rbx-offset)
			  (:res result any-reg rdx-offset)

			  (:temp length any-reg rdi-offset)
			  (:temp rsi unsigned-reg rsi-offset)
			  (:temp rcx unsigned-reg rcx-offset)
			  (:temp rax unsigned-reg rax-offset))
  (declare (ignore result rsi rcx rax))
  (loadw length string vector-length-slot other-pointer-type)
  (inst jmp (make-fixup 'sxhash-simple-substring :assembly-routine)))

(define-assembly-routine (sxhash-simple-substring
			  (:translate %sxhash-simple-substring)
			  (:policy :fast-safe)
			  (:arg-types * positive-fixnum)
			  (:result-types positive-fixnum))
			 ((:arg string descriptor-reg rbx-offset)
			  (:arg length any-reg rdi-offset)
			  (:res result any-reg rdx-offset)

			  (:temp rsi unsigned-reg rsi-offset)
			  (:temp rcx unsigned-reg rcx-offset)
			  (:temp rax unsigned-reg rax-offset))
  ;; Compute a pointer to where we are going to be extracting the bits.
  (inst lea rsi	(make-ea :byte :base string
			 :disp (- (* vector-data-offset word-bytes)
				  other-pointer-type)))
  ;; Initialize the result.
  (inst xor result result)
  ;; Get the count.  If it's zero, blow out.
  (inst mov rcx length)
cwang's avatar
cwang committed
88
  (inst jrcxz done)
cwang's avatar
cwang committed
89 90 91
  ;; Convert it into count of the number of full words.  If zero, then skip
  ;; to the part that handles the tail.
  (inst shr rcx 5) ; 2 tag bits + 3
cwang's avatar
cwang committed
92
  (inst jrcxz do-extra)
cwang's avatar
cwang committed
93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109
  ;; Clear the direction flag, so we advance through memory.
  (inst cld)

  LOOP
  ;; Merge each successive word with the result.
  (inst lods rax)			; load 64-bits into rax and (+8 rsi)

  (inst rol result 5)
  (inst xor result rax)
  (inst loop loop)

  DO-EXTRA
  ;; Now we have to take care of any bytes that don't make up a full word.
  ;; First, check to see how many of them there are.  If zero, blow out of
  ;; here.  Otherwise, multiply by 8.
  (inst mov rcx length)
  (inst and rcx (fixnumize 7))
cwang's avatar
cwang committed
110
  (inst jrcxz done)
cwang's avatar
cwang committed
111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135
  ;; some bytes are left
  (inst shl rcx 1)

  ;; Grab the last word.
  (inst lods rax)

  ;; Convert the count into a mask.  The count is multiplied by 8, so we just
  ;; shift -1 left, which shifts count*8 zeros into the low order end.  We
  ;; then invert that, ending up with a mask of count*8 ones.
  (inst mov rsi -1)
  (inst shl rsi :cl)
  (inst not rsi)
  ;; Use the mask to strip off the bits we arn't interested in, and merge
  ;; the remaining bits with the result.
  (inst and rax rsi)
  (inst rol result 5)
  (inst xor result rax)

  DONE

  ;; Force result to be a 32-bit positive fixnum because hash-vector is a
  ;; 32-bit vector. This hash function is not good. We need to use the
  ;; upper half of the word and change the hash-vector.
  (inst and result #x7ffffffc)
  (inst ret))