home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
17 Bit Software 1: Collection A
/
17Bit_Collection_A.iso
/
files
/
134.dms
/
134.adf
/
Icon
/
xref.icn
< prev
Wrap
Text File
|
1988-07-25
|
5KB
|
195 lines
# I-XREF(1)
#
# Icon program cross-reference
#
# Allan J. Anderson
#
# Last modified 7/10/83
#
global resword, linenum, letters, digits, var, buffer, qflag, f, fflag, xflag
global inmaxcol, inlmarg, inchunk, localvar
record procrec(pname,begline,lastline)
procedure main(a)
local word, w2, p, prec, i, L, ln
initial {
resword := ["break","by","case","default","do","dynamic","else",
"end","every","external","fail","global","if",
"initial","local","next","not","of","procedure",
"record","repeat","return","static","suspend","then",
"to","until","while"]
linenum := 0
var := table() # var[variable[proc]] is list of line numbers
prec := [] # list of procedure records
localvar := [] # list of local variables of current routine
buffer := [] # a put-back buffer for getword
proc := "global"
letters := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz' ++ '_'
digits := '1234567890'
}
# &trace := -1
every p := a[i := 1 to *a] do
if p == ("-q" | "-Q") then
qflag := 1
else if p == ("-x" | "-X") then
xflag := 1
else if p == ("-w" | "-W") then
inmaxcol := integer(a[i + 1])
else if p == ("-l" | "-L") then
inlmarg := integer(a[i + 1])
else if p == ("-c" | "-C") then
inchunk := integer(a[i + 1])
else if f := open(p,"r") then
fflag := 1
while word := getword() do
if word == "procedure" then {
put(prec,procrec("",linenum,0))
proc := getword() | break
p := pull(prec)
p.pname := proc
put(prec,p)
}
else if word == ("global" | "external" | "record") then {
word := getword() | break
addword(word,"global",linenum)
while (w2 := getword()) == "," do {
if Find(word,resword) then break
word := getword() | break
addword(word,"global",linenum)
}
put(buffer,w2)
}
else if word == ("local" | "dynamic" | "static") then {
word := getword() | break
put(localvar,word)
addword(word,proc,linenum)
while (w2 := getword()) == "," do {
if Find(word,resword) then break
word := getword() | break
put(localvar,word)
addword(word,proc,linenum)
}
put(buffer,w2)
}
else if word == "end" then {
proc := "global"
localvar := []
p := pull(prec)
p.lastline := linenum
put(prec,p)
}
else if Find(word,resword) then
next
else {
ln := linenum
if (w2 := getword()) == "(" then
word ||:= " *" # special mark for procedures
else
put(buffer,w2) # put back w2
addword(word,proc,ln)
}
every write(!format(var))
write("\n\nprocedures:\tlines:\n")
L := []
every p := !prec do
put(L,left(p.pname,16," ") || p.begline || "-" || p.lastline)
every write(!(sort(L)))
end
procedure addword(word,proc,lineno)
if any(letters,word) | \xflag then {
/var[word] := table()
if /var[word]["global"] | Find(word,\localvar) then {
/(var[word])[proc] := [word,proc]
put((var[word])[proc],lineno)
}
else {
/var[word]["global"] := [word,"global"]
put((var[word])["global"],lineno)
}
}
end
procedure getword()
local j, c
static lin, i
repeat {
if *buffer > 0 then return get(buffer)
if /lin | i = *lin + 1 then
if lin := myread() then {
i := 1
linenum +:= 1
}
else fail
if i := upto(~(' ' ++ '\t' ++ '\n'),lin,i) then { # skip white space
j := i
if lin[i] == ("'" | '"') then { # don't xref quoted words
if /qflag then {
c := lin[i]
i +:= 1
repeat
if i := upto(c ++ '\\',lin,i) + 1 then
if lin[i - 1] == c then break
else i +:= 1
else {
i := 1
linenum +:= 1
lin := myread() | fail
}
}
else i +:= 1
}
else if lin[i] == "#" then { # don't xref comments; get next line
i := *lin + 1
}
else if i := many(letters ++ digits,lin,i) then
return lin[j:i]
else {
i +:= 1
return lin[i - 1]
}
}
else
i := *lin + 1
} # repeat
end
procedure format(T)
local V, block, n, L, lin, maxcol, lmargin, chunk, col
initial {
maxcol := \inmaxcol | 80
lmargin := \inlmarg | 40
chunk := \inchunk | 4
}
L := []
col := lmargin
every V := !T do
every block := !V do {
lin := left(block[1],16," ") || left(block[2],lmargin - 16," ")
every lin ||:= center(block[3 to *block],chunk," ") do {
col +:= chunk
if col >= maxcol - chunk then {
lin ||:= "\n\t\t\t\t\t"
col := lmargin
}
}
if col = lmargin then lin := lin[1:-6] # came out exactly even
put(L,lin)
col := lmargin
}
L := sort(L)
push(L,"variable\tprocedure\t\tline numbers\n")
return L
end
procedure Find(w,L)
every if w == L[1 to *L] then return
end
procedure myread()
if \fflag then return read(f) else return read()
end