Bug fix: zero out "TCHARM_Global" user data after migration.
[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 <ctype.h>
9
10 #if 0
11     /*Many debugging statements:*/
12 #    define DBG(x) ckout<<"["<<thisIndex<<"] TCHARM> "<<x<<endl;
13 #    define DBGX(x) ckout<<"PE("<<CkMyPe()<<") TCHARM> "<<x<<endl;
14 #else
15     /*No debugging statements*/
16 #    define DBG(x) /*empty*/
17 #    define DBGX(x) /*empty*/
18 #endif
19
20 CtvDeclare(TCharm *,_curTCharm);
21
22 static int lastNumChunks=0;
23
24 class TCharmTraceLibList {
25         enum {maxLibs=20,maxLibNameLen=15};
26         //List of libraries we want to trace:
27         int curLibs;
28         char libNames[maxLibs][maxLibNameLen];
29         int checkIfTracing(const char *lib) const
30         {
31                 for (int i=0;i<curLibs;i++) 
32                         if (0==strcmp(lib,libNames[i]))
33                                 return 1;
34                 return 0;
35         }
36 public:
37         TCharmTraceLibList() {curLibs=0;}
38         void addTracing(const char *lib) 
39         { //We want to trace this library-- add its name to the list.
40                 CkPrintf("TCHARM> Will trace calls to library %s\n",lib);
41                 int i;
42                 for (i=0;0!=*lib;i++,lib++)
43                         libNames[curLibs][i]=tolower(*lib);
44                 libNames[curLibs][i]=0;
45                 // if already tracing, skip
46                 if (checkIfTracing(libNames[curLibs])) return;
47                 curLibs++;
48         }
49         inline int isTracing(const char *lib) const {
50                 if (curLibs==0) return 0; //Common case
51                 else return checkIfTracing(lib);
52         }
53 };
54 static TCharmTraceLibList tcharm_tracelibs;
55 static int tcharm_nomig=0, tcharm_nothreads=0;
56 static int tcharm_stacksize=1*1024*1024; /*Default stack size is 1MB*/
57 static int tcharm_initted=0;
58
59 void TCharm::nodeInit(void)
60 {
61 }
62
63 void TCharm::procInit(void)
64 {
65   CtvInitialize(TCharm *,_curTCharm);
66   CtvAccess(_curTCharm)=NULL;
67   tcharm_initted=1;
68   CtgInit();
69
70   // called on every pe to eat these arguments
71   char **argv=CkGetArgv();
72   tcharm_nomig=CmiGetArgFlagDesc(argv,"+tcharm_nomig","Disable migration support (debugging)");
73   tcharm_nothreads=CmiGetArgFlagDesc(argv,"+tcharm_nothread","Disable thread support (debugging)");
74   tcharm_nothreads|=CmiGetArgFlagDesc(argv,"+tcharm_nothreads",NULL);
75   char *traceLibName=NULL;
76   while (CmiGetArgStringDesc(argv,"+tcharm_trace",&traceLibName,"Print each call to this library"))
77       tcharm_tracelibs.addTracing(traceLibName);
78   CmiGetArgIntDesc(argv,"+tcharm_stacksize",&tcharm_stacksize,"Set the thread stack size (default 1MB)");
79   if (CkMyPe()!=0) { //Processor 0 eats "+vp<N>" and "-vp<N>" later:
80         int ignored;
81         while (CmiGetArgIntDesc(argv,"-vp",&ignored,NULL)) {}
82         while (CmiGetArgIntDesc(argv,"+vp",&ignored,NULL)) {}
83   }
84   if (CkMyPe()==0) { // Echo various debugging options:
85     if (tcharm_nomig) CmiPrintf("TCHARM> Disabling migration support, for debugging\n");
86     if (tcharm_nothreads) CmiPrintf("TCHARM> Disabling thread support, for debugging\n");
87   }
88 }
89
90 void TCHARM_Api_trace(const char *routineName,const char *libraryName)
91 {
92         if (!tcharm_tracelibs.isTracing(libraryName)) return;
93         TCharm *tc=CtvAccess(_curTCharm);
94         char where[100];
95         if (tc==NULL) sprintf(where,"[serial context on %d]",CkMyPe());
96         else sprintf(where,"[%p> vp %d, p %d]",(void *)tc,tc->getElement(),CkMyPe());
97         CmiPrintf("%s Called routine %s\n",where,routineName);
98         CmiPrintStackTrace(1);
99         CmiPrintf("\n");
100 }
101
102 static void startTCharmThread(TCharmInitMsg *msg)
103 {
104         DBGX("thread started");
105         TCharm::activateThread();
106         typedef void (*threadFn_t)(void *);
107         ((threadFn_t)msg->threadFn)(msg->data);
108         TCharm::deactivateThread();
109         CtvAccess(_curTCharm)->done();
110 }
111
112 TCharm::TCharm(TCharmInitMsg *initMsg_)
113 {
114   initMsg=initMsg_;
115   initMsg->opts.sanityCheck();
116   timeOffset=0.0;
117   threadGlobals=CtgCreate();
118   if (tcharm_nothreads)
119   { //Don't even make a new thread-- just use main thread
120     tid=CthSelf();
121   }
122   else /*Create a thread normally*/
123   {
124     if (tcharm_nomig) { /*Nonmigratable version, for debugging*/
125       tid=CthCreate((CthVoidFn)startTCharmThread,initMsg,initMsg->opts.stackSize);
126     } else {
127       tid=CthCreateMigratable((CthVoidFn)startTCharmThread,initMsg,initMsg->opts.stackSize);
128     }
129 #if CMK_BLUEGENE_CHARM
130     BgAttach(tid);
131 #endif
132   }
133   CtvAccessOther(tid,_curTCharm)=this;
134   isStopped=true;
135   resumeAfterMigration=false;
136   exitWhenDone=initMsg->opts.exitWhenDone;
137   threadInfo.tProxy=CProxy_TCharm(thisArrayID);
138   threadInfo.thisElement=thisIndex;
139   threadInfo.numElements=initMsg->numElements;
140   heapBlocks=CmiIsomallocBlockListNew();
141   nUd=0;
142   usesAtSync=CmiTrue;
143   run();
144 }
145
146 TCharm::TCharm(CkMigrateMessage *msg)
147         :CBase_TCharm(msg)
148 {
149   initMsg=NULL;
150   tid=NULL;
151   threadGlobals=NULL;
152   threadInfo.tProxy=CProxy_TCharm(thisArrayID);
153 }
154
155 void checkPupMismatch(PUP::er &p,int expected,const char *where)
156 {
157         int v=expected;
158         p|v;
159         if (v!=expected) {
160                 CkError("FATAL ERROR> Mismatch %s pup routine\n",where);
161                 CkAbort("FATAL ERROR: Pup direction mismatch");
162         }
163 }
164
165 void TCharm::pup(PUP::er &p) {
166 //Pup superclass
167   ArrayElement1D::pup(p);
168
169   checkPupMismatch(p,5136,"before TCHARM");
170   p(isStopped); p(resumeAfterMigration); p(exitWhenDone);
171   p(threadInfo.thisElement);
172   p(threadInfo.numElements);
173   
174   if (sema.size()>0) 
175         CkAbort("TCharm::pup> Cannot migrate with unconsumed semaphores!\n");
176
177 #ifndef CMK_OPTIMIZE
178   DBG("Packing thread");
179   if (!isStopped)
180     CkAbort("Cannot pup a running thread.  You must suspend before migrating.\n");
181   if (tcharm_nomig) CkAbort("Cannot migrate with the +tcharm_nomig option!\n");
182 #endif
183
184   //This seekBlock allows us to reorder the packing/unpacking--
185   // This is needed because the userData depends on the thread's stack
186   // and heap data both at pack and unpack time.
187   PUP::seekBlock s(p,2);
188   
189 // Set up TCHARM context for use during user's pup routines:
190   CtvAccess(_curTCharm)=this;
191   activateThread();
192   
193 //Pup thread (EVIL & UGLY):
194   if (p.isUnpacking())
195   {//In this case, unpack the thread & heap before the user data
196     s.seek(1);
197     tid = CthPup((pup_er) &p, tid);
198     CtvAccessOther(tid,_curTCharm)=this;
199     CmiIsomallocBlockListPup((pup_er) &p,&heapBlocks);
200     threadGlobals=CtgPup((pup_er) &p,threadGlobals);
201     //Restart our clock: set it up so packTime==CkWallTimer+timeOffset
202     double packTime;
203     p(packTime);
204     timeOffset=packTime-CkWallTimer();
205     checkPupMismatch(p,5138,"after TCHARM thread");
206   }
207
208   //Pack all user data
209   s.seek(0);
210   p(nUd);
211   
212   for(int i=0;i<nUd;i++) ud[i].pup(p);
213   checkPupMismatch(p,5137,"after TCHARM_Register user data");
214   p|sud;
215   checkPupMismatch(p,5138,"after TCHARM_Global user data");
216   
217   if (!p.isUnpacking())
218   {//In this case, pack the thread & heap after the user data
219     s.seek(1);
220     tid = CthPup((pup_er) &p, tid);
221     CmiIsomallocBlockListPup((pup_er) &p,&heapBlocks);
222     threadGlobals=CtgPup((pup_er) &p,threadGlobals);
223     //Stop our clock:
224     double packTime=CkWallTimer()+timeOffset;
225     p(packTime);
226     checkPupMismatch(p,5138,"after TCHARM thread");
227   }
228   
229   CtvAccess(_curTCharm)=NULL;
230   deactivateThread();
231   
232   s.endBlock(); //End of seeking block
233   checkPupMismatch(p,5140,"after TCHARM");
234 }
235
236 //Pup one group of user data
237 void TCharm::UserData::pup(PUP::er &p)
238 {
239   pup_er pext=(pup_er)(&p);
240   p(mode);
241   switch(mode) {
242   case 'c': { /* C mode: userdata is on the stack, so keep address */
243      p((void*)&data,sizeof(data));
244      //FIXME: function pointers may not be valid across processors
245      p((void*)&cfn, sizeof(TCHARM_Pup_fn));
246      if (cfn) cfn(pext,data);
247      } break;
248   case 'g': { /* Global mode: zero out userdata on arrival */
249      if (p.isUnpacking()) data=0;
250      //FIXME: function pointers may not be valid across processors
251      p((void*)&gfn, sizeof(TCHARM_Pup_global_fn));
252      if (gfn) gfn(pext);
253      } break;
254   default:
255      break;
256   };
257 }
258
259 TCharm::~TCharm()
260 {
261   CmiIsomallocBlockListDelete(heapBlocks);
262   CthFree(tid);
263   delete initMsg;
264 }
265
266 void TCharm::migrateTo(int destPE) {
267         if (destPE==CkMyPe()) return;
268         // Make sure migrateMe gets called *after* we suspend:
269         thisProxy[thisIndex].migrateDelayed(destPE);
270         resumeAfterMigration=true;
271         suspend();
272 }
273 void TCharm::migrateDelayed(int destPE) {
274         migrateMe(destPE);
275 }
276 void TCharm::ckJustMigrated(void) {
277         ArrayElement::ckJustMigrated();
278         if (resumeAfterMigration) {
279                 resumeAfterMigration=false;
280                 resume(); //Start the thread running
281         }
282 }
283
284 // clear the data before restarting from disk
285 void TCharm::clear()
286 {
287   CmiIsomallocBlockListDelete(heapBlocks);
288   CthFree(tid);
289   delete initMsg;
290 }
291
292 //Register user data to be packed with the thread
293 int TCharm::add(const TCharm::UserData &d)
294 {
295   if (nUd>=maxUserData)
296     CkAbort("TCharm: Registered too many user data fields!\n");
297   int nu=nUd++;
298   ud[nu]=d;
299   return nu;
300 }
301 void *TCharm::lookupUserData(int i) {
302         if (i<0 || i>=nUd)
303                 CkAbort("Bad user data index passed to TCharmGetUserdata!\n");
304         return ud[i].getData();
305 }
306
307 //Start the thread running
308 void TCharm::run(void)
309 {
310   DBG("TCharm::run()");
311   if (tcharm_nothreads) {/*Call user routine directly*/
312           startTCharmThread(initMsg);
313   } 
314   else /* start the thread as usual */
315           start();
316 }
317
318 //Block the thread until start()ed again.
319 void TCharm::stop(void)
320 {
321 #ifndef CMK_OPTIMIZE
322   if (tid != CthSelf())
323     CkAbort("Called TCharm::stop from outside TCharm thread!\n");
324   if (tcharm_nothreads)
325     CkAbort("Cannot make blocking calls using +tcharm_nothreads!\n");
326 #endif
327   stopTiming();
328   isStopped=true;
329   DBG("thread suspended");
330   CthSuspend();
331   DBG("thread resumed");
332   /*SUBTLE: We have to do the get() because "this" may have changed
333     during a migration-suspend.  If you access *any* members
334     from this point onward, you'll cause heap corruption if
335     we're resuming from migration!  (OSL 2003/9/23)
336    */
337   TCharm *dis=TCharm::get();
338   dis->isStopped=false;
339   dis->startTiming();
340 }
341
342 //Resume the waiting thread
343 void TCharm::start(void)
344 {
345   isStopped=false;
346   DBG("thread resuming soon");
347   CthAwaken(tid);
348 }
349
350 //Block our thread, schedule, and come back:
351 void TCharm::schedule(void) {
352   DBG("thread schedule");
353   start(); // Calls CthAwaken
354   stop(); // Calls CthSuspend
355 }
356
357 //Go to sync, block, possibly migrate, and then resume
358 void TCharm::migrate(void)
359 {
360 #if CMK_LBDB_ON
361   DBG("going to sync");
362   AtSync();
363   stop();
364 #else
365   DBG("skipping sync, because there is no load balancer");
366 #endif
367 }
368
369 //Resume from sync: start the thread again
370 void TCharm::ResumeFromSync(void)
371 {
372   start();
373 }
374
375
376 /****** TcharmClient ******/
377 void TCharmClient1D::ckJustMigrated(void) {
378   ArrayElement1D::ckJustMigrated();
379   findThread();
380   tcharmClientInit();
381 }
382
383 void TCharmClient1D::pup(PUP::er &p) {
384   ArrayElement1D::pup(p);
385   p|threadProxy;
386 }
387
388 CkArrayID TCHARM_Get_threads(void) {
389         TCHARMAPI("TCHARM_Get_threads");
390         return TCharm::get()->getProxy();
391 }
392
393 /************* Startup/Shutdown Coordination Support ************/
394
395 // Useless values to reduce over:
396 int vals[2]={0,1};
397
398 //Called when we want to go to a barrier
399 void TCharm::barrier(void) {
400         //Contribute to a synchronizing reduction
401         CkCallback cb(index_t::atBarrier(0), thisProxy[0]);
402         contribute(sizeof(vals),&vals,CkReduction::sum_int,cb);
403         stop();
404 }
405
406 //Called when we've reached the barrier
407 void TCharm::atBarrier(CkReductionMsg *m) {
408         DBGX("clients all at barrier");
409         delete m;
410         thisProxy.start(); //Just restart everybody
411 }
412
413 //Called when the thread is done running
414 void TCharm::done(void) {
415         DBG("TCharm thread "<<thisIndex<<" done")
416         if (exitWhenDone) {
417                 //Contribute to a synchronizing reduction
418                 CkCallback cb(index_t::atExit(0), thisProxy[0]);
419                 contribute(sizeof(vals),&vals,CkReduction::sum_int,cb);
420         }
421         stop();
422 }
423 //Called when all threads are done running
424 void TCharm::atExit(CkReductionMsg *m) {
425         DBGX("TCharm::atExit> exiting");
426         delete m;
427         CkExit();
428 }
429
430
431 /************* Setup **************/
432
433 //Globals used to control setup process
434 static TCHARM_Fallback_setup_fn g_fallbackSetup=NULL;
435 void TCHARM_Set_fallback_setup(TCHARM_Fallback_setup_fn f)
436 {
437         g_fallbackSetup=f;
438 }
439 void TCHARM_Call_fallback_setup(void) {
440         if (g_fallbackSetup) 
441                 (g_fallbackSetup)();
442         else
443                 CkAbort("TCHARM: Unexpected fallback setup--missing TCHARM_User_setup routine?");
444 }
445
446 /************** User API ***************/
447 /**********************************
448 Callable from UserSetup:
449 */
450
451 // Read the command line to figure out how many threads to create:
452 CDECL int TCHARM_Get_num_chunks(void)
453 {
454         TCHARMAPI("TCHARM_Get_num_chunks");
455         if (CkMyPe()!=0) CkAbort("TCHARM_Get_num_chunks should only be called on PE 0 during setup!");
456         int nChunks=CkNumPes();
457         char **argv=CkGetArgv();
458         CmiGetArgIntDesc(argv,"-vp",&nChunks,"Set the total number of virtual processors");
459         CmiGetArgIntDesc(argv,"+vp",&nChunks,NULL);
460         lastNumChunks=nChunks;
461         return nChunks;
462 }
463 FDECL int FTN_NAME(TCHARM_GET_NUM_CHUNKS,tcharm_get_num_chunks)(void)
464 {
465         return TCHARM_Get_num_chunks();
466 }
467
468 // Fill out the default thread options:
469 TCHARM_Thread_options::TCHARM_Thread_options(int doDefault)
470 {
471         stackSize=0; /* default stacksize */
472         exitWhenDone=0; /* don't exit when done by default. */
473 }
474 void TCHARM_Thread_options::sanityCheck(void) {
475         if (stackSize<=0) stackSize=tcharm_stacksize;
476 }
477
478
479 TCHARM_Thread_options g_tcharmOptions(1);
480
481 /*Set the size of the thread stack*/
482 CDECL void TCHARM_Set_stack_size(int newStackSize)
483 {
484         TCHARMAPI("TCHARM_Set_stack_size");
485         g_tcharmOptions.stackSize=newStackSize;
486 }
487 FDECL void FTN_NAME(TCHARM_SET_STACK_SIZE,tcharm_set_stack_size)
488         (int *newSize)
489 { TCHARM_Set_stack_size(*newSize); }
490
491 CDECL void TCHARM_Set_exit(void) { g_tcharmOptions.exitWhenDone=1; }
492
493 /*Create a new array of threads, which will be bound to by subsequent libraries*/
494 CDECL void TCHARM_Create(int nThreads,
495                         TCHARM_Thread_start_fn threadFn)
496 {
497         TCHARMAPI("TCHARM_Create");
498         TCHARM_Create_data(nThreads,
499                          (TCHARM_Thread_data_start_fn)threadFn,NULL,0);
500 }
501 FDECL void FTN_NAME(TCHARM_CREATE,tcharm_create)
502         (int *nThreads,TCHARM_Thread_start_fn threadFn)
503 { TCHARM_Create(*nThreads,threadFn); }
504
505 static CProxy_TCharm TCHARM_Build_threads(TCharmInitMsg *msg);
506
507 /*As above, but pass along (arbitrary) data to threads*/
508 CDECL void TCHARM_Create_data(int nThreads,
509                   TCHARM_Thread_data_start_fn threadFn,
510                   void *threadData,int threadDataLen)
511 {
512         TCHARMAPI("TCHARM_Create_data");
513         TCharmInitMsg *msg=new (threadDataLen,0) TCharmInitMsg(
514                 (CthVoidFn)threadFn,g_tcharmOptions);
515         msg->numElements=nThreads;
516         memcpy(msg->data,threadData,threadDataLen);
517         TCHARM_Build_threads(msg);
518         
519         // Reset the thread options:
520         g_tcharmOptions=TCHARM_Thread_options(1);
521 }
522
523 FDECL void FTN_NAME(TCHARM_CREATE_DATA,tcharm_create_data)
524         (int *nThreads,
525                   TCHARM_Thread_data_start_fn threadFn,
526                   void *threadData,int *threadDataLen)
527 { TCHARM_Create_data(*nThreads,threadFn,threadData,*threadDataLen); }
528
529 static int mapCreated=0;
530 static CkGroupID mapID;
531 CkGroupID CkCreatePropMap(void);
532
533 static CProxy_TCharm TCHARM_Build_threads(TCharmInitMsg *msg)
534 {
535   char** argv = CkGetArgv();
536   CkArrayOptions opts(msg->numElements);
537   if (!mapCreated) {
538     char* mapping;
539     if (0!=CmiGetArgString(argv, "+mapping", &mapping)){
540
541       if(0==strcmp(mapping,"BLOCK_MAP")){
542         mapID=CProxy_BlockMap::ckNew();
543       }
544      
545       if(0==strcmp(mapping,"RR_MAP")){
546         mapID=CProxy_RRMap::ckNew();
547       }
548
549       if(0==strcmp(mapping,"PROP_MAP")){
550         mapID=CkCreatePropMap();
551       }
552     } else {
553       mapID=CkCreatePropMap();
554     }
555     mapCreated=1;
556   }
557   opts.setMap(mapID);
558   int nElem=msg->numElements; //<- save it because msg will be deleted.
559   return CProxy_TCharm::ckNew(msg,opts);
560 }
561
562 // Helper used when creating a new array bound to the TCHARM threads:
563 CkArrayOptions TCHARM_Attach_start(CkArrayID *retTCharmArray,int *retNumElts)
564 {
565         TCharm *tc=TCharm::get();
566         if (!tc)
567                 CkAbort("You must call TCHARM initialization routines from a TCHARM thread!");
568         int nElts=tc->getNumElements();
569         if (retNumElts!=NULL) *retNumElts=nElts;
570         *retTCharmArray=tc->getProxy();
571         CkArrayOptions opts(nElts);
572         opts.bindTo(tc->getProxy());
573         return opts;
574 }
575
576 void TCHARM_Suspend(void) {
577         TCharm *tc=TCharm::get();
578         tc->suspend();
579 }
580
581 /***********************************
582 Callable from worker thread
583 */
584 CDECL int TCHARM_Element(void)
585
586         TCHARMAPI("TCHARM_Element");
587         return TCharm::get()->getElement();
588 }
589 CDECL int TCHARM_Num_elements(void)
590
591         TCHARMAPI("TCHARM_Num_elements");
592         return TCharm::get()->getNumElements();
593 }
594
595 FDECL int FTN_NAME(TCHARM_ELEMENT,tcharm_element)(void) 
596 { return TCHARM_Element();}
597 FDECL int FTN_NAME(TCHARM_NUM_ELEMENTS,tcharm_num_elements)(void) 
598 { return TCHARM_Num_elements();}
599
600 //Make sure this address will migrate with us when we move:
601 static void checkAddress(void *data)
602 {
603         if (tcharm_nomig||tcharm_nothreads) return; //Stack is not isomalloc'd
604         if (!CmiIsomallocInRange(data))
605             CkAbort("The UserData you register must be allocated on the stack!\n");
606 }
607
608 /* Old "register"-based userdata: */
609 CDECL int TCHARM_Register(void *data,TCHARM_Pup_fn pfn)
610
611         TCHARMAPI("TCHARM_Register");
612         checkAddress(data);
613         return TCharm::get()->add(TCharm::UserData(pfn,data));
614 }
615 FDECL int FTN_NAME(TCHARM_REGISTER,tcharm_register)
616         (void *data,TCHARM_Pup_fn pfn)
617
618         TCHARMAPI("TCHARM_Register");
619         checkAddress(data);
620         return TCharm::get()->add(TCharm::UserData(pfn,data));
621 }
622
623 CDECL void *TCHARM_Get_userdata(int id)
624 {
625         TCHARMAPI("TCHARM_Get_userdata");
626         return TCharm::get()->lookupUserData(id);
627 }
628 FDECL void *FTN_NAME(TCHARM_GET_USERDATA,tcharm_get_userdata)(int *id)
629 { return TCHARM_Get_userdata(*id); }
630
631 /* New hardcoded-ID userdata: */
632 CDECL void TCHARM_Set_global(int globalID,void *new_value,TCHARM_Pup_global_fn pup_or_NULL)
633 {
634         TCHARMAPI("TCHARM_Set_global");
635         TCharm *tc=TCharm::get();
636         if (tc->sud.length()<=globalID)
637         { //We don't have room for this ID yet: make room
638                 int newLen=2*globalID;
639                 tc->sud.resize(newLen);
640         }
641         tc->sud[globalID]=TCharm::UserData(pup_or_NULL,new_value);
642 }
643 CDECL void *TCHARM_Get_global(int globalID)
644 {
645         //Skip TCHARMAPI("TCHARM_Get_global") because there's no dynamic allocation here,
646         // and this routine should be as fast as possible.
647         CkVec<TCharm::UserData> &v=TCharm::get()->sud;
648         if (v.length()<=globalID) return NULL; //Uninitialized global
649         return v[globalID].getData();
650 }
651
652 CDECL void TCHARM_Migrate(void)
653 {
654         TCHARMAPI("TCHARM_Migrate");
655         TCharm::get()->migrate();
656 }
657 FORTRAN_AS_C(TCHARM_MIGRATE,TCHARM_Migrate,tcharm_migrate,(void),())
658
659 CDECL void TCHARM_Migrate_to(int destPE)
660 {
661         TCHARMAPI("TCHARM_Migrate_to");
662         TCharm::get()->migrateTo(destPE);
663 }
664 FORTRAN_AS_C(TCHARM_MIGRATE_TO,TCHARM_Migrate_to,tcharm_migrate_to,
665         (int *destPE),(*destPE))
666
667 CDECL void TCHARM_Yield(void)
668 {
669         TCHARMAPI("TCHARM_Yield");
670         TCharm::get()->schedule();
671 }
672 FORTRAN_AS_C(TCHARM_YIELD,TCHARM_Yield,tcharm_yield,(void),())
673
674 CDECL void TCHARM_Barrier(void)
675 {
676         TCHARMAPI("TCHARM_Barrier");
677         TCharm::get()->barrier();
678 }
679 FORTRAN_AS_C(TCHARM_BARRIER,TCHARM_Barrier,tcharm_barrier,(void),())
680
681 CDECL void TCHARM_Done(void)
682 {
683         TCHARMAPI("TCHARM_Done");
684         TCharm *c=TCharm::getNULL();
685         if (!c) CkExit();
686         else c->done();
687 }
688 FORTRAN_AS_C(TCHARM_DONE,TCHARM_Done,tcharm_done,(void),())
689
690
691 CDECL double TCHARM_Wall_timer(void)
692 {
693   TCHARMAPI("TCHARM_Wall_timer");
694   TCharm *c=TCharm::getNULL();
695   if(!c) return CkWallTimer();
696   else { //Have to apply current thread's time offset
697     return CkWallTimer()+c->getTimeOffset();
698   }
699 }
700
701 #if 1
702 /*Include Fortran-style "iargc" and "getarg" routines.
703 These are needed to get access to the command-line arguments from Fortran.
704 */
705 FDECL int FTN_NAME(TCHARM_IARGC,tcharm_iargc)(void) {
706   TCHARMAPI("tcharm_iargc");
707   return CkGetArgc()-1;
708 }
709
710 FDECL void FTN_NAME(TCHARM_GETARG,tcharm_getarg)
711         (int *i_p,char *dest,int destLen)
712 {
713   TCHARMAPI("tcharm_getarg");
714   int i=*i_p;
715   if (i<0) CkAbort("tcharm_getarg called with negative argument!");
716   if (i>=CkGetArgc()) CkAbort("tcharm_getarg called with argument > iargc!");
717   const char *src=CkGetArgv()[i];
718   strcpy(dest,src);
719   for (i=strlen(dest);i<destLen;i++) dest[i]=' ';
720 }
721
722 #endif
723
724 //These silly routines are used for serial startup:
725 extern void _initCharm(int argc, char **argv);
726 CDECL void TCHARM_Init(int *argc,char ***argv) {
727         if (!tcharm_initted) {
728           ConverseInit(*argc, *argv, (CmiStartFn) _initCharm,1,1);
729           _initCharm(*argc,*argv);
730         }
731 }
732
733 FDECL void FTN_NAME(TCHARM_INIT,tcharm_init)(void)
734 {
735         int argc=1;
736         char *argv_sto[2]={"foo",NULL};
737         char **argv=argv_sto;
738         TCHARM_Init(&argc,&argv);
739 }
740
741 /***********************************
742 * TCHARM Semaphores:
743 * The idea is one side "puts", the other side "gets"; 
744 * but the calls can come in any order--
745 * if the "get" comes first, it blocks until the put.
746 * This makes a convenient, race-condition-free way to do
747 * onetime initializations.  
748 */
749 /// Find this semaphore, or insert if there isn't one:
750 TCharm::TCharmSemaphore *TCharm::findSema(int id) {
751         for (int s=0;s<sema.size();s++)
752                 if (sema[s].id==id) 
753                         return &sema[s];
754         sema.push_back(TCharmSemaphore(id));
755         return &sema[sema.size()-1];
756 }
757 /// Remove this semaphore from the list
758 void TCharm::freeSema(TCharmSemaphore *doomed) {
759         int id=doomed->id;
760         for (int s=0;s<sema.size();s++)
761                 if (sema[s].id==id) {
762                         sema[s]=sema[sema.length()-1];
763                         sema.length()--;
764                         return;
765                 }
766         CkAbort("Tried to free nonexistent TCharm semaphore");
767 }
768
769 /// Block until this semaphore has data:
770 TCharm::TCharmSemaphore *TCharm::getSema(int id) {
771         TCharmSemaphore *s=findSema(id);
772         if (s->data==NULL) 
773         { //Semaphore isn't filled yet: wait until it is
774                 s->thread=CthSelf();
775                 suspend(); //Will be woken by semaPut
776                 // Semaphore may have moved-- find it again
777                 s=findSema(id);
778                 if (s->data==NULL) CkAbort("TCharm::semaGet awoken too early!");
779         }
780         return s;
781 }
782
783 /// Store data at the semaphore "id".
784 ///  The put can come before or after the get.
785 void TCharm::semaPut(int id,void *data) {
786         TCharmSemaphore *s=findSema(id);
787         if (s->data!=NULL) CkAbort("Duplicate calls to TCharm::semaPut!");
788         s->data=data;
789         DBG("semaPut "<<id<<" "<<data);
790         if (s->thread!=NULL) {//Awaken the thread
791                 s->thread=NULL;
792                 resume();
793         }
794 }
795
796 /// Retreive data from the semaphore "id".
797 ///  Blocks if the data is not immediately available.
798 ///  Consumes the data, so another put will be required for the next get.
799 void *TCharm::semaGet(int id) {
800         TCharmSemaphore *s=getSema(id);
801         void *ret=s->data;
802         DBG("semaGet "<<id<<" "<<ret);
803         // Now remove the semaphore from the list:
804         freeSema(s);
805         return ret;
806 }
807
808 /// Retreive data from the semaphore "id".
809 ///  Blocks if the data is not immediately available.
810 void *TCharm::semaGets(int id) {
811         TCharmSemaphore *s=getSema(id);
812         return s->data;
813 }
814
815 /// Retreive data from the semaphore "id", or returns NULL.
816 void *TCharm::semaPeek(int id) {
817         TCharmSemaphore *s=findSema(id);
818         return s->data;
819 }
820
821 #include "tcharm.def.h"