\ File "Assembler"

FORTH DEFINITIONS

ANEW NASSEMBLER

FORTH DEFINITIONS
DECIMAL

3000 MINIMUM.OBJECT
100 MINIMUM.VOCAB

cr ." Loading Assembler..."


1500  VOCABULARY ASSEMBLER

1500  VOCABULARY LOCAL     LOCAL DEFINITIONS

( save symbol vocaab, use as short term  intermediate vocab )

UNIQUE.MSG OFF

CREATE SAVE.SYMBOL.VOCAB    SYMBOL.VOCAB @ ,

: SYMBOLS  ( SETS SYMBOL TO CONTEXT )
    CONTEXT @ SYMBOL.VOCAB !  ;


: ASSEMBLER.WORDS   ( compile in ASSEMBLER - but search both )
    [COMPILE] LOCAL    SYMBOLS
    [COMPILE] ASSEMBLER DEFINITIONS ;

: LOCAL.WORDS  ( compile in LOCAL - but search both )
    [COMPILE]  ASSEMBLER   SYMBOLS
    [COMPILE]  LOCAL DEFINITIONS  ;


\ Syntax flag, Forth Definitions

LOCAL.WORDS

CREATE OLD.SYNTAX  0 ,

: -OS  OLD.SYNTAX OFF ;


HEX

\ Size/Direction Flags


CREATE (SZMP)   1000 W, 3000 W, 2000 W,
: SIZE ( REUSE USER VARIABLE )  SCRATCH ;
: !SIZE DUP SIZE ! ;

: SZMAP 3 AND 2* (SZMP) + W@ ;

ASSEMBLER.WORDS
    0 CONSTANT BYTE
    1 CONSTANT WORD
    2 CONSTANT LONG

: TO  OLD.SYNTAX ON 0 ;   ( for upward compatibility )
: FROM OLD.SYNTAX ON 1 ;


\ Opcode Manipulation, Registers

LOCAL.WORDS

VARIABLE OPCODE  ( opcode pointer )

: ,OP   ( n -- )    HERE OPCODE ! W, ;
: OP>   ( -- n )    OPCODE @ ;
: @,OP  ( addr -- ) W@ ,OP ;
: OP     ( n -- )   CREATE W,  DOES> @,OP -OS ;
: @OR!    ( n1/n2 -- ) SWAP OVER W@ OR SWAP W! ;
: <OROP   ( n -- )  OP>  @OR! ;

( register defining words )
: DREG  CREATE W, DOES> W@ 0 ;
: AREG  CREATE W, DOES> W@ 1 ;


\ Register definition, Register Tests

ASSEMBLER.WORDS
0 DREG D0  1 DREG D1  2 DREG D2  3 DREG D3  4 DREG D4
5 DREG D5  6 DREG D6  7 DREG D7
0 AREG A0  1 AREG A1  2 AREG A2  3 AREG A3  4 AREG A4
5 AREG A5  6 AREG A6  7 AREG A7

LOCAL.WORDS

\ Register Tests

: ?REG ( reg -- reg ) DUP 7 SWAP < ERROR" NOT A REGISTER" ;

: ?AREG ( reg -- )  1 = not
                    ERROR"  ? EXPECTED AN ADDRESS REGISTER !" ;
: ?DREG ( REG -- )  ERROR"  ? EXPECTED A DATA REGISTER !" ;

: ?SPECIAL.REG  ( -n -- flg  true if 40<=n<=42 )
  NEGATE 40 42 RANGE SWAP DROP ;

: RMODE ( reg/mode -> -rmode )  SWAP ?REG  OR  NEGATE ;


\ Addressing Modes

ASSEMBLER.WORDS
: )+  ?AREG 0 SWAP 18  RMODE ;
: -) ?AREG 0 SWAP 20 RMODE ;
: ()  ?AREG 0 SWAP 10  RMODE ;
: #  -3C ;
: #L  LONG SIZE ! # ;
: #W  WORD SIZE ! # ;
: I)  ?AREG 28 RMODE ;
: @#W  -38 ;
: @#L  -39 ;
: PCI)  -3A ;

\   ALL addressing modes put 2 items on stack
\         Rn      ( -- n / [0] or [1] )
\   ()  )+  -)    ( -- 0 / -rmode )
\   all others    ( -- ext.word / -rmode )

\   where -rmode is the negative of rmode used in opcode


LOCAL.WORDS

: EW ( reg#\reg type\offset\length -- ext word  build ext wd )
    1- DUP 0< ERROR"  BYTE OFST ILLEGAL"   ( index length )
    0B SCALE SWAP  -7F 80 RANGE NOT
    ERROR"   OFFSET OUT OF RANGE" 0FF AND OR  ( offset )
    SWAP  0F SCALE  OR  SWAP  ( a/d ) 0C SCALE OR ( reg# ) ;
    ( Corrected per J. Wood )

: <W, ( n -- append high order word )
    -10 SCALE W, ;

: ?VALID  10 3C RANGE NOT
    ERROR" INVALID ADDRESSING MODE ! " ;


\ Prepare EA

ASSEMBLER.WORDS

: @I)  >R >R EW R> R> ?AREG 30 RMODE ;
: PC@I) EW 3B NEGATE ;
: CCR  0 -40 ;  ( Valid only for MOVE, )
: SR   0 -41 ;  ( Valid only for MOVE, )
: USP  0 -42 ;  ( Valid only for MOVE, )

LOCAL.WORDS

: FIXMODE  ( [ew],[0]or[reg#] \ [reg.flg]or[-rmode]
                            -- [ew/rmode] or [rmode] )
    DUP 0< IF  NEGATE ?VALID DUP 28 < IF SWAP DROP THEN
           ELSE DUP 1 SWAP < IF 38 ELSE 3 SCALE OR THEN
           THEN ;


\  Ea Construction

: ,OPERAND ( EVALUATE AND EMPLACE OPERANDS)
    38 AND 8 /
    DUP 7 = IF OP> W@ 7 AND
      DUP 1 = IF ( ABS LONG) DROP OVER <W, ELSE
      DUP 2 = IF ( PC-REL) DROP SWAP HERE - SWAP ELSE
      4 = IF ( IMMED) SIZE @ 2 = IF OVER <W, THEN
    THEN THEN THEN THEN  4 > IF W, THEN ;

: EA,OP  FIXMODE  DUP  <OROP  ,OPERAND  -OS ;

: EAOP    ( EA )  CREATE W, DOES> @,OP  EA,OP ;

: TOP  ( ea\size -- )
    CREATE W, DOES> @,OP  BYTE LONG RANGE NOT
                ERROR" ? SIZE ERROR !"
                !SIZE 6 SCALE <OROP EA,OP ;


\ Opcode Primitives

: ROP  ( ea\Dn -- REGISTER OPERATION OPCODES)
    CREATE W, DOES> @,OP  WORD SIZE !
    ?DREG ?REG 9 SCALE <OROP EA,OP ;

: OLD.ROMOP  ( REG OPMODE -- SPECIFIED MODE OPCODES )
    !SIZE SWAP ?DREG ROT 2 SCALE OR SWAP
        3 SCALE OR 6 SCALE <OROP EA,OP ;

: ROMOP  ( REG OPMODE -- SPECIFIED MODE OPCODES )
    CREATE W, DOES> @,OP  OLD.SYNTAX @ NOT  IF
    >R DUP IF 2SWAP 1 ELSE 0 THEN 2 BURY R> THEN OLD.ROMOP ;

: SROP  ( data -- IMMEDIATE STATUS REG OPERATORS )
    CREATE W,  DOES> @,OP  W,  -OS ;


\ 68000 Opcodes

ASSEMBLER.WORDS

4E71 OP    NOP,     4E70 OP    RESET,  4E73 OP     RTE,
4E77 OP    RTR,     4E75 OP    RTS,    4E76 OP     TRAPV,
4AFC OP    ILLEGAL,

4EC0 EAOP  JMP,     4E80 EAOP  JSR,    44C0 EAOP   TOCCR,
46C0 EAOP  TOSR,    40C0 EAOP  FROMSR, 4800 EAOP   NBCD,
4840 EAOP  PEA,     4AC0 EAOP  TAS,

D000 ROMOP ADD,     C000 ROMOP AND,    8000 ROMOP  OR,
9000 ROMOP SUB,

4880 TOP   EXT,     4200 TOP   CLR,     4400 TOP   NEG,
4000 TOP   NEGX,    4600 TOP   NOT,     4A00 TOP   TST,

4180 ROP   CHK,     C0C0 ROP   MULU,    C1C0 ROP   MULS,
81C0 ROP   DIVS,    80C0 ROP   DIVU,

023C SROP  ANDCCR,  027C SROP  ANDSR,   0A3C SROP EORCCR,
0A7C SROP  EORSR,   003C SROP  ORCCR,   007C SROP ORSR,
4E72 SROP  STOP,


\  Positive Logic Conditionals

 0200 CONSTANT  HI  0300 CONSTANT  LS
 0400 CONSTANT  CC  0500 CONSTANT  CS
 0600 CONSTANT  NE  0700 CONSTANT  EQ
 0800 CONSTANT  VC  0900 CONSTANT  VS
 0A00 CONSTANT  PL  0B00 CONSTANT  MI
 0C00 CONSTANT  GE  0D00 CONSTANT  LT
 0E00 CONSTANT  GT  0F00 CONSTANT  LE


\   Conditional Opcodes

: BCC,   ( addr\cond  --    Conditional branch opcodes)
    6000 ,OP <OROP   HERE  -  DUP  ABS
    7F  < IF FF  AND <OROP   ELSE  W,  THEN -OS ;

: DBCC,  ( addr\Dn\cond  --  decrement and branch instr)
    50C8 ,OP  <OROP  ?DREG ?REG <OROP  HERE - W, -OS  ;

: SCC,  ( ea\cond -- conditionally set operation)
    50C0 ,OP <OROP  EA,OP ;

: BRA,  0 BCC, ;

: BSR,  100 BCC, ;


\   Assembler Opcode primatives

LOCAL.WORDS

: IOP  ( ea\data\sz  --  IMMEDIATE ALU OPS)
    CREATE W, DOES>  @,OP  DUP !SIZE  6 SCALE  <OROP  2/
    IF , ELSE  W, THEN  EA,OP ;

: AOP  ( ea\An\sz  --  ADDRESS REGISTER MATH)
    CREATE W, DOES>  @,OP  3 AND !SIZE 7 SCALE <OROP
    ?AREG  ?REG  9 SCALE  <OROP  EA,OP  ;

: MOP  @,OP 3 AND !SIZE  6 SCALE SWAP 7 AND
     9 SCALE OR <OROP EA,OP ;

: MSOP  ( ea/Dn/sz  -- handles CMP, EOR, )
    CREATE W, DOES> >R >R ?DREG ?REG R> R> MOP ;

: QOP  ( ea\data\sz   --  handles ADDQ, SUBQ, )
     CREATE W, DOES> 3 PICK 8 > ERROR" DATA TOO LARGE" MOP ;

: MOP1  ( reg reg -- decimal math op@s )
     @,OP 1 AND 3 SCALE <OROP  9 SCALE <OROP DROP
     7 AND <OROP ;       ( TAK Correction )

: DOP  ( srcRn\destRn -- ) CREATE W, DOES> MOP1 -OS ;

: XOP  ( srcRn\destRn\sz --  EXTENDED OPERATIONS)
   CREATE W, DOES> SWAP !SIZE >R MOP1 R> 6 SCALE <OROP -OS ;

: BTOP  ( ea\[bit#] or [Dn] -- BIT MANIPULATION)
   CREATE W, DOES> @,OP
      IF 800 <OROP W,
      ELSE 100 <OROP ?REG 9 SCALE <OROP
      THEN
   EA,OP ;


: IOP2  ( [ea\data\sz] or [data\sp.reg] -- immediate ops)
   CREATE W, DOES> @,OP  DUP ?SPECIAL.REG
    IF   SWAP DROP NEGATE
         CASE 40 ( CCR ) OF 003C  ENDOF
              41 ( SR )  OF 007C  ENDOF
            ERROR" USP DESTINATION INVALID ! "
         ENDCASE <OROP W, -OS
    ELSE DUP !SIZE 6 SCALE <OROP  2/
         IF , ELSE W, THEN EA,OP
    THEN ;

: SOP.REG   20 SWAP 3 AND !SIZE 6 SCALE OR <OROP ?DREG
    ?REG 9 SCALE SWAP ?DREG SWAP ?REG OR <OROP ;

: SOP.IMMED  3 AND 6 SCALE <OROP DROP
    7 AND 9 SCALE SWAP ?DREG SWAP ?REG OR <OROP ;

: SOP.MEM   OP> DUP W@ DUP 18 AND 6 SCALE OR C0 OR
    FFC0 AND SWAP W! EA,OP ;

: SOP ( DR DR SZ  OR DR  CNT # SZ OR EA  -- SHIFT OP@A )
    CREATE W, DOES> @,OP   DUP 0<
      IF SOP.MEM ELSE OVER 0<
        IF SOP.IMMED ELSE SOP.REG THEN
      THEN ;


\   Assembler Special Case OPcodes

ASSEMBLER.WORDS

: CMPM,  ( Aa\Ab\sz -- MEMORY MEMORY COMPARE)
      B108 ,OP  3 AND !SIZE 6 SCALE
      SWAP ?AREG  OR  SWAP ?AREG
      SWAP 9 SCALE  OR  <OROP -OS ;

: EXG,  ( Rx\Ry -- EXCHANGE REGISTERS)
      C100 ,OP  ROT 2DUP   =
       IF  8 OR SWAP DROP
       ELSE   DROP NOT IF SWAP THEN 11
       THEN
      3 SCALE SWAP  ?REG OR SWAP ?REG 9 SCALE OR <OROP -OS ;

: LEA,  ( ea\An\LONG -- Load Effective Address )
      41C0 ,OP DROP ?AREG ?REG 9 SCALE <OROP EA,OP ;

LOCAL.WORDS

: OLDMOVEM, ( EA TO/FROM REGMASK SZ -- LOAD/STORE MULTIPLE REGS )
    4880 ,OP 2 AND 5 SCALE  ROT IF  400 OR THEN
    <OROP W, EA,OP ;

: OLDMOVEP,  ( OFST AREG TO/FROM DR SZ -- MOVE TO/FROM I/O)
    0108 ,OP 2 AND 5 SCALE >R  ?DREG ?REG 9 SCALE R> OR SWAP
    IF 080 OR THEN  SWAP ?AREG SWAP ?REG OR <OROP W, -OS ;

ASSEMBLER.WORDS

: TOUSP,  ( An -- move An to user stack pointer )
    4E60 ,OP ?AREG ?REG <OROP -OS ;

: FROMUSP,  ( An -- move user stack pointer to An  )
    4E68 ,OP ?AREG ?REG <OROP -OS ;

: MOVEP,  ( [offset\An\Dn\sz] or [offset\Dn\An\sz]
          or old syntax [offset\An\TO/FROM\Dn\sz] -- move I/O)
   OLD.SYNTAX @ NOT
    IF OVER IF >R 2SWAP R> 1 ELSE 0 THEN 3 BURY
    THEN OLDMOVEP, ;

: MOVEQ, ( data\Dn -- Quick Register Load )
    7000 ,OP ?DREG ?REG 9 SCALE SWAP FF AND OR <OROP -OS ;

: TRAP,  ( trap# -- trap function )
    0F AND 4E40 OR ,OP -OS ;

: SWAP,  ( Dn -- ) 4840 ,OP ?DREG ?REG <OROP -OS ;

: UNLK,  ( An -- ) 4E58 ,OP ?AREG ?REG <OROP -OS ;

: LINK,  ( disp\An -- ) 4E50 ,OP ?AREG ?REG <OROP W, -OS ;


\  Special MOVE Operators

LOCAL.WORDS

: REGULAR.MOVE,  ( srcEA\destEA\sz -- )
    OVER 1 = OVER 0= AND
        ERROR" BYTE MOVE TO ADDRESS REGISTER ILLEGAL !"
    !SIZE SZMAP >R 0 ,OP 4 ALLOT EA,OP
    OP> W@ DUP 7 AND 6 SCALE SWAP  38 AND OR
    3 SCALE R> OR OP> W!
    HERE >R OP> 2+ DP ! EA,OP R> HERE OP> 6+ =
      IF    DP !
      ELSE  OP> 6+ 2DUP = NOT
            IF DO I W@ W, 2 +LOOP ELSE 2DROP THEN
        THEN -OS ;

: SPECIAL.MOVE, ( [special.reg\ea]  or [ea\special.reg] -- )
    DUP  ?SPECIAL.REG NOT
      IF 2SWAP 1 ELSE 0 THEN  ( tos is direction flag )
    ROT DROP SWAP NEGATE
    CASE
         40 OF  ERROR" FROM CCR - ILLEGAL INSTRUCTION"  TOCCR,  ENDOF
         41 OF  IF FROMSR,    ELSE TOSR,   THEN ENDOF
         42 OF  IF FROMUSP,   ELSE TOUSP,  THEN ENDOF
    ENDCASE ;


ASSEMBLER.WORDS

: MOVE, ( [srcEA\destEA\sz] or [special.reg\ea]  or [ea\special.reg] -- )
    DUP 0<
     IF   SPECIAL.MOVE,
     ELSE DUP 1 >
        IF   REGULAR.MOVE,
        ELSE 3 PICK ?SPECIAL.REG NOT
           IF   REGULAR.MOVE,
           ELSE OVER 0<
              IF   REGULAR.MOVE,
              ELSE SPECIAL.MOVE,
              THEN
          THEN
       THEN
     THEN ;

: MOVEA,  OVER ?AREG REGULAR.MOVE, ;


\   Assembler OP Codes

C100 DOP  ABCD,  8100 DOP SBCD,

D0C0 AOP  ADDA,  B0C0 AOP CMPA,  90C0 AOP SUBA,

0600 IOP  ADDI,  0200 IOP ANDI,  0C00 IOP CMPI,
0A00 IOP  EORI,  0000 IOP  ORI,  0400 IOP SUBI,

5000 QOP  ADDQ,  5100 QOP SUBQ,

D100 XOP  ADDX,  9100 XOP SUBX,

B000 MSOP   CMP,  B100 MSOP  EOR,

E100 SOP   ASL,  E000 SOP  ASR,   E108 SOP LSL,
E008 SOP   LSR,  E118 SOP  ROL,   E018 SOP ROR,
E110 SOP  ROXL,  E010 SOP ROXR,

0040 BTOP BCHG, 0080 BTOP BCLR, 0000 BTOP BTST,
00C0 BTOP BSET,


\ REGLIST stuff

LOCAL.WORDS

-50 CONSTANT REGLIST.ID

: MARKREG  ( reg#\a-d flag\regmask -- sets bit in mask )
    >R 8* + 1 SWAP SCALE I@ OR I! R>DROP ;

: FINAL/ ( addr\cnt -- appends "/" ) + ASCII / SWAP C! ;

: BADLIST  ERROR" INVALID REGLIST STRING " ;

: GET.NEXT.REG  ( regmask\$addr -- )
    1- 2 OVER C!  ' ASSEMBLER @ (FIND) NOT  BADLIST
    DROP EXECUTE ROT MARKREG ;

: REG.RANGE  ( regmask\$addr -- handles register range )
    DUP C@ OVER 3+ C@ = NOT BADLIST ( both Dn or both An )
    DUP 4+ C@ OVER 1+ C@ - 1+      0 DO
    2DUP GET.NEXT.REG  DUP 1+ DUP C@ 1+ SWAP C! LOOP 2DROP ;

: REVERSE.MASK  ( regmask -- reversed mask )  0 10 0 DO
    OVER 1 I SCALE AND IF 1 0F I - SCALE OR THEN   LOOP
    SWAP DROP ;

ASSEMBLER.WORDS

: REGLIST  ( regmask\reglist.id )
   0 LOCALS| REGMASK |
   BL (WORD) PAD OVER C@ 1+ CMOVE ASSEMBLER
   PAD COUNT 2DUP UPPER 2DUP FINAL/ OVER + SWAP
   DO   I 2+ C@
      CASE
         ASCII -   OF   ADDR.OF REGMASK I REG.RANGE    6  ENDOF
         ASCII /   OF   ADDR.OF REGMASK I GET.NEXT.REG 3  ENDOF
         TRUE BADLIST
      ENDCASE
   +LOOP
    REGMASK REGLIST.ID  COMPILING
      IF SWAP [COMPILE] LITERAL [COMPILE] LITERAL THEN ;

  IMMEDIATE


\ MOVEM,

ASSEMBLER.WORDS

: MOVEM,  ( [ea\reglist\size] or [reglist\ea\size] -- )
    { or old syntax: ea\TO/FROM\rlist\sie }
   OLD.SYNTAX @ NOT
     IF >R DUP REGLIST.ID = NOT
          IF 2SWAP 1 ELSE 0 THEN
       >R  REGLIST.ID = NOT   ERROR" SIZE or REGLIST missing ?? "
       OVER ABS 20 27 RANGE   SWAP DROP
          IF REVERSE.MASK THEN
       R> ( direction ) NOT  ( NOT allows for OLDMOVEM, bug )
       SWAP ( bury direction)  R> ( SIZE)
     THEN OLDMOVEM, ;

LOCAL.WORDS

: SHORTBRANCH  ( addr disp -- )  FF AND
    OVER W@ 6000 OR OR SWAP W! ;

: LONGBRANCH  ( addr disp -- )
    FFFF AND   OVER W@ FFFE AND   6000 OR
    3 PICK W!   SWAP 2+  W! ;

: IPATCH ( addr addr -> ) OVER 2+ -
    2DUP  ABS 7F >  SWAP W@ 1 AND BOOLEAN    2DUP XOR
      IF ?DUP NOT ERROR" BRANCH TOO LONG - USE LONG FORM "
          ERROR" BRANCH TOO SHORT - USE SHORT FORM "
      ELSE   DROP
          IF LONGBRANCH ELSE SHORTBRANCH THEN
      THEN ;

ASSEMBLER.WORDS

: IF,       ( COND -> ADDR) HERE SWAP 100 XOR W, ;

: IF.L,     ( COND -> ADDR) HERE SWAP 101 XOR W, 0 W, ;

: ELSE,     ( ADDR -> ADDR) 0 W, HERE IPATCH HERE 2- ;

: ELSE.L,   ( ADDR -> ADDR) 1 W, 0 W, HERE IPATCH HERE 4- ;

: THEN,     ( ADDR -> )     HERE IPATCH ;

: BEGIN,    ( -> ADDR )     HERE ;

: WHILE,    ( COND -> ADDR) IF, ;

: WHILE.L,  ( COND -> ADDR) IF.L, ;

: REPEAT,  ( ADDR ADDR -> )
    HERE  DUP 2+  4 PICK  -  ABS 7F >
      IF 1 W, THEN 0 W, ROT IPATCH HERE IPATCH ;

: UNTIL,   ( ADDR COND ->)
   100 XOR  HERE  2+ 3 PICK  -   ABS 7F >
     IF   1 OR W,   0 W,  HERE 4-
     ELSE   W, HERE 2-
     THEN   SWAP IPATCH ;

( ****** LOOPS TERMINATE AT 0 -> -1 CROSSING  ****** )

: WLOOP,  ( DN -- ) 100  DBCC, ;

: LOOP,   ( DN -- )  01 LONG SUBQ, MI UNTIL, ;


\  Assembler Macro Definitions

: W   D3 ;   : TOS  D4 ;    : TOR D5 ;    : 2OR D6 ;
: IP  A2 ;   : RP   A3 ;    : OBJECT.PTR  A6  ; : SP A7 ;

: PUSH, ( ea --  long at ea into stack)  SP -) LONG MOVE, ;

: WPUSH, ( ea -- word at ea into stack)  SP -) WORD MOVE, ;

: PUT,  ( ea -- long at ea to stack)     SP () LONG MOVE, ;

: POP,  ( ea -- long outof stack to ea)  SP )+ 2SWAP LONG MOVE, ;

: WPOP, ( ea -- word out of stack to ea) SP )+ 2SWAP WORD MOVE, ;

: GET,  ( ea -- long fron stack to ea)   SP () 2SWAP LONG MOVE, ;

: )NEXT  NEXT.PTR - next-a6 - OBJECT.PTR I)  ;

: NEXT   ( address intrepreter )
    IP )+ W WORD MOVE,  W next-a6 WORD A6 @I) JMP,  ;


: END-CODE  ( DEPTH AT START)   CURRENT @ CONTEXT !
          ?EXEC  ?CSP  SMUDGE  ;

: >FORTH ( -- | switch to high level)
        ASSEMBLER  HERE 10 + PCI) IP LONG LEA,  NEXT
        CURRENT @ CONTEXT !  [COMPILE] ] ;


FORTH DEFINITIONS

DECIMAL

: >CODE ( -- | switch to code level)
    HERE 2+ MAKE.TOKEN  W,
    [compile] [  [compile] assembler  ;   immediate

: ENTERCODE (  Begin assembly outside of a colon definition )
      [compile] assembler   !csp  ;

: CODE   ( --- create code definition )  LOCAL
    CREATE -4 ALLOT   SMUDGE  -OS  ENTERCODE ;

: ;CODE   LOCAL  ?CSP COMPILE (;CODE@) HERE 2+ NEW.TOKEN W,
    STATE OFF  -OS  ENTERCODE ;  IMMEDIATE

: M:  ?EXEC [COMPILE]  : [COMPILE] ASSEMBLER ;
  ( for macros -- executes ":" then sets CONTEXT to ASSEMBLER )


LOCAL SAVE.SYMBOL.VOCAB @ SYMBOL.VOCAB !

FORTH DEFINITIONS

 ' LOCAL @ TO.HEAP     ' LOCAL OFF    AXE LOCAL

UNIQUE.MSG ON

DECIMAL