From 24cfa8cfdfdda7a1c0e20230faa9f182d78fc67f Mon Sep 17 00:00:00 2001 From: jgarcia Date: Fri, 1 Feb 2008 11:41:34 +0000 Subject: [PATCH] Use a hashing algorithm combined with a time stamp to name initialization functions in object files --- src/CHANGELOG | 9 +++++ src/cmp/cmpmain.lsp | 77 ++++++++++++++++--------------------------- src/cmp/cmptop.lsp | 6 +++- src/cmp/cmpwt.lsp | 2 +- src/cmp/load.lsp.in | 1 + src/cmp/sysfun.lsp | 2 +- src/lsp/config.lsp.in | 2 +- 7 files changed, 47 insertions(+), 52 deletions(-) diff --git a/src/CHANGELOG b/src/CHANGELOG index 417968c54..7bba4568f 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -29,6 +29,15 @@ ECL 0.9k: consed : 160 bytes Formerly, this would cons 3200192 bytes. + - When compiling object files that will form part of either a unified FASL or + of a library (static or dynamically linked), there used to be name + collisions between the initialization functions of different modules. Now + ECL uses a cleverer hashing algorithm to name these functions, storing the + key in a string in the object file, which is later searched before linking + the file. Currently the hash key only depends on the pathname of the source + file and the universal time at which is compiled, hence there may still be + collisions between files compiled on different machines. In short: you should + only worry if you regularly use the function C::BUILD. * CLOS: diff --git a/src/cmp/cmpmain.lsp b/src/cmp/cmpmain.lsp index 213e7f7a3..9ea5d0aca 100644 --- a/src/cmp/cmpmain.lsp +++ b/src/cmp/cmpmain.lsp @@ -1,5 +1,6 @@ ;;;; Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya. ;;;; Copyright (c) 1990, Giuseppe Attardi. +;;;; Copyright (c) 2001, Juan Jose Garcia Ripoll ;;;; ;;;; This program is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Library General Public @@ -205,8 +206,7 @@ WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLine, int nCmdS ~A }") -(defun init-function-name (s &key ((:prefix si::*init-function-prefix*) si::*init-function-prefix*) - (kind :object)) +(defun init-function-name (s &key (kind :object)) (flet ((translate-char (c) (cond ((and (char>= c #\a) (char<= c #\z)) (char-upcase c)) @@ -234,9 +234,6 @@ WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLine, int nCmdS (concatenate 'string "init_" (disambiguation kind) - (if si::*init-function-prefix* - (concatenate 'string si::*init-function-prefix* "_") - "") (map 'string #'translate-char (string s))))) (defun guess-kind (pathname) @@ -257,39 +254,21 @@ or a loadable module." pathname) :object)))) -(defun guess-name-and-flags (pathname &key (prefix si::*init-function-prefix*) - (kind (guess-kind pathname))) - "Given a file name, guess whether it is an object file or a library, and what -is the name of the initialization function in this file." - (let ((filename (pathname-name pathname)) - name flags) - (case kind - ((:object :c) - (setf name filename - flags (si::coerce-to-filename pathname))) - ((:fasl :fas) - (setf name "CODE" - flags "")) - ((:static-library :lib) - (setf name (if (zerop (search +static-library-prefix+ filename)) - (subseq filename (length +static-library-prefix+) nil) - filename) - flags (if (probe-file pathname) - (si::coerce-to-filename pathname) - (concatenate 'string "-l" name)))) - ((:shared-library :dll) - (setf name (if (zerop (search +shared-library-prefix+ filename)) - (subseq filename (length +shared-library-prefix+) nil) - filename) - flags (if (probe-file pathname) - (si::coerce-to-filename pathname) - (concatenate 'string "-l" name)))) - ((:program) - (setf name "ECL_PROGRAM" - flags nil)) - (otherwise - (error "C::BUILDER cannot accept files of kind ~s" kind))) - (values (init-function-name name :kind kind :prefix prefix) flags))) +(defun guess-ld-flags (pathname &key (kind (guess-kind pathname))) + "Given a file name, return the compiler command line argument to link this file in." + (case kind + ((:object :c) + (si::coerce-to-filename pathname)) + ((:fasl :fas) + nil) + ((:static-library :lib) + (si::coerce-to-filename pathname)) + ((:shared-library :dll) + (si::coerce-to-filename pathname)) + ((:program) + nil) + (otherwise + (error "C::BUILDER cannot accept files of kind ~s" kind)))) (defun system-ld-flag (library) "Given a symbol, try to find a library that matches it, either by looking in the @@ -369,8 +348,10 @@ output = cl_safe_eval(c_string_to_object(lisp_code), Cnil, OBJNULL); (unless (member kind '(:shared-library :dll :static-library :lib :object :c)) (error "C::BUILDER does not accept a file ~s of kind ~s" item kind)) - (multiple-value-bind (init-fn flags) - (guess-name-and-flags (parse-namestring item)) + (let* ((path (parse-namestring item)) + (init-fn (guess-init-name path)) + (flags (guess-ld-flags path))) + ;; We should give a warning that we cannot link this module in (when flags (push flags ld-flags)) (push init-fn submodules)))))) (setq c-file (open c-name :direction :output)) @@ -396,7 +377,7 @@ static cl_object VV[VM]; (when (or (symbolp output-name) (stringp output-name)) (setf output-name (compile-file-pathname output-name :type target))) (unless init-name - (setf init-name (guess-name-and-flags output-name :prefix nil :kind target))) + (setf init-name (guess-init-name output-name :kind target))) (ecase target (:program (format c-file +lisp-program-init+ init-name "" shared-data-file @@ -442,9 +423,9 @@ static cl_object VV[VM]; (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) + (cmp-delete-file tmp-name) + (cmp-delete-file c-name) + (cmp-delete-file o-name) output-name)) (defun build-fasl (&rest args) @@ -568,8 +549,8 @@ Cannot compile ~a." (when (zerop *error-count*) (when *compile-verbose* (format t "~&;;; End of Pass 1. ")) - (setf init-name (guess-name-and-flags output-file :kind - (if system-p :object :fasl))) + (setf init-name (guess-init-name output-file :kind + (if system-p :object :fasl))) (compiler-pass2 c-pathname h-pathname data-pathname system-p init-name shared-data-file)) @@ -699,7 +680,7 @@ Cannot compile ~a." (h-pathname (compile-file-pathname data-pathname :type :h)) (o-pathname (compile-file-pathname data-pathname :type :object)) (so-pathname (compile-file-pathname data-pathname)) - (init-name (guess-name-and-flags so-pathname :kind :fasl))) + (init-name (guess-init-name so-pathname :kind :fasl))) (with-lock (+load-compile-lock+) (init-env) @@ -805,7 +786,7 @@ Cannot compile ~a." (t1expr disassembled-form) (if (zerop *error-count*) (catch *cmperr-tag* - (ctop-write (guess-name-and-flags "foo" :kind :fasl) + (ctop-write (guess-init-name "foo" :kind :fasl) (if h-file h-file "") (if data-file data-file ""))) (setq *error-p* t)) diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp index 026afc3d2..1c69aee7b 100644 --- a/src/cmp/cmptop.lsp +++ b/src/cmp/cmptop.lsp @@ -145,7 +145,11 @@ (wt-nl "return;}") (wt-nl "#ifdef ECL_DYNAMIC_VV") (wt-nl "VV = Cblock->cblock.data;") - (wt-nl "#endif")) + (wt-nl "#endif") + ;; With this we ensure creating a constant with the tag + ;; and the initialization file + (wt-nl "Cblock->cblock.data_text = \"" (init-name-tag name) "\";") + ) (when si::*compiler-constants* (wt-nl "{cl_object data = ecl_symbol_value(" (nth-value 1 (si::mangle-name '*compiler-constants* nil)) diff --git a/src/cmp/cmpwt.lsp b/src/cmp/cmpwt.lsp index aac3d5581..da735128a 100644 --- a/src/cmp/cmpwt.lsp +++ b/src/cmp/cmpwt.lsp @@ -134,7 +134,7 @@ 0 i))) -(defun data-dump (stream &optional as-lisp-file &aux must-close) +(defun data-dump (stream &key as-lisp-file init-name &aux must-close) (etypecase stream (null (return-from data-dump)) ((or pathname string) diff --git a/src/cmp/load.lsp.in b/src/cmp/load.lsp.in index 6bd949954..33eeb7425 100644 --- a/src/cmp/load.lsp.in +++ b/src/cmp/load.lsp.in @@ -31,6 +31,7 @@ "src:cmp;cmpcbk.lsp" "src:cmp;cmpct.lsp" "src:cmp;cmpnum.lsp" + "src:cmp;cmpname.lsp" "src:cmp;cmpmain.lsp")) (let ((si::*keep-documentation* nil)) diff --git a/src/cmp/sysfun.lsp b/src/cmp/sysfun.lsp index d2c287a32..711c06e13 100644 --- a/src/cmp/sysfun.lsp +++ b/src/cmp/sysfun.lsp @@ -1387,7 +1387,7 @@ type_of(#0)==t_bitvector") nsubst-if nsubst-if-not ;; mislib.lsp logical-pathname-translations load-logical-pathname-translations decode-universal-time - encode-universal-time get-decoded-time get-universal-time + encode-universal-time get-decoded-time ensure-directories-exist si::simple-program-error si::signal-simple-error ;; module.lsp provide require diff --git a/src/lsp/config.lsp.in b/src/lsp/config.lsp.in index b02cb5965..a7e58dfb6 100644 --- a/src/lsp/config.lsp.in +++ b/src/lsp/config.lsp.in @@ -24,7 +24,7 @@ Returns, as a string, the location of the machine on which ECL runs." (defun lisp-implementation-version () "Args:() Returns the version of your ECL as a string." - "@PACKAGE_VERSION@ (CVS 2008-01-28 11:22)") + "@PACKAGE_VERSION@ (CVS 2008-02-01 12:40)") (defun machine-type () "Args: ()