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