Repositories / ecl.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 29cd90c)
cmp: embed unique tag with init function name in each exported module
authorDaniel Kochmański <daniel@turtleware.eu>
Thu, 30 Jul 2015 19:20:15 +0000 (21:20 +0200)
committerDaniel Kochmański <daniel@turtleware.eu>
Thu, 30 Jul 2015 19:20:15 +0000 (21:20 +0200)
This is necessary if we want to retrieve function name from compiled
binary, what is necessary if we want to use unique names for this
function. This is necessary for fix of issue #41.

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
src/new-cmp/cmpmain.lsp patch | blob | blame | history

diff --git a/src/cmp/cmpmain.lsp b/src/cmp/cmpmain.lsp
index ebbc920..06f2233 100755 (executable)
--- a/src/cmp/cmpmain.lsp
+++ b/src/cmp/cmpmain.lsp
@@ -247,6 +247,7 @@ void ~A(cl_object cblock)
                 cblock->cblock.data_size = 0;
                 return;
         }
+        Cblock->cblock.data_text = (const cl_object *)\"~A\";
         ~A
 {
         /*
@@ -481,47 +482,50 @@ output = si_safe_eval(2, ecl_read_from_cstring(lisp_code), ECL_NIL);
       (setf main-name (compute-init-name output-name
                                          :kind target
                                          :prefix "main_")))
-    (ecase target
-      (:program
-       (format c-file +lisp-program-init+ init-name "" submodules "")
-       (format c-file #+:win32 (ecase system (:console +lisp-program-main+)
-                                             (:windows +lisp-program-winmain+))
-                      #-:win32 +lisp-program-main+
-                      prologue-code init-name epilogue-code)
-       (close c-file)
-       (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 prologue-code
-               submodules epilogue-code)
-       (cmpnote "Library initialization function is ~A" main-name)
-       (format c-file +lisp-library-main+
-               main-name prologue-code init-name epilogue-code)
-       (close c-file)
-       (compiler-cc c-name o-name)
-       (when (probe-file output-name) (delete-file output-name))
-       (linker-ar output-name o-name ld-flags))
-      #+dlopen
-      ((:shared-library :dll)
-       (format c-file +lisp-program-init+ init-name prologue-code
-               submodules epilogue-code)
-       (cmpnote "Library initialization function is ~A" main-name)
-       (format c-file +lisp-library-main+
-               main-name prologue-code init-name epilogue-code)
-       (close c-file)
-       (compiler-cc c-name o-name)
-       (shared-cc output-name (list* o-name ld-flags)))
-      #+dlopen
-      (:fasl
-       (format c-file +lisp-program-init+ init-name prologue-code
-               submodules epilogue-code)
-       (close c-file)
-       (compiler-cc c-name o-name)
-       (bundle-cc output-name init-name (list* o-name ld-flags))))
-    (mapc 'cmp-delete-file tmp-names)
-    (cmp-delete-file c-name)
-    (cmp-delete-file o-name)
-    output-name))
+    (let ((init-tag (init-name-tag init-name :kind target)))
+      (ecase target
+        (:program
+         (format c-file +lisp-program-init+ init-name
+                 init-tag
+                 "" submodules "")
+         (format c-file #+:win32 (ecase system (:console +lisp-program-main+)
+                                        (:windows +lisp-program-winmain+))
+                 #-:win32 +lisp-program-main+
+                 prologue-code init-name epilogue-code)
+         (close c-file)
+         (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-library-main+
+                 main-name prologue-code init-name epilogue-code)
+         (close c-file)
+         (compiler-cc c-name o-name)
+         (when (probe-file output-name) (delete-file output-name))
+         (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-library-main+
+                 main-name prologue-code init-name epilogue-code)
+         (close c-file)
+         (compiler-cc c-name o-name)
+         (shared-cc output-name (list* o-name ld-flags)))
+        #+dlopen
+        (:fasl
+         (format c-file +lisp-program-init+ init-name init-tag prologue-code
+                 submodules epilogue-code)
+         (close c-file)
+         (compiler-cc c-name o-name)
+         (bundle-cc output-name init-name (list* o-name ld-flags))))
+      (mapc 'cmp-delete-file tmp-names)
+      (cmp-delete-file c-name)
+      (cmp-delete-file o-name)
+      output-name)))
 
 (defun build-fasl (&rest args)
   (apply #'builder :fasl args))
diff --git a/src/cmp/cmpname.lsp b/src/cmp/cmpname.lsp
index 27e9eb2..8dd237f 100644 (file)
--- a/src/cmp/cmpname.lsp
+++ b/src/cmp/cmpname.lsp
@@ -56,8 +56,17 @@ machine."
                            (encode-number-in-name ms))))
     tag))
 
-(defun init-name-tag (init-name)
-  (concatenate 'base-string "@EcLtAg" ":" init-name "@"))
+(defun kind->tag (kind)
+  (case kind
+    ((:object :c)           "@EcLtAg")
+    ((:fasl :fas)           "@EcLtAg_fas")
+    ((:static-library :lib) "@EcLtAg_lib")
+    ((:shared-library :dll) "@EcLtAg_dll")
+    ((:program)             "@EcLtAg_exe")
+    (otherwise (error "C::BUILDER cannot accept files of kind ~s" kind))))
+
+(defun init-name-tag (init-name &key (kind :object))
+  (concatenate 'base-string (kind->tag kind) ":" init-name "@"))
 
 (defun search-tag (stream tag)
   (declare (si::c-local))
diff --git a/src/new-cmp/cmpmain.lsp b/src/new-cmp/cmpmain.lsp
index 97b1280..dce4982 100644 (file)
--- a/src/new-cmp/cmpmain.lsp
+++ b/src/new-cmp/cmpmain.lsp
@@ -184,6 +184,7 @@ void ~A(cl_object cblock)
 #if defined(ECL_DYNAMIC_VV) && defined(ECL_SHARED_DATA)
         VV = Cblock->cblock.data;
 #endif
+        Cblock->cblock.data_text = (const cl_object *)\"~A\";
         ~A
 {
         cl_object current, next = Cblock;
@@ -372,56 +373,58 @@ static cl_object VV[VM];
       (setf output-name (compile-file-pathname output-name :type target)))
     (unless init-name
       (setf init-name (compute-init-name output-name :kind target)))
-    (ecase target
-      (:program
-       (format c-file +lisp-program-init+ init-name "" shared-data-file
-               submodules "")
-       (format c-file #+:win32 (ecase system (:console +lisp-program-main+)
-                                             (:windows +lisp-program-winmain+))
-                      #-:win32 +lisp-program-main+
-                      prologue-code init-name epilogue-code)
-       (close c-file)
-       (compiler-cc c-name o-name)
-       (apply #'linker-cc output-name (namestring o-name) ld-flags))
-      ((:library :static-library :lib)
-       (format c-file +lisp-program-init+ init-name prologue-code
-               shared-data-file submodules epilogue-code)
-       (close c-file)
-       (compiler-cc c-name o-name)
-       (when (probe-file output-name) (delete-file output-name))
-       #-msvc
-       (progn
-       (safe-system (format nil "ar cr ~A ~A ~{~A ~}"
-                            output-name o-name ld-flags))
-       (safe-system (format nil "ranlib ~A" output-name)))
-       #+msvc
-       (unwind-protect
+
+    (let ((init-tag (init-name-tag init-name :kind target)))
+      (ecase target
+        (:program
+         (format c-file +lisp-program-init+ init-name init-tag "" shared-data-file
+                 submodules "")
+         (format c-file #+:win32 (ecase system (:console +lisp-program-main+)
+                                        (:windows +lisp-program-winmain+))
+                 #-:win32 +lisp-program-main+
+                 prologue-code init-name epilogue-code)
+         (close c-file)
+         (compiler-cc c-name o-name)
+         (apply #'linker-cc output-name (namestring o-name) ld-flags))
+        ((:library :static-library :lib)
+         (format c-file +lisp-program-init+ init-name init-tag prologue-code
+                 shared-data-file submodules epilogue-code)
+         (close c-file)
+         (compiler-cc c-name o-name)
+         (when (probe-file output-name) (delete-file output-name))
+         #-msvc
          (progn
-           (with-open-file (f "static_lib.tmp" :direction :output :if-does-not-exist :create :if-exists :supersede)
-             (format f "/DEBUGTYPE:CV /OUT:~A ~A ~{~&\"~A\"~}"
-                     output-name o-name ld-flags))
-           (safe-system "link -lib @static_lib.tmp"))
-         (when (probe-file "static_lib.tmp")
-           (cmp-delete-file "static_lib.tmp")))
-       )
-      #+dlopen
-      ((:shared-library :dll)
-       (format c-file +lisp-program-init+ init-name prologue-code
-               shared-data-file submodules epilogue-code)
-       (close c-file)
-       (compiler-cc c-name o-name)
-       (apply #'shared-cc output-name o-name ld-flags))
-      #+dlopen
-      (:fasl
-       (format c-file +lisp-program-init+ init-name prologue-code shared-data-file
-               submodules epilogue-code)
-       (close c-file)
-       (compiler-cc c-name o-name)
-       (apply #'bundle-cc output-name init-name o-name ld-flags)))
-    (cmp-delete-file tmp-name)
-    (cmp-delete-file c-name)
-    (cmp-delete-file o-name)
-    output-name))
+           (safe-system (format nil "ar cr ~A ~A ~{~A ~}"
+                                output-name o-name ld-flags))
+           (safe-system (format nil "ranlib ~A" output-name)))
+         #+msvc
+         (unwind-protect
+              (progn
+                (with-open-file (f "static_lib.tmp" :direction :output :if-does-not-exist :create :if-exists :supersede)
+                  (format f "/DEBUGTYPE:CV /OUT:~A ~A ~{~&\"~A\"~}"
+                          output-name o-name ld-flags))
+                (safe-system "link -lib @static_lib.tmp"))
+           (when (probe-file "static_lib.tmp")
+             (cmp-delete-file "static_lib.tmp")))
+         )
+        #+dlopen
+        ((:shared-library :dll)
+         (format c-file +lisp-program-init+ init-name init-tag prologue-code
+                 shared-data-file submodules epilogue-code)
+         (close c-file)
+         (compiler-cc c-name o-name)
+         (apply #'shared-cc output-name o-name ld-flags))
+        #+dlopen
+        (:fasl
+         (format c-file +lisp-program-init+ init-name init-tag prologue-code shared-data-file
+                 submodules epilogue-code)
+         (close c-file)
+         (compiler-cc c-name o-name)
+         (apply #'bundle-cc output-name init-name o-name ld-flags)))
+      (cmp-delete-file tmp-name)
+      (cmp-delete-file c-name)
+      (cmp-delete-file o-name)
+      output-name)))
 
 (defun build-fasl (&rest args)
   (apply #'builder :fasl args))
Embeddable Common Lisp (Official: https://gitlab.com/embeddable-common-lisp/ecl)