Using fry in cpu.x86, working on alien intrinsics

basis/cpu/x86/allot/allot.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel words kernel.private namespaces math math.private
-sequences generic arrays system layouts alien locals
+sequences generic arrays system layouts alien locals fry
 cpu.architecture cpu.x86.assembler cpu.x86.architecture
 compiler.constants compiler.cfg.templates compiler.cfg.builder
 compiler.codegen compiler.codegen.fixup ;
@@ -118,7 +118,7 @@ M:: x86 %box-alien ( dst src temp -- )
     "end" resolve-label ; inline
 
 : overflow-template ( word insn -- )
-    [ overflow-check ] curry T{ template
+    '[ _ overflow-check ] T{ template
         { input { { f "x" } { f "y" } } }
         { scratch { { f "z" } } }
         { output { "z" } }

basis/cpu/x86/architecture/architecture.factor

@@ -49,7 +49,6 @@ HOOK: temp-reg-1 cpu ( -- reg )
 HOOK: temp-reg-2 cpu ( -- reg )
 
 HOOK: fixnum>slot@ cpu ( op -- )
-
 HOOK: prepare-division cpu ( -- )
 
 M: f load-literal

basis/cpu/x86/assembler/syntax/syntax.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel words sequences lexer parser ;
+USING: kernel words sequences lexer parser fry ;
 IN: cpu.x86.assembler.syntax
 
 : define-register ( name num size -- )
@@ -9,7 +9,7 @@ IN: cpu.x86.assembler.syntax
     "register-size" set-word-prop ;
 
 : define-registers ( names size -- )
-    >r dup length r> [ define-register ] curry 2each ;
+    '[ _ define-register ] each-index ;
 
 : REGISTERS: ( -- )
     scan-word ";" parse-tokens swap define-registers ; parsing

basis/cpu/x86/intrinsics/intrinsics.factor

@@ -3,7 +3,7 @@
 USING: accessors arrays byte-arrays alien.accessors kernel
 kernel.private math memory namespaces make sequences words
 system layouts combinators math.order math.private alien
-alien.c-types slots.private locals cpu.architecture
+alien.c-types slots.private locals fry cpu.architecture
 cpu.x86.assembler cpu.x86.assembler.private cpu.x86.architecture
 compiler.codegen.fixup compiler.constants compiler.intrinsics
 compiler.cfg.builder compiler.cfg.registers compiler.cfg.stacks
@@ -51,7 +51,6 @@ IN: cpu.x86.intrinsics
     {
         [ %constant-slot "val" operand MOV ] T{ template
             { input { { f "val" } { f "obj" } { small-slot "n" } { small-slot "tag" } } }
-            { clobber { "obj" } }
         }
     }
     {
@@ -62,16 +61,6 @@ IN: cpu.x86.intrinsics
     }
 } define-intrinsics
 
-! Sometimes, we need to do stuff with operands which are
-! less than the word size. Instead of teaching the register
-! allocator about the different sized registers, with all
-! the complexity this entails, we just push/pop a register
-! which is guaranteed to be unused (the tempreg)
-: small-reg cell 8 = RBX EBX ? ; inline
-: small-reg-8 BL ; inline
-: small-reg-16 BX ; inline
-: small-reg-32 EBX ; inline
-
 ! Fixnums
 : fixnum-op ( op hash -- pair )
     >r [ "x" operand "y" operand ] swap suffix r> 2array ;
@@ -219,17 +208,38 @@ IN: cpu.x86.intrinsics
 } define-intrinsic
 
 ! Alien intrinsics
-: %alien-accessor ( quot -- )
+
+! Sometimes, we need to do stuff with operands which are
+! less than the word size. Instead of teaching the register
+! allocator about the different sized registers, with all
+! the complexity this entails, we just push/pop a register
+! which is guaranteed to be unused (the tempreg)
+: small-reg cell 8 = RAX EAX ? ; inline
+: small-reg-8 AL ; inline
+: small-reg-16 AX ; inline
+: small-reg-32 EAX ; inline
+
+: %prepare-alien-accessor ( -- )
     "offset" operand %untag-fixnum
-    "offset" operand "alien" operand ADD
+    "offset" operand "alien" operand ADD ;
+
+: (%alien-accessor) ( quot -- )
     "offset" operand [] swap call ; inline
 
-: %alien-integer-get ( quot reg -- )
+: %alien-accessor ( quot -- )
+    %prepare-alien-accessor (%alien-accessor) ; inline
+
+: %alien-integer-get ( reg quot -- )
+    %prepare-alien-accessor
+    "value" operand small-reg = [
+        (%alien-accessor)
+    ] [
         small-reg PUSH
-    swap %alien-accessor
+        (%alien-accessor)
         "value" operand small-reg MOV
-    "value" operand %tag-fixnum
+        small-reg POP
-    small-reg POP ; inline
+    ] if
+    "value" operand %tag-fixnum ; inline
 
 : alien-integer-get-template
     T{ template
@@ -242,23 +252,28 @@ IN: cpu.x86.intrinsics
         { clobber { "offset" } }
     } ;
 
-: define-getter ( word quot reg -- )
+: define-getter ( word reg quot -- )
-    [ %alien-integer-get ] 2curry
+    '[ _ _ %alien-integer-get ]
     alien-integer-get-template
     define-intrinsic ;
 
 : define-unsigned-getter ( word reg -- )
-    [ small-reg dup XOR MOV ] swap define-getter ;
+    [ small-reg dup XOR MOV ] define-getter ;
 
 : define-signed-getter ( word reg -- )
-    [ [ >r MOV small-reg r> MOVSX ] curry ] keep define-getter ;
+    dup '[ MOV small-reg _ MOVSX ] define-getter ;
 
-: %alien-integer-set ( quot reg -- )
+: %alien-integer-set ( reg quot -- )
+    "value" operand %untag-fixnum
+    %prepare-alien-accessor
+    small-reg "value" operand = [
+        (%alien-accessor)
+    ] [
         small-reg PUSH
         small-reg "value" operand MOV
-    small-reg %untag-fixnum
+        (%alien-accessor)
-    swap %alien-accessor
+        small-reg POP
-    small-reg POP ; inline
+    ] if ; inline
 
 : alien-integer-set-template
     T{ template
@@ -271,8 +286,7 @@ IN: cpu.x86.intrinsics
     } ;
 
 : define-setter ( word reg -- )
-    [ swap MOV ] swap
+    '[ _ [ swap MOV ] %alien-integer-set ]
-    [ %alien-integer-set ] 2curry
     alien-integer-set-template
     define-intrinsic ;
 

basis/cpu/x86/sse2/sse2.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.accessors arrays generic kernel
 kernel.private math math.private memory namespaces sequences
-words math.floats.private layouts quotations locals
+words math.floats.private layouts quotations locals fry
 system compiler.constants compiler.codegen compiler.cfg.templates
 compiler.cfg.registers compiler.cfg.builder cpu.architecture
 cpu.x86.assembler cpu.x86.architecture cpu.x86.intrinsics ;
@@ -87,10 +87,10 @@ M: x86 %unbox-float ( dst src -- )
     } ;
 
 : define-alien-float-intrinsics ( word get-quot word set-quot -- )
-    [ "value" operand swap %alien-accessor ] curry
+    '[ "value" operand _ %alien-accessor ]
     alien-float-set-template
     define-intrinsic
-    [ "value" operand swap %alien-accessor ] curry
+    '[ "value" operand _ %alien-accessor ]
     alien-float-get-template
     define-intrinsic ;