/* Read and manage symbol tables from object modules
 */

#include "scheme.h"

#if defined(CAN_LOAD_OBJ) || defined (INIT_OBJECTS)

#ifdef COFF
#  include <filehdr.h>
#  include <syms.h>
#  undef TYPE         /* ldfnc.h defines a TYPE macro. */
#  include <ldfcn.h>
#  undef TYPE
#  ifdef USE_BITFIELDS
#    define TYPE(x) ((int)(x).s.type)
#  else
#    define TYPE(x) ((int)((x) >> VALBITS))
#  endif
#else
#  include <a.out.h>
#  include <sys/types.h>
#endif

char *Safe_Malloc (size) {
    char *ret;

    if ((ret = malloc (size)) == 0)
	Primitive_Error ("not enough memory to allocate ~s bytes",
	    Make_Fixnum (size));
    return ret;
}

#ifdef COFF

SYMTAB *Snarf_Symbols (lf, ep) LDFILE *lf; {
    SYMTAB *tab;
    register SYM *sp, **nextp;
    SYMENT sym;
    long inx;
    char *p;
    extern char *ldgetname();

    if (ldtbseek (lf) == FAILURE) {
	ldclose (lf, NULL);
	Primitive_Error ("can't ldtbseek");
    }
    tab = (SYMTAB *)Safe_Malloc (sizeof (SYMTAB));
    tab->first = 0;
    tab->strings = 0;
    nextp = &tab->first;
    while (1) {
	inx = ldtbindex (lf);
	if (ldtbread (lf, inx, &sym) == FAILURE)
	    break;
	if (sym.n_scnum == N_UNDEF || sym.n_scnum == N_DEBUG
		|| sym.n_scnum > HEADER(lf).f_nscns)
	    continue;
	if ((p = ldgetname (lf, &sym)) == NULL)
	    continue;
	sp = (SYM *)Safe_Malloc (sizeof (SYM));
	sp->name = Safe_Malloc (strlen (p) + 1);
	strcpy (sp->name, p);
	sp->type = sym.n_type;
	sp->value = sym.n_value;
	*nextp = sp;
	nextp = &sp->next;
	*nextp = 0;
    }
    return tab;
}

SYMTAB *Open_File_And_Snarf_Symbols (name) char *name; {
    LDFILE *f;
    SYMTAB *tab;

    if ((f = ldopen (name, NULL)) == FAILURE)
	Primitive_Error ("can't ldopen a.out file");
    tab = Snarf_Symbols (f);
    ldclose (f);
    return tab;
}

#else

SYMTAB *Snarf_Symbols (f, ep) FILE *f; struct exec *ep; {
    SYMTAB *tab;
    register SYM *sp, **nextp;
    int nsyms, strsiz;
    struct nlist nl;

    tab = (SYMTAB *)Safe_Malloc (sizeof (SYMTAB));
    tab->first = 0;
    tab->strings = 0;
    nextp = &tab->first;
    (void)fseek (f, (long)N_SYMOFF(*ep), 0);
    for (nsyms = ep->a_syms / sizeof (nl); nsyms > 0; nsyms--) {
	if (fread ((char *)&nl, sizeof (nl), 1, f) != 1) {
	    Free_Symbols (tab);
	    fclose (f);
	    Primitive_Error ("corrupt symbol table in object file");
	}
	if (nl.n_un.n_strx == 0 || nl.n_type & N_STAB)
	    continue;
	sp = (SYM *)Safe_Malloc (sizeof (SYM));
	sp->name = (char *)nl.n_un.n_strx;
	sp->type = nl.n_type;
	sp->value = nl.n_value;
	*nextp = sp;
	nextp = &sp->next;
	*nextp = 0;
    }
    if (fread ((char *)&strsiz, sizeof (strsiz), 1, f) != 1) {
strerr:
	Free_Symbols (tab);
	fclose (f);
	Primitive_Error ("corrupt string table in object file");
    }
    if (strsiz <= 4)
	goto strerr;
    tab->strings = Safe_Malloc (strsiz);
    strsiz -= 4;
    if (fread (tab->strings+4, 1, strsiz, f) != strsiz)
	goto strerr;
    for (sp = tab->first; sp; sp = sp->next)
	sp->name = tab->strings + (long)sp->name;
    return tab;
}

SYMTAB *Open_File_And_Snarf_Symbols (name) char *name; {
    struct exec hdr;
    FILE *f;
    SYMTAB *tab;

    if ((f = fopen (name, "r")) == NULL)
	Primitive_Error ("can't open a.out file");
    if (fread ((char *)&hdr, sizeof hdr, 1, f) != 1) {
	fclose (f);
	Primitive_Error ("can't read a.out header");
    }
    tab = Snarf_Symbols (f, &hdr);
    fclose (f);
    return tab;
}

#endif

Free_Symbols (tab) SYMTAB *tab; {
    register SYM *sp;

    for (sp = tab->first; sp; sp = sp->next) {
#ifdef COFF
	free (sp->name);
#endif
	free ((char *)sp);
    }
    if (tab->strings)
	free (tab->strings);
}

Call_Initializers (tab, addr) SYMTAB *tab; char *addr; {
    register SYM *sp;

    for (sp = tab->first; sp; sp = sp->next) {
#ifndef COFF
	if ((sp->type & N_TYPE) != N_TEXT)
	    continue;
#endif
	if (sp->name[0] == '_' && (char *)sp->value >= addr
		&& (bcmp (sp->name, "__STI", 5) == 0
		|| bcmp (sp->name, "_init_", 6) == 0))
	    ((int (*)())sp->value)();
    }
}

#endif