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