Use a hashing algorithm combined with a time stamp to name initialization functions in object files

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:
 

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))

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))

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)

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))

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

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: ()