#ifndef _RUNTIME_H #define _RUNTIME_H #define PARANOID 0 #define INSCOUNT 0 #ifndef TRACE #define TRACE 0 #endif #define WHEN_SCC(x) #include /* include file for global definitions */ typedef long Int; typedef unsigned long UInt; #ifdef __alpha typedef unsigned int UHalf; typedef signed int Half; #else typedef unsigned short UHalf; typedef signed short Half; #endif typedef signed long HeapOffset; #define HEAPOFFSET(x) ((HeapOffset)(x)) typedef unsigned short JumpItem; typedef struct { JumpItem constr; JumpItem offset; } JumpTable; #ifdef __arm #define HZ 100 #else #include #endif #ifndef HZ #ifdef __mips #define HZ 50 #else #define HZ 100 #endif #endif /* timeRO.s timeUnix.c */ typedef struct { unsigned int l; unsigned int h; } timer; extern void timerClear(timer *); extern void timerRead(timer *); extern void timerStart(timer *); extern void timerStop(timer *); /* misc typedefs */ typedef unsigned char UChar; typedef UInt Node; typedef Node *NodePtr; typedef UChar Code; typedef Code *CodePtr; typedef UInt *Cinfo; typedef UInt Coninfo; typedef UInt *Finfo; extern NodePtr Hp; extern NodePtr *Sp; extern NodePtr *Fp; extern CodePtr Ip; extern char **Argv; extern int Argc; #define DUMP_ADDR 1 #define DUMP_IND 2 #define DUMP_TOP 4 #define TRACE_EVAL 8 #define TRACE_RETURN 16 #ifdef TRACE extern int traceIp,traceSp,traceHp,traceDepth,traceFlag; #endif extern int xlib_debug; #ifdef PROFILE #define DYNAMIC #define WHO_CODE 1 #define WHO_STACK 2 #define PROFILE_MODULE 1 #define PROFILE_PRODUCER 2 #define PROFILE_CONSTRUCTOR 4 #define PROFILE_RETAINER 8 #define PROFILE_LIFETIME 16 #define PROFILE_KIND 32 #define PROFILE_BIOGRAPHY 128 #define PROFILE_FIRST 256 #define PROFILE_SCC 512 typedef struct { char *module; char *producer; char *constructor; } SInfo; typedef struct RETAINER { struct RETAINER *next; int size; short hashv; char keep; char no; char *member[1]; } Retainer; typedef union { struct { unsigned int created:9; unsigned int first:9; unsigned int last:9; unsigned int used:5; } parts; UInt all; } BInfo; #define MAX_USED 31 typedef struct { SInfo *sinfo; BInfo binfo; Retainer *rinfo; Int unique; } Info; extern char filename[]; extern char inputname[]; extern char lastname[]; extern int useUnique; extern int unique; extern int record; extern int replay; extern int post_mortem; extern int second_run; extern FILE *lastFILE; extern FILE *inputFILE; typedef struct { char lastused; char dead; char used; } pm_data; extern pm_data *lastAREA; extern int lastSIZE; extern int FilterBiography; extern int PrintUse; extern int argcounts; extern FILE *proFILE; extern int countAp; extern SInfo dummyProfInfo; extern int unique; extern timer runTime; extern int oldVapSize; #if 0 /*PH*/ extern volatile NodePtr profileHpLimit; extern volatile int timeSample; extern double profileInterval; extern int pactive; #endif extern int profile; extern int old_profile; extern int filter; extern int year; #define EXTRA ((Int)sizeof(Info)/(Int)sizeof(Node)) #define GET_INFO(p) ((Info *)(1 + (NodePtr)(p))) #define WHEN_PROFILE(x) x #define WHEN_DYNAMIC(x) x #define INIT_PROFINFO(nodeptr,info) \ { Info *infop = GET_INFO(nodeptr); \ infop->sinfo = info; \ infop->binfo.all = 0; \ infop->binfo.parts.created = year; \ infop->rinfo = 0; \ infop->unique = 0; \ WHEN_SCC(infop->retainer = (Retainer *)sccptr;) \ } #define UPDATE_PROFINFO(nodeptr) \ { Info *info = GET_INFO(nodeptr); \ if(!info->binfo.parts.used) { info->binfo.parts.used=1; info->binfo.parts.first = year;} \ else { if(info->binfo.parts.usedbinfo.parts.used++; } \ info->binfo.parts.last = year; \ } #define SAVE_PROFINFO(nodeptr) \ if(profile) { \ /* timerStop(&runTime); */ \ if(post_mortem && INSIDE(nodeptr)) { \ UPDATE_PROFINFO(nodeptr) \ addElement(GET_INFO(nodeptr),sizeofNode(*nodeptr)*NS); \ } \ /* timerStart(&runTime); */ \ } #define FILL_AT(size,dst) \ oldVapSize = sizeofNode(dst[0])+EXTRA;\ if(oldVapSize > size) { \ dst[size] = (Node)-(Int)(dst+oldVapSize); \ } #else #define EXTRA 0 #define WHEN_PROFILE(x) #define WHEN_DYNAMIC(x) #define INIT_PROFINFO(nodeptr,info) #define UPDATE_PROFINFO(nodeptr) #define SAVE_PROFINFO(nodeptr) #define FILL_AT(newsize,nodeptr) #endif /* functions */ void nhc_abort(char *errorMsg); extern Node FN_Prelude_46blackhole[]; extern Node CF__95Builtin_46hputc_95ok[]; extern Node CF__95Driver_46_95toplevel[]; extern Node FN__95Driver_46_95toplevel[]; extern Node FN__95Driver_46_95driver[]; extern Node FN_Prelude_46primLeave[]; extern Node FN_Builtin_46primUnpackCString[]; extern Node FN_Builtin_46hgets[]; extern Node FN_Prelude_46_36[]; extern Node C0_Prelude_46_91_93[]; extern Node C0_Builtin_46PrimToken[]; extern Node C0_Prelude_46True[]; extern Node C0_Prelude_46False[]; extern Node Start_World[]; extern Node FN_Builtin_46primLeave[]; extern Node CF_Prelude_46_95zap_95arg[]; extern Node CF_Prelude_46_95zap_95stack[]; extern Node FN_Prelude_46Monad_46Prelude_46IO_46return[]; extern Node FN_Prelude_46_95ioReturn[]; extern Node FN_IOExtras_46unsafePerformIO[]; #define BLACKHOLE ((Node)FN_Prelude_46blackhole) #define HPUTC_OK ((NodePtr)CF__95Builtin_46hputc_95ok) #define TOPLEVEL ((NodePtr)CF__95Driver_46_95toplevel) #define TOPLEVEL_code ((NodePtr)FN__95Driver_46_95toplevel) #define LEAVE ((Node)FN_Prelude_46primLeave) #define GET_WORLD ((Node)Start_World) #define MAIN ((Node)FN__95Driver_46_95driver) #define TOKEN ((Node)C0_Builtin_46PrimToken) #define PRIM_STRING ((Node)FN_Builtin_46primUnpackCString) #define PRIM_HGETS ((Node)FN_Builtin_46hgets) #define PRIM_APPLY ((Node)FN_Prelude_46_36) #define CON_TRUE ((Node)C0_Prelude_46True) #define CON_FALSE ((Node)C0_Prelude_46False) #define CON_NIL ((Node)C0_Prelude_46_91_93) #define ZAP_ARG_NODE ((NodePtr) CF_Prelude_46_95zap_95arg) #define ZAP_STACK_NODE ((NodePtr) CF_Prelude_46_95zap_95stack) #define IORETURN ((Node)FN_Prelude_46Monad_46Prelude_46IO_46return) /*#define IORETURN ((Node)FN_Prelude_46_95ioReturn) -- removed again*/ #define PERFORMIO ((Node)FN_IOExtras_46unsafePerformIO) #define C_CODE ((Code)FN_Prelude_46primLeave) /* collector */ typedef struct GCCONST { int sizeArity; struct GCCONST *next; NodePtr ptr[1]; /* size is in sizeArity + (1+EXTRA) extra if arity == 0 */ } *GcConst; #define GcEnd ((GcConst)-1) extern GcConst oldCaf; extern GcConst newCaf; extern NodePtr hpLimit; extern NodePtr hpStart,hpEnd; extern NodePtr *spStart, *spEnd; extern int hpSize; extern int spSize; extern void initGc(Int hpSize,NodePtr *ihp,Int spSize,NodePtr **isp); extern void finishGc(NodePtr hp,int verbose); extern NodePtr callGc(Int size,NodePtr hp, NodePtr *sp, NodePtr *fp); #ifdef PROFILE extern void do_comment(char *); #endif /* ForeignObjs */ struct FOREIGNOBJ; typedef void (*gcFO)(struct FOREIGNOBJ *); typedef void (*gcCval)(void *); typedef struct { int bm,size; FILE *fp; int fdesc; char *path; } FileDesc; typedef struct FOREIGNOBJ { int used; void* cval; gcCval gc; /* Second-stage garbage collector */ gcFO gcf; /* First-stage garbage collector */ } ForeignObj; void initForeignObjs(void); ForeignObj *allocForeignObj(void*a,gcCval gc,gcFO gcf); void freeForeignObj(ForeignObj *cd); void *derefForeignObj(ForeignObj *cd); void clearForeignObjs(void); void markForeignObj(ForeignObj *cd); void gcForeignObjs(void); void gcNow(ForeignObj *cd); void gcLater(ForeignObj *cd); void gcNone(ForeignObj *cd); void gcFile(void *a); void gcSocket(void *a); void runDeferredGCs (void); extern ForeignObj fo_stdin; extern ForeignObj fo_stdout; extern ForeignObj fo_stderr; typedef void (*markfun)(); typedef void (*flipfun)(); typedef struct USER_GC { markfun mark; flipfun flip; struct USER_GC *next; } UserGC; extern void add_user_gc(markfun, flipfun); #ifdef TPROF extern CodePtr *ipref; extern int tprof; extern int gcData; /* Needed by main.c or haskellInit */ extern void tprofTMInit(void); extern void tprofInclude(char *); extern void tprofStart(void); extern void tprofStop(int, char **); extern void gcDataStart(int, char **); extern void gcDataStop(NodePtr); /* Needed by collector.c and/or timer.c */ extern FILE *gdFILE; extern void tprofRecordTick(void); extern void tprofRecordGC(void); /* tprof.c <-> tprofprel?.o or tprofusr.o */ extern void tprofTMInit(void); extern void tprofInitTree(CodePtr, char *, int *); extern void tprofTMIncludeUsr(char *, int); extern void tprofTMIncludeUsrSubfn(void); extern void tprofTMIncludePrel(char *, int); extern void tprofTMIncludePrelSubfn(void); extern int tprofTMInitTreeUsr(void); extern int tprofTMInitTreePrel1(void); extern int tprofTMInitTreePrel2(void); extern int tprofTMInitTreePrel3(void); /* Needed by mutator.c */ extern void tprofRecordEnter(char*, int **); extern void tprofEnterGreencard(CodePtr,char *); extern void tprofExitGreencard(void); extern int *last_tick; extern int cancel_enter; extern int **enterPtr; #define TPROF_SETUP \ int canceling_enters = 0; #define TPROF_RUN \ ipref = &ip; #define TPROF_CANCEL_ENTERS(num) \ if (canceling_enters) /* Check that we _really_ wanted to */ \ if (cancel_enter==1) cancel_enter++; /* count an enter */ \ else { \ cancel_enter=0; \ canceling_enters=0; \ last_tick = NULL; \ } #define TPROF_NEEDSTACK_I16 TPROF_CANCEL_ENTERS(1) #define TPROF_SELECTOR_EVAL TPROF_CANCEL_ENTERS(2) #define TPROF_SELECT TPROF_CANCEL_ENTERS(3) #define TPROF_RETURN_EVAL TPROF_CANCEL_ENTERS(4) #define TPROF_GREENCARD_ENTER \ if(tprof) \ tprofEnterGreencard((CodePtr)FINFO_CODE(GET_FINFO(vapptr)), \ (char *)constptr[-1]); #define TPROF_GREENCARD_EXIT \ ipref = &ip; \ tprofExitGreencard(); #define TPROF_EVAL \ enterPtr = (int**) FINFO_ENTERPTR(GET_FINFO(vapptr)); \ if (**enterPtr==-1) { /* First enter for this function */ \ tprofRecordEnter((char*)constptr[-1], enterPtr); \ } \ else /* no need to search the tree :-) */ \ (**enterPtr)++; \ cancel_enter=1; \ canceling_enters=1; \ last_tick = NULL; #define TPROF_EVAL_END \ if (canceling_enters) { \ if (cancel_enter==5) { \ (**enterPtr)--; \ if (last_tick != NULL) \ (*last_tick)--; \ cancel_enter=0; \ canceling_enters=0; \ } \ } #else #define TPROF_SETUP #define TPROF_RUN #define TPROF_NEEDSTACK_I16 #define TPROF_SELECTOR_EVAL #define TPROF_SELECT #define TPROF_RETURN_EVAL #define TPROF_GREENCARD_ENTER #define TPROF_GREENCARD_EXIT #define TPROF_EVAL #define TPROF_EVAL_END #endif #if defined(PROFILE) || defined(TPROF) /* timer.c */ extern volatile NodePtr profileHpLimit; extern volatile int timeSample; extern double profileInterval; extern int pactive; extern timer runTime; extern void setuptimer (void); extern void stoptimer (void); #define RATE 20000 /* exception rate in us */ #define ACTIVE_TIME 1 #define FREEZE_TIME 2 #endif /* mutator.c */ void run(NodePtr); #define DOUBLE_H 1 /* High part of double */ #define DOUBLE_L 0 #if TRACE /* dump.h */ extern void prByteIns(CodePtr ip); extern void prGraph(NodePtr nodeptr,Int flags,Int d); extern void prStack(NodePtr *sp,NodePtr *fp,NodePtr vapptr,NodePtr *constptr,int flags,int depth); extern void prStackGc(NodePtr *sp,NodePtr *fp,int flags,int depth); #endif #if INSCOUNT /* inscount.c */ extern int insCount; extern void countIns(CodePtr ip); extern void printIns(void); #endif /* tables.c */ #define SIZE_FLOAT (EXTRA+2) #define SIZE_DOUBLE (EXTRA+3) #define SIZE_INT (EXTRA+2) #define SIZE_INT64 (EXTRA+3) #define SIZE_APPLY (EXTRA+3) #define SIZE_VAP1 (EXTRA+2) #define SIZE_VAP2 (EXTRA+3) #define SIZE_CONS (EXTRA+3) #define SIZE_TUPLE(n) (EXTRA+1+n) #define SIZE_HOLE (EXTRA+1) #define SIZE_TAG (EXTRA+1) #define SIZE_IND (1) #define SIZE_ENUM (EXTRA+1) #define RSIZE_FLOAT 2 #define RSIZE_DOUBLE 3 #define RSIZE_INT 2 #define RSIZE_INT64 3 #define RSIZE_APPLY 3 #define RSIZE_VAP1 2 #define RSIZE_CONS 3 #define RSIZE_HOLE 1 #define RSIZE_TAG 1 #define RSIZE_IND 1 #define RSIZE_ENUM 1 #define TABLE_SIZE_INT (SIZE_INT) /* useful C-macros */ #define IND_REMOVE(p) \ while((!((int)p & ZAP_BIT)) && (0==(*p & MASK_WTAG))) p = (NodePtr)*p /* while(0==(*p & MASK_WTAG)) p = (NodePtr)*p ---- NR */ #define IND_REMOVE_T(p,t) \ while(0==(t=(*p & MASK_WTAG))) p = (NodePtr)*p #define IND_REMOVE_T_EXTRA(p,t,e) \ while(0==(t=(*p & MASK_WTAG))) {p = (NodePtr)*p; e} #define IND_REMOVE_T_U(p,t,u) \ if(0==(t = (*p & MASK_WTAG))) { \ do { p = (NodePtr)*p; \ } while (0==(t = (*p & MASK_WTAG))); \ *u = p; \ } else /* integer functions */ typedef struct { Int sizeTag; /* abs(SIZE) is the number of limbs the last field points to. If SIZE is negative this is a negative number. */ WHEN_PROFILE(Info info;) UInt d[1]; /* First limb. */ } __MP_INT; #define MP_INT __MP_INT typedef unsigned long int mp_limb; typedef long int mp_limb_signed; typedef mp_limb * mp_ptr; typedef mp_limb * mp_srcptr; typedef long int mp_size; NodePtr mpz_add(MP_INT *,MP_INT *,MP_INT *); /* first free = fun(dst,src1,src2) */ Int mpz_add_need(MP_INT *,MP_INT *); NodePtr mpz_sub(MP_INT *,MP_INT *,MP_INT *); Int mpz_sub_need(MP_INT *,MP_INT *); NodePtr mpz_div(MP_INT *,MP_INT *,MP_INT *); Int mpz_div_need(MP_INT *,MP_INT *); NodePtr mpz_mul(MP_INT *,MP_INT *,MP_INT *); Int mpz_mul_need(MP_INT *,MP_INT *); NodePtr mpz_mod(MP_INT *,MP_INT *,MP_INT *); Int mpz_mod_need(MP_INT *,MP_INT *); NodePtr mpz_and(MP_INT *,MP_INT *,MP_INT *); Int mpz_and_need(MP_INT *,MP_INT *); NodePtr mpz_or(MP_INT *,MP_INT *,MP_INT *); Int mpz_or_need(MP_INT *,MP_INT *); NodePtr mpz_abs(MP_INT *,MP_INT *); Int mpz_abs_need(MP_INT *); NodePtr mpz_sgn(MP_INT *,MP_INT *); Int mpz_sgn_need(MP_INT *); NodePtr mpz_neg(MP_INT *,MP_INT *); Int mpz_neg_need(MP_INT *); int mpz_le(MP_INT *,MP_INT *); /* bool = fun(src1,src2) */ int mpz_eq(MP_INT *,MP_INT *); /* help functions */ mp_size _mpn_add(mp_ptr sum_ptr ,mp_srcptr add1_ptr, mp_size add1_size ,mp_srcptr add2_ptr, mp_size add2_size); mp_size _mpn_sub (mp_ptr dif_ptr ,mp_srcptr min_ptr, mp_size min_size ,mp_srcptr sub_ptr, mp_size sub_size); mp_size _mpn_mul (mp_ptr prodp ,mp_srcptr up, mp_size usize ,mp_srcptr vp, mp_size vsize); mp_size _mpn_div (mp_ptr quot_ptr ,mp_ptr num_ptr, mp_size num_size ,mp_srcptr den_ptr, mp_size den_size); int _mpn_cmp (mp_srcptr op1_ptr, mp_size op1_size ,mp_srcptr op2_ptr, mp_size op2_size); mp_limb _mpn_lshift (mp_ptr wp ,mp_srcptr up, mp_size usize ,unsigned long int cnt); mp_size _mpn_rshift (mp_ptr wp ,mp_srcptr up, mp_size usize ,unsigned long int cnt); #ifdef PROFILE extern Retainer *findRetainer(Retainer *rinfo,int keep,char *function); int member(char *function,Retainer *rinfo); NodePtr remark(NodePtr *inode, int keep, char *newMember,int who); void pushRemarkStack(int keep, char *function,NodePtr node,int who); void remarkRest(void); void remarkInit(void); #endif #endif