diff --git a/build-support/grovel.c b/build-support/grovel.c index 8422ec197c..1260b29c80 100644 --- a/build-support/grovel.c +++ b/build-support/grovel.c @@ -141,10 +141,12 @@ void unix_constants() constant(EINTR); constant(EAGAIN); constant(EINPROGRESS); - constant(PROT_READ); + constant(PROT_READ); constant(PROT_WRITE); constant(MAP_FILE); constant(MAP_SHARED); + grovel(pid_t); + } int main() { @@ -158,6 +160,10 @@ int main() { openbsd_stat(); openbsd_types(); #endif + grovel(blkcnt_t); + grovel(blksize_t); + //grovel(fflags_t); + grovel(ssize_t); #ifdef UNIX unix_types(); diff --git a/core/cpu/x86/architecture/architecture.factor b/core/cpu/x86/architecture/architecture.factor index 49b05ea48f..f993639c05 100755 --- a/core/cpu/x86/architecture/architecture.factor +++ b/core/cpu/x86/architecture/architecture.factor @@ -156,7 +156,7 @@ M: x86-backend %unbox-small-struct ( size -- ) M: x86-backend struct-small-enough? ( size -- ? ) { 1 2 4 8 } member? - os { "linux" "solaris" } member? not and ; + os { "linux" "netbsd" "solaris" } member? not and ; M: x86-backend %return ( -- ) 0 %unwind ; diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor index c9b9f5d977..dea549eb37 100644 --- a/extra/peg/ebnf/ebnf-tests.factor +++ b/extra/peg/ebnf/ebnf-tests.factor @@ -142,4 +142,32 @@ IN: peg.ebnf.tests { f } [ "Z" [EBNF foo=[^A-Z] EBNF] call -] unit-test \ No newline at end of file +] unit-test + +[ + #! Test direct left recursion. Currently left recursion should cause a + #! failure of that parser. + #! Not using packrat, so recursion causes data stack overflow + "1+1" [EBNF num=([0-9])+ expr=expr "+" num | num EBNF] call +] must-fail + +{ V{ 49 } } [ + #! Test direct left recursion. Currently left recursion should cause a + #! failure of that parser. + #! Using packrat, so first part of expr fails, causing 2nd choice to be used + "1+1" [ [EBNF num=([0-9])+ expr=expr "+" num | num EBNF] call ] with-packrat parse-result-ast +] unit-test + +[ + #! Test indirect left recursion. Currently left recursion should cause a + #! failure of that parser. + #! Not using packrat, so recursion causes data stack overflow + "1+1" [EBNF num=([0-9])+ x=expr expr=x "+" num | num EBNF] call +] must-fail + +{ V{ 49 } } [ + #! Test indirect left recursion. Currently left recursion should cause a + #! failure of that parser. + #! Using packrat, so first part of expr fails, causing 2nd choice to be used + "1+1" [ [EBNF num=([0-9])+ x=expr expr=x "+" num | num EBNF] call ] with-packrat parse-result-ast +] unit-test diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index 11e1e2ea64..ed0dea0410 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -266,7 +266,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser ) ] [ ] make delay sp ; : transform-ebnf ( string -- object ) - 'ebnf' parse parse-result-ast transform ; + 'ebnf' packrat-parse parse-result-ast transform ; : check-parse-result ( result -- result ) dup [ @@ -281,7 +281,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser ) ] if ; : ebnf>quot ( string -- hashtable quot ) - 'ebnf' parse check-parse-result + 'ebnf' packrat-parse check-parse-result parse-result-ast transform dup main swap at compile 1quotation ; : [EBNF "EBNF]" parse-multiline-string ebnf>quot nip parsed ; parsing diff --git a/extra/peg/peg-docs.factor b/extra/peg/peg-docs.factor index 30e7f0e72f..c93d1af830 100644 --- a/extra/peg/peg-docs.factor +++ b/extra/peg/peg-docs.factor @@ -12,7 +12,7 @@ HELP: parse { $description "Given the input string, parse it using the given parser. The result is a object if " "the parse was successful, otherwise it is f." } -{ $see-also compile with-packrat } ; +{ $see-also compile with-packrat packrat-parse } ; HELP: with-packrat { $values @@ -23,8 +23,30 @@ HELP: with-packrat "Calls the quotation with a packrat cache in scope. Usually the quotation will " "call " { $link parse } " or call a word produced by " { $link compile } "." "The cache is used to avoid the possible exponential time performace that pegs " - "can have, instead giving linear time at the cost of increased memory usage." } -{ $see-also compile parse } ; + "can have, instead giving linear time at the cost of increased memory usage. " + "Use of this packrat option also allows direct and indirect recursion to " + "be handled in the parser without entering an infinite loop." } +{ $see-also compile parse packrat-parse packrat-call } ; + +HELP: packrat-parse +{ $values + { "input" "a string" } + { "parser" "a parser" } + { "result" "a parse-result or f" } +} +{ $description + "Compiles and calls the parser with a packrat cache in scope." } +{ $see-also compile parse packrat-call with-packrat } ; + +HELP: packrat-call +{ $values + { "input" "a string" } + { "quot" "a quotation with stack effect ( input -- result )" } + { "result" "a parse-result or f" } +} +{ $description + "Calls the compiled parser with a packrat cache in scope." } +{ $see-also compile packrat-call packrat-parse with-packrat } ; HELP: compile { $values @@ -36,7 +58,7 @@ HELP: compile "The mapping from parser to compiled word is kept in a cache. If you later change " "the definition of a parser you'll need to clear this cache with " { $link reset-compiled-parsers } " before using " { $link compile } " on that parser again." } -{ $see-also compile with-packrat reset-compiled-parsers } ; +{ $see-also compile with-packrat reset-compiled-parsers packrat-call packrat-parse } ; HELP: reset-compiled-parsers { $description diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor index 89cc243863..cd95bd3b93 100644 --- a/extra/peg/peg-tests.factor +++ b/extra/peg/peg-tests.factor @@ -158,3 +158,41 @@ IN: peg.tests "a]" "[" token hide "a" token "]" token hide 3array seq parse ] unit-test + +{ V{ "1" "-" "1" } V{ "1" "+" "1" } } [ + [ + [ "1" token , "-" token , "1" token , ] seq* , + [ "1" token , "+" token , "1" token , ] seq* , + ] choice* + "1-1" over parse parse-result-ast swap + "1+1" swap parse parse-result-ast +] unit-test + +{ V{ "1" "-" "1" } V{ "1" "+" "1" } } [ + [ + [ + [ "1" token , "-" token , "1" token , ] seq* , + [ "1" token , "+" token , "1" token , ] seq* , + ] choice* + "1-1" over parse parse-result-ast swap + ] with-packrat + [ + "1+1" swap parse parse-result-ast + ] with-packrat +] unit-test + +: expr ( -- parser ) + #! Test direct left recursion. Currently left recursion should cause a + #! failure of that parser. + [ expr ] delay "+" token "1" token 3seq "1" token 2choice ; + +[ + #! Not using packrat, so recursion causes data stack overflow + "1+1" expr parse parse-result-ast +] must-fail + +{ "1" } [ + #! Using packrat, so expr fails, causing the 2nd choice to be used. + "1+1" expr [ parse ] with-packrat parse-result-ast +] unit-test + diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 10c9ce907d..709052b7dd 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -24,13 +24,32 @@ SYMBOL: packrat GENERIC: (compile) ( parser -- quot ) -:: run-packrat-parser ( input quot c -- result ) - input slice? [ input slice-from ] [ 0 ] if - quot c [ drop H{ } clone ] cache - [ - drop input quot call +: input-from ( input -- n ) + #! Return the index from the original string that the + #! input slice is based on. + dup slice? [ slice-from ] [ drop 0 ] if ; + +: input-cache ( quot cache -- cache ) + #! From the packrat cache, obtain the cache for the parser quotation + #! that maps the input string position to the parser result. + [ drop H{ } clone ] cache ; + +:: cached-result ( n input-cache input quot -- result ) + #! Get the cached result for input position n + #! from the input cache. If the item is not in the cache, + #! call 'quot' with 'input' on the stack to get the result + #! and store that in the cache and return it. + n input-cache [ + drop + f n input-cache set-at + input quot call ] cache ; inline +:: run-packrat-parser ( input quot c -- result ) + input input-from + quot c input-cache + input quot cached-result ; inline + : run-parser ( input quot -- result ) #! If a packrat cache is available, use memoization for #! packrat parsing, otherwise do a standard peg call. @@ -48,11 +67,17 @@ GENERIC: (compile) ( parser -- quot ) [ compiled-parser ] with-compilation-unit ; : parse ( state parser -- result ) - compile execute ; + compile execute ; inline : with-packrat ( quot -- result ) #! Run the quotation with a packrat cache active. - [ H{ } clone packrat ] dip with-variable ; + [ H{ } clone packrat ] dip with-variable ; inline + +: packrat-parse ( state parser -- result ) + [ parse ] with-packrat ; + +: packrat-call ( state quot -- result ) + with-packrat ; inline r vm "test.image" temp-file r> dup deploy-config make-deploy-image diff --git a/extra/unix/bsd/bsd.factor b/extra/unix/bsd/bsd.factor index e652f1b9f9..cb7b347c20 100755 --- a/extra/unix/bsd/bsd.factor +++ b/extra/unix/bsd/bsd.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax combinators system vocabs.loader ; IN: unix -USING: alien.syntax ; ! FreeBSD @@ -15,8 +15,6 @@ USING: alien.syntax ; : O_TRUNC HEX: 0400 ; inline : O_EXCL HEX: 0800 ; inline -: FD_SETSIZE 1024 ; inline - : SOL_SOCKET HEX: ffff ; inline : SO_REUSEADDR HEX: 4 ; inline : SO_OOBINLINE HEX: 100 ; inline @@ -83,3 +81,10 @@ C-STRUCT: sockaddr-un : SEEK_SET 0 ; inline : SEEK_CUR 1 ; inline : SEEK_END 2 ; inline + +os { + { "macosx" [ "unix.bsd.macosx" require ] } + { "freebsd" [ "unix.bsd.freebsd" require ] } + { "openbsd" [ "unix.bsd.openbsd" require ] } + { "netbsd" [ "unix.bsd.netbsd" require ] } +} case diff --git a/extra/unix/bsd/freebsd/freebsd.factor b/extra/unix/bsd/freebsd/freebsd.factor new file mode 100644 index 0000000000..94bb708527 --- /dev/null +++ b/extra/unix/bsd/freebsd/freebsd.factor @@ -0,0 +1,3 @@ +IN: unix + +: FD_SETSIZE 1024 ; diff --git a/extra/unix/bsd/macosx/macosx.factor b/extra/unix/bsd/macosx/macosx.factor new file mode 100644 index 0000000000..3c0617ad17 --- /dev/null +++ b/extra/unix/bsd/macosx/macosx.factor @@ -0,0 +1,3 @@ +IN: unix + +: FD_SETSIZE 1024 ; inline diff --git a/extra/unix/bsd/netbsd/netbsd.factor b/extra/unix/bsd/netbsd/netbsd.factor new file mode 100644 index 0000000000..ac18749830 --- /dev/null +++ b/extra/unix/bsd/netbsd/netbsd.factor @@ -0,0 +1,3 @@ +IN: unix + +: FD_SETSIZE 256 ; inline diff --git a/extra/unix/bsd/openbsd/openbsd.factor b/extra/unix/bsd/openbsd/openbsd.factor new file mode 100644 index 0000000000..3c0617ad17 --- /dev/null +++ b/extra/unix/bsd/openbsd/openbsd.factor @@ -0,0 +1,3 @@ +IN: unix + +: FD_SETSIZE 1024 ; inline diff --git a/extra/unix/stat/netbsd/32/32.factor b/extra/unix/stat/netbsd/32/32.factor new file mode 100644 index 0000000000..bb2df6d6d3 --- /dev/null +++ b/extra/unix/stat/netbsd/32/32.factor @@ -0,0 +1,26 @@ +USING: kernel alien.syntax math ; +IN: unix.stat + +! NetBSD 4.0 + +C-STRUCT: stat + { "dev_t" "st_dev" } + { "mode_t" "st_mode" } + { "ino_t" "st_ino" } + { "nlink_t" "st_nlink" } + { "uid_t" "st_uid" } + { "gid_t" "st_gid" } + { "dev_t" "st_rdev" } + { "timespec" "st_atim" } + { "timespec" "st_mtim" } + { "timespec" "st_ctim" } + { "timespec" "st_birthtim" } + { "off_t" "st_size" } + { "blkcnt_t" "st_blocks" } + { "blksize_t" "st_blksize" } + { "uint32_t" "st_flags" } + { "uint32_t" "st_gen" } + { { "uint32_t" 2 } "st_qspare" } ; + +FUNCTION: int stat ( char* pathname, stat* buf ) ; +FUNCTION: int lstat ( char* pathname, stat* buf ) ; diff --git a/extra/unix/stat/netbsd/64/64.factor b/extra/unix/stat/netbsd/64/64.factor new file mode 100644 index 0000000000..f1f6f93dbd --- /dev/null +++ b/extra/unix/stat/netbsd/64/64.factor @@ -0,0 +1,27 @@ +USING: kernel alien.syntax math ; +IN: unix.stat + +! NetBSD 4.0 + +C-STRUCT: stat + { "dev_t" "st_dev" } + { "ino_t" "st_ino" } + { "mode_t" "st_mode" } + { "nlink_t" "st_nlink" } + { "uid_t" "st_uid" } + { "gid_t" "st_gid" } + { "dev_t" "st_rdev" } + { "timespec" "st_atim" } + { "timespec" "st_mtim" } + { "timespec" "st_ctim" } + { "off_t" "st_size" } + { "blkcnt_t" "st_blocks" } + { "blksize_t" "st_blksize" } + { "uint32_t" "st_flags" } + { "uint32_t" "st_gen" } + { "uint32_t" "st_spare0" } + { "timespec" "st_birthtim" } + { "int" "__pad5" } ; + +FUNCTION: int stat ( char* pathname, stat* buf ) ; +FUNCTION: int lstat ( char* pathname, stat* buf ) ; diff --git a/extra/unix/stat/netbsd/netbsd.factor b/extra/unix/stat/netbsd/netbsd.factor index bb2df6d6d3..8057e5939b 100644 --- a/extra/unix/stat/netbsd/netbsd.factor +++ b/extra/unix/stat/netbsd/netbsd.factor @@ -1,26 +1,7 @@ -USING: kernel alien.syntax math ; +USING: layouts combinators vocabs.loader ; IN: unix.stat -! NetBSD 4.0 - -C-STRUCT: stat - { "dev_t" "st_dev" } - { "mode_t" "st_mode" } - { "ino_t" "st_ino" } - { "nlink_t" "st_nlink" } - { "uid_t" "st_uid" } - { "gid_t" "st_gid" } - { "dev_t" "st_rdev" } - { "timespec" "st_atim" } - { "timespec" "st_mtim" } - { "timespec" "st_ctim" } - { "timespec" "st_birthtim" } - { "off_t" "st_size" } - { "blkcnt_t" "st_blocks" } - { "blksize_t" "st_blksize" } - { "uint32_t" "st_flags" } - { "uint32_t" "st_gen" } - { { "uint32_t" 2 } "st_qspare" } ; - -FUNCTION: int stat ( char* pathname, stat* buf ) ; -FUNCTION: int lstat ( char* pathname, stat* buf ) ; +cell-bits { + { 32 [ "unix.stat.netbsd.32" require ] } + { 64 [ "unix.stat.netbsd.64" require ] } +} case diff --git a/extra/unix/types/netbsd/netbsd.factor b/extra/unix/types/netbsd/netbsd.factor index 77636a6d6d..6d33547627 100755 --- a/extra/unix/types/netbsd/netbsd.factor +++ b/extra/unix/types/netbsd/netbsd.factor @@ -18,7 +18,7 @@ TYPEDEF: ulonglong u_int64_t TYPEDEF: __uint32_t __dev_t TYPEDEF: __uint32_t dev_t -TYPEDEF: __uint64_t ino_t +TYPEDEF: __uint32_t ino_t TYPEDEF: __uint32_t mode_t TYPEDEF: __uint32_t nlink_t TYPEDEF: __uint32_t uid_t @@ -26,7 +26,6 @@ TYPEDEF: __uint32_t gid_t TYPEDEF: __int64_t off_t TYPEDEF: __int64_t blkcnt_t TYPEDEF: __uint32_t blksize_t -TYPEDEF: __uint32_t fflags_t -TYPEDEF: int ssize_t +TYPEDEF: longlong ssize_t TYPEDEF: int pid_t TYPEDEF: int time_t diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index 8953b638f6..bed87ebd0f 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -160,6 +160,5 @@ FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ; { [ linux? ] [ "unix.linux" require ] } { [ bsd? ] [ "unix.bsd" require ] } { [ solaris? ] [ "unix.solaris" require ] } - { [ t ] [ ] } } cond