ghc/rts/Assembler.c

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