:doc "private: stuff for implementing ALIENs and friends"
:use ("CL")
:export ("%CAST" "%DEREF-ADDR" "%HEAP-ALIEN" "%HEAP-ALIEN-ADDR"
-
"%LOCAL-ALIEN-ADDR" "%LOCAL-ALIEN-FORCED-TO-MEMORY-P" "%SAP-ALIEN"
"%SET-DEREF" "%SET-HEAP-ALIEN" "%SET-LOCAL-ALIEN" "%SET-SLOT"
"%SLOT-ADDR" "*VALUES-TYPE-OKAY*" "ALIEN-ARRAY-TYPE"
"GET-PAGE-SIZE" "GET-SYSTEM-INFO"
"IGNORE-INTERRUPT"
"INT-SAP" "INVALIDATE-DESCRIPTOR" "IO-TIMEOUT"
- "MACRO" "MAKE-FD-STREAM" "MAKE-OBJECT-SET" "MAP-PORT"
+ "MACRO" "MAKE-FD-STREAM" "MAKE-OBJECT-SET" "MEMMOVE"
"NATURALIZE-BOOLEAN" "NATURALIZE-INTEGER"
- "NULL-TERMINATED-STRING" "OBJECT-SET-OPERATION"
+ "OBJECT-SET-OPERATION"
"OS-COLD-INIT-OR-REINIT" "OS-CONTEXT-T" "OUTPUT-RAW-BYTES"
- "PARSE-BODY" "PERQ-STRING" "POINTER"
- "POINTER<" "POINTER>" "PORT" "POSITIVE-PRIMEP" "PUSH-USING-SETQ"
+ "PARSE-BODY" "POINTER"
+ "POINTER<" "POINTER>" "PORT" "POSITIVE-PRIMEP"
"READ-N-BYTES" "REALLOCATE-SYSTEM-MEMORY" "RECORD-SIZE"
"REMOVE-FD-HANDLER" "REMOVE-PORT-DEATH-HANDLER"
"REMOVE-PORT-OBJECT"
#!-sb-fluid (declaim (inline do-unary-bit-bash))
(defun do-unary-bit-bash (src src-offset dst dst-offset length
dst-ref-fn dst-set-fn src-ref-fn)
+ ;; FIXME: Declaring these bit indices to be of type OFFSET, then
+ ;; using the inline expansion in SPEED 3 SAFETY 0 functions, is not
+ ;; a good thing. At the very least, we should make sure that the
+ ;; type (overflow) checks get done. Better would be to avoid
+ ;; using bit indices, and to use 32-bit unsigneds instead, and/or
+ ;; to call out to things like memmove(3) for big moves.
(declare (type offset src-offset dst-offset length)
(type function dst-ref-fn dst-set-fn src-ref-fn))
(multiple-value-bind (dst-word-offset dst-bit-offset)
(ash (aref ,vec (+ ,index 4)) 24))
(incf ,index 5))))))
-;;; Takes an adjustable vector Vec with a fill pointer and pushes the
-;;; variable length representation of Int on the end.
+;;; Take an adjustable vector VEC with a fill pointer and push the
+;;; variable length representation of INT on the end.
(defun write-var-integer (int vec)
(declare (type (unsigned-byte 32) int))
(cond ((<= int 253)
\f
;;;; packed strings
;;;;
-;;;; A packed string is a variable length integer length followed by the
-;;;; character codes.
+;;;; A packed string is a variable length integer length followed by
+;;;; the character codes.
-;;; Read a packed string from Vec starting at Index, advancing Index.
+;;; Read a packed string from VEC starting at INDEX, advancing INDEX.
(defmacro read-var-string (vec index)
(once-only ((len `(read-var-integer ,vec ,index)))
(once-only ((res `(make-string ,len)))
(incf ,index ,len)
,res))))
-;;; Write String into Vec (adjustable, fill-pointer) represented as the
-;;; length (in a var-length integer) followed by the codes of the characters.
+;;; Write STRING into VEC (adjustable, with fill-pointer) represented
+;;; as the length (in a var-length integer) followed by the codes of
+;;; the characters.
(defun write-var-string (string vec)
(declare (simple-string string))
(let ((len (length string)))
\f
;;;; packed bit vectors
-;;; Read the specified number of Bytes out of Vec at Index and convert them
-;;; to a bit-vector. Index is incremented.
+;;; Read the specified number of BYTES out of VEC at INDEX and convert
+;;; them to a BIT-VECTOR. INDEX is incremented.
(defmacro read-packed-bit-vector (bytes vec index)
(once-only ((n-bytes bytes))
(once-only ((n-res `(make-array (* ,n-bytes 8) :element-type 'bit)))
(defun just-dump-it-normally (object &optional (env nil env-p))
(declare (type structure!object object))
(if env-p
- (make-load-form-saving-slots object :environment env)
- (make-load-form-saving-slots object)))
+ (make-load-form-saving-slots object :environment env)
+ (make-load-form-saving-slots object)))
;;; a MAKE-LOAD-FORM function for objects which don't use the load
;;; form system. This is used for LAYOUT objects because the special
(defun parse-def!struct-args (nameoid &rest rest)
(multiple-value-bind (name options) ; Note: OPTIONS can change below.
(if (consp nameoid)
- (values (first nameoid) (rest nameoid))
- (values nameoid nil))
+ (values (first nameoid) (rest nameoid))
+ (values nameoid nil))
(let* ((include-clause (find :include options :key #'first))
(def!struct-supertype nil) ; may change below
(mlff-clause (find :make-load-form-fun options :key #'first))
(when include-clause
(setf def!struct-supertype (second include-clause)))
(if (eq name 'structure!object) ; if root of hierarchy
- (aver (not include-clause))
- (unless include-clause
- (setf def!struct-supertype 'structure!object)
- (push `(:include ,def!struct-supertype) options)))
+ (aver (not include-clause))
+ (unless include-clause
+ (setf def!struct-supertype 'structure!object)
+ (push `(:include ,def!struct-supertype) options)))
(values name `((,name ,@options) ,@rest) mlff def!struct-supertype)))))
;;; Part of the raison d'etre for DEF!STRUCT is to be able to emulate
(let* ((class (sb!xc:find-class (type-of instance)))
(layout (class-layout class)))
(if (zerop index)
- layout
- (let* ((dd (layout-info layout))
- (dsd (elt (dd-slots dd) (1- index)))
- (accessor (dsd-accessor dsd)))
- (declare (type symbol accessor))
- (funcall accessor instance)))))
+ layout
+ (let* ((dd (layout-info layout))
+ (dsd (elt (dd-slots dd) (1- index)))
+ (accessor (dsd-accessor dsd)))
+ (declare (type symbol accessor))
+ (funcall accessor instance)))))
(defun %instance-set (instance index new-value)
(check-type instance structure!object)
(let* ((class (sb!xc:find-class (type-of instance)))
(layout (class-layout class)))
(if (zerop index)
- (error "can't set %INSTANCE-REF FOO 0 in cross-compilation host")
- (let* ((dd (layout-info layout))
- (dsd (elt (dd-slots dd) (1- index)))
- (accessor (dsd-accessor dsd)))
- (declare (type symbol accessor))
- (funcall (fdefinition `(setf ,accessor)) new-value instance))))))
+ (error "can't set %INSTANCE-REF FOO 0 in cross-compilation host")
+ (let* ((dd (layout-info layout))
+ (dsd (elt (dd-slots dd) (1- index)))
+ (accessor (dsd-accessor dsd)))
+ (declare (type symbol accessor))
+ (funcall (fdefinition `(setf ,accessor)) new-value instance))))))
;;; a helper function for DEF!STRUCT in the #+SB-XC-HOST case: Return
;;; DEFSTRUCT-style arguments with any class names in the SB!XC
(destructuring-bind (name-and-options &rest slots-and-doc) defstruct-args
(multiple-value-bind (name options)
(if (symbolp name-and-options)
- (values name-and-options nil)
- (values (first name-and-options)
- (rest name-and-options)))
+ (values name-and-options nil)
+ (values (first name-and-options)
+ (rest name-and-options)))
(flet ((uncross-option (option)
(if (eq (first option) :include)
- (destructuring-bind
- (include-keyword included-name &rest rest)
- option
- `(,include-keyword
- ,(uncross included-name)
- ,@rest))
+ (destructuring-bind
+ (include-keyword included-name &rest rest)
+ option
+ `(,include-keyword
+ ,(uncross included-name)
+ ,@rest))
option)))
`((,(uncross name)
,@(mapcar #'uncross-option options))
(multiple-value-bind (name defstruct-args mlff def!struct-supertype)
(apply #'parse-def!struct-args args)
`(progn
- ;; (Putting the DEFSTRUCT here, outside the EVAL-WHEN, seems to
- ;; be necessary in order to cross-compile the hash table
- ;; implementation. -- WHN 19990809)
+ ;; Make sure that we really do include STRUCTURE!OBJECT. (If an
+ ;; :INCLUDE clause was used, and the included class didn't
+ ;; itself include STRUCTURE!OBJECT, then we wouldn't; and it's
+ ;; better to find out ASAP then to let the bug lurk until
+ ;; someone tries to do MAKE-LOAD-FORM on the object.)
+ (aver (subtypep ',def!struct-supertype 'structure!object))
(defstruct ,@defstruct-args)
- ;; (Putting this SETF here, outside the EVAL-WHEN, seems to be
- ;; necessary in order to allow us to put the DEFSTRUCT outside
- ;; the EVAL-WHEN.)
(setf (def!struct-type-make-load-form-fun ',name)
,(if (symbolp mlff)
- `',mlff
- mlff)
+ `',mlff
+ mlff)
(def!struct-supertype ',name)
',def!struct-supertype)
;; This bit of commented-out code hasn't been needed for quite
#+sb-xc-host
(defun force-delayed-def!structs ()
(if (boundp '*delayed-def!structs*)
- (progn
- (mapcar (lambda (x)
- (let ((*package* (delayed-def!struct-package x)))
- ;; KLUDGE(?): EVAL is almost always the wrong thing.
- ;; However, since we have to map DEFSTRUCT over the
- ;; list, and since ANSI declined to specify any
- ;; functional primitives corresponding to the
- ;; DEFSTRUCT macro, it seems to me that EVAL is
- ;; required in there somewhere..
- (eval `(sb!xc:defstruct ,@(delayed-def!struct-args x)))))
- (reverse *delayed-def!structs*))
- ;; We shouldn't need this list any more. Making it unbound
- ;; serves as a signal to DEF!STRUCT that it needn't delay
- ;; DEF!STRUCTs any more. It is also generally a good thing for
- ;; other reasons: it frees garbage, and it discourages anyone
- ;; else from pushing anything else onto the list later.
- (makunbound '*delayed-def!structs*))
- ;; This condition is probably harmless if it comes up when
- ;; interactively experimenting with the system by loading a source
- ;; file into it more than once. But it's worth warning about it
- ;; because it definitely shouldn't come up in an ordinary build
- ;; process.
- (warn "*DELAYED-DEF!STRUCTS* is already unbound.")))
+ (progn
+ (mapcar (lambda (x)
+ (let ((*package* (delayed-def!struct-package x)))
+ ;; KLUDGE(?): EVAL is almost always the wrong thing.
+ ;; However, since we have to map DEFSTRUCT over the
+ ;; list, and since ANSI declined to specify any
+ ;; functional primitives corresponding to the
+ ;; DEFSTRUCT macro, it seems to me that EVAL is
+ ;; required in there somewhere..
+ (eval `(sb!xc:defstruct ,@(delayed-def!struct-args x)))))
+ (reverse *delayed-def!structs*))
+ ;; We shouldn't need this list any more. Making it unbound
+ ;; serves as a signal to DEF!STRUCT that it needn't delay
+ ;; DEF!STRUCTs any more. It is also generally a good thing for
+ ;; other reasons: it frees garbage, and it discourages anyone
+ ;; else from pushing anything else onto the list later.
+ (makunbound '*delayed-def!structs*))
+ ;; This condition is probably harmless if it comes up when
+ ;; interactively experimenting with the system by loading a source
+ ;; file into it more than once. But it's worth warning about it
+ ;; because it definitely shouldn't come up in an ordinary build
+ ;; process.
+ (warn "*DELAYED-DEF!STRUCTS* is already unbound.")))
;;; The STRUCTURE!OBJECT abstract class is the base of the type
;;; hierarchy for objects which have/use DEF!STRUCT functionality.
#+sb-xc-host
(defmethod make-load-form ((obj structure!object) &optional (env nil env-p))
(if env-p
- (structure!object-make-load-form obj env)
- (structure!object-make-load-form obj)))
+ (structure!object-make-load-form obj env)
+ (structure!object-make-load-form obj)))
(declare (type system-area-pointer context))
;; FIXME: The find-the-detailed-problem code below went stale with
;; the big switchover to POSIX signal handling and signal contexts
- ;; which are opaque at the Lisp level ca plod-0.6.7. It needs to be
+ ;; which are opaque at the Lisp level ca. sbcl-0.6.7. It needs to be
;; revived, which will require writing a C-level os-dependent
;; function to extract floating point modes, and a Lisp-level
;; DEF-ALIEN-ROUTINE to get to the C-level os-dependent function.
(in-package "SB!IMPL")
-;(defun %sp-byte-blt (src-string src-start dst-string dst-start dst-end)
-; "Moves bytes from Src-String into Dst-String between Dst-Start (inclusive)
-;and Dst-End (exclusive) (Dst-Start - Dst-End bytes are moved). Overlap of the
-;strings does not affect the result. This would be done on the Vax
-;with MOVC3. The arguments do not need to be strings: 8-bit U-Vectors
-;are also acceptable."
-; (%primitive byte-blt src-string src-start dst-string dst-start dst-end))
-
+;;; Compare the substrings specified by STRING1 and STRING2 and return
+;;; NIL if the strings are STRING=, or the lowest index of STRING1 in
+;;; which the two differ. If one string is longer than the other and
+;;; the shorter is a prefix of the longer, the length of the shorter +
+;;; START1 is returned. The arguments must be simple strings.
+;;;
+;;; This would be done on the Vax with CMPC3.
(defun %sp-string-compare (string1 start1 end1 string2 start2 end2)
(declare (simple-string string1 string2))
(declare (fixnum start1 end1 start2 end2))
- #!+sb-doc
- "Compares the substrings specified by String1 and String2 and returns
-NIL if the strings are String=, or the lowest index of String1 in
-which the two differ. If one string is longer than the other and the
-shorter is a prefix of the longer, the length of the shorter + start1 is
-returned. This would be done on the Vax with CMPC3. The arguments must
-be simple strings."
(let ((len1 (- end1 start1))
(len2 (- end2 start2)))
(declare (fixnum len1 len2))
(if (char/= (schar string1 index1) (schar string2 index2))
(return index1)))))))
+;;; like %SP-STRING-COMPARE, only backwards
(defun %sp-reverse-string-compare (string1 start1 end1 string2 start2 end2)
(declare (simple-string string1 string2))
(declare (fixnum start1 end1 start2 end2))
- #!+sb-doc
- "like %SP-STRING-COMPARE, only backwards"
(let ((len1 (- end1 start1))
(len2 (- end2 start2)))
(declare (fixnum len1 len2))
`(char-code (char-ref ,index))))
,@body))))
+;;; The codes of the characters of STRING from START to END are used
+;;; as indices into the TABLE, which is a U-Vector of 8-bit bytes.
+;;; When the number picked up from the table bitwise ANDed with MASK
+;;; is non-zero, the current index into the STRING is returned.
+;;;
+;;; (This corresponds to SCANC on the Vax.)
(defun %sp-find-character-with-attribute (string start end table mask)
(declare (type (simple-array (unsigned-byte 8) (256)) table)
(type (or simple-string system-area-pointer) string)
(fixnum start end mask))
- #!+sb-doc
- "%SP-Find-Character-With-Attribute String, Start, End, Table, Mask
- The codes of the characters of String from Start to End are used as indices
- into the Table, which is a U-Vector of 8-bit bytes. When the number picked
- up from the table bitwise ANDed with Mask is non-zero, the current
- index into the String is returned. The corresponds to SCANC on the Vax."
(maybe-sap-maybe-string (string)
(do ((index start (1+ index)))
((>= index end) nil)
(unless (zerop (logand (aref table (byte-ref index)) mask))
(return index)))))
+;;; like %SP-FIND-CHARACTER-WITH-ATTRIBUTE, only sdrawkcaB
(defun %sp-reverse-find-character-with-attribute (string start end table mask)
- #!+sb-doc
- "Like %SP-Find-Character-With-Attribute, only sdrawkcaB."
(declare (type (or simple-string system-area-pointer) string)
(fixnum start end mask)
(type (array (unsigned-byte 8) (256)) table))
(unless (zerop (logand (aref table (byte-ref index)) mask))
(return index)))))
+;;; Search STRING for the CHARACTER from START to END. If the
+;;; character is found, the corresponding index into STRING is
+;;; returned, otherwise NIL is returned.
(defun %sp-find-character (string start end character)
- #!+sb-doc
- "%SP-Find-Character String, Start, End, Character
- Searches String for the Character from Start to End. If the character is
- found, the corresponding index into String is returned, otherwise NIL is
- returned."
(declare (fixnum start end)
(type (or simple-string system-area-pointer) string)
(base-char character))
(when (char= (char-ref index) character)
(return index)))))
+;;; Search STRING for CHARACTER from END to START. If the character is
+;;; found, the corresponding index into STRING is returned, otherwise
+;;; NIL is returned.
(defun %sp-reverse-find-character (string start end character)
(declare (type (or simple-string system-area-pointer) string)
(fixnum start end)
(base-char character))
- #!+sb-doc
- "%SP-Reverse-Find-Character String, Start, End, Character
- Searches String for Character from End to Start. If the character is
- found, the corresponding index into String is returned, otherwise NIL is
- returned."
(maybe-sap-maybe-string (string)
(do ((index (1- end) (1- index))
(terminus (1- start)))
(if (char= (char-ref index) character)
(return index)))))
+;;; Return the index of the first character between START and END
+;;; which is not CHAR= to CHARACTER, or NIL if there is no such
+;;; character.
(defun %sp-skip-character (string start end character)
(declare (type (or simple-string system-area-pointer) string)
(fixnum start end)
(base-char character))
- #!+sb-doc
- "%SP-Skip-Character String, Start, End, Character
- Returns the index of the first character between Start and End which
- is not Char= to Character, or NIL if there is no such character."
(maybe-sap-maybe-string (string)
(do ((index start (1+ index)))
((= index end) nil)
(if (char/= (char-ref index) character)
(return index)))))
+;;; Return the index of the last character between START and END which
+;;; is not CHAR= to CHARACTER, or NIL if there is no such character.
(defun %sp-reverse-skip-character (string start end character)
(declare (type (or simple-string system-area-pointer) string)
(fixnum start end)
(base-char character))
- #!+sb-doc
- "%SP-Skip-Character String, Start, End, Character
- Returns the index of the last character between Start and End which
- is not Char= to Character, or NIL if there is no such character."
(maybe-sap-maybe-string (string)
(do ((index (1- end) (1- index))
(terminus (1- start)))
(if (char/= (char-ref index) character)
(return index)))))
+;;; Search for the substring of STRING1 specified in STRING2. Return
+;;; an index into STRING2, or NIL if the substring wasn't found.
(defun %sp-string-search (string1 start1 end1 string2 start2 end2)
- #!+sb-doc
- "%SP-String-Search String1, Start1, End1, String2, Start2, End2
- Searches for the substring of String1 specified in String2.
- Returns an index into String2 or NIL if the substring wasn't
- found."
(declare (simple-string string1 string2))
(do ((index2 start2 (1+ index2)))
((= index2 end2) nil)
--- /dev/null
+;;;; assorted alien definitions
+
+;;;; 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!IMPL")
+
+(declaim (inline memmove))
+(def-alien-routine ("memmove" memmove) void
+ (dest (* char))
+ (src (* char))
+ (n unsigned-int))
;;; The HOST structure holds the functions that both parse the
;;; pathname information into structure slot entries, and after
;;; translation the inverse (unparse) functions.
-(sb!xc:defstruct (host (:constructor nil))
+(def!struct (host (:constructor nil))
(parse (required-argument) :type function)
(unparse (required-argument) :type function)
(unparse-host (required-argument) :type function)
(unparse-enough (required-argument) :type function)
(customary-case (required-argument) :type (member :upper :lower)))
-(sb!xc:defstruct (logical-host
+(def!struct (logical-host
(:include host
(:parse #'parse-logical-namestring)
(:unparse #'unparse-logical-namestring)
;;; the various magic tokens that are allowed to appear in pretty much
;;; all pathname components
-(sb!xc:deftype component-tokens () ; FIXME: rename to PATHNAME-COMPONENT-TOKENS
+(sb!xc:deftype pathname-component-tokens ()
'(member nil :unspecific :wild))
(sb!xc:defstruct (pathname (:conc-name %pathname-)
;; the host (at present either a UNIX or logical host)
(host nil :type (or host null))
;; the name of a logical or physical device holding files
- (device nil :type (or simple-string component-tokens))
+ (device nil :type (or simple-string pathname-component-tokens))
;; a list of strings that are the component subdirectory components
(directory nil :type list)
;; the filename
- (name nil :type (or simple-string pattern component-tokens))
+ (name nil :type (or simple-string pattern pathname-component-tokens))
;; the type extension of the file
- (type nil :type (or simple-string pattern component-tokens))
+ (type nil :type (or simple-string pattern pathname-component-tokens))
;; the version number of the file, a positive integer (not supported
;; on standard Unix filesystems)
- (version nil :type (or integer component-tokens (member :newest))))
+ (version nil :type (or integer pathname-component-tokens (member :newest))))
;;; Logical pathnames have the following format:
;;;
;;; Read NUMBYTES bytes into BUFFER beginning at START, and return the
;;; number of bytes read.
;;;
-;;; Note: CMU CL's version of this had a special interpretation of EOF-ERROR-P
-;;; which SBCL does not have. (In the EOF-ERROR-P=NIL case, CMU CL's version
-;;; would return as soon as any data became available.) This could be useful
-;;; behavior for things like pipes in some cases, but it wasn't being used in
-;;; SBCL, so it was dropped. If we ever need it, it could be added later as a
-;;; new variant N-BIN method (perhaps N-BIN-ASAP?) or something.
+;;; Note: CMU CL's version of this had a special interpretation of
+;;; EOF-ERROR-P which SBCL does not have. (In the EOF-ERROR-P=NIL
+;;; case, CMU CL's version would return as soon as any data became
+;;; available.) This could be useful behavior for things like pipes in
+;;; some cases, but it wasn't being used in SBCL, so it was dropped.
+;;; If we ever need it, it could be added later as a new variant N-BIN
+;;; method (perhaps N-BIN-ASAP?) or something.
(defun read-n-bytes (stream buffer start numbytes &optional (eof-error-p t))
(declare (type lisp-stream stream)
(type index numbytes start)
#!+sb-doc
"Makes a new pathname from the component arguments. Note that host is
a host-structure or string."
- (declare (type (or string host component-tokens) host)
- (type (or string component-tokens) device)
- (type (or list string pattern component-tokens) directory)
- (type (or string pattern component-tokens) name type)
- (type (or integer component-tokens (member :newest)) version)
+ (declare (type (or string host pathname-component-tokens) host)
+ (type (or string pathname-component-tokens) device)
+ (type (or list string pattern pathname-component-tokens) directory)
+ (type (or string pattern pathname-component-tokens) name type)
+ (type (or integer pathname-component-tokens (member :newest)) version)
(type (or pathname-designator null) defaults)
(type (member :common :local) case))
(let* ((defaults (when defaults
;;;; primitive translator for BYTE-BLT
(def-primitive-translator byte-blt (src src-start dst dst-start dst-end)
+
+ ;; new version
+ ;;
+ ;; FIXME: CMU CL had a hairier implementation of this. It had the
+ ;; small problem that it didn't work for large (>16M) values of
+ ;; SRC-START or DST-START. However, it might have been more
+ ;; efficient. In particular, I haven't checked how much the foreign
+ ;; function call costs us here. My guess is that if the overhead is
+ ;; acceptable for SQRT and COS, it's acceptable here, but this
+ ;; should probably be checked. -- WHN
+ (once-only ((dst-start dst-start))
+ `(flet ((sap (thing)
+ (etypecase thing
+ (system-area-pointer thing)
+ ((simple-unboxed-array (*)) (vector-sap thing)))))
+ (declare (inline sap))
+ (without-gcing
+ (memmove (sap+ (sap ,dst) ,dst-start)
+ (sap+ (sap ,src) ,src-start)
+ (- ,dst-end ,dst-start)))))
+
+ ;; REMOVEME when new version works
+ ;;
+ ;; old version, had overflow problems because it converts byte
+ ;; indices to bit indices, which is not good when GENESIS is trying
+ ;; to read into a byte vector which represents the cold image (>16M bytes)
+ #+nil
`(let ((src ,src)
(src-start (* ,src-start sb!vm:byte-bits))
(dst ,dst)
;;;; N-arg arithmetic and logic functions are associated into two-arg
;;;; versions, and degenerate cases are flushed.
-;;; Left-associate First-Arg and More-Args using Function.
+;;; Left-associate FIRST-ARG and MORE-ARGS using FUNCTION.
(declaim (ftype (function (symbol t list) list) associate-arguments))
(defun associate-arguments (function first-arg more-args)
(let ((next (rest more-args))
\f
;;;; SAP-INT and INT-SAP
+;;; The function SAP-INT is used to generate an integer corresponding
+;;; to the system area pointer, suitable for passing to the kernel
+;;; interfaces (which want all addresses specified as integers). The
+;;; function INT-SAP is used to do the opposite conversion. The
+;;; integer representation of a SAP is the byte offset of the SAP from
+;;; the start of the address space.
(define-vop (sap-int)
(:args (sap :scs (sap-reg) :target int))
(:arg-types system-area-pointer)
(:policy :fast-safe)
(:generator 1
(move int sap)))
-
(define-vop (int-sap)
(:args (int :scs (unsigned-reg) :target sap))
(:arg-types unsigned-num)
LDSO_STUBIFY(lseek)
LDSO_STUBIFY(lstat)
LDSO_STUBIFY(malloc)
+ LDSO_STUBIFY(memmove)
LDSO_STUBIFY(mkdir)
LDSO_STUBIFY(open)
LDSO_STUBIFY(opendir)
/* LDSO_STUBIFY(memcpy) */
/* LDSO_STUBIFY(memfrob) */
/* LDSO_STUBIFY(memmem) */
-/* LDSO_STUBIFY(memmove) */
/* LDSO_STUBIFY(memset) */
/* LDSO_STUBIFY(mkdir) */
/* LDSO_STUBIFY(mkfifo) */
("code/target-c-call" :not-host)
("code/target-allocate" :not-host)
+ ("code/misc-aliens" :not-host) ; needs DEF-ALIEN-ROUTINE from target-alieneval
+
("code/array" :not-host)
("code/target-sxhash" :not-host)
;;; 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.11.26"
+"0.6.11.27"
projects / sbcl.git / commitdiff