From 0dcf42a5b1d7639bc460a26250b975beea61f066 Mon Sep 17 00:00:00 2001 From: Carsten Strotmann Date: Sun, 19 Jul 2020 09:40:16 +0200 Subject: [PATCH] Target 8080/CPM: implemented N>R NR> ? --- 8080/CPM/TOOLS.FB | 2 +- sources/cpm/TOOLS.FB.src | 38 ++++++++++++++++++++++++++++++++++++-- 2 files changed, 37 insertions(+), 3 deletions(-) diff --git a/8080/CPM/TOOLS.FB b/8080/CPM/TOOLS.FB index fceccbb..20a457b 100644 --- a/8080/CPM/TOOLS.FB +++ b/8080/CPM/TOOLS.FB @@ -1 +1 @@ -\\ 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 und END-TRACE) \ Loadscreen for simple decompiler and tracer 11Nov86 Onlyforth Vocabulary Tools Tools also definitions 01 05 +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 \ 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 ! ; \ 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= ?[ 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 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 off ; \ clears trap range : endloop \ stop tracing loop 'ip @ 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 \ 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 ! ; \ 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= ?[ 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 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 off ; \ clears trap range : endloop \ stop tracing loop 'ip @ 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/cpm/TOOLS.FB.src b/sources/cpm/TOOLS.FB.src index af3f5fb..afa7b23 100644 --- a/sources/cpm/TOOLS.FB.src +++ b/sources/cpm/TOOLS.FB.src @@ -16,11 +16,11 @@ Screen 0 not modified 14 Er ist unentbehrliches Hilfsmittel bei der Fehlersuche. 15 (Benutzung: DEBUG und END-TRACE) Screen 1 not modified - 0 \ Loadscreen for simple decompiler and tracer 11Nov86 + 0 \ Programming-Tools word set / tracer cas 19july2020 1 2 Onlyforth Vocabulary Tools Tools also definitions 3 - 4 01 05 +thru + 4 01 05 +thru 15 16 +thru 5 06 +load \ Tracer 6 7 Onlyforth @@ -270,3 +270,37 @@ Screen 15 not modified 13 14 : trace' ( -- ) \ reads a word 15 context push debug R NR> cr + 1 + 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 17 not modified + 0 \ ? + 1 + 2 : ? ( a-addr -- ) + 3 \ Display the value stored at a-addr. + 4 @ . ; + 5 + 6 + 7 + 8 + 9 +10 +11 +12 +13 +14 +15