home *** CD-ROM | disk | FTP | other *** search
- # I-XREF(1)
- #
- # Icon program cross-reference
- #
- # Allan J. Anderson
- #
- # Last modified 7/10/83
- #
-
- global resword, linenum, letters, digits, var, buffer, qflag, f, fflag, xflag
- global inmaxcol, inlmarg, inchunk, localvar
-
- record procrec(pname,begline,lastline)
-
- procedure main(a)
- local word, w2, p, prec, i, L, ln
- initial {
- resword := ["break","by","case","default","do","dynamic","else",
- "end","every","external","fail","global","if",
- "initial","local","next","not","of","procedure",
- "record","repeat","return","static","suspend","then",
- "to","until","while"]
- linenum := 0
- var := table() # var[variable[proc]] is list of line numbers
- prec := [] # list of procedure records
- localvar := [] # list of local variables of current routine
- buffer := [] # a put-back buffer for getword
- proc := "global"
- letters := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz' ++ '_'
- digits := '1234567890'
- }
- # &trace := -1
- every p := a[i := 1 to *a] do
- if p == ("-q" | "-Q") then
- qflag := 1
- else if p == ("-x" | "-X") then
- xflag := 1
- else if p == ("-w" | "-W") then
- inmaxcol := integer(a[i + 1])
- else if p == ("-l" | "-L") then
- inlmarg := integer(a[i + 1])
- else if p == ("-c" | "-C") then
- inchunk := integer(a[i + 1])
- else if f := open(p,"r") then
- fflag := 1
- while word := getword() do
- if word == "procedure" then {
- put(prec,procrec("",linenum,0))
- proc := getword() | break
- p := pull(prec)
- p.pname := proc
- put(prec,p)
- }
- else if word == ("global" | "external" | "record") then {
- word := getword() | break
- addword(word,"global",linenum)
- while (w2 := getword()) == "," do {
- if Find(word,resword) then break
- word := getword() | break
- addword(word,"global",linenum)
- }
- put(buffer,w2)
- }
- else if word == ("local" | "dynamic" | "static") then {
- word := getword() | break
- put(localvar,word)
- addword(word,proc,linenum)
- while (w2 := getword()) == "," do {
- if Find(word,resword) then break
- word := getword() | break
- put(localvar,word)
- addword(word,proc,linenum)
- }
- put(buffer,w2)
- }
- else if word == "end" then {
- proc := "global"
- localvar := []
- p := pull(prec)
- p.lastline := linenum
- put(prec,p)
- }
- else if Find(word,resword) then
- next
- else {
- ln := linenum
- if (w2 := getword()) == "(" then
- word ||:= " *" # special mark for procedures
- else
- put(buffer,w2) # put back w2
- addword(word,proc,ln)
- }
- every write(!format(var))
- write("\n\nprocedures:\tlines:\n")
- L := []
- every p := !prec do
- put(L,left(p.pname,16," ") || p.begline || "-" || p.lastline)
- every write(!(sort(L)))
- end
-
- procedure addword(word,proc,lineno)
- if any(letters,word) | \xflag then {
- /var[word] := table()
- if /var[word]["global"] | Find(word,\localvar) then {
- /(var[word])[proc] := [word,proc]
- put((var[word])[proc],lineno)
- }
- else {
- /var[word]["global"] := [word,"global"]
- put((var[word])["global"],lineno)
- }
- }
- end
-
- procedure getword()
- local j, c
- static lin, i
- repeat {
- if *buffer > 0 then return get(buffer)
- if /lin | i = *lin + 1 then
- if lin := myread() then {
- i := 1
- linenum +:= 1
- }
- else fail
- if i := upto(~(' ' ++ '\t' ++ '\n'),lin,i) then { # skip white space
- j := i
- if lin[i] == ("'" | '"') then { # don't xref quoted words
- if /qflag then {
- c := lin[i]
- i +:= 1
- repeat
- if i := upto(c ++ '\\',lin,i) + 1 then
- if lin[i - 1] == c then break
- else i +:= 1
- else {
- i := 1
- linenum +:= 1
- lin := myread() | fail
- }
- }
- else i +:= 1
- }
- else if lin[i] == "#" then { # don't xref comments; get next line
- i := *lin + 1
- }
- else if i := many(letters ++ digits,lin,i) then
- return lin[j:i]
- else {
- i +:= 1
- return lin[i - 1]
- }
- }
- else
- i := *lin + 1
- } # repeat
- end
-
- procedure format(T)
- local V, block, n, L, lin, maxcol, lmargin, chunk, col
- initial {
- maxcol := \inmaxcol | 80
- lmargin := \inlmarg | 40
- chunk := \inchunk | 4
- }
- L := []
- col := lmargin
- every V := !T do
- every block := !V do {
- lin := left(block[1],16," ") || left(block[2],lmargin - 16," ")
- every lin ||:= center(block[3 to *block],chunk," ") do {
- col +:= chunk
- if col >= maxcol - chunk then {
- lin ||:= "\n\t\t\t\t\t"
- col := lmargin
- }
- }
- if col = lmargin then lin := lin[1:-6] # came out exactly even
- put(L,lin)
- col := lmargin
- }
- L := sort(L)
- push(L,"variable\tprocedure\t\tline numbers\n")
- return L
- end
-
- procedure Find(w,L)
- every if w == L[1 to *L] then return
- end
-
- procedure myread()
- if \fflag then return read(f) else return read()
- end
-
-