X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Fsubprim.lisp;h=b3185d151829ce37eafd2b624ce748826b918e81;hb=aa7b669779e8e88349938ca962229f31ead08af2;hp=82ddcf1a4fec685d859fef0c56c2cb2c55e2d085;hpb=dfa55a883f94470267b626dae77ce7e7dfac3df6;p=sbcl.git diff --git a/src/compiler/alpha/subprim.lisp b/src/compiler/alpha/subprim.lisp index 82ddcf1..b3185d1 100644 --- a/src/compiler/alpha/subprim.lisp +++ b/src/compiler/alpha/subprim.lisp @@ -1,24 +1,17 @@ -;;; -*- Package: ALPHA; Log: C.Log -*- -;;; -;;; ********************************************************************** -;;; This code was written as part of the CMU Common Lisp project at -;;; Carnegie Mellon University, and has been placed in the public domain. -;;; - -;;; -;;; ********************************************************************** -;;; -;;; Linkage information for standard static functions, and random vops. -;;; -;;; Written by William Lott. -;;; Converted by Sean Hallgren. -;;; -(in-package "SB!VM") - +;;;; linkage information for standard static functions, and random vops +;;;; 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") -;;;; Length +;;;; LENGTH (define-vop (length/list) (:translate length) @@ -27,7 +20,7 @@ (:temporary (:scs (descriptor-reg) :from (:argument 0)) ptr) (:temporary (:scs (non-descriptor-reg)) temp) (:temporary (:scs (any-reg) :type fixnum :to (:result 0) :target result) - count) + count) (:results (result :scs (any-reg descriptor-reg))) (:policy :fast-safe) (:vop-var vop) @@ -35,28 +28,24 @@ (:generator 50 (move object ptr) (move zero-tn count) - + LOOP - + (inst cmpeq ptr null-tn temp) (inst bne temp done) - + (inst and ptr lowtag-mask temp) - (inst xor temp list-pointer-type temp) + (inst xor temp list-pointer-lowtag temp) (inst bne temp not-list) - - (loadw ptr ptr cons-cdr-slot list-pointer-type) + + (loadw ptr ptr cons-cdr-slot list-pointer-lowtag) (inst addq count (fixnumize 1) count) (inst br zero-tn loop) - + NOT-LIST (cerror-call vop done object-not-list-error ptr) - + DONE (move count result))) - - -(define-static-function length (object) :translate length) - - +(define-static-fun length (object) :translate length)