Merge branch 'master' of git://factorcode.org/git/factor
commit
f864d51255
|
@ -5,7 +5,7 @@ cpu.x86.architecture cpu.x86.intrinsics cpu.x86.allot
|
||||||
cpu.architecture kernel kernel.private math namespaces sequences
|
cpu.architecture kernel kernel.private math namespaces sequences
|
||||||
generator.registers generator.fixup generator system layouts
|
generator.registers generator.fixup generator system layouts
|
||||||
alien.compiler combinators command-line
|
alien.compiler combinators command-line
|
||||||
compiler compiler.units io vocabs.loader accessors ;
|
compiler compiler.units io vocabs.loader accessors init ;
|
||||||
IN: cpu.x86.32
|
IN: cpu.x86.32
|
||||||
|
|
||||||
! We implement the FFI for Linux, OS X and Windows all at once.
|
! We implement the FFI for Linux, OS X and Windows all at once.
|
||||||
|
@ -262,9 +262,11 @@ os windows? [
|
||||||
4 "double" c-type set-c-type-align
|
4 "double" c-type set-c-type-align
|
||||||
] unless
|
] unless
|
||||||
|
|
||||||
: sse2? ( -- ? ) "Intrinsic" throw ;
|
: (sse2?) ( -- ? ) "Intrinsic" throw ;
|
||||||
|
|
||||||
\ sse2? [
|
<<
|
||||||
|
|
||||||
|
\ (sse2?) [
|
||||||
{ EAX EBX ECX EDX } [ PUSH ] each
|
{ EAX EBX ECX EDX } [ PUSH ] each
|
||||||
EAX 1 MOV
|
EAX 1 MOV
|
||||||
CPUID
|
CPUID
|
||||||
|
@ -274,6 +276,10 @@ os windows? [
|
||||||
JE
|
JE
|
||||||
] { } define-if-intrinsic
|
] { } define-if-intrinsic
|
||||||
|
|
||||||
|
>>
|
||||||
|
|
||||||
|
: sse2? ( -- ? ) (sse2?) ;
|
||||||
|
|
||||||
"-no-sse2" cli-args member? [
|
"-no-sse2" cli-args member? [
|
||||||
"Checking if your CPU supports SSE2..." print flush
|
"Checking if your CPU supports SSE2..." print flush
|
||||||
[ optimized-recompile-hook ] recompile-hook [
|
[ optimized-recompile-hook ] recompile-hook [
|
||||||
|
@ -282,6 +288,14 @@ os windows? [
|
||||||
[
|
[
|
||||||
" - yes" print
|
" - yes" print
|
||||||
"cpu.x86.sse2" require
|
"cpu.x86.sse2" require
|
||||||
|
[
|
||||||
|
sse2? [
|
||||||
|
"This image was built to use SSE2, which your CPU does not support." print
|
||||||
|
"You will need to bootstrap Factor again." print
|
||||||
|
flush
|
||||||
|
1 exit
|
||||||
|
] unless
|
||||||
|
] "cpu.x86" add-init-hook
|
||||||
] [
|
] [
|
||||||
" - no" print
|
" - no" print
|
||||||
] if
|
] if
|
||||||
|
|
|
@ -1,7 +1,8 @@
|
||||||
IN: io.files.tests
|
IN: io.files.tests
|
||||||
USING: tools.test io.files io.files.private io threads kernel
|
USING: tools.test io.files io.files.private io threads kernel
|
||||||
continuations io.encodings.ascii io.files.unique sequences
|
continuations io.encodings.ascii io.files.unique sequences
|
||||||
strings accessors io.encodings.utf8 math destructors ;
|
strings accessors io.encodings.utf8 math destructors
|
||||||
|
namespaces ;
|
||||||
|
|
||||||
\ exists? must-infer
|
\ exists? must-infer
|
||||||
\ (exists?) must-infer
|
\ (exists?) must-infer
|
||||||
|
@ -276,3 +277,12 @@ strings accessors io.encodings.utf8 math destructors ;
|
||||||
|
|
||||||
[ "touch-twice-test" temp-file delete-file ] ignore-errors
|
[ "touch-twice-test" temp-file delete-file ] ignore-errors
|
||||||
[ ] [ 2 [ "touch-twice-test" temp-file touch-file ] times ] unit-test
|
[ ] [ 2 [ "touch-twice-test" temp-file touch-file ] times ] unit-test
|
||||||
|
|
||||||
|
! aum's bug
|
||||||
|
[
|
||||||
|
"." current-directory set
|
||||||
|
".." "resource-path" set
|
||||||
|
[ "../core/bootstrap/stage2.factor" ]
|
||||||
|
[ "resource:core/bootstrap/stage2.factor" (normalize-path) ]
|
||||||
|
unit-test
|
||||||
|
] with-scope
|
||||||
|
|
|
@ -121,6 +121,7 @@ PRIVATE>
|
||||||
{
|
{
|
||||||
{ [ over empty? ] [ append-path-empty ] }
|
{ [ over empty? ] [ append-path-empty ] }
|
||||||
{ [ dup empty? ] [ drop ] }
|
{ [ dup empty? ] [ drop ] }
|
||||||
|
{ [ over right-trim-separators "." = ] [ nip ] }
|
||||||
{ [ dup absolute-path? ] [ nip ] }
|
{ [ dup absolute-path? ] [ nip ] }
|
||||||
{ [ dup head.? ] [ rest left-trim-separators append-path ] }
|
{ [ dup head.? ] [ rest left-trim-separators append-path ] }
|
||||||
{ [ dup head..? ] [
|
{ [ dup head..? ] [
|
||||||
|
|
|
@ -1,61 +1,59 @@
|
||||||
|
|
||||||
USING: kernel parser namespaces quotations arrays vectors strings
|
USING: kernel parser combinators sequences splitting quotations arrays macros
|
||||||
sequences assocs classes.tuple math combinators ;
|
arrays.lib combinators.cleave combinators.conditional newfx ;
|
||||||
|
|
||||||
IN: bake
|
IN: bake
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
TUPLE: insert-quot expr ;
|
SYMBOL: ,
|
||||||
|
SYMBOL: @
|
||||||
|
|
||||||
C: <insert-quot> insert-quot
|
: comma? ( obj -- ? ) , = ;
|
||||||
|
: atsym? ( obj -- ? ) @ = ;
|
||||||
: ,[ \ ] [ >quotation <insert-quot> ] parse-literal ; parsing
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
TUPLE: splice-quot expr ;
|
DEFER: [bake-array]
|
||||||
|
|
||||||
C: <splice-quot> splice-quot
|
: broil-element ( obj -- quot )
|
||||||
|
{
|
||||||
: %[ \ ] [ >quotation <splice-quot> ] parse-literal ; parsing
|
{ [ comma? ] [ drop [ >r ] ] }
|
||||||
|
{ [ array? ] [ [bake-array] [ >r ] append ] }
|
||||||
|
{ [ drop t ] [ [ >r ] prefix-on ] }
|
||||||
|
}
|
||||||
|
1cond ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: ,u ( seq -- seq ) unclip building get push ;
|
: [broil] ( array -- quot )
|
||||||
|
[ reverse [ broil-element ] map concat ]
|
||||||
|
[ length [ drop [ r> ] ] map concat ]
|
||||||
|
[ length [ narray ] prefix-on ]
|
||||||
|
tri append append
|
||||||
|
>quotation ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
SYMBOL: exemplar
|
: [simmer] ( array -- quot )
|
||||||
|
|
||||||
: reset-building ( -- ) 1024 <vector> building set ;
|
{ @ } split reverse
|
||||||
|
[ [ [bake-array] [ append ] append [ >r ] append ] map concat ]
|
||||||
|
[ length [ drop [ r> append ] ] map concat ]
|
||||||
|
bi
|
||||||
|
|
||||||
: save-exemplar ( seq -- seq ) dup exemplar set ;
|
>r 2 head* [ >r ] append r> ! remove the last append
|
||||||
|
|
||||||
: finish-baking ( -- seq ) building get exemplar get like ;
|
[ { } ] swap append
|
||||||
|
|
||||||
DEFER: bake
|
append ;
|
||||||
|
|
||||||
: bake-item ( item -- )
|
|
||||||
{ { [ dup \ , = ] [ drop , ] }
|
|
||||||
{ [ dup \ % = ] [ drop % ] }
|
|
||||||
{ [ dup \ ,u = ] [ drop ,u ] }
|
|
||||||
{ [ dup insert-quot? ] [ insert-quot-expr call , ] }
|
|
||||||
{ [ dup splice-quot? ] [ splice-quot-expr call % ] }
|
|
||||||
{ [ dup integer? ] [ , ] }
|
|
||||||
{ [ dup string? ] [ , ] }
|
|
||||||
{ [ dup tuple? ] [ tuple>array bake >tuple , ] }
|
|
||||||
{ [ dup assoc? ] [ [ >alist bake ] keep assoc-like , ] }
|
|
||||||
{ [ dup sequence? ] [ bake , ] }
|
|
||||||
{ [ t ] [ , ] } }
|
|
||||||
cond ;
|
|
||||||
|
|
||||||
: bake-items ( seq -- ) [ bake-item ] each ;
|
|
||||||
|
|
||||||
: bake ( seq -- seq )
|
|
||||||
[ reset-building save-exemplar bake-items finish-baking ] with-scope ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: `{ \ } [ >array ] parse-literal \ bake parsed ; parsing
|
: [bake-array] ( array -- quot ) [ @ member? ] [ [simmer] ] [ [broil] ] 1if ;
|
||||||
|
|
||||||
|
MACRO: bake-array ( array -- quot ) [bake-array] ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
: `{ \ } [ >array ] parse-literal \ bake-array parsed ; parsing
|
|
@ -1,13 +1,13 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
IN: bootstrap.image.download
|
|
||||||
USING: http.client checksums checksums.openssl splitting assocs
|
USING: http.client checksums checksums.openssl splitting assocs
|
||||||
kernel io.files bootstrap.image sequences io ;
|
kernel io.files bootstrap.image sequences io urls ;
|
||||||
|
IN: bootstrap.image.download
|
||||||
|
|
||||||
: url "http://factorcode.org/images/latest/" ;
|
: url URL" http://factorcode.org/images/latest/" ;
|
||||||
|
|
||||||
: download-checksums ( -- alist )
|
: download-checksums ( -- alist )
|
||||||
url "checksums.txt" append http-get nip
|
url "checksums.txt" >url derive-url http-get nip
|
||||||
string-lines [ " " split1 ] { } map>assoc ;
|
string-lines [ " " split1 ] { } map>assoc ;
|
||||||
|
|
||||||
: need-new-image? ( image -- ? )
|
: need-new-image? ( image -- ? )
|
||||||
|
@ -21,7 +21,10 @@ kernel io.files bootstrap.image sequences io ;
|
||||||
: download-image ( arch -- )
|
: download-image ( arch -- )
|
||||||
boot-image-name dup need-new-image? [
|
boot-image-name dup need-new-image? [
|
||||||
"Downloading " write dup write "..." print
|
"Downloading " write dup write "..." print
|
||||||
url prepend download
|
url over >url derive-url download
|
||||||
|
need-new-image? [
|
||||||
|
"Boot image corrupt, or checksums.txt on server out of date" throw
|
||||||
|
] when
|
||||||
] [
|
] [
|
||||||
"Boot image up to date" print
|
"Boot image up to date" print
|
||||||
drop
|
drop
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
|
|
||||||
USING: kernel debugger system namespaces sequences splitting combinators
|
USING: kernel debugger system namespaces sequences splitting combinators
|
||||||
io io.files io.launcher prettyprint bootstrap.image
|
io io.files io.launcher prettyprint bootstrap.image
|
||||||
bake combinators.cleave
|
combinators.cleave
|
||||||
builder.util
|
builder.util
|
||||||
builder.common
|
builder.common
|
||||||
builder.release.branch
|
builder.release.branch
|
||||||
|
|
|
@ -6,7 +6,7 @@ USING: kernel words namespaces classes parser continuations
|
||||||
combinators sequences splitting quotations arrays strings tools.time
|
combinators sequences splitting quotations arrays strings tools.time
|
||||||
sequences.deep accessors assocs.lib
|
sequences.deep accessors assocs.lib
|
||||||
io.encodings.utf8
|
io.encodings.utf8
|
||||||
combinators.cleave bake calendar calendar.format ;
|
combinators.cleave calendar calendar.format ;
|
||||||
|
|
||||||
IN: builder.util
|
IN: builder.util
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,17 @@
|
||||||
|
|
||||||
|
USING: kernel combinators sequences macros fry newfx combinators.cleave ;
|
||||||
|
|
||||||
|
IN: combinators.conditional
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
MACRO: 1if ( test then else -- ) '[ dup @ , , if ] ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
MACRO: 1cond ( tbl -- )
|
||||||
|
[ [ 1st [ dup ] prepend ] [ 2nd ] bi {2} ] map
|
||||||
|
[ cond ] prefix-on ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
|
@ -88,6 +88,7 @@ $nl
|
||||||
$nl
|
$nl
|
||||||
"The basic building blocks:"
|
"The basic building blocks:"
|
||||||
{ $subsection "threads" }
|
{ $subsection "threads" }
|
||||||
|
{ $subsection "alarms" }
|
||||||
"High-level abstractions:"
|
"High-level abstractions:"
|
||||||
{ $subsection "concurrency.combinators" }
|
{ $subsection "concurrency.combinators" }
|
||||||
{ $subsection "concurrency.promises" }
|
{ $subsection "concurrency.promises" }
|
||||||
|
@ -274,6 +275,7 @@ ARTICLE: "handbook" "Factor documentation"
|
||||||
{ $heading "Library reference" }
|
{ $heading "Library reference" }
|
||||||
{ $subsection "numbers" }
|
{ $subsection "numbers" }
|
||||||
{ $subsection "collections" }
|
{ $subsection "collections" }
|
||||||
|
{ $subsection "models" }
|
||||||
{ $subsection "io" }
|
{ $subsection "io" }
|
||||||
{ $subsection "concurrency" }
|
{ $subsection "concurrency" }
|
||||||
{ $subsection "system" }
|
{ $subsection "system" }
|
||||||
|
@ -288,8 +290,8 @@ ARTICLE: "handbook" "Factor documentation"
|
||||||
{ $subsection "compiler" }
|
{ $subsection "compiler" }
|
||||||
{ $subsection "layouts" }
|
{ $subsection "layouts" }
|
||||||
{ $heading "User interface" }
|
{ $heading "User interface" }
|
||||||
{ $about "ui" }
|
{ $subsection "ui" }
|
||||||
{ $about "ui.tools" }
|
{ $subsection "ui-tools" }
|
||||||
{ $heading "Index" }
|
{ $heading "Index" }
|
||||||
{ $subsection "primitive-index" }
|
{ $subsection "primitive-index" }
|
||||||
{ $subsection "error-index" }
|
{ $subsection "error-index" }
|
||||||
|
|
|
@ -55,23 +55,31 @@ ARTICLE: "io.monitors.descriptors" "File system change descriptors"
|
||||||
{ $subsection +rename-file+ } ;
|
{ $subsection +rename-file+ } ;
|
||||||
|
|
||||||
ARTICLE: "io.monitors.platforms" "Monitors on different platforms"
|
ARTICLE: "io.monitors.platforms" "Monitors on different platforms"
|
||||||
"Whether the " { $snippet "path" } " output value of " { $link next-change } " contains an absolute path or a path relative to the path given to " { $link <monitor> } " is platform-specific. User code should not assume either case."
|
"Whether the " { $snippet "path" } " output value of " { $link next-change } " contains an absolute path or a path relative to the path given to " { $link <monitor> } " is unspecified, and may even vary on the same platform. User code should not assume either case."
|
||||||
|
$nl
|
||||||
|
"If the immediate path being monitored was changed, then " { $snippet "path" } " will equal " { $snippet "\"\"" } "; however this condition is not reported on all platforms. See below."
|
||||||
{ $heading "Mac OS X" }
|
{ $heading "Mac OS X" }
|
||||||
"Factor uses " { $snippet "FSEventStream" } "s to implement monitors on Mac OS X. This requires Mac OS X 10.5 or later."
|
"Factor uses " { $snippet "FSEventStream" } "s to implement monitors on Mac OS X. This requires Mac OS X 10.5 or later."
|
||||||
$nl
|
$nl
|
||||||
{ $snippet "FSEventStream" } "s always monitor directory hierarchies recursively, and the " { $snippet "recursive?" } " parameter to " { $link <monitor> } " has no effect."
|
{ $snippet "FSEventStream" } "s always monitor directory hierarchies recursively, and the " { $snippet "recursive?" } " parameter to " { $link <monitor> } " has no effect."
|
||||||
$nl
|
$nl
|
||||||
"The " { $snippet "changed" } " output value of the " { $link next-change } " word always outputs " { $link +modify-file+ } " and the " { $snippet "path" } " output value is always the directory containing the file that changed. Unlike other platforms, fine-grained information is not available."
|
"The " { $snippet "changed" } " output value of the " { $link next-change } " word always outputs " { $link +modify-file+ } " and the " { $snippet "path" } " output value is always the directory containing the file that changed. Unlike other platforms, fine-grained information is not available."
|
||||||
|
$nl
|
||||||
|
"Only directories may be monitored, not individual files. Changes to the directory itself (permissions, modification time, and so on) are not reported; only changes to children are reported."
|
||||||
{ $heading "Windows" }
|
{ $heading "Windows" }
|
||||||
"Factor uses " { $snippet "ReadDirectoryChanges" } " to implement monitors on Windows."
|
"Factor uses " { $snippet "ReadDirectoryChanges" } " to implement monitors on Windows."
|
||||||
$nl
|
$nl
|
||||||
"Both recursive and non-recursive monitors are directly supported by the operating system."
|
"Both recursive and non-recursive monitors are directly supported by the operating system."
|
||||||
|
$nl
|
||||||
|
"Only directories may be monitored, not individual files. Changes to the directory itself (permissions, modification time, and so on) are not reported; only changes to children are reported."
|
||||||
{ $heading "Linux" }
|
{ $heading "Linux" }
|
||||||
"Factor uses " { $snippet "inotify" } " to implement monitors on Linux. This requires Linux kernel version 2.6.16 or later."
|
"Factor uses " { $snippet "inotify" } " to implement monitors on Linux. This requires Linux kernel version 2.6.16 or later."
|
||||||
$nl
|
$nl
|
||||||
"Factor simulates recursive monitors by creating a hierarchy of monitors for every subdirectory, since " { $snippet "inotify" } " can only monitor a single directory. This is transparent to user code."
|
"Factor simulates recursive monitors by creating a hierarchy of monitors for every subdirectory, since " { $snippet "inotify" } " can only monitor a single directory. This is transparent to user code."
|
||||||
$nl
|
$nl
|
||||||
"Inside a single " { $link with-monitors } " scope, only one monitor may be created for any given directory."
|
"Inside a single " { $link with-monitors } " scope, only one monitor may be created for any given directory."
|
||||||
|
$nl
|
||||||
|
"Both directories and files may be monitored. Unlike Mac OS X and Windows, changes to the immediate directory being monitored (permissions, modification time, and so on) are reported."
|
||||||
{ $heading "BSD" }
|
{ $heading "BSD" }
|
||||||
"Factor uses " { $snippet "kqueue" } " to implement monitors on BSD."
|
"Factor uses " { $snippet "kqueue" } " to implement monitors on BSD."
|
||||||
$nl
|
$nl
|
||||||
|
|
|
@ -0,0 +1,34 @@
|
||||||
|
IN: io.unix.linux.monitors.tests
|
||||||
|
USING: io.monitors tools.test io.files system sequences
|
||||||
|
continuations namespaces concurrency.count-downs kernel io
|
||||||
|
threads calendar prettyprint destructors io.timeouts ;
|
||||||
|
|
||||||
|
! On Linux, a notification on the directory itself would report an invalid
|
||||||
|
! path name
|
||||||
|
[
|
||||||
|
[ ] [ "monitor-test-self" temp-file make-directories ] unit-test
|
||||||
|
|
||||||
|
! Non-recursive
|
||||||
|
[ ] [ "monitor-test-self" temp-file f <monitor> "m" set ] unit-test
|
||||||
|
|
||||||
|
[ ] [ "monitor-test-self" temp-file touch-file ] unit-test
|
||||||
|
|
||||||
|
[ t ] [
|
||||||
|
"m" get next-change drop
|
||||||
|
[ "" = ] [ "monitor-test-self" temp-file = ] bi or
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ ] [ "m" get dispose ] unit-test
|
||||||
|
|
||||||
|
! Recursive
|
||||||
|
[ ] [ "monitor-test-self" temp-file t <monitor> "m" set ] unit-test
|
||||||
|
|
||||||
|
[ ] [ "monitor-test-self" temp-file touch-file ] unit-test
|
||||||
|
|
||||||
|
[ t ] [
|
||||||
|
"m" get next-change drop
|
||||||
|
[ "" = ] [ "monitor-test-self" temp-file = ] bi or
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ ] [ "m" get dispose ] unit-test
|
||||||
|
] with-monitors
|
|
@ -83,12 +83,15 @@ M: linux-monitor dispose* ( monitor -- )
|
||||||
drop
|
drop
|
||||||
] { } make prune ;
|
] { } make prune ;
|
||||||
|
|
||||||
|
: parse-event-name ( event -- name )
|
||||||
|
dup inotify-event-len zero?
|
||||||
|
[ drop "" ] [ inotify-event-name utf8 alien>string ] if ;
|
||||||
|
|
||||||
: parse-file-notify ( buffer -- path changed )
|
: parse-file-notify ( buffer -- path changed )
|
||||||
dup inotify-event-mask ignore-flags? [
|
dup inotify-event-mask ignore-flags? [
|
||||||
drop f f
|
drop f f
|
||||||
] [
|
] [
|
||||||
[ inotify-event-name utf8 alien>string ]
|
[ parse-event-name ] [ inotify-event-mask parse-action ] bi
|
||||||
[ inotify-event-mask parse-action ] bi
|
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: events-exhausted? ( i buffer -- ? )
|
: events-exhausted? ( i buffer -- ? )
|
||||||
|
|
|
@ -2,7 +2,7 @@ USING: tools.test io.pipes io.unix.pipes io.encodings.utf8
|
||||||
io.encodings io namespaces sequences ;
|
io.encodings io namespaces sequences ;
|
||||||
IN: io.unix.pipes.tests
|
IN: io.unix.pipes.tests
|
||||||
|
|
||||||
[ { 0 0 } ] [ { "ls" "grep x" } run-pipeline ] unit-test
|
[ { 0 0 } ] [ { "ls" "grep ." } run-pipeline ] unit-test
|
||||||
|
|
||||||
[ { 0 f 0 } ] [
|
[ { 0 f 0 } ] [
|
||||||
{
|
{
|
||||||
|
@ -12,6 +12,6 @@ IN: io.unix.pipes.tests
|
||||||
output-stream [ utf8 <encoder> ] change
|
output-stream [ utf8 <encoder> ] change
|
||||||
input-stream get lines reverse [ print ] each f
|
input-stream get lines reverse [ print ] each f
|
||||||
]
|
]
|
||||||
"grep x"
|
"grep ."
|
||||||
} run-pipeline
|
} run-pipeline
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
|
@ -52,7 +52,3 @@ HOOK: add-completion io-backend ( port -- )
|
||||||
"SECURITY_ATTRIBUTES" <c-object>
|
"SECURITY_ATTRIBUTES" <c-object>
|
||||||
"SECURITY_ATTRIBUTES" heap-size
|
"SECURITY_ATTRIBUTES" heap-size
|
||||||
over set-SECURITY_ATTRIBUTES-nLength ;
|
over set-SECURITY_ATTRIBUTES-nLength ;
|
||||||
|
|
||||||
: security-attributes-inherit ( -- obj )
|
|
||||||
default-security-attributes
|
|
||||||
TRUE over set-SECURITY_ATTRIBUTES-bInheritHandle ; foldable
|
|
||||||
|
|
|
@ -1,2 +1,3 @@
|
||||||
|
Bruno Deferrari
|
||||||
Doug Coleman
|
Doug Coleman
|
||||||
Slava Pestov
|
Slava Pestov
|
||||||
|
|
|
@ -1,7 +1,8 @@
|
||||||
USING: kernel tools.test accessors arrays sequences qualified
|
USING: kernel tools.test accessors arrays sequences qualified
|
||||||
io.streams.string io.streams.duplex namespaces threads
|
io.streams.string io.streams.duplex namespaces threads
|
||||||
calendar irc.client.private ;
|
calendar irc.client.private concurrency.mailboxes classes ;
|
||||||
EXCLUDE: irc.client => join ;
|
EXCLUDE: irc.client => join ;
|
||||||
|
RENAME: join irc.client => join_
|
||||||
IN: irc.client.tests
|
IN: irc.client.tests
|
||||||
|
|
||||||
! Utilities
|
! Utilities
|
||||||
|
@ -64,13 +65,16 @@ privmsg new
|
||||||
[ connect-irc ] keep 1 seconds sleep
|
[ connect-irc ] keep 1 seconds sleep
|
||||||
nick>> name>> ] unit-test
|
nick>> name>> ] unit-test
|
||||||
|
|
||||||
! TODO: Channel join messages
|
{ join_ "#factortest" } [
|
||||||
! { ":factorbot!n=factorbo@some.where JOIN :#factortest"
|
{ ":factorbot!n=factorbo@some.where JOIN :#factortest"
|
||||||
! ":ircserver.net MODE #factortest +ns"
|
":ircserver.net MODE #factortest +ns"
|
||||||
! ":ircserver.net 353 factorbot @ #factortest :@factorbot "
|
":ircserver.net 353 factorbot @ #factortest :@factorbot "
|
||||||
! ":ircserver.net 366 factorbot #factortest :End of /NAMES list."
|
":ircserver.net 366 factorbot #factortest :End of /NAMES list."
|
||||||
! ":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah"
|
":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah"
|
||||||
! } make-client dup "factorbot" set-nick
|
} make-client dup "factorbot" set-nick
|
||||||
|
[ connect-irc ] keep 1 seconds sleep
|
||||||
|
join-messages>> 5 seconds mailbox-get-timeout
|
||||||
|
[ class ] [ trailing>> ] bi ] unit-test
|
||||||
! TODO: user join
|
! TODO: user join
|
||||||
! ":somedude!n=user@isp.net JOIN :#factortest"
|
! ":somedude!n=user@isp.net JOIN :#factortest"
|
||||||
! TODO: channel message
|
! TODO: channel message
|
||||||
|
|
|
@ -1,8 +1,8 @@
|
||||||
! Copyright (C) 2007 Doug Coleman, Slava Pestov.
|
! Copyright (C) 2008 Bruno Deferrari, Doug Coleman, Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: arrays combinators concurrency.mailboxes fry io strings
|
USING: combinators concurrency.mailboxes fry io strings
|
||||||
io.encodings.8-bit io.sockets kernel namespaces sequences
|
io.encodings.8-bit io.sockets kernel namespaces sequences
|
||||||
sequences.lib splitting threads calendar classes.tuple
|
splitting threads calendar classes.tuple
|
||||||
classes ascii assocs accessors destructors continuations ;
|
classes ascii assocs accessors destructors continuations ;
|
||||||
IN: irc.client
|
IN: irc.client
|
||||||
|
|
||||||
|
@ -33,7 +33,6 @@ TUPLE: irc-listener in-messages out-messages ;
|
||||||
TUPLE: irc-server-listener < irc-listener ;
|
TUPLE: irc-server-listener < irc-listener ;
|
||||||
TUPLE: irc-channel-listener < irc-listener name password timeout ;
|
TUPLE: irc-channel-listener < irc-listener name password timeout ;
|
||||||
TUPLE: irc-nick-listener < irc-listener name ;
|
TUPLE: irc-nick-listener < irc-listener name ;
|
||||||
UNION: irc-named-listener irc-nick-listener irc-channel-listener ;
|
|
||||||
|
|
||||||
: <irc-listener> ( -- irc-listener ) <mailbox> <mailbox> irc-listener boa ;
|
: <irc-listener> ( -- irc-listener ) <mailbox> <mailbox> irc-listener boa ;
|
||||||
|
|
||||||
|
@ -78,13 +77,19 @@ TUPLE: unhandled < irc-message ;
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
! ======================================
|
! ======================================
|
||||||
! Shortcuts
|
! Utils
|
||||||
! ======================================
|
! ======================================
|
||||||
|
|
||||||
: irc> ( -- irc-client ) current-irc-client get ;
|
: irc> ( -- irc-client ) current-irc-client get ;
|
||||||
: irc-stream> ( -- stream ) irc> stream>> ;
|
: irc-stream> ( -- stream ) irc> stream>> ;
|
||||||
: irc-write ( s -- ) irc-stream> stream-write ;
|
: irc-write ( s -- ) irc-stream> stream-write ;
|
||||||
: irc-print ( s -- ) irc-stream> [ stream-print ] keep stream-flush ;
|
: irc-print ( s -- ) irc-stream> [ stream-print ] keep stream-flush ;
|
||||||
|
: listener> ( name -- listener/f ) irc> listeners>> at ;
|
||||||
|
: unregister-listener ( name -- ) irc> listeners>> delete-at ;
|
||||||
|
|
||||||
|
: to-listener ( message name -- )
|
||||||
|
listener> [ f listener> ] unless*
|
||||||
|
[ in-messages>> mailbox-put ] [ drop ] if* ;
|
||||||
|
|
||||||
! ======================================
|
! ======================================
|
||||||
! IRC client messages
|
! IRC client messages
|
||||||
|
@ -188,8 +193,7 @@ TUPLE: unhandled < irc-message ;
|
||||||
GENERIC: handle-incoming-irc ( irc-message -- )
|
GENERIC: handle-incoming-irc ( irc-message -- )
|
||||||
|
|
||||||
M: irc-message handle-incoming-irc ( irc-message -- )
|
M: irc-message handle-incoming-irc ( irc-message -- )
|
||||||
f irc> listeners>> at
|
f listener> [ in-messages>> mailbox-put ] [ drop ] if* ;
|
||||||
[ in-messages>> mailbox-put ] [ drop ] if* ;
|
|
||||||
|
|
||||||
M: logged-in handle-incoming-irc ( logged-in -- )
|
M: logged-in handle-incoming-irc ( logged-in -- )
|
||||||
name>> irc> nick>> (>>name) ;
|
name>> irc> nick>> (>>name) ;
|
||||||
|
@ -201,11 +205,15 @@ M: nick-in-use handle-incoming-irc ( nick-in-use -- )
|
||||||
name>> "_" append /NICK ;
|
name>> "_" append /NICK ;
|
||||||
|
|
||||||
M: privmsg handle-incoming-irc ( privmsg -- )
|
M: privmsg handle-incoming-irc ( privmsg -- )
|
||||||
dup irc-message-origin irc> listeners>> [ at ] keep
|
dup irc-message-origin to-listener ;
|
||||||
'[ f , at ] unless* [ in-messages>> mailbox-put ] [ drop ] if* ;
|
|
||||||
|
|
||||||
M: join handle-incoming-irc ( join -- )
|
M: join handle-incoming-irc ( join -- )
|
||||||
irc> join-messages>> mailbox-put ;
|
dup trailing>> listener>
|
||||||
|
[ irc> join-messages>> ] unless* mailbox-put ;
|
||||||
|
|
||||||
|
M: kick handle-incoming-irc ( kick -- )
|
||||||
|
[ ] [ channel>> ] [ who>> ] tri me? [ dup unregister-listener ] when
|
||||||
|
to-listener ;
|
||||||
|
|
||||||
M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- )
|
M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- )
|
||||||
broadcast-message-to-listeners ;
|
broadcast-message-to-listeners ;
|
||||||
|
@ -326,6 +334,5 @@ PRIVATE>
|
||||||
spawn-irc
|
spawn-irc
|
||||||
] with-variable ;
|
] with-variable ;
|
||||||
|
|
||||||
GENERIC: add-listener ( irc-client irc-listener -- )
|
: add-listener ( irc-listener irc-client -- )
|
||||||
M: irc-listener add-listener ( irc-client irc-listener -- )
|
current-irc-client rot '[ , (add-listener) ] with-variable ;
|
||||||
current-irc-client swap '[ , (add-listener) ] with-variable ;
|
|
||||||
|
|
|
@ -22,7 +22,7 @@ VAR: command-table
|
||||||
: exec-command* ( string -- )
|
: exec-command* ( string -- )
|
||||||
[ parameter ] [ command ] bi
|
[ parameter ] [ command ] bi
|
||||||
command-table> at dup
|
command-table> at dup
|
||||||
[ 1 tail* call ] [ 3drop ] if ;
|
[ 1 tail* call ] [ 2drop ] if ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
Phil Dawes
|
|
@ -0,0 +1,4 @@
|
||||||
|
IN: micros.backend
|
||||||
|
USING: io.backend ;
|
||||||
|
|
||||||
|
HOOK: (micros) io-backend ( -- n )
|
|
@ -0,0 +1,14 @@
|
||||||
|
IN: micros
|
||||||
|
USING: help.syntax help.markup kernel prettyprint sequences ;
|
||||||
|
|
||||||
|
HELP: micros
|
||||||
|
{ $values { "n" "an integer" } }
|
||||||
|
{ $description "Outputs the number of microseconds ellapsed since midnight January 1, 1970"
|
||||||
|
} ;
|
||||||
|
|
||||||
|
|
||||||
|
HELP: micro-time
|
||||||
|
{ $values { "quot" "a quot" }
|
||||||
|
{ "n" "an integer" } }
|
||||||
|
{ $description "executes the quotation and pushes the number of microseconds taken onto the stack"
|
||||||
|
} ;
|
|
@ -0,0 +1,7 @@
|
||||||
|
IN: micros.tests
|
||||||
|
USING: micros tools.test math math.functions system kernel ;
|
||||||
|
|
||||||
|
! a bit racy but I can't think of a better way to check this right now
|
||||||
|
[ t ]
|
||||||
|
[ millis 1000 / micros 1000000 / [ truncate ] bi@ = ] unit-test
|
||||||
|
|
|
@ -0,0 +1,13 @@
|
||||||
|
IN: micros
|
||||||
|
USING: micros.backend system kernel combinators vocabs.loader math ;
|
||||||
|
|
||||||
|
: micros ( -- n ) (micros) ; inline
|
||||||
|
|
||||||
|
: micro-time ( quot -- n )
|
||||||
|
micros slip micros swap - ; inline
|
||||||
|
|
||||||
|
{
|
||||||
|
{ [ os unix? ] [ "micros.unix" ] }
|
||||||
|
{ [ os windows? ] [ "micros.windows" ] }
|
||||||
|
} cond require
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
Microsecond precision clock
|
|
@ -0,0 +1,6 @@
|
||||||
|
IN: micros.unix
|
||||||
|
USING: micros.backend io.backend system alien.c-types kernel unix.time math ;
|
||||||
|
|
||||||
|
M: unix (micros)
|
||||||
|
"timespec" <c-object> dup f gettimeofday drop
|
||||||
|
[ timespec-sec 1000000 * ] [ timespec-nsec ] bi + ;
|
|
@ -0,0 +1,7 @@
|
||||||
|
IN: micros.windows
|
||||||
|
USING: system kernel windows.time math math.functions micros.backend ;
|
||||||
|
|
||||||
|
! 116444736000000000 is the windowstime epoch offset
|
||||||
|
! since windowstime starts at 1600 and unix epoch is 1970
|
||||||
|
M: windows (micros)
|
||||||
|
windows-time 116444736000000000 - 10 / truncate ;
|
|
@ -232,8 +232,10 @@ HELP: move-by-page
|
||||||
{ $side-effects "range" } ;
|
{ $side-effects "range" } ;
|
||||||
|
|
||||||
ARTICLE: "models" "Models"
|
ARTICLE: "models" "Models"
|
||||||
"The Factor UI provides basic support for dataflow programming via " { $emphasis "models" } " and " { $emphasis "controls" } ". A model is an observable value. Changing a model's value notifies other objects which depend on the model automatically, and models may depend on each other's values."
|
"The " { $vocab-link "models" } " vocabulary provides basic support for dataflow programming. A model is an observable value. Changing a model's value notifies other objects which depend on the model automatically, and models may depend on each other's values."
|
||||||
$nl
|
$nl
|
||||||
|
"The class of models:"
|
||||||
|
{ $subsection model }
|
||||||
"Creating models:"
|
"Creating models:"
|
||||||
{ $subsection <model> }
|
{ $subsection <model> }
|
||||||
"Adding and removing connections:"
|
"Adding and removing connections:"
|
||||||
|
|
|
@ -195,4 +195,8 @@ METHOD: as-mutate { object object assoc } set-at ;
|
||||||
: adjoin ( seq elt -- seq ) over sets:adjoin ;
|
: adjoin ( seq elt -- seq ) over sets:adjoin ;
|
||||||
: adjoin-on ( elt seq -- seq ) tuck sets:adjoin ;
|
: adjoin-on ( elt seq -- seq ) tuck sets:adjoin ;
|
||||||
: adjoined ( set elt -- ) swap sets:adjoin ;
|
: adjoined ( set elt -- ) swap sets:adjoin ;
|
||||||
: adjoined-on ( elt set -- ) sets:adjoin ;
|
: adjoined-on ( elt set -- ) sets:adjoin ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
: start ( seq subseq -- i ) swap sequences:start ;
|
|
@ -0,0 +1,9 @@
|
||||||
|
IN: ori.tests
|
||||||
|
USING: ori tools.test ;
|
||||||
|
|
||||||
|
\ pitch-up must-infer
|
||||||
|
\ pitch-down must-infer
|
||||||
|
\ turn-left must-infer
|
||||||
|
\ turn-right must-infer
|
||||||
|
\ roll-left must-infer
|
||||||
|
\ roll-right must-infer
|
|
@ -17,7 +17,7 @@ C: <ori> ori
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: make-matrix ( quot width -- matrix ) >r { } make r> group ;
|
: make-matrix ( quot width -- matrix ) >r { } make r> group ; inline
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
|
|
||||||
USING: kernel namespaces arrays quotations sequences assocs combinators
|
USING: kernel namespaces arrays quotations sequences assocs combinators
|
||||||
mirrors math math.vectors random macros bake ;
|
mirrors math math.vectors random macros fry ;
|
||||||
|
|
||||||
IN: random-weighted
|
IN: random-weighted
|
||||||
|
|
||||||
|
@ -16,5 +16,5 @@ probabilities layers [ 1000 * ] map 1000 random [ > ] curry find drop ;
|
||||||
dup [ second ] map swap [ first ] map random-weighted swap nth ;
|
dup [ second ] map swap [ first ] map random-weighted swap nth ;
|
||||||
|
|
||||||
MACRO: call-random-weighted ( exp -- )
|
MACRO: call-random-weighted ( exp -- )
|
||||||
[ keys ] [ values <enum> >alist ] bi swap
|
[ keys ] [ values <enum> >alist ] bi
|
||||||
[ , random-weighted , case ] bake ;
|
'[ , random-weighted , case ] ;
|
||||||
|
|
|
@ -1,5 +1,6 @@
|
||||||
|
|
||||||
USING: kernel parser namespaces threads arrays sequences unix unix.process bake ;
|
USING: kernel parser namespaces threads arrays sequences unix unix.process
|
||||||
|
bake ;
|
||||||
|
|
||||||
IN: raptor
|
IN: raptor
|
||||||
|
|
||||||
|
|
|
@ -1,30 +1,26 @@
|
||||||
|
|
||||||
USING: kernel parser math quotations namespaces sequences namespaces.lib
|
USING: kernel parser math quotations namespaces sequences macros fry ;
|
||||||
inference.transforms ;
|
|
||||||
|
|
||||||
IN: rewrite-closures
|
IN: rewrite-closures
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
! : set-parameters ( seq -- ) reverse [ set ] each ;
|
: [set-parameters] ( seq -- quot ) reverse [ [ set ] curry ] map concat ;
|
||||||
|
|
||||||
: [set-parameters] ( seq -- quot ) [ [ set ] curry ] map concat ;
|
MACRO: set-parameters ( seq -- quot ) [set-parameters] ;
|
||||||
|
|
||||||
: set-parameters ( seq -- ) [set-parameters] call ;
|
|
||||||
|
|
||||||
\ set-parameters [ [set-parameters] ] 1 define-transform
|
|
||||||
|
|
||||||
: parametric-quot ( parameters quot -- quot )
|
|
||||||
[ [ swap ] set-parameters [ ] call ] make* ;
|
|
||||||
|
|
||||||
: scoped-quot ( quot -- quot ) [ with-scope ] curry ;
|
|
||||||
|
|
||||||
: closed-quot ( quot -- quot )
|
|
||||||
[ namestack >r [ namestack ] set-namestack [ ] call r> set-namestack ] make* ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: lambda ( parameters quot -- ) parametric-quot scoped-quot closed-quot ;
|
: parametric-quot ( parameters quot -- quot ) '[ , set-parameters , call ] ;
|
||||||
|
|
||||||
|
: scoped-quot ( quot -- quot ) '[ , with-scope ] ;
|
||||||
|
|
||||||
|
: closed-quot ( quot -- quot )
|
||||||
|
namestack swap '[ namestack [ , set-namestack @ ] dip set-namestack ] ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
: lambda ( parameters quot -- quot ) parametric-quot scoped-quot closed-quot ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
|
|
@ -12,15 +12,15 @@ IN: size-of
|
||||||
VAR: headers
|
VAR: headers
|
||||||
|
|
||||||
: include-headers ( -- seq )
|
: include-headers ( -- seq )
|
||||||
headers> [ { "#include <" , ">" } bake to-string ] map ;
|
headers> [ `{ "#include <" , ">" } to-string ] map ;
|
||||||
|
|
||||||
: size-of-c-program ( type -- lines )
|
: size-of-c-program ( type -- lines )
|
||||||
{
|
`{
|
||||||
"#include <stdio.h>"
|
"#include <stdio.h>"
|
||||||
include-headers
|
include-headers
|
||||||
{ "main() { printf( \"%i\" , sizeof( " , " ) ) ; }" }
|
{ "main() { printf( \"%i\" , sizeof( " , " ) ) ; }" }
|
||||||
}
|
}
|
||||||
bake to-strings ;
|
to-strings ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
|
|
||||||
USING: kernel namespaces arrays sequences threads math math.vectors
|
USING: kernel namespaces arrays sequences threads math math.vectors
|
||||||
ui random bake springies springies.ui ;
|
ui random springies springies.ui ;
|
||||||
|
|
||||||
IN: springies.models.2x2snake
|
IN: springies.models.2x2snake
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
|
|
||||||
USING: kernel namespaces arrays sequences threads math ui random bake
|
USING: kernel namespaces arrays sequences threads math ui random fry
|
||||||
springies springies.ui ;
|
springies springies.ui ;
|
||||||
|
|
||||||
IN: springies.models.3snake
|
IN: springies.models.3snake
|
||||||
|
@ -158,8 +158,10 @@ times
|
||||||
|
|
||||||
;
|
;
|
||||||
|
|
||||||
: go* ( quot -- )
|
! : go* ( quot -- )
|
||||||
[ [ [ springies-window* 1000 sleep % ] with-scope ] with-ui ] bake call ;
|
! [ [ [ springies-window* 1000 sleep % ] with-scope ] with-ui ] bake call ;
|
||||||
|
|
||||||
|
: go* ( quot -- ) '[ [ springies-window* 1000 sleep @ ] with-scope ] with-ui ;
|
||||||
|
|
||||||
! : go ( -- ) [ [ springies-window* 1000 sleep model ] with-scope ] with-ui ;
|
! : go ( -- ) [ [ springies-window* 1000 sleep model ] with-scope ] with-ui ;
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
|
|
||||||
USING: kernel namespaces arrays sequences threads math ui random bake
|
USING: kernel namespaces arrays sequences threads math ui random
|
||||||
springies springies.ui ;
|
springies springies.ui ;
|
||||||
|
|
||||||
IN: springies.models.belt-tire
|
IN: springies.models.belt-tire
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
|
|
||||||
USING: kernel namespaces arrays sequences threads math math.vectors
|
USING: kernel namespaces arrays sequences threads math math.vectors
|
||||||
ui random bake springies springies.ui ;
|
ui random springies springies.ui ;
|
||||||
|
|
||||||
IN: springies.models.nifty
|
IN: springies.models.nifty
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
|
|
||||||
USING: kernel namespaces arrays sequences threads math math.vectors
|
USING: kernel namespaces arrays sequences threads math math.vectors
|
||||||
ui random bake
|
ui random
|
||||||
springies springies.ui ;
|
springies springies.ui ;
|
||||||
|
|
||||||
IN: springies.models.urchin
|
IN: springies.models.urchin
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
|
|
||||||
USING: kernel namespaces threads sequences math math.vectors
|
USING: kernel namespaces threads sequences math math.vectors
|
||||||
opengl.gl opengl colors ui ui.gadgets ui.gadgets.slate
|
opengl.gl opengl colors ui ui.gadgets ui.gadgets.slate
|
||||||
bake rewrite-closures vars springies ;
|
fry rewrite-closures vars springies ;
|
||||||
|
|
||||||
IN: springies.ui
|
IN: springies.ui
|
||||||
|
|
||||||
|
@ -62,5 +62,4 @@ DEFER: maybe-loop
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: go* ( quot -- )
|
: go* ( quot -- ) '[ [ springies-window* 1000 sleep @ ] with-scope ] with-ui ;
|
||||||
[ [ [ springies-window* 1000 sleep % ] with-scope ] with-ui ] bake call ;
|
|
|
@ -89,8 +89,8 @@ ARTICLE: "building-ui" "Building user interfaces"
|
||||||
{ $subsection "ui-geometry" }
|
{ $subsection "ui-geometry" }
|
||||||
{ $subsection "ui-layouts" }
|
{ $subsection "ui-layouts" }
|
||||||
{ $subsection "gadgets" }
|
{ $subsection "gadgets" }
|
||||||
{ $subsection "models" }
|
{ $subsection "ui-windows" }
|
||||||
{ $subsection "ui-windows" } ;
|
{ $see-also "models" } ;
|
||||||
|
|
||||||
ARTICLE: "gadgets" "Pre-made UI gadgets"
|
ARTICLE: "gadgets" "Pre-made UI gadgets"
|
||||||
{ $subsection "ui.gadgets.labels" }
|
{ $subsection "ui.gadgets.labels" }
|
||||||
|
|
|
@ -29,4 +29,5 @@ C-STRUCT: timespec
|
||||||
[ set-timespec-sec ] keep ;
|
[ set-timespec-sec ] keep ;
|
||||||
|
|
||||||
FUNCTION: time_t time ( time_t* t ) ;
|
FUNCTION: time_t time ( time_t* t ) ;
|
||||||
FUNCTION: tm* localtime ( time_t* clock ) ;
|
FUNCTION: tm* localtime ( time_t* clock ) ;
|
||||||
|
FUNCTION: int gettimeofday ( timespec* TP, void* TZP ) ;
|
||||||
|
|
21
vm/image.c
21
vm/image.c
|
@ -28,8 +28,14 @@ INLINE void load_data_heap(FILE *file, F_HEADER *h, F_PARAMETERS *p)
|
||||||
|
|
||||||
F_ZONE *tenured = &data_heap->generations[TENURED];
|
F_ZONE *tenured = &data_heap->generations[TENURED];
|
||||||
|
|
||||||
if(fread((void*)tenured->start,h->data_size,1,file) != 1)
|
long int bytes_read = fread((void*)tenured->start,1,h->data_size,file);
|
||||||
|
|
||||||
|
if(bytes_read != h->data_size)
|
||||||
|
{
|
||||||
|
fprintf(stderr,"truncated image: %ld bytes read, %ld bytes expected\n",
|
||||||
|
bytes_read,h->data_size);
|
||||||
fatal_error("load_data_heap failed",0);
|
fatal_error("load_data_heap failed",0);
|
||||||
|
}
|
||||||
|
|
||||||
tenured->here = tenured->start + h->data_size;
|
tenured->here = tenured->start + h->data_size;
|
||||||
data_relocation_base = h->data_relocation_base;
|
data_relocation_base = h->data_relocation_base;
|
||||||
|
@ -44,9 +50,16 @@ INLINE void load_code_heap(FILE *file, F_HEADER *h, F_PARAMETERS *p)
|
||||||
|
|
||||||
init_code_heap(p->code_size);
|
init_code_heap(p->code_size);
|
||||||
|
|
||||||
if(h->code_size != 0
|
if(h->code_size != 0)
|
||||||
&& fread(first_block(&code_heap),h->code_size,1,file) != 1)
|
{
|
||||||
fatal_error("load_code_heap failed",0);
|
long int bytes_read = fread(first_block(&code_heap),1,h->code_size,file);
|
||||||
|
if(bytes_read != h->code_size)
|
||||||
|
{
|
||||||
|
fprintf(stderr,"truncated image: %ld bytes read, %ld bytes expected\n",
|
||||||
|
bytes_read,h->code_size);
|
||||||
|
fatal_error("load_code_heap failed",0);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
code_relocation_base = h->code_relocation_base;
|
code_relocation_base = h->code_relocation_base;
|
||||||
build_free_list(&code_heap,h->code_size);
|
build_free_list(&code_heap,h->code_size);
|
||||||
|
|
Loading…
Reference in New Issue