VolksForth/8080/CPM/tools.fb

\\ Tools                                                 11Nov86Dieses File enthaelt die wichtigsten Werkzeuge zur Programm-    entwicklung:    - den einfachen Decompiler                                      - der DUMP-Befehl                                               - den Tracer                                                                                                    Der einfache Decompiler wird benutzt, um neue Defining-Words    zu ueberpruefen. Der automatische Decompiler kann ja dafuer     nicht benutzt werden, da ihm diese Strukturen unbekannt sind.   (Benutzung: addr und dann, je nach Art: S N D L C oder B)                                                                       DUMP wird zum Ausgeben von Hexdumps benutzt. (from count DUMP)                                                                  Der Tracer erlaubt Einzelschrittausfuehrung von Worten.         Er ist unentbehrliches Hilfsmittel bei der Fehlersuche.         (Benutzung:  DEBUG <name>  und  END-TRACE)                      \  Programming-Tools word set / tracer            cas 19july2020                                                                Onlyforth    Vocabulary Tools  Tools also definitions                                                                           01 05 +thru   &15 &16 +thru                                        06 +load     \ Tracer                                                                                                        Onlyforth                                                                                                                       : internal \ start headerless definitions                          1 ?head ! ;                                                                                                                  : external \ end headerless definitions                            ?head off ;                                                                                                                                                                                  \ Tools for decompiling                                  22feb86                                                                | : ?:     dup 4 u.r ." :" ;                                    | : @?     dup @ 6 u.r ;                                        | : c?     dup c@ 3 .r ;                                                                                                        : s   ( adr - adr+ )                                             ?: space  c? 3 spaces  dup 1+ over c@ type  dup c@ + 1+ even ;                                                                 : n   ( adr - adr+2 )  ?: @? 2 spaces  dup @ >name .name 2+ ;   : d   ( adr n - adr+n)                                           2dup swap ?:  swap  0 DO c? 1+ LOOP  2 spaces  -rot type ;                                                                                                                                                                                                                                                                     \ Tools for decompiling                                  22feb86                                                                : l   ( adr - adr+2 )    ?: 5 spaces @? 2+ ;                    : c   ( adr - adr+1)     1 d ;                                  : b   ( adr - adr+1)     ?: @? dup @ over + 5 u.r 2+ ;                                                                                                                                                                                                          \\                                                              : dump ( adr n -) bounds ?DO cr I 10 d drop stop? IF LEAVE      THEN 10 +LOOP ;                                                                                                                                                                                                                                                                                                                                                                                 \ General Dump Utility - Output                       UH 07Jun86                                                                | : .2   ( n -- )   0  <#   # #   #>   type  space ;            | : .6   ( d -- )   <#  # # # # # #  #>  type ;                 | : d.2   ( addr len -- )   bounds ?DO  I C@  .2  LOOP ;        | : emit.   ( char -- )                                            $7F and  dup bl $7E uwithin not IF drop Ascii . THEN  emit ; | : dln   ( addr --- )                                             cr  dup 6 u.r  2 spaces  8 2dup d.2  space                      over + 8 d.2  space   $10 bounds ?DO  I C@ EMIT.  LOOP  ;    | : ?.n    ( n1 n2 -- n1 )                                         2dup = IF  ." \/"  drop  ELSE  2 .r  THEN   space ;          | : ?.a    ( n1 n2 -- n1 )                                         2dup = IF  ." V"  drop   ELSE  1 .r  THEN ;                                                                                                                                                  \ .head                                               UH 03Jun86                                                                                                                                | : .head   ( addr len -- addr' len' )                             swap  dup -$10 and  swap  $0F and  cr 8 spaces                  8 0 DO  I ?.n  LOOP  space  $10 8 DO  I ?.n  LOOP               space  $10 0 DO  I ?.a  LOOP  rot + ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        \ Dump and Fill Memory Utility                        UH 25Aug86                                                                Forth definitions                                                                                                               : dump   ( addr len -- )                                         base push  hex    .head                                         bounds ?DO  I dln  stop? IF  LEAVE  THEN  $10 +LOOP ;                                                                          Tools definitions                                                                                                               : du   ( addr -- addr+$40 )     dup $40 dump  $40 + ;                                                                           : dl   ( line# -- )             c/l * scr @ block + c/l  dump ;                                                                 Forth definitions                                                                                                               \ Trace Loadscreen                                       29Jun86                                                                Onlyforth       \needs Tools    Vocabulary Tools                Tools also definitions                                                                                                          1 8 +thru                                                                                                                       Onlyforth                                                                                                                       \ clear                                                                                                                         \  don't forget END-TRACE after using DEBUG                                                                                                                                                                                                                                                                                     \ Variables do-trace                                  UH 04Nov86                                                                | Variable Wsave        \ Variable for saving W                 | Variable <ip          \ start of trace trap range             | Variable ip>          \ end of trace trap range               | Variable 'ip          \ holds IP  (preincrement!)             | Variable nest?        \ True if NEST shall be performed       | Variable newnext      \ Address of new Next for tracing       | Variable #spaces      \ for indenting nested trace            | Variable tracing      \ true if trace mode active                                                                                                                                                                                                                                                                                                                                                                                                             \ install Tracer                                      UH 18Nov87                                                                Tools definitions                                                                                                               | Code do-trace   \ patch Next to new definition                   $C3 A mvi ( jmp )  >next sta                                    newnext lhld       >next 1+ shld  Next                       end-code                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        \ throw status on Return-Stack                           29Jun86                                                                | Create: npull                                                    rp@ count  2dup + even rp!  r> swap cmove ;                                                                                  : npush  ( addr len --)   r> -rot  over >r                         rp@ over 1+ -  even dup rp!  place  npull >r  >r ;                                                                           | : oneline   .status space query interpret  -&82 allot                       rdrop ( delete quit from tracenext ) ;                                                                                                                                                                                                                                                                                                                                                                                                            \ reenter tracer                                         04Nov86                                                                | Code (step                                                       true H lxi   tracing shld   IP rpop   Wsave lhld   H W mvx   Label fnext                                                        xchg                                                            M E mov   H inx   M D mov   xchg   pchl                      end-code                                                                                                                        | Create: nextstep   (step ;                                                                                                    | : (debug  ( addr --)   \ start tracing at addr                      dup  <ip !                                                      BEGIN  1+ dup @   ['] unnest =  UNTIL  2+ ip> ! ;                                                                                                                                         \ check trace conditions                                 04Nov86                                                                Label tracenext   tracenext newnext !                              IP ldax  IP inx   A L mov   IP ldax   IP inx   A H mov          xchg   tracing lhld   H A mov   L ora   fnext jz                nest? 1+ lda   A ana                                            0= ?[                                                                 <IP lhld  H inx                                                 IP A mov  H cmp   fnext jc                                        0= ?[ IP' A mov  L cmp   fnext jc ]?                          IP> lhld                                                        H A mov   IP cmp   fnext jc                                       0= ?[ L A mov   IP' cmp   fnext jc ]?                      ][ A xra nest? 1+ sta  ]? \ low byte still set                                        \ one trace condition satisfied        W H mvx   Wsave shld   false H lxi   tracing shld            \ tracer display                                      UH 25Jan88                                                                ;c: nest? @                                                         IF  nest? off  r>  ip> push  <ip push  dup 2- (debug                 #spaces push  1 #spaces +!  >r   THEN                      r@ nextstep >r  input push  output push  standardi/o            cr #spaces @ spaces                                             dup 'ip !  2-  dup 5 u.r  @ dup 6 u.r  2 spaces                 >name .name  $1C col -  0 max spaces  .s                        state push  blk push  >in push  ['] 'quit >body push            [ ' parser >body ] Literal push                                 span push  #tib push  tib #tib @ npush  r0 push                 rp@ r0 !  &82 allot  ['] oneline Is 'quit  quit ;                                                                                                                                                                                                           \ DEBUG with errorchecking                               28Nov86                                                                | : traceable  ( cfa -- cfa' )                                   recursive  dup @                                                ['] : @    case? ?exit                                          ['] key @  case? IF  >body c@ Input @ +  @  traceable exit THEN ['] type @ case? IF  >body c@ Output @ + @  traceable exit THEN ['] r/w  @ case? IF  >body                  traceable exit THEN dup 1+ @ [ ' Forth @ 1+ @ ] Literal =      IF nip 1+  exit THEN drop >name .name ." can't be DEBUGged" quit ;                                                                                  also Forth definitions                                                                                                          : debug  ( -- )   \ reads a word                                   '  traceable  (debug   Tools                                    nest? off  #spaces off  tracing on  do-trace ;               \ misc. words for tracing                                28Nov86Tools definitions                                                                                                               : nest                  \ trace next high-level word executed      'ip @ 2- @ traceable drop  nest? on ;                                                                                        : unnest                \ ends tracing of actual word              <ip on  ip> off ;    \ clears trap range                                                                                     : endloop               \ stop tracing loop                        'ip @ <ip ! ;        \ use when at end of loop                                                                               Forth definitions                                                                                                               : trace' ( -- )   \ reads a word                                   context push   debug   <ip perform  end-trace ;              \ N>R  NR> cr                                                                                                                   : N>R  ( i * n +n -- ) ( R: -- j * x +n )                       \ Transfer N items and count to the return stack.                 DUP BEGIN DUP WHILE                                               ROT R> SWAP >R >R                                               1-                                                            REPEAT DROP  R> SWAP >R >R  ;                                                                                                 : NR>  ( -- i * x +n ) ( R: j * x +n -- )                       \ Pull N items and count off the return stack.                    R> R> SWAP >R DUP                                               BEGIN  DUP  WHILE                                                  R> R> SWAP >R -ROT                                              1-                                                          REPEAT  DROP  ;                                                \  ?                                                                                                                            : ?  ( a-addr -- )                                              \ Display the value stored at a-addr.                             @ . ;