Annotation of 43BSD/contrib/icon/src/cmd/i-xref.icn, revision 1.1.1.1

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: 

unix.superglobalmegacorp.com

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