Added ability to swap global variables using the Ctg routines.
[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
22 static int lastNumChunks=0;
23
24 class TCharmTraceLibList {
25         enum {maxLibs=20,maxLibNameLen=15};
26         //List of libraries we want to trace:
27         int curLibs;
28         char libNames[maxLibs][maxLibNameLen];
29         int checkIfTracing(const char *lib) const
30         {
31                 for (int i=0;i<curLibs;i++) 
32                         if (0==strcmp(lib,libNames[i]))
33                                 return 1;
34                 return 0;
35         }
36 public:
37         TCharmTraceLibList() {curLibs=0;}
38         void addTracing(const char *lib) 
39         { //We want to trace this library-- add its name to the list.
40                 CkPrintf("TCHARM> Will trace calls to library %s\n",lib);
41                 int i;
42                 for (i=0;0!=*lib;i++,lib++)
43                         libNames[curLibs][i]=tolower(*lib);
44                 libNames[curLibs][i]=0;
45                 // if already tracing, skip
46                 if (checkIfTracing(libNames[curLibs])) return;
47                 curLibs++;
48         }
49         inline int isTracing(const char *lib) const {
50                 if (curLibs==0) return 0; //Common case
51                 else return checkIfTracing(lib);
52         }
53 };
54 static TCharmTraceLibList tcharm_tracelibs;
55 static int tcharm_nomig=0, tcharm_nothreads=0;
56 static int tcharm_stacksize=1*1024*1024; /*Default stack size is 1MB*/
57 static int tcharm_initted=0;
58
59 void TCharm::nodeInit(void)
60 {
61 }
62
63 void TCharm::procInit(void)
64 {
65   CtvInitialize(TCharm *,_curTCharm);
66   CtvAccess(_curTCharm)=NULL;
67   tcharm_initted=1;
68   CtgInit();
69
70   // called on every pe to eat these arguments
71   char **argv=CkGetArgv();
72   tcharm_nomig=CmiGetArgFlagDesc(argv,"+tcharm_nomig","Disable migration support (debugging)");
73   tcharm_nothreads=CmiGetArgFlagDesc(argv,"+tcharm_nothread","Disable thread support (debugging)");
74   tcharm_nothreads|=CmiGetArgFlagDesc(argv,"+tcharm_nothreads",NULL);
75   char *traceLibName=NULL;
76   while (CmiGetArgStringDesc(argv,"+tcharm_trace",&traceLibName,"Print each call to this library"))
77       tcharm_tracelibs.addTracing(traceLibName);
78   CmiGetArgIntDesc(argv,"+tcharm_stacksize",&tcharm_stacksize,"Set the thread stack size (default 1MB)");
79   if (CkMyPe()!=0) { //Processor 0 eats "+vp<N>" and "-vp<N>" later:
80         int ignored;
81         while (CmiGetArgIntDesc(argv,"-vp",&ignored,NULL)) {}
82         while (CmiGetArgIntDesc(argv,"+vp",&ignored,NULL)) {}
83   }
84   if (CkMyPe()==0) { // Echo various debugging options:
85     if (tcharm_nomig) CmiPrintf("TCHARM> Disabling migration support, for debugging\n");
86     if (tcharm_nothreads) CmiPrintf("TCHARM> Disabling thread support, for debugging\n");
87   }
88 }
89
90 void TCHARM_Api_trace(const char *routineName,const char *libraryName)
91 {
92         if (!tcharm_tracelibs.isTracing(libraryName)) return;
93         TCharm *tc=CtvAccess(_curTCharm);
94         char where[100];
95         if (tc==NULL) sprintf(where,"[serial context on %d]",CkMyPe());
96         else sprintf(where,"[%p> vp %d, p %d]",(void *)tc,tc->getElement(),CkMyPe());
97         CmiPrintf("%s Called routine %s\n",where,routineName);
98         CmiPrintStackTrace(1);
99         CmiPrintf("\n");
100 }
101
102 static void startTCharmThread(TCharmInitMsg *msg)
103 {
104         DBGX("thread started");
105         TCharm::activateThread();
106         typedef void (*threadFn_t)(void *);
107         ((threadFn_t)msg->threadFn)(msg->data);
108         TCharm::deactivateThread();
109         CtvAccess(_curTCharm)->done();
110 }
111
112 TCharm::TCharm(TCharmInitMsg *initMsg_)
113 {
114   initMsg=initMsg_;
115   initMsg->opts.sanityCheck();
116   timeOffset=0.0;
117   threadGlobals=CtgCreate();
118   if (tcharm_nothreads)
119   { //Don't even make a new thread-- just use main thread
120     tid=CthSelf();
121   }
122   else /*Create a thread normally*/
123   {
124     if (tcharm_nomig) { /*Nonmigratable version, for debugging*/
125       tid=CthCreate((CthVoidFn)startTCharmThread,initMsg,initMsg->opts.stackSize);
126     } else {
127       tid=CthCreateMigratable((CthVoidFn)startTCharmThread,initMsg,initMsg->opts.stackSize);
128     }
129 #if CMK_BLUEGENE_CHARM
130     BgAttach(tid);
131 #endif
132   }
133   CtvAccessOther(tid,_curTCharm)=this;
134   isStopped=true;
135   resumeAfterMigration=false;
136   exitWhenDone=initMsg->opts.exitWhenDone;
137   threadInfo.tProxy=CProxy_TCharm(thisArrayID);
138   threadInfo.thisElement=thisIndex;
139   threadInfo.numElements=initMsg->numElements;
140   heapBlocks=CmiIsomallocBlockListNew();
141   nUd=0;
142   usesAtSync=CmiTrue;
143   run();
144 }
145
146 TCharm::TCharm(CkMigrateMessage *msg)
147         :CBase_TCharm(msg)
148 {
149   initMsg=NULL;
150   tid=NULL;
151   threadGlobals=NULL;
152   threadInfo.tProxy=CProxy_TCharm(thisArrayID);
153 }
154
155 void TCharm::pup(PUP::er &p) {
156 //Pup superclass
157   ArrayElement1D::pup(p);
158
159   p(isStopped); p(resumeAfterMigration); p(exitWhenDone);
160   p(threadInfo.thisElement);
161   p(threadInfo.numElements);
162   
163   if (sema.size()>0) 
164         CkAbort("TCharm::pup> Cannot migrate with unconsumed semaphores!\n");
165
166 #ifndef CMK_OPTIMIZE
167   DBG("Packing thread");
168   if (!isStopped)
169     CkAbort("Cannot pup a running thread.  You must suspend before migrating.\n");
170   if (tcharm_nomig) CkAbort("Cannot migrate with the +tcharm_nomig option!\n");
171 #endif
172
173 //Pup thread (EVIL & UGLY):
174   //This seekBlock allows us to reorder the packing/unpacking--
175   // This is needed because the userData depends on the thread's stack
176   // and heap data both at pack and unpack time.
177   PUP::seekBlock s(p,2);
178   if (p.isUnpacking())
179   {//In this case, unpack the thread & heap before the user data
180     s.seek(1);
181     tid = CthPup((pup_er) &p, tid);
182     CtvAccessOther(tid,_curTCharm)=this;
183     CmiIsomallocBlockListPup((pup_er) &p,&heapBlocks);
184     threadGlobals=CtgPup((pup_er) &p,threadGlobals);
185     //Restart our clock: set it up so packTime==CkWallTimer+timeOffset
186     double packTime;
187     p(packTime);
188     timeOffset=packTime-CkWallTimer();
189   }
190
191   //Pack all user data
192   s.seek(0);
193   p(nUd);
194   
195   activateThread();
196   for(int i=0;i<nUd;i++) ud[i].pup(p);
197   p|sud;
198   deactivateThread();
199   
200   if (!p.isUnpacking())
201   {//In this case, pack the thread & heap after the user data
202     s.seek(1);
203     tid = CthPup((pup_er) &p, tid);
204     CmiIsomallocBlockListPup((pup_er) &p,&heapBlocks);
205     threadGlobals=CtgPup((pup_er) &p,threadGlobals);
206     //Stop our clock:
207     double packTime=CkWallTimer()+timeOffset;
208     p(packTime);
209   }
210   s.endBlock(); //End of seeking block
211 }
212
213 //Pup one group of user data
214 void TCharm::UserData::pup(PUP::er &p)
215 {
216   pup_er pext=(pup_er)(&p);
217   p(isC);
218   //Save address of userdata-- assumes user data is on the stack
219   p((void*)&data,sizeof(data));
220   if (isC) { //C version
221     //FIXME: function pointers may not be valid across processors
222     p((void*)&cfn, sizeof(TCpupUserDataC));
223     if (cfn) cfn(pext,data);
224   }
225   else { //Fortran version
226     //FIXME: function pointers may not be valid across processors
227     p((void*)&ffn, sizeof(TCpupUserDataF));
228     if (ffn) ffn(pext,data);
229   }
230 }
231
232 TCharm::~TCharm()
233 {
234   CmiIsomallocBlockListDelete(heapBlocks);
235   CthFree(tid);
236   delete initMsg;
237 }
238
239 void TCharm::migrateTo(int destPE) {
240         if (destPE==CkMyPe()) return;
241         // Make sure migrateMe gets called *after* we suspend:
242         thisProxy[thisIndex].migrateDelayed(destPE);
243         resumeAfterMigration=true;
244         suspend();
245 }
246 void TCharm::migrateDelayed(int destPE) {
247         migrateMe(destPE);
248 }
249 void TCharm::ckJustMigrated(void) {
250         ArrayElement::ckJustMigrated();
251         if (resumeAfterMigration) {
252                 resumeAfterMigration=false;
253                 resume(); //Start the thread running
254         }
255 }
256
257 // clear the data before restarting from disk
258 void TCharm::clear()
259 {
260   CmiIsomallocBlockListDelete(heapBlocks);
261   CthFree(tid);
262   delete initMsg;
263 }
264
265 //Register user data to be packed with the thread
266 int TCharm::add(const TCharm::UserData &d)
267 {
268   if (nUd>=maxUserData)
269     CkAbort("TCharm: Registered too many user data fields!\n");
270   int nu=nUd++;
271   ud[nu]=d;
272   return nu;
273 }
274 void *TCharm::lookupUserData(int i) {
275         if (i<0 || i>=nUd)
276                 CkAbort("Bad user data index passed to TCharmGetUserdata!\n");
277         return ud[i].getData();
278 }
279
280 //Start the thread running
281 void TCharm::run(void)
282 {
283   DBG("TCharm::run()");
284   if (tcharm_nothreads) {/*Call user routine directly*/
285           startTCharmThread(initMsg);
286   } 
287   else /* start the thread as usual */
288           start();
289 }
290
291 //Block the thread until start()ed again.
292 void TCharm::stop(void)
293 {
294 #ifndef CMK_OPTIMIZE
295   if (tid != CthSelf())
296     CkAbort("Called TCharm::stop from outside TCharm thread!\n");
297   if (tcharm_nothreads)
298     CkAbort("Cannot make blocking calls using +tcharm_nothreads!\n");
299 #endif
300   stopTiming();
301   isStopped=true;
302   DBG("thread suspended");
303   CthSuspend();
304   DBG("thread resumed");
305   /*SUBTLE: We have to do the get() because "this" may have changed
306     during a migration-suspend.  If you access *any* members
307     from this point onward, you'll cause heap corruption if
308     we're resuming from migration!  (OSL 2003/9/23)
309    */
310   TCharm *dis=TCharm::get();
311   dis->isStopped=false;
312   dis->startTiming();
313 }
314
315 //Resume the waiting thread
316 void TCharm::start(void)
317 {
318   isStopped=false;
319   DBG("thread resuming soon");
320   CthAwaken(tid);
321 }
322
323 //Block our thread, schedule, and come back:
324 void TCharm::schedule(void) {
325   DBG("thread schedule");
326   start(); // Calls CthAwaken
327   stop(); // Calls CthSuspend
328 }
329
330 //Go to sync, block, possibly migrate, and then resume
331 void TCharm::migrate(void)
332 {
333 #if CMK_LBDB_ON
334   DBG("going to sync");
335   AtSync();
336   stop();
337 #else
338   DBG("skipping sync, because there is no load balancer");
339 #endif
340 }
341
342 //Resume from sync: start the thread again
343 void TCharm::ResumeFromSync(void)
344 {
345   start();
346 }
347
348
349 /****** TcharmClient ******/
350 void TCharmClient1D::ckJustMigrated(void) {
351   ArrayElement1D::ckJustMigrated();
352   findThread();
353   tcharmClientInit();
354 }
355
356 void TCharmClient1D::pup(PUP::er &p) {
357   ArrayElement1D::pup(p);
358   p|threadProxy;
359 }
360
361 CkArrayID TCHARM_Get_threads(void) {
362         TCHARMAPI("TCHARM_Get_threads");
363         return TCharm::get()->getProxy();
364 }
365
366 /************* Startup/Shutdown Coordination Support ************/
367
368 // Useless values to reduce over:
369 int vals[2]={0,1};
370
371 //Called when we want to go to a barrier
372 void TCharm::barrier(void) {
373         //Contribute to a synchronizing reduction
374         CkCallback cb(index_t::atBarrier(0), thisProxy[0]);
375         contribute(sizeof(vals),&vals,CkReduction::sum_int,cb);
376         stop();
377 }
378
379 //Called when we've reached the barrier
380 void TCharm::atBarrier(CkReductionMsg *m) {
381         DBGX("clients all at barrier");
382         delete m;
383         thisProxy.start(); //Just restart everybody
384 }
385
386 //Called when the thread is done running
387 void TCharm::done(void) {
388         DBG("TCharm thread "<<thisIndex<<" done")
389         if (exitWhenDone) {
390                 //Contribute to a synchronizing reduction
391                 CkCallback cb(index_t::atExit(0), thisProxy[0]);
392                 contribute(sizeof(vals),&vals,CkReduction::sum_int,cb);
393         }
394         stop();
395 }
396 //Called when all threads are done running
397 void TCharm::atExit(CkReductionMsg *m) {
398         DBGX("TCharm::atExit> exiting");
399         delete m;
400         CkExit();
401 }
402
403
404 /************* Setup **************/
405
406 //Globals used to control setup process
407 static TCHARM_Fallback_setup_fn g_fallbackSetup=NULL;
408 void TCHARM_Set_fallback_setup(TCHARM_Fallback_setup_fn f)
409 {
410         g_fallbackSetup=f;
411 }
412 void TCHARM_Call_fallback_setup(void) {
413         if (g_fallbackSetup) 
414                 (g_fallbackSetup)();
415         else
416                 CkAbort("TCHARM: Unexpected fallback setup--missing TCHARM_User_setup routine?");
417 }
418
419 /************** User API ***************/
420 /**********************************
421 Callable from UserSetup:
422 */
423
424 // Read the command line to figure out how many threads to create:
425 CDECL int TCHARM_Get_num_chunks(void)
426 {
427         TCHARMAPI("TCHARM_Get_num_chunks");
428         if (CkMyPe()!=0) CkAbort("TCHARM_Get_num_chunks should only be called on PE 0 during setup!");
429         int nChunks=CkNumPes();
430         char **argv=CkGetArgv();
431         CmiGetArgIntDesc(argv,"-vp",&nChunks,"Set the total number of virtual processors");
432         CmiGetArgIntDesc(argv,"+vp",&nChunks,NULL);
433         lastNumChunks=nChunks;
434         return nChunks;
435 }
436 FDECL int FTN_NAME(TCHARM_GET_NUM_CHUNKS,tcharm_get_num_chunks)(void)
437 {
438         return TCHARM_Get_num_chunks();
439 }
440
441 // Fill out the default thread options:
442 TCHARM_Thread_options::TCHARM_Thread_options(int doDefault)
443 {
444         stackSize=0; /* default stacksize */
445         exitWhenDone=0; /* don't exit when done by default. */
446 }
447 void TCHARM_Thread_options::sanityCheck(void) {
448         if (stackSize<=0) stackSize=tcharm_stacksize;
449 }
450
451
452 TCHARM_Thread_options g_tcharmOptions(1);
453
454 /*Set the size of the thread stack*/
455 CDECL void TCHARM_Set_stack_size(int newStackSize)
456 {
457         TCHARMAPI("TCHARM_Set_stack_size");
458         g_tcharmOptions.stackSize=newStackSize;
459 }
460 FDECL void FTN_NAME(TCHARM_SET_STACK_SIZE,tcharm_set_stack_size)
461         (int *newSize)
462 { TCHARM_Set_stack_size(*newSize); }
463
464 CDECL void TCHARM_Set_exit(void) { g_tcharmOptions.exitWhenDone=1; }
465
466 /*Create a new array of threads, which will be bound to by subsequent libraries*/
467 CDECL void TCHARM_Create(int nThreads,
468                         TCHARM_Thread_start_fn threadFn)
469 {
470         TCHARMAPI("TCHARM_Create");
471         TCHARM_Create_data(nThreads,
472                          (TCHARM_Thread_data_start_fn)threadFn,NULL,0);
473 }
474 FDECL void FTN_NAME(TCHARM_CREATE,tcharm_create)
475         (int *nThreads,TCHARM_Thread_start_fn threadFn)
476 { TCHARM_Create(*nThreads,threadFn); }
477
478 static CProxy_TCharm TCHARM_Build_threads(TCharmInitMsg *msg);
479
480 /*As above, but pass along (arbitrary) data to threads*/
481 CDECL void TCHARM_Create_data(int nThreads,
482                   TCHARM_Thread_data_start_fn threadFn,
483                   void *threadData,int threadDataLen)
484 {
485         TCHARMAPI("TCHARM_Create_data");
486         TCharmInitMsg *msg=new (threadDataLen,0) TCharmInitMsg(
487                 (CthVoidFn)threadFn,g_tcharmOptions);
488         msg->numElements=nThreads;
489         memcpy(msg->data,threadData,threadDataLen);
490         TCHARM_Build_threads(msg);
491         
492         // Reset the thread options:
493         g_tcharmOptions=TCHARM_Thread_options(1);
494 }
495
496 FDECL void FTN_NAME(TCHARM_CREATE_DATA,tcharm_create_data)
497         (int *nThreads,
498                   TCHARM_Thread_data_start_fn threadFn,
499                   void *threadData,int *threadDataLen)
500 { TCHARM_Create_data(*nThreads,threadFn,threadData,*threadDataLen); }
501
502 static int propMapCreated=0;
503 static CkGroupID propMapID;
504 CkGroupID CkCreatePropMap(void);
505
506 static CProxy_TCharm TCHARM_Build_threads(TCharmInitMsg *msg)
507 {
508         CkArrayOptions opts(msg->numElements);
509         if (!propMapCreated) {
510                 propMapCreated=1;
511                 propMapID=CkCreatePropMap();
512         }
513         opts.setMap(propMapID);
514         int nElem=msg->numElements; //<- save it because msg will be deleted.
515         return CProxy_TCharm::ckNew(msg,opts);
516 }
517
518 // Helper used when creating a new array bound to the TCHARM threads:
519 CkArrayOptions TCHARM_Attach_start(CkArrayID *retTCharmArray,int *retNumElts)
520 {
521         TCharm *tc=TCharm::get();
522         if (!tc)
523                 CkAbort("You must call TCHARM initialization routines from a TCHARM thread!");
524         int nElts=tc->getNumElements();
525         if (retNumElts!=NULL) *retNumElts=nElts;
526         *retTCharmArray=tc->getProxy();
527         CkArrayOptions opts(nElts);
528         opts.bindTo(tc->getProxy());
529         return opts;
530 }
531
532 void TCHARM_Suspend(void) {
533         TCharm *tc=TCharm::get();
534         tc->suspend();
535 }
536
537 /***********************************
538 Callable from worker thread
539 */
540 CDECL int TCHARM_Element(void)
541
542         TCHARMAPI("TCHARM_Element");
543         return TCharm::get()->getElement();
544 }
545 CDECL int TCHARM_Num_elements(void)
546
547         TCHARMAPI("TCHARM_Num_elements");
548         return TCharm::get()->getNumElements();
549 }
550
551 FDECL int FTN_NAME(TCHARM_ELEMENT,tcharm_element)(void) 
552 { return TCHARM_Element();}
553 FDECL int FTN_NAME(TCHARM_NUM_ELEMENTS,tcharm_num_elements)(void) 
554 { return TCHARM_Num_elements();}
555
556 //Make sure this address will migrate with us when we move:
557 static void checkAddress(void *data)
558 {
559         if (tcharm_nomig||tcharm_nothreads) return; //Stack is not isomalloc'd
560         if (!CmiIsomallocInRange(data))
561             CkAbort("The UserData you register must be allocated on the stack!\n");
562 }
563
564 /* Old "register"-based userdata: */
565 CDECL int TCHARM_Register(void *data,TCHARM_Pup_fn pfn)
566
567         TCHARMAPI("TCHARM_Register");
568         checkAddress(data);
569         return TCharm::get()->add(TCharm::UserData(pfn,data));
570 }
571 FDECL int FTN_NAME(TCHARM_REGISTER,tcharm_register)
572         (void *data,TCpupUserDataF pfn)
573
574         TCHARMAPI("TCHARM_Register");
575         checkAddress(data);
576         return TCharm::get()->add(TCharm::UserData(
577                 pfn,data,TCharm::UserData::isFortran()));
578 }
579
580 CDECL void *TCHARM_Get_userdata(int id)
581 {
582         TCHARMAPI("TCHARM_Get_userdata");
583         return TCharm::get()->lookupUserData(id);
584 }
585 FDECL void *FTN_NAME(TCHARM_GET_USERDATA,tcharm_get_userdata)(int *id)
586 { return TCHARM_Get_userdata(*id); }
587
588 /* New hardcoded-ID userdata: */
589 CDECL void TCHARM_Set_global(int globalID,void *new_value,TCHARM_Pup_global_fn pup_or_NULL)
590 {
591         TCHARMAPI("TCHARM_Set_global");
592         TCharm *tc=TCharm::get();
593         if (tc->sud.length()<=globalID)
594         { //We don't have room for this ID yet: make room
595                 int newLen=2*globalID;
596                 tc->sud.resize(newLen);
597         }
598         tc->sud[globalID]=TCharm::UserData((TCHARM_Pup_fn) pup_or_NULL,new_value);
599 }
600 CDECL void *TCHARM_Get_global(int globalID)
601 {
602         //Skip TCHARMAPI("TCHARM_Get_global") because there's no dynamic allocation here,
603         // and this routine should be as fast as possible.
604         CkVec<TCharm::UserData> &v=TCharm::get()->sud;
605         if (v.length()<=globalID) return NULL; //Uninitialized global
606         return v[globalID].getData();
607 }
608
609 CDECL void TCHARM_Migrate(void)
610 {
611         TCHARMAPI("TCHARM_Migrate");
612         TCharm::get()->migrate();
613 }
614 FORTRAN_AS_C(TCHARM_MIGRATE,TCHARM_Migrate,tcharm_migrate,(void),())
615
616 CDECL void TCHARM_Migrate_to(int destPE)
617 {
618         TCHARMAPI("TCHARM_Migrate_to");
619         TCharm::get()->migrateTo(destPE);
620 }
621 FORTRAN_AS_C(TCHARM_MIGRATE_TO,TCHARM_Migrate_to,tcharm_migrate_to,
622         (int *destPE),(*destPE))
623
624 CDECL void TCHARM_Yield(void)
625 {
626         TCHARMAPI("TCHARM_Yield");
627         TCharm::get()->schedule();
628 }
629 FORTRAN_AS_C(TCHARM_YIELD,TCHARM_Yield,tcharm_yield,(void),())
630
631 CDECL void TCHARM_Barrier(void)
632 {
633         TCHARMAPI("TCHARM_Barrier");
634         TCharm::get()->barrier();
635 }
636 FORTRAN_AS_C(TCHARM_BARRIER,TCHARM_Barrier,tcharm_barrier,(void),())
637
638 CDECL void TCHARM_Done(void)
639 {
640         TCHARMAPI("TCHARM_Done");
641         TCharm *c=TCharm::getNULL();
642         if (!c) CkExit();
643         else c->done();
644 }
645 FORTRAN_AS_C(TCHARM_DONE,TCHARM_Done,tcharm_done,(void),())
646
647
648 CDECL double TCHARM_Wall_timer(void)
649 {
650   TCHARMAPI("TCHARM_Wall_timer");
651   TCharm *c=TCharm::getNULL();
652   if(!c) return CkWallTimer();
653   else { //Have to apply current thread's time offset
654     return CkWallTimer()+c->getTimeOffset();
655   }
656 }
657
658 #if 1
659 /*Include Fortran-style "iargc" and "getarg" routines.
660 These are needed to get access to the command-line arguments from Fortran.
661 */
662 FDECL int FTN_NAME(TCHARM_IARGC,tcharm_iargc)(void) {
663   TCHARMAPI("tcharm_iargc");
664   return CkGetArgc()-1;
665 }
666
667 FDECL void FTN_NAME(TCHARM_GETARG,tcharm_getarg)
668         (int *i_p,char *dest,int destLen)
669 {
670   TCHARMAPI("tcharm_getarg");
671   int i=*i_p;
672   if (i<0) CkAbort("tcharm_getarg called with negative argument!");
673   if (i>=CkGetArgc()) CkAbort("tcharm_getarg called with argument > iargc!");
674   const char *src=CkGetArgv()[i];
675   strcpy(dest,src);
676   for (i=strlen(dest);i<destLen;i++) dest[i]=' ';
677 }
678
679 #endif
680
681 //These silly routines are used for serial startup:
682 extern void _initCharm(int argc, char **argv);
683 CDECL void TCHARM_Init(int *argc,char ***argv) {
684         if (!tcharm_initted) {
685           ConverseInit(*argc, *argv, (CmiStartFn) _initCharm,1,1);
686           _initCharm(*argc,*argv);
687         }
688 }
689
690 FDECL void FTN_NAME(TCHARM_INIT,tcharm_init)(void)
691 {
692         int argc=1;
693         char *argv_sto[2]={"foo",NULL};
694         char **argv=argv_sto;
695         TCHARM_Init(&argc,&argv);
696 }
697
698 /***********************************
699 * TCHARM Semaphores:
700 * The idea is one side "puts", the other side "gets"; 
701 * but the calls can come in any order--
702 * if the "get" comes first, it blocks until the put.
703 * This makes a convenient, race-condition-free way to do
704 * onetime initializations.  
705 */
706 /// Find this semaphore, or insert if there isn't one:
707 TCharm::TCharmSemaphore *TCharm::findSema(int id) {
708         for (int s=0;s<sema.size();s++)
709                 if (sema[s].id==id) 
710                         return &sema[s];
711         sema.push_back(TCharmSemaphore(id));
712         return &sema[sema.size()-1];
713 }
714 /// Remove this semaphore from the list
715 void TCharm::freeSema(TCharmSemaphore *doomed) {
716         int id=doomed->id;
717         for (int s=0;s<sema.size();s++)
718                 if (sema[s].id==id) {
719                         sema[s]=sema[sema.length()-1];
720                         sema.length()--;
721                         return;
722                 }
723         CkAbort("Tried to free nonexistent TCharm semaphore");
724 }
725
726 /// Block until this semaphore has data:
727 TCharm::TCharmSemaphore *TCharm::getSema(int id) {
728         TCharmSemaphore *s=findSema(id);
729         if (s->data==NULL) 
730         { //Semaphore isn't filled yet: wait until it is
731                 s->thread=CthSelf();
732                 suspend(); //Will be woken by semaPut
733                 // Semaphore may have moved-- find it again
734                 s=findSema(id);
735                 if (s->data==NULL) CkAbort("TCharm::semaGet awoken too early!");
736         }
737         return s;
738 }
739
740 /// Store data at the semaphore "id".
741 ///  The put can come before or after the get.
742 void TCharm::semaPut(int id,void *data) {
743         TCharmSemaphore *s=findSema(id);
744         if (s->data!=NULL) CkAbort("Duplicate calls to TCharm::semaPut!");
745         s->data=data;
746         DBG("semaPut "<<id<<" "<<data);
747         if (s->thread!=NULL) {//Awaken the thread
748                 s->thread=NULL;
749                 resume();
750         }
751 }
752
753 /// Retreive data from the semaphore "id".
754 ///  Blocks if the data is not immediately available.
755 ///  Consumes the data, so another put will be required for the next get.
756 void *TCharm::semaGet(int id) {
757         TCharmSemaphore *s=getSema(id);
758         void *ret=s->data;
759         DBG("semaGet "<<id<<" "<<ret);
760         // Now remove the semaphore from the list:
761         freeSema(s);
762         return ret;
763 }
764
765 /// Retreive data from the semaphore "id".
766 ///  Blocks if the data is not immediately available.
767 void *TCharm::semaGets(int id) {
768         TCharmSemaphore *s=getSema(id);
769         return s->data;
770 }
771
772 /// Retreive data from the semaphore "id", or returns NULL.
773 void *TCharm::semaPeek(int id) {
774         TCharmSemaphore *s=findSema(id);
775         return s->data;
776 }
777
778 #include "tcharm.def.h"