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

Nmakefile

@@ -1,17 +1,27 @@
-!IF DEFINED(DEBUG)
+!IF DEFINED(PLATFORM)
-LINK_FLAGS = /nologo /safeseh /DEBUG shell32.lib
+
-CL_FLAGS = /nologo /Zi /O2 /W3 /DFACTOR_DEBUG
+LINK_FLAGS = /nologo shell32.lib
-!ELSE
-LINK_FLAGS = /nologo /safeseh 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

basis/alien/fortran/fortran.factor

@@ -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
+    "I77" "libI77.so" cdecl add-library
-    "F77" "libF77.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: f2c-abi fortran-c-abi cdecl ;
-M: g95-abi fortran-c-abi "cdecl" ;
+M: g95-abi fortran-c-abi cdecl ;
-M: gfortran-abi fortran-c-abi "cdecl" ;
+M: gfortran-abi fortran-c-abi cdecl ;
-M: intel-unix-abi fortran-c-abi "cdecl" ;
+M: intel-unix-abi fortran-c-abi cdecl ;
-M: intel-windows-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 ;

basis/alien/libraries/libraries-docs.factor

@@ -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 macosx? ] [ \"libfreetype.6.dylib\" cdecl add-library ] }"
-    "    { [ os windows? ] [ \"freetype6.dll\" \"cdecl\" add-library ] }"
+    "    { [ os windows? ] [ \"freetype6.dll\" cdecl add-library ] }"
     "    [ drop ]"
     "} cond >>"
 }

basis/alien/libraries/libraries.factor

@@ -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
 

basis/alien/parser/parser.factor

@@ -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 )
+: (CREATE-C-TYPE) ( word -- word )
-    scan validate-c-type-name current-vocab create {
+    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 ;
 

basis/alien/remote-control/remote-control.factor

@@ -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

basis/alien/syntax/syntax-docs.factor

@@ -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... ;" }
+{ $syntax "C-ENUM: type/f words... ;" }
-{ $values { "words" "a sequence of word names" } }
+{ $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 its index in the enumeration definition. The first word pushes 0." }
+{ $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:

basis/alien/syntax/syntax.factor

@@ -25,8 +25,10 @@ SYNTAX: TYPEDEF:
     scan-c-type CREATE-C-TYPE dup save-location typedef ;
 
 SYNTAX: C-ENUM:
-    ";" parse-tokens
+    scan dup "f" =
-    [ [ create-in ] dip define-constant ] each-index ;
+    [ drop ]
+    [ (CREATE-C-TYPE) dup save-location int swap typedef ] if
+    0 parse-enum-members ;
 
 SYNTAX: C-TYPE:
     void CREATE-C-TYPE typedef ;

basis/cairo/ffi/ffi.factor

@@ -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 winnt? ] [ "cairo" "libcairo-2.dll" cdecl add-library ] }
-    { [ os macosx? ] [ "cairo" "/opt/local/lib/libcairo.dylib" "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: cairo_status_t
-C-ENUM:
     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: cairo_operator_t
-C-ENUM:
     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: cairo_antialias_t
-C-ENUM:
     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: cairo_fill_rule_t
-C-ENUM:
     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: cairo_line_cap_t
-C-ENUM:
     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: cairo_line_join_t
-C-ENUM:
     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: cairo_font_slant_t
-C-ENUM:
     CAIRO_FONT_SLANT_NORMAL
     CAIRO_FONT_SLANT_ITALIC
     CAIRO_FONT_SLANT_OBLIQUE ;
 
-TYPEDEF: int cairo_font_weight_t
+C-ENUM: cairo_font_weight_t
-C-ENUM:
     CAIRO_FONT_WEIGHT_NORMAL
     CAIRO_FONT_WEIGHT_BOLD ;
 
-TYPEDEF: int cairo_subpixel_order_t
+C-ENUM: cairo_subpixel_order_t
-C-ENUM:
     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: cairo_hint_style_t
-C-ENUM:
     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: cairo_hint_metrics_t
-C-ENUM:
     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: cairo_font_type_t
-C-ENUM:
     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: cairo_path_data_type_t
-C-ENUM:
     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: cairo_surface_type_t
-C-ENUM:
     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: cairo_format_t
-C-ENUM:
     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: cairo_pattern_type_t
-C-ENUM:
     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: cairo_extend_t
-C-ENUM:
     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: cairo_filter_t
-C-ENUM:
     CAIRO_FILTER_FAST
     CAIRO_FILTER_GOOD
     CAIRO_FILTER_BEST

basis/cocoa/application/application.factor

@@ -8,7 +8,7 @@ IN: cocoa.application
 
 : <NSString> ( str -- alien ) <CFString> -> autorelease ;
 
-C-ENUM:
+C-ENUM: f
 NSApplicationDelegateReplySuccess
 NSApplicationDelegateReplyCancel
 NSApplicationDelegateReplyFailure ;

basis/cocoa/subclassing/subclassing.factor

@@ -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 )

basis/compiler/alien/alien.factor

@@ -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 ;

basis/compiler/cfg/builder/builder-tests.factor

@@ -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-indirect ]
-    [ int { int } "cdecl" [ ] alien-callback ]
+    [ int { int } cdecl [ ] alien-callback ]
     [ swap - + * ]
     [ swap slot ]
     [ blahblah ]

basis/compiler/codegen/codegen.factor

@@ -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 )
+:: alloc-parameter ( parameter abi -- reg rep )
-    c-type-rep dup reg-class-of reg-class-full?
+    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 ]
+    [ [ alien-parameters flatten-value-types ] [ abi>> ] bi ]
-    [ '[ alloc-parameter _ execute ] ]
+    [ '[ _ 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 ;
 

basis/compiler/tests/alien.factor

@@ -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
+compiler continuations effects generalizations io
-io.streams.string kernel math memory namespaces
+io.backend io.pathnames io.streams.string kernel
-namespaces.private parser quotations sequences
+math memory namespaces namespaces.private parser
-specialized-arrays stack-checker stack-checker.errors
+quotations sequences specialized-arrays stack-checker
-system threads tools.test words alien.complex concurrency.promises ;
+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

basis/compiler/tests/redefine24.factor

@@ -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 ;

basis/compression/zlib/ffi/ffi.factor

@@ -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
 

basis/core-foundation/run-loop/run-loop.factor

@@ -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 ( -- )

basis/core-graphics/core-graphics.factor

@@ -6,8 +6,7 @@ images images.memory core-graphics.types core-foundation.utilities
 opengl.gl literals ;
 IN: core-graphics
 
-! CGImageAlphaInfo
+C-ENUM: CGImageAlphaInfo
-C-ENUM:
 kCGImageAlphaNone
 kCGImageAlphaPremultipliedLast
 kCGImageAlphaPremultipliedFirst

basis/cpu/architecture/architecture.factor

@@ -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 ;

basis/cpu/ppc/linux/linux.factor

@@ -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 ;
 

basis/cpu/ppc/macosx/macosx.factor

@@ -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 ;
 

basis/cpu/ppc/ppc.factor

@@ -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?>> ;
 

basis/cpu/x86/32/32-tests.factor

@@ -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

basis/cpu/x86/32/32.factor

@@ -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
+USING: locals alien alien.c-types alien.libraries alien.syntax
-kernel fry math namespaces sequences system layouts io
+arrays kernel fry math namespaces sequences system layouts io
-vocabs.loader accessors init combinators command-line make
+vocabs.loader accessors init classes.struct combinators command-line
-compiler compiler.units compiler.constants compiler.alien
+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 2drop { } ;
-M: float-regs param-regs drop { } ;
+
+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
+M: stack-params copy-register*
-    stack-params assert=
+    drop
-    [ [ EAX ] dip local@ MOV ] dip
+    {
-    stack@ EAX MOV ;
+        { [ 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 -- )
+: callee-cleanup? ( abi -- ? )
-    #! a) If we just called an stdcall function in Windows, it
+    { stdcall fastcall thiscall } member? ;
-    #! cleaned up the stack frame for us. But we don't want that
+
-    #! so we 'undo' the cleanup since we do that in %epilogue.
+: stack-arg-size ( params -- n )
-    #! b) If we just called a function returning a struct, we
+    dup abi>> '[
-    #! have to fix ESP.
+        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 abi>> callee-cleanup? ] [ stack-arg-size ] }
-        { [ dup funny-large-struct-return? ] [ drop EAX PUSH ] }
+        { [ dup funny-large-struct-return? ] [ drop 4 ] }
-        [ drop ]
+        [ 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

basis/cpu/x86/32/bootstrap.factor

@@ -13,15 +13,16 @@ IN: bootstrap.x86
 : div-arg ( -- reg ) EAX ;
 : mod-arg ( -- reg ) EDX ;
 : temp0 ( -- reg ) EAX ;
-: temp1 ( -- reg ) EDX ;
+: temp1 ( -- reg ) ECX ;
-: temp2 ( -- reg ) ECX ;
+: temp2 ( -- reg ) EBX ;
-: temp3 ( -- 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
+    ECX ESP -4 [+] LEA
-    ctx-reg context-callstack-top-offset [+] EDX MOV
+    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
+    temp2 temp3 callstack-length-offset [+] MOV
-    EDX tag-bits get SHR
+    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
+    temp2 PUSH
-    EBP PUSH
+    temp1 PUSH
-    EAX 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

basis/cpu/x86/64/64-tests.factor

@@ -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 ;

basis/cpu/x86/64/64.factor

@@ -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-0 ( -- reg ) 0 int-regs cdecl param-reg ; inline
-: param-reg-1 ( -- reg ) 1 int-regs param-reg ; inline
+: param-reg-1 ( -- reg ) 1 int-regs cdecl param-reg ; inline
-: param-reg-2 ( -- reg ) 2 int-regs param-reg ; inline
+: param-reg-2 ( -- reg ) 2 int-regs cdecl param-reg ; inline
-: param-reg-3 ( -- reg ) 3 int-regs 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

basis/cpu/x86/64/bootstrap.factor

@@ -11,10 +11,11 @@ IN: bootstrap.x86
 : shift-arg ( -- reg ) RCX ;
 : div-arg ( -- reg ) RAX ;
 : mod-arg ( -- reg ) RDX ;
-: temp0 ( -- reg ) RDI ;
+: temp0 ( -- reg ) RAX ;
-: temp1 ( -- reg ) RSI ;
+: 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
 

basis/cpu/x86/64/unix/unix.factor

@@ -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
+    (flatten-stack-type) ;
-    cell /i \ (stack-value) c-type <repetition> ;
 
 : flatten-struct ( c-type -- seq )
     dup heap-size 16 > [

basis/cpu/x86/64/winnt/winnt.factor

@@ -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 ;
 

basis/cpu/x86/bootstrap.factor

@@ -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
+    ! On x86-32 fastcall, and x86-64, some arguments are passed
-    ! so the only register that is safe for use here is nv-reg.
+    ! 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
+    ! Callbacks which return structs, or use stdcall/fastcall/thiscall,
-    ! parameter here. See the comment in callback-return-rewind
+    ! need a parameter here.
-    ! in cpu.x86.32
+
+    ! 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
+    temp2 temp3 MOV
-    ! compute positive shift value in temp1
+    ! compute positive shift value in temp2
-    temp1 CL SHL
+    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
+    ! if shift count was negative, move temp0 to temp2
-    temp1 temp3 CMOVGE
+    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

basis/cpu/x86/features/features.factor

@@ -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

basis/cpu/x86/x86.factor

@@ -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 ;
 

basis/db/postgresql/ffi/ffi.factor

@@ -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

basis/db/sqlite/ffi/ffi.factor

@@ -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

basis/glib/glib.factor

@@ -8,14 +8,14 @@ IN: glib
 <<
 
 {
-    { [ os winnt? ] [ "glib" "libglib-2.0-0.dll" "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 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 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 macosx? ] [ "gobject" "/opt/local/lib/libgobject-2.0.0.dylib" cdecl add-library ] }
     { [ os unix? ] [ ] }
 } cond
 

basis/images/pgm/authors.txt

@@ -0,0 +1 @@
+Erik Charlebois

basis/images/pgm/pgm-tests.factor

@@ -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

basis/images/pgm/pgm.factor

@@ -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 ;

basis/images/pgm/summary.txt

@@ -0,0 +1 @@
+Image loading for PGM image files.

basis/images/ppm/authors.txt

@@ -0,0 +1 @@
+Erik Charlebois

basis/images/ppm/ppm-tests.factor

@@ -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

basis/images/ppm/ppm.factor

@@ -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 ;

basis/images/ppm/summary.txt

@@ -0,0 +1 @@
+Image loading for PPM image files.

basis/io/backend/unix/multiplexers/run-loop/run-loop.factor

@@ -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

basis/io/monitors/recursive/recursive.factor

@@ -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? [
+    receive {
-        drop stop-pump
+        { [ 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 ;

basis/io/sockets/secure/openssl/openssl.factor

@@ -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
 

basis/io/sockets/windows/nt/nt.factor

@@ -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 -- )

basis/math/floats/env/x86/32/32.factor

@@ -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

basis/math/floats/env/x86/64/64.factor

@@ -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" [
+    void { void* } cdecl [
-        int-regs param-regs first [] STMXCSR
+        int-regs cdecl param-regs first [] STMXCSR
     ] alien-assembly ;
 
 M: x86.64 set-sse-env
-    void { void* } "cdecl" [
+    void { void* } cdecl [
-        int-regs param-regs first [] LDMXCSR
+        int-regs cdecl param-regs first [] LDMXCSR
     ] alien-assembly ;
 
 M: x86.64 get-x87-env
-    void { void* } "cdecl" [
+    void { void* } cdecl [
-        int-regs param-regs first [] FNSTSW
+        int-regs cdecl param-regs first [] FNSTSW
-        int-regs param-regs first 2 [+] FNSTCW
+        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 ;

basis/opengl/gl/macosx/macosx.factor

@@ -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

basis/opengl/gl/unix/unix.factor

@@ -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

basis/opengl/gl/windows/windows.factor

@@ -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

basis/openssl/libcrypto/libcrypto.factor

@@ -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 winnt? ] [ "libcrypto" "libeay32.dll" cdecl add-library ] }
-    { [ os macosx? ] [ "libcrypto" "libcrypto.dylib" "cdecl" add-library ] }
+    { [ os macosx? ] [ "libcrypto" "libcrypto.dylib" cdecl add-library ] }
-    { [ os unix? ] [ "libcrypto" "libcrypto.so" "cdecl" add-library ] }
+    { [ os unix? ] [ "libcrypto" "libcrypto.so" cdecl add-library ] }
 } cond
 >>
 

basis/openssl/libssl/libssl.factor

@@ -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 winnt? ] [ "libssl" "ssleay32.dll" cdecl add-library ] }
-    { [ os macosx? ] [ "libssl" "libssl.dylib" "cdecl" add-library ] }
+    { [ os macosx? ] [ "libssl" "libssl.dylib" cdecl add-library ] }
-    { [ os unix? ] [ "libssl" "libssl.so" "cdecl" add-library ] }
+    { [ os unix? ] [ "libssl" "libssl.so" cdecl add-library ] }
 } cond >>
 
 CONSTANT: X509_FILETYPE_PEM       1

basis/pango/cairo/cairo.factor

@@ -12,8 +12,8 @@ classes.struct cairo cairo.ffi ;
 IN: pango.cairo
 
 << {
-    { [ os winnt? ] [ "pangocairo" "libpangocairo-1.0-0.dll" "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 macosx? ] [ "pangocairo" "/opt/local/lib/libpangocairo-1.0.0.dylib" cdecl add-library ] }
     { [ os unix? ] [ ] }
 } cond >>
 

basis/pango/fonts/fonts.factor

@@ -8,8 +8,7 @@ IN: pango.fonts
 
 LIBRARY: pango
 
-TYPEDEF: int PangoStyle
+C-ENUM: PangoStyle
-C-ENUM:
 PANGO_STYLE_NORMAL
 PANGO_STYLE_OBLIQUE
 PANGO_STYLE_ITALIC ;

basis/pango/pango.factor

@@ -11,8 +11,8 @@ IN: pango
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 << {
-    { [ os winnt? ] [ "pango" "libpango-1.0-0.dll" "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 macosx? ] [ "pango" "/opt/local/lib/libpango-1.0.0.dylib" cdecl add-library ] }
     { [ os unix? ] [ ] }
 } cond >>
 

basis/stack-checker/alien/alien.factor

@@ -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
+    [ xt>> ] [ stack-cleanup ] bi '[ _ _ callback-xt ] infer-quot-here ;
-    '[ _ _ callback-xt ] infer-quot-here ;
 
 : infer-alien-callback ( -- )
     alien-callback-params new

basis/tools/deploy/test/9/9.factor

@@ -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

basis/tools/disassembler/disassembler.factor

@@ -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 ;
 

basis/tools/disassembler/udis/udis.factor

@@ -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

basis/tools/profiler/profiler-tests.factor

@@ -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 ( -- ) ;
 

basis/ui/backend/windows/windows.factor

@@ -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

basis/ui/gadgets/grids/grids-docs.factor

@@ -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> }

basis/unicode/breaks/breaks.factor

@@ -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?

basis/unix/ffi/ffi.factor

@@ -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

basis/vm/vm.factor

@@ -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

basis/windows/advapi32/advapi32.factor

@@ -146,8 +146,7 @@ CONSTANT: TokenSessionReference 14
 CONSTANT: TokenSandBoxInert 15
 ! } TOKEN_INFORMATION_CLASS;
 
-TYPEDEF: DWORD ACCESS_MODE
+C-ENUM: ACCESS_MODE
-C-ENUM:
     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: MULTIPLE_TRUSTEE_OPERATION
-C-ENUM:
     NO_MULTIPLE_TRUSTEE
     TRUSTEE_IS_IMPERSONATE ;
 
-TYPEDEF: DWORD TRUSTEE_FORM
+C-ENUM: TRUSTEE_FORM
-C-ENUM:
   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: TRUSTEE_TYPE
-C-ENUM:
     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: SE_OBJECT_TYPE
-C-ENUM:
     SE_UNKNOWN_OBJECT_TYPE
     SE_FILE_OBJECT
     SE_SERVICE

basis/windows/ce/ce.factor

@@ -1,14 +1,14 @@
 USING: alien sequences alien.libraries ;
 {
-    { "advapi32" "\\windows\\coredll.dll" "stdcall" }
+    { "advapi32" "\\windows\\coredll.dll" stdcall }
-    { "gdi32"    "\\windows\\coredll.dll" "stdcall" }
+    { "gdi32"    "\\windows\\coredll.dll" stdcall }
-    { "user32"   "\\windows\\coredll.dll" "stdcall" }
+    { "user32"   "\\windows\\coredll.dll" stdcall }
-    { "kernel32" "\\windows\\coredll.dll" "stdcall" }
+    { "kernel32" "\\windows\\coredll.dll" stdcall }
-    { "winsock"  "\\windows\\ws2.dll" "stdcall" }
+    { "winsock"  "\\windows\\ws2.dll" stdcall }
-    { "mswsock"  "\\windows\\ws2.dll" "stdcall" }
+    { "mswsock"  "\\windows\\ws2.dll" stdcall }
-    { "libc"     "\\windows\\coredll.dll" "stdcall"   }
+    { "libc"     "\\windows\\coredll.dll" stdcall   }
-    { "libm"     "\\windows\\coredll.dll" "stdcall"   }
+    { "libm"     "\\windows\\coredll.dll" stdcall   }
-    ! { "gl"       "libGLES_CM.dll"         "stdcall" }
+    ! { "gl"       "libGLES_CM.dll"         stdcall }
-    ! { "glu"      "libGLES_CM.dll"         "stdcall" }
+    ! { "glu"      "libGLES_CM.dll"         stdcall }
-    { "ole32"    "ole32.dll"    "stdcall" }
+    { "ole32"    "ole32.dll"    stdcall }
 } [ first3 add-library ] each

basis/windows/com/syntax/syntax.factor

@@ -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 ;

basis/windows/com/wrapper/wrapper.factor

@@ -114,7 +114,7 @@ unless
         ] [
             first2 (finish-thunk)
         ] bi*
-        "stdcall" swap compile-alien-callback
+        stdcall swap compile-alien-callback
     ] 2map ;
 
 : (make-callbacks) ( implementations -- sequence )

basis/windows/ddk/hid/hid.factor

@@ -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
+USING: alien alien.c-types alien.libraries alien.syntax
-kernel math windows.types windows.ole32 ;
+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 } ;

basis/windows/ddk/setupapi/setupapi.factor

@@ -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
+USING: literals windows.kernel32 math alien.syntax windows.types
-alien.c-types windows.errors windows.ole32 windows.advapi32 alien.libraries ;
+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 ) ;

basis/windows/ddk/winusb/winusb.factor

@@ -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
+USING: alien alien.c-types alien.syntax classes.struct
-windows.types alien.libraries ;
+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 }

basis/windows/directx/d3d11shader/d3d11shader.factor

@@ -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

basis/windows/directx/d3d9types/d3d9types.factor

@@ -502,8 +502,7 @@ CONSTANT: MAXD3DDECLUSAGE         13
 CONSTANT: MAXD3DDECLUSAGEINDEX    15
 CONSTANT: MAXD3DDECLLENGTH        64
 
-TYPEDEF: int D3DDECLMETHOD
+C-ENUM: D3DDECLMETHOD
-C-ENUM:
     D3DDECLMETHOD_DEFAULT
     D3DDECLMETHOD_PARTIALU
     D3DDECLMETHOD_PARTIALV

basis/windows/directx/d3dcsx/d3dcsx.factor

@@ -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

basis/windows/directx/d3dx9shader/d3dx9shader.factor

@@ -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

basis/windows/directx/dcommon/dcommon.factor

@@ -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

basis/windows/directx/dwrite/dwrite.factor

@@ -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
+C-ENUM: DWRITE_FONT_SIMULATIONS
-CONSTANT: DWRITE_FONT_SIMULATIONS_BOLD    1
+    DWRITE_FONT_SIMULATIONS_NONE
-CONSTANT: DWRITE_FONT_SIMULATIONS_OBLIQUE 2
+    DWRITE_FONT_SIMULATIONS_BOLD
-TYPEDEF: int DWRITE_FONT_SIMULATIONS
+    DWRITE_FONT_SIMULATIONS_OBLIQUE ;
 
-CONSTANT: DWRITE_FONT_WEIGHT_THIN        100
+C-ENUM: DWRITE_FONT_WEIGHT
-CONSTANT: DWRITE_FONT_WEIGHT_EXTRA_LIGHT 200
+    { DWRITE_FONT_WEIGHT_THIN        100 }
-CONSTANT: DWRITE_FONT_WEIGHT_ULTRA_LIGHT 200
+    { DWRITE_FONT_WEIGHT_EXTRA_LIGHT 200 }
-CONSTANT: DWRITE_FONT_WEIGHT_LIGHT       300
+    { DWRITE_FONT_WEIGHT_ULTRA_LIGHT 200 }
-CONSTANT: DWRITE_FONT_WEIGHT_NORMAL      400
+    { DWRITE_FONT_WEIGHT_LIGHT       300 }
-CONSTANT: DWRITE_FONT_WEIGHT_REGULAR     400
+    { DWRITE_FONT_WEIGHT_NORMAL      400 }
-CONSTANT: DWRITE_FONT_WEIGHT_MEDIUM      500
+    { DWRITE_FONT_WEIGHT_REGULAR     400 }
-CONSTANT: DWRITE_FONT_WEIGHT_DEMI_BOLD   600
+    { DWRITE_FONT_WEIGHT_MEDIUM      500 }
-CONSTANT: DWRITE_FONT_WEIGHT_SEMI_BOLD   600
+    { DWRITE_FONT_WEIGHT_DEMI_BOLD   600 }
-CONSTANT: DWRITE_FONT_WEIGHT_BOLD        700
+    { DWRITE_FONT_WEIGHT_SEMI_BOLD   600 }
-CONSTANT: DWRITE_FONT_WEIGHT_EXTRA_BOLD  800
+    { DWRITE_FONT_WEIGHT_BOLD        700 }
-CONSTANT: DWRITE_FONT_WEIGHT_ULTRA_BOLD  800
+    { DWRITE_FONT_WEIGHT_EXTRA_BOLD  800 }
-CONSTANT: DWRITE_FONT_WEIGHT_BLACK       900
+    { DWRITE_FONT_WEIGHT_ULTRA_BOLD  800 }
-CONSTANT: DWRITE_FONT_WEIGHT_HEAVY       900
+    { DWRITE_FONT_WEIGHT_BLACK       900 }
-CONSTANT: DWRITE_FONT_WEIGHT_EXTRA_BLACK 950
+    { DWRITE_FONT_WEIGHT_HEAVY       900 }
-CONSTANT: DWRITE_FONT_WEIGHT_ULTRA_BLACK 950
+    { DWRITE_FONT_WEIGHT_EXTRA_BLACK 950 }
-TYPEDEF: int DWRITE_FONT_WEIGHT
+    { DWRITE_FONT_WEIGHT_ULTRA_BLACK 950 } ;
 
-CONSTANT: DWRITE_FONT_STRETCH_UNDEFINED       0
+C-ENUM: DWRITE_FONT_STRETCH
-CONSTANT: DWRITE_FONT_STRETCH_ULTRA_CONDENSED 1
+    { DWRITE_FONT_STRETCH_UNDEFINED       0 }
-CONSTANT: DWRITE_FONT_STRETCH_EXTRA_CONDENSED 2
+    { DWRITE_FONT_STRETCH_ULTRA_CONDENSED 1 }
-CONSTANT: DWRITE_FONT_STRETCH_CONDENSED       3
+    { DWRITE_FONT_STRETCH_EXTRA_CONDENSED 2 }
-CONSTANT: DWRITE_FONT_STRETCH_SEMI_CONDENSED  4
+    { DWRITE_FONT_STRETCH_CONDENSED       3 }
-CONSTANT: DWRITE_FONT_STRETCH_NORMAL          5
+    { DWRITE_FONT_STRETCH_SEMI_CONDENSED  4 }
-CONSTANT: DWRITE_FONT_STRETCH_MEDIUM          5
+    { DWRITE_FONT_STRETCH_NORMAL          5 }
-CONSTANT: DWRITE_FONT_STRETCH_SEMI_EXPANDED   6
+    { DWRITE_FONT_STRETCH_MEDIUM          5 }
-CONSTANT: DWRITE_FONT_STRETCH_EXPANDED        7
+    { DWRITE_FONT_STRETCH_SEMI_EXPANDED   6 }
-CONSTANT: DWRITE_FONT_STRETCH_EXTRA_EXPANDED  8
+    { DWRITE_FONT_STRETCH_EXPANDED        7 }
-CONSTANT: DWRITE_FONT_STRETCH_ULTRA_EXPANDED  9
+    { DWRITE_FONT_STRETCH_EXTRA_EXPANDED  8 }
-TYPEDEF: int DWRITE_FONT_STRETCH
+    { 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: DWRITE_PIXEL_GEOMETRY
-C-ENUM:
     DWRITE_PIXEL_GEOMETRY_FLAT
     DWRITE_PIXEL_GEOMETRY_RGB
     DWRITE_PIXEL_GEOMETRY_BGR ;
 
-TYPEDEF: int DWRITE_RENDERING_MODE
+C-ENUM: DWRITE_RENDERING_MODE
-C-ENUM:
     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: DWRITE_READING_DIRECTION
-C-ENUM:
     DWRITE_READING_DIRECTION_LEFT_TO_RIGHT
     DWRITE_READING_DIRECTION_RIGHT_TO_LEFT ;
 
-TYPEDEF: int DWRITE_FLOW_DIRECTION
+C-ENUM: DWRITE_FLOW_DIRECTION
-C-ENUM:
     DWRITE_FLOW_DIRECTION_TOP_TO_BOTTOM ;
 
-TYPEDEF: int DWRITE_TEXT_ALIGNMENT
+C-ENUM: DWRITE_TEXT_ALIGNMENT
-C-ENUM:
     DWRITE_TEXT_ALIGNMENT_LEADING
     DWRITE_TEXT_ALIGNMENT_TRAILING
     DWRITE_TEXT_ALIGNMENT_CENTER ;
 
-TYPEDEF: int DWRITE_PARAGRAPH_ALIGNMENT
+C-ENUM: DWRITE_PARAGRAPH_ALIGNMENT
-C-ENUM:
     DWRITE_PARAGRAPH_ALIGNMENT_NEAR
     DWRITE_PARAGRAPH_ALIGNMENT_FAR
     DWRITE_PARAGRAPH_ALIGNMENT_CENTER ;
 
-TYPEDEF: int DWRITE_WORD_WRAPPING
+C-ENUM: DWRITE_WORD_WRAPPING
-C-ENUM:
     DWRITE_WORD_WRAPPING_WRAP
     DWRITE_WORD_WRAPPING_NO_WRAP ;
 
-TYPEDEF: int DWRITE_LINE_SPACING_METHOD
+C-ENUM: DWRITE_LINE_SPACING_METHOD
-C-ENUM:
     DWRITE_LINE_SPACING_METHOD_DEFAULT
     DWRITE_LINE_SPACING_METHOD_UNIFORM ;
 
-TYPEDEF: int DWRITE_TRIMMING_GRANULARITY
+C-ENUM: DWRITE_TRIMMING_GRANULARITY
-C-ENUM:
     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
+C-ENUM: DWRITE_SCRIPT_SHAPES
-CONSTANT: DWRITE_SCRIPT_SHAPES_NO_VISUAL 1
+    DWRITE_SCRIPT_SHAPES_DEFAULT
-TYPEDEF: int DWRITE_SCRIPT_SHAPES
+    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
 

basis/windows/directx/dxgitype/dxgitype.factor

@@ -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 }

basis/windows/directx/xapo/xapo.factor

@@ -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*             }

basis/windows/directx/xaudio2/xaudio2.factor

@@ -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 }

basis/windows/dwmapi/dwmapi.factor

@@ -1,6 +1,7 @@
 ! (c)2009 Joe Groff bsd license
-USING: alien.c-types alien.data alien.libraries alien.syntax
+USING: alien alien.c-types alien.data alien.libraries
-classes.struct kernel math system-info.windows windows.types ;
+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
 

basis/windows/kernel32/kernel32.factor

@@ -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 }

basis/windows/nt/nt.factor

@@ -1,35 +1,35 @@
 USING: alien sequences alien.libraries ;
 {
-    { "advapi32"    "advapi32.dll"       "stdcall" }
+    { "advapi32"    "advapi32.dll"       stdcall }
-    { "dinput"      "dinput8.dll"        "stdcall" }
+    { "dinput"      "dinput8.dll"        stdcall }
-    { "gdi32"       "gdi32.dll"          "stdcall" }
+    { "gdi32"       "gdi32.dll"          stdcall }
-    { "user32"      "user32.dll"         "stdcall" }
+    { "user32"      "user32.dll"         stdcall }
-    { "kernel32"    "kernel32.dll"       "stdcall" }
+    { "kernel32"    "kernel32.dll"       stdcall }
-    { "winsock"     "ws2_32.dll"         "stdcall" }
+    { "winsock"     "ws2_32.dll"         stdcall }
-    { "mswsock"     "mswsock.dll"        "stdcall" }
+    { "mswsock"     "mswsock.dll"        stdcall }
-    { "shell32"     "shell32.dll"        "stdcall" }
+    { "shell32"     "shell32.dll"        stdcall }
-    { "libc"        "msvcrt.dll"         "cdecl"   }
+    { "libc"        "msvcrt.dll"         cdecl   }
-    { "libm"        "msvcrt.dll"         "cdecl"   }
+    { "libm"        "msvcrt.dll"         cdecl   }
-    { "gl"          "opengl32.dll"       "stdcall" }
+    { "gl"          "opengl32.dll"       stdcall }
-    { "glu"         "glu32.dll"          "stdcall" }
+    { "glu"         "glu32.dll"          stdcall }
-    { "ole32"       "ole32.dll"          "stdcall" }
+    { "ole32"       "ole32.dll"          stdcall }
-    { "usp10"       "usp10.dll"          "stdcall" }
+    { "usp10"       "usp10.dll"          stdcall }
-    { "psapi"       "psapi.dll"          "stdcall" }
+    { "psapi"       "psapi.dll"          stdcall }
-    { "xinput"      "xinput1_3.dll"      "stdcall" }
+    { "xinput"      "xinput1_3.dll"      stdcall }
-    { "dxgi"        "dxgi.dll"           "stdcall" }
+    { "dxgi"        "dxgi.dll"           stdcall }
-    { "d2d1"        "d2d1.dll"           "stdcall" }
+    { "d2d1"        "d2d1.dll"           stdcall }
-    { "d3d9"        "d3d9.dll"           "stdcall" }
+    { "d3d9"        "d3d9.dll"           stdcall }
-    { "d3d10"       "d3d10.dll"          "stdcall" }
+    { "d3d10"       "d3d10.dll"          stdcall }
-    { "d3d10_1"     "d3d10_1.dll"        "stdcall" }
+    { "d3d10_1"     "d3d10_1.dll"        stdcall }
-    { "d3d11"       "d3d11.dll"          "stdcall" }
+    { "d3d11"       "d3d11.dll"          stdcall }
-    { "d3dcompiler" "d3dcompiler_42.dll" "stdcall" } 
+    { "d3dcompiler" "d3dcompiler_42.dll" stdcall } 
-    { "d3dcsx"      "d3dcsx_42.dll"      "stdcall" }
+    { "d3dcsx"      "d3dcsx_42.dll"      stdcall }
-    { "d3dx9"       "d3dx9_42.dll"       "stdcall" }
+    { "d3dx9"       "d3dx9_42.dll"       stdcall }
-    { "d3dx10"      "d3dx10_42.dll"      "stdcall" }
+    { "d3dx10"      "d3dx10_42.dll"      stdcall }
-    { "d3dx11"      "d3dx11_42.dll"      "stdcall" }
+    { "d3dx11"      "d3dx11_42.dll"      stdcall }
-    { "dwrite"      "dwrite.dll"         "stdcall" }
+    { "dwrite"      "dwrite.dll"         stdcall }
-    { "x3daudio"    "x3daudio1_6.dll"    "stdcall" }
+    { "x3daudio"    "x3daudio1_6.dll"    stdcall }
-    { "xactengine"  "xactengine3_5.dll"  "stdcall" }
+    { "xactengine"  "xactengine3_5.dll"  stdcall }
-    { "xapofx"      "xapofx1_3.dll"      "stdcall" }
+    { "xapofx"      "xapofx1_3.dll"      stdcall }
-    { "xaudio2"     "xaudio2_5.dll"      "stdcall" }
+    { "xaudio2"     "xaudio2_5.dll"      stdcall }
 } [ first3 add-library ] each

basis/windows/usp10/usp10.factor

@@ -37,22 +37,23 @@ FUNCTION: HRESULT ScriptLayout (
     int* piLogicalToVisual
 ) ;
 
-C-ENUM: SCRIPT_JUSTIFY_NONE
+C-ENUM: f
-SCRIPT_JUSTIFY_ARABIC_BLANK
+    SCRIPT_JUSTIFY_NONE
-SCRIPT_JUSTIFY_CHARACTER
+    SCRIPT_JUSTIFY_ARABIC_BLANK
-SCRIPT_JUSTIFY_RESERVED1
+    SCRIPT_JUSTIFY_CHARACTER
-SCRIPT_JUSTIFY_BLANK
+    SCRIPT_JUSTIFY_RESERVED1
-SCRIPT_JUSTIFY_RESERVED2
+    SCRIPT_JUSTIFY_BLANK
-SCRIPT_JUSTIFY_RESERVED3
+    SCRIPT_JUSTIFY_RESERVED2
-SCRIPT_JUSTIFY_ARABIC_NORMAL
+    SCRIPT_JUSTIFY_RESERVED3
-SCRIPT_JUSTIFY_ARABIC_KASHIDA
+    SCRIPT_JUSTIFY_ARABIC_NORMAL
-SCRIPT_JUSTIFY_ALEF
+    SCRIPT_JUSTIFY_ARABIC_KASHIDA
-SCRIPT_JUSTIFY_HA
+    SCRIPT_JUSTIFY_ALEF
-SCRIPT_JUSTIFY_RA
+    SCRIPT_JUSTIFY_HA
-SCRIPT_JUSTIFY_BA
+    SCRIPT_JUSTIFY_RA
-SCRIPT_JUSTIFY_BARA
+    SCRIPT_JUSTIFY_BA
-SCRIPT_JUSTIFY_SEEN
+    SCRIPT_JUSTIFY_BARA
-SCRIPT_JUSTIFFY_RESERVED4 ;
+    SCRIPT_JUSTIFY_SEEN
+    SCRIPT_JUSTIFFY_RESERVED4 ;
 
 STRUCT: SCRIPT_VISATTR
     { flags WORD } ;

basis/x11/constants/constants.factor

@@ -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 ;

core/alien/alien-docs.factor

@@ -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."
 }

core/alien/alien.factor

@@ -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 )

extra/benchmark/fib6/fib6.factor

@@ -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 ;
 

extra/chipmunk/ffi/ffi.factor

@@ -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
+USING: accessors alien alien.c-types alien.libraries
-combinators.short-circuit kernel math math.order sequences
+alien.syntax classes.struct combinators combinators.short-circuit
-typed specialized-arrays locals system alien.libraries ;
+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                 }

extra/curses/ffi/ffi.factor

@@ -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

extra/cursors/cursors-tests.factor

@@ -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

extra/elf/elf.factor

@@ -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> ;
+    

extra/fluids/authors.txt

@@ -0,0 +1 @@
+Erik Charlebois

extra/fluids/fluids.factor

@@ -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