~ chicken-core (chicken-5) 118b48f132e16014ff19d84f59434aac2267860c
commit 118b48f132e16014ff19d84f59434aac2267860c
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Jun 1 13:36:35 2010 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Tue Jun 1 13:36:35 2010 +0200
applied patch by Peter Bex for providing location-info for ##sys#make-c-string invocations
diff --git a/compiler.scm b/compiler.scm
index a7d1612d..51ee03be 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -1144,7 +1144,8 @@
nonnull-c-string))
`((##sys#make-c-string
(##core#let
- () ,@(cddr lam)))))
+ () ,@(cddr lam))
+ ',name)))
((member
rtype
'((const c-string*)
@@ -1167,7 +1168,7 @@
((r (##core#let () ,@(cddr lam))))
(,(macro-alias 'and se)
r
- (##sys#make-c-string r)) ) ) )
+ (##sys#make-c-string r ',name)) ) ) )
(else (cddr lam)) ) )
rtype) ) )
e se #f) ) ) ) )
diff --git a/eval.scm b/eval.scm
index 1fe54b48..cb00ab75 100644
--- a/eval.scm
+++ b/eval.scm
@@ -889,9 +889,9 @@
(display " ...\n")
(flush-output)] )
(or (and fname
- (or (##sys#dload (##sys#make-c-string fname) topentry #t)
+ (or (##sys#dload (##sys#make-c-string fname 'load) topentry #t)
(and (not (has-sep? fname))
- (##sys#dload (##sys#make-c-string (##sys#string-append "./" fname)) topentry #t) ) ) )
+ (##sys#dload (##sys#make-c-string (##sys#string-append "./" fname) 'load) topentry #t) ) ) )
(call-with-current-continuation
(lambda (abrt)
(fluid-let ((##sys#read-error-with-line-number #t)
@@ -989,14 +989,14 @@
(string-append
"C_"
(##sys#string->c-identifier (##sys#slot uname 1))
- "_toplevel") ) ] )
+ "_toplevel") 'load-library) ] )
(when (load-verbose)
(display "; loading library ")
(display uname)
(display " ...\n") )
(let loop ([libs libs])
(cond [(null? libs) #f]
- [(##sys#dload (##sys#make-c-string (##sys#slot libs 0)) top #f)
+ [(##sys#dload (##sys#make-c-string (##sys#slot libs 0) 'load-library) top #f)
(unless (memq id ##sys#features) (set! ##sys#features (cons id ##sys#features)))
#t]
[else (loop (##sys#slot libs 1))] ) ) ) ) ) ) ) )
diff --git a/files.scm b/files.scm
index 4ff312e3..9fbc27db 100644
--- a/files.scm
+++ b/files.scm
@@ -378,7 +378,7 @@ EOF
(number->string n 16)))))
(if (directory-exists? pn)
(loop)
- (let ((r (##core#inline "C_mkdir" (##sys#make-c-string pn))))
+ (let ((r (##core#inline "C_mkdir" (##sys#make-c-string pn 'create-temporary-directory))))
(if (eq? r 0)
pn
(##sys#signal-hook
diff --git a/library.scm b/library.scm
index 2d35cad3..e9a444cc 100644
--- a/library.scm
+++ b/library.scm
@@ -1953,7 +1953,7 @@ EOF
(##sys#pathname-resolution
filename
(lambda (filename)
- (unless (eq? 0 (##core#inline "C_delete_file" (##sys#make-c-string filename)))
+ (unless (eq? 0 (##core#inline "C_delete_file" (##sys#make-c-string filename 'delete-file)))
(##sys#update-errno)
(##sys#signal-hook
#:file-error 'delete-file
@@ -1970,7 +1970,7 @@ EOF
(##sys#pathname-resolution
new
(lambda (new)
- (unless (eq? 0 (##core#inline "C_rename_file" (##sys#make-c-string old) (##sys#make-c-string new)))
+ (unless (eq? 0 (##core#inline "C_rename_file" (##sys#make-c-string old 'rename-file) (##sys#make-c-string new)))
(##sys#update-errno)
(##sys#signal-hook
#:file-error 'rename-file
@@ -4369,7 +4369,7 @@ EOF
(cond [(symbol? prefix) (##sys#slot prefix 1)]
[(string? prefix) prefix]
[else (##sys#signal-hook #:type-error "bad argument type - invalid prefix" prefix)] ) ) ] )
- (let ([nsp (##sys#find-symbol-table (##sys#make-c-string (##sys#slot ns 1)))])
+ (let ([nsp (##sys#find-symbol-table (##sys#make-c-string (##sys#slot ns 1) 'import))])
(define (copy s str)
(let ([s2 (##sys#intern-symbol
(if prefix
@@ -4407,7 +4407,7 @@ EOF
(cond [(symbol? sym) (##sys#slot sym 1)]
[(string? sym) sym]
[else (##sys#signal-hook #:type-error "bad argument type - not a valid import name" sym)] )
- (##sys#find-symbol-table (##sys#make-c-string (##sys#slot ns 1))) ) ] )
+ (##sys#find-symbol-table (##sys#make-c-string (##sys#slot ns 1) '##sys#namespace-ref)) ) ] )
(cond [s (##core#inline "C_retrieve" s)]
[(pair? default) (car default)]
[else (##sys#error "symbol not exported from namespace" sym ns)] ) ) )
diff --git a/posixunix.scm b/posixunix.scm
index 837487ef..e4768282 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -615,7 +615,7 @@ EOF
(##sys#check-string filename 'file-open)
(##sys#check-exact flags 'file-open)
(##sys#check-exact mode 'file-open)
- (let ([fd (##core#inline "C_open" (##sys#make-c-string (##sys#expand-home-path filename)) flags mode)])
+ (let ([fd (##core#inline "C_open" (##sys#make-c-string (##sys#expand-home-path filename) 'file-open) flags mode)])
(when (eq? -1 fd)
(posix-error #:file-error 'file-open "cannot open file" filename flags mode) )
fd) ) ) ) )
@@ -654,7 +654,7 @@ EOF
(define file-mkstemp
(lambda (template)
(##sys#check-string template 'file-mkstemp)
- (let* ([buf (##sys#make-c-string template)]
+ (let* ([buf (##sys#make-c-string template 'file-mkstemp)]
[fd (##core#inline "C_mkstemp" buf)]
[path-length (##sys#size buf)])
(when (eq? -1 fd)
@@ -747,12 +747,13 @@ EOF
(define (##sys#stat file link loc)
(let ([r (cond [(fixnum? file) (##core#inline "C_fstat" file)]
[(string? file)
- (let ([path (##sys#make-c-string (##sys#expand-home-path file))])
+ (let ([path (##sys#make-c-string (##sys#expand-home-path file) loc)])
(if link
(##core#inline "C_lstat" path)
(##core#inline "C_stat" path) ) ) ]
[else
- (##sys#signal-hook #:type-error loc "bad argument type - not a fixnum or string" file)] ) ] )
+ (##sys#signal-hook
+ #:type-error loc "bad argument type - not a fixnum or string" file)] ) ] )
(when (fx< r 0)
(posix-error #:file-error loc "cannot access file" file) ) ) )
@@ -825,11 +826,11 @@ EOF
;;; Directory stuff:
(define-inline (*directory? loc name)
- (and (fx= 0 (##core#inline "C_stat" (##sys#make-c-string name)))
+ (and (fx= 0 (##core#inline "C_stat" (##sys#make-c-string name loc)))
(foreign-value "C_isdir" bool) ) )
(define-inline (*create-directory loc name)
- (unless (fx= 0 (##core#inline "C_mkdir" (##sys#make-c-string name)))
+ (unless (fx= 0 (##core#inline "C_mkdir" (##sys#make-c-string name loc)))
(posix-error #:file-error loc "cannot create directory" name)) )
(define create-directory
@@ -851,7 +852,7 @@ EOF
(define change-directory
(lambda (name)
(##sys#check-string name 'change-directory)
- (let ((sname (##sys#make-c-string (##sys#expand-home-path name))))
+ (let ((sname (##sys#make-c-string (##sys#expand-home-path name) 'change-directory)))
(unless (fx= 0 (##core#inline "C_chdir" sname))
(posix-error #:file-error 'change-directory "cannot change current directory" name) )
name)))
@@ -859,7 +860,7 @@ EOF
(define delete-directory
(lambda (name)
(##sys#check-string name 'delete-directory)
- (let ((sname (##sys#make-c-string (##sys#expand-home-path name))))
+ (let ((sname (##sys#make-c-string (##sys#expand-home-path name) 'delete-directory)))
(unless (fx= 0 (##core#inline "C_rmdir" sname))
(posix-error #:file-error 'delete-directory "cannot delete directory" name) )
name)))
@@ -873,7 +874,7 @@ EOF
(let ([buffer (make-string 256)]
[handle (##sys#make-pointer)]
[entry (##sys#make-pointer)] )
- (##core#inline "C_opendir" (##sys#make-c-string (##sys#expand-home-path spec)) handle)
+ (##core#inline "C_opendir" (##sys#make-c-string (##sys#expand-home-path spec) 'directory) handle)
(if (##sys#null-pointer? handle)
(posix-error #:file-error 'directory "cannot open directory" spec)
(let loop ()
@@ -917,8 +918,8 @@ EOF
'open-input-pipe
cmd #t
(case m
- ((#:text) (##core#inline_allocate ("open_text_input_pipe" 2) (##sys#make-c-string cmd)))
- ((#:binary) (##core#inline_allocate ("open_binary_input_pipe" 2) (##sys#make-c-string cmd)))
+ ((#:text) (##core#inline_allocate ("open_text_input_pipe" 2) (##sys#make-c-string cmd 'open-input-pipe)))
+ ((#:binary) (##core#inline_allocate ("open_binary_input_pipe" 2) (##sys#make-c-string cmd 'open-input-pipe)))
(else (badmode m)) ) ) ) ) )
(set! open-output-pipe
(lambda (cmd . m)
@@ -928,8 +929,8 @@ EOF
'open-output-pipe
cmd #f
(case m
- ((#:text) (##core#inline_allocate ("open_text_output_pipe" 2) (##sys#make-c-string cmd)))
- ((#:binary) (##core#inline_allocate ("open_binary_output_pipe" 2) (##sys#make-c-string cmd)))
+ ((#:text) (##core#inline_allocate ("open_text_output_pipe" 2) (##sys#make-c-string cmd 'open-output-pipe)))
+ ((#:binary) (##core#inline_allocate ("open_binary_output_pipe" 2) (##sys#make-c-string cmd 'open-output-pipe)))
(else (badmode m)) ) ) ) ) )
(set! close-input-pipe
(lambda (port)
@@ -1182,7 +1183,7 @@ EOF
(##core#inline "C_getpwuid" user)
(begin
(##sys#check-string user 'user-information)
- (##core#inline "C_getpwnam" (##sys#make-c-string user)) ) ) ] )
+ (##core#inline "C_getpwnam" (##sys#make-c-string user 'user-information)) ) ) ] )
(and r
((if as-vector vector list)
_user-name
@@ -1212,7 +1213,7 @@ EOF
(##core#inline "C_getgrgid" group)
(begin
(##sys#check-string group 'group-information)
- (##core#inline "C_getgrnam" (##sys#make-c-string group)) ) ) ] )
+ (##core#inline "C_getgrnam" (##sys#make-c-string group 'group-information)) ) ) ] )
(and r
((if as-vector vector list)
_group-name
@@ -1348,7 +1349,7 @@ EOF
(lambda (fname m)
(##sys#check-string fname 'change-file-mode)
(##sys#check-exact m 'change-file-mode)
- (when (fx< (##core#inline "C_chmod" (##sys#make-c-string (##sys#expand-home-path fname)) m) 0)
+ (when (fx< (##core#inline "C_chmod" (##sys#make-c-string (##sys#expand-home-path fname) 'change-file-mode) m) 0)
(posix-error #:file-error 'change-file-mode "cannot change file mode" fname m) ) ) )
(define change-file-owner
@@ -1356,7 +1357,7 @@ EOF
(##sys#check-string fn 'change-file-owner)
(##sys#check-exact uid 'change-file-owner)
(##sys#check-exact gid 'change-file-owner)
- (when (fx< (##core#inline "C_chown" (##sys#make-c-string (##sys#expand-home-path fn)) uid gid) 0)
+ (when (fx< (##core#inline "C_chown" (##sys#make-c-string (##sys#expand-home-path fn) 'change-file-owner) uid gid) 0)
(posix-error #:file-error 'change-file-owner "cannot change file owner" fn uid gid) ) ) )
(define-foreign-variable _r_ok int "R_OK")
@@ -1366,7 +1367,7 @@ EOF
(let ()
(define (check filename acc loc)
(##sys#check-string filename loc)
- (let ([r (fx= 0 (##core#inline "C_test_access" (##sys#make-c-string (##sys#expand-home-path filename)) acc))])
+ (let ([r (fx= 0 (##core#inline "C_test_access" (##sys#make-c-string (##sys#expand-home-path filename) loc) acc))])
(unless r (##sys#update-errno))
r) )
(set! file-read-access? (lambda (filename) (check filename _r_ok 'file-read-access?)))
@@ -1405,8 +1406,8 @@ EOF
(##sys#check-string new 'create-symbolic-link)
(when (fx< (##core#inline
"C_symlink"
- (##sys#make-c-string (##sys#expand-home-path old))
- (##sys#make-c-string (##sys#expand-home-path new)) )
+ (##sys#make-c-string (##sys#expand-home-path old) 'create-symbolic-link)
+ (##sys#make-c-string (##sys#expand-home-path new) 'create-symbolic-link) )
0)
(posix-error #:file-error 'create-symbol-link "cannot create symbolic link" old new) ) ) )
@@ -1417,7 +1418,7 @@ EOF
[buf (make-string (fx+ _filename_max 1))] )
(lambda (fname #!optional canonicalize)
(##sys#check-string fname 'read-symbolic-link)
- (let ([len (##core#inline "C_do_readlink" (##sys#make-c-string (##sys#expand-home-path fname)) buf)])
+ (let ([len (##core#inline "C_do_readlink" (##sys#make-c-string (##sys#expand-home-path fname) 'read-symbolic-link) buf)])
(when (fx< len 0)
(posix-error #:file-error 'read-symbolic-link "cannot read symbolic link" fname) )
(let ((pathname (substring buf 0 len)))
@@ -1445,7 +1446,7 @@ EOF
(define fileno/stderr _stderr_fileno)
(let ()
- (define (mode inp m)
+ (define (mode inp m loc)
(##sys#make-c-string
(cond [(pair? m)
(let ([m (car m)])
@@ -1453,7 +1454,8 @@ EOF
[(###append) (if (not inp) "a" (##sys#error "invalid mode for input file" m))]
[else (##sys#error "invalid mode argument" m)] ) ) ]
[inp "r"]
- [else "w"] ) ) )
+ [else "w"] )
+ loc) )
(define (check loc fd inp r)
(if (##sys#null-pointer? r)
(posix-error #:file-error loc "cannot open file" fd)
@@ -1463,11 +1465,11 @@ EOF
(set! open-input-file*
(lambda (fd . m)
(##sys#check-exact fd 'open-input-file*)
- (check 'open-input-file* fd #t (##core#inline_allocate ("C_fdopen" 2) fd (mode #t m))) ) )
+ (check 'open-input-file* fd #t (##core#inline_allocate ("C_fdopen" 2) fd (mode #t m 'open-input-file*))) ) )
(set! open-output-file*
(lambda (fd . m)
(##sys#check-exact fd 'open-output-file*)
- (check 'open-output-file* fd #f (##core#inline_allocate ("C_fdopen" 2) fd (mode #f m)) ) ) ) )
+ (check 'open-output-file* fd #f (##core#inline_allocate ("C_fdopen" 2) fd (mode #f m 'open-output-file*)) ) ) ) )
(define port->fileno
(lambda (port)
@@ -1680,7 +1682,7 @@ EOF
(define file-truncate
(lambda (fname off)
(##sys#check-number off 'file-truncate)
- (when (fx< (cond [(string? fname) (##core#inline "C_truncate" (##sys#make-c-string (##sys#expand-home-path fname)) off)]
+ (when (fx< (cond [(string? fname) (##core#inline "C_truncate" (##sys#make-c-string (##sys#expand-home-path fname) 'file-truncate) off)]
[(fixnum? fname) (##core#inline "C_ftruncate" fname off)]
[else (##sys#error 'file-truncate "invalid file" fname)] )
0)
@@ -1739,7 +1741,7 @@ EOF
(##sys#check-string fname 'create-fifo)
(let ([mode (if (pair? mode) (car mode) (fxior _s_irwxu (fxior _s_irwxg _s_irwxo)))])
(##sys#check-exact mode 'create-fifo)
- (when (fx< (##core#inline "C_mkfifo" (##sys#make-c-string (##sys#expand-home-path fname)) mode) 0)
+ (when (fx< (##core#inline "C_mkfifo" (##sys#make-c-string (##sys#expand-home-path fname) 'create-fifo) mode) 0)
(posix-error #:file-error 'create-fifo "cannot create FIFO" fname mode) ) ) ) )
(define fifo?
@@ -1757,12 +1759,12 @@ EOF
(lambda (var val)
(##sys#check-string var 'setenv)
(##sys#check-string val 'setenv)
- (##core#inline "C_setenv" (##sys#make-c-string var) (##sys#make-c-string val))
+ (##core#inline "C_setenv" (##sys#make-c-string var 'setenv) (##sys#make-c-string val 'setenv))
(##core#undefined) ) )
(define (unsetenv var)
(##sys#check-string var 'unsetenv)
- (##core#inline "C_unsetenv" (##sys#make-c-string var))
+ (##core#inline "C_unsetenv" (##sys#make-c-string var 'unsetenv))
(##core#undefined) )
(define get-environment-variables
@@ -1863,7 +1865,7 @@ EOF
(if fmt
(begin
(##sys#check-string fmt 'time->string)
- (or (strftime tm (##sys#make-c-string fmt))
+ (or (strftime tm (##sys#make-c-string fmt 'time->string))
(##sys#error 'time->string "time formatting overflows buffer" tm)) )
(let ([str (asctime tm)])
(if str
@@ -1875,7 +1877,7 @@ EOF
(lambda (tim #!optional (fmt "%a %b %e %H:%M:%S %Z %Y"))
(##sys#check-string tim 'string->time)
(##sys#check-string fmt 'string->time)
- (strptime (##sys#make-c-string tim) (##sys#make-c-string fmt) (make-vector 10 #f)) ) ) )
+ (strptime (##sys#make-c-string tim 'string->time) (##sys#make-c-string fmt) (make-vector 10 #f)) ) ) )
(define (local-time->seconds tm)
(check-time-vector 'local-time->seconds tm)
@@ -2012,7 +2014,7 @@ EOF
(let ([s (car el)])
(##sys#check-string s 'process-execute)
(setenv i s (##sys#size s)) ) ) )
- (let* ([prg (##sys#make-c-string (##sys#expand-home-path filename))]
+ (let* ([prg (##sys#make-c-string (##sys#expand-home-path filename) 'process-execute)]
[r (if envlist
(##core#inline "C_execve" prg)
(##core#inline "C_execvp" prg) )] )
diff --git a/posixwin.scm b/posixwin.scm
index 1c2150a3..7de366dc 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -997,7 +997,7 @@ EOF
(##sys#check-string filename 'file-open)
(##sys#check-exact flags 'file-open)
(##sys#check-exact mode 'file-open)
- (let ([fd (##core#inline "C_open" (##sys#make-c-string (##sys#expand-home-path filename)) flags mode)])
+ (let ([fd (##core#inline "C_open" (##sys#make-c-string (##sys#expand-home-path filename) 'file-open) flags mode)])
(when (eq? -1 fd)
(##sys#update-errno)
(##sys#signal-hook #:file-error 'file-open "cannot open file" filename flags mode) )
@@ -1041,7 +1041,7 @@ EOF
(let ([string-length string-length])
(lambda (template)
(##sys#check-string template 'file-mkstemp)
- (let* ([buf (##sys#make-c-string template)]
+ (let* ([buf (##sys#make-c-string template 'file-mkstemp)]
[fd (##core#inline "C_mkstemp" buf)]
[path-length (string-length buf)])
(when (eq? -1 fd)
@@ -1072,7 +1072,10 @@ EOF
(define (##sys#stat file link loc) ; link is ignored
(let ([r (cond [(fixnum? file) (##core#inline "C_fstat" file)]
- [(string? file) (##core#inline "C_stat" (##sys#make-c-string (##sys#expand-home-path file)))]
+ [(string? file)
+ (##core#inline
+ "C_stat"
+ (##sys#make-c-string (##sys#expand-home-path file) loc))]
[else
(##sys#signal-hook #:type-error loc "bad argument type - not a fixnum or string" file)] ) ] )
(when (fx< r 0)
@@ -1136,7 +1139,7 @@ EOF
;;; Directory stuff:
(define-inline (create-directory-helper name)
- (unless (fx= 0 (##core#inline "C_mkdir" (##sys#make-c-string name)))
+ (unless (fx= 0 (##core#inline "C_mkdir" (##sys#make-c-string name 'create-directory)))
(##sys#update-errno)
(##sys#signal-hook #:file-error 'create-directory
"cannot create directory" name)))
@@ -1173,7 +1176,7 @@ EOF
(define change-directory
(lambda (name)
(##sys#check-string name 'change-directory)
- (let ((sname (##sys#make-c-string (##sys#expand-home-path name))))
+ (let ((sname (##sys#make-c-string (##sys#expand-home-path name) 'change-directory)))
(unless (fx= 0 (##core#inline "C_chdir" sname))
(##sys#update-errno)
(##sys#signal-hook
@@ -1183,7 +1186,7 @@ EOF
(define delete-directory
(lambda (name)
(##sys#check-string name 'delete-directory)
- (let ((sname (##sys#make-c-string (##sys#expand-home-path name))))
+ (let ((sname (##sys#make-c-string (##sys#expand-home-path name) 'delete-directory)))
(unless (fx= 0 (##core#inline "C_rmdir" sname))
(##sys#update-errno)
(##sys#signal-hook #:file-error 'delete-directory "cannot delete directory" name) )
@@ -1198,7 +1201,7 @@ EOF
(let ([buffer (make-string 256)]
[handle (##sys#make-pointer)]
[entry (##sys#make-pointer)] )
- (##core#inline "C_opendir" (##sys#make-c-string (##sys#expand-home-path spec)) handle)
+ (##core#inline "C_opendir" (##sys#make-c-string (##sys#expand-home-path spec) 'directory) handle)
(if (##sys#null-pointer? handle)
(begin
(##sys#update-errno)
@@ -1246,8 +1249,8 @@ EOF
(check
cmd #t
(case m
- ((###text) (##core#inline_allocate ("open_text_input_pipe" 2) (##sys#make-c-string cmd)))
- ((###binary) (##core#inline_allocate ("open_binary_input_pipe" 2) (##sys#make-c-string cmd)))
+ ((###text) (##core#inline_allocate ("open_text_input_pipe" 2) (##sys#make-c-string cmd 'open-input-pipe)))
+ ((###binary) (##core#inline_allocate ("open_binary_input_pipe" 2) (##sys#make-c-string cmd 'open-input-pipe)))
(else (badmode m)) ) ) ) ) )
(set! open-output-pipe
(lambda (cmd . m)
@@ -1256,8 +1259,8 @@ EOF
(check
cmd #f
(case m
- ((###text) (##core#inline_allocate ("open_text_output_pipe" 2) (##sys#make-c-string cmd)))
- ((###binary) (##core#inline_allocate ("open_binary_output_pipe" 2) (##sys#make-c-string cmd)))
+ ((###text) (##core#inline_allocate ("open_text_output_pipe" 2) (##sys#make-c-string cmd 'open-output-pipe)))
+ ((###binary) (##core#inline_allocate ("open_binary_output_pipe" 2) (##sys#make-c-string cmd 'open-output-pipe)))
(else (badmode m)) ) ) ) ) )
(set! close-input-pipe
(lambda (port)
@@ -1472,7 +1475,7 @@ EOF
(lambda (fname m)
(##sys#check-string fname 'change-file-mode)
(##sys#check-exact m 'change-file-mode)
- (when (fx< (##core#inline "C_chmod" (##sys#make-c-string (##sys#expand-home-path fname)) m) 0)
+ (when (fx< (##core#inline "C_chmod" (##sys#make-c-string (##sys#expand-home-path fname) 'change-file-mode) m) 0)
(##sys#update-errno)
(##sys#signal-hook #:file-error 'change-file-mode "cannot change file mode" fname m) ) ) )
@@ -1483,7 +1486,7 @@ EOF
(let ()
(define (check filename acc loc)
(##sys#check-string filename loc)
- (let ([r (fx= 0 (##core#inline "C_test_access" (##sys#make-c-string (##sys#expand-home-path filename)) acc))])
+ (let ([r (fx= 0 (##core#inline "C_test_access" (##sys#make-c-string (##sys#expand-home-path filename) loc) acc))])
(unless r (##sys#update-errno))
r) )
(set! file-read-access? (lambda (filename) (check filename _r_ok 'file-read-access?)))
@@ -1503,7 +1506,7 @@ EOF
(define fileno/stderr _stderr_fileno)
(let ()
- (define (mode inp m)
+ (define (mode inp m loc)
(##sys#make-c-string
(cond [(pair? m)
(let ([m (car m)])
@@ -1511,7 +1514,8 @@ EOF
[(###append) (if (not inp) "a" (##sys#error "invalid mode for input file" m))]
[else (##sys#error "invalid mode argument" m)] ) ) ]
[inp "r"]
- [else "w"] ) ) )
+ [else "w"] )
+ loc) )
(define (check fd inp r)
(##sys#update-errno)
(if (##sys#null-pointer? r)
@@ -1522,11 +1526,11 @@ EOF
(set! open-input-file*
(lambda (fd . m)
(##sys#check-exact fd 'open-input-file*)
- (check fd #t (##core#inline_allocate ("C_fdopen" 2) fd (mode #t m))) ) )
+ (check fd #t (##core#inline_allocate ("C_fdopen" 2) fd (mode #t m 'open-input-file*))) ) )
(set! open-output-file*
(lambda (fd . m)
(##sys#check-exact fd 'open-output-file*)
- (check fd #f (##core#inline_allocate ("C_fdopen" 2) fd (mode #f m)) ) ) ) )
+ (check fd #f (##core#inline_allocate ("C_fdopen" 2) fd (mode #f m 'open-output-file*)) ) ) ) )
(define port->fileno
(lambda (port)
@@ -1559,12 +1563,12 @@ EOF
(lambda (var val)
(##sys#check-string var 'setenv)
(##sys#check-string val 'setenv)
- (##core#inline "C_setenv" (##sys#make-c-string var) (##sys#make-c-string val))
+ (##core#inline "C_setenv" (##sys#make-c-string var 'setenv) (##sys#make-c-string val 'setenv))
(##core#undefined) ) )
(define (unsetenv var)
(##sys#check-string var 'unsetenv)
- (##core#inline "C_putenv" (##sys#make-c-string var))
+ (##core#inline "C_putenv" (##sys#make-c-string var 'unsetenv))
(##core#undefined) )
(define get-environment-variables
@@ -1612,7 +1616,7 @@ EOF
(if fmt
(begin
(##sys#check-string fmt 'time->string)
- (or (strftime tm (##sys#make-c-string fmt))
+ (or (strftime tm (##sys#make-c-string fmt 'time->string))
(##sys#error 'time->string "time formatting overflows buffer" tm)) )
(let ([str (asctime tm)])
(if str
@@ -1737,7 +1741,7 @@ EOF
(build-exec-argvec loc (and arglst ($quote-args-list arglst exactf)) setarg 1)
(build-exec-argvec loc envlst setenv 0)
(##core#inline "C_flushall")
- (##sys#make-c-string (##sys#expand-home-path filename)) ) ) )
+ (##sys#make-c-string (##sys#expand-home-path filename) loc) ) ) )
(define ($exec-teardown loc msg filename res)
(##sys#update-errno)
Trap