From 5fc3ad92f6872f01b8eb66366c33189fc848d25a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 2 Oct 2009 20:18:34 -0500 Subject: [PATCH] cpu.arm.assembler: dust it off, update to work with contemporary Factor, and clean it up a bit --- .../cpu}/arm/assembler/assembler-tests.factor | 7 +- .../cpu}/arm/assembler/assembler.factor | 271 ++++++++++-------- .../cpu}/arm/assembler/authors.txt | 0 3 files changed, 158 insertions(+), 120 deletions(-) rename {unmaintained => basis/cpu}/arm/assembler/assembler-tests.factor (89%) rename {unmaintained => basis/cpu}/arm/assembler/assembler.factor (53%) rename {unmaintained => basis/cpu}/arm/assembler/authors.txt (100%) diff --git a/unmaintained/arm/assembler/assembler-tests.factor b/basis/cpu/arm/assembler/assembler-tests.factor similarity index 89% rename from unmaintained/arm/assembler/assembler-tests.factor rename to basis/cpu/arm/assembler/assembler-tests.factor index a30ab9f797..3164fc197a 100644 --- a/unmaintained/arm/assembler/assembler-tests.factor +++ b/basis/cpu/arm/assembler/assembler-tests.factor @@ -1,8 +1,9 @@ IN: cpu.arm.assembler.tests -USING: assembler-arm math test namespaces sequences kernel -quotations ; +USING: cpu.arm.assembler math tools.test namespaces make +sequences kernel quotations ; +FROM: cpu.arm.assembler => B ; -: test-opcode [ { } make first ] curry unit-test ; +: test-opcode ( expect quot -- ) [ { } make first ] curry unit-test ; [ HEX: ea000000 ] [ 0 B ] test-opcode [ HEX: eb000000 ] [ 0 BL ] test-opcode diff --git a/unmaintained/arm/assembler/assembler.factor b/basis/cpu/arm/assembler/assembler.factor similarity index 53% rename from unmaintained/arm/assembler/assembler.factor rename to basis/cpu/arm/assembler/assembler.factor index 5a69f93d85..38e385020f 100755 --- a/unmaintained/arm/assembler/assembler.factor +++ b/basis/cpu/arm/assembler/assembler.factor @@ -1,31 +1,46 @@ -! Copyright (C) 2007 Slava Pestov. +! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays generator generator.fixup kernel sequences words -namespaces math math.bitfields ; +USING: accessors arrays combinators kernel make math math.bitwise +namespaces sequences words words.symbol parser ; IN: cpu.arm.assembler -: define-registers ( seq -- ) - dup length [ "register" set-word-prop ] 2each ; +! Registers +<< -SYMBOL: R0 -SYMBOL: R1 -SYMBOL: R2 -SYMBOL: R3 -SYMBOL: R4 -SYMBOL: R5 -SYMBOL: R6 -SYMBOL: R7 -SYMBOL: R8 -SYMBOL: R9 -SYMBOL: R10 -SYMBOL: R11 -SYMBOL: R12 -SYMBOL: R13 -SYMBOL: R14 -SYMBOL: R15 +SYMBOL: registers -{ R0 R1 R2 R3 R4 R5 R6 R7 R8 R9 R10 R11 R12 R13 R14 R15 } -define-registers +V{ } registers set-global + +SYNTAX: REGISTER: + CREATE-WORD + [ define-symbol ] + [ registers get length "register" set-word-prop ] + [ registers get push ] + tri ; + +>> + +REGISTER: R0 +REGISTER: R1 +REGISTER: R2 +REGISTER: R3 +REGISTER: R4 +REGISTER: R5 +REGISTER: R6 +REGISTER: R7 +REGISTER: R8 +REGISTER: R9 +REGISTER: R10 +REGISTER: R11 +REGISTER: R12 +REGISTER: R13 +REGISTER: R14 +REGISTER: R15 + +ALIAS: SL R10 ALIAS: FP R11 ALIAS: IP R12 +ALIAS: SP R13 ALIAS: LR R14 ALIAS: PC R15 + +boolean ; @@ -33,8 +48,7 @@ GENERIC: register ( register -- n ) M: word register "register" word-prop ; M: f register drop 0 ; -: SL R10 ; inline : FP R11 ; inline : IP R12 ; inline -: SP R13 ; inline : LR R14 ; inline : PC R15 ; inline +PRIVATE> ! Condition codes SYMBOL: cond-code @@ -46,43 +60,52 @@ SYMBOL: cond-code #! Default value is BIN: 1110 AL (= always) cond-code [ f ] change BIN: 1110 or ; -: EQ BIN: 0000 >CC ; -: NE BIN: 0001 >CC ; -: CS BIN: 0010 >CC ; -: CC BIN: 0011 >CC ; -: LO BIN: 0100 >CC ; -: PL BIN: 0101 >CC ; -: VS BIN: 0110 >CC ; -: VC BIN: 0111 >CC ; -: HI BIN: 1000 >CC ; -: LS BIN: 1001 >CC ; -: GE BIN: 1010 >CC ; -: LT BIN: 1011 >CC ; -: GT BIN: 1100 >CC ; -: LE BIN: 1101 >CC ; -: AL BIN: 1110 >CC ; -: NV BIN: 1111 >CC ; +: EQ ( -- ) BIN: 0000 >CC ; +: NE ( -- ) BIN: 0001 >CC ; +: CS ( -- ) BIN: 0010 >CC ; +: CC ( -- ) BIN: 0011 >CC ; +: LO ( -- ) BIN: 0100 >CC ; +: PL ( -- ) BIN: 0101 >CC ; +: VS ( -- ) BIN: 0110 >CC ; +: VC ( -- ) BIN: 0111 >CC ; +: HI ( -- ) BIN: 1000 >CC ; +: LS ( -- ) BIN: 1001 >CC ; +: GE ( -- ) BIN: 1010 >CC ; +: LT ( -- ) BIN: 1011 >CC ; +: GT ( -- ) BIN: 1100 >CC ; +: LE ( -- ) BIN: 1101 >CC ; +: AL ( -- ) BIN: 1110 >CC ; +: NV ( -- ) BIN: 1111 >CC ; + + 28 shift bitor , ; : insn ( bitspec -- ) bitfield (insn) ; inline ! Branching instructions -GENERIC# (B) 1 ( signed-imm-24 l -- ) +GENERIC# (B) 1 ( target l -- ) M: integer (B) { 24 { 1 25 } { 0 26 } { 1 27 } 0 } insn ; -M: word (B) 0 swap (B) rc-relative-arm-3 rel-word ; -M: label (B) 0 swap (B) rc-relative-arm-3 label-fixup ; -: B 0 (B) ; : BL 1 (B) ; +PRIVATE> + +: B ( target -- ) 0 (B) ; +: BL ( target -- ) 1 (B) ; ! Data processing instructions + + : S ( -- ) updates-cond-code on ; : S> ( -- ? ) updates-cond-code [ f ] change ; + [ 20 2^ bitor ] when (insn) ; inline @@ -100,21 +123,25 @@ M: register shift-imm/reg ( Rs Rm shift -- n ) { register 0 } } bitfield ; -GENERIC: shifter-op ( shifter-op -- n ) +PRIVATE> TUPLE: IMM immed rotate ; C: IMM -M: IMM shifter-op - dup IMM-immed swap IMM-rotate - { { 1 25 } 8 0 } bitfield ; - TUPLE: shifter Rm by shift ; C: shifter +> ] [ rotate>> ] bi { { 1 25 } 8 0 } bitfield ; + M: shifter shifter-op - dup shifter-by over shifter-Rm rot shifter-shift - shift-imm/reg ; + [ by>> ] [ Rm>> ] [ shift>> ] tri shift-imm/reg ; + +PRIVATE> : ( Rm shift-imm/Rs -- shifter-op ) BIN: 00 ; : ( Rm shift-imm/Rs -- shifter-op ) BIN: 01 ; @@ -123,9 +150,10 @@ M: shifter shifter-op : ( Rm -- shifter-op ) 0 ; M: register shifter-op 0 shifter-op ; - M: integer shifter-op 0 shifter-op ; + shifter-op ; { register 12 } ! Rd } sinsn ; -: AND BIN: 0000 addr1 ; -: EOR BIN: 0001 addr1 ; -: SUB BIN: 0010 addr1 ; -: RSB BIN: 0011 addr1 ; -: ADD BIN: 0100 addr1 ; -: ADC BIN: 0101 addr1 ; -: SBC BIN: 0110 addr1 ; -: RSC BIN: 0111 addr1 ; -: ORR BIN: 1100 addr1 ; -: BIC BIN: 1110 addr1 ; +PRIVATE> -: MOV f swap BIN: 1101 addr1 ; -: MVN f swap BIN: 1111 addr1 ; +: AND ( Rd Rn shifter-op -- ) BIN: 0000 addr1 ; +: EOR ( Rd Rn shifter-op -- ) BIN: 0001 addr1 ; +: SUB ( Rd Rn shifter-op -- ) BIN: 0010 addr1 ; +: RSB ( Rd Rn shifter-op -- ) BIN: 0011 addr1 ; +: ADD ( Rd Rn shifter-op -- ) BIN: 0100 addr1 ; +: ADC ( Rd Rn shifter-op -- ) BIN: 0101 addr1 ; +: SBC ( Rd Rn shifter-op -- ) BIN: 0110 addr1 ; +: RSC ( Rd Rn shifter-op -- ) BIN: 0111 addr1 ; +: ORR ( Rd Rn shifter-op -- ) BIN: 1100 addr1 ; +: BIC ( Rd Rn shifter-op -- ) BIN: 1110 addr1 ; + +: MOV ( Rd shifter-op -- ) [ f ] dip BIN: 1101 addr1 ; +: MVN ( Rd shifter-op -- ) [ f ] dip BIN: 1111 addr1 ; ! These always update the condition code flags -: (CMP) >r f -rot r> S addr1 ; + + +: TST ( Rn shifter-op -- ) BIN: 1000 (CMP) ; +: TEQ ( Rn shifter-op -- ) BIN: 1001 (CMP) ; +: CMP ( Rn shifter-op -- ) BIN: 1010 (CMP) ; +: CMN ( Rn shifter-op -- ) BIN: 1011 (CMP) ; ! Multiply instructions -: (MLA) ( Rd Rm Rs Rn a -- ) + shifter-op ; { 1 4 } } sinsn ; -: MUL ( Rd Rm Rs -- ) f 0 (MLA) ; -: MLA ( Rd Rm Rs Rn -- ) 1 (MLA) ; - : (S/UMLAL) ( RdLo RdHi Rm Rs s a -- ) { { 1 23 } @@ -184,8 +217,15 @@ M: integer shifter-op 0 shifter-op ; { 1 4 } } sinsn ; -: SMLAL 1 1 (S/UMLAL) ; : SMULL 1 0 (S/UMLAL) ; -: UMLAL 0 1 (S/UMLAL) ; : UMULL 0 0 (S/UMLAL) ; +PRIVATE> + +: MUL ( Rd Rm Rs -- ) f 0 (MLA) ; +: MLA ( Rd Rm Rs Rn -- ) 1 (MLA) ; + +: SMLAL ( RdLo RdHi Rm Rs -- ) 1 1 (S/UMLAL) ; +: SMULL ( RdLo RdHi Rm Rs -- ) 1 0 (S/UMLAL) ; +: UMLAL ( RdLo RdHi Rm Rs -- ) 0 1 (S/UMLAL) ; +: UMULL ( RdLo RdHi Rm Rs -- ) 0 0 (S/UMLAL) ; ! Miscellaneous arithmetic instructions : CLZ ( Rd Rm -- ) @@ -203,39 +243,21 @@ M: integer shifter-op 0 shifter-op ; ! Status register acess instructions ! Load and store instructions + ( delegate p u w -- addressing ) - { - set-delegate - set-addressing-p - set-addressing-u - set-addressing-w - } addressing construct ; +TUPLE: addressing base p u w ; +C: addressing M: addressing addressing-mode-2 - { - addressing-p addressing-u addressing-w delegate - } get-slots addressing-mode-2 + { [ p>> ] [ u>> ] [ w>> ] [ base>> addressing-mode-2 ] } cleave { 0 21 23 24 } bitfield ; M: integer addressing-mode-2 ; M: object addressing-mode-2 shifter-op { { 1 25 } 0 } bitfield ; -! Offset -: <+> 1 1 0 ; -: <-> 1 0 0 ; - -! Pre-indexed -: 1 1 1 ; -: 1 0 1 ; - -! Post-indexed -: <+!> 0 1 0 ; -: <-!> 0 0 0 ; - : addr2 ( Rd Rn addressing-mode b l -- ) { { 1 26 } @@ -246,16 +268,32 @@ M: object addressing-mode-2 shifter-op { { 1 25 } 0 } bitfield ; { register 12 } } insn ; -: LDR 0 1 addr2 ; -: LDRB 1 1 addr2 ; -: STR 0 0 addr2 ; -: STRB 1 0 addr2 ; +PRIVATE> + +! Offset +: <+> ( base -- addressing ) 1 1 0 ; +: <-> ( base -- addressing ) 1 0 0 ; + +! Pre-indexed +: ( base -- addressing ) 1 1 1 ; +: ( base -- addressing ) 1 0 1 ; + +! Post-indexed +: <+!> ( base -- addressing ) 0 1 0 ; +: <-!> ( base -- addressing ) 0 0 0 ; + +: LDR ( Rd Rn addressing-mode -- ) 0 1 addr2 ; +: LDRB ( Rd Rn addressing-mode -- ) 1 1 addr2 ; +: STR ( Rd Rn addressing-mode -- ) 0 0 addr2 ; +: STRB ( Rd Rn addressing-mode -- ) 1 0 addr2 ; ! We might have to simulate these instructions since older ARM ! chips don't have them. SYMBOL: have-BX? SYMBOL: have-BLX? + -M: label (BX) 0 swap (BX) rc-relative-arm-3 label-fixup ; +: BX ( Rm -- ) have-BX? get [ 0 (BX) ] [ [ PC ] dip MOV ] if ; -: BX have-BX? get [ 0 (BX) ] [ PC swap MOV ] if ; - -: BLX have-BLX? get [ 1 (BX) ] [ LR PC MOV BX ] if ; +: BLX ( Rm -- ) have-BLX? get [ 1 (BX) ] [ LR PC MOV BX ] if ; ! More load and store instructions +n/n ( b -- n n ) dup -4 shift swap HEX: f bitand ; +: b>n/n ( b -- n n ) [ -4 shift ] [ HEX: f bitand ] bi ; M: addressing addressing-mode-3 - [ addressing-p ] keep - [ addressing-u ] keep - [ addressing-w ] keep - delegate addressing-mode-3 + { [ p>> ] [ u>> ] [ w>> ] [ base>> addressing-mode-3 ] } cleave { 0 21 23 24 } bitfield ; M: integer addressing-mode-3 @@ -318,10 +353,12 @@ M: object addressing-mode-3 { register 12 } } insn ; -: LDRH 1 1 0 addr3 ; -: LDRSB 0 1 1 addr3 ; -: LDRSH 1 1 1 addr3 ; -: STRH 1 0 0 addr3 ; +PRIVATE> + +: LDRH ( Rn Rd addressing-mode -- ) 1 1 0 addr3 ; +: LDRSB ( Rn Rd addressing-mode -- ) 0 1 1 addr3 ; +: LDRSH ( Rn Rd addressing-mode -- ) 1 1 1 addr3 ; +: STRH ( Rn Rd addressing-mode -- ) 1 0 0 addr3 ; ! Load and store multiple instructions diff --git a/unmaintained/arm/assembler/authors.txt b/basis/cpu/arm/assembler/authors.txt similarity index 100% rename from unmaintained/arm/assembler/authors.txt rename to basis/cpu/arm/assembler/authors.txt