hi

AT91所有开发板的资料 AT91所有开发板的资料

\ B4 A Small Forth for the ARM Architecture
\    Copyright (C) 2000  Rod Crawford
\
\    This program is free software; you can redistribute it and/or modify
\    it under the terms of the GNU General Public License as published by
\    the Free Software Foundation; either version 2 of the License, or
\    (at your option) any later version.
\
\    This program is distributed in the hope that it will be useful,
\    but WITHOUT ANY WARRANTY; without even the implied warranty of
\    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
\    GNU General Public License for more details.
\
\    You should have received a copy of the GNU General Public License
\    along with this program; if not, write to the Free Software
\    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA


." Loading B4 Secondaries..."

                            Forth Definitions
\ TARGET ELECTIVES
\ -----------------
\ This file contains conditional compilation code
\ to allow you to build B4 for the Evaluator7T board from ARM
\ or the ARMulator running under AXD.
\ The following defines the platforms on which you can expand.

Variable Platform   
-1 Constant Evaluator7T  : Evaluator7T? ( --t|f)  Platform @ Evaluator7T = ;   
0 Constant ARMulator     : ARMulator? ( --t|f)    Platform @ ARMulator = ;

: .Platform ( --) Platform @ IF  ." Evaluator7T"  ELSE  ." ARMulator"  ENDIF ;

\ UNCOMMENT one of the following lines to define YOUR platform

  Evaluator7T Platform !
\   ARMulator   Platform !

\ ----------------------------


: [Compile] ( -- ;word in input) ' !Call ; IMMEDIATE
: Compile ( -- ;word in input) 
  ' [Compile] Literal  [ ' !Call ] Literal !Call ; IMMEDIATE
: ['] ( -- ;word in input)' [Compile] Literal ; IMMEDIATE


: Now ( -- CFA of word to be patched)
  state @  IF   [compile] ['] ELSE '   ENDIF ; IMMEDIATE

: Is ( a --)
  state @ IF   [compile] ['] Compile (is) 
          ELSE  ' (is)
          ENDIF ; IMMEDIATE


: Error" ( -- ;txt) [Compile] ." Compile abort ; IMMEDIATE

: ?Error"
  Compile 0=
  [Compile] IF
  [Compile] ."
  Compile abort
  [Compile] Endif
; IMMEDIATE
  

\ Useful Words for Mapping Words CFA's
Hex
: last ( -- lfa)  current @ @ ;
: .cfa ( lfa - ) Base @ >R   >cfa Hex U.   R> Base ! ;
: .Name ( lfa -- ) >nfa dup 1+ Swap C@ 7F AND Type ;
: (MapCarve) ( --) (carve) last dup .cfa .Name CR ;
: Mapped ( --) Now Carve is (MapCarve) ;
: UnMapped ( --) Now Carve is (Carve) ;


\ User Variables
: 'User     'boot @ 4 + ; 
: +User     'boot @ 8 + ;

: User \ n --
  Create
      +User @ dup ,  + +User !
  DOES>
      'User @ + ;
DECIMAL
: pass ( a l --)
  BEGIN
       BEGIN 32 word c@
       WHILE dup 'word c@ =
             IF  'word dup >UC
                 1+ >R Over Over R> Swap S=
                 IF drop drop EXIT ENDIF
             ENDIF
       REPEAT
  Query
  AGAIN ;

: IF( ( f --;text in input)  0= IF $" )ELSE(" pass ENDIF ; IMMEDIATE
: )ELSE( ( --;text in input) $" )ENDIF" pass ;             IMMEDIATE
: )ENDIF ( --) NOOP ; IMMEDIATE


." Loaded" CR CR
\ CIAO
\ -------------------------------------------


." Loading B4 Assembler..."

Vocabulary 4asm   4asm definitions

\ Registers
Decimal

\ Source Registers
 0 Constant R0   1 Constant R1
 2 Constant R2   3 Constant R3
 4 Constant R4   5 Constant R5
 6 Constant R6   7 Constant R7
 8 Constant R8   9 Constant R9
10 Constant R10 11 Constant R11
12 Constant R12 13 Constant R13
14 Constant R14 15 Constant R15

\ Destination Registers
16 Constant R0,  17 Constant R1,
18 Constant R2,  19 Constant R3,
20 Constant R4,  21 Constant R5,
22 Constant R6,  23 Constant R7,
24 Constant R8,  25 Constant R9, 
26 Constant R10, 27 Constant R11,
28 Constant R12, 29 Constant R13,
30 Constant R14, 31 Constant R15,

\ Register Checks
decimal
: ?R0-R15 \ R# -- R#
  dup 0 15 within?  ?error" Register Argument not R0-R15" ;

: ?R0-R14 \ R# -- R#
  dup 0 14 within? ?error" Register Argument not R0-R14" ;

: ?R0,-R15, \ R# -- R#
  dup 16 31 within? ?error" Register Argument not R0,-R15," ;

: ?8Bit \ 8b -- 8b
  dup 0 255 within? ?error" Value > 255 ie not 8 Bits";

\ Condition Fields
variable cond \ hold the condition field to be ORed in

: condition
  create \ --
  ,
  does>
  @ cond ! ;

Binary
0000 Condition {EQ} 0001 Condition {NE} 0010 Condition {CS}
0011 Condition {CC} 0100 Condition {MI} 0101 Condition {PL}
0110 Condition {VS} 0111 Condition {VC} 1000 Condition {HI}
1001 Condition {LS} 1010 Condition {GE} 1011 Condition {LT}
1100 Condition {GT} 1101 Condition {LE} 1110 Condition {AL}

\ Default for intructions is always {AL}
{AL}

Decimal 
: |cond ( b -- b') cond @ 28 << OR   {AL} ;

\ literals
variable litting  variable nlit

: # ( n --)  litting on  nlit ! ;

Decimal
: |lit ( n -- n')
  litting @ IF   
     nlit @   [ 1 25 << ] Literal OR \ set the immediate bit
     OR                              \ or into opcode
     litting OFF
  ENDIF ;


\ Set Conditions
Variable Setting   : {S}  ( --)  1 Setting ! ;
Decimal
: |sbit \ -- set the s bit if needed
  Setting @  20 << OR    Setting OFF ;

\ Shift Operators
Variable Shift
Decimal

: shiftop
  Create ,   \ opcode -- ; word in input
  Does> @ >R              \ #|Register --
    Litting @
    IF    Litting OFF  nlit @  7 <<    \ Shift lit value into place
    ELSE  8 <<  [ 1 4 << ] Literal  OR \ Shift reg into place and mark as Reg Op in bit 4
    ENDIF
  R> 5 << OR  Shift ! ;  \ OR in the Shift Op and store it for later

: |shift ( Opcode -- Opcode')  Shift @ OR   Shift OFF ;

 Binary 00 ShiftOp LSL  01 ShiftOp LSR  10 ShiftOp ASR  11 ShiftOp ROR

\ Branch Instructions   
binary   
: BX ( R# --) ?R0-R15  0001001011111111111100010000 OR   |cond  , ;
     
: B ( offset --)
  1000 -
  dup 0< IF   \ prune to 23 bits with the sign in bit 24
          10 >>  111111111111111111111111 
  ELSE    10 >>  011111111111111111111111
  ENDIF AND  1010000000000000000000000000 OR |cond  , ;

: BL \ offset --
  1000 -
  dup 0< IF \ prune to 23 bits with the sign in bit 24
          10 >>  111111111111111111111111
  ELSE    10 >>  011111111111111111111111
  ENDIF  AND  1011000000000000000000000000 OR  |cond  , ;

\ DATA PROCESSING INTRUCTIONS dips
\ dip {cond}{S} Rd, Rn
\ op2 Rn Rd, {S}{cond} dip
Decimal
: dpi
  create       \ opcode -- ; word in input Usage: Rn Rd, {S}{cond} dip
    21 << ,    \ shift into place
  does> 
   @ >R  
     16 - 12 <<            \ normalise Rd, to R0-R15 and shift into place
     swap 16 <<            \ shift Rn into place
    OR
    litting @ IF  |lit     \ OR in the literal
    ELSE          OR       \ OR in the register
    ENDIF  |sbit  |cond |shift 
   R> OR , ;

Decimal
  0 dpi and    1 dpi eor    2 dpi sub   3 dpi rsb    4 dpi add
  5 dpi adc    6 dpi sbc    7 dpi rsc   8 dpi (tst)  9 dpi (teq)
 10 dpi (cmp) 11 dpi (cmn) 12 dpi orr  13 dpi (mov) 14 dpi bic
 15 dpi (mvn)

\ Test dpi's have no destination (so defualt it to R0) and force flags tst
: tst ( op2 op1 --)  R0, {S} (tst) ;   : teq ( op2 op1 --)  R0, {S} (teq) ;   
: cmp ( op2 op1 --)  R0, {S} (cmp) ;   : cmn ( op2 op1 --)  R0, {S} (cmn) ;

\ Move dpi's have only one operand (so default 1st Operand to R0)
: mov ( op2 dest --) R0 Swap (mov) ;  : mvn ( op2 dest --) R0 Swap (mvn) ;

\ PSR Xfer Operations
\ Usage: CPSR Rd, MRS   SPSR Rd, MRS   R# CPSR_CF, MSR   R# SPSR_CF, MSR
\         op2 CPSR_F, MSR  op2 SPSR_F, MSR

: mrs noop ; \ Defer until later
: cpsr ( --)  
  r0 r15  Now mrs is (tst) ; \ Cludge in R0 R15 & use tst without S bit set
: spsr ( --)  
  r0 r15  Now mrs is (cmp) ; \ Cludge in R0 R15 & use cmp without S bit set

: msr noop ; \ Defer until later
: cpsr_cf, ( --)  
  R9 R15,  Now msr is (teq) ; \ Cludge in R9 R15, & use teq without S bit set
                    
: spsr_cf, ( --)
  R9 R15,  Now msr is (cmn) ; \ Cludge in R9 R15, & use cmn without S bit set
: cpsr_f, ( --)  
  R8 R15,  Now msr is (teq) ; \ Cludge in R8 R15, & use teq without S bit set
                    
: spsr_f, ( -- )
  R8 R15,  Now msr is (cmn) ; \ Cludge in R8 R15, & use cmn without S bit set

\ Multiply Operators Mulop
Decimal
: mulop  \ rs rm rd, --
  16 - 16 <<            \ normalise Rd, to R0-R15 and shift into place
  144 OR                \ OR in magic #
  OR                    \ or in Rm
  swap 8 << OR          \ or in Rs
  |sbit |cond ;

: MUL ( rs rm rd, -- )  mulop , ;  \ Rd:=Rm*Rs

: MULA \ rn rs rm rd,  \ Rd:=Rm*Rs+Rn
  mulop 1 21 << OR     \ set the accumulate bit
  swap 12 << OR  , ;   \ or in Rs and lay opcode

\ Long Multiply Operators Mulop
Decimal
: lmulop \ rs rm rdhi, rdlo, -- opcode
  16 - 12 <<            \ normalise Rdlo to R0-R15 and shift into place
  swap 16 - 16 <<  OR   \ normalise Rdhi to R0-R15 and shift into place
  OR                    \ OR in Rm
  144 OR  [ 1 23 << ] Literal OR    \ OR in magic #s
  swap 8 << OR          \ shift Rs into place and or in
  |sbit  |cond ;

: SMULL ( Rs Rm Rdhi, Rdlo, --)  
  lmulop 1 22 << OR , ;  \ OR in the U bit and lay opcode

: SMLAL \ Rs Rm Rdhi, Rdlo, -- 
  lmulop 1 21 << OR           \ OR in the A bit
  [ 1 22 << ] Literal OR , ;  \ OR in the U bit and lay the opcode

: UMULL ( Rs Rm Rdhi, Rdlo, -- )  lmulop , ;

: UMLAL \ Rs Rm Rdhi, Rdlo, -- 
  lmulop [ 1 21 << ] Literal OR , ; \ OR in the A bit and lay the opcode

\ Single Data Xfer - SDT
Decimal   
Variable Byting : {B} ( -- )  1 Byting ! ;
: |Bbit ( --set the B bit if needed) Byting @  22 << OR   Byting OFF ;

Variable Writing   : {T} ( -- ) 1 Writing ! ;   : {!} {T} ;
: |Tbit ( -- set the W bit if needed) Writing @  21 << OR   Writing OFF ;

Variable Ping \ Careful how you pronounce this in company :)
: ][ ( Set pre indexed addressing) 1 Ping ! ;
: [] ; \ Set post indexed addressing
: |Pbit ( -- set the P if needed) Ping @  24 << OR   Ping OFF ;

Variable {+/-} \ 3 state variable indicateing +/- offset and that lit or reg follows  
: {+} ( Set Up; add offset to base) 2 {+/-} ! ;
: {-} ( Set Down; subtract offset from base)  1 {+/-} ! ;
: |Ubit ( -- set the U bit if needed) 
  {+/-} @  1 >>  23 << OR  {+/-} OFF ;

: SDT   \ n1.. -- opcode  \ Single Data Transfer Instruction
  16 - 12 <<                \ normalise Rd, to R0-R15 and shift into place
  swap   16 <<              \ shift Rn into place
  OR
  [ 1 26 << ] Literal OR    \ OR in Magic #
  {+/-} @ IF                \ True heralds further literal or regs
    litting @ IF  
          |lit  \ OR in the literal
          [ hex ]
          FDFFFFFF 
          [ Forth ] AND [ 4ASM ]             \ reset lit bit 'cause its opposite
          [ decimal  ]
    ELSE  [ 1 25 << ] Literal OR    \ set immediate bit 'cause its opposite 
          OR |shift                 \ OR in a register & any shift
    ENDIF
  ELSE {+}                          \ Needs to be {+} whatever
  ENDIF  |cond |Bbit |Tbit |Pbit |Ubit ;

: LDR ( n...--)  SDT  [ 1 20 << ] Literal OR  , ;
: STR ( n...--)  SDT , ;

Decimal
: {R} create , does> @ OR ;
: {R ( -- 0) 0 ;

: R} ( -- RegisterMask) Dup ?Error" Register List Cannot Be Empty" ;

Binary
               1 {R}  R0+
              10 {R}  R1+
             100 {R}  R2+
            1000 {R}  R3+
           10000 {R}  R4+
          100000 {R}  R5+
         1000000 {R}  R6+
        10000000 {R}  R7+
       100000000 {R}  R8+
      1000000000 {R}  R9+
     10000000000 {R} R10+
    100000000000 {R} R11+
   1000000000000 {R} R12+
  10000000000000 {R} R13+
 100000000000000 {R} R14+
1000000000000000 {R} R15+


: {^} {B} ; \ Use the byte bit setting wordset 'cause it sets same bit 22

Decimal 

: BDT   \ n1.. --       \ Block Data Transfer Instruction
[ Forth ]
Create ,
Does> @
  DUP 3 AND 23 <<           \ Shift in PU bits
  Swap 4 AND 18 << OR       \ Shift in L bit 
 swap 16 - 16 << OR          \ OR in Rd, 
 OR                          \ OR in the Register List
 1 27 <<  OR                 \ OR in Magic #
[ 4ASM ]
 |cond |Bbit |Tbit , ;


Binary
111 DUP BDT LDMED    BDT LDMIB   101 DUP BDT LDMFD    BDT LDMIA
110 DUP BDT LDMEA    BDT LDMDB   100 DUP BDT LDMFA    BDT LDMDA
011 DUP BDT STMFA    BDT STMIB   001 DUP BDT STMEA    BDT STMIA
010 DUP BDT STMFD    BDT STMDB   000 DUP BDT STMED    BDT STMDA


DECIMAL
: Code[ \ --             \ Use this for leaf asm subroutines only!
  {AL}                   \ set default to always on conditional execution
  litting off setting off
  Here 4 - dp !          \ backup up one cell since to replace the LR push
  [Compile] [ ; IMMEDIATE

\ Define Forth Registers
R15 Constant PC   R15, Constant PC,
R14 Constant LR   R14, Constant LR,
R13 Constant RSP  R13, Constant RSP,
R12 Constant DSP  R12, Constant DSP,
R11 Constant A2   R11, Constant A2,
R10 Constant A1   R10, Constant A1,

: ]Code ( --)  LR PC, MOV ;

\ SWIs
Decimal
: SWI ( n --) 15 24 << OR |cond , ;

\ SWIs Angel
Hex 123456 Constant angel_SWI_ARM
: >Angel ( n --)
  DSP R9, MOV                   \ Preserve DSP 'cause Angel destroys R12
   # r0, MOV   angel_SWI_ARM SWI 
  R9 DSP, MOV ;                 \ restore DSP 'cause Angel destroys R12

: SYS_WriteC ( 'c --) R1, LDR 3 >Angel ;

\ SWIs Demon
: >Demon ( swi# --) SWI ;

\ Forth Register Macros