Retropikzel
/
foreign-c-srfis
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Update SRFI-170 to use latest (foreign c)

This commit is contained in:
retropikzel 2026-01-22 10:52:08 +02:00
parent 458e277eec
commit bddc6ea95a
2 changed files with 35 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
srfi/170.scm
View File

@ -176,11 +176,12 @@
(letrec* ((looper (lambda (c index result) (letrec* ((looper (lambda (c index result)
(if (char=? c #\null) (if (char=? c #\null)
(list->string (reverse result)) (list->string (reverse result))
(looper (c-bytevector-char-ref pointer (looper (c-bytevector-ref pointer
(+ offset index)) 'char
(+ offset index))
(+ index 1) (+ index 1)
(cons c result)))))) (cons c result))))))
(looper (c-bytevector-char-ref pointer offset) 1 (list)))) (looper (c-bytevector-ref pointer 'char offset) 1 (list))))
; struct dirent d_name offset on linux ; struct dirent d_name offset on linux
(define d-name-offset 19) (define d-name-offset 19)
@ -332,10 +333,10 @@
(+ count 1) (+ count 1)
groups-pointer groups-pointer
(append result (append result
(list (c-bytevector-sint-ref groups-pointer (list (c-bytevector-ref groups-pointer
(* (c-type-size 'int) count) 'int
(native-endianness) (* (c-type-size 'int) count)
(c-type-size 'int))))))) ))))))
(define (user-supplementary-gids) (define (user-supplementary-gids)
(let* ((group-count (c-getgroups 0 (make-c-null))) (let* ((group-count (c-getgroups 0 (make-c-null)))
@ -357,26 +358,28 @@
(let ((password-struct (if (number? uid/name) (let ((password-struct (if (number? uid/name)
(c-getpwuid uid/name) (c-getpwuid uid/name)
(c-getpwnam (string->c-utf8 uid/name))))) (c-getpwnam (string->c-utf8 uid/name)))))
(make-user-info (c-utf8->string (c-bytevector-pointer-ref password-struct (make-user-info (c-utf8->string (c-bytevector-ref password-struct
0)) 'pointer
(c-bytevector-sint-ref password-struct 0))
(* (c-type-size 'pointer) 2) (c-bytevector-ref password-struct
(native-endianness) 'int
(c-type-size 'int)) (* (c-type-size 'pointer) 2))
(c-bytevector-sint-ref password-struct (c-bytevector-ref password-struct
(+ (* (c-type-size 'pointer) 2) 'int
(c-type-size 'int)) (+ (* (c-type-size 'pointer) 2)
(native-endianness) (c-type-size 'int)))
(c-type-size 'int)) (c-utf8->string (c-bytevector-ref password-struct
(c-utf8->string (c-bytevector-pointer-ref password-struct 'pointer
(+ (* (c-type-size 'pointer) 3) (+ (* (c-type-size 'pointer) 3)
(* (c-type-size 'int) 2)))) (* (c-type-size 'int) 2))))
(c-utf8->string (c-bytevector-pointer-ref password-struct (c-utf8->string (c-bytevector-ref password-struct
(+ (* (c-type-size 'pointer) 4) 'pointer
(* (c-type-size 'int) 2)))) (+ (* (c-type-size 'pointer) 4)
(c-utf8->string (c-bytevector-pointer-ref password-struct (* (c-type-size 'int) 2))))
(+ (* (c-type-size 'pointer) 2) (c-utf8->string (c-bytevector-ref password-struct
(* (c-type-size 'int) 2))))))) 'pointer
(+ (* (c-type-size 'pointer) 2)
(* (c-type-size 'int) 2)))))))
(define-record-type <group-info> (define-record-type <group-info>
@ -390,11 +393,10 @@
(c-getgrgid gid/name) (c-getgrgid gid/name)
(c-getgrnam (string->c-utf8 gid/name))))) (c-getgrnam (string->c-utf8 gid/name)))))
(make-group-info (make-group-info
(c-utf8->string (c-bytevector-pointer-ref group-struct 0)) (c-utf8->string (c-bytevector-ref group-struct 'pointer 0))
(c-bytevector-sint-ref group-struct (c-bytevector-ref group-struct
(* (c-type-size 'pointer) 2) 'int
(native-endianness) (* (c-type-size 'pointer) 2)))))
(c-type-size 'int)))))
(define (set-environment-variable! name value) (define (set-environment-variable! name value)
(c-setenv (string->c-utf8 name) (string->c-utf8 value) 1)) (c-setenv (string->c-utf8 name) (string->c-utf8 value) 1))

2
srfi/170/VERSION
View File

@ -1 +1 @@
0.1.1 0.1.2