From 730e2dd8168e27c0aa98a9556df2802b8e92aa7c Mon Sep 17 00:00:00 2001 From: sewardj Date: Fri, 12 Jan 2001 12:06:24 +0000 Subject: [PATCH] [project @ 2001-01-12 12:06:24 by sewardj] Latest bug fixes. --- ghc/rts/Interpreter.c | 72 ++++++++++++++++++++++++++++++++++++------------- 1 file changed, 54 insertions(+), 18 deletions(-) diff --git a/ghc/rts/Interpreter.c b/ghc/rts/Interpreter.c index 83009b9..fb474ea 100644 --- a/ghc/rts/Interpreter.c +++ b/ghc/rts/Interpreter.c @@ -5,8 +5,8 @@ * Copyright (c) 1994-2000. * * $RCSfile: Interpreter.c,v $ - * $Revision: 1.10 $ - * $Date: 2001/01/10 17:21:18 $ + * $Revision: 1.11 $ + * $Date: 2001/01/12 12:06:24 $ * ---------------------------------------------------------------------------*/ #ifdef GHCI @@ -49,6 +49,25 @@ SAVE_STACK_POINTERS; return retcode; +static __inline__ StgPtr allocate_UPD ( int n_words ) +{ + //fprintf(stderr, "alloc_UPD %d -> ", n_words ); + if (n_words - sizeofW(StgHeader) < MIN_UPD_SIZE) + n_words = MIN_UPD_SIZE + sizeofW(StgHeader); + //fprintf(stderr, "%d\n", n_words ); + return allocate(n_words); +} + +static __inline__ StgPtr allocate_NONUPD ( int n_words ) +{ + //fprintf(stderr, "alloc_NONUPD %d -> ", n_words ); + if (n_words - sizeofW(StgHeader) < MIN_NONUPD_SIZE) + n_words = MIN_NONUPD_SIZE + sizeofW(StgHeader); + //fprintf(stderr, "%d\n", n_words ); + return allocate(n_words); +} + + StgThreadReturnCode interpretBCO ( Capability* cap ) { /* On entry, the closure to interpret is on the top of the @@ -154,16 +173,16 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) //} do_print_stack = 1; fprintf(stderr,"iSp = %p iSu = %p pc = %d ", iSp, iSu, bciPtr); - disInstr(bco,bciPtr); - if (0) { int i; - fprintf(stderr,"\n"); - for (i = 8; i >= 0; i--) - fprintf(stderr, "%d %p\n", i, (StgPtr)(*(iSp+i))); - fprintf(stderr,"\n"); - } - ); + disInstr(bco,bciPtr); + if (0) { int i; + fprintf(stderr,"\n"); + for (i = 8; i >= 0; i--) + fprintf(stderr, "%d %p\n", i, (StgPtr)(*(iSp+i))); + fprintf(stderr,"\n"); + } + //if (do_print_stack) checkStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu); + ); - // checkStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu); switch (BCO_NEXT) { @@ -176,7 +195,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) /* Handle arg check failure. Copy the spare args into a PAP frame. */ /* fprintf(stderr, "arg check fail %d %d\n", arg_words_reqd, arg_words_avail ); */ - pap = (StgPAP*)allocate(PAP_sizeW(arg_words_avail)); + pap = (StgPAP*)allocate_UPD(PAP_sizeW(arg_words_avail)); SET_HDR(pap,&stg_PAP_info,CCS_SYSTEM/*ToDo*/); pap->n_args = arg_words_avail; pap->fun = obj; @@ -186,6 +205,10 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) iSp = (StgPtr)iSu; iSp --; StackWord(0) = (W_)pap; + IF_DEBUG(evaluator, + fprintf(stderr,"\tBuilt "); + printObj((StgClosure*)pap); + ); RETURN(ThreadEnterGHC); } case bci_PUSH_L: { @@ -256,8 +279,10 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) goto nextInsn; } case bci_ALLOC: { + StgAP_UPD* ap; int n_payload = BCO_NEXT - 1; - StgAP_UPD* ap = (StgAP_UPD*)allocate(AP_sizeW(n_payload)); + int request = AP_sizeW(n_payload); + ap = (StgAP_UPD*)allocate_UPD(request); StackWord(-1) = (W_)ap; ap->n_args = n_payload; SET_HDR(ap, &stg_AP_UPD_info, ??) @@ -274,6 +299,10 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) for (i = 0; i < n_payload; i++) ap->payload[i] = (StgClosure*)StackWord(i+1); iSp += n_payload+1; + IF_DEBUG(evaluator, + fprintf(stderr,"\tBuilt "); + printObj((StgClosure*)ap); + ); goto nextInsn; } case bci_UNPACK: { @@ -308,16 +337,23 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) int i; int o_itbl = BCO_NEXT; int n_words = BCO_NEXT; - StgInfoTable* itbl = BCO_ITBL(o_itbl); - /* A bit of a kludge since n_words = n_p + n_np */ - int request = CONSTR_sizeW( n_words, 0 ); - StgClosure* con = (StgClosure*)allocate(request); - SET_HDR(con, itbl, CCS_SYSTEM/*ToDo*/); + StgInfoTable* itbl = INFO_PTR_TO_STRUCT(BCO_ITBL(o_itbl)); + int request = CONSTR_sizeW( itbl->layout.payload.ptrs, + itbl->layout.payload.nptrs ); + StgClosure* con = (StgClosure*)allocate_NONUPD(request); + //fprintf(stderr, "---PACK p %d, np %d\n", + // (int) itbl->layout.payload.ptrs, + // (int) itbl->layout.payload.nptrs ); + SET_HDR(con, BCO_ITBL(o_itbl), CCS_SYSTEM/*ToDo*/); for (i = 0; i < n_words; i++) con->payload[i] = (StgClosure*)StackWord(i); iSp += n_words; iSp --; StackWord(0) = (W_)con; + IF_DEBUG(evaluator, + fprintf(stderr,"\tBuilt "); + printObj((StgClosure*)con); + ); goto nextInsn; } case bci_TESTLT_P: { -- 1.7.10.4