From 5bee1ba3a178c17a5443dd48dc6eb0bfc768900e Mon Sep 17 00:00:00 2001
From: kusumotonorio <47816570+kusumotonorio@users.noreply.github.com>
Date: Thu, 16 Jan 2020 20:57:13 +0900
Subject: [PATCH 01/15] Improve System V AMD64 ABI compliance

---
 basis/compiler/cfg/builder/alien/alien.factor |  4 ++-
 .../cfg/builder/alien/boxing/boxing.factor    | 30 ++++++++++++++---
 basis/cpu/x86/64/unix/unix.factor             | 33 ++++++++++++++-----
 basis/ui/backend/cocoa/views/views.factor     |  7 ++--
 4 files changed, 56 insertions(+), 18 deletions(-)

diff --git a/basis/compiler/cfg/builder/alien/alien.factor b/basis/compiler/cfg/builder/alien/alien.factor
index 57e96997f2..6fea1ec902 100644
--- a/basis/compiler/cfg/builder/alien/alien.factor
+++ b/basis/compiler/cfg/builder/alien/alien.factor
@@ -15,6 +15,8 @@ IN: compiler.cfg.builder.alien
         0 stack-params set
         V{ } clone reg-values set
         V{ } clone stack-values set
+        0 int-reg-reps set
+        0 float-reg-reps set
         @
         reg-values get
         stack-values get
@@ -46,7 +48,7 @@ IN: compiler.cfg.builder.alien
 : caller-parameters ( params -- reg-inputs stack-inputs )
     [ abi>> ] [ parameters>> ] [ return>> ] tri
     '[
-        _ unbox-parameters
+        _ unbox-parameters 
         _ prepare-struct-caller struct-return-area set
         (caller-parameters)
     ] with-param-regs ;
diff --git a/basis/compiler/cfg/builder/alien/boxing/boxing.factor b/basis/compiler/cfg/builder/alien/boxing/boxing.factor
index e7713a09be..689431a0e8 100644
--- a/basis/compiler/cfg/builder/alien/boxing/boxing.factor
+++ b/basis/compiler/cfg/builder/alien/boxing/boxing.factor
@@ -10,19 +10,39 @@ IN: compiler.cfg.builder.alien.boxing
 
 SYMBOL: struct-return-area
 
+SYMBOLS: int-reg-reps float-reg-reps ;
+
+: inc-not-f ( variable -- ) dup get [ inc ] [ drop ] if ; inline
+
+: dec-not-f ( variable -- ) dup get [ dec ] [ drop ] if ; inline
+
+: record-reg-reps ( seq -- seq )
+    dup [
+        dup second not [  ! on-stack?: f 
+            first int-rep? int-reg-reps float-reg-reps ? inc-not-f
+        ] [ drop ] if
+    ] each ;
+
+: unrecord-reg-reps ( seq -- seq )
+    dup [
+        dup second not [  ! on-stack?: f 
+            first int-rep? int-reg-reps float-reg-reps ? dec-not-f
+        ] [ drop ] if
+    ] each ;
+
 GENERIC: flatten-c-type ( c-type -- pairs )
 
 M: c-type flatten-c-type
-    rep>> f f 3array 1array ;
+    rep>> f f 3array 1array record-reg-reps ;
 
 M: long-long-type flatten-c-type
-    drop 2 [ int-rep long-long-on-stack? f 3array ] replicate ;
+    drop 2 [ int-rep long-long-on-stack? f 3array ] replicate record-reg-reps ;
 
 HOOK: flatten-struct-type cpu ( type -- pairs )
 HOOK: flatten-struct-type-return cpu ( type -- pairs )
 
 M: object flatten-struct-type
-    heap-size cell align cell /i { int-rep f f } <array> ;
+    heap-size cell align cell /i { int-rep f f } <array> record-reg-reps ;
 
 M: struct-c-type flatten-c-type
     flatten-struct-type ;
@@ -70,12 +90,12 @@ M: c-type unbox
             [ swap ^^unbox ]
         } case 1array
     ]
-    [ drop f f 3array 1array ] 2bi ;
+    [ drop f f 3array 1array ] 2bi record-reg-reps ;
 
 M: long-long-type unbox
     [ next-vreg next-vreg 2dup ] 2dip unboxer>> ##unbox-long-long, 2array
     int-rep long-long-on-stack? long-long-odd-register? 3array
-    int-rep long-long-on-stack? f 3array 2array ;
+    int-rep long-long-on-stack? f 3array 2array record-reg-reps ;
 
 M: struct-c-type unbox ( src c-type -- vregs reps )
     [ ^^unbox-any-c-ptr ] dip explode-struct ;
diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor
index 6a605e9d0b..5ebdb8b6d2 100644
--- a/basis/cpu/x86/64/unix/unix.factor
+++ b/basis/cpu/x86/64/unix/unix.factor
@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien.c-types arrays assocs
 compiler.cfg.builder.alien.boxing cpu.architecture cpu.x86
-cpu.x86.assembler cpu.x86.assembler.operands kernel layouts make math
-math.order sequences splitting system ;
+cpu.x86.assembler cpu.x86.assembler.operands kernel layouts locals
+make math math.order namespaces sequences splitting system ;
 IN: cpu.x86.64.unix
 
 M: x86.64 param-regs
@@ -24,16 +24,33 @@ M: x86.64 reserved-stack-space 0 ;
         [ 8 mod zero? [ t , ] when , ] assoc-each
     ] { } make { t } split harvest ;
 
-: flatten-small-struct ( c-type -- seq )
-    struct-types&offset split-struct [
+:: flatten-small-struct ( c-type -- seq )
+    c-type struct-types&offset split-struct [
         [ lookup-c-type c-type-rep reg-class-of ] map
-        int-regs swap member? int-rep double-rep ?
-        f f 3array
-    ] map ;
+        int-regs swap member? int-rep double-rep ? f f 3array
+    ] map :> reps
+    int-reg-reps get float-reg-reps get and [
+        0 :> int-mems!
+        0 :> float-mems!
+        reps [
+            first int-rep? [
+                int-mems 1 + int-mems!
+            ] [
+                float-mems 1 + float-mems!
+            ] if
+        ] each
+        int-reg-reps get int-mems + 6 >
+        float-reg-reps get float-mems + 8 > or [
+            reps [ first t f 3array ] map
+        ] [ reps ] if
+    ] [ reps ] if ;
 
 M: x86.64 flatten-struct-type ( c-type -- seq )
     dup heap-size 16 <=
-    [ flatten-small-struct ] [ call-next-method [ first t f 3array ] map ] if ;
+    [ flatten-small-struct record-reg-reps ] [
+        call-next-method [ first t f 3array ] map
+        unrecord-reg-reps
+    ] if ;
 
 M: x86.64 return-struct-in-registers? ( c-type -- ? )
     heap-size 2 cells <= ;
diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor
index eaa09b3351..6f412ce29a 100644
--- a/basis/ui/backend/cocoa/views/views.factor
+++ b/basis/ui/backend/cocoa/views/views.factor
@@ -238,16 +238,15 @@ IMPORT: NSAttributedString
     ] [ underlines ] if ;
 
 :: update-marked-text ( gadget str selectedRange replacementRange -- )
-    replacementRange location>>  NSNotFound = not     ! [ 
-    replacementRange length>> NSNotFound = not and [  ! erase this line
+    replacementRange location>>  NSNotFound = not [ 
         gadget editor-caret first
         dup gadget editor-line
         [ 
-            replacementRange length>> ! location>>
+            replacementRange location>>
             >codepoint-index
             2array gadget set-caret
         ] [
-            replacementRange length>> 1 + ! [ location>> ] [ length>> ] bi +
+            replacementRange [ location>> ] [ length>> ] bi +
             >codepoint-index
             2array gadget set-mark
         ] 2bi

From d58132222518a69abaf41dc43583fb3fc3de7c68 Mon Sep 17 00:00:00 2001
From: kusumotonorio <47816570+kusumotonorio@users.noreply.github.com>
Date: Thu, 16 Jan 2020 21:06:22 +0900
Subject: [PATCH 02/15] Remove an extra space

---
 basis/compiler/cfg/builder/alien/alien.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/compiler/cfg/builder/alien/alien.factor b/basis/compiler/cfg/builder/alien/alien.factor
index 6fea1ec902..06b18597c8 100644
--- a/basis/compiler/cfg/builder/alien/alien.factor
+++ b/basis/compiler/cfg/builder/alien/alien.factor
@@ -48,7 +48,7 @@ IN: compiler.cfg.builder.alien
 : caller-parameters ( params -- reg-inputs stack-inputs )
     [ abi>> ] [ parameters>> ] [ return>> ] tri
     '[
-        _ unbox-parameters 
+        _ unbox-parameters
         _ prepare-struct-caller struct-return-area set
         (caller-parameters)
     ] with-param-regs ;

From bb7777e0cfa64f7e45f6132e12fc62159bb065d0 Mon Sep 17 00:00:00 2001
From: kusumotonorio <47816570+kusumotonorio@users.noreply.github.com>
Date: Thu, 16 Jan 2020 23:34:24 +0900
Subject: [PATCH 03/15] boxing.factor: Change Stack Effects

---
 basis/compiler/cfg/builder/alien/boxing/boxing.factor | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/basis/compiler/cfg/builder/alien/boxing/boxing.factor b/basis/compiler/cfg/builder/alien/boxing/boxing.factor
index 689431a0e8..e0fcc58027 100644
--- a/basis/compiler/cfg/builder/alien/boxing/boxing.factor
+++ b/basis/compiler/cfg/builder/alien/boxing/boxing.factor
@@ -12,18 +12,22 @@ SYMBOL: struct-return-area
 
 SYMBOLS: int-reg-reps float-reg-reps ;
 
+<PRIVATE
+
 : inc-not-f ( variable -- ) dup get [ inc ] [ drop ] if ; inline
 
 : dec-not-f ( variable -- ) dup get [ dec ] [ drop ] if ; inline
 
-: record-reg-reps ( seq -- seq )
+PRIVATE>
+
+: record-reg-reps ( reps -- reps )
     dup [
         dup second not [  ! on-stack?: f 
             first int-rep? int-reg-reps float-reg-reps ? inc-not-f
         ] [ drop ] if
     ] each ;
 
-: unrecord-reg-reps ( seq -- seq )
+: unrecord-reg-reps ( reps -- reps )
     dup [
         dup second not [  ! on-stack?: f 
             first int-rep? int-reg-reps float-reg-reps ? dec-not-f

From 2ee51f50e2d975ffe8492de531ddc46beb66054a Mon Sep 17 00:00:00 2001
From: kusumotonorio <47816570+kusumotonorio@users.noreply.github.com>
Date: Sun, 19 Jan 2020 14:30:38 +0900
Subject: [PATCH 04/15] Stop inc-not-f and dec-not-f, etc

---
 .../cfg/builder/alien/boxing/boxing.factor         | 14 ++++----------
 basis/cpu/x86/64/unix/unix.factor                  |  3 ++-
 2 files changed, 6 insertions(+), 11 deletions(-)

diff --git a/basis/compiler/cfg/builder/alien/boxing/boxing.factor b/basis/compiler/cfg/builder/alien/boxing/boxing.factor
index e0fcc58027..75321ec62d 100644
--- a/basis/compiler/cfg/builder/alien/boxing/boxing.factor
+++ b/basis/compiler/cfg/builder/alien/boxing/boxing.factor
@@ -12,25 +12,19 @@ SYMBOL: struct-return-area
 
 SYMBOLS: int-reg-reps float-reg-reps ;
 
-<PRIVATE
-
-: inc-not-f ( variable -- ) dup get [ inc ] [ drop ] if ; inline
-
-: dec-not-f ( variable -- ) dup get [ dec ] [ drop ] if ; inline
-
-PRIVATE>
-
 : record-reg-reps ( reps -- reps )
     dup [
         dup second not [  ! on-stack?: f 
-            first int-rep? int-reg-reps float-reg-reps ? inc-not-f
+            first int-rep? int-reg-reps float-reg-reps ?
+            dup get [ inc ] [ drop ] if
         ] [ drop ] if
     ] each ;
 
 : unrecord-reg-reps ( reps -- reps )
     dup [
         dup second not [  ! on-stack?: f 
-            first int-rep? int-reg-reps float-reg-reps ? dec-not-f
+            first int-rep? int-reg-reps float-reg-reps ?
+            dup get [ dec ] [ drop ] if
         ] [ drop ] if
     ] each ;
 
diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor
index 5ebdb8b6d2..ffb287f6e0 100644
--- a/basis/cpu/x86/64/unix/unix.factor
+++ b/basis/cpu/x86/64/unix/unix.factor
@@ -27,7 +27,8 @@ M: x86.64 reserved-stack-space 0 ;
 :: flatten-small-struct ( c-type -- seq )
     c-type struct-types&offset split-struct [
         [ lookup-c-type c-type-rep reg-class-of ] map
-        int-regs swap member? int-rep double-rep ? f f 3array
+        int-regs swap member? int-rep double-rep ?
+        f f 3array
     ] map :> reps
     int-reg-reps get float-reg-reps get and [
         0 :> int-mems!

From c258a4e2f4c7185ee37218f2831a2755a37a088c Mon Sep 17 00:00:00 2001
From: kusumotonorio <47816570+kusumotonorio@users.noreply.github.com>
Date: Sun, 19 Jan 2020 21:57:05 +0900
Subject: [PATCH 05/15] Add Callback Tests

---
 basis/compiler/tests/alien.factor | 70 ++++++++++++++++++++++++++++++-
 vm/ffi_test.c                     | 21 ++++++++++
 vm/ffi_test.h                     | 21 ++++++++++
 3 files changed, 111 insertions(+), 1 deletion(-)

diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor
index 3e4f149077..83a7aa32f7 100644
--- a/basis/compiler/tests/alien.factor
+++ b/basis/compiler/tests/alien.factor
@@ -2,7 +2,7 @@ USING: accessors alien alien.c-types alien.complex alien.data alien.libraries
 alien.syntax arrays byte-arrays classes classes.struct combinators
 combinators.extras compiler compiler.test concurrency.promises continuations
 destructors effects generalizations io io.backend io.pathnames
-io.streams.string kernel kernel.private libc layouts math math.bitwise
+io.streams.string kernel kernel.private libc layouts locals math math.bitwise
 math.private memory namespaces namespaces.private random parser quotations
 sequences slots.private specialized-arrays stack-checker stack-checker.errors
 system threads tools.test words ;
@@ -963,3 +963,71 @@ FUNCTION: void* bug1021_test_3 ( c-string a )
 { } [
     10000 [ 0 doit 33 assert= ] times
 ] unit-test
+
+! Tests for System V AMD64 ABI 
+STRUCT: test_struct_66 { mem1 ulong } { mem2 ulong } ;
+STRUCT: test_struct_68 { mem1 ulong } { mem2 ulong } { mem3 ulong } ;
+FUNCTION: ulong ffi_test_66 ( ulong a, ulong b, ulong c, test_struct_66 d, test_struct_66 e )
+FUNCTION: ulong ffi_test_67 ( ulong a, ulong b, ulong c, test_struct_66 d, test_struct_66 e ulong _f )
+FUNCTION: ulong ffi_test_68 ( ulong a, ulong b, ulong c, test_struct_66 d, test_struct_68 e test_struct_66 _f )
+
+{ 28 } [ 1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_66 f 6 7 } ffi_test_66 ] unit-test
+
+: callback-14 ( -- callback )
+    ulong { ulong ulong ulong test_struct_66 test_struct_66 } cdecl
+    [| a b c d e |
+        a b + c +
+        d [ mem1>> + ] [ mem2>> + ] bi
+        e [ mem1>> + ] [ mem2>> + ] bi
+    ] alien-callback ;
+
+: callback-14-test ( a b c d e callback -- result )
+    ulong { ulong ulong ulong test_struct_66 test_struct_66 } cdecl alien-indirect ;
+
+{ 28 } [
+    1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_66 f 6 7 } callback-14 [
+        callback-14-test
+    ] with-callback
+] unit-test
+
+{ 44 } [ 1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_66 f 6 7 } 8 ffi_test_67 ] unit-test
+
+: callback-15 ( -- callback )
+    ulong { ulong ulong ulong test_struct_66 test_struct_66 ulong } cdecl
+    [| a b c d e _f |
+        a b + c +
+        d [ mem1>> + ] [ mem2>> + ] bi
+        e [ mem1>> + ] [ mem2>> + ] bi
+        _f 2 * + 
+    ] alien-callback ;
+
+: callback-15-test ( a b c d e _f callback -- result )
+    ulong { ulong ulong ulong test_struct_66 test_struct_66 ulong } cdecl alien-indirect ;
+
+{ 44 } [
+    1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_66 f 6 7 } 8 callback-15 [
+        callback-15-test
+    ] with-callback
+] unit-test
+
+{ 55 } [
+    1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_68 f 6 7 8 } S{ test_struct_66 f 9 10 } ffi_test_68
+] unit-test
+
+: callback-16 ( -- callback )
+    ulong { ulong ulong ulong test_struct_66 test_struct_68 test_struct_66 } cdecl
+    [| a b c d e _f |
+        a b + c +
+        d [ mem1>> + ] [ mem2>> + ] bi
+        e [ mem1>> + ] [ mem2>> + ] [ mem3>> + ] tri
+        _f [ mem1>> + ] [ mem2>> + ] bi
+    ] alien-callback ;
+
+: callback-16-test ( a b c d e _f callback -- result )
+    ulong { ulong ulong ulong test_struct_66 test_struct_68 test_struct_66 } cdecl alien-indirect ;
+
+{ 55 } [
+    1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_68 f 6 7 8 } S{ test_struct_66 f 9 10 } callback-16 [
+        callback-16-test
+    ] with-callback
+] unit-test
diff --git a/vm/ffi_test.c b/vm/ffi_test.c
index 1927a8d988..f2dbd2bd50 100644
--- a/vm/ffi_test.c
+++ b/vm/ffi_test.c
@@ -357,6 +357,27 @@ double ffi_test_65(int n, ...) {
     return sum;
 }
 
+unsigned long ffi_test_66(unsigned long a, unsigned long b, unsigned long c,
+                          struct test_struct_66 d, struct test_struct_66 e) {
+    unsigned long x;
+    x = a + b + c + d.mem1 + d.mem2 + e.mem1 + e.mem2;
+    return x;
+}
+
+unsigned long ffi_test_67(unsigned long a, unsigned long b, unsigned long c,
+                          struct test_struct_66 d, struct test_struct_66 e,
+                          unsigned long f) {
+    unsigned long x;
+    x = a + b + c + d.mem1 + d.mem2 + e.mem1 + e.mem2 + f*2;
+    return x;
+}
+
+unsigned long ffi_test_68(unsigned long a, unsigned long b, unsigned long c,
+                          struct test_struct_66 d, struct test_struct_68 e, struct test_struct_66 f) {
+    unsigned long x;
+    x = a + b + c + d.mem1 + d.mem2 + e.mem1 + e.mem2 + e.mem3 + f.mem1 + f.mem2;
+	return x;
+}
 
 void* bug1021_test_1(void* x, int y) {
   return (void*)(y * y + (size_t)x);
diff --git a/vm/ffi_test.h b/vm/ffi_test.h
index 1c7ae7ddb3..97ee793302 100644
--- a/vm/ffi_test.h
+++ b/vm/ffi_test.h
@@ -232,6 +232,27 @@ FACTOR_EXPORT struct ulonglong_pair ffi_test_63(void);
 FACTOR_EXPORT int ffi_test_64(int n, ...);
 FACTOR_EXPORT double ffi_test_65(int n, ...);
 
+
+struct test_struct_66 {
+  unsigned long mem1;
+  unsigned long mem2;
+};
+
+struct test_struct_68 {
+  unsigned long mem1;
+  unsigned long mem2;
+  unsigned long mem3;  
+};
+
+FACTOR_EXPORT unsigned long ffi_test_66(unsigned long a, unsigned long b, unsigned long c,
+                                        struct test_struct_66 d, struct test_struct_66 e);
+
+FACTOR_EXPORT unsigned long ffi_test_67(unsigned long a, unsigned long b, unsigned long c,
+                                        struct test_struct_66 d, struct test_struct_66 e, unsigned long f);
+
+FACTOR_EXPORT unsigned long ffi_test_68(unsigned long a, unsigned long b, unsigned long c,
+                                        struct test_struct_66 d, struct test_struct_68 e, struct test_struct_66 f);
+
 FACTOR_EXPORT void* bug1021_test_1(void* x, int y);
 FACTOR_EXPORT int bug1021_test_2(int x, char* y, void *z);
 FACTOR_EXPORT void* bug1021_test_3(int x);

From e6726acd026a7115b77b9e0d7f7b3d4b5683bb62 Mon Sep 17 00:00:00 2001
From: kusumotonorio <47816570+kusumotonorio@users.noreply.github.com>
Date: Sun, 19 Jan 2020 22:27:17 +0900
Subject: [PATCH 06/15] put alien.factor back

---
 basis/compiler/tests/alien.factor | 70 +------------------------------
 1 file changed, 1 insertion(+), 69 deletions(-)

diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor
index 83a7aa32f7..3e4f149077 100644
--- a/basis/compiler/tests/alien.factor
+++ b/basis/compiler/tests/alien.factor
@@ -2,7 +2,7 @@ USING: accessors alien alien.c-types alien.complex alien.data alien.libraries
 alien.syntax arrays byte-arrays classes classes.struct combinators
 combinators.extras compiler compiler.test concurrency.promises continuations
 destructors effects generalizations io io.backend io.pathnames
-io.streams.string kernel kernel.private libc layouts locals math math.bitwise
+io.streams.string kernel kernel.private libc layouts math math.bitwise
 math.private memory namespaces namespaces.private random parser quotations
 sequences slots.private specialized-arrays stack-checker stack-checker.errors
 system threads tools.test words ;
@@ -963,71 +963,3 @@ FUNCTION: void* bug1021_test_3 ( c-string a )
 { } [
     10000 [ 0 doit 33 assert= ] times
 ] unit-test
-
-! Tests for System V AMD64 ABI 
-STRUCT: test_struct_66 { mem1 ulong } { mem2 ulong } ;
-STRUCT: test_struct_68 { mem1 ulong } { mem2 ulong } { mem3 ulong } ;
-FUNCTION: ulong ffi_test_66 ( ulong a, ulong b, ulong c, test_struct_66 d, test_struct_66 e )
-FUNCTION: ulong ffi_test_67 ( ulong a, ulong b, ulong c, test_struct_66 d, test_struct_66 e ulong _f )
-FUNCTION: ulong ffi_test_68 ( ulong a, ulong b, ulong c, test_struct_66 d, test_struct_68 e test_struct_66 _f )
-
-{ 28 } [ 1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_66 f 6 7 } ffi_test_66 ] unit-test
-
-: callback-14 ( -- callback )
-    ulong { ulong ulong ulong test_struct_66 test_struct_66 } cdecl
-    [| a b c d e |
-        a b + c +
-        d [ mem1>> + ] [ mem2>> + ] bi
-        e [ mem1>> + ] [ mem2>> + ] bi
-    ] alien-callback ;
-
-: callback-14-test ( a b c d e callback -- result )
-    ulong { ulong ulong ulong test_struct_66 test_struct_66 } cdecl alien-indirect ;
-
-{ 28 } [
-    1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_66 f 6 7 } callback-14 [
-        callback-14-test
-    ] with-callback
-] unit-test
-
-{ 44 } [ 1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_66 f 6 7 } 8 ffi_test_67 ] unit-test
-
-: callback-15 ( -- callback )
-    ulong { ulong ulong ulong test_struct_66 test_struct_66 ulong } cdecl
-    [| a b c d e _f |
-        a b + c +
-        d [ mem1>> + ] [ mem2>> + ] bi
-        e [ mem1>> + ] [ mem2>> + ] bi
-        _f 2 * + 
-    ] alien-callback ;
-
-: callback-15-test ( a b c d e _f callback -- result )
-    ulong { ulong ulong ulong test_struct_66 test_struct_66 ulong } cdecl alien-indirect ;
-
-{ 44 } [
-    1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_66 f 6 7 } 8 callback-15 [
-        callback-15-test
-    ] with-callback
-] unit-test
-
-{ 55 } [
-    1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_68 f 6 7 8 } S{ test_struct_66 f 9 10 } ffi_test_68
-] unit-test
-
-: callback-16 ( -- callback )
-    ulong { ulong ulong ulong test_struct_66 test_struct_68 test_struct_66 } cdecl
-    [| a b c d e _f |
-        a b + c +
-        d [ mem1>> + ] [ mem2>> + ] bi
-        e [ mem1>> + ] [ mem2>> + ] [ mem3>> + ] tri
-        _f [ mem1>> + ] [ mem2>> + ] bi
-    ] alien-callback ;
-
-: callback-16-test ( a b c d e _f callback -- result )
-    ulong { ulong ulong ulong test_struct_66 test_struct_68 test_struct_66 } cdecl alien-indirect ;
-
-{ 55 } [
-    1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_68 f 6 7 8 } S{ test_struct_66 f 9 10 } callback-16 [
-        callback-16-test
-    ] with-callback
-] unit-test

From 56c6e3058b8eb3fb2fe9523287e8a614b7339def Mon Sep 17 00:00:00 2001
From: kusumotonorio <47816570+kusumotonorio@users.noreply.github.com>
Date: Sun, 19 Jan 2020 22:30:48 +0900
Subject: [PATCH 07/15] put alien.factor, ffi_test.* back

---
 vm/ffi_test.c | 21 ---------------------
 vm/ffi_test.h | 21 ---------------------
 2 files changed, 42 deletions(-)

diff --git a/vm/ffi_test.c b/vm/ffi_test.c
index f2dbd2bd50..1927a8d988 100644
--- a/vm/ffi_test.c
+++ b/vm/ffi_test.c
@@ -357,27 +357,6 @@ double ffi_test_65(int n, ...) {
     return sum;
 }
 
-unsigned long ffi_test_66(unsigned long a, unsigned long b, unsigned long c,
-                          struct test_struct_66 d, struct test_struct_66 e) {
-    unsigned long x;
-    x = a + b + c + d.mem1 + d.mem2 + e.mem1 + e.mem2;
-    return x;
-}
-
-unsigned long ffi_test_67(unsigned long a, unsigned long b, unsigned long c,
-                          struct test_struct_66 d, struct test_struct_66 e,
-                          unsigned long f) {
-    unsigned long x;
-    x = a + b + c + d.mem1 + d.mem2 + e.mem1 + e.mem2 + f*2;
-    return x;
-}
-
-unsigned long ffi_test_68(unsigned long a, unsigned long b, unsigned long c,
-                          struct test_struct_66 d, struct test_struct_68 e, struct test_struct_66 f) {
-    unsigned long x;
-    x = a + b + c + d.mem1 + d.mem2 + e.mem1 + e.mem2 + e.mem3 + f.mem1 + f.mem2;
-	return x;
-}
 
 void* bug1021_test_1(void* x, int y) {
   return (void*)(y * y + (size_t)x);
diff --git a/vm/ffi_test.h b/vm/ffi_test.h
index 97ee793302..1c7ae7ddb3 100644
--- a/vm/ffi_test.h
+++ b/vm/ffi_test.h
@@ -232,27 +232,6 @@ FACTOR_EXPORT struct ulonglong_pair ffi_test_63(void);
 FACTOR_EXPORT int ffi_test_64(int n, ...);
 FACTOR_EXPORT double ffi_test_65(int n, ...);
 
-
-struct test_struct_66 {
-  unsigned long mem1;
-  unsigned long mem2;
-};
-
-struct test_struct_68 {
-  unsigned long mem1;
-  unsigned long mem2;
-  unsigned long mem3;  
-};
-
-FACTOR_EXPORT unsigned long ffi_test_66(unsigned long a, unsigned long b, unsigned long c,
-                                        struct test_struct_66 d, struct test_struct_66 e);
-
-FACTOR_EXPORT unsigned long ffi_test_67(unsigned long a, unsigned long b, unsigned long c,
-                                        struct test_struct_66 d, struct test_struct_66 e, unsigned long f);
-
-FACTOR_EXPORT unsigned long ffi_test_68(unsigned long a, unsigned long b, unsigned long c,
-                                        struct test_struct_66 d, struct test_struct_68 e, struct test_struct_66 f);
-
 FACTOR_EXPORT void* bug1021_test_1(void* x, int y);
 FACTOR_EXPORT int bug1021_test_2(int x, char* y, void *z);
 FACTOR_EXPORT void* bug1021_test_3(int x);

From aba3d668491df8191c1ebe60a623afe9b5c19434 Mon Sep 17 00:00:00 2001
From: kusumotonorio <47816570+kusumotonorio@users.noreply.github.com>
Date: Mon, 20 Jan 2020 18:53:26 +0900
Subject: [PATCH 08/15] unix.factor: Use count

---
 basis/cpu/x86/64/unix/unix.factor | 11 ++---------
 1 file changed, 2 insertions(+), 9 deletions(-)

diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor
index ffb287f6e0..caef383769 100644
--- a/basis/cpu/x86/64/unix/unix.factor
+++ b/basis/cpu/x86/64/unix/unix.factor
@@ -31,15 +31,8 @@ M: x86.64 reserved-stack-space 0 ;
         f f 3array
     ] map :> reps
     int-reg-reps get float-reg-reps get and [
-        0 :> int-mems!
-        0 :> float-mems!
-        reps [
-            first int-rep? [
-                int-mems 1 + int-mems!
-            ] [
-                float-mems 1 + float-mems!
-            ] if
-        ] each
+        reps [ first int-rep? ] count :> int-mems
+        reps length int-mems - :> float-mems
         int-reg-reps get int-mems + 6 >
         float-reg-reps get float-mems + 8 > or [
             reps [ first t f 3array ] map

From 7349f9d95372ceaa848edb2978fa69e28d4beb7b Mon Sep 17 00:00:00 2001
From: kusumotonorio <47816570+kusumotonorio@users.noreply.github.com>
Date: Mon, 20 Jan 2020 20:38:43 +0900
Subject: [PATCH 09/15] boxing.factor: Use count

---
 .../cfg/builder/alien/boxing/boxing.factor    | 22 ++++++++-----------
 1 file changed, 9 insertions(+), 13 deletions(-)

diff --git a/basis/compiler/cfg/builder/alien/boxing/boxing.factor b/basis/compiler/cfg/builder/alien/boxing/boxing.factor
index 75321ec62d..05406653a1 100644
--- a/basis/compiler/cfg/builder/alien/boxing/boxing.factor
+++ b/basis/compiler/cfg/builder/alien/boxing/boxing.factor
@@ -13,21 +13,17 @@ SYMBOL: struct-return-area
 SYMBOLS: int-reg-reps float-reg-reps ;
 
 : record-reg-reps ( reps -- reps )
-    dup [
-        dup second not [  ! on-stack?: f 
-            first int-rep? int-reg-reps float-reg-reps ?
-            dup get [ inc ] [ drop ] if
-        ] [ drop ] if
-    ] each ;
+    dup  ! reps: { { reg-rep on-stack? odd-register? } ... }
+    [ [ [ second not ] [ first int-rep?     ] bi and ] count int-reg-reps   +@ ]
+    [ [ [ second not ] [ first int-rep? not ] bi and ] count float-reg-reps +@ ]
+    bi ;
 
 : unrecord-reg-reps ( reps -- reps )
-    dup [
-        dup second not [  ! on-stack?: f 
-            first int-rep? int-reg-reps float-reg-reps ?
-            dup get [ dec ] [ drop ] if
-        ] [ drop ] if
-    ] each ;
-
+    dup
+    [ [ [ second not ] [ first int-rep?     ] bi and ] count -1 * int-reg-reps   +@ ]
+    [ [ [ second not ] [ first int-rep? not ] bi and ] count -1 * float-reg-reps +@ ]
+    bi ;
+    
 GENERIC: flatten-c-type ( c-type -- pairs )
 
 M: c-type flatten-c-type

From 95519b013058d541f2c5c461a2f169442fa7b26f Mon Sep 17 00:00:00 2001
From: kusumotonorio <47816570+kusumotonorio@users.noreply.github.com>
Date: Mon, 20 Jan 2020 20:47:16 +0900
Subject: [PATCH 10/15] boxing.factor: Swap first and second positions

---
 basis/compiler/cfg/builder/alien/boxing/boxing.factor | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/basis/compiler/cfg/builder/alien/boxing/boxing.factor b/basis/compiler/cfg/builder/alien/boxing/boxing.factor
index 05406653a1..dd50feb4a7 100644
--- a/basis/compiler/cfg/builder/alien/boxing/boxing.factor
+++ b/basis/compiler/cfg/builder/alien/boxing/boxing.factor
@@ -14,14 +14,14 @@ SYMBOLS: int-reg-reps float-reg-reps ;
 
 : record-reg-reps ( reps -- reps )
     dup  ! reps: { { reg-rep on-stack? odd-register? } ... }
-    [ [ [ second not ] [ first int-rep?     ] bi and ] count int-reg-reps   +@ ]
-    [ [ [ second not ] [ first int-rep? not ] bi and ] count float-reg-reps +@ ]
+    [ [ [ first int-rep?     ] [ second not ] bi and ] count int-reg-reps   +@ ]
+    [ [ [ first int-rep? not ] [ second not ] bi and ] count float-reg-reps +@ ]
     bi ;
 
 : unrecord-reg-reps ( reps -- reps )
     dup
-    [ [ [ second not ] [ first int-rep?     ] bi and ] count -1 * int-reg-reps   +@ ]
-    [ [ [ second not ] [ first int-rep? not ] bi and ] count -1 * float-reg-reps +@ ]
+    [ [ [ first int-rep?     ] [ second not ] bi and ] count -1 * int-reg-reps   +@ ]
+    [ [ [ first int-rep? not ] [ second not ] bi and ] count -1 * float-reg-reps +@ ]
     bi ;
     
 GENERIC: flatten-c-type ( c-type -- pairs )

From 1eaa895c8a91a46c71383dc8e0d1dc5a23849e6c Mon Sep 17 00:00:00 2001
From: kusumotonorio <47816570+kusumotonorio@users.noreply.github.com>
Date: Thu, 23 Jan 2020 20:02:03 +0900
Subject: [PATCH 11/15] unix.factor: Bug fix etc., boxing.factor: Improves
 record/unrecord-reps

---
 .../cfg/builder/alien/boxing/boxing.factor      | 17 +++++++----------
 basis/cpu/x86/64/unix/unix.factor               |  7 +++----
 2 files changed, 10 insertions(+), 14 deletions(-)

diff --git a/basis/compiler/cfg/builder/alien/boxing/boxing.factor b/basis/compiler/cfg/builder/alien/boxing/boxing.factor
index dd50feb4a7..075a2df084 100644
--- a/basis/compiler/cfg/builder/alien/boxing/boxing.factor
+++ b/basis/compiler/cfg/builder/alien/boxing/boxing.factor
@@ -12,18 +12,15 @@ SYMBOL: struct-return-area
 
 SYMBOLS: int-reg-reps float-reg-reps ;
 
-: record-reg-reps ( reps -- reps )
-    dup  ! reps: { { reg-rep on-stack? odd-register? } ... }
-    [ [ [ first int-rep?     ] [ second not ] bi and ] count int-reg-reps   +@ ]
-    [ [ [ first int-rep? not ] [ second not ] bi and ] count float-reg-reps +@ ]
-    bi ;
+: reg-reps ( reps -- int-reps float-reps )
+    [ second ] reject [ [ first int-rep? ] count ] [ length over - ] bi ;
+
+: record-reg-reps ( reps -- reps )            
+    dup reg-reps [ int-reg-reps +@ ] [ float-reg-reps +@ ] bi* ;
 
 : unrecord-reg-reps ( reps -- reps )
-    dup
-    [ [ [ first int-rep?     ] [ second not ] bi and ] count -1 * int-reg-reps   +@ ]
-    [ [ [ first int-rep? not ] [ second not ] bi and ] count -1 * float-reg-reps +@ ]
-    bi ;
-    
+    dup reg-reps [ neg int-reg-reps +@ ] [ neg float-reg-reps +@ ] bi* ;
+
 GENERIC: flatten-c-type ( c-type -- pairs )
 
 M: c-type flatten-c-type
diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor
index caef383769..f5df862848 100644
--- a/basis/cpu/x86/64/unix/unix.factor
+++ b/basis/cpu/x86/64/unix/unix.factor
@@ -31,8 +31,7 @@ M: x86.64 reserved-stack-space 0 ;
         f f 3array
     ] map :> reps
     int-reg-reps get float-reg-reps get and [
-        reps [ first int-rep? ] count :> int-mems
-        reps length int-mems - :> float-mems
+        reps reg-reps :> ( int-mems float-mems )
         int-reg-reps get int-mems + 6 >
         float-reg-reps get float-mems + 8 > or [
             reps [ first t f 3array ] map
@@ -42,8 +41,8 @@ M: x86.64 reserved-stack-space 0 ;
 M: x86.64 flatten-struct-type ( c-type -- seq )
     dup heap-size 16 <=
     [ flatten-small-struct record-reg-reps ] [
-        call-next-method [ first t f 3array ] map
-        unrecord-reg-reps
+        call-next-method unrecord-reg-reps
+        [ first t f 3array ] map
     ] if ;
 
 M: x86.64 return-struct-in-registers? ( c-type -- ? )

From d992e87cd671f4fb4e62dbc9609c9705f6945d74 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 23 Jan 2020 19:44:03 -0600
Subject: [PATCH 12/15] LICENSE.txt: Update the copyright year!

---
 LICENSE.txt | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/LICENSE.txt b/LICENSE.txt
index 9e25f74a59..fc4fbc9767 100644
--- a/LICENSE.txt
+++ b/LICENSE.txt
@@ -1,4 +1,4 @@
-Copyright (c) 2019, Slava Pestov, et al.
+Copyright (c) 2020, Slava Pestov, et al.
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without

From eb4c6cf71157ec0b3db1d61086116e0373c267b4 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Fri, 24 Jan 2020 13:47:20 -0800
Subject: [PATCH 13/15] bittorrent: initial commit of message parsing.

---
 extra/bittorrent/authors.txt             |   1 +
 extra/bittorrent/bittorrent-tests.factor |  10 +
 extra/bittorrent/bittorrent.factor       | 277 +++++++++++++++++++++++
 extra/bittorrent/summary.txt             |   1 +
 4 files changed, 289 insertions(+)
 create mode 100644 extra/bittorrent/authors.txt
 create mode 100644 extra/bittorrent/bittorrent-tests.factor
 create mode 100644 extra/bittorrent/bittorrent.factor
 create mode 100644 extra/bittorrent/summary.txt

diff --git a/extra/bittorrent/authors.txt b/extra/bittorrent/authors.txt
new file mode 100644
index 0000000000..e091bb8164
--- /dev/null
+++ b/extra/bittorrent/authors.txt
@@ -0,0 +1 @@
+John Benediktsson
diff --git a/extra/bittorrent/bittorrent-tests.factor b/extra/bittorrent/bittorrent-tests.factor
new file mode 100644
index 0000000000..1c2e9585c6
--- /dev/null
+++ b/extra/bittorrent/bittorrent-tests.factor
@@ -0,0 +1,10 @@
+USING: bittorrent io.sockets tools.test ;
+
+{
+    {
+        T{ inet4 { host "127.0.0.1" } { port 80 } }
+        T{ inet4 { host "1.1.1.1" } { port 443 } }
+    }
+} [
+    B{ 127 0 0 1 0x00 0x50 1 1 1 1 0x01 0xbb } parse-peer4s
+] unit-test
diff --git a/extra/bittorrent/bittorrent.factor b/extra/bittorrent/bittorrent.factor
new file mode 100644
index 0000000000..c831372b39
--- /dev/null
+++ b/extra/bittorrent/bittorrent.factor
@@ -0,0 +1,277 @@
+! Copyright (C) 2020 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+USING: accessors arrays assocs bencode byte-arrays checksums
+checksums.sha combinators fry grouping http.client io io.binary
+io.encodings.binary io.files io.pathnames io.sockets
+io.streams.byte-array kernel literals make math math.bitwise
+math.parser math.ranges namespaces random sequences splitting
+strings urls ;
+
+IN: bittorrent
+
+<<
+CONSTANT: ALPHANUMERIC $[
+    [
+        CHAR: a CHAR: z [a,b] %
+        CHAR: A CHAR: Z [a,b] %
+        CHAR: 0 CHAR: 9 [a,b] %
+        ".-_~" %
+    ] { } make
+]
+
+: random-peer-id ( -- bytes )
+    20 [ ALPHANUMERIC random ] B{ } replicate-as ;
+>>
+
+SYMBOL: torrent-peer-id
+torrent-peer-id [ random-peer-id ] initialize
+
+SYMBOL: torrent-port
+torrent-port [ 6881 ] initialize
+
+
+! bitfield
+
+: bitfield-index ( n -- j i )
+    8 /mod 7 swap - ;
+
+: set-bitfield ( elt n bitfield -- )
+    [ bitfield-index rot ] dip -rot
+    '[ _ _ [ set-bit ] [ clear-bit ] if ] change-nth ;
+
+: check-bitfield ( n bitfield -- ? )
+    [ bitfield-index swap ] dip nth bit? ;
+
+
+! http
+
+: http-get-bencode ( url -- obj )
+    <get-request> BV{ } clone [
+        '[ _ push-all ] with-http-request* check-response drop
+    ] keep B{ } like bencode> ;
+
+
+! metainfo
+
+GENERIC: load-metainfo ( obj -- metainfo )
+
+M: url load-metainfo http-get-bencode ;
+
+M: pathname load-metainfo
+    binary [ read-bencode ] with-file-reader ;
+
+M: string load-metainfo
+    dup "http" head? [ >url ] [ <pathname> ] if load-metainfo ;
+
+: info-hash ( metainfo -- hash )
+    "info hash" swap dup '[
+        drop _ "info" of >bencode sha1 checksum-bytes
+    ] cache ;
+
+: announce-url ( metainfo -- url )
+    dup "announce-list" of [ nip first random ] [ "announce" of ] if* ;
+
+: scrape-url ( metainfo -- url/f )
+    announce-url "announce" over path>> subseq? [
+        [ "announce" "scrape" replace ] change-path
+    ] [ drop f ] if ;
+
+
+
+! tracker
+
+: tracker-url ( metainfo -- url )
+    {
+        [ announce-url >url ]
+        [
+            info-hash "info_hash" set-query-param
+            torrent-peer-id get "peer_id" set-query-param
+            torrent-port get "port" set-query-param
+            0 "uploaded" set-query-param
+            0 "downloaded" set-query-param
+            1 "compact" set-query-param
+        ]
+        [
+            { "info" "length" } [ of ] each
+            "left" set-query-param
+        ]
+    } cleave ;
+
+: parse-peer4 ( peerbin -- inet4 )
+    4 cut [
+        [ number>string ] { } map-as "." join
+    ] dip be> <inet4> ;
+
+: parse-peer4s ( peersbin -- inet4s )
+    dup array? [
+        [ [ "ip" of ] [ "port" of ] bi <inet4> ] map
+    ] [
+        6 <groups> [ parse-peer4 ] map
+    ] if ;
+
+: parse-peer6 ( peerbin -- inet6 )
+    16 cut [
+        2 <groups> [ be> number>string ] map ":" join
+    ] dip be> <inet6> ;
+
+: parse-peer6s ( peersbin -- inet6s )
+    18 <groups> [ parse-peer6 ] map ;
+
+: load-tracker ( torrent -- response )
+    tracker-url http-get-bencode
+    "peers" over [ parse-peer4s ] change-at ;
+
+: send-event ( torrent event -- response )
+    [ tracker-url ] [ "event" set-query-param ] bi*
+    http-get-bencode ;
+
+
+
+! messages
+
+TUPLE: handshake string reserved info-hash peer-id ;
+
+: <handshake> ( info-hash peer-id -- handshake )
+    handshake new
+        "BitTorrent protocol" >byte-array >>string
+        8 <byte-array> >>reserved
+        swap >>peer-id
+        swap >>info-hash ;
+
+: read-handshake ( -- handshake/f )
+    read1 [
+        [ 48 + read ] keep cut 8 cut 20 cut handshake boa
+    ] [ f ] if* ;
+
+: write-handshake ( handshake -- )
+    {
+        [ string>> [ length write1 ] [ write ] bi ]
+        [ reserved>> write ]
+        [ info-hash>> write ]
+        [ peer-id>> write ]
+    } cleave flush ;
+
+TUPLE: keep-alive ;
+TUPLE: choke ;
+TUPLE: unchoke ;
+TUPLE: interested ;
+TUPLE: not-interested ;
+TUPLE: have index ;
+TUPLE: bitfield bitfield ;
+TUPLE: request index begin length ;
+TUPLE: piece index begin block ;
+TUPLE: cancel index begin length ;
+TUPLE: port port ;
+TUPLE: suggest-piece index ;
+TUPLE: have-all ;
+TUPLE: have-none ;
+TUPLE: reject-request index begin length ;
+TUPLE: allowed-fast index ;
+TUPLE: extended id payload ;
+TUPLE: unknown id payload ;
+
+: read-int ( -- n/f ) 4 read [ be> ] [ f ] if* ;
+
+: parse-message ( bytes -- message/f )
+    unclip {
+        ! Core Protocol
+        { 0 [ drop choke boa ] }
+        { 1 [ drop unchoke boa ] }
+        { 2 [ drop interested boa ] }
+        { 3 [ drop not-interested boa ] }
+        { 4 [ 4 head be> have boa ] }
+        { 5 [ bitfield boa ] }
+        { 6 [ 4 cut 4 cut 4 head [ be> ] tri@ request boa ] }
+        { 7 [ 4 cut 4 cut [ [ be> ] bi@ ] dip piece boa ] }
+        { 8 [ 4 cut 4 cut 4 head [ be> ] tri@ cancel boa ] }
+
+        ! DHT Extension
+        { 9 [ be> port boa ] }
+
+        ! Fast Extensions
+        { 0x0D [ 4 head be> suggest-piece boa ] }
+        { 0x0E [ drop have-all boa ] }
+        { 0x0F [ drop have-none boa ] }
+        { 0x10 [ 4 cut 4 cut 4 head [ be> ] tri@ reject-request boa ] }
+        { 0x11 [ 4 head be> allowed-fast boa ] }
+
+        ! Extension Protocol
+        { 0x14 [ unclip swap extended boa ] }
+
+        ! Hash Transfer Protocol
+        ! { 0x15 [ "HashRequest" ] }
+        ! { 0x16 [ "Hashes" ] }
+        ! { 0x17 [ "HashReject" ] }
+        [ swap unknown boa ]
+    } case ;
+
+: read-message ( -- message )
+    read-int {
+        { f [ f ] }
+        { 0 [ keep-alive boa ] }
+        [ read [ parse-message ] [ f ] if* ]
+    } case ;
+
+: write-int ( n -- ) 4 >be write ;
+
+GENERIC: write-message ( message -- )
+
+M: keep-alive write-message drop 0 write-int ;
+
+M: choke write-message drop 1 write-int 0 write1 ;
+
+M: unchoke write-message drop 1 write-int 1 write1 ;
+
+M: interested write-message drop 1 write-int 2 write1 ;
+
+M: not-interested write-message drop 1 write-int 3 write1 ;
+
+M: have write-message
+    5 write-int 4 write1 index>> write-int ;
+
+M: bitfield write-message
+    field>> dup length 1 + write-int 5 write1 write ;
+
+M: request write-message
+    [ index>> ] [ begin>> ] [ length>> ] tri
+    13 write-int 6 write1 [ write-int ] tri@ ;
+
+M: piece write-message
+    [ index>> ] [ offset>> ] [ block>> ] tri
+    dup length 9 + write-int 7 write1
+    [ write-int ] [ write-int ] [ write ] tri* ;
+
+M: cancel write-message
+    [ index>> ] [ offset>> ] [ length>> ] tri
+    13 write-int 8 write1 [ write-int ] tri@ ;
+
+M: port write-message
+    5 write-int 9 write1 port>> write-int ;
+
+M: suggest-piece write-message
+    5 write-int 0x0D write1 index>> write-int ;
+
+M: have-all write-message drop 1 write-int 0x0E write1 ;
+
+M: have-none write-message drop 1 write-int 0x0F write1 ;
+
+M: reject-request write-message
+    [ index>> ] [ begin>> ] [ length>> ] tri
+    13 write-int 0x10 write1 [ write-int ] tri@ ;
+
+M: allowed-fast write-message
+    5 write-int 0x11 write1 index>> write-int ;
+
+M: extended write-message
+    [ payload>> ] [ id>> ] bi
+    over length 2 + write-int 0x14 write1 write1 write ;
+
+M: unknown write-message
+    [ payload>> ] [ id>> ] bi
+    over length 1 + write-int write1 write ;
+
+: >message ( bytes -- message )
+    binary [ read-message ] with-byte-reader ;
+
+: message> ( message -- bytes )
+    binary [ write-message ] with-byte-writer ;
diff --git a/extra/bittorrent/summary.txt b/extra/bittorrent/summary.txt
new file mode 100644
index 0000000000..9275727d01
--- /dev/null
+++ b/extra/bittorrent/summary.txt
@@ -0,0 +1 @@
+BitTorent protocol for peer-to-peer file sharing.

From fb3928f8073ccad00ddb1ed41c088e1333b1a53f Mon Sep 17 00:00:00 2001
From: kusumotonorio <47816570+kusumotonorio@users.noreply.github.com>
Date: Sat, 25 Jan 2020 06:54:33 +0900
Subject: [PATCH 14/15] Tests for System V AMD64 ABI (#2233)

* Adds Tests for System V AMD64 ABI

* Remove TABs, etc.

* Adds a test

* Some Cleanup

* Add Callback Tests

* Add More Tests
---
 basis/compiler/tests/alien.factor | 116 +++++++++++++++++++++++++++++-
 vm/ffi_test.c                     |  35 +++++++++
 vm/ffi_test.def                   |   9 ++-
 vm/ffi_test.h                     |  33 +++++++++
 4 files changed, 190 insertions(+), 3 deletions(-)

diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor
index 3e4f149077..7edb840226 100644
--- a/basis/compiler/tests/alien.factor
+++ b/basis/compiler/tests/alien.factor
@@ -2,7 +2,7 @@ USING: accessors alien alien.c-types alien.complex alien.data alien.libraries
 alien.syntax arrays byte-arrays classes classes.struct combinators
 combinators.extras compiler compiler.test concurrency.promises continuations
 destructors effects generalizations io io.backend io.pathnames
-io.streams.string kernel kernel.private libc layouts math math.bitwise
+io.streams.string kernel kernel.private libc layouts locals math math.bitwise
 math.private memory namespaces namespaces.private random parser quotations
 sequences slots.private specialized-arrays stack-checker stack-checker.errors
 system threads tools.test words ;
@@ -963,3 +963,117 @@ FUNCTION: void* bug1021_test_3 ( c-string a )
 { } [
     10000 [ 0 doit 33 assert= ] times
 ] unit-test
+
+! Tests for System V AMD64 ABI 
+STRUCT: test_struct_66 { mem1 ulong } { mem2 ulong } ;
+STRUCT: test_struct_68 { mem1 ulong } { mem2 ulong } { mem3 ulong } ;
+STRUCT: test_struct_69 { mem1 float } { mem2 ulong } { mem3 ulong } ;
+FUNCTION: ulong ffi_test_66 ( ulong a, ulong b, ulong c, test_struct_66 d, test_struct_66 e )
+FUNCTION: ulong ffi_test_67 ( ulong a, ulong b, ulong c, test_struct_66 d, test_struct_66 e ulong _f )
+FUNCTION: ulong ffi_test_68 ( ulong a, ulong b, ulong c, test_struct_66 d, test_struct_68 e test_struct_66 _f )
+FUNCTION: ulong ffi_test_69 ( ulong a, ulong b, ulong c, test_struct_66 d, test_struct_69 e test_struct_66 _f )
+FUNCTION: ulong ffi_test_70 ( test_struct_68 a test_struct_68 b, test_struct_66 c )  
+
+{ 28 } [ 1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_66 f 6 7 } ffi_test_66 ] unit-test
+
+: callback-14 ( -- callback )
+    ulong { ulong ulong ulong test_struct_66 test_struct_66 } cdecl
+    [| a b c d e |
+        a b + c +
+        d [ mem1>> + ] [ mem2>> + ] bi
+        e [ mem1>> + ] [ mem2>> + ] bi
+    ] alien-callback ;
+
+: callback-14-test ( a b c d e callback -- result )
+    ulong { ulong ulong ulong test_struct_66 test_struct_66 } cdecl alien-indirect ;
+
+{ 28 } [
+    1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_66 f 6 7 } callback-14 [
+        callback-14-test
+    ] with-callback
+] unit-test
+
+{ 44 } [ 1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_66 f 6 7 } 8 ffi_test_67 ] unit-test
+
+: callback-15 ( -- callback )
+    ulong { ulong ulong ulong test_struct_66 test_struct_66 ulong } cdecl
+    [| a b c d e _f |
+        a b + c +
+        d [ mem1>> + ] [ mem2>> + ] bi
+        e [ mem1>> + ] [ mem2>> + ] bi
+        _f 2 * + 
+    ] alien-callback ;
+
+: callback-15-test ( a b c d e _f callback -- result )
+    ulong { ulong ulong ulong test_struct_66 test_struct_66 ulong } cdecl alien-indirect ;
+
+{ 44 } [
+    1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_66 f 6 7 } 8 callback-15 [
+        callback-15-test
+    ] with-callback
+] unit-test
+
+{ 55 } [
+    1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_68 f 6 7 8 } S{ test_struct_66 f 9 10 } ffi_test_68
+] unit-test
+
+: callback-16 ( -- callback )
+    ulong { ulong ulong ulong test_struct_66 test_struct_68 test_struct_66 } cdecl
+    [| a b c d e _f |
+        a b + c +
+        d [ mem1>> + ] [ mem2>> + ] bi
+        e [ mem1>> + ] [ mem2>> + ] [ mem3>> + ] tri
+        _f [ mem1>> + ] [ mem2>> + ] bi
+    ] alien-callback ;
+
+: callback-16-test ( a b c d e _f callback -- result )
+    ulong { ulong ulong ulong test_struct_66 test_struct_68 test_struct_66 } cdecl alien-indirect ;
+
+{ 55 } [
+    1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_68 f 6 7 8 } S{ test_struct_66 f 9 10 } callback-16 [
+        callback-16-test
+    ] with-callback
+] unit-test
+
+{ 55 } [
+   1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_69 f 6.0 7 8 } S{ test_struct_66 f 9 10 } ffi_test_69
+] unit-test
+
+: callback-17 ( -- callback )
+    ulong { ulong ulong ulong test_struct_66 test_struct_69 test_struct_66 } cdecl
+    [| a b c d e _f |
+        a b + c +
+        d [ mem1>> + ] [ mem2>> + ] bi
+        e [ mem1>> >integer + ] [ mem2>> + ] [ mem3>> + ] tri
+        _f [ mem1>> + ] [ mem2>> + ] bi
+    ] alien-callback ;
+
+: callback-17-test ( a b c d e _f callback -- result )
+    ulong { ulong ulong ulong test_struct_66 test_struct_69 test_struct_66 } cdecl alien-indirect ;
+
+{ 55 } [
+    1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_69 f 6.0 7 8 } S{ test_struct_66 f 9 10 } callback-17 [
+        callback-17-test
+    ] with-callback
+] unit-test
+
+{ 36 } [
+    S{ test_struct_68 f 1 2 3 } S{ test_struct_68 f 4 5 6 } S{ test_struct_66 f 7 8 } ffi_test_70
+] unit-test
+
+: callback-18 ( -- callback )
+    ulong { test_struct_68 test_struct_68 test_struct_66 } cdecl
+    [| a b c |
+        a [ mem1>> ] [ mem2>> + ] [ mem3>> + ] tri     
+        b [ mem1>> + ] [ mem2>> + ] [ mem3>> + ] tri
+        c [ mem1>> + ] [ mem2>> + ] bi
+    ] alien-callback ;
+
+: callback-18-test ( a b c callback -- result )
+    ulong { test_struct_68 test_struct_68 test_struct_66 } cdecl alien-indirect ;
+
+{ 36 } [
+    S{ test_struct_68 f 1 2 3 } S{ test_struct_68 f 4 5 6 } S{ test_struct_66 f 7 8 } callback-18 [
+        callback-18-test
+    ] with-callback
+] unit-test
diff --git a/vm/ffi_test.c b/vm/ffi_test.c
index 1927a8d988..7e927b9d27 100644
--- a/vm/ffi_test.c
+++ b/vm/ffi_test.c
@@ -357,6 +357,41 @@ double ffi_test_65(int n, ...) {
     return sum;
 }
 
+unsigned long ffi_test_66(unsigned long a, unsigned long b, unsigned long c,
+                          struct test_struct_66 d, struct test_struct_66 e) {
+    unsigned long x;
+    x = a + b + c + d.mem1 + d.mem2 + e.mem1 + e.mem2;
+    return x;
+}
+
+unsigned long ffi_test_67(unsigned long a, unsigned long b, unsigned long c,
+                          struct test_struct_66 d, struct test_struct_66 e,
+                          unsigned long f) {
+    unsigned long x;
+    x = a + b + c + d.mem1 + d.mem2 + e.mem1 + e.mem2 + f*2;
+    return x;
+}
+
+unsigned long ffi_test_68(unsigned long a, unsigned long b, unsigned long c,
+                          struct test_struct_66 d, struct test_struct_68 e, struct test_struct_66 f) {
+    unsigned long x;
+    x = a + b + c + d.mem1 + d.mem2 + e.mem1 + e.mem2 + e.mem3 + f.mem1 + f.mem2;
+    return x;
+}
+
+unsigned long ffi_test_69(unsigned long a, unsigned long b, unsigned long c,
+                          struct test_struct_66 d, struct test_struct_69 e, struct test_struct_66 f) {
+    unsigned long x;
+    x = a + b + c + d.mem1 + d.mem2 + (long)e.mem1 + e.mem2 + e.mem3 + f.mem1 + f.mem2;
+    return x;
+}
+
+unsigned long ffi_test_70(struct test_struct_68 a, struct test_struct_68 b, struct test_struct_66 c) { 
+    unsigned long x;
+    x = a.mem1 + a.mem2 + a.mem3 + b.mem1 + b.mem2 + b.mem3 + c.mem1 + c.mem2;
+    return x;
+}
+
 
 void* bug1021_test_1(void* x, int y) {
   return (void*)(y * y + (size_t)x);
diff --git a/vm/ffi_test.def b/vm/ffi_test.def
index fd5ff7b27e..4602bf92c4 100644
--- a/vm/ffi_test.def
+++ b/vm/ffi_test.def
@@ -1,5 +1,5 @@
 EXPORTS
-	ffi_test_0
+        ffi_test_0
         ffi_test_1
         ffi_test_2
         ffi_test_3
@@ -46,7 +46,7 @@ EXPORTS
         ffi_test_42
         ffi_test_43
         ffi_test_44
-	ffi_test_49
+        ffi_test_49
         ffi_test_50
         ffi_test_51
         ffi_test_52
@@ -62,6 +62,11 @@ EXPORTS
         ffi_test_63
         ffi_test_64
         ffi_test_65
+        ffi_test_66
+        ffi_test_67
+        ffi_test_68
+        ffi_test_69
+        ffi_test_70		
         bug1021_test_1
         bug1021_test_2
         bug1021_test_3
diff --git a/vm/ffi_test.h b/vm/ffi_test.h
index 1c7ae7ddb3..0a78885f03 100644
--- a/vm/ffi_test.h
+++ b/vm/ffi_test.h
@@ -232,6 +232,39 @@ FACTOR_EXPORT struct ulonglong_pair ffi_test_63(void);
 FACTOR_EXPORT int ffi_test_64(int n, ...);
 FACTOR_EXPORT double ffi_test_65(int n, ...);
 
+
+struct test_struct_66 {
+  unsigned long mem1;
+  unsigned long mem2;
+};
+
+struct test_struct_68 {
+  unsigned long mem1;
+  unsigned long mem2;
+  unsigned long mem3;  
+};
+
+struct test_struct_69 {
+  float         mem1;
+  unsigned long mem2;
+  unsigned long mem3;  
+};
+
+FACTOR_EXPORT unsigned long ffi_test_66(unsigned long a, unsigned long b, unsigned long c,
+                                        struct test_struct_66 d, struct test_struct_66 e);
+
+FACTOR_EXPORT unsigned long ffi_test_67(unsigned long a, unsigned long b, unsigned long c,
+                                        struct test_struct_66 d, struct test_struct_66 e, unsigned long f);
+
+FACTOR_EXPORT unsigned long ffi_test_68(unsigned long a, unsigned long b, unsigned long c,
+                                        struct test_struct_66 d, struct test_struct_68 e, struct test_struct_66 f);
+
+FACTOR_EXPORT unsigned long ffi_test_69(unsigned long a, unsigned long b, unsigned long c,
+                                        struct test_struct_66 d, struct test_struct_69 e, struct test_struct_66 f);
+
+FACTOR_EXPORT unsigned long ffi_test_70(struct test_struct_68 a, struct test_struct_68 b, struct test_struct_66 c);
+
+
 FACTOR_EXPORT void* bug1021_test_1(void* x, int y);
 FACTOR_EXPORT int bug1021_test_2(int x, char* y, void *z);
 FACTOR_EXPORT void* bug1021_test_3(int x);

From a62ea78d73f3a824aec8698b9613edd2e312f75d Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Fri, 24 Jan 2020 14:47:42 -0800
Subject: [PATCH 15/15] ui.backend.cocoa.views: some formatting cleanup.

---
 basis/ui/backend/cocoa/views/views.factor | 303 +++++++++++-----------
 1 file changed, 151 insertions(+), 152 deletions(-)

diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor
index 6f412ce29a..62e04d8f9e 100644
--- a/basis/ui/backend/cocoa/views/views.factor
+++ b/basis/ui/backend/cocoa/views/views.factor
@@ -193,7 +193,7 @@ IMPORT: NSAttributedString
 
 :: >codepoint-index ( str utf16-index -- codepoint-index )
     0 utf16-index 2 * str utf16n encode subseq utf16n decode length ;
-    
+
 :: >utf16-index ( str codepoint-index -- utf16-index )
     0 codepoint-index str subseq utf16n encode length 2 / >integer ;
 
@@ -213,7 +213,7 @@ IMPORT: NSAttributedString
     0 0 <NSRange> :> effective-range
     text -> string CF>string :> str
     str utf16n encode :> byte-16n
-    0 :> cp-loc!    
+    0 :> cp-loc!
     "NSMarkedClauseSegment" <NSString> :> segment-attr
     [ effective-range [ location>> ] [ length>> ] bi + text-length < ] [
         text
@@ -231,14 +231,14 @@ IMPORT: NSAttributedString
         [ str swap >codepoint-index ] bi@ swap - :> len
         cp-loc cp-loc len + dup cp-loc!
         2array thickness 2array
-        suffix underlines! 
+        suffix underlines!
     ] while 
     underlines length 1 = [
         underlines first first 2 2array 1array  ! thickness: 2
     ] [ underlines ] if ;
 
 :: update-marked-text ( gadget str selectedRange replacementRange -- )
-    replacementRange location>>  NSNotFound = not [ 
+    replacementRange location>> NSNotFound = [
         gadget editor-caret first
         dup gadget editor-line
         [ 
@@ -253,12 +253,12 @@ IMPORT: NSAttributedString
         gadget earlier-caret/mark dup
         gadget preedit-start<<
         0 1 2array v+ gadget preedit-end<<
-    ] when
+    ] unless
 
     gadget preedit? [
         gadget remove-preedit-text
     ] when
-    
+
     gadget earlier-caret/mark dup
     gadget preedit-start<<
     0 str length 2array v+ gadget preedit-end<<
@@ -271,7 +271,7 @@ IMPORT: NSAttributedString
     [ str swap >codepoint-index ] bi@ -
     2array v+
     dup gadget preedit-selected-end<<
-    dup gadget set-caret gadget set-mark          
+    dup gadget set-caret gadget set-mark
     gadget preedit-start>> gadget preedit-end>> = [
         gadget remove-preedit-info 
     ] when ;
@@ -459,179 +459,178 @@ PRIVATE>
 
     ! Text input
     METHOD: void insertText: id text replacementRange: NSRange replacementRange [
-            self window :> window
-            window [
-                "" clone :> str!
-                text NSString -> class -> isKindOfClass: 0 = not [
-                    text CF>string str!               
-                ] [
-                    text -> string CF>string str!               
-                ] if
-                window world-focus :> gadget
-                gadget [
-                    gadget support-input-methods? [                        
-                        replacementRange location>> NSNotFound = [                        
-                            gadget editor-caret first
-                            dup gadget editor-line
-                            [ 
-                                replacementRange location>> >codepoint-index
-                                2array gadget set-caret
-                            ] [
-                                replacementRange [ location>> ] [ length>> ] bi + 
-                                >codepoint-index
-                                2array gadget set-mark
-                            ] 2bi                        
-                        ] unless
-                        gadget preedit? [
-                            gadget [ remove-preedit-text ] [ remove-preedit-info ] bi
-                            str gadget user-input* drop
-                            f gadget preedit-selection-mode?<<
+        self window :> window
+        window [
+            "" clone :> str!
+            text NSString -> class -> isKindOfClass: 0 = not [
+                text CF>string str!
+            ] [
+                text -> string CF>string str!
+            ] if
+            window world-focus :> gadget
+            gadget [
+                gadget support-input-methods? [
+                    replacementRange location>> NSNotFound = [
+                        gadget editor-caret first
+                        dup gadget editor-line
+                        [ 
+                            replacementRange location>> >codepoint-index
+                            2array gadget set-caret
                         ] [
-                            str window user-input                           
-                        ] if
-                    ] [ 
+                            replacementRange [ location>> ] [ length>> ] bi +
+                            >codepoint-index
+                            2array gadget set-mark
+                        ] 2bi
+                    ] unless
+                    gadget preedit? [
+                        gadget remove-preedit-text
+                        gadget remove-preedit-info
+                        str gadget user-input* drop
+                        f gadget preedit-selection-mode?<<
+                    ] [
                         str window user-input
                     ] if
-                ] when
+                ] [ 
+                    str window user-input
+                ] if
             ] when
-        ] ;
+        ] when
+    ] ;
 
     METHOD: char hasMarkedText [
-            self window :> window
-            window [
-                window world-focus :> gadget
-                gadget [
-                    gadget preedit? [ 1 ] [ 0 ] if
-                ] [ 0 ] if
+        self window :> window
+        window [
+            window world-focus :> gadget
+            gadget [
+                gadget preedit? 1 0 ?
             ] [ 0 ] if
-        ] ;
+        ] [ 0 ] if
+    ] ;
 
-    METHOD: NSRange markedRange [ 
-            self window :> window
-            window [
-                window world-focus :> gadget
-                gadget [
-                    gadget preedit? [
-                        gadget [ preedit-start>> second ] [ preedit-end>> second ] bi >= [ 
-                            NSNotFound 0 
-                        ] [
-                            gadget preedit-start>> first gadget editor-line :> str
-                            gadget
-                            [ preedit-start>> second ]                 ! location
-                            [ preedit-end>> second ]
-                            bi [ str swap >utf16-index ] bi@ over -    ! length
-                        ] if
-                    ] [  NSNotFound 0 ] if
-                ] [  NSNotFound 0 ] if
+    METHOD: NSRange markedRange [
+        self window :> window
+        window [
+            window world-focus :> gadget
+            gadget [
+                gadget preedit? [
+                    gadget preedit-start>> second
+                    gadget preedit-end>> second < [
+                        gadget preedit-start>> first gadget editor-line :> str
+                        gadget preedit-start>> second           ! location
+                        gadget preedit-end>> second
+                        [ str swap >utf16-index ] bi@ over -    ! length
+                    ] [ NSNotFound 0 ] if
+                ] [ NSNotFound 0 ] if
             ] [ NSNotFound 0 ] if
-            <NSRange>
-        ] ;
+        ] [ NSNotFound 0 ] if
+        <NSRange>
+    ] ;
 
     METHOD: NSRange selectedRange [
-            self window :> window
-            window [
-                window world-focus :> gadget
-                gadget [
-                    gadget support-input-methods? [
-                        gadget editor-caret first gadget editor-line :> str
-                        gadget preedit? [
-                            str
-                            gadget
-                            [ preedit-selected-start>> second ]
-                            [ preedit-start>> second ] 
-                            bi - >utf16-index                        ! location
-                            gadget
-                            [ preedit-selected-end>> second ]
-                            [ preedit-selected-start>> second ]
-                            bi [ str swap >utf16-index ] bi@ -       ! length
-                        ] [                            
-                            str gadget editor-caret second >utf16-index 0
-                        ] if
-                    ] [ 0 0 ] if
-                ] [ 0 0 ] if
-            ] [ 0 0 ] if 
-            <NSRange>
-        ] ;
-   
-    METHOD: void setMarkedText: id text selectedRange: NSRange selectedRange
-                                     replacementRange: NSRange replacementRange [           
-            self window :> window
-            window [
-                window world-focus :> gadget
-                gadget [
-                    { } clone :> underlines!
-                    "" clone :> str!
-                    text NSString -> class -> isKindOfClass: 0 = not [
-                        text CF>string str!               
+        self window :> window
+        window [
+            window world-focus :> gadget
+            gadget [
+                gadget support-input-methods? [
+                    gadget editor-caret first gadget editor-line :> str
+                    gadget preedit? [
+                        str
+                        gadget preedit-selected-start>> second
+                        gadget preedit-start>> second
+                        - >utf16-index                        ! location
+                        gadget preedit-selected-end>> second
+                        gadget preedit-selected-start>> second
+                        [ str swap >utf16-index ] bi@ -       ! length
                     ] [
-                        text -> string CF>string str!               
-                        gadget support-input-methods? [
-                            gadget text selectedRange make-preedit-underlines underlines!
-                        ] when
+                        str gadget editor-caret second >utf16-index 0
                     ] if
+                ] [ 0 0 ] if
+            ] [ 0 0 ] if
+        ] [ 0 0 ] if 
+        <NSRange>
+    ] ;
+
+    METHOD: void setMarkedText: id text selectedRange: NSRange selectedRange
+                                     replacementRange: NSRange replacementRange [
+        self window :> window
+        window [
+            window world-focus :> gadget
+            gadget [
+                { } clone :> underlines!
+                "" clone :> str!
+                text NSString -> class -> isKindOfClass: 0 = not [
+                    text CF>string str!
+                ] [
+                    text -> string CF>string str!
                     gadget support-input-methods? [
-                        gadget str selectedRange replacementRange update-marked-text
-                        underlines gadget preedit-underlines<<
-                    ] when
-                ] when
-            ] when            
-        ] ;
-             
-    METHOD: void unmarkText [ 
-            self window :> window
-            window [
-                window world-focus :> gadget
-                gadget [
-                    gadget support-input-methods? [
-                        gadget preedit? [
-                            gadget {
-                                [ preedit-start>> second ]
-                                [ preedit-end>> second ]
-                                [ preedit-start>> first ] [ editor-line ]
-                            } cleave subseq
-                            gadget [ remove-preedit-text ] [ remove-preedit-info ] bi
-                            gadget user-input* drop
-                        ] when
-                        f gadget preedit-selection-mode?<<
+                        gadget text selectedRange make-preedit-underlines underlines!
                     ] when
+                ] if
+                gadget support-input-methods? [
+                    gadget str selectedRange replacementRange update-marked-text
+                    underlines gadget preedit-underlines<<
                 ] when
             ] when
-        ] ;
-    
-    METHOD: id validAttributesForMarkedText [             
-            NSArray "NSMarkedClauseSegment" <NSString> -> arrayWithObject:
-        ] ;
+        ] when
+    ] ;
+
+    METHOD: void unmarkText [
+        self window :> window
+        window [
+            window world-focus :> gadget
+            gadget [
+                gadget support-input-methods? [
+                    gadget preedit? [
+                        gadget {
+                            [ preedit-start>> second ]
+                            [ preedit-end>> second ]
+                            [ preedit-start>> first ]
+                            [ editor-line ]
+                        } cleave subseq
+                        gadget remove-preedit-text
+                        gadget remove-preedit-info
+                        gadget user-input* drop
+                    ] when
+                    f gadget preedit-selection-mode?<<
+                ] when
+            ] when
+        ] when
+    ] ;
+
+    METHOD: id validAttributesForMarkedText [
+        NSArray "NSMarkedClauseSegment" <NSString> -> arrayWithObject:
+    ] ;
 
     METHOD: id attributedSubstringForProposedRange: NSRange aRange
                                        actualRange: id actualRange [ f ] ;
-    
+
     METHOD: NSUInteger characterIndexForPoint: NSPoint point [ 0 ] ;
 
     METHOD: NSRect firstRectForCharacterRange: NSRange aRange
                                   actualRange: NSRange actualRange [
-            self window :> window
-            window [
-                window world-focus :> gadget
-                gadget [
-                    gadget support-input-methods? [
-                        gadget editor-caret first gadget editor-line :> str                
-                        str aRange location>> >codepoint-index :> start-pos
-                        gadget editor-caret first start-pos 2array gadget loc>x
-                        gadget caret-loc second gadget caret-dim second + 
-                        2array                     ! character pos
-                        gadget screen-loc v+       ! + gadget pos 
-                        { 1 -1 } v*
-                        window handle>> window>> dup -> frame -> contentRectForFrameRect:
-                        CGRect-top-left 2array v+  ! + window pos
-                        first2 [ >fixnum ] bi@ 0 gadget line-height >fixnum
-                    ] [ 0 0 0 0 ] if
+        self window :> window
+        window [
+            window world-focus :> gadget
+            gadget [
+                gadget support-input-methods? [
+                    gadget editor-caret first gadget editor-line :> str
+                    str aRange location>> >codepoint-index :> start-pos
+                    gadget editor-caret first start-pos 2array gadget loc>x
+                    gadget caret-loc second gadget caret-dim second + 
+                    2array                     ! character pos
+                    gadget screen-loc v+       ! + gadget pos
+                    { 1 -1 } v*
+                    window handle>> window>> dup -> frame -> contentRectForFrameRect:
+                    CGRect-top-left 2array v+  ! + window pos
+                    first2 [ >fixnum ] bi@ 0 gadget line-height >fixnum
                 ] [ 0 0 0 0 ] if
             ] [ 0 0 0 0 ] if
-            <CGRect>
-        ] ;
+        ] [ 0 0 0 0 ] if
+        <CGRect>
+    ] ;
 
     METHOD: void doCommandBySelector: SEL selector [ ] ;
-    
+
     ! Initialization
     METHOD: void updateFactorGadgetSize: id notification
     [