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