2008-12-14 21:03:00 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								USING: unix byte-arrays kernel io.backend.unix math.bitwise
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								io.ports io.files io.files.private io.pathnames environment
							 | 
						
					
						
							
								
									
										
										
										
											2010-04-01 15:43:27 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								destructors system unix.ffi literals ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-14 21:03:00 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: io.files.unix
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: unix cwd ( -- path )
							 | 
						
					
						
							
								
									
										
										
										
											2010-01-19 17:53:15 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    MAXPATHLEN [ <byte-array> ] keep
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ getcwd ] unix-system-call
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-14 21:03:00 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ (io-error) ] unless* ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: unix cd ( path -- ) [ chdir ] unix-system-call drop ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2010-04-01 15:43:27 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: read-flags flags{ O_RDONLY }
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-14 21:03:00 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2010-04-01 15:43:27 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: open-read ( path -- fd ) read-flags file-mode open-file ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-14 21:03:00 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: unix (file-reader) ( path -- stream )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    open-read <fd> init-fd <input-port> ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2010-04-01 15:43:27 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: write-flags flags{ O_WRONLY O_CREAT O_TRUNC }
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-14 21:03:00 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: open-write ( path -- fd )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    write-flags file-mode open-file ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: unix (file-writer) ( path -- stream )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    open-write <fd> init-fd <output-port> ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2010-04-01 15:43:27 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								CONSTANT: append-flags flags{ O_WRONLY O_APPEND O_CREAT }
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-14 21:03:00 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: open-append ( path -- fd )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        append-flags file-mode open-file |dispose
							 | 
						
					
						
							
								
									
										
										
										
											2010-01-23 10:07:35 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        dup 0 SEEK_END [ lseek ] unix-system-call drop
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-14 21:03:00 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] with-destructors ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: unix (file-appender) ( path -- stream )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    open-append <fd> init-fd <output-port> ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: unix home "HOME" os-env ;
							 |