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