Merge branch 'master' of git://factorcode.org/git/factor
Slava Pestov
commit
80c570999b
|
|
@ -2,16 +2,16 @@ USING: help.markup help.syntax math ;
|
|||
IN: io.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." } ;
|
||||
|
||||
HELP: file-crc32
|
||||
{ $values { "path" "a pathname string" } { "n" integer } }
|
||||
{ $description "Computes the CRC32 checksum of a file's contents." } ;
|
||||
HELP: lines-crc32
|
||||
{ $values { "lines" "a sequence of strings" } { "n" integer } }
|
||||
{ $description "Computes the CRC32 checksum of a sequence of lines of bytes." } ;
|
||||
|
||||
ARTICLE: "io.crc32" "CRC32 checksum calculation"
|
||||
"The CRC32 checksum algorithm provides a quick but unreliable way to detect changes in data."
|
||||
{ $subsection crc32 }
|
||||
{ $subsection file-crc32 } ;
|
||||
{ $subsection lines-crc32 } ;
|
||||
|
||||
ABOUT: "io.crc32"
|
||||
|
|
|
|||
|
|
@ -23,8 +23,6 @@ IN: io.crc32
|
|||
: crc32 ( seq -- n )
|
||||
>r HEX: ffffffff dup r> [ (crc32) ] each bitxor ;
|
||||
|
||||
: file-crc32 ( path -- n ) file-contents crc32 ;
|
||||
|
||||
: lines-crc32 ( seq -- n )
|
||||
HEX: ffffffff tuck [
|
||||
[ (crc32) ] each CHAR: \n (crc32)
|
||||
|
|
|
|||
|
|
@ -74,3 +74,10 @@ M: object <file-writer>
|
|||
|
||||
M: object <file-appender>
|
||||
"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 -- ? )
|
||||
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 -- ? )
|
||||
dup source-files get at [
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ TUPLE: monitor queue closed? ;
|
|||
set-monitor-queue
|
||||
} monitor construct ;
|
||||
|
||||
HOOK: fill-queue io-backend ( monitor -- assoc )
|
||||
HOOK: fill-queue io-backend ( monitor -- )
|
||||
|
||||
: changed-file ( changed path -- )
|
||||
namespace [ append ] change-at ;
|
||||
|
|
@ -32,7 +32,7 @@ HOOK: <monitor> io-backend ( path recursive? -- monitor )
|
|||
: next-change ( monitor -- path changed )
|
||||
dup check-monitor
|
||||
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 ;
|
||||
|
||||
SYMBOL: +add-file+
|
||||
|
|
|
|||
|
|
@ -54,21 +54,22 @@ TUPLE: inotify watches ;
|
|||
M: linux-io <monitor> ( path recursive? -- monitor )
|
||||
drop IN_CHANGE_EVENTS add-watch ;
|
||||
|
||||
: notify-callback ( assoc monitor -- )
|
||||
linux-monitor-callback dup
|
||||
[ schedule-thread-with ] [ 2drop ] if ;
|
||||
: notify-callback ( monitor -- )
|
||||
dup linux-monitor-callback
|
||||
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 [
|
||||
"Cannot wait for changes on the same file from multiple threads" throw
|
||||
] when
|
||||
[ swap set-linux-monitor-callback stop ] callcc1
|
||||
swap check-monitor ;
|
||||
[ swap set-linux-monitor-callback stop ] callcc0
|
||||
check-monitor ;
|
||||
|
||||
M: linux-monitor dispose ( monitor -- )
|
||||
dup check-monitor
|
||||
t over set-monitor-closed?
|
||||
H{ } over notify-callback
|
||||
dup notify-callback
|
||||
remove-watch ;
|
||||
|
||||
: ?flag ( n mask symbol -- n )
|
||||
|
|
@ -106,13 +107,13 @@ M: linux-monitor dispose ( monitor -- )
|
|||
inotify-event-len "inotify-event" heap-size +
|
||||
swap >r + r> ;
|
||||
|
||||
: wd>queue ( wd -- queue )
|
||||
inotify-event-wd wd>monitor monitor-queue ;
|
||||
|
||||
: parse-file-notifications ( i buffer -- )
|
||||
2dup events-exhausted? [ 2drop ] [
|
||||
2dup inotify-event@ dup inotify-event-wd wd>queue
|
||||
[ parse-file-notify changed-file ] bind
|
||||
2dup inotify-event@ dup inotify-event-wd wd>monitor [
|
||||
monitor-queue [
|
||||
parse-file-notify changed-file
|
||||
] bind
|
||||
] keep notify-callback
|
||||
next-event parse-file-notifications
|
||||
] if ;
|
||||
|
||||
|
|
@ -135,7 +136,7 @@ M: inotify-task do-io-task ( task -- )
|
|||
io-task-port read-notifications f ;
|
||||
|
||||
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
|
||||
|
||||
|
|
|
|||
|
|
@ -78,6 +78,7 @@ M: windows-nt-io <monitor> ( path recursive? -- monitor )
|
|||
dup FILE_NOTIFY_INFORMATION-NextEntryOffset dup zero?
|
||||
[ 3drop ] [ swap <displaced-alien> (changed-files) ] if ;
|
||||
|
||||
M: windows-nt-io fill-queue ( monitor -- assoc )
|
||||
dup win32-monitor-path over buffer-ptr rot read-changes
|
||||
[ zero? [ 2drop ] [ (changed-files) ] if ] H{ } make-assoc ;
|
||||
M: windows-nt-io fill-queue ( monitor -- )
|
||||
dup win32-monitor-path over buffer-ptr pick read-changes
|
||||
[ 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 ;
|
||||
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 ( -- )
|
||||
"Stripping startup hooks" show
|
||||
"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.
|
||||
IN: unix
|
||||
USING: alien.syntax ;
|
||||
|
||||
TYPEDEF: ulong off_t
|
||||
|
||||
! Linux.
|
||||
|
||||
: O_RDONLY HEX: 0000 ; inline
|
||||
|
|
|
|||
|
|
@ -3,8 +3,6 @@
|
|||
IN: unix
|
||||
USING: alien.syntax system kernel ;
|
||||
|
||||
TYPEDEF: ulong off_t
|
||||
|
||||
! Solaris.
|
||||
|
||||
: O_RDONLY HEX: 0000 ; inline
|
||||
|
|
|
|||
|
|
@ -19,11 +19,13 @@ TYPEDEF: uint time_t
|
|||
TYPEDEF: uint uid_t
|
||||
TYPEDEF: ulong size_t
|
||||
TYPEDEF: ulong u_long
|
||||
TYPEDEF: ulonglong off_t
|
||||
TYPEDEF: ushort mode_t
|
||||
TYPEDEF: ushort 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?)
|
||||
{ "int" "min" } ! Minutes: 0-59
|
||||
|
|
|
|||
Loading…
Reference in New Issue