Plan 9 from Bell Labs’s /usr/web/sources/contrib/fernan/nhc98/src/runtime/Kernel/haskellInit.c

Copyright © 2021 Plan 9 Foundation.
Distributed under the MIT License.
Download the Plan 9 distribution.


#include <stddef.h>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <ctype.h>
#include <time.h>
#include <setjmp.h>
#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 <default>    */
              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);
}


Bell Labs OSI certified Powered by Plan 9

(Return to Plan 9 Home Page)

Copyright © 2021 Plan 9 Foundation. All Rights Reserved.
Comments to [email protected].