extensions.c 5.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181
  1. /* Copyright 2001,2002,2004,2006,2009-2011,2018-2019,2021
  2. Free Software Foundation, Inc.
  3. This file is part of Guile.
  4. Guile is free software: you can redistribute it and/or modify it
  5. under the terms of the GNU Lesser General Public License as published
  6. by the Free Software Foundation, either version 3 of the License, or
  7. (at your option) any later version.
  8. Guile is distributed in the hope that it will be useful, but WITHOUT
  9. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  10. FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
  11. License for more details.
  12. You should have received a copy of the GNU Lesser General Public
  13. License along with Guile. If not, see
  14. <https://www.gnu.org/licenses/>. */
  15. #ifdef HAVE_CONFIG_H
  16. # include <config.h>
  17. #endif
  18. #include <string.h>
  19. #include "dynl.h"
  20. #include "dynwind.h"
  21. #include "gc.h"
  22. #include "gsubr.h"
  23. #include "foreign.h"
  24. #include "strings.h"
  25. #include "threads.h"
  26. #include "extensions.h"
  27. typedef struct extension_t
  28. {
  29. struct extension_t *next;
  30. const char *lib;
  31. const char *init;
  32. void (*func)(void *);
  33. void *data;
  34. } extension_t;
  35. static extension_t *registered_extensions = NULL;
  36. static scm_i_pthread_mutex_t ext_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
  37. /* Register a LIB/INIT pair for use by `scm_load_extension'. LIB is
  38. allowed to be NULL and then only INIT is used to identify the
  39. registered entry. This is useful when you don't know the library
  40. name (which isn't really relevant anyway in a completely linked
  41. program) and you are sure that INIT is unique (which it must be for
  42. static linking). Hmm, given this reasoning, what use is LIB
  43. anyway?
  44. */
  45. void
  46. scm_c_register_extension (const char *lib, const char *init,
  47. void (*func) (void *), void *data)
  48. {
  49. extension_t *ext = scm_malloc (sizeof(extension_t));
  50. if (lib)
  51. ext->lib = scm_strdup (lib);
  52. else
  53. ext->lib = NULL;
  54. ext->init = scm_strdup (init);
  55. ext->func = func;
  56. ext->data = data;
  57. scm_i_pthread_mutex_lock (&ext_lock);
  58. ext->next = registered_extensions;
  59. registered_extensions = ext;
  60. scm_i_pthread_mutex_unlock (&ext_lock);
  61. }
  62. static void
  63. load_extension (SCM lib, SCM init)
  64. {
  65. extension_t *head;
  66. scm_i_pthread_mutex_lock (&ext_lock);
  67. head = registered_extensions;
  68. scm_i_pthread_mutex_unlock (&ext_lock);
  69. /* Search the registry. */
  70. if (head != NULL)
  71. {
  72. extension_t *ext;
  73. char *clib, *cinit;
  74. int found = 0;
  75. scm_dynwind_begin (0);
  76. clib = scm_to_utf8_string (lib);
  77. scm_dynwind_free (clib);
  78. cinit = scm_to_utf8_string (init);
  79. scm_dynwind_free (cinit);
  80. for (ext = head; ext; ext = ext->next)
  81. if ((ext->lib == NULL || !strcmp (ext->lib, clib))
  82. && !strcmp (ext->init, cinit))
  83. {
  84. ext->func (ext->data);
  85. found = 1;
  86. break;
  87. }
  88. scm_dynwind_end ();
  89. if (found)
  90. return;
  91. }
  92. /* Dynamically link the library. */
  93. #if HAVE_MODULES
  94. SCM pointer = scm_dynamic_pointer (init, scm_dynamic_link (lib));
  95. void (*f)(void) = scm_to_pointer (pointer);
  96. f ();
  97. #else
  98. scm_misc_error ("load-extension",
  99. "extension ~S:~S not registered and dynamic-link disabled",
  100. scm_list_2 (init, lib));
  101. #endif
  102. }
  103. void
  104. scm_c_load_extension (const char *lib, const char *init)
  105. {
  106. load_extension (scm_from_utf8_string (lib), scm_from_utf8_string (init));
  107. }
  108. SCM_DEFINE (scm_load_extension, "load-extension", 2, 0, 0,
  109. (SCM lib, SCM init),
  110. "Load and initialize the extension designated by LIB and INIT.\n"
  111. "When there is no pre-registered function for LIB/INIT, this is\n"
  112. "equivalent to\n"
  113. "\n"
  114. "@lisp\n"
  115. "(dynamic-call INIT (dynamic-link LIB))\n"
  116. "@end lisp\n"
  117. "\n"
  118. "When there is a pre-registered function, that function is called\n"
  119. "instead.\n"
  120. "\n"
  121. "Normally, there is no pre-registered function. This option exists\n"
  122. "only for situations where dynamic linking is unavailable or unwanted.\n"
  123. "In that case, you would statically link your program with the desired\n"
  124. "library, and register its init function right after Guile has been\n"
  125. "initialized.\n"
  126. "\n"
  127. "LIB should be a string denoting a shared library without any file type\n"
  128. "suffix such as \".so\". The suffix is provided automatically. It\n"
  129. "should also not contain any directory components. Libraries that\n"
  130. "implement Guile Extensions should be put into the normal locations for\n"
  131. "shared libraries. We recommend to use the naming convention\n"
  132. "libguile-bla-blum for a extension related to a module `(bla blum)'.\n"
  133. "\n"
  134. "The normal way for a extension to be used is to write a small Scheme\n"
  135. "file that defines a module, and to load the extension into this\n"
  136. "module. When the module is auto-loaded, the extension is loaded as\n"
  137. "well. For example,\n"
  138. "\n"
  139. "@lisp\n"
  140. "(define-module (bla blum))\n"
  141. "\n"
  142. "(load-extension \"libguile-bla-blum\" \"bla_init_blum\")\n"
  143. "@end lisp")
  144. #define FUNC_NAME s_scm_load_extension
  145. {
  146. load_extension (lib, init);
  147. return SCM_UNSPECIFIED;
  148. }
  149. #undef FUNC_NAME
  150. void
  151. scm_init_extensions ()
  152. {
  153. #include "extensions.x"
  154. }