Merge branch 'master' into abi-symbols
Joe Groff
commit
ef884ef7f2
14
GNUmakefile
14
GNUmakefile
|
|
@ -169,22 +169,16 @@ macosx.app: factor
|
|||
mkdir -p $(BUNDLE)/Contents/Frameworks
|
||||
mv $(EXECUTABLE) $(BUNDLE)/Contents/MacOS/factor
|
||||
ln -s Factor.app/Contents/MacOS/factor ./factor
|
||||
cp $(ENGINE) $(BUNDLE)/Contents/Frameworks/$(ENGINE)
|
||||
|
||||
install_name_tool \
|
||||
-change libfactor.dylib \
|
||||
@executable_path/../Frameworks/libfactor.dylib \
|
||||
Factor.app/Contents/MacOS/factor
|
||||
|
||||
$(ENGINE): $(DLL_OBJS)
|
||||
$(TOOLCHAIN_PREFIX)$(LINKER) $(ENGINE) $(DLL_OBJS)
|
||||
|
||||
factor: $(EXE_OBJS) $(ENGINE)
|
||||
$(TOOLCHAIN_PREFIX)$(CPP) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
|
||||
factor: $(EXE_OBJS) $(DLL_OBJS)
|
||||
$(TOOLCHAIN_PREFIX)$(CPP) $(LIBS) $(LIBPATH) -L. $(DLL_OBJS) \
|
||||
$(CFLAGS) -o $(EXECUTABLE) $(EXE_OBJS)
|
||||
|
||||
factor-console: $(EXE_OBJS) $(ENGINE)
|
||||
$(TOOLCHAIN_PREFIX)$(CPP) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
|
||||
factor-console: $(EXE_OBJS) $(DLL_OBJS)
|
||||
$(TOOLCHAIN_PREFIX)$(CPP) $(LIBS) $(LIBPATH) -L. $(DLL_OBJS) \
|
||||
$(CFLAGS) $(CFLAGS_CONSOLE) -o $(CONSOLE_EXECUTABLE) $(EXE_OBJS)
|
||||
|
||||
factor-ffi-test: $(FFI_TEST_LIBRARY)
|
||||
|
|
|
|||
|
|
@ -60,6 +60,8 @@ $nl
|
|||
}
|
||||
"You must always free pointers returned by any of the above words when the block of memory is no longer in use:"
|
||||
{ $subsections free }
|
||||
"The above words record memory allocations, to help catch double frees and track down memory leaks with " { $link "tools.destructors" } ". To free memory allocated by a C library, another word can be used:"
|
||||
{ $subsections (free) }
|
||||
"Utilities for automatically freeing memory in conjunction with " { $link with-destructors } ":"
|
||||
{ $subsections
|
||||
&free
|
||||
|
|
@ -148,9 +150,9 @@ $nl
|
|||
}
|
||||
"The first allocates " { $link byte-array } "s, and the latter allocates manually-managed memory which is not moved by the garbage collector and has to be explicitly freed by calling " { $link free } ". See " { $link "byte-arrays-gc" } " for a discussion of the two approaches."
|
||||
$nl
|
||||
"The C type " { $link char } { $snippet "*" } " represents a generic pointer to " { $snippet "char" } "; arguments with this type will expect and return " { $link alien } "s, and won't perform any implicit string conversion."
|
||||
"The C type " { $snippet "char*" } " represents a generic pointer to " { $snippet "char" } "; arguments with this type will expect and return " { $link alien } "s, and won't perform any implicit string conversion."
|
||||
$nl
|
||||
"A word to read strings from arbitrary addresses:"
|
||||
{ $subsections alien>string }
|
||||
"For example, if a C function returns a " { $link c-string } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "char*" } " and call one of the above words before passing the pointer to " { $link free } "." ;
|
||||
"For example, if a C function returns a " { $link c-string } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "char*" } " and call " { $link (free) } " yourself." ;
|
||||
|
||||
|
|
|
|||
|
|
@ -76,27 +76,27 @@ HELP: day-abbreviation3
|
|||
} related-words
|
||||
|
||||
HELP: average-month
|
||||
{ $values { "ratio" ratio } }
|
||||
{ $values { "value" ratio } }
|
||||
{ $description "The length of an average month averaged over 400 years. Used internally for adding an arbitrary real number of months to a timestamp." } ;
|
||||
|
||||
HELP: months-per-year
|
||||
{ $values { "integer" integer } }
|
||||
{ $values { "value" integer } }
|
||||
{ $description "Returns the number of months in a year." } ;
|
||||
|
||||
HELP: days-per-year
|
||||
{ $values { "ratio" ratio } }
|
||||
{ $values { "value" ratio } }
|
||||
{ $description "Returns the number of days in a year averaged over 400 years. Used internally for adding an arbitrary real number of days to a timestamp." } ;
|
||||
|
||||
HELP: hours-per-year
|
||||
{ $values { "ratio" ratio } }
|
||||
{ $values { "value" ratio } }
|
||||
{ $description "Returns the number of hours in a year averaged over 400 years. Used internally for adding an arbitrary real number of hours to a timestamp." } ;
|
||||
|
||||
HELP: minutes-per-year
|
||||
{ $values { "ratio" ratio } }
|
||||
{ $values { "value" ratio } }
|
||||
{ $description "Returns the number of minutes in a year averaged over 400 years. Used internally for adding an arbitrary real number of minutes to a timestamp." } ;
|
||||
|
||||
HELP: seconds-per-year
|
||||
{ $values { "integer" integer } }
|
||||
{ $values { "value" integer } }
|
||||
{ $description "Returns the number of seconds in a year averaged over 400 years. Used internally for adding an arbitrary real number of seconds to a timestamp." } ;
|
||||
|
||||
HELP: julian-day-number
|
||||
|
|
|
|||
|
|
@ -176,3 +176,13 @@ IN: calendar.tests
|
|||
[ t ] [ 1356998399 unix-time>timestamp 2013 <year-gmt> 1 seconds time- = ] unit-test
|
||||
|
||||
[ t ] [ 1500000000 random [ unix-time>timestamp timestamp>unix-time ] keep = ] unit-test
|
||||
|
||||
[ t ] [
|
||||
2009 1 29 <date> 1 months time+
|
||||
2009 3 1 <date> =
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
2008 1 29 <date> 1 months time+
|
||||
2008 2 29 <date> =
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -99,12 +99,12 @@ CONSTANT: day-abbreviations3
|
|||
: day-abbreviation3 ( n -- string )
|
||||
day-abbreviations3 nth ; inline
|
||||
|
||||
: average-month ( -- ratio ) 30+5/12 ; inline
|
||||
: months-per-year ( -- integer ) 12 ; inline
|
||||
: days-per-year ( -- ratio ) 3652425/10000 ; inline
|
||||
: hours-per-year ( -- ratio ) 876582/100 ; inline
|
||||
: minutes-per-year ( -- ratio ) 5259492/10 ; inline
|
||||
: seconds-per-year ( -- integer ) 31556952 ; inline
|
||||
CONSTANT: average-month 30+5/12
|
||||
CONSTANT: months-per-year 12
|
||||
CONSTANT: days-per-year 3652425/10000
|
||||
CONSTANT: hours-per-year 876582/100
|
||||
CONSTANT: minutes-per-year 5259492/10
|
||||
CONSTANT: seconds-per-year 31556952
|
||||
|
||||
:: julian-day-number ( year month day -- n )
|
||||
#! Returns a composite date number
|
||||
|
|
@ -200,7 +200,7 @@ GENERIC: +second ( timestamp x -- timestamp )
|
|||
[ 3 >>month 1 >>day ] when ;
|
||||
|
||||
M: integer +year ( timestamp n -- timestamp )
|
||||
[ [ + ] curry change-year adjust-leap-year ] unless-zero ;
|
||||
[ + ] curry change-year adjust-leap-year ;
|
||||
|
||||
M: real +year ( timestamp n -- timestamp )
|
||||
[ float>whole-part swapd days-per-year * +day swap +year ] unless-zero ;
|
||||
|
|
|
|||
|
|
@ -5,8 +5,7 @@ classes.struct continuations combinators compiler compiler.alien
|
|||
core-graphics.types stack-checker kernel math namespaces make
|
||||
quotations sequences strings words cocoa.runtime cocoa.types io
|
||||
macros memoize io.encodings.utf8 effects layouts libc
|
||||
libc.private lexer init core-foundation fry generalizations
|
||||
specialized-arrays ;
|
||||
lexer init core-foundation fry generalizations specialized-arrays ;
|
||||
QUALIFIED-WITH: alien.c-types c
|
||||
IN: cocoa.messages
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types alien.syntax kernel math.bitwise core-foundation ;
|
||||
USING: alien.c-types alien.syntax kernel math.bitwise core-foundation
|
||||
literals ;
|
||||
IN: core-foundation.file-descriptors
|
||||
|
||||
TYPEDEF: void* CFFileDescriptorRef
|
||||
|
|
@ -25,7 +26,7 @@ FUNCTION: void CFFileDescriptorEnableCallBacks (
|
|||
) ;
|
||||
|
||||
: enable-all-callbacks ( fd -- )
|
||||
{ kCFFileDescriptorReadCallBack kCFFileDescriptorWriteCallBack } flags
|
||||
flags{ kCFFileDescriptorReadCallBack kCFFileDescriptorWriteCallBack }
|
||||
CFFileDescriptorEnableCallBacks ;
|
||||
|
||||
: <CFFileDescriptor> ( fd callback -- handle )
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
USING: alien alien.c-types alien.destructors alien.syntax accessors
|
||||
destructors fry kernel math math.bitwise sequences libc colors
|
||||
images images.memory core-graphics.types core-foundation.utilities
|
||||
opengl.gl ;
|
||||
opengl.gl literals ;
|
||||
IN: core-graphics
|
||||
|
||||
! CGImageAlphaInfo
|
||||
|
|
@ -16,15 +16,15 @@ kCGImageAlphaFirst
|
|||
kCGImageAlphaNoneSkipLast
|
||||
kCGImageAlphaNoneSkipFirst ;
|
||||
|
||||
: kCGBitmapAlphaInfoMask ( -- n ) HEX: 1f ; inline
|
||||
: kCGBitmapFloatComponents ( -- n ) 1 8 shift ; inline
|
||||
CONSTANT: kCGBitmapAlphaInfoMask HEX: 1f
|
||||
CONSTANT: kCGBitmapFloatComponents 256
|
||||
|
||||
: kCGBitmapByteOrderMask ( -- n ) HEX: 7000 ; inline
|
||||
: kCGBitmapByteOrderDefault ( -- n ) 0 12 shift ; inline
|
||||
: kCGBitmapByteOrder16Little ( -- n ) 1 12 shift ; inline
|
||||
: kCGBitmapByteOrder32Little ( -- n ) 2 12 shift ; inline
|
||||
: kCGBitmapByteOrder16Big ( -- n ) 3 12 shift ; inline
|
||||
: kCGBitmapByteOrder32Big ( -- n ) 4 12 shift ; inline
|
||||
CONSTANT: kCGBitmapByteOrderMask HEX: 7000
|
||||
CONSTANT: kCGBitmapByteOrderDefault 0
|
||||
CONSTANT: kCGBitmapByteOrder16Little 4096
|
||||
CONSTANT: kCGBitmapByteOrder32Little 8192
|
||||
CONSTANT: kCGBitmapByteOrder16Big 12288
|
||||
CONSTANT: kCGBitmapByteOrder32Big 16384
|
||||
|
||||
: kCGBitmapByteOrder16Host ( -- n )
|
||||
little-endian?
|
||||
|
|
@ -121,8 +121,8 @@ FUNCTION: uint GetCurrentButtonState ( ) ;
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: bitmap-flags ( -- flags )
|
||||
{ kCGImageAlphaPremultipliedFirst kCGBitmapByteOrder32Host } flags ;
|
||||
: bitmap-flags ( -- n )
|
||||
kCGImageAlphaPremultipliedFirst kCGBitmapByteOrder32Host bitor ;
|
||||
|
||||
: bitmap-color-space ( -- color-space )
|
||||
CGColorSpaceCreateDeviceRGB &CGColorSpaceRelease ;
|
||||
|
|
|
|||
|
|
@ -3,7 +3,8 @@
|
|||
USING: bootstrap.image.private kernel kernel.private namespaces
|
||||
system cpu.ppc.assembler compiler.units compiler.constants math
|
||||
math.private math.ranges layouts words vocabs slots.private
|
||||
locals locals.backend generic.single.private fry sequences ;
|
||||
locals locals.backend generic.single.private fry sequences
|
||||
threads.private ;
|
||||
FROM: cpu.ppc.assembler => B ;
|
||||
IN: bootstrap.ppc
|
||||
|
||||
|
|
@ -14,6 +15,22 @@ CONSTANT: ds-reg 13
|
|||
CONSTANT: rs-reg 14
|
||||
CONSTANT: vm-reg 15
|
||||
CONSTANT: ctx-reg 16
|
||||
CONSTANT: nv-reg 17
|
||||
|
||||
: jit-call ( string -- )
|
||||
0 2 LOAD32 rc-absolute-ppc-2/2 jit-dlsym
|
||||
2 MTLR
|
||||
BLRL ;
|
||||
|
||||
: jit-call-quot ( -- )
|
||||
4 3 quot-entry-point-offset LWZ
|
||||
4 MTLR
|
||||
BLRL ;
|
||||
|
||||
: jit-jump-quot ( -- )
|
||||
4 3 quot-entry-point-offset LWZ
|
||||
4 MTCTR
|
||||
BCTR ;
|
||||
|
||||
: factor-area-size ( -- n ) 16 ;
|
||||
|
||||
|
|
@ -52,27 +69,62 @@ CONSTANT: ctx-reg 16
|
|||
saved-int-regs-size +
|
||||
saved-fp-regs-size +
|
||||
saved-vec-regs-size +
|
||||
4 +
|
||||
16 align ;
|
||||
|
||||
: old-context-save-offset ( -- n )
|
||||
432 save-at ;
|
||||
|
||||
[
|
||||
! Create stack frame
|
||||
0 MFLR
|
||||
1 1 callback-frame-size neg STWU
|
||||
0 1 callback-frame-size lr-save + STW
|
||||
|
||||
! Save all non-volatile registers
|
||||
nv-int-regs [ 4 * save-int ] each-index
|
||||
nv-fp-regs [ 8 * 80 + save-fp ] each-index
|
||||
nv-vec-regs [ 16 * 224 + save-vec ] each-index
|
||||
|
||||
! Load VM into vm-reg
|
||||
0 vm-reg LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel
|
||||
|
||||
! Save old context
|
||||
2 vm-reg vm-context-offset LWZ
|
||||
2 1 old-context-save-offset STW
|
||||
|
||||
! Switch over to the spare context
|
||||
2 vm-reg vm-spare-context-offset LWZ
|
||||
2 vm-reg vm-context-offset STW
|
||||
|
||||
! Save C callstack pointer
|
||||
1 2 context-callstack-save-offset STW
|
||||
|
||||
! Load Factor callstack pointer
|
||||
1 2 context-callstack-bottom-offset LWZ
|
||||
|
||||
! Call into Factor code
|
||||
0 2 LOAD32 rc-absolute-ppc-2/2 rt-entry-point jit-rel
|
||||
2 MTLR
|
||||
BLRL
|
||||
|
||||
! Load VM again, pointlessly
|
||||
0 vm-reg LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel
|
||||
|
||||
! Load C callstack pointer
|
||||
2 vm-reg vm-context-offset LWZ
|
||||
1 2 context-callstack-save-offset LWZ
|
||||
|
||||
! Load old context
|
||||
2 1 old-context-save-offset LWZ
|
||||
2 vm-reg vm-context-offset STW
|
||||
|
||||
! Restore non-volatile registers
|
||||
nv-vec-regs [ 16 * 224 + restore-vec ] each-index
|
||||
nv-fp-regs [ 8 * 80 + restore-fp ] each-index
|
||||
nv-int-regs [ 4 * restore-int ] each-index
|
||||
|
||||
! Tear down stack frame and return
|
||||
0 1 callback-frame-size lr-save + LWZ
|
||||
1 1 0 LWZ
|
||||
0 MTLR
|
||||
|
|
@ -92,7 +144,6 @@ CONSTANT: ctx-reg 16
|
|||
rs-reg ctx-reg context-retainstack-offset STW ;
|
||||
|
||||
: jit-restore-context ( -- )
|
||||
jit-load-context
|
||||
ds-reg ctx-reg context-datastack-offset LWZ
|
||||
rs-reg ctx-reg context-retainstack-offset LWZ ;
|
||||
|
||||
|
|
@ -267,9 +318,8 @@ CONSTANT: ctx-reg 16
|
|||
jit-save-context
|
||||
3 6 MR
|
||||
4 vm-reg MR
|
||||
0 5 LOAD32 "inline_cache_miss" rc-absolute-ppc-2/2 jit-dlsym
|
||||
5 MTLR
|
||||
BLRL
|
||||
"inline_cache_miss" jit-call
|
||||
jit-load-context
|
||||
jit-restore-context ;
|
||||
|
||||
[ jit-load-return-address jit-inline-cache-miss ]
|
||||
|
|
@ -321,10 +371,9 @@ CONSTANT: ctx-reg 16
|
|||
[
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg dup 4 SUBI
|
||||
5 3 quot-entry-point-offset LWZ
|
||||
]
|
||||
[ 5 MTLR BLRL ]
|
||||
[ 5 MTCTR BCTR ] \ (call) define-combinator-primitive
|
||||
[ jit-call-quot ]
|
||||
[ jit-jump-quot ] \ (call) define-combinator-primitive
|
||||
|
||||
[
|
||||
3 ds-reg 0 LWZ
|
||||
|
|
@ -343,14 +392,22 @@ CONSTANT: ctx-reg 16
|
|||
|
||||
! Special primitives
|
||||
[
|
||||
nv-reg 3 MR
|
||||
|
||||
3 vm-reg MR
|
||||
"begin_callback" jit-call
|
||||
|
||||
jit-load-context
|
||||
jit-restore-context
|
||||
! Save ctx->callstack_bottom
|
||||
1 ctx-reg context-callstack-bottom-offset STW
|
||||
|
||||
! Call quotation
|
||||
5 3 quot-entry-point-offset LWZ
|
||||
5 MTLR
|
||||
BLRL
|
||||
3 nv-reg MR
|
||||
jit-call-quot
|
||||
|
||||
jit-save-context
|
||||
|
||||
3 vm-reg MR
|
||||
"end_callback" jit-call
|
||||
] \ c-to-factor define-sub-primitive
|
||||
|
||||
[
|
||||
|
|
@ -362,6 +419,7 @@ CONSTANT: ctx-reg 16
|
|||
0 vm-reg LOAD32 0 rc-absolute-ppc-2/2 jit-vm
|
||||
|
||||
! Load ds and rs registers
|
||||
jit-load-context
|
||||
jit-restore-context
|
||||
|
||||
! We have changed the stack; load return address again
|
||||
|
|
@ -369,9 +427,7 @@ CONSTANT: ctx-reg 16
|
|||
0 MTLR
|
||||
|
||||
! Call quotation
|
||||
4 3 quot-entry-point-offset LWZ
|
||||
4 MTCTR
|
||||
BCTR
|
||||
jit-call-quot
|
||||
] \ unwind-native-frames define-sub-primitive
|
||||
|
||||
[
|
||||
|
|
@ -392,9 +448,7 @@ CONSTANT: ctx-reg 16
|
|||
1 3 MR
|
||||
! Call memcpy; arguments are now in the correct registers
|
||||
1 1 -64 STWU
|
||||
0 2 LOAD32 "factor_memcpy" rc-absolute-ppc-2/2 jit-dlsym
|
||||
2 MTLR
|
||||
BLRL
|
||||
"factor_memcpy" jit-call
|
||||
1 1 0 LWZ
|
||||
! Return with new callstack
|
||||
0 1 lr-save LWZ
|
||||
|
|
@ -405,13 +459,10 @@ CONSTANT: ctx-reg 16
|
|||
[
|
||||
jit-save-context
|
||||
4 vm-reg MR
|
||||
0 2 LOAD32 "lazy_jit_compile" rc-absolute-ppc-2/2 jit-dlsym
|
||||
2 MTLR
|
||||
BLRL
|
||||
5 3 quot-entry-point-offset LWZ
|
||||
"lazy_jit_compile" jit-call
|
||||
]
|
||||
[ 5 MTLR BLRL ]
|
||||
[ 5 MTCTR BCTR ]
|
||||
[ jit-call-quot ]
|
||||
[ jit-jump-quot ]
|
||||
\ lazy-jit-compile define-combinator-primitive
|
||||
|
||||
! Objects
|
||||
|
|
@ -665,9 +716,7 @@ CONSTANT: ctx-reg 16
|
|||
[ BNO ]
|
||||
[
|
||||
5 vm-reg MR
|
||||
0 6 LOAD32 func rc-absolute-ppc-2/2 jit-dlsym
|
||||
6 MTLR
|
||||
BLRL
|
||||
func jit-call
|
||||
]
|
||||
jit-conditional* ;
|
||||
|
||||
|
|
@ -689,11 +738,78 @@ CONSTANT: ctx-reg 16
|
|||
[
|
||||
4 4 tag-bits get SRAWI
|
||||
5 vm-reg MR
|
||||
0 6 LOAD32 "overflow_fixnum_multiply" rc-absolute-ppc-2/2 jit-dlsym
|
||||
6 MTLR
|
||||
BLRL
|
||||
"overflow_fixnum_multiply" jit-call
|
||||
]
|
||||
jit-conditional*
|
||||
] \ fixnum* define-sub-primitive
|
||||
|
||||
! Contexts
|
||||
: jit-switch-context ( reg -- )
|
||||
! Save ds, rs registers
|
||||
jit-save-context
|
||||
|
||||
! Make the new context the current one
|
||||
ctx-reg swap MR
|
||||
ctx-reg vm-reg vm-context-offset STW
|
||||
|
||||
! Load new stack pointer
|
||||
1 ctx-reg context-callstack-top-offset LWZ
|
||||
|
||||
! Load new ds, rs registers
|
||||
jit-restore-context ;
|
||||
|
||||
: jit-pop-context-and-param ( -- )
|
||||
3 ds-reg 0 LWZ
|
||||
3 3 alien-offset LWZ
|
||||
4 ds-reg -4 LWZ
|
||||
ds-reg ds-reg 8 SUBI ;
|
||||
|
||||
: jit-push-param ( -- )
|
||||
ds-reg ds-reg 4 ADDI
|
||||
4 ds-reg 0 STW ;
|
||||
|
||||
: jit-set-context ( -- )
|
||||
jit-pop-context-and-param
|
||||
3 jit-switch-context
|
||||
jit-push-param ;
|
||||
|
||||
[ jit-set-context ] \ (set-context) define-sub-primitive
|
||||
|
||||
: jit-pop-quot-and-param ( -- )
|
||||
3 ds-reg 0 LWZ
|
||||
4 ds-reg -4 LWZ
|
||||
ds-reg ds-reg 8 SUBI ;
|
||||
|
||||
: jit-start-context ( -- )
|
||||
! Create the new context in return-reg
|
||||
3 vm-reg MR
|
||||
"new_context" jit-call
|
||||
6 3 MR
|
||||
|
||||
jit-pop-quot-and-param
|
||||
|
||||
6 jit-switch-context
|
||||
|
||||
jit-push-param
|
||||
|
||||
jit-jump-quot ;
|
||||
|
||||
[ jit-start-context ] \ (start-context) define-sub-primitive
|
||||
|
||||
: jit-delete-current-context ( -- )
|
||||
jit-load-context
|
||||
3 vm-reg MR
|
||||
4 ctx-reg MR
|
||||
"delete_context" jit-call ;
|
||||
|
||||
[
|
||||
jit-delete-current-context
|
||||
jit-set-context
|
||||
] \ (set-context-and-delete) define-sub-primitive
|
||||
|
||||
[
|
||||
jit-delete-current-context
|
||||
jit-start-context
|
||||
] \ (start-context-and-delete) define-sub-primitive
|
||||
|
||||
[ "bootstrap.ppc" forget-vocab ] with-compilation-unit
|
||||
|
|
|
|||
|
|
@ -678,8 +678,6 @@ M: ppc %box-large-struct ( n c-type -- )
|
|||
|
||||
M:: ppc %restore-context ( temp1 temp2 -- )
|
||||
temp1 "ctx" %vm-field
|
||||
temp2 1 stack-frame get total-size>> ADDI
|
||||
temp2 temp1 "callstack-bottom" context-field-offset STW
|
||||
ds-reg temp1 "datastack" context-field-offset LWZ
|
||||
rs-reg temp1 "retainstack" context-field-offset LWZ ;
|
||||
|
||||
|
|
@ -692,14 +690,6 @@ M:: ppc %save-context ( temp1 temp2 -- )
|
|||
M: ppc %alien-invoke ( symbol dll -- )
|
||||
[ 11 ] 2dip %alien-global 11 MTLR BLRL ;
|
||||
|
||||
M: ppc %alien-callback ( quot -- )
|
||||
3 4 %restore-context
|
||||
3 swap %load-reference
|
||||
4 3 quot-entry-point-offset LWZ
|
||||
4 MTLR
|
||||
BLRL
|
||||
3 4 %save-context ;
|
||||
|
||||
M: ppc %prepare-alien-indirect ( -- )
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg ds-reg 4 SUBI
|
||||
|
|
@ -710,18 +700,6 @@ M: ppc %prepare-alien-indirect ( -- )
|
|||
M: ppc %alien-indirect ( -- )
|
||||
16 MTLR BLRL ;
|
||||
|
||||
M: ppc %callback-value ( ctype -- )
|
||||
! Save top of data stack
|
||||
3 ds-reg 0 LWZ
|
||||
3 1 0 local@ STW
|
||||
3 %load-vm-addr
|
||||
! Restore data/call/retain stacks
|
||||
"unnest_context" f %alien-invoke
|
||||
! Restore top of data stack
|
||||
3 1 0 local@ LWZ
|
||||
! Unbox former top of data stack to return registers
|
||||
unbox-return ;
|
||||
|
||||
M: ppc immediate-arithmetic? ( n -- ? ) -32768 32767 between? ;
|
||||
|
||||
M: ppc immediate-bitwise? ( n -- ? ) 0 65535 between? ;
|
||||
|
|
@ -757,14 +735,31 @@ M: ppc %box-small-struct ( c-type -- )
|
|||
4 3 4 LWZ
|
||||
3 3 0 LWZ ;
|
||||
|
||||
M: ppc %nest-context ( -- )
|
||||
M: ppc %begin-callback ( -- )
|
||||
3 %load-vm-addr
|
||||
"nest_context" f %alien-invoke ;
|
||||
"begin_callback" f %alien-invoke ;
|
||||
|
||||
M: ppc %unnest-context ( -- )
|
||||
M: ppc %alien-callback ( quot -- )
|
||||
3 4 %restore-context
|
||||
3 swap %load-reference
|
||||
4 3 quot-entry-point-offset LWZ
|
||||
4 MTLR
|
||||
BLRL
|
||||
3 4 %save-context ;
|
||||
|
||||
M: ppc %end-callback ( -- )
|
||||
3 %load-vm-addr
|
||||
"unnest_context" f %alien-invoke ;
|
||||
|
||||
M: ppc %end-callback-value ( ctype -- )
|
||||
! Save top of data stack
|
||||
12 ds-reg 0 LWZ
|
||||
%end-callback
|
||||
! Restore top of data stack
|
||||
3 12 MR
|
||||
! Unbox former top of data stack to return registers
|
||||
unbox-return ;
|
||||
|
||||
M: ppc %unbox-small-struct ( size -- )
|
||||
heap-size cell align cell /i {
|
||||
{ 1 [ %unbox-struct-1 ] }
|
||||
|
|
|
|||
|
|
@ -63,15 +63,22 @@ IN: bootstrap.x86
|
|||
rs-reg ctx-reg context-retainstack-offset [+] MOV ;
|
||||
|
||||
[
|
||||
! ctx-reg is preserved across the call because it is non-volatile
|
||||
! in the C ABI
|
||||
jit-load-vm
|
||||
jit-save-context
|
||||
! call the primitive
|
||||
ESP [] vm-reg MOV
|
||||
0 CALL rc-relative rt-dlsym jit-rel
|
||||
! restore ds, rs registers
|
||||
jit-restore-context
|
||||
] jit-primitive jit-define
|
||||
|
||||
: jit-jump-quot ( -- )
|
||||
EAX quot-entry-point-offset [+] JMP ;
|
||||
|
||||
: jit-call-quot ( -- )
|
||||
EAX quot-entry-point-offset [+] CALL ;
|
||||
|
||||
[
|
||||
jit-load-vm
|
||||
ESP [] vm-reg MOV
|
||||
|
|
@ -85,22 +92,11 @@ IN: bootstrap.x86
|
|||
jit-load-context
|
||||
jit-restore-context
|
||||
|
||||
! save C callstack pointer
|
||||
ctx-reg context-callstack-save-offset [+] ESP MOV
|
||||
|
||||
! load Factor callstack pointer
|
||||
ESP ctx-reg context-callstack-bottom-offset [+] MOV
|
||||
ESP 4 ADD
|
||||
|
||||
! call the quotation
|
||||
EAX quot-entry-point-offset [+] CALL
|
||||
jit-call-quot
|
||||
|
||||
jit-load-vm
|
||||
jit-save-context
|
||||
|
||||
! load C callstack pointer
|
||||
ESP ctx-reg context-callstack-save-offset [+] MOV
|
||||
|
||||
ESP [] vm-reg MOV
|
||||
"end_callback" jit-call
|
||||
] \ c-to-factor define-sub-primitive
|
||||
|
|
@ -109,8 +105,8 @@ IN: bootstrap.x86
|
|||
EAX ds-reg [] MOV
|
||||
ds-reg bootstrap-cell SUB
|
||||
]
|
||||
[ EAX quot-entry-point-offset [+] CALL ]
|
||||
[ EAX quot-entry-point-offset [+] JMP ]
|
||||
[ jit-call-quot ]
|
||||
[ jit-jump-quot ]
|
||||
\ (call) define-combinator-primitive
|
||||
|
||||
[
|
||||
|
|
@ -133,8 +129,7 @@ IN: bootstrap.x86
|
|||
jit-load-context
|
||||
jit-restore-context
|
||||
|
||||
! Call quotation
|
||||
EAX quot-entry-point-offset [+] JMP
|
||||
jit-jump-quot
|
||||
] \ unwind-native-frames define-sub-primitive
|
||||
|
||||
[
|
||||
|
|
@ -175,8 +170,8 @@ IN: bootstrap.x86
|
|||
! Call VM
|
||||
"lazy_jit_compile" jit-call
|
||||
]
|
||||
[ EAX quot-entry-point-offset [+] CALL ]
|
||||
[ EAX quot-entry-point-offset [+] JMP ]
|
||||
[ jit-call-quot ]
|
||||
[ jit-jump-quot ]
|
||||
\ lazy-jit-compile define-combinator-primitive
|
||||
|
||||
! Inline cache miss entry points
|
||||
|
|
@ -247,8 +242,8 @@ IN: bootstrap.x86
|
|||
jit-conditional
|
||||
] \ fixnum* define-sub-primitive
|
||||
|
||||
! Threads
|
||||
: jit-set-context ( reg -- )
|
||||
! Contexts
|
||||
: jit-switch-context ( reg -- )
|
||||
! Save ds, rs registers
|
||||
jit-load-vm
|
||||
jit-save-context
|
||||
|
|
@ -263,7 +258,26 @@ IN: bootstrap.x86
|
|||
! Load new ds, rs registers
|
||||
jit-restore-context ;
|
||||
|
||||
[
|
||||
: jit-set-context ( -- )
|
||||
! Load context and parameter from datastack
|
||||
EAX ds-reg [] MOV
|
||||
EAX EAX alien-offset [+] MOV
|
||||
EBX ds-reg -4 [+] MOV
|
||||
ds-reg 8 SUB
|
||||
|
||||
! Make the new context active
|
||||
EAX jit-switch-context
|
||||
|
||||
! Twiddle stack for return
|
||||
ESP 4 ADD
|
||||
|
||||
! Store parameter to datastack
|
||||
ds-reg 4 ADD
|
||||
ds-reg [] EBX MOV ;
|
||||
|
||||
[ jit-set-context ] \ (set-context) define-sub-primitive
|
||||
|
||||
: jit-start-context ( -- )
|
||||
! Create the new context in return-reg
|
||||
jit-load-vm
|
||||
ESP [] vm-reg MOV
|
||||
|
|
@ -274,7 +288,7 @@ IN: bootstrap.x86
|
|||
ds-reg 8 SUB
|
||||
|
||||
! Make the new context active
|
||||
EAX jit-set-context
|
||||
EAX jit-switch-context
|
||||
|
||||
! Push parameter
|
||||
EAX EBX -4 [+] MOV
|
||||
|
|
@ -283,26 +297,26 @@ IN: bootstrap.x86
|
|||
|
||||
! Jump to initial quotation
|
||||
EAX EBX [] MOV
|
||||
EAX quot-entry-point-offset [+] JMP
|
||||
] \ (start-context) define-sub-primitive
|
||||
jit-jump-quot ;
|
||||
|
||||
[ jit-start-context ] \ (start-context) define-sub-primitive
|
||||
|
||||
: jit-delete-current-context ( -- )
|
||||
jit-load-vm
|
||||
jit-load-context
|
||||
ESP [] vm-reg MOV
|
||||
ESP 4 [+] ctx-reg MOV
|
||||
"delete_context" jit-call ;
|
||||
|
||||
[
|
||||
! Load context and parameter from datastack
|
||||
EAX ds-reg [] MOV
|
||||
EAX EAX alien-offset [+] MOV
|
||||
EBX ds-reg -4 [+] MOV
|
||||
ds-reg 8 SUB
|
||||
jit-delete-current-context
|
||||
jit-set-context
|
||||
] \ (set-context-and-delete) define-sub-primitive
|
||||
|
||||
! Make the new context active
|
||||
EAX jit-set-context
|
||||
|
||||
! Twiddle stack for return
|
||||
ESP 4 ADD
|
||||
|
||||
! Store parameter to datastack
|
||||
ds-reg 4 ADD
|
||||
ds-reg [] EBX MOV
|
||||
] \ (set-context) define-sub-primitive
|
||||
[
|
||||
jit-delete-current-context
|
||||
jit-start-context
|
||||
] \ (start-context-and-delete) define-sub-primitive
|
||||
|
||||
<< "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >>
|
||||
call
|
||||
|
|
|
|||
|
|
@ -57,11 +57,12 @@ IN: bootstrap.x86
|
|||
ctx-reg context-retainstack-offset [+] rs-reg MOV ;
|
||||
|
||||
: jit-restore-context ( -- )
|
||||
jit-load-context
|
||||
ds-reg ctx-reg context-datastack-offset [+] MOV
|
||||
rs-reg ctx-reg context-retainstack-offset [+] MOV ;
|
||||
|
||||
[
|
||||
! ctx-reg is preserved across the call because it is non-volatile
|
||||
! in the C ABI
|
||||
jit-save-context
|
||||
! call the primitive
|
||||
arg1 vm-reg MOV
|
||||
|
|
@ -70,30 +71,25 @@ IN: bootstrap.x86
|
|||
jit-restore-context
|
||||
] jit-primitive jit-define
|
||||
|
||||
: jit-jump-quot ( -- ) arg1 quot-entry-point-offset [+] JMP ;
|
||||
|
||||
: jit-call-quot ( -- ) arg1 quot-entry-point-offset [+] CALL ;
|
||||
|
||||
[
|
||||
nv-reg arg1 MOV
|
||||
|
||||
arg1 vm-reg MOV
|
||||
"begin_callback" jit-call
|
||||
|
||||
jit-load-context
|
||||
jit-restore-context
|
||||
|
||||
! save C callstack pointer
|
||||
ctx-reg context-callstack-save-offset [+] stack-reg MOV
|
||||
|
||||
! load Factor callstack pointer
|
||||
stack-reg ctx-reg context-callstack-bottom-offset [+] MOV
|
||||
stack-reg 8 ADD
|
||||
|
||||
! call the quotation
|
||||
arg1 nv-reg MOV
|
||||
arg1 quot-entry-point-offset [+] CALL
|
||||
jit-call-quot
|
||||
|
||||
jit-save-context
|
||||
|
||||
! load C callstack pointer
|
||||
stack-reg ctx-reg context-callstack-save-offset [+] MOV
|
||||
|
||||
arg1 vm-reg MOV
|
||||
"end_callback" jit-call
|
||||
] \ c-to-factor define-sub-primitive
|
||||
|
|
@ -102,8 +98,8 @@ IN: bootstrap.x86
|
|||
arg1 ds-reg [] MOV
|
||||
ds-reg bootstrap-cell SUB
|
||||
]
|
||||
[ arg1 quot-entry-point-offset [+] CALL ]
|
||||
[ arg1 quot-entry-point-offset [+] JMP ]
|
||||
[ jit-call-quot ]
|
||||
[ jit-jump-quot ]
|
||||
\ (call) define-combinator-primitive
|
||||
|
||||
[
|
||||
|
|
@ -121,10 +117,11 @@ IN: bootstrap.x86
|
|||
vm-reg 0 MOV 0 rc-absolute-cell jit-vm
|
||||
|
||||
! Load ds and rs registers
|
||||
jit-load-context
|
||||
jit-restore-context
|
||||
|
||||
! Call quotation
|
||||
arg1 quot-entry-point-offset [+] JMP
|
||||
jit-jump-quot
|
||||
] \ unwind-native-frames define-sub-primitive
|
||||
|
||||
[
|
||||
|
|
@ -157,9 +154,10 @@ IN: bootstrap.x86
|
|||
jit-save-context
|
||||
arg2 vm-reg MOV
|
||||
"lazy_jit_compile" jit-call
|
||||
arg1 return-reg MOV
|
||||
]
|
||||
[ return-reg quot-entry-point-offset [+] CALL ]
|
||||
[ return-reg quot-entry-point-offset [+] JMP ]
|
||||
[ jit-jump-quot ]
|
||||
\ lazy-jit-compile define-combinator-primitive
|
||||
|
||||
! Inline cache miss entry points
|
||||
|
|
@ -173,6 +171,7 @@ IN: bootstrap.x86
|
|||
arg1 RBX MOV
|
||||
arg2 vm-reg MOV
|
||||
"inline_cache_miss" jit-call
|
||||
jit-load-context
|
||||
jit-restore-context ;
|
||||
|
||||
[ jit-load-return-address jit-inline-cache-miss ]
|
||||
|
|
@ -222,8 +221,8 @@ IN: bootstrap.x86
|
|||
jit-conditional
|
||||
] \ fixnum* define-sub-primitive
|
||||
|
||||
! Threads
|
||||
: jit-set-context ( reg -- )
|
||||
! Contexts
|
||||
: jit-switch-context ( reg -- )
|
||||
! Save ds, rs registers
|
||||
jit-save-context
|
||||
|
||||
|
|
@ -237,44 +236,59 @@ IN: bootstrap.x86
|
|||
! Load new ds, rs registers
|
||||
jit-restore-context ;
|
||||
|
||||
[
|
||||
: jit-pop-context-and-param ( -- )
|
||||
arg1 ds-reg [] MOV
|
||||
arg1 arg1 alien-offset [+] MOV
|
||||
arg2 ds-reg -8 [+] MOV
|
||||
ds-reg 16 SUB ;
|
||||
|
||||
: jit-push-param ( -- )
|
||||
ds-reg 8 ADD
|
||||
ds-reg [] arg2 MOV ;
|
||||
|
||||
: jit-set-context ( -- )
|
||||
jit-pop-context-and-param
|
||||
arg1 jit-switch-context
|
||||
RSP 8 ADD
|
||||
jit-push-param ;
|
||||
|
||||
[ jit-set-context ] \ (set-context) define-sub-primitive
|
||||
|
||||
: jit-pop-quot-and-param ( -- )
|
||||
arg1 ds-reg [] MOV
|
||||
arg2 ds-reg -8 [+] MOV
|
||||
ds-reg 16 SUB ;
|
||||
|
||||
: jit-start-context ( -- )
|
||||
! Create the new context in return-reg
|
||||
arg1 vm-reg MOV
|
||||
"new_context" jit-call
|
||||
|
||||
! Load quotation and parameter from datastack
|
||||
arg1 ds-reg [] MOV
|
||||
arg2 ds-reg -8 [+] MOV
|
||||
ds-reg 16 SUB
|
||||
jit-pop-quot-and-param
|
||||
|
||||
! Make the new context active
|
||||
return-reg jit-set-context
|
||||
return-reg jit-switch-context
|
||||
|
||||
! Push parameter
|
||||
ds-reg 8 ADD
|
||||
ds-reg [] arg2 MOV
|
||||
jit-push-param
|
||||
|
||||
! Jump to initial quotation
|
||||
arg1 quot-entry-point-offset [+] JMP
|
||||
] \ (start-context) define-sub-primitive
|
||||
jit-jump-quot ;
|
||||
|
||||
[ jit-start-context ] \ (start-context) define-sub-primitive
|
||||
|
||||
: jit-delete-current-context ( -- )
|
||||
jit-load-context
|
||||
arg1 vm-reg MOV
|
||||
arg2 ctx-reg MOV
|
||||
"delete_context" jit-call ;
|
||||
|
||||
[
|
||||
! Load context and parameter from datastack
|
||||
temp0 ds-reg [] MOV
|
||||
temp0 temp0 alien-offset [+] MOV
|
||||
temp1 ds-reg -8 [+] MOV
|
||||
ds-reg 16 SUB
|
||||
jit-delete-current-context
|
||||
jit-set-context
|
||||
] \ (set-context-and-delete) define-sub-primitive
|
||||
|
||||
! Make the new context active
|
||||
temp0 jit-set-context
|
||||
|
||||
! Twiddle stack for return
|
||||
RSP 8 ADD
|
||||
|
||||
! Store parameter to datastack
|
||||
ds-reg 8 ADD
|
||||
ds-reg [] temp1 MOV
|
||||
] \ (set-context) define-sub-primitive
|
||||
[
|
||||
jit-delete-current-context
|
||||
jit-start-context
|
||||
] \ (start-context-and-delete) define-sub-primitive
|
||||
|
||||
<< "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >>
|
||||
call
|
||||
|
|
|
|||
|
|
@ -164,3 +164,5 @@ IN: cpu.x86.assembler.tests
|
|||
|
||||
[ { 15 183 195 } ] [ [ EAX BX MOVZX ] { } make ] unit-test
|
||||
|
||||
[ { 100 199 5 0 0 0 0 123 0 0 0 } ] [ [ 0 [] FS 123 MOV ] { } make ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -188,6 +188,13 @@ M: register displacement, drop ;
|
|||
|
||||
PRIVATE>
|
||||
|
||||
! Segment override prefixes
|
||||
: CS ( -- ) HEX: 2e , ;
|
||||
: ES ( -- ) HEX: 26 , ;
|
||||
: SS ( -- ) HEX: 36 , ;
|
||||
: FS ( -- ) HEX: 64 , ;
|
||||
: GS ( -- ) HEX: 65 , ;
|
||||
|
||||
! Moving stuff
|
||||
GENERIC: PUSH ( op -- )
|
||||
M: register PUSH f HEX: 50 short-operand ;
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
USING: accessors alien.c-types combinators destructors
|
||||
io.backend.unix kernel math.bitwise sequences
|
||||
specialized-arrays unix unix.kqueue unix.time assocs
|
||||
io.backend.unix.multiplexers classes.struct ;
|
||||
io.backend.unix.multiplexers classes.struct literals ;
|
||||
SPECIALIZED-ARRAY: kevent
|
||||
IN: io.backend.unix.multiplexers.kqueue
|
||||
|
||||
|
|
@ -31,13 +31,13 @@ M: kqueue-mx dispose* fd>> close-file ;
|
|||
|
||||
M: kqueue-mx add-input-callback ( thread fd mx -- )
|
||||
[ call-next-method ] [
|
||||
[ EVFILT_READ { EV_ADD EV_ONESHOT } flags make-kevent ] dip
|
||||
[ EVFILT_READ flags{ EV_ADD EV_ONESHOT } make-kevent ] dip
|
||||
register-kevent
|
||||
] 2bi ;
|
||||
|
||||
M: kqueue-mx add-output-callback ( thread fd mx -- )
|
||||
[ call-next-method ] [
|
||||
[ EVFILT_WRITE { EV_ADD EV_ONESHOT } flags make-kevent ] dip
|
||||
[ EVFILT_WRITE flags{ EV_ADD EV_ONESHOT } make-kevent ] dip
|
||||
register-kevent
|
||||
] 2bi ;
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@ USING: alien alien.c-types alien.data alien.syntax arrays continuations
|
|||
destructors generic io.mmap io.ports io.backend.windows io.files.windows
|
||||
kernel libc locals math math.bitwise namespaces quotations sequences windows
|
||||
windows.advapi32 windows.kernel32 windows.types io.backend system accessors
|
||||
io.backend.windows.privileges classes.struct windows.errors ;
|
||||
io.backend.windows.privileges classes.struct windows.errors literals ;
|
||||
IN: io.backend.windows.nt.privileges
|
||||
|
||||
TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
|
||||
|
|
@ -11,7 +11,7 @@ TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
|
|||
! http://msdn.microsoft.com/msdnmag/issues/05/03/TokenPrivileges/
|
||||
|
||||
: (open-process-token) ( handle -- handle )
|
||||
{ TOKEN_ADJUST_PRIVILEGES TOKEN_QUERY } flags PHANDLE <c-object>
|
||||
flags{ TOKEN_ADJUST_PRIVILEGES TOKEN_QUERY } PHANDLE <c-object>
|
||||
[ OpenProcessToken win32-error=0/f ] keep *void* ;
|
||||
|
||||
: open-process-token ( -- handle )
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ io.buffers io.files io.ports io.binary io.timeouts system
|
|||
strings kernel math namespaces sequences windows.errors
|
||||
windows.kernel32 windows.shell32 windows.types splitting
|
||||
continuations math.bitwise accessors init sets assocs
|
||||
classes.struct classes ;
|
||||
classes.struct classes literals ;
|
||||
IN: io.backend.windows
|
||||
|
||||
TUPLE: win32-handle < disposable handle ;
|
||||
|
|
@ -43,12 +43,12 @@ HOOK: add-completion io-backend ( port -- )
|
|||
<win32-file> |dispose
|
||||
dup add-completion ;
|
||||
|
||||
: share-mode ( -- n )
|
||||
{
|
||||
CONSTANT: share-mode
|
||||
flags{
|
||||
FILE_SHARE_READ
|
||||
FILE_SHARE_WRITE
|
||||
FILE_SHARE_DELETE
|
||||
} flags ; foldable
|
||||
}
|
||||
|
||||
: default-security-attributes ( -- obj )
|
||||
SECURITY_ATTRIBUTES <struct>
|
||||
|
|
|
|||
|
|
@ -4,11 +4,10 @@ USING: accessors alien.c-types alien.strings combinators
|
|||
continuations destructors fry io io.backend io.backend.unix
|
||||
io.directories io.encodings.binary io.encodings.utf8 io.files
|
||||
io.pathnames io.files.types kernel math.bitwise sequences system
|
||||
unix unix.stat vocabs.loader classes.struct unix.ffi ;
|
||||
unix unix.stat vocabs.loader classes.struct unix.ffi literals ;
|
||||
IN: io.directories.unix
|
||||
|
||||
: touch-mode ( -- n )
|
||||
{ O_WRONLY O_APPEND O_CREAT O_EXCL } flags ; foldable
|
||||
CONSTANT: touch-mode flags{ O_WRONLY O_APPEND O_CREAT O_EXCL }
|
||||
|
||||
M: unix touch-file ( path -- )
|
||||
normalize-path
|
||||
|
|
|
|||
|
|
@ -54,12 +54,19 @@ HELP: with-unique-directory
|
|||
}
|
||||
{ $description "Creates a directory with " { $link unique-directory } " and calls the quotation with the pathname on the stack using the " { $link with-temporary-directory } " combinator. The quotation can access the " { $link current-temporary-directory } " symbol for the name of the temporary directory. Subsequent unique files will be created in this unique directory until the combinator returns." } ;
|
||||
|
||||
HELP: move-file-unique
|
||||
HELP: copy-file-unique
|
||||
{ $values
|
||||
{ "path" "a pathname string" } { "directory" "a directory" }
|
||||
{ "path" "a pathname string" } { "prefix" string } { "suffix" string }
|
||||
{ "path'" "a pathname string" }
|
||||
}
|
||||
{ $description "Moves " { $snippet "path" } " to " { $snippet "directory" } " by creating a unique file in this directory. Returns the new path." } ;
|
||||
{ $description "Copies " { $snippet "path" } " to a new unique file in the directory stored in " { $link current-temporary-directory } ". Returns the new path." } ;
|
||||
|
||||
HELP: move-file-unique
|
||||
{ $values
|
||||
{ "path" "a pathname string" } { "prefix" string } { "suffix" string }
|
||||
{ "path'" "a pathname string" }
|
||||
}
|
||||
{ $description "Moves " { $snippet "path" } " to a new unique file in the directory stored in " { $link current-temporary-directory } ". Returns the new path." } ;
|
||||
|
||||
HELP: current-temporary-directory
|
||||
{ $values
|
||||
|
|
@ -98,7 +105,10 @@ ARTICLE: "io.files.unique" "Unique files"
|
|||
}
|
||||
"Default temporary directory:"
|
||||
{ $subsections default-temporary-directory }
|
||||
"Moving files into a directory safely:"
|
||||
{ $subsections move-file-unique } ;
|
||||
"Copying and moving files to a new unique file:"
|
||||
{ $subsections
|
||||
copy-file-unique
|
||||
move-file-unique
|
||||
} ;
|
||||
|
||||
ABOUT: "io.files.unique"
|
||||
|
|
|
|||
|
|
@ -70,10 +70,17 @@ PRIVATE>
|
|||
: unique-file ( prefix -- path )
|
||||
"" make-unique-file ;
|
||||
|
||||
: move-file-unique ( path directory -- path' )
|
||||
[
|
||||
"" unique-file [ move-file ] keep
|
||||
] with-temporary-directory ;
|
||||
: move-file-unique ( path prefix suffix -- path' )
|
||||
make-unique-file [ move-file ] keep ;
|
||||
|
||||
: copy-file-unique ( path prefix suffix -- path' )
|
||||
make-unique-file [ copy-file ] keep ;
|
||||
|
||||
: temporary-file ( -- path ) "" unique-file ;
|
||||
|
||||
: with-working-directory ( path quot -- )
|
||||
over make-directories
|
||||
dupd '[ _ _ with-temporary-directory ] with-directory ; inline
|
||||
|
||||
{
|
||||
{ [ os unix? ] [ "io.files.unique.unix" ] }
|
||||
|
|
|
|||
|
|
@ -1,11 +1,10 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel io.ports io.backend.unix math.bitwise
|
||||
unix system io.files.unique unix.ffi ;
|
||||
unix system io.files.unique unix.ffi literals ;
|
||||
IN: io.files.unique.unix
|
||||
|
||||
: open-unique-flags ( -- flags )
|
||||
{ O_RDWR O_CREAT O_EXCL } flags ;
|
||||
CONSTANT: open-unique-flags flags{ O_RDWR O_CREAT O_EXCL }
|
||||
|
||||
M: unix (touch-unique-file) ( path -- )
|
||||
open-unique-flags file-mode open-file close-file ;
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@ USING: tools.test io.files io.files.temp io.pathnames
|
|||
io.directories io.files.info io.files.info.unix continuations
|
||||
kernel io.files.unix math.bitwise calendar accessors
|
||||
math.functions math unix.users unix.groups arrays sequences
|
||||
grouping io.pathnames.private ;
|
||||
grouping io.pathnames.private literals ;
|
||||
IN: io.files.unix.tests
|
||||
|
||||
[ "/usr/libexec/" ] [ "/usr/libexec/awk/" parent-directory ] unit-test
|
||||
|
|
@ -45,7 +45,7 @@ IN: io.files.unix.tests
|
|||
prepare-test-file
|
||||
|
||||
[ t ]
|
||||
[ test-file { USER-ALL GROUP-ALL OTHER-ALL } flags set-file-permissions perms OCT: 777 = ] unit-test
|
||||
[ test-file flags{ USER-ALL GROUP-ALL OTHER-ALL } set-file-permissions perms OCT: 777 = ] unit-test
|
||||
|
||||
[ t ] [ test-file user-read? ] unit-test
|
||||
[ t ] [ test-file user-write? ] unit-test
|
||||
|
|
@ -85,7 +85,7 @@ prepare-test-file
|
|||
[ f ] [ test-file file-info other-read? ] unit-test
|
||||
|
||||
[ t ]
|
||||
[ test-file { USER-ALL GROUP-ALL OTHER-EXECUTE } flags set-file-permissions perms OCT: 771 = ] unit-test
|
||||
[ test-file flags{ USER-ALL GROUP-ALL OTHER-EXECUTE } set-file-permissions perms OCT: 771 = ] unit-test
|
||||
|
||||
prepare-test-file
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: unix byte-arrays kernel io.backend.unix math.bitwise
|
||||
io.ports io.files io.files.private io.pathnames environment
|
||||
destructors system unix.ffi ;
|
||||
destructors system unix.ffi literals ;
|
||||
IN: io.files.unix
|
||||
|
||||
M: unix cwd ( -- path )
|
||||
|
|
@ -12,15 +12,14 @@ M: unix cwd ( -- path )
|
|||
|
||||
M: unix cd ( path -- ) [ chdir ] unix-system-call drop ;
|
||||
|
||||
: read-flags ( -- n ) O_RDONLY ; inline
|
||||
CONSTANT: read-flags flags{ O_RDONLY }
|
||||
|
||||
: open-read ( path -- fd ) O_RDONLY file-mode open-file ;
|
||||
: open-read ( path -- fd ) read-flags file-mode open-file ;
|
||||
|
||||
M: unix (file-reader) ( path -- stream )
|
||||
open-read <fd> init-fd <input-port> ;
|
||||
|
||||
: write-flags ( -- n )
|
||||
{ O_WRONLY O_CREAT O_TRUNC } flags ; inline
|
||||
CONSTANT: write-flags flags{ O_WRONLY O_CREAT O_TRUNC }
|
||||
|
||||
: open-write ( path -- fd )
|
||||
write-flags file-mode open-file ;
|
||||
|
|
@ -28,8 +27,7 @@ M: unix (file-reader) ( path -- stream )
|
|||
M: unix (file-writer) ( path -- stream )
|
||||
open-write <fd> init-fd <output-port> ;
|
||||
|
||||
: append-flags ( -- n )
|
||||
{ O_WRONLY O_APPEND O_CREAT } flags ; inline
|
||||
CONSTANT: append-flags flags{ O_WRONLY O_APPEND O_CREAT }
|
||||
|
||||
: open-append ( path -- fd )
|
||||
[
|
||||
|
|
|
|||
|
|
@ -6,7 +6,8 @@ io.backend.windows kernel math splitting fry alien.strings
|
|||
windows windows.kernel32 windows.time windows.types calendar
|
||||
combinators math.functions sequences namespaces make words
|
||||
system destructors accessors math.bitwise continuations
|
||||
windows.errors arrays byte-arrays generalizations alien.data ;
|
||||
windows.errors arrays byte-arrays generalizations alien.data
|
||||
literals ;
|
||||
IN: io.files.windows
|
||||
|
||||
: open-file ( path access-mode create-mode flags -- handle )
|
||||
|
|
@ -16,7 +17,7 @@ IN: io.files.windows
|
|||
] with-destructors ;
|
||||
|
||||
: open-r/w ( path -- win32-file )
|
||||
{ GENERIC_READ GENERIC_WRITE } flags
|
||||
flags{ GENERIC_READ GENERIC_WRITE }
|
||||
OPEN_EXISTING 0 open-file ;
|
||||
|
||||
: open-read ( path -- win32-file )
|
||||
|
|
@ -29,7 +30,7 @@ IN: io.files.windows
|
|||
GENERIC_WRITE OPEN_ALWAYS 0 open-file ;
|
||||
|
||||
: open-existing ( path -- win32-file )
|
||||
{ GENERIC_READ GENERIC_WRITE } flags
|
||||
flags{ GENERIC_READ GENERIC_WRITE }
|
||||
share-mode
|
||||
f
|
||||
OPEN_EXISTING
|
||||
|
|
@ -38,7 +39,7 @@ IN: io.files.windows
|
|||
|
||||
: maybe-create-file ( path -- win32-file ? )
|
||||
#! return true if file was just created
|
||||
{ GENERIC_READ GENERIC_WRITE } flags
|
||||
flags{ GENERIC_READ GENERIC_WRITE }
|
||||
share-mode
|
||||
f
|
||||
OPEN_ALWAYS
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2007 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors destructors io.backend.unix io.mmap
|
||||
USING: accessors destructors io.backend.unix io.mmap literals
|
||||
io.mmap.private kernel locals math.bitwise system unix unix.ffi ;
|
||||
IN: io.mmap.unix
|
||||
|
||||
|
|
@ -12,13 +12,13 @@ IN: io.mmap.unix
|
|||
] with-destructors ;
|
||||
|
||||
M: unix (mapped-file-r/w)
|
||||
{ PROT_READ PROT_WRITE } flags
|
||||
{ MAP_FILE MAP_SHARED } flags
|
||||
flags{ PROT_READ PROT_WRITE }
|
||||
flags{ MAP_FILE MAP_SHARED }
|
||||
O_RDWR mmap-open ;
|
||||
|
||||
M: unix (mapped-file-reader)
|
||||
{ PROT_READ } flags
|
||||
{ MAP_FILE MAP_SHARED } flags
|
||||
flags{ PROT_READ }
|
||||
flags{ MAP_FILE MAP_SHARED }
|
||||
O_RDONLY mmap-open ;
|
||||
|
||||
M: unix close-mapped-file ( mmap -- )
|
||||
|
|
|
|||
|
|
@ -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
|
||||
io.mmap.private kernel libc math math.bitwise namespaces quotations sequences
|
||||
windows windows.advapi32 windows.kernel32 io.backend system
|
||||
accessors locals windows.errors ;
|
||||
accessors locals windows.errors literals ;
|
||||
IN: io.mmap.windows
|
||||
|
||||
: create-file-mapping ( hFile lpAttributes flProtect dwMaximumSizeHigh dwMaximumSizeLow lpName -- HANDLE )
|
||||
|
|
@ -29,9 +29,9 @@ C: <win32-mapped-file> win32-mapped-file
|
|||
|
||||
M: windows (mapped-file-r/w)
|
||||
[
|
||||
{ GENERIC_WRITE GENERIC_READ } flags
|
||||
flags{ GENERIC_WRITE GENERIC_READ }
|
||||
OPEN_ALWAYS
|
||||
{ PAGE_READWRITE SEC_COMMIT } flags
|
||||
flags{ PAGE_READWRITE SEC_COMMIT }
|
||||
FILE_MAP_ALL_ACCESS mmap-open
|
||||
-rot <win32-mapped-file>
|
||||
] with-destructors ;
|
||||
|
|
@ -40,7 +40,7 @@ M: windows (mapped-file-reader)
|
|||
[
|
||||
GENERIC_READ
|
||||
OPEN_ALWAYS
|
||||
{ PAGE_READONLY SEC_COMMIT } flags
|
||||
flags{ PAGE_READONLY SEC_COMMIT }
|
||||
FILE_MAP_READ mmap-open
|
||||
-rot <win32-mapped-file>
|
||||
] with-destructors ;
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ io.files io.pathnames io.buffers io.ports io.timeouts
|
|||
io.backend.unix io.encodings.utf8 unix.linux.inotify assocs
|
||||
namespaces make threads continuations init math math.bitwise
|
||||
sets alien alien.strings alien.c-types vocabs.loader accessors
|
||||
system hashtables destructors unix classes.struct ;
|
||||
system hashtables destructors unix classes.struct literals ;
|
||||
FROM: namespaces => set ;
|
||||
IN: io.monitors.linux
|
||||
|
||||
|
|
@ -65,13 +65,13 @@ M: linux-monitor dispose* ( monitor -- )
|
|||
tri ;
|
||||
|
||||
: ignore-flags? ( mask -- ? )
|
||||
{
|
||||
flags{
|
||||
IN_DELETE_SELF
|
||||
IN_MOVE_SELF
|
||||
IN_UNMOUNT
|
||||
IN_Q_OVERFLOW
|
||||
IN_IGNORED
|
||||
} flags bitand 0 > ;
|
||||
} bitand 0 > ;
|
||||
|
||||
: parse-action ( mask -- changed )
|
||||
[
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ locals kernel math assocs namespaces make continuations sequences
|
|||
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.buffers io.files io.timeouts io.encodings.string literals
|
||||
io.encodings.utf16n io windows.errors windows.kernel32 windows.types
|
||||
io.pathnames classes.struct ;
|
||||
IN: io.monitors.windows.nt
|
||||
|
|
@ -16,7 +16,7 @@ IN: io.monitors.windows.nt
|
|||
share-mode
|
||||
f
|
||||
OPEN_EXISTING
|
||||
{ FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_OVERLAPPED } flags
|
||||
flags{ FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_OVERLAPPED }
|
||||
f
|
||||
CreateFile opened-file ;
|
||||
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ IN: io.pipes.windows.nt
|
|||
! http://twistedmatrix.com/trac/browser/trunk/twisted/internet/iocpreactor/process.py
|
||||
|
||||
: create-named-pipe ( name -- handle )
|
||||
{ PIPE_ACCESS_INBOUND FILE_FLAG_OVERLAPPED } flags
|
||||
flags{ PIPE_ACCESS_INBOUND FILE_FLAG_OVERLAPPED }
|
||||
PIPE_TYPE_BYTE
|
||||
1
|
||||
4096
|
||||
|
|
@ -21,7 +21,7 @@ IN: io.pipes.windows.nt
|
|||
|
||||
: open-other-end ( name -- handle )
|
||||
GENERIC_WRITE
|
||||
{ FILE_SHARE_READ FILE_SHARE_WRITE } flags
|
||||
flags{ FILE_SHARE_READ FILE_SHARE_WRITE }
|
||||
default-security-attributes
|
||||
OPEN_EXISTING
|
||||
FILE_FLAG_OVERLAPPED
|
||||
|
|
|
|||
|
|
@ -32,6 +32,10 @@ HELP: free
|
|||
{ $values { "alien" c-ptr } }
|
||||
{ $description "Deallocates a block of memory allocated by " { $link malloc } ", " { $link calloc } " or " { $link realloc } "." } ;
|
||||
|
||||
HELP: (free)
|
||||
{ $values { "alien" c-ptr } }
|
||||
{ $description "Deallocates a block of memory allocated by an external C library." } ;
|
||||
|
||||
HELP: &free
|
||||
{ $values { "alien" c-ptr } }
|
||||
{ $description "Marks the block of memory for unconditional deallocation at the end of the current " { $link with-destructors } " scope." } ;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
! Copyright (C) 2004, 2005 Mackenzie Straight
|
||||
! Copyright (C) 2007, 2009 Slava Pestov
|
||||
! Copyright (C) 2007, 2010 Slava Pestov
|
||||
! Copyright (C) 2007, 2008 Doug Coleman
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types assocs continuations alien.destructors kernel
|
||||
|
|
@ -18,8 +18,6 @@ IN: libc
|
|||
: preserve-errno ( quot -- )
|
||||
errno [ call ] dip set-errno ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: (malloc) ( size -- alien )
|
||||
void* "libc" "malloc" { ulong } alien-invoke ;
|
||||
|
||||
|
|
@ -32,6 +30,8 @@ IN: libc
|
|||
: (realloc) ( alien size -- newalien )
|
||||
void* "libc" "realloc" { void* ulong } alien-invoke ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
! We stick malloc-ptr instances in the global disposables set
|
||||
TUPLE: malloc-ptr value continuation ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Joe Groff.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax kernel multiline ;
|
||||
USING: help.markup help.syntax kernel multiline sequences ;
|
||||
IN: literals
|
||||
|
||||
HELP: $
|
||||
|
|
@ -62,6 +62,19 @@ ${ five six 7 } .
|
|||
|
||||
{ POSTPONE: $ POSTPONE: $[ POSTPONE: ${ } related-words
|
||||
|
||||
HELP: flags{
|
||||
{ $values { "values" sequence } }
|
||||
{ $description "Constructs a constant flag value from a sequence of integers or words that output integers. The resulting constant is computed at parse-time, which makes this word as efficient as using a literal integer." }
|
||||
{ $examples
|
||||
{ $example "USING: literals kernel prettyprint ;"
|
||||
"IN: scratchpad"
|
||||
"CONSTANT: x HEX: 1"
|
||||
"flags{ HEX: 20 x BIN: 100 } .h"
|
||||
"25"
|
||||
}
|
||||
} ;
|
||||
|
||||
|
||||
ARTICLE: "literals" "Interpolating code results into literal values"
|
||||
"The " { $vocab-link "literals" } " vocabulary contains words to run code at parse time and insert the results into more complex literal values."
|
||||
{ $example """
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
USING: kernel literals math tools.test ;
|
||||
USING: accessors kernel literals math tools.test ;
|
||||
IN: literals.tests
|
||||
|
||||
<<
|
||||
|
|
@ -27,3 +27,16 @@ CONSTANT: constant-a 3
|
|||
: sixty-nine ( -- a b ) 6 9 ;
|
||||
|
||||
[ { 6 9 } ] [ ${ sixty-nine } ] unit-test
|
||||
|
||||
CONSTANT: a 1
|
||||
CONSTANT: b 2
|
||||
ALIAS: c b
|
||||
ALIAS: d c
|
||||
|
||||
CONSTANT: foo flags{ a b d }
|
||||
|
||||
[ 3 ] [ foo ] unit-test
|
||||
[ 3 ] [ flags{ a b d } ] unit-test
|
||||
\ foo def>> must-infer
|
||||
|
||||
[ 1 ] [ flags{ 1 } ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! (c) Joe Groff, see license for details
|
||||
USING: accessors continuations kernel parser words quotations
|
||||
vectors sequences fry ;
|
||||
USING: accessors combinators continuations fry kernel lexer
|
||||
math parser quotations sequences vectors words words.alias ;
|
||||
IN: literals
|
||||
|
||||
<PRIVATE
|
||||
|
|
@ -8,8 +8,13 @@ IN: literals
|
|||
! Use def>> call so that CONSTANT:s defined in the same file can
|
||||
! be called
|
||||
|
||||
: expand-alias ( obj -- obj' )
|
||||
dup alias? [ def>> first expand-alias ] when ;
|
||||
|
||||
: expand-literal ( seq obj -- seq' )
|
||||
'[ _ dup word? [ def>> call ] when ] with-datastack ;
|
||||
'[
|
||||
_ expand-alias dup word? [ def>> call ] when
|
||||
] with-datastack ;
|
||||
|
||||
: expand-literals ( seq -- seq' )
|
||||
[ [ { } ] dip expand-literal ] map concat ;
|
||||
|
|
@ -19,3 +24,8 @@ PRIVATE>
|
|||
SYNTAX: $ scan-word expand-literal >vector ;
|
||||
SYNTAX: $[ parse-quotation with-datastack >vector ;
|
||||
SYNTAX: ${ \ } [ expand-literals ] parse-literal ;
|
||||
SYNTAX: flags{
|
||||
\ } [
|
||||
expand-literals
|
||||
0 [ bitor ] reduce
|
||||
] parse-literal ;
|
||||
|
|
|
|||
|
|
@ -19,11 +19,6 @@ ERROR: local-writer-in-literal-error ;
|
|||
M: local-writer-in-literal-error summary
|
||||
drop "Local writer words not permitted inside literals" ;
|
||||
|
||||
ERROR: local-word-in-literal-error ;
|
||||
|
||||
M: local-word-in-literal-error summary
|
||||
drop "Local words not permitted inside literals" ;
|
||||
|
||||
ERROR: :>-outside-lambda-error ;
|
||||
|
||||
M: :>-outside-lambda-error summary
|
||||
|
|
|
|||
|
|
@ -24,10 +24,6 @@ SYMBOL: in-lambda?
|
|||
: parse-local-defs ( -- words assoc )
|
||||
[ "|" [ make-local ] map-tokens ] H{ } make-assoc ;
|
||||
|
||||
: make-local-word ( name def -- word )
|
||||
[ <local-word> [ dup name>> set ] [ ] [ ] tri ] dip
|
||||
"local-word-def" set-word-prop ;
|
||||
|
||||
SINGLETON: lambda-parser
|
||||
|
||||
SYMBOL: locals
|
||||
|
|
|
|||
|
|
@ -21,8 +21,6 @@ M: local localize dupd read-local-quot ;
|
|||
|
||||
M: quote localize dupd local>> read-local-quot ;
|
||||
|
||||
M: local-word localize dupd read-local-quot [ call ] append ;
|
||||
|
||||
M: local-reader localize dupd read-local-quot [ local-value ] append ;
|
||||
|
||||
M: local-writer localize
|
||||
|
|
|
|||
|
|
@ -82,9 +82,6 @@ M: local-reader rewrite-element , ;
|
|||
M: local-writer rewrite-element
|
||||
local-writer-in-literal-error ;
|
||||
|
||||
M: local-word rewrite-element
|
||||
local-word-in-literal-error ;
|
||||
|
||||
M: word rewrite-element <wrapper> , ;
|
||||
|
||||
: rewrite-wrapper ( wrapper -- )
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2007, 2009 Slava Pestov, Eduardo Cavazos.
|
||||
! Copyright (C) 2007, 2010 Slava Pestov, Eduardo Cavazos.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors combinators kernel sequences words
|
||||
quotations ;
|
||||
|
|
@ -35,11 +35,6 @@ PREDICATE: local < word "local?" word-prop ;
|
|||
|
||||
M: local literalize ;
|
||||
|
||||
PREDICATE: local-word < word "local-word?" word-prop ;
|
||||
|
||||
: <local-word> ( name -- word )
|
||||
f <word> dup t "local-word?" set-word-prop ;
|
||||
|
||||
PREDICATE: local-reader < word "local-reader?" word-prop ;
|
||||
|
||||
: <local-reader> ( name -- word )
|
||||
|
|
@ -58,5 +53,5 @@ PREDICATE: local-writer < word "local-writer?" word-prop ;
|
|||
[ nip ]
|
||||
} 2cleave ;
|
||||
|
||||
UNION: lexical local local-reader local-writer local-word ;
|
||||
UNION: lexical local local-reader local-writer ;
|
||||
UNION: special lexical quote def ;
|
||||
|
|
|
|||
|
|
@ -135,18 +135,6 @@ HELP: clear-bit
|
|||
}
|
||||
} ;
|
||||
|
||||
HELP: flags
|
||||
{ $values { "values" sequence } }
|
||||
{ $description "Constructs a constant flag value from a sequence of integers or words that output integers. The resulting constant is computed at compile-time, which makes this word as efficient as using a literal integer." }
|
||||
{ $examples
|
||||
{ $example "USING: math.bitwise kernel prettyprint ;"
|
||||
"IN: scratchpad"
|
||||
"CONSTANT: x HEX: 1"
|
||||
"{ HEX: 20 x BIN: 100 } flags .h"
|
||||
"25"
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: symbols>flags
|
||||
{ $values { "symbols" sequence } { "assoc" assoc } { "flag-bits" integer } }
|
||||
{ $description "Constructs an integer value by mapping the values in the " { $snippet "symbols" } " sequence to integer values using " { $snippet "assoc" } " and " { $link bitor } "ing the values together." }
|
||||
|
|
@ -375,6 +363,10 @@ $nl
|
|||
bit?
|
||||
bit-clear?
|
||||
}
|
||||
"Toggling a bit:"
|
||||
{ $subsections
|
||||
toggle-bit
|
||||
}
|
||||
"Operations with bitmasks:"
|
||||
{ $subsections
|
||||
mask
|
||||
|
|
@ -404,7 +396,6 @@ $nl
|
|||
}
|
||||
"Bitfields:"
|
||||
{ $subsections
|
||||
flags
|
||||
"math-bitfields"
|
||||
} ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
USING: accessors math math.bitwise tools.test kernel words
|
||||
specialized-arrays alien.c-types math.vectors.simd
|
||||
sequences destructors libc ;
|
||||
sequences destructors libc literals ;
|
||||
SPECIALIZED-ARRAY: int
|
||||
IN: math.bitwise.tests
|
||||
|
||||
|
|
@ -23,17 +23,6 @@ IN: math.bitwise.tests
|
|||
: test-1+ ( x -- y ) 1 + ;
|
||||
[ 512 ] [ 1 { { test-1+ 8 } } bitfield ] unit-test
|
||||
|
||||
CONSTANT: a 1
|
||||
CONSTANT: b 2
|
||||
|
||||
: foo ( -- flags ) { a b } flags ;
|
||||
|
||||
[ 3 ] [ foo ] unit-test
|
||||
[ 3 ] [ { a b } flags ] unit-test
|
||||
\ foo def>> must-infer
|
||||
|
||||
[ 1 ] [ { 1 } flags ] unit-test
|
||||
|
||||
[ 8 ] [ 0 3 toggle-bit ] unit-test
|
||||
[ 0 ] [ 8 3 toggle-bit ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -44,10 +44,6 @@ IN: math.bitwise
|
|||
: W- ( x y -- z ) - 64 bits ; inline
|
||||
: W* ( x y -- z ) * 64 bits ; inline
|
||||
|
||||
! flags
|
||||
MACRO: flags ( values -- )
|
||||
[ 0 ] [ [ ?execute bitor ] curry compose ] reduce ;
|
||||
|
||||
: symbols>flags ( symbols assoc -- flag-bits )
|
||||
[ at ] curry map
|
||||
0 [ bitor ] reduce ;
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ $nl
|
|||
"ui.gadgets.labels ui.gadgets.packs ui.gadgets.panes"
|
||||
"ui.gadgets.sliders ;"
|
||||
""
|
||||
": <funny-model> ( -- model ) 0 10 0 100 <range> ;"
|
||||
": <funny-model> ( -- model ) 0 10 0 100 1 <range> ;"
|
||||
": <funny-slider> ( model -- slider ) horizontal <slider> ;"
|
||||
""
|
||||
"<funny-model> <funny-model> 2array"
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types alien.syntax combinators kernel
|
||||
system namespaces assocs parser lexer sequences words
|
||||
quotations math.bitwise alien.libraries ;
|
||||
quotations math.bitwise alien.libraries literals ;
|
||||
|
||||
IN: openssl.libssl
|
||||
|
||||
|
|
@ -258,15 +258,14 @@ CONSTANT: SSL_SESS_CACHE_OFF HEX: 0000
|
|||
CONSTANT: SSL_SESS_CACHE_CLIENT HEX: 0001
|
||||
CONSTANT: SSL_SESS_CACHE_SERVER HEX: 0002
|
||||
|
||||
: SSL_SESS_CACHE_BOTH ( -- n )
|
||||
{ SSL_SESS_CACHE_CLIENT SSL_SESS_CACHE_SERVER } flags ; inline
|
||||
CONSTANT: SSL_SESS_CACHE_BOTH flags{ SSL_SESS_CACHE_CLIENT SSL_SESS_CACHE_SERVER }
|
||||
|
||||
CONSTANT: SSL_SESS_CACHE_NO_AUTO_CLEAR HEX: 0080
|
||||
CONSTANT: SSL_SESS_CACHE_NO_INTERNAL_LOOKUP HEX: 0100
|
||||
CONSTANT: SSL_SESS_CACHE_NO_INTERNAL_STORE HEX: 0200
|
||||
|
||||
: SSL_SESS_CACHE_NO_INTERNAL ( -- n )
|
||||
{ SSL_SESS_CACHE_NO_INTERNAL_LOOKUP SSL_SESS_CACHE_NO_INTERNAL_STORE } flags ; inline
|
||||
CONSTANT: SSL_SESS_CACHE_NO_INTERNAL
|
||||
flags{ SSL_SESS_CACHE_NO_INTERNAL_LOOKUP SSL_SESS_CACHE_NO_INTERNAL_STORE }
|
||||
|
||||
! ===============================================
|
||||
! x509_vfy.h
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ CONSTANT: factor-crypto-container "FactorCryptoContainer"
|
|||
] if ;
|
||||
|
||||
: create-crypto-context ( provider type -- handle )
|
||||
{ CRYPT_MACHINE_KEYSET CRYPT_NEWKEYSET } flags
|
||||
flags{ CRYPT_MACHINE_KEYSET CRYPT_NEWKEYSET }
|
||||
(acquire-crypto-context) win32-error=0/f *void* ;
|
||||
|
||||
ERROR: acquire-crypto-context-failed provider type ;
|
||||
|
|
|
|||
|
|
@ -151,13 +151,6 @@ M: bad-call summary
|
|||
: required-stack-effect ( word -- effect )
|
||||
dup stack-effect [ ] [ missing-effect ] ?if ;
|
||||
|
||||
: infer-word ( word -- )
|
||||
{
|
||||
{ [ dup macro? ] [ do-not-compile ] }
|
||||
{ [ dup "no-compile" word-prop ] [ do-not-compile ] }
|
||||
[ dup required-stack-effect apply-word/effect ]
|
||||
} cond ;
|
||||
|
||||
: with-infer ( quot -- effect visitor )
|
||||
[
|
||||
init-inference
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@ compiler.units system.private combinators
|
|||
combinators.short-circuit locals locals.backend locals.types
|
||||
combinators.private stack-checker.values generic.single
|
||||
generic.single.private alien.libraries tools.dispatch.private
|
||||
tools.profiler.private
|
||||
tools.profiler.private macros
|
||||
stack-checker.alien
|
||||
stack-checker.state
|
||||
stack-checker.errors
|
||||
|
|
@ -27,11 +27,37 @@ stack-checker.recursive-state
|
|||
stack-checker.row-polymorphism ;
|
||||
IN: stack-checker.known-words
|
||||
|
||||
: infer-primitive ( word -- )
|
||||
dup
|
||||
[ "input-classes" word-prop ]
|
||||
[ "default-output-classes" word-prop ] bi <effect>
|
||||
apply-word/effect ;
|
||||
: infer-special ( word -- )
|
||||
[ current-word set ] [ "special" word-prop call( -- ) ] bi ;
|
||||
|
||||
: infer-shuffle ( shuffle -- )
|
||||
[ in>> length consume-d ] keep ! inputs shuffle
|
||||
[ drop ] [ shuffle dup copy-values dup output-d ] 2bi ! inputs outputs copies
|
||||
[ nip f f ] [ swap zip ] 2bi ! in-d out-d in-r out-r mapping
|
||||
#shuffle, ;
|
||||
|
||||
: infer-shuffle-word ( word -- )
|
||||
"shuffle" word-prop infer-shuffle ;
|
||||
|
||||
: infer-local-reader ( word -- )
|
||||
(( -- value )) apply-word/effect ;
|
||||
|
||||
: infer-local-writer ( word -- )
|
||||
(( value -- )) apply-word/effect ;
|
||||
|
||||
: non-inline-word ( word -- )
|
||||
dup depends-on-effect
|
||||
{
|
||||
{ [ dup "shuffle" word-prop ] [ infer-shuffle-word ] }
|
||||
{ [ dup "special" word-prop ] [ infer-special ] }
|
||||
{ [ dup "transform-quot" word-prop ] [ apply-transform ] }
|
||||
{ [ dup macro? ] [ apply-macro ] }
|
||||
{ [ dup local? ] [ infer-local-reader ] }
|
||||
{ [ dup local-reader? ] [ infer-local-reader ] }
|
||||
{ [ dup local-writer? ] [ infer-local-writer ] }
|
||||
{ [ dup "no-compile" word-prop ] [ do-not-compile ] }
|
||||
[ dup required-stack-effect apply-word/effect ]
|
||||
} cond ;
|
||||
|
||||
{
|
||||
{ drop (( x -- )) }
|
||||
|
|
@ -51,15 +77,6 @@ IN: stack-checker.known-words
|
|||
{ swap (( x y -- y x )) }
|
||||
} [ "shuffle" set-word-prop ] assoc-each
|
||||
|
||||
: infer-shuffle ( shuffle -- )
|
||||
[ in>> length consume-d ] keep ! inputs shuffle
|
||||
[ drop ] [ shuffle dup copy-values dup output-d ] 2bi ! inputs outputs copies
|
||||
[ nip f f ] [ swap zip ] 2bi ! in-d out-d in-r out-r mapping
|
||||
#shuffle, ;
|
||||
|
||||
: infer-shuffle-word ( word -- )
|
||||
"shuffle" word-prop infer-shuffle ;
|
||||
|
||||
: check-declaration ( declaration -- declaration )
|
||||
dup { [ array? ] [ [ class? ] all? ] } 1&&
|
||||
[ bad-declaration-error ] unless ;
|
||||
|
|
@ -180,11 +197,6 @@ M: bad-executable summary
|
|||
|
||||
\ call-effect-unsafe [ infer-call-effect-unsafe ] "special" set-word-prop
|
||||
|
||||
: infer-exit ( -- )
|
||||
\ exit (( n -- * )) apply-word/effect ;
|
||||
|
||||
\ exit [ infer-exit ] "special" set-word-prop
|
||||
|
||||
: infer-load-locals ( -- )
|
||||
pop-literal nip
|
||||
consume-d dup copy-values dup output-r
|
||||
|
|
@ -249,22 +261,10 @@ M: bad-executable summary
|
|||
c-to-factor
|
||||
} [ dup '[ _ do-not-compile ] "special" set-word-prop ] each
|
||||
|
||||
: infer-special ( word -- )
|
||||
[ current-word set ] [ "special" word-prop call( -- ) ] bi ;
|
||||
|
||||
: infer-local-reader ( word -- )
|
||||
(( -- value )) apply-word/effect ;
|
||||
|
||||
: infer-local-writer ( word -- )
|
||||
(( value -- )) apply-word/effect ;
|
||||
|
||||
: infer-local-word ( word -- )
|
||||
"local-word-def" word-prop infer-quot-here ;
|
||||
|
||||
{
|
||||
declare call (call) dip 2dip 3dip curry compose
|
||||
execute (execute) call-effect-unsafe execute-effect-unsafe if
|
||||
dispatch <tuple-boa> exit load-local load-locals get-local
|
||||
dispatch <tuple-boa> load-local load-locals get-local
|
||||
drop-locals do-primitive alien-invoke alien-indirect
|
||||
alien-callback
|
||||
} [ t "no-compile" set-word-prop ] each
|
||||
|
|
@ -276,26 +276,10 @@ M: bad-executable summary
|
|||
! More words not to compile
|
||||
\ clear t "no-compile" set-word-prop
|
||||
|
||||
: non-inline-word ( word -- )
|
||||
dup depends-on-effect
|
||||
{
|
||||
{ [ dup "shuffle" word-prop ] [ infer-shuffle-word ] }
|
||||
{ [ dup "special" word-prop ] [ infer-special ] }
|
||||
{ [ dup "primitive" word-prop ] [ infer-primitive ] }
|
||||
{ [ dup "transform-quot" word-prop ] [ apply-transform ] }
|
||||
{ [ dup "macro" word-prop ] [ apply-macro ] }
|
||||
{ [ dup local? ] [ infer-local-reader ] }
|
||||
{ [ dup local-reader? ] [ infer-local-reader ] }
|
||||
{ [ dup local-writer? ] [ infer-local-writer ] }
|
||||
{ [ dup local-word? ] [ infer-local-word ] }
|
||||
[ infer-word ]
|
||||
} cond ;
|
||||
|
||||
: define-primitive ( word inputs outputs -- )
|
||||
[ 2drop t "primitive" set-word-prop ]
|
||||
[ drop "input-classes" set-word-prop ]
|
||||
[ nip "default-output-classes" set-word-prop ]
|
||||
3tri ;
|
||||
[ "input-classes" set-word-prop ]
|
||||
[ "default-output-classes" set-word-prop ]
|
||||
bi-curry* bi ;
|
||||
|
||||
! Stack effects for all primitives
|
||||
\ (byte-array) { integer } { byte-array } define-primitive \ (byte-array) make-flushable
|
||||
|
|
@ -311,8 +295,10 @@ M: bad-executable summary
|
|||
\ (save-image) { byte-array byte-array } { } define-primitive
|
||||
\ (save-image-and-exit) { byte-array byte-array } { } define-primitive
|
||||
\ (set-context) { object alien } { object } define-primitive
|
||||
\ (set-context-and-delete) { object alien } { } define-primitive
|
||||
\ (sleep) { integer } { } define-primitive
|
||||
\ (start-context) { object quotation } { object } define-primitive
|
||||
\ (start-context-and-delete) { object quotation } { } define-primitive
|
||||
\ (word) { object object object } { word } define-primitive \ (word) make-flushable
|
||||
\ <array> { integer object } { array } define-primitive \ <array> make-flushable
|
||||
\ <byte-array> { integer } { byte-array } define-primitive \ <byte-array> make-flushable
|
||||
|
|
@ -376,7 +362,6 @@ M: bad-executable summary
|
|||
\ data-room { } { byte-array } define-primitive \ data-room make-flushable
|
||||
\ datastack { } { array } define-primitive \ datastack make-flushable
|
||||
\ datastack-for { c-ptr } { array } define-primitive \ datastack-for make-flushable
|
||||
\ delete-context { c-ptr } { } define-primitive
|
||||
\ die { } { } define-primitive
|
||||
\ disable-gc-events { } { object } define-primitive
|
||||
\ dispatch-stats { } { byte-array } define-primitive
|
||||
|
|
|
|||
|
|
@ -9,13 +9,21 @@ IN: threads
|
|||
|
||||
<PRIVATE
|
||||
|
||||
! (set-context) and (start-context) are sub-primitives, but
|
||||
! we don't want them inlined into callers since their behavior
|
||||
! depends on what frames are on the callstack
|
||||
: set-context ( obj context -- obj' ) (set-context) ;
|
||||
! Wrap sub-primitives; we don't want them inlined into callers
|
||||
! since their behavior depends on what frames are on the callstack
|
||||
: set-context ( obj context -- obj' )
|
||||
(set-context) ;
|
||||
|
||||
: start-context ( obj quot: ( obj -- * ) -- obj' ) (start-context) ;
|
||||
: start-context ( obj quot: ( obj -- * ) -- obj' )
|
||||
(start-context) ;
|
||||
|
||||
: set-context-and-delete ( obj context -- * )
|
||||
(set-context-and-delete) ;
|
||||
|
||||
: start-context-and-delete ( obj quot: ( obj -- * ) -- * )
|
||||
(start-context-and-delete) ;
|
||||
|
||||
! Context introspection
|
||||
: namestack-for ( context -- namestack )
|
||||
[ 0 ] dip context-object-for ;
|
||||
|
||||
|
|
@ -159,60 +167,43 @@ DEFER: stop
|
|||
while
|
||||
drop ;
|
||||
|
||||
: start ( namestack -- obj )
|
||||
CONSTANT: [start]
|
||||
[
|
||||
set-namestack
|
||||
init-catchstack
|
||||
self quot>> call
|
||||
stop
|
||||
] start-context ;
|
||||
]
|
||||
|
||||
DEFER: next
|
||||
|
||||
: no-runnable-threads ( -- obj )
|
||||
! We should never be in a state where the only threads
|
||||
! are sleeping; the I/O wait thread is always runnable.
|
||||
! However, if it dies, we handle this case
|
||||
! semi-gracefully.
|
||||
!
|
||||
! And if sleep-time outputs f, there are no sleeping
|
||||
! threads either... so WTF.
|
||||
sleep-time {
|
||||
{ [ dup not ] [ drop die ] }
|
||||
{ [ dup 0 = ] [ drop ] }
|
||||
[ (sleep) ]
|
||||
} cond next ;
|
||||
: no-runnable-threads ( -- ) die ;
|
||||
|
||||
: (next) ( obj thread -- obj' )
|
||||
f >>state
|
||||
dup set-self
|
||||
dup runnable>>
|
||||
[ context>> box> set-context ] [ t >>runnable drop start ] if ;
|
||||
[ context>> box> set-context ]
|
||||
[ t >>runnable drop [start] start-context ] if ;
|
||||
|
||||
: next ( -- obj )
|
||||
: (stop) ( obj thread -- * )
|
||||
dup runnable>>
|
||||
[ context>> box> set-context-and-delete ]
|
||||
[ t >>runnable drop [start] start-context-and-delete ] if ;
|
||||
|
||||
: next ( -- obj thread )
|
||||
expire-sleep-loop
|
||||
run-queue dup deque-empty?
|
||||
[ drop no-runnable-threads ]
|
||||
[ pop-back dup array? [ first2 ] [ [ f ] dip ] if (next) ] if ;
|
||||
|
||||
: recycler-thread ( -- thread ) 68 special-object ;
|
||||
|
||||
: recycler-queue ( -- vector ) 69 special-object ;
|
||||
|
||||
: delete-context-later ( context -- )
|
||||
recycler-queue push recycler-thread interrupt ;
|
||||
run-queue pop-back
|
||||
dup array? [ first2 ] [ [ f ] dip ] if
|
||||
f >>state
|
||||
dup set-self ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: stop ( -- * )
|
||||
self [ exit-handler>> call( -- ) ] [ unregister-thread ] bi
|
||||
context delete-context-later next
|
||||
die 1 exit ;
|
||||
next (stop) ;
|
||||
|
||||
: suspend ( state -- obj )
|
||||
[ self ] dip >>state
|
||||
[ context ] dip context>> >box
|
||||
next ;
|
||||
next (next) ;
|
||||
|
||||
: yield ( -- ) self resume f suspend drop ;
|
||||
|
||||
|
|
@ -260,22 +251,9 @@ GENERIC: error-in-thread ( error thread -- )
|
|||
[ set-self ]
|
||||
tri ;
|
||||
|
||||
! The recycler thread deletes contexts belonging to stopped
|
||||
! threads
|
||||
|
||||
: recycler-loop ( -- )
|
||||
recycler-queue [ [ delete-context ] each ] [ delete-all ] bi
|
||||
f sleep-until
|
||||
recycler-loop ;
|
||||
|
||||
: init-recycler ( -- )
|
||||
[ recycler-loop ] "Context recycler" spawn 68 set-special-object
|
||||
V{ } clone 69 set-special-object ;
|
||||
|
||||
: init-threads ( -- )
|
||||
init-thread-state
|
||||
init-initial-thread
|
||||
init-recycler ;
|
||||
init-initial-thread ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ $nl
|
|||
|
||||
ARTICLE: "tools.deploy.usage" "Deploy tool usage"
|
||||
"Once the necessary deployment flags have been set, the application can be deployed:"
|
||||
{ $subsections deploy }
|
||||
{ $subsections deploy deploy-image-only }
|
||||
"For example, you can deploy the " { $vocab-link "hello-ui" } " demo which comes with Factor. Note that this demo already has a deployment configuration, so nothing needs to be configured:"
|
||||
{ $code "\"hello-ui\" deploy" }
|
||||
{ $list
|
||||
|
|
@ -61,4 +61,10 @@ ABOUT: "tools.deploy"
|
|||
|
||||
HELP: deploy
|
||||
{ $values { "vocab" "a vocabulary specifier" } }
|
||||
{ $description "Deploys " { $snippet "vocab" } ", saving the deployed image as " { $snippet { $emphasis "vocab" } ".image" } "." } ;
|
||||
{ $description "Deploys " { $snippet "vocab" } " into a packaged application. This will create a directory containing the Factor VM, a deployed image set up to run the " { $link POSTPONE: MAIN: } " entry point of " { $snippet "vocab" } " at startup, and any " { $link "deploy-resources" } " and shared libraries the application depends on. On Mac OS X, the deployment directory will be a standard " { $snippet ".app" } " bundle executable from Finder. To only generate the Factor image, use " { $link deploy-image-only } "." } ;
|
||||
|
||||
HELP: deploy-image-only
|
||||
{ $values { "vocab" "a vocabulary specifier" } { "image" "a pathname" } }
|
||||
{ $description "Deploys " { $snippet "vocab" } ", saving the deployed image to the location specified by " { $snippet "image" } ". This only builds the Factor image for the vocabulary; to create a complete packaged application, use " { $link deploy } "." } ;
|
||||
|
||||
{ deploy deploy-image-only } related-words
|
||||
|
|
|
|||
|
|
@ -1,13 +1,16 @@
|
|||
! Copyright (C) 2007, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.deploy.backend system vocabs.loader kernel
|
||||
combinators ;
|
||||
combinators tools.deploy.config.editor ;
|
||||
IN: tools.deploy
|
||||
|
||||
: deploy ( vocab -- ) deploy* ;
|
||||
|
||||
: deploy-image-only ( vocab image -- )
|
||||
[ vm ] 2dip swap dup deploy-config make-deploy-image drop ;
|
||||
|
||||
{
|
||||
{ [ os macosx? ] [ "tools.deploy.macosx" ] }
|
||||
{ [ os winnt? ] [ "tools.deploy.windows" ] }
|
||||
{ [ os unix? ] [ "tools.deploy.unix" ] }
|
||||
} cond require
|
||||
} cond require
|
||||
|
|
|
|||
|
|
@ -34,9 +34,6 @@ IN: tools.deploy.macosx
|
|||
"Contents/Info.plist" append-path
|
||||
write-plist ;
|
||||
|
||||
: copy-dll ( bundle-name -- )
|
||||
"Frameworks/libfactor.dylib" copy-bundle-dir ;
|
||||
|
||||
: copy-nib ( bundle-name -- )
|
||||
deploy-ui? get [
|
||||
"Resources/English.lproj/MiniFactor.nib" copy-bundle-dir
|
||||
|
|
@ -50,11 +47,10 @@ IN: tools.deploy.macosx
|
|||
: create-app-dir ( vocab bundle-name -- vm )
|
||||
{
|
||||
[
|
||||
nip {
|
||||
[ copy-dll ]
|
||||
[ copy-nib ]
|
||||
[ "Contents/Resources" append-path make-directories ]
|
||||
} cleave
|
||||
nip
|
||||
[ copy-nib ]
|
||||
[ "Contents/Resources" append-path make-directories ]
|
||||
[ "Contents/Frameworks" append-path make-directories ] tri
|
||||
]
|
||||
[ copy-icns ]
|
||||
[ create-app-plist ]
|
||||
|
|
|
|||
|
|
@ -42,12 +42,8 @@ IN: tools.deploy.shaker
|
|||
deploy-threads? get [
|
||||
"threads" startup-hooks get delete-at
|
||||
] unless
|
||||
native-io? [
|
||||
"io.thread" startup-hooks get delete-at
|
||||
] unless
|
||||
strip-io? [
|
||||
"io.backend" startup-hooks get delete-at
|
||||
"io.thread" startup-hooks get delete-at
|
||||
] when
|
||||
strip-dictionary? [
|
||||
{
|
||||
|
|
@ -175,7 +171,6 @@ IN: tools.deploy.shaker
|
|||
"predicate"
|
||||
"predicate-definition"
|
||||
"predicating"
|
||||
"primitive"
|
||||
"reader"
|
||||
"reading"
|
||||
"recursive"
|
||||
|
|
@ -397,16 +392,15 @@ IN: tools.deploy.shaker
|
|||
] [ drop ] if ;
|
||||
|
||||
: strip-c-io ( -- )
|
||||
! On all platforms, if deploy-io is 1, we strip out C streams.
|
||||
! On Unix, if deploy-io is 3, we strip out C streams as well.
|
||||
! On Windows, even if deploy-io is 3, C streams are still used
|
||||
! for the console, so don't strip it there.
|
||||
strip-io?
|
||||
deploy-io get 3 = os windows? not and
|
||||
or [
|
||||
[
|
||||
c-io-backend forget
|
||||
"io.streams.c" forget-vocab
|
||||
"io-thread-running?" "io.thread" lookup [
|
||||
global delete-at
|
||||
] when*
|
||||
] with-compilation-unit
|
||||
"Stripping C I/O" show
|
||||
"vocab:tools/deploy/shaker/strip-c-io.factor" run-file
|
||||
] when ;
|
||||
|
||||
: compress ( pred post-process string -- )
|
||||
|
|
|
|||
|
|
@ -0,0 +1,10 @@
|
|||
USING: compiler.units definitions io.backend io.streams.c kernel
|
||||
math threads.private vocabs ;
|
||||
|
||||
[
|
||||
c-io-backend forget
|
||||
"io.streams.c" forget-vocab
|
||||
] with-compilation-unit
|
||||
|
||||
M: object io-multiplex
|
||||
dup 0 = [ drop ] [ 60 60 * 1000 * 1000 * or (sleep) ] if ;
|
||||
|
|
@ -11,16 +11,12 @@ IN: tools.deploy.windows
|
|||
|
||||
CONSTANT: app-icon-resource-id "APPICON"
|
||||
|
||||
: copy-dll ( bundle-name -- )
|
||||
"resource:factor.dll" swap copy-file-into ;
|
||||
|
||||
:: copy-vm ( executable bundle-name extension -- vm )
|
||||
vm "." split1-last drop extension append
|
||||
bundle-name executable ".exe" append append-path
|
||||
[ copy-file ] keep ;
|
||||
|
||||
: create-exe-dir ( vocab bundle-name -- vm )
|
||||
dup copy-dll
|
||||
deploy-console? get ".com" ".exe" ? copy-vm ;
|
||||
|
||||
: open-in-explorer ( dir -- )
|
||||
|
|
|
|||
|
|
@ -628,7 +628,7 @@ M: windows-ui-backend do-events
|
|||
WNDCLASSEX <struct> f GetModuleHandle
|
||||
class-name-ptr pick GetClassInfoEx 0 = [
|
||||
WNDCLASSEX heap-size >>cbSize
|
||||
{ CS_HREDRAW CS_VREDRAW CS_OWNDC } flags >>style
|
||||
flags{ CS_HREDRAW CS_VREDRAW CS_OWNDC } >>style
|
||||
ui-wndproc >>lpfnWndProc
|
||||
0 >>cbClsExtra
|
||||
0 >>cbWndExtra
|
||||
|
|
@ -811,8 +811,7 @@ M: windows-ui-backend (ungrab-input) ( handle -- )
|
|||
f ClipCursor drop
|
||||
1 ShowCursor drop ;
|
||||
|
||||
: fullscreen-flags ( -- n )
|
||||
{ WS_CAPTION WS_BORDER WS_THICKFRAME } flags ; inline
|
||||
CONSTANT: fullscreen-flags { WS_CAPTION WS_BORDER WS_THICKFRAME }
|
||||
|
||||
: enter-fullscreen ( world -- )
|
||||
handle>> hWnd>>
|
||||
|
|
@ -838,7 +837,7 @@ M: windows-ui-backend (ungrab-input) ( handle -- )
|
|||
[
|
||||
f
|
||||
over hwnd>RECT get-RECT-dimensions
|
||||
{ SWP_NOMOVE SWP_NOSIZE SWP_NOZORDER SWP_FRAMECHANGED } flags
|
||||
flags{ SWP_NOMOVE SWP_NOSIZE SWP_NOZORDER SWP_FRAMECHANGED }
|
||||
SetWindowPos win32-error=0/f
|
||||
]
|
||||
[ SW_RESTORE ShowWindow win32-error=0/f ]
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types alien.syntax math math.bitwise classes.struct ;
|
||||
USING: alien.c-types alien.syntax math math.bitwise classes.struct
|
||||
literals ;
|
||||
IN: unix.linux.inotify
|
||||
|
||||
STRUCT: inotify-event
|
||||
|
|
@ -27,8 +28,8 @@ CONSTANT: IN_UNMOUNT HEX: 2000 ! Backing fs was unmounted
|
|||
CONSTANT: IN_Q_OVERFLOW HEX: 4000 ! Event queued overflowed
|
||||
CONSTANT: IN_IGNORED HEX: 8000 ! File was ignored
|
||||
|
||||
: IN_CLOSE ( -- n ) { IN_CLOSE_WRITE IN_CLOSE_NOWRITE } flags ; foldable ! close
|
||||
: IN_MOVE ( -- n ) { IN_MOVED_FROM IN_MOVED_TO } flags ; foldable ! moves
|
||||
CONSTANT: IN_CLOSE flags{ IN_CLOSE_WRITE IN_CLOSE_NOWRITE }
|
||||
CONSTANT: IN_MOVE flags{ IN_MOVED_FROM IN_MOVED_TO }
|
||||
|
||||
CONSTANT: IN_ONLYDIR HEX: 1000000 ! only watch the path if it is a directory
|
||||
CONSTANT: IN_DONT_FOLLOW HEX: 2000000 ! don't follow a sym link
|
||||
|
|
@ -36,20 +37,20 @@ CONSTANT: IN_MASK_ADD HEX: 20000000 ! add to the mask of an already existing w
|
|||
CONSTANT: IN_ISDIR HEX: 40000000 ! event occurred against dir
|
||||
CONSTANT: IN_ONESHOT HEX: 80000000 ! only send event once
|
||||
|
||||
: IN_CHANGE_EVENTS ( -- n )
|
||||
{
|
||||
CONSTANT: IN_CHANGE_EVENTS
|
||||
flags{
|
||||
IN_MODIFY IN_ATTRIB IN_MOVED_FROM
|
||||
IN_MOVED_TO IN_DELETE IN_CREATE IN_DELETE_SELF
|
||||
IN_MOVE_SELF
|
||||
} flags ; foldable
|
||||
}
|
||||
|
||||
: IN_ALL_EVENTS ( -- n )
|
||||
{
|
||||
CONSTANT: IN_ALL_EVENTS
|
||||
flags{
|
||||
IN_ACCESS IN_MODIFY IN_ATTRIB IN_CLOSE_WRITE
|
||||
IN_CLOSE_NOWRITE IN_OPEN IN_MOVED_FROM
|
||||
IN_MOVED_TO IN_DELETE IN_CREATE IN_DELETE_SELF
|
||||
IN_MOVE_SELF
|
||||
} flags ; foldable
|
||||
}
|
||||
|
||||
FUNCTION: int inotify_init ( ) ;
|
||||
FUNCTION: int inotify_add_watch ( int fd, c-string name, uint mask ) ;
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
USING: alien.c-types io.encodings.utf8 io.encodings.string
|
||||
kernel sequences unix.stat accessors unix combinators math
|
||||
grouping system alien.strings math.bitwise alien.syntax
|
||||
unix.types classes.struct unix.ffi ;
|
||||
unix.types classes.struct unix.ffi literals ;
|
||||
IN: unix.statfs.macosx
|
||||
|
||||
CONSTANT: MNT_RDONLY HEX: 00000001
|
||||
|
|
@ -29,8 +29,8 @@ CONSTANT: MNT_MULTILABEL HEX: 04000000
|
|||
CONSTANT: MNT_NOATIME HEX: 10000000
|
||||
ALIAS: MNT_UNKNOWNPERMISSIONS MNT_IGNORE_OWNERSHIP
|
||||
|
||||
: MNT_VISFLAGMASK ( -- n )
|
||||
{
|
||||
CONSTANT: MNT_VISFLAGMASK
|
||||
flags{
|
||||
MNT_RDONLY MNT_SYNCHRONOUS MNT_NOEXEC
|
||||
MNT_NOSUID MNT_NODEV MNT_UNION
|
||||
MNT_ASYNC MNT_EXPORTED MNT_QUARANTINE
|
||||
|
|
@ -38,14 +38,13 @@ ALIAS: MNT_UNKNOWNPERMISSIONS MNT_IGNORE_OWNERSHIP
|
|||
MNT_ROOTFS MNT_DOVOLFS MNT_DONTBROWSE
|
||||
MNT_IGNORE_OWNERSHIP MNT_AUTOMOUNTED MNT_JOURNALED
|
||||
MNT_NOUSERXATTR MNT_DEFWRITE MNT_MULTILABEL MNT_NOATIME
|
||||
} flags ; inline
|
||||
}
|
||||
|
||||
CONSTANT: MNT_UPDATE HEX: 00010000
|
||||
CONSTANT: MNT_RELOAD HEX: 00040000
|
||||
CONSTANT: MNT_FORCE HEX: 00080000
|
||||
|
||||
: MNT_CMDFLAGS ( -- n )
|
||||
{ MNT_UPDATE MNT_RELOAD MNT_FORCE } flags ; inline
|
||||
CONSTANT: MNT_CMDFLAGS flags{ MNT_UPDATE MNT_RELOAD MNT_FORCE }
|
||||
|
||||
CONSTANT: VFS_GENERIC 0
|
||||
CONSTANT: VFS_NUMMNTOPS 1
|
||||
|
|
|
|||
|
|
@ -2,17 +2,12 @@ IN: validators.tests
|
|||
USING: kernel sequences tools.test validators accessors
|
||||
namespaces assocs ;
|
||||
|
||||
[ "" v-one-line ] must-fail
|
||||
[ "hello world" ] [ "hello world" v-one-line ] unit-test
|
||||
[ "hello\nworld" v-one-line ] must-fail
|
||||
|
||||
[ "" v-one-word ] must-fail
|
||||
[ "hello" ] [ "hello" v-one-word ] unit-test
|
||||
[ "hello world" v-one-word ] must-fail
|
||||
|
||||
[ t ] [ "on" v-checkbox ] unit-test
|
||||
[ f ] [ "off" v-checkbox ] unit-test
|
||||
|
||||
[ "default test" ] [ "" "default test" v-default ] unit-test
|
||||
[ "blah" ] [ "blah" "default test" v-default ] unit-test
|
||||
|
||||
[ "foo" v-number ] must-fail
|
||||
[ 123 ] [ "123" v-number ] unit-test
|
||||
[ 123 ] [ "123" v-integer ] unit-test
|
||||
|
|
@ -42,6 +37,14 @@ namespaces assocs ;
|
|||
[ "http:/www.factorcode.org" v-url ]
|
||||
[ "invalid URL" = ] must-fail-with
|
||||
|
||||
[ "" v-one-line ] must-fail
|
||||
[ "hello world" ] [ "hello world" v-one-line ] unit-test
|
||||
[ "hello\nworld" v-one-line ] must-fail
|
||||
|
||||
[ "" v-one-word ] must-fail
|
||||
[ "hello" ] [ "hello" v-one-word ] unit-test
|
||||
[ "hello world" v-one-word ] must-fail
|
||||
|
||||
[ 4561261212345467 ] [ "4561261212345467" v-credit-card ] unit-test
|
||||
|
||||
[ 4561261212345467 ] [ "4561-2612-1234-5467" v-credit-card ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2006, 2008 Slava Pestov
|
||||
! Copyright (C) 2006, 2010 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel continuations sequences math namespaces make sets
|
||||
math.parser math.ranges assocs regexp unicode.categories arrays
|
||||
|
|
@ -9,7 +9,7 @@ IN: validators
|
|||
>lower "on" = ;
|
||||
|
||||
: v-default ( str def -- str/def )
|
||||
[ nip empty? ] 2keep ? ;
|
||||
[ drop empty? not ] 2keep ? ;
|
||||
|
||||
: v-required ( str -- str )
|
||||
dup empty? [ "required" throw ] when ;
|
||||
|
|
|
|||
|
|
@ -1,28 +1,9 @@
|
|||
USING: alien.c-types alien.syntax kernel math windows.types
|
||||
windows.kernel32 math.bitwise classes.struct ;
|
||||
USING: alien.c-types alien.syntax classes.struct kernel
|
||||
literals math math.bitwise windows.kernel32 windows.types ;
|
||||
IN: windows.advapi32
|
||||
|
||||
LIBRARY: advapi32
|
||||
|
||||
CONSTANT: PROV_RSA_FULL 1
|
||||
CONSTANT: PROV_RSA_SIG 2
|
||||
CONSTANT: PROV_DSS 3
|
||||
CONSTANT: PROV_FORTEZZA 4
|
||||
CONSTANT: PROV_MS_EXCHANGE 5
|
||||
CONSTANT: PROV_SSL 6
|
||||
CONSTANT: PROV_RSA_SCHANNEL 12
|
||||
CONSTANT: PROV_DSS_DH 13
|
||||
CONSTANT: PROV_EC_ECDSA_SIG 14
|
||||
CONSTANT: PROV_EC_ECNRA_SIG 15
|
||||
CONSTANT: PROV_EC_ECDSA_FULL 16
|
||||
CONSTANT: PROV_EC_ECNRA_FULL 17
|
||||
CONSTANT: PROV_DH_SCHANNEL 18
|
||||
CONSTANT: PROV_SPYRUS_LYNKS 20
|
||||
CONSTANT: PROV_RNG 21
|
||||
CONSTANT: PROV_INTEL_SEC 22
|
||||
CONSTANT: PROV_REPLACE_OWF 23
|
||||
CONSTANT: PROV_RSA_AES 24
|
||||
|
||||
CONSTANT: MS_DEF_DH_SCHANNEL_PROV "Microsoft DH Schannel Cryptographic Provider"
|
||||
|
||||
CONSTANT: MS_DEF_DSS_DH_PROV
|
||||
|
|
@ -56,12 +37,6 @@ CONSTANT: MS_SCARD_PROV
|
|||
CONSTANT: MS_STRONG_PROV
|
||||
"Microsoft Strong Cryptographic Provider"
|
||||
|
||||
CONSTANT: CRYPT_VERIFYCONTEXT HEX: F0000000
|
||||
CONSTANT: CRYPT_NEWKEYSET HEX: 8
|
||||
CONSTANT: CRYPT_DELETEKEYSET HEX: 10
|
||||
CONSTANT: CRYPT_MACHINE_KEYSET HEX: 20
|
||||
CONSTANT: CRYPT_SILENT HEX: 40
|
||||
|
||||
STRUCT: ACL
|
||||
{ AclRevision BYTE }
|
||||
{ Sbz1 BYTE }
|
||||
|
|
@ -361,18 +336,18 @@ CONSTANT: TOKEN_IMPERSONATE HEX: 0004
|
|||
CONSTANT: TOKEN_QUERY HEX: 0008
|
||||
CONSTANT: TOKEN_QUERY_SOURCE HEX: 0010
|
||||
CONSTANT: TOKEN_ADJUST_DEFAULT HEX: 0080
|
||||
: TOKEN_READ ( -- n ) { STANDARD_RIGHTS_READ TOKEN_QUERY } flags ;
|
||||
CONSTANT: TOKEN_READ flags{ STANDARD_RIGHTS_READ TOKEN_QUERY }
|
||||
|
||||
: TOKEN_WRITE ( -- n )
|
||||
{
|
||||
CONSTANT: TOKEN_WRITE
|
||||
flags{
|
||||
STANDARD_RIGHTS_WRITE
|
||||
TOKEN_ADJUST_PRIVILEGES
|
||||
TOKEN_ADJUST_GROUPS
|
||||
TOKEN_ADJUST_DEFAULT
|
||||
} flags ; foldable
|
||||
}
|
||||
|
||||
: TOKEN_ALL_ACCESS ( -- n )
|
||||
{
|
||||
CONSTANT: TOKEN_ALL_ACCESS
|
||||
flags{
|
||||
STANDARD_RIGHTS_REQUIRED
|
||||
TOKEN_ASSIGN_PRIMARY
|
||||
TOKEN_DUPLICATE
|
||||
|
|
@ -383,7 +358,7 @@ CONSTANT: TOKEN_ADJUST_DEFAULT HEX: 0080
|
|||
TOKEN_ADJUST_GROUPS
|
||||
TOKEN_ADJUST_SESSIONID
|
||||
TOKEN_ADJUST_DEFAULT
|
||||
} flags ; foldable
|
||||
}
|
||||
|
||||
CONSTANT: HKEY_CLASSES_ROOT HEX: 80000000
|
||||
CONSTANT: HKEY_CURRENT_USER HEX: 80000001
|
||||
|
|
@ -426,6 +401,305 @@ CONSTANT: REG_QWORD_LITTLE_ENDIAN 11
|
|||
CONSTANT: REG_CREATED_NEW_KEY 1
|
||||
CONSTANT: REG_OPENED_EXISTING_KEY 2
|
||||
|
||||
|
||||
|
||||
CONSTANT: ALG_CLASS_ANY 0
|
||||
CONSTANT: ALG_CLASS_SIGNATURE 8192
|
||||
CONSTANT: ALG_CLASS_MSG_ENCRYPT 16384
|
||||
CONSTANT: ALG_CLASS_DATA_ENCRYPT 24576
|
||||
CONSTANT: ALG_CLASS_HASH 32768
|
||||
CONSTANT: ALG_CLASS_KEY_EXCHANGE 40960
|
||||
CONSTANT: ALG_CLASS_ALL 57344
|
||||
CONSTANT: ALG_TYPE_ANY 0
|
||||
CONSTANT: ALG_TYPE_DSS 512
|
||||
CONSTANT: ALG_TYPE_RSA 1024
|
||||
CONSTANT: ALG_TYPE_BLOCK 1536
|
||||
CONSTANT: ALG_TYPE_STREAM 2048
|
||||
CONSTANT: ALG_TYPE_DH 2560
|
||||
CONSTANT: ALG_TYPE_SECURECHANNEL 3072
|
||||
CONSTANT: ALG_SID_ANY 0
|
||||
CONSTANT: ALG_SID_RSA_ANY 0
|
||||
CONSTANT: ALG_SID_RSA_PKCS 1
|
||||
CONSTANT: ALG_SID_RSA_MSATWORK 2
|
||||
CONSTANT: ALG_SID_RSA_ENTRUST 3
|
||||
CONSTANT: ALG_SID_RSA_PGP 4
|
||||
CONSTANT: ALG_SID_DSS_ANY 0
|
||||
CONSTANT: ALG_SID_DSS_PKCS 1
|
||||
CONSTANT: ALG_SID_DSS_DMS 2
|
||||
CONSTANT: ALG_SID_DES 1
|
||||
CONSTANT: ALG_SID_3DES 3
|
||||
CONSTANT: ALG_SID_DESX 4
|
||||
CONSTANT: ALG_SID_IDEA 5
|
||||
CONSTANT: ALG_SID_CAST 6
|
||||
CONSTANT: ALG_SID_SAFERSK64 7
|
||||
CONSTANT: ALG_SID_SAFERSK128 8
|
||||
CONSTANT: ALG_SID_3DES_112 9
|
||||
CONSTANT: ALG_SID_SKIPJACK 10
|
||||
CONSTANT: ALG_SID_TEK 11
|
||||
CONSTANT: ALG_SID_CYLINK_MEK 12
|
||||
CONSTANT: ALG_SID_RC5 13
|
||||
CONSTANT: ALG_SID_RC2 2
|
||||
CONSTANT: ALG_SID_RC4 1
|
||||
CONSTANT: ALG_SID_SEAL 2
|
||||
CONSTANT: ALG_SID_MD2 1
|
||||
CONSTANT: ALG_SID_MD4 2
|
||||
CONSTANT: ALG_SID_MD5 3
|
||||
CONSTANT: ALG_SID_SHA 4
|
||||
CONSTANT: ALG_SID_MAC 5
|
||||
CONSTANT: ALG_SID_RIPEMD 6
|
||||
CONSTANT: ALG_SID_RIPEMD160 7
|
||||
CONSTANT: ALG_SID_SSL3SHAMD5 8
|
||||
CONSTANT: ALG_SID_HMAC 9
|
||||
CONSTANT: ALG_SID_TLS1PRF 10
|
||||
CONSTANT: ALG_SID_EXAMPLE 80
|
||||
|
||||
CONSTANT: CALG_MD2 flags{ ALG_CLASS_HASH ALG_TYPE_ANY ALG_SID_MD2 }
|
||||
CONSTANT: CALG_MD4 flags{ ALG_CLASS_HASH ALG_TYPE_ANY ALG_SID_MD4 }
|
||||
CONSTANT: CALG_MD5 flags{ ALG_CLASS_HASH ALG_TYPE_ANY ALG_SID_MD5 }
|
||||
CONSTANT: CALG_SHA flags{ ALG_CLASS_HASH ALG_TYPE_ANY ALG_SID_SHA }
|
||||
CONSTANT: CALG_MAC flags{ ALG_CLASS_HASH ALG_TYPE_ANY ALG_SID_MAC }
|
||||
CONSTANT: CALG_3DES flags{ ALG_CLASS_DATA_ENCRYPT ALG_TYPE_BLOCK 3 }
|
||||
CONSTANT: CALG_CYLINK_MEK flags{ ALG_CLASS_DATA_ENCRYPT ALG_TYPE_BLOCK 12 }
|
||||
CONSTANT: CALG_SKIPJACK flags{ ALG_CLASS_DATA_ENCRYPT ALG_TYPE_BLOCK 10 }
|
||||
CONSTANT: CALG_KEA_KEYX flags{ ALG_CLASS_KEY_EXCHANGE ALG_TYPE_STREAM ALG_TYPE_DSS 4 }
|
||||
CONSTANT: CALG_RSA_SIGN flags{ ALG_CLASS_SIGNATURE ALG_TYPE_RSA ALG_SID_RSA_ANY }
|
||||
CONSTANT: CALG_DSS_SIGN flags{ ALG_CLASS_SIGNATURE ALG_TYPE_DSS ALG_SID_DSS_ANY }
|
||||
CONSTANT: CALG_RSA_KEYX flags{ ALG_CLASS_KEY_EXCHANGE ALG_TYPE_RSA ALG_SID_RSA_ANY }
|
||||
CONSTANT: CALG_DES flags{ ALG_CLASS_DATA_ENCRYPT ALG_TYPE_BLOCK ALG_SID_DES }
|
||||
CONSTANT: CALG_RC2 flags{ ALG_CLASS_DATA_ENCRYPT ALG_TYPE_BLOCK ALG_SID_RC2 }
|
||||
CONSTANT: CALG_RC4 flags{ ALG_CLASS_DATA_ENCRYPT ALG_TYPE_STREAM ALG_SID_RC4 }
|
||||
CONSTANT: CALG_SEAL flags{ ALG_CLASS_DATA_ENCRYPT ALG_TYPE_STREAM ALG_SID_SEAL }
|
||||
CONSTANT: CALG_DH_EPHEM flags{ ALG_CLASS_KEY_EXCHANGE ALG_TYPE_STREAM ALG_TYPE_DSS ALG_SID_DSS_DMS }
|
||||
CONSTANT: CALG_DESX flags{ ALG_CLASS_DATA_ENCRYPT ALG_TYPE_BLOCK ALG_SID_DESX }
|
||||
! CONSTANT: CALG_TLS1PRF flags{ ALG_CLASS_DHASH ALG_TYPE_ANY ALG_SID_TLS1PRF }
|
||||
|
||||
CONSTANT: CRYPT_VERIFYCONTEXT HEX: F0000000
|
||||
CONSTANT: CRYPT_NEWKEYSET 8
|
||||
CONSTANT: CRYPT_DELETEKEYSET 16
|
||||
CONSTANT: CRYPT_MACHINE_KEYSET 32
|
||||
CONSTANT: CRYPT_SILENT 64
|
||||
CONSTANT: CRYPT_EXPORTABLE 1
|
||||
CONSTANT: CRYPT_USER_PROTECTED 2
|
||||
CONSTANT: CRYPT_CREATE_SALT 4
|
||||
CONSTANT: CRYPT_UPDATE_KEY 8
|
||||
CONSTANT: AT_KEYEXCHANGE 1
|
||||
CONSTANT: AT_SIGNATURE 2
|
||||
CONSTANT: CRYPT_USERDATA 1
|
||||
CONSTANT: KP_IV 1
|
||||
CONSTANT: KP_SALT 2
|
||||
CONSTANT: KP_PADDING 3
|
||||
CONSTANT: KP_MODE 4
|
||||
CONSTANT: KP_MODE_BITS 5
|
||||
CONSTANT: KP_PERMISSIONS 6
|
||||
CONSTANT: KP_ALGID 7
|
||||
CONSTANT: KP_BLOCKLEN 8
|
||||
CONSTANT: PKCS5_PADDING 1
|
||||
CONSTANT: CRYPT_MODE_CBC 1
|
||||
CONSTANT: CRYPT_MODE_ECB 2
|
||||
CONSTANT: CRYPT_MODE_OFB 3
|
||||
CONSTANT: CRYPT_MODE_CFB 4
|
||||
CONSTANT: CRYPT_MODE_CTS 5
|
||||
CONSTANT: CRYPT_MODE_CBCI 6
|
||||
CONSTANT: CRYPT_MODE_CFBP 7
|
||||
CONSTANT: CRYPT_MODE_OFBP 8
|
||||
CONSTANT: CRYPT_MODE_CBCOFM 9
|
||||
CONSTANT: CRYPT_MODE_CBCOFMI 10
|
||||
CONSTANT: CRYPT_ENCRYPT 1
|
||||
CONSTANT: CRYPT_DECRYPT 2
|
||||
CONSTANT: CRYPT_EXPORT 4
|
||||
CONSTANT: CRYPT_READ 8
|
||||
CONSTANT: CRYPT_WRITE 16
|
||||
CONSTANT: CRYPT_MAC 32
|
||||
CONSTANT: HP_ALGID 1
|
||||
CONSTANT: HP_HASHVAL 2
|
||||
CONSTANT: HP_HASHSIZE 4
|
||||
CONSTANT: PP_ENUMALGS 1
|
||||
CONSTANT: PP_ENUMCONTAINERS 2
|
||||
CONSTANT: PP_IMPTYPE 3
|
||||
CONSTANT: PP_NAME 4
|
||||
CONSTANT: PP_VERSION 5
|
||||
CONSTANT: PP_CONTAINER 6
|
||||
CONSTANT: PP_ENUMMANDROOTS 25
|
||||
CONSTANT: PP_ENUMELECTROOTS 26
|
||||
CONSTANT: PP_KEYSET_TYPE 27
|
||||
CONSTANT: PP_ADMIN_PIN 31
|
||||
CONSTANT: PP_KEYEXCHANGE_PIN 32
|
||||
CONSTANT: PP_SIGNATURE_PIN 33
|
||||
CONSTANT: PP_SIG_KEYSIZE_INC 34
|
||||
CONSTANT: PP_KEYX_KEYSIZE_INC 35
|
||||
CONSTANT: PP_UNIQUE_CONTAINER 36
|
||||
CONSTANT: PP_SGC_INFO 37
|
||||
CONSTANT: PP_USE_HARDWARE_RNG 38
|
||||
CONSTANT: PP_KEYSPEC 39
|
||||
CONSTANT: PP_ENUMEX_SIGNING_PROT 40
|
||||
CONSTANT: CRYPT_FIRST 1
|
||||
CONSTANT: CRYPT_NEXT 2
|
||||
CONSTANT: CRYPT_IMPL_HARDWARE 1
|
||||
CONSTANT: CRYPT_IMPL_SOFTWARE 2
|
||||
CONSTANT: CRYPT_IMPL_MIXED 3
|
||||
CONSTANT: CRYPT_IMPL_UNKNOWN 4
|
||||
CONSTANT: PROV_RSA_FULL 1
|
||||
CONSTANT: PROV_RSA_SIG 2
|
||||
CONSTANT: PROV_DSS 3
|
||||
CONSTANT: PROV_FORTEZZA 4
|
||||
CONSTANT: PROV_MS_MAIL 5
|
||||
CONSTANT: PROV_SSL 6
|
||||
CONSTANT: PROV_STT_MER 7
|
||||
CONSTANT: PROV_STT_ACQ 8
|
||||
CONSTANT: PROV_STT_BRND 9
|
||||
CONSTANT: PROV_STT_ROOT 10
|
||||
CONSTANT: PROV_STT_ISS 11
|
||||
CONSTANT: PROV_RSA_SCHANNEL 12
|
||||
CONSTANT: PROV_DSS_DH 13
|
||||
CONSTANT: PROV_EC_ECDSA_SIG 14
|
||||
CONSTANT: PROV_EC_ECNRA_SIG 15
|
||||
CONSTANT: PROV_EC_ECDSA_FULL 16
|
||||
CONSTANT: PROV_EC_ECNRA_FULL 17
|
||||
CONSTANT: PROV_DH_SCHANNEL 18
|
||||
CONSTANT: PROV_SPYRUS_LYNKS 20
|
||||
CONSTANT: PROV_RNG 21
|
||||
CONSTANT: PROV_INTEL_SEC 22
|
||||
CONSTANT: PROV_REPLACE_OWF 23
|
||||
CONSTANT: PROV_RSA_AES 24
|
||||
CONSTANT: MAXUIDLEN 64
|
||||
CONSTANT: CUR_BLOB_VERSION 2
|
||||
CONSTANT: X509_ASN_ENCODING 1
|
||||
CONSTANT: PKCS_7_ASN_ENCODING 65536
|
||||
CONSTANT: CERT_V1 0
|
||||
CONSTANT: CERT_V2 1
|
||||
CONSTANT: CERT_V3 2
|
||||
CONSTANT: CERT_E_CHAINING -2146762486
|
||||
CONSTANT: CERT_E_CN_NO_MATCH -2146762481
|
||||
CONSTANT: CERT_E_EXPIRED -2146762495
|
||||
CONSTANT: CERT_E_PURPOSE -2146762490
|
||||
CONSTANT: CERT_E_REVOCATION_FAILURE -2146762482
|
||||
CONSTANT: CERT_E_REVOKED -2146762484
|
||||
CONSTANT: CERT_E_ROLE -2146762493
|
||||
CONSTANT: CERT_E_UNTRUSTEDROOT -2146762487
|
||||
CONSTANT: CERT_E_UNTRUSTEDTESTROOT -2146762483
|
||||
CONSTANT: CERT_E_VALIDITYPERIODNESTING -2146762494
|
||||
CONSTANT: CERT_E_WRONG_USAGE -2146762480
|
||||
CONSTANT: CERT_E_PATHLENCONST -2146762492
|
||||
CONSTANT: CERT_E_CRITICAL -2146762491
|
||||
CONSTANT: CERT_E_ISSUERCHAINING -2146762489
|
||||
CONSTANT: CERT_E_MALFORMED -2146762488
|
||||
CONSTANT: CRYPT_E_REVOCATION_OFFLINE -2146885613
|
||||
CONSTANT: CRYPT_E_REVOKED -2146885616
|
||||
CONSTANT: TRUST_E_BASIC_CONSTRAINTS -2146869223
|
||||
CONSTANT: TRUST_E_CERT_SIGNATURE -2146869244
|
||||
CONSTANT: TRUST_E_FAIL -2146762485
|
||||
CONSTANT: CERT_TRUST_NO_ERROR 0
|
||||
CONSTANT: CERT_TRUST_IS_NOT_TIME_VALID 1
|
||||
CONSTANT: CERT_TRUST_IS_NOT_TIME_NESTED 2
|
||||
CONSTANT: CERT_TRUST_IS_REVOKED 4
|
||||
CONSTANT: CERT_TRUST_IS_NOT_SIGNATURE_VALID 8
|
||||
CONSTANT: CERT_TRUST_IS_NOT_VALID_FOR_USAGE 16
|
||||
CONSTANT: CERT_TRUST_IS_UNTRUSTED_ROOT 32
|
||||
CONSTANT: CERT_TRUST_REVOCATION_STATUS_UNKNOWN 64
|
||||
CONSTANT: CERT_TRUST_IS_CYCLIC 128
|
||||
CONSTANT: CERT_TRUST_IS_PARTIAL_CHAIN 65536
|
||||
CONSTANT: CERT_TRUST_CTL_IS_NOT_TIME_VALID 131072
|
||||
CONSTANT: CERT_TRUST_CTL_IS_NOT_SIGNATURE_VALID 262144
|
||||
CONSTANT: CERT_TRUST_CTL_IS_NOT_VALID_FOR_USAGE 524288
|
||||
CONSTANT: CERT_TRUST_HAS_EXACT_MATCH_ISSUER 1
|
||||
CONSTANT: CERT_TRUST_HAS_KEY_MATCH_ISSUER 2
|
||||
CONSTANT: CERT_TRUST_HAS_NAME_MATCH_ISSUER 4
|
||||
CONSTANT: CERT_TRUST_IS_SELF_SIGNED 8
|
||||
CONSTANT: CERT_TRUST_IS_COMPLEX_CHAIN 65536
|
||||
CONSTANT: CERT_CHAIN_POLICY_BASE 1
|
||||
CONSTANT: CERT_CHAIN_POLICY_AUTHENTICODE 2
|
||||
CONSTANT: CERT_CHAIN_POLICY_AUTHENTICODE_TS 3
|
||||
CONSTANT: CERT_CHAIN_POLICY_SSL 4
|
||||
CONSTANT: CERT_CHAIN_POLICY_BASIC_CONSTRAINTS 5
|
||||
CONSTANT: CERT_CHAIN_POLICY_NT_AUTH 6
|
||||
CONSTANT: USAGE_MATCH_TYPE_AND 0
|
||||
CONSTANT: USAGE_MATCH_TYPE_OR 1
|
||||
CONSTANT: CERT_SIMPLE_NAME_STR 1
|
||||
CONSTANT: CERT_OID_NAME_STR 2
|
||||
CONSTANT: CERT_X500_NAME_STR 3
|
||||
CONSTANT: CERT_NAME_STR_SEMICOLON_FLAG 1073741824
|
||||
CONSTANT: CERT_NAME_STR_CRLF_FLAG 134217728
|
||||
CONSTANT: CERT_NAME_STR_NO_PLUS_FLAG 536870912
|
||||
CONSTANT: CERT_NAME_STR_NO_QUOTING_FLAG 268435456
|
||||
CONSTANT: CERT_NAME_STR_REVERSE_FLAG 33554432
|
||||
CONSTANT: CERT_NAME_STR_ENABLE_T61_UNICODE_FLAG 131072
|
||||
CONSTANT: CERT_FIND_ANY 0
|
||||
CONSTANT: CERT_FIND_CERT_ID 1048576
|
||||
CONSTANT: CERT_FIND_CTL_USAGE 655360
|
||||
CONSTANT: CERT_FIND_ENHKEY_USAGE 655360
|
||||
CONSTANT: CERT_FIND_EXISTING 851968
|
||||
CONSTANT: CERT_FIND_HASH 65536
|
||||
CONSTANT: CERT_FIND_ISSUER_ATTR 196612
|
||||
CONSTANT: CERT_FIND_ISSUER_NAME 131076
|
||||
CONSTANT: CERT_FIND_ISSUER_OF 786432
|
||||
CONSTANT: CERT_FIND_KEY_IDENTIFIER 983040
|
||||
CONSTANT: CERT_FIND_KEY_SPEC 589824
|
||||
CONSTANT: CERT_FIND_MD5_HASH 262144
|
||||
CONSTANT: CERT_FIND_PROPERTY 327680
|
||||
CONSTANT: CERT_FIND_PUBLIC_KEY 393216
|
||||
CONSTANT: CERT_FIND_SHA1_HASH 65536
|
||||
CONSTANT: CERT_FIND_SIGNATURE_HASH 917504
|
||||
CONSTANT: CERT_FIND_SUBJECT_ATTR 196615
|
||||
CONSTANT: CERT_FIND_SUBJECT_CERT 720896
|
||||
CONSTANT: CERT_FIND_SUBJECT_NAME 131079
|
||||
CONSTANT: CERT_FIND_SUBJECT_STR_A 458759
|
||||
CONSTANT: CERT_FIND_SUBJECT_STR_W 524295
|
||||
CONSTANT: CERT_FIND_ISSUER_STR_A 458756
|
||||
CONSTANT: CERT_FIND_ISSUER_STR_W 524292
|
||||
CONSTANT: CERT_FIND_OR_ENHKEY_USAGE_FLAG 16
|
||||
CONSTANT: CERT_FIND_OPTIONAL_ENHKEY_USAGE_FLAG 1
|
||||
CONSTANT: CERT_FIND_NO_ENHKEY_USAGE_FLAG 8
|
||||
CONSTANT: CERT_FIND_VALID_ENHKEY_USAGE_FLAG 32
|
||||
CONSTANT: CERT_FIND_EXT_ONLY_ENHKEY_USAGE_FLAG 2
|
||||
CONSTANT: CERT_CASE_INSENSITIVE_IS_RDN_ATTRS_FLAG 2
|
||||
CONSTANT: CERT_UNICODE_IS_RDN_ATTRS_FLAG 1
|
||||
CONSTANT: CERT_CHAIN_FIND_BY_ISSUER 1
|
||||
CONSTANT: CERT_CHAIN_FIND_BY_ISSUER_COMPARE_KEY_FLAG 1
|
||||
CONSTANT: CERT_CHAIN_FIND_BY_ISSUER_COMPLEX_CHAIN_FLAG 2
|
||||
CONSTANT: CERT_CHAIN_FIND_BY_ISSUER_CACHE_ONLY_FLAG 32768
|
||||
CONSTANT: CERT_CHAIN_FIND_BY_ISSUER_CACHE_ONLY_URL_FLAG 4
|
||||
CONSTANT: CERT_CHAIN_FIND_BY_ISSUER_LOCAL_MACHINE_FLAG 8
|
||||
CONSTANT: CERT_CHAIN_FIND_BY_ISSUER_NO_KEY_FLAG 16384
|
||||
CONSTANT: CERT_STORE_PROV_SYSTEM 10
|
||||
CONSTANT: CERT_SYSTEM_STORE_LOCAL_MACHINE 131072
|
||||
CONSTANT: szOID_PKIX_KP_SERVER_AUTH "4235600"
|
||||
CONSTANT: szOID_SERVER_GATED_CRYPTO "4235658"
|
||||
CONSTANT: szOID_SGC_NETSCAPE "2.16.840.1.113730.4.1"
|
||||
CONSTANT: szOID_PKIX_KP_CLIENT_AUTH "1.3.6.1.5.5.7.3.2"
|
||||
|
||||
CONSTANT: CRYPT_NOHASHOID HEX: 00000001
|
||||
CONSTANT: CRYPT_NO_SALT HEX: 10
|
||||
CONSTANT: CRYPT_PREGEN HEX: 40
|
||||
CONSTANT: CRYPT_RECIPIENT HEX: 10
|
||||
CONSTANT: CRYPT_INITIATOR HEX: 40
|
||||
CONSTANT: CRYPT_ONLINE HEX: 80
|
||||
CONSTANT: CRYPT_SF HEX: 100
|
||||
CONSTANT: CRYPT_CREATE_IV HEX: 200
|
||||
CONSTANT: CRYPT_KEK HEX: 400
|
||||
CONSTANT: CRYPT_DATA_KEY HEX: 800
|
||||
CONSTANT: CRYPT_VOLATILE HEX: 1000
|
||||
CONSTANT: CRYPT_SGCKEY HEX: 2000
|
||||
|
||||
CONSTANT: KEYSTATEBLOB HEX: C
|
||||
CONSTANT: OPAQUEKEYBLOB HEX: 9
|
||||
CONSTANT: PLAINTEXTKEYBLOB HEX: 8
|
||||
CONSTANT: PRIVATEKEYBLOB HEX: 7
|
||||
CONSTANT: PUBLICKEYBLOB HEX: 6
|
||||
CONSTANT: PUBLICKEYBLOBEX HEX: A
|
||||
CONSTANT: SIMPLEBLOB HEX: 1
|
||||
CONSTANT: SYMMETRICWRAPKEYBLOB HEX: B
|
||||
|
||||
TYPEDEF: uint ALG_ID
|
||||
|
||||
STRUCT: PUBLICKEYSTRUC
|
||||
{ bType BYTE }
|
||||
{ bVersion BYTE }
|
||||
{ reserved WORD }
|
||||
{ aiKeyAlg ALG_ID } ;
|
||||
|
||||
TYPEDEF: PUBLICKEYSTRUC BLOBHEADER
|
||||
TYPEDEF: LONG HCRYPTHASH
|
||||
TYPEDEF: LONG HCRYPTKEY
|
||||
TYPEDEF: DWORD REGSAM
|
||||
|
||||
! : I_ScGetCurrentGroupStateW ;
|
||||
|
|
@ -590,7 +864,7 @@ FUNCTION: BOOL CryptAcquireContextW ( HCRYPTPROV* phProv,
|
|||
ALIAS: CryptAcquireContext CryptAcquireContextW
|
||||
|
||||
! : CryptContextAddRef ;
|
||||
! : CryptCreateHash ;
|
||||
FUNCTION: BOOL CryptCreateHash ( HCRYPTPROV hProv, ALG_ID Algid, HCRYPTKEY hKey, DWORD dwFlags, HCRYPTHASH *pHash ) ;
|
||||
! : CryptDecrypt ;
|
||||
! : CryptDeriveKey ;
|
||||
! : CryptDestroyHash ;
|
||||
|
|
@ -613,7 +887,7 @@ FUNCTION: BOOL CryptGenRandom ( HCRYPTPROV hProv, DWORD dwLen, BYTE* pbBuffer )
|
|||
! : CryptGetUserKey ;
|
||||
! : CryptHashData ;
|
||||
! : CryptHashSessionKey ;
|
||||
! : CryptImportKey ;
|
||||
FUNCTION: BOOL CryptImportKey ( HCRYPTPROV hProv, BYTE *pbData, DWORD dwDataLen, HCRYPTKEY hPubKey, DWORD dwFlags, HCRYPTKEY *phKey ) ;
|
||||
FUNCTION: BOOL CryptReleaseContext ( HCRYPTPROV hProv, DWORD dwFlags ) ;
|
||||
! : CryptSetHashParam ;
|
||||
! : CryptSetKeyParam ;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
USING: alien.syntax windows.types classes.struct math alien.c-types
|
||||
math.bitwise kernel locals windows.kernel32 ;
|
||||
math.bitwise kernel locals windows.kernel32 literals ;
|
||||
IN: windows.directx.d3d9types
|
||||
|
||||
TYPEDEF: DWORD D3DCOLOR
|
||||
|
|
@ -54,19 +54,21 @@ CONSTANT: D3DCS_PLANE3 HEX: 00000200
|
|||
CONSTANT: D3DCS_PLANE4 HEX: 00000400
|
||||
CONSTANT: D3DCS_PLANE5 HEX: 00000800
|
||||
|
||||
: D3DCS_ALL ( -- n )
|
||||
{ D3DCS_LEFT
|
||||
D3DCS_RIGHT
|
||||
D3DCS_TOP
|
||||
D3DCS_BOTTOM
|
||||
D3DCS_FRONT
|
||||
D3DCS_BACK
|
||||
D3DCS_PLANE0
|
||||
D3DCS_PLANE1
|
||||
D3DCS_PLANE2
|
||||
D3DCS_PLANE3
|
||||
D3DCS_PLANE4
|
||||
D3DCS_PLANE5 } flags ; inline
|
||||
CONSTANT: D3DCS_ALL
|
||||
flags{
|
||||
D3DCS_LEFT
|
||||
D3DCS_RIGHT
|
||||
D3DCS_TOP
|
||||
D3DCS_BOTTOM
|
||||
D3DCS_FRONT
|
||||
D3DCS_BACK
|
||||
D3DCS_PLANE0
|
||||
D3DCS_PLANE1
|
||||
D3DCS_PLANE2
|
||||
D3DCS_PLANE3
|
||||
D3DCS_PLANE4
|
||||
D3DCS_PLANE5
|
||||
}
|
||||
|
||||
STRUCT: D3DCLIPSTATUS9
|
||||
{ ClipUnion DWORD }
|
||||
|
|
@ -777,8 +779,7 @@ CONSTANT: D3DVS_SWIZZLE_MASK HEX: 00FF0000
|
|||
: D3DVS_W_Z ( -- n ) 2 D3DVS_SWIZZLE_SHIFT 6 + shift ; inline
|
||||
: D3DVS_W_W ( -- n ) 3 D3DVS_SWIZZLE_SHIFT 6 + shift ; inline
|
||||
|
||||
: D3DVS_NOSWIZZLE ( -- n )
|
||||
{ D3DVS_X_X D3DVS_Y_Y D3DVS_Z_Z D3DVS_W_W } flags ; inline
|
||||
CONSTANT: D3DVS_NOSWIZZLE flags{ D3DVS_X_X D3DVS_Y_Y D3DVS_Z_Z D3DVS_W_W }
|
||||
|
||||
CONSTANT: D3DSP_SWIZZLE_SHIFT 16
|
||||
CONSTANT: D3DSP_SWIZZLE_MASK HEX: 00FF0000
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
USING: alien.data kernel locals math math.bitwise
|
||||
windows.kernel32 sequences byte-arrays unicode.categories
|
||||
io.encodings.string io.encodings.utf16n alien.strings
|
||||
arrays literals windows.types specialized-arrays ;
|
||||
arrays literals windows.types specialized-arrays literals ;
|
||||
SPECIALIZED-ARRAY: TCHAR
|
||||
IN: windows.errors
|
||||
|
||||
|
|
@ -705,10 +705,10 @@ CONSTANT: FORMAT_MESSAGE_MAX_WIDTH_MASK HEX: 000000FF
|
|||
|
||||
ERROR: error-message-failed id ;
|
||||
:: n>win32-error-string ( id -- string )
|
||||
{
|
||||
flags{
|
||||
FORMAT_MESSAGE_FROM_SYSTEM
|
||||
FORMAT_MESSAGE_ARGUMENT_ARRAY
|
||||
} flags
|
||||
}
|
||||
f
|
||||
id
|
||||
LANG_NEUTRAL SUBLANG_DEFAULT make-lang-id
|
||||
|
|
@ -719,8 +719,10 @@ ERROR: error-message-failed id ;
|
|||
: win32-error-string ( -- str )
|
||||
GetLastError n>win32-error-string ;
|
||||
|
||||
ERROR: windows-error n string ;
|
||||
|
||||
: (win32-error) ( n -- )
|
||||
[ win32-error-string throw ] unless-zero ;
|
||||
[ dup win32-error-string windows-error ] unless-zero ;
|
||||
|
||||
: win32-error ( -- )
|
||||
GetLastError (win32-error) ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2005, 2006 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types alien.syntax alien.destructors
|
||||
kernel windows.types math.bitwise ;
|
||||
kernel windows.types math.bitwise literals ;
|
||||
IN: windows.gdi32
|
||||
|
||||
CONSTANT: BI_RGB 0
|
||||
|
|
@ -818,7 +818,7 @@ CONSTANT: TA_RIGHT 2
|
|||
CONSTANT: TA_RTLREADING 256
|
||||
CONSTANT: TA_NOUPDATECP 0
|
||||
CONSTANT: TA_UPDATECP 1
|
||||
: TA_MASK ( -- n ) { TA_BASELINE TA_CENTER TA_UPDATECP TA_RTLREADING } flags ; foldable
|
||||
CONSTANT: TA_MASK flags{ TA_BASELINE TA_CENTER TA_UPDATECP TA_RTLREADING }
|
||||
CONSTANT: VTA_BASELINE 24
|
||||
CONSTANT: VTA_CENTER 6
|
||||
ALIAS: VTA_LEFT TA_BOTTOM
|
||||
|
|
|
|||
|
|
@ -33,18 +33,17 @@ CONSTANT: WS_MINIMIZEBOX HEX: 00020000
|
|||
CONSTANT: WS_MAXIMIZEBOX HEX: 00010000
|
||||
|
||||
! Common window styles
|
||||
: WS_OVERLAPPEDWINDOW ( -- n )
|
||||
{
|
||||
CONSTANT: WS_OVERLAPPEDWINDOW
|
||||
flags{
|
||||
WS_OVERLAPPED
|
||||
WS_CAPTION
|
||||
WS_SYSMENU
|
||||
WS_THICKFRAME
|
||||
WS_MINIMIZEBOX
|
||||
WS_MAXIMIZEBOX
|
||||
} flags ; foldable
|
||||
}
|
||||
|
||||
: WS_POPUPWINDOW ( -- n )
|
||||
{ WS_POPUP WS_BORDER WS_SYSMENU } flags ; foldable
|
||||
CONSTANT: WS_POPUPWINDOW flags{ WS_POPUP WS_BORDER WS_SYSMENU }
|
||||
|
||||
ALIAS: WS_CHILDWINDOW WS_CHILD
|
||||
|
||||
|
|
@ -76,11 +75,11 @@ CONSTANT: WS_EX_CONTROLPARENT HEX: 00010000
|
|||
CONSTANT: WS_EX_STATICEDGE HEX: 00020000
|
||||
CONSTANT: WS_EX_APPWINDOW HEX: 00040000
|
||||
|
||||
: WS_EX_OVERLAPPEDWINDOW ( -- n )
|
||||
WS_EX_WINDOWEDGE WS_EX_CLIENTEDGE bitor ; foldable
|
||||
CONSTANT: WS_EX_OVERLAPPEDWINDOW
|
||||
flags{ WS_EX_WINDOWEDGE WS_EX_CLIENTEDGE }
|
||||
|
||||
: WS_EX_PALETTEWINDOW ( -- n )
|
||||
{ WS_EX_WINDOWEDGE WS_EX_TOOLWINDOW WS_EX_TOPMOST } flags ; foldable
|
||||
CONSTANT: WS_EX_PALETTEWINDOW
|
||||
flags{ WS_EX_WINDOWEDGE WS_EX_TOOLWINDOW WS_EX_TOPMOST }
|
||||
|
||||
CONSTANT: CS_VREDRAW HEX: 0001
|
||||
CONSTANT: CS_HREDRAW HEX: 0002
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
USING: alien alien.c-types alien.strings alien.syntax arrays
|
||||
byte-arrays kernel literals math sequences windows.types
|
||||
windows.kernel32 windows.errors math.bitwise io.encodings.utf16n
|
||||
classes.struct windows.com.syntax init ;
|
||||
classes.struct windows.com.syntax init literals ;
|
||||
FROM: alien.c-types => short ;
|
||||
IN: windows.winsock
|
||||
|
||||
|
|
@ -73,8 +73,7 @@ CONSTANT: AI_PASSIVE 1
|
|||
CONSTANT: AI_CANONNAME 2
|
||||
CONSTANT: AI_NUMERICHOST 4
|
||||
|
||||
: AI_MASK ( -- n )
|
||||
{ AI_PASSIVE AI_CANONNAME AI_NUMERICHOST } flags ; inline
|
||||
CONSTANT: AI_MASK flags{ AI_PASSIVE AI_CANONNAME AI_NUMERICHOST }
|
||||
|
||||
CONSTANT: NI_NUMERICHOST 1
|
||||
CONSTANT: NI_NUMERICSERV 2
|
||||
|
|
|
|||
|
|
@ -2,18 +2,18 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel math math.bitwise math.vectors
|
||||
namespaces sequences x11 x11.xlib x11.constants x11.glx arrays
|
||||
fry classes.struct ;
|
||||
fry classes.struct literals ;
|
||||
IN: x11.windows
|
||||
|
||||
: create-window-mask ( -- n )
|
||||
{ CWBackPixel CWBorderPixel CWColormap CWEventMask } flags ;
|
||||
CONSTANT: create-window-mask
|
||||
flags{ CWBackPixel CWBorderPixel CWColormap CWEventMask }
|
||||
|
||||
: create-colormap ( visinfo -- colormap )
|
||||
[ dpy get root get ] dip visual>> AllocNone
|
||||
XCreateColormap ;
|
||||
|
||||
: event-mask ( -- n )
|
||||
{
|
||||
CONSTANT: event-mask
|
||||
flags{
|
||||
ExposureMask
|
||||
StructureNotifyMask
|
||||
KeyPressMask
|
||||
|
|
@ -25,7 +25,7 @@ IN: x11.windows
|
|||
EnterWindowMask
|
||||
LeaveWindowMask
|
||||
PropertyChangeMask
|
||||
} flags ;
|
||||
}
|
||||
|
||||
: window-attributes ( visinfo -- attributes )
|
||||
XSetWindowAttributes <struct>
|
||||
|
|
|
|||
|
|
@ -12,7 +12,8 @@
|
|||
! and note the section.
|
||||
USING: accessors kernel arrays alien alien.c-types alien.data
|
||||
alien.strings alien.syntax classes.struct math math.bitwise words
|
||||
sequences namespaces continuations io io.encodings.ascii x11.syntax ;
|
||||
sequences namespaces continuations io io.encodings.ascii x11.syntax
|
||||
literals ;
|
||||
FROM: alien.c-types => short ;
|
||||
IN: x11.xlib
|
||||
|
||||
|
|
@ -1134,8 +1135,8 @@ X-FUNCTION: Status XWithdrawWindow (
|
|||
: PAspect ( -- n ) 7 2^ ; inline
|
||||
: PBaseSize ( -- n ) 8 2^ ; inline
|
||||
: PWinGravity ( -- n ) 9 2^ ; inline
|
||||
: PAllHints ( -- n )
|
||||
{ PPosition PSize PMinSize PMaxSize PResizeInc PAspect } flags ; foldable
|
||||
CONSTANT: PAllHints
|
||||
flags{ PPosition PSize PMinSize PMaxSize PResizeInc PAspect }
|
||||
|
||||
STRUCT: XSizeHints
|
||||
{ flags long }
|
||||
|
|
|
|||
|
|
@ -370,7 +370,9 @@ tuple
|
|||
{ "fixnum>" "math.private" (( x y -- ? )) }
|
||||
{ "fixnum>=" "math.private" (( x y -- ? )) }
|
||||
{ "(set-context)" "threads.private" (( obj context -- obj' )) }
|
||||
{ "(set-context-and-delete)" "threads.private" (( obj context -- * )) }
|
||||
{ "(start-context)" "threads.private" (( obj quot -- obj' )) }
|
||||
{ "(start-context-and-delete)" "threads.private" (( obj quot -- * )) }
|
||||
} [ first3 make-sub-primitive ] each
|
||||
|
||||
! Primitive words
|
||||
|
|
@ -531,7 +533,7 @@ tuple
|
|||
{ "set-string-nth-fast" "strings.private" "primitive_set_string_nth_fast" (( ch n string -- )) }
|
||||
{ "set-string-nth-slow" "strings.private" "primitive_set_string_nth_slow" (( ch n string -- )) }
|
||||
{ "string-nth" "strings.private" "primitive_string_nth" (( n string -- ch )) }
|
||||
{ "(exit)" "system" "primitive_exit" (( n -- )) }
|
||||
{ "(exit)" "system" "primitive_exit" (( n -- * )) }
|
||||
{ "nano-count" "system" "primitive_nano_count" (( -- ns )) }
|
||||
{ "system-micros" "system" "primitive_system_micros" (( -- us )) }
|
||||
{ "(sleep)" "threads.private" "primitive_sleep" (( nanos -- )) }
|
||||
|
|
@ -540,13 +542,12 @@ tuple
|
|||
{ "context-object-for" "threads.private" "primitive_context_object_for" (( n context -- obj )) }
|
||||
{ "datastack-for" "threads.private" "primitive_datastack_for" (( context -- array )) }
|
||||
{ "retainstack-for" "threads.private" "primitive_retainstack_for" (( context -- array )) }
|
||||
{ "delete-context" "threads.private" "primitive_delete_context" (( context -- )) }
|
||||
{ "dispatch-stats" "tools.dispatch.private" "primitive_dispatch_stats" (( -- stats )) }
|
||||
{ "reset-dispatch-stats" "tools.dispatch.private" "primitive_reset_dispatch_stats" (( -- )) }
|
||||
{ "profiling" "tools.profiler.private" "primitive_profiling" (( ? -- )) }
|
||||
{ "optimized?" "words" "primitive_optimized_p" (( word -- ? )) }
|
||||
{ "word-code" "words" "primitive_word_code" (( word -- start end )) }
|
||||
{ "(word)" "words.private" "primitive_word" (( name vocab -- word )) }
|
||||
{ "(word)" "words.private" "primitive_word" (( name vocab hashcode -- word )) }
|
||||
} [ first4 make-primitive ] each
|
||||
|
||||
! Bump build number
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2007, 2009 Slava Pestov.
|
||||
! Copyright (C) 2007, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel kernel.private sequences math namespaces
|
||||
init splitting assocs system.private layouts words ;
|
||||
|
|
@ -57,4 +57,4 @@ PRIVATE>
|
|||
|
||||
: embedded? ( -- ? ) 15 special-object ;
|
||||
|
||||
: exit ( n -- ) do-shutdown-hooks (exit) ;
|
||||
: exit ( n -- * ) do-shutdown-hooks (exit) ;
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ IN: fullscreen
|
|||
:: (monitor-info>devmodes) ( monitor-info n -- )
|
||||
DEVMODE <struct>
|
||||
DEVMODE heap-size >>dmSize
|
||||
{ DM_BITSPERPEL DM_PELSWIDTH DM_PELSHEIGHT } flags >>dmFields
|
||||
flags{ DM_BITSPERPEL DM_PELSWIDTH DM_PELSHEIGHT } >>dmFields
|
||||
:> devmode
|
||||
|
||||
monitor-info szDevice>>
|
||||
|
|
@ -73,11 +73,11 @@ ERROR: display-change-error n ;
|
|||
|
||||
: set-fullscreen-styles ( hwnd -- )
|
||||
[ GWL_STYLE [ WS_OVERLAPPEDWINDOW unmask ] change-style ]
|
||||
[ GWL_EXSTYLE [ { WS_EX_APPWINDOW WS_EX_TOPMOST } flags bitor ] change-style ] bi ;
|
||||
[ GWL_EXSTYLE [ flags{ WS_EX_APPWINDOW WS_EX_TOPMOST } bitor ] change-style ] bi ;
|
||||
|
||||
: set-non-fullscreen-styles ( hwnd -- )
|
||||
[ GWL_STYLE [ WS_OVERLAPPEDWINDOW bitor ] change-style ]
|
||||
[ GWL_EXSTYLE [ { WS_EX_APPWINDOW WS_EX_TOPMOST } flags unmask ] change-style ] bi ;
|
||||
[ GWL_EXSTYLE [ flags{ WS_EX_APPWINDOW WS_EX_TOPMOST } unmask ] change-style ] bi ;
|
||||
|
||||
ERROR: unsupported-resolution triple ;
|
||||
|
||||
|
|
@ -92,10 +92,10 @@ ERROR: unsupported-resolution triple ;
|
|||
hwnd f
|
||||
desktop-monitor-info rcMonitor>> slots{ left top } first2
|
||||
triple first2
|
||||
{
|
||||
flags{
|
||||
SWP_NOACTIVATE SWP_NOCOPYBITS SWP_NOOWNERZORDER
|
||||
SWP_NOREPOSITION SWP_NOZORDER
|
||||
} flags
|
||||
}
|
||||
SetWindowPos win32-error=0/f ;
|
||||
|
||||
:: enable-fullscreen ( triple hwnd -- rect )
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.syntax kernel math.bitwise sequences system io.serial ;
|
||||
USING: alien.syntax kernel math.bitwise sequences system io.serial
|
||||
literals ;
|
||||
IN: io.serial.unix
|
||||
|
||||
M: bsd lookup-baud ( m -- n )
|
||||
|
|
@ -60,7 +61,7 @@ CONSTANT: HUPCL HEX: 00004000
|
|||
CONSTANT: CLOCAL HEX: 00008000
|
||||
CONSTANT: CCTS_OFLOW HEX: 00010000
|
||||
CONSTANT: CRTS_IFLOW HEX: 00020000
|
||||
: CRTSCTS ( -- n ) { CCTS_OFLOW CRTS_IFLOW } flags ; inline
|
||||
CONSTANT: CRTSCTS flags{ CCTS_OFLOW CRTS_IFLOW }
|
||||
CONSTANT: CDTR_IFLOW HEX: 00040000
|
||||
CONSTANT: CDSR_OFLOW HEX: 00080000
|
||||
CONSTANT: CCAR_OFLOW HEX: 00100000
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel math.bitwise io.serial io.serial.unix ;
|
||||
USING: accessors kernel math.bitwise io.serial io.serial.unix
|
||||
literals ;
|
||||
IN: io.serial.unix
|
||||
|
||||
: serial-obj ( -- obj )
|
||||
|
|
@ -10,10 +11,10 @@ IN: io.serial.unix
|
|||
! "/dev/ttyd0" >>path ! freebsd
|
||||
! "/dev/ttyU0" >>path ! openbsd
|
||||
19200 >>baud
|
||||
{ IGNPAR ICRNL } flags >>iflag
|
||||
{ } flags >>oflag
|
||||
{ CS8 CLOCAL CREAD } flags >>cflag
|
||||
{ ICANON } flags >>lflag ;
|
||||
flags{ IGNPAR ICRNL } >>iflag
|
||||
flags{ } >>oflag
|
||||
flags{ CS8 CLOCAL CREAD } >>cflag
|
||||
flags{ ICANON } >>lflag ;
|
||||
|
||||
: serial-test ( -- serial )
|
||||
serial-obj
|
||||
|
|
|
|||
|
|
@ -3,7 +3,8 @@
|
|||
USING: accessors alien.c-types alien.syntax alien.data
|
||||
classes.struct combinators io.ports io.streams.duplex
|
||||
system kernel math math.bitwise vocabs.loader io.serial
|
||||
io.serial.unix.termios io.backend.unix unix unix.ffi ;
|
||||
io.serial.unix.termios io.backend.unix unix unix.ffi
|
||||
literals ;
|
||||
IN: io.serial.unix
|
||||
|
||||
<< {
|
||||
|
|
@ -33,7 +34,7 @@ FUNCTION: int cfsetspeed ( termios* t, speed_t s ) ;
|
|||
|
||||
M: unix open-serial ( serial -- serial' )
|
||||
dup
|
||||
path>> { O_RDWR O_NOCTTY O_NDELAY } flags file-mode open-file
|
||||
path>> flags{ O_RDWR O_NOCTTY O_NDELAY } file-mode open-file
|
||||
fd>duplex-stream >>stream ;
|
||||
|
||||
: serial-fd ( serial -- fd )
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ ui.gadgets.worlds ui.pixel-formats specialized-arrays
|
|||
specialized-vectors literals fry
|
||||
sequences.deep destructors math.bitwise opengl.gl
|
||||
game.models game.models.obj game.models.loader game.models.collada
|
||||
prettyprint images.tga ;
|
||||
prettyprint images.tga literals ;
|
||||
FROM: alien.c-types => float ;
|
||||
SPECIALIZED-ARRAY: float
|
||||
SPECIALIZED-VECTOR: uint
|
||||
|
|
@ -164,9 +164,9 @@ TUPLE: vbo
|
|||
0 0 0 0 glClearColor
|
||||
1 glClearDepth
|
||||
HEX: ffffffff glClearStencil
|
||||
{ GL_COLOR_BUFFER_BIT
|
||||
flags{ GL_COLOR_BUFFER_BIT
|
||||
GL_DEPTH_BUFFER_BIT
|
||||
GL_STENCIL_BUFFER_BIT } flags glClear ;
|
||||
GL_STENCIL_BUFFER_BIT } glClear ;
|
||||
|
||||
: draw-model ( world -- )
|
||||
clear-screen
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: cocoa cocoa.application cocoa.types cocoa.classes cocoa.windows
|
||||
core-graphics.types kernel math.bitwise ;
|
||||
core-graphics.types kernel math.bitwise literals ;
|
||||
IN: webkit-demo
|
||||
|
||||
FRAMEWORK: /System/Library/Frameworks/WebKit.framework
|
||||
|
|
@ -13,13 +13,13 @@ IMPORT: WebView
|
|||
WebView -> alloc
|
||||
rect f f -> initWithFrame:frameName:groupName: ;
|
||||
|
||||
: window-style ( -- n )
|
||||
{
|
||||
CONSTANT: window-style ( -- n )
|
||||
flags{
|
||||
NSClosableWindowMask
|
||||
NSMiniaturizableWindowMask
|
||||
NSResizableWindowMask
|
||||
NSTitledWindowMask
|
||||
} flags ;
|
||||
}
|
||||
|
||||
: <WebWindow> ( -- id )
|
||||
<WebView> rect window-style <ViewWindow> ;
|
||||
|
|
|
|||
|
|
@ -119,6 +119,11 @@ void factor_vm::delete_context(context *old_context)
|
|||
active_contexts.erase(old_context);
|
||||
}
|
||||
|
||||
VM_C_API void delete_context(factor_vm *parent, context *old_context)
|
||||
{
|
||||
parent->delete_context(old_context);
|
||||
}
|
||||
|
||||
void factor_vm::begin_callback()
|
||||
{
|
||||
ctx->reset();
|
||||
|
|
@ -185,7 +190,10 @@ cell factor_vm::datastack_to_array(context *ctx)
|
|||
{
|
||||
cell array = stack_to_array(ctx->datastack_seg->start,ctx->datastack);
|
||||
if(array == false_object)
|
||||
{
|
||||
general_error(ERROR_DATASTACK_UNDERFLOW,false_object,false_object);
|
||||
return false_object;
|
||||
}
|
||||
else
|
||||
return array;
|
||||
}
|
||||
|
|
@ -293,10 +301,4 @@ void factor_vm::primitive_context()
|
|||
ctx->push(allot_alien(ctx));
|
||||
}
|
||||
|
||||
void factor_vm::primitive_delete_context()
|
||||
{
|
||||
context *old_context = (context *)pinned_alien_offset(ctx->pop());
|
||||
delete_context(old_context);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -70,6 +70,7 @@ struct context {
|
|||
};
|
||||
|
||||
VM_C_API context *new_context(factor_vm *parent);
|
||||
VM_C_API void delete_context(factor_vm *parent, context *old_context);
|
||||
VM_C_API void begin_callback(factor_vm *parent);
|
||||
VM_C_API void end_callback(factor_vm *parent);
|
||||
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@ namespace factor
|
|||
|
||||
#define FACTOR_CPU_STRING "ppc"
|
||||
|
||||
#define CALLSTACK_BOTTOM(ctx) (stack_frame *)ctx->callstack_seg->end
|
||||
#define CALLSTACK_BOTTOM(ctx) (stack_frame *)(ctx->callstack_seg->end - 32)
|
||||
|
||||
/* In the instruction sequence:
|
||||
|
||||
|
|
|
|||
|
|
@ -93,9 +93,6 @@ enum special_object {
|
|||
OBJ_SLEEP_QUEUE = 66,
|
||||
|
||||
OBJ_VM_COMPILER = 67, /* version string of the compiler we were built with */
|
||||
|
||||
OBJ_RECYCLE_THREAD = 68,
|
||||
OBJ_RECYCLE_QUEUE = 69,
|
||||
};
|
||||
|
||||
/* save-image-and-exit discards special objects that are filled in on startup
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@ namespace factor
|
|||
|
||||
#define VM_C_API extern "C" __attribute__((visibility("default")))
|
||||
#define FACTOR_OS_STRING "macosx"
|
||||
#define NULL_DLL "libfactor.dylib"
|
||||
#define NULL_DLL NULL
|
||||
|
||||
void early_init();
|
||||
|
||||
|
|
|
|||
|
|
@ -46,7 +46,6 @@ void sleep_nanos(u64 nsec)
|
|||
|
||||
void factor_vm::init_ffi()
|
||||
{
|
||||
/* NULL_DLL is "libfactor.dylib" for OS X and NULL for generic Unix */
|
||||
null_dll = dlopen(NULL_DLL,RTLD_LAZY);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -50,7 +50,6 @@ namespace factor
|
|||
_(data_room) \
|
||||
_(datastack) \
|
||||
_(datastack_for) \
|
||||
_(delete_context) \
|
||||
_(die) \
|
||||
_(disable_gc_events) \
|
||||
_(dispatch_stats) \
|
||||
|
|
|
|||
Loading…
Reference in New Issue