Implement SRFI 112.

diff --git a/doc/ref-manual/scheme.texinfo b/doc/ref-manual/scheme.texinfo
index 1ad46c614fa2f1fc66e2504bd846e2f56f279f49..1a2c9acd2a3791cb0c2835013499c67f0eb26109 100644 (file)
--- a/doc/ref-manual/scheme.texinfo
+++ b/doc/ref-manual/scheme.texinfo
@@ -535,6 +535,7 @@ Standards Support
 * SRFI 27::
 * SRFI 39::
 * SRFI 69::
+* SRFI 112::
 * SRFI 115::
 * SRFI 124::
 * SRFI 125::

diff --git a/doc/ref-manual/standards.texi b/doc/ref-manual/standards.texi
index 164db92e0dc1c231cd6d592b86a21d301af7c0f5..97601c0830162fa920160c104deab7710d3a4ab4 100644 (file)
--- a/doc/ref-manual/standards.texi
+++ b/doc/ref-manual/standards.texi
@@ -12,6 +12,7 @@
 * SRFI 27::
 * SRFI 39::
 * SRFI 69::
+* SRFI 112::
 * SRFI 115::
 * SRFI 124::
 * SRFI 125::
@@ -1374,7 +1375,7 @@ All names are bound in the @mitgnu{} global environment.
 @tab @nicode{parameterize}
 @end multitable
 
-@node SRFI 69, SRFI 115, SRFI 39, Standards Support
+@node SRFI 69, SRFI 112, SRFI 39, Standards Support
 @section SRFI 69: Basic Hash Tables
 @findex alist->hash-table
 @findex hash
@@ -1443,7 +1444,41 @@ All names are bound in the @mitgnu{} global environment.
 @tab @nicode{string-hash}
 @end multitable
 
-@node SRFI 115, SRFI 124, SRFI 69, Standards Support
+@node SRFI 112, SRFI 115, SRFI 69, Standards Support
+@section SRFI 112: Environment Inquiry
+@findex cpu-architecture
+@findex implementation-name
+@findex implementation-version
+@findex machine-name
+@findex os-name
+@findex os-version
+
+@cartouche
+@table @b
+@item Description
+Provides human-readable information at run time about the hardware and
+software configuration on which a Scheme program is being executed.
+@item URL
+@srfiurl{112}
+@item Support
+Fully supported.
+@item Libraries
+@nicode{(srfi 112)}
+@item Global
+All names are bound in the @mitgnu{} global environment.
+@end table
+@end cartouche
+
+@multitable @columnfractions .5 .5
+@item @nicode{cpu-architecture}
+@tab @nicode{implementation-name}
+@item @nicode{implementation-version}
+@tab @nicode{machine-name}
+@item @nicode{os-name}
+@tab @nicode{os-version}
+@end multitable
+
+@node SRFI 115, SRFI 124, SRFI 112, Standards Support
 @section SRFI 115: Scheme Regular Expressions
 @findex char-set->sre
 @findex regexp

diff --git a/src/microcode/configure.ac b/src/microcode/configure.ac
index 1f3711578baadad849f193cef0be7421888be6ad..9bc732f7ec4c061f8c134a9906111aa37f6ba1e3 100644 (file)
--- a/src/microcode/configure.ac
+++ b/src/microcode/configure.ac
@@ -439,14 +439,12 @@ AC_HEADER_STDBOOL
 AC_HEADER_SYS_WAIT
 AC_CHECK_HEADERS_ONCE([sys/time.h])
 
-AC_CHECK_HEADERS([bsdtty.h fcntl.h fenv.h ieeefp.h malloc.h poll.h])
-AC_CHECK_HEADERS([sgtty.h stropts.h])
-AC_CHECK_HEADERS([sys/file.h sys/ioctl.h sys/mount.h sys/param.h])
-AC_CHECK_HEADERS([sys/ptyio.h sys/socket.h sys/timex.h sys/un.h])
+AC_CHECK_HEADERS([bsdtty.h dlfcn.h fcntl.h fenv.h ieeefp.h malloc.h netdb.h])
+AC_CHECK_HEADERS([poll.h sgtty.h stdint.h stropts.h])
+AC_CHECK_HEADERS([sys/file.h sys/ioctl.h sys/mman.h sys/mount.h sys/param.h])
+AC_CHECK_HEADERS([sys/ptyio.h sys/socket.h sys/timex.h sys/un.h sys/utsname.h])
 AC_CHECK_HEADERS([sys/vfs.h])
 AC_CHECK_HEADERS([termio.h termios.h unistd.h util.h utime.h])
-AC_CHECK_HEADERS([dlfcn.h netdb.h])
-AC_CHECK_HEADERS([sys/mman.h stdint.h])
 
 define([SCM_INC_TIME],
     [

diff --git a/src/microcode/pruxenv.c b/src/microcode/pruxenv.c
index fef2deab018fb2519c9c736962cf7bc05227a178..a5ae6f3f02cb7d23196405477f10ba567b47d5af 100644 (file)
--- a/src/microcode/pruxenv.c
+++ b/src/microcode/pruxenv.c
@@ -39,6 +39,10 @@ extern const char * OS_current_user_home_directory (void);
 #ifdef HAVE_SOCKETS
 #  include "uxsock.h"
 #endif
+
+#ifdef HAVE_SYS_UTSNAME_H
+#  include "sys/utsname.h"
+#endif
 \f
 DEFINE_PRIMITIVE ("FILE-TIME->STRING", Prim_file_time_to_string, 1, 1,
   "Convert a file system time stamp into a date/time string.")
@@ -282,3 +286,21 @@ DEFINE_PRIMITIVE ("MACOSX-MAIN-BUNDLE-DIR",
   PRIMITIVE_RETURN (UNSPECIFIC);
 #endif
 }
+
+DEFINE_PRIMITIVE ("uname", Prim_uname, 0, 0, 0)
+{
+#ifdef HAVE_SYS_UTSNAME_H
+  struct utsname buf;
+  STD_VOID_SYSTEM_CALL (syscall_uname, (UX_uname (&buf)));
+  SCHEME_OBJECT v = (allocate_marked_vector (TC_VECTOR, 5, true));
+  VECTOR_SET (v, 0, (char_pointer_to_string (buf.sysname)));
+  VECTOR_SET (v, 1, (char_pointer_to_string (buf.nodename)));
+  VECTOR_SET (v, 2, (char_pointer_to_string (buf.release)));
+  VECTOR_SET (v, 3, (char_pointer_to_string (buf.version)));
+  VECTOR_SET (v, 4, (char_pointer_to_string (buf.machine)));
+  PRIMITIVE_RETURN (v);
+#else
+  error_unimplemented_primitive ();
+  PRIMITIVE_RETURN (UNSPECIFIC);
+#endif
+}

diff --git a/src/microcode/syscall.h b/src/microcode/syscall.h
index 49c6c8c2ae6a33527f1dad7e6fecd3608b2cdae8..d3c73562a7ad3771446524337f90491b86a860ac 100644 (file)
--- a/src/microcode/syscall.h
+++ b/src/microcode/syscall.h
@@ -107,6 +107,7 @@ enum syscall_names
   syscall_terminal_set_state,
   syscall_time,
   syscall_times,
+  syscall_uname,
   syscall_unlink,
   syscall_utime,
   syscall_vfork,

diff --git a/src/microcode/ux.h b/src/microcode/ux.h
index 4cb38be2f20aec7c050a4891b8ccb30c1affacbf..d3c3939bafc9e6fb11f295fe401e19263257bd5b 100644 (file)
--- a/src/microcode/ux.h
+++ b/src/microcode/ux.h
@@ -635,6 +635,10 @@ typedef void Tsignal_handler_result;
    extern int UX_closefrom (int);
 #  define EMULATE_CLOSEFROM
 #endif
+
+#ifdef HAVE_SYS_UTSNAME_H
+#  define UX_uname uname
+#endif
 \f
 /* poll is somewhat busted on Mac OSX 10.4 (Tiger), so use select.  */
 #ifdef __APPLE__

diff --git a/src/microcode/uxtop.c b/src/microcode/uxtop.c
index d17d2b0cc5f521bd39e696d39016d2eb3eae81ab..bd4e1435d3d0b61d9c913b919dc6c895f3db5db3 100644 (file)
--- a/src/microcode/uxtop.c
+++ b/src/microcode/uxtop.c
@@ -488,6 +488,7 @@ static const char * syscall_names_table [] =
   "terminal-set-state",
   "time",
   "times",
+  "uname",
   "unlink",
   "utime",
   "vfork",

diff --git a/src/runtime/feature.scm b/src/runtime/feature.scm
index 89d3749eac4d6d5358d369d0147a2a903f670442..570e3c7bd1f06f3de60d0dfe460e11bf2d10ba86 100644 (file)
--- a/src/runtime/feature.scm
+++ b/src/runtime/feature.scm
@@ -73,6 +73,7 @@ USA.
     srfi-39    ;Parameter objects
     srfi-62    ;S-expression comments
     srfi-69    ;Basic Hash Tables
+    srfi-112   ;Environment Inquiry
     srfi-115   ;Scheme Regular Expressions
     srfi-124   ;Ephemerons
     srfi-125   ;Intermediate hash tables

diff --git a/src/runtime/library-standard.scm b/src/runtime/library-standard.scm
index 2a4af05fa2668eb833de1b77ad7b5474951e3851..6982ae9c99907d98483195db25c0074d31d6c987 100644 (file)
--- a/src/runtime/library-standard.scm
+++ b/src/runtime/library-standard.scm
@@ -974,6 +974,14 @@ USA.
     make-hash-table
     string-ci-hash
     string-hash))
+
+(define-standard-library '(srfi 112)
+  '(cpu-architecture
+    implementation-name
+    implementation-version
+    machine-name
+    os-name
+    os-version))
 \f
 (define-standard-library '(srfi 115)
   '(char-set->sre

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 28ed047c5f85b26dde9b5d6a49dbab864e0474bf..5238eca7bb4eda268038542d172ffcf65f046504 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1197,17 +1197,24 @@ USA.
   (extend-package (runtime os-primitives)
     (files "unxprm")
     (export ()
+           cpu-architecture            ;(srfi 112)
            delete-environment-variable!
            file-attributes/gid
            file-attributes/inode-number
            file-attributes/uid
+           implementation-name         ;(srfi 112)
+           implementation-version      ;(srfi 112)
+           machine-name                ;(srfi 112)
+           os-name                     ;(srfi 112)
+           os-version                  ;(srfi 112)
            set-environment-variable!
            unix/current-gid
            unix/current-pid
            unix/current-uid
            unix/gid->string
            unix/system
-           unix/uid->string))))
+           unix/uid->string
+           unix/uname))))
 
 (define-package (runtime legacy-string)
   (files "legacy-string")

diff --git a/src/runtime/unxprm.scm b/src/runtime/unxprm.scm
index 5893ae5c67308ecf174837ba6ce7316748511b28..d1c6b63d47da5e28f68dcdef61254796887b907f 100644 (file)
--- a/src/runtime/unxprm.scm
+++ b/src/runtime/unxprm.scm
@@ -466,4 +466,30 @@ USA.
   (list "-c" command))
 
 (define (os/executable-pathname-types)
-  '())
\ No newline at end of file
+  '())
+\f
+;;;; SRFI 112
+
+(define (unix/uname)
+  ;; Returns a vector of
+  ;; #(sysname nodename version release machine)
+  ((ucode-primitive uname 0)))
+
+(define (implementation-name) "MIT/GNU Scheme")
+
+(define (implementation-version)
+  (get-subsystem-version-string "Release"))
+
+(define (cpu-architecture)
+  (vector-ref (unix/uname) 4))
+
+(define (machine-name)
+  (vector-ref (unix/uname) 1))
+
+(define (os-name)
+  microcode-id/operating-system-variant)
+
+(define (os-version)
+  (string-append (vector-ref (unix/uname) 2)
+                " "
+                (vector-ref (unix/uname) 3)))
\ No newline at end of file