(FILECREATED " 8-Feb-86 15:29:27" {ERINYES}<HERRING>COMPILER>FRAMENAMECHECK.;2 5476   

      changes to:  (FNS FRAMENAMECHECK)

      previous date: " 8-Feb-86 11:23:18" {ERINYES}<HERRING>COMPILER>FRAMENAMECHECK.;1)


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

(PRETTYCOMPRINT FRAMENAMECHECKCOMS)

(RPAQQ FRAMENAMECHECKCOMS ((COMS (* * for looking for framenames -- specifically for looking for what 
                                    framenames occur in those CCODEPs whose framename is not the 
                                    function name in the usual sense)
                                 (* FRAMENAMECHECK scans all atoms, building a list of framenames 
                                    that occur in function definition headers of CCODEPs that occur 
                                    in the function definition cell of an atom with a different name 
                                    -- it then prints the list to T -- for each such framename, the 
                                    list contains an entry <framename list-of-oks list-of-others> -- 
                                    list-of-oks and list-of-others are each a list of atoms, the 
                                    atoms in which the CCODEP was found -- list-of-oks lists 
                                    functions that are "safe" to smash, list-of-others lists the rest
                                    )
                                 (FNS FRAMENAMECHECK FRAMENAMECHECK.NOTICE FRAMENAMECHECK.REPORT))))
(* * for looking for framenames -- specifically for looking for what framenames occur in those 
CCODEPs whose framename is not the function name in the usual sense)




(* FRAMENAMECHECK scans all atoms, building a list of framenames that occur in function 
definition headers of CCODEPs that occur in the function definition cell of an atom with a 
different name -- it then prints the list to T -- for each such framename, the list contains an
 entry <framename list-of-oks list-of-others> -- list-of-oks and list-of-others are each a list
 of atoms, the atoms in which the CCODEP was found -- list-of-oks lists functions that are 
"safe" to smash, list-of-others lists the rest)

(DEFINEQ

(FRAMENAMECHECK
  [LAMBDA NIL                                                              (* jmh 
                                                                           " 8-Feb-86 15:28")
    (LET (FNC.LIST)
         (DECLARE (SPECVARS FNC.LIST))
         [MAPATOMS (FUNCTION (LAMBDA (THEATOM)
                               (LET ((THEDEF (GETD THEATOM))
                                     FRAMENAME)
                                    (if (CCODEP THEDEF)
                                        then (SETQ FRAMENAME (fetch (CODEARRAY FRAMENAME)
                                                                of THEDEF))
                                             (if (NEQ FRAMENAME THEATOM)
                                                 then (FRAMENAMECHECK.NOTICE FRAMENAME THEATOM
                                                             (DDALL.OK THEATOM NIL T]
         (FRAMENAMECHECK.REPORT])

(FRAMENAMECHECK.NOTICE
  [LAMBDA (FRAMENAME THEATOM OK?)                                          (* jmh 
                                                                           " 8-Feb-86 11:09")
            
            (* * add THEATOM to one of the two lists under FRAMENAME in FNC.LIST)

    (DECLARE (USEDFREE FNC.LIST))
    (LET ((THEENTRY (ASSOC FRAMENAME FNC.LIST)))
         (if (NULL THEENTRY)
             then (SETQ THEENTRY (LIST FRAMENAME NIL NIL))
                  (if (NULL FNC.LIST)
                      then (SETQ FNC.LIST (LIST THEENTRY))
                    else (push FNC.LIST THEENTRY)))
         (LET [(ABOVETHESUBLIST (if OK?
                                    then (CDR THEENTRY)
                                  else (CDDR THEENTRY]
              (if (NULL (CAR ABOVETHESUBLIST))
                  then (RPLACA ABOVETHESUBLIST (LIST THEATOM))
                else (push (CAR ABOVETHESUBLIST)
                           THEATOM])

(FRAMENAMECHECK.REPORT
  [LAMBDA NIL                                                              (* jmh 
                                                                           " 8-Feb-86 11:01")
    (DECLARE (USEDFREE FNC.LIST))
    (LET ((THEFILE T))
         (printout THEFILE (LENGTH FNC.LIST)
                " special framenames in ccodeps in "
                [for X in FNC.LIST sum (IPLUS (LENGTH (CADR X))
                                              (LENGTH (CADDR X]
                " atoms' fndef dells --" T)
         (for X in (SORT FNC.LIST) do (printout THEFILE T (CAR X)
                                             (IPLUS (LENGTH (CADR X))
                                                    (LENGTH (CADDR X)))
                                             " --" T)
                                      (printout THEFILE 5 (LENGTH (CADR X))
                                             "'ok' fns: "
                                             (SORT (CADR X))
                                             T)
                                      (printout THEFILE 5 (LENGTH (CADDR X))
                                             "'other' fns: "
                                             (SORT (CADDR X))
                                             T])
)
(PUTPROPS FRAMENAMECHECK COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2216 5391 (FRAMENAMECHECK 2226 . 3143) (FRAMENAMECHECK.NOTICE 3145 . 4107) (
FRAMENAMECHECK.REPORT 4109 . 5389)))))
STOP