[project @ 2005-04-05 09:38:00 by simonmar]

Main x86_64 hacking: we have a problem on this arch where binutils
can't generate 64-bit relative relocations (R_X86_64_PC64), which many
of our info-table fields are.  So far we've been hacking around it by
putting everything in the text section, but I've decided to adopt
another approach: we'll use explicit 32-bit offset fields on this
platform instead.  This is safe in the default "small" memory model
where all symbols are guaranteed to be in the lower 2Gb of the address
space.

NCG changes coming; mangler changes are probably required too.

diff --git a/ghc/includes/InfoTables.h b/ghc/includes/InfoTables.h
index 148be67..ae3b2c2 100644 (file)
--- a/ghc/includes/InfoTables.h
+++ b/ghc/includes/InfoTables.h
@@ -210,6 +210,26 @@ typedef struct StgLargeSRT_ {
 } StgLargeSRT;
 
 /* ----------------------------------------------------------------------------
+   Relative pointers
+
+   Several pointer fields in info tables are expressed as offsets
+   relative to the info pointer, so that we can generate
+   position-independent code.
+
+   There is a complication on the x86_64 platform, where pointeres are
+   64 bits, but the tools don't support 64-bit relative relocations.
+   However, the default memory model (small) ensures that all symbols
+   have values in the lower 2Gb of the address space, so offsets all
+   fit in 32 bits.  Hence we can use 32-bit offset fields.
+   ------------------------------------------------------------------------- */
+
+#if x86_64_TARGET_ARCH
+#define OFFSET_FIELD(n) StgHalfInt n; StgHalfWord __pad_##n;
+#else   
+#define OFFSET_FIELD(n) StgInt n;
+#endif
+
+/* ----------------------------------------------------------------------------
    Info Tables
    ------------------------------------------------------------------------- */
 
@@ -230,7 +250,7 @@ typedef union {
 #ifndef TABLES_NEXT_TO_CODE
     StgLargeBitmap* large_bitmap; /* pointer to large bitmap structure */
 #else
-    StgWord large_bitmap_offset;  /* offset from info table to large bitmap structure */
+    OFFSET_FIELD( large_bitmap_offset );  /* offset from info table to large bitmap structure */
 #endif
     
     StgWord selector_offset;     /* used in THUNK_SELECTORs */
@@ -287,9 +307,12 @@ typedef struct _StgInfoTable {
    -------------------------------------------------------------------------- */
 
 typedef struct _StgFunInfoExtraRev {
-    StgWord        slow_apply_offset; /* apply to args on the stack */
-    StgWord        bitmap;     /* arg ptr/nonptr bitmap */
-    StgWord        srt_offset; /* pointer to the SRT table */
+    OFFSET_FIELD ( slow_apply_offset ); /* apply to args on the stack */
+    union { 
+       StgWord bitmap;
+       OFFSET_FIELD ( bitmap_offset ); /* arg ptr/nonptr bitmap */
+    } b;
+    OFFSET_FIELD ( srt_offset ); /* pointer to the SRT table */
     StgHalfWord    fun_type;    /* function type */
     StgHalfWord    arity;       /* function arity */
 } StgFunInfoExtraRev;
@@ -323,7 +346,7 @@ typedef struct {
 
 typedef struct {
 #if defined(TABLES_NEXT_TO_CODE)
-    StgWord      srt_offset;   /* offset to the SRT table */
+    OFFSET_FIELD( srt_offset );        /* offset to the SRT table */
     StgInfoTable i;
 #else
     StgInfoTable i;
@@ -346,7 +369,7 @@ typedef struct _StgThunkInfoTable {
     StgInfoTable i;
 #endif
 #if defined(TABLES_NEXT_TO_CODE)
-    StgWord        srt_offset; /* offset to the SRT table */
+    OFFSET_FIELD( srt_offset );        /* offset to the SRT table */
 #else
     StgSRT         *srt;       /* pointer to the SRT table */
 #endif
@@ -389,9 +412,9 @@ typedef struct _StgThunkInfoTable {
 
 #ifdef TABLES_NEXT_TO_CODE
 #define GET_FUN_LARGE_BITMAP(info) ((StgLargeBitmap*) (((StgWord) ((info)+1)) \
-                                        + (info)->f.bitmap))
+                                        + (info)->f.b.bitmap_offset))
 #else
-#define GET_FUN_LARGE_BITMAP(info) ((StgLargeBitmap*) ((info)->f.bitmap))
+#define GET_FUN_LARGE_BITMAP(info) ((StgLargeBitmap*) ((info)->f.b.bitmap_offset))
 #endif
 
 

diff --git a/ghc/includes/MachRegs.h b/ghc/includes/MachRegs.h
index e929579..9a18812 100644 (file)
--- a/ghc/includes/MachRegs.h
+++ b/ghc/includes/MachRegs.h
@@ -264,20 +264,41 @@
                callee-saves
   %rax
   %rbx         YES
-  %rcx
-  %rdx         (seem to be used as arg regs on x86-64)
-  %rsi         (seem to be used as arg regs on x86-64)
-  %rdi         (seem to be used as arg regs on x86-64)
-  %rbp         YES
+  %rcx          arg reg, caller-saves
+  %rdx         arg reg, caller-saves
+  %rsi         arg reg, caller-saves
+  %rdi         arg reg, caller-saves
+  %rbp         YES (our *prime* register)
   %rsp         (unavailable - stack pointer)
-  %r8
-  %r9
-  %r10
-  %r11         
+  %r8           arg reg, caller-saves
+  %r9          arg reg, caller-saves
+  %r10          caller-saves
+  %r11         caller-saves
   %r12         YES
   %r13         YES
   %r14         YES
   %r15         YES
+
+  %xmm0-7       arg regs, caller-saves
+  %xmm8-15      caller-saves
+
+  A better reg mapping might be:
+
+      %rbp  Sp
+      %rbx  R1
+      %r8   R2
+      %r9   R3
+      %r10  R4
+      %r12  Hp
+      %r14  SpLim
+      %r15  HpLim
+      %xmm8-11   F1-F4
+      %xmm12-13  D1-D2
+
+  Use the caller-saves regs for Rn, because we don't always have to
+  save those (as opposed to Sp/Hp/SpLim etc. which always have to be
+  saved).
+
   --------------------------------------------------------------------------- */
 
 #if x86_64_REGS

diff --git a/ghc/includes/StgTypes.h b/ghc/includes/StgTypes.h
index ae9eec5..393cf27 100644 (file)
--- a/ghc/includes/StgTypes.h
+++ b/ghc/includes/StgTypes.h
@@ -83,11 +83,13 @@ typedef unsigned __int64       StgWord64;
 #if SIZEOF_VOID_P == 8
 typedef StgInt64           StgInt;
 typedef StgWord64          StgWord;
+typedef StgInt32           StgHalfInt;
 typedef StgWord32          StgHalfWord;
 #else
 #if SIZEOF_VOID_P == 4
 typedef StgInt32           StgInt; 
 typedef StgWord32          StgWord;
+typedef StgInt16           StgHalfInt;
 typedef StgWord16          StgHalfWord;
 #else
 #error GHC untested on this architecture: sizeof(void *) != 4 or 8

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index aacef6b..ea88b21 100644 (file)
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -434,7 +434,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
          bitmap_size = stp->n_blocks * BLOCK_SIZE / (sizeof(W_)*BITS_PER_BYTE);
 
          if (bitmap_size > 0) {
-             bitmap_bdescr = allocGroup((nat)BLOCK_ROUND_UP(bitmap_size) 
+             bitmap_bdescr = allocGroup((lnat)BLOCK_ROUND_UP(bitmap_size) 
                                         / BLOCK_SIZE);
              stp->bitmap = bitmap_bdescr;
              bitmap = bitmap_bdescr->start;
@@ -2352,8 +2352,8 @@ scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
     p = (StgPtr)args;
     switch (fun_info->f.fun_type) {
     case ARG_GEN:
-       bitmap = BITMAP_BITS(fun_info->f.bitmap);
-       size = BITMAP_SIZE(fun_info->f.bitmap);
+       bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
+       size = BITMAP_SIZE(fun_info->f.b.bitmap);
        goto small_bitmap;
     case ARG_GEN_BIG:
        size = GET_FUN_LARGE_BITMAP(fun_info)->size;
@@ -2393,7 +2393,7 @@ scavenge_PAP (StgPAP *pap)
 
     switch (fun_info->f.fun_type) {
     case ARG_GEN:
-       bitmap = BITMAP_BITS(fun_info->f.bitmap);
+       bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
        goto small_bitmap;
     case ARG_GEN_BIG:
        scavenge_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);

diff --git a/ghc/rts/GCCompact.c b/ghc/rts/GCCompact.c
index 30836e3..c6a8f6e 100644 (file)
--- a/ghc/rts/GCCompact.c
+++ b/ghc/rts/GCCompact.c
@@ -223,8 +223,8 @@ thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
     p = (StgPtr)args;
     switch (fun_info->f.fun_type) {
     case ARG_GEN:
-       bitmap = BITMAP_BITS(fun_info->f.bitmap);
-       size = BITMAP_SIZE(fun_info->f.bitmap);
+       bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
+       size = BITMAP_SIZE(fun_info->f.b.bitmap);
        goto small_bitmap;
     case ARG_GEN_BIG:
        size = GET_FUN_LARGE_BITMAP(fun_info)->size;
@@ -379,7 +379,7 @@ thread_PAP (StgPAP *pap)
 
     switch (fun_info->f.fun_type) {
     case ARG_GEN:
-       bitmap = BITMAP_BITS(fun_info->f.bitmap);
+       bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
        goto small_bitmap;
     case ARG_GEN_BIG:
        thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);

diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c
index 0ed5a32..d5c9386 100644 (file)
--- a/ghc/rts/Printer.c
+++ b/ghc/rts/Printer.c
@@ -322,18 +322,18 @@ printClosure( StgClosure *obj )
                 putchar(arrWordsGetChar(obj,i));
                } */
            for (i=0; i<((StgArrWords *)obj)->words; i++)
-             debugBelch("%u", ((StgArrWords *)obj)->payload[i]);
+             debugBelch("%lu", ((StgArrWords *)obj)->payload[i]);
             debugBelch("\")\n");
             break;
         }
 
     case MUT_ARR_PTRS:
-       debugBelch("MUT_ARR_PTRS(size=%d)\n", ((StgMutArrPtrs *)obj)->ptrs);
+       debugBelch("MUT_ARR_PTRS(size=%ld)\n", ((StgMutArrPtrs *)obj)->ptrs);
        break;
 
     case MUT_ARR_PTRS_FROZEN:
 #if !defined(XMLAMBDA)
-       debugBelch("MUT_ARR_PTRS_FROZEN(size=%d)\n", ((StgMutArrPtrs *)obj)->ptrs);
+       debugBelch("MUT_ARR_PTRS_FROZEN(size=%ld)\n", ((StgMutArrPtrs *)obj)->ptrs);
        break;
 #else
           {
@@ -382,7 +382,7 @@ printClosure( StgClosure *obj )
             break;
 
     case STABLE_NAME:
-            debugBelch("STABLE_NAME(%d)\n", ((StgStableName*)obj)->sn); 
+            debugBelch("STABLE_NAME(%ld)\n", ((StgStableName*)obj)->sn); 
             break;
 
     case TSO:
@@ -499,12 +499,12 @@ printSmallBitmap( StgPtr spBottom, StgPtr payload, StgWord bitmap, nat size )
 
     p = payload;
     for(i = 0; i < size; i++, bitmap >>= 1 ) {
-       debugBelch("   stk[%d] (%p) = ", spBottom-(payload+i), payload+i);
+       debugBelch("   stk[%ld] (%p) = ", spBottom-(payload+i), payload+i);
        if ((bitmap & 1) == 0) {
            printPtr((P_)payload[i]);
            debugBelch("\n");
        } else {
-           debugBelch("Word# %d\n", payload[i]);
+           debugBelch("Word# %ld\n", payload[i]);
        }
     }
 }
@@ -520,12 +520,12 @@ printLargeBitmap( StgPtr spBottom, StgPtr payload, StgLargeBitmap* large_bitmap,
        StgWord bitmap = large_bitmap->bitmap[bmp];
        j = 0;
        for(; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1 ) {
-           debugBelch("   stk[%d] (%p) = ", spBottom-(payload+i), payload+i);
+           debugBelch("   stk[%ld] (%p) = ", spBottom-(payload+i), payload+i);
            if ((bitmap & 1) == 0) {
                printPtr((P_)payload[i]);
                debugBelch("\n");
            } else {
-               debugBelch("Word# %d\n", payload[i]);
+               debugBelch("Word# %ld\n", payload[i]);
            }
        }
     }
@@ -617,8 +617,8 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
            switch (fun_info->f.fun_type) {
            case ARG_GEN:
                printSmallBitmap(spBottom, sp+1,
-                                BITMAP_BITS(fun_info->f.bitmap),
-                                BITMAP_SIZE(fun_info->f.bitmap));
+                                BITMAP_BITS(fun_info->f.b.bitmap),
+                                BITMAP_SIZE(fun_info->f.b.bitmap));
                break;
            case ARG_GEN_BIG:
                printLargeBitmap(spBottom, sp+2,

diff --git a/ghc/rts/RetainerProfile.c b/ghc/rts/RetainerProfile.c
index 2461948..10bed44 100644 (file)
--- a/ghc/rts/RetainerProfile.c
+++ b/ghc/rts/RetainerProfile.c
@@ -1375,8 +1375,8 @@ retainStack( StgClosure *c, retainer c_child_r,
            p = (P_)&ret_fun->payload;
            switch (fun_info->f.fun_type) {
            case ARG_GEN:
-               bitmap = BITMAP_BITS(fun_info->f.bitmap);
-               size = BITMAP_SIZE(fun_info->f.bitmap);
+               bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
+               size = BITMAP_SIZE(fun_info->f.b.bitmap);
                p = retain_small_bitmap(p, size, bitmap, c, c_child_r);
                break;
            case ARG_GEN_BIG:
@@ -1431,7 +1431,7 @@ retain_PAP (StgPAP *pap, retainer c_child_r)
 
     switch (fun_info->f.fun_type) {
     case ARG_GEN:
-       bitmap = BITMAP_BITS(fun_info->f.bitmap);
+       bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
        p = retain_small_bitmap(p, pap->n_args, bitmap, 
                                (StgClosure *)pap, c_child_r);
        break;

diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c
index a8f1f56..7bc2f83 100644 (file)
--- a/ghc/rts/Sanity.c
+++ b/ghc/rts/Sanity.c
@@ -169,7 +169,7 @@ checkStackFrame( StgPtr c )
        switch (fun_info->f.fun_type) {
        case ARG_GEN:
            checkSmallBitmap((StgPtr)ret_fun->payload, 
-                            BITMAP_BITS(fun_info->f.bitmap), size);
+                            BITMAP_BITS(fun_info->f.b.bitmap), size);
            break;
        case ARG_GEN_BIG:
            checkLargeBitmap((StgPtr)ret_fun->payload,
@@ -361,7 +361,7 @@ checkClosure( StgClosure* p )
            switch (fun_info->f.fun_type) {
            case ARG_GEN:
                checkSmallBitmap( (StgPtr)pap->payload, 
-                                 BITMAP_BITS(fun_info->f.bitmap), pap->n_args );
+                                 BITMAP_BITS(fun_info->f.b.bitmap), pap->n_args );
                break;
            case ARG_GEN_BIG:
                checkLargeBitmap( (StgPtr)pap->payload, 

diff --git a/ghc/rts/Stable.c b/ghc/rts/Stable.c
index a2b1136..eadfa68 100644 (file)
--- a/ghc/rts/Stable.c
+++ b/ghc/rts/Stable.c
@@ -179,7 +179,7 @@ lookupStableName(StgPtr p)
   
   if (sn != 0) {
     ASSERT(stable_ptr_table[sn].addr == p);
-    IF_DEBUG(stable,debugBelch("cached stable name %d at %p\n",sn,p));
+    IF_DEBUG(stable,debugBelch("cached stable name %ld at %p\n",sn,p));
     return sn;
   } else {
     sn = stable_ptr_free - stable_ptr_table;
@@ -372,13 +372,13 @@ gcStablePtrTable( void )
                if (p->sn_obj == NULL) {
                    // StableName object is dead
                    freeStableName(p);
-                   IF_DEBUG(stable, debugBelch("GC'd Stable name %d\n", 
+                   IF_DEBUG(stable, debugBelch("GC'd Stable name %ld\n", 
                                                p - stable_ptr_table));
                    continue;
                    
                } else {
                  p->addr = (StgPtr)isAlive((StgClosure *)p->addr);
-                   IF_DEBUG(stable, debugBelch("Stable name %d still alive at %p, ref %d\n", p - stable_ptr_table, p->addr, p->ref));
+                   IF_DEBUG(stable, debugBelch("Stable name %ld still alive at %p, ref %ld\n", p - stable_ptr_table, p->addr, p->ref));
                }
            }
        }