(lambda ()
(add-event-receiver! event:after-restart process-command-line)))
+(define (scheme-program-name)
+ (string-from-primitive ((ucode-primitive scheme-program-name 0))))
+
(define (command-line)
- (vector->list ((ucode-primitive get-command-line 0))))
+ (map string-from-primitive
+ (vector->list ((ucode-primitive get-command-line 0)))))
(define-deferred param:load-init-file?
(make-settable-parameter #t))
(set! *command-line-arguments* '())
(let ((unused (or ((ucode-primitive get-unused-command-line 0)) '#())))
(parameterize ((param:load-init-file? #t))
- (process-keyword (vector->list unused) '())
+ (process-keyword (map string-from-primitive (vector->list unused)) '())
(for-each (lambda (act) (act))
(reverse after-parsing-actions))
(if (and (param:load-init-file?)
(define (reset-environment-variables!)
(hash-table-clear! %env-cache)
(vector-for-each (lambda (s)
- (let ((i (string-find-next-char s #\=)))
+ (let ((s (string-from-primitive s))
+ (i (string-find-next-char s #\=)))
(if i
(hash-table-set! %env-cache
(string-head s i)
(lambda ()
(let ((result ((ucode-primitive open-pty-master 0))))
(values (make-channel (vector-ref result 0))
- (vector-ref result 1)
- (vector-ref result 2))))))
+ (string-from-primitive (vector-ref result 1))
+ (string-from-primitive (vector-ref result 2)))))))
(define (pty-master-send-signal channel signal)
((ucode-primitive pty-master-send-signal 2) (channel-descriptor channel)
(remove-from-gc-finalizer! open-directories channel))
(define (directory-channel-read channel)
- ((ucode-primitive new-directory-read 1)
- (directory-channel/descriptor channel)))
+ (string-from-primitive
+ ((ucode-primitive new-directory-read 1)
+ (directory-channel/descriptor channel))))
(define (directory-channel-read-matching channel prefix)
- ((ucode-primitive new-directory-read-matching 2)
- (directory-channel/descriptor channel)
- (string-for-primitive prefix)))
+ (string-from-primitive
+ ((ucode-primitive new-directory-read-matching 2)
+ (directory-channel/descriptor channel)
+ (string-for-primitive prefix))))
\f
;;;; Select registry
(define-package (runtime simple-file-ops)
(files "sfile")
(parent (runtime))
+ (export () deprecated:simple-file-ops
+ (file-writable? file-writeable?))
(export ()
+ (file-exists? file-exists-indirect?)
+ (file-soft-link? file-symbolic-link?)
<mime-type>
allocate-temporary-file
associate-pathname-type-with-mime-type
file-executable?
file-exists-direct?
file-exists-indirect?
- file-exists?
file-modification-time<=?
file-modification-time<?
file-processed?
file-readable?
file-regular?
- file-soft-link?
file-symbolic-link?
file-touch
file-type-direct
file-type-indirect
- file-writable?
file-writeable?
guarantee-init-file-directory
hard-link-file
(parent (runtime))
(files "os-primitives")
(export ()
+ (file-attributes file-attributes-direct)
copy-file
current-home-directory
current-user-name
file-access-time
file-access-time-direct
file-access-time-indirect
- file-attributes
file-attributes-direct
file-attributes-indirect
file-attributes/access-time
substring?
vector->string)
(export (runtime)
- string-for-primitive)
+ string-for-primitive
+ string-from-primitive)
(export (runtime symbol)
%ascii-ustring!
%ascii-ustring-allocate
argument-command-line-parser
command-line
command-line-arguments
+ scheme-program-name
set-command-line-parser!
simple-command-line-parser))
(->namestring
(if (default-object? filename)
(merge-pathnames
- (let ((filename ((ucode-primitive reload-band-name))))
+ (let ((filename
+ (string-from-primitive
+ ((ucode-primitive reload-band-name)))))
(if (not filename)
(error "no default band name available"))
filename))
#f
result)))
-(define file-exists? file-exists-indirect?)
-
(define file-type-direct)
(define file-type-indirect)
(let ((make-file-type
(eq? 'directory (file-type-indirect filename)))
(define (file-symbolic-link? filename)
- ((ucode-primitive file-symlink? 1)
- (string-for-primitive (->namestring (merge-pathnames filename)))))
-(define file-soft-link? file-symbolic-link?)
+ (string-from-primitive
+ ((ucode-primitive file-symlink? 1)
+ (string-for-primitive (->namestring (merge-pathnames filename))))))
(define (file-access filename amode)
((ucode-primitive file-access 2)
filename
(string-for-primitive (directory-namestring pathname)))))
2))
-(define file-writable? file-writeable?) ;upwards compatability
(define (file-executable? filename)
(file-access filename 1))
string
(string->utf8 string)))
+(define (string-from-primitive string)
+ (if (legacy-string? string)
+ (utf8->string (legacy-string->bytevector string))
+ string))
+
(define-integrable (every-loop proc ref string start end)
(let loop ((i start))
(if (fix:< i end)
(error "Can't find temporary directory.")))))
\f
(define (file-attributes-direct filename)
- ((ucode-primitive file-attributes 1)
- (string-for-primitive (->namestring (merge-pathnames filename)))))
+ (let ((v
+ ((ucode-primitive file-attributes 1)
+ (string-for-primitive (->namestring (merge-pathnames filename))))))
+ (and v
+ (begin
+ (vector-set! v 0 (string-from-primitive (vector-ref v 0)))
+ v))))
(define (file-attributes-indirect filename)
((ucode-primitive file-attributes-indirect 1)
(string-for-primitive (->namestring (merge-pathnames filename)))))
-(define file-attributes
- file-attributes-direct)
-
(define-structure (file-attributes
(type vector)
(constructor #f)
(let ((directory ((ucode-primitive get-user-home-directory 1) user-name)))
(if (not directory)
(error "Can't find user's home directory:" user-name))
- (pathname-as-directory directory)))
+ (pathname-as-directory (string-from-primitive directory))))
(define (current-home-directory)
(let ((home (get-environment-variable "HOME")))
(working-directory-pathname
(pathname-simplify
(pathname-as-directory
- ((ucode-primitive working-directory-pathname))))))
+ (string-from-primitive
+ ((ucode-primitive working-directory-pathname)))))))
(define (set-working-directory-pathname! name)
(let ((pathname (new-pathname name)))