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