* Copyright (c) 1994-1998.
*
* $RCSfile: Assembler.c,v $
- * $Revision: 1.29 $
- * $Date: 2000/05/10 09:00:20 $
+ * $Revision: 1.32 $
+ * $Date: 2000/06/15 13:23:51 $
*
* This module provides functions to construct BCOs and other closures
* required by the bytecode compiler.
objects = obj;
obj->n_refs = obj->n_words = obj->n_insns = 0;
obj->closure = NULL;
+ obj->stgexpr = 0; /*NIL*/
obj->magic = 0x31415927;
INITIALISE_TABLE(AsmEntity,obj->entities,
obj->sizeEntities,
}
}
+/* Support for the peephole optimiser. Find the instruction
+ byte n back, carefully stepping over any non Asm_Insn8 entities
+ on the way.
+*/
+static Instr asmInstrBack ( AsmBCO bco, StgInt n )
+{
+ StgInt ue = bco->usedEntities;
+ while (1) {
+ if (ue < 0 || n <= 0) barf("asmInstrBack");
+ ue--;
+ if (bco->entities[ue].kind != Asm_Insn8) continue;
+ n--;
+ if (n == 0) return bco->entities[ue].val;
+ }
+}
+
+
+/* Throw away n Asm_Insn8 bytes, and slide backwards any Asm_Insn8 entities
+ as necessary.
+*/
+static void asmInstrRecede ( AsmBCO bco, StgInt n )
+{
+ StgInt ue = bco->usedEntities;
+ StgInt wr;
+ while (1) {
+ if (ue < 0 || n <= 0) barf("asmInstrRecede");
+ ue--;
+ if (bco->entities[ue].kind != Asm_Insn8) continue;
+ n--;
+ bco->n_insns--;
+ if (n == 0) break;
+ }
+ /* Now ue is the place where we would recede usedEntities to,
+ except that there may be stuff to slide downwards.
+ */
+ wr = ue;
+ for (; ue < bco->usedEntities; ue++) {
+ if (bco->entities[ue].kind != Asm_Insn8) {
+ bco->entities[wr] = bco->entities[ue];
+ wr++;
+ }
+ }
+ bco->usedEntities = wr;
+}
+
+
static int asmFindInNonPtrs ( AsmBCO bco, StgWord w )
{
int i, j = 0;
return NULL; /*notreached*/
}
+
void asmCopyAndLink ( void )
{
int j, k;
bco->n_words = abco->n_words;
bco->n_instrs = abco->n_insns + (obj->max_sp <= 255 ? 2 : 3);
bco->stgexpr = abco->stgexpr;
-
+ //ppStgExpr(bco->stgexpr);
/* First copy in the ptrs. */
k = 0;
for (j = 0; j < obj->usedEntities; j++) {
AsmBCO asmBeginBCO( int /*StgExpr*/ e )
{
- AsmBCO bco = asmNewObject();
+ AsmBCO bco = asmNewObject();
bco->kind = Asm_BCO;
bco->stgexpr = e;
+ //ppStgExpr(bco->stgexpr);
bco->sp = 0;
bco->max_sp = 0;
bco->lastOpc = i_INTERNAL_ERROR;
asmAddInstr(bco,i % 256);
}
-#if 0
-static Instr asmInstrBack ( AsmBCO bco, StgWord n )
-{
- return bco->is.elems[bco->is.len - n];
-}
-
-static void asmInstrRecede ( AsmBCO bco, StgWord n )
-{
- if (bco->is.len < n) barf("asmInstrRecede");
- bco->is.len -= n;
-}
-#endif
#define asmAddNonPtrWords(bco,ty,x) \
{ \
static void emiti_ ( AsmBCO bco, Instr opcode )
{
-#if 0
+#if 1
StgInt x, y;
if (bco->lastOpc == i_SLIDE && opcode == i_ENTER) {
/* SLIDE x y ; ENTER ===> SE x y */
static void emiti_8 ( AsmBCO bco, Instr opcode, int arg1 )
{
-#if 0
+#if 1
StgInt x;
if (bco->lastOpc == i_VAR && opcode == i_VAR) {
/* VAR x ; VAR y ===> VV x y */
emiti_16(bco,i_ALLOC_CONSTR_big,arg1);
}
+#ifdef XMLAMBDA
+static void emit_i_ALLOC_ROW( AsmBCO bco, int n )
+{
+ ASSERT(n >= 0);
+ if (n < 256)
+ emiti_8 ( bco, i_ALLOC_ROW, n ); else
+ emiti_16( bco, i_ALLOC_ROW_big, n );
+}
+
+static void emit_i_PACK_ROW (AsmBCO bco, int var )
+{
+ ASSERT(var >= 0);
+ if (var < 256)
+ emiti_8 ( bco, i_PACK_ROW, var ); else
+ emiti_16( bco, i_PACK_ROW_big, var );
+}
+
+static void emit_i_PACK_INJ (AsmBCO bco, int var )
+{
+ ASSERT(var >= 0);
+ if (var < 256)
+ emiti_8 ( bco, i_PACK_INJ, var ); else
+ emiti_16( bco, i_PACK_INJ_big, var );
+}
+
+static void emit_i_TEST_INJ (AsmBCO bco, int var )
+{
+ ASSERT(var >= 0);
+ if (var < 256)
+ emiti_8_16 ( bco, i_TEST_INJ, var, 0 ); else
+ emiti_16_16( bco, i_TEST_INJ_big, var, 0 );
+}
+#endif
+
/* --------------------------------------------------------------------------
* Arg checks.
* ------------------------------------------------------------------------*/
, { "primIsNegativeZeroDouble", "D", "B", MONAD_Id, i_PRIMOP1, i_isNegativeZeroDouble }
, { "primIsIEEEDouble", "", "B", MONAD_Id, i_PRIMOP1, i_isIEEEDouble }
+#ifdef XMLAMBDA
+ /* primitive row operations. */
+ , { "primRowInsertAt", "XIa","X", MONAD_Id, i_PRIMOP2, i_rowInsertAt }
+ , { "primRowRemoveAt", "XI", "aX", MONAD_Id, i_PRIMOP2, i_rowRemoveAt }
+#endif
+
/* Ref operations */
, { "primNewRef", "a", "R", MONAD_ST, i_PRIMOP2, i_newRef }
, { "primWriteRef", "Ra", "", MONAD_ST, i_PRIMOP2, i_writeRef }
void asmEndPack( AsmBCO bco, AsmVar v, AsmSp start, AsmInfo info )
{
nat size = bco->sp - start;
- assert(bco->sp >= start);
- assert(start >= v);
+ ASSERT(bco->sp >= start);
+ ASSERT(start >= v);
/* only reason to include info is for this assertion */
- assert(info->layout.payload.ptrs == size);
+ ASSERT(info->layout.payload.ptrs == size);
emit_i_PACK(bco, bco->sp - v);
setSp(bco, start);
}
return info;
}
+#ifdef XMLAMBDA
+/* -----------------------------------------------------------------------
+ All the XMLambda primitives.
+------------------------------------------------------------------------*/
+
+/* -----------------------------------------------------------------------
+ allocation & unpacking of rows
+------------------------------------------------------------------------*/
+AsmVar asmAllocRow ( AsmBCO bco, AsmNat n /*number of fields*/ )
+{
+ emit_i_ALLOC_ROW(bco,n);
+
+ incSp(bco, sizeofW(StgClosurePtr));
+ return bco->sp;
+}
+
+AsmSp asmBeginPackRow( AsmBCO bco )
+{
+ return bco->sp;
+}
+
+void asmEndPackRow( AsmBCO bco, AsmVar v, AsmSp start, AsmNat n /*#fields*/ )
+{
+ nat size = bco->sp - start;
+ ASSERT(bco->sp >= start);
+ ASSERT(start >= v);
+ /* only reason to include n is for this assertion */
+ ASSERT(n == size);
+ emit_i_PACK_ROW(bco,bco->sp - v);
+ setSp(bco, start);
+}
+
+void asmBeginUnpackRow( AsmBCO bco )
+{
+ /* dummy to make it look prettier */
+}
+
+void asmEndUnpackRow( AsmBCO bco )
+{
+ emiti_(bco,i_UNPACK_ROW);
+}
+
+/*------------------------------------------------------------------------
+ Inj primitives.
+ The Inj constructor contains the value and its index: an unboxed int
+ data Inj = forall a. Inj a Int#
+ There is no "big" form for the INJ_CONST instructions. The index
+ is therefore still limited to 256 values.
+------------------------------------------------------------------------*/
+AsmVar asmInj( AsmBCO bco, AsmVar index )
+{
+ emit_i_PACK_INJ( bco, bco->sp - index );
+
+ decSp(bco, sizeofW(StgPtr)); /* pop argument value */
+ incSp(bco, sizeofW(StgPtr)); /* push Inj result */
+ return bco->sp;
+}
+
+AsmVar asmInjConst( AsmBCO bco, AsmIndex x )
+{
+ ASSERT( x >= 0 && x <= 255 );
+ emiti_8 (bco, i_PACK_INJ_CONST, x );
+
+ decSp(bco, sizeofW(StgPtr)); /* pop argument value */
+ incSp(bco, sizeofW(StgPtr)); /* push Inj result */
+ return bco->sp;
+}
+
+/* UNPACK_INJ only returns the value; the index should be
+ tested using the TEST_INJ instructions. */
+AsmVar asmUnInj( AsmBCO bco )
+{
+ emiti_(bco,i_UNPACK_INJ);
+ incSp(bco, sizeofW(StgPtr)); /* push the value */
+ return bco->sp;
+}
+
+AsmPc asmTestInj( AsmBCO bco, AsmVar index )
+{
+ emit_i_TEST_INJ(bco,bco->sp - index);
+ return bco->n_insns;
+}
+
+AsmPc asmTestInjConst( AsmBCO bco, AsmIndex x )
+{
+ ASSERT( x >= 0 && x <= 255 );
+ emiti_8_16 (bco, i_TEST_INJ_CONST, x, 0 );
+ return bco->n_insns;
+}
+
+AsmVar asmConstIndex( AsmBCO bco, AsmIndex x )
+{
+ ASSERT( x >= 0 && x <= 65535 );
+ asmConstInt(bco,x);
+ return bco->sp;
+}
+#endif
+
/*-------------------------------------------------------------------------*/
#endif /* INTERPRETER */
projects / ghc-hetmet.git / blobdiff