FFFF XOR

: Pulse ( Mask Addr --)
    2DUP OR! >R INVERT R> AND!;

:
;C Pulse ( Mask Addr --)
        HEADER  Pulse,5,'Pulse',DOCODE
        DECD   PSP
        MOV     2(PSP),0(PSP)
        AND     @PSP+,0(TOS)
        XOR     @PSP+,0(TOS)
        MOV     @PSP+,TOS
        NEXT

WORDS
Pulse DINT EINT !LEDS COLD .S DUMP U.R WORDS MARKER FLALIGNED ENVIRONMENT?
DEPTH MOVE WITHIN LEAVE +LOOP LOOP ENDLOOP DO L> >L REPEAT WHILE AGAIN UNTIL BE
GIN ELSE THEN IF POSTPONE ['] ; : IMMEDIATE REVEAL HIDE ] [ RECURSE DOES> (DOES>
) CREATE <BUILDS HEADER ( [CHAR] CHAR ' ABORT" ?ABORT ABORT QUIT EVALUATE INTERP
RET ?NUMBER >NUMBER ?SIGN DIGIT? LITERAL FIND IMMED? NFA>CFA NFA>LFA WORD >COUNT
ED /STRING SOURCE IC, I, IALLOT IHERE C, , ALLOT HERE HEX DECIMAL . U. SIGN #> #
S # >DIGIT <# HOLD UD* UD/MOD IWORD ." S" IS" (S") (IS") ITYPE ICOUNT TYPE ACCEP
T UMAX UMIN SPACES SPACE CR COUNT 2OVER 2SWAP 2DUP 2DROP 2! 2@ MIN MAX */ */MOD
MOD / /MOD * FM/MOD SM/REM M* DABS ?DNEGATE DNEGATE ABS ?NEGATE S>D #INIT UINIT
BL TIBSIZE TIB S0 R0 L0 PAD NEWEST IDP LP HP LATEST 'SOURCE DP STATE BASE >IN U0
,NONE !DEST ,DEST ,BRANCH ,EXIT !COLON ,JMP ,CALL ,CF !CF COMPILE, >BODY CHARS
CHAR+ CELLS CELL+ CELL ALIGNED ALIGN KEY? KEY EMIT N= S= SCAN SKIP I->D CMOVE> C
MOVE FILL UM/MOD UM* UNLOOP J I (+loop) (loop) (do) ?branch branch U> U< > < <>
= 0< 0= RSHIFT LSHIFT 2/ 2* >< 1- 1+ NEGATE INVERT XOR OR AND - M+ AND! OR! +! +
D->I IC@ I@ IC! I! FLERASE C! C@ ! @ TUCK RP! RP@ SP! SP@ R@ R> >R NIP ROT OVER
SWAP DROP ?DUP DUP USER CONSTANT VARIABLE EXIT lit EXECUTE
ok

: Pulses ( Mask Addr Num --)                
    0 DO                        
        2DUP                              
        Pulse                        
    LOOP
    2DROP;

REQUIRE CASE-INS lib\ext\caseins.f

: MREAD-FILE READ-FILE ;
: MC! C! ;
: MC@ C@ ;
: MW! W! ;
: MW@ W@ ;
: M! ! ;
: M@ @ ;
: M+ + ;
: MNEGATE NEGATE ;
: MOVER OVER ;
: MAND AND ;
: MCR CR ;
: MEXECUTE EXECUTE ;
: MVARIABLE VARIABLE ;

REQUIRE >NAME ~mak\LIB\fpc.f
REQUIRE NUMBER? ~mak\LIB\fpcnum.f


TRUE VALUE QUICK
: SL\ POSTPONE \ ; IMMEDIATE

[DEFINED] GUI-CONSOLE
[IF] : FJB GUI-CONSOLE::FlushJetBuf ;
[ELSE] : FJB ;
[THEN]


REQUIRE TC_?LIMIT ~mak\LIB\THERE\STAT.f


MODULE: TC_M
REQUIRE T_@ ~mak\LIB\THERE\mthere.f
;MODULE
REQUIRE TH_H- ~mak\LIB\THERE\RECOM.F

\ REQUIRE CS-! ~mak\ext.f

REQUIRE ASMINF_MOD ~mak\MSP430\SRC\ASMMSP.f

~mak\MSP430\SRC\LEX.F
~mak\MSP430\SRC\prefix.f



\ EOF
\ REQUIRE DISMSP ~mak\MSP430\SRC\DISMSP.f
: M\ POSTPONE \ ; IMMEDIATE
REQUIRE T-START ~mak\MSP430\SRC\tc.f

[IFNDEF] W>S
: W>S ( w -- n ) \ Расширение знакового 16 разрядонго числа до 32 разрядного
0xFFFF AND \ удаляем грязь из старших разрядов
0x8000 XOR 0x8000 - ;
[THEN]


: HH.+ DUP C@ 2 H.R 1+ ;
: INST.+
HH.+ ." " ;

: MINST ( ADDR1 ADDR2 -- ADDR1 ADDR1 )
\ F7_ED
DUP H. 9 EMIT 9 EMIT INST.+
BEGIN 2DUP U>
WHILE \ DUP 7 AND 0= IF CR DUP H. 9 EMIT THEN
INST.+
REPEAT ;


REQUIRE INCLUDED_AL ~mak\LIB\THERE\mlist.f
\ DIS-OPT

0 VALUE ROM-HERE

0 VALUE FID


CREATE FTST 0x2000 ALLOT


CASE-INS ON

0x4000 TO CODE-SIZE

0xFC00 TO T-ORG \ Начальный целевой адрес области кода

T-ORG VALUE MT-ORG
0x5000 TO D-ORG \ Начальный целевой адрес области данных
0x5000 CONSTANT SP0@ \ дно стека данных
0x7F00 CONSTANT RP0@ \ дно стека возвратов
\ CREATE CS-ORG 1 CS-CELLS ALLOT

T-ORG TO INCL-HH

' NOOP TO <PRE>
[DEFINED] DBG_STOP [IF] DBG_STOP [THEN]

CR .( T-ORG=) T-ORG H.

\ S" devel\~mak\MSP430\BLOAD.F" INCLUDED \EOF

T-START

S" devel\~mak\MSP430\ROM.f" INCLUDED
HERE TO ROM-HERE
MCR .( ROM=) HERE T-ORG - .
.( safasfs)
S" F.C" CSAVE
S" F.BIN" TSAVE
S" F.HEX" T-SAVE
\ T-ORG HERE OVER ALSO FORTH - PREVIOUS DISMSP

T-STOP

...
T-START

S" devel\~mak\MSP430\ROM.f" INCLUDED
...

HERE TO ROM-HERE
MCR .( ROM=) HERE T-ORG - .
.( safasfs)
S" F.C" CSAVE
S" F.BIN" TSAVE
S" F.HEX" T-SAVE
\ T-ORG HERE OVER ALSO FORTH - PREVIOUS DISMSP

T-STOP

( DEFER SOME WORDS FOR EASE IN PORTING TO A CROSS ASSEMBLER )
DEFER     CODE-C, '     C, IS     CODE-C, ( X -- )
DEFER     CODE-W, '     W, IS     CODE-W, ( X -- )
...

: save-input ( -- x1 .. xn n ) \ core-ext
    \G The @i{n} entries @i{xn - x1} describe the current state of the
    \G input source specification, in some platform-dependent way that can
    \G be used by @code{restore-input}.
    (save-input) current-input @ swap 1+;

: include  ( ... "file" -- ... ) \ gforth
    \G @code{include-file} the file @var{file}.
    name included;

: require  ( ... "file" -- ... ) \ gforth
    \G @code{include-file} @var{file} only if it is not included already.
    name required;

see code
: code
  header here 8 + cfa, 0 init-asm; ok
  ok
see :
: :
  header (:noname); ok
see 2DUP
Code 2dup
( $402FE3 )  mov     dword ptr 42A6F8 , ebx  \ $89 $1D $F8 $A6 $42 $0
( $402FE9 )  mov     eax , dword ptr 4 [esi]  \ $8B $46 $4
( $402FEC )  mov     edx , dword ptr [esi]  \ $8B $16
( $402FEE )  sub     esi , # 8  \ $83 $EE $8
( $402FF1 )  add     ebx , # 4  \ $83 $C3 $4
( $402FF4 )  mov     dword ptr 4 [esi] , eax  \ $89 $46 $4
( $402FF7 )  mov     dword ptr [esi] , edx  \ $89 $16
( $402FF9 )  mov     edi , dword ptr FC [ebx]  \ $8B $7B $FC
( $402FFC )  jmp     4014A4  \ $E9 $A3 $E4 $FF $FF
end-code
ok

#if !defined(USE_TOS) && !defined(USE_NO_TOS)
#define USE_TOS
#endif

#ifndef USE_FTOS
#ifndef USE_NO_FTOS
#define USE_FTOS
#endif
#endif

#include "../generic/machine.h"
#include <sys/types.h>

/* this calls a dummy function in cacheflush0.S */
/* you can replace it through "./configure arm_cacheflush=<file>" */
/* if you know how to flush the icache on the arm in general, mail me */
#define FLUSH_ICACHE(addr,size) cacheflush(addr,size)
void cacheflush(void *p, size_t size);

#if defined(FORCE_REG) && !defined(DOUBLY_INDIRECT) && !defined(VM_PROFILING)
/*
according to http://mail-index.netbsd.org/port-arm/2003/05/17/0000.html:

R0-R3: argument passing/caller-saved
R4-R10: callee-saved
R12, R14: caller-saved
R11: frame pointer
R13: stack pointer
*/
/* works with gcc-2.95.2 */
#define RPREG asm("r7")
#endif