cs: more portable approach to errno

Have the main Racket executable export a function to get errno, which
avoids portability problems trying to access it via the FFI.

Related to #2344
This commit is contained in:
Matthew Flatt 2018-10-29 20:35:12 -06:00
parent 063fa65872
commit 0242a46396
2 changed files with 37 additions and 18 deletions

View File

@ -5,6 +5,7 @@
#include <fcntl.h> #include <fcntl.h>
#include <string.h> #include <string.h>
#include <stdlib.h> #include <stdlib.h>
#include <errno.h>
#include "scheme.h" #include "scheme.h"
#include "rktio.h" #include "rktio.h"
@ -78,10 +79,16 @@ static void racket_exit(int v)
exit(v); exit(v);
} }
static int racket_errno()
{
return errno;
}
static void init_foreign() static void init_foreign()
{ {
# include "rktio.inc" # include "rktio.inc"
Sforeign_symbol("racket_exit", (void *)racket_exit); Sforeign_symbol("racket_exit", (void *)racket_exit);
Sforeign_symbol("racket_errno", (void *)racket_errno);
} }
void racket_boot(int argc, char **argv, char *self, void racket_boot(int argc, char **argv, char *self,

View File

@ -1814,24 +1814,36 @@
;; function is called with interrupts disabled ;; function is called with interrupts disabled
(define get-errno (define get-errno
(let ([get-&errno-name (cond
(case (machine-type) [(foreign-entry? "racket_errno")
[(a6nt ta6nt i3nt ti3nt) (foreign-procedure "racket_errno" () int)]
(load-shared-object "msvcrt.dll") [else
"_errno"] ;; We get here only during a bootstrapping process or in a
[(a6osx ta6osx i3osx ti3osx) ;; development mode that is not running in a Racket executable
(load-shared-object "libc.dylib") (let ([get-&errno-name
"__error"] (case (machine-type)
[(a6le ta6le i3le ti3le) [(a6nt ta6nt i3nt ti3nt)
(load-shared-object "libc.so.6") (load-shared-object "msvcrt.dll")
"__errno_location"] "_errno"]
[else [(a6osx ta6osx i3osx ti3osx)
;; FIXME for more platforms (load-shared-object "libc.dylib")
(load-shared-object "libc.so") "__error"]
"__error"])]) [(a6le ta6le i3le ti3le)
(let ([get-&errno (foreign-procedure get-&errno-name () void*)]) (load-shared-object "libc.so.6")
(lambda () "__errno_location"]
(foreign-ref 'int (get-&errno) 0))))) [else #f])])
(cond
[get-&errno-name
(let ([get-&errno (foreign-procedure get-&errno-name () void*)])
(lambda ()
(foreign-ref 'int (get-&errno) 0)))]
[else
(let ([warned? #f])
(lambda ()
(unless warned?
(set! warned? #t)
(#%printf "Warning: not recording actual errno value\n"))
0))]))]))
;; function is called with interrupts disabled ;; function is called with interrupts disabled
(define get-last-error (define get-last-error