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