home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / tests / bench / ipxref.dat < prev    next >
Text File  |  2000-07-29  |  7KB  |  240 lines
  1. ############################################################################
  2. #
  3. #    Name:    ipxref.icn
  4. #
  5. #    Title:    Produce cross reference for Icon program
  6. #
  7. #    Author:    Allan J. Anderson
  8. #
  9. #    Date:    June 10, 1988
  10. #
  11. ############################################################################
  12. #  
  13. #     This program cross-references Icon programs. It lists the
  14. #  occurrences of each variable by line number. Variables are listed
  15. #  by procedure or separately as globals.  The options specify the
  16. #  formatting of the output and whether or not to cross-reference
  17. #  quoted strings and non-alphanumerics. Variables that are followed
  18. #  by a left parenthesis are listed with an asterisk following the
  19. #  name.  If a file is not specified, then standard input is cross-
  20. #  referenced.
  21. #  
  22. #  Options: The following options change the format defaults:
  23. #  
  24. #       -c n The column width per line number. The default is 4
  25. #            columns wide.
  26. #  
  27. #       -l n The starting column (i.e. left margin) of the line
  28. #            numbers.  The default is column 40.
  29. #  
  30. #       -w n The column width of the whole output line. The default
  31. #            is 80 columns wide.
  32. #  
  33. #     Normally only alphanumerics are cross-referenced. These
  34. #  options expand what is considered:
  35. #  
  36. #       -q   Include quoted strings.
  37. #  
  38. #       -x   Include all non-alphanumerics.
  39. #  
  40. #  Note: This program assumes the subject file is a valid Icon pro-
  41. #  gram. For example, quotes are expected to be matched.
  42. #  
  43. ############################################################################
  44. #
  45. #  Bugs:
  46. #
  47. #     In some situations, the output is not properly formatted.
  48. #
  49. ############################################################################
  50. #
  51. #  Links: options, post
  52. #
  53. ############################################################################
  54.  
  55. link options, post
  56.  
  57. global resword, linenum, letters, alphas, var, buffer, qflag, infile, xflag
  58. global inmaxcol, inlmarg, inchunk, localvar, lin
  59.  
  60. record procrec(pname,begline,lastline)
  61.  
  62. procedure main(args)
  63.  
  64.    local word, w2, p, prec, i, L, ln, switches, nfile
  65.  
  66.    Init__("ipxref")
  67.  
  68.    resword := ["break","by","case","default","do","dynamic","else","end",
  69.       "every","fail","global","if","initial","link", "local","next","not",
  70.       "of","procedure", "record","repeat","return","static","suspend","then",
  71.       "to","until","while"]
  72.    linenum := 0
  73.    var := table()        # var[variable[proc]] is list of line numbers
  74.    prec := []            # list of procedure records
  75.    localvar := []        # list of local variables of current routine
  76.    buffer := []            # a put-back buffer for getword
  77.    proc := "global"
  78.    letters := &letters ++ '_'
  79.    alphas := letters ++ &digits
  80.  
  81.    switches := options(args,"qxw+l+c+")
  82.  
  83.    if \switches["q"] then qflag := 1
  84.    if \switches["x"] then xflag := 1
  85.    inmaxcol := \switches["w"]
  86.    inlmarg := \switches["l"]
  87.    inchunk := \switches["c"]
  88.    infile := open(args[1],"r")     # could use some checking
  89.  
  90.    while word := getword() do
  91.       if word == "link" then {
  92.          buffer := []
  93.          lin := ""
  94.          next
  95.          }
  96.       else if word == "procedure" then {
  97.          put(prec,procrec("",linenum,0))
  98.          proc := getword() | break
  99.          p := pull(prec)
  100.          p.pname := proc
  101.          put(prec,p)
  102.          }
  103.       else if word == ("global" | "link" | "record") then {
  104.          word := getword() | break
  105.          addword(word,"global",linenum)
  106.          while (w2 := getword()) == "," do {
  107.             if word == !resword then break
  108.             word := getword() | break
  109.             addword(word,"global",linenum)
  110.             }
  111.          put(buffer,w2)
  112.          }
  113.       else if word == ("local" | "dynamic" | "static") then {
  114.          word := getword() | break
  115.          put(localvar,word)
  116.          addword(word,proc,linenum)
  117.          while (w2 := getword()) == "," do {
  118.             if word == !resword then break
  119.             word := getword() | break
  120.             put(localvar,word)
  121.             addword(word,proc,linenum)
  122.             }
  123.          put(buffer,w2)
  124.          }
  125.       else if word == "end" then {
  126.          proc := "global"
  127.          localvar := []
  128.          p := pull(prec)
  129.          p.lastline := linenum
  130.          put(prec,p)
  131.          }
  132.       else if word == !resword then 
  133.          next
  134.       else {
  135.          ln := linenum
  136.          if (w2 := getword()) == "(" then
  137.             word ||:= " *"            # special mark for procedures
  138.          else
  139.             put(buffer,w2)            # put back w2
  140.          addword(word,proc,ln)
  141.          }
  142.    every write(!format(var))
  143.    write("\n\nprocedures:\tlines:\n")
  144.    L := []
  145.    every p := !prec do
  146.       put(L,left(p.pname,16," ") || p.begline || "-" || p.lastline)
  147.    every write(!sort(L))
  148.  
  149.    Term__()
  150.  
  151. end
  152.  
  153. procedure addword(word,proc,lineno)
  154.    if any(letters,word) | \xflag then {
  155.       /var[word] := table()
  156.       if /var[word]["global"] | (word == !\localvar) then {
  157.          /(var[word])[proc] := [word,proc]
  158.          put((var[word])[proc],lineno)
  159.          }
  160.       else {
  161.          /var[word]["global"] := [word,"global"]
  162.          put((var[word])["global"],lineno)
  163.          }
  164.       }
  165. end
  166.  
  167. procedure getword()
  168.    local j, c
  169.    static i, nonwhite
  170.    initial nonwhite := ~' \t\n'
  171.  
  172.    repeat {
  173.       if *buffer > 0 then return get(buffer)
  174.       if /lin | i = *lin + 1 then
  175.          if lin := read(infile) then {
  176.             i := 1
  177.             linenum +:= 1
  178.             }
  179.          else fail
  180.       if i := upto(nonwhite,lin,i) then {   # skip white space
  181.          j := i
  182.          if lin[i] == ("'" | "\"") then {   # don't xref quoted words
  183.             if /qflag then {
  184.                c := lin[i]
  185.                i +:= 1
  186.                repeat
  187.                   if i := upto(c ++ '\\',lin,i) + 1 then
  188.                      if lin[i - 1] == c then break
  189.                      else i +:= 1
  190.                   else {
  191.                      i := 1
  192.                      linenum +:= 1
  193.                      lin := read(infile) | fail
  194.                      }
  195.                }
  196.             else i +:= 1
  197.             }
  198.          else if lin[i] == "#" then {    # don't xref comments; get next line
  199.             i := *lin + 1
  200.             }
  201.          else if i := many(alphas,lin,i) then
  202.             return lin[j:i]
  203.          else {
  204.             i +:= 1
  205.             return lin[i - 1]
  206.             }
  207.          }
  208.       else
  209.          i := *lin + 1
  210.    }       # repeat
  211. end
  212.  
  213. procedure format(T)
  214.    local V, block, n, L, lin, maxcol, lmargin, chunk, col
  215.    initial {
  216.       maxcol := \inmaxcol | 80
  217.       lmargin := \inlmarg | 40
  218.       chunk := \inchunk | 4
  219.       }
  220.    L := []
  221.    col := lmargin
  222.    every V := !T do
  223.       every block := !V do {
  224.          lin := left(block[1],16," ") || left(block[2],lmargin - 16," ")
  225.          every lin ||:= center(block[3 to *block],chunk," ") do {
  226.             col +:= chunk
  227.             if col >= maxcol - chunk then {
  228.                lin ||:= "\n\t\t\t\t\t"
  229.                col := lmargin
  230.                }
  231.             }
  232.          if col = lmargin then lin := lin[1:-6] # came out exactly even
  233.          put(L,lin)
  234.          col := lmargin
  235.          }
  236.    L := sort(L)
  237.    push(L,"variable\tprocedure\t\tline numbers\n")
  238.    return L
  239. end
  240.