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