From b841dcc15947b8a3ad065556830c48630335a148 Mon Sep 17 00:00:00 2001 From: "U-SLAVA-FB3999113\\Slava" Date: Thu, 18 Oct 2007 02:37:52 -0400 Subject: [PATCH] Further progress on the ARM backend --- core/cpu/arm/allot/allot.factor | 10 +- core/cpu/arm/architecture/architecture.factor | 100 ++++++++++-------- core/cpu/arm/arm.factor | 12 ++- core/cpu/arm/assembler/assembler.factor | 2 +- core/cpu/arm/bootstrap.factor | 11 +- core/cpu/arm/intrinsics/intrinsics.factor | 12 +-- 6 files changed, 79 insertions(+), 68 deletions(-) diff --git a/core/cpu/arm/allot/allot.factor b/core/cpu/arm/allot/allot.factor index c70c1090c2..440aeca2a3 100755 --- a/core/cpu/arm/allot/allot.factor +++ b/core/cpu/arm/allot/allot.factor @@ -22,7 +22,7 @@ IN: cpu.arm.allot ; : %store-tagged ( reg tag -- ) - >r dup fresh-object v>operand R11 r> tag-number ORI ; + >r dup fresh-object v>operand R11 r> tag-number ORR ; : %allot-bignum ( #digits -- ) #! 1 cell header, 1 cell length, 1 cell sign, + digits @@ -32,10 +32,10 @@ IN: cpu.arm.allot R12 R11 cell <+> STR ! store the length ; -: %allot-bignum-signed-1 ( reg -- ) +: %allot-bignum-signed-1 ( dst src -- ) #! on entry, reg is a 30-bit quantity sign-extended to #! 32-bits. - #! exits with tagged ptr to bignum in allot-tmp. + #! exits with tagged ptr to bignum in reg. [ "end" define-label ! is it zero? @@ -55,9 +55,9 @@ IN: cpu.arm.allot ! store sign R12 R11 2 cells <+> STR ! store the number - dup v>operand R11 3 cells <+> STR + v>operand R11 3 cells <+> STR ! tag the bignum, store it in reg - bignum %tag-allot + bignum %store-tagged "end" resolve-label ] with-scope ; diff --git a/core/cpu/arm/architecture/architecture.factor b/core/cpu/arm/architecture/architecture.factor index 7e077b4a22..4545ad2e93 100755 --- a/core/cpu/arm/architecture/architecture.factor +++ b/core/cpu/arm/architecture/architecture.factor @@ -52,19 +52,19 @@ M: immediate load-literal M: arm-backend stack-frame ( n -- i ) factor-area-size + 8 align ; -M: ppc-backend %save-xt ( -- ) +M: arm-backend %save-xt ( -- ) R12 PC 8 SUB ; M: arm-backend %prologue ( n -- ) SP SP pick SUB - R11 over LI + R11 over MOV R11 SP pick next-save <+> STR - R12 SP rot xt-save <+> STR - LR SP pick lr-save <+> STR ; + R12 SP pick xt-save <+> STR + LR SP rot lr-save <+> STR ; M: arm-backend %epilogue ( n -- ) - LR SP lr-save <+> LDR - SP SP rot stack-frame ADD ; + LR SP pick lr-save <+> LDR + SP SP rot ADD ; : compile-dlsym ( symbol dll reg -- ) [ @@ -99,9 +99,6 @@ M: arm-backend %call-label ( label -- ) BL ; M: arm-backend %jump-label ( label -- ) B ; -: %load-xt ( word -- ) - 0 swap LOAD32 rc-absolute-ppc-2/2 rel-word ; - : %prepare-primitive ( word -- ) #! Save stack pointer to stack_chain->callstack_top, load XT R1 SP MOV @@ -145,11 +142,9 @@ M: arm-backend %return ( -- ) %epilogue-later PC LR MOV ; M: arm-backend %unwind drop %return ; -: (%peek/replace) - >r drop >r v>operand r> loc>operand r> execute ; +M: arm-backend %peek >r v>operand r> loc>operand LDR ; -M: int-regs (%peek) \ LDR (%peek/replace) ; -M: int-regs (%replace) \ STR (%peek/replace) ; +M: arm-backend %replace >r v>operand r> loc>operand STR ; : (%inc) ( n reg -- ) dup rot cells dup 0 < [ neg SUB ] [ ADD ] if ; @@ -255,14 +250,14 @@ M: arm-backend %box-large-struct ( n size -- ) M: arm-backend struct-small-enough? ( size -- ? ) wince? [ drop f ] [ 4 <= ] if ; -M: ppc-backend %prepare-alien-invoke +M: arm-backend %prepare-alien-invoke #! Save Factor stack pointers in case the C code calls a #! callback which does a GC, which must reliably trace #! all roots. "stack_chain" f R12 %alien-global SP R12 0 <+> STR - ds-reg 11 8 <+> STR - rs-reg 11 12 <+> STR ; + ds-reg R12 8 <+> STR + rs-reg R12 12 <+> STR ; M: arm-backend %alien-invoke ( symbol dll -- ) ! Load target address @@ -314,37 +309,50 @@ M: long-long-type c-type-stack-align? drop wince? not ; M: arm-backend fp-shadows-int? ( -- ? ) f ; ! Alien intrinsics -: add-alien-offset "offset" operand tag-bits get ADD ; +M: arm-backend %unbox-byte-array ( dst src -- ) + [ v>operand ] 2apply byte-array-offset ADD ; -: (%unbox-alien) <+> roll call ; inline +M: arm-backend %unbox-alien ( dst src -- ) + [ v>operand ] 2apply alien-offset <+> LDR ; -M: arm-backend %unbox-byte-array ( quot src -- ) - "address" operand "alien" operand add-alien-offset - "address" operand alien-offset (%unbox-alien) ; +M: arm-backend %unbox-f ( dst src -- ) + drop v>operand 0 MOV ; -M: arm-backend %unbox-alien ( quot src -- ) - "address" operand "alien" operand alien-offset <+> LDR - "address" operand dup add-alien-offset - "address" operand 0 (%unbox-alien) ; - -M: arm-backend %unbox-f ( quot src -- ) - "offset" operand dup %untag-fixnum - "offset" operand 0 (%unbox-alien) ; - -M: arm-backend %complex-alien-accessor ( quot src -- ) - "is-f" define-label - "is-alien" define-label +M: arm-backend %unbox-any-c-ptr ( dst src -- ) + #! We need three registers here. R11 and R12 are reserved + #! temporary registers. The third one is R14, which we have + #! to save/restore. "end" define-label - "alien" operand f v>operand CMP - "is-f" get EQ B - "address" operand "alien" operand header-offset neg <-> LDR - "address" operand alien type-number tag-header CMP - "is-alien" get EQ B - [ %unbox-byte-array ] 2keep - "end" get B - "is-alien" resolve-label - [ %unbox-alien ] 2keep - "end" get B - "is-f" resolve-label - %unbox-f - "end" resolve-label ; + "start" define-label + ! Save R14. + R14 SP 4 <-> STR + ! Address is computed in RR11 + R11 0 MOV + ! Load object into R12 + R12 swap v>operand MOV + ! We come back here with displaced aliens + "start" resolve-label + ! Is the object f? + R12 f v>operand CMP + ! If so, done + "end" get EQ B + ! Is the object an alien? + R14 R12 header-offset <+> LDR + R14 alien type-number tag-header CMP + ! Add byte array address to address being computed + R11 R11 R12 NE ADD + ! Add an offset to start of byte array's data area + R11 R11 byte-array-offset NE ADD + "end" get NE B + ! If alien, load the offset + R14 R12 alien-offset LDR + ! Add it to address being computed + R11 R11 R14 ADD + ! Now recurse on the underlying alien + R12 R12 underlying-alien-offset LDR + "start" get B + "end" resolve-label + ! Done, store address in destination register + v>operand R11 MOV + ! Restore R14. + R14 SP 4 <-> LDR ; diff --git a/core/cpu/arm/arm.factor b/core/cpu/arm/arm.factor index afe6411d97..e2814b772f 100755 --- a/core/cpu/arm/arm.factor +++ b/core/cpu/arm/arm.factor @@ -1,7 +1,9 @@ +! Copyright (C) 2007 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types kernel math namespaces -cpu.architecture cpu.arm.architecture cpu.arm.intrinsics -generator generator.registers continuations compiler io -vocabs.loader ; +cpu.architecture cpu.arm.architecture cpu.arm.assembler +cpu.arm.intrinsics generator generator.registers continuations +compiler io vocabs.loader sequences ; ! EABI passes floats in integer registers. [ alien-float ] @@ -34,9 +36,9 @@ T{ arm-backend } compiler-backend set-global "==========" print "You should specify the -arm-variant= switch." print " can be one of arm3, arm4, arm4t, or arm5." print - "Assuming arm4t." print + "Assuming arm3." print "==========" print - "arm4t" "arm-variant" set + "arm3" "arm-variant" set-global ] if "arm-variant" get { "arm4" "arm4t" "arm5" } member? [ diff --git a/core/cpu/arm/assembler/assembler.factor b/core/cpu/arm/assembler/assembler.factor index e61e02ae8d..d10b24de4e 100755 --- a/core/cpu/arm/assembler/assembler.factor +++ b/core/cpu/arm/assembler/assembler.factor @@ -276,7 +276,7 @@ M: label (BX) 0 swap (BX) rc-relative-arm-3 label-fixup ; : BX have-BX? get [ 0 (BX) ] [ PC swap MOV ] if ; -: BLX have-BLX? get [ 1 (BLX) ] [ LR PC MOV BX ] if ; +: BLX have-BLX? get [ 1 (BX) ] [ LR PC MOV BX ] if ; ! More load and store instructions GENERIC: addressing-mode-3 ( addressing-mode -- n ) diff --git a/core/cpu/arm/bootstrap.factor b/core/cpu/arm/bootstrap.factor index 4f67255305..8ab94cade4 100755 --- a/core/cpu/arm/bootstrap.factor +++ b/core/cpu/arm/bootstrap.factor @@ -1,10 +1,11 @@ ! Copyright (C) 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: bootstrap.image.private kernel namespaces system -cpu.arm.assembler cpu.arm5.assembler math layouts words vocabs ; +cpu.arm.assembler math layouts words vocabs ; IN: bootstrap.arm -T{ arm5-variant } arm-variant set-global +! We generate ARM3 code +f have-BX? set 4 \ cell set big-endian off @@ -66,12 +67,12 @@ big-endian off : jit-call scan-reg SP scan-save <+> STR ! save scan pointer LR PC MOV ! save return address - PC xt-reg MOV ! call + xt-reg BX ! call scan-reg SP scan-save <+> LDR ! restore scan pointer ; : jit-jump - PC xt-reg MOV ; + xt-reg BX ; [ load-word-xt jit-call ] { } make jit-word-call set @@ -113,6 +114,6 @@ big-endian off LR SP 4 <-> LDR ! load return address ] { } make jit-epilog set -[ PC LR MOV ] { } make jit-return set +[ LR BX ] { } make jit-return set "bootstrap.arm" forget-vocab diff --git a/core/cpu/arm/intrinsics/intrinsics.factor b/core/cpu/arm/intrinsics/intrinsics.factor index 18cfb7d3de..bc2e966906 100755 --- a/core/cpu/arm/intrinsics/intrinsics.factor +++ b/core/cpu/arm/intrinsics/intrinsics.factor @@ -16,11 +16,11 @@ IN: cpu.arm.intrinsics "obj" get operand-tag - <+/-> ; : %slot-literal-any-tag - "obj" operand "scratch" operand %untag + "scratch" operand "obj" operand %untag "val" operand "scratch" operand "n" get cells <+> ; : %slot-any - "obj" operand "scratch" operand %untag + "scratch" operand "obj" operand %untag "n" operand dup 1 MOV "scratch" operand "val" operand "n" operand <+> ; @@ -52,8 +52,8 @@ IN: cpu.arm.intrinsics } } define-intrinsics -: generate-write-barrier ( -- ) - "val" operand-immediate? "obj" get fresh-object? or [ +: %write-barrier ( -- ) + "val" get operand-immediate? "obj" get fresh-object? or [ "cards_offset" f R12 %alien-global "scratch" operand R12 "scratch" operand card-bits ADD "val" operand "scratch" operand 0 LDRB @@ -156,7 +156,7 @@ IN: cpu.arm.intrinsics "end" get VC B { "x" "y" } %untag-fixnums "x" operand "x" operand "y" operand roll execute - "x" get %allot-bignum-signed-1 + "out" get "x" get %allot-bignum-signed-1 "end" resolve-label ] with-scope ; inline @@ -173,7 +173,7 @@ IN: cpu.arm.intrinsics \ fixnum>bignum [ "x" operand dup %untag-fixnum - "x" get %allot-bignum-signed-1 + "out" get "x" get %allot-bignum-signed-1 ] H{ { +input+ { { f "x" } } } { +scratch+ { { f "out" } } }