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