Changeset 13676 for trunk/source/library


Ignore:
Timestamp:
Apr 27, 2010, 12:15:24 PM (9 years ago)
Author:
gz
Message:

Tweaks to match documentation

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/library/core-files.lisp

    r13501 r13676  
    3131
    3232(export '(open-core close-core
    33           core-heap-utilization map-core-areas map-core-region map-core-pointers
     33          core-heap-utilization map-core-areas
    3434          core-q core-l core-w core-b
    3535          core-consp core-symbolp core-functionp core-listp core-nullp core-uvector-p
    3636          core-uvtype core-uvtypep core-uvref core-uvsize
    3737          core-car core-cdr core-object-typecode-type
    38           core-istruct-type core-struct-type core-instance-type core-function-type
    3938          core-object-type-key  core-type-string
    4039          copy-from-core core-list
     
    4847          core-instance-class
    4948          core-instance-p
    50           core-string-equal
     49          core-string=
    5150          core-all-processes core-process-name
    5251          core-find-process-for-id
     
    953952(defun core-symbol-pointers ()
    954953  (or (core-info-symbol-ptrs (current-core))
    955       (let ((vector (make-array 1000 :adjustable t :fill-pointer 0))
    956             (keys (core-keyword-package)))
     954      (let ((vector (make-array 1000 :adjustable t :fill-pointer 0)))
    957955        (map-core-areas (lambda (obj)
    958956                          (when (core-symbolp obj)
    959                             (unless (eq (core-symbol-package obj) keys)
    960                               (vector-push-extend obj vector)))))
     957                            (vector-push-extend obj vector))))
    961958        (setf (core-info-symbol-ptrs (current-core)) vector))))
    962959
     
    965962
    966963
    967 (defun core-string-equal (ptr string &aux (len (length string)))
     964(defun core-string= (ptr string &aux (len (length string)))
    968965  (assert (core-uvtypep ptr :simple-string))
    969966  (when (eq (core-uvsize ptr) len)
     
    972969
    973970(defun core-find-package (name &key error)
     971  (when (integerp name)
     972    (when (core-symbolp name)
     973      (setq name (core-q name target::symbol.pname)))
     974    (when (core-uvtypep name :simple-string)
     975      (setq name (copy-from-core name :depth 1))))
    974976  (setq name (string name))
    975977  (or (loop for list-ptr = (core-all-packages-ptr) then (core-cdr list-ptr)
     
    979981                       while (core-consp names-ptr)
    980982                       as name-ptr = (core-car names-ptr)
    981                        thereis (core-string-equal name-ptr name))
     983                       thereis (core-string= name-ptr name))
    982984              do (return pkg-ptr))
    983985      (and error (error "No package named ~s" name))))
     
    991993  (copy-from-core (core-car (core-uvref pkg-ptr pkg.names)) :depth 1))
    992994
    993 (defun core-find-symbol (name &optional (package (symbol-package name)))
    994   ;; Unlike the real cl:find-symbol, this doesn't look for inherited symbols,
     995(defun core-find-symbol (name &optional package)
     996  ;; Unlike cl:find-symbol, this doesn't look for inherited symbols,
    995997  ;; you have to get the package right.
     998  (when (integerp name)
     999    (when (core-symbolp name)
     1000      (when (null package)
     1001        (setq package (core-symbol-package name)))
     1002      (setq name (core-q name target::symbol.pname)))
     1003    (when (core-uvtypep name :simple-string)
     1004      (setq name (copy-from-core name :depth 1))))
     1005  (when (and (null package) (non-nil-symbolp name))
     1006    (setq package (symbol-package name)))
     1007  (when (null package) (error "Package is required"))
    9961008  (let* ((symbol-name (string name))
    9971009         (name-len (length symbol-name))
    998          (pkg-ptr (if (integerp package)
     1010         (pkg-ptr (if (and (integerp package) (core-uvtypep package :package))
    9991011                    package
    10001012                    (core-find-package (if (packagep package)
    10011013                                         (package-name package)
    1002                                          (string package))
     1014                                         package)
    10031015                                       :error t))))
    1004     (assert (core-uvtypep pkg-ptr :package))
    10051016    (multiple-value-bind (primary secondary) (hash-pname symbol-name name-len)
    10061017      (flet ((findsym (htab-ptr)
     
    10121023                       until (eql sym 0)
    10131024                       do (when (and (core-symbolp sym)
    1014                                      (core-string-equal (core-q sym target::symbol.pname) symbol-name))
     1025                                     (core-string= (core-q sym target::symbol.pname) symbol-name))
    10151026                            (return (if (eq sym (nil-relative-symbol-address 'nil))
    10161027                                      (target-nil-value)
Note: See TracChangeset for help on using the changeset viewer.