Actual source code: dl.c

  1: #define PETSC_DLL
  2: /*
  3:       Routines for opening dynamic link libraries (DLLs), keeping a searchable
  4:    path of DLLs, obtaining remote DLLs via a URL and opening them locally.
  5: */

 7:  #include petsc.h
 8:  #include petscsys.h
 9:  #include ../src/sys/dll/dlimpl.h

 11: /* ------------------------------------------------------------------------------*/
 12: /*
 13:       Code to maintain a list of opened dynamic libraries and load symbols
 14: */
 15: struct _n_PetscDLLibrary {
 16:   PetscDLLibrary next;
 17:   PetscDLHandle  handle;
 18:   char           libname[PETSC_MAX_PATH_LEN];
 19: };

 23: PetscErrorCode  PetscDLLibraryPrintPath(PetscDLLibrary libs)
 24: {
 26:   while (libs) {
 27:     PetscErrorPrintf("  %s\n",libs->libname);
 28:     libs = libs->next;
 29:   }
 30:   return(0);
 31: }

 35: /*@C
 36:    PetscDLLibraryRetrieve - Copies a PETSc dynamic library from a remote location
 37:      (if it is remote), indicates if it exits and its local name.

 39:      Collective on MPI_Comm

 41:    Input Parameters:
 42: +   comm - processors that are opening the library
 43: -   libname - name of the library, can be relative or absolute

 45:    Output Parameter:
 46: .   handle - library handle 

 48:    Level: developer

 50:    Notes:
 51:    [[<http,ftp>://hostname]/directoryname/]filename[.so.1.0]

 53:    ${PETSC_ARCH}, ${PETSC_DIR}, ${PETSC_LIB_DIR}, or ${any environmental variable}
 54:    occuring in directoryname and filename will be replaced with appropriate values.
 55: @*/
 56: PetscErrorCode  PetscDLLibraryRetrieve(MPI_Comm comm,const char libname[],char *lname,size_t llen,PetscTruth *found)
 57: {
 58:   char           *buf,*par2,suffix[16],*gz,*so;
 59:   size_t         len;

 63:   /* 
 64:      make copy of library name and replace $PETSC_ARCH etc
 65:      so we can add to the end of it to look for something like .so.1.0 etc.
 66:   */
 67:   PetscStrlen(libname,&len);
 68:   len  = PetscMax(4*len,PETSC_MAX_PATH_LEN);
 69:   PetscMalloc(len*sizeof(char),&buf);
 70:   par2 = buf;
 71:   PetscStrreplace(comm,libname,par2,len);

 73:   /* temporarily remove .gz if it ends library name */
 74:   PetscStrrstr(par2,".gz",&gz);
 75:   if (gz) {
 76:     PetscStrlen(gz,&len);
 77:     if (len != 3) gz  = 0; /* do not end (exactly) with .gz */
 78:     else          *gz = 0; /* ends with .gz, so remove it   */
 79:   }
 80:   /* strip out .a from it if user put it in by mistake */
 81:   PetscStrlen(par2,&len);
 82:   if (par2[len-1] == 'a' && par2[len-2] == '.') par2[len-2] = 0;


 85:   /* see if library name does already not have suffix attached */
 86:   PetscStrcpy(suffix,".");
 87:   PetscStrcat(suffix,PETSC_SLSUFFIX);
 88:   PetscStrrstr(par2,suffix,&so);
 89:   /* and attach the suffix if it is not there */
 90:   if (!so) { PetscStrcat(par2,suffix); }

 92:   /* restore the .gz suffix if it was there */
 93:   if (gz) { PetscStrcat(par2,".gz"); }

 95:   /* and finally retrieve the file */
 96:   PetscFileRetrieve(comm,par2,lname,llen,found);

 98:   PetscFree(buf);
 99:   return(0);
100: }


105: /*@C
106:    PetscDLLibraryOpen - Opens a PETSc dynamic link library

108:      Collective on MPI_Comm

110:    Input Parameters:
111: +   comm - processors that are opening the library
112: -   path - name of the library, can be relative or absolute

114:    Output Parameter:
115: .   entry - a PETSc dynamic link library entry

117:    Level: developer

119:    Notes:
120:    [[<http,ftp>://hostname]/directoryname/]filename[.so.1.0]

122:    ${PETSC_ARCH} occuring in directoryname and filename 
123:    will be replaced with the appropriate value.
124: @*/
125: PetscErrorCode  PetscDLLibraryOpen(MPI_Comm comm,const char path[],PetscDLLibrary *entry)
126: {
128:   PetscTruth     foundlibrary,match;
129:   char           libname[PETSC_MAX_PATH_LEN],par2[PETSC_MAX_PATH_LEN],suffix[16],*s;
130:   char           *basename,registername[128];
131:   PetscDLHandle  handle;
132:   PetscErrorCode (*func)(const char*) = NULL;
133:   size_t         len;


139:   *entry = PETSC_NULL;
140: 
141:   /* retrieve the library */
142:   PetscInfo1(0,"Retrieving %s\n",path);
143:   PetscDLLibraryRetrieve(comm,path,par2,PETSC_MAX_PATH_LEN,&foundlibrary);
144:   if (!foundlibrary) SETERRQ1(PETSC_ERR_FILE_OPEN,"Unable to locate dynamic library:\n  %s\n",path);
145:   /* Eventually config/configure.py should determine if the system needs an executable dynamic library */
146: #define PETSC_USE_NONEXECUTABLE_SO
147: #if !defined(PETSC_USE_NONEXECUTABLE_SO)
148:   PetscTestFile(par2,'x',&foundlibrary);
149:   if (!foundlibrary) SETERRQ2(PETSC_ERR_FILE_OPEN,"Dynamic library is not executable:\n  %s\n  %s\n",path,par2);
150: #endif

152:   /* copy path and setup shared library suffix  */
153:   PetscStrncpy(libname,path,PETSC_MAX_PATH_LEN);
154:   PetscStrcpy(suffix,".");
155:   PetscStrcat(suffix,PETSC_SLSUFFIX);
156:   /* remove wrong suffixes from libname */
157:   PetscStrrstr(libname,".gz",&s);
158:   if (s && s[3] == 0) s[0] = 0;
159:   PetscStrrstr(libname,".a",&s);
160:   if (s && s[2] == 0) s[0] = 0;
161:   /* remove shared suffix from libname */
162:   PetscStrrstr(libname,suffix,&s);
163:   if (s) s[0] = 0;

165:   /* open the dynamic library */
166:   PetscInfo1(0,"Opening dynamic library %s\n",libname);
167:   PetscDLOpen(par2,PETSC_DL_DECIDE,&handle);

169:   /* look for [path/]libXXXXX.YYY and extract out the XXXXXX */
170:   PetscStrrchr(libname,'/',&basename); /* XXX Windows ??? */
171:   if (!basename) basename = libname;
172:   PetscStrncmp(basename,"lib",3,&match);
173:   if (match) {
174:     basename = basename + 3;
175:   } else {
176:     PetscInfo1(0,"Dynamic library %s do not have lib prefix\n",libname);
177:   }
178:   PetscStrlen(basename,&len);
179:   PetscStrcpy(registername,"PetscDLLibraryRegister_");
180:   PetscStrncat(registername,basename,len);
181:   PetscDLSym(handle,registername,(void**)&func);
182:   if (func) {
183:     PetscInfo1(0,"Loading registered routines from %s\n",libname);
184:     (*func)(libname);
185:   } else {
186:     PetscInfo2(0,"Dynamic library %s do not have symbol %s\n",libname,registername);
187:   }
188: 
189:   PetscNew(struct _n_PetscDLLibrary,entry);
190:   (*entry)->next   = 0;
191:   (*entry)->handle = handle;
192:   PetscStrcpy((*entry)->libname,libname);

194:   return(0);
195: }

199: /*@C
200:    PetscDLLibrarySym - Load a symbol from the dynamic link libraries.

202:    Collective on MPI_Comm

204:    Input Parameter:
205: +  comm - communicator that will open the library
206: .  outlist - list of already open libraries that may contain symbol (checks here before path)
207: .  path     - optional complete library name
208: -  insymbol - name of symbol

210:    Output Parameter:
211: .  value 

213:    Level: developer

215:    Notes: Symbol can be of the form
216:         [/path/libname[.so.1.0]:]functionname[()] where items in [] denote optional 

218:         Will attempt to (retrieve and) open the library if it is not yet been opened.

220: @*/
221: PetscErrorCode  PetscDLLibrarySym(MPI_Comm comm,PetscDLLibrary *outlist,const char path[],const char insymbol[],void **value)
222: {
223:   char           libname[PETSC_MAX_PATH_LEN],suffix[16],*symbol,*s;
224:   size_t         len;
225:   PetscDLLibrary nlist,prev,list;


234:   list   = *outlist;
235:   *value = 0;

237:   /* make copy of symbol so we can edit it in place */
238:   PetscStrlen(insymbol,&len);
239:   PetscMalloc((len+1)*sizeof(char),&symbol);
240:   PetscStrcpy(symbol,insymbol);
241:   /* If symbol contains () then replace with a NULL, to support functionname() */
242:   PetscStrchr(symbol,'(',&s);
243:   if (s) s[0] = 0;

245:   /*
246:        Function name does include library 
247:        -------------------------------------
248:   */
249:   if (path && path[0] != '\0') {
250:     /* copy path and remove suffix from libname */
251:     PetscStrncpy(libname,path,PETSC_MAX_PATH_LEN);
252:     PetscStrcpy(suffix,".");
253:     PetscStrcat(suffix,PETSC_SLSUFFIX);
254:     PetscStrrstr(libname,suffix,&s);
255:     if (s) s[0] = 0;
256:     /* Look if library is already opened and in path */
257:     prev  = 0;
258:     nlist = list;
259:     while (nlist) {
260:       PetscTruth match;
261:       PetscStrcmp(nlist->libname,libname,&match);
262:       if (match) goto done;
263:       prev  = nlist;
264:       nlist = nlist->next;
265:     }
266:     /* open the library and append it to path */
267:     PetscDLLibraryOpen(comm,path,&nlist);
268:     PetscInfo1(0,"Appending %s to dynamic library search path\n",path);
269:     if (prev) { prev->next = nlist; }
270:     else      { *outlist   = nlist; }

272:   done:;
273:     PetscDLSym(nlist->handle,symbol,value);
274:     if (!*value) {
275:       SETERRQ2(PETSC_ERR_PLIB,"Unable to locate function %s in dynamic library %s",insymbol,path);
276:     }
277:     PetscInfo2(0,"Loading function %s from dynamic library %s\n",insymbol,path);

279:   /*
280:        Function name does not include library so search path
281:        -----------------------------------------------------
282:   */
283:   } else {
284:     while (list) {
285:       PetscDLSym(list->handle,symbol,value);
286:       if (*value) {
287:         PetscInfo2(0,"Loading symbol %s from dynamic library %s\n",symbol,list->libname);
288:         break;
289:       }
290:       list = list->next;
291:     }
292:     if (!*value) {
293:       PetscDLSym(PETSC_NULL,symbol,value);
294:       if (*value) {
295:         PetscInfo1(0,"Loading symbol %s from object code\n",symbol);
296:       }
297:     }
298:   }

300:   PetscFree(symbol);
301:   return(0);
302: }

306: /*@C
307:      PetscDLLibraryAppend - Appends another dynamic link library to the seach list, to the end
308:                 of the search path.

310:      Collective on MPI_Comm

312:      Input Parameters:
313: +     comm - MPI communicator
314: -     path - name of the library

316:      Output Parameter:
317: .     outlist - list of libraries

319:      Level: developer

321:      Notes: if library is already in path will not add it.
322: @*/
323: PetscErrorCode  PetscDLLibraryAppend(MPI_Comm comm,PetscDLLibrary *outlist,const char path[])
324: {
325:   PetscDLLibrary list,prev;
327:   size_t         len;
328:   PetscTruth     match,dir;
329:   char           program[PETSC_MAX_PATH_LEN],found[8*PETSC_MAX_PATH_LEN];
330:   char           *libname,suffix[16],*s;
331:   PetscToken     token;

335: 
336:   /* is path a directory? */
337:   PetscTestDirectory(path,'r',&dir);
338:   if (dir) {
339:     PetscInfo1(0,"Checking directory %s for dynamic libraries\n",path);
340:     PetscStrcpy(program,path);
341:     PetscStrlen(program,&len);
342:     if (program[len-1] == '/') {
343:       PetscStrcat(program,"*.");
344:     } else {
345:       PetscStrcat(program,"/*.");
346:     }
347:     PetscStrcat(program,PETSC_SLSUFFIX);

349:     PetscLs(comm,program,found,8*PETSC_MAX_PATH_LEN,&dir);
350:     if (!dir) return(0);
351:   } else {
352:     PetscStrncpy(found,path,PETSC_MAX_PATH_LEN);
353:   }
354:   PetscStrcpy(suffix,".");
355:   PetscStrcat(suffix,PETSC_SLSUFFIX);

357:   PetscTokenCreate(found,'\n',&token);
358:   PetscTokenFind(token,&libname);
359:   while (libname) {
360:     /* remove suffix from libname */
361:     PetscStrrstr(libname,suffix,&s);
362:     if (s) s[0] = 0;
363:     /* see if library was already open then we are done */
364:     list  = prev = *outlist;
365:     match = PETSC_FALSE;
366:     while (list) {
367:       PetscStrcmp(list->libname,libname,&match);
368:       if (match) break;
369:       prev = list;
370:       list = list->next;
371:     }
372:     /* restore suffix from libname */
373:     if (s) s[0] = '.';
374:     if (!match) {
375:       /* open the library and add to end of list */
376:       PetscDLLibraryOpen(comm,libname,&list);
377:       PetscInfo1(0,"Appending %s to dynamic library search path\n",libname);
378:       if (!*outlist) {
379:         *outlist   = list;
380:       } else {
381:         prev->next = list;
382:       }
383:     }
384:     PetscTokenFind(token,&libname);
385:   }
386:   PetscTokenDestroy(token);
387:   return(0);
388: }

392: /*@C
393:      PetscDLLibraryPrepend - Add another dynamic library to search for symbols to the beginning of
394:                  the search path.

396:      Collective on MPI_Comm

398:      Input Parameters:
399: +     comm - MPI communicator
400: -     path - name of the library

402:      Output Parameter:
403: .     outlist - list of libraries

405:      Level: developer

407:      Notes: If library is already in path will remove old reference.

409: @*/
410: PetscErrorCode  PetscDLLibraryPrepend(MPI_Comm comm,PetscDLLibrary *outlist,const char path[])
411: {
412:   PetscDLLibrary list,prev;
414:   size_t         len;
415:   PetscTruth     match,dir;
416:   char           program[PETSC_MAX_PATH_LEN],found[8*PETSC_MAX_PATH_LEN];
417:   char           *libname,suffix[16],*s;
418:   PetscToken     token;

422: 
423:   /* is path a directory? */
424:   PetscTestDirectory(path,'r',&dir);
425:   if (dir) {
426:     PetscInfo1(0,"Checking directory %s for dynamic libraries\n",path);
427:     PetscStrcpy(program,path);
428:     PetscStrlen(program,&len);
429:     if (program[len-1] == '/') {
430:       PetscStrcat(program,"*.");
431:     } else {
432:       PetscStrcat(program,"/*.");
433:     }
434:     PetscStrcat(program,PETSC_SLSUFFIX);

436:     PetscLs(comm,program,found,8*PETSC_MAX_PATH_LEN,&dir);
437:     if (!dir) return(0);
438:   } else {
439:     PetscStrncpy(found,path,PETSC_MAX_PATH_LEN);
440:   }

442:   PetscStrcpy(suffix,".");
443:   PetscStrcat(suffix,PETSC_SLSUFFIX);

445:   PetscTokenCreate(found,'\n',&token);
446:   PetscTokenFind(token,&libname);
447:   while (libname) {
448:     /* remove suffix from libname */
449:     PetscStrstr(libname,suffix,&s);
450:     if (s) s[0] = 0;
451:     /* see if library was already open and move it to the front */
452:     prev  = 0;
453:     list  = *outlist;
454:     match = PETSC_FALSE;
455:     while (list) {
456:       PetscStrcmp(list->libname,libname,&match);
457:       if (match) {
458:         PetscInfo1(0,"Moving %s to begin of dynamic library search path\n",libname);
459:         if (prev) prev->next = list->next;
460:         if (prev) list->next = *outlist;
461:         *outlist = list;
462:         break;
463:       }
464:       prev = list;
465:       list = list->next;
466:     }
467:     /* restore suffix from libname */
468:     if (s) s[0] = '.';
469:     if (!match) {
470:       /* open the library and add to front of list */
471:       PetscDLLibraryOpen(comm,libname,&list);
472:       PetscInfo1(0,"Prepending %s to dynamic library search path\n",libname);
473:       list->next = *outlist;
474:       *outlist   = list;
475:     }
476:     PetscTokenFind(token,&libname);
477:   }
478:   PetscTokenDestroy(token);
479:   return(0);
480: }

484: /*@C
485:      PetscDLLibraryClose - Destroys the search path of dynamic libraries and closes the libraries.

487:     Collective on PetscDLLibrary

489:     Input Parameter:
490: .     head - library list

492:      Level: developer

494: @*/
495: PetscErrorCode  PetscDLLibraryClose(PetscDLLibrary list)
496: {
497:   PetscTruth     done = PETSC_FALSE;
498:   PetscDLLibrary prev,tail;

502:   if (!list) return(0);
503:   /* traverse the list in reverse order */
504:   while (!done) {
505:     if (!list->next) done = PETSC_TRUE;
506:     prev = tail = list;
507:     while (tail->next) {
508:       prev = tail;
509:       tail = tail->next;
510:     }
511:     prev->next = 0;
512:     /* close the dynamic library and free the space in entry data-structure*/
513:     PetscInfo1(0,"Closing dynamic library %s\n",tail->libname);
514:     PetscDLClose(&tail->handle);
515:     PetscFree(tail);
516:   };
517:   return(0);
518: }

520: /* ------------------------------------------------------------------------------*/

522: /*
523:    Contains the list of registered CCA components
524: */
525: PetscFList CCAList = 0;

529: /*@C
530:      PetscDLLibraryCCAAppend - Appends another CCA dynamic link library to the seach list, to the end
531:                 of the search path.

533:      Collective on MPI_Comm

535:      Input Parameters:
536: +     comm - MPI communicator
537: -     dirname - name of directory to check

539:      Output Parameter:
540: .     outlist - list of libraries

542:      Level: developer

544:      Notes: if library is already in path will not add it.
545: @*/
546: PetscErrorCode  PetscDLLibraryCCAAppend(MPI_Comm comm,PetscDLLibrary *outlist,const char dirname[])
547: {
549:   size_t         l;
550:   PetscTruth     dir;
551:   char           program[PETSC_MAX_PATH_LEN],buf[8*PETSC_MAX_PATH_LEN],*libname1,fbuf[PETSC_MAX_PATH_LEN],*found,suffix[16],*f2;
552:   char           *func,*funcname,libname[PETSC_MAX_PATH_LEN],*lib;
553:   FILE           *fp;
554:   PetscToken     token1, token2;
555:   int            err;

558:   /* is dirname a directory? */
559:   PetscTestDirectory(dirname,'r',&dir);
560:   if (!dir) return(0);

562:   PetscInfo1(0,"Checking directory %s for CCA components\n",dirname);
563:   PetscStrcpy(program,dirname);
564:   PetscStrcat(program,"/*.cca");

566:   PetscLs(comm,program,buf,8*PETSC_MAX_PATH_LEN,&dir);
567:   if (!dir) return(0);

569:   PetscStrcpy(suffix,".");
570:   PetscStrcat(suffix,PETSC_SLSUFFIX);
571:   PetscTokenCreate(buf,'\n',&token1);
572:   PetscTokenFind(token1,&libname1);
573:   while (libname1) {
574:     fp    = fopen(libname1,"r"); if (!fp) continue;
575:     while ((found = fgets(fbuf,PETSC_MAX_PATH_LEN,fp))) {
576:       if (found[0] == '!') continue;
577:       PetscStrstr(found,suffix,&f2);
578:       if (f2) { /* found library name */
579:         if (found[0] == '/') {
580:           lib = found;
581:         } else {
582:           PetscStrcpy(libname,dirname);
583:           PetscStrlen(libname,&l);
584:           if (libname[l-1] != '/') {PetscStrcat(libname,"/");}
585:           PetscStrcat(libname,found);
586:           lib  = libname;
587:         }
588:         PetscDLLibraryAppend(comm,outlist,lib);
589:       } else {
590:         PetscInfo2(0,"CCA Component function and name: %s from %s\n",found,libname1);
591:         PetscTokenCreate(found,' ',&token2);
592:         PetscTokenFind(token2,&func);
593:         PetscTokenFind(token2,&funcname);
594:         PetscFListAdd(&CCAList,funcname,func,PETSC_NULL);
595:         PetscTokenDestroy(token2);
596:       }
597:     }
598:     err = fclose(fp);
599:     if (err) SETERRQ(PETSC_ERR_SYS,"fclose() failed on file");
600:     PetscTokenFind(token1,&libname1);
601:   }
602:   PetscTokenDestroy(token1);
603:   return(0);
604: }