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