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