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

(FILECREATED "18-Feb-2026 16:08:45" |{WMEDLEY}<lispusers>WHOCALLS.;2| 4272   

      :EDIT-BY |rmk|

      :PREVIOUS-DATE "18-Dec-86 19:03:25" |{WMEDLEY}<lispusers>WHOCALLS.;1|)


(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)
(DECLARE\: DONTCOPY
  (FILEMAP (NIL (466 4064 (WHOCALLS 476 . 1870) (WHOCALLS1 1872 . 3004) (DISTRIBUTE.CALLINFO 3006 . 3232
) (DISTRIBUTE-CALL-INFO-FOR-SYMBOL 3234 . 4062)))))
STOP
