changed global variable namd vals to _vals to skip swapglobals
[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 #ifdef _FAULT_MLOG_
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 #ifdef _FAULT_MLOG_
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 #ifdef _FAULT_MLOG_ 
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 #ifdef _FAULT_MLOG_
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{  // "PROP_MAP" or anything else
756     mapID=CkCreatePropMap();
757   }
758   opts.setMap(mapID);
759   int nElem=msg->numElements; //<- save it because msg will be deleted.
760   return CProxy_TCharm::ckNew(msg,opts);
761 }
762
763 // Helper used when creating a new array bound to the TCHARM threads:
764 CkArrayOptions TCHARM_Attach_start(CkArrayID *retTCharmArray,int *retNumElts)
765 {
766         TCharm *tc=TCharm::get();
767         if (!tc)
768                 CkAbort("You must call TCHARM initialization routines from a TCHARM thread!");
769         int nElts=tc->getNumElements();
770       
771         //CmiPrintf("TCHARM Elements = %d\n", nElts);  
772       
773         if (retNumElts!=NULL) *retNumElts=nElts;
774         *retTCharmArray=tc->getProxy();
775         CkArrayOptions opts(nElts);
776         opts.bindTo(tc->getProxy());
777         return opts;
778 }
779
780 void TCHARM_Suspend(void) {
781         TCharm *tc=TCharm::get();
782         tc->suspend();
783 }
784
785 /***********************************
786 Callable from worker thread
787 */
788 CDECL int TCHARM_Element(void)
789
790         TCHARMAPI("TCHARM_Element");
791         return TCharm::get()->getElement();
792 }
793 CDECL int TCHARM_Num_elements(void)
794
795         TCHARMAPI("TCHARM_Num_elements");
796         return TCharm::get()->getNumElements();
797 }
798
799 FDECL int FTN_NAME(TCHARM_ELEMENT,tcharm_element)(void) 
800 { return TCHARM_Element();}
801 FDECL int FTN_NAME(TCHARM_NUM_ELEMENTS,tcharm_num_elements)(void) 
802 { return TCHARM_Num_elements();}
803
804 //Make sure this address will migrate with us when we move:
805 static void checkAddress(void *data)
806 {
807         if (tcharm_nomig||tcharm_nothreads) return; //Stack is not isomalloc'd
808         if (CmiThreadIs(CMI_THREAD_IS_ALIAS)||CmiThreadIs(CMI_THREAD_IS_STACKCOPY)) return; // memory alias thread
809         if (CmiIsomallocEnabled()) {
810           if (!CmiIsomallocInRange(data))
811             CkAbort("The UserData you register must be allocated on the stack!\n");
812         }
813         else {
814           if(CkMyPe() == 0)
815             CkPrintf("Warning> checkAddress failed because isomalloc not supported.\n");
816         }
817 }
818
819 /* Old "register"-based userdata: */
820 CDECL int TCHARM_Register(void *data,TCHARM_Pup_fn pfn)
821
822         TCHARMAPI("TCHARM_Register");
823         checkAddress(data);
824         return TCharm::get()->add(TCharm::UserData(pfn,TCharm::get()->getThread(),data));
825 }
826 FDECL int FTN_NAME(TCHARM_REGISTER,tcharm_register)
827         (void *data,TCHARM_Pup_fn pfn)
828
829         TCHARMAPI("TCHARM_Register");
830         checkAddress(data);
831         return TCharm::get()->add(TCharm::UserData(pfn,TCharm::get()->getThread(),data));
832 }
833
834 CDECL void *TCHARM_Get_userdata(int id)
835 {
836         TCHARMAPI("TCHARM_Get_userdata");
837         return TCharm::get()->lookupUserData(id);
838 }
839 FDECL void *FTN_NAME(TCHARM_GET_USERDATA,tcharm_get_userdata)(int *id)
840 { return TCHARM_Get_userdata(*id); }
841
842 /* New hardcoded-ID userdata: */
843 CDECL void TCHARM_Set_global(int globalID,void *new_value,TCHARM_Pup_global_fn pup_or_NULL)
844 {
845         TCHARMAPI("TCHARM_Set_global");
846         TCharm *tc=TCharm::get();
847         if (tc->sud.length()<=globalID)
848         { //We don't have room for this ID yet: make room
849                 int newLen=2*globalID;
850                 tc->sud.resize(newLen);
851         }
852         tc->sud[globalID]=TCharm::UserData(pup_or_NULL,tc->getThread(),new_value);
853 }
854 CDECL void *TCHARM_Get_global(int globalID)
855 {
856         //Skip TCHARMAPI("TCHARM_Get_global") because there's no dynamic allocation here,
857         // and this routine should be as fast as possible.
858         CkVec<TCharm::UserData> &v=TCharm::get()->sud;
859         if (v.length()<=globalID) return NULL; //Uninitialized global
860         return v[globalID].getData();
861 }
862
863 CDECL void TCHARM_Migrate(void)
864 {
865         TCHARMAPI("TCHARM_Migrate");
866         if (CthMigratable() == 0) {
867           if(CkMyPe() == 0)
868             CkPrintf("Warning> thread migration is not supported!\n");
869           return;
870         }
871         TCharm::get()->migrate();
872 }
873 FORTRAN_AS_C(TCHARM_MIGRATE,TCHARM_Migrate,tcharm_migrate,(void),())
874
875 CDECL void TCHARM_Async_Migrate(void)
876 {
877         TCHARMAPI("TCHARM_Async_Migrate");
878         TCharm::get()->async_migrate();
879 }
880 FORTRAN_AS_C(TCHARM_ASYNC_MIGRATE,TCHARM_Async_Migrate,tcharm_async_migrate,(void),())
881
882 CDECL void TCHARM_Allow_Migrate(void)
883 {
884         TCHARMAPI("TCHARM_Allow_Migrate");
885         TCharm::get()->allow_migrate();
886 }
887 FORTRAN_AS_C(TCHARM_ALLOW_MIGRATE,TCHARM_Allow_Migrate,tcharm_allow_migrate,(void),())
888
889 CDECL void TCHARM_Migrate_to(int destPE)
890 {
891         TCHARMAPI("TCHARM_Migrate_to");
892         TCharm::get()->migrateTo(destPE);
893 }
894
895 CDECL void TCHARM_Evacuate()
896 {
897         TCHARMAPI("TCHARM_Migrate_to");
898         TCharm::get()->evacuate();
899 }
900
901 FORTRAN_AS_C(TCHARM_MIGRATE_TO,TCHARM_Migrate_to,tcharm_migrate_to,
902         (int *destPE),(*destPE))
903
904 CDECL void TCHARM_Yield(void)
905 {
906         TCHARMAPI("TCHARM_Yield");
907         TCharm::get()->schedule();
908 }
909 FORTRAN_AS_C(TCHARM_YIELD,TCHARM_Yield,tcharm_yield,(void),())
910
911 CDECL void TCHARM_Barrier(void)
912 {
913         TCHARMAPI("TCHARM_Barrier");
914         TCharm::get()->barrier();
915 }
916 FORTRAN_AS_C(TCHARM_BARRIER,TCHARM_Barrier,tcharm_barrier,(void),())
917
918 CDECL void TCHARM_Done(void)
919 {
920         TCHARMAPI("TCHARM_Done");
921         TCharm *c=TCharm::getNULL();
922         if (!c) CkExit();
923         else c->done();
924 }
925 FORTRAN_AS_C(TCHARM_DONE,TCHARM_Done,tcharm_done,(void),())
926
927
928 CDECL double TCHARM_Wall_timer(void)
929 {
930   TCHARMAPI("TCHARM_Wall_timer");
931   TCharm *c=TCharm::getNULL();
932   if(!c) return CkWallTimer();
933   else { //Have to apply current thread's time offset
934     return CkWallTimer()+c->getTimeOffset();
935   }
936 }
937
938 #if 1
939 /*Include Fortran-style "iargc" and "getarg" routines.
940 These are needed to get access to the command-line arguments from Fortran.
941 */
942 FDECL int FTN_NAME(TCHARM_IARGC,tcharm_iargc)(void) {
943   TCHARMAPI("tcharm_iargc");
944   return CkGetArgc()-1;
945 }
946
947 FDECL void FTN_NAME(TCHARM_GETARG,tcharm_getarg)
948         (int *i_p,char *dest,int destLen)
949 {
950   TCHARMAPI("tcharm_getarg");
951   int i=*i_p;
952   if (i<0) CkAbort("tcharm_getarg called with negative argument!");
953   if (i>=CkGetArgc()) CkAbort("tcharm_getarg called with argument > iargc!");
954   const char *src=CkGetArgv()[i];
955   strcpy(dest,src);
956   for (i=strlen(dest);i<destLen;i++) dest[i]=' ';
957 }
958
959 #endif
960
961 //These silly routines are used for serial startup:
962 extern void _initCharm(int argc, char **argv);
963 CDECL void TCHARM_Init(int *argc,char ***argv) {
964         if (!tcharm_initted) {
965           ConverseInit(*argc, *argv, (CmiStartFn) _initCharm,1,1);
966           _initCharm(*argc,*argv);
967         }
968 }
969
970 FDECL void FTN_NAME(TCHARM_INIT,tcharm_init)(void)
971 {
972         int argc=1;
973         const char *argv_sto[2]={"foo",NULL};
974         char **argv=(char **)argv_sto;
975         TCHARM_Init(&argc,&argv);
976 }
977
978 /***********************************
979 * TCHARM Semaphores:
980 * The idea is one side "puts", the other side "gets"; 
981 * but the calls can come in any order--
982 * if the "get" comes first, it blocks until the put.
983 * This makes a convenient, race-condition-free way to do
984 * onetime initializations.  
985 */
986 /// Find this semaphore, or insert if there isn't one:
987 TCharm::TCharmSemaphore *TCharm::findSema(int id) {
988         for (int s=0;s<sema.size();s++)
989                 if (sema[s].id==id) 
990                         return &sema[s];
991         sema.push_back(TCharmSemaphore(id));
992         return &sema[sema.size()-1];
993 }
994 /// Remove this semaphore from the list
995 void TCharm::freeSema(TCharmSemaphore *doomed) {
996         int id=doomed->id;
997         for (int s=0;s<sema.size();s++)
998                 if (sema[s].id==id) {
999                         sema[s]=sema[sema.length()-1];
1000                         sema.length()--;
1001                         return;
1002                 }
1003         CkAbort("Tried to free nonexistent TCharm semaphore");
1004 }
1005
1006 /// Block until this semaphore has data:
1007 TCharm::TCharmSemaphore *TCharm::getSema(int id) {
1008         TCharmSemaphore *s=findSema(id);
1009         if (s->data==NULL) 
1010         { //Semaphore isn't filled yet: wait until it is
1011                 s->thread=CthSelf();
1012                 suspend(); //Will be woken by semaPut
1013                 // Semaphore may have moved-- find it again
1014                 s=findSema(id);
1015                 if (s->data==NULL) CkAbort("TCharm::semaGet awoken too early!");
1016         }
1017         return s;
1018 }
1019
1020 /// Store data at the semaphore "id".
1021 ///  The put can come before or after the get.
1022 void TCharm::semaPut(int id,void *data) {
1023         TCharmSemaphore *s=findSema(id);
1024         if (s->data!=NULL) CkAbort("Duplicate calls to TCharm::semaPut!");
1025         s->data=data;
1026         DBG("semaPut "<<id<<" "<<data);
1027         if (s->thread!=NULL) {//Awaken the thread
1028                 s->thread=NULL;
1029                 resume();
1030         }
1031 }
1032
1033 /// Retreive data from the semaphore "id".
1034 ///  Blocks if the data is not immediately available.
1035 ///  Consumes the data, so another put will be required for the next get.
1036 void *TCharm::semaGet(int id) {
1037         TCharmSemaphore *s=getSema(id);
1038         void *ret=s->data;
1039         DBG("semaGet "<<id<<" "<<ret);
1040         // Now remove the semaphore from the list:
1041         freeSema(s);
1042         return ret;
1043 }
1044
1045 /// Retreive data from the semaphore "id".
1046 ///  Blocks if the data is not immediately available.
1047 void *TCharm::semaGets(int id) {
1048         TCharmSemaphore *s=getSema(id);
1049         return s->data;
1050 }
1051
1052 /// Retreive data from the semaphore "id", or returns NULL.
1053 void *TCharm::semaPeek(int id) {
1054         TCharmSemaphore *s=findSema(id);
1055         return s->data;
1056 }
1057
1058 /****** System Call support ******/
1059 /*
1060 TCHARM_System exists to work around a bug where Linux ia32
1061 glibc2.2.x with pthreads crashes at the fork() site when 
1062 called from a user-levelthread. 
1063
1064 The fix is to call system from the main thread, by 
1065 passing the request out of the thread to our array element 
1066 before calling system().
1067 */
1068
1069 CDECL int 
1070 TCHARM_System(const char *shell_command)
1071 {
1072         return TCharm::get()->system(shell_command);
1073 }
1074 int TCharm::system(const char *cmd)
1075 {
1076         int ret=-1778;
1077         callSystemStruct s;
1078         s.cmd=cmd;
1079         s.ret=&ret;
1080         thisProxy[thisIndex].callSystem(s);
1081         suspend();
1082         return ret;
1083 }
1084
1085 void TCharm::callSystem(const callSystemStruct &s)
1086 {
1087         *s.ret = ::system(s.cmd);
1088         resume();
1089 }
1090
1091
1092
1093 #include "tcharm.def.h"