![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to lxref.l CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 41BSD / cmd / liszt|
Return to lxref.l CVS log | Up to [CSRG BSD Unix] / 41BSD / cmd / liszt |
1.1 ! root 1: ;------ lxref: lisp cross reference program ! 2: ;-- author: j foderaro ! 3: ; This program generates a cross reference listing of a set of one or ! 4: ; more lisp files. It reads the output of cross reference files ! 5: ; generated by the compiler. These files usually have the extension .x . ! 6: ; the .x files are lisp readable. There format is: ! 7: ; The first s-expression is (File <filename>) where <filename> is the ! 8: ; name of the lisp source file. ! 9: ; Then there is one s-expression for each function (including macros) ! 10: ; which is defined in the file. The car of each expression is the function ! 11: ; name, the cadr is the function type and the cddr is a list of those ! 12: ; functions called ! 13: ; ! 14: ; lxref can be run from the command level ! 15: ; % lxref foo.x bar.x ! 16: ; or in this way ! 17: ; % lxref ! 18: ; -> (lxref foo.x bar.x) ! 19: ; ! 20: ; There is one option, that is changing the ignorelevel. If a function ! 21: ; is called by more than ignorelevel functions then all those functions ! 22: ; are listed, instead a summary of the number of calls is printed. This ! 23: ; is useful for preventing the printing of massive lists for common ! 24: ; system functions such as setq. ! 25: ; To change the ignorelevel to 40 you would type: ! 26: ; ! 27: ; % lxref -40 foo.x bar.x ! 28: ; ! 29: ! 30: ! 31: ; load in the macro package ! 32: (eval-when (eval compile) ! 33: (cond ((null (get 'jkfmacs 'version)) (load 'jkfmacs)))) ! 34: ! 35: (defmacro Push (atm val) ! 36: `(setq ,atm (cons ,val ,atm))) ! 37: ! 38: ! 39: ! 40: ; insure we have plenty of space to grow into ! 41: (opval 'pagelimit 9999) ! 42: ! 43: ! 44: (declare (special width ignorefuncs)) ! 45: (setq ignorelevel 50) ! 46: ! 47: (def xrefinit ! 48: (lambda nil ! 49: (setq readtable (makereadtable t)) ! 50: (cond ((greaterp (argv -1) 1) ; build up list of args ! 51: (do ((i (1- (argv -1)) (1- i)) (arglis)) ! 52: ((lessp i 1) ! 53: (setq user-top-level nil) ! 54: (exit (apply 'lxref arglis))) ! 55: (setq arglis (cons (argv i) arglis)))) ! 56: (t (patom "Lxref - lisp cross reference program") ! 57: (terpr poport) ! 58: (setq user-top-level nil))))) ! 59: ! 60: (setq user-top-level 'xrefinit) ! 61: ! 62: (defun lxref fexpr (files) ! 63: (prog (p funcs i-seen i-home i-type i-callers filenm caller callee name ! 64: home type caller tmp fname) ! 65: (setq i-seen (gensym) i-home (gensym) i-type (gensym) i-callers (gensym)) ! 66: ! 67: ; check for the only option permitted, that of changing the ignorelevel ! 68: ; ! 69: (If (and files (eq '- (car (setq tmp (explode (car files)))))) ! 70: then (If (not (fixp (setq ignorelevel (readlist (cdr tmp))))) ! 71: then (patom "bad ignorelevel count") ! 72: (exit 1)) ! 73: (setq files (cdr files))) ! 74: (do ((ii files (cdr ii))) ! 75: ((null ii)) ! 76: ; open up xref file ! 77: (setq fname (nreverse (explodec (car ii)))) ! 78: (If (and (eq 'l (car fname) (eq '|.| (cadr fname)))) ! 79: then (setq fname (implode (nreverse (cons 'x ! 80: (cons '|.| ! 81: (cddr fname)))))) ! 82: else (setq fname (car ii))) ! 83: (If (and (not (portp (setq p (car (errset (infile fname) nil))))) ! 84: (not (portp (setq p (car (errset (infile (concat fname ".x")))))))) ! 85: then (patom "Couldn't open ") ! 86: (patom (car ii)) ! 87: (terpr) ! 88: (go bottom)) ! 89: ! 90: ; first record should be (File filename) ! 91: (setq filenm (car (errset (read p)))) ! 92: ! 93: (If (and (dtpr filenm) (eq 'File (car filenm))) ! 94: then (setq filenm (cadr filenm)) ! 95: else (patom "File ") ! 96: (patom (car ii)) ! 97: (patom " is not a xref file") ! 98: (terpr) ! 99: (close p) ! 100: (go bottom)) ! 101: ! 102: ;(patom "Processing ") (patom (car ii)) (terpr) (drain) ! 103: ! 104: ; for each function in the file ! 105: (do ((jj (read p) (read p))) ! 106: ((null jj) (close p)) ! 107: (setq caller (car jj)) ! 108: (If (not (get caller i-seen)) ! 109: then (putprop caller t i-seen) ! 110: (Push funcs caller)) ; add to global list ! 111: ; remember home of this function (and allow multiple homes) ! 112: (putprop caller (cons filenm (get caller i-home)) i-home) ! 113: ! 114: ; remember type of this function (and allow multiple types) ! 115: (putprop caller (cons (cadr jj) (get caller i-type)) i-type) ! 116: ! 117: ; for each function the caller calls ! 118: (do ((kk (cddr jj) (cdr kk))) ! 119: ((null kk)) ! 120: (setq callee (car kk)) ! 121: (If (not (get callee i-seen)) then (putprop callee t i-seen) ! 122: (Push funcs callee)) ! 123: (putprop callee ! 124: (cons (cons caller filenm) ! 125: (get callee i-callers)) ! 126: i-callers))) ! 127: bottom ) ! 128: ! 129: ; sort alphabetically ! 130: ; (patom "There are ") (print (length funcs)) (patom " functions ") ! 131: ; (terpr) ! 132: (setq funcs (sort funcs 'alphalessp)) ! 133: ;(patom "To sort required ") (print sort-compares) (patom "comparisons") ! 134: ; (terpr) ! 135: ! 136: ; now print out the cross reference ! 137: (do ((ii funcs (cdr ii))) ! 138: ((null ii)) ! 139: (setq name (car ii) ! 140: home (get name i-home) ! 141: type (get name i-type) ! 142: callers (get name i-callers)) ! 143: ! 144: (If (lessp (setq clength (length callers)) ignorelevel) ! 145: then (setq callers (sortcar callers 'alphalessp))) ! 146: (If (null home) ! 147: then (setq home (If (getd name) ! 148: then (setq type (ncons (typeit (getd name)))) ! 149: '(Franz-initial) ! 150: else '(Undefined)))) ! 151: ! 152: (patom name) ! 153: (patom " ") ! 154: (If (null (cdr type)) ! 155: then (patom (car type)) ! 156: (patom " ") ! 157: (patom (car home)) ! 158: else (patom "Mult def: ") ! 159: (mapcar '(lambda (typ hom) ! 160: (patom typ) ! 161: (patom " in ") ! 162: (patom hom) ! 163: (patom ", ")) ! 164: type ! 165: home)) ! 166: ! 167: ! 168: (terpr) ! 169: (patom " ") ! 170: (cond ((null callers) ! 171: (patom "*** Unreferenced ***")) ! 172: ((not (lessp clength ignorelevel)) ! 173: (patom "Called by ") ! 174: (print clength) ! 175: (patom " functions")) ! 176: (t (do ((jj callers (cdr jj)) ! 177: (calle) ! 178: (width 8)) ! 179: ((null jj)) ! 180: ; only print name if in same file ! 181: (setq calle (caar jj)) ! 182: (cond ((memq (cdar jj) home) ! 183: (terprchk (+ (flatc calle) 2)) ! 184: (patom calle)) ! 185: (t (terprchk (+ (flatc calle) 6 (flatc (cdar jj)))) ! 186: (patom calle) ! 187: (patom " in ") ! 188: (patom (cdar jj)))) ! 189: (If (cdr jj) then (patom ", "))))) ! 190: (terpr) ! 191: (terpr) ! 192: botloop ) ! 193: (return 0))) ! 194: ! 195: ! 196: (defun terprchk (wid) ! 197: (cond ((> (setq width (+ wid width)) 80.) ! 198: (terpr) ! 199: (patom " ") ! 200: (setq width (+ 8 wid))))) ! 201: ! 202: ; determine type of function ! 203: (defun typeit (fcn) ! 204: (cond ((bcdp fcn) (getdisc fcn)) ! 205: ((dtpr fcn) (car fcn)))) ! 206: ! 207: ! 208: ; set up read table to be the same as when liszt wrote the file ! 209: (setq readtable (makereadtable t)) ; readtable same as original
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.