X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fassembly%2Falpha%2Farray.lisp;h=f1aefb69d624db3e0b2b355b00c60b4b399df3b6;hb=37b1ed8e9b6faa84832b8251998b5d0eb1f6b307;hp=1ab3057798542d1420d117326b38a059b9532c24;hpb=dfa55a883f94470267b626dae77ce7e7dfac3df6;p=sbcl.git diff --git a/src/assembly/alpha/array.lisp b/src/assembly/alpha/array.lisp index 1ab3057..f1aefb6 100644 --- a/src/assembly/alpha/array.lisp +++ b/src/assembly/alpha/array.lisp @@ -1,96 +1,92 @@ -;;; -*- Package: ALPHA -*- -;;; -;;; ********************************************************************** -;;; This code was written as part of the CMU Common Lisp project at -;;; Carnegie Mellon University, and has been placed in the public domain. -;;; -;;; -;;; ********************************************************************** -;;; -;;; This file contains the support routines for arrays and vectors. -;;; -;;; Written by William Lott. -;;; Conversion by Sean Hallgren -;;; +;;;; support routines for arrays and vectors + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + (in-package "SB!VM") (define-assembly-routine (allocate-vector - (:policy :fast-safe) - (:translate allocate-vector) - (:arg-types positive-fixnum - positive-fixnum - positive-fixnum)) - ((:arg type any-reg a0-offset) - (:arg length any-reg a1-offset) - (:arg words any-reg a2-offset) - (:res result descriptor-reg a0-offset) - - (:temp ndescr non-descriptor-reg nl0-offset)) + (:policy :fast-safe) + (:translate allocate-vector) + (:arg-types positive-fixnum + positive-fixnum + positive-fixnum)) + ((:arg type any-reg a0-offset) + (:arg length any-reg a1-offset) + (:arg words any-reg a2-offset) + (:res result descriptor-reg a0-offset) + + (:temp ndescr non-descriptor-reg nl0-offset)) ;; This is kinda sleezy, changing words like this. But we can because ;; the vop thinks it is temporary. - (inst addq words (+ (1- (ash 1 lowtag-bits)) - (* vector-data-offset word-bytes)) - words) + (inst addq words (+ (1- (ash 1 n-lowtag-bits)) + (* vector-data-offset n-word-bytes)) + words) (inst li (lognot lowtag-mask) ndescr) (inst and words ndescr words) (inst srl type word-shift ndescr) (pseudo-atomic () - (inst bis alloc-tn other-pointer-type result) + (inst bis alloc-tn other-pointer-lowtag result) (inst addq alloc-tn words alloc-tn) - (storew ndescr result 0 other-pointer-type) - (storew length result vector-length-slot other-pointer-type))) - + (storew ndescr result 0 other-pointer-lowtag) + (storew length result vector-length-slot other-pointer-lowtag))) -;;;; Hash primitives +;;;; hash primitives #| (define-assembly-routine (sxhash-simple-string - (:translate %sxhash-simple-string) - (:policy :fast-safe) - (:result-types positive-fixnum)) - ((:arg string descriptor-reg a0-offset) - (:res result any-reg a0-offset) + (:translate %sxhash-simple-string) + (:policy :fast-safe) + (:result-types positive-fixnum)) + ((:arg string descriptor-reg a0-offset) + (:res result any-reg a0-offset) - (:temp length any-reg a1-offset) + (:temp length any-reg a1-offset) - (:temp lip interior-reg lip-offset) - (:temp accum non-descriptor-reg nl0-offset) - (:temp data non-descriptor-reg nl1-offset) - (:temp byte non-descriptor-reg nl2-offset) - (:temp retaddr non-descriptor-reg nl3-offset) - (:temp temp1 non-descriptor-reg nl4-offset)) + (:temp lip interior-reg lip-offset) + (:temp accum non-descriptor-reg nl0-offset) + (:temp data non-descriptor-reg nl1-offset) + (:temp byte non-descriptor-reg nl2-offset) + (:temp retaddr non-descriptor-reg nl3-offset) + (:temp temp1 non-descriptor-reg nl4-offset)) ;; These are needed after we jump into sxhash-simple-substring. (progn result lip accum data byte retaddr) (inst li (make-fixup 'sxhash-simple-substring :assembly-routine) temp1) - (loadw length string vector-length-slot other-pointer-type) + (loadw length string vector-length-slot other-pointer-lowtag) (inst jmp zero-tn temp1 - (make-fixup 'sxhash-simple-substring :assembly-routine))) + (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 a0-offset) - (:arg length any-reg a1-offset) - (:res result any-reg a0-offset) - - (:temp lip interior-reg lip-offset) - (:temp accum non-descriptor-reg nl0-offset) - (:temp data non-descriptor-reg nl1-offset) - (:temp byte non-descriptor-reg nl2-offset) - (:temp retaddr non-descriptor-reg nl3-offset)) + (:translate %sxhash-simple-substring) + (:policy :fast-safe) + (:arg-types * positive-fixnum) + (:result-types positive-fixnum)) + ((:arg string descriptor-reg a0-offset) + (:arg length any-reg a1-offset) + (:res result any-reg a0-offset) + + (:temp lip interior-reg lip-offset) + (:temp accum non-descriptor-reg nl0-offset) + (:temp data non-descriptor-reg nl1-offset) + (:temp byte non-descriptor-reg nl2-offset) + (:temp retaddr non-descriptor-reg nl3-offset)) ;; Save the return address (inst subq lip code-tn retaddr) ;; Get a pointer to the data. (inst addq string - (- (* vector-data-offset word-bytes) other-pointer-type) - lip) + (- (* vector-data-offset n-word-bytes) other-pointer-lowtag) + lip) (move zero-tn accum) (inst br zero-tn test)