Return to ipxref.icn CVS log

Up to [Research Unix] / researchv10dc / cmd / icon / ipl / source

researchv10 Dan Cross

#	IPXREF
#
#	Create Icon program cross-reference
#
#	Allan J. Anderson
#
#	Last modified 4/29/86 by Ralph E. Griswold
#

global resword, linenum, letters, digits, var, buffer, qflag, f, fflag, xflag
global inmaxcol, inlmarg, inchunk, localvar, lin

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","fail","global","if","initial","link",
         "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 := &lcase ++ &ucase ++ '_'
      digits := '1234567890'
      }
   i := 0
   while p := a[i +:= 1] do
      case p of {
         "-q":  qflag := 1
         "-x":  xflag := 1
         "-w":  inmaxcol := integer(a[i +:= 1])
         "-l":  inlmarg := integer(a[i +:= 1])
         "-c":  inchunk := integer(a[i +:= 1])
         default:  if f := open(p,"r") then fflag := 1
            else stop("usage:  [-q -x -w -l -c] file")
            }
   while word := getword() do
      if word == "link" then {
         buffer := []
         lin := ""
         next
         }
      else 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" | "link" | "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 i, nonwhite
   nonwhite := ~' \t\n'
   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(nonwhite,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 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.