suppot for ampi
[charm.git] / src / libs / ck-libs / tcharm / tcharm.C
1 /*
2 Threaded Charm++ "Framework Framework"
3
4 Orion Sky Lawlor, olawlor@acm.org, 11/19/2001
5  */
6 #include "tcharm_impl.h"
7 #include "tcharm.h"
8 #include "ckevacuation.h"
9 #include <ctype.h>
10
11 #if 0 
12     /*Many debugging statements:*/
13 #    define DBG(x) ckout<<"["<<thisIndex<<","<<CkMyPe()<<"] TCHARM> "<<x<<endl;
14 #    define DBGX(x) ckout<<"PE("<<CkMyPe()<<") TCHARM> "<<x<<endl;
15 #else
16     /*No debugging statements*/
17 #    define DBG(x) /*empty*/
18 #    define DBGX(x) /*empty*/
19 #endif
20
21 CtvDeclare(TCharm *,_curTCharm);
22
23 static int lastNumChunks=0;
24
25 class TCharmTraceLibList {
26         enum {maxLibs=20,maxLibNameLen=15};
27         //List of libraries we want to trace:
28         int curLibs;
29         char libNames[maxLibs][maxLibNameLen];
30         int checkIfTracing(const char *lib) const
31         {
32                 for (int i=0;i<curLibs;i++) 
33                         if (0==strcmp(lib,libNames[i]))
34                                 return 1;
35                 return 0;
36         }
37 public:
38         TCharmTraceLibList() {curLibs=0;}
39         void addTracing(const char *lib) 
40         { //We want to trace this library-- add its name to the list.
41                 CkPrintf("TCHARM> Will trace calls to library %s\n",lib);
42                 int i;
43                 for (i=0;0!=*lib;i++,lib++)
44                         libNames[curLibs][i]=tolower(*lib);
45                 libNames[curLibs][i]=0;
46                 // if already tracing, skip
47                 if (checkIfTracing(libNames[curLibs])) return;
48                 curLibs++;
49         }
50         inline int isTracing(const char *lib) const {
51                 if (curLibs==0) return 0; //Common case
52                 else return checkIfTracing(lib);
53         }
54 };
55 static TCharmTraceLibList tcharm_tracelibs;
56 static int tcharm_nomig=0, tcharm_nothreads=0;
57 static int tcharm_stacksize=1*1024*1024; /*Default stack size is 1MB*/
58 static int tcharm_initted=0;
59 CkpvDeclare(int, mapCreated);
60 static CkGroupID mapID;
61 static char* mapping = NULL;
62
63 void TCharm::nodeInit(void)
64 {
65 }
66
67 void TCharm::procInit(void)
68 {
69   CtvInitialize(TCharm *,_curTCharm);
70   CtvAccess(_curTCharm)=NULL;
71   tcharm_initted=1;
72   CtgInit();
73
74   CkpvInitialize(int, mapCreated);
75   CkpvAccess(mapCreated) = 0;
76
77   // called on every pe to eat these arguments
78   char **argv=CkGetArgv();
79   tcharm_nomig=CmiGetArgFlagDesc(argv,"+tcharm_nomig","Disable migration support (debugging)");
80   tcharm_nothreads=CmiGetArgFlagDesc(argv,"+tcharm_nothread","Disable thread support (debugging)");
81   tcharm_nothreads|=CmiGetArgFlagDesc(argv,"+tcharm_nothreads",NULL);
82   char *traceLibName=NULL;
83   while (CmiGetArgStringDesc(argv,"+tcharm_trace",&traceLibName,"Print each call to this library"))
84       tcharm_tracelibs.addTracing(traceLibName);
85   // CmiGetArgIntDesc(argv,"+tcharm_stacksize",&tcharm_stacksize,"Set the thread stack size (default 1MB)");
86   char *str;
87   if (CmiGetArgStringDesc(argv,"+tcharm_stacksize",&str,"Set the thread stack size (default 1MB)"))  {
88     if (strpbrk(str,"M")) {
89       sscanf(str, "%dM", &tcharm_stacksize);
90       tcharm_stacksize *= 1024*1024;
91     }
92     else if (strpbrk(str,"K")) {
93       sscanf(str, "%dK", &tcharm_stacksize);
94       tcharm_stacksize *= 1024;
95     }
96     else {
97       sscanf(str, "%d", &tcharm_stacksize);
98     }
99     if (CkMyPe() == 0)
100       CkPrintf("TCharm> stack size is set to %d.\n", tcharm_stacksize);
101   }
102   if (CkMyPe()!=0) { //Processor 0 eats "+vp<N>" and "-vp<N>" later:
103         int ignored;
104         while (CmiGetArgIntDesc(argv,"-vp",&ignored,NULL)) {}
105         while (CmiGetArgIntDesc(argv,"+vp",&ignored,NULL)) {}
106   }
107   if (CkMyPe()==0) { // Echo various debugging options:
108     if (tcharm_nomig) CmiPrintf("TCHARM> Disabling migration support, for debugging\n");
109     if (tcharm_nothreads) CmiPrintf("TCHARM> Disabling thread support, for debugging\n");
110   }
111   if (CkpvAccess(mapCreated)==0) {
112     if (0!=CmiGetArgString(argv, "+mapping", &mapping)){
113     }
114     CkpvAccess(mapCreated)=1;
115   }
116 }
117
118 void TCHARM_Api_trace(const char *routineName,const char *libraryName)
119 {
120         if (!tcharm_tracelibs.isTracing(libraryName)) return;
121         TCharm *tc=CtvAccess(_curTCharm);
122         char where[100];
123         if (tc==NULL) sprintf(where,"[serial context on %d]",CkMyPe());
124         else sprintf(where,"[%p> vp %d, p %d]",(void *)tc,tc->getElement(),CkMyPe());
125         CmiPrintf("%s Called routine %s\n",where,routineName);
126         CmiPrintStackTrace(1);
127         CmiPrintf("\n");
128 }
129
130 // register thread start functions to get a function handler
131 // this is portable across heterogeneous platforms, or on machines with
132 // random stack/function pointer
133
134 static CkVec<TCHARM_Thread_data_start_fn> threadFnTable;
135
136 int TCHARM_Register_thread_function(TCHARM_Thread_data_start_fn fn)
137 {
138   int idx = threadFnTable.size();
139   threadFnTable.push_back(fn);
140   return idx+1;                     // make 0 invalid number
141 }
142
143 TCHARM_Thread_data_start_fn getTCharmThreadFunction(int idx)
144 {
145   CmiAssert(idx > 0);
146   return threadFnTable[idx-1];
147 }
148
149 static void startTCharmThread(TCharmInitMsg *msg)
150 {
151         DBGX("thread started");
152         TCharm::activateThread();
153        TCHARM_Thread_data_start_fn threadFn = getTCharmThreadFunction(msg->threadFn);
154         threadFn(msg->data);
155         TCharm::deactivateThread();
156         CtvAccess(_curTCharm)->done();
157 }
158
159 TCharm::TCharm(TCharmInitMsg *initMsg_)
160 {
161   initMsg=initMsg_;
162   initMsg->opts.sanityCheck();
163   timeOffset=0.0;
164   if (tcharm_nothreads)
165   { //Don't even make a new thread-- just use main thread
166     tid=CthSelf();
167   }
168   else /*Create a thread normally*/
169   {
170     if (tcharm_nomig) { /*Nonmigratable version, for debugging*/
171       tid=CthCreate((CthVoidFn)startTCharmThread,initMsg,initMsg->opts.stackSize);
172     } else {
173       tid=CthCreateMigratable((CthVoidFn)startTCharmThread,initMsg,initMsg->opts.stackSize);
174     }
175 #if CMK_BIGSIM_CHARM
176     BgAttach(tid);
177     BgUnsetStartOutOfCore();
178 #endif
179   }
180   threadGlobals=CtgCreate(tid);
181   CtvAccessOther(tid,_curTCharm)=this;
182   isStopped=true;
183   resumeAfterMigration=false;
184         /* FAULT_EVAC*/
185         AsyncEvacuate(CmiTrue);
186   skipResume=false;
187   exitWhenDone=initMsg->opts.exitWhenDone;
188   isSelfDone = false;
189   threadInfo.tProxy=CProxy_TCharm(thisArrayID);
190   threadInfo.thisElement=thisIndex;
191   threadInfo.numElements=initMsg->numElements;
192   if (1 || CmiMemoryIs(CMI_MEMORY_IS_ISOMALLOC)) {
193         heapBlocks=CmiIsomallocBlockListNew(tid);
194   } else
195         heapBlocks=0;
196   nUd=0;
197   usesAtSync=CmiTrue;
198   run();
199   CkCallback cb(CkIndex_TCharm::ResumeFromChkpSync(),thisProxy(thisIndex));
200   setChkpResumeClient(cb);
201 }
202
203 TCharm::TCharm(CkMigrateMessage *msg)
204         :CBase_TCharm(msg)
205 {
206   initMsg=NULL;
207   tid=NULL;
208   threadGlobals=NULL;
209   threadInfo.tProxy=CProxy_TCharm(thisArrayID);
210         AsyncEvacuate(CmiTrue);
211   heapBlocks=0;
212 }
213
214 void checkPupMismatch(PUP::er &p,int expected,const char *where)
215 {
216         int v=expected;
217         p|v;
218         if (v!=expected) {
219                 CkError("FATAL ERROR> Mismatch %s pup routine\n",where);
220                 CkAbort("FATAL ERROR: Pup direction mismatch");
221         }
222 }
223
224 void TCharm::pup(PUP::er &p) {
225 //Pup superclass
226   ArrayElement1D::pup(p);
227
228   //BIGSIM_OOC DEBUGGING
229   //if(!p.isUnpacking()){
230   //  CmiPrintf("TCharm[%d] packing: ", thisIndex);
231   //  CthPrintThdStack(tid);
232   //}
233
234   checkPupMismatch(p,5134,"before TCHARM");
235 #if (defined(_FAULT_MLOG_) || defined(_FAULT_CAUSAL_))
236     if(!isStopped){
237 //      resumeAfterMigration = true;
238     }
239     isStopped = true;
240 #endif
241   p(isStopped); p(resumeAfterMigration); p(exitWhenDone); p(isSelfDone); p(skipResume);
242   p(threadInfo.thisElement);
243   p(threadInfo.numElements);
244   
245   if (sema.size()>0){
246         CkAbort("TCharm::pup> Cannot migrate with unconsumed semaphores!\n");
247   }
248
249 #ifndef CMK_OPTIMIZE
250   DBG("Packing thread");
251   if (!isStopped && !CmiMemoryIs(CMI_MEMORY_IS_ISOMALLOC)){
252     if(_BgOutOfCoreFlag==0) //not doing out-of-core scheduling
253         CkAbort("Cannot pup a running thread.  You must suspend before migrating.\n");
254   }     
255   if (tcharm_nomig) CkAbort("Cannot migrate with the +tcharm_nomig option!\n");
256 #endif
257
258   //This seekBlock allows us to reorder the packing/unpacking--
259   // This is needed because the userData depends on the thread's stack
260   // and heap data both at pack and unpack time.
261   PUP::seekBlock s(p,2);
262   
263   if (p.isUnpacking())
264   {//In this case, unpack the thread & heap before the user data
265     s.seek(1);
266     pupThread(p);
267     //Restart our clock: set it up so packTime==CkWallTimer+timeOffset
268     double packTime;
269     p(packTime);
270     timeOffset=packTime-CkWallTimer();
271   }
272   
273 //Pack all user data
274   // Set up TCHARM context for use during user's pup routines:
275   CtvAccess(_curTCharm)=this;
276   activateThread();
277
278   s.seek(0);
279   checkPupMismatch(p,5135,"before TCHARM user data");
280   p(nUd);
281   for(int i=0;i<nUd;i++) {
282     if (p.isUnpacking()) ud[i].update(tid);
283     ud[i].pup(p);
284   }
285   checkPupMismatch(p,5137,"after TCHARM_Register user data");
286
287   if (CmiMemoryIs(CMI_MEMORY_IS_ISOMALLOC))
288     deactivateThread();
289   p|sud;           //  sud vector block can not be in isomalloc
290   checkPupMismatch(p,5138,"after TCHARM_Global user data");
291   
292   // Tear down TCHARM context after calling user pup routines
293   if (!CmiMemoryIs(CMI_MEMORY_IS_ISOMALLOC))
294     deactivateThread();
295   CtvAccess(_curTCharm)=NULL;
296   
297   if (!p.isUnpacking())
298   {//In this case, pack the thread & heap after the user data
299     s.seek(1);
300     pupThread(p);
301     //Stop our clock:
302     double packTime=CkWallTimer()+timeOffset;
303     p(packTime);
304   }
305   
306   s.endBlock(); //End of seeking block
307   checkPupMismatch(p,5140,"after TCHARM");
308   
309   //BIGSIM_OOC DEBUGGING
310   //if(p.isUnpacking()){
311   //  CmiPrintf("TCharm[%d] unpacking: ", thisIndex);
312   //  CthPrintThdStack(tid);
313   //}
314
315 }
316
317 // Pup our thread and related data
318 void TCharm::pupThread(PUP::er &pc) {
319     pup_er p=(pup_er)&pc;
320     checkPupMismatch(pc,5138,"before TCHARM thread");
321     if (1 || CmiMemoryIs(CMI_MEMORY_IS_ISOMALLOC))
322       CmiIsomallocBlockListPup(p,&heapBlocks,tid);
323     tid = CthPup(p, tid);
324     if (pc.isUnpacking()) {
325       CtvAccessOther(tid,_curTCharm)=this;
326 #if CMK_BIGSIM_CHARM
327       BgAttach(tid);
328 #endif
329     }
330     threadGlobals=CtgPup(p,threadGlobals);
331     checkPupMismatch(pc,5139,"after TCHARM thread");
332 }
333
334 //Pup one group of user data
335 void TCharm::UserData::pup(PUP::er &p)
336 {
337   pup_er pext=(pup_er)(&p);
338   p(mode);
339   switch(mode) {
340   case 'c': { /* C mode: userdata is on the stack, so keep address */
341 //     p((char*)&data,sizeof(data));
342      p(pos);
343      //FIXME: function pointers may not be valid across processors
344      p((char*)&cfn, sizeof(TCHARM_Pup_fn));
345      char *data = CthPointer(t, pos);
346      if (cfn) cfn(pext,data);
347      } break;
348   case 'g': { /* Global mode: zero out userdata on arrival */
349      if (CmiMemoryIs(CMI_MEMORY_IS_ISOMALLOC))
350      {
351         // keep the pointer value if using isomalloc, no need to use pup
352        p(pos);
353      }
354      else if (p.isUnpacking())      //  zero out userdata on arrival
355        pos=0;
356
357        //FIXME: function pointers may not be valid across processors
358      p((char*)&gfn, sizeof(TCHARM_Pup_global_fn));
359      if (gfn) gfn(pext);
360      } break;
361   default:
362      break;
363   };
364 }
365
366 TCharm::~TCharm()
367 {
368   //BIGSIM_OOC DEBUGGING
369   //CmiPrintf("TCharm destructor called with heapBlocks=%p!\n", heapBlocks);
370   
371 #if !CMK_USE_MEMPOOL_ISOMALLOC
372   if (heapBlocks) CmiIsomallocBlockListDelete(heapBlocks);
373 #endif
374   CthFree(tid);
375   CtgFree(threadGlobals);
376   delete initMsg;
377 }
378
379 void TCharm::migrateTo(int destPE) {
380         if (destPE==CkMyPe()) return;
381         if (CthMigratable() == 0) {
382             CkPrintf("Warning> thread migration is not supported!\n");
383             return;
384         }
385         // Make sure migrateMe gets called *after* we suspend:
386         thisProxy[thisIndex].migrateDelayed(destPE);
387 //      resumeAfterMigration=true;
388         suspend();
389 }
390 void TCharm::migrateDelayed(int destPE) {
391         migrateMe(destPE);
392 }
393 void TCharm::ckJustMigrated(void) {
394         ArrayElement::ckJustMigrated();
395 #if (defined(_FAULT_MLOG_) || defined(_FAULT_CAUSAL_))
396 //  resumeAfterMigration = true;
397 #endif
398         if (resumeAfterMigration) {
399                 resumeAfterMigration=false;
400                 resume(); //Start the thread running
401         }
402 }
403
404 void TCharm::ckJustRestored(void) {
405         //CkPrintf("call just restored from TCharm[%d]\n", thisIndex);
406         ArrayElement::ckJustRestored();
407         //if (resumeAfterMigration) {
408         //      resumeAfterMigration=false;
409         //      resume(); //Start the thread running
410         //}
411 }
412
413 /*
414         FAULT_EVAC
415
416         If a Tcharm object is about to migrate it should be suspended first
417 */
418 void TCharm::ckAboutToMigrate(void){
419         ArrayElement::ckAboutToMigrate();
420         resumeAfterMigration = true;
421         isStopped = true;
422 //      suspend();
423 }
424
425 // clear the data before restarting from disk
426 void TCharm::clear()
427 {
428   if (heapBlocks) CmiIsomallocBlockListDelete(heapBlocks);
429   CthFree(tid);
430   delete initMsg;
431 }
432
433 //Register user data to be packed with the thread
434 int TCharm::add(const TCharm::UserData &d)
435 {
436   if (nUd>=maxUserData)
437     CkAbort("TCharm: Registered too many user data fields!\n");
438   int nu=nUd++;
439   ud[nu]=d;
440   return nu;
441 }
442 void *TCharm::lookupUserData(int i) {
443         if (i<0 || i>=nUd)
444                 CkAbort("Bad user data index passed to TCharmGetUserdata!\n");
445         return ud[i].getData();
446 }
447
448 //Start the thread running
449 void TCharm::run(void)
450 {
451   DBG("TCharm::run()");
452   if (tcharm_nothreads) {/*Call user routine directly*/
453           startTCharmThread(initMsg);
454   } 
455   else /* start the thread as usual */
456           start();
457 }
458
459 //Block the thread until start()ed again.
460 void TCharm::stop(void)
461 {
462 #ifndef CMK_OPTIMIZE
463   if (tid != CthSelf())
464     CkAbort("Called TCharm::stop from outside TCharm thread!\n");
465   if (tcharm_nothreads)
466     CkAbort("Cannot make blocking calls using +tcharm_nothreads!\n");
467 #endif
468   stopTiming();
469   isStopped=true;
470   DBG("thread suspended");
471
472   CthSuspend();
473 //      DBG("thread resumed");
474   /*SUBTLE: We have to do the get() because "this" may have changed
475     during a migration-suspend.  If you access *any* members
476     from this point onward, you'll cause heap corruption if
477     we're resuming from migration!  (OSL 2003/9/23)
478    */
479   TCharm *dis=TCharm::get();
480 #if (defined(_FAULT_MLOG_) || defined(_FAULT_CAUSAL_)) 
481 /*  CpvAccess(_currentObj) = dis;
482  *      printf("[%d] _currentObject set to TCharm index %d %p\n",CkMyPe(),dis->thisIndex,dis);*/
483 #endif
484   dis->isStopped=false;
485   dis->startTiming();
486   //CkPrintf("[%d] Thread resumed  for tid %p\n",dis->thisIndex,dis->tid);
487 }
488
489 //Resume the waiting thread
490 void TCharm::start(void)
491 {
492   //  since this thread is scheduled, it is not a good idea to migrate 
493   isStopped=false;
494   DBG("thread resuming soon");
495   //CkPrintf("TCharm[%d]::start()\n", thisIndex);
496   //CmiPrintStackTrace(0);
497 #if (defined(_FAULT_MLOG_) || defined(_FAULT_CAUSAL_))
498 //CthAwakenPrio(tid, CQS_QUEUEING_BFIFO, 1, &prio);
499   CthAwaken(tid);
500 #else
501   CthAwaken(tid);
502 #endif
503   DBG("thread resuming soon");
504 }
505
506 //Block our thread, schedule, and come back:
507 void TCharm::schedule(void) {
508   DBG("thread schedule");
509   start(); // Calls CthAwaken
510   stop(); // Calls CthSuspend
511 }
512
513 //Go to sync, block, possibly migrate, and then resume
514 void TCharm::migrate(void)
515 {
516 #if CMK_LBDB_ON
517   DBG("going to sync");
518   AtSync();
519   stop();
520 #else
521   DBG("skipping sync, because there is no load balancer");
522 #endif
523 }
524
525
526 void TCharm::chkpsync(void)
527 {
528 #if CMK_LBDB_ON
529   DBG("going to sync");
530   AtChkpSync();
531   stop();
532 #else
533   DBG("skipping sync, because there is no load balancer");
534 #endif
535 }
536
537 void TCharm::evacuate(){
538         /*
539                 FAULT_EVAC
540         */
541         //CkClearAllArrayElementsCPP();
542         if(CkpvAccess(startedEvac)){
543 //              resumeAfterMigration=true;
544                 CcdCallFnAfter((CcdVoidFn)CkEmmigrateElement, (void *)myRec, 1);
545                 suspend();
546                 return;
547         }
548         return;
549
550 }
551
552 //calls atsync with async mode
553 void TCharm::async_migrate(void)
554 {
555 #if CMK_LBDB_ON
556   DBG("going to sync at async mode");
557   skipResume = true;            // we resume immediately
558   ReadyMigrate(false);
559   AtSync(0);
560   schedule();
561 //  allow_migrate();
562 #else
563   DBG("skipping sync, because there is no load balancer");
564 #endif
565 }
566
567 /*
568 Note:
569  thread can only migrate at the point when this is called
570 */
571 void TCharm::allow_migrate(void)
572 {
573 #if CMK_LBDB_ON
574 //  ReadyMigrate(true);
575   int nextPe = MigrateToPe();
576   if (nextPe != -1) {
577     migrateTo(nextPe);
578   }
579 #else
580   DBG("skipping sync, because there is no load balancer");
581 #endif
582 }
583
584 //Resume from sync: start the thread again
585 void TCharm::ResumeFromSync(void)
586 {
587   //if(isSelfDone) return;
588   //if (exitWhenDone) return; //for bigsim ooc execution
589   if (!skipResume) start();
590   CkPrintf("thread ResumeFromSync\n");
591 }
592
593 void TCharm::ResumeFromChkpSync(void)
594 {
595   start();
596 }
597
598 /****** TcharmClient ******/
599 void TCharmClient1D::ckJustMigrated(void) {
600   ArrayElement1D::ckJustMigrated();
601   findThread();
602   tcharmClientInit();
603 }
604
605 void TCharmClient1D::pup(PUP::er &p) {
606   ArrayElement1D::pup(p);
607   p|threadProxy;
608 }
609
610 CkArrayID TCHARM_Get_threads(void) {
611         TCHARMAPI("TCHARM_Get_threads");
612         return TCharm::get()->getProxy();
613 }
614
615 /************* Startup/Shutdown Coordination Support ************/
616
617 // Useless values to reduce over:
618 int _vals[2]={0,1};
619
620 //Called when we want to go to a barrier
621 void TCharm::barrier(void) {
622         //Contribute to a synchronizing reduction
623         CkCallback cb(index_t::atBarrier(0), thisProxy[0]);
624         contribute(sizeof(_vals),&_vals,CkReduction::sum_int,cb);
625 #if CMK_BIGSIM_CHARM
626         void *curLog;           // store current log in timeline
627         _TRACE_BG_TLINE_END(&curLog);
628         TRACE_BG_AMPI_BREAK(NULL, "TCharm_Barrier_START", NULL, 0, 1);
629 #endif
630         stop();
631 #if CMK_BIGSIM_CHARM
632          _TRACE_BG_SET_INFO(NULL, "TCHARM_Barrier_END",  &curLog, 1);
633 #endif
634 }
635
636 //Called when we've reached the barrier
637 void TCharm::atBarrier(CkReductionMsg *m) {
638         DBGX("clients all at barrier");
639         delete m;
640         thisProxy.start(); //Just restart everybody
641 }
642
643 //Called when the thread is done running
644 void TCharm::done(void) {
645         //CmiPrintStackTrace(0);
646         DBG("TCharm thread "<<thisIndex<<" done")
647         if (exitWhenDone) {
648                 //Contribute to a synchronizing reduction
649                 CkCallback cb(index_t::atExit(0), thisProxy[0]);
650                 contribute(sizeof(_vals),&_vals,CkReduction::sum_int,cb);
651         }
652         isSelfDone = true;
653         stop();
654 }
655 //Called when all threads are done running
656 void TCharm::atExit(CkReductionMsg *m) {
657         DBGX("TCharm::atExit1> exiting");
658         delete m;
659         //thisProxy.unsetFlags();
660         CkExit();
661         //CkPrintf("After CkExit()!!!!!!!\n");
662 }
663
664 /************* Setup **************/
665
666 //Globals used to control setup process
667 static TCHARM_Fallback_setup_fn g_fallbackSetup=NULL;
668 void TCHARM_Set_fallback_setup(TCHARM_Fallback_setup_fn f)
669 {
670         g_fallbackSetup=f;
671 }
672 void TCHARM_Call_fallback_setup(void) {
673         if (g_fallbackSetup) 
674                 (g_fallbackSetup)();
675         else
676                 CkAbort("TCHARM: Unexpected fallback setup--missing TCHARM_User_setup routine?");
677 }
678
679 /************** User API ***************/
680 /**********************************
681 Callable from UserSetup:
682 */
683
684 // Read the command line to figure out how many threads to create:
685 CDECL int TCHARM_Get_num_chunks(void)
686 {
687         TCHARMAPI("TCHARM_Get_num_chunks");
688         if (CkMyPe()!=0) CkAbort("TCHARM_Get_num_chunks should only be called on PE 0 during setup!");
689         int nChunks=CkNumPes();
690         char **argv=CkGetArgv();
691         CmiGetArgIntDesc(argv,"-vp",&nChunks,"Set the total number of virtual processors");
692         CmiGetArgIntDesc(argv,"+vp",&nChunks,NULL);
693         lastNumChunks=nChunks;
694         return nChunks;
695 }
696 FDECL int FTN_NAME(TCHARM_GET_NUM_CHUNKS,tcharm_get_num_chunks)(void)
697 {
698         return TCHARM_Get_num_chunks();
699 }
700
701 // Fill out the default thread options:
702 TCHARM_Thread_options::TCHARM_Thread_options(int doDefault)
703 {
704         stackSize=0; /* default stacksize */
705         exitWhenDone=0; /* don't exit when done by default. */
706 }
707 void TCHARM_Thread_options::sanityCheck(void) {
708         if (stackSize<=0) stackSize=tcharm_stacksize;
709 }
710
711
712 TCHARM_Thread_options g_tcharmOptions(1);
713
714 /*Set the size of the thread stack*/
715 CDECL void TCHARM_Set_stack_size(int newStackSize)
716 {
717         TCHARMAPI("TCHARM_Set_stack_size");
718         g_tcharmOptions.stackSize=newStackSize;
719 }
720 FDECL void FTN_NAME(TCHARM_SET_STACK_SIZE,tcharm_set_stack_size)
721         (int *newSize)
722 { TCHARM_Set_stack_size(*newSize); }
723
724 CDECL void TCHARM_Set_exit(void) { g_tcharmOptions.exitWhenDone=1; }
725
726 /*Create a new array of threads, which will be bound to by subsequent libraries*/
727 CDECL void TCHARM_Create(int nThreads,
728                         int threadFn)
729 {
730         TCHARMAPI("TCHARM_Create");
731         TCHARM_Create_data(nThreads,
732                          threadFn,NULL,0);
733 }
734 FDECL void FTN_NAME(TCHARM_CREATE,tcharm_create)
735         (int *nThreads,int threadFn)
736 { TCHARM_Create(*nThreads,threadFn); }
737
738 static CProxy_TCharm TCHARM_Build_threads(TCharmInitMsg *msg);
739
740 /*As above, but pass along (arbitrary) data to threads*/
741 CDECL void TCHARM_Create_data(int nThreads,
742                   int threadFn,
743                   void *threadData,int threadDataLen)
744 {
745         TCHARMAPI("TCHARM_Create_data");
746         TCharmInitMsg *msg=new (threadDataLen,0) TCharmInitMsg(
747                 threadFn,g_tcharmOptions);
748         msg->numElements=nThreads;
749         memcpy(msg->data,threadData,threadDataLen);
750         TCHARM_Build_threads(msg);
751         
752         // Reset the thread options:
753         g_tcharmOptions=TCHARM_Thread_options(1);
754 }
755
756 FDECL void FTN_NAME(TCHARM_CREATE_DATA,tcharm_create_data)
757         (int *nThreads,
758                   int threadFn,
759                   void *threadData,int *threadDataLen)
760 { TCHARM_Create_data(*nThreads,threadFn,threadData,*threadDataLen); }
761
762 CkGroupID CkCreatePropMap(void);
763
764 static CProxy_TCharm TCHARM_Build_threads(TCharmInitMsg *msg)
765 {
766   CkArrayOptions opts(msg->numElements);
767   CkAssert(CkpvAccess(mapCreated)==1);
768
769   if(haveConfigurableRRMap()){
770     CkPrintf("USING ConfigurableRRMap\n");
771     mapID=CProxy_ConfigurableRRMap::ckNew();
772   } else if(mapping==NULL){
773 #if CMK_BIGSIM_CHARM
774     mapID=CProxy_BlockMap::ckNew();
775 #else
776 #if __FAULT__
777         mapID=CProxy_RRMap::ckNew();
778 #else
779     mapID=CkCreatePropMap();
780 #endif
781 #endif
782   } else if(0 == strcmp(mapping,"BLOCK_MAP")) {
783     CkPrintf("USING BLOCK_MAP\n");
784     mapID = CProxy_BlockMap::ckNew();
785   } else if(0 == strcmp(mapping,"RR_MAP")) {
786     CkPrintf("USING RR_MAP\n");
787     mapID = CProxy_RRMap::ckNew();
788   } else if(0 == strcmp(mapping,"MAPFILE")) {
789     CkPrintf("Reading map from file\n");
790     mapID = CProxy_ReadFileMap::ckNew();
791   } else {  // "PROP_MAP" or anything else
792     mapID = CkCreatePropMap();
793   }
794   opts.setMap(mapID);
795   return CProxy_TCharm::ckNew(msg,opts);
796 }
797
798 // Helper used when creating a new array bound to the TCHARM threads:
799 CkArrayOptions TCHARM_Attach_start(CkArrayID *retTCharmArray,int *retNumElts)
800 {
801         TCharm *tc=TCharm::get();
802         if (!tc)
803                 CkAbort("You must call TCHARM initialization routines from a TCHARM thread!");
804         int nElts=tc->getNumElements();
805       
806         //CmiPrintf("TCHARM Elements = %d\n", nElts);  
807       
808         if (retNumElts!=NULL) *retNumElts=nElts;
809         *retTCharmArray=tc->getProxy();
810         CkArrayOptions opts(nElts);
811         opts.bindTo(tc->getProxy());
812         return opts;
813 }
814
815 void TCHARM_Suspend(void) {
816         TCharm *tc=TCharm::get();
817         tc->suspend();
818 }
819
820 /***********************************
821 Callable from worker thread
822 */
823 CDECL int TCHARM_Element(void)
824
825         TCHARMAPI("TCHARM_Element");
826         return TCharm::get()->getElement();
827 }
828 CDECL int TCHARM_Num_elements(void)
829
830         TCHARMAPI("TCHARM_Num_elements");
831         return TCharm::get()->getNumElements();
832 }
833
834 FDECL int FTN_NAME(TCHARM_ELEMENT,tcharm_element)(void) 
835 { return TCHARM_Element();}
836 FDECL int FTN_NAME(TCHARM_NUM_ELEMENTS,tcharm_num_elements)(void) 
837 { return TCHARM_Num_elements();}
838
839 //Make sure this address will migrate with us when we move:
840 static void checkAddress(void *data)
841 {
842         if (tcharm_nomig||tcharm_nothreads) return; //Stack is not isomalloc'd
843         if (CmiThreadIs(CMI_THREAD_IS_ALIAS)||CmiThreadIs(CMI_THREAD_IS_STACKCOPY)) return; // memory alias thread
844         if (CmiIsomallocEnabled()) {
845           if (!CmiIsomallocInRange(data))
846             CkAbort("The UserData you register must be allocated on the stack!\n");
847         }
848         else {
849           if(CkMyPe() == 0)
850             CkPrintf("Warning> checkAddress failed because isomalloc not supported.\n");
851         }
852 }
853
854 /* Old "register"-based userdata: */
855 CDECL int TCHARM_Register(void *data,TCHARM_Pup_fn pfn)
856
857         TCHARMAPI("TCHARM_Register");
858         checkAddress(data);
859         return TCharm::get()->add(TCharm::UserData(pfn,TCharm::get()->getThread(),data));
860 }
861 FDECL int FTN_NAME(TCHARM_REGISTER,tcharm_register)
862         (void *data,TCHARM_Pup_fn pfn)
863
864         TCHARMAPI("TCHARM_Register");
865         checkAddress(data);
866         return TCharm::get()->add(TCharm::UserData(pfn,TCharm::get()->getThread(),data));
867 }
868
869 CDECL void *TCHARM_Get_userdata(int id)
870 {
871         TCHARMAPI("TCHARM_Get_userdata");
872         return TCharm::get()->lookupUserData(id);
873 }
874 FDECL void *FTN_NAME(TCHARM_GET_USERDATA,tcharm_get_userdata)(int *id)
875 { return TCHARM_Get_userdata(*id); }
876
877 /* New hardcoded-ID userdata: */
878 CDECL void TCHARM_Set_global(int globalID,void *new_value,TCHARM_Pup_global_fn pup_or_NULL)
879 {
880         TCHARMAPI("TCHARM_Set_global");
881         TCharm *tc=TCharm::get();
882         if (tc->sud.length()<=globalID)
883         { //We don't have room for this ID yet: make room
884                 int newLen=2*globalID;
885                 tc->sud.resize(newLen);
886         }
887         tc->sud[globalID]=TCharm::UserData(pup_or_NULL,tc->getThread(),new_value);
888 }
889 CDECL void *TCHARM_Get_global(int globalID)
890 {
891         //Skip TCHARMAPI("TCHARM_Get_global") because there's no dynamic allocation here,
892         // and this routine should be as fast as possible.
893         CkVec<TCharm::UserData> &v=TCharm::get()->sud;
894         if (v.length()<=globalID) return NULL; //Uninitialized global
895         return v[globalID].getData();
896 }
897
898 CDECL void TCHARM_Migrate(void)
899 {
900         TCHARMAPI("TCHARM_Migrate");
901         if (CthMigratable() == 0) {
902           if(CkMyPe() == 0)
903             CkPrintf("Warning> thread migration is not supported!\n");
904           return;
905         }
906         TCharm::get()->migrate();
907 }
908
909 CDECL void TCHARM_ChkpSync(void)
910 {
911         TCHARMAPI("TCHARM_ChkpSync");
912         if (CthMigratable() == 0) {
913           if(CkMyPe() == 0)
914             CkPrintf("Warning> thread migration is not supported!\n");
915           return;
916         }
917         TCharm::get()->chkpsync();
918 }
919
920 FORTRAN_AS_C(TCHARM_MIGRATE,TCHARM_Migrate,tcharm_migrate,(void),())
921 FORTRAN_AS_C(TCHARM_CHKPSYNC,TCHARM_ChkpSync,tcharm_chkpsync,(void),())
922
923 CDECL void TCHARM_Async_Migrate(void)
924 {
925         TCHARMAPI("TCHARM_Async_Migrate");
926         TCharm::get()->async_migrate();
927 }
928 FORTRAN_AS_C(TCHARM_ASYNC_MIGRATE,TCHARM_Async_Migrate,tcharm_async_migrate,(void),())
929
930 CDECL void TCHARM_Allow_Migrate(void)
931 {
932         TCHARMAPI("TCHARM_Allow_Migrate");
933         TCharm::get()->allow_migrate();
934 }
935 FORTRAN_AS_C(TCHARM_ALLOW_MIGRATE,TCHARM_Allow_Migrate,tcharm_allow_migrate,(void),())
936
937 CDECL void TCHARM_Migrate_to(int destPE)
938 {
939         TCHARMAPI("TCHARM_Migrate_to");
940         TCharm::get()->migrateTo(destPE);
941 }
942
943 CDECL void TCHARM_Evacuate()
944 {
945         TCHARMAPI("TCHARM_Migrate_to");
946         TCharm::get()->evacuate();
947 }
948
949 FORTRAN_AS_C(TCHARM_MIGRATE_TO,TCHARM_Migrate_to,tcharm_migrate_to,
950         (int *destPE),(*destPE))
951
952 CDECL void TCHARM_Yield(void)
953 {
954         TCHARMAPI("TCHARM_Yield");
955         TCharm::get()->schedule();
956 }
957 FORTRAN_AS_C(TCHARM_YIELD,TCHARM_Yield,tcharm_yield,(void),())
958
959 CDECL void TCHARM_Barrier(void)
960 {
961         TCHARMAPI("TCHARM_Barrier");
962         TCharm::get()->barrier();
963 }
964 FORTRAN_AS_C(TCHARM_BARRIER,TCHARM_Barrier,tcharm_barrier,(void),())
965
966 CDECL void TCHARM_Done(void)
967 {
968         TCHARMAPI("TCHARM_Done");
969         TCharm *c=TCharm::getNULL();
970         if (!c) CkExit();
971         else c->done();
972 }
973 FORTRAN_AS_C(TCHARM_DONE,TCHARM_Done,tcharm_done,(void),())
974
975
976 CDECL double TCHARM_Wall_timer(void)
977 {
978   TCHARMAPI("TCHARM_Wall_timer");
979   TCharm *c=TCharm::getNULL();
980   if(!c) return CkWallTimer();
981   else { //Have to apply current thread's time offset
982     return CkWallTimer()+c->getTimeOffset();
983   }
984 }
985
986 #if 1
987 /*Include Fortran-style "iargc" and "getarg" routines.
988 These are needed to get access to the command-line arguments from Fortran.
989 */
990 FDECL int FTN_NAME(TCHARM_IARGC,tcharm_iargc)(void) {
991   TCHARMAPI("tcharm_iargc");
992   return CkGetArgc()-1;
993 }
994
995 FDECL void FTN_NAME(TCHARM_GETARG,tcharm_getarg)
996         (int *i_p,char *dest,int destLen)
997 {
998   TCHARMAPI("tcharm_getarg");
999   int i=*i_p;
1000   if (i<0) CkAbort("tcharm_getarg called with negative argument!");
1001   if (i>=CkGetArgc()) CkAbort("tcharm_getarg called with argument > iargc!");
1002   const char *src=CkGetArgv()[i];
1003   strcpy(dest,src);
1004   for (i=strlen(dest);i<destLen;i++) dest[i]=' ';
1005 }
1006
1007 #endif
1008
1009 //These silly routines are used for serial startup:
1010 extern void _initCharm(int argc, char **argv);
1011 CDECL void TCHARM_Init(int *argc,char ***argv) {
1012         if (!tcharm_initted) {
1013           ConverseInit(*argc, *argv, (CmiStartFn) _initCharm,1,1);
1014           _initCharm(*argc,*argv);
1015         }
1016 }
1017
1018 FDECL void FTN_NAME(TCHARM_INIT,tcharm_init)(void)
1019 {
1020         int argc=1;
1021         const char *argv_sto[2]={"foo",NULL};
1022         char **argv=(char **)argv_sto;
1023         TCHARM_Init(&argc,&argv);
1024 }
1025
1026 /***********************************
1027 * TCHARM Semaphores:
1028 * The idea is one side "puts", the other side "gets"; 
1029 * but the calls can come in any order--
1030 * if the "get" comes first, it blocks until the put.
1031 * This makes a convenient, race-condition-free way to do
1032 * onetime initializations.  
1033 */
1034 /// Find this semaphore, or insert if there isn't one:
1035 TCharm::TCharmSemaphore *TCharm::findSema(int id) {
1036         for (unsigned int s=0;s<sema.size();s++)
1037                 if (sema[s].id==id) 
1038                         return &sema[s];
1039         sema.push_back(TCharmSemaphore(id));
1040         return &sema[sema.size()-1];
1041 }
1042 /// Remove this semaphore from the list
1043 void TCharm::freeSema(TCharmSemaphore *doomed) {
1044         int id=doomed->id;
1045         for (unsigned int s=0;s<sema.size();s++)
1046                 if (sema[s].id==id) {
1047                         sema[s]=sema[sema.length()-1];
1048                         sema.length()--;
1049                         return;
1050                 }
1051         CkAbort("Tried to free nonexistent TCharm semaphore");
1052 }
1053
1054 /// Block until this semaphore has data:
1055 TCharm::TCharmSemaphore *TCharm::getSema(int id) {
1056         TCharmSemaphore *s=findSema(id);
1057         if (s->data==NULL) 
1058         { //Semaphore isn't filled yet: wait until it is
1059                 s->thread=CthSelf();
1060                 suspend(); //Will be woken by semaPut
1061                 // Semaphore may have moved-- find it again
1062                 s=findSema(id);
1063                 if (s->data==NULL) CkAbort("TCharm::semaGet awoken too early!");
1064         }
1065         return s;
1066 }
1067
1068 /// Store data at the semaphore "id".
1069 ///  The put can come before or after the get.
1070 void TCharm::semaPut(int id,void *data) {
1071         TCharmSemaphore *s=findSema(id);
1072         if (s->data!=NULL) CkAbort("Duplicate calls to TCharm::semaPut!");
1073         s->data=data;
1074         DBG("semaPut "<<id<<" "<<data);
1075         if (s->thread!=NULL) {//Awaken the thread
1076                 s->thread=NULL;
1077                 resume();
1078         }
1079 }
1080
1081 /// Retreive data from the semaphore "id".
1082 ///  Blocks if the data is not immediately available.
1083 ///  Consumes the data, so another put will be required for the next get.
1084 void *TCharm::semaGet(int id) {
1085         TCharmSemaphore *s=getSema(id);
1086         void *ret=s->data;
1087         DBG("semaGet "<<id<<" "<<ret);
1088         // Now remove the semaphore from the list:
1089         freeSema(s);
1090         return ret;
1091 }
1092
1093 /// Retreive data from the semaphore "id".
1094 ///  Blocks if the data is not immediately available.
1095 void *TCharm::semaGets(int id) {
1096         TCharmSemaphore *s=getSema(id);
1097         return s->data;
1098 }
1099
1100 /// Retreive data from the semaphore "id", or returns NULL.
1101 void *TCharm::semaPeek(int id) {
1102         TCharmSemaphore *s=findSema(id);
1103         return s->data;
1104 }
1105
1106 /****** System Call support ******/
1107 /*
1108 TCHARM_System exists to work around a bug where Linux ia32
1109 glibc2.2.x with pthreads crashes at the fork() site when 
1110 called from a user-levelthread. 
1111
1112 The fix is to call system from the main thread, by 
1113 passing the request out of the thread to our array element 
1114 before calling system().
1115 */
1116
1117 CDECL int 
1118 TCHARM_System(const char *shell_command)
1119 {
1120         return TCharm::get()->system(shell_command);
1121 }
1122 int TCharm::system(const char *cmd)
1123 {
1124         int ret=-1778;
1125         callSystemStruct s;
1126         s.cmd=cmd;
1127         s.ret=&ret;
1128         thisProxy[thisIndex].callSystem(s);
1129         suspend();
1130         return ret;
1131 }
1132
1133 void TCharm::callSystem(const callSystemStruct &s)
1134 {
1135         *s.ret = ::system(s.cmd);
1136         resume();
1137 }
1138
1139
1140
1141 #include "tcharm.def.h"