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

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

release
Daniel Ehrenberg 2010-01-26 14:14:05 -06:00
parent 52f2ac2bb9 ce5cf520b3
commit 19d551a544
171 changed files with 2095 additions and 1122 deletions
basis
alien/c-types
bootstrap
cocoa
command-line
compiler
compression/lzw
concurrency/combinators
cpu/x86
db
dlists
documents
environment/unix
eval
game/input/dinput
grouping
help
images/jpeg
io
listener
lists
locals
math
prettyprint/stylesheet
regexp
sequences
specialized-arrays
specialized-vectors
stack-checker/known-words
tools
ui/gadgets
unicode/case
unix
Show More

2
GNUmakefile
View File

@ -213,6 +213,8 @@ endif
clean:
rm -f vm/*.o
rm -f factor.dll
rm -f factor.lib
rm -f factor.dll.lib
rm -f libfactor.*
rm -f libfactor-ffi-test.*
rm -f Factor.app/Contents/Frameworks/libfactor.dylib

11
Nmakefile
View File

@ -1,5 +1,10 @@
!IF DEFINED(DEBUG)
LINK_FLAGS = /nologo /DEBUG shell32.lib
CL_FLAGS = /nologo /Zi /O2 /W3 /DFACTOR_DEBUG
!ELSE
LINK_FLAGS = /nologo shell32.lib
CL_FLAGS = /nologo /O2 /W3
!ENDIF
EXE_OBJS = factor.dll.lib vm\main-windows-nt.obj vm\factor.res
@ -50,11 +55,17 @@ DLL_OBJS = vm\os-windows-nt.obj \
.cpp.obj:
cl /EHsc $(CL_FLAGS) /Fo$@ /c $<
.c.obj:
cl $(CL_FLAGS) /Fo$@ /c $<
.rs.res:
rc $<
all: factor.com factor.exe
libfactor-ffi-test.dll: vm/ffi_test.obj
link $(LINK_FLAGS) /out:libfactor-ffi-test.dll /dll vm/ffi_test.obj
factor.dll.lib: $(DLL_OBJS)
link $(LINK_FLAGS) /implib:factor.dll.lib /out:factor.dll /dll $(DLL_OBJS)

115
basis/alien/c-types/c-types.factor
View File

@ -348,52 +348,6 @@ SYMBOLS:
"alien_offset" >>unboxer
\ void* define-primitive-type
<long-long-type>
integer >>class
integer >>boxed-class
[ alien-signed-8 ] >>getter
[ set-alien-signed-8 ] >>setter
8 >>size
8-byte-alignment
"from_signed_8" >>boxer
"to_signed_8" >>unboxer
\ longlong define-primitive-type
<long-long-type>
integer >>class
integer >>boxed-class
[ alien-unsigned-8 ] >>getter
[ set-alien-unsigned-8 ] >>setter
8 >>size
8-byte-alignment
"from_unsigned_8" >>boxer
"to_unsigned_8" >>unboxer
\ ulonglong define-primitive-type
<c-type>
integer >>class
integer >>boxed-class
[ alien-signed-cell ] >>getter
[ set-alien-signed-cell ] >>setter
bootstrap-cell >>size
bootstrap-cell >>align
bootstrap-cell >>align-first
"from_signed_cell" >>boxer
"to_fixnum" >>unboxer
\ long define-primitive-type
<c-type>
integer >>class
integer >>boxed-class
[ alien-unsigned-cell ] >>getter
[ set-alien-unsigned-cell ] >>setter
bootstrap-cell >>size
bootstrap-cell >>align
bootstrap-cell >>align-first
"from_unsigned_cell" >>boxer
"to_cell" >>unboxer
\ ulong define-primitive-type
<c-type>
integer >>class
integer >>boxed-class
@ -514,16 +468,75 @@ SYMBOLS:
[ >float ] >>unboxer-quot
\ double define-primitive-type
cpu x86.64? os windows? and [
cell 8 = [
<c-type>
integer >>class
integer >>boxed-class
[ alien-signed-cell ] >>getter
[ set-alien-signed-cell ] >>setter
bootstrap-cell >>size
bootstrap-cell >>align
bootstrap-cell >>align-first
"from_signed_cell" >>boxer
"to_fixnum" >>unboxer
\ longlong define-primitive-type
<c-type>
integer >>class
integer >>boxed-class
[ alien-unsigned-cell ] >>getter
[ set-alien-unsigned-cell ] >>setter
bootstrap-cell >>size
bootstrap-cell >>align
bootstrap-cell >>align-first
"from_unsigned_cell" >>boxer
"to_cell" >>unboxer
\ ulonglong define-primitive-type
os windows? [
\ int c-type \ long define-primitive-type
\ uint c-type \ ulong define-primitive-type
] [
\ longlong c-type \ long define-primitive-type
\ ulonglong c-type \ ulong define-primitive-type
] if
\ longlong c-type \ ptrdiff_t typedef
\ longlong c-type \ intptr_t typedef
\ ulonglong c-type \ uintptr_t typedef
\ ulonglong c-type \ size_t typedef
] [
\ long c-type \ ptrdiff_t typedef
\ long c-type \ intptr_t typedef
\ ulong c-type \ uintptr_t typedef
\ ulong c-type \ size_t typedef
<long-long-type>
integer >>class
integer >>boxed-class
[ alien-signed-8 ] >>getter
[ set-alien-signed-8 ] >>setter
8 >>size
8-byte-alignment
"from_signed_8" >>boxer
"to_signed_8" >>unboxer
\ longlong define-primitive-type
<long-long-type>
integer >>class
integer >>boxed-class
[ alien-unsigned-8 ] >>getter
[ set-alien-unsigned-8 ] >>setter
8 >>size
8-byte-alignment
"from_unsigned_8" >>boxer
"to_unsigned_8" >>unboxer
\ ulonglong define-primitive-type
\ int c-type \ long define-primitive-type
\ uint c-type \ ulong define-primitive-type
\ int c-type \ ptrdiff_t typedef
\ int c-type \ intptr_t typedef
\ uint c-type \ uintptr_t typedef
\ uint c-type \ size_t typedef
] if
] with-compilation-unit

11
basis/bootstrap/finish-bootstrap.factor
View File

@ -8,9 +8,14 @@ namespaces eval kernel vocabs.loader io ;
(command-line) parse-command-line
load-vocab-roots
run-user-init
"e" get [ eval( -- ) ] when*
ignore-cli-args? not script get and
[ run-script ] [ "run" get run ] if*
"e" get script get or [
"e" get [ eval( -- ) ] when*
script get [ run-script ] when*
] [
"run" get run
] if
output-stream get [ stream-flush ] when*
0 exit
] [ print-error 1 exit ] recover

2
basis/cocoa/cocoa-tests.factor
View File

@ -1,5 +1,5 @@
USING: cocoa cocoa.messages cocoa.subclassing cocoa.types
compiler kernel namespaces cocoa.classes cocoa.runtime
compiler.test kernel namespaces cocoa.classes cocoa.runtime
tools.test memory compiler.units math core-graphics.types ;
FROM: alien.c-types => int void ;
IN: cocoa.tests

4
basis/command-line/command-line-docs.factor
View File

@ -37,10 +37,6 @@ HELP: main-vocab
HELP: default-cli-args
{ $description "Sets global variables corresponding to default command line arguments." } ;
HELP: ignore-cli-args?
{ $values { "?" "a boolean" } }
{ $description "On Mac OS X, source files to run are supplied by the Cocoa API, so to avoid running them twice the startup code has to call this word." } ;
ARTICLE: "runtime-cli-args" "Command line switches for the VM"
"A handful of command line switches are processed by the VM and not the library. They control low-level features."
{ $table

3
basis/command-line/command-line.factor
View File

@ -67,7 +67,4 @@ SYMBOL: main-vocab-hook
main-vocab "run" set
] bind ;
: ignore-cli-args? ( -- ? )
os macosx? "run" get "ui" = and ;
[ default-cli-args ] "command-line" add-startup-hook

4
basis/compiler/cfg/ssa/construction/tdmsc/tdmsc.factor
View File

@ -86,7 +86,7 @@ SYMBOLS: visited merge-sets levels again? ;
cfg get reverse-post-order ; inline
: filter-by ( flags seq -- seq' )
[ drop ] pusher [ 2each ] dip ;
[ drop ] selector [ 2each ] dip ;
HINTS: filter-by { bit-array object } ;
@ -107,4 +107,4 @@ PRIVATE>
] 2each ; inline
: merge-set ( bbs -- bbs' )
(merge-set) filter-by ;
(merge-set) filter-by ;

2
basis/compiler/cfg/stacks/uninitialized/uninitialized.factor
View File

@ -55,7 +55,7 @@ M: insn visit-insn drop ;
2dup [ length ] bi@ max '[ _ 1 pad-tail ] bi@ [ bitand ] 2map ;
: (uninitialized-locs) ( seq quot -- seq' )
[ [ drop 0 = ] pusher [ each-index ] dip ] dip map ; inline
[ [ drop 0 = ] selector [ each-index ] dip ] dip map ; inline
PRIVATE>

15
basis/compiler/compiler-docs.factor
View File

@ -16,11 +16,7 @@ ARTICLE: "compiler-usage" "Calling the optimizing compiler"
disable-optimizer
enable-optimizer
}
"Removing a word's optimized definition:"
{ $subsections decompile }
"Compiling a single quotation:"
{ $subsections compile-call }
"Higher-level words can be found in " { $link "compilation-units" } "." ;
"More words can be found in " { $link "compilation-units" } "." ;
ARTICLE: "compiler-impl" "Compiler implementation"
"The " { $vocab-link "compiler" } "vocabulary, in addition to providing the user-visible words of the compiler, implements the main compilation loop."
@ -60,10 +56,6 @@ $nl
ABOUT: "compiler"
HELP: decompile
{ $values { "word" word } }
{ $description "Removes a word's optimized definition. The word will be compiled with the non-optimizing compiler until recompiled with the optimizing compiler again." } ;
HELP: compile-word
{ $values { "word" word } }
{ $description "Compile a single word." }
@ -72,8 +64,3 @@ HELP: compile-word
HELP: optimizing-compiler
{ $description "Singleton class implementing " { $link recompile } " to call the optimizing compiler." }
{ $notes "This is an internal word, and user code should call " { $link compile } " instead." } ;
HELP: compile-call
{ $values { "quot" quotation } }
{ $description "Compiles and runs a quotation." }
{ $notes "This word is used by compiler unit tests to test compilation of small pieces of code." } ;

13
basis/compiler/compiler.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2004, 2009 Slava Pestov.
! Copyright (C) 2004, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel namespaces arrays sequences io words fry
continuations vocabs assocs dlists definitions math graphs generic
@ -181,14 +181,6 @@ t compile-dependencies? set-global
: compile-loop ( deque -- )
[ compile-word yield-hook get call( -- ) ] slurp-deque ;
: decompile ( word -- )
dup def>> 2array 1array modify-code-heap ;
: compile-call ( quot -- )
[ dup infer define-temp ] with-compilation-unit execute ;
\ compile-call t "no-compile" set-word-prop
SINGLETON: optimizing-compiler
M: optimizing-compiler recompile ( words -- alist )
@ -220,6 +212,3 @@ M: optimizing-compiler process-forgotten-words
: disable-optimizer ( -- )
f compiler-impl set-global ;
: recompile-all ( -- )
all-words compile ;

1
basis/compiler/test/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

19
basis/compiler/test/test.factor Normal file
View File

@ -0,0 +1,19 @@
! Copyright (C) 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays compiler.units kernel stack-checker
sequences vocabs words tools.test tools.test.private ;
IN: compiler.test
: decompile ( word -- )
dup def>> 2array 1array modify-code-heap ;
: recompile-all ( -- )
all-words compile ;
: compile-call ( quot -- )
[ dup infer define-temp ] with-compilation-unit execute ;
<< \ compile-call t "no-compile" set-word-prop >>
: compiler-test ( name -- )
"resource:basis/compiler/tests/" ".factor" surround run-test-file ;

2
basis/compiler/tests/codegen.factor
View File

@ -1,4 +1,4 @@
USING: generalizations accessors arrays compiler kernel
USING: generalizations accessors arrays compiler.test kernel
kernel.private math hashtables.private math.private namespaces
sequences tools.test namespaces.private slots.private
sequences.private byte-arrays alien alien.accessors layouts

2
basis/compiler/tests/curry.factor
View File

@ -1,5 +1,5 @@
USING: tools.test quotations math kernel sequences
assocs namespaces make compiler.units compiler ;
assocs namespaces make compiler.units compiler.test ;
IN: compiler.tests.curry
[ 3 ] [ 5 [ [ 2 - ] curry call ] compile-call ] unit-test

5
basis/compiler/tests/float.factor
View File

@ -1,5 +1,6 @@
USING: compiler.units compiler kernel kernel.private memory math
math.private tools.test math.floats.private math.order fry ;
USING: compiler.units compiler.test kernel kernel.private memory
math math.private tools.test math.floats.private math.order fry
;
IN: compiler.tests.float
[ 5.0 ] [ [ 5.0 ] compile-call gc gc gc ] unit-test

2
basis/compiler/tests/intrinsics.factor
View File

@ -4,7 +4,7 @@ strings tools.test words continuations sequences.private
hashtables.private byte-arrays system random layouts vectors
sbufs strings.private slots.private alien math.order
alien.accessors alien.c-types alien.data alien.syntax alien.strings
namespaces libc io.encodings.ascii classes compiler ;
namespaces libc io.encodings.ascii classes compiler.test ;
FROM: math => float ;
IN: compiler.tests.intrinsics

2
basis/compiler/tests/optimizer.factor
View File

@ -4,7 +4,7 @@ sbufs strings tools.test vectors words sequences.private
quotations classes classes.algebra classes.tuple.private
continuations growable namespaces hints alien.accessors
compiler.tree.builder compiler.tree.optimizer sequences.deep
compiler definitions generic.single shuffle math.order ;
compiler.test definitions generic.single shuffle math.order ;
IN: compiler.tests.optimizer
GENERIC: xyz ( obj -- obj )

2
basis/compiler/tests/simple.factor
View File

@ -1,4 +1,4 @@
USING: compiler compiler.units tools.test kernel kernel.private
USING: compiler.test compiler.units tools.test kernel kernel.private
sequences.private math.private math combinators strings alien
arrays memory vocabs parser eval quotations compiler.errors
definitions ;

2
basis/compiler/tests/tuples.factor
View File

@ -1,4 +1,4 @@
USING: kernel tools.test compiler.units compiler ;
USING: kernel tools.test compiler.units compiler.test ;
IN: compiler.tests.tuples
TUPLE: color red green blue ;

4
basis/compression/lzw/lzw-docs.factor
View File

@ -52,7 +52,7 @@ HELP: reset-lzw-uncompress
}
{ $description "Reset the LZW uncompressor state (either at initialization time or immediately after receiving a Clear Code). " } ;
ARTICLE: "compression.lzw.differences" "LZW Differences between TIFF and GIF"
ARTICLE: "compression.lzw.differences" "LZW differences between TIFF and GIF"
{ $vocab-link "compression.lzw" }
$nl
"There are some subtle differences between the LZW algorithm used by TIFF and GIF images."
@ -66,7 +66,7 @@ $nl
"TIFF and GIF both add the concept of a 'Clear Code' and a 'End of Information Code' to the LZW algorithm. In both cases, the 'Clear Code' is equal to 2**(code-size - 1) and the 'End of Information Code' is equal to the Clear Code + 1. These 2 codes are reserved in the string table. So in both cases, the LZW string table is initialized to have a length equal to the End of Information Code + 1."
;
ARTICLE: "compression.lzw" "LZW Compression"
ARTICLE: "compression.lzw" "LZW compression"
{ $vocab-link "compression.lzw" }
$nl
"Implements both the TIFF and GIF variations of the LZW algorithm."

2
basis/concurrency/combinators/combinators.factor
View File

@ -22,7 +22,7 @@ PRIVATE>
] (parallel-each) ; inline
: parallel-filter ( seq quot -- newseq )
over [ pusher [ parallel-each ] dip ] dip like ; inline
over [ selector [ parallel-each ] dip ] dip like ; inline
<PRIVATE

18
basis/cpu/x86/64/64.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2005, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays kernel math namespaces make sequences
system layouts alien alien.c-types alien.accessors slots
splitting assocs combinators locals compiler.constants
system layouts alien alien.c-types alien.accessors alien.libraries
slots splitting assocs combinators locals compiler.constants
compiler.codegen compiler.codegen.fixup
compiler.cfg.instructions compiler.cfg.builder
compiler.cfg.intrinsics compiler.cfg.stack-frame
@ -118,9 +118,6 @@ M:: x86.64 %unbox ( n rep func -- )
! this is the end of alien-callback
n [ n rep reg-class-of return-reg rep %save-param-reg ] when ;
M: x86.64 %unbox-long-long ( n func -- )
[ int-rep ] dip %unbox ;
: %unbox-struct-field ( c-type i -- )
! Alien must be in param-reg-0.
R11 swap cells [+] swap rep>> reg-class-of {
@ -163,12 +160,11 @@ M:: x86.64 %box ( n rep func -- )
] [
rep load-return-value
] if
rep int-rep? [ param-reg-1 ] [ param-reg-0 ] if %mov-vm-ptr
rep int-rep?
cpu x86.64? os windows? and or
param-reg-1 param-reg-0 ? %mov-vm-ptr
func f %alien-invoke ;
M: x86.64 %box-long-long ( n func -- )
[ int-rep ] dip %box ;
: box-struct-field@ ( i -- operand ) 1 + cells param@ ;
: %box-struct-field ( c-type i -- )
@ -258,7 +254,7 @@ M: x86.64 %callback-value ( ctype -- )
M:: x86.64 %unary-float-function ( dst src func -- )
0 src float-function-param
func f %alien-invoke
func "libm" load-library %alien-invoke
dst float-function-return ;
M:: x86.64 %binary-float-function ( dst src1 src2 func -- )
@ -266,7 +262,7 @@ M:: x86.64 %binary-float-function ( dst src1 src2 func -- )
! src2 is always a spill slot
0 src1 float-function-param
1 src2 float-function-param
func f %alien-invoke
func "libm" load-library %alien-invoke
dst float-function-return ;
M:: x86.64 %call-gc ( gc-root-count temp -- )

2
basis/cpu/x86/64/winnt/winnt.factor
View File

@ -22,5 +22,5 @@ M: x86.64 dummy-int-params? t ;
M: x86.64 dummy-fp-params? t ;
M: x86.64 temp-reg RAX ;
M: x86.64 temp-reg R11 ;

4
basis/cpu/x86/x86.factor
View File

@ -56,8 +56,8 @@ M: x86 stack-frame-size ( stack-frame -- i )
3 cells +
align-stack ;
! Must be a volatile register not used for parameter passing, for safe
! use in calls in and out of C
! Must be a volatile register not used for parameter passing or
! integer return
HOOK: temp-reg cpu ( -- reg )
HOOK: pic-tail-reg cpu ( -- reg )

2
basis/db/db.factor
View File

@ -113,7 +113,7 @@ M: object execute-statement* ( statement type -- )
] if ; inline recursive
: query-map ( statement quot -- seq )
accumulator [ query-each ] dip { } like ; inline
collector [ query-each ] dip { } like ; inline
: with-db ( db quot -- )
[ db-open db-connection ] dip

2
basis/dlists/dlists.factor
View File

@ -153,7 +153,7 @@ M: dlist clear-deque ( dlist -- )
'[ obj>> @ ] dlist-each-node ; inline
: dlist>seq ( dlist -- seq )
[ ] accumulator [ dlist-each ] dip ;
[ ] collector [ dlist-each ] dip ;
: 1dlist ( obj -- dlist ) <dlist> [ push-front ] keep ;

2
basis/documents/documents.factor
View File

@ -61,7 +61,7 @@ TUPLE: document < model locs undos redos inside-undo? ;
] if ; inline
: map-lines ( from to quot -- results )
accumulator [ each-line ] dip ; inline
collector [ each-line ] dip ; inline
: start/end-on-line ( from to line# document -- n1 n2 )
[ start-on-line ] [ end-on-line ] bi-curry bi-curry bi* ;

2
basis/environment/unix/unix.factor
View File

@ -3,7 +3,7 @@
USING: alien alien.c-types alien.data alien.strings
alien.syntax kernel layouts sequences system unix
environment io.encodings.utf8 unix.utilities vocabs.loader
combinators alien.accessors ;
combinators alien.accessors unix.ffi ;
IN: environment.unix
HOOK: environ os ( -- void* )

60
basis/eval/eval-docs.factor
View File

@ -1,25 +1,73 @@
IN: eval
USING: help.markup help.syntax strings io effects ;
USING: help.markup help.syntax strings io effects parser
listener vocabs.parser debugger combinators ;
HELP: (eval)
{ $values { "str" string } { "effect" effect } }
{ $description "Parses Factor source code from a string, and calls the resulting quotation, which must have the given stack effect." }
{ $notes "This word must be wrapped within " { $link with-file-vocabs } " or " { $link with-interactive-vocabs } ", since it assumes that the " { $link manifest } " variable is set in the current dynamic scope." }
{ $errors "Throws an error if the input is malformed, or if the evaluation itself throws an error." } ;
HELP: eval
{ $values { "str" string } { "effect" effect } }
{ $description "Parses Factor source code from a string, and calls the resulting quotation, which must have the given stack effect." }
{ $notes "The code string is parsed and called in a new dynamic scope with an initial vocabulary search path consisting of just the " { $snippet "syntax" } " vocabulary. The evaluated code can use " { $link "word-search-syntax" } " to alter the search path." }
{ $errors "Throws an error if the input is malformed, or if the evaluation itself throws an error." } ;
HELP: eval(
{ $syntax "eval( inputs -- outputs )" }
{ $description "Parses Factor source code from the string at the top of the stack, and calls the resulting quotation, which must have the given stack effect." }
{ $notes
"This parsing word is just a slightly nicer syntax for " { $link eval } ". The following are equivalent:"
{ $code
"eval( inputs -- outputs )"
"(( inputs -- outputs )) eval"
}
}
{ $errors "Throws an error if the input is malformed, or if the evaluation itself throws an error." } ;
HELP: eval>string
{ $values { "str" string } { "output" string } }
{ $description "Evaluates the Factor code in " { $snippet "str" } " with " { $link output-stream } " rebound to a string output stream, then outputs the resulting string. The code in the string must not take or leave any values on the stack." } ;
{ $description "Evaluates the Factor code in " { $snippet "str" } " with " { $link output-stream } " rebound to a string output stream, then outputs the resulting string. The code in the string must not take or leave any values on the stack." }
{ $errors "If the code throws an error, the error is caught, and the result of calling " { $link print-error } " on the error is returned." } ;
ARTICLE: "eval" "Evaluating strings at runtime"
"The " { $vocab-link "eval" } " vocabulary implements support for evaluating strings at runtime."
ARTICLE: "eval-vocabs" "Evaluating strings with a different vocabulary search path"
"Strings passed to " { $link eval } " are always evaluated with an initial vocabulary search path consisting of just the " { $snippet "syntax" } " vocabulary. This is the same search path that source files start out with. This behavior can be customized by taking advantage of the fact that " { $link eval } " is composed from two simpler words:"
{ $subsections
(eval)
with-file-vocabs
}
"Code in the listener tool starts out with a different initial search path, with more vocabularies are available by default. Strings of code can be evaluated in this search path by using " { $link (eval) } " with a different combinator:"
{ $subsections
with-interactive-vocabs
}
"When using " { $link (eval) } ", the quotation passed to " { $link with-file-vocabs } " and " { $link with-interactive-vocabs } " can also make specific vocabularies available to the evaluated string. This is done by having the quotation change the run-time vocabulary search path prior to calling " { $link (eval) } ". For run-time analogues of the parse-time " { $link "word-search-syntax" } " see " { $link "word-search-parsing" } "."
$nl
"The vocabulary set used by " { $link with-interactive-vocabs } " can be altered by rebinding a dynamic variable:"
{ $subsections interactive-vocabs }
{ $heading "Example" }
"In this example, a string is evaluated with a fictional " { $snippet "cad.objects" } " vocabulary in the search path by default, together with the listener's " { $link interactive-vocabs } "; the quotation is expected to produce a sequence on the stack:"
{ $code
"""USING: eval listener vocabs.parser ;
[
"cad-objects" use-vocab
(( -- seq )) (eval)
] with-interactive-vocabs"""
}
"Note that the search path in the outer code (set by the " { $link POSTPONE: USING: } " form) has no relation to the search path used when parsing the string parameter (this is determined by " { $link with-interactive-vocabs } " and " { $link use-vocab } ")." ;
ARTICLE: "eval" "Evaluating strings at run time"
"The " { $vocab-link "eval" } " vocabulary implements support for evaluating strings of code dynamically."
$nl
"The main entry point is a parsing word, which wraps a library word:"
{ $subsections
POSTPONE: eval(
eval>string
} ;
eval
}
"This pairing is analogous to that of " { $link POSTPONE: call( } " with " { $link call-effect } "."
$nl
"Advanced features:"
{ $subsections "eval-vocabs" eval>string }
;
ABOUT: "eval"

21
basis/game/input/dinput/dinput.factor Normal file → Executable file
View File

@ -1,13 +1,12 @@
USING: accessors alien alien.c-types alien.strings arrays
assocs byte-arrays combinators combinators.short-circuit
continuations game.input game.input.dinput.keys-array
io.encodings.utf16 io.encodings.utf16n kernel locals math
math.bitwise math.rectangles namespaces parser sequences
shuffle specialized-arrays ui.backend.windows vectors
windows.com windows.directx.dinput
windows.directx.dinput.constants .errors windows.kernel32
windows.messages .ole32 windows.user32 classes.struct
alien.data ;
USING: accessors alien alien.c-types alien.strings arrays assocs
byte-arrays combinators combinators.short-circuit continuations
game.input game.input.dinput.keys-array io.encodings.utf16
io.encodings.utf16n kernel locals math math.bitwise
math.rectangles namespaces parser sequences shuffle
specialized-arrays ui.backend.windows vectors windows.com
windows.directx.dinput windows.directx.dinput.constants
windows.kernel32 windows.messages windows.ole32 windows.errors
windows.user32 classes.struct alien.data ;
SPECIALIZED-ARRAY: DIDEVICEOBJECTDATA
IN: game.input.dinput
@ -315,7 +314,7 @@ CONSTANT: pov-values
} case ;
: fill-mouse-state ( buffer count -- state )
[ +mouse-state+ get ] 2dip swap [ nth (fill-mouse-state) ] curry each ;
iota [ +mouse-state+ get ] 2dip swap [ nth (fill-mouse-state) ] curry each ;
: get-device-state ( device DIJOYSTATE2 -- )
[ dup IDirectInputDevice8W::Poll ole32-error ] dip

2
basis/grouping/grouping-tests.factor
View File

@ -30,3 +30,5 @@ IN: grouping.tests
[ f ] [ [ 1.0 1 1 ] all-equal? ] unit-test
[ t ] [ { 1 2 3 4 } [ < ] monotonic? ] unit-test
[ f ] [ { 1 2 3 4 } [ > ] monotonic? ] unit-test
[ { 6 7 8 3 4 5 0 1 2 } ] [ 9 iota >array dup 3 <groups> reverse! drop ] unit-test

4
basis/help/crossref/crossref.factor
View File

@ -7,10 +7,10 @@ IN: help.crossref
: article-links ( topic elements -- seq )
[ article-content ] dip
collect-elements [ >link ] map ;
collect-elements ;
: article-children ( topic -- seq )
{ $subsection $subsections } article-links ;
{ $subsection $subsections } article-links [ >link ] map ;
: help-path ( topic -- seq )
[ article-parent ] follow rest ;

2
basis/help/lint/lint.factor
View File

@ -69,7 +69,7 @@ PRIVATE>
'[ _ vocab-help [ article drop ] when* ] check-something ;
: check-vocab ( vocab -- )
"Checking " write dup write "..." print
"Checking " write dup write "..." print flush
[ check-about ]
[ words [ check-word ] each ]
[ vocab-articles get at [ check-article ] each ]

2
basis/images/jpeg/jpeg.factor
View File

@ -351,7 +351,7 @@ SINGLETONS: YUV420 YUV444 Y MAGIC! ;
[ bitstream>> ]
[ [ [ <huffman-decoder> ] with map ] change-huff-tables drop ] bi
jpeg> components>> [ fetch-tables ] each
[ decode-macroblock 2array ] accumulator
[ decode-macroblock 2array ] collector
[ all-macroblocks ] dip
jpeg> setup-bitmap draw-macroblocks
jpeg> bitmap>> 3 <groups> [ color-transform ] map! drop

10
basis/io/backend/unix/unix.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax generic assocs kernel
kernel.private math io.ports sequences strings sbufs threads
unix vectors io.buffers io.backend io.encodings math.parser
unix unix.ffi vectors io.buffers io.backend io.encodings math.parser
continuations system libc namespaces make io.timeouts
io.encodings.utf8 destructors destructors.private accessors
summary combinators locals unix.time unix.types fry
@ -17,8 +17,8 @@ TUPLE: fd < disposable fd ;
: init-fd ( fd -- fd )
[
|dispose
dup fd>> F_SETFL O_NONBLOCK fcntl io-error
dup fd>> F_SETFD FD_CLOEXEC fcntl io-error
dup fd>> F_SETFL O_NONBLOCK [ fcntl ] unix-system-call drop
dup fd>> F_SETFD FD_CLOEXEC [ fcntl ] unix-system-call drop
] with-destructors ;
: <fd> ( n -- fd )
@ -50,7 +50,7 @@ M: fd cancel-operation ( fd -- )
] if ;
M: unix tell-handle ( handle -- n )
fd>> 0 SEEK_CUR lseek [ io-error ] [ ] bi ;
fd>> 0 SEEK_CUR [ lseek ] unix-system-call [ io-error ] [ ] bi ;
M: unix seek-handle ( n seek-type handle -- )
swap {
@ -59,7 +59,7 @@ M: unix seek-handle ( n seek-type handle -- )
{ io:seek-end [ SEEK_END ] }
[ io:bad-seek-type ]
} case
[ fd>> swap ] dip lseek io-error ;
[ fd>> swap ] dip [ lseek ] unix-system-call drop ;
SYMBOL: +retry+ ! just try the operation again without blocking
SYMBOL: +input+

6
basis/io/directories/search/search.factor
View File

@ -64,17 +64,17 @@ PRIVATE>
setup-traversal iterate-directory-entries drop ; inline
: recursive-directory-files ( path bfs? -- paths )
[ ] accumulator [ each-file ] dip ; inline
[ ] collector [ each-file ] dip ; inline
: recursive-directory-entries ( path bfs? -- directory-entries )
[ ] accumulator [ each-directory-entry ] dip ; inline
[ ] collector [ each-directory-entry ] dip ; inline
: find-file ( path bfs? quot -- path/f )
[ <directory-iterator> ] dip
[ keep and ] curry iterate-directory ; inline
: find-all-files ( path quot -- paths/f )
[ f <directory-iterator> ] dip pusher
[ f <directory-iterator> ] dip selector
[ [ f ] compose iterate-directory drop ] dip ; inline
ERROR: file-not-found path bfs? quot ;

4
basis/io/directories/unix/linux/linux.factor
View File

@ -1,11 +1,11 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types io.directories.unix kernel system unix
classes.struct ;
classes.struct unix.ffi ;
IN: io.directories.unix.linux
M: unix find-next-file ( DIR* -- dirent )
dirent <struct>
f <void*>
[ readdir64_r 0 = [ (io-error) ] unless ] 2keep
[ [ readdir64_r ] unix-system-call 0 = [ (io-error) ] unless ] 2keep
*void* [ drop f ] unless ;

8
basis/io/directories/unix/unix.factor
View File

@ -4,7 +4,7 @@ USING: accessors alien.c-types alien.strings combinators
continuations destructors fry io io.backend io.backend.unix
io.directories io.encodings.binary io.encodings.utf8 io.files
io.pathnames io.files.types kernel math.bitwise sequences system
unix unix.stat vocabs.loader classes.struct ;
unix unix.stat vocabs.loader classes.struct unix.ffi ;
IN: io.directories.unix
: touch-mode ( -- n )
@ -17,15 +17,15 @@ M: unix touch-file ( path -- )
] if ;
M: unix move-file ( from to -- )
[ normalize-path ] bi@ rename io-error ;
[ normalize-path ] bi@ [ rename ] unix-system-call drop ;
M: unix delete-file ( path -- ) normalize-path unlink-file ;
M: unix make-directory ( path -- )
normalize-path OCT: 777 mkdir io-error ;
normalize-path OCT: 777 [ mkdir ] unix-system-call drop ;
M: unix delete-directory ( path -- )
normalize-path rmdir io-error ;
normalize-path [ rmdir ] unix-system-call drop ;
M: unix copy-file ( from to -- )
[ normalize-path ] bi@ call-next-method ;

2
basis/io/files/info/info.factor
View File

@ -26,7 +26,7 @@ available-space free-space used-space total-space ;
HOOK: file-system-info os ( path -- file-system-info )
{
{ [ os unix? ] [ "io.files.info.unix." os name>> append ] }
{ [ os unix? ] [ "io.files.info" ] }
{ [ os windows? ] [ "io.files.info.windows" ] }
} cond require

25
basis/io/files/info/unix/unix.factor
View File

@ -1,13 +1,13 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel system math math.bitwise strings arrays
sequences combinators combinators.short-circuit alien.c-types
vocabs.loader calendar calendar.unix io.files.info
io.files.types io.backend io.directories unix unix.stat
unix.time unix.users unix.groups classes.struct
specialized-arrays literals ;
SPECIALIZED-ARRAY: timeval
USING: accessors alien.c-types arrays calendar calendar.unix
classes.struct combinators combinators.short-circuit io.backend
io.directories io.files.info io.files.types kernel literals
math math.bitwise sequences specialized-arrays strings system
unix unix.ffi unix.groups unix.stat unix.time unix.users
vocabs.loader ;
IN: io.files.info.unix
SPECIALIZED-ARRAY: timeval
TUPLE: unix-file-system-info < file-system-info
block-size preferred-block-size
@ -109,7 +109,7 @@ M: unix stat>type ( stat -- type )
: chmod-set-bit ( path mask ? -- )
[ dup stat-mode ] 2dip
[ bitor ] [ unmask ] if chmod io-error ;
[ bitor ] [ unmask ] if [ chmod ] unix-system-call drop ;
GENERIC# file-mode? 1 ( obj mask -- ? )
@ -174,7 +174,7 @@ CONSTANT: ALL-EXECUTE OCT: 0000111
: set-other-execute ( path ? -- ) OTHER-EXECUTE swap chmod-set-bit ;
: set-file-permissions ( path n -- )
[ normalize-path ] dip chmod io-error ;
[ normalize-path ] dip [ chmod ] unix-system-call drop ;
: file-permissions ( path -- n )
normalize-path file-info permissions>> ;
@ -202,7 +202,7 @@ PRIVATE>
: set-file-times ( path timestamps -- )
#! set access, write
[ normalize-path ] dip
timestamps>byte-array utimes io-error ;
timestamps>byte-array [ utimes ] unix-system-call drop ;
: set-file-access-time ( path timestamp -- )
f 2array set-file-times ;
@ -211,7 +211,8 @@ PRIVATE>
f swap 2array set-file-times ;
: set-file-ids ( path uid gid -- )
[ normalize-path ] 2dip [ -1 or ] bi@ chown io-error ;
[ normalize-path ] 2dip [ -1 or ] bi@
[ chown ] unix-system-call drop ;
GENERIC: set-file-user ( path string/id -- )
@ -285,3 +286,5 @@ PRIVATE>
{ +regular-file+ [ file-type>executable ] }
[ drop file-type>executable ]
} case ;
"io.files.info.unix." os name>> append require

8
basis/io/files/links/unix/unix.factor
View File

@ -1,14 +1,14 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io.backend io.files.links system unix io.pathnames kernel
io.files sequences ;
USING: io.backend io.files io.files.links io.pathnames kernel
sequences system unix unix.ffi ;
IN: io.files.links.unix
M: unix make-link ( path1 path2 -- )
normalize-path symlink io-error ;
normalize-path [ symlink ] unix-system-call drop ;
M: unix make-hard-link ( path1 path2 -- )
normalize-path link io-error ;
normalize-path [ link ] unix-system-call drop ;
M: unix read-link ( path -- path' )
normalize-path read-symbolic-link ;

2
basis/io/files/unique/unix/unix.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel io.ports io.backend.unix math.bitwise
unix system io.files.unique ;
unix system io.files.unique unix.ffi ;
IN: io.files.unique.unix
: open-unique-flags ( -- flags )

7
basis/io/files/unix/unix.factor
View File

@ -2,11 +2,12 @@
! See http://factorcode.org/license.txt for BSD license.
USING: unix byte-arrays kernel io.backend.unix math.bitwise
io.ports io.files io.files.private io.pathnames environment
destructors system ;
destructors system unix.ffi ;
IN: io.files.unix
M: unix cwd ( -- path )
MAXPATHLEN [ <byte-array> ] keep getcwd
MAXPATHLEN [ <byte-array> ] keep
[ getcwd ] unix-system-call
[ (io-error) ] unless* ;
M: unix cd ( path -- ) [ chdir ] unix-system-call drop ;
@ -33,7 +34,7 @@ M: unix (file-writer) ( path -- stream )
: open-append ( path -- fd )
[
append-flags file-mode open-file |dispose
dup 0 SEEK_END lseek io-error
dup 0 SEEK_END [ lseek ] unix-system-call drop
] with-destructors ;
M: unix (file-appender) ( path -- stream )

23
basis/io/launcher/launcher.factor Normal file → Executable file
View File

@ -1,4 +1,4 @@
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: system kernel namespaces strings hashtables sequences assocs
combinators vocabs.loader init threads continuations math accessors
@ -127,16 +127,17 @@ M: process-was-killed error.
"Launch descriptor:" print nl
process>> . ;
: wait-for-process ( process -- status )
: (wait-for-process) ( process -- status )
dup handle>>
[
dup handle>>
[
dup [ processes get at push ] curry
"process" suspend drop
] when
dup killed>>
[ process-was-killed ] [ status>> ] if
] with-timeout ;
dup [ processes get at push ] curry
"process" suspend drop
] when
dup killed>>
[ process-was-killed ] [ status>> ] if ;
: wait-for-process ( process -- status )
[ (wait-for-process) ] with-timeout ;
: run-detached ( desc -- process )
>process
@ -264,7 +265,7 @@ M: output-process-error error.
+stdout+ >>stderr
[ +closed+ or ] change-stdin
utf8 <process-reader*>
[ stream-contents ] [ dup wait-for-process ] bi*
[ [ stream-contents ] [ dup (wait-for-process) ] bi* ] with-timeout
0 = [ 2drop ] [ output-process-error ] if ;
: notify-exit ( process status -- )

2
basis/io/launcher/unix/unix.factor
View File

@ -5,7 +5,7 @@ continuations environment io io.backend io.backend.unix
io.files io.files.private io.files.unix io.launcher
io.launcher.unix.parser io.pathnames io.ports kernel math
namespaces sequences strings system threads unix
unix.process ;
unix.process unix.ffi ;
IN: io.launcher.unix
: get-arguments ( process -- seq )

14
basis/io/launcher/windows/nt/nt-tests.factor Normal file → Executable file
View File

@ -23,6 +23,20 @@ IN: io.launcher.windows.nt.tests
[ f ] [ "notepad" get process-running? ] unit-test
[
<process>
"notepad" >>command
1/2 seconds >>timeout
try-process
] must-fail
[
<process>
"notepad" >>command
1/2 seconds >>timeout
try-output-process
] must-fail
: console-vm ( -- path )
vm ".exe" ?tail [ ".com" append ] when ;

2
basis/io/mmap/unix/unix.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors destructors io.backend.unix io.mmap
io.mmap.private kernel locals math.bitwise system unix ;
io.mmap.private kernel locals math.bitwise system unix unix.ffi ;
IN: io.mmap.unix
:: mmap-open ( path length prot flags open-mode -- alien fd )

2
basis/io/pipes/unix/unix.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types system kernel unix math sequences
io.backend.unix io.ports specialized-arrays accessors ;
io.backend.unix io.ports specialized-arrays accessors unix.ffi ;
QUALIFIED: io.pipes
SPECIALIZED-ARRAY: int
IN: io.pipes.unix

3
basis/io/sockets/secure/unix/unix.factor
View File

@ -6,7 +6,8 @@ alien.strings libc continuations destructors openssl
openssl.libcrypto openssl.libssl io io.files io.ports
io.backend.unix io.sockets.unix io.encodings.ascii io.buffers
io.sockets io.sockets.private io.sockets.secure
io.sockets.secure.openssl io.timeouts system summary fry ;
io.sockets.secure.openssl io.timeouts system summary fry
unix.ffi ;
FROM: io.ports => shutdown ;
IN: io.sockets.secure.unix

6
basis/io/sockets/sockets-tests.factor
View File

@ -49,6 +49,12 @@ io.streams.string ;
[ "1:2:0:0:0:0:3:4" ]
[ B{ 0 1 0 2 0 0 0 0 0 0 0 0 0 3 0 4 } T{ inet6 } inet-ntop ] unit-test
[ B{ 0 0 0 0 0 0 0 0 0 127 0 0 0 0 0 1 } ]
[ "::127.0.0.1" T{ inet6 } inet-pton ] unit-test
[ B{ 0 2 0 0 0 0 0 9 0 127 0 0 0 0 0 1 } ]
[ "2::9:127.0.0.1" T{ inet6 } inet-pton ] unit-test
[ "2001:6f8:37a:5:0:0:0:1" ]
[ "2001:6f8:37a:5::1" T{ inet6 } [ inet-pton ] [ inet-ntop ] bi ] unit-test

40
basis/io/sockets/sockets.factor
View File

@ -11,7 +11,7 @@ IN: io.sockets
<< {
{ [ os windows? ] [ "windows.winsock" ] }
{ [ os unix? ] [ "unix" ] }
{ [ os unix? ] [ "unix.ffi" ] }
} cond use-vocab >>
! Addressing
@ -64,21 +64,25 @@ C: <inet4> inet4
M: inet4 inet-ntop ( data addrspec -- str )
drop 4 memory>byte-array [ number>string ] { } map-as "." join ;
ERROR: malformed-inet4 sequence ;
ERROR: bad-inet4-component string ;
: parse-inet4 ( string -- seq )
"." split dup length 4 = [
malformed-inet4
] unless
[
string>number
[ "Dotted component not a number" throw ] unless*
] B{ } map-as ;
ERROR: invalid-inet4 string reason ;
M: invalid-inet4 summary drop "Invalid IPv4 address" ;
M: inet4 inet-pton ( str addrspec -- data )
drop
[
"." split dup length 4 = [
"Must have four components" throw
] unless
[
string>number
[ "Dotted component not a number" throw ] unless*
] B{ } map-as
] [ invalid-inet4 ] recover ;
[ parse-inet4 ] [ invalid-inet4 ] recover ;
M: inet4 address-size drop 4 ;
@ -112,11 +116,21 @@ M: invalid-inet6 summary drop "Invalid IPv6 address" ;
<PRIVATE
ERROR: bad-ipv6-component obj ;
ERROR: bad-ipv4-embedded-prefix obj ;
: parse-ipv6-component ( seq -- seq' )
[ dup hex> [ nip ] [ bad-ipv6-component ] if* ] { } map-as ;
: parse-inet6 ( string -- seq )
[ f ] [
":" split [
hex> [ "Component not a number" throw ] unless*
] { } map-as
":" split CHAR: . over last member? [
unclip-last
[ parse-ipv6-component ] [ parse-inet4 ] bi* append
] [
parse-ipv6-component
] if
] if-empty ;
: pad-inet6 ( string1 string2 -- seq )

22
basis/io/sockets/unix/unix.factor
View File

@ -5,7 +5,7 @@ threads sequences byte-arrays io.binary io.backend.unix
io.streams.duplex io.backend io.pathnames io.sockets.private
io.files.private io.encodings.utf8 math.parser continuations
libc combinators system accessors destructors unix locals init
classes.struct alien.data ;
classes.struct alien.data unix.ffi ;
EXCLUDE: namespaces => bind ;
EXCLUDE: io => read write ;
@ -59,10 +59,15 @@ M: object (get-remote-address) ( handle local -- sockaddr )
[ (io-error) ]
} cond ;
M: object establish-connection ( client-out remote -- )
[ drop ] [ [ handle>> handle-fd ] [ make-sockaddr/size ] bi* connect ] 2bi
M:: object establish-connection ( client-out remote -- )
client-out remote
[ drop ]
[
[ handle>> handle-fd ] [ make-sockaddr/size ] bi* connect
] 2bi
{
{ [ 0 = ] [ drop ] }
{ [ errno EINTR = ] [ drop client-out remote establish-connection ] }
{ [ errno EINPROGRESS = ] [
[ +output+ wait-for-port ] [ wait-to-connect ] bi
] }
@ -70,7 +75,12 @@ M: object establish-connection ( client-out remote -- )
} cond ;
: ?bind-client ( socket -- )
bind-local-address get [ [ fd>> ] dip make-sockaddr/size bind io-error ] [ drop ] if* ; inline
bind-local-address get [
[ fd>> ] dip make-sockaddr/size
[ bind ] unix-system-call drop
] [
drop
] if* ; inline
M: object ((client)) ( addrspec -- fd )
protocol-family SOCK_STREAM socket-fd
@ -83,12 +93,12 @@ M: object ((client)) ( addrspec -- fd )
: server-socket-fd ( addrspec type -- fd )
[ dup protocol-family ] dip socket-fd
[ init-server-socket ] keep
[ handle-fd swap make-sockaddr/size bind io-error ] keep ;
[ handle-fd swap make-sockaddr/size [ bind ] unix-system-call drop ] keep ;
M: object (server) ( addrspec -- handle )
[
SOCK_STREAM server-socket-fd
dup handle-fd 128 listen io-error
dup handle-fd 128 [ listen ] unix-system-call drop
] with-destructors ;
: do-accept ( server addrspec -- fd sockaddr )

7
basis/listener/listener-docs.factor
View File

@ -1,4 +1,4 @@
USING: help.markup help.syntax kernel io system prettyprint continuations ;
USING: help.markup help.syntax kernel io system prettyprint continuations quotations ;
IN: listener
ARTICLE: "listener-watch" "Watching variables in the listener"
@ -21,6 +21,11 @@ HELP: only-use-vocabs
{ $values { "vocabs" "a sequence of vocabulary specifiers" } }
{ $description "Replaces the current manifest's vocabulary search path with the given set of vocabularies." } ;
HELP: with-interactive-vocabs
{ $values { "quot" quotation } }
{ $description "Calls the quotation in a scope with an initial vocabulary search path consisting of all vocabularies from " { $link interactive-vocabs } ", and with the current vocabulary for new definitions set to " { $vocab-link "scratchpad" } "." }
{ $notes "This is the same initial search path as used by the " { $link "listener" } " tool." } ;
HELP: show-var
{ $values { "var" "a variable name" } }
{ $description "Adds a variable to the watch list; its value will be printed by the listener after every expression." } ;

2
basis/lists/lists.factor
View File

@ -88,7 +88,7 @@ PRIVATE>
<reversed> nil [ swons ] reduce ;
: lmap>array ( list quot -- array )
accumulator [ leach ] dip { } like ; inline
collector [ leach ] dip { } like ; inline
: list>array ( list -- array )
[ ] lmap>array ;

14
basis/locals/locals-docs.factor
View File

@ -4,7 +4,7 @@ IN: locals
HELP: [|
{ $syntax "[| bindings... | body... ]" }
{ $description "A literal quotation with named variable bindings. When the quotation is " { $link call } "ed, it will take values off the datastack values and place them into the bindings from left to right. The body may then refer to these bindings. The quotation may also bind to named variables in an enclosing scope to create a closure." }
{ $description "A literal quotation with named variable bindings. When the quotation is " { $link call } "ed, it will take values off the datastack and place them into the bindings from left to right. The body may then refer to these bindings. The quotation may also bind to named variables in an enclosing scope to create a closure." }
{ $examples "See " { $link "locals-examples" } "." } ;
HELP: [let
@ -20,7 +20,7 @@ $nl
{ $code ":> c :> b :> a" }
{ $code ":> ( a b c )" }
$nl
"If any " { $snippet "var" } " name is followed by an exclamation point (" { $snippet "!" } "), that new variable is mutable. See " { $link "locals-mutable" } " for more information on mutable lexical variables." }
"If any " { $snippet "var" } " name is followed by an exclamation point (" { $snippet "!" } "), that new variable is mutable. See " { $link "locals-mutable" } " for more information." }
{ $notes
"This syntax can only be used inside a lexical scope established by a " { $link POSTPONE: :: } " definition, " { $link POSTPONE: [let } " form, or " { $link POSTPONE: [| } " quotation. Normal quotations have their own lexical scope only if they are inside an outer scope. Definition forms such as " { $link POSTPONE: : } " do not establish a lexical scope by themselves unless documented otherwise, nor is there a lexical scope available at the top level of source files or in the listener. " { $link POSTPONE: [let } " can be used to create a lexical scope where one is not otherwise available." }
{ $examples "See " { $link "locals-examples" } "." } ;
@ -31,7 +31,7 @@ HELP: ::
{ $syntax ":: word ( vars... -- outputs... ) body... ;" }
{ $description "Defines a word with named inputs. The word binds its input values to lexical variables from left to right, then executes the body with those bindings in scope."
$nl
"If any " { $snippet "var" } " name is followed by an exclamation point (" { $snippet "!" } "), the corresponding new variable is made mutable. See " { $link "locals-mutable" } " for more information on mutable lexical variables." }
"If any " { $snippet "var" } " name is followed by an exclamation point (" { $snippet "!" } "), the corresponding new variable is made mutable. See " { $link "locals-mutable" } " for more information." }
{ $notes "The names of the " { $snippet "outputs" } " do not affect the word's behavior. However, the compiler verifies that the stack effect accurately represents the number of outputs as with " { $link POSTPONE: : } " definitions." }
{ $examples "See " { $link "locals-examples" } "." } ;
@ -41,7 +41,7 @@ HELP: MACRO::
{ $syntax "MACRO:: word ( vars... -- outputs... ) body... ;" }
{ $description "Defines a macro with named inputs. The macro binds its input variables to lexical variables from left to right, then executes the body with those bindings in scope."
$nl
"If any " { $snippet "var" } " name is followed by an exclamation point (" { $snippet "!" } "), the corresponding new variable is made mutable. See " { $link "locals-mutable" } " for more information on mutable lexical variables." }
"If any " { $snippet "var" } " name is followed by an exclamation point (" { $snippet "!" } "), the corresponding new variable is made mutable. See " { $link "locals-mutable" } " for more information." }
{ $notes "The expansion of a macro cannot reference lexical variables bound in the outer scope. There are also limitations on passing arguments involving lexical variables into macros. See " { $link "locals-limitations" } " for details." }
{ $examples "See " { $link "locals-examples" } "." } ;
@ -51,7 +51,7 @@ HELP: MEMO::
{ $syntax "MEMO:: word ( vars... -- outputs... ) body... ;" }
{ $description "Defines a memoized word with named inputs. The word binds its input values to lexical variables from left to right, then executes the body with those bindings in scope."
$nl
"If any " { $snippet "var" } " name is followed by an exclamation point (" { $snippet "!" } "), the corresponding new variable is made mutable. See " { $link "locals-mutable" } " for more information on mutable lexical variables." }
"If any " { $snippet "var" } " name is followed by an exclamation point (" { $snippet "!" } "), the corresponding new variable is made mutable. See " { $link "locals-mutable" } " for more information." }
{ $examples "See " { $link "locals-examples" } "." } ;
{ POSTPONE: MEMO: POSTPONE: MEMO:: } related-words
@ -60,7 +60,7 @@ HELP: M::
{ $syntax "M:: class generic ( vars... -- outputs... ) body... ;" }
{ $description "Defines a new method on " { $snippet "generic" } " for " { $snippet "class" } " with named inputs. The method binds its input values to lexical variables from left to right, then executes the body with those bindings in scope."
$nl
"If any " { $snippet "var" } " name is followed by an exclamation point (" { $snippet "!" } "), the corresponding new variable is made mutable. See " { $link "locals-mutable" } " for more information on mutable lexical variables." }
"If any " { $snippet "var" } " name is followed by an exclamation point (" { $snippet "!" } "), the corresponding new variable is made mutable. See " { $link "locals-mutable" } " for more information." }
{ $notes "The names of the " { $snippet "outputs" } " do not affect the word's behavior. However, the compiler verifies that the stack effect accurately represents the number of outputs as with " { $link POSTPONE: M: } " definitions." }
{ $examples "See " { $link "locals-examples" } "." } ;
@ -209,7 +209,7 @@ $nl
ARTICLE: "locals-mutable" "Mutable lexical variables"
"When a lexical variable is bound using " { $link POSTPONE: :> } ", " { $link POSTPONE: :: } ", or " { $link POSTPONE: [| } ", the variable may be made mutable by suffixing its name with an exclamation point (" { $snippet "!" } "). A mutable variable's value is read by giving its name without the exclamation point as usual. To write to the variable, use its name with the " { $snippet "!" } " suffix."
$nl
"Mutable bindings are implemented in a manner similar to the ML language; each mutable binding is actually an immutable binding of a mutable cell. Reading the binding automatically unboxes the value from the cell, and writing to the binding stores into it."
"Mutable bindings are implemented in a manner similar to that taken by the ML language. Each mutable binding is actually an immutable binding of a mutable cell. Reading the binding automatically unboxes the value from the cell, and writing to the binding stores into it."
$nl
"Writing to mutable variables from outer lexical scopes is fully supported and has full closure semantics. See " { $link "locals-examples" } " for examples of mutable lexical variables in action." ;

1
basis/math/blas/config/config.factor
View File

@ -15,7 +15,6 @@ blas-fortran-abi [
{
{ [ os macosx? ] [ intel-unix-abi ] }
{ [ os windows? cpu x86.32? and ] [ f2c-abi ] }
{ [ os netbsd? cpu x86.64? and ] [ g95-abi ] }
{ [ os windows? cpu x86.64? and ] [ gfortran-abi ] }
{ [ os freebsd? ] [ gfortran-abi ] }
{ [ os linux? ] [ gfortran-abi ] }

4
basis/math/floats/env/env-tests.factor vendored
View File

@ -1,7 +1,7 @@
USING: kernel math math.floats.env math.floats.env.private
math.functions math.libm sequences tools.test locals
compiler.units kernel.private fry compiler math.private words
system ;
compiler.units kernel.private fry compiler.test math.private
words system ;
IN: math.floats.env.tests
: set-default-fp-env ( -- )

2
basis/math/vectors/conversion/conversion-tests.factor
View File

@ -1,5 +1,5 @@
! (c)Joe Groff bsd license
USING: accessors arrays compiler continuations generalizations
USING: accessors arrays compiler.test continuations generalizations
kernel kernel.private locals math.vectors.conversion math.vectors.simd
sequences stack-checker tools.test ;
FROM: alien.c-types => char uchar short ushort int uint longlong ulonglong float double ;

2
basis/math/vectors/simd/simd-tests.factor
View File

@ -1,4 +1,4 @@
USING: accessors arrays classes compiler compiler.tree.debugger
USING: accessors arrays classes compiler.test compiler.tree.debugger
effects fry io kernel kernel.private math math.functions
math.private math.vectors math.vectors.simd
math.vectors.simd.private prettyprint random sequences system

14
basis/prettyprint/stylesheet/stylesheet-docs.factor
View File

@ -8,33 +8,31 @@ HELP: effect-style
{ "effect" "an effect" }
{ "style" "a style assoc" }
}
{ $description "The styling hook for stack effects" } ;
{ $description "The stylesheet for stack effects" } ;
HELP: string-style
{ $values
{ "str" "a string" }
{ "style" "a style assoc" }
}
{ $description "The styling hook for string literals" } ;
{ $description "The stylesheet for string literals" } ;
HELP: vocab-style
{ $values
{ "vocab" "a vocabulary specifier" }
{ "style" "a style assoc" }
}
{ $description "The styling hook for vocab names" } ;
{ $description "The stylesheet for vocab names" } ;
HELP: word-style
{ $values
{ "word" "a word" }
{ "style" "a style assoc" }
}
{ $description "The styling hook for word names" } ;
{ $description "The stylesheet for word names" } ;
ARTICLE: "prettyprint.stylesheet" "Prettyprinter Formatted Output"
{ $vocab-link "prettyprint.stylesheet" }
$nl
"Control the way that the prettyprinter formats output based on object type. These hooks form a basic \"syntax\" highlighting system."
ARTICLE: "prettyprint.stylesheet" "Prettyprinter stylesheet"
"The " { $vocab-link "prettyprint.stylesheet" } " vocabulary defines variables which control the way that the prettyprinter formats output based on object type."
{ $subsections
word-style
string-style

2
basis/regexp/regexp.factor
View File

@ -84,7 +84,7 @@ PRIVATE>
[ prepare-match-iterator ] dip (each-match) ; inline
: map-matches ( string regexp quot: ( start end string -- obj ) -- seq )
accumulator [ each-match ] dip >array ; inline
collector [ each-match ] dip >array ; inline
: all-matching-slices ( string regexp -- seq )
[ slice boa ] map-matches ;

2
basis/sequences/deep/deep.factor
View File

@ -21,7 +21,7 @@ M: object branch? drop f ;
[ '[ _ deep-map ] map ] [ drop ] if ; inline recursive
: deep-filter ( obj quot: ( elt -- ? ) -- seq )
over [ pusher [ deep-each ] dip ] dip
over [ selector [ deep-each ] dip ] dip
dup branch? [ like ] [ drop ] if ; inline recursive
: (deep-find) ( obj quot: ( elt -- ? ) -- elt ? )

8
basis/sequences/generalizations/generalizations.factor
View File

@ -58,19 +58,19 @@ MACRO: (ncollect) ( n -- )
: mnmap ( m*seq quot m n -- result*n )
2dup '[ [ _ npick ] dip swap _ dupn ] 2dip mnmap-as ; inline
: naccumulator-for ( quot ...exemplar n -- quot' vec... )
: ncollector-for ( quot ...exemplar n -- quot' vec... )
5 dupn '[
[ [ length ] keep new-resizable ] _ napply
[ [ [ push ] _ apply-curry _ spread* ] _ ncurry compose ] _ nkeep
] call ; inline
: naccumulator ( quot n -- quot' vec... )
[ V{ } swap dupn ] keep naccumulator-for ; inline
: ncollector ( quot n -- quot' vec... )
[ V{ } swap dupn ] keep ncollector-for ; inline
: nproduce-as ( pred quot ...exemplar n -- seq... )
7 dupn '[
_ ndup
[ _ naccumulator-for [ while ] _ ndip ]
[ _ ncollector-for [ while ] _ ndip ]
_ ncurry _ ndip
[ like ] _ apply-curry _ spread*
] call ; inline

3
basis/specialized-arrays/specialized-arrays-tests.factor
View File

@ -4,7 +4,8 @@ specialized-arrays.private sequences alien.c-types accessors
kernel arrays combinators compiler compiler.units classes.struct
combinators.smart compiler.tree.debugger math libc destructors
sequences.private multiline eval words vocabs namespaces
assocs prettyprint alien.data math.vectors definitions ;
assocs prettyprint alien.data math.vectors definitions
compiler.test ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: int

4
basis/specialized-vectors/specialized-vectors.factor
View File

@ -24,9 +24,9 @@ WHERE
V A <A> vectors.functor:define-vector
M: V contract 2drop ;
M: V contract 2drop ; inline
M: V byte-length underlying>> byte-length ;
M: V byte-length underlying>> byte-length ; inline
M: V pprint-delims drop \ V{ \ } ;

4
basis/stack-checker/known-words/known-words.factor
View File

@ -516,9 +516,9 @@ M: bad-executable summary
\ compact-gc { } { } define-primitive
\ (save-image) { byte-array } { } define-primitive
\ (save-image) { byte-array byte-array } { } define-primitive
\ (save-image-and-exit) { byte-array } { } define-primitive
\ (save-image-and-exit) { byte-array byte-array } { } define-primitive
\ data-room { } { byte-array } define-primitive
\ data-room make-flushable

36
basis/tools/crossref/crossref.factor
View File

@ -1,9 +1,10 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! Copyright (C) 2005, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: words assocs definitions io io.pathnames io.styles kernel
prettyprint sorting see sets sequences arrays hashtables help.crossref
help.topics help.markup quotations accessors source-files namespaces
graphs vocabs generic generic.single threads compiler.units init ;
prettyprint sorting see sets sequences arrays hashtables help
help.crossref help.topics help.markup quotations accessors
source-files namespaces graphs vocabs generic generic.single
threads compiler.units init combinators.smart ;
IN: tools.crossref
SYMBOL: crossref
@ -50,10 +51,16 @@ M: callable uses ( quot -- assoc )
M: word uses def>> uses ;
M: link uses { $subsection $subsections $link $see-also } article-links ;
M: link uses
[ { $subsection $subsections $link $see-also } article-links [ >link ] map ]
[ { $vocab-link } article-links [ >vocab-link ] map ]
bi append ;
M: pathname uses string>> source-file top-level-form>> [ uses ] [ { } ] if* ;
! To make UI browser happy
M: vocab uses drop f ;
GENERIC: crossref-def ( defspec -- )
M: object crossref-def
@ -62,18 +69,23 @@ M: object crossref-def
M: word crossref-def
[ call-next-method ] [ subwords [ crossref-def ] each ] bi ;
: defs-to-crossref ( -- seq )
[
all-words
all-articles [ >link ] map
source-files get keys [ <pathname> ] map
] append-outputs ;
: build-crossref ( -- crossref )
"Computing usage index... " write flush yield
H{ } clone crossref [
all-words
source-files get keys [ <pathname> ] map
[ [ crossref-def ] each ] bi@
crossref get
] with-variable
H{ } clone [
crossref set-global
defs-to-crossref [ crossref-def ] each
] keep
"done" print flush ;
: get-crossref ( -- crossref )
crossref global [ drop build-crossref ] cache ;
crossref get-global [ build-crossref ] unless* ;
GENERIC: irrelevant? ( defspec -- ? )

1
basis/tools/deploy/shaker/shaker.factor Normal file → Executable file
View File

@ -545,6 +545,7 @@ SYMBOL: deploy-vocab
[
strip-debugger? [
"debugger" require
"tools.errors" require
"inspector" require
deploy-ui? get [
"ui.debugger" require

2
basis/tools/profiler/profiler-tests.factor
View File

@ -1,6 +1,6 @@
USING: accessors tools.profiler tools.test kernel memory math
threads alien alien.c-types tools.profiler.private sequences
compiler compiler.units words ;
compiler.test compiler.units words ;
IN: tools.profiler.tests
[ t ] [

2
basis/tools/time/time-tests.factor
View File

@ -1,4 +1,4 @@
IN: tools.time.tests
USING: tools.time tools.test compiler ;
USING: tools.time tools.test compiler.test ;
[ ] [ [ [ ] time ] compile-call ] unit-test

21
basis/ui/gadgets/gadgets.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! Copyright (C) 2005, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays hashtables kernel math namespaces
make sequences quotations math.vectors combinators sorting
@ -62,18 +62,19 @@ M: gadget children-on nip children>> ;
<PRIVATE
: ((fast-children-on)) ( gadget dim axis -- <=> )
[ swap loc>> v- ] dip v. 0 <=> ;
:: (fast-children-on) ( dim axis children -- i )
children [ dim axis ((fast-children-on)) ] search drop ;
:: (fast-children-on) ( point axis children quot -- i )
children [
[ point ] dip
quot call( value -- loc ) v-
axis v. 0 <=>
] search drop ; inline
PRIVATE>
: fast-children-on ( rect axis children -- from to )
[ [ loc>> ] 2dip (fast-children-on) 0 or ]
[ [ rect-bounds v+ ] 2dip (fast-children-on) ?1+ ]
3bi ;
:: fast-children-on ( rect axis children quot -- slice )
rect loc>> axis children quot (fast-children-on) 0 or
rect rect-bounds v+ axis children quot (fast-children-on) ?1+
children <slice> ; inline
M: gadget contains-rect? ( bounds gadget -- ? )
dup visible?>> [ call-next-method ] [ 2drop f ] if ;

24
basis/ui/gadgets/grids/grids-tests.factor
View File

@ -1,12 +1,14 @@
USING: ui.gadgets ui.gadgets.grids tools.test kernel arrays
namespaces math.rectangles accessors ui.gadgets.grids.private
ui.gadgets.debug sequences ;
ui.gadgets.debug sequences classes ;
IN: ui.gadgets.grids.tests
[ { 0 0 } ] [ { } <grid> pref-dim ] unit-test
: 100x100 ( -- gadget ) <gadget> { 100 100 } >>dim ;
: 200x200 ( -- gadget ) <gadget> { 200 200 } >>dim ;
[ { 100 100 } ] [
100x100
1array 1array <grid> pref-dim
@ -81,4 +83,22 @@ IN: ui.gadgets.grids.tests
"g" get
dup layout
children>> [ loc>> ] map
] unit-test
] unit-test
! children-on logic was insufficient
[ ] [
100x100 dup "a" set 200x200 2array
100x100 dup "b" set 200x200 2array 2array <grid> f >>fill? "g" set
] unit-test
[ ] [ "g" get prefer ] unit-test
[ ] [ "g" get layout ] unit-test
[ { 0 50 } ] [ "a" get loc>> ] unit-test
[ { 0 250 } ] [ "b" get loc>> ] unit-test
[ gadget { 200 200 } ]
[ { 120 20 } "g" get pick-up [ class ] [ dim>> ] bi ] unit-test
[ gadget { 200 200 } ]
[ { 120 220 } "g" get pick-up [ class ] [ dim>> ] bi ] unit-test

13
basis/ui/gadgets/grids/grids.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2006, 2009 Slava Pestov.
! Copyright (C) 2006, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel math math.order math.matrices namespaces make sequences words io
math.vectors ui.gadgets ui.baseline-alignment columns accessors strings.tables
USING: arrays kernel math math.order math.matrices namespaces
make sequences words io math.vectors ui.gadgets
ui.baseline-alignment columns accessors strings.tables
math.rectangles fry ;
IN: ui.gadgets.grids
@ -115,8 +116,10 @@ M: grid layout* [ grid>> ] [ <grid-layout> ] bi grid-layout ;
M: grid children-on ( rect gadget -- seq )
dup children>> empty? [ 2drop f ] [
[ { 0 1 } ] dip grid>>
[ 0 <column> fast-children-on ] [ <slice> concat ] bi
[ { 0 1 } ] dip
[ grid>> ] [ dim>> ] bi
'[ _ [ loc>> vmin ] reduce ] fast-children-on
concat
] if ;
M: grid gadget-text*

5
basis/ui/gadgets/packs/packs.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! Copyright (C) 2005, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: sequences ui.gadgets ui.baseline-alignment
ui.baseline-alignment.private kernel math math.functions math.vectors
@ -100,5 +100,4 @@ M: pack layout*
dup children>> pref-dims pack-layout ;
M: pack children-on ( rect gadget -- seq )
[ orientation>> ] [ children>> ] bi
[ fast-children-on ] keep <slice> ;
[ orientation>> ] [ children>> ] bi [ loc>> ] fast-children-on ;

5
basis/ui/gadgets/panes/panes.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! Copyright (C) 2005, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays hashtables io kernel namespaces sequences
strings quotations math opengl combinators memoize math.vectors
@ -352,7 +352,8 @@ M: paragraph stream-format
GENERIC: sloppy-pick-up* ( loc gadget -- n )
M: pack sloppy-pick-up* ( loc gadget -- n )
[ orientation>> ] [ children>> ] bi (fast-children-on) ;
[ orientation>> ] [ children>> ] bi
[ loc>> ] (fast-children-on) ;
M: gadget sloppy-pick-up*
children>> [ contains-point? ] with find-last drop ;

8
basis/unicode/case/case.factor
View File

@ -109,13 +109,13 @@ HINTS: >upper string ;
lt? [ lithuanian>upper ] when
[ title>> ] [ ch>title ] map-case ; inline
: title-word ( string -- title )
unclip 1string [ >lower ] [ (>title) ] bi* prepend ; inline
PRIVATE>
: capitalize ( string -- title )
unclip 1string [ >lower ] [ (>title) ] bi* prepend ; inline
: >title ( string -- title )
final-sigma >words [ title-word ] map concat ;
final-sigma >words [ capitalize ] map concat ;
HINTS: >title string ;

30
basis/unix/bsd/netbsd/structs/structs.factor
View File

@ -1,30 +0,0 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.syntax unix.time unix.types
unix.types.netbsd classes.struct ;
IN: unix
STRUCT: sockaddr_storage
{ ss_len __uint8_t }
{ ss_family sa_family_t }
{ __ss_pad1 { char _SS_PAD1SIZE } }
{ __ss_align __int64_t }
{ __ss_pad2 { char _SS_PAD2SIZE } } ;
STRUCT: exit_struct
{ e_termination uint16_t }
{ e_exit uint16_t } ;
STRUCT: utmpx
{ ut_user { char _UTX_USERSIZE } }
{ ut_id { char _UTX_IDSIZE } }
{ ut_line { char _UTX_LINESIZE } }
{ ut_host { char _UTX_HOSTSIZE } }
{ ut_session uint16_t }
{ ut_type uint16_t }
{ ut_pid pid_t }
{ ut_exit exit_struct }
{ ut_ss sockaddr_storage }
{ ut_tv timeval }
{ ut_pad { uint32_t 10 } } ;

5
basis/unix/debugger/debugger.factor
View File

@ -1,7 +1,6 @@
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: debugger prettyprint accessors unix kernel ;
FROM: io => write print nl ;
USING: accessors debugger io kernel prettyprint unix ;
IN: unix.debugger
M: unix-error error.

1
basis/unix/ffi/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

0
basis/unix/bsd/authors.txt → basis/unix/ffi/bsd/authors.txt
View File

10
basis/unix/bsd/bsd.factor → basis/unix/ffi/bsd/bsd.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.syntax classes.struct combinators
system unix.types vocabs.loader ;
IN: unix
IN: unix.ffi
CONSTANT: MAXPATHLEN 1024
@ -85,8 +85,8 @@ CONSTANT: SEEK_CUR 1
CONSTANT: SEEK_END 2
os {
{ macosx [ "unix.bsd.macosx" require ] }
{ freebsd [ "unix.bsd.freebsd" require ] }
{ openbsd [ "unix.bsd.openbsd" require ] }
{ netbsd [ "unix.bsd.netbsd" require ] }
{ macosx [ "unix.ffi.bsd.macosx" require ] }
{ freebsd [ "unix.ffi.bsd.freebsd" require ] }
{ openbsd [ "unix.ffi.bsd.openbsd" require ] }
{ netbsd [ "unix.ffi.bsd.netbsd" require ] }
} case

2
basis/unix/bsd/freebsd/freebsd.factor → basis/unix/ffi/bsd/freebsd/freebsd.factor
View File

@ -1,5 +1,5 @@
USING: alien.c-types alien.syntax classes.struct unix.types ;
IN: unix
IN: unix.ffi
CONSTANT: FD_SETSIZE 1024

0
basis/unix/bsd/freebsd/tags.txt → basis/unix/ffi/bsd/freebsd/tags.txt
View File

7
basis/unix/bsd/macosx/macosx.factor → basis/unix/ffi/bsd/macosx/macosx.factor
View File

@ -1,6 +1,7 @@
USING: alien.c-types alien.syntax unix.time unix.types
unix.types.macosx classes.struct ;
IN: unix
USING: alien alien.c-types alien.libraries alien.syntax
classes.struct combinators kernel system unix unix.time
unix.types vocabs vocabs.loader ;
IN: unix.ffi
CONSTANT: FD_SETSIZE 1024

0
basis/unix/bsd/macosx/tags.txt → basis/unix/ffi/bsd/macosx/tags.txt
View File

32
basis/unix/bsd/netbsd/netbsd.factor → basis/unix/ffi/bsd/netbsd/netbsd.factor
View File

@ -1,6 +1,6 @@
USING: alien.syntax alien.c-types math vocabs.loader
classes.struct unix.types ;
IN: unix
classes.struct unix.types unix.time ;
IN: unix.ffi
CONSTANT: FD_SETSIZE 256
@ -127,6 +127,8 @@ CONSTANT: _UTX_LINESIZE 32
CONSTANT: _UTX_IDSIZE 4
CONSTANT: _UTX_HOSTSIZE 256
<<
CONSTANT: _SS_MAXSIZE 128
: _SS_ALIGNSIZE ( -- n )
@ -138,4 +140,28 @@ CONSTANT: _SS_MAXSIZE 128
: _SS_PAD2SIZE ( -- n )
_SS_MAXSIZE 2 - _SS_PAD1SIZE - _SS_ALIGNSIZE - ; inline
"unix.bsd.netbsd.structs" require
>>
STRUCT: sockaddr_storage
{ ss_len __uint8_t }
{ ss_family sa_family_t }
{ __ss_pad1 { char _SS_PAD1SIZE } }
{ __ss_align __int64_t }
{ __ss_pad2 { char _SS_PAD2SIZE } } ;
STRUCT: exit_struct
{ e_termination uint16_t }
{ e_exit uint16_t } ;
STRUCT: utmpx
{ ut_user { char _UTX_USERSIZE } }
{ ut_id { char _UTX_IDSIZE } }
{ ut_line { char _UTX_LINESIZE } }
{ ut_host { char _UTX_HOSTSIZE } }
{ ut_session uint16_t }
{ ut_type uint16_t }
{ ut_pid pid_t }
{ ut_exit exit_struct }
{ ut_ss sockaddr_storage }
{ ut_tv timeval }
{ ut_pad { uint32_t 10 } } ;

0
basis/unix/bsd/netbsd/structs/tags.txt → basis/unix/ffi/bsd/netbsd/tags.txt
View File

2
basis/unix/bsd/openbsd/openbsd.factor → basis/unix/ffi/bsd/openbsd/openbsd.factor
View File

@ -1,5 +1,5 @@
USING: alien.c-types alien.syntax classes.struct unix.types ;
IN: unix
IN: unix.ffi
CONSTANT: FD_SETSIZE 1024

0
basis/unix/bsd/netbsd/tags.txt → basis/unix/ffi/bsd/openbsd/tags.txt
View File

0
basis/unix/bsd/summary.txt → basis/unix/ffi/bsd/summary.txt
View File

0
basis/unix/bsd/openbsd/tags.txt → basis/unix/ffi/bsd/tags.txt
View File

158
basis/unix/ffi/ffi.factor Normal file
View File

@ -0,0 +1,158 @@
! Copyright (C) 2010 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.libraries alien.syntax
classes.struct combinators kernel system unix.time unix.types
vocabs vocabs.loader ;
IN: unix.ffi
<<
{
{ [ os linux? ] [ "unix.ffi.linux" require ] }
{ [ os bsd? ] [ "unix.ffi.bsd" require ] }
{ [ os solaris? ] [ "unix.ffi.solaris" require ] }
} cond
>>
CONSTANT: PROT_NONE 0
CONSTANT: PROT_READ 1
CONSTANT: PROT_WRITE 2
CONSTANT: PROT_EXEC 4
CONSTANT: MAP_FILE 0
CONSTANT: MAP_SHARED 1
CONSTANT: MAP_PRIVATE 2
CONSTANT: SEEK_SET 0
CONSTANT: SEEK_CUR 1
CONSTANT: SEEK_END 2
: MAP_FAILED ( -- alien ) -1 <alien> ; inline
CONSTANT: NGROUPS_MAX 16
CONSTANT: DT_UNKNOWN 0
CONSTANT: DT_FIFO 1
CONSTANT: DT_CHR 2
CONSTANT: DT_DIR 4
CONSTANT: DT_BLK 6
CONSTANT: DT_REG 8
CONSTANT: DT_LNK 10
CONSTANT: DT_SOCK 12
CONSTANT: DT_WHT 14
LIBRARY: libc
FUNCTION: char* strerror ( int errno ) ;
STRUCT: group
{ gr_name char* }
{ gr_passwd char* }
{ gr_gid int }
{ gr_mem char** } ;
FUNCTION: int accept ( int s, void* sockaddr, socklen_t* socklen ) ;
FUNCTION: int bind ( int s, void* name, socklen_t namelen ) ;
FUNCTION: int chdir ( char* path ) ;
FUNCTION: int chmod ( char* path, mode_t mode ) ;
FUNCTION: int fchmod ( int fd, mode_t mode ) ;
FUNCTION: int chown ( char* path, uid_t owner, gid_t group ) ;
FUNCTION: int chroot ( char* path ) ;
FUNCTION: int close ( int fd ) ;
FUNCTION: int closedir ( DIR* dirp ) ;
FUNCTION: int connect ( int s, void* name, socklen_t namelen ) ;
FUNCTION: int dup2 ( int oldd, int newd ) ;
FUNCTION: void endpwent ( ) ;
FUNCTION: int fchdir ( int fd ) ;
FUNCTION: int fchown ( int fd, uid_t owner, gid_t group ) ;
FUNCTION: int fcntl ( int fd, int cmd, int arg ) ;
FUNCTION: int flock ( int fd, int operation ) ;
FUNCTION: void freeaddrinfo ( addrinfo* ai ) ;
FUNCTION: int futimes ( int id, timeval[2] times ) ;
FUNCTION: char* gai_strerror ( int ecode ) ;
FUNCTION: int getaddrinfo ( char* hostname, char* servname, addrinfo* hints, addrinfo** res ) ;
FUNCTION: char* getcwd ( char* buf, size_t size ) ;
FUNCTION: pid_t getpid ;
FUNCTION: int getdtablesize ;
FUNCTION: gid_t getegid ;
FUNCTION: uid_t geteuid ;
FUNCTION: gid_t getgid ;
FUNCTION: char* getenv ( char* name ) ;
FUNCTION: int getgrgid_r ( gid_t gid, group* grp, char* buffer, size_t bufsize, group** result ) ;
FUNCTION: int getgrnam_r ( char* name, group* grp, char* buffer, size_t bufsize, group** result ) ;
FUNCTION: passwd* getpwent ( ) ;
FUNCTION: passwd* getpwuid ( uid_t uid ) ;
FUNCTION: passwd* getpwnam ( char* login ) ;
FUNCTION: int getpwnam_r ( char* login, passwd* pwd, char* buffer, size_t bufsize, passwd** result ) ;
FUNCTION: int getgroups ( int gidsetlen, gid_t* gidset ) ;
FUNCTION: int getgrouplist ( char* name, int basegid, int* groups, int* ngroups ) ;
FUNCTION: int getrlimit ( int resource, rlimit* rlp ) ;
FUNCTION: int setrlimit ( int resource, rlimit* rlp ) ;
FUNCTION: int getpriority ( int which, id_t who ) ;
FUNCTION: int setpriority ( int which, id_t who, int prio ) ;
FUNCTION: int getrusage ( int who, rusage* r_usage ) ;
FUNCTION: group* getgrent ;
FUNCTION: int gethostname ( char* name, int len ) ;
FUNCTION: int getsockname ( int socket, sockaddr* address, socklen_t* address_len ) ;
FUNCTION: int getpeername ( int socket, sockaddr* address, socklen_t* address_len ) ;
FUNCTION: uid_t getuid ;
FUNCTION: uint htonl ( uint n ) ;
FUNCTION: ushort htons ( ushort n ) ;
! FUNCTION: int issetugid ;
FUNCTION: int ioctl ( int fd, ulong request, char* argp ) ;
FUNCTION: int lchown ( char* path, uid_t owner, gid_t group ) ;
FUNCTION: int listen ( int s, int backlog ) ;
FUNCTION: off_t lseek ( int fildes, off_t offset, int whence ) ;
FUNCTION: int mkdir ( char* path, mode_t mode ) ;
FUNCTION: void* mmap ( void* addr, size_t len, int prot, int flags, int fd, off_t offset ) ;
FUNCTION: int munmap ( void* addr, size_t len ) ;
FUNCTION: uint ntohl ( uint n ) ;
FUNCTION: ushort ntohs ( ushort n ) ;
FUNCTION: int shutdown ( int fd, int how ) ;
FUNCTION: int open ( char* path, int flags, int prot ) ;
FUNCTION: DIR* opendir ( char* path ) ;
STRUCT: utimbuf
{ actime time_t }
{ modtime time_t } ;
FUNCTION: int utime ( char* path, utimbuf* buf ) ;
FUNCTION: int pclose ( void* file ) ;
FUNCTION: int pipe ( int* filedes ) ;
FUNCTION: void* popen ( char* command, char* type ) ;
FUNCTION: ssize_t read ( int fd, void* buf, size_t nbytes ) ;
FUNCTION: dirent* readdir ( DIR* dirp ) ;
FUNCTION: int readdir_r ( void* dirp, dirent* entry, dirent** result ) ;
FUNCTION: ssize_t readlink ( char* path, char* buf, size_t bufsize ) ;
CONSTANT: PATH_MAX 1024
FUNCTION: ssize_t recv ( int s, void* buf, size_t nbytes, int flags ) ;
FUNCTION: ssize_t recvfrom ( int s, void* buf, size_t nbytes, int flags, sockaddr-in* from, socklen_t* fromlen ) ;
FUNCTION: int rename ( char* from, char* to ) ;
FUNCTION: int rmdir ( char* path ) ;
FUNCTION: int select ( int nfds, void* readfds, void* writefds, void* exceptfds, timeval* timeout ) ;
FUNCTION: ssize_t sendto ( int s, void* buf, size_t len, int flags, sockaddr-in* to, socklen_t tolen ) ;
FUNCTION: int setenv ( char* name, char* value, int overwrite ) ;
FUNCTION: int unsetenv ( char* name ) ;
FUNCTION: int setegid ( gid_t egid ) ;
FUNCTION: int seteuid ( uid_t euid ) ;
FUNCTION: int setgid ( gid_t gid ) ;
FUNCTION: int setgroups ( int ngroups, gid_t* gidset ) ;
FUNCTION: int setregid ( gid_t rgid, gid_t egid ) ;
FUNCTION: int setreuid ( uid_t ruid, uid_t euid ) ;
FUNCTION: int setsockopt ( int s, int level, int optname, void* optval, socklen_t optlen ) ;
FUNCTION: int setuid ( uid_t uid ) ;
FUNCTION: int socket ( int domain, int type, int protocol ) ;
FUNCTION: int symlink ( char* path1, char* path2 ) ;
FUNCTION: int link ( char* path1, char* path2 ) ;
FUNCTION: int system ( char* command ) ;
FUNCTION: int unlink ( char* path ) ;
FUNCTION: int utimes ( char* path, timeval[2] times ) ;
FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ;
"librt" "librt.so" "cdecl" add-library

1
basis/unix/ffi/linux/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

236
basis/unix/ffi/linux/linux.factor Normal file
View File

@ -0,0 +1,236 @@
! Copyright (C) 2010 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.syntax classes.struct unix.types ;
IN: unix.ffi
CONSTANT: MAXPATHLEN 1024
CONSTANT: O_RDONLY HEX: 0000
CONSTANT: O_WRONLY HEX: 0001
CONSTANT: O_RDWR HEX: 0002
CONSTANT: O_CREAT HEX: 0040
CONSTANT: O_EXCL HEX: 0080
CONSTANT: O_NOCTTY HEX: 0100
CONSTANT: O_TRUNC HEX: 0200
CONSTANT: O_APPEND HEX: 0400
CONSTANT: O_NONBLOCK HEX: 0800
ALIAS: O_NDELAY O_NONBLOCK
CONSTANT: SOL_SOCKET 1
CONSTANT: FD_SETSIZE 1024
CONSTANT: SO_REUSEADDR 2
CONSTANT: SO_OOBINLINE 10
CONSTANT: SO_SNDTIMEO HEX: 15
CONSTANT: SO_RCVTIMEO HEX: 14
CONSTANT: F_SETFD 2
CONSTANT: FD_CLOEXEC 1
CONSTANT: F_SETFL 4
STRUCT: addrinfo
{ flags int }
{ family int }
{ socktype int }
{ protocol int }
{ addrlen socklen_t }
{ addr void* }
{ canonname char* }
{ next addrinfo* } ;
STRUCT: sockaddr-in
{ family ushort }
{ port ushort }
{ addr in_addr_t }
{ unused longlong } ;
STRUCT: sockaddr-in6
{ family ushort }
{ port ushort }
{ flowinfo uint }
{ addr uchar[16] }
{ scopeid uint } ;
CONSTANT: max-un-path 108
STRUCT: sockaddr-un
{ family ushort }
{ path { char max-un-path } } ;
CONSTANT: SOCK_STREAM 1
CONSTANT: SOCK_DGRAM 2
CONSTANT: AF_UNSPEC 0
CONSTANT: AF_UNIX 1
CONSTANT: AF_INET 2
CONSTANT: AF_INET6 10
ALIAS: PF_UNSPEC AF_UNSPEC
ALIAS: PF_UNIX AF_UNIX
ALIAS: PF_INET AF_INET
ALIAS: PF_INET6 AF_INET6
CONSTANT: IPPROTO_TCP 6
CONSTANT: IPPROTO_UDP 17
CONSTANT: AI_PASSIVE 1
CONSTANT: SEEK_SET 0
CONSTANT: SEEK_CUR 1
CONSTANT: SEEK_END 2
STRUCT: passwd
{ pw_name char* }
{ pw_passwd char* }
{ pw_uid uid_t }
{ pw_gid gid_t }
{ pw_gecos char* }
{ pw_dir char* }
{ pw_shell char* } ;
! dirent64
STRUCT: dirent
{ d_ino ulonglong }
{ d_off longlong }
{ d_reclen ushort }
{ d_type uchar }
{ d_name char[256] } ;
FUNCTION: int open64 ( char* path, int flags, int prot ) ;
FUNCTION: dirent* readdir64 ( DIR* dirp ) ;
FUNCTION: int readdir64_r ( void* dirp, dirent* entry, dirent** result ) ;
CONSTANT: EPERM 1
CONSTANT: ENOENT 2
CONSTANT: ESRCH 3
CONSTANT: EINTR 4
CONSTANT: EIO 5
CONSTANT: ENXIO 6
CONSTANT: E2BIG 7
CONSTANT: ENOEXEC 8
CONSTANT: EBADF 9
CONSTANT: ECHILD 10
CONSTANT: EAGAIN 11
CONSTANT: ENOMEM 12
CONSTANT: EACCES 13
CONSTANT: EFAULT 14
CONSTANT: ENOTBLK 15
CONSTANT: EBUSY 16
CONSTANT: EEXIST 17
CONSTANT: EXDEV 18
CONSTANT: ENODEV 19
CONSTANT: ENOTDIR 20
CONSTANT: EISDIR 21
CONSTANT: EINVAL 22
CONSTANT: ENFILE 23
CONSTANT: EMFILE 24
CONSTANT: ENOTTY 25
CONSTANT: ETXTBSY 26
CONSTANT: EFBIG 27
CONSTANT: ENOSPC 28
CONSTANT: ESPIPE 29
CONSTANT: EROFS 30
CONSTANT: EMLINK 31
CONSTANT: EPIPE 32
CONSTANT: EDOM 33
CONSTANT: ERANGE 34
CONSTANT: EDEADLK 35
CONSTANT: ENAMETOOLONG 36
CONSTANT: ENOLCK 37
CONSTANT: ENOSYS 38
CONSTANT: ENOTEMPTY 39
CONSTANT: ELOOP 40
ALIAS: EWOULDBLOCK EAGAIN
CONSTANT: ENOMSG 42
CONSTANT: EIDRM 43
CONSTANT: ECHRNG 44
CONSTANT: EL2NSYNC 45
CONSTANT: EL3HLT 46
CONSTANT: EL3RST 47
CONSTANT: ELNRNG 48
CONSTANT: EUNATCH 49
CONSTANT: ENOCSI 50
CONSTANT: EL2HLT 51
CONSTANT: EBADE 52
CONSTANT: EBADR 53
CONSTANT: EXFULL 54
CONSTANT: ENOANO 55
CONSTANT: EBADRQC 56
CONSTANT: EBADSLT 57
ALIAS: EDEADLOCK EDEADLK
CONSTANT: EBFONT 59
CONSTANT: ENOSTR 60
CONSTANT: ENODATA 61
CONSTANT: ETIME 62
CONSTANT: ENOSR 63
CONSTANT: ENONET 64
CONSTANT: ENOPKG 65
CONSTANT: EREMOTE 66
CONSTANT: ENOLINK 67
CONSTANT: EADV 68
CONSTANT: ESRMNT 69
CONSTANT: ECOMM 70
CONSTANT: EPROTO 71
CONSTANT: EMULTIHOP 72
CONSTANT: EDOTDOT 73
CONSTANT: EBADMSG 74
CONSTANT: EOVERFLOW 75
CONSTANT: ENOTUNIQ 76
CONSTANT: EBADFD 77
CONSTANT: EREMCHG 78
CONSTANT: ELIBACC 79
CONSTANT: ELIBBAD 80
CONSTANT: ELIBSCN 81
CONSTANT: ELIBMAX 82
CONSTANT: ELIBEXEC 83
CONSTANT: EILSEQ 84
CONSTANT: ERESTART 85
CONSTANT: ESTRPIPE 86
CONSTANT: EUSERS 87
CONSTANT: ENOTSOCK 88
CONSTANT: EDESTADDRREQ 89
CONSTANT: EMSGSIZE 90
CONSTANT: EPROTOTYPE 91
CONSTANT: ENOPROTOOPT 92
CONSTANT: EPROTONOSUPPORT 93
CONSTANT: ESOCKTNOSUPPORT 94
CONSTANT: EOPNOTSUPP 95
CONSTANT: EPFNOSUPPORT 96
CONSTANT: EAFNOSUPPORT 97
CONSTANT: EADDRINUSE 98
CONSTANT: EADDRNOTAVAIL 99
CONSTANT: ENETDOWN 100
CONSTANT: ENETUNREACH 101
CONSTANT: ENETRESET 102
CONSTANT: ECONNABORTED 103
CONSTANT: ECONNRESET 104
CONSTANT: ENOBUFS 105
CONSTANT: EISCONN 106
CONSTANT: ENOTCONN 107
CONSTANT: ESHUTDOWN 108
CONSTANT: ETOOMANYREFS 109
CONSTANT: ETIMEDOUT 110
CONSTANT: ECONNREFUSED 111
CONSTANT: EHOSTDOWN 112
CONSTANT: EHOSTUNREACH 113
CONSTANT: EALREADY 114
CONSTANT: EINPROGRESS 115
CONSTANT: ESTALE 116
CONSTANT: EUCLEAN 117
CONSTANT: ENOTNAM 118
CONSTANT: ENAVAIL 119
CONSTANT: EISNAM 120
CONSTANT: EREMOTEIO 121
CONSTANT: EDQUOT 122
CONSTANT: ENOMEDIUM 123
CONSTANT: EMEDIUMTYPE 124
CONSTANT: ECANCELED 125
CONSTANT: ENOKEY 126
CONSTANT: EKEYEXPIRED 127
CONSTANT: EKEYREVOKED 128
CONSTANT: EKEYREJECTED 129
CONSTANT: EOWNERDEAD 130
CONSTANT: ENOTRECOVERABLE 131

0
basis/unix/bsd/tags.txt → basis/unix/ffi/linux/tags.txt
View File

0
basis/unix/solaris/authors.txt → basis/unix/ffi/solaris/authors.txt
View File

4
basis/unix/solaris/solaris.factor → basis/unix/ffi/solaris/solaris.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2006 Patrick Mauritz.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.syntax system kernel layouts ;
IN: unix
IN: unix.ffi
! Solaris.
@ -52,7 +52,7 @@ STRUCT: sockaddr-in6
{ addr uchar[16] }
{ scopeid uint } ;
: max-un-path 108 ;
CONSTANT: max-un-path 108
STRUCT: sockaddr-un
{ family ushort }

0
basis/unix/solaris/tags.txt → basis/unix/ffi/solaris/tags.txt
View File

1
basis/unix/ffi/tags.txt Normal file
View File

@ -0,0 +1 @@
unportable

Some files were not shown because too many files have changed in this diff Show More