From b6786a8df07d82cb3f9ddc6bcef2800b7e8fa7a2 Mon Sep 17 00:00:00 2001 From: Carsten Strotmann Date: Sun, 19 Jul 2020 08:41:36 +0200 Subject: [PATCH] Target MSDOS: implemented NR> N>R ? in Programming-Tools word set --- msdos/tools.fb | 2 +- sources/msdos/tools.fb.src | 27 ++++++++++++++++++++++----- 2 files changed, 23 insertions(+), 6 deletions(-) diff --git a/msdos/tools.fb b/msdos/tools.fb index 629ed0f..c46f7cf 100644 --- a/msdos/tools.fb +++ b/msdos/tools.fb @@ -1 +1 @@ -\ ks 22 dez 87 Some simple tools for debugging. A state-of-the-art, interactive single step tracer and a couple of tools for decompiling and dumping \ Trace Loadscreen ks cas 25sep16 Onlyforth \needs Assembler 2 loadfrom asm.fb Vocabulary Tools Tools also definitions 1 9 +thru Onlyforth .( Tools geladen) cr \ trace - next ks 11 jun 87 | Variable nest? nest? off Label tracenext 0 # nest? #) byte cmp 0= ?[ $5555 # I cmp here 2- >label (ip >= ?[ [[ swap lods A W xchg W ) jmp ]? $5555 # I cmp here 2- >label ip) CS ?] ][ 0 # nest? #) byte mov ]? $5555 # W mov here 2- >label >tracing W ) jmp end-code | (ip Constant | : (debug ( addr -- ) dup ! ; \ install Tracer ks 11 jun 87 Label (do-trace next-link # W mov D push $E9 # A- mov tracenext 1+ # C mov [[ W ) W mov W W or 0= not ?[[ A- -4 W D) mov C D mov W D sub D -3 W D) mov ]]? D pop ret end-code Code do-trace (do-trace # call Next end-code ' end-trace Alias end-trace | Code (step (do-trace # call R ) I mov R inc R inc lods A W xchg W ) jmp | Create: nextstep (step ; \ tracer display ks 20 sep 88 | Variable nest# nest# off | Variable 'ip 'ip off | Create: -nest r> ip> ! r> r0 ! r> dup #tib ! rp@ over tib swap cmove rp@ + rp! r> Is parser r> adr 'quit ! r> >in ! r> blk ! r> state ! r> output ! r> input ! ; \ tracer display ks 16 sep 88 | : tracing end-trace nest? @ IF r> r ip> @ >r -nest >r >r 1 nest# +! r@ 2- (debug nest? off THEN r@ 'ip ! nextstep >r input @ >r output @ >r state @ >r blk @ >r >in @ >r adr 'quit @ >r adr parser @ >r tib #tib @ rp@ over - under rp! cmove #tib @ >r r0 @ >r rp@ r0 ! standardi/o cr nest# @ spaces 'ip @ dup 5 u.r @ dup 5 u.r 2 spaces >name .name &30 nest# @ + tab .s $20 allot ['] oneline Is 'quit quit ; ' tracing >tracing ! \ test traceability ks 07 dez 87 | : traceable ( cfa -- cfa' ) recursive dup @ [ ' : @ ] Literal case? ?exit [ ' key @ ] Literal case? IF >body c@ Input @ + @ traceable exit THEN [ ' type @ ] Literal case? IF >body c@ Output @ + @ traceable exit THEN [ ' r/w @ ] Literal case? IF >body @ traceable exit THEN c@ $E9 = IF @ 1+ exit THEN \ Does> word >name .name ." can't be DEBUGged" quit ; \ user words for tracing ks 16 sep 88 | : do_debug ( addr -- ) traceable (debug nest? off nest# off do-trace ; : nest \ trace next high-level word executed 'ip @ @ traceable drop nest? on ; : unnest \ ends tracing of actual word off ; unnest \ clears trap range : endloop \ stop tracing loop 'ip @ r do_debug r> execute end-trace unnest ; \ tools for decompiling, interactive use ks 04 jul 87 | : ?: ( addr -- addr ) dup 5 u.r ." :" ; | : @? ( addr -- addr ) dup @ 6 u.r ; | : c? ( addr -- addr ) dup c@ 3 .r ; | : end $28 tab ; : s ( addr1 -- addr2 ) ?: 3 spaces c? 2 spaces count 2dup type + even end ; : n ( addr1 -- addr2 ) ?: @? 2 spaces dup @ >name .name 2+ end ; : d ( addr1 n -- addr2 ) 2dup swap ?: 3 spaces swap 0 DO c? 1+ LOOP 2 spaces -rot type end ; : l ( addr1 -- addr2 ) ?: 6 spaces @? 2+ end ; : c ( addr1 -- addr2 ) 1 d end ; : b ( addr1 -- addr2 ) ?: @? dup @ over + 6 u.r 2+ end ; \ often times ks 29 jun 87 Onlyforth : often stop? ?exit >in off ; | Variable #times #times off : times ( n -- ) ?dup IF #times @ 2+ u< stop? or IF #times off exit THEN 1 #times +! ELSE stop? ?exit THEN >in off ; \ dump ks 04 jul 87 : dump ( addr n -- ) base push hex bounds ?DO cr I $10 [ Tools ] d [ Forth ] drop stop? IF LEAVE THEN $10 +LOOP ; | : ld ( seg:addr -- ) over 4 u.r ." :" dup 0 <# # # # # #> type 3 spaces ds@ pad $10 lmove pad $10 bounds DO I c@ 3 u.r LOOP 2 spaces pad $10 type ; : ldump ( seg:addr quan -- ) base push hex 0 DO cr 2dup ld $10 + stop? IF LEAVE THEN $10 +LOOP 2drop ; \ No newline at end of file +\ ks 22 dez 87 Some simple tools for debugging. A state-of-the-art, interactive single step tracer and a couple of tools for decompiling and dumping \ Programming-Tools word set cas 19july2020 Onlyforth \needs Assembler 2 loadfrom asm.fb Vocabulary Tools Tools also definitions 1 11 +thru Onlyforth .( Tools loaded ) cr \ trace - next ks 11 jun 87 | Variable nest? nest? off Label tracenext 0 # nest? #) byte cmp 0= ?[ $5555 # I cmp here 2- >label (ip >= ?[ [[ swap lods A W xchg W ) jmp ]? $5555 # I cmp here 2- >label ip) CS ?] ][ 0 # nest? #) byte mov ]? $5555 # W mov here 2- >label >tracing W ) jmp end-code | (ip Constant | : (debug ( addr -- ) dup ! ; \ install Tracer ks 11 jun 87 Label (do-trace next-link # W mov D push $E9 # A- mov tracenext 1+ # C mov [[ W ) W mov W W or 0= not ?[[ A- -4 W D) mov C D mov W D sub D -3 W D) mov ]]? D pop ret end-code Code do-trace (do-trace # call Next end-code ' end-trace Alias end-trace | Code (step (do-trace # call R ) I mov R inc R inc lods A W xchg W ) jmp | Create: nextstep (step ; \ tracer display ks 20 sep 88 | Variable nest# nest# off | Variable 'ip 'ip off | Create: -nest r> ip> ! r> r0 ! r> dup #tib ! rp@ over tib swap cmove rp@ + rp! r> Is parser r> adr 'quit ! r> >in ! r> blk ! r> state ! r> output ! r> input ! ; \ tracer display ks 16 sep 88 | : tracing end-trace nest? @ IF r> r ip> @ >r -nest >r >r 1 nest# +! r@ 2- (debug nest? off THEN r@ 'ip ! nextstep >r input @ >r output @ >r state @ >r blk @ >r >in @ >r adr 'quit @ >r adr parser @ >r tib #tib @ rp@ over - under rp! cmove #tib @ >r r0 @ >r rp@ r0 ! standardi/o cr nest# @ spaces 'ip @ dup 5 u.r @ dup 5 u.r 2 spaces >name .name &30 nest# @ + tab .s $20 allot ['] oneline Is 'quit quit ; ' tracing >tracing ! \ test traceability ks 07 dez 87 | : traceable ( cfa -- cfa' ) recursive dup @ [ ' : @ ] Literal case? ?exit [ ' key @ ] Literal case? IF >body c@ Input @ + @ traceable exit THEN [ ' type @ ] Literal case? IF >body c@ Output @ + @ traceable exit THEN [ ' r/w @ ] Literal case? IF >body @ traceable exit THEN c@ $E9 = IF @ 1+ exit THEN \ Does> word >name .name ." can't be DEBUGged" quit ; \ user words for tracing ks 16 sep 88 | : do_debug ( addr -- ) traceable (debug nest? off nest# off do-trace ; : nest \ trace next high-level word executed 'ip @ @ traceable drop nest? on ; : unnest \ ends tracing of actual word off ; unnest \ clears trap range : endloop \ stop tracing loop 'ip @ r do_debug r> execute end-trace unnest ; \ tools for decompiling, interactive use ks 04 jul 87 | : ?: ( addr -- addr ) dup 5 u.r ." :" ; | : @? ( addr -- addr ) dup @ 6 u.r ; | : c? ( addr -- addr ) dup c@ 3 .r ; | : end $28 tab ; : s ( addr1 -- addr2 ) ?: 3 spaces c? 2 spaces count 2dup type + even end ; : n ( addr1 -- addr2 ) ?: @? 2 spaces dup @ >name .name 2+ end ; : d ( addr1 n -- addr2 ) 2dup swap ?: 3 spaces swap 0 DO c? 1+ LOOP 2 spaces -rot type end ; : l ( addr1 -- addr2 ) ?: 6 spaces @? 2+ end ; : c ( addr1 -- addr2 ) 1 d end ; : b ( addr1 -- addr2 ) ?: @? dup @ over + 6 u.r 2+ end ; \ often times ks 29 jun 87 Onlyforth : often stop? ?exit >in off ; | Variable #times #times off : times ( n -- ) ?dup IF #times @ 2+ u< stop? or IF #times off exit THEN 1 #times +! ELSE stop? ?exit THEN >in off ; \ dump ks 04 jul 87 : dump ( addr n -- ) base push hex bounds ?DO cr I $10 [ Tools ] d [ Forth ] drop stop? IF LEAVE THEN $10 +LOOP ; | : ld ( seg:addr -- ) over 4 u.r ." :" dup 0 <# # # # # #> type 3 spaces ds@ pad $10 lmove pad $10 bounds DO I c@ 3 u.r LOOP 2 spaces pad $10 type ; : ldump ( seg:addr quan -- ) base push hex 0 DO cr 2dup ld $10 + stop? IF LEAVE THEN $10 +LOOP 2drop ; \ 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. @ . ; \ No newline at end of file diff --git a/sources/msdos/tools.fb.src b/sources/msdos/tools.fb.src index cb17b1e..4156d7f 100644 --- a/sources/msdos/tools.fb.src +++ b/sources/msdos/tools.fb.src @@ -16,12 +16,12 @@ Screen 0 not modified 14 15 Screen 1 not modified - 0 \ Trace Loadscreen ks cas 25sep16 + 0 \ Programming-Tools word set cas 19july2020 1 Onlyforth \needs Assembler 2 loadfrom asm.fb 2 3 Vocabulary Tools Tools also definitions 4 - 5 1 9 +thru Onlyforth .( Tools geladen) cr + 5 1 11 +thru Onlyforth .( Tools loaded ) cr 6 7 8 @@ -186,10 +186,27 @@ Screen 10 not modified 14 15 Screen 11 not modified - 0 + 0 \ N>R NR> cr 1 - 2 - 3 + 2 : N>R ( i * n +n -- ) ( R: -- j * x +n ) + 3 \ Transfer N items and count to the return stack. + 4 DUP BEGIN DUP WHILE + 5 ROT R> SWAP >R >R + 6 1- + 7 REPEAT DROP R> SWAP >R >R ; + 8 + 9 : NR> ( -- i * x +n ) ( R: j * x +n -- ) +10 \ Pull N items and count off the return stack. +11 R> R> SWAP >R DUP +12 BEGIN DUP WHILE +13 R> R> SWAP >R -ROT +14 1- +15 REPEAT DROP ; +Screen 12 not modified + 0 \ ? + 1 : ? ( a-addr -- ) + 2 \ Display the value stored at a-addr. + 3 @ . ; 4 5 6