mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-14 13:21:54 -08:00
cmp: embed unique tag with init function name in each exported module
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>
This commit is contained in:
Daniel Kochmański
parent
29cd90c448
commit
8bc260c377
3 changed files with 108 additions and 92 deletions
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue