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