home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / FFA.ZIP / PASM.SEQ < prev    next >
Encoding:
Text File  |  1987-12-31  |  22.3 KB  |  647 lines
  1. \ PASM.SEQ    PREFIX & POSTFIX assembler by Robert L. Smith & Tom Zimmer
  2.  
  3. comment:
  4.  
  5.   An assembler for the 8086/8088, with both Prefix and Postfix syntax.
  6.  
  7.   PASM defaults to Prefix notation, but can be switched to F83 style
  8. Postfix notation with the word POSTFIX. To revert back to Prefix notation,
  9. use PREFIX.
  10.  
  11.   See the file ASSEM.TXT for a further description of the syntax.
  12.  
  13. comment;
  14.  
  15. 2VARIABLE APRIOR  4 ALLOT
  16.  
  17.         ' DROP APRIOR ! ' DROP APRIOR 4 + !
  18.  
  19. : <A;!>         ( A1 A2 --- )           \ Set up assembly instruction
  20.                 APRIOR 4 + 2! ;         \ completion function
  21.  
  22. : <A;>          ( --- )
  23.                 APRIOR 2@ EXECUTE       \ perform assembly completion
  24.                 APRIOR 4 + 2@ APRIOR 2! \ SET UP FOR NEXT PREVIOUS
  25.                 ['] DROP APRIOR 4 + ! ; \ Make it not care if it is redone.
  26.  
  27. : <RUN-A;>      ( --- )                 \ make sure we complete instruction
  28.                 <RUN> <A;> ;              \ at the end of each line.
  29.  
  30. DEFER A;!       ' <A;!>    IS A;!
  31. DEFER A;        ' <A;>     IS A;
  32. DEFER RUN-A;    ' <RUN-A;> IS RUN-A;
  33.  
  34. VARIABLE POSTVAR                        \ is this post fix notation?
  35.  
  36. : PREFIX        ( --- )
  37.                 ['] <A;!>    IS A;!
  38.                 ['] <A;>     IS A;
  39.                 ['] <RUN-A;> IS RUN-A;  POSTVAR OFF ;
  40.  
  41. : POSTFIX       ( --- )
  42.                 ['] EXECUTE  IS A;!
  43.                 ['] NOOP     IS A;
  44.                 ['] <RUN>    IS RUN-A;  POSTVAR ON ;
  45.  
  46. PREFIX          \ Default is PREFIX assembler.
  47.  
  48. : >PRE          R> POSTVAR @ >R >R PREFIX ;     \ Save and set PREFIX
  49.  
  50. : PRE>          R> R> IF POSTFIX THEN >R ;      \ Restore previous FIX
  51.  
  52. \ The ASSEMBLER follows:
  53. ONLY FORTH ALSO ASSEMBLER DEFINITIONS ALSO
  54.  
  55.  
  56. DEFER C,         FORTH ' C,       ASSEMBLER IS C,
  57. DEFER ,          FORTH ' ,        ASSEMBLER IS ,
  58. DEFER HERE       FORTH ' HERE     ASSEMBLER IS HERE
  59.  
  60. DEFER ?>MARK
  61. DEFER ?>RESOLVE
  62. DEFER ?<MARK
  63. DEFER ?<RESOLVE
  64.  
  65. HEX
  66.  
  67. 20 CONSTANT MAX_LABELS
  68.  
  69. CREATE SHORTLABELS MAX_LABELS 4 * ALLOT
  70.  
  71. : SXBYTE  ( n1 -- n2 )   DUP 80 AND IF FF00 OR THEN ;
  72.  
  73. : CLEAR_LABELS   ( -- )  SHORTLABELS MAX_LABELS 4 * 0 FILL ;
  74.  
  75. : CHECKLABEL   ( n -- m ) \ Or abort
  76.      DUP MAX_LABELS 1- U> ABORT"  Bad Label "
  77.      2* 2* SHORTLABELS + ;
  78.  
  79. : $     ( n1 -- n2 )
  80.      CHECKLABEL DUP @
  81.      IF  @  ELSE  2+ DUP @ SWAP HERE 2+ SWAP !
  82.          DUP 0= IF  HERE 2+ +  THEN
  83.      THEN ;
  84.  
  85. \ Labels for the Assembler.
  86.  
  87. : $RESOLVE   ( linkaddr -- )
  88.      @ DUP 0= IF  DROP EXIT  THEN  0
  89.      BEGIN
  90.           + DUP 1- C@ OVER HERE OVER - SWAP 1- C!
  91.           SXBYTE DUP 0=
  92.      UNTIL
  93.      2DROP ;
  94.  
  95. : $:F           ( N1 --- )
  96.                 CHECKLABEL DUP 2+ $RESOLVE  0 OVER 2+ !
  97.                 HERE SWAP ! ;
  98.  
  99. : $:            ( n -- )
  100.                 ['] $:F A;! A; ;
  101.  
  102. \ End of Local Label definitions
  103.  
  104.  
  105. FORTH DEFINITIONS
  106.  
  107. : DOASSEM       ( --- )
  108.                 0 ['] DROP A;!
  109.                   ['] RUN-A; IS RUN
  110.                 ALSO ASSEMBLER ;
  111.  
  112. ' DOASSEM IS SETASSEM
  113.  
  114. : LABEL         ( NAME --- )            \ Really just a constant addr
  115.                 SETASSEM CREATE ;
  116.  
  117. : CODE          ( NAME --- )
  118.                 LABEL -3 DP +! HIDE ;
  119.  
  120. ASSEMBLER DEFINITIONS
  121.  
  122. : END-CODE      ['] <RUN> IS RUN
  123.                 PREVIOUS A; REVEAL ;
  124.  
  125. ' END-CODE ALIAS C;
  126.  
  127. \ 8088 Assembler, based on Ray Duncan's Dr. Dobb's article.
  128.  
  129. : ERROR3        ( --- )
  130.                 ['] DROP APRIOR 4 + !   \ Make it not care if it is redone.
  131.                 TRUE ABORT"  Illegal Operand "  ;
  132.  
  133. VARIABLE <#>   VARIABLE <TD>   VARIABLE <TS>   VARIABLE <RD>   VARIABLE <RS>
  134. VARIABLE <W>   VARIABLE <WD>   VARIABLE <OD>   VARIABLE <OS>   VARIABLE <D>
  135. VARIABLE <SP>  VARIABLE <FR>   VARIABLE <AO>   VARIABLE <ND>   VARIABLE <DST>
  136. VARIABLE <SST> VARIABLE <WS>
  137.  
  138. : D>S           ( --- )                 \ Move destination to source.
  139.                 <TD> @ <TS> !
  140.                 <RD> @ <RS> !
  141.                 <OD> @ <OS> ! ;
  142.  
  143. : ?D>S          ( --- )                 \ Move Dest to Src if postfix
  144.                 <TS> @ 0=               \ If no source specified
  145.                 POSTVAR @ 0<> AND       \ and we are in postfix mode
  146.                 IF      D>S             \ Move destination to source
  147.                 THEN    ;
  148.  
  149. : ?D><S         ( --- )                 \ If no destinatiion specified
  150.                 <DST> @                 \ yet, then swap source and dest.
  151.                 IF      <TD> <TS> 2DUP @ SWAP @ ROT ! SWAP !
  152.                         <RD> <RS> 2DUP @ SWAP @ ROT ! SWAP !
  153.                         <OD> <OS> 2DUP @ SWAP @ ROT ! SWAP !
  154.                 THEN    <DST> OFF ;
  155.  
  156. : ?<SP>   <SP> @ SP@ - 2- 2/ ;
  157.  
  158. : <SREG>        ( A1 --- )
  159.                 POSTVAR @
  160.                 IF      <DST> OFF       \ Only reset dest if postfix
  161.                 THEN    <SST> ON
  162.                 DUP C@ DUP 0FF = IF DROP ELSE DUP <W> ! <WS> ! THEN
  163.                 1+ DUP C@ <TS> !
  164.                 1+ C@ <RS> !  <TS> @ 4 = IF ?<SP> 0 > IF <OS> ! THEN THEN ;
  165.  
  166. : <DREG>        ( A1 --- )
  167.                 <DST> ON
  168.                 DUP C@ DUP 0FF = IF DROP ELSE DUP <W> !  <WD> ! THEN
  169.                 1+ DUP C@ <TD> !  1+ C@ <RD> !  <#> @
  170.                 ABORT"  Immediate Data not allowed "
  171.                 <TD> @ 4 = IF ?<SP> 0 > IF <OD> ! THEN THEN ;
  172.  
  173. \ Destination Register processing.
  174.  
  175. : DREG          CREATE C, C, C, DOES> POSTVAR @
  176.                 IF      <SREG>
  177.                 ELSE    <DREG>
  178.                 THEN    ;
  179.  
  180. \ Source Register processing.
  181.  
  182. : SREG          CREATE C, C, C, DOES> POSTVAR @
  183.                 IF      <SST> @ IF <DREG> ELSE <SREG> THEN
  184.                 ELSE    <SREG>
  185.                 THEN    ;
  186.  
  187. \ Source Register Definitions
  188.  
  189. \    Reg  Type W        Name          Reg   Type  W        Name
  190.      0    2    0  SREG  AL            0     3     1  SREG  AX
  191.      1    2    0  SREG  CL            1     3     1  SREG  CX
  192.      2    2    0  SREG  DL            2     3     1  SREG  DX
  193.      3    2    0  SREG  BL            3     3     1  SREG  BX
  194.      4    2    0  SREG  AH            4     3     1  SREG  SP
  195.      5    2    0  SREG  CH            5     3     1  SREG  BP
  196.                                                 ' BP ALIAS RP
  197.      6    2    0  SREG  DH            6     3     1  SREG  SI
  198.                                       6     3     1  SREG  IP
  199.      7    2    0  SREG  BH            7     3     1  SREG  DI
  200.                                                           
  201.      0    4    -1 SREG  [BX+SI]       0     4     -1 SREG  [SI+BX]
  202.      0    4    -1 SREG  [BX+IP]       0     4     -1 SREG  [IP+BX]
  203.      1    4    -1 SREG  [BX+DI]       1     4     -1 SREG  [DI+BX]
  204.      2    4    -1 SREG  [BP+SI]       2     4     -1 SREG  [SI+BP]
  205.         ' [BP+SI] ALIAS [BP+IP]            ' [SI+BP] ALIAS [IP+BP]
  206.         ' [BP+SI] ALIAS [RP+IP]            ' [SI+BP] ALIAS [IP+RP]
  207.      3    4    -1 SREG  [BP+DI]       3     4     -1 SREG  [DI+BP]
  208.         ' [BP+DI] ALIAS [RP+DI]            ' [DI+BP] ALIAS [DI+RP]
  209.      4    4    -1 SREG  [SI]          5     4     -1 SREG  [DI]
  210.      4    4    -1 SREG  [IP]          7     4     -1 SREG  [BX]
  211.      6    4    -1 SREG  [BP]
  212.            ' [BP] ALIAS [RP]
  213.  
  214.      0    5    -1 SREG  ES            1     5     -1 SREG  CS
  215.      2    5    -1 SREG  SS            3     5     -1 SREG  DS
  216.                                                       
  217. \ Destination Register Definitions                    
  218.  
  219.      0    5    -1 DREG  ES,           1     5     -1 DREG  CS,
  220.      2    5    -1 DREG  SS,           3     5     -1 DREG  DS,
  221.                                                  
  222.      0    2    0  DREG  AL,           0     3     1  DREG  AX,
  223.      1    2    0  DREG  CL,           1     3     1  DREG  CX,
  224.      2    2    0  DREG  DL,           2     3     1  DREG  DX,
  225.      3    2    0  DREG  BL,           3     3     1  DREG  BX,
  226.      4    2    0  DREG  AH,           4     3     1  DREG  SP,
  227.      5    2    0  DREG  CH,           5     3     1  DREG  BP,
  228.                                                ' BP, ALIAS RP,
  229.      6    2    0  DREG  DH,           6     3     1  DREG  SI,
  230.                                                ' SI, ALIAS IP,
  231.      7    2    0  DREG  BH,           7     3     1  DREG  DI,
  232.                                                      
  233.      0    4    -1 DREG  [BX+SI],      0     4     -1 DREG  [SI+BX],
  234.      0    4    -1 DREG  [BX+IP],      0     4     -1 DREG  [IP+BX],
  235.      1    4    -1 DREG  [BX+DI],      1     4     -1 DREG  [DI+BX],
  236.      2    4    -1 DREG  [BP+SI],      2     4     -1 DREG  [SI+BP],
  237.      2    4    -1 DREG  [BP+IP],      2     4     -1 DREG  [IP+BP],
  238.      3    4    -1 DREG  [BP+DI],      3     4     -1 DREG  [DI+BP],
  239.      4    4    -1 DREG  [SI],         5     4     -1 DREG  [DI],
  240.           ' [SI], ALIAS [IP],
  241.      6    4    -1 DREG  [BP],         7     4     -1 DREG  [BX],
  242.           ' [BP], ALIAS [RP],
  243.  
  244. \ Miscellaneous Operators
  245. : TS@     <TS> @ ;
  246. : TD@     <TD> @ ;
  247. : RD@     <RD> @ ;
  248. : RS@     <RS> @ ;
  249. : +D      <D> @ 2* + ;
  250. : +W      <W> @ + ;
  251. : +RD     <RD> @ + ;
  252. : +RS     <RS> @ + ;
  253. : MOD1    3F AND 40 OR ;
  254. : MOD2    3F AND 80 OR ;
  255. : MOD3    3F AND C0 OR ;
  256. : RS0    <RS> @ 8 * ;
  257. : RSD    RS0 +RD ;
  258. : MD,    RS0 6 + C, ;
  259. : MS,    RD@ 8 * 6 + C, ;
  260. : RDS    RD@ 8 * +RS ;
  261. : CXD,   C@ MOD3 +RD C, ;
  262. : CXS,   C@ MOD3 +RS C, ;
  263.  
  264. \ Equates to Addressing Modes
  265.  
  266. 0 CONSTANT DIRECT       1 CONSTANT IMMED     2 CONSTANT REG8
  267. 3 CONSTANT REG16        4 CONSTANT INDEXED   5 CONSTANT SEGREG
  268.  
  269. \ Initialize all variables and flags
  270.  
  271. : RESET   0 <#> !   0 <W> !   0 <OS> !  0 <RD> !
  272.           0 <TD> !  0 <TS> !  0 <OD> !  0 <SP> !
  273.           0 <D> !   0 <WD> !  0 <RS> !  0 <FR> !  0 <ND> !
  274.           0 <DST> ! 0 <SST> ! 0 <WS> ! ;
  275.  
  276. : REG?     REG8 OVER = SWAP REG16 = OR ;
  277.  
  278. : DREG?   TD@ REG? ;
  279.  
  280. : ADREG?  DREG? RD@ ( 3 AND ) 0= AND ;
  281.  
  282. : ASREG?  TS@ REG? RS@ ( 3 AND ) 0= AND ;
  283.  
  284. : SUBREG  C@ 38 AND ;
  285.  
  286. : +S,     <AO> @
  287.                IF OVER 80 + 100 U< IF 2 OR C, C, ELSE C, , THEN
  288.                ELSE C, , THEN ;
  289.  
  290. \ Init. Direction Pointer
  291.  
  292. : DSET    TS@ DUP INDEXED = SWAP DIRECT = OR NEGATE <D> ! ;
  293.  
  294. : DT      1 <D> ! ;    \ Set Direction Flag True.
  295.  
  296. : OFFSET8,     HERE 1+ - DUP ABS OVER 0< + 7F >
  297.                ABORT"  Address out of range "  C, ;
  298.  
  299. : OFFSET16,    HERE 2+ - , ;
  300.  
  301. \ Calculate and store displacement for MEM/REG Instructions.
  302.  
  303. : DISP,   <D> @ IF <OS> ELSE <OD> THEN @ DUP
  304.                 IF DUP ABS 7F > IF SWAP MOD2 C, , ELSE SWAP MOD1 C, C, THEN
  305.                 ELSE DROP DUP 7 AND 6 = IF MOD1 C, 0 THEN C, THEN ;
  306.  
  307. \ Calculate the M/R 2nd operator byte
  308.  
  309. : M/RS,   38 AND TS@
  310.           CASE DIRECT  OF 6 + C, ,                   ENDOF
  311.              REG8    OF C0 + +RS C,                  ENDOF
  312.              REG16   OF C0 + +RS C,                  ENDOF
  313.              INDEXED OF <OS> @ 0= RS@ 6 <> AND
  314.                         IF      +RS C,
  315.                         ELSE    <OS> @ 80 + 100 U<
  316.                                 IF      40 + +RS C, <OS> @ C,
  317.                                 ELSE    80 + +RS C, <OS> @ ,
  318.                                 THEN
  319.                         THEN                         ENDOF
  320.              ERROR3                                    ENDCASE
  321.           ;
  322.  
  323. : M/RD,         ( ? --- ) D>S M/RS, ;
  324.  
  325. : 8/16,   <W> @ IF , ELSE C, THEN ;
  326.  
  327. \ Words to build the instructions:
  328.  
  329. : 1MIF          ( A1 --- )
  330.                 C@ C, RESET ;           \ Single Byte Inst.
  331.  
  332. : 1MI     CREATE C, DOES> ['] 1MIF A;! A; ;
  333.  
  334. : 1AMIF        ( A1 --- )               \ AX LODS or AX STOS
  335.                 C@ +W C, RESET ;           \ Single Byte Inst.
  336.  
  337. : 1AMI     CREATE C, DOES> ['] 1AMIF A;! A; ;
  338.  
  339. : 2MIF          ( A1 --- )
  340.                 C@ C, OFFSET8, RESET ;  \ Cond Jumps, Loops
  341.  
  342. : 2MI     CREATE C, DOES> ['] 2MIF A;! A; ;
  343.  
  344. : 3MI     CREATE C, DOES> C@ C, ;                       \ Segment Over-ride
  345.  
  346. : 4MIF          ( A1 --- )
  347.                 ?D>S TS@                \ Reg. Push and Pop
  348.           CASE
  349.                 SEGREG OF C@ RS@ 8 * + C,      ENDOF     \ SEGMENT
  350.                 REG16  OF 1+ C@ +RS C,         ENDOF       \ REGISTER
  351.                 REG8   OF ERROR3               ENDOF       \ 8 BIT ILLEGAL
  352.                        DROP 2+ C@ DUP C,
  353.                        30 AND M/RS,
  354.                                                ENDCASE    \ MEMORY
  355.           RESET ;
  356.  
  357. : 4MI     CREATE C, C, C, DOES> ['] 4MIF A;! A; ;
  358.  
  359. : 5MIF          ( A1 --- )
  360.                 ?D>S TS@                        \ Iseg. Jump, Call
  361.           CASE DIRECT  OF   <ND> @
  362.                             IF   0FF C, C@ <FR> @
  363.                                  IF  8 +  THEN  M/RS,
  364.                             ELSE <FR> @
  365.                                  IF  2+ C@ C, , ,
  366.                                  ELSE  OVER HERE 3 + - 80 + 100 U<
  367.                                          OVER C@ 20 = AND
  368.                                          <WD> @ 0= AND
  369.                                          IF  DROP 0EB C, OFFSET8,
  370.                                          ELSE 1+ C@ C, OFFSET16,
  371.                                          THEN
  372.                                  THEN
  373.                             THEN                                ENDOF
  374.              REG16   OF     0FF C, CXS,                         ENDOF
  375.              INDEXED OF     DSET 0FF C, C@ <FR> @
  376.                             IF  8 +  THEN  +RS DISP,            ENDOF
  377.              ERROR3                                             ENDCASE
  378.           RESET ;
  379.  
  380. : 5MI     CREATE C, C, C, DOES> ['] 5MIF A;! A; ;
  381.  
  382. : 6MIF          ( A1 --- )              \ IN and OUT
  383.                 DUP C@ 2 AND
  384.                 IF      TD@
  385.                 ELSE    TS@     THEN
  386.         IMMED = IF      C@ +W C, C,
  387.                 ELSE 1+ C@ +W C,        THEN RESET ;
  388.  
  389.  
  390. : 6MI     CREATE C, C, DOES> ['] 6MIF A;! A; ;
  391.  
  392. \ ADC, ADD, AND, etc.
  393.  
  394. : 7MIF          ( A1 --- )
  395.                 DUP 1+ C@ 1 AND <AO> !
  396.           TS@ IMMED =
  397.           IF ADREG?
  398.                IF 2+ C@ +W C, TD@ REG8 = IF C, ELSE , THEN
  399.                ELSE DUP 1+ C@ FE AND +W ROT >R  \ Save IMMEDiate data
  400.                     <AO> @
  401.                     IF  R@ 80 + 100 U<
  402.                          IF     2 OR C, C@ M/RD, R@ C,
  403.                          ELSE        C, C@ M/RD, R@ ,
  404.                          THEN
  405.                     ELSE             C, C@ M/RD, R@ 8/16,
  406.                     THEN   R> DROP              \ Clean Return stack
  407.                THEN
  408.           ELSE C@ TS@ REG?
  409.                IF +W C, RS@ 8 * M/RD,
  410.                ELSE 84 OVER - IF 2 OR THEN +W C, TD@ REG?
  411.                     IF RD@ 8 * M/RS, ELSE ERROR3 THEN
  412.                THEN
  413.           THEN RESET ;
  414.  
  415. : 7MI     CREATE C, C, C, DOES> ['] 7MIF A;! A; ;
  416.  
  417. : 8MIF          ( A1 --- )
  418.                 ?D>S
  419.                 DUP 1+ C@ +W C, C@ M/RS, RESET ;
  420.  
  421. : 8MI     CREATE C, C, DOES> ['] 8MIF A;! A; ;
  422.  
  423. : 9MIF          ( A1 --- )
  424.                 <DST> @ 0=
  425.                 IF      1 <DST> ! ?D><S
  426.                         1 <TS> ! 1 <SST> !      \ : #  1 <TS> !  1 <SST> ! ;
  427.                         1 SWAP  <W> @ <WD> !
  428.                 ELSE    POSTVAR @               \ If postfix, reverse
  429.                         IF      ?D><S           \ the operands
  430.                                 <WS> @ <WD> !   \ Correct word mode
  431.                         THEN
  432.                 THEN
  433.                 DUP 1+ C@ <WD> @ +
  434.           TS@ 1 > IF 2+ C, ELSE C, NIP THEN  C@ M/RD, RESET ;
  435.  
  436. : 9MI           CREATE C, C, DOES> ['] 9MIF A;! A; ;
  437.  
  438. : 10MIF         ( A1 --- )
  439.                 DUP 1+ C@ C, C@ C, RESET ;
  440.  
  441. : 10MI          CREATE C, C, DOES> ['] 10MIF A;! A; ;
  442.  
  443. : 11MIF         ( A1 --- )
  444.                 ?D>S TS@ REG? <W> @ 0<> AND
  445.                 IF C@ +RS C, ELSE 1+ C@ FE +W C, M/RS, THEN RESET ;
  446.  
  447. : 11MI          CREATE C, C, DOES> ['] 11MIF A;! A; ;
  448.  
  449. : 12MIF         ( A1 --- )
  450.                 DROP                    \ MOV Instruction
  451.             TD@ SEGREG = IF 8E C,  RD@ 8 * M/RS,   ELSE
  452.             TS@ SEGREG = IF 8C C,  RS@ 8 * M/RD,   ELSE
  453.             TS@ IMMED = TD@ REG? AND
  454.                 IF 16 +W 8 * +RD C, 8/16,          ELSE
  455.             TS@ 0= TD@ 0= OR ADREG? ASREG? OR AND
  456.                 IF A0 +W TS@ IF 2+ THEN C, , ( 8/16, ) ELSE
  457.             TS@ IMMED = IF C6 +W C, >R 0 M/RD, R> 8/16, ELSE
  458.             88 +W TD@ REG?
  459.                         IF 2+ C, RD@ 8 * M/RS,      ELSE
  460.             TS@ REG? IF C, RS@ 8 * M/RD, ELSE ERROR3    THEN THEN THEN THEN
  461.                                                         THEN THEN THEN
  462.           RESET ;
  463.  
  464. : 12MI    CREATE DOES> ['] 12MIF A;! A; ;
  465.  
  466. : 13MIF         ( A1 --- )
  467.                 DROP    TS@ REG? TD@ REG? AND   \ Both are registers
  468.                         RS@ 0= RD@ 0= OR AND    \ Either register is AX
  469.                         <W> @ 1 = AND           \ And it is AX not AL.
  470.         IF      RS@ 0=
  471.                 IF      RD@
  472.                 ELSE    RS@
  473.                 THEN    90 + C,
  474.         ELSE    86 +W             \ XCHG Instruction
  475.           TS@ REG? 0=
  476.               IF TD@ REG? 0=
  477.                    IF   ERROR3
  478.                    ELSE C,
  479.                         RD@ 8 * M/RS,
  480.                    THEN
  481.               ELSE C, RS@ 8 * M/RD,
  482.               THEN
  483.         THEN    RESET ;
  484.  
  485. : 13MI    CREATE DOES> ['] 13MIF A;! A; ;
  486.  
  487. : 14MIF         ( A1 --- )
  488.                 C@ C, TD@ REG?
  489.               IF RD@ 8 * M/RS, ELSE ERROR3 THEN RESET ;
  490.  
  491. : 14MI    CREATE C, DOES> ['] 14MIF A;! A; ;
  492.  
  493. : 15MIF         ( A1 --- )
  494.                 DROP DUP 3 =
  495.           IF DROP CC C, ELSE CD C, C, THEN RESET ;
  496.  
  497. : 15MI    CREATE DOES> ['] 15MIF A;! A; ;
  498.  
  499. \ Now let's create the actual instructions.
  500.  
  501. 37        1MI   AAA      FC        1MI   CLD
  502. D5 0A    10MI   AAD      FA        1MI   CLI
  503. D4 0A    10MI   AAM      F5        1MI   CMC
  504. 3F        1MI   AAS      3C 81 38  7MI   CMP
  505. 14 81 10  7MI   ADC      A6        1MI   CMPSB
  506. 04 81 00  7MI   ADD      A7        1MI   CMPSW
  507. 24 80 20  7MI   AND      99        1MI   CWD
  508. 9A E8 10  5MI   CALL     27        1MI   DAA
  509. 98        1MI   CBW      2F        1MI   DAS
  510. F8        1MI   CLC      08 48    11MI   DEC
  511.  
  512. F6 30     8MI   DIV      73        2MI   JAE
  513. F4        1MI   HLT      72        2MI   JB
  514. F6 38     8MI   IDIV     76        2MI   JBE
  515. F6 28     8MI   IMUL     76        2MI   JC
  516. EC E4     6MI   IN       E3        2MI   JCXZ
  517. 00 40    11MI   INC      74        2MI   JE
  518.          15MI   INT      7F        2MI   JG
  519. CE        1MI   INTO     7D        2MI   JGE
  520. CF        1MI   IRET     7C        2MI   JL
  521. 77        2MI   JA       7E        2MI   JLE
  522.  
  523. EA E9 20  5MI   JMP      7F        2MI   JNLE
  524. 76        2MI   JNA      71        2MI   JNO
  525. 72        2MI   JNAE     7B        2MI   JNP
  526. 73        2MI   JNB      79        2MI   JNS
  527. 77        2MI   JNBE     75        2MI   JNZ
  528. 73        2MI   JNC      70        2MI   JO
  529. 75        2MI   JNE      7A        2MI   JP
  530. 7E        2MI   JNG      7A        2MI   JPE
  531. 7C        2MI   JNGE     7B        2MI   JPO
  532. 7D        2MI   JNL      78        2MI   JS
  533.  
  534. 74        2MI   JZ       E0        2MI   LOOPNE
  535. 9F        1MI   LAHF     E0        2MI   LOOPNZ
  536. C5       14MI   LDS      E1        2MI   LOOPZ
  537. 8D       14MI   LEA               12MI   MOV
  538. C4       14MI   LES      A4        1MI   MOVSB
  539. F0        1MI   LOCK     A5        1MI   MOVSW  A5      1MI   MOVS
  540. AC        1MI   LODSB    F6 20     8MI   MUL    AC      1AMI  LODS
  541. AD        1MI   LODSW    F6 18     8MI   NEG
  542. E2        2MI   LOOP     90        1MI   NOP
  543. E1        2MI   LOOPE    F6 10     8MI   NOT
  544.  
  545. 0C 80 08  7MI   OR       F2        1MI   REPNE
  546. EE 08     6MI   OUT      F2        1MI   REPNZ
  547. 8F 58 07  4MI   POP      F3        1MI   REPZ
  548. 9D        1MI   POPF     C3        1MI   RET
  549. FF 50 06  4MI   PUSH     D0 00     9MI   ROL
  550. 9C        1MI   PUSHF    D0 08     9MI   ROR
  551. D0 10     9MI   RCL      9E        1MI   SAHF
  552. D0 18     9MI   RCR      D0 38     9MI   SAR
  553. F3        1MI   REP      1C 81 18  7MI   SBB
  554. F3        1MI   REPE     AE        1MI   SCASB
  555.  
  556. AF        1MI   SCASW    AB        1MI   STOSW  AA      1AMI   STOS
  557. D0 20     9MI   SAL      2C 81 28  7MI   SUB
  558. D0 20     9MI   SHL      A4 F6 84  7MI   TEST
  559. D0 28     9MI   SHR      9B        1MI   WAIT
  560. F9        1MI   STC               13MI   XCHG
  561. FD        1MI   STD      D7        1MI   XLAT
  562. FB        1MI   STI      34 80 30  7MI   XOR
  563. AA        1MI   STOSB    \               ESC
  564.  
  565. \ Segment over-ride commands:
  566. 26        3MI   ES:
  567. 2E        3MI   CS:
  568. 36        3MI   SS:
  569. 3E        3MI   DS:
  570.  
  571. : FAR     1 <FR> ! ;
  572.  
  573. : BYTE    0 <W> !   0 <WD> ! ;
  574.  
  575. : WORD    1 <W> !   1 <WD> ! ;
  576.  
  577. : #       1 <TS> ! -1 <SST> ! ;
  578.  
  579. : #)      ( ?D><S ) -1 <SST> !   \ Swap source and dest if no dest spec'ed.
  580.           1 <W> ! ;                \ Default to word mode
  581.  
  582. : []      0 <W> !  1 <ND> ! ;
  583.  
  584. : 3*      DUP 2* + ;
  585.  
  586. \ MACROS for NEXT, 1PUSH, and 2PUSH.
  587.  
  588. VARIABLE INLN           \ Flag to determine if we are compiling IN_LINE next.
  589.  
  590. : INLINEON      INLN ON ;
  591. : INLINEOFF     INLN OFF ;      INLINEOFF       \ Default to NO INLINE NEXT.
  592.  
  593. : NEXT          ( -- )
  594.                 >PRE    INLN @
  595.                 IF      LODSW ES: JMP AX    A;
  596.                 ELSE              JMP >NEXT A;
  597.                 THEN    PRE> ;
  598.  
  599. : 1PUSH         ( -- )
  600.                 >PRE    INLN @
  601.                 IF      PUSH AX LODSW ES: JMP AX       A;
  602.                 ELSE                      JMP >NEXT 1- A;
  603.                 THEN    PRE> ;
  604.  
  605. : 2PUSH         ( -- )
  606.                 >PRE    INLN @
  607.                 IF      PUSH DX PUSH AX LODSW ES: JMP AX       A;
  608.                 ELSE                              JMP >NEXT 2- A;
  609.                 THEN    PRE> ;
  610.  
  611. : A?>MARK    ( -- f addr ) TRUE   HERE   0 C,   ;
  612. : A?>RESOLVE ( f addr -- ) HERE OVER 1+ - SWAP C! ?CONDITION ;
  613. : A?<MARK    ( -- f addr ) TRUE   HERE   ;
  614. : A?<RESOLVE ( f addr -- ) HERE 1+ -  C,   ?CONDITION   ;
  615. ' A?>MARK    ASSEMBLER IS ?>MARK
  616. ' A?>RESOLVE ASSEMBLER IS ?>RESOLVE
  617. ' A?<MARK    ASSEMBLER IS ?<MARK
  618. ' A?<RESOLVE ASSEMBLER IS ?<RESOLVE
  619.  
  620. HEX
  621.  
  622. 75 CONSTANT 0=   74 CONSTANT 0<>   79 CONSTANT 0<
  623. 78 CONSTANT 0>=  7D CONSTANT <     7C CONSTANT >=
  624. 7F CONSTANT <=   7E CONSTANT >     73 CONSTANT U<
  625. 72 CONSTANT U>=  77 CONSTANT U<=   76 CONSTANT U>
  626. 71 CONSTANT OV   E3 CONSTANT CX<>0
  627.  
  628. DECIMAL
  629.  
  630. HEX
  631.  
  632. : IF      C,   ?>MARK  ;
  633. : THEN    ?>RESOLVE   ;
  634. : ELSE    0EB IF   2SWAP   THEN   ;
  635. : BEGIN   ?<MARK   ;
  636. : UNTIL   C,   ?<RESOLVE   ;
  637. : AGAIN   0EB UNTIL   ;
  638. : WHILE   IF   ;
  639. : REPEAT   2SWAP   AGAIN   THEN   ;
  640. \ : DO      MOV # CX HERE   ;
  641.  
  642.  
  643. ONLY FORTH DEFINITIONS ALSO
  644.  
  645. DECIMAL
  646.  
  647.