~ chicken-core (chicken-5) 7283667e359c597c54e35a0b74b788b0570e7dcd


commit 7283667e359c597c54e35a0b74b788b0570e7dcd
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Jan 19 14:30:35 2010 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Tue Jan 19 14:30:35 2010 +0100

    dloading checks whether dll was linked with gui libs; fixed linking of gui-libs in csc

diff --git a/c-backend.scm b/c-backend.scm
index c851520e..ea251c2e 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -551,6 +551,7 @@
 		      (gen "C_noret_decl(C_" uname ")" #t)
 		      (when emit-unsafe-marker
 			(gen "C_externexport void C_dynamic_and_unsafe(void) {}" #t) )
+		      (gen "C_gui_nongui_marker" #t)
 		      (gen "C_externexport void C_ccall ")
 		      (gen "C_" uname) ) ] )
 	     (gen #\()
diff --git a/chicken.h b/chicken.h
index 7b4c309e..13418cc8 100644
--- a/chicken.h
+++ b/chicken.h
@@ -564,6 +564,8 @@ typedef unsigned __int64   uint64_t;
 #define C_RUNTIME_SAFE_DLOAD_UNSAFE_ERROR             34
 #define C_BAD_ARGUMENT_TYPE_NO_FLONUM_ERROR           35
 #define C_BAD_ARGUMENT_TYPE_NO_CLOSURE_ERROR          36
+#define C_RUNTIME_GUI_DLOAD_NONGUI_ERROR              37
+#define C_RUNTIME_NONGUI_DLOAD_GUI_ERROR              38
 
 
 /* Platform information */
@@ -1315,6 +1317,12 @@ extern double trunc(double);
 # define C_main_entry_point
 #endif
 
+#if defined(C_SHARED) && defined(C_WINDOWS_GUI)
+# define C_gui_nongui_marker            C_externexport void C_gui_application(void) {}
+#else
+# define C_gui_nongui_marker
+#endif
+
 #define C_alloc_flonum                  C_word *___tmpflonum = C_alloc(WORDS_PER_FLONUM)
 #define C_kontinue_flonum(k, n)         C_kontinue((k), C_flonum(&___tmpflonum, (n)))
 
diff --git a/csc.scm b/csc.scm
index f38eb012..2fea215a 100644
--- a/csc.scm
+++ b/csc.scm
@@ -1,6 +1,6 @@
 ;;;; csc.scm - Driver program for the CHICKEN compiler - felix -*- Scheme -*-
 ;
-; Copyright (c) 2008-2009, The Chicken Team
+; Copyright (c) 2008-2010, The Chicken Team
 ; Copyright (c) 2000-2007, Felix L. Winkelmann
 ; All rights reserved.
 ;
@@ -108,12 +108,20 @@
 (define pic-options (if (or mingw msvc) '("-DPIC") '("-fPIC" "-DPIC")))
 (define windows-shell WINDOWS_SHELL)
 
-(define default-library (string-append
-                         (if msvc "libchicken-static." "libchicken.")
-                         library-extension))
-(define default-unsafe-library (string-append
-                                (if msvc "libuchicken-static." "libuchicken.")
-                                library-extension))
+(define default-library
+  (string-append
+   (if msvc "libchicken-static." "libchicken.")
+   library-extension))
+
+(define default-unsafe-library
+  (string-append
+   (if msvc "libuchicken-static." "libuchicken.")
+   library-extension))
+
+(define default-gui-library
+  (string-append
+   (if msvc "libchickengui-static." "libchickengui.")
+   library-extension))
 
 (define cleanup-filename quotewrap)
 
@@ -185,10 +193,12 @@
   (if host-mode
       INSTALL_MORE_STATIC_LIBS
       TARGET_MORE_STATIC_LIBS))
+
 (define extra-shared-libraries 
   (if host-mode 
       INSTALL_MORE_LIBS
       TARGET_MORE_LIBS))
+
 (define default-library-files 
   (list
    (quotewrap
@@ -196,10 +206,27 @@
 	    (string-append
 	     (if host-mode INSTALL_LIB_HOME TARGET_LIB_HOME)
 	     (string-append "/" default-library)))) ))
-(define default-shared-library-files (if msvc
-                                         (list (string-append "libchicken." library-extension))
-                                         '("-lchicken")))
+
+(define default-shared-library-files 
+  (if msvc
+      (list (string-append "libchicken." library-extension))
+      '("-lchicken")))
+
+(define default-gui-library-files 
+  (list
+   (quotewrap
+    (prefix default-gui-library "lib"
+	    (string-append
+	     (if host-mode INSTALL_LIB_HOME TARGET_LIB_HOME)
+	     (string-append "/" default-library)))) ))
+
+(define default-gui-shared-library-files 
+  (if msvc
+      (list (string-append "libchickengui." library-extension))
+      '("-lchickengui")))
+
 (define unsafe-libraries #f)
+
 (define unsafe-library-files
   (list
    (quotewrap 
@@ -207,16 +234,19 @@
 	    (string-append 
 	     (if host-mode INSTALL_LIB_HOME TARGET_LIB_HOME)
 	     (string-append "/" default-unsafe-library)))) ))
-(define unsafe-shared-library-files (if msvc
-                                        (list (string-append "libuchicken." library-extension))
-                                        '("-luchicken")))
+
+(define unsafe-shared-library-files
+  (if msvc
+      (list (string-append "libuchicken." library-extension))
+      '("-luchicken")))
+
 (define (use-unsafe-libraries)
   (set! unsafe-libraries #t)
   (set! library-files unsafe-library-files)
   (set! shared-library-files unsafe-shared-library-files))
 
-(define gui-library-files default-library-files)
-(define gui-shared-library-files default-shared-library-files)
+(define gui-library-files default-gui-library-files)
+(define gui-shared-library-files default-gui-shared-library-files)
 (define library-files default-library-files)
 (define shared-library-files default-shared-library-files)
 
diff --git a/library.scm b/library.scm
index 7b48eb65..ad36f5b5 100644
--- a/library.scm
+++ b/library.scm
@@ -3842,6 +3842,12 @@ EOF
 		     args) )
 	((35) (apply ##sys#signal-hook #:type-error loc "bad argument type - not a flonum" args))
 	((36) (apply ##sys#signal-hook #:type-error loc "bad argument type - not a procedure" args))
+	((37) (apply ##sys#signal-hook #:runtime-error loc
+		     "code to load dynamically was linked with non-GUI runtime libraries, but executing runtime was not"
+		     args) )
+	((38) (apply ##sys#signal-hook #:runtime-error loc
+		     "code to load dynamically was linked with GUI runtime libraries, but executing runtime was not"
+		     args) )
 	(else (apply ##sys#signal-hook #:runtime-error loc "unknown internal error" args)) ) ) ) )
 
 
diff --git a/runtime.c b/runtime.c
index b2eeee75..fca3616f 100644
--- a/runtime.c
+++ b/runtime.c
@@ -1560,6 +1560,16 @@ void barf(int code, char *loc, ...)
     c = 0;
     break;
 
+  case C_RUNTIME_GUI_DLOAD_NONGUI_ERROR:
+    msg = C_text("code to load dynamically was linked with non-GUI runtime libraries, but executing runtime was not");
+    c = 0;
+    break;
+
+  case C_RUNTIME_NONGUI_DLOAD_GUI_ERROR:
+    msg = C_text("code to load dynamically was linked with GUI runtime libraries, but executing runtime was not");
+    c = 0;
+    break;
+
   case C_BAD_ARGUMENT_TYPE_NO_FLONUM_ERROR:
     msg = C_text("bad argument type - not a flonum");
     c = 1;
@@ -8004,7 +8014,7 @@ void dload_2(void *dummy)
 
     if(p != NULL) {
       /* check whether dloaded code is not a library unit
-       * and matches current safety setting: */
+       * and matches current safety/gui setting: */
       if((p2 = C_dlsym(handle, C_text("C_dynamic_and_unsafe"))) == NULL)
 	p2 = C_dlsym(handle, C_text("_C_dynamic_and_unsafe"));
 
@@ -8091,12 +8101,30 @@ void dload_2(void *dummy)
 #endif
       
       /* unsafe marker not found and this is not a library unit? */
-      if(!ok && !C_strcmp(topname, "C_toplevel"))
+      if(!ok && !C_strcmp(topname, "C_toplevel")) {
 #ifdef C_UNSAFE_RUNTIME
 	barf(C_RUNTIME_UNSAFE_DLOAD_SAFE_ERROR, NULL);
 #else
         barf(C_RUNTIME_SAFE_DLOAD_UNSAFE_ERROR, NULL);
 #endif
+      }
+
+      /* do the same check for GUI libraries: */
+      p2 = GetProcAddress(handle, C_text("C_gui_application"));
+
+#ifdef C_WINDOWS_GUI
+      ok = p2 != NULL;		/* GUI runtime, GUI code */
+#else
+      ok = p2 == NULL;		/* non-GUI runtime, non-GUI code */
+#endif
+      
+      /* GUI marker not found and this is not a library unit? */
+      if(!ok && !C_strcmp(topname, "C_toplevel"))
+#ifdef C_WINDOWS_GUI
+	barf(C_RUNTIME_GUI_DLOAD_NONGUI_ERROR, NULL);
+#else
+	barf(C_RUNTIME_NONGUI_DLOAD_GUI_ERROR, NULL);
+#endif
 
       current_module_name = C_strdup(mname);
       current_module_handle = handle;
Trap