hi

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

: skip ( a l c -- a' l')
Code[  
  4 # {+} DSP ][ R0, {!} LDR    \ store c in R0
  4 # {+} DSP ][ A1, {!} LDR    \ store l in A1
  4 # {+} DSP ][ A2, {!} LDR    \ store a in A2
Here
  0 # A1, TEQ                   \ end of string?
Mark                            \ Yes go to end
  1 # {+} A2 [] R3, {!} {B} LDR \ get a byte
  R0 R3, CMP                    \ Is it the Same?
  1 # A1 A1, {EQ} SUB           \ Yes, Decrement count
Swap Here - {EQ} B              \ Yes, go round again
  1 # A2 A2, SUB                \ No, point A2 to that char
Forth {EQ} Resolve 4asm         \ resolve to of loop
  A2>D A1>D                     \ push the result
]Code

: scan ( a l c -- a' l')
Code[  
  4 # {+} DSP ][ R0, {!} LDR    \ store c in R0
  4 # {+} DSP ][ A1, {!} LDR    \ store l in A1
  4 # {+} DSP ][ A2, {!} LDR    \ store a in A2
Here
  0 # A1, TEQ                   \ end of string?
Mark                            \ Yes go to end
  1 # {+} A2 [] R3, {!} {B} LDR \ get a byte
  R0 R3, CMP                    \ Is it not the Same?
  1 # A1 A1, {NE} SUB           \ Yes, Decrement count
Swap Here - {NE} B              \ Yes, go round again
  1 # A2 A2, SUB                \ No, point A2 to that char
Forth {EQ} Resolve 4asm         \ resolve to of loop
  A2>D A1>D                     \ push the result
]Code

DECIMAL 
: >UC \ $ -- ; uppercases a counted string
Code[  
  4 # {+} DSP ][ R0, {!} LDR    \ store $ in R0
             R0  R1, {B} LDR    \ store length in R1
              1 # R0 R0, ADD    \ store start R0
               122 # R2, MOV    \ upper ascii bount
                97 # R3, MOV    \ Lower ascii bound
Here
                    0 # R1, TEQ \ end of string?
               LR PC,  {EQ} MOV \ Yes Exit
                 1 # R1 R1, SUB \ Decrement Count
  1 # {+} R0 [] A1, {!} {B} LDR \ get a byte
                     R3 A1, CMP \ check lower bound
dup Here - {LT} B               \ < go round again
                     R2 A1, CMP \ Check uuper bound
dup Here - {GT} B               \ > go round again
                32 # A1 A1, SUB \ bring back to A-Z
      1 # {-} R0 ][ A1, {B} STR \ store back ch in string
Here - B                        \ go round again
]Code

                     Forth Target Definitions
HEX
: >cfa ( lfa -- cfa) 4 + ;     : >lfa ( cfa -- lfa ) 4 - ;
  
: IMMEDIATE? ( nfa -- n)  \ 1 if immediate else -1
   c@ dup 7F AND = IF -1 ELSE 1 ENDIF ;
                

: Expect Noop ;

DECIMAL
: query ( --) TIB 128 Expect 0 >IN ! ;

Evaluator7T? IF(  \ Expects CR/LF

  : CR ( --)   13 (tty-emit)  10 (tty-emit) ;

)ELSE(     \ Expects LF only

  : CR ( --)   10 (tty-emit) ;

)ENDIF

: (Prompt) ( --   basic one for debug) 79 emit 75 emit CR ;
: Prompt Noop ;   Now Prompt is (prompt)

: U/MOD \ n div - r q 
   >R
      0 Swap
      BEGIN
         I - Dup 0 < 0=  \ while +ve
      WHILE
         Swap 1+ Swap
      REPEAT
      Dup 0 < IF I + ENDIF
   R>Drop
   swap ;

: Count ( a -- a' c) dup 1+ swap C@ ;

                     Forth Target Definitions 4ASM
: SP@ ( -- n) code[ DSP A1, MOV  A1>D ]code
: SP! ( n --) code[ D>A1  A1 DSP, MOV ]code
: rP@ ( -- n) code[ RSP A1, MOV  A1>D ]code
: rP! ( n --) code[ D>A1  A1 RSP, MOV ]code
   
                      Forth Target Definitions
DECIMAL
: .line ( --) tib span @ type CR ;

: Error Noop ;

\ ROOT Vocabulary Creation
Create (Root) 0 ,
' (Root) 16 + 'root Forth !  \ store the data field of (root) to patch later

                      Forth Target Definitions
: ForthT (root) context ! ;

Evaluator7T? IF(
)ELSE(

  \ Angel FILE IO
  Create ch 0 ,    \ a one character buffer

  DECIMAL
  Create SourceFile
  0 ,                    \ Handle goes here
  ch  ,                  \ ch and status buffer ' goes here
  1 ,                    \ Number of bytes please
  0 ,                    \ file Mode read
  \ Info for opening	
  0 ,                    \ 'Filename$
  0 ,                    \ Mode to be readonly
  2 ,                    \ #FileName$
  Here SourceFile 16 + ! \ Store 'Filename$
  ASCII H C,             \ File is called Called HI 
  ASCII I C,
  0 C,                   \ A File Called HI terminated by Null
  0 c,                   \ Align

                  Forth Target Definitions 4ASM

: SYS_Open ( FileBLock -- status )
  [ D>A1   A1 R1, MOV  1 >Angel   R0 A1, MOV   A1>D ] ;



                  Forth Target Definitions
DECIMAL

: <Sourcefile  ( -- )
  SourceFile 16 + Sys_Open  ?Dup  IF SourceFile !  ELSE  1 Error  ENDIF ;


: (File-key) \ -- c
  SourceFile      \ Handle
[                  Forth Target Definitions 4ASM
   4 # {+} DSP ][ R1, {!} LDR
   6 >Angel
   4 # {-} DSP [] R0, STR    \ R0 has the # chars not read which we push

                   Forth Target Definitions
]
  0 = 
  IF    ch @         \ 0 status all is well push the char
  ELSE 0 2 error     \ Non zero status the read failed. Flag it.
  ENDIF ;

)ENDIF  \ End of Angel IO

\ DICTIONARY MANIPULATION WORDS
: Here ( -- n) dp @ ;
: , ( n --) Here !  4 dp +! ;
: c, ( b --) Here c!  1 dp +! ;
: Allot ( n --) dp +! ;

HEX
: Aligned ( --)  Here 3 AND ?dup   IF 4 Swap - FOR 0 c, REPEAT ENDIF ;

  
: word ( c -- a)
  >R 
    >IN @ TIB Over + \ start here
    Span @ Rot -     \ for length
    I Skip           \ a' l'
    Over Swap        \ a' a' l
    I  Scan          \ a' a'' l
  R>DROP
  Here Align >R               \ string starts word aligned
    Span @ Swap - 1+ >IN !    \ update >IN
    Over -                    \ length of string
    dup I c!                  \ store it.
    I 1+ Swap  CMOVE          \ move the string
  R>                          \ start of string
 ;

: token ( c -- a)
  Here >R
    Word dup dp !
         c@ 1+ Allot Aligned  \ 0 Fill to next word
  R> dp ! 
  'Word ;

DECIMAL   
: (carve)  ( --;word in input)  
  32 word dup >UC Count Nip
  dup c,  Allot Aligned
  Here current @ @ ,  current @ ! ;

: Carve NOOP ; Now Carve is (carve)

                    Forth Target Definitions

: NOT \ n -- NOT(n)
   -1 
[                   Forth Target Definitions 4ASM
   D>A2
   D>A1
   A2 A1 A1, EOR
   A1>D
] ;

: S= ( a1 a2 l -- t|f)
Code[ 
  4 # {+} DSP ][ R0, {!} LDR    \ store length in R0
  4 # {+} DSP ][ R2, {!} LDR    \ store Addr2 in R2
  4 # {+} DSP ][ R1, {!} LDR    \ store Addr1 in R1
Here
  0 # R0, TEQ                   \ is length 0?
  0 # A1, {EQ} MVN               \ Yes, Push True.
  4 # {-} DSP [] A1, {EQ} STR   
  LR PC,  {EQ} MOV              \ Yes Exit
  1 # {+} R1 [] A1, {!} {B} LDR \ get bytes to compare
  1 # {+} R2 [] A2, {!} {B} LDR   
  A1 A2, TEQ                    \ are  chs equal?
  1 # R0 R0, {EQ} SUB           \ yes, Decrement the count
Here - {EQ} B                   \ yes, go and check next word
  0 # A1, MOV                    \ No, Push false.
  A1>D
]Code                           \ Exit     

: Name= ( nfa text -- t|f)
\ Assumes R7 has the mask in it from caller
Code[ 
   4 # {+} DSP ][ R2, {!} LDR   \ store text addr in R2
            R2 [] R0, {B} LDR   \ get  length in R0 
              1 # R0 R0,  ADD   \ include count byte in comparison    
  3 # R0 R4, AND                \ store bits 1 & 2 not divisable by 4
  2 # LSR R0 R0, MOV            \ Divide by 4 to get num of words to compare
  0 # R4, TEQ                   \ was string across word boundary?
  1 # R0 R0, {NE} ADD           \ yes add 1 to num of words to compare

  4 # {+} DSP ][ R1, {!} LDR    \ store Addr1 in R1
\ Do the first Word longhand 'cause of the immediate bit
  0 # R0, TEQ                   \ is length 0?
  0 # A1, {EQ} MVN              \ Yes, Push True.
  4 # {-} DSP [] A1, {EQ} STR   
  LR PC,  {EQ} MOV              \ Yes Exit
  4 # {+} R1 [] R5, {!}  LDR    \ get words to compare
  4 # {+} R2 [] R6, {!}  LDR
               R7 R5 R5, AND    \ Mask out the immediate bit  
  R5 R6, TEQ                    \ are  words equal?
  1 # R0 R0, {EQ} SUB           \ yes, Decrement the count
  0 # A1, {NE} MOV              \ No, Push false.
  4 # {-} DSP [] A1, {NE} STR   
  LR PC, {NE} MOV               \ and exit
Here
  0 # R0, TEQ                   \ is length 0?
  0 # A1, {EQ} MVN              \ Yes, Push True.
  4 # {-} DSP [] A1, {EQ} STR   
  LR PC,  {EQ} MOV              \ Yes Exit
  4 # {+} R1 [] R5, {!}  LDR    \ get words to compare
  4 # {+} R2 [] R6, {!}  LDR   
  R5 R6, TEQ                    \ are  words equal?
  1 # R0 R0, {EQ} SUB           \ yes, Decrement the count
Here - {EQ} B                   \ yes, go and check next word
  0 # A1, MOV                    \ No, Push false.
  A1>D
]Code                           \ Exit     

                    Forth Target Definitions

: spaces ( n --) FOR space REPEAT ;

HEX
: Words ( --)
  0 >R
    Context @ @
    BEGIN dup WHILE 
          dup >nfa
          dup Immediate? 1 = IF 69 emit ELSE space ENDIF 
          dup 1+ swap  c@ 7F AND 
          dup 8 swap - dup 0 < IF 9 + R> 1+ >R ENDIF
          rot rot type spaces
       @
      I 6 < IF  R> 1+ >R  ELSE R>Drop 0 >R CR  ENDIF
    REPEAT
    drop
  R>Drop
; 


HEX 
: Find ( a1 -- a2 +/-1 | a1 0)
  FFFFFF7F 
 [             Forth Target Definitions 4ASM 
   4 # {+} DSP ][ R7, {!} LDR    \ store the mask in R7 for use by Name=
               Forth Target Definitions ]
   
  >R Context @                              \ context
  BEGIN @ Dup WHILE                         \ LFA
     dup >nfa dup i name=
     IF   R>Drop
          swap >cfa swap Immediate? EXIT    \ cfa 1|-1 
     ELSE Drop
     ENDIF
  REPEAT
  Drop R> 0 ;

DECIMAL
: digit? ( c -- n 1| 0)
   >R base @ 11 <                              \ decimal base or below?
      IF   I 48 dup base @ + 1 - within?       \ digit within 0...base-1?
           IF R> 48 -  1 EXIT ENDIF
      ELSE I 48 57 within?                     \ 0..9? 
           IF   R> 48 -  1 EXIT                \ yes, return 0..9
           ELSE I 65 dup base @ + 1 - within?  \ is in in A..base?
               IF R> 55 -  1 EXIT ENDIF        \ yes, retrn A..base  
         ENDIF
      ENDIF
    R>Drop 0 ;      

: number? ( a -- f | n t)
   Count >R
   0 swap            \ start with 0 and see what it ends up as
   BEGIN
        I 0<>        \ while not end of string
   WHILE
        dup c@
        digit?
        0= IF  R>Drop 2Drop 0 EXIT ENDIF
        \ # a n
        rot base @ U* drop +     \ a #
        swap 1+                     \ # a+1
        R> 1 - >R
    REPEAT
    drop                \ junk address leaving #
    R>    DROP
    1 ;


\ CONTROL STRUCTURES
                 Forth Target Definitions
: execute ( a --) >R ;

Binary
: {EQ} 0000 Cond ! ;   : {NE} 0001 Cond ! ; : {AL} 1110 Cond ! ;

Decimal
: |cond ( b -- b') \ shove in the condition for execution and default back to
  cond @ 28 << OR {AL} ;

BINARY                    \ This is BL from the assembler.
: !BL ( offset --)
  1000 - dup 0 < 
  IF   10 >> 111111111111111111111111 AND \ prune to 23 bits with sign in bit 24
  ELSE 10 >> 011111111111111111111111 AND
  ENDIF     
  1011000000000000000000000000 OR   |cond , ;

: !call ( a --) Here -   !BL ;

: !B ( offset --)
  1000 - dup 0< 
  IF   10 >> 111111111111111111111111 AND
  ELSE 10 >> 011111111111111111111111 AND
  ENDIF     
  1010000000000000000000000000 OR  |cond  , ;

: !Jump ( a --) Here -   !B ;

Hex
: !Before \ Lay down    4 # {-} RSP [] LR, STR
   E40DE004 , ;
: !Next   \ Lay Down    4 # {+} RSP ][ PC, {!} LDR
   E5BDF004 , ;

DECIMAL
: resolve ( a --)
  Here >R          \ remember where I am now
       dp !        \ go back to where I was
       I !jump     \ branch from there to where I am now    
  R> dp ! ;        \ go back to where I am now

                  Forth Target Definitions

: Literal ( n --) [ ' LIT Forth ] Literal [ Target ] !call , ; IMMEDIATE
: Exit ( --) !next ; IMMEDIATE

HEX
: Create ( --; word in input)
   Carve
   !Before
   E28FA004    ,   \ 4 # PC  A1, ADD 
   E40CA004 ,      \ A1>D
   !Next ;

DECIMAL
                Forth Target Definitions

: (.") ( --)  R> DUP >R  4 + Count Type ; 
' (.") '(.") !  \ remember (.") so for ." running on host

: ($") ( -- a l)  R> DUP >R   4 + Count ; 

: depth \ -- n ; returns the data stack depth, sans itself
  (S0) @ SP@  - 4 -  4 U/MOD Nip ;

: .DIGIT ( n base --)
  11 <
  IF   48 
  ELSE dup 10 <
       IF 48 ELSE 55 ENDIF
  ENDIF
  + emit ;

: U. ( n --)
  base @ >R
  0 swap
  BEGIN  I U/MOD  rot 1 + swap   dup 0=  UNTIL
  drop
  BEGIN swap I .digit  1 -  dup 0=  UNTIL
  drop  R>Drop  32 EMIT ;

: .  ( n --)  Dup  0 <  IF   45 EMIT  Negate   ENDIF  U. ;

: .prompt ( --) ."  ok"   depth ?dup  IF 45 Emit .  ENDIF  CR ;
Now Prompt is .prompt

: (is) ( a1 a2  --)
  Here >R
    Swap 4 + dp !  \ point dictionary at addr to patch
    !Call          \ patch