Merge branch 'master' of git://factorcode.org/git/factor

core/debugger/debugger.factor

@@ -6,7 +6,7 @@ strings io.styles vectors words system splitting math.parser
 tuples continuations continuations.private combinators
 generic.math io.streams.duplex classes compiler.units
 generic.standard vocabs threads threads.private init
-kernel.private ;
+kernel.private libc ;
 IN: debugger
 
 GENERIC: error. ( error -- )
@@ -63,20 +63,9 @@ M: string error. print ;
     [ global [ "Error in print-error!" print drop ] bind ]
     recover ;
 
-: error-in-thread. ( -- )
-    error-thread get-global
-    "Error in thread " write
-    [
-        dup thread-id #
-        " (" % dup thread-name %
-        ", " % dup thread-quot unparse-short % ")" %
-    ] "" make
-    swap write-object ":" print nl ;
-
 SYMBOL: error-hook
 
 [
-    error-in-thread.
     print-error
     restarts.
     nl
@@ -265,6 +254,24 @@ M: no-compilation-unit error.
 M: no-vocab summary
     drop "Vocabulary does not exist" ;
 
+M: check-ptr summary
+    drop "Memory allocation failed" ;
+
+M: double-free summary
+    drop "Free failed since memory is not allocated" ;
+
+M: realloc-error summary
+    drop "Memory reallocation failed" ;
+
+: error-in-thread. ( -- )
+    error-thread get-global
+    "Error in thread " write
+    [
+        dup thread-id #
+        " (" % dup thread-name %
+        ", " % dup thread-quot unparse-short % ")" %
+    ] "" make swap write-object ":" print nl ;
+
 ! Hooks
 M: thread error-in-thread ( error thread -- )
     initial-thread get-global eq? [

core/io/files/files.factor

@@ -142,7 +142,6 @@ DEFER: copy-tree-to
 
 : copy-tree ( from to -- )
     over directory? [
-        dup make-directories
         >r dup directory swap r> [
             >r swap first path+ r> copy-tree-to
         ] 2curry each

core/libc/libc.factor

@@ -2,7 +2,7 @@
 ! Copyright (C) 2007 Slava Pestov
 ! Copyright (C) 2007 Doug Coleman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien assocs continuations init inspector kernel namespaces ;
+USING: alien assocs continuations init kernel namespaces ;
 IN: libc
 
 <PRIVATE
@@ -25,22 +25,16 @@ PRIVATE>
 
 TUPLE: check-ptr ;
 
-M: check-ptr summary drop "Memory allocation failed" ;
-
 : check-ptr ( c-ptr -- c-ptr )
     [ \ check-ptr construct-boa throw ] unless* ;
 
 TUPLE: double-free ;
 
-M: double-free summary drop "Free failed since memory is not allocated" ;
-
 : double-free ( -- * )
     \ double-free construct-empty throw ;
 
 TUPLE: realloc-error ptr size ;
 
-M: realloc-error summary drop "Memory reallocation failed" ;
-
 : realloc-error ( alien size -- * )
     \ realloc-error construct-boa throw ;
 

extra/hello-world/deploy.factor

@@ -1,13 +1,14 @@
 USING: tools.deploy.config ;
 H{
-    { deploy-c-types? f }
+    { deploy-io 2 }
-    { deploy-ui? f }
-    { deploy-reflection 1 }
     { deploy-math? f }
+    { deploy-threads? f }
+    { deploy-compiler? f }
     { deploy-word-props? f }
     { deploy-word-defs? f }
     { deploy-name "Hello world (console)" }
+    { deploy-reflection 2 }
+    { deploy-c-types? f }
+    { deploy-ui? f }
     { "stop-after-last-window?" t }
-    { deploy-compiler? f }
-    { deploy-io 2 }
 }

extra/io/monitors/monitors.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.backend kernel continuations namespaces sequences
-assocs hashtables sorting arrays threads boxes ;
+assocs hashtables sorting arrays threads boxes io.timeouts ;
 IN: io.monitors
 
 <PRIVATE
@@ -32,7 +32,11 @@ M: monitor dispose
 
 ! Simple monitor; used on Linux and Mac OS X. On Windows,
 ! monitors are full-fledged ports.
-TUPLE: simple-monitor handle callback ;
+TUPLE: simple-monitor handle callback timeout ;
+
+M: simple-monitor timeout simple-monitor-timeout ;
+
+M: simple-monitor set-timeout set-simple-monitor-timeout ;
 
 : <simple-monitor> ( handle -- simple-monitor )
     f (monitor) <box> {
@@ -47,9 +51,14 @@ TUPLE: simple-monitor handle callback ;
 : notify-callback ( simple-monitor -- )
     simple-monitor-callback ?box [ resume ] [ drop ] if ;
 
+M: simple-monitor timed-out
+    notify-callback ;
+
 M: simple-monitor fill-queue ( monitor -- )
+    [
         [ swap simple-monitor-callback >box ]
         "monitor" suspend drop
+    ] with-timeout
     check-monitor ;
 
 M: simple-monitor dispose ( monitor -- )

extra/io/unix/files/files.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.backend io.nonblocking io.unix.backend io.files io
-unix kernel math continuations math.bitfields byte-arrays
+unix unix.stat kernel math continuations math.bitfields byte-arrays
 alien ;
+
 IN: io.unix.files
 
 M: unix-io cwd

extra/tools/deploy/config/config-docs.factor

@@ -66,6 +66,11 @@ HELP: deploy-math?
 $nl
 "On by default. Often the programmer will use rationals without realizing it. A small amount of space can be saved by stripping these features out, but some code may require changes to work properly." } ;
 
+HELP: deploy-threads?
+{ $description "Deploy flag. If set, the deployed image will contain support for threads."
+$nl
+"On by default. Often the programmer will use threads without realizing it. A small amount of space can be saved by stripping this feature out, but some code may require changes to work properly." } ;
+
 HELP: deploy-compiler?
 { $description "Deploy flag. If set, words in the deployed image will be compiled with the optimizing compiler when possible."
 $nl

extra/tools/deploy/config/config.factor

@@ -10,6 +10,7 @@ SYMBOL: deploy-name
 SYMBOL: deploy-ui?
 SYMBOL: deploy-compiler?
 SYMBOL: deploy-math?
+SYMBOL: deploy-threads?
 
 SYMBOL: deploy-io
 
@@ -55,6 +56,7 @@ SYMBOL: deploy-image
         { deploy-io                 2 }
         { deploy-reflection         1 }
         { deploy-compiler?          t }
+        { deploy-threads?           t }
         { deploy-math?              t }
         { deploy-word-props?        f }
         { deploy-word-defs?         f }

extra/tools/deploy/deploy-tests.factor

@@ -0,0 +1,22 @@
+IN: temporary
+USING: tools.test system io.files kernel tools.deploy.config
+tools.deploy.backend math ;
+
+: shake-and-bake
+    "." resource-path [
+        vm
+        "hello.image" temp-file
+        rot dup deploy-config make-deploy-image
+    ] with-directory ;
+
+[ ] [ "hello-world" shake-and-bake ] unit-test
+
+[ t ] [
+    "hello.image" temp-file file-length 500000 <=
+] unit-test
+
+[ ] [ "hello-ui" shake-and-bake ] unit-test
+
+[ t ] [
+    "hello.image" temp-file file-length 2000000 <=
+] unit-test

extra/tools/deploy/shaker/shaker.factor

@@ -11,8 +11,16 @@ IN: tools.deploy.shaker
 : strip-init-hooks ( -- )
     "Stripping startup hooks" show
     "command-line" init-hooks get delete-at
-    "mallocs" init-hooks get delete-at
+    "libc" init-hooks get delete-at
-    strip-io? [ "io.backend" init-hooks get delete-at ] when ;
+    deploy-threads? get [
+        "threads" init-hooks get delete-at
+    ] unless
+    native-io? [
+        "io.thread" init-hooks get delete-at
+    ] unless
+    strip-io? [
+        "io.backend" init-hooks get delete-at
+    ] when ;
 
 : strip-debugger ( -- )
     strip-debugger? [
@@ -85,6 +93,7 @@ IN: tools.deploy.shaker
     { } set-retainstack
     V{ } set-namestack
     V{ } set-catchstack
+    
     "Saving final image" show
     [ save-image-and-exit ] call-clear ;
 

extra/tools/deploy/shaker/strip-debugger.factor

@@ -1,6 +1,8 @@
-USING: kernel ;
+USING: kernel threads threads.private ;
 IN: debugger
 
 : print-error die ;
 
 : error. die ;
+
+M: thread error-in-thread ( error thread -- ) die 2drop ;

extra/tools/deploy/windows/windows.factor

@@ -10,10 +10,10 @@ IN: tools.deploy.windows
     vm over copy-file ;
 
 : copy-fonts ( bundle-name -- )
-    "fonts/" resource-path swap copy-tree ;
+    "fonts/" resource-path swap copy-tree-to ;
 
 : copy-dlls ( bundle-name -- )
-    { "freetype6.dll" "zlib1.dll" "factor-nt.dll" }
+    { "freetype6.dll" "zlib1.dll" "factor.dll" }
     [ resource-path ] map
     swap copy-files-to ;
 
@@ -30,10 +30,11 @@ TUPLE: windows-deploy-implementation ;
 T{ windows-deploy-implementation } deploy-implementation set-global
 
 M: windows-deploy-implementation deploy*
-    "." resource-path cd
+    "." resource-path [
         dup deploy-config [
             [ deploy-name get create-exe-dir ] keep
             [ deploy-name get image-name ] keep
             [ namespace make-deploy-image ] keep
             open-in-explorer
-    ] bind ;
+        ] bind
+    ] with-directory ;

extra/tools/disassembler/disassembler.factor

@@ -27,7 +27,7 @@ M: pair make-disassemble-cmd
         +closed+ +stdin+ set
         out-file +stdout+ set
         [ "gdb" , "-x" , in-file , "-batch" , ] { } make +arguments+ set
-    ] { } make-assoc run-process drop
+    ] { } make-assoc try-process
     out-file file-lines ;
 
 : tabs>spaces ( str -- str' )

extra/ui/tools/deploy/deploy.factor

@@ -34,9 +34,10 @@ TUPLE: deploy-gadget vocab settings ;
     "Advanced:" <label> gadget,
     deploy-compiler? get "Use optimizing compiler" <checkbox> gadget,
     deploy-math? get "Rational and complex number support" <checkbox> gadget,
-    deploy-word-props? get "Include word properties" <checkbox> gadget,
+    deploy-threads? get "Threading support" <checkbox> gadget,
-    deploy-word-defs? get "Include word definitions" <checkbox> gadget,
+    deploy-word-props? get "Retain all word properties" <checkbox> gadget,
-    deploy-c-types? get "Include C types" <checkbox> gadget, ;
+    deploy-word-defs? get "Retain all word definitions" <checkbox> gadget,
+    deploy-c-types? get "Retain all C types" <checkbox> gadget, ;
 
 : deploy-settings-theme
     { 10 10 } over set-pack-gap

extra/unix/stat/linux/32/32.factor

@@ -24,31 +24,10 @@ C-STRUCT: stat
     { "ulong"     "unused4" }
     { "ulong"     "unused5" } ;
 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 FUNCTION: int __xstat  ( int ver, char* pathname, stat* buf ) ;
 FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ;
 
 :  stat ( pathname buf -- int ) 3 -rot __xstat ;
 : lstat ( pathname buf -- int ) 3 -rot __lxstat ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: S_IFMT   OCT: 170000 ; ! These bits determine file type.
-
-: S_IFDIR  OCT:  40000 ;    ! Directory.
-: S_IFCHR  OCT:  20000 ;    ! Character device.
-: S_IFBLK  OCT:  60000 ;    ! Block device.
-: S_IFREG  OCT: 100000 ;    ! Regular file.
-: S_IFIFO  OCT: 010000 ;    ! FIFO.
-: S_IFLNK  OCT: 120000 ;    ! Symbolic link.
-: S_IFSOCK OCT: 140000 ;    ! Socket.
-
-: S_ISTYPE ( mode mask -- val ) >r S_IFMT bitand r> = ;
-
-: S_ISREG  ( mode -- value ) S_IFREG S_ISTYPE ;
-: S_ISDIR  ( mode -- value ) S_IFDIR S_ISTYPE ;
-: S_ISCHR  ( mode -- value ) S_IFCHR S_ISTYPE ;
-: S_ISBLK  ( mode -- value ) S_IFBLK S_ISTYPE ;
-: S_ISFIFO ( mode -- value ) S_IFIFO S_ISTYPE ;
-: S_ISLNK  ( mode -- value ) S_IFLNK S_ISTYPE ;
-: S_ISSOCK ( mode -- value ) S_IFSOCK S_ISTYPE ;
-

extra/unix/stat/linux/64/64.factor

@@ -29,26 +29,3 @@ FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ;
 
 :  stat ( pathname buf -- int ) 3 -rot __xstat ;
 : lstat ( pathname buf -- int ) 3 -rot __lxstat ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: S_IFMT   OCT: 170000 ; ! These bits determine file type.
-
-: S_IFDIR  OCT:  40000 ;    ! Directory.
-: S_IFCHR  OCT:  20000 ;    ! Character device.
-: S_IFBLK  OCT:  60000 ;    ! Block device.
-: S_IFREG  OCT: 100000 ;    ! Regular file.
-: S_IFIFO  OCT: 010000 ;    ! FIFO.
-: S_IFLNK  OCT: 120000 ;    ! Symbolic link.
-: S_IFSOCK OCT: 140000 ;    ! Socket.
-
-: S_ISTYPE ( mode mask -- val ) >r S_IFMT bitand r> = ;
-
-: S_ISREG  ( mode -- value ) S_IFREG S_ISTYPE ;
-: S_ISDIR  ( mode -- value ) S_IFDIR S_ISTYPE ;
-: S_ISCHR  ( mode -- value ) S_IFCHR S_ISTYPE ;
-: S_ISBLK  ( mode -- value ) S_IFBLK S_ISTYPE ;
-: S_ISFIFO ( mode -- value ) S_IFIFO S_ISTYPE ;
-: S_ISLNK  ( mode -- value ) S_IFLNK S_ISTYPE ;
-: S_ISSOCK ( mode -- value ) S_IFSOCK S_ISTYPE ;
-

extra/unix/stat/macosx/macosx.factor

@@ -27,26 +27,3 @@ C-STRUCT: stat
 
 FUNCTION: int stat  ( char* pathname, stat* buf ) ;
 FUNCTION: int lstat ( char* pathname, stat* buf ) ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: S_IFMT   OCT: 170000 ; ! These bits determine file type.
-
-: S_IFDIR  OCT:  40000 ;    ! Directory.
-: S_IFCHR  OCT:  20000 ;    ! Character device.
-: S_IFBLK  OCT:  60000 ;    ! Block device.
-: S_IFREG  OCT: 100000 ;    ! Regular file.
-: S_IFIFO  OCT: 010000 ;    ! FIFO.
-: S_IFLNK  OCT: 120000 ;    ! Symbolic link.
-: S_IFSOCK OCT: 140000 ;    ! Socket.
-
-: S_ISTYPE ( mode mask -- val ) >r S_IFMT bitand r> = ;
-
-: S_ISREG  ( mode -- value ) S_IFREG S_ISTYPE ;
-: S_ISDIR  ( mode -- value ) S_IFDIR S_ISTYPE ;
-: S_ISCHR  ( mode -- value ) S_IFCHR S_ISTYPE ;
-: S_ISBLK  ( mode -- value ) S_IFBLK S_ISTYPE ;
-: S_ISFIFO ( mode -- value ) S_IFIFO S_ISTYPE ;
-: S_ISLNK  ( mode -- value ) S_IFLNK S_ISTYPE ;
-: S_ISSOCK ( mode -- value ) S_IFSOCK S_ISTYPE ;
-

extra/unix/stat/stat.factor

@@ -1,8 +1,62 @@
 
-USING: system combinators vocabs.loader ;
+USING: kernel system combinators alien.syntax math vocabs.loader ;
 
 IN: unix.stat
 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! File Types
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: S_IFMT   OCT: 170000 ; ! These bits determine file type.
+
+: S_IFDIR  OCT:  40000 ;    ! Directory.
+: S_IFCHR  OCT:  20000 ;    ! Character device.
+: S_IFBLK  OCT:  60000 ;    ! Block device.
+: S_IFREG  OCT: 100000 ;    ! Regular file.
+: S_IFIFO  OCT: 010000 ;    ! FIFO.
+: S_IFLNK  OCT: 120000 ;    ! Symbolic link.
+: S_IFSOCK OCT: 140000 ;    ! Socket.
+
+: S_ISTYPE ( mode mask -- val ) >r S_IFMT bitand r> = ;
+
+: S_ISREG  ( mode -- value ) S_IFREG S_ISTYPE ;
+: S_ISDIR  ( mode -- value ) S_IFDIR S_ISTYPE ;
+: S_ISCHR  ( mode -- value ) S_IFCHR S_ISTYPE ;
+: S_ISBLK  ( mode -- value ) S_IFBLK S_ISTYPE ;
+: S_ISFIFO ( mode -- value ) S_IFIFO S_ISTYPE ;
+: S_ISLNK  ( mode -- value ) S_IFLNK S_ISTYPE ;
+: S_ISSOCK ( mode -- value ) S_IFSOCK S_ISTYPE ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! File Access Permissions
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! Read, write, execute/search by owner
+: S_IRWXU OCT: 0000700 ; inline    ! rwx mask owner
+: S_IRUSR OCT: 0000400 ; inline    ! r owner
+: S_IWUSR OCT: 0000200 ; inline    ! w owner
+: S_IXUSR OCT: 0000100 ; inline    ! x owner
+! Read, write, execute/search by group
+: S_IRWXG OCT: 0000070 ; inline    ! rwx mask group
+: S_IRGRP OCT: 0000040 ; inline    ! r group
+: S_IWGRP OCT: 0000020 ; inline    ! w group
+: S_IXGRP OCT: 0000010 ; inline    ! x group
+! Read, write, execute/search by others
+: S_IRWXO OCT: 0000007 ; inline    ! rwx mask other
+: S_IROTH OCT: 0000004 ; inline    ! r other
+: S_IWOTH OCT: 0000002 ; inline    ! w other
+: S_IXOTH OCT: 0000001 ; inline    ! x other
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+FUNCTION: int chmod ( char* path, mode_t mode ) ;
+
+FUNCTION: int fchmod ( int fd, mode_t mode ) ;
+
+FUNCTION: int mkdir ( char* path, mode_t mode ) ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 {
   { [ linux? ] [ "unix.stat.linux" require ] }
   { [ t      ] [                           ] }

extra/unix/types/linux/linux.factor

@@ -7,9 +7,9 @@ IN: unix.types
 
 TYPEDEF: ulonglong __uquad_type
 TYPEDEF: ulong     __ulongword_type
-TYPEDEF: uint      __uword_type
+TYPEDEF: long      __sword_type
+TYPEDEF: ulong     __uword_type
 TYPEDEF: long      __slongword_type
-TYPEDEF: int       __sword_type
 TYPEDEF: uint      __u32_type
 TYPEDEF: int       __s32_type 
 

extra/unix/types/macosx/macosx.factor

@@ -1,4 +1,6 @@
 
+USING: alien.syntax ;
+
 IN: unix.types
 
 ! Darwin 9.1.0 ppc

extra/unix/unix.factor

@@ -1,37 +1,15 @@
 ! Copyright (C) 2005, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-IN: unix
+
 USING: alien alien.c-types alien.syntax kernel libc structs
-math namespaces system combinators vocabs.loader ;
+math namespaces system combinators vocabs.loader unix.types ;
 
-! ! ! Unix types
+IN: unix
 
-TYPEDEF:  long  word
-TYPEDEF: ulong uword
-
-TYPEDEF:  long longword
-TYPEDEF: ulong ulongword
-
-TYPEDEF: long ssize_t
-TYPEDEF: longword blksize_t
-TYPEDEF: longword blkcnt_t
-TYPEDEF: longlong quad_t
-TYPEDEF: ulonglong dev_t
-TYPEDEF: uint gid_t
 TYPEDEF: uint in_addr_t
-TYPEDEF: ulong ino_t
-TYPEDEF: int pid_t
 TYPEDEF: uint socklen_t
 TYPEDEF: uint time_t
-TYPEDEF: uint uid_t
 TYPEDEF: ulong size_t
-TYPEDEF: ulong u_long
-TYPEDEF: uint mode_t
-TYPEDEF: uword nlink_t
-TYPEDEF: void* caddr_t
-
-TYPEDEF: ulong off_t
-TYPEDEF-IF: bsd? ulonglong off_t
 
 C-STRUCT: tm
     { "int" "sec" }    ! Seconds: 0-59 (K&R says 0-61?)
@@ -56,41 +34,6 @@ C-STRUCT: timespec
     [ set-timespec-nsec ] keep
     [ set-timespec-sec ] keep ;
 
-! ! ! Unix constants
-
-! File type
-: S_IFMT    OCT: 0170000 ; inline ! type of file
-: S_IFIFO   OCT: 0010000 ; inline ! named pipe (fifo)
-: S_IFCHR   OCT: 0020000 ; inline ! character special
-: S_IFDIR   OCT: 0040000 ; inline ! directory
-: S_IFBLK   OCT: 0060000 ; inline ! block special
-: S_IFREG   OCT: 0100000 ; inline ! regular
-: S_IFLNK   OCT: 0120000 ; inline ! symbolic link
-: S_IFSOCK  OCT: 0140000 ; inline ! socket
-: S_IFWHT   OCT: 0160000 ; inline ! whiteout
-: S_IFXATTR OCT: 0200000 ; inline ! extended attribute
-
-! File mode
-! Read, write, execute/search by owner
-: S_IRWXU OCT: 0000700 ; inline    ! rwx mask owner
-: S_IRUSR OCT: 0000400 ; inline    ! r owner
-: S_IWUSR OCT: 0000200 ; inline    ! w owner
-: S_IXUSR OCT: 0000100 ; inline    ! x owner
-! Read, write, execute/search by group
-: S_IRWXG OCT: 0000070 ; inline    ! rwx mask group
-: S_IRGRP OCT: 0000040 ; inline    ! r group
-: S_IWGRP OCT: 0000020 ; inline    ! w group
-: S_IXGRP OCT: 0000010 ; inline    ! x group
-! Read, write, execute/search by others
-: S_IRWXO OCT: 0000007 ; inline    ! rwx mask other
-: S_IROTH OCT: 0000004 ; inline    ! r other
-: S_IWOTH OCT: 0000002 ; inline    ! w other
-: S_IXOTH OCT: 0000001 ; inline    ! x other
-
-: S_ISUID OCT: 0004000 ; inline    ! set user id on execution
-: S_ISGID OCT: 0002000 ; inline    ! set group id on execution
-: S_ISVTX OCT: 0001000 ; inline    ! sticky bit
-
 : PROT_NONE   0 ; inline
 : PROT_READ   1 ; inline
 : PROT_WRITE  2 ; inline
@@ -113,7 +56,6 @@ LIBRARY: libc
 FUNCTION: int accept ( int s, void* sockaddr, socklen_t* socklen ) ;
 FUNCTION: int bind ( int s, void* name, socklen_t namelen ) ;
 FUNCTION: int chdir ( char* path ) ;
-FUNCTION: int chmod ( char* path, mode_t mode ) ;
 FUNCTION: int chown ( char* path, uid_t owner, gid_t group ) ;
 FUNCTION: int chroot ( char* path ) ;
 FUNCTION: void close ( int fd ) ;
@@ -124,7 +66,6 @@ FUNCTION: int execv ( char* path, char** argv ) ;
 FUNCTION: int execvp ( char* path, char** argv ) ;
 FUNCTION: int execve ( char* path, char** argv, char** envp ) ;
 FUNCTION: int fchdir ( int fd ) ;
-FUNCTION: int fchmod ( int fd, mode_t mode ) ;
 FUNCTION: int fchown ( int fd, uid_t owner, gid_t group ) ;
 FUNCTION: int fcntl ( int fd, int cmd, int arg ) ;
 FUNCTION: int flock ( int fd, int operation ) ;
@@ -150,7 +91,6 @@ FUNCTION: int lchown ( char* path, uid_t owner, gid_t group ) ;
 FUNCTION: int listen ( int s, int backlog ) ;
 FUNCTION: tm* localtime ( time_t* clock ) ;
 FUNCTION: off_t lseek ( int fildes, off_t offset, int whence ) ;
-FUNCTION: int mkdir ( char* path, mode_t mode ) ;
 FUNCTION: void* mmap ( void* addr, size_t len, int prot, int flags, int fd, off_t offset ) ;
 FUNCTION: int munmap ( void* addr, size_t len ) ;
 FUNCTION: uint ntohl ( uint n ) ;

vm/image.c

@@ -161,6 +161,9 @@ DEFINE_PRIMITIVE(save_image_and_exit)
 	for(i = 0; i < FIRST_SAVE_ENV; i++)
 		userenv[i] = F;
 
+	for(i = LAST_SAVE_ENV + 1; i < USER_ENV; i++)
+		userenv[i] = F;
+
 	/* do a full GC + code heap compaction */
 	compact_code_heap();
 

vm/run.h

@@ -64,6 +64,7 @@ typedef enum {
 } F_ENVTYPE;
 
 #define FIRST_SAVE_ENV BOOT_ENV
+#define LAST_SAVE_ENV STAGE2_ENV
 
 /* TAGGED user environment data; see getenv/setenv prims */
 DLLEXPORT CELL userenv[USER_ENV];