Annotation of 43BSD/contrib/icon/src/cmd/i-xref.icn, revision 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.