An 80386 Assembler in Forth

John develops an assembler written in Forth that takes advantage of the extended capabilities of the 80386.


October 01, 1988
URL:http://www.drdobbs.com/tools/an-80386-assembler-in-forth/184408009

OCT88: AN 80386 ASSEMBLER IN FORTH

John B. Dilworth is a professor in the Department of Philosophy, Western Michigan University, Kalamazoo, MI 49008, and specializes in Artificial Intelligence research.


The 80386 assembler, written in Forth (Forth-83 Standard), presented in this article will benefit not just Forth programmers, but anyone interested in learning about or using the rich, efficient instruction set and highly versatile address and operand modes of the 80386 microprocessor. The 80386 can be programmed using either a "flat" model of memory organization, in which up to 4 gigabytes of memory are physically addressable as a single array, or the segmented model familiar to 8086 and 80286 programmers (whose code runs unchanged on the 80386). If you then consider the CPU's sophisticated on-chip memory-management, protection, and multi-tasking facilities, and its strategic role in the MS-DOS OS/2 world, you will have a microprocessor that all serious programmers must understand in depth. This assembler is both a helpful learning aid and a useful tool that is easy to modify or enhance.

The assembler implements the full 80386 instruction set, including the privileged instructions available only in protected mode. Thus, it is a complete 80286 and 8086 assembler, since the 80286 instruction set is a proper subset of that of the 80386. As written, you can immediately use this assembler in real, non-protected mode with the popular F83 public domain Forth system of Laxen and Perry. You can easily adapt it to other Forth (or non-Forth) environments, or you could modify it to produce stand-alone object-code files with little difficulty. Because the assembler is written in high-level Forth (no CODE words$, the code itself is portable and non-processor-specific; because the F83 system has been implemented on 8080, 8086, and 68000 systems, the assembler is also a cross assembler when run on such non 80386 processors.

Forth Assemblers

As with other Forth assemblers this assembler would normally be used as a supplement to the resident compiler in a Forth system, whenever speed or other efficiency considerations point to native machine code as the best solution. The resident compiler itself produces threaded Forth code from Forth source which is organized as Forth words in the standard Forth dictionary structure. The assembler produces machine code for the host microprocessor, but also compiles it into the dictionary as the parameter field of a Forth CODE word. This word has a standard Forth header with name, link and code fields. You can then invoke machine-code definitions by name in Forth source code in the same way as ordinary Forth words. CODE words are written in the form

CODE NAME operands + opcode
              ... END-CODE

with the CODE automatically invoking the assembler at compile time and END-CODE terminating it.

You can find this integrated approach to combining high-level and machine-level code constructs in the structure of Forth assembly language itself. In addition to Forth assembly equivalents of the directives, opcodes, and operands of a conventional assembler, the full power of the Forth interpreter is always available for constant and variable definitions, address calculations, procedure definition and invocation, or any special tricks you might want to do while assembling code. Forth equivalents of such high-level constructs as WHILE-DO, REPEAT-UNTIL, and IF-THEN-ELSE are also available (see screen 59, in Listing One, page 60). You may mix these freely with more conventional assembly language forms. One desirable result of this approach is that the labels conventional assemblers use for conditional or unconditional jumps become unnecessary, just as you can eliminate GOTOs in high-level languages by structured-programming techniques.

To make this 80386 assembler as accessible as possible, I have adopted many of Michael Perry's sound, efficient methods, and basic Forth-assembler vocabulary as found in his original 8086 assembler (supplied with the F83 system). However, since the changes involved in moving up from the 8086 to the 80386 are so extensive, I've had to rework virtually every Forth word and introduce many new ones. (The new assembler is over four times the size of the original.) With regret, I have resisted any temptation to optimize for size or speed in favor of a plain, more comprehensible style.

Fortunately the F83 Forth system is well-documented not only by the authors, but also in painstaking detail by C.H. Ting in his book Inside F83 San Mateo, CA: Offete Enterprises, 1986). Thus, if you need more basic details concerning Forth and Forth assembly language than this article provides, you have plenty of good resources available including the selections A Forth Assembler for the 6502, by William F. Ragsdale (pages 203 - 214) and A 68000 Forth Assembler, by Michael A. Perry (pages 193 - 202), both in Dr. Dobb's Toolbox of Forth (Redwood City, CA: M&T Books, 1986).

In this article, I shall concentrate upon the specifics of the 80386 that go beyond those of the 8086, along with the additional Forth structures that you need to implement them. For more general information on software aspects of the 80386 and its instruction set, see Programming the 80386 by John H. Crawford and Patrick P. Gelsinger, (San Francisco, CA: Sybex Inc., 1987) and 80386 Programmer's Reference Manual (Santa Clara, CA: Intel Corp., 1986).

80386 Instruction Assembly

An assembler's job is to translate instruction mnemonics and associated operands into machine code for a specific processor. As shown in Figure 1, page 29, for the 8086, the target or output bytes in the translation comprise--in order of runtime processing and from low to high memory--a possible segment-override prefix byte, 1 - 2 opcode bytes, 0 - 1 ModR/M bytes (described later), 0 - 2 displacement bytes, and 0 - 2 immediate-data bytes. (All of these bytes could additionally be prefixed by one of several repeat prefixes or the LOCK prefix to exclude bus interference by other processors.) Note also that 80x86-series processors store and process either multiple-byte addresses or data with low-order bytes before (at lower addresses than) higher-order, more significant bytes.

The 80x86 ModR/M byte has three fields as shown in Figure 2, on page 29. Most-significant bits 6 and 7 make up a MOD field, which combines with the 3-bit R/M field (least-significant bits) to specify 32 possible values to indicate 1 of 8 registers or 1 of 24 indexing modes. The REG field uses the next 3 bits following the MOD field, and specifies either a register or further opcode information. Its meaning is determined by the opcode byte(s) of the whole instruction. Finally, as already indicated, the 3 least-significant bits make up an R/M field whose interpretation depends on the value in the initial 2-bit MOD field.

As Figure 3 (below) shows the kinds of output bytes that an 80386 assembler produces include all of the 8086 kinds, along with several new or 32-bit-extended varieties. Two new prefixes-- the Address-Size and Operand-Size--are available, which you can use to override the default Use type of a segment (indicating whether it is used for 16-bit or 32-bit code or data) for the specific instruction following the prefix. There are also two extra segment-override prefixes that correspond to the new general-purpose segment registers FS and GS available with the 80386. The remaining new item consists of a possible SIB byte (Scaled Index Base byte, described later) occurring immediately after the ModR/M byte; if present, the SIB byte is signalled by a binary 100 in the R/M field of the ModR/M byte. You can find these 32-bit extensions in the displacement bytes (now 0 -4 bytes) and the immediate-data bytes (also 0 - 4 bytes.)

Figure 1: 8086/286 instruction encoding

Seg Ovrd     Opcode       ModR/M       Disp         Immed
(0-1)           (1-2)           (0-1)           (0-2)        (0-2)

Figure 2: ModR/M and SIB byte

   7    6          5        4     3                      2     1    0
   Mod             Reg/Opcode           R/M

SIB (Scaled Index Base) byte

   7     6          5       4      3                   2     1    0
   Scale              Index           Base

Figure 3: 80386 instruction encoding

AddrSiz  OpndSiz  Seg Ovrd  Opcode  ModR/M    SIB     Disp   Immed
(0-1)           (0-1)      (0-1)       (1-2)         (0-1)     (0-1)   (0-4)   (0-4)

Figure 4: Cases needing SIB byte (R/M = 100)

Mod     Base            Operand                             Forth Example

00      not 101      [base+(scale*index)]                [EAX+ECX] or
                                                            [EAX+ECX] *1
00      101             [disp32+(scale*index)]           234,567 [EAX] *2
01      any             [base+(scale*index)+disp8]       7 [ESP+ECX] or
                                                            7 [ESP+ECX] *1
10      any             [base+(scale*index)+disp32]      89,567 [EDX+ECX] *4

Note: As usual, default segment register is DS: (data segment) for all registers but ESP and EBP, whose default is 55: (stack segment.)

The 80386 SIB byte is needed in those cases when memory operands are too complicated to be represented by a single ModR/M byte as shown in Figure 2. In these cases, a Based Indexed or Scaled Indexed indirect memory mode is required which are the [reg] *x,[reg+reg] and [reg+reg]*x cases in the assembler, as shown in Figure 4, page 30. The relevant information is encoded in three fields of the SIB byte. First, bits 6 and 7 make up the SS field, specifying the scale factor, which is a multiplicative factor that facilitates efficient addressing of offsets for different data sizes. The middle 3-bit field specifies the index register, while the lowest 3 bits give the base register.

Forth Structure and Code Walk-Through

Given the required output or object code byte and bit-field structures specified earlier for an 80386 assembler, let's look at the way this Forth assembler goes about translating input instructions and operands into the required forms. First study Figure 5, page 33, which compares Forth assembler syntax (the 80386-specific parts are my own invention) with the more conventional syntax of nonForth assemblers. Note the mirror image quality of the Forth relative to the conventional syntax: this quality relates to Forth's stack-based postfix mathematical notation (3 + (4 5) is 3 4 5 * + in Forth). Forth assemblers avoid a separate parsing stage for assembly source code by defining all of the operands and opcodes as full fledged Forth words. These words can then be processed by the regular Forth interpreter. (However, you easily can add a separate parse routine as a preprocessor to this assembler if you prefer the conventional syntax.

Operands leave values on the data stack, which are then processed by a Forth opcode word--hence, the need to have the operands before the opcode in the Forth syntax. Source operands precede destination operands, and numeric arguments precede operators within each operand. For example, Figure 5 includes the following case:

6 [EBX] EDX BSF BSF EDX,[EBX] + 6

BSF is a new 80386 instruction that scans forward in the source operand (from bit 0 upwards) to find the first set bit. If a set bit is found, the destination operand is loaded with its bit index (the zero flag is also set). In this case, the source is an indirect memory operand that specifies an address (in the default segment DS) at 6 + the contents of EBX; the destination operand is register EDX.

The Forth interpreter handles this case as follows. The literal constant 6 goes on the Forth stack. Next, the Forth word [EBX] (defined on screen 3) is executed and places the special constant 3611d or E1Bh on the stack, the upper 8 bits of which (00001110b) identity it as a register-indirect constant, and the lower 8 bits (00|011|011b) of which both identity the register and are used via masking to set appropriate values in the corresponding ModR/M or SIB byte fields. (Internally, most assembler calculations are carried out in octal because base 8 is best for representing 3-bit fields.) Next EDX (defined on screen 2), which places its own special constant 2578d = A12h (the upper 8 bits 00001010b defining it as a 32-bit register, the lower 8 | 00|010|010b again defining a masking template) on the stack. As shown in screen 43, everything is now set up for the execution of the Forth opcode word BSF as defined by 19MI:

19MI : CREATE C, DOES> C@
         ONPREFX 17 (octal) C, C,
     OVER REG? (source a reg also?)
           IF RR, ELSE (mem source)
      MEM, THEN WRAP;
HEX (change base) BC 19MI BSF

Figure 5: Forth versus conventional assembler syntax

                                  Forth        Conventional (MASM, etc.)

                                  ECX    DIV   DIV   ECX
                       CX   AX    MOV    MOV   AX,CX
                      ECX  EAX    MOV    MOV   EAX,ECX

                          37 # BX ADD    ADD   BX,37
                123,456 D#    EBX SUB    SUB   EBX,123456

              ADRS32 D#) ECX      BSR    BSR   ECX,ADRS32
                    ES: DX 0 [BX] CMP    CMP   ES:[BX],DX
                      6 [EBX] EDX BSF    BSF   EDX,[EBX]+6
     345,678 [EDX+EAX] *4         PUSH   PUSH  [EDX+EAX*4] + 345678

19MI is a defining word which creates the word BSF, stores in it byte 2 (BCh) of its opcode, and sets it up to use the code after the word DOES> in 19MI itself. This economical and powerful Forth technique is used widely in the assembler, wherever a group of similar words needs to be defined. BSF works as follows: C fetches its stored opcode; ONPREFX stores the opcode in the variable OP; sets a flag (OPSET ON) for a 2-operand opcode; and calls PREFX (screen 22), which invokes ADR PREFX, OPNDPREFX, and SEGOVR? that check the stack contents to see if address, operand, or segment-override prefixes are needed. If they are, BSF then assembles them if necessary. ONPREFX concludes by fetching the stored opcode, which BSF (17 C, C,) assembles after the first opcode byte (octal 17 = Fh.) Note that throughout this and later processing, the algorithms used must ensure that the assembler does not confuse the special constants on the stack with memory displacements or the immediate data also found there. The postfix structure of the stack contents make this straightforward: items nearer the top determine the interpretation of those further down.

Having dealt with prefixes and opcodes, BSF now checks (OVER BEG?) whether the next-to-top source stack item is a register constant; in this case, it is not, so ELSE MEM applies. MEM, (screen 16) organizes the fairly complex series of tests and decisions (screens 11 - 16) required to sort out and assemble. In the present case, MEM32 (screen 15), which handles the disp [REG32] cases, is called RMID OVER RLOW OR sorts out the required fields of the destination and source operands (leaving 00|010| 011b); DOUBLE? tests for a 32-bit displacement; and, after more tests, assembly is completed with the mode-1, byte-displacement code 100 OP, C, which OR's octal 100 (01|000|000b) with the previously formed ModR/M fields to give the complete ModR/M byte 01|010|011b=53h, followed by the 1-byte displacement 6 assembled by C. The complete code assembled is hex 67 66 OF BC 53 06, here 67 and 66 are the address and operand-size prefixes, which are needed because of the 32-bit operations in a 16-bit data segment. OF BC are the required opcode bytes.

Features and Immediate Uses for the 80386

What can you do with the 80386 running in real mode (that is, its default power-up mode) under DOS? Clearly the full power and flexibility of its 32-bit processing requires an operating system designed to support all its features; but in the meantime there are useful enhancements available. For example, one of the pains of working with the segmented 80x86 architecture is not only the 64K segment limitation, but only having one extra segment register (ES) to work with. The new FS and GS segment registers should improve the efficiency of data transfer involving more than two areas.

With the 32-bit registers, another improvement is that you can use any one as a base or index register in indirect memory operations (previously, you could use only BX, BP, SI and DI). Of course, under DOS, you should ensure that you use only valid 16-bit addresses in these operations. The ability to use a scaling factor of 1, 2, 4, or 8 is also valuable in addressing into arrays of different data sizes (byte, word, doubleword, or quadword.) Don't overlook the most basic advantage of being able to manipulate data in 32-bit chunks, rather than manipulating merely 16 bits at a time: this advantage offers a significant speed improvement even within the limitations of DOS's 64K segments. For example, you can add or subtract doubleword integers without register swapping, and some direct 64-bit multiplication and division operations are available.

The instruction set of the 80386 also shows some improvements over those sets of the previous 8086/186/286 processors. Ignoring instructions that only apply to protected and virtual 8086 mode, the following instructions are immediately available for use in real mode. MOVSX and MOVZX move with sign and zeroextend; SET sets a byte on the same range of conditions as the J.. series (such as SETZ, SETNZ); you can use MOV to move to and from the new control, test, and debug registers (CRO, DR0, TR6, and so forth), SHLD and SHRD do double-precision shifts; BSF and BFR scan for a set bit; BT BTC, BTR, and BTS copy a specified bit into the carry flag for testing, while LFS, LGS, and LSS load a full pointer into the corresponding segment register (FS, GS, or SS) and specified 16 or 32-bit destination register. As well as these new instructions, there is also a liberal range of 80286 instructions enhanced to work with 32 bits, including IMUL, stack-related operations PUSHAD, POPAD, PUSHFD, POPFD, and IRETD, string instructions CMPSD, LODSD, MOVSD, SCASD, STOSD, INSD, and OUTSD, and conversion instructions CWDE and CDQ.

Overall, the instruction set and its modes offer a rich and diverse range of new possibilities for programmers to take advantage of.

[LISTING ONE]


SCREEN 0

\ 80386 Assembler                                    10jul88 JBD
\
\                     80386 Assembler
\           Copyright (c) 1988 by John B. Dilworth
\
\ Permission is given to freely use or distribute this program,
\ provided that this entire copyright notice is included on all
\ copies of the source code, or any documentation of the
\ object code.  It is released as 'Shareware'; please remit
\ an appropriate amount, based on usage, for registration,
\ extra documentation, updates, etc., to the author at
\ 133 N. Arlington St., Kalamazoo, MI 49007.
\
\ My thanks to Mike Perry and Henry Laxen, whose public-domain
\  F83 Forth system and 8086 Assembler inspired this program.
\
SCREEN 1

\ 80386 Assembler Load Screen                        10jul88 JBD

: FAF  ONLY FORTH ALSO ASSEMBLER ALSO FORTH ;  FAF
: CODE  CODE FAF ;
\ Above to load on top of F83, 80386 assembler use only.
\ For full use of system, recompile F83 and replace 8086
\ assembler, or set up new Vocabulary for this assembler and
\ redefine CODE etc. to refer to it.

DECIMAL
2 59  THRU  CR .( 80386 Assembler loaded.)
EXIT

SCREEN 2

\ 80386 Assembler   Register, Mode Definitions       10jul88 JBD
OCTAL ( default base)
: REG    ( mode reg# -- )  11 * SWAP 1000 * OR CONSTANT   ;
: REGS   ( n mode -- )   SWAP 0 DO  DUP I REG  LOOP  DROP ;
10 0 REGS   AL  CL  DL  BL  AH  CH  DH  BH
10 1 REGS   AX  CX  DX  BX  SP  BP  SI  DI
10 2 REGS   [BX+SI] [BX+DI] [BP+SI] [BP+DI] [SI] [DI] [BP] [BX]
 4 2 REGS   [SI+BX] [DI+BX] [SI+BP] [DI+BP]
 6 3 REGS   ES  CS  SS  DS  FS GS
 3 4 REGS   #   #)  S#)
10 5 REGS   EAX ECX EDX EBX ESP EBP ESI EDI

: MD   CREATE  1000 * ,  DOES>  @ SWAP 7000 AND = 0<>  ;

0 MD R8?   1 MD R16?   2 MD MEM?   3 MD SEG?
5 MD R32?  6 MD MMI32?  7 MD MEM32?

SCREEN 3

\ DOUBLE, SIZE32, DOUBLE?, REG32, REGS32, SWD, DWD   10jul88 JBD
VARIABLE DOUBLE   VARIABLE SIZE32
: DOUBLE?  DOUBLE @ 0<> ; ( test for 32-bit displacement)

: REG32   ( mode reg# -- )
   11 * SWAP 1000 * OR CREATE  ,
   DOES>  @  ( -- constant )  DPL @ -1 = NOT  ( double word?)
    IF  -1 DOUBLE !  -1 DPL !  ELSE 0 DOUBLE ! THEN ;
: REGS32 ( n mode -- )
   SWAP 0 DO DUP I REG32 LOOP DROP ;
10 7 REGS32   [EAX] [ECX] [EDX] [EBX] [ESP] [EBP] [ESI] [EDI]

: SWD ( 16-bit disp; use to define single-word vars )
   CREATE , DOES>   SIZE ON  SIZE32 OFF ;
: DWD ( 16-bit disp; use to define double-word vars )
   SWAP CREATE , , DOES>  SIZE32 ON ;

SCREEN 4

\ IREG/S, initializing MMI32 regs [EAX+EBX] etc.     10jul88 JBD

: IREG ( base, loop index -- )
   OR 6000 OR  CREATE ,  DOES>  @ ( constant)
   DPL @ -1 = NOT ( double word?)
    IF  -1 DOUBLE !  -1 DPL !  ELSE 0 DOUBLE ! THEN ;

: IREGS ( reg# -- ) ( Init's [EAX+EBX] etc. in SIB format )
   10 *  10 0 DO  DUP  I   IREG  LOOP DROP ;

VARIABLE SPT  ( used in prefix tests)

SCREEN 5

\ IREGS, initializing MMI32 regs [EAX+EBX] etc.      10jul88 JBD
0 IREGS [EAX+EAX] [ECX+EAX] [EDX+EAX] [EBX+EAX]
        [ESP+EAX] [EBP+EAX] [ESI+EAX] [EDI+EAX]
1 IREGS [EAX+ECX] [ECX+ECX] [EDX+ECX] [EBX+ECX]
        [ESP+ECX] [EBP+ECX] [ESI+ECX] [EDI+ECX]
2 IREGS [EAX+EDX] [ECX+EDX] [EDX+EDX] [EBX+EDX]
        [ESP+EDX] [EBP+EDX] [ESI+EDX] [EDI+EDX]
3 IREGS [EAX+EBX] [ECX+EBX] [EDX+EBX] [EBX+EBX]
        [ESP+EBX] [EBP+EBX] [ESI+EBX] [EDI+EBX]
          ( ESP can't be index register)
5 IREGS [EAX+EBP] [ECX+EBP] [EDX+EBP] [EBX+EBP]
        [ESP+EBP] [EBP+EBP] [ESI+EBP] [EDI+EBP]
6 IREGS [EAX+ESI] [ECX+ESI] [EDX+ESI] [EBX+ESI]
        [ESP+ESI] [EBP+ESI] [ESI+ESI] [EDI+ESI]
7 IREGS [EAX+EDI] [ECX+EDI] [EDX+EDI] [EBX+EDI]
        [ESP+EDI] [EBP+EDI] [ESI+EDI] [EDI+EDI]

SCREEN 6

\ SREG, etc.  ( Special registers )                  10jul88 JBD

: SREG ( 13-15th bits + regval -- )  CONSTANT ;

HEX  2000 SREG CR0   2012 SREG CR2   201B SREG CR3
     4000 SREG DR0   4009 SREG DR1   4012 SREG DR2
     401B SREG DR3   4036 SREG DR6   403F SREG DR7
     8036 SREG TR6   803F SREG TR7
OCTAL

: CTL? 20000 AND 0<> ;   ( tests for control, debug, test regs)
: DBG? 40000 AND 0<> ;
: TRG? 100000 AND 0<> ;

: SPL? 160000 AND  0<> ; ( One of bits 13-15 set?)

SCREEN 7

\ Constants, Address modes, Immediate data + tests   10jul88 JBD

: D#   4033  -1 DPL !  ;             ( 32-bit immed. data)
: D#)  4050  0 DOUBLE !  -1 DPL ! ;  ( 32-bit direct mem. disp)
: SD#) 4060  0 DOUBLE !  -1 DPL ! ;
                           ( non-relative 32-bit call/jmp disp)

10000 CONSTANT *1  10100 CONSTANT *2  ( scaling factors)
10200 CONSTANT *4  10300 CONSTANT *8

: #?    # = 0<> ;
: D#?  D# =  0<>  ;

BP CONSTANT RP   [BP] CONSTANT [RP]   ( RETURN STACK POINTER )
SI CONSTANT IP   [SI] CONSTANT [IP]   ( INTERPRETER POINTER )
BX CONSTANT W    [BX] CONSTANT [W]    ( WORKING REGISTER )

SCREEN 8

\ Addressing Modes, etc.                             10jul88 JBD
: REG?    ( n -- f )   DUP 17000 AND 2000 <
   IF ( If 8 or 16-bit reg) DROP -1   ELSE R32? THEN ;

: BIG?   ( n -- f )   ABS -400 AND 0<>  ;
: RLOW   ( n1 -- n2 )    7 AND ;
: RMID   ( n1 -- n2 )   70 AND ;
VARIABLE SIZE   SIZE ON
: BYTE   ( -- )   SIZE OFF ;
: OP,   ( n op -- )   OR C,  ;

: ,/C,  ( n f -- )   IF  ,  ELSE  C,  THEN  ;
: RR,   ( mr1 mr2 -- )   RMID SWAP RLOW OR 300 OP,  ;

VARIABLE LOGICAL
: B/L?   ( n -- f )   BIG? LOGICAL @ OR  ;

SCREEN 9

\ Direct or Indirect Memory (Address size) tests     10jul88 JBD
: #)?  #) = 0<> ;
: D#)?  4050  = 0<> ;
: SD#)? 4060  = 0<> ;
: U#)?  DUP  #)?  SWAP D#)? OR 0<> ;

: SIZE32?   SIZE32  @ 0<> ;

: *? DUP *1 = 1 PICK *2 = OR  1 PICK *4 = OR  ( --reg, flg)
     1 PICK *8 = OR  0<> SWAP DROP ;

: UMEM32? DUP MEM32? SWAP MMI32? OR 0<> ;
: UMEM?   DUP DUP UMEM32? SWAP MEM?
   2 PICK *? OR OR 0<> SWAP DROP  ;

: UMEMA? DUP UMEM? SWAP U#)? OR 0<> ;  ( Any-memory test)

SCREEN 10

\ 32-bit operation words                             10jul88 JBD
VARIABLE USE   USE OFF
: USE?  USE @ 0<> ;
: USE16  USE OFF  SIZE32 OFF  ; ( 386 default segment types)
: USE32  USE ON   SIZE32 ON   ;
: WRAP  USE? IF ( 32-bit) SIZE32 ON ELSE SIZE32 OFF THEN
   SIZE ON ;
( Operand sizes )
: BY     ( -- )   BYTE ;
: WD     ( -- )   SIZE ON SIZE32 OFF ;
: DW     ( -- )   SIZE32 ON  ;

: W,   ( op mr -- )
   DUP R16? 1 AND  SWAP  R32? 1 AND  OR  OP,  ;
: SIZE,   ( op -- op' )
   SIZE @ 1 AND   SIZE32 @ 1 AND  OR  OP,  ;

SCREEN 11

\ MMI32*, ( disp [EAX+EBX] *x cases)                 10jul88 JBD

: MMI32*,   ( disp mr *x rmid -- )  ( mr of [eax+ebx] form)
   DOUBLE? NOT
   IF    ( test for |--|---|101|)   2 PICK
    7 AND 5 = 4 PICK 0= AND ( is it 0 [ebp+reg] case?)
    IF ( --disp mr *x rmid) 104 OP, OR  C,  C,
    ELSE ( any other case; mode 0, 1 or 2) 3 PICK BIG?
     IF  204 OP,  OR  C,  ,  0  ,
     ELSE  3 PICK 0=  ( mode 0?)
      IF ( --disp mr *x rmid) 4 OP, OR C, DROP ( mode 0,no disp)
      ELSE  104 OP, OR C, C, ( mode 1, byte disp) THEN THEN THEN
   ELSE  ( double)  ( --disp mr *x rmid) 204 OP, ( --disp mr *x)
    OR  C, SWAP , ,  ( mode 2, 32-bit disp)   THEN ;

SCREEN 12

\ MEM*, MEM32*;  MEM32 scaling cases, disp [eax] *x  10jul88 JBD
( disp [EAX] *X cases: must code as [disp32+{scale*index}] )

: MEM32*,   ( disp mr *x rmid -- )  ( mr of [eax] form)
   4 OP, ( disp mr *x)
   SWAP ( disp *x mr)  OR ( disp rslt)
   5 OP, ( disp)
   DOUBLE?  IF  SWAP , ,  ELSE  , 0 ,  THEN  ;

 : MEM*, ( disp mr *x rmid -- )
    RMID SWAP 377 AND ( --disp mr rmid *x )  ( 8 bits only)
    SWAP 2 PICK  ( --disp mr *x rmid mr)  MEM32?
    IF    ROT  RMID  -ROT  ( __disp mr *x rmid)   MEM32*,
    ELSE  ROT  377  AND  -ROT   MMI32*,   THEN ;

SCREEN 13

\ MEM#), MEM16, ( all drct mem + 16-bit indrct mem ) 10jul88 JBD

: MEM#),   ( disp mr rmid -- )  OVER #) =   ( direct mem opnd)
   IF  RMID 6 OP, DROP ,  ELSE
    OVER D#)?  IF  RMID 5 OP, DROP SWAP , , THEN THEN  ;

: MEM16,   ( disp mr rmid -- ) ( Original indirect mem cases)
   RMID OVER RLOW OR -ROT [BP] = OVER 0= AND
    IF  SWAP 100 OP, C,  ELSE  SWAP OVER BIG?
     IF  200 OP, ,  ELSE  OVER 0=
      IF  C, DROP  ELSE  100 OP, C,
    THEN THEN THEN  ;

SCREEN 14

\ MMI32, ( disp [EAX+EBX] cases, MMI32? test)        10jul88 JBD
   ( Extra SIB byte needed)

: MMI32,   ( disp mr rmid -- )  ( mr of [eax+ebx] form)
   RMID  DOUBLE? NOT
   IF ( all non-double-disp cases)  OVER ( --disp mr rmid mr)
    7 AND 5 = 3 PICK 0= AND ( is it 0 [ebp+reg] case?)
     IF ( --disp mr rmid) 104 OP,  C, C,
                 ( |01|reg|100|, =[ebp+{scl*indx}+dsp8])
     ELSE  2 PICK BIG? ( > 8 bits? If so, mode 2, 32-bit disp)
      IF 204 OP, C,   ,  0  ,
      ELSE  2 PICK 0=
       IF ( --disp mr rmid) 4 OP, C, DROP ( mode 0, no disp)
       ELSE  104 OP, C, C, ( mode 1, byte disp)  THEN THEN THEN
    ELSE ( double)  204 OP, C, SWAP  , ,   THEN ;

SCREEN 15

\ Addressing: MEM32, (disp [EAX] cases, MEM32? test) 10jul88 JBD

: MEM32,   ( disp mr mr -- )
   RMID OVER RLOW OR    DOUBLE?  NOT
   IF ( all single-disp cases)  -ROT   ( -- rslt disp opnd)
    [EBP] = OVER 0= AND
     IF  ( --rslt, disp) SWAP 100 OP, C, ( mode 1 with 0 disp)
     ELSE  SWAP OVER BIG?    ( larger than 8 bits?)
      IF    200 OP,  ,  0 ,  ( 16-bit case)
      ELSE  OVER 0=
       IF ( --disp, rslt)  C, DROP   ( mode 0, no disp)
       ELSE  100 OP, C, ( mode 1, byte disp) THEN THEN THEN
    ELSE  ( double disp) NIP  200 OP,  SWAP  ,   ,  THEN ;

SCREEN 16

\ Addressing: MEM, ( cases satisfying UMEMA? test)   10jul88 JBD

: MEM,   ( disp ?op mr mr -- )
    OVER U#)? IF MEM#), ELSE
     OVER MEM? IF MEM16, ELSE
      OVER MEM32? IF MEM32, ELSE
       OVER MMI32? IF MMI32, ELSE
        MEM*, THEN THEN THEN THEN ;

SCREEN 17

\ Segment and Segment Override handling              10jul88 JBD
HEX  VARIABLE INTER
: FAR    ( -- )   INTER ON  ;
: ?FAR   ( n1 -- n2 )   INTER @ IF   8 OR  THEN  INTER OFF ;
VARIABLE SOVROP   VARIABLE SOVRFLG    SOVRFLG OFF
: SEGOVR  ( opcode -- ) CREATE C, DOES>
    C@  SOVROP  C!  SOVRFLG  ON  ;
 2E SEGOVR CS:  3E SEGOVR DS:  26 SEGOVR ES:
 36 SEGOVR SS:  64 SEGOVR FS:  65 SEGOVR GS:
: SOVR? SOVRFLG @ 0<> ;
: SEGOVR?  SOVR? IF SOVROP C@ C,  SOVRFLG OFF THEN  ;  OCTAL

: SEG16? ( -- f; is it ES,CS,SS or DS?)   ( 12MI use)
   DUP SEG? IF 40 AND 0= ELSE DROP 0 THEN ;
: SEG32? ( -- f; is it FS or GS?)         ( 12MI use)
   DUP SEG? IF 40 AND 0<> ELSE DROP 0 THEN ;

SCREEN 18

\ Address Prefix handling: APREFX32 etc.             10jul88 JBD
( Handle Adr/Operand-Size 386 Prefixes)

VARIABLE OPSET ( 0 for 1-operand opcodes, 1 for others)
: OPSET? OPSET @ 0<> ;
VARIABLE DUN  0 DUN !   : DUN? DUN @ 0<> ;

: APREFX32 ( ...-...)
   SPT @ PICK DUP DUP  D#)?  SWAP UMEM32? OR SWAP *?  OR
    IF   1 DUN !
    ELSE  SPT @ PICK DUP  DUP MEM? SWAP #)? OR SWAP S#) = OR
     IF 147 C, 1 DUN !  THEN  THEN
   SPT @ 0=  ( move ptr to begn of source opnds)
   OPSET?  AND
    IF ( must be reg ) 1 SPT !  THEN  ;

SCREEN 19

\ Address Prefix handling: APREFX16 etc.             10jul88 JBD

: APREFX16 ( ...-...) ( USE16, 32 bit adr. cases)
   SPT @ PICK DUP  #)?  SWAP MEM?  OR
    IF   1 DUN !   ( no adr-size prefix reqd)
    ELSE  SPT @    PICK DUP  UMEM32? SWAP D#)?   OR ( --..flg)
          SPT @ 1+ PICK DUP  *?      SWAP SD#)?  OR  OR
     IF 147 C, 1 DUN !  THEN  THEN
   SPT @ 0= ( move ptr to begn of sOs opnds)
   OPSET?  AND
    IF ( must be reg) 1 SPT ! THEN ;

SCREEN 20

\ Operand Prefix handling: OPREFX32                  10jul88 JBD

: OPREFX32 ( ...--...)  ( USE32, but 16-bit opnds?)
   SPT @ PICK  DUP  D#?  SWAP R32?  OR
    IF   1 DUN !
    ELSE  SPT @ PICK DUP  R16? SWAP #?  OR
     IF 146 C, 1 DUN !  THEN  THEN
   SPT @ 0=  ( move ptr to begn of source opnds)
   OPSET?  AND
    IF DUP  REG? IF 1 SPT !  THEN
     DUP DUP  MEM?  SWAP #)?  OR  IF 2 SPT !  THEN
     DUP D#)?  IF 3 SPT !  THEN
     DUP UMEM32? IF DOUBLE? IF 3 SPT ! ELSE 2 SPT ! THEN THEN
     DUP   *?   IF DOUBLE? IF 4 SPT ! ELSE 3 SPT ! THEN THEN
    THEN ;

SCREEN 21

\ Operand Prefix handling: OPREFX16                  10jul88 JBD

: OPREFX16 ( ...--...) ( USE16,  but 32 bit operands?)
   SPT @ PICK DUP  #?  SWAP R16?  OR
    IF   1 DUN !   ( no opnd-size prefix required)
     ELSE  SPT @ PICK DUP  R32?  SWAP D#?  OR
    IF 146 C, 1 DUN !  THEN  THEN
   SPT @ 0= ( move ptr to begn of source opnds)
   OPSET?  AND
    IF DUP  REG? IF 1 SPT !  THEN
     DUP DUP  MEM?  SWAP #)?  OR  IF 2 SPT !  THEN
     DUP D#)?  IF 3 SPT !  THEN
     DUP UMEM32? IF DOUBLE? IF 3 SPT ! ELSE 2 SPT ! THEN THEN
     DUP   *?   IF DOUBLE? IF 4 SPT ! ELSE 3 SPT ! THEN THEN
    THEN ;

SCREEN 22

\ Addrs/Operand Prefixes: PREFX, ADRPREFX, OPNDPREFX 10jul88 JBD
: OPNDPREFX ( ..reg -- ..reg ) 0 SPT !  0 DUN !  USE?
   IF OPREFX32  DUN? NOT
    IF  OPREFX32  DUN? NOT SIZE32? NOT AND
     IF 146 C, THEN  THEN
   ELSE  OPREFX16 DUN? NOT
    IF  OPREFX16 DUN? NOT SIZE32? AND
     IF 146 C, THEN THEN THEN ;
: ADRPREFX ( ..Reg -- ..Reg ) 0 SPT !  0 DUN !
   USE?  IF APREFX32 DUN? NOT  IF  APREFX32 THEN
   ELSE APREFX16 DUN? NOT  IF  APREFX16 THEN THEN ;
: PREFX ( ..reg opadr. -- ..reg opadr)
    ADRPREFX  OPNDPREFX  SEGOVR? ;
 VARIABLE OP
: OFFPREFX ( ..op -- ..op ) OP C! OPSET OFF PREFX OP C@ ;
: ONPREFX  ( ..op -- ..op ) OP C! OPSET  ON PREFX OP C@ ;

SCREEN 23

\ OPND, OPADR;  WMEM, R/M,  WR/SM,                   10jul88 JBD

 VARIABLE OPND  VARIABLE OPADR

: WMEM,  ( disp mem reg op -- )  OVER  W,  MEM, ;

: R/M, ( mr reg -- )  OVER REG? IF  RR, ELSE MEM, THEN ;

: WR/SM,   ( rm reg op -- )   2 PICK DUP REG?
   IF  W, RR,  ELSE  DROP SIZE, MEM,  THEN  SIZE ON  ;

SCREEN 24

\ 1MI, 2MI                                           10jul88 JBD
: 1MI   CREATE  C,  DOES>  C@ C,  ;
HEX
 37 1MI AAA  3F 1MI AAS  F8 1MI CLC  FC 1MI CLD  FA 1MI CLI
 F5 1MI CMC  27 1MI DAA  2F 1MI DAS  F4 1MI HLT  CE 1MI INTO
 9F 1MI LAHF F0 1MI LOCK 90 1MI NOP  F2 1MI REP  F3 1MI REPE
 F2 1MI REPNE   F2 1MI REPNZ   F3 1MI REPZ   9E 1MI SAHF
 F9 1MI STC  FD 1MI STD  FB 1MI STI  9B 1MI WAIT D7 1MI XLAT
OCTAL

: 2MI   CREATE  C,  DOES>  C@ C,  12 C,  ;
HEX  D5 2MI AAD  D4 2MI AAM OCTAL

SCREEN 25

\ .386 etc, SHORT etc.                               10jul88 JBD

VARIABLE .386VAR    .386VAR OFF
: .386? .386VAR @ 0<> ;         ( all for 3MI use)
: .386  .386? IF  .386VAR ON ELSE .386VAR OFF THEN ; ( toggles)

VARIABLE SHORT
( Use SH before 3MI words for short jump when 386 enabled)
: SH  SHORT ON  ;
: SH? SHORT @ 0<> ;

SCREEN 26

\ 3MI, JA etc.                                       10jul88 JBD

: 3MI   CREATE  C,  DOES>  .386? NOT
   IF  C@ C,  HERE - 1-
    DUP -200 177 WITHIN NOT ABORT" Branch out of Range" C,
   ELSE ( all 386 cases) C@ OFFPREFX   SH?
    IF SHORT OFF  C,  #)?
     IF HERE - 1- C,
     ELSE ( D#}) HERE 4 + S>D  D-  DROP C, THEN
    ELSE ( 386 near, not short)  17 C, 20 + C, #)?
     IF  HERE - 2- ,
     ELSE ( D#}) HERE 4 + S>D D- SWAP , ,
   THEN THEN THEN  WRAP ;

SCREEN 27

\ 3MI  words                                         10jul88 JBD
HEX
 77 3MI JA   73 3MI JAE   72 3MI JB    76 3MI JBE   72 3MI JC
 74 3MI JE   7F 3MI JG    7D 3MI JGE   7C 3MI JL    7E 3MI JLE
 76 3MI JNA  72 3MI JNAE  73 3MI JNB   77 3MI JNBE  73 3MI JNC
 75 3MI JNE  7E 3MI JNG   7C 3MI JNGE  7D 3MI JNL   7F 3MI JNLE
 71 3MI JNO  7B 3MI JNP   79 3MI JNS   75 3MI JNZ   70 3MI JO
 7A 3MI JP   7A 3MI JPE   7B 3MI JPO   78 3MI JS    74 3MI JZ

OCTAL

SCREEN 28

\ 4MI, 14MI                                          10jul88 JBD
OCTAL
: 4MI   CREATE  C,  DOES>  C@ ONPREFX
   C,  MEM, WRAP ;
HEX  C5 4MI LDS  8D 4MI LEA  C4 4MI LES  OCTAL

( 14MI is 386 instrucs not covered by 4MI)

: 14MI   CREATE   C,  DOES>  C@ ONPREFX  17 C,
   C,  MEM, WRAP ;
HEX  B4 14MI LFS   B5 14MI LGS   B2 14MI LSS OCTAL

SCREEN 29

\ 5MI                                                10jul88 JBD
: 5MI   CREATE  C,  DOES>   ( no numeric operands)
   0 ( dummy param for PREFX) SWAP C@  OFFPREFX NIP
   SIZE,  WRAP  ;
 ( Use with BY, WD or DW to give opnd size, with optional
   seg override for source string; dest. uses auto ES: override)
 HEX  A6 5MI CMPS  A4 5MI MOVS  AE 5MI SCAS
: CMPSB  A6 C, ;
: CMPSW  WD OPSET OFF 0 PREFX DROP A7 C, WRAP ;
: CMPSD  DW OPSET OFF 0 PREFX DROP A7 C, WRAP ;
: MOVSB  A4 C, ;
: MOVSW  WD OPSET OFF 0 PREFX DROP A5 C, WRAP ;
: MOVSD  DW OPSET OFF 0 PREFX DROP A5 C, WRAP ;
: SCASB  AE C, ;
: SCASW  WD OPSET OFF 0 PREFX DROP AF C, WRAP ;
: SCASD  DW OPSET OFF 0 PREFX DROP AF C, WRAP ;     OCTAL

SCREEN 30

\ 6MI, LODS etc.; 7MI, DIV etc.                      10jul88 JBD
 ( Use with BY, WD or DW to give opnd size)
: 6MI   CREATE  C,  DOES>  C@ 0 SWAP OFFPREFX
   SWAP DROP  SIZE, WRAP ;
HEX  AC 6MI LODS  AA 6MI STOS
: LODSB ( no opnds) AC C, ;
: LODSW ( no opnds) DX  OPSET OFF PREFX  DROP  AD C, ;
: LODSD ( no opnds) EDX OPSET OFF PREFX  DROP  AD C, ;
: STOSB ( no opnds) AA C, ;
: STOSW ( no opnds) DX  OPSET OFF PREFX  DROP  AB C, ;
: STOSD ( no opnds) EDX OPSET OFF PREFX  DROP  AB C, ;  OCTAL

: 7MI   CREATE  C,  DOES> C@ OFFPREFX 366 WR/SM, WRAP ;

SCREEN 31

\ 8MI: IN, OUT;  9MI: DEC, INC                       10jul88 JBD

: 8MI   CREATE  C,  DOES>  C@ OP C! OPSET ON PREFX OP C@
   SWAP DUP R16? SWAP R32? OR 1 AND OR  SWAP # =
   IF  C, C,  ELSE  ( DX) 10 OR  C,  THEN  WRAP ;

HEX E4 8MI IN  E6 8MI OUT  OCTAL

: 9MI   CREATE  C,  DOES>  C@ OP C! OPSET OFF PREFX OP C@
   OVER DUP R16? SWAP R32? OR
    IF  100 OR SWAP RLOW OP,
    ELSE  376 WR/SM, THEN   WRAP ;

HEX  8 9MI DEC  0 9MI INC  OCTAL

SCREEN 32

\ 10MI, RCL etc.                                     10jul88 JBD
   ( 1 # m/r shl,  cl m/r shl,  imm8 # m/r shl are legal forms)

: 10MI CREATE C, DOES> C@ OP C!  OPSET ON PREFX OP C@
    SPT @ 1+ ROLL ( CL or # ) CL =
    IF  322 WR/SM,
    ELSE ( #)
     SPT @ 1+ ROLL ( imm8 data)  DUP 1 =
     IF  DROP 320  WR/SM,
     ELSE ( imm8) OPND !  300 WR/SM, OPND @ C,
    THEN THEN  WRAP ;

HEX   10 10MI RCL   18 10MI RCR    0 10MI ROL   8 10MI ROR
      38 10MI SAR   20 10MI SHL   20 10MI SAL  28 10MI SHR
OCTAL

SCREEN 33

\ 11MI, CALL and JMP                                 10jul88 JBD

: 11MI   CREATE  C, C,  DOES>  OPADR ! OPSET OFF PREFX
   OPADR @ OVER DUP OPND ! DUP #)? SWAP D#)? OR
   IF  NIP C@ INTER @
     IF  1 AND IF  352  ELSE  232  THEN  C, OPND @ #)?
      IF SWAP , , ELSE -ROT SWAP , , , THEN INTER OFF
     ELSE OPND @ #)?
      IF  SWAP HERE - 2- SWAP  2DUP 1 AND SWAP BIG? NOT AND
       IF  2 OP, C,  ELSE  C,  1- ,  THEN
      ELSE ( D#}) -ROT HERE 5 + S>D D- ROT C, SWAP , , THEN THEN
   ELSE  OVER S#) =
    IF NIP #) SWAP  ELSE OVER SD#)?
     IF NIP D#) SWAP THEN THEN
   377 C, 1+ C@ ?FAR  R/M,  THEN  WRAP ;
HEX  10 E8 11MI  CALL    20 E9 11MI JMP      OCTAL

SCREEN 34

\ 12MI, PUSH and POP                                 10jul88 JBD
: 12MI ( immed, 32segreg{2bytes}, m/r, segreg, reg opcodes -- )
         CREATE  C, C, C, C, C, C, DOES>
   OPADR ! OPSET OFF PREFX OPADR @ OVER REG?
   IF  C@ SWAP RLOW OP,
   ELSE  1+ OVER SEG16?
    IF  C@ RLOW SWAP RMID OP,
    ELSE  OVER UMEMA?
     IF  COUNT SWAP C@ C,  MEM,
     ELSE 2+ OVER SEG32?
      IF COUNT C, C@ OVER FS = IF C, ELSE 10 + C, THEN  DROP
      ELSE ( Immed: PUSH only) 2+ SWAP D#?
       IF C@   C, SWAP , ,
       ELSE ( # ) C@ ( disp op) SWAP DUP BIG?
        IF SWAP C, , ELSE ( 8 bits) SWAP 2 OR  C, C,
    THEN THEN THEN THEN THEN THEN  WRAP ;

SCREEN 35

\ 12MI, PUSH and POP opcodes                         10jul88 JBD

HEX

68 0A0 0F 0FF 36 50  12MI PUSH

0  0A1 0F 8F  07 58  12MI POP

OCTAL

SCREEN 36

\ NROLL :  TOS to N+1th stack position               10jul88 JBD

( 1 NROLL = SWAP, 2 NROLL = -ROT )

VARIABLE NUMROLL ( number to ROLL)

: NROLL ( n --)  DUP 0<>            ( for 13MIMEM use)
   IF  DUP NUMROLL !  0 DO
    NUMROLL @  ROLL LOOP   ELSE DROP  THEN ;

SCREEN 37

\ 13MI: 13MISIMM                                     10jul88 JBD

 : 13MISIMM ( immed. source with reg dest)
    OPND @ #?
    IF   OVER B/L? OVER DUP  R16?  SWAP R32? OR 2DUP AND
     -ROT 1 AND SWAP NOT 2 AND OR 200 OP,
     SWAP RLOW 300 OR  OP @  OP,  ,/C,
    ELSE ( D# source) 177777 DUP 2DUP AND
     -ROT 1 AND SWAP NOT 2 AND OR 200 OP,
     SWAP RLOW 300 OR  OP @  OP, DROP SWAP , ,
    THEN  ;

SCREEN 38

\ 13MI: 13MIMEM                                      10jul88 JBD

: 13MIMEM  ( dest= mem cases of 13MI)
   SPT @  ROLL  DUP REG?
   IF  OP C@  WMEM,
   ELSE  ( #)  #?
    IF SPT @  PICK B/L? DUP NOT 2 AND 200 OR SIZE,
     SPT @  NROLL  OP @  MEM,
     SIZE @ AND ,/C,
    ELSE ( D#) 177777 DUP NOT 2 AND 200 OR SIZE,
     SPT @  NROLL  OP @  MEM,
     DROP SWAP , ,  THEN  THEN  ;

SCREEN 39

\ 13MI, ADD etc.                                     10jul88 JBD

: 13MI  CREATE C, C, DOES>  COUNT OP C!  C@ LOGICAL !
   OPSET ON PREFX  DUP REG? ( dest a reg?)
   IF  OVER REG?  ( source a reg also?)
    IF OP @ OVER W, SWAP RR,
    ELSE  OVER DUP UMEM? SWAP U#)?   OR  ( memory source?)
     IF  OP @ 2 OR WMEM,
     ELSE  ( # or D#) OVER OPND  !  NIP DUP RLOW 0= ( accum?)
      IF  OP @ 4 OR OVER W, OPND @ #?
       IF  R16? ,/C,  ELSE ( D#) DROP  SWAP , , THEN
      ELSE 13MISIMM ( immed. source, dest reg but not accum)
    THEN THEN THEN
   ELSE  ( mem dest.)  13MIMEM THEN  WRAP ;

SCREEN 40

\ 15MI, SETcond                                      10jul88 JBD

: 15MI  CREATE  C, DOES> C@ OFFPREFX  17 C,  220 OR C,
   DUP R8?
    IF  RLOW 300 OP,
    ELSE ( mem) 0 ( rmid) MEM, THEN  WRAP ;

HEX
7 15MI SETA 3 15MI SETAE  2 15MI SETB 6 15MI SETBE 2 15MI SETC
4 15MI SETE F 15MI SETG 0D 15MI SETGE 0C 15MI SETL 0E 15MI SETLE
 6 15MI SETNA  2 15MI SETNAE  3 15MI SETNB  7 15MI SETNBE
 3 15MI SETNC  5 15MI SETNE  0E 15MI SETNG 0C 15MI SETNGE
0D 15MI SETNL 0F 15MI SETNLE  1 15MI SETNO 0B 15MI SETNP
 9 15MI SETNS  5 15MI SETNZ   0 15MI SETO  0A 15MI SETP
0A 15MI SETPE 0B 15MI SETPO   8 15MI SETS   4 15MI SETZ
OCTAL

SCREEN 41

\ 16MI + 17MI, CBW,CWD etc, PUSHA/POPA etc, IRET/D   10jul88 JBD

: 16MI  CREATE C, DOES> USE? IF 146 C, ( 66h) THEN
   C@ C, WRAP ;

HEX  99 16MI CWD   98 16MI CBW  60 16MI PUSHA  9C 16MI PUSHF
     61 16MI POPA  9D 16MI POPF CF 16MI IRET
OCTAL

: 17MI  CREATE C, DOES> USE? NOT IF 146 C, ( 66h) THEN
   C@ C, WRAP ;

HEX  99 17MI CDQ  98 17MI CWDE  60 17MI PUSHAD  9C 17MI PUSHFD
     61 17MI POPAD  9D 17MI POPFD  CF 17MI IRETD
OCTAL

SCREEN 42

\ 18MI,  SHLD/SHRD ( non-standard modr/m byte)       10jul88 JBD
   ( cl reg m/r shld,  imm8 # reg m/r shld  are legal forms)
VARIABLE CLFLG      : CL? CL = 0<> ;    : CL  CL CLFLG ON ;
: CLFLG? CLFLG @ 0<> ;
: 18MI CREATE C, DOES> C@  ONPREFX   17 C,
   SPT @ 2+ ROLL ( CL or # )  CL?
    IF  1+ C,
    ELSE ( # ) SPT @ 2+ ROLL  OPND C!  C, THEN
   DUP REG? ( dest a reg?)
    IF ( source a reg also) SWAP RR,  CLFLG?
     IF CLFLG OFF ELSE  OPND C@ ( imm8) C, THEN
    ELSE ( dest mem, source reg)
     SPT @ ROLL MEM,  CLFLG?
     IF CLFLG OFF ELSE  OPND C@ ( imm8) C, THEN
    THEN  WRAP ;
HEX   A4 18MI SHLD  AC 18MI SHRD   OCTAL

SCREEN 43

\ 19MI, LAR + LSL, BSF + BSR                         10jul88 JBD

: 19MI CREATE C, DOES> C@  ONPREFX  17 C, C,
   OVER REG?  ( source a reg also?)
    IF   RR,
    ELSE ( mem source)  MEM, THEN  WRAP ;

HEX  02 19MI LAR   03 19MI LSL
     BC 19MI BSF   BD 19MI BSR   OCTAL

SCREEN 44

\ 20MI, LGDT etc.                                    10jul88 JBD

  ( 2nd op, rmid -- )
: 20MI  CREATE  C, C, DOES> DUP OPADR !  C@ OFFPREFX
   17 C,  C, OPADR @ 1+ C@ ( rmid)
   OVER REG?
    IF  SWAP RLOW  OR  300 OP,
    ELSE ( mem)  MEM, THEN  WRAP ;

HEX  10 1 20MI LGDT   18 1 20MI LIDT   10 0 20MI LLDT
     18 0 20MI LTR     0 1 20MI SGDT    8 1 20MI SIDT
      0 0 20MI SLDT   20 1 20MI SMSW    8 0 20MI STR
     20 0 20MI VERR   28 0 20MI VERW
OCTAL

SCREEN 45

\ 21MI, BT  etc.                                     10jul88 JBD
   ( reg m/r bt,  imm8 # m/r bt  are legal forms)
       ( N.B.: non-standard modr/m byte!)
: 21MI CREATE C, DOES> C@ OP C! OPSET ON PREFX   17 C,
   SPT @  ROLL ( reg or  # ) DUP #?  ( source immed?)
    IF  DROP 272 C, SPT @ ROLL OPND C! DUP REG? ( dest a reg?)
     IF RLOW 300 OR  OP C@ OR C,  OPND C@ C,
     ELSE ( mem dest) OP C@ MEM, OPND C@ C, THEN
    ELSE ( reg source ) OPND !  OP C@ 203 OR C,
     DUP REG? ( dest a reg also?)
      IF OPND @ ( source reg)  RR,
      ELSE ( dest mem, source reg)  OPND @ MEM, THEN
    THEN  WRAP ;

HEX  20 21MI BT   38 21MI BTC   30 21MI BTR   28 21MI BTS
OCTAL

SCREEN 46

\ 22MI, INS etc.                                     10jul88 JBD
: 22MI   CREATE  C,  DOES>   ( DX -- )
   SWAP DROP ( DX not needed in code)
   0 ( dummy param for PREFX ) SWAP C@  OFFPREFX NIP
   SIZE,  WRAP  ;
 ( Use with BY, WD or DW to give operand size.)

HEX  6C 22MI INS   6E 22MI OUTS

: INSB   6C C, ;
: INSW   WD OPSET OFF 0 PREFX DROP  6D C, WRAP ;
: INSD   DW OPSET OFF 0 PREFX DROP  6D C, WRAP ;
: OUTSB  6E C, ;
: OUTSW  WD OPSET OFF 0 PREFX DROP  6F C, WRAP ;
: OUTSD  DW OPSET OFF 0 PREFX DROP  6F C, WRAP ;
OCTAL

SCREEN 47

\ 23MI, MOVSX and MOVZX                              10jul88 JBD

: 23MI CREATE C, DOES> C@  ONPREFX  17 C,
   2 PICK  R8? IF C, ELSE  SIZE, THEN
   OVER REG?  ( source a reg also?)
    IF  RR,
    ELSE ( mem source)  MEM, THEN WRAP ;

HEX  BE 23MI MOVSX  B6 23MI MOVZX  OCTAL

SCREEN 48


\ TEST: TESTMEM                                      10jul88 JBD

: TESTMEM  ( dest= mem cases of TEST)
   SPT @    ROLL  DUP REG?
   IF  204  WMEM,
   ELSE  ( # )  #?
    IF  366 SIZE, 0 MEM, SIZE @ ,/C,
    ELSE ( D# ) 366 SIZE, 0 MEM, SWAP  , ,
   THEN  THEN  ;

SCREEN 49

\ TEST                                               10jul88 JBD

: TEST  OPSET ON PREFX
   DUP REG? ( dest a reg?)
   IF  OVER REG?  ( source a reg also?)
    IF 204  OVER W, SWAP RR,
    ELSE  OVER DUP UMEM? SWAP U#)?   OR  ( memory source?)
     IF  204  WMEM,
     ELSE  ( # or D# ) OVER OPND  !  NIP DUP RLOW 0= ( ACC? )
      IF  250  OVER W,
      ELSE 366 OVER W, DUP RLOW 300 OP, THEN
      DUP R32? IF ( #D) DROP SWAP , ,
       ELSE R16?  ,/C,  THEN THEN THEN
   ELSE  ( mem dest.)  TESTMEM  THEN  WRAP ;

SCREEN 50

\ ESC, INT, XCHG                                     10jul88 JBD
HEX

: ESC  ( rm, 6-bit const -- ) RLOW  0D8  OP, R/M, ;

: INT  ( n -- )  0CD  C, C,  ;  ( N.B.: no # )

: XCHG   ( mr1 mr2 -- )   OPSET ON PREFX  DUP REG?
   IF  DUP DUP AX =  SWAP EAX = OR
     IF  DROP RLOW 90 OP,  ELSE  OVER DUP AX =  SWAP EAX = OR
     IF  NIP  RLOW 90 OP,  ELSE  86 WR/SM,  THEN  THEN
   ELSE  ROT 86 WR/SM,  THEN  WRAP ;

SCREEN 51

\ MOV: MOVRGSG2                                      10jul88 JBD

: MOVRGSG2 ( -- ss dst )       ( Continuation from MOVRGSG1)
    OVER SEG?
    IF  SWAP 8C C, RR,
    ELSE  OVER DUP  #?   SWAP D#?  OR
     IF   DUP DUP  R16? SWAP R32?  OR  SWAP
      RLOW OVER 8 AND OR B0 OP,
      SWAP D#?  IF  DROP SWAP , ,  ELSE  ,/C,  THEN
     ELSE  8A OVER W, R/M,  THEN THEN ;

SCREEN 52

\ MOV: MOVRGSG1                                      10jul88 JBD

: MOVRGSG1 ( -- ss dst )  ( dest either REG or SEG)
   DUP SEG?
   IF  8E C, R/M,
   ELSE  DUP REG?
    IF  ( direct memory source? )  OVER DUP
     #)?  SWAP  D#)?  OR  OVER RLOW 0= AND
      IF  A0 SWAP W,  D#)?  IF  SWAP , , ELSE  ,  THEN
      ELSE  ( all other cases )  MOVRGSG2  THEN THEN THEN ;

SCREEN 53

\ MOV: MOVMEM                                        10jul88 JBD
  ( dest a memory expression, so source is reg or immed.)

: MOVMEM   ( ss dst -- )    ( dest a memory expression)
   SPT @  ( PREFX handles increment for double displacements)
   ROLL  DUP SEG?  ( source a segreg?)
   IF  8C C, MEM,
   ELSE  DUP #?
    IF  DROP C6 SIZE, 0 MEM,  SIZE @ ,/C,
    ELSE  DUP D#?
     IF  DROP C6 SIZE, 0 MEM,  SWAP , ,
     ELSE  OVER #)?  OVER RLOW 0= AND
      IF  A2 SWAP W,  DROP   ,   ELSE  88 OVER W, R/M,
      THEN THEN THEN  THEN  ;

SCREEN 54

\ MOV, MOVSPL                                        10jul88 JBD

: MOVSPL  0F C, DUP SPL? ( dest SPL?)
   IF DUP CTL? IF 22 ELSE DUP DBG? IF 23 ELSE 26 THEN THEN
    C, RMID SWAP RLOW OR C0 OR C,
   ELSE ( source is SPL)  SPT @  PICK
    DUP CTL? IF DROP 20 ELSE  DBG? IF 21 ELSE 24 THEN THEN
    C, RLOW SWAP RMID OR C0 OR C, THEN ;

: MOV ( source dest--) OPSET ON PREFX
   DUP SPL?  SPT @ 1+ PICK SPL?  OR  ( dest or source SPL?)
    IF MOVSPL
    ELSE  DUP DUP REG? SWAP SEG?  OR ( dest reg or segreg?)
     IF MOVRGSG1  ELSE MOVMEM THEN THEN  WRAP ;

SCREEN 55

\ ARPL, CLTS, BOUND, ENTER, LEAVE                    10jul88 JBD
OCTAL
 ( r16 m/r16 ARPL)
: ARPL  ( N.B.: non-standard modr/m byte!)
        OPSET ON PREFX 143 C, DUP R16?
   IF SWAP RR, ELSE ( mem dest) SPT @ ROLL MEM, THEN WRAP ;

: CLTS  ( --) 17 C,  6 C, ;

: BOUND ( mem reg bound) OPSET ON PREFX  142 C, MEM, WRAP ;

: ENTER ( imm8  imm16  enter)
   310 C,  ,  C,  ;

: LEAVE  ( --)  311 C, ;

SCREEN 56

\ JCXZ, JECXZ                                        10jul88 JBD

: JCXZ ( adr, #} or D#}  -- )  USE?
   IF 146 C, THEN  343 C,  #)?
    IF  HERE - 2- ,
    ELSE ( D#})  HERE 4 + S>D D- SWAP , ,  THEN ;

: JECXZ ( adr, #} or D#} -- )  USE? NOT
   IF 146 C, THEN  343 C,  #)?
    IF  HERE - 2- ,
    ELSE ( D#})  HERE 4 + S>D D- SWAP , ,  THEN ;

SCREEN 57

\ 7MI and 13MI, Opcode Definitions.                  10jul88 JBD
( Put here to avoid conflicts with ordinary NOT, AND and OR)
 HEX
 30 7MI DIV  38 7MI IDIV  28 7MI IMUL 20 7MI MUL 10 7MI NOT

 0 10 13MI ADC   0  0 13MI ADD   2 20 13MI AND  0 38 13MI CMP
 2  8 13MI  OR   0 18 13MI SBB   0 28 13MI SUB  2 30 13MI XOR

DECIMAL

SCREEN 58

\ Structured Conditionals                            10jul88 JBD
: 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
DECIMAL

SCREEN 59

\ Structured Conditionals                            10jul88 JBD
HEX
: IF      C,   ?>MARK  ;
: THEN    ?>RESOLVE   ;
: ELSE    0EB IF   2SWAP   THEN   ;
: BEGIN   ?<MARK   ;
: UNTIL   C,   ?<RESOLVE   ;
: AGAIN   0EB UNTIL   ;
: WHILE   IF   ;
: REPEAT   2SWAP   AGAIN   THEN   ;
: DO      # CX MOV   HERE   ;
: NEXT    >NEXT #) JMP   ;
: 1PUSH   >NEXT 1- #) JMP   ;
: 2PUSH   >NEXT 2- #) JMP   ;
DECIMAL










Terms of Service | Privacy Statement | Copyright © 2024 UBM Tech, All rights reserved.