/* Copyright (c) 1982 Regents of the University of California */
static char sccsid
[] = "@(#)object.c 1.10 %G%";
* Object code interface, mainly for extraction of symbolic information.
unsigned int stringsize
; /* size of the dumped string table */
unsigned int nsyms
; /* number of symbols */
unsigned int nfiles
; /* number of files */
unsigned int nlines
; /* number of lines */
public String objname
= "a.out";
private String progname
= nil
;
private Language curlang
;
private Symbol curmodule
;
private Symbol commchain
;
private Boolean strip_
= false;
private Linetab
*linep
, *prevlinep
;
#define curfilename() (filep-1)->filename
* Blocks are figured out on the fly while reading the symbol table.
private Symbol blkstack
[MAXBLKDEPTH
];
private Integer curlevel
;
#define enterblock(b) { \
blkstack[curlevel] = curblock; \
if (curblock->class == FUNC or curblock->class == PROC) { \
if (prevlinep != linep) { \
curblock->symvalue.funcv.src = true; \
curblock = blkstack[curlevel]; \
* Enter a source line or file name reference into the appropriate table.
* Expanded inline to reduce procedure calls.
* private enterline(linenumber, address)
#define enterline(linenumber, address) \
if (linenumber != lp->line) { \
if (address != lp->addr) { \
private Symbol typetable
[NTYPES
];
* Read in the namelist from the obj file.
* Reads and seeks are used instead of fread's and fseek's
* for efficiency sake; there's a lot of data being read here.
fatal("can't open %s", file
);
read(f
, &hdr
, sizeof(hdr
));
nlhdr
.nsyms
= hdr
.a_syms
/ sizeof(nlist
);
nlhdr
.nfiles
= nlhdr
.nsyms
;
nlhdr
.nlines
= nlhdr
.nsyms
;
lseek(f
, (long) N_STROFF(hdr
), 0);
read(f
, &(nlhdr
.stringsize
), sizeof(nlhdr
.stringsize
));
stringtab
= newarr(char, nlhdr
.stringsize
);
read(f
, stringtab
, nlhdr
.stringsize
);
allocmaps(nlhdr
.nfiles
, nlhdr
.nlines
);
lseek(f
, (long) N_SYMOFF(hdr
), 0);
* Read in symbols from object file.
register struct nlist
*np
, *ub
;
register Boolean afterlg
;
namelist
= newarr(struct nlist
, nlhdr
.nsyms
);
read(f
, namelist
, nlhdr
.nsyms
* sizeof(struct nlist
));
ub
= &namelist
[nlhdr
.nsyms
];
for (np
= &namelist
[0]; np
< ub
; np
++) {
name
= &stringtab
[index
- 4];
* if the program contains any .f files a trailing _ is stripped
* from the name on the assumption it was added by the compiler.
* This only affects names that follow the sdb N_SO entry with
if(strip_
&& *name
!= '\0' ) {
for(p
=name
,q
=(name
+1); *q
!= '\0'; p
=q
++);
if (*p
== '_') *p
= '\0';
* not an N_STAB ==> name != nil
* name[0] == '-' ==> name == "-lg"
* name[0] != '_' ==> filename or invisible
* The "-lg" signals the beginning of global loader symbols.
if ((np
->n_type
&N_STAB
) != 0) {
} else if (name
[0] == '-') {
if (curblock
->class != PROG
) {
if (curblock
->class != PROG
) {
enterline(0, (linep
-1)->addr
+ 1);
check_global(&name
[1], np
);
} else if (name
[0] == '_') {
check_local(&name
[1], np
);
} else if ((np
->n_type
&N_TEXT
) == N_TEXT
) {
* Initialize symbol information.
progname
= strdup(objname
);
if (rindex(progname
, '/') != nil
) {
progname
= rindex(progname
, '/') + 1;
if (index(progname
, '.') != nil
) {
*(index(progname
, '.')) = '\0';
program
= insert(identname(progname
, true));
program
->symvalue
.funcv
.beginaddr
= 0;
t_boolean
= maketype("$boolean", 0L, 1L);
t_int
= maketype("$integer", 0x80000000L
, 0x7fffffffL
);
t_char
= maketype("$char", 0L, 127L);
t_real
= maketype("$real", 8L, 0L);
t_nil
= maketype("$nil", 0L, 0L);
* Free all the object file information that's being stored.
* Enter a namelist entry.
private enter_nl(name
, np
)
register struct nlist
*np
;
n
= identname(name
, true);
* Build a symbol for the common; all GSYMS that follow will be chained;
* the head of this list is kept in common.offset, the tail in common.chain
curcomm
->symvalue
.common
.chain
= commchain
;
curcomm
->block
= curblock
;
curcomm
->level
= program
->level
;
curcomm
->symvalue
.common
.chain
= nil
;
commchain
= curcomm
->symvalue
.common
.chain
;
curcomm
->symvalue
.common
.chain
= commchain
;
enterline((Lineno
) np
->n_desc
, (Address
) np
->n_value
);
* Compilation unit. C associates scope with filenames
* so we treat them as "modules". The filename without
* the suffix is used for the module name.
* Because there is no explicit "end-of-block" mark in
* the object file, we must exit blocks for the current
mname
= strdup(ident(n
));
if (rindex(mname
, '/') != nil
) {
mname
= rindex(mname
, '/') + 1;
suffix
= rindex(mname
, '.');
curlang
= findlanguage(suffix
);
if(curlang
== findlanguage(".f")) {
if (curblock
->class != PROG
) {
if (curblock
->class != PROG
) {
nn
= identname(mname
, true);
if (curmodule
== nil
or curmodule
->name
!= nn
) {
s
->symvalue
.funcv
.beginaddr
= 0;
if (program
->language
== nil
) {
program
->language
= curlang
;
enterfile(ident(n
), (Address
) np
->n_value
);
bzero(typetable
, sizeof(typetable
));
* Textually included files.
enterfile(name
, (Address
) np
->n_value
);
* These symbols are assumed to have non-nil names.
if (index(name
, ':') == nil
) {
* Shouldn't do this if user might be typing.
warning("old style symbol information found in \"%s\"",
* Should complain out this, obviously the wrong symbol format.
printf("ntype %2x, desc %x, value %x\n",
np->n_type, np->n_desc, np->n_value);
* Check to see if a global _name is already in the symbol table,
private check_global(name
, np
)
register struct nlist
*np
;
if (not streq(name
, "end")) {
n
= identname(name
, true);
if ((np
->n_type
&N_TYPE
) == N_TEXT
) {
t
->level
== program
->level
and isblock(t
)
t
->language
= findlanguage(".s");
t
->level
= program
->level
;
t
->symvalue
.funcv
.src
= false;
t
->symvalue
.funcv
.beginaddr
= np
->n_value
;
} else if ((np
->n_type
&N_TYPE
) == N_BSS
) {
u
= (Symbol
) t
->symvalue
.common
.offset
;
u
->symvalue
.offset
= u
->symvalue
.common
.offset
+np
->n_value
;
u
= u
->symvalue
.common
.chain
;
* Check to see if a namelist entry refers to a variable.
* If not, create a variable for the entry. In any case,
* set the offset of the variable according to the value field
t
->class == VAR
and t
->level
== program
->level
t
->language
= findlanguage(".s");
t
->level
= program
->level
;
t
->symvalue
.offset
= np
->n_value
;
* Check to see if a local _name is known in the current scope.
private check_local(name
, np
)
register struct nlist
*np
;
n
= identname(name
, true);
cur
= ((np
->n_type
&N_TYPE
) == N_TEXT
) ? curmodule
: curblock
;
find(t
, n
) where t
->block
== cur
endfind(t
);
t
->language
= findlanguage(".s");
if ((np
->n_type
&N_TYPE
) == N_TEXT
) {
t
->symvalue
.funcv
.src
= false;
t
->symvalue
.funcv
.beginaddr
= np
->n_value
;
t
->symvalue
.offset
= np
->n_value
;
* Check to see if a symbol corresponds to a object file name.
* For some reason these are listed as in the text segment.
private check_filename(name
)
if (i
>= 0 and mname
[i
] == '.' and mname
[i
+1] == 'o') {
while (mname
[i
] != '/' and i
>= 0) {
s
= insert(identname(&mname
[i
+1], true));
s
->language
= findlanguage(".s");
s
->symvalue
.funcv
.beginaddr
= 0;
if (curblock
->class != PROG
) {
if (curblock
->class != PROG
) {
* Put an nlist into the symbol table.
* If it's already there just add the associated information.
* Type information is encoded in the name following a ":".
private Symbol
constype();
#define skipchar(ptr, ch) { \
panic("expected char '%c', found char '%c'", ch, *ptr); \
private entersym(str
, np
)
n
= identname(str
, true);
if (index("FfGV", c
) != nil
) {
if (c
== 'F' or c
== 'f') {
level
= (c
== 'f' ? curmodule
->level
: program
->level
);
find(s
, n
) where s
->level
== level
and s
->class == class endfind(s
);
s
->symvalue
.offset
= np
->n_value
;
case 't': /* type name */
panic("bad input on type \"%s\" at \"%s\"", symname(s
),
} else if (i
>= NTYPES
) {
panic("too many types in file \"%s\"", curfilename());
* A hack for C typedefs that don't create new types,
* e.g. typedef unsigned int Hashvalue;
* or typedef struct blah BLAH;
s
->type
= symbol_alloc();
panic("bad input on tag \"%s\" at \"%s\"", symname(s
),
} else if (i
>= NTYPES
) {
panic("too many types in file \"%s\"", curfilename());
if (typetable
[i
] != nil
) {
typetable
[i
]->language
= curlang
;
typetable
[i
]->class = TYPE
;
case 'F': /* public function */
case 'f': /* private function */
if (curblock
->class == FUNC
or curblock
->class == PROC
) {
s
->level
= program
->level
;
s
->symvalue
.funcv
.src
= false;
s
->symvalue
.funcv
.beginaddr
= np
->n_value
;
case 'G': /* public variable */
s
->level
= program
->level
;
case 'S': /* private variable */
s
->level
= curmodule
->level
;
* keep global BSS variables chained so can resolve when get the start
* of common; keep the list in order so f77 can display all vars in a COMMON
case 'V': /* own variable */
commchain
->symvalue
.common
.chain
= s
;
curcomm
->symvalue
.common
.offset
= (int) s
;
s
->symvalue
.common
.offset
= np
->n_value
;
s
->symvalue
.common
.chain
= nil
;
case 'r': /* register variable */
case 'p': /* parameter variable */
case 'v': /* varies parameter */
s
->symvalue
.offset
= np
->n_value
;
default: /* local variable */
* Construct a type out of a string encoding.
* The forms of the string are
* r<type>;<number>;<number> $ subrange
* a<type>;<type> $ array[index] of element
* s{<name>:<type>;<number>;<number>} $ record
private Symbol
constype(type
)
panic("bad type number at \"%s\"", curchar
);
} else if (n
>= NTYPES
) {
panic("too many types in file \"%s\"", curfilename());
if (typetable
[n
] != nil
) {
/* some letters indicate a dynamic bound, ie what follows
is the offset from the fp which contains the bound; this will
need a different encoding when pc a['A'..'Z'] is
added; J is a special flag to handle fortran a(*) bounds
t
->symvalue
.rangev
.lowertype
= R_ARG
;
t
->symvalue
.rangev
.lowertype
= R_TEMP
;
t
->symvalue
.rangev
.lowertype
= R_ADJUST
;
t
->symvalue
.rangev
.lowertype
= R_CONST
;
t
->symvalue
.rangev
.lower
= getint();
t
->symvalue
.rangev
.uppertype
= R_ARG
;
t
->symvalue
.rangev
.uppertype
= R_TEMP
;
t
->symvalue
.rangev
.uppertype
= R_ADJUST
;
t
->symvalue
.rangev
.uppertype
= R_CONST
;
t
->symvalue
.rangev
.upper
= getint();
t
->chain
= constype(nil
);
t
->class = (class == 's') ? RECORD
: VARNT
;
t
->symvalue
.offset
= getint();
while (*cur
!= ';' and *cur
!= '\0') {
panic("index(\"%s\", ':') failed", curchar
);
name
= identname(cur
, true);
u
->chain
= newSymbol(name
, b
, FIELD
, nil
, nil
);
u
->symvalue
.field
.offset
= getint();
u
->symvalue
.field
.length
= getint();
while (*curchar
!= ';' and *curchar
!= '\0') {
u
->chain
= insert(identname(curchar
, true));
u
->symvalue
.iconval
= getint();
* Read an integer from the current position in the type string.
* Add a tag name. This is a kludge to be able to refer
* to tags that have the same name as some other symbol
sprintf(buf
, "$$%.90s", ident(s
->name
));
t
= insert(identname(buf
, false));
t
->language
= s
->language
;
* Allocate file and line tables and initialize indices.
private allocmaps(nf
, nl
)
filetab
= newarr(Filetab
, nf
);
linetab
= newarr(Linetab
, nl
);
* Add a file to the file table.
* If the new address is the same as the previous file address
* this routine used to not enter the file, but this caused some
* problems so it has been removed. It's not clear that this in
* turn may not also cause a problem.
private enterfile(filename
, addr
)
filep
->filename
= filename
;
filep
->lineindex
= linep
- linetab
;
* Since we only estimated the number of lines (and it was a poor
* estimation) and since we need to know the exact number of lines
* to do a binary search, we set it when we're done.
nlhdr
.nlines
= linep
- linetab
;
* Similarly for nfiles ...
nlhdr
.nfiles
= filep
- filetab
;
setsource(filetab
[0].filename
);