]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' of git://factorcode.org/git/factor into struct-updates
authorJoe Groff <arcata@gmail.com>
Mon, 31 Aug 2009 17:01:04 +0000 (12:01 -0500)
committerJoe Groff <arcata@gmail.com>
Mon, 31 Aug 2009 17:01:04 +0000 (12:01 -0500)
basis/io/files/info/unix/freebsd/freebsd.factor
basis/io/files/info/unix/netbsd/netbsd.factor [changed mode: 0644->0755]
basis/io/files/info/unix/openbsd/openbsd.factor [changed mode: 0644->0755]
basis/unix/bsd/bsd.factor
basis/unix/groups/groups.factor
basis/unix/linux/linux.factor
basis/unix/unix.factor
basis/unix/users/bsd/bsd.factor
basis/unix/users/users.factor

index 079dac23a96e51500b195345405f54310949c083..12f04db881aad928f9bcb420105241aa38f706de 100644 (file)
@@ -40,7 +40,7 @@ M: freebsd statfs>file-system-info ( file-system-info statvfs -- file-system-inf
     } cleave ;
 
 M: freebsd file-system-statvfs ( path -- byte-array )
-    \ statvfs <struct> [ statvfs io-error ] keep ;
+    \ statvfs <struct> [ statvfs io-error ] keep ;
 
 M: freebsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info )
     {
@@ -50,6 +50,6 @@ M: freebsd statvfs>file-system-info ( file-system-info statvfs -- file-system-in
 
 M: freebsd file-systems ( -- array )
     f 0 0 getfsstat dup io-error
-    \ statfs <struct> dup dup length 0 getfsstat io-error
-    statfs heap-size group
-    [ f_mntonname>> alien>native-string file-system-info ] map ;
+    \ statfs <c-type-array>
+    [ dup length 0 getfsstat io-error ]
+    [ [ f_mntonname>> utf8 alien>string file-system-info ] map ] bi ;
old mode 100644 (file)
new mode 100755 (executable)
index 7c28258..65c2d1d
@@ -4,7 +4,7 @@ USING: alien.syntax kernel unix.stat math unix
 combinators system io.backend accessors alien.c-types
 io.encodings.utf8 alien.strings unix.types io.files.unix
 io.files io.files.info unix.statvfs.netbsd unix.getfsstat.netbsd arrays
-grouping sequences io.encodings.utf8 classes.struct
+grouping sequences io.encodings.utf8 classes.struct struct-arrays
 io.files.info.unix ;
 IN: io.files.info.unix.netbsd
 
@@ -47,6 +47,6 @@ M: netbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-inf
 
 M: netbsd file-systems ( -- array )
     f 0 0 getvfsstat dup io-error
-    \ statvfs <c-array> dup dup length 0 getvfsstat io-error
-    \ statvfs heap-size group
-    [ f_mntonname>> utf8 alien>string file-system-info ] map ;
+    \ statvfs <struct-array>
+    [ dup length 0 getvfsstat io-error ]
+    [ [ f_mntonname>> utf8 alien>string file-system-info ] map ] bi ;
old mode 100644 (file)
new mode 100755 (executable)
index 242938a..c367139
@@ -4,7 +4,7 @@ USING: accessors alien.c-types alien.strings alien.syntax
 combinators io.backend io.files io.files.info io.files.unix kernel math
 sequences system unix unix.getfsstat.openbsd grouping
 unix.statfs.openbsd unix.statvfs.openbsd unix.types
-arrays io.files.info.unix classes.struct ;
+arrays io.files.info.unix classes.struct struct-arrays ;
 IN: io.files.unix.openbsd
 
 TUPLE: freebsd-file-system-info < unix-file-system-info
@@ -47,6 +47,6 @@ M: openbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-in
 
 M: openbsd file-systems ( -- seq )
     f 0 0 getfsstat dup io-error
-    \ statfs <c-array> dup dup length 0 getfsstat io-error 
-    \ statfs heap-size group 
-    [ f_mntonname>> alien>native-string file-system-info ] map ;
+    \ statfs <c-type-array>
+    [ dup length 0 getvfsstat io-error ]
+    [ [ f_mntonname>> utf8 alien>string file-system-info ] map ] bi ;
index bb0f9b520163324302a7761fa79a813c47028117..dd45a42d3e6dc459a2115f325c8ef987d95c88ee 100644 (file)
@@ -1,6 +1,7 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax combinators system vocabs.loader ;
+USING: alien.syntax classes.struct combinators system
+vocabs.loader ;
 IN: unix
 
 CONSTANT: MAXPATHLEN 1024
@@ -46,18 +47,18 @@ C-STRUCT: sockaddr-un
     { "uchar" "family" }
     { { "char" 104 } "path" } ;
 
-C-STRUCT: passwd
-    { "char*"  "pw_name" }
-    { "char*"  "pw_passwd" }
-    { "uid_t"  "pw_uid" }
-    { "gid_t"  "pw_gid" }
-    { "time_t" "pw_change" }
-    { "char*"  "pw_class" }
-    { "char*"  "pw_gecos" }
-    { "char*"  "pw_dir" }
-    { "char*"  "pw_shell" }
-    { "time_t" "pw_expire" }
-    { "int"    "pw_fields" } ;
+STRUCT: passwd
+    { pw_name char* }
+    { pw_passwd char* }
+    { pw_uid uid_t }
+    { pw_gid gid_t }
+    { pw_change time_t }
+    { pw_class char* }
+    { pw_gecos char* }
+    { pw_dir char* }
+    { pw_shell char* }
+    { pw_expire time_t }
+    { pw_fields int } ;
 
 CONSTANT: max-un-path 104
 
index eba0e4976f40e7927e61ae7c02e76e15752b48b4..c4392c4c6da9ec3fb009c9d995fb4b58c992940a 100644 (file)
@@ -1,12 +1,14 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.strings io.encodings.utf8
-io.backend.unix kernel math sequences splitting unix strings
+io.backend.unix kernel math sequences splitting strings
 combinators.short-circuit byte-arrays combinators
 accessors math.parser fry assocs namespaces continuations
-unix.users unix.utilities ;
+unix.users unix.utilities classes.struct ;
 IN: unix.groups
 
+QUALIFIED: unix
+
 QUALIFIED: grouping
 
 TUPLE: group id name passwd members ;
@@ -18,27 +20,27 @@ GENERIC: group-struct ( obj -- group/f )
 <PRIVATE
 
 : group-members ( group-struct -- seq )
-    group-gr_mem utf8 alien>strings ;
+    gr_mem>> utf8 alien>strings ;
 
 : (group-struct) ( id -- group-struct id group-struct byte-array length void* )
-    "group" <c-object> tuck 4096
+    \ unix:group <struct> tuck 4096
     [ <byte-array> ] keep f <void*> ;
 
 : check-group-struct ( group-struct ptr -- group-struct/f )
     *void* [ drop f ] unless ;
 
 M: integer group-struct ( id -- group/f )
-    (group-struct) [ getgrgid_r io-error ] keep check-group-struct ;
+    (group-struct) [ unix:getgrgid_r unix:io-error ] keep check-group-struct ;
 
 M: string group-struct ( string -- group/f )
-    (group-struct) [ getgrnam_r io-error ] keep check-group-struct ;
+    (group-struct) [ unix:getgrnam_r unix:io-error ] keep check-group-struct ;
 
 : group-struct>group ( group-struct -- group )
     [ \ group new ] dip
     {
-        [ group-gr_name >>name ]
-        [ group-gr_passwd >>passwd ]
-        [ group-gr_gid >>id ]
+        [ gr_name>> >>name ]
+        [ gr_passwd>> >>passwd ]
+        [ gr_gid>> >>id ]
         [ group-members >>members ]
     } cleave ;
 
@@ -48,12 +50,12 @@ PRIVATE>
     dup group-cache get [
         ?at [ name>> ] [ number>string ] if
     ] [
-        group-struct [ group-gr_name ] [ f ] if*
+        group-struct [ gr_name>> ] [ f ] if*
     ] if*
     [ nip ] [ number>string ] if* ;
 
 : group-id ( string -- id/f )
-    group-struct [ group-gr_gid ] [ f ] if* ;
+    group-struct [ gr_gid>> ] [ f ] if* ;
 
 <PRIVATE
 
@@ -62,8 +64,8 @@ PRIVATE>
 
 : (user-groups) ( string -- seq )
     #! first group is -1337, legacy unix code
-    -1337 NGROUPS_MAX [ 4 * <byte-array> ] keep
-    <int> [ getgrouplist io-error ] 2keep
+    -1337 unix:NGROUPS_MAX [ 4 * <byte-array> ] keep
+    <int> [ unix:getgrouplist unix:io-error ] 2keep
     [ 4 tail-slice ] [ *int 1 - ] bi* >groups ;
 
 PRIVATE>
@@ -77,7 +79,7 @@ M: integer user-groups ( id -- seq )
     user-name (user-groups) ;
     
 : all-groups ( -- seq )
-    [ getgrent dup ] [ group-struct>group ] produce nip ;
+    [ unix:getgrent dup ] [ \ unix:group memory>struct group-struct>group ] produce nip ;
 
 : <group-cache> ( -- assoc )
     all-groups [ [ id>> ] keep ] H{ } map>assoc ;
@@ -85,14 +87,11 @@ M: integer user-groups ( id -- seq )
 : with-group-cache ( quot -- )
     [ <group-cache> group-cache ] dip with-variable ; inline
 
-: real-group-id ( -- id )
-    getgid ; inline
+: real-group-id ( -- id ) unix:getgid ; inline
 
-: real-group-name ( -- string )
-    real-group-id group-name ; inline
+: real-group-name ( -- string ) real-group-id group-name ; inline
 
-: effective-group-id ( -- string )
-    getegid ; inline
+: effective-group-id ( -- string ) unix:getegid ; inline
 
 : effective-group-name ( -- string )
     effective-group-id group-name ; inline
@@ -112,10 +111,10 @@ GENERIC: set-effective-group ( obj -- )
 <PRIVATE
 
 : (set-real-group) ( id -- )
-    setgid io-error ; inline
+    unix:setgid unix:io-error ; inline
 
 : (set-effective-group) ( id -- )
-    setegid io-error ; inline
+    unix:setegid unix:io-error ; inline
 
 PRIVATE>
     
index 31789baf1c5a8760464c828976199f3a721d3e43..5b1a41f21f2fcae6acc8e6de195d5719021da555 100644 (file)
@@ -84,14 +84,14 @@ CONSTANT: SEEK_SET 0
 CONSTANT: SEEK_CUR 1
 CONSTANT: SEEK_END 2
 
-C-STRUCT: passwd
-    { "char*"  "pw_name" }
-    { "char*"  "pw_passwd" }
-    { "uid_t"  "pw_uid" }
-    { "gid_t"  "pw_gid" }
-    { "char*"  "pw_gecos" }
-    { "char*"  "pw_dir" }
-    { "char*"  "pw_shell" } ;
+STRUCT: passwd
+    { pw_name char* }
+    { pw_passwd char* }
+    { pw_uid uid_t }
+    { pw_gid gid_t }
+    { pw_gecos char* }
+    { pw_dir char* }
+    { pw_shell char* } ;
 
 ! dirent64
 STRUCT: dirent
index 9c4251dd1e44fec167f7f55beafc0428f4820096..59a3331354a59378ce916846ef7c8734c51e38f2 100644 (file)
@@ -5,7 +5,7 @@ USING: alien alien.c-types alien.syntax kernel libc
 sequences continuations byte-arrays strings math namespaces
 system combinators vocabs.loader accessors
 stack-checker macros locals generalizations unix.types
-io vocabs ;
+io vocabs classes.struct ;
 IN: unix
 
 CONSTANT: PROT_NONE   0
@@ -35,11 +35,11 @@ CONSTANT: DT_LNK      10
 CONSTANT: DT_SOCK     12
 CONSTANT: DT_WHT      14
 
-C-STRUCT: group
-    { "char*" "gr_name" }
-    { "char*" "gr_passwd" }
-    { "int" "gr_gid" }
-    { "char**" "gr_mem" } ;
+STRUCT: group
+    { gr_name char* }
+    { gr_passwd char* }
+    { gr_gid int }
+    { gr_mem char** } ;
 
 LIBRARY: libc
 
@@ -147,19 +147,19 @@ M: unix open-file [ open ] unix-system-call ;
 
 FUNCTION: DIR* opendir ( char* path ) ;
 
-C-STRUCT: utimbuf
-    { "time_t" "actime"  }
-    { "time_t" "modtime" } ;
+STRUCT: utimbuf
+    { actime time_t }
+    { modtime time_t } ;
 
-FUNCTION: int utime ( char* path, utimebuf* buf ) ;
+FUNCTION: int utime ( char* path, utimbuf* buf ) ;
 
 : touch ( filename -- ) f [ utime ] unix-system-call drop ;
 
 : change-file-times ( filename access modification -- )
-    "utimebuf" <c-object>
-    [ set-utimbuf-modtime ] keep
-    [ set-utimbuf-actime ] keep
-    [ utime ] unix-system-call drop ;
+    utimbuf <struct>
+        swap >>modtime
+        swap >>actime
+        [ utime ] unix-system-call drop ;
 
 FUNCTION: int pclose ( void* file ) ;
 FUNCTION: int pipe ( int* filedes ) ;
index b3778ced7063acc71b897640a7b802271bf14c99..2c41a05a7f5cdf7141ba2727b0fe2b0af3d5d66d 100644 (file)
@@ -1,8 +1,9 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators accessors kernel unix unix.users
+USING: combinators accessors kernel unix.users
 system ;
 IN: unix.users.bsd
+QUALIFIED: unix
 
 TUPLE: bsd-passwd < passwd change class expire fields ;
 
@@ -11,9 +12,9 @@ M: bsd new-passwd ( -- bsd-passwd ) bsd-passwd new ;
 M: bsd passwd>new-passwd ( passwd -- bsd-passwd )
     [ call-next-method ] keep
     {
-        [ passwd-pw_change >>change ]
-        [ passwd-pw_class >>class ]
-        [ passwd-pw_shell >>shell ]
-        [ passwd-pw_expire >>expire ]
-        [ passwd-pw_fields >>fields ]
+        [ pw_change>> >>change ]
+        [ pw_class>> >>class ]
+        [ pw_shell>> >>shell ]
+        [ pw_expire>> >>expire ]
+        [ pw_fields>> >>fields ]
     } cleave ;
index a523f0818bbbb4ca3553cc2a7687b58c5546c906..09119ff0cc3ec6e6f0cf8d80795c7313eb72bb87 100644 (file)
@@ -1,11 +1,12 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.strings io.encodings.utf8
-io.backend.unix kernel math sequences splitting unix strings
+io.backend.unix kernel math sequences splitting strings
 combinators.short-circuit grouping byte-arrays combinators
 accessors math.parser fry assocs namespaces continuations
-vocabs.loader system ;
+vocabs.loader system classes.struct ;
 IN: unix.users
+QUALIFIED: unix
 
 TUPLE: passwd user-name password uid gid gecos dir shell ;
 
@@ -20,23 +21,23 @@ M: unix new-passwd ( -- passwd )
 M: unix passwd>new-passwd ( passwd -- seq )
     [ new-passwd ] dip
     {
-        [ passwd-pw_name >>user-name ]
-        [ passwd-pw_passwd >>password ]
-        [ passwd-pw_uid >>uid ]
-        [ passwd-pw_gid >>gid ]
-        [ passwd-pw_gecos >>gecos ]
-        [ passwd-pw_dir >>dir ]
-        [ passwd-pw_shell >>shell ]
+        [ pw_name>> >>user-name ]
+        [ pw_passwd>> >>password ]
+        [ pw_uid>> >>uid ]
+        [ pw_gid>> >>gid ]
+        [ pw_gecos>> >>gecos ]
+        [ pw_dir>> >>dir ]
+        [ pw_shell>> >>shell ]
     } cleave ;
 
 : with-pwent ( quot -- )
-    [ endpwent ] [ ] cleanup ; inline
+    [ unix:endpwent ] [ ] cleanup ; inline
 
 PRIVATE>
 
 : all-users ( -- seq )
     [
-        [ getpwent dup ] [ passwd>new-passwd ] produce nip
+        [ unix:getpwent dup ] [ unix:passwd memory>struct passwd>new-passwd ] produce nip
     ] with-pwent ;
 
 SYMBOL: user-cache
@@ -51,10 +52,10 @@ GENERIC: user-passwd ( obj -- passwd/f )
 
 M: integer user-passwd ( id -- passwd/f )
     user-cache get
-    [ at ] [ getpwuid [ passwd>new-passwd ] [ f ] if* ] if* ;
+    [ at ] [ unix:getpwuid [ unix:passwd memory>struct passwd>new-passwd ] [ f ] if* ] if* ;
 
 M: string user-passwd ( string -- passwd/f )
-    getpwnam dup [ passwd>new-passwd ] when ;
+    unix:getpwnam dup [ unix:passwd memory>struct passwd>new-passwd ] when ;
 
 : user-name ( id -- string )
     dup user-passwd
@@ -64,13 +65,13 @@ M: string user-passwd ( string -- passwd/f )
     user-passwd uid>> ;
 
 : real-user-id ( -- id )
-    getuid ; inline
+    unix:getuid ; inline
 
 : real-user-name ( -- string )
     real-user-id user-name ; inline
 
 : effective-user-id ( -- id )
-    geteuid ; inline
+    unix:geteuid ; inline
 
 : effective-user-name ( -- string )
     effective-user-id user-name ; inline
@@ -92,10 +93,10 @@ GENERIC: set-effective-user ( string/id -- )
 <PRIVATE
 
 : (set-real-user) ( id -- )
-    setuid io-error ; inline
+    unix:setuid unix:io-error ; inline
 
 : (set-effective-user) ( id -- )
-    seteuid io-error ; inline
+    unix:seteuid unix:io-error ; inline
 
 PRIVATE>