Screen 0 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 1 not modified     
 0 \ 68000 Disassembler loadscreen                        05dec86we
 1                                                                 
 2 Onlyforth                                                       
 3                                                                 
 4 \needs >absaddr    : >absaddr     0 forthstart d+ ;             
 5 \needs Code        .( Load assemble.scr first) abort            
 6                                                                 
 7 1 ?head !       \ alle Disassembler-Worte headerless            
 8 1 $12 +thru                                                     
 9                                                                 
10 0 ?head !                                                       
11 $13 +load       \ Benutzer-Worte mit Header                     
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 2 not modified     
 0 \ long words and presigns                              14oct86we
 1                                                                 
 2 : l+    ( n -- )    extend d+  ;                                
 3 : l-    ( n -- )    extend d-  ;                                
 4 : l+!   ( n addr -- )   >absaddr  ln+! ;                        
 5                                                                 
 6 : .#    Ascii # emit ;                                          
 7 : .$    Ascii $ emit ;                                          
 8 : .,    Ascii , emit ;                                          
 9 : .-    Ascii - emit ;                                          
10 : ..    Ascii . emit ;                                          
11                                                                 
12 : .0r   ( n width --)   over abs swap                           
13   <# 0 DO # LOOP swap sign #>  type space ;                     
14                                                                 
15                                                                 
Screen 3 not modified     
 0 \ signed / unsigned byte, word and long output         28jan86ma
 1                                                                 
 2 : .lformat   ( laddr --)  <# #s #> dup 8 swap - spaces type ;   
 3                                                                 
 4 : .lu   ( d -- )       <# #s #> type   ;                        
 5 : .$lu  ( d -- )       .$ .lu ;                                 
 6                                                                 
 7 : .wo   ( n -- )       0  <# # # # # #>  type ;                 
 8 : .$wu  ( n -- )       .$ .wo ;                                 
 9 : .$ws  ( n -- )       dup $7FFF u>                             
10                          IF .- 1.0000 rot d- THEN  .$ .wo  ;    
11 : .by   ( 8b -- )      0   <#  # #  #>   type ;                 
12 : .$bu  ( 8b -- )      .$ .by ;                                 
13 : .$bs  ( 8b -- )      $FF and dup $7F >                        
14                          IF .- 100 swap - THEN .$ .by  ;        
15 : .lb  ( hi lo len -- )   bounds ?DO  I over lc@ .by  LOOP  ;   
Screen 4 not modified     
 0 \ Variables and tabs                                   18jan86ma
 1                                                                 
 2 2Variable addr    2Variable dispaddr    2Variable saveaddr      
 3 Variable  opcode  Variable  mne         Variable  mode          
 4 Variable  reg     Variable  length      Variable  sr            
 5 Variable  predec                                                
 6                                                                 
 7   &10 constant  bytfld       : tab     row  swap   at ;         
 8   &32 constant  mnefld                                          
 9   &40 constant  adrfld       : tab1    row  adrfld at ;         
10                                                                 
11 : getword                                                       
12    addr 2@  2 l+  2dup  addr 2!  l@ ;                           
13 : getlong                                                       
14    addr 2@  4 l+  2dup  addr 2!  2dup  2 l-  l@ >r  l@ r>   ;   
15                                                                 
Screen 5 not modified     
 0 \ print registernumber, dump                           18jan86ma
 1                                                                 
 2 : .reg      ( n -- )   7 and  Ascii 0 +  emit ;                 
 3 : .(areg)   ( n -- )   Ascii A emit .reg ;                      
 4 : .(dreg)   ( n -- )   Ascii D emit .reg ;                      
 5                                                                 
 6 : .areg                reg @ .(areg) ;                          
 7 : .dreg                reg @ .(dreg) ;                          
 8                                                                 
 9 : .aind                Ascii ( emit .areg Ascii ) emit ;        
10 : .apost               .aind Ascii + emit ;                     
11 : .apre                .- .aind ;                               
12                                                                 
13 : dumpws               getword .$ws ;                           
14 : dumpw                getword .$wu ;                           
15 : dumpl                getlong .$lu ;                           
Screen 6 not modified     
 0 \ print length , bitmasking                            04mar86we
 1                                                                 
 2 : len.    length @                                              
 3       0   case? IF  ." .b"  tab1 exit  THEN                     
 4       1   case? IF  ." .w"  tab1 exit  THEN                     
 5       2   case? IF  ." .l"  tab1 exit  THEN                     
 6           tab1  drop ;                                          
 7                                                                 
 8 Code shift   ( n -- )   SP )+ D0 move  SP ) D1 move             
 9                         D0 D1 lsr  D1 SP ) move   Next end-code 
10 : 4shft   4 shift ;             : 8shft   8 shift  ;            
11 : cshft   $0C shift ;                                           
12 : bitce   $0C shift 7 and ;     : bit5     5 shift  1 and ;     
13 : bit6    6 shift   1 and ;     : bit7     7 shift  1 and ;     
14 : bit10   $0A shift 1 and ;     : bit11  $0B shift  1 and ;     
15 : bit8b   8 shift $0F and ;                                     
Screen 7 not modified     
 0 \ bitmasking 2                                         28jan86ma
 1                                                                 
 2 : bit02   7 and ;                : bit8    8 shift  1 and ;     
 3 : bit35   3 shift  7 and ;       : bit3    3 shift  1 and ;     
 4 : bit68   6 shift  7 and ;       : bit9b   9 shift  7 and ;     
 5 : bit67   6 shift  3 and ;       : bit37   3 shift  $1F and ;   
 6                                                                 
 7 : len!.      length ! len. ;                                    
 8 : length6    opcode @ bit6 1+ len!. ;                           
 9 : length67   opcode @ bit67   len!. ;                           
10                                                                 
11 : reg02!     opcode @ bit02   reg ! ;                           
12 : reg9b!     opcode @ bit9b   reg ! ;                           
13                                                                 
14 : bit9b.    .# opcode @ bit9b dup 0=                            
15                IF drop 8 THEN  .$bu ;                           
Screen 8 not modified     
 0 \ list register                                        26jan86ma
 1                                                                 
 2 : reglist                                                       
 3   getword 10 0 DO                                               
 4      dup 2/ swap 1 and                                          
 5        IF I predec @                                            
 6           IF $0F swap -  THEN  dup 7 >                          
 7              IF .(areg)  ELSE  .(dreg) THEN  dup                
 8                IF  ." /"  THEN                                  
 9        THEN   LOOP drop ;                                       
10                                                                 
11 : mnext length6 reg02! .dreg ;                                  
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 9 not modified     
 0 \ print adressing mode                                bp 28Aug86
 1                                                                 
 2 : .a/pcreg     mode @ 7 =                                       
 3                IF  ." PC" ELSE .areg THEN ;                     
 4 : l?    ( ext.word -- )  $800 and IF ." .L" exit THEN ." .W" ;  
 5 : i8bit                                                         
 6      getword dup .$bs                                           
 7      Ascii ( emit .a/pcreg ., dup $7FFF >                       
 8        IF  Ascii A emit ELSE Ascii D emit THEN                  
 9      dup  bitce .reg l? Ascii ) emit ;                          
10                                                                 
11 : imm                                                           
12   .# length @                                                   
13      0  case? IF  getword .$bu exit  THEN                       
14      1  case? IF  dumpw        exit  THEN                       
15      2  case? IF  dumpl        exit  THEN   drop  ;             
Screen 10 not modified     
 0 \  print adressing mode                                28jan86ma
 1                                                                 
 2 : mode7      reg @                                              
 3      0  case? IF  dumpws                           exit THEN    
 4      1  case? IF  dumpl                            exit THEN    
 5      2  case? IF  dumpws ." (PC)"                  exit THEN    
 6      3  case? IF  i8bit                            exit THEN    
 7      4  case? IF  sr @ IF ." SR"  ELSE  imm  THEN  exit THEN    
 8         drop  ." ???"  ;                                        
 9                                                                 
10 : effadr     mode @                                             
11  0  case? IF .dreg exit THEN   1 case? IF .areg  exit THEN      
12  2  case? IF .aind exit THEN   3 case? IF .apost exit THEN      
13  4  case? IF .apre exit THEN   5 case? IF dumpws .aind exit THEN
14  6  case? IF i8bit exit THEN   7 case? IF mode7 exit  THEN      
15  drop    ;                                                      
Screen 11 not modified     
 0 \ find register and mode                               28jan86ma
 1 : .ea       opcode @  dup bit02 reg !  bit35 mode !  effadr ;   
 2 : .eadest   opcode @  dup bit68 mode !  bit9b reg !  effadr ;   
 3 : mnabcd                                                        
 4   tab1 opcode @ bit3                                            
 5   IF     reg02!  .apre  .,  reg9b!  .apre                       
 6   ELSE   reg02!  .dreg  .,  reg9b!  .dreg THEN ;                
 7 : mnaddx      length67  mnabcd ;                                
 8 : mncmpm      length67  reg02!  .apost  .,  reg9b!  .apost ;    
 9 : mnexg                                                         
10   tab1  reg9b!  opcode @  bit37                                 
11   dup  9 = IF  .areg  ELSE  .dreg  THEN  .,  reg02!             
12        8 = IF  .dreg  ELSE  .areg  THEN ;                       
13 : mnadd     length67  opcode @                                  
14  bit8 IF    reg9b!  .dreg  .,  .ea                              
15       ELSE  .ea  .,  reg9b!  .dreg  THEN ;                      
Screen 12 not modified     
 0 \  find register and mode                              26jan86ma
 1 : mnadda   opcode @  bit8 1+ len!.  .ea  .,  reg9b!  .areg ;    
 2 : mnaddi   length67  imm  .,  1 sr !  .ea ;                     
 3 : mnaddq   length67  bit9b.  .,  .ea ;                          
 4 : mnmoveq  tab1  .#  opcode @ .$bs  .,  reg9b!  .dreg ;         
 5 : mnswap   tab1  reg02!  .dreg ;                                
 6 : mnunlk   tab1  reg02!  .areg ;                                
 7 : mnclr    length67  .ea ;                                      
 8 : mnjmp    tab1  .ea ;                                          
 9 : mnchk    mnjmp  .,  reg9b!  .dreg ;                           
10 : mnlea    tab1  .ea  .,  reg9b!  .areg ;                       
11 : mnbchg   tab1  opcode @  bit8                                 
12     IF  reg9b!  .dreg  ELSE  .# dumpw  THEN  .,  .ea ;          
13 : mnbchg2  tab1  reg9b!  .dreg  .,  .ea ;                       
14 : .dir     opcode @  bit8                                       
15     IF Ascii l emit  ELSE Ascii r emit  THEN ;                  
Screen 13 not modified     
 0 \  find register and mode                              23sep86we
 1                                                                 
 2 : mnshft                                                        
 3   .dir  length67  opcode @  bit5                                
 4     IF  reg9b!  .dreg  ELSE  bit9b. THEN  .,  reg02!  .dreg ;   
 5 : mnshft2  .dir mnjmp ;                                         
 6 : reladr2                                                       
 7   getword dup  $7FFF >                                          
 8    IF 1.0000 rot d-  THEN  2+ dispaddr 2@  rot l+ .$lu ;        
 9 : reladr                                                        
10   opcode  @ $FF and ?dup                                        
11     IF  dup $7F > IF 100 - THEN 2+ dispaddr 2@ rot l+ .$lu      
12     ELSE  reladr2 THEN ;                                        
13 : quote  Create $22 word drop $22 allot  Does> 1+ ;             
14    quote  ctbl0 t f hilscccsneeqvcvsplmigeltgtle"               
15    quote  ctbl1 rasrhilscccsneeqvcvsplmigeltgtle"               
Screen 14 not modified     
 0 \  find register and mode                              18jan86ma
 1                                                                 
 2 : .cond ( ctblflag --> )                                        
 3     IF ctbl1 ELSE ctbl0 THEN                                    
 4    opcode  @ bit8b 2* + 2 type tab1 ;                           
 5 : mnscc  0 .cond  .ea ;                                         
 6 : mnbcc  1 .cond  reladr ;                                      
 7 : mndbcc 0 .cond  reg02!  .dreg  .,  reladr2 ;                  
 8 : mnlink tab1  reg02!  .areg  .,  .#  dumpws ;                  
 9 : mnmove                                                        
10   4 opcode @  bitce - dup 3 =  IF drop 0 THEN                   
11   len!.  .ea  .,  .eadest ;                                     
12 : mnmoveccr  mnjmp  ." ,ccr" ;                                  
13 : mnmovesr   mnjmp  ." ,sr" ;                                   
14 : mnmovefsr  tab1  ." sr,"  .ea ;                               
15                                                                 
Screen 15 not modified     
 0 \  find register and mode                              26jan86ma
 1                                                                 
 2 : mnmoveusp  tab1  reg02!  opcode @  bit3                       
 3     IF ." usp," .areg  ELSE  .areg  ." ,usp"  THEN ;            
 4 : mnmovem                                                       
 5   length6 opcode  @ dup bit35 4 = predec ! bit10                
 6     IF .ea ., reglist  ELSE  reglist ., .ea  THEN ;             
 7 : mnmovep                                                       
 8   length6 opcode  @ bit7                                        
 9      IF reg9b! .dreg ., dumpws reg02! .aind                     
10      ELSE  dumpws  reg02! .aind ., reg9b! .dreg  THEN ;         
11 : mnstop tab1 .# dumpw ;                                        
12 : mntrap tab1 .# opcode  @ $0F and .$bu  ;                      
13 : mnimp ;                                                       
14                                                                 
15 : t,    swap  ,  ,  [compile] ' ,   bl word drop   8 allot ;    
Screen 16 not modified     
 0 \ mask- and opcode-table                               18jan86ma
 1                                                                 
 2 Create mntbl       base @ hex                                   
 3 ff00 0600 t, mnaddi     addi    ff00 0200 t, mnaddi     andi    
 4 ff00 0c00 t, mnaddi     cmpi    ff00 0a00 t, mnaddi     eori    
 5 ff00 0000 t, mnaddi     ori     ff00 0400 t, mnaddi     subi    
 6 ffc0 0840 t, mnbchg     bchg    ffc0 0880 t, mnbchg     bclr    
 7 ffc0 08c0 t, mnbchg     bset    ffc0 0800 t, mnbchg     btst    
 8 e1c0 2040 t, mnmove     movea   c000 0000 t, mnmove     move    
 9 ffff 4afc t, mnimp      illegal ffff 4e71 t, mnimp      nop     
10 ffff 4e70 t, mnimp      reset   ffff 4e73 t, mnimp      rte     
11 ffff 4e77 t, mnimp      rtr     ffff 4e75 t, mnimp      rts     
12 ffff 4e76 t, mnimp      trapv   ffff 4e72 t, mnstop     stop    
13 fff0 4e40 t, mntrap     trap    fff8 4840 t, mnswap     swap    
14 fff8 4e58 t, mnunlk     unlk    fff8 4e50 t, mnlink     link    
15 ffb8 4880 t, mnext      ext     ffc0 44c0 t, mnmoveccr  move    
Screen 17 not modified     
 0 \  mask- and opcode-table                              18jan86ma
 1                                                                 
 2 ffc0 46c0 t, mnmovesr   move    ffc0 40c0 t, mnmovefsr  move    
 3 fff0 4e60 t, mnmoveusp  move    ffc0 4ac0 t, mnjmp      tas     
 4 ff00 4200 t, mnclr      clr     ff00 4400 t, mnclr      neg     
 5 ff00 4000 t, mnclr      negx    ff00 4600 t, mnclr      not     
 6 ff00 4a00 t, mnclr      tst     ffc0 4ec0 t, mnjmp      jmp     
 7 ffc0 4e80 t, mnjmp      jsr     ffc0 4800 t, mnjmp      nbcd    
 8 ffc0 4840 t, mnjmp      pea     f1c0 41c0 t, mnlea      lea     
 9 f1c0 4180 t, mnchk      chk     fb80 4880 t, mnmovem    movem   
10 f0f8 50c8 t, mndbcc     db      f0c0 50c0 t, mnscc      s       
11 f100 5000 t, mnaddq     addq    f100 5100 t, mnaddq     subq    
12 f000 6000 t, mnbcc      b       f100 7000 t, mnmoveq    moveq   
13 f1f0 8100 t, mnabcd     sbcd    f1c0 81c0 t, mnchk      divs    
14 f1c0 80c0 t, mnchk      divu    f000 8000 t, mnadd      or      
15                                                                 
Screen 18 not modified     
 0 \  mask- and opcode-table                              18jan86ma
 1                                                                 
 2 f0c0 90c0 t, mnadda     suba    f130 9100 t, mnaddx     subx    
 3 f000 9000 t, mnadd      sub     f000 a000 t, mnimp      ?ext0a  
 4 f0c0 b0c0 t, mnadda     cmpa    f138 b108 t, mncmpm     cmpm    
 5 f100 b100 t, mnadd      eor     f100 b000 t, mnadd      cmp     
 6 f1f0 c100 t, mnabcd     abcd    f1c0 c1c0 t, mnchk      muls    
 7 f1c0 c0c0 t, mnchk      mulu    f130 c100 t, mnexg      exg     
 8 f000 c000 t, mnadd      and     f0c0 d0c0 t, mnadda     adda    
 9 f130 d100 t, mnaddx     addx    f000 d000 t, mnadd      add     
10 fec0 e0c0 t, mnshft2    as      fec0 e2c0 t, mnshft2    ls      
11 fec0 e4c0 t, mnshft2    rox     fec0 e6c0 t, mnshft2    ro      
12 f018 e000 t, mnshft     as      f018 e008 t, mnshft     ls      
13 f018 e010 t, mnshft     rox     f018 e018 t, mnshft     ro      
14 f000 f000 t, mnimp      ?ext0f  0000 0000 t, mnimp      ???     
15 base !                                                          
Screen 19 not modified     
 0 \ search mne and dis a line                            05dec86we
 1                                                                 
 2 : searchmne     ( -- )                                          
 3   mntbl  0 sr !  0 predec !                                     
 4      BEGIN  dup @  opcode @ and  over 2+ @ =                    
 5        IF  dup 6 +  count type  4+ @ execute  exit  THEN        
 6      $0E + REPEAT  ;                                            
 7                                                                 
 8 : disline       ( -- )          base push  hex                  
 9     cr    dispaddr 2@ .lformat   mnefld tab                     
10     addr 2@  2dup  saveaddr 2!  l@ opcode !                     
11     searchmne   2 addr l+!   bytfld  tab                        
12     addr 2@  saveaddr 2@  d- drop  dup >r  dispaddr l+!         
13     saveaddr 2@ swap r>  .lb  drop   ;                          
14                                                                 
15                                                                 
Screen 20 not modified     
 0 \ addr! dis ldis disw                                  14oct86we
 1                                                                 
 2 : addr!   2dup addr 2! dispaddr 2! ;                            
 3                                                                 
 4 : disassline  addr! disline ;                                   
 5                                                                 
 6 : ldis    addr! BEGIN disline stop? UNTIL cr  ;                 
 7                                                                 
 8 : dis     >absaddr  ldis ;                                      
 9                                                                 
10 : disw    ' 2+ dup ."  Adresse : " u.  cr  >absaddr  addr!      
11           BEGIN                                                 
12             BEGIN  disline  opcode @ $4EF3 = stop? or UNTIL     
13           key   $FF and  #esc = UNTIL                           
14           cr ;                                                  
15                                                                 
