* Copyright (c) 1994-1998.
*
* $RCSfile: Assembler.c,v $
- * $Revision: 1.28 $
- * $Date: 2000/05/09 10:00:35 $
+ * $Revision: 1.33 $
+ * $Date: 2000/10/09 11:18:46 $
*
* 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++) {
}
-#if 0
-void asmMarkObject ( AsmObject obj )
-{
- ASSERT(obj->num_unresolved == 0 && obj->closure);
- obj->closure = MarkRoot(obj->closure);
-}
-#endif
-
/* --------------------------------------------------------------------------
* Keeping track of the simulated stack pointer
* ------------------------------------------------------------------------*/
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 */
asmInstr16(bco,arg2);
}
+#ifdef XMLAMBDA
+static void emiti_8_8_16 ( AsmBCO bco, Instr opcode, int arg1, int arg2, int arg3 )
+{
+ asmInstrOp(bco,opcode);
+ asmInstr8(bco,arg1);
+ asmInstr8(bco,arg2);
+ asmInstr16(bco,arg3);
+}
+#endif
/* --------------------------------------------------------------------------
* Wrappers around the above fns
emiti_16(bco,i_CONST_ADDR_big,arg1);
}
+static void emit_i_CONST_WORD ( AsmBCO bco, int arg1 )
+{
+ ASSERT(arg1 >= 0);
+ if (arg1 < 256)
+ emiti_8 (bco,i_CONST_WORD, arg1); else
+ emiti_16(bco,i_CONST_WORD_big,arg1);
+}
+
static void emit_i_CONST_CHAR ( AsmBCO bco, int arg1 )
{
ASSERT(arg1 >= 0);
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_VAR (AsmBCO bco, int var )
+{
+ ASSERT(var >= 0);
+ if (var < 256)
+ emiti_8 ( bco, i_PACK_INJ_VAR, var ); else
+ emiti_16( bco, i_PACK_INJ_VAR_big, var );
+}
+
+static void emit_i_TEST_INJ_VAR (AsmBCO bco, int var )
+{
+ ASSERT(var >= 0);
+ if (var < 256)
+ emiti_8_16 ( bco, i_TEST_INJ_VAR, var, 0 ); else
+ emiti_16_16( bco, i_TEST_INJ_VAR_big, var, 0 );
+}
+
+static void emit_i_ADD_WORD_VAR (AsmBCO bco, int var )
+{
+ ASSERT(var >= 0);
+ if (var < 256)
+ emiti_8( bco, i_ADD_WORD_VAR, var ); else
+ emiti_16( bco, i_ADD_WORD_VAR_big, var );
+}
+#endif
+
/* --------------------------------------------------------------------------
* Arg checks.
* ------------------------------------------------------------------------*/
void asmConstWord( AsmBCO bco, AsmWord x )
{
- emit_i_CONST_INT(bco,bco->n_words);
- asmAddNonPtrWords(bco,AsmWord,(AsmInt)x);
+ emit_i_CONST_WORD(bco,bco->n_words);
+ asmAddNonPtrWords(bco,AsmWord,x);
incSp(bco, repSizeW(WORD_REP));
}
, { "primIsNegativeZeroDouble", "D", "B", MONAD_Id, i_PRIMOP1, i_isNegativeZeroDouble }
, { "primIsIEEEDouble", "", "B", MONAD_Id, i_PRIMOP1, i_isIEEEDouble }
+#ifdef XMLAMBDA
+ /* primitive row operations. */
+ , { "primRowInsertAt", "XWa","X", MONAD_Id, i_PRIMOP2, i_rowInsertAt }
+ , { "primRowRemoveAt", "XW", "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.
+------------------------------------------------------------------------*/
+static void asmConstWordOpt( AsmBCO bco, AsmWord w )
+{
+ if (w < 256)
+ {
+ emiti_8( bco, i_CONST_WORD_8, w );
+ incSp( bco, repSizeW(WORD_REP)); /* push word */
+ }
+ else
+ {
+ asmConstWord( bco, w );
+ }
+}
+
+/* -----------------------------------------------------------------------
+ insert/remove primitives on rows
+------------------------------------------------------------------------*/
+void asmEndPrimRowChainInsert( AsmBCO bco, AsmSp base, AsmWord n /* number of args */ )
+{
+static AsmPrim primRowChainInsert
+ = { "primRowChainInsert", 0, 0, MONAD_Id, i_PRIMOP2, i_rowChainInsert };
+
+ nat size = bco->sp - base;
+ ASSERT(bco->sp >= base);
+ ASSERT(n*3 + 1 == size); /* n witness/value pairs + the row */
+
+ asmConstWordOpt(bco, n);
+ asmEndPrim(bco,&primRowChainInsert,base);
+}
+
+void asmEndPrimRowChainBuild( AsmBCO bco, AsmSp base, AsmWord n /* number of args */ )
+{
+static AsmPrim primRowChainBuild
+ = { "primRowChainBuild", 0, 0, MONAD_Id, i_PRIMOP2, i_rowChainBuild };
+
+ nat size = bco->sp - base;
+ ASSERT(bco->sp >= base);
+ ASSERT(n*3 == size); /* n witness/value pairs */
+
+ asmConstWordOpt(bco, n);
+ asmEndPrim(bco,&primRowChainBuild,base);
+}
+
+void asmEndPrimRowChainRemove( AsmBCO bco, AsmSp base, AsmWord n /* number of args */ )
+{
+static AsmPrim primRowChainRemove
+ = { "primRowChainRemove", 0, 0, MONAD_Id, i_PRIMOP2, i_rowChainRemove };
+
+ nat size = bco->sp - base;
+ ASSERT(bco->sp >= base);
+ ASSERT(n*2 + 1 == size); /* n witnesses + the row */
+
+ asmConstWordOpt(bco, n);
+ asmEndPrim(bco,&primRowChainRemove,base);
+}
+
+void asmEndPrimRowChainSelect( AsmBCO bco, AsmSp base, AsmWord n /* number of args */ )
+{
+static AsmPrim primRowChainSelect
+ = { "primRowChainSelect", 0, 0, MONAD_Id, i_PRIMOP2, i_rowChainSelect };
+
+ nat size = bco->sp - base;
+ ASSERT(bco->sp >= base);
+ ASSERT(n*2 + 1 == size); /* n witnesses + the row */
+
+ asmConstWordOpt(bco, n);
+ asmEndPrim(bco,&primRowChainSelect,base);
+}
+
+/* -----------------------------------------------------------------------
+ allocation & unpacking of rows
+------------------------------------------------------------------------*/
+AsmVar asmAllocRow ( AsmBCO bco, AsmWord 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, AsmWord n /*number of 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 __attribute__ ((unused)) )
+{
+ /* dummy to make it look prettier */
+}
+
+void asmEndUnpackRow( AsmBCO bco )
+{
+ emiti_(bco,i_UNPACK_ROW);
+}
+
+void asmConstRowTriv( AsmBCO bco )
+{
+ emiti_(bco,i_CONST_ROW_TRIV);
+ incSp(bco,sizeofW(StgPtr));
+}
+
+/*------------------------------------------------------------------------
+ Inj primitives.
+ The Inj constructor contains the value and its index: an unboxed word
+ data Inj = forall a. Inj a Int#
+------------------------------------------------------------------------*/
+AsmVar asmInjRel( AsmBCO bco, AsmVar var, AsmWitness w )
+{
+ int offset = bco->sp - var;
+
+ if (w == 0)
+ {
+ emit_i_PACK_INJ_VAR( bco, offset );
+ }
+ else if (w < 256 && offset < 256 && offset >= 0)
+ {
+ emiti_8_8( bco, i_PACK_INJ_REL_8, offset, w );
+ }
+ else
+ {
+ asmWitnessRel( bco, var, w );
+ emiti_( bco, i_PACK_INJ );
+ decSp(bco, repSizeW(WITNESS_REP)); /* pop witness */
+ }
+
+ decSp(bco, sizeofW(StgPtr)); /* pop argument value */
+ incSp(bco, sizeofW(StgPtr)); /* push Inj result */
+ return bco->sp;
+}
+
+AsmVar asmInjConst( AsmBCO bco, AsmWitness w )
+{
+ if (w < 256)
+ {
+ emiti_8 (bco, i_PACK_INJ_CONST_8, w );
+ }
+ else
+ {
+ asmWitnessConst( bco, w );
+ emiti_( bco, i_PACK_INJ );
+ decSp(bco, repSizeW(WITNESS_REP)); /* pop witness */
+ }
+
+ 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 asmTestInjRel( AsmBCO bco, AsmVar var, AsmWitness w )
+{
+ int offset = bco->sp - var;
+
+ if (w == 0)
+ {
+ emit_i_TEST_INJ_VAR(bco,offset );
+ }
+ else if (w < 256 && offset < 256 && offset >= 0)
+ {
+ emiti_8_8_16( bco, i_TEST_INJ_REL_8, offset, w, 0 );
+ }
+ else
+ {
+ asmWitnessRel( bco, var, w );
+ emiti_16( bco, i_TEST_INJ, 0 );
+ decSp(bco, repSizeW(WITNESS_REP)); /* pop witness */
+ }
+ return bco->n_insns;
+}
+
+AsmPc asmTestInjConst( AsmBCO bco, AsmWitness w )
+{
+ if (w < 256)
+ {
+ emiti_8_16( bco, i_TEST_INJ_CONST_8, w, 0 );
+ }
+ else
+ {
+ asmWitnessConst( bco, w );
+ emiti_16( bco, i_TEST_INJ, 0 );
+ decSp(bco, repSizeW(WITNESS_REP)); /* pop witness */
+ }
+ return bco->n_insns;
+}
+
+
+void asmWitnessRel( AsmBCO bco, AsmVar var, AsmWitness w )
+{
+ int offset = bco->sp - var;
+
+ if (w == 0)
+ {
+ asmVar( bco, var, WITNESS_REP );
+ }
+ else if (w < 256 && offset < 256 && offset >= 0)
+ {
+ emiti_8_8( bco, i_ADD_WORD_VAR_8, offset, w );
+ incSp( bco, repSizeW(WITNESS_REP)); /* push result */
+ }
+ else
+ {
+ asmWitnessConst( bco, w );
+ emit_i_ADD_WORD_VAR( bco, bco->sp - var );
+ decSp( bco, repSizeW(WITNESS_REP)); /* pop witness w */
+ incSp( bco, repSizeW(WITNESS_REP)); /* push witness result */
+ }
+}
+
+void asmWitnessConst( AsmBCO bco, AsmWitness w )
+{
+ if (w < 256)
+ {
+ emiti_8( bco, i_CONST_WORD_8, w );
+ incSp( bco, repSizeW(WITNESS_REP)); /* push witness */
+ }
+ else
+ {
+ asmConstWord( bco, w );
+ }
+}
+
+#endif
+
+
+#ifdef XMLAMBDA
+/* -----------------------------------------------------------------------
+ Calling c functions
+------------------------------------------------------------------------*/
+#include "ForeignCall.h" /* for CallInfo definition */
+#include "Dynamic.h" /* for loadLibrarySymbol & decorateSymbol */
+
+void asmEndPrimCallIndirect(
+ AsmBCO bco
+ , AsmSp base
+ , const char* argTypes
+ , const char* resultTypes
+ , CallType callType )
+{
+static AsmPrim primCCall
+ = { "ccall", 0, 0, MONAD_Id, i_PRIMOP2, i_ccall };
+
+ CallInfo callInfo;
+ StgWord offset = 0;
+ int argCount = argTypes ? strlen(argTypes) : 0;
+ int resultCount = resultTypes ? strlen(resultTypes) : 0;
+
+ if (argCount + resultCount > MAX_CALL_VALUES)
+ barf( "external call: too many arguments and/or results" );
+
+ /* initialize the callInfo structure */
+ callInfo.argCount = argCount;
+ callInfo.resultCount = resultCount;
+ callInfo.callConv = CCall;
+ callInfo.data[0] = '\0';
+ callInfo.data[1] = '\0';
+
+ switch (callType)
+ {
+ case CCall: callInfo.callConv = CCall; break;
+ case StdCall: callInfo.callConv = StdCall; break;
+ default: belch( "external call: unknown calling convention: \"%c\"", callType );
+ }
+
+ if (argCount > 0) strcpy(callInfo.data,argTypes);
+ if (resultCount > 0) strcpy(callInfo.data + argCount + 1, resultTypes);
+
+ /* We push the offset of the CallInfo structure in this BCO's
+ non-ptr area as a Word. In the "i_ccall" primitive
+ this offset is used to retrieve the CallInfo again. */
+ offset = bco->n_words;
+ asmAddNonPtrWords(bco,CallInfo,callInfo);
+ asmConstWord(bco,offset);
+
+ /* emit a ccall */
+ asmEndPrim( bco, &primCCall, base );
+ return;
+}
+
+
+void asmEndPrimCallDynamic(
+ AsmBCO bco
+ , AsmSp base
+ , const char* libName
+ , const char* funName
+ , const char* argTypes
+ , const char* resultTypes
+ , CallType callType
+ , int /*bool*/ decorate )
+{
+ void* funPtr;
+ ASSERT(libName);
+ ASSERT(funName);
+
+ /* load the function pointer */
+ if (decorate)
+ {
+ char funNameBuf[MAX_SYMBOL_NAME];
+ decorateSymbol( funNameBuf, funName, MAX_SYMBOL_NAME
+ , callType, argTypes, resultTypes );
+ funPtr = loadLibrarySymbol( libName, funNameBuf, callType );
+ }
+ else
+ funPtr = loadLibrarySymbol( libName, funName, callType );
+
+ /* push the static function pointer */
+ asmConstAddr( bco, funPtr );
+
+ /* and call it indirectly */
+ asmEndPrimCallIndirect( bco, base, argTypes, resultTypes, callType );
+}
+
+#endif /* XMLAMBDA */
+
+
/*-------------------------------------------------------------------------*/
#endif /* INTERPRETER */
projects / ghc-hetmet.git / blobdiff