fixed problems reported by Douglas Brebner 2000-01-01..
make.sh and friends now use foo/bar instead of foo/bar/ to
specify directories, since foo/bar/ fails on NetBSD.
(SETF ALIEN:EXTERN-ALIEN) works (instead of dying with
undefined function SB-KERNEL:%SET-SAP-REF-32).
so that (TYPEP (MAKE-ARRAY 3) '(VECTOR SOMETHING-NOT-DEFINED-YET))
returns (VALUES T T). Probably it should be an error instead,
complaining that the type SOMETHING-NOT-DEFINED-YET is not defined.
+ Or perhaps UPGRADED-ARRAY-ELEMENT-TYPE should just fail when a type
+ isn't defined yet. (What if the definition of
+ SOMETHING-NOT-DEFINED-YET turns out to be SINGLE-FLOAT?)
41:
TYPEP of VALUES types is sometimes implemented very inefficiently, e.g. in
# this script (including "gmake clean" in the src/runtime directory)
# several times in a row without failure.. so we leave the output/
# directory in place.)
-rm -rf obj/* output/* doc/user-manual/ \
- doc/user-manual.junk/ doc/DBTOHTML_OUTPUT_DIR*
-# (The doc/user-manual.junk/ and doc/DBTOHTML_OUTPUT_DIR* directories
-# are created when the Cygnus db2html script when it formats the the
+rm -rf obj/* output/* doc/user-manual \
+ doc/user-manual.junk doc/DBTOHTML_OUTPUT_DIR*
+# (The doc/user-manual.junk and doc/DBTOHTML_OUTPUT_DIR* directories
+# are created by the Cygnus db2html script when it formats the the
# user manual, and since this db2html script is the one which is
# currently used to format the manual for the standard binary
# distribution, we automatically clean up after it here in the
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.
-(in-package "SB!SYS")
-;;; FIXME: Shouldn't these be IN-PACKAGE SB!KERNEL instead? (They're
-;;; not dependent on the OS, only on the CPU architecture.)
+(in-package "SB!KERNEL")
\f
;;;; primitive SAP operations
+;;; Return T iff the SAP X points to a smaller address then the SAP Y.
(defun sap< (x y)
- #!+sb-doc
- "Return T iff the SAP X points to a smaller address then the SAP Y."
(declare (type system-area-pointer x y))
(sap< x y))
+;;; Return T iff the SAP X points to a smaller or the same address as
+;;; the SAP Y.
(defun sap<= (x y)
- #!+sb-doc
- "Return T iff the SAP X points to a smaller or the same address as
- the SAP Y."
(declare (type system-area-pointer x y))
(sap<= x y))
+;;; Return T iff the SAP X points to the same address as the SAP Y.
(defun sap= (x y)
- #!+sb-doc
- "Return T iff the SAP X points to the same address as the SAP Y."
(declare (type system-area-pointer x y))
(sap= x y))
+;;; Return T iff the SAP X points to a larger or the same address as
+;;; the SAP Y.
(defun sap>= (x y)
- #!+sb-doc
- "Return T iff the SAP X points to a larger or the same address as
- the SAP Y."
(declare (type system-area-pointer x y))
(sap>= x y))
+;;; Return T iff the SAP X points to a larger address then the SAP Y.
(defun sap> (x y)
- #!+sb-doc
- "Return T iff the SAP X points to a larger address then the SAP Y."
(declare (type system-area-pointer x y))
(sap> x y))
+;;; Return a new SAP, OFFSET bytes from SAP.
(defun sap+ (sap offset)
- #!+sb-doc
- "Return a new sap OFFSET bytes from SAP."
(declare (type system-area-pointer sap)
(fixnum offset))
(sap+ sap offset))
+;;; Return the byte offset between SAP1 and SAP2.
(defun sap- (sap1 sap2)
- #!+sb-doc
- "Return the byte offset between SAP1 and SAP2."
(declare (type system-area-pointer sap1 sap2))
(sap- sap1 sap2))
+;;; Convert SAP into an integer.
(defun sap-int (sap)
- #!+sb-doc
- "Converts a System Area Pointer into an integer."
(declare (type system-area-pointer sap))
(sap-int sap))
+;;; Convert an integer into a SAP.
(defun int-sap (int)
- #!+sb-doc
- "Converts an integer into a System Area Pointer."
(declare (type sap-int-type int))
(int-sap int))
+;;; Return the 8-bit byte at OFFSET bytes from SAP.
(defun sap-ref-8 (sap offset)
- #!+sb-doc
- "Returns the 8-bit byte at OFFSET bytes from SAP."
(declare (type system-area-pointer sap)
(fixnum offset))
(sap-ref-8 sap offset))
+;;; Return the 16-bit word at OFFSET bytes from SAP.
(defun sap-ref-16 (sap offset)
- #!+sb-doc
- "Returns the 16-bit word at OFFSET bytes from SAP."
(declare (type system-area-pointer sap)
(fixnum offset))
(sap-ref-16 sap offset))
+;;; Returns the 32-bit dualword at OFFSET bytes from SAP.
(defun sap-ref-32 (sap offset)
- #!+sb-doc
- "Returns the 32-bit dualword at OFFSET bytes from SAP."
(declare (type system-area-pointer sap)
(fixnum offset))
(sap-ref-32 sap offset))
+;;; Return the 64-bit quadword at OFFSET bytes from SAP.
#!+alpha
(defun sap-ref-64 (sap offset)
- #!+sb-doc
- "Returns the 64-bit quadword at OFFSET bytes from SAP."
(declare (type system-area-pointer sap)
(fixnum offset))
(sap-ref-64 sap offset))
+;;; Return the 32-bit SAP at OFFSET bytes from SAP.
(defun sap-ref-sap (sap offset)
- #!+sb-doc
- "Returns the 32-bit system-area-pointer at OFFSET bytes from SAP."
(declare (type system-area-pointer sap)
(fixnum offset))
(sap-ref-sap sap offset))
+;;; Return the 32-bit SINGLE-FLOAT at OFFSET bytes from SAP.
(defun sap-ref-single (sap offset)
- #!+sb-doc
- "Returns the 32-bit single-float at OFFSET bytes from SAP."
(declare (type system-area-pointer sap)
(fixnum offset))
(sap-ref-single sap offset))
+;;; Return the 64-bit DOUBLE-FLOAT at OFFSET bytes from SAP.
(defun sap-ref-double (sap offset)
- #!+sb-doc
- "Returns the 64-bit double-float at OFFSET bytes from SAP."
(declare (type system-area-pointer sap)
(fixnum offset))
(sap-ref-double sap offset))
+;;; Return the LONG-FLOAT at OFFSET bytes from SAP.
#!+(or x86 long-float)
(defun sap-ref-long (sap offset)
- #!+sb-doc
- "Returns the long-float at OFFSET bytes from SAP."
(declare (type system-area-pointer sap)
(fixnum offset))
(sap-ref-long sap offset))
+;;; Return the signed 8-bit byte at OFFSET bytes from SAP.
(defun signed-sap-ref-8 (sap offset)
- #!+sb-doc
- "Returns the signed 8-bit byte at OFFSET bytes from SAP."
(declare (type system-area-pointer sap)
(fixnum offset))
(signed-sap-ref-8 sap offset))
+;;; Return the signed 16-bit word at OFFSET bytes from SAP.
(defun signed-sap-ref-16 (sap offset)
- #!+sb-doc
- "Returns the signed 16-bit word at OFFSET bytes from SAP."
(declare (type system-area-pointer sap)
(fixnum offset))
(signed-sap-ref-16 sap offset))
+;;; Return the signed 32-bit dualword at OFFSET bytes from SAP.
(defun signed-sap-ref-32 (sap offset)
- #!+sb-doc
- "Returns the signed 32-bit dualword at OFFSET bytes from SAP."
(declare (type system-area-pointer sap)
(fixnum offset))
(signed-sap-ref-32 sap offset))
+;;; Return the signed 64-bit quadword at OFFSET bytes from SAP.
#!+alpha
(defun signed-sap-ref-64 (sap offset)
- #!+sb-doc
- "Returns the signed 64-bit quadword at OFFSET bytes from SAP."
(declare (type system-area-pointer sap)
(fixnum offset))
(signed-sap-ref-64 sap offset))
\f
;;;; some tools
-;;; Take the file named X and make it into a file named Y. Sorta like UNIX, and
-;;; unlike Common Lisp's bare RENAME-FILE, we don't allow information
-;;; from the original filename to influence the final filename. (The reason
-;;; that it's only sorta like UNIX is that in UNIX "mv foo bar/" will work,
-;;; but the analogous (RENAME-FILE-A-LA-UNIX "foo" "bar/") should fail.)
+;;; Take the file named X and make it into a file named Y. Sorta like
+;;; UNIX, and unlike Common Lisp's bare RENAME-FILE, we don't allow
+;;; information from the original filename to influence the final
+;;; filename. (The reason that it's only sorta like UNIX is that in
+;;; UNIX "mv foo bar/" will work, but the analogous
+;;; (RENAME-FILE-A-LA-UNIX "foo" "bar/") should fail.)
;;;
-;;; (This is a workaround for the weird behavior of Debian CMU CL 2.4.6, where
-;;; (RENAME-FILE "dir/x" "dir/y") tries to create a file called "dir/dir/y".
-;;; If that behavior goes away, then we should be able to get rid of this
-;;; function and use plain RENAME-FILE in the COMPILE-STEM function
-;;; above. -- WHN 19990321
+;;; (This is a workaround for the weird behavior of Debian CMU CL
+;;; 2.4.6, where (RENAME-FILE "dir/x" "dir/y") tries to create a file
+;;; called "dir/dir/y". If that behavior goes away, then we should be
+;;; able to get rid of this function and use plain RENAME-FILE in the
+;;; COMPILE-STEM function above. -- WHN 19990321
(defun rename-file-a-la-unix (x y)
(rename-file x
;; (Note that the TRUENAME expression here is lifted from an
(pathname obj)))
(compile 'compile-stem)
-;;; basic tool for building other tools
-#+nil
-(defun tool-cload-stem (stem)
- (load (compile-stem stem
- :src-prefix *src-prefix*
- :obj-prefix *host-obj-prefix*
- :obj-suffix *host-obj-suffix*
- :compile-file #'compile-file))
- (values))
-#+nil (compile 'tool-cload-stem)
-
;;; other miscellaneous tools
(load "src/cold/read-from-file.lisp")
(load "src/cold/rename-package-carefully.lisp")
;;; (This function is not used by the build process, but is intended
;;; for interactive use when experimenting with the system. It runs
;;; the cross-compiler on test files with arbitrary filenames, not
-;;; necessarily in the source tree, e.g. in "/tmp/".)
+;;; necessarily in the source tree, e.g. in "/tmp".)
(defun target-compile-file (filename)
(funcall *in-target-compilation-mode-fn*
(lambda ()
;;;; do belong in cold load and will hopefully make it back there reasonably
;;;; soon). -- WHN 19991207
-(dolist (stem '(;; FIXME: The files here from outside the src/pcl/ directory
+(dolist (stem '(;; FIXME: The files here from outside the src/pcl directory
;; probably belong in cold load instead of warm load. They
;; ended up here as a quick hack to work around the
;; consequences of my misunderstanding how ASSEMBLE-FILE works
;;; FIXME: This stuff isn't part of the ANSI spec, and isn't even
;;; exported from PCL, but it looks as though it might be useful,
;;; so I don't want to just delete it. Perhaps it should go in
-;;; a contrib/ directory eventually?
+;;; a "contrib" directory eventually?
#|
;;; TRACE-METHOD and UNTRACE-METHOD accept method specs as arguments. A
;;; FIXME: Perhaps now that a significant number of files are built
;;; in warm load instead of cold load, this file should now be called
;;; cold-stems-and-flags.lisp-expr? Also, perhaps this file should move
-;;; into the src/cold/ directory?
+;;; into the src/cold directory?
(
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; miscellaneous
--- /dev/null
+;;;; This file is for compiler tests which have side effects (e.g.
+;;;; executing DEFUN) but which don't need any special side-effecting
+;;;; environmental stuff (e.g. DECLAIM of particular optimization
+;;;; settings). Similar tests which *do* expect special settings may
+;;;; be in files compiler-1.impure.lisp, compiler-2.impure.lisp, etc.
+
+;;;; 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, the test
+;;;; files (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.
+
+(cl:in-package :cl-user)
+
+;;; In sbcl-0.6.10, Douglas Brebner reported that (SETF EXTERN-ALIEN)
+;;; was messed up so badly that trying to execute expressions like
+;;; this signalled an error.
+(setf (sb-alien:extern-alien "gencgc_oldest_gen_to_gc" sb-alien:unsigned)
+ (sb-alien:extern-alien "gencgc_oldest_gen_to_gc" sb-alien:unsigned))
+
+;;; success
+(quit :unix-status 104)
;;; handle the following case exactly (otherwise we get an error:
;;; "#'IDENTITY CALLED WITH 2 ARGS."
(setf (logical-pathname-translations "demo2")
- '(("test;**;*.*" "/tmp/demo2/test/")))
+ '(("test;**;*.*" "/tmp/demo2/test")))
(enough-namestring "demo2:test;foo.lisp")
;;; When a pathname comes from a logical host, it should be in upper
;;; 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.10.12"
+"0.6.10.13"
projects / sbcl.git / commitdiff