/* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.147 2004/05/15 15:35:47 dons Exp $
*
- * (c) The GHC Team, 2000-2003
+ * (c) The GHC Team, 2000-2004
*
* RTS Object Linker
*
#include "Linker.h"
#include "LinkerInternals.h"
#include "RtsUtils.h"
-#include "StoragePriv.h"
#include "Schedule.h"
+#include "Storage.h"
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
# define MAIN_CAP_SYM
#endif
+#ifdef TABLES_NEXT_TO_CODE
+#define RTS_RET_SYMBOLS /* nothing */
+#else
+#define RTS_RET_SYMBOLS \
+ SymX(stg_enter_ret) \
+ SymX(stg_gc_fun_ret) \
+ SymX(stg_ap_0_ret) \
+ SymX(stg_ap_v_ret) \
+ SymX(stg_ap_f_ret) \
+ SymX(stg_ap_d_ret) \
+ SymX(stg_ap_l_ret) \
+ SymX(stg_ap_n_ret) \
+ SymX(stg_ap_p_ret) \
+ SymX(stg_ap_pv_ret) \
+ SymX(stg_ap_pp_ret) \
+ SymX(stg_ap_ppv_ret) \
+ SymX(stg_ap_ppp_ret) \
+ SymX(stg_ap_pppv_ret) \
+ SymX(stg_ap_pppp_ret) \
+ SymX(stg_ap_ppppp_ret) \
+ SymX(stg_ap_pppppp_ret)
+#endif
+
#define RTS_SYMBOLS \
Maybe_ForeignObj \
Maybe_Stable_Names \
Sym(StgReturn) \
SymX(stg_enter_info) \
- SymX(stg_enter_ret) \
SymX(stg_gc_void_info) \
SymX(__stg_gc_enter_1) \
SymX(stg_gc_noregs) \
SymX(stg_gc_l1) \
SymX(__stg_gc_fun) \
SymX(stg_gc_fun_info) \
- SymX(stg_gc_fun_ret) \
SymX(stg_gc_gen) \
SymX(stg_gc_gen_info) \
SymX(stg_gc_gen_hp) \
SymX(StackOverflowHook) \
SymX(__encodeDouble) \
SymX(__encodeFloat) \
+ SymX(addDLL) \
SymX(__gmpn_gcd_1) \
SymX(__gmpz_cmp) \
SymX(__gmpz_cmp_si) \
SymX(__int_encodeDouble) \
SymX(__int_encodeFloat) \
SymX(andIntegerzh_fast) \
+ SymX(barf) \
SymX(blockAsyncExceptionszh_fast) \
SymX(catchzh_fast) \
SymX(cmp_thread) \
SymX(genSymZh) \
SymX(getProgArgv) \
SymX(getStablePtr) \
+ SymX(initLinker) \
SymX(int2Integerzh_fast) \
SymX(integer2Intzh_fast) \
SymX(integer2Wordzh_fast) \
SymX(isFloatNaN) \
SymX(isFloatNegativeZero) \
SymX(killThreadzh_fast) \
+ SymX(loadObj) \
+ SymX(lookupSymbol) \
SymX(makeStablePtrzh_fast) \
SymX(minusIntegerzh_fast) \
SymX(mkApUpd0zh_fast) \
SymX(remIntegerzh_fast) \
SymX(resetNonBlockingFd) \
SymX(resumeThread) \
+ SymX(resolveObjs) \
SymX(rts_apply) \
SymX(rts_checkSchedStatus) \
SymX(rts_eval) \
SymX(stg_ap_pp_info) \
SymX(stg_ap_ppv_info) \
SymX(stg_ap_ppp_info) \
+ SymX(stg_ap_pppv_info) \
SymX(stg_ap_pppp_info) \
SymX(stg_ap_ppppp_info) \
SymX(stg_ap_pppppp_info) \
- SymX(stg_ap_ppppppp_info) \
- SymX(stg_ap_0_ret) \
- SymX(stg_ap_v_ret) \
- SymX(stg_ap_f_ret) \
- SymX(stg_ap_d_ret) \
- SymX(stg_ap_l_ret) \
- SymX(stg_ap_n_ret) \
- SymX(stg_ap_p_ret) \
- SymX(stg_ap_pv_ret) \
- SymX(stg_ap_pp_ret) \
- SymX(stg_ap_ppv_ret) \
- SymX(stg_ap_ppp_ret) \
- SymX(stg_ap_pppp_ret) \
- SymX(stg_ap_ppppp_ret) \
- SymX(stg_ap_pppppp_ret) \
- SymX(stg_ap_ppppppp_ret) \
SymX(stg_ap_1_upd_info) \
SymX(stg_ap_2_upd_info) \
SymX(stg_ap_3_upd_info) \
SymX(stg_ap_5_upd_info) \
SymX(stg_ap_6_upd_info) \
SymX(stg_ap_7_upd_info) \
- SymX(stg_ap_8_upd_info) \
SymX(stg_exit) \
SymX(stg_sel_0_upd_info) \
SymX(stg_sel_10_upd_info) \
SymX(tryPutMVarzh_fast) \
SymX(tryTakeMVarzh_fast) \
SymX(unblockAsyncExceptionszh_fast) \
+ SymX(unloadObj) \
SymX(unsafeThawArrayzh_fast) \
SymX(waitReadzh_fast) \
SymX(waitWritezh_fast) \
#define SymX(vvv) /**/
#define SymX_redirect(vvv,xxx) /**/
RTS_SYMBOLS
+RTS_RET_SYMBOLS
RTS_LONG_LONG_SYMS
RTS_POSIX_ONLY_SYMBOLS
RTS_MINGW_ONLY_SYMBOLS
/* fprintf(stderr, "loadObj %s\n", path ); */
- /* Check that we haven't already loaded this object. Don't give up
- at this stage; ocGetNames_* will barf later. */
+ /* Check that we haven't already loaded this object.
+ Ignore requests to load multiple times */
{
ObjectCode *o;
int is_dup = 0;
for (o = objects; o; o = o->next) {
- if (0 == strcmp(o->fileName, path))
+ if (0 == strcmp(o->fileName, path)) {
is_dup = 1;
+ break; /* don't need to search further */
+ }
}
if (is_dup) {
- fprintf(stderr,
- "\n\n"
+ IF_DEBUG(linker, belch(
"GHCi runtime linker: warning: looks like you're trying to load the\n"
"same object file twice:\n"
" %s\n"
- "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
- "\n"
- , path);
+ "GHCi will ignore this, but be warned.\n"
+ , path));
+ return 1; /* success */
}
}
- relocateAddress(oc, nSections, sections, pair->r_value));
i++;
}
- else
+ else if(scat->r_type == PPC_RELOC_HI16
+ || scat->r_type == PPC_RELOC_LO16
+ || scat->r_type == PPC_RELOC_HA16
+ || scat->r_type == PPC_RELOC_LO14)
+ { // these are generated by label+offset things
+ struct relocation_info *pair = &relocs[i+1];
+ if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
+ barf("Invalid Mach-O file: "
+ "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
+
+ if(scat->r_type == PPC_RELOC_LO16)
+ {
+ word = ((unsigned short*) wordPtr)[1];
+ word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
+ }
+ else if(scat->r_type == PPC_RELOC_LO14)
+ {
+ barf("Unsupported Relocation: PPC_RELOC_LO14");
+ word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
+ word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
+ }
+ else if(scat->r_type == PPC_RELOC_HI16)
+ {
+ word = ((unsigned short*) wordPtr)[1] << 16;
+ word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
+ }
+ else if(scat->r_type == PPC_RELOC_HA16)
+ {
+ word = ((unsigned short*) wordPtr)[1] << 16;
+ word += ((short)relocs[i+1].r_address & (short)0xFFFF);
+ }
+
+
+ word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
+ - scat->r_value;
+
+ i++;
+ }
+ else
continue; // ignore the others
if(scat->r_type == GENERIC_RELOC_VANILLA
{
*wordPtr = word;
}
- else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF)
+ else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
{
((unsigned short*) wordPtr)[1] = word & 0xFFFF;
}
- else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF)
+ else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
{
((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
}
- else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF)
+ else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
{
((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
+ ((word & (1<<15)) ? 1 : 0);
{
struct nlist *symbol = &nlist[reloc->r_symbolnum];
char *nm = image + symLC->stroff + symbol->n_un.n_strx;
- word = (unsigned long) (lookupSymbol(nm));
- if(!word)
+ unsigned long symbolAddress = (unsigned long) (lookupSymbol(nm));
+ if(!symbolAddress)
{
belch("\nunknown symbol `%s'", nm);
return 0;
}
if(reloc->r_pcrel)
- {
+ {
+ ASSERT(word == 0);
+ word = symbolAddress;
jumpIsland = (long) makeJumpIsland(oc,reloc->r_symbolnum,(void*)word);
word -= ((long)image) + sect->offset + reloc->r_address;
if(jumpIsland != 0)
- (((long)image) + sect->offset + reloc->r_address);
}
}
+ else
+ {
+ word += symbolAddress;
+ }
}
if(reloc->r_type == GENERIC_RELOC_VANILLA)
projects / ghc-hetmet.git / blobdiff