|
|
1.1 root 1: # I-XREF(1)
2: #
3: # Icon program cross-reference
4: #
5: # Allan J. Anderson
6: #
7: # Last modified 7/10/83
8: #
9:
10: global resword, linenum, letters, digits, var, buffer, qflag, f, fflag, xflag
11: global inmaxcol, inlmarg, inchunk, localvar
12:
13: record procrec(pname,begline,lastline)
14:
15: procedure main(a)
16: local word, w2, p, prec, i, L, ln
17: initial {
18: resword := ["break","by","case","default","do","dynamic","else",
19: "end","every","external","fail","global","if",
20: "initial","local","next","not","of","procedure",
21: "record","repeat","return","static","suspend","then",
22: "to","until","while"]
23: linenum := 0
24: var := table() # var[variable[proc]] is list of line numbers
25: prec := [] # list of procedure records
26: localvar := [] # list of local variables of current routine
27: buffer := [] # a put-back buffer for getword
28: proc := "global"
29: letters := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz' ++ '_'
30: digits := '1234567890'
31: }
32: # &trace := -1
33: every p := a[i := 1 to *a] do
34: if p == ("-q" | "-Q") then
35: qflag := 1
36: else if p == ("-x" | "-X") then
37: xflag := 1
38: else if p == ("-w" | "-W") then
39: inmaxcol := integer(a[i + 1])
40: else if p == ("-l" | "-L") then
41: inlmarg := integer(a[i + 1])
42: else if p == ("-c" | "-C") then
43: inchunk := integer(a[i + 1])
44: else if f := open(p,"r") then
45: fflag := 1
46: while word := getword() do
47: if word == "procedure" then {
48: put(prec,procrec("",linenum,0))
49: proc := getword() | break
50: p := pull(prec)
51: p.pname := proc
52: put(prec,p)
53: }
54: else if word == ("global" | "external" | "record") then {
55: word := getword() | break
56: addword(word,"global",linenum)
57: while (w2 := getword()) == "," do {
58: if Find(word,resword) then break
59: word := getword() | break
60: addword(word,"global",linenum)
61: }
62: put(buffer,w2)
63: }
64: else if word == ("local" | "dynamic" | "static") then {
65: word := getword() | break
66: put(localvar,word)
67: addword(word,proc,linenum)
68: while (w2 := getword()) == "," do {
69: if Find(word,resword) then break
70: word := getword() | break
71: put(localvar,word)
72: addword(word,proc,linenum)
73: }
74: put(buffer,w2)
75: }
76: else if word == "end" then {
77: proc := "global"
78: localvar := []
79: p := pull(prec)
80: p.lastline := linenum
81: put(prec,p)
82: }
83: else if Find(word,resword) then
84: next
85: else {
86: ln := linenum
87: if (w2 := getword()) == "(" then
88: word ||:= " *" # special mark for procedures
89: else
90: put(buffer,w2) # put back w2
91: addword(word,proc,ln)
92: }
93: every write(!format(var))
94: write("\n\nprocedures:\tlines:\n")
95: L := []
96: every p := !prec do
97: put(L,left(p.pname,16," ") || p.begline || "-" || p.lastline)
98: every write(!(sort(L)))
99: end
100:
101: procedure addword(word,proc,lineno)
102: if any(letters,word) | \xflag then {
103: /var[word] := table()
104: if /var[word]["global"] | Find(word,\localvar) then {
105: /(var[word])[proc] := [word,proc]
106: put((var[word])[proc],lineno)
107: }
108: else {
109: /var[word]["global"] := [word,"global"]
110: put((var[word])["global"],lineno)
111: }
112: }
113: end
114:
115: procedure getword()
116: local j, c
117: static lin, i
118: repeat {
119: if *buffer > 0 then return get(buffer)
120: if /lin | i = *lin + 1 then
121: if lin := myread() then {
122: i := 1
123: linenum +:= 1
124: }
125: else fail
126: if i := upto(~(' ' ++ '\t' ++ '\n'),lin,i) then { # skip white space
127: j := i
128: if lin[i] == ("'" | '"') then { # don't xref quoted words
129: if /qflag then {
130: c := lin[i]
131: i +:= 1
132: repeat
133: if i := upto(c ++ '\\',lin,i) + 1 then
134: if lin[i - 1] == c then break
135: else i +:= 1
136: else {
137: i := 1
138: linenum +:= 1
139: lin := myread() | fail
140: }
141: }
142: else i +:= 1
143: }
144: else if lin[i] == "#" then { # don't xref comments; get next line
145: i := *lin + 1
146: }
147: else if i := many(letters ++ digits,lin,i) then
148: return lin[j:i]
149: else {
150: i +:= 1
151: return lin[i - 1]
152: }
153: }
154: else
155: i := *lin + 1
156: } # repeat
157: end
158:
159: procedure format(T)
160: local V, block, n, L, lin, maxcol, lmargin, chunk, col
161: initial {
162: maxcol := \inmaxcol | 80
163: lmargin := \inlmarg | 40
164: chunk := \inchunk | 4
165: }
166: L := []
167: col := lmargin
168: every V := !T do
169: every block := !V do {
170: lin := left(block[1],16," ") || left(block[2],lmargin - 16," ")
171: every lin ||:= center(block[3 to *block],chunk," ") do {
172: col +:= chunk
173: if col >= maxcol - chunk then {
174: lin ||:= "\n\t\t\t\t\t"
175: col := lmargin
176: }
177: }
178: if col = lmargin then lin := lin[1:-6] # came out exactly even
179: put(L,lin)
180: col := lmargin
181: }
182: L := sort(L)
183: push(L,"variable\tprocedure\t\tline numbers\n")
184: return L
185: end
186:
187: procedure Find(w,L)
188: every if w == L[1 to *L] then return
189: end
190:
191: procedure myread()
192: if \fflag then return read(f) else return read()
193: end
194:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.