Screen 0 not modified     
 0 \ 8086 Assembler                                     cas 10nov05
 1 This 8086 Assembler was written by Klaus Schleisiek.            
 2 Assembler Definitions are created with the definig word         
 3 CODE and closed with the word END-CODE.                         
 4                                                                 
 5 The 8086 Registers naming and usage in volksFORTH               
 6                                                                 
 7 Intel vForth  Used for                   8bit-Register          
 8 AX      A     free                           A+ A-              
 9 DX      D     topmost Stackitem              D+ D-              
10 CX      C     free                           C+ C-              
11 BX      R     Returnstack Pointer            R+ R-              
12 BP      U     User Pointer                                      
13 SP      S     Stack Pointer                                     
14 SI      I     Instruction Pointer                               
15 DI      W     Word Pointer, mostly free                         
Screen 1 not modified     
 0 \ 8086 Assembler   loadscreen                        cas 10nov05
 1   Onlyforth                                                     
 2                                                                 
 3 | : u2/ ( 16b -- 15b )   2/ $7FFF and ;                         
 4 | : 8*  ( 15b -- 16b )   2* 2* 2* ;                             
 5 | : 8/  ( 16b -- 13b )   u2/ 2/ 2/ ;                            
 6                                                                 
 7   Vocabulary Assembler                                          
 8   Assembler also definitions                                    
 9                                                                 
10   3 &21 thru clear  .( Assembler loaded ) cr                    
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 2 not modified     
 0 \ conditional Assembler compiler                     cas 10nov05
 1   here                                                          
 2                                                                 
 3   : temp-assembler  ( addr -- )  hide  last off  dp !           
 4      " ASSEMBLER"  find nip ?exit   here $1800 + sp@ u>         
 5      IF  display cr ." Assembler won't fit" abort  THEN         
 6      here   sp@ $1800 - dp !  1 load   dp ! ;                   
 7                                                                 
 8   temp-assembler   \\                                           
 9                                                                 
10   : blocks   ( n -- addr / ff )                                 
11      first @ >r   dup 0 ?DO  freebuffer  LOOP                   
12      [ b/blk negate ] Literal * first @ +   r@ u> r> and ;      
13                                                                 
14                                                                 
15                                                                 
Screen 3 not modified     
 0 \ Code generating primitives                         cas 10nov05
 1                                                                 
 2   Variable >codes  \ points at table of execution vectors       
 3                                                                 
 4 | Create nrc  ] c, , here ! c! [                                
 5                                                                 
 6   : nonrelocate  nrc >codes ! ;  nonrelocate                    
 7                                                                 
 8 | : >exec ( n -- n+2 )   Create dup c, 2+                       
 9     Does> c@  >codes @ + perform ;                              
10                                                                 
11 0 | >exec >c,       | >exec >,       | >exec >here              
12   | >exec >!        | >exec >c!   drop                          
13                                                                 
14                                                                 
15                                                                 
Screen 4 not modified     
 0 \ 8086 Registers                                     cas 10nov05
 1                                                                 
 2  0 Constant A    1 Constant C    2 Constant D    3 Constant R   
 3  4 Constant S    5 Constant U    6 Constant I    7 Constant W   
 4 ' I Alias SI    ' W Alias DI    ' R Alias BX                    
 5                                                                 
 6  8 Constant A-   9 Constant C-  $A Constant D-  $B Constant R-  
 7 $C Constant A+  $D Constant C+  $E Constant D+  $F Constant R+  
 8 ' R- Alias B-   ' R+ Alias B+                                   
 9                                                                 
10   $100 Constant E:         $101 Constant C:                     
11   $102 Constant S:         $103 Constant D:                     
12                                                                 
13 | Variable isize        ( specifies Size by prefix)             
14 | : Size: ( n -- )  Create c,  Does>  c@ isize ! ;              
15   0 Size: byte      1 Size: word  word    2 Size: far           
Screen 5 not modified     
 0 \ 8086 Assembler  System variables                   cas 10nov05
 1                                                                 
 2 | Variable direction    \ 0 reg>EA, -1 EA>reg                   
 3 | Variable size         \ 1 word, 0 byte, -1 undefined          
 4 | Variable displaced    \ 1 direct, 0 nothing, -1 displaced     
 5 | Variable displacement                                         
 6                                                                 
 7 | : setsize              isize @  size ! ;                      
 8 | : long?   ( n -- f )   $FF80 and dup 0< not ?exit $FF80 xor ; 
 9 | : wexit                rdrop word ;                           
10 | : moderr               word true Abort" invalid" ;            
11 | : ?moderr ( f -- )     0=exit  moderr ;                       
12 | : ?word                size @ 1- ?moderr ;                    
13 | : far?    ( -- f )     size @ 2 = ;                           
14                                                                 
15                                                                 
Screen 6 not modified     
 0 \ 8086 addressing modes                              cas 10nov05
 1                                                                 
 2 | Create (EA  7 c, 0 c, 6 c, 4 c, 5 c,                          
 3 | : ()  ( 8b1 -- 8b2 )                                          
 4      3 - dup 4 u> over 1 = or ?moderr (EA + c@ ;                
 5                                                                 
 6  -1 Constant #       $C6 Constant #)       -1 Constant C*       
 7                                                                 
 8   : )   ( u1 -- u2 )                                            
 9      () 6 case? IF  0 $86 exit  THEN  $C0 or ;                  
10   : I)  ( u1 u2 -- u3 )  + 9 - dup 3 u> ?moderr $C0 or ;        
11                                                                 
12   : D)  ( n u1 -- n u2 )                                        
13      () over long? IF  $40  ELSE  $80  THEN or ;                
14   : DI) ( n u1 u2 -- n u3 )                                     
15      I) over long? IF  $80  ELSE  $40  THEN xor ;               
Screen 7 not modified     
 0 \ 8086 Registers and addressing modes                cas 10nov05
 1                                                                 
 2 | : displaced?  ( [n] u1 -- [n] u1 f )                          
 3      dup #) = IF  1 exit  THEN                                  
 4      dup $C0 and dup $40 = swap $80 = or ;                      
 5                                                                 
 6 | : displace    ( [n] u1 -- u1 )   displaced? ?dup 0=exit       
 7      displaced @ ?moderr   displaced !   swap displacement !  ; 
 8                                                                 
 9 | : rmode   ( u1 -- u2 )   1 size !  dup 8 and 0=exit           
10      size off  $FF07 and ;                                      
11                                                                 
12 | : mmode?  ( 9b - 9b f)     dup $C0 and ;                      
13                                                                 
14 | : rmode?  ( 8b1 - 8b1 f)   mmode? $C0 = ;                     
15                                                                 
Screen 8 not modified     
 0 \ 8086  decoding addressing modes                    cas 10nov05
 1                                                                 
 2 | : 2address  ( [n] source [displ] dest -- 15b / [n] 16b )      
 3      size on   displaced off   dup # = ?moderr   mmode?         
 4      IF  displace False  ELSE  rmode True  THEN  direction !    
 5      >r # case?  IF  r> $80C0 xor  size @ 1+ ?exit  setsize exit
 6                  THEN  direction @                              
 7      IF  r> 8* >r mmode? IF  displace                           
 8          ELSE  dup 8/ 1 and  size @ = ?moderr $FF07 and  THEN   
 9      ELSE  rmode 8*                                             
10      THEN  r> or $C0 xor ;                                      
11                                                                 
12 | : 1address  ( [displ] 9b -- 9b )                              
13      # case? ?moderr   size on   displaced off   direction off  
14      mmode? IF  displace setsize  ELSE  rmode  THEN  $C0 xor ;  
15                                                                 
Screen 9 not modified     
 0 \ 8086 assembler                                     cas 10nov05
 1 | : immediate?   ( u -- u f )  dup 0< ;                         
 2                                                                 
 3 | : nonimmediate ( u -- u )    immediate? ?moderr ;             
 4                                                                 
 5 | : r/m                        7 and ;                          
 6                                                                 
 7 | : reg                        $38 and ;                        
 8                                                                 
 9 | : ?akku  ( u -- u ff / tf )  dup r/m 0= dup 0=exit  nip ;     
10                                                                 
11 | : smode? ( u1 -- u1 ff / u2 tf )  dup $F00 and                
12      IF  dup $100 and IF  dup r/m 8* swap reg 8/                
13                           or $C0 or  direction off              
14                       THEN  True exit                           
15      THEN  False ;                                              
Screen 10 not modified     
 0 \ 8086 Registers and addressing modes                cas 10nov05
 1                                                                 
 2 | : w,          size @ or >c, ;                                 
 3                                                                 
 4 | : dw,         size @ or  direction @ IF  2 xor  THEN  >c, ;   
 5                                                                 
 6 | : ?word,  ( u1 f -- )  IF  >, exit  THEN  >c, ;               
 7                                                                 
 8 | : direct,     displaced @ 0=exit                              
 9      displacement @ dup long?  displaced @ 1+ or ?word, ;       
10                                                                 
11 | : r/m,        >c, direct, ;                                   
12                                                                 
13 | : data,       size @ ?word, ;                                 
14                                                                 
15                                                                 
Screen 11 not modified     
 0 \ 8086 Arithmetic instructions                       cas 10nov05
 1                                                                 
 2 | : Arith: ( code -- )  Create ,                                
 3   Does> @ >r   2address  immediate?                             
 4      IF  rmode? IF  ?akku IF  r> size @                         
 5                               IF  5 or >c, >, wexit  THEN       
 6                               4 or >c, >c, wexit  THEN THEN     
 7          r@ or  $80 size @ or   r> 0<                           
 8          IF  size @ IF  2 pick long? 0= IF  2 or  size off  THEN
 9          THEN       THEN  >c, >c, direct,  data,  wexit         
10      THEN  r> dw, r/m,  wexit ;                                 
11                                                                 
12   $8000 Arith: add      $0008 Arith: or                         
13   $8010 Arith: adc      $8018 Arith: sbb                        
14   $0020 Arith: and      $8028 Arith: sub                        
15   $0030 Arith: xor      $8038 Arith: cmp                        
Screen 12 not modified     
 0 \ 8086 move push pop                                 cas 10nov05
 1                                                                 
 2   : mov    [ Forth ] 2address  immediate?                       
 3      IF  rmode? IF  r/m $B0 or size @ IF  8 or  THEN            
 4                     >c, data, wexit                             
 5                 THEN  $C6 w, r/m, data, wexit                   
 6      THEN  6 case? IF  $A2 dw, direct, wexit  THEN              
 7      smode? IF  $8C direction @ IF  2 or  THEN  >c, r/m, wexit  
 8             THEN  $88 dw, r/m, wexit ;                          
 9                                                                 
10 | : pupo   [ Forth ] >r  1address  ?word                        
11      smode? IF  reg 6 r> IF  1+  THEN  or >c, wexit  THEN       
12      rmode? IF  r/m $50 or r> or >c, wexit  THEN                
13      r> IF  $8F  ELSE  $30 or $FF  THEN  >c, r/m, wexit ;       
14                                                                 
15   : push  0 pupo ;        : pop   8 pupo ;                      
Screen 13 not modified     
 0 \ 8086 inc & dec , effective addresses               cas 10nov05
 1                                                                 
 2 | : inc/dec   [ Forth ] >r 1address   rmode?                    
 3      IF  size @ IF  r/m $40 or r> or >c, wexit  THEN            
 4      THEN  $FE w, r> or r/m, wexit ;                            
 5                                                                 
 6   : dec   8 inc/dec ;         : inc   0 inc/dec ;               
 7                                                                 
 8 | : EA:  ( code -- )   Create c, [ Forth ]                      
 9   Does> >r 2address nonimmediate                                
10      rmode? direction @ 0= or ?moderr r> c@ >c, r/m, wexit ;    
11                                                                 
12   $C4 EA: les   $8D EA: lea   $C5 EA: lds                       
13                                                                 
14                                                                 
15                                                                 
Screen 14 not modified     
 0 \ 8086  xchg  segment prefix                         cas 10nov05
 1   : xchg  [ Forth ]  2address nonimmediate rmode?               
 2    IF  size @ IF  dup r/m 0=                                    
 3                   IF  8/ true  ELSE  dup $38 and 0=  THEN       
 4                   IF  r/m $90 or >c, wexit  THEN                
 5    THEN       THEN  $86 w, r/m, wexit ;                         
 6                                                                 
 7 | : 1addr:  ( code -- )  Create c, [ Forth ]                    
 8   Does> c@ >r 1address $F6 w, r> or r/m, wexit ;                
 9                                                                 
10   $10 1addr: com     $18 1addr: neg                             
11   $20 1addr: mul     $28 1addr: imul                            
12   $38 1addr: idiv    $30 1addr: div                             
13                                                                 
14   : seg   ( 8b -)    [ Forth ]                                  
15      $100 xor dup $FFFC and ?moderr  8* $26 or >c, ;            
Screen 15 not modified     
 0 \ 8086  test not neg mul imul div idiv               cas 10nov05
 1                                                                 
 2   : test   [ Forth ]  2address immediate?                       
 3      IF  rmode? IF  ?akku IF  $A8 w, data, wexit  THEN THEN     
 4          $F6 w, r/m, data, wexit                                
 5      THEN  $84 w, r/m, wexit ;                                  
 6                                                                 
 7 | : in/out  [ Forth ] >r 1address setsize                       
 8      $C2 case? IF  $EC r> or w, wexit  THEN                     
 9      6 - ?moderr  $E4 r> or w,  displacement @ >c, wexit ;      
10                                                                 
11   : out  2 in/out ;          : in   0 in/out ;                  
12                                                                 
13   : int    3 case? IF  $CC >c, wexit  THEN  $CD >c, >c, wexit ; 
14                                                                 
15                                                                 
Screen 16 not modified     
 0 \ 8086 shifts  and  string instructions              cas 10nov05
 1                                                                 
 2 | : Shifts:  ( code -- )   Create c,  [ Forth ]                 
 3   Does> c@ >r C* case? >r 1address                              
 4         r> direction !  $D0 dw, r> or r/m, wexit ;              
 5                                                                 
 6   $00 Shifts: rol     $08 Shifts: ror                           
 7   $10 Shifts: rcl     $18 Shifts: rcr                           
 8   $20 Shifts: shl     $28 Shifts: shr                           
 9   $38 Shifts: sar     ' shl Alias sal                           
10                                                                 
11 | : Str:  ( code -- )   Create c,                               
12   Does> c@ setsize w, wexit ;                                   
13                                                                 
14   $A6 Str: cmps      $AC Str: lods     $A4 Str: movs            
15   $AE Str: scas      $AA Str: stos                              
Screen 17 not modified     
 0 \ implied 8086 instructions                          cas 10nov05
 1                                                                 
 2   : Byte:  ( code -- )  Create c,  Does> c@ >c, ;               
 3   : Word:  ( code -- )  Create ,   Does> @ >, ;                 
 4                                                                 
 5  $37 Byte: aaa    $AD5 Word: aad    $AD4 Word: aam              
 6  $3F Byte: aas     $98 Byte: cbw     $F8 Byte: clc              
 7  $FC Byte: cld     $FA Byte: cli     $F5 Byte: cmc              
 8  $99 Byte: cwd     $27 Byte: daa     $2F Byte: das              
 9  $F4 Byte: hlt     $CE Byte: into    $CF Byte: iret             
10  $9F Byte: lahf    $F0 Byte: lock    $90 Byte: nop              
11  $9D Byte: popf    $9C Byte: pushf   $9E Byte: sahf             
12  $F9 Byte: stc     $FD Byte: std     $FB Byte: sti              
13  $9B Byte: wait    $D7 Byte: xlat                               
14  $C3 Byte: ret     $CB Byte: lret                               
15  $F2 Byte: rep     $F2 Byte: 0<>rep  $F3 Byte: 0=rep            
Screen 18 not modified     
 0 \ 8086  jmp call  conditions                         cas 10nov05
 1 | : jmp/call    >r setsize # case?  [ Forth ]                   
 2      IF  far? IF  r> IF $EA ELSE $9A THEN  >c, swap >, >, wexit 
 3               THEN  >here 2+ - r>                               
 4          IF  dup long? 0= IF  $EB >c, >c, wexit  THEN  $E9      
 5          ELSE  $E8  THEN  >c, 1- >, wexit                       
 6      THEN  1address $FF >c, $10 or r> +                         
 7      far? IF  8 or  THEN  r/m, wexit ;                          
 8   : call    0 jmp/call ;         : jmp   $10 jmp/call ;         
 9                                                                 
10   $71 Constant OS    $73 Constant CS                            
11   $75 Constant 0=    $77 Constant >=                            
12   $79 Constant 0<    $7B Constant PE                            
13   $7D Constant <     $7F Constant <=                            
14   $E2 Constant C0=   $E0 Constant ?C0=                          
15   : not  1 [ Forth ] xor ;                                      
Screen 19 not modified     
 0 \ 8086 conditional branching                         cas 10nov05
 1                                                                 
 2   : +ret   $C2 >c, >, ;                                         
 3   : +lret  $CA >c, >, ;                                         
 4                                                                 
 5 | : ?range    dup long? abort" out of range" ;                  
 6                                                                 
 7   : ?[     >, >here 1- ;                                        
 8   : ]?     >here over 1+ - ?range swap >c! ;                    
 9   : ][     $EB ?[ swap ]? ;                                     
10   : ?[[    ?[ swap ;                                            
11   : [[     >here ;                                              
12   : ?]     >c, >here 1+ - ?range >c, ;                          
13   : ]]     $EB ?] ;                                             
14   : ]]?    ]] ]? ;                                              
15                                                                 
Screen 20 not modified     
 0 \ Next  user'  end-code  ;c:                         cas 10nov05
 1                                                                 
 2   : Next  lods  A W xchg  W ) jmp                               
 3      >here   next-link @ >,   next-link ! ;                     
 4                                                                 
 5   : u'   ' >body c@ ;                                           
 6                                                                 
 7   Forth definitions                                             
 8                                                                 
 9 \needs end-code    : end-code   toss also ;                     
10                                                                 
11   Assembler definitions                                         
12                                                                 
13   : ;c:   recover # call last off  end-code  0 ] ;              
14                                                                 
15                                                                 
Screen 21 not modified     
 0 \ 8086 Assembler, Forth words                        cas 10nov05
 1   Onlyforth                                                     
 2                                                                 
 3   : Assembler     Assembler [ Assembler ] wexit ;               
 4                                                                 
 5   : ;code   0 ?pairs compile (;code                             
 6      reveal  [compile] [  Assembler ; immediate                 
 7                                                                 
 8   : Code    Create [ Assembler ] >here dup 2- >!  Assembler ;   
 9                                                                 
10   : >label   ( addr -- )                                        
11      here  | Create immediate swap ,  4 hallot                  
12      here 4 - heap 4 cmove   heap  last @ (name> !   dp !       
13   Does>  ( -- addr )  @  state @ 0=exit  [compile] Literal ;    
14                                                                 
15   : Label   [ Assembler ] >here >label  Assembler ;             
Screen 22 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
