ghc/rts/Assembler.c

   1 /* -*- mode: hugs-c; -*- */
   2 /* --------------------------------------------------------------------------
   3  * $Id: Assembler.c,v 1.4 1999/02/05 16:02:34 simonm Exp $
   4  *
   5  * Copyright (c) The GHC Team 1994-1998.
   6  *
   7  * Bytecode assembler
   8  *
   9  * This module provides functions to construct BCOs and other closures
  10  * required by the bytecode compiler.
  11  *
  12  * It is supposed to shield the compiler from platform dependent information
  13  * such as:
  14  *
  15  * o sizeof(StgFloat)
  16  * o sizeof(I#)
  17  *
  18  * and from details of how the abstract machine is implemented such as:
  19  *
  20  * o what does a BCO look like?
  21  * o how many bytes does the "Push InfoTable" instruction require?
  22  *
  23  * Details of design:
  24  * o (To handle letrecs) We allocate Aps, Paps and Cons using number of
  25  *   heap allocated args to determine size.
  26  *   We can't handle unboxed args :-(
  27  * o All stack offsets are relative to position of Sp at start of
  28  *   function or thunk (not BCO - consider continuations)
  29  * o Active thunks must be roots during GC - how to achieve this?
  30  * o Each BCO contains its own stack and heap check
  31  *   We don't try to exploit the Hp check optimisation - easier to make
  32  *   each thunk stand on its own.
  33  * o asBind returns a "varid" (which is, in fact, a stack offset)
  34  *   asVar acts on a "varid" - combining it with the current stack size to
  35  *   determine actual position
  36  * o Assembler.h uses totally neutral types: strings, floats, ints, etc
  37  *   to minimise conflicts with other parts of the system.
  38  * Simulated Stack
  39  * ------------------------------------------------------------------------*/
  40
  41 #include "Rts.h"
  42
  43 #ifdef INTERPRETER
  44
  45 #include "RtsFlags.h"
  46 #include "RtsUtils.h"
  47 #include "Bytecodes.h"
  48 #include "Printer.h"
  49 #include "Disassembler.h"
  50 #include "Evaluator.h"
  51 #include "StgMiscClosures.h"
  52 #include "Storage.h"
  53
  54 #define INSIDE_ASSEMBLER_C
  55 #include "Assembler.h"
  56 #undef INSIDE_ASSEMBLER_C
  57
  58 /* --------------------------------------------------------------------------
  59  * References between BCOs
  60  *
  61  * These are necessary because there can be circular references between
  62  * BCOs so we have to keep track of all the references to each object
  63  * and fill in all the references once we're done.
  64  *
  65  * ToDo: generalise to allow references between any objects
  66  * ------------------------------------------------------------------------*/
  67
  68 typedef struct {
  69     AsmObject ref;  /* who refers to it                       */
  70     AsmNat i;       /* index into some table held by referer  */
  71 } AsmRef;
  72
  73 /* --------------------------------------------------------------------------
  74  * Queues (of instructions, ptrs, nonptrs)
  75  * ------------------------------------------------------------------------*/
  76
  77 /* ToDo: while debugging, we use a chunk size of 1 to stress-test the code
  78  * this should be fine-tuned using statistics on common sizes
  79  */
  80
  81 #define InstrsChunkSize  40
  82 #define PtrsChunkSize    10
  83 #define RefsChunkSize    10
  84 #define NonPtrsChunkSize 10
  85
  86 #define Queue Instrs
  87 #define Type  StgNat8
  88 #include "QueueTemplate.h"
  89 #undef Type
  90 #undef Queue
  91
  92 #define Queue Ptrs
  93 #define Type  AsmObject
  94 #include "QueueTemplate.h"
  95 #undef Type
  96 #undef Queue
  97
  98 #define Queue Refs
  99 #define Type  AsmRef
 100 #include "QueueTemplate.h"
 101 #undef Type
 102 #undef Queue
 103
 104 #define Queue NonPtrs
 105 #define Type  StgWord
 106 #include "QueueTemplate.h"
 107 #undef Type
 108 #undef Queue
 109
 110 /* --------------------------------------------------------------------------
 111  * AsmObjects are used to build heap objects.
 112  *
 113  * AsmObjects can contain circular references to each other
 114  * so we have to keep track of all the references which can't be filled
 115  * in yet.
 116  *
 117  * When we finish building an AsmObject, we allocate an actual heap object and
 118  * fill in all the references to the asmObject with pointers to the heap object.
 119  *
 120  * We obtain a limited form of polymorphism through inheritance by putting
 121  * the AsmObject first in every structure (as in C++ implementations).
 122  * We use the closure type of the allocated object to figure out
 123  * where the payload lives in the closure.
 124  * ------------------------------------------------------------------------*/
 125 /* ToDo: clean up terminology: is Closure right or should it be object or ... */
 126
 127 struct AsmObject_ {
 128     Refs           refs;
 129     Ptrs           ptrs;
 130     AsmNat         num_unresolved; /* number of unfilled references */
 131     StgClosure*    closure;        /* where object was allocated    */
 132 };
 133
 134 struct AsmCon_ {
 135     struct AsmObject_ object;  /* must be first in struct */
 136
 137     AsmInfo info;
 138 };
 139
 140 struct AsmCAF_ {
 141     struct AsmObject_ object;  /* must be first in struct */
 142 };
 143
 144 struct AsmBCO_ {
 145     struct AsmObject_ object;  /* must be first in struct */
 146
 147     Instrs   is;
 148     NonPtrs  nps;
 149
 150     /* abstract machine ("executed" during compilation) */
 151     AsmSp    sp;          /* stack ptr */
 152     AsmSp    max_sp;
 153     StgWord  hp;          /* heap ptr  */
 154     StgWord  max_hp;
 155 };
 156
 157 static void asmResolveRef( AsmObject obj, AsmNat i, AsmClosure reference )
 158 {
 159     ASSERT(obj->closure);
 160     switch (get_itbl(obj->closure)->type) {
 161     case BCO:
 162         {
 163             StgBCO* bco = stgCast(StgBCO*,obj->closure);
 164             ASSERT(i < bco->n_ptrs && bcoConstPtr(bco,i) == NULL);
 165             bcoConstCPtr(bco,i) = reference;
 166             break;
 167         }
 168     case CAF_UNENTERED:
 169         {
 170             StgCAF* caf = stgCast(StgCAF*,obj->closure);
 171             ASSERT(i == 0 && caf->body == NULL);
 172             caf->body = reference;
 173             break;
 174         }
 175     case CONSTR:
 176         {
 177             StgClosure* con = stgCast(StgClosure*,obj->closure);
 178             ASSERT(i < get_itbl(con)->layout.payload.nptrs && payloadCPtr(con,i) == NULL);
 179             payloadCPtr(con,i) = reference;
 180             break;
 181         }
 182     case AP_UPD:
 183         {
 184             StgAP_UPD* ap = stgCast(StgAP_UPD*,obj->closure);
 185             ASSERT(i < 1+ap->n_args);
 186             if (i==0) {
 187                 ASSERT(ap->fun == NULL);
 188                 ap->fun = reference;
 189             } else {
 190                 ASSERT(payloadCPtr(ap,i-1) == NULL);
 191                 payloadCPtr(ap,i-1) = reference;
 192             }
 193             break;
 194         }
 195     default:
 196             barf("asmResolveRef");
 197     }
 198     obj->num_unresolved -= 1;
 199
 200     if (obj->num_unresolved == 0) {
 201         /* todo: free the queues */
 202
 203         /* we don't print until all ptrs are resolved */
 204         IF_DEBUG(codegen,printObj(obj->closure));
 205     }
 206 }
 207
 208 static void asmAddRef( AsmObject referent, AsmObject referer, AsmNat i )
 209 {
 210     if (referent->closure) {
 211         asmResolveRef(referer,i,(AsmClosure)referent->closure);
 212     } else {
 213         insertRefs(&(referent->refs),(AsmRef){referer,i});
 214     }
 215 }
 216
 217 void asmAddPtr( AsmObject obj, AsmObject arg )
 218 {
 219     ASSERT(obj->closure == 0); /* can't extend an object once it's allocated */
 220     insertPtrs( &obj->ptrs, arg );
 221 }
 222
 223 static void asmBeginObject( AsmObject obj )
 224 {
 225     obj->closure = NULL;
 226     obj->num_unresolved = 0;
 227     initRefs(&obj->refs);
 228     initPtrs(&obj->ptrs);
 229 }
 230
 231 static void asmEndObject( AsmObject obj, StgClosure* c )
 232 {
 233     obj->num_unresolved = obj->ptrs.len;
 234     obj->closure = c;
 235     mapQueue(Ptrs,    AsmObject, obj->ptrs, asmAddRef(x,obj,i));
 236     mapQueue(Refs,    AsmRef,    obj->refs, asmResolveRef(x.ref,x.i,c));
 237     if (obj->num_unresolved == 0) {
 238         /* todo: free the queues */
 239         /* we don't print until all ptrs are resolved */
 240         IF_DEBUG(codegen,printObj(obj->closure));
 241     }
 242 }
 243
 244 int asmObjectHasClosure ( AsmObject obj )
 245 {
 246     return (obj->num_unresolved == 0 && obj->closure);
 247 }
 248
 249 AsmClosure asmClosureOfObject ( AsmObject obj )
 250 {
 251     ASSERT(asmObjectHasClosure(obj));
 252     return obj->closure;
 253 }
 254
 255 void asmMarkObject ( AsmObject obj )
 256 {
 257     ASSERT(obj->num_unresolved == 0 && obj->closure);
 258     obj->closure = MarkRoot(obj->closure);
 259 }
 260
 261 /* --------------------------------------------------------------------------
 262  * Heap allocation
 263  * ------------------------------------------------------------------------*/
 264
 265 static StgClosure* asmAlloc( nat size )
 266 {
 267     StgClosure* o = stgCast(StgClosure*,allocate(size));
 268     ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
 269     /* printf("Allocated %p .. %p\n", o, o+size-1); */
 270     return o;
 271 }
 272
 273 static void grabHpUpd( AsmBCO bco, nat size )
 274 {
 275     /* ToDo: sometimes we should test for MIN_UPD_SIZE instead */
 276     ASSERT( size >= MIN_UPD_SIZE + sizeofW(StgHeader) );
 277     bco->hp += size;
 278 }
 279
 280 static void grabHpNonUpd( AsmBCO bco, nat size )
 281 {
 282     /* ToDo: sometimes we should test for MIN_UPD_SIZE instead */
 283     ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
 284     bco->hp += size;
 285 }
 286
 287 static void resetHp( AsmBCO bco, nat hp )
 288 {
 289     bco->max_hp = stg_max(bco->hp,bco->max_hp);
 290     bco->hp     = hp;
 291 }
 292
 293 static void resetSp( AsmBCO bco, AsmSp sp )
 294 {
 295     bco->max_sp = stg_max(bco->sp,bco->max_sp);
 296     bco->sp     = sp;
 297 }
 298
 299 /* --------------------------------------------------------------------------
 300  *
 301  * ------------------------------------------------------------------------*/
 302
 303 AsmObject asmMkObject( AsmClosure c )
 304 {
 305     AsmObject obj = malloc(sizeof(struct AsmObject_));
 306     if (obj == NULL) {
 307         barf("Can't allocate AsmObject");
 308     }
 309     asmBeginObject(obj);
 310     asmEndObject(obj,c);
 311     return obj;
 312 }
 313
 314 AsmCon asmBeginCon( AsmInfo info )
 315 {
 316     AsmCon con = malloc(sizeof(struct AsmCon_));
 317     if (con == NULL) {
 318         barf("Can't allocate AsmCon");
 319     }
 320     asmBeginObject(&con->object);
 321     con->info = info;
 322     return con;
 323 }
 324
 325 void asmEndCon( AsmCon con )
 326 {
 327     nat p  = con->object.ptrs.len;
 328     nat np = stg_max(0,MIN_NONUPD_SIZE-p);
 329
 330     StgClosure* c = asmAlloc(CONSTR_sizeW(p,np));
 331     StgClosure* o = stgCast(StgClosure*,c);
 332     SET_HDR(o,con->info,??);
 333     mapQueue(Ptrs,    AsmObject, con->object.ptrs, payloadCPtr(o,i) = NULL);
 334     { nat i; for( i=0; i<np; ++i ) { payloadWord(o,p+i) = 0xdeadbeef; } }
 335     asmEndObject(&con->object,c);
 336 }
 337
 338 AsmCAF asmBeginCAF( void )
 339 {
 340     AsmCAF caf = malloc(sizeof(struct AsmCAF_));
 341     if (caf == NULL) {
 342         barf("Can't allocate AsmCAF");
 343     }
 344     asmBeginObject(&caf->object);
 345     return caf;
 346 }
 347
 348 void asmEndCAF( AsmCAF caf, AsmBCO body )
 349 {
 350     StgClosure* c = asmAlloc(CAF_sizeW());
 351     StgCAF*     o = stgCast(StgCAF*,c);
 352     SET_HDR(o,&CAF_UNENTERED_info,??);
 353     o->body  = NULL;
 354     o->value = stgCast(StgClosure*,0xdeadbeef);
 355     o->link  = stgCast(StgCAF*,0xdeadbeef);
 356     asmAddPtr(&caf->object,&body->object);
 357     asmEndObject(&caf->object,c);
 358 }
 359
 360 AsmBCO asmBeginBCO( void )
 361 {
 362     AsmBCO bco = malloc(sizeof(struct AsmBCO_));
 363     if (bco == NULL) {
 364         barf("Can't allocate AsmBCO");
 365     }
 366     asmBeginObject(&bco->object);
 367     initInstrs(&bco->is);
 368     initNonPtrs(&bco->nps);
 369
 370     bco->max_sp = bco->sp = 0;
 371     bco->max_hp = bco->hp = 0;
 372     return bco;
 373 }
 374
 375 void asmEndBCO( AsmBCO bco )
 376 {
 377     nat p  = bco->object.ptrs.len;
 378     nat np = bco->nps.len;
 379 #if 0
 380     nat is = bco->is.len + 4;  /* 4 for stack and heap checks */
 381 #else
 382     nat is = bco->is.len + 2;  /* 4 for stack check */
 383 #endif
 384
 385     StgClosure* c = asmAlloc(BCO_sizeW(p,np,is));
 386     StgBCO*     o = stgCast(StgBCO*,c);
 387     SET_HDR(o,&BCO_info,??);
 388     o->n_ptrs   = p;
 389     o->n_words  = np;
 390     o->n_instrs = is;
 391     mapQueue(Ptrs,    AsmObject, bco->object.ptrs, bcoConstCPtr(o,i) = NULL);
 392     mapQueue(NonPtrs, StgWord,   bco->nps,  bcoConstWord(o,i) = x);
 393     {
 394         nat j = 0;
 395         bco->max_sp = stg_max(bco->sp,bco->max_sp);
 396         bco->max_hp = stg_max(bco->hp,bco->max_hp);
 397         bcoInstr(o,j++) = i_STK_CHECK;
 398         bcoInstr(o,j++) = bco->max_sp;
 399 #if 0
 400         bcoInstr(o,j++) = i_HP_CHECK;
 401         bcoInstr(o,j++) = bco->max_hp;
 402 #endif
 403         mapQueue(Instrs,  StgNat8,   bco->is,   bcoInstr(o,j++) = x);
 404         ASSERT(j == is);
 405     }
 406     asmEndObject(&bco->object,c);
 407 }
 408
 409 /* --------------------------------------------------------------------------
 410  *
 411  * ------------------------------------------------------------------------*/
 412
 413 static void asmInstr( AsmBCO bco, StgWord i )
 414 {
 415     ASSERT(i < 256); /* must be a byte */
 416     insertInstrs(&(bco->is),i);
 417 }
 418
 419 static void asmPtr( AsmBCO bco, AsmObject x )
 420 {
 421     insertPtrs( &bco->object.ptrs, x );
 422 }
 423
 424 static void asmWord( AsmBCO bco, StgWord i )
 425 {
 426     insertNonPtrs( &bco->nps, i );
 427 }
 428
 429 #define asmWords(bco,ty,x)                               \
 430     {                                                    \
 431         union { ty a; AsmWord b[sizeofW(ty)]; } p;       \
 432         nat i;                                           \
 433         p.a = x;                                         \
 434         for( i = 0; i < sizeofW(ty); i++ ) {             \
 435             asmWord(bco,p.b[i]);                         \
 436         }                                                \
 437     }
 438
 439 static StgWord repSizeW( AsmRep rep )
 440 {
 441     switch (rep) {
 442     case CHAR_REP:    return sizeofW(StgWord) + sizeofW(StgChar);
 443
 444     case BOOL_REP:
 445     case INT_REP:     return sizeofW(StgWord) + sizeofW(StgInt);
 446 #ifdef PROVIDE_INT64
 447     case INT64_REP:   return sizeofW(StgWord) + sizeofW(StgInt64);
 448 #endif
 449 #ifdef PROVIDE_WORD
 450     case WORD_REP:    return sizeofW(StgWord) + sizeofW(StgWord);
 451 #endif
 452 #ifdef PROVIDE_ADDR
 453     case ADDR_REP:    return sizeofW(StgWord) + sizeofW(StgAddr);
 454 #endif
 455     case FLOAT_REP:   return sizeofW(StgWord) + sizeofW(StgFloat);
 456     case DOUBLE_REP:  return sizeofW(StgWord) + sizeofW(StgDouble);
 457 #ifdef PROVIDE_STABLE
 458     case STABLE_REP:  return sizeofW(StgWord) + sizeofW(StgWord);
 459 #endif
 460
 461 #ifdef PROVIDE_INTEGER
 462     case INTEGER_REP:
 463 #endif
 464 #ifdef PROVIDE_WEAK
 465     case WEAK_REP:
 466 #endif
 467 #ifdef PROVIDE_FOREIGN
 468     case FOREIGN_REP:
 469 #endif
 470     case ALPHA_REP:    /* a                        */
 471     case BETA_REP:     /* b                        */
 472     case GAMMA_REP:    /* c                        */
 473     case HANDLER_REP:  /* IOError -> IO a          */
 474     case ERROR_REP:    /* IOError                  */
 475 #ifdef PROVIDE_ARRAY
 476     case ARR_REP    :  /* PrimArray              a */
 477     case BARR_REP   :  /* PrimByteArray          a */
 478     case REF_REP    :  /* Ref                  s a */
 479     case MUTARR_REP :  /* PrimMutableArray     s a */
 480     case MUTBARR_REP:  /* PrimMutableByteArray s a */
 481 #endif
 482 #ifdef PROVIDE_CONCURRENT
 483     case THREADID_REP: /* ThreadId                 */
 484     case MVAR_REP:     /* MVar a                   */
 485 #endif
 486     case PTR_REP:     return sizeofW(StgPtr);
 487
 488     case VOID_REP:    return sizeofW(StgWord);
 489     default:          barf("repSizeW %d",rep);
 490     }
 491 }
 492
 493 /* --------------------------------------------------------------------------
 494  * Arg checks.
 495  * ------------------------------------------------------------------------*/
 496
 497 AsmSp  asmBeginArgCheck ( AsmBCO bco )
 498 {
 499     ASSERT(bco->sp == 0);
 500     return bco->sp;
 501 }
 502
 503 void   asmEndArgCheck   ( AsmBCO bco, AsmSp last_arg )
 504 {
 505     nat args = bco->sp - last_arg;
 506     if (args != 0) { /* optimisation */
 507         asmInstr(bco,i_ARG_CHECK);
 508         asmInstr(bco,args);
 509         grabHpNonUpd(bco,PAP_sizeW(args-1));
 510         resetHp(bco,0);
 511     }
 512 }
 513
 514 /* --------------------------------------------------------------------------
 515  * Creating and using "variables"
 516  * ------------------------------------------------------------------------*/
 517
 518 AsmVar asmBind          ( AsmBCO bco, AsmRep rep )
 519 {
 520     bco->sp += repSizeW(rep);
 521     return bco->sp;
 522 }
 523
 524 void   asmVar           ( AsmBCO bco, AsmVar v, AsmRep rep )
 525 {
 526     switch (rep) {
 527     case BOOL_REP:
 528     case INT_REP:
 529             asmInstr(bco,i_VAR_INT);
 530             break;
 531 #ifdef PROVIDE_INT64
 532     case INT64_REP:
 533             asmInstr(bco,i_VAR_INT64);
 534             break;
 535 #endif
 536 #ifdef PROVIDE_WORD
 537     case WORD_REP:
 538             asmInstr(bco,i_VAR_WORD);
 539             break;
 540 #endif
 541 #ifdef PROVIDE_ADDR
 542     case ADDR_REP:
 543             asmInstr(bco,i_VAR_ADDR);
 544             break;
 545 #endif
 546     case CHAR_REP:
 547             asmInstr(bco,i_VAR_CHAR);
 548             break;
 549     case FLOAT_REP:
 550             asmInstr(bco,i_VAR_FLOAT);
 551             break;
 552     case DOUBLE_REP:
 553             asmInstr(bco,i_VAR_DOUBLE);
 554             break;
 555 #ifdef PROVIDE_STABLE
 556     case STABLE_REP:
 557             asmInstr(bco,i_VAR_STABLE);
 558             break;
 559 #endif
 560
 561 #ifdef PROVIDE_INTEGER
 562     case INTEGER_REP:
 563 #endif
 564 #ifdef PROVIDE_WEAK
 565     case WEAK_REP:
 566 #endif
 567 #ifdef PROVIDE_FOREIGN
 568     case FOREIGN_REP:
 569 #endif
 570     case ALPHA_REP:    /* a                        */
 571     case BETA_REP:     /* b                        */
 572     case GAMMA_REP:    /* c                        */
 573     case HANDLER_REP:  /* IOError -> IO a          */
 574     case ERROR_REP:    /* IOError                  */
 575 #ifdef PROVIDE_ARRAY
 576     case ARR_REP    :  /* PrimArray              a */
 577     case BARR_REP   :  /* PrimByteArray          a */
 578     case REF_REP    :  /* Ref                  s a */
 579     case MUTARR_REP :  /* PrimMutableArray     s a */
 580     case MUTBARR_REP:  /* PrimMutableByteArray s a */
 581 #endif
 582 #ifdef PROVIDE_CONCURRENT
 583     case THREADID_REP: /* ThreadId                 */
 584     case MVAR_REP:     /* MVar a                   */
 585 #endif
 586     case PTR_REP:
 587             asmInstr(bco,i_VAR);
 588             break;
 589
 590     case VOID_REP:
 591             asmInstr(bco,i_VOID);
 592             bco->sp += repSizeW(rep);
 593             return; /* NB we don't break! */
 594     default:
 595             barf("asmVar %d",rep);
 596     }
 597     asmInstr(bco,bco->sp - v);
 598     bco->sp += repSizeW(rep);
 599 }
 600
 601 /* --------------------------------------------------------------------------
 602  * Tail calls
 603  * ------------------------------------------------------------------------*/
 604
 605 AsmSp asmBeginEnter( AsmBCO bco )
 606 {
 607     return bco->sp;
 608 }
 609
 610 void asmEndEnter( AsmBCO bco, AsmSp sp1, AsmSp sp2 )
 611 {
 612     int x = bco->sp - sp1;
 613     int y = sp1 - sp2;
 614     ASSERT(x >= 0 && y >= 0);
 615     if (y != 0) {
 616         asmInstr(bco,i_SLIDE);
 617         asmInstr(bco,x);
 618         asmInstr(bco,y);
 619         bco->sp -= sp1 - sp2;
 620     }
 621     asmInstr(bco,i_ENTER);
 622 }
 623
 624 /* --------------------------------------------------------------------------
 625  * Build boxed Ints, Floats, etc
 626  * ------------------------------------------------------------------------*/
 627
 628 AsmVar asmBox( AsmBCO bco, AsmRep rep )
 629 {
 630     switch (rep) {
 631     case CHAR_REP:
 632             asmInstr(bco,i_PACK_CHAR);
 633             grabHpNonUpd(bco,Czh_sizeW);
 634             break;
 635     case INT_REP:
 636             asmInstr(bco,i_PACK_INT);
 637             grabHpNonUpd(bco,Izh_sizeW);
 638             break;
 639 #ifdef PROVIDE_INT64
 640     case INT64_REP:
 641             asmInstr(bco,i_PACK_INT64);
 642             grabHpNonUpd(bco,I64zh_sizeW);
 643             break;
 644 #endif
 645 #ifdef PROVIDE_WORD
 646     case WORD_REP:
 647             asmInstr(bco,i_PACK_WORD);
 648             grabHpNonUpd(bco,Wzh_sizeW);
 649             break;
 650 #endif
 651 #ifdef PROVIDE_ADDR
 652     case ADDR_REP:
 653             asmInstr(bco,i_PACK_ADDR);
 654             grabHpNonUpd(bco,Azh_sizeW);
 655             break;
 656 #endif
 657     case FLOAT_REP:
 658             asmInstr(bco,i_PACK_FLOAT);
 659             grabHpNonUpd(bco,Fzh_sizeW);
 660             break;
 661     case DOUBLE_REP:
 662             asmInstr(bco,i_PACK_DOUBLE);
 663             grabHpNonUpd(bco,Dzh_sizeW);
 664             break;
 665 #ifdef PROVIDE_STABLE
 666     case STABLE_REP:
 667             asmInstr(bco,i_PACK_STABLE);
 668             grabHpNonUpd(bco,Stablezh_sizeW);
 669             break;
 670 #endif
 671
 672     default:
 673             barf("asmBox %d",rep);
 674     }
 675     /* NB: these operations DO pop their arg       */
 676     bco->sp -= repSizeW(rep);   /* pop unboxed arg */
 677     bco->sp += sizeofW(StgPtr); /* push box        */
 678     return bco->sp;
 679 }
 680
 681 /* --------------------------------------------------------------------------
 682  * Unbox Ints, Floats, etc
 683  * ------------------------------------------------------------------------*/
 684
 685 AsmVar asmUnbox( AsmBCO bco, AsmRep rep )
 686 {
 687     switch (rep) {
 688     case INT_REP:
 689             asmInstr(bco,i_UNPACK_INT);
 690             break;
 691 #ifdef PROVIDE_INT64
 692     case INT64_REP:
 693             asmInstr(bco,i_UNPACK_INT64);
 694             break;
 695 #endif
 696 #ifdef PROVIDE_WORD
 697     case WORD_REP:
 698             asmInstr(bco,i_UNPACK_WORD);
 699             break;
 700 #endif
 701 #ifdef PROVIDE_ADDR
 702     case ADDR_REP:
 703             asmInstr(bco,i_UNPACK_ADDR);
 704             break;
 705 #endif
 706     case CHAR_REP:
 707             asmInstr(bco,i_UNPACK_CHAR);
 708             break;
 709     case FLOAT_REP:
 710             asmInstr(bco,i_UNPACK_FLOAT);
 711             break;
 712     case DOUBLE_REP:
 713             asmInstr(bco,i_UNPACK_DOUBLE);
 714             break;
 715     case STABLE_REP:
 716             asmInstr(bco,i_UNPACK_STABLE);
 717             break;
 718
 719     default:
 720             barf("asmUnbox %d",rep);
 721     }
 722     /* NB: these operations DO NOT pop their arg  */
 723     bco->sp += repSizeW(rep); /* push unboxed arg */
 724     return bco->sp;
 725 }
 726
 727 /* --------------------------------------------------------------------------
 728  * Return unboxed Ints, Floats, etc
 729  * ------------------------------------------------------------------------*/
 730
 731 void asmReturnUnboxed( AsmBCO bco, AsmRep rep )
 732 {
 733     switch (rep) {
 734     case CHAR_REP:
 735             asmInstr(bco,i_RETURN_CHAR);
 736             break;
 737     case INT_REP:
 738             asmInstr(bco,i_RETURN_INT);
 739             break;
 740 #ifdef PROVIDE_INT64
 741     case INT64_REP:
 742             asmInstr(bco,i_RETURN_INT64);
 743             break;
 744 #endif
 745 #ifdef PROVIDE_WORD
 746     case WORD_REP:
 747             asmInstr(bco,i_RETURN_WORD);
 748             break;
 749 #endif
 750 #ifdef PROVIDE_ADDR
 751     case ADDR_REP:
 752             asmInstr(bco,i_RETURN_ADDR);
 753             break;
 754 #endif
 755     case FLOAT_REP:
 756             asmInstr(bco,i_RETURN_FLOAT);
 757             break;
 758     case DOUBLE_REP:
 759             asmInstr(bco,i_RETURN_DOUBLE);
 760             break;
 761 #ifdef PROVIDE_STABLE
 762     case STABLE_REP:
 763             asmInstr(bco,i_RETURN_STABLE);
 764             break;
 765 #endif
 766 #ifdef PROVIDE_INTEGER
 767     case INTEGER_REP:
 768 #endif
 769 #ifdef PROVIDE_WEAK
 770     case WEAK_REP:
 771 #endif
 772 #ifdef PROVIDE_FOREIGN
 773     case FOREIGN_REP:
 774 #endif
 775 #ifdef PROVIDE_ARRAY
 776     case ARR_REP    :  /* PrimArray              a */
 777     case BARR_REP   :  /* PrimByteArray          a */
 778     case REF_REP    :  /* Ref                  s a */
 779     case MUTARR_REP :  /* PrimMutableArray     s a */
 780     case MUTBARR_REP:  /* PrimMutableByteArray s a */
 781 #endif
 782 #ifdef PROVIDE_CONCURRENT
 783     case THREADID_REP: /* ThreadId                 */
 784     case MVAR_REP:     /* MVar a                   */
 785 #endif
 786             asmInstr(bco,i_RETURN_GENERIC);
 787             break;
 788     default:
 789             barf("asmReturnUnboxed %d",rep);
 790     }
 791 }
 792
 793 /* --------------------------------------------------------------------------
 794  * Push unboxed Ints, Floats, etc
 795  * ------------------------------------------------------------------------*/
 796
 797 void asmConstInt( AsmBCO bco, AsmInt x )
 798 {
 799     asmInstr(bco,i_CONST_INT);
 800     asmInstr(bco,bco->nps.len);
 801     asmWords(bco,AsmInt,x);
 802     bco->sp += repSizeW(INT_REP);
 803 }
 804
 805 #ifdef PROVIDE_INT64
 806 void asmConstInt64( AsmBCO bco, AsmInt64 x )
 807 {
 808     asmInstr(bco,i_CONST_INT64);
 809     asmInstr(bco,bco->nps.len);
 810     asmWords(bco,AsmInt64,x);
 811     bco->sp += repSizeW(INT64_REP);
 812 }
 813 #endif
 814
 815 #ifdef PROVIDE_INTEGER
 816 void asmConstInteger( AsmBCO bco, AsmString x )
 817 {
 818     asmInstr(bco,i_CONST_INTEGER);
 819     asmInstr(bco,bco->nps.len);
 820     asmWords(bco,AsmString,x);
 821     bco->sp += repSizeW(INTEGER_REP);
 822 }
 823 #endif
 824
 825 #ifdef PROVIDE_ADDR
 826 void asmConstAddr( AsmBCO bco, AsmAddr x )
 827 {
 828     asmInstr(bco,i_CONST_ADDR);
 829     asmInstr(bco,bco->nps.len);
 830     asmWords(bco,AsmAddr,x);
 831     bco->sp += repSizeW(ADDR_REP);
 832 }
 833 #endif
 834
 835 #ifdef PROVIDE_WORD
 836 void asmConstWord( AsmBCO bco, AsmWord x )
 837 {
 838     asmInstr(bco,i_CONST_INT);
 839     asmInstr(bco,bco->nps.len);
 840     asmWords(bco,AsmWord,x);
 841     bco->sp += repSizeW(WORD_REP);
 842 }
 843 #endif
 844
 845 void asmConstChar( AsmBCO bco, AsmChar x )
 846 {
 847     asmInstr(bco,i_CONST_CHAR);
 848     asmInstr(bco,bco->nps.len);
 849     asmWords(bco,AsmChar,x);
 850     bco->sp += repSizeW(CHAR_REP);
 851 }
 852
 853 void asmConstFloat( AsmBCO bco, AsmFloat x )
 854 {
 855     asmInstr(bco,i_CONST_FLOAT);
 856     asmInstr(bco,bco->nps.len);
 857     asmWords(bco,AsmFloat,x);
 858     bco->sp += repSizeW(FLOAT_REP);
 859 }
 860
 861 void asmConstDouble( AsmBCO bco, AsmDouble x )
 862 {
 863     asmInstr(bco,i_CONST_DOUBLE);
 864     asmInstr(bco,bco->nps.len);
 865     asmWords(bco,AsmDouble,x);
 866     bco->sp += repSizeW(DOUBLE_REP);
 867 }
 868
 869 /* --------------------------------------------------------------------------
 870  *
 871  * ------------------------------------------------------------------------*/
 872
 873 /* a mildly bogus pair of functions... */
 874 AsmSp asmBeginCase( AsmBCO bco )
 875 {
 876     return bco->sp;
 877 }
 878
 879 void asmEndCase( AsmBCO bco )
 880 {
 881 }
 882
 883 AsmSp asmContinuation( AsmBCO bco, AsmBCO ret_addr )
 884 {
 885     asmInstr(bco,i_RETADDR);
 886     asmInstr(bco,bco->object.ptrs.len);
 887     asmPtr(bco,&(ret_addr->object));
 888     bco->sp += 2 * sizeofW(StgPtr);
 889     return bco->sp;
 890 }
 891
 892 AsmBCO asmBeginContinuation ( AsmSp sp )
 893 {
 894     AsmBCO bco = asmBeginBCO();
 895     bco->sp = sp;
 896     return bco;
 897 }
 898
 899 void asmEndContinuation ( AsmBCO bco )
 900 {
 901     asmEndBCO(bco);
 902 }
 903
 904 /* --------------------------------------------------------------------------
 905  * Branches
 906  * ------------------------------------------------------------------------*/
 907
 908 AsmSp asmBeginAlt( AsmBCO bco )
 909 {
 910     return bco->sp;
 911 }
 912
 913 void asmEndAlt( AsmBCO bco, AsmSp  sp )
 914 {
 915 #if 0
 916     /* This warning is now redundant since we no longer use the hp/max_hp
 917      * information calculated by the assembler
 918      */
 919 #warning ToDo: adjust hp/max_hp in asmEndAlt
 920 #endif
 921     resetSp(bco,sp);
 922 }
 923
 924 AsmPc asmTest( AsmBCO bco, AsmWord tag )
 925 {
 926     asmInstr(bco,i_TEST);
 927     asmInstr(bco,tag);
 928     asmInstr(bco,0);
 929     return bco->is.len;
 930 }
 931
 932 AsmPc asmTestInt( AsmBCO bco, AsmVar v, AsmInt x )
 933 {
 934     asmVar(bco,v,INT_REP);
 935     asmConstInt(bco,x);
 936     asmInstr(bco,i_TEST_INT);
 937     asmInstr(bco,0);
 938     bco->sp -= 2*repSizeW(INT_REP);
 939     return bco->is.len;
 940 }
 941
 942 void asmFixBranch( AsmBCO bco, AsmPc from )
 943 {
 944     int distance = bco->is.len - from;
 945     ASSERT(distance >= 0);
 946     setInstrs(&(bco->is),from-1,distance);
 947 }
 948
 949 void asmPanic( AsmBCO bco )
 950 {
 951     asmInstr(bco,i_PANIC); /* "irrefutable" pattern failed - oops! */
 952 }
 953
 954 /* --------------------------------------------------------------------------
 955  * Primops
 956  * ------------------------------------------------------------------------*/
 957
 958 AsmSp asmBeginPrim( AsmBCO bco )
 959 {
 960     return bco->sp;
 961 }
 962
 963 void   asmEndPrim( AsmBCO bco, const AsmPrim* prim, AsmSp base )
 964 {
 965     asmInstr(bco,prim->prefix);
 966     asmInstr(bco,prim->opcode);
 967     bco->sp = base;
 968 }
 969
 970 /* Hugs used to let you add arbitrary primops with arbitrary types
 971  * just by editing Prelude.hs or any other file you wanted.
 972  * We deliberately avoided that approach because we wanted more
 973  * control over which primops are provided.
 974  */
 975 const AsmPrim asmPrimOps[] = {
 976
 977     /* Char# operations */
 978       { "primGtChar",                "CC", "B",  MONAD_Id, i_PRIMOP1, i_gtChar }
 979     , { "primGeChar",                "CC", "B",  MONAD_Id, i_PRIMOP1, i_geChar }
 980     , { "primEqChar",                "CC", "B",  MONAD_Id, i_PRIMOP1, i_eqChar }
 981     , { "primNeChar",                "CC", "B",  MONAD_Id, i_PRIMOP1, i_neChar }
 982     , { "primLtChar",                "CC", "B",  MONAD_Id, i_PRIMOP1, i_ltChar }
 983     , { "primLeChar",                "CC", "B",  MONAD_Id, i_PRIMOP1, i_leChar }
 984     , { "primCharToInt",             "C",  "I",  MONAD_Id, i_PRIMOP1, i_charToInt }
 985     , { "primIntToChar",             "I",  "C",  MONAD_Id, i_PRIMOP1, i_intToChar }
 986
 987     /* Int# operations */
 988     , { "primGtInt",                 "II", "B",  MONAD_Id, i_PRIMOP1, i_gtInt }
 989     , { "primGeInt",                 "II", "B",  MONAD_Id, i_PRIMOP1, i_geInt }
 990     , { "primEqInt",                 "II", "B",  MONAD_Id, i_PRIMOP1, i_eqInt }
 991     , { "primNeInt",                 "II", "B",  MONAD_Id, i_PRIMOP1, i_neInt }
 992     , { "primLtInt",                 "II", "B",  MONAD_Id, i_PRIMOP1, i_ltInt }
 993     , { "primLeInt",                 "II", "B",  MONAD_Id, i_PRIMOP1, i_leInt }
 994     , { "primMinInt",                "",   "I",  MONAD_Id, i_PRIMOP1, i_minInt }
 995     , { "primMaxInt",                "",   "I",  MONAD_Id, i_PRIMOP1, i_maxInt }
 996     , { "primPlusInt",               "II", "I",  MONAD_Id, i_PRIMOP1, i_plusInt }
 997     , { "primMinusInt",              "II", "I",  MONAD_Id, i_PRIMOP1, i_minusInt }
 998     , { "primTimesInt",              "II", "I",  MONAD_Id, i_PRIMOP1, i_timesInt }
 999     , { "primQuotInt",               "II", "I",  MONAD_Id, i_PRIMOP1, i_quotInt }
1000     , { "primRemInt",                "II", "I",  MONAD_Id, i_PRIMOP1, i_remInt }
1001     , { "primQuotRemInt",            "II", "II", MONAD_Id, i_PRIMOP1, i_quotRemInt }
1002     , { "primNegateInt",             "I",  "I",  MONAD_Id, i_PRIMOP1, i_negateInt }
1003
1004     , { "primAndInt",                "II", "I",  MONAD_Id, i_PRIMOP1, i_andInt }
1005     , { "primOrInt",                 "II", "I",  MONAD_Id, i_PRIMOP1, i_orInt }
1006     , { "primXorInt",                "II", "I",  MONAD_Id, i_PRIMOP1, i_xorInt }
1007     , { "primNotInt",                "I",  "I",  MONAD_Id, i_PRIMOP1, i_notInt }
1008     , { "primShiftLInt",             "IW", "I",  MONAD_Id, i_PRIMOP1, i_shiftLInt }
1009     , { "primShiftRAInt",            "IW", "I",  MONAD_Id, i_PRIMOP1, i_shiftRAInt }
1010     , { "primShiftRLInt",            "IW", "I",  MONAD_Id, i_PRIMOP1, i_shiftRLInt }
1011
1012 #ifdef PROVIDE_INT64
1013     /* Int64# operations */
1014     , { "primGtInt64",               "zz", "B",  MONAD_Id, i_PRIMOP1, i_gtInt64 }
1015     , { "primGeInt64",               "zz", "B",  MONAD_Id, i_PRIMOP1, i_geInt64 }
1016     , { "primEqInt64",               "zz", "B",  MONAD_Id, i_PRIMOP1, i_eqInt64 }
1017     , { "primNeInt64",               "zz", "B",  MONAD_Id, i_PRIMOP1, i_neInt64 }
1018     , { "primLtInt64",               "zz", "B",  MONAD_Id, i_PRIMOP1, i_ltInt64 }
1019     , { "primLeInt64",               "zz", "B",  MONAD_Id, i_PRIMOP1, i_leInt64 }
1020     , { "primMinInt64",              "",   "z",  MONAD_Id, i_PRIMOP1, i_minInt64 }
1021     , { "primMaxInt64",              "",   "z",  MONAD_Id, i_PRIMOP1, i_maxInt64 }
1022     , { "primPlusInt64",             "zz", "z",  MONAD_Id, i_PRIMOP1, i_plusInt64 }
1023     , { "primMinusInt64",            "zz", "z",  MONAD_Id, i_PRIMOP1, i_minusInt64 }
1024     , { "primTimesInt64",            "zz", "z",  MONAD_Id, i_PRIMOP1, i_timesInt64 }
1025     , { "primQuotInt64",             "zz", "z",  MONAD_Id, i_PRIMOP1, i_quotInt64 }
1026     , { "primRemInt64",              "zz", "z",  MONAD_Id, i_PRIMOP1, i_remInt64 }
1027     , { "primQuotRemInt64",          "zz", "zz", MONAD_Id, i_PRIMOP1, i_quotRemInt64 }
1028     , { "primNegateInt64",           "z",  "z",  MONAD_Id, i_PRIMOP1, i_negateInt64 }
1029
1030     , { "primAndInt64",               "zz", "z",  MONAD_Id, i_PRIMOP1, i_andInt64 }
1031     , { "primOrInt64",                "zz", "z",  MONAD_Id, i_PRIMOP1, i_orInt64 }
1032     , { "primXorInt64",               "zz", "z",  MONAD_Id, i_PRIMOP1, i_xorInt64 }
1033     , { "primNotInt64",               "z",  "z",  MONAD_Id, i_PRIMOP1, i_notInt64 }
1034     , { "primShiftLInt64",            "zW", "z",  MONAD_Id, i_PRIMOP1, i_shiftLInt64 }
1035     , { "primShiftRAInt64",           "zW", "z",  MONAD_Id, i_PRIMOP1, i_shiftRAInt64 }
1036     , { "primShiftRLInt64",           "zW", "z",  MONAD_Id, i_PRIMOP1, i_shiftRLInt64 }
1037
1038     , { "primInt64ToInt",            "z",  "I",  MONAD_Id, i_PRIMOP1, i_int64ToInt }
1039     , { "primIntToInt64",            "I",  "z",  MONAD_Id, i_PRIMOP1, i_intToInt64 }
1040 #ifdef PROVIDE_WORD
1041     , { "primInt64ToWord",           "z",  "W",  MONAD_Id, i_PRIMOP1, i_int64ToWord }
1042     , { "primWordToInt64",           "W",  "z",  MONAD_Id, i_PRIMOP1, i_wordToInt64 }
1043 #endif
1044     , { "primInt64ToFloat",          "z",  "F",  MONAD_Id, i_PRIMOP1, i_int64ToFloat }
1045     , { "primFloatToInt64",          "F",  "z",  MONAD_Id, i_PRIMOP1, i_floatToInt64 }
1046     , { "primInt64ToDouble",         "z",  "D",  MONAD_Id, i_PRIMOP1, i_int64ToDouble }
1047     , { "primDoubleToInt64",         "D",  "z",  MONAD_Id, i_PRIMOP1, i_doubleToInt64 }
1048 #endif
1049
1050 #ifdef PROVIDE_WORD
1051     /* Word# operations */
1052     , { "primGtWord",                "WW", "B",  MONAD_Id, i_PRIMOP1, i_gtWord }
1053     , { "primGeWord",                "WW", "B",  MONAD_Id, i_PRIMOP1, i_geWord }
1054     , { "primEqWord",                "WW", "B",  MONAD_Id, i_PRIMOP1, i_eqWord }
1055     , { "primNeWord",                "WW", "B",  MONAD_Id, i_PRIMOP1, i_neWord }
1056     , { "primLtWord",                "WW", "B",  MONAD_Id, i_PRIMOP1, i_ltWord }
1057     , { "primLeWord",                "WW", "B",  MONAD_Id, i_PRIMOP1, i_leWord }
1058     , { "primMinWord",               "",   "W",  MONAD_Id, i_PRIMOP1, i_minWord }
1059     , { "primMaxWord",               "",   "W",  MONAD_Id, i_PRIMOP1, i_maxWord }
1060     , { "primPlusWord",              "WW", "W",  MONAD_Id, i_PRIMOP1, i_plusWord }
1061     , { "primMinusWord",             "WW", "W",  MONAD_Id, i_PRIMOP1, i_minusWord }
1062     , { "primTimesWord",             "WW", "W",  MONAD_Id, i_PRIMOP1, i_timesWord }
1063     , { "primQuotWord",              "WW", "W",  MONAD_Id, i_PRIMOP1, i_quotWord }
1064     , { "primRemWord",               "WW", "W",  MONAD_Id, i_PRIMOP1, i_remWord }
1065     , { "primQuotRemWord",           "WW", "WW", MONAD_Id, i_PRIMOP1, i_quotRemWord }
1066     , { "primNegateWord",            "W",  "W",  MONAD_Id, i_PRIMOP1, i_negateWord }
1067
1068     , { "primAndWord",               "WW", "W",  MONAD_Id, i_PRIMOP1, i_andWord }
1069     , { "primOrWord",                "WW", "W",  MONAD_Id, i_PRIMOP1, i_orWord }
1070     , { "primXorWord",               "WW", "W",  MONAD_Id, i_PRIMOP1, i_xorWord }
1071     , { "primNotWord",               "W",  "W",  MONAD_Id, i_PRIMOP1, i_notWord }
1072     , { "primShiftLWord",            "WW", "W",  MONAD_Id, i_PRIMOP1, i_shiftLWord }
1073     , { "primShiftRAWord",           "WW", "W",  MONAD_Id, i_PRIMOP1, i_shiftRAWord }
1074     , { "primShiftRLWord",           "WW", "W",  MONAD_Id, i_PRIMOP1, i_shiftRLWord }
1075
1076     , { "primIntToWord",             "I",  "W",  MONAD_Id, i_PRIMOP1, i_intToWord }
1077     , { "primWordToInt",             "W",  "I",  MONAD_Id, i_PRIMOP1, i_wordToInt }
1078 #endif
1079
1080 #ifdef PROVIDE_ADDR
1081     /* Addr# operations */
1082     , { "primGtAddr",                "AA", "B",  MONAD_Id, i_PRIMOP1, i_gtAddr }
1083     , { "primGeAddr",                "AA", "B",  MONAD_Id, i_PRIMOP1, i_geAddr }
1084     , { "primEqAddr",                "AA", "B",  MONAD_Id, i_PRIMOP1, i_eqAddr }
1085     , { "primNeAddr",                "AA", "B",  MONAD_Id, i_PRIMOP1, i_neAddr }
1086     , { "primLtAddr",                "AA", "B",  MONAD_Id, i_PRIMOP1, i_ltAddr }
1087     , { "primLeAddr",                "AA", "B",  MONAD_Id, i_PRIMOP1, i_leAddr }
1088     , { "primIntToAddr",             "I",  "A",  MONAD_Id, i_PRIMOP1, i_intToAddr }
1089     , { "primAddrToInt",             "A",  "I",  MONAD_Id, i_PRIMOP1, i_addrToInt }
1090
1091     , { "primIndexCharOffAddr",      "AI", "C",  MONAD_Id, i_PRIMOP1, i_indexCharOffAddr }
1092     , { "primIndexIntOffAddr",       "AI", "I",  MONAD_Id, i_PRIMOP1, i_indexIntOffAddr }
1093 #ifdef PROVIDE_INT64
1094     , { "primIndexInt64OffAddr",     "AI", "z",  MONAD_Id, i_PRIMOP1, i_indexInt64OffAddr }
1095 #endif
1096     , { "primIndexWordOffAddr",      "AI", "W",  MONAD_Id, i_PRIMOP1, i_indexWordOffAddr }
1097     , { "primIndexAddrOffAddr",      "AI", "A",  MONAD_Id, i_PRIMOP1, i_indexAddrOffAddr }
1098     , { "primIndexFloatOffAddr",     "AI", "F",  MONAD_Id, i_PRIMOP1, i_indexFloatOffAddr }
1099     , { "primIndexDoubleOffAddr",    "AI", "D",  MONAD_Id, i_PRIMOP1, i_indexDoubleOffAddr }
1100 #ifdef PROVIDE_STABLE
1101     , { "primIndexStableOffAddr",    "AI", "s",  MONAD_Id, i_PRIMOP1, i_indexStableOffAddr }
1102 #endif
1103
1104     /* These ops really ought to be in the IO monad */
1105     , { "primReadCharOffAddr",       "AI", "C",  MONAD_ST, i_PRIMOP1, i_readCharOffAddr }
1106     , { "primReadIntOffAddr",        "AI", "I",  MONAD_ST, i_PRIMOP1, i_readIntOffAddr }
1107 #ifdef PROVIDE_INT64
1108     , { "primReadInt64OffAddr",      "AI", "z",  MONAD_ST, i_PRIMOP1, i_readInt64OffAddr }
1109 #endif
1110     , { "primReadWordOffAddr",       "AI", "W",  MONAD_ST, i_PRIMOP1, i_readWordOffAddr }
1111     , { "primReadAddrOffAddr",       "AI", "A",  MONAD_ST, i_PRIMOP1, i_readAddrOffAddr }
1112     , { "primReadFloatOffAddr",      "AI", "F",  MONAD_ST, i_PRIMOP1, i_readFloatOffAddr }
1113     , { "primReadDoubleOffAddr",     "AI", "D",  MONAD_ST, i_PRIMOP1, i_readDoubleOffAddr }
1114 #ifdef PROVIDE_STABLE
1115     , { "primReadStableOffAddr",     "AI", "s",  MONAD_ST, i_PRIMOP1, i_readStableOffAddr }
1116 #endif
1117
1118     /* These ops really ought to be in the IO monad */
1119     , { "primWriteCharOffAddr",      "AIC", "",  MONAD_ST, i_PRIMOP1, i_writeCharOffAddr }
1120     , { "primWriteIntOffAddr",       "AII", "",  MONAD_ST, i_PRIMOP1, i_writeIntOffAddr }
1121 #ifdef PROVIDE_INT64
1122     , { "primWriteInt64OffAddr",     "AIz", "",  MONAD_ST, i_PRIMOP1, i_writeInt64OffAddr }
1123 #endif
1124     , { "primWriteWordOffAddr",      "AIW", "",  MONAD_ST, i_PRIMOP1, i_writeWordOffAddr }
1125     , { "primWriteAddrOffAddr",      "AIA", "",  MONAD_ST, i_PRIMOP1, i_writeAddrOffAddr }
1126     , { "primWriteFloatOffAddr",     "AIF", "",  MONAD_ST, i_PRIMOP1, i_writeFloatOffAddr }
1127     , { "primWriteDoubleOffAddr",    "AID", "",  MONAD_ST, i_PRIMOP1, i_writeDoubleOffAddr }
1128 #ifdef PROVIDE_STABLE
1129     , { "primWriteStableOffAddr",    "AIs", "",  MONAD_ST, i_PRIMOP1, i_writeStableOffAddr }
1130 #endif
1131
1132 #endif /* PROVIDE_ADDR */
1133
1134 #ifdef PROVIDE_INTEGER
1135     /* Integer operations */
1136     , { "primCompareInteger",        "ZZ", "I",  MONAD_Id, i_PRIMOP1, i_compareInteger }
1137     , { "primNegateInteger",         "Z",  "Z",  MONAD_Id, i_PRIMOP1, i_negateInteger }
1138     , { "primPlusInteger",           "ZZ", "Z",  MONAD_Id, i_PRIMOP1, i_plusInteger }
1139     , { "primMinusInteger",          "ZZ", "Z",  MONAD_Id, i_PRIMOP1, i_minusInteger }
1140     , { "primTimesInteger",          "ZZ", "Z",  MONAD_Id, i_PRIMOP1, i_timesInteger }
1141     , { "primQuotRemInteger",        "ZZ", "ZZ", MONAD_Id, i_PRIMOP1, i_quotRemInteger }
1142     , { "primDivModInteger",         "ZZ", "ZZ", MONAD_Id, i_PRIMOP1, i_divModInteger }
1143     , { "primIntegerToInt",          "Z",  "I",  MONAD_Id, i_PRIMOP1, i_integerToInt }
1144     , { "primIntToInteger",          "I",  "Z",  MONAD_Id, i_PRIMOP1, i_intToInteger }
1145     , { "primIntegerToInt64",        "Z",  "z",  MONAD_Id, i_PRIMOP1, i_integerToInt64 }
1146     , { "primInt64ToInteger",        "z",  "Z",  MONAD_Id, i_PRIMOP1, i_int64ToInteger }
1147 #ifdef PROVIDE_WORD
1148     , { "primIntegerToWord",         "Z",  "W",  MONAD_Id, i_PRIMOP1, i_integerToWord }
1149     , { "primWordToInteger",         "W",  "Z",  MONAD_Id, i_PRIMOP1, i_wordToInteger }
1150 #endif
1151     , { "primIntegerToFloat",        "Z",  "F",  MONAD_Id, i_PRIMOP1, i_integerToFloat }
1152     , { "primFloatToInteger",        "F",  "Z",  MONAD_Id, i_PRIMOP1, i_floatToInteger }
1153     , { "primIntegerToDouble",       "Z",  "D",  MONAD_Id, i_PRIMOP1, i_integerToDouble }
1154     , { "primDoubleToInteger",       "D",  "Z",  MONAD_Id, i_PRIMOP1, i_doubleToInteger }
1155 #endif
1156
1157     /* Float# operations */
1158     , { "primGtFloat",               "FF", "B",  MONAD_Id, i_PRIMOP1, i_gtFloat }
1159     , { "primGeFloat",               "FF", "B",  MONAD_Id, i_PRIMOP1, i_geFloat }
1160     , { "primEqFloat",               "FF", "B",  MONAD_Id, i_PRIMOP1, i_eqFloat }
1161     , { "primNeFloat",               "FF", "B",  MONAD_Id, i_PRIMOP1, i_neFloat }
1162     , { "primLtFloat",               "FF", "B",  MONAD_Id, i_PRIMOP1, i_ltFloat }
1163     , { "primLeFloat",               "FF", "B",  MONAD_Id, i_PRIMOP1, i_leFloat }
1164     , { "primMinFloat",              "",   "F",  MONAD_Id, i_PRIMOP1, i_minFloat }
1165     , { "primMaxFloat",              "",   "F",  MONAD_Id, i_PRIMOP1, i_maxFloat }
1166     , { "primRadixFloat",            "",   "I",  MONAD_Id, i_PRIMOP1, i_radixFloat }
1167     , { "primDigitsFloat",           "",   "I",  MONAD_Id, i_PRIMOP1, i_digitsFloat }
1168     , { "primMinExpFloat",           "",   "I",  MONAD_Id, i_PRIMOP1, i_minExpFloat }
1169     , { "primMaxExpFloat",           "",   "I",  MONAD_Id, i_PRIMOP1, i_maxExpFloat }
1170     , { "primPlusFloat",             "FF", "F",  MONAD_Id, i_PRIMOP1, i_plusFloat }
1171     , { "primMinusFloat",            "FF", "F",  MONAD_Id, i_PRIMOP1, i_minusFloat }
1172     , { "primTimesFloat",            "FF", "F",  MONAD_Id, i_PRIMOP1, i_timesFloat }
1173     , { "primDivideFloat",           "FF", "F",  MONAD_Id, i_PRIMOP1, i_divideFloat }
1174     , { "primNegateFloat",           "F",  "F",  MONAD_Id, i_PRIMOP1, i_negateFloat }
1175     , { "primFloatToInt",            "F",  "I",  MONAD_Id, i_PRIMOP1, i_floatToInt }
1176     , { "primIntToFloat",            "I",  "F",  MONAD_Id, i_PRIMOP1, i_intToFloat }
1177     , { "primExpFloat",              "F",  "F",  MONAD_Id, i_PRIMOP1, i_expFloat }
1178     , { "primLogFloat",              "F",  "F",  MONAD_Id, i_PRIMOP1, i_logFloat }
1179     , { "primSqrtFloat",             "F",  "F",  MONAD_Id, i_PRIMOP1, i_sqrtFloat }
1180     , { "primSinFloat",              "F",  "F",  MONAD_Id, i_PRIMOP1, i_sinFloat }
1181     , { "primCosFloat",              "F",  "F",  MONAD_Id, i_PRIMOP1, i_cosFloat }
1182     , { "primTanFloat",              "F",  "F",  MONAD_Id, i_PRIMOP1, i_tanFloat }
1183     , { "primAsinFloat",             "F",  "F",  MONAD_Id, i_PRIMOP1, i_asinFloat }
1184     , { "primAcosFloat",             "F",  "F",  MONAD_Id, i_PRIMOP1, i_acosFloat }
1185     , { "primAtanFloat",             "F",  "F",  MONAD_Id, i_PRIMOP1, i_atanFloat }
1186     , { "primSinhFloat",             "F",  "F",  MONAD_Id, i_PRIMOP1, i_sinhFloat }
1187     , { "primCoshFloat",             "F",  "F",  MONAD_Id, i_PRIMOP1, i_coshFloat }
1188     , { "primTanhFloat",             "F",  "F",  MONAD_Id, i_PRIMOP1, i_tanhFloat }
1189     , { "primPowerFloat",            "FF", "F",  MONAD_Id, i_PRIMOP1, i_powerFloat }
1190 #ifdef PROVIDE_INT64
1191     , { "primDecodeFloatz",          "F",  "zI", MONAD_Id, i_PRIMOP1, i_decodeFloatz }
1192     , { "primEncodeFloatz",          "zI", "F",  MONAD_Id, i_PRIMOP1, i_encodeFloatz }
1193 #endif
1194 #ifdef PROVIDE_INTEGER
1195     , { "primDecodeFloatZ",          "F",  "ZI", MONAD_Id, i_PRIMOP1, i_decodeFloatZ }
1196     , { "primEncodeFloatZ",          "ZI", "F",  MONAD_Id, i_PRIMOP1, i_encodeFloatZ }
1197 #endif
1198     , { "primIsNaNFloat",            "F",  "B",  MONAD_Id, i_PRIMOP1, i_isNaNFloat }
1199     , { "primIsInfiniteFloat",       "F",  "B",  MONAD_Id, i_PRIMOP1, i_isInfiniteFloat }
1200     , { "primIsDenormalizedFloat",   "F",  "B",  MONAD_Id, i_PRIMOP1, i_isDenormalizedFloat }
1201     , { "primIsNegativeZeroFloat",   "F",  "B",  MONAD_Id, i_PRIMOP1, i_isNegativeZeroFloat }
1202     , { "primIsIEEEFloat",           "",   "B",  MONAD_Id, i_PRIMOP1, i_isIEEEFloat }
1203
1204     /* Double# operations */
1205     , { "primGtDouble",              "DD", "B",  MONAD_Id, i_PRIMOP1, i_gtDouble }
1206     , { "primGeDouble",              "DD", "B",  MONAD_Id, i_PRIMOP1, i_geDouble }
1207     , { "primEqDouble",              "DD", "B",  MONAD_Id, i_PRIMOP1, i_eqDouble }
1208     , { "primNeDouble",              "DD", "B",  MONAD_Id, i_PRIMOP1, i_neDouble }
1209     , { "primLtDouble",              "DD", "B",  MONAD_Id, i_PRIMOP1, i_ltDouble }
1210     , { "primLeDouble",              "DD", "B",  MONAD_Id, i_PRIMOP1, i_leDouble }
1211     , { "primMinDouble",             "",   "D",  MONAD_Id, i_PRIMOP1, i_minDouble }
1212     , { "primMaxDouble",             "",   "D",  MONAD_Id, i_PRIMOP1, i_maxDouble }
1213     , { "primRadixDouble",           "",   "I",  MONAD_Id, i_PRIMOP1, i_radixDouble }
1214     , { "primDigitsDouble",          "",   "I",  MONAD_Id, i_PRIMOP1, i_digitsDouble }
1215     , { "primMinExpDouble",          "",   "I",  MONAD_Id, i_PRIMOP1, i_minExpDouble }
1216     , { "primMaxExpDouble",          "",   "I",  MONAD_Id, i_PRIMOP1, i_maxExpDouble }
1217     , { "primPlusDouble",            "DD", "D",  MONAD_Id, i_PRIMOP1, i_plusDouble }
1218     , { "primMinusDouble",           "DD", "D",  MONAD_Id, i_PRIMOP1, i_minusDouble }
1219     , { "primTimesDouble",           "DD", "D",  MONAD_Id, i_PRIMOP1, i_timesDouble }
1220     , { "primDivideDouble",          "DD", "D",  MONAD_Id, i_PRIMOP1, i_divideDouble }
1221     , { "primNegateDouble",          "D",  "D",  MONAD_Id, i_PRIMOP1, i_negateDouble }
1222     , { "primDoubleToInt",           "D",  "I",  MONAD_Id, i_PRIMOP1, i_doubleToInt }
1223     , { "primIntToDouble",           "I",  "D",  MONAD_Id, i_PRIMOP1, i_intToDouble }
1224     , { "primDoubleToFloat",         "D",  "F",  MONAD_Id, i_PRIMOP1, i_doubleToFloat }
1225     , { "primFloatToDouble",         "F",  "D",  MONAD_Id, i_PRIMOP1, i_floatToDouble }
1226     , { "primExpDouble",             "D",  "D",  MONAD_Id, i_PRIMOP1, i_expDouble }
1227     , { "primLogDouble",             "D",  "D",  MONAD_Id, i_PRIMOP1, i_logDouble }
1228     , { "primSqrtDouble",            "D",  "D",  MONAD_Id, i_PRIMOP1, i_sqrtDouble }
1229     , { "primSinDouble",             "D",  "D",  MONAD_Id, i_PRIMOP1, i_sinDouble }
1230     , { "primCosDouble",             "D",  "D",  MONAD_Id, i_PRIMOP1, i_cosDouble }
1231     , { "primTanDouble",             "D",  "D",  MONAD_Id, i_PRIMOP1, i_tanDouble }
1232     , { "primAsinDouble",            "D",  "D",  MONAD_Id, i_PRIMOP1, i_asinDouble }
1233     , { "primAcosDouble",            "D",  "D",  MONAD_Id, i_PRIMOP1, i_acosDouble }
1234     , { "primAtanDouble",            "D",  "D",  MONAD_Id, i_PRIMOP1, i_atanDouble }
1235     , { "primSinhDouble",            "D",  "D",  MONAD_Id, i_PRIMOP1, i_sinhDouble }
1236     , { "primCoshDouble",            "D",  "D",  MONAD_Id, i_PRIMOP1, i_coshDouble }
1237     , { "primTanhDouble",            "D",  "D",  MONAD_Id, i_PRIMOP1, i_tanhDouble }
1238     , { "primPowerDouble",           "DD", "D",  MONAD_Id, i_PRIMOP1, i_powerDouble }
1239 #ifdef PROVIDE_INT64
1240     , { "primDecodeDoublez",         "D",  "zI", MONAD_Id, i_PRIMOP1, i_decodeDoublez }
1241     , { "primEncodeDoublez",         "zI",  "D", MONAD_Id, i_PRIMOP1, i_encodeDoublez }
1242 #endif
1243 #ifdef PROVIDE_INTEGER
1244     , { "primDecodeDoubleZ",         "D",  "ZI", MONAD_Id, i_PRIMOP1, i_decodeDoubleZ }
1245     , { "primEncodeDoubleZ",         "ZI",  "D", MONAD_Id, i_PRIMOP1, i_encodeDoubleZ }
1246 #endif
1247     , { "primIsNaNDouble",           "D",  "B",  MONAD_Id, i_PRIMOP1, i_isNaNDouble }
1248     , { "primIsInfiniteDouble",      "D",  "B",  MONAD_Id, i_PRIMOP1, i_isInfiniteDouble }
1249     , { "primIsDenormalizedDouble",  "D",  "B",  MONAD_Id, i_PRIMOP1, i_isDenormalizedDouble }
1250     , { "primIsNegativeZeroDouble",  "D",  "B",  MONAD_Id, i_PRIMOP1, i_isNegativeZeroDouble }
1251     , { "primIsIEEEDouble",          "",   "B",  MONAD_Id, i_PRIMOP1, i_isIEEEDouble }
1252
1253
1254     /* Polymorphic force :: a -> (# #) */
1255     , { "primForce",                 "a",  "",   MONAD_Id, i_PRIMOP2, i_force }
1256
1257     /* Error operations - not in IO monad! */
1258     , { "primRaise",                 "E",  "a",  MONAD_Id, i_PRIMOP2, i_raise }
1259     , { "primCatch'",                "aH", "a",  MONAD_Id, i_PRIMOP2, i_catch }
1260
1261 #ifdef PROVIDE_ARRAY
1262     /* Ref operations */
1263     , { "primNewRef",                "a",  "R",  MONAD_ST, i_PRIMOP2, i_newRef }
1264     , { "primWriteRef",              "Ra", "",   MONAD_ST, i_PRIMOP2, i_writeRef }
1265     , { "primReadRef",               "R",  "a",  MONAD_ST, i_PRIMOP2, i_readRef }
1266     , { "primSameRef",               "RR", "B",  MONAD_Id, i_PRIMOP2, i_sameRef }
1267
1268     /* PrimArray operations */
1269     , { "primSameMutableArray",      "MM",  "B", MONAD_Id, i_PRIMOP2, i_sameMutableArray }
1270     , { "primUnsafeFreezeArray",     "M",   "X", MONAD_ST, i_PRIMOP2, i_unsafeFreezeArray }
1271     , { "primNewArray",              "Ia",  "M", MONAD_ST, i_PRIMOP2, i_newArray }
1272     , { "primWriteArray",            "MIa", "",  MONAD_ST, i_PRIMOP2, i_writeArray }
1273     , { "primReadArray",             "MI",  "a", MONAD_ST, i_PRIMOP2, i_readArray }
1274     , { "primIndexArray",            "XI",  "a", MONAD_Id, i_PRIMOP2, i_indexArray }
1275     , { "primSizeArray",             "X",   "I", MONAD_Id, i_PRIMOP2, i_sizeArray }
1276     , { "primSizeMutableArray",      "M",   "I", MONAD_Id, i_PRIMOP2, i_sizeMutableArray }
1277
1278     /* Prim[Mutable]ByteArray operations */
1279     , { "primSameMutableByteArray",  "mm", "B", MONAD_Id, i_PRIMOP2, i_sameMutableByteArray }
1280     , { "primUnsafeFreezeByteArray", "m",  "x", MONAD_ST, i_PRIMOP2, i_unsafeFreezeByteArray }
1281
1282     , { "primNewByteArray",          "I",  "m", MONAD_ST, i_PRIMOP2, i_newByteArray }
1283
1284     , { "primWriteCharArray",        "mIC", "", MONAD_ST, i_PRIMOP2, i_writeCharArray }
1285     , { "primReadCharArray",         "mI", "C", MONAD_ST, i_PRIMOP2, i_readCharArray }
1286     , { "primIndexCharArray",        "xI", "C", MONAD_Id, i_PRIMOP2, i_indexCharArray }
1287
1288     , { "primWriteIntArray",         "mII", "",  MONAD_ST, i_PRIMOP2, i_writeIntArray }
1289     , { "primReadIntArray",          "mI",  "I", MONAD_ST, i_PRIMOP2, i_readIntArray }
1290     , { "primIndexIntArray",         "xI",  "I", MONAD_Id, i_PRIMOP2, i_indexIntArray }
1291
1292 #ifdef PROVIDE_INT64
1293     , { "primWriteInt64Array",       "mIz", "",  MONAD_ST, i_PRIMOP2, i_writeInt64Array }
1294     , { "primReadInt64Array",        "mI",  "z", MONAD_ST, i_PRIMOP2, i_readInt64Array }
1295     , { "primIndexInt64Array",       "xI",  "z", MONAD_Id, i_PRIMOP2, i_indexInt64Array }
1296 #endif
1297
1298     /* {new,write,read,index}IntegerArray not provided */
1299
1300 #ifdef PROVIDE_WORD
1301     , { "primWriteWordArray",        "mIW", "",  MONAD_ST, i_PRIMOP2, i_writeWordArray }
1302     , { "primReadWordArray",         "mI",  "W", MONAD_ST, i_PRIMOP2, i_readWordArray }
1303     , { "primIndexWordArray",        "xI",  "W", MONAD_Id, i_PRIMOP2, i_indexWordArray }
1304 #endif
1305 #ifdef PROVIDE_ADDR
1306     , { "primWriteAddrArray",        "mIA", "",  MONAD_ST, i_PRIMOP2, i_writeAddrArray }
1307     , { "primReadAddrArray",         "mI",  "A", MONAD_ST, i_PRIMOP2, i_readAddrArray }
1308     , { "primIndexAddrArray",        "xI",  "A", MONAD_Id, i_PRIMOP2, i_indexAddrArray }
1309 #endif
1310     , { "primWriteFloatArray",       "mIF", "",  MONAD_ST, i_PRIMOP2, i_writeFloatArray }
1311     , { "primReadFloatArray",        "mI",  "F", MONAD_ST, i_PRIMOP2, i_readFloatArray }
1312     , { "primIndexFloatArray",       "xI",  "F", MONAD_Id, i_PRIMOP2, i_indexFloatArray }
1313
1314     , { "primWriteDoubleArray" ,     "mID", "",  MONAD_ST, i_PRIMOP2, i_writeDoubleArray }
1315     , { "primReadDoubleArray",       "mI",  "D", MONAD_ST, i_PRIMOP2, i_readDoubleArray }
1316     , { "primIndexDoubleArray",      "xI",  "D", MONAD_Id, i_PRIMOP2, i_indexDoubleArray }
1317
1318 #ifdef PROVIDE_STABLE
1319     , { "primWriteStableArray",      "mIs", "",  MONAD_ST, i_PRIMOP2, i_writeStableArray }
1320     , { "primReadStableArray",       "mI",  "s", MONAD_ST, i_PRIMOP2, i_readStableArray }
1321     , { "primIndexStableArray",      "xI",  "s", MONAD_Id, i_PRIMOP2, i_indexStableArray }
1322 #endif
1323
1324     /* {new,write,read,index}ForeignObjArray not provided */
1325
1326 #endif PROVIDE_ARRAY
1327
1328 #ifdef PROVIDE_FOREIGN
1329     /* ForeignObj# operations */
1330     , { "primMakeForeignObj",        "A",  "f",  MONAD_IO, i_PRIMOP2, i_makeForeignObj }
1331 #endif
1332 #ifdef PROVIDE_WEAK
1333     /* WeakPair# operations */
1334     , { "primMakeWeak",              "bac", "w",  MONAD_IO, i_PRIMOP2, i_makeWeak }
1335     , { "primDeRefWeak",             "w",   "Ia", MONAD_IO, i_PRIMOP2, i_deRefWeak }
1336 #endif
1337 #ifdef PROVIDE_STABLE
1338     /* StablePtr# operations */
1339     , { "primMakeStablePtr",         "a", "s",   MONAD_IO, i_PRIMOP2, i_makeStablePtr }
1340     , { "primDeRefStablePtr",        "s", "a",   MONAD_IO, i_PRIMOP2, i_deRefStablePtr }
1341     , { "primFreeStablePtr",         "s", "",    MONAD_IO, i_PRIMOP2, i_freeStablePtr }
1342 #endif
1343 #ifdef PROVIDE_PTREQUALITY
1344     , { "primReallyUnsafePtrEquality", "aa", "B",MONAD_Id, i_PRIMOP2, i_reallyUnsafePtrEquality }
1345 #endif
1346 #ifdef PROVIDE_COERCE
1347     , { "primUnsafeCoerce",          "a", "b",   MONAD_Id, i_PRIMOP2, i_unsafeCoerce }
1348 #endif
1349 #ifdef PROVIDE_CONCURRENT
1350     /* Concurrency operations */
1351     , { "primFork",                  "a", "T",   MONAD_IO, i_PRIMOP2, i_fork }
1352     , { "primKillThread",            "T", "",    MONAD_IO, i_PRIMOP2, i_killThread }
1353     , { "primSameMVar",              "rr", "B",  MONAD_Id, i_PRIMOP2, i_sameMVar }
1354     , { "primNewMVar",               "",  "r",   MONAD_IO, i_PRIMOP2, i_newMVar }
1355     , { "primTakeMVar",              "r", "a",   MONAD_IO, i_PRIMOP2, i_takeMVar }
1356     , { "primPutMVar",               "ra", "",   MONAD_IO, i_PRIMOP2, i_putMVar }
1357     , { "primDelay",                 "I", "",    MONAD_IO, i_PRIMOP2, i_delay }
1358     , { "primWaitRead",              "I", "",    MONAD_IO, i_PRIMOP2, i_waitRead }
1359     , { "primWaitWrite",             "I", "",    MONAD_IO, i_PRIMOP2, i_waitWrite }
1360 #endif
1361
1362     /* Ccall is polyadic - so it's excluded from this table */
1363
1364     , { 0,0,0,0 }
1365 };
1366
1367 const AsmPrim ccall_Id = { "ccall", 0, 0, MONAD_IO, i_PRIMOP2, i_ccall_Id };
1368 const AsmPrim ccall_IO = { "ccall", 0, 0, MONAD_IO, i_PRIMOP2, i_ccall_IO };
1369
1370 const AsmPrim* asmFindPrim( char* s )
1371 {
1372     int i;
1373     for (i=0; asmPrimOps[i].name; ++i) {
1374         if (strcmp(s,asmPrimOps[i].name)==0) {
1375             return &asmPrimOps[i];
1376         }
1377     }
1378     return 0;
1379 }
1380
1381 const AsmPrim* asmFindPrimop( AsmInstr prefix, AsmInstr op )
1382 {
1383     nat i;
1384     for (i=0; asmPrimOps[i].name; ++i) {
1385         if (asmPrimOps[i].prefix == prefix && asmPrimOps[i].opcode == op) {
1386             return &asmPrimOps[i];
1387         }
1388     }
1389     return 0;
1390 }
1391
1392 /* --------------------------------------------------------------------------
1393  * Heap manipulation
1394  * ------------------------------------------------------------------------*/
1395
1396 AsmVar asmAllocCONSTR   ( AsmBCO bco, AsmInfo info )
1397 {
1398     ASSERT( sizeW_fromITBL(info) >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
1399     asmInstr(bco,i_ALLOC_CONSTR);
1400     asmInstr(bco,bco->nps.len);
1401     asmWords(bco,AsmInfo,info);
1402     bco->sp += sizeofW(StgClosurePtr);
1403     grabHpNonUpd(bco,sizeW_fromITBL(info));
1404     return bco->sp;
1405 }
1406
1407 AsmSp asmBeginPack( AsmBCO bco )
1408 {
1409     return bco->sp;
1410 }
1411
1412 void asmEndPack( AsmBCO bco, AsmVar v, AsmSp start, AsmInfo info )
1413 {
1414     nat size = bco->sp - start;
1415     ASSERT(bco->sp >= start);
1416     ASSERT(start >= v);
1417     /* only reason to include info is for this assertion */
1418     ASSERT(info->layout.payload.ptrs == size);
1419     asmInstr(bco,i_PACK);
1420     asmInstr(bco,bco->sp - v);
1421     bco->sp = start;
1422 }
1423
1424 void asmBeginUnpack( AsmBCO bco )
1425 {
1426     /* dummy to make it look prettier */
1427 }
1428
1429 void asmEndUnpack( AsmBCO bco )
1430 {
1431     asmInstr(bco,i_UNPACK);
1432 }
1433
1434 AsmVar asmAllocAP( AsmBCO bco, AsmNat words )
1435 {
1436     asmInstr(bco,i_ALLOC_AP);
1437     asmInstr(bco,words);
1438     bco->sp += sizeofW(StgPtr);
1439     grabHpUpd(bco,AP_sizeW(words));
1440     return bco->sp;
1441 }
1442
1443 AsmSp asmBeginMkAP( AsmBCO bco )
1444 {
1445     return bco->sp;
1446 }
1447
1448 void asmEndMkAP( AsmBCO bco, AsmVar v, AsmSp start )
1449 {
1450     asmInstr(bco,i_MKAP);
1451     asmInstr(bco,bco->sp-v);
1452     asmInstr(bco,bco->sp-start-1);  /* -1 because fun isn't counted */
1453     bco->sp = start;
1454 }
1455
1456 AsmVar asmAllocPAP( AsmBCO bco, AsmNat size )
1457 {
1458     asmInstr(bco,i_ALLOC_PAP);
1459     asmInstr(bco,size);
1460     bco->sp += sizeofW(StgPtr);
1461     return bco->sp;
1462 }
1463
1464 AsmSp asmBeginMkPAP( AsmBCO bco )
1465 {
1466     return bco->sp;
1467 }
1468
1469 void asmEndMkPAP( AsmBCO bco, AsmVar v, AsmSp start )
1470 {
1471     asmInstr(bco,i_MKPAP);
1472     asmInstr(bco,bco->sp-v);
1473     asmInstr(bco,bco->sp-start-1);  /* -1 because fun isn't counted */
1474     bco->sp = start;
1475 }
1476
1477 AsmVar asmClosure( AsmBCO bco, AsmObject p )
1478 {
1479     StgWord o = bco->object.ptrs.len;
1480     if (o < 256) {
1481         asmInstr(bco,i_CONST);
1482         asmInstr(bco,o);
1483         asmPtr(bco,p);
1484     } else {
1485         asmInstr(bco,i_CONST2);
1486         asmInstr(bco,o / 256);
1487         asmInstr(bco,o % 256);
1488         asmPtr(bco,p);
1489     }
1490     bco->sp += sizeofW(StgPtr);
1491     return bco->sp;
1492 }
1493
1494 /* --------------------------------------------------------------------------
1495  * Building InfoTables
1496  * ------------------------------------------------------------------------*/
1497
1498 AsmInfo asmMkInfo( AsmNat tag, AsmNat ptrs )
1499 {
1500     StgInfoTable* info = stgMallocBytes( sizeof(StgInfoTable),"asmMkInfo");
1501     /* Note: the evaluator automatically pads objects with the right number
1502      * of non-ptrs to satisfy MIN_NONUPD_SIZE restrictions.
1503      */
1504     AsmNat nptrs = stg_max(0,MIN_NONUPD_SIZE-ptrs);
1505
1506     /* initialisation code based on INFO_TABLE_CONSTR */
1507     info->layout.payload.ptrs  = ptrs;
1508     info->layout.payload.nptrs = nptrs;
1509     info->srt_len = tag;
1510     info->type    = CONSTR;
1511     info->flags   = FLAGS_CONSTR;
1512 #ifdef USE_MINIINTERPRETER
1513     info->entry   = stgCast(StgFunPtr,&Hugs_CONSTR_entry);
1514 #else
1515 #warning asmMkInfo: Need to insert entry code in some cunning way
1516 #endif
1517     ASSERT( sizeW_fromITBL(info) >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
1518     return info;
1519 }
1520
1521 /*-------------------------------------------------------------------------*/
1522
1523 #endif /* INTERPRETER */
1524