add 'so-mode to `system-type'

To work better with OpenBSD (which has been a problem since we
changed `ffi-lib' to open libraries in "local" mode by default).

collects/ffi/unsafe.rkt

@@ -111,7 +111,7 @@
 (define (get-ffi-lib name [version/s ""]
 		     #:fail [fail #f]
 		     #:get-lib-dirs [get-lib-dirs get-lib-search-dirs]
-                     #:global? [global? #f])
+                     #:global? [global? (eq? (system-type 'so-mode) 'global)])
   (cond
    [(not name) (ffi-lib name)] ; #f => NULL => open this executable
    [(not (or (string? name) (path? name)))

collects/scribblings/foreign/libs.scrbl

@@ -18,7 +18,7 @@ Returns @racket[#t] if @racket[v] is a @deftech{foreign-library value},
                   [version (or/c string? (listof (or/c string? #f)) #f) #f]
 		  [#:get-lib-dirs get-lib-dirs (-> (listof path?)) get-lib-search-dirs]
 		  [#:fail fail (or/c #f (-> any)) #f]
-                  [#:global? global? any/c #f])
+                  [#:global? global? any/c (eq? 'global (system-type 'so-mode))])
          any]{
 
 Returns a @tech{foreign-library value} or the result of @racket[fail]. 

collects/scribblings/reference/runtime.scrbl

@@ -18,7 +18,7 @@ contain a null character; the environment variable named by
 @racket[name] is set to @racket[value]. The return value is
 @racket[#t] if the assignment succeeds, @racket[#f] otherwise.}
 
-@defproc[(system-type [mode (or/c 'os 'word 'gc 'link 'so-suffix 'machine)
+@defproc[(system-type [mode (or/c 'os 'word 'gc 'link 'so-suffix 'so-mode 'machine)
                             'os])
          (or/c symbol? string? bytes? exact-positive-integer?)]{
 
@@ -63,6 +63,11 @@ that represents the file extension used for shared objects on the
 current platform. The byte string starts with a period, so it is
 suitable as a second argument to @racket[path-replace-suffix].
 
+In @indexed-racket['so-mode] mode, then the result is @racket['local]
+if foreign libraries should be opened in ``local'' mode by default
+(as on most platforms) or @racket['global] if foreign libraries
+should be opened in ``global'' mode.
+
 In @indexed-racket['machine] mode, then the result is a string, which
 contains further details about the current machine in a
 platform-specific format.}

doc/release-notes/racket/HISTORY.txt

@@ -1,5 +1,7 @@
 Version 5.3.3.7
 Added module-compiled-cross-phase-persistent?
+Added 'so-mode mode for system-type
+ffi/unsafe: changed ffi-lib to use (system-type 'so-mode)
 slideshow/balloon: add balloon-enable-3d
 
 Version 5.3.3.6

src/racket/sconfig.h

@@ -308,6 +308,8 @@
 # define UNDERSCORE_DYNLOAD_SYMBOL_PREFIX
 #endif
 
+# define USE_DLOPEN_GLOBAL_BY_DEFAULT
+
 # define USE_IEEE_FP_PREDS
 
 # define USE_DYNAMIC_FDSET_SIZE
@@ -1484,6 +1486,9 @@
     an extra underscore ("_") must be placed in front of the name passed 
     to dlopen(). */
 
+ /* USE_DLOPEN_GLOBAL_BY_DEFAULT opens shared libraries in "global"
+    mode by default, instead of "local" mode. */
+
  /* LINK_EXTENSIONS_BY_TABLE specifies that the Racket functions
     used by an extension must be manually linked via a table of
     function pointers. Windows dynamic linking uses this method. */

src/racket/src/string.c

@@ -342,6 +342,9 @@ static char *string_to_from_locale(int to_bytes,
 #define portable_isspace(x) (((x) < 128) && isspace(x))
 
 ROSYM static Scheme_Object *sys_symbol;
+ROSYM static Scheme_Object *link_symbol, *machine_symbol, *gc_symbol;
+ROSYM static Scheme_Object *so_suffix_symbol, *so_mode_symbol, *word_symbol;
+ROSYM static Scheme_Object *os_symbol;
 ROSYM static Scheme_Object *platform_3m_path, *platform_cgc_path;
 READ_ONLY static Scheme_Object *zero_length_char_string;
 READ_ONLY static Scheme_Object *zero_length_byte_string;
@@ -362,6 +365,21 @@ scheme_init_string (Scheme_Env *env)
   REGISTER_SO(sys_symbol);
   sys_symbol = scheme_intern_symbol(SYSTEM_TYPE_NAME);
 
+  REGISTER_SO(link_symbol);
+  REGISTER_SO(machine_symbol);
+  REGISTER_SO(gc_symbol);
+  REGISTER_SO(so_suffix_symbol);
+  REGISTER_SO(so_mode_symbol);
+  REGISTER_SO(word_symbol);
+  REGISTER_SO(os_symbol);
+  link_symbol = scheme_intern_symbol("link");
+  machine_symbol = scheme_intern_symbol("machine");
+  gc_symbol = scheme_intern_symbol("gc");
+  so_suffix_symbol = scheme_intern_symbol("so-suffix");
+  so_mode_symbol = scheme_intern_symbol("so-mode");
+  word_symbol = scheme_intern_symbol("word");
+  os_symbol = scheme_intern_symbol("os");
+
   REGISTER_SO(zero_length_char_string);
   REGISTER_SO(zero_length_byte_string);
   zero_length_char_string = scheme_alloc_char_string(0, 0);
@@ -2296,9 +2314,7 @@ static void machine_details(char *s);
 static Scheme_Object *system_type(int argc, Scheme_Object *argv[])
 {
   if (argc) {
-    Scheme_Object *sym;
+    if (SAME_OBJ(argv[0], link_symbol)) {
-    sym = scheme_intern_symbol("link");
-    if (SAME_OBJ(argv[0], sym)) {
 #if defined(OS_X) && !defined(XONX)
       return scheme_intern_symbol("framework");
 #else
@@ -2314,8 +2330,7 @@ static Scheme_Object *system_type(int argc, Scheme_Object *argv[])
 #endif
     }
 
-    sym = scheme_intern_symbol("machine");
+    if (SAME_OBJ(argv[0], machine_symbol)) {
-    if (SAME_OBJ(argv[0], sym)) {
       char buff[1024];
       
       machine_details(buff);
@@ -2323,8 +2338,7 @@ static Scheme_Object *system_type(int argc, Scheme_Object *argv[])
       return scheme_make_utf8_string(buff);
     }
 
-    sym = scheme_intern_symbol("gc");
+    if (SAME_OBJ(argv[0], gc_symbol)) {
-    if (SAME_OBJ(argv[0], sym)) {
 #ifdef MZ_PRECISE_GC
       return scheme_intern_symbol("3m");
 #else
@@ -2332,8 +2346,7 @@ static Scheme_Object *system_type(int argc, Scheme_Object *argv[])
 #endif
     }
 
-    sym = scheme_intern_symbol("so-suffix");
+    if (SAME_OBJ(argv[0], so_suffix_symbol)) {
-    if (SAME_OBJ(argv[0], sym)) {
 #ifdef DOS_FILE_SYSTEM
       return scheme_make_byte_string(".dll");
 #else
@@ -2349,14 +2362,21 @@ static Scheme_Object *system_type(int argc, Scheme_Object *argv[])
 #endif
     }
 
-    sym = scheme_intern_symbol("word");
+    if (SAME_OBJ(argv[0], so_mode_symbol)) {
-    if (SAME_OBJ(argv[0], sym)) {
+#ifdef MZ_DLOPEN_GLOBAL_BY_DEFAULT
+      return scheme_intern_symbol("global");
+#else
+      return scheme_intern_symbol("local");
+#endif
+    }
+
+
+    if (SAME_OBJ(argv[0], word_symbol)) {
       return scheme_make_integer(sizeof(void*)*8);
     }
 
-    sym = scheme_intern_symbol("os");
+    if (!SAME_OBJ(argv[0], os_symbol)) {
-    if (!SAME_OBJ(argv[0], sym)) {
+      scheme_wrong_contract("system-type", "(or/c 'os 'word 'link 'machine 'gc 'so-suffix 'so-mode 'word)", 0, argc, argv);
-      scheme_wrong_contract("system-type", "(or/c 'os 'word 'link 'machine 'gc 'so-suffix 'word)", 0, argc, argv);
       return NULL;
     }
   }