;;;; CL:*FEATURES* tags which have special meaning to SBCL or which
;;;; have a special conventional meaning
;;;;
-;;;; Note that the preferred way to customize the features of a local
-;;;; build of SBCL is not to edit this file, but to tweak
-;;;; customize-target-features.lisp.
+;;;; Note that the recommended way to customize the features of a
+;;;; local build of SBCL is not to edit this file, but instead to
+;;;; tweak customize-target-features.lisp. E.g. you can use code like
+;;;; this:
+;;;; (lambda (list)
+;;;; (flet ((enable (x) (pushnew x list))
+;;;; (disable (x) (setf list (remove x list))))
+;;;; #+nil (enable :sb-show)
+;;;; (enable :sb-after-xc-core)
+;;;; #+nil (disable :sb-doc)
+;;;; list))
+;;;; That way, because customize-target-features.lisp is in
+;;;; .cvsignore, your local changes will remain local even if you use
+;;;; "cvs diff" to submit patches to SBCL.
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
:sbcl
;; Douglas Thomas Crosher's conservative generational GC (the only one
- ;; we currently support)
+ ;; we currently support for X86)
:gencgc
;; We're running under a UNIX. This is sort of redundant, and it was also
;; really, really know what you're doing):
;;
;; machine architecture features:
- ;; :x86 ; any Intel 386 or better, or compatibles like the AMD K6 or K7
- ;; (No others are supported by SBCL as of 0.6.7, but :alpha or
- ;; :sparc support could be ported from CMU CL if anyone is
- ;; sufficiently motivated to do so.)
- ;; (CMU CL also had a :pentium feature, which affected the definition
- ;; of some floating point vops. It was present but not enabled in the
- ;; CMU CL code that SBCL is derived from, and is present but stale
- ;; in SBCL as of 0.6.7.)
+ ;; :x86
+ ;; any Intel 386 or better, or compatibles like the AMD K6 or K7
+ ;; :alpha
+ ;; DEC/Compaq Alpha CPU
+ ;; (No other CPUs are supported by SBCL as of 0.6.12.15, but SPARC or
+ ;; PowerPC support could be ported from CMU CL if anyone is
+ ;; sufficiently motivated to do so, or if you're *really* motivated,
+ ;; you could write a port from scratch for a new CPU architecture.)
+ ;; (CMU CL also had a :pentium feature, which affected the definition
+ ;; of some floating point vops. It was present but not enabled or
+ ;; documented in the CMU CL code that SBCL is derived from, and is
+ ;; present but stale in SBCL as of 0.6.12.)
;;
;; operating system features:
;; :linux = We're intended to run under some version of Linux.
;; :openbsd = We're intended to run under FreeBSD.
;; (No others are supported by SBCL as of 0.6.7, but :hpux or
;; :solaris support could be ported from CMU CL if anyone is
- ;; sufficiently motivated to do so.)
+ ;; sufficiently motivated to do so, and it'd even be possible,
+ ;; though harder, to port the system to Microsoft Windows.)
)
"CONSTANTLY-T" "CONSTANTLY-NIL" "CONSTANTLY-0"
"PSXHASH"
"%BREAK"
+ "PHYSICALIZE-PATHNAME"
;; ..and macros..
"COLLECT"
(sb!ext:run-program "/usr/bin/uname" `("-r")
:output stream))))))
\f
-;;; OS-COLD-INIT-OR-REINIT initializes our operating-system interface.
-;;; It sets the values of the global port variables to what they
-;;; should be and calls the functions that set up the argument blocks
-;;; for the server interfaces.
(defun os-cold-init-or-reinit ()
- (setf *software-version* nil))
+ (setf *software-version* nil)
+ (setf *default-pathname-defaults*
+ (pathname (sb!ext::default-directory))))
;;; Return system time, user time and number of page faults.
(defun get-system-info ()
(print-unreadable-object (structure ,stream :type t)
,@(nreverse reversed-prints))))))
\f
+;;;; etc.
+
+;;; Given a pathname, return a corresponding physical pathname.
+(defun physicalize-pathname (possibly-logical-pathname)
+ (if (typep possibly-logical-pathname 'logical-pathname)
+ (translate-logical-pathname possibly-logical-pathname)
+ possibly-logical-pathname))
+\f
#|
;;; REMOVEME when done testing byte cross-compiler
(defun byte-compiled-foo (x y)
(:charpos
(fd-stream-char-pos fd-stream))
(:file-length
- ;; FIXME: This is broken on OpenBSD until the FFI, or at least
- ;; UNIX-FSTAT, learns to extract 64-bit values. (As of sbcl-0.6.12.8,
- ;; UNIX-FSTAT returns a 0 placeholder instead.)
- #!+openbsd
- (error "FIXME: internal error, FILE-LENGTH is broken on OpenBSD")
- #!-openbsd
(multiple-value-bind (okay dev ino mode nlink uid gid rdev size
atime mtime ctime blksize blocks)
(sb!unix:unix-fstat (fd-stream-fd fd-stream))
(type (or index (member nil :start :end)) newpos))
(if (null newpos)
(sb!sys:without-interrupts
- ;; First, find the position of the UNIX file descriptor in the
- ;; file.
+ ;; First, find the position of the UNIX file descriptor in the file.
(multiple-value-bind (posn errno)
(sb!unix:unix-lseek (fd-stream-fd stream) 0 sb!unix:l_incr)
(declare (type (or index null) posn))
(if (empty-relative-pathname-spec-p pathname-spec)
"."
;; Otherwise, the ordinary rules apply.
- (let* ((possibly-logical-pathname (pathname pathname-spec))
- (physical-pathname (if (typep possibly-logical-pathname
- 'logical-pathname)
- (namestring (translate-logical-pathname
- possibly-logical-pathname))
- possibly-logical-pathname))
+ (let* ((namestring (physicalize-pathname (pathname pathname-spec)))
(matches nil)) ; an accumulator for actual matches
- (enumerate-matches (match physical-pathname nil
- :verify-existence for-input)
+ (enumerate-matches (match namestring nil :verify-existence for-input)
(push match matches))
(case (length matches)
(0 nil)
actually exist, and attempt to create them if they do not.
The MODE argument is a CMUCL/SBCL-specific extension to control
the Unix permission bits."
- (let* ((pathname (pathname pathspec))
- (pathname (if (typep pathname 'logical-pathname)
- (translate-logical-pathname pathname)
- pathname))
- (created-p nil))
+ (let ((pathname (physicalize-pathname (pathname pathspec)))
+ (created-p nil))
(when (wild-pathname-p pathname)
(error 'simple-file-error
:format-control "bad place for a wild pathname"
(sb!ext:run-program "/bin/uname" `("-r")
:output stream))))))
-;;; OS-COLD-INIT-OR-REINIT initializes our operating-system interface.
-;;; It sets the values of the global port variables to what they
-;;; should be and calls the functions that set up the argument blocks
-;;; for the server interfaces.
(defun os-cold-init-or-reinit () ; KLUDGE: don't know what to do here
#!+sparc ;; Can't use #x20000000 thru #xDFFFFFFF, but mach tries to let us.
- (sb!sys:allocate-system-memory-at (sb!sys:int-sap #x20000000) #xc0000000))
+ (sb!sys:allocate-system-memory-at (sb!sys:int-sap #x20000000) #xc0000000)
+ (setf *software-version* nil)
+ (setf *default-pathname-defaults*
+ (pathname (sb!ext::default-directory))))
;;; Return system time, user time and number of page faults.
(defun get-system-info ()
out early because of some argument error or something).
The following &KEY args are defined:
+ :TOPLEVEL
+ The function to run when the created core file is resumed.
+ The default function handles command line toplevel option
+ processing and runs the top level read-eval-print loop. This
+ function should not return.
+ :PURIFY
+ If true (the default), do a purifying GC which moves all dynamically
+ allocated objects into static space so that they stay pure. This takes
+ somewhat longer than the normal GC which is otherwise done, but it's
+ only done once, and subsequent GC's will be done less often and will
+ take less time in the resulting core file. See PURIFY.
+ :ROOT-STRUCTURES
+ This should be a list of the main entry points in any newly loaded
+ systems. This need not be supplied, but locality and/or GC performance
+ may be better if they are. Meaningless if :PURIFY is NIL. See PURIFY.
+ :ENVIRONMENT-NAME
+ This is also passed to PURIFY when :PURIFY is T. (rarely used)
- :TOPLEVEL
- The function to run when the created core file is resumed.
- The default function handles command line toplevel option
- processing and runs the top level read-eval-print loop. This
- function should not return.
-
- :PURIFY
- If true (the default), do a purifying GC which moves all dynamically
- allocated objects into static space so that they stay pure. This takes
- somewhat longer than the normal GC which is otherwise done, but it's only
- done once, and subsequent GC's will be done less often and will take less
- time in the resulting core file. See PURIFY.
-
- :ROOT-STRUCTURES
- This should be a list of the main entry points in any newly loaded
- systems. This need not be supplied, but locality and/or GC performance
- may be better if they are. Meaningless if :PURIFY is NIL. See PURIFY.
-
- :ENVIRONMENT-NAME
- This is also passed to PURIFY when :PURIFY is T. (rarely used)"
+ The save/load process changes the values of some global variables:
+ *STANDARD-OUTPUT*, *DEBUG-IO*, etc.
+ Everything related to open streams is necessarily changed, since
+ the OS won't let us preserve a stream across save and load.
+ *DEFAULT-PATHNAME-DEFAULTS*
+ This is reinitialized to reflect the working directory where the
+ saved core is loaded."
#!+mp (sb!mp::shutdown-multi-processing)
(when (fboundp 'sb!eval:flush-interpreted-function-cache)
'(unsigned-byte 8)))
(load-as-fasl filespec verbose print)
(load-as-source filespec verbose print))
- (let ((pn (merge-pathnames (pathname filespec)
- *default-pathname-defaults*)))
- (if (wild-pathname-p pn)
- (let ((files (directory pn)))
+ (let (;; FIXME: MERGE-PATHNAMES doesn't work here for
+ ;; FILESPEC="TEST:Load-Test" and
+ ;; (LOGICAL-PATHNAME-TRANSLATIONS "TEST")
+ ;; = (("**;*.*.*" "/foo/bar/**/*.*")).
+ ;; Physicalizing the pathname before merging
+ ;; is a workaround, but the ANSI spec talks about
+ ;; MERGE-PATHNAMES accepting (and returning)
+ ;; logical pathnames, so a true fix would probably
+ ;; include fixing MERGE-PATHNAMES, then probably
+ ;; revisiting this code.
+ (ppn (physicalize-pathname (pathname filespec))))
+ (if (wild-pathname-p ppn)
+ (let ((files (directory ppn)))
#!+high-security
(when (null files)
(error 'file-error :pathname filespec))
(dolist (file files t)
- (internal-load pn
+ (internal-load ppn
file
internal-if-does-not-exist
verbose
print)))
- (let ((tn (probe-file pn)))
- (if (or tn (pathname-type pn))
- (internal-load pn
+ (let ((tn (probe-file ppn)))
+ (if (or tn (pathname-type ppn))
+ (internal-load ppn
tn
internal-if-does-not-exist
verbose
print)
(internal-load-default-type
- pn
+ ppn
internal-if-does-not-exist
verbose
print)))))))))
values)
(defun %enumerate-search-list (pathname function)
- (let* ((pathname (if (typep pathname 'logical-pathname)
- (translate-logical-pathname pathname)
- pathname))
+ (let* ((pathname (physicalize-pathname pathname))
(search-list (extract-search-list pathname nil)))
(cond
((not search-list)
(slot wrapped-stat 'st-uid)
(slot wrapped-stat 'st-gid)
(slot wrapped-stat 'st-rdev)
- ;; FIXME: OpenBSD has a 64-bit st_size slot, which is
- ;; basically a good thing, except that it is too
- ;; 21st-century for sbcl-0.6.12.8's FFI to handle. As a
- ;; quick kludgy workaround, we return a 0 placeholder from
- ;; this function, and downstream we stub out the FILE-LENGTH
- ;; operation (which is the only place that SBCL actually
- ;; uses the SIZE value returned from any UNIX-STAT-ish call).
- #!+openbsd 0
- #!-openbsd (slot wrapped-stat 'st-size)
+ (slot wrapped-stat 'st-size)
(slot wrapped-stat 'st-atime)
(slot wrapped-stat 'st-mtime)
(slot wrapped-stat 'st-ctime)
(slot wrapped-stat 'st-blksize)
(slot wrapped-stat 'st-blocks)))
-;;; Unix system calls in the stat(2) family are implemented as calls
-;;; to C-level wrapper functions which copy all the raw "struct
-;;; stat" slots into the system-independent wrapped_stat format.
+;;; Unix system calls in the stat(2) family are handled by calls to
+;;; C-level wrapper functions which copy all the raw "struct stat"
+;;; slots into the system-independent wrapped_stat format.
;;; stat(2) <-> stat_wrapper()
;;; fstat(2) <-> fstat_wrapper()
;;; lstat(2) <-> lstat_wrapper()
\f
;;;; time.h
-;; the POSIX.4 structure for a time value. This is like a `struct
-;; timeval' but has nanoseconds instead of microseconds.
+;; the POSIX.4 structure for a time value. This is like a "struct
+;; timeval" but has nanoseconds instead of microseconds.
(def-alien-type nil
(struct timespec
(tv-sec long) ; seconds
(tm-sec int) ; Seconds. [0-60] (1 leap second)
(tm-min int) ; Minutes. [0-59]
(tm-hour int) ; Hours. [0-23]
- (tm-mday int) ; Day. [1-31]
- (tm-mon int) ; Month. [0-11]
- (tm-year int) ; Year - 1900.
- (tm-wday int) ; Day of week. [0-6]
- (tm-yday int) ; Days in year.[0-365]
- (tm-isdst int) ; DST. [-1/0/1]
- (tm-gmtoff long) ; Seconds east of UTC.
- (tm-zone c-string))) ; Timezone abbreviation.
+ (tm-mday int) ; Day. [1-31]
+ (tm-mon int) ; Month. [0-11]
+ (tm-year int) ; Year - 1900.
+ (tm-wday int) ; Day of week. [0-6]
+ (tm-yday int) ; Days in year. [0-365]
+ (tm-isdst int) ; DST. [-1/0/1]
+ (tm-gmtoff long) ; Seconds east of UTC.
+ (tm-zone c-string))) ; Timezone abbreviation.
(def-alien-routine get-timezone sb!c-call:void
(when sb!c-call:long :in)
;;; default to the appropriate implementation-defined default type for
;;; compiled files.
(defun cfp-output-file-default (input-file)
- (let* ((defaults (merge-pathnames input-file
+ (let* (;; FIXME: I think the PHYSICALIZE-PATHNAME wrapper here
+ ;; shouldn't really be necessary. Unfortunately
+ ;; sbcl-0.6.12.18's MERGE-PATHNAMES doesn't like logical
+ ;; pathnames very much, and doesn't get good results in
+ ;; tests/side-effectful-pathnames.sh for (COMPILE-FILE
+ ;; "TEST:$StudlyCapsStem"), unless I do this. It would be
+ ;; good to straighten out how MERGE-PATHNAMES is really
+ ;; supposed to work for logical pathnames, and add a bunch of
+ ;; test cases to check it, then get rid of this cruft.
+ (defaults (merge-pathnames (physicalize-pathname (pathname
+ input-file))
*default-pathname-defaults*))
(retyped (make-pathname :type *backend-fasl-file-type*
:defaults defaults)))
(in-package "CL-USER")
;;; In sbcl-0.6.9 FOO-NAMESTRING functions returned "" instead of NIL.
-(let ((pathname0 (make-pathname :host nil
- :directory
- (pathname-directory
- *default-pathname-defaults*)
- :name "getty"))
+(let ((pathname0 (make-pathname :host nil
+ :directory
+ (pathname-directory
+ *default-pathname-defaults*)
+ :name "getty"))
(pathname1 (make-pathname :host nil
:directory nil
:name nil)))
(assert (equal (file-namestring pathname0) "getty"))
- (assert (equal (directory-namestring pathname0) ""))
+ (assert (equal (directory-namestring pathname0)
+ (directory-namestring *default-pathname-defaults*)))
(assert (equal (file-namestring pathname1) ""))
(assert (equal (directory-namestring pathname1) "")))
(format t "translation=~S~%" translation)
(format t "expected-translation=~S~%" expected-translation)
(assert (string= translation expected-translation)))
+ (format t "about to LOAD ~S~%" "TEST:$StudlyCapsStem")
(load "TEST:$StudlyCapsStem")
(assert (eq *loaded* :yes))
(let ((compiled-file-name (namestring (compile-file "TEST:$StudlyCapsStem")))
;;; 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.17"
+"0.6.12.18"
projects / sbcl.git / commitdiff