From 22bc4dd169cc1e4d22bf8bcacebb95dc621ef808 Mon Sep 17 00:00:00 2001 From: sewardj Date: Wed, 10 May 2000 09:00:20 +0000 Subject: [PATCH 1/1] [project @ 2000-05-10 09:00:20 by sewardj] Zap CRUDE_PROFILING. It was there mainly to test assess the effect of the simplifier; is redundant. --- ghc/includes/options.h | 10 +-- ghc/interpreter/codegen.c | 60 +-------------- ghc/interpreter/compiler.c | 13 +--- ghc/interpreter/connect.h | 18 +---- ghc/interpreter/hugs.c | 16 +--- ghc/rts/Assembler.c | 12 +-- ghc/rts/Evaluator.c | 177 +------------------------------------------- 7 files changed, 17 insertions(+), 289 deletions(-) diff --git a/ghc/includes/options.h b/ghc/includes/options.h index 916e84e..7993101 100644 --- a/ghc/includes/options.h +++ b/ghc/includes/options.h @@ -7,8 +7,8 @@ * Hugs version 1.4, December 1997 * * $RCSfile: options.h,v $ - * $Revision: 1.28 $ - * $Date: 2000/05/09 09:26:29 $ + * $Revision: 1.29 $ + * $Date: 2000/05/10 09:00:20 $ * ------------------------------------------------------------------------*/ @@ -134,12 +134,6 @@ #define PROVIDE_PTREQUALITY 1 #define PROVIDE_CONCURRENT 1 -/* Enable a crude profiler which counts BCO entries, bytes allocated - and bytecode insns executed on a per-fn basis. Used for assessing - the effect of the simplifier/optimiser. -*/ -#undef CRUDE_PROFILING - /* Turn bytecode interpreter support on/off. */ #define INTERPRETER 1 diff --git a/ghc/interpreter/codegen.c b/ghc/interpreter/codegen.c index 31a09a8..83985cd 100644 --- a/ghc/interpreter/codegen.c +++ b/ghc/interpreter/codegen.c @@ -9,8 +9,8 @@ * included in the distribution. * * $RCSfile: codegen.c,v $ - * $Revision: 1.23 $ - * $Date: 2000/04/27 16:35:29 $ + * $Revision: 1.24 $ + * $Date: 2000/05/10 09:00:20 $ * ------------------------------------------------------------------------*/ #include "hugsbasictypes.h" @@ -111,14 +111,10 @@ Still to do: * Profile and accelerate. Code generation is slower because linking is slower. Evaluation GC is slower because markHugsObjects has - sloweed down. + slowed down. * Make setCurrentModule ignore name table entries created by the lambda-lifter. - -* Zap various #if 0 in codegen.c/Assembler.c. - -* Zap CRUDE_PROFILING. */ @@ -206,23 +202,6 @@ static void cgAddPtrToObject ( AsmObject obj, Cell ptrish ) } } -#if 0 -static void cgPushRef ( AsmBCO bco, Cell c ) -{ - switch (whatIs(c)) { - case CPTRCELL: - asmPushRefNoOp(bco,(StgPtr)cptrOf(c)); break; - case PTRCELL: - asmPushRefObject(bco,ptrOf(c)); break; - case NAME: - case TUPLE: - asmPushRefHugs(bco,c); break; - default: - internal("cgPushRef"); - } -} -#endif - /* Get a pointer to atom e onto the stack. */ static Void pushAtom ( AsmBCO bco, StgAtom e ) { @@ -314,11 +293,7 @@ static Void pushAtom ( AsmBCO bco, StgAtom e ) static AsmBCO cgAlts( AsmSp root, AsmSp sp, List alts ) { -#ifdef CRUDE_PROFILING - AsmBCO bco = asmBeginContinuation(sp, currentTop + 1000000000); -#else AsmBCO bco = asmBeginContinuation(sp, alts); -#endif Bool omit_test = length(alts) == 2 && isDefaultAlt(hd(tl(alts))) && @@ -650,31 +625,6 @@ static Void build( AsmBCO bco, StgVar v ) } else internal("build: STGAPP"); -#if 0 -Looks like a hack to me. - if (isName(fun)) { - if (nonNull(name(fun).closure)) - fun = name(fun).closure; else - fun = cptrFromName(fun); - } - - if (isCPtr(fun)) { - assert(isName(fun0)); - itsaPAP = name(fun0).arity > length(args); -# if DEBUG_CODEGEN - fprintf ( stderr, "nativeCall: name %s, arity %d, args %d\n", - nameFromOPtr(cptrOf(fun)), name(fun0).arity, - length(args) ); -# endif - } else { - itsaPAP = FALSE; - if (nonNull(stgVarBody(fun)) - && whatIs(stgVarBody(fun)) == LAMBDA - && length(stgLambdaArgs(stgVarBody(fun))) > length(args) - ) - itsaPAP = TRUE; - } -#endif if (itsaPAP) { AsmSp start = asmBeginMkPAP(bco); @@ -740,11 +690,7 @@ static void beginTop( StgVar v ) setObj(v,asmBeginCon(stgConInfo(stgConCon(rhs)))); break; case LAMBDA: -# ifdef CRUDE_PROFILING - setObj(v,asmBeginBCO(currentTop)); -# else setObj(v,asmBeginBCO(rhs)); -# endif break; default: setObj(v,asmBeginCAF()); diff --git a/ghc/interpreter/compiler.c b/ghc/interpreter/compiler.c index 00d7679..f536ae2 100644 --- a/ghc/interpreter/compiler.c +++ b/ghc/interpreter/compiler.c @@ -11,8 +11,8 @@ * included in the distribution. * * $RCSfile: compiler.c,v $ - * $Revision: 1.30 $ - * $Date: 2000/04/27 16:35:29 $ + * $Revision: 1.31 $ + * $Date: 2000/05/10 09:00:20 $ * ------------------------------------------------------------------------*/ #include "hugsbasictypes.h" @@ -1484,11 +1484,6 @@ Void evalExp ( void ) /* compile and run input expression */ This all also seems to imply that doRevertCAFs should always be TRUE. */ - -# ifdef CRUDE_PROFILING - cp_init(); -# endif - { HaskellObj result; /* ignored */ SchedulerStatus status; @@ -1537,10 +1532,6 @@ Void evalExp ( void ) /* compile and run input expression */ fflush(stdout); fflush(stderr); } -# ifdef CRUDE_PROFILING - cp_show(); -# endif - } diff --git a/ghc/interpreter/connect.h b/ghc/interpreter/connect.h index 127a236..430e130 100644 --- a/ghc/interpreter/connect.h +++ b/ghc/interpreter/connect.h @@ -9,8 +9,8 @@ * included in the distribution. * * $RCSfile: connect.h,v $ - * $Revision: 1.40 $ - * $Date: 2000/04/27 16:35:29 $ + * $Revision: 1.41 $ + * $Date: 2000/05/10 09:00:20 $ * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- @@ -526,20 +526,6 @@ extern FILE *outputStream; /* current output stream */ extern Int outColumn; /* current output column number */ - -/*--------------------------------------------------------------------------- - * Crude profiling (probably doesn't work) - *-------------------------------------------------------------------------*/ - -#ifdef CRUDE_PROFILING -extern void cp_init ( void ); -extern void cp_enter ( Cell /*StgVar*/ ); -extern void cp_bill_words ( int ); -extern void cp_bill_insns ( int ); -extern void cp_show ( void ); -#endif - - /*--------------------------------------------------------------------------- * For dynamic.c and general object-related stuff *-------------------------------------------------------------------------*/ diff --git a/ghc/interpreter/hugs.c b/ghc/interpreter/hugs.c index 2cef783..79a335c 100644 --- a/ghc/interpreter/hugs.c +++ b/ghc/interpreter/hugs.c @@ -9,8 +9,8 @@ * included in the distribution. * * $RCSfile: hugs.c,v $ - * $Revision: 1.69 $ - * $Date: 2000/04/27 16:35:29 $ + * $Revision: 1.70 $ + * $Date: 2000/05/10 09:00:20 $ * ------------------------------------------------------------------------*/ #include @@ -569,8 +569,8 @@ static struct cmd cmds[] = { {":reload", RELOAD}, {":gc", COLLECT}, {":edit", EDIT}, {":quit", QUIT}, {":set", SET}, {":find", FIND}, {":names", NAMES}, {":info", INFO}, {":project", PROJECT}, - {":dump", DUMP}, {":ztats", STATS}, - {":module",SETMODULE}, + {":dump", DUMP}, + {":module", SETMODULE}, {":browse", BROWSE}, #if EXPLAIN_INSTANCE_RESOLUTION {":xplain", XPLAIN}, @@ -608,9 +608,6 @@ static Void local menu() { Printf(":gc force garbage collection\n"); Printf(":version print Hugs version\n"); Printf(":dump print STG code for named fn\n"); -#ifdef CRUDE_PROFILING - Printf(":ztats print reduction stats\n"); -#endif Printf(":quit exit Hugs interpreter\n"); } @@ -2449,11 +2446,6 @@ String argv[]; { break; case SET : set(); break; - case STATS: -#ifdef CRUDE_PROFILING - cp_show(); -#endif - break; case SYSTEM : if (shellEsc(readLine())) Printf("Warning: Shell escape terminated abnormally\n"); break; diff --git a/ghc/rts/Assembler.c b/ghc/rts/Assembler.c index 76878e9..fa0984a 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.28 $ - * $Date: 2000/05/09 10:00:35 $ + * $Revision: 1.29 $ + * $Date: 2000/05/10 09:00:20 $ * * This module provides functions to construct BCOs and other closures * required by the bytecode compiler. @@ -368,14 +368,6 @@ void asmCopyAndLink ( void ) } -#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 * ------------------------------------------------------------------------*/ diff --git a/ghc/rts/Evaluator.c b/ghc/rts/Evaluator.c index 7043e27..566666f 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.51 $ - * $Date: 2000/05/09 10:00:36 $ + * $Revision: 1.52 $ + * $Date: 2000/05/10 09:00:20 $ * ---------------------------------------------------------------------------*/ #include "Rts.h" @@ -74,164 +74,6 @@ extern void* /* StgClosure* */ getHugs_BCO_cptr_for ( char* s ); extern int /* Bool */ combined; -/* -------------------------------------------------------------------------- - * Crude profiling stuff (mainly to assess effect of optimiser) - * ------------------------------------------------------------------------*/ - -#ifdef CRUDE_PROFILING - -#define M_CPTAB 10000 -#define CP_NIL (-1) - -int cpInUse = -1; -int cpCurr; - -typedef - struct { int /*StgVar*/ who; - int /*StgVar*/ twho; - int enters; - int bytes; - int insns; - } - CPRecord; - -CPRecord cpTab[M_CPTAB]; - -void cp_init ( void ) -{ - int i; - cpCurr = CP_NIL; - cpInUse = 0; - for (i = 0; i < M_CPTAB; i++) - cpTab[i].who = CP_NIL; -} - - - -void cp_enter ( StgBCO* b ) -{ - int is_ret_cont; - int h; - int /*StgVar*/ v = b->stgexpr; - if ((void*)v == NULL) return; - - is_ret_cont = 0; - if (v > 500000000) { - is_ret_cont = 1; - v -= 1000000000; - } - - if (v < 0) - h = (-v) % M_CPTAB; else - h = v % M_CPTAB; - - assert (h >= 0 && h < M_CPTAB); - while (cpTab[h].who != v && cpTab[h].who != CP_NIL) { - h++; if (h == M_CPTAB) h = 0; - }; - cpCurr = h; - if (cpTab[cpCurr].who == CP_NIL) { - cpTab[cpCurr].who = v; - if (!is_ret_cont) cpTab[cpCurr].enters = 1; - cpTab[cpCurr].bytes = cpTab[cpCurr].insns = 0; - cpInUse++; - if (cpInUse * 2 > M_CPTAB) { - fprintf(stderr, "\nCRUDE_PROFILING hash table is too full\n" ); - assert(0); - } - } else { - if (!is_ret_cont) cpTab[cpCurr].enters++; - } - - -} - -void cp_bill_words ( int nw ) -{ - if (cpCurr == CP_NIL) return; - cpTab[cpCurr].bytes += sizeof(StgWord)*nw; -} - - -void cp_bill_insns ( int ni ) -{ - if (cpCurr == CP_NIL) return; - cpTab[cpCurr].insns += ni; -} - - -static double percent ( double a, double b ) -{ - return (100.0 * a) / b; -} - - -void cp_show ( void ) -{ - int i, j, max, maxN, totE, totB, totI, cumE, cumB, cumI; - char nm[200]; - - if (cpInUse == -1) return; - - fflush(stdout);fflush(stderr); - printf ( "\n\n" ); - - totE = totB = totI = 0; - for (i = 0; i < M_CPTAB; i++) { - cpTab[i].twho = cpTab[i].who; - if (cpTab[i].who != CP_NIL) { - totE += cpTab[i].enters; - totB += cpTab[i].bytes; - totI += cpTab[i].insns; - } - } - - printf ( "Totals: " - "%6d (%7.3f M) enters, " - "%6d (%7.3f M) insns, " - "%6d (%7.3f M) bytes\n\n", - totE, totE/1000000.0, totI, totI/1000000.0, totB, totB/1000000.0 ); - - cumE = cumB = cumI = 0; - for (j = 0; j < 32; j++) { - - maxN = max = -1; - for (i = 0; i < M_CPTAB; i++) - if (cpTab[i].who != CP_NIL && - cpTab[i].enters > maxN) { - maxN = cpTab[i].enters; - max = i; - } - if (max == -1) break; - - cumE += cpTab[max].enters; - cumB += cpTab[max].bytes; - cumI += cpTab[max].insns; - - strcpy(nm, maybeName(cpTab[max].who)); - if (strcmp(nm, "(unknown)")==0) - sprintf ( nm, "id%d", -cpTab[max].who); - - printf ( "%20s %7d es (%4.1f%%, %4.1f%% c) " - "%7d bs (%4.1f%%, %4.1f%% c) " - "%7d is (%4.1f%%, %4.1f%% c)\n", - nm, - cpTab[max].enters, percent(cpTab[max].enters,totE), percent(cumE,totE), - cpTab[max].bytes, percent(cpTab[max].bytes,totB), percent(cumB,totB), - cpTab[max].insns, percent(cpTab[max].insns,totI), percent(cumI,totI) - ); - - cpTab[max].twho = cpTab[max].who; - cpTab[max].who = CP_NIL; - } - - for (i = 0; i < M_CPTAB; i++) - cpTab[i].who = cpTab[i].twho; - - printf ( "\n" ); -} - -#endif /* -------------------------------------------------------------------------- @@ -590,11 +432,6 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 ) RETURN(HeapOverflow); } -# if CRUDE_PROFILING - cp_enter ( bco ); -# endif - - bciPtr = &(bcoInstr(bco,0)); LoopTopLabel @@ -613,10 +450,6 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 ) LLL; ); -# if CRUDE_PROFILING - SSS; cp_bill_insns(1); LLL; -# endif - Dispatch Case(i_INTERNAL_ERROR): @@ -1691,18 +1524,12 @@ static inline StgStablePtr taggedStackStable ( StgStackOffset i ) static inline StgPtr grabHpUpd( nat size ) { ASSERT( size >= MIN_UPD_SIZE + sizeofW(StgHeader) ); -#ifdef CRUDE_PROFILING - cp_bill_words ( size ); -#endif return allocate(size); } static inline StgPtr grabHpNonUpd( nat size ) { ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) ); -#ifdef CRUDE_PROFILING - cp_bill_words ( size ); -#endif return allocate(size); } -- 1.7.10.4