home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1988 / 10 / 80386a.fth next >
Text File  |  1988-10-31  |  56KB  |  965 lines
  1. SCREE╬ 0
  2.  
  3. \ 80386 Assembler                                    10jul88 JBD
  4. \                                                               
  5. \                     80386 Assembler                           
  6. \           Copyright (c) 1988 by John B. Dilworth              
  7. \                                                               
  8. \ Permission is given to freely use or distribute this program, 
  9. \ provided that this entire copyright notice is included on all 
  10. \ copies of the source code, or any documentation of the        
  11. \ object code.  It is released as 'Shareware'; please remit     
  12. \ an appropriate amount, based on usage, for registration,      
  13. \ extra documentation, updates, etc., to the author at          
  14. \ 133 N. Arlington St., Kalamazoo, MI 49007.                    
  15. \                                                               
  16. \ My thanks to Mike Perry and Henry Laxen, whose public-domain  
  17. \  F83 Forth system and 8086 Assembler inspired this program.   
  18. \                                                               
  19. SCREE╬ 1
  20.  
  21. \ 80386 Assembler Load Screen                        10jul88 JBD
  22.                                                                 
  23. : FAF  ONLY FORTH ALSO ASSEMBLER ALSO FORTH ;  FAF              
  24. : CODE  CODE FAF ;                                              
  25. \ Above to load on top of F83, 80386 assembler use only.        
  26. \ For full use of system, recompile F83 and replace 8086        
  27. \ assembler, or set up new Vocabulary for this assembler and    
  28. \ redefine CODE etc. to refer to it.                            
  29.                                                                 
  30. DECIMAL                                                         
  31. 2 59  THRU  CR .( 80386 Assembler loaded.)                      
  32. EXIT                                                            
  33.  
  34. SCREE╬ 2
  35.                                                                 
  36. \ 80386 Assembler   Register, Mode Definitions       10jul88 JBD
  37. OCTAL ( default base)                                           
  38. : REG    ( mode reg# -- )  11 * SWAP 1000 * OR CONSTANT   ;     
  39. : REGS   ( n mode -- )   SWAP 0 DO  DUP I REG  LOOP  DROP ;     
  40. 10 0 REGS   AL  CL  DL  BL  AH  CH  DH  BH                      
  41. 10 1 REGS   AX  CX  DX  BX  SP  BP  SI  DI                      
  42. 10 2 REGS   [BX+SI] [BX+DI] [BP+SI] [BP+DI] [SI] [DI] [BP] [BX] 
  43.  4 2 REGS   [SI+BX] [DI+BX] [SI+BP] [DI+BP]                     
  44.  6 3 REGS   ES  CS  SS  DS  FS GS                               
  45.  3 4 REGS   #   #)  S#)                                         
  46. 10 5 REGS   EAX ECX EDX EBX ESP EBP ESI EDI                     
  47.                                                                 
  48. : MD   CREATE  1000 * ,  DOES>  @ SWAP 7000 AND = 0<>  ;        
  49.                                                                 
  50. 0 MD R8?   1 MD R16?   2 MD MEM?   3 MD SEG?                    
  51. 5 MD R32?  6 MD MMI32?  7 MD MEM32?                             
  52.  
  53. SCREE╬ 3
  54.  
  55. \ DOUBLE, SIZE32, DOUBLE?, REG32, REGS32, SWD, DWD   10jul88 JBD
  56. VARIABLE DOUBLE   VARIABLE SIZE32                               
  57. : DOUBLE?  DOUBLE @ 0<> ; ( test for 32-bit displacement)       è                                                                
  58. : REG32   ( mode reg# -- )                                      
  59.    11 * SWAP 1000 * OR CREATE  ,                                
  60.    DOES>  @  ( -- constant )  DPL @ -1 = NOT  ( double word?)   
  61.     IF  -1 DOUBLE !  -1 DPL !  ELSE 0 DOUBLE ! THEN ;           
  62. : REGS32 ( n mode -- )                                          
  63.    SWAP 0 DO DUP I REG32 LOOP DROP ;                            
  64. 10 7 REGS32   [EAX] [ECX] [EDX] [EBX] [ESP] [EBP] [ESI] [EDI]   
  65.                                                                 
  66. : SWD ( 16-bit disp; use to define single-word vars )           
  67.    CREATE , DOES>   SIZE ON  SIZE32 OFF ;                       
  68. : DWD ( 16-bit disp; use to define double-word vars )           
  69.    SWAP CREATE , , DOES>  SIZE32 ON ;                           
  70.  
  71. SCREE╬ 4
  72.  
  73. \ IREG/S, initializing MMI32 regs [EAX+EBX] etc.     10jul88 JBD
  74.                                                                 
  75. : IREG ( base, loop index -- )                                  
  76.    OR 6000 OR  CREATE ,  DOES>  @ ( constant)                   
  77.    DPL @ -1 = NOT ( double word?)                               
  78.     IF  -1 DOUBLE !  -1 DPL !  ELSE 0 DOUBLE ! THEN ;           
  79.                                                                 
  80. : IREGS ( reg# -- ) ( Init's [EAX+EBX] etc. in SIB format )     
  81.    10 *  10 0 DO  DUP  I   IREG  LOOP DROP ;                    
  82.                                                                 
  83. VARIABLE SPT  ( used in prefix tests)                           
  84.                                                                 
  85. SCREE╬ 5
  86.  
  87. \ IREGS, initializing MMI32 regs [EAX+EBX] etc.      10jul88 JBD
  88. 0 IREGS [EAX+EAX] [ECX+EAX] [EDX+EAX] [EBX+EAX]                 
  89.         [ESP+EAX] [EBP+EAX] [ESI+EAX] [EDI+EAX]                 
  90. 1 IREGS [EAX+ECX] [ECX+ECX] [EDX+ECX] [EBX+ECX]                 
  91.         [ESP+ECX] [EBP+ECX] [ESI+ECX] [EDI+ECX]                 
  92. 2 IREGS [EAX+EDX] [ECX+EDX] [EDX+EDX] [EBX+EDX]                 
  93.         [ESP+EDX] [EBP+EDX] [ESI+EDX] [EDI+EDX]                 
  94. 3 IREGS [EAX+EBX] [ECX+EBX] [EDX+EBX] [EBX+EBX]                 
  95.         [ESP+EBX] [EBP+EBX] [ESI+EBX] [EDI+EBX]                 
  96.           ( ESP can't be index register)                        
  97. 5 IREGS [EAX+EBP] [ECX+EBP] [EDX+EBP] [EBX+EBP]                 
  98.         [ESP+EBP] [EBP+EBP] [ESI+EBP] [EDI+EBP]                 
  99. 6 IREGS [EAX+ESI] [ECX+ESI] [EDX+ESI] [EBX+ESI]                 
  100.         [ESP+ESI] [EBP+ESI] [ESI+ESI] [EDI+ESI]                 
  101. 7 IREGS [EAX+EDI] [ECX+EDI] [EDX+EDI] [EBX+EDI]                 
  102.         [ESP+EDI] [EBP+EDI] [ESI+EDI] [EDI+EDI]                 
  103.  
  104. SCREE╬ 6
  105.  
  106. \ SREG, etc.  ( Special registers )                  10jul88 JBD
  107.                                                                 
  108. : SREG ( 13-15th bits + regval -- )  CONSTANT ;                 
  109.                                                                 
  110. HEX  2000 SREG CR0   2012 SREG CR2   201B SREG CR3              
  111.      4000 SREG DR0   4009 SREG DR1   4012 SREG DR2              è     401B SREG DR3   4036 SREG DR6   403F SREG DR7              
  112.      8036 SREG TR6   803F SREG TR7                              
  113. OCTAL                                                           
  114.                                                                 
  115. : CTL? 20000 AND 0<> ;   ( tests for control, debug, test regs) 
  116. : DBG? 40000 AND 0<> ;                                          
  117. : TRG? 100000 AND 0<> ;                                         
  118.                                                                 
  119. : SPL? 160000 AND  0<> ; ( One of bits 13-15 set?)              
  120.                                                                 
  121. SCREE╬ 7
  122.  
  123. \ Constants, Address modes, Immediate data + tests   10jul88 JBD
  124.                                                                 
  125. : D#   4033  -1 DPL !  ;             ( 32-bit immed. data)      
  126. : D#)  4050  0 DOUBLE !  -1 DPL ! ;  ( 32-bit direct mem. disp) 
  127. : SD#) 4060  0 DOUBLE !  -1 DPL ! ;                             
  128.                            ( non-relative 32-bit call/jmp disp) 
  129.                                                                 
  130. 10000 CONSTANT *1  10100 CONSTANT *2  ( scaling factors)        
  131. 10200 CONSTANT *4  10300 CONSTANT *8                            
  132.                                                                 
  133. : #?    # = 0<> ;                                               
  134. : D#?  D# =  0<>  ;                                             
  135.                                                                 
  136. BP CONSTANT RP   [BP] CONSTANT [RP]   ( RETURN STACK POINTER )  
  137. SI CONSTANT IP   [SI] CONSTANT [IP]   ( INTERPRETER POINTER )   
  138. BX CONSTANT W    [BX] CONSTANT [W]    ( WORKING REGISTER )      
  139.  
  140. SCREE╬ 8
  141.  
  142. \ Addressing Modes, etc.                             10jul88 JBD
  143. : REG?    ( n -- f )   DUP 17000 AND 2000 <                     
  144.    IF ( If 8 or 16-bit reg) DROP -1   ELSE R32? THEN ;          
  145.                                                                 
  146. : BIG?   ( n -- f )   ABS -400 AND 0<>  ;                       
  147. : RLOW   ( n1 -- n2 )    7 AND ;                                
  148. : RMID   ( n1 -- n2 )   70 AND ;                                
  149. VARIABLE SIZE   SIZE ON                                         
  150. : BYTE   ( -- )   SIZE OFF ;                                    
  151. : OP,   ( n op -- )   OR C,  ;                                  
  152.                                                                 
  153. : ,/C,  ( n f -- )   IF  ,  ELSE  C,  THEN  ;                   
  154. : RR,   ( mr1 mr2 -- )   RMID SWAP RLOW OR 300 OP,  ;           
  155.                                                                 
  156. VARIABLE LOGICAL                                                
  157. : B/L?   ( n -- f )   BIG? LOGICAL @ OR  ;                      
  158.  
  159. SCREE╬ 9
  160.  
  161. \ Direct or Indirect Memory (Address size) tests     10jul88 JBD
  162. : #)?  #) = 0<> ;                                               
  163. : D#)?  4050  = 0<> ;                                           
  164. : SD#)? 4060  = 0<> ;                                           
  165. : U#)?  DUP  #)?  SWAP D#)? OR 0<> ;                            è                                                                
  166. : SIZE32?   SIZE32  @ 0<> ;                                     
  167.                                                                 
  168. : *? DUP *1 = 1 PICK *2 = OR  1 PICK *4 = OR  ( --reg, flg)     
  169.      1 PICK *8 = OR  0<> SWAP DROP ;                            
  170.                                                                 
  171. : UMEM32? DUP MEM32? SWAP MMI32? OR 0<> ;                       
  172. : UMEM?   DUP DUP UMEM32? SWAP MEM?                             
  173.    2 PICK *? OR OR 0<> SWAP DROP  ;                             
  174.                                                                 
  175. : UMEMA? DUP UMEM? SWAP U#)? OR 0<> ;  ( Any-memory test)       
  176.  
  177. SCREE╬ 10
  178.  
  179. \ 32-bit operation words                             10jul88 JBD
  180. VARIABLE USE   USE OFF                                          
  181. : USE?  USE @ 0<> ;                                             
  182. : USE16  USE OFF  SIZE32 OFF  ; ( 386 default segment types)    
  183. : USE32  USE ON   SIZE32 ON   ;                                 
  184. : WRAP  USE? IF ( 32-bit) SIZE32 ON ELSE SIZE32 OFF THEN        
  185.    SIZE ON ;                                                    
  186. ( Operand sizes )                                               
  187. : BY     ( -- )   BYTE ;                                        
  188. : WD     ( -- )   SIZE ON SIZE32 OFF ;                          
  189. : DW     ( -- )   SIZE32 ON  ;                                  
  190.                                                                 
  191. : W,   ( op mr -- )                                             
  192.    DUP R16? 1 AND  SWAP  R32? 1 AND  OR  OP,  ;                 
  193. : SIZE,   ( op -- op' )                                         
  194.    SIZE @ 1 AND   SIZE32 @ 1 AND  OR  OP,  ;                    
  195.  
  196. SCREE╬ 11
  197.  
  198. \ MMI32*, ( disp [EAX+EBX] *x cases)                 10jul88 JBD
  199.                                                                 
  200. : MMI32*,   ( disp mr *x rmid -- )  ( mr of [eax+ebx] form)     
  201.    DOUBLE? NOT                                                  
  202.    IF    ( test for |--|---|101|)   2 PICK                      
  203.     7 AND 5 = 4 PICK 0= AND ( is it 0 [ebp+reg] case?)          
  204.     IF ( --disp mr *x rmid) 104 OP, OR  C,  C,                  
  205.     ELSE ( any other case; mode 0, 1 or 2) 3 PICK BIG?          
  206.      IF  204 OP,  OR  C,  ,  0  ,                               
  207.      ELSE  3 PICK 0=  ( mode 0?)                                
  208.       IF ( --disp mr *x rmid) 4 OP, OR C, DROP ( mode 0,no disp)
  209.       ELSE  104 OP, OR C, C, ( mode 1, byte disp) THEN THEN THEN
  210.    ELSE  ( double)  ( --disp mr *x rmid) 204 OP, ( --disp mr *x)
  211.     OR  C, SWAP , ,  ( mode 2, 32-bit disp)   THEN ;            
  212.                                                                 
  213. SCREE╬ 12
  214.  
  215. \ MEM*, MEM32*;  MEM32 scaling cases, disp [eax] *x  10jul88 JBD
  216. ( disp [EAX] *X cases: must code as [disp32+{scale*index}] )    
  217.                                                                 
  218. : MEM32*,   ( disp mr *x rmid -- )  ( mr of [eax] form)         
  219.    4 OP, ( disp mr *x)                                          è   SWAP ( disp *x mr)  OR ( disp rslt)                          
  220.    5 OP, ( disp)                                                
  221.    DOUBLE?  IF  SWAP , ,  ELSE  , 0 ,  THEN  ;                  
  222.                                                                 
  223.  : MEM*, ( disp mr *x rmid -- )                                 
  224.     RMID SWAP 377 AND ( --disp mr rmid *x )  ( 8 bits only)     
  225.     SWAP 2 PICK  ( --disp mr *x rmid mr)  MEM32?                
  226.     IF    ROT  RMID  -ROT  ( __disp mr *x rmid)   MEM32*,       
  227.     ELSE  ROT  377  AND  -ROT   MMI32*,   THEN ;                
  228.                                                                 
  229. SCREE╬ 13
  230.  
  231. \ MEM#), MEM16, ( all drct mem + 16-bit indrct mem ) 10jul88 JBD
  232.                                                                 
  233. : MEM#),   ( disp mr rmid -- )  OVER #) =   ( direct mem opnd)  
  234.    IF  RMID 6 OP, DROP ,  ELSE                                  
  235.     OVER D#)?  IF  RMID 5 OP, DROP SWAP , , THEN THEN  ;        
  236.                                                                 
  237. : MEM16,   ( disp mr rmid -- ) ( Original indirect mem cases)   
  238.    RMID OVER RLOW OR -ROT [BP] = OVER 0= AND                    
  239.     IF  SWAP 100 OP, C,  ELSE  SWAP OVER BIG?                   
  240.      IF  200 OP, ,  ELSE  OVER 0=                               
  241.       IF  C, DROP  ELSE  100 OP, C,                             
  242.     THEN THEN THEN  ;                                           
  243.  
  244. SCREE╬ 14
  245.                                                                
  246. \ MMI32, ( disp [EAX+EBX] cases, MMI32? test)        10jul88 JBD
  247.    ( Extra SIB byte needed)                                     
  248.                                                                 
  249. : MMI32,   ( disp mr rmid -- )  ( mr of [eax+ebx] form)         
  250.    RMID  DOUBLE? NOT                                            
  251.    IF ( all non-double-disp cases)  OVER ( --disp mr rmid mr)   
  252.     7 AND 5 = 3 PICK 0= AND ( is it 0 [ebp+reg] case?)          
  253.      IF ( --disp mr rmid) 104 OP,  C, C,                        
  254.                  ( |01|reg|100|, =[ebp+{scl*indx}+dsp8])        
  255.      ELSE  2 PICK BIG? ( > 8 bits? If so, mode 2, 32-bit disp)  
  256.       IF 204 OP, C,   ,  0  ,                                   
  257.       ELSE  2 PICK 0=                                           
  258.        IF ( --disp mr rmid) 4 OP, C, DROP ( mode 0, no disp)    
  259.        ELSE  104 OP, C, C, ( mode 1, byte disp)  THEN THEN THEN 
  260.     ELSE ( double)  204 OP, C, SWAP  , ,   THEN ;               
  261.  
  262. SCREE╬ 15
  263.  
  264. \ Addressing: MEM32, (disp [EAX] cases, MEM32? test) 10jul88 JBD
  265.                                                                 
  266. : MEM32,   ( disp mr mr -- )                                    
  267.    RMID OVER RLOW OR    DOUBLE?  NOT                            
  268.    IF ( all single-disp cases)  -ROT   ( -- rslt disp opnd)     
  269.     [EBP] = OVER 0= AND                                         
  270.      IF  ( --rslt, disp) SWAP 100 OP, C, ( mode 1 with 0 disp)  
  271.      ELSE  SWAP OVER BIG?    ( larger than 8 bits?)             
  272.       IF    200 OP,  ,  0 ,  ( 16-bit case)                     
  273.       ELSE  OVER 0=                                             è       IF ( --disp, rslt)  C, DROP   ( mode 0, no disp)         
  274.        ELSE  100 OP, C, ( mode 1, byte disp) THEN THEN THEN     
  275.     ELSE  ( double disp) NIP  200 OP,  SWAP  ,   ,  THEN ;      
  276.  
  277. SCREE╬ 16
  278.                                                                 
  279. \ Addressing: MEM, ( cases satisfying UMEMA? test)   10jul88 JBD
  280.                                                                 
  281. : MEM,   ( disp ?op mr mr -- )                                  
  282.     OVER U#)? IF MEM#), ELSE                                    
  283.      OVER MEM? IF MEM16, ELSE                                   
  284.       OVER MEM32? IF MEM32, ELSE                                
  285.        OVER MMI32? IF MMI32, ELSE                               
  286.         MEM*, THEN THEN THEN THEN ;                             
  287.  
  288. SCREE╬ 17
  289.                                                                 
  290. \ Segment and Segment Override handling              10jul88 JBD
  291. HEX  VARIABLE INTER                                             
  292. : FAR    ( -- )   INTER ON  ;                                   
  293. : ?FAR   ( n1 -- n2 )   INTER @ IF   8 OR  THEN  INTER OFF ;    
  294. VARIABLE SOVROP   VARIABLE SOVRFLG    SOVRFLG OFF               
  295. : SEGOVR  ( opcode -- ) CREATE C, DOES>                         
  296.     C@  SOVROP  C!  SOVRFLG  ON  ;                              
  297.  2E SEGOVR CS:  3E SEGOVR DS:  26 SEGOVR ES:                    
  298.  36 SEGOVR SS:  64 SEGOVR FS:  65 SEGOVR GS:                    
  299. : SOVR? SOVRFLG @ 0<> ;                                         
  300. : SEGOVR?  SOVR? IF SOVROP C@ C,  SOVRFLG OFF THEN  ;  OCTAL    
  301.                                                                 
  302. : SEG16? ( -- f; is it ES,CS,SS or DS?)   ( 12MI use)           
  303.    DUP SEG? IF 40 AND 0= ELSE DROP 0 THEN ;                     
  304. : SEG32? ( -- f; is it FS or GS?)         ( 12MI use)           
  305.    DUP SEG? IF 40 AND 0<> ELSE DROP 0 THEN ;                    
  306.  
  307. SCREE╬ 18
  308.  
  309. \ Address Prefix handling: APREFX32 etc.             10jul88 JBD
  310. ( Handle Adr/Operand-Size 386 Prefixes)                         
  311.                                                                 
  312. VARIABLE OPSET ( 0 for 1-operand opcodes, 1 for others)         
  313. : OPSET? OPSET @ 0<> ;                                          
  314. VARIABLE DUN  0 DUN !   : DUN? DUN @ 0<> ;                      
  315.                                                                 
  316. : APREFX32 ( ...-...)                                           
  317.    SPT @ PICK DUP DUP  D#)?  SWAP UMEM32? OR SWAP *?  OR        
  318.     IF   1 DUN !                                                
  319.     ELSE  SPT @ PICK DUP  DUP MEM? SWAP #)? OR SWAP S#) = OR    
  320.      IF 147 C, 1 DUN !  THEN  THEN                              
  321.    SPT @ 0=  ( move ptr to begn of source opnds)                
  322.    OPSET?  AND                                                  
  323.     IF ( must be reg ) 1 SPT !  THEN  ;                         
  324.                                                                 
  325. SCREE╬ 19
  326.  
  327. \ Address Prefix handling: APREFX16 etc.             10jul88 JBDè                                                                
  328. : APREFX16 ( ...-...) ( USE16, 32 bit adr. cases)               
  329.    SPT @ PICK DUP  #)?  SWAP MEM?  OR                           
  330.     IF   1 DUN !   ( no adr-size prefix reqd)                   
  331.     ELSE  SPT @    PICK DUP  UMEM32? SWAP D#)?   OR ( --..flg)  
  332.           SPT @ 1+ PICK DUP  *?      SWAP SD#)?  OR  OR         
  333.      IF 147 C, 1 DUN !  THEN  THEN                              
  334.    SPT @ 0= ( move ptr to begn of sOs opnds)                    
  335.    OPSET?  AND                                                  
  336.     IF ( must be reg) 1 SPT ! THEN ;                            
  337.                                                                 
  338. SCREE╬ 20
  339.  
  340. \ Operand Prefix handling: OPREFX32                  10jul88 JBD
  341.                                                                 
  342. : OPREFX32 ( ...--...)  ( USE32, but 16-bit opnds?)             
  343.    SPT @ PICK  DUP  D#?  SWAP R32?  OR                          
  344.     IF   1 DUN !                                                
  345.     ELSE  SPT @ PICK DUP  R16? SWAP #?  OR                      
  346.      IF 146 C, 1 DUN !  THEN  THEN                              
  347.    SPT @ 0=  ( move ptr to begn of source opnds)                
  348.    OPSET?  AND                                                  
  349.     IF DUP  REG? IF 1 SPT !  THEN                               
  350.      DUP DUP  MEM?  SWAP #)?  OR  IF 2 SPT !  THEN              
  351.      DUP D#)?  IF 3 SPT !  THEN                                 
  352.      DUP UMEM32? IF DOUBLE? IF 3 SPT ! ELSE 2 SPT ! THEN THEN   
  353.      DUP   *?   IF DOUBLE? IF 4 SPT ! ELSE 3 SPT ! THEN THEN    
  354.     THEN ;                                                      
  355.                                                                 
  356. SCREE╬ 21
  357.  
  358. \ Operand Prefix handling: OPREFX16                  10jul88 JBD
  359.                                                                 
  360. : OPREFX16 ( ...--...) ( USE16,  but 32 bit operands?)          
  361.    SPT @ PICK DUP  #?  SWAP R16?  OR                            
  362.     IF   1 DUN !   ( no opnd-size prefix required)              
  363.      ELSE  SPT @ PICK DUP  R32?  SWAP D#?  OR                   
  364.     IF 146 C, 1 DUN !  THEN  THEN                               
  365.    SPT @ 0= ( move ptr to begn of source opnds)                 
  366.    OPSET?  AND                                                  
  367.     IF DUP  REG? IF 1 SPT !  THEN                               
  368.      DUP DUP  MEM?  SWAP #)?  OR  IF 2 SPT !  THEN              
  369.      DUP D#)?  IF 3 SPT !  THEN                                 
  370.      DUP UMEM32? IF DOUBLE? IF 3 SPT ! ELSE 2 SPT ! THEN THEN   
  371.      DUP   *?   IF DOUBLE? IF 4 SPT ! ELSE 3 SPT ! THEN THEN    
  372.     THEN ;                                                      
  373.                                                                 
  374. SCREE╬ 22
  375.  
  376. \ Addrs/Operand Prefixes: PREFX, ADRPREFX, OPNDPREFX 10jul88 JBD
  377. : OPNDPREFX ( ..reg -- ..reg ) 0 SPT !  0 DUN !  USE?           
  378.    IF OPREFX32  DUN? NOT                                        
  379.     IF  OPREFX32  DUN? NOT SIZE32? NOT AND                      
  380.      IF 146 C, THEN  THEN                                       
  381.    ELSE  OPREFX16 DUN? NOT                                      è    IF  OPREFX16 DUN? NOT SIZE32? AND                           
  382.      IF 146 C, THEN THEN THEN ;                                 
  383. : ADRPREFX ( ..Reg -- ..Reg ) 0 SPT !  0 DUN !                  
  384.    USE?  IF APREFX32 DUN? NOT  IF  APREFX32 THEN                
  385.    ELSE APREFX16 DUN? NOT  IF  APREFX16 THEN THEN ;             
  386. : PREFX ( ..reg opadr. -- ..reg opadr)                          
  387.     ADRPREFX  OPNDPREFX  SEGOVR? ;                              
  388.  VARIABLE OP                                                    
  389. : OFFPREFX ( ..op -- ..op ) OP C! OPSET OFF PREFX OP C@ ;       
  390. : ONPREFX  ( ..op -- ..op ) OP C! OPSET  ON PREFX OP C@ ;       
  391.  
  392. SCREE╬ 23
  393.  
  394. \ OPND, OPADR;  WMEM, R/M,  WR/SM,                   10jul88 JBD
  395.                                                                 
  396.  VARIABLE OPND  VARIABLE OPADR                                  
  397.                                                                 
  398. : WMEM,  ( disp mem reg op -- )  OVER  W,  MEM, ;               
  399.                                                                 
  400. : R/M, ( mr reg -- )  OVER REG? IF  RR, ELSE MEM, THEN ;        
  401.                                                                 
  402. : WR/SM,   ( rm reg op -- )   2 PICK DUP REG?                   
  403.    IF  W, RR,  ELSE  DROP SIZE, MEM,  THEN  SIZE ON  ;          
  404.  
  405. SCREE╬ 24
  406.  
  407. \ 1MI, 2MI                                           10jul88 JBD
  408. : 1MI   CREATE  C,  DOES>  C@ C,  ;                             
  409. HEX                                                             
  410.  37 1MI AAA  3F 1MI AAS  F8 1MI CLC  FC 1MI CLD  FA 1MI CLI     
  411.  F5 1MI CMC  27 1MI DAA  2F 1MI DAS  F4 1MI HLT  CE 1MI INTO    
  412.  9F 1MI LAHF F0 1MI LOCK 90 1MI NOP  F2 1MI REP  F3 1MI REPE    
  413.  F2 1MI REPNE   F2 1MI REPNZ   F3 1MI REPZ   9E 1MI SAHF        
  414.  F9 1MI STC  FD 1MI STD  FB 1MI STI  9B 1MI WAIT D7 1MI XLAT    
  415. OCTAL                                                           
  416.                                                                 
  417. : 2MI   CREATE  C,  DOES>  C@ C,  12 C,  ;                      
  418. HEX  D5 2MI AAD  D4 2MI AAM OCTAL                               
  419.  
  420. SCREE╬ 25
  421.  
  422. \ .386 etc, SHORT etc.                               10jul88 JBD
  423.                                                                 
  424. VARIABLE .386VAR    .386VAR OFF                                 
  425. : .386? .386VAR @ 0<> ;         ( all for 3MI use)              
  426. : .386  .386? IF  .386VAR ON ELSE .386VAR OFF THEN ; ( toggles) 
  427.                                                                 
  428. VARIABLE SHORT                                                  
  429. ( Use SH before 3MI words for short jump when 386 enabled)      
  430. : SH  SHORT ON  ;                                               
  431. : SH? SHORT @ 0<> ;                                             
  432.                                                                 
  433. SCREE╬ 26
  434.  
  435. \ 3MI, JA etc.                                       10jul88 JBDè                                                                
  436. : 3MI   CREATE  C,  DOES>  .386? NOT                            
  437.    IF  C@ C,  HERE - 1-                                         
  438.     DUP -200 177 WITHIN NOT ABORT" Branch out of Range" C,      
  439.    ELSE ( all 386 cases) C@ OFFPREFX   SH?                      
  440.     IF SHORT OFF  C,  #)?                                       
  441.      IF HERE - 1- C,                                            
  442.      ELSE ( D#}) HERE 4 + S>D  D-  DROP C, THEN                 
  443.     ELSE ( 386 near, not short)  17 C, 20 + C, #)?              
  444.      IF  HERE - 2- ,                                            
  445.      ELSE ( D#}) HERE 4 + S>D D- SWAP , ,                       
  446.    THEN THEN THEN  WRAP ;                                       
  447.                                                                 
  448. SCREE╬ 27
  449.  
  450. \ 3MI  words                                         10jul88 JBD
  451. HEX                                                             
  452.  77 3MI JA   73 3MI JAE   72 3MI JB    76 3MI JBE   72 3MI JC   
  453.  74 3MI JE   7F 3MI JG    7D 3MI JGE   7C 3MI JL    7E 3MI JLE  
  454.  76 3MI JNA  72 3MI JNAE  73 3MI JNB   77 3MI JNBE  73 3MI JNC  
  455.  75 3MI JNE  7E 3MI JNG   7C 3MI JNGE  7D 3MI JNL   7F 3MI JNLE 
  456.  71 3MI JNO  7B 3MI JNP   79 3MI JNS   75 3MI JNZ   70 3MI JO   
  457.  7A 3MI JP   7A 3MI JPE   7B 3MI JPO   78 3MI JS    74 3MI JZ   
  458.                                                                 
  459. OCTAL                                                           
  460.                                                                 
  461. SCREE╬ 28
  462.  
  463. \ 4MI, 14MI                                          10jul88 JBD
  464. OCTAL                                                           
  465. : 4MI   CREATE  C,  DOES>  C@ ONPREFX                           
  466.    C,  MEM, WRAP ;                                              
  467. HEX  C5 4MI LDS  8D 4MI LEA  C4 4MI LES  OCTAL                  
  468.                                                                 
  469. ( 14MI is 386 instrucs not covered by 4MI)                      
  470.                                                                 
  471. : 14MI   CREATE   C,  DOES>  C@ ONPREFX  17 C,                  
  472.    C,  MEM, WRAP ;                                              
  473. HEX  B4 14MI LFS   B5 14MI LGS   B2 14MI LSS OCTAL              
  474.  
  475. SCREE╬ 29
  476.  
  477. \ 5MI                                                10jul88 JBD
  478. : 5MI   CREATE  C,  DOES>   ( no numeric operands)              
  479.    0 ( dummy param for PREFX) SWAP C@  OFFPREFX NIP             
  480.    SIZE,  WRAP  ;                                               
  481.  ( Use with BY, WD or DW to give opnd size, with optional       
  482.    seg override for source string; dest. uses auto ES: override)
  483.  HEX  A6 5MI CMPS  A4 5MI MOVS  AE 5MI SCAS                     
  484. : CMPSB  A6 C, ;                                                
  485. : CMPSW  WD OPSET OFF 0 PREFX DROP A7 C, WRAP ;                 
  486. : CMPSD  DW OPSET OFF 0 PREFX DROP A7 C, WRAP ;                 
  487. : MOVSB  A4 C, ;                                                
  488. : MOVSW  WD OPSET OFF 0 PREFX DROP A5 C, WRAP ;                 
  489. : MOVSD  DW OPSET OFF 0 PREFX DROP A5 C, WRAP ;                 è: SCASB  AE C, ;                                                
  490. : SCASW  WD OPSET OFF 0 PREFX DROP AF C, WRAP ;                 
  491. : SCASD  DW OPSET OFF 0 PREFX DROP AF C, WRAP ;     OCTAL       
  492.  
  493. SCREE╬ 30
  494.  
  495. \ 6MI, LODS etc.; 7MI, DIV etc.                      10jul88 JBD
  496.  ( Use with BY, WD or DW to give opnd size)                     
  497. : 6MI   CREATE  C,  DOES>  C@ 0 SWAP OFFPREFX                   
  498.    SWAP DROP  SIZE, WRAP ;                                      
  499. HEX  AC 6MI LODS  AA 6MI STOS                                   
  500. : LODSB ( no opnds) AC C, ;                                     
  501. : LODSW ( no opnds) DX  OPSET OFF PREFX  DROP  AD C, ;          
  502. : LODSD ( no opnds) EDX OPSET OFF PREFX  DROP  AD C, ;          
  503. : STOSB ( no opnds) AA C, ;                                     
  504. : STOSW ( no opnds) DX  OPSET OFF PREFX  DROP  AB C, ;          
  505. : STOSD ( no opnds) EDX OPSET OFF PREFX  DROP  AB C, ;  OCTAL   
  506.                                                                 
  507. : 7MI   CREATE  C,  DOES> C@ OFFPREFX 366 WR/SM, WRAP ;         
  508.  
  509. SCREE╬ 31
  510.  
  511. \ 8MI: IN, OUT;  9MI: DEC, INC                       10jul88 JBD
  512.                                                                 
  513. : 8MI   CREATE  C,  DOES>  C@ OP C! OPSET ON PREFX OP C@        
  514.    SWAP DUP R16? SWAP R32? OR 1 AND OR  SWAP # =                
  515.    IF  C, C,  ELSE  ( DX) 10 OR  C,  THEN  WRAP ;               
  516.                                                                 
  517. HEX E4 8MI IN  E6 8MI OUT  OCTAL                                
  518.                                                                 
  519. : 9MI   CREATE  C,  DOES>  C@ OP C! OPSET OFF PREFX OP C@       
  520.    OVER DUP R16? SWAP R32? OR                                   
  521.     IF  100 OR SWAP RLOW OP,                                    
  522.     ELSE  376 WR/SM, THEN   WRAP ;                              
  523.                                                                 
  524. HEX  8 9MI DEC  0 9MI INC  OCTAL                                
  525.  
  526. SCREE╬ 32
  527.  
  528. \ 10MI, RCL etc.                                     10jul88 JBD
  529.    ( 1 # m/r shl,  cl m/r shl,  imm8 # m/r shl are legal forms) 
  530.                                                                 
  531. : 10MI CREATE C, DOES> C@ OP C!  OPSET ON PREFX OP C@           
  532.     SPT @ 1+ ROLL ( CL or # ) CL =                              
  533.     IF  322 WR/SM,                                              
  534.     ELSE ( #)                                                   
  535.      SPT @ 1+ ROLL ( imm8 data)  DUP 1 =                        
  536.      IF  DROP 320  WR/SM,                                       
  537.      ELSE ( imm8) OPND !  300 WR/SM, OPND @ C,                  
  538.     THEN THEN  WRAP ;                                           
  539.                                                                 
  540. HEX   10 10MI RCL   18 10MI RCR    0 10MI ROL   8 10MI ROR      
  541.       38 10MI SAR   20 10MI SHL   20 10MI SAL  28 10MI SHR      
  542. OCTAL                                                           
  543. èSCREE╬ 33
  544.  
  545. \ 11MI, CALL and JMP                                 10jul88 JBD
  546.                                                                 
  547. : 11MI   CREATE  C, C,  DOES>  OPADR ! OPSET OFF PREFX          
  548.    OPADR @ OVER DUP OPND ! DUP #)? SWAP D#)? OR                 
  549.    IF  NIP C@ INTER @                                           
  550.      IF  1 AND IF  352  ELSE  232  THEN  C, OPND @ #)?          
  551.       IF SWAP , , ELSE -ROT SWAP , , , THEN INTER OFF           
  552.      ELSE OPND @ #)?                                            
  553.       IF  SWAP HERE - 2- SWAP  2DUP 1 AND SWAP BIG? NOT AND     
  554.        IF  2 OP, C,  ELSE  C,  1- ,  THEN                       
  555.       ELSE ( D#}) -ROT HERE 5 + S>D D- ROT C, SWAP , , THEN THEN
  556.    ELSE  OVER S#) =                                             
  557.     IF NIP #) SWAP  ELSE OVER SD#)?                             
  558.      IF NIP D#) SWAP THEN THEN                                  
  559.    377 C, 1+ C@ ?FAR  R/M,  THEN  WRAP ;                        
  560. HEX  10 E8 11MI  CALL    20 E9 11MI JMP      OCTAL              
  561.  
  562. SCREE╬ 34
  563.  
  564. \ 12MI, PUSH and POP                                 10jul88 JBD
  565. : 12MI ( immed, 32segreg{2bytes}, m/r, segreg, reg opcodes -- ) 
  566.          CREATE  C, C, C, C, C, C, DOES>                        
  567.    OPADR ! OPSET OFF PREFX OPADR @ OVER REG?                    
  568.    IF  C@ SWAP RLOW OP,                                         
  569.    ELSE  1+ OVER SEG16?                                         
  570.     IF  C@ RLOW SWAP RMID OP,                                   
  571.     ELSE  OVER UMEMA?                                           
  572.      IF  COUNT SWAP C@ C,  MEM,                                 
  573.      ELSE 2+ OVER SEG32?                                        
  574.       IF COUNT C, C@ OVER FS = IF C, ELSE 10 + C, THEN  DROP    
  575.       ELSE ( Immed: PUSH only) 2+ SWAP D#?                      
  576.        IF C@   C, SWAP , ,                                      
  577.        ELSE ( # ) C@ ( disp op) SWAP DUP BIG?                   
  578.         IF SWAP C, , ELSE ( 8 bits) SWAP 2 OR  C, C,            
  579.     THEN THEN THEN THEN THEN THEN  WRAP ;                       
  580.  
  581. SCREE╬ 35
  582.  
  583. \ 12MI, PUSH and POP opcodes                         10jul88 JBD
  584.                                                                 
  585. HEX                                                             
  586.                                                                 
  587. 68 0A0 0F 0FF 36 50  12MI PUSH                                  
  588.                                                                 
  589. 0  0A1 0F 8F  07 58  12MI POP                                   
  590.                                                                 
  591. OCTAL                                                           
  592.  
  593. SCREE╬ 36
  594.  
  595. \ NROLL :  TOS to N+1th stack position               10jul88 JBD
  596.                                                                 
  597. ( 1 NROLL = SWAP, 2 NROLL = -ROT )                              è                                                                
  598. VARIABLE NUMROLL ( number to ROLL)                              
  599.                                                                 
  600. : NROLL ( n --)  DUP 0<>            ( for 13MIMEM use)          
  601.    IF  DUP NUMROLL !  0 DO                                      
  602.     NUMROLL @  ROLL LOOP   ELSE DROP  THEN ;                    
  603.                                                                 
  604. SCREE╬ 37
  605.  
  606. \ 13MI: 13MISIMM                                     10jul88 JBD
  607.                                                                 
  608.  : 13MISIMM ( immed. source with reg dest)                      
  609.     OPND @ #?                                                   
  610.     IF   OVER B/L? OVER DUP  R16?  SWAP R32? OR 2DUP AND        
  611.      -ROT 1 AND SWAP NOT 2 AND OR 200 OP,                       
  612.      SWAP RLOW 300 OR  OP @  OP,  ,/C,                          
  613.     ELSE ( D# source) 177777 DUP 2DUP AND                       
  614.      -ROT 1 AND SWAP NOT 2 AND OR 200 OP,                       
  615.      SWAP RLOW 300 OR  OP @  OP, DROP SWAP , ,                  
  616.     THEN  ;                                                     
  617.                                                                 
  618. SCREE╬ 38
  619.  
  620. \ 13MI: 13MIMEM                                      10jul88 JBD
  621.                                                                 
  622. : 13MIMEM  ( dest= mem cases of 13MI)                           
  623.    SPT @  ROLL  DUP REG?                                        
  624.    IF  OP C@  WMEM,                                             
  625.    ELSE  ( #)  #?                                               
  626.     IF SPT @  PICK B/L? DUP NOT 2 AND 200 OR SIZE,              
  627.      SPT @  NROLL  OP @  MEM,                                   
  628.      SIZE @ AND ,/C,                                            
  629.     ELSE ( D#) 177777 DUP NOT 2 AND 200 OR SIZE,                
  630.      SPT @  NROLL  OP @  MEM,                                   
  631.      DROP SWAP , ,  THEN  THEN  ;                               
  632.  
  633. SCREE╬ 39
  634.  
  635. \ 13MI, ADD etc.                                     10jul88 JBD
  636.                                                                 
  637. : 13MI  CREATE C, C, DOES>  COUNT OP C!  C@ LOGICAL !           
  638.    OPSET ON PREFX  DUP REG? ( dest a reg?)                      
  639.    IF  OVER REG?  ( source a reg also?)                         
  640.     IF OP @ OVER W, SWAP RR,                                    
  641.     ELSE  OVER DUP UMEM? SWAP U#)?   OR  ( memory source?)      
  642.      IF  OP @ 2 OR WMEM,                                        
  643.      ELSE  ( # or D#) OVER OPND  !  NIP DUP RLOW 0= ( accum?)   
  644.       IF  OP @ 4 OR OVER W, OPND @ #?                           
  645.        IF  R16? ,/C,  ELSE ( D#) DROP  SWAP , , THEN            
  646.       ELSE 13MISIMM ( immed. source, dest reg but not accum)    
  647.     THEN THEN THEN                                              
  648.    ELSE  ( mem dest.)  13MIMEM THEN  WRAP ;                     
  649.  
  650. SCREE╬ 40
  651. è\ 15MI, SETcond                                      10jul88 JBD
  652.                                                                 
  653. : 15MI  CREATE  C, DOES> C@ OFFPREFX  17 C,  220 OR C,          
  654.    DUP R8?                                                      
  655.     IF  RLOW 300 OP,                                            
  656.     ELSE ( mem) 0 ( rmid) MEM, THEN  WRAP ;                     
  657.                                                                 
  658. HEX                                                             
  659. 7 15MI SETA 3 15MI SETAE  2 15MI SETB 6 15MI SETBE 2 15MI SETC  
  660. 4 15MI SETE F 15MI SETG 0D 15MI SETGE 0C 15MI SETL 0E 15MI SETLE
  661.  6 15MI SETNA  2 15MI SETNAE  3 15MI SETNB  7 15MI SETNBE       
  662.  3 15MI SETNC  5 15MI SETNE  0E 15MI SETNG 0C 15MI SETNGE       
  663. 0D 15MI SETNL 0F 15MI SETNLE  1 15MI SETNO 0B 15MI SETNP        
  664.  9 15MI SETNS  5 15MI SETNZ   0 15MI SETO  0A 15MI SETP         
  665. 0A 15MI SETPE 0B 15MI SETPO   8 15MI SETS   4 15MI SETZ         
  666. OCTAL                                                           
  667.  
  668. SCREE╬ 41
  669.  
  670. \ 16MI + 17MI, CBW,CWD etc, PUSHA/POPA etc, IRET/D   10jul88 JBD
  671.                                                                 
  672. : 16MI  CREATE C, DOES> USE? IF 146 C, ( 66h) THEN              
  673.    C@ C, WRAP ;                                                 
  674.                                                                 
  675. HEX  99 16MI CWD   98 16MI CBW  60 16MI PUSHA  9C 16MI PUSHF    
  676.      61 16MI POPA  9D 16MI POPF CF 16MI IRET                    
  677. OCTAL                                                           
  678.                                                                 
  679. : 17MI  CREATE C, DOES> USE? NOT IF 146 C, ( 66h) THEN          
  680.    C@ C, WRAP ;                                                 
  681.                                                                 
  682. HEX  99 17MI CDQ  98 17MI CWDE  60 17MI PUSHAD  9C 17MI PUSHFD  
  683.      61 17MI POPAD  9D 17MI POPFD  CF 17MI IRETD                
  684. OCTAL                                                           
  685.  
  686. SCREE╬ 42
  687.  
  688. \ 18MI,  SHLD/SHRD ( non-standard modr/m byte)       10jul88 JBD
  689.    ( cl reg m/r shld,  imm8 # reg m/r shld  are legal forms)    
  690. VARIABLE CLFLG      : CL? CL = 0<> ;    : CL  CL CLFLG ON ;     
  691. : CLFLG? CLFLG @ 0<> ;                                          
  692. : 18MI CREATE C, DOES> C@  ONPREFX   17 C,                      
  693.    SPT @ 2+ ROLL ( CL or # )  CL?                               
  694.     IF  1+ C,                                                   
  695.     ELSE ( # ) SPT @ 2+ ROLL  OPND C!  C, THEN                  
  696.    DUP REG? ( dest a reg?)                                      
  697.     IF ( source a reg also) SWAP RR,  CLFLG?                    
  698.      IF CLFLG OFF ELSE  OPND C@ ( imm8) C, THEN                 
  699.     ELSE ( dest mem, source reg)                                
  700.      SPT @ ROLL MEM,  CLFLG?                                    
  701.      IF CLFLG OFF ELSE  OPND C@ ( imm8) C, THEN                 
  702.     THEN  WRAP ;                                                
  703. HEX   A4 18MI SHLD  AC 18MI SHRD   OCTAL                        
  704.  
  705. SCREE╬ 43è
  706. \ 19MI, LAR + LSL, BSF + BSR                         10jul88 JBD
  707.                                                                 
  708. : 19MI CREATE C, DOES> C@  ONPREFX  17 C, C,                    
  709.    OVER REG?  ( source a reg also?)                             
  710.     IF   RR,                                                    
  711.     ELSE ( mem source)  MEM, THEN  WRAP ;                       
  712.                                                                 
  713. HEX  02 19MI LAR   03 19MI LSL                                  
  714.      BC 19MI BSF   BD 19MI BSR   OCTAL                          
  715.                                                                 
  716. SCREE╬ 44
  717.  
  718. \ 20MI, LGDT etc.                                    10jul88 JBD
  719.                                                                 
  720.   ( 2nd op, rmid -- )                                           
  721. : 20MI  CREATE  C, C, DOES> DUP OPADR !  C@ OFFPREFX            
  722.    17 C,  C, OPADR @ 1+ C@ ( rmid)                              
  723.    OVER REG?                                                    
  724.     IF  SWAP RLOW  OR  300 OP,                                  
  725.     ELSE ( mem)  MEM, THEN  WRAP ;                              
  726.                                                                 
  727. HEX  10 1 20MI LGDT   18 1 20MI LIDT   10 0 20MI LLDT           
  728.      18 0 20MI LTR     0 1 20MI SGDT    8 1 20MI SIDT           
  729.       0 0 20MI SLDT   20 1 20MI SMSW    8 0 20MI STR            
  730.      20 0 20MI VERR   28 0 20MI VERW                            
  731. OCTAL                                                           
  732.                                                                 
  733. SCREE╬ 45
  734.  
  735. \ 21MI, BT  etc.                                     10jul88 JBD
  736.    ( reg m/r bt,  imm8 # m/r bt  are legal forms)               
  737.        ( N.B.: non-standard modr/m byte!)                       
  738. : 21MI CREATE C, DOES> C@ OP C! OPSET ON PREFX   17 C,          
  739.    SPT @  ROLL ( reg or  # ) DUP #?  ( source immed?)           
  740.     IF  DROP 272 C, SPT @ ROLL OPND C! DUP REG? ( dest a reg?)  
  741.      IF RLOW 300 OR  OP C@ OR C,  OPND C@ C,                    
  742.      ELSE ( mem dest) OP C@ MEM, OPND C@ C, THEN                
  743.     ELSE ( reg source ) OPND !  OP C@ 203 OR C,                 
  744.      DUP REG? ( dest a reg also?)                               
  745.       IF OPND @ ( source reg)  RR,                              
  746.       ELSE ( dest mem, source reg)  OPND @ MEM, THEN            
  747.     THEN  WRAP ;                                                
  748.                                                                 
  749. HEX  20 21MI BT   38 21MI BTC   30 21MI BTR   28 21MI BTS       
  750. OCTAL                                                           
  751.  
  752. SCREE╬ 46
  753.  
  754. \ 22MI, INS etc.                                     10jul88 JBD
  755. : 22MI   CREATE  C,  DOES>   ( DX -- )                          
  756.    SWAP DROP ( DX not needed in code)                           
  757.    0 ( dummy param for PREFX ) SWAP C@  OFFPREFX NIP            
  758.    SIZE,  WRAP  ;                                               
  759.  ( Use with BY, WD or DW to give operand size.)                 è                                                                
  760. HEX  6C 22MI INS   6E 22MI OUTS                                 
  761.                                                                 
  762. : INSB   6C C, ;                                                
  763. : INSW   WD OPSET OFF 0 PREFX DROP  6D C, WRAP ;                
  764. : INSD   DW OPSET OFF 0 PREFX DROP  6D C, WRAP ;                
  765. : OUTSB  6E C, ;                                                
  766. : OUTSW  WD OPSET OFF 0 PREFX DROP  6F C, WRAP ;                
  767. : OUTSD  DW OPSET OFF 0 PREFX DROP  6F C, WRAP ;                
  768. OCTAL                                                           
  769.  
  770. SCREE╬ 47
  771.  
  772. \ 23MI, MOVSX and MOVZX                              10jul88 JBD
  773.                                                                 
  774. : 23MI CREATE C, DOES> C@  ONPREFX  17 C,                       
  775.    2 PICK  R8? IF C, ELSE  SIZE, THEN                           
  776.    OVER REG?  ( source a reg also?)                             
  777.     IF  RR,                                                     
  778.     ELSE ( mem source)  MEM, THEN WRAP ;                        
  779.                                                                 
  780. HEX  BE 23MI MOVSX  B6 23MI MOVZX  OCTAL                        
  781.                                                                 
  782. SCREE╬ 48
  783.  
  784. \ TEST: TESTMEM                                      10jul88 JBD
  785.                                                                 
  786. : TESTMEM  ( dest= mem cases of TEST)                           
  787.    SPT @    ROLL  DUP REG?                                      
  788.    IF  204  WMEM,                                               
  789.    ELSE  ( # )  #?                                              
  790.     IF  366 SIZE, 0 MEM, SIZE @ ,/C,                            
  791.     ELSE ( D# ) 366 SIZE, 0 MEM, SWAP  , ,                      
  792.    THEN  THEN  ;                                                
  793.                                                                 
  794. SCREE╬ 49
  795.  
  796. \ TEST                                               10jul88 JBD
  797.                                                                 
  798. : TEST  OPSET ON PREFX                                          
  799.    DUP REG? ( dest a reg?)                                      
  800.    IF  OVER REG?  ( source a reg also?)                         
  801.     IF 204  OVER W, SWAP RR,                                    
  802.     ELSE  OVER DUP UMEM? SWAP U#)?   OR  ( memory source?)      
  803.      IF  204  WMEM,                                             
  804.      ELSE  ( # or D# ) OVER OPND  !  NIP DUP RLOW 0= ( ACC? )   
  805.       IF  250  OVER W,                                          
  806.       ELSE 366 OVER W, DUP RLOW 300 OP, THEN                    
  807.       DUP R32? IF ( #D) DROP SWAP , ,                           
  808.        ELSE R16?  ,/C,  THEN THEN THEN                          
  809.    ELSE  ( mem dest.)  TESTMEM  THEN  WRAP ;                    
  810.  
  811. SCREE╬ 50
  812.  
  813. \ ESC, INT, XCHG                                     10jul88 JBDèHEX                                                             
  814.                                                                 
  815. : ESC  ( rm, 6-bit const -- ) RLOW  0D8  OP, R/M, ;             
  816.                                                                 
  817. : INT  ( n -- )  0CD  C, C,  ;  ( N.B.: no # )                  
  818.                                                                 
  819. : XCHG   ( mr1 mr2 -- )   OPSET ON PREFX  DUP REG?              
  820.    IF  DUP DUP AX =  SWAP EAX = OR                              
  821.      IF  DROP RLOW 90 OP,  ELSE  OVER DUP AX =  SWAP EAX = OR   
  822.      IF  NIP  RLOW 90 OP,  ELSE  86 WR/SM,  THEN  THEN          
  823.    ELSE  ROT 86 WR/SM,  THEN  WRAP ;                            
  824.  
  825. SCREE╬ 51
  826.  
  827. \ MOV: MOVRGSG2                                      10jul88 JBD
  828.                                                                 
  829. : MOVRGSG2 ( -- ss dst )       ( Continuation from MOVRGSG1)    
  830.     OVER SEG?                                                   
  831.     IF  SWAP 8C C, RR,                                          
  832.     ELSE  OVER DUP  #?   SWAP D#?  OR                           
  833.      IF   DUP DUP  R16? SWAP R32?  OR  SWAP                     
  834.       RLOW OVER 8 AND OR B0 OP,                                 
  835.       SWAP D#?  IF  DROP SWAP , ,  ELSE  ,/C,  THEN             
  836.      ELSE  8A OVER W, R/M,  THEN THEN ;                         
  837.  
  838. SCREE╬ 52
  839.  
  840. \ MOV: MOVRGSG1                                      10jul88 JBD
  841.                                                                 
  842. : MOVRGSG1 ( -- ss dst )  ( dest either REG or SEG)             
  843.    DUP SEG?                                                     
  844.    IF  8E C, R/M,                                               
  845.    ELSE  DUP REG?                                               
  846.     IF  ( direct memory source? )  OVER DUP                     
  847.      #)?  SWAP  D#)?  OR  OVER RLOW 0= AND                      
  848.       IF  A0 SWAP W,  D#)?  IF  SWAP , , ELSE  ,  THEN          
  849.       ELSE  ( all other cases )  MOVRGSG2  THEN THEN THEN ;     
  850.  
  851. SCREE╬ 53
  852.  
  853. \ MOV: MOVMEM                                        10jul88 JBD
  854.   ( dest a memory expression, so source is reg or immed.)       
  855.                                                                 
  856. : MOVMEM   ( ss dst -- )    ( dest a memory expression)         
  857.    SPT @  ( PREFX handles increment for double displacements)   
  858.    ROLL  DUP SEG?  ( source a segreg?)                          
  859.    IF  8C C, MEM,                                               
  860.    ELSE  DUP #?                                                 
  861.     IF  DROP C6 SIZE, 0 MEM,  SIZE @ ,/C,                       
  862.     ELSE  DUP D#?                                               
  863.      IF  DROP C6 SIZE, 0 MEM,  SWAP , ,                         
  864.      ELSE  OVER #)?  OVER RLOW 0= AND                           
  865.       IF  A2 SWAP W,  DROP   ,   ELSE  88 OVER W, R/M,          
  866.       THEN THEN THEN  THEN  ;                                   
  867.                                                                 èSCREE╬ 54
  868.  
  869. \ MOV, MOVSPL                                        10jul88 JBD
  870.                                                                 
  871. : MOVSPL  0F C, DUP SPL? ( dest SPL?)                           
  872.    IF DUP CTL? IF 22 ELSE DUP DBG? IF 23 ELSE 26 THEN THEN      
  873.     C, RMID SWAP RLOW OR C0 OR C,                               
  874.    ELSE ( source is SPL)  SPT @  PICK                           
  875.     DUP CTL? IF DROP 20 ELSE  DBG? IF 21 ELSE 24 THEN THEN      
  876.     C, RLOW SWAP RMID OR C0 OR C, THEN ;                        
  877.                                                                 
  878. : MOV ( source dest--) OPSET ON PREFX                           
  879.    DUP SPL?  SPT @ 1+ PICK SPL?  OR  ( dest or source SPL?)     
  880.     IF MOVSPL                                                   
  881.     ELSE  DUP DUP REG? SWAP SEG?  OR ( dest reg or segreg?)     
  882.      IF MOVRGSG1  ELSE MOVMEM THEN THEN  WRAP ;                 
  883.                                                                 
  884. SCREE╬ 55
  885.  
  886. \ ARPL, CLTS, BOUND, ENTER, LEAVE                    10jul88 JBD
  887. OCTAL                                                           
  888.  ( r16 m/r16 ARPL)                                              
  889. : ARPL  ( N.B.: non-standard modr/m byte!)                      
  890.         OPSET ON PREFX 143 C, DUP R16?                          
  891.    IF SWAP RR, ELSE ( mem dest) SPT @ ROLL MEM, THEN WRAP ;     
  892.                                                                 
  893. : CLTS  ( --) 17 C,  6 C, ;                                     
  894.                                                                 
  895. : BOUND ( mem reg bound) OPSET ON PREFX  142 C, MEM, WRAP ;     
  896.                                                                 
  897. : ENTER ( imm8  imm16  enter)                                   
  898.    310 C,  ,  C,  ;                                             
  899.                                                                 
  900. : LEAVE  ( --)  311 C, ;                                        
  901.                                                                 
  902. SCREE╬ 56
  903.  
  904. \ JCXZ, JECXZ                                        10jul88 JBD
  905.                                                                 
  906. : JCXZ ( adr, #} or D#}  -- )  USE?                             
  907.    IF 146 C, THEN  343 C,  #)?                                  
  908.     IF  HERE - 2- ,                                             
  909.     ELSE ( D#})  HERE 4 + S>D D- SWAP , ,  THEN ;               
  910.                                                                 
  911. : JECXZ ( adr, #} or D#} -- )  USE? NOT                         
  912.    IF 146 C, THEN  343 C,  #)?                                  
  913.     IF  HERE - 2- ,                                             
  914.     ELSE ( D#})  HERE 4 + S>D D- SWAP , ,  THEN ;               
  915.                                                                 
  916. SCREE╬ 57
  917.  
  918. \ 7MI and 13MI, Opcode Definitions.                  10jul88 JBD
  919. ( Put here to avoid conflicts with ordinary NOT, AND and OR)    
  920.  HEX                                                            
  921.  30 7MI DIV  38 7MI IDIV  28 7MI IMUL 20 7MI MUL 10 7MI NOT     è                                                                
  922.  0 10 13MI ADC   0  0 13MI ADD   2 20 13MI AND  0 38 13MI CMP   
  923.  2  8 13MI  OR   0 18 13MI SBB   0 28 13MI SUB  2 30 13MI XOR   
  924.                                                                 
  925. DECIMAL                                                         
  926.                                                                 
  927. SCREE╬ 58
  928.  
  929. \ Structured Conditionals                            10jul88 JBD
  930. : A?>MARK    ( -- f addr ) TRUE   HERE   0 C,   ;               
  931. : A?>RESOLVE ( f addr -- ) HERE OVER 1+ - SWAP C! ?CONDITION ;  
  932. : A?<MARK    ( -- f addr ) TRUE   HERE   ;                      
  933. : A?<RESOLVE ( f addr -- ) HERE 1+ -  C,   ?CONDITION   ;       
  934. ' A?>MARK    ASSEMBLER IS ?>MARK                                
  935. ' A?>RESOLVE ASSEMBLER IS ?>RESOLVE                             
  936. ' A?<MARK    ASSEMBLER IS ?<MARK                                
  937. ' A?<RESOLVE ASSEMBLER IS ?<RESOLVE                             
  938. HEX                                                             
  939. 75 CONSTANT 0=   74 CONSTANT 0<>   79 CONSTANT 0<               
  940. 78 CONSTANT 0>=  7D CONSTANT <     7C CONSTANT >=               
  941. 7F CONSTANT <=   7E CONSTANT >     73 CONSTANT U<               
  942. 72 CONSTANT U>=  77 CONSTANT U<=   76 CONSTANT U>               
  943. 71 CONSTANT OV                                                  
  944. DECIMAL                                                         
  945.  
  946. SCREE╬ 59
  947.  
  948. \ Structured Conditionals                            10jul88 JBD
  949. HEX                                                             
  950. : IF      C,   ?>MARK  ;                                        
  951. : THEN    ?>RESOLVE   ;                                         
  952. : ELSE    0EB IF   2SWAP   THEN   ;                             
  953. : BEGIN   ?<MARK   ;                                            
  954. : UNTIL   C,   ?<RESOLVE   ;                                    
  955. : AGAIN   0EB UNTIL   ;                                         
  956. : WHILE   IF   ;                                                
  957. : REPEAT   2SWAP   AGAIN   THEN   ;                             
  958. : DO      # CX MOV   HERE   ;                                   
  959. : NEXT    >NEXT #) JMP   ;                                      
  960. : 1PUSH   >NEXT 1- #) JMP   ;                                   
  961. : 2PUSH   >NEXT 2- #) JMP   ;                                   
  962. DECIMAL                                                         
  963.                                                                 
  964.                                                                 
  965.