~ chicken-core (chicken-5) 4fbb2220bc9897e534a90b59796ab6ae4df68019
commit 4fbb2220bc9897e534a90b59796ab6ae4df68019
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Wed Dec 27 19:48:56 2017 +1300
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Sun Jan 7 19:58:09 2018 +0100
Split process-context library into "standard" and "posix" components
This moves the high-level procedures of the chicken.process-context
module out of posix.scm and into library.scm, to avoid programs having
to load the posix unit for things like `get-environment-variable'. The
procedures that are left in the "posix" component are those that deal
with file descriptors, user/group information, and chroot(2).
To allow the setter for `current-directory' to continue to be used with
file descriptor arguments, a hook for directory changes is introduced.
By default, this hook invokes the standard `change-directory' procedure,
and when the posix unit is loaded it's extended to support fchdir(2).
Also, evict the procedures in chicken.process-context from the bare
"chicken" module, in preparation for its removal.
Signed-off-by: Peter Bex <peter@more-magic.net>
diff --git a/README b/README
index 2569e5d8..ba976f83 100644
--- a/README
+++ b/README
@@ -311,6 +311,7 @@ _/ _/ _/ _/ _/ _/ _/ _/ _/ _/_/
| | |-- chicken.process.import.so
| | |-- chicken.process.signal.import.so
| | |-- chicken.process-context.import.so
+ | | |-- chicken.process-context.posix.import.so
| | |-- chicken.random.import.so
| | |-- chicken.repl.import.so
| | |-- chicken.sort.import.so
diff --git a/batch-driver.scm b/batch-driver.scm
index ebd62ea6..e9a10cde 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -43,6 +43,7 @@
chicken.pathname
chicken.platform
chicken.pretty-print
+ chicken.process-context
chicken.string
chicken.time
chicken.compiler.support
diff --git a/chicken-install.scm b/chicken-install.scm
index 94c62caf..9d37eb32 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -33,11 +33,11 @@
(import (chicken foreign))
(import (chicken keyword))
(import (chicken file))
+(import (chicken file posix))
(import (chicken fixnum))
(import (chicken format))
(import (chicken irregex))
(import (chicken tcp))
-(import (chicken posix))
(import (chicken port))
(import (chicken platform))
(import (chicken io))
diff --git a/chicken-profile.scm b/chicken-profile.scm
index f6968d17..42a48a6f 100644
--- a/chicken-profile.scm
+++ b/chicken-profile.scm
@@ -30,8 +30,9 @@
(import chicken scheme)
(import chicken.file
+ chicken.file.posix
chicken.internal
- chicken.posix
+ chicken.process-context
chicken.sort
chicken.string)
diff --git a/chicken-status.scm b/chicken-status.scm
index cc8be19f..4018f9a7 100644
--- a/chicken-status.scm
+++ b/chicken-status.scm
@@ -32,9 +32,10 @@
(chicken format)
(chicken irregex)
(chicken port)
- (chicken posix)
- (chicken pathname)
+ (chicken posix) ; FIXME once terminal-{size,port?} are rehomed
+ (chicken pathname)
(chicken pretty-print)
+ (chicken process-context)
(chicken sort)
(only (chicken string) ->string))
diff --git a/chicken-uninstall.scm b/chicken-uninstall.scm
index fe47d842..9db8c9c3 100644
--- a/chicken-uninstall.scm
+++ b/chicken-uninstall.scm
@@ -31,12 +31,12 @@
(import (chicken file)
(chicken foreign)
(chicken io)
- (chicken format)
- (chicken irregex)
- (chicken port)
+ (chicken format)
+ (chicken irregex)
+ (chicken port)
(chicken pathname)
- (chicken posix)
- (chicken string))
+ (chicken process-context)
+ (chicken string))
(include "mini-srfi-1.scm")
(include "egg-environment.scm")
diff --git a/chicken.import.scm b/chicken.import.scm
index 610cfe38..604792b5 100644
--- a/chicken.import.scm
+++ b/chicken.import.scm
@@ -28,7 +28,6 @@
'((abort . chicken.condition#abort)
(add1 . chicken.base#add1)
argc+argv
- argv
(bignum? . chicken.base#bignum?)
(build-platform . chicken.platform#build-platform)
(call/cc . chicken.base#call/cc)
@@ -36,7 +35,6 @@
(char-name . chicken.base#char-name)
(chicken-home . chicken.platform#chicken-home)
(chicken-version . chicken.platform#chicken-version)
- command-line-arguments
(condition-predicate . chicken.condition#condition-predicate)
(condition-property-accessor . chicken.condition#condition-property-accessor)
(condition? . chicken.condition#condition?)
@@ -55,7 +53,6 @@
(exact-integer? . chicken.base#exact-integer?)
(exact-integer-sqrt . chicken.base#exact-integer-sqrt)
(exact-integer-nth-root . chicken.base#exact-integer-nth-root)
- executable-pathname
(exit . chicken.base#exit)
(exit-handler . chicken.base#exit-handler)
(expand . chicken.syntax#expand)
@@ -99,7 +96,6 @@
(gensym . chicken.base#gensym)
(get-call-chain . chicken.base#get-call-chain)
(get-condition-property . chicken.condition#get-condition-property)
- get-environment-variable
(get-line-number . chicken.syntax#get-line-number)
get-output-string
(getter-with-setter . chicken.base#getter-with-setter)
@@ -138,7 +134,6 @@
(print-call-chain . chicken.base#print-call-chain)
(print* . chicken.base#print*)
(procedure-information . chicken.base#procedure-information)
- program-name
(promise? . chicken.base#promise?)
(quotient&modulo . chicken.base#quotient&modulo)
(quotient&remainder . chicken.base#quotient&remainder)
diff --git a/chicken.scm b/chicken.scm
index ed7a2ef6..935ecc5f 100644
--- a/chicken.scm
+++ b/chicken.scm
@@ -39,6 +39,7 @@
chicken.compiler.c-platform
chicken.compiler.support
chicken.compiler.user-pass
+ chicken.process-context
chicken.string)
(include "tweaks")
diff --git a/csc.scm b/csc.scm
index 9b8fd531..fb8cc54c 100644
--- a/csc.scm
+++ b/csc.scm
@@ -28,14 +28,14 @@
(module main ()
(import scheme
- chicken
+ chicken
chicken.file
chicken.foreign
chicken.format
- chicken.io
+ chicken.io
chicken.pathname
- chicken.posix
- chicken.process
+ chicken.process
+ chicken.process-context
chicken.string)
(include "egg-environment.scm")
diff --git a/defaults.make b/defaults.make
index 851fb1dc..65002cad 100644
--- a/defaults.make
+++ b/defaults.make
@@ -268,8 +268,8 @@ DYNAMIC_IMPORT_LIBRARIES = srfi-4
DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise blob errno file.posix \
fixnum flonum format gc io keyword load locative memory \
memory.representation platform plist posix pretty-print \
- process process.signal process-context random sort string \
- time time.posix
+ process process.signal process-context process-context.posix \
+ random sort string time time.posix
DYNAMIC_CHICKEN_COMPILER_IMPORT_LIBRARIES = user-pass
DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES = continuation eval file \
internal irregex pathname port read-syntax repl tcp
diff --git a/distribution/manifest b/distribution/manifest
index 1450e019..0fa78f93 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -331,6 +331,8 @@ chicken.process.signal.import.scm
chicken.process.signal.import.c
chicken.process-context.import.scm
chicken.process-context.import.c
+chicken.process-context.posix.import.scm
+chicken.process-context.posix.import.c
chicken.random.import.scm
chicken.random.import.c
chicken.read-syntax.import.scm
diff --git a/file.scm b/file.scm
index 0f8f2ea3..82fd866b 100644
--- a/file.scm
+++ b/file.scm
@@ -87,7 +87,8 @@ EOF
chicken.io
chicken.irregex
chicken.pathname
- chicken.posix)
+ chicken.process-context
+ chicken.posix) ; FIXME file should not depend on posix
(include "common-declarations.scm")
diff --git a/library.scm b/library.scm
index 221ea661..d696fc03 100644
--- a/library.scm
+++ b/library.scm
@@ -39,11 +39,12 @@
make-complex flonum->ratnum ratnum
+maximum-allowed-exponent+ mantexp->dbl ldexp round-quotient
##sys#string->compnum ##sys#internal-gcd)
- (not inline ##sys#user-read-hook ##sys#error-hook ##sys#signal-hook
- ##sys#sleep-hook ##sys#schedule ##sys#default-read-info-hook
- ##sys#infix-list-hook ##sys#sharp-number-hook
- ##sys#user-print-hook ##sys#user-interrupt-hook
- ##sys#windows-platform ##sys#features)
+ (not inline ##sys#change-directory-hook ##sys#user-read-hook
+ ##sys#error-hook ##sys#signal-hook ##sys#sleep-hook
+ ##sys#default-read-info-hook ##sys#infix-list-hook
+ ##sys#sharp-number-hook ##sys#user-print-hook
+ ##sys#user-interrupt-hook ##sys#windows-platform
+ ##sys#schedule ##sys#features)
(foreign-declare #<<EOF
#include <errno.h>
#include <float.h>
@@ -1012,22 +1013,17 @@ EOF
(define ##sys#warn warning)
(define ##sys#notice notice)
-(define-foreign-variable main_argc int "C_main_argc")
-(define-foreign-variable main_argv c-pointer "C_main_argv")
(define-foreign-variable strerror c-string "strerror(errno)")
(define ##sys#gc (##core#primitive "C_gc"))
(define (##sys#setslot x i y) (##core#inline "C_i_setslot" x i y))
(define (##sys#setislot x i y) (##core#inline "C_i_set_i_slot" x i y))
(define ##sys#allocate-vector (##core#primitive "C_allocate_vector"))
-(define (argc+argv) (##sys#values main_argc main_argv))
(define ##sys#make-structure (##core#primitive "C_make_structure"))
(define ##sys#ensure-heap-reserve (##core#primitive "C_ensure_heap_reserve"))
(define ##sys#symbol-table-info (##core#primitive "C_get_symbol_table_info"))
(define ##sys#memory-info (##core#primitive "C_get_memory_info"))
(define ##sys#decode-seconds (##core#primitive "C_decode_seconds"))
-(define get-environment-variable (foreign-lambda c-string "C_getenv" c-string))
-(define executable-pathname (foreign-lambda c-string* "C_executable_pathname"))
(define (##sys#start-timer)
(##sys#gc #t)
@@ -5892,9 +5888,135 @@ EOF
[else (##sys#read-error port "unreadable object")] ) ] ) ) ) )
-;;; command-line handling
+;;; Accessing process information (cwd, environ, etc.)
+
+#>
+
+#define C_chdir(str) C_fix(chdir(C_c_string(str)))
+#define C_curdir(buf) (getcwd(C_c_string(buf), 1024) ? C_fix(strlen(C_c_string(buf))) : C_SCHEME_FALSE)
+#define C_getenventry(i) (environ[ i ])
+
+#ifdef HAVE_CRT_EXTERNS_H
+# include <crt_externs.h>
+# define environ (*_NSGetEnviron())
+#else
+extern char **environ;
+#endif
+
+#ifdef HAVE_SETENV
+# define C_unsetenv(s) (unsetenv((char *)C_data_pointer(s)), C_SCHEME_TRUE)
+# define C_setenv(x, y) C_fix(setenv((char *)C_data_pointer(x), (char *)C_data_pointer(y), 1))
+#else
+# if defined(_WIN32) && !defined(__CYGWIN__)
+# define C_unsetenv(s) C_setenv(s, C_SCHEME_FALSE)
+# else
+# define C_unsetenv(s) C_fix(putenv((char *)C_data_pointer(s)))
+# endif
+static C_word C_fcall C_setenv(C_word x, C_word y) {
+ char *sx = C_c_string(x),
+ *sy = (y == C_SCHEME_FALSE ? "" : C_c_string(y));
+ int n1 = C_strlen(sx), n2 = C_strlen(sy);
+ int buf_len = n1 + n2 + 2;
+ char *buf = (char *)C_malloc(buf_len);
+ if(buf == NULL) return(C_fix(0));
+ else {
+ C_strlcpy(buf, sx, buf_len);
+ C_strlcat(buf, "=", buf_len);
+ C_strlcat(buf, sy, buf_len);
+ return(C_fix(putenv(buf)));
+ }
+}
+#endif
+
+<#
+
+(module chicken.process-context
+ (argv argc+argv command-line-arguments
+ program-name executable-pathname
+ change-directory current-directory
+ get-environment-variable get-environment-variables
+ set-environment-variable! unset-environment-variable!)
+
+(import scheme)
+(import chicken.base chicken.fixnum chicken.foreign)
+(import (only chicken unless)) ; FIXME
+;;; Current directory access:
+
+(define (change-directory name)
+ (##sys#check-string name 'change-directory)
+ (let ((sname (##sys#make-c-string name 'change-directory)))
+ (unless (fx= (##core#inline "C_chdir" sname) 0)
+ (##sys#update-errno)
+ (##sys#signal-hook #:file-error 'change-directory
+ (string-append "cannot change current directory - " strerror) name))
+ name))
+
+(define (##sys#change-directory-hook dir) ; set! by posix for fd support
+ (change-directory dir))
+
+(define current-directory
+ (getter-with-setter
+ (lambda ()
+ (let* ((buffer (make-string 1024))
+ (len (##core#inline "C_curdir" buffer)))
+ (unless ##sys#windows-platform ; FIXME need `cond-expand' here
+ (##sys#update-errno))
+ (if len
+ (##sys#substring buffer 0 len)
+ (##sys#signal-hook
+ #:file-error
+ 'current-directory "cannot retrieve current directory"))))
+ (lambda (dir)
+ (##sys#change-directory-hook dir))))
+
+
+;;; Environment access:
+
+(define get-environment-variable
+ (foreign-lambda c-string "C_getenv" c-string))
+
+(define (set-environment-variable! var val)
+ (##sys#check-string var 'set-environment-variable!)
+ (##sys#check-string val 'set-environment-variable!)
+ (##core#inline "C_setenv"
+ (##sys#make-c-string var 'set-environment-variable!)
+ (##sys#make-c-string val 'set-environment-variable!))
+ (##core#undefined))
+
+(define (unset-environment-variable! var)
+ (##sys#check-string var 'unset-environment-variable!)
+ (##core#inline "C_unsetenv"
+ (##sys#make-c-string var 'unset-environment-variable!))
+ (##core#undefined))
+
+(define get-environment-variables
+ (let ((get (foreign-lambda c-string "C_getenventry" int)))
+ (lambda ()
+ (let loop ((i 0))
+ (let ((entry (get i)))
+ (if entry
+ (let scan ((j 0))
+ (if (char=? #\= (##core#inline "C_subchar" entry j))
+ (cons (cons (##sys#substring entry 0 j)
+ (##sys#substring entry (fx+ j 1) (##sys#size entry)))
+ (loop (fx+ i 1)))
+ (scan (fx+ j 1))))
+ '()))))))
+
+
+;;; Command line handling
+
+(define-foreign-variable main_argc int "C_main_argc")
+(define-foreign-variable main_argv c-pointer "C_main_argv")
+
+(define executable-pathname
+ (foreign-lambda c-string* "C_executable_pathname"))
+
+(define (argc+argv)
+ (##sys#values main_argc main_argv))
+
(define argv ; includes program name
(let ((cache #f)
(fetch-arg (foreign-lambda* c-string ((scheme-object i))
@@ -5933,6 +6055,8 @@ EOF
(##sys#check-list x 'command-line-arguments)
x) ) )
+) ; chicken.process-context
+
(module chicken.gc
(current-gc-milliseconds gc memory-statistics set-finalizer!
@@ -6285,10 +6409,12 @@ EOF
)
(import scheme)
-(import chicken.fixnum chicken.foreign chicken.keyword)
-(import (only chicken get-environment-variable make-parameter))
+(import chicken.fixnum chicken.foreign chicken.keyword chicken.process-context)
(import chicken.internal.syntax)
+(import (only chicken make-parameter))
+(import (only chicken when unless define-constant))
+
(define software-type
(let ((sym (string->symbol ((##core#primitive "C_software_type")))))
(lambda () sym)))
diff --git a/modules.scm b/modules.scm
index 8e5179c6..92e13dfe 100644
--- a/modules.scm
+++ b/modules.scm
@@ -1118,8 +1118,8 @@
(##sys#register-core-module
'srfi-98 'posix
- '(get-environment-variable
- (get-environment-variables . chicken.posix#get-environment-variables)))
+ '((get-environment-variable . chicken.process-context#get-environment-variable)
+ (get-environment-variables . chicken.process-context#get-environment-variables)))
(register-feature! 'module-environments)
diff --git a/posix-common.scm b/posix-common.scm
index d8322ce3..589701d8 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -32,8 +32,6 @@
static int C_not_implemented(void);
int C_not_implemented() { return -1; }
-#define C_curdir(buf) (getcwd(C_c_string(buf), 1024) ? C_fix(strlen(C_c_string(buf))) : C_SCHEME_FALSE)
-
static C_TLS struct stat C_statbuf;
#define C_stat_type (C_statbuf.st_mode & S_IFMT)
@@ -110,31 +108,6 @@ static char C_time_string [TIME_STRING_MAXLENGTH + 1];
#define C_fseek(p, n, w) C_mk_nbool(fseek(C_port_file(p), C_num_to_int64(n), C_unfix(w)))
#define C_lseek(fd, o, w) C_fix(lseek(C_unfix(fd), C_num_to_int64(o), C_unfix(w)))
-#ifdef HAVE_SETENV
-# define C_unsetenv(s) (unsetenv((char *)C_data_pointer(s)), C_SCHEME_TRUE)
-# define C_setenv(x, y) C_fix(setenv((char *)C_data_pointer(x), (char *)C_data_pointer(y), 1))
-#else
-# if defined(_WIN32) && !defined(__CYGWIN__)
-# define C_unsetenv(s) C_setenv(s, C_SCHEME_FALSE)
-# else
-# define C_unsetenv(s) C_fix(putenv((char *)C_data_pointer(s)))
-# endif
-static C_word C_fcall C_setenv(C_word x, C_word y) {
- char *sx = C_c_string(x),
- *sy = (y == C_SCHEME_FALSE ? "" : C_c_string(y));
- int n1 = C_strlen(sx), n2 = C_strlen(sy);
- int buf_len = n1 + n2 + 2;
- char *buf = (char *)C_malloc(buf_len);
- if(buf == NULL) return(C_fix(0));
- else {
- C_strlcpy(buf, sx, buf_len);
- C_strlcat(buf, "=", buf_len);
- C_strlcat(buf, sy, buf_len);
- return(C_fix(putenv(buf)));
- }
-}
-#endif
-
EOF
))
@@ -482,15 +455,7 @@ EOF
fd) ) )
-;;; Set or get current directory:
-
-(define change-directory
- (lambda (name)
- (##sys#check-string name 'change-directory)
- (let ((sname (##sys#make-c-string name 'change-directory)))
- (unless (fx= 0 (##core#inline "C_chdir" sname))
- (posix-error #:file-error 'change-directory "cannot change current directory" name))
- name)))
+;;; Set or get current directory by file descriptor:
(define (change-directory* fd)
(##sys#check-fixnum fd 'change-directory*)
@@ -498,21 +463,10 @@ EOF
(posix-error #:file-error 'change-directory* "cannot change current directory" fd))
fd)
-(define current-directory
- (getter-with-setter
- (lambda ()
- (let* ((buffer (make-string 1024))
- (len (##core#inline "C_curdir" buffer)))
- #+(or unix cygwin)
- (##sys#update-errno)
- (if len
- (##sys#substring buffer 0 len)
- (##sys#signal-hook
- #:file-error
- 'current-directory "cannot retrieve current directory"))))
- (lambda (dir)
- ((if (fixnum? dir) change-directory* change-directory) dir))
- "(current-directory)"))
+(set! ##sys#change-directory-hook
+ (let ((cd ##sys#change-directory-hook))
+ (lambda (dir)
+ ((if (fixnum? dir) change-directory* cd) dir))))
(define directory
(lambda (#!optional (spec (current-directory)) show-dotfiles?)
@@ -607,38 +561,6 @@ EOF
(##sys#error 'time->string "cannot convert time vector to string" tm) ) ) ) ) ) )
-;;; Environment access:
-
-(define set-environment-variable!
- (lambda (var val)
- (##sys#check-string var 'set-environment-variable!)
- (##sys#check-string val 'set-environment-variable!)
- (##core#inline "C_setenv"
- (##sys#make-c-string var 'set-environment-variable!)
- (##sys#make-c-string val 'set-environment-variable!))
- (##core#undefined) ) )
-
-(define (unset-environment-variable! var)
- (##sys#check-string var 'unset-environment-variable!)
- (##core#inline "C_unsetenv"
- (##sys#make-c-string var 'unset-environment-variable!))
- (##core#undefined) )
-
-(define get-environment-variables
- (let ([get (foreign-lambda c-string "C_getenventry" int)])
- (lambda ()
- (let loop ([i 0])
- (let ([entry (get i)])
- (if entry
- (let scan ([j 0])
- (if (char=? #\= (##core#inline "C_subchar" entry j))
- (cons (cons (##sys#substring entry 0 j)
- (##sys#substring entry (fx+ j 1) (##sys#size entry)))
- (loop (fx+ i 1)))
- (scan (fx+ j 1)) ) )
- '() ) ) ) ) ) )
-
-
;;; Signals
(define (set-signal-handler! sig proc)
diff --git a/posix.scm b/posix.scm
index 88bd2b5d..00aa1bec 100644
--- a/posix.scm
+++ b/posix.scm
@@ -41,9 +41,9 @@
(module chicken.posix
(block-device? call-with-input-pipe call-with-output-pipe
- change-directory change-directory* character-device? close-input-pipe
+ change-directory* character-device? close-input-pipe
close-output-pipe create-fifo create-pipe
- create-session create-symbolic-link current-directory
+ create-session create-symbolic-link
current-effective-group-id current-effective-user-id
current-effective-user-name current-group-id current-process-id
current-user-id current-user-name directory
@@ -55,7 +55,7 @@
file-owner file-permissions file-position file-read file-read-access?
file-select file-size file-stat file-test-lock file-truncate
file-type file-unlock file-write file-write-access? fileno/stderr
- fileno/stdin fileno/stdout get-environment-variables
+ fileno/stdin fileno/stdout
local-time->seconds local-timezone-abbreviation
open-input-file* open-input-pipe open-output-file* open-output-pipe
open/append open/binary open/creat open/excl open/fsync open/noctty
@@ -69,7 +69,7 @@
process-spawn process-wait read-symbolic-link regular-file?
seconds->local-time seconds->string seconds->utc-time seek/cur
seek/end seek/set
- set-alarm! set-environment-variable! set-file-group! set-file-owner!
+ set-alarm! set-file-group! set-file-owner!
set-file-permissions! set-file-position! set-file-times!
set-root-directory! set-signal-handler! set-signal-mask!
signal-handler signal-mask signal-mask! signal-masked? signal-unmask!
@@ -81,7 +81,7 @@
signal/xfsz signals-list socket? spawn/detach spawn/nowait
spawn/nowaito spawn/overlay spawn/wait string->time symbolic-link?
terminal-name terminal-port? terminal-size
- time->string unset-environment-variable! user-information
+ time->string user-information
utc-time->seconds with-input-from-pipe with-output-to-pipe)
(import scheme chicken)
@@ -90,6 +90,7 @@
chicken.memory
chicken.pathname
chicken.port
+ chicken.process-context
chicken.time)
(cond-expand
@@ -160,13 +161,13 @@
perm/ixgrp perm/ixoth perm/ixusr
port->fileno seek/cur seek/end seek/set set-file-group! set-file-owner!
set-file-permissions! set-file-position! set-file-times!)
-(import chicken chicken.posix))
+(import chicken.posix))
(module chicken.time.posix
(seconds->utc-time utc-time->seconds seconds->local-time
seconds->string local-time->seconds string->time time->string
local-timezone-abbreviation)
-(import chicken chicken.posix))
+(import chicken.posix))
(module chicken.process
(qs system system* process-execute process-fork process-run
@@ -213,17 +214,13 @@
signal/quit signal/segv signal/stop signal/term signal/trap
signal/tstp signal/urg signal/usr1 signal/usr2 signal/vtalrm
signal/winch signal/xcpu signal/xfsz set-alarm!)
-(import chicken chicken.posix))
-
-(module chicken.process-context
- (change-directory change-directory* current-directory
- command-line-arguments argv get-environment-variable
- get-environment-variables set-environment-variable!
- unset-environment-variable!
- executable-pathname program-name set-root-directory!
+(import chicken.posix))
+
+(module chicken.process-context.posix
+ (change-directory* set-root-directory!
current-effective-group-id current-effective-user-id
current-group-id current-process-id current-user-id
parent-process-id current-user-name
current-effective-user-name create-session
process-group-id user-information)
-(import chicken chicken.posix))
+(import chicken.posix))
diff --git a/posixunix.scm b/posixunix.scm
index 0e22c28e..23ace285 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -79,16 +79,6 @@ static C_TLS int C_wait_status;
# define MAP_ANON 0
#endif
-#if defined(HAVE_CRT_EXTERNS_H)
-# include <crt_externs.h>
-# define C_getenventry(i) ((*_NSGetEnviron())[ i ])
-#elif defined(C_MACOSX)
-# define C_getenventry(i) NULL
-#else
-extern char **environ;
-# define C_getenventry(i) (environ[ i ])
-#endif
-
#ifndef FILENAME_MAX
# define FILENAME_MAX 1024
#endif
@@ -110,7 +100,6 @@ static C_TLS struct timeval C_timeval;
static C_TLS struct stat C_statbuf;
#define C_fchdir(fd) C_fix(fchdir(C_unfix(fd)))
-#define C_chdir(str) C_fix(chdir(C_c_string(str)))
#define open_binary_input_pipe(a, n, name) C_mpointer(a, popen(C_c_string(name), "r"))
#define open_text_input_pipe(a, n, name) open_binary_input_pipe(a, n, name)
diff --git a/posixwin.scm b/posixwin.scm
index ac8ffd27..c5ba4619 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -105,10 +105,6 @@ static C_TLS char C_shlcmd[256] = "";
/* Current user name */
static C_TLS TCHAR C_username[255 + 1] = "";
-/* Directory Operations */
-
-#define C_chdir(str) C_fix(chdir(C_c_string(str)))
-
/* DIRENT stuff */
struct dirent
{
@@ -197,8 +193,6 @@ readdir(DIR * dir)
#define C_pipe(d, m) C_fix(_pipe(C_pipefds, PIPE_BUF, C_unfix(m)))
#define C_close(fd) C_fix(close(C_unfix(fd)))
-#define C_getenventry(i) environ[ i ]
-
#define C_u_i_lstat(fn) C_u_i_stat(fn)
#define C_u_i_execvp(f,a) C_fix(execvp(C_data_pointer(f), (const char *const *)C_c_pointer_vector_or_null(a)))
diff --git a/rules.make b/rules.make
index 202262c1..ef162cf8 100644
--- a/rules.make
+++ b/rules.make
@@ -477,6 +477,7 @@ $(eval $(call declare-emitted-import-lib-dependency,chicken.file.posix,$(POSIXFI
$(eval $(call declare-emitted-import-lib-dependency,chicken.time.posix,$(POSIXFILE)))
$(eval $(call declare-emitted-import-lib-dependency,chicken.process,$(POSIXFILE)))
$(eval $(call declare-emitted-import-lib-dependency,chicken.process.signal,$(POSIXFILE)))
+$(eval $(call declare-emitted-import-lib-dependency,chicken.process-context.posix,$(POSIXFILE)))
$(eval $(call declare-emitted-import-lib-dependency,chicken.bitwise,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.blob,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.fixnum,library))
@@ -485,6 +486,7 @@ $(eval $(call declare-emitted-import-lib-dependency,chicken.gc,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.keyword,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.platform,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.plist,library))
+$(eval $(call declare-emitted-import-lib-dependency,chicken.process-context,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.time,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.load,eval))
$(eval $(call declare-emitted-import-lib-dependency,chicken.format,extras))
@@ -502,6 +504,7 @@ chicken.c: chicken.scm mini-srfi-1.scm \
chicken.compiler.c-platform.import.scm \
chicken.compiler.support.import.scm \
chicken.compiler.user-pass.import.scm \
+ chicken.process-context.import.scm \
chicken.string.import.scm
batch-driver.c: batch-driver.scm mini-srfi-1.scm \
chicken.compiler.core.import.scm \
@@ -520,6 +523,7 @@ batch-driver.c: batch-driver.scm mini-srfi-1.scm \
chicken.pathname.import.scm \
chicken.platform.import.scm \
chicken.pretty-print.import.scm \
+ chicken.process-context.import.scm \
chicken.string.import.scm \
chicken.time.import.scm
c-platform.c: c-platform.scm mini-srfi-1.scm \
@@ -618,6 +622,7 @@ csc.c: csc.scm \
chicken.pathname.import.scm \
chicken.posix.import.scm \
chicken.process.import.scm \
+ chicken.process-context.import.scm \
chicken.string.import.scm
csi.c: csi.scm \
chicken.base.import.scm \
@@ -632,6 +637,7 @@ csi.c: csi.scm \
chicken.platform.import.scm \
chicken.port.import.scm \
chicken.pretty-print.import.scm \
+ chicken.process-context.import.scm \
chicken.repl.import.scm \
chicken.sort.import.scm \
chicken.string.import.scm \
@@ -639,6 +645,7 @@ csi.c: csi.scm \
chicken-profile.c: chicken-profile.scm \
chicken.internal.import.scm \
chicken.posix.import.scm \
+ chicken.process-context.import.scm \
chicken.sort.import.scm \
chicken.string.import.scm
chicken-status.c: chicken-status.scm \
@@ -650,6 +657,7 @@ chicken-status.c: chicken-status.scm \
chicken.port.import.scm \
chicken.posix.import.scm \
chicken.pretty-print.import.scm \
+ chicken.process-context.import.scm \
chicken.sort.import.scm \
chicken.string.import.scm
chicken-install.c: chicken-install.scm \
@@ -663,6 +671,7 @@ chicken-install.c: chicken-install.scm \
chicken.port.import.scm \
chicken.posix.import.scm \
chicken.pretty-print.import.scm \
+ chicken.process-context.import.scm \
chicken.sort.import.scm \
chicken.string.import.scm \
chicken.tcp.import.scm
@@ -674,6 +683,7 @@ chicken-uninstall.c: chicken-uninstall.scm \
chicken.pathname.import.scm \
chicken.port.import.scm \
chicken.posix.import.scm \
+ chicken.process-context.import.scm \
chicken.string.import.scm
chicken-syntax.c: chicken-syntax.scm \
chicken.platform.import.scm \
@@ -692,6 +702,7 @@ posixunix.c: posixunix.scm \
chicken.pathname.import.scm \
chicken.platform.import.scm \
chicken.port.import.scm \
+ chicken.process-context.import.scm \
chicken.time.import.scm
posixwin.c: posixwin.scm \
chicken.condition.import.scm \
@@ -701,6 +712,7 @@ posixwin.c: posixwin.scm \
chicken.pathname.import.scm \
chicken.platform.import.scm \
chicken.port.import.scm \
+ chicken.process-context.import.scm \
chicken.string.import.scm \
chicken.time.import.scm
data-structures.c: data-structures.scm \
@@ -732,7 +744,8 @@ file.c: file.scm \
chicken.irregex.import.scm \
chicken.foreign.import.scm \
chicken.pathname.import.scm \
- chicken.posix.import.scm
+ chicken.posix.import.scm \
+ chicken.process-context.import.scm
lolevel.c: lolevel.scm \
chicken.foreign.import.scm
pathname.c: pathname.scm \
@@ -766,6 +779,7 @@ library.c: $(SRCDIR)library.scm
-emit-import-library chicken.keyword \
-emit-import-library chicken.platform \
-emit-import-library chicken.plist \
+ -emit-import-library chicken.process-context \
-emit-import-library chicken.time
internal.c: $(SRCDIR)internal.scm $(SRCDIR)mini-srfi-1.scm
$(bootstrap-lib) -emit-import-library chicken.internal
@@ -795,7 +809,7 @@ posixunix.c: $(SRCDIR)posix.scm $(SRCDIR)posixunix.scm $(SRCDIR)posix-common.scm
-emit-import-library chicken.time.posix \
-emit-import-library chicken.process \
-emit-import-library chicken.process.signal \
- -emit-import-library chicken.process-context \
+ -emit-import-library chicken.process-context.posix \
-emit-import-library chicken.posix
posixwin.c: $(SRCDIR)posix.scm $(SRCDIR)posixwin.scm $(SRCDIR)posix-common.scm $(SRCDIR)common-declarations.scm
$(bootstrap-lib) -feature platform-windows \
@@ -804,7 +818,7 @@ posixwin.c: $(SRCDIR)posix.scm $(SRCDIR)posixwin.scm $(SRCDIR)posix-common.scm $
-emit-import-library chicken.time.posix \
-emit-import-library chicken.process \
-emit-import-library chicken.process.signal \
- -emit-import-library chicken.process-context \
+ -emit-import-library chicken.process-context.posix \
-emit-import-library chicken.posix
irregex.c: $(SRCDIR)irregex.scm $(SRCDIR)irregex-core.scm $(SRCDIR)irregex-utils.scm $(SRCDIR)common-declarations.scm
$(bootstrap-lib) -emit-import-library chicken.irregex
diff --git a/tests/callback-tests.scm b/tests/callback-tests.scm
index afac01ee..b7c6eee2 100644
--- a/tests/callback-tests.scm
+++ b/tests/callback-tests.scm
@@ -1,5 +1,6 @@
;;;; callback-tests.scm
+(import (only (chicken process-context) command-line-arguments))
(define k1)
diff --git a/tests/executable-tests.scm b/tests/executable-tests.scm
index d98f121f..9ad7761f 100644
--- a/tests/executable-tests.scm
+++ b/tests/executable-tests.scm
@@ -2,8 +2,9 @@
(include "test.scm")
-(import (chicken pathname)
- (chicken posix)
+(import (chicken file)
+ (chicken pathname)
+ (chicken process-context)
(chicken string))
(define program-path
diff --git a/tests/fft.scm b/tests/fft.scm
index 3f00e38f..5c187feb 100644
--- a/tests/fft.scm
+++ b/tests/fft.scm
@@ -9,7 +9,10 @@
(block)
(not safe)))
(else
- (import chicken.bitwise chicken.fixnum chicken.flonum)))
+ (import (chicken bitwise)
+ (chicken fixnum)
+ (chicken flonum)
+ (chicken process-context))))
;;; All the following redefinitions are *ignored* by the Gambit compiler
;;; because of the declarations above.
diff --git a/tests/file-access-tests.scm b/tests/file-access-tests.scm
index 79682f2d..41e98343 100644
--- a/tests/file-access-tests.scm
+++ b/tests/file-access-tests.scm
@@ -4,6 +4,8 @@
;; These may seem silly, but some of them actually fail on MinGW without help.
;;
+(import (chicken process-context))
+
(define / (car (command-line-arguments)))
(define // (string-append / /))
(define /// (string-append / / /))
diff --git a/tests/locative-stress-test.scm b/tests/locative-stress-test.scm
index e5d160e9..96096fd6 100644
--- a/tests/locative-stress-test.scm
+++ b/tests/locative-stress-test.scm
@@ -2,7 +2,8 @@
(declare (usual-integrations))
-(import (chicken fixnum))
+(import (chicken fixnum)
+ (only (chicken process-context) command-line-arguments))
;(set-gc-report! #t)
diff --git a/tests/numbers-test.scm b/tests/numbers-test.scm
index 81be61e2..3141d5d2 100644
--- a/tests/numbers-test.scm
+++ b/tests/numbers-test.scm
@@ -7,7 +7,6 @@
(chicken flonum)
(chicken format)
(chicken platform)
- (chicken posix)
(chicken time))
;; The default "comparator" doesn't know how to deal with extended number types
diff --git a/tests/port-tests.scm b/tests/port-tests.scm
index 4fde81c0..b4774972 100644
--- a/tests/port-tests.scm
+++ b/tests/port-tests.scm
@@ -1,5 +1,7 @@
-(import chicken.condition chicken.file chicken.flonum chicken.format
- chicken.io chicken.port chicken.posix chicken.tcp srfi-4)
+(import chicken.condition chicken.file chicken.file.posix
+ chicken.flonum chicken.format chicken.io chicken.port
+ chicken.process chicken.process.signal chicken.tcp srfi-4
+ chicken.posix) ; FIXME drop once terminal-port? is rehomed
(include "test.scm")
(test-begin "ports")
diff --git a/tests/posix-tests.scm b/tests/posix-tests.scm
index 706a8dff..103f14a5 100644
--- a/tests/posix-tests.scm
+++ b/tests/posix-tests.scm
@@ -2,6 +2,7 @@
(chicken file)
(chicken platform)
(chicken posix)
+ (chicken process-context)
(chicken memory representation))
(define-syntax assert-error
diff --git a/tests/private-repository-test.scm b/tests/private-repository-test.scm
index 5db6544d..02e730eb 100644
--- a/tests/private-repository-test.scm
+++ b/tests/private-repository-test.scm
@@ -3,7 +3,8 @@
(import (chicken pathname)
(chicken platform)
- (chicken posix))
+ (chicken process-context)
+ (chicken file))
(define read-symbolic-link*
(cond-expand
diff --git a/types.db b/types.db
index b0772da5..76c6fb6f 100644
--- a/types.db
+++ b/types.db
@@ -846,11 +846,6 @@
(chicken.eval#module-environment
(#(procedure #:clean #:enforce) chicken.eval#module-environment ((or symbol (list-of (or symbol fixnum)))) (struct environment)))
-;; chicken
-
-(argc+argv (#(procedure #:clean) argc+argv () fixnum pointer))
-(argv (#(procedure #:clean) argv () (list-of string)))
-
;; base
@@ -1105,7 +1100,6 @@
(chicken.blob#string->blob (#(procedure #:clean #:enforce) chicken.blob#string->blob (string) blob))
(case-sensitive (#(procedure #:clean) case-sensitive (#!optional *) *))
-(command-line-arguments (#(procedure #:clean) command-line-arguments (#!optional (list-of string)) (list-of string)))
;; condition
@@ -1169,7 +1163,6 @@
(##sys#signal-hook (procedure ##sys#signal-hook (* #!rest) noreturn))
(##sys#debug-mode? (procedure ##sys#debug-mode? () boolean)
(() (##core#inline "C_i_debug_modep")))
-(executable-pathname (#(procedure #:pure) executable-pathname () (or string false)))
(file-exists? (#(procedure #:clean #:enforce) file-exists? (string) (or false string)))
(directory-exists? (#(procedure #:clean #:enforce) directory-exists? (string) (or false string)))
@@ -1314,7 +1307,6 @@
(chicken.fixnum#fx*? (#(procedure #:pure) chicken.fixnum#fx*? ((or fixnum false) (or fixnum false)) (or fixnum false)))
(chicken.fixnum#fx/? (#(procedure #:clean) chicken.fixnum#fx/? ((or fixnum false) (or fixnum false)) (or fixnum false)))
-(get-environment-variable (#(procedure #:clean #:enforce) get-environment-variable (string) *))
(get-output-string (#(procedure #:clean #:enforce) get-output-string (output-port) string))
;; keyword
@@ -1386,8 +1378,6 @@
(port-closed? (#(procedure #:clean #:enforce) port-closed? (port) boolean)
((port) (scheme#eq? (##sys#slot #(1) '8) '0)))
-(program-name (#(procedure #:clean #:enforce) program-name (#!optional string) string))
-
;; gc
@@ -1912,11 +1902,24 @@
(chicken.errno#errno/wouldblock fixnum)
(chicken.errno#errno/xdev fixnum)
+;; process-context
+
+(chicken.process-context#argc+argv (#(procedure #:clean) chicken.process-context#argc+argv () fixnum pointer))
+(chicken.process-context#argv (#(procedure #:clean) chicken.process-context#argv () (list-of string)))
+(chicken.process-context#change-directory (#(procedure #:clean #:enforce) chicken.process-context#change-directory (string) string))
+(chicken.process-context#command-line-arguments (#(procedure #:clean) chicken.process-context#command-line-arguments (#!optional (list-of string)) (list-of string)))
+(chicken.process-context#current-directory (#(procedure #:clean #:enforce) chicken.process-context#current-directory () string))
+(chicken.process-context#executable-pathname (#(procedure #:pure) chicken.process-context#executable-pathname () (or string false)))
+(chicken.process-context#get-environment-variable (#(procedure #:clean #:enforce) chicken.process-context#get-environment-variable (string) *))
+(chicken.process-context#get-environment-variables (#(procedure #:clean) chicken.process-context#get-environment-variables () (list-of (pair string string))))
+(chicken.process-context#program-name (#(procedure #:clean #:enforce) chicken.process-context#program-name (#!optional string) string))
+(chicken.process-context#set-environment-variable! (#(procedure #:clean #:enforce) chicken.process-context#set-environment-variable! (string string) undefined))
+(chicken.process-context#unset-environment-variable! (#(procedure #:clean #:enforce) chicken.process-context#unset-environment-variable! (string) undefined))
+
;; posix
(chicken.posix#call-with-input-pipe (#(procedure #:enforce) chicken.posix#call-with-input-pipe (string (procedure (input-port) . *) #!optional symbol) . *))
(chicken.posix#call-with-output-pipe (#(procedure #:enforce) chicken.posix#call-with-output-pipe (string (procedure (input-port) . *) #!optional symbol) . *))
-(chicken.posix#change-directory (#(procedure #:clean #:enforce) chicken.posix#change-directory (string) string))
(chicken.posix#change-directory* (#(procedure #:clean #:enforce) chicken.posix#change-directory* (fixnum) fixnum))
(chicken.posix#close-input-pipe (#(procedure #:clean #:enforce) chicken.posix#close-input-pipe (input-port) fixnum))
(chicken.posix#close-output-pipe (#(procedure #:clean #:enforce) chicken.posix#close-output-pipe (output-port) fixnum))
@@ -1925,12 +1928,9 @@
(chicken.posix#create-session (#(procedure #:clean) chicken.posix#create-session () fixnum))
(chicken.posix#create-symbolic-link (#(procedure #:clean #:enforce) chicken.posix#create-symbolic-link (string string) undefined))
-(chicken.posix#current-directory (#(procedure #:clean #:enforce) chicken.posix#current-directory () string))
-
(chicken.posix#current-effective-group-id (#(procedure #:clean) chicken.posix#current-effective-group-id () fixnum))
(chicken.posix#current-effective-user-id (#(procedure #:clean) chicken.posix#current-effective-user-id () fixnum))
(chicken.posix#current-effective-user-name (#(procedure #:clean) chicken.posix#current-effective-user-name () string))
-(chicken.posix#get-environment-variables (#(procedure #:clean) chicken.posix#get-environment-variables () (list-of (pair string string))))
(chicken.posix#current-group-id (#(procedure #:clean) chicken.posix#current-group-id () fixnum))
(chicken.posix#current-process-id (#(procedure #:clean) chicken.posix#current-process-id () fixnum))
(chicken.posix#current-user-id (#(procedure #:clean) chicken.posix#current-user-id () fixnum))
@@ -2044,7 +2044,6 @@
(chicken.posix#set-root-directory! (#(procedure #:clean #:enforce) chicken.posix#set-root-directory! (string) undefined))
(chicken.posix#set-signal-handler! (#(procedure #:clean #:enforce) chicken.posix#set-signal-handler! (fixnum (or false (procedure (fixnum) . *))) undefined))
(chicken.posix#set-signal-mask! (#(procedure #:clean #:enforce) chicken.posix#set-signal-mask! ((list-of fixnum)) undefined))
-(chicken.posix#set-environment-variable! (#(procedure #:clean #:enforce) chicken.posix#set-environment-variable! (string string) undefined))
(chicken.posix#signal-handler (#(procedure #:clean #:enforce) chicken.posix#signal-handler (fixnum) (or false (procedure (fixnum) . *))))
(chicken.posix#signal-mask (#(procedure #:clean) chicken.posix#signal-mask () fixnum))
(chicken.posix#signal-mask! (#(procedure #:clean #:enforce) chicken.posix#signal-mask! (fixnum) undefined))
@@ -2093,7 +2092,6 @@
(chicken.posix#terminal-port? (#(procedure #:clean #:enforce) chicken.posix#terminal-port? (port) boolean))
(chicken.posix#terminal-size (#(procedure #:clean #:enforce) chicken.posix#terminal-size (port) fixnum fixnum))
(chicken.posix#time->string (#(procedure #:clean #:enforce) chicken.posix#time->string ((vector fixnum fixnum fixnum fixnum fixnum fixnum fixnum fixnum boolean fixnum) #!optional string) string))
-(chicken.posix#unset-environment-variable! (#(procedure #:clean #:enforce) chicken.posix#unset-environment-variable! (string) undefined))
(chicken.posix#user-information (#(procedure #:clean #:enforce) chicken.posix#user-information ((or string fixnum) #!optional *) *))
(chicken.posix#utc-time->seconds (#(procedure #:clean #:enforce) chicken.posix#utc-time->seconds ((vector fixnum fixnum fixnum fixnum fixnum fixnum fixnum fixnum boolean fixnum)) integer))
(chicken.posix#with-input-from-pipe (#(procedure #:enforce) chicken.posix#with-input-from-pipe (string (procedure () . *) #!optional symbol) . *))
Trap