Return to i-xref.icn CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / icon / src / cmd

BSD 4.3

#	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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.