X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FAssembler.c;h=b167f0dd578681d8119be0c276dd6b700090ee59;hb=7007351bb709611fbb259aae2eb286d107355486;hp=0d963916e6a07632e01fca679a20eb977adaedfc;hpb=081601b1b535a1b520b7ad2a6de02ba6d9145172;p=ghc-hetmet.git diff --git a/ghc/rts/Assembler.c b/ghc/rts/Assembler.c index 0d96391..b167f0d 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.13 $ - * $Date: 1999/11/01 18:19:40 $ + * $Revision: 1.24 $ + * $Date: 2000/03/20 04:26:24 $ * * This module provides functions to construct BCOs and other closures * required by the bytecode compiler. @@ -49,9 +49,10 @@ #include "Bytecodes.h" #include "Printer.h" #include "Disassembler.h" -#include "Evaluator.h" #include "StgMiscClosures.h" #include "Storage.h" +#include "Schedule.h" +#include "Evaluator.h" #define INSIDE_ASSEMBLER_C #include "Assembler.h" @@ -78,25 +79,33 @@ typedef struct { #define Queue Instrs #define Type StgWord8 +#define MAKE_findIn 0 #include "QueueTemplate.h" +#undef MAKE_findIn #undef Type #undef Queue #define Queue Ptrs #define Type AsmObject +#define MAKE_findIn 0 #include "QueueTemplate.h" +#undef MAKE_findIn #undef Type #undef Queue #define Queue Refs #define Type AsmRef +#define MAKE_findIn 0 #include "QueueTemplate.h" +#undef MAKE_findIn #undef Type #undef Queue #define Queue NonPtrs #define Type StgWord +#define MAKE_findIn 1 #include "QueueTemplate.h" +#undef MAKE_findIn #undef Type #undef Queue @@ -145,8 +154,6 @@ struct AsmBCO_ { /* abstract machine ("executed" during compilation) */ AsmSp sp; /* stack ptr */ AsmSp max_sp; - StgWord hp; /* heap ptr */ - StgWord max_hp; Instr lastOpc; }; @@ -171,8 +178,8 @@ static void asmResolveRef( AsmObject obj, AsmNat i, AsmClosure reference ) case CONSTR: { StgClosure* con = stgCast(StgClosure*,obj->closure); - ASSERT(i < get_itbl(con)->layout.payload.nptrs && payloadCPtr(con,i) == NULL); - payloadCPtr(con,i) = reference; + ASSERT(i < get_itbl(con)->layout.payload.nptrs && con->payload[i] == NULL); + con->payload[i] = reference; break; } case AP_UPD: @@ -183,8 +190,8 @@ static void asmResolveRef( AsmObject obj, AsmNat i, AsmClosure reference ) ASSERT(ap->fun == NULL); ap->fun = reference; } else { - ASSERT(payloadCPtr(ap,i-1) == NULL); - payloadCPtr(ap,i-1) = reference; + ASSERT(ap->payload[i-1] == NULL); + ap->payload[i-1] = reference; } break; } @@ -261,26 +268,6 @@ static StgClosure* asmAlloc( nat size ) return o; } -static void grabHpUpd( AsmBCO bco, nat size ) -{ - /* ToDo: sometimes we should test for MIN_UPD_SIZE instead */ - ASSERT( size >= MIN_UPD_SIZE + sizeofW(StgHeader) ); - bco->hp += size; -} - -static void grabHpNonUpd( AsmBCO bco, nat size ) -{ - /* ToDo: sometimes we should test for MIN_UPD_SIZE instead */ - ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) ); - bco->hp += size; -} - -static void resetHp( AsmBCO bco, nat hp ) -{ - bco->max_hp = stg_max(bco->hp,bco->max_hp); - bco->hp = hp; -} - static void setSp( AsmBCO bco, AsmSp sp ) { bco->max_sp = stg_max(bco->sp,bco->max_sp); @@ -336,8 +323,8 @@ void asmEndCon( AsmCon con ) StgClosure* c = asmAlloc(CONSTR_sizeW(p,np)); StgClosure* o = stgCast(StgClosure*,c); SET_HDR(o,con->info,??); - mapQueue(Ptrs, AsmObject, con->object.ptrs, payloadCPtr(o,i) = NULL); - { nat i; for( i=0; iobject.ptrs, o->payload[i] = NULL); + { nat i; for( i=0; ipayload[p+i] = (StgClosure *)0xdeadbeef; }} asmEndObject(&con->object,c); } @@ -376,7 +363,6 @@ AsmBCO asmBeginBCO( int /*StgExpr*/ e ) bco->stgexpr = e; bco->max_sp = bco->sp = 0; - bco->max_hp = bco->hp = 0; bco->lastOpc = i_INTERNAL_ERROR; return bco; } @@ -399,7 +385,6 @@ void asmEndBCO( AsmBCO bco ) { nat j = 0; bco->max_sp = stg_max(bco->sp,bco->max_sp); - bco->max_hp = stg_max(bco->hp,bco->max_hp); ASSERT(bco->max_sp <= 65535); if (bco->max_sp <= 255) { @@ -466,6 +451,11 @@ static void asmWord( AsmBCO bco, StgWord i ) insertNonPtrs( &bco->nps, i ); } +static int asmFindInNonPtrs ( AsmBCO bco, StgWord i ) +{ + return findInNonPtrs ( &bco->nps, i ); +} + #define asmWords(bco,ty,x) \ { \ union { ty a; AsmWord b[sizeofW(ty)]; } p; \ @@ -483,12 +473,13 @@ static StgWord repSizeW( AsmRep rep ) case CHAR_REP: return sizeofW(StgWord) + sizeofW(StgChar); case BOOL_REP: - case INT_REP: return sizeofW(StgWord) + sizeofW(StgInt); - case WORD_REP: return sizeofW(StgWord) + sizeofW(StgWord); - case ADDR_REP: return sizeofW(StgWord) + sizeofW(StgAddr); - case FLOAT_REP: return sizeofW(StgWord) + sizeofW(StgFloat); - case DOUBLE_REP: return sizeofW(StgWord) + sizeofW(StgDouble); - case STABLE_REP: return sizeofW(StgWord) + sizeofW(StgWord); + case INT_REP: return sizeofW(StgWord) + sizeofW(StgInt); + case THREADID_REP: + case WORD_REP: return sizeofW(StgWord) + sizeofW(StgWord); + case ADDR_REP: return sizeofW(StgWord) + sizeofW(StgAddr); + case FLOAT_REP: return sizeofW(StgWord) + sizeofW(StgFloat); + case DOUBLE_REP: return sizeofW(StgWord) + sizeofW(StgDouble); + case STABLE_REP: return sizeofW(StgWord) + sizeofW(StgWord); case INTEGER_REP: #ifdef PROVIDE_WEAK @@ -500,6 +491,7 @@ static StgWord repSizeW( AsmRep rep ) case ALPHA_REP: /* a */ case BETA_REP: /* b */ case GAMMA_REP: /* c */ + case DELTA_REP: /* d */ case HANDLER_REP: /* IOError -> IO a */ case ERROR_REP: /* IOError */ case ARR_REP : /* PrimArray a */ @@ -507,10 +499,7 @@ static StgWord repSizeW( AsmRep rep ) case REF_REP : /* Ref s a */ case MUTARR_REP : /* PrimMutableArray s a */ case MUTBARR_REP: /* PrimMutableByteArray s a */ -#ifdef PROVIDE_CONCURRENT - case THREADID_REP: /* ThreadId */ case MVAR_REP: /* MVar a */ -#endif case PTR_REP: return sizeofW(StgPtr); case VOID_REP: return sizeofW(StgWord); @@ -764,6 +753,14 @@ static void emit_i_RETADDR ( AsmBCO bco, int arg1 ) emiti_16(bco,i_RETADDR_big,arg1); } +static void emit_i_ALLOC_CONSTR ( AsmBCO bco, int arg1 ) +{ + ASSERT(arg1 >= 0); + if (arg1 < 256) + emiti_8 (bco,i_ALLOC_CONSTR, arg1); else + emiti_16(bco,i_ALLOC_CONSTR_big,arg1); +} + /* -------------------------------------------------------------------------- * Arg checks. @@ -780,8 +777,6 @@ void asmEndArgCheck ( AsmBCO bco, AsmSp last_arg ) nat args = bco->sp - last_arg; if (args != 0) { /* optimisation */ emiti_8(bco,i_ARG_CHECK,args); - grabHpNonUpd(bco,PAP_sizeW(args-1)); - resetHp(bco,0); } } @@ -811,6 +806,7 @@ void asmVar ( AsmBCO bco, AsmVar v, AsmRep rep ) case INT_REP: emit_i_VAR_INT(bco,offset); break; + case THREADID_REP: case WORD_REP: emit_i_VAR_WORD(bco,offset); break; @@ -840,6 +836,7 @@ void asmVar ( AsmBCO bco, AsmVar v, AsmRep rep ) case ALPHA_REP: /* a */ case BETA_REP: /* b */ case GAMMA_REP: /* c */ + case DELTA_REP: /* d */ case HANDLER_REP: /* IOError -> IO a */ case ERROR_REP: /* IOError */ case ARR_REP : /* PrimArray a */ @@ -847,10 +844,7 @@ void asmVar ( AsmBCO bco, AsmVar v, AsmRep rep ) case REF_REP : /* Ref s a */ case MUTARR_REP : /* PrimMutableArray s a */ case MUTBARR_REP: /* PrimMutableByteArray s a */ -#ifdef PROVIDE_CONCURRENT - case THREADID_REP: /* ThreadId */ case MVAR_REP: /* MVar a */ -#endif case PTR_REP: emit_i_VAR(bco,offset); break; @@ -891,31 +885,25 @@ AsmVar asmBox( AsmBCO bco, AsmRep rep ) switch (rep) { case CHAR_REP: emiti_(bco,i_PACK_CHAR); - grabHpNonUpd(bco,Czh_sizeW); break; case INT_REP: emiti_(bco,i_PACK_INT); - grabHpNonUpd(bco,Izh_sizeW); break; + case THREADID_REP: case WORD_REP: emiti_(bco,i_PACK_WORD); - grabHpNonUpd(bco,Wzh_sizeW); break; case ADDR_REP: emiti_(bco,i_PACK_ADDR); - grabHpNonUpd(bco,Azh_sizeW); break; case FLOAT_REP: emiti_(bco,i_PACK_FLOAT); - grabHpNonUpd(bco,Fzh_sizeW); break; case DOUBLE_REP: emiti_(bco,i_PACK_DOUBLE); - grabHpNonUpd(bco,Dzh_sizeW); break; case STABLE_REP: emiti_(bco,i_PACK_STABLE); - grabHpNonUpd(bco,Stablezh_sizeW); break; default: @@ -937,6 +925,7 @@ AsmVar asmUnbox( AsmBCO bco, AsmRep rep ) case INT_REP: emiti_(bco,i_UNPACK_INT); break; + case THREADID_REP: case WORD_REP: emiti_(bco,i_UNPACK_WORD); break; @@ -1104,18 +1093,23 @@ AsmSp asmBeginPrim( AsmBCO bco ) return bco->sp; } -void asmEndPrim( AsmBCO bco, const AsmPrim* prim, AsmSp base ) +void asmEndPrim( AsmBCO bco, const AsmPrim* prim, AsmSp base ) { emiti_8(bco,prim->prefix,prim->opcode); setSp(bco, base); } +char* asmGetPrimopName ( AsmPrim* p ) +{ + return p->name; +} + /* Hugs used to let you add arbitrary primops with arbitrary types * just by editing Prelude.hs or any other file you wanted. * We deliberately avoided that approach because we wanted more * control over which primops are provided. */ -const AsmPrim asmPrimOps[] = { +AsmPrim asmPrimOps[] = { /* Char# operations */ { "primGtChar", "CC", "B", MONAD_Id, i_PRIMOP1, i_gtChar } @@ -1405,33 +1399,48 @@ const AsmPrim asmPrimOps[] = { #endif #ifdef PROVIDE_CONCURRENT /* Concurrency operations */ - , { "primFork", "a", "T", MONAD_IO, i_PRIMOP2, i_fork } + , { "primForkIO", "a", "T", MONAD_IO, i_PRIMOP2, i_forkIO } , { "primKillThread", "T", "", MONAD_IO, i_PRIMOP2, i_killThread } - , { "primSameMVar", "rr", "B", MONAD_Id, i_PRIMOP2, i_sameMVar } - , { "primNewMVar", "", "r", MONAD_IO, i_PRIMOP2, i_newMVar } - , { "primTakeMVar", "r", "a", MONAD_IO, i_PRIMOP2, i_takeMVar } - , { "primPutMVar", "ra", "", MONAD_IO, i_PRIMOP2, i_putMVar } - , { "primDelay", "I", "", MONAD_IO, i_PRIMOP2, i_delay } + , { "primRaiseInThread", "TE", "", MONAD_IO, i_PRIMOP2, i_raiseInThread } + , { "primWaitRead", "I", "", MONAD_IO, i_PRIMOP2, i_waitRead } , { "primWaitWrite", "I", "", MONAD_IO, i_PRIMOP2, i_waitWrite } + , { "primYield", "", "", MONAD_IO, i_PRIMOP2, i_yield } , { "primDelay", "I", "", MONAD_IO, i_PRIMOP2, i_delay } + , { "primGetThreadId", "", "T", MONAD_IO, i_PRIMOP2, i_getThreadId } + , { "primCmpThreadIds", "TT", "I", MONAD_Id, i_PRIMOP2, i_cmpThreadIds } #endif + , { "primNewEmptyMVar", "", "r", MONAD_IO, i_PRIMOP2, i_newMVar } + /* primTakeMVar is handwritten bytecode */ + , { "primPutMVar", "ra", "", MONAD_IO, i_PRIMOP2, i_putMVar } + , { "primSameMVar", "rr", "B", MONAD_Id, i_PRIMOP2, i_sameMVar } + /* Ccall is polyadic - so it's excluded from this table */ , { 0,0,0,0,0,0 } }; -const AsmPrim ccall_ccall_Id +AsmPrim ccall_ccall_Id = { "ccall", 0, 0, MONAD_IO, i_PRIMOP2, i_ccall_ccall_Id }; -const AsmPrim ccall_ccall_IO +AsmPrim ccall_ccall_IO = { "ccall", 0, 0, MONAD_IO, i_PRIMOP2, i_ccall_ccall_IO }; -const AsmPrim ccall_stdcall_Id +AsmPrim ccall_stdcall_Id = { "ccall", 0, 0, MONAD_IO, i_PRIMOP2, i_ccall_stdcall_Id }; -const AsmPrim ccall_stdcall_IO +AsmPrim ccall_stdcall_IO = { "ccall", 0, 0, MONAD_IO, i_PRIMOP2, i_ccall_stdcall_IO }; +#ifdef DEBUG +void checkBytecodeCount( void ) { + if (MAX_Primop1 >= 255) { + printf("Too many Primop1 bytecodes (%d)\n",MAX_Primop1); + } + if (MAX_Primop2 >= 255) { + printf("Too many Primop2 bytecodes (%d)\n",MAX_Primop2); + } +} +#endif -const AsmPrim* asmFindPrim( char* s ) +AsmPrim* asmFindPrim( char* s ) { int i; for (i=0; asmPrimOps[i].name; ++i) { @@ -1442,7 +1451,7 @@ const AsmPrim* asmFindPrim( char* s ) return 0; } -const AsmPrim* asmFindPrimop( AsmInstr prefix, AsmInstr op ) +AsmPrim* asmFindPrimop( AsmInstr prefix, AsmInstr op ) { nat i; for (i=0; asmPrimOps[i].name; ++i) { @@ -1484,7 +1493,7 @@ AsmBCO asm_BCO_seq ( void ) AsmBCO eval, cont; cont = asmBeginBCO(0 /*NIL*/); - emiti_8(cont,i_ARG_CHECK,2); + emiti_8(cont,i_ARG_CHECK,2); /* should never fail */ emit_i_VAR(cont,1); emit_i_SLIDE(cont,1,2); emiti_(cont,i_ENTER); @@ -1505,17 +1514,67 @@ AsmBCO asm_BCO_seq ( void ) return eval; } +AsmBCO asm_BCO_takeMVar ( void ) +{ + AsmBCO kase, casecont, take; + + take = asmBeginBCO(0 /*NIL*/); + emit_i_VAR(take,0); + emiti_8(take,i_PRIMOP2,i_takeMVar); + emit_i_VAR(take,3); + emit_i_VAR(take,1); + emit_i_VAR(take,4); + emit_i_SLIDE(take,3,4); + emiti_(take,i_ENTER); + incSp(take,20); + asmEndBCO(take); + + casecont = asmBeginBCO(0 /*NIL*/); + emiti_(casecont,i_UNPACK); + emit_i_VAR(casecont,4); + emit_i_VAR(casecont,4); + emit_i_VAR(casecont,2); + emit_i_CONST(casecont,casecont->object.ptrs.len); + asmPtr(casecont,&(take->object)); + emit_i_SLIDE(casecont,4,5); + emiti_(casecont,i_ENTER); + incSp(casecont,20); + asmEndBCO(casecont); + + kase = asmBeginBCO(0 /*NIL*/); + emiti_8(kase,i_ARG_CHECK,3); + emit_i_RETADDR(kase,kase->object.ptrs.len); + asmPtr(kase,&(casecont->object)); + emit_i_VAR(kase,2); + emiti_(kase,i_ENTER); + incSp(kase,20); + asmEndBCO(kase); + + return kase; +} + + /* -------------------------------------------------------------------------- * Heap manipulation * ------------------------------------------------------------------------*/ AsmVar asmAllocCONSTR ( AsmBCO bco, AsmInfo info ) { + int i; ASSERT( sizeW_fromITBL(info) >= MIN_NONUPD_SIZE + sizeofW(StgHeader) ); - emiti_8(bco,i_ALLOC_CONSTR,bco->nps.len); - asmWords(bco,AsmInfo,info); + + /* Look in this bco's collection of nonpointers (literals) + to see if the itbl pointer is already there. If so, re-use it. */ + i = asmFindInNonPtrs ( bco, (StgWord)info ); + + if (i == -1) { + emit_i_ALLOC_CONSTR(bco,bco->nps.len); + asmWords(bco,AsmInfo,info); + } else { + emit_i_ALLOC_CONSTR(bco,i); + } + incSp(bco, sizeofW(StgClosurePtr)); - grabHpNonUpd(bco,sizeW_fromITBL(info)); return bco->sp; } @@ -1549,7 +1608,6 @@ AsmVar asmAllocAP( AsmBCO bco, AsmNat words ) { emiti_8(bco,i_ALLOC_AP,words); incSp(bco, sizeofW(StgPtr)); - grabHpUpd(bco,AP_sizeW(words)); return bco->sp; }