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