Changeset 3346


Ignore:
Timestamp:
Oct 2, 2012, 2:59:50 AM (19 months ago)
Author:
wmb
Message:

Debugger - the "up" keystroke ('U') was not working when debugging inside a do .. loop due to misinterpreting a pointer to the loop end address as a return address.

Location:
forth/lib
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • forth/lib/debug.fth

    r3341 r3346  
    8888\ Go up the return stack until we find an interesting caller 
    8989: up1  ( rp -- ) 
    90    begin  na1+  dup rp0 @ <>  while          ( rs-adr ) 
    91       dup @                                  ( rs-adr ip ) 
    92       dup in-dictionary?  if                 ( rs-adr ip ) 
    93          find-cfa  dup indirect-call?  if    ( rs-adr xt ) 
    94             drop                             ( rs-adr ) 
    95          else                                ( rs-adr xt ) 
    96             nip                              ( rs-adr ) 
    97             scrolling-debug?  if             ( xt ) 
    98                cr ." [ Up to " dup .name ." ]" cr 
    99             then                             ( xt ) 
    100             (debug                           ( ) 
    101             exit                             ( -- ) 
    102          then                                ( rs-adr ) 
    103       else                                   ( rs-adr ip ) 
    104          drop                                ( rs-adr ) 
    105       then                                   ( rs-adr ) 
    106    repeat                                    ( rs-adr ) 
    107    drop                                      ( ) 
     90   begin  na1+  dup rp0 @ <>  while             ( rs-adr ) 
     91      dup @                                     ( rs-adr ip ) 
     92      dup in-dictionary?  if                    ( rs-adr ip ) 
     93         dup loop-end?  if                      ( rs-adr ip ) 
     94            drop                                ( rs-adr ) 
     95         else                                   ( rs-adr ip ) 
     96            find-cfa  dup indirect-call?  if    ( rs-adr xt ) 
     97               drop                             ( rs-adr ) 
     98            else                                ( rs-adr xt ) 
     99               nip                              ( rs-adr ) 
     100               scrolling-debug?  if             ( xt ) 
     101                  cr ." [ Up to " dup .name ." ]" cr 
     102               then                             ( xt ) 
     103               (debug                           ( ) 
     104               exit                             ( -- ) 
     105            then                                ( rs-adr ) 
     106         then                                   ( rs-adr ) 
     107      else                                      ( rs-adr ) 
     108         drop                                   ( rs-adr ) 
     109      then                                      ( rs-adr ) 
     110   repeat                                       ( rs-adr ) 
     111   drop                                         ( ) 
    108112; 
    109113 
  • forth/lib/rstrace.fth

    r2913 r3346  
    2323; 
    24241 bits/cell 1- lshift constant minus0 
     25: loop-end?  ( adr -- flag ) 
     26   dup reasonable-ip?  0=  if    ( adr ) 
     27      drop false exit            ( -- false ) 
     28   then                          ( adr ) 
     29   dup @ +                       ( adr' ) 
     30   dup reasonable-ip?  0=  if    ( adr ) 
     31      drop false exit            ( -- false ) 
     32   then                          ( adr ) 
     33   ip>token  -1 na+  token@      ( xt ) 
     34   dup ['] (loop) =  swap ['] (+loop) =  or  ( flag ) 
     35; 
     36 
    2537: .do-or-n  ( rs-adr n -- rs-adr' ) 
    2638   over @ reasonable-ip?  0=  if              ( rs-adr n ) 
    2739      \ The second number is not an IP so it could be a do loop frame 
    28       over na1+ @  reasonable-ip?  if         ( rs-adr n ) 
    29          \ The third entry is a reasonable IP so it could be a do loop frame 
    30          \ Make sure it points just past a loop end 
    31          over na1+ @  dup @ +                 ( rs-adr n n2 ) 
    32          dup reasonable-ip?  if               ( rs-adr n adr ) 
    33             ip>token  -1 na+  token@          ( rs-adr n xt ) 
    34             dup ['] (loop) =  swap ['] (+loop) =  or  if  ( rs-adr n ) 
    35                \ The two numbers span the +- boundary, so probably a do loop 
    36                ."    Do loop frame inside " 
    37                over na1+ @ ip>token .current-word ( rs-adr n ) 
    38                over @                             ( rs-adr n n1 ) 
    39                ."   i: "  tuck + .                ( rs-adr n1 ) 
    40                ."   limit: "  minus0  + .         ( rs-adr ) 
    41                2 na+ exit 
    42             then                               ( rs-adr n ) 
    43          else                                  ( rs-adr n n2 ) 
    44             drop                               ( rs-adr n ) 
    45          then                                  ( rs-adr n ) 
    46       then                                     ( rs-adr n ) 
    47    then                                        ( rs-adr n ) 
     40      over na1+ @                             ( rs-adr n n2 ) 
     41      dup loop-end?  if                       ( rs-adr n n2 ) 
     42         ."    Do loop frame inside " 
     43         ip>token .current-word               ( rs-adr n ) 
     44         over @                               ( rs-adr n n1 ) 
     45         ."   i: "  tuck + .                  ( rs-adr n1 ) 
     46         ."   limit: "  minus0  + .           ( rs-adr ) 
     47         2 na+ exit                           ( -- rs-adr' ) 
     48      then                                    ( rs-adr n n2 ) 
     49      drop                                    ( rs-adr n ) 
     50   then                                       ( rs-adr n ) 
    4851   9 u.r 
    4952; 
Note: See TracChangeset for help on using the changeset viewer.