From fe2c20882aba3194a0b25211e763c90263c80576 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 13 Oct 2008 22:43:32 -0500 Subject: [PATCH] Fix alien accessor intrinsics; a bit more complex now that we don't reserve a tempreg --- basis/cpu/x86/64/64.factor | 65 ++++++++++++++++++++-- basis/cpu/x86/assembler/assembler.factor | 8 +++ basis/cpu/x86/intrinsics/intrinsics.factor | 46 +++++++-------- basis/cpu/x86/sse2/sse2.factor | 32 ++++++----- 4 files changed, 109 insertions(+), 42 deletions(-) diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index fec3f453ae..a78b4d8d92 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -6,7 +6,8 @@ layouts alien alien.accessors alien.structs slots splitting assocs combinators cpu.x86.assembler cpu.x86.architecture cpu.x86.intrinsics cpu.x86.sse2 cpu.x86.allot cpu.architecture compiler.constants -compiler.codegen compiler.codegen.fixup compiler.cfg.instructions ; +compiler.codegen compiler.codegen.fixup compiler.cfg.instructions +compiler.cfg.builder ; IN: cpu.x86.64 M: x86.64 machine-registers @@ -224,10 +225,64 @@ M: x86.64 %callback-value ( ctype -- ) USE: cpu.x86.intrinsics +: (%alien-get-4) ( -- ) + small-reg-32 "offset" operand [] MOV ; inline + +: %alien-unsigned-4 ( -- ) + %prepare-alien-accessor + "value" operand small-reg = [ + (%alien-get-4) + ] [ + small-reg PUSH + (%alien-get-4) + "value" operand small-reg MOV + small-reg POP + ] if + "value" operand %tag-fixnum ; inline + +: (%alien-signed-4) ( -- ) + (%alien-get-4) + "value" operand small-reg-32 MOVSX ; + +: %alien-signed-4 ( -- ) + %prepare-alien-accessor + "value" operand small-reg = [ + (%alien-signed-4) + ] [ + small-reg PUSH + (%alien-signed-4) + small-reg POP + ] if + "value" operand %tag-fixnum ; inline + +: define-alien-unsigned-4-getter ( word -- ) + [ %alien-unsigned-4 ] alien-integer-get-template define-intrinsic ; + +: define-alien-signed-4-getter ( word -- ) + [ %alien-signed-4 ] alien-integer-get-template define-intrinsic ; + +: %set-alien-4 ( -- ) + "value" operand "offset" operand = [ + "value" operand %untag-fixnum + ] unless + %prepare-alien-accessor + small-reg "offset" operand = [ + "value" operand "offset" operand XCHG + "value" operand [] small-reg-32 MOV + ] [ + small-reg PUSH + small-reg "value" operand MOV + "offset" operand [] small-reg-32 MOV + small-reg POP + ] if ; inline + +: define-alien-4-setter ( word -- ) + [ %set-alien-4 ] alien-integer-set-template define-intrinsic ; + ! On 64-bit systems, the result of reading 4 bytes from memory ! is a fixnum. -\ alien-unsigned-4 small-reg-32 define-unsigned-getter -\ set-alien-unsigned-4 small-reg-32 define-setter +\ alien-unsigned-4 define-alien-unsigned-4-getter +\ set-alien-unsigned-4 define-alien-4-setter -\ alien-signed-4 small-reg-32 define-signed-getter -\ set-alien-signed-4 small-reg-32 define-setter +\ alien-signed-4 define-alien-signed-4-getter +\ set-alien-signed-4 define-alien-4-setter diff --git a/basis/cpu/x86/assembler/assembler.factor b/basis/cpu/x86/assembler/assembler.factor index e4f81993ca..91e4e8ca69 100644 --- a/basis/cpu/x86/assembler/assembler.factor +++ b/basis/cpu/x86/assembler/assembler.factor @@ -378,6 +378,8 @@ GENERIC: CMP ( dst src -- ) M: immediate CMP swap { BIN: 111 t HEX: 80 } immediate-1/4 ; M: operand CMP OCT: 070 2-operand ; +: XCHG ( dst src -- ) OCT: 207 2-operand ; + : NOT ( dst -- ) { BIN: 010 t HEX: f7 } 1-operand ; : NEG ( dst -- ) { BIN: 011 t HEX: f7 } 1-operand ; : MUL ( dst -- ) { BIN: 100 t HEX: f7 } 1-operand ; @@ -406,6 +408,12 @@ M: operand IMUL2 OCT: 257 extended-opcode (2-operand) ; swapd (2-operand) ; +: MOVZX ( dst src -- ) + OCT: 266 extended-opcode + over register-16? [ BIN: 1 opcode-or ] when + swapd + (2-operand) ; + ! Conditional move : MOVcc ( dst src cc -- ) extended-opcode swapd (2-operand) ; diff --git a/basis/cpu/x86/intrinsics/intrinsics.factor b/basis/cpu/x86/intrinsics/intrinsics.factor index a42e5a2bc2..e5f13f4a9d 100644 --- a/basis/cpu/x86/intrinsics/intrinsics.factor +++ b/basis/cpu/x86/intrinsics/intrinsics.factor @@ -214,29 +214,26 @@ IN: cpu.x86.intrinsics ! allocator about the different sized registers, with all ! the complexity this entails, we just push/pop a register ! which is guaranteed to be unused (the tempreg) -: small-reg cell 8 = RAX EAX ? ; inline -: small-reg-8 AL ; inline -: small-reg-16 AX ; inline -: small-reg-32 EAX ; inline +: small-reg cell 8 = RDX EDX ? ; inline +: small-reg-8 DL ; inline +: small-reg-16 DX ; inline +: small-reg-32 EDX ; inline : %prepare-alien-accessor ( -- ) "offset" operand %untag-fixnum "offset" operand "alien" operand ADD ; -: (%alien-accessor) ( quot -- ) - "offset" operand [] swap call ; inline - -: %alien-accessor ( quot -- ) - %prepare-alien-accessor (%alien-accessor) ; inline +:: (%alien-integer-get) ( reg quot -- ) + reg "offset" operand [] MOV + "value" operand reg quot call ; inline : %alien-integer-get ( reg quot -- ) %prepare-alien-accessor "value" operand small-reg = [ - (%alien-accessor) + (%alien-integer-get) ] [ small-reg PUSH - (%alien-accessor) - "value" operand small-reg MOV + (%alien-integer-get) small-reg POP ] if "value" operand %tag-fixnum ; inline @@ -258,20 +255,23 @@ IN: cpu.x86.intrinsics define-intrinsic ; : define-unsigned-getter ( word reg -- ) - [ small-reg dup XOR MOV ] define-getter ; + [ MOVZX ] define-getter ; : define-signed-getter ( word reg -- ) - dup '[ MOV small-reg _ MOVSX ] define-getter ; + [ MOVSX ] define-getter ; -: %alien-integer-set ( reg quot -- ) - "value" operand %untag-fixnum +: %alien-integer-set ( reg -- ) + "value" operand "offset" operand = [ + "value" operand %untag-fixnum + ] unless %prepare-alien-accessor - small-reg "value" operand = [ - (%alien-accessor) + small-reg "offset" operand = [ + "value" operand "offset" operand XCHG + "value" operand [] swap MOV ] [ small-reg PUSH small-reg "value" operand MOV - (%alien-accessor) + "offset" operand [] swap MOV small-reg POP ] if ; inline @@ -286,7 +286,7 @@ IN: cpu.x86.intrinsics } ; : define-setter ( word reg -- ) - '[ _ [ swap MOV ] %alien-integer-set ] + '[ _ %alien-integer-set ] alien-integer-set-template define-intrinsic ; @@ -303,7 +303,8 @@ IN: cpu.x86.intrinsics \ set-alien-signed-2 small-reg-16 define-setter \ alien-cell [ - "value" operand [ MOV ] %alien-accessor + %prepare-alien-accessor + "value" operand "offset" operand [] MOV ] T{ template { input { { unboxed-c-ptr "alien" c-ptr } @@ -315,7 +316,8 @@ IN: cpu.x86.intrinsics } define-intrinsic \ set-alien-cell [ - "value" operand [ swap MOV ] %alien-accessor + %prepare-alien-accessor + "offset" operand [] "value" operand MOV ] T{ template { input { { unboxed-c-ptr "value" pinned-c-ptr } diff --git a/basis/cpu/x86/sse2/sse2.factor b/basis/cpu/x86/sse2/sse2.factor index 856cf3c519..9650a4ce11 100644 --- a/basis/cpu/x86/sse2/sse2.factor +++ b/basis/cpu/x86/sse2/sse2.factor @@ -86,22 +86,24 @@ M: x86 %unbox-float ( dst src -- ) { clobber { "offset" } } } ; -: define-alien-float-intrinsics ( word get-quot word set-quot -- ) - '[ "value" operand _ %alien-accessor ] - alien-float-set-template - define-intrinsic - '[ "value" operand _ %alien-accessor ] +: define-float-getter ( word get-quot -- ) + '[ + %prepare-alien-accessor + "value" operand "offset" operand [] @ + ] alien-float-get-template define-intrinsic ; -\ alien-double -[ MOVSD ] -\ set-alien-double -[ swap MOVSD ] -define-alien-float-intrinsics +: define-float-setter ( word set-quot -- ) + '[ + %prepare-alien-accessor + "offset" operand [] "value" operand @ + ] + alien-float-set-template + define-intrinsic ; -\ alien-float -[ dupd MOVSS dup CVTSS2SD ] -\ set-alien-float -[ swap dup dup CVTSD2SS MOVSS ] -define-alien-float-intrinsics +\ alien-double [ MOVSD ] define-float-getter +\ set-alien-double [ MOVSD ] define-float-setter + +\ alien-float [ dupd MOVSS dup CVTSS2SD ] define-float-getter +\ set-alien-float [ dup dup CVTSD2SS MOVSS ] define-float-setter