The CMU CL garbage collector was credited to "Christopher Hoover,
Rob MacLachlan, Dave McDonald, et al." in the CMU CL code/gc.lisp file,
with some extra code for the MIPS port credited to Christopher Hoover
-alone.
+alone. The credits on the original "gc.c", "Stop and Copy GC based
+on Cheney's algorithm", said "written by Christopher Hoover".
Guy Steele wrote the original character functions
code/char.lisp
to centralize information about machine-dependent macros and constants.
Sean Hallgren is credited with most of the Alpha backend. Julian
-Dolby created the CMU CL Alpha/linux port.
+Dolby created the CMU CL Alpha/linux port. Douglas Crosher added
+complex-float support.
The CMU CL machine-independent disassembler (compiler/disassem.lisp)
was written by Miles Bader.
internal representation of (OR ..) types to accommodate the new
support for (AND ..) types, among other things)
+changes in sbcl-0.6.13 relative to sbcl-0.6.12:
+* The system has now been ported to the Alpha CPU, thanks to Dan Barlow.
+
planned incompatible changes in 0.7.x:
* The debugger prompt sequence now goes "5]", "5[2]", "5[3]", etc.
as you get deeper into recursive calls to the debugger command loop,
instead of the old "5]", "5]]", "5]]]" sequence. (I was motivated
- to do this when ILISP and SBCL got into arguments which left me
- deeply nested in the debugger.)
-* When the profiling interface settles down, it might impact TRACE.
- They both encapsulate functions, and it's not clear yet how
- e.g. UNPROFILE will interact with TRACE and UNTRACE. (This shouldn't
- matter, though, unless you are using profiling. If you never
- profile anything, TRACE should continue to behave as before.)
+ to do this when squabbles between ILISP and SBCL left me
+ very deeply nested in the debugger.)
* The fasl file extension may change, perhaps to ".fasl".
* The default output representation for unprintable ASCII characters
which, unlike e.g. #\Newline, don't have names defined in the
ANSI Common Lisp standard, may change to their ASCII symbolic
names: #\Nul, #\Soh, #\Stx, etc.
* INTERNAL-TIME-UNITS-PER-SECOND might increase, e.g. to 1000.
+* FASL file extensions change to ".fasl", instead of the various
+ CPU-dependent values (".x86f", ".axpf", etc.) inherited from CMU CL.
* MAYBE-INLINE will probably go away at some point, maybe 0.7.x,
maybe later, in favor of the ANSI-recommended idiom for making
a function optionally inline.
-* FASL file extensions change to ".fasl", instead of the various
- CPU-dependent values (".x86f" etc.) inherited from CMU CL.
+* When the profiling interface settles down, maybe in 0.7.x, maybe
+ later, it might impact TRACE. They both encapsulate functions, and
+ it's not clear yet how e.g. UNPROFILE will interact with TRACE
+ and UNTRACE. (This shouldn't matter, though, unless you are
+ using profiling. If you never profile anything, TRACE should
+ continue to behave as before.)
-;;; -*- 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.
-;;;
-;;;
-;;; **********************************************************************
-;;;
-;;; Stuff to handle allocation of stuff we don't want to do inline.
-;;;
-;;; Written by William Lott.
-;;;
+;;;; stuff to handle allocation of stuff we don't want to do inline
-(in-package "SB!VM")
+;;;; 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")
-;;; Given that the pseudo-atomic sequence is so short, there is
+;;; (Given that the pseudo-atomic sequence is so short, there is
;;; nothing that qualifies. But we want to keep the file around
-;;; in case we decide to add something later.
+;;; in case we decide to add something later.)
-;;; **********************************************************************
-;;; This code was written as part of the CMU Common Lisp project at
-;;; Carnegie Mellon University, and has been placed in the public domain.
-;;;
-;;;
-;;; **********************************************************************
-;;;
-;;; Stuff to handle simple cases for generic arithmetic.
-;;;
-;;; Written by William Lott.
-;;; Conversion by Sean Hallgren
-;;;
-
-(in-package "SB!VM")
+;;;; Stuff to handle simple cases for generic arithmetic.
+;;;; 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 (generic-+
(:cost 10)
(inst bne temp DO-STATIC-FUN)
(inst addq x y res)
- ; Check to see if we need a bignum
+ ; Check whether we need a bignum.
(inst sra res 31 temp)
(inst beq temp DONE)
(inst not temp temp)
(inst beq temp DONE)
(inst sra res 2 temp3)
- ; From move-from-signed
+ ; from move-from-signed
(inst li 2 temp2)
(inst sra temp3 31 temp)
(inst cmoveq temp 1 temp2)
(inst bne temp DO-STATIC-FUN)
(inst subq x y res)
- ; Check to see if we need a bignum
+ ; Check whether we need a bignum.
(inst sra res 31 temp)
(inst beq temp DONE)
(inst not temp temp)
(inst beq temp DONE)
(inst sra res 2 temp3)
- ; From move-from-signed
+ ; from move-from-signed
(inst li 2 temp2)
(inst sra temp3 31 temp)
(inst cmoveq temp 1 temp2)
(inst and y 3 temp)
(inst bne temp DO-STATIC-FUN)
- ;; Remove the tag from one arg so that the result will have the correct
- ;; fixnum tag.
+ ;; Remove the tag from one arg so that the result will have the
+ ;; correct fixnum tag.
(inst sra x 2 temp)
(inst mulq temp y lo)
(inst sra lo 32 hi)
(inst sll lo 32 res)
(inst sra res 32 res)
- ;; Check to see if the result will fit in a fixnum. (I.e. the high word
- ;; is just 32 copies of the sign bit of the low word).
+ ;; Check to see if the result will fit in a fixnum. (I.e. the high
+ ;; word is just 32 copies of the sign bit of the low word).
(inst sra res 31 temp)
(inst xor hi temp temp)
(inst beq temp DONE)
- ;; Shift the double word hi:res down two bits into hi:low to get rid of the
- ;; fixnum tag.
+ ;; Shift the double word hi:res down two bits into hi:low to get rid
+ ;; of the fixnum tag.
(inst sra lo 2 lo)
(inst sra lo 32 hi)
;; Store two words.
(storew lo res bignum-digits-offset other-pointer-type)
(storew hi res (1+ bignum-digits-offset) other-pointer-type)
- ;; Out of here
+ ;; out of here
(lisp-return lra lip :offset 2)
DO-STATIC-FUN
DONE)
\f
-;;;; Division.
+;;;; division
(define-assembly-routine (signed-truncate
(:note "(signed-byte 32) truncate")
(emit-label label)))
\f
-;;;; Comparison routines.
+;;;; comparison routines
(macrolet
((define-cond-assem-rtn (name translate static-fn cmp not-p)
-;;; -*- 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")
(inst addq alloc-tn words alloc-tn)
(storew ndescr result 0 other-pointer-type)
(storew length result vector-length-slot other-pointer-type)))
-
\f
-;;;; Hash primitives
+;;;; hash primitives
#|
(define-assembly-routine (sxhash-simple-string
(:translate %sxhash-simple-string)
-;;; **********************************************************************
-;;; This code was written as part of the CMU Common Lisp project at
-;;; Carnegie Mellon University, and has been placed in the public domain.
-;;;
-;;;
-;;; **********************************************************************
-;;;
-(in-package "SB!VM")
+;;;; 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")
\f
;;;; Return-multiple with other than one value
-#+sb-assembling ;; we don't want a vop for this one.
+#+sb-assembling ;; We don't want a vop for this one.
(define-assembly-routine
(return-multiple
(:return-style :none))
;; Return.
(lisp-return lra lip))
-
\f
-;;;; tail-call-variable.
+;;;; tail-call-variable
-#+sb-assembling ;; no vop for this one either.
+#+sb-assembling ;; no vop for this one either
(define-assembly-routine
(tail-call-variable
(:return-style :none))
(lisp-jump temp lip)))
\f
-;;;; Non-local exit noise.
+;;;; non-local exit noise
(define-assembly-routine
(unwind
(store-symbol-value next-uwp sb!impl::*current-unwind-protect-block*)
(inst br zero-tn do-exit))
-
(define-assembly-routine
throw
((:arg target descriptor-reg a0-offset)
-;;; -*- 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 machine specific support routines needed by
-;;; the file assembler.
-;;;
-(in-package "SB!VM")
+;;;; the machine-specific support routines needed by the file assembler
+
+;;;; 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")
(!def-vm-support-routine generate-call-sequence (name style vop)
(ecase style
'((:temporary (:scs (non-descriptor-reg)) temp))
nil))))
-
(!def-vm-support-routine generate-return-sequence (style)
(ecase style
(:raw
-;;; -*- Package: ALPHA -*-
-;;;
+;;;; Alpha-specific implementation stuff
-(in-package "SB!VM")
-
-(export '(#||# fixup-code-object internal-error-arguments
- context-program-counter context-register
- context-float-register context-floating-point-modes
- extern-alien-name sanctify-for-execution))
+;;;; 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")
\f
(defvar *number-of-signals* 64)
(defvar *bits-per-word* 64)
-;;; see x86-vm.lisp
+;;; See x86-vm.lisp for a description of this.
(def-alien-type os-context-t (struct os-context-t-struct))
-
\f
;;;; MACHINE-TYPE and MACHINE-VERSION
(defun machine-type ()
- "Returns a string describing the type of the local machine."
+ "Return a string describing the type of the local machine."
"Alpha")
(defun machine-version ()
- "Returns a string describing the version of the local machine."
+ "Return a string describing the version of the local machine."
"Alpha")
-
-
\f
-;;; FIXUP-CODE-OBJECT -- Interface
-;;;
(defun fixup-code-object (code offset value kind)
(unless (zerop (rem offset word-bytes))
(error "Unaligned instruction? offset=#x~X." offset))
(:lda
(setf (sap-ref-8 sap offset) (ldb (byte 8 0) value))
(setf (sap-ref-8 sap (1+ offset)) (ldb (byte 8 8) value)))))))
-
-
\f
-
-;;; "Sigcontext" access functions, cut & pasted from x86-vm.lisp then
-;;; hacked for types. The alpha has 64-bit registers, so these
-;;; potentially return 64 bit numbers (which means bignums ... ew)
-;;; We think that 99 times of 100 (i.e. unless something is badly wrong)
-;;; we'll get answers that fit in 32 bits anyway.
-
-;;; Which probably won't help us stop passing bignums around as the
-;;; compiler can't prove they fit in 32 bits. But maybe the stuff it
-;;; does on x86 to unbox 32-bit constants happens magically for 64-bit
-;;; constants here. Just maybe.
-
-;;; see also x86-vm for commentary on signed vs unsigned.
+;;;; "Sigcontext" access functions, cut & pasted from x86-vm.lisp then
+;;;; hacked for types.
+;;;;
+;;;; KLUDGE: The alpha has 64-bit registers, so these potentially
+;;;; return 64 bit numbers (which means bignums ... ew) We think that
+;;;; 99 times of 100 (i.e. unless something is badly wrong) we'll get
+;;;; answers that fit in 32 bits anyway. Which probably won't help us
+;;;; stop passing bignums around as the compiler can't prove they fit
+;;;; in 32 bits. But maybe the stuff it does on x86 to unbox 32-bit
+;;;; constants happens magically for 64-bit constants here. Just
+;;;; maybe. -- Dan Barlow, ca. 2001-05-05
+;;;;
+;;;; See also x86-vm for commentary on signed vs unsigned.
(def-alien-routine ("os_context_pc_addr" context-pc-addr) (* unsigned-long)
(context (* os-context-t)))
(setf (deref (context-register-addr context index))
new))
-;;; Like CONTEXT-REGISTER, but returns the value of a float register.
-;;; FORMAT is the type of float to return.
+;;; This is like CONTEXT-REGISTER, but returns the value of a float
+;;; register. FORMAT is the type of float to return.
-;;; whether COERCE actually knows how to make a float out of a long
-;;; is another question. This stuff still needs testing
+;;; FIXME: Whether COERCE actually knows how to make a float out of a
+;;; long is another question. This stuff still needs testing.
(def-alien-routine ("os_context_fpregister_addr" context-float-register-addr)
(* long)
(context (* os-context-t))
(setf (deref (context-float-register-addr context index))
(coerce new format)))
-
;;; Given a signal context, return the floating point modes word in
;;; the same format as returned by FLOATING-POINT-MODES.
(defun context-floating-point-modes (context)
;;; (pc)
;;; (example from undefined_tramp: "(gdb) x/40ub 0x10148" for yourself
;;; to replicate)
-
(defun internal-error-arguments (context)
(declare (type (alien (* os-context-t)) context))
(sb!int::/show0 "entering INTERNAL-ERROR-ARGUMENTS")
(return))
(sc-offsets (sb!c::read-var-integer vector index)))
(values error-number (sc-offsets)))))))
-
\f
-;;; EXTERN-ALIEN-NAME -- interface.
-;;;
-;;; The loader uses this to convert alien names to the form they occure in
-;;; the symbol table (for example, prepending an underscore). On the Alpha
-;;; we don't do anything.
-;;;
+;;; The loader uses this to convert alien names to the form they
+;;; occure in the symbol table (for example, prepending an
+;;; underscore). On the Alpha we don't do anything.
(defun extern-alien-name (name)
(declare (type simple-base-string name))
name)
-
-
\f
-;;; SANCTIFY-FOR-EXECUTION -- Interface.
-;;;
-;;; Do whatever is necessary to make the given code component executable.
-;;;
-
-;;; XXX do we really not have to flush caches or something here? I need
-;;; an architecture manual
+;;;; Do whatever is necessary to make the given code component
+;;;; executable.
+;;;;
+;;;; XXX do we really not have to flush caches or something here? I
+;;;; need an architecture manual
(defun sanctify-for-execution (component)
(declare (ignore component))
nil)
;; false, then the function is not in the cache (or is in the process of
;; being removed.)
(definition nil :type (or sb!c::clambda null))
- ;; The number of consequtive GCs that this function has been unused. This is
- ;; used to control cache replacement.
+ ;; The number of consecutive GCs that this function has been unused.
+ ;; This is used to control cache replacement.
(gcs 0 :type sb!c::index)
;; True if Lambda has been converted at least once, and thus warnings should
;; be suppressed on additional conversions.
(setf (deref (context-register-addr context index))
new))
-;;; Like CONTEXT-REGISTER, but returns the value of a float register.
-;;; FORMAT is the type of float to return.
+;;; This is like CONTEXT-REGISTER, but returns the value of a float
+;;; register. FORMAT is the type of float to return.
;;;
;;; As of sbcl-0.6.7, there is no working code which calls this code,
;;; so it's stubbed out. Someday, in order to make the debugger work
-;;; -*- 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.
-;;;
+;;;; allocation VOPs for the Alpha port
-;;;
-;;; **********************************************************************
-;;;
-;;; Allocation VOPs for the Alpha port.
-;;;
-;;; Written by William Lott.
-;;; Converted by Sean Hallgren.
-;;;
+;;;; 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")
-
-
\f
;;;; LIST and LIST*
(define-vop (list* list-or-list*)
(:variant t))
-
\f
-;;;; Special purpose inline allocators.
+;;;; special purpose inline allocators
(define-vop (allocate-code-object)
(:args (boxed-arg :scs (any-reg))
(storew value result value-cell-value-slot other-pointer-type)))
\f
-;;;; Automatic allocators for primitive objects.
+;;;; automatic allocators for primitive objects
(define-vop (make-unbound-marker)
(:args)
-;;; -*- 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.
-;;;
+;;;; the VM definition arithmetic VOPs for the Alpha
-;;;
-;;; **********************************************************************
-;;;
-;;; $Header$
-;;;
-;;; This file contains the VM definition arithmetic VOPs for the MIPS.
-;;;
-;;; Written by Rob MacLachlan
-;;; Converted by Sean Hallgren
-;;;
+;;;; 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")
-
-
-
\f
-;;;; Unary operations.
+;;;; unary operations
(define-vop (fixnum-unop)
(:args (x :scs (any-reg)))
(:translate lognot)
(:generator 1
(inst not x res)))
-
-
\f
-;;;; Binary fixnum operations.
+;;;; binary fixnum operations
;;; Assume that any constant operand is the second arg...
(define-binop lognor 1 3 ornot (unsigned-byte 6) (unsigned-byte 8))
(define-binop logand 1 3 and (unsigned-byte 6) (unsigned-byte 8))
(define-binop logxor 1 3 xor (unsigned-byte 6) (unsigned-byte 8))
-
-
-;;; Shifting
-
+\f
+;;;; shifting
(define-vop (fast-ash)
(:note "inline ASH")
(inst and num mask num)
(inst and temp mask temp)
(inst addq num temp res)))
-
-
-;;; Multiply
+\f
+;;;; multiplying
(define-vop (fast-*/fixnum=>fixnum fast-fixnum-binop)
(:temporary (:scs (non-descriptor-reg)) temp)
(:translate *)
(:generator 3
(inst mulq x y r)))
-
-
\f
-;;;; Binary conditional VOPs:
+;;;; binary conditional VOPs
(define-vop (fast-conditional)
(:conditional)
(inst beq temp target)
(inst bne temp target)))))
-;;; EQL/FIXNUM is funny because the first arg can be of any type, not just a
-;;; known fixnum.
+;;; EQL/FIXNUM is funny because the first arg can be of any type, not
+;;; just a known fixnum.
(define-conditional-vop eql
(declare (ignore signed))
(inst beq temp target)
(inst bne temp target)))
-;;; These versions specify a fixnum restriction on their first arg. We have
-;;; also generic-eql/fixnum VOPs which are the same, but have no restriction on
-;;; the first arg and a higher cost. The reason for doing this is to prevent
-;;; fixnum specific operations from being used on word integers, spuriously
-;;; consing the argument.
-;;;
+;;; These versions specify a fixnum restriction on their first arg. We
+;;; have also generic-eql/fixnum VOPs which are the same, but have no
+;;; restriction on the first arg and a higher cost. The reason for
+;;; doing this is to prevent fixnum specific operations from being
+;;; used on word integers, spuriously consing the argument.
(define-vop (fast-eql/fixnum fast-conditional)
(:args (x :scs (any-reg))
(y :scs (any-reg)))
(:generator 1
(inst and amount #x1f temp)
(inst sll num temp r)))
-
-
\f
-;;;; Bignum stuff.
+;;;; bignum stuff
(define-vop (bignum-length get-header-data)
(:translate sb!bignum::%bignum-length)
(:translate sb!bignum::%ashl)
(:generator 1
(inst sll digit count result)))
-
\f
-;;;; Static functions.
+;;;; static functions
(define-static-function two-arg-gcd (x y) :translate gcd)
(define-static-function two-arg-lcm (x y) :translate lcm)
-;;; -*- 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 Alpha definitions for array operations.
-;;;
-;;; Written by William Lott
-;;; Conversion by Sean Hallgren
-;;; Complex-float support by Douglas Crosher 1998.
-;;;
-(in-package "SB!VM")
+;;;; the Alpha definitions for array operations
+;;;; 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")
\f
-;;;; Allocator for the array header.
+;;;; allocator for the array header
(define-vop (make-array-header)
(:policy :fast-safe)
\f
-;;;; Additional accessors and setters for the array header.
+;;;; additional accessors and setters for the array header
(defknown sb!impl::%array-dimension (t index) index
(flushable))
\f
-;;;; Bounds checking routine.
-
+;;;; bounds checking routine
(define-vop (check-bound)
(:translate %check-bound)
(inst cmpult index bound temp)
(inst beq temp error)
(move index result))))
-
-
\f
-;;;; Accessors/Setters
-
-;;; Variants built on top of word-index-ref, etc. I.e. those vectors whos
-;;; elements are represented in integer registers and are built out of
-;;; 8, 16, or 32 bit elements.
+;;;; accessors/setters
+;;; Variants built on top of word-index-ref, etc. I.e. those vectors
+;;; whose elements are represented in integer registers and are built
+;;; out of 8, 16, or 32 bit elements.
(macrolet ((def-full-data-vector-frobs (type element-type &rest scs)
`(progn
- (define-full-reffer ,(symbolicate "DATA-VECTOR-REF/" type) ,type
+ (define-full-reffer ,(symbolicate "DATA-VECTOR-REF/" type)
+ ,type
vector-data-offset other-pointer-type
,(remove-if #'(lambda (x) (member x '(null zero))) scs)
,element-type
data-vector-ref)
- (define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type) ,type
+ (define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type)
+ ,type
vector-data-offset other-pointer-type ,scs ,element-type
- data-vector-set #+gengc ,(if (member 'descriptor-reg scs) t nil))))
+ data-vector-set #+gengc ,(if (member 'descriptor-reg scs)
+ t
+ nil))))
(def-partial-data-vector-frobs
(type element-type size signed &rest scs)
`(progn
- (define-partial-reffer ,(symbolicate "DATA-VECTOR-REF/" type) ,type
+ (define-partial-reffer ,(symbolicate "DATA-VECTOR-REF/" type)
+ ,type
,size ,signed vector-data-offset other-pointer-type ,scs
,element-type data-vector-ref)
- (define-partial-setter ,(symbolicate "DATA-VECTOR-SET/" type) ,type
+ (define-partial-setter ,(symbolicate "DATA-VECTOR-SET/" type)
+ ,type
,size vector-data-offset other-pointer-type ,scs
,element-type data-vector-set)))
(def-small-data-vector-frobs (type bits)
(:results (value :scs (any-reg)))
(:result-types positive-fixnum)
(:temporary (:scs (interior-reg)) lip)
- (:temporary (:scs (non-descriptor-reg) :to (:result 0)) temp result)
+ (:temporary (:scs (non-descriptor-reg) :to (:result 0))
+ temp result)
(:generator 20
(inst srl index ,bit-shift temp)
(inst sll temp 2 temp)
lip)
(inst and index ,(1- elements-per-word) temp)
,@(unless (= bits 1)
- `((inst sll temp ,(1- (integer-length bits)) temp)))
+ `((inst sll temp
+ ,(1- (integer-length bits)) temp)))
(inst srl result temp result)
(inst and result ,(1- (ash 1 bits)) result)
(inst sll result 2 value)))
(:results (result :scs (unsigned-reg)))
(:result-types positive-fixnum)
(:generator 15
- (multiple-value-bind (word extra) (floor index ,elements-per-word)
- (loadw result object (+ word vector-data-offset)
+ (multiple-value-bind (word extra)
+ (floor index ,elements-per-word)
+ (loadw result object (+ word
+ vector-data-offset)
other-pointer-type)
(unless (zerop extra)
(inst srl result (* extra ,bits) result))
(unless (= extra ,(1- elements-per-word))
- (inst and result ,(1- (ash 1 bits)) result)))))
+ (inst and result ,(1- (ash 1 bits))
+ result)))))
(define-vop (,(symbolicate 'data-vector-set/ type))
(:note "inline array store")
(:translate data-vector-set)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
(index :scs (unsigned-reg) :target shift)
- (value :scs (unsigned-reg zero immediate) :target result))
+ (value :scs (unsigned-reg zero immediate)
+ :target result))
(:arg-types ,type positive-fixnum positive-fixnum)
(:results (result :scs (unsigned-reg)))
(:result-types positive-fixnum)
(:temporary (:scs (interior-reg)) lip)
(:temporary (:scs (non-descriptor-reg)) temp old)
- (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) shift)
+ (:temporary (:scs (non-descriptor-reg)
+ :from (:argument 1)) shift)
(:generator 25
(inst srl index ,bit-shift temp)
(inst sll temp 2 temp)
lip)
(inst and index ,(1- elements-per-word) shift)
,@(unless (= bits 1)
- `((inst sll shift ,(1- (integer-length bits)) shift)))
+ `((inst sll shift ,(1- (integer-length
+ bits))
+ shift)))
(unless (and (sc-is value immediate)
- (= (tn-value value) ,(1- (ash 1 bits))))
+ (= (tn-value value)
+ ,(1- (ash 1 bits))))
(inst li ,(1- (ash 1 bits)) temp)
(inst sll temp shift temp)
(inst not temp temp)
(unless (sc-is value zero)
(sc-case value
(immediate
- (inst li (logand (tn-value value) ,(1- (ash 1 bits))) temp))
+ (inst li
+ (logand (tn-value value)
+ ,(1- (ash 1 bits)))
+ temp))
(unsigned-reg
- (inst and value ,(1- (ash 1 bits)) temp)))
+ (inst and value
+ ,(1- (ash 1 bits))
+ temp)))
(inst sll temp shift temp)
(inst bis old temp old))
(inst stl old
(:translate data-vector-set)
(:policy :fast-safe)
(:args (object :scs (descriptor-reg))
- (value :scs (unsigned-reg zero immediate) :target result))
+ (value :scs (unsigned-reg zero immediate)
+ :target result))
(:arg-types ,type
(:constant
(integer 0
(:result-types positive-fixnum)
(:temporary (:scs (non-descriptor-reg)) temp old)
(:generator 20
- (multiple-value-bind (word extra) (floor index ,elements-per-word)
+ (multiple-value-bind (word extra)
+ (floor index ,elements-per-word)
(inst ldl object
- (- (* (+ word vector-data-offset) word-bytes)
+ (- (* (+ word vector-data-offset)
+ word-bytes)
other-pointer-type)
old)
(unless (and (sc-is value immediate)
- (= (tn-value value) ,(1- (ash 1 bits))))
+ (= (tn-value value)
+ ,(1- (ash 1 bits))))
(cond ((= extra ,(1- elements-per-word))
(inst sll old ,bits old)
(inst srl old ,bits old))
(t
(inst li
- (lognot (ash ,(1- (ash 1 bits)) (* extra ,bits)))
+ (lognot (ash ,(1- (ash 1
+ bits))
+ (* extra ,bits)))
temp)
(inst and old temp old))))
(sc-case value
(zero)
(immediate
- (let ((value (ash (logand (tn-value value) ,(1- (ash 1 bits)))
- (* extra ,bits))))
+ (let ((value
+ (ash (logand (tn-value
+ value)
+ ,(1- (ash 1
+ bits)))
+ (* extra
+ ,bits))))
(cond ((< value #x10000)
(inst bis old value old))
(t
(inst li value temp)
(inst bis old temp old)))))
(unsigned-reg
- (inst sll value (* extra ,bits) temp)
+ (inst sll value (* extra ,bits)
+ temp)
(inst bis old temp old)))
(inst stl old
- (- (* (+ word vector-data-offset) word-bytes)
+ (- (* (+ word vector-data-offset)
+ word-bytes)
other-pointer-type)
object)
(sc-case value
(def-full-data-vector-frobs simple-array-signed-byte-30 tagged-num any-reg)
- (def-full-data-vector-frobs simple-array-signed-byte-32 signed-num signed-reg)
+ (def-full-data-vector-frobs simple-array-signed-byte-32 signed-num
+ signed-reg)
- ;; Integer vectors whos elements are smaller than a byte. I.e. bit, 2-bit,
- ;; and 4-bit vectors.
- ;;
-
+ ;; Integer vectors whos elements are smaller than a byte. I.e. bit,
+ ;; 2-bit, and 4-bit vectors.
(def-small-data-vector-frobs simple-bit-vector 1)
(def-small-data-vector-frobs simple-array-unsigned-byte-2 2)
(def-small-data-vector-frobs simple-array-unsigned-byte-4 4))
-
-;;; And the float variants.
-;;;
+;;; and the float variants..
(define-vop (data-vector-ref/simple-array-single-float)
(:note "inline array access")
other-pointer-type) lip)
(unless (location= result value)
(inst fmove value result))))
-
\f
-;;; Complex float arrays.
+;;; complex float arrays
(define-vop (data-vector-ref/simple-array-complex-single-float)
(:note "inline array access")
(inst fmove value-imag result-imag)))))
\f
-;;; These VOPs are used for implementing float slots in structures (whose raw
-;;; data is an unsigned-32 vector.
+;;; These VOPs are used for implementing float slots in structures
+;;; (whose raw data is an unsigned-32 vector).
;;;
(define-vop (raw-ref-single data-vector-ref/simple-array-single-float)
(:translate %raw-ref-single)
(:arg-types simple-array-unsigned-byte-32 positive-fixnum
complex-double-float))
-
;;; These vops are useful for accessing the bits of a vector irrespective of
;;; what type of vector it is.
-;;;
-
+;;;
(define-full-reffer raw-bits * 0 other-pointer-type (unsigned-reg) unsigned-num
%raw-bits)
(define-full-setter set-raw-bits * 0 other-pointer-type (unsigned-reg)
unsigned-num %set-raw-bits #+gengc nil)
-
\f
-;;;; Misc. Array VOPs.
+;;;; misc. array VOPs
(define-vop (get-vector-subtype get-header-data))
(define-vop (set-vector-subtype set-header-data))
-;;;; that part of the parms.lisp file from original CMU CL which is defined in
-;;;; terms of the BACKEND structure
+;;;; that part of the parms.lisp file from original CMU CL which is
+;;;; defined in terms of the BACKEND structure
;;;;
-;;;; FIXME: When we break up the BACKEND structure, this might be mergeable
-;;;; back into the parms.lisp file.
+;;;; FIXME: Now that the BACKEND structure has been broken up, this
+;;;; might be mergeable back into the parms.lisp file.
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.
-
-
(in-package "SB!VM")
-
\f
;;;; compiler constants
;;;(setf *backend-fasl-file-version* 8)
;;; 8 = sbcl-0.6.10.4 revived Gray stream support, changing stream layouts
-
(setf *backend-register-save-penalty* 3)
(setf *backend-byte-order* :little-endian)
-;;; -*- 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 VOPs and other necessary machine specific support
-;;; routines for call-out to C.
-;;;
-;;; Written by William Lott.
-;;; Converted by Sean Hallgren.
-;;;
-(in-package "SB!VM")
+;;;; VOPs and other machine-specific support routines for call-out to C
+
+;;;; 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.
-(use-package "SB!ALIEN")
-(use-package "SB!ALIEN-INTERNALS")
+(in-package "SB!VM")
(defun my-make-wired-tn (prim-type-name sc-name offset)
(make-wired-tn (primitive-type-or-lose prim-type-name )
(alien-function-type-result-type type)
nil)))))
-
(define-vop (foreign-symbol-address)
(:translate foreign-symbol-address)
(:policy :fast-safe)
-;;;
-;;; **********************************************************************
-;;; 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 VM definition of function call for the Alpha.
-;;;
-;;; Written by Rob MacLachlan
-;;;
-;;; Converted for the Alpha by Sean Hallgren
-;;;
-(in-package "SB!VM")
+;;;; the VM definition of function call for the Alpha
+;;;; 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")
\f
-;;;; Interfaces to IR2 conversion:
+;;;; interfaces to IR2 conversion
-;;; Standard-Argument-Location -- Interface
-;;;
-;;; Return a wired TN describing the N'th full call argument passing
+;;; Return a wired TN describing the N'th full call argument passing
;;; location.
;;;
(!def-vm-support-routine standard-argument-location (n)
control-stack-arg-scn n)))
-;;; Make-Return-PC-Passing-Location -- Interface
-;;;
-;;; Make a passing location TN for a local call return PC. If standard is
-;;; true, then use the standard (full call) location, otherwise use any legal
-;;; location. Even in the non-standard case, this may be restricted by a
-;;; desire to use a subroutine call instruction.
+;;; Make a passing location TN for a local call return PC. If standard
+;;; is true, then use the standard (full call) location, otherwise use
+;;; any legal location. Even in the non-standard case, this may be
+;;; restricted by a desire to use a subroutine call instruction.
;;;
(!def-vm-support-routine make-return-pc-passing-location (standard)
#!+gengc (declare (ignore standard))
#!+gengc
(make-wired-tn *fixnum-primitive-type* immediate-arg-scn ra-offset))
-;;; Make-Old-FP-Passing-Location -- Interface
-;;;
-;;; Similar to Make-Return-PC-Passing-Location, but makes a location to pass
-;;; Old-FP in. This is (obviously) wired in the standard convention, but is
-;;; totally unrestricted in non-standard conventions, since we can always fetch
-;;; it off of the stack using the arg pointer.
+;;; This is similar to Make-Return-PC-Passing-Location, but makes a
+;;; location to pass Old-FP in. This is (obviously) wired in the
+;;; standard convention, but is totally unrestricted in non-standard
+;;; conventions, since we can always fetch it off of the stack using
+;;; the arg pointer.
;;;
(!def-vm-support-routine make-old-fp-passing-location (standard)
(if standard
(make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset)
(make-normal-tn *fixnum-primitive-type*)))
-;;; Make-Old-FP-Save-Location, Make-Return-PC-Save-Location -- Interface
-;;;
-;;; Make the TNs used to hold Old-FP and Return-PC within the current
-;;; function. We treat these specially so that the debugger can find them at a
-;;; known location.
-;;;
+;;; These functions make the TNs used to hold Old-FP and Return-PC
+;;; within the current function. We treat these specially so that the
+;;; debugger can find them at a known location.
(!def-vm-support-routine make-old-fp-save-location (env)
(specify-save-tn
(environment-debug-live-tn (make-normal-tn *fixnum-primitive-type*) env)
(make-wired-tn *fixnum-primitive-type*
control-stack-arg-scn
ocfp-save-offset)))
-;;;
(!def-vm-support-routine make-return-pc-save-location (env)
(let ((ptype #!-gengc *backend-t-primitive-type*
#!+gengc *fixnum-primitive-type*))
(make-wired-tn ptype control-stack-arg-scn
#!-gengc lra-save-offset #!+gengc ra-save-offset))))
-;;; Make-Argument-Count-Location -- Interface
-;;;
-;;; Make a TN for the standard argument count passing location. We only
-;;; need to make the standard location, since a count is never passed when we
-;;; are using non-standard conventions.
-;;;
+;;; Make a TN for the standard argument count passing location. We
+;;; only need to make the standard location, since a count is never
+;;; passed when we are using non-standard conventions.
(!def-vm-support-routine make-argument-count-location ()
(make-wired-tn *fixnum-primitive-type* immediate-arg-scn nargs-offset))
-;;; MAKE-NFP-TN -- Interface
-;;;
-;;; Make a TN to hold the number-stack frame pointer. This is allocated
-;;; once per component, and is component-live.
-;;;
+;;; Make a TN to hold the number-stack frame pointer. This is
+;;; allocated once per component, and is component-live.
(!def-vm-support-routine make-nfp-tn ()
(component-live-tn
(make-wired-tn *fixnum-primitive-type* immediate-arg-scn nfp-offset)))
-;;; MAKE-STACK-POINTER-TN ()
-;;;
(!def-vm-support-routine make-stack-pointer-tn ()
(make-normal-tn *fixnum-primitive-type*))
-;;; MAKE-NUMBER-STACK-POINTER-TN ()
-;;;
(!def-vm-support-routine make-number-stack-pointer-tn ()
(make-normal-tn *fixnum-primitive-type*))
-;;; Make-Unknown-Values-Locations -- Interface
-;;;
-;;; Return a list of TNs that can be used to represent an unknown-values
-;;; continuation within a function.
-;;;
+;;; Return a list of TNs that can be used to represent an
+;;; unknown-values continuation within a function.
(!def-vm-support-routine make-unknown-values-locations ()
(list (make-stack-pointer-tn)
(make-normal-tn *fixnum-primitive-type*)))
-;;; Select-Component-Format -- Interface
-;;;
-;;; This function is called by the Entry-Analyze phase, allowing
-;;; VM-dependent initialization of the IR2-Component structure. We push
-;;; placeholder entries in the Constants to leave room for additional
-;;; noise in the code object header.
-;;;
+;;; This function is called by the Entry-Analyze phase, allowing
+;;; VM-dependent initialization of the IR2-Component structure. We
+;;; push placeholder entries in the Constants to leave room for
+;;; additional noise in the code object header.
(!def-vm-support-routine select-component-format (component)
(declare (type component component))
(dotimes (i code-constants-offset)
(values))
\f
-;;;; Frame hackery:
+;;;; frame hackery
-;;; BYTES-NEEDED-FOR-NON-DESCRIPTOR-STACK-FRAME -- internal
-;;;
-;;; Return the number of bytes needed for the current non-descriptor stack
-;;; frame. Non-descriptor stack frames must be multiples of 8 bytes on
-;;; the PMAX.
-;;;
+;;; Return the number of bytes needed for the current non-descriptor
+;;; stack frame. Non-descriptor stack frames must be multiples of 8
+;;; bytes on the PMAX.
(defun bytes-needed-for-non-descriptor-stack-frame ()
(* (logandc2 (1+ (sb-allocated-size 'non-descriptor-stack)) 1)
word-bytes))
-;;; Used for setting up the Old-FP in local call.
-;;;
+;;; This is used for setting up the Old-FP in local call.
(define-vop (current-fp)
(:results (val :scs (any-reg)))
(:generator 1
(move cfp-tn val)))
-;;; Used for computing the caller's NFP for use in known-values return. Only
-;;; works assuming there is no variable size stuff on the nstack.
-;;;
+;;; This is used for computing the caller's NFP for use in
+;;; known-values return. It only works assuming there is no variable
+;;; size stuff on the nstack.
(define-vop (compute-old-nfp)
(:results (val :scs (any-reg)))
(:vop-var vop)
(when nfp
(inst addq nfp (bytes-needed-for-non-descriptor-stack-frame) val)))))
-
(define-vop (xep-allocate-frame)
(:info start-lab copy-more-arg-follows)
(:ignore copy-more-arg-follows)
(:vop-var vop)
(:temporary (:scs (non-descriptor-reg)) temp)
(:generator 1
- ;; Make sure the function is aligned, and drop a label pointing to this
- ;; function header.
+ ;; Make sure the function is aligned, and drop a label pointing to
+ ;; this function header.
(align lowtag-bits)
(trace-table-entry trace-table-function-prologue)
(emit-label start-lab)
(let ((entry-point (gen-label)))
(emit-label entry-point)
(inst compute-code-from-fn code-tn lip-tn entry-point temp)
- ;; ### We should also save it on the stack so that the garbage collector
- ;; won't forget about us if we call anyone else.
+ ;; ### We should also save it on the stack so that the garbage
+ ;; collector won't forget about us if we call anyone else.
)
;; Build our stack frames.
(inst lda csp-tn (* word-bytes (sb-allocated-size 'control-stack)) cfp-tn)
(move nsp-tn nfp))
(trace-table-entry trace-table-normal)))
-;;; Allocate a partial frame for passing stack arguments in a full call. Nargs
-;;; is the number of arguments passed. If no stack arguments are passed, then
-;;; we don't have to do anything.
-;;;
+;;; Allocate a partial frame for passing stack arguments in a full
+;;; call. Nargs is the number of arguments passed. If no stack
+;;; arguments are passed, then we don't have to do anything.
(define-vop (allocate-full-call-frame)
(:info nargs)
(:results (res :scs (any-reg)))
\f
-;;; Default-Unknown-Values -- Internal
-;;;
-;;; Emit code needed at the return-point from an unknown-values call for a
-;;; fixed number of values. Values is the head of the TN-Ref list for the
-;;; locations that the values are to be received into. Nvals is the number of
-;;; values that are to be received (should equal the length of Values).
+;;; Emit code needed at the return-point from an unknown-values call
+;;; for a fixed number of values. Values is the head of the TN-Ref
+;;; list for the locations that the values are to be received into.
+;;; Nvals is the number of values that are to be received (should
+;;; equal the length of Values).
;;;
-;;; Move-Temp is a Descriptor-Reg TN used as a temporary.
+;;; Move-Temp is a Descriptor-Reg TN used as a temporary.
;;;
-;;; This code exploits the fact that in the unknown-values convention, a
-;;; single value return returns at the return PC + 8, whereas a return of other
-;;; than one value returns directly at the return PC.
+;;; This code exploits the fact that in the unknown-values convention,
+;;; a single value return returns at the return PC + 8, whereas a
+;;; return of other than one value returns directly at the return PC.
;;;
-;;; If 0 or 1 values are expected, then we just emit an instruction to reset
-;;; the SP (which will only be executed when other than 1 value is returned.)
+;;; If 0 or 1 values are expected, then we just emit an instruction to
+;;; reset the SP (which will only be executed when other than 1 value
+;;; is returned.)
;;;
;;; In the general case, we have to do three things:
;;; -- Default unsupplied register values. This need only be done when a
br defaulting-done
nop
|#
-;;;
(defun default-unknown-values (vop values nvals move-temp temp lra-label)
(declare (type (or tn-ref null) values)
(type unsigned-byte nvals) (type tn move-temp temp))
(if (<= nvals 1)
(progn
- ;; Note that this is a single-value return point. This is actually
- ;; the multiple-value entry point for a single desired value, but
- ;; the code location has to be here, or the debugger backtrace
- ;; gets confused.
+ ;; Note that this is a single-value return point. This is
+ ;; actually the multiple-value entry point for a single
+ ;; desired value, but the code location has to be here, or the
+ ;; debugger backtrace gets confused.
(without-scheduling ()
(note-this-location vop :single-value-return)
(move ocfp-tn csp-tn)
#!-gengc (inst compute-code-from-lra code-tn code-tn lra-label temp)
#!+gengc (inst compute-code-from-ra code-tn ra-tn lra-label temp))))
(values))
-
\f
-;;;; Unknown values receiving:
+;;;; unknown values receiving
-;;; Receive-Unknown-Values -- Internal
+;;; Emit code needed at the return point for an unknown-values call
+;;; for an arbitrary number of values.
;;;
-;;; Emit code needed at the return point for an unknown-values call for an
-;;; arbitrary number of values.
+;;; We do the single and non-single cases with no shared code: there
+;;; doesn't seem to be any potential overlap, and receiving a single
+;;; value is more important efficiency-wise.
;;;
-;;; We do the single and non-single cases with no shared code: there doesn't
-;;; seem to be any potential overlap, and receiving a single value is more
-;;; important efficiency-wise.
+;;; When there is a single value, we just push it on the stack,
+;;; returning the old SP and 1.
;;;
-;;; When there is a single value, we just push it on the stack, returning
-;;; the old SP and 1.
-;;;
-;;; When there is a variable number of values, we move all of the argument
-;;; registers onto the stack, and return Args and Nargs.
-;;;
-;;; Args and Nargs are TNs wired to the named locations. We must
-;;; explicitly allocate these TNs, since their lifetimes overlap with the
-;;; results Start and Count (also, it's nice to be able to target them).
+;;; When there is a variable number of values, we move all of the
+;;; argument registers onto the stack, and return Args and Nargs.
;;;
+;;; Args and Nargs are TNs wired to the named locations. We must
+;;; explicitly allocate these TNs, since their lifetimes overlap with
+;;; the results Start and Count (also, it's nice to be able to target
+;;; them).
(defun receive-unknown-values (args nargs start count lra-label temp)
(declare (type tn args nargs start count temp))
(let ((variable-values (gen-label))
(inst br zero-tn done)))
(values))
-
-;;; VOP that can be inherited by unknown values receivers. The main thing this
-;;; handles is allocation of the result temporaries.
-;;;
+;;; a VOP that can be inherited by unknown values receivers. The main
+;;; thing this handles is allocation of the result temporaries.
(define-vop (unknown-values-receiver)
(:results
(start :scs (any-reg))
:from :eval :to (:result 1))
nvals)
(:temporary (:scs (non-descriptor-reg)) temp))
-
-
\f
-;;;; Local call with unknown values convention return:
+;;;; local call with unknown values convention return
;;; Non-TR local call for a fixed number of values passed according to the
;;; unknown values convention.
;;; Values are the return value locations (wired to the standard passing
;;; locations).
;;;
-;;; Save is the save info, which we can ignore since saving has been done.
-;;; Return-PC is the TN that the return PC should be passed in.
-;;; Target is a continuation pointing to the start of the called function.
-;;; Nvals is the number of values received.
-;;;
-;;; Note: we can't use normal load-tn allocation for the fixed args, since all
-;;; registers may be tied up by the more operand. Instead, we use
-;;; MAYBE-LOAD-STACK-TN.
+;;; Save is the save info, which we can ignore since saving has been
+;;; done. Return-PC is the TN that the return PC should be passed in.
+;;; Target is a continuation pointing to the start of the called
+;;; function. Nvals is the number of values received.
;;;
+;;; Note: we can't use normal load-tn allocation for the fixed args,
+;;; since all registers may be tied up by the more operand. Instead,
+;;; we use MAYBE-LOAD-STACK-TN.
(define-vop (call-local)
(:args (fp)
(nfp)
(maybe-load-stack-nfp-tn cur-nfp nfp-save temp))))
-;;; Non-TR local call for a variable number of return values passed according
-;;; to the unknown values convention. The results are the start of the values
-;;; glob and the number of values received.
-;;;
-;;; Note: we can't use normal load-tn allocation for the fixed args, since all
-;;; registers may be tied up by the more operand. Instead, we use
-;;; MAYBE-LOAD-STACK-TN.
+;;; Non-TR local call for a variable number of return values passed
+;;; according to the unknown values convention. The results are the
+;;; start of the values glob and the number of values received.
;;;
+;;; Note: we can't use normal load-tn allocation for the fixed args,
+;;; since all registers may be tied up by the more operand. Instead,
+;;; we use MAYBE-LOAD-STACK-TN.
(define-vop (multiple-call-local unknown-values-receiver)
(:args (fp)
(nfp)
(maybe-load-stack-nfp-tn cur-nfp nfp-save temp))))
\f
-;;;; Local call with known values return:
+;;;; local call with known values return
-;;; Non-TR local call with known return locations. Known-value return works
-;;; just like argument passing in local call.
+;;; Non-TR local call with known return locations. Known-value return
+;;; works just like argument passing in local call.
;;;
;;; Note: we can't use normal load-tn allocation for the fixed args, since all
;;; registers may be tied up by the more operand. Instead, we use
;;; MAYBE-LOAD-STACK-TN.
-;;;
(define-vop (known-call-local)
(:args (fp)
(nfp)
(note-this-location vop :known-return)
(maybe-load-stack-nfp-tn cur-nfp nfp-save temp))))
-;;; Return from known values call. We receive the return locations as
-;;; arguments to terminate their lifetimes in the returning function. We
-;;; restore FP and CSP and jump to the Return-PC.
-;;;
-;;; Note: we can't use normal load-tn allocation for the fixed args, since all
-;;; registers may be tied up by the more operand. Instead, we use
-;;; MAYBE-LOAD-STACK-TN.
+;;; Return from known values call. We receive the return locations as
+;;; arguments to terminate their lifetimes in the returning function.
+;;; We restore FP and CSP and jump to the Return-PC.
;;;
+;;; Note: we can't use normal load-tn allocation for the fixed args,
+;;; since all registers may be tied up by the more operand. Instead,
+;;; we use MAYBE-LOAD-STACK-TN.
(define-vop (known-return)
(:args (ocfp :target ocfp-temp)
(return-pc :target return-pc-temp)
(vals :more t))
(:temporary (:sc any-reg :from (:argument 0)) ocfp-temp)
- (:temporary (:sc #!-gengc descriptor-reg #!+gengc any-reg :from (:argument 1))
+ (:temporary (:sc #!-gengc descriptor-reg #!+gengc any-reg
+ :from (:argument 1))
return-pc-temp)
#!-gengc (:temporary (:scs (interior-reg)) lip)
(:move-args :known-return)
\f
;;;; Full call:
-;;;
-;;; There is something of a cross-product effect with full calls. Different
-;;; versions are used depending on whether we know the number of arguments or
-;;; the name of the called function, and whether we want fixed values, unknown
-;;; values, or a tail call.
-;;;
-;;; In full call, the arguments are passed creating a partial frame on the
-;;; stack top and storing stack arguments into that frame. On entry to the
-;;; callee, this partial frame is pointed to by FP. If there are no stack
-;;; arguments, we don't bother allocating a partial frame, and instead set FP
-;;; to SP just before the call.
-
-;;; Define-Full-Call -- Internal
-;;;
-;;; This macro helps in the definition of full call VOPs by avoiding code
-;;; replication in defining the cross-product VOPs.
+;;;;
+;;;; There is something of a cross-product effect with full calls.
+;;;; Different versions are used depending on whether we know the
+;;;; number of arguments or the name of the called function, and
+;;;; whether we want fixed values, unknown values, or a tail call.
+;;;;
+;;;; In full call, the arguments are passed creating a partial frame on
+;;;; the stack top and storing stack arguments into that frame. On
+;;;; entry to the callee, this partial frame is pointed to by FP. If
+;;;; there are no stack arguments, we don't bother allocating a partial
+;;;; frame, and instead set FP to SP just before the call.
+
+;;; This macro helps in the definition of full call VOPs by avoiding
+;;; code replication in defining the cross-product VOPs.
;;;
;;; Name is the name of the VOP to define.
;;;
-;;; Named is true if the first argument is a symbol whose global function
-;;; definition is to be called.
+;;; Named is true if the first argument is a symbol whose global
+;;; function definition is to be called.
;;;
;;; Return is either :Fixed, :Unknown or :Tail:
;;; -- If :Fixed, then the call is for a fixed number of values, returned in
;;; -- If :Tail, then do a tail-recursive call. No values are returned.
;;; The Ocfp and Return-PC are passed as the second and third arguments.
;;;
-;;; In non-tail calls, the pointer to the stack arguments is passed as the last
-;;; fixed argument. If Variable is false, then the passing locations are
-;;; passed as a more arg. Variable is true if there are a variable number of
-;;; arguments passed on the stack. Variable cannot be specified with :Tail
-;;; return. TR variable argument call is implemented separately.
-;;;
-;;; In tail call with fixed arguments, the passing locations are passed as a
-;;; more arg, but there is no new-FP, since the arguments have been set up in
-;;; the current frame.
+;;; In non-tail calls, the pointer to the stack arguments is passed as
+;;; the last fixed argument. If Variable is false, then the passing
+;;; locations are passed as a more arg. Variable is true if there are
+;;; a variable number of arguments passed on the stack. Variable
+;;; cannot be specified with :Tail return. TR variable argument call
+;;; is implemented separately.
;;;
+;;; In tail call with fixed arguments, the passing locations are
+;;; passed as a more arg, but there is no new-FP, since the arguments
+;;; have been set up in the current frame.
(defmacro define-full-call (name named return variable)
(assert (not (and variable (eq return :tail))))
`(define-vop (,name
(maybe-load-stack-nfp-tn cur-nfp nfp-save temp)))
(:tail))))))
-
(define-full-call call nil :fixed nil)
(define-full-call call-named t :fixed nil)
(define-full-call multiple-call nil :unknown nil)
(define-full-call call-variable nil :fixed t)
(define-full-call multiple-call-variable nil :unknown t)
-
-;;; Defined separately, since needs special code that BLT's the arguments
-;;; down.
-;;;
+;;; This is defined separately, since it needs special code that blits
+;;; the arguments down.
(define-vop (tail-call-variable)
(:args
(args-arg :scs (any-reg) :target args)
;; And jump to the assembly-routine that does the bliting.
(inst li (make-fixup 'tail-call-variable :assembly-routine) temp)
(inst jmp zero-tn temp)))
-
\f
-;;;; Unknown values return:
+;;;; unknown values return
;;; Return a single value using the unknown-values convention.
-;;;
(define-vop (return-single)
(:args (ocfp :scs (any-reg))
#!-gengc (return-pc :scs (descriptor-reg))
(inst ret zero-tn temp 1))
(trace-table-entry trace-table-normal)))
-
-;;; Do unknown-values return of a fixed number of values. The Values are
-;;; required to be set up in the standard passing locations. Nvals is the
-;;; number of values returned.
+;;; Do unknown-values return of a fixed number of values. The Values
+;;; are required to be set up in the standard passing locations. Nvals
+;;; is the number of values returned.
;;;
-;;; If returning a single value, then deallocate the current frame, restore
-;;; FP and jump to the single-value entry at Return-PC + 8.
-;;;
-;;; If returning other than one value, then load the number of values returned,
-;;; NIL out unsupplied values registers, restore FP and return at Return-PC.
-;;; When there are stack values, we must initialize the argument pointer to
-;;; point to the beginning of the values block (which is the beginning of the
-;;; current frame.)
+;;; If returning a single value, then deallocate the current frame,
+;;; restore FP and jump to the single-value entry at Return-PC + 8.
;;;
+;;; If returning other than one value, then load the number of values
+;;; returned, NIL out unsupplied values registers, restore FP and
+;;; return at Return-PC. When there are stack values, we must
+;;; initialize the argument pointer to point to the beginning of the
+;;; values block (which is the beginning of the current frame.)
(define-vop (return)
(:args (ocfp :scs (any-reg))
- (return-pc :scs (#!-gengc descriptor-reg #!+gengc any-reg) :to (:eval 1)
+ (return-pc :scs (#!-gengc descriptor-reg #!+gengc any-reg)
+ :to (:eval 1)
#!+gengc :target #!+gengc ra)
(values :more t))
(:ignore values)
(lisp-return return-pc lip)
(trace-table-entry trace-table-normal)))
-;;; Do unknown-values return of an arbitrary number of values (passed on the
-;;; stack.) We check for the common case of a single return value, and do that
-;;; inline using the normal single value return convention. Otherwise, we
-;;; branch off to code that calls an assembly-routine.
-;;;
+;;; Do unknown-values return of an arbitrary number of values (passed
+;;; on the stack.) We check for the common case of a single return
+;;; value, and do that inline using the normal single value return
+;;; convention. Otherwise, we branch off to code that calls an
+;;; assembly-routine.
(define-vop (return-multiple)
(:args (ocfp-arg :scs (any-reg) :target ocfp)
#!-gengc (lra-arg :scs (descriptor-reg) :target lra)
(inst li (make-fixup 'return-multiple :assembly-routine) temp)
(inst jmp zero-tn temp))
(trace-table-entry trace-table-normal)))
-
-
\f
-;;;; XEP hackery:
-
+;;;; XEP hackery
;;; We don't need to do anything special for regular functions.
-;;;
(define-vop (setup-environment)
(:info label)
(:ignore label)
))
;;; Get the lexical environment from its passing location.
-;;;
(define-vop (setup-closure-environment)
(:temporary (:sc descriptor-reg :offset lexenv-offset :target closure
:to (:result 0))
;; Get result.
(move lexenv closure)))
-;;; Copy a more arg from the argument area to the end of the current frame.
-;;; Fixed is the number of non-more arguments.
-;;;
+;;; Copy a &MORE arg from the argument area to the end of the current
+;;; frame. FIXED is the number of non-more arguments.
(define-vop (copy-more-arg)
(:temporary (:sc any-reg :offset nl0-offset) result)
(:temporary (:sc any-reg :offset nl1-offset) count)
(inst subq count (fixnumize 1) count)))
(emit-label done))))
-
-;;; More args are stored consequtively on the stack, starting immediately at
-;;; the context pointer. The context pointer is not typed, so the lowtag is 0.
-;;;
+;;; &More args are stored consecutively on the stack, starting
+;;; immediately at the context pointer. The context pointer is not
+;;; typed, so the lowtag is 0.
(define-full-reffer more-arg * 0 0 (descriptor-reg any-reg) * %more-arg)
-
-;;; Turn more arg (context, count) into a list.
-;;;
+;;; Turn &MORE arg (context, count) into a list.
(define-vop (listify-rest-args)
(:args (context-arg :target context :scs (descriptor-reg))
(count-arg :target count :scs (any-reg)))
(storew null-tn dst 1 list-pointer-type))
(emit-label done))))
-;;; Return the location and size of the more arg glob created by Copy-More-Arg.
-;;; Supplied is the total number of arguments supplied (originally passed in
-;;; NARGS.) Fixed is the number of non-rest arguments.
-;;;
-;;; We must duplicate some of the work done by Copy-More-Arg, since at that
-;;; time the environment is in a pretty brain-damaged state, preventing this
-;;; info from being returned as values. What we do is compute
-;;; supplied - fixed, and return a pointer that many words below the current
-;;; stack top.
+;;; Return the location and size of the &MORE arg glob created by
+;;; Copy-More-Arg. Supplied is the total number of arguments supplied
+;;; (originally passed in NARGS.) Fixed is the number of non-&rest
+;;; arguments.
;;;
+;;; We must duplicate some of the work done by Copy-More-Arg, since at
+;;; that time the environment is in a pretty brain-damaged state,
+;;; preventing this info from being returned as values. What we do is
+;;; compute supplied - fixed, and return a pointer that many words
+;;; below the current stack top.
(define-vop (more-arg-context)
(:policy :fast-safe)
(:translate sb!c::%more-arg-context)
(inst subq csp-tn count context)))
-;;; Signal wrong argument count error if Nargs isn't = to Count.
-;;;
+;;; Signal wrong argument count error if Nargs isn't equal to Count.
(define-vop (verify-argument-count)
(:policy :fast-safe)
(:translate sb!c::%verify-argument-count)
(inst subq nargs (fixnumize count) temp)
(inst bne temp err-lab))))))
-;;; Various other error signalers.
-;;;
+;;; various other error signalers
(macrolet ((frob (name error translate &rest args)
`(define-vop (,name)
,@(when translate
-;;; -*- 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.
-;;;
-
-;;;
-;;; **********************************************************************
-;;;
-;;; This file contains the VM definition of various primitive memory access
-;;; VOPs for the Alpha.
-;;;
-;;; Written by Rob MacLachlan
-;;;
-;;; Converted by Sean Hallgren
-;;;
+;;;; the VM definition of various primitive memory access VOPs for the
+;;;; Alpha
+
+;;;; 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")
-
-
\f
-;;;; Data object ref/set stuff.
+;;;; data object ref/set stuff
(define-vop (slot)
(:args (object :scs (descriptor-reg)))
(storew value object offset lowtag))
#-gengc
(storew value object offset lowtag)))
-
\f
-;;;; Symbol hacking VOPs:
+;;;; symbol hacking VOPs
;;; The compiler likes to be able to directly SET symbols.
-;;;
(define-vop (set cell-set)
(:variant symbol-value-slot other-pointer-type))
;;; Do a cell ref with an error check for being unbound.
-;;;
(define-vop (checked-cell-ref)
(:args (object :scs (descriptor-reg) :target obj-temp))
(:results (value :scs (descriptor-reg any-reg)))
(:temporary (:scs (non-descriptor-reg)) temp)
(:temporary (:scs (descriptor-reg) :from (:argument 0)) obj-temp))
-;;; With Symbol-Value, we check that the value isn't the trap object. So
-;;; Symbol-Value of NIL is NIL.
-;;;
+;;; With SYMBOL-VALUE, we check that the value isn't the trap object.
+;;; So SYMBOL-VALUE of NIL is NIL.
(define-vop (symbol-value checked-cell-ref)
(:translate symbol-value)
(:generator 9
(inst xor value unbound-marker-type temp)
(inst beq temp err-lab))))
-;;; Like CHECKED-CELL-REF, only we are a predicate to see if the cell is bound.
+;;; Like CHECKED-CELL-REF, only we are a predicate to see if the cell
+;;; is bound.
(define-vop (boundp-frob)
(:args (object :scs (descriptor-reg)))
(:conditional)
\f
-;;;; Fdefinition (fdefn) objects.
+;;;; FDEFINITION (fdefn) objects
(define-vop (fdefn-function cell-ref)
(:variant fdefn-function-slot other-pointer-type))
(inst li (make-fixup "undefined_tramp" :foreign) temp)
(move fdefn result)
(storew temp fdefn fdefn-raw-addr-slot other-pointer-type)))
-
-
\f
-;;;; Binding and Unbinding.
-
-;;; BIND -- Establish VAL as a binding for SYMBOL. Save the old value and
-;;; the symbol on the binding stack and stuff the new value into the
-;;; symbol.
+;;;; binding and Unbinding
+;;; Establish VAL as a binding for SYMBOL. Save the old value and the
+;;; symbol on the binding stack and stuff the new value into the symbol.
(define-vop (bind)
(:args (val :scs (any-reg descriptor-reg))
(symbol :scs (descriptor-reg)))
(inst beq temp loop)
(emit-label done))))
-
-
\f
-;;;; Closure indexing.
+;;;; closure indexing
(define-full-reffer closure-index-ref *
closure-info-offset function-pointer-type
(define-vop (closure-init slot-set)
(:variant closure-info-offset function-pointer-type))
-
\f
-;;;; Value Cell hackery.
+;;;; value cell hackery
(define-vop (value-cell-ref cell-ref)
(:variant value-cell-value-slot other-pointer-type))
(define-vop (value-cell-set cell-set)
(:variant value-cell-value-slot other-pointer-type))
-
-
\f
-;;;; Instance hackery:
+;;;; instance hackery
(define-vop (instance-length)
(:policy :fast-safe)
(define-full-setter instance-index-set * instance-slots-offset
instance-pointer-type (descriptor-reg any-reg null zero) * %instance-set)
-
-
\f
-;;;; Code object frobbing.
+;;;; code object frobbing
(define-full-reffer code-header-ref * 0 other-pointer-type
(descriptor-reg any-reg) * code-header-ref)
(define-full-setter code-header-set * 0 other-pointer-type
(descriptor-reg any-reg null zero) * code-header-set)
-
-
\f
-;;;; Mutator accessing.
+;;;; mutator accessing
+
+#+gengc
+(progn
-#+gengc (progn
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ ;; SBCL has never had GENGC. Now that we have Alpha support, it
+ ;; would probably be nice to restore GENGC support so that the Alpha
+ ;; doesn't have to crawl along with stop'n'copy. When we do, the CMU
+ ;; CL code below will need updating to the SBCL way of looking at
+ ;; things, e.g. at least using "SB-KERNEL" or "SB!KERNEL" instead of
+ ;; :KERNEL. -- WHN 2001-05-08
+ (error "This code is stale as of sbcl-0.6.12."))
(define-vop (mutator-ub32-ref)
(:policy :fast-safe)
(lisp-type ref-vop set-vop)
(ecase type
(:des
- (values t 'mutator-descriptor-ref 'mutator-descriptor-set))
+ (values t
+ 'mutator-descriptor-ref
+ 'mutator-descriptor-set))
(:ub32
- (values '(unsigned-byte 32) 'mutator-ub32-ref 'mutator-ub32-set))
+ (values '(unsigned-byte 32)
+ 'mutator-ub32-ref
+ 'mutator-ub32-set))
(:sap
- (values 'system-area-pointer 'mutator-sap-ref 'mutator-sap-set)))
+ (values 'system-area-pointer
+ 'mutator-sap-ref
+ 'mutator-sap-set)))
`(progn
(export ',fn :kernel)
(defknown ,fn () ,lisp-type (flushable))
(:translate ,fn)
(:variant ,offset))
,@(when writable
- `((defknown ((setf ,fn)) (,lisp-type) ,lisp-type (unsafe))
+ `((defknown ((setf ,fn)) (,lisp-type) ,lisp-type
+ (unsafe))
(define-vop (,set ,set-vop)
(:translate (setf ,fn))
(:variant ,offset)))))))))
-;;; -*- Package: C; 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.
-;;;
-
-;;;
-;;; **********************************************************************
-;;;
-;;; $Header$
-;;;
-;;; This file contains the RT VM definition of character operations.
-;;;
-;;; Written by Rob MacLachlan
-;;; Converted for the Alpha by Sean Hallgren.
-;;;
-(in-package "SB!VM")
-
+;;;; the Alpha VM definition of character operations
+;;;; 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")
\f
-;;;; Moves and coercions:
+;;;; moves and coercions
;;; Move a tagged char to an untagged representation.
-;;;
(define-vop (move-to-base-char)
(:args (x :scs (any-reg descriptor-reg)))
(:results (y :scs (base-char-reg)))
(define-move-vop move-to-base-char :move
(any-reg descriptor-reg) (base-char-reg))
-
;;; Move an untagged char to a tagged representation.
-;;;
(define-vop (move-from-base-char)
(:args (x :scs (base-char-reg)))
(:results (y :scs (any-reg descriptor-reg)))
(base-char-reg) (any-reg descriptor-reg))
;;; Move untagged base-char values.
-;;;
(define-vop (base-char-move)
(:args (x :target y
:scs (base-char-reg)
;;; Move untagged base-char arguments/return-values.
-;;;
(define-vop (move-base-char-argument)
(:args (x :target y
:scs (base-char-reg))
;;;
(define-move-vop move-argument :move-argument
(base-char-reg) (any-reg descriptor-reg))
-
-
\f
-;;;; Other operations:
+;;;; other operations
(define-vop (char-code)
(:translate char-code)
(:result-types base-char)
(:generator 1
(inst srl code 2 res)))
-
\f
-;;; Comparison of base-chars.
-;;;
+;;;; comparison of BASE-CHARs
+
(define-vop (base-char-compare)
(:args (x :scs (base-char-reg))
(y :scs (base-char-reg)))
-;;; -*- 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.
-;;;
-
-;;;
-;;; **********************************************************************
-;;;
-;;; Compiler support for the new whizzy debugger.
-;;;
-;;; Written by William Lott.
-;;; Converted by Sean Hallgren.
-;;;
-(in-package "SB!VM")
+;;;; Alpha compiler support for the new whizzy debugger
+;;;; 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-vop (debug-cur-sp)
(:translate current-sp)
(loadw res fun 0 function-pointer-type)
(inst srl res sb!vm:type-bits res)))
-
-
-
(defknown make-number-stack-pointer ((unsigned-byte 32)) system-area-pointer
(movable foldable flushable))
-;;; This file contains floating point support for the Alpha.
-
-(in-package "SB!VM")
+;;;; floating point support for the Alpha
+;;;; 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")
\f
-;;;; Move functions:
+;;;; float move functions
(define-move-function (load-fp-zero 1) (vop x y)
((fp-single-zero) (single-reg)
(let ((nfp (current-nfp-tn vop))
(offset (* (tn-offset y) word-bytes)))
(inst stt x offset nfp)))
-
-
\f
-;;;; Move VOPs:
+;;;; float move VOPs
(macrolet ((frob (vop sc)
`(progn
(,sc descriptor-reg) (,sc)))))
(frob move-single-float-argument single-reg single-stack nil)
(frob move-double-float-argument double-reg double-stack t))
-
\f
-;;;; Complex float move functions
+;;;; complex float move functions
(defun complex-single-reg-real-tn (x)
(make-random-tn :kind :normal :sc (sc-or-lose 'single-reg )
(inst stt imag-tn (+ offset (* 2 sb!vm:word-bytes)) nfp))))
;;;
-;;; Complex float register to register moves.
+;;; complex float register to register moves.
;;;
(define-vop (complex-single-move)
(:args (x :scs (complex-single-reg) :target y
(complex-double-reg) (descriptor-reg))
;;;
-;;; Move from a descriptor to a complex float register
+;;; Move from a descriptor to a complex float register.
;;;
(define-vop (move-to-complex-single)
(:args (x :scs (descriptor-reg)))
(descriptor-reg) (complex-double-reg))
;;;
-;;; Complex float move-argument vop
+;;; complex float move-argument vop
;;;
(define-vop (move-complex-single-float-argument)
(:args (x :scs (complex-single-reg) :target y)
(descriptor-reg))
\f
-;;;; Arithmetic VOPs:
+;;;; float arithmetic VOPs
(define-vop (float-op)
(:args (x) (y))
(:vop-var vop)
(:save-p :compute-only))
-;;; Need to insure that ops that can cause traps do not clobber an
-;;; argument register with invalid results. This so the software
-;;; trap handler can re-execute the instruction and produce correct
-;;; IEEE result. The :from :load hopefully does that.
+;;; We need to insure that ops that can cause traps do not clobber an
+;;; argument register with invalid results. This so the software trap
+;;; handler can re-execute the instruction and produce correct IEEE
+;;; result. The :from :load hopefully does that.
(macrolet ((frob (name sc ptype)
`(define-vop (,name float-op)
(:args (x :scs (,sc))
(frob %negate/double-float fneg %negate double-reg double-float))
\f
-;;;; Comparison:
+;;;; float comparison
(define-vop (float-compare)
(:args (x) (y))
(frob = nil =/single-float =/double-float t))
\f
-;;;; Conversion:
+;;;; float conversion
(macrolet
((frob (name translate inst ld-inst to-sc to-type &optional single)
(inst mskll lo-bits 4 lo-bits)))
\f
-;;;; Float mode hackery:
+;;;; float mode hackery
(sb!xc:deftype float-modes () '(unsigned-byte 32)) ;actually 24 -dan
(defknown floating-point-modes () float-modes (flushable))
(move res new))))
\f
-;;;; Complex float VOPs
+;;;; complex float VOPs
(define-vop (make-complex-single-float)
(:translate complex)
-;;; -*- 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 instruction set definition for the Alpha.
-;;;
-;;; Written by Sean Hallgren.
-;;;
+;;; the instruction set definition for the Alpha
-(in-package "SB!VM")
+;;;; 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")
;;;(def-assembler-params
;;; :scheduler-p nil)
;;; ../x86/insts contains the invocation
;;; (setf sb!disassem:*disassem-inst-alignment-bytes* 1)
;;; which apparently was another use of def-assembler-params
-
\f
-;;;; Utility functions.
+;;;; utility functions
(defun reg-tn-encoding (tn)
(declare (type tn tn)
(unless (eq (sb-name (sc-sb (tn-sc tn))) 'float-registers)
(error "~S isn't a floating-point register." tn))
(tn-offset tn))))
-
\f
-;;;; Initial disassembler setup.
+;;;; initial disassembler setup
;; XXX find out what this was supposed to do
;; (sb!disassem:set-disassem-params :instruction-alignment 32)
\f
-;;;; Define-instruction-formats for disassembler.
+;;;; DEFINE-INSTRUCTION-FORMATs for the disassembler
+
(sb!disassem:define-instruction-format
(memory 32 :default-printer '(:name :tab ra "," disp "(" rb ")"))
(op :field (byte 6 26))
(palcode :field (byte 26 0)))
\f
-;;;; Emitters.
+;;;; emitters
+
(define-bitfield-emitter emit-word 16
(byte 16 0))
(define-bitfield-emitter emit-pal 32
(byte 6 26) (byte 26 0))
-
\f
-;;;; Macros for instructions.
+;;;; macros for instructions
+
(macrolet ((define-memory (name op &optional fixup float)
`(define-instruction ,name (segment ra disp rb ,@(if fixup
'(&optional type)))
-;;; -*- 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.
-;;;
+;;;; various useful macros for generating Alpha code
-;;;
-;;; **********************************************************************
-;;;
-;;; This file contains various useful macros for generating Alpha code.
-;;;
-;;; Written by William Lott and Christopher Hoover.
-;;; Alpha conversion by Sean Hallgren.
-;;;
+;;;; 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")
-
-;;; Handy macro for defining top-level forms that depend on the compile
-;;; environment.
-
+;;; a handy macro for defining top-level forms that depend on the
+;;; compile environment
(defmacro expand (expr)
(let ((gensym (gensym)))
`(macrolet
((,gensym ()
,expr))
(,gensym))))
-
\f
-;;; Instruction-like macros.
+;;; instruction-like macros
;;; c.f. x86 backend:
;;(defmacro move (dst src)
;; `(unless (location= ,n-dst ,n-src)
;; (inst mov ,n-dst ,n-src))))
-
(defmacro move (src dst)
"Move SRC into DST unless they are location=."
(once-only ((n-src src) (n-dst dst))
(inst ldl ,n-target ,n-offset ,n-source)
(inst and ,n-target #xff ,n-target))))
-;;; Macros to handle the fact that we cannot use the machine native call and
-;;; return instructions.
+;;; macros to handle the fact that we cannot use the machine native
+;;; call and return instructions
(defmacro lisp-jump (function lip)
"Jump to the lisp function FUNCTION. LIP is an interior-reg temporary."
\f
-;;;; Stack TN's
+;;;; stack TN's
-;;; Load-Stack-TN, Store-Stack-TN -- Interface
-;;;
;;; Move a stack TN to a register and vice-versa.
-;;;
(defmacro load-stack-tn (reg stack)
`(let ((reg ,reg)
(stack ,stack))
(sc-case stack
((control-stack)
(loadw reg cfp-tn offset))))))
-
(defmacro store-stack-tn (stack reg)
`(let ((stack ,stack)
(reg ,reg))
((control-stack)
(storew reg cfp-tn offset))))))
-
-;;; MAYBE-LOAD-STACK-TN -- Interface
-;;;
+;;; Move the TN Reg-Or-Stack into Reg if it isn't already there.
(defmacro maybe-load-stack-tn (reg reg-or-stack)
- "Move the TN Reg-Or-Stack into Reg if it isn't already there."
(once-only ((n-reg reg)
(n-stack reg-or-stack))
`(sc-case ,n-reg
((control-stack)
(loadw ,n-reg cfp-tn (tn-offset ,n-stack))))))))
-;;; MAYBE-LOAD-STACK-NFP-TN -- Interface
-;;;
+;;; Move the TN Reg-Or-Stack into Reg if it isn't already there.
(defmacro maybe-load-stack-nfp-tn (reg reg-or-stack temp)
- "Move the TN Reg-Or-Stack into Reg if it isn't already there."
(once-only ((n-reg reg)
(n-stack reg-or-stack))
`(when ,reg
(loadw ,n-reg cfp-tn (tn-offset ,n-stack))
(inst mskll nsp-tn 0 ,temp)
(inst bis ,temp ,n-reg ,n-reg))))))))
-
-
\f
-;;;; Storage allocation:
-
+;;;; storage allocation
+
+;;; Do stuff to allocate an other-pointer object of fixed Size with a
+;;; single word header having the specified Type-Code. The result is
+;;; placed in Result-TN, Flag-Tn must be wired to NL3-OFFSET, and
+;;; Temp-TN is a non- descriptor temp (which may be randomly used by
+;;; the body.) The body is placed inside the PSEUDO-ATOMIC, and
+;;; presumably initializes the object.
(defmacro with-fixed-allocation ((result-tn temp-tn type-code size)
&body body)
- "Do stuff to allocate an other-pointer object of fixed Size with a single
- word header having the specified Type-Code. The result is placed in
- Result-TN, Flag-Tn must be wired to NL3-OFFSET, and Temp-TN is a non-
- descriptor temp (which may be randomly used by the body.) The body is
- placed inside the PSEUDO-ATOMIC, and presumably initializes the object."
`(pseudo-atomic (:extra (pad-data-block ,size))
(inst bis alloc-tn other-pointer-type ,result-tn)
(inst li (logior (ash (1- ,size) type-bits) ,type-code) ,temp-tn)
-;;; -*- 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.
-;;;
+;;;; the Alpha definitions of some general purpose memory reference
+;;;; VOPs inherited by basic memory reference operations
-;;;
-;;; **********************************************************************
-;;;
-;;; This file contains the Alpha definitions of some general purpose memory
-;;; reference VOPs inherited by basic memory reference operations.
-;;;
-;;; Written by Rob MacLachlan
-;;;
-;;; Converted by Sean Hallgren.
-;;;
+;;;; 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")
-
-
-;;; Cell-Ref and Cell-Set are used to define VOPs like CAR, where the offset to
-;;; be read or written is a property of the VOP used.
-;;;
+;;; Cell-Ref and Cell-Set are used to define VOPs like CAR, where the
+;;; offset to be read or written is a property of the VOP used.
(define-vop (cell-ref)
(:args (object :scs (descriptor-reg)))
(:results (value :scs (descriptor-reg any-reg)))
(:policy :fast-safe)
(:generator 4
(loadw value object offset lowtag)))
-;;;
(define-vop (cell-set)
(:args (object :scs (descriptor-reg))
(value :scs (descriptor-reg any-reg null zero)))
(:generator 4
(storew value object offset lowtag)))
-;;; Slot-Ref and Slot-Set are used to define VOPs like Closure-Ref, where the
-;;; offset is constant at compile time, but varies for different uses. We add
-;;; in the stardard g-vector overhead.
-;;;
+;;; Slot-Ref and Slot-Set are used to define VOPs like Closure-Ref,
+;;; where the offset is constant at compile time, but varies for
+;;; different uses. We add in the stardard g-vector overhead.
(define-vop (slot-ref)
(:args (object :scs (descriptor-reg)))
(:results (value :scs (descriptor-reg any-reg)))
(:info offset)
(:generator 4
(loadw value object (+ base offset) lowtag)))
-;;;
(define-vop (slot-set)
(:args (object :scs (descriptor-reg))
(value :scs (descriptor-reg any-reg null zero)))
-;;; -*- 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 MIPS VM definition of operand loading/saving and
-;;; the Move VOP.
-;;;
-;;; Written by Rob MacLachlan.
-;;; Conversion by Sean Hallgren.
-;;;
-(in-package "SB!VM")
+;;;; the Alpha VM definition of operand loading/saving and the Move VOP
+;;;; 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-move-function (load-immediate 1) (vop x y)
((null zero immediate)
(unsigned-reg) (unsigned-stack))
(let ((nfp (current-nfp-tn vop)))
(storeq x nfp (tn-offset y))))
-
\f
-;;;; The Move VOP:
-;;;
+;;;; The Move VOP
+
(define-vop (move)
(:args (x :target y
:scs (any-reg descriptor-reg zero null)
(any-reg descriptor-reg zero null)
(any-reg descriptor-reg))
-;;; Make Move the check VOP for T so that type check generation doesn't think
-;;; it is a hairy type. This also allows checking of a few of the values in a
-;;; continuation to fall out.
-;;;
+;;; Make Move the check VOP for T so that type check generation
+;;; doesn't think it is a hairy type. This also allows checking of a
+;;; few of the values in a continuation to fall out.
(primitive-type-vop move (:check) t)
-;;; The Move-Argument VOP is used for moving descriptor values into another
-;;; frame for argument or known value passing.
-;;;
+;;; The Move-Argument VOP is used for moving descriptor values into
+;;; another frame for argument or known value passing.
(define-vop (move-argument)
(:args (x :target y
:scs (any-reg descriptor-reg null zero))
(define-move-vop move-argument :move-argument
(any-reg descriptor-reg null zero)
(any-reg descriptor-reg))
-
-
\f
;;;; ILLEGAL-MOVE
-;;; This VOP exists just to begin the lifetime of a TN that couldn't be written
-;;; legally due to a type error. An error is signalled before this VOP is
-;;; so we don't need to do anything (not that there would be anything sensible
-;;; to do anyway.)
-;;;
+;;; This VOP exists just to begin the lifetime of a TN that couldn't
+;;; be written legally due to a type error. An error is signalled
+;;; before this VOP is so we don't need to do anything (not that there
+;;; would be anything sensible to do anyway.)
(define-vop (illegal-move)
(:args (x) (type))
(:results (y))
(:save-p :compute-only)
(:generator 666
(error-call vop object-not-type-error x type)))
-
-
\f
-;;;; Moves and coercions:
-
-;;; These MOVE-TO-WORD VOPs move a tagged integer to a raw full-word
-;;; representation. Similarly, the MOVE-FROM-WORD VOPs converts a raw integer
-;;; to a tagged bignum or fixnum.
-
-;;; Arg is a fixnum, so just shift it. We need a type restriction because some
-;;; possible arg SCs (control-stack) overlap with possible bignum arg SCs.
-;;;
+;;;; moves and coercions
+;;;;
+;;;; These MOVE-TO-WORD VOPs move a tagged integer to a raw full-word
+;;;; representation. Similarly, the MOVE-FROM-WORD VOPs converts a raw
+;;;; integer to a tagged bignum or fixnum.
+
+;;; Arg is a fixnum, so just shift it. We need a type restriction
+;;; because some possible arg SCs (control-stack) overlap with
+;;; possible bignum arg SCs.
(define-vop (move-to-word/fixnum)
(:args (x :scs (any-reg descriptor-reg)))
(:results (y :scs (signed-reg unsigned-reg)))
(descriptor-reg) (signed-reg unsigned-reg))
-;;; Result is a fixnum, so we can just shift. We need the result type
+;;; Result is a fixnum, so we can just shift. We need the result type
;;; restriction because of the control-stack ambiguity noted above.
-;;;
(define-vop (move-from-word/fixnum)
(:args (x :scs (signed-reg unsigned-reg)))
(:results (y :scs (any-reg descriptor-reg)))
(define-move-vop move-from-word/fixnum :move
(signed-reg unsigned-reg) (any-reg descriptor-reg))
-;;; Result may be a bignum, so we have to check. Use a worst-case cost to make
-;;; sure people know they may be number consing.
-;;;
+;;; Result may be a bignum, so we have to check. Use a worst-case cost
+;;; to make sure people know they may be number consing.
(define-vop (move-from-signed)
(:args (arg :scs (signed-reg unsigned-reg) :target x))
(:results (y :scs (any-reg descriptor-reg)))
(define-move-vop move-from-signed :move
(signed-reg) (descriptor-reg))
-
-;;; Check for fixnum, and possibly allocate one or two word bignum result. Use
-;;; a worst-case cost to make sure people know they may be number consing.
-;;;
+;;; Check for fixnum, and possibly allocate one or two word bignum
+;;; result. Use a worst-case cost to make sure people know they may be
+;;; number consing.
(define-vop (move-from-unsigned)
(:args (arg :scs (signed-reg unsigned-reg) :target x))
(:results (y :scs (any-reg descriptor-reg)))
(define-move-vop move-from-unsigned :move
(unsigned-reg) (descriptor-reg))
-
;;; Move untagged numbers.
-;;;
(define-vop (word-move)
(:args (x :target y
:scs (signed-reg unsigned-reg)
(define-move-vop word-move :move
(signed-reg unsigned-reg) (signed-reg unsigned-reg))
-
;;; Move untagged number arguments/return-values.
-;;;
(define-vop (move-word-argument)
(:args (x :target y
:scs (signed-reg unsigned-reg))
(descriptor-reg any-reg signed-reg unsigned-reg) (signed-reg unsigned-reg))
-;;; Use standard MOVE-ARGUMENT + coercion to move an untagged number to a
-;;; descriptor passing location.
-;;;
+;;; Use standard MOVE-ARGUMENT + coercion to move an untagged number
+;;; to a descriptor passing location.
(define-move-vop move-argument :move-argument
(signed-reg unsigned-reg) (any-reg descriptor-reg))
-;;; -*- 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.
-;;;
+;;;; the definitions of VOPs used for non-local exit (throw, lexical
+;;;; exit, etc.)
+
+;;;; 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.
-;;;
-;;; **********************************************************************
-;;;
-;;; This file contains the definitions of VOPs used for non-local exit
-;;; (throw, lexical exit, etc.)
-;;;
-;;; Written by Rob MacLachlan
-;;; Conversion by Sean Hallgren
-;;;
(in-package "SB!VM")
-
-;;; MAKE-NLX-SP-TN -- Interface
-;;;
-;;; Make an environment-live stack TN for saving the SP for NLX entry.
-;;;
+;;; Make an environment-live stack TN for saving the SP for NLX entry.
(!def-vm-support-routine make-nlx-sp-tn (env)
(environment-live-tn
(make-representation-tn *fixnum-primitive-type* immediate-arg-scn)
env))
-;;; Make-NLX-Entry-Argument-Start-Location -- Interface
-;;;
-;;; Make a TN for the argument count passing location for a
+;;; Make a TN for the argument count passing location for a
;;; non-local entry.
-;;;
(!def-vm-support-routine make-nlx-entry-argument-start-location ()
(make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset))
\f
-;;; Save and restore dynamic environment.
-;;;
-;;; These VOPs are used in the reentered function to restore the appropriate
-;;; dynamic environment. Currently we only save the Current-Catch and binding
-;;; stack pointer. We don't need to save/restore the current unwind-protect,
-;;; since unwind-protects are implicitly processed during unwinding. If there
-;;; were any additional stacks, then this would be the place to restore the top
-;;; pointers.
-
-
-;;; Make-Dynamic-State-TNs -- Interface
-;;;
-;;; Return a list of TNs that can be used to snapshot the dynamic state for
+;;;; save and restoring the dynamic environment
+;;;;
+;;;; These VOPs are used in the reentered function to restore the
+;;;; appropriate dynamic environment. Currently we only save the
+;;;; Current-Catch and binding stack pointer. We don't need to
+;;;; save/restore the current unwind-protect, since unwind-protects
+;;;; are implicitly processed during unwinding. If there were any
+;;;; additional stacks, then this would be the place to restore the
+;;;; top pointers.
+
+
+;;; Return a list of TNs that can be used to snapshot the dynamic state for
;;; use with the Save/Restore-Dynamic-Environment VOPs.
-;;;
(!def-vm-support-routine make-dynamic-state-tns ()
(list (make-normal-tn *backend-t-primitive-type*)
(make-normal-tn *backend-t-primitive-type*)
(:results (res :scs (any-reg descriptor-reg)))
(:generator 1
(move bsp-tn res)))
-
-
\f
-;;;; Unwind block hackery:
+;;;; unwind block hackery
-;;; Compute the address of the catch block from its TN, then store into the
-;;; block the current Fp, Env, Unwind-Protect, and the entry PC.
-;;;
+;;; Compute the address of the catch block from its TN, then store
+;;; into the block the current Fp, Env, Unwind-Protect, and the entry PC.
(define-vop (make-unwind-block)
(:args (tn))
(:info entry-label)
(storew temp block sb!vm:catch-block-entry-pc-slot)))
-;;; Like Make-Unwind-Block, except that we also store in the specified tag, and
-;;; link the block into the Current-Catch list.
-;;;
+;;; This is like Make-Unwind-Block, except that we also store in the
+;;; specified tag, and link the block into the Current-Catch list.
(define-vop (make-catch-block)
(:args (tn)
(tag :scs (descriptor-reg)))
(move result block)))
-
-;;; Just set the current unwind-protect to TN's address. This instantiates an
-;;; unwind block as an unwind-protect.
-;;;
+;;; Just set the current unwind-protect to TN's address. This
+;;; instantiates an unwind block as an unwind-protect.
(define-vop (set-unwind-protect)
(:args (tn))
(:temporary (:scs (descriptor-reg)) new-uwp)
(load-symbol-value block sb!impl::*current-unwind-protect-block*)
(loadw block block sb!vm:unwind-block-current-uwp-slot)
(store-symbol-value block sb!impl::*current-unwind-protect-block*)))
-
\f
-;;;; NLX entry VOPs:
-
+;;;; NLX entry VOPs
(define-vop (nlx-entry)
(:args (sp) ; Note: we can't list an sc-restriction, 'cause any load vops
(inst br zero-tn defaulting-done))))))
(load-stack-tn csp-tn sp)))
-
(define-vop (nlx-entry-multiple)
(:args (top :target dst) (start :target src) (count :target num))
;; Again, no SC restrictions for the args, 'cause the loading would
(emit-label done)
(inst move dst csp-tn))))
-
;;; This VOP is just to force the TNs used in the cleanup onto the stack.
-;;;
(define-vop (uwp-entry)
(:info label)
(:save-p :force-to-stack)
+;;;; 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")
(defconstant static-space-start #x28000000)
(defconstant static-space-end #x2c000000)
- ;; this is used in purify as part of a sloppy check to see if a pointer
+ ;; this is used in PURIFY as part of a sloppy check to see if a pointer
;; is in dynamic space. Chocolate brownie for the first person to fix it
;; -dan 20010502
(defconstant dynamic-space-start #x30000000)
;;; the X86 port defines *nil-value* as (+ *target-static-space-start* #xB)
;;; here, but it seems to be the only port that needs to know the
;;; location of NIL from lisp.
-
-
\f
-;;;; Other random constants.
+;;;; other miscellaneous constants
(defenum (:suffix -trap :start 8)
halt
call-site
function-prologue
function-epilogue)
-
-
\f
-;;;; Static symbols.
+;;;; static symbols
;;; These symbols are loaded into static space directly after NIL so
;;; that the system can compute their address by adding a constant
sb!di::handle-function-end-breakpoint
sb!impl::fdefinition-object
- ;; Free Pointers.
+ ;; free Pointers
*read-only-space-free-pointer*
*static-space-free-pointer*
*initial-dynamic-space-free-pointer*
- ;; Things needed for non-local-exit.
+ ;; things needed for non-local exit
sb!impl::*current-catch-block*
sb!impl::*current-unwind-protect-block*
sb!c::*eval-stack-top*
- ;; Interrupt Handling
+ ;; interrupt handling
sb!impl::*free-interrupt-context-index*
sb!unix::*interrupts-enabled*
- sb!unix::*interrupt-pending*
- ))
+ sb!unix::*interrupt-pending*))
(defparameter *static-functions*
'(length
sb!kernel:two-arg-<
sb!kernel:two-arg->
sb!kernel:two-arg-=
- ;; Probably need the following as they are defined in arith.lisp
- ;; two-arg-<= two-arg->= two-arg-/=
+ ;; FIXME: Is this
+ ;; probably need the following as they are defined in
+ ;; arith.lisp: two-arg-<= two-arg->= two-arg-/=
+ ;; a comment from old CMU CL or old old CMU CL or
+ ;; the SBCL alpha port or what? Do we need to worry about it,
+ ;; or can we delete it?
eql
sb!kernel:%negate
sb!kernel:two-arg-and
-;;; -*- 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.
-;;;
+;;;; the VM definition of predicate VOPs for the Alpha
-;;;
-;;; **********************************************************************
-;;;
-;;; This file contains the VM definition of predicate VOPs for the Alpha.
-;;;
-;;; Written by Rob MacLachlan
-;;;
-;;; Converted by Sean Hallgren.
-;;;
+;;;; 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")
-
-
\f
-;;;; The Branch VOP.
+;;;; the Branch VOP
-;;; The unconditional branch, emitted when we can't drop through to the desired
-;;; destination. Dest is the continuation we transfer control to.
-;;;
+;;; The unconditional branch, emitted when we can't drop through to
+;;; the desired destination. Dest is the continuation we transfer
+;;; control to.
(define-vop (branch)
(:info dest)
(:generator 5
(inst br zero-tn dest)))
-
\f
-;;;; Conditional VOPs:
+;;;; conditional VOPs
(define-vop (if-eq)
(:args (x :scs (any-reg descriptor-reg zero null))
+++ /dev/null
-;;; -*- 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 temporary printing utilities and similar noise.
-;;;
-;;; Written by William Lott.
-;;; Converted by Sean Hallgren.
-
-(in-package "SB!VM")
-
-
-
-(define-vop (print)
- (:args (object :scs (descriptor-reg) :target a0))
- (:results (result :scs (descriptor-reg)))
- (:save-p t)
- (:temporary (:sc any-reg :offset cfunc-offset :target result :to (:result 0))
- cfunc)
- (:temporary (:sc descriptor-reg :offset nl0-offset :from (:argument 0)) a0)
- (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)
- (:temporary (:scs (non-descriptor-reg)) temp)
- (:vop-var vop)
- (:generator 0
- (let ((cur-nfp (current-nfp-tn vop)))
- (move object a0)
- (when cur-nfp
- (store-stack-tn nfp-save cur-nfp))
- (inst li (make-fixup "debug_print" :foreign) cfunc)
- (inst li (make-fixup "call_into_c" :foreign) temp)
- (inst jsr lip-tn temp (make-fixup "call_into_c" :foreign))
- (when cur-nfp
- (maybe-load-stack-nfp-tn cur-nfp nfp-save temp))
- (move cfunc result))))
-;;; -*- Package: VM; 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.
-;;;
-
-;;;
-;;; **********************************************************************
-;;;
-;;; This file contains the Alpha VM definition of SAP operations.
-;;;
-;;; Written by William Lott.
-;;; Alpha conversion by Sean Hallgren.
-;;;
-(in-package "SB!VM")
+;;;; the Alpha VM definition of SAP operations
+;;;; 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")
\f
-;;;; Moves and coercions:
+;;;; moves and coercions
;;; Move a tagged SAP to an untagged representation.
-;;;
-
(define-vop (move-to-sap)
(:args (x :scs (descriptor-reg)))
(:results (y :scs (sap-reg)))
(:note "system area pointer indirection")
(:generator 1
(loadq y x sap-pointer-slot other-pointer-type)))
-
-;;;
(define-move-vop move-to-sap :move
(descriptor-reg) (sap-reg))
-
;;; Move an untagged SAP to a tagged representation.
-;;;
(define-vop (move-from-sap)
(:args (x :scs (sap-reg) :target sap))
(:temporary (:scs (sap-reg) :from (:argument 0)) sap)
(move x sap)
(with-fixed-allocation (y ndescr sap-type sap-size)
(storeq sap y sap-pointer-slot other-pointer-type))))
-;;;
(define-move-vop move-from-sap :move
(sap-reg) (descriptor-reg))
-
-;;; Move untagged sap values.
-;;;
+;;; Move untagged SAP values.
(define-vop (sap-move)
(:args (x :target y
:scs (sap-reg)
(:affected)
(:generator 0
(move x y)))
-;;;
(define-move-vop sap-move :move
(sap-reg) (sap-reg))
-
-;;; Move untagged sap arguments/return-values.
-;;;
+;;; Move untagged SAP arguments/return-values.
(define-vop (move-sap-argument)
(:args (x :target y
:scs (sap-reg))
(move x y))
(sap-stack
(storeq x fp (tn-offset y))))))
-;;;
(define-move-vop move-sap-argument :move-argument
(descriptor-reg sap-reg) (sap-reg))
-
;;; Use standard MOVE-ARGUMENT + coercion to move an untagged sap to a
;;; descriptor passing location.
-;;;
(define-move-vop move-argument :move-argument
(sap-reg) (descriptor-reg))
-
-
\f
;;;; SAP-INT and INT-SAP
(:policy :fast-safe)
(:generator 1
(move int sap)))
-
-
\f
;;;; POINTER+ and POINTER-
(:result-types signed-num)
(:generator 1
(inst subq ptr1 ptr2 res)))
-
\f
;;;; mumble-SYSTEM-REF and mumble-SYSTEM-SET
single-reg single-float :single)
(def-system-ref-and-set sap-ref-double %set-sap-ref-double
double-reg double-float :double))
-
\f
-;;; Noise to convert normal lisp data objects into SAPs.
+;;; noise to convert normal Lisp data objects into SAPs
(define-vop (vector-sap)
(:translate vector-sap)
-;;; -*- 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.
-;;;
+;;;; temporary printing utilities and similar noise
-;;;
-;;; **********************************************************************
-;;;
-;;; This file contains temporary printing utilities and similar noise.
-;;;
-;;; Written by William Lott.
-;;; Converted by Sean Hallgren.
+;;;; 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-vop (print)
(:args (object :scs (descriptor-reg) :target a0))
(:results (result :scs (descriptor-reg)))
-;;; -*- 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 VOPs and macro magic necessary to call static
-;;; functions.
-;;;
-;;; Written by William Lott.
-;;; Converted by Sean Hallgren.
-;;;
-(in-package "SB!VM")
-
+;;;; VOPs and macro magic for calling static functions
+;;;; 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-vop (static-function-template)
(:save-p t)
(:temporary (:sc any-reg :offset ocfp-offset) ocfp)
(:temporary (:sc control-stack :offset nfp-save-offset) nfp-save))
-
(eval-when (:compile-toplevel :load-toplevel :execute)
-
(defun static-function-template-name (num-args num-results)
(intern (format nil "~:@(~R-arg-~R-result-static-function~)"
num-args num-results)))
-
(defun moves (src dst)
(collect ((moves))
(do ((dst dst (cdr dst))
(maybe-load-stack-nfp-tn cur-nfp nfp-save temp))
,@(moves (temp-names) (result-names))))))))
-
-) ; eval-when (compile load eval)
-
+) ; EVAL-WHEN
(expand
(collect ((templates (list 'progn)))
(templates (static-function-template-vop i 1)))
(templates)))
-
(defmacro define-static-function (name args &key (results '(x)) translate
policy cost arg-types result-types)
`(define-vop (,name
-;;; -*- 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")
\f
-;;;; Length
+;;;; LENGTH
(define-vop (length/list)
(:translate length)
DONE
(move count result)))
-
(define-static-function length (object) :translate length)
-
-
-
;;;; files for more information.
(in-package "SB!VM")
-
\f
-;;;; Type frobbing VOPs
+;;;; type frobbing VOPs
(define-vop (get-lowtag)
(:translate get-lowtag)
(inst bis res temp res)))))
\f
-;;;; Allocation
+;;;; allocation
(define-vop (dynamic-space-free-pointer)
(:results (int :scs (sap-reg)))
(move csp-tn int)))
\f
-;;;; Code object frobbing.
+;;;; code object frobbing
(define-vop (code-instructions)
(:translate code-instructions)
(inst addq ndescr offset ndescr)
(inst subq ndescr (- other-pointer-type function-pointer-type) ndescr)
(inst addq code ndescr func)))
-
\f
-;;;; Other random VOPs.
-
+;;;; other random VOPs.
(defknown sb!unix::do-pending-interrupt () (values))
(define-vop (sb!unix::do-pending-interrupt)
(define-vop (halt)
(:generator 1
(inst gentrap halt-trap)))
-
\f
-;;;; Dynamic vop count collection support
+;;;; dynamic vop count collection support
(define-vop (count-me)
(:args (count-vector :scs (descriptor-reg)))
-;;; dunno quite what needs to be in here
+;;;; This file is for stuff which was in CMU CL's insts.lisp
+;;;; file, but which in the SBCL build process can't be compiled
+;;;; into code for the cross-compilation host.
-(in-package "SB!VM")
+;;;; 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.
-;;; foo
+(in-package "SB!VM")
+;;; (On the Alpha, nothing seems to be needed here.)
;;;; files for more information.
(in-package "SB!VM")
-
-
\f
-;;;; Test generation utilities.
+;;;; test generation utilities
(eval-when (:compile-toplevel :execute)
-;;; -*- 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.
-;;;
+;;;; the Alpha implementation of unknown-values VOPs
-;;;
-;;; **********************************************************************
-;;;
-;;; This file contains the implementation of unknown-values VOPs.
-;;;
-;;; Written by Rob MacLachlan
-;;;
-;;; Converted to the Alpha by Sean Hallgren.
-;;;
+;;;; 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-vop (reset-stack-pointer)
(:args (ptr :scs (any-reg)))
(:generator 1
(move ptr csp-tn)))
-
-;;; Push some values onto the stack, returning the start and number of values
-;;; pushed as results. It is assumed that the Vals are wired to the standard
-;;; argument locations. Nvals is the number of values to push.
-;;;
-;;; The generator cost is pseudo-random. We could get it right by defining a
-;;; bogus SC that reflects the costs of the memory-to-memory moves for each
-;;; operand, but this seems unworthwhile.
+;;; Push some values onto the stack, returning the start and number of
+;;; values pushed as results. It is assumed that the Vals are wired to
+;;; the standard argument locations. Nvals is the number of values to
+;;; push.
;;;
+;;; The generator cost is pseudo-random. We could get it right by
+;;; defining a bogus SC that reflects the costs of the
+;;; memory-to-memory moves for each operand, but this seems
+;;; unworthwhile.
(define-vop (push-values)
(:args
(vals :more t))
(move start-temp start)
(inst li (fixnumize nvals) count)))
-
-;;; Push a list of values on the stack, returning Start and Count as used in
-;;; unknown values continuations.
-;;;
+;;; Push a list of values on the stack, returning Start and Count as
+;;; used in unknown values continuations.
(define-vop (values-list)
(:args (arg :scs (descriptor-reg) :target list))
(:arg-types list)
DONE
(inst subq csp-tn start count)))
-;;; Copy the more arg block to the top of the stack so we can use them
-;;; as function arguments.
-;;;
+;;; Copy the &MORE arg block to the top of the stack so we can use
+;;; them as function arguments.
(define-vop (%more-arg-values)
(:args (context :scs (descriptor-reg any-reg) :target src)
(skip :scs (any-reg zero immediate))
-;;;; miscellaneous VM definition noise for the x86
+;;;; miscellaneous VM definition noise for the Alpha
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;;; files for more information.
(in-package "SB!VM")
-
-
\f
-;;;; Define the registers
+;;;; defining the registers
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar *register-names* (make-array 32 :initial-element nil)))
(define-storage-base constant :non-packed)
(define-storage-base immediate-constant :non-packed)
+;;; a handy macro so we don't have to keep changing all the numbers
+;;; whenever we insert a new storage class.
;;;
-;;; Handy macro so we don't have to keep changing all the numbers whenever
-;;; we insert a new storage class.
;;; FIXME: This macro is not needed in the runtime target.
(defmacro define-storage-classes (&rest classes)
(list* `(define-storage-class ,sc-name ,index
,@(cdr class))
`(defconstant ,constant-name ,index)
- `(export ',constant-name)
+ ;; (The CMU CL version of this macro did
+ ;; `(EXPORT ',CONSTANT-NAME)
+ ;; here, but in SBCL we try to have package
+ ;; structure described statically in one
+ ;; master source file, instead of building it
+ ;; dynamically by letting all the system code
+ ;; modify it as the system boots.)
forms)))
(index 0 (1+ index))
(classes classes (cdr classes)))
;;; and seems to be working so far -dan
(defconstant sb!vm::kludge-nondeterministic-catch-block-size 7)
-
(define-storage-classes
;; Non-immediate contstants in the constant pool
;; A catch or unwind block.
(catch-block control-stack
:element-size sb!vm::kludge-nondeterministic-catch-block-size))
-
\f
-;;;; Make some random tns for important registers.
-
+;;; Make some random tns for important registers.
(macrolet ((defregtn (name sc)
(let ((offset-sym (symbolicate name "-OFFSET"))
(tn-sym (symbolicate name "-TN")))
(defregtn ocfp any-reg)
(defregtn lip interior-reg))
-;; And some floating point values.
+;; and some floating point values..
(defparameter fp-single-zero-tn
(make-random-tn :kind :normal
:sc (sc-or-lose 'single-reg)
(make-random-tn :kind :normal
:sc (sc-or-lose 'double-reg)
:offset 31))
-
\f
-;;; Immediate-Constant-SC -- Interface
-;;;
-;;; If value can be represented as an immediate constant, then return the
-;;; appropriate SC number, otherwise return NIL.
-;;;
+;;; If value can be represented as an immediate constant, then return
+;;; the appropriate SC number, otherwise return NIL.
(!def-vm-support-routine immediate-constant-sc (value)
(typecase value
((integer 0 0)
(sc-number-or-lose 'fp-double-zero )
nil))))
\f
-;;;; Function Call Parameters
+;;;; function call parameters
-;;; The SC numbers for register and stack arguments/return values.
-;;;
+;;; the SC numbers for register and stack arguments/return values
(defconstant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg))
(defconstant immediate-arg-scn (meta-sc-number-or-lose 'any-reg))
(defconstant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack))
(eval-when (:compile-toplevel :load-toplevel :execute)
-;;; Offsets of special stack frame locations
+;;; offsets of special stack frame locations
(defconstant ocfp-save-offset 0)
(defconstant lra-save-offset 1)
(defconstant nfp-save-offset 2)
-;;; The number of arguments/return values passed in registers.
-;;;
+;;; the number of arguments/return values passed in registers
(defconstant register-arg-count 6)
-;;; Names to use for the argument registers.
-;;;
-
-
-); Eval-When (Compile Load Eval)
+;;; (Names to use for the argument registers would go here, but there
+;;; are none.)
+); EVAL-WHEN
-;;; A list of TN's describing the register arguments.
-;;;
+;;; a list of TN's describing the register arguments
(defparameter *register-arg-tns*
(mapcar #'(lambda (n)
(make-random-tn :kind :normal
:offset n))
*register-arg-offsets*))
-;;; SINGLE-VALUE-RETURN-BYTE-OFFSET
-;;;
;;; This is used by the debugger.
-;;;
-(export 'single-value-return-byte-offset)
(defconstant single-value-return-byte-offset 4)
-
\f
-;;; LOCATION-PRINT-NAME -- Interface
-;;;
-;;; This function is called by debug output routines that want a pretty name
-;;; for a TN's location. It returns a thing that can be printed with PRINC.
-;;;
+;;; This function is called by debug output routines that want a
+;;; pretty name for a TN's location. It returns a thing that can be
+;;; printed with PRINC.
(!def-vm-support-routine location-print-name (tn)
; (declare (type tn tn))
(let ((sb (sb-name (sc-sb (tn-sc tn))))
;;;; target-only stuff from CMU CL's src/compiler/x86/insts.lisp
+;;;;
+;;;; i.e. stuff which was in CMU CL's insts.lisp file, but which in
+;;;; the SBCL build process can't be compiled into code for the
+;;;; cross-compilation host
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
+# 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.
+
# -mcpu=pca56 makes _my_ alpha go fast, I'm told. Yours may do something
# else.
CFLAGS += -mcpu=pca56 -Dalpha
-# stuff shared between various *BSD OSes
+# configuration stuff shared between various *BSD OSes
+
+# 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.
CFLAGS += -DGENCGC
ASSEM_SRC = x86-assem.S
+# 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.
+
ASSEM_SRC = x86-assem.S ldso-stubs.S
ARCH_SRC = x86-arch.c
* files for more information.
*/
-/* note that although superficially it appears that we use
+/* Note that although superficially it appears that we use
* os_context_t like we ought to, we actually just assume its a
* ucontext in places. Naughty */
-
-
#include <stdio.h>
#include <string.h>
#include <asm/pal.h> /* for PAL_gentrap */
+/*
+ * 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.
+ */
+
#include "validate.h"
#include <alpha/regdef.h>
#include <asm/pal.h>
/*
- * The x86 Linux incarnation of arch-dependent OS-dependent routines.
- * See also linux-os.c
+ * This is the x86 Linux incarnation of arch-dependent OS-dependent
+ * routines. See also "linux-os.c".
*/
+/*
+ * 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.
+ */
-/* header files lifted wholesale from linux-os.c, some may be redundant */
-
+/* These header files were lifted wholesale from linux-os.c, some may
+ * be redundant. -- Dan Barlow ca. 2001-05-01 */
#include <stdio.h>
#include <sys/param.h>
#include <sys/file.h>
+/*
+ * 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.
+ */
#define NREGS (32)
+++ /dev/null
-/*
-
- $Header$
-
- This code was written as part of the CMU Common Lisp project at
- Carnegie Mellon University, and has been placed in the public domain.
-
-*/
-#error "this file is dead"
/*
- * Stop and Copy GC based on Cheney's algorithm.
- *
- * $Header$
- *
- * Written by Christopher Hoover.
+ * stop and copy GC based on Cheney's algorithm
*/
+/*
+ * 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.
+ */
#include <stdio.h>
#include <sys/time.h>
#include "validate.h"
#include "lispregs.h"
#include "interr.h"
+
+/* So you need to debug? */
#if 0
#define PRINTNOISE
#define DEBUG_SPACE_PREDICATES
if (internal_errors_enabled) {
SHOW("in interrupt_internal_error");
-#define QSHOW 1
#if QSHOW
/* Display some rudimentary debugging information about the
* error, so that even if the Lisp error handler gets badly
* Unix - that is, it forces stuff into the low 2Gb where 32-bit pointers
* can find it */
+/*
+ * 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.
+ */
+
OUTPUT_FORMAT("elf64-alpha", "elf64-alpha",
"elf64-alpha")
OUTPUT_ARCH(alpha)
/*
* The x86 Linux incarnation of arch-dependent OS-dependent routines.
- * See also linux-os.c
+ * See also "linux-os.c".
*/
-
-/* header files lifted wholesale from linux-os.c, some may be redundant */
+/*
+ * 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.
+ */
#include <stdio.h>
#include <sys/param.h>
ld -shared -o $testfilestem.so $testfilestem.o
${SBCL:-sbcl} <<EOF
- (load-foreign '("$testfilestem.so"))
- (def-alien-routine summish int (x int) (y int))
- (assert (= (summish 10 20) 31))
+ (when (fboundp 'load-foreign) ; not necessarily supported on all OSes..
+ (load-foreign '("$testfilestem.so"))
+ (def-alien-routine summish int (x int) (y int))
+ (assert (= (summish 10 20) 31)))
(sb-ext:quit :unix-status 52) ; success convention for Lisp program
EOF
if [ $? != 52 ]; then
;;; with byte compilation, since at least in sbcl-0.6.12 the byte
;;; compiler can't record argument list information.)
(defvar *public-package-names*
- '("SB-ALIEN" "SB-C-CALL" "SB-DEBUG" "SB-EXT" "SB-EXT""SB-GRAY" "SB-MP"
+ '("SB-ALIEN" "SB-C-CALL" "SB-DEBUG" "SB-EXT" "SB-GRAY" "SB-MP"
"SB-PROFILE" "SB-PCL" "COMMON-LISP"))
(defun has-arglist-info-p (function)
(and (not (typep function 'sb-c::byte-function))
(dolist (public-package *public-package-names*)
(when (find-package public-package)
(check-ext-symbols-arglist public-package)))
+(terpri)
* Lisp code.
*/
+/*
+ * This software is part of the SBCL system. See the README file for
+ * more information.
+ *
+ * While most of SBCL is derived from the CMU CL system, many
+ * utilities for the build process (like this one) were written from
+ * scratch after the fork from CMU CL.
+ *
+ * This software is in the public domain and is provided with
+ * absolutely no warranty. See the COPYING and CREDITS files for
+ * more information.
+ */
+
#include <stdio.h>
#include <sys/types.h>
#include <sys/times.h>
;;; versions, and a string like "0.6.5.12" is used for versions which
;;; aren't released but correspond only to CVS tags or snapshots.
-"0.6.12.4"
+"0.6.12.5"
projects / sbcl.git / commitdiff