From: daan Date: Thu, 15 Jun 2000 13:23:52 +0000 (+0000) Subject: [project @ 2000-06-15 13:23:51 by daan] X-Git-Tag: Approximately_9120_patches~4189 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=3d124552f679101c2f6dd98101b10dbcf9ba0898;p=ghc-hetmet.git [project @ 2000-06-15 13:23:51 by daan] Added new primitives and bytecodes that support code generation for XMLambda. All additions are surrounded by #ifdef XMLAMBDA. Most important additions: - Rows (n-tuples) which are implemented on top of Frozen Mutarrays - Inj (variant sums), which is implemented using a new constructor called Inj which contains both the value and an unboxed int which represents the index. --- diff --git a/ghc/rts/Assembler.c b/ghc/rts/Assembler.c index ab80581..6746185 100644 --- a/ghc/rts/Assembler.c +++ b/ghc/rts/Assembler.c @@ -5,8 +5,8 @@ * Copyright (c) 1994-1998. * * $RCSfile: Assembler.c,v $ - * $Revision: 1.31 $ - * $Date: 2000/05/26 10:14:34 $ + * $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. @@ -861,6 +861,40 @@ static void emit_i_ALLOC_CONSTR ( AsmBCO bco, int arg1 ) 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. * ------------------------------------------------------------------------*/ @@ -1414,6 +1448,12 @@ AsmPrim asmPrimOps[] = { , { "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 } @@ -1824,6 +1864,104 @@ AsmInfo asmMkInfo( AsmNat tag, AsmNat ptrs ) 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 */ diff --git a/ghc/rts/Bytecodes.h b/ghc/rts/Bytecodes.h index f033a21..07e717a 100644 --- a/ghc/rts/Bytecodes.h +++ b/ghc/rts/Bytecodes.h @@ -1,6 +1,6 @@ /* ----------------------------------------------------------------------------- - * $Id: Bytecodes.h,v 1.15 2000/04/11 20:44:19 panne Exp $ + * $Id: Bytecodes.h,v 1.16 2000/06/15 13:23:51 daan Exp $ * * (c) The GHC Team, 1998-1999 * @@ -33,15 +33,27 @@ Ins(i_ALLOC_PAP), \ Ins(i_ALLOC_CONSTR), \ Ins(i_ALLOC_CONSTR_big), \ + Ins(i_ALLOC_ROW), \ + Ins(i_ALLOC_ROW_big), \ Ins(i_MKAP), \ Ins(i_MKAP_big), \ Ins(i_MKPAP), \ Ins(i_PACK), \ Ins(i_PACK_big), \ + Ins(i_PACK_ROW), \ + Ins(i_PACK_ROW_big), \ + Ins(i_PACK_INJ), \ + Ins(i_PACK_INJ_big), \ + Ins(i_PACK_INJ_CONST), \ Ins(i_SLIDE), \ Ins(i_SLIDE_big), \ Ins(i_TEST), \ + Ins(i_TEST_INJ), \ + Ins(i_TEST_INJ_big), \ + Ins(i_TEST_INJ_CONST), \ Ins(i_UNPACK), \ + Ins(i_UNPACK_ROW), \ + Ins(i_UNPACK_INJ), \ Ins(i_VAR), \ Ins(i_VAR_big), \ Ins(i_CONST), \ @@ -326,6 +338,12 @@ typedef enum , i_raise +#ifdef XMLAMBDA + /* row primitives. */ + , i_rowInsertAt + , i_rowRemoveAt +#endif + /* Ref operations */ , i_newRef , i_writeRef @@ -444,7 +462,7 @@ typedef enum /* If you add a new primop to this table, check you don't * overflow the 256 limit. That is MAX_Primop2 <= 255. - * Current value (30/10/98) = 0x42 + * Current value (6/10/2000) = 0x44 */ , MAX_Primop2 = i_ccall_stdcall_IO } Primop2; diff --git a/ghc/rts/Disassembler.c b/ghc/rts/Disassembler.c index 56792cb..cd8ea43 100644 --- a/ghc/rts/Disassembler.c +++ b/ghc/rts/Disassembler.c @@ -5,8 +5,8 @@ * Copyright (c) 1994-1998. * * $RCSfile: Disassembler.c,v $ - * $Revision: 1.12 $ - * $Date: 1999/12/07 11:49:11 $ + * $Revision: 1.13 $ + * $Date: 2000/06/15 13:23:51 $ * ---------------------------------------------------------------------------*/ #include "Rts.h" @@ -81,6 +81,18 @@ static InstrPtr disIntPC ( StgBCO *bco, InstrPtr pc, char* i ) return pc; } +#ifdef XMLAMBDA +static InstrPtr disInt16PC ( StgBCO *bco, InstrPtr pc, char* i ) +{ + StgInt x; + StgWord y; + x = bcoInstr(bco,pc); pc += 2; + y = bcoInstr16(bco,pc); pc += 2; + fprintf(stderr,"%s %d %d",i,x,pc+y); + return pc; +} +#endif + static InstrPtr disPC ( StgBCO *bco, InstrPtr pc, char* i ) { StgWord y = bcoInstr16(bco,pc); pc += 2; @@ -267,6 +279,36 @@ InstrPtr disInstr( StgBCO *bco, InstrPtr pc ) case i_CONST_big: return disConstPtr16(bco,pc,"CONST_big"); +#ifdef XMLAMBDA + case i_ALLOC_ROW: + return disInt(bco,pc,"ALLOC_ROW"); + case i_ALLOC_ROW_big: + return disInt16(bco,pc,"ALLOC_ROW_big"); + case i_PACK_ROW: + return disInt(bco,pc,"PACK_ROW"); + case i_PACK_ROW_big: + return disInt16(bco,pc,"PACK_ROW_big"); + + case i_PACK_INJ: + return disInt(bco,pc,"PACK_INJ"); + case i_PACK_INJ_big: + return disInt16(bco,pc,"PACK_INJ_big"); + case i_PACK_INJ_CONST: + return disInt(bco,pc,"PACK_INJ_CONST"); + + case i_UNPACK_ROW: + return disNone(bco,pc,"UNPACK_ROW"); + case i_UNPACK_INJ: + return disNone(bco,pc,"UNPACK_INJ"); + + case i_TEST_INJ: + return disIntPC(bco,pc,"TEST_INJ"); + case i_TEST_INJ_big: + return disInt16PC(bco,pc,"TEST_INJ_big"); + case i_TEST_INJ_CONST: + return disIntPC(bco,pc,"TEST_INJ_CONST"); +#endif + case i_VOID: return disNone(bco,pc,"VOID"); diff --git a/ghc/rts/Evaluator.c b/ghc/rts/Evaluator.c index 05f2d49..8248f2a 100644 --- a/ghc/rts/Evaluator.c +++ b/ghc/rts/Evaluator.c @@ -5,8 +5,8 @@ * Copyright (c) 1994-1998. * * $RCSfile: Evaluator.c,v $ - * $Revision: 1.54 $ - * $Date: 2000/05/26 10:14:34 $ + * $Revision: 1.55 $ + * $Date: 2000/06/15 13:23:51 $ * ---------------------------------------------------------------------------*/ #include "Rts.h" @@ -585,6 +585,29 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 ) xPushPtr(p); Continue; } +#ifdef XMLAMBDA + /* allocate rows, implemented on top of Arrays */ + Case(i_ALLOC_ROW): + { + StgMutArrPtrs* p; + int n = BCO_INSTR_8; + SSS; p = stgCast(StgMutArrPtrs*,grabHpNonUpd(sizeofW(StgMutArrPtrs) + n)); LLL; + SET_HDR(p,&MUT_ARR_PTRS_FROZEN_info,CCCS); + p->ptrs = n; + xPushPtr(p); + Continue; + } + Case(i_ALLOC_ROW_big): + { + StgMutArrPtrs* p; + int n = BCO_INSTR_16; + SSS; p = stgCast(StgMutArrPtrs*,grabHpNonUpd(sizeofW(StgMutArrPtrs) + n)); LLL; + SET_HDR(p,&MUT_ARR_PTRS_FROZEN_info,CCCS); + p->ptrs = n; + xPushPtr(p); + Continue; + } +#endif Case(i_MKAP): { int x = BCO_INSTR_8; /* ToDo: Word not Int! */ @@ -688,6 +711,112 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 ) ); Continue; } +#ifdef XMLAMBDA + /* pack values into a row. */ + Case(i_PACK_ROW): + { + int offset = BCO_INSTR_8; + StgMutArrPtrs* p = stgCast(StgMutArrPtrs*,xStackPtr(offset)); + StgWord n = p->ptrs; + nat i; + + for (i=0; ipayload[i] = xPopCPtr(); + } + IF_DEBUG(evaluator, + fprintf(stderr,"\tBuilt "); + SSS; + printObj(stgCast(StgClosure*,p)); + LLL; + ); + Continue; + } + Case(i_PACK_ROW_big): + { + int offset = BCO_INSTR_16; + StgMutArrPtrs* p = stgCast(StgMutArrPtrs*,xStackPtr(offset)); + StgWord n = p->ptrs; + nat i; + + for (i=0; ipayload[i] = xPopCPtr(); + } + IF_DEBUG(evaluator, + fprintf(stderr,"\tBuilt "); + SSS; + printObj(stgCast(StgClosure*,p)); + LLL; + ); + Continue; + } + /* pack values into an Inj */ + Case(i_PACK_INJ): + { + const int size = CONSTR_sizeW(sizeofW(StgPtr),sizeofW(StgInt)); + int offset = BCO_INSTR_8; + + StgClosure* o; + SSS; o = (StgClosure*)grabHpNonUpd(size); LLL; + SET_HDR(o,Inj_con_info,??); + + payloadWord(o,sizeofW(StgPtr)) = xTaggedStackInt(offset); + payloadPtr(o,0) = xPopPtr(); + + IF_DEBUG(evaluator, + fprintf(stderr,"\tBuilt "); + SSS; + printObj(stgCast(StgClosure*,o)); + LLL; + ); + xPushPtr(stgCast(StgPtr,o)); + Continue; + } + Case(i_PACK_INJ_big): + { + const int size = CONSTR_sizeW(sizeofW(StgPtr),sizeofW(StgInt)); + int offset = BCO_INSTR_16; + + StgClosure* o; + SSS; o = (StgClosure*)grabHpNonUpd(size); LLL; + SET_HDR(o,Inj_con_info,??); + + payloadWord(o,sizeofW(StgPtr)) = xTaggedStackInt(offset); + payloadPtr(o,0) = xPopPtr(); + + IF_DEBUG(evaluator, + fprintf(stderr,"\tBuilt "); + SSS; + printObj(stgCast(StgClosure*,o)); + LLL; + ); + xPushPtr(stgCast(StgPtr,o)); + Continue; + } + Case(i_PACK_INJ_CONST): + { + const int size = CONSTR_sizeW(sizeofW(StgPtr),sizeofW(StgInt)); + int index = BCO_INSTR_8; + + StgClosure* o; + SSS; o = (StgClosure*)grabHpNonUpd(size); LLL; + SET_HDR(o,Inj_con_info,??); + + payloadWord(o,sizeofW(StgPtr)) = index; + payloadPtr(o,0) = xPopPtr(); + + IF_DEBUG(evaluator, + fprintf(stderr,"\tBuilt "); + SSS; + printObj(stgCast(StgClosure*,o)); + LLL; + ); + xPushPtr(stgCast(StgPtr,o)); + Continue; + } + +#endif /* XMLAMBDA */ Case(i_SLIDE): { int x = BCO_INSTR_8; @@ -733,6 +862,45 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 ) } Continue; } +#ifdef XMLAMBDA + /* Test Inj indices. */ + Case(i_TEST_INJ): + { + int offset = BCO_INSTR_8; + StgWord jump = BCO_INSTR_16; + + int index = payloadWord( (StgClosure*)xStackPtr(0), sizeofW(StgPtr) ); + if (index != xTaggedStackInt(offset) ) + { + bciPtr += jump; + } + Continue; + } + Case(i_TEST_INJ_big): + { + int offset = BCO_INSTR_16; + StgWord jump = BCO_INSTR_16; + + int index = payloadWord( (StgClosure*)xStackPtr(0), sizeofW(StgPtr) ); + if (index != xTaggedStackInt(offset) ) + { + bciPtr += jump; + } + Continue; + } + Case(i_TEST_INJ_CONST): + { + int value = BCO_INSTR_8; + StgWord jump = BCO_INSTR_16; + + int index = payloadWord( (StgClosure*)xStackPtr(0), sizeofW(StgPtr) ); + if (index != value ) + { + bciPtr += jump; + } + Continue; + } +#endif /* XMLAMBDA */ Case(i_UNPACK): { StgClosure* o = stgCast(StgClosure*,xStackPtr(0)); @@ -752,6 +920,29 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 ) } Continue; } +#ifdef XMLAMBDA + /* extract all fields of a row */ + Case(i_UNPACK_ROW): + { + StgMutArrPtrs* p = stgCast(StgMutArrPtrs*,xStackPtr(0)); + int i = p->ptrs; + while (--i >= 0) + { + xPushCPtr(p->payload[i]); + } + Continue; + } + /* extract the value of an INJ */ + Case(i_UNPACK_INJ): + { + StgClosure* con = stgCast(StgClosure*,xStackPtr(0)); + + ASSERT(get_itbl(con) == Inj_con_info); + + xPushPtr(payloadPtr(con,0)); + Continue; + } +#endif /* XMLAMBA */ Case(i_VAR_big): { int n = BCO_INSTR_16; @@ -1291,6 +1482,10 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 ) case CONSTR_CHARLIKE: case CONSTR_STATIC: case CONSTR_NOCAF_STATIC: +#ifdef XMLAMBDA +/* rows are mutarrays and should be treated as constructors. */ + case MUT_ARR_PTRS_FROZEN: +#endif { while (1) { switch (get_itbl(stgCast(StgClosure*,xSp))->type) { @@ -1446,6 +1641,11 @@ static inline StgWord stackWord ( StgStackOffset i ) static inline void setStackWord ( StgStackOffset i, StgWord w ) { gSp[i] = w; } +#ifdef XMLAMBDA +static inline void setStackPtr ( StgStackOffset i, StgPtr p ) + { *(stgCast(StgPtr*, gSp+i)) = p; } +#endif + static inline void PushTaggedRealWorld( void ) { PushTag(REALWORLD_TAG); } inline void PushTaggedInt ( StgInt x ) @@ -2549,6 +2749,71 @@ static void* enterBCO_primop2 ( int primop2code, StgClosure* err = PopCPtr(); return (raiseAnError(err)); } +#ifdef XMLAMBDA +/*------------------------------------------------------------------------ + Insert and Remove primitives on Rows +------------------------------------------------------------------------*/ + case i_rowInsertAt: + { + nat j; + /* get: row, index and value */ + StgMutArrPtrs* row = stgCast(StgMutArrPtrs*,PopPtr()); + nat i = PopTaggedInt(); + StgClosure* x = PopCPtr(); + + /* allocate new row */ + StgWord n = row->ptrs; + StgMutArrPtrs* newRow + = stgCast(StgMutArrPtrs*,allocate(sizeofW(StgMutArrPtrs) + n + 1)); + SET_HDR(newRow,&MUT_ARR_PTRS_FROZEN_info,CCCS); + newRow->ptrs = n+1; + + ASSERT(i <= n); + + /* copy the fields, inserting the new value */ + for (j = 0; j < i; j++) { + newRow->payload[j] = row->payload[j]; + } + newRow->payload[i] = x; + for (j = i+1; j <= n; j++) + { + newRow->payload[j] = row->payload[j-1]; + } + + PushPtr(stgCast(StgPtr,newRow)); + break; + } + + case i_rowRemoveAt: + { + nat j; + /* get row and index */ + StgMutArrPtrs* row = stgCast(StgMutArrPtrs*,PopPtr()); + nat i = PopTaggedInt(); /* or Word?? */ + + /* allocate new row */ + StgWord n = row->ptrs; + StgMutArrPtrs* newRow + = stgCast(StgMutArrPtrs*,allocate(sizeofW(StgMutArrPtrs) + n - 1)); + SET_HDR(newRow,&MUT_ARR_PTRS_FROZEN_info,CCCS); + newRow->ptrs = n-1; + + ASSERT(i < n); + + /* copy the fields, except for the removed value. */ + for (j = 0; j < i; j++) { + newRow->payload[j] = row->payload[j]; + } + for (j = i+1; j < n; j++) + { + newRow->payload[j-1] = row->payload[j]; + } + + PushCPtr(row->payload[i]); + PushPtr(stgCast(StgPtr,newRow)); + break; + } +#endif /* XMLAMBDA */ case i_newRef: { diff --git a/ghc/rts/Prelude.c b/ghc/rts/Prelude.c index 7188e74..154b046 100644 --- a/ghc/rts/Prelude.c +++ b/ghc/rts/Prelude.c @@ -1,6 +1,6 @@ /* ----------------------------------------------------------------------------- - * $Id: Prelude.c,v 1.7 2000/05/22 13:09:29 simonmar Exp $ + * $Id: Prelude.c,v 1.8 2000/06/15 13:23:52 daan Exp $ * * (c) The GHC Team, 1998-2000 * @@ -75,6 +75,17 @@ INFO_TABLE_CONSTR(hugs_standalone_Wzh_static_info,Hugs_CONSTR_entry, 0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,,EF_,0,0); INFO_TABLE_CONSTR(hugs_standalone_StablePtr_static_info,Hugs_CONSTR_entry, 0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,,EF_,0,0); + +#ifdef XMLAMBDA +/* The Inj constructor: data Inj = forall a. Inj a Int# + Since this one is not present in Haskell compiled stuff, we bind it statically. +*/ +INFO_TABLE_CONSTR(xmlambda_Inj_con_info,Hugs_CONSTR_entry, + sizeofW(StgPtr),sizeofW(StgInt),0,CONSTR,,EF_,0,0); + +const StgInfoTable* ind_Inj_con_info = &xmlambda_Inj_con_info; +#endif /* XMLAMBDA */ + #endif diff --git a/ghc/rts/Prelude.h b/ghc/rts/Prelude.h index d6dbda4..db04225 100644 --- a/ghc/rts/Prelude.h +++ b/ghc/rts/Prelude.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Prelude.h,v 1.10 2000/05/23 15:31:48 sewardj Exp $ + * $Id: Prelude.h,v 1.11 2000/06/15 13:23:52 daan Exp $ * * (c) The GHC Team, 1998-2000 * @@ -134,6 +134,14 @@ extern const StgInfoTable *ind_StablePtr_con_info; #define StablePtr_static_info ind_StablePtr_static_info #define StablePtr_con_info ind_StablePtr_con_info +#ifdef XMLAMBDA +/* The Inj constructor. Not present in combined mode or compiled code. */ + +extern const StgInfoTable *ind_Inj_con_info; +#define Inj_con_info ind_Inj_con_info + +#endif + #endif void fixupRTStoPreludeRefs( void*(*)(char*) ); diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c index d6d106d..32e0bc6 100644 --- a/ghc/rts/Printer.c +++ b/ghc/rts/Printer.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Printer.c,v 1.26 2000/04/17 14:31:19 sewardj Exp $ + * $Id: Printer.c,v 1.27 2000/06/15 13:23:52 daan Exp $ * * (c) The GHC Team, 1994-2000. * @@ -258,6 +258,23 @@ void printClosure( StgClosure *obj ) break; } +#ifdef XMLAMBDA +/* rows are mutarrays in xmlambda, maybe we should make a new type: ROW */ + case MUT_ARR_PTRS_FROZEN: + { + StgWord i; + StgMutArrPtrs* p = stgCast(StgMutArrPtrs*,obj); + + fprintf(stderr,"Row<%i>(",p->ptrs); + for (i = 0; i < p->ptrs; ++i) { + if (i > 0) fprintf(stderr,", "); + printPtr((StgPtr)(p->payload[i])); + } + fprintf(stderr,")\n"); + break; + } +#endif + case FUN: case FUN_1_0: case FUN_0_1: case FUN_1_1: case FUN_0_2: case FUN_2_0: