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