Merge branch 'master' of git://factorcode.org/git/factor
commit
28f54b7fac
|
@ -164,7 +164,7 @@ GENERIC: stack-size ( type -- size ) foldable
|
|||
|
||||
M: string stack-size c-type stack-size ;
|
||||
|
||||
M: c-type stack-size size>> ;
|
||||
M: c-type stack-size size>> cell align ;
|
||||
|
||||
GENERIC: byte-length ( seq -- n ) flushable
|
||||
|
||||
|
@ -436,6 +436,6 @@ M: long-long-type box-return ( type -- )
|
|||
"double" define-primitive-type
|
||||
|
||||
"long" "ptrdiff_t" typedef
|
||||
|
||||
"long" "intptr_t" typedef
|
||||
"ulong" "size_t" typedef
|
||||
] with-compilation-unit
|
||||
|
|
|
@ -1,14 +1,10 @@
|
|||
! Copyright (C) 2004, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays generic hashtables kernel kernel.private
|
||||
math namespaces parser sequences strings words libc
|
||||
math namespaces parser sequences strings words libc fry
|
||||
alien.c-types alien.structs.fields cpu.architecture ;
|
||||
IN: alien.structs
|
||||
|
||||
: if-value-structs? ( ctype true false -- )
|
||||
value-structs?
|
||||
[ drop call ] [ >r 2drop "void*" r> call ] if ; inline
|
||||
|
||||
TUPLE: struct-type size align fields ;
|
||||
|
||||
M: struct-type heap-size size>> ;
|
||||
|
@ -17,20 +13,26 @@ M: struct-type c-type-align align>> ;
|
|||
|
||||
M: struct-type c-type-stack-align? drop f ;
|
||||
|
||||
M: struct-type unbox-parameter
|
||||
[ %unbox-struct ] [ unbox-parameter ] if-value-structs? ;
|
||||
: if-value-struct ( ctype true false -- )
|
||||
[ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
|
||||
|
||||
M: struct-type unbox-return
|
||||
f swap %unbox-struct ;
|
||||
M: struct-type unbox-parameter
|
||||
[ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ;
|
||||
|
||||
M: struct-type box-parameter
|
||||
[ %box-struct ] [ box-parameter ] if-value-structs? ;
|
||||
[ %box-large-struct ] [ box-parameter ] if-value-struct ;
|
||||
|
||||
: if-small-struct ( c-type true false -- ? )
|
||||
[ dup struct-small-enough? ] 2dip '[ f swap @ ] if ; inline
|
||||
|
||||
M: struct-type unbox-return
|
||||
[ %unbox-small-struct ] [ %unbox-large-struct ] if-small-struct ;
|
||||
|
||||
M: struct-type box-return
|
||||
f swap %box-struct ;
|
||||
[ %box-small-struct ] [ %box-large-struct ] if-small-struct ;
|
||||
|
||||
M: struct-type stack-size
|
||||
[ heap-size ] [ stack-size ] if-value-structs? ;
|
||||
[ heap-size ] [ stack-size ] if-value-struct ;
|
||||
|
||||
: c-struct? ( type -- ? ) (c-type) struct-type? ;
|
||||
|
||||
|
@ -40,7 +42,7 @@ M: struct-type stack-size
|
|||
-rot define-c-type ;
|
||||
|
||||
: define-struct-early ( name vocab fields -- fields )
|
||||
-rot [ rot first2 <field-spec> ] 2curry map ;
|
||||
[ first2 <field-spec> ] with with map ;
|
||||
|
||||
: compute-struct-align ( types -- n )
|
||||
[ c-type-align ] map supremum ;
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: http.client checksums checksums.openssl splitting assocs
|
||||
USING: http.client checksums checksums.md5 splitting assocs
|
||||
kernel io.files bootstrap.image sequences io urls ;
|
||||
IN: bootstrap.image.download
|
||||
|
||||
|
@ -13,7 +13,7 @@ IN: bootstrap.image.download
|
|||
: need-new-image? ( image -- ? )
|
||||
dup exists?
|
||||
[
|
||||
[ openssl-md5 checksum-file hex-string ]
|
||||
[ md5 checksum-file hex-string ]
|
||||
[ download-checksums at ]
|
||||
bi = not
|
||||
] [ drop t ] if ;
|
||||
|
|
|
@ -235,7 +235,7 @@ M: float-regs reg-class-variable drop float-regs ;
|
|||
GENERIC: inc-reg-class ( register-class -- )
|
||||
|
||||
: ?dummy-stack-params ( reg-class -- )
|
||||
dummy-stack-params? [ reg-size stack-params +@ ] [ drop ] if ;
|
||||
dummy-stack-params? [ reg-size cell align stack-params +@ ] [ drop ] if ;
|
||||
|
||||
: ?dummy-int-params ( reg-class -- )
|
||||
dummy-int-params? [ reg-size cell /i 1 max int-regs +@ ] [ drop ] if ;
|
||||
|
@ -264,7 +264,7 @@ M: object reg-class-full?
|
|||
|
||||
: spill-param ( reg-class -- n reg-class )
|
||||
stack-params get
|
||||
>r reg-size stack-params +@ r>
|
||||
>r reg-size cell align stack-params +@ r>
|
||||
stack-params ;
|
||||
|
||||
: fastcall-param ( reg-class -- n reg-class )
|
||||
|
|
|
@ -6,7 +6,7 @@ HELP: enable-compiler
|
|||
{ $description "Enables the optimizing compiler." } ;
|
||||
|
||||
HELP: disable-compiler
|
||||
{ $description "Enables the optimizing compiler." } ;
|
||||
{ $description "Disable the optimizing compiler." } ;
|
||||
|
||||
ARTICLE: "compiler-usage" "Calling the optimizing compiler"
|
||||
"Normally, new word definitions are recompiled automatically. This can be changed:"
|
||||
|
|
|
@ -146,13 +146,21 @@ FUNCTION: void ffi_test_20 double x1, double x2, double x3,
|
|||
|
||||
! Make sure XT doesn't get clobbered in stack frame
|
||||
|
||||
: ffi_test_31 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a ptr -- result y )
|
||||
"void"
|
||||
: ffi_test_31 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a -- result y )
|
||||
"int"
|
||||
f "ffi_test_31"
|
||||
{ "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" }
|
||||
alien-invoke gc 3 ;
|
||||
|
||||
[ 3 ] [ 42 [ ] each ffi_test_31 ] unit-test
|
||||
[ 861 3 ] [ 42 [ ] each ffi_test_31 ] unit-test
|
||||
|
||||
: ffi_test_31_point_5 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a -- result )
|
||||
"float"
|
||||
f "ffi_test_31_point_5"
|
||||
{ "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" }
|
||||
alien-invoke ;
|
||||
|
||||
[ 861.0 ] [ 42 [ >float ] each ffi_test_31_point_5 ] unit-test
|
||||
|
||||
FUNCTION: longlong ffi_test_21 long x long y ;
|
||||
|
||||
|
|
|
@ -141,10 +141,10 @@ HOOK: %loop-entry cpu ( -- )
|
|||
HOOK: small-enough? cpu ( n -- ? )
|
||||
|
||||
! Is this structure small enough to be returned in registers?
|
||||
HOOK: struct-small-enough? cpu ( heap-size -- ? )
|
||||
HOOK: struct-small-enough? cpu ( c-type -- ? )
|
||||
|
||||
! Do we pass value structs by value or hidden reference?
|
||||
HOOK: value-structs? cpu ( -- ? )
|
||||
! Do we pass this struct by value or hidden reference?
|
||||
HOOK: value-struct? cpu ( c-type -- ? )
|
||||
|
||||
! If t, all parameters are shadowed by dummy stack parameters
|
||||
HOOK: dummy-stack-params? cpu ( -- ? )
|
||||
|
@ -207,14 +207,3 @@ M: object %callback-return drop %return ;
|
|||
M: stack-params param-reg drop ;
|
||||
|
||||
M: stack-params param-regs drop f ;
|
||||
|
||||
: if-small-struct ( n size true false -- ? )
|
||||
[ 2dup [ not ] [ struct-small-enough? ] bi* and ] 2dip
|
||||
[ '[ nip @ ] ] dip if ;
|
||||
inline
|
||||
|
||||
: %unbox-struct ( n c-type -- )
|
||||
[ %unbox-small-struct ] [ %unbox-large-struct ] if-small-struct ;
|
||||
|
||||
: %box-struct ( n c-type -- )
|
||||
[ %box-small-struct ] [ %box-large-struct ] if-small-struct ;
|
||||
|
|
|
@ -15,7 +15,7 @@ M: linux lr-save 1 cells ;
|
|||
|
||||
M: float-regs param-regs drop { 1 2 3 4 5 6 7 8 } ;
|
||||
|
||||
M: ppc value-structs? f ;
|
||||
M: ppc value-struct? drop f ;
|
||||
|
||||
M: ppc dummy-stack-params? f ;
|
||||
|
||||
|
|
|
@ -16,7 +16,7 @@ M: macosx lr-save 2 cells ;
|
|||
|
||||
M: float-regs param-regs drop { 1 2 3 4 5 6 7 8 9 10 11 12 13 } ;
|
||||
|
||||
M: ppc value-structs? t ;
|
||||
M: ppc value-struct? drop t ;
|
||||
|
||||
M: ppc dummy-stack-params? t ;
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel layouts system math alien.c-types
|
||||
USING: kernel layouts system math alien.c-types sequences
|
||||
compiler.cfg.registers cpu.architecture cpu.x86.assembler cpu.x86 ;
|
||||
IN: cpu.x86.64.winnt
|
||||
|
||||
|
@ -10,8 +10,9 @@ M: float-regs param-regs drop { XMM0 XMM1 XMM2 XMM3 } ;
|
|||
|
||||
M: x86.64 reserved-area-size 4 cells ;
|
||||
|
||||
M: x86.64 struct-small-enough? ( size -- ? )
|
||||
heap-size cell <= ;
|
||||
M: x86.64 struct-small-enough? heap-size { 1 2 4 8 } member? ;
|
||||
|
||||
M: x86.64 value-struct? heap-size { 1 2 4 8 } member? ;
|
||||
|
||||
M: x86.64 dummy-stack-params? f ;
|
||||
|
||||
|
@ -21,6 +22,7 @@ M: x86.64 dummy-fp-params? t ;
|
|||
|
||||
<<
|
||||
"longlong" "ptrdiff_t" typedef
|
||||
"longlong" "intptr_t" typedef
|
||||
"int" "long" typedef
|
||||
"uint" "ulong" typedef
|
||||
>>
|
||||
|
|
|
@ -507,7 +507,7 @@ M: x86 %prepare-alien-invoke
|
|||
temp-reg-1 2 cells [+] ds-reg MOV
|
||||
temp-reg-1 3 cells [+] rs-reg MOV ;
|
||||
|
||||
M: x86 value-structs? t ;
|
||||
M: x86 value-struct? drop t ;
|
||||
|
||||
M: x86 small-enough? ( n -- ? )
|
||||
HEX: -80000000 HEX: 7fffffff between? ;
|
||||
|
|
|
@ -64,7 +64,7 @@ C-STRUCT: glyph
|
|||
{ "FT_Pos" "advance-x" }
|
||||
{ "FT_Pos" "advance-y" }
|
||||
|
||||
{ "long" "format" }
|
||||
{ "intptr_t" "format" }
|
||||
|
||||
{ "int" "bitmap-rows" }
|
||||
{ "int" "bitmap-width" }
|
||||
|
|
|
@ -61,7 +61,7 @@
|
|||
</table>
|
||||
|
||||
<p>
|
||||
<button>Update</button>
|
||||
<button type="submit">Update</button>
|
||||
<t:validation-errors />
|
||||
</p>
|
||||
|
||||
|
|
|
@ -32,7 +32,7 @@
|
|||
|
||||
</table>
|
||||
|
||||
<button>Recover password</button>
|
||||
<button type="submit">Recover password</button>
|
||||
|
||||
</t:form>
|
||||
|
||||
|
|
|
@ -31,7 +31,7 @@
|
|||
</table>
|
||||
|
||||
<p>
|
||||
<button>Set password</button>
|
||||
<button type="submit">Set password</button>
|
||||
<t:validation-errors />
|
||||
</p>
|
||||
|
||||
|
|
|
@ -62,7 +62,7 @@
|
|||
|
||||
<p>
|
||||
|
||||
<button>Register</button>
|
||||
<button type="submit">Register</button>
|
||||
<t:validation-errors />
|
||||
|
||||
</p>
|
||||
|
|
|
@ -35,7 +35,7 @@
|
|||
|
||||
<p>
|
||||
|
||||
<button>Log in</button>
|
||||
<button type="submit">Log in</button>
|
||||
<t:validation-errors />
|
||||
|
||||
</p>
|
||||
|
|
|
@ -10,17 +10,15 @@ IN: help.html
|
|||
|
||||
: escape-char ( ch -- )
|
||||
dup H{
|
||||
{ CHAR: " "__quote__" }
|
||||
{ CHAR: " "__quo__" }
|
||||
{ CHAR: * "__star__" }
|
||||
{ CHAR: : "__colon__" }
|
||||
{ CHAR: < "__lt__" }
|
||||
{ CHAR: > "__gt__" }
|
||||
{ CHAR: ? "__question__" }
|
||||
{ CHAR: \\ "__backslash__" }
|
||||
{ CHAR: ? "__que__" }
|
||||
{ CHAR: \\ "__back__" }
|
||||
{ CHAR: | "__pipe__" }
|
||||
{ CHAR: _ "__underscore__" }
|
||||
{ CHAR: / "__slash__" }
|
||||
{ CHAR: \\ "__backslash__" }
|
||||
{ CHAR: , "__comma__" }
|
||||
{ CHAR: @ "__at__" }
|
||||
} at [ % ] [ , ] ?if ;
|
||||
|
@ -117,10 +115,10 @@ M: result link-href href>> ;
|
|||
[ [ title>> ] compare ] sort ;
|
||||
|
||||
: article-apropos ( string -- results )
|
||||
"articles.idx" temp-file offline-apropos ;
|
||||
"articles.idx" offline-apropos ;
|
||||
|
||||
: word-apropos ( string -- results )
|
||||
"words.idx" temp-file offline-apropos ;
|
||||
"words.idx" offline-apropos ;
|
||||
|
||||
: vocab-apropos ( string -- results )
|
||||
"vocabs.idx" temp-file offline-apropos ;
|
||||
"vocabs.idx" offline-apropos ;
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
USING: io io.files io.streams.string io.encodings.utf8
|
||||
html.templates html.templates.fhtml kernel
|
||||
tools.test sequences parser ;
|
||||
tools.test sequences parser splitting prettyprint ;
|
||||
IN: html.templates.fhtml.tests
|
||||
|
||||
: test-template ( path -- ? )
|
||||
|
@ -8,8 +8,10 @@ IN: html.templates.fhtml.tests
|
|||
prepend
|
||||
[
|
||||
".fhtml" append <fhtml> [ call-template ] with-string-writer
|
||||
<string-reader> lines
|
||||
] keep
|
||||
".html" append utf8 file-contents = ;
|
||||
".html" append utf8 file-lines
|
||||
[ . . ] [ = ] 2bi ;
|
||||
|
||||
[ t ] [ "example" test-template ] unit-test
|
||||
[ t ] [ "bug" test-template ] unit-test
|
||||
|
|
|
@ -114,19 +114,29 @@ M: threaded-server handle-client* handler>> call ;
|
|||
] when*
|
||||
] unless ;
|
||||
|
||||
: (start-server) ( threaded-server -- )
|
||||
init-server
|
||||
dup threaded-server [
|
||||
dup name>> [
|
||||
[ listen-on [ start-accept-loop ] parallel-each ]
|
||||
[ ready>> raise-flag ]
|
||||
bi
|
||||
] with-logging
|
||||
] with-variable ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: start-server ( threaded-server -- )
|
||||
init-server
|
||||
dup secure-config>> [
|
||||
dup threaded-server [
|
||||
dup name>> [
|
||||
[ listen-on [ start-accept-loop ] parallel-each ]
|
||||
[ ready>> raise-flag ]
|
||||
bi
|
||||
] with-logging
|
||||
] with-variable
|
||||
] with-secure-context ;
|
||||
#! Only create a secure-context if we want to listen on
|
||||
#! a secure port, otherwise start-server won't work at
|
||||
#! all if SSL is not available.
|
||||
dup secure>> [
|
||||
dup secure-config>> [
|
||||
(start-server)
|
||||
] with-secure-context
|
||||
] [
|
||||
(start-server)
|
||||
] if ;
|
||||
|
||||
: wait-for-server ( threaded-server -- )
|
||||
ready>> wait-for-flag ;
|
||||
|
|
|
@ -1,157 +1,157 @@
|
|||
USING: io.launcher tools.test calendar accessors environment
|
||||
namespaces kernel system arrays io io.files io.encodings.ascii
|
||||
sequences parser assocs hashtables math continuations eval ;
|
||||
IN: io.windows.launcher.nt.tests
|
||||
|
||||
[ ] [
|
||||
<process>
|
||||
"notepad" >>command
|
||||
1/2 seconds >>timeout
|
||||
"notepad" set
|
||||
] unit-test
|
||||
|
||||
[ f ] [ "notepad" get process-running? ] unit-test
|
||||
|
||||
[ f ] [ "notepad" get process-started? ] unit-test
|
||||
|
||||
[ ] [ "notepad" [ run-detached ] change ] unit-test
|
||||
|
||||
[ "notepad" get wait-for-process ] must-fail
|
||||
|
||||
[ t ] [ "notepad" get killed>> ] unit-test
|
||||
|
||||
[ f ] [ "notepad" get process-running? ] unit-test
|
||||
|
||||
[ ] [
|
||||
<process>
|
||||
vm "-quiet" "-run=hello-world" 3array >>command
|
||||
"out.txt" temp-file >>stdout
|
||||
try-process
|
||||
] unit-test
|
||||
|
||||
[ "Hello world" ] [
|
||||
"out.txt" temp-file ascii file-lines first
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
<process>
|
||||
vm "-run=listener" 2array >>command
|
||||
+closed+ >>stdin
|
||||
try-process
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "stderr.factor" 3array >>command
|
||||
"out.txt" temp-file >>stdout
|
||||
"err.txt" temp-file >>stderr
|
||||
try-process
|
||||
] with-directory
|
||||
] unit-test
|
||||
|
||||
[ "output" ] [
|
||||
"out.txt" temp-file ascii file-lines first
|
||||
] unit-test
|
||||
|
||||
[ "error" ] [
|
||||
"err.txt" temp-file ascii file-lines first
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "stderr.factor" 3array >>command
|
||||
"out.txt" temp-file >>stdout
|
||||
+stdout+ >>stderr
|
||||
try-process
|
||||
] with-directory
|
||||
] unit-test
|
||||
|
||||
[ "outputerror" ] [
|
||||
"out.txt" temp-file ascii file-lines first
|
||||
] unit-test
|
||||
|
||||
[ "output" ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "stderr.factor" 3array >>command
|
||||
"err2.txt" temp-file >>stderr
|
||||
ascii <process-reader> lines first
|
||||
] with-directory
|
||||
] unit-test
|
||||
|
||||
[ "error" ] [
|
||||
"err2.txt" temp-file ascii file-lines first
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
ascii <process-reader> contents
|
||||
] with-directory eval
|
||||
|
||||
os-envs =
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
+replace-environment+ >>environment-mode
|
||||
os-envs >>environment
|
||||
ascii <process-reader> contents
|
||||
] with-directory eval
|
||||
|
||||
os-envs =
|
||||
] unit-test
|
||||
|
||||
[ "B" ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
{ { "A" "B" } } >>environment
|
||||
ascii <process-reader> contents
|
||||
] with-directory eval
|
||||
|
||||
"A" swap at
|
||||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
{ { "HOME" "XXX" } } >>environment
|
||||
+prepend-environment+ >>environment-mode
|
||||
ascii <process-reader> contents
|
||||
] with-directory eval
|
||||
|
||||
"HOME" swap at "XXX" =
|
||||
] unit-test
|
||||
|
||||
2 [
|
||||
[ ] [
|
||||
<process>
|
||||
"cmd.exe /c dir" >>command
|
||||
"dir.txt" temp-file >>stdout
|
||||
try-process
|
||||
] unit-test
|
||||
|
||||
[ ] [ "dir.txt" temp-file delete-file ] unit-test
|
||||
] times
|
||||
|
||||
[ "append-test" temp-file delete-file ] ignore-errors
|
||||
|
||||
[ "Hello appender\r\nHello appender\r\n" ] [
|
||||
2 [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "append.factor" 3array >>command
|
||||
"append-test" temp-file <appender> >>stdout
|
||||
try-process
|
||||
] with-directory
|
||||
] times
|
||||
|
||||
"append-test" temp-file ascii file-contents
|
||||
] unit-test
|
||||
USING: io.launcher tools.test calendar accessors environment
|
||||
namespaces kernel system arrays io io.files io.encodings.ascii
|
||||
sequences parser assocs hashtables math continuations eval ;
|
||||
IN: io.windows.launcher.nt.tests
|
||||
|
||||
[ ] [
|
||||
<process>
|
||||
"notepad" >>command
|
||||
1/2 seconds >>timeout
|
||||
"notepad" set
|
||||
] unit-test
|
||||
|
||||
[ f ] [ "notepad" get process-running? ] unit-test
|
||||
|
||||
[ f ] [ "notepad" get process-started? ] unit-test
|
||||
|
||||
[ ] [ "notepad" [ run-detached ] change ] unit-test
|
||||
|
||||
[ "notepad" get wait-for-process ] must-fail
|
||||
|
||||
[ t ] [ "notepad" get killed>> ] unit-test
|
||||
|
||||
[ f ] [ "notepad" get process-running? ] unit-test
|
||||
|
||||
[ ] [
|
||||
<process>
|
||||
vm "-quiet" "-run=hello-world" 3array >>command
|
||||
"out.txt" temp-file >>stdout
|
||||
try-process
|
||||
] unit-test
|
||||
|
||||
[ "Hello world" ] [
|
||||
"out.txt" temp-file ascii file-lines first
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
<process>
|
||||
vm "-run=listener" 2array >>command
|
||||
+closed+ >>stdin
|
||||
try-process
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "stderr.factor" 3array >>command
|
||||
"out.txt" temp-file >>stdout
|
||||
"err.txt" temp-file >>stderr
|
||||
try-process
|
||||
] with-directory
|
||||
] unit-test
|
||||
|
||||
[ "output" ] [
|
||||
"out.txt" temp-file ascii file-lines first
|
||||
] unit-test
|
||||
|
||||
[ "error" ] [
|
||||
"err.txt" temp-file ascii file-lines first
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "stderr.factor" 3array >>command
|
||||
"out.txt" temp-file >>stdout
|
||||
+stdout+ >>stderr
|
||||
try-process
|
||||
] with-directory
|
||||
] unit-test
|
||||
|
||||
[ "outputerror" ] [
|
||||
"out.txt" temp-file ascii file-lines first
|
||||
] unit-test
|
||||
|
||||
[ "output" ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "stderr.factor" 3array >>command
|
||||
"err2.txt" temp-file >>stderr
|
||||
ascii <process-reader> lines first
|
||||
] with-directory
|
||||
] unit-test
|
||||
|
||||
[ "error" ] [
|
||||
"err2.txt" temp-file ascii file-lines first
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
ascii <process-reader> contents
|
||||
] with-directory eval
|
||||
|
||||
os-envs =
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
+replace-environment+ >>environment-mode
|
||||
os-envs >>environment
|
||||
ascii <process-reader> contents
|
||||
] with-directory eval
|
||||
|
||||
os-envs =
|
||||
] unit-test
|
||||
|
||||
[ "B" ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
{ { "A" "B" } } >>environment
|
||||
ascii <process-reader> contents
|
||||
] with-directory eval
|
||||
|
||||
"A" swap at
|
||||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
{ { "USERPROFILE" "XXX" } } >>environment
|
||||
+prepend-environment+ >>environment-mode
|
||||
ascii <process-reader> contents
|
||||
] with-directory eval
|
||||
|
||||
"USERPROFILE" swap at "XXX" =
|
||||
] unit-test
|
||||
|
||||
2 [
|
||||
[ ] [
|
||||
<process>
|
||||
"cmd.exe /c dir" >>command
|
||||
"dir.txt" temp-file >>stdout
|
||||
try-process
|
||||
] unit-test
|
||||
|
||||
[ ] [ "dir.txt" temp-file delete-file ] unit-test
|
||||
] times
|
||||
|
||||
[ "append-test" temp-file delete-file ] ignore-errors
|
||||
|
||||
[ "Hello appender\r\nHello appender\r\n" ] [
|
||||
2 [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "append.factor" 3array >>command
|
||||
"append-test" temp-file <appender> >>stdout
|
||||
try-process
|
||||
] with-directory
|
||||
] times
|
||||
|
||||
"append-test" temp-file ascii file-contents
|
||||
] unit-test
|
||||
|
|
|
@ -229,6 +229,8 @@ M: tuple rewrite-element
|
|||
|
||||
M: local rewrite-element , ;
|
||||
|
||||
M: local-reader rewrite-element , ;
|
||||
|
||||
M: word rewrite-element literalize , ;
|
||||
|
||||
M: object rewrite-element , ;
|
||||
|
|
|
@ -355,3 +355,13 @@ INTERSECTION: intersection-see-test sequence number ;
|
|||
[ ] [ \ curry see ] unit-test
|
||||
|
||||
[ "POSTPONE: [" ] [ \ [ unparse ] unit-test
|
||||
|
||||
TUPLE: started-out-hustlin' ;
|
||||
|
||||
GENERIC: ended-up-ballin'
|
||||
|
||||
M: started-out-hustlin' ended-up-ballin' ; inline
|
||||
|
||||
[ "USING: prettyprint.tests ;\nM: started-out-hustlin' ended-up-ballin' ; inline\n" ] [
|
||||
[ { started-out-hustlin' ended-up-ballin' } see ] with-string-writer
|
||||
] unit-test
|
||||
|
|
|
@ -253,6 +253,9 @@ M: object see
|
|||
block>
|
||||
] with-use nl ;
|
||||
|
||||
M: method-spec see
|
||||
first2 method see ;
|
||||
|
||||
GENERIC: see-class* ( word -- )
|
||||
|
||||
M: union-class see-class*
|
||||
|
|
|
@ -108,3 +108,9 @@ M: inconsistent-recursive-call-error error.
|
|||
"The recursive word " write
|
||||
word>> pprint
|
||||
" calls itself with a different set of quotation parameters than were input" print ;
|
||||
|
||||
TUPLE: unknown-primitive-error ;
|
||||
|
||||
M: unknown-primitive-error error.
|
||||
drop
|
||||
"Cannot determine stack effect statically" print ;
|
||||
|
|
|
@ -162,7 +162,7 @@ M: object infer-call*
|
|||
{ \ load-locals [ infer-load-locals ] }
|
||||
{ \ get-local [ infer-get-local ] }
|
||||
{ \ drop-locals [ infer-drop-locals ] }
|
||||
{ \ do-primitive [ \ do-primitive cannot-infer-effect ] }
|
||||
{ \ do-primitive [ unknown-primitive-error inference-warning ] }
|
||||
{ \ alien-invoke [ infer-alien-invoke ] }
|
||||
{ \ alien-indirect [ infer-alien-indirect ] }
|
||||
{ \ alien-callback [ infer-alien-callback ] }
|
||||
|
|
|
@ -580,3 +580,5 @@ DEFER: eee'
|
|||
dup "A" throw [ bogus-error ] [ drop ] if ; inline recursive
|
||||
|
||||
[ bogus-error ] must-infer
|
||||
|
||||
[ [ clear ] infer. ] [ inference-error? ] must-fail-with
|
||||
|
|
|
@ -199,11 +199,11 @@ TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION
|
|||
: THREAD_PRIORITY_TIME_CRITICAL 15 ; inline
|
||||
|
||||
C-STRUCT: OVERLAPPED
|
||||
{ "int" "internal" }
|
||||
{ "int" "internal-high" }
|
||||
{ "int" "offset" }
|
||||
{ "int" "offset-high" }
|
||||
{ "void*" "event" } ;
|
||||
{ "UINT_PTR" "internal" }
|
||||
{ "UINT_PTR" "internal-high" }
|
||||
{ "DWORD" "offset" }
|
||||
{ "DWORD" "offset-high" }
|
||||
{ "HANDLE" "event" } ;
|
||||
|
||||
C-STRUCT: SYSTEMTIME
|
||||
{ "WORD" "wYear" }
|
||||
|
|
|
@ -40,10 +40,11 @@ TYPEDEF: void* LPVOID
|
|||
TYPEDEF: void* LPCVOID
|
||||
|
||||
TYPEDEF: float FLOAT
|
||||
TYPEDEF: short HALF_PTR
|
||||
TYPEDEF: ushort UHALF_PTR
|
||||
TYPEDEF: int INT_PTR
|
||||
TYPEDEF: uint UINT_PTR
|
||||
|
||||
TYPEDEF: intptr_t HALF_PTR
|
||||
TYPEDEF: intptr_t UHALF_PTR
|
||||
TYPEDEF: intptr_t INT_PTR
|
||||
TYPEDEF: intptr_t UINT_PTR
|
||||
|
||||
TYPEDEF: int LONG_PTR
|
||||
TYPEDEF: ulong ULONG_PTR
|
||||
|
|
|
@ -25,6 +25,11 @@ IN: io.tests
|
|||
! Make sure we use correct to_c_string form when writing
|
||||
[ ] [ "\0" write ] unit-test
|
||||
|
||||
[ ] [
|
||||
"It seems Jobs has lost his grasp on reality again.\n"
|
||||
"separator-test.txt" temp-file latin1 set-file-contents
|
||||
] unit-test
|
||||
|
||||
[
|
||||
{
|
||||
{ "It seems " CHAR: J }
|
||||
|
@ -33,7 +38,7 @@ IN: io.tests
|
|||
}
|
||||
] [
|
||||
[
|
||||
"resource:core/io/test/separator-test.txt"
|
||||
"separator-test.txt" temp-file
|
||||
latin1 <file-reader> [
|
||||
"J" read-until 2array ,
|
||||
"i" read-until 2array ,
|
||||
|
|
|
@ -1 +0,0 @@
|
|||
It seems Jobs has lost his grasp on reality again.
|
|
@ -1,10 +1,10 @@
|
|||
USING: benchmark.regex-dna io io.files io.encodings.ascii
|
||||
io.streams.string kernel tools.test ;
|
||||
io.streams.string kernel tools.test splitting ;
|
||||
IN: benchmark.regex-dna.tests
|
||||
|
||||
[ t ] [
|
||||
"resource:extra/benchmark/regex-dna/regex-dna-test-in.txt"
|
||||
[ regex-dna ] with-string-writer
|
||||
[ regex-dna ] with-string-writer string-lines
|
||||
"resource:extra/benchmark/regex-dna/regex-dna-test-out.txt"
|
||||
ascii file-contents =
|
||||
ascii file-lines =
|
||||
] unit-test
|
||||
|
|
|
@ -7,7 +7,7 @@ IN: contributors
|
|||
|
||||
: changelog ( -- authors )
|
||||
image parent-directory [
|
||||
"git-log --pretty=format:%an" ascii <process-reader> lines
|
||||
"git log --pretty=format:%an" ascii <process-reader> lines
|
||||
] with-directory ;
|
||||
|
||||
: patch-counts ( authors -- assoc )
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
IN: mason.child.tests
|
||||
USING: mason.child mason.config tools.test namespaces ;
|
||||
|
||||
[ { "make" "clean" "winnt-x86-32" } ] [
|
||||
[ { "make" "winnt-x86-32" } ] [
|
||||
[
|
||||
"winnt" target-os set
|
||||
"x86.32" target-cpu set
|
||||
|
@ -9,7 +9,7 @@ USING: mason.child mason.config tools.test namespaces ;
|
|||
] with-scope
|
||||
] unit-test
|
||||
|
||||
[ { "make" "clean" "macosx-x86-32" } ] [
|
||||
[ { "make" "macosx-x86-32" } ] [
|
||||
[
|
||||
"macosx" target-os set
|
||||
"x86.32" target-cpu set
|
||||
|
@ -17,7 +17,7 @@ USING: mason.child mason.config tools.test namespaces ;
|
|||
] with-scope
|
||||
] unit-test
|
||||
|
||||
[ { "gmake" "clean" "netbsd-ppc" } ] [
|
||||
[ { "gmake" "netbsd-ppc" } ] [
|
||||
[
|
||||
"netbsd" target-os set
|
||||
"ppc" target-cpu set
|
||||
|
|
|
@ -2,14 +2,26 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel namespaces make debugger sequences io.files
|
||||
io.launcher arrays accessors calendar continuations
|
||||
combinators.short-circuit mason.common mason.report mason.platform ;
|
||||
combinators.short-circuit mason.common mason.report
|
||||
mason.platform mason.config http.client ;
|
||||
IN: mason.child
|
||||
|
||||
: make-cmd ( -- args )
|
||||
[ gnu-make , "clean" , platform , ] { } make ;
|
||||
gnu-make platform 2array ;
|
||||
|
||||
: download-dlls ( -- )
|
||||
target-os get "winnt" = [
|
||||
"http://factorcode.org/dlls/"
|
||||
target-cpu get "x86.64" = [ "64/" append ] when
|
||||
[ "freetype6.dll" append ]
|
||||
[ "zlib1.dll" append ] bi
|
||||
[ download ] bi@
|
||||
] when ;
|
||||
|
||||
: make-vm ( -- )
|
||||
"factor" [
|
||||
download-dlls
|
||||
|
||||
<process>
|
||||
make-cmd >>command
|
||||
"../compile-log" >>stdout
|
||||
|
|
|
@ -16,11 +16,11 @@ TUPLE: help-webapp < dispatcher ;
|
|||
{ "search" [ 1 v-min-length 50 v-max-length v-one-line ] }
|
||||
} validate-params
|
||||
|
||||
help-dir set-current-directory
|
||||
|
||||
"search" value article-apropos "articles" set-value
|
||||
"search" value word-apropos "words" set-value
|
||||
"search" value vocab-apropos "vocabs" set-value
|
||||
help-dir [
|
||||
"search" value article-apropos "articles" set-value
|
||||
"search" value word-apropos "words" set-value
|
||||
"search" value vocab-apropos "vocabs" set-value
|
||||
] with-directory
|
||||
|
||||
{ help-webapp "search" } <chloe-content>
|
||||
] >>submit ;
|
||||
|
|
|
@ -30,7 +30,7 @@
|
|||
|
||||
<t:form t:action="$help-webapp/search">
|
||||
<t:field t:name="search" />
|
||||
<button>Search</button>
|
||||
<button type="submit">Search</button>
|
||||
</t:form>
|
||||
|
||||
<t:if t:value="articles">
|
||||
|
|
|
@ -18,6 +18,6 @@
|
|||
</tr>
|
||||
</table>
|
||||
|
||||
<p> <button>Submit</button> </p>
|
||||
<p> <button type="submit">Submit</button> </p>
|
||||
</t:form>
|
||||
</t:chloe>
|
||||
|
|
|
@ -52,7 +52,7 @@
|
|||
</tr>
|
||||
</table>
|
||||
|
||||
<p> <button>Done</button> </p>
|
||||
<p> <button type="submit">Done</button> </p>
|
||||
|
||||
</t:form>
|
||||
|
||||
|
|
|
@ -37,7 +37,7 @@
|
|||
<th class="field-label big-field-label">Capabilities:</th>
|
||||
<td>
|
||||
<t:each t:name="capabilities">
|
||||
<li><t:checkbox t:name="@value" t:label="@value" /><br/>
|
||||
<t:checkbox t:name="@value" t:label="@value" /><br/>
|
||||
</t:each>
|
||||
</td>
|
||||
</tr>
|
||||
|
|
|
@ -4,7 +4,7 @@
|
|||
|
||||
<t:form t:action="$wee-url">
|
||||
<p>Shorten URL: <t:field t:name="url" t:size="40" /></p>
|
||||
<button>Shorten</button>
|
||||
<button type="submit">Shorten</button>
|
||||
</t:form>
|
||||
|
||||
</t:chloe>
|
||||
|
|
|
@ -16,7 +16,7 @@
|
|||
</p>
|
||||
|
||||
<p>
|
||||
<button>Save</button>
|
||||
<button type="submit">Save</button>
|
||||
</p>
|
||||
|
||||
</t:form>
|
||||
|
|
|
@ -32,7 +32,7 @@
|
|||
</tr>
|
||||
</table>
|
||||
|
||||
<button>View</button>
|
||||
<button type="submit">View</button>
|
||||
</t:form>
|
||||
|
||||
</t:chloe>
|
||||
|
|
107
misc/factor.el
107
misc/factor.el
|
@ -317,10 +317,9 @@ value from the existing code in the buffer."
|
|||
|
||||
;;; Factor mode indentation:
|
||||
|
||||
(defvar factor-indent-width factor-default-indent-width
|
||||
"Indentation width in factor buffers. A local variable.")
|
||||
|
||||
(make-variable-buffer-local 'factor-indent-width)
|
||||
(make-variable-buffer-local
|
||||
(defvar factor-indent-width factor-default-indent-width
|
||||
"Indentation width in factor buffers. A local variable."))
|
||||
|
||||
(defconst factor--regexp-word-start
|
||||
(let ((sws '("" ":" "TUPLE" "MACRO" "MACRO:" "M")))
|
||||
|
@ -340,45 +339,67 @@ value from the existing code in the buffer."
|
|||
(setq iw (current-indentation))))))
|
||||
iw))
|
||||
|
||||
(defun factor--brackets-depth ()
|
||||
"Returns number of brackets, not closed on previous lines."
|
||||
(syntax-ppss-depth
|
||||
(save-excursion
|
||||
(syntax-ppss (line-beginning-position)))))
|
||||
(defsubst factor--ppss-brackets-depth ()
|
||||
(nth 0 (syntax-ppss)))
|
||||
|
||||
(defsubst factor--ppss-brackets-start ()
|
||||
(nth 1 (syntax-ppss)))
|
||||
|
||||
(defsubst factor--line-indent (pos)
|
||||
(save-excursion (goto-char pos) (current-indentation)))
|
||||
|
||||
(defconst factor--regex-closing-paren "[])}]")
|
||||
(defsubst factor--at-closing-paren-p ()
|
||||
(looking-at factor--regex-closing-paren))
|
||||
|
||||
(defsubst factor--at-first-char-p ()
|
||||
(= (- (point) (line-beginning-position)) (current-indentation)))
|
||||
|
||||
(defconst factor--regex-single-liner
|
||||
(format "^%s" (regexp-opt '("USE:" "IN:" "PRIVATE>" "<PRIVATE"))))
|
||||
|
||||
(defun factor--at-end-of-def ()
|
||||
(or (looking-at ".*;[ \t]*$")
|
||||
(looking-at factor--regex-single-liner)))
|
||||
|
||||
(defun factor--indent-in-brackets ()
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(when (or (and (re-search-forward factor--regex-closing-paren
|
||||
(line-end-position) t)
|
||||
(not (backward-char)))
|
||||
(> (factor--ppss-brackets-depth) 0))
|
||||
(let ((op (factor--ppss-brackets-start)))
|
||||
(when (> (line-number-at-pos) (line-number-at-pos op))
|
||||
(if (factor--at-closing-paren-p)
|
||||
(factor--line-indent op)
|
||||
(+ (factor--line-indent op) factor-indent-width)))))))
|
||||
|
||||
(defun factor--indent-definition ()
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(when (looking-at "\\([^ ]\\|^\\)+:") 0)))
|
||||
|
||||
(defun factor--indent-continuation ()
|
||||
(save-excursion
|
||||
(forward-line -1)
|
||||
(beginning-of-line)
|
||||
(if (bobp) 0
|
||||
(if (looking-at "^[ \t]*$")
|
||||
(factor--indent-continuation)
|
||||
(if (factor--at-end-of-def)
|
||||
(- (current-indentation) factor-indent-width)
|
||||
(if (factor--indent-definition)
|
||||
(+ (current-indentation) factor-indent-width)
|
||||
(current-indentation)))))))
|
||||
|
||||
(defun factor--calculate-indentation ()
|
||||
"Calculate Factor indentation for line at point."
|
||||
(let ((not-indented t)
|
||||
(cur-indent 0))
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(if (bobp)
|
||||
(setq cur-indent 0)
|
||||
(save-excursion
|
||||
(while not-indented
|
||||
;; Check that we are inside open brackets
|
||||
(save-excursion
|
||||
(let ((cur-depth (factor--brackets-depth)))
|
||||
(forward-line -1)
|
||||
(setq cur-indent (+ (current-indentation)
|
||||
(* factor-indent-width
|
||||
(- cur-depth (factor--brackets-depth)))))
|
||||
(setq not-indented nil)))
|
||||
(forward-line -1)
|
||||
;; Check that we are after the end of previous word
|
||||
(if (looking-at ".*;[ \t]*$")
|
||||
(progn
|
||||
(setq cur-indent (- (current-indentation) factor-indent-width))
|
||||
(setq not-indented nil))
|
||||
;; Check that we are after the start of word
|
||||
(if (looking-at factor--regexp-word-start)
|
||||
(progn
|
||||
(message "inword")
|
||||
(setq cur-indent (+ (current-indentation) factor-indent-width))
|
||||
(setq not-indented nil))
|
||||
(if (bobp)
|
||||
(setq not-indented nil))))))))
|
||||
cur-indent))
|
||||
(or (and (bobp) 0)
|
||||
(factor--indent-definition)
|
||||
(factor--indent-in-brackets)
|
||||
(factor--indent-continuation)
|
||||
0))
|
||||
|
||||
(defun factor-indent-line ()
|
||||
"Indent current line as Factor code"
|
||||
|
@ -420,11 +441,15 @@ value from the existing code in the buffer."
|
|||
|
||||
;;; Factor listener mode
|
||||
|
||||
;;;###autoload
|
||||
(define-derived-mode factor-listener-mode comint-mode "Factor Listener")
|
||||
|
||||
(define-key factor-listener-mode-map [f8] 'factor-refresh-all)
|
||||
|
||||
;;;###autoload
|
||||
(defun run-factor ()
|
||||
"Start a factor listener inside emacs, or switch to it if it
|
||||
already exists."
|
||||
(interactive)
|
||||
(switch-to-buffer
|
||||
(make-comint-in-buffer "factor" nil (expand-file-name factor-binary) nil
|
||||
|
@ -433,6 +458,8 @@ value from the existing code in the buffer."
|
|||
(factor-listener-mode))
|
||||
|
||||
(defun factor-refresh-all ()
|
||||
"Reload source files and documentation for all loaded
|
||||
vocabularies which have been modified on disk."
|
||||
(interactive)
|
||||
(comint-send-string "*factor*" "refresh-all\n"))
|
||||
|
||||
|
|
|
@ -224,7 +224,17 @@ struct test_struct_7 ffi_test_30(void)
|
|||
return s;
|
||||
}
|
||||
|
||||
void ffi_test_31(int x0, int x1, int x2, int x3, int x4, int x5, int x6, int x7, int x8, int x9, int x10, int x11, int x12, int x13, int x14, int x15, int x16, int x17, int x18, int x19, int x20, int x21, int x22, int x23, int x24, int x25, int x26, int x27, int x28, int x29, int x30, int x31, int x32, int x33, int x34, int x35, int x36, int x37, int x38, int x39, int x40, int x41) { }
|
||||
int ffi_test_31(int x0, int x1, int x2, int x3, int x4, int x5, int x6, int x7, int x8, int x9, int x10, int x11, int x12, int x13, int x14, int x15, int x16, int x17, int x18, int x19, int x20, int x21, int x22, int x23, int x24, int x25, int x26, int x27, int x28, int x29, int x30, int x31, int x32, int x33, int x34, int x35, int x36, int x37, int x38, int x39, int x40, int x41)
|
||||
{
|
||||
printf("ffi_test_31(%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d)\n",x0,x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,x21,x22,x23,x24,x25,x26,x27,x28,x29,x30,x31,x32,x33,x34,x35,x36,x37,x38,x39,x40,x41);
|
||||
return x0 + x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 + x10 + x11 + x12 + x13 + x14 + x15 + x16 + x17 + x18 + x19 + x20 + x21 + x22 + x23 + x24 + x25 + x26 + x27 + x28 + x29 + x30 + x31 + x32 + x33 + x34 + x35 + x36 + x37 + x38 + x39 + x40 + x41;
|
||||
}
|
||||
|
||||
float ffi_test_31_point_5(float x0, float x1, float x2, float x3, float x4, float x5, float x6, float x7, float x8, float x9, float x10, float x11, float x12, float x13, float x14, float x15, float x16, float x17, float x18, float x19, float x20, float x21, float x22, float x23, float x24, float x25, float x26, float x27, float x28, float x29, float x30, float x31, float x32, float x33, float x34, float x35, float x36, float x37, float x38, float x39, float x40, float x41)
|
||||
{
|
||||
printf("ffi_test_31_point_5(%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f,%f)\n",x0,x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,x21,x22,x23,x24,x25,x26,x27,x28,x29,x30,x31,x32,x33,x34,x35,x36,x37,x38,x39,x40,x41);
|
||||
return x0 + x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 + x10 + x11 + x12 + x13 + x14 + x15 + x16 + x17 + x18 + x19 + x20 + x21 + x22 + x23 + x24 + x25 + x26 + x27 + x28 + x29 + x30 + x31 + x32 + x33 + x34 + x35 + x36 + x37 + x38 + x39 + x40 + x41;
|
||||
}
|
||||
|
||||
double ffi_test_32(struct test_struct_8 x, int y)
|
||||
{
|
||||
|
|
|
@ -48,7 +48,8 @@ struct test_struct_6 { char x, y, z, a, b, c; };
|
|||
DLLEXPORT struct test_struct_6 ffi_test_29(void);
|
||||
struct test_struct_7 { char x, y, z, a, b, c, d; };
|
||||
DLLEXPORT struct test_struct_7 ffi_test_30(void);
|
||||
DLLEXPORT void ffi_test_31(int x0, int x1, int x2, int x3, int x4, int x5, int x6, int x7, int x8, int x9, int x10, int x11, int x12, int x13, int x14, int x15, int x16, int x17, int x18, int x19, int x20, int x21, int x22, int x23, int x24, int x25, int x26, int x27, int x28, int x29, int x30, int x31, int x32, int x33, int x34, int x35, int x36, int x37, int x38, int x39, int x40, int x41);
|
||||
DLLEXPORT int ffi_test_31(int x0, int x1, int x2, int x3, int x4, int x5, int x6, int x7, int x8, int x9, int x10, int x11, int x12, int x13, int x14, int x15, int x16, int x17, int x18, int x19, int x20, int x21, int x22, int x23, int x24, int x25, int x26, int x27, int x28, int x29, int x30, int x31, int x32, int x33, int x34, int x35, int x36, int x37, int x38, int x39, int x40, int x41);
|
||||
DLLEXPORT float ffi_test_31_point_5(float x0, float x1, float x2, float x3, float x4, float x5, float x6, float x7, float x8, float x9, float x10, float x11, float x12, float x13, float x14, float x15, float x16, float x17, float x18, float x19, float x20, float x21, float x22, float x23, float x24, float x25, float x26, float x27, float x28, float x29, float x30, float x31, float x32, float x33, float x34, float x35, float x36, float x37, float x38, float x39, float x40, float x41);
|
||||
struct test_struct_8 { double x; double y; };
|
||||
DLLEXPORT double ffi_test_32(struct test_struct_8 x, int y);
|
||||
struct test_struct_9 { float x; float y; };
|
||||
|
|
|
@ -109,7 +109,7 @@ void primitive_fixnum_shift(void)
|
|||
}
|
||||
else if(y < WORD_SIZE - TAG_BITS)
|
||||
{
|
||||
F_FIXNUM mask = -(1L << (WORD_SIZE - 1 - TAG_BITS - y));
|
||||
F_FIXNUM mask = -((F_FIXNUM)1 << (WORD_SIZE - 1 - TAG_BITS - y));
|
||||
if((x > 0 && (x & mask) == 0) || (x & mask) == mask)
|
||||
{
|
||||
dpush(tag_fixnum(x << y));
|
||||
|
|
|
@ -29,7 +29,13 @@ long exception_handler(PEXCEPTION_POINTERS pe)
|
|||
signal_number = ERROR_DIVIDE_BY_ZERO;
|
||||
c->EIP = (CELL)divide_by_zero_signal_handler_impl;
|
||||
}
|
||||
else
|
||||
/* If the Widcomm bluetooth stack is installed, the BTTray.exe process
|
||||
injects code into running programs. For some reason this results in
|
||||
random SEH exceptions with this (undocumented) exception code being
|
||||
raised. The workaround seems to be ignoring this altogether, since that
|
||||
is what happens if SEH is not enabled. Don't really have any idea what
|
||||
this exception means. */
|
||||
else if(e->ExceptionCode != 0x40010006)
|
||||
{
|
||||
signal_number = 11;
|
||||
c->EIP = (CELL)misc_signal_handler_impl;
|
||||
|
|
Loading…
Reference in New Issue