steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Further progress on the ARM backend

release
U-SLAVA-FB3999113\Slava 2007-10-18 02:37:52 -04:00
parent bf82687051
commit b841dcc159
6 changed files with 79 additions and 68 deletions

10
core/cpu/arm/allot/allot.factor
View File

@ -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 ;

100
core/cpu/arm/architecture/architecture.factor
View File

@ -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 <ASR> 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 ;

12
core/cpu/arm/arm.factor
View File

@ -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=<variant> switch." print
"<variant> 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? [

2
core/cpu/arm/assembler/assembler.factor
View File

@ -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 )

11
core/cpu/arm/bootstrap.factor
View File

@ -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

12
core/cpu/arm/intrinsics/intrinsics.factor
View File

@ -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 <LSR> 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 <LSR> 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" } } }