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