Changeset 11129


Ignore:
Timestamp:
Oct 17, 2008, 1:07:44 PM (11 years ago)
Author:
gz
Message:

More changes in support of read-recording-source (which is still not used anywhere, but will be)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lib/db-io.lisp

    r11081 r11129  
    114114          (error "Error opening CDB database ~S" pathname)
    115115          (%ptr-to-int handle)))))
    116  
    117  
     116
    118117  ;;; Read N octets from FID into BUF.  Return #of octets read or error.
    119118  (defun fid-read (fid buf n)
     
    876875   (declare (ignore char arg))
    877876   (let* ((package (find-package (ftd-interface-package-name *target-ftd*))))
    878      (multiple-value-bind (sym query)
     877     (multiple-value-bind (sym source query)
    879878         (%read-symbol-preserving-case
    880879          stream
     
    882881       (unless *read-suppress*
    883882         (let* ((fv (%load-var sym query)))
    884            (if query
    885              fv
    886              (%foreign-access-form `(%reference-external-entry-point (load-time-value ,fv))
    887                                    (fv.type fv)
    888                                    0
    889                                    nil))))))))
     883           (values (if query
     884                     fv
     885                     (%foreign-access-form `(%reference-external-entry-point (load-time-value ,fv))
     886                                           (fv.type fv)
     887                                           0
     888                                           nil))
     889                   source)))))))
    890890
    891891
     
    10201020         (query nil)
    10211021         (error nil)
    1022          (sym nil))
     1022         (sym nil)
     1023         (source nil))
    10231024    (let* ((*package* package))
    10241025      (unwind-protect
     
    10281029               (setq query t)
    10291030               (read-char stream))
    1030              (multiple-value-setq (sym error)
    1031                (handler-case (read stream nil nil)
    1032                  (error (condition) (values nil condition)))))
     1031             (multiple-value-setq (sym source error)
     1032               (handler-case (read-internal stream nil nil nil)
     1033                 (error (condition) (values nil nil condition)))))
    10331034        (setf (readtable-case *readtable*) case)))
    10341035    (when error
    10351036      (error error))
    1036     (values sym query)))
     1037    (values sym source query)))
    10371038
    10381039(set-dispatch-macro-character
     
    10411042   (declare (ignore char))
    10421043   (let* ((package (find-package (ftd-interface-package-name *target-ftd*))))
    1043      (multiple-value-bind (sym query)
     1044     (multiple-value-bind (sym source query)
    10441045         (%read-symbol-preserving-case
    10451046            stream
     
    10491050           (symbol
    10501051            (if query
    1051               (load-os-constant sym query)
     1052              (values (load-os-constant sym query) source)
    10521053              (progn
    10531054                (when (eq (symbol-package sym) package)
     
    10601061                       (load-os-constant sym)))
    10611062                    (1 (makunbound sym) (load-os-constant sym))))
    1062                 sym)))
     1063                (values sym source))))
    10631064           (string
    10641065            (let* ((val 0)
    10651066                   (len (length sym)))
    1066               (dotimes (i 4 val)
     1067              (dotimes (i 4 (values val source))
    10671068                (let* ((ch (if (< i len) (char sym i) #\space)))
    10681069                  (setq val (logior (ash val 8) (char-code ch)))))))))))))
     
    10721073    (declare (ignore char))
    10731074    (unless arg (setq arg 0))
    1074     (multiple-value-bind (sym query)
     1075    (multiple-value-bind (sym source query)
    10751076        (%read-symbol-preserving-case
    10761077                 stream
     
    10791080        (unless (and sym (symbolp sym)) (report-bad-arg sym 'symbol))
    10801081        (if query
    1081           (load-external-function sym t)
     1082          (values (load-external-function sym t) source)
    10821083          (let* ((def (if (eql arg 0)
    10831084                        (gethash sym (ftd-external-function-definitions
    10841085                                      *target-ftd*)))))
    1085             (if (and def (eq (macro-function sym) #'%external-call-expander))
    1086               sym
    1087               (load-external-function sym nil))))))))
     1086            (values (if (and def (eq (macro-function sym) #'%external-call-expander))
     1087                      sym
     1088                      (load-external-function sym nil))
     1089                    source)))))))
    10881090
    10891091(set-dispatch-macro-character
Note: See TracChangeset for help on using the changeset viewer.