[Gd-chatter] r11768 - in trunk/fundev/sources: common-dylan lib/unix-portability registry/x86-freebsd registry/x86-linux
hannes at gwydiondylan.org
hannes at gwydiondylan.org
Thu Apr 3 10:31:48 CEST 2008
Author: hannes
Date: Thu Apr 3 10:31:46 2008
New Revision: 11768
Added:
trunk/fundev/sources/common-dylan/freebsd-common-dylan.lid
- copied, changed from r11767, trunk/fundev/sources/common-dylan/unix-common-dylan.lid
trunk/fundev/sources/common-dylan/freebsd-common-extensions-helper.c (contents, props changed)
trunk/fundev/sources/common-dylan/freebsd-common-extensions.dylan (contents, props changed)
trunk/fundev/sources/common-dylan/linux-common-dylan.lid
- copied, changed from r11767, trunk/fundev/sources/common-dylan/unix-common-dylan.lid
trunk/fundev/sources/common-dylan/linux-common-extensions.dylan (contents, props changed)
Removed:
trunk/fundev/sources/common-dylan/unix-common-dylan.lid
Modified:
trunk/fundev/sources/common-dylan/library.dylan
trunk/fundev/sources/common-dylan/unix-common-extensions.dylan
trunk/fundev/sources/lib/unix-portability/freebsd-portability.dylan
trunk/fundev/sources/lib/unix-portability/library.dylan
trunk/fundev/sources/lib/unix-portability/linux-portability.dylan
trunk/fundev/sources/lib/unix-portability/win32-portability.dylan
trunk/fundev/sources/registry/x86-freebsd/common-dylan
trunk/fundev/sources/registry/x86-linux/common-dylan
Log:
Bug: 7297
deprecate procfs on FreeBSD:
* create separate lid files for common-dylan on FreeBSD and Linux;
update registry
* implement sysctls on FreeBSD for KERN_PROC_PATHNAME and KERN_PROC_ARGS
in freebsd-common-extensions.dylan
and freebsd-common-extensions-helper.c
* move platform-specific Linux code from unix-common-extensions.dylan
to linux-common-extensions.dylan
* remove $proc-path from unix-portability;
remove unix-portability from common-dylan
Copied: trunk/fundev/sources/common-dylan/freebsd-common-dylan.lid (from r11767, trunk/fundev/sources/common-dylan/unix-common-dylan.lid)
==============================================================================
--- trunk/fundev/sources/common-dylan/unix-common-dylan.lid (original)
+++ trunk/fundev/sources/common-dylan/freebsd-common-dylan.lid Thu Apr 3 10:31:46 2008
@@ -5,6 +5,7 @@
Files: library
macros
common-extensions
+ freebsd-common-extensions
unix-common-extensions
locators-protocol
streams-protocol
@@ -22,6 +23,7 @@
machine-words/signal-overflow
machine-words/double
machine-words/unsigned-double
+C-Source-Files: freebsd-common-extensions-helper.c
Copyright: Original Code is Copyright (c) 1995-2004 Functional Objects, Inc.
All rights reserved.
License: Functional Objects Library Public License Version 1.0
Added: trunk/fundev/sources/common-dylan/freebsd-common-extensions-helper.c
==============================================================================
--- (empty file)
+++ trunk/fundev/sources/common-dylan/freebsd-common-extensions-helper.c Thu Apr 3 10:31:46 2008
@@ -0,0 +1,22 @@
+#include <sys/types.h>
+#include <sys/sysctl.h>
+#include <stdlib.h>
+
+uint application_filename_length () {
+ int mib[4] = { CTL_KERN, KERN_PROC, KERN_PROC_PATHNAME, -1 };
+ size_t len;
+ sysctl(mib, 4, NULL, &len, NULL, 0);
+ return len;
+}
+
+uint application_filename_name (char* buffer, uint len) {
+ int mib[4] = { CTL_KERN, KERN_PROC, KERN_PROC_PATHNAME, -1 };
+ sysctl(mib, 4, buffer, &len, NULL, 0);
+ return len;
+}
+
+uint application_arguments (char* buffer, uint len) {
+ int mib[4] = { CTL_KERN, KERN_PROC, KERN_PROC_ARGS, getpid() };
+ sysctl(mib, 4, buffer, &len, NULL, 0);
+ return len;
+}
Added: trunk/fundev/sources/common-dylan/freebsd-common-extensions.dylan
==============================================================================
--- (empty file)
+++ trunk/fundev/sources/common-dylan/freebsd-common-extensions.dylan Thu Apr 3 10:31:46 2008
@@ -0,0 +1,44 @@
+Module: common-dylan-internals
+Author: Hannes Mehnert
+Synopsis: Common extensions to Dylan
+Copyright: Original Code is Copyright (c) 1995-2004 Functional Objects, Inc.
+ All rights reserved.
+License: Functional Objects Library Public License Version 1.0
+Dual-license: GNU Lesser General Public License
+Warranty: Distributed WITHOUT WARRANTY OF ANY KIND
+
+define inline-only function get-application-commandline () => (res :: <string>)
+ let cursize = 128;
+ let len = 128;
+ let buffer = #f;
+ while (len >= cursize)
+ cursize := cursize * 2;
+ buffer := make(<byte-string>, size: cursize, fill: '\0');
+ len := raw-as-integer(%call-c-function("application_arguments")
+ (buffer :: <raw-byte-string>,
+ length :: <raw-c-unsigned-int>)
+ => (res :: <raw-c-unsigned-int>)
+ (primitive-string-as-raw(buffer),
+ integer-as-raw(cursize))
+ end);
+ end;
+ copy-sequence(buffer, end: len);
+end;
+
+define inline-only function get-application-filename () => (res :: <string>)
+ let length = raw-as-integer(%call-c-function("application_filename_length")
+ ()
+ => (length :: <raw-c-unsigned-int>)
+ ()
+ end);
+
+ let buffer = make(<byte-string>, size: length, fill: '\0');
+ let len = raw-as-integer(%call-c-function("application_filename_name")
+ (buffer :: <raw-byte-string>,
+ length :: <raw-c-unsigned-int>)
+ => (res :: <raw-c-unsigned-int>)
+ (primitive-string-as-raw(buffer),
+ integer-as-raw(length))
+ end);
+ copy-sequence(buffer, end: len - 1);
+end;
\ No newline at end of file
Modified: trunk/fundev/sources/common-dylan/library.dylan
==============================================================================
--- trunk/fundev/sources/common-dylan/library.dylan (original)
+++ trunk/fundev/sources/common-dylan/library.dylan Thu Apr 3 10:31:46 2008
@@ -14,7 +14,6 @@
finalization,
threads,
threads-extensions };
- use unix-portability;
export
common-dylan,
common-extensions,
@@ -305,5 +304,4 @@
use simple-random;
use simple-profiling;
use simple-io;
- use unix-portability;
end module common-dylan-internals;
Copied: trunk/fundev/sources/common-dylan/linux-common-dylan.lid (from r11767, trunk/fundev/sources/common-dylan/unix-common-dylan.lid)
==============================================================================
--- trunk/fundev/sources/common-dylan/unix-common-dylan.lid (original)
+++ trunk/fundev/sources/common-dylan/linux-common-dylan.lid Thu Apr 3 10:31:46 2008
@@ -5,6 +5,7 @@
Files: library
macros
common-extensions
+ linux-common-extensions
unix-common-extensions
locators-protocol
streams-protocol
Added: trunk/fundev/sources/common-dylan/linux-common-extensions.dylan
==============================================================================
--- (empty file)
+++ trunk/fundev/sources/common-dylan/linux-common-extensions.dylan Thu Apr 3 10:31:46 2008
@@ -0,0 +1,85 @@
+Module: common-dylan-internals
+Author: Gary Palter
+Synopsis: Common extensions to Dylan
+Copyright: Original Code is Copyright (c) 1995-2004 Functional Objects, Inc.
+ All rights reserved.
+License: Functional Objects Library Public License Version 1.0
+Dual-license: GNU Lesser General Public License
+Warranty: Distributed WITHOUT WARRANTY OF ANY KIND
+
+
+define inline-only function get-application-commandline () => (res :: <string>)
+ let pid
+ = raw-as-integer(%call-c-function("getpid")
+ () => (pid :: <raw-c-signed-int>)
+ ()
+ end);
+
+ let cmdline-path
+ = concatenate("/proc/", integer-to-string(pid), "/cmdline");
+ let cmdline-fd = -1;
+ let cmdline :: <byte-string> = "";
+ block ()
+ cmdline-fd
+ := raw-as-integer(%call-c-function ("open")
+ (path :: <raw-byte-string>,
+ flags :: <raw-c-signed-int>,
+ mode :: <raw-c-signed-int>)
+ => (fd :: <raw-c-signed-int>)
+ (primitive-string-as-raw(cmdline-path),
+ integer-as-raw(0),
+ integer-as-raw(0))
+ end);
+ if (cmdline-fd > 0)
+ let count :: <integer> = 1;
+ while (count > 0)
+ let buffer = make(<byte-string>, size: 8192, fill: '\0');
+ count
+ := raw-as-integer(%call-c-function ("read")
+ (fd :: <raw-c-signed-int>,
+ buffer :: <raw-byte-string>,
+ size :: <raw-c-unsigned-long>)
+ => (count :: <raw-c-signed-int>)
+ (integer-as-raw(cmdline-fd),
+ primitive-string-as-raw(buffer),
+ integer-as-raw(8192))
+ end);
+ if (count > 0)
+ cmdline := concatenate(cmdline, copy-sequence(buffer, end: count));
+ end;
+ end;
+ end;
+ cleanup
+ if (cmdline-fd > 0)
+ %call-c-function ("close")
+ (fd :: <raw-c-signed-int>) => (ok? :: <raw-c-signed-int>)
+ (integer-as-raw(cmdline-fd))
+ end
+ end
+ end;
+ cmdline
+end;
+
+define inline-only function get-application-filename () => (res :: <string>)
+ let pid
+ = raw-as-integer(%call-c-function("getpid")
+ () => (pid :: <raw-c-signed-int>)
+ ()
+ end);
+ let exe-path
+ = concatenate("/proc/", integer-to-string(pid), "/exe");
+ let buffer = make(<byte-string>, size: 8192, fill: '\0');
+ let count
+ = raw-as-integer(%call-c-function ("readlink")
+ (path :: <raw-byte-string>,
+ buffer :: <raw-byte-string>,
+ bufsize :: <raw-c-unsigned-long>)
+ => (count :: <raw-c-signed-int>)
+ (primitive-string-as-raw(exe-path),
+ primitive-string-as-raw(buffer),
+ integer-as-raw(8192))
+ end);
+ unless (count = -1)
+ copy-sequence(buffer, end: count)
+ end;
+end;
\ No newline at end of file
Modified: trunk/fundev/sources/common-dylan/unix-common-extensions.dylan
==============================================================================
--- trunk/fundev/sources/common-dylan/unix-common-extensions.dylan (original)
+++ trunk/fundev/sources/common-dylan/unix-common-extensions.dylan Thu Apr 3 10:31:46 2008
@@ -47,82 +47,24 @@
define variable *application-filename* :: false-or(<byte-string>) = #f;
define variable *application-arguments* :: <simple-object-vector> = #[];
-///---*** NOTE: The following works on Linux and, presumably, any other UNIX
-///---*** variant that implements the /proc filesystem.
define inline-only function ensure-application-name-filename-and-arguments () => ()
unless (*application-name*)
- let pid
- = raw-as-integer(%call-c-function ("getpid") () => (pid :: <raw-c-signed-int>) () end);
- //
- let cmdline-path
- = concatenate("/proc/", integer-to-string(pid), "/cmdline");
- let cmdline-fd = -1;
- block ()
- cmdline-fd
- := raw-as-integer(%call-c-function ("open")
- (path :: <raw-byte-string>, flags :: <raw-c-signed-int>,
- mode :: <raw-c-signed-int>)
- => (fd :: <raw-c-signed-int>)
- (primitive-string-as-raw(cmdline-path),
- integer-as-raw(0),
- integer-as-raw(0))
- end);
- if (cmdline-fd > 0)
- let cmdline :: <byte-string> = "";
- let count :: <integer> = 1;
- while (count > 0)
- let buffer = make(<byte-string>, size: 8192, fill: '\0');
- count
- := raw-as-integer(%call-c-function ("read")
- (fd :: <raw-c-signed-int>, buffer :: <raw-byte-string>,
- size :: <raw-c-unsigned-long>)
- => (count :: <raw-c-signed-int>)
- (integer-as-raw(cmdline-fd),
- primitive-string-as-raw(buffer),
- integer-as-raw(8192))
- end);
- if (count > 0)
- cmdline := concatenate(cmdline, copy-sequence(buffer, end: count));
- end;
- end;
- let tokens = make(<stretchy-vector>);
- let _start :: <integer> = 0;
- let _end :: <integer> = size(cmdline);
- let _skip :: <integer> = 0;
- while (_start < _end)
- let _next :: <integer> = position(cmdline, '\0', test: \=, skip: _skip) | _end;
- add!(tokens, copy-sequence(cmdline, start: _start, end: _next));
- _start := _next + 1;
- _skip := _skip + 1;
- end;
- *application-name* := tokens[0];
- *application-arguments* := apply(vector, copy-sequence(tokens, start: 1));
- end;
- cleanup
- if (cmdline-fd > 0)
- %call-c-function ("close")
- (fd :: <raw-c-signed-int>) => (ok? :: <raw-c-signed-int>)
- (integer-as-raw(cmdline-fd))
- end
- end
+ let cmdline = get-application-commandline();
+ let tokens = make(<stretchy-vector>);
+ let _start :: <integer> = 0;
+ let _end :: <integer> = size(cmdline);
+ let _skip :: <integer> = 0;
+ while (_start < _end)
+ let _next :: <integer>
+ = position(cmdline, '\0', test: \=, skip: _skip) | _end;
+ add!(tokens, copy-sequence(cmdline, start: _start, end: _next));
+ _start := _next + 1;
+ _skip := _skip + 1;
end;
- //
- let exe-path
- = concatenate("/proc/", integer-to-string(pid), "/", $proc-path);
- let buffer = make(<byte-string>, size: 8192, fill: '\0');
- let count
- = raw-as-integer(%call-c-function ("readlink")
- (path :: <raw-byte-string>, buffer :: <raw-byte-string>,
- bufsize :: <raw-c-unsigned-long>)
- => (count :: <raw-c-signed-int>)
- (primitive-string-as-raw(exe-path),
- primitive-string-as-raw(buffer),
- integer-as-raw(8192))
- end);
- unless (count = -1)
- *application-filename* := copy-sequence(buffer, end: count)
- end
- end
+ *application-name* := tokens[0];
+ *application-arguments* := apply(vector, copy-sequence(tokens, start: 1));
+ *application-filename* := get-application-filename();
+ end;
end function ensure-application-name-filename-and-arguments;
define function application-name () => (name :: <byte-string>)
Modified: trunk/fundev/sources/lib/unix-portability/freebsd-portability.dylan
==============================================================================
--- trunk/fundev/sources/lib/unix-portability/freebsd-portability.dylan (original)
+++ trunk/fundev/sources/lib/unix-portability/freebsd-portability.dylan Thu Apr 3 10:31:46 2008
@@ -18,5 +18,3 @@
(%call-c-function ("__error") () => (errnop :: <raw-pointer>) () end,
integer-as-raw(0), integer-as-raw(0)))
end;
-
-define constant $proc-path = "file";
Modified: trunk/fundev/sources/lib/unix-portability/library.dylan
==============================================================================
--- trunk/fundev/sources/lib/unix-portability/library.dylan (original)
+++ trunk/fundev/sources/lib/unix-portability/library.dylan Thu Apr 3 10:31:46 2008
@@ -11,5 +11,5 @@
use dylan;
use dylan-direct-c-ffi;
- export unix-errno, $proc-path, unix-lseek;
+ export unix-errno, unix-lseek;
end;
\ No newline at end of file
Modified: trunk/fundev/sources/lib/unix-portability/linux-portability.dylan
==============================================================================
--- trunk/fundev/sources/lib/unix-portability/linux-portability.dylan (original)
+++ trunk/fundev/sources/lib/unix-portability/linux-portability.dylan Thu Apr 3 10:31:46 2008
@@ -12,10 +12,6 @@
end)
end;
-
-
define function unix-errno () => (res :: <integer>)
raw-as-integer(%call-c-function ("myerrno") () => (errnop :: <raw-c-signed-int>) () end)
end;
-
-define constant $proc-path = "exe";
Modified: trunk/fundev/sources/lib/unix-portability/win32-portability.dylan
==============================================================================
--- trunk/fundev/sources/lib/unix-portability/win32-portability.dylan (original)
+++ trunk/fundev/sources/lib/unix-portability/win32-portability.dylan Thu Apr 3 10:31:46 2008
@@ -7,5 +7,3 @@
define function unix-errno () => (res)
end;
-
-define constant $proc-path = "";
Modified: trunk/fundev/sources/registry/x86-freebsd/common-dylan
==============================================================================
--- trunk/fundev/sources/registry/x86-freebsd/common-dylan (original)
+++ trunk/fundev/sources/registry/x86-freebsd/common-dylan Thu Apr 3 10:31:46 2008
@@ -1 +1 @@
-abstract://dylan/common-dylan/unix-common-dylan.lid
+abstract://dylan/common-dylan/freebsd-common-dylan.lid
Modified: trunk/fundev/sources/registry/x86-linux/common-dylan
==============================================================================
--- trunk/fundev/sources/registry/x86-linux/common-dylan (original)
+++ trunk/fundev/sources/registry/x86-linux/common-dylan Thu Apr 3 10:31:46 2008
@@ -1 +1 @@
-abstract://dylan/common-dylan/unix-common-dylan.lid
+abstract://dylan/common-dylan/linux-common-dylan.lid
More information about the chatter
mailing list