From f2c6f8de5bfb8369714b67fde739aa067747cc0c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 13 Oct 2008 16:43:58 -0500 Subject: [PATCH] Using fry in cpu.x86, working on alien intrinsics --- basis/cpu/x86/allot/allot.factor | 4 +- .../cpu/x86/architecture/architecture.factor | 1 - basis/cpu/x86/assembler/syntax/syntax.factor | 4 +- basis/cpu/x86/intrinsics/intrinsics.factor | 78 +++++++++++-------- basis/cpu/x86/sse2/sse2.factor | 6 +- 5 files changed, 53 insertions(+), 40 deletions(-) diff --git a/basis/cpu/x86/allot/allot.factor b/basis/cpu/x86/allot/allot.factor index 13d81e0d89..a1180755db 100644 --- a/basis/cpu/x86/allot/allot.factor +++ b/basis/cpu/x86/allot/allot.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel words kernel.private namespaces math math.private -sequences generic arrays system layouts alien locals +sequences generic arrays system layouts alien locals fry cpu.architecture cpu.x86.assembler cpu.x86.architecture compiler.constants compiler.cfg.templates compiler.cfg.builder compiler.codegen compiler.codegen.fixup ; @@ -118,7 +118,7 @@ M:: x86 %box-alien ( dst src temp -- ) "end" resolve-label ; inline : overflow-template ( word insn -- ) - [ overflow-check ] curry T{ template + '[ _ overflow-check ] T{ template { input { { f "x" } { f "y" } } } { scratch { { f "z" } } } { output { "z" } } diff --git a/basis/cpu/x86/architecture/architecture.factor b/basis/cpu/x86/architecture/architecture.factor index d4b5efd378..83876d72f8 100644 --- a/basis/cpu/x86/architecture/architecture.factor +++ b/basis/cpu/x86/architecture/architecture.factor @@ -49,7 +49,6 @@ HOOK: temp-reg-1 cpu ( -- reg ) HOOK: temp-reg-2 cpu ( -- reg ) HOOK: fixnum>slot@ cpu ( op -- ) - HOOK: prepare-division cpu ( -- ) M: f load-literal diff --git a/basis/cpu/x86/assembler/syntax/syntax.factor b/basis/cpu/x86/assembler/syntax/syntax.factor index 5940663d42..d267baaf4f 100644 --- a/basis/cpu/x86/assembler/syntax/syntax.factor +++ b/basis/cpu/x86/assembler/syntax/syntax.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel words sequences lexer parser ; +USING: kernel words sequences lexer parser fry ; IN: cpu.x86.assembler.syntax : define-register ( name num size -- ) @@ -9,7 +9,7 @@ IN: cpu.x86.assembler.syntax "register-size" set-word-prop ; : define-registers ( names size -- ) - >r dup length r> [ define-register ] curry 2each ; + '[ _ define-register ] each-index ; : REGISTERS: ( -- ) scan-word ";" parse-tokens swap define-registers ; parsing diff --git a/basis/cpu/x86/intrinsics/intrinsics.factor b/basis/cpu/x86/intrinsics/intrinsics.factor index b7a5b6063b..a42e5a2bc2 100644 --- a/basis/cpu/x86/intrinsics/intrinsics.factor +++ b/basis/cpu/x86/intrinsics/intrinsics.factor @@ -3,7 +3,7 @@ USING: accessors arrays byte-arrays alien.accessors kernel kernel.private math memory namespaces make sequences words system layouts combinators math.order math.private alien -alien.c-types slots.private locals cpu.architecture +alien.c-types slots.private locals fry cpu.architecture cpu.x86.assembler cpu.x86.assembler.private cpu.x86.architecture compiler.codegen.fixup compiler.constants compiler.intrinsics compiler.cfg.builder compiler.cfg.registers compiler.cfg.stacks @@ -51,7 +51,6 @@ IN: cpu.x86.intrinsics { [ %constant-slot "val" operand MOV ] T{ template { input { { f "val" } { f "obj" } { small-slot "n" } { small-slot "tag" } } } - { clobber { "obj" } } } } { @@ -62,16 +61,6 @@ IN: cpu.x86.intrinsics } } define-intrinsics -! Sometimes, we need to do stuff with operands which are -! less than the word size. Instead of teaching the register -! allocator about the different sized registers, with all -! the complexity this entails, we just push/pop a register -! which is guaranteed to be unused (the tempreg) -: small-reg cell 8 = RBX EBX ? ; inline -: small-reg-8 BL ; inline -: small-reg-16 BX ; inline -: small-reg-32 EBX ; inline - ! Fixnums : fixnum-op ( op hash -- pair ) >r [ "x" operand "y" operand ] swap suffix r> 2array ; @@ -219,17 +208,38 @@ IN: cpu.x86.intrinsics } define-intrinsic ! Alien intrinsics -: %alien-accessor ( quot -- ) + +! Sometimes, we need to do stuff with operands which are +! less than the word size. Instead of teaching the register +! allocator about the different sized registers, with all +! the complexity this entails, we just push/pop a register +! which is guaranteed to be unused (the tempreg) +: small-reg cell 8 = RAX EAX ? ; inline +: small-reg-8 AL ; inline +: small-reg-16 AX ; inline +: small-reg-32 EAX ; inline + +: %prepare-alien-accessor ( -- ) "offset" operand %untag-fixnum - "offset" operand "alien" operand ADD + "offset" operand "alien" operand ADD ; + +: (%alien-accessor) ( quot -- ) "offset" operand [] swap call ; inline -: %alien-integer-get ( quot reg -- ) - small-reg PUSH - swap %alien-accessor - "value" operand small-reg MOV - "value" operand %tag-fixnum - small-reg POP ; inline +: %alien-accessor ( quot -- ) + %prepare-alien-accessor (%alien-accessor) ; inline + +: %alien-integer-get ( reg quot -- ) + %prepare-alien-accessor + "value" operand small-reg = [ + (%alien-accessor) + ] [ + small-reg PUSH + (%alien-accessor) + "value" operand small-reg MOV + small-reg POP + ] if + "value" operand %tag-fixnum ; inline : alien-integer-get-template T{ template @@ -242,23 +252,28 @@ IN: cpu.x86.intrinsics { clobber { "offset" } } } ; -: define-getter ( word quot reg -- ) - [ %alien-integer-get ] 2curry +: define-getter ( word reg quot -- ) + '[ _ _ %alien-integer-get ] alien-integer-get-template define-intrinsic ; : define-unsigned-getter ( word reg -- ) - [ small-reg dup XOR MOV ] swap define-getter ; + [ small-reg dup XOR MOV ] define-getter ; : define-signed-getter ( word reg -- ) - [ [ >r MOV small-reg r> MOVSX ] curry ] keep define-getter ; + dup '[ MOV small-reg _ MOVSX ] define-getter ; -: %alien-integer-set ( quot reg -- ) - small-reg PUSH - small-reg "value" operand MOV - small-reg %untag-fixnum - swap %alien-accessor - small-reg POP ; inline +: %alien-integer-set ( reg quot -- ) + "value" operand %untag-fixnum + %prepare-alien-accessor + small-reg "value" operand = [ + (%alien-accessor) + ] [ + small-reg PUSH + small-reg "value" operand MOV + (%alien-accessor) + small-reg POP + ] if ; inline : alien-integer-set-template T{ template @@ -271,8 +286,7 @@ IN: cpu.x86.intrinsics } ; : define-setter ( word reg -- ) - [ swap MOV ] swap - [ %alien-integer-set ] 2curry + '[ _ [ swap MOV ] %alien-integer-set ] alien-integer-set-template define-intrinsic ; diff --git a/basis/cpu/x86/sse2/sse2.factor b/basis/cpu/x86/sse2/sse2.factor index e7ab902e07..856cf3c519 100644 --- a/basis/cpu/x86/sse2/sse2.factor +++ b/basis/cpu/x86/sse2/sse2.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.accessors arrays generic kernel kernel.private math math.private memory namespaces sequences -words math.floats.private layouts quotations locals +words math.floats.private layouts quotations locals fry system compiler.constants compiler.codegen compiler.cfg.templates compiler.cfg.registers compiler.cfg.builder cpu.architecture cpu.x86.assembler cpu.x86.architecture cpu.x86.intrinsics ; @@ -87,10 +87,10 @@ M: x86 %unbox-float ( dst src -- ) } ; : define-alien-float-intrinsics ( word get-quot word set-quot -- ) - [ "value" operand swap %alien-accessor ] curry + '[ "value" operand _ %alien-accessor ] alien-float-set-template define-intrinsic - [ "value" operand swap %alien-accessor ] curry + '[ "value" operand _ %alien-accessor ] alien-float-get-template define-intrinsic ;