1/*
2    Title:  An interpreter for a compact instruction set.
3    Author:     Dave Matthews, Cambridge University Computer Laboratory
4
5    Copyright (c) 2000-7
6        Cambridge University Technical Services Limited
7    Further development Copyright David C.J. Matthews 2015-18, 2020.
8
9    This library is free software; you can redistribute it and/or
10    modify it under the terms of the GNU Lesser General Public
11    License version 2.1 as published by the Free Software Foundation.
12
13    This library is distributed in the hope that it will be useful,
14    but WITHOUT ANY WARRANTY; without even the implied warranty of
15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16    Lesser General Public License for more details.
17
18    You should have received a copy of the GNU Lesser General Public
19    License along with this library; if not, write to the Free Software
20    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
21
22*/
23
24#ifdef HAVE_CONFIG_H
25#include "config.h"
26#elif defined(_WIN32)
27#include "winconfig.h"
28#else
29#error "No configuration file"
30#endif
31
32#ifdef HAVE_STDIO_H
33#include <stdio.h>
34#endif
35
36#ifdef HAVE_ASSERT_H
37#include <assert.h>
38#define ASSERT(x) assert(x)
39#else
40#define ASSERT(x) 0
41#endif
42
43#ifdef HAVE_STRING_H
44#include <string.h>
45#endif
46
47#ifdef HAVE_FLOAT_H
48#include <float.h>
49#endif
50
51#ifdef HAVE_MATH_H
52#include <math.h>
53#endif
54
55#include <cmath> // Currently just for isnan.
56
57#include "globals.h"
58#include "int_opcodes.h"
59#include "machine_dep.h"
60#include "sys.h"
61#include "profiling.h"
62#include "arb.h"
63#include "reals.h"
64#include "processes.h"
65#include "run_time.h"
66#include "gc.h"
67#include "diagnostics.h"
68#include "polystring.h"
69#include "save_vec.h"
70#include "memmgr.h"
71#include "scanaddrs.h"
72#include "rtsentry.h"
73
74#if (SIZEOF_VOIDP == 8 && !defined(POLYML32IN64))
75#define IS64BITS 1
76#endif
77
78
79#define arg1    (pc[0] + pc[1]*256)
80#define arg2    (pc[2] + pc[3]*256)
81
82const PolyWord True = TAGGED(1);
83const PolyWord False = TAGGED(0);
84const PolyWord Zero = TAGGED(0);
85
86#define CHECKED_REGS 2
87#define UNCHECKED_REGS 0
88
89#define EXTRA_STACK 0 // Don't need any extra - signals aren't handled on the Poly stack.
90
91/* the amount of ML stack space to reserve for registers,
92   C exception handling etc. The compiler requires us to
93   reserve 2 stack-frames worth (2 * 20 words) plus whatever
94   we require for the register save area. We actually reserve
95   slightly more than this. SPF 3/3/97
96*/
97#define OVERFLOW_STACK_SIZE \
98  (50 + \
99   CHECKED_REGS + \
100   UNCHECKED_REGS + \
101   EXTRA_STACK)
102
103
104// This duplicates some code in reals.cpp but is now updated.
105#define DOUBLESIZE (sizeof(double)/sizeof(POLYUNSIGNED))
106
107union realdb { double dble; POLYUNSIGNED puns[DOUBLESIZE]; };
108
109#define LGWORDSIZE (sizeof(uintptr_t) / sizeof(PolyWord))
110
111// We're using float for Real32 so it needs to be 32-bits.
112// Assume that's true for the moment.
113#if (SIZEOF_FLOAT != 4)
114#error "Float is not 32-bits.  Please report this"
115#endif
116
117union flt { float fl; int32_t i; };
118
119class IntTaskData: public TaskData {
120public:
121    IntTaskData();
122    ~IntTaskData();
123
124    virtual void GarbageCollect(ScanAddress *process);
125    void ScanStackAddress(ScanAddress *process, stackItem& val, StackSpace *stack);
126    virtual void EnterPolyCode(); // Start running ML
127
128    // Switch to Poly and return with the io function to call.
129    int SwitchToPoly();
130    virtual void SetException(poly_exn *exc);
131    virtual void InterruptCode();
132
133    // AddTimeProfileCount is used in time profiling.
134    virtual bool AddTimeProfileCount(SIGNALCONTEXT *context);
135
136    virtual void InitStackFrame(TaskData *newTask, Handle proc, Handle arg);
137
138    // Increment or decrement the first word of the object pointed to by the
139    // mutex argument and return the new value.
140    virtual Handle AtomicDecrement(Handle mutexp);
141    // Set a mutex to zero.
142    virtual void AtomicReset(Handle mutexp);
143
144    // Return the minimum space occupied by the stack.   Used when setting a limit.
145    virtual uintptr_t currentStackSpace(void) const { return ((stackItem*)this->stack->top - this->taskSp) + OVERFLOW_STACK_SIZE; }
146
147    virtual void addProfileCount(POLYUNSIGNED words) { addSynchronousCount(taskPc, words); }
148
149    virtual void CopyStackFrame(StackObject *old_stack, uintptr_t old_length, StackObject *new_stack, uintptr_t new_length);
150
151    bool interrupt_requested;
152
153    // Allocate memory on the heap.  Returns with the address of the cell. Does not set the
154    // length word or any of the data.
155    PolyObject *allocateMemory(POLYUNSIGNED words, POLYCODEPTR &pc, stackItem *&sp)
156    {
157        words++; // Add the size of the length word.
158        // N.B. The allocation area may be empty so that both of these are zero.
159        if (this->allocPointer >= this->allocLimit + words + 1)
160        {
161#ifdef POLYML32IN64
162            if (words & 1) words++;
163#endif
164            this->allocPointer -= words;
165            return (PolyObject *)(this->allocPointer+1);
166        }
167        // Insufficient space.
168        SaveInterpreterState(pc, sp);
169        // Find some space to allocate in. Returns a pointer to the newly allocated space.
170        // N.B. This may return zero if the heap is exhausted and it has set this
171        // up for an exception.  Generally it allocates by decrementing allocPointer
172        // but if the required memory is large it may allocate in a separate area.
173        PolyWord *space = processes->FindAllocationSpace(this, words, true);
174        LoadInterpreterState(pc, sp);
175        if (space == 0) return 0;
176        return (PolyObject *)(space+1);
177    }
178
179    // Put a real result in a "box"
180    PolyObject *boxDouble(double d, POLYCODEPTR &pc, stackItem*&sp)
181    {
182        PolyObject *mem = this->allocateMemory(DOUBLESIZE, pc, sp);
183        if (mem == 0) return 0;
184        mem->SetLengthWord(DOUBLESIZE, F_BYTE_OBJ);
185        union realdb uniondb;
186        uniondb.dble = d;
187        // Copy the words.  Depending on the word length this may copy one or more words.
188        for (unsigned i = 0; i < DOUBLESIZE; i++)
189            mem->Set(i, PolyWord::FromUnsigned(uniondb.puns[i]));
190        return mem;
191    }
192
193    // Extract a double value from a box.
194    double unboxDouble(PolyWord p)
195    {
196        union realdb uniondb;
197        for (unsigned i = 0; i < DOUBLESIZE; i++)
198            uniondb.puns[i] = p.AsObjPtr()->Get(i).AsUnsigned();
199        return uniondb.dble;
200    }
201
202    // Largely copied from reals.cpp
203
204#if (SIZEOF_FLOAT < SIZEOF_POLYWORD)
205
206    // Typically for 64-bit mode.  Use a tagged representation.
207    // The code-generator on the X86/64 assumes the float is in the
208    // high order word.
209#define FLT_SHIFT ((SIZEOF_POLYWORD-SIZEOF_FLOAT)*8)
210    float unboxFloat(PolyWord p)
211    {
212        union flt argx;
213        argx.i = p.AsSigned() >> FLT_SHIFT;
214        return argx.fl;
215    }
216
217    PolyObject *boxFloat(float f, POLYCODEPTR &pc, stackItem*&sp)
218    {
219        union flt argx;
220        argx.fl = f;
221        PolyWord p = PolyWord::FromSigned(((POLYSIGNED)argx.i << FLT_SHIFT) + 1);
222        return p.AsObjPtr(); // Temporarily cast it to this even though it isn't really
223    }
224#else
225    // Typically for 32-bit mode.  Use a boxed representation.
226    PolyObject *boxFloat(float f, POLYCODEPTR &pc, stackItem*&sp)
227    {
228        PolyObject *mem = this->allocateMemory(1, pc, sp);
229        if (mem == 0) return 0;
230        mem->SetLengthWord(1, F_BYTE_OBJ);
231        union flt argx;
232        argx.fl = f;
233        mem->Set(0, PolyWord::FromSigned(argx.i));
234        return mem;
235    }
236
237    // Extract a double value from a box.
238    float unboxFloat(PolyWord p)
239    {
240        union flt argx;
241        argx.i = (int32_t)p.AsObjPtr()->Get(0).AsSigned();
242        return argx.fl;
243    }
244
245#endif
246
247    // Update the copies in the task object
248    void SaveInterpreterState(POLYCODEPTR pc, stackItem*sp)
249    {
250        taskPc = pc;
251        taskSp = sp;
252    }
253
254    // Update the local state
255    void LoadInterpreterState(POLYCODEPTR &pc, stackItem*&sp)
256    {
257        pc = taskPc;
258        sp = taskSp;
259    }
260
261    POLYCODEPTR     taskPc; /* Program counter. */
262    stackItem       *taskSp; /* Stack pointer. */
263    stackItem       *hr;
264    stackItem       exception_arg;
265    bool            raiseException;
266    stackItem       *sl; /* Stack limit register. */
267
268    PolyObject      *overflowPacket, *dividePacket;
269
270#ifdef PROFILEOPCODES
271    unsigned frequency[256], arg1Value[256], arg2Value[256];
272#endif
273};
274
275IntTaskData::IntTaskData() : interrupt_requested(false), overflowPacket(0), dividePacket(0)
276{
277#ifdef PROFILEOPCODES
278    memset(frequency, 0, sizeof(frequency));
279    memset(arg1Value, 0, sizeof(arg1Value));
280    memset(arg2Value, 0, sizeof(arg2Value));
281#endif
282}
283
284IntTaskData::~IntTaskData()
285{
286#ifdef PROFILEOPCODES
287    OutputDebugStringA("Frequency\n");
288    for (unsigned i = 0; i < 256; i++)
289    {
290        if (frequency[i] != 0)
291        {
292            char buffer[100];
293            sprintf(buffer, "%02X: %u\n", i, frequency[i]);
294            OutputDebugStringA(buffer);
295        }
296    }
297    OutputDebugStringA("Arg1\n");
298    for (unsigned i = 0; i < 256; i++)
299    {
300        if (arg1Value[i] != 0)
301        {
302            char buffer[100];
303            sprintf(buffer, "%02X: %u\n", i, arg1Value[i]);
304            OutputDebugStringA(buffer);
305        }
306    }
307    OutputDebugStringA("Arg2\n");
308    for (unsigned i = 0; i < 256; i++)
309    {
310        if (arg2Value[i] != 0)
311        {
312            char buffer[100];
313            sprintf(buffer, "%02X: %u\n", i, arg2Value[i]);
314            OutputDebugStringA(buffer);
315        }
316    }
317#endif
318}
319
320// This lock is used to synchronise all atomic operations.
321// It is not needed in the X86 version because that can use a global
322// memory lock.
323static PLock mutexLock;
324
325// Special value for return address.
326#define SPECIAL_PC_END_THREAD           ((POLYCODEPTR)0)
327
328class Interpreter : public MachineDependent {
329public:
330    Interpreter() {}
331
332    // Create a task data object.
333    virtual TaskData *CreateTaskData(void) { return new IntTaskData(); }
334    virtual Architectures MachineArchitecture(void) { return MA_Interpreted; }
335};
336
337void IntTaskData::InitStackFrame(TaskData *parentTask, Handle proc, Handle arg)
338/* Initialise stack frame. */
339{
340    StackSpace *space = this->stack;
341    StackObject *stack = (StackObject *)space->stack();
342    PolyObject *closure = DEREFWORDHANDLE(proc);
343    uintptr_t stack_size = space->spaceSize() * sizeof(PolyWord) / sizeof(stackItem);
344    this->taskPc = *(POLYCODEPTR*)closure;
345
346    this->exception_arg = TAGGED(0); /* Used for exception argument. */
347    this->taskSp = (stackItem*)stack + stack_size;
348    this->raiseException = false;
349
350    /* Set up exception handler */
351    /* No previous handler so point it at itself. */
352    this->taskSp--;
353    this->taskSp->stackAddr = this->taskSp;
354    (--this->taskSp)->codeAddr = SPECIAL_PC_END_THREAD; /* Default return address. */
355    this->hr = this->taskSp;
356
357    /* If this function takes an argument store it on the stack. */
358    if (arg != 0) *(--this->taskSp) = DEREFWORD(arg);
359
360    (*(--this->taskSp)).codeAddr = SPECIAL_PC_END_THREAD; /* Return address. */
361    *(--this->taskSp) = (PolyWord)closure; /* Closure address */
362
363    // Make packets for exceptions.
364    overflowPacket = makeExceptionPacket(parentTask, EXC_overflow);
365    dividePacket = makeExceptionPacket(parentTask, EXC_divide);
366}
367
368extern "C" {
369    typedef POLYUNSIGNED(*callFastRts0)();
370    typedef POLYUNSIGNED(*callFastRts1)(intptr_t);
371    typedef POLYUNSIGNED(*callFastRts2)(intptr_t, intptr_t);
372    typedef POLYUNSIGNED(*callFastRts3)(intptr_t, intptr_t, intptr_t);
373    typedef POLYUNSIGNED(*callFastRts4)(intptr_t, intptr_t, intptr_t, intptr_t);
374    typedef POLYUNSIGNED(*callFastRts5)(intptr_t, intptr_t, intptr_t, intptr_t, intptr_t);
375    typedef POLYUNSIGNED(*callFullRts0)(PolyObject *);
376    typedef POLYUNSIGNED(*callFullRts1)(PolyObject *, intptr_t);
377    typedef POLYUNSIGNED(*callFullRts2)(PolyObject *, intptr_t, intptr_t);
378    typedef POLYUNSIGNED(*callFullRts3)(PolyObject *, intptr_t, intptr_t, intptr_t);
379    typedef double (*callRTSRtoR) (double);
380    typedef double (*callRTSRRtoR) (double, double);
381    typedef double (*callRTSGtoR) (intptr_t);
382    typedef double (*callRTSRGtoR) (double, intptr_t);
383    typedef float(*callRTSFtoF) (float);
384    typedef float(*callRTSFFtoF) (float, float);
385    typedef float(*callRTSGtoF) (intptr_t);
386    typedef float(*callRTSFGtoF) (float, intptr_t);
387}
388
389void IntTaskData::InterruptCode()
390/* Stop the Poly code at a suitable place. */
391/* We may get an asynchronous interrupt at any time. */
392{
393    IntTaskData *itd = (IntTaskData *)this;
394    itd->interrupt_requested = true;
395}
396
397
398void IntTaskData::SetException(poly_exn *exc)
399/* Set up the stack of a process to raise an exception. */
400{
401    this->raiseException = true;
402    *(--this->taskSp) = (PolyWord)exc; /* push exception data */
403}
404
405int IntTaskData::SwitchToPoly()
406/* (Re)-enter the Poly code from C. */
407{
408    // Local values.  These are copies of member variables but are used so frequently that
409    // it is important that access should be fast.
410    POLYCODEPTR     pc;
411    stackItem*sp;
412
413    LoadInterpreterState(pc, sp);
414
415    sl = (stackItem*)((PolyWord*)this->stack->stack() + OVERFLOW_STACK_SIZE);
416
417    // We may have taken an interrupt which has set an exception.
418    if (this->raiseException) goto RAISE_EXCEPTION;
419
420    for(;;){ /* Each instruction */
421#if (0)
422        char buff[1000];
423        sprintf(buff, "addr = %p sp=%p instr=%02x *sp=%p\n", pc, sp, *pc, (*sp).stackAddr);
424        OutputDebugStringA(buff);
425#endif
426        // These are temporary values used where one instruction jumps to
427        // common code.
428        POLYUNSIGNED    tailCount;
429        stackItem*      tailPtr;
430        POLYUNSIGNED    returnCount;
431        POLYUNSIGNED    storeWords;
432        POLYUNSIGNED    stackCheck;
433        PolyObject      *closure;
434        double          dv;
435
436#ifdef PROFILEOPCODES
437        frequency[*pc]++;
438#endif
439        switch(*pc++) {
440
441        case INSTR_jump8false:
442        {
443            PolyWord u = *sp++;
444            if (u == True) pc += 1;
445            else pc += *pc + 1;
446            break;
447        }
448
449        case INSTR_jump8: pc += *pc + 1; break;
450
451        case INSTR_jump8True:
452        {
453            PolyWord u = *sp++;
454            if (u == False) pc += 1;
455            else pc += *pc + 1;
456            break;
457        }
458
459        case INSTR_jump16True:
460            // Invert the sense of the test and fall through.
461            *sp = ((*sp).w() == True) ? False : True;
462
463        case INSTR_jump16false:
464        {
465            PolyWord u = *sp++; /* Pop argument */
466            if (u == True) { pc += 2; break; }
467            /* else - false - take the jump */
468        }
469
470        case INSTR_jump16:
471            pc += arg1 + 2; break;
472
473        case INSTR_push_handler: /* Save the old handler value. */
474            (*(--sp)).stackAddr = this->hr; /* Push old handler */
475            break;
476
477        case INSTR_setHandler8: /* Set up a handler */
478            (*(--sp)).codeAddr = pc + *pc + 1; /* Address of handler */
479            this->hr = sp;
480            pc += 1;
481            break;
482
483        case INSTR_setHandler16: /* Set up a handler */
484            (*(--sp)).codeAddr = pc + arg1 + 2; /* Address of handler */
485            this->hr = sp;
486            pc += 2;
487            break;
488
489        case INSTR_deleteHandler: /* Delete handler retaining the result. */
490        {
491            stackItem u = *sp++;
492            sp = this->hr;
493            sp++; // Remove handler entry point
494            this->hr = (*sp).stackAddr; // Restore old handler
495            *sp = u; // Put back the result
496            break;
497        }
498
499        case INSTR_case16:
500            {
501                // arg1 is the largest value that is in the range
502                POLYSIGNED u = UNTAGGED(*sp++); /* Get the value */
503                if (u >= arg1 || u < 0) pc += 2 + arg1*2; /* Out of range */
504                else {
505                    pc += 2;
506                    pc += /* Index */pc[u*2]+pc[u*2 + 1]*256; }
507                break;
508            }
509
510
511        case INSTR_tail_3_bLegacy:
512           tailCount = 3;
513           tailPtr = sp + tailCount;
514           sp = tailPtr + *pc;
515           goto TAIL_CALL;
516
517        case INSTR_tail_3_2Legacy:
518           tailCount = 3;
519           tailPtr = sp + tailCount;
520           sp = tailPtr + 2;
521           goto TAIL_CALL;
522
523        case INSTR_tail_3_3Legacy:
524           tailCount = 3;
525           tailPtr = sp + tailCount;
526           sp = tailPtr + 3;
527           goto TAIL_CALL;
528
529        case INSTR_tail_4_bLegacy:
530           tailCount = 4;
531           tailPtr = sp + tailCount;
532           sp = tailPtr + *pc;
533           goto TAIL_CALL;
534
535        case INSTR_tail_b_b:
536           tailCount = *pc;
537           tailPtr = sp + tailCount;
538           sp = tailPtr + pc[1];
539       TAIL_CALL: /* For general case. */
540           if (tailCount < 2) Crash("Invalid argument\n");
541           for (; tailCount > 0; tailCount--) *(--sp) = *(--tailPtr);
542           pc = (*sp++).codeAddr; /* Pop the original return address. */
543           closure = (*sp++).w().AsObjPtr();
544           goto CALL_CLOSURE; /* And drop through. */
545
546        case INSTR_call_closure: /* Closure call. */
547        {
548            closure = (*sp++).w().AsObjPtr();
549            CALL_CLOSURE:
550            (--sp)->codeAddr = pc; /* Save return address. */
551            *(--sp) = (PolyWord)closure;
552            pc = *(POLYCODEPTR*)closure;    /* Get entry point. */
553            this->taskPc = pc; // Update in case we're profiling
554            // Check that there at least 128 words on the stack
555            stackCheck = 128;
556            goto STACKCHECK;
557        }
558
559        case INSTR_callConstAddr8:
560            closure = (*(PolyWord*)(pc + pc[0] + 1)).AsObjPtr(); pc += 1; goto CALL_CLOSURE;
561
562        case INSTR_callConstAddr16:
563            closure = (*(PolyWord*)(pc + arg1 + 2)).AsObjPtr(); pc += 2; goto CALL_CLOSURE;
564
565        case INSTR_callLocalB:
566        {
567            closure = (sp[*pc++]).w().AsObjPtr();
568            goto CALL_CLOSURE;
569        }
570
571        case INSTR_return_w:
572            returnCount = arg1; /* Get no. of args to remove. */
573
574            RETURN: /* Common code for return. */
575            {
576                stackItem result = *sp++; /* Result */
577                sp++; /* Remove the link/closure */
578                pc = (*sp++).codeAddr; /* Return address */
579                sp += returnCount; /* Add on number of args. */
580                if (pc == SPECIAL_PC_END_THREAD)
581                    exitThread(this); // This thread is exiting.
582                *(--sp) = result; /* Result */
583                this->taskPc = pc; // Update in case we're profiling
584            }
585            break;
586
587        case INSTR_return_b: returnCount = *pc; goto RETURN;
588        case INSTR_return_0Legacy: returnCount = 0; goto RETURN;
589        case INSTR_return_1: returnCount = 1; goto RETURN;
590        case INSTR_return_2: returnCount = 2; goto RETURN;
591        case INSTR_return_3: returnCount = 3; goto RETURN;
592
593        case INSTR_stackSize8Legacy:
594            stackCheck = *pc++;
595            goto STACKCHECK;
596
597        case INSTR_stackSize16:
598        {
599            stackCheck = arg1; pc += 2;
600        STACKCHECK:
601            // Check there is space on the stack
602            if (sp - stackCheck < sl)
603            {
604                uintptr_t min_size = (this->stack->top - (PolyWord*)sp) + OVERFLOW_STACK_SIZE + stackCheck;
605                SaveInterpreterState(pc, sp);
606                CheckAndGrowStack(this, min_size);
607                LoadInterpreterState(pc, sp);
608                sl = (stackItem*)this->stack->stack() + OVERFLOW_STACK_SIZE;
609            }
610            // Also check for interrupts
611            if (this->interrupt_requested)
612            {
613                // Check for interrupts
614                this->interrupt_requested = false;
615                SaveInterpreterState(pc, sp);
616                return -1;
617            }
618            break;
619        }
620
621        case INSTR_raise_ex:
622        {
623            RAISE_EXCEPTION:
624            this->raiseException = false;
625            PolyException *exn = (PolyException*)((*sp).w().AsObjPtr());
626            this->exception_arg = (PolyWord)exn; /* Get exception data */
627            sp = this->hr;
628            pc = (*sp++).codeAddr;
629            if (pc == SPECIAL_PC_END_THREAD)
630                exitThread(this);  // Default handler for thread.
631            this->hr = (*sp++).stackAddr;
632            break;
633        }
634
635        case INSTR_tuple_2: storeWords = 2; goto TUPLE;
636        case INSTR_tuple_3: storeWords = 3; goto TUPLE;
637        case INSTR_tuple_4: storeWords = 4; goto TUPLE;
638        case INSTR_tuple_b: storeWords = *pc; pc++; goto TUPLE;
639
640        case INSTR_closureB:
641            storeWords = *pc++;
642            goto CREATE_CLOSURE;
643            break;
644
645        case INSTR_local_w:
646            {
647                stackItem u = sp[arg1];
648                *(--sp) = u;
649                pc += 2;
650                break;
651            }
652
653        case INSTR_constAddr8:
654            *(--sp) = *(PolyWord*)(pc + pc[0] + 1); pc += 1; break;
655
656        case INSTR_constAddr16:
657            *(--sp) = *(PolyWord*)(pc + arg1 + 2); pc += 2; break;
658
659        case INSTR_const_int_w: *(--sp) = TAGGED(arg1); pc += 2; break;
660
661        case INSTR_jump_back8:
662            pc -= *pc + 1;
663            if (this->interrupt_requested)
664            {
665                // Check for interrupt in case we're in a loop
666                this->interrupt_requested = false;
667                SaveInterpreterState(pc, sp);
668                return -1;
669            }
670            break;
671
672        case INSTR_jump_back16:
673            pc -= arg1 + 1;
674            if (this->interrupt_requested)
675            {
676                // Check for interrupt in case we're in a loop
677                this->interrupt_requested = false;
678                SaveInterpreterState(pc, sp);
679                return -1;
680            }
681            break;
682
683        case INSTR_lock:
684            {
685                PolyObject *obj = (*sp).w().AsObjPtr();
686                obj->SetLengthWord(obj->LengthWord() & ~_OBJ_MUTABLE_BIT);
687                break;
688            }
689
690        case INSTR_ldexc: *(--sp) = this->exception_arg; break;
691
692        case INSTR_local_b: { stackItem u = sp[*pc]; *(--sp) = u; pc += 1; break; }
693
694        case INSTR_indirect_b:
695            *sp = (*sp).w().AsObjPtr()->Get(*pc); pc += 1; break;
696
697        case INSTR_indirectLocalBB:
698        { PolyWord u = sp[*pc++]; *(--sp) = u.AsObjPtr()->Get(*pc++); break; }
699
700        case INSTR_indirectLocalB0:
701        { PolyWord u = sp[*pc++]; *(--sp) = u.AsObjPtr()->Get(0); break; }
702
703        case INSTR_indirect0Local0:
704        { PolyWord u = sp[0]; *(--sp) = u.AsObjPtr()->Get(0); break; }
705
706        case INSTR_indirectLocalB1:
707        { PolyWord u = sp[*pc++]; *(--sp) = u.AsObjPtr()->Get(1); break; }
708
709        case INSTR_moveToContainerB:
710            { PolyWord u = *sp++; (*sp).stackAddr[*pc] = u; pc += 1; break; }
711
712        case INSTR_moveToMutClosureB:
713        {
714            PolyWord u = *sp++;
715            (*sp).w().AsObjPtr()->Set(*pc++ + sizeof(uintptr_t) / sizeof(PolyWord), u);
716            break;
717        }
718
719        case INSTR_indirectContainerB:
720            *sp = (*sp).stackAddr[*pc]; pc += 1; break;
721
722        case INSTR_indirectClosureBB:
723        { PolyWord u = sp[*pc++]; *(--sp) = u.AsObjPtr()->Get(*pc++ + sizeof(uintptr_t) / sizeof(PolyWord)); break; }
724
725        case INSTR_indirectClosureB0:
726        { PolyWord u = sp[*pc++]; *(--sp) = u.AsObjPtr()->Get(sizeof(uintptr_t) / sizeof(PolyWord)); break; }
727
728        case INSTR_indirectClosureB1:
729        { PolyWord u = sp[*pc++]; *(--sp) = u.AsObjPtr()->Get(sizeof(uintptr_t) / sizeof(PolyWord) + 1); break; }
730
731        case INSTR_indirectClosureB2:
732        { PolyWord u = sp[*pc++]; *(--sp) = u.AsObjPtr()->Get(sizeof(uintptr_t) / sizeof(PolyWord) + 2); break; }
733
734        case INSTR_set_stack_val_b:
735            { PolyWord u = *sp++; sp[*pc-1] = u; pc += 1; break; }
736
737        case INSTR_reset_b: sp += *pc; pc += 1; break;
738
739        case INSTR_reset_r_b:
740            { PolyWord u = *sp; sp += *pc; *sp = u; pc += 1; break; }
741
742        case INSTR_const_int_b: *(--sp) = TAGGED(*pc); pc += 1; break;
743
744        case INSTR_local_0: { stackItem u = sp[0]; *(--sp) = u; break; }
745        case INSTR_local_1: { stackItem u = sp[1]; *(--sp) = u; break; }
746        case INSTR_local_2: { stackItem u = sp[2]; *(--sp) = u; break; }
747        case INSTR_local_3: { stackItem u = sp[3]; *(--sp) = u; break; }
748        case INSTR_local_4: { stackItem u = sp[4]; *(--sp) = u; break; }
749        case INSTR_local_5: { stackItem u = sp[5]; *(--sp) = u; break; }
750        case INSTR_local_6: { stackItem u = sp[6]; *(--sp) = u; break; }
751        case INSTR_local_7: { stackItem u = sp[7]; *(--sp) = u; break; }
752        case INSTR_local_8: { stackItem u = sp[8]; *(--sp) = u; break; }
753        case INSTR_local_9: { stackItem u = sp[9]; *(--sp) = u; break; }
754        case INSTR_local_10: { stackItem u = sp[10]; *(--sp) = u; break; }
755        case INSTR_local_11: { stackItem u = sp[11]; *(--sp) = u; break; }
756        case INSTR_local_12: { stackItem u = sp[12]; *(--sp) = u; break; }
757        case INSTR_local_13: { stackItem u = sp[13]; *(--sp) = u; break; }
758        case INSTR_local_14: { stackItem u = sp[14]; *(--sp) = u; break; }
759        case INSTR_local_15: { stackItem u = sp[15]; *(--sp) = u; break; }
760
761        case INSTR_indirect_0:
762            *sp = (*sp).w().AsObjPtr()->Get(0); break;
763
764        case INSTR_indirect_1:
765            *sp = (*sp).w().AsObjPtr()->Get(1); break;
766
767        case INSTR_indirect_2:
768            *sp = (*sp).w().AsObjPtr()->Get(2); break;
769
770        case INSTR_indirect_3:
771            *sp = (*sp).w().AsObjPtr()->Get(3); break;
772
773        case INSTR_indirect_4:
774            *sp = (*sp).w().AsObjPtr()->Get(4); break;
775
776        case INSTR_indirect_5:
777            *sp = (*sp).w().AsObjPtr()->Get(5); break;
778
779        case INSTR_const_0: *(--sp) = Zero; break;
780        case INSTR_const_1: *(--sp) = TAGGED(1); break;
781        case INSTR_const_2: *(--sp) = TAGGED(2); break;
782        case INSTR_const_3: *(--sp) = TAGGED(3); break;
783        case INSTR_const_4: *(--sp) = TAGGED(4); break;
784        case INSTR_const_10: *(--sp) = TAGGED(10); break;
785
786        case INSTR_reset_r_1: { PolyWord u = *sp; sp += 1; *sp = u; break; }
787        case INSTR_reset_r_2: { PolyWord u = *sp; sp += 2; *sp = u; break; }
788        case INSTR_reset_r_3: { PolyWord u = *sp; sp += 3; *sp = u; break; }
789
790        case INSTR_reset_1: sp += 1; break;
791        case INSTR_reset_2: sp += 2; break;
792
793        case INSTR_stack_containerB:
794        {
795            POLYUNSIGNED words = *pc++;
796            while (words-- > 0) *(--sp) = Zero;
797            sp--;
798            (*sp).stackAddr = sp + 1;
799            break;
800        }
801
802        case INSTR_tuple_containerLegacy: /* Create a tuple from a container. */
803            {
804                storeWords = arg1;
805                PolyObject *t = this->allocateMemory(storeWords, pc, sp);
806                if (t == 0) goto RAISE_EXCEPTION;
807                t->SetLengthWord(storeWords, 0);
808                for(; storeWords > 0; )
809                {
810                    storeWords--;
811                    t->Set(storeWords, (*sp).stackAddr[storeWords]);
812                }
813                *sp = (PolyWord)t;
814                pc += 2;
815                break;
816            }
817
818        case INSTR_callFastRTS0:
819            {
820                callFastRts0 doCall = *(callFastRts0*)(*sp++).w().AsObjPtr();
821                this->raiseException = false;
822                SaveInterpreterState(pc, sp);
823                POLYUNSIGNED result = doCall();
824                LoadInterpreterState(pc, sp);
825                // If this raised an exception
826                if (this->raiseException) goto RAISE_EXCEPTION;
827                *(--sp) = PolyWord::FromUnsigned(result);
828                break;
829            }
830
831        case INSTR_callFastRTS1:
832            {
833                callFastRts1 doCall = *(callFastRts1*)(*sp++).w().AsObjPtr();
834                intptr_t rtsArg1 = (*sp++).argValue;
835                this->raiseException = false;
836                SaveInterpreterState(pc, sp);
837                POLYUNSIGNED result = doCall(rtsArg1);
838                LoadInterpreterState(pc, sp);
839                // If this raised an exception
840                if (this->raiseException) goto RAISE_EXCEPTION;
841                *(--sp) = PolyWord::FromUnsigned(result);
842                break;
843            }
844
845        case INSTR_callFastRTS2:
846            {
847                callFastRts2 doCall = *(callFastRts2*)(*sp++).w().AsObjPtr();
848                intptr_t rtsArg2 = (*sp++).argValue; // Pop off the args, last arg first.
849                intptr_t rtsArg1 = (*sp++).argValue;
850                this->raiseException = false;
851                SaveInterpreterState(pc, sp);
852                POLYUNSIGNED result = doCall(rtsArg1, rtsArg2);
853                LoadInterpreterState(pc, sp);
854                // If this raised an exception
855                if (this->raiseException) goto RAISE_EXCEPTION;
856                *(--sp) = PolyWord::FromUnsigned(result);
857                break;
858            }
859
860        case INSTR_callFastRTS3:
861            {
862                callFastRts3 doCall = *(callFastRts3*)(*sp++).w().AsObjPtr();
863                intptr_t rtsArg3 = (*sp++).argValue; // Pop off the args, last arg first.
864                intptr_t rtsArg2 = (*sp++).argValue;
865                intptr_t rtsArg1 = (*sp++).argValue;
866                this->raiseException = false;
867                SaveInterpreterState(pc, sp);
868                POLYUNSIGNED result = doCall(rtsArg1, rtsArg2, rtsArg3);
869                LoadInterpreterState(pc, sp);
870                // If this raised an exception
871                if (this->raiseException) goto RAISE_EXCEPTION;
872                *(--sp) = PolyWord::FromUnsigned(result);
873                break;
874            }
875
876        case INSTR_callFastRTS4:
877            {
878                callFastRts4 doCall = *(callFastRts4*)(*sp++).w().AsObjPtr();
879                intptr_t rtsArg4 = (*sp++).argValue; // Pop off the args, last arg first.
880                intptr_t rtsArg3 = (*sp++).argValue;
881                intptr_t rtsArg2 = (*sp++).argValue;
882                intptr_t rtsArg1 = (*sp++).argValue;
883                this->raiseException = false;
884                SaveInterpreterState(pc, sp);
885                POLYUNSIGNED result = doCall(rtsArg1, rtsArg2, rtsArg3, rtsArg4);
886                LoadInterpreterState(pc, sp);
887                // If this raised an exception
888                if (this->raiseException) goto RAISE_EXCEPTION;
889                *(--sp) = PolyWord::FromUnsigned(result);
890                break;
891            }
892
893        case INSTR_callFastRTS5:
894            {
895                callFastRts5 doCall = *(callFastRts5*)(*sp++).w().AsObjPtr();
896                intptr_t rtsArg5 = (*sp++).argValue; // Pop off the args, last arg first.
897                intptr_t rtsArg4 = (*sp++).argValue;
898                intptr_t rtsArg3 = (*sp++).argValue;
899                intptr_t rtsArg2 = (*sp++).argValue;
900                intptr_t rtsArg1 = (*sp++).argValue;
901                this->raiseException = false;
902                SaveInterpreterState(pc, sp);
903                POLYUNSIGNED result = doCall(rtsArg1, rtsArg2, rtsArg3, rtsArg4, rtsArg5);
904                LoadInterpreterState(pc, sp);
905                // If this raised an exception
906                if (this->raiseException) goto RAISE_EXCEPTION;
907                *(--sp) = PolyWord::FromUnsigned(result);
908                break;
909            }
910
911        case INSTR_callFullRTS0:
912            {
913                callFullRts0 doCall = *(callFullRts0*)(*sp++).w().AsObjPtr();
914                this->raiseException = false;
915                SaveInterpreterState(pc, sp);
916                POLYUNSIGNED result = doCall(this->threadObject);
917                LoadInterpreterState(pc, sp);
918                // If this raised an exception
919                if (this->raiseException) goto RAISE_EXCEPTION;
920                *(--sp)= PolyWord::FromUnsigned(result);
921                break;
922            }
923
924        case INSTR_callFullRTS1:
925            {
926                callFullRts1 doCall = *(callFullRts1*)(*sp++).w().AsObjPtr();
927                intptr_t rtsArg1 = (*sp++).argValue;
928                this->raiseException = false;
929                SaveInterpreterState(pc, sp);
930                POLYUNSIGNED result = doCall(this->threadObject, rtsArg1);
931                LoadInterpreterState(pc, sp);
932                // If this raised an exception
933                if (this->raiseException) goto RAISE_EXCEPTION;
934                *(--sp) = PolyWord::FromUnsigned(result);
935                break;
936            }
937
938        case INSTR_callFullRTS2:
939            {
940                callFullRts2 doCall = *(callFullRts2*)(*sp++).w().AsObjPtr();
941                intptr_t rtsArg2 = (*sp++).argValue; // Pop off the args, last arg first.
942                intptr_t rtsArg1 = (*sp++).argValue;
943                this->raiseException = false;
944                SaveInterpreterState(pc, sp);
945                POLYUNSIGNED result = doCall(this->threadObject, rtsArg1, rtsArg2);
946                LoadInterpreterState(pc, sp);
947                // If this raised an exception
948                if (this->raiseException) goto RAISE_EXCEPTION;
949                *(--sp) = PolyWord::FromUnsigned(result);
950                break;
951            }
952
953        case INSTR_callFullRTS3:
954            {
955                callFullRts3 doCall = *(callFullRts3*)(*sp++).w().AsObjPtr();
956                intptr_t rtsArg3 = (*sp++).argValue; // Pop off the args, last arg first.
957                intptr_t rtsArg2 = (*sp++).argValue;
958                intptr_t rtsArg1 = (*sp++).argValue;
959                this->raiseException = false;
960                SaveInterpreterState(pc, sp);
961                POLYUNSIGNED result = doCall(this->threadObject, rtsArg1, rtsArg2, rtsArg3);
962                LoadInterpreterState(pc, sp);
963                // If this raised an exception
964                if (this->raiseException) goto RAISE_EXCEPTION;
965                *(--sp) = PolyWord::FromUnsigned(result);
966                break;
967            }
968
969        case INSTR_notBoolean:
970            *sp = ((*sp).w() == True) ? False : True; break;
971
972        case INSTR_isTagged:
973            *sp = (*sp).w().IsTagged() ? True : False; break;
974
975        case INSTR_cellLength:
976            /* Return the length word. */
977            *sp = TAGGED((*sp).w().AsObjPtr()->Length());
978            break;
979
980        case INSTR_cellFlags:
981        {
982            PolyObject *p = (*sp).w().AsObjPtr();
983            POLYUNSIGNED f = (p->LengthWord()) >> OBJ_PRIVATE_FLAGS_SHIFT;
984            *sp = TAGGED(f);
985            break;
986        }
987
988        case INSTR_clearMutable:
989        {
990            PolyObject *obj = (*sp).w().AsObjPtr();
991            POLYUNSIGNED lengthW = obj->LengthWord();
992            /* Clear the mutable bit. */
993            obj->SetLengthWord(lengthW & ~_OBJ_MUTABLE_BIT);
994            *sp = Zero;
995            break;
996        }
997
998//        case INSTR_stringLength: // Now replaced by loadUntagged
999//            *sp = TAGGED(((PolyStringObject*)(*sp).AsObjPtr())->length);
1000//            break;
1001
1002        case INSTR_atomicIncr:
1003        {
1004            PLocker l(&mutexLock);
1005            PolyObject *p = (*sp).w().AsObjPtr();
1006            PolyWord newValue = TAGGED(UNTAGGED(p->Get(0))+1);
1007            p->Set(0, newValue);
1008            *sp = newValue;
1009            break;
1010        }
1011
1012        case INSTR_atomicDecr:
1013        {
1014            PLocker l(&mutexLock);
1015            PolyObject *p = (*sp).w().AsObjPtr();
1016            PolyWord newValue = TAGGED(UNTAGGED(p->Get(0))-1);
1017            p->Set(0, newValue);
1018            *sp = newValue;
1019            break;
1020        }
1021
1022        case INSTR_equalWord:
1023        {
1024            PolyWord u = *sp++;
1025            *sp = u == (*sp) ? True : False;
1026            break;
1027        }
1028
1029        case INSTR_jumpNEqLocal:
1030        {
1031            // Compare a local with a constant and jump if not equal.
1032            PolyWord u = sp[pc[0]];
1033            if (u.IsTagged() && u.UnTagged() == pc[1])
1034                pc += 3;
1035            else pc += pc[2] + 3;
1036            break;
1037        }
1038
1039        case INSTR_jumpNEqLocalInd:
1040        {
1041            // Test the union tag value in the first word of a tuple.
1042            PolyWord u = sp[pc[0]];
1043            u = u.AsObjPtr()->Get(0);
1044            if (u.IsTagged() && u.UnTagged() == pc[1])
1045                pc += 3;
1046            else pc += pc[2] + 3;
1047            break;
1048        }
1049
1050        case INSTR_isTaggedLocalB:
1051        {
1052            PolyWord u = sp[*pc++];
1053            *(--sp) = u.IsTagged() ? True : False;
1054            break;
1055        }
1056
1057        case INSTR_jumpTaggedLocal:
1058        {
1059            PolyWord u = sp[*pc];
1060            // Jump if the value is tagged.
1061            if (u.IsTagged())
1062                pc += pc[1] + 2;
1063            else pc += 2;
1064            break;
1065        }
1066
1067        case INSTR_lessSigned:
1068        {
1069            PolyWord u = *sp++;
1070            *sp = ((*sp).w().AsSigned() < u.AsSigned()) ? True : False;
1071            break;
1072        }
1073
1074        case INSTR_lessUnsigned:
1075        {
1076            PolyWord u = *sp++;
1077            *sp = ((*sp).w().AsUnsigned() < u.AsUnsigned()) ? True : False;
1078            break;
1079        }
1080
1081        case INSTR_lessEqSigned:
1082        {
1083            PolyWord u = *sp++;
1084            *sp = ((*sp).w().AsSigned() <= u.AsSigned()) ? True : False;
1085            break;
1086        }
1087
1088        case INSTR_lessEqUnsigned:
1089        {
1090            PolyWord u = *sp++;
1091            *sp = ((*sp).w().AsUnsigned() <= u.AsUnsigned()) ? True : False;
1092            break;
1093        }
1094
1095        case INSTR_greaterSigned:
1096        {
1097            PolyWord u = *sp++;
1098            *sp = ((*sp).w().AsSigned() > u.AsSigned()) ? True : False;
1099            break;
1100        }
1101
1102        case INSTR_greaterUnsigned:
1103        {
1104            PolyWord u = *sp++;
1105            *sp = ((*sp).w().AsUnsigned() > u.AsUnsigned()) ? True : False;
1106            break;
1107        }
1108
1109        case INSTR_greaterEqSigned:
1110        {
1111            PolyWord u = *sp++;
1112            *sp = ((*sp).w().AsSigned() >= u.AsSigned()) ? True : False;
1113            break;
1114        }
1115
1116        case INSTR_greaterEqUnsigned:
1117        {
1118            PolyWord u = *sp++;
1119            *sp = ((*sp).w().AsUnsigned() >= u.AsUnsigned()) ? True : False;
1120            break;
1121        }
1122
1123        case INSTR_fixedAdd:
1124        {
1125            PolyWord x = *sp++;
1126            PolyWord y = (*sp);
1127            POLYSIGNED t = UNTAGGED(x) + UNTAGGED(y);
1128            if (t <= MAXTAGGED && t >= -MAXTAGGED-1)
1129                *sp = TAGGED(t);
1130            else
1131            {
1132                *(--sp) = (PolyWord)overflowPacket;
1133                goto RAISE_EXCEPTION;
1134            }
1135            break;
1136        }
1137
1138        case INSTR_fixedSub:
1139        {
1140            PolyWord x = *sp++;
1141            PolyWord y = (*sp);
1142            POLYSIGNED t = UNTAGGED(y) - UNTAGGED(x);
1143            if (t <= MAXTAGGED && t >= -MAXTAGGED-1)
1144                *sp = TAGGED(t);
1145            else
1146            {
1147                *(--sp) = (PolyWord)overflowPacket;
1148                goto RAISE_EXCEPTION;
1149            }
1150            break;
1151        }
1152
1153        case INSTR_fixedMult:
1154        {
1155            POLYSIGNED x = UNTAGGED(*sp++);
1156            POLYSIGNED y = (*sp).w().AsSigned() - 1; // Just remove the tag
1157            POLYSIGNED t = x * y;
1158            if (x != 0 && t / x != y)
1159            {
1160                *(--sp) = (PolyWord)overflowPacket;
1161                goto RAISE_EXCEPTION;
1162            }
1163            *sp = PolyWord::FromSigned(t+1); // Add back the tag
1164            break;
1165        }
1166
1167        case INSTR_fixedQuot:
1168        {
1169            // Zero and overflow are checked for in ML.
1170            POLYSIGNED u = UNTAGGED(*sp++);
1171            PolyWord y = (*sp);
1172            *sp = TAGGED(UNTAGGED(y) / u);
1173            break;
1174        }
1175
1176        case INSTR_fixedRem:
1177        {
1178            // Zero and overflow are checked for in ML.
1179            POLYSIGNED u = UNTAGGED(*sp++);
1180            PolyWord y = (*sp);
1181            *sp = TAGGED(UNTAGGED(y) % u);
1182            break;
1183        }
1184
1185        case INSTR_wordAdd:
1186        {
1187            PolyWord u = *sp++;
1188            // Because we're not concerned with overflow we can just add the values and subtract the tag.
1189            *sp = PolyWord::FromUnsigned((*sp).w().AsUnsigned() + u.AsUnsigned() - TAGGED(0).AsUnsigned());
1190            break;
1191        }
1192
1193        case INSTR_wordSub:
1194        {
1195            PolyWord u = *sp++;
1196            *sp = PolyWord::FromUnsigned((*sp).w().AsUnsigned() - u.AsUnsigned() + TAGGED(0).AsUnsigned());
1197            break;
1198        }
1199
1200        case INSTR_wordMult:
1201        {
1202            PolyWord u = *sp++;
1203            *sp = TAGGED(UNTAGGED_UNSIGNED(*sp) * UNTAGGED_UNSIGNED(u));
1204            break;
1205        }
1206
1207        case INSTR_wordDiv:
1208        {
1209            POLYUNSIGNED u = UNTAGGED_UNSIGNED(*sp++);
1210            // Detection of zero is done in ML
1211            *sp = TAGGED(UNTAGGED_UNSIGNED(*sp) / u); break;
1212        }
1213
1214        case INSTR_wordMod:
1215        {
1216            POLYUNSIGNED u = UNTAGGED_UNSIGNED(*sp++);
1217            *sp = TAGGED(UNTAGGED_UNSIGNED(*sp) % u);
1218            break;
1219        }
1220
1221        case INSTR_wordAnd:
1222        {
1223            PolyWord u = *sp++;
1224            // Since both of these should be tagged the tag bit will be preserved.
1225            *sp = PolyWord::FromUnsigned((*sp).w().AsUnsigned() & u.AsUnsigned());
1226            break;
1227        }
1228
1229        case INSTR_wordOr:
1230        {
1231            PolyWord u = *sp++;
1232            // Since both of these should be tagged the tag bit will be preserved.
1233            *sp = PolyWord::FromUnsigned((*sp).w().AsUnsigned() | u.AsUnsigned());
1234            break;
1235        }
1236
1237        case INSTR_wordXor:
1238        {
1239            PolyWord u = *sp++;
1240            // This will remove the tag bit so it has to be reinstated.
1241            *sp = PolyWord::FromUnsigned(((*sp).w().AsUnsigned() ^ u.AsUnsigned()) | TAGGED(0).AsUnsigned());
1242            break;
1243        }
1244
1245        case INSTR_wordShiftLeft:
1246        {
1247            // ML requires shifts greater than a word to return zero.
1248            // That's dealt with at the higher level.
1249            PolyWord u = *sp++;
1250            *sp = TAGGED(UNTAGGED_UNSIGNED(*sp) << UNTAGGED_UNSIGNED(u));
1251            break;
1252        }
1253
1254        case INSTR_wordShiftRLog:
1255        {
1256            PolyWord u = *sp++;
1257            *sp = TAGGED(UNTAGGED_UNSIGNED(*sp) >> UNTAGGED_UNSIGNED(u));
1258            break;
1259        }
1260
1261        case INSTR_allocByteMem:
1262        {
1263            // Allocate byte segment.  This does not need to be initialised.
1264            POLYUNSIGNED flags = UNTAGGED_UNSIGNED(*sp++);
1265            POLYUNSIGNED length = UNTAGGED_UNSIGNED(*sp);
1266            PolyObject *t = this->allocateMemory(length, pc, sp);
1267            if (t == 0) goto RAISE_EXCEPTION; // Exception
1268            t->SetLengthWord(length, (byte)flags);
1269            *sp = (PolyWord)t;
1270            break;
1271        }
1272
1273        case INSTR_getThreadId:
1274            *(--sp) = (PolyWord)this->threadObject;
1275            break;
1276
1277        case INSTR_allocWordMemory:
1278        {
1279            // Allocate word segment.  This must be initialised.
1280            // We mustn't pop the initialiser until after any potential GC.
1281            POLYUNSIGNED length = UNTAGGED_UNSIGNED(sp[2]);
1282            PolyObject *t = this->allocateMemory(length, pc, sp);
1283            if (t == 0) goto RAISE_EXCEPTION;
1284            PolyWord initialiser = *sp++;
1285            POLYUNSIGNED flags = UNTAGGED_UNSIGNED(*sp++);
1286            t->SetLengthWord(length, (byte)flags);
1287            *sp = (PolyWord)t;
1288            // Have to initialise the data.
1289            for (; length > 0; ) t->Set(--length, initialiser);
1290            break;
1291        }
1292
1293        case INSTR_alloc_ref:
1294        {
1295            // Allocate a single word mutable cell.  This is more common than allocWordMemory on its own.
1296            PolyObject *t = this->allocateMemory(1, pc, sp);
1297            if (t == 0) goto RAISE_EXCEPTION;
1298            PolyWord initialiser = (*sp);
1299            t->SetLengthWord(1, F_MUTABLE_BIT);
1300            t->Set(0, initialiser);
1301            *sp = (PolyWord)t;
1302            break;
1303        }
1304
1305        case INSTR_allocMutClosureB:
1306        {
1307            // Allocate memory for a mutable closure and copy in the code address.
1308            POLYUNSIGNED length = *pc++ + sizeof(uintptr_t) / sizeof(PolyWord);
1309            PolyObject* t = this->allocateMemory(length, pc, sp);
1310            if (t == 0) goto RAISE_EXCEPTION;
1311            t->SetLengthWord(length, F_CLOSURE_OBJ | F_MUTABLE_BIT);
1312            PolyObject* srcClosure = (*sp).w().AsObjPtr();
1313            *(uintptr_t*)t = *(uintptr_t*)srcClosure;
1314            for (POLYUNSIGNED i = sizeof(uintptr_t) / sizeof(PolyWord); i < length; i++)
1315                t->Set(i, TAGGED(0));
1316            *sp = (PolyWord)t;
1317            break;
1318        }
1319
1320        case INSTR_loadMLWordLegacy:
1321        {
1322            // The values on the stack are base, index and offset.
1323            POLYUNSIGNED offset = UNTAGGED(*sp++);
1324            POLYUNSIGNED index = UNTAGGED(*sp++);
1325            PolyObject *p = (PolyObject*)((*sp).w().AsCodePtr() + offset);
1326            *sp = p->Get(index);
1327            break;
1328        }
1329
1330        case INSTR_loadMLWord:
1331        {
1332            POLYUNSIGNED index = UNTAGGED(*sp++);
1333            PolyObject* p = (PolyObject*)((*sp).w().AsCodePtr());
1334            *sp = p->Get(index);
1335            break;
1336        }
1337
1338        case INSTR_loadMLByte:
1339        {
1340            // The values on the stack are base and index.
1341            POLYUNSIGNED index = UNTAGGED(*sp++);
1342            POLYCODEPTR p = (*sp).w().AsCodePtr();
1343            *sp = TAGGED(p[index]); // Have to tag the result
1344            break;
1345        }
1346
1347        case INSTR_loadUntaggedLegacy:
1348        {
1349            // The values on the stack are base, index and offset.
1350            POLYUNSIGNED offset = UNTAGGED(*sp++);
1351            POLYUNSIGNED index = UNTAGGED(*sp++);
1352            PolyObject *p = (PolyObject*)((*sp).w().AsCodePtr() + offset);
1353            *sp = TAGGED(p->Get(index).AsUnsigned());
1354            break;
1355        }
1356
1357        case INSTR_loadUntagged:
1358        {
1359            POLYUNSIGNED index = UNTAGGED(*sp++);
1360            PolyObject* p = (PolyObject*)((*sp).w().AsCodePtr());
1361            *sp = TAGGED(p->Get(index).AsUnsigned());
1362            break;
1363        }
1364
1365        case INSTR_storeMLWordLegacy:
1366        {
1367            PolyWord toStore = *sp++;
1368            POLYUNSIGNED offset = UNTAGGED(*sp++);
1369            POLYUNSIGNED index = UNTAGGED(*sp++);
1370            PolyObject *p = (PolyObject*)((*sp).w().AsCodePtr() + offset);
1371            p->Set(index, toStore);
1372            *sp = Zero;
1373            break;
1374        }
1375
1376        case INSTR_storeMLWord:
1377        {
1378            PolyWord toStore = *sp++;
1379            POLYUNSIGNED index = UNTAGGED(*sp++);
1380            PolyObject* p = (PolyObject*)((*sp).w().AsCodePtr());
1381            p->Set(index, toStore);
1382            *sp = Zero;
1383            break;
1384        }
1385
1386        case INSTR_storeMLByte:
1387        {
1388            POLYUNSIGNED toStore = UNTAGGED(*sp++);
1389            POLYUNSIGNED index = UNTAGGED(*sp++);
1390            POLYCODEPTR p = (*sp).w().AsCodePtr();
1391            p[index] = (byte)toStore;
1392            *sp = Zero;
1393            break;
1394        }
1395
1396        case INSTR_storeUntaggedLegacy:
1397        {
1398            PolyWord toStore = PolyWord::FromUnsigned(UNTAGGED_UNSIGNED(*sp++));
1399            POLYUNSIGNED offset = UNTAGGED(*sp++);
1400            POLYUNSIGNED index = UNTAGGED(*sp++);
1401            PolyObject *p = (PolyObject*)((*sp).w().AsCodePtr() + offset);
1402            p->Set(index, toStore);
1403            *sp = Zero;
1404            break;
1405        }
1406
1407        case INSTR_storeUntagged:
1408        {
1409            PolyWord toStore = PolyWord::FromUnsigned(UNTAGGED_UNSIGNED(*sp++));
1410            POLYUNSIGNED index = UNTAGGED(*sp++);
1411            PolyObject* p = (PolyObject*)((*sp).w().AsCodePtr());
1412            p->Set(index, toStore);
1413            *sp = Zero;
1414            break;
1415        }
1416
1417        case INSTR_blockMoveWordLegacy:
1418        {
1419            // The offsets are byte counts but the the indexes are in words.
1420            POLYUNSIGNED length = UNTAGGED_UNSIGNED(*sp++);
1421            POLYUNSIGNED destOffset = UNTAGGED_UNSIGNED(*sp++);
1422            POLYUNSIGNED destIndex = UNTAGGED_UNSIGNED(*sp++);
1423            PolyObject *dest = (PolyObject*)((*sp++).w().AsCodePtr() + destOffset);
1424            POLYUNSIGNED srcOffset = UNTAGGED_UNSIGNED(*sp++);
1425            POLYUNSIGNED srcIndex = UNTAGGED_UNSIGNED(*sp++);
1426            PolyObject *src = (PolyObject*)((*sp).w().AsCodePtr() + srcOffset);
1427            for (POLYUNSIGNED u = 0; u < length; u++) dest->Set(destIndex+u, src->Get(srcIndex+u));
1428            *sp = Zero;
1429            break;
1430        }
1431
1432        case INSTR_blockMoveWord:
1433        {
1434            POLYUNSIGNED length = UNTAGGED_UNSIGNED(*sp++);
1435            POLYUNSIGNED destIndex = UNTAGGED_UNSIGNED(*sp++);
1436            PolyObject* dest = (PolyObject*)((*sp++).w().AsCodePtr());
1437            POLYUNSIGNED srcIndex = UNTAGGED_UNSIGNED(*sp++);
1438            PolyObject* src = (PolyObject*)((*sp).w().AsCodePtr());
1439            for (POLYUNSIGNED u = 0; u < length; u++) dest->Set(destIndex + u, src->Get(srcIndex + u));
1440            *sp = Zero;
1441            break;
1442        }
1443
1444        case INSTR_blockMoveByte:
1445        {
1446            POLYUNSIGNED length = UNTAGGED_UNSIGNED(*sp++);
1447            POLYUNSIGNED destOffset = UNTAGGED_UNSIGNED(*sp++);
1448            POLYCODEPTR dest = (*sp++).w().AsCodePtr();
1449            POLYUNSIGNED srcOffset = UNTAGGED_UNSIGNED(*sp++);
1450            POLYCODEPTR src = (*sp).w().AsCodePtr();
1451            memcpy(dest+destOffset, src+srcOffset, length);
1452            *sp = Zero;
1453            break;
1454        }
1455
1456        case INSTR_blockEqualByte:
1457        {
1458            POLYUNSIGNED length = UNTAGGED_UNSIGNED(*sp++);
1459            POLYUNSIGNED arg2Offset = UNTAGGED_UNSIGNED(*sp++);
1460            POLYCODEPTR arg2Ptr = (*sp++).w().AsCodePtr();
1461            POLYUNSIGNED arg1Offset = UNTAGGED_UNSIGNED(*sp++);
1462            POLYCODEPTR arg1Ptr = (*sp).w().AsCodePtr();
1463            *sp = memcmp(arg1Ptr+arg1Offset, arg2Ptr+arg2Offset, length) == 0 ? True : False;
1464            break;
1465        }
1466
1467        case INSTR_blockCompareByte:
1468        {
1469            POLYUNSIGNED length = UNTAGGED_UNSIGNED(*sp++);
1470            POLYUNSIGNED arg2Offset = UNTAGGED_UNSIGNED(*sp++);
1471            POLYCODEPTR arg2Ptr = (*sp++).w().AsCodePtr();
1472            POLYUNSIGNED arg1Offset = UNTAGGED_UNSIGNED(*sp++);
1473            POLYCODEPTR arg1Ptr = (*sp).w().AsCodePtr();
1474            int result = memcmp(arg1Ptr+arg1Offset, arg2Ptr+arg2Offset, length);
1475            *sp = result == 0 ? TAGGED(0) : result < 0 ? TAGGED(-1) : TAGGED(1);
1476            break;
1477        }
1478
1479        // Backwards compatibility.
1480        // These are either used in the current compiler or compiled by it
1481        // while building the basis library.
1482        case EXTINSTR_stack_containerW:
1483        case EXTINSTR_reset_r_w:
1484        case EXTINSTR_tuple_w:
1485        case EXTINSTR_unsignedToLongW:
1486        case EXTINSTR_signedToLongW:
1487        case EXTINSTR_longWToTagged:
1488        case EXTINSTR_lgWordShiftLeft:
1489        case EXTINSTR_fixedIntToReal:
1490        case EXTINSTR_callFastRtoR:
1491        case EXTINSTR_realMult:
1492        case EXTINSTR_realDiv:
1493        case EXTINSTR_realNeg:
1494        case EXTINSTR_realAbs:
1495        case EXTINSTR_realToFloat:
1496        case EXTINSTR_floatDiv:
1497        case EXTINSTR_floatNeg:
1498        case EXTINSTR_floatAbs:
1499        case EXTINSTR_callFastFtoF:
1500        case EXTINSTR_floatMult:
1501        case EXTINSTR_callFastGtoR:
1502        case EXTINSTR_realUnordered:
1503        case EXTINSTR_realEqual:
1504        case EXTINSTR_lgWordEqual:
1505        case EXTINSTR_lgWordOr:
1506        case EXTINSTR_wordShiftRArith:
1507        case EXTINSTR_lgWordLess:
1508            // Back up and handle them as though they were escaped.
1509            pc--;
1510
1511        case INSTR_escape:
1512        {
1513            switch (*pc++) {
1514
1515            case EXTINSTR_callFastRRtoR:
1516            {
1517                // Floating point call.
1518                callRTSRRtoR doCall = *(callRTSRRtoR*)(*sp++).w().AsObjPtr();
1519                PolyWord rtsArg2 = *sp++;
1520                PolyWord rtsArg1 = *sp++;
1521                double argument1 = unboxDouble(rtsArg1);
1522                double argument2 = unboxDouble(rtsArg2);
1523                // Allocate memory for the result.
1524                double result = doCall(argument1, argument2);
1525                PolyObject* t = boxDouble(result, pc, sp);
1526                if (t == 0) goto RAISE_EXCEPTION;
1527                *(--sp) = (PolyWord)t;
1528                break;
1529            }
1530
1531            case EXTINSTR_callFastRGtoR:
1532            {
1533                // Call that takes a POLYUNSIGNED argument and returns a double.
1534                callRTSRGtoR doCall = *(callRTSRGtoR*)(*sp++).w().AsObjPtr();
1535                intptr_t rtsArg2 = (*sp++).w().AsSigned();
1536                PolyWord rtsArg1 = *sp++;
1537                double argument1 = unboxDouble(rtsArg1);
1538                // Allocate memory for the result.
1539                double result = doCall(argument1, rtsArg2);
1540                PolyObject* t = boxDouble(result, pc, sp);
1541                if (t == 0) goto RAISE_EXCEPTION;
1542                *(--sp) = (PolyWord)t;
1543                break;
1544            }
1545
1546            case EXTINSTR_callFastGtoR:
1547            {
1548                // Call that takes a POLYUNSIGNED argument and returns a double.
1549                callRTSGtoR doCall = *(callRTSGtoR*)(*sp++).w().AsObjPtr();
1550                intptr_t rtsArg1 = (*sp++).w().AsSigned();
1551                // Allocate memory for the result.
1552                double result = doCall(rtsArg1);
1553                PolyObject* t = boxDouble(result, pc, sp);
1554                if (t == 0) goto RAISE_EXCEPTION;
1555                *(--sp) = (PolyWord)t;
1556                break;
1557            }
1558
1559            case EXTINSTR_callFastFtoF:
1560            {
1561                // Floating point call.  The call itself does not allocate but we
1562                // need to put the result into a "box".
1563                callRTSFtoF doCall = *(callRTSFtoF*)(*sp++).w().AsObjPtr();
1564                PolyWord rtsArg1 = *sp++;
1565                float argument = unboxFloat(rtsArg1);
1566                // Allocate memory for the result.
1567                float result = doCall(argument);
1568                PolyObject* t = boxFloat(result, pc, sp);
1569                if (t == 0) goto RAISE_EXCEPTION;
1570                *(--sp) = (PolyWord)t;
1571                break;
1572            }
1573
1574            case EXTINSTR_callFastFFtoF:
1575            {
1576                // Floating point call.
1577                callRTSFFtoF doCall = *(callRTSFFtoF*)(*sp++).w().AsObjPtr();
1578                PolyWord rtsArg2 = *sp++;
1579                PolyWord rtsArg1 = *sp++;
1580                float argument1 = unboxFloat(rtsArg1);
1581                float argument2 = unboxFloat(rtsArg2);
1582                // Allocate memory for the result.
1583                float result = doCall(argument1, argument2);
1584                PolyObject* t = boxFloat(result, pc, sp);
1585                if (t == 0) goto RAISE_EXCEPTION;
1586                *(--sp) = (PolyWord)t;
1587                break;
1588            }
1589
1590            case EXTINSTR_callFastGtoF:
1591            {
1592                // Call that takes a POLYUNSIGNED argument and returns a double.
1593                callRTSGtoF doCall = *(callRTSGtoF*)(*sp++).w().AsObjPtr();
1594                intptr_t rtsArg1 = (*sp++).w().AsSigned();
1595                // Allocate memory for the result.
1596                float result = doCall(rtsArg1);
1597                PolyObject* t = boxFloat(result, pc, sp);
1598                if (t == 0) goto RAISE_EXCEPTION;
1599                *(--sp) = (PolyWord)t;
1600                break;
1601            }
1602
1603            case EXTINSTR_callFastFGtoF:
1604            {
1605                // Call that takes a POLYUNSIGNED argument and returns a double.
1606                callRTSFGtoF doCall = *(callRTSFGtoF*)(*sp++).w().AsObjPtr();
1607                intptr_t rtsArg2 = (*sp++).w().AsSigned();
1608                PolyWord rtsArg1 = *sp++;
1609                float argument1 = unboxFloat(rtsArg1);
1610                // Allocate memory for the result.
1611                float result = doCall(argument1, rtsArg2);
1612                PolyObject* t = boxFloat(result, pc, sp);
1613                if (t == 0) goto RAISE_EXCEPTION;
1614                *(--sp) = (PolyWord)t;
1615                break;
1616            }
1617
1618            case EXTINSTR_callFastRtoR:
1619            {
1620                // Floating point call.  The call itself does not allocate but we
1621                // need to put the result into a "box".
1622                callRTSRtoR doCall = *(callRTSRtoR*)(*sp++).w().AsObjPtr();
1623                PolyWord rtsArg1 = *sp++;
1624                double argument = unboxDouble(rtsArg1);
1625                // Allocate memory for the result.
1626                double result = doCall(argument);
1627                PolyObject* t = boxDouble(result, pc, sp);
1628                if (t == 0) goto RAISE_EXCEPTION;
1629                *(--sp) = (PolyWord)t;
1630                break;
1631            }
1632
1633            case EXTINSTR_atomicReset:
1634            {
1635                // This is needed in the interpreted version otherwise there
1636                // is a chance that we could set the value to zero while another
1637                // thread is between getting the old value and setting it to the new value.
1638                PLocker l(&mutexLock);
1639                PolyObject* p = (*sp).w().AsObjPtr();
1640                p->Set(0, TAGGED(0)); // Set this to released.
1641                *sp = TAGGED(0); // Push the unit result
1642                break;
1643            }
1644
1645            case EXTINSTR_longWToTagged:
1646            {
1647                // Extract the first word and return it as a tagged value.  This loses the top-bit
1648                POLYUNSIGNED wx = (*sp).w().AsObjPtr()->Get(0).AsUnsigned();
1649                *sp = TAGGED(wx);
1650                break;
1651            }
1652
1653            case EXTINSTR_signedToLongW:
1654            {
1655                // Shift the tagged value to remove the tag and put it into the first word.
1656                // The original sign bit is copied in the shift.
1657                intptr_t wx = (*sp).w().UnTagged();
1658                PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp);
1659                if (t == 0) goto RAISE_EXCEPTION;
1660                t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ);
1661                *(intptr_t*)t = wx;
1662                *sp = (PolyWord)t;
1663                break;
1664            }
1665
1666            case EXTINSTR_unsignedToLongW:
1667            {
1668                // As with the above except the value is treated as an unsigned
1669                // value and the top bit is zero.
1670                uintptr_t wx = (*sp).w().UnTaggedUnsigned();
1671                PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp);
1672                if (t == 0) goto RAISE_EXCEPTION;
1673                t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ);
1674                *(uintptr_t*)t = wx;
1675                *sp = (PolyWord)t;
1676                break;
1677            }
1678
1679            case EXTINSTR_realAbs:
1680            {
1681                PolyObject* t = this->boxDouble(fabs(unboxDouble(*sp)), pc, sp);
1682                if (t == 0) goto RAISE_EXCEPTION;
1683                *sp = (PolyWord)t;
1684                break;
1685            }
1686
1687            case EXTINSTR_realNeg:
1688            {
1689                PolyObject* t = this->boxDouble(-(unboxDouble(*sp)), pc, sp);
1690                if (t == 0) goto RAISE_EXCEPTION;
1691                *sp = (PolyWord)t;
1692                break;
1693            }
1694
1695            case EXTINSTR_floatAbs:
1696            {
1697                PolyObject* t = this->boxFloat(fabs(unboxFloat(*sp)), pc, sp);
1698                if (t == 0) goto RAISE_EXCEPTION;
1699                *sp = (PolyWord)t;
1700                break;
1701            }
1702
1703            case EXTINSTR_floatNeg:
1704            {
1705                PolyObject* t = this->boxFloat(-(unboxFloat(*sp)), pc, sp);
1706                if (t == 0) goto RAISE_EXCEPTION;
1707                *sp = (PolyWord)t;
1708                break;
1709            }
1710
1711            case EXTINSTR_fixedIntToReal:
1712            {
1713                POLYSIGNED u = UNTAGGED(*sp);
1714                PolyObject* t = this->boxDouble((double)u, pc, sp);
1715                if (t == 0) goto RAISE_EXCEPTION;
1716                *sp = (PolyWord)t;
1717                break;
1718            }
1719
1720            case EXTINSTR_fixedIntToFloat:
1721            {
1722                POLYSIGNED u = UNTAGGED(*sp);
1723                PolyObject* t = this->boxFloat((float)u, pc, sp);
1724                if (t == 0) goto RAISE_EXCEPTION;
1725                *sp = (PolyWord)t;
1726                break;
1727            }
1728
1729            case EXTINSTR_floatToReal:
1730            {
1731                float u = unboxFloat(*sp);
1732                PolyObject* t = this->boxDouble((double)u, pc, sp);
1733                if (t == 0) goto RAISE_EXCEPTION;
1734                *sp = (PolyWord)t;
1735                break;
1736            }
1737
1738            case EXTINSTR_wordShiftRArith:
1739            {
1740                PolyWord u = *sp++;
1741                // Strictly speaking, C does not require that this uses
1742                // arithmetic shifting so we really ought to set the
1743                // high-order bits explicitly.
1744                *sp = TAGGED(UNTAGGED(*sp) >> UNTAGGED(u));
1745                break;
1746            }
1747
1748
1749            case EXTINSTR_lgWordEqual:
1750            {
1751                uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr());
1752                uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr());
1753                *sp = wx == wy ? True : False;
1754                break;
1755            }
1756
1757            case EXTINSTR_lgWordLess:
1758            {
1759                uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr());
1760                uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr());
1761                *sp = (wy < wx) ? True : False;
1762                break;
1763            }
1764
1765            case EXTINSTR_lgWordLessEq:
1766            {
1767                uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr());
1768                uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr());
1769                *sp = (wy <= wx) ? True : False;
1770                break;
1771            }
1772
1773            case EXTINSTR_lgWordGreater:
1774            {
1775                uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr());
1776                uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr());
1777                *sp = (wy > wx) ? True : False;
1778                break;
1779            }
1780
1781            case EXTINSTR_lgWordGreaterEq:
1782            {
1783                uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr());
1784                uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr());
1785                *sp = (wy >= wx) ? True : False;
1786                break;
1787            }
1788
1789            case EXTINSTR_lgWordAdd:
1790            {
1791                uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr());
1792                uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr());
1793                PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp);
1794                if (t == 0) goto RAISE_EXCEPTION;
1795                t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ);
1796                *(uintptr_t*)t = wy + wx;
1797                *sp = (PolyWord)t;
1798                break;
1799            }
1800
1801            case EXTINSTR_lgWordSub:
1802            {
1803                uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr());
1804                uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr());
1805                PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp);
1806                if (t == 0) goto RAISE_EXCEPTION;
1807                t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ);
1808                *(uintptr_t*)t = wy - wx;
1809                *sp = (PolyWord)t;
1810                break;
1811            }
1812
1813            case EXTINSTR_lgWordMult:
1814            {
1815                uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr());
1816                uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr());
1817                PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp);
1818                if (t == 0) goto RAISE_EXCEPTION;
1819                t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ);
1820                *(uintptr_t*)t = wy * wx;
1821                *sp = (PolyWord)t;
1822                break;
1823            }
1824
1825            case EXTINSTR_lgWordDiv:
1826            {
1827                uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr());
1828                uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr());
1829                PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp);
1830                if (t == 0) goto RAISE_EXCEPTION;
1831                t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ);
1832                *(uintptr_t*)t = wy / wx;
1833                *sp = (PolyWord)t;
1834                break;
1835            }
1836
1837            case EXTINSTR_lgWordMod:
1838            {
1839                uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr());
1840                uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr());
1841                PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp);
1842                if (t == 0) goto RAISE_EXCEPTION;
1843                t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ);
1844                *(uintptr_t*)t = wy % wx;
1845                *sp = (PolyWord)t;
1846                break;
1847            }
1848
1849            case EXTINSTR_lgWordAnd:
1850            {
1851                uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr());
1852                uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr());
1853                PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp);
1854                if (t == 0) goto RAISE_EXCEPTION;
1855                t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ);
1856                *(uintptr_t*)t = wy & wx;
1857                *sp = (PolyWord)t;
1858                break;
1859            }
1860
1861            case EXTINSTR_lgWordOr:
1862            {
1863                uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr());
1864                uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr());
1865                PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp);
1866                if (t == 0) goto RAISE_EXCEPTION;
1867                t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ);
1868                *(uintptr_t*)t = wy | wx;
1869                *sp = (PolyWord)t;
1870                break;
1871            }
1872
1873            case EXTINSTR_lgWordXor:
1874            {
1875                uintptr_t wx = *(uintptr_t*)((*sp++).w().AsObjPtr());
1876                uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr());
1877                PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp);
1878                if (t == 0) goto RAISE_EXCEPTION;
1879                t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ);
1880                *(uintptr_t*)t = wy ^ wx;
1881                *sp = (PolyWord)t;
1882                break;
1883            }
1884
1885            case EXTINSTR_lgWordShiftLeft:
1886            {
1887                // The shift amount is a tagged word not a boxed large word
1888                POLYUNSIGNED wx = UNTAGGED_UNSIGNED(*sp++);
1889                uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr());
1890                PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp);
1891                if (t == 0) goto RAISE_EXCEPTION;
1892                t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ);
1893                *(uintptr_t*)t = wy << wx;
1894                *sp = (PolyWord)t;
1895                break;
1896            }
1897
1898            case EXTINSTR_lgWordShiftRLog:
1899            {
1900                // The shift amount is a tagged word not a boxed large word
1901                POLYUNSIGNED wx = UNTAGGED_UNSIGNED(*sp++);
1902                uintptr_t wy = *(uintptr_t*)((*sp).w().AsObjPtr());
1903                PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp);
1904                if (t == 0) goto RAISE_EXCEPTION;
1905                t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ);
1906                *(uintptr_t*)t = wy >> wx;
1907                *sp = (PolyWord)t;
1908                break;
1909            }
1910
1911            case EXTINSTR_lgWordShiftRArith:
1912            {
1913                // The shift amount is a tagged word not a boxed large word
1914                POLYUNSIGNED wx = UNTAGGED_UNSIGNED(*sp++);
1915                intptr_t wy = *(intptr_t*)((*sp).w().AsObjPtr());
1916                PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp);
1917                if (t == 0) goto RAISE_EXCEPTION;
1918                t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ);
1919                *(intptr_t*)t = wy >> wx;
1920                *sp = (PolyWord)t;
1921                break;
1922            }
1923
1924            case EXTINSTR_realEqual:
1925            {
1926                double u = unboxDouble(*sp++);
1927                *sp = u == unboxDouble(*sp) ? True : False;
1928                break;
1929            }
1930
1931            case EXTINSTR_realLess:
1932            {
1933                double u = unboxDouble(*sp++);
1934                *sp = unboxDouble(*sp) < u ? True : False;
1935                break;
1936            }
1937
1938            case EXTINSTR_realLessEq:
1939            {
1940                double u = unboxDouble(*sp++);
1941                *sp = unboxDouble(*sp) <= u ? True : False;
1942                break;
1943            }
1944
1945            case EXTINSTR_realGreater:
1946            {
1947                double u = unboxDouble(*sp++);
1948                *sp = unboxDouble(*sp) > u ? True : False;
1949                break;
1950            }
1951
1952            case EXTINSTR_realGreaterEq:
1953            {
1954                double u = unboxDouble(*sp++);
1955                *sp = unboxDouble(*sp) >= u ? True : False;
1956                break;
1957            }
1958
1959            case EXTINSTR_realUnordered:
1960            {
1961                double u = unboxDouble(*sp++);
1962                double v = unboxDouble(*sp);
1963                *sp = (std::isnan(u) || std::isnan(v)) ? True : False;
1964                break;
1965            }
1966
1967            case EXTINSTR_realAdd:
1968            {
1969                double u = unboxDouble(*sp++);
1970                double v = unboxDouble(*sp);
1971                PolyObject* t = this->boxDouble(v + u, pc, sp);
1972                if (t == 0) goto RAISE_EXCEPTION;
1973                *sp = (PolyWord)t;
1974                break;
1975            }
1976
1977            case EXTINSTR_realSub:
1978            {
1979                double u = unboxDouble(*sp++);
1980                double v = unboxDouble(*sp);
1981                PolyObject* t = this->boxDouble(v - u, pc, sp);
1982                if (t == 0) goto RAISE_EXCEPTION;
1983                *sp = (PolyWord)t;
1984                break;
1985            }
1986
1987            case EXTINSTR_realMult:
1988            {
1989                double u = unboxDouble(*sp++);
1990                double v = unboxDouble(*sp);
1991                PolyObject* t = this->boxDouble(v * u, pc, sp);
1992                if (t == 0) goto RAISE_EXCEPTION;
1993                *sp = (PolyWord)t;
1994                break;
1995            }
1996
1997            case EXTINSTR_realDiv:
1998            {
1999                double u = unboxDouble(*sp++);
2000                double v = unboxDouble(*sp);
2001                PolyObject* t = this->boxDouble(v / u, pc, sp);
2002                if (t == 0) goto RAISE_EXCEPTION;
2003                *sp = (PolyWord)t;
2004                break;
2005            }
2006
2007            case EXTINSTR_floatEqual:
2008            {
2009                float u = unboxFloat(*sp++);
2010                *sp = u == unboxFloat(*sp) ? True : False;
2011                break;
2012            }
2013
2014            case EXTINSTR_floatLess:
2015            {
2016                float u = unboxFloat(*sp++);
2017                *sp = unboxFloat(*sp) < u ? True : False;
2018                break;
2019            }
2020
2021            case EXTINSTR_floatLessEq:
2022            {
2023                float u = unboxFloat(*sp++);
2024                *sp = unboxFloat(*sp) <= u ? True : False;
2025                break;
2026            }
2027
2028            case EXTINSTR_floatGreater:
2029            {
2030                float u = unboxFloat(*sp++);
2031                *sp = unboxFloat(*sp) > u ? True : False;
2032                break;
2033            }
2034
2035            case EXTINSTR_floatGreaterEq:
2036            {
2037                float u = unboxFloat(*sp++);
2038                *sp = unboxFloat(*sp) >= u ? True : False;
2039                break;
2040            }
2041
2042            case EXTINSTR_floatUnordered:
2043            {
2044                float u = unboxFloat(*sp++);
2045                float v = unboxFloat(*sp);
2046                *sp = (std::isnan(u) || std::isnan(v)) ? True : False;
2047                break;
2048            }
2049
2050            case EXTINSTR_floatAdd:
2051            {
2052                float u = unboxFloat(*sp++);
2053                float v = unboxFloat(*sp);
2054                PolyObject* t = this->boxFloat(v + u, pc, sp);
2055                if (t == 0) goto RAISE_EXCEPTION;
2056                *sp = (PolyWord)t;
2057                break;
2058            }
2059
2060            case EXTINSTR_floatSub:
2061            {
2062                float u = unboxFloat(*sp++);
2063                float v = unboxFloat(*sp);
2064                PolyObject* t = this->boxFloat(v - u, pc, sp);
2065                if (t == 0) goto RAISE_EXCEPTION;
2066                *sp = (PolyWord)t;
2067                break;
2068            }
2069
2070            case EXTINSTR_floatMult:
2071            {
2072                float u = unboxFloat(*sp++);
2073                float v = unboxFloat(*sp);
2074                PolyObject* t = this->boxFloat(v * u, pc, sp);
2075                if (t == 0) goto RAISE_EXCEPTION;
2076                *sp = (PolyWord)t;
2077                break;
2078            }
2079
2080            case EXTINSTR_floatDiv:
2081            {
2082                float u = unboxFloat(*sp++);
2083                float v = unboxFloat(*sp);
2084                PolyObject* t = this->boxFloat(v / u, pc, sp);
2085                if (t == 0) goto RAISE_EXCEPTION;
2086                *sp = (PolyWord)t;
2087                break;
2088            }
2089
2090            case EXTINSTR_realToFloat:
2091            {
2092                // Convert a double to a float.  It's complicated because it depends on the rounding mode.
2093                int rMode = *pc++;
2094                int current = getrounding();
2095                // If the rounding is 4 it means "use current rounding".
2096                // Don't call unboxDouble until we're set the rounding.  GCC seems to convert it
2097                // before the actual float cast.
2098                if (rMode < 4) setrounding(rMode);
2099                double d = unboxDouble(*sp);
2100                float v = (float)d; // Convert with the appropriate rounding.
2101                setrounding(current);
2102                PolyObject* t = this->boxFloat(v, pc, sp);
2103                if (t == 0) goto RAISE_EXCEPTION;
2104                *sp = (PolyWord)t;
2105                break;
2106            }
2107
2108            case EXTINSTR_realToInt:
2109                dv = unboxDouble(*sp);
2110                goto realtoint;
2111
2112            case EXTINSTR_floatToInt:
2113                dv = (double)unboxFloat(*sp);
2114            realtoint:
2115                {
2116                    // Convert a double or a float to a tagged integer.
2117                    int rMode = *pc++;
2118                    // We mustn't try converting a value that will overflow the conversion
2119                    // but we need to be careful that we don't raise overflow incorrectly due
2120                    // to rounding.
2121                    if (dv > (double)(MAXTAGGED + MAXTAGGED / 2) ||
2122                        dv < -(double)(MAXTAGGED + MAXTAGGED / 2))
2123                    {
2124                        *(--sp) = (PolyWord)overflowPacket;
2125                        goto RAISE_EXCEPTION;
2126                    }
2127                    POLYSIGNED p;
2128                    switch (rMode)
2129                    {
2130                    case POLY_ROUND_TONEAREST:
2131                        p = (POLYSIGNED)round(dv);
2132                        break;
2133                    case POLY_ROUND_DOWNWARD:
2134                        p = (POLYSIGNED)floor(dv);
2135                        break;
2136                    case POLY_ROUND_UPWARD:
2137                        p = (POLYSIGNED)ceil(dv);
2138                        break;
2139                    case POLY_ROUND_TOZERO:
2140                    default:
2141                        // Truncation is the default for C.
2142                        p = (POLYSIGNED)dv;
2143                    }
2144
2145                    // Check that the value can be tagged.
2146                    if (p > MAXTAGGED || p < -MAXTAGGED - 1)
2147                    {
2148                        *(--sp) = (PolyWord)overflowPacket;
2149                        goto RAISE_EXCEPTION;
2150                    }
2151                    *sp = TAGGED(p);
2152                    break;
2153                }
2154
2155            case EXTINSTR_loadC8:
2156            {
2157                // This is similar to loadMLByte except that the base address is a boxed large-word.
2158                // Also the index is SIGNED.
2159                POLYSIGNED offset = UNTAGGED(*sp++);
2160                POLYSIGNED index = UNTAGGED(*sp++);
2161                POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset;
2162                *sp = TAGGED(p[index]); // Have to tag the result
2163                break;
2164            }
2165
2166            case EXTINSTR_loadC16:
2167            {
2168                // This and the other loads are similar to loadMLWord with separate
2169                // index and offset values.
2170                POLYSIGNED offset = UNTAGGED(*sp++);
2171                POLYSIGNED index = UNTAGGED(*sp++);
2172                POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset;
2173                POLYUNSIGNED r = ((uint16_t*)p)[index];
2174                *sp = TAGGED(r);
2175                break;
2176            }
2177
2178            case EXTINSTR_loadC32:
2179            {
2180                POLYSIGNED offset = UNTAGGED(*sp++);
2181                POLYSIGNED index = UNTAGGED(*sp++);
2182                POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset;
2183                uintptr_t r = ((uint32_t*)p)[index];
2184#ifdef IS64BITS
2185                // This is tagged in 64-bit mode
2186                * sp = TAGGED(r);
2187#else
2188                // But boxed in 32-bit mode.
2189                PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp);
2190                if (t == 0) goto RAISE_EXCEPTION;
2191                t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ);
2192                *(uintptr_t*)t = r;
2193                *sp = (PolyWord)t;
2194#endif
2195                break;
2196            }
2197
2198#if (defined(IS64BITS) || defined(POLYML32IN64))
2199            case EXTINSTR_loadC64:
2200            {
2201                POLYSIGNED offset = UNTAGGED(*sp++);
2202                POLYSIGNED index = UNTAGGED(*sp++);
2203                POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset;
2204                uintptr_t r = ((uint64_t*)p)[index];
2205                // This must be boxed.
2206                PolyObject* t = this->allocateMemory(LGWORDSIZE, pc, sp);
2207                if (t == 0) goto RAISE_EXCEPTION;
2208                t->SetLengthWord(LGWORDSIZE, F_BYTE_OBJ);
2209                *(uintptr_t*)t = r;
2210                *sp = (PolyWord)t;
2211                break;
2212            }
2213#endif
2214
2215            case EXTINSTR_loadCFloat:
2216            {
2217                POLYSIGNED offset = UNTAGGED(*sp++);
2218                POLYSIGNED index = UNTAGGED(*sp++);
2219                POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset;
2220                double r = ((float*)p)[index];
2221                // This must be boxed.
2222                PolyObject* t = this->boxDouble(r, pc, sp);
2223                if (t == 0) goto RAISE_EXCEPTION;
2224                *sp = (PolyWord)t;
2225                break;
2226            }
2227
2228            case EXTINSTR_loadCDouble:
2229            {
2230                POLYSIGNED offset = UNTAGGED(*sp++);
2231                POLYSIGNED index = UNTAGGED(*sp++);
2232                POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset;
2233                double r = ((double*)p)[index];
2234                // This must be boxed.
2235                PolyObject* t = this->boxDouble(r, pc, sp);
2236                if (t == 0) goto RAISE_EXCEPTION;
2237                *sp = (PolyWord)t;
2238                break;
2239            }
2240
2241            case EXTINSTR_storeC8:
2242            {
2243                // Similar to storeMLByte except that the base address is a boxed large-word.
2244                POLYUNSIGNED toStore = UNTAGGED(*sp++);
2245                POLYSIGNED offset = UNTAGGED(*sp++);
2246                POLYSIGNED index = UNTAGGED(*sp++);
2247                POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset;
2248                p[index] = (byte)toStore;
2249                *sp = Zero;
2250                break;
2251            }
2252
2253            case EXTINSTR_storeC16:
2254            {
2255                uint16_t toStore = (uint16_t)UNTAGGED(*sp++);
2256                POLYSIGNED offset = UNTAGGED(*sp++);
2257                POLYSIGNED index = UNTAGGED(*sp++);
2258                POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset;
2259                ((uint16_t*)p)[index] = toStore;
2260                *sp = Zero;
2261                break;
2262            }
2263
2264            case EXTINSTR_storeC32:
2265            {
2266#ifdef IS64BITS
2267                // This is a tagged value in 64-bit mode.
2268                uint32_t toStore = (uint32_t)UNTAGGED(*sp++);
2269#else
2270                // but a boxed value in 32-bit mode.
2271                uint32_t toStore = (uint32_t)(*(uintptr_t*)((*sp++).w().AsObjPtr()));
2272#endif
2273                POLYSIGNED offset = UNTAGGED(*sp++);
2274                POLYSIGNED index = UNTAGGED(*sp++);
2275                POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset;
2276                ((uint32_t*)p)[index] = toStore;
2277                *sp = Zero;
2278                break;
2279        }
2280
2281#if (defined(IS64BITS) || defined(POLYML32IN64))
2282            case EXTINSTR_storeC64:
2283            {
2284                // This is a boxed value.
2285                uint64_t toStore = *(uintptr_t*)((*sp++).w().AsObjPtr());
2286                POLYSIGNED offset = UNTAGGED(*sp++);
2287                POLYSIGNED index = UNTAGGED(*sp++);
2288                POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset;
2289                ((uint64_t*)p)[index] = toStore;
2290                *sp = Zero;
2291                break;
2292            }
2293#endif
2294
2295            case EXTINSTR_storeCFloat:
2296            {
2297                // This is a boxed value.
2298                float toStore = (float)unboxDouble(*sp++);
2299                POLYSIGNED offset = UNTAGGED(*sp++);
2300                POLYSIGNED index = UNTAGGED(*sp++);
2301                POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset;
2302                ((float*)p)[index] = toStore;
2303                *sp = Zero;
2304                break;
2305            }
2306
2307            case EXTINSTR_storeCDouble:
2308            {
2309                // This is a boxed value.
2310                double toStore = unboxDouble(*sp++);
2311                POLYSIGNED offset = UNTAGGED(*sp++);
2312                POLYSIGNED index = UNTAGGED(*sp++);
2313                POLYCODEPTR p = *((byte**)((*sp).w().AsObjPtr())) + offset;
2314                ((double*)p)[index] = toStore;
2315                *sp = Zero;
2316                break;
2317            }
2318
2319            case EXTINSTR_jump32True:
2320                // Invert the sense of the test and fall through.
2321                *sp = ((*sp).w() == True) ? False : True;
2322
2323            case EXTINSTR_jump32False:
2324            {
2325                PolyWord u = *sp++; /* Pop argument */
2326                if (u == True) { pc += 4; break; }
2327                /* else - false - take the jump */
2328            }
2329
2330            case EXTINSTR_jump32:
2331            {
2332                // This is a 32-bit signed quantity on both 64-bits and 32-bits.
2333                POLYSIGNED offset = pc[3] & 0x80 ? -1 : 0;
2334                offset = (offset << 8) | pc[3];
2335                offset = (offset << 8) | pc[2];
2336                offset = (offset << 8) | pc[1];
2337                offset = (offset << 8) | pc[0];
2338                pc += offset + 4;
2339                break;
2340            }
2341
2342            case EXTINSTR_setHandler32: /* Set up a handler */
2343            {
2344                POLYUNSIGNED offset = pc[0] + (pc[1] << 8) + (pc[2] << 16) + (pc[3] << 24);
2345                (--sp)->codeAddr = pc + offset + 4; /* Address of handler */
2346                this->hr = sp;
2347                pc += 4;
2348                break;
2349            }
2350
2351            case EXTINSTR_case32:
2352            {
2353                // arg1 is the number of cases i.e. one more than the largest value
2354                // This is followed by that number of 32-bit offsets.
2355                // If the value is out of range the default case is immediately after the table.
2356                POLYSIGNED u = UNTAGGED(*sp++); /* Get the value */
2357                if (u >= arg1 || u < 0) pc += 2 + arg1 * 4; /* Out of range */
2358                else
2359                {
2360                    pc += 2;
2361                    pc += /* Index */pc[u * 4] + (pc[u * 4 + 1] << 8) + (pc[u * 4 + 2] << 16) + (pc[u * 4 + 3] << 24);
2362                }
2363                break;
2364            }
2365
2366            case EXTINSTR_tuple_w:
2367            {
2368                storeWords = arg1; pc += 2;
2369            TUPLE: /* Common code for tupling. */
2370                PolyObject* p = this->allocateMemory(storeWords, pc, sp);
2371                if (p == 0) goto RAISE_EXCEPTION; // Exception
2372                p->SetLengthWord(storeWords, 0);
2373                for (; storeWords > 0; ) p->Set(--storeWords, *sp++);
2374                *(--sp) = (PolyWord)p;
2375                break;
2376            }
2377
2378            case EXTINSTR_indirect_w:
2379                *sp = (*sp).w().AsObjPtr()->Get(arg1); pc += 2; break;
2380
2381            case EXTINSTR_moveToContainerW:
2382            {
2383                PolyWord u = *sp++;
2384                (*sp).stackAddr[arg1] =u;
2385                pc += 2;
2386                break;
2387            }
2388
2389            case EXTINSTR_moveToMutClosureW:
2390            {
2391               PolyWord u = *sp++;
2392                (*sp).w().AsObjPtr()->Set(arg1 + sizeof(uintptr_t)/sizeof(PolyWord), u);
2393                pc += 2;
2394                break;
2395            }
2396
2397            case EXTINSTR_indirectContainerW:
2398                *sp = (*sp).stackAddr[arg1]; pc += 2; break;
2399
2400            case EXTINSTR_indirectClosureW:
2401                *sp = (*sp).w().AsObjPtr()->Get(arg1+sizeof(uintptr_t)/sizeof(PolyWord)); pc += 2; break;
2402
2403            case EXTINSTR_set_stack_val_w:
2404            {
2405                PolyWord u = *sp++;
2406                sp[arg1 - 1] = u;
2407                pc += 2;
2408                break;
2409            }
2410
2411            case EXTINSTR_reset_w: sp += arg1; pc += 2; break;
2412
2413            case EXTINSTR_reset_r_w:
2414            {
2415                PolyWord u = *sp;
2416                sp += arg1;
2417                *sp = u;
2418                pc += 2;
2419                break;
2420            }
2421
2422            case EXTINSTR_stack_containerW:
2423            {
2424                POLYUNSIGNED words = arg1; pc += 2;
2425                while (words-- > 0) *(--sp) = Zero;
2426                sp--;
2427                (*sp).stackAddr = sp + 1;
2428                break;
2429            }
2430
2431            case EXTINSTR_constAddr32:
2432            {
2433                POLYUNSIGNED offset = pc[0] + (pc[1] << 8) + (pc[2] << 16) + (pc[3] << 24);
2434                *(--sp) = *(PolyWord*)(pc + offset + 4);
2435                pc += 4;
2436                break;
2437            }
2438
2439            case EXTINSTR_allocCSpace:
2440            {
2441                // Allocate this on the C heap.
2442                POLYUNSIGNED length = UNTAGGED_UNSIGNED(*sp);
2443                void* memory = malloc(length);
2444                *sp = Make_sysword(this, (uintptr_t)memory)->Word();
2445                break;
2446            }
2447
2448            case EXTINSTR_freeCSpace:
2449            {
2450                // Both the address and the size are passed as arguments.
2451                sp++; // Size
2452                PolyWord addr = *sp;
2453                free(*(void**)(addr.AsObjPtr()));
2454                *sp = TAGGED(0);
2455                break;
2456            }
2457
2458            case EXTINSTR_tail:
2459                /* Tail recursive call. */
2460                /* Move items up the stack. */
2461                /* There may be an overlap if the function we are calling
2462                   has more args than this one. */
2463                tailCount = arg1;
2464                tailPtr = sp + tailCount;
2465                sp = tailPtr + arg2;
2466                goto TAIL_CALL;
2467
2468
2469            case EXTINSTR_allocMutClosureW:
2470            {
2471                // Allocate memory for a mutable closure and copy in the code address.
2472                POLYUNSIGNED length = arg1 + sizeof(uintptr_t) / sizeof(PolyWord);
2473                pc += 2;
2474                PolyObject* t = this->allocateMemory(length, pc, sp);
2475                if (t == 0) goto RAISE_EXCEPTION;
2476                t->SetLengthWord(length, F_CLOSURE_OBJ | F_MUTABLE_BIT);
2477                PolyObject* srcClosure = (*sp).w().AsObjPtr();
2478                *(uintptr_t*)t = *(uintptr_t*)srcClosure;
2479                for (POLYUNSIGNED i = sizeof(uintptr_t) / sizeof(PolyWord); i < length; i++)
2480                    t->Set(i, TAGGED(0));
2481                *sp = (PolyWord)t;
2482                break;
2483            }
2484
2485            case EXTINSTR_closureW:
2486            {
2487                storeWords = arg1;
2488                pc += 2;
2489            CREATE_CLOSURE:
2490                // Allocate a closure.  storeWords is the number of non-locals.
2491                POLYUNSIGNED length = storeWords + sizeof(uintptr_t) / sizeof(PolyWord);
2492                PolyObject* t = this->allocateMemory(length, pc, sp);
2493                if (t == 0) goto RAISE_EXCEPTION;
2494                t->SetLengthWord(length, F_CLOSURE_OBJ);
2495                for (; storeWords > 0; ) t->Set(--storeWords + sizeof(uintptr_t) / sizeof(PolyWord), *sp++);
2496                PolyObject* srcClosure = (*sp).w().AsObjPtr();
2497                *(uintptr_t*)t = *(uintptr_t*)srcClosure;
2498                *sp = (PolyWord)t;
2499                break;
2500            }
2501
2502            default: Crash("Unknown extended instruction %x\n", pc[-1]);
2503            }
2504
2505            break;
2506        }
2507
2508        case INSTR_enterIntX86:
2509            // This is a no-op if we are already interpreting.
2510            pc += 3; break;
2511
2512        default: Crash("Unknown instruction %x\n", pc[-1]);
2513
2514        } /* switch */
2515     } /* for */
2516     return 0;
2517} /* MD_switch_to_poly */
2518
2519void IntTaskData::GarbageCollect(ScanAddress *process)
2520{
2521    TaskData::GarbageCollect(process);
2522
2523    overflowPacket = process->ScanObjectAddress(overflowPacket);
2524    dividePacket = process->ScanObjectAddress(dividePacket);
2525
2526    if (stack != 0)
2527    {
2528        StackSpace *stackSpace = stack;
2529        stackItem*stackPtr = this->taskSp;
2530        // The exception arg if any
2531        ScanStackAddress(process, this->exception_arg, stackSpace);
2532
2533        // Now the values on the stack.
2534        for (stackItem* q = stackPtr; q < (stackItem*)stack->top; q++)
2535            ScanStackAddress(process, *q, stack);
2536    }
2537}
2538
2539// Process a value within the stack.
2540void IntTaskData::ScanStackAddress(ScanAddress *process, stackItem& stackItem, StackSpace *stack)
2541{
2542    // We may have return addresses on the stack which could look like
2543// tagged values.  Check whether the value is in the code area before
2544// checking whether it is untagged.
2545    if (stackItem.codeAddr == SPECIAL_PC_END_THREAD/* 0 */)
2546        return;
2547#ifdef POLYML32IN64
2548    // In 32-in-64 return addresses always have the top 32 bits non-zero.
2549    if (stackItem.argValue < ((uintptr_t)1 << 32))
2550    {
2551        // It's either a tagged integer or an object pointer.
2552        if (stackItem.w().IsDataPtr())
2553        {
2554            PolyWord val = process->ScanObjectAddress(stackItem.w().AsObjPtr());
2555            stackItem = val;
2556        }
2557    }
2558    else
2559    {
2560        // Could be a code address or a stack address.
2561        MemSpace* space = gMem.SpaceForAddress(stackItem.codeAddr - 1);
2562        if (space == 0 || space->spaceType != ST_CODE) return;
2563        PolyObject* obj = gMem.FindCodeObject(stackItem.codeAddr);
2564        ASSERT(obj != 0);
2565        // Process the address of the start.  Don't update anything.
2566        process->ScanObjectAddress(obj);
2567    }
2568#else
2569    // The -1 here is because we may have a zero-sized cell in the last
2570    // word of a space.
2571    MemSpace* space = gMem.SpaceForAddress(stackItem.codeAddr - 1);
2572    if (space == 0) return; // In particular we may have one of the assembly code addresses.
2573    if (space->spaceType == ST_CODE)
2574    {
2575        PolyObject* obj = gMem.FindCodeObject(stackItem.codeAddr);
2576        // If it is actually an integer it might be outside a valid code object.
2577        if (obj == 0)
2578        {
2579            ASSERT(stackItem.w().IsTagged()); // It must be an integer
2580        }
2581        else // Process the address of the start.  Don't update anything.
2582            process->ScanObjectAddress(obj);
2583    }
2584    else if (space->spaceType == ST_LOCAL && stackItem.w().IsDataPtr())
2585        // Local values must be word addresses.
2586    {
2587        PolyWord val = process->ScanObjectAddress(stackItem.w().AsObjPtr());
2588        stackItem = val;
2589    }
2590#endif
2591
2592}
2593
2594
2595// Copy a stack
2596void IntTaskData::CopyStackFrame(StackObject *old_stack, uintptr_t old_length, StackObject *new_stack, uintptr_t new_length)
2597{
2598#ifdef POLYML32IN64
2599    old_length = old_length / 2;
2600    new_length = new_length / 2;
2601#endif
2602    /* Moves a stack, updating all references within the stack */
2603    stackItem*old_base = (stackItem*)old_stack;
2604    stackItem*new_base = (stackItem*)new_stack;
2605    stackItem*old_top = old_base + old_length;
2606
2607    /* Calculate the offset of the new stack from the old. If the frame is
2608    being extended objects in the new frame will be further up the stack
2609    than in the old one. */
2610
2611    uintptr_t offset = new_base - old_base + new_length - old_length;
2612    stackItem *oldSp = this->taskSp;
2613    this->taskSp = oldSp + offset;
2614    this->hr = this->hr + offset;
2615
2616    /* Skip the unused part of the stack. */
2617
2618    uintptr_t i = oldSp - old_base;
2619
2620    ASSERT(i <= old_length);
2621
2622    i = old_length - i;
2623
2624    stackItem *old = oldSp;
2625    stackItem *newp = this->taskSp;
2626
2627    while (i--)
2628    {
2629        stackItem old_word = *old++;
2630        if (old_word.w().IsDataPtr() && old_word.stackAddr >= old_base && old_word.stackAddr <= old_top)
2631            old_word.stackAddr = old_word.stackAddr + offset;
2632        else if (old_word.w().IsDataPtr() && IsHeapAddress(old_word.stackAddr))
2633        {
2634            stackItem* addr = (stackItem*)old_word.w().AsStackAddr();
2635            if (addr >= old_base && addr <= old_top)
2636            {
2637                addr += offset;
2638                old_word = PolyWord::FromStackAddr((PolyWord*)addr);
2639            }
2640        }
2641        *newp++ = old_word;
2642    }
2643    ASSERT(old == ((stackItem*)old_stack) + old_length);
2644    ASSERT(newp == ((stackItem*)new_stack) + new_length);
2645}
2646
2647void IntTaskData::EnterPolyCode()
2648/* Called from "main" to enter the code. */
2649{
2650    Handle hOriginal = this->saveVec.mark(); // Set this up for the IO calls.
2651    while (1)
2652    {
2653        this->saveVec.reset(hOriginal); // Remove old RTS arguments and results.
2654
2655        // Run the ML code and return with the function to call.
2656        this->inML = true;
2657        int ioFunction = SwitchToPoly();
2658        this->inML = false;
2659
2660        try {
2661            switch (ioFunction)
2662            {
2663            case -1:
2664                // We've been interrupted.  This usually involves simulating a
2665                // stack overflow so we could come here because of a genuine
2666                // stack overflow.
2667                // Previously this code was executed on every RTS call but there
2668                // were problems on Mac OS X at least with contention on schedLock.
2669                // Process any asynchronous events i.e. interrupts or kill
2670                processes->ProcessAsynchRequests(this);
2671                // Release and re-acquire use of the ML memory to allow another thread
2672                // to GC.
2673                processes->ThreadReleaseMLMemory(this);
2674                processes->ThreadUseMLMemory(this);
2675                break;
2676
2677            case -2: // A callback has returned.
2678                ASSERT(0); // Callbacks aren't implemented
2679
2680            default:
2681                Crash("Unknown io operation %d\n", ioFunction);
2682            }
2683        }
2684        catch (IOException &) {
2685        }
2686
2687    }
2688}
2689
2690// As far as possible we want locking and unlocking an ML mutex to be fast so
2691// we try to implement the code in the assembly code using appropriate
2692// interlocked instructions.  That does mean that if we need to lock and
2693// unlock an ML mutex in this code we have to use the same, machine-dependent,
2694// code to do it.  These are defaults that are used where there is no
2695// machine-specific code.
2696
2697static Handle ProcessAtomicDecrement(TaskData *taskData, Handle mutexp)
2698{
2699    PLocker l(&mutexLock);
2700    PolyObject *p = DEREFHANDLE(mutexp);
2701    // A thread can only call this once so the values will be short
2702    PolyWord newValue = TAGGED(UNTAGGED(p->Get(0))-1);
2703    p->Set(0, newValue);
2704    return taskData->saveVec.push(newValue);
2705}
2706
2707// Release a mutex.  We need to lock the mutex to ensure we don't
2708// reset it in the time between one of atomic operations reading
2709// and writing the mutex.
2710static Handle ProcessAtomicReset(TaskData *taskData, Handle mutexp)
2711{
2712    PLocker l(&mutexLock);
2713    DEREFHANDLE(mutexp)->Set(0, TAGGED(0)); // Set this to released.
2714    return taskData->saveVec.push(TAGGED(0)); // Push the unit result
2715}
2716
2717Handle IntTaskData::AtomicDecrement(Handle mutexp)
2718{
2719    return ProcessAtomicDecrement(this, mutexp);
2720}
2721
2722void IntTaskData::AtomicReset(Handle mutexp)
2723{
2724    (void)ProcessAtomicReset(this, mutexp);
2725}
2726
2727bool IntTaskData::AddTimeProfileCount(SIGNALCONTEXT *context)
2728{
2729    if (taskPc != 0)
2730    {
2731        // See if the PC we've got is an ML code address.
2732        MemSpace *space = gMem.SpaceForAddress(taskPc);
2733        if (space != 0 && (space->spaceType == ST_CODE || space->spaceType == ST_PERMANENT))
2734        {
2735            incrementCountAsynch(taskPc);
2736            return true;
2737        }
2738    }
2739    return false;
2740}
2741
2742extern "C" {
2743    POLYEXTERNALSYMBOL POLYUNSIGNED PolyInterpretedGetAbiList(FirstArgument threadId);
2744    POLYEXTERNALSYMBOL POLYUNSIGNED PolyInterpretedCreateCIF(FirstArgument threadId, PolyWord abiValue, PolyWord resultType, PolyWord argTypes);
2745    POLYEXTERNALSYMBOL POLYUNSIGNED PolyInterpretedCallFunction(FirstArgument threadId, PolyWord cifAddr, PolyWord cFunAddr, PolyWord resAddr, PolyWord argVec);
2746    POLYEXTERNALSYMBOL POLYUNSIGNED PolyInterpretedEnterIntMode();
2747}
2748
2749// FFI
2750#if (defined(HAVE_LIBFFI) && defined(HAVE_FFI_H))
2751
2752#ifdef HAVE_ERRNO_H
2753#include <errno.h>
2754#endif
2755
2756#include <ffi.h>
2757
2758static struct _abiTable { const char* abiName; ffi_abi abiCode; } abiTable[] =
2759{
2760    // Unfortunately the ABI entries are enums rather than #defines so we
2761    // can't test individual entries.
2762    #ifdef X86_WIN32
2763        {"sysv", FFI_SYSV},
2764        {"stdcall", FFI_STDCALL},
2765        {"thiscall", FFI_THISCALL},
2766        {"fastcall", FFI_FASTCALL},
2767        {"ms_cdecl", FFI_MS_CDECL},
2768    #elif defined(X86_WIN64)
2769        {"win64", FFI_WIN64},
2770    #elif defined(X86_64) || (defined (__x86_64__) && defined (X86_DARWIN))
2771        {"unix64", FFI_UNIX64},
2772    #elif defined(X86_ANY)
2773        {"sysv", FFI_SYSV},
2774    #endif
2775        { "default", FFI_DEFAULT_ABI}
2776};
2777
2778static Handle mkAbitab(TaskData* taskData, void*, char* p);
2779
2780static Handle toSysWord(TaskData* taskData, void* p)
2781{
2782    return Make_sysword(taskData, (uintptr_t)p);
2783}
2784
2785// Convert the Poly type info into ffi_type values.
2786/*
2787    datatype cTypeForm =
2788            CTypeFloatingPt | CTypePointer | CTypeSignedInt | CTypeUnsignedInt
2789        |   CTypeStruct of cType list | CTypeVoid
2790        withtype cType = { typeForm: cTypeForm, align: word, size: word }
2791*/
2792static ffi_type* decodeType(PolyWord pType)
2793{
2794    PolyWord typeForm = pType.AsObjPtr()->Get(2);
2795    PolyWord typeSize = pType.AsObjPtr()->Get(0);
2796
2797    if (typeForm.IsDataPtr())
2798    {
2799        // Struct
2800        size_t size = typeSize.UnTaggedUnsigned();
2801        unsigned short align = (unsigned short)pType.AsObjPtr()->Get(1).UnTaggedUnsigned();
2802        unsigned nElems = 0;
2803        PolyWord listStart = typeForm.AsObjPtr()->Get(0);
2804        for (PolyWord p = listStart; !ML_Cons_Cell::IsNull(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t)
2805            nElems++;
2806        size_t space = sizeof(ffi_type);
2807        // Add space for the elements plus one extra for the zero terminator.
2808        space += (nElems + 1) * sizeof(ffi_type*);
2809        ffi_type* result = (ffi_type*)calloc(1, space);
2810        // Raise an exception rather than returning zero.
2811        if (result == 0) return 0;
2812        ffi_type** elem = (ffi_type**)(result + 1);
2813        result->size = size;
2814        result->alignment = align;
2815        result->type = FFI_TYPE_STRUCT;
2816        result->elements = elem;
2817        if (elem != 0)
2818        {
2819            for (PolyWord p = listStart; !ML_Cons_Cell::IsNull(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t)
2820            {
2821                PolyWord e = ((ML_Cons_Cell*)p.AsObjPtr())->h;
2822                ffi_type* t = decodeType(e);
2823                if (t == 0) return 0;
2824                *elem++ = t;
2825            }
2826            *elem = 0; // Null terminator
2827        }
2828        return result;
2829    }
2830    else
2831    {
2832        switch (typeForm.UnTaggedUnsigned())
2833        {
2834        case 0:
2835        {
2836            // Floating point
2837            if (typeSize.UnTaggedUnsigned() == ffi_type_float.size)
2838                return &ffi_type_float;
2839            else if (typeSize.UnTaggedUnsigned() == ffi_type_double.size)
2840                return &ffi_type_double;
2841            ASSERT(0);
2842        }
2843        case 1: // FFI type poiner
2844            return &ffi_type_pointer;
2845        case 2: // Signed integer.
2846        {
2847            switch (typeSize.UnTaggedUnsigned())
2848            {
2849            case 1: return &ffi_type_sint8;
2850            case 2: return &ffi_type_sint16;
2851            case 4: return &ffi_type_sint32;
2852            case 8: return &ffi_type_sint64;
2853            default: ASSERT(0);
2854            }
2855        }
2856        case 3: // Unsigned integer.
2857        {
2858            switch (typeSize.UnTaggedUnsigned())
2859            {
2860            case 1: return &ffi_type_uint8;
2861            case 2: return &ffi_type_uint16;
2862            case 4: return &ffi_type_uint32;
2863            case 8: return &ffi_type_uint64;
2864            default: ASSERT(0);
2865            }
2866        }
2867        case 4: // Void
2868            return &ffi_type_void;
2869        }
2870        ASSERT(0);
2871    }
2872    return 0;
2873}
2874
2875// Create a CIF.  This contains all the types and some extra information.
2876// The arguments are the raw ML values.  That does make this dependent on the
2877// representations used by the compiler.
2878// This mallocs space for the CIF and the types.  The space is never freed.
2879//
2880POLYUNSIGNED PolyInterpretedCreateCIF(FirstArgument threadId, PolyWord abiValue, PolyWord resultType, PolyWord argTypes)
2881{
2882    TaskData* taskData = TaskData::FindTaskForId(threadId);
2883    ASSERT(taskData != 0);
2884    taskData->PreRTSCall();
2885    Handle reset = taskData->saveVec.mark();
2886    Handle result = 0;
2887    ffi_abi abi = (ffi_abi)get_C_ushort(taskData, abiValue);
2888
2889    try {
2890        unsigned nArgs = 0;
2891        for (PolyWord p = argTypes; !ML_Cons_Cell::IsNull(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t)
2892            nArgs++;
2893        // Allocate space for the cif followed by the argument type vector
2894        size_t space = sizeof(ffi_cif) + nArgs * sizeof(ffi_type*);
2895        ffi_cif* cif = (ffi_cif*)malloc(space);
2896        if (cif == 0) raise_syscall(taskData, "Insufficient memory", ENOMEM);
2897        ffi_type* rtype = decodeType(resultType);
2898        if (rtype == 0) raise_syscall(taskData, "Insufficient memory", ENOMEM);
2899        ffi_type** atypes = (ffi_type**)(cif + 1);
2900        // Copy the arguments types.
2901        ffi_type** at = atypes;
2902        for (PolyWord p = argTypes; !ML_Cons_Cell::IsNull(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t)
2903        {
2904            PolyWord e = ((ML_Cons_Cell*)p.AsObjPtr())->h;
2905            ffi_type *atype = decodeType(e);
2906            if (atype == 0) raise_syscall(taskData, "Insufficient memory", ENOMEM);
2907            *at++ = atype;
2908        }
2909        ffi_status status = ffi_prep_cif(cif, abi, nArgs, rtype, atypes);
2910        if (status == FFI_BAD_TYPEDEF)
2911            raise_exception_string(taskData, EXC_foreign, "Bad typedef in ffi_prep_cif");
2912        else if (status == FFI_BAD_ABI)
2913            raise_exception_string(taskData, EXC_foreign, "Bad ABI in ffi_prep_cif");
2914        else if (status != FFI_OK)
2915            raise_exception_string(taskData, EXC_foreign, "Error in ffi_prep_cif");
2916        result = toSysWord(taskData, cif);
2917    }
2918    catch (...) {} // If an ML exception is raised
2919
2920    taskData->saveVec.reset(reset);
2921    taskData->PostRTSCall();
2922    if (result == 0) return TAGGED(0).AsUnsigned();
2923    else return result->Word().AsUnsigned();
2924}
2925
2926// Call a function.
2927POLYUNSIGNED PolyInterpretedCallFunction(FirstArgument threadId, PolyWord cifAddr, PolyWord cFunAddr, PolyWord resAddr, PolyWord argVec)
2928{
2929    ffi_cif* cif = *(ffi_cif**)cifAddr.AsAddress();
2930    void* f = *(void**)cFunAddr.AsAddress();
2931    void* res = *(void**)resAddr.AsAddress();
2932    void* arg = *(void**)argVec.AsAddress();
2933    // Poly passes the arguments as values, effectively a single struct.
2934    // Libffi wants a vector of addresses.
2935    void** argVector = (void**)calloc(cif->nargs + 1, sizeof(void*));
2936    unsigned n = 0;
2937    uintptr_t p = (uintptr_t)arg;
2938    while (n < cif->nargs)
2939    {
2940        uintptr_t align = cif->arg_types[n]->alignment;
2941        p = (p + align - 1) & (0-align);
2942        argVector[n] = (void*)p;
2943        p += cif->arg_types[n]->size;
2944        n++;
2945    }
2946    // The result area we have provided is only as big as required.
2947    // Libffi may need a larger area.
2948    if (cif->rtype->size < FFI_SIZEOF_ARG)
2949    {
2950        char result[FFI_SIZEOF_ARG];
2951        ffi_call(cif, FFI_FN(f), &result, argVector);
2952        if (cif->rtype->type != FFI_TYPE_VOID)
2953            memcpy(res, result, cif->rtype->size);
2954    }
2955    else ffi_call(cif, FFI_FN(f), res, argVector);
2956    free(argVector);
2957    return TAGGED(0).AsUnsigned();
2958}
2959
2960#else
2961// Libffi is not present.
2962
2963// A basic table so that the Foreign structure will compile
2964static struct _abiTable { const char* abiName; int abiCode; } abiTable[] =
2965{
2966        { "default", 0}
2967};
2968
2969// Don't raise an exception at this point so we can build calls.
2970POLYUNSIGNED PolyInterpretedCreateCIF(FirstArgument threadId, PolyWord abiValue, PolyWord resultType, PolyWord argTypes)
2971{
2972    return TAGGED(0).AsUnsigned();
2973}
2974
2975POLYUNSIGNED PolyInterpretedCallFunction(FirstArgument threadId, PolyWord cifAddr, PolyWord cFunAddr, PolyWord resAddr, PolyWord argVec)
2976{
2977    TaskData* taskData = TaskData::FindTaskForId(threadId);
2978    try {
2979        raise_exception_string(taskData, EXC_foreign, "Foreign function calling is not available.  Libffi is not installled.");
2980    } catch (...) {} // Handle the IOException
2981    return TAGGED(0).AsUnsigned();
2982}
2983
2984#endif
2985
2986// Construct an entry in the ABI table.
2987static Handle mkAbitab(TaskData* taskData, void* arg, char* p)
2988{
2989    struct _abiTable* ab = (struct _abiTable*)p;
2990    // Construct a pair of the string and the code
2991    Handle name = taskData->saveVec.push(C_string_to_Poly(taskData, ab->abiName));
2992    Handle code = Make_arbitrary_precision(taskData, ab->abiCode);
2993    Handle result = alloc_and_save(taskData, 2);
2994    result->WordP()->Set(0, name->Word());
2995    result->WordP()->Set(1, code->Word());
2996    return result;
2997}
2998
2999// Get ABI list.  This is called once only before the basis library is built.
3000POLYUNSIGNED PolyInterpretedGetAbiList(FirstArgument threadId)
3001{
3002    TaskData* taskData = TaskData::FindTaskForId(threadId);
3003    ASSERT(taskData != 0);
3004    taskData->PreRTSCall();
3005    Handle reset = taskData->saveVec.mark();
3006    Handle result = 0;
3007
3008    try {
3009        result = makeList(taskData, sizeof(abiTable) / sizeof(abiTable[0]),
3010            (char*)abiTable, sizeof(abiTable[0]), 0, mkAbitab);
3011    }
3012    catch (...) {} // If an ML exception is raised
3013
3014    taskData->saveVec.reset(reset);
3015    taskData->PostRTSCall();
3016    if (result == 0) return TAGGED(0).AsUnsigned();
3017    else return result->Word().AsUnsigned();
3018}
3019
3020// Do we require EnterInt instructions and if so for which architecture?
3021// 0 = > None; 1 => X86_32, 2 => X86_64. 3 => X86_32_in_64.
3022POLYUNSIGNED PolyInterpretedEnterIntMode()
3023{
3024    return TAGGED(0).AsUnsigned();
3025}
3026
3027static Interpreter interpreterObject;
3028
3029MachineDependent *machineDependent = &interpreterObject;
3030
3031// No machine-specific calls in the interpreter.
3032struct _entrypts machineSpecificEPT[] =
3033{
3034    { "PolyInterpretedGetAbiList",           (polyRTSFunction)&PolyInterpretedGetAbiList },
3035    { "PolyInterpretedCreateCIF",            (polyRTSFunction)&PolyInterpretedCreateCIF },
3036    { "PolyInterpretedCallFunction",         (polyRTSFunction)&PolyInterpretedCallFunction },
3037    { "PolyInterpretedEnterIntMode",         (polyRTSFunction)&PolyInterpretedEnterIntMode },
3038   { NULL, NULL} // End of list.
3039};
3040