os module now compiles
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Fri, 16 Mar 2018 22:50:39 +0000 (23:50 +0100)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Fri, 16 Mar 2018 22:50:39 +0000 (23:50 +0100)
modules/language/python/for.scm
modules/language/python/module/errno.scm
modules/language/python/module/os.scm
modules/language/python/module/python.scm
modules/language/python/module/resource.scm
modules/language/python/module/stat.scm
modules/language/python/set.scm

index 4541df2a407cefabee011648bef17efb1b1124ce..fcd562bc65be5f515bc2f07784065a389b9b7da2 100644 (file)
 (define-syntax for
   (syntax-rules (:)
     ((for ((x ... : E) ...) ((c n) ...) code ... #:final fin)
-     (for-work #f ((x ... : E) ...) ((c n) ...) (code ...) fin))
+     (for-work #f ((x ... : E) ...) ((c n) ...) (code ...) fin values))
+
+    ((for ((x ... : E) ...) ((c n) ...) code ... #:else fin)
+     (for-work #f ((x ... : E) ...) ((c n) ...) (code ...) (values)
+               (lambda () fin)))
     
     ((for lp ((x ... : E) ...) ((c n) ...) code ... #:final fin)
-     (for-work lp ((x ... : E) ...) ((c n) ...) (code ...) fin))
+     (for-work lp ((x ... : E) ...) ((c n) ...) (code ...) fin values))
+
+    ((for lp ((x ... : E) ...) ((c n) ...) code ... #:else fin)
+     (for-work lp ((x ... : E) ...) ((c n) ...) (code ...) (values)
+               (lambda () fin)))
     
     ((for ((x ... : E) ...) ((c n) ...) code ...)
-     (for-work #f ((x ... : E) ...) ((c n) ...) (code ...) (values)))
+     (for-work #f ((x ... : E) ...) ((c n) ...) (code ...) (values) values))
     
     ((for lp ((x ... : E) ...) ((c n) ...) code ...)
-     (for-work lp ((x ... : E) ...) ((c n) ...) (code ...) (values)))))
+     (for-work lp ((x ... : E) ...) ((c n) ...) (code ...) (values) values))))
     
 (define-syntax for-work
-  (lambda (x)
+  (lambda (z)
     (define (wrap-continue lp code)
       (if (syntax->datum lp)
           #`(lambda () (let/ec #,lp #,@code))
           #`(lambda ()              #,@code)))
       
-    (syntax-case x ()
-      ((for lp ((x ... : E) ...) ((c n) ...) (code ...) fin)
+    (syntax-case z ()
+      ((for lp ((x ... : E) ...) ((c n) ...) (code ...) fin er)
        (with-syntax (((It ...)       (generate-temporaries #'(E ...)))
                      ((cc ...)       (generate-temporaries #'(c ...)))
                      (((x1 ...) ...) (generate-temporaries2 #'((x ...) ...)))
                      (((x2 ...) ...) (generate-temporaries2 #'((x ...) ...)))
                      ((N ...)        (map length #'((x ...) ...)))
+                     (else-          (datum->syntax #'for 'else-))
                      (llp            (if (syntax->datum #'lp) #'lp #'lpu)))
          
-         #`(let/ec lp-break
+         #`(let/ec lp-break0                                  
+             (let ((It    (wrap-in E)) ...
+                   (c     n          ) ...
+                   (x     'None      ) ... ...
+                   (x1    #f         ) ... ...)
+             (let* ((else-    er      )
+                    (lp-break (lambda q (else-) (apply lp-break0 q))))
              (syntax-parameterize ((break (lambda (z)
                                             (syntax-case z ()
                                               ((_ . l)
                                                #'(lp-break . l))
                                               (_ #'lp-break)))))
-                                  
-               (let ((It (wrap-in E)) ...
-                     (c  n          ) ...
-                     (x  'None      ) ... ...
-                     (x1 #f         ) ... ...)
+
                  (catch StopIteration
                    (lambda ()
                      (let llp ((cc c) ...)                                
@@ -81,7 +92,7 @@
                              #'lp
                              #'((let ((x x) ... ...) code ...)))
                          (lambda (cc ... . q) (llp cc ...)))))
-                   (lambda q fin))))))))))
+                   (lambda q (else-) fin)))))))))))
 
 (define-class <scm-list>   () l)
 (define-class <scm-string> () s i)
index 6bcc02a1e57bb4cfd84300add04f8ddfbd0bc5a6..1626175bfc90354ee9975328e9885e461c0f64d7 100644 (file)
@@ -1,7 +1,6 @@
 (define-module (language python module errno)
   #:use-module (system foreign)
-  #:use-module (language python dict)
-  #:use-module (language python list)                          
+  #:use-module (oop pf-objects)
   #:export (errno errorcode))
 
 
     (lambda ()
       (pointer-address (dereference-pointer f)))))
 
-(define errorcode (dict))
+(define errorcode (make-hash-table))
 
 (define-syntax-rule (mk x n)
   (begin
-    (define x n)
+    (if (defined? 'x)
+        (define! 'x x)
+        (define! 'x n))
     (export x)
-    (pylist-set! errorcode n "x")))
+    (pylist-set! errorcode n (symbol->string 'x))))
 
 (mk EPERM    1)
 (mk ENOENT   2)
index 29f7a5b79e64490402e2aa41723b3554025710f1..6639b1d9c1b5f87f8d7d183fe9fd301fa19ac993 100644 (file)
@@ -1,23 +1,31 @@
 (define-module (language python module os)
   #:use-module (ice-9 match)
   #:use-module (ice-9 ftw)
+  #:use-module (ice-9 control)
   #:use-module (system foreign)
   #:use-module (oop pf-objects)
   #:use-module (oop goops)
   #:use-module (rnrs bytevectors)
   #:use-module (language python for)
-  #:use-module ((language python module python) #:select (open))
+  #:use-module (language python persist)
   #:use-module (language python try)
   #:use-module (language python module stat)
   #:use-module (language python exceptions)
   #:use-module (language python yield)
+  #:use-module (language python range)
   #:use-module (language python string)
   #:use-module (language python bytes)
+  #:use-module (language python dict)
+  #:use-module (language python set)
+  #:use-module (language python def)
   #:use-module (language python module errno)
+  #:use-module (language python module resource)
+  #:use-module ((language python module python)
+                #:select ((open . builtin:open)))
   #:use-module (language python list)
   #:export (error name ctermid environ environb chdir fchdir getcwd
                   fsencode fdencode fspath PathLike getenv getenvb
-                  get_exec_path getgid getegid geteuid
+                  get_exec_path getgid getegid geteuid fdopen
                   getgroups getgrouplist getlogin getpgid getpgrp getpid
                   getppid PRIO_PROCESS PRIO_PRGRP PRIO_USER getpriority
                   getresgid getuid initgroups putenv setegid seteuid
         (raise error (errno) ((@ (guile) strerror) (errno)))
         (values))))
 
+(define-syntax-rule (defineu f x)
+  (define f
+    (catch #t
+      (lambda () x)
+      (lambda z
+        (let ((message (format #f "could not define ~a" 'f)))
+          (warn message)
+          (lambda z (error message)))))))
+
 (define-syntax guile
   (syntax-rules ()
     ((_ (x ...) code)        (guile (x ...) code code))
     ((_ (x ...) code1 code2)
-     (define code1 (lambda (x ...) (ca ((@ (guile) code2 x ...))))))
+     (define code1 (lambda (x ...) (ca ((@ (guile) code2) x ...)))))
     ((_ code) (guile code code))
     ((_ code1 code2)
-     (define code1 (lambda x (ca (apply (@ (guile) code2 x))))))))
+     (define code1 (lambda x (ca (apply (@ (guile) code2) x)))))))
 
 
 (define path   "posixpath")
 
       (define __setitem__
         (lambda (self k v) 
-          (putenv (slot-ref (pystring (+ k "=" v)) 'str))))
+          ((@ (guile) putenv) (slot-ref (pystring (+ k "=" v)) 'str))))
 
       (define __delitem__
         (lambda (self k)
-          (putenv (slot-ref (pystring k) 'str))))
+          ((@ (guile) putenv) (slot-ref (pystring k) 'str))))
       
       (define __iter__
         (lambda (self)
 
       (define __setitem__
         (lambda (self k v) 
-          (putenv (slot-ref (string (+ k "=" v)) 'str))))
+          ((@ (guile) putenv) (slot-ref (string (+ k "=" v)) 'str))))
 
       (define __delitem__
         (lambda (self k)
-          (putenv (slot-ref (string k) 'str))))
+          ((@ (guile) putenv) (slot-ref (string k) 'str))))
       
       (define __iter__
         (lambda (self)
 (define* (get_exec_path #:key (env #f))
   (define (f s)
     (let ((s (slot-ref (string s) 'str)))
-      (string-split str ":")))      
+      (string-split s ":")))      
   (if env
       (f (pylist-ref env     "PATH"))
       (f (pylist-ref environ "PATH"))))
 (guile getppid)
 
 (define PRIO_PROCESS (@ (guile) PRIO_PROCESS))
-(define PRIO_PRGRP   (@ (guile) PRIO_PRGRP))
+(define PRIO_PGRP    (@ (guile) PRIO_PGRP))
 (define PRIO_USER    (@ (guile) PRIO_USER))
 
 (guile getpriority)
 
-(define getresgid
+(define getresgid #f)
+(defineu getresgid
   (let* ((f  (pointer->procedure
               void
               (dynamic-func "getresgid" (dynamic-link))
 
 (guile getuid)
 
-(define initgroup
+(define initgroups #f)
+(defineu initgroups
   (let ((f (pointer->procedure
-            'int
+            int
             (dynamic-func "initgroups" (dynamic-link))
-            '(* int))))
+            (list '* int))))
          
     (lambda (user group)
-      (rm (string->pointer user) group))))
+      (rm (f (string->pointer user) group)))))
 
 (define (putenv key value)
   (pylist-set! environ key value))
 (guile setgid)
 
 (guile setgroups)
-(define setpgrp
-  (let ((f (pointer->procedure 'int
+(define setpgrp #f)
+(defineu setpgrp
+  (let ((f (pointer->procedure int
                                (dynamic-func "setpgrp" (dynamic-link))
                                '())))
     (lambda ()
 (guile setpgid)
 (guile setpriority)
 
+(define setregid #f)
 (define setregid
-  (let ((f (pointer->procedure 'int
+  (let ((f (pointer->procedure int
                                (dynamic-func "setregid" (dynamic-link))
-                               '(int int))))
+                               (list int int))))
     (lambda (a b)
       (rm (f a b)))))
 
+(define setresgid #f)
 (define setresgid
-  (let ((f (pointer->procedure 'int
+  (let ((f (pointer->procedure int
                                (dynamic-func "setresgid" (dynamic-link))
-                               '(int int int))))
+                               (list int int int))))
     (lambda (a b c)
       (rm (f a b c)))))
 
-(define setreuid
-  (let ((f (pointer->procedure 'int
+(define setreuid #f)
+(defineu setreuid
+  (let ((f (pointer->procedure int
                                (dynamic-func "setreuid" (dynamic-link))
-                               '(int int))))
+                               (list int int))))
     (lambda (a b)
       (rm (f a b)))))
 
-(define setresuid
-  (let ((f (pointer->procedure 'int
+(define setresuid #f)
+(defineu setresuid
+  (let ((f (pointer->procedure int
                                (dynamic-func "setresuid" (dynamic-link))
-                               '(int int int))))
+                               (list int int int))))
     (lambda (a b c)
       (rm (f a b c)))))
 
 (guile unsetenv)
 
 ;; File descriptor operations
-(define fdopen open)
 
 (define close
   (lambda (fd)
-    (ca (close-fd fd))))
+    (ca ((@ (guile) close-fdes) fd))))
 
 (define (closerange fd_low fd_high)
-  (for ((i : (range low high))) ()
-       (try:
+  (for ((i : (range fd_low fd_high))) ()
+       (try
         (lambda () (close i))
-        (#:except OSError => (lambda (x) (values))))))
+        (#:except OSError => (lambda x (values))))))
 
 (define device_encoding (lambda (fd) (error "not implemented")))
 
 (guile (fd) dup)
 
 (define dup2
-  (let ((f (pointer->procedure 'int
+  (let ((f (pointer->procedure int
                                (dynamic-func "dup3" (dynamic-link))
-                               '(int int int))))
+                               (list int int int))))
     (lambda* (fd fd2 #:optional (inheritable? #t))
       (if inheritable?
           (rm (f fd fd2 O_CLOEXEC))
       ((_ 1 (m mm) self scm)
        (with-syntax ((mem  (concat "st_" #'mm))
                      (smem (concat "stat:" #'m)))
-         #'(set self 'mem (smem scm)))))))
+         #'(set self 'mem (smem scm))))
       ((_ 1 m self scm)
-       (statset 1 (m m) self scm))))
+       #'(statset 1 (m m) self scm)))))
+
+(define stat-float-times #t)
 
 (define-python-class stat_result ()
   (define __init__
 
 (guile (fd) fsynch fsync)
 
-(guil (fd len) ftruncate truncate-file)
+(guile (fd len) ftruncate truncate-file)
 
 (guile (fd) isatty isatty?)
 
 (define F_TLOCK 2)
 (define F_ULOCK 0)
 (define F_TEST  3)
-(define lockf
-  (let ((f (pointer->procedure 'int
+
+(define lockf #f)
+(defineu lockf
+  (let ((f (pointer->procedure int
                                (dynamic-func "lockf" (dynamic-link))
-                               '(int int long))))
+                               (list int int long))))
     (lambda (fd op len)
       (rm (f fd op len)))))
 
 (define SEEK_DATA #x3)
 (define SEEK_HOLE #x4)
 
-(define lseek 
-  (let ((f (pointer->procedure 'int
+(define lseek  #f)
+(defineu lseek 
+  (let ((f (pointer->procedure int
                                (dynamic-func "lseek" (dynamic-link))
-                               '(int long int))))
+                               (list int long int))))
     (lambda (fd pos how)      
       (rm (f fd pos how)))))
 
 (define open
-  (let ((f (pointer->procedure 'int
+  (let ((f (pointer->procedure int
                                (dynamic-func "openat" (dynamic-link))
-                               '(int * int int))))
+                               (list int '* int int))))
 
     (lambda* (path flags mode #:optional (dir_fd None))
       (if (eq? dir_fd None)
 
 (define openpty (lambda x (error "not implemented")))
 
+(define fdopen builtin:open)
+
 (define pipe
-  (let ((x (ca (@ (guile) pipe))))
+  (let ((x (ca ((@ (guile) pipe)))))
     (values (car x) (cdr x))))
 
-(define pipe2
-  (let ((f (pointer->procedure 'int
+(define pipe2 #f)
+(defineu pipe2
+  (let ((f (pointer->procedure int
                                (dynamic-func "pipe2" (dynamic-link))
-                               '(int * int))))
+                               (list int '* int))))
     (lambda (flags)
-      (let* ((a  (make-bytevector 16))
+      (let* ((a  (make-bytevector 8))
              (ap (bytevector->pointer a)))
         (rm (f ap flags))
         (values (bytevector-s32-ref a 0 (native-endianness))
-                (bytevector-s32-ref a 1 (native-endianness)))))))
+                (bytevector-s32-ref a 4 (native-endianness)))))))
 
 
-(define posix_fallocate
-  (let ((f (pointer->procedure 'int
+(define posix_fallocate #f)
+(defineu posix_fallocate
+  (let ((f (pointer->procedure int
                                (dynamic-func "posix_fallocate" (dynamic-link))
-                               '(int long long))))
+                               (list int long long))))
     (lambda (fd off len)
       (rm (f fd off len)))))
 
-(define posix_fadvise
-   (let ((f (pointer->procedure 'int
+(define posix_fadvise #f)
+(defineu posix_fadvise
+   (let ((f (pointer->procedure int
                                (dynamic-func "posix_fadvise" (dynamic-link))
-                               '(int long long int))))
+                               (list int long long int))))
     (lambda (fd off len advice)
       (rm (f fd off len advice)))))
 
 (define POSIX_FADV_DONTNEED   4)
 (define POSIX_FADV_NOREUSE    5)
 
-(define pread
-  (let ((f (pointer->procedure 'int
+(define pread #f)
+(defineu pread
+  (let ((f (pointer->procedure int
                                (dynamic-func "pread" (dynamic-link))
-                               '(int * long long))))
+                               (list int '* long long))))
     (lambda (fd size offset)
       (let* ((a  (make-bytevector size))
              (ap (bytevector->pointer a)))
                 (slot-set! o 'bv   a)
                 o)))))))
 
-(define pwrite
-  (let ((f (pointer->procedure 'int
+(define pwrite #f)
+(defineu pwrite
+  (let ((f (pointer->procedure int
                                (dynamic-func "pwrite" (dynamic-link))
-                               '(int * long long))))
+                               (list int '* long long))))
   
     (lambda (fd a offset)
-      (let* ((ap (bytevector->pointer a)))
-        (rm (f fd ap size offset))))))
+      (let* ((ap (bytevector->pointer (slot-ref (bytes a) 'bytes))))
+        (rm (f fd ap (len a) offset))))))
 
-(define read
-  (let ((f (pointer->procedure 'int
+(define read #f)
+(defineu read
+  (let ((f (pointer->procedure int
                                (dynamic-func "read" (dynamic-link))
-                               '(int * long))))
+                               (list int '* long))))
     (lambda (fd size)
       (let* ((a  (make-bytevector size))
              (ap (bytevector->pointer a)))
                 (slot-set! o 'bv   a)
                 o)))))))
 
+
 (define (sendfile out in offset count)
   (ca
    (if (eq? count None)
-       ((@ (guile) sendfile out in count))
-       ((@ (guile) sendfile out in count offset)))))
+       ((@ (guile) sendfile) out in count)
+       ((@ (guile) sendfile) out in count offset))))
 
 (define F_GETFL 3)
-(define fcntl2 (pointer->procedure 'int
-                                   (dynamic-func "fcntl" (dynamic-link))
-                                   '(int int)))
-(define fcntl3 (pointer->procedure 'int
-                                   (dynamic-func "fcntl" (dynamic-link))
-                                   '(int int INT)))
+
+(define fcntl2 #f)
+(define fcntl3 #f)
+(defineu fcntl2 (pointer->procedure int
+                                    (dynamic-func "fcntl" (dynamic-link))
+                                   (list int int)))
+(defineu fcntl3 (pointer->procedure int
+                                    (dynamic-func "fcntl" (dynamic-link))
+                                    (list int int int)))
 
 (define (set_blocking fd is-blocking?)
   (let ((o (rm (fcntl2 fd F_GETFL))))
 (guile (fd pg) tcsetpgrp)
 (guile (fd)    ttyname)
 
-(define write
-  (let ((f (pointer->procedure 'int
+(define write #f)
+(defineu write
+  (let ((f (pointer->procedure int
                                (dynamic-func "write" (dynamic-link))
-                               '(int * long))))
+                               (list int '* long))))
   
     (lambda (fd a)
-      (let* ((ap (bytevector->pointer a)))
-        (rm (f fd ap size))))))
+      (let* ((ap (bytevector->pointer (slot-ref (bytes a) 'bytes)))) 
+        (rm (f fd ap (len a)))))))
 
 (define (writev fd buffers) (error "not implemented"))
     
 (define R_OK (@ (guile) R_OK))
 (define X_OK (@ (guile) X_OK))
 
-(define access
-  (let ((f  (pointer->procedure 'int
+(define access #f)
+(defineu access
+  (let ((f  (pointer->procedure int
                                (dynamic-func "access" (dynamic-link))
-                               '(* int)))
-        (fa (pointer->procedure 'int
+                               (list '* int)))
+        (fa (pointer->procedure int
                                 (dynamic-func "faccessat" (dynamic-link))
-                                '(* int int int))))
+                                (list '* int int int))))
 
     (lambda* (path mode #:key
                    (dir_fd None)
                           (if follow_symlinks 0 AT_SYMLINK_NOFOLLOW))))))))
 
 
-
-(define chdir
-  (let ((f (pointer->procedure 'int
-                               (dynamic-func "access" (dynamic-link))
+(define chdir #f)
+(defineu chdir
+  (let ((f (pointer->procedure int
+                               (dynamic-func "chdir" (dynamic-link))
                                '(*))))
     (lambda (pth)
       (let ((pth (aif it (ref pth '__fspath__)
                       (it)
                       pth)))
-        (if (int? pth)
+        (if (number? pth)
             (rm (f pth))
             (ca ((@ (guile) chdir) pth)))))))
 
 (define chflags
   (lambda x (error "Not implemented")))
 
-(define chmod
-  (let ((f   (pointer->procedure 'int
+(define chmod (lambda x #f))
+(defineu chmod
+  (let ((f   (pointer->procedure int
                                  (dynamic-func "chmod" (dynamic-link))
-                                 '(* int)))
-        (ff  (pointer->procedure 'int
+                                 (list '* int)))
+        (ff  (pointer->procedure int
                                  (dynamic-func "fchmod" (dynamic-link))
-                                 '(int int)))
-        (fat (pointer->procedure 'int
+                                 (list int int)))
+        (fat (pointer->procedure int
                                  (dynamic-func "fchmodat" (dynamic-link))
-                                 '(* int int int))))
+                                 (list '* int int int))))
   (lambda* (path mode #:key (dir_fd None) (follow_symlinks #t))
-    (if (int? path)
+    (if (number? path)
         (rm (ff path mode))
         (let ((path (aif it (ref path '__fspath__)
                          (it)
        (it)
        path))
 
-(define chown
-  (let ((f   (pointer->procedure 'int
+(define chown (lambda x #f))
+(defineu chown
+  (let ((f   (pointer->procedure int
                                  (dynamic-func "chown" (dynamic-link))
-                                 '(* int int)))
-        (ff  (pointer->procedure 'int
+                                 (list '* int int)))
+        (ff  (pointer->procedure int
                                  (dynamic-func "fchown" (dynamic-link))
-                                 '(int int int)))
-        (lf  (pointer->procedure 'int
-                                 (dynamic-func "lchow" (dynamic-link))
-                                 '(* int int)))
-        (fat (pointer->procedure 'int
+                                 (list int int int)))
+        (lf  (pointer->procedure int
+                                 (dynamic-func "lchown" (dynamic-link))
+                                 (list '* int int)))
+        (fat (pointer->procedure int
                                  (dynamic-func "fchownat" (dynamic-link))
-                                 '(* int int int int))))
+                                 (list '* int int int int))))
     (lambda* (path uid gid #:key (dir_fd None) (follow_symlinks #t))
-      (if (int? path)
+      (if (number? path)
           (rm (ff path uid gid))
           (let ((path (path-it path)))
             (if (eq? dir_fd None)
                              0
                              AT_SYMLINK_NOFOLLOW)))))))))
 
-(guile ((x)) chroot)
+(guile (x) chroot)
 
 (define fchdir chdir)
 
 (guile () getcwd)
 
 (define (getcwdb)
-  (byte (getcwd)))
+  (bytes (getcwd)))
 
 (define lchflags (lambda x (error "not implemented")))
 
 (define (lchown path uid gid)
   (chown path uid gid #:follow_symlinks #f))
 
-(define link
-  (let ((f (pointer->procedure 'int
-                                 (dynamic-func "linkat" (dynamic-link))
-                                 '(* * int int int))))
+(define AT_FDCWD -100)
+
+(define link #f)
+(defineu link
+  (let ((f (pointer->procedure int
+                               (dynamic-func "linkat" (dynamic-link))
+                                 (list '* '* int int int))))
     (lambda* (src dst #:key
                   (src_dir_fd None)
-                  (dst_dir_fd None),
+                  (dst_dir_fd None)
                   (follow_symlinks #t))
       (let ((src (path-it src))
             (dst (path-it dst))
         (dynamic-wind
           (lambda x #f)
           (lambda ()
-            (let lp ((o ) (l '()))
+            (let lp ((o o))
               (let ((w (ca (readdir o))))
                 (if (eof-object? w)
                     '()
-                    (cons w (lp o))))))
+                    (if (or (equal? w ".") (equal? w ".."))
+                        (lp o)
+                        (cons w (lp o)))))))
           (lambda x (closedir o)))))))
 
-(define stat
+(define stat (lambda x #f))
+(defineu stat
   (let ((f (pointer->procedure int
                                (dynamic-func "__fxstatat" (dynamic-link))
                                (list int int '* '* int)))
   (lambda* (path #:key (dir_fd None))
     (stat path #:dir_fd dir_fd #:follow_symlinks #f)))
 
-(define mkdir
+(define mkdir #f)
+(defineu mkdir
   (let ((fat (pointer->procedure int
                                  (dynamic-func "mkdirat" (dynamic-link))
-                                 (list int * int))))
+                                 (list int '* int))))
     (lambda* (path mode #:key (dir_fd None))
       (rm (fat (if (eq? dir_fd None) AT_FDCWD dir_fd)
                (string->pointer (path-it path))
              (mkdir s mode)))
          (lp s l))))))
 
-(define mkfifo
+(define mkfifo #f)
+(defineu mkfifo
   (let ((fat (pointer->procedure int
                                  (dynamic-func "mkfifoat" (dynamic-link))
-                                 (list int * int))))
+                                 (list int '* int))))
     (lambda* (path mode #:key (dir_fd None))
       (rm (fat (if (eq? dir_fd None) AT_FDCWD dir_fd)
                (string->pointer (path-it path))
                mode)))))
 
-(define mknod
+(define mknod #f)
+(defineu mknod
   (let ((fat (pointer->procedure int
-                                 (dynamic-func "mknodat" (dynamic-link))
-                                 (list int * int))))
+                                 (dynamic-func "__xmknodat" (dynamic-link))
+                                 (list int int '* int))))
     (lambda* (path mode #:optional (device 0) #:key (dir_fd None))
-      (rm (fat (if (eq? dir_fd None) AT_FDCWD dir_fd)
+      (rm (fat (if (eq? dir_fd None) AT_FDCWD dir_fd)
                (string->pointer (path-it path))
                mode
                device)))))
 
-(define major
+(define major #f)
+(defineu major
   (let ((f (pointer->procedure int
                                (dynamic-func "gnu_dev_major" (dynamic-link))
                                (list int64))))
     (lambda (device)
       (ca (f device)))))
 
-(define minor
+(define minor #f)
+(defineu minor
   (let ((f (pointer->procedure int
                                (dynamic-func "gnu_dev_minor" (dynamic-link))
                                (list int64))))
     (lambda (device)
       (ca (f device)))))
 
-(define makedev
+(define makedev #f)
+(defineu makedev
   (let ((f (pointer->procedure int64
                                (dynamic-func "gnu_dev_makedev" (dynamic-link))
                                (list int int))))
               (error "Bug could not find pathcond name endex")
               (rm e2))))))
 
-         
-(define pathconf
+
+(define pathconf #f)
+(defineu pathconf
   (let ((f (pointer->procedure long
                                (dynamic-func "pathconf" (dynamic-link))
                                (list '* int)))
             (let ((path (path-it path)))
               (rmp (f (string->pointer path) ni))))))))
 
-(define readlink
+(define readlink #f)
+(defineu readlink
   (let ((fat (pointer->procedure int
                                  (dynamic-func "readlinkat" (dynamic-link))
-                                 (list int * long))))
+                                 (list int '* '* long))))
     (lambda* (path #:key (dir_fd None))
       (let* ((n   10000)
              (bv  (make-bytevector 10000))
         (bytevector-u8-set! bv (- n 1) 0)
         (pointer->string bvp)))))
 
-
-(define remove
+(define remove #f)
+(defineu remove
   (let ((fat (pointer->procedure int
                                  (dynamic-func "unlinkat" (dynamic-link))
-                                 (list int * int))))
+                                 (list int '* int))))
     (lambda* (path #:key (dir_fd None))
       (rm (fat (if (eq? dir_fd None) AT_FDCWD dir_fd)
                (string->pointer (path-it path))
 (define unlink remove)
 
 (define rmdir
-  (lambda (path #:key (dir_fd None))
+  (lambda* (path #:key (dir_fd None))
     (let ((path (path-it path)))
       (if (eq? dir_fd None)
           ((@ (guile) rmdir) path)
               (lambda x (values)))
             (lp (cdr l)))))))
 
-(define rename
+(define rename #f)
+(defineu rename
   (let ((fat (pointer->procedure int
                                  (dynamic-func "renameat" (dynamic-link))
-                                 (list int * int *))))
+                                 (list int '* int '*))))
     (lambda* (src dst #:key (src_dir_fd None) (dst_dir_fd None))
       (rm (fat (if (eq? src_dir_fd None) AT_FDCWD src_dir_fd)
                (string->pointer (path-it src))
                (lp l (cons x d)))
              (lp l (cons x d))))))
     (rename old new)
-    (let ((l (split old #\/)))
+    (let ((l (string-split old #\/)))
       (if (> (length l) 1)
           (if (= (length l) 2)
-              (removedirs (string-concat (car l) "/"))
+              (removedirs (string-append (car l) "/"))
               (removedirs (string-join (reverse (cdr (reverse l))) "/")))))
     (values)))
 
   
   (define is_dir
     (lambda* (self #:key (follow_symlinks #t))
-      (let ((s (stat (ref self 'path) #:follow_symlink follow_symlink)))
+      (let ((s (stat (ref self 'path) #:follow_symlinks follow_symlinks)))
         ((@ (stat) is-dir?) (ref s '_st_mode)))))
   
   (define is_file
     (lambda* (self #:key (follow_symlinks #t))
-      (let ((s (stat (ref self 'path) #:follow_symlink follow_symlink)))
+      (let ((s (stat (ref self 'path) #:follow_symlinks follow_symlinks)))
         ((@ (stat) is-reg?) (ref s '_st_mode)))))
 
   (define is_symlink
        #f
        (path-it path)))))
 
-(define stat-float-times #t)
 (define (stat_float_times newvalue)
   (set! stat-float-times newvalue))
 
          f_namemax)
        (list a1 a2 a3 a4 a5 a6 a7 a8 a9 a10)))))
 
-(define statvfs
+(define statvfs #f)
+(defineu statvfs
   (let ((f (pointer->procedure int
                                (dynamic-func "statvfs" (dynamic-link))
-                               (list *)))
+                               (list '* '*)))
         (ff (pointer->procedure int
                                (dynamic-func "fstatvfs" (dynamic-link))
-                               (list int *)))))
+                               (list int '*))))
     (lambda (path)
-      (let* ((bv (make-bytevector 11*8))
+      (let* ((bv (make-bytevector (* 11 8)))
              (bvp (bytevector->pointer bv)))
         (rm (if (number? path)
                 (ff path bvp)
                 (f (string->pointer (path-it path)) bvp)))
             
         (StatVFS
-         (bytevector-u64-ref bv 0  (native-endianness))
-         (bytevector-u64-ref bv 1  (native-endianness))
-         (bytevector-u64-ref bv 2  (native-endianness))
-         (bytevector-u64-ref bv 3  (native-endianness))
-         (bytevector-u64-ref bv 4  (native-endianness))
-         (bytevector-u64-ref bv 5  (native-endianness))
-         (bytevector-u64-ref bv 6  (native-endianness))
-         (bytevector-u64-ref bv 8  (native-endianness))
-         (bytevector-u64-ref bv 9  (native-endianness))
-         (bytevector-u64-ref bv 10 (native-endianness)))))))
-
-(define symlink
+         (bytevector-u64-ref bv (* 0  8) (native-endianness))
+         (bytevector-u64-ref bv (* 1  8) (native-endianness))
+         (bytevector-u64-ref bv (* 2  8) (native-endianness))
+         (bytevector-u64-ref bv (* 3  8) (native-endianness))
+         (bytevector-u64-ref bv (* 4  8) (native-endianness))
+         (bytevector-u64-ref bv (* 5  8) (native-endianness))
+         (bytevector-u64-ref bv (* 6  8) (native-endianness))
+         (bytevector-u64-ref bv (* 7  8) (native-endianness))
+         (bytevector-u64-ref bv (* 9  8) (native-endianness))
+         (bytevector-u64-ref bv (* 10 8) (native-endianness)))))))
+
+(define symlink #f)
+(defineu symlink
   (let ((fat (pointer->procedure int
                                  (dynamic-func "symlinkat" (dynamic-link))
                                  (list '* int '*))))
                 (if (eq? dir_fd None) AT_FDCWD dir_fd)
                 (string->pointer (path-it src))))))))
 
-(define truncate
+(define truncate #f)
+(defineu truncate
   (let ((ff (pointer->procedure int
                                 (dynamic-func "ftruncate" (dynamic-link))
                                 (list int long)))
                  length))))))
 
 (define UTIME_NOW (- (ash 1 30) 1))
-(define utime
+
+(define utime #f)
+(defineu utime
   (let ((ff  (pointer->procedure int
-                                 (dynamic-func "futimens" (dynamic-link))
-                                 (int '*)))
+                                 (dynamic-func "futimes" (dynamic-link))
+                                 (list int '*)))
         (fat (pointer->procedure int
-                                 (dynamic-func "futimensat" (dynamic-link))
-                                 (int '* '* int)))
+                                 (dynamic-func "futimesat" (dynamic-link))
+                                 (list int '* '* int))))
 
     (lambda* (path #:optional (times None) (ns #f) #:key (dir_fd None)
                    (follow_symlinks #t))
       (let* ((bv  (make-bytevector 32))
-             (bvp (byteector->pointer bv)))
+             (bvp (bytevector->pointer bv)))
         (if (eq? ns None)
             (if (eq? times None)
                 (let ()
-                  (bytevector-s64-set! bv 0 0
+                  (bytevector-s64-set! bv 0  0
                                        (native-endianness))
-                  (bytevector-s64-set! bv 1 0 UTIME_NOW
+                  (bytevector-s64-set! bv  UTIME_NOW
                                        (native-endianness))
-                  (bytevector-s64-set! bv 2 0
+                  (bytevector-s64-set! bv 16 0
                                        (native-endianness))
-                  (bytevector-s64-set! bv 3 UTIME_NOW
+                  (bytevector-s64-set! bv 24 UTIME_NOW
                                        (native-endianness)))
                 (let ((x1 (pylist-ref ns 0))
                       (x2 (pylist-ref ns 1)))
-                  (bytevector-s64-set! bv 0 (floor-quotient x1 1000000000)
+                  (bytevector-s64-set! bv 0  (floor-quotient x1 1000000000)
                                        (native-endianness))
-                  (bytevector-s64-set! bv 1 (modulo  x1 1000000000)
+                  (bytevector-s64-set! bv  (modulo  x1 1000000000)
                                        (native-endianness))
-                  (bytevector-s64-set! bv 2 (floor-quotient x2 1000000000)
+                  (bytevector-s64-set! bv 16 (floor-quotient x2 1000000000)
                                        (native-endianness))
-                  (bytevector-s64-set! bv 3 (modulo  x2 1000000000)
+                  (bytevector-s64-set! bv 24 (modulo  x2 1000000000)
                                        (native-endianness))))
             (if (eq? times None)
                 (begin
                   (bytevector-s64-set! bv 0 (pylist-ref times 0)
                                        (native-endianness))
-                  (bytevector-s64-set! bv 1 0
+                  (bytevector-s64-set! bv 8 0
                                        (native-endianness))
-                  (bytevector-s64-set! bv 2 (pylist-ref times 1)
+                  (bytevector-s64-set! bv 16 (pylist-ref times 1)
                                        (native-endianness))
-                  (bytevector-s64-set! bv 3 0
+                  (bytevector-s64-set! bv 24 0
                                        (native-endianness)))
                 (raise error "utime cannot set both s and ns")))
         (rm (if (number? path)
                      (string->pointer (path-it path))
                      (if follow_symlinks
                          0
-                         AT_SYMLINK_NOFOLLOW)))))))))
+                         AT_SYMLINK_NOFOLLOW))))))))
 
 
-(define* (walk top #:key (topdown #t) (onerror None) (followlinks #f))
+(def (walk top (= topdown #t) (= onerror None) (= followlinks #f))
   ((make-generator ()
     (lambda (yield)
       (let/ec ret
         (try
          (lambda ()
            (set! entries (py-list (scandir top))))
-         (#except error =>
+         (#:except error =>
                   (lambda (x . _)
                     (if onerror (onerror x) (ret)))))
        
         (for ((entry : entries)) ()
              (define is_dir (try
-                             (lambda ((ref entry 'is_dir)))
+                             (lambda () (ref entry 'is_dir))
                              (#:except error => (lambda x #f))))
              (if is_dir
                  (pylist-append! dirs    (ref entry 'name))
                              (try
                               (lambda () ((ref entry 'is_symlink)))
                               (#:except error => (lambda x #f)))))))
-                   (if walk_into
+                   (if walk-into
                        (for ((a b c : (walk (ref entry 'path) topdown
                                             onerror followlinks))) ()
                            (yield a b c)))))
       (() (string-join (reverse r) "/")))))
 
 (define (path:join . l)
-  (normpath (string-join (map path-it l) "/")))
+  (path:normpath (string-join (map path-it l) "/")))
 
 (define (_fwalk topfd toppath topdown onerror follow_symlinks)
   ((make-generator ()
    (lambda (yield)
      (define names   (listdir topfd))
-     (define dir     (py-list))
+     (define dirs    (py-list))
      (define nondirs (py-list))
 
      (for ((name : names)) ()
       
      (if topdown
          (yield toppath dirs nondirs topfd))
-     
+
      (for continue ((name : dirs)) ()
           (call-with-values
               (lambda ()
                    (values (stat name #:dir_fd topfd
                                  #:follow_symlinks follow_symlinks))
                    (open name O_RDONLY #:dir_fd topfd))
-                 (#:except errpr =>
-                  (lambda (err . l)
+                 (#:except error =>
+                   (lambda (err . l)
                     (if (not (eq? onerror None))
                         (onerror err)
                         (continue))))))
                        (for ((a b c d :
                                 (_fwalk dirfd dirpath topdown onerror
                                         follow_symlinks))) ()
-                         (yield a b c d)))))
-               (#:finally
-                (close dirfd))))))
+                           (yield a b c d)))))
+               
+               #:finally
+               (close dirfd)))))
 
      (if not topdown
          (yield toppath dirs nondirs topfd))))))
 
-(define* (fwalk #:optinal (top ".") (topdown #t) (onerror #t)
-                #:key     (follow_symlinks #f) (dir_fd None))
+(def (fwalk (= top ".") (= topdown #t) (= onerror #t)
+            (= follow_symlinks #f) (= dir_fd None))
   ((make-generator ()
    (lambda (yield)
      (define orig_st (stat top #:follow_symlinks #f #:dir_fd dir_fd))
      (define topfd   (open top O_RDONLY #:dir_fd dir_fd))
 
      (try
-      (if (or follow_symlinks or (and (S_ISDIR (ref orig_st 'st_mode))
-                                      (path:samestat orig_st (stat topfd))))
-          (for ((a b c d : (_fwalk topfd top topdown onerror follow_symlinks)))
-               ()
-            (yield a b c d)))
-      (#:finally:
-       (close topfd)))))))
+      (lambda ()
+        (if (or follow_symlinks (and (S_ISDIR (ref orig_st 'st_mode))
+                                     (path:samestat orig_st (stat topfd))))
+            (for ((a b c d :
+                     (_fwalk topfd top topdown onerror follow_symlinks)))
+              ()
+              (yield a b c d))))
+      #:finally
+      (close topfd))))))
 
 ;; Extended attributes
-(define getxattr
+(define getxattr #f)
+(defineu getxattr
   (let ((f   (pointer->procedure int
                                 (dynamic-func "getxattr" (dynamic-link))
-                                ('* '* '* int)))
+                                (list '* '* '* int)))
         (lf  (pointer->procedure int
                                 (dynamic-func "lgetxattr" (dynamic-link))
-                                ('* '* '* int)))
+                                (list '* '* '* int)))
         (ff  (pointer->procedure int
                                 (dynamic-func "fgetxattr" (dynamic-link))
-                                ('* '* '* int))))
-    (lambda (path attribute #:key (follow_symlink #t))
+                                (list '* '* '* int))))
+    (lambda* (path attribute #:key (follow_symlink #t))
       (let ((path (ca (if (number? path)
                           path
                           (string->pointer (path-it path)))))
              (k   (ca (string->pointer attribute))))
          (let lp ((size 128))
-           (let ((v  (make-bytevector size))
-                 (pv (bytevector->pointer v)))
+           (let* ((v  (make-bytevector size))
+                  (pv (bytevector->pointer v)))
              (let ((n (rm (if (number? path)
                               (ff path k pv size)
                               (if follow_symlink
                    (lp (* 2 size))
                    (pointer->string pv)))))))))
 
-(define listxattr
+(define listxattr #f)
+(defineu listxattr
   (let ((f  (pointer->procedure int
                                 (dynamic-func "listxattr" (dynamic-link))
-                                ('* '* int)))
+                                (list '* '* int)))
         (lf (pointer->procedure int
                                 (dynamic-func "llistxattr" (dynamic-link))
-                                ('* '* int)))
+                                (list '* '* int)))
         (ff (pointer->procedure int
                                 (dynamic-func "flistxattr" (dynamic-link))
-                                ('* '* int))))
+                                (list '* '* int))))
     (define (mk l)
       (define v  (make-bytevector (+ (length l) 1)))
-      (define vp (bytevector->pointer))
+      (define vp (bytevector->pointer v))
       (let lp ((i 0) (l l))
         (if (pair? l)
             (begin
               (bytevector-u8-set! v i 0)
               (pointer->string vp)))))
     
-    (lambda (path attribute #:key (follow_symlink #t))
+    (lambda* (path attribute #:key (follow_symlink #t))
       (let ((path (if (number? path) path (string->pointer (path-it path)))))
         (let lp ((size 128))
-          (let ((v  (make-bytevector size))
-                (pv (bytevector->pointer v)))
+          (let* ((v  (make-bytevector size))
+                 (pv (bytevector->pointer v)))
             (let ((n (rm (if (number? path)
                              (ff path pv size)
                              (if follow_symlink
                                     (lp2 (+ j 1) (cons x r))))
                               (if (null? r)
                                   (lp j l)
-                                  (lp j (cons (mk (reverse r) l))))))
-                        (pylist (reverse l)))))))))))))
+                                  (lp j (cons (mk (reverse r)) l)))))
+                        (pylist (reverse l))))))))))))
 
-(define removexattr
+(define removexattr #f)
+(defineu removexattr
   (let ((f  (pointer->procedure int
                                 (dynamic-func "removexattr" (dynamic-link))
-                                ('* '*)))
+                                (list '* '*)))
         (lf (pointer->procedure int
                                 (dynamic-func "lremovexattr" (dynamic-link))
-                                ('* '*)))
+                                (list '* '*)))
         (ff (pointer->procedure int
                                 (dynamic-func "fremovexattr" (dynamic-link))
-                                (int '*))))
-    (lambda (path attribute #:key (follow_symlink #t))
+                                (list int '*))))
+    (lambda* (path attribute #:key (follow_symlink #t))
       (let ((path (if (number? path)
                       path
                       (string->pointer (path-it path))))
                     (f  path k)
                     (lf path k))))))))
 
-(define setxattr
+(define setxattr #f)
+(defineu setxattr
   (let ((f  (pointer->procedure int
                                 (dynamic-func "setxattr" (dynamic-link))
-                                ('* '* '* int int)))
+                                (list '* '* '* int int)))
         (lf (pointer->procedure int
                                 (dynamic-func "lsetxattr" (dynamic-link))
-                                ('* '* '* int int)))
+                                (list '* '* '* int int)))
         (ff (pointer->procedure int
                                 (dynamic-func "fsetxattr" (dynamic-link))
-                                (int '* '* int int))))
-    (lambda (path attribute value flags #:key (follow_symlink #t))
-      (let ((path (if (number? path) path (string->pointer (path-it path))))
-            (val  (ca (string->pointer value)))
-            (s    (string-length val))
-            (k    (ca (string->pointer attribute))))
+                                (list int '* '* int int))))
+    (lambda* (path attribute value flags #:key (follow_symlink #t))
+      (let* ((path (if (number? path) path (string->pointer (path-it path))))
+             (val  (ca (string->pointer value)))
+             (s    (string-length val))
+             (k    (ca (string->pointer attribute))))
         (rm (if (number? path)
                 (ff path k val s flags)
                 (if follow_symlink
 ;; Processes
 (define (abort) ((@ (guile) raise) (@ (guile) SIGABRT)))
 
+(define (exists p)
+  (if (number? p)
+      (catch #t
+        (lambda () ((@ (guile) readlink) (format #f "/proc/self/fd/~a" p)))
+        (lambda x #f))
+      (catch #t
+        (lambda () ((@ (guile) stat) (path-it p)) #t)
+        (lambda x #f))))
+
 (define (comp e pth)
   (if (eq? (string-ref pth 0) #\/)
       pth
-      (let ((r (pylist-get e "PATH")))
+      (let ((r (py-get e "PATH")))
         (if r
             (let lp ((l (string-split r #\:)))
               (match l
                 ((pp . l)
-                 (let ((newpath (join pp p)))
+                 (let ((newpath (string-join (cons pp pth) "/")))
                    (if (exists newpath)
                        newpath
                        (lp l))))
 (define (execlpe path . args)      
   (let* ((a (reverse args))
          (e (compe (car args)))
-         (l (cons e (reverse (cdr args))))))
-  (apply (@ (guile) execle) (comp e (path-it path)) l)
+         (l (cons e (reverse (cdr args)))))
+  (apply (@ (guile) execle) (comp e (path-it path)) l)))
 
 (define (execlp path . args) (apply (@ (guile) execlp) (path-it path) args))
 
 (define (nice i) (ca ((@ (guile) nice) i)))
 
 (define killpg
-  (let ((f))
+  (let ((f (pointer->procedure int
+                                (dynamic-func "killpg" (dynamic-link))
+                                (list int int))))
     (lambda (pgid sig)
       (rm (f pgid sig)))))
 
 (define (plock . l) (error "not implemented"))
 
-(define DEFAULT_BUFFER_SIZE 4096)
+(define DEFAULT_BUFFER_SIZE (@@ (language python module python)
+                                DEFAULT_BUFFER_SIZE))
+
 (define* (popen com #:optional (mode "r") (buffering -1))
-  (let ((port (ca (open-pipe com (case mode
-                                   (("r")       OPEN_READ)
-                                   (("w")       OPEN_WRITE)
-                                   (("rw" "wr") OPEN_BOTH))))))
+  (let ((port (ca ((@ (ice-9 popen) open-pipe) com
+                   (cond 
+                     ((equal? mode "r")       OPEN_READ)
+                     ((equal? mode "w")       OPEN_WRITE)
+                     ((or (equal? mode "rw")
+                          (equal? mode "r+")
+                          (equal? mode "w+")
+                          (equal? mode "wr"))
+                      OPEN_BOTH))))))
     (ca
      (case buffering
        ((-1)
   (ca (Times ((@ (guile) times)))))
 
 (define (wait)
-  (let ((x (wait-pid -1)))
+  (let ((x ((@ (guile) waitpid) -1)))
     (list (car x) (cdr x))))
 
 (define-python-class SigInfo ()
               (ref self 'si_uid)
               (ref self 'si_status)))))
       
-
-(define waitid
+(define waitid #f)
+(defineu waitid
   (let ((f (pointer->procedure int
                                 (dynamic-func "waitid" (dynamic-link))
-                                (int int '* int))))
+                                (list int int '* int))))
     (lambda (idtype id options)
       (let* ((b         (make-bytevector 228))
              (vp        (bytevector->pointer b))
-             (ref       (lambda (i) (bytebector-s32-ref
-                                     b i (native-endianess))))
+             (ref       (lambda (i) (bytevector-s32-ref
+                                     b i (native-endianness))))
              (si_status (lambda () (ref 6)))
              (si_code   (lambda () (ref 2)))
              (si_pid    (lambda () (ref 4)))
 (define (waitpid pid options)
   (ca ((@ (guile) waitpid) pid options)))
 
-(define wait3
+(define wait3 #f)
+(defineu wait3
   (let ((f (pointer->procedure int
                                 (dynamic-func "wait3" (dynamic-link))
-                                ('* int '*))))
+                                (list '* int '*))))
     (lambda (option)
       (let* ((v  (make-bytevector 250))
              (vp (bytevector->pointer v))
-             (w  (mkae-bytevector 8))
+             (w  (make-bytevector 8))
              (wp (bytevector->pointer w)))
 
         (let ((pid (rm (f wp option vp))))
           (list pid
-                (bytevector-s32-ref w 0 (native-endianess))
+                (bytevector-s32-ref w 0 (native-endianness))
                 (ResUsage v)))))))
 
-(define wait4
+(define wait4 #f)
+(defineu wait4
   (let ((f (pointer->procedure int
                                (dynamic-func "wait4" (dynamic-link))
-                               (int '* int '*))))
+                               (list int '* int '*))))
     (lambda (pid option)
       (let* ((v  (make-bytevector 250))
              (vp (bytevector->pointer v))
-             (w  (mkae-bytevector 8))
+             (w  (make-bytevector 8))
              (wp (bytevector->pointer w)))
 
         (let ((pid2 (rm (f pid wp option vp))))
           (list pid
-                (bytevector-s32-ref w 0 (native-endianess))
+                (bytevector-s32-ref w 0 (native-endianness))
                 (ResUsage v)))))))
 
 (define __WCOREFLAG   #x80)
 (define __W_CONTINUED #xffff)
-(define (__WTERMSIG s) 
+
 (define (WCOREDUMP    status) (> (logand status __WCOREFLAG) 0))
 (define (WIFCONTINUED status) (=      status __W_CONTINUED))
 (define (WIFSTOPPED   status) (= (logand status #xff) #x7f))
-(define (WIFSIGNALED  status) (> (ash (+ (logand status 0x7f) 1) -1) 0))
+(define (WIFSIGNALED  status) (> (ash (+ (logand status #x7f) 1) -1) 0))
                                 
 (define (WIFEXITED    status) (= (WTERMSIG status) 0))
 (define (WEXITSTATUS  status) (ash (logand status #xff00) 8))
 (define (WSTOPSIG     status) (WEXITSTATUS status))
 (define (WTERMSIG     status) (logand status #x7f))
 
-(define supprts_dir_fs
-  (set '()))
-
-(define support_effective_ids
-  (set '()))
-
-(define supports_fd
-  (set '()))
-
-
-
 ;; Scheduling
 
 (define SCHED_OTHER 0)
     (lambda (self v)
       (if (bytevector? v)
           (set self 'sched_priority
-               (bytevector-s32-ref v 0 (native-endianess)))
+               (bytevector-s32-ref v 0 (native-endianness)))
           (set self 'sched_priority v)))))
 
-(define sched_get_priority_min
+(define sched_get_priority_min #f)
+(defineu sched_get_priority_min
   (let ((f (pointer->procedure int
                                (dynamic-func "sched_get_priority_min"
                                              (dynamic-link))
                                (list int))))
     (lambda (policy) (rm (f policy)))))
 
-(define sched_get_priority_max
+(define sched_get_priority_max #f)
+(defineu sched_get_priority_max
   (let ((f (pointer->procedure int
                                (dynamic-func "sched_get_priority_max"
                                              (dynamic-link))
                                (list int))))
     (lambda (policy) (rm (f policy)))))
 
-(define sched_setscheduler
+(define sched_setscheduler #f)
+(defineu sched_setscheduler
   (let ((f (pointer->procedure int
                                (dynamic-func "sched_setscheduler"
                                              (dynamic-link))
       (let* ((v  (make-bytevector 32))
              (vp (bytevector->pointer v)))
         (bytevector-s32-set! v 0 (ref param 'sched_priority)
-                             (native-endianess))
+                             (native-endianness))
         (rm (f pid policy vp))))))
 
-(define sched_getscheduler
+(define sched_getscheduler #f)
+(defineu sched_getscheduler
   (let ((f (pointer->procedure int
                                (dynamic-func "sched_getscheduler"
                                              (dynamic-link))
     (lambda (pid)
       (ca (f pid)))))
 
-(define sched_setparam
+(define sched_setparam #f)
+(defineu sched_setparam
   (let ((f (pointer->procedure int
                                (dynamic-func "sched_setparam"
                                              (dynamic-link))
       (let* ((v  (make-bytevector 32))
              (vp (bytevector->pointer v)))
         (bytevector-s32-set! v 0 (ref param 'sched_priority)
-                             (native-endianess))
+                             (native-endianness))
         (rm (f pid vp))))))
 
-(define sched_getparam
+(define sched_getparam #f)
+(defineu sched_getparam
   (let ((f (pointer->procedure int
                                (dynamic-func "sched_getparam"
                                              (dynamic-link))
 (define sched_rr_get_intervall
   (lambda x (error "not implemented")))
 
-(define sched_yield
+(define sched_yield #f)
+(defineu sched_yield
   (let ((f (pointer->procedure int
                                (dynamic-func "sched_yield"
                                              (dynamic-link))
                                (list))))
     (lambda () (rm (f)))))
 
-(define sched_setaffinity
+(define sched_setaffinity#f)
+(defineu sched_setaffinity
   (let ((f (pointer->procedure int
                                (dynamic-func "sched_setaffinity"
                                              (dynamic-link))
                                (list int int '*)))
         (n (/ 1024 64)))
     (lambda (pid mask)
-      (let* ((v  (make-bytecvector (/ 1024 64)))
+      (let* ((v  (make-bytevector (/ 1024 64)))
              (vp (bytevector->pointer v)))
         
-        (for ((m : mask)) ()
-             (bytevector-u64-set! v i m (native-endianess)))
+        (for ((m : mask)) ((i (range 1000)))
+             (bytevector-u64-set! v i (* m 8) (native-endianness)))
 
         (rm (f pid (/ n 8) vp))))))
 
-(define sched_getaffinity
+(define sched_getaffinity #f)
+(defineu sched_getaffinity
   (let ((f (pointer->procedure int
                                (dynamic-func "sched_getaffinity"
                                              (dynamic-link))
                                (list int int '*)))
         (n (/ 1024 64)))
     (lambda (pid)
-      (let* ((v  (make-bytecvector (/ 1024 64)))
+      (let* ((v  (make-bytevector (/ 1024 64)))
              (vp (bytevector->pointer v)))
         
         (rm (f pid (/ n 8) vp))
         (let lp ((i 0))
           (if (< i n)              
-              (cons (bytevector-u64-ref v i (native-endianess))
+              (cons (bytevector-u64-ref v (* i 8) (native-endianness))
                     (lp (+ i 1)))
               '()))))))
               
 
 ;; MISC SYSTEM INFORMATION
+
+(define supprts_dir_fs
+  (py-set '()))
+
+(define support_effective_ids
+  (py-set '()))
+
+(define supports_fd
+  (py-set '()))
index 8264feec768fb1a3f9370c99c768af09318c83f5..093d03e27d3f13ada8f0de322ea281ff331a7a18 100644 (file)
   #:export (print repr complex float int str
                   set all any bin callable reversed
                   chr classmethod staticmethod
-                  divmod enumerate filter 
+                  divmod enumerate filter open
                   getattr hasattr hex isinstance issubclass
                   iter map sum id input oct ord pow super
                   sorted zip))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
+(define (path-it path)
+  (aif it (ref path '__fspath__)
+       (it)
+       path))
+
 (define print
   (case-lambda
     (()  ((@ (guile) format) #t "~%"))
                 (begin
                   (yield (reverse r))
                   (lp))))))))))
-  
+
+(define DEFAULT_BUFFER_SIZE 4096)
+(def (open path
+           (= mode      "r")
+           (= buffering -1 )
+           (= encoding   None)
+           (= errors     None)
+           (= newline    None)
+           (= closefd    #t)
+           (= opener     None))
+     
+     (define modelist (string->list mode))
+     (define path     (path-it path))
+     (define (clean ch l)
+       (filter (lambda (c) (not (eq? ch c))) l))
+     (let ((port (if (number? path)
+                     (begin
+                       (if (member #\a modelist)
+                           (seek path 0 SEEK_END))
+                       (if (member #\x modelist)
+                           (error "cannot use mode 'x' for fd input"))
+                       (cond
+                        ((member #\r modelist)
+                         (fdes->inport path))
+                        ((member #\w modelist)
+                         (fdes->outport path))))
+                     (begin
+                       (if (member #\x modelist)
+                           (if (file-exists? path)
+                               (raise OSError "mode='x' and file exists")
+                               (set mode (list->string
+                                          (clean #\x modelist)))))                                                            
+                       ((@ (guile) open-file) (path-it path) mode)))))
+
+       (case buffering
+         ((-1)
+          (setvbuf port 'block DEFAULT_BUFFER_SIZE))
+         ((0)
+          (setvbuf port 'none))
+         ((1)
+          (setvbuf port 'line))
+         (else
+          (setvbuf port 'block buffering)))
+
+       port))
+
+                        
+         
+     
+           
+     
 
   
index 200127e5edbf2aafc5a0be4503e7efe86ac92333..672c1e9d304fcc4d52286ee1dd62a83c549f36df 100644 (file)
@@ -1,10 +1,11 @@
 (define-module (language python module resource)
   #:use-module (system foreign)
   #:use-module (rnrs bytevectors)
+  #:use-module (oop pf-objects)
   #:use-module (language python exceptions)
+  #:use-module (language python list)
   #:use-module (language python module errno)
   #:use-module (language python try)
-  #:use-module (language python list)
   #:export (RLIM_INFINITY RLIMIT_CORE RLIMIT_CPU RLIMIT_FSIZE RLIMIT_DATA
                           RLIMIT_STACK RLIMIT_RSS RLIMIT_NPROC RLIMIT_NOFILE
                           RLIMIT_MEMLOCK RLIMIT_AS RLIMIT_LOCKS
             (raise OSError (pylist-ref errorcode e) ((@ (guile) strerror) e)))))
         (values))))
 
+(define-syntax-rule (defineu f x)
+  (define f
+    (catch #t
+      (lambda () x)
+      (lambda z
+        (let ((message (format #f "could not define ~a" 'f)))
+          (warn message)
+          (lambda z (error message)))))))
+
 (define RLIM_INFINITY #xffffffffffffffff)
 
 (define RLIMIT_CORE        4)
 (define RLIMIT_RTTIME     15)
 (define RLIMIT_SIGPENDING 11)
 
-(define getrlimit
+(define getrlimit #f)
+(defineu getrlimit
   (let ((f (pointer->procedure int
                                (dynamic-func "getrlimit" (dynamic-link))
-                               (int '*))))
+                               (list int '*))))
     (lambda (resource)
       (let* ((v  (make-bytevector 16))
              (vp (bytevector->pointer v)))
-        (rm (f res vp) (EINVAL (raise ValueError "wrong resource")))
-        (list (bytevector-u64-ref v 0 (native-endianess))
-              (bytevector-u64-ref v 1 (native-endianess)))))))
+        (rm (f resource vp) (EINVAL (raise ValueError "wrong resource")))
+        (list (bytevector-u64-ref v 0 (native-endianness))
+              (bytevector-u64-ref v 8 (native-endianness)))))))
 
-(define setrlimit
+
+(define setrlimit #f)
+(defineu setrlimit
   (let ((f (pointer->procedure int
                                (dynamic-func "setrlimit" (dynamic-link))
-                               (int '*))))
+                               (list int '*))))
     (lambda (resource limits)
       (let* ((v  (make-bytevector 16))
              (vp (bytevector->pointer v)))
-        (bytevector-u64-set! v 0 (pylist-ref limits 0) (native-endianess))
-        (bytevector-u64-set! v 1 (pylist-ref limits 1) (native-endianess))
+        (bytevector-u64-set! v 0 (pylist-ref limits 0) (native-endianness))
+        (bytevector-u64-set! v 8 (pylist-ref limits 1) (native-endianness))
+
         (rm (f resource vp)
             (EINVAL (raise ValueError "wrong resource"))
             (EPERM  (raise ValueError "wrong permission")))
         (values)))))
 
-(define prlimit
+(define prlimit #f)
+(defineu prlimit
   (let ((f (pointer->procedure int
                                (dynamic-func "prlimit" (dynamic-link))
-                               (int int '* '*))))
+                               (list int int '* '*))))
     (lambda* (pid resource #:optional (limits None))
-      (let ((vnew  (make-bytevector 16))
-            (vold  (make-bytevector 16))
-            (vpnew (bytevector->pointer vnew))
-            (vpold (bytevector->pointer vold)))
+      (let* ((vnew  (make-bytevector 16))
+             (vold  (make-bytevector 16))
+             (vpnew (bytevector->pointer vnew))
+             (vpold (bytevector->pointer vold)))
         (if (not (equal? limits None))
             (begin
               (bytevector-u64-set! vnew 0 (pylist-ref limits 0)
-                                   (native-endianess))
-              (bytevector-u64-set! vnew 1 (pylist-ref limits 1)
-                                   (native-endianess))))
+                                   (native-endianness))
+              (bytevector-u64-set! vnew 8 (pylist-ref limits 1)
+                                   (native-endianness))))
         (rm (f pid resource
                (if (eq? limits None)
-                   (adress-pointer 0)
+                   (make-pointer 0)
                    vpnew)
                vpold)
             (EINVAL (raise ValueError "wrong resource"))
             (ESRCH  (raise ProcessLookupError "prlimit"))
             (EPERM  (raise PermissionError "prlimit")))
         
-        (list (bytevector-u64-ref vold 0 (native-endianess))
-              (bytevector-u64-ref vold 1 (native-endianess)))))))
+        (list (bytevector-u64-ref vold 0 (native-endianness))
+              (bytevector-u64-ref vold 8 (native-endianness)))))))
+
 
-        
 (define RUSAGE_SELF       0)
 (define RUSAGE_CHILDREN  -1)
 (define RUSAGE_BOTH      -2)
     (lambda (self v)
       (define i 0)
       (define-syntax-rule (gettime k)
-        (let ((x1 (bytevector-u64-ref v i (native-endianess)))
-              (x2 (bytevector-u64-ref v (+ i 1) (native-endianess))))
-          (set! i (+ i 2))
+        (let ((x1 (bytevector-u64-ref v i (native-endianness)))
+              (x2 (bytevector-u64-ref v (+ i 8) (native-endianness))))
+          (set! i (+ i (* 8 2)))
           (set self k (+ (* x1 1.0) (/ (* x2 1.0) 1000000)))))
       (define-syntax-rule (s k)
         (begin
-          (set self k (bytevector-u64-ref v i (native-endianess)))
-          (set! i (+ i 1))))
+          (set self k (bytevector-u64-ref v i (native-endianness)))
+          (set! i (+ i 8))))
       (gettime 'ru_utime)
       (gettime 'ru_stime)
       (s 'ru_maxrss)
       (s 'ru_nvcsw)
       (s 'ru_nivcsw))))
 
-(define getrusage
+(define getrusage #f)
+(defineu getrusage
   (let ((f (pointer->procedure int
                                (dynamic-func "getrusage" (dynamic-link))
-                               (int '*))))
+                               (list int '*))))
     (lambda (who)
       (let* ((v  (make-bytevector 160))
-             (vp (bytevector->pointer)))
+             (vp (bytevector->pointer v)))
         
         (rm (f who vp)
             (EINVAL (raise ValueError "wrong who in getrusage")))
 
         (ResUsage v)))))
 
-(define getpagesize
+(define getpagesize #f)
+(defineu getpagesize
   (let ((f (pointer->procedure int
                                (dynamic-func "getpagesize" (dynamic-link))
-                               ())))
+                               '())))
     (lambda ()
       (rm (f)))))
 
+
index a430562608844ee16868a104e682d5712109623f..9723f437c55fcd908504a8d96e70e38fb96b7747 100644 (file)
@@ -1,4 +1,7 @@
 (define-module (language python module stat)
+  #:use-module (language python list)
+  #:use-module (language python string)
+  #:use-module (language python for)
   #:export (ST_MODE ST_INO ST_DEV ST_NLINK ST_UID ST_GID ST_SIZE ST_ATIME
                     ST_MTIME ST_CTIME S_ISUID S_ISGID S_ENFMT S_ISVTX S_IREAD
                     S_IWRITE S_IEXEC S_IRWXU S_IRUSR S_IWUSR S_IXUSR S_IRGRP
@@ -96,8 +99,8 @@
      (,S_ISGID         "S")
      (,S_IXGRP         "x"))
 
-    ((,S_IROTH         "r"),)
-    ((,S_IWOTH         "w"),)
+    ((,S_IROTH         "r"))
+    ((,S_IWOTH         "w"))
     ((,(logior S_IXOTH S_ISVTX) "t")
      (,S_ISVTX         "T")
      (,S_IXOTH         "x"))))
   (for ((table : _filemode_table)) ()
        (for ((bit char : table)) ()
             (if (= (logand mode  bit) bit)
-                (pylist-append! perm char)
-                (break))
+                (begin
+                  (pylist-append! perm char)
+                  (break)))
             #:final
             (pylist-append! perm "-")))
+  (pk perm)
+  (py-join "" perm))
 
-  (py-string-join "" perm))
index 25b02d71a9afca98d197693a08b13d0ec7c80c3b..6931956ce79f183ca21ee0a0bd22d6475555b881 100644 (file)
       ((self x)
        (let ((d (make-py-hashtable)))
          (slot-set! self 'dict d)
-        (for ((y : x)) ()
-             (pylist-set! d y #t))))))
+         (if (eq? x '())
+             (values)
+             (for ((y : x)) ()
+                  (pylist-set! d y #t)))))))
 
   (define pop
     (lambda (self)