|
|
1.1 ! root 1: # I-XREF(1) ! 2: # ! 3: # Icon program cross-reference ! 4: # ! 5: # Allan J. Anderson ! 6: # ! 7: # Last modified 7/10/83 ! 8: # ! 9: ! 10: global resword, linenum, letters, digits, var, buffer, qflag, f, fflag, xflag ! 11: global inmaxcol, inlmarg, inchunk, localvar ! 12: ! 13: record procrec(pname,begline,lastline) ! 14: ! 15: procedure main(a) ! 16: local word, w2, p, prec, i, L, ln ! 17: initial { ! 18: resword := ["break","by","case","default","do","dynamic","else", ! 19: "end","every","external","fail","global","if", ! 20: "initial","local","next","not","of","procedure", ! 21: "record","repeat","return","static","suspend","then", ! 22: "to","until","while"] ! 23: linenum := 0 ! 24: var := table() # var[variable[proc]] is list of line numbers ! 25: prec := [] # list of procedure records ! 26: localvar := [] # list of local variables of current routine ! 27: buffer := [] # a put-back buffer for getword ! 28: proc := "global" ! 29: letters := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz' ++ '_' ! 30: digits := '1234567890' ! 31: } ! 32: # &trace := -1 ! 33: every p := a[i := 1 to *a] do ! 34: if p == ("-q" | "-Q") then ! 35: qflag := 1 ! 36: else if p == ("-x" | "-X") then ! 37: xflag := 1 ! 38: else if p == ("-w" | "-W") then ! 39: inmaxcol := integer(a[i + 1]) ! 40: else if p == ("-l" | "-L") then ! 41: inlmarg := integer(a[i + 1]) ! 42: else if p == ("-c" | "-C") then ! 43: inchunk := integer(a[i + 1]) ! 44: else if f := open(p,"r") then ! 45: fflag := 1 ! 46: while word := getword() do ! 47: if word == "procedure" then { ! 48: put(prec,procrec("",linenum,0)) ! 49: proc := getword() | break ! 50: p := pull(prec) ! 51: p.pname := proc ! 52: put(prec,p) ! 53: } ! 54: else if word == ("global" | "external" | "record") then { ! 55: word := getword() | break ! 56: addword(word,"global",linenum) ! 57: while (w2 := getword()) == "," do { ! 58: if Find(word,resword) then break ! 59: word := getword() | break ! 60: addword(word,"global",linenum) ! 61: } ! 62: put(buffer,w2) ! 63: } ! 64: else if word == ("local" | "dynamic" | "static") then { ! 65: word := getword() | break ! 66: put(localvar,word) ! 67: addword(word,proc,linenum) ! 68: while (w2 := getword()) == "," do { ! 69: if Find(word,resword) then break ! 70: word := getword() | break ! 71: put(localvar,word) ! 72: addword(word,proc,linenum) ! 73: } ! 74: put(buffer,w2) ! 75: } ! 76: else if word == "end" then { ! 77: proc := "global" ! 78: localvar := [] ! 79: p := pull(prec) ! 80: p.lastline := linenum ! 81: put(prec,p) ! 82: } ! 83: else if Find(word,resword) then ! 84: next ! 85: else { ! 86: ln := linenum ! 87: if (w2 := getword()) == "(" then ! 88: word ||:= " *" # special mark for procedures ! 89: else ! 90: put(buffer,w2) # put back w2 ! 91: addword(word,proc,ln) ! 92: } ! 93: every write(!format(var)) ! 94: write("\n\nprocedures:\tlines:\n") ! 95: L := [] ! 96: every p := !prec do ! 97: put(L,left(p.pname,16," ") || p.begline || "-" || p.lastline) ! 98: every write(!(sort(L))) ! 99: end ! 100: ! 101: procedure addword(word,proc,lineno) ! 102: if any(letters,word) | \xflag then { ! 103: /var[word] := table() ! 104: if /var[word]["global"] | Find(word,\localvar) then { ! 105: /(var[word])[proc] := [word,proc] ! 106: put((var[word])[proc],lineno) ! 107: } ! 108: else { ! 109: /var[word]["global"] := [word,"global"] ! 110: put((var[word])["global"],lineno) ! 111: } ! 112: } ! 113: end ! 114: ! 115: procedure getword() ! 116: local j, c ! 117: static lin, i ! 118: repeat { ! 119: if *buffer > 0 then return get(buffer) ! 120: if /lin | i = *lin + 1 then ! 121: if lin := myread() then { ! 122: i := 1 ! 123: linenum +:= 1 ! 124: } ! 125: else fail ! 126: if i := upto(~(' ' ++ '\t' ++ '\n'),lin,i) then { # skip white space ! 127: j := i ! 128: if lin[i] == ("'" | '"') then { # don't xref quoted words ! 129: if /qflag then { ! 130: c := lin[i] ! 131: i +:= 1 ! 132: repeat ! 133: if i := upto(c ++ '\\',lin,i) + 1 then ! 134: if lin[i - 1] == c then break ! 135: else i +:= 1 ! 136: else { ! 137: i := 1 ! 138: linenum +:= 1 ! 139: lin := myread() | fail ! 140: } ! 141: } ! 142: else i +:= 1 ! 143: } ! 144: else if lin[i] == "#" then { # don't xref comments; get next line ! 145: i := *lin + 1 ! 146: } ! 147: else if i := many(letters ++ digits,lin,i) then ! 148: return lin[j:i] ! 149: else { ! 150: i +:= 1 ! 151: return lin[i - 1] ! 152: } ! 153: } ! 154: else ! 155: i := *lin + 1 ! 156: } # repeat ! 157: end ! 158: ! 159: procedure format(T) ! 160: local V, block, n, L, lin, maxcol, lmargin, chunk, col ! 161: initial { ! 162: maxcol := \inmaxcol | 80 ! 163: lmargin := \inlmarg | 40 ! 164: chunk := \inchunk | 4 ! 165: } ! 166: L := [] ! 167: col := lmargin ! 168: every V := !T do ! 169: every block := !V do { ! 170: lin := left(block[1],16," ") || left(block[2],lmargin - 16," ") ! 171: every lin ||:= center(block[3 to *block],chunk," ") do { ! 172: col +:= chunk ! 173: if col >= maxcol - chunk then { ! 174: lin ||:= "\n\t\t\t\t\t" ! 175: col := lmargin ! 176: } ! 177: } ! 178: if col = lmargin then lin := lin[1:-6] # came out exactly even ! 179: put(L,lin) ! 180: col := lmargin ! 181: } ! 182: L := sort(L) ! 183: push(L,"variable\tprocedure\t\tline numbers\n") ! 184: return L ! 185: end ! 186: ! 187: procedure Find(w,L) ! 188: every if w == L[1 to *L] then return ! 189: end ! 190: ! 191: procedure myread() ! 192: if \fflag then return read(f) else return read() ! 193: end ! 194:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.