Commit 6e350884 authored by simonmar's avatar simonmar
Browse files

[project @ 2000-10-06 15:33:27 by simonmar]

Object file linker for GHCi.
parent 85dfd240
/* -----------------------------------------------------------------------------
* $Id: Linker.c,v 1.1 2000/10/06 15:33:27 simonmar Exp $
*
* (c) The GHC Team, 2000
*
* RTS Object Linker
*
* ---------------------------------------------------------------------------*/
#include "Rts.h"
#include "RtsFlags.h"
#include "HsFFI.h"
#include "Hash.h"
#include "Linker.h"
#include "RtsUtils.h"
/* These two are POSIX headers */
#include <sys/types.h>
#include <sys/stat.h>
/* ToDo: configure this */
#include <dlfcn.h>
/* A bucket in the symbol hash-table. Primarily, maps symbol names to
* absolute addresses. All symbols from a given module are linked
* together, so they can be freed at the same time. There's also a
* bucket link field for the hash table.
*/
typedef struct _SymbolVal {
char *lbl;
void *addr;
} SymbolVal;
typedef enum { OBJECT_LOADED, OBJECT_RESOLVED } OStatus;
/* Indication of section kinds for loaded objects. Needed by
the GC for deciding whether or not a pointer on the stack
is a code pointer.
*/
typedef enum { SECTIONKIND_CODE_OR_RODATA,
SECTIONKIND_RWDATA,
SECTIONKIND_OTHER,
SECTIONKIND_NOINFOAVAIL }
SectionKind;
typedef struct { void* start; void* end; SectionKind kind; }
Section;
/* Top-level structure for an object module. One of these is allocated
* for each object file in use.
*/
typedef struct _ObjectCode {
OStatus status;
char* fileName;
int fileSize;
char* formatName; /* eg "ELF32", "DLL", "COFF", etc. */
SymbolVal *symbols;
int n_symbols;
/* ptr to malloc'd lump of memory holding the obj file */
void* image;
/* The section-kind entries for this object module. Dynamically expands. */
Section* sections;
int n_sections;
/* Allow a chain of these things */
struct _ObjectCode * next;
} ObjectCode;
/* Hash table mapping symbol names to Symbol */
/*Str*/HashTable *symhash;
/* List of currently loaded objects */
ObjectCode *objects;
#if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS)
static int ocVerifyImage_ELF ( ObjectCode* oc );
static int ocGetNames_ELF ( ObjectCode* oc );
static int ocResolve_ELF ( ObjectCode* oc );
#elif defined(cygwin32_TARGET_OS)
static int ocVerifyImage_PEi386 ( ObjectCode* oc );
static int ocGetNames_PEi386 ( ObjectCode* oc );
static int ocResolve_PEi386 ( ObjectCode* oc );
#endif
/* -----------------------------------------------------------------------------
* Built-in symbols from the RTS
*/
#define RTS_SYMBOLS \
SymX(MainRegTable) \
Sym(stg_gc_enter_1) \
Sym(stg_gc_noregs) \
Sym(stg_gc_seq_1) \
Sym(stg_gc_d1) \
Sym(stg_gc_f1) \
Sym(stg_gc_ut_1_0) \
Sym(stg_gc_ut_0_1) \
Sym(stg_gc_unbx_r1) \
Sym(stg_chk_0) \
Sym(stg_chk_1) \
Sym(stg_gen_chk) \
SymX(stg_exit) \
SymX(stg_update_PAP) \
SymX(__ap_2_upd_info) \
SymX(__ap_3_upd_info) \
SymX(__ap_4_upd_info) \
SymX(__ap_5_upd_info) \
SymX(__ap_6_upd_info) \
SymX(__ap_7_upd_info) \
SymX(__ap_8_upd_info) \
SymX(__sel_0_upd_info) \
SymX(__sel_1_upd_info) \
SymX(__sel_2_upd_info) \
SymX(__sel_3_upd_info) \
SymX(__sel_4_upd_info) \
SymX(__sel_5_upd_info) \
SymX(__sel_6_upd_info) \
SymX(__sel_7_upd_info) \
SymX(__sel_8_upd_info) \
SymX(__sel_9_upd_info) \
SymX(__sel_10_upd_info) \
SymX(__sel_11_upd_info) \
SymX(__sel_12_upd_info) \
SymX(upd_frame_info) \
SymX(seq_frame_info) \
SymX(CAF_BLACKHOLE_info) \
SymX(IND_STATIC_info) \
SymX(EMPTY_MVAR_info) \
SymX(MUT_ARR_PTRS_FROZEN_info) \
SymX(newCAF) \
SymX(putMVarzh_fast) \
SymX(newMVarzh_fast) \
SymX(takeMVarzh_fast) \
SymX(tryTakeMVarzh_fast) \
SymX(catchzh_fast) \
SymX(raisezh_fast) \
SymX(delayzh_fast) \
SymX(yieldzh_fast) \
SymX(killThreadzh_fast) \
SymX(waitReadzh_fast) \
SymX(waitWritezh_fast) \
SymX(CHARLIKE_closure) \
SymX(INTLIKE_closure) \
SymX(suspendThread) \
SymX(resumeThread) \
SymX(stackOverflow) \
SymX(int2Integerzh_fast) \
SymX(ErrorHdrHook) \
SymX(mkForeignObjzh_fast) \
SymX(__encodeDouble) \
SymX(decodeDoublezh_fast) \
SymX(isDoubleNaN) \
SymX(isDoubleInfinite) \
SymX(isDoubleDenormalized) \
SymX(isDoubleNegativeZero) \
SymX(__encodeFloat) \
SymX(decodeFloatzh_fast) \
SymX(isFloatNaN) \
SymX(isFloatInfinite) \
SymX(isFloatDenormalized) \
SymX(isFloatNegativeZero) \
SymX(__int_encodeFloat) \
SymX(__int_encodeDouble) \
SymX(__gmpz_cmp_si) \
SymX(__gmpz_cmp) \
SymX(__gmpn_gcd_1) \
SymX(gcdIntegerzh_fast) \
SymX(newArrayzh_fast) \
SymX(unsafeThawArrayzh_fast) \
SymX(newDoubleArrayzh_fast) \
SymX(newFloatArrayzh_fast) \
SymX(newAddrArrayzh_fast) \
SymX(newWordArrayzh_fast) \
SymX(newIntArrayzh_fast) \
SymX(newCharArrayzh_fast) \
SymX(newMutVarzh_fast) \
SymX(quotRemIntegerzh_fast) \
SymX(quotIntegerzh_fast) \
SymX(remIntegerzh_fast) \
SymX(divExactIntegerzh_fast) \
SymX(divModIntegerzh_fast) \
SymX(timesIntegerzh_fast) \
SymX(minusIntegerzh_fast) \
SymX(plusIntegerzh_fast) \
SymX(mkWeakzh_fast) \
SymX(prog_argv) \
SymX(prog_argc) \
SymX(resetNonBlockingFd) \
SymX(getStablePtr) \
SymX(stable_ptr_table) \
SymX(shutdownHaskellAndExit) \
Sym(stg_enterStackTop) \
SymX(CAF_UNENTERED_entry) \
Sym(stg_yield_to_Hugs) \
Sym(StgReturn) \
Sym(init_stack) \
SymX(blockAsyncExceptionszh_fast) \
SymX(unblockAsyncExceptionszh_fast) \
Sym(__init_PrelGHC)
/* entirely bogus claims about types of these symbols */
#define Sym(vvv) extern void (vvv);
#define SymX(vvv) /**/
RTS_SYMBOLS
#undef Sym
#undef SymX
#ifdef LEADING_UNDERSCORE
#define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
#else
#define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
#endif
#define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
(void*)(&(vvv)) },
#define SymX(vvv) Sym(vvv)
static SymbolVal rtsSyms[] = {
RTS_SYMBOLS
{ 0, 0 } /* sentinel */
};
/* -----------------------------------------------------------------------------
* initialize the object linker
*/
static void *dl_prog_handle;
void
initLinker( void )
{
SymbolVal *sym;
symhash = allocStrHashTable();
/* populate the symbol table with stuff from the RTS */
for (sym = rtsSyms; sym->lbl != NULL; sym++) {
insertStrHashTable(symhash, sym->lbl, sym);
}
dl_prog_handle = dlopen(NULL, RTLD_LAZY);
}
/* -----------------------------------------------------------------------------
* lookup a symbol in the hash table
*/
void *
lookupSymbol( char *lbl )
{
SymbolVal *val;
val = lookupStrHashTable(symhash, lbl);
if (val == NULL) {
return dlsym(dl_prog_handle, lbl);
} else {
return val->addr;
}
}
/* -----------------------------------------------------------------------------
* Load an obj (populate the global symbol table, but don't resolve yet)
*
* Returns: 1 if ok, 0 on error.
*/
HsInt
loadObj( char *path )
{
ObjectCode* oc;
struct stat st;
int r, n;
FILE *f;
#ifdef DEBUG
/* assert that we haven't already loaded this object */
{
ObjectCode *o;
for (o = objects; o; o = o->next)
ASSERT(strcmp(o->fileName, path));
}
#endif /* DEBUG */
oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
# if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS)
oc->formatName = "ELF";
# elif defined(cygwin32_TARGET_OS)
oc->formatName = "PEi386";
# else
free(oc);
barf("loadObj: not implemented on this platform");
# endif
r = stat(path, &st);
if (r == -1) { return 0; }
oc->fileName = path;
oc->fileSize = st.st_size;
oc->image = stgMallocBytes( st.st_size, "loadObj(image)" );
oc->symbols = NULL;
oc->sections = NULL;
/* chain it onto the list of objects */
oc->next = objects;
objects = oc;
/* load the image into memory */
f = fopen(path, "rb");
if (!f) {
barf("loadObj: can't read `%s'", path);
}
n = fread ( oc->image, 1, oc->fileSize, f );
if (n != oc->fileSize) {
fclose(f);
barf("loadObj: error whilst reading `%s'", path);
}
/* verify the in-memory image */
# if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS)
r = ocVerifyImage_ELF ( oc );
# elif defined(cygwin32_TARGET_OS)
r = ocVerifyImage_PEi386 ( oc );
# else
barf("loadObj: no verify method");
# endif
if (!r) { return r; }
/* build the symbol list for this image */
# if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS)
r = ocGetNames_ELF ( oc );
# elif defined(cygwin32_TARGET_OS)
r = ocGetNames_PEi386 ( oc );
# else
barf("loadObj: no getNames method");
# endif
if (!r) { return r; }
/* loaded, but not resolved yet */
oc->status = OBJECT_LOADED;
return 1;
}
/* -----------------------------------------------------------------------------
* resolve all the currently unlinked objects in memory
*
* Returns: 1 if ok, 0 on error.
*/
HsInt
resolveObjs( void )
{
ObjectCode *oc;
int r;
for (oc = objects; oc; oc = oc->next) {
if (oc->status != OBJECT_RESOLVED) {
# if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS)
r = ocResolve_ELF ( oc );
# elif defined(cygwin32_TARGET_OS)
r = ocResolve_PEi386 ( oc );
# else
barf("link: not implemented on this platform");
# endif
if (!r) { return r; }
oc->status = OBJECT_RESOLVED;
}
}
return 1;
}
/* -----------------------------------------------------------------------------
* delete an object from the pool
*/
HsInt
unloadObj( char *path )
{
ObjectCode *oc;
for (oc = objects; oc; oc = oc->next) {
if (!strcmp(oc->fileName,path)) {
/* Remove all the mappings for the symbols within this
* object..
*/
{
SymbolVal *s;
for (s = oc->symbols; s < oc->symbols + oc->n_symbols; s++) {
removeStrHashTable(symhash, s->lbl, NULL);
}
}
/* We're going to leave this in place, in case there are
any pointers from the heap into it: */
/* free(oc->image); */
free(oc->symbols);
free(oc->sections);
free(oc);
return 1;
}
}
belch("unloadObj: can't find `%s' to unload", path);
return 0;
}
/* --------------------------------------------------------------------------
* PEi386 specifics (cygwin32)
* ------------------------------------------------------------------------*/
/* The information for this linker comes from
Microsoft Portable Executable
and Common Object File Format Specification
revision 5.1 January 1998
which SimonM says comes from the MS Developer Network CDs.
*/
#if defined(cygwin32_TARGET_OS)
typedef unsigned char UChar;
typedef unsigned short UInt16;
typedef unsigned int UInt32;
typedef int Int32;
typedef
struct {
UInt16 Machine;
UInt16 NumberOfSections;
UInt32 TimeDateStamp;
UInt32 PointerToSymbolTable;
UInt32 NumberOfSymbols;
UInt16 SizeOfOptionalHeader;
UInt16 Characteristics;
}
COFF_header;
#define sizeof_COFF_header 20
typedef
struct {
UChar Name[8];
UInt32 VirtualSize;
UInt32 VirtualAddress;
UInt32 SizeOfRawData;
UInt32 PointerToRawData;
UInt32 PointerToRelocations;
UInt32 PointerToLinenumbers;
UInt16 NumberOfRelocations;
UInt16 NumberOfLineNumbers;
UInt32 Characteristics;
}
COFF_section;
#define sizeof_COFF_section 40
typedef
struct {
UChar Name[8];
UInt32 Value;
UInt16 SectionNumber;
UInt16 Type;
UChar StorageClass;
UChar NumberOfAuxSymbols;
}
COFF_symbol;
#define sizeof_COFF_symbol 18
typedef
struct {
UInt32 VirtualAddress;
UInt32 SymbolTableIndex;
UInt16 Type;
}
COFF_reloc;
#define sizeof_COFF_reloc 10
/* From PE spec doc, section 3.3.2 */
#define IMAGE_FILE_RELOCS_STRIPPED 0x0001
#define IMAGE_FILE_EXECUTABLE_IMAGE 0x0002
#define IMAGE_FILE_DLL 0x2000
#define IMAGE_FILE_SYSTEM 0x1000
#define IMAGE_FILE_BYTES_REVERSED_HI 0x8000
#define IMAGE_FILE_BYTES_REVERSED_LO 0x0080
#define IMAGE_FILE_32BIT_MACHINE 0x0100
/* From PE spec doc, section 5.4.2 and 5.4.4 */
#define IMAGE_SYM_CLASS_EXTERNAL 2
#define IMAGE_SYM_CLASS_STATIC 3
#define IMAGE_SYM_UNDEFINED 0
/* From PE spec doc, section 4.1 */
#define IMAGE_SCN_CNT_CODE 0x00000020
#define IMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
/* From PE spec doc, section 5.2.1 */
#define IMAGE_REL_I386_DIR32 0x0006
#define IMAGE_REL_I386_REL32 0x0014
/* We use myindex to calculate array addresses, rather than
simply doing the normal subscript thing. That's because
some of the above structs have sizes which are not
a whole number of words. GCC rounds their sizes up to a
whole number of words, which means that the address calcs
arising from using normal C indexing or pointer arithmetic
are just plain wrong. Sigh.
*/
static UChar *
myindex ( int scale, int index, void* base )
{
return
((UChar*)base) + scale * index;
}
static void
printName ( UChar* name, UChar* strtab )
{
if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
UInt32 strtab_offset = * (UInt32*)(name+4);
fprintf ( stderr, "%s", strtab + strtab_offset );
} else {
int i;
for (i = 0; i < 8; i++) {
if (name[i] == 0) break;
fprintf ( stderr, "%c", name[i] );
}
}
}
static void
copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
{
if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
UInt32 strtab_offset = * (UInt32*)(name+4);
strncpy ( dst, strtab+strtab_offset, dstSize );
dst[dstSize-1] = 0;
} else {
int i = 0;
while (1) {
if (i >= 8) break;
if (name[i] == 0) break;
dst[i] = name[i];
i++;
}
dst[i] = 0;
}
}
static UChar *
cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
{
UChar* newstr;
/* If the string is longer than 8 bytes, look in the
string table for it -- this will be correctly zero terminated.
*/
if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
UInt32 strtab_offset = * (UInt32*)(name+4);
return ((UChar*)strtab) + strtab_offset;
}
/* Otherwise, if shorter than 8 bytes, return the original,
which by defn is correctly terminated.
*/
if (name[7]==0) return name;
/* The annoying case: 8 bytes. Copy into a temporary
(which is never freed ...)
*/
newstr = malloc(9);
if (newstr) {
strncpy(newstr,name,8);
newstr[8] = 0;
}
return newstr;
}
/* Just compares the short names (first 8 chars) */
static COFF_section *
findPEi386SectionCalled ( ObjectCode* oc, char* name )
{
int i;
COFF_header* hdr
= (COFF_header*)(oc->image);
COFF_section* sectab
= (COFF_section*) (
((UChar*)(oc->image))
+ sizeof_COFF_header + hdr->SizeOfOptionalHeader
);
for (i = 0; i < hdr->NumberOfSections; i++) {
UChar* n1;
UChar* n2;
COFF_section* section_i
= (COFF_section*)
myindex ( sizeof_COFF_section, i, sectab );
n1 = (UChar*) &(section_i->Name);
n2 = name;
if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
n1[6]==n2[6] && n1[7]==n2[7])
return section_i;
}
return NULL;
}
static void
zapTrailingAtSign ( UChar* sym )
{
int i, j;
if (sym[0] == 0) return;
i = 0;
while (sym[i] != 0) i++;
i--;
j = i;
while (j > 0 && isdigit(sym[j])) j--;
if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
}
static int
ocVerifyImage_PEi386 ( ObjectCode* oc )
{
int i, j;
COFF_header* hdr;
COFF_section* sectab;
COFF_symbol* symtab;
UChar* strtab;