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