![[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.