\ PASM.SEQ    PREFIX & POSTFIX assembler by Robert L. Smith & Tom Zimmer

comment:

  An assembler for the 8086/8088, with both Prefix and Postfix syntax.

  PASM defaults to Prefix notation, but can be switched to F83 style
Postfix notation with the word POSTFIX. To revert back to Prefix notation,
use PREFIX.

  See the file ASSEM.TXT for a further description of the syntax.

comment;

2VARIABLE APRIOR  4 ALLOT

        ' DROP APRIOR ! ' DROP APRIOR 4 + !

: <A;!>         ( A1 A2 --- )           \ Set up assembly instruction
                APRIOR 4 + 2! ;         \ completion function

: <A;>          ( --- )
                APRIOR 2@ EXECUTE       \ perform assembly completion
                APRIOR 4 + 2@ APRIOR 2! \ SET UP FOR NEXT PREVIOUS
                ['] DROP APRIOR 4 + ! ; \ Make it not care if it is redone.

: <RUN-A;>      ( --- )                 \ make sure we complete instruction
                <RUN> <A;> ;              \ at the end of each line.

DEFER A;!       ' <A;!>    IS A;!
DEFER A;        ' <A;>     IS A;
DEFER RUN-A;    ' <RUN-A;> IS RUN-A;

VARIABLE POSTVAR                        \ is this post fix notation?

: PREFIX        ( --- )
                ['] <A;!>    IS A;!
                ['] <A;>     IS A;
                ['] <RUN-A;> IS RUN-A;  POSTVAR OFF ;

: POSTFIX       ( --- )
                ['] EXECUTE  IS A;!
                ['] NOOP     IS A;
                ['] <RUN>    IS RUN-A;  POSTVAR ON ;

PREFIX          \ Default is PREFIX assembler.

: >PRE          R> R> POSTVAR @ >R >R >R PREFIX ;    \ Save and set PREFIX

: PRE>          R> R> R> IF POSTFIX THEN >R >R ;     \ Restore previous FIX

\ The ASSEMBLER follows:
ONLY FORTH ALSO ASSEMBLER DEFINITIONS ALSO


DEFER C,         FORTH ' C,       ASSEMBLER IS C,
DEFER ,          FORTH ' ,        ASSEMBLER IS ,
DEFER HERE       FORTH ' HERE     ASSEMBLER IS HERE

DEFER ?>MARK
DEFER ?>RESOLVE
DEFER ?<MARK
DEFER ?<RESOLVE

HEX

20 CONSTANT MAX_LABELS

CREATE SHORTLABELS MAX_LABELS 4 * ALLOT

: SXBYTE  ( n1 -- n2 )   DUP 80 AND IF FF00 OR THEN ;

: CLEAR_LABELS   ( -- )  SHORTLABELS MAX_LABELS 4 * 0 FILL ;

: CHECKLABEL   ( n -- m ) \ Or abort
     DUP MAX_LABELS 1- U> ABORT"  Bad Label "
     2* 2* SHORTLABELS + ;

: $     ( n1 -- n2 )
     CHECKLABEL DUP @
     IF  @  ELSE  2+ DUP @ SWAP HERE 2+ SWAP !
         DUP 0= IF  HERE 2+ +  THEN
     THEN ;

\ Labels for the Assembler.

: $RESOLVE   ( linkaddr -- )
     @ DUP 0= IF  DROP EXIT  THEN  0
     BEGIN
          + DUP 1- C@ OVER HERE OVER -
          DUP $7F > ABORT" Branch out of range!"
          SWAP 1- C!
          SXBYTE DUP 0=
     UNTIL
     2DROP ;

: $:F           ( N1 --- )
                CHECKLABEL DUP 2+ $RESOLVE  0 OVER 2+ !
                HERE SWAP ! ;

: $:            ( n -- )
                ['] $:F A;! A; ;

: L$            ( --- a1 )              \ Pass a1 to L$:
                0 A; HERE ;

: L$:           ( a1 --- )              \ a1 = addr passed by L$
                A; HERE OVER - SWAP 2- ! ;

comment:
        Use L$ as follows:      \ Usable with JMP or CALL

                JMP L$          \ Does a long jump to L$:
                ...
                ...             \ A bunch of bytes occur between these
                ...             \ instructions
                ...
            L$: MOV X, X        \ Destination of long jump
comment;

\ End of Local Label definitions


FORTH DEFINITIONS

: DOASSEM       ( --- )
                  ['] RUN-A; IS RUN
                0 ['] DROP A;!
                APRIOR 4 + 2@ APRIOR 2!
                ALSO ASSEMBLER ;

' DOASSEM IS SETASSEM

: LABEL         ( NAME --- )            \ Really just a constant addr
                SETASSEM CREATE ;

: CODE          ( NAME --- )
                LABEL -3 DP +! HIDE ;

ASSEMBLER DEFINITIONS

: END-CODE      ['] <RUN> IS RUN
                PREVIOUS A; REVEAL ;

' END-CODE ALIAS C;

\ 8088 Assembler, based on Ray Duncan's Dr. Dobb's article.

: ERROR3        ( --- )
                ['] DROP APRIOR 4 + !   \ Make it not care if it is redone.
                TRUE ABORT"  Illegal Operand "  ;

: ?ORDERERROR   ( F1 --- )
                IF      ['] DROP APRIOR 4 + !
                        TRUE ABORT" Wrong Operand Order! "
                THEN    ;


VARIABLE <#>   VARIABLE <TD>   VARIABLE <TS>   VARIABLE <RD>   VARIABLE <RS>
VARIABLE <W>   VARIABLE <WD>   VARIABLE <OD>   VARIABLE <OS>   VARIABLE <D>
VARIABLE <SP>  VARIABLE <FR>   VARIABLE <AO>   VARIABLE <ND>   VARIABLE <DST>
VARIABLE <SST> VARIABLE <WS>   VARIABLE <ID>

: D>S           ( --- )                 \ Move destination to source.
                <TD> @ <TS> !
                <RD> @ <RS> !
                <OD> @ <OS> ! ;

: ?D>S          ( --- )                 \ Move Dest to Src if postfix
                <TS> @ 0=               \ If no source specified
                POSTVAR @ 0<> AND       \ and we are in postfix mode
                IF      D>S             \ Move destination to source
                THEN    ;

: ?D><S         ( --- )                 \ If no destinatiion specified
                <DST> @                 \ yet, then swap source and dest.
                IF      <TD> <TS> 2DUP @ SWAP @ ROT ! SWAP !
                        <RD> <RS> 2DUP @ SWAP @ ROT ! SWAP !
                        <OD> <OS> 2DUP @ SWAP @ ROT ! SWAP !
                THEN    <DST> OFF ;

: ?<SP>   <SP> @ SP@ - 2- 2/ ;

: <SREG>        ( A1 --- )
                POSTVAR @
                IF      <DST> OFF       \ Only reset dest if postfix
                THEN    <SST> ON
                DUP C@ DUP 0FF = IF DROP ELSE DUP <W> ! <WS> ! THEN
                1+ DUP C@ <TS> !
                1+ C@ <RS> !  <TS> @ 4 = IF ?<SP> 0 > IF <OS> ! THEN THEN ;

: <DREG>        ( A1 --- )
                <DST> ON
                DUP C@ DUP 0FF = IF DROP ELSE DUP <W> !  <WD> ! THEN
                1+ DUP C@ <TD> !  1+ C@ <RD> !  <#> @
                ABORT"  Immediate Data not allowed "
                <TD> @ 4 = IF ?<SP> 0 > IF <OD> ! THEN THEN ;

\ Destination Register processing.

: DREG          CREATE C, C, C, DOES> POSTVAR @
                IF      <SREG>
                ELSE    <DREG>
                THEN    ;

\ Source Register processing.

: SREG          CREATE C, C, C, DOES> POSTVAR @
                IF      <SST> @ IF <DREG> ELSE <SREG> THEN
                ELSE    <SREG>
                THEN    ;

\ Source Register Definitions

\    Reg  Type W        Name          Reg   Type  W        Name
     0    2    0  SREG  AL            0     3     1  SREG  AX
     1    2    0  SREG  CL            1     3     1  SREG  CX
     2    2    0  SREG  DL            2     3     1  SREG  DX
     3    2    0  SREG  BL            3     3     1  SREG  BX
     4    2    0  SREG  AH            4     3     1  SREG  SP
     5    2    0  SREG  CH            5     3     1  SREG  BP
                                                ' BP ALIAS RP
     6    2    0  SREG  DH            6     3     1  SREG  SI
                                      6     3     1  SREG  IP
     7    2    0  SREG  BH            7     3     1  SREG  DI
                                                          
     0    4    -1 SREG  [BX+SI]       0     4     -1 SREG  [SI+BX]
     0    4    -1 SREG  [BX+IP]       0     4     -1 SREG  [IP+BX]
     1    4    -1 SREG  [BX+DI]       1     4     -1 SREG  [DI+BX]
     2    4    -1 SREG  [BP+SI]       2     4     -1 SREG  [SI+BP]
        ' [BP+SI] ALIAS [BP+IP]            ' [SI+BP] ALIAS [IP+BP]
        ' [BP+SI] ALIAS [RP+IP]            ' [SI+BP] ALIAS [IP+RP]
     3    4    -1 SREG  [BP+DI]       3     4     -1 SREG  [DI+BP]
        ' [BP+DI] ALIAS [RP+DI]            ' [DI+BP] ALIAS [DI+RP]
     4    4    -1 SREG  [SI]          5     4     -1 SREG  [DI]
     4    4    -1 SREG  [IP]          7     4     -1 SREG  [BX]
     6    4    -1 SREG  [BP]
           ' [BP] ALIAS [RP]

     0    5    -1 SREG  ES            1     5     -1 SREG  CS
     2    5    -1 SREG  SS            3     5     -1 SREG  DS
                                                      
\ Destination Register Definitions                    

     0    5    -1 DREG  ES,           1     5     -1 DREG  CS,
     2    5    -1 DREG  SS,           3     5     -1 DREG  DS,
                                                 
     0    2    0  DREG  AL,           0     3     1  DREG  AX,
     1    2    0  DREG  CL,           1     3     1  DREG  CX,
     2    2    0  DREG  DL,           2     3     1  DREG  DX,
     3    2    0  DREG  BL,           3     3     1  DREG  BX,
     4    2    0  DREG  AH,           4     3     1  DREG  SP,
     5    2    0  DREG  CH,           5     3     1  DREG  BP,
                                               ' BP, ALIAS RP,
     6    2    0  DREG  DH,           6     3     1  DREG  SI,
                                               ' SI, ALIAS IP,
     7    2    0  DREG  BH,           7     3     1  DREG  DI,
                                                     
     0    4    -1 DREG  [BX+SI],      0     4     -1 DREG  [SI+BX],
     0    4    -1 DREG  [BX+IP],      0     4     -1 DREG  [IP+BX],
     1    4    -1 DREG  [BX+DI],      1     4     -1 DREG  [DI+BX],
     2    4    -1 DREG  [BP+SI],      2     4     -1 DREG  [SI+BP],
     2    4    -1 DREG  [BP+IP],      2     4     -1 DREG  [IP+BP],
     3    4    -1 DREG  [BP+DI],      3     4     -1 DREG  [DI+BP],
     4    4    -1 DREG  [SI],         5     4     -1 DREG  [DI],
          ' [SI], ALIAS [IP],
     6    4    -1 DREG  [BP],         7     4     -1 DREG  [BX],
          ' [BP], ALIAS [RP],

\ Miscellaneous Operators
: TS@     <TS> @ ;
: TD@     <TD> @ ;
: RD@     <RD> @ ;
: RS@     <RS> @ ;
: +D      <D> @ 2* + ;
: +W      <W> @ + ;
: +RD     <RD> @ + ;
: +RS     <RS> @ + ;
: MOD1    3F AND 40 OR ;
: MOD2    3F AND 80 OR ;
: MOD3    3F AND C0 OR ;
: RS0    <RS> @ 8 * ;
: RSD    RS0 +RD ;
: MD,    RS0 6 + C, ;
: MS,    RD@ 8 * 6 + C, ;
: RDS    RD@ 8 * +RS ;
: CXD,   C@ MOD3 +RD C, ;
: CXS,   C@ MOD3 +RS C, ;

\ Equates to Addressing Modes

0 CONSTANT DIRECT       1 CONSTANT IMMED     2 CONSTANT REG8
3 CONSTANT REG16        4 CONSTANT INDEXED   5 CONSTANT SEGREG

\ Initialize all variables and flags

: RESET   0 <#> !   0 <W> !   0 <OS> !  0 <RD> !
          0 <TD> !  0 <TS> !  0 <OD> !  0 <SP> !
          0 <D> !   0 <WD> !  0 <RS> !  0 <FR> !  0 <ND> !
          0 <DST> ! 0 <SST> ! 0 <WS> !  0 <ID> !  ;

: REG?     REG8 OVER = SWAP REG16 = OR ;

: DREG?   TD@ REG? ;

: ADREG?  DREG? RD@ ( 3 AND ) 0= AND ;

: ASREG?  TS@ REG? RS@ ( 3 AND ) 0= AND ;

: SUBREG  C@ 38 AND ;

: +S,     <AO> @
               IF OVER 80 + 100 U< IF 2 OR C, C, ELSE C, , THEN
               ELSE C, , THEN ;

\ Init. Direction Pointer

: DSET    TS@ DUP INDEXED = SWAP DIRECT = OR NEGATE <D> ! ;

: DT      1 <D> ! ;    \ Set Direction Flag True.

: OFFSET8,     HERE 1+ - DUP ABS OVER 0< + 7F >
               ABORT"  Address out of range "  C, ;

: OFFSET16,    HERE 2+ - , ;

\ Calculate and store displacement for MEM/REG Instructions.

: DISP,   <D> @ IF <OS> ELSE <OD> THEN @ DUP
                IF DUP ABS 7F > IF SWAP MOD2 C, , ELSE SWAP MOD1 C, C, THEN
                ELSE DROP DUP 7 AND 6 = IF MOD1 C, 0 THEN C, THEN ;

\ Calculate the M/R 2nd operator byte

: M/RS,   38 AND TS@
          CASE DIRECT  OF 6 + C, ,                   ENDOF
             REG8    OF C0 + +RS C,                  ENDOF
             REG16   OF C0 + +RS C,                  ENDOF
             INDEXED OF <OS> @ 0= RS@ 6 <> AND
                        IF      +RS C,
                        ELSE    <OS> @ 80 + 100 U<
                                IF      40 + +RS C, <OS> @ C,
                                ELSE    80 + +RS C, <OS> @ ,
                                THEN
                        THEN                         ENDOF
             ERROR3                                    ENDCASE
          ;

: M/RD,         ( ? --- ) D>S M/RS, ;

: 8/16,   <W> @ IF , ELSE C, THEN ;

\ Words to build the instructions:

: 1MIF          ( A1 --- )
                C@ C, RESET ;           \ Single Byte Inst.

: 1MI     CREATE C, DOES> ['] 1MIF A;! A; ;

: 1AMIF        ( A1 --- )               \ AX LODS or AX STOS
                C@ +W C, RESET ;           \ Single Byte Inst.

: 1AMI     CREATE C, DOES> ['] 1AMIF A;! A; ;

: 2MIF          ( A1 --- )
                C@ C, OFFSET8, RESET ;  \ Cond Jumps, Loops

: 2MI     CREATE C, DOES> ['] 2MIF A;! A; ;

: 3MI     CREATE C, DOES> C@ C, ;                       \ Segment Over-ride

: 4MIF          ( A1 --- )
                ?D>S TS@                \ Reg. Push and Pop
          CASE
                SEGREG OF C@ RS@ 8 * + C,      ENDOF     \ SEGMENT
                REG16  OF 1+ C@ +RS C,         ENDOF       \ REGISTER
                REG8   OF ERROR3               ENDOF       \ 8 BIT ILLEGAL
                       DROP 2+ C@ DUP C,
                       30 AND M/RS,
                                               ENDCASE    \ MEMORY
          RESET ;

: 4MI     CREATE C, C, C, DOES> ['] 4MIF A;! A; ;

: 5MIF          ( A1 --- )
                ?D>S TS@                        \ Iseg. Jump, Call
          CASE DIRECT  OF   <ND> @
                            IF   0FF C, C@ <FR> @
                                 IF  8 +  THEN  M/RS,
                            ELSE <FR> @
                                 IF  2+ C@ C, , ,
                                 ELSE  OVER HERE 3 + - 80 + 100 U<
                                         OVER C@ 20 = AND
                                         <WD> @ 0= AND
                                         IF  DROP 0EB C, OFFSET8,
                                         ELSE 1+ C@ C, OFFSET16,
                                         THEN
                                 THEN
                            THEN                                ENDOF
             REG16   OF     0FF C, CXS,                         ENDOF
             INDEXED OF     DSET 0FF C, C@ <FR> @
                            IF  8 +  THEN  +RS DISP,            ENDOF
             ERROR3                                             ENDCASE
          RESET ;

: 5MI     CREATE C, C, C, DOES> ['] 5MIF A;! A; ;

: 6MIF          ( A1 --- )      \ IN and OUT
                DUP C@ 2 AND            \ IN or OUT?
                IF      <WS> @          \ This is an OUT
                        ADREG? ?ORDERERROR
                ELSE    <WD> @          \ This is an IN
                        ASREG? ?ORDERERROR
                THEN    SWAP <ID> @     \ WAS THERE IMMEDIATE DATA ?
                IF         C@ + ( +W ) C, C,
                ELSE    1+ C@ + ( +W ) C,
                THEN    RESET ;


: 6MI     CREATE C, C, DOES> ['] 6MIF A;! A; ;

\ ADC, ADD, AND, etc.

: 7MIF          ( A1 --- )
                DUP 1+ C@ 1 AND <AO> !
          TS@ IMMED =
          IF ADREG?
               IF 2+ C@ +W C, TD@ REG8 = IF C, ELSE , THEN
               ELSE DUP 1+ C@ FE AND +W ROT >R  \ Save IMMEDiate data
                    <AO> @
                    IF  R@ 80 + 100 U<
                         IF     2 OR C, C@ M/RD, R@ C,
                         ELSE        C, C@ M/RD, R@ ,
                         THEN
                    ELSE             C, C@ M/RD, R@ 8/16,
                    THEN   r>drop              \ Clean Return stack
               THEN
          ELSE C@ TS@ REG?
               IF +W C, RS@ 8 * M/RD,
               ELSE 84 OVER - IF 2 OR THEN +W C, TD@ REG?
                    IF RD@ 8 * M/RS, ELSE ERROR3 THEN
               THEN
          THEN RESET ;

: 7MI     CREATE C, C, C, DOES> ['] 7MIF A;! A; ;

: 8MIF          ( A1 --- )
                ?D>S
                DUP 1+ C@ +W C, C@ M/RS, RESET ;

: 8MI     CREATE C, C, DOES> ['] 8MIF A;! A; ;

: 9MIF          ( A1 --- )
                <DST> @ 0=
                IF      1 <DST> ! ?D><S
                        1 <TS> ! 1 <SST> !      \ : #  1 <TS> !  1 <SST> ! ;
                        1 SWAP  <W> @ <WD> !
                ELSE    POSTVAR @               \ If postfix, reverse
                        IF      ?D><S           \ the operands
                                <WS> @ <WD> !   \ Correct word mode
                        THEN
                THEN
                DUP 1+ C@ <WD> @ +
          TS@ 1 > IF 2+ C, ELSE C, NIP THEN  C@ M/RD, RESET ;

: 9MI           CREATE C, C, DOES> ['] 9MIF A;! A; ;

: 10MIF         ( A1 --- )
                DUP 1+ C@ C, C@ C, RESET ;

: 10MI          CREATE C, C, DOES> ['] 10MIF A;! A; ;

: 11MIF         ( A1 --- )
                ?D>S TS@ REG? <W> @ 0<> AND
                IF C@ +RS C, ELSE 1+ C@ FE +W C, M/RS, THEN RESET ;

: 11MI          CREATE C, C, DOES> ['] 11MIF A;! A; ;

: 12MIF         ( A1 --- )
                DROP                    \ MOV Instruction
            TD@ SEGREG = IF 8E C,  RD@ 8 * M/RS,   ELSE
            TS@ SEGREG = IF 8C C,  RS@ 8 * M/RD,   ELSE
            TS@ IMMED = TD@ REG? AND
                IF 16 +W 8 * +RD C, 8/16,          ELSE
            TS@ 0= TD@ 0= OR ADREG? ASREG? OR AND
                IF A0 +W TS@ IF 2+ THEN C, , ( 8/16, ) ELSE
            TS@ IMMED = IF C6 +W C, >R 0 M/RD, R> 8/16, ELSE
            88 +W TD@ REG?
                        IF 2+ C, RD@ 8 * M/RS,      ELSE
            TS@ REG? IF C, RS@ 8 * M/RD, ELSE ERROR3    THEN THEN THEN THEN
                                                        THEN THEN THEN
          RESET ;

: 12MI    CREATE DOES> ['] 12MIF A;! A; ;

: 13MIF         ( A1 --- )
                DROP    TS@ REG? TD@ REG? AND   \ Both are registers
                        RS@ 0= RD@ 0= OR AND    \ Either register is AX
                        <W> @ 1 = AND           \ And it is AX not AL.
        IF      RS@ 0=
                IF      RD@
                ELSE    RS@
                THEN    90 + C,
        ELSE    86 +W             \ XCHG Instruction
          TS@ REG? 0=
              IF TD@ REG? 0=
                   IF   ERROR3
                   ELSE C,
                        RD@ 8 * M/RS,
                   THEN
              ELSE C, RS@ 8 * M/RD,
              THEN
        THEN    RESET ;

: 13MI    CREATE DOES> ['] 13MIF A;! A; ;

: 14MIF         ( A1 --- )
                C@ C, TD@ REG?
              IF RD@ 8 * M/RS, ELSE ERROR3 THEN RESET ;

: 14MI    CREATE C, DOES> ['] 14MIF A;! A; ;

: 15MIF         ( A1 --- )
                DROP DUP 3 =
          IF DROP CC C, ELSE CD C, C, THEN RESET ;

: 15MI    CREATE DOES> ['] 15MIF A;! A; ;

\ Now let's create the actual instructions.

37        1MI   AAA      FC        1MI   CLD
D5 0A    10MI   AAD      FA        1MI   CLI
D4 0A    10MI   AAM      F5        1MI   CMC
3F        1MI   AAS      3C 81 38  7MI   CMP
14 81 10  7MI   ADC      A6        1MI   CMPSB
04 81 00  7MI   ADD      A7        1MI   CMPSW
24 80 20  7MI   AND      99        1MI   CWD
9A E8 10  5MI   CALL     27        1MI   DAA
98        1MI   CBW      2F        1MI   DAS
F8        1MI   CLC      08 48    11MI   DEC

F6 30     8MI   DIV      73        2MI   JAE
F4        1MI   HLT      72        2MI   JB
F6 38     8MI   IDIV     76        2MI   JBE
F6 28     8MI   IMUL     72        2MI   JC
EC E4     6MI   IN       E3        2MI   JCXZ
00 40    11MI   INC      74        2MI   JE
         15MI   INT      7F        2MI   JG
CE        1MI   INTO     7D        2MI   JGE
CF        1MI   IRET     7C        2MI   JL
77        2MI   JA       7E        2MI   JLE

EA E9 20  5MI   JMP      7F        2MI   JNLE
76        2MI   JNA      71        2MI   JNO
72        2MI   JNAE     7B        2MI   JNP
73        2MI   JNB      79        2MI   JNS
77        2MI   JNBE     75        2MI   JNZ
73        2MI   JNC      70        2MI   JO
75        2MI   JNE      7A        2MI   JP
7E        2MI   JNG      7A        2MI   JPE
7C        2MI   JNGE     7B        2MI   JPO
7D        2MI   JNL      78        2MI   JS

74        2MI   JZ       E0        2MI   LOOPNE
9F        1MI   LAHF     E0        2MI   LOOPNZ
C5       14MI   LDS      E1        2MI   LOOPZ
8D       14MI   LEA               12MI   MOV
C4       14MI   LES      A4        1MI   MOVSB
F0        1MI   LOCK     A5        1MI   MOVSW  A5      1MI   MOVS
AC        1MI   LODSB    F6 20     8MI   MUL    AC      1AMI  LODS
AD        1MI   LODSW    F6 18     8MI   NEG
E2        2MI   LOOP     90        1MI   NOP
E1        2MI   LOOPE    F6 10     8MI   NOT

0C 80 08  7MI   OR       F2        1MI   REPNE
EE E6     6MI   OUT      F2        1MI   REPNZ
8F 58 07  4MI   POP      F3        1MI   REPZ
9D        1MI   POPF     C3        1MI   RET
                         CB        1MI   RETF
FF 50 06  4MI   PUSH     D0 00     9MI   ROL
9C        1MI   PUSHF    D0 08     9MI   ROR
D0 10     9MI   RCL      9E        1MI   SAHF
D0 18     9MI   RCR      D0 38     9MI   SAR
F3        1MI   REP      1C 81 18  7MI   SBB
F3        1MI   REPE     AE        1MI   SCASB

AF        1MI   SCASW    AB        1MI   STOSW  AA      1AMI   STOS
D0 20     9MI   SAL      2C 81 28  7MI   SUB
D0 20     9MI   SHL      A8 F6 84  7MI   TEST
D0 28     9MI   SHR      9B        1MI   WAIT
F9        1MI   STC               13MI   XCHG
FD        1MI   STD      D7        1MI   XLAT
FB        1MI   STI      34 80 30  7MI   XOR
AA        1MI   STOSB    \               ESC

\ Segment over-ride commands:
26        3MI   ES:
2E        3MI   CS:
36        3MI   SS:
3E        3MI   DS:

: FAR     1 <FR> ! ;

: BYTE    0 <W> !   0 <WD> ! ;

: WORD    1 <W> !   1 <WD> ! ;

: #       1 <TS> ! -1 <SST> ! 1 <ID> ! ;

: #)      ( ?D><S ) -1 <SST> !   \ Swap source and dest if no dest spec'ed.
          1 <W> ! ;                \ Default to word mode

: []      0 <W> !  1 <ND> ! ;

: 3*      DUP 2* + ;

\ MACROS for NEXT, 1PUSH, and 2PUSH.

VARIABLE INLN           \ Flag to determine if we are compiling IN_LINE next.

: INLINEON      INLN ON ;
: INLINEOFF     INLN OFF ;      INLINEOFF       \ Default to NO INLINE NEXT.

: NEXT          ( -- )
                >PRE    INLN @
                IF      LODSW ES: JMP AX    A;
                ELSE              JMP >NEXT A;
                THEN    PRE> ;

: 1PUSH         ( -- )
                >PRE    INLN @
                IF      PUSH AX LODSW ES: JMP AX       A;
                ELSE                      JMP >NEXT 1- A;
                THEN    PRE> ;

: 2PUSH         ( -- )
                >PRE    INLN @
                IF      PUSH DX PUSH AX LODSW ES: JMP AX       A;
                ELSE                              JMP >NEXT 2- A;
                THEN    PRE> ;

: A?>MARK    ( -- f addr ) TRUE   HERE   0 C,   ;
: A?>RESOLVE ( f addr -- ) HERE OVER 1+ - SWAP C! ?CONDITION ;
: A?<MARK    ( -- f addr ) TRUE   HERE   ;
: A?<RESOLVE ( f addr -- ) HERE 1+ -  C,   ?CONDITION   ;
' A?>MARK    ASSEMBLER IS ?>MARK
' A?>RESOLVE ASSEMBLER IS ?>RESOLVE
' A?<MARK    ASSEMBLER IS ?<MARK
' A?<RESOLVE ASSEMBLER IS ?<RESOLVE

HEX

75 CONSTANT 0=   74 CONSTANT 0<>   79 CONSTANT 0<
78 CONSTANT 0>=  7D CONSTANT <     7C CONSTANT >=
7F CONSTANT <=   7E CONSTANT >     73 CONSTANT U<
72 CONSTANT U>=  77 CONSTANT U<=   76 CONSTANT U>
71 CONSTANT OV   E3 CONSTANT CX<>0

DECIMAL

HEX

: IF      >R A; R> C,   ?>MARK  ;
: THEN    A; ?>RESOLVE   ;
: ELSE    0EB IF   2SWAP   THEN   ;
: BEGIN   A; ?<MARK   ;
: UNTIL   >R A; R> C,   ?<RESOLVE   ;
: AGAIN   0EB UNTIL   ;
: WHILE   IF   ;
: REPEAT  A; 2SWAP   AGAIN   THEN   ;
\ : DO      MOV # CX HERE   ;

FORTH DEFINITIONS

: INLINE        [COMPILE] [ SETASSEM HERE X, ; IMMEDIATE

ASSEMBLER DEFINITIONS

: END-INLINE    [ ASSEMBLER ] END-CODE ] ;

COMMENT:
        \ Here is an example of how to use INLINE and END-INLINE to add
        \ assembly code in the middle of a CODE definition.

        : TEST  ( --- )
                5 0
                DO I
                        INLINE
                                pop ax
                                add ax, # 23
                                1push
                        END-INLINE
                        .
                LOOP ;
COMMENT;

ONLY FORTH DEFINITIONS ALSO

DECIMAL