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

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

db4
Joe Groff 2009-04-30 21:36:54 -05:00
parent 9149f375d1 0432b00336
commit 49674dc8ad
213 changed files with 4574 additions and 2810 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
Makefile
View File

@ -9,11 +9,11 @@ VERSION = 0.92
BUNDLE = Factor.app
LIBPATH = -L/usr/X11R6/lib
CFLAGS = -Wall
CFLAGS = -Wall -Werror
FFI_TEST_CFLAGS = -fPIC
ifdef DEBUG
CFLAGS += -g
CFLAGS += -g -DFACTOR_DEBUG
else
CFLAGS += -O3
endif
@ -28,7 +28,10 @@ endif
DLL_OBJS = $(PLAF_DLL_OBJS) \
vm/alien.o \
vm/arrays.o \
vm/bignum.o \
vm/booleans.o \
vm/byte_arrays.o \
vm/callstack.o \
vm/code_block.o \
vm/code_gc.o \
@ -36,17 +39,22 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \
vm/data_gc.o \
vm/data_heap.o \
vm/debug.o \
vm/dispatch.o \
vm/errors.o \
vm/factor.o \
vm/image.o \
vm/inline_cache.o \
vm/io.o \
vm/jit.o \
vm/math.o \
vm/primitives.o \
vm/profiler.o \
vm/quotations.o \
vm/run.o \
vm/types.o \
vm/utilities.o
vm/strings.o \
vm/tuples.o \
vm/utilities.o \
vm/words.o
EXE_OBJS = $(PLAF_EXE_OBJS)
@ -183,5 +191,5 @@ vm/ffi_test.o: vm/ffi_test.c
.m.o:
$(CC) -c $(CFLAGS) -o $@ $<
.PHONY: factor

2
basis/alien/remote-control/remote-control.factor
View File

@ -15,7 +15,7 @@ IN: alien.remote-control
"void" { "long" } "cdecl" [ sleep ] alien-callback ;
: ?callback ( word -- alien )
dup optimized>> [ execute ] [ drop f ] if ; inline
dup optimized? [ execute ] [ drop f ] if ; inline
: init-remote-control ( -- )
\ eval-callback ?callback 16 setenv

7
basis/bootstrap/compiler/compiler.factor
View File

@ -5,7 +5,7 @@ sequences namespaces parser kernel kernel.private classes
classes.private arrays hashtables vectors classes.tuple sbufs
hashtables.private sequences.private math classes.tuple.private
growable namespaces.private assocs words command-line vocabs io
io.encodings.string libc splitting math.parser
io.encodings.string libc splitting math.parser memory
compiler.units math.order compiler.tree.builder
compiler.tree.optimizer compiler.cfg.optimizer ;
IN: bootstrap.compiler
@ -25,8 +25,11 @@ IN: bootstrap.compiler
enable-compiler
! Push all tuple layouts to tenured space to improve method caching
gc
: compile-unoptimized ( words -- )
[ optimized>> not ] filter compile ;
[ optimized? not ] filter compile ;
nl
"Compiling..." write flush

149
basis/bootstrap/image/image.factor
View File

@ -3,14 +3,13 @@
USING: alien arrays byte-arrays generic assocs hashtables assocs
hashtables.private io io.binary io.files io.encodings.binary
io.pathnames kernel kernel.private math namespaces make parser
prettyprint sequences sequences.private strings sbufs
vectors words quotations assocs system layouts splitting
grouping growable classes classes.builtin classes.tuple
classes.tuple.private words.private vocabs
vocabs.loader source-files definitions debugger
quotations.private sequences.private combinators
math.order math.private accessors
slots.private compiler.units fry ;
prettyprint sequences sequences.private strings sbufs vectors words
quotations assocs system layouts splitting grouping growable classes
classes.builtin classes.tuple classes.tuple.private vocabs
vocabs.loader source-files definitions debugger quotations.private
sequences.private combinators math.order math.private accessors
slots.private generic.single.private compiler.units compiler.constants
fry ;
IN: bootstrap.image
: arch ( os cpu -- arch )
@ -94,13 +93,30 @@ CONSTANT: -1-offset 9
SYMBOL: sub-primitives
: make-jit ( quot rc rt offset -- quad )
[ [ call( -- ) ] { } make ] 3dip 4array ;
SYMBOL: jit-define-rc
SYMBOL: jit-define-rt
SYMBOL: jit-define-offset
: jit-define ( quot rc rt offset name -- )
: compute-offset ( -- offset )
building get length jit-define-rc get rc-absolute-cell = bootstrap-cell 4 ? - ;
: jit-rel ( rc rt -- )
jit-define-rt set
jit-define-rc set
compute-offset jit-define-offset set ;
: make-jit ( quot -- quad )
[
call( -- )
jit-define-rc get
jit-define-rt get
jit-define-offset get 3array
] B{ } make prefix ;
: jit-define ( quot name -- )
[ make-jit ] dip set ;
: define-sub-primitive ( quot rc rt offset word -- )
: define-sub-primitive ( quot word -- )
[ make-jit ] dip sub-primitives get set-at ;
! The image being constructed; a vector of word-size integers
@ -119,7 +135,6 @@ SYMBOL: bootstrap-global
SYMBOL: bootstrap-boot-quot
! JIT parameters
SYMBOL: jit-code-format
SYMBOL: jit-prolog
SYMBOL: jit-primitive-word
SYMBOL: jit-primitive
@ -129,20 +144,36 @@ SYMBOL: jit-push-immediate
SYMBOL: jit-if-word
SYMBOL: jit-if-1
SYMBOL: jit-if-2
SYMBOL: jit-dispatch-word
SYMBOL: jit-dispatch
SYMBOL: jit-dip-word
SYMBOL: jit-dip
SYMBOL: jit-2dip-word
SYMBOL: jit-2dip
SYMBOL: jit-3dip-word
SYMBOL: jit-3dip
SYMBOL: jit-execute-word
SYMBOL: jit-execute-jump
SYMBOL: jit-execute-call
SYMBOL: jit-epilog
SYMBOL: jit-return
SYMBOL: jit-profiling
SYMBOL: jit-declare-word
SYMBOL: jit-save-stack
! PIC stubs
SYMBOL: pic-load
SYMBOL: pic-tag
SYMBOL: pic-hi-tag
SYMBOL: pic-tuple
SYMBOL: pic-hi-tag-tuple
SYMBOL: pic-check-tag
SYMBOL: pic-check
SYMBOL: pic-hit
SYMBOL: pic-miss-word
! Megamorphic dispatch
SYMBOL: mega-lookup
SYMBOL: mega-lookup-word
SYMBOL: mega-miss-word
! Default definition for undefined words
SYMBOL: undefined-quot
@ -150,7 +181,6 @@ SYMBOL: undefined-quot
H{
{ bootstrap-boot-quot 20 }
{ bootstrap-global 21 }
{ jit-code-format 22 }
{ jit-prolog 23 }
{ jit-primitive-word 24 }
{ jit-primitive 25 }
@ -159,20 +189,32 @@ SYMBOL: undefined-quot
{ jit-if-word 28 }
{ jit-if-1 29 }
{ jit-if-2 30 }
{ jit-dispatch-word 31 }
{ jit-dispatch 32 }
{ jit-epilog 33 }
{ jit-return 34 }
{ jit-profiling 35 }
{ jit-push-immediate 36 }
{ jit-declare-word 42 }
{ jit-save-stack 43 }
{ jit-dip-word 44 }
{ jit-dip 45 }
{ jit-2dip-word 46 }
{ jit-2dip 47 }
{ jit-3dip-word 48 }
{ jit-3dip 49 }
{ jit-save-stack 38 }
{ jit-dip-word 39 }
{ jit-dip 40 }
{ jit-2dip-word 41 }
{ jit-2dip 42 }
{ jit-3dip-word 43 }
{ jit-3dip 44 }
{ jit-execute-word 45 }
{ jit-execute-jump 46 }
{ jit-execute-call 47 }
{ pic-load 48 }
{ pic-tag 49 }
{ pic-hi-tag 50 }
{ pic-tuple 51 }
{ pic-hi-tag-tuple 52 }
{ pic-check-tag 53 }
{ pic-check 54 }
{ pic-hit 55 }
{ pic-miss-word 56 }
{ mega-lookup 57 }
{ mega-lookup-word 58 }
{ mega-miss-word 59 }
{ undefined-quot 60 }
} ; inline
@ -205,8 +247,8 @@ SYMBOL: undefined-quot
: emit-fixnum ( n -- ) tag-fixnum emit ;
: emit-object ( header tag quot -- addr )
swap here-as [ swap tag-fixnum emit call align-here ] dip ;
: emit-object ( class quot -- addr )
over tag-number here-as [ swap type-number tag-fixnum emit call align-here ] dip ;
inline
! Write an object to the image.
@ -251,7 +293,7 @@ GENERIC: ' ( obj -- ptr )
M: bignum '
[
bignum tag-number dup [ emit-bignum ] emit-object
bignum [ emit-bignum ] emit-object
] cache-object ;
! Fixnums
@ -274,7 +316,7 @@ M: fake-bignum ' n>> tag-fixnum ;
M: float '
[
float tag-number dup [
float [
align-here double>bits emit-64
] emit-object
] cache-object ;
@ -309,7 +351,7 @@ M: f '
[ vocabulary>> , ]
[ def>> , ]
[ props>> , ]
[ drop f , ]
[ direct-entry-def>> , ] ! direct-entry-def
[ drop 0 , ] ! count
[ word-sub-primitive , ]
[ drop 0 , ] ! xt
@ -318,8 +360,7 @@ M: f '
} cleave
] { } make [ ' ] map
] bi
\ word type-number object tag-number
[ emit-seq ] emit-object
\ word [ emit-seq ] emit-object
] keep put-object ;
: word-error ( word msg -- * )
@ -340,8 +381,7 @@ M: word ' ;
! Wrappers
M: wrapper '
wrapped>> ' wrapper type-number object tag-number
[ emit ] emit-object ;
wrapped>> ' wrapper [ emit ] emit-object ;
! Strings
: native> ( object -- object )
@ -370,7 +410,7 @@ M: wrapper '
: emit-string ( string -- ptr )
[ length ] [ extended-part ' ] [ ] tri
string type-number object tag-number [
string [
[ emit-fixnum ]
[ emit ]
[ f ' emit ascii-part pad-bytes emit-bytes ]
@ -387,12 +427,11 @@ M: string '
: emit-dummy-array ( obj type -- ptr )
[ assert-empty ] [
type-number object tag-number
[ 0 emit-fixnum ] emit-object
] bi* ;
M: byte-array '
byte-array type-number object tag-number [
byte-array [
dup length emit-fixnum
pad-bytes emit-bytes
] emit-object ;
@ -406,7 +445,7 @@ ERROR: tuple-removed class ;
: (emit-tuple) ( tuple -- pointer )
[ tuple-slots ]
[ class transfer-word require-tuple-layout ] bi prefix [ ' ] map
tuple type-number dup [ emit-seq ] emit-object ;
tuple [ emit-seq ] emit-object ;
: emit-tuple ( tuple -- pointer )
dup class name>> "tombstone" =
@ -421,8 +460,7 @@ M: tombstone '
! Arrays
: emit-array ( array -- offset )
[ ' ] map array type-number object tag-number
[ [ length emit-fixnum ] [ emit-seq ] bi ] emit-object ;
[ ' ] map array [ [ length emit-fixnum ] [ emit-seq ] bi ] emit-object ;
M: array ' emit-array ;
@ -448,7 +486,7 @@ M: tuple-layout-array '
M: quotation '
[
array>> '
quotation type-number object tag-number [
quotation [
emit ! array
f ' emit ! compiled
f ' emit ! cached-effect
@ -480,15 +518,16 @@ M: quotation '
: emit-jit-data ( -- )
\ if jit-if-word set
\ dispatch jit-dispatch-word set
\ do-primitive jit-primitive-word set
\ declare jit-declare-word set
\ dip jit-dip-word set
\ 2dip jit-2dip-word set
\ 3dip jit-3dip-word set
\ (execute) jit-execute-word set
\ inline-cache-miss \ pic-miss-word set
\ mega-cache-lookup \ mega-lookup-word set
\ mega-cache-miss \ mega-miss-word set
[ undefined ] undefined-quot set
{
jit-code-format
jit-prolog
jit-primitive-word
jit-primitive
@ -498,19 +537,31 @@ M: quotation '
jit-if-word
jit-if-1
jit-if-2
jit-dispatch-word
jit-dispatch
jit-dip-word
jit-dip
jit-2dip-word
jit-2dip
jit-3dip-word
jit-3dip
jit-execute-word
jit-execute-jump
jit-execute-call
jit-epilog
jit-return
jit-profiling
jit-declare-word
jit-save-stack
pic-load
pic-tag
pic-hi-tag
pic-tuple
pic-hi-tag-tuple
pic-check-tag
pic-check
pic-hit
pic-miss-word
mega-lookup
mega-lookup-word
mega-miss-word
undefined-quot
} [ emit-userenv ] each ;

4
basis/bootstrap/stage2.factor
View File

@ -35,10 +35,6 @@ SYMBOL: bootstrap-time
"Core bootstrap completed in " write core-bootstrap-time get print-time
"Bootstrap completed in " write bootstrap-time get print-time
[ optimized>> ] count-words " compiled words" print
[ symbol? ] count-words " symbol words" print
[ ] count-words " words total" print
"Bootstrapping is complete." print
"Now, you can run Factor:" print
vm write " -i=" write "output-image" get print flush ;

4
basis/calendar/windows/windows.factor
View File

@ -1,5 +1,5 @@
USING: calendar namespaces alien.c-types system windows
windows.kernel32 kernel math combinators ;
USING: calendar namespaces alien.c-types system
windows.kernel32 kernel math combinators windows.errors ;
IN: calendar.windows
M: windows gmt-offset ( -- hours minutes seconds )

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

@ -1,5 +1,4 @@
USING: help.markup help.syntax parser vocabs.loader strings
command-line.private ;
USING: help.markup help.syntax parser vocabs.loader strings ;
IN: command-line
HELP: run-bootstrap-init
@ -53,6 +52,7 @@ ARTICLE: "runtime-cli-args" "Command line switches for the VM"
{ { $snippet "-aging=" { $emphasis "n" } } "Size of aging generation (1), megabytes" }
{ { $snippet "-tenured=" { $emphasis "n" } } "Size of oldest generation (2), megabytes" }
{ { $snippet "-codeheap=" { $emphasis "n" } } "Code heap size, megabytes" }
{ { $snippet "-pic=" { $emphasis "n" } } "Maximum inline cache size. Setting of 0 disables inline caching, > 1 enables polymorphic inline caching" }
{ { $snippet "-securegc" } "If specified, unused portions of the data heap will be zeroed out after every garbage collection" }
}
"If an " { $snippet "-i=" } " switch is not present, the default image file is used, which is usually a file named " { $snippet "factor.image" } " in the same directory as the runtime executable (on Windows and Mac OS X) or the current directory (on Unix)." ;

28
basis/compiler/cfg/intrinsics/allot/allot.factor
View File

@ -27,11 +27,11 @@ IN: compiler.cfg.intrinsics.allot
[ tuple ##set-slots ] [ ds-push drop ] 2bi
] [ drop emit-primitive ] if ;
: store-length ( len reg -- )
[ ^^load-literal ] dip 1 object tag-number ##set-slot-imm ;
: store-length ( len reg class -- )
[ [ ^^load-literal ] dip 1 ] dip tag-number ##set-slot-imm ;
: store-initial-element ( elt reg len -- )
[ 2 + object tag-number ##set-slot-imm ] with with each ;
:: store-initial-element ( len reg elt class -- )
len [ [ elt reg ] dip 2 + class tag-number ##set-slot-imm ] each ;
: expand-<array>? ( obj -- ? )
dup integer? [ 0 8 between? ] [ drop f ] if ;
@ -42,8 +42,8 @@ IN: compiler.cfg.intrinsics.allot
[let | elt [ ds-pop ]
reg [ len ^^allot-array ] |
ds-drop
len reg store-length
elt reg len store-initial-element
len reg array store-length
len reg elt array store-initial-element
reg ds-push
]
] [ node emit-primitive ] if
@ -57,16 +57,16 @@ IN: compiler.cfg.intrinsics.allot
: emit-allot-byte-array ( len -- dst )
ds-drop
dup ^^allot-byte-array
[ store-length ] [ ds-push ] [ ] tri ;
[ byte-array store-length ] [ ds-push ] [ ] tri ;
: emit-(byte-array) ( node -- )
dup node-input-infos first literal>> dup expand-<byte-array>?
[ nip emit-allot-byte-array drop ] [ drop emit-primitive ] if ;
: emit-<byte-array> ( node -- )
dup node-input-infos first literal>> dup expand-<byte-array>? [
nip
[ 0 ^^load-literal ] dip
[ emit-allot-byte-array ] keep
bytes>cells store-initial-element
] [ drop emit-primitive ] if ;
:: emit-<byte-array> ( node -- )
node node-input-infos first literal>> dup expand-<byte-array>? [
:> len
0 ^^load-literal :> elt
len emit-allot-byte-array :> reg
len reg elt byte-array store-initial-element
] [ drop node emit-primitive ] if ;

4
basis/compiler/cfg/intrinsics/intrinsics.factor
View File

@ -52,8 +52,6 @@ IN: compiler.cfg.intrinsics
arrays:<array>
byte-arrays:<byte-array>
byte-arrays:(byte-array)
math.private:<complex>
math.private:<ratio>
kernel:<wrapper>
alien.accessors:alien-unsigned-1
alien.accessors:set-alien-unsigned-1
@ -140,8 +138,6 @@ IN: compiler.cfg.intrinsics
{ \ arrays:<array> [ emit-<array> iterate-next ] }
{ \ byte-arrays:<byte-array> [ emit-<byte-array> iterate-next ] }
{ \ byte-arrays:(byte-array) [ emit-(byte-array) iterate-next ] }
{ \ math.private:<complex> [ emit-simple-allot iterate-next ] }
{ \ math.private:<ratio> [ emit-simple-allot iterate-next ] }
{ \ kernel:<wrapper> [ emit-simple-allot iterate-next ] }
{ \ alien.accessors:alien-unsigned-1 [ 1 emit-alien-unsigned-getter iterate-next ] }
{ \ alien.accessors:set-alien-unsigned-1 [ 1 emit-alien-integer-setter iterate-next ] }

8
basis/compiler/cfg/value-numbering/value-numbering-tests.factor
View File

@ -92,7 +92,7 @@ sequences ;
T{ ##load-reference f V int-regs 1 + }
T{ ##peek f V int-regs 2 D 0 }
T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc> }
T{ ##compare-imm f V int-regs 6 V int-regs 4 7 cc/= }
T{ ##compare-imm f V int-regs 6 V int-regs 4 5 cc/= }
T{ ##replace f V int-regs 6 D 0 }
} value-numbering trim-temps
] unit-test
@ -110,7 +110,7 @@ sequences ;
T{ ##load-reference f V int-regs 1 + }
T{ ##peek f V int-regs 2 D 0 }
T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc<= }
T{ ##compare-imm f V int-regs 6 V int-regs 4 7 cc= }
T{ ##compare-imm f V int-regs 6 V int-regs 4 5 cc= }
T{ ##replace f V int-regs 6 D 0 }
} value-numbering trim-temps
] unit-test
@ -132,7 +132,7 @@ sequences ;
T{ ##unbox-float f V double-float-regs 10 V int-regs 8 }
T{ ##unbox-float f V double-float-regs 11 V int-regs 9 }
T{ ##compare-float f V int-regs 12 V double-float-regs 10 V double-float-regs 11 cc< }
T{ ##compare-imm f V int-regs 14 V int-regs 12 7 cc= }
T{ ##compare-imm f V int-regs 14 V int-regs 12 5 cc= }
T{ ##replace f V int-regs 14 D 0 }
} value-numbering trim-temps
] unit-test
@ -149,6 +149,6 @@ sequences ;
T{ ##peek f V int-regs 29 D -1 }
T{ ##peek f V int-regs 30 D -2 }
T{ ##compare f V int-regs 33 V int-regs 29 V int-regs 30 cc<= }
T{ ##compare-imm-branch f V int-regs 33 7 cc/= }
T{ ##compare-imm-branch f V int-regs 33 5 cc/= }
} value-numbering trim-temps
] unit-test

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

@ -44,7 +44,7 @@ SYMBOL: calls
SYMBOL: compiling-word
: compiled-stack-traces? ( -- ? ) 59 getenv ;
: compiled-stack-traces? ( -- ? ) 67 getenv ;
! Mapping _label IDs to label instances
SYMBOL: labels

13
basis/compiler/codegen/fixup/fixup.factor
View File

@ -3,15 +3,13 @@
USING: arrays byte-arrays byte-vectors generic assocs hashtables
io.binary kernel kernel.private math namespaces make sequences
words quotations strings alien.accessors alien.strings layouts
system combinators math.bitwise words.private math.order
system combinators math.bitwise math.order
accessors growable cpu.architecture compiler.constants ;
IN: compiler.codegen.fixup
GENERIC: fixup* ( obj -- )
: code-format ( -- n ) 22 getenv ;
: compiled-offset ( -- n ) building get length code-format * ;
: compiled-offset ( -- n ) building get length ;
SYMBOL: relocation-table
SYMBOL: label-table
@ -25,7 +23,7 @@ TUPLE: label-fixup label class ;
M: label-fixup fixup*
dup class>> rc-absolute?
[ "Absolute labels not supported" throw ] when
[ label>> ] [ class>> ] bi compiled-offset 4 - rot
[ class>> ] [ label>> ] bi compiled-offset 4 - swap
3array label-table get push ;
TUPLE: rel-fixup class type ;
@ -58,6 +56,9 @@ SYMBOL: literal-table
: rel-word ( word class -- )
[ add-literal ] dip rt-xt rel-fixup ;
: rel-word-direct ( word class -- )
[ add-literal ] dip rt-xt-direct rel-fixup ;
: rel-primitive ( word class -- )
[ def>> first add-literal ] dip rt-primitive rel-fixup ;
@ -88,4 +89,4 @@ SYMBOL: literal-table
literal-table get >array
relocation-table get >byte-array
label-table get resolve-labels
] { } make 4array ;
] B{ } make 4array ;

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

@ -1,7 +1,7 @@
USING: assocs compiler.cfg.builder compiler.cfg.optimizer
compiler.errors compiler.tree.builder compiler.tree.optimizer
compiler.units help.markup help.syntax io parser quotations
sequences words words.private ;
sequences words ;
IN: compiler
HELP: enable-compiler

76
basis/compiler/compiler.factor
View File

@ -2,19 +2,20 @@
! 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
combinators deques search-deques macros io source-files.errors
stack-checker stack-checker.state stack-checker.inlining
stack-checker.errors combinators.short-circuit compiler.errors
compiler.units compiler.tree.builder compiler.tree.optimizer
compiler.cfg.builder compiler.cfg.optimizer compiler.cfg.linearization
compiler.cfg.two-operand compiler.cfg.linear-scan
compiler.cfg.stack-frame compiler.codegen compiler.utilities ;
generic.single combinators deques search-deques macros io
source-files.errors stack-checker stack-checker.state
stack-checker.inlining stack-checker.errors combinators.short-circuit
compiler.errors compiler.units compiler.tree.builder
compiler.tree.optimizer compiler.cfg.builder compiler.cfg.optimizer
compiler.cfg.linearization compiler.cfg.two-operand
compiler.cfg.linear-scan compiler.cfg.stack-frame compiler.codegen
compiler.utilities ;
IN: compiler
SYMBOL: compile-queue
SYMBOL: compiled
: queue-compile? ( word -- ? )
: compile? ( word -- ? )
#! Don't attempt to compile certain words.
{
[ "forgotten" word-prop ]
@ -24,7 +25,7 @@ SYMBOL: compiled
} 1|| not ;
: queue-compile ( word -- )
dup queue-compile? [ compile-queue get push-front ] [ drop ] if ;
dup compile? [ compile-queue get push-front ] [ drop ] if ;
: recompile-callers? ( word -- ? )
changed-effects get key? ;
@ -41,6 +42,14 @@ SYMBOL: compiled
H{ } clone generic-dependencies set
clear-compiler-error ;
GENERIC: no-compile? ( word -- ? )
M: word no-compile? "no-compile" word-prop ;
M: method-body no-compile? "method-generic" word-prop no-compile? ;
M: predicate-engine-word no-compile? "owner-generic" word-prop no-compile? ;
: ignore-error? ( word error -- ? )
#! Ignore some errors on inline combinators, macros, and special
#! words such as 'call'.
@ -48,8 +57,8 @@ SYMBOL: compiled
{
[ macro? ]
[ inline? ]
[ no-compile? ]
[ "special" word-prop ]
[ "no-compile" word-prop ]
} 1||
] [
{
@ -80,32 +89,46 @@ SYMBOL: compiled
: not-compiled-def ( word error -- def )
'[ _ _ not-compiled ] [ ] like ;
: ignore-error ( word error -- * )
drop
[ clear-compiler-error ]
[ dup def>> deoptimize-with ]
bi ;
: remember-error ( word error -- * )
[ swap <compiler-error> compiler-error ]
[ [ drop ] [ not-compiled-def ] 2bi deoptimize-with ]
2bi ;
: deoptimize ( word error -- * )
#! If the error is ignorable, compile the word with the
#! non-optimizing compiler, using its definition. Otherwise,
#! if the compiler error is not ignorable, use a dummy
#! definition from 'not-compiled-def' which throws an error.
2dup ignore-error? [
drop
[ dup def>> deoptimize-with ]
[ clear-compiler-error ]
bi
] [
[ swap <compiler-error> compiler-error ]
[ [ drop ] [ not-compiled-def ] 2bi deoptimize-with ]
2bi
] if ;
{
{ [ dup inference-error? not ] [ rethrow ] }
{ [ 2dup ignore-error? ] [ ignore-error ] }
[ remember-error ]
} cond ;
: optimize? ( word -- ? )
{
[ predicate-engine-word? ]
[ contains-breakpoints? ]
[ single-generic? ]
} 1|| not ;
: frontend ( word -- nodes )
#! If the word contains breakpoints, don't optimize it, since
#! the walker does not support this.
dup contains-breakpoints? [ dup def>> deoptimize-with ] [
[ build-tree ] [ deoptimize ] recover optimize-tree
] if ;
dup optimize?
[ [ build-tree ] [ deoptimize ] recover optimize-tree ]
[ dup def>> deoptimize-with ]
if ;
: compile-dependency ( word -- )
#! If a word calls an unoptimized word, try to compile the callee.
dup optimized>> [ drop ] [ queue-compile ] if ;
dup optimized? [ drop ] [ queue-compile ] if ;
! Only switch this off for debugging.
SYMBOL: compile-dependencies?
@ -161,7 +184,10 @@ M: optimizing-compiler recompile ( words -- alist )
[
<hashed-dlist> compile-queue set
H{ } clone compiled set
[ queue-compile ] each
[
[ queue-compile ]
[ subwords [ compile-dependency ] each ] bi
] each
compile-queue get compile-loop
compiled get >alist
] with-scope ;

34
basis/compiler/constants/constants.factor
View File

@ -1,6 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: math kernel layouts system strings ;
USING: math kernel layouts system strings words quotations byte-arrays
alien arrays ;
IN: compiler.constants
! These constants must match vm/memory.h
@ -11,18 +12,17 @@ CONSTANT: deck-bits 18
! These constants must match vm/layouts.h
: header-offset ( -- n ) object tag-number neg ; inline
: float-offset ( -- n ) 8 float tag-number - ; inline
: string-offset ( -- n ) 4 bootstrap-cells object tag-number - ; inline
: string-offset ( -- n ) 4 bootstrap-cells string tag-number - ; inline
: string-aux-offset ( -- n ) 2 bootstrap-cells string tag-number - ; inline
: profile-count-offset ( -- n ) 7 bootstrap-cells object tag-number - ; inline
: byte-array-offset ( -- n ) 2 bootstrap-cells object tag-number - ; inline
: alien-offset ( -- n ) 3 bootstrap-cells object tag-number - ; inline
: underlying-alien-offset ( -- n ) bootstrap-cell object tag-number - ; inline
: profile-count-offset ( -- n ) 7 bootstrap-cells \ word tag-number - ; inline
: byte-array-offset ( -- n ) 2 bootstrap-cells byte-array tag-number - ; inline
: alien-offset ( -- n ) 3 bootstrap-cells alien tag-number - ; inline
: underlying-alien-offset ( -- n ) bootstrap-cell alien tag-number - ; inline
: tuple-class-offset ( -- n ) bootstrap-cell tuple tag-number - ; inline
: class-hash-offset ( -- n ) bootstrap-cell object tag-number - ; inline
: word-xt-offset ( -- n ) 9 bootstrap-cells object tag-number - ; inline
: quot-xt-offset ( -- n ) 5 bootstrap-cells object tag-number - ; inline
: word-code-offset ( -- n ) 10 bootstrap-cells object tag-number - ; inline
: array-start-offset ( -- n ) 2 bootstrap-cells object tag-number - ; inline
: word-xt-offset ( -- n ) 9 bootstrap-cells \ word tag-number - ; inline
: quot-xt-offset ( -- n ) 5 bootstrap-cells quotation tag-number - ; inline
: word-code-offset ( -- n ) 10 bootstrap-cells \ word tag-number - ; inline
: array-start-offset ( -- n ) 2 bootstrap-cells array tag-number - ; inline
: compiled-header-size ( -- n ) 5 bootstrap-cells ; inline
! Relocation classes
@ -41,10 +41,12 @@ CONSTANT: rt-primitive 0
CONSTANT: rt-dlsym 1
CONSTANT: rt-dispatch 2
CONSTANT: rt-xt 3
CONSTANT: rt-here 4
CONSTANT: rt-this 5
CONSTANT: rt-immediate 6
CONSTANT: rt-stack-chain 7
CONSTANT: rt-xt-direct 4
CONSTANT: rt-here 5
CONSTANT: rt-this 6
CONSTANT: rt-immediate 7
CONSTANT: rt-stack-chain 8
CONSTANT: rt-untagged 9
: rc-absolute? ( n -- ? )
[ rc-absolute-ppc-2/2 = ]

7
basis/compiler/tests/call-effect.factor Normal file
View File

@ -0,0 +1,7 @@
IN: compiler.tests.call-effect
USING: tools.test combinators generic.single sequences kernel ;
: execute-ic-test ( a b -- c ) execute( a -- c ) ;
! VM type check error
[ 1 f execute-ic-test ] [ second 3 = ] must-fail-with

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

@ -26,7 +26,7 @@ IN: compiler.tests.codegen
[ 2 3 4 ] [ 3 [ 2 swap 4 ] compile-call ] unit-test
[ { 1 2 3 } { 1 4 3 } 3 3 ]
[ { 1 2 3 } { 1 4 3 } 2 2 ]
[ { 1 2 3 } { 1 4 3 } [ over tag over tag ] compile-call ]
unit-test
@ -37,7 +37,7 @@ unit-test
: foo ( -- ) ;
[ 5 5 ]
[ 3 3 ]
[ 1.2 [ tag [ foo ] keep ] compile-call ]
unit-test
@ -211,7 +211,7 @@ TUPLE: my-tuple ;
{ tuple vector } 3 slot { word } declare
dup 1 slot 0 fixnum-bitand { [ ] } dispatch ;
[ t ] [ \ dispatch-alignment-regression optimized>> ] unit-test
[ t ] [ \ dispatch-alignment-regression optimized? ] unit-test
[ vector ] [ dispatch-alignment-regression ] unit-test

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

@ -9,7 +9,7 @@ math.private tools.test math.floats.private ;
[ 3.0 1 2 3 ] [ 1.0 2.0 [ float+ 1 2 3 ] compile-call ] unit-test
[ 5 ] [ 1.0 [ 2.0 float+ tag ] compile-call ] unit-test
[ 3 ] [ 1.0 [ 2.0 float+ tag ] compile-call ] unit-test
[ 3.0 ] [ 1.0 [ 2.0 float+ ] compile-call ] unit-test
[ 3.0 ] [ 1.0 [ 2.0 swap float+ ] compile-call ] unit-test

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

@ -342,12 +342,12 @@ cell 8 = [
] unit-test
[ 1 2 ] [
1 2 [ <complex> ] compile-call
1 2 [ complex boa ] compile-call
dup real-part swap imaginary-part
] unit-test
[ 1 2 ] [
1 2 [ <ratio> ] compile-call dup numerator swap denominator
1 2 [ ratio boa ] compile-call dup numerator swap denominator
] unit-test
[ \ + ] [ \ + [ <wrapper> ] compile-call ] unit-test

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

@ -4,13 +4,13 @@ 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 ;
compiler definitions ;
IN: compiler.tests.optimizer
GENERIC: xyz ( obj -- obj )
M: array xyz xyz ;
[ t ] [ \ xyz optimized>> ] unit-test
[ t ] [ M\ array xyz optimized? ] unit-test
! Test predicate inlining
: pred-test-1 ( a -- b c )
@ -95,7 +95,7 @@ TUPLE: pred-test ;
! regression
GENERIC: void-generic ( obj -- * )
: breakage ( -- * ) "hi" void-generic ;
[ t ] [ \ breakage optimized>> ] unit-test
[ t ] [ \ breakage optimized? ] unit-test
[ breakage ] must-fail
! regression
@ -120,7 +120,7 @@ GENERIC: void-generic ( obj -- * )
! compiling <tuple> with a non-literal class failed
: <tuple>-regression ( class -- tuple ) <tuple> ;
[ t ] [ \ <tuple>-regression optimized>> ] unit-test
[ t ] [ \ <tuple>-regression optimized? ] unit-test
GENERIC: foozul ( a -- b )
M: reversed foozul ;
@ -229,7 +229,7 @@ USE: binary-search.private
: node-successor-f-bug ( x -- * )
[ 3 throw ] [ empty-compound ] compose [ 3 throw ] if ;
[ t ] [ \ node-successor-f-bug optimized>> ] unit-test
[ t ] [ \ node-successor-f-bug optimized? ] unit-test
[ ] [ [ new ] build-tree optimize-tree drop ] unit-test
@ -243,7 +243,7 @@ USE: binary-search.private
] if
] if ;
[ t ] [ \ lift-throw-tail-regression optimized>> ] unit-test
[ t ] [ \ lift-throw-tail-regression optimized? ] unit-test
[ 3 "an integer" ] [ 3 lift-throw-tail-regression ] unit-test
[ "hi" "a string" ] [ "hi" lift-throw-tail-regression ] unit-test
@ -274,7 +274,7 @@ HINTS: recursive-inline-hang array ;
: recursive-inline-hang-1 ( -- a )
{ } recursive-inline-hang ;
[ t ] [ \ recursive-inline-hang-1 optimized>> ] unit-test
[ t ] [ \ recursive-inline-hang-1 optimized? ] unit-test
DEFER: recursive-inline-hang-3
@ -325,7 +325,7 @@ PREDICATE: list < improper-list
dup "a" get { array-capacity } declare >=
[ dup "b" get { array-capacity } declare >= [ 3 ] [ 4 ] if ] [ 5 ] if ;
[ t ] [ \ interval-inference-bug optimized>> ] unit-test
[ t ] [ \ interval-inference-bug optimized? ] unit-test
[ ] [ 1 "a" set 2 "b" set ] unit-test
[ 2 3 ] [ 2 interval-inference-bug ] unit-test
@ -384,3 +384,9 @@ DEFER: loop-bbb
1 >bignum 2 >bignum
[ { bignum integer } declare [ shift ] keep 1+ ] compile-call
] unit-test
: broken-declaration ( -- ) \ + declare ;
[ f ] [ \ broken-declaration optimized? ] unit-test
[ ] [ [ \ broken-declaration forget ] with-compilation-unit ] unit-test

6
basis/compiler/tests/peg-regression.factor
View File

@ -4,7 +4,7 @@
! optimization, which would batch generic word updates at the
! end of a compilation unit.
USING: kernel accessors peg.ebnf ;
USING: kernel accessors peg.ebnf words ;
IN: compiler.tests.peg-regression
TUPLE: pipeline-expr background ;
@ -22,5 +22,5 @@ pipeline = "hello" => [[ ast>pipeline-expr ]]
USE: tools.test
[ t ] [ \ expr optimized>> ] unit-test
[ t ] [ \ ast>pipeline-expr optimized>> ] unit-test
[ t ] [ \ expr optimized? ] unit-test
[ t ] [ \ ast>pipeline-expr optimized? ] unit-test

14
basis/compiler/tests/pic-problem-1.factor Normal file
View File

@ -0,0 +1,14 @@
IN: compiler.tests.pic-problem-1
USING: kernel sequences prettyprint memory tools.test ;
TUPLE: x ;
M: x length drop 0 ;
INSTANCE: x sequence
<< gc >>
CONSTANT: blah T{ x }
[ T{ x } ] [ blah ] unit-test

4
basis/compiler/tests/redefine3.factor
View File

@ -14,7 +14,7 @@ M: empty-mixin sheeple drop "wake up" ;
: sheeple-test ( -- string ) { } sheeple ;
[ "sheeple" ] [ sheeple-test ] unit-test
[ t ] [ \ sheeple-test optimized>> ] unit-test
[ t ] [ \ sheeple-test optimized? ] unit-test
[ t ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
[ f ] [ empty-mixin \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
@ -27,6 +27,6 @@ M: empty-mixin sheeple drop "wake up" ;
[ ] [ [ array empty-mixin remove-mixin-instance ] with-compilation-unit ] unit-test
[ "sheeple" ] [ sheeple-test ] unit-test
[ t ] [ \ sheeple-test optimized>> ] unit-test
[ t ] [ \ sheeple-test optimized? ] unit-test
[ t ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
[ f ] [ empty-mixin \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test

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

@ -235,6 +235,6 @@ M: f single-combination-test-2 single-combination-test-4 ;
10 [
[ "compiler.tests.foo" forget-vocab ] with-compilation-unit
[ t ] [
"USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline recursive : recursive ( -- ) (recursive) ; \\ (recursive) optimized>>" eval( -- obj )
"USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline recursive : recursive ( -- ) (recursive) ; \\ (recursive) optimized?" eval( -- obj )
] unit-test
] times

8
basis/compiler/tests/spilling.factor
View File

@ -1,5 +1,5 @@
USING: math.private kernel combinators accessors arrays
generalizations tools.test ;
generalizations tools.test words ;
IN: compiler.tests.spilling
: float-spill-bug ( a -- b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b )
@ -47,7 +47,7 @@ IN: compiler.tests.spilling
[ 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 ]
[ 1.0 float-spill-bug ] unit-test
[ t ] [ \ float-spill-bug optimized>> ] unit-test
[ t ] [ \ float-spill-bug optimized? ] unit-test
: float-fixnum-spill-bug ( object -- object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object )
{
@ -132,7 +132,7 @@ IN: compiler.tests.spilling
[ 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 ]
[ 1.0 float-fixnum-spill-bug ] unit-test
[ t ] [ \ float-fixnum-spill-bug optimized>> ] unit-test
[ t ] [ \ float-fixnum-spill-bug optimized? ] unit-test
: resolve-spill-bug ( a b -- c )
[ 1 fixnum+fast ] bi@ dup 10 fixnum< [
@ -159,7 +159,7 @@ IN: compiler.tests.spilling
16 narray
] if ;
[ t ] [ \ resolve-spill-bug optimized>> ] unit-test
[ t ] [ \ resolve-spill-bug optimized? ] unit-test
[ 4 ] [ 1 1 resolve-spill-bug ] unit-test

2
basis/compiler/tree/debugger/debugger.factor
View File

@ -153,7 +153,7 @@ SYMBOL: node-count
[ 1+ ] dip
dup #call? [
word>> {
{ [ dup "intrinsics" word-prop over "if-intrinsics" word-prop or ] [ intrinsics-called ] }
{ [ dup "intrinsic" word-prop ] [ intrinsics-called ] }
{ [ dup generic? ] [ generics-called ] }
{ [ dup method-body? ] [ methods-called ] }
[ words-called ]

1
basis/compiler/tree/escape-analysis/check/check.factor
View File

@ -12,7 +12,6 @@ M: #push run-escape-analysis*
M: #call run-escape-analysis*
{
{ [ dup word>> \ <complex> eq? ] [ t ] }
{ [ dup immutable-tuple-boa? ] [ t ] }
[ f ]
} cond nip ;

4
basis/compiler/tree/escape-analysis/escape-analysis-tests.factor
View File

@ -17,7 +17,7 @@ GENERIC: count-unboxed-allocations* ( m node -- n )
out-d>> first escaping-allocation? [ 1+ ] unless ;
M: #call count-unboxed-allocations*
dup [ immutable-tuple-boa? ] [ word>> \ <complex> eq? ] bi or
dup immutable-tuple-boa?
[ (count-unboxed-allocations) ] [ drop ] if ;
M: #push count-unboxed-allocations*
@ -291,7 +291,7 @@ C: <ro-box> ro-box
[ 0 ] [ [ bad-tuple-fib-3 i>> ] count-unboxed-allocations ] unit-test
[ 1 ] [ [ <complex> >rect ] count-unboxed-allocations ] unit-test
[ 1 ] [ [ complex boa >rect ] count-unboxed-allocations ] unit-test
[ 0 ] [ [ 1 cons boa 2 cons boa ] count-unboxed-allocations ] unit-test

4
basis/compiler/tree/escape-analysis/simple/simple.factor
View File

@ -47,9 +47,6 @@ M: #push escape-analysis*
[ record-unknown-allocation ]
if ;
: record-complex-allocation ( #call -- )
[ in-d>> ] [ out-d>> first ] bi record-allocation ;
: slot-offset ( #call -- n/f )
dup in-d>>
[ first node-value-info class>> ]
@ -71,7 +68,6 @@ M: #push escape-analysis*
M: #call escape-analysis*
dup word>> {
{ \ <tuple-boa> [ record-tuple-allocation ] }
{ \ <complex> [ record-complex-allocation ] }
{ \ slot [ record-slot-call ] }
[ drop record-unknown-allocation ]
} case ;

16
basis/compiler/tree/propagation/info/info.factor
View File

@ -70,18 +70,10 @@ DEFER: <literal-info>
dup literal>> class >>class
dup literal>> dup real? [ [a,a] >>interval ] [
[ [-inf,inf] >>interval ] dip
{
{ [ dup complex? ] [
[ real-part <literal-info> ]
[ imaginary-part <literal-info> ] bi
2array >>slots
] }
{ [ dup tuple? ] [
[ tuple-slots [ <literal-info> ] map ] [ class ] bi
read-only-slots >>slots
] }
[ drop ]
} cond
dup tuple? [
[ tuple-slots [ <literal-info> ] map ] [ class ] bi
read-only-slots >>slots
] [ drop ] if
] if ; inline
: init-value-info ( info -- info )

6
basis/compiler/tree/propagation/inlining/inlining.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel arrays sequences math math.order
math.partial-dispatch generic generic.standard generic.math
math.partial-dispatch generic generic.standard generic.single generic.math
classes.algebra classes.union sets quotations assocs combinators
words namespaces continuations classes fry combinators.smart hints
locals
@ -188,9 +188,7 @@ SYMBOL: history
{ curry compose } memq? ;
: never-inline-word? ( word -- ? )
[ deferred? ]
[ "default" word-prop ]
[ { call execute } memq? ] tri or or ;
[ deferred? ] [ "default" word-prop ] [ \ call eq? ] tri or or ;
: custom-inlining? ( word -- ? )
"custom-inlining" word-prop ;

6
basis/compiler/tree/propagation/propagation-tests.factor
View File

@ -357,7 +357,7 @@ TUPLE: immutable-prop-test-tuple { x sequence read-only } ;
] unit-test
[ V{ complex } ] [
[ <complex> ] final-classes
[ complex boa ] final-classes
] unit-test
[ V{ complex } ] [
@ -375,7 +375,7 @@ TUPLE: immutable-prop-test-tuple { x sequence read-only } ;
[ V{ complex } ] [
[
{ float float object } declare
[ "Oops" throw ] [ <complex> ] if
[ "Oops" throw ] [ complex boa ] if
] final-classes
] unit-test
@ -590,7 +590,7 @@ MIXIN: empty-mixin
[ V{ float } ] [
[
[ { float float } declare <complex> ]
[ { float float } declare complex boa ]
[ 2drop C{ 0.0 0.0 } ]
if real-part
] final-classes

2
basis/compiler/tree/propagation/simple/simple.factor
View File

@ -109,7 +109,7 @@ M: #declare propagate-before
: output-value-infos ( #call word -- infos )
{
{ [ dup tuple-constructor? ] [ propagate-tuple-constructor ] }
{ [ dup \ <tuple-boa> eq? ] [ drop propagate-<tuple-boa> ] }
{ [ dup sequence-constructor? ] [ propagate-sequence-constructor ] }
{ [ dup predicate? ] [ propagate-predicate ] }
{ [ dup "outputs" word-prop ] [ call-outputs-quot ] }

21
basis/compiler/tree/propagation/slots/slots.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: fry assocs arrays byte-arrays strings accessors sequences
kernel slots classes.algebra classes.tuple classes.tuple.private
@ -8,9 +8,6 @@ IN: compiler.tree.propagation.slots
! Propagation of immutable slots and array lengths
! Revisit this code when delegation is removed and when complex
! numbers become tuples.
UNION: fixed-length-sequence array byte-array string ;
: sequence-constructor? ( word -- ? )
@ -29,9 +26,6 @@ UNION: fixed-length-sequence array byte-array string ;
[ constructor-output-class <class-info> ]
bi* value-info-intersect 1array ;
: tuple-constructor? ( word -- ? )
{ <tuple-boa> <complex> } memq? ;
: fold-<tuple-boa> ( values class -- info )
[ [ literal>> ] map ] dip prefix >tuple
<literal-info> ;
@ -44,18 +38,9 @@ UNION: fixed-length-sequence array byte-array string ;
<tuple-info>
] if ;
: propagate-<tuple-boa> ( #call -- info )
: propagate-<tuple-boa> ( #call -- infos )
in-d>> unclip-last
value-info literal>> first (propagate-tuple-constructor) ;
: propagate-<complex> ( #call -- info )
in-d>> [ value-info ] map complex <tuple-info> ;
: propagate-tuple-constructor ( #call word -- infos )
{
{ \ <tuple-boa> [ propagate-<tuple-boa> ] }
{ \ <complex> [ propagate-<complex> ] }
} case 1array ;
value-info literal>> first (propagate-tuple-constructor) 1array ;
: read-only-slot? ( n class -- ? )
all-slots [ offset>> = ] with find nip

1
basis/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor
View File

@ -32,7 +32,6 @@ TUPLE: empty-tuple ;
[ dup [ drop f ] [ "A" throw ] if ]
[ [ ] [ ] curry curry dup 2 slot swap 3 slot dup 2 slot swap 3 slot drop ]
[ [ ] [ ] curry curry call ]
[ <complex> <complex> dup 1 slot drop 2 slot drop ]
[ 1 cons boa over [ "A" throw ] when car>> ]
[ [ <=> ] sort ]
[ [ <=> ] with search ]

4
basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor
View File

@ -36,9 +36,6 @@ M: #push unbox-tuples* ( #push -- nodes )
: unbox-<tuple-boa> ( #call -- nodes )
dup unbox-output? [ in-d>> 1 tail* #drop ] when ;
: unbox-<complex> ( #call -- nodes )
dup unbox-output? [ drop { } ] when ;
: (flatten-values) ( values accum -- )
dup '[
dup unboxed-allocation
@ -70,7 +67,6 @@ M: #push unbox-tuples* ( #push -- nodes )
M: #call unbox-tuples*
dup word>> {
{ \ <tuple-boa> [ unbox-<tuple-boa> ] }
{ \ <complex> [ unbox-<complex> ] }
{ \ slot [ unbox-slot-access ] }
[ drop ]
} case ;

146
basis/cpu/ppc/bootstrap.factor
View File

@ -2,15 +2,13 @@
! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image.private kernel kernel.private namespaces
system cpu.ppc.assembler compiler.codegen.fixup compiler.units
compiler.constants math math.private layouts words words.private
compiler.constants math math.private layouts words
vocabs slots.private locals.backend ;
IN: bootstrap.ppc
4 \ cell set
big-endian on
4 jit-code-format set
CONSTANT: ds-reg 29
CONSTANT: rs-reg 30
@ -23,7 +21,7 @@ CONSTANT: rs-reg 30
: xt-save ( -- n ) stack-frame 2 bootstrap-cells - ;
[
0 6 LOAD32
0 6 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel
11 6 profile-count-offset LWZ
11 11 1 tag-fixnum ADDI
11 6 profile-count-offset STW
@ -31,65 +29,50 @@ CONSTANT: rs-reg 30
11 11 compiled-header-size ADDI
11 MTCTR
BCTR
] rc-absolute-ppc-2/2 rt-immediate 1 jit-profiling jit-define
] jit-profiling jit-define
[
0 6 LOAD32
0 6 LOAD32 rc-absolute-ppc-2/2 rt-this jit-rel
0 MFLR
1 1 stack-frame SUBI
6 1 xt-save STW
stack-frame 6 LI
6 1 next-save STW
0 1 lr-save stack-frame + STW
] rc-absolute-ppc-2/2 rt-this 1 jit-prolog jit-define
] jit-prolog jit-define
[
0 6 LOAD32
0 6 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel
6 ds-reg 4 STWU
] rc-absolute-ppc-2/2 rt-immediate 1 jit-push-immediate jit-define
] jit-push-immediate jit-define
[
0 6 LOAD32
0 6 LOAD32 rc-absolute-ppc-2/2 rt-stack-chain jit-rel
7 6 0 LWZ
1 7 0 STW
] rc-absolute-ppc-2/2 rt-stack-chain 1 jit-save-stack jit-define
] jit-save-stack jit-define
[
0 6 LOAD32
0 6 LOAD32 rc-absolute-ppc-2/2 rt-primitive jit-rel
6 MTCTR
BCTR
] rc-absolute-ppc-2/2 rt-primitive 1 jit-primitive jit-define
] jit-primitive jit-define
[ 0 BL ] rc-relative-ppc-3 rt-xt 0 jit-word-call jit-define
[ 0 BL rc-relative-ppc-3 rt-xt-direct jit-rel ] jit-word-call jit-define
[ 0 B ] rc-relative-ppc-3 rt-xt 0 jit-word-jump jit-define
[ 0 B rc-relative-ppc-3 rt-xt jit-rel ] jit-word-jump jit-define
[
3 ds-reg 0 LWZ
ds-reg dup 4 SUBI
0 3 \ f tag-number CMPI
2 BEQ
0 B
] rc-relative-ppc-3 rt-xt 4 jit-if-1 jit-define
0 B rc-relative-ppc-3 rt-xt jit-rel
] jit-if-1 jit-define
[
0 B
] rc-relative-ppc-3 rt-xt 0 jit-if-2 jit-define
: jit-jump-quot ( -- )
4 3 quot-xt-offset LWZ
4 MTCTR
BCTR ;
[
0 3 LOAD32
6 ds-reg 0 LWZ
6 6 1 SRAWI
3 3 6 ADD
3 3 array-start-offset LWZ
ds-reg dup 4 SUBI
jit-jump-quot
] rc-absolute-ppc-2/2 rt-immediate 1 jit-dispatch jit-define
0 B rc-relative-ppc-3 rt-xt jit-rel
] jit-if-2 jit-define
: jit->r ( -- )
4 ds-reg 0 LWZ
@ -139,29 +122,29 @@ CONSTANT: rs-reg 30
[
jit->r
0 BL
0 BL rc-relative-ppc-3 rt-xt jit-rel
jit-r>
] rc-relative-ppc-3 rt-xt 3 jit-dip jit-define
] jit-dip jit-define
[
jit-2>r
0 BL
0 BL rc-relative-ppc-3 rt-xt jit-rel
jit-2r>
] rc-relative-ppc-3 rt-xt 6 jit-2dip jit-define
] jit-2dip jit-define
[
jit-3>r
0 BL
0 BL rc-relative-ppc-3 rt-xt jit-rel
jit-3r>
] rc-relative-ppc-3 rt-xt 8 jit-3dip jit-define
] jit-3dip jit-define
[
0 1 lr-save stack-frame + LWZ
1 1 stack-frame ADDI
0 MTLR
] f f f jit-epilog jit-define
] jit-epilog jit-define
[ BLR ] f f f jit-return jit-define
[ BLR ] jit-return jit-define
! Sub-primitives
@ -169,8 +152,10 @@ CONSTANT: rs-reg 30
[
3 ds-reg 0 LWZ
ds-reg dup 4 SUBI
jit-jump-quot
] f f f \ (call) define-sub-primitive
4 3 quot-xt-offset LWZ
4 MTCTR
BCTR
] \ (call) define-sub-primitive
[
3 ds-reg 0 LWZ
@ -178,7 +163,7 @@ CONSTANT: rs-reg 30
4 3 word-xt-offset LWZ
4 MTCTR
BCTR
] f f f \ (execute) define-sub-primitive
] \ (execute) define-sub-primitive
! Objects
[
@ -186,7 +171,7 @@ CONSTANT: rs-reg 30
3 3 tag-mask get ANDI
3 3 tag-bits get SLWI
3 ds-reg 0 STW
] f f f \ tag define-sub-primitive
] \ tag define-sub-primitive
[
3 ds-reg 0 LWZ
@ -195,25 +180,25 @@ CONSTANT: rs-reg 30
4 4 0 0 31 tag-bits get - RLWINM
4 3 3 LWZX
3 ds-reg 0 STW
] f f f \ slot define-sub-primitive
] \ slot define-sub-primitive
! Shufflers
[
ds-reg dup 4 SUBI
] f f f \ drop define-sub-primitive
] \ drop define-sub-primitive
[
ds-reg dup 8 SUBI
] f f f \ 2drop define-sub-primitive
] \ 2drop define-sub-primitive
[
ds-reg dup 12 SUBI
] f f f \ 3drop define-sub-primitive
] \ 3drop define-sub-primitive
[
3 ds-reg 0 LWZ
3 ds-reg 4 STWU
] f f f \ dup define-sub-primitive
] \ dup define-sub-primitive
[
3 ds-reg 0 LWZ
@ -221,7 +206,7 @@ CONSTANT: rs-reg 30
ds-reg dup 8 ADDI
3 ds-reg 0 STW
4 ds-reg -4 STW
] f f f \ 2dup define-sub-primitive
] \ 2dup define-sub-primitive
[
3 ds-reg 0 LWZ
@ -231,36 +216,36 @@ CONSTANT: rs-reg 30
3 ds-reg 0 STW
4 ds-reg -4 STW
5 ds-reg -8 STW
] f f f \ 3dup define-sub-primitive
] \ 3dup define-sub-primitive
[
3 ds-reg 0 LWZ
ds-reg dup 4 SUBI
3 ds-reg 0 STW
] f f f \ nip define-sub-primitive
] \ nip define-sub-primitive
[
3 ds-reg 0 LWZ
ds-reg dup 8 SUBI
3 ds-reg 0 STW
] f f f \ 2nip define-sub-primitive
] \ 2nip define-sub-primitive
[
3 ds-reg -4 LWZ
3 ds-reg 4 STWU
] f f f \ over define-sub-primitive
] \ over define-sub-primitive
[
3 ds-reg -8 LWZ
3 ds-reg 4 STWU
] f f f \ pick define-sub-primitive
] \ pick define-sub-primitive
[
3 ds-reg 0 LWZ
4 ds-reg -4 LWZ
4 ds-reg 0 STW
3 ds-reg 4 STWU
] f f f \ dupd define-sub-primitive
] \ dupd define-sub-primitive
[
3 ds-reg 0 LWZ
@ -268,21 +253,21 @@ CONSTANT: rs-reg 30
3 ds-reg 4 STWU
4 ds-reg -4 STW
3 ds-reg -8 STW
] f f f \ tuck define-sub-primitive
] \ tuck define-sub-primitive
[
3 ds-reg 0 LWZ
4 ds-reg -4 LWZ
3 ds-reg -4 STW
4 ds-reg 0 STW
] f f f \ swap define-sub-primitive
] \ swap define-sub-primitive
[
3 ds-reg -4 LWZ
4 ds-reg -8 LWZ
3 ds-reg -8 STW
4 ds-reg -4 STW
] f f f \ swapd define-sub-primitive
] \ swapd define-sub-primitive
[
3 ds-reg 0 LWZ
@ -291,7 +276,7 @@ CONSTANT: rs-reg 30
4 ds-reg -8 STW
3 ds-reg -4 STW
5 ds-reg 0 STW
] f f f \ rot define-sub-primitive
] \ rot define-sub-primitive
[
3 ds-reg 0 LWZ
@ -300,13 +285,13 @@ CONSTANT: rs-reg 30
3 ds-reg -8 STW
5 ds-reg -4 STW
4 ds-reg 0 STW
] f f f \ -rot define-sub-primitive
] \ -rot define-sub-primitive
[ jit->r ] f f f \ load-local define-sub-primitive
[ jit->r ] \ load-local define-sub-primitive
! Comparisons
: jit-compare ( insn -- )
0 3 LOAD32
0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel
4 ds-reg 0 LWZ
5 ds-reg -4 LWZU
5 0 4 CMP
@ -315,8 +300,7 @@ CONSTANT: rs-reg 30
3 ds-reg 0 STW ;
: define-jit-compare ( insn word -- )
[ [ jit-compare ] curry rc-absolute-ppc-2/2 rt-immediate 1 ] dip
define-sub-primitive ;
[ [ jit-compare ] curry ] dip define-sub-primitive ;
\ BEQ \ eq? define-jit-compare
\ BGE \ fixnum>= define-jit-compare
@ -336,7 +320,7 @@ CONSTANT: rs-reg 30
2 BNE
1 tag-fixnum 4 LI
4 ds-reg 0 STW
] f f f \ both-fixnums? define-sub-primitive
] \ both-fixnums? define-sub-primitive
: jit-math ( insn -- )
3 ds-reg 0 LWZ
@ -344,9 +328,9 @@ CONSTANT: rs-reg 30
[ 5 3 4 ] dip execute( dst src1 src2 -- )
5 ds-reg 0 STW ;
[ \ ADD jit-math ] f f f \ fixnum+fast define-sub-primitive
[ \ ADD jit-math ] \ fixnum+fast define-sub-primitive
[ \ SUBF jit-math ] f f f \ fixnum-fast define-sub-primitive
[ \ SUBF jit-math ] \ fixnum-fast define-sub-primitive
[
3 ds-reg 0 LWZ
@ -354,20 +338,20 @@ CONSTANT: rs-reg 30
4 4 tag-bits get SRAWI
5 3 4 MULLW
5 ds-reg 0 STW
] f f f \ fixnum*fast define-sub-primitive
] \ fixnum*fast define-sub-primitive
[ \ AND jit-math ] f f f \ fixnum-bitand define-sub-primitive
[ \ AND jit-math ] \ fixnum-bitand define-sub-primitive
[ \ OR jit-math ] f f f \ fixnum-bitor define-sub-primitive
[ \ OR jit-math ] \ fixnum-bitor define-sub-primitive
[ \ XOR jit-math ] f f f \ fixnum-bitxor define-sub-primitive
[ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive
[
3 ds-reg 0 LWZ
3 3 NOT
3 3 tag-mask get XORI
3 ds-reg 0 STW
] f f f \ fixnum-bitnot define-sub-primitive
] \ fixnum-bitnot define-sub-primitive
[
3 ds-reg 0 LWZ
@ -382,7 +366,7 @@ CONSTANT: rs-reg 30
2 BGT
5 7 MR
5 ds-reg 0 STW
] f f f \ fixnum-shift-fast define-sub-primitive
] \ fixnum-shift-fast define-sub-primitive
[
3 ds-reg 0 LWZ
@ -392,7 +376,7 @@ CONSTANT: rs-reg 30
6 5 3 MULLW
7 6 4 SUBF
7 ds-reg 0 STW
] f f f \ fixnum-mod define-sub-primitive
] \ fixnum-mod define-sub-primitive
[
3 ds-reg 0 LWZ
@ -401,7 +385,7 @@ CONSTANT: rs-reg 30
5 4 3 DIVW
5 5 tag-bits get SLWI
5 ds-reg 0 STW
] f f f \ fixnum/i-fast define-sub-primitive
] \ fixnum/i-fast define-sub-primitive
[
3 ds-reg 0 LWZ
@ -412,20 +396,20 @@ CONSTANT: rs-reg 30
5 5 tag-bits get SLWI
5 ds-reg -4 STW
7 ds-reg 0 STW
] f f f \ fixnum/mod-fast define-sub-primitive
] \ fixnum/mod-fast define-sub-primitive
[
3 ds-reg 0 LWZ
3 3 1 SRAWI
rs-reg 3 3 LWZX
3 ds-reg 0 STW
] f f f \ get-local define-sub-primitive
] \ get-local define-sub-primitive
[
3 ds-reg 0 LWZ
ds-reg ds-reg 4 SUBI
3 3 1 SRAWI
rs-reg 3 rs-reg SUBF
] f f f \ drop-locals define-sub-primitive
] \ drop-locals define-sub-primitive
[ "bootstrap.ppc" forget-vocab ] with-compilation-unit

12
basis/cpu/x86/32/bootstrap.factor
View File

@ -22,13 +22,15 @@ IN: bootstrap.x86
: rex-length ( -- n ) 0 ;
[
temp0 0 [] MOV ! load stack_chain
temp0 [] stack-reg MOV ! save stack pointer
] rc-absolute-cell rt-stack-chain 2 jit-save-stack jit-define
! load stack_chain
temp0 0 [] MOV rc-absolute-cell rt-stack-chain jit-rel
! save stack pointer
temp0 [] stack-reg MOV
] jit-save-stack jit-define
[
(JMP) drop
] rc-relative rt-primitive 1 jit-primitive jit-define
(JMP) drop rc-relative rt-primitive jit-rel
] jit-primitive jit-define
<< "vocab:cpu/x86/bootstrap.factor" parse-file parsed >>
call

16
basis/cpu/x86/64/bootstrap.factor
View File

@ -20,15 +20,19 @@ IN: bootstrap.x86
: rex-length ( -- n ) 1 ;
[
temp0 0 MOV ! load stack_chain
! load stack_chain
temp0 0 MOV rc-absolute-cell rt-stack-chain jit-rel
temp0 temp0 [] MOV
temp0 [] stack-reg MOV ! save stack pointer
] rc-absolute-cell rt-stack-chain 1 rex-length + jit-save-stack jit-define
! save stack pointer
temp0 [] stack-reg MOV
] jit-save-stack jit-define
[
temp1 0 MOV ! load XT
temp1 JMP ! go
] rc-absolute-cell rt-primitive 1 rex-length + jit-primitive jit-define
! load XT
temp1 0 MOV rc-absolute-cell rt-primitive jit-rel
! go
temp1 JMP
] jit-primitive jit-define
<< "vocab:cpu/x86/bootstrap.factor" parse-file parsed >>
call

2
basis/cpu/x86/assembler/assembler-tests.factor
View File

@ -62,3 +62,5 @@ IN: cpu.x86.assembler.tests
[ { HEX: 48 HEX: d3 HEX: e1 } ] [ [ RCX CL SHL ] { } make ] unit-test
[ { HEX: 48 HEX: d3 HEX: e8 } ] [ [ RAX CL SHR ] { } make ] unit-test
[ { HEX: 48 HEX: d3 HEX: e9 } ] [ [ RCX CL SHR ] { } make ] unit-test
[ { HEX: f7 HEX: c1 HEX: d2 HEX: 04 HEX: 00 HEX: 00 } ] [ [ ECX 1234 TEST ] { } make ] unit-test

15
basis/cpu/x86/assembler/assembler.factor
View File

@ -316,15 +316,16 @@ M: operand JMP { BIN: 100 t HEX: ff } 1-operand ;
GENERIC: CALL ( op -- )
: (CALL) ( -- rel-class ) HEX: e8 , 0 4, rc-relative ;
M: f CALL (CALL) 2drop ;
M: callable CALL (CALL) rel-word ;
M: callable CALL (CALL) rel-word-direct ;
M: label CALL (CALL) label-fixup ;
M: operand CALL { BIN: 010 t HEX: ff } 1-operand ;
GENERIC# JUMPcc 1 ( addr opcode -- )
: (JUMPcc) ( n -- rel-class ) extended-opcode, 0 4, rc-relative ;
M: f JUMPcc nip (JUMPcc) drop ;
M: callable JUMPcc (JUMPcc) rel-word ;
M: label JUMPcc (JUMPcc) label-fixup ;
: (JUMPcc) ( addr n -- rel-class ) extended-opcode, 4, rc-relative ;
M: f JUMPcc [ 0 ] dip (JUMPcc) 2drop ;
M: integer JUMPcc (JUMPcc) drop ;
M: callable JUMPcc [ 0 ] dip (JUMPcc) rel-word ;
M: label JUMPcc [ 0 ] dip (JUMPcc) label-fixup ;
: JO ( dst -- ) HEX: 80 JUMPcc ;
: JNO ( dst -- ) HEX: 81 JUMPcc ;
@ -382,6 +383,10 @@ GENERIC: CMP ( dst src -- )
M: immediate CMP swap { BIN: 111 t HEX: 80 } immediate-1/4 ;
M: operand CMP OCT: 070 2-operand ;
GENERIC: TEST ( dst src -- )
M: immediate TEST swap { BIN: 0 t HEX: f7 } immediate-4 ;
M: operand TEST OCT: 204 2-operand ;
: XCHG ( dst src -- ) OCT: 207 2-operand ;
: BSR ( dst src -- ) swap { HEX: 0f HEX: bd } (2-operand) ;

255
basis/cpu/x86/bootstrap.factor
View File

@ -1,18 +1,16 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image.private kernel kernel.private namespaces
system cpu.x86.assembler layouts compiler.units math
math.private compiler.constants vocabs slots.private words
words.private locals.backend ;
locals.backend make sequences combinators arrays ;
IN: bootstrap.x86
big-endian off
1 jit-code-format set
[
! Load word
temp0 0 MOV
temp0 0 MOV rc-absolute-cell rt-immediate jit-rel
! Bump profiling counter
temp0 profile-count-offset [+] 1 tag-fixnum ADD
! Load word->code
@ -21,35 +19,35 @@ big-endian off
temp0 compiled-header-size ADD
! Jump to XT
temp0 JMP
] rc-absolute-cell rt-immediate 1 rex-length + jit-profiling jit-define
] jit-profiling jit-define
[
! load XT
temp0 0 MOV
temp0 0 MOV rc-absolute-cell rt-this jit-rel
! save stack frame size
stack-frame-size PUSH
! push XT
temp0 PUSH
! alignment
stack-reg stack-frame-size 3 bootstrap-cells - SUB
] rc-absolute-cell rt-this 1 rex-length + jit-prolog jit-define
] jit-prolog jit-define
[
! load literal
temp0 0 MOV
temp0 0 MOV rc-absolute-cell rt-immediate jit-rel
! increment datastack pointer
ds-reg bootstrap-cell ADD
! store literal on datastack
ds-reg [] temp0 MOV
] rc-absolute-cell rt-immediate 1 rex-length + jit-push-immediate jit-define
] jit-push-immediate jit-define
[
f JMP
] rc-relative rt-xt 1 jit-word-jump jit-define
f JMP rc-relative rt-xt jit-rel
] jit-word-jump jit-define
[
f CALL
] rc-relative rt-xt 1 jit-word-call jit-define
f CALL rc-relative rt-xt-direct jit-rel
] jit-word-call jit-define
[
! load boolean
@ -59,31 +57,13 @@ big-endian off
! compare boolean with f
temp0 \ f tag-number CMP
! jump to true branch if not equal
f JNE
] rc-relative rt-xt 10 rex-length 3 * + jit-if-1 jit-define
f JNE rc-relative rt-xt jit-rel
] jit-if-1 jit-define
[
! jump to false branch if equal
f JMP
] rc-relative rt-xt 1 jit-if-2 jit-define
[
! load dispatch table
temp1 0 MOV
! load index
temp0 ds-reg [] MOV
! turn it into an array offset
fixnum>slot@
! pop index
ds-reg bootstrap-cell SUB
! compute quotation location
temp0 temp1 ADD
! load quotation
arg temp0 array-start-offset [+] MOV
! execute branch. the quot must be in arg, since it might
! not be compiled yet
arg quot-xt-offset [+] JMP
] rc-absolute-cell rt-immediate 1 rex-length + jit-dispatch jit-define
f JMP rc-relative rt-xt jit-rel
] jit-if-2 jit-define
: jit->r ( -- )
rs-reg bootstrap-cell ADD
@ -135,30 +115,133 @@ big-endian off
[
jit->r
f CALL
f CALL rc-relative rt-xt jit-rel
jit-r>
] rc-relative rt-xt 11 rex-length 4 * + jit-dip jit-define
] jit-dip jit-define
[
jit-2>r
f CALL
f CALL rc-relative rt-xt jit-rel
jit-2r>
] rc-relative rt-xt 17 rex-length 6 * + jit-2dip jit-define
] jit-2dip jit-define
[
jit-3>r
f CALL
f CALL rc-relative rt-xt jit-rel
jit-3r>
] rc-relative rt-xt 23 rex-length 8 * + jit-3dip jit-define
] jit-3dip jit-define
: prepare-(execute) ( -- operand )
! load from stack
temp0 ds-reg [] MOV
! pop stack
ds-reg bootstrap-cell SUB
! execute word
temp0 word-xt-offset [+] ;
[ prepare-(execute) JMP ] jit-execute-jump jit-define
[ prepare-(execute) CALL ] jit-execute-call jit-define
[
! unwind stack frame
stack-reg stack-frame-size bootstrap-cell - ADD
] f f f jit-epilog jit-define
] jit-epilog jit-define
[ 0 RET ] f f f jit-return jit-define
[ 0 RET ] jit-return jit-define
! Sub-primitives
! ! ! Polymorphic inline caches
! temp0 contains the object being dispatched on
! temp1 contains its class
! Load a value from a stack position
[
temp1 ds-reg HEX: ffffffff [+] MOV rc-absolute rt-untagged jit-rel
] pic-load jit-define
! Tag
: load-tag ( -- )
temp1 tag-mask get AND
temp1 tag-bits get SHL ;
[ load-tag ] pic-tag jit-define
! The 'make' trick lets us compute the jump distance for the
! conditional branches there
! Hi-tag
[
temp0 temp1 MOV
load-tag
temp1 object tag-number tag-fixnum CMP
[ temp1 temp0 object tag-number neg [+] MOV ] { } make
[ length JNE ] [ % ] bi
] pic-hi-tag jit-define
! Tuple
[
temp0 temp1 MOV
load-tag
temp1 tuple tag-number tag-fixnum CMP
[ temp1 temp0 tuple tag-number neg bootstrap-cell + [+] MOV ] { } make
[ length JNE ] [ % ] bi
] pic-tuple jit-define
! Hi-tag and tuple
[
temp0 temp1 MOV
load-tag
! If bits 2 and 3 are set, the tag is either 6 (object) or 7 (tuple)
temp1 BIN: 110 tag-fixnum CMP
[
! Untag temp0
temp0 tag-mask get bitnot AND
! Set temp1 to 0 for objects, and 8 for tuples
temp1 1 tag-fixnum AND
bootstrap-cell 4 = [ temp1 1 SHR ] when
! Load header cell or tuple layout cell
temp1 temp0 temp1 [+] MOV
] [ ] make [ length JL ] [ % ] bi
] pic-hi-tag-tuple jit-define
[
temp1 HEX: ffffffff CMP rc-absolute rt-immediate jit-rel
] pic-check-tag jit-define
[
temp2 HEX: ffffffff MOV rc-absolute-cell rt-immediate jit-rel
temp1 temp2 CMP
] pic-check jit-define
[ f JE rc-relative rt-xt jit-rel ] pic-hit jit-define
! ! ! Megamorphic caches
[
! cache = ...
temp0 0 MOV rc-absolute-cell rt-immediate jit-rel
! key = class
temp2 temp1 MOV
bootstrap-cell 8 = [ temp2 1 SHL ] when
! key &= cache.length - 1
temp2 mega-cache-size get 1- bootstrap-cell * AND
! cache += array-start-offset
temp0 array-start-offset ADD
! cache += key
temp0 temp2 ADD
! if(get(cache) == class)
temp0 [] temp1 CMP
! ... goto get(cache + bootstrap-cell)
[
temp0 temp0 bootstrap-cell [+] MOV
temp0 word-xt-offset [+] JMP
] [ ] make
[ length JNE ] [ % ] bi
! fall-through on miss
] mega-lookup jit-define
! ! ! Sub-primitives
! Quotations and words
[
@ -168,16 +251,7 @@ big-endian off
ds-reg bootstrap-cell SUB
! call quotation
arg quot-xt-offset [+] JMP
] f f f \ (call) define-sub-primitive
[
! load from stack
temp0 ds-reg [] MOV
! pop stack
ds-reg bootstrap-cell SUB
! execute word
temp0 word-xt-offset [+] JMP
] f f f \ (execute) define-sub-primitive
] \ (call) define-sub-primitive
! Objects
[
@ -189,7 +263,7 @@ big-endian off
temp0 tag-bits get SHL
! push to stack
ds-reg [] temp0 MOV
] f f f \ tag define-sub-primitive
] \ tag define-sub-primitive
[
! load slot number
@ -207,26 +281,26 @@ big-endian off
temp0 temp1 temp0 [+] MOV
! push to stack
ds-reg [] temp0 MOV
] f f f \ slot define-sub-primitive
] \ slot define-sub-primitive
! Shufflers
[
ds-reg bootstrap-cell SUB
] f f f \ drop define-sub-primitive
] \ drop define-sub-primitive
[
ds-reg 2 bootstrap-cells SUB
] f f f \ 2drop define-sub-primitive
] \ 2drop define-sub-primitive
[
ds-reg 3 bootstrap-cells SUB
] f f f \ 3drop define-sub-primitive
] \ 3drop define-sub-primitive
[
temp0 ds-reg [] MOV
ds-reg bootstrap-cell ADD
ds-reg [] temp0 MOV
] f f f \ dup define-sub-primitive
] \ dup define-sub-primitive
[
temp0 ds-reg [] MOV
@ -234,7 +308,7 @@ big-endian off
ds-reg 2 bootstrap-cells ADD
ds-reg [] temp0 MOV
ds-reg bootstrap-cell neg [+] temp1 MOV
] f f f \ 2dup define-sub-primitive
] \ 2dup define-sub-primitive
[
temp0 ds-reg [] MOV
@ -244,31 +318,31 @@ big-endian off
ds-reg [] temp0 MOV
ds-reg -1 bootstrap-cells [+] temp1 MOV
ds-reg -2 bootstrap-cells [+] temp3 MOV
] f f f \ 3dup define-sub-primitive
] \ 3dup define-sub-primitive
[
temp0 ds-reg [] MOV
ds-reg bootstrap-cell SUB
ds-reg [] temp0 MOV
] f f f \ nip define-sub-primitive
] \ nip define-sub-primitive
[
temp0 ds-reg [] MOV
ds-reg 2 bootstrap-cells SUB
ds-reg [] temp0 MOV
] f f f \ 2nip define-sub-primitive
] \ 2nip define-sub-primitive
[
temp0 ds-reg -1 bootstrap-cells [+] MOV
ds-reg bootstrap-cell ADD
ds-reg [] temp0 MOV
] f f f \ over define-sub-primitive
] \ over define-sub-primitive
[
temp0 ds-reg -2 bootstrap-cells [+] MOV
ds-reg bootstrap-cell ADD
ds-reg [] temp0 MOV
] f f f \ pick define-sub-primitive
] \ pick define-sub-primitive
[
temp0 ds-reg [] MOV
@ -276,7 +350,7 @@ big-endian off
ds-reg [] temp1 MOV
ds-reg bootstrap-cell ADD
ds-reg [] temp0 MOV
] f f f \ dupd define-sub-primitive
] \ dupd define-sub-primitive
[
temp0 ds-reg [] MOV
@ -285,21 +359,21 @@ big-endian off
ds-reg [] temp0 MOV
ds-reg -1 bootstrap-cells [+] temp1 MOV
ds-reg -2 bootstrap-cells [+] temp0 MOV
] f f f \ tuck define-sub-primitive
] \ tuck define-sub-primitive
[
temp0 ds-reg [] MOV
temp1 ds-reg bootstrap-cell neg [+] MOV
ds-reg bootstrap-cell neg [+] temp0 MOV
ds-reg [] temp1 MOV
] f f f \ swap define-sub-primitive
] \ swap define-sub-primitive
[
temp0 ds-reg -1 bootstrap-cells [+] MOV
temp1 ds-reg -2 bootstrap-cells [+] MOV
ds-reg -2 bootstrap-cells [+] temp0 MOV
ds-reg -1 bootstrap-cells [+] temp1 MOV
] f f f \ swapd define-sub-primitive
] \ swapd define-sub-primitive
[
temp0 ds-reg [] MOV
@ -308,7 +382,7 @@ big-endian off
ds-reg -2 bootstrap-cells [+] temp1 MOV
ds-reg -1 bootstrap-cells [+] temp0 MOV
ds-reg [] temp3 MOV
] f f f \ rot define-sub-primitive
] \ rot define-sub-primitive
[
temp0 ds-reg [] MOV
@ -317,14 +391,14 @@ big-endian off
ds-reg -2 bootstrap-cells [+] temp0 MOV
ds-reg -1 bootstrap-cells [+] temp3 MOV
ds-reg [] temp1 MOV
] f f f \ -rot define-sub-primitive
] \ -rot define-sub-primitive
[ jit->r ] f f f \ load-local define-sub-primitive
[ jit->r ] \ load-local define-sub-primitive
! Comparisons
: jit-compare ( insn -- )
! load t
temp3 0 MOV
temp3 0 MOV rc-absolute-cell rt-immediate jit-rel
! load f
temp1 \ f tag-number MOV
! load first value
@ -339,8 +413,7 @@ big-endian off
ds-reg [] temp1 MOV ;
: define-jit-compare ( insn word -- )
[ [ jit-compare ] curry rc-absolute-cell rt-immediate 1 rex-length + ] dip
define-sub-primitive ;
[ [ jit-compare ] curry ] dip define-sub-primitive ;
\ CMOVE \ eq? define-jit-compare
\ CMOVGE \ fixnum>= define-jit-compare
@ -357,9 +430,9 @@ big-endian off
! compute result
[ ds-reg [] temp0 ] dip execute( dst src -- ) ;
[ \ ADD jit-math ] f f f \ fixnum+fast define-sub-primitive
[ \ ADD jit-math ] \ fixnum+fast define-sub-primitive
[ \ SUB jit-math ] f f f \ fixnum-fast define-sub-primitive
[ \ SUB jit-math ] \ fixnum-fast define-sub-primitive
[
! load second input
@ -374,20 +447,20 @@ big-endian off
temp0 temp1 IMUL2
! push result
ds-reg [] temp1 MOV
] f f f \ fixnum*fast define-sub-primitive
] \ fixnum*fast define-sub-primitive
[ \ AND jit-math ] f f f \ fixnum-bitand define-sub-primitive
[ \ AND jit-math ] \ fixnum-bitand define-sub-primitive
[ \ OR jit-math ] f f f \ fixnum-bitor define-sub-primitive
[ \ OR jit-math ] \ fixnum-bitor define-sub-primitive
[ \ XOR jit-math ] f f f \ fixnum-bitxor define-sub-primitive
[ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive
[
! complement
ds-reg [] NOT
! clear tag bits
ds-reg [] tag-mask get XOR
] f f f \ fixnum-bitnot define-sub-primitive
] \ fixnum-bitnot define-sub-primitive
[
! load shift count
@ -411,7 +484,7 @@ big-endian off
temp1 temp3 CMOVGE
! push to stack
ds-reg [] temp1 MOV
] f f f \ fixnum-shift-fast define-sub-primitive
] \ fixnum-shift-fast define-sub-primitive
: jit-fixnum-/mod ( -- )
! load second parameter
@ -431,7 +504,7 @@ big-endian off
ds-reg bootstrap-cell SUB
! push to stack
ds-reg [] mod-arg MOV
] f f f \ fixnum-mod define-sub-primitive
] \ fixnum-mod define-sub-primitive
[
jit-fixnum-/mod
@ -441,7 +514,7 @@ big-endian off
div-arg tag-bits get SHL
! push to stack
ds-reg [] div-arg MOV
] f f f \ fixnum/i-fast define-sub-primitive
] \ fixnum/i-fast define-sub-primitive
[
jit-fixnum-/mod
@ -450,7 +523,7 @@ big-endian off
! push to stack
ds-reg [] mod-arg MOV
ds-reg bootstrap-cell neg [+] div-arg MOV
] f f f \ fixnum/mod-fast define-sub-primitive
] \ fixnum/mod-fast define-sub-primitive
[
temp0 ds-reg [] MOV
@ -461,7 +534,7 @@ big-endian off
temp1 1 tag-fixnum MOV
temp0 temp1 CMOVE
ds-reg [] temp0 MOV
] f f f \ both-fixnums? define-sub-primitive
] \ both-fixnums? define-sub-primitive
[
! load local number
@ -472,7 +545,7 @@ big-endian off
temp0 rs-reg temp0 [+] MOV
! push to stack
ds-reg [] temp0 MOV
] f f f \ get-local define-sub-primitive
] \ get-local define-sub-primitive
[
! load local count
@ -483,6 +556,6 @@ big-endian off
fixnum>slot@
! decrement retain stack pointer
rs-reg temp0 SUB
] f f f \ drop-locals define-sub-primitive
] \ drop-locals define-sub-primitive
[ "bootstrap.x86" forget-vocab ] with-compilation-unit

2
basis/debugger/debugger-docs.factor
View File

@ -1,6 +1,6 @@
USING: alien arrays generic generic.math help.markup help.syntax
kernel math memory strings sbufs vectors io io.files classes
help generic.standard continuations io.files.private listener
help generic.single continuations io.files.private listener
alien.libraries ;
IN: debugger

2
basis/debugger/debugger.factor
View File

@ -6,7 +6,7 @@ sequences assocs sequences.private strings io.styles
io.pathnames vectors words system splitting math.parser
classes.mixin classes.tuple continuations continuations.private
combinators generic.math classes.builtin classes compiler.units
generic.standard vocabs init kernel.private io.encodings
generic.standard generic.single vocabs init kernel.private io.encodings
accessors math.order destructors source-files parser
classes.tuple.parser effects.parser lexer
generic.parser strings.parser vocabs.loader vocabs.parser see

18
basis/hints/hints.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: parser words definitions kernel sequences assocs arrays
kernel.private fry combinators accessors vectors strings sbufs
byte-arrays byte-vectors io.binary io.streams.string splitting math
math.parser generic generic.standard generic.standard.engines classes
math.parser generic generic.single generic.standard classes
hashtables namespaces ;
IN: hints
@ -42,13 +42,13 @@ SYMBOL: specialize-method?
t specialize-method? set-global
: method-declaration ( method -- quot )
[ "method-generic" word-prop dispatch# object <array> ]
[ "method-class" word-prop ]
bi prefix [ declare ] curry [ ] like ;
: specialize-method ( quot method -- quot' )
[
specialize-method? get [
[ "method-class" word-prop ] [ "method-generic" word-prop ] bi
method-declaration prepend
] [ drop ] if
]
[ specialize-method? get [ method-declaration prepend ] [ drop ] if ]
[ "method-generic" word-prop "specializer" word-prop ] bi
[ specialize-quot ] when* ;
@ -71,7 +71,7 @@ t specialize-method? set-global
SYNTAX: HINTS:
scan-object
[ changed-definition ]
[ parse-definition "specializer" set-word-prop ] bi ;
[ parse-definition { } like "specializer" set-word-prop ] bi ;
! Default specializers
{ first first2 first3 first4 }

4
basis/io/backend/windows/nt/nt.factor
View File

@ -46,7 +46,7 @@ M: winnt add-completion ( win32-handle -- )
{ [ dup integer? ] [ ] }
{ [ dup array? ] [
first dup eof?
[ drop 0 ] [ (win32-error-string) throw ] if
[ drop 0 ] [ n>win32-error-string throw ] if
] }
} cond
] with-timeout ;
@ -105,7 +105,7 @@ M: winnt seek-handle ( n seek-type handle -- )
GetLastError {
{ [ dup expected-io-error? ] [ drop f ] }
{ [ dup eof? ] [ drop t ] }
[ (win32-error-string) throw ]
[ n>win32-error-string throw ]
} cond
] [ f ] if ;

2
basis/io/backend/windows/nt/privileges/privileges.factor
View File

@ -2,7 +2,7 @@ USING: alien alien.c-types alien.syntax arrays continuations
destructors generic io.mmap io.ports io.backend.windows io.files.windows
kernel libc math math.bitwise namespaces quotations sequences windows
windows.advapi32 windows.kernel32 io.backend system accessors
io.backend.windows.privileges ;
io.backend.windows.privileges windows.errors ;
IN: io.backend.windows.nt.privileges
TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES

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

@ -1,10 +1,10 @@
! Copyright (C) 2004, 2008 Mackenzie Straight, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays destructors io io.backend
io.buffers io.files io.ports io.binary io.timeouts
windows.errors strings kernel math namespaces sequences windows
windows.kernel32 windows.shell32 windows.types windows.winsock
splitting continuations math.bitwise system accessors ;
io.buffers io.files io.ports io.binary io.timeouts system
windows.errors strings kernel math namespaces sequences
windows.errors windows.kernel32 windows.shell32 windows.types
windows.winsock splitting continuations math.bitwise accessors ;
IN: io.backend.windows
: set-inherit ( handle ? -- )
@ -51,4 +51,4 @@ HOOK: add-completion io-backend ( port -- )
: default-security-attributes ( -- obj )
"SECURITY_ATTRIBUTES" <c-object>
"SECURITY_ATTRIBUTES" heap-size
over set-SECURITY_ATTRIBUTES-nLength ;
over set-SECURITY_ATTRIBUTES-nLength ;

4
basis/io/files/links/links-docs.factor
View File

@ -5,6 +5,10 @@ HELP: make-link
{ $values { "target" "a path to the symbolic link's target" } { "symlink" "a path to new symbolic link" } }
{ $description "Creates a symbolic link." } ;
HELP: make-hard-link
{ $values { "target" "a path to the hard link's target" } { "link" "a path to new symbolic link" } }
{ $description "Creates a hard link." } ;
HELP: read-link
{ $values { "symlink" "a path to an existing symbolic link" } { "path" "the path pointed to by the symbolic link" } }
{ $description "Reads the symbolic link and returns its target path." } ;

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

@ -6,6 +6,8 @@ IN: io.files.links
HOOK: make-link os ( target symlink -- )
HOOK: make-hard-link os ( target link -- )
HOOK: read-link os ( symlink -- path )
: copy-link ( target symlink -- )

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

@ -7,6 +7,9 @@ IN: io.files.links.unix
M: unix make-link ( path1 path2 -- )
normalize-path symlink io-error ;
M: unix make-hard-link ( path1 path2 -- )
normalize-path link io-error ;
M: unix read-link ( path -- path' )
normalize-path read-symbolic-link ;

3
basis/io/files/windows/nt/nt.factor
View File

@ -4,7 +4,8 @@ io.backend.windows io.files.windows io.encodings.utf16n windows
windows.kernel32 kernel libc math threads system environment
alien.c-types alien.arrays alien.strings sequences combinators
combinators.short-circuit ascii splitting alien strings assocs
namespaces make accessors tr windows.time windows.shell32 ;
namespaces make accessors tr windows.time windows.shell32
windows.errors ;
IN: io.files.windows.nt
M: winnt cwd

6
basis/io/mmap/windows/windows.factor
View File

@ -2,7 +2,7 @@ USING: alien alien.c-types arrays destructors generic io.mmap
io.ports io.backend.windows io.files.windows io.backend.windows.privileges
kernel libc math math.bitwise namespaces quotations sequences
windows windows.advapi32 windows.kernel32 io.backend system
accessors locals ;
accessors locals windows.errors ;
IN: io.mmap.windows
: create-file-mapping ( hFile lpAttributes flProtect dwMaximumSizeHigh dwMaximumSizeLow lpName -- HANDLE )
@ -12,8 +12,8 @@ IN: io.mmap.windows
MapViewOfFile [ win32-error=0/f ] keep ;
:: mmap-open ( path length access-mode create-mode protect access -- handle handle address )
[let | lo [ length HEX: ffffffff bitand ]
hi [ length -32 shift HEX: ffffffff bitand ] |
[let | lo [ length 32 bits ]
hi [ length -32 shift 32 bits ] |
{ "SeCreateGlobalPrivilege" "SeLockMemoryPrivilege" } [
path access-mode create-mode 0 open-file |dispose
dup handle>> f protect hi lo f create-file-mapping |dispose

2
basis/io/monitors/windows/nt/nt.factor
View File

@ -6,7 +6,7 @@ hashtables sorting arrays combinators math.bitwise strings
system accessors threads splitting io.backend io.backend.windows
io.backend.windows.nt io.files.windows.nt io.monitors io.ports
io.buffers io.files io.timeouts io.encodings.string
io.encodings.utf16n io windows windows.kernel32 windows.types
io.encodings.utf16n io windows.errors windows.kernel32 windows.types
io.pathnames ;
IN: io.monitors.windows.nt

6
basis/io/styles/styles.factor
View File

@ -99,7 +99,11 @@ M: plain-writer make-block-stream
nip <ignore-close-stream> ;
M: plain-writer stream-write-table
[ drop format-table [ nl ] [ write ] interleave ] with-output-stream* ;
[
drop
[ [ >string ] map ] map format-table
[ nl ] [ write ] interleave
] with-output-stream* ;
M: plain-writer make-cell-stream 2drop <string-writer> ;

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

@ -585,4 +585,4 @@ M: integer ed's-bug neg ;
:: ed's-test-case ( a -- b )
{ [ a ed's-bug ] } && ;
[ t ] [ \ ed's-test-case optimized>> ] unit-test
[ t ] [ \ ed's-test-case optimized? ] unit-test

4
basis/math/complex/complex-docs.factor
View File

@ -25,7 +25,3 @@ HELP: complex
{ $class-description "The class of complex numbers with non-zero imaginary part." } ;
ABOUT: "complex-numbers"
HELP: <complex> ( x y -- z )
{ $values { "x" "a real number" } { "y" "a real number" } { "z" "a complex number" } }
{ $description "Low-level complex number constructor. User code should call " { $link rect> } " instead." } ;

6
basis/math/complex/complex.factor
View File

@ -15,14 +15,14 @@ M: complex hashcode* nip >rect [ hashcode ] bi@ bitxor ;
: complex= ( x y quot -- ? ) componentwise and ; inline
M: complex equal? over complex? [ [ = ] complex= ] [ 2drop f ] if ;
M: complex number= [ number= ] complex= ;
: complex-op ( x y quot -- z ) componentwise (rect>) ; inline
: complex-op ( x y quot -- z ) componentwise rect> ; inline
M: complex + [ + ] complex-op ;
M: complex - [ - ] complex-op ;
: *re ( x y -- xr*yr xi*yi ) [ >rect ] bi@ [ * ] bi-curry@ bi* ; inline
: *im ( x y -- xi*yr xr*yi ) swap [ >rect ] bi@ swap [ * ] bi-curry@ bi* ; inline
M: complex * [ *re - ] [ *im + ] 2bi (rect>) ;
M: complex * [ *re - ] [ *im + ] 2bi rect> ;
: (complex/) ( x y -- r i m ) [ [ *re + ] [ *im - ] 2bi ] keep absq ; inline
: complex/ ( x y quot -- z ) [ (complex/) ] dip curry bi@ (rect>) ; inline
: complex/ ( x y quot -- z ) [ (complex/) ] dip curry bi@ rect> ; inline
M: complex / [ / ] complex/ ;
M: complex /f [ /f ] complex/ ;
M: complex /i [ /i ] complex/ ;

5
basis/math/functions/functions-docs.factor
View File

@ -100,11 +100,6 @@ ARTICLE: "math-functions" "Mathematical functions"
ABOUT: "math-functions"
HELP: (rect>)
{ $values { "x" real } { "y" real } { "z" number } }
{ $description "Creates a complex number from real and imaginary components." }
{ $warning "This word does not check that the arguments are real numbers, which can have undefined consequences. Use the " { $link rect> } " word instead." } ;
HELP: rect>
{ $values { "x" real } { "y" real } { "z" number } }
{ $description "Creates a complex number from real and imaginary components. If " { $snippet "z" } " is an integer zero, this will simply output " { $snippet "x" } "." } ;

13
basis/math/functions/functions.factor
View File

@ -7,19 +7,8 @@ IN: math.functions
: >fraction ( a/b -- a b )
[ numerator ] [ denominator ] bi ; inline
<PRIVATE
: (rect>) ( x y -- z )
dup 0 = [ drop ] [ <complex> ] if ; inline
PRIVATE>
: rect> ( x y -- z )
2dup [ real? ] both? [
(rect>)
] [
"Complex number must have real components" throw
] if ; inline
dup 0 = [ drop ] [ complex boa ] if ; inline
GENERIC: sqrt ( x -- y ) foldable

3
basis/math/ratios/ratios-docs.factor
View File

@ -47,6 +47,3 @@ HELP: 2>fraction
{ $values { "a/b" rational } { "c/d" rational } { "a" integer } { "c" integer } { "b" "a positive integer" } { "d" "a positive integer" } }
{ $description "Extracts the numerator and denominator of two rational numbers at once." } ;
HELP: <ratio> ( a b -- a/b )
{ $values { "a" integer } { "b" integer } { "a/b" "a ratio" } }
{ $description "Primitive ratio constructor. User code should call " { $link / } " to create ratios instead." } ;

2
basis/math/ratios/ratios.factor
View File

@ -9,7 +9,7 @@ IN: math.ratios
<PRIVATE
: fraction> ( a b -- a/b )
dup 1 number= [ drop ] [ <ratio> ] if ; inline
dup 1 number= [ drop ] [ ratio boa ] if ; inline
: scale ( a/b c/d -- a*d b*c )
2>fraction [ * swap ] dip * swap ; inline

4
basis/random/windows/windows.factor
View File

@ -1,6 +1,6 @@
USING: accessors alien.c-types byte-arrays continuations
kernel windows windows.advapi32 init namespaces random
destructors locals ;
kernel windows.advapi32 init namespaces random destructors
locals windows.errors ;
IN: random.windows
TUPLE: windows-rng provider type ;

10
basis/see/see.factor
View File

@ -1,13 +1,13 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes classes.builtin
classes.intersection classes.mixin classes.predicate
classes.singleton classes.tuple classes.union combinators
definitions effects generic generic.standard io io.pathnames
classes.intersection classes.mixin classes.predicate classes.singleton
classes.tuple classes.union combinators definitions effects generic
generic.single generic.standard generic.hook io io.pathnames
io.streams.string io.styles kernel make namespaces prettyprint
prettyprint.backend prettyprint.config prettyprint.custom
prettyprint.sections sequences sets sorting strings summary
words words.symbol words.constant words.alias ;
prettyprint.sections sequences sets sorting strings summary words
words.symbol words.constant words.alias ;
IN: see
GENERIC: synopsis* ( defspec -- )

9
basis/stack-checker/backend/backend.factor
View File

@ -1,10 +1,9 @@
! Copyright (C) 2004, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: fry arrays generic io io.streams.string kernel math
namespaces parser sequences strings vectors words quotations
effects classes continuations assocs combinators
compiler.errors accessors math.order definitions sets
generic.standard.engines.tuple hints macros stack-checker.state
USING: fry arrays generic io io.streams.string kernel math namespaces
parser sequences strings vectors words quotations effects classes
continuations assocs combinators compiler.errors accessors math.order
definitions sets hints macros stack-checker.state
stack-checker.visitor stack-checker.errors stack-checker.values
stack-checker.recursive-state ;
IN: stack-checker.backend

13
basis/stack-checker/call-effect/call-effect-tests.factor
View File

@ -1,7 +1,16 @@
USING: stack-checker.call-effect tools.test math kernel ;
USING: stack-checker.call-effect tools.test math kernel math effects ;
IN: stack-checker.call-effect.tests
[ t ] [ \ + (( a b -- c )) execute-effect-unsafe? ] unit-test
[ t ] [ \ + (( a b c -- d e )) execute-effect-unsafe? ] unit-test
[ f ] [ \ + (( a b c -- d )) execute-effect-unsafe? ] unit-test
[ f ] [ \ call (( x -- )) execute-effect-unsafe? ] unit-test
[ f ] [ \ call (( x -- )) execute-effect-unsafe? ] unit-test
[ t ] [ [ + ] cached-effect (( a b -- c )) effect= ] unit-test
[ t ] [ 5 [ + ] curry cached-effect (( a -- c )) effect= ] unit-test
[ t ] [ 5 [ ] curry cached-effect (( -- c )) effect= ] unit-test
[ t ] [ [ dup ] [ drop ] compose cached-effect (( a -- b )) effect= ] unit-test
[ t ] [ [ drop ] [ dup ] compose cached-effect (( a b -- c d )) effect= ] unit-test
[ t ] [ [ 2drop ] [ dup ] compose cached-effect (( a b c -- d e )) effect= ] unit-test
[ t ] [ [ 1 2 3 ] [ 2drop ] compose cached-effect (( -- a )) effect= ] unit-test
[ t ] [ [ 1 2 ] [ 3drop ] compose cached-effect (( a -- )) effect= ] unit-test

30
basis/stack-checker/call-effect/call-effect.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators combinators.private effects fry
kernel kernel.private make sequences continuations quotations
stack-checker stack-checker.transforms words ;
stack-checker stack-checker.transforms words math ;
IN: stack-checker.call-effect
! call( and execute( have complex expansions.
@ -18,14 +18,36 @@ IN: stack-checker.call-effect
TUPLE: inline-cache value ;
: cache-hit? ( word/quot ic -- ? ) value>> eq? ; inline
: cache-hit? ( word/quot ic -- ? )
[ value>> ] [ value>> eq? ] bi and ; inline
SYMBOL: +unknown+
SINGLETON: +unknown+
GENERIC: cached-effect ( quot -- effect )
M: object cached-effect drop +unknown+ ;
GENERIC: curry-effect ( effect -- effect' )
M: +unknown+ curry-effect ;
M: effect curry-effect
[ in>> length ] [ out>> length ] [ terminated?>> ] tri
pick 0 = [ [ 1+ ] dip ] [ [ 1- ] 2dip ] if
effect boa ;
M: curry cached-effect
quot>> cached-effect curry-effect ;
: compose-effects* ( effect1 effect2 -- effect' )
{
{ [ 2dup [ effect? ] both? ] [ compose-effects ] }
{ [ 2dup [ +unknown+ eq? ] either? ] [ 2drop +unknown+ ] }
} cond ;
M: compose cached-effect
[ first>> ] [ second>> ] bi [ cached-effect ] bi@ compose-effects* ;
M: quotation cached-effect
dup cached-effect>>
[ ] [
@ -79,7 +101,7 @@ M: quotation cached-effect
[ '[ _ execute ] ] dip call-effect-slow ; inline
: execute-effect-unsafe? ( word effect -- ? )
over optimized>> [ [ stack-effect ] dip effect<= ] [ 2drop f ] if ; inline
over optimized? [ [ stack-effect ] dip effect<= ] [ 2drop f ] if ; inline
: execute-effect-fast ( word effect inline-cache -- )
2over execute-effect-unsafe?

2
basis/stack-checker/errors/errors.factor
View File

@ -33,4 +33,6 @@ ERROR: unknown-primitive-error < inference-error ;
ERROR: transform-expansion-error < inference-error word error ;
ERROR: bad-declaration-error < inference-error declaration ;
M: object (literal) "literal value" literal-expected ;

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

@ -9,9 +9,10 @@ quotations quotations.private sbufs sbufs.private
sequences sequences.private slots.private strings
strings.private system threads.private classes.tuple
classes.tuple.private vectors vectors.private words definitions
words.private assocs summary compiler.units system.private
combinators locals locals.backend locals.types words.private
assocs summary compiler.units system.private
combinators combinators.short-circuit locals locals.backend locals.types
quotations.private combinators.private stack-checker.values
generic.single generic.single.private
alien.libraries
stack-checker.alien
stack-checker.state
@ -57,8 +58,12 @@ IN: stack-checker.known-words
: infer-shuffle-word ( word -- )
"shuffle" word-prop infer-shuffle ;
: check-declaration ( declaration -- declaration )
dup { [ array? ] [ [ class? ] all? ] } 1&&
[ bad-declaration-error ] unless ;
: infer-declare ( -- )
pop-literal nip
pop-literal nip check-declaration
[ length ensure-d ] keep zip
#declare, ;
@ -142,7 +147,7 @@ M: object infer-call*
apply-word/effect ;
: infer-execute-effect-unsafe ( -- )
\ execute infer-effect-unsafe ;
\ (execute) infer-effect-unsafe ;
: infer-call-effect-unsafe ( -- )
\ call infer-effect-unsafe ;
@ -227,14 +232,7 @@ M: object infer-call*
! More words not to compile
\ call t "no-compile" set-word-prop
\ call subwords [ t "no-compile" set-word-prop ] each
\ execute t "no-compile" set-word-prop
\ execute subwords [ t "no-compile" set-word-prop ] each
\ effective-method t "no-compile" set-word-prop
\ effective-method subwords [ t "no-compile" set-word-prop ] each
\ clear t "no-compile" set-word-prop
: non-inline-word ( word -- )
@ -292,9 +290,6 @@ M: object infer-call*
\ bignum>float { bignum } { float } define-primitive
\ bignum>float make-foldable
\ <ratio> { integer integer } { ratio } define-primitive
\ <ratio> make-foldable
\ string>float { string } { float } define-primitive
\ string>float make-foldable
@ -313,9 +308,6 @@ M: object infer-call*
\ bits>double { integer } { float } define-primitive
\ bits>double make-foldable
\ <complex> { real real } { complex } define-primitive
\ <complex> make-foldable
\ both-fixnums? { object object } { object } define-primitive
\ fixnum+ { fixnum fixnum } { integer } define-primitive
@ -676,3 +668,12 @@ M: object infer-call*
\ gc-stats { } { array } define-primitive
\ jit-compile { quotation } { } define-primitive
\ lookup-method { object array } { word } define-primitive
\ reset-dispatch-stats { } { } define-primitive
\ dispatch-stats { } { array } define-primitive
\ reset-inline-cache-stats { } { } define-primitive
\ inline-cache-stats { } { array } define-primitive
\ optimized? { word } { object } define-primitive

1
basis/stack-checker/stack-checker-docs.factor
View File

@ -102,6 +102,7 @@ ARTICLE: "tools.inference" "Stack effect tools"
"Comparing effects:"
{ $subsection effect-height }
{ $subsection effect<= }
{ $subsection effect= }
"The class of stack effects:"
{ $subsection effect }
{ $subsection effect? } ;

1
basis/stack-checker/transforms/transforms.factor
View File

@ -108,7 +108,6 @@ IN: stack-checker.transforms
] 1 define-transform
\ boa t "no-compile" set-word-prop
M\ tuple-class boa t "no-compile" set-word-prop
\ new [
dup tuple-class? [

4
basis/strings/tables/tables-tests.factor
View File

@ -2,3 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test strings.tables ;
IN: strings.tables.tests
[ { "A BB" "CC D" } ] [ { { "A" "BB" } { "CC" "D" } } format-table ] unit-test
[ { "A C" "B " "D E" } ] [ { { "A\nB" "C" } { "D" "E" } } format-table ] unit-test

27
basis/strings/tables/tables.factor
View File

@ -1,21 +1,30 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences fry math.order ;
USING: kernel sequences fry math.order splitting ;
IN: strings.tables
<PRIVATE
: format-column ( seq ? -- seq )
[
dup [ length ] [ max ] map-reduce
'[ _ CHAR: \s pad-tail ] map
] unless ;
: map-last ( seq quot -- seq )
[ dup length <reversed> ] dip '[ 0 = @ ] 2map ; inline
: max-length ( seq -- n )
[ length ] [ max ] map-reduce ;
: format-row ( seq ? -- seq )
[
dup max-length
'[ _ "" pad-tail ] map
] unless ;
: format-column ( seq ? -- seq )
[
dup max-length
'[ _ CHAR: \s pad-tail ] map
] unless ;
PRIVATE>
: format-table ( table -- seq )
flip [ format-column ] map-last
flip [ " " join ] map ;
[ [ [ string-lines ] map ] dip format-row flip ] map-last concat
flip [ format-column ] map-last flip [ " " join ] map ;

5
basis/tools/continuations/continuations.factor
View File

@ -4,7 +4,7 @@ USING: threads kernel namespaces continuations combinators
sequences math namespaces.private continuations.private
concurrency.messaging quotations kernel.private words
sequences.private assocs models models.arrow arrays accessors
generic generic.standard definitions make sbufs tools.crossref ;
generic generic.single definitions make sbufs tools.crossref ;
IN: tools.continuations
<PRIVATE
@ -53,8 +53,7 @@ M: object add-breakpoint ;
: (step-into-execute) ( word -- )
{
{ [ dup "step-into" word-prop ] [ "step-into" word-prop call ] }
{ [ dup standard-generic? ] [ effective-method (step-into-execute) ] }
{ [ dup hook-generic? ] [ effective-method (step-into-execute) ] }
{ [ dup single-generic? ] [ effective-method (step-into-execute) ] }
{ [ dup uses \ suspend swap member? ] [ execute break ] }
{ [ dup primitive? ] [ execute break ] }
[ def>> (step-into-quot) ]

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

@ -3,8 +3,7 @@
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.standard.engines.tuple threads
compiler.units init ;
graphs vocabs generic generic.single threads compiler.units init ;
IN: tools.crossref
SYMBOL: crossref
@ -82,7 +81,7 @@ M: object irrelevant? drop f ;
M: default-method irrelevant? drop t ;
M: engine-word irrelevant? drop t ;
M: predicate-engine irrelevant? drop t ;
PRIVATE>

11
basis/tools/deploy/backend/backend.factor
View File

@ -3,12 +3,11 @@
USING: namespaces make continuations.private kernel.private init
assocs kernel vocabs words sequences memory io system arrays
continuations math definitions mirrors splitting parser classes
summary layouts vocabs.loader prettyprint.config prettyprint
debugger io.streams.c io.files io.files.temp io.pathnames
io.directories io.directories.hierarchy io.backend quotations
io.launcher words.private tools.deploy.config
tools.deploy.config.editor bootstrap.image io.encodings.utf8
destructors accessors hashtables ;
summary layouts vocabs.loader prettyprint.config prettyprint debugger
io.streams.c io.files io.files.temp io.pathnames io.directories
io.directories.hierarchy io.backend quotations io.launcher
tools.deploy.config tools.deploy.config.editor bootstrap.image
io.encodings.utf8 destructors accessors hashtables ;
IN: tools.deploy.backend
: copy-vm ( executable bundle-name -- vm )

13
basis/tools/deploy/shaker/shaker.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors io.backend io.streams.c init fry
namespaces make assocs kernel parser lexer strings.parser vocabs
sequences words words.private memory kernel.private
sequences words memory kernel.private
continuations io vocabs.loader system strings sets
vectors quotations byte-arrays sorting compiler.units
definitions generic generic.standard tools.deploy.config ;
@ -103,6 +103,7 @@ IN: tools.deploy.shaker
"compiled-uses"
"constraints"
"custom-inlining"
"decision-tree"
"declared-effect"
"default"
"default-method"
@ -112,14 +113,12 @@ IN: tools.deploy.shaker
"engines"
"forgotten"
"identities"
"if-intrinsics"
"infer"
"inline"
"inlined-block"
"input-classes"
"instances"
"interval"
"intrinsics"
"intrinsic"
"lambda"
"loc"
"local-reader"
@ -136,7 +135,7 @@ IN: tools.deploy.shaker
"method-generic"
"modular-arithmetic"
"no-compile"
"optimizer-hooks"
"owner-generic"
"outputs"
"participants"
"predicate"
@ -149,17 +148,13 @@ IN: tools.deploy.shaker
"register"
"register-size"
"shuffle"
"slot-names"
"slots"
"special"
"specializer"
"step-into"
"step-into?"
! UI needs this
! "superclass"
"transform-n"
"transform-quot"
"tuple-dispatch-generic"
"type"
"writer"
"writing"

28
basis/tools/scaffold/scaffold.factor
View File

@ -6,7 +6,7 @@ vocabs.loader io combinators calendar accessors math.parser
io.streams.string ui.tools.operations quotations strings arrays
prettyprint words vocabs sorting sets classes math alien urls
splitting ascii combinators.short-circuit alarms words.symbol
system ;
system summary ;
IN: tools.scaffold
SYMBOL: developer-name
@ -16,6 +16,10 @@ ERROR: not-a-vocab-root string ;
ERROR: vocab-name-contains-separator path ;
ERROR: vocab-name-contains-dot path ;
ERROR: no-vocab vocab ;
ERROR: bad-developer-name name ;
M: bad-developer-name summary
drop "Developer name must be a string." ;
<PRIVATE
@ -101,10 +105,14 @@ ERROR: no-vocab vocab ;
] if ;
: scaffold-authors ( vocab-root vocab -- )
"authors.txt" vocab-root/vocab/file>path scaffolding? [
[ developer-name get ] dip utf8 set-file-contents
developer-name get [
"authors.txt" vocab-root/vocab/file>path scaffolding? [
developer-name get swap utf8 set-file-contents
] [
drop
] if
] [
drop
2drop
] if ;
: lookup-type ( string -- object/string ? )
@ -298,9 +306,12 @@ SYMBOL: examples-flag
"}" print
] with-variable ;
: touch. ( path -- )
[ touch-file ]
[ "Click to edit: " write <pathname> . ] bi ;
: scaffold-rc ( path -- )
[ home ] dip append-path
[ touch-file ] [ "Click to edit: " write <pathname> . ] bi ;
[ home ] dip append-path touch. ;
: scaffold-factor-boot-rc ( -- )
os windows? "factor-boot-rc" ".factor-boot-rc" ? scaffold-rc ;
@ -308,4 +319,7 @@ SYMBOL: examples-flag
: scaffold-factor-rc ( -- )
os windows? "factor-rc" ".factor-rc" ? scaffold-rc ;
: scaffold-emacs ( -- ) ".emacs" scaffold-rc ;
HOOK: scaffold-emacs os ( -- )
M: unix scaffold-emacs ( -- ) ".emacs" scaffold-rc ;

1
basis/tools/scaffold/windows/authors.txt Executable file
View File

@ -0,0 +1 @@
Doug Coleman

1
basis/tools/scaffold/windows/tags.txt Normal file
View File

@ -0,0 +1 @@
unportable

7
basis/tools/scaffold/windows/windows.factor Executable file
View File

@ -0,0 +1,7 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: io.pathnames system tools.scaffold windows.shell32 ;
IN: tools.scaffold.windows
M: windows scaffold-emacs ( -- )
application-data ".emacs" append-path touch. ;

55
basis/tools/time/time.factor
View File

@ -1,24 +1,27 @@
! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.vectors memory io io.styles prettyprint
namespaces system sequences splitting grouping assocs strings ;
namespaces system sequences splitting grouping assocs strings
generic.single combinators ;
IN: tools.time
: benchmark ( quot -- runtime )
micros [ call micros ] dip - ; inline
: time. ( data -- )
unclip
"==== RUNNING TIME" print nl 1000000 /f pprint " seconds" print nl
: time. ( time -- )
"== Running time ==" print nl 1000000 /f pprint " seconds" print ;
: gc-stats. ( stats -- )
5 cut*
"==== GARBAGE COLLECTION" print nl
"== Garbage collection ==" print nl
"Times are in microseconds." print nl
[
6 group
{
"GC count:"
"Cumulative GC time (us):"
"Longest GC pause (us):"
"Average GC pause (us):"
"Total GC time:"
"Longest GC pause:"
"Average GC pause:"
"Objects copied:"
"Bytes copied:"
} prefix
@ -29,13 +32,43 @@ IN: tools.time
[
nl
{
"Total GC time (us):"
"Total GC time:"
"Cards scanned:"
"Decks scanned:"
"Card scan time (us):"
"Card scan time:"
"Code heap literal scans:"
} swap zip simple-table.
] bi* ;
: dispatch-stats. ( stats -- )
"== Megamorphic caches ==" print nl
{ "Hits" "Misses" } swap zip simple-table. ;
: inline-cache-stats. ( stats -- )
nl "== Polymorphic inline caches ==" print nl
3 cut
[
"Transitions:" print
{ "Cold to monomorphic" "Mono to polymorphic" "Poly to megamorphic" } swap zip
simple-table. nl
] [
"Type check stubs:" print
{ "Tag only" "Hi-tag" "Tuple" "Hi-tag and tuple" } swap zip
simple-table.
] bi* ;
: time ( quot -- )
gc-reset micros [ call gc-stats micros ] dip - prefix time. ; inline
gc-reset
reset-dispatch-stats
reset-inline-cache-stats
benchmark gc-stats dispatch-stats inline-cache-stats
H{ { table-gap { 20 20 } } } [
[
[ [ time. ] 3dip ] with-cell
[ ] with-cell
] with-row
[
[ [ gc-stats. ] 2dip ] with-cell
[ [ dispatch-stats. ] [ inline-cache-stats. ] bi* ] with-cell
] with-row
] tabular-output nl ; inline

4
basis/tools/walker/walker-tests.factor
View File

@ -1,7 +1,7 @@
USING: tools.walker io io.streams.string kernel math
math.private namespaces prettyprint sequences tools.test
continuations math.parser threads arrays tools.walker.debug
generic.standard sequences.private kernel.private
generic.single sequences.private kernel.private
tools.continuations accessors words ;
IN: tools.walker.tests
@ -118,7 +118,7 @@ IN: tools.walker.tests
\ breakpoint-test don't-step-into
[ f ] [ \ breakpoint-test optimized>> ] unit-test
[ f ] [ \ breakpoint-test optimized? ] unit-test
[ { 3 } ] [ [ breakpoint-test ] test-walker ] unit-test

58
basis/ui/backend/windows/windows.factor
View File

@ -6,15 +6,19 @@ ui.gadgets ui.gadgets.private ui.backend ui.clipboards
ui.gadgets.worlds ui.gestures ui.event-loop io kernel math
math.vectors namespaces make sequences strings vectors words
windows.kernel32 windows.gdi32 windows.user32 windows.opengl32
windows.messages windows.types windows.offscreen windows.nt windows
windows.messages windows.types windows.offscreen windows.nt
threads libc combinators fry combinators.short-circuit continuations
command-line shuffle opengl ui.render ascii math.bitwise locals
accessors math.rectangles math.order ascii calendar
io.encodings.utf16n ;
io.encodings.utf16n windows.errors ;
IN: ui.backend.windows
SINGLETON: windows-ui-backend
: lo-word ( wparam -- lo ) <short> *short ; inline
: hi-word ( wparam -- hi ) -16 shift lo-word ; inline
: >lo-hi ( WORD -- array ) [ lo-word ] [ hi-word ] bi 2array ;
: crlf>lf ( str -- str' )
CHAR: \r swap remove ;
@ -286,8 +290,6 @@ SYMBOL: nc-buttons
message>button nc-buttons get
swap [ push ] [ delete ] if ;
: >lo-hi ( WORD -- array ) [ lo-word ] [ hi-word ] bi 2array ;
: mouse-wheel ( wParam -- array ) >lo-hi [ sgn neg ] map ;
: mouse-event>gesture ( uMsg -- button )
@ -553,6 +555,54 @@ M: windows-ui-backend (with-ui)
M: windows-ui-backend beep ( -- )
0 MessageBeep drop ;
: fullscreen-RECT ( hwnd -- RECT )
MONITOR_DEFAULTTONEAREST MonitorFromWindow
"MONITORINFOEX" <c-object> dup length over set-MONITORINFOEX-cbSize
[ GetMonitorInfo win32-error=0/f ] keep MONITORINFOEX-rcMonitor ;
: hwnd>RECT ( hwnd -- RECT )
"RECT" <c-object> [ GetWindowRect win32-error=0/f ] keep ;
: fullscreen-flags ( -- n )
{ WS_CAPTION WS_BORDER WS_THICKFRAME } flags ; inline
: enter-fullscreen ( world -- )
handle>> hWnd>>
{
[
GWL_STYLE GetWindowLong
fullscreen-flags unmask
]
[ GWL_STYLE rot SetWindowLong win32-error=0/f ]
[
HWND_TOP
over hwnd>RECT get-RECT-dimensions
SWP_FRAMECHANGED
SetWindowPos win32-error=0/f
]
[ SW_MAXIMIZE ShowWindow win32-error=0/f ]
} cleave ;
: exit-fullscreen ( world -- )
handle>> hWnd>>
{
[
GWL_STYLE GetWindowLong
fullscreen-flags bitor
]
[ GWL_STYLE rot SetWindowLong win32-error=0/f ]
[
f
over hwnd>RECT get-RECT-dimensions
{ SWP_NOMOVE SWP_NOSIZE SWP_NOZORDER SWP_FRAMECHANGED } flags
SetWindowPos win32-error=0/f
]
[ SW_RESTORE ShowWindow win32-error=0/f ]
} cleave ;
M: windows-ui-backend set-fullscreen* ( ? world -- )
swap [ enter-fullscreen ] [ exit-fullscreen ] if ;
windows-ui-backend ui-backend set-global
[ "ui.tools" ] main-vocab-hook set-global

2
basis/ui/tools/error-list/error-list.factor
View File

@ -10,7 +10,7 @@ ui.gadgets.tables ui.gadgets.labeled ui.gadgets.tracks ui.gestures
ui.operations ui.tools.browser ui.tools.common ui.gadgets.scrollers
ui.tools.inspector ui.gadgets.status-bar ui.operations
ui.gadgets.buttons ui.gadgets.borders ui.gadgets.packs
ui.gadgets.labels ui.baseline-alignment ui.images ui.tools.listener
ui.gadgets.labels ui.baseline-alignment ui.images
compiler.errors tools.errors tools.errors.model ;
IN: ui.tools.error-list

11
basis/ui/tools/listener/completion/completion.factor
View File

@ -3,11 +3,10 @@
USING: accessors arrays assocs calendar colors colors.constants
documents documents.elements fry kernel words sets splitting math
math.vectors models.delay models.arrow combinators.short-circuit
parser present sequences tools.completion help.vocabs generic
generic.standard.engines.tuple fonts definitions.icons ui.images
ui.commands ui.operations ui.gadgets ui.gadgets.editors
ui.gadgets.glass ui.gadgets.scrollers ui.gadgets.tables
ui.gadgets.tracks ui.gadgets.labeled
parser present sequences tools.completion help.vocabs generic fonts
definitions.icons ui.images ui.commands ui.operations ui.gadgets
ui.gadgets.editors ui.gadgets.glass ui.gadgets.scrollers
ui.gadgets.tables ui.gadgets.tracks ui.gadgets.labeled
ui.gadgets.worlds ui.gadgets.wrappers ui.gestures ui.pens.solid
ui.tools.listener.history combinators vocabs ui.tools.listener.popups ;
IN: ui.tools.listener.completion
@ -120,8 +119,6 @@ M: object completion-string present ;
M: method-body completion-string method-completion-string ;
M: engine-word completion-string method-completion-string ;
GENERIC# accept-completion-hook 1 ( item popup -- )
: insert-completion ( item popup -- )

1
basis/unix/unix.factor
View File

@ -194,6 +194,7 @@ FUNCTION: int setsockopt ( int s, int level, int optname, void* optval, socklen_
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 ) ;

120
basis/windows/advapi32/advapi32.factor
View File

@ -350,35 +350,46 @@ CONSTANT: TOKEN_ADJUST_DEFAULT HEX: 0080
TOKEN_ADJUST_DEFAULT
} flags ; foldable
CONSTANT: HKEY_CLASSES_ROOT 1
CONSTANT: HKEY_CURRENT_CONFIG 2
CONSTANT: HKEY_CURRENT_USER 3
CONSTANT: HKEY_LOCAL_MACHINE 4
CONSTANT: HKEY_USERS 5
CONSTANT: HKEY_CLASSES_ROOT HEX: 80000000
CONSTANT: HKEY_CURRENT_USER HEX: 80000001
CONSTANT: HKEY_LOCAL_MACHINE HEX: 80000002
CONSTANT: HKEY_USERS HEX: 80000003
CONSTANT: HKEY_PERFORMANCE_DATA HEX: 80000004
CONSTANT: HKEY_CURRENT_CONFIG HEX: 80000005
CONSTANT: HKEY_DYN_DATA HEX: 80000006
CONSTANT: HKEY_PERFORMANCE_TEXT HEX: 80000050
CONSTANT: HKEY_PERFORMANCE_NLSTEXT HEX: 80000060
CONSTANT: KEY_ALL_ACCESS HEX: 0001
CONSTANT: KEY_CREATE_LINK HEX: 0002
CONSTANT: KEY_QUERY_VALUE HEX: 0001
CONSTANT: KEY_SET_VALUE HEX: 0002
CONSTANT: KEY_CREATE_SUB_KEY HEX: 0004
CONSTANT: KEY_ENUMERATE_SUB_KEYS HEX: 0008
CONSTANT: KEY_EXECUTE HEX: 0010
CONSTANT: KEY_NOTIFY HEX: 0020
CONSTANT: KEY_QUERY_VALUE HEX: 0040
CONSTANT: KEY_READ HEX: 0080
CONSTANT: KEY_SET_VALUE HEX: 0100
CONSTANT: KEY_WOW64_64KEY HEX: 0200
CONSTANT: KEY_WOW64_32KEY HEX: 0400
CONSTANT: KEY_WRITE HEX: 0800
CONSTANT: KEY_NOTIFY HEX: 0010
CONSTANT: KEY_CREATE_LINK HEX: 0020
CONSTANT: KEY_READ HEX: 20019
CONSTANT: KEY_WOW64_32KEY HEX: 0200
CONSTANT: KEY_WOW64_64KEY HEX: 0100
CONSTANT: KEY_WRITE HEX: 20006
CONSTANT: KEY_EXECUTE KEY_READ
CONSTANT: KEY_ALL_ACCESS HEX: F003F
CONSTANT: REG_BINARY 1
CONSTANT: REG_DWORD 2
CONSTANT: REG_EXPAND_SZ 3
CONSTANT: REG_MULTI_SZ 4
CONSTANT: REG_QWORD 5
CONSTANT: REG_SZ 6
CONSTANT: REG_NONE 0
CONSTANT: REG_SZ 1
CONSTANT: REG_EXPAND_SZ 2
CONSTANT: REG_BINARY 3
CONSTANT: REG_DWORD 4
CONSTANT: REG_DWORD_LITTLE_ENDIAN 4
CONSTANT: REG_DWORD_BIG_ENDIAN 5
CONSTANT: REG_LINK 6
CONSTANT: REG_MULTI_SZ 7
CONSTANT: REG_RESOURCE_LIST 8
CONSTANT: REG_FULL_RESOURCE_DESCRIPTOR 9
CONSTANT: REG_RESOURCE_REQUIREMENTS_LIST 10
CONSTANT: REG_QWORD 11
CONSTANT: REG_QWORD_LITTLE_ENDIAN 11
TYPEDEF: DWORD REGSAM
! : I_ScGetCurrentGroupStateW ;
! : A_SHAFinal ;
! : A_SHAInit ;
@ -874,7 +885,7 @@ FUNCTION: BOOL OpenThreadToken ( HANDLE ThreadHandle, DWORD DesiredAccess, BOOL
! : ReadEncryptedFileRaw ;
! : ReadEventLogA ;
! : ReadEventLogW ;
! : RegCloseKey ;
FUNCTION: LONG RegCloseKey ( HKEY hKey ) ;
! : RegConnectRegistryA ;
! : RegConnectRegistryW ;
! : RegCreateKeyA ;
@ -883,15 +894,52 @@ FUNCTION: LONG RegCreateKeyExW ( HKEY hKey, LPCTSTR lpSubKey, DWORD Reserved, LP
! : RegCreateKeyW
! : RegDeleteKeyA ;
! : RegDeleteKeyW ;
FUNCTION: LONG RegDeleteKeyExW (
HKEY hKey,
LPCTSTR lpSubKey,
DWORD Reserved,
LPTSTR lpClass,
DWORD dwOptions,
REGSAM samDesired,
LPSECURITY_ATTRIBUTES lpSecurityAttributes,
PHKEY phkResult,
LPDWORD lpdwDisposition
) ;
ALIAS: RegDeleteKeyEx RegDeleteKeyExW
! : RegDeleteValueA ;
! : RegDeleteValueW ;
! : RegDisablePredefinedCache ;
! : RegEnumKeyA ;
! : RegEnumKeyExA ;
! : RegEnumKeyExW ;
FUNCTION: LONG RegEnumKeyExW (
HKEY hKey,
DWORD dwIndex,
LPTSTR lpName,
LPDWORD lpcName,
LPDWORD lpReserved,
LPTSTR lpClass,
LPDWORD lpcClass,
PFILETIME lpftLastWriteTime
) ;
! : RegEnumKeyW ;
! : RegEnumValueA ;
! : RegEnumValueW ;
FUNCTION: LONG RegEnumValueW (
HKEY hKey,
DWORD dwIndex,
LPTSTR lpValueName,
LPDWORD lpcchValueName,
LPDWORD lpReserved,
LPDWORD lpType,
LPBYTE lpData,
LPDWORD lpcbData
) ;
ALIAS: RegEnumValue RegEnumValueW
! : RegFlushKey ;
! : RegGetKeySecurity ;
! : RegLoadKeyA ;
@ -900,17 +948,33 @@ FUNCTION: LONG RegCreateKeyExW ( HKEY hKey, LPCTSTR lpSubKey, DWORD Reserved, LP
FUNCTION: LONG RegOpenCurrentUser ( REGSAM samDesired, PHKEY phkResult ) ;
! : RegOpenKeyA ;
! : RegOpenKeyExA ;
! : RegOpenKeyExW ;
FUNCTION: LONG RegOpenKeyExW ( HKEY hKey, LPCTSTR lpSubKey, DWORD ulOptions, REGSAM samDesired, PHKEY phkResult ) ;
ALIAS: RegOpenKeyEx RegOpenKeyExW
! : RegOpenKeyW ;
! : RegOpenUserClassesRoot ;
! : RegOverridePredefKey ;
! : RegQueryInfoKeyA ;
! : RegQueryInfoKeyW ;
FUNCTION: LONG RegQueryInfoKeyW (
HKEY hKey,
LPTSTR lpClass,
LPDWORD lpcClass,
LPDWORD lpReserved,
LPDWORD lpcSubKeys,
LPDWORD lpcMaxSubKeyLen,
LPDWORD lpcMaxClassLen,
LPDWORD lpcValues,
LPDWORD lpcMaxValueNameLen,
LPDWORD lpcMaxValueLen,
LPDWORD lpcbSecurityDescriptor,
PFILETIME lpftLastWriteTime
) ;
ALIAS: RegQueryInfoKey RegQueryInfoKeyW
! : RegQueryMultipleValuesA ;
! : RegQueryMultipleValuesW ;
! : RegQueryValueA ;
! : RegQueryValueExA ;
FUNCTION: LONG RegQueryValueExW ( HKEY hKey, LPCTSTR lpValueName, LPWORD lpReserved, LPDWORD lpType, LPBYTE lpData, LPDWORD lpcbData ) ;
FUNCTION: LONG RegQueryValueExW ( HKEY hKey, LPCTSTR lpValueName, LPDWORD lpReserved, LPDWORD lpType, LPBYTE lpData, LPDWORD lpcbData ) ;
ALIAS: RegQueryValueEx RegQueryValueExW
! : RegQueryValueW ;
! : RegReplaceKeyA ;
! : RegReplaceKeyW ;

6
basis/windows/errors/errors-tests.factor Executable file
View File

@ -0,0 +1,6 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test windows.errors strings ;
IN: windows.errors.tests
[ t ] [ 0 n>win32-error-string string? ] unit-test

759
basis/windows/errors/errors.factor
View File

@ -1,9 +1,752 @@
IN: windows.errors
USING: alien.c-types kernel locals math math.bitwise
windows.kernel32 sequences byte-arrays unicode.categories
io.encodings.string io.encodings.utf16n alien.strings
arrays ;
IN: windows.errors
CONSTANT: ERROR_SUCCESS 0
CONSTANT: ERROR_NO_MORE_FILES 18
CONSTANT: ERROR_HANDLE_EOF 38
CONSTANT: ERROR_BROKEN_PIPE 109
CONSTANT: ERROR_ENVVAR_NOT_FOUND 203
CONSTANT: ERROR_IO_INCOMPLETE 996
CONSTANT: ERROR_IO_PENDING 997
CONSTANT: ERROR_SUCCESS 0
CONSTANT: ERROR_INVALID_FUNCTION 1
CONSTANT: ERROR_FILE_NOT_FOUND 2
CONSTANT: ERROR_PATH_NOT_FOUND 3
CONSTANT: ERROR_TOO_MANY_OPEN_FILES 4
CONSTANT: ERROR_ACCESS_DENIED 5
CONSTANT: ERROR_INVALID_HANDLE 6
CONSTANT: ERROR_ARENA_TRASHED 7
CONSTANT: ERROR_NOT_ENOUGH_MEMORY 8
CONSTANT: ERROR_INVALID_BLOCK 9
CONSTANT: ERROR_BAD_ENVIRONMENT 10
CONSTANT: ERROR_BAD_FORMAT 11
CONSTANT: ERROR_INVALID_ACCESS 12
CONSTANT: ERROR_INVALID_DATA 13
CONSTANT: ERROR_OUTOFMEMORY 14
CONSTANT: ERROR_INVALID_DRIVE 15
CONSTANT: ERROR_CURRENT_DIRECTORY 16
CONSTANT: ERROR_NOT_SAME_DEVICE 17
CONSTANT: ERROR_NO_MORE_FILES 18
CONSTANT: ERROR_WRITE_PROTECT 19
CONSTANT: ERROR_BAD_UNIT 20
CONSTANT: ERROR_NOT_READY 21
CONSTANT: ERROR_BAD_COMMAND 22
CONSTANT: ERROR_CRC 23
CONSTANT: ERROR_BAD_LENGTH 24
CONSTANT: ERROR_SEEK 25
CONSTANT: ERROR_NOT_DOS_DISK 26
CONSTANT: ERROR_SECTOR_NOT_FOUND 27
CONSTANT: ERROR_OUT_OF_PAPER 28
CONSTANT: ERROR_WRITE_FAULT 29
CONSTANT: ERROR_READ_FAULT 30
CONSTANT: ERROR_GEN_FAILURE 31
CONSTANT: ERROR_SHARING_VIOLATION 32
CONSTANT: ERROR_LOCK_VIOLATION 33
CONSTANT: ERROR_WRONG_DISK 34
CONSTANT: ERROR_SHARING_BUFFER_EXCEEDED 36
CONSTANT: ERROR_HANDLE_EOF 38
CONSTANT: ERROR_HANDLE_DISK_FULL 39
CONSTANT: ERROR_NOT_SUPPORTED 50
CONSTANT: ERROR_REM_NOT_LIST 51
CONSTANT: ERROR_DUP_NAME 52
CONSTANT: ERROR_BAD_NETPATH 53
CONSTANT: ERROR_NETWORK_BUSY 54
CONSTANT: ERROR_DEV_NOT_EXIST 55
CONSTANT: ERROR_TOO_MANY_CMDS 56
CONSTANT: ERROR_ADAP_HDW_ERR 57
CONSTANT: ERROR_BAD_NET_RESP 58
CONSTANT: ERROR_UNEXP_NET_ERR 59
CONSTANT: ERROR_BAD_REM_ADAP 60
CONSTANT: ERROR_PRINTQ_FULL 61
CONSTANT: ERROR_NO_SPOOL_SPACE 62
CONSTANT: ERROR_PRINT_CANCELLED 63
CONSTANT: ERROR_NETNAME_DELETED 64
CONSTANT: ERROR_NETWORK_ACCESS_DENIED 65
CONSTANT: ERROR_BAD_DEV_TYPE 66
CONSTANT: ERROR_BAD_NET_NAME 67
CONSTANT: ERROR_TOO_MANY_NAMES 68
CONSTANT: ERROR_TOO_MANY_SESS 69
CONSTANT: ERROR_SHARING_PAUSED 70
CONSTANT: ERROR_REQ_NOT_ACCEP 71
CONSTANT: ERROR_REDIR_PAUSED 72
CONSTANT: ERROR_FILE_EXISTS 80
CONSTANT: ERROR_CANNOT_MAKE 82
CONSTANT: ERROR_FAIL_I24 83
CONSTANT: ERROR_OUT_OF_STRUCTURES 84
CONSTANT: ERROR_ALREADY_ASSIGNED 85
CONSTANT: ERROR_INVALID_PASSWORD 86
CONSTANT: ERROR_INVALID_PARAMETER 87
CONSTANT: ERROR_NET_WRITE_FAULT 88
CONSTANT: ERROR_NO_PROC_SLOTS 89
CONSTANT: ERROR_TOO_MANY_SEMAPHORES 100
CONSTANT: ERROR_EXCL_SEM_ALREADY_OWNED 101
CONSTANT: ERROR_SEM_IS_SET 102
CONSTANT: ERROR_TOO_MANY_SEM_REQUESTS 103
CONSTANT: ERROR_INVALID_AT_INTERRUPT_TIME 104
CONSTANT: ERROR_SEM_OWNER_DIED 105
CONSTANT: ERROR_SEM_USER_LIMIT 106
CONSTANT: ERROR_DISK_CHANGE 107
CONSTANT: ERROR_DRIVE_LOCKED 108
CONSTANT: ERROR_BROKEN_PIPE 109
CONSTANT: ERROR_OPEN_FAILED 110
CONSTANT: ERROR_BUFFER_OVERFLOW 111
CONSTANT: ERROR_DISK_FULL 112
CONSTANT: ERROR_NO_MORE_SEARCH_HANDLES 113
CONSTANT: ERROR_INVALID_TARGET_HANDLE 114
CONSTANT: ERROR_INVALID_CATEGORY 117
CONSTANT: ERROR_INVALID_VERIFY_SWITCH 118
CONSTANT: ERROR_BAD_DRIVER_LEVEL 119
CONSTANT: ERROR_CALL_NOT_IMPLEMENTED 120
CONSTANT: ERROR_SEM_TIMEOUT 121
CONSTANT: ERROR_INSUFFICIENT_BUFFER 122
CONSTANT: ERROR_INVALID_NAME 123
CONSTANT: ERROR_INVALID_LEVEL 124
CONSTANT: ERROR_NO_VOLUME_LABEL 125
CONSTANT: ERROR_MOD_NOT_FOUND 126
CONSTANT: ERROR_PROC_NOT_FOUND 127
CONSTANT: ERROR_WAIT_NO_CHILDREN 128
CONSTANT: ERROR_CHILD_NOT_COMPLETE 129
CONSTANT: ERROR_DIRECT_ACCESS_HANDLE 130
CONSTANT: ERROR_NEGATIVE_SEEK 131
CONSTANT: ERROR_SEEK_ON_DEVICE 132
CONSTANT: ERROR_IS_JOIN_TARGET 133
CONSTANT: ERROR_IS_JOINED 134
CONSTANT: ERROR_IS_SUBSTED 135
CONSTANT: ERROR_NOT_JOINED 136
CONSTANT: ERROR_NOT_SUBSTED 137
CONSTANT: ERROR_JOIN_TO_JOIN 138
CONSTANT: ERROR_SUBST_TO_SUBST 139
CONSTANT: ERROR_JOIN_TO_SUBST 140
CONSTANT: ERROR_SUBST_TO_JOIN 141
CONSTANT: ERROR_BUSY_DRIVE 142
CONSTANT: ERROR_SAME_DRIVE 143
CONSTANT: ERROR_DIR_NOT_ROOT 144
CONSTANT: ERROR_DIR_NOT_EMPTY 145
CONSTANT: ERROR_IS_SUBST_PATH 146
CONSTANT: ERROR_IS_JOIN_PATH 147
CONSTANT: ERROR_PATH_BUSY 148
CONSTANT: ERROR_IS_SUBST_TARGET 149
CONSTANT: ERROR_SYSTEM_TRACE 150
CONSTANT: ERROR_INVALID_EVENT_COUNT 151
CONSTANT: ERROR_TOO_MANY_MUXWAITERS 152
CONSTANT: ERROR_INVALID_LIST_FORMAT 153
CONSTANT: ERROR_LABEL_TOO_LONG 154
CONSTANT: ERROR_TOO_MANY_TCBS 155
CONSTANT: ERROR_SIGNAL_REFUSED 156
CONSTANT: ERROR_DISCARDED 157
CONSTANT: ERROR_NOT_LOCKED 158
CONSTANT: ERROR_BAD_THREADID_ADDR 159
CONSTANT: ERROR_BAD_ARGUMENTS 160
CONSTANT: ERROR_BAD_PATHNAME 161
CONSTANT: ERROR_SIGNAL_PENDING 162
CONSTANT: ERROR_MAX_THRDS_REACHED 164
CONSTANT: ERROR_LOCK_FAILED 167
CONSTANT: ERROR_BUSY 170
CONSTANT: ERROR_CANCEL_VIOLATION 173
CONSTANT: ERROR_ATOMIC_LOCKS_NOT_SUPPORTED 174
CONSTANT: ERROR_INVALID_SEGMENT_NUMBER 180
CONSTANT: ERROR_INVALID_ORDINAL 182
CONSTANT: ERROR_ALREADY_EXISTS 183
CONSTANT: ERROR_INVALID_FLAG_NUMBER 186
CONSTANT: ERROR_SEM_NOT_FOUND 187
CONSTANT: ERROR_INVALID_STARTING_CODESEG 188
CONSTANT: ERROR_INVALID_STACKSEG 189
CONSTANT: ERROR_INVALID_MODULETYPE 190
CONSTANT: ERROR_INVALID_EXE_SIGNATURE 191
CONSTANT: ERROR_EXE_MARKED_INVALID 192
CONSTANT: ERROR_BAD_EXE_FORMAT 193
CONSTANT: ERROR_ITERATED_DATA_EXCEEDS_64k 194
CONSTANT: ERROR_INVALID_MINALLOCSIZE 195
CONSTANT: ERROR_DYNLINK_FROM_INVALID_RING 196
CONSTANT: ERROR_IOPL_NOT_ENABLED 197
CONSTANT: ERROR_INVALID_SEGDPL 198
CONSTANT: ERROR_AUTODATASEG_EXCEEDS_64k 199
CONSTANT: ERROR_RING2SEG_MUST_BE_MOVABLE 200
CONSTANT: ERROR_RELOC_CHAIN_XEEDS_SEGLIM 201
CONSTANT: ERROR_INFLOOP_IN_RELOC_CHAIN 202
CONSTANT: ERROR_ENVVAR_NOT_FOUND 203
CONSTANT: ERROR_NO_SIGNAL_SENT 205
CONSTANT: ERROR_FILENAME_EXCED_RANGE 206
CONSTANT: ERROR_RING2_STACK_IN_USE 207
CONSTANT: ERROR_META_EXPANSION_TOO_LONG 208
CONSTANT: ERROR_INVALID_SIGNAL_NUMBER 209
CONSTANT: ERROR_THREAD_1_INACTIVE 210
CONSTANT: ERROR_LOCKED 212
CONSTANT: ERROR_TOO_MANY_MODULES 214
CONSTANT: ERROR_NESTING_NOT_ALLOWED 215
CONSTANT: ERROR_EXE_MACHINE_TYPE_MISMATCH 216
CONSTANT: ERROR_BAD_PIPE 230
CONSTANT: ERROR_PIPE_BUSY 231
CONSTANT: ERROR_NO_DATA 232
CONSTANT: ERROR_PIPE_NOT_CONNECTED 233
CONSTANT: ERROR_MORE_DATA 234
CONSTANT: ERROR_VC_DISCONNECTED 240
CONSTANT: ERROR_INVALID_EA_NAME 254
CONSTANT: ERROR_EA_LIST_INCONSISTENT 255
CONSTANT: ERROR_NO_MORE_ITEMS 259
CONSTANT: ERROR_CANNOT_COPY 266
CONSTANT: ERROR_DIRECTORY 267
CONSTANT: ERROR_EAS_DIDNT_FIT 275
CONSTANT: ERROR_EA_FILE_CORRUPT 276
CONSTANT: ERROR_EA_TABLE_FULL 277
CONSTANT: ERROR_INVALID_EA_HANDLE 278
CONSTANT: ERROR_EAS_NOT_SUPPORTED 282
CONSTANT: ERROR_NOT_OWNER 288
CONSTANT: ERROR_TOO_MANY_POSTS 298
CONSTANT: ERROR_PARTIAL_COPY 299
CONSTANT: ERROR_MR_MID_NOT_FOUND 317
CONSTANT: ERROR_INVALID_ADDRESS 487
CONSTANT: ERROR_ARITHMETIC_OVERFLOW 534
CONSTANT: ERROR_PIPE_CONNECTED 535
CONSTANT: ERROR_PIPE_LISTENING 536
CONSTANT: ERROR_EA_ACCESS_DENIED 994
CONSTANT: ERROR_OPERATION_ABORTED 995
CONSTANT: ERROR_IO_INCOMPLETE 996
CONSTANT: ERROR_IO_PENDING 997
CONSTANT: ERROR_NOACCESS 998
CONSTANT: ERROR_SWAPERROR 999
CONSTANT: ERROR_STACK_OVERFLOW 1001
CONSTANT: ERROR_INVALID_MESSAGE 1002
CONSTANT: ERROR_CAN_NOT_COMPLETE 1003
CONSTANT: ERROR_INVALID_FLAGS 1004
CONSTANT: ERROR_UNRECOGNIZED_VOLUME 1005
CONSTANT: ERROR_FILE_INVALID 1006
CONSTANT: ERROR_FULLSCREEN_MODE 1007
CONSTANT: ERROR_NO_TOKEN 1008
CONSTANT: ERROR_BADDB 1009
CONSTANT: ERROR_BADKEY 1010
CONSTANT: ERROR_CANTOPEN 1011
CONSTANT: ERROR_CANTREAD 1012
CONSTANT: ERROR_CANTWRITE 1013
CONSTANT: ERROR_REGISTRY_RECOVERED 1014
CONSTANT: ERROR_REGISTRY_CORRUPT 1015
CONSTANT: ERROR_REGISTRY_IO_FAILED 1016
CONSTANT: ERROR_NOT_REGISTRY_FILE 1017
CONSTANT: ERROR_KEY_DELETED 1018
CONSTANT: ERROR_NO_LOG_SPACE 1019
CONSTANT: ERROR_KEY_HAS_CHILDREN 1020
CONSTANT: ERROR_CHILD_MUST_BE_VOLATILE 1021
CONSTANT: ERROR_NOTIFY_ENUM_DIR 1022
CONSTANT: ERROR_DEPENDENT_SERVICES_RUNNING 1051
CONSTANT: ERROR_INVALID_SERVICE_CONTROL 1052
CONSTANT: ERROR_SERVICE_REQUEST_TIMEOUT 1053
CONSTANT: ERROR_SERVICE_NO_THREAD 1054
CONSTANT: ERROR_SERVICE_DATABASE_LOCKED 1055
CONSTANT: ERROR_SERVICE_ALREADY_RUNNING 1056
CONSTANT: ERROR_INVALID_SERVICE_ACCOUNT 1057
CONSTANT: ERROR_SERVICE_DISABLED 1058
CONSTANT: ERROR_CIRCULAR_DEPENDENCY 1059
CONSTANT: ERROR_SERVICE_DOES_NOT_EXIST 1060
CONSTANT: ERROR_SERVICE_CANNOT_ACCEPT_CTRL 1061
CONSTANT: ERROR_SERVICE_NOT_ACTIVE 1062
CONSTANT: ERROR_FAILED_SERVICE_CONTROLLER_CONNECT 1063
CONSTANT: ERROR_EXCEPTION_IN_SERVICE 1064
CONSTANT: ERROR_DATABASE_DOES_NOT_EXIST 1065
CONSTANT: ERROR_SERVICE_SPECIFIC_ERROR 1066
CONSTANT: ERROR_PROCESS_ABORTED 1067
CONSTANT: ERROR_SERVICE_DEPENDENCY_FAIL 1068
CONSTANT: ERROR_SERVICE_LOGON_FAILED 1069
CONSTANT: ERROR_SERVICE_START_HANG 1070
CONSTANT: ERROR_INVALID_SERVICE_LOCK 1071
CONSTANT: ERROR_SERVICE_MARKED_FOR_DELETE 1072
CONSTANT: ERROR_SERVICE_EXISTS 1073
CONSTANT: ERROR_ALREADY_RUNNING_LKG 1074
CONSTANT: ERROR_SERVICE_DEPENDENCY_DELETED 1075
CONSTANT: ERROR_BOOT_ALREADY_ACCEPTED 1076
CONSTANT: ERROR_SERVICE_NEVER_STARTED 1077
CONSTANT: ERROR_DUPLICATE_SERVICE_NAME 1078
CONSTANT: ERROR_DIFFERENT_SERVICE_ACCOUNT 1079
CONSTANT: ERROR_END_OF_MEDIA 1100
CONSTANT: ERROR_FILEMARK_DETECTED 1101
CONSTANT: ERROR_BEGINNING_OF_MEDIA 1102
CONSTANT: ERROR_SETMARK_DETECTED 1103
CONSTANT: ERROR_NO_DATA_DETECTED 1104
CONSTANT: ERROR_PARTITION_FAILURE 1105
CONSTANT: ERROR_INVALID_BLOCK_LENGTH 1106
CONSTANT: ERROR_DEVICE_NOT_PARTITIONED 1107
CONSTANT: ERROR_UNABLE_TO_LOCK_MEDIA 1108
CONSTANT: ERROR_UNABLE_TO_UNLOAD_MEDIA 1109
CONSTANT: ERROR_MEDIA_CHANGED 1110
CONSTANT: ERROR_BUS_RESET 1111
CONSTANT: ERROR_NO_MEDIA_IN_DRIVE 1112
CONSTANT: ERROR_NO_UNICODE_TRANSLATION 1113
CONSTANT: ERROR_DLL_INIT_FAILED 1114
CONSTANT: ERROR_SHUTDOWN_IN_PROGRESS 1115
CONSTANT: ERROR_NO_SHUTDOWN_IN_PROGRESS 1116
CONSTANT: ERROR_IO_DEVICE 1117
CONSTANT: ERROR_SERIAL_NO_DEVICE 1118
CONSTANT: ERROR_IRQ_BUSY 1119
CONSTANT: ERROR_MORE_WRITES 1120
CONSTANT: ERROR_COUNTER_TIMEOUT 1121
CONSTANT: ERROR_FLOPPY_ID_MARK_NOT_FOUND 1122
CONSTANT: ERROR_FLOPPY_WRONG_CYLINDER 1123
CONSTANT: ERROR_FLOPPY_UNKNOWN_ERROR 1124
CONSTANT: ERROR_FLOPPY_BAD_REGISTERS 1125
CONSTANT: ERROR_DISK_RECALIBRATE_FAILED 1126
CONSTANT: ERROR_DISK_OPERATION_FAILED 1127
CONSTANT: ERROR_DISK_RESET_FAILED 1128
CONSTANT: ERROR_EOM_OVERFLOW 1129
CONSTANT: ERROR_NOT_ENOUGH_SERVER_MEMORY 1130
CONSTANT: ERROR_POSSIBLE_DEADLOCK 1131
CONSTANT: ERROR_MAPPED_ALIGNMENT 1132
CONSTANT: ERROR_SET_POWER_STATE_VETOED 1140
CONSTANT: ERROR_SET_POWER_STATE_FAILED 1141
CONSTANT: ERROR_TOO_MANY_LINKS 1142
CONSTANT: ERROR_OLD_WIN_VERSION 1150
CONSTANT: ERROR_APP_WRONG_OS 1151
CONSTANT: ERROR_SINGLE_INSTANCE_APP 1152
CONSTANT: ERROR_RMODE_APP 1153
CONSTANT: ERROR_INVALID_DLL 1154
CONSTANT: ERROR_NO_ASSOCIATION 1155
CONSTANT: ERROR_DDE_FAIL 1156
CONSTANT: ERROR_DLL_NOT_FOUND 1157
CONSTANT: ERROR_BAD_DEVICE 1200
CONSTANT: ERROR_CONNECTION_UNAVAIL 1201
CONSTANT: ERROR_DEVICE_ALREADY_REMEMBERED 1202
CONSTANT: ERROR_NO_NET_OR_BAD_PATH 1203
CONSTANT: ERROR_BAD_PROVIDER 1204
CONSTANT: ERROR_CANNOT_OPEN_PROFILE 1205
CONSTANT: ERROR_BAD_PROFILE 1206
CONSTANT: ERROR_NOT_CONTAINER 1207
CONSTANT: ERROR_EXTENDED_ERROR 1208
CONSTANT: ERROR_INVALID_GROUPNAME 1209
CONSTANT: ERROR_INVALID_COMPUTERNAME 1210
CONSTANT: ERROR_INVALID_EVENTNAME 1211
CONSTANT: ERROR_INVALID_DOMAINNAME 1212
CONSTANT: ERROR_INVALID_SERVICENAME 1213
CONSTANT: ERROR_INVALID_NETNAME 1214
CONSTANT: ERROR_INVALID_SHARENAME 1215
CONSTANT: ERROR_INVALID_PASSWORDNAME 1216
CONSTANT: ERROR_INVALID_MESSAGENAME 1217
CONSTANT: ERROR_INVALID_MESSAGEDEST 1218
CONSTANT: ERROR_SESSION_CREDENTIAL_CONFLICT 1219
CONSTANT: ERROR_REMOTE_SESSION_LIMIT_EXCEEDED 1220
CONSTANT: ERROR_DUP_DOMAINNAME 1221
CONSTANT: ERROR_NO_NETWORK 1222
CONSTANT: ERROR_CANCELLED 1223
CONSTANT: ERROR_USER_MAPPED_FILE 1224
CONSTANT: ERROR_CONNECTION_REFUSED 1225
CONSTANT: ERROR_GRACEFUL_DISCONNECT 1226
CONSTANT: ERROR_ADDRESS_ALREADY_ASSOCIATED 1227
CONSTANT: ERROR_ADDRESS_NOT_ASSOCIATED 1228
CONSTANT: ERROR_CONNECTION_INVALID 1229
CONSTANT: ERROR_CONNECTION_ACTIVE 1230
CONSTANT: ERROR_NETWORK_UNREACHABLE 1231
CONSTANT: ERROR_HOST_UNREACHABLE 1232
CONSTANT: ERROR_PROTOCOL_UNREACHABLE 1233
CONSTANT: ERROR_PORT_UNREACHABLE 1234
CONSTANT: ERROR_REQUEST_ABORTED 1235
CONSTANT: ERROR_CONNECTION_ABORTED 1236
CONSTANT: ERROR_RETRY 1237
CONSTANT: ERROR_CONNECTION_COUNT_LIMIT 1238
CONSTANT: ERROR_LOGIN_TIME_RESTRICTION 1239
CONSTANT: ERROR_LOGIN_WKSTA_RESTRICTION 1240
CONSTANT: ERROR_INCORRECT_ADDRESS 1241
CONSTANT: ERROR_ALREADY_REGISTERED 1242
CONSTANT: ERROR_SERVICE_NOT_FOUND 1243
CONSTANT: ERROR_NOT_AUTHENTICATED 1244
CONSTANT: ERROR_NOT_LOGGED_ON 1245
CONSTANT: ERROR_CONTINUE 1246
CONSTANT: ERROR_ALREADY_INITIALIZED 1247
CONSTANT: ERROR_NO_MORE_DEVICES 1248
CONSTANT: ERROR_NOT_ALL_ASSIGNED 1300
CONSTANT: ERROR_SOME_NOT_MAPPED 1301
CONSTANT: ERROR_NO_QUOTAS_FOR_ACCOUNT 1302
CONSTANT: ERROR_LOCAL_USER_SESSION_KEY 1303
CONSTANT: ERROR_NULL_LM_PASSWORD 1304
CONSTANT: ERROR_UNKNOWN_REVISION 1305
CONSTANT: ERROR_REVISION_MISMATCH 1306
CONSTANT: ERROR_INVALID_OWNER 1307
CONSTANT: ERROR_INVALID_PRIMARY_GROUP 1308
CONSTANT: ERROR_NO_IMPERSONATION_TOKEN 1309
CONSTANT: ERROR_CANT_DISABLE_MANDATORY 1310
CONSTANT: ERROR_NO_LOGON_SERVERS 1311
CONSTANT: ERROR_NO_SUCH_LOGON_SESSION 1312
CONSTANT: ERROR_NO_SUCH_PRIVILEGE 1313
CONSTANT: ERROR_PRIVILEGE_NOT_HELD 1314
CONSTANT: ERROR_INVALID_ACCOUNT_NAME 1315
CONSTANT: ERROR_USER_EXISTS 1316
CONSTANT: ERROR_NO_SUCH_USER 1317
CONSTANT: ERROR_GROUP_EXISTS 1318
CONSTANT: ERROR_NO_SUCH_GROUP 1319
CONSTANT: ERROR_MEMBER_IN_GROUP 1320
CONSTANT: ERROR_MEMBER_NOT_IN_GROUP 1321
CONSTANT: ERROR_LAST_ADMIN 1322
CONSTANT: ERROR_WRONG_PASSWORD 1323
CONSTANT: ERROR_ILL_FORMED_PASSWORD 1324
CONSTANT: ERROR_PASSWORD_RESTRICTION 1325
CONSTANT: ERROR_LOGON_FAILURE 1326
CONSTANT: ERROR_ACCOUNT_RESTRICTION 1327
CONSTANT: ERROR_INVALID_LOGON_HOURS 1328
CONSTANT: ERROR_INVALID_WORKSTATION 1329
CONSTANT: ERROR_PASSWORD_EXPIRED 1330
CONSTANT: ERROR_ACCOUNT_DISABLED 1331
CONSTANT: ERROR_NONE_MAPPED 1332
CONSTANT: ERROR_TOO_MANY_LUIDS_REQUESTED 1333
CONSTANT: ERROR_LUIDS_EXHAUSTED 1334
CONSTANT: ERROR_INVALID_SUB_AUTHORITY 1335
CONSTANT: ERROR_INVALID_ACL 1336
CONSTANT: ERROR_INVALID_SID 1337
CONSTANT: ERROR_INVALID_SECURITY_DESCR 1338
CONSTANT: ERROR_BAD_INHERITANCE_ACL 1340
CONSTANT: ERROR_SERVER_DISABLED 1341
CONSTANT: ERROR_SERVER_NOT_DISABLED 1342
CONSTANT: ERROR_INVALID_ID_AUTHORITY 1343
CONSTANT: ERROR_ALLOTTED_SPACE_EXCEEDED 1344
CONSTANT: ERROR_INVALID_GROUP_ATTRIBUTES 1345
CONSTANT: ERROR_BAD_IMPERSONATION_LEVEL 1346
CONSTANT: ERROR_CANT_OPEN_ANONYMOUS 1347
CONSTANT: ERROR_BAD_VALIDATION_CLASS 1348
CONSTANT: ERROR_BAD_TOKEN_TYPE 1349
CONSTANT: ERROR_NO_SECURITY_ON_OBJECT 1350
CONSTANT: ERROR_CANT_ACCESS_DOMAIN_INFO 1351
CONSTANT: ERROR_INVALID_SERVER_STATE 1352
CONSTANT: ERROR_INVALID_DOMAIN_STATE 1353
CONSTANT: ERROR_INVALID_DOMAIN_ROLE 1354
CONSTANT: ERROR_NO_SUCH_DOMAIN 1355
CONSTANT: ERROR_DOMAIN_EXISTS 1356
CONSTANT: ERROR_DOMAIN_LIMIT_EXCEEDED 1357
CONSTANT: ERROR_INTERNAL_DB_CORRUPTION 1358
CONSTANT: ERROR_INTERNAL_ERROR 1359
CONSTANT: ERROR_GENERIC_NOT_MAPPED 1360
CONSTANT: ERROR_BAD_DESCRIPTOR_FORMAT 1361
CONSTANT: ERROR_NOT_LOGON_PROCESS 1362
CONSTANT: ERROR_LOGON_SESSION_EXISTS 1363
CONSTANT: ERROR_NO_SUCH_PACKAGE 1364
CONSTANT: ERROR_BAD_LOGON_SESSION_STATE 1365
CONSTANT: ERROR_LOGON_SESSION_COLLISION 1366
CONSTANT: ERROR_INVALID_LOGON_TYPE 1367
CONSTANT: ERROR_CANNOT_IMPERSONATE 1368
CONSTANT: ERROR_RXACT_INVALID_STATE 1369
CONSTANT: ERROR_RXACT_COMMIT_FAILURE 1370
CONSTANT: ERROR_SPECIAL_ACCOUNT 1371
CONSTANT: ERROR_SPECIAL_GROUP 1372
CONSTANT: ERROR_SPECIAL_USER 1373
CONSTANT: ERROR_MEMBERS_PRIMARY_GROUP 1374
CONSTANT: ERROR_TOKEN_ALREADY_IN_USE 1375
CONSTANT: ERROR_NO_SUCH_ALIAS 1376
CONSTANT: ERROR_MEMBER_NOT_IN_ALIAS 1377
CONSTANT: ERROR_MEMBER_IN_ALIAS 1378
CONSTANT: ERROR_ALIAS_EXISTS 1379
CONSTANT: ERROR_LOGON_NOT_GRANTED 1380
CONSTANT: ERROR_TOO_MANY_SECRETS 1381
CONSTANT: ERROR_SECRET_TOO_LONG 1382
CONSTANT: ERROR_INTERNAL_DB_ERROR 1383
CONSTANT: ERROR_TOO_MANY_CONTEXT_IDS 1384
CONSTANT: ERROR_LOGON_TYPE_NOT_GRANTED 1385
CONSTANT: ERROR_NT_CROSS_ENCRYPTION_REQUIRED 1386
CONSTANT: ERROR_NO_SUCH_MEMBER 1387
CONSTANT: ERROR_INVALID_MEMBER 1388
CONSTANT: ERROR_TOO_MANY_SIDS 1389
CONSTANT: ERROR_LM_CROSS_ENCRYPTION_REQUIRED 1390
CONSTANT: ERROR_NO_INHERITANCE 1391
CONSTANT: ERROR_FILE_CORRUPT 1392
CONSTANT: ERROR_DISK_CORRUPT 1393
CONSTANT: ERROR_NO_USER_SESSION_KEY 1394
CONSTANT: ERROR_LICENSE_QUOTA_EXCEEDED 1395
CONSTANT: ERROR_INVALID_WINDOW_HANDLE 1400
CONSTANT: ERROR_INVALID_MENU_HANDLE 1401
CONSTANT: ERROR_INVALID_CURSOR_HANDLE 1402
CONSTANT: ERROR_INVALID_ACCEL_HANDLE 1403
CONSTANT: ERROR_INVALID_HOOK_HANDLE 1404
CONSTANT: ERROR_INVALID_DWP_HANDLE 1405
CONSTANT: ERROR_TLW_WITH_WSCHILD 1406
CONSTANT: ERROR_CANNOT_FIND_WND_CLASS 1407
CONSTANT: ERROR_WINDOW_OF_OTHER_THREAD 1408
CONSTANT: ERROR_HOTKEY_ALREADY_REGISTERED 1409
CONSTANT: ERROR_CLASS_ALREADY_EXISTS 1410
CONSTANT: ERROR_CLASS_DOES_NOT_EXIST 1411
CONSTANT: ERROR_CLASS_HAS_WINDOWS 1412
CONSTANT: ERROR_INVALID_INDEX 1413
CONSTANT: ERROR_INVALID_ICON_HANDLE 1414
CONSTANT: ERROR_PRIVATE_DIALOG_INDEX 1415
CONSTANT: ERROR_LISTBOX_ID_NOT_FOUND 1416
CONSTANT: ERROR_NO_WILDCARD_CHARACTERS 1417
CONSTANT: ERROR_CLIPBOARD_NOT_OPEN 1418
CONSTANT: ERROR_HOTKEY_NOT_REGISTERED 1419
CONSTANT: ERROR_WINDOW_NOT_DIALOG 1420
CONSTANT: ERROR_CONTROL_ID_NOT_FOUND 1421
CONSTANT: ERROR_INVALID_COMBOBOX_MESSAGE 1422
CONSTANT: ERROR_WINDOW_NOT_COMBOBOX 1423
CONSTANT: ERROR_INVALID_EDIT_HEIGHT 1424
CONSTANT: ERROR_DC_NOT_FOUND 1425
CONSTANT: ERROR_INVALID_HOOK_FILTER 1426
CONSTANT: ERROR_INVALID_FILTER_PROC 1427
CONSTANT: ERROR_HOOK_NEEDS_HMOD 1428
CONSTANT: ERROR_GLOBAL_ONLY_HOOK 1429
CONSTANT: ERROR_JOURNAL_HOOK_SET 1430
CONSTANT: ERROR_HOOK_NOT_INSTALLED 1431
CONSTANT: ERROR_INVALID_LB_MESSAGE 1432
CONSTANT: ERROR_LB_WITHOUT_TABSTOPS 1434
CONSTANT: ERROR_DESTROY_OBJECT_OF_OTHER_THREAD 1435
CONSTANT: ERROR_CHILD_WINDOW_MENU 1436
CONSTANT: ERROR_NO_SYSTEM_MENU 1437
CONSTANT: ERROR_INVALID_MSGBOX_STYLE 1438
CONSTANT: ERROR_INVALID_SPI_VALUE 1439
CONSTANT: ERROR_SCREEN_ALREADY_LOCKED 1440
CONSTANT: ERROR_HWNDS_HAVE_DIFF_PARENT 1441
CONSTANT: ERROR_NOT_CHILD_WINDOW 1442
CONSTANT: ERROR_INVALID_GW_COMMAND 1443
CONSTANT: ERROR_INVALID_THREAD_ID 1444
CONSTANT: ERROR_NON_MDICHILD_WINDOW 1445
CONSTANT: ERROR_POPUP_ALREADY_ACTIVE 1446
CONSTANT: ERROR_NO_SCROLLBARS 1447
CONSTANT: ERROR_INVALID_SCROLLBAR_RANGE 1448
CONSTANT: ERROR_INVALID_SHOWWIN_COMMAND 1449
CONSTANT: ERROR_NO_SYSTEM_RESOURCES 1450
CONSTANT: ERROR_NONPAGED_SYSTEM_RESOURCES 1451
CONSTANT: ERROR_PAGED_SYSTEM_RESOURCES 1452
CONSTANT: ERROR_WORKING_SET_QUOTA 1453
CONSTANT: ERROR_PAGEFILE_QUOTA 1454
CONSTANT: ERROR_COMMITMENT_LIMIT 1455
CONSTANT: ERROR_MENU_ITEM_NOT_FOUND 1456
CONSTANT: ERROR_INVALID_KEYBOARD_HANDLE 1457
CONSTANT: ERROR_HOOK_TYPE_NOT_ALLOWED 1458
CONSTANT: ERROR_REQUIRES_INTERACTIVE_WINDOWSTATION 1459
CONSTANT: ERROR_TIMEOUT 1460
CONSTANT: ERROR_EVENTLOG_FILE_CORRUPT 1500
CONSTANT: ERROR_EVENTLOG_CANT_START 1501
CONSTANT: ERROR_LOG_FILE_FULL 1502
CONSTANT: ERROR_EVENTLOG_FILE_CHANGED 1503
CONSTANT: RPC_S_INVALID_STRING_BINDING 1700
CONSTANT: RPC_S_WRONG_KIND_OF_BINDING 1701
CONSTANT: RPC_S_INVALID_BINDING 1702
CONSTANT: RPC_S_PROTSEQ_NOT_SUPPORTED 1703
CONSTANT: RPC_S_INVALID_RPC_PROTSEQ 1704
CONSTANT: RPC_S_INVALID_STRING_UUID 1705
CONSTANT: RPC_S_INVALID_ENDPOINT_FORMAT 1706
CONSTANT: RPC_S_INVALID_NET_ADDR 1707
CONSTANT: RPC_S_NO_ENDPOINT_FOUND 1708
CONSTANT: RPC_S_INVALID_TIMEOUT 1709
CONSTANT: RPC_S_OBJECT_NOT_FOUND 1710
CONSTANT: RPC_S_ALREADY_REGISTERED 1711
CONSTANT: RPC_S_TYPE_ALREADY_REGISTERED 1712
CONSTANT: RPC_S_ALREADY_LISTENING 1713
CONSTANT: RPC_S_NO_PROTSEQS_REGISTERED 1714
CONSTANT: RPC_S_NOT_LISTENING 1715
CONSTANT: RPC_S_UNKNOWN_MGR_TYPE 1716
CONSTANT: RPC_S_UNKNOWN_IF 1717
CONSTANT: RPC_S_NO_BINDINGS 1718
CONSTANT: RPC_S_NO_PROTSEQS 1719
CONSTANT: RPC_S_CANT_CREATE_ENDPOINT 1720
CONSTANT: RPC_S_OUT_OF_RESOURCES 1721
CONSTANT: RPC_S_SERVER_UNAVAILABLE 1722
CONSTANT: RPC_S_SERVER_TOO_BUSY 1723
CONSTANT: RPC_S_INVALID_NETWORK_OPTIONS 1724
CONSTANT: RPC_S_NO_CALL_ACTIVE 1725
CONSTANT: RPC_S_CALL_FAILED 1726
CONSTANT: RPC_S_CALL_FAILED_DNE 1727
CONSTANT: RPC_S_PROTOCOL_ERROR 1728
CONSTANT: RPC_S_UNSUPPORTED_TRANS_SYN 1730
CONSTANT: RPC_S_UNSUPPORTED_TYPE 1732
CONSTANT: RPC_S_INVALID_TAG 1733
CONSTANT: RPC_S_INVALID_BOUND 1734
CONSTANT: RPC_S_NO_ENTRY_NAME 1735
CONSTANT: RPC_S_INVALID_NAME_SYNTAX 1736
CONSTANT: RPC_S_UNSUPPORTED_NAME_SYNTAX 1737
CONSTANT: RPC_S_UUID_NO_ADDRESS 1739
CONSTANT: RPC_S_DUPLICATE_ENDPOINT 1740
CONSTANT: RPC_S_UNKNOWN_AUTHN_TYPE 1741
CONSTANT: RPC_S_MAX_CALLS_TOO_SMALL 1742
CONSTANT: RPC_S_STRING_TOO_LONG 1743
CONSTANT: RPC_S_PROTSEQ_NOT_FOUND 1744
CONSTANT: RPC_S_PROCNUM_OUT_OF_RANGE 1745
CONSTANT: RPC_S_BINDING_HAS_NO_AUTH 1746
CONSTANT: RPC_S_UNKNOWN_AUTHN_SERVICE 1747
CONSTANT: RPC_S_UNKNOWN_AUTHN_LEVEL 1748
CONSTANT: RPC_S_INVALID_AUTH_IDENTITY 1749
CONSTANT: RPC_S_UNKNOWN_AUTHZ_SERVICE 1750
CONSTANT: EPT_S_INVALID_ENTRY 1751
CONSTANT: EPT_S_CANT_PERFORM_OP 1752
CONSTANT: EPT_S_NOT_REGISTERED 1753
CONSTANT: RPC_S_NOTHING_TO_EXPORT 1754
CONSTANT: RPC_S_INCOMPLETE_NAME 1755
CONSTANT: RPC_S_INVALID_VERS_OPTION 1756
CONSTANT: RPC_S_NO_MORE_MEMBERS 1757
CONSTANT: RPC_S_NOT_ALL_OBJS_UNEXPORTED 1758
CONSTANT: RPC_S_INTERFACE_NOT_FOUND 1759
CONSTANT: RPC_S_ENTRY_ALREADY_EXISTS 1760
CONSTANT: RPC_S_ENTRY_NOT_FOUND 1761
CONSTANT: RPC_S_NAME_SERVICE_UNAVAILABLE 1762
CONSTANT: RPC_S_INVALID_NAF_ID 1763
CONSTANT: RPC_S_CANNOT_SUPPORT 1764
CONSTANT: RPC_S_NO_CONTEXT_AVAILABLE 1765
CONSTANT: RPC_S_INTERNAL_ERROR 1766
CONSTANT: RPC_S_ZERO_DIVIDE 1767
CONSTANT: RPC_S_ADDRESS_ERROR 1768
CONSTANT: RPC_S_FP_DIV_ZERO 1769
CONSTANT: RPC_S_FP_UNDERFLOW 1770
CONSTANT: RPC_S_FP_OVERFLOW 1771
CONSTANT: RPC_X_NO_MORE_ENTRIES 1772
CONSTANT: RPC_X_SS_CHAR_TRANS_OPEN_FAIL 1773
CONSTANT: RPC_X_SS_CHAR_TRANS_SHORT_FILE 1774
CONSTANT: RPC_X_SS_IN_NULL_CONTEXT 1775
CONSTANT: RPC_X_SS_CONTEXT_DAMAGED 1777
CONSTANT: RPC_X_SS_HANDLES_MISMATCH 1778
CONSTANT: RPC_X_SS_CANNOT_GET_CALL_HANDLE 1779
CONSTANT: RPC_X_NULL_REF_POINTER 1780
CONSTANT: RPC_X_ENUM_VALUE_OUT_OF_RANGE 1781
CONSTANT: RPC_X_BYTE_COUNT_TOO_SMALL 1782
CONSTANT: RPC_X_BAD_STUB_DATA 1783
CONSTANT: ERROR_INVALID_USER_BUFFER 1784
CONSTANT: ERROR_UNRECOGNIZED_MEDIA 1785
CONSTANT: ERROR_NO_TRUST_LSA_SECRET 1786
CONSTANT: ERROR_NO_TRUST_SAM_ACCOUNT 1787
CONSTANT: ERROR_TRUSTED_DOMAIN_FAILURE 1788
CONSTANT: ERROR_TRUSTED_RELATIONSHIP_FAILURE 1789
CONSTANT: ERROR_TRUST_FAILURE 1790
CONSTANT: RPC_S_CALL_IN_PROGRESS 1791
CONSTANT: ERROR_NETLOGON_NOT_STARTED 1792
CONSTANT: ERROR_ACCOUNT_EXPIRED 1793
CONSTANT: ERROR_REDIRECTOR_HAS_OPEN_HANDLES 1794
CONSTANT: ERROR_PRINTER_DRIVER_ALREADY_INSTALLED 1795
CONSTANT: ERROR_UNKNOWN_PORT 1796
CONSTANT: ERROR_UNKNOWN_PRINTER_DRIVER 1797
CONSTANT: ERROR_UNKNOWN_PRINTPROCESSOR 1798
CONSTANT: ERROR_INVALID_SEPARATOR_FILE 1799
CONSTANT: ERROR_INVALID_PRIORITY 1800
CONSTANT: ERROR_INVALID_PRINTER_NAME 1801
CONSTANT: ERROR_PRINTER_ALREADY_EXISTS 1802
CONSTANT: ERROR_INVALID_PRINTER_COMMAND 1803
CONSTANT: ERROR_INVALID_DATATYPE 1804
CONSTANT: ERROR_INVALID_ENVIRONMENT 1805
CONSTANT: RPC_S_NO_MORE_BINDINGS 1806
CONSTANT: ERROR_NOLOGON_INTERDOMAIN_TRUST_ACCOUNT 1807
CONSTANT: ERROR_NOLOGON_WORKSTATION_TRUST_ACCOUNT 1808
CONSTANT: ERROR_NOLOGON_SERVER_TRUST_ACCOUNT 1809
CONSTANT: ERROR_DOMAIN_TRUST_INCONSISTENT 1810
CONSTANT: ERROR_SERVER_HAS_OPEN_HANDLES 1811
CONSTANT: ERROR_RESOURCE_DATA_NOT_FOUND 1812
CONSTANT: ERROR_RESOURCE_TYPE_NOT_FOUND 1813
CONSTANT: ERROR_RESOURCE_NAME_NOT_FOUND 1814
CONSTANT: ERROR_RESOURCE_LANG_NOT_FOUND 1815
CONSTANT: ERROR_NOT_ENOUGH_QUOTA 1816
CONSTANT: RPC_S_NO_INTERFACES 1817
CONSTANT: RPC_S_CALL_CANCELLED 1818
CONSTANT: RPC_S_BINDING_INCOMPLETE 1819
CONSTANT: RPC_S_COMM_FAILURE 1820
CONSTANT: RPC_S_UNSUPPORTED_AUTHN_LEVEL 1821
CONSTANT: RPC_S_NO_PRINC_NAME 1822
CONSTANT: RPC_S_NOT_RPC_ERROR 1823
CONSTANT: RPC_S_UUID_LOCAL_ONLY 1824
CONSTANT: RPC_S_SEC_PKG_ERROR 1825
CONSTANT: RPC_S_NOT_CANCELLED 1826
CONSTANT: RPC_X_INVALID_ES_ACTION 1827
CONSTANT: RPC_X_WRONG_ES_VERSION 1828
CONSTANT: RPC_X_WRONG_STUB_VERSION 1829
CONSTANT: RPC_X_INVALID_PIPE_OBJECT 1830
CONSTANT: RPC_X_INVALID_PIPE_OPERATION 1831
CONSTANT: RPC_X_WRONG_PIPE_VERSION 1832
CONSTANT: RPC_S_GROUP_MEMBER_NOT_FOUND 1898
CONSTANT: EPT_S_CANT_CREATE 1899
CONSTANT: RPC_S_INVALID_OBJECT 1900
CONSTANT: ERROR_INVALID_TIME 1901
CONSTANT: ERROR_INVALID_FORM_NAME 1902
CONSTANT: ERROR_INVALID_FORM_SIZE 1903
CONSTANT: ERROR_ALREADY_WAITING 1904
CONSTANT: ERROR_PRINTER_DELETED 1905
CONSTANT: ERROR_INVALID_PRINTER_STATE 1906
CONSTANT: ERROR_PASSWORD_MUST_CHANGE 1907
CONSTANT: ERROR_DOMAIN_CONTROLLER_NOT_FOUND 1908
CONSTANT: ERROR_ACCOUNT_LOCKED_OUT 1909
CONSTANT: OR_INVALID_OXID 1910
CONSTANT: OR_INVALID_OID 1911
CONSTANT: OR_INVALID_SET 1912
CONSTANT: RPC_S_SEND_INCOMPLETE 1913
CONSTANT: ERROR_INVALID_PIXEL_FORMAT 2000
CONSTANT: ERROR_BAD_DRIVER 2001
CONSTANT: ERROR_INVALID_WINDOW_STYLE 2002
CONSTANT: ERROR_METAFILE_NOT_SUPPORTED 2003
CONSTANT: ERROR_TRANSFORM_NOT_SUPPORTED 2004
CONSTANT: ERROR_CLIPPING_NOT_SUPPORTED 2005
CONSTANT: ERROR_BAD_USERNAME 2202
CONSTANT: ERROR_NOT_CONNECTED 2250
CONSTANT: ERROR_OPEN_FILES 2401
CONSTANT: ERROR_ACTIVE_CONNECTIONS 2402
CONSTANT: ERROR_DEVICE_IN_USE 2404
CONSTANT: ERROR_UNKNOWN_PRINT_MONITOR 3000
CONSTANT: ERROR_PRINTER_DRIVER_IN_USE 3001
CONSTANT: ERROR_SPOOL_FILE_NOT_FOUND 3002
CONSTANT: ERROR_SPL_NO_STARTDOC 3003
CONSTANT: ERROR_SPL_NO_ADDJOB 3004
CONSTANT: ERROR_PRINT_PROCESSOR_ALREADY_INSTALLED 3005
CONSTANT: ERROR_PRINT_MONITOR_ALREADY_INSTALLED 3006
CONSTANT: ERROR_INVALID_PRINT_MONITOR 3007
CONSTANT: ERROR_PRINT_MONITOR_IN_USE 3008
CONSTANT: ERROR_PRINTER_HAS_JOBS_QUEUED 3009
CONSTANT: ERROR_SUCCESS_REBOOT_REQUIRED 3010
CONSTANT: ERROR_SUCCESS_RESTART_REQUIRED 3011
CONSTANT: ERROR_WINS_INTERNAL 4000
CONSTANT: ERROR_CAN_NOT_DEL_LOCAL_WINS 4001
CONSTANT: ERROR_STATIC_INIT 4002
CONSTANT: ERROR_INC_BACKUP 4003
CONSTANT: ERROR_FULL_BACKUP 4004
CONSTANT: ERROR_REC_NON_EXISTENT 4005
CONSTANT: ERROR_RPL_NOT_ALLOWED 4006
CONSTANT: ERROR_NO_BROWSER_SERVERS_FOUND 6118
CONSTANT: SUBLANG_NEUTRAL 0
CONSTANT: LANG_NEUTRAL 0
CONSTANT: SUBLANG_DEFAULT 1
CONSTANT: FORMAT_MESSAGE_ALLOCATE_BUFFER HEX: 00000100
CONSTANT: FORMAT_MESSAGE_IGNORE_INSERTS HEX: 00000200
CONSTANT: FORMAT_MESSAGE_FROM_STRING HEX: 00000400
CONSTANT: FORMAT_MESSAGE_FROM_HMODULE HEX: 00000800
CONSTANT: FORMAT_MESSAGE_FROM_SYSTEM HEX: 00001000
CONSTANT: FORMAT_MESSAGE_ARGUMENT_ARRAY HEX: 00002000
CONSTANT: FORMAT_MESSAGE_MAX_WIDTH_MASK HEX: 000000FF
: make-lang-id ( lang1 lang2 -- n )
10 shift bitor ; inline
ERROR: error-message-failed id ;
:: n>win32-error-string ( id -- string )
{
FORMAT_MESSAGE_FROM_SYSTEM
FORMAT_MESSAGE_ARGUMENT_ARRAY
} flags
f
id
LANG_NEUTRAL SUBLANG_DEFAULT make-lang-id
32768 [ "TCHAR" <c-array> ] keep
f pick [ FormatMessage 0 = [ id error-message-failed ] when ] dip
utf16n alien>string [ blank? ] trim ;
: win32-error-string ( -- str )
GetLastError n>win32-error-string ;
: (win32-error) ( n -- )
dup zero? [
drop
] [
win32-error-string throw
] if ;
: win32-error ( -- )
GetLastError (win32-error) ;
: win32-error=0/f ( n -- ) { 0 f } member? [ win32-error ] when ;
: win32-error>0 ( n -- ) 0 > [ win32-error ] when ;
: win32-error<0 ( n -- ) 0 < [ win32-error ] when ;
: win32-error<>0 ( n -- ) zero? [ win32-error ] unless ;
: invalid-handle? ( handle -- )
INVALID_HANDLE_VALUE = [
win32-error-string throw
] when ;
: expected-io-errors ( -- seq )
ERROR_SUCCESS
ERROR_IO_INCOMPLETE
ERROR_IO_PENDING
WAIT_TIMEOUT 4array ; foldable
: expected-io-error? ( error-code -- ? )
expected-io-errors member? ;
: expected-io-error ( error-code -- )
dup expected-io-error? [
drop
] [
win32-error-string throw
] if ;
: io-error ( return-value -- )
{ 0 f } member? [ GetLastError expected-io-error ] when ;

2
basis/windows/fonts/fonts.factor
View File

@ -1,5 +1,5 @@
USING: assocs memoize locals kernel accessors init fonts math
combinators windows windows.types windows.gdi32 ;
combinators windows.errors windows.types windows.gdi32 ;
IN: windows.fonts
: windows-font-name ( string -- string' )

1
basis/windows/fonts/tags.txt Normal file
View File

@ -0,0 +1 @@
unportable

14
basis/windows/kernel32/kernel32.factor
View File

@ -1110,7 +1110,19 @@ FUNCTION: BOOL FindVolumeMountPointClose ( HANDLE hFindVolumeMountPoint ) ;
! FUNCTION: FoldStringA
! FUNCTION: FoldStringW
! FUNCTION: FormatMessageA
! FUNCTION: FormatMessageW
FUNCTION: DWORD FormatMessageW (
DWORD dwFlags,
LPCVOID lpSource,
DWORD dwMessageId,
DWORD dwLanguageId,
LPTSTR lpBuffer,
DWORD nSize,
void* Arguments
) ;
ALIAS: FormatMessage FormatMessageW
FUNCTION: BOOL FreeConsole ( ) ;
! FUNCTION: FreeEnvironmentStringsA
FUNCTION: BOOL FreeEnvironmentStringsW ( LPTCH lpszEnvironmentBlock ) ;

6
basis/windows/ole32/ole32.factor
View File

@ -1,6 +1,6 @@
USING: alien alien.syntax alien.c-types alien.strings math
kernel sequences windows windows.types debugger io accessors
math.order namespaces make math.parser windows.kernel32
kernel sequences windows.errors windows.types debugger io
accessors math.order namespaces make math.parser windows.kernel32
combinators locals specialized-arrays.direct.uchar ;
IN: windows.ole32
@ -120,7 +120,7 @@ TUPLE: ole32-error error-code ;
C: <ole32-error> ole32-error
M: ole32-error error.
"COM method failed: " print error-code>> (win32-error-string) print ;
"COM method failed: " print error-code>> n>win32-error-string print ;
: ole32-error ( hresult -- )
dup succeeded? [ drop ] [ <ole32-error> throw ] if ;

4
basis/windows/shell32/shell32.factor
View File

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings alien.syntax
combinators io.encodings.utf16n io.files io.pathnames kernel
windows windows.com windows.com.syntax windows.user32
windows.ole32 ;
windows.errors windows.com windows.com.syntax windows.user32
windows.ole32 windows ;
IN: windows.shell32
CONSTANT: CSIDL_DESKTOP HEX: 00

6
basis/windows/time/time.factor
View File

@ -1,11 +1,11 @@
! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types kernel math windows windows.kernel32
namespaces calendar math.bitwise ;
USING: alien alien.c-types kernel math windows.errors
windows.kernel32 namespaces calendar math.bitwise ;
IN: windows.time
: >64bit ( lo hi -- n )
32 shift bitor ;
32 shift bitor ; inline
: windows-1601 ( -- timestamp )
1601 1 1 0 0 0 instant <timestamp> ;

2
basis/windows/types/types.factor
View File

@ -100,7 +100,7 @@ TYPEDEF: HANDLE HGDIOBJ
TYPEDEF: HANDLE HGLOBAL
TYPEDEF: HANDLE HHOOK
TYPEDEF: HANDLE HINSTANCE
TYPEDEF: HANDLE HKEY
TYPEDEF: DWORD HKEY
TYPEDEF: HANDLE HKL
TYPEDEF: HANDLE HLOCAL
TYPEDEF: HANDLE HMENU

4
basis/windows/uniscribe/uniscribe.factor
View File

@ -2,9 +2,9 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel assocs math sequences fry io.encodings.string
io.encodings.utf16n accessors arrays combinators destructors
cache namespaces init fonts alien.c-types windows windows.usp10
cache namespaces init fonts alien.c-types windows.usp10
windows.offscreen windows.gdi32 windows.ole32 windows.types
windows.fonts opengl.textures locals ;
windows.fonts opengl.textures locals windows.errors ;
IN: windows.uniscribe
TUPLE: script-string font string metrics ssa size image disposed ;

49
basis/windows/user32/user32.factor
View File

@ -542,12 +542,46 @@ C-STRUCT: DEV_BROADCAST_HDR
{ "DWORD" "dbch_size" }
{ "DWORD" "dbch_devicetype" }
{ "DWORD" "dbch_reserved" } ;
C-STRUCT: DEV_BROADCAST_DEVICEW
{ "DWORD" "dbcc_size" }
{ "DWORD" "dbcc_devicetype" }
{ "DWORD" "dbcc_reserved" }
{ "GUID" "dbcc_classguid" }
{ "WCHAR[1]" "dbcc_name" } ;
{ { "WCHAR" 1 } "dbcc_name" } ;
CONSTANT: CCHDEVICENAME 32
C-STRUCT: MONITORINFOEX
{ "DWORD" "cbSize" }
{ "RECT" "rcMonitor" }
{ "RECT" "rcWork" }
{ "DWORD" "dwFlags" }
{ { "TCHAR" CCHDEVICENAME } "szDevice" } ;
TYPEDEF: MONITORINFOEX* LPMONITORINFOEX
TYPEDEF: MONITORINFOEX* LPMONITORINFO
CONSTANT: MONITOR_DEFAULTTONULL 0
CONSTANT: MONITOR_DEFAULTTOPRIMARY 1
CONSTANT: MONITOR_DEFAULTTONEAREST 2
CONSTANT: MONITORINFOF_PRIMARY 1
CONSTANT: SWP_NOSIZE 1
CONSTANT: SWP_NOMOVE 2
CONSTANT: SWP_NOZORDER 4
CONSTANT: SWP_NOREDRAW 8
CONSTANT: SWP_NOACTIVATE 16
CONSTANT: SWP_FRAMECHANGED 32
CONSTANT: SWP_SHOWWINDOW 64
CONSTANT: SWP_HIDEWINDOW 128
CONSTANT: SWP_NOCOPYBITS 256
CONSTANT: SWP_NOOWNERZORDER 512
CONSTANT: SWP_NOSENDCHANGING 1024
CONSTANT: SWP_DRAWFRAME SWP_FRAMECHANGED
CONSTANT: SWP_NOREPOSITION SWP_NOOWNERZORDER
CONSTANT: SWP_DEFERERASE 8192
CONSTANT: SWP_ASYNCWINDOWPOS 16384
LIBRARY: user32
@ -910,7 +944,10 @@ ALIAS: GetMessage GetMessageW
! FUNCTION: GetMessagePos
! FUNCTION: GetMessageTime
! FUNCTION: GetMonitorInfoA
! FUNCTION: GetMonitorInfoW
FUNCTION: BOOL GetMonitorInfoW ( HMONITOR hMonitor, LPMONITORINFO lpmi ) ;
ALIAS: GetMonitorInfo GetMonitorInfoW
! FUNCTION: GetMouseMovePointsEx
! FUNCTION: GetNextDlgGroupItem
! FUNCTION: GetNextDlgTabItem
@ -961,6 +998,8 @@ FUNCTION: HWND GetWindow ( HWND hWnd, UINT uCmd ) ;
! FUNCTION: GetWindowInfo
! FUNCTION: GetWindowLongA
! FUNCTION: GetWindowLongW
FUNCTION: LONG_PTR GetWindowLongW ( HANDLE hWnd, int index ) ;
ALIAS: GetWindowLong GetWindowLongW
! FUNCTION: GetWindowModuleFileName
! FUNCTION: GetWindowModuleFileNameA
! FUNCTION: GetWindowModuleFileNameW
@ -1127,7 +1166,7 @@ ALIAS: MessageBoxEx MessageBoxExW
! FUNCTION: ModifyMenuW
! FUNCTION: MonitorFromPoint
! FUNCTION: MonitorFromRect
! FUNCTION: MonitorFromWindow
FUNCTION: HMONITOR MonitorFromWindow ( HWND hWnd, DWORD dwFlags ) ;
! FUNCTION: mouse_event
@ -1303,12 +1342,14 @@ FUNCTION: void SetLastErrorEx ( DWORD dwErrCode, DWORD dwType ) ;
! FUNCTION: SetWindowContextHelpId
! FUNCTION: SetWindowLongA
! FUNCTION: SetWindowLongW
FUNCTION: LONG_PTR SetWindowLongW ( HANDLE hWnd, int index, LONG_PTR dwNewLong ) ;
ALIAS: SetWindowLong SetWindowLongW
! FUNCTION: SetWindowPlacement
FUNCTION: BOOL SetWindowPos ( HWND hWnd, HWND hWndInsertAfter, int X, int Y, int cx, int cy, UINT uFlags ) ;
: HWND_BOTTOM ( -- alien ) 1 <alien> ;
: HWND_NOTOPMOST ( -- alien ) -2 <alien> ;
: HWND_TOP ( -- alien ) 0 <alien> ;
CONSTANT: HWND_TOP f
: HWND_TOPMOST ( -- alien ) -1 <alien> ;
! FUNCTION: SetWindowRgn

56
basis/windows/windows.factor
View File

@ -1,61 +1,5 @@
! Copyright (C) 2005, 2006 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.syntax alien.c-types alien.strings arrays
combinators kernel math namespaces parser sequences
windows.errors windows.types windows.kernel32 words
io.encodings.utf16n ;
IN: windows
: lo-word ( wparam -- lo ) <short> *short ; inline
: hi-word ( wparam -- hi ) -16 shift lo-word ; inline
CONSTANT: MAX_UNICODE_PATH 32768
! You must LocalFree the return value!
FUNCTION: void* error_message ( DWORD id ) ;
: (win32-error-string) ( n -- string )
error_message
dup utf16n alien>string
swap LocalFree drop ;
: win32-error-string ( -- str )
GetLastError (win32-error-string) ;
: (win32-error) ( n -- )
dup zero? [
drop
] [
win32-error-string throw
] if ;
: win32-error ( -- )
GetLastError (win32-error) ;
: win32-error=0/f ( n -- ) { 0 f } member? [ win32-error ] when ;
: win32-error>0 ( n -- ) 0 > [ win32-error ] when ;
: win32-error<0 ( n -- ) 0 < [ win32-error ] when ;
: win32-error<>0 ( n -- ) zero? [ win32-error ] unless ;
: invalid-handle? ( handle -- )
INVALID_HANDLE_VALUE = [
win32-error-string throw
] when ;
: expected-io-errors ( -- seq )
ERROR_SUCCESS
ERROR_IO_INCOMPLETE
ERROR_IO_PENDING
WAIT_TIMEOUT 4array ; foldable
: expected-io-error? ( error-code -- ? )
expected-io-errors member? ;
: expected-io-error ( error-code -- )
dup expected-io-error? [
drop
] [
(win32-error-string) throw
] if ;
: io-error ( return-value -- )
{ 0 f } member? [ GetLastError expected-io-error ] when ;

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