Merge branch 'master' of factorcode.org:/git/factor
Joe Groff
commit
43ab0af1ac
44
Nmakefile
44
Nmakefile
|
|
@ -1,17 +1,27 @@
|
|||
!IF DEFINED(DEBUG)
|
||||
LINK_FLAGS = /nologo /safeseh /DEBUG shell32.lib
|
||||
CL_FLAGS = /nologo /Zi /O2 /W3 /DFACTOR_DEBUG
|
||||
!ELSE
|
||||
LINK_FLAGS = /nologo /safeseh shell32.lib
|
||||
!IF DEFINED(PLATFORM)
|
||||
|
||||
LINK_FLAGS = /nologo shell32.lib
|
||||
CL_FLAGS = /nologo /O2 /W3
|
||||
|
||||
!IF DEFINED(DEBUG)
|
||||
LINK_FLAGS = $(LINK_FLAGS) /DEBUG
|
||||
CL_FLAGS = $(CL_FLAGS) /Zi /DFACTOR_DEBUG
|
||||
!ENDIF
|
||||
|
||||
!IF "$(PLATFORM)" == "x86-32"
|
||||
LINK_FLAGS = $(LINK_FLAGS) /safeseh
|
||||
PLAF_DLL_OBJS = vm\os-windows-nt-x86.32.obj vm\safeseh.obj
|
||||
!ELSEIF "$(PLATFORM)" == "x86-64"
|
||||
PLAF_DLL_OBJS = vm\os-windows-nt-x86.64.obj
|
||||
!ENDIF
|
||||
|
||||
ML_FLAGS = /nologo /safeseh
|
||||
|
||||
EXE_OBJS = vm\main-windows-nt.obj vm\factor.res
|
||||
|
||||
DLL_OBJS = vm\os-windows-nt.obj \
|
||||
DLL_OBJS = $(PLAF_DLL_OBJS) \
|
||||
vm\os-windows.obj \
|
||||
vm\os-windows-nt.obj \
|
||||
vm\aging_collector.obj \
|
||||
vm\alien.obj \
|
||||
vm\arrays.obj \
|
||||
|
|
@ -49,7 +59,6 @@ DLL_OBJS = vm\os-windows-nt.obj \
|
|||
vm\profiler.obj \
|
||||
vm\quotations.obj \
|
||||
vm\run.obj \
|
||||
vm\safeseh.obj \
|
||||
vm\strings.obj \
|
||||
vm\to_tenured_collector.obj \
|
||||
vm\tuples.obj \
|
||||
|
|
@ -69,8 +78,6 @@ DLL_OBJS = vm\os-windows-nt.obj \
|
|||
.rs.res:
|
||||
rc $<
|
||||
|
||||
all: factor.com factor.exe factor.dll.lib libfactor-ffi-test.dll
|
||||
|
||||
libfactor-ffi-test.dll: vm/ffi_test.obj
|
||||
link $(LINK_FLAGS) /out:libfactor-ffi-test.dll /dll vm/ffi_test.obj
|
||||
|
||||
|
|
@ -83,6 +90,23 @@ factor.com: $(EXE_OBJS) $(DLL_OBJS)
|
|||
factor.exe: $(EXE_OBJS) $(DLL_OBJS)
|
||||
link $(LINK_FLAGS) /out:factor.exe /SUBSYSTEM:windows $(EXE_OBJS) $(DLL_OBJS)
|
||||
|
||||
all: factor.com factor.exe factor.dll.lib libfactor-ffi-test.dll
|
||||
|
||||
!ENDIF
|
||||
|
||||
default:
|
||||
@echo Usage: nmake /f Nmakefile platform
|
||||
@echo Where platform is one of:
|
||||
@echo x86-32
|
||||
@echo x86-64
|
||||
@exit 1
|
||||
|
||||
x86-32:
|
||||
nmake PLATFORM=x86-32 /f Nmakefile all
|
||||
|
||||
x86-64:
|
||||
nmake PLATFORM=x86-64 /f Nmakefile all
|
||||
|
||||
clean:
|
||||
del vm\*.obj
|
||||
del factor.lib
|
||||
|
|
@ -91,6 +115,6 @@ clean:
|
|||
del factor.dll
|
||||
del factor.dll.lib
|
||||
|
||||
.PHONY: all clean
|
||||
.PHONY: all default x86-32 x86-64 clean
|
||||
|
||||
.SUFFIXES: .rs
|
||||
|
|
|
|||
|
|
@ -13,8 +13,8 @@ SINGLETONS: f2c-abi g95-abi gfortran-abi intel-unix-abi intel-windows-abi ;
|
|||
|
||||
<<
|
||||
: add-f2c-libraries ( -- )
|
||||
"I77" "libI77.so" "cdecl" add-library
|
||||
"F77" "libF77.so" "cdecl" add-library ;
|
||||
"I77" "libI77.so" cdecl add-library
|
||||
"F77" "libF77.so" cdecl add-library ;
|
||||
|
||||
os netbsd? [ add-f2c-libraries ] when
|
||||
>>
|
||||
|
|
@ -42,11 +42,11 @@ library-fortran-abis [ H{ } clone ] initialize
|
|||
[ "__" append ] [ "_" append ] if ;
|
||||
|
||||
HOOK: fortran-c-abi fortran-abi ( -- abi )
|
||||
M: f2c-abi fortran-c-abi "cdecl" ;
|
||||
M: g95-abi fortran-c-abi "cdecl" ;
|
||||
M: gfortran-abi fortran-c-abi "cdecl" ;
|
||||
M: intel-unix-abi fortran-c-abi "cdecl" ;
|
||||
M: intel-windows-abi fortran-c-abi "cdecl" ;
|
||||
M: f2c-abi fortran-c-abi cdecl ;
|
||||
M: g95-abi fortran-c-abi cdecl ;
|
||||
M: gfortran-abi fortran-c-abi cdecl ;
|
||||
M: intel-unix-abi fortran-c-abi cdecl ;
|
||||
M: intel-windows-abi fortran-c-abi cdecl ;
|
||||
|
||||
HOOK: real-functions-return-double? fortran-abi ( -- ? )
|
||||
M: f2c-abi real-functions-return-double? t ;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ IN: alien.libraries
|
|||
|
||||
HELP: <library>
|
||||
{ $values
|
||||
{ "path" "a pathname string" } { "abi" "the ABI used by the library, either " { $snippet "cdecl" } " or " { $snippet "stdcall" } }
|
||||
{ "path" "a pathname string" } { "abi" "the ABI used by the library, either " { $link cdecl } " or " { $link stdcall } }
|
||||
{ "library" library } }
|
||||
{ $description "Opens a C library using the path and ABI parameters and outputs a library tuple." }
|
||||
{ $notes "User code should use " { $link add-library } " so that the opened library is added to a global hashtable, " { $link libraries } "." } ;
|
||||
|
|
@ -19,7 +19,7 @@ HELP: library
|
|||
{ $description "Looks up a library by its logical name. The library object is a hashtable with the following keys:"
|
||||
{ $list
|
||||
{ { $snippet "name" } " - the full path of the C library binary" }
|
||||
{ { $snippet "abi" } " - the ABI used by the library, either " { $snippet "cdecl" } " or " { $snippet "stdcall" } }
|
||||
{ { $snippet "abi" } " - the ABI used by the library, either " { $link cdecl } " or " { $link stdcall } }
|
||||
{ { $snippet "dll" } " - an instance of the " { $link dll } " class; only set if the library is loaded" }
|
||||
}
|
||||
} ;
|
||||
|
|
@ -43,7 +43,7 @@ HELP: load-library
|
|||
{ $description "Loads a library by logical name and outputs a handle which may be passed to " { $link dlsym } " or " { $link dlclose } ". If the library is already loaded, returns the existing handle." } ;
|
||||
|
||||
HELP: add-library
|
||||
{ $values { "name" string } { "path" string } { "abi" "one of " { $snippet "\"cdecl\"" } " or " { $snippet "\"stdcall\"" } } }
|
||||
{ $values { "name" string } { "path" string } { "abi" "one of " { $link cdecl } " or " { $link stdcall } } }
|
||||
{ $description "Defines a new logical library named " { $snippet "name" } " located in the file system at " { $snippet "path" } " and the specified ABI. The logical library name can then be used by a " { $link POSTPONE: LIBRARY: } " form to specify the logical library for subsequent " { $link POSTPONE: FUNCTION: } " definitions." }
|
||||
{ $notes "Because the entire source file is parsed before top-level forms are executed, " { $link add-library } " must be placed within a " { $snippet "<< ... >>" } " parse-time evaluation block."
|
||||
$nl
|
||||
|
|
@ -53,8 +53,8 @@ $nl
|
|||
{ $examples "Here is a typical usage of " { $link add-library } ":"
|
||||
{ $code
|
||||
"<< \"freetype\" {"
|
||||
" { [ os macosx? ] [ \"libfreetype.6.dylib\" \"cdecl\" add-library ] }"
|
||||
" { [ os windows? ] [ \"freetype6.dll\" \"cdecl\" add-library ] }"
|
||||
" { [ os macosx? ] [ \"libfreetype.6.dylib\" cdecl add-library ] }"
|
||||
" { [ os windows? ] [ \"freetype6.dll\" cdecl add-library ] }"
|
||||
" [ drop ]"
|
||||
"} cond >>"
|
||||
}
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ M: library dispose dll>> [ dispose ] when* ;
|
|||
[ <library> swap libraries get set-at ] 3bi ;
|
||||
|
||||
: library-abi ( library -- abi )
|
||||
library [ abi>> ] [ "cdecl" ] if* ;
|
||||
library [ abi>> ] [ cdecl ] if* ;
|
||||
|
||||
SYMBOL: deploy-libraries
|
||||
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ USING: accessors alien alien.c-types alien.libraries arrays
|
|||
assocs classes combinators combinators.short-circuit
|
||||
compiler.units effects grouping kernel parser sequences
|
||||
splitting words fry locals lexer namespaces summary math
|
||||
vocabs.parser ;
|
||||
vocabs.parser words.constant ;
|
||||
IN: alien.parser
|
||||
|
||||
: parse-c-type-name ( name -- word )
|
||||
|
|
@ -51,14 +51,17 @@ ERROR: *-in-c-type-name name ;
|
|||
dup "*" tail?
|
||||
[ *-in-c-type-name ] when ;
|
||||
|
||||
: CREATE-C-TYPE ( -- word )
|
||||
scan validate-c-type-name current-vocab create {
|
||||
: (CREATE-C-TYPE) ( word -- word )
|
||||
validate-c-type-name current-vocab create {
|
||||
[ fake-definition ]
|
||||
[ set-word ]
|
||||
[ reset-c-type ]
|
||||
[ ]
|
||||
} cleave ;
|
||||
|
||||
: CREATE-C-TYPE ( -- word )
|
||||
scan (CREATE-C-TYPE) ;
|
||||
|
||||
<PRIVATE
|
||||
GENERIC: return-type-name ( type -- name )
|
||||
|
||||
|
|
@ -72,6 +75,18 @@ M: pointer return-type-name to>> return-type-name CHAR: * suffix ;
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: define-enum-member ( word-string value -- next-value )
|
||||
[ create-in ] dip [ define-constant ] keep 1 + ;
|
||||
|
||||
: parse-enum-member ( word-string value -- next-value )
|
||||
over "{" =
|
||||
[ 2drop scan scan-object define-enum-member "}" expect ]
|
||||
[ define-enum-member ] if ;
|
||||
|
||||
: parse-enum-members ( counter -- )
|
||||
scan dup ";" = not
|
||||
[ swap parse-enum-member parse-enum-members ] [ 2drop ] if ;
|
||||
|
||||
: scan-function-name ( -- return function )
|
||||
scan-c-type scan parse-pointers ;
|
||||
|
||||
|
|
|
|||
|
|
@ -6,14 +6,14 @@ eval ;
|
|||
IN: alien.remote-control
|
||||
|
||||
: eval-callback ( -- callback )
|
||||
void* { c-string } "cdecl"
|
||||
void* { c-string } cdecl
|
||||
[ eval>string utf8 malloc-string ] alien-callback ;
|
||||
|
||||
: yield-callback ( -- callback )
|
||||
void { } "cdecl" [ yield ] alien-callback ;
|
||||
void { } cdecl [ yield ] alien-callback ;
|
||||
|
||||
: sleep-callback ( -- callback )
|
||||
void { long } "cdecl" [ sleep ] alien-callback ;
|
||||
void { long } cdecl [ sleep ] alien-callback ;
|
||||
|
||||
: ?callback ( word -- alien )
|
||||
dup optimized? [ execute ] [ drop f ] if ; inline
|
||||
|
|
|
|||
|
|
@ -58,15 +58,15 @@ HELP: TYPEDEF:
|
|||
{ $notes "This word differs from " { $link typedef } " in that it runs at parse time, to ensure correct ordering of operations when loading source files. Words defined in source files are compiled before top-level forms are run, so if a source file defines C binding words and uses " { $link typedef } ", the type alias won't be available at compile time." } ;
|
||||
|
||||
HELP: C-ENUM:
|
||||
{ $syntax "C-ENUM: words... ;" }
|
||||
{ $values { "words" "a sequence of word names" } }
|
||||
{ $description "Creates a sequence of word definitions in the current vocabulary. Each word pushes an integer according to its index in the enumeration definition. The first word pushes 0." }
|
||||
{ $syntax "C-ENUM: type/f words... ;" }
|
||||
{ $values { "type" "a name to typedef to int or f" } { "words" "a sequence of word names" } }
|
||||
{ $description "Creates a sequence of word definitions in the current vocabulary. Each word pushes an integer according to the rules of C enums." }
|
||||
{ $notes "This word emulates a C-style " { $snippet "enum" } " in Factor. While this feature can be used for any purpose, using integer constants is discouraged unless it is for interfacing with C libraries. Factor code should use " { $link "words.symbol" } " or " { $link "singletons" } " instead." }
|
||||
{ $examples
|
||||
"Here is an example enumeration definition:"
|
||||
{ $code "C-ENUM: red green blue ;" }
|
||||
{ $code "C-ENUM: color_t red { green 3 } blue ;" }
|
||||
"It is equivalent to the following series of definitions:"
|
||||
{ $code "CONSTANT: red 0" "CONSTANT: green 1" "CONSTANT: blue 2" }
|
||||
{ $code "CONSTANT: red 0" "CONSTANT: green 3" "CONSTANT: blue 4" }
|
||||
} ;
|
||||
|
||||
HELP: C-TYPE:
|
||||
|
|
|
|||
|
|
@ -25,8 +25,10 @@ SYNTAX: TYPEDEF:
|
|||
scan-c-type CREATE-C-TYPE dup save-location typedef ;
|
||||
|
||||
SYNTAX: C-ENUM:
|
||||
";" parse-tokens
|
||||
[ [ create-in ] dip define-constant ] each-index ;
|
||||
scan dup "f" =
|
||||
[ drop ]
|
||||
[ (CREATE-C-TYPE) dup save-location int swap typedef ] if
|
||||
0 parse-enum-members ;
|
||||
|
||||
SYNTAX: C-TYPE:
|
||||
void CREATE-C-TYPE typedef ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,8 @@
|
|||
! Copyright (c) 2007 Sampo Vuori
|
||||
! Copyright (c) 2008 Matthew Willis
|
||||
!
|
||||
|
||||
|
||||
! Adapted from cairo.h, version 1.5.14
|
||||
! License: http://factorcode.org/license.txt
|
||||
|
||||
|
|
@ -10,8 +12,8 @@ alien.libraries classes.struct ;
|
|||
|
||||
IN: cairo.ffi
|
||||
<< {
|
||||
{ [ os winnt? ] [ "cairo" "libcairo-2.dll" "cdecl" add-library ] }
|
||||
{ [ os macosx? ] [ "cairo" "/opt/local/lib/libcairo.dylib" "cdecl" add-library ] }
|
||||
{ [ os winnt? ] [ "cairo" "libcairo-2.dll" cdecl add-library ] }
|
||||
{ [ os macosx? ] [ "cairo" "/opt/local/lib/libcairo.dylib" cdecl add-library ] }
|
||||
{ [ os unix? ] [ ] }
|
||||
} cond >>
|
||||
|
||||
|
|
@ -38,14 +40,13 @@ TYPEDEF: void* cairo_pattern_t
|
|||
|
||||
TYPEDEF: void* cairo_destroy_func_t
|
||||
: cairo-destroy-func ( quot -- callback )
|
||||
[ void { pointer: void } "cdecl" ] dip alien-callback ; inline
|
||||
[ void { pointer: void } cdecl ] dip alien-callback ; inline
|
||||
|
||||
! See cairo.h for details
|
||||
STRUCT: cairo_user_data_key_t
|
||||
{ unused int } ;
|
||||
|
||||
TYPEDEF: int cairo_status_t
|
||||
C-ENUM:
|
||||
C-ENUM: cairo_status_t
|
||||
CAIRO_STATUS_SUCCESS
|
||||
CAIRO_STATUS_NO_MEMORY
|
||||
CAIRO_STATUS_INVALID_RESTORE
|
||||
|
|
@ -79,11 +80,11 @@ CONSTANT: CAIRO_CONTENT_COLOR_ALPHA HEX: 3000
|
|||
|
||||
TYPEDEF: void* cairo_write_func_t
|
||||
: cairo-write-func ( quot -- callback )
|
||||
[ cairo_status_t { pointer: void c-string int } "cdecl" ] dip alien-callback ; inline
|
||||
[ cairo_status_t { pointer: void c-string int } cdecl ] dip alien-callback ; inline
|
||||
|
||||
TYPEDEF: void* cairo_read_func_t
|
||||
: cairo-read-func ( quot -- callback )
|
||||
[ cairo_status_t { pointer: void c-string int } "cdecl" ] dip alien-callback ; inline
|
||||
[ cairo_status_t { pointer: void c-string int } cdecl ] dip alien-callback ; inline
|
||||
|
||||
! Functions for manipulating state objects
|
||||
FUNCTION: cairo_t*
|
||||
|
|
@ -125,8 +126,7 @@ FUNCTION: void
|
|||
cairo_pop_group_to_source ( cairo_t* cr ) ;
|
||||
|
||||
! Modify state
|
||||
TYPEDEF: int cairo_operator_t
|
||||
C-ENUM:
|
||||
C-ENUM: cairo_operator_t
|
||||
CAIRO_OPERATOR_CLEAR
|
||||
|
||||
CAIRO_OPERATOR_SOURCE
|
||||
|
|
@ -163,8 +163,7 @@ cairo_set_source_surface ( cairo_t* cr, cairo_surface_t* surface, double x, doub
|
|||
FUNCTION: void
|
||||
cairo_set_tolerance ( cairo_t* cr, double tolerance ) ;
|
||||
|
||||
TYPEDEF: int cairo_antialias_t
|
||||
C-ENUM:
|
||||
C-ENUM: cairo_antialias_t
|
||||
CAIRO_ANTIALIAS_DEFAULT
|
||||
CAIRO_ANTIALIAS_NONE
|
||||
CAIRO_ANTIALIAS_GRAY
|
||||
|
|
@ -173,8 +172,7 @@ C-ENUM:
|
|||
FUNCTION: void
|
||||
cairo_set_antialias ( cairo_t* cr, cairo_antialias_t antialias ) ;
|
||||
|
||||
TYPEDEF: int cairo_fill_rule_t
|
||||
C-ENUM:
|
||||
C-ENUM: cairo_fill_rule_t
|
||||
CAIRO_FILL_RULE_WINDING
|
||||
CAIRO_FILL_RULE_EVEN_ODD ;
|
||||
|
||||
|
|
@ -184,8 +182,7 @@ cairo_set_fill_rule ( cairo_t* cr, cairo_fill_rule_t fill_rule ) ;
|
|||
FUNCTION: void
|
||||
cairo_set_line_width ( cairo_t* cr, double width ) ;
|
||||
|
||||
TYPEDEF: int cairo_line_cap_t
|
||||
C-ENUM:
|
||||
C-ENUM: cairo_line_cap_t
|
||||
CAIRO_LINE_CAP_BUTT
|
||||
CAIRO_LINE_CAP_ROUND
|
||||
CAIRO_LINE_CAP_SQUARE ;
|
||||
|
|
@ -193,8 +190,7 @@ C-ENUM:
|
|||
FUNCTION: void
|
||||
cairo_set_line_cap ( cairo_t* cr, cairo_line_cap_t line_cap ) ;
|
||||
|
||||
TYPEDEF: int cairo_line_join_t
|
||||
C-ENUM:
|
||||
C-ENUM: cairo_line_join_t
|
||||
CAIRO_LINE_JOIN_MITER
|
||||
CAIRO_LINE_JOIN_ROUND
|
||||
CAIRO_LINE_JOIN_BEVEL ;
|
||||
|
|
@ -379,35 +375,30 @@ STRUCT: cairo_font_extents_t
|
|||
{ max_x_advance double }
|
||||
{ max_y_advance double } ;
|
||||
|
||||
TYPEDEF: int cairo_font_slant_t
|
||||
C-ENUM:
|
||||
C-ENUM: cairo_font_slant_t
|
||||
CAIRO_FONT_SLANT_NORMAL
|
||||
CAIRO_FONT_SLANT_ITALIC
|
||||
CAIRO_FONT_SLANT_OBLIQUE ;
|
||||
|
||||
TYPEDEF: int cairo_font_weight_t
|
||||
C-ENUM:
|
||||
C-ENUM: cairo_font_weight_t
|
||||
CAIRO_FONT_WEIGHT_NORMAL
|
||||
CAIRO_FONT_WEIGHT_BOLD ;
|
||||
|
||||
TYPEDEF: int cairo_subpixel_order_t
|
||||
C-ENUM:
|
||||
C-ENUM: cairo_subpixel_order_t
|
||||
CAIRO_SUBPIXEL_ORDER_DEFAULT
|
||||
CAIRO_SUBPIXEL_ORDER_RGB
|
||||
CAIRO_SUBPIXEL_ORDER_BGR
|
||||
CAIRO_SUBPIXEL_ORDER_VRGB
|
||||
CAIRO_SUBPIXEL_ORDER_VBGR ;
|
||||
|
||||
TYPEDEF: int cairo_hint_style_t
|
||||
C-ENUM:
|
||||
C-ENUM: cairo_hint_style_t
|
||||
CAIRO_HINT_STYLE_DEFAULT
|
||||
CAIRO_HINT_STYLE_NONE
|
||||
CAIRO_HINT_STYLE_SLIGHT
|
||||
CAIRO_HINT_STYLE_MEDIUM
|
||||
CAIRO_HINT_STYLE_FULL ;
|
||||
|
||||
TYPEDEF: int cairo_hint_metrics_t
|
||||
C-ENUM:
|
||||
C-ENUM: cairo_hint_metrics_t
|
||||
CAIRO_HINT_METRICS_DEFAULT
|
||||
CAIRO_HINT_METRICS_OFF
|
||||
CAIRO_HINT_METRICS_ON ;
|
||||
|
|
@ -527,8 +518,7 @@ cairo_font_face_get_reference_count ( cairo_font_face_t* font_face ) ;
|
|||
FUNCTION: cairo_status_t
|
||||
cairo_font_face_status ( cairo_font_face_t* font_face ) ;
|
||||
|
||||
TYPEDEF: int cairo_font_type_t
|
||||
C-ENUM:
|
||||
C-ENUM: cairo_font_type_t
|
||||
CAIRO_FONT_TYPE_TOY
|
||||
CAIRO_FONT_TYPE_FT
|
||||
CAIRO_FONT_TYPE_WIN32
|
||||
|
|
@ -640,8 +630,7 @@ cairo_get_target ( cairo_t* cr ) ;
|
|||
FUNCTION: cairo_surface_t*
|
||||
cairo_get_group_target ( cairo_t* cr ) ;
|
||||
|
||||
TYPEDEF: int cairo_path_data_type_t
|
||||
C-ENUM:
|
||||
C-ENUM: cairo_path_data_type_t
|
||||
CAIRO_PATH_MOVE_TO
|
||||
CAIRO_PATH_LINE_TO
|
||||
CAIRO_PATH_CURVE_TO
|
||||
|
|
@ -707,8 +696,7 @@ cairo_surface_get_reference_count ( cairo_surface_t* surface ) ;
|
|||
FUNCTION: cairo_status_t
|
||||
cairo_surface_status ( cairo_surface_t* surface ) ;
|
||||
|
||||
TYPEDEF: int cairo_surface_type_t
|
||||
C-ENUM:
|
||||
C-ENUM: cairo_surface_type_t
|
||||
CAIRO_SURFACE_TYPE_IMAGE
|
||||
CAIRO_SURFACE_TYPE_PDF
|
||||
CAIRO_SURFACE_TYPE_PS
|
||||
|
|
@ -771,8 +759,7 @@ cairo_surface_show_page ( cairo_surface_t* surface ) ;
|
|||
|
||||
! Image-surface functions
|
||||
|
||||
TYPEDEF: int cairo_format_t
|
||||
C-ENUM:
|
||||
C-ENUM: cairo_format_t
|
||||
CAIRO_FORMAT_ARGB32
|
||||
CAIRO_FORMAT_RGB24
|
||||
CAIRO_FORMAT_A8
|
||||
|
|
@ -844,8 +831,7 @@ cairo_pattern_get_user_data ( cairo_pattern_t* pattern, cairo_user_data_key_t* k
|
|||
FUNCTION: cairo_status_t
|
||||
cairo_pattern_set_user_data ( cairo_pattern_t* pattern, cairo_user_data_key_t* key, void* user_data, cairo_destroy_func_t destroy ) ;
|
||||
|
||||
TYPEDEF: int cairo_pattern_type_t
|
||||
C-ENUM:
|
||||
C-ENUM: cairo_pattern_type_t
|
||||
CAIRO_PATTERN_TYPE_SOLID
|
||||
CAIRO_PATTERN_TYPE_SURFACE
|
||||
CAIRO_PATTERN_TYPE_LINEAR
|
||||
|
|
@ -866,8 +852,7 @@ cairo_pattern_set_matrix ( cairo_pattern_t* pattern, cairo_matrix_t* matrix ) ;
|
|||
FUNCTION: void
|
||||
cairo_pattern_get_matrix ( cairo_pattern_t* pattern, cairo_matrix_t* matrix ) ;
|
||||
|
||||
TYPEDEF: int cairo_extend_t
|
||||
C-ENUM:
|
||||
C-ENUM: cairo_extend_t
|
||||
CAIRO_EXTEND_NONE
|
||||
CAIRO_EXTEND_REPEAT
|
||||
CAIRO_EXTEND_REFLECT
|
||||
|
|
@ -879,8 +864,7 @@ cairo_pattern_set_extend ( cairo_pattern_t* pattern, cairo_extend_t extend ) ;
|
|||
FUNCTION: cairo_extend_t
|
||||
cairo_pattern_get_extend ( cairo_pattern_t* pattern ) ;
|
||||
|
||||
TYPEDEF: int cairo_filter_t
|
||||
C-ENUM:
|
||||
C-ENUM: cairo_filter_t
|
||||
CAIRO_FILTER_FAST
|
||||
CAIRO_FILTER_GOOD
|
||||
CAIRO_FILTER_BEST
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ IN: cocoa.application
|
|||
|
||||
: <NSString> ( str -- alien ) <CFString> -> autorelease ;
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: f
|
||||
NSApplicationDelegateReplySuccess
|
||||
NSApplicationDelegateReplyCancel
|
||||
NSApplicationDelegateReplyFailure ;
|
||||
|
|
|
|||
|
|
@ -40,7 +40,7 @@ IN: cocoa.subclassing
|
|||
|
||||
: prepare-method ( ret types quot -- type imp )
|
||||
[ [ encode-types ] 2keep ] dip
|
||||
'[ _ _ "cdecl" _ alien-callback ]
|
||||
'[ _ _ cdecl _ alien-callback ]
|
||||
(( -- callback )) define-temp ;
|
||||
|
||||
: prepare-methods ( methods -- methods )
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ IN: compiler.alien
|
|||
|
||||
: alien-parameters ( params -- seq )
|
||||
dup parameters>>
|
||||
swap return>> large-struct? [ void* prefix ] when ;
|
||||
swap return>> large-struct? [ struct-return-pointer-type prefix ] when ;
|
||||
|
||||
: alien-return ( params -- type )
|
||||
return>> dup large-struct? [ drop void ] when ;
|
||||
|
|
|
|||
|
|
@ -68,8 +68,8 @@ IN: compiler.cfg.builder.tests
|
|||
[ [ dup ] loop ]
|
||||
[ [ 2 ] [ 3 throw ] if 4 ]
|
||||
[ int f "malloc" { int } alien-invoke ]
|
||||
[ int { int } "cdecl" alien-indirect ]
|
||||
[ int { int } "cdecl" [ ] alien-callback ]
|
||||
[ int { int } cdecl alien-indirect ]
|
||||
[ int { int } cdecl [ ] alien-callback ]
|
||||
[ swap - + * ]
|
||||
[ swap slot ]
|
||||
[ blahblah ]
|
||||
|
|
|
|||
|
|
@ -300,12 +300,12 @@ M: float-rep next-fastcall-param
|
|||
M: double-rep next-fastcall-param
|
||||
float-regs inc [ ?dummy-stack-params ] [ ?dummy-int-params ] bi ;
|
||||
|
||||
GENERIC: reg-class-full? ( reg-class -- ? )
|
||||
GENERIC# reg-class-full? 1 ( reg-class abi -- ? )
|
||||
|
||||
M: stack-params reg-class-full? drop t ;
|
||||
M: stack-params reg-class-full? 2drop t ;
|
||||
|
||||
M: reg-class reg-class-full?
|
||||
[ get ] [ param-regs length ] bi >= ;
|
||||
[ get ] swap '[ _ param-regs length ] bi >= ;
|
||||
|
||||
: alloc-stack-param ( rep -- n reg-class rep )
|
||||
stack-params get
|
||||
|
|
@ -315,13 +315,22 @@ M: reg-class reg-class-full?
|
|||
: alloc-fastcall-param ( rep -- n reg-class rep )
|
||||
[ [ reg-class-of get ] [ reg-class-of ] [ next-fastcall-param ] tri ] keep ;
|
||||
|
||||
: alloc-parameter ( parameter -- reg rep )
|
||||
c-type-rep dup reg-class-of reg-class-full?
|
||||
:: alloc-parameter ( parameter abi -- reg rep )
|
||||
parameter c-type-rep dup reg-class-of abi reg-class-full?
|
||||
[ alloc-stack-param ] [ alloc-fastcall-param ] if
|
||||
[ param-reg ] dip ;
|
||||
[ abi param-reg ] dip ;
|
||||
|
||||
SYMBOL: (stack-value)
|
||||
<< void* c-type clone \ (stack-value) define-primitive-type
|
||||
stack-params \ (stack-value) c-type (>>rep) >>
|
||||
|
||||
: ((flatten-type)) ( type to-type -- seq )
|
||||
[ stack-size cell align cell /i ] dip c-type <repetition> ; inline
|
||||
|
||||
: (flatten-int-type) ( type -- seq )
|
||||
stack-size cell align cell /i void* c-type <repetition> ;
|
||||
void* ((flatten-type)) ;
|
||||
: (flatten-stack-type) ( type -- seq )
|
||||
(stack-value) ((flatten-type)) ;
|
||||
|
||||
GENERIC: flatten-value-type ( type -- types )
|
||||
|
||||
|
|
@ -355,8 +364,8 @@ M: c-type-name flatten-value-type c-type flatten-value-type ;
|
|||
#! Moves values from C stack to registers (if word is
|
||||
#! %load-param-reg) and registers to C stack (if word is
|
||||
#! %save-param-reg).
|
||||
[ alien-parameters flatten-value-types ]
|
||||
[ '[ alloc-parameter _ execute ] ]
|
||||
[ [ alien-parameters flatten-value-types ] [ abi>> ] bi ]
|
||||
[ '[ _ alloc-parameter _ execute ] ]
|
||||
bi* each-parameter ; inline
|
||||
|
||||
: reverse-each-parameter ( parameters quot -- )
|
||||
|
|
@ -412,7 +421,7 @@ M: array dlsym-valid? '[ _ dlsym ] any? ;
|
|||
3array ;
|
||||
|
||||
: alien-invoke-dlsym ( params -- symbols dll )
|
||||
[ dup abi>> "stdcall" = [ stdcall-mangle ] [ function>> ] if ]
|
||||
[ dup abi>> stdcall = [ stdcall-mangle ] [ function>> ] if ]
|
||||
[ library>> load-library ]
|
||||
bi 2dup check-dlsym ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,10 +1,11 @@
|
|||
USING: accessors alien alien.c-types alien.libraries
|
||||
alien.syntax arrays classes.struct combinators
|
||||
compiler continuations effects io io.backend io.pathnames
|
||||
io.streams.string kernel math memory namespaces
|
||||
namespaces.private parser quotations sequences
|
||||
specialized-arrays stack-checker stack-checker.errors
|
||||
system threads tools.test words alien.complex concurrency.promises ;
|
||||
compiler continuations effects generalizations io
|
||||
io.backend io.pathnames io.streams.string kernel
|
||||
math memory namespaces namespaces.private parser
|
||||
quotations sequences specialized-arrays stack-checker
|
||||
stack-checker.errors system threads tools.test words
|
||||
alien.complex concurrency.promises ;
|
||||
FROM: alien.c-types => float short ;
|
||||
SPECIALIZED-ARRAY: float
|
||||
SPECIALIZED-ARRAY: char
|
||||
|
|
@ -19,9 +20,11 @@ IN: compiler.tests.alien
|
|||
{ [ os unix? ] [ "libfactor-ffi-test.so" ] }
|
||||
} cond append-path ;
|
||||
|
||||
"f-cdecl" libfactor-ffi-tests-path "cdecl" add-library
|
||||
"f-cdecl" libfactor-ffi-tests-path cdecl add-library
|
||||
|
||||
"f-stdcall" libfactor-ffi-tests-path "stdcall" add-library
|
||||
"f-stdcall" libfactor-ffi-tests-path stdcall add-library
|
||||
|
||||
"f-fastcall" libfactor-ffi-tests-path fastcall add-library
|
||||
>>
|
||||
|
||||
LIBRARY: f-cdecl
|
||||
|
|
@ -90,7 +93,7 @@ FUNCTION: TINY ffi_test_17 int x ;
|
|||
[ [ alien-indirect ] infer ] [ inference-error? ] must-fail-with
|
||||
|
||||
: indirect-test-1 ( ptr -- result )
|
||||
int { } "cdecl" alien-indirect ;
|
||||
int { } cdecl alien-indirect ;
|
||||
|
||||
{ 1 1 } [ indirect-test-1 ] must-infer-as
|
||||
|
||||
|
|
@ -99,7 +102,7 @@ FUNCTION: TINY ffi_test_17 int x ;
|
|||
[ 3 ] [ &: ffi_test_1 indirect-test-1 ] unit-test
|
||||
|
||||
: indirect-test-1' ( ptr -- )
|
||||
int { } "cdecl" alien-indirect drop ;
|
||||
int { } cdecl alien-indirect drop ;
|
||||
|
||||
{ 1 0 } [ indirect-test-1' ] must-infer-as
|
||||
|
||||
|
|
@ -108,7 +111,7 @@ FUNCTION: TINY ffi_test_17 int x ;
|
|||
[ -1 indirect-test-1 ] must-fail
|
||||
|
||||
: indirect-test-2 ( x y ptr -- result )
|
||||
int { int int } "cdecl" alien-indirect gc ;
|
||||
int { int int } cdecl alien-indirect gc ;
|
||||
|
||||
{ 3 1 } [ indirect-test-2 ] must-infer-as
|
||||
|
||||
|
|
@ -117,11 +120,11 @@ FUNCTION: TINY ffi_test_17 int x ;
|
|||
unit-test
|
||||
|
||||
: indirect-test-3 ( a b c d ptr -- result )
|
||||
int { int int int int } "stdcall" alien-indirect
|
||||
int { int int int int } stdcall alien-indirect
|
||||
gc ;
|
||||
|
||||
[ f ] [ "f-stdcall" load-library f = ] unit-test
|
||||
[ "stdcall" ] [ "f-stdcall" library abi>> ] unit-test
|
||||
[ stdcall ] [ "f-stdcall" library abi>> ] unit-test
|
||||
|
||||
: ffi_test_18 ( w x y z -- int )
|
||||
int "f-stdcall" "ffi_test_18" { int int int int }
|
||||
|
|
@ -137,6 +140,14 @@ unit-test
|
|||
11 6 -7 ffi_test_19 [ x>> ] [ y>> ] [ z>> ] tri
|
||||
] unit-test
|
||||
|
||||
: multi_ffi_test_18 ( w x y z w' x' y' z' -- int int )
|
||||
[ int "f-stdcall" "ffi_test_18" { int int int int } alien-invoke ]
|
||||
4 ndip
|
||||
int "f-stdcall" "ffi_test_18" { int int int int } alien-invoke
|
||||
gc ;
|
||||
|
||||
[ 25 85 ] [ 2 3 4 5 6 7 8 9 multi_ffi_test_18 ] unit-test
|
||||
|
||||
FUNCTION: double ffi_test_6 float x float y ;
|
||||
[ 6.0 ] [ 3.0 2.0 ffi_test_6 ] unit-test
|
||||
[ "a" "b" ffi_test_6 ] must-fail
|
||||
|
|
@ -314,21 +325,21 @@ FUNCTION: ulonglong ffi_test_38 ( ulonglong x, ulonglong y ) ;
|
|||
|
||||
! Test callbacks
|
||||
|
||||
: callback-1 ( -- callback ) void { } "cdecl" [ ] alien-callback ;
|
||||
: callback-1 ( -- callback ) void { } cdecl [ ] alien-callback ;
|
||||
|
||||
[ 0 1 ] [ [ callback-1 ] infer [ in>> length ] [ out>> length ] bi ] unit-test
|
||||
|
||||
[ t ] [ callback-1 alien? ] unit-test
|
||||
|
||||
: callback_test_1 ( ptr -- ) void { } "cdecl" alien-indirect ;
|
||||
: callback_test_1 ( ptr -- ) void { } cdecl alien-indirect ;
|
||||
|
||||
[ ] [ callback-1 callback_test_1 ] unit-test
|
||||
|
||||
: callback-2 ( -- callback ) void { } "cdecl" [ [ 5 throw ] ignore-errors ] alien-callback ;
|
||||
: callback-2 ( -- callback ) void { } cdecl [ [ 5 throw ] ignore-errors ] alien-callback ;
|
||||
|
||||
[ ] [ callback-2 callback_test_1 ] unit-test
|
||||
|
||||
: callback-3 ( -- callback ) void { } "cdecl" [ 5 "x" set ] alien-callback ;
|
||||
: callback-3 ( -- callback ) void { } cdecl [ 5 "x" set ] alien-callback ;
|
||||
|
||||
[ t 3 5 ] [
|
||||
[
|
||||
|
|
@ -340,38 +351,38 @@ FUNCTION: ulonglong ffi_test_38 ( ulonglong x, ulonglong y ) ;
|
|||
] unit-test
|
||||
|
||||
: callback-5 ( -- callback )
|
||||
void { } "cdecl" [ gc ] alien-callback ;
|
||||
void { } cdecl [ gc ] alien-callback ;
|
||||
|
||||
[ "testing" ] [
|
||||
"testing" callback-5 callback_test_1
|
||||
] unit-test
|
||||
|
||||
: callback-5b ( -- callback )
|
||||
void { } "cdecl" [ compact-gc ] alien-callback ;
|
||||
void { } cdecl [ compact-gc ] alien-callback ;
|
||||
|
||||
[ "testing" ] [
|
||||
"testing" callback-5b callback_test_1
|
||||
] unit-test
|
||||
|
||||
: callback-6 ( -- callback )
|
||||
void { } "cdecl" [ [ continue ] callcc0 ] alien-callback ;
|
||||
void { } cdecl [ [ continue ] callcc0 ] alien-callback ;
|
||||
|
||||
[ 1 2 3 ] [ callback-6 callback_test_1 1 2 3 ] unit-test
|
||||
|
||||
: callback-7 ( -- callback )
|
||||
void { } "cdecl" [ 1000000 sleep ] alien-callback ;
|
||||
void { } cdecl [ 1000000 sleep ] alien-callback ;
|
||||
|
||||
[ 1 2 3 ] [ callback-7 callback_test_1 1 2 3 ] unit-test
|
||||
|
||||
[ f ] [ namespace global eq? ] unit-test
|
||||
|
||||
: callback-8 ( -- callback )
|
||||
void { } "cdecl" [ [ ] in-thread yield ] alien-callback ;
|
||||
void { } cdecl [ [ ] in-thread yield ] alien-callback ;
|
||||
|
||||
[ ] [ callback-8 callback_test_1 ] unit-test
|
||||
|
||||
: callback-9 ( -- callback )
|
||||
int { int int int } "cdecl" [
|
||||
int { int int int } cdecl [
|
||||
+ + 1 +
|
||||
] alien-callback ;
|
||||
|
||||
|
|
@ -429,12 +440,12 @@ STRUCT: double-rect
|
|||
} cleave ;
|
||||
|
||||
: double-rect-callback ( -- alien )
|
||||
void { void* void* double-rect } "cdecl"
|
||||
void { void* void* double-rect } cdecl
|
||||
[ "example" set-global 2drop ] alien-callback ;
|
||||
|
||||
: double-rect-test ( arg callback -- arg' )
|
||||
[ f f ] 2dip
|
||||
void { void* void* double-rect } "cdecl" alien-indirect
|
||||
void { void* void* double-rect } cdecl alien-indirect
|
||||
"example" get-global ;
|
||||
|
||||
[ 1.0 2.0 3.0 4.0 ]
|
||||
|
|
@ -455,7 +466,7 @@ FUNCTION: test_struct_14 ffi_test_40 ( double x1, double x2 ) ;
|
|||
] unit-test
|
||||
|
||||
: callback-10 ( -- callback )
|
||||
test_struct_14 { double double } "cdecl"
|
||||
test_struct_14 { double double } cdecl
|
||||
[
|
||||
test_struct_14 <struct>
|
||||
swap >>x2
|
||||
|
|
@ -463,7 +474,7 @@ FUNCTION: test_struct_14 ffi_test_40 ( double x1, double x2 ) ;
|
|||
] alien-callback ;
|
||||
|
||||
: callback-10-test ( x1 x2 callback -- result )
|
||||
test_struct_14 { double double } "cdecl" alien-indirect ;
|
||||
test_struct_14 { double double } cdecl alien-indirect ;
|
||||
|
||||
[ 1.0 2.0 ] [
|
||||
1.0 2.0 callback-10 callback-10-test
|
||||
|
|
@ -478,7 +489,7 @@ FUNCTION: test-struct-12 ffi_test_41 ( int a, double x ) ;
|
|||
] unit-test
|
||||
|
||||
: callback-11 ( -- callback )
|
||||
test-struct-12 { int double } "cdecl"
|
||||
test-struct-12 { int double } cdecl
|
||||
[
|
||||
test-struct-12 <struct>
|
||||
swap >>x
|
||||
|
|
@ -486,7 +497,7 @@ FUNCTION: test-struct-12 ffi_test_41 ( int a, double x ) ;
|
|||
] alien-callback ;
|
||||
|
||||
: callback-11-test ( x1 x2 callback -- result )
|
||||
test-struct-12 { int double } "cdecl" alien-indirect ;
|
||||
test-struct-12 { int double } cdecl alien-indirect ;
|
||||
|
||||
[ 1 2.0 ] [
|
||||
1 2.0 callback-11 callback-11-test
|
||||
|
|
@ -502,7 +513,7 @@ FUNCTION: test_struct_15 ffi_test_42 ( float x, float y ) ;
|
|||
[ 1.0 2.0 ] [ 1.0 2.0 ffi_test_42 [ x>> ] [ y>> ] bi ] unit-test
|
||||
|
||||
: callback-12 ( -- callback )
|
||||
test_struct_15 { float float } "cdecl"
|
||||
test_struct_15 { float float } cdecl
|
||||
[
|
||||
test_struct_15 <struct>
|
||||
swap >>y
|
||||
|
|
@ -510,7 +521,7 @@ FUNCTION: test_struct_15 ffi_test_42 ( float x, float y ) ;
|
|||
] alien-callback ;
|
||||
|
||||
: callback-12-test ( x1 x2 callback -- result )
|
||||
test_struct_15 { float float } "cdecl" alien-indirect ;
|
||||
test_struct_15 { float float } cdecl alien-indirect ;
|
||||
|
||||
[ 1.0 2.0 ] [
|
||||
1.0 2.0 callback-12 callback-12-test [ x>> ] [ y>> ] bi
|
||||
|
|
@ -525,7 +536,7 @@ FUNCTION: test_struct_16 ffi_test_43 ( float x, int a ) ;
|
|||
[ 1.0 2 ] [ 1.0 2 ffi_test_43 [ x>> ] [ a>> ] bi ] unit-test
|
||||
|
||||
: callback-13 ( -- callback )
|
||||
test_struct_16 { float int } "cdecl"
|
||||
test_struct_16 { float int } cdecl
|
||||
[
|
||||
test_struct_16 <struct>
|
||||
swap >>a
|
||||
|
|
@ -533,7 +544,7 @@ FUNCTION: test_struct_16 ffi_test_43 ( float x, int a ) ;
|
|||
] alien-callback ;
|
||||
|
||||
: callback-13-test ( x1 x2 callback -- result )
|
||||
test_struct_16 { float int } "cdecl" alien-indirect ;
|
||||
test_struct_16 { float int } cdecl alien-indirect ;
|
||||
|
||||
[ 1.0 2 ] [
|
||||
1.0 2 callback-13 callback-13-test
|
||||
|
|
@ -584,13 +595,13 @@ FUNCTION: short ffi_test_48 ( bool-field-test x ) ;
|
|||
|
||||
! Test interaction between threads and callbacks
|
||||
: thread-callback-1 ( -- callback )
|
||||
int { } "cdecl" [ yield 100 ] alien-callback ;
|
||||
int { } cdecl [ yield 100 ] alien-callback ;
|
||||
|
||||
: thread-callback-2 ( -- callback )
|
||||
int { } "cdecl" [ yield 200 ] alien-callback ;
|
||||
int { } cdecl [ yield 200 ] alien-callback ;
|
||||
|
||||
: thread-callback-invoker ( callback -- n )
|
||||
int { } "cdecl" alien-indirect ;
|
||||
int { } cdecl alien-indirect ;
|
||||
|
||||
<promise> "p" set
|
||||
[ thread-callback-1 thread-callback-invoker "p" get fulfill ] in-thread
|
||||
|
|
@ -603,6 +614,98 @@ FUNCTION: void this_does_not_exist ( ) ;
|
|||
[ this_does_not_exist ] [ { "kernel-error" 9 f f } = ] must-fail-with
|
||||
|
||||
! More alien-assembly tests are in cpu.* vocabs
|
||||
: assembly-test-1 ( -- ) void { } "cdecl" [ ] alien-assembly ;
|
||||
: assembly-test-1 ( -- ) void { } cdecl [ ] alien-assembly ;
|
||||
|
||||
[ ] [ assembly-test-1 ] unit-test
|
||||
|
||||
[ f ] [ "f-fastcall" load-library f = ] unit-test
|
||||
[ fastcall ] [ "f-fastcall" library abi>> ] unit-test
|
||||
|
||||
: ffi_test_49 ( x -- int )
|
||||
int "f-fastcall" "ffi_test_49" { int }
|
||||
alien-invoke gc ;
|
||||
: ffi_test_50 ( x y -- int )
|
||||
int "f-fastcall" "ffi_test_50" { int int }
|
||||
alien-invoke gc ;
|
||||
: ffi_test_51 ( x y z -- int )
|
||||
int "f-fastcall" "ffi_test_51" { int int int }
|
||||
alien-invoke gc ;
|
||||
: multi_ffi_test_51 ( x y z x' y' z' -- int int )
|
||||
[ int "f-fastcall" "ffi_test_51" { int int int } alien-invoke ]
|
||||
3dip
|
||||
int "f-fastcall" "ffi_test_51" { int int int } alien-invoke gc ;
|
||||
|
||||
[ 4 ] [ 3 ffi_test_49 ] unit-test
|
||||
[ 8 ] [ 3 4 ffi_test_50 ] unit-test
|
||||
[ 13 ] [ 3 4 5 ffi_test_51 ] unit-test
|
||||
[ 13 22 ] [ 3 4 5 6 7 8 multi_ffi_test_51 ] unit-test
|
||||
|
||||
: ffi_test_52 ( x y z -- int )
|
||||
int "f-fastcall" "ffi_test_52" { int float int }
|
||||
alien-invoke gc ;
|
||||
: ffi_test_53 ( x y z w -- int )
|
||||
int "f-fastcall" "ffi_test_53" { int float int int }
|
||||
alien-invoke gc ;
|
||||
: ffi_test_57 ( x y -- test-struct-11 )
|
||||
test-struct-11 "f-fastcall" "ffi_test_57" { int int }
|
||||
alien-invoke gc ;
|
||||
: ffi_test_58 ( x y z -- test-struct-11 )
|
||||
test-struct-11 "f-fastcall" "ffi_test_58" { int int int }
|
||||
alien-invoke gc ;
|
||||
|
||||
[ 13 ] [ 3 4.0 5 ffi_test_52 ] unit-test
|
||||
[ 19 ] [ 3 4.0 5 6 ffi_test_53 ] unit-test
|
||||
[ S{ test-struct-11 f 7 -1 } ] [ 3 4 ffi_test_57 ] unit-test
|
||||
[ S{ test-struct-11 f 7 -3 } ] [ 3 4 7 ffi_test_58 ] unit-test
|
||||
|
||||
: fastcall-ii-indirect ( x y ptr -- result )
|
||||
int { int int } fastcall alien-indirect ;
|
||||
: fastcall-iii-indirect ( x y z ptr -- result )
|
||||
int { int int int } fastcall alien-indirect ;
|
||||
: fastcall-ifi-indirect ( x y z ptr -- result )
|
||||
int { int float int } fastcall alien-indirect ;
|
||||
: fastcall-ifii-indirect ( x y z w ptr -- result )
|
||||
int { int float int int } fastcall alien-indirect ;
|
||||
: fastcall-struct-return-ii-indirect ( x y ptr -- result )
|
||||
test-struct-11 { int int } fastcall alien-indirect ;
|
||||
: fastcall-struct-return-iii-indirect ( x y z ptr -- result )
|
||||
test-struct-11 { int int int } fastcall alien-indirect ;
|
||||
|
||||
[ 8 ] [ 3 4 &: ffi_test_50 fastcall-ii-indirect ] unit-test
|
||||
[ 13 ] [ 3 4 5 &: ffi_test_51 fastcall-iii-indirect ] unit-test
|
||||
[ 13 ] [ 3 4.0 5 &: ffi_test_52 fastcall-ifi-indirect ] unit-test
|
||||
[ 19 ] [ 3 4.0 5 6 &: ffi_test_53 fastcall-ifii-indirect ] unit-test
|
||||
|
||||
[ S{ test-struct-11 f 7 -1 } ]
|
||||
[ 3 4 &: ffi_test_57 fastcall-struct-return-ii-indirect ] unit-test
|
||||
|
||||
[ S{ test-struct-11 f 7 -3 } ]
|
||||
[ 3 4 7 &: ffi_test_58 fastcall-struct-return-iii-indirect ] unit-test
|
||||
|
||||
: fastcall-ii-callback ( -- ptr )
|
||||
int { int int } fastcall [ + 1 + ] alien-callback ;
|
||||
: fastcall-iii-callback ( -- ptr )
|
||||
int { int int int } fastcall [ + + 1 + ] alien-callback ;
|
||||
: fastcall-ifi-callback ( -- ptr )
|
||||
int { int float int } fastcall
|
||||
[ [ >integer ] dip + + 1 + ] alien-callback ;
|
||||
: fastcall-ifii-callback ( -- ptr )
|
||||
int { int float int int } fastcall
|
||||
[ [ >integer ] 2dip + + + 1 + ] alien-callback ;
|
||||
: fastcall-struct-return-ii-callback ( -- ptr )
|
||||
test-struct-11 { int int } fastcall
|
||||
[ [ + ] [ - ] 2bi test-struct-11 <struct-boa> ] alien-callback ;
|
||||
: fastcall-struct-return-iii-callback ( -- ptr )
|
||||
test-struct-11 { int int int } fastcall
|
||||
[ [ drop + ] [ - nip ] 3bi test-struct-11 <struct-boa> ] alien-callback ;
|
||||
|
||||
[ 8 ] [ 3 4 fastcall-ii-callback fastcall-ii-indirect ] unit-test
|
||||
[ 13 ] [ 3 4 5 fastcall-iii-callback fastcall-iii-indirect ] unit-test
|
||||
[ 13 ] [ 3 4.0 5 fastcall-ifi-callback fastcall-ifi-indirect ] unit-test
|
||||
[ 19 ] [ 3 4.0 5 6 fastcall-ifii-callback fastcall-ifii-indirect ] unit-test
|
||||
|
||||
[ S{ test-struct-11 f 7 -1 } ]
|
||||
[ 3 4 fastcall-struct-return-ii-callback fastcall-struct-return-ii-indirect ] unit-test
|
||||
|
||||
[ S{ test-struct-11 f 7 -3 } ]
|
||||
[ 3 4 7 fastcall-struct-return-iii-callback fastcall-struct-return-iii-indirect ] unit-test
|
||||
|
|
|
|||
|
|
@ -7,12 +7,12 @@ TYPEDEF: alien.c-types:int type-1
|
|||
TYPEDEF: alien.c-types:int type-3
|
||||
|
||||
: callback ( -- ptr )
|
||||
type-3 { type-1 type-1 } "cdecl" [ + >integer ] alien-callback ;
|
||||
type-3 { type-1 type-1 } cdecl [ + >integer ] alien-callback ;
|
||||
|
||||
TYPEDEF: alien.c-types:float type-2
|
||||
|
||||
: indirect ( x y ptr -- z )
|
||||
type-3 { type-2 type-2 } "cdecl" alien-indirect ;
|
||||
type-3 { type-2 type-2 } cdecl alien-indirect ;
|
||||
|
||||
[ ] [
|
||||
"USING: alien.c-types alien.syntax ;
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ IN: compression.zlib.ffi
|
|||
{ [ os winnt? ] [ "zlib1.dll" ] }
|
||||
{ [ os macosx? ] [ "libz.dylib" ] }
|
||||
{ [ os unix? ] [ "libz.so" ] }
|
||||
} cond "cdecl" add-library >>
|
||||
} cond cdecl add-library >>
|
||||
|
||||
LIBRARY: zlib
|
||||
|
||||
|
|
|
|||
|
|
@ -120,7 +120,7 @@ PRIVATE>
|
|||
[ fds>> [ enable-all-callbacks ] each ] bi ;
|
||||
|
||||
: timer-callback ( -- callback )
|
||||
void { CFRunLoopTimerRef void* } "cdecl"
|
||||
void { CFRunLoopTimerRef void* } cdecl
|
||||
[ 2drop reset-run-loop yield ] alien-callback ;
|
||||
|
||||
: init-thread-timer ( -- )
|
||||
|
|
|
|||
|
|
@ -6,8 +6,7 @@ images images.memory core-graphics.types core-foundation.utilities
|
|||
opengl.gl literals ;
|
||||
IN: core-graphics
|
||||
|
||||
! CGImageAlphaInfo
|
||||
C-ENUM:
|
||||
C-ENUM: CGImageAlphaInfo
|
||||
kCGImageAlphaNone
|
||||
kCGImageAlphaPremultipliedLast
|
||||
kCGImageAlphaPremultipliedFirst
|
||||
|
|
|
|||
|
|
@ -486,15 +486,15 @@ HOOK: %loop-entry cpu ( -- )
|
|||
GENERIC: return-reg ( reg-class -- reg )
|
||||
|
||||
! Sequence of registers used for parameter passing in class
|
||||
GENERIC: param-regs ( reg-class -- regs )
|
||||
GENERIC# param-regs 1 ( reg-class abi -- regs )
|
||||
|
||||
M: stack-params param-regs drop f ;
|
||||
M: stack-params param-regs 2drop f ;
|
||||
|
||||
GENERIC: param-reg ( n reg-class -- reg )
|
||||
GENERIC# param-reg 1 ( n reg-class abi -- reg )
|
||||
|
||||
M: reg-class param-reg param-regs nth ;
|
||||
|
||||
M: stack-params param-reg drop ;
|
||||
M: stack-params param-reg 2drop ;
|
||||
|
||||
! Is this integer small enough to be an immediate operand for
|
||||
! %add-imm, %sub-imm, and %mul-imm?
|
||||
|
|
@ -504,6 +504,9 @@ HOOK: immediate-arithmetic? cpu ( n -- ? )
|
|||
! %and-imm, %or-imm, and %xor-imm?
|
||||
HOOK: immediate-bitwise? cpu ( n -- ? )
|
||||
|
||||
! What c-type describes the implicit struct return pointer for large structs?
|
||||
HOOK: struct-return-pointer-type cpu ( -- c-type )
|
||||
|
||||
! Is this structure small enough to be returned in registers?
|
||||
HOOK: return-struct-in-registers? cpu ( c-type -- ? )
|
||||
|
||||
|
|
@ -592,6 +595,6 @@ HOOK: %end-callback cpu ( -- )
|
|||
|
||||
HOOK: %end-callback-value cpu ( c-type -- )
|
||||
|
||||
HOOK: callback-return-rewind cpu ( params -- n )
|
||||
HOOK: stack-cleanup cpu ( params -- n )
|
||||
|
||||
M: object callback-return-rewind drop 0 ;
|
||||
M: object stack-cleanup drop 0 ;
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ M: linux reserved-area-size 2 cells ;
|
|||
|
||||
M: linux lr-save 1 cells ;
|
||||
|
||||
M: float-regs param-regs drop { 1 2 3 4 5 6 7 8 } ;
|
||||
M: float-regs param-regs 2drop { 1 2 3 4 5 6 7 8 } ;
|
||||
|
||||
M: ppc value-struct? drop f ;
|
||||
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ M: macosx reserved-area-size 6 cells ;
|
|||
|
||||
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: float-regs param-regs 2drop { 1 2 3 4 5 6 7 8 9 10 11 12 13 } ;
|
||||
|
||||
M: ppc value-struct? drop t ;
|
||||
|
||||
|
|
|
|||
|
|
@ -235,7 +235,7 @@ M: spill-slot float-function-param* [ 1 ] dip n>> spill@ LFD ;
|
|||
M: integer float-function-param* FMR ;
|
||||
|
||||
: float-function-param ( i src -- )
|
||||
[ float-regs param-regs nth ] dip float-function-param* ;
|
||||
[ float-regs cdecl param-regs nth ] dip float-function-param* ;
|
||||
|
||||
: float-function-return ( reg -- )
|
||||
float-regs return-reg double-rep %copy ;
|
||||
|
|
@ -584,7 +584,7 @@ M: ppc %reload ( dst rep src -- )
|
|||
M: ppc %loop-entry ;
|
||||
|
||||
M: int-regs return-reg drop 3 ;
|
||||
M: int-regs param-regs drop { 3 4 5 6 7 8 9 10 } ;
|
||||
M: int-regs param-regs 2drop { 3 4 5 6 7 8 9 10 } ;
|
||||
M: float-regs return-reg drop 1 ;
|
||||
|
||||
M:: ppc %save-param-reg ( stack reg rep -- )
|
||||
|
|
@ -644,7 +644,7 @@ M:: ppc %box ( n rep func -- )
|
|||
! If the source is a stack location, load it into freg #0.
|
||||
! If the source is f, then we assume the value is already in
|
||||
! freg #0.
|
||||
n [ 0 rep reg-class-of param-reg rep %load-param-reg ] when*
|
||||
n [ 0 rep reg-class-of cdecl param-reg rep %load-param-reg ] when*
|
||||
rep double-rep? 5 4 ? %load-vm-addr
|
||||
func f %alien-invoke ;
|
||||
|
||||
|
|
@ -701,6 +701,8 @@ M: ppc immediate-arithmetic? ( n -- ? ) -32768 32767 between? ;
|
|||
|
||||
M: ppc immediate-bitwise? ( n -- ? ) 0 65535 between? ;
|
||||
|
||||
M: ppc struct-return-pointer-type void* ;
|
||||
|
||||
M: ppc return-struct-in-registers? ( c-type -- ? )
|
||||
c-type return-in-registers?>> ;
|
||||
|
||||
|
|
|
|||
|
|
@ -2,6 +2,6 @@ IN: cpu.x86.32.tests
|
|||
USING: alien alien.c-types tools.test cpu.x86.assembler
|
||||
cpu.x86.assembler.operands ;
|
||||
|
||||
: assembly-test-1 ( -- x ) int { } "cdecl" [ EAX 3 MOV ] alien-assembly ;
|
||||
: assembly-test-1 ( -- x ) int { } cdecl [ EAX 3 MOV ] alien-assembly ;
|
||||
|
||||
[ 3 ] [ assembly-test-1 ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2005, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: locals alien.c-types alien.libraries alien.syntax arrays
|
||||
kernel fry math namespaces sequences system layouts io
|
||||
vocabs.loader accessors init combinators command-line make
|
||||
compiler compiler.units compiler.constants compiler.alien
|
||||
USING: locals alien alien.c-types alien.libraries alien.syntax
|
||||
arrays kernel fry math namespaces sequences system layouts io
|
||||
vocabs.loader accessors init classes.struct combinators command-line
|
||||
make compiler compiler.units compiler.constants compiler.alien
|
||||
compiler.codegen compiler.codegen.fixup
|
||||
compiler.cfg.instructions compiler.cfg.builder
|
||||
compiler.cfg.intrinsics compiler.cfg.stack-frame
|
||||
|
|
@ -67,9 +67,9 @@ M:: x86.32 %dispatch ( src temp -- )
|
|||
[ align-code ]
|
||||
bi ;
|
||||
|
||||
M: x86.32 pic-tail-reg EBX ;
|
||||
M: x86.32 pic-tail-reg EDX ;
|
||||
|
||||
M: x86.32 reserved-stack-space 4 cells ;
|
||||
M: x86.32 reserved-stack-space 0 ;
|
||||
|
||||
M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
|
||||
|
||||
|
|
@ -86,14 +86,24 @@ M: x86.32 return-struct-in-registers? ( c-type -- ? )
|
|||
: struct-return@ ( n -- operand )
|
||||
[ next-stack@ ] [ stack-frame get params>> local@ ] if* ;
|
||||
|
||||
! On x86, parameters are never passed in registers.
|
||||
! On x86, parameters are usually never passed in registers, except with Microsoft's
|
||||
! "thiscall" and "fastcall" abis
|
||||
M: int-regs return-reg drop EAX ;
|
||||
M: int-regs param-regs drop { } ;
|
||||
M: float-regs param-regs drop { } ;
|
||||
M: float-regs param-regs 2drop { } ;
|
||||
|
||||
M: int-regs param-regs
|
||||
nip {
|
||||
{ thiscall [ { ECX } ] }
|
||||
{ fastcall [ { ECX EDX } ] }
|
||||
[ drop { } ]
|
||||
} case ;
|
||||
|
||||
GENERIC: load-return-reg ( src rep -- )
|
||||
GENERIC: store-return-reg ( dst rep -- )
|
||||
|
||||
M: stack-params load-return-reg drop EAX swap MOV ;
|
||||
M: stack-params store-return-reg drop EAX MOV ;
|
||||
|
||||
M: int-rep load-return-reg drop EAX swap MOV ;
|
||||
M: int-rep store-return-reg drop EAX MOV ;
|
||||
|
||||
|
|
@ -111,19 +121,23 @@ M: x86.32 %prologue ( n -- )
|
|||
M: x86.32 %prepare-jump
|
||||
pic-tail-reg 0 MOV xt-tail-pic-offset rc-absolute-cell rel-here ;
|
||||
|
||||
M: x86.32 %load-param-reg
|
||||
stack-params assert=
|
||||
[ [ EAX ] dip local@ MOV ] dip
|
||||
stack@ EAX MOV ;
|
||||
M: stack-params copy-register*
|
||||
drop
|
||||
{
|
||||
{ [ dup integer? ] [ EAX swap next-stack@ MOV EAX MOV ] }
|
||||
{ [ over integer? ] [ EAX swap MOV param@ EAX MOV ] }
|
||||
} cond ;
|
||||
|
||||
M: x86.32 %save-param-reg 3drop ;
|
||||
M: x86.32 %save-param-reg [ local@ ] 2dip %copy ;
|
||||
|
||||
M: x86.32 %load-param-reg [ swap local@ ] dip %copy ;
|
||||
|
||||
: (%box) ( n rep -- )
|
||||
#! If n is f, push the return register onto the stack; we
|
||||
#! are boxing a return value of a C function. If n is an
|
||||
#! integer, push [ESP+n] on the stack; we are boxing a
|
||||
#! parameter being passed to a callback from C.
|
||||
over [ [ next-stack@ ] dip load-return-reg ] [ 2drop ] if ;
|
||||
over [ [ local@ ] dip load-return-reg ] [ 2drop ] if ;
|
||||
|
||||
M:: x86.32 %box ( n rep func -- )
|
||||
n rep (%box)
|
||||
|
|
@ -295,27 +309,36 @@ M:: x86.32 %binary-float-function ( dst src1 src2 func -- )
|
|||
func "libm" load-library %alien-invoke
|
||||
dst float-function-return ;
|
||||
|
||||
: stdcall? ( params -- ? )
|
||||
abi>> "stdcall" = ;
|
||||
|
||||
: funny-large-struct-return? ( params -- ? )
|
||||
#! MINGW ABI incompatibility disaster
|
||||
[ return>> large-struct? ]
|
||||
[ abi>> "mingw" = os windows? not or ]
|
||||
[ abi>> mingw = os windows? not or ]
|
||||
bi and ;
|
||||
|
||||
M: x86.32 %cleanup ( params -- )
|
||||
#! a) If we just called an stdcall function in Windows, it
|
||||
#! cleaned up the stack frame for us. But we don't want that
|
||||
#! so we 'undo' the cleanup since we do that in %epilogue.
|
||||
#! b) If we just called a function returning a struct, we
|
||||
#! have to fix ESP.
|
||||
: callee-cleanup? ( abi -- ? )
|
||||
{ stdcall fastcall thiscall } member? ;
|
||||
|
||||
: stack-arg-size ( params -- n )
|
||||
dup abi>> '[
|
||||
alien-parameters flatten-value-types
|
||||
[ _ alloc-parameter 2drop ] each
|
||||
stack-params get
|
||||
] with-param-regs ;
|
||||
|
||||
M: x86.32 stack-cleanup ( params -- n )
|
||||
#! a) Functions which are stdcall/fastcall/thiscall have to
|
||||
#! clean up the caller's stack frame.
|
||||
#! b) Functions returning large structs on MINGW have to
|
||||
#! fix ESP.
|
||||
{
|
||||
{ [ dup stdcall? ] [ drop ESP stack-frame get params>> SUB ] }
|
||||
{ [ dup funny-large-struct-return? ] [ drop EAX PUSH ] }
|
||||
[ drop ]
|
||||
{ [ dup abi>> callee-cleanup? ] [ stack-arg-size ] }
|
||||
{ [ dup funny-large-struct-return? ] [ drop 4 ] }
|
||||
[ drop 0 ]
|
||||
} cond ;
|
||||
|
||||
M: x86.32 %cleanup ( params -- )
|
||||
stack-cleanup [ ESP swap SUB ] unless-zero ;
|
||||
|
||||
M:: x86.32 %call-gc ( gc-root-count temp -- )
|
||||
temp gc-root-base special@ LEA
|
||||
8 save-vm-ptr
|
||||
|
|
@ -329,18 +352,13 @@ M: x86.32 dummy-int-params? f ;
|
|||
|
||||
M: x86.32 dummy-fp-params? f ;
|
||||
|
||||
M: x86.32 callback-return-rewind ( params -- n )
|
||||
#! a) If the callback is stdcall, we have to clean up the
|
||||
#! caller's stack frame.
|
||||
#! b) If the callback is returning a large struct, we have
|
||||
#! to fix ESP.
|
||||
{
|
||||
{ [ dup stdcall? ] [ <alien-stack-frame> [ params>> ] [ return>> ] bi + ] }
|
||||
{ [ dup funny-large-struct-return? ] [ drop 4 ] }
|
||||
[ drop 0 ]
|
||||
} cond ;
|
||||
|
||||
! Dreadful
|
||||
M: object flatten-value-type (flatten-int-type) ;
|
||||
M: object flatten-value-type (flatten-stack-type) ;
|
||||
M: struct-c-type flatten-value-type (flatten-stack-type) ;
|
||||
M: long-long-type flatten-value-type (flatten-stack-type) ;
|
||||
M: c-type flatten-value-type
|
||||
dup rep>> int-rep? [ (flatten-int-type) ] [ (flatten-stack-type) ] if ;
|
||||
|
||||
M: x86.32 struct-return-pointer-type (stack-value) ;
|
||||
|
||||
check-sse
|
||||
|
|
|
|||
|
|
@ -13,15 +13,16 @@ IN: bootstrap.x86
|
|||
: div-arg ( -- reg ) EAX ;
|
||||
: mod-arg ( -- reg ) EDX ;
|
||||
: temp0 ( -- reg ) EAX ;
|
||||
: temp1 ( -- reg ) EDX ;
|
||||
: temp2 ( -- reg ) ECX ;
|
||||
: temp3 ( -- reg ) EBX ;
|
||||
: temp1 ( -- reg ) ECX ;
|
||||
: temp2 ( -- reg ) EBX ;
|
||||
: temp3 ( -- reg ) EDX ;
|
||||
: pic-tail-reg ( -- reg ) EDX ;
|
||||
: stack-reg ( -- reg ) ESP ;
|
||||
: frame-reg ( -- reg ) EBP ;
|
||||
: vm-reg ( -- reg ) ECX ;
|
||||
: vm-reg ( -- reg ) EBX ;
|
||||
: ctx-reg ( -- reg ) EBP ;
|
||||
: nv-regs ( -- seq ) { ESI EDI EBX } ;
|
||||
: nv-reg ( -- reg ) EBX ;
|
||||
: nv-reg ( -- reg ) ESI ;
|
||||
: ds-reg ( -- reg ) ESI ;
|
||||
: rs-reg ( -- reg ) EDI ;
|
||||
: fixnum>slot@ ( -- ) temp0 2 SAR ;
|
||||
|
|
@ -40,7 +41,7 @@ IN: bootstrap.x86
|
|||
] jit-prolog jit-define
|
||||
|
||||
[
|
||||
temp3 0 MOV rc-absolute-cell rt-here jit-rel
|
||||
pic-tail-reg 0 MOV rc-absolute-cell rt-here jit-rel
|
||||
0 JMP rc-relative rt-entry-point-pic-tail jit-rel
|
||||
] jit-word-jump jit-define
|
||||
|
||||
|
|
@ -53,8 +54,8 @@ IN: bootstrap.x86
|
|||
|
||||
: jit-save-context ( -- )
|
||||
jit-load-context
|
||||
EDX ESP -4 [+] LEA
|
||||
ctx-reg context-callstack-top-offset [+] EDX MOV
|
||||
ECX ESP -4 [+] LEA
|
||||
ctx-reg context-callstack-top-offset [+] ECX MOV
|
||||
ctx-reg context-datastack-offset [+] ds-reg MOV
|
||||
ctx-reg context-retainstack-offset [+] rs-reg MOV ;
|
||||
|
||||
|
|
@ -135,25 +136,25 @@ IN: bootstrap.x86
|
|||
|
||||
[
|
||||
! Load callstack object
|
||||
EBX ds-reg [] MOV
|
||||
temp3 ds-reg [] MOV
|
||||
ds-reg bootstrap-cell SUB
|
||||
! Get ctx->callstack_bottom
|
||||
jit-load-vm
|
||||
jit-load-context
|
||||
EAX ctx-reg context-callstack-bottom-offset [+] MOV
|
||||
temp0 ctx-reg context-callstack-bottom-offset [+] MOV
|
||||
! Get top of callstack object -- 'src' for memcpy
|
||||
EBP EBX callstack-top-offset [+] LEA
|
||||
temp1 temp3 callstack-top-offset [+] LEA
|
||||
! Get callstack length, in bytes --- 'len' for memcpy
|
||||
EDX EBX callstack-length-offset [+] MOV
|
||||
EDX tag-bits get SHR
|
||||
temp2 temp3 callstack-length-offset [+] MOV
|
||||
temp2 tag-bits get SHR
|
||||
! Compute new stack pointer -- 'dst' for memcpy
|
||||
EAX EDX SUB
|
||||
temp0 temp2 SUB
|
||||
! Install new stack pointer
|
||||
ESP EAX MOV
|
||||
ESP temp0 MOV
|
||||
! Call memcpy
|
||||
EDX PUSH
|
||||
EBP PUSH
|
||||
EAX PUSH
|
||||
temp2 PUSH
|
||||
temp1 PUSH
|
||||
temp0 PUSH
|
||||
"factor_memcpy" jit-call
|
||||
ESP 12 ADD
|
||||
! Return with new callstack
|
||||
|
|
@ -177,7 +178,7 @@ IN: bootstrap.x86
|
|||
|
||||
! Inline cache miss entry points
|
||||
: jit-load-return-address ( -- )
|
||||
EBX ESP stack-frame-size bootstrap-cell - [+] MOV ;
|
||||
pic-tail-reg ESP stack-frame-size bootstrap-cell - [+] MOV ;
|
||||
|
||||
! These are always in tail position with an existing stack
|
||||
! frame, and the stack. The frame setup takes this into account.
|
||||
|
|
@ -185,7 +186,7 @@ IN: bootstrap.x86
|
|||
jit-load-vm
|
||||
jit-save-context
|
||||
ESP 4 [+] vm-reg MOV
|
||||
ESP [] EBX MOV
|
||||
ESP [] pic-tail-reg MOV
|
||||
"inline_cache_miss" jit-call
|
||||
jit-restore-context ;
|
||||
|
||||
|
|
@ -213,6 +214,7 @@ IN: bootstrap.x86
|
|||
[
|
||||
ESP [] EAX MOV
|
||||
ESP 4 [+] EDX MOV
|
||||
jit-load-vm
|
||||
ESP 8 [+] vm-reg MOV
|
||||
jit-call
|
||||
]
|
||||
|
|
@ -237,6 +239,7 @@ IN: bootstrap.x86
|
|||
EBX tag-bits get SAR
|
||||
ESP [] EBX MOV
|
||||
ESP 4 [+] EBP MOV
|
||||
jit-load-vm
|
||||
ESP 8 [+] vm-reg MOV
|
||||
"overflow_fixnum_multiply" jit-call
|
||||
]
|
||||
|
|
@ -266,7 +269,7 @@ IN: bootstrap.x86
|
|||
! Load context and parameter from datastack
|
||||
EAX ds-reg [] MOV
|
||||
EAX EAX alien-offset [+] MOV
|
||||
EBX ds-reg -4 [+] MOV
|
||||
EDX ds-reg -4 [+] MOV
|
||||
ds-reg 8 SUB
|
||||
|
||||
! Make the new context active
|
||||
|
|
@ -280,7 +283,7 @@ IN: bootstrap.x86
|
|||
|
||||
! Store parameter to datastack
|
||||
ds-reg 4 ADD
|
||||
ds-reg [] EBX MOV ;
|
||||
ds-reg [] EDX MOV ;
|
||||
|
||||
[ jit-set-context ] \ (set-context) define-sub-primitive
|
||||
|
||||
|
|
@ -291,14 +294,14 @@ IN: bootstrap.x86
|
|||
"new_context" jit-call
|
||||
|
||||
! Save pointer to quotation and parameter
|
||||
EBX ds-reg MOV
|
||||
EDX ds-reg MOV
|
||||
ds-reg 8 SUB
|
||||
|
||||
! Make the new context active
|
||||
EAX jit-switch-context
|
||||
|
||||
! Push parameter
|
||||
EAX EBX -4 [+] MOV
|
||||
EAX EDX -4 [+] MOV
|
||||
ds-reg 4 ADD
|
||||
ds-reg [] EAX MOV
|
||||
|
||||
|
|
@ -309,7 +312,7 @@ IN: bootstrap.x86
|
|||
0 PUSH
|
||||
|
||||
! Jump to initial quotation
|
||||
EAX EBX [] MOV
|
||||
EAX EDX [] MOV
|
||||
jit-jump-quot ;
|
||||
|
||||
[ jit-start-context ] \ (start-context) define-sub-primitive
|
||||
|
|
|
|||
|
|
@ -2,12 +2,12 @@ USING: alien alien.c-types cpu.architecture cpu.x86.64
|
|||
cpu.x86.assembler cpu.x86.assembler.operands tools.test ;
|
||||
IN: cpu.x86.64.tests
|
||||
|
||||
: assembly-test-1 ( -- x ) int { } "cdecl" [ RAX 3 MOV ] alien-assembly ;
|
||||
: assembly-test-1 ( -- x ) int { } cdecl [ RAX 3 MOV ] alien-assembly ;
|
||||
|
||||
[ 3 ] [ assembly-test-1 ] unit-test
|
||||
|
||||
: assembly-test-2 ( a b -- x )
|
||||
int { int int } "cdecl" [
|
||||
int { int int } cdecl [
|
||||
param-reg-0 param-reg-1 ADD
|
||||
int-regs return-reg param-reg-0 MOV
|
||||
] alien-assembly ;
|
||||
|
|
|
|||
|
|
@ -11,10 +11,10 @@ cpu.architecture vm ;
|
|||
FROM: layouts => cell cells ;
|
||||
IN: cpu.x86.64
|
||||
|
||||
: param-reg-0 ( -- reg ) 0 int-regs param-reg ; inline
|
||||
: param-reg-1 ( -- reg ) 1 int-regs param-reg ; inline
|
||||
: param-reg-2 ( -- reg ) 2 int-regs param-reg ; inline
|
||||
: param-reg-3 ( -- reg ) 3 int-regs param-reg ; inline
|
||||
: param-reg-0 ( -- reg ) 0 int-regs cdecl param-reg ; inline
|
||||
: param-reg-1 ( -- reg ) 1 int-regs cdecl param-reg ; inline
|
||||
: param-reg-2 ( -- reg ) 2 int-regs cdecl param-reg ; inline
|
||||
: param-reg-3 ( -- reg ) 3 int-regs cdecl param-reg ; inline
|
||||
|
||||
M: x86.64 pic-tail-reg RBX ;
|
||||
|
||||
|
|
@ -52,8 +52,6 @@ M: x86.64 %set-vm-field ( src offset -- )
|
|||
M: x86.64 %vm-field-ptr ( dst offset -- )
|
||||
[ vm-reg ] dip [+] LEA ;
|
||||
|
||||
: param@ ( n -- op ) reserved-stack-space + stack@ ;
|
||||
|
||||
M: x86.64 %prologue ( n -- )
|
||||
temp-reg -7 [RIP+] LEA
|
||||
dup PUSH
|
||||
|
|
@ -157,7 +155,7 @@ M:: x86.64 %unbox-large-struct ( n c-type -- )
|
|||
"to_value_struct" f %alien-invoke ;
|
||||
|
||||
: load-return-value ( rep -- )
|
||||
[ [ 0 ] dip reg-class-of param-reg ]
|
||||
[ [ 0 ] dip reg-class-of cdecl param-reg ]
|
||||
[ reg-class-of return-reg ]
|
||||
[ ]
|
||||
tri %copy ;
|
||||
|
|
@ -165,7 +163,7 @@ M:: x86.64 %unbox-large-struct ( n c-type -- )
|
|||
M:: x86.64 %box ( n rep func -- )
|
||||
n [
|
||||
n
|
||||
0 rep reg-class-of param-reg
|
||||
0 rep reg-class-of cdecl param-reg
|
||||
rep %load-param-reg
|
||||
] [
|
||||
rep load-return-value
|
||||
|
|
@ -253,7 +251,7 @@ M: x86.64 %end-callback-value ( ctype -- )
|
|||
unbox-return ;
|
||||
|
||||
: float-function-param ( i src -- )
|
||||
[ float-regs param-regs nth ] dip double-rep %copy ;
|
||||
[ float-regs cdecl param-regs nth ] dip double-rep %copy ;
|
||||
|
||||
: float-function-return ( reg -- )
|
||||
float-regs return-reg double-rep %copy ;
|
||||
|
|
@ -281,6 +279,8 @@ M:: x86.64 %call-gc ( gc-root-count temp -- )
|
|||
! Call GC
|
||||
"inline_gc" f %alien-invoke ;
|
||||
|
||||
M: x86.64 struct-return-pointer-type void* ;
|
||||
|
||||
! The result of reading 4 bytes from memory is a fixnum on
|
||||
! x86-64.
|
||||
enable-alien-4-intrinsics
|
||||
|
|
|
|||
|
|
@ -11,10 +11,11 @@ IN: bootstrap.x86
|
|||
: shift-arg ( -- reg ) RCX ;
|
||||
: div-arg ( -- reg ) RAX ;
|
||||
: mod-arg ( -- reg ) RDX ;
|
||||
: temp0 ( -- reg ) RDI ;
|
||||
: temp1 ( -- reg ) RSI ;
|
||||
: temp0 ( -- reg ) RAX ;
|
||||
: temp1 ( -- reg ) RCX ;
|
||||
: temp2 ( -- reg ) RDX ;
|
||||
: temp3 ( -- reg ) RBX ;
|
||||
: pic-tail-reg ( -- reg ) RBX ;
|
||||
: return-reg ( -- reg ) RAX ;
|
||||
: nv-reg ( -- reg ) RBX ;
|
||||
: stack-reg ( -- reg ) RSP ;
|
||||
|
|
@ -42,7 +43,7 @@ IN: bootstrap.x86
|
|||
] jit-prolog jit-define
|
||||
|
||||
[
|
||||
temp3 5 [RIP+] LEA
|
||||
pic-tail-reg 5 [RIP+] LEA
|
||||
0 JMP rc-relative rt-entry-point-pic-tail jit-rel
|
||||
] jit-word-jump jit-define
|
||||
|
||||
|
|
|
|||
|
|
@ -7,18 +7,13 @@ compiler.cfg.registers ;
|
|||
IN: cpu.x86.64.unix
|
||||
|
||||
M: int-regs param-regs
|
||||
drop { RDI RSI RDX RCX R8 R9 } ;
|
||||
2drop { RDI RSI RDX RCX R8 R9 } ;
|
||||
|
||||
M: float-regs param-regs
|
||||
drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
|
||||
2drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
|
||||
|
||||
M: x86.64 reserved-stack-space 0 ;
|
||||
|
||||
SYMBOL: (stack-value)
|
||||
! The ABI for passing structs by value is pretty great
|
||||
<< void* c-type clone \ (stack-value) define-primitive-type
|
||||
stack-params \ (stack-value) c-type (>>rep) >>
|
||||
|
||||
: struct-types&offset ( struct-type -- pairs )
|
||||
fields>> [
|
||||
[ type>> ] [ offset>> ] bi 2array
|
||||
|
|
@ -36,8 +31,7 @@ stack-params \ (stack-value) c-type (>>rep) >>
|
|||
] map ;
|
||||
|
||||
: flatten-large-struct ( c-type -- seq )
|
||||
heap-size cell align
|
||||
cell /i \ (stack-value) c-type <repetition> ;
|
||||
(flatten-stack-type) ;
|
||||
|
||||
: flatten-struct ( c-type -- seq )
|
||||
dup heap-size 16 > [
|
||||
|
|
|
|||
|
|
@ -5,9 +5,9 @@ compiler.cfg.registers cpu.architecture cpu.x86.assembler cpu.x86
|
|||
cpu.x86.assembler.operands ;
|
||||
IN: cpu.x86.64.winnt
|
||||
|
||||
M: int-regs param-regs drop { RCX RDX R8 R9 } ;
|
||||
M: int-regs param-regs 2drop { RCX RDX R8 R9 } ;
|
||||
|
||||
M: float-regs param-regs drop { XMM0 XMM1 XMM2 XMM3 } ;
|
||||
M: float-regs param-regs 2drop { XMM0 XMM1 XMM2 XMM3 } ;
|
||||
|
||||
M: x86.64 reserved-stack-space 4 cells ;
|
||||
|
||||
|
|
|
|||
|
|
@ -12,8 +12,9 @@ big-endian off
|
|||
[
|
||||
! Optimizing compiler's side of callback accesses
|
||||
! arguments that are on the stack via the frame pointer.
|
||||
! On x86-64, some arguments are passed in registers, and
|
||||
! so the only register that is safe for use here is nv-reg.
|
||||
! On x86-32 fastcall, and x86-64, some arguments are passed
|
||||
! in registers, and so the only registers that are safe for
|
||||
! use here are frame-reg, nv-reg and vm-reg.
|
||||
frame-reg PUSH
|
||||
frame-reg stack-reg MOV
|
||||
|
||||
|
|
@ -65,23 +66,24 @@ big-endian off
|
|||
|
||||
frame-reg POP
|
||||
|
||||
! Callbacks which return structs, or use stdcall, need a
|
||||
! parameter here. See the comment in callback-return-rewind
|
||||
! in cpu.x86.32
|
||||
! Callbacks which return structs, or use stdcall/fastcall/thiscall,
|
||||
! need a parameter here.
|
||||
|
||||
! See the comment for M\ x86.32 stack-cleanup in cpu.x86.32
|
||||
HEX: ffff RET rc-absolute-2 rt-untagged jit-rel
|
||||
] callback-stub jit-define
|
||||
|
||||
[
|
||||
! Load word
|
||||
nv-reg 0 MOV rc-absolute-cell rt-literal jit-rel
|
||||
temp0 0 MOV rc-absolute-cell rt-literal jit-rel
|
||||
! Bump profiling counter
|
||||
nv-reg profile-count-offset [+] 1 tag-fixnum ADD
|
||||
temp0 profile-count-offset [+] 1 tag-fixnum ADD
|
||||
! Load word->code
|
||||
nv-reg nv-reg word-code-offset [+] MOV
|
||||
temp0 temp0 word-code-offset [+] MOV
|
||||
! Compute word entry point
|
||||
nv-reg compiled-header-size ADD
|
||||
temp0 compiled-header-size ADD
|
||||
! Jump to entry point
|
||||
nv-reg JMP
|
||||
temp0 JMP
|
||||
] jit-profiling jit-define
|
||||
|
||||
[
|
||||
|
|
@ -200,7 +202,7 @@ big-endian off
|
|||
|
||||
! ! ! Polymorphic inline caches
|
||||
|
||||
! The PIC stubs are not permitted to touch temp3.
|
||||
! The PIC stubs are not permitted to touch pic-tail-reg.
|
||||
|
||||
! Load a value from a stack position
|
||||
[
|
||||
|
|
@ -477,23 +479,23 @@ big-endian off
|
|||
! load value
|
||||
temp3 ds-reg [] MOV
|
||||
! make a copy
|
||||
temp1 temp3 MOV
|
||||
! compute positive shift value in temp1
|
||||
temp1 CL SHL
|
||||
temp2 temp3 MOV
|
||||
! compute positive shift value in temp2
|
||||
temp2 CL SHL
|
||||
shift-arg NEG
|
||||
! compute negative shift value in temp3
|
||||
temp3 CL SAR
|
||||
temp3 tag-mask get bitnot AND
|
||||
shift-arg 0 CMP
|
||||
! if shift count was negative, move temp0 to temp1
|
||||
temp1 temp3 CMOVGE
|
||||
! if shift count was negative, move temp0 to temp2
|
||||
temp2 temp3 CMOVGE
|
||||
! push to stack
|
||||
ds-reg [] temp1 MOV
|
||||
ds-reg [] temp2 MOV
|
||||
] \ fixnum-shift-fast define-sub-primitive
|
||||
|
||||
: jit-fixnum-/mod ( -- )
|
||||
! load second parameter
|
||||
temp3 ds-reg [] MOV
|
||||
temp1 ds-reg [] MOV
|
||||
! load first parameter
|
||||
div-arg ds-reg bootstrap-cell neg [+] MOV
|
||||
! make a copy
|
||||
|
|
@ -501,7 +503,7 @@ big-endian off
|
|||
! sign-extend
|
||||
mod-arg bootstrap-cell-bits 1 - SAR
|
||||
! divide
|
||||
temp3 IDIV ;
|
||||
temp1 IDIV ;
|
||||
|
||||
[
|
||||
jit-fixnum-/mod
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ IN: cpu.x86.features
|
|||
<PRIVATE
|
||||
|
||||
: (sse-version) ( -- n )
|
||||
int { } "cdecl" [
|
||||
int { } cdecl [
|
||||
"sse-42" define-label
|
||||
"sse-41" define-label
|
||||
"ssse-3" define-label
|
||||
|
|
@ -97,12 +97,12 @@ MEMO: sse-version ( -- n )
|
|||
HOOK: instruction-count cpu ( -- n )
|
||||
|
||||
M: x86.32 instruction-count
|
||||
longlong { } "cdecl" [
|
||||
longlong { } cdecl [
|
||||
RDTSC
|
||||
] alien-assembly ;
|
||||
|
||||
M: x86.64 instruction-count
|
||||
longlong { } "cdecl" [
|
||||
longlong { } cdecl [
|
||||
RAX 0 MOV
|
||||
RDTSC
|
||||
RDX 32 SHL
|
||||
|
|
|
|||
|
|
@ -41,6 +41,8 @@ HOOK: extra-stack-space cpu ( stack-frame -- n )
|
|||
|
||||
: gc-root@ ( n -- op ) gc-root-offset special@ ;
|
||||
|
||||
: param@ ( n -- op ) reserved-stack-space + stack@ ;
|
||||
|
||||
: decr-stack-reg ( n -- )
|
||||
dup 0 = [ drop ] [ stack-reg swap SUB ] if ;
|
||||
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ IN: db.postgresql.ffi
|
|||
{ [ os winnt? ] [ "libpq.dll" ] }
|
||||
{ [ os macosx? ] [ "libpq.dylib" ] }
|
||||
{ [ os unix? ] [ "libpq.so" ] }
|
||||
} cond "cdecl" add-library >>
|
||||
} cond cdecl add-library >>
|
||||
|
||||
! ConnSatusType
|
||||
CONSTANT: CONNECTION_OK HEX: 0
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ IN: db.sqlite.ffi
|
|||
{ [ os winnt? ] [ "sqlite3.dll" ] }
|
||||
{ [ os macosx? ] [ "/usr/lib/libsqlite3.dylib" ] }
|
||||
{ [ os unix? ] [ "libsqlite3.so" ] }
|
||||
} cond "cdecl" add-library >>
|
||||
} cond cdecl add-library >>
|
||||
|
||||
! Return values from sqlite functions
|
||||
CONSTANT: SQLITE_OK 0 ! Successful result
|
||||
|
|
|
|||
|
|
@ -8,14 +8,14 @@ IN: glib
|
|||
<<
|
||||
|
||||
{
|
||||
{ [ os winnt? ] [ "glib" "libglib-2.0-0.dll" "cdecl" add-library ] }
|
||||
{ [ os macosx? ] [ "glib" "/opt/local/lib/libglib-2.0.0.dylib" "cdecl" add-library ] }
|
||||
{ [ os winnt? ] [ "glib" "libglib-2.0-0.dll" cdecl add-library ] }
|
||||
{ [ os macosx? ] [ "glib" "/opt/local/lib/libglib-2.0.0.dylib" cdecl add-library ] }
|
||||
{ [ os unix? ] [ ] }
|
||||
} cond
|
||||
|
||||
{
|
||||
{ [ os winnt? ] [ "gobject" "libgobject-2.0-0.dll" "cdecl" add-library ] }
|
||||
{ [ os macosx? ] [ "gobject" "/opt/local/lib/libgobject-2.0.0.dylib" "cdecl" add-library ] }
|
||||
{ [ os winnt? ] [ "gobject" "libgobject-2.0-0.dll" cdecl add-library ] }
|
||||
{ [ os macosx? ] [ "gobject" "/opt/local/lib/libgobject-2.0.0.dylib" cdecl add-library ] }
|
||||
{ [ os unix? ] [ ] }
|
||||
} cond
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Erik Charlebois
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
! Copyright (C) 2010 Erik Charlebois.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: images.testing ;
|
||||
IN: images.pgm.tests
|
||||
|
||||
"vocab:images/testing/pgm/radial.binary.pgm" decode-test
|
||||
"vocab:images/testing/pgm/radial.ascii.pgm" decode-test
|
||||
|
|
@ -0,0 +1,62 @@
|
|||
! Copyright (C) 2010 Erik Charlebois.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien.c-types ascii combinators images images.loader
|
||||
io io.encodings.ascii io.encodings.string kernel locals make math
|
||||
math.parser sequences specialized-arrays ;
|
||||
SPECIALIZED-ARRAY: ushort
|
||||
IN: images.pgm
|
||||
|
||||
SINGLETON: pgm-image
|
||||
"pgm" pgm-image register-image-class
|
||||
|
||||
: read-token ( -- token )
|
||||
[ read1 dup blank?
|
||||
[ t ]
|
||||
[ dup CHAR: # =
|
||||
[ "\n" read-until 2drop t ]
|
||||
[ f ] if
|
||||
] if
|
||||
] [ drop ] while
|
||||
" \n\r\t" read-until drop swap
|
||||
prefix ascii decode ;
|
||||
|
||||
: read-number ( -- number )
|
||||
read-token string>number ;
|
||||
|
||||
:: read-numbers ( n lim -- )
|
||||
n lim = [
|
||||
read-number ,
|
||||
n 1 + lim read-numbers
|
||||
] unless ;
|
||||
|
||||
:: read-pgm ( -- image )
|
||||
read-token :> type
|
||||
read-number :> width
|
||||
read-number :> height
|
||||
read-number :> max
|
||||
width height * :> npixels
|
||||
max 256 >= :> wide
|
||||
|
||||
type {
|
||||
{ "P2" [ [ 0 npixels read-numbers ] wide [ ushort-array{ } ] [ B{ } ] if make ] }
|
||||
{ "P5" [ wide [ 2 ] [ 1 ] if npixels * read ] }
|
||||
} case :> data
|
||||
|
||||
image new
|
||||
L >>component-order
|
||||
{ width height } >>dim
|
||||
f >>upside-down?
|
||||
data >>bitmap
|
||||
wide [ ushort-components ] [ ubyte-components ] if >>component-type ;
|
||||
|
||||
M: pgm-image stream>image
|
||||
drop [ read-pgm ] with-input-stream ;
|
||||
|
||||
M: pgm-image image>stream
|
||||
drop {
|
||||
[ drop "P5\n" ascii encode write ]
|
||||
[ dim>> first number>string " " append ascii encode write ]
|
||||
[ dim>> second number>string "\n" append ascii encode write ]
|
||||
[ component-type>> ubyte-components = [ "255\n" ] [ "65535\n" ] if ascii encode write ]
|
||||
[ bitmap>> write ]
|
||||
} cleave ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Image loading for PGM image files.
|
||||
|
|
@ -0,0 +1 @@
|
|||
Erik Charlebois
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
! Copyright (C) 2010 Erik Charlebois.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: images.testing ;
|
||||
IN: images.ppm.tests
|
||||
|
||||
"vocab:images/testing/ppm/binary.ppm" decode-test
|
||||
"vocab:images/testing/ppm/ascii.ppm" decode-test
|
||||
|
|
@ -0,0 +1,59 @@
|
|||
! Copyright (C) 2010 Erik Charlebois.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors ascii combinators images images.loader io
|
||||
io.encodings.ascii io.encodings.string kernel locals make math
|
||||
math.parser prettyprint sequences ;
|
||||
IN: images.ppm
|
||||
|
||||
SINGLETON: ppm-image
|
||||
"ppm" ppm-image register-image-class
|
||||
|
||||
: read-token ( -- token )
|
||||
[ read1 dup blank?
|
||||
[ t ]
|
||||
[ dup CHAR: # =
|
||||
[ "\n" read-until 2drop t ]
|
||||
[ f ] if
|
||||
] if
|
||||
] [ drop ] while
|
||||
" \n\r\t" read-until drop swap
|
||||
prefix ascii decode ;
|
||||
|
||||
: read-number ( -- number )
|
||||
read-token string>number ;
|
||||
|
||||
:: read-numbers ( n lim -- )
|
||||
n lim = [
|
||||
read-number ,
|
||||
n 1 + lim read-numbers
|
||||
] unless ;
|
||||
|
||||
:: read-ppm ( -- image )
|
||||
read-token :> type
|
||||
read-number :> width
|
||||
read-number :> height
|
||||
read-number :> max
|
||||
width height 3 * * :> npixels
|
||||
type {
|
||||
{ "P3" [ [ 0 npixels read-numbers ] B{ } make ] }
|
||||
{ "P6" [ npixels read ] }
|
||||
} case :> data
|
||||
|
||||
image new
|
||||
RGB >>component-order
|
||||
{ width height } >>dim
|
||||
f >>upside-down?
|
||||
data >>bitmap
|
||||
ubyte-components >>component-type ;
|
||||
|
||||
M: ppm-image stream>image
|
||||
drop [ read-ppm ] with-input-stream ;
|
||||
|
||||
M: ppm-image image>stream
|
||||
drop {
|
||||
[ drop "P6\n" ascii encode write ]
|
||||
[ dim>> first number>string " " append ascii encode write ]
|
||||
[ dim>> second number>string "\n" append ascii encode write ]
|
||||
[ drop "255\n" ascii encode write ]
|
||||
[ bitmap>> write ]
|
||||
} cleave ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Image loading for PPM image files.
|
||||
|
|
@ -11,7 +11,7 @@ TUPLE: run-loop-mx kqueue-mx ;
|
|||
|
||||
: file-descriptor-callback ( -- callback )
|
||||
void { CFFileDescriptorRef CFOptionFlags void* }
|
||||
"cdecl" [
|
||||
cdecl [
|
||||
3drop
|
||||
0 mx get kqueue-mx>> wait-for-events
|
||||
reset-run-loop
|
||||
|
|
|
|||
|
|
@ -1,9 +1,10 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! Copyright (C) 2008, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors sequences assocs arrays continuations
|
||||
destructors combinators kernel threads concurrency.messaging
|
||||
concurrency.mailboxes concurrency.promises io.files io.files.info
|
||||
io.directories io.pathnames io.monitors debugger fry ;
|
||||
io.directories io.pathnames io.monitors io.monitors.private
|
||||
debugger fry ;
|
||||
IN: io.monitors.recursive
|
||||
|
||||
! Simulate recursive monitors on platforms that don't have them
|
||||
|
|
@ -71,12 +72,14 @@ M: recursive-monitor dispose*
|
|||
] with with each ;
|
||||
|
||||
: pump-loop ( -- )
|
||||
receive dup +stop+ eq? [
|
||||
drop stop-pump
|
||||
] [
|
||||
receive {
|
||||
{ [ dup +stop+ eq? ] [ drop stop-pump ] }
|
||||
{ [ dup monitor-disposed eq? ] [ drop ] }
|
||||
[
|
||||
[ '[ _ update-hierarchy ] ignore-errors ] [ pump-step ] bi
|
||||
pump-loop
|
||||
] if ;
|
||||
]
|
||||
} cond ;
|
||||
|
||||
: monitor-ready ( error/t -- )
|
||||
monitor tget ready>> fulfill ;
|
||||
|
|
|
|||
|
|
@ -31,7 +31,7 @@ TUPLE: openssl-context < secure-context aliens sessions ;
|
|||
] [ drop ] if ;
|
||||
|
||||
: password-callback ( -- alien )
|
||||
int { void* int bool void* } "cdecl"
|
||||
int { void* int bool void* } cdecl
|
||||
[| buf size rwflag password! |
|
||||
password [ B{ 0 } password! ] unless
|
||||
|
||||
|
|
|
|||
|
|
@ -57,7 +57,7 @@ TUPLE: ConnectEx-args port
|
|||
} cleave
|
||||
int
|
||||
{ SOCKET void* int PVOID DWORD LPDWORD void* }
|
||||
"stdcall" alien-indirect drop
|
||||
stdcall alien-indirect drop
|
||||
winsock-error-string [ throw ] when* ; inline
|
||||
|
||||
M: object establish-connection ( client-out remote -- )
|
||||
|
|
|
|||
|
|
@ -3,26 +3,26 @@ cpu.x86.assembler.operands math.floats.env.x86 system ;
|
|||
IN: math.floats.env.x86.32
|
||||
|
||||
M: x86.32 get-sse-env
|
||||
void { void* } "cdecl" [
|
||||
void { void* } cdecl [
|
||||
EAX ESP [] MOV
|
||||
EAX [] STMXCSR
|
||||
] alien-assembly ;
|
||||
|
||||
M: x86.32 set-sse-env
|
||||
void { void* } "cdecl" [
|
||||
void { void* } cdecl [
|
||||
EAX ESP [] MOV
|
||||
EAX [] LDMXCSR
|
||||
] alien-assembly ;
|
||||
|
||||
M: x86.32 get-x87-env
|
||||
void { void* } "cdecl" [
|
||||
void { void* } cdecl [
|
||||
EAX ESP [] MOV
|
||||
EAX [] FNSTSW
|
||||
EAX 2 [+] FNSTCW
|
||||
] alien-assembly ;
|
||||
|
||||
M: x86.32 set-x87-env
|
||||
void { void* } "cdecl" [
|
||||
void { void* } cdecl [
|
||||
EAX ESP [] MOV
|
||||
FNCLEX
|
||||
EAX 2 [+] FLDCW
|
||||
|
|
|
|||
|
|
@ -3,23 +3,23 @@ cpu.x86.assembler.operands math.floats.env.x86 sequences system ;
|
|||
IN: math.floats.env.x86.64
|
||||
|
||||
M: x86.64 get-sse-env
|
||||
void { void* } "cdecl" [
|
||||
int-regs param-regs first [] STMXCSR
|
||||
void { void* } cdecl [
|
||||
int-regs cdecl param-regs first [] STMXCSR
|
||||
] alien-assembly ;
|
||||
|
||||
M: x86.64 set-sse-env
|
||||
void { void* } "cdecl" [
|
||||
int-regs param-regs first [] LDMXCSR
|
||||
void { void* } cdecl [
|
||||
int-regs cdecl param-regs first [] LDMXCSR
|
||||
] alien-assembly ;
|
||||
|
||||
M: x86.64 get-x87-env
|
||||
void { void* } "cdecl" [
|
||||
int-regs param-regs first [] FNSTSW
|
||||
int-regs param-regs first 2 [+] FNSTCW
|
||||
void { void* } cdecl [
|
||||
int-regs cdecl param-regs first [] FNSTSW
|
||||
int-regs cdecl param-regs first 2 [+] FNSTCW
|
||||
] alien-assembly ;
|
||||
|
||||
M: x86.64 set-x87-env
|
||||
void { void* } "cdecl" [
|
||||
void { void* } cdecl [
|
||||
FNCLEX
|
||||
int-regs param-regs first 2 [+] FLDCW
|
||||
int-regs cdecl param-regs first 2 [+] FLDCW
|
||||
] alien-assembly ;
|
||||
|
|
|
|||
|
|
@ -3,4 +3,4 @@ IN: opengl.gl.macosx
|
|||
|
||||
: gl-function-context ( -- context ) 0 ; inline
|
||||
: gl-function-address ( name -- address ) f dlsym ; inline
|
||||
: gl-function-calling-convention ( -- str ) "cdecl" ; inline
|
||||
: gl-function-calling-convention ( -- str ) cdecl ; inline
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
USING: kernel x11.glx ;
|
||||
USING: alien kernel x11.glx ;
|
||||
IN: opengl.gl.unix
|
||||
|
||||
: gl-function-context ( -- context ) glXGetCurrentContext ; inline
|
||||
: gl-function-address ( name -- address ) glXGetProcAddressARB ; inline
|
||||
: gl-function-calling-convention ( -- str ) "cdecl" ; inline
|
||||
: gl-function-calling-convention ( -- str ) cdecl ; inline
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
USING: alien.c-types alien.syntax kernel windows.types ;
|
||||
USING: alien alien.c-types alien.syntax kernel windows.types ;
|
||||
IN: opengl.gl.windows
|
||||
|
||||
LIBRARY: gl
|
||||
|
|
@ -8,4 +8,4 @@ FUNCTION: void* wglGetProcAddress ( c-string name ) ;
|
|||
|
||||
: gl-function-context ( -- context ) wglGetCurrentContext ; inline
|
||||
: gl-function-address ( name -- address ) wglGetProcAddress ; inline
|
||||
: gl-function-calling-convention ( -- str ) "stdcall" ; inline
|
||||
: gl-function-calling-convention ( -- str ) stdcall ; inline
|
||||
|
|
|
|||
|
|
@ -14,9 +14,9 @@ IN: openssl.libcrypto
|
|||
{
|
||||
{ [ os openbsd? ] [ ] } ! VM is linked with it
|
||||
{ [ os netbsd? ] [ ] }
|
||||
{ [ os winnt? ] [ "libcrypto" "libeay32.dll" "cdecl" add-library ] }
|
||||
{ [ os macosx? ] [ "libcrypto" "libcrypto.dylib" "cdecl" add-library ] }
|
||||
{ [ os unix? ] [ "libcrypto" "libcrypto.so" "cdecl" add-library ] }
|
||||
{ [ os winnt? ] [ "libcrypto" "libeay32.dll" cdecl add-library ] }
|
||||
{ [ os macosx? ] [ "libcrypto" "libcrypto.dylib" cdecl add-library ] }
|
||||
{ [ os unix? ] [ "libcrypto" "libcrypto.so" cdecl add-library ] }
|
||||
} cond
|
||||
>>
|
||||
|
||||
|
|
|
|||
|
|
@ -10,9 +10,9 @@ IN: openssl.libssl
|
|||
<< {
|
||||
{ [ os openbsd? ] [ ] } ! VM is linked with it
|
||||
{ [ os netbsd? ] [ ] }
|
||||
{ [ os winnt? ] [ "libssl" "ssleay32.dll" "cdecl" add-library ] }
|
||||
{ [ os macosx? ] [ "libssl" "libssl.dylib" "cdecl" add-library ] }
|
||||
{ [ os unix? ] [ "libssl" "libssl.so" "cdecl" add-library ] }
|
||||
{ [ os winnt? ] [ "libssl" "ssleay32.dll" cdecl add-library ] }
|
||||
{ [ os macosx? ] [ "libssl" "libssl.dylib" cdecl add-library ] }
|
||||
{ [ os unix? ] [ "libssl" "libssl.so" cdecl add-library ] }
|
||||
} cond >>
|
||||
|
||||
CONSTANT: X509_FILETYPE_PEM 1
|
||||
|
|
|
|||
|
|
@ -12,8 +12,8 @@ classes.struct cairo cairo.ffi ;
|
|||
IN: pango.cairo
|
||||
|
||||
<< {
|
||||
{ [ os winnt? ] [ "pangocairo" "libpangocairo-1.0-0.dll" "cdecl" add-library ] }
|
||||
{ [ os macosx? ] [ "pangocairo" "/opt/local/lib/libpangocairo-1.0.0.dylib" "cdecl" add-library ] }
|
||||
{ [ os winnt? ] [ "pangocairo" "libpangocairo-1.0-0.dll" cdecl add-library ] }
|
||||
{ [ os macosx? ] [ "pangocairo" "/opt/local/lib/libpangocairo-1.0.0.dylib" cdecl add-library ] }
|
||||
{ [ os unix? ] [ ] }
|
||||
} cond >>
|
||||
|
||||
|
|
|
|||
|
|
@ -8,8 +8,7 @@ IN: pango.fonts
|
|||
|
||||
LIBRARY: pango
|
||||
|
||||
TYPEDEF: int PangoStyle
|
||||
C-ENUM:
|
||||
C-ENUM: PangoStyle
|
||||
PANGO_STYLE_NORMAL
|
||||
PANGO_STYLE_OBLIQUE
|
||||
PANGO_STYLE_ITALIC ;
|
||||
|
|
|
|||
|
|
@ -11,8 +11,8 @@ IN: pango
|
|||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
<< {
|
||||
{ [ os winnt? ] [ "pango" "libpango-1.0-0.dll" "cdecl" add-library ] }
|
||||
{ [ os macosx? ] [ "pango" "/opt/local/lib/libpango-1.0.0.dylib" "cdecl" add-library ] }
|
||||
{ [ os winnt? ] [ "pango" "libpango-1.0-0.dll" cdecl add-library ] }
|
||||
{ [ os macosx? ] [ "pango" "/opt/local/lib/libpango-1.0.0.dylib" cdecl add-library ] }
|
||||
{ [ os unix? ] [ ] }
|
||||
} cond >>
|
||||
|
||||
|
|
|
|||
|
|
@ -107,8 +107,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
|
|||
[ callbacks get ] dip '[ _ <callback> ] cache ;
|
||||
|
||||
: callback-bottom ( params -- )
|
||||
[ xt>> ] [ callback-return-rewind ] bi
|
||||
'[ _ _ callback-xt ] infer-quot-here ;
|
||||
[ xt>> ] [ stack-cleanup ] bi '[ _ _ callback-xt ] infer-quot-here ;
|
||||
|
||||
: infer-alien-callback ( -- )
|
||||
alien-callback-params new
|
||||
|
|
|
|||
|
|
@ -2,9 +2,9 @@ USING: alien alien.c-types kernel math ;
|
|||
IN: tools.deploy.test.9
|
||||
|
||||
: callback-test ( -- callback )
|
||||
int { int } "cdecl" [ 1 + ] alien-callback ;
|
||||
int { int } cdecl [ 1 + ] alien-callback ;
|
||||
|
||||
: indirect-test ( -- )
|
||||
10 callback-test int { int } "cdecl" alien-indirect 11 assert= ;
|
||||
10 callback-test int { int } cdecl alien-indirect 11 assert= ;
|
||||
|
||||
MAIN: indirect-test
|
||||
|
|
|
|||
|
|
@ -15,6 +15,11 @@ HOOK: disassemble* disassembler-backend ( from to -- lines )
|
|||
|
||||
TR: tabs>spaces "\t" "\s" ;
|
||||
|
||||
GENERIC: (>address) ( object -- n )
|
||||
|
||||
M: integer (>address) ;
|
||||
M: alien (>address) alien-address ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
M: byte-array disassemble
|
||||
|
|
@ -24,7 +29,7 @@ M: byte-array disassemble
|
|||
2array disassemble
|
||||
] with-destructors ;
|
||||
|
||||
M: pair disassemble first2 disassemble* [ tabs>spaces print ] each ;
|
||||
M: pair disassemble first2 [ (>address) ] bi@ disassemble* [ tabs>spaces print ] each ;
|
||||
|
||||
M: word disassemble word-code 2array disassemble ;
|
||||
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ IN: tools.disassembler.udis
|
|||
{ [ os macosx? ] [ "libudis86.0.dylib" ] }
|
||||
{ [ os unix? ] [ "libudis86.so.0" ] }
|
||||
{ [ os winnt? ] [ "libudis86.dll" ] }
|
||||
} cond "cdecl" add-library
|
||||
} cond cdecl add-library
|
||||
>>
|
||||
|
||||
LIBRARY: libudis86
|
||||
|
|
|
|||
|
|
@ -21,9 +21,9 @@ IN: tools.profiler.tests
|
|||
|
||||
[ ] [ \ + usage-profile. ] unit-test
|
||||
|
||||
: callback-test ( -- callback ) void { } "cdecl" [ ] alien-callback ;
|
||||
: callback-test ( -- callback ) void { } cdecl [ ] alien-callback ;
|
||||
|
||||
: indirect-test ( callback -- ) void { } "cdecl" alien-indirect ;
|
||||
: indirect-test ( callback -- ) void { } cdecl alien-indirect ;
|
||||
|
||||
: foobar ( -- ) ;
|
||||
|
||||
|
|
|
|||
|
|
@ -609,7 +609,7 @@ SYMBOL: trace-messages?
|
|||
|
||||
! return 0 if you handle the message, else just let DefWindowProc return its val
|
||||
: ui-wndproc ( -- object )
|
||||
uint { void* uint long long } "stdcall" [
|
||||
uint { void* uint long long } stdcall [
|
||||
pick
|
||||
trace-messages? get-global [ dup windows-message-name name>> print flush ] when
|
||||
wm-handlers get-global at* [ call ] [ drop DefWindowProc ] if
|
||||
|
|
@ -633,7 +633,7 @@ M: windows-ui-backend do-events
|
|||
0 >>cbClsExtra
|
||||
0 >>cbWndExtra
|
||||
f GetModuleHandle >>hInstance
|
||||
f GetModuleHandle "fraptor" utf16n string>alien LoadIcon >>hIcon
|
||||
f GetModuleHandle "APPICON" utf16n string>alien LoadIcon >>hIcon
|
||||
f IDC_ARROW LoadCursor >>hCursor
|
||||
|
||||
class-name-ptr >>lpszClassName
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@ USING: ui.gadgets help.markup help.syntax arrays ;
|
|||
IN: ui.gadgets.grids
|
||||
|
||||
ARTICLE: "ui-grid-layout" "Grid layouts"
|
||||
"Grid gadgets layout their children in a rectangular grid."
|
||||
"Grid gadgets layout their children in a rectangular grid. The grid is represented as a sequence of sequences of gadgets. Every child sequence is a row of gadgets. Every row must have an equal number of gadgets in it."
|
||||
{ $subsections grid }
|
||||
"Creating grids from a fixed set of gadgets:"
|
||||
{ $subsections <grid> }
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ IN: unicode.breaks
|
|||
<PRIVATE
|
||||
! Grapheme breaks
|
||||
|
||||
C-ENUM: Any L V T LV LVT Extend Control CR LF
|
||||
C-ENUM: f Any L V T LV LVT Extend Control CR LF
|
||||
SpacingMark Prepend graphemes ;
|
||||
|
||||
: jamo-class ( ch -- class )
|
||||
|
|
@ -131,7 +131,7 @@ VALUE: word-break-table
|
|||
"vocab:unicode/data/WordBreakProperty.txt" load-interval-file
|
||||
to: word-break-table
|
||||
|
||||
C-ENUM: wOther wCR wLF wNewline wExtend wFormat wKatakana wALetter wMidLetter
|
||||
C-ENUM: f wOther wCR wLF wNewline wExtend wFormat wKatakana wALetter wMidLetter
|
||||
wMidNum wMidNumLet wNumeric wExtendNumLet words ;
|
||||
|
||||
: word-break-classes ( -- table ) ! Is there a way to avoid this?
|
||||
|
|
|
|||
|
|
@ -156,4 +156,4 @@ FUNCTION: int unlink ( c-string path ) ;
|
|||
FUNCTION: int utimes ( c-string path, timeval[2] times ) ;
|
||||
FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ;
|
||||
|
||||
"librt" "librt.so" "cdecl" add-library
|
||||
"librt" "librt.so" cdecl add-library
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@ STRUCT: vm
|
|||
|
||||
: vm-field-offset ( field -- offset ) vm offset-of ; inline
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: f
|
||||
collect-nursery-op
|
||||
collect-aging-op
|
||||
collect-to-tenured-op
|
||||
|
|
|
|||
|
|
@ -146,8 +146,7 @@ CONSTANT: TokenSessionReference 14
|
|||
CONSTANT: TokenSandBoxInert 15
|
||||
! } TOKEN_INFORMATION_CLASS;
|
||||
|
||||
TYPEDEF: DWORD ACCESS_MODE
|
||||
C-ENUM:
|
||||
C-ENUM: ACCESS_MODE
|
||||
NOT_USED_ACCESS
|
||||
GRANT_ACCESS
|
||||
SET_ACCESS
|
||||
|
|
@ -156,21 +155,18 @@ C-ENUM:
|
|||
SET_AUDIT_SUCCESS
|
||||
SET_AUDIT_FAILURE ;
|
||||
|
||||
TYPEDEF: DWORD MULTIPLE_TRUSTEE_OPERATION
|
||||
C-ENUM:
|
||||
C-ENUM: MULTIPLE_TRUSTEE_OPERATION
|
||||
NO_MULTIPLE_TRUSTEE
|
||||
TRUSTEE_IS_IMPERSONATE ;
|
||||
|
||||
TYPEDEF: DWORD TRUSTEE_FORM
|
||||
C-ENUM:
|
||||
C-ENUM: TRUSTEE_FORM
|
||||
TRUSTEE_IS_SID
|
||||
TRUSTEE_IS_NAME
|
||||
TRUSTEE_BAD_FORM
|
||||
TRUSTEE_IS_OBJECTS_AND_SID
|
||||
TRUSTEE_IS_OBJECTS_AND_NAME ;
|
||||
|
||||
TYPEDEF: DWORD TRUSTEE_TYPE
|
||||
C-ENUM:
|
||||
C-ENUM: TRUSTEE_TYPE
|
||||
TRUSTEE_IS_UNKNOWN
|
||||
TRUSTEE_IS_USER
|
||||
TRUSTEE_IS_GROUP
|
||||
|
|
@ -181,8 +177,7 @@ C-ENUM:
|
|||
TRUSTEE_IS_INVALID
|
||||
TRUSTEE_IS_COMPUTER ;
|
||||
|
||||
TYPEDEF: DWORD SE_OBJECT_TYPE
|
||||
C-ENUM:
|
||||
C-ENUM: SE_OBJECT_TYPE
|
||||
SE_UNKNOWN_OBJECT_TYPE
|
||||
SE_FILE_OBJECT
|
||||
SE_SERVICE
|
||||
|
|
|
|||
|
|
@ -1,14 +1,14 @@
|
|||
USING: alien sequences alien.libraries ;
|
||||
{
|
||||
{ "advapi32" "\\windows\\coredll.dll" "stdcall" }
|
||||
{ "gdi32" "\\windows\\coredll.dll" "stdcall" }
|
||||
{ "user32" "\\windows\\coredll.dll" "stdcall" }
|
||||
{ "kernel32" "\\windows\\coredll.dll" "stdcall" }
|
||||
{ "winsock" "\\windows\\ws2.dll" "stdcall" }
|
||||
{ "mswsock" "\\windows\\ws2.dll" "stdcall" }
|
||||
{ "libc" "\\windows\\coredll.dll" "stdcall" }
|
||||
{ "libm" "\\windows\\coredll.dll" "stdcall" }
|
||||
! { "gl" "libGLES_CM.dll" "stdcall" }
|
||||
! { "glu" "libGLES_CM.dll" "stdcall" }
|
||||
{ "ole32" "ole32.dll" "stdcall" }
|
||||
{ "advapi32" "\\windows\\coredll.dll" stdcall }
|
||||
{ "gdi32" "\\windows\\coredll.dll" stdcall }
|
||||
{ "user32" "\\windows\\coredll.dll" stdcall }
|
||||
{ "kernel32" "\\windows\\coredll.dll" stdcall }
|
||||
{ "winsock" "\\windows\\ws2.dll" stdcall }
|
||||
{ "mswsock" "\\windows\\ws2.dll" stdcall }
|
||||
{ "libc" "\\windows\\coredll.dll" stdcall }
|
||||
{ "libm" "\\windows\\coredll.dll" stdcall }
|
||||
! { "gl" "libGLES_CM.dll" stdcall }
|
||||
! { "glu" "libGLES_CM.dll" stdcall }
|
||||
{ "ole32" "ole32.dll" stdcall }
|
||||
} [ first3 add-library ] each
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ MACRO: com-invoke ( n return parameters -- )
|
|||
[ 2nip length ] 3keep
|
||||
'[
|
||||
_ npick *void* _ cell * alien-cell _ _
|
||||
"stdcall" alien-indirect
|
||||
stdcall alien-indirect
|
||||
] ;
|
||||
|
||||
TUPLE: com-interface-definition word parent iid functions ;
|
||||
|
|
|
|||
|
|
@ -114,7 +114,7 @@ unless
|
|||
] [
|
||||
first2 (finish-thunk)
|
||||
] bi*
|
||||
"stdcall" swap compile-alien-callback
|
||||
stdcall swap compile-alien-callback
|
||||
] 2map ;
|
||||
|
||||
: (make-callbacks) ( implementations -- sequence )
|
||||
|
|
|
|||
|
|
@ -1,10 +1,10 @@
|
|||
! Copyright (C) 2010 Erik Charlebois.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types alien.libraries alien.syntax classes.struct
|
||||
kernel math windows.types windows.ole32 ;
|
||||
USING: alien alien.c-types alien.libraries alien.syntax
|
||||
classes.struct kernel math windows.types windows.ole32 ;
|
||||
IN: windows.ddk.hid
|
||||
|
||||
<< "hid" "hid.dll" "stdcall" add-library >>
|
||||
<< "hid" "hid.dll" stdcall add-library >>
|
||||
LIBRARY: hid
|
||||
|
||||
TYPEDEF: LONG NTSTATUS
|
||||
|
|
@ -206,11 +206,10 @@ CONSTANT: HID_USAGE_DIGITIZER_BARREL_SWITCH HEX: 44
|
|||
CONSTANT: HIDP_LINK_COLLECTION_ROOT -1
|
||||
CONSTANT: HIDP_LINK_COLLECTION_UNSPECIFIED 0
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: HIDP_REPORT_TYPE
|
||||
HidP_Input
|
||||
HidP_Output
|
||||
HidP_Feature ;
|
||||
TYPEDEF: int HIDP_REPORT_TYPE
|
||||
|
||||
STRUCT: USAGE_AND_PAGE
|
||||
{ Usage USAGE }
|
||||
|
|
@ -608,10 +607,9 @@ HidP_UsageAndPageListDifference (
|
|||
ULONG UsageListLength
|
||||
) ;
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: HIDP_KEYBOARD_DIRECTION
|
||||
HidP_Keyboard_Break
|
||||
HidP_Keyboard_Make ;
|
||||
TYPEDEF: int HIDP_KEYBOARD_DIRECTION
|
||||
|
||||
STRUCT: HIDP_KEYBOARD_MODIFIER_STATE
|
||||
{ ul ULONG } ;
|
||||
|
|
|
|||
|
|
@ -1,10 +1,11 @@
|
|||
! Copyright (C) 2010 Erik Charlebois.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: literals windows.kernel32 math alien.syntax windows.types classes.struct
|
||||
alien.c-types windows.errors windows.ole32 windows.advapi32 alien.libraries ;
|
||||
USING: literals windows.kernel32 math alien.syntax windows.types
|
||||
classes.struct alien alien.c-types windows.errors windows.ole32
|
||||
windows.advapi32 alien.libraries ;
|
||||
IN: windows.ddk.setupapi
|
||||
|
||||
<< "setupapi" "setupapi.dll" "stdcall" add-library >>
|
||||
<< "setupapi" "setupapi.dll" stdcall add-library >>
|
||||
LIBRARY: setupapi
|
||||
|
||||
TYPEDEF: DWORDLONG SP_LOG_TOKEN
|
||||
|
|
@ -1515,14 +1516,13 @@ FUNCTION: BOOL SetupRemoveFileLogEntryA ( HSPFILELOG FileLogHandle, PCSTR LogSec
|
|||
FUNCTION: BOOL SetupRemoveFileLogEntryW ( HSPFILELOG FileLogHandle, PCWSTR LogSectionName, PCWSTR TargetFilename ) ;
|
||||
ALIAS: SetupRemoveFileLogEntry SetupRemoveFileLogEntryW
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: SetupFileLogInfo
|
||||
SetupFileLogSourceFilename
|
||||
SetupFileLogChecksum
|
||||
SetupFileLogDiskTagfile
|
||||
SetupFileLogDiskDescription
|
||||
SetupFileLogOtherInfo
|
||||
SetupFileLogMax ;
|
||||
TYPEDEF: int SetupFileLogInfo
|
||||
|
||||
FUNCTION: BOOL SetupQueryFileLogA ( HSPFILELOG FileLogHandle, PCSTR LogSectionName, PCSTR TargetFilename, SetupFileLogInfo DesiredInfo, PSTR DataOut, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
|
||||
FUNCTION: BOOL SetupQueryFileLogW ( HSPFILELOG FileLogHandle, PCWSTR LogSectionName, PCWSTR TargetFilename, SetupFileLogInfo DesiredInfo, PWSTR DataOut, DWORD ReturnBufferSize, PDWORD RequiredSize ) ;
|
||||
|
|
|
|||
|
|
@ -1,10 +1,10 @@
|
|||
! Copyright (C) 2010 Erik Charlebois.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types alien.syntax classes.struct windows.kernel32
|
||||
windows.types alien.libraries ;
|
||||
USING: alien alien.c-types alien.syntax classes.struct
|
||||
windows.kernel32 windows.types alien.libraries ;
|
||||
IN: windows.ddk.winusb
|
||||
|
||||
<< "winusb" "winusb.dll" "stdcall" add-library >>
|
||||
<< "winusb" "winusb.dll" stdcall add-library >>
|
||||
LIBRARY: winusb
|
||||
|
||||
TYPEDEF: PVOID WINUSB_INTERFACE_HANDLE
|
||||
|
|
@ -22,12 +22,11 @@ STRUCT: USB_INTERFACE_DESCRIPTOR
|
|||
{ iInterface UCHAR } ;
|
||||
TYPEDEF: USB_INTERFACE_DESCRIPTOR* PUSB_INTERFACE_DESCRIPTOR
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: USBD_PIPE_TYPE
|
||||
UsbdPipeTypeControl
|
||||
UsbdPipeTypeIsochronous
|
||||
UsbdPipeTypeBulk
|
||||
UsbdPipeTypeInterrupt ;
|
||||
TYPEDEF: int USBD_PIPE_TYPE
|
||||
|
||||
STRUCT: WINUSB_PIPE_INFORMATION
|
||||
{ PipeType USBD_PIPE_TYPE }
|
||||
|
|
|
|||
|
|
@ -24,11 +24,11 @@ CONSTANT: D3D11_RETURN_TYPE_DOUBLE 7
|
|||
CONSTANT: D3D11_RETURN_TYPE_CONTINUED 8
|
||||
TYPEDEF: int D3D11_RESOURCE_RETURN_TYPE
|
||||
|
||||
C-ENUM: D3D11_CT_CBUFFER
|
||||
C-ENUM: D3D11_CBUFFER_TYPE
|
||||
D3D11_CT_CBUFFER
|
||||
D3D11_CT_TBUFFER
|
||||
D3D11_CT_INTERFACE_POINTERS
|
||||
D3D11_CT_RESOURCE_BIND_INFO ;
|
||||
TYPEDEF: int D3D11_CBUFFER_TYPE
|
||||
TYPEDEF: D3D11_CBUFFER_TYPE* LPD3D11_CBUFFER_TYPE
|
||||
|
||||
STRUCT: D3D11_SIGNATURE_PARAMETER_DESC
|
||||
|
|
|
|||
|
|
@ -502,8 +502,7 @@ CONSTANT: MAXD3DDECLUSAGE 13
|
|||
CONSTANT: MAXD3DDECLUSAGEINDEX 15
|
||||
CONSTANT: MAXD3DDECLLENGTH 64
|
||||
|
||||
TYPEDEF: int D3DDECLMETHOD
|
||||
C-ENUM:
|
||||
C-ENUM: D3DDECLMETHOD
|
||||
D3DDECLMETHOD_DEFAULT
|
||||
D3DDECLMETHOD_PARTIALU
|
||||
D3DDECLMETHOD_PARTIALV
|
||||
|
|
|
|||
|
|
@ -48,10 +48,9 @@ COM-INTERFACE: ID3DX11FFT IUnknown {b3f7a938-4c93-4310-a675-b30d6de50553}
|
|||
HRESULT ForwardTransform ( ID3D11UnorderedAccessView* pInputBuffer, ID3D11UnorderedAccessView** ppOutputBuffer )
|
||||
HRESULT InverseTransform ( ID3D11UnorderedAccessView* pInputBuffer, ID3D11UnorderedAccessView** ppOutputBuffer ) ;
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: D3DX11_FFT_DATA_TYPE
|
||||
D3DX11_FFT_DATA_TYPE_REAL
|
||||
D3DX11_FFT_DATA_TYPE_COMPLEX ;
|
||||
TYPEDEF: int D3DX11_FFT_DATA_TYPE
|
||||
|
||||
CONSTANT: D3DX11_FFT_DIM_MASK_1D 1
|
||||
CONSTANT: D3DX11_FFT_DIM_MASK_2D 3
|
||||
|
|
|
|||
|
|
@ -41,25 +41,23 @@ STRUCT: D3DXSEMANTIC
|
|||
{ UsageIndex UINT } ;
|
||||
TYPEDEF: D3DXSEMANTIC* LPD3DXSEMANTIC
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: D3DXREGISTER_SET
|
||||
D3DXRS_BOOL
|
||||
D3DXRS_INT4
|
||||
D3DXRS_FLOAT4
|
||||
D3DXRS_SAMPLER ;
|
||||
TYPEDEF: int D3DXREGISTER_SET
|
||||
TYPEDEF: D3DXREGISTER_SET* LPD3DXREGISTER_SET
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: D3DXPARAMETER_CLASS
|
||||
D3DXPC_SCALAR
|
||||
D3DXPC_VECTOR
|
||||
D3DXPC_MATRIX_ROWS
|
||||
D3DXPC_MATRIX_COLUMNS
|
||||
D3DXPC_OBJECT
|
||||
D3DXPC_STRUCT ;
|
||||
TYPEDEF: int D3DXPARAMETER_CLASS
|
||||
TYPEDEF: D3DXPARAMETER_CLASS* LPD3DXPARAMETER_CLASS
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: D3DXPARAMETER_TYPE
|
||||
D3DXPT_VOID
|
||||
D3DXPT_BOOL
|
||||
D3DXPT_INT
|
||||
|
|
@ -80,7 +78,6 @@ C-ENUM:
|
|||
D3DXPT_PIXELFRAGMENT
|
||||
D3DXPT_VERTEXFRAGMENT
|
||||
D3DXPT_UNSUPPORTED ;
|
||||
TYPEDEF: int D3DXPARAMETER_TYPE
|
||||
TYPEDEF: D3DXPARAMETER_TYPE* LPD3DXPARAMETER_TYPE
|
||||
|
||||
STRUCT: D3DXCONSTANTTABLE_DESC
|
||||
|
|
@ -161,10 +158,9 @@ COM-INTERFACE: ID3DXTextureShader IUnknown {3E3D67F8-AA7A-405d-A857-BA01D4758426
|
|||
HRESULT SetMatrixTransposeArray ( D3DXHANDLE hConstant, D3DXMATRIX* pMatrix, UINT Count )
|
||||
HRESULT SetMatrixTransposePointerArray ( D3DXHANDLE hConstant, D3DXMATRIX** ppMatrix, UINT Count ) ;
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: D3DXINCLUDE_TYPE
|
||||
D3DXINC_LOCAL
|
||||
D3DXINC_SYSTEM ;
|
||||
TYPEDEF: int D3DXINCLUDE_TYPE
|
||||
TYPEDEF: D3DXINCLUDE_TYPE* LPD3DXINCLUDE_TYPE
|
||||
|
||||
C-TYPE: ID3DXInclude
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
USING: alien.c-types alien.syntax ;
|
||||
IN: windows.directx.dcommon
|
||||
|
||||
C-ENUM: DWRITE_MEASURING_MODE_NATURAL
|
||||
C-ENUM: DWRITE_MEASURING_MODE
|
||||
DWRITE_MEASURING_MODE_NATURAL
|
||||
DWRITE_MEASURING_MODE_GDI_CLASSIC
|
||||
DWRITE_MEASURING_MODE_GDI_NATURAL ;
|
||||
TYPEDEF: int DWRITE_MEASURING_MODE
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ IN: windows.directx.dwrite
|
|||
|
||||
LIBRARY: dwrite
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: DWRITE_FONT_FILE_TYPE
|
||||
DWRITE_FONT_FILE_TYPE_UNKNOWN
|
||||
DWRITE_FONT_FILE_TYPE_CFF
|
||||
DWRITE_FONT_FILE_TYPE_TRUETYPE
|
||||
|
|
@ -14,9 +14,8 @@ C-ENUM:
|
|||
DWRITE_FONT_FILE_TYPE_TYPE1_PFB
|
||||
DWRITE_FONT_FILE_TYPE_VECTOR
|
||||
DWRITE_FONT_FILE_TYPE_BITMAP ;
|
||||
TYPEDEF: int DWRITE_FONT_FILE_TYPE
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: DWRITE_FONT_FACE_TYPE
|
||||
DWRITE_FONT_FACE_TYPE_CFF
|
||||
DWRITE_FONT_FACE_TYPE_TRUETYPE
|
||||
DWRITE_FONT_FACE_TYPE_TRUETYPE_COLLECTION
|
||||
|
|
@ -24,51 +23,49 @@ C-ENUM:
|
|||
DWRITE_FONT_FACE_TYPE_VECTOR
|
||||
DWRITE_FONT_FACE_TYPE_BITMAP
|
||||
DWRITE_FONT_FACE_TYPE_UNKNOWN ;
|
||||
TYPEDEF: int DWRITE_FONT_FACE_TYPE
|
||||
|
||||
CONSTANT: DWRITE_FONT_SIMULATIONS_NONE 0
|
||||
CONSTANT: DWRITE_FONT_SIMULATIONS_BOLD 1
|
||||
CONSTANT: DWRITE_FONT_SIMULATIONS_OBLIQUE 2
|
||||
TYPEDEF: int DWRITE_FONT_SIMULATIONS
|
||||
C-ENUM: DWRITE_FONT_SIMULATIONS
|
||||
DWRITE_FONT_SIMULATIONS_NONE
|
||||
DWRITE_FONT_SIMULATIONS_BOLD
|
||||
DWRITE_FONT_SIMULATIONS_OBLIQUE ;
|
||||
|
||||
CONSTANT: DWRITE_FONT_WEIGHT_THIN 100
|
||||
CONSTANT: DWRITE_FONT_WEIGHT_EXTRA_LIGHT 200
|
||||
CONSTANT: DWRITE_FONT_WEIGHT_ULTRA_LIGHT 200
|
||||
CONSTANT: DWRITE_FONT_WEIGHT_LIGHT 300
|
||||
CONSTANT: DWRITE_FONT_WEIGHT_NORMAL 400
|
||||
CONSTANT: DWRITE_FONT_WEIGHT_REGULAR 400
|
||||
CONSTANT: DWRITE_FONT_WEIGHT_MEDIUM 500
|
||||
CONSTANT: DWRITE_FONT_WEIGHT_DEMI_BOLD 600
|
||||
CONSTANT: DWRITE_FONT_WEIGHT_SEMI_BOLD 600
|
||||
CONSTANT: DWRITE_FONT_WEIGHT_BOLD 700
|
||||
CONSTANT: DWRITE_FONT_WEIGHT_EXTRA_BOLD 800
|
||||
CONSTANT: DWRITE_FONT_WEIGHT_ULTRA_BOLD 800
|
||||
CONSTANT: DWRITE_FONT_WEIGHT_BLACK 900
|
||||
CONSTANT: DWRITE_FONT_WEIGHT_HEAVY 900
|
||||
CONSTANT: DWRITE_FONT_WEIGHT_EXTRA_BLACK 950
|
||||
CONSTANT: DWRITE_FONT_WEIGHT_ULTRA_BLACK 950
|
||||
TYPEDEF: int DWRITE_FONT_WEIGHT
|
||||
C-ENUM: DWRITE_FONT_WEIGHT
|
||||
{ DWRITE_FONT_WEIGHT_THIN 100 }
|
||||
{ DWRITE_FONT_WEIGHT_EXTRA_LIGHT 200 }
|
||||
{ DWRITE_FONT_WEIGHT_ULTRA_LIGHT 200 }
|
||||
{ DWRITE_FONT_WEIGHT_LIGHT 300 }
|
||||
{ DWRITE_FONT_WEIGHT_NORMAL 400 }
|
||||
{ DWRITE_FONT_WEIGHT_REGULAR 400 }
|
||||
{ DWRITE_FONT_WEIGHT_MEDIUM 500 }
|
||||
{ DWRITE_FONT_WEIGHT_DEMI_BOLD 600 }
|
||||
{ DWRITE_FONT_WEIGHT_SEMI_BOLD 600 }
|
||||
{ DWRITE_FONT_WEIGHT_BOLD 700 }
|
||||
{ DWRITE_FONT_WEIGHT_EXTRA_BOLD 800 }
|
||||
{ DWRITE_FONT_WEIGHT_ULTRA_BOLD 800 }
|
||||
{ DWRITE_FONT_WEIGHT_BLACK 900 }
|
||||
{ DWRITE_FONT_WEIGHT_HEAVY 900 }
|
||||
{ DWRITE_FONT_WEIGHT_EXTRA_BLACK 950 }
|
||||
{ DWRITE_FONT_WEIGHT_ULTRA_BLACK 950 } ;
|
||||
|
||||
CONSTANT: DWRITE_FONT_STRETCH_UNDEFINED 0
|
||||
CONSTANT: DWRITE_FONT_STRETCH_ULTRA_CONDENSED 1
|
||||
CONSTANT: DWRITE_FONT_STRETCH_EXTRA_CONDENSED 2
|
||||
CONSTANT: DWRITE_FONT_STRETCH_CONDENSED 3
|
||||
CONSTANT: DWRITE_FONT_STRETCH_SEMI_CONDENSED 4
|
||||
CONSTANT: DWRITE_FONT_STRETCH_NORMAL 5
|
||||
CONSTANT: DWRITE_FONT_STRETCH_MEDIUM 5
|
||||
CONSTANT: DWRITE_FONT_STRETCH_SEMI_EXPANDED 6
|
||||
CONSTANT: DWRITE_FONT_STRETCH_EXPANDED 7
|
||||
CONSTANT: DWRITE_FONT_STRETCH_EXTRA_EXPANDED 8
|
||||
CONSTANT: DWRITE_FONT_STRETCH_ULTRA_EXPANDED 9
|
||||
TYPEDEF: int DWRITE_FONT_STRETCH
|
||||
C-ENUM: DWRITE_FONT_STRETCH
|
||||
{ DWRITE_FONT_STRETCH_UNDEFINED 0 }
|
||||
{ DWRITE_FONT_STRETCH_ULTRA_CONDENSED 1 }
|
||||
{ DWRITE_FONT_STRETCH_EXTRA_CONDENSED 2 }
|
||||
{ DWRITE_FONT_STRETCH_CONDENSED 3 }
|
||||
{ DWRITE_FONT_STRETCH_SEMI_CONDENSED 4 }
|
||||
{ DWRITE_FONT_STRETCH_NORMAL 5 }
|
||||
{ DWRITE_FONT_STRETCH_MEDIUM 5 }
|
||||
{ DWRITE_FONT_STRETCH_SEMI_EXPANDED 6 }
|
||||
{ DWRITE_FONT_STRETCH_EXPANDED 7 }
|
||||
{ DWRITE_FONT_STRETCH_EXTRA_EXPANDED 8 }
|
||||
{ DWRITE_FONT_STRETCH_ULTRA_EXPANDED 9 } ;
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: DWRITE_FONT_STYLE
|
||||
DWRITE_FONT_STYLE_NORMAL
|
||||
DWRITE_FONT_STYLE_OBLIQUE
|
||||
DWRITE_FONT_STYLE_ITALIC ;
|
||||
TYPEDEF: int DWRITE_FONT_STYLE
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: DWRITE_INFORMATIONAL_STRING_ID
|
||||
DWRITE_INFORMATIONAL_STRING_NONE
|
||||
DWRITE_INFORMATIONAL_STRING_COPYRIGHT_NOTICE
|
||||
DWRITE_INFORMATIONAL_STRING_VERSION_STRINGS
|
||||
|
|
@ -85,7 +82,6 @@ C-ENUM:
|
|||
DWRITE_INFORMATIONAL_STRING_PREFERRED_FAMILY_NAMES
|
||||
DWRITE_INFORMATIONAL_STRING_PREFERRED_SUBFAMILY_NAMES
|
||||
DWRITE_INFORMATIONAL_STRING_SAMPLE_TEXT ;
|
||||
TYPEDEF: int DWRITE_INFORMATIONAL_STRING_ID
|
||||
|
||||
STRUCT: DWRITE_FONT_METRICS
|
||||
{ designUnitsPerEm USHORT }
|
||||
|
|
@ -112,10 +108,9 @@ STRUCT: DWRITE_GLYPH_OFFSET
|
|||
{ advanceOffset FLOAT }
|
||||
{ ascenderOffset FLOAT } ;
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: DWRITE_FACTORY_TYPE
|
||||
DWRITE_FACTORY_TYPE_SHARED
|
||||
DWRITE_FACTORY_TYPE_ISOLATED ;
|
||||
TYPEDEF: int DWRITE_FACTORY_TYPE
|
||||
|
||||
C-TYPE: IDWriteFontFileStream
|
||||
|
||||
|
|
@ -138,14 +133,12 @@ COM-INTERFACE: IDWriteFontFile IUnknown {739d886a-cef5-47dc-8769-1a8b41bebbb0}
|
|||
HRESULT GetLoader ( IDWriteFontFileLoader** fontFileLoader )
|
||||
HRESULT Analyze ( BOOL* isSupportedFontType, DWRITE_FONT_FILE_TYPE* fontFileType, DWRITE_FONT_FACE_TYPE* fontFaceType, UINT32* numberOfFaces ) ;
|
||||
|
||||
TYPEDEF: int DWRITE_PIXEL_GEOMETRY
|
||||
C-ENUM:
|
||||
C-ENUM: DWRITE_PIXEL_GEOMETRY
|
||||
DWRITE_PIXEL_GEOMETRY_FLAT
|
||||
DWRITE_PIXEL_GEOMETRY_RGB
|
||||
DWRITE_PIXEL_GEOMETRY_BGR ;
|
||||
|
||||
TYPEDEF: int DWRITE_RENDERING_MODE
|
||||
C-ENUM:
|
||||
C-ENUM: DWRITE_RENDERING_MODE
|
||||
DWRITE_RENDERING_MODE_DEFAULT
|
||||
DWRITE_RENDERING_MODE_ALIASED
|
||||
DWRITE_RENDERING_MODE_CLEARTYPE_GDI_CLASSIC
|
||||
|
|
@ -240,39 +233,32 @@ COM-INTERFACE: IDWriteFont IUnknown {acd16696-8c14-4f5d-877e-fe3fc1d32737}
|
|||
HRESULT HasCharacter ( UINT32 unicodeValue, BOOL* exists )
|
||||
HRESULT CreateFontFace ( IDWriteFontFace** fontFace ) ;
|
||||
|
||||
TYPEDEF: int DWRITE_READING_DIRECTION
|
||||
C-ENUM:
|
||||
C-ENUM: DWRITE_READING_DIRECTION
|
||||
DWRITE_READING_DIRECTION_LEFT_TO_RIGHT
|
||||
DWRITE_READING_DIRECTION_RIGHT_TO_LEFT ;
|
||||
|
||||
TYPEDEF: int DWRITE_FLOW_DIRECTION
|
||||
C-ENUM:
|
||||
C-ENUM: DWRITE_FLOW_DIRECTION
|
||||
DWRITE_FLOW_DIRECTION_TOP_TO_BOTTOM ;
|
||||
|
||||
TYPEDEF: int DWRITE_TEXT_ALIGNMENT
|
||||
C-ENUM:
|
||||
C-ENUM: DWRITE_TEXT_ALIGNMENT
|
||||
DWRITE_TEXT_ALIGNMENT_LEADING
|
||||
DWRITE_TEXT_ALIGNMENT_TRAILING
|
||||
DWRITE_TEXT_ALIGNMENT_CENTER ;
|
||||
|
||||
TYPEDEF: int DWRITE_PARAGRAPH_ALIGNMENT
|
||||
C-ENUM:
|
||||
C-ENUM: DWRITE_PARAGRAPH_ALIGNMENT
|
||||
DWRITE_PARAGRAPH_ALIGNMENT_NEAR
|
||||
DWRITE_PARAGRAPH_ALIGNMENT_FAR
|
||||
DWRITE_PARAGRAPH_ALIGNMENT_CENTER ;
|
||||
|
||||
TYPEDEF: int DWRITE_WORD_WRAPPING
|
||||
C-ENUM:
|
||||
C-ENUM: DWRITE_WORD_WRAPPING
|
||||
DWRITE_WORD_WRAPPING_WRAP
|
||||
DWRITE_WORD_WRAPPING_NO_WRAP ;
|
||||
|
||||
TYPEDEF: int DWRITE_LINE_SPACING_METHOD
|
||||
C-ENUM:
|
||||
C-ENUM: DWRITE_LINE_SPACING_METHOD
|
||||
DWRITE_LINE_SPACING_METHOD_DEFAULT
|
||||
DWRITE_LINE_SPACING_METHOD_UNIFORM ;
|
||||
|
||||
TYPEDEF: int DWRITE_TRIMMING_GRANULARITY
|
||||
C-ENUM:
|
||||
C-ENUM: DWRITE_TRIMMING_GRANULARITY
|
||||
DWRITE_TRIMMING_GRANULARITY_NONE
|
||||
DWRITE_TRIMMING_GRANULARITY_CHARACTER
|
||||
DWRITE_TRIMMING_GRANULARITY_WORD ;
|
||||
|
|
@ -410,31 +396,29 @@ COM-INTERFACE: IDWriteTypography IUnknown {55f1112b-1dc2-4b3c-9541-f46894ed85b6}
|
|||
UINT32 GetFontFeatureCount ( )
|
||||
HRESULT GetFontFeature ( UINT32 fontFeatureIndex, DWRITE_FONT_FEATURE* fontFeature ) ;
|
||||
|
||||
CONSTANT: DWRITE_SCRIPT_SHAPES_DEFAULT 0
|
||||
CONSTANT: DWRITE_SCRIPT_SHAPES_NO_VISUAL 1
|
||||
TYPEDEF: int DWRITE_SCRIPT_SHAPES
|
||||
C-ENUM: DWRITE_SCRIPT_SHAPES
|
||||
DWRITE_SCRIPT_SHAPES_DEFAULT
|
||||
DWRITE_SCRIPT_SHAPES_NO_VISUAL ;
|
||||
|
||||
STRUCT: DWRITE_SCRIPT_ANALYSIS
|
||||
{ script USHORT }
|
||||
{ shapes DWRITE_SCRIPT_SHAPES } ;
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: DWRITE_BREAK_CONDITION
|
||||
DWRITE_BREAK_CONDITION_NEUTRAL
|
||||
DWRITE_BREAK_CONDITION_CAN_BREAK
|
||||
DWRITE_BREAK_CONDITION_MAY_NOT_BREAK
|
||||
DWRITE_BREAK_CONDITION_MUST_BREAK ;
|
||||
TYPEDEF: int DWRITE_BREAK_CONDITION
|
||||
|
||||
STRUCT: DWRITE_LINE_BREAKPOINT
|
||||
{ data BYTE } ;
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: DWRITE_NUMBER_SUBSTITUTION_METHOD
|
||||
DWRITE_NUMBER_SUBSTITUTION_METHOD_FROM_CULTURE
|
||||
DWRITE_NUMBER_SUBSTITUTION_METHOD_CONTEXTUAL
|
||||
DWRITE_NUMBER_SUBSTITUTION_METHOD_NONE
|
||||
DWRITE_NUMBER_SUBSTITUTION_METHOD_NATIONAL
|
||||
DWRITE_NUMBER_SUBSTITUTION_METHOD_TRADITIONAL ;
|
||||
TYPEDEF: int DWRITE_NUMBER_SUBSTITUTION_METHOD
|
||||
|
||||
COM-INTERFACE: IDWriteNumberSubstitution IUnknown {14885CC9-BAB0-4f90-B6ED-5C366A2CD03D} ;
|
||||
|
||||
|
|
@ -628,9 +612,9 @@ COM-INTERFACE: IDWriteGdiInterop IUnknown {1edd9491-9853-4299-898f-6432983b6f3a}
|
|||
HRESULT CreateFontFaceFromHdc ( HDC hdc, IDWriteFontFace** fontFace )
|
||||
HRESULT CreateBitmapRenderTarget ( HDC hdc, UINT32 width, UINT32 height, IDWriteBitmapRenderTarget** renderTarget ) ;
|
||||
|
||||
C-ENUM: DWRITE_TEXTURE_ALIASED_1x1
|
||||
C-ENUM: DWRITE_TEXTURE_TYPE
|
||||
DWRITE_TEXTURE_ALIASED_1x1
|
||||
DWRITE_TEXTURE_CLEARTYPE_3x1 ;
|
||||
TYPEDEF: int DWRITE_TEXTURE_TYPE
|
||||
|
||||
CONSTANT: DWRITE_ALPHA_MAX 255
|
||||
|
||||
|
|
|
|||
|
|
@ -47,23 +47,23 @@ STRUCT: DXGI_RATIONAL
|
|||
{ Numerator UINT }
|
||||
{ Denominator UINT } ;
|
||||
|
||||
C-ENUM: DXGI_MODE_SCANLINE_ORDER_UNSPECIFIED
|
||||
C-ENUM: DXGI_MODE_SCANLINE_ORDER
|
||||
DXGI_MODE_SCANLINE_ORDER_UNSPECIFIED
|
||||
DXGI_MODE_SCANLINE_ORDER_PROGRESSIVE
|
||||
DXGI_MODE_SCANLINE_ORDER_UPPER_FIELD_FIRST
|
||||
DXGI_MODE_SCANLINE_ORDER_LOWER_FIELD_FIRST ;
|
||||
TYPEDEF: int DXGI_MODE_SCANLINE_ORDER
|
||||
|
||||
C-ENUM: DXGI_MODE_SCALING_UNSPECIFIED
|
||||
C-ENUM: DXGI_MODE_SCALING
|
||||
DXGI_MODE_SCALING_UNSPECIFIED
|
||||
DXGI_MODE_SCALING_CENTERED
|
||||
DXGI_MODE_SCALING_STRETCHED ;
|
||||
TYPEDEF: int DXGI_MODE_SCALING
|
||||
|
||||
C-ENUM: DXGI_MODE_ROTATION_UNSPECIFIED
|
||||
C-ENUM: DXGI_MODE_ROTATION
|
||||
DXGI_MODE_ROTATION_UNSPECIFIED
|
||||
DXGI_MODE_ROTATION_IDENTITY
|
||||
DXGI_MODE_ROTATION_ROTATE90
|
||||
DXGI_MODE_ROTATION_ROTATE180
|
||||
DXGI_MODE_ROTATION_ROTATE270 ;
|
||||
TYPEDEF: int DXGI_MODE_ROTATION
|
||||
|
||||
STRUCT: DXGI_MODE_DESC
|
||||
{ Width UINT }
|
||||
|
|
|
|||
|
|
@ -39,10 +39,9 @@ STRUCT: XAPO_LOCKFORPROCESS_BUFFER_PARAMETERS
|
|||
{ pFormat WAVEFORMATEX* }
|
||||
{ MaxFrameCount UINT32 } ;
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: XAPO_BUFFER_FLAGS
|
||||
XAPO_BUFFER_SILENT
|
||||
XAPO_BUFFER_VALID ;
|
||||
TYPEDEF: int XAPO_BUFFER_FLAGS
|
||||
|
||||
STRUCT: XAPO_PROCESS_BUFFER_PARAMETERS
|
||||
{ pBuffer void* }
|
||||
|
|
|
|||
|
|
@ -133,12 +133,11 @@ STRUCT: XAUDIO2_EFFECT_CHAIN
|
|||
{ EffectCount UINT32 }
|
||||
{ pEffectDescriptors XAUDIO2_EFFECT_DESCRIPTOR* } ;
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: XAUDIO2_FILTER_TYPE
|
||||
LowPassFilter
|
||||
BandPassFilter
|
||||
HighPassFilter
|
||||
NotchFilter ;
|
||||
TYPEDEF: int XAUDIO2_FILTER_TYPE
|
||||
|
||||
STRUCT: XAUDIO2_FILTER_PARAMETERS
|
||||
{ Type XAUDIO2_FILTER_TYPE }
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! (c)2009 Joe Groff bsd license
|
||||
USING: alien.c-types alien.data alien.libraries alien.syntax
|
||||
classes.struct kernel math system-info.windows windows.types ;
|
||||
USING: alien alien.c-types alien.data alien.libraries
|
||||
alien.syntax classes.struct kernel math system-info.windows
|
||||
windows.types ;
|
||||
IN: windows.dwmapi
|
||||
|
||||
STRUCT: MARGINS
|
||||
|
|
@ -21,7 +22,7 @@ STRUCT: DWM_BLURBEHIND
|
|||
: full-window-margins ( -- MARGINS )
|
||||
-1 -1 -1 -1 <MARGINS> ; inline
|
||||
|
||||
<< "dwmapi" "dwmapi.dll" "stdcall" add-library >>
|
||||
<< "dwmapi" "dwmapi.dll" stdcall add-library >>
|
||||
|
||||
LIBRARY: dwmapi
|
||||
|
||||
|
|
|
|||
|
|
@ -199,7 +199,7 @@ CONSTANT: THREAD_PRIORITY_LOWEST -2
|
|||
CONSTANT: THREAD_PRIORITY_NORMAL 0
|
||||
CONSTANT: THREAD_PRIORITY_TIME_CRITICAL 15
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: COMPUTER_NAME_FORMAT
|
||||
ComputerNameNetBIOS
|
||||
ComputerNameDnsHostname
|
||||
ComputerNameDnsDomain
|
||||
|
|
@ -210,8 +210,6 @@ C-ENUM:
|
|||
ComputerNamePhysicalDnsFullyQualified
|
||||
ComputerNameMax ;
|
||||
|
||||
TYPEDEF: uint COMPUTER_NAME_FORMAT
|
||||
|
||||
STRUCT: OVERLAPPED
|
||||
{ internal UINT_PTR }
|
||||
{ internal-high UINT_PTR }
|
||||
|
|
|
|||
|
|
@ -1,35 +1,35 @@
|
|||
USING: alien sequences alien.libraries ;
|
||||
{
|
||||
{ "advapi32" "advapi32.dll" "stdcall" }
|
||||
{ "dinput" "dinput8.dll" "stdcall" }
|
||||
{ "gdi32" "gdi32.dll" "stdcall" }
|
||||
{ "user32" "user32.dll" "stdcall" }
|
||||
{ "kernel32" "kernel32.dll" "stdcall" }
|
||||
{ "winsock" "ws2_32.dll" "stdcall" }
|
||||
{ "mswsock" "mswsock.dll" "stdcall" }
|
||||
{ "shell32" "shell32.dll" "stdcall" }
|
||||
{ "libc" "msvcrt.dll" "cdecl" }
|
||||
{ "libm" "msvcrt.dll" "cdecl" }
|
||||
{ "gl" "opengl32.dll" "stdcall" }
|
||||
{ "glu" "glu32.dll" "stdcall" }
|
||||
{ "ole32" "ole32.dll" "stdcall" }
|
||||
{ "usp10" "usp10.dll" "stdcall" }
|
||||
{ "psapi" "psapi.dll" "stdcall" }
|
||||
{ "xinput" "xinput1_3.dll" "stdcall" }
|
||||
{ "dxgi" "dxgi.dll" "stdcall" }
|
||||
{ "d2d1" "d2d1.dll" "stdcall" }
|
||||
{ "d3d9" "d3d9.dll" "stdcall" }
|
||||
{ "d3d10" "d3d10.dll" "stdcall" }
|
||||
{ "d3d10_1" "d3d10_1.dll" "stdcall" }
|
||||
{ "d3d11" "d3d11.dll" "stdcall" }
|
||||
{ "d3dcompiler" "d3dcompiler_42.dll" "stdcall" }
|
||||
{ "d3dcsx" "d3dcsx_42.dll" "stdcall" }
|
||||
{ "d3dx9" "d3dx9_42.dll" "stdcall" }
|
||||
{ "d3dx10" "d3dx10_42.dll" "stdcall" }
|
||||
{ "d3dx11" "d3dx11_42.dll" "stdcall" }
|
||||
{ "dwrite" "dwrite.dll" "stdcall" }
|
||||
{ "x3daudio" "x3daudio1_6.dll" "stdcall" }
|
||||
{ "xactengine" "xactengine3_5.dll" "stdcall" }
|
||||
{ "xapofx" "xapofx1_3.dll" "stdcall" }
|
||||
{ "xaudio2" "xaudio2_5.dll" "stdcall" }
|
||||
{ "advapi32" "advapi32.dll" stdcall }
|
||||
{ "dinput" "dinput8.dll" stdcall }
|
||||
{ "gdi32" "gdi32.dll" stdcall }
|
||||
{ "user32" "user32.dll" stdcall }
|
||||
{ "kernel32" "kernel32.dll" stdcall }
|
||||
{ "winsock" "ws2_32.dll" stdcall }
|
||||
{ "mswsock" "mswsock.dll" stdcall }
|
||||
{ "shell32" "shell32.dll" stdcall }
|
||||
{ "libc" "msvcrt.dll" cdecl }
|
||||
{ "libm" "msvcrt.dll" cdecl }
|
||||
{ "gl" "opengl32.dll" stdcall }
|
||||
{ "glu" "glu32.dll" stdcall }
|
||||
{ "ole32" "ole32.dll" stdcall }
|
||||
{ "usp10" "usp10.dll" stdcall }
|
||||
{ "psapi" "psapi.dll" stdcall }
|
||||
{ "xinput" "xinput1_3.dll" stdcall }
|
||||
{ "dxgi" "dxgi.dll" stdcall }
|
||||
{ "d2d1" "d2d1.dll" stdcall }
|
||||
{ "d3d9" "d3d9.dll" stdcall }
|
||||
{ "d3d10" "d3d10.dll" stdcall }
|
||||
{ "d3d10_1" "d3d10_1.dll" stdcall }
|
||||
{ "d3d11" "d3d11.dll" stdcall }
|
||||
{ "d3dcompiler" "d3dcompiler_42.dll" stdcall }
|
||||
{ "d3dcsx" "d3dcsx_42.dll" stdcall }
|
||||
{ "d3dx9" "d3dx9_42.dll" stdcall }
|
||||
{ "d3dx10" "d3dx10_42.dll" stdcall }
|
||||
{ "d3dx11" "d3dx11_42.dll" stdcall }
|
||||
{ "dwrite" "dwrite.dll" stdcall }
|
||||
{ "x3daudio" "x3daudio1_6.dll" stdcall }
|
||||
{ "xactengine" "xactengine3_5.dll" stdcall }
|
||||
{ "xapofx" "xapofx1_3.dll" stdcall }
|
||||
{ "xaudio2" "xaudio2_5.dll" stdcall }
|
||||
} [ first3 add-library ] each
|
||||
|
|
|
|||
|
|
@ -37,22 +37,23 @@ FUNCTION: HRESULT ScriptLayout (
|
|||
int* piLogicalToVisual
|
||||
) ;
|
||||
|
||||
C-ENUM: SCRIPT_JUSTIFY_NONE
|
||||
SCRIPT_JUSTIFY_ARABIC_BLANK
|
||||
SCRIPT_JUSTIFY_CHARACTER
|
||||
SCRIPT_JUSTIFY_RESERVED1
|
||||
SCRIPT_JUSTIFY_BLANK
|
||||
SCRIPT_JUSTIFY_RESERVED2
|
||||
SCRIPT_JUSTIFY_RESERVED3
|
||||
SCRIPT_JUSTIFY_ARABIC_NORMAL
|
||||
SCRIPT_JUSTIFY_ARABIC_KASHIDA
|
||||
SCRIPT_JUSTIFY_ALEF
|
||||
SCRIPT_JUSTIFY_HA
|
||||
SCRIPT_JUSTIFY_RA
|
||||
SCRIPT_JUSTIFY_BA
|
||||
SCRIPT_JUSTIFY_BARA
|
||||
SCRIPT_JUSTIFY_SEEN
|
||||
SCRIPT_JUSTIFFY_RESERVED4 ;
|
||||
C-ENUM: f
|
||||
SCRIPT_JUSTIFY_NONE
|
||||
SCRIPT_JUSTIFY_ARABIC_BLANK
|
||||
SCRIPT_JUSTIFY_CHARACTER
|
||||
SCRIPT_JUSTIFY_RESERVED1
|
||||
SCRIPT_JUSTIFY_BLANK
|
||||
SCRIPT_JUSTIFY_RESERVED2
|
||||
SCRIPT_JUSTIFY_RESERVED3
|
||||
SCRIPT_JUSTIFY_ARABIC_NORMAL
|
||||
SCRIPT_JUSTIFY_ARABIC_KASHIDA
|
||||
SCRIPT_JUSTIFY_ALEF
|
||||
SCRIPT_JUSTIFY_HA
|
||||
SCRIPT_JUSTIFY_RA
|
||||
SCRIPT_JUSTIFY_BA
|
||||
SCRIPT_JUSTIFY_BARA
|
||||
SCRIPT_JUSTIFY_SEEN
|
||||
SCRIPT_JUSTIFFY_RESERVED4 ;
|
||||
|
||||
STRUCT: SCRIPT_VISATTR
|
||||
{ flags WORD } ;
|
||||
|
|
|
|||
|
|
@ -406,4 +406,4 @@ CONSTANT: MSBFirst 1
|
|||
! * EXTENDED WINDOW MANAGER HINTS
|
||||
! *****************************************************************
|
||||
|
||||
C-ENUM: _NET_WM_STATE_REMOVE _NET_WM_STATE_ADD _NET_WM_STATE_TOGGLE ;
|
||||
C-ENUM: f _NET_WM_STATE_REMOVE _NET_WM_STATE_ADD _NET_WM_STATE_TOGGLE ;
|
||||
|
|
|
|||
|
|
@ -5,6 +5,21 @@ alien.libraries alien.c-types quotations kernel
|
|||
sequences ;
|
||||
IN: alien
|
||||
|
||||
HELP: cdecl
|
||||
{ $description "This symbol is passed as the " { $snippet "abi" } " argument to " { $link alien-indirect } ", " { $link alien-callback } ", " { $link alien-assembly } ", and " { $link add-library } " to indicate that the standard C calling convention should be used, where the caller cleans up the stack frame after calling the function. This symbol only has meaning on 32-bit x86 platforms." } ;
|
||||
|
||||
HELP: stdcall
|
||||
{ $description "This symbol is passed as the " { $snippet "abi" } " argument to " { $link alien-indirect } ", " { $link alien-callback } ", " { $link alien-assembly } ", and " { $link add-library } " to indicate that the Windows API calling convention should be used, where the called function cleans up its own stack frame before returning to the caller. This symbol only has meaning on 32-bit x86 platforms." } ;
|
||||
|
||||
HELP: fastcall
|
||||
{ $warning "In the current implementation this ABI only works for functions that take only integer and pointer arguments." }
|
||||
{ $description "This symbol is passed as the " { $snippet "abi" } " argument to " { $link alien-indirect } ", " { $link alien-callback } ", " { $link alien-assembly } ", and " { $link add-library } " to indicate that the \"fast call\" calling convention should be used, where the first two integer or pointer arguments are passed in registers and the function cleans up its own stack frame before returning to the caller. This symbol only has meaning on 32-bit x86 platforms." } ;
|
||||
|
||||
HELP: thiscall
|
||||
{ $description "This symbol is passed as the " { $snippet "abi" } " argument to " { $link alien-indirect } ", " { $link alien-callback } ", " { $link alien-assembly } ", and " { $link add-library } " to indicate that Microsoft Visual C++ calling convention should be used, where the first argument (which must be a \"this\" pointer) is passed in a register and the function cleans up its own stack frame before returning to the caller. This symbol only has meaning on 32-bit x86 platforms." } ;
|
||||
|
||||
{ cdecl stdcall fastcall thiscall } related-words
|
||||
|
||||
HELP: >c-ptr
|
||||
{ $values { "obj" object } { "c-ptr" c-ptr } }
|
||||
{ $contract "Outputs a pointer to the binary data of this object." } ;
|
||||
|
|
@ -85,7 +100,7 @@ HELP: alien-indirect-error
|
|||
} ;
|
||||
|
||||
HELP: alien-indirect
|
||||
{ $values { "args..." "zero or more objects passed to the C function" } { "funcptr" "a C function pointer" } { "return" "a C return type" } { "parameters" "a sequence of C parameter types" } { "abi" "one of " { $snippet "\"cdecl\"" } " or " { $snippet "\"stdcall\"" } } { "return..." "the return value of the function, if not " { $link void } } }
|
||||
{ $values { "args..." "zero or more objects passed to the C function" } { "funcptr" "a C function pointer" } { "return" "a C return type" } { "parameters" "a sequence of C parameter types" } { "abi" "one of " { $link cdecl } " or " { $link stdcall } } { "return..." "the return value of the function, if not " { $link void } } }
|
||||
{ $description
|
||||
"Invokes a C function pointer passed on the data stack. Input parameters are taken from the data stack following the function pointer, and the return value is pushed on the data stack after the function returns. A return type of " { $link void } " indicates that no value is to be expected."
|
||||
}
|
||||
|
|
@ -101,7 +116,7 @@ HELP: alien-callback-error
|
|||
} ;
|
||||
|
||||
HELP: alien-callback
|
||||
{ $values { "return" "a C return type" } { "parameters" "a sequence of C parameter types" } { "abi" "one of " { $snippet "\"cdecl\"" } " or " { $snippet "\"stdcall\"" } } { "quot" quotation } { "alien" alien } }
|
||||
{ $values { "return" "a C return type" } { "parameters" "a sequence of C parameter types" } { "abi" "one of " { $link cdecl } " or " { $link stdcall } } { "quot" quotation } { "alien" alien } }
|
||||
{ $description
|
||||
"Defines a callback from C to Factor which accepts the given set of parameters from the C caller, pushes them on the data stack, calls the quotation, and passes a return value back to the C caller. A return type of " { $snippet "void" } " indicates that no value is to be returned."
|
||||
$nl
|
||||
|
|
@ -114,7 +129,7 @@ HELP: alien-callback
|
|||
"A simple example, showing a C function which returns the difference of two given integers:"
|
||||
{ $code
|
||||
": difference-callback ( -- alien )"
|
||||
" int { int int } \"cdecl\" [ - ] alien-callback ;"
|
||||
" int { int int } cdecl [ - ] alien-callback ;"
|
||||
}
|
||||
}
|
||||
{ $errors "Throws an " { $link alien-callback-error } " if the word calling " { $link alien-callback } " is not compiled." } ;
|
||||
|
|
@ -128,7 +143,7 @@ HELP: alien-assembly-error
|
|||
} ;
|
||||
|
||||
HELP: alien-assembly
|
||||
{ $values { "args..." "zero or more objects passed to the C function" } { "return" "a C return type" } { "parameters" "a sequence of C parameter types" } { "abi" "one of " { $snippet "\"cdecl\"" } " or " { $snippet "\"stdcall\"" } } { "quot" quotation } { "return..." "the return value of the function, if not " { $link void } } }
|
||||
{ $values { "args..." "zero or more objects passed to the C function" } { "return" "a C return type" } { "parameters" "a sequence of C parameter types" } { "abi" "one of " { $link cdecl } " or " { $link stdcall } } { "quot" quotation } { "return..." "the return value of the function, if not " { $link void } } }
|
||||
{ $description
|
||||
"Invokes arbitrary machine code, generated at compile-time by the quotation. Input parameters are taken from the data stack, and the return value is pushed on the data stack after the function returns. A return type of " { $link void } " indicates that no value is to be expected."
|
||||
}
|
||||
|
|
|
|||
|
|
@ -64,6 +64,10 @@ M: alien equal?
|
|||
M: pinned-alien hashcode*
|
||||
nip dup expired>> [ drop 1234 ] [ alien-address ] if ;
|
||||
|
||||
SINGLETONS: stdcall thiscall fastcall cdecl mingw ;
|
||||
|
||||
UNION: abi stdcall thiscall fastcall cdecl mingw ;
|
||||
|
||||
ERROR: alien-callback-error ;
|
||||
|
||||
: alien-callback ( return parameters abi quot -- alien )
|
||||
|
|
|
|||
|
|
@ -2,12 +2,12 @@ USING: math kernel alien alien.c-types ;
|
|||
IN: benchmark.fib6
|
||||
|
||||
: fib ( x -- y )
|
||||
int { int } "cdecl" [
|
||||
int { int } cdecl [
|
||||
dup 1 <= [ drop 1 ] [
|
||||
1 - dup fib swap 1 - fib +
|
||||
] if
|
||||
] alien-callback
|
||||
int { int } "cdecl" alien-indirect ;
|
||||
int { int } cdecl alien-indirect ;
|
||||
|
||||
: fib-main ( -- ) 32 fib drop ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,8 +1,9 @@
|
|||
! Copyright (C) 2010 Erik Charlebois
|
||||
! See http:// factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien.c-types alien.syntax classes.struct combinators
|
||||
combinators.short-circuit kernel math math.order sequences
|
||||
typed specialized-arrays locals system alien.libraries ;
|
||||
USING: accessors alien alien.c-types alien.libraries
|
||||
alien.syntax classes.struct combinators combinators.short-circuit
|
||||
kernel math math.order sequences typed specialized-arrays locals
|
||||
system ;
|
||||
SPECIALIZED-ARRAY: void*
|
||||
IN: chipmunk.ffi
|
||||
|
||||
|
|
@ -11,7 +12,7 @@ IN: chipmunk.ffi
|
|||
{ [ os windows? ] [ "chipmunk.dll" ] }
|
||||
{ [ os macosx? ] [ "libchipmunk.dylib" ] }
|
||||
{ [ os unix? ] [ "libchipmunk.so" ] }
|
||||
} cond "cdecl" add-library
|
||||
} cond cdecl add-library
|
||||
|
||||
"chipmunk" deploy-library
|
||||
>>
|
||||
|
|
@ -348,12 +349,11 @@ STRUCT: cpSegmentQueryInfo
|
|||
{ t cpFloat }
|
||||
{ n cpVect } ;
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: cpShapeType
|
||||
CP_CIRCLE_SHAPE
|
||||
CP_SEGMENT_SHAPE
|
||||
CP_POLY_SHAPE
|
||||
CP_NUM_SHAPES ;
|
||||
TYPEDEF: int cpShapeType
|
||||
|
||||
CALLBACK: cpBB cacheData_cb ( cpShape* shape, cpVect p, cpVect rot ) ;
|
||||
CALLBACK: void destroy_cb ( cpShape* shape ) ;
|
||||
|
|
@ -482,11 +482,10 @@ STRUCT: cpContact
|
|||
|
||||
FUNCTION: cpContact* cpContactInit ( cpContact* con, cpVect p, cpVect n, cpFloat dist, cpHashValue hash ) ;
|
||||
|
||||
C-ENUM:
|
||||
C-ENUM: cpArbiterState
|
||||
cpArbiterStateNormal
|
||||
cpArbiterStateFirstColl
|
||||
cpArbiterStateIgnore ;
|
||||
TYPEDEF: int cpArbiterState
|
||||
|
||||
STRUCT: cpArbiter
|
||||
{ numContacts int }
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ IN: curses.ffi
|
|||
{ [ os winnt? ] [ "libcurses.dll" ] }
|
||||
{ [ os macosx? ] [ "libcurses.dylib" ] }
|
||||
{ [ os unix? ] [ "libcurses.so" ] }
|
||||
} cond "cdecl" add-library >>
|
||||
} cond cdecl add-library >>
|
||||
|
||||
C-TYPE: WINDOW
|
||||
C-TYPE: SCREEN
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
! (c)2010 Joe Groff bsd license
|
||||
USING: accessors cursors make math sequences sorting tools.test ;
|
||||
USING: accessors cursors kernel make math sequences sorting tools.test ;
|
||||
FROM: cursors => each map assoc-each assoc>map ;
|
||||
IN: cursors.tests
|
||||
|
||||
|
|
@ -12,6 +12,10 @@ IN: cursors.tests
|
|||
T{ linear-cursor f 1 1 } T{ linear-cursor f 5 1 } [ value>> 3 mod zero? ] -find
|
||||
] unit-test
|
||||
|
||||
[ T{ linear-cursor f 5 1 } ] [
|
||||
T{ linear-cursor f 1 1 } T{ linear-cursor f 5 1 } [ value>> 6 = ] -find
|
||||
] unit-test
|
||||
|
||||
[ { 1 3 } ] [
|
||||
[ T{ linear-cursor f 1 2 } T{ linear-cursor f 5 2 } [ value>> , ] -each ]
|
||||
{ } make
|
||||
|
|
|
|||
|
|
@ -1,8 +1,11 @@
|
|||
! Copyright (C) 2010 Erik Charlebois.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types alien.syntax classes.struct ;
|
||||
USING: accessors alien alien.c-types alien.strings alien.syntax arrays
|
||||
classes.struct io.encodings.ascii kernel locals math math.intervals
|
||||
sequences specialized-arrays strings typed ;
|
||||
IN: elf
|
||||
|
||||
! FFI data
|
||||
CONSTANT: EI_NIDENT 16
|
||||
CONSTANT: EI_MAG0 0
|
||||
CONSTANT: EI_MAG1 1
|
||||
|
|
@ -456,3 +459,154 @@ STRUCT: Elf32_Dyn
|
|||
STRUCT: Elf64_Dyn
|
||||
{ d_tag Elf64_Sxword }
|
||||
{ d_val Elf64_Xword } ;
|
||||
|
||||
! Low-level interface
|
||||
SPECIALIZED-ARRAYS: Elf32_Shdr Elf64_Shdr Elf32_Sym Elf64_Sym Elf32_Phdr Elf64_Phdr uchar ;
|
||||
UNION: Elf32/64_Ehdr Elf32_Ehdr Elf64_Ehdr ;
|
||||
UNION: Elf32/64_Shdr Elf32_Shdr Elf64_Shdr ;
|
||||
UNION: Elf32/64_Shdr-array Elf32_Shdr-array Elf64_Shdr-array ;
|
||||
UNION: Elf32/64_Sym Elf32_Sym Elf64_Sym ;
|
||||
UNION: Elf32/64_Sym-array Elf32_Sym-array Elf64_Sym-array ;
|
||||
UNION: Elf32/64_Phdr Elf32_Phdr Elf64_Phdr ;
|
||||
UNION: Elf32/64_Phdr-array Elf32_Phdr-array Elf64_Phdr-array ;
|
||||
|
||||
TYPED: 64-bit? ( elf: Elf32/64_Ehdr -- ? )
|
||||
e_ident>> EI_CLASS swap nth ELFCLASS64 = ;
|
||||
|
||||
TYPED: elf-header ( c-ptr -- elf: Elf32/64_Ehdr )
|
||||
[ Elf64_Ehdr memory>struct 64-bit? ] keep swap
|
||||
[ Elf64_Ehdr memory>struct ]
|
||||
[ Elf32_Ehdr memory>struct ] if ;
|
||||
|
||||
TYPED:: elf-section-headers ( elf: Elf32/64_Ehdr -- headers: Elf32/64_Shdr-array )
|
||||
elf [ e_shoff>> ] [ e_shnum>> ] bi :> ( off num )
|
||||
off elf >c-ptr <displaced-alien> num
|
||||
elf 64-bit?
|
||||
[ <direct-Elf64_Shdr-array> ]
|
||||
[ <direct-Elf32_Shdr-array> ] if ;
|
||||
|
||||
TYPED:: elf-program-headers ( elf: Elf32/64_Ehdr -- headers: Elf32/64_Phdr-array )
|
||||
elf [ e_phoff>> ] [ e_phnum>> ] bi :> ( off num )
|
||||
off elf >c-ptr <displaced-alien> num
|
||||
elf 64-bit?
|
||||
[ <direct-Elf64_Phdr-array> ]
|
||||
[ <direct-Elf32_Phdr-array> ] if ;
|
||||
|
||||
TYPED: elf-loadable-segments ( headers: Elf32/64_Phdr-array -- headers: Elf32/64_Phdr-array )
|
||||
[ p_type>> PT_LOAD = ] filter ;
|
||||
|
||||
TYPED:: elf-segment-sections ( segment: Elf32/64_Phdr sections: Elf32/64_Shdr-array -- sections )
|
||||
segment [ p_offset>> dup ] [ p_filesz>> + ] bi [a,b) :> segment-interval
|
||||
sections [ dup [ sh_offset>> dup ] [ sh_size>> + ] bi [a,b) 2array ] { } map-as :> section-intervals
|
||||
section-intervals [ second segment-interval interval-intersect empty-interval = not ]
|
||||
filter [ first ] map ;
|
||||
|
||||
TYPED:: virtual-address-segment ( elf: Elf32/64_Ehdr address -- program-header/f )
|
||||
elf elf-program-headers elf-loadable-segments [
|
||||
[ p_vaddr>> dup ] [ p_memsz>> + ] bi [a,b)
|
||||
address swap interval-contains?
|
||||
] filter [ f ] [ first ] if-empty ;
|
||||
|
||||
TYPED:: virtual-address-section ( elf: Elf32/64_Ehdr address -- section-header/f )
|
||||
elf address virtual-address-segment :> segment
|
||||
segment elf elf-section-headers elf-segment-sections :> sections
|
||||
address segment p_vaddr>> - segment p_offset>> + :> faddress
|
||||
sections [
|
||||
[ sh_offset>> dup ] [ sh_size>> + ] bi [a,b)
|
||||
faddress swap interval-contains?
|
||||
] filter [ f ] [ first ] if-empty ;
|
||||
|
||||
TYPED:: elf-segment-data ( elf: Elf32/64_Ehdr header: Elf32/64_Phdr -- uchar-array/f )
|
||||
header [ p_offset>> elf >c-ptr <displaced-alien> ] [ p_filesz>> ] bi <direct-uchar-array> ;
|
||||
|
||||
TYPED:: elf-section-data ( elf: Elf32/64_Ehdr header: Elf32/64_Shdr -- uchar-array/f )
|
||||
header [ sh_offset>> elf >c-ptr <displaced-alien> ] [ sh_size>> ] bi <direct-uchar-array> ;
|
||||
|
||||
TYPED:: elf-section-data-by-index ( elf: Elf32/64_Ehdr index -- header/f uchar-array/f )
|
||||
elf elf-section-headers :> sections
|
||||
index sections nth :> header
|
||||
elf header elf-section-data :> data
|
||||
header data ;
|
||||
|
||||
TYPED:: elf-section-name ( elf: Elf32/64_Ehdr header: Elf32/64_Shdr -- name: string )
|
||||
elf elf e_shstrndx>> elf-section-data-by-index nip >c-ptr :> section-names
|
||||
header sh_name>> section-names <displaced-alien> ascii alien>string ;
|
||||
|
||||
TYPED:: elf-section-data-by-name ( elf: Elf32/64_Ehdr name: string -- header/f uchar-array/f )
|
||||
elf elf-section-headers :> sections
|
||||
elf e_shstrndx>> :> ndx
|
||||
elf ndx sections nth elf-section-data >c-ptr :> section-names
|
||||
sections 1 tail [
|
||||
sh_name>> section-names <displaced-alien> ascii alien>string name =
|
||||
] find nip
|
||||
[ dup elf swap elf-section-data ]
|
||||
[ f f ] if* ;
|
||||
|
||||
TYPED:: elf-sections ( elf: Elf32/64_Ehdr -- sections )
|
||||
elf elf-section-headers :> sections
|
||||
elf elf e_shstrndx>> elf-section-data-by-index nip >c-ptr :> section-names
|
||||
sections [
|
||||
[ sh_name>> section-names <displaced-alien>
|
||||
ascii alien>string ] keep 2array
|
||||
] { } map-as ;
|
||||
|
||||
TYPED:: elf-symbols ( elf: Elf32/64_Ehdr section-data: uchar-array -- symbols )
|
||||
elf ".strtab" elf-section-data-by-name nip >c-ptr :> strings
|
||||
section-data [ >c-ptr ] [ length ] bi
|
||||
elf 64-bit?
|
||||
[ Elf64_Sym heap-size / <direct-Elf64_Sym-array> ]
|
||||
[ Elf32_Sym heap-size / <direct-Elf32_Sym-array> ] if
|
||||
[ [ st_name>> strings <displaced-alien> ascii alien>string ] keep 2array ] { } map-as ;
|
||||
|
||||
! High level interface
|
||||
TUPLE: elf elf-header ;
|
||||
TUPLE: section name elf-header section-header data ;
|
||||
TUPLE: segment elf-header program-header data ;
|
||||
TUPLE: symbol name elf-header sym data ;
|
||||
|
||||
GENERIC: sections ( obj -- sections )
|
||||
|
||||
: <elf> ( c-ptr -- elf )
|
||||
elf-header elf boa ;
|
||||
|
||||
M:: elf sections ( elf -- sections )
|
||||
elf elf-header>> elf-sections
|
||||
[
|
||||
first2 :> ( name header )
|
||||
elf elf-header>> header elf-section-data :> data
|
||||
name elf elf-header>> header data section boa
|
||||
] { } map-as ;
|
||||
|
||||
:: segments ( elf -- segments )
|
||||
elf elf-header>> elf-program-headers
|
||||
[| header |
|
||||
elf elf-header>> header elf-segment-data :> data
|
||||
elf elf-header>> header data segment boa
|
||||
] { } map-as ;
|
||||
|
||||
M:: segment sections ( segment -- sections )
|
||||
segment program-header>>
|
||||
segment elf-header>> elf-section-headers
|
||||
elf-segment-sections
|
||||
|
||||
[| header |
|
||||
segment elf-header>> header elf-section-name :> name
|
||||
segment elf-header>> header elf-section-data :> data
|
||||
name segment elf-header>> header data section boa
|
||||
] { } map-as ;
|
||||
|
||||
:: symbols ( section -- symbols )
|
||||
section elf-header>>
|
||||
section data>>
|
||||
elf-symbols
|
||||
[
|
||||
first2 :> ( name sym )
|
||||
name section elf-header>> sym f symbol boa
|
||||
] { } map-as ;
|
||||
|
||||
:: symbol-data ( symbol -- data )
|
||||
symbol [ elf-header>> ] [ sym>> st_value>> ] bi virtual-address-segment :> segment
|
||||
symbol sym>> st_value>> segment p_vaddr>> - segment p_offset>> + :> faddress
|
||||
faddress symbol elf-header>> >c-ptr <displaced-alien>
|
||||
symbol sym>> st_size>> <direct-uchar-array> ;
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Erik Charlebois
|
||||
Binary file not shown.
|
|
@ -0,0 +1,120 @@
|
|||
! Copyright (C) 2010 Erik Charlebois.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays classes.struct destructors game.loop
|
||||
game.worlds gpu gpu.buffers gpu.effects.blur gpu.framebuffers
|
||||
gpu.render gpu.shaders gpu.state gpu.textures gpu.util images
|
||||
images.loader kernel literals locals make math math.rectangles
|
||||
math.vectors namespaces opengl.gl sequences specialized-arrays
|
||||
ui.gadgets.worlds ui.gestures ui.pixel-formats gpu.effects.step
|
||||
images.pgm images.ppm ;
|
||||
FROM: alien.c-types => float ;
|
||||
SPECIALIZED-ARRAY: float
|
||||
IN: fluids
|
||||
|
||||
STRUCT: particle_t
|
||||
{ p float[2] }
|
||||
{ v float[2] }
|
||||
{ m float } ;
|
||||
SPECIALIZED-ARRAY: particle_t
|
||||
|
||||
CONSTANT: gravity { 0.0 -0.1 }
|
||||
|
||||
:: verlet-integrate-particle ( particle dt -- particle' )
|
||||
particle [ p>> ] [ v>> ] bi dt v*n v+
|
||||
gravity dt dt * particle m>> 2 * / v*n v+ :> p'
|
||||
p' particle p>> v- dt v/n :> v'
|
||||
p' v' particle m>> particle_t <struct-boa> ; inline
|
||||
|
||||
CONSTANT: initial-particles
|
||||
particle_t-array{
|
||||
S{ particle_t f float-array{ 0.5 0.6 } float-array{ 0 0.1 } 1.0 }
|
||||
S{ particle_t f float-array{ 0.5 0.6 } float-array{ 0.1 0 } 3.0 }
|
||||
|
||||
S{ particle_t f float-array{ 0.5 0.5 } float-array{ 0.1 0.1 } 2.0 }
|
||||
S{ particle_t f float-array{ 0.5 0.6 } float-array{ -0.1 0 } 1.0 }
|
||||
S{ particle_t f float-array{ 0.6 0.5 } float-array{ 0 -0.1 } 3.0 }
|
||||
S{ particle_t f float-array{ 0.7 0.5 } float-array{ 0.1 0.1 } 1.0 }
|
||||
S{ particle_t f float-array{ 0.1 0.5 } float-array{ -0.1 -0.1 } 5.0 }
|
||||
S{ particle_t f float-array{ 0.2 0.5 } float-array{ 0 0 } 1.0 }
|
||||
S{ particle_t f float-array{ 0.3 0.3 } float-array{ 0 0 } 4.0 }
|
||||
S{ particle_t f float-array{ 0.5 0.15 } float-array{ 0 0 } 1.0 }
|
||||
S{ particle_t f float-array{ 0.5 0.1 } float-array{ 0 0 } 9.0 }
|
||||
}
|
||||
|
||||
: integrate-particles! ( particles dt -- particles )
|
||||
[ verlet-integrate-particle ] curry map! ;
|
||||
|
||||
TUPLE: fluids-world < game-world
|
||||
particles texture ramp { paused boolean initial: f } ;
|
||||
|
||||
: make-texture ( pathname -- texture )
|
||||
load-image
|
||||
[
|
||||
[ component-order>> ]
|
||||
[ component-type>> ] bi
|
||||
T{ texture-parameters
|
||||
{ wrap clamp-texcoord-to-edge }
|
||||
{ min-filter filter-nearest }
|
||||
{ mag-filter filter-nearest }
|
||||
{ min-mipmap-filter f } }
|
||||
<texture-2d>
|
||||
]
|
||||
[
|
||||
0 swap [ allocate-texture-image ] 3keep 2drop
|
||||
] bi ;
|
||||
|
||||
SYMBOL: fluid
|
||||
|
||||
: integrate ( world -- )
|
||||
particles>> $[ 60 fps 1000000 /f ] integrate-particles! drop ;
|
||||
|
||||
: pause ( -- )
|
||||
fluid get [ not ] change-paused drop ;
|
||||
|
||||
: step ( -- )
|
||||
fluid get paused>> [ fluid get integrate ] when ;
|
||||
|
||||
M: fluids-world begin-game-world
|
||||
dup fluid set
|
||||
init-gpu
|
||||
initial-particles clone >>particles
|
||||
"resource:extra/fluids/particle2.pgm" make-texture >>texture
|
||||
"resource:extra/fluids/colors.ppm" make-texture >>ramp
|
||||
drop ;
|
||||
|
||||
M: fluids-world end-game-world
|
||||
drop ;
|
||||
|
||||
M: fluids-world tick-game-world
|
||||
dup paused>> [ drop ] [ integrate ] if ;
|
||||
|
||||
M:: fluids-world draw-world* ( world -- )
|
||||
world particles>> [
|
||||
[ p>> [ first , ] [ second , ] bi ] each
|
||||
] curry float-array{ } make :> verts
|
||||
|
||||
[
|
||||
verts world texture>> 30.0 world dim>> { 4 4 } v/
|
||||
blended-point-sprite-batch &dispose
|
||||
blend-state new set-gpu-state
|
||||
gaussian-blur &dispose
|
||||
world ramp>> world dim>> step-texture &dispose
|
||||
world dim>> draw-texture
|
||||
] with-destructors ;
|
||||
|
||||
GAME: fluids {
|
||||
{ world-class fluids-world }
|
||||
{ title "Fluids Test" }
|
||||
{ pixel-format-attributes {
|
||||
windowed double-buffered T{ depth-bits { value 24 } } } }
|
||||
{ pref-dim { 1024 768 } }
|
||||
{ tick-interval-micros $[ 60 fps ] }
|
||||
} ;
|
||||
|
||||
fluids-world H{
|
||||
{ T{ button-down } [ [
|
||||
hand-loc get >float-array
|
||||
world get dim>> >float-array v/ 2 v*n 1 v-n { 1 -1 } v*
|
||||
float-array{ 0 0.2 } 2.0 particle_t <struct-boa> suffix
|
||||
] change-particles drop ] }
|
||||
} set-gestures
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue