Merge branch 'master' of git://factorcode.org/git/factor
						commit
						d779ce0a78
					
				| 
						 | 
					@ -2,16 +2,16 @@ USING: help.markup help.syntax math ;
 | 
				
			||||||
IN: io.crc32
 | 
					IN: io.crc32
 | 
				
			||||||
 | 
					
 | 
				
			||||||
HELP: crc32
 | 
					HELP: crc32
 | 
				
			||||||
{ $values { "seq" "a sequence" } { "n" integer } }
 | 
					{ $values { "seq" "a sequence of bytes" } { "n" integer } }
 | 
				
			||||||
{ $description "Computes the CRC32 checksum of a sequence of bytes." } ;
 | 
					{ $description "Computes the CRC32 checksum of a sequence of bytes." } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
HELP: file-crc32
 | 
					HELP: lines-crc32
 | 
				
			||||||
{ $values { "path" "a pathname string" } { "n" integer } }
 | 
					{ $values { "lines" "a sequence of strings" } { "n" integer } }
 | 
				
			||||||
{ $description "Computes the CRC32 checksum of a file's contents." } ;
 | 
					{ $description "Computes the CRC32 checksum of a sequence of lines of bytes." } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
ARTICLE: "io.crc32" "CRC32 checksum calculation"
 | 
					ARTICLE: "io.crc32" "CRC32 checksum calculation"
 | 
				
			||||||
"The CRC32 checksum algorithm provides a quick but unreliable way to detect changes in data."
 | 
					"The CRC32 checksum algorithm provides a quick but unreliable way to detect changes in data."
 | 
				
			||||||
{ $subsection crc32 }
 | 
					{ $subsection crc32 }
 | 
				
			||||||
{ $subsection file-crc32 } ;
 | 
					{ $subsection lines-crc32 } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
ABOUT: "io.crc32"
 | 
					ABOUT: "io.crc32"
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -23,8 +23,6 @@ IN: io.crc32
 | 
				
			||||||
: crc32 ( seq -- n )
 | 
					: crc32 ( seq -- n )
 | 
				
			||||||
    >r HEX: ffffffff dup r> [ (crc32) ] each bitxor ;
 | 
					    >r HEX: ffffffff dup r> [ (crc32) ] each bitxor ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: file-crc32 ( path -- n ) file-contents crc32 ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
: lines-crc32 ( seq -- n )
 | 
					: lines-crc32 ( seq -- n )
 | 
				
			||||||
    HEX: ffffffff tuck [
 | 
					    HEX: ffffffff tuck [
 | 
				
			||||||
        [ (crc32) ] each CHAR: \n (crc32)
 | 
					        [ (crc32) ] each CHAR: \n (crc32)
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -74,3 +74,10 @@ M: object <file-writer>
 | 
				
			||||||
 | 
					
 | 
				
			||||||
M: object <file-appender>
 | 
					M: object <file-appender>
 | 
				
			||||||
    "ab" fopen <c-writer> <plain-writer> ;
 | 
					    "ab" fopen <c-writer> <plain-writer> ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					: show ( msg -- )
 | 
				
			||||||
 | 
					    #! A word which directly calls primitives. It is used to
 | 
				
			||||||
 | 
					    #! print stuff from contexts where the I/O system would
 | 
				
			||||||
 | 
					    #! otherwise not work (tools.deploy.shaker, the I/O
 | 
				
			||||||
 | 
					    #! multiplexer thread).
 | 
				
			||||||
 | 
					    "\r\n" append stdout-handle fwrite stdout-handle fflush ;
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -17,7 +17,7 @@ uses definitions ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: (source-modified?) ( path modified checksum -- ? )
 | 
					: (source-modified?) ( path modified checksum -- ? )
 | 
				
			||||||
    pick file-modified rot [ 0 or ] 2apply >
 | 
					    pick file-modified rot [ 0 or ] 2apply >
 | 
				
			||||||
    [ swap file-crc32 number= not ] [ 2drop f ] if ;
 | 
					    [ swap file-lines lines-crc32 = not ] [ 2drop f ] if ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: source-modified? ( path -- ? )
 | 
					: source-modified? ( path -- ? )
 | 
				
			||||||
    dup source-files get at [
 | 
					    dup source-files get at [
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -17,7 +17,7 @@ TUPLE: monitor queue closed? ;
 | 
				
			||||||
        set-monitor-queue
 | 
					        set-monitor-queue
 | 
				
			||||||
    } monitor construct ;
 | 
					    } monitor construct ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
HOOK: fill-queue io-backend ( monitor -- assoc )
 | 
					HOOK: fill-queue io-backend ( monitor -- )
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: changed-file ( changed path -- )
 | 
					: changed-file ( changed path -- )
 | 
				
			||||||
    namespace [ append ] change-at ;
 | 
					    namespace [ append ] change-at ;
 | 
				
			||||||
| 
						 | 
					@ -32,7 +32,7 @@ HOOK: <monitor> io-backend ( path recursive? -- monitor )
 | 
				
			||||||
: next-change ( monitor -- path changed )
 | 
					: next-change ( monitor -- path changed )
 | 
				
			||||||
    dup check-monitor
 | 
					    dup check-monitor
 | 
				
			||||||
    dup monitor-queue dup assoc-empty? [
 | 
					    dup monitor-queue dup assoc-empty? [
 | 
				
			||||||
        drop dup fill-queue over set-monitor-queue next-change
 | 
					        drop dup fill-queue next-change
 | 
				
			||||||
    ] [ nip dequeue-change ] if ;
 | 
					    ] [ nip dequeue-change ] if ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
SYMBOL: +add-file+
 | 
					SYMBOL: +add-file+
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -54,21 +54,22 @@ TUPLE: inotify watches ;
 | 
				
			||||||
M: linux-io <monitor> ( path recursive? -- monitor )
 | 
					M: linux-io <monitor> ( path recursive? -- monitor )
 | 
				
			||||||
    drop IN_CHANGE_EVENTS add-watch ;
 | 
					    drop IN_CHANGE_EVENTS add-watch ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: notify-callback ( assoc monitor -- )
 | 
					: notify-callback ( monitor -- )
 | 
				
			||||||
    linux-monitor-callback dup
 | 
					    dup linux-monitor-callback
 | 
				
			||||||
    [ schedule-thread-with ] [ 2drop ] if ;
 | 
					    f rot set-linux-monitor-callback
 | 
				
			||||||
 | 
					    [ schedule-thread ] when* ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
M: linux-io fill-queue ( monitor -- assoc )
 | 
					M: linux-io fill-queue ( monitor -- )
 | 
				
			||||||
    dup linux-monitor-callback [
 | 
					    dup linux-monitor-callback [
 | 
				
			||||||
        "Cannot wait for changes on the same file from multiple threads" throw
 | 
					        "Cannot wait for changes on the same file from multiple threads" throw
 | 
				
			||||||
    ] when
 | 
					    ] when
 | 
				
			||||||
    [ swap set-linux-monitor-callback stop ] callcc1
 | 
					    [ swap set-linux-monitor-callback stop ] callcc0
 | 
				
			||||||
    swap check-monitor ;
 | 
					    check-monitor ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
M: linux-monitor dispose ( monitor -- )
 | 
					M: linux-monitor dispose ( monitor -- )
 | 
				
			||||||
    dup check-monitor
 | 
					    dup check-monitor
 | 
				
			||||||
    t over set-monitor-closed?
 | 
					    t over set-monitor-closed?
 | 
				
			||||||
    H{ } over notify-callback
 | 
					    dup notify-callback
 | 
				
			||||||
    remove-watch ;
 | 
					    remove-watch ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: ?flag ( n mask symbol -- n )
 | 
					: ?flag ( n mask symbol -- n )
 | 
				
			||||||
| 
						 | 
					@ -106,13 +107,13 @@ M: linux-monitor dispose ( monitor -- )
 | 
				
			||||||
    inotify-event-len "inotify-event" heap-size +
 | 
					    inotify-event-len "inotify-event" heap-size +
 | 
				
			||||||
    swap >r + r> ;
 | 
					    swap >r + r> ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: wd>queue ( wd -- queue )
 | 
					 | 
				
			||||||
    inotify-event-wd wd>monitor monitor-queue ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
: parse-file-notifications ( i buffer -- )
 | 
					: parse-file-notifications ( i buffer -- )
 | 
				
			||||||
    2dup events-exhausted? [ 2drop ] [
 | 
					    2dup events-exhausted? [ 2drop ] [
 | 
				
			||||||
        2dup inotify-event@ dup inotify-event-wd wd>queue
 | 
					        2dup inotify-event@ dup inotify-event-wd wd>monitor [
 | 
				
			||||||
        [ parse-file-notify changed-file ] bind
 | 
					            monitor-queue [
 | 
				
			||||||
 | 
					                parse-file-notify changed-file
 | 
				
			||||||
 | 
					            ] bind
 | 
				
			||||||
 | 
					        ] keep notify-callback
 | 
				
			||||||
        next-event parse-file-notifications
 | 
					        next-event parse-file-notifications
 | 
				
			||||||
    ] if ;
 | 
					    ] if ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -135,7 +136,7 @@ M: inotify-task do-io-task ( task -- )
 | 
				
			||||||
    io-task-port read-notifications f ;
 | 
					    io-task-port read-notifications f ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
M: linux-io init-io ( -- )
 | 
					M: linux-io init-io ( -- )
 | 
				
			||||||
    <select-mx> mx set-global ; ! init-inotify ;
 | 
					    <select-mx> dup mx set-global init-inotify ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
T{ linux-io } set-io-backend
 | 
					T{ linux-io } set-io-backend
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -78,6 +78,7 @@ M: windows-nt-io <monitor> ( path recursive? -- monitor )
 | 
				
			||||||
    dup FILE_NOTIFY_INFORMATION-NextEntryOffset dup zero?
 | 
					    dup FILE_NOTIFY_INFORMATION-NextEntryOffset dup zero?
 | 
				
			||||||
    [ 3drop ] [ swap <displaced-alien> (changed-files) ] if ;
 | 
					    [ 3drop ] [ swap <displaced-alien> (changed-files) ] if ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
M: windows-nt-io fill-queue ( monitor -- assoc )
 | 
					M: windows-nt-io fill-queue ( monitor -- )
 | 
				
			||||||
    dup win32-monitor-path over buffer-ptr rot read-changes
 | 
					    dup win32-monitor-path over buffer-ptr pick read-changes
 | 
				
			||||||
    [ zero? [ 2drop ] [ (changed-files) ] if ] H{ } make-assoc ;
 | 
					    [ zero? [ 2drop ] [ (changed-files) ] if ] H{ } make-assoc
 | 
				
			||||||
 | 
					    swap set-monitor-queue ;
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -8,11 +8,6 @@ debugger io.streams.c io.streams.duplex io.files io.backend
 | 
				
			||||||
quotations words.private tools.deploy.config compiler.units ;
 | 
					quotations words.private tools.deploy.config compiler.units ;
 | 
				
			||||||
IN: tools.deploy.shaker
 | 
					IN: tools.deploy.shaker
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: show ( msg -- )
 | 
					 | 
				
			||||||
    #! Use primitives directly so that we can print stuff even
 | 
					 | 
				
			||||||
    #! after most of the image has been stripped away
 | 
					 | 
				
			||||||
    "\r\n" append stdout-handle fwrite stdout-handle fflush ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
: strip-init-hooks ( -- )
 | 
					: strip-init-hooks ( -- )
 | 
				
			||||||
    "Stripping startup hooks" show
 | 
					    "Stripping startup hooks" show
 | 
				
			||||||
    "command-line" init-hooks get delete-at
 | 
					    "command-line" init-hooks get delete-at
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -1,10 +1,8 @@
 | 
				
			||||||
! Copyright (C) 2005 Slava Pestov.
 | 
					! Copyright (C) 2005, 2008 Slava Pestov.
 | 
				
			||||||
! See http://factorcode.org/license.txt for BSD license.
 | 
					! See http://factorcode.org/license.txt for BSD license.
 | 
				
			||||||
IN: unix
 | 
					IN: unix
 | 
				
			||||||
USING: alien.syntax ;
 | 
					USING: alien.syntax ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
TYPEDEF: ulong off_t
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
! Linux.
 | 
					! Linux.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: O_RDONLY  HEX: 0000 ; inline
 | 
					: O_RDONLY  HEX: 0000 ; inline
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -3,8 +3,6 @@
 | 
				
			||||||
IN: unix
 | 
					IN: unix
 | 
				
			||||||
USING: alien.syntax system kernel ;
 | 
					USING: alien.syntax system kernel ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
TYPEDEF: ulong off_t
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
! Solaris.
 | 
					! Solaris.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: O_RDONLY  HEX: 0000 ; inline
 | 
					: O_RDONLY  HEX: 0000 ; inline
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -19,11 +19,13 @@ TYPEDEF: uint time_t
 | 
				
			||||||
TYPEDEF: uint uid_t
 | 
					TYPEDEF: uint uid_t
 | 
				
			||||||
TYPEDEF: ulong size_t
 | 
					TYPEDEF: ulong size_t
 | 
				
			||||||
TYPEDEF: ulong u_long
 | 
					TYPEDEF: ulong u_long
 | 
				
			||||||
TYPEDEF: ulonglong off_t
 | 
					 | 
				
			||||||
TYPEDEF: ushort mode_t
 | 
					TYPEDEF: ushort mode_t
 | 
				
			||||||
TYPEDEF: ushort nlink_t
 | 
					TYPEDEF: ushort nlink_t
 | 
				
			||||||
TYPEDEF: void* caddr_t
 | 
					TYPEDEF: void* caddr_t
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					TYPEDEF: ulong off_t
 | 
				
			||||||
 | 
					TYPEDEF-IF: bsd? ulonglong off_t
 | 
				
			||||||
 | 
					
 | 
				
			||||||
C-STRUCT: tm
 | 
					C-STRUCT: tm
 | 
				
			||||||
    { "int" "sec" }    ! Seconds: 0-59 (K&R says 0-61?)
 | 
					    { "int" "sec" }    ! Seconds: 0-59 (K&R says 0-61?)
 | 
				
			||||||
    { "int" "min" }    ! Minutes: 0-59
 | 
					    { "int" "min" }    ! Minutes: 0-59
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue