Ignore:
Timestamp:
Jul 26, 2009, 1:24:19 PM (10 years ago)
Author:
gz
Message:

Some changes in support of Slime:

Implement CCL:COMPUTE-APPLICABLE-METHODS-USING-CLASSES

Add a :stream-args argument to CCL:ACCEPT-CONNECTION, for one-time initargs for the stream being created. E.g. (accept-connection listener :stream-args `(:external-format ,external-format-for-this-connection-only))

Add CCL:TEMP-PATHNAME

Bind new var CCL:*TOP-ERROR-FRAME* to the error frame in break loops, to make it available to debugger/break hooks.

Add CCL:*SELECT-INTERACTIVE-PROCESS-HOOK* and call it to select the process to use for handling SIGINT.

Add CCL:*MERGE-COMPILER-WARNINGS* to control whether warnings with the same format string and args but different source locations should be merged.

Export CCL:COMPILER-WARNING, CCL:STYLE-WARNING, CCL:COMPILER-WARNING-FUNCTION-NAME and CCL:COMPILER-WARNING-SOURCE-NOTE.

Create a CCL:COMPILER-WARNING-SOURCE-NOTE even if not otherwise saving source locations, just using the fasl file and toplevel stream position, but taking into account compile-file-original-truename and compiler-file-original-buffer-offset. Get rid of stream-position and file-name slots in compiler warnings.

Export CCL:REPORT-COMPILER-WARNING, and make it accept a :SHORT keyword arg to skip the textual representation of the warning location.

Export CCL:NAME-OF, and make it return the fully qualified name for methods, return object for eql-specializer

Make CCL:FIND-DEFINITION-SOURCES handle xref-entries.

Export CCL:SETF-FUNCTION-SPEC-NAME, make it explicitly ignore the long-form setf method case.

Export the basic inspector API from the inspector package.

Export EQL-SPECIALIZER and SLOT-DEFINITION-DOCUMENTATION from OPENMCL-MOP

Refactor things a bit in backtrace code, define and export an API for examining backtraces:

CCL:MAP-CALL-FRAMES
CCL:FRAME-FUNCTION
CCL:FRAME-SUPPLIED-ARGUMENTS
CCL:FRAME-NAMED-VARIABLES

other misc new exports:

CCL:DEFINITION-TYPE
CCL;CALLER-FUNCTIONS
CCL:SLOT-DEFINITION-DOCUMENTATION
CCL:*SAVE-ARGLIST-INFO*
CCL:NATIVE-TRANSLATED-NAMESTRING
CCL:NATIVE-TO-PATHNAME
CCL:HASH-TABLE-WEAK-P
CCL;PROCESS-SERIAL-NUMBER
CCL:PROCESS-EXHAUSTED-P
CCL:APPLY-IN-FRAME

Other misc tweaks:

Make cbreak-loop use the break message when given a uselessly empty condition.

Use setf-function-name-p more consistently

Make find-applicable-methods handle eql specializers better.

Try to more consistently recognize lists of the form (:method ...) as method names.

Add xref-entry-full-name (which wasn't needed in the end)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lib/backtrace-lds.lisp

    r10114 r12463  
    3131  #+ppc-target #(save7 save6 save5 save4 save3 save2 save1 save0))
    3232
     33(defun frame-function (frame context)
     34  "Returns the function using the frame, and pc offset within the function, if known"
     35  (declare (ignore context))
     36  (cfp-lfun (require-type frame 'integer)))
     37
     38(defun frame-supplied-arguments (frame context &key (unknown-marker (%unbound-marker)))
     39  "Return a list of supplied arguments to the call which opened this frame, as best we can reconstruct it"
     40  (multiple-value-bind (lfun pc) (cfp-lfun frame)
     41    (multiple-value-bind (args valid) (supplied-argument-list context frame lfun pc)
     42      (if (not valid)
     43        unknown-marker
     44        (if (eq unknown-marker (%unbound-marker))
     45          args
     46          (substitute unknown-marker (%unbound-marker) args))))))
     47
     48(defun frame-named-variables (frame context &key (unknown-marker (%unbound-marker)))
     49  "Returns an alist of (NAME . VALUE) of all named variables in this frame."
     50  (multiple-value-bind (lfun pc) (cfp-lfun frame)
     51    (multiple-value-bind (args locals) (arguments-and-locals context frame lfun pc unknown-marker)
     52      (if (eq unknown-marker (%unbound-marker))
     53        (append args locals)
     54        (substitute unknown-marker (%unbound-marker) (append args locals))))))
     55
     56
     57(defun frame-arguments-and-locals (frame context &key unknown-marker)
     58  "Return two values, the arguments and the locals, known for this frame, as alists of (name . value)"
     59  (multiple-value-bind (lfun pc) (cfp-lfun frame)
     60    (arguments-and-locals context frame lfun pc unknown-marker)))
    3361
    3462;;; Returns three values: (ARG-VALUES TYPES NAMES), solely for the benefit
     
    3967;;;   cares about whether this is equal to "keyword" or not.
    4068;;; NAMES is a list of symbols which name the args.
     69;; 7/13/2009: This is now deprecated.  Use frame-supplied-arguments.
    4170(defun frame-supplied-args (frame lfun pc child context)
    4271  (declare (ignore child))
     
    4574    (if (<= pc target::arg-check-trap-pc-limit)
    4675      (values (arg-check-call-arguments frame lfun) nil nil)
    47       (let* ((arglist (arglist-from-map lfun))
    48              (args (arguments-and-locals context frame lfun pc))
    49              (state :required))
    50         (collect ((arg-values)
    51                   (types)
    52                   (names))
    53           (dolist (arg arglist)
    54             (if (or (member arg lambda-list-keywords)
    55                     (eq arg '&lexpr))
    56               (setq state arg)
    57               (let* ((pair (pop args)))
    58                 (case state
    59                   (&lexpr
    60                    (with-list-from-lexpr (rest (cdr pair))
    61                      (dolist (r rest) (arg-values r) (names nil) (types nil)))
    62                    (return))
    63                   (&rest
    64                    (dolist (r (cdr pair)) (arg-values r) (names nil) (types nil))
    65                    (return))
    66                   (&key
    67                    (arg-values arg)
    68                    (names nil)
    69                    (types nil)))
    70                 (let* ((value (cdr pair)))
    71                   (if (eq value (%unbound-marker))
    72                     (return))
    73                   (names (car pair))
    74                   (arg-values value)
    75                   (types nil)))))
    76           (values (arg-values) (types) (names)))))))
     76      (multiple-value-bind (arglist valid) (arglist-from-map lfun)
     77        (if (not valid)
     78          (values nil nil nil)
     79          (let* ((args (arguments-and-locals context frame lfun pc))
     80                 (state :required))
     81            (collect ((arg-values)
     82                      (types)
     83                      (names))
     84              (dolist (arg arglist)
     85                (if (or (member arg lambda-list-keywords)
     86                        (eq arg '&lexpr))
     87                  (setq state arg)
     88                  (let* ((pair (pop args)))
     89                    (case state
     90                      (&lexpr
     91                         (with-list-from-lexpr (rest (cdr pair))
     92                           (dolist (r rest) (arg-values r) (names nil) (types nil)))
     93                         (return))
     94                      (&rest
     95                         (dolist (r (cdr pair)) (arg-values r) (names nil) (types nil))
     96                         (return))
     97                      (&key
     98                         (arg-values arg)
     99                         (names nil)
     100                         (types nil)))
     101                    (let* ((value (cdr pair)))
     102                      (if (eq value (%unbound-marker))
     103                        (return))
     104                      (names (car pair))
     105                      (arg-values value)
     106                      (types nil)))))
     107              (values (arg-values) (types) (names)))))))))
    77108
    78109
Note: See TracChangeset for help on using the changeset viewer.