* (lisp-implementation-version)
"0.pre7.129"
+142:
+ (as reported by Lynn Quam on cmucl-imp ca. 2002-01-16)
+ %NATURALIZE-C-STRING conses a lot, like 16 bytes per byte
+ of the naturalized string. We could probably port the patches
+ from the cmucl-imp mailing list.
+
KNOWN BUGS RELATED TO THE IR1 INTERPRETER
"%DOUBLE-FLOAT" "%DPB" "%EXP" "%EXPM1"
"%FIND-POSITION" "%FIND-POSITION-VECTOR-MACRO"
"%FIND-POSITION-IF" "%FIND-POSITION-IF-VECTOR-MACRO"
+ "%FIND-POSITION-IF-NOT" "%FIND-POSITION-IF-NOT-VECTOR-MACRO"
"%FUN-DOC" "%FUN-NAME"
"%HYPOT" "%LDB"
"%LOG" "%LOGB" "%LOG10" "%LOG1P" "%LONG-FLOAT"
(vector*-frob (sequence)
`(%find-position-if-vector-macro predicate ,sequence
from-end start end key)))
+ (frobs)))
+ (defun %find-position-if-not (predicate sequence-arg from-end start end key)
+ (macrolet ((frob (sequence from-end)
+ `(%find-position-if-not predicate ,sequence
+ ,from-end start end key))
+ (vector*-frob (sequence)
+ `(%find-position-if-not-vector-macro predicate ,sequence
+ from-end start end key)))
(frobs))))
;;; the user interface to FIND and POSITION: Get all our ducks in a
(def-find-position-if find-if 0)
(def-find-position-if position-if 1))
-;;; the deprecated functions FIND-IF-NOT and POSITION-IF-NOT. We don't
-;;; bother to worry about optimizing them.
-;;;
-;;; (Except note that on Sat, Oct 06, 2001 at 04:22:38PM +0100,
-;;; Christophe Rhodes wrote on sbcl-devel
+;;; the deprecated functions FIND-IF-NOT and POSITION-IF-NOT. We
+;;; didn't bother to worry about optimizing them, except note that on
+;;; Sat, Oct 06, 2001 at 04:22:38PM +0100, Christophe Rhodes wrote on
+;;; sbcl-devel
;;;
;;; My understanding is that while the :test-not argument is
;;; deprecated in favour of :test (complement #'foo) because of
;;;
;;; FIXME: Remove uses of these deprecated functions (and of :TEST-NOT
;;; too) within the implementation of SBCL.
+(declaim (inline find-if-not position-if-not))
(macrolet ((def-find-position-if-not (fun-name values-index)
`(defun ,fun-name (predicate sequence
&key from-end (start 0) end key)
(nth-value
,values-index
- (%find-position-if (complement (%coerce-callable-to-fun
- predicate))
- sequence
- from-end
- start
- end
- (effective-find-position-key key))))))
+ (%find-position-if-not (%coerce-callable-to-fun predicate)
+ sequence
+ from-end
+ start
+ end
+ (effective-find-position-key key))))))
+
(def-find-position-if-not find-if-not 0)
(def-find-position-if-not position-if-not 1))
\f
(let ((alien-type (parse-alien-type type env)))
(if (eq (compute-alien-rep-type alien-type) 'system-area-pointer)
`(%sap-alien ,sap ',alien-type)
- (error "cannot make aliens of type ~S out of SAPs" type))))
+ (error "cannot make an alien of type ~S out of a SAP" type))))
(defun %sap-alien (sap type)
(declare (type system-area-pointer sap)
(define-alien-type-translator void ()
(parse-alien-type '(values) (sb!kernel:make-null-lexenv)))
\f
+#+nil
+(define-alien-routine strlen integer
+ (s (* char)))
+
(defun %naturalize-c-string (sap)
(declare (type system-area-pointer sap))
(with-alien ((ptr (* char) sap))
- (locally
- (declare (optimize (speed 3) (safety 0)))
- (let ((length (loop
- for offset of-type fixnum upfrom 0
- until (zerop (deref ptr offset))
- finally (return offset))))
- (let ((result (make-string length)))
- (sb!kernel:copy-from-system-area (alien-sap ptr) 0
- result (* sb!vm:vector-data-offset
- sb!vm:n-word-bits)
- (* length sb!vm:n-byte-bits))
- result)))))
+ (let* ((length (alien-funcall (extern-alien "strlen"
+ (function integer (* char)))
+ ptr))
+ (result (make-string length)))
+ (declare (optimize (speed 3) (safety 0)))
+ (sb!kernel:%byte-blt sap 0 result 0 length)
+ result)))
(t sequence t index sequence-end function function)
(values t (or index null))
(flushable call))
-(defknown %find-position-if
+(defknown (%find-position-if %find-position-if-not)
(function sequence t index sequence-end function)
(values t (or index null))
(call))
(defun cold-intern (symbol &optional (package (symbol-package symbol)))
;; Anything on the cross-compilation host which refers to the target
- ;; machinery through the host SB-XC package can be translated to
+ ;; machinery through the host SB-XC package should be translated to
;; something on the target which refers to the same machinery
;; through the target COMMON-LISP package.
(let ((p (find-package "SB-XC")))
(when (eq (symbol-package symbol) p)
(setf symbol (intern (symbol-name symbol) *cl-package*))))
+ ;; Make sure that the symbol has an appropriate package. In
+ ;; particular, catch the so-easy-to-make error of typing something
+ ;; like SB-KERNEL:%BYTE-BLT in cold sources when what you really
+ ;; need is SB!KERNEL:%BYTE-BLT.
+ (let ((package-name (package-name package)))
+ (cond ((find package-name '("COMMON-LISP" "KEYWORD") :test #'string=)
+ ;; That's OK then.
+ (values))
+ ((string= package-name "SB!" :end1 3 :end2 3)
+ ;; That looks OK, too. (All the target-code packages
+ ;; have names like that.)
+ (values))
+ (t
+ ;; looks bad: maybe COMMON-LISP-USER? maybe an extension
+ ;; package in the xc host? something we can't think of
+ ;; a valid reason to dump, anyway...
+ (error "internal error: PACKAGE-NAME=~S looks too much like a typo."
+ package-name))))
+
(let (;; Information about each cold-interned symbol is stored
;; in COLD-INTERN-INFO.
;; (CAR COLD-INTERN-INFO) = descriptor of symbol
(give-up-ir1-transform
"sequence type not known at compile time")))))
-;;; %FIND-POSITION-IF for LIST data
-(deftransform %find-position-if ((predicate sequence from-end start end key)
- (function list t t t function)
- *
- :policy (> speed space)
- :important t)
- "expand inline"
- '(let ((index 0)
- (find nil)
- (position nil))
- (declare (type index index))
- (dolist (i sequence (values find position))
- (let ((key-i (funcall key i)))
- (when (and end (>= index end))
- (return (values find position)))
- (when (>= index start)
- (when (funcall predicate key-i)
- ;; This hack of dealing with non-NIL FROM-END for list
- ;; data by iterating forward through the list and keeping
- ;; track of the last time we found a match might be more
- ;; screwy than what the user expects, but it seems to be
- ;; allowed by the ANSI standard. (And if the user is
- ;; screwy enough to ask for FROM-END behavior on list
- ;; data, turnabout is fair play.)
- ;;
- ;; It's also not enormously efficient, calling PREDICATE
- ;; and KEY more often than necessary; but all the
- ;; alternatives seem to have their own efficiency
- ;; problems.
- (if from-end
- (setf find i
- position index)
- (return (values i index))))))
- (incf index))))
-
+;;; %FIND-POSITION-IF and %FIND-POSITION-IF-NOT for LIST data
+(macrolet ((def-frob (name condition)
+ `(deftransform ,name ((predicate sequence from-end start end key)
+ (function list t t t function)
+ *
+ :policy (> speed space)
+ :important t)
+ "expand inline"
+ `(let ((index 0)
+ (find nil)
+ (position nil))
+ (declare (type index index))
+ (dolist (i sequence (values find position))
+ (let ((key-i (funcall key i)))
+ (when (and end (>= index end))
+ (return (values find position)))
+ (when (>= index start)
+ (,',condition (funcall predicate key-i)
+ ;; This hack of dealing with non-NIL
+ ;; FROM-END for list data by iterating
+ ;; forward through the list and keeping
+ ;; track of the last time we found a match
+ ;; might be more screwy than what the user
+ ;; expects, but it seems to be allowed by
+ ;; the ANSI standard. (And if the user is
+ ;; screwy enough to ask for FROM-END
+ ;; behavior on list data, turnabout is
+ ;; fair play.)
+ ;;
+ ;; It's also not enormously efficient,
+ ;; calling PREDICATE and KEY more often
+ ;; than necessary; but all the
+ ;; alternatives seem to have their own
+ ;; efficiency problems.
+ (if from-end
+ (setf find i
+ position index)
+ (return (values i index))))))
+ (incf index))))))
+ (def-frob %find-position-if when)
+ (def-frob %find-position-if-not unless))
+
;;; %FIND-POSITION for LIST data can be expanded into %FIND-POSITION-IF
;;; without loss of efficiency. (I.e., the optimizer should be able
;;; to straighten everything out.)
element
`(funcall ,predicate (funcall ,key ,element)))))
-;;; %FIND-POSITION and %FIND-POSITION-IF for VECTOR data
+(def!macro %find-position-if-not-vector-macro (predicate sequence
+ from-end start end key)
+ (let ((element (gensym "ELEMENT")))
+ (%find-position-or-find-position-if-vector-expansion
+ sequence
+ from-end
+ start
+ end
+ element
+ `(not (funcall ,predicate (funcall ,key ,element))))))
+
+;;; %FIND-POSITION, %FIND-POSITION-IF and %FIND-POSITION-IF-NOT for
+;;; VECTOR data
(deftransform %find-position-if ((predicate sequence from-end start end key)
(function vector t t t function)
*
(check-inlineability-of-find-position-if sequence from-end)
'(%find-position-if-vector-macro predicate sequence
from-end start end key))
+
+(deftransform %find-position-if-not ((predicate sequence from-end start end key)
+ (function vector t t t function)
+ *
+ :policy (> speed space)
+ :important t)
+ "expand inline"
+ (check-inlineability-of-find-position-if sequence from-end)
+ '(%find-position-if-not-vector-macro predicate sequence
+ from-end start end key))
+
(deftransform %find-position ((item sequence from-end start end key test)
(t vector t t t function function)
*
* stubs for C-linkage library functions which we need to refer to
* from Lisp
*
- * These exist for the benefit of Lisp code that needs to refer to
- * foreign symbols when dlsym() is not available (i.e. when dumping
+ * (But note this is only the Linux version, as per the FIXME
+ * note in the BSD version in undefineds.h.)
+ *
+ * These stubs exist for the benefit of Lisp code that needs to refer
+ * to foreign symbols when dlsym() is not available (i.e. when dumping
* cold-sbcl.core, when we may be running in a host that's not SBCL,
* or on platforms that don't have it at all). If the runtime is
* dynamically linked, library functions won't be linked into it, so
LDSO_STUBIFY(socket)
LDSO_STUBIFY(stat)
LDSO_STUBIFY(strerror)
+ LDSO_STUBIFY(strlen)
LDSO_STUBIFY(symlink)
LDSO_STUBIFY(sync)
LDSO_STUBIFY(tanh)
/*
* routines that must be linked into the core for Lisp to work
+ *
+ * but note this is only the BSD version, as per the FIXME
+ *
+ * FIXME: It's tedious and error-prone having to edit both this file and
+ * the analogous ldso-stubs.S file when we change the references to
+ * functions, enough so that it would probably be good to rewrite
+ * both files in terms of a shared list of function names.
+ * E.g. the function names could be in shared-function-names.h
+ * SHARED_FUNCTION(cos)
+ * SHARED_FUNCTION(sinh)
+ * SHARED_FUNCTION(strlen)
+ * etc. and the per-OS files could look like
+ * #define SHARED_FUNCTION(f) ....
+ * #include "shared-function-names.h"
+ * ...then going on to do OS-specific things
+ * "Once and only once."
*/
/*
* provided with absolutely no warranty. See the COPYING and CREDITS
* files for more information.
*/
-
+
/* Pick up all the syscalls. */
F(accept)
F(access)
#endif
F(hypot)
+/* string things */
+F(strlen)
+
/* network support */
F(gethostbyname)
F(gethostbyaddr)
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.pre7.137"
+"0.pre7.138"
projects / sbcl.git / commitdiff