(DEFINE-FILE-INFO §PACKAGE "INTERLISP" §READTABLE "XCL" §BASE 10)

(filecreated "18-Dec-86 19:03:25" {eris}<lispcore>internal>library>whocalls.\;2
 4500   

      |changes| |to:|  (fns distribute.callinfo distribute-call-info-for-symbol)
                       (vars whocallscoms)

      |previous| |date:| " 7-Nov-86 02:47:11" {eris}<lispusers>lispcore>whocalls.\;2)


; Copyright (c) 1986 by Xerox Corporation.  All rights reserved.

(prettycomprint whocallscoms)

(rpaqq whocallscoms
 ((fns whocalls whocalls1 distribute.callinfo distribute-call-info-for-symbol)
                     (prop proptype calledby usedfreeby usedglobalby boundby)))
(defineq

(WHOCALLS

  (LAMBDA (CALLEE USAGE)
    (DECLARE
 (SPECVARS CALLEE USAGE CALLTYPE VAL))
           (* |bvm:| " 1-Oct-86 14:05")

    (PROG ((CALLTYPE (|if|
 (LISTP USAGE)
                         |then|
                              (* \; 

                                                            "some subset of (BOUND USEDFREE GLOBALS)")

                               (SETQ USAGE (|for|
 TYPE |in|
 USAGE
                                              |collect|
 (OR (MISSPELLED? TYPE 70
                                                                   '(BOUND USEDFREE GLOBALS))
                                                            (\\ILLEGAL.ARG TYPE))))
                               'VARAPPLY
                       |else|
 (SELECTQ USAGE
                                  ((USES VAR VARS BOUND USEDFREE GLOBALS) 
                                       (SETQ USAGE 'USES)
                                       'VARAPPLY)
                                  ((BOUND USEDFREE GLOBALS) 
                                       (SETQ USAGE (LIST USAGE))
                                       'VARAPPLY)
                                  ((NIL CALLS) 
                                       'FNAPPLY)
                                  (\\ILLEGAL.ARG USAGE))))
           VAL)
          (MAPATOMS (FUNCTION WHOCALLS1))
          (RETURN VAL))))

(WHOCALLS1

  (LAMBDA (FN)
    (DECLARE
 (USEDFREE CALLEE USAGE CALLTYPE VAL))
           (* |bvm:| " 1-Oct-86 14:05")

                                                             (* |;;| "If FN uses CALLEE in the CALLTYPE manner, add FN to the list VAL.  This is separate fn because of the RETFROM.")

    (COND
       ((CCODEP FN)
        (CALLSCCODE FN CALLTYPE (FUNCTION (LAMBDA (CALLED FLG)
                                            (COND
                                               ((AND (OR (NLISTP USAGE)
                                                         (MEMB FLG USAGE))
                                                     (COND
                                                        ((LISTP CALLEE)
                                                         (MEMB CALLED CALLEE))
                                                        (T (EQ CALLED CALLEE))))
                                                (|printout| T FN ", ")
                                                (|push|
 VAL FN)
                                                (RETFROM 'WHOCALLS1))))))
        (BLOCK)))))

(distribute.callinfo

  (lambda nil
                                               (* \; "Edited 18-Dec-86 19:03 by Pavel")

    (add.process '(mapatoms 'distribute-call-info-for-symbol) 'name 'distribute-call-info)))

(distribute-call-info-for-symbol

  (lambda (x)
                                               (* \; "Edited 18-Dec-86 19:00 by Pavel")

    (block)
    (and (ccodep x)
         (prog ((y (callsccode x)))
               (|for|
 z |in|
 (cadr y) |do|
 (|pushnew|
 (getprop z 'calledby)
                                                  x))
               (|for|
 z |in|
 (caddr y) |do|
 (|pushnew|
 (getprop z 'boundby)
                                                   x))
               (|for|
 z |in|
 (cadddr y) |do|
 (|pushnew|
 (getprop z 'usedfreeby)
                                                    x))
               (|for|
 z |in|
 (car (cddddr y)) |do|
 (|pushnew|
 (getprop z 'usedglobalby)
                                                          x))))))
)

(putprops calledby proptype
 ignore)

(putprops usedfreeby proptype
 ignore)

(putprops usedglobalby proptype
 ignore)

(putprops boundby proptype
 ignore)
(putprops whocalls copyright ("Xerox Corporation" 1986))
(declare\: dontcopy
  (filemap (nil (653 4251 (whocalls 663 . 2057) (whocalls1 2059 . 3191) (distribute.callinfo 3193 . 3419
) (distribute-call-info-for-symbol 3421 . 4249)))))
stop