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