steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2008-03-27 20:10:30 -05:00
parent 17ba5aa2ef 9dcabddb52
commit 280e3bbf98
43 changed files with 406 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
build-support/grovel.c
View File

@ -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();

2
core/cpu/x86/architecture/architecture.factor
View File

@ -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 ;

6
core/io/backend/backend.factor
View File

@ -1,6 +1,7 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: init kernel system namespaces io io.encodings io.encodings.utf8 ;
USING: init kernel system namespaces io io.encodings
io.encodings.utf8 init assocs ;
IN: io.backend
SYMBOL: io-backend
@ -22,7 +23,8 @@ HOOK: normalize-pathname io-backend ( str -- newstr )
M: object normalize-directory normalize-pathname ;
: set-io-backend ( io-backend -- )
io-backend set-global init-io init-stdio ;
io-backend set-global init-io init-stdio
"io.files" init-hooks get at call ;
[ init-io embedded? [ init-stdio ] unless ]
"io.backend" add-init-hook

50
core/io/files/files-tests.factor
View File

@ -7,6 +7,56 @@ io.encodings.utf8 ;
[ ] [ "blahblah" temp-file make-directory ] unit-test
[ t ] [ "blahblah" temp-file directory? ] unit-test
[ t ] [
[ temp-directory "loldir" append-path delete-directory ] ignore-errors
temp-directory [
"loldir" make-directory
] with-directory
temp-directory "loldir" append-path exists?
] unit-test
[ ] [
[ temp-directory "loldir" append-path delete-directory ] ignore-errors
temp-directory [
"loldir" make-directory
"loldir" delete-directory
] with-directory
] unit-test
[ "file1 contents" ] [
[ temp-directory "loldir" append-path delete-directory ] ignore-errors
temp-directory [
"file1 contents" "file1" utf8 set-file-contents
"file1" "file2" copy-file
"file2" utf8 file-contents
] with-directory
"file1" temp-file delete-file
"file2" temp-file delete-file
] unit-test
[ "file3 contents" ] [
temp-directory [
"file3 contents" "file3" utf8 set-file-contents
"file3" "file4" move-file
"file4" utf8 file-contents
] with-directory
"file4" temp-file delete-file
] unit-test
[ ] [
temp-directory [
"file5" touch-file
"file5" delete-file
] with-directory
] unit-test
[ ] [
temp-directory [
"file6" touch-file
"file6" link-info drop
] with-directory
] unit-test
[ "passwd" ] [ "/etc/passwd" file-name ] unit-test
[ "awk" ] [ "/usr/libexec/awk/" file-name ] unit-test
[ "awk" ] [ "/usr/libexec/awk///" file-name ] unit-test

4
core/io/files/files.factor
View File

@ -45,6 +45,8 @@ HOOK: (file-appender) io-backend ( path -- stream )
! Pathnames
: path-separator? ( ch -- ? ) windows? "/\\" "/" ? member? ;
: path-separator ( -- string ) windows? "\\" "/" ? ;
: right-trim-separators ( str -- newstr )
[ path-separator? ] right-trim ;
@ -170,7 +172,7 @@ SYMBOL: current-directory
M: object cwd ( -- path ) "." ;
[ cwd current-directory set-global ] "current-directory" add-init-hook
[ cwd current-directory set-global ] "io.files" add-init-hook
: with-directory ( path quot -- )
>r normalize-pathname r>

2
core/mirrors/mirrors-docs.factor
View File

@ -36,7 +36,7 @@ HELP: <mirror>
"TUPLE: circle center radius ;"
"C: <circle> circle"
"{ 100 50 } 15 <circle> <mirror> >alist ."
"{ { \"center\" { 100 50 } } { \"radius\" 15 } }"
"{ { \"delegate\" f } { \"center\" { 100 50 } } { \"radius\" 15 } }"
}
} ;

12
extra/editors/editors.factor
View File

@ -1,8 +1,9 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: parser kernel namespaces sequences definitions io.files
inspector continuations tuples tools.crossref tools.vocabs
io prettyprint source-files assocs vocabs vocabs.loader ;
io prettyprint source-files assocs vocabs vocabs.loader
io.backend splitting ;
IN: editors
TUPLE: no-edit-hook ;
@ -25,11 +26,8 @@ SYMBOL: edit-hook
require ;
: edit-location ( file line -- )
edit-hook get [
call
] [
no-edit-hook edit-location
] if* ;
>r normalize-pathname "\\\\?\\" ?head drop r>
edit-hook get [ call ] [ no-edit-hook edit-location ] if* ;
: edit ( defspec -- )
where [ first2 edit-location ] when* ;

2
extra/editors/jedit/jedit.factor Normal file → Executable file
View File

@ -8,7 +8,7 @@ io.encodings.utf8 ;
IN: editors.jedit
: jedit-server-info ( -- port auth )
home "/.jedit/server" append-path ascii [
home ".jedit/server" append-path ascii [
readln drop
readln string>number
readln string>number

2
extra/editors/ultraedit/ultraedit.factor
View File

@ -5,7 +5,7 @@ IN: editors.ultraedit
: ultraedit-path ( -- path )
\ ultraedit-path get-global [
program-files
"\\IDM Computer Solutions\\UltraEdit-32\\uedit32.exe" append-path
"IDM Computer Solutions\\UltraEdit-32\\uedit32.exe" append-path
] unless* ;
: ultraedit ( file line -- )

4
extra/editors/wordpad/wordpad.factor
View File

@ -5,10 +5,10 @@ IN: editors.wordpad
: wordpad-path ( -- path )
\ wordpad-path get [
program-files "\\Windows NT\\Accessories\\wordpad.exe" append-path
program-files "Windows NT\\Accessories\\wordpad.exe" append-path
] unless* ;
: wordpad ( file line -- )
drop wordpad-path swap 2array run-detached drop ;
drop wordpad-path swap 2array dup . run-detached drop ;
[ wordpad ] edit-hook set-global

18
extra/io/unix/files/files.factor
View File

@ -7,11 +7,11 @@ calendar io.encodings.binary ;
IN: io.unix.files
M: unix-io cwd
M: unix-io cwd ( -- path )
MAXPATHLEN [ <byte-array> ] [ ] bi getcwd
[ (io-error) ] unless* ;
M: unix-io cd
M: unix-io cd ( path -- )
chdir io-error ;
: read-flags O_RDONLY ; inline
@ -39,25 +39,26 @@ M: unix-io (file-writer) ( path -- stream )
M: unix-io (file-appender) ( path -- stream )
open-append <writer> ;
: touch-mode
: touch-mode ( -- n )
{ O_WRONLY O_APPEND O_CREAT O_EXCL } flags ; foldable
M: unix-io touch-file ( path -- )
normalize-pathname
touch-mode file-mode open
dup 0 < [ err_no EEXIST = [ err_no io-error ] unless ] when
close ;
M: unix-io move-file ( from to -- )
rename io-error ;
[ normalize-pathname ] 2apply rename io-error ;
M: unix-io delete-file ( path -- )
unlink io-error ;
normalize-pathname unlink io-error ;
M: unix-io make-directory ( path -- )
OCT: 777 mkdir io-error ;
normalize-pathname OCT: 777 mkdir io-error ;
M: unix-io delete-directory ( path -- )
rmdir io-error ;
normalize-pathname rmdir io-error ;
: (copy-file) ( from to -- )
dup parent-directory make-directories
@ -68,8 +69,9 @@ M: unix-io delete-directory ( path -- )
] with-disposal ;
M: unix-io copy-file ( from to -- )
[ normalize-pathname ] 2apply
[ (copy-file) ]
[ swap file-info file-info-permissions chmod io-error ]
[ swap file-info file-info-permissions chmod io-error ]
2bi ;
: stat>type ( stat -- type )

30
extra/peg/ebnf/ebnf-tests.factor
View File

@ -142,4 +142,32 @@ IN: peg.ebnf.tests
{ f } [
"Z" [EBNF foo=[^A-Z] EBNF] call
] unit-test
] 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

4
extra/peg/ebnf/ebnf.factor
View File

@ -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

30
extra/peg/peg-docs.factor
View File

@ -12,7 +12,7 @@ HELP: parse
{ $description
"Given the input string, parse it using the given parser. The result is a <parse-result> 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

38
extra/peg/peg-tests.factor
View File

@ -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

43
extra/peg/peg.factor
View File

@ -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
<PRIVATE
@ -313,7 +338,7 @@ MEMO: 3seq ( parser1 parser2 parser3 -- parser )
MEMO: 4seq ( parser1 parser2 parser3 parser4 -- parser )
4array seq ;
MEMO: seq* ( quot -- paser )
: seq* ( quot -- paser )
{ } make seq ; inline
MEMO: choice ( seq -- parser )
@ -328,7 +353,7 @@ MEMO: 3choice ( parser1 parser2 parser3 -- parser )
MEMO: 4choice ( parser1 parser2 parser3 parser4 -- parser )
4array choice ;
MEMO: choice* ( quot -- paser )
: choice* ( quot -- paser )
{ } make choice ; inline
MEMO: repeat0 ( parser -- parser )

5
extra/tools/deploy/deploy-tests.factor
View File

@ -1,10 +1,11 @@
IN: tools.deploy.tests
USING: tools.test system io.files kernel tools.deploy.config
tools.deploy.backend math sequences io.launcher arrays
namespaces ;
namespaces continuations ;
: shake-and-bake ( vocab -- )
"." resource-path [
[ "test.image" temp-file delete-file ] ignore-errors
"resource:" [
>r vm
"test.image" temp-file
r> dup deploy-config make-deploy-image

17
extra/tools/deploy/macosx/macosx.factor
View File

@ -62,11 +62,12 @@ T{ macosx-deploy-implementation } deploy-implementation set-global
M: macosx-deploy-implementation deploy* ( vocab -- )
".app deploy tool" assert.app
"." resource-path cd
dup deploy-config [
bundle-name dup exists? [ delete-tree ] [ drop ] if
[ bundle-name create-app-dir ] keep
[ bundle-name deploy.app-image ] keep
namespace make-deploy-image
bundle-name show-in-finder
] bind ;
"resource:" [
dup deploy-config [
bundle-name dup exists? [ delete-tree ] [ drop ] if
[ bundle-name create-app-dir ] keep
[ bundle-name deploy.app-image ] keep
namespace make-deploy-image
bundle-name show-in-finder
] bind
] with-directory ;

2
extra/tools/deploy/shaker/shaker.factor
View File

@ -81,7 +81,7 @@ IN: tools.deploy.shaker
[
"class" ,
"metaclass" ,
"slot-names" ,
"layout" ,
deploy-ui? get [
"gestures" ,
"commands" ,

11
extra/unix/bsd/bsd.factor
View File

@ -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

3
extra/unix/bsd/freebsd/freebsd.factor Normal file
View File

@ -0,0 +1,3 @@
IN: unix
: FD_SETSIZE 1024 ;

3
extra/unix/bsd/macosx/macosx.factor Normal file
View File

@ -0,0 +1,3 @@
IN: unix
: FD_SETSIZE 1024 ; inline

3
extra/unix/bsd/netbsd/netbsd.factor Normal file
View File

@ -0,0 +1,3 @@
IN: unix
: FD_SETSIZE 256 ; inline

3
extra/unix/bsd/openbsd/openbsd.factor Normal file
View File

@ -0,0 +1,3 @@
IN: unix
: FD_SETSIZE 1024 ; inline

13
extra/unix/kqueue/freebsd/freebsd.factor Normal file
View File

@ -0,0 +1,13 @@
USE: alien.syntax
IN: unix.kqueue
C-STRUCT: kevent
{ "ulong" "ident" } ! identifier for this event
{ "short" "filter" } ! filter for event
{ "ushort" "flags" } ! action flags for kqueue
{ "uint" "fflags" } ! filter flag value
{ "long" "data" } ! filter data value
{ "void*" "udata" } ! opaque user data identifier
;
FUNCTION: int kevent ( int kq, kevent* changelist, int nchanges, kevent* eventlist, int nevents, timespec* timeout ) ;

15
extra/unix/kqueue/kqueue.factor
View File

@ -1,21 +1,12 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax ;
USING: alien.syntax system sequences vocabs.loader ;
IN: unix.kqueue
<< "unix.kqueue." os append require >>
FUNCTION: int kqueue ( ) ;
FUNCTION: int kevent ( int kq, kevent* changelist, int nchanges, kevent* eventlist, int nevents, timespec* timeout ) ;
C-STRUCT: kevent
{ "ulong" "ident" } ! identifier for this event
{ "short" "filter" } ! filter for event
{ "ushort" "flags" } ! action flags for kqueue
{ "uint" "fflags" } ! filter flag value
{ "long" "data" } ! filter data value
{ "void*" "udata" } ! opaque user data identifier
;
: EVFILT_READ -1 ; inline
: EVFILT_WRITE -2 ; inline
: EVFILT_AIO -3 ; inline ! attached to aio requests

13
extra/unix/kqueue/macosx/macosx.factor Normal file
View File

@ -0,0 +1,13 @@
USE: alien.syntax
IN: unix.kqueue
C-STRUCT: kevent
{ "ulong" "ident" } ! identifier for this event
{ "short" "filter" } ! filter for event
{ "ushort" "flags" } ! action flags for kqueue
{ "uint" "fflags" } ! filter flag value
{ "long" "data" } ! filter data value
{ "void*" "udata" } ! opaque user data identifier
;
FUNCTION: int kevent ( int kq, kevent* changelist, int nchanges, kevent* eventlist, int nevents, timespec* timeout ) ;

14
extra/unix/kqueue/netbsd/netbsd.factor Normal file
View File

@ -0,0 +1,14 @@
USE: alien.syntax
IN: unix.kqueue
C-STRUCT: kevent
{ "ulong" "ident" } ! identifier for this event
{ "uint" "filter" } ! filter for event
{ "uint" "flags" } ! action flags for kqueue
{ "uint" "fflags" } ! filter flag value
{ "longlong" "data" } ! filter data value
{ "void*" "udata" } ! opaque user data identifier
;
FUNCTION: int kevent ( int kq, kevent* changelist, size_t nchanges, kevent* eventlist, size_t nevents, timespec* timeout ) ;

14
extra/unix/kqueue/openbsd/openbsd.factor Normal file
View File

@ -0,0 +1,14 @@
USE: alien.syntax
IN: unix.kqueue
C-STRUCT: kevent
{ "ulong" "ident" } ! identifier for this event
{ "uint" "filter" } ! filter for event
{ "uint" "flags" } ! action flags for kqueue
{ "uint" "fflags" } ! filter flag value
{ "longlong" "data" } ! filter data value
{ "void*" "udata" } ! opaque user data identifier
;
FUNCTION: int kevent ( int kq, kevent* changelist, size_t nchanges, kevent* eventlist, size_t nevents, timespec* timeout ) ;

29
extra/unix/stat/netbsd/32/32.factor Normal file
View File

@ -0,0 +1,29 @@
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 __stat30 ( char* pathname, stat* buf ) ;
FUNCTION: int __lstat30 ( char* pathname, stat* buf ) ;
: stat __stat30 ;
: lstat __lstat30 ;

29
extra/unix/stat/netbsd/64/64.factor Normal file
View File

@ -0,0 +1,29 @@
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" } ;
FUNCTION: int __stat13 ( char* pathname, stat* buf ) ;
FUNCTION: int __lstat13 ( char* pathname, stat* buf ) ;
: stat __stat13 ; inline
: lstat __lstat13 ; inline

29
extra/unix/stat/netbsd/netbsd.factor
View File

@ -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

6
extra/unix/types/netbsd/32/32.factor Executable file
View File

@ -0,0 +1,6 @@
USING: alien.syntax ;
IN: unix.types
! NetBSD 4.0
TYPEDEF: __uint64_t ino_t

6
extra/unix/types/netbsd/64/64.factor Executable file
View File

@ -0,0 +1,6 @@
USING: alien.syntax ;
IN: unix.types
! NetBSD 4.0
TYPEDEF: __uint32_t ino_t

12
extra/unix/types/netbsd/netbsd.factor
View File

@ -1,4 +1,4 @@
USING: alien.syntax ;
USING: alien.syntax combinators layouts vocabs.loader ;
IN: unix.types
! NetBSD 4.0
@ -18,7 +18,6 @@ TYPEDEF: ulonglong u_int64_t
TYPEDEF: __uint32_t __dev_t
TYPEDEF: __uint32_t dev_t
TYPEDEF: __uint64_t ino_t
TYPEDEF: __uint32_t mode_t
TYPEDEF: __uint32_t nlink_t
TYPEDEF: __uint32_t uid_t
@ -26,7 +25,12 @@ 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: long ssize_t
TYPEDEF: int pid_t
TYPEDEF: int time_t
cell-bits {
{ 32 [ "unix.types.netbsd.32" require ] }
{ 64 [ "unix.types.netbsd.64" require ] }
} case

1
extra/unix/unix.factor
View File

@ -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

2
misc/factor.sh
View File

@ -306,7 +306,7 @@ update_boot_images() {
echo "Deleting old images..."
rm checksums.txt* > /dev/null 2>&1
rm $BOOT_IMAGE.* > /dev/null 2>&1
rm staging.*.image > /dev/null 2>&1
rm temp/staging.*.image > /dev/null 2>&1
if [[ -f $BOOT_IMAGE ]] ; then
get_url http://factorcode.org/images/latest/checksums.txt
factorcode_md5=`cat checksums.txt|grep $BOOT_IMAGE|cut -f2 -d' '`;

0
vm/os-linux-x86-32.h → vm/os-linux-x86.32.h
View File

0
vm/os-linux-x86-64.h → vm/os-linux-x86.64.h
View File

3
vm/os-netbsd-x86.32.h Normal file
View File

@ -0,0 +1,3 @@
#include <ucontext.h>
#define ucontext_stack_pointer(uap) ((void *)_UC_MACHINE_SP((ucontext_t *)uap))

4
vm/os-netbsd-x86.64.h Normal file
View File

@ -0,0 +1,4 @@
#include <ucontext.h>
#define ucontext_stack_pointer(uap) \
((void *)(((ucontext_t *)(uap))->uc_mcontext.__gregs[_REG_URSP]))

1
vm/os-netbsd.h
View File

@ -1,6 +1,5 @@
#include <ucontext.h>
#define ucontext_stack_pointer(uap) ((void *)_UC_MACHINE_SP((ucontext_t *)uap))
#define UAP_PROGRAM_COUNTER(uap) _UC_MACHINE_PC((ucontext_t *)uap)
#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN)

13
vm/platform.h
View File

@ -67,20 +67,29 @@
#endif
#elif defined(__NetBSD__)
#define FACTOR_OS_STRING "netbsd"
#if defined(FACTOR_X86)
#include "os-netbsd-x86.32.h"
#elif defined(FACTOR_AMD64)
#include "os-netbsd-x86.64.h"
#else
#error "Unsupported NetBSD flavor"
#endif
#include "os-netbsd.h"
#elif defined(linux)
#define FACTOR_OS_STRING "linux"
#include "os-linux.h"
#if defined(FACTOR_X86)
#include "os-linux-x86-32.h"
#include "os-linux-x86.32.h"
#elif defined(FACTOR_PPC)
#include "os-unix-ucontext.h"
#include "os-linux-ppc.h"
#elif defined(FACTOR_ARM)
#include "os-linux-arm.h"
#elif defined(FACTOR_AMD64)
#include "os-linux-x86-64.h"
#include "os-linux-x86.64.h"
#else
#error "Unsupported Linux flavor"
#endif