From 47a40c89ca2e588b62d986a58907e178bce1de4f Mon Sep 17 00:00:00 2001 From: sewardj Date: Tue, 6 Jul 1999 16:40:28 +0000 Subject: [PATCH] [project @ 1999-07-06 16:40:22 by sewardj] Assembler/Disassembler: handle and print calls to compiled code Evaluator: return to scheduler when entering unknown closure StgCRun: debugging trace in miniinterpreter (temporary) Updates: fix normal and vectored returns to Hugs --- ghc/rts/Assembler.c | 14 ++++++++++++-- ghc/rts/Disassembler.c | 8 ++++---- ghc/rts/Evaluator.c | 36 +++++++++++++++++++++------------- ghc/rts/StgCRun.c | 46 ++++++++++++++++++++++++++++++++++++++++++-- ghc/rts/StgMiscClosures.hc | 8 +++----- ghc/rts/Updates.hc | 28 +++++++++++++++++++++++++-- 6 files changed, 112 insertions(+), 28 deletions(-) diff --git a/ghc/rts/Assembler.c b/ghc/rts/Assembler.c index c959e3f..738b891 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.8 $ - * $Date: 1999/04/27 10:07:15 $ + * $Revision: 1.9 $ + * $Date: 1999/07/06 16:40:22 $ * * This module provides functions to construct BCOs and other closures * required by the bytecode compiler. @@ -1554,6 +1554,16 @@ AsmVar asmClosure( AsmBCO bco, AsmObject p ) return bco->sp; } +AsmVar asmGHCClosure( AsmBCO bco, AsmObject p ) +{ + // A complete hack. Pushes the address as a tagged int + // and then uses SLIDE to get rid of the tag. Appalling. + asmConstInt(bco, (AsmInt)p); + emit_i_SLIDE(bco,0,1); bco->sp -= 1; + return bco->sp; +} + + /* -------------------------------------------------------------------------- * Building InfoTables * ------------------------------------------------------------------------*/ diff --git a/ghc/rts/Disassembler.c b/ghc/rts/Disassembler.c index 9cd5054..0cfc6b7 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.6 $ - * $Date: 1999/04/27 10:07:19 $ + * $Revision: 1.7 $ + * $Date: 1999/07/06 16:40:24 $ * ---------------------------------------------------------------------------*/ #include "Rts.h" @@ -120,14 +120,14 @@ static InstrPtr disConstPtr16 ( StgBCO *bco, InstrPtr pc, char* i ) static InstrPtr disConstInt ( StgBCO *bco, InstrPtr pc, char* i ) { StgInt x = bcoConstInt(bco,bcoInstr(bco,pc++)); - fprintf(stderr,"%s %d",i,x); + fprintf(stderr,"%s %d (0x%x)",i,x,x); return pc; } static InstrPtr disConstInt16 ( StgBCO *bco, InstrPtr pc, char* i ) { StgInt x = bcoConstInt(bco,bcoInstr16(bco,pc)); pc += 2; - fprintf(stderr,"%s %d",i,x); + fprintf(stderr,"%s %d (0x%x)",i,x,x); return pc; } diff --git a/ghc/rts/Evaluator.c b/ghc/rts/Evaluator.c index 66f4a89..f7c8147 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.16 $ - * $Date: 1999/05/11 16:47:50 $ + * $Revision: 1.17 $ + * $Date: 1999/07/06 16:40:24 $ * ---------------------------------------------------------------------------*/ #include "Rts.h" @@ -473,7 +473,11 @@ StgThreadReturnCode enter( StgClosure* obj0 ) ); #endif - if (++eCount == 0) { + if ( +#ifdef DEBUG + 1 || +#endif + ++eCount == 0) { if (context_switch) { xPushCPtr(obj); /* code to restart with */ RETURN(ThreadYielding); @@ -532,7 +536,7 @@ StgThreadReturnCode enter( StgClosure* obj0 ) fprintf(stderr,"Sp = %p\tSu = %p\tpc = %d\t", xSp, xSu, PC); SSS; disInstr(bco,PC); - { int i; + if (0) { int i; fprintf(stderr,"\n"); for (i = 8; i >= 0; i--) fprintf(stderr, "%d %p\n", i, (StgPtr)(*(Sp+i))); @@ -813,6 +817,11 @@ StgThreadReturnCode enter( StgClosure* obj0 ) ASSERT( itbl->type == CONSTR || itbl->type == CONSTR_STATIC || itbl->type == CONSTR_NOCAF_STATIC + || itbl->type == CONSTR_1_0 + || itbl->type == CONSTR_0_1 + || itbl->type == CONSTR_2_0 + || itbl->type == CONSTR_1_1 + || itbl->type == CONSTR_0_2 ); while (--i>=0) { xPushCPtr(payloadCPtr(o,i)); @@ -1341,6 +1350,11 @@ StgThreadReturnCode enter( StgClosure* obj0 ) goto enterLoop; } case CONSTR: + case CONSTR_1_0: + case CONSTR_0_1: + case CONSTR_2_0: + case CONSTR_1_1: + case CONSTR_0_2: case CONSTR_INTLIKE: case CONSTR_CHARLIKE: case CONSTR_STATIC: @@ -1400,15 +1414,11 @@ StgThreadReturnCode enter( StgClosure* obj0 ) } default: { - SSS; - fprintf(stderr, "enterCountI = %d\n", enterCountI); - fprintf(stderr, "panic: enter: entered unknown closure\n"); - printObj(obj); - fprintf(stderr, "what it points at is\n"); - printObj( ((StgEvacuated*)obj) ->evacuee); - LLL; - exit(1); - /* formerly ... */ + //SSS; + //fprintf(stderr, "enterCountI = %d\n", enterCountI); + //fprintf(stderr, "entering unknown closure -- yielding to sched\n"); + //printObj(obj); + //LLL; CurrentTSO->whatNext = ThreadEnterGHC; xPushCPtr(obj); /* code to restart with */ RETURN(ThreadYielding); diff --git a/ghc/rts/StgCRun.c b/ghc/rts/StgCRun.c index 91e464c..016275e 100644 --- a/ghc/rts/StgCRun.c +++ b/ghc/rts/StgCRun.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: StgCRun.c,v 1.5 1999/03/11 11:21:47 simonm Exp $ + * $Id: StgCRun.c,v 1.6 1999/07/06 16:40:27 sewardj Exp $ * * (c) The GHC Team, 1998-1999 * @@ -38,6 +38,8 @@ static jmp_buf jmp_environment; +#if 0 + extern StgThreadReturnCode StgRun(StgFunPtr f) { jmp_buf save_buf; @@ -45,7 +47,7 @@ extern StgThreadReturnCode StgRun(StgFunPtr f) memcpy((void *) jmp_environment, (void *) save_buf, sizeof(jmp_buf)); if (setjmp(jmp_environment) == 0) { while ( 1 ) { - IF_DEBUG(evaluator, + IF_DEBUG(evaluator, fprintf(stderr,"Jumping to "); printPtr((P_)f); fprintf(stderr,"\n"); @@ -64,6 +66,46 @@ EXTFUN(StgReturn) longjmp(jmp_environment, 1); } +#else + +extern StgThreadReturnCode StgRun(StgFunPtr f) +{ + char* nm; + while ( f ) { + +#if 0 + //IF_DEBUG(evaluator, + fprintf(stderr,"Jumping to "); + nm = nameOfObjSym ( f ); + if (nm) + fprintf(stderr, "%s (%p)", nm, f); else + printPtr((P_)f); + fprintf(stderr,"\n"); + // ); +if (0&& MainRegTable.rSp) { + int i; + StgWord* p = MainRegTable.rSp; +fprintf(stderr, "SP = %p\n", p); + p += (8-1); + for (i = 0; i < 8; i++, p--) + fprintf (stderr, "-- %p: %p\n", p, *p ); +} +#endif + + f = (StgFunPtr) (f)(); + } + + return (StgThreadReturnCode)R1.i; +} + +EXTFUN(StgReturn) +{ + return 0; +} +#endif + + + #else /* !USE_MINIINTERPRETER */ #ifdef LEADING_UNDERSCORE diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc index ad32cd0..10d8cd0 100644 --- a/ghc/rts/StgMiscClosures.hc +++ b/ghc/rts/StgMiscClosures.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: StgMiscClosures.hc,v 1.25 1999/06/08 10:26:39 simonmar Exp $ + * $Id: StgMiscClosures.hc,v 1.26 1999/07/06 16:40:27 sewardj Exp $ * * (c) The GHC Team, 1998-1999 * @@ -501,10 +501,8 @@ SET_STATIC_HDR(forceIO_closure,forceIO_info,CCS_DONTZuCARE,,EI_) STGFUN(Hugs_CONSTR_entry) { - Sp -= 1; - ((StgPtr*)Sp)[0] = R1.p; - /* vectored: JMP_(RET_VEC(((StgPtr*)Sp)[1],constrTag(?))); */ - JMP_(ENTRY_CODE(((StgPtr*)Sp)[1])); + /* R1 points at the constructor */ + JMP_(ENTRY_CODE(((StgPtr*)Sp)[0])); } #define RET_BCO_ENTRY_TEMPLATE(label) \ diff --git a/ghc/rts/Updates.hc b/ghc/rts/Updates.hc index e9ac61f..5c64e4d 100644 --- a/ghc/rts/Updates.hc +++ b/ghc/rts/Updates.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Updates.hc,v 1.17 1999/05/13 17:31:14 simonm Exp $ + * $Id: Updates.hc,v 1.18 1999/07/06 16:40:28 sewardj Exp $ * * (c) The GHC Team, 1998-1999 * @@ -70,7 +70,31 @@ FE_ \ } -UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_entry,ENTRY_CODE(Sp[0])); +//UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_entry,ENTRY_CODE(Sp[0])); + STGFUN(Upd_frame_entry); + STGFUN(Upd_frame_entry) + { + StgClosure *updatee; + FB_ + /* tick - ToDo: check this is right */ + TICK_UPD_EXISTING(); + + updatee = ((StgUpdateFrame *)Sp)->updatee; + + /* update the updatee with an indirection to the return value */ + UPD_IND(updatee,R1.p); + + /* reset Su to the next update frame */ + Su = ((StgUpdateFrame *)Sp)->link; + + /* remove the update frame from the stack */ + Sp += sizeofW(StgUpdateFrame); + + JMP_(ENTRY_CODE(Sp[0])); + FE_ + } + + UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_0_entry,RET_VEC(Sp[0],0)); UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_1_entry,RET_VEC(Sp[0],1)); UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_2_entry,RET_VEC(Sp[0],2)); -- 1.7.10.4