;; libnative.scm supplemental code.
;; Generated automatically by gen-native.scm.  DO NOT EDIT.

;; Register-only calling
;; sysvx64-call-reg
#|
text:                entry6f7::
0008: f2 0f 10 3d          ((movs_ :farg7-variant) (farg7:) %xmm7)
    : 00 00 00 00            
text:                entry6f6::
0010: f2 0f 10 35          ((movs_ :farg6-variant) (farg6:) %xmm6)
    : 00 00 00 00            
text:                entry6f5::
0018: f2 0f 10 2d          ((movs_ :farg5-variant) (farg5:) %xmm5)
    : 00 00 00 00            
text:                entry6f4::
0020: f2 0f 10 25          ((movs_ :farg4-variant) (farg4:) %xmm4)
    : 00 00 00 00            
text:                entry6f3::
0028: f2 0f 10 1d          ((movs_ :farg3-variant) (farg3:) %xmm3)
    : 00 00 00 00            
text:                entry6f2::
0030: f2 0f 10 15          ((movs_ :farg2-variant) (farg2:) %xmm2)
    : 00 00 00 00            
text:                entry6f1::
0038: f2 0f 10 0d          ((movs_ :farg1-variant) (farg1:) %xmm1)
    : 00 00 00 00            
text:                entry6f0::
0040: f2 0f 10 05          ((movs_ :farg0-variant) (farg0:) %xmm0)
    : 00 00 00 00            
text:                entry6::
004a: 49 b9 00 00          (movq (imm64 :iarg5) %r9)
    : 00 00 00 00            
    : 00 00                  
text:                entry5::
0054: 49 b8 00 00          (movq (imm64 :iarg4) %r8)
    : 00 00 00 00            
    : 00 00                  
text:                entry4::
005e: 48 b9 00 00          (movq (imm64 :iarg3) %rcx)
    : 00 00 00 00            
    : 00 00                  
text:                entry3::
0068: 48 ba 00 00          (movq (imm64 :iarg2) %rdx)
    : 00 00 00 00            
    : 00 00                  
text:                entry2::
0072: 48 be 00 00          (movq (imm64 :iarg1) %rsi)
    : 00 00 00 00            
    : 00 00                  
text:                entry1::
007c: 48 bf 00 00          (movq (imm64 :iarg0) %rdi)
    : 00 00 00 00            
    : 00 00                  
text:                entry0::
007d: 53                   (push %rbx)
007f: b0 00                (movb (imm8 :num-fargs) %al)
0085: ff 15 00 00          (call (func:))
    : 00 00                  
0087: b3 00                (movb (imm8 :retkind) %bl)
0089: fe cb                (decb %bl)
008f: 0f 88 99 00          (jsl epilog:)
    : 00 00                  
0091: 74 30                (jz fixnum:)
0093: fe cb                (decb %bl)
0095: 74 35                (jz integer:)
0097: fe cb                (decb %bl)
0099: 74 3f                (jz uinteger:)
009b: fe cb                (decb %bl)
009d: 74 49                (jz double:)
009f: fe cb                (decb %bl)
00a1: 74 4f                (jz float:)
00a3: fe cb                (decb %bl)
00a5: 74 59                (jz void:)
00a7: fe cb                (decb %bl)
00a9: 74 61                (jz cstring:)
text:                pointer::
00ac: 48 89 c7             (movq %rax %rdi)
00b6: 48 be 00 00          (movq (imm64 :rettype) %rsi)
    : 00 00 00 00            
    : 00 00                  
00b9: 48 31 c0             (xorq %rax %rax)
00bf: ff 15 00 00          (call (fn-handle:))
    : 00 00                  
00c1: eb 67                (jmp epilog:)
text:                fixnum::
00c5: 48 c1 e0 02          (shl 2 %rax)
00c8: 48 ff c0             (incq %rax)
00ca: eb 5e                (jmp epilog:)
text:                integer::
00cd: 48 89 c7             (movq %rax %rdi)
00d0: 48 31 c0             (xorq %rax %rax)
00d6: ff 15 00 00          (call (fn-int:))
    : 00 00                  
00d8: eb 50                (jmp epilog:)
text:                uinteger::
00db: 48 89 c7             (movq %rax %rdi)
00de: 48 31 c0             (xorq %rax %rax)
00e4: ff 15 00 00          (call (fn-uint:))
    : 00 00                  
00e6: eb 42                (jmp epilog:)
text:                double::
00e8: b0 01                (movb 1 %al)
00ee: ff 15 00 00          (call (fn-flonum:))
    : 00 00                  
00f0: eb 38                (jmp epilog:)
text:                float::
00f4: f3 0f 5a c0          (cvtss2sd %xmm0 %xmm0)
00f6: b0 01                (movb 1 %al)
00fc: ff 15 00 00          (call (fn-flonum:))
    : 00 00                  
00fe: eb 2a                (jmp epilog:)
text:                void::
0108: 48 b8 00 00          (movq (imm64 :SCM_UNDEFINED) %rax)
    : 00 00 00 00            
    : 00 00                  
010a: eb 1e                (jmp epilog:)
text:                cstring::
010d: 48 89 c7             (movq %rax %rdi)
0114: 48 c7 c6 ff          (movq -1 %rsi)
    : ff ff ff               
011b: 48 c7 c2 ff          (movq -1 %rdx)
    : ff ff ff               
0122: 48 c7 c1 00          (movq (imm32 :SCM_STRING_COPYING) %rcx)
    : 00 00 00               
0128: ff 15 00 00          (call (fn-string:))
    : 00 00                  
text:                epilog::
0129: 5b                   (pop %rbx)
012a: c3                   (ret)
     .endsection text
     .section data
data:                func::
0132: 00 00 00 00          (.dataq :func)
    : 00 00 00 00            
data:                fn-flonum::
013a: 00 00 00 00          (.dataq :Scm_MakeFlonum)
    : 00 00 00 00            
data:                fn-string::
0142: 00 00 00 00          (.dataq :Scm_MakeString)
    : 00 00 00 00            
data:                fn-handle::
014a: 00 00 00 00          (.dataq :Scm_MakeNativeHandleSimple)
    : 00 00 00 00            
data:                fn-int::
0152: 00 00 00 00          (.dataq :Scm_IntptrToInteger)
    : 00 00 00 00            
data:                fn-uint::
015a: 00 00 00 00          (.dataq :Scm_UintptrToInteger)
    : 00 00 00 00            
data:                farg0::
0162: 00 00 00 00          (.dataq :farg0)
    : 00 00 00 00            
data:                farg1::
016a: 00 00 00 00          (.dataq :farg1)
    : 00 00 00 00            
data:                farg2::
0172: 00 00 00 00          (.dataq :farg2)
    : 00 00 00 00            
data:                farg3::
017a: 00 00 00 00          (.dataq :farg3)
    : 00 00 00 00            
data:                farg4::
0182: 00 00 00 00          (.dataq :farg4)
    : 00 00 00 00            
data:                farg5::
018a: 00 00 00 00          (.dataq :farg5)
    : 00 00 00 00            
data:                farg6::
0192: 00 00 00 00          (.dataq :farg6)
    : 00 00 00 00            
data:                farg7::
019a: 00 00 00 00          (.dataq :farg7)
    : 00 00 00 00            
data:                end::
|#
(define
 sysvx64-call-reg-tmpl
 (let*
  ((data
    '(:fragments
      ((:section
        text
        :bytes
        #u8(#xf2 #xf #x10 #x3d #x0 #x0 #x0 #x0 #xf2 #xf #x10 #x35 #x0 #x0
            #x0 #x0 #xf2 #xf #x10 #x2d #x0 #x0 #x0 #x0 #xf2 #xf #x10 #x25
            #x0 #x0 #x0 #x0 #xf2 #xf #x10 #x1d #x0 #x0 #x0 #x0 #xf2 #xf
            #x10 #x15 #x0 #x0 #x0 #x0 #xf2 #xf #x10 #xd #x0 #x0 #x0 #x0
            #xf2 #xf #x10 #x5 #x0 #x0 #x0 #x0 #x49 #xb9 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x49 #xb8 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x48
            #xb9 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x48 #xba #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x48 #xbe #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x48
            #xbf #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x53 #xb0 #x0 #xff #x15
            #x0 #x0 #x0 #x0 #xb3 #x0 #xfe #xcb #xf #x88 #x99 #x0 #x0 #x0
            #x74 #x30 #xfe #xcb #x74 #x35 #xfe #xcb #x74 #x3f #xfe #xcb
            #x74 #x49 #xfe #xcb #x74 #x4f #xfe #xcb #x74 #x59 #xfe #xcb
            #x74 #x61 #x48 #x89 #xc7 #x48 #xbe #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x48 #x31 #xc0 #xff #x15 #x0 #x0 #x0 #x0 #xeb #x67 #x48
            #xc1 #xe0 #x2 #x48 #xff #xc0 #xeb #x5e #x48 #x89 #xc7 #x48
            #x31 #xc0 #xff #x15 #x0 #x0 #x0 #x0 #xeb #x50 #x48 #x89 #xc7
            #x48 #x31 #xc0 #xff #x15 #x0 #x0 #x0 #x0 #xeb #x42 #xb0 #x1
            #xff #x15 #x0 #x0 #x0 #x0 #xeb #x38 #xf3 #xf #x5a #xc0 #xb0
            #x1 #xff #x15 #x0 #x0 #x0 #x0 #xeb #x2a #x48 #xb8 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #xeb #x1e #x48 #x89 #xc7 #x48 #xc7 #xc6
            #xff #xff #xff #xff #x48 #xc7 #xc2 #xff #xff #xff #xff #x48
            #xc7 #xc1 #x0 #x0 #x0 #x0 #xff #x15 #x0 #x0 #x0 #x0 #x5b #xc3)
        :labels
        ((entry6f7: . #x0) (entry6f6: . #x8) (entry6f5: . #x10)
         (entry6f4: . #x18) (entry6f3: . #x20) (entry6f2: . #x28)
         (entry6f1: . #x30) (entry6f0: . #x38) (entry6: . #x40)
         (entry5: . #x4a) (entry4: . #x54) (entry3: . #x5e)
         (entry2: . #x68) (entry1: . #x72) (entry0: . #x7c)
         (pointer: . #xa9) (fixnum: . #xc1) (integer: . #xca)
         (uinteger: . #xd8) (double: . #xe6) (float: . #xf0)
         (void: . #xfe) (cstring: . #x10a) (epilog: . #x128))
        :patches
        ((fn-string: #x124 label-rel #x128) (:SCM_STRING_COPYING #x11e #x4)
         (:SCM_UNDEFINED #x100 #x8) (fn-flonum: #xf8 label-rel #xfc)
         (fn-flonum: #xea label-rel #xee) (fn-uint: #xe0 label-rel #xe4)
         (fn-int: #xd2 label-rel #xd6) (fn-handle: #xbb label-rel #xbf)
         (:rettype #xae #x8) (:retkind #x86 #x1)
         (func: #x81 label-rel #x85) (:num-fargs #x7e #x1)
         (:iarg0 #x74 #x8) (:iarg1 #x6a #x8) (:iarg2 #x60 #x8)
         (:iarg3 #x56 #x8) (:iarg4 #x4c #x8) (:iarg5 #x42 #x8)
         (:farg0-variant #x38 x86_64-movs_) (farg0: #x3c label-rel #x40)
         (:farg1-variant #x30 x86_64-movs_) (farg1: #x34 label-rel #x38)
         (:farg2-variant #x28 x86_64-movs_) (farg2: #x2c label-rel #x30)
         (:farg3-variant #x20 x86_64-movs_) (farg3: #x24 label-rel #x28)
         (:farg4-variant #x18 x86_64-movs_) (farg4: #x1c label-rel #x20)
         (:farg5-variant #x10 x86_64-movs_) (farg5: #x14 label-rel #x18)
         (:farg6-variant #x8 x86_64-movs_) (farg6: #xc label-rel #x10)
         (:farg7-variant #x0 x86_64-movs_) (farg7: #x4 label-rel #x8))
        :locals
        ())
       (:section
        data
        :bytes
        #u8(#x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0)
        :labels
        ((func: . #x0) (fn-flonum: . #x8) (fn-string: . #x10)
         (fn-handle: . #x18) (fn-int: . #x20) (fn-uint: . #x28)
         (farg0: . #x30) (farg1: . #x38) (farg2: . #x40) (farg3: . #x48)
         (farg4: . #x50) (farg5: . #x58) (farg6: . #x60) (farg7: . #x68)
         (end: . #x70))
        :patches
        ((:farg7 #x68 #x8) (:farg6 #x60 #x8) (:farg5 #x58 #x8)
         (:farg4 #x50 #x8) (:farg3 #x48 #x8) (:farg2 #x40 #x8)
         (:farg1 #x38 #x8) (:farg0 #x30 #x8)
         (:Scm_UintptrToInteger #x28 #x8) (:Scm_IntptrToInteger #x20 #x8)
         (:Scm_MakeNativeHandleSimple #x18 #x8) (:Scm_MakeString #x10 #x8)
         (:Scm_MakeFlonum #x8 #x8) (:func #x0 #x8))
        :locals
        ()))
      :endian
      little-endian
      :stack-word-size
      #x8))
   (p
    (delay
     ((module-binding-ref 'lang.asm.linker 'deserialize-obj-template) data))))
  (^ () (force p))))

;; Spill-to-stack case
;; sysvx64-call-spill
#|
text:                entry6f7::
0008: f2 0f 10 3d          ((movs_ :farg7-variant) (farg7:) %xmm7)
    : 00 00 00 00            
text:                entry6f6::
0010: f2 0f 10 35          ((movs_ :farg6-variant) (farg6:) %xmm6)
    : 00 00 00 00            
text:                entry6f5::
0018: f2 0f 10 2d          ((movs_ :farg5-variant) (farg5:) %xmm5)
    : 00 00 00 00            
text:                entry6f4::
0020: f2 0f 10 25          ((movs_ :farg4-variant) (farg4:) %xmm4)
    : 00 00 00 00            
text:                entry6f3::
0028: f2 0f 10 1d          ((movs_ :farg3-variant) (farg3:) %xmm3)
    : 00 00 00 00            
text:                entry6f2::
0030: f2 0f 10 15          ((movs_ :farg2-variant) (farg2:) %xmm2)
    : 00 00 00 00            
text:                entry6f1::
0038: f2 0f 10 0d          ((movs_ :farg1-variant) (farg1:) %xmm1)
    : 00 00 00 00            
text:                entry6f0::
0040: f2 0f 10 05          ((movs_ :farg0-variant) (farg0:) %xmm0)
    : 00 00 00 00            
text:                entry6::
004a: 49 b9 00 00          (movq (imm64 :iarg5) %r9)
    : 00 00 00 00            
    : 00 00                  
text:                entry5::
0054: 49 b8 00 00          (movq (imm64 :iarg4) %r8)
    : 00 00 00 00            
    : 00 00                  
text:                entry4::
005e: 48 b9 00 00          (movq (imm64 :iarg3) %rcx)
    : 00 00 00 00            
    : 00 00                  
text:                entry3::
0068: 48 ba 00 00          (movq (imm64 :iarg2) %rdx)
    : 00 00 00 00            
    : 00 00                  
text:                init::
006f: 48 c7 c0 00          (movq (imm32 :init-spill-size) %rax)
    : 00 00 00               
0076: 48 8d 35 00          (leaq (spill:) %rsi)
    : 00 00 00               
007a: 48 83 ec 00          (subq (imm8 :align-pad) %rsp)
text:                loop::
007d: 48 8b 3e             (movq (%rsi) %rdi)
007e: 57                   (push %rdi)
0082: 48 83 c6 08          (addq 8 %rsi)
0086: 48 83 e8 08          (subq 8 %rax)
0088: 75 f2                (jnz loop:)
text:                entry2::
0092: 48 be 00 00          (movq (imm64 :iarg1) %rsi)
    : 00 00 00 00            
    : 00 00                  
text:                entry1::
009c: 48 bf 00 00          (movq (imm64 :iarg0) %rdi)
    : 00 00 00 00            
    : 00 00                  
text:                entry0::
009e: b0 00                (movb (imm8 :num-fargs) %al)
00a4: ff 15 00 00          (call (func:))
    : 00 00                  
00a6: b3 00                (movb (imm8 :retkind) %bl)
00a8: fe cb                (decb %bl)
00ae: 0f 88 99 00          (jsl epilog:)
    : 00 00                  
00b0: 74 30                (jz fixnum:)
00b2: fe cb                (decb %bl)
00b4: 74 35                (jz integer:)
00b6: fe cb                (decb %bl)
00b8: 74 3f                (jz uinteger:)
00ba: fe cb                (decb %bl)
00bc: 74 49                (jz double:)
00be: fe cb                (decb %bl)
00c0: 74 4f                (jz float:)
00c2: fe cb                (decb %bl)
00c4: 74 59                (jz void:)
00c6: fe cb                (decb %bl)
00c8: 74 61                (jz cstring:)
text:                pointer::
00cb: 48 89 c7             (movq %rax %rdi)
00d5: 48 be 00 00          (movq (imm64 :rettype) %rsi)
    : 00 00 00 00            
    : 00 00                  
00d8: 48 31 c0             (xorq %rax %rax)
00de: ff 15 00 00          (call (fn-handle:))
    : 00 00                  
00e0: eb 67                (jmp epilog:)
text:                fixnum::
00e4: 48 c1 e0 02          (shl 2 %rax)
00e7: 48 ff c0             (incq %rax)
00e9: eb 5e                (jmp epilog:)
text:                integer::
00ec: 48 89 c7             (movq %rax %rdi)
00ef: 48 31 c0             (xorq %rax %rax)
00f5: ff 15 00 00          (call (fn-int:))
    : 00 00                  
00f7: eb 50                (jmp epilog:)
text:                uinteger::
00fa: 48 89 c7             (movq %rax %rdi)
00fd: 48 31 c0             (xorq %rax %rax)
0103: ff 15 00 00          (call (fn-uint:))
    : 00 00                  
0105: eb 42                (jmp epilog:)
text:                double::
0107: b0 01                (movb 1 %al)
010d: ff 15 00 00          (call (fn-flonum:))
    : 00 00                  
010f: eb 38                (jmp epilog:)
text:                float::
0113: f3 0f 5a c0          (cvtss2sd %xmm0 %xmm0)
0115: b0 01                (movb 1 %al)
011b: ff 15 00 00          (call (fn-flonum:))
    : 00 00                  
011d: eb 2a                (jmp epilog:)
text:                void::
0127: 48 b8 00 00          (movq (imm64 :SCM_UNDEFINED) %rax)
    : 00 00 00 00            
    : 00 00                  
0129: eb 1e                (jmp epilog:)
text:                cstring::
012c: 48 89 c7             (movq %rax %rdi)
0133: 48 c7 c6 ff          (movq -1 %rsi)
    : ff ff ff               
013a: 48 c7 c2 ff          (movq -1 %rdx)
    : ff ff ff               
0141: 48 c7 c1 00          (movq (imm32 :SCM_STRING_COPYING) %rcx)
    : 00 00 00               
0147: ff 15 00 00          (call (fn-string:))
    : 00 00                  
text:                epilog::
014e: 48 81 c4 00          (addq (imm32 :epilogue-spill-size) %rsp)
    : 00 00 00               
014f: c3                   (ret)
     .endsection text
     .section data
data:                func::
0157: 00 00 00 00          (.dataq :func)
    : 00 00 00 00            
data:                fn-flonum::
015f: 00 00 00 00          (.dataq :Scm_MakeFlonum)
    : 00 00 00 00            
data:                fn-string::
0167: 00 00 00 00          (.dataq :Scm_MakeString)
    : 00 00 00 00            
data:                fn-handle::
016f: 00 00 00 00          (.dataq :Scm_MakeNativeHandleSimple)
    : 00 00 00 00            
data:                fn-int::
0177: 00 00 00 00          (.dataq :Scm_IntptrToInteger)
    : 00 00 00 00            
data:                fn-uint::
017f: 00 00 00 00          (.dataq :Scm_UintptrToInteger)
    : 00 00 00 00            
data:                farg0::
0187: 00 00 00 00          (.dataq :farg0)
    : 00 00 00 00            
data:                farg1::
018f: 00 00 00 00          (.dataq :farg1)
    : 00 00 00 00            
data:                farg2::
0197: 00 00 00 00          (.dataq :farg2)
    : 00 00 00 00            
data:                farg3::
019f: 00 00 00 00          (.dataq :farg3)
    : 00 00 00 00            
data:                farg4::
01a7: 00 00 00 00          (.dataq :farg4)
    : 00 00 00 00            
data:                farg5::
01af: 00 00 00 00          (.dataq :farg5)
    : 00 00 00 00            
data:                farg6::
01b7: 00 00 00 00          (.dataq :farg6)
    : 00 00 00 00            
data:                farg7::
01bf: 00 00 00 00          (.dataq :farg7)
    : 00 00 00 00            
data:                spill::
01c7: 00 00 00 00          (.dataq :spill)
    : 00 00 00 00            
|#
(define
 sysvx64-call-spill-tmpl
 (let*
  ((data
    '(:fragments
      ((:section
        text
        :bytes
        #u8(#xf2 #xf #x10 #x3d #x0 #x0 #x0 #x0 #xf2 #xf #x10 #x35 #x0 #x0
            #x0 #x0 #xf2 #xf #x10 #x2d #x0 #x0 #x0 #x0 #xf2 #xf #x10 #x25
            #x0 #x0 #x0 #x0 #xf2 #xf #x10 #x1d #x0 #x0 #x0 #x0 #xf2 #xf
            #x10 #x15 #x0 #x0 #x0 #x0 #xf2 #xf #x10 #xd #x0 #x0 #x0 #x0
            #xf2 #xf #x10 #x5 #x0 #x0 #x0 #x0 #x49 #xb9 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x49 #xb8 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x48
            #xb9 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x48 #xba #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x48 #xc7 #xc0 #x0 #x0 #x0 #x0 #x48 #x8d #x35
            #x0 #x0 #x0 #x0 #x48 #x83 #xec #x0 #x48 #x8b #x3e #x57 #x48
            #x83 #xc6 #x8 #x48 #x83 #xe8 #x8 #x75 #xf2 #x48 #xbe #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x48 #xbf #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #xb0 #x0 #xff #x15 #x0 #x0 #x0 #x0 #xb3 #x0 #xfe #xcb #xf
            #x88 #x99 #x0 #x0 #x0 #x74 #x30 #xfe #xcb #x74 #x35 #xfe #xcb
            #x74 #x3f #xfe #xcb #x74 #x49 #xfe #xcb #x74 #x4f #xfe #xcb
            #x74 #x59 #xfe #xcb #x74 #x61 #x48 #x89 #xc7 #x48 #xbe #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x48 #x31 #xc0 #xff #x15 #x0 #x0 #x0
            #x0 #xeb #x67 #x48 #xc1 #xe0 #x2 #x48 #xff #xc0 #xeb #x5e #x48
            #x89 #xc7 #x48 #x31 #xc0 #xff #x15 #x0 #x0 #x0 #x0 #xeb #x50
            #x48 #x89 #xc7 #x48 #x31 #xc0 #xff #x15 #x0 #x0 #x0 #x0 #xeb
            #x42 #xb0 #x1 #xff #x15 #x0 #x0 #x0 #x0 #xeb #x38 #xf3 #xf
            #x5a #xc0 #xb0 #x1 #xff #x15 #x0 #x0 #x0 #x0 #xeb #x2a #x48
            #xb8 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #xeb #x1e #x48 #x89 #xc7
            #x48 #xc7 #xc6 #xff #xff #xff #xff #x48 #xc7 #xc2 #xff #xff
            #xff #xff #x48 #xc7 #xc1 #x0 #x0 #x0 #x0 #xff #x15 #x0 #x0 #x0
            #x0 #x48 #x81 #xc4 #x0 #x0 #x0 #x0 #xc3)
        :labels
        ((entry6f7: . #x0) (entry6f6: . #x8) (entry6f5: . #x10)
         (entry6f4: . #x18) (entry6f3: . #x20) (entry6f2: . #x28)
         (entry6f1: . #x30) (entry6f0: . #x38) (entry6: . #x40)
         (entry5: . #x4a) (entry4: . #x54) (entry3: . #x5e) (init: . #x68)
         (loop: . #x7a) (entry2: . #x88) (entry1: . #x92) (entry0: . #x9c)
         (pointer: . #xc8) (fixnum: . #xe0) (integer: . #xe9)
         (uinteger: . #xf7) (double: . #x105) (float: . #x10f)
         (void: . #x11d) (cstring: . #x129) (epilog: . #x147))
        :patches
        ((:epilogue-spill-size #x14a #x4)
         (fn-string: #x143 label-rel #x147) (:SCM_STRING_COPYING #x13d #x4)
         (:SCM_UNDEFINED #x11f #x8) (fn-flonum: #x117 label-rel #x11b)
         (fn-flonum: #x109 label-rel #x10d)
         (fn-uint: #xff label-rel #x103) (fn-int: #xf1 label-rel #xf5)
         (fn-handle: #xda label-rel #xde) (:rettype #xcd #x8)
         (:retkind #xa5 #x1) (func: #xa0 label-rel #xa4)
         (:num-fargs #x9d #x1) (:iarg0 #x94 #x8) (:iarg1 #x8a #x8)
         (:align-pad #x79 #x1) (spill: #x72 label-rel #x76)
         (:init-spill-size #x6b #x4) (:iarg2 #x60 #x8) (:iarg3 #x56 #x8)
         (:iarg4 #x4c #x8) (:iarg5 #x42 #x8)
         (:farg0-variant #x38 x86_64-movs_) (farg0: #x3c label-rel #x40)
         (:farg1-variant #x30 x86_64-movs_) (farg1: #x34 label-rel #x38)
         (:farg2-variant #x28 x86_64-movs_) (farg2: #x2c label-rel #x30)
         (:farg3-variant #x20 x86_64-movs_) (farg3: #x24 label-rel #x28)
         (:farg4-variant #x18 x86_64-movs_) (farg4: #x1c label-rel #x20)
         (:farg5-variant #x10 x86_64-movs_) (farg5: #x14 label-rel #x18)
         (:farg6-variant #x8 x86_64-movs_) (farg6: #xc label-rel #x10)
         (:farg7-variant #x0 x86_64-movs_) (farg7: #x4 label-rel #x8))
        :locals
        ())
       (:section
        data
        :bytes
        #u8(#x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0)
        :labels
        ((func: . #x0) (fn-flonum: . #x8) (fn-string: . #x10)
         (fn-handle: . #x18) (fn-int: . #x20) (fn-uint: . #x28)
         (farg0: . #x30) (farg1: . #x38) (farg2: . #x40) (farg3: . #x48)
         (farg4: . #x50) (farg5: . #x58) (farg6: . #x60) (farg7: . #x68)
         (spill: . #x70))
        :patches
        ((:spill #x70 #x8) (:farg7 #x68 #x8) (:farg6 #x60 #x8)
         (:farg5 #x58 #x8) (:farg4 #x50 #x8) (:farg3 #x48 #x8)
         (:farg2 #x40 #x8) (:farg1 #x38 #x8) (:farg0 #x30 #x8)
         (:Scm_UintptrToInteger #x28 #x8) (:Scm_IntptrToInteger #x20 #x8)
         (:Scm_MakeNativeHandleSimple #x18 #x8) (:Scm_MakeString #x10 #x8)
         (:Scm_MakeFlonum #x8 #x8) (:func #x0 #x8))
        :locals
        ()))
      :endian
      little-endian
      :stack-word-size
      #x8))
   (p
    (delay
     ((module-binding-ref 'lang.asm.linker 'deserialize-obj-template) data))))
  (^ () (force p))))

;; Callback trampoline
;; sysvx64-callback
#|
text:                entry::
0001: 53                   (push %rbx)
0008: 48 81 ec b0          (subq (imm32 176) %rsp)
    : 00 00 00               
text:                prolog-end::
000d: 48 89 7c 24          (movq %rdi (0 %rsp))
    : 00                     
0012: 48 89 74 24          (movq %rsi (8 %rsp))
    : 08                     
0017: 48 89 54 24          (movq %rdx (16 %rsp))
    : 10                     
001c: 48 89 4c 24          (movq %rcx (24 %rsp))
    : 18                     
0021: 4c 89 44 24          (movq %r8 (32 %rsp))
    : 20                     
0026: 4c 89 4c 24          (movq %r9 (40 %rsp))
    : 28                     
002c: f2 0f 11 44          (movsd %xmm0 (48 %rsp))
    : 24 30                  
0032: f2 0f 11 4c          (movsd %xmm1 (56 %rsp))
    : 24 38                  
0038: f2 0f 11 54          (movsd %xmm2 (64 %rsp))
    : 24 40                  
003e: f2 0f 11 5c          (movsd %xmm3 (72 %rsp))
    : 24 48                  
0044: f2 0f 11 64          (movsd %xmm4 (80 %rsp))
    : 24 50                  
004a: f2 0f 11 6c          (movsd %xmm5 (88 %rsp))
    : 24 58                  
0050: f2 0f 11 74          (movsd %xmm6 (96 %rsp))
    : 24 60                  
0056: f2 0f 11 7c          (movsd %xmm7 (104 %rsp))
    : 24 68                  
0059: 48 31 db             (xorq %rbx %rbx)
text:                box-loop::
0061: 48 0f b6 05          (movzbq (nargs:) %rax)
    : 00 00 00 00            
0064: 48 39 c3             (cmpq %rax %rbx)
006a: 0f 8d f1 00          (jgel build-args:)
    : 00 00                  
0071: 4c 8d 15 00          (leaq (argkinds:) %r10)
    : 00 00 00               
0076: 49 0f b6 04          (movzbq (%r10 %rbx 1) %rax)
    : 1a                     
007d: 4c 8d 15 00          (leaq (argsrcs:) %r10)
    : 00 00 00               
0082: 4d 0f b6 14          (movzbq (%r10 %rbx 1) %r10)
    : 1a                     
0084: 3c 04                (cmpb 4 %al)
008a: 0f 84 9d 00          (jel box-double:)
    : 00 00                  
008c: 3c 05                (cmpb 5 %al)
0092: 0f 84 a9 00          (jel box-float:)
    : 00 00                  
0096: 4a 8b 3c d4          (movq (0 %rsp %r10 8) %rdi)
0098: 3c 01                (cmpb 1 %al)
009e: 0f 84 28 00          (jel box-fixnum:)
    : 00 00                  
00a0: 3c 02                (cmpb 2 %al)
00a6: 0f 84 2f 00          (jel box-intptr:)
    : 00 00                  
00a8: 3c 03                (cmpb 3 %al)
00ae: 0f 84 35 00          (jel box-uintptr:)
    : 00 00                  
00b0: 3c 07                (cmpb 7 %al)
00b6: 0f 84 3b 00          (jel box-cstring:)
    : 00 00                  
00b8: 3c 08                (cmpb 8 %al)
00be: 0f 84 53 00          (jel box-pointer:)
    : 00 00                  
00c1: 48 89 f8             (movq %rdi %rax)
00c6: e9 88 00 00          (jmpl store-boxed:)
    : 00                     
text:                box-fixnum::
00c9: 48 89 f8             (movq %rdi %rax)
00cd: 48 c1 e0 02          (shl 2 %rax)
00d0: 48 ff c0             (incq %rax)
00d5: e9 79 00 00          (jmpl store-boxed:)
    : 00                     
text:                box-intptr::
00d8: 48 31 c0             (xorq %rax %rax)
00de: ff 15 00 00          (call (fn-int:))
    : 00 00                  
00e3: e9 6b 00 00          (jmpl store-boxed:)
    : 00                     
text:                box-uintptr::
00e6: 48 31 c0             (xorq %rax %rax)
00ec: ff 15 00 00          (call (fn-uint:))
    : 00 00                  
00f1: e9 5d 00 00          (jmpl store-boxed:)
    : 00                     
text:                box-cstring::
00f8: 48 c7 c6 ff          (movq -1 %rsi)
    : ff ff ff               
00ff: 48 c7 c2 ff          (movq -1 %rdx)
    : ff ff ff               
0106: 48 c7 c1 00          (movq (imm32 :SCM_STRING_COPYING) %rcx)
    : 00 00 00               
010c: ff 15 00 00          (call (fn-string:))
    : 00 00                  
0111: e9 3d 00 00          (jmpl store-boxed:)
    : 00                     
text:                box-pointer::
0118: 4c 8d 1d 00          (leaq (argtypes:) %r11)
    : 00 00 00               
011c: 49 8b 34 db          (movq (%r11 %rbx 8) %rsi)
0122: ff 15 00 00          (call (fn-handle:))
    : 00 00                  
0127: e9 27 00 00          (jmpl store-boxed:)
    : 00                     
text:                box-double::
012e: f2 42 0f 10          (movsd (48 %rsp %r10 8) %xmm0)
    : 44 d4 30               
0130: b0 01                (movb 1 %al)
0136: ff 15 00 00          (call (fn-flonum:))
    : 00 00                  
013b: e9 13 00 00          (jmpl store-boxed:)
    : 00                     
text:                box-float::
0142: f2 42 0f 10          (movsd (48 %rsp %r10 8) %xmm0)
    : 44 d4 30               
0146: f3 0f 5a c0          (cvtss2sd %xmm0 %xmm0)
0148: b0 01                (movb 1 %al)
014e: ff 15 00 00          (call (fn-flonum:))
    : 00 00                  
text:                store-boxed::
0153: 48 89 44 dc          (movq %rax (112 %rsp %rbx 8))
    : 70                     
0156: 48 ff c3             (incq %rbx)
015b: e9 fe fe ff          (jmpl box-loop:)
    : ff                     
text:                build-args::
0162: 48 8b 05 00          (movq (SCM_NIL:) %rax)
    : 00 00 00               
016a: 48 0f b6 1d          (movzbq (nargs:) %rbx)
    : 00 00 00 00            
text:                build-loop::
016e: 48 83 fb 00          (cmpq 0 %rbx)
0174: 0f 84 16 00          (jel apply-it:)
    : 00 00                  
0177: 48 ff cb             (decq %rbx)
017a: 48 89 c6             (movq %rax %rsi)
017f: 48 8b 7c dc          (movq (112 %rsp %rbx 8) %rdi)
    : 70                     
0185: ff 15 00 00          (call (fn-cons:))
    : 00 00                  
018a: e9 e0 ff ff          (jmpl build-loop:)
    : ff                     
text:                apply-it::
0191: 48 8b 3d 00          (movq (proc:) %rdi)
    : 00 00 00               
0194: 48 89 c6             (movq %rax %rsi)
019a: ff 15 00 00          (call (fn-callback:))
    : 00 00                  
019c: b3 00                (movb (imm8 :retkind) %bl)
019e: fe cb                (decb %bl)
01a4: 0f 88 66 00          (jsl epilog:)
    : 00 00                  
01a6: 74 23                (jz ret-fixnum:)
01a8: fe cb                (decb %bl)
01aa: 74 25                (jz ret-intptr:)
01ac: fe cb                (decb %bl)
01ae: 74 2c                (jz ret-uintptr:)
01b0: fe cb                (decb %bl)
01b2: 74 33                (jz ret-double:)
01b4: fe cb                (decb %bl)
01b6: 74 3a                (jz ret-float:)
01b8: fe cb                (decb %bl)
01ba: 74 45                (jz ret-void:)
01bc: fe cb                (decb %bl)
01be: 74 43                (jz ret-cstring:)
text:                ret-pointer::
01c1: 48 89 c7             (movq %rax %rdi)
01c7: ff 15 00 00          (call (fn-handle-ptr:))
    : 00 00                  
01c9: eb 41                (jmp epilog:)
text:                ret-fixnum::
01cd: 48 c1 f8 02          (sar 2 %rax)
01cf: eb 3b                (jmp epilog:)
text:                ret-intptr::
01d2: 48 89 c7             (movq %rax %rdi)
01d8: ff 15 00 00          (call (fn-get-int:))
    : 00 00                  
01da: eb 30                (jmp epilog:)
text:                ret-uintptr::
01dd: 48 89 c7             (movq %rax %rdi)
01e3: ff 15 00 00          (call (fn-get-uint:))
    : 00 00                  
01e5: eb 25                (jmp epilog:)
text:                ret-double::
01e8: 48 89 c7             (movq %rax %rdi)
01ee: ff 15 00 00          (call (fn-get-double:))
    : 00 00                  
01f0: eb 1a                (jmp epilog:)
text:                ret-float::
01f3: 48 89 c7             (movq %rax %rdi)
01f9: ff 15 00 00          (call (fn-get-double:))
    : 00 00                  
01fd: f2 0f 5a c0          (cvtsd2ss %xmm0 %xmm0)
01ff: eb 0b                (jmp epilog:)
text:                ret-void::
0201: eb 09                (jmp epilog:)
text:                ret-cstring::
0204: 48 89 c7             (movq %rax %rdi)
020a: ff 15 00 00          (call (fn-get-cstring:))
    : 00 00                  
text:                epilog::
0211: 48 81 c4 b0          (addq (imm32 176) %rsp)
    : 00 00 00               
0212: 5b                   (pop %rbx)
0213: c3                   (ret)
     .endsection text
     .section data
data:                proc::
021b: 00 00 00 00          (.dataq :proc)
    : 00 00 00 00            
data:                fn-callback::
0223: 00 00 00 00          (.dataq :Scm__FFINativeCallCallback)
    : 00 00 00 00            
data:                fn-cons::
022b: 00 00 00 00          (.dataq :Scm_Cons)
    : 00 00 00 00            
data:                fn-flonum::
0233: 00 00 00 00          (.dataq :Scm_MakeFlonum)
    : 00 00 00 00            
data:                fn-string::
023b: 00 00 00 00          (.dataq :Scm_MakeString)
    : 00 00 00 00            
data:                fn-handle::
0243: 00 00 00 00          (.dataq :Scm_MakeNativeHandleSimple)
    : 00 00 00 00            
data:                fn-int::
024b: 00 00 00 00          (.dataq :Scm_IntptrToInteger)
    : 00 00 00 00            
data:                fn-uint::
0253: 00 00 00 00          (.dataq :Scm_UintptrToInteger)
    : 00 00 00 00            
data:                fn-get-int::
025b: 00 00 00 00          (.dataq :Scm_IntegerToIntptr)
    : 00 00 00 00            
data:                fn-get-uint::
0263: 00 00 00 00          (.dataq :Scm_IntegerToUintptr)
    : 00 00 00 00            
data:                fn-get-double::
026b: 00 00 00 00          (.dataq :Scm_GetDouble)
    : 00 00 00 00            
data:                fn-get-cstring::
0273: 00 00 00 00          (.dataq :Scm_GetStringConst)
    : 00 00 00 00            
data:                fn-handle-ptr::
027b: 00 00 00 00          (.dataq :Scm_NativeHandlePtr)
    : 00 00 00 00            
data:                SCM_NIL::
0283: 00 00 00 00          (.dataq :SCM_NIL)
    : 00 00 00 00            
data:                nargs::
0284: 00                   (.datab :nargs)
data:                argkinds::
0285: 00                   (.datab :argkind0)
0286: 00                   (.datab :argkind1)
0287: 00                   (.datab :argkind2)
0288: 00                   (.datab :argkind3)
0289: 00                   (.datab :argkind4)
028a: 00                   (.datab :argkind5)
028b: 00                   (.datab :argkind6)
028c: 00                   (.datab :argkind7)
data:                argsrcs::
028d: 00                   (.datab :argsrc0)
028e: 00                   (.datab :argsrc1)
028f: 00                   (.datab :argsrc2)
0290: 00                   (.datab :argsrc3)
0291: 00                   (.datab :argsrc4)
0292: 00                   (.datab :argsrc5)
0293: 00                   (.datab :argsrc6)
0294: 00                   (.datab :argsrc7)
data:                argtypes::
029c: 00 00 00 00          (.dataq :argtype0)
    : 00 00 00 00            
02a4: 00 00 00 00          (.dataq :argtype1)
    : 00 00 00 00            
02ac: 00 00 00 00          (.dataq :argtype2)
    : 00 00 00 00            
02b4: 00 00 00 00          (.dataq :argtype3)
    : 00 00 00 00            
02bc: 00 00 00 00          (.dataq :argtype4)
    : 00 00 00 00            
02c4: 00 00 00 00          (.dataq :argtype5)
    : 00 00 00 00            
02cc: 00 00 00 00          (.dataq :argtype6)
    : 00 00 00 00            
02d4: 00 00 00 00          (.dataq :argtype7)
    : 00 00 00 00            
data:                end::
|#
(define
 sysvx64-callback-tmpl
 (let*
  ((data
    '(:fragments
      ((:section
        text
        :bytes
        #u8(#x53 #x48 #x81 #xec #xb0 #x0 #x0 #x0 #x48 #x89 #x7c #x24 #x0
            #x48 #x89 #x74 #x24 #x8 #x48 #x89 #x54 #x24 #x10 #x48 #x89 #x4c
            #x24 #x18 #x4c #x89 #x44 #x24 #x20 #x4c #x89 #x4c #x24 #x28
            #xf2 #xf #x11 #x44 #x24 #x30 #xf2 #xf #x11 #x4c #x24 #x38 #xf2
            #xf #x11 #x54 #x24 #x40 #xf2 #xf #x11 #x5c #x24 #x48 #xf2 #xf
            #x11 #x64 #x24 #x50 #xf2 #xf #x11 #x6c #x24 #x58 #xf2 #xf #x11
            #x74 #x24 #x60 #xf2 #xf #x11 #x7c #x24 #x68 #x48 #x31 #xdb
            #x48 #xf #xb6 #x5 #x0 #x0 #x0 #x0 #x48 #x39 #xc3 #xf #x8d #xf1
            #x0 #x0 #x0 #x4c #x8d #x15 #x0 #x0 #x0 #x0 #x49 #xf #xb6 #x4
            #x1a #x4c #x8d #x15 #x0 #x0 #x0 #x0 #x4d #xf #xb6 #x14 #x1a
            #x3c #x4 #xf #x84 #x9d #x0 #x0 #x0 #x3c #x5 #xf #x84 #xa9 #x0
            #x0 #x0 #x4a #x8b #x3c #xd4 #x3c #x1 #xf #x84 #x28 #x0 #x0 #x0
            #x3c #x2 #xf #x84 #x2f #x0 #x0 #x0 #x3c #x3 #xf #x84 #x35 #x0
            #x0 #x0 #x3c #x7 #xf #x84 #x3b #x0 #x0 #x0 #x3c #x8 #xf #x84
            #x53 #x0 #x0 #x0 #x48 #x89 #xf8 #xe9 #x88 #x0 #x0 #x0 #x48
            #x89 #xf8 #x48 #xc1 #xe0 #x2 #x48 #xff #xc0 #xe9 #x79 #x0 #x0
            #x0 #x48 #x31 #xc0 #xff #x15 #x0 #x0 #x0 #x0 #xe9 #x6b #x0 #x0
            #x0 #x48 #x31 #xc0 #xff #x15 #x0 #x0 #x0 #x0 #xe9 #x5d #x0 #x0
            #x0 #x48 #xc7 #xc6 #xff #xff #xff #xff #x48 #xc7 #xc2 #xff
            #xff #xff #xff #x48 #xc7 #xc1 #x0 #x0 #x0 #x0 #xff #x15 #x0
            #x0 #x0 #x0 #xe9 #x3d #x0 #x0 #x0 #x4c #x8d #x1d #x0 #x0 #x0
            #x0 #x49 #x8b #x34 #xdb #xff #x15 #x0 #x0 #x0 #x0 #xe9 #x27
            #x0 #x0 #x0 #xf2 #x42 #xf #x10 #x44 #xd4 #x30 #xb0 #x1 #xff
            #x15 #x0 #x0 #x0 #x0 #xe9 #x13 #x0 #x0 #x0 #xf2 #x42 #xf #x10
            #x44 #xd4 #x30 #xf3 #xf #x5a #xc0 #xb0 #x1 #xff #x15 #x0 #x0
            #x0 #x0 #x48 #x89 #x44 #xdc #x70 #x48 #xff #xc3 #xe9 #xfe #xfe
            #xff #xff #x48 #x8b #x5 #x0 #x0 #x0 #x0 #x48 #xf #xb6 #x1d #x0
            #x0 #x0 #x0 #x48 #x83 #xfb #x0 #xf #x84 #x16 #x0 #x0 #x0 #x48
            #xff #xcb #x48 #x89 #xc6 #x48 #x8b #x7c #xdc #x70 #xff #x15
            #x0 #x0 #x0 #x0 #xe9 #xe0 #xff #xff #xff #x48 #x8b #x3d #x0
            #x0 #x0 #x0 #x48 #x89 #xc6 #xff #x15 #x0 #x0 #x0 #x0 #xb3 #x0
            #xfe #xcb #xf #x88 #x66 #x0 #x0 #x0 #x74 #x23 #xfe #xcb #x74
            #x25 #xfe #xcb #x74 #x2c #xfe #xcb #x74 #x33 #xfe #xcb #x74
            #x3a #xfe #xcb #x74 #x45 #xfe #xcb #x74 #x43 #x48 #x89 #xc7
            #xff #x15 #x0 #x0 #x0 #x0 #xeb #x41 #x48 #xc1 #xf8 #x2 #xeb
            #x3b #x48 #x89 #xc7 #xff #x15 #x0 #x0 #x0 #x0 #xeb #x30 #x48
            #x89 #xc7 #xff #x15 #x0 #x0 #x0 #x0 #xeb #x25 #x48 #x89 #xc7
            #xff #x15 #x0 #x0 #x0 #x0 #xeb #x1a #x48 #x89 #xc7 #xff #x15
            #x0 #x0 #x0 #x0 #xf2 #xf #x5a #xc0 #xeb #xb #xeb #x9 #x48 #x89
            #xc7 #xff #x15 #x0 #x0 #x0 #x0 #x48 #x81 #xc4 #xb0 #x0 #x0 #x0
            #x5b #xc3)
        :labels
        ((entry: . #x0) (prolog-end: . #x8) (box-loop: . #x59)
         (box-fixnum: . #xc6) (box-intptr: . #xd5) (box-uintptr: . #xe3)
         (box-cstring: . #xf1) (box-pointer: . #x111)
         (box-double: . #x127) (box-float: . #x13b) (store-boxed: . #x14e)
         (build-args: . #x15b) (build-loop: . #x16a) (apply-it: . #x18a)
         (ret-pointer: . #x1be) (ret-fixnum: . #x1c9)
         (ret-intptr: . #x1cf) (ret-uintptr: . #x1da)
         (ret-double: . #x1e5) (ret-float: . #x1f0) (ret-void: . #x1ff)
         (ret-cstring: . #x201) (epilog: . #x20a))
        :patches
        ((fn-get-cstring: #x206 label-rel #x20a)
         (fn-get-double: #x1f5 label-rel #x1f9)
         (fn-get-double: #x1ea label-rel #x1ee)
         (fn-get-uint: #x1df label-rel #x1e3)
         (fn-get-int: #x1d4 label-rel #x1d8)
         (fn-handle-ptr: #x1c3 label-rel #x1c7) (:retkind #x19b #x1)
         (fn-callback: #x196 label-rel #x19a)
         (proc: #x18d label-rel #x191) (fn-cons: #x181 label-rel #x185)
         (nargs: #x166 label-rel #x16a) (SCM_NIL: #x15e label-rel #x162)
         (fn-flonum: #x14a label-rel #x14e)
         (fn-flonum: #x132 label-rel #x136)
         (fn-handle: #x11e label-rel #x122)
         (argtypes: #x114 label-rel #x118)
         (fn-string: #x108 label-rel #x10c)
         (:SCM_STRING_COPYING #x102 #x4) (fn-uint: #xe8 label-rel #xec)
         (fn-int: #xda label-rel #xde) (argsrcs: #x79 label-rel #x7d)
         (argkinds: #x6d label-rel #x71) (nargs: #x5d label-rel #x61))
        :locals
        ())
       (:section
        data
        :bytes
        #u8(#x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0)
        :labels
        ((proc: . #x0) (fn-callback: . #x8) (fn-cons: . #x10)
         (fn-flonum: . #x18) (fn-string: . #x20) (fn-handle: . #x28)
         (fn-int: . #x30) (fn-uint: . #x38) (fn-get-int: . #x40)
         (fn-get-uint: . #x48) (fn-get-double: . #x50)
         (fn-get-cstring: . #x58) (fn-handle-ptr: . #x60)
         (SCM_NIL: . #x68) (nargs: . #x70) (argkinds: . #x71)
         (argsrcs: . #x79) (argtypes: . #x81) (end: . #xc1))
        :patches
        ((:argtype7 #xb9 #x8) (:argtype6 #xb1 #x8) (:argtype5 #xa9 #x8)
         (:argtype4 #xa1 #x8) (:argtype3 #x99 #x8) (:argtype2 #x91 #x8)
         (:argtype1 #x89 #x8) (:argtype0 #x81 #x8) (:argsrc7 #x80 #x1)
         (:argsrc6 #x7f #x1) (:argsrc5 #x7e #x1) (:argsrc4 #x7d #x1)
         (:argsrc3 #x7c #x1) (:argsrc2 #x7b #x1) (:argsrc1 #x7a #x1)
         (:argsrc0 #x79 #x1) (:argkind7 #x78 #x1) (:argkind6 #x77 #x1)
         (:argkind5 #x76 #x1) (:argkind4 #x75 #x1) (:argkind3 #x74 #x1)
         (:argkind2 #x73 #x1) (:argkind1 #x72 #x1) (:argkind0 #x71 #x1)
         (:nargs #x70 #x1) (:SCM_NIL #x68 #x8)
         (:Scm_NativeHandlePtr #x60 #x8) (:Scm_GetStringConst #x58 #x8)
         (:Scm_GetDouble #x50 #x8) (:Scm_IntegerToUintptr #x48 #x8)
         (:Scm_IntegerToIntptr #x40 #x8) (:Scm_UintptrToInteger #x38 #x8)
         (:Scm_IntptrToInteger #x30 #x8)
         (:Scm_MakeNativeHandleSimple #x28 #x8) (:Scm_MakeString #x20 #x8)
         (:Scm_MakeFlonum #x18 #x8) (:Scm_Cons #x10 #x8)
         (:Scm__FFINativeCallCallback #x8 #x8) (:proc #x0 #x8))
        :locals
        ()))
      :endian
      little-endian
      :stack-word-size
      #x8))
   (p
    (delay
     ((module-binding-ref 'lang.asm.linker 'deserialize-obj-template) data))))
  (^ () (force p))))

(define
 (%iarg-type? t)
 (or (eq? t <top>) (subtype? t <integer>) (eq? t <c-string>)
  (is-a? t <c-pointer>) (is-a? t <c-array>) (is-a? t <c-function>)))
(define (%farg-type? t) (or (eq? t <double>) (eq? t <float>)))
(define
 (%asm-boxkind type)
 (cond
  ((eq? type <top>) 0)
  ((or (eq? type <fixnum>) (eq? type <uint8>)) 1)
  ((eq? type <intptr_t>) 2)
  ((eq? type <uintptr_t>) 3)
  ((eq? type <double>) 4)
  ((eq? type <float>) 5)
  ((eq? type <void>) 6)
  ((eq? type <c-string>) 7)
  ((or (is-a? type <c-pointer>) (is-a? type <c-array>)
    (is-a? type <c-function>))
   8)
  (else (error "unknown FFI box kind for asm path:" type))))
(define-enum SCM_STRING_COPYING)
(define
 (%asm-call-patches gea)
 `((:Scm_MakeFlonum ,<intptr_t> ,(gea "_Scm_MakeFlonum"))
   (:Scm_MakeString ,<intptr_t> ,(gea "_Scm_MakeString"))
   (:Scm_MakeNativeHandleSimple ,<intptr_t>
    ,(gea "_Scm_MakeNativeHandleSimple"))
   (:Scm_IntptrToInteger ,<intptr_t> ,(gea "_Scm_IntptrToInteger"))
   (:Scm_UintptrToInteger ,<intptr_t> ,(gea "_Scm_UintptrToInteger"))
   (:SCM_STRING_COPYING ,<int32> ,SCM_STRING_COPYING)
   (:SCM_UNDEFINED ,<top> ,(undefined))))
(define
 (%asm-callback-patches gea)
 `((:Scm__FFINativeCallCallback ,<intptr_t>
    ,(gea "_Scm__FFINativeCallCallback"))
   (:Scm_Cons ,<intptr_t> ,(gea "_Scm_Cons"))
   (:Scm_MakeFlonum ,<intptr_t> ,(gea "_Scm_MakeFlonum"))
   (:Scm_MakeString ,<intptr_t> ,(gea "_Scm_MakeString"))
   (:Scm_MakeNativeHandleSimple ,<intptr_t>
    ,(gea "_Scm_MakeNativeHandleSimple"))
   (:Scm_IntptrToInteger ,<intptr_t> ,(gea "_Scm_IntptrToInteger"))
   (:Scm_UintptrToInteger ,<intptr_t> ,(gea "_Scm_UintptrToInteger"))
   (:Scm_IntegerToIntptr ,<intptr_t> ,(gea "_Scm_IntegerToIntptr"))
   (:Scm_IntegerToUintptr ,<intptr_t> ,(gea "_Scm_IntegerToUintptr"))
   (:Scm_GetDouble ,<intptr_t> ,(gea "_Scm_GetDouble"))
   (:Scm_GetStringConst ,<intptr_t> ,(gea "_Scm_GetStringConst"))
   (:Scm_NativeHandlePtr ,<intptr_t> ,(gea "_Scm_NativeHandlePtr"))
   (:SCM_STRING_COPYING ,<int32> ,SCM_STRING_COPYING)
   (:SCM_NIL ,<top> ,'())))
(define
 call-sysvx64
 (^
  (ptr args rettype)
  (let*
   ((num-iargs (count (^p (%iarg-type? (car p))) args))
    (num-fargs (count (^p (%farg-type? (car p))) args))
    (num-spills (+ (max 0 (- num-iargs 6)) (max 0 (- num-fargs 8)))))
   (if
    (zero? num-spills)
    (call-sysvx64-regs ptr args num-iargs num-fargs rettype)
    (call-sysvx64-spill ptr args (min num-iargs 6) (min num-fargs 8) num-spills
     rettype)))))
(define
 call-sysvx64-regs
 (let
  ((% (%%make-bootstrap-function-table '(%%call-native %%get-entry-address)))
   (link-tmpl #f) (lbl-off #f) (prelinked-tmpl #f))
  (define
   (init!)
   (set! link-tmpl (module-binding-ref 'lang.asm.linker 'link-templates))
   (set! lbl-off (module-binding-ref 'lang.asm.linker 'linked-label-offset))
   (let
    ((prelink (module-binding-ref 'lang.asm.linker 'prelink-template))
     (gea (% '%%get-entry-address)))
    (set! prelinked-tmpl
     (prelink (sysvx64-call-reg-tmpl) (%asm-call-patches gea)))))
  (^
   (ptr args num-iargs num-fargs rettype)
   (when (not link-tmpl) (init!))
   (let*
    ((effective-nargs (if (zero? num-fargs) num-iargs (+ 6 num-fargs)))
     (entry-label
      (~
       '#(entry0: entry1: entry2: entry3: entry4: entry5: entry6: entry6f0:
          entry6f1: entry6f2: entry6f3: entry6f4: entry6f5: entry6f6: entry6f7:)
       effective-nargs))
     (retkind (%asm-boxkind rettype))
     (params
      (let
       loop
       ((args args) (icount 0) (fcount 0) (r '()))
       (cond
        ((null? args) r)
        ((%iarg-type? (caar args))
         (loop
          (cdr args)
          (+ icount 1)
          fcount
          (cons
           `(,(~ '#(:iarg0 :iarg1 :iarg2 :iarg3 :iarg4 :iarg5) icount)
             ,@(car args))
           r)))
        ((%farg-type? (caar args))
         (let
          ((fkey
            (~ '#(:farg0 :farg1 :farg2 :farg3 :farg4 :farg5 :farg6 :farg7)
             fcount))
           (vkey
            (~
             '#(:farg0-variant :farg1-variant :farg2-variant :farg3-variant
                :farg4-variant :farg5-variant :farg6-variant :farg7-variant)
             fcount)))
          (loop
           (cdr args)
           icount
           (+ fcount 1)
           (if (eq? (caar args) <float>)
            (list* `(,vkey ,<uint8> movss) `(,fkey ,@(car args)) r)
            (cons `(,fkey ,@(car args)) r)))))
        (else (error "bad arg entry:" (car args)))))))
    (receive
     (bytes lbs)
     (link-tmpl
      (list prelinked-tmpl)
      `((:func ,<void*> ,ptr) (:num-fargs ,<uint8> ,num-fargs)
        (:retkind ,<integer> ,retkind) (:rettype ,<top> ,rettype) ,@params))
     ((% '%%call-native) 0 0 bytes 0 (lbl-off lbs 'end:)
      (lbl-off lbs entry-label) 0 0))))))
(define
 call-sysvx64-spill
 (let
  ((% (%%make-bootstrap-function-table '(%%call-native %%get-entry-address)))
   (link-tmpl #f) (lbl-off #f) (prelinked-tmpl #f))
  (define
   (init!)
   (set! link-tmpl (module-binding-ref 'lang.asm.linker 'link-templates))
   (set! lbl-off (module-binding-ref 'lang.asm.linker 'linked-label-offset))
   (let
    ((prelink (module-binding-ref 'lang.asm.linker 'prelink-template))
     (gea (% '%%get-entry-address)))
    (set! prelinked-tmpl
     (prelink (sysvx64-call-spill-tmpl) (%asm-call-patches gea)))))
  (^
   (ptr args num-iargs num-fargs num-spills rettype)
   (when (not link-tmpl) (init!))
   (let*
    ((effective-nargs (if (zero? num-fargs) num-iargs (+ 6 num-fargs)))
     (entry-label
      (~
       '#(entry0: entry1: entry2: entry3: entry4: entry5: entry6: entry6f0:
          entry6f1: entry6f2: entry6f3: entry6f4: entry6f5: entry6f6: entry6f7:)
       effective-nargs)))
    (let
     loop
     ((args args) (icount 0) (fcount 0) (scount 0) (named '())
      (spill-params '()))
     (if
      (null? args)
      (let*
       ((align-pad (if (even? num-spills) 8 0))
        (spill-area-bytes (* 8 num-spills)) (retkind (%asm-boxkind rettype)))
       (receive
        (bytes lbs)
        (link-tmpl
         (list prelinked-tmpl)
         `((:func ,<void*> ,ptr) (:num-fargs ,<uint8> ,num-fargs)
           (:init-spill-size ,<int32> ,spill-area-bytes)
           (:epilogue-spill-size ,<int32> ,(+ spill-area-bytes align-pad))
           (:align-pad ,<int8> ,align-pad) (:retkind ,<integer> ,retkind)
           (:rettype ,<top> ,rettype) ,@named ,@spill-params)
         :postamble
         spill-area-bytes)
        ((% '%%call-native) 0 0 bytes 0
         (+ (lbl-off lbs 'spill:) spill-area-bytes) (lbl-off lbs entry-label) 0
         0)))
      (cond
       ((%iarg-type? (caar args))
        (if
         (< icount 6)
         (loop
          (cdr args)
          (+ icount 1)
          fcount
          scount
          (cons
           `(,(~ '#(:iarg0 :iarg1 :iarg2 :iarg3 :iarg4 :iarg5) icount)
             ,@(car args))
           named)
          spill-params)
         (loop
          (cdr args)
          (+ icount 1)
          fcount
          (+ scount 1)
          named
          (cons `(:spill ,@(car args) ,(* (- num-spills scount 1) 8))
           spill-params))))
       ((%farg-type? (caar args))
        (if
         (< fcount 8)
         (let
          ((fkey
            (~ '#(:farg0 :farg1 :farg2 :farg3 :farg4 :farg5 :farg6 :farg7)
             fcount))
           (vkey
            (~
             '#(:farg0-variant :farg1-variant :farg2-variant :farg3-variant
                :farg4-variant :farg5-variant :farg6-variant :farg7-variant)
             fcount)))
          (loop
           (cdr args)
           icount
           (+ fcount 1)
           scount
           (if (eq? (caar args) <float>)
            (list* `(,vkey ,<uint8> movss) `(,fkey ,@(car args)) named)
            (cons `(,fkey ,@(car args)) named))
           spill-params))
         (loop
          (cdr args)
          icount
          (+ fcount 1)
          (+ scount 1)
          named
          (cons `(:spill ,@(car args) ,(* (- num-spills scount 1) 8))
           spill-params))))
       (else (error "bad arg entry:" (car args))))))))))
(define
 (%asm-argsrcs arg-canons)
 (let
  loop
  ((as arg-canons) (ii 0) (fi 0) (acc '()))
  (cond
   ((null? as) (values (reverse acc) ii fi))
   ((or (eq? (car as) <double>) (eq? (car as) <float>))
    (loop (cdr as) ii (+ fi 1) (cons fi acc)))
   (else (loop (cdr as) (+ ii 1) fi (cons ii acc))))))
(define
 (%asm-argtype type)
 (if
  (or (is-a? type <c-pointer>) (is-a? type <c-array>) (is-a? type <c-function>))
  type #f))
(define
 assemble-callback-sysvx64
 (let
  ((% (%%make-bootstrap-function-table '(%%get-entry-address))) (link-tmpl #f)
   (lbl-off #f) (prelinked-tmpl #f))
  (define
   (init!)
   (set! link-tmpl (module-binding-ref 'lang.asm.linker 'link-templates))
   (set! lbl-off (module-binding-ref 'lang.asm.linker 'linked-label-offset))
   (let
    ((prelink (module-binding-ref 'lang.asm.linker 'prelink-template))
     (gea (% '%%get-entry-address)))
    (parameterize
     (((with-module gauche.typeutil native-ptr-fill-enabled?) #t))
     (set! prelinked-tmpl
      (prelink (sysvx64-callback-tmpl) (%asm-callback-patches gea))))))
  (define MAX-ARGS 8)
  (^
   (proc arg-canons rettype)
   (when (not link-tmpl) (init!))
   (let*
    ((nargs (length arg-canons)))
    (when
     (> nargs MAX-ARGS)
     (errorf
      "FFI native callback: more than ~a register-resident args is not supported yet (got ~a)"
      MAX-ARGS nargs))
    (receive
     (srcs num-int num-fp)
     (%asm-argsrcs arg-canons)
     (when
      (or (> num-int 6) (> num-fp 8))
      (errorf
       "FFI native callback: spilled args not yet supported (~a int / ~a fp)"
       num-int num-fp))
     (let*
      ((kinds (map %asm-boxkind arg-canons))
       (_
        (when (memv 6 kinds)
         (error "FFI native callback: <void> can't appear as an argument type")))
       (types (map %asm-argtype arg-canons))
       (pad
        (^ (lst filler)
         (append lst (make-list (- MAX-ARGS (length lst)) filler))))
       (k8 (pad kinds 0))
       (s8 (pad srcs 0))
       (t8 (pad types #f))
       (arg-params
        (append
         (map (^ (i k) `(,(make-keyword (format "argkind~a" i)) ,<int8> ,k))
          (iota MAX-ARGS) k8)
         (map (^ (i s) `(,(make-keyword (format "argsrc~a" i)) ,<int8> ,s))
          (iota MAX-ARGS) s8)
         (map (^ (i t) `(,(make-keyword (format "argtype~a" i)) ,<top> ,t))
          (iota MAX-ARGS) t8))))
      (parameterize
       (((with-module gauche.typeutil native-ptr-fill-enabled?) #t))
       (receive
        (bytes lbs)
        (link-tmpl
         (list prelinked-tmpl)
         `((:proc ,<top> ,proc) (:nargs ,<int8> ,nargs)
           (:retkind ,<int8> ,(%asm-boxkind rettype)) ,@arg-params))
        (values bytes (lbl-off lbs 'entry:) 0 0)))))))))
;; Register-only calling
;; winx64-call-reg
#|
text:                entry4f3::
0008: f2 0f 10 1d          ((movs_ :farg3-variant) (farg3:) %xmm3)
    : 00 00 00 00            
text:                entry4f2::
0010: f2 0f 10 15          ((movs_ :farg2-variant) (farg2:) %xmm2)
    : 00 00 00 00            
text:                entry4f1::
0018: f2 0f 10 0d          ((movs_ :farg1-variant) (farg1:) %xmm1)
    : 00 00 00 00            
text:                entry4f0::
0020: f2 0f 10 05          ((movs_ :farg0-variant) (farg0:) %xmm0)
    : 00 00 00 00            
text:                entry4::
002a: 49 b9 00 00          (movq (imm64 :iarg3) %r9)
    : 00 00 00 00            
    : 00 00                  
text:                entry3::
0034: 49 b8 00 00          (movq (imm64 :iarg2) %r8)
    : 00 00 00 00            
    : 00 00                  
text:                entry2::
003e: 48 ba 00 00          (movq (imm64 :iarg1) %rdx)
    : 00 00 00 00            
    : 00 00                  
text:                entry1::
0048: 48 b9 00 00          (movq (imm64 :iarg0) %rcx)
    : 00 00 00 00            
    : 00 00                  
text:                entry0::
0049: 53                   (push %rbx)
004d: 48 83 c4 e0          (addq -32 %rsp)
0053: ff 15 00 00          (call (func:))
    : 00 00                  
0055: b3 00                (movb (imm8 :retkind) %bl)
0057: fe cb                (decb %bl)
005d: 0f 88 84 00          (jsl epilog:)
    : 00 00                  
005f: 74 2d                (jz fixnum:)
0061: fe cb                (decb %bl)
0063: 74 32                (jz integer:)
0065: fe cb                (decb %bl)
0067: 74 39                (jz uinteger:)
0069: fe cb                (decb %bl)
006b: 74 44                (jz double:)
006d: fe cb                (decb %bl)
006f: 74 3c                (jz float:)
0071: fe cb                (decb %bl)
0073: 74 44                (jz void:)
0075: fe cb                (decb %bl)
0077: 74 4c                (jz cstring:)
text:                pointer::
007a: 48 89 c1             (movq %rax %rcx)
0084: 48 ba 00 00          (movq (imm64 :rettype) %rdx)
    : 00 00 00 00            
    : 00 00                  
008a: ff 15 00 00          (call (fn-handle:))
    : 00 00                  
008c: eb 55                (jmp epilog:)
text:                fixnum::
0090: 48 c1 e0 02          (shl 2 %rax)
0093: 48 ff c0             (incq %rax)
0095: eb 4c                (jmp epilog:)
text:                integer::
0098: 48 89 c1             (movq %rax %rcx)
009e: ff 15 00 00          (call (fn-int:))
    : 00 00                  
00a0: eb 41                (jmp epilog:)
text:                uinteger::
00a3: 48 89 c1             (movq %rax %rcx)
00a9: ff 15 00 00          (call (fn-uint:))
    : 00 00                  
00ab: eb 36                (jmp epilog:)
text:                float::
00af: f3 0f 5a c0          (cvtss2sd %xmm0 %xmm0)
text:                double::
00b5: ff 15 00 00          (call (fn-flonum:))
    : 00 00                  
00b7: eb 2a                (jmp epilog:)
text:                void::
00c1: 48 b8 00 00          (movq (imm64 :SCM_UNDEFINED) %rax)
    : 00 00 00 00            
    : 00 00                  
00c3: eb 1e                (jmp epilog:)
text:                cstring::
00c6: 48 89 c1             (movq %rax %rcx)
00cd: 48 c7 c2 ff          (movq -1 %rdx)
    : ff ff ff               
00d4: 49 c7 c0 ff          (movq -1 %r8)
    : ff ff ff               
00db: 49 c7 c1 00          (movq (imm32 :SCM_STRING_COPYING) %r9)
    : 00 00 00               
00e1: ff 15 00 00          (call (fn-string:))
    : 00 00                  
text:                epilog::
00e5: 48 83 c4 20          (addq 32 %rsp)
00e6: 5b                   (pop %rbx)
00e7: c3                   (ret)
     .endsection text
     .section data
data:                func::
00ef: 00 00 00 00          (.dataq :func)
    : 00 00 00 00            
data:                fn-flonum::
00f7: 00 00 00 00          (.dataq :Scm_MakeFlonum)
    : 00 00 00 00            
data:                fn-string::
00ff: 00 00 00 00          (.dataq :Scm_MakeString)
    : 00 00 00 00            
data:                fn-handle::
0107: 00 00 00 00          (.dataq :Scm_MakeNativeHandleSimple)
    : 00 00 00 00            
data:                fn-int::
010f: 00 00 00 00          (.dataq :Scm_IntptrToInteger)
    : 00 00 00 00            
data:                fn-uint::
0117: 00 00 00 00          (.dataq :Scm_UintptrToInteger)
    : 00 00 00 00            
data:                farg0::
011f: 00 00 00 00          (.dataq :farg0)
    : 00 00 00 00            
data:                farg1::
0127: 00 00 00 00          (.dataq :farg1)
    : 00 00 00 00            
data:                farg2::
012f: 00 00 00 00          (.dataq :farg2)
    : 00 00 00 00            
data:                farg3::
0137: 00 00 00 00          (.dataq :farg3)
    : 00 00 00 00            
data:                end::
|#
(define
 winx64-call-reg-tmpl
 (let*
  ((data
    '(:fragments
      ((:section
        text
        :bytes
        #u8(#xf2 #xf #x10 #x1d #x0 #x0 #x0 #x0 #xf2 #xf #x10 #x15 #x0 #x0
            #x0 #x0 #xf2 #xf #x10 #xd #x0 #x0 #x0 #x0 #xf2 #xf #x10 #x5 #x0
            #x0 #x0 #x0 #x49 #xb9 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x49
            #xb8 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x48 #xba #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x48 #xb9 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x53
            #x48 #x83 #xc4 #xe0 #xff #x15 #x0 #x0 #x0 #x0 #xb3 #x0 #xfe
            #xcb #xf #x88 #x84 #x0 #x0 #x0 #x74 #x2d #xfe #xcb #x74 #x32
            #xfe #xcb #x74 #x39 #xfe #xcb #x74 #x44 #xfe #xcb #x74 #x3c
            #xfe #xcb #x74 #x44 #xfe #xcb #x74 #x4c #x48 #x89 #xc1 #x48
            #xba #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #xff #x15 #x0 #x0 #x0 #x0
            #xeb #x55 #x48 #xc1 #xe0 #x2 #x48 #xff #xc0 #xeb #x4c #x48
            #x89 #xc1 #xff #x15 #x0 #x0 #x0 #x0 #xeb #x41 #x48 #x89 #xc1
            #xff #x15 #x0 #x0 #x0 #x0 #xeb #x36 #xf3 #xf #x5a #xc0 #xff
            #x15 #x0 #x0 #x0 #x0 #xeb #x2a #x48 #xb8 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #xeb #x1e #x48 #x89 #xc1 #x48 #xc7 #xc2 #xff #xff
            #xff #xff #x49 #xc7 #xc0 #xff #xff #xff #xff #x49 #xc7 #xc1
            #x0 #x0 #x0 #x0 #xff #x15 #x0 #x0 #x0 #x0 #x48 #x83 #xc4 #x20
            #x5b #xc3)
        :labels
        ((entry4f3: . #x0) (entry4f2: . #x8) (entry4f1: . #x10)
         (entry4f0: . #x18) (entry4: . #x20) (entry3: . #x2a)
         (entry2: . #x34) (entry1: . #x3e) (entry0: . #x48)
         (pointer: . #x77) (fixnum: . #x8c) (integer: . #x95)
         (uinteger: . #xa0) (float: . #xab) (double: . #xaf)
         (void: . #xb7) (cstring: . #xc3) (epilog: . #xe1))
        :patches
        ((fn-string: #xdd label-rel #xe1) (:SCM_STRING_COPYING #xd7 #x4)
         (:SCM_UNDEFINED #xb9 #x8) (fn-flonum: #xb1 label-rel #xb5)
         (fn-uint: #xa5 label-rel #xa9) (fn-int: #x9a label-rel #x9e)
         (fn-handle: #x86 label-rel #x8a) (:rettype #x7c #x8)
         (:retkind #x54 #x1) (func: #x4f label-rel #x53) (:iarg0 #x40 #x8)
         (:iarg1 #x36 #x8) (:iarg2 #x2c #x8) (:iarg3 #x22 #x8)
         (:farg0-variant #x18 x86_64-movs_) (farg0: #x1c label-rel #x20)
         (:farg1-variant #x10 x86_64-movs_) (farg1: #x14 label-rel #x18)
         (:farg2-variant #x8 x86_64-movs_) (farg2: #xc label-rel #x10)
         (:farg3-variant #x0 x86_64-movs_) (farg3: #x4 label-rel #x8))
        :locals
        ())
       (:section
        data
        :bytes
        #u8(#x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0)
        :labels
        ((func: . #x0) (fn-flonum: . #x8) (fn-string: . #x10)
         (fn-handle: . #x18) (fn-int: . #x20) (fn-uint: . #x28)
         (farg0: . #x30) (farg1: . #x38) (farg2: . #x40) (farg3: . #x48)
         (end: . #x50))
        :patches
        ((:farg3 #x48 #x8) (:farg2 #x40 #x8) (:farg1 #x38 #x8)
         (:farg0 #x30 #x8) (:Scm_UintptrToInteger #x28 #x8)
         (:Scm_IntptrToInteger #x20 #x8)
         (:Scm_MakeNativeHandleSimple #x18 #x8) (:Scm_MakeString #x10 #x8)
         (:Scm_MakeFlonum #x8 #x8) (:func #x0 #x8))
        :locals
        ()))
      :endian
      little-endian
      :stack-word-size
      #x8))
   (p
    (delay
     ((module-binding-ref 'lang.asm.linker 'deserialize-obj-template) data))))
  (^ () (force p))))

;; Spill-to-stack case
;; winx64-call-spill
#|
text:                entry::
text:                entry4f3::
0008: f2 0f 10 1d          ((movs_ :farg3-variant) (farg3:) %xmm3)
    : 00 00 00 00            
text:                entry4f2::
0010: f2 0f 10 15          ((movs_ :farg2-variant) (farg2:) %xmm2)
    : 00 00 00 00            
text:                entry4f1::
0018: f2 0f 10 0d          ((movs_ :farg1-variant) (farg1:) %xmm1)
    : 00 00 00 00            
text:                entry4f0::
0020: f2 0f 10 05          ((movs_ :farg0-variant) (farg0:) %xmm0)
    : 00 00 00 00            
text:                init::
0021: 53                   (push %rbx)
0028: 48 c7 c0 00          (movq (imm32 :init-spill-size) %rax)
    : 00 00 00               
002f: 4c 8d 15 30          (leaq (spill: %rip) %r10)
    : 01 00 00               
0033: 48 83 ec 00          (subq (imm8 :align-pad) %rsp)
text:                loop::
0036: 4d 8b 1a             (movq (%r10) %r11)
0038: 41 53                (push %r11)
003c: 49 83 c2 08          (addq 8 %r10)
0040: 48 83 e8 08          (subq 8 %rax)
0042: 75 f1                (jnz loop:)
text:                entry4::
004c: 49 b9 00 00          (movq (imm64 :iarg3) %r9)
    : 00 00 00 00            
    : 00 00                  
text:                entry3::
0056: 49 b8 00 00          (movq (imm64 :iarg2) %r8)
    : 00 00 00 00            
    : 00 00                  
text:                entry2::
0060: 48 ba 00 00          (movq (imm64 :iarg1) %rdx)
    : 00 00 00 00            
    : 00 00                  
text:                entry1::
006a: 48 b9 00 00          (movq (imm64 :iarg0) %rcx)
    : 00 00 00 00            
    : 00 00                  
text:                entry0::
006e: 48 83 c4 e0          (addq -32 %rsp)
0074: ff 15 00 00          (call (func:))
    : 00 00                  
0076: b3 00                (movb (imm8 :retkind) %bl)
0078: fe cb                (decb %bl)
007e: 0f 88 84 00          (jsl epilog:)
    : 00 00                  
0080: 74 2d                (jz fixnum:)
0082: fe cb                (decb %bl)
0084: 74 32                (jz integer:)
0086: fe cb                (decb %bl)
0088: 74 39                (jz uinteger:)
008a: fe cb                (decb %bl)
008c: 74 44                (jz double:)
008e: fe cb                (decb %bl)
0090: 74 3c                (jz float:)
0092: fe cb                (decb %bl)
0094: 74 44                (jz void:)
0096: fe cb                (decb %bl)
0098: 74 4c                (jz cstring:)
text:                pointer::
009b: 48 89 c1             (movq %rax %rcx)
00a5: 48 ba 00 00          (movq (imm64 :rettype) %rdx)
    : 00 00 00 00            
    : 00 00                  
00ab: ff 15 00 00          (call (fn-handle:))
    : 00 00                  
00ad: eb 55                (jmp epilog:)
text:                fixnum::
00b1: 48 c1 e0 02          (shl 2 %rax)
00b4: 48 ff c0             (incq %rax)
00b6: eb 4c                (jmp epilog:)
text:                integer::
00b9: 48 89 c1             (movq %rax %rcx)
00bf: ff 15 00 00          (call (fn-int:))
    : 00 00                  
00c1: eb 41                (jmp epilog:)
text:                uinteger::
00c4: 48 89 c1             (movq %rax %rcx)
00ca: ff 15 00 00          (call (fn-uint:))
    : 00 00                  
00cc: eb 36                (jmp epilog:)
text:                float::
00d0: f3 0f 5a c0          (cvtss2sd %xmm0 %xmm0)
text:                double::
00d6: ff 15 00 00          (call (fn-flonum:))
    : 00 00                  
00d8: eb 2a                (jmp epilog:)
text:                void::
00e2: 48 b8 00 00          (movq (imm64 :SCM_UNDEFINED) %rax)
    : 00 00 00 00            
    : 00 00                  
00e4: eb 1e                (jmp epilog:)
text:                cstring::
00e7: 48 89 c1             (movq %rax %rcx)
00ee: 48 c7 c2 ff          (movq -1 %rdx)
    : ff ff ff               
00f5: 49 c7 c0 ff          (movq -1 %r8)
    : ff ff ff               
00fc: 49 c7 c1 00          (movq (imm32 :SCM_STRING_COPYING) %r9)
    : 00 00 00               
0102: ff 15 00 00          (call (fn-string:))
    : 00 00                  
text:                epilog::
0106: 48 83 c4 20          (addq 32 %rsp)
text:                epilogue::
010d: 48 81 c4 00          (addq (imm32 :epilogue-spill-size) %rsp)
    : 00 00 00               
010e: 5b                   (pop %rbx)
010f: c3                   (ret)
     .endsection text
     .section data
data:                func::
0117: 00 00 00 00          (.dataq :func)
    : 00 00 00 00            
data:                fn-flonum::
011f: 00 00 00 00          (.dataq :Scm_MakeFlonum)
    : 00 00 00 00            
data:                fn-string::
0127: 00 00 00 00          (.dataq :Scm_MakeString)
    : 00 00 00 00            
data:                fn-handle::
012f: 00 00 00 00          (.dataq :Scm_MakeNativeHandleSimple)
    : 00 00 00 00            
data:                fn-int::
0137: 00 00 00 00          (.dataq :Scm_IntptrToInteger)
    : 00 00 00 00            
data:                fn-uint::
013f: 00 00 00 00          (.dataq :Scm_UintptrToInteger)
    : 00 00 00 00            
data:                farg0::
0147: 00 00 00 00          (.dataq :farg0)
    : 00 00 00 00            
data:                farg1::
014f: 00 00 00 00          (.dataq :farg1)
    : 00 00 00 00            
data:                farg2::
0157: 00 00 00 00          (.dataq :farg2)
    : 00 00 00 00            
data:                farg3::
015f: 00 00 00 00          (.dataq :farg3)
    : 00 00 00 00            
data:                spill::
0167: 00 00 00 00          (.dataq :spill)
    : 00 00 00 00            
|#
(define
 winx64-call-spill-tmpl
 (let*
  ((data
    '(:fragments
      ((:section
        text
        :bytes
        #u8(#xf2 #xf #x10 #x1d #x0 #x0 #x0 #x0 #xf2 #xf #x10 #x15 #x0 #x0
            #x0 #x0 #xf2 #xf #x10 #xd #x0 #x0 #x0 #x0 #xf2 #xf #x10 #x5 #x0
            #x0 #x0 #x0 #x53 #x48 #xc7 #xc0 #x0 #x0 #x0 #x0 #x4c #x8d #x15
            #x30 #x1 #x0 #x0 #x48 #x83 #xec #x0 #x4d #x8b #x1a #x41 #x53
            #x49 #x83 #xc2 #x8 #x48 #x83 #xe8 #x8 #x75 #xf1 #x49 #xb9 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x49 #xb8 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x48 #xba #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x48 #xb9
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x48 #x83 #xc4 #xe0 #xff #x15
            #x0 #x0 #x0 #x0 #xb3 #x0 #xfe #xcb #xf #x88 #x84 #x0 #x0 #x0
            #x74 #x2d #xfe #xcb #x74 #x32 #xfe #xcb #x74 #x39 #xfe #xcb
            #x74 #x44 #xfe #xcb #x74 #x3c #xfe #xcb #x74 #x44 #xfe #xcb
            #x74 #x4c #x48 #x89 #xc1 #x48 #xba #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #xff #x15 #x0 #x0 #x0 #x0 #xeb #x55 #x48 #xc1 #xe0 #x2
            #x48 #xff #xc0 #xeb #x4c #x48 #x89 #xc1 #xff #x15 #x0 #x0 #x0
            #x0 #xeb #x41 #x48 #x89 #xc1 #xff #x15 #x0 #x0 #x0 #x0 #xeb
            #x36 #xf3 #xf #x5a #xc0 #xff #x15 #x0 #x0 #x0 #x0 #xeb #x2a
            #x48 #xb8 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #xeb #x1e #x48 #x89
            #xc1 #x48 #xc7 #xc2 #xff #xff #xff #xff #x49 #xc7 #xc0 #xff
            #xff #xff #xff #x49 #xc7 #xc1 #x0 #x0 #x0 #x0 #xff #x15 #x0
            #x0 #x0 #x0 #x48 #x83 #xc4 #x20 #x48 #x81 #xc4 #x0 #x0 #x0 #x0
            #x5b #xc3)
        :labels
        ((entry: . #x0) (entry4f3: . #x0) (entry4f2: . #x8)
         (entry4f1: . #x10) (entry4f0: . #x18) (init: . #x20)
         (loop: . #x33) (entry4: . #x42) (entry3: . #x4c) (entry2: . #x56)
         (entry1: . #x60) (entry0: . #x6a) (pointer: . #x98)
         (fixnum: . #xad) (integer: . #xb6) (uinteger: . #xc1)
         (float: . #xcc) (double: . #xd0) (void: . #xd8) (cstring: . #xe4)
         (epilog: . #x102) (epilogue: . #x106))
        :patches
        ((:epilogue-spill-size #x109 #x4) (fn-string: #xfe label-rel #x102)
         (:SCM_STRING_COPYING #xf8 #x4) (:SCM_UNDEFINED #xda #x8)
         (fn-flonum: #xd2 label-rel #xd6) (fn-uint: #xc6 label-rel #xca)
         (fn-int: #xbb label-rel #xbf) (fn-handle: #xa7 label-rel #xab)
         (:rettype #x9d #x8) (:retkind #x75 #x1)
         (func: #x70 label-rel #x74) (:iarg0 #x62 #x8) (:iarg1 #x58 #x8)
         (:iarg2 #x4e #x8) (:iarg3 #x44 #x8) (:align-pad #x32 #x1)
         (:init-spill-size #x24 #x4) (:farg0-variant #x18 x86_64-movs_)
         (farg0: #x1c label-rel #x20) (:farg1-variant #x10 x86_64-movs_)
         (farg1: #x14 label-rel #x18) (:farg2-variant #x8 x86_64-movs_)
         (farg2: #xc label-rel #x10) (:farg3-variant #x0 x86_64-movs_)
         (farg3: #x4 label-rel #x8))
        :locals
        ())
       (:section
        data
        :bytes
        #u8(#x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0)
        :labels
        ((func: . #x0) (fn-flonum: . #x8) (fn-string: . #x10)
         (fn-handle: . #x18) (fn-int: . #x20) (fn-uint: . #x28)
         (farg0: . #x30) (farg1: . #x38) (farg2: . #x40) (farg3: . #x48)
         (spill: . #x50))
        :patches
        ((:spill #x50 #x8) (:farg3 #x48 #x8) (:farg2 #x40 #x8)
         (:farg1 #x38 #x8) (:farg0 #x30 #x8)
         (:Scm_UintptrToInteger #x28 #x8) (:Scm_IntptrToInteger #x20 #x8)
         (:Scm_MakeNativeHandleSimple #x18 #x8) (:Scm_MakeString #x10 #x8)
         (:Scm_MakeFlonum #x8 #x8) (:func #x0 #x8))
        :locals
        ()))
      :endian
      little-endian
      :stack-word-size
      #x8))
   (p
    (delay
     ((module-binding-ref 'lang.asm.linker 'deserialize-obj-template) data))))
  (^ () (force p))))

(define
 call-winx64
 (^
  (ptr args rettype)
  (let*
   ((num-args (length args))
    (num-fargs (count (^p (%farg-type? (car p))) args))
    (num-spills (max 0 (- num-args 4))))
   (if (zero? num-spills)
    (call-winx64-regs ptr args num-args num-fargs rettype)
    (call-winx64-spill ptr args num-args num-fargs num-spills rettype)))))
(define
 call-winx64-regs
 (let
  ((% (%%make-bootstrap-function-table '(%%call-native %%get-entry-address)))
   (link-tmpl #f) (lbl-off #f) (prelinked-tmpl #f))
  (define
   (init!)
   (set! link-tmpl (module-binding-ref 'lang.asm.linker 'link-templates))
   (set! lbl-off (module-binding-ref 'lang.asm.linker 'linked-label-offset))
   (let
    ((prelink (module-binding-ref 'lang.asm.linker 'prelink-template))
     (gea (% '%%get-entry-address)))
    (set! prelinked-tmpl
     (prelink (winx64-call-reg-tmpl) (%asm-call-patches gea)))))
  (^
   (ptr args num-args num-fargs rettype)
   (when (not link-tmpl) (init!))
   (let*
    ((effective-nargs (if (zero? num-fargs) num-args (+ 4 num-args)))
     (entry-label
      (~
       '#(entry0: entry1: entry2: entry3: entry4: entry4f0: entry4f1: entry4f2:
          entry4f3:)
       effective-nargs))
     (retkind (%asm-boxkind rettype))
     (params
      (let
       loop
       ((args args) (count 0) (r '()))
       (cond
        ((null? args) r)
        ((%iarg-type? (caar args))
         (loop (cdr args) (+ count 1)
          (cons `(,(~ '#(:iarg0 :iarg1 :iarg2 :iarg3) count) ,@(car args)) r)))
        ((%farg-type? (caar args))
         (let
          ((fkey (~ '#(:farg0 :farg1 :farg2 :farg3) count))
           (ikey (~ '#(:iarg0 :iarg1 :iarg2 :iarg3) count))
           (vkey
            (~ '#(:farg0-variant :farg1-variant :farg2-variant :farg3-variant)
             count)))
          (loop
           (cdr args)
           (+ count 1)
           (if
            (eq? (caar args) <float>)
            (list* `(,vkey ,<uint8> movss) `(,fkey ,@(car args))
             `(,ikey ,@(car args)) r)
            (list* `(,fkey ,@(car args)) `(,ikey ,@(car args)) r)))))
        (else (error "bad arg entry:" (car args)))))))
    (receive
     (bytes lbs)
     (link-tmpl
      (list prelinked-tmpl)
      (list* `(:func ,<void*> ,ptr) `(:retkind ,<integer> ,retkind)
       `(:rettype ,<top> ,rettype) params))
     ((% '%%call-native) 0 0 bytes 0 (lbl-off lbs 'end:)
      (lbl-off lbs entry-label) (+ (lbl-off lbs 'entry0:) 5) 40))))))
(define
 call-winx64-spill
 (let
  ((% (%%make-bootstrap-function-table '(%%call-native %%get-entry-address)))
   (link-tmpl #f) (lbl-off #f) (prelinked-tmpl #f))
  (define
   (init!)
   (set! link-tmpl (module-binding-ref 'lang.asm.linker 'link-templates))
   (set! lbl-off (module-binding-ref 'lang.asm.linker 'linked-label-offset))
   (let
    ((prelink (module-binding-ref 'lang.asm.linker 'prelink-template))
     (gea (% '%%get-entry-address)))
    (set! prelinked-tmpl
     (prelink (winx64-call-spill-tmpl) (%asm-call-patches gea)))))
  (^
   (ptr args num-args num-fargs num-spills rettype)
   (when (not link-tmpl) (init!))
   (let
    loop
    ((args args) (count 0) (scount 0) (named '()) (spill-params '()))
    (if
     (null? args)
     (let*
      ((align-pad (if (even? num-spills) 0 8))
       (spill-area-bytes (* 8 num-spills)) (retkind (%asm-boxkind rettype)))
      (receive
       (bytes lbs)
       (link-tmpl
        (list prelinked-tmpl)
        `((:func ,<void*> ,ptr) (:init-spill-size ,<int32> ,spill-area-bytes)
          (:epilogue-spill-size ,<int32> ,(+ spill-area-bytes align-pad))
          (:align-pad ,<int8> ,align-pad) (:retkind ,<integer> ,retkind)
          (:rettype ,<top> ,rettype) ,@named ,@spill-params)
        :postamble
        spill-area-bytes)
       ((% '%%call-native) 0 0 bytes 0
        (+ (lbl-off lbs 'spill:) spill-area-bytes) (lbl-off lbs 'entry:)
        (+ (lbl-off lbs 'entry0:) 4) (+ spill-area-bytes align-pad 40))))
     (cond
      ((%iarg-type? (caar args))
       (if
        (< count 4)
        (loop (cdr args) (+ count 1) scount
         (cons `(,(~ '#(:iarg0 :iarg1 :iarg2 :iarg3) count) ,@(car args)) named)
         spill-params)
        (loop
         (cdr args)
         (+ count 1)
         (+ scount 1)
         named
         (cons `(:spill ,@(car args) ,(* (- num-spills scount 1) 8))
          spill-params))))
      ((%farg-type? (caar args))
       (if
        (< count 4)
        (let
         ((fkey (~ '#(:farg0 :farg1 :farg2 :farg3) count))
          (ikey (~ '#(:iarg0 :iarg1 :iarg2 :iarg3) count))
          (vkey
           (~ '#(:farg0-variant :farg1-variant :farg2-variant :farg3-variant)
            count)))
         (loop
          (cdr args)
          (+ count 1)
          scount
          (if
           (eq? (caar args) <float>)
           (list* `(,vkey ,<uint8> movss) `(,fkey ,@(car args))
            `(,ikey ,@(car args)) named)
           (list* `(,fkey ,@(car args)) `(,ikey ,@(car args)) named))
          spill-params))
        (loop
         (cdr args)
         (+ count 1)
         (+ scount 1)
         named
         (cons `(:spill ,@(car args) ,(* (- num-spills scount 1) 8))
          spill-params))))
      (else (error "bad arg entry:" (car args)))))))))
;; Callback trampoline (Windows x64)
;; winx64-callback
#|
text:                entry::
0001: 53                   (push %rbx)
0008: 48 81 ec 80          (subq (imm32 128) %rsp)
    : 00 00 00               
text:                prolog-end::
000d: 48 89 4c 24          (movq %rcx (32 %rsp))
    : 20                     
0012: 48 89 54 24          (movq %rdx (40 %rsp))
    : 28                     
0017: 4c 89 44 24          (movq %r8 (48 %rsp))
    : 30                     
001c: 4c 89 4c 24          (movq %r9 (56 %rsp))
    : 38                     
0022: f2 0f 11 44          (movsd %xmm0 (64 %rsp))
    : 24 40                  
0028: f2 0f 11 4c          (movsd %xmm1 (72 %rsp))
    : 24 48                  
002e: f2 0f 11 54          (movsd %xmm2 (80 %rsp))
    : 24 50                  
0034: f2 0f 11 5c          (movsd %xmm3 (88 %rsp))
    : 24 58                  
0037: 48 31 db             (xorq %rbx %rbx)
text:                box-loop::
003f: 48 0f b6 05          (movzbq (nargs:) %rax)
    : 00 00 00 00            
0042: 48 39 c3             (cmpq %rax %rbx)
0048: 0f 8d da 00          (jgel build-args:)
    : 00 00                  
004f: 4c 8d 15 00          (leaq (argkinds:) %r10)
    : 00 00 00               
0054: 49 0f b6 04          (movzbq (%r10 %rbx 1) %rax)
    : 1a                     
0056: 3c 04                (cmpb 4 %al)
005c: 0f 84 98 00          (jel box-double:)
    : 00 00                  
005e: 3c 05                (cmpb 5 %al)
0064: 0f 84 a1 00          (jel box-float:)
    : 00 00                  
0069: 48 8b 4c dc          (movq (32 %rsp %rbx 8) %rcx)
    : 20                     
006b: 3c 01                (cmpb 1 %al)
0071: 0f 84 28 00          (jel box-fixnum:)
    : 00 00                  
0073: 3c 02                (cmpb 2 %al)
0079: 0f 84 2f 00          (jel box-intptr:)
    : 00 00                  
007b: 3c 03                (cmpb 3 %al)
0081: 0f 84 32 00          (jel box-uintptr:)
    : 00 00                  
0083: 3c 07                (cmpb 7 %al)
0089: 0f 84 35 00          (jel box-cstring:)
    : 00 00                  
008b: 3c 08                (cmpb 8 %al)
0091: 0f 84 4d 00          (jel box-pointer:)
    : 00 00                  
0094: 48 89 c8             (movq %rcx %rax)
0099: e9 7c 00 00          (jmpl store-boxed:)
    : 00                     
text:                box-fixnum::
009c: 48 89 c8             (movq %rcx %rax)
00a0: 48 c1 e0 02          (shl 2 %rax)
00a3: 48 ff c0             (incq %rax)
00a8: e9 6d 00 00          (jmpl store-boxed:)
    : 00                     
text:                box-intptr::
00ae: ff 15 00 00          (call (fn-int:))
    : 00 00                  
00b3: e9 62 00 00          (jmpl store-boxed:)
    : 00                     
text:                box-uintptr::
00b9: ff 15 00 00          (call (fn-uint:))
    : 00 00                  
00be: e9 57 00 00          (jmpl store-boxed:)
    : 00                     
text:                box-cstring::
00c5: 48 c7 c2 ff          (movq -1 %rdx)
    : ff ff ff               
00cc: 49 c7 c0 ff          (movq -1 %r8)
    : ff ff ff               
00d3: 49 c7 c1 00          (movq (imm32 :SCM_STRING_COPYING) %r9)
    : 00 00 00               
00d9: ff 15 00 00          (call (fn-string:))
    : 00 00                  
00de: e9 37 00 00          (jmpl store-boxed:)
    : 00                     
text:                box-pointer::
00e5: 4c 8d 1d 00          (leaq (argtypes:) %r11)
    : 00 00 00               
00e9: 49 8b 14 db          (movq (%r11 %rbx 8) %rdx)
00ef: ff 15 00 00          (call (fn-handle:))
    : 00 00                  
00f4: e9 21 00 00          (jmpl store-boxed:)
    : 00                     
text:                box-double::
00fa: f2 0f 10 44          (movsd (64 %rsp %rbx 8) %xmm0)
    : dc 40                  
0100: ff 15 00 00          (call (fn-flonum:))
    : 00 00                  
0105: e9 10 00 00          (jmpl store-boxed:)
    : 00                     
text:                box-float::
010b: f2 0f 10 44          (movsd (64 %rsp %rbx 8) %xmm0)
    : dc 40                  
010f: f3 0f 5a c0          (cvtss2sd %xmm0 %xmm0)
0115: ff 15 00 00          (call (fn-flonum:))
    : 00 00                  
text:                store-boxed::
011a: 48 89 44 dc          (movq %rax (96 %rsp %rbx 8))
    : 60                     
011d: 48 ff c3             (incq %rbx)
0122: e9 15 ff ff          (jmpl box-loop:)
    : ff                     
text:                build-args::
0129: 48 8b 05 00          (movq (SCM_NIL:) %rax)
    : 00 00 00               
0131: 48 0f b6 1d          (movzbq (nargs:) %rbx)
    : 00 00 00 00            
text:                build-loop::
0135: 48 83 fb 00          (cmpq 0 %rbx)
013b: 0f 84 16 00          (jel apply-it:)
    : 00 00                  
013e: 48 ff cb             (decq %rbx)
0141: 48 89 c2             (movq %rax %rdx)
0146: 48 8b 4c dc          (movq (96 %rsp %rbx 8) %rcx)
    : 60                     
014c: ff 15 00 00          (call (fn-cons:))
    : 00 00                  
0151: e9 e0 ff ff          (jmpl build-loop:)
    : ff                     
text:                apply-it::
0158: 48 8b 0d 00          (movq (proc:) %rcx)
    : 00 00 00               
015b: 48 89 c2             (movq %rax %rdx)
0161: ff 15 00 00          (call (fn-callback:))
    : 00 00                  
0163: b3 00                (movb (imm8 :retkind) %bl)
0165: fe cb                (decb %bl)
016b: 0f 88 66 00          (jsl epilog:)
    : 00 00                  
016d: 74 23                (jz ret-fixnum:)
016f: fe cb                (decb %bl)
0171: 74 25                (jz ret-intptr:)
0173: fe cb                (decb %bl)
0175: 74 2c                (jz ret-uintptr:)
0177: fe cb                (decb %bl)
0179: 74 33                (jz ret-double:)
017b: fe cb                (decb %bl)
017d: 74 3a                (jz ret-float:)
017f: fe cb                (decb %bl)
0181: 74 45                (jz ret-void:)
0183: fe cb                (decb %bl)
0185: 74 43                (jz ret-cstring:)
text:                ret-pointer::
0188: 48 89 c1             (movq %rax %rcx)
018e: ff 15 00 00          (call (fn-handle-ptr:))
    : 00 00                  
0190: eb 41                (jmp epilog:)
text:                ret-fixnum::
0194: 48 c1 f8 02          (sar 2 %rax)
0196: eb 3b                (jmp epilog:)
text:                ret-intptr::
0199: 48 89 c1             (movq %rax %rcx)
019f: ff 15 00 00          (call (fn-get-int:))
    : 00 00                  
01a1: eb 30                (jmp epilog:)
text:                ret-uintptr::
01a4: 48 89 c1             (movq %rax %rcx)
01aa: ff 15 00 00          (call (fn-get-uint:))
    : 00 00                  
01ac: eb 25                (jmp epilog:)
text:                ret-double::
01af: 48 89 c1             (movq %rax %rcx)
01b5: ff 15 00 00          (call (fn-get-double:))
    : 00 00                  
01b7: eb 1a                (jmp epilog:)
text:                ret-float::
01ba: 48 89 c1             (movq %rax %rcx)
01c0: ff 15 00 00          (call (fn-get-double:))
    : 00 00                  
01c4: f2 0f 5a c0          (cvtsd2ss %xmm0 %xmm0)
01c6: eb 0b                (jmp epilog:)
text:                ret-void::
01c8: eb 09                (jmp epilog:)
text:                ret-cstring::
01cb: 48 89 c1             (movq %rax %rcx)
01d1: ff 15 00 00          (call (fn-get-cstring:))
    : 00 00                  
text:                epilog::
01d8: 48 81 c4 80          (addq (imm32 128) %rsp)
    : 00 00 00               
01d9: 5b                   (pop %rbx)
01da: c3                   (ret)
     .endsection text
     .section data
data:                proc::
01e2: 00 00 00 00          (.dataq :proc)
    : 00 00 00 00            
data:                fn-callback::
01ea: 00 00 00 00          (.dataq :Scm__FFINativeCallCallback)
    : 00 00 00 00            
data:                fn-cons::
01f2: 00 00 00 00          (.dataq :Scm_Cons)
    : 00 00 00 00            
data:                fn-flonum::
01fa: 00 00 00 00          (.dataq :Scm_MakeFlonum)
    : 00 00 00 00            
data:                fn-string::
0202: 00 00 00 00          (.dataq :Scm_MakeString)
    : 00 00 00 00            
data:                fn-handle::
020a: 00 00 00 00          (.dataq :Scm_MakeNativeHandleSimple)
    : 00 00 00 00            
data:                fn-int::
0212: 00 00 00 00          (.dataq :Scm_IntptrToInteger)
    : 00 00 00 00            
data:                fn-uint::
021a: 00 00 00 00          (.dataq :Scm_UintptrToInteger)
    : 00 00 00 00            
data:                fn-get-int::
0222: 00 00 00 00          (.dataq :Scm_IntegerToIntptr)
    : 00 00 00 00            
data:                fn-get-uint::
022a: 00 00 00 00          (.dataq :Scm_IntegerToUintptr)
    : 00 00 00 00            
data:                fn-get-double::
0232: 00 00 00 00          (.dataq :Scm_GetDouble)
    : 00 00 00 00            
data:                fn-get-cstring::
023a: 00 00 00 00          (.dataq :Scm_GetStringConst)
    : 00 00 00 00            
data:                fn-handle-ptr::
0242: 00 00 00 00          (.dataq :Scm_NativeHandlePtr)
    : 00 00 00 00            
data:                SCM_NIL::
024a: 00 00 00 00          (.dataq :SCM_NIL)
    : 00 00 00 00            
data:                nargs::
024b: 00                   (.datab :nargs)
data:                argkinds::
024c: 00                   (.datab :argkind0)
024d: 00                   (.datab :argkind1)
024e: 00                   (.datab :argkind2)
024f: 00                   (.datab :argkind3)
data:                argtypes::
0257: 00 00 00 00          (.dataq :argtype0)
    : 00 00 00 00            
025f: 00 00 00 00          (.dataq :argtype1)
    : 00 00 00 00            
0267: 00 00 00 00          (.dataq :argtype2)
    : 00 00 00 00            
026f: 00 00 00 00          (.dataq :argtype3)
    : 00 00 00 00            
data:                end::
|#
(define
 winx64-callback-tmpl
 (let*
  ((data
    '(:fragments
      ((:section
        text
        :bytes
        #u8(#x53 #x48 #x81 #xec #x80 #x0 #x0 #x0 #x48 #x89 #x4c #x24 #x20
            #x48 #x89 #x54 #x24 #x28 #x4c #x89 #x44 #x24 #x30 #x4c #x89
            #x4c #x24 #x38 #xf2 #xf #x11 #x44 #x24 #x40 #xf2 #xf #x11 #x4c
            #x24 #x48 #xf2 #xf #x11 #x54 #x24 #x50 #xf2 #xf #x11 #x5c #x24
            #x58 #x48 #x31 #xdb #x48 #xf #xb6 #x5 #x0 #x0 #x0 #x0 #x48
            #x39 #xc3 #xf #x8d #xda #x0 #x0 #x0 #x4c #x8d #x15 #x0 #x0 #x0
            #x0 #x49 #xf #xb6 #x4 #x1a #x3c #x4 #xf #x84 #x98 #x0 #x0 #x0
            #x3c #x5 #xf #x84 #xa1 #x0 #x0 #x0 #x48 #x8b #x4c #xdc #x20
            #x3c #x1 #xf #x84 #x28 #x0 #x0 #x0 #x3c #x2 #xf #x84 #x2f #x0
            #x0 #x0 #x3c #x3 #xf #x84 #x32 #x0 #x0 #x0 #x3c #x7 #xf #x84
            #x35 #x0 #x0 #x0 #x3c #x8 #xf #x84 #x4d #x0 #x0 #x0 #x48 #x89
            #xc8 #xe9 #x7c #x0 #x0 #x0 #x48 #x89 #xc8 #x48 #xc1 #xe0 #x2
            #x48 #xff #xc0 #xe9 #x6d #x0 #x0 #x0 #xff #x15 #x0 #x0 #x0 #x0
            #xe9 #x62 #x0 #x0 #x0 #xff #x15 #x0 #x0 #x0 #x0 #xe9 #x57 #x0
            #x0 #x0 #x48 #xc7 #xc2 #xff #xff #xff #xff #x49 #xc7 #xc0 #xff
            #xff #xff #xff #x49 #xc7 #xc1 #x0 #x0 #x0 #x0 #xff #x15 #x0
            #x0 #x0 #x0 #xe9 #x37 #x0 #x0 #x0 #x4c #x8d #x1d #x0 #x0 #x0
            #x0 #x49 #x8b #x14 #xdb #xff #x15 #x0 #x0 #x0 #x0 #xe9 #x21
            #x0 #x0 #x0 #xf2 #xf #x10 #x44 #xdc #x40 #xff #x15 #x0 #x0 #x0
            #x0 #xe9 #x10 #x0 #x0 #x0 #xf2 #xf #x10 #x44 #xdc #x40 #xf3
            #xf #x5a #xc0 #xff #x15 #x0 #x0 #x0 #x0 #x48 #x89 #x44 #xdc
            #x60 #x48 #xff #xc3 #xe9 #x15 #xff #xff #xff #x48 #x8b #x5 #x0
            #x0 #x0 #x0 #x48 #xf #xb6 #x1d #x0 #x0 #x0 #x0 #x48 #x83 #xfb
            #x0 #xf #x84 #x16 #x0 #x0 #x0 #x48 #xff #xcb #x48 #x89 #xc2
            #x48 #x8b #x4c #xdc #x60 #xff #x15 #x0 #x0 #x0 #x0 #xe9 #xe0
            #xff #xff #xff #x48 #x8b #xd #x0 #x0 #x0 #x0 #x48 #x89 #xc2
            #xff #x15 #x0 #x0 #x0 #x0 #xb3 #x0 #xfe #xcb #xf #x88 #x66 #x0
            #x0 #x0 #x74 #x23 #xfe #xcb #x74 #x25 #xfe #xcb #x74 #x2c #xfe
            #xcb #x74 #x33 #xfe #xcb #x74 #x3a #xfe #xcb #x74 #x45 #xfe
            #xcb #x74 #x43 #x48 #x89 #xc1 #xff #x15 #x0 #x0 #x0 #x0 #xeb
            #x41 #x48 #xc1 #xf8 #x2 #xeb #x3b #x48 #x89 #xc1 #xff #x15 #x0
            #x0 #x0 #x0 #xeb #x30 #x48 #x89 #xc1 #xff #x15 #x0 #x0 #x0 #x0
            #xeb #x25 #x48 #x89 #xc1 #xff #x15 #x0 #x0 #x0 #x0 #xeb #x1a
            #x48 #x89 #xc1 #xff #x15 #x0 #x0 #x0 #x0 #xf2 #xf #x5a #xc0
            #xeb #xb #xeb #x9 #x48 #x89 #xc1 #xff #x15 #x0 #x0 #x0 #x0
            #x48 #x81 #xc4 #x80 #x0 #x0 #x0 #x5b #xc3)
        :labels
        ((entry: . #x0) (prolog-end: . #x8) (box-loop: . #x37)
         (box-fixnum: . #x99) (box-intptr: . #xa8) (box-uintptr: . #xb3)
         (box-cstring: . #xbe) (box-pointer: . #xde) (box-double: . #xf4)
         (box-float: . #x105) (store-boxed: . #x115) (build-args: . #x122)
         (build-loop: . #x131) (apply-it: . #x151) (ret-pointer: . #x185)
         (ret-fixnum: . #x190) (ret-intptr: . #x196)
         (ret-uintptr: . #x1a1) (ret-double: . #x1ac) (ret-float: . #x1b7)
         (ret-void: . #x1c6) (ret-cstring: . #x1c8) (epilog: . #x1d1))
        :patches
        ((fn-get-cstring: #x1cd label-rel #x1d1)
         (fn-get-double: #x1bc label-rel #x1c0)
         (fn-get-double: #x1b1 label-rel #x1b5)
         (fn-get-uint: #x1a6 label-rel #x1aa)
         (fn-get-int: #x19b label-rel #x19f)
         (fn-handle-ptr: #x18a label-rel #x18e) (:retkind #x162 #x1)
         (fn-callback: #x15d label-rel #x161)
         (proc: #x154 label-rel #x158) (fn-cons: #x148 label-rel #x14c)
         (nargs: #x12d label-rel #x131) (SCM_NIL: #x125 label-rel #x129)
         (fn-flonum: #x111 label-rel #x115)
         (fn-flonum: #xfc label-rel #x100)
         (fn-handle: #xeb label-rel #xef) (argtypes: #xe1 label-rel #xe5)
         (fn-string: #xd5 label-rel #xd9) (:SCM_STRING_COPYING #xcf #x4)
         (fn-uint: #xb5 label-rel #xb9) (fn-int: #xaa label-rel #xae)
         (argkinds: #x4b label-rel #x4f) (nargs: #x3b label-rel #x3f))
        :locals
        ())
       (:section
        data
        :bytes
        #u8(#x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0
            #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0)
        :labels
        ((proc: . #x0) (fn-callback: . #x8) (fn-cons: . #x10)
         (fn-flonum: . #x18) (fn-string: . #x20) (fn-handle: . #x28)
         (fn-int: . #x30) (fn-uint: . #x38) (fn-get-int: . #x40)
         (fn-get-uint: . #x48) (fn-get-double: . #x50)
         (fn-get-cstring: . #x58) (fn-handle-ptr: . #x60)
         (SCM_NIL: . #x68) (nargs: . #x70) (argkinds: . #x71)
         (argtypes: . #x75) (end: . #x95))
        :patches
        ((:argtype3 #x8d #x8) (:argtype2 #x85 #x8) (:argtype1 #x7d #x8)
         (:argtype0 #x75 #x8) (:argkind3 #x74 #x1) (:argkind2 #x73 #x1)
         (:argkind1 #x72 #x1) (:argkind0 #x71 #x1) (:nargs #x70 #x1)
         (:SCM_NIL #x68 #x8) (:Scm_NativeHandlePtr #x60 #x8)
         (:Scm_GetStringConst #x58 #x8) (:Scm_GetDouble #x50 #x8)
         (:Scm_IntegerToUintptr #x48 #x8) (:Scm_IntegerToIntptr #x40 #x8)
         (:Scm_UintptrToInteger #x38 #x8) (:Scm_IntptrToInteger #x30 #x8)
         (:Scm_MakeNativeHandleSimple #x28 #x8) (:Scm_MakeString #x20 #x8)
         (:Scm_MakeFlonum #x18 #x8) (:Scm_Cons #x10 #x8)
         (:Scm__FFINativeCallCallback #x8 #x8) (:proc #x0 #x8))
        :locals
        ()))
      :endian
      little-endian
      :stack-word-size
      #x8))
   (p
    (delay
     ((module-binding-ref 'lang.asm.linker 'deserialize-obj-template) data))))
  (^ () (force p))))

(define
 assemble-callback-winx64
 (let
  ((% (%%make-bootstrap-function-table '(%%get-entry-address))) (link-tmpl #f)
   (lbl-off #f) (prelinked-tmpl #f))
  (define
   (init!)
   (set! link-tmpl (module-binding-ref 'lang.asm.linker 'link-templates))
   (set! lbl-off (module-binding-ref 'lang.asm.linker 'linked-label-offset))
   (let
    ((prelink (module-binding-ref 'lang.asm.linker 'prelink-template))
     (gea (% '%%get-entry-address)))
    (parameterize
     (((with-module gauche.typeutil native-ptr-fill-enabled?) #t))
     (set! prelinked-tmpl
      (prelink (winx64-callback-tmpl) (%asm-callback-patches gea))))))
  (define MAX-ARGS 4)
  (^
   (proc arg-canons rettype)
   (when (not link-tmpl) (init!))
   (let*
    ((nargs (length arg-canons)))
    (when
     (> nargs MAX-ARGS)
     (errorf
      "FFI native callback: more than ~a register-resident args is not supported yet (got ~a)"
      MAX-ARGS nargs))
    (let*
     ((kinds (map %asm-boxkind arg-canons))
      (_
       (when (memv 6 kinds)
        (error "FFI native callback: <void> can't appear as an argument type")))
      (types (map %asm-argtype arg-canons))
      (pad
       (^ (lst filler)
        (append lst (make-list (- MAX-ARGS (length lst)) filler))))
      (k4 (pad kinds 0))
      (t4 (pad types #f))
      (arg-params
       (append
        (map (^ (i k) `(,(make-keyword (format "argkind~a" i)) ,<int8> ,k))
         (iota MAX-ARGS) k4)
        (map (^ (i t) `(,(make-keyword (format "argtype~a" i)) ,<top> ,t))
         (iota MAX-ARGS) t4))))
     (parameterize
      (((with-module gauche.typeutil native-ptr-fill-enabled?) #t))
      (receive
       (bytes lbs)
       (link-tmpl
        (list prelinked-tmpl)
        `((:proc ,<top> ,proc) (:nargs ,<int8> ,nargs)
          (:retkind ,<int8> ,(%asm-boxkind rettype)) ,@arg-params))
       (let*
        ((entry-off (lbl-off lbs 'entry:))
         (prolog-end (lbl-off lbs 'prolog-end:)))
        (values bytes entry-off prolog-end (+ 8 128))))))))))
