4.3BSD/usr/contrib/icon/src/cmd/i-xref.icn

#	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