Repositories / ecl.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 4548ed7)
builder: provide wrapper for randomized function init name
authorDaniel Kochmański <daniel@turtleware.eu>
Fri, 2 Oct 2015 10:51:22 +0000 (12:51 +0200)
committerDaniel Kochmański <daniel@turtleware.eu>
Fri, 2 Oct 2015 11:01:04 +0000 (13:01 +0200)
Randomized init funciton name is used internally and prevents symbol
clashes which lead to bugs when loading systems of the same name
(bundles for instance).

On the other hand wrapper provides a way to initialize library from
the C code. In this case it is programmer responsibility to name his
system uniquely. It will initialize it's submodules fine.

Fixes #74. Fixes #177.

Signed-off-by: Daniel Kochmański <daniel@turtleware.eu>
src/cmp/cmpmain.lsp patch | blob | blame | history
src/cmp/cmpname.lsp patch | blob | blame | history

diff --git a/src/cmp/cmpmain.lsp b/src/cmp/cmpmain.lsp
index dd422e5..f4f7da4 100755 (executable)
--- a/src/cmp/cmpmain.lsp
+++ b/src/cmp/cmpmain.lsp
@@ -233,7 +233,7 @@ the environment variable TMPDIR to a different value." template))
 #ifdef __cplusplus
 extern \"C\"
 #endif
-ECL_DLLEXPORT
+
 void ~A(cl_object cblock)
 {
         /*
@@ -272,6 +272,16 @@ void ~A(cl_object cblock)
 }
 ")
 
+(defconstant +lisp-init-wrapper+ "
+ECL_DLLEXPORT
+void ~A(cl_object cblock)
+{
+        /* This function is a wrapper over the randomized init function
+         * name. */
+        ~A(cblock);
+}
+")
+
 (defconstant +lisp-program-main+ "
 extern int
 main(int argc, char **argv)
@@ -387,15 +397,28 @@ filesystem or in the database of ASDF modules."
             (find-archive system))
        (fallback)))))
 
-(defun builder (target output-name &key lisp-files ld-flags
-                (init-name nil)
-                (main-name nil)
-                (prologue-code "")
-                (epilogue-code (when (eq target :program) '(SI::TOP-LEVEL T)))
-                #+:win32 (system :console)
+(defun builder (target output-name
+                &key
+                  lisp-files ld-flags
+                  (init-name nil)
+                  (main-name nil)
+                  (prologue-code "")
+                  (epilogue-code (when (eq target :program) '(SI::TOP-LEVEL T)))
+                  #+:win32 (system :console)
                 &aux
-                (*suppress-compiler-messages* (or *suppress-compiler-messages*
-                                                  (not *compile-verbose*))))
+                  (*suppress-compiler-messages* (or *suppress-compiler-messages*
+                                                    (not *compile-verbose*)))
+                  (output-name (if (or (symbolp output-name) (stringp output-name))
+                                   (compile-file-pathname output-name :type target)
+                                   output-name))
+                  (init-name (or init-name (compute-init-name output-name
+                                                              :kind target)))
+                  (wrap-init-name (compute-init-name output-name
+                                                     :kind target
+                                                     :wrapper t))
+                  (main-name (or main-name (compute-init-name output-name
+                                                              :kind target
+                                                              :prefix "main_"))))
   ;;
   ;; The epilogue-code can be either a string made of C code, or a
   ;; lisp form.  In the latter case we add some additional C code to
@@ -470,14 +493,7 @@ output = si_safe_eval(2, ecl_read_from_cstring(lisp_code), ECL_NIL);
                                  submodules-data))
     (setq c-file (open c-name :direction :output :external-format :default))
     (format c-file +lisp-program-header+ submodules)
-    (when (or (symbolp output-name) (stringp output-name))
-      (setf output-name (compile-file-pathname output-name :type target)))
-    (unless init-name
-      (setf init-name (compute-init-name output-name :kind target)))
-    (unless main-name
-      (setf main-name (compute-init-name output-name
-                                         :kind target
-                                         :prefix "main_")))
+
     (let ((init-tag (init-name-tag init-name :kind target)))
       (ecase target
         (:program
@@ -492,9 +508,9 @@ output = si_safe_eval(2, ecl_read_from_cstring(lisp_code), ECL_NIL);
          (compiler-cc c-name o-name)
          (linker-cc output-name (list* (namestring o-name) ld-flags)))
         ((:library :static-library :lib)
-         (format c-file +lisp-program-init+ init-name init-tag prologue-code
-                 submodules epilogue-code)
-         (cmpnote "Library initialization function is ~A" main-name)
+         (format c-file +lisp-program-init+
+                 init-name init-tag prologue-code submodules epilogue-code)
+         (format c-file +lisp-init-wrapper+ wrap-init-name init-name)
          (format c-file +lisp-library-main+
                  main-name prologue-code init-name epilogue-code)
          (close c-file)
@@ -503,9 +519,9 @@ output = si_safe_eval(2, ecl_read_from_cstring(lisp_code), ECL_NIL);
          (linker-ar output-name o-name ld-flags))
         #+dlopen
         ((:shared-library :dll)
-         (format c-file +lisp-program-init+ init-name init-tag prologue-code
-                 submodules epilogue-code)
-         (cmpnote "Library initialization function is ~A" main-name)
+         (format c-file +lisp-program-init+
+                 init-name init-tag prologue-code submodules epilogue-code)
+         (format c-file +lisp-init-wrapper+ wrap-init-name init-name)
          (format c-file +lisp-library-main+
                  main-name prologue-code init-name epilogue-code)
          (close c-file)
diff --git a/src/cmp/cmpname.lsp b/src/cmp/cmpname.lsp
index 0f0ca87..be6b27a 100644 (file)
--- a/src/cmp/cmpname.lsp
+++ b/src/cmp/cmpname.lsp
@@ -115,7 +115,9 @@ the function name it precedes."
       (subseq name (length prefix) nil)
       name))
 
-(defun compute-init-name (pathname &key (kind (guess-kind pathname)) (prefix nil))
+(defun compute-init-name (pathname &key (kind (guess-kind pathname))
+                                     (prefix nil)
+                                     (wrapper nil))
   "Computes initialization function name. Libraries, FASLS and
 programs init function names can't be randomized to allow
 initialization from the C code which wants to use it."
@@ -127,11 +129,15 @@ initialization from the C code which wants to use it."
       ((:fasl :fas)
        (init-function-name "CODE" :kind :fas :prefix prefix))
       ((:static-library :lib)
-       (init-function-name (remove-prefix +static-library-prefix+ filename)
+       (init-function-name (if wrapper
+                               (remove-prefix +static-library-prefix+ filename)
+                               unique-name)
                            :kind :lib
                            :prefix prefix))
       ((:shared-library :dll)
-       (init-function-name (remove-prefix +shared-library-prefix+ filename)
+       (init-function-name (if wrapper
+                               (remove-prefix +shared-library-prefix+ filename)
+                               unique-name)
                            :kind :dll
                            :prefix prefix))
       ((:program)
Embeddable Common Lisp (Official: https://gitlab.com/embeddable-common-lisp/ecl)