hi

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

  R> dp ! ;


DECIMAL

Evaluator7T? IF( 

: (TTY-expect) \ a n --
  Over Swap               \ a a n 
  FOR Key      
      dup 13 = IF drop 32   FINAL ENDIF
      dup 10 = IF drop 32   FINAL ENDIF 
      dup 8 =  IF  Emit 1 - Over Max
               ELSE dup Emit  Over c! 1+
               ENDIF
  REPEAT
  Swap - span ! ;   



                 Forth Target Definitions 4ASM
Create >char 0 ,
Create end 0 ,

: buffer@ ( a --a')
Code[
  4 # {+} DSP ][ R2, {!} LDR    \ store buff in R2
  37 # R3,  MOV                 \ EOF char
Here
                       4 >Demon    \ get ch
                       R3  R0, CMP \ EOF
1 # {+} R2 [] R0, {!} {B}      STR \ store ch in buff and inc
 Here - {NE} B                     \ go round again
    4 # {-} DSP [] R2, STR         \ push addr
]Code

                 Forth Target Definitions 


HEX
: 0buffer ( --)
  FFFF dup >char ! buffer@ end ! ;

DECIMAL
: char@ ( -- c)
  >char >R I @ c@ 1 R> +! 
  dup 37 = IF drop 32
      [ ' Expect Forth ] Literal  [ Target ]         \   use normal expect
      [ ' (tty-expect) Forth ] Literal [ Target ] 
     (is) 
      [ ' Prompt Forth ] Literal  [ Target ]         \   Now Prompt is ok
      [ ' .prompt Forth ] Literal [ Target ]   
      (is)   
      ." EOF" CR 
  ENDIF ;


: (file-expect) \ a n --
  Over Swap               \ a a n 
  FOR char@               \ Uncomment if your terminal emulator doesnt echo
      dup 13 = IF drop 32   FINAL ENDIF
      dup 10 = IF drop 32   FINAL ENDIF 
      dup 8 =  IF  drop 1 - Over Max
               ELSE  Over c! 1+
               ENDIF
  REPEAT
  Swap - span ! ;   


)ELSE(

: (TTY-expect) \ a n --
  Over Swap               \ a a n 
  FOR Key      \ Dup Emit   \ Uncomment if your terminal emulator doesnt echo
      dup 13 = IF drop 32        ENDIF
      dup 10 = IF drop 32  FINAL ENDIF 
      dup 8 =  IF  drop 1 - Over Max
               ELSE  Over c! 1+
               ENDIF
  REPEAT
  Swap - span ! ;   

)ENDIF
  
Now Expect is (TTY-expect)


Evaluator7T? IF(

   : Hi ( --) 
     ." Please Transmit Texfile from Host..." 0buffer ." Compiling" CR
     [ ' Expect Forth ] Literal  [ Target ]       \   use file expect
     [ ' (file-expect) Forth ] Literal [ Target ] 
     (is) 
   [ ' Prompt Forth ] Literal [ Target ]          \   Now Prompt is Noop
   [ ' Noop Forth ] Literal   [ Target ] 
   (is) ;

   : CIAO ( --)
      [ ' Expect Forth ] Literal  [ Target ]         \   use normal expect
      [ ' (tty-expect) Forth ] Literal [ Target ] 
     (is) 
      [ ' Prompt Forth ] Literal  [ Target ]         \   Now Prompt is ok
      [ ' .prompt Forth ] Literal [ Target ]   
      (is)   
      ." Ciao" CR ;

)ELSE(
   : Hi ( --)
     <Sourcefile
   [ ' Key Forth ] Literal [ Target ]              \   Now Key is (File-Key)
   [ ' (File-Key) Forth ] Literal  [ Target ]
   (is)
   [ ' Prompt Forth ] Literal [ Target ]            \   Now Prompt is Noop
   [ ' Noop Forth ] Literal   [ Target ] 
   (is) ;

: CIAO ( --)
[ ' Key Forth ] Literal  [ Target ]              \   Now Key is (TTY-Key)
[ ' (TTY-Key) Forth ] Literal [ Target ] 
(is)
[ ' Prompt Forth ] Literal  [ Target ]           \   Now Prompt is ok
[ ' .prompt Forth ] Literal [ Target ]   
(is)   
." Ciao" CR ;

)ENDIF



: interpret  ( --)
  BEGIN
    ( ?stack) 32 token c@ 0<>
  WHILE  'word dup >UC find ?dup
         IF   state @
              IF    1 = IF  execute  ELSE  !call  ENDIF
              ELSE  drop  execute
              ENDIF
         ELSE number?
              IF   state @  IF [compile] literal ENDIF
              ELSE 0 error
              ENDIF
         ENDIF
   REPEAT ;

: Definitions ( --)  Context @ Current ! ;


: (quit) ( --)
  0 state !
  BEGIN
      (r0) @ rp!
      query ( .line) interpret
      state @ 0=  IF  prompt  ENDIF   
  0 UNTIL ;

: Quit (quit) ;

: Warm ( --)
  (S0) @ SP! 
[ ' Key Forth ] Literal  [ Target ]              \ Now Key is (TTY-Key)
[ ' (TTY-Key) Forth ] Literal [ Target ] 
(is)
[ ' Emit Forth ] Literal  [ Target ]             \ Now Emit is (TTY-emit)
[ ' (TTY-emit) Forth ] Literal [ Target ] 
(is)
[ ' prompt Forth ] Literal  [ Target ]           \ Now prompt is .prompt
[ ' .prompt Forth ] Literal [ Target ] 
(is)
." OK!" CR   Quit ;

: abort ( --) ." ABORT " Warm ;

DECIMAL
: (COLD)
  ." B4 version 1.0, Copyright (C) 2000 Rod Crawford" CR CR
  ."   B4 comes with ABSOLUTELY NO WARRANTY." CR
  ."   This is free software, and you are welcome" CR
  ."   to redistribute it under certain conditions" CR 
  ."   described in the GNU General Public License" CR CR
  Fence @  DP ! 
 !root @ (root) !  ForthT Definitions 
  10 Base !
  ." Hi! "
  Quit ;

: BOOT (COLD) ;   : COLD 'Boot @ >R ;

: (error) \ --
   .line
   'Word Count type 32 (TTY-emit)
   63 (TTY-emit) ."  Error " u. CR WARM ;
Now Error is (error)

: VARIABLE ( --; work input) CREATE 0 , ;

: Mark ( -- Here)  \ Use for forward branches
  Here 0 , ;  

DECIMAL
: ." ( --;text in input)
  state @ 0= IF 34 word count type [ Forth ] EXIT [ Target ]  Endif
 [ ' (.") Forth ] Literal [ Target ] !call
  Mark
    34 word count 
    >R  I c,    Here I cmove  R>  Allot Aligned
  Resolve ; IMMEDIATE

: $" ( --;text in input)
  state @ 0= IF 99 Error Endif
 [ ' ($") Forth ] Literal [ Target ] !call
  Mark
    34 word count 
    >R  I c,      Here I cmove   R>  Allot Aligned
  Resolve ; IMMEDIATE

: ' ( --;text in input)
  32 token dup >UC find  0= IF  DROP 3 Error  ENDIF ;

: FORGET ( --; word in input)
  ' >lfa dup @   current @ 
     Over Over < IF 9 ERROR ENDIF
  !    >nfa dp ! ;


: .S ( -- ; prints the contents of the stack)
  BASE @ >R 16 Base !
   SP@
   BEGIN  dup (S0) @ - 0<>
   WHILE  dup  4 + @ U. CR
   4 +  REPEAT
   Drop
  R> BASE ! ; 

: Ascii ( -- c) 32 Word 1 + C@ ; 


\ CONDITIONAL WORDS
HEX
: BEGIN ( -- a)  here  ; immediate
: AGAIN ( a--)  !call ; immediate
: UNTIL ( a--)  
  E5BCA004 ,     \ D>A1                 \ pop into A1
  E33A0000 ,     \ 0 # A1, TEQ          \ is it 0?
  {EQ} !call ; immediate                \ branch back if it is zero

: IF  ( -- a -1) 
  E5BCA004 ,    \  D>A1              \ pop item
  E33A0000 ,    \  0 # A1, TEQ       \ is it 0? 
  here 0 , -1 ; immediate            \ make a space for the branch if equal
 
: ENDIF  ( a n --)
  [ Forth ]
   IF    
  [ Target ]
          {EQ} resolve
  [ Forth ]
   ELSE  
  [ Target ]
          resolve 
  [ Forth ]
   ENDIF
  [ Target ]
; immediate


: ELSE   ( a1 -1 -- a2 0)
  [ Forth ]
  IF
  [ Target ]
      here >R 0 ,            \ make space for branch to ENDIF
       {EQ} resolve          \ If it is not branch to where we are now
       R> 0                  \ We were an else not an IF so flag that
  [ Forth ]
  ELSE
  [ Target ]
       4 Error
  [ Forth ]
  ENDIF
  [ Target ]
; immediate

: WHILE ( a1 -- a1 a2 -1 ) [compile] IF ; immediate

: REPEAT ( a1 a2 -1 )
  [ Forth ]
  IF
  [ Target ]
      swap !call            \ branch back to BEGIN/FOR
     {EQ} resolve           \ resolve branch from while/loop exit
  [ Forth ]
  ELSE
  [ Target ]
        5 Error
  [ Forth ]
  ENDIF
  [ Target ]
; immediate

: FOR ( n -- )
  E5BCA004 , 
  E40DA004 , \ >R
Here         \ Loop starts here
  E59DA004 , \ 4 # {+} RSP ][ A1, LDR    \ get index
  E33A0000 , \ 0 # A1, TEQ               \ is it 0
   28DD004 , \ 4 # RSP RSP, {EQ} ADD     \ Yes, chuck index
Mark         \ Yes, Exit loop
  E24AA001 , \ 1 # A1 A1, SUB            \ Decrement Count
  E58DA004 , \   4 # {+} RSP ][ A1, STR  \ put back index
-1           \ Flag for REPEAT to find
; IMMEDIATE

\ B4 STARTUP
\ Patch a branch to Cold/quit at the start of Target Memory


Forth 'Target @ resolve

Target Definitions 4ASM

BINARY
\ force user mode. Boot loader SWI's Only work in this mode!
           CPSR R0, MRS  \ get CPSR
            0 # R1, MVN  \ make mask from -1
         1111 # R2, MOV  \ bits to unset for user mode
          R2 R1 R1, EOR  \ create mask
          R1 R0 R0, AND  \ mask CPSR
        R0 CPSR_CF, MSR  \ set CPSR

HEX
\ If running from somewhere other than expected then copy
\ to proper address and restart.
\ e.g. boot in flash, copy itself to it's RAM address and start there.

\ Load R1 with start of Forth
  0 # {+} R15 ][ R1, LDR  \ Fetch literal thats 8 words ahead of here
  Here 0 ,                \ we will branch round the literal
Forth 'Target @  ,        \ store start of target Forth
4ASM
  resolve                 \ resolve the branch around
               R1 R0, MOV \ Remember the proper start address in R0

\ Load R2 with End of Forth
  0 # {+} R15 ][ R2, LDR  \ Fetch literal thats 8 words ahead of here
  Here 0 ,                \ we will branch round the literal
Forth Here 'End !         \ Note where we store end of Forth for relocation
               0 ,        \ Fill with Zero patch and end of compilation.
4ASM
  resolve                 \ resolve the branch around             


\ Load R3 with offset of Forth in Flash
  0 # {+} R15 ][ R3, LDR  \ Fetch literal thats 8 words ahead of here
  Here 0 ,                \ we will branch round the literal
Forth 
 Here 'Target @ -  C + ,  \ store start of target Forth from where PC will be
4ASM
  resolve                 \ resolve the branch around   

           R3 R15 R4, SUB \ Calc start address of Forth in Flash
               R4 R1, TEQ \ Am I in the right place
Here 0 ,                  \ Yes, Branch over copy

Here
     4 # {+} R4 [] R5, {!}  LDR \ get a word from where I am
     4 # {+} R1 [] R5, {!}  STR \ store it where I want it to be
                     R1 R2, TEQ \ copy compete?
Here - {NE} B                   \ No, Go round again
                   R0 R15, MOV  \ Restart a the right address!
Forth {EQ} Resolve 4asm         \ resolve to skip copy

                   
\ COLD Code 
\ Setup the stacks

  0 # {+} R15 ][ A1, LDR  \ Fetch literal thats 8 words ahead of here
  Here 0 ,                \ we will branch round the literal
Forth Target
  (R0) Forth ,            \ store literal
4ASM
  resolve                 \ resolve the branch around
  A1 RSP, LDR             \ load contents of address the literal pointed to

  0 # {+} R15 ][ A2, LDR  \ as above
  Here 0 ,
Forth Target
  (S0) Forth ,
4ASM
  resolve
  A2 DSP, LDR

                   Forth Target Definitions
]  BOOT [ 

DECIMAL
: DOES>
    Here
    R>         \ get where does is at we don't put it back 
               \ so force an exit from caller one word on from 
               \ it is where the DOES part of the word should start
    Current @  @ 16 + dp ! \ (next) laid by create
    !Call
    dp ! ; 

: Constant ( n --)  CREATE ,   DOES> @ ;

: Vocabulary ( --; word in input)
  Create   Context @ @ ,
  Does>    Context ! ;


DECIMAL
\ Compile target words with T on the end to prevent
\ them being used whilst Target compiling. T is CLEANed off later.

: (T 41 Word Drop ; IMMEDIATE
: \T Span @ >IN ! ; IMMEDIATE

: DECIMAL  10 BASE ! ;   : HEX   16 BASE ! ;   : BINARY   2 BASE ! ;

: IMMEDIATE ( --) Current @ @ >nfa dup c@ 128 OR swap c! ;

: ]    1 state ! ;
: [    0 state ! ; Forth IMMEDIATE Target
: :T  carve  !Before  ] ;
: ;T  !Next  0 state !  ; Forth IMMEDIATE Target

\ Clean up Target words & store away last entry in Forth Voc for restoration in COLD
Clean :T   Clean ;T   Clean (T    Clean \T  

Forth Context Target @ @ dup 'root @ ! !Root !
Forth ." New Forth is " Here Target 'Boot Forth @ - u. ." Bytes" CR

Forth  Here dup 'End @ !    Target     Fence !

Clean ForthT

COMPLETE
%