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