diff options
Diffstat (limited to 'modules/language')
-rw-r--r-- | modules/language/python/exceptions.scm | 28 | ||||
-rw-r--r-- | modules/language/python/module/os.scm | 281 | ||||
-rw-r--r-- | modules/language/python/module/resource.scm | 163 |
3 files changed, 458 insertions, 14 deletions
diff --git a/modules/language/python/exceptions.scm b/modules/language/python/exceptions.scm index 2922f3f..9c75658 100644 --- a/modules/language/python/exceptions.scm +++ b/modules/language/python/exceptions.scm @@ -5,23 +5,25 @@ Exception ValueError TypeError IndexError KeyError AttributeError SyntaxError SystemException - OSError + OSError ProcessLookupError PermissionError None)) (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) -(define StopIteration 'StopIteration) -(define GeneratorExit 'GeneratorExit) -(define SystemException 'SystemException) -(define RuntimeError 'RuntimeError) -(define IndexError 'IndexError) -(define ValueError 'ValueError) -(define None 'None) -(define KeyError 'KeyError) -(define TypeError 'TypeError) -(define AttributeError 'AttributeError) -(define SyntaxError 'SyntaxError) -(define OSError 'OSError) +(define StopIteration 'StopIteration) +(define GeneratorExit 'GeneratorExit) +(define SystemException 'SystemException) +(define RuntimeError 'RuntimeError) +(define IndexError 'IndexError) +(define ValueError 'ValueError) +(define None 'None) +(define KeyError 'KeyError) +(define TypeError 'TypeError) +(define AttributeError 'AttributeError) +(define SyntaxError 'SyntaxError) +(define OSError 'OSError) +(define ProcessLookupError 'ProcessLookupError) +(define PermissionError 'PermissionError) (define-python-class Exception () (define __init__ diff --git a/modules/language/python/module/os.scm b/modules/language/python/module/os.scm index f4e1caf..29f7a5b 100644 --- a/modules/language/python/module/os.scm +++ b/modules/language/python/module/os.scm @@ -13,6 +13,7 @@ #:use-module (language python yield) #:use-module (language python string) #:use-module (language python bytes) + #:use-module (language python module errno) #:use-module (language python list) #:export (error name ctermid environ environb chdir fchdir getcwd fsencode fdencode fspath PathLike getenv getenvb @@ -59,6 +60,21 @@ P_WAIT P_NOWAIT P_NOWAIT0 + P_PID P_PGID P_ALL + WEXITED WUNTRACED WSTOPPED WNOWAIT WCONTINUED WNOHANG + CLD_EXITED CLD_KILLED CLD_DUMPED CLD_STOPED CLD_TRAPPED + CLD_CONTINUED + + startfile system times wait waitid waitpid wait3 wait4 + + WCOREDUMP WIFCONTINUED WIFSTOPPED WIFSIGNALED WIFEXITED + WEXITSTATUS WSTOPSIG WTERMSIG + + sched_get_priority_min sched_get_priority_max + sched_setscheduler sched_getscheduler sched_setparam + sched_getparam sched_rr_get_intervall sched_yield + sched_setaffinity sched_getaffinity + )) (define error OSError) @@ -1559,7 +1575,24 @@ (define (plock . l) (error "not implemented")) -(define popen) +(define DEFAULT_BUFFER_SIZE 4096) +(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)))))) + (ca + (case buffering + ((-1) + (setvbuf port 'block DEFAULT_BUFFER_SIZE)) + ((0) + (setvbuf port 'none)) + ((1) + (setvbuf port 'line)) + (else + (setvbuf port 'block buffering)))) + + port)) (define P_WAIT 0) (define P_NOWAIT 1) @@ -1587,6 +1620,134 @@ (mk-spawn spawnvp execvp) (mk-spawn spawnvpe execvpe) +(define startfile + (lambda x (error "not implemented"))) + +(define (system command) (ca ((@ (guile) system) command))) + +(define-python-class Times () + (define __init__ + (lambda (self v) + (set self 'user (tms:utime v)) + (set self 'system (tms:stime v)) + (set self 'children_user (tms:cutime v)) + (set self 'children_system (tms:cstime v)) + (set self 'elapsed (tms:clock v)))) + (define __repr__ + (lambda (self) + (format #f "Time(user:~a system:~a ...)" + (ref self 'user) + (ref self 'system))))) + +(define (times) + (ca (Times ((@ (guile) times))))) + +(define (wait) + (let ((x (wait-pid -1))) + (list (car x) (cdr x)))) + +(define-python-class SigInfo () + (define __init__ + (lambda (self a b c d e) + (set self 'si_signo a) + (set self 'si_code b) + (set self 'si_pid c) + (set self 'si_uid d) + (set self 'si_status e))) + + (define __repr__ + (lambda (self) + (format #f + "SigInfo(signo:~a code:~a pid:~a uid:~a status:~a" + (ref self 'si_signo) + (ref self 'si_code) + (ref self 'si_pid) + (ref self 'si_uid) + (ref self 'si_status))))) + + +(define waitid + (let ((f (pointer->procedure int + (dynamic-func "waitid" (dynamic-link)) + (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)))) + (si_status (lambda () (ref 6))) + (si_code (lambda () (ref 2))) + (si_pid (lambda () (ref 4))) + (si_uid (lambda () (ref 5))) + (si_signo (lambda () (ref 0)))) + (rm (f idtype id vp options)) + (SigInfo (si_signo) (si_code) (si_pid) (si_uid) + (si_status)))))) + +(define P_PID 1) +(define P_PGID 2) +(define P_ALL 0) + +(define WEXITED 4) +(define WUNTRACED 2) +(define WSTOPPED 2) +(define WNOWAIT #x01000000) +(define WCONTINUED 8) +(define WNOHANG 1) + +(define CLD_EXITED 1) +(define CLD_KILLED 2) +(define CLD_DUMPED 3) +(define CLD_STOPED 5) +(define CLD_TRAPPED 4) +(define CLD_CONTINUED 6) + +(define (waitpid pid options) + (ca ((@ (guile) waitpid) pid options))) + +(define wait3 + (let ((f (pointer->procedure int + (dynamic-func "wait3" (dynamic-link)) + ('* int '*)))) + (lambda (option) + (let* ((v (make-bytevector 250)) + (vp (bytevector->pointer v)) + (w (mkae-bytevector 8)) + (wp (bytevector->pointer w))) + + (let ((pid (rm (f wp option vp)))) + (list pid + (bytevector-s32-ref w 0 (native-endianess)) + (ResUsage v))))))) + +(define wait4 + (let ((f (pointer->procedure int + (dynamic-func "wait4" (dynamic-link)) + (int '* int '*)))) + (lambda (pid option) + (let* ((v (make-bytevector 250)) + (vp (bytevector->pointer v)) + (w (mkae-bytevector 8)) + (wp (bytevector->pointer w))) + + (let ((pid2 (rm (f pid wp option vp)))) + (list pid + (bytevector-s32-ref w 0 (native-endianess)) + (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 (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 '())) @@ -1598,3 +1759,121 @@ +;; Scheduling + +(define SCHED_OTHER 0) +(define SCHED_BATCH 3) +(define SCHED_IDLE 5) +(define SCHED_FIFO 1) +(define SCHED_RR 2) +(define SCHED_RESET_ON_FORK #x40000000) + +(define-python-class sched_param () + (define __init__ + (lambda (self v) + (if (bytevector? v) + (set self 'sched_priority + (bytevector-s32-ref v 0 (native-endianess))) + (set self 'sched_priority v))))) + +(define 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 + (let ((f (pointer->procedure int + (dynamic-func "sched_get_priority_max" + (dynamic-link)) + (list int)))) + (lambda (policy) (rm (f policy))))) + +(define sched_setscheduler + (let ((f (pointer->procedure int + (dynamic-func "sched_setscheduler" + (dynamic-link)) + (list int int '*)))) + (lambda (pid policy param) + (let* ((v (make-bytevector 32)) + (vp (bytevector->pointer v))) + (bytevector-s32-set! v 0 (ref param 'sched_priority) + (native-endianess)) + (rm (f pid policy vp)))))) + +(define sched_getscheduler + (let ((f (pointer->procedure int + (dynamic-func "sched_getscheduler" + (dynamic-link)) + (list int)))) + (lambda (pid) + (ca (f pid))))) + +(define sched_setparam + (let ((f (pointer->procedure int + (dynamic-func "sched_setparam" + (dynamic-link)) + (list int '*)))) + (lambda (pid param) + (let* ((v (make-bytevector 32)) + (vp (bytevector->pointer v))) + (bytevector-s32-set! v 0 (ref param 'sched_priority) + (native-endianess)) + (rm (f pid vp)))))) + +(define sched_getparam + (let ((f (pointer->procedure int + (dynamic-func "sched_getparam" + (dynamic-link)) + (list int '*)))) + (lambda (pid param) + (let* ((v (make-bytevector 32)) + (vp (bytevector->pointer v))) + (rm (f pid vp)) + (sched_param v))))) + +(define sched_rr_get_intervall + (lambda x (error "not implemented"))) + +(define sched_yield + (let ((f (pointer->procedure int + (dynamic-func "sched_yield" + (dynamic-link)) + (list)))) + (lambda () (rm (f))))) + +(define 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))) + (vp (bytevector->pointer v))) + + (for ((m : mask)) () + (bytevector-u64-set! v i m (native-endianess))) + + (rm (f pid (/ n 8) vp)))))) + +(define 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))) + (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)) + (lp (+ i 1))) + '())))))) + + +;; MISC SYSTEM INFORMATION diff --git a/modules/language/python/module/resource.scm b/modules/language/python/module/resource.scm new file mode 100644 index 0000000..200127e --- /dev/null +++ b/modules/language/python/module/resource.scm @@ -0,0 +1,163 @@ +(define-module (language python module resource) + #:use-module (system foreign) + #:use-module (rnrs bytevectors) + #:use-module (language python exceptions) + #: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 + RLIMIT_MSGQUEUE RLIMIT_NICE RLIMIT_RTPRIO + RLIMIT_RTTIME RLIMIT_SIGPENDING + + getrlimit setrlimit prlimit + + RUSAGE_SELF RUSAGE_CHILDREN RUSAGE_BOTH RUSAGE_THREAD + getrusage getpagesize + + ResUsage + )) + +(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) +(define-syntax-rule (ca code) + (catch #t + (lambda () code) + (lambda x (raise error x)))) +(define-syntax-rule (rm code (m . mm) ...) + (let ((r (ca code))) + (if (< r 0) + (let ((e (errno))) + (cond + ((= e m) mm) ... + (else + (raise OSError (pylist-ref errorcode e) ((@ (guile) strerror) e))))) + (values)))) + +(define RLIM_INFINITY #xffffffffffffffff) + +(define RLIMIT_CORE 4) +(define RLIMIT_CPU 0) +(define RLIMIT_FSIZE 1) +(define RLIMIT_DATA 2) +(define RLIMIT_STACK 3) +(define RLIMIT_RSS 5) +(define RLIMIT_NPROC 6) +(define RLIMIT_NOFILE 7) +(define RLIMIT_MEMLOCK 8) +(define RLIMIT_AS 9) +(define RLIMIT_LOCKS 10) +(define RLIMIT_MSGQUEUE 12) +(define RLIMIT_NICE 13) +(define RLIMIT_RTPRIO 14) +(define RLIMIT_RTTIME 15) +(define RLIMIT_SIGPENDING 11) + +(define getrlimit + (let ((f (pointer->procedure int + (dynamic-func "getrlimit" (dynamic-link)) + (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))))))) + +(define setrlimit + (let ((f (pointer->procedure int + (dynamic-func "setrlimit" (dynamic-link)) + (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)) + (rm (f resource vp) + (EINVAL (raise ValueError "wrong resource")) + (EPERM (raise ValueError "wrong permission"))) + (values))))) + +(define prlimit + (let ((f (pointer->procedure int + (dynamic-func "prlimit" (dynamic-link)) + (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))) + (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)))) + (rm (f pid resource + (if (eq? limits None) + (adress-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))))))) + + +(define RUSAGE_SELF 0) +(define RUSAGE_CHILDREN -1) +(define RUSAGE_BOTH -2) +(define RUSAGE_THREAD 1) + +(define-python-class ResUsage () + (define __init__ + (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)) + (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)))) + (gettime 'ru_utime) + (gettime 'ru_stime) + (s 'ru_maxrss) + (s 'ru_ixrss ) + (s 'ru_idrss ) + (s 'ru_isrss ) + (s 'ru_minflt) + (s 'ru_majflt) + (s 'ru_nswap) + (s 'ru_inblock) + (s 'ru_outblock) + (s 'ru_msgsnd) + (s 'ru_msgrcv) + (s 'ru_nsignals) + (s 'ru_nvcsw) + (s 'ru_nivcsw)))) + +(define getrusage + (let ((f (pointer->procedure int + (dynamic-func "getrusage" (dynamic-link)) + (int '*)))) + (lambda (who) + (let* ((v (make-bytevector 160)) + (vp (bytevector->pointer))) + + (rm (f who vp) + (EINVAL (raise ValueError "wrong who in getrusage"))) + + (ResUsage v))))) + +(define getpagesize + (let ((f (pointer->procedure int + (dynamic-func "getpagesize" (dynamic-link)) + ()))) + (lambda () + (rm (f))))) + |