#include #include #include #include #include #include #include #include "comp.h" #include "node.h" #include "mutlib.h" #include "initend.h" #include "stableptr.h" #include "profile.h" /* #include "runtime.h" -- already included in node.h */ #define ARGSIZE 200 /* Obsolete? Used to limit number of cmdline args. */ /* flags */ #if INSCOUNT int insCount; #endif int bellGc; int gcStatics; int dumpStack; timer gcTime,totalTime,runTime; extern int hpSize, spSize; /****/ #define NO_UNIT 0 #define SIZE_UNIT 1 #define TIME_UNIT 2 #define assign(var,exp) (var>exp ? var : (var=exp)) double numArg(int unit, char *s) { double prefix = 1; double i = 0; while(isdigit(*s)) { /* i = i*10 + *s++ - '0'; */ assign(i,i*10 + *s - '0'); s++; } if(*s=='.') { double pos = 0.1; while(isdigit(*++s)) { i = i + (double)(*s - '0')*pos; pos /= 10.0; } } switch(*s) { case 'k': case 'K': prefix *= 1000; s++; break; case 'm': prefix *= -1000000; s++; break; /* ugly hack to distinguis milli from Mega if followed by s */ case 'M': prefix *= 1000000; s++; break; } if(TIME_UNIT & unit && *s == 's') { s++; if(prefix < 0 ) prefix = 0.001; i = -i*prefix; } else if (SIZE_UNIT & unit) { if(prefix<0) prefix = -prefix; switch(*s) { case 'b': case 'B': s++; assign(i,i*prefix)/sizeof(Node); break; case 'w': case 'W': s++; assign(i,i*prefix); break; default: assign(i,i*prefix)/sizeof(Node); break; } } if(*s) fprintf(stderr,"Ignoring extra character(s) '%s' at end of number\n",s); return i; } #ifdef PROFILE void getMaxSet(char *maxs) { extern int maxSet; if(*maxs) maxSet = atoi(maxs); else maxSet = 1; } #endif int exit_code=0; #if defined(__CYGWIN32__) || defined(__MINGW32__) jmp_buf exit_mutator; #else sigjmp_buf exit_mutator; #endif char **Argv; int Argc; void haskellInit (int argc, char **argv) { int i; #if 0 if(argc>=ARGSIZE) { fprintf(stderr,"Sorry temporary limit of max %d arguments\n",ARGSIZE); exit(-1); } #endif /*Argv = (char **)malloc(ARGSIZE*sizeof(char *));*/ Argv = (char **)malloc((argc+1)*sizeof(char *)); if(!Argv) { fprintf(stderr,"Out of memory when reserving space for %d arguments\n",argc); exit(-1); } Argv[0] = argv[0]; for(Argc = i = 1; i < argc; i++) { if (!strcmp(argv[i],"+RTS")) { i++; for(; i < argc; i++) { if(!strcmp(argv[i],"-RTS")) { break; } else if(argv[i][0] != '-') { fprintf(stderr,"Warning: unknown runtime argument %s ignored.\n",argv[i]); } else { switch(argv[i][1]) { case 's': gcStatics ++; break; case 'B': bellGc ++; break; case 'H': if(argv[i][2]) hpSize = (Int)numArg(SIZE_UNIT,&argv[i][2]); break; case 'V': case 'K': if(argv[i][2]) spSize = (Int)numArg(SIZE_UNIT,&argv[i][2]); break; #if defined(PROFILE) || defined(TPROF) case 'i': if(argv[i][2]) profileInterval = numArg(SIZE_UNIT|TIME_UNIT,&argv[i][2]); else { fprintf(stderr, "-i must be followed by number of words or time in seconds between profile sample!\n"); exit(-1); } if(profileInterval < 0) { profileInterval = -profileInterval; timeSample = 1; } else timeSample = 0; break; #endif #if PROFILE case 'p': if(!profile) {profile = PROFILE_PRODUCER; WHEN_DYNAMIC(getMaxSet(&argv[i][2]);)} else if(argv[i][2]) addRestrictions(&argv[i][2],PROFILE_PRODUCER); break; case 'c': if(!profile) {profile = PROFILE_CONSTRUCTOR; WHEN_DYNAMIC(getMaxSet(&argv[i][2]);)} else if(argv[i][2]) addRestrictions(&argv[i][2],PROFILE_CONSTRUCTOR); break; case 'm': if(!profile) {profile = PROFILE_MODULE; WHEN_DYNAMIC(getMaxSet(&argv[i][2]);)} else if(argv[i][2]) addRestrictions(&argv[i][2],PROFILE_MODULE); break; case 'r': if(!profile) {profile = PROFILE_RETAINER; getMaxSet(&argv[i][2]);} else if(argv[i][2]) addRestrictions(&argv[i][2],PROFILE_RETAINER); break; case 'b': if(!profile){profile = PROFILE_BIOGRAPHY; getMaxSet(&argv[i][2]);} else addRestrictions(&argv[i][2],PROFILE_BIOGRAPHY); break; case 'l': if(!profile){profile = PROFILE_LIFETIME; getMaxSet(&argv[i][2]);} else addRestrictions(&argv[i][2],PROFILE_LIFETIME); break; case '1': if(!profile) { fprintf(stderr,"First run\n"); profile = PROFILE_FIRST; } else { fprintf(stderr,"The '-f' can only be used on it's own\n"); } case '2': second_run = 1; break; case '@': countAp = 1; break; case 'u': if(!profile){ fprintf(stderr,"It only possible to use -u as modifier of other profile."); exit(-1); } else { PrintUse = 1; } break; #endif case 't': case 'z': #ifdef TPROF #ifdef PROFILE if (!profile) { /* -tmt order by module then ticks */ tprof = 1; /* -tmc order by module then calls (then ticks) */ } /* -tc order by calls then ticks */ #else /* -tt order by time then calls etc. */ tprof = 1; #endif /* Args following -t in quotes give */ tprofTMInit(); /* Module names that the user wishes */ if (argv[i][2]) { /* to collapse/expand eg. -t"-Ph +IO" */ tprofInclude(argv[i]+2); /* will collapse Ph and expand IO */ } /* "+all" & "-all" are valid, default */ break; /* is to expand only user modules */ case 'G': gcData = 1; #else fprintf(stderr, "Program has not been compiled for time profiling - ignoring -%c[option]\n",argv[i][1]); #endif break; #if INSCOUNT case 'I': insCount++; break; #endif case 'X': /* Only useful if linked with -X */ xlib_debug ++; break; default: fprintf(stderr,"Warning unrecognized run-time flag %s ignored.\n",argv[i]); } } } } else { Argv[Argc] = argv[i]; Argc++; } } #ifdef TPROF if(gcData) gcDataStart(argc,argv); /*PH*/ if(tprof) tprofStart(); #endif initForeignObjs(); initGc(hpSize,&Hp,spSize,&Sp); stableInit(); /*MW*/ timerClear(&totalTime); timerClear(&runTime); timerClear(&gcTime); timerStart(&totalTime); #ifdef PROFILE if(profile) profile_start(argc,argv); #endif timerStart(&runTime); Fp = Sp; /* initialise the Frame pointer */ } /* end of haskellInit */ int haskellEnd (int argc, char **argv) { timerStop(&runTime); #ifdef TPROF if(tprof) tprofStop(argc,argv); /*PH*/ if(gcData) gcDataStop(Hp); #endif #ifdef PROFILE if(profile) profile_stop(Hp); #endif //if (pendingIdx) runDeferredGCs(); /* run finalisers before quitting */ timerStop(&totalTime); fflush(stdout); fflush(stderr); finishGc(Hp,bellGc > 2); if(bellGc > 2) { double tt = (double)totalTime.l/(double)HZ; if(totalTime.h) fprintf(stderr,"32 bit timer not enough! Total time wrapped around %d times.\n",totalTime.h); fprintf(stderr,"Total time = %7.2f\n",tt); if(gcTime.h) fprintf(stderr,"32 bit timer not enough! Gc time wrapped around %d times.\n",gcTime.h); fprintf(stderr,"Gc time = %7.2f\n",(double)gcTime.l/(double)HZ); if(runTime.h) fprintf(stderr,"32 bit timer not enough! Run time wrapped around %d times.\n",runTime.h); fprintf(stderr,"Run time = %7.2f\n",(double)runTime.l/(double)HZ); } #ifdef PROFILE if(profile) profile_again(argc,argv); #endif #if INSCOUNT if(insCount) { printIns(); } #endif if(gcStatics) { finishGc(Hp,1); } exit(exit_code); }