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