X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ffndb.lisp;h=0c80ebf22a28aa72e70f2c5e50688a8cfd36f078;hb=0c0d8909984b5b33bb6b59b350b2d5cee6dc1715;hp=cbd728ebc478904a1147f4fafbe3255612ad8594;hpb=a682f4c392bc874a6a898632889319ebdd8821fc;p=sbcl.git

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index cbd728e..0c80ebf 100644
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -16,9 +16,9 @@
 ;;;; information for known functions:
 
 (defknown coerce (t type-specifier) t
-  ;; Note:
-  ;; This is not FLUSHABLE because it's defined to signal errors.
-  (movable)
+    ;; Note:
+    ;; This is not FLUSHABLE because it's defined to signal errors.
+    (movable)
   ;; :DERIVE-TYPE RESULT-TYPE-SPEC-NTH-ARG 2 ? Nope... (COERCE 1 'COMPLEX)
   ;; returns REAL/INTEGER, not COMPLEX.
   )
@@ -29,8 +29,8 @@
 
 ;;; These can be affected by type definitions, so they're not FOLDABLE.
 (defknown (sb!xc:upgraded-complex-part-type sb!xc:upgraded-array-element-type)
-          (type-specifier &optional lexenv-designator) type-specifier
-  (unsafely-flushable))
+    (type-specifier &optional lexenv-designator) type-specifier
+    (unsafely-flushable))
 
 ;;;; from the "Predicates" chapter:
 
@@ -81,7 +81,7 @@
 
 (sb!xc:deftype name-for-class () t)
 (defknown classoid-name (classoid) name-for-class (flushable))
-(defknown find-classoid (name-for-class &optional t lexenv-designator)
+(defknown find-classoid (name-for-class &optional t)
   (or classoid null) ())
 (defknown classoid-of (t) classoid (flushable))
 (defknown layout-of (t) layout (flushable))
@@ -204,7 +204,7 @@
 (defknown unexport (symbols-designator &optional package-designator) (eql t))
 (defknown shadowing-import (symbols-designator &optional package-designator)
   (eql t))
-(defknown shadow ((or symbol string list) &optional package-designator)
+(defknown shadow ((or symbol character string list) &optional package-designator)
   (eql t))
 (defknown (use-package unuse-package)
   ((or list package-designator) &optional package-designator) (eql t))
@@ -231,7 +231,7 @@
 (defknown * (&rest number) number
   (movable foldable flushable explicit-check))
 (defknown / (number &rest number) number
-  (movable foldable flushable explicit-check))
+  (movable foldable unsafely-flushable explicit-check))
 (defknown (1+ 1-) (number) number
   (movable foldable flushable explicit-check))
 
@@ -326,18 +326,18 @@
   (movable foldable flushable explicit-check))
 
 (defknown decode-float (float) (values float float-exponent float)
-  (movable foldable flushable explicit-check))
+  (movable foldable unsafely-flushable explicit-check))
 (defknown scale-float (float integer) float
   (movable foldable unsafely-flushable explicit-check))
 (defknown float-radix (float) float-radix
-  (movable foldable flushable))
+  (movable foldable unsafely-flushable))
 (defknown float-sign (float &optional float) float
-  (movable foldable flushable explicit-check))
+  (movable foldable unsafely-flushable explicit-check))
 (defknown (float-digits float-precision) (float) float-digits
-  (movable foldable flushable explicit-check))
+  (movable foldable unsafely-flushable explicit-check))
 (defknown integer-decode-float (float)
-          (values integer float-int-exponent (member -1 1))
-          (movable foldable flushable explicit-check))
+    (values integer float-int-exponent (member -1 1))
+    (movable foldable unsafely-flushable explicit-check))
 
 (defknown complex (real &optional real) number
   (movable foldable flushable explicit-check))
@@ -380,8 +380,12 @@
 (defknown deposit-field (integer byte-specifier integer) integer
   (movable foldable flushable))
 (defknown random ((or (float (0.0)) (integer 1)) &optional random-state)
-  (or (float 0.0) (integer 0)) ())
-(defknown make-random-state (&optional (or (member nil t) random-state))
+  (or (float 0.0) (integer 0))
+  (explicit-check))
+(defknown make-random-state (&optional
+                             (or (member nil t) random-state unsigned-byte
+                                 (simple-array (unsigned-byte 8) (*))
+                                 (simple-array (unsigned-byte 32) (*))))
   random-state (flushable))
 (defknown random-state-p (t) boolean (movable foldable flushable))
 
@@ -485,13 +489,15 @@
                          (:start index) (:end sequence-end)) sequence
   (unsafe)
   :derive-type #'result-type-first-arg
-  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1))
+  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)
+  :result-arg 0)
 
 (defknown replace (sequence sequence &rest t &key (:start1 index)
                    (:end1 sequence-end) (:start2 index) (:end2 sequence-end))
   sequence ()
   :derive-type #'result-type-first-arg
-  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1))
+  :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)
+  :result-arg 0)
 
 (defknown remove
   (t sequence &rest t &key (:from-end t) (:test callable)
@@ -678,8 +684,13 @@
 (defknown list-length (list) (or index null) (foldable unsafely-flushable))
 (defknown nth (unsigned-byte list) t (foldable flushable))
 (defknown nthcdr (unsigned-byte list) t (foldable unsafely-flushable))
+
 (defknown last (list &optional unsigned-byte) t (foldable flushable))
-(defknown sb!impl::last1 (list) t (foldable flushable))
+(defknown %last0 (list) t (foldable flushable))
+(defknown %last1 (list) t (foldable flushable))
+(defknown %lastn/fixnum (list (and unsigned-byte fixnum)) t (foldable flushable))
+(defknown %lastn/bignum (list (and unsigned-byte bignum)) t (foldable flushable))
+
 (defknown list (&rest t) list (movable flushable unsafe))
 (defknown list* (t &rest t) t (movable flushable unsafe))
 (defknown make-list (index &key (:initial-element t)) list
@@ -783,7 +794,9 @@
   (&key (:test callable) (:size unsigned-byte)
         (:rehash-size (or (integer 1) (float (1.0))))
         (:rehash-threshold (real 0 1))
-        (:weakness (member nil :key :value :key-and-value :key-or-value)))
+        (:hash-function (or null callable))
+        (:weakness (member nil :key :value :key-and-value :key-or-value))
+        (:synchronized t))
   hash-table
   (flushable unsafe))
 (defknown hash-table-p (t) boolean (movable foldable flushable))
@@ -801,14 +814,14 @@
 (defknown clrhash (hash-table) hash-table ()
   :destroyed-constant-args (nth-constant-args 2))
 (defknown hash-table-count (hash-table) index (flushable))
-(defknown hash-table-rehash-size (hash-table) (or (integer 1) (float (1.0)))
+(defknown hash-table-rehash-size (hash-table) (or index (single-float (1.0)))
   (foldable flushable))
-(defknown hash-table-rehash-threshold (hash-table) (real 0 1)
+(defknown hash-table-rehash-threshold (hash-table) (single-float (0.0) 1.0)
   (foldable flushable))
 (defknown hash-table-size (hash-table) index (flushable))
 (defknown hash-table-test (hash-table) symbol (foldable flushable))
-(defknown sxhash (t) (integer 0 #.sb!xc:most-positive-fixnum)
-  (#-sb-xc-host foldable flushable))
+(defknown sxhash (t) hash (#-sb-xc-host foldable flushable))
+(defknown psxhash (t &optional t) hash (#-sb-xc-host foldable flushable))
 
 ;;;; from the "Arrays" chapter
 
@@ -862,12 +875,16 @@
 
 (defknown array-has-fill-pointer-p (array) boolean
   (movable foldable flushable))
-(defknown fill-pointer (vector) index (foldable unsafely-flushable))
-(defknown vector-push (t vector) (or index null) ()
+(defknown fill-pointer (complex-vector) index
+    (unsafely-flushable explicit-check))
+(defknown vector-push (t complex-vector) (or index null)
+    (explicit-check)
   :destroyed-constant-args (nth-constant-args 2))
-(defknown vector-push-extend (t vector &optional index) index ()
+(defknown vector-push-extend (t complex-vector &optional (and index (integer 1))) index
+    (explicit-check)
   :destroyed-constant-args (nth-constant-args 2))
-(defknown vector-pop (vector) t ()
+(defknown vector-pop (complex-vector) t
+    (explicit-check)
   :destroyed-constant-args (nth-constant-args 1))
 
 ;;; FIXME: complicated :DESTROYED-CONSTANT-ARGS
@@ -905,7 +922,7 @@
   simple-string (flushable))
 
 (defknown (string-trim string-left-trim string-right-trim)
-  (sequence string-designator) simple-string (flushable))
+  (sequence string-designator) string (flushable))
 
 (defknown (string-upcase string-downcase string-capitalize)
   (string-designator &key (:start index) (:end sequence-end))
@@ -974,7 +991,7 @@
   (character character &optional readtable (or readtable null)) (eql t)
   ())
 
-(defknown set-macro-character (character callable &optional t readtable)
+(defknown set-macro-character (character callable &optional t (or readtable null))
   (eql t)
   (unsafe))
 (defknown get-macro-character (character &optional (or readtable null))
@@ -983,7 +1000,7 @@
 (defknown make-dispatch-macro-character (character &optional t readtable)
   (eql t) ())
 (defknown set-dispatch-macro-character
-  (character character callable &optional readtable) function
+  (character character callable &optional (or readtable null)) (eql t)
   (unsafe))
 (defknown get-dispatch-macro-character
   (character character &optional (or readtable null)) (or callable null)
@@ -1222,7 +1239,7 @@
                                            :rename-and-delete :overwrite
                                            :append :supersede nil))
                        (:if-does-not-exist (member :error :create nil))
-                       (:external-format keyword))
+                       (:external-format external-format-designator))
   (or stream null))
 
 (defknown rename-file (pathname-designator filename)
@@ -1244,11 +1261,11 @@
    &key
    (:verbose t)
    (:print t)
-   (:if-does-not-exist (member :error :create nil))
-   (:external-format keyword))
+   (:if-does-not-exist t)
+   (:external-format external-format-designator))
   t)
 
-(defknown directory (pathname-designator &key)
+(defknown directory (pathname-designator &key (:resolve-symlinks t))
   list ())
 
 ;;;; from the "Conditions" chapter:
@@ -1279,7 +1296,9 @@
   null)
 
 ;;; and analogous SBCL extension:
+(defknown sb!impl::%failed-aver (t) nil)
 (defknown bug (t &rest t) nil) ; never returns
+
 
 ;;;; from the "Miscellaneous" Chapter:
 
@@ -1297,11 +1316,12 @@
                      (member t)))
    (:verbose t)
    (:print t)
-   (:external-format keyword)
+   (:external-format external-format-designator)
 
    ;; extensions
    (:trace-file t)
-   (:block-compile t))
+   (:block-compile t)
+   (:emit-cfasl t))
   (values (or pathname null) boolean boolean))
 
 ;; FIXME: consider making (OR CALLABLE CONS) something like
@@ -1310,10 +1330,6 @@
                        (:stream stream) (:use-labels t))
   null)
 
-(defknown fdocumentation (t symbol)
-  (or string null)
-  (flushable))
-
 (defknown describe (t &optional (or stream (member t nil))) (values))
 (defknown inspect (t) (values))
 (defknown room (&optional (member t nil :default)) (values))
@@ -1372,19 +1388,21 @@
 
 ;;;; miscellaneous extensions
 
+(defknown symbol-global-value (symbol) t ())
+(defknown set-symbol-global-value (symbol t) t ())
+
 (defknown get-bytes-consed () unsigned-byte (flushable))
 (defknown mask-signed-field ((integer 0 *) integer) integer
           (movable flushable foldable))
 
-;;; PCOUNTERs
-(defknown incf-pcounter (pcounter unsigned-byte) pcounter)
-(defknown pcounter->integer (pcounter) unsigned-byte)
-(defknown %incf-pcounter-or-fixnum ((or pcounter fixnum) unsigned-byte)
-  (or pcounter fixnum))
-(defknown pcounter-or-fixnum->integer ((or pcounter fixnum)) unsigned-byte)
+(defknown array-storage-vector (array) (simple-array * (*))
+    (any))
 
 ;;;; magical compiler frobs
 
+(defknown %unary-truncate/single-float (single-float) integer (movable foldable flushable))
+(defknown %unary-truncate/double-float (double-float) integer (movable foldable flushable))
+
 ;;; We can't fold this in general because of SATISFIES. There is a
 ;;; special optimizer anyway.
 (defknown %typep (t (or type-specifier ctype)) boolean
@@ -1399,7 +1417,9 @@
 (defknown %more-arg-context (t t) (values t index) (flushable))
 (defknown %more-arg (t index) t)
 #!+stack-grows-downward-not-upward
-(defknown %more-kw-arg (t index) (values t t))
+;;; FIXME: The second argument here should really be NEGATIVE-INDEX, but doing that
+;;; breaks the build, and I cannot seem to figure out why. --NS 2006-06-29
+(defknown %more-kw-arg (t fixnum) (values t t))
 (defknown %more-arg-values (t index index) * (flushable))
 (defknown %verify-arg-count (index index) (values))
 (defknown %arg-count-error (t) nil)
@@ -1420,6 +1440,7 @@
 ;; FIXME: This function does not return, but due to the implementation
 ;; of FILTER-LVAR we cannot write it here.
 (defknown %compile-time-type-error (t t t) *)
+(defknown sb!kernel::case-failure (t t t) nil)
 
 (defknown %odd-key-args-error () nil)
 (defknown %unknown-key-arg-error (t) nil)
@@ -1431,19 +1452,33 @@
 (defknown %check-bound (array index fixnum) index (movable foldable flushable))
 (defknown data-vector-ref (simple-array index) t
   (foldable explicit-check always-translatable))
+(defknown data-vector-ref-with-offset (simple-array index fixnum) t
+  (foldable explicit-check always-translatable))
 (defknown data-vector-set (array index t) t
   (unsafe explicit-check always-translatable))
+(defknown data-vector-set-with-offset (array index fixnum t) t
+  (unsafe explicit-check always-translatable))
 (defknown hairy-data-vector-ref (array index) t
   (foldable explicit-check))
 (defknown hairy-data-vector-set (array index t) t (unsafe explicit-check))
-(defknown %caller-frame-and-pc () (values t t) (flushable))
+(defknown hairy-data-vector-ref/check-bounds (array index) t
+  (foldable explicit-check))
+(defknown hairy-data-vector-set/check-bounds (array index t)
+  t
+  (unsafe explicit-check))
+(defknown %caller-frame () t (flushable))
+(defknown %caller-pc () system-area-pointer (flushable))
 (defknown %with-array-data (array index (or index null))
   (values (simple-array * (*)) index index index)
   (foldable flushable))
+(defknown %with-array-data/fp (array index (or index null))
+  (values (simple-array * (*)) index index index)
+  (foldable flushable))
 (defknown %set-symbol-package (symbol t) t (unsafe))
 (defknown %coerce-name-to-fun ((or symbol cons)) function (flushable))
 (defknown %coerce-callable-to-fun (callable) function (flushable))
-(defknown failed-%with-array-data (t t t) nil)
+(defknown array-bounding-indices-bad-error (t t t) nil)
+(defknown sequence-bounding-indices-bad-error (t t t) nil)
 (defknown %find-position
   (t sequence t index sequence-end function function)
   (values t (or index null))
@@ -1459,6 +1494,15 @@
   function
   (flushable foldable))
 
+(defknown %adjoin     (t list)          list (explicit-check foldable flushable))
+(defknown %adjoin-key (t list function) list (explicit-check foldable flushable call))
+(defknown %assoc      (t list)          list (explicit-check foldable flushable))
+(defknown %assoc-key  (t list function) list (explicit-check foldable flushable call))
+(defknown %member     (t list)          list (explicit-check foldable flushable))
+(defknown %member-key (t list function) list (explicit-check foldable flushable call))
+(defknown %rassoc     (t list)          list (explicit-check foldable flushable))
+(defknown %rassoc-key (t list function) list (explicit-check foldable flushable call))
+
 (defknown %check-vector-sequence-bounds (vector index sequence-end)
   index
   (unwind))
@@ -1496,21 +1540,19 @@
   :destroyed-constant-args (nth-constant-args 1))
 (defknown %set-symbol-value (symbol t) t (unsafe))
 (defknown (setf symbol-function) (function symbol) function (unsafe))
-(defknown %set-symbol-plist (symbol t) t (unsafe))
-(defknown (setf fdocumentation) ((or string null) t symbol)
-  (or string null)
-  ())
+(defknown %set-symbol-plist (symbol list) list (unsafe))
 (defknown %setnth (unsigned-byte list t) t (unsafe)
   :destroyed-constant-args (nth-constant-args 2))
-(defknown %set-fill-pointer (vector index) index (unsafe)
+(defknown %set-fill-pointer (complex-vector index) index
+    (unsafe explicit-check)
   :destroyed-constant-args (nth-constant-args 1))
 
 ;;;; ALIEN and call-out-to-C stuff
 
-;;; 'unsafe' attribute because we store the arg on the stack, which is in
-;;; some sense 'passing it upwards'
-(defknown sb!vm::push-word-on-c-stack (system-area-pointer) (values) (unsafe))
-(defknown sb!vm::pop-words-from-c-stack (index) (values) ())
+;; Used by WITH-PINNED-OBJECTS
+#!+(or x86 x86-64)
+(defknown sb!vm::touch-object (t) (values)
+    (unsafe always-translatable))
 
 #!+linkage-table
 (defknown foreign-symbol-dataref-sap (simple-string)
@@ -1534,8 +1576,26 @@
           (flushable))
 
 (defknown compiler-error (t &rest t) nil ())
-(defknown (compiler-warn compiler-style-warn) (string &rest t) (values) ())
+(defknown (compiler-warn compiler-style-warn) (t &rest t) (values) ())
 (defknown (compiler-notify maybe-compiler-notify) ((or string symbol) &rest t)
   (values)
   ())
-(defknown style-warn (string &rest t) null ())
+(defknown style-warn (t &rest t) null ())
+
+
+;;;; memory barriers
+
+(defknown sb!vm:%compiler-barrier () (values) ())
+(defknown sb!vm:%memory-barrier () (values) ())
+(defknown sb!vm:%read-barrier () (values) ())
+(defknown sb!vm:%write-barrier () (values) ())
+(defknown sb!vm:%data-dependency-barrier () (values) ())
+
+
+;;;; atomic ops
+(defknown %compare-and-swap-svref (simple-vector index t t) t
+    (unsafe))
+(defknown %compare-and-swap-instance-ref (instance index t t) t
+    (unsafe))
+(defknown %compare-and-swap-symbol-value (symbol t t) t
+    (unsafe unwind))