Have configure take arguments telling it where gmp is; fixes trac #957

[ghc-hetmet.git] / rts / Interpreter.c

diff --git a/rts/Interpreter.c b/rts/Interpreter.c
index 81d4e38..62fd2c2 100644 (file)
--- a/rts/Interpreter.c
+++ b/rts/Interpreter.c
@@ -12,7 +12,6 @@
 #include "TSO.h"
 #include "Schedule.h"
 #include "RtsFlags.h"
-#include "Storage.h"
 #include "LdvProfile.h"
 #include "Updates.h"
 #include "Sanity.h"
@@ -42,9 +41,19 @@
 /* Sp points to the lowest live word on the stack. */
 
 #define BCO_NEXT      instrs[bciPtr++]
+#define BCO_NEXT_32   (bciPtr += 2, (((StgWord) instrs[bciPtr-2]) << 16) + ((StgWord) instrs[bciPtr-1]))
+#define BCO_NEXT_64   (bciPtr += 4, (((StgWord) instrs[bciPtr-4]) << 48) + (((StgWord) instrs[bciPtr-3]) << 32) + (((StgWord) instrs[bciPtr-2]) << 16) + ((StgWord) instrs[bciPtr-1]))
+#if WORD_SIZE_IN_BITS == 32
+#define BCO_NEXT_WORD BCO_NEXT_32
+#elif WORD_SIZE_IN_BITS == 64
+#define BCO_NEXT_WORD BCO_NEXT_64
+#else
+#error Cannot cope with WORD_SIZE_IN_BITS being nether 32 nor 64
+#endif
+#define BCO_GET_LARGE_ARG ((bci & bci_FLAG_LARGE_ARGS) ? BCO_NEXT_WORD : BCO_NEXT)
+
 #define BCO_PTR(n)    (W_)ptrs[n]
 #define BCO_LIT(n)    literals[n]
-#define BCO_ITBL(n)   itbls[n]
 
 #define LOAD_STACK_POINTERS                                    \
     Sp = cap->r.rCurrentTSO->sp;                               \
@@ -714,12 +723,11 @@ run_BCO:
     INTERP_TICK(it_BCO_entries);
     {
        register int       bciPtr     = 1; /* instruction pointer */
+    register StgWord16 bci;
        register StgBCO*   bco        = (StgBCO*)obj;
        register StgWord16* instrs    = (StgWord16*)(bco->instrs->payload);
        register StgWord*  literals   = (StgWord*)(&bco->literals->payload[0]);
        register StgPtr*   ptrs       = (StgPtr*)(&bco->ptrs->payload[0]);
-       register StgInfoTable** itbls = (StgInfoTable**)
-           (&bco->itbls->payload[0]);
 
 #ifdef INTERP_STATS
        it_lastopc = 0; /* no opcode */
@@ -754,13 +762,18 @@ run_BCO:
        it_lastopc = (int)instrs[bciPtr];
 #endif
 
-       switch (BCO_NEXT) {
+       bci = BCO_NEXT;
+    /* We use the high 8 bits for flags, only the highest of which is
+     * currently allocated */
+    ASSERT((bci & 0xFF00) == (bci & 0x8000));
+
+    switch (bci & 0xFF) {
 
        case bci_STKCHECK: {
            // Explicit stack check at the beginning of a function
            // *only* (stack checks in case alternatives are
            // propagated to the enclosing function).
-           int stk_words_reqd = BCO_NEXT + 1;
+           StgWord stk_words_reqd = BCO_GET_LARGE_ARG + 1;
            if (Sp - stk_words_reqd < SpLim) {
                Sp -= 2; 
                Sp[1] = (W_)obj; 
@@ -1002,12 +1015,12 @@ run_BCO:
            int i;
            int o_itbl         = BCO_NEXT;
            int n_words        = BCO_NEXT;
-           StgInfoTable* itbl = INFO_PTR_TO_STRUCT(BCO_ITBL(o_itbl));
+           StgInfoTable* itbl = INFO_PTR_TO_STRUCT(BCO_LIT(o_itbl));
            int request        = CONSTR_sizeW( itbl->layout.payload.ptrs, 
                                               itbl->layout.payload.nptrs );
            StgClosure* con = (StgClosure*)allocate_NONUPD(request);
            ASSERT( itbl->layout.payload.ptrs + itbl->layout.payload.nptrs > 0);
-           SET_HDR(con, BCO_ITBL(o_itbl), CCS_SYSTEM/*ToDo*/);
+           SET_HDR(con, (StgInfoTable*)BCO_LIT(o_itbl), CCS_SYSTEM/*ToDo*/);
            for (i = 0; i < n_words; i++) {
                con->payload[i] = (StgClosure*)Sp[i];
            }
@@ -1249,7 +1262,8 @@ run_BCO:
            
            // Errors
        default: 
-           barf("interpretBCO: unknown or unimplemented opcode");
+           barf("interpretBCO: unknown or unimplemented opcode %d",
+                 (int)BCO_NEXT);
 
        } /* switch on opcode */
     }