Allow setting errno instead of just clearing it

diff --git a/basis/libc/libc.factor b/basis/libc/libc.factor
index fe56c83516eca532fedd5cc934ea64e24238fc3d..e935d49748fd3c533479ee0e5bbeabbf5dd59d46 100644 (file)
--- a/basis/libc/libc.factor
+++ b/basis/libc/libc.factor
@@ -9,8 +9,14 @@ IN: libc
 : errno ( -- int )
     int "factor" "err_no" { } alien-invoke ;
 
+: set-errno ( int -- )
+    void "factor" "set_err_no" { int } alien-invoke ;
+
 : clear-errno ( -- )
-    void "factor" "clear_err_no" { } alien-invoke ;
+    0 set-errno ;
+
+: preserve-errno ( quot -- )
+    errno [ call ] dip set-errno ; inline
 
 <PRIVATE
 

diff --git a/vm/io.cpp b/vm/io.cpp
index a3283b84acda4f478f6b5913778556258352ae38..880675b212be78798a7e497f590275cd8ea37b09 100755 (executable)
--- a/vm/io.cpp
+++ b/vm/io.cpp
@@ -245,8 +245,8 @@ VM_C_API int err_no()
        return errno;
 }
 
-VM_C_API void clear_err_no()
+VM_C_API void set_err_no(int err)
 {
-       errno = 0;
+       errno = err;
 }
 }

diff --git a/vm/io.hpp b/vm/io.hpp
index 41e9cec82dba096908b650a182a9b53a0def7335..c96c95863d312481045c9f1426c32a70c9c3b7b6 100755 (executable)
--- a/vm/io.hpp
+++ b/vm/io.hpp
@@ -8,6 +8,6 @@ int safe_fclose(FILE *stream);
 /* Platform specific primitives */
 
 VM_C_API int err_no();
-VM_C_API void clear_err_no();
+VM_C_API void set_err_no(int err);
 
 }