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