86static char SccsId[] =
"%W% %G%";
89#if defined(__x86_64__) && defined (__linux__)
95typedef greg_t context_reg;
96#define CONTEXT_PC(scv) (((ucontext_t *)(scv))->uc_mcontext.gregs[14])
97#define CONTEXT_BP(scv) (((ucontext_t *)(scv))->uc_mcontext.gregs[6])
99#elif defined(__i386__) && defined (__linux__)
104typedef greg_t context_reg;
105#define CONTEXT_PC(scv) (((ucontext_t *)(scv))->uc_mcontext.gregs[14])
106#define CONTEXT_BP(scv) (((ucontext_t *)(scv))->uc_mcontext.gregs[6])
108#elif defined(__APPLE__) && defined(__x86_64__)
110#include <AvailabilityMacros.h>
111#include <sys/ucontext.h>
113#if !defined(MAC_OS_X_VERSION_10_5) || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_5
114#define CONTEXT_REG(r) r
116#define CONTEXT_REG(r) __##r
119#define CONTEXT_STATE(scv) (((ucontext_t *)(scv))->uc_mcontext->CONTEXT_REG(ss))
120#define CONTEXT_PC(scv) (CONTEXT_STATE(scv).CONTEXT_REG(rip))
121#define CONTEXT_BP(scv) (CONTEXT_STATE(scv).CONTEXT_REG(rbp))
123#elif defined(__APPLE__) && defined(__i386__)
125#include <AvailabilityMacros.h>
126#include <sys/ucontext.h>
128#if !defined(MAC_OS_X_VERSION_10_5) || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_5
129#define CONTEXT_REG(r) r
131#define CONTEXT_REG(r) __##r
134#define CONTEXT_STATE(scv) (((ucontext_t *)(scv))->uc_mcontext->CONTEXT_REG(ss))
135#define CONTEXT_PC(scv) (CONTEXT_STATE(scv).CONTEXT_REG(eip))
136#define CONTEXT_BP(scv) (CONTEXT_STATE(scv).CONTEXT_REG(ebp))
137#define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
141#define CONTEXT_PC(scv) NULL
142#define CONTEXT_BP(scv) NULL
169#define TIMER_DEFAULT 100
170#define PROFILING_FILE 1
171#define PROFPREDS_FILE 2
176} __attribute__ ((packed)) buf_ptr;
182} __attribute__ ((packed)) buf_extra;
217 temp->parent=temp->left=temp->right=temp;
220 temp->key=temp->lim=NULL;
222 temp->source=GPROF_NO_EVENT;;
224 temp->parent=temp->left=temp->right=GLOBAL_ProfilerNil;
225 temp->key=temp->lim=NULL;
227 temp->source=GPROF_NO_EVENT;
270 if (y->left != rb_nil) y->left->parent=x;
277 if( x == x->parent->left) {
286 Assert(!GLOBAL_ProfilerNil->red,
"nil not red in LeftRotate");
326 if (rb_nil != x->right) x->right->parent=y;
332 if( y == y->parent->left) {
341 Assert(!GLOBAL_ProfilerNil->red,
"nil not red in RightRotate");
367 z->left=z->right=rb_nil;
368 y=GLOBAL_ProfilerRoot;
369 x=GLOBAL_ProfilerRoot->left;
370 while( x != rb_nil) {
372 if (x->key > z->key) {
379 if ( (y == GLOBAL_ProfilerRoot) ||
387 Assert(!GLOBAL_ProfilerNil->red,
"nil not red in TreeInsertHelp");
424 while(x->parent->red) {
425 if (x->parent == x->parent->parent->left) {
426 y=x->parent->parent->right;
430 x->parent->parent->red=1;
433 if (x == x->parent->right) {
438 x->parent->parent->red=1;
439 RightRotate(x->parent->parent);
442 y=x->parent->parent->left;
446 x->parent->parent->red=1;
449 if (x == x->parent->left) {
454 x->parent->parent->red=1;
455 LeftRotate(x->parent->parent);
459 GLOBAL_ProfilerRoot->left->red=0;
463 Assert(!GLOBAL_ProfilerNil->red,
"nil not red in RBTreeInsert");
464 Assert(!GLOBAL_ProfilerRoot->red,
"root not red in RBTreeInsert");
483RBExactQuery(
yamop* q) {
487 if (!GLOBAL_ProfilerRoot)
return NULL;
488 x=GLOBAL_ProfilerRoot->left;
489 if (x == rb_nil)
return NULL;
496 if ( x == rb_nil)
return NULL;
503RBLookup(
yamop *entry) {
506 if (!GLOBAL_ProfilerRoot)
508 current = GLOBAL_ProfilerRoot->left;
509 while (current != GLOBAL_ProfilerNil) {
510 if (current->key <= entry && current->lim >= entry) {
513 if (entry > current->key)
514 current = current->right;
516 current = current->left;
542 while( (!x->red) && (root != x)) {
543 if (x == x->parent->left) {
548 LeftRotate(x->parent);
551 if ( (!w->right->red) && (!w->left->red) ) {
555 if (!w->right->red) {
561 w->red=x->parent->red;
564 LeftRotate(x->parent);
572 RightRotate(x->parent);
575 if ( (!w->right->red) && (!w->left->red) ) {
585 w->red=x->parent->red;
588 RightRotate(x->parent);
596 Assert(!tree->nil->red,
"nil not black in RBDeleteFixUp");
622 if (rb_nil != (y = x->right)) {
623 while(y->left != rb_nil) {
629 while(x == y->right) {
633 if (y == root)
return(rb_nil);
661 y= ((z->left == rb_nil) || (z->right == rb_nil)) ? z : TreeSuccessor(z);
662 x= (y->left == rb_nil) ? y->right : y->left;
663 if (root == (x->parent = y->parent)) {
666 if (y == y->parent->left) {
675 Assert( (y!=tree->nil),
"y is nil in RBDelete\n");
679 if (!(y->red)) RBDeleteFixUp(x);
687 z->left->parent=z->right->parent=y;
688 if (z == z->parent->left) {
697 if (!(y->red)) RBDeleteFixUp(x);
702 Assert(!tree->nil->red,
"nil not black in RBDelete");
706char *set_profile_dir(
char *);
707char *set_profile_dir(
char *name){
712 if (GLOBAL_DIRNAME!=NULL) free(GLOBAL_DIRNAME);
713 GLOBAL_DIRNAME=malloc(size);
714 if (GLOBAL_DIRNAME==NULL) { printf(
"Profiler Out of Mem\n"); exit(1); }
715 strcpy(GLOBAL_DIRNAME,name);
717 if (GLOBAL_DIRNAME==NULL) {
719 if (GLOBAL_DIRNAME!=NULL) free(GLOBAL_DIRNAME);
721 GLOBAL_DIRNAME=malloc(size);
722 if (GLOBAL_DIRNAME==NULL) { printf(
"Profiler Out of Mem\n"); exit(1); }
723 }
while (getcwd(GLOBAL_DIRNAME, size-15)==NULL);
726return GLOBAL_DIRNAME;
729char *profile_names(
int);
730char *profile_names(
int k) {
731 static char *FNAME=NULL;
734 if (GLOBAL_DIRNAME==NULL) set_profile_dir(NULL);
736 if (FNAME==NULL) { printf(
"Profiler Out of Mem\n"); exit(1); }
738 if (k==PROFILING_FILE) {
739 snprintf(FNAME,size,
"%s/PROFILING_%d",GLOBAL_DIRNAME,getpid());
741 snprintf(FNAME,size,
"%s/PROFPREDS_%d",GLOBAL_DIRNAME,getpid());
743 FNAME = realloc(FNAME, strlen(FNAME)+1);
748void del_profile_files(
void);
749void del_profile_files() {
750 if (GLOBAL_DIRNAME!=NULL) {
751 remove(profile_names(PROFPREDS_FILE));
752 remove(profile_names(PROFILING_FILE));
757Yap_inform_profiler_of_clause__(
void *code_start,
void *code_end,
PredEntry *pe,gprof_info index_code) {
760 GLOBAL_ProfOn = TRUE;
766 fwrite(&b,
sizeof(b),1,GLOBAL_FPreds);
767 fwrite(&e,
sizeof(e),1,GLOBAL_FPreds);
768 GLOBAL_ProfOn = FALSE;
771typedef struct clause_entry {
779static Int profend( USES_REGS1 );
783 if (node == GLOBAL_ProfilerNil)
785 clean_tree(node->left);
786 clean_tree(node->right);
787 Yap_FreeCodeSpace((
char *)node);
792 clean_tree(GLOBAL_ProfilerRoot);
793 Yap_FreeCodeSpace((
char *)GLOBAL_ProfilerNil);
794 GLOBAL_ProfilerNil = GLOBAL_ProfilerRoot = NULL;
795 GLOBAL_ProfCalls = GLOBAL_ProfGCs = GLOBAL_ProfHGrows = GLOBAL_ProfSGrows = GLOBAL_ProfMallocs = GLOBAL_ProfOns = 0L;
801 if (GLOBAL_ProfilerRoot)
803 while (!(GLOBAL_ProfilerRoot = RBTreeCreate())) {
804 if (!Yap_growheap(FALSE, 0, NULL)) {
805 Yap_Error(RESOURCE_ERROR_HEAP, TermNil,
"while initializing profiler");
812static void RemoveCode(CODEADDR clau)
818 if (!GLOBAL_ProfilerRoot)
return;
819 if (!(x = RBExactQuery((
yamop *)clau))) {
821 GLOBAL_ProfOn = FALSE;
828 if (!(node = RBExactQuery((
yamop *)(pp->OpcodeOfPred)))) {
829 node = RBTreeInsert((
yamop *)(pp->OpcodeOfPred), NEXTOP((
yamop *)(pp->OpcodeOfPred),e));
830 node->lim = (
yamop *)pp;
834 GLOBAL_ProfOn = FALSE;
842showprofres( USES_REGS1 ) {
845 profend( PASS_REGS1 );
851 GLOBAL_ProfMallocs=0;
854 GLOBAL_ProfIndexing=0;
855 GLOBAL_FProf=fopen(profile_names(PROFILING_FILE),
"r");
856 if (GLOBAL_FProf==NULL) { fclose(GLOBAL_FProf);
return FALSE; }
857 while (fread(&buf,
sizeof(buf), 1, GLOBAL_FProf)) {
864 if (fread(&e,
sizeof(buf_extra),1,GLOBAL_FProf) == 0)
866 node = RBTreeInsert(buf.ptr, e.end);
868 node->source = e.inf;
876 md = ((prolog_exec_mode*)buf.ptr)[0];
879 }
else if (md & MallocMode) {
880 GLOBAL_ProfMallocs++;
881 }
else if (md & GrowHeapMode) {
883 }
else if (md & GrowStackMode) {
895 node = RBLookup(buf.ptr);
898 fprintf(stderr,
"Oops: %p\n", buf.ptr);
901 switch(node->source) {
903 case GPROF_INDEX_EXPAND:
905 case GPROF_STATIC_INDEX:
906 case GPROF_INIT_EXPAND:
907 case GPROF_INIT_LOG_UPD_CLAUSE:
908 case GPROF_NEW_LU_SWITCH:
909 case GPROF_NEW_STATIC_SWITCH:
910 case GPROF_NEW_EXPAND_BLOCK:
911 GLOBAL_ProfIndexing++;
921 fclose(GLOBAL_FProf);
922 if (GLOBAL_ProfCalls==0)
928#define TestMode (GCMode | GrowHeapMode | GrowStackMode | ErrorHandlingMode | InErrorMode | AbortMode | MallocMode)
932prof_alrm(
int signo, siginfo_t *si,
void *scv)
945 GLOBAL_ProfOn = TRUE;
946 oldpc = (
void *) CONTEXT_PC(scv);
947 if (LOCAL_PrologMode & TestMode) {
950 b.ptr= (
void *)LOCAL_PrologMode;
951 fwrite(&b,
sizeof(b),1,GLOBAL_FPreds);
952 GLOBAL_ProfOn = FALSE;
956 if (oldpc>(
void *) &Yap_absmi && oldpc <= (
void *) &Yap_absmiEND) {
960 current_p =(
yamop *) CONTEXT_BP(scv);
966 op_numbers oop = Yap_op_from_opcode(PREVOP(P,Osbpp)->opc);
968 if (oop == _call_cpred || oop == _call_usercpred) {
970 current_p = PREVOP(P,Osbpp)->y_u.Osbpp.p->CodeOfPred;
971 }
else if ((oop = Yap_op_from_opcode(P->opc)) == _execute_cpred) {
973 current_p = P->y_u.Osbpp.p->CodeOfPred;
979#if !USE_SYSTEM_MALLOC
980 if (P < (
yamop *)Yap_HeapBase || P > (
yamop *)HeapTop) {
982 fprintf(stderr,
"Oops: %p, %p\n", oldpc, current_p);
984 GLOBAL_ProfOn = FALSE;
991 fwrite(&b,
sizeof(b),1,GLOBAL_FPreds);
992 GLOBAL_ProfOn = FALSE;
997Yap_InformOfRemoval(
void *clau)
999 GLOBAL_ProfOn = TRUE;
1000 if (GLOBAL_FPreds != NULL) {
1006 fwrite(&b,
sizeof(b),1,GLOBAL_FPreds);
1007 GLOBAL_ProfOn = FALSE;
1010 GLOBAL_ProfOn = FALSE;
1013static Int profend( USES_REGS1 );
1016profnode( USES_REGS1 ) {
1017 Term t1 = Deref(ARG1), tleft, tright;
1020 if (!GLOBAL_ProfilerRoot)
1023 node = GLOBAL_ProfilerRoot;
1028 if (node->left == GLOBAL_ProfilerNil) {
1031 tleft = MkIntegerTerm((Int)node->left);
1033 if (node->left == GLOBAL_ProfilerNil) {
1036 tleft = MkIntegerTerm((Int)node->left);
1038 if (node->right == GLOBAL_ProfilerNil) {
1041 tright = MkIntegerTerm((Int)node->right);
1044 Yap_unify(ARG2,MkIntegerTerm((Int)node->key)) &&
1045 Yap_unify(ARG3,MkIntegerTerm((Int)node->pe)) &&
1046 Yap_unify(ARG4,MkIntegerTerm((Int)node->pcs)) &&
1047 Yap_unify(ARG5,tleft) &&
1048 Yap_unify(ARG6,tright);
1052profglobs( USES_REGS1 ) {
1054 Yap_unify(ARG1,MkIntegerTerm(GLOBAL_ProfCalls)) &&
1055 Yap_unify(ARG2,MkIntegerTerm(GLOBAL_ProfGCs)) &&
1056 Yap_unify(ARG3,MkIntegerTerm(GLOBAL_ProfHGrows)) &&
1057 Yap_unify(ARG4,MkIntegerTerm(GLOBAL_ProfSGrows)) &&
1058 Yap_unify(ARG5,MkIntegerTerm(GLOBAL_ProfMallocs)) &&
1059 Yap_unify(ARG6,MkIntegerTerm(GLOBAL_ProfIndexing)) &&
1060 Yap_unify(ARG7,MkIntegerTerm(GLOBAL_ProfOns)) ;
1064do_profinit( USES_REGS1 )
1068 GLOBAL_FProf=fopen(profile_names(PROFILING_FILE),
"w+");
1069 if (GLOBAL_FProf==NULL) { fclose(GLOBAL_FProf);
return FALSE; }
1070 GLOBAL_FPreds = GLOBAL_FProf;
1072 Yap_dump_code_area_for_profiler();
1076static Int profinit( USES_REGS1 )
1078 if (GLOBAL_ProfilerOn!=0)
return (FALSE);
1080 if (!do_profinit( PASS_REGS1 ))
1083 GLOBAL_ProfilerOn = -1;
1087static Int start_profilers(
int msec)
1090 struct sigaction sa;
1092 if (GLOBAL_ProfilerOn!=-1) {
1095 sa.sa_sigaction=prof_alrm;
1096 sigemptyset(&sa.sa_mask);
1097 sa.sa_flags=SA_SIGINFO;
1098 if (sigaction(SIGPROF,&sa,NULL)== -1)
return FALSE;
1101 t.it_interval.tv_sec=0;
1102 t.it_interval.tv_usec=msec;
1103 t.it_value.tv_sec=0;
1104 t.it_value.tv_usec=msec;
1105 setitimer(ITIMER_PROF,&t,NULL);
1107 GLOBAL_ProfilerOn = msec;
1112static Int profoff( USES_REGS1 ) {
1113 if (GLOBAL_ProfilerOn>0) {
1115 t.it_interval.tv_sec=0;
1116 t.it_interval.tv_usec=0;
1117 t.it_value.tv_sec=0;
1118 t.it_value.tv_usec=0;
1120 setitimer(ITIMER_PROF,&t,NULL);
1121 GLOBAL_ProfilerOn = -1;
1127static Int ProfOn( USES_REGS1 ) {
1129 profoff( PASS_REGS1 );
1131 return(start_profilers(IntOfTerm(p)));
1134static Int ProfOn0( USES_REGS1 ) {
1135 profoff( PASS_REGS1 );
1136 return(start_profilers(TIMER_DEFAULT));
1139static Int profison( USES_REGS1 ) {
1140 return (GLOBAL_ProfilerOn > 0);
1143static Int profalt( USES_REGS1 ) {
1144 if (GLOBAL_ProfilerOn==0)
return(FALSE);
1145 if (GLOBAL_ProfilerOn==-1)
return ProfOn( PASS_REGS1 );
1146 return profoff( PASS_REGS1 );
1149static Int profend( USES_REGS1 )
1151 if (GLOBAL_ProfilerOn==0)
return(FALSE);
1152 profoff( PASS_REGS1 );
1153 GLOBAL_ProfilerOn=0;
1154 fclose(GLOBAL_FProf);
1155 GLOBAL_FPreds = NULL;
1159static Int getpredinfo( USES_REGS1 )
1167 if (pp->ModuleOfPred == PROLOG_MODULE)
1170 mod = pp->ModuleOfPred;
1171 if (pp->ModuleOfPred == IDB_MODULE) {
1172 if (pp->PredFlags & NumberDBPredFlag) {
1174 name = MkIntegerTerm(pp->src.IndxId);
1175 }
else if (pp->PredFlags & AtomDBPredFlag) {
1177 name = MkAtomTerm((
Atom)pp->FunctorOfPred);
1179 name = MkAtomTerm(NameOfFunctor(pp->FunctorOfPred));
1180 arity = ArityOfFunctor(pp->FunctorOfPred);
1183 arity = pp->ArityOfPE;
1184 if (pp->ArityOfPE) {
1185 name = MkAtomTerm(NameOfFunctor(pp->FunctorOfPred));
1187 name = MkAtomTerm((
Atom)(pp->FunctorOfPred));
1190 return Yap_unify(ARG2, mod) &&
1191 Yap_unify(ARG3, name) &&
1192 Yap_unify(ARG4, MkIntegerTerm(arity));
1195static Int profres0( USES_REGS1 ) {
1196 return(showprofres( PASS_REGS1 ));
1202Yap_InitLowProf(
void)
1205 GLOBAL_ProfCalls = 0;
1206 GLOBAL_ProfilerOn = FALSE;
1208 Yap_InitCPred(
"profinit",0, profinit, SafePredFlag);
1209 Yap_InitCPred(
"profend" ,0, profend, SafePredFlag);
1210 Yap_InitCPred(
"profon" , 0, ProfOn0, SafePredFlag);
1211 Yap_InitCPred(
"profoff", 0, profoff, SafePredFlag);
1212 Yap_InitCPred(
"profalt", 0, profalt, SafePredFlag);
1213 Yap_InitCPred(
"$offline_showprofres", 0, profres0, SafePredFlag);
1214 Yap_InitCPred(
"$profnode", 6, profnode, SafePredFlag);
1215 Yap_InitCPred(
"$profglobs", 7, profglobs, SafePredFlag);
1216 Yap_InitCPred(
"$profison",0 , profison, SafePredFlag);
1217 Yap_InitCPred(
"$get_pred_pinfo", 4, getpredinfo, SafePredFlag);
1218 Yap_InitCPred(
"showprofres", 4, getpredinfo, SafePredFlag);
@ source
If true maintain the source for all clauses.