home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / evm.seq < prev    next >
Encoding:
Text File  |  1991-01-08  |  28.4 KB  |  897 lines
  1. \ EVM.SEQ               6805 EVM Support                by Andrew McKewan
  2.  
  3. ONLY FORTH ALSO DEFINITIONS DECIMAL
  4.  
  5. \u sym-free sym-free
  6. \u serial-off serial-off
  7.  
  8. ANEW EVM-STUFF
  9.  
  10. NOBASE  ( don't change base in ABORT )
  11.  
  12. FLOAD TERM.SEQ          \ Serial port
  13. SINIT 9600 BAUD SERIAL-ON
  14.  
  15. FLOAD DISEVM.SEQ        \ Disassembler
  16.  
  17. VOCABULARY EVM          \ EVM Debugger Commands
  18.  
  19. ONLY FORTH ALSO EVM ALSO FORTH DEFINITIONS
  20.  
  21. \ ***************************************************************************
  22. \ Target Memory Map
  23.  
  24. $2000 value targ-size
  25.  $100 value targ-origin
  26. $0FFF value maxaddr             \ maximum target address
  27. $1FFE value reset-vector
  28.  
  29.   $50 value targ-stack
  30.   $58 value targ-sp0
  31.  
  32.  
  33. \ ***************************************************************************
  34. \ Read object file
  35.  
  36. CREATE IMAGE $2000 ALLOT        \ Max 8K target
  37. : THERE    IMAGE + ;
  38. : C@-T     THERE C@ ;
  39. : C!-T     THERE C! ;
  40. : @-T      THERE @ flip ;
  41.  
  42.  
  43. HANDLE OBJFILE
  44.  
  45. : READ-OBJECT   ( -- )
  46.                 ?FILEOPEN
  47.                 SEQHANDLE OBJFILE $>HANDLE
  48.                 " BIN" ">$ OBJFILE $>EXT
  49.                 OBJFILE HOPEN ABORT" Object file not found"
  50.                 IMAGE targ-size OBJFILE HREAD
  51.                 targ-size <> ABORT" Error reading object file"
  52.                 OBJFILE HCLOSE DROP ;
  53.  
  54. \ ***************************************************************************
  55. \ Symbol Table
  56.  
  57. \ The symbol table is a table with a 4-byte entry per target byte.
  58. \
  59. \   bytes 0-1 : nfa of symbol or zero if no symbol at this address
  60. \   bytes 2-3 : source line number
  61.  
  62. 0 value sym-seg                         \ segment of symbol table
  63. maxaddr 1+ 4 * constant sym-size        \ symbol table size in bytes
  64.  
  65. : >sym  ( tadr -- seg ofs )     sym-seg swap 4 * ;
  66. : >lin  ( tadr -- seg ofs )     sym-seg swap 4 * 2+ ;
  67.  
  68. : find-sym      ( tadr -- nfa t | f )   \ find symbol for this address
  69.                 >sym @L ?dup 0<> ;
  70.  
  71. : find-line     ( tadr -- line# )       \ find source line number
  72.                 >lin @L ;
  73.  
  74.  
  75. \ Allocate symbol table
  76.  
  77. : sym-alloc     ( -- )
  78.                 sym-seg 0=
  79.                 if      sym-size paragraph alloc
  80.                         abort" can't allocate symbol lookup table"
  81.                         =: sym-seg drop
  82.                         sym-seg 0 sym-size 0 lfill
  83.                 then ;
  84.  
  85. : sym-free      sym-seg
  86.                 if      sym-seg dealloc
  87.                         abort" can't free symbol table segment"
  88.                         off> sym-seg
  89.                 then ;
  90.  
  91.  
  92. \ Read symbol file
  93.  
  94. VOCABULARY SYMBOL       \ vocabulary for symbol constants
  95.  
  96. : SRUN          ( -- )
  97.                 BL WORD DUP C@  \ ignore blank lines
  98.                 IF      NUMBER? NIP
  99.                         IF      DUP CONSTANT
  100.                                 last @ swap >sym !L
  101.                         ELSE    DROP
  102.                         THEN
  103.                 ELSE    DROP
  104.                 THEN ;
  105.  
  106. : SYMLOAD       ( handle -- f )
  107.                 SAVE> CURRENT           SAVE> CONTEXT
  108.                 SAVE> BASE              SAVE> RUN
  109.                 SAVE> WARNING
  110.                 ['] SRUN IS RUN
  111.                 SYMBOL DEFINITIONS  HEX
  112.                 WARNING OFF
  113.                 $FLOAD
  114.                 RESTORE> WARNING
  115.                 RESTORE> RUN            RESTORE> BASE
  116.                 RESTORE> CONTEXT        RESTORE> CURRENT ;
  117.  
  118. HANDLE SYMFILE
  119.  
  120. : READ-SYMBOLS  ( -- )
  121.                 ?FILEOPEN
  122.                 sym-alloc
  123.                 SEQHANDLE SYMFILE $>HANDLE
  124.                 " SYM" ">$ SYMFILE $>EXT
  125.                 SYMFILE SYMLOAD ?OPEN.ERROR ;
  126.  
  127.  
  128. \ Read Line number file
  129.  
  130. 0 value lastaddr        \ last address where line number known
  131.  
  132. : add-lines     ( adr -- )      \ fill in line number table
  133.                                 \ put loadline-1 into entries for
  134.                                 \ lastaddr to adr-1.  Update lastaddr.
  135.                 loadline @ 1- 1 max
  136.                 over lastaddr
  137.                 do      dup i >lin !L
  138.                 loop
  139.                 drop =: lastaddr ;
  140.  
  141.  
  142. : LRUN          ( -- )
  143.                 BL WORD DUP C@  \ blank line signals end of file
  144.                 IF      NUMBER? NIP  \ so does bad number
  145.                         IF      dup lastaddr <>
  146.                                 if      add-lines
  147.                                 else    drop
  148.                                 then    exit
  149.                         THEN
  150.                 THEN
  151.                 drop ( here or bad # )
  152.                 maxaddr 1+ add-lines  \ fill in rest of addresses
  153.                 [compile] \S ;
  154.  
  155. : LINLOAD       ( handle -- f )
  156.                 SAVE> BASE
  157.                 SAVE> RUN
  158.                 ['] LRUN IS RUN
  159.                 HEX
  160.                 0 =: lastaddr
  161.                 $FLOAD
  162.                 RESTORE> RUN
  163.                 RESTORE> BASE ;
  164.  
  165. HANDLE LINFILE
  166.  
  167. : READ-LINES    ( -- )
  168.                 ?FILEOPEN
  169.                 sym-alloc
  170.                 SEQHANDLE LINFILE $>HANDLE
  171.                 " LIN" ">$ LINFILE $>EXT
  172.                 LINFILE LINLOAD ?OPEN.ERROR ;
  173.  
  174. \ Read Source File
  175.  
  176. : read-source   ( -- )
  177.                 ?fileopen
  178.                 [ editor ]
  179.                 off> newfl
  180.                 seqhandle hclose drop           \ close current file
  181.                 seqhandle ed1hndl $>handle      \ copy file to edit handle
  182.                 ?readfile
  183.                 seqhandle hopen drop            \ open current file
  184.                 ;
  185.  
  186.  
  187.  
  188. : READ          \ Read target files
  189.                 READ-OBJECT
  190.                 READ-SYMBOLS
  191.                 READ-LINES
  192.                 READ-SOURCE ;
  193.  
  194.  
  195. \ ***************************************************************************
  196. \ Build Motorola S-records
  197.  
  198. VARIABLE CKSUM
  199. : CHAR   ( c -- )  HLD @ C!  1 HLD +! ;
  200. : DIGT   ( n -- )  DUP 9 > IF 7 + THEN  '0' + CHAR ;
  201. : BYTE   ( b -- )  DUP CKSUM +!  0 16 UM/MOD DIGT DIGT ;
  202.  
  203. : S-REC         ( tadr len -- adr n )
  204.                 \ Format a record from the target into the Motorola S-record
  205.                 \ format.  Return the address and length of the ASCII string.
  206.                 PAD HLD !  CKSUM OFF
  207.                 'S' CHAR  '1' CHAR              \ prefix
  208.                 DUP 3 + BYTE                    \ length
  209.                 OVER SPLIT BYTE BYTE            \ address
  210.                 BOUNDS ?DO  I C@-T BYTE  LOOP   \ data
  211.                 CKSUM @ NOT 255 AND BYTE        \ checksum
  212.                 PAD HLD @ OVER - ;
  213.  
  214. : S-EOF         ( -- adr n )  " S9030000FC" ;
  215.  
  216. \ ***************************************************************************
  217. \ Download to EVM
  218.  
  219. : WAIT          ( char -- )  BEGIN DUP SKEY = UNTIL DROP ;
  220.  
  221. : PROMPT        ASCII > WAIT ;
  222.  
  223. : STOP?         KEY? IF KEY DROP QUIT THEN ;
  224.  
  225. : ECHO          BEGIN SKEY? WHILE SKEY EMIT REPEAT ;
  226.  
  227. : STYPE         ( adr len -- )
  228.                 BOUNDS ?DO  I C@ SEMIT  ( ECHO )  LOOP ;
  229.  
  230. : ENTER         13 SEMIT ;
  231.  
  232. : SEND          ( adr len -- )   STYPE ENTER  13 WAIT ;
  233.  
  234. : RECORD        ( tadr len -- )
  235.                 #OUT OFF  OVER H.
  236.                 S-REC SEND ;
  237.  
  238. : (DOWN)        ( tadr len -- )
  239.                 \ Download a series of S-records to the EVM board for the
  240.                 \ given target address and length.
  241.                 16 /MOD  SWAP >R  0
  242.                 ?DO     DUP 16 RECORD
  243.                         16 +
  244.                         STOP?
  245.                 LOOP    R> DUP
  246.                 IF  RECORD  ELSE  2DROP  THEN ;
  247.  
  248. : -ZEROS        ( adr len -- adr len' )
  249.                 DUP 0
  250.                 ?DO     2DUP + 1- C@-T ?LEAVE
  251.                         1-
  252.                 LOOP ;
  253.  
  254. : OK?           KILL  ENTER  10 MS
  255.                 BEGIN   SKEY?
  256.                 WHILE   SKEY ASCII > = IF EXIT THEN
  257.                 REPEAT
  258.                 1 ABORT" EVM off-line" ;
  259.  
  260. : HC05C8-DOWN   ( -- )
  261.                 OK? CR
  262.                 " LOAD T" SEND
  263.                 $20 $30 -ZEROS (DOWN)
  264.                 $100 $1000 -ZEROS (DOWN)
  265.                 $1FF4 $0C (DOWN)
  266.                 S-EOF SEND
  267.                 PROMPT ;
  268.  
  269. EVM DEFINITIONS
  270. defer DOWN      ' HC05C8-DOWN is DOWN
  271. FORTH DEFINITIONS
  272.  
  273. \ ***************************************************************************
  274. \ EVM debugging
  275.  
  276. : S"            [COMPILE] " COMPILE STYPE ; IMMEDIATE
  277.  
  278. : PUT           ( n -- )
  279.                 SAVE> BASE
  280.                 HEX (U.) STYPE
  281.                 RESTORE> BASE ;
  282.  
  283. : GET           ( -- n )
  284.                 SKEY 16 DIGIT DROP  16 *
  285.                 SKEY 16 DIGIT DROP  +       ;
  286.  
  287. : END           ASCII . SEMIT ENTER ;
  288.  
  289. : REPLY         ( char -- )
  290.                 BEGIN SKEY 2DUP - WHILE EMIT REPEAT 2DROP ;
  291.  
  292. : ANSWER        10 WAIT
  293.                 BEGIN   13 REPLY 10 WAIT
  294.                         SKEY DUP '>' <>
  295.                 WHILE   CR EMIT
  296.                 REPEAT  DROP ;
  297.  
  298.  
  299. \ ***************************************************************************
  300. \ Read/Write Target Memory
  301.  
  302. : TC@           ( tadr -- c )
  303.                 S" MM " PUT  ENTER
  304.                 ASCII = WAIT  GET
  305.                 PROMPT  END   PROMPT ;
  306.  
  307. : TC!           ( c tadr -- )
  308.                 S" MM " PUT  ENTER
  309.                 PROMPT   PUT  END   PROMPT ;
  310.  
  311. : T@            ( tadr -- w )
  312.                 S" MM " PUT ENTER
  313.                 ASCII = WAIT  GET 256 *  PROMPT  ENTER
  314.                 ASCII = WAIT  GET +      PROMPT  END
  315.                 PROMPT ;
  316.  
  317. : T!            ( w tadr -- )
  318.                 S" MM " PUT ENTER
  319.                 PROMPT  SPLIT PUT  ENTER
  320.                 PROMPT        PUT  END
  321.                 PROMPT ;
  322.  
  323. : TDUMP         ( tadr len -- )
  324.                 S" MD " OVER PUT
  325.                 S"  "  1- + PUT ENTER
  326.                 CR ANSWER ;
  327.  
  328. : TASM          ( adr #inst -- )
  329.                 S" ASM "  SWAP PUT ENTER  13 WAIT
  330.                 1- 0 ?DO  ASCII > REPLY  ENTER  LOOP
  331.                 ASCII > REPLY  END  PROMPT ;
  332.  
  333. : T?            TC@ . ;
  334.  
  335. \ ***************************************************************************
  336. \ Registers
  337.  
  338. : RD            S" RD" ENTER                    \ display registers
  339.                 ASCII = WAIT ." S=" 13 REPLY
  340.                 PROMPT ;
  341.  
  342. \ ***************************************************************************
  343. \ Window Locations
  344.  
  345. \ Source Window
  346.  1 value srctop         \ top row of source window
  347.  7 value srcbot         \ bottom row of source window
  348.  0 value srcleft        \ left margin of source window
  349. 75 value srcwidth       \ width of source line (not including line #)
  350.  
  351. \ Disassembly Window
  352.  9 value distop         \ top row of disassembly window
  353. 18 value disbot         \ bottom row of disassembly window
  354.  1 value disleft        \ left margin of disassembly window
  355. 53 value diswidth       \ width of disassembly window
  356.  
  357. \ Command Window
  358. disbot 2+ value cmdtop         \ top row of command window
  359.  
  360. \ Register Window, 5 rows x 13 columns
  361.  9 value regrow         \ upper-left row
  362. 55 value regcol         \ upper-left column
  363.  
  364. \ Stack Window, 5 rows x 10 columns
  365.  9 value stkrow         \ upper-left row
  366. 69 value stkcol         \ upper-left column
  367.  
  368. \ Watch/Breakpoint Window, 4 rows
  369. 15 value watchrow       \ upper-left row
  370. 55 value watchcol       \ upper-left column
  371. 79 value watchend       \ right column
  372.  
  373. : frame
  374.                 savecursor cursor-off on> nosetcur
  375. >norm \                 black >bg yellow >fg
  376. 0  8 at ." ╔═════════════════════════════════════════════════════╦═════════════╦══════════╗"
  377. 0  9 at ." ║                                                     ║             ║          ║"
  378. 0 10 at ." ║                                                     ║             ║          ║"
  379. 0 11 at ." ║                                                     ║             ║          ║"
  380. 0 12 at ." ║                                                     ║             ║          ║"
  381. 0 13 at ." ║                                                     ║             ║          ║"
  382. 0 14 at ." ║                                                     ╠═════════════╩══════════╣"
  383. 0 15 at ." ║                                                     ║                        ║"
  384. 0 16 at ." ║                                                     ║                        ║"
  385. 0 17 at ." ║                                                     ║                        ║"
  386. 0 18 at ." ║                                                     ║                        ║"
  387. 0 19 at ." ╚═════════════════════════════════════════════════════╩════════════════════════╝"
  388.                 off> nosetcur restcursor ;
  389.  
  390.  
  391. \ ***************************************************************************
  392. \ Color Scheme
  393.  
  394. : color ( bg fg -- )    \ define colors
  395.         create swap 16 * + ,
  396.         does> @ attrib c! ;
  397.  
  398. black yellow color %source
  399. ltgray black color %source-rev
  400. blue white   color %dis
  401. ltgray black color %dis-rev
  402. green white  color %register
  403. brown white  color %stack
  404. ltgray blue  color %watch
  405. red white    color %break
  406.  
  407. \ ***************************************************************************
  408. \ GET/PUT REGISTER SET
  409.  
  410. EVM DEFINITIONS
  411. 0 value A
  412. 0 value X
  413. 0 value SP
  414. 0 value PC
  415. 0 value CC
  416. 0 value TSP      targ-sp0 =: TSP  \ Target stack pointer
  417.  
  418. FORTH DEFINITIONS
  419.  
  420. : .cc           CC $10 and if ." H" else ." ." then
  421.                 CC $08 and if ." I" else ." ." then
  422.                 CC $04 and if ." N" else ." ." then
  423.                 CC $02 and if ." Z" else ." ." then
  424.                 CC $01 and if ." C" else ." ." then
  425.                 space ;
  426.  
  427. : .REGS         ." A=" A .  ." X=" X .  ." SP=" SP .
  428.                 ." PC=" PC .  ." CC=" .cc ;
  429.  
  430. : regat  ( n -- )  regcol swap regrow + at ;
  431. : .rr    ( n -- )  4 .r  2 spaces ;
  432.  
  433. : show-regs
  434.                 savecursor cursor-off on> nosetcur
  435.                 %register
  436.                 0 regat ."   A  = " A .rr
  437.                 1 regat ."   X  = " X .rr
  438.                 2 regat ."   SP = " SP .rr
  439.                 3 regat ."   PC = " PC .rr
  440.                 4 regat ."   CC = " .cc
  441.                 off> nosetcur restcursor ;
  442.  
  443.  
  444. : ?tsp          ( -- )  \ set TSP if X points to stack
  445.                 X targ-stack targ-sp0 between if  X =: TSP  then ;
  446.  
  447. : (GET-REGS)    ( -- )
  448.                 ASCII = WAIT GET                =: SP
  449.                 ASCII = WAIT GET 256 * GET +    =: PC
  450.                 ASCII = WAIT GET                =: A
  451.                 ASCII = WAIT GET                =: X      ?tsp
  452.                 ASCII = WAIT GET                =: CC
  453.                 PROMPT ;
  454.  
  455. : GET-REGS      S" RD" ENTER
  456.                 (GET-REGS) ;
  457.  
  458. : PUT-REGS      ( -- )
  459.                 S" RM" ENTER
  460.                 PROMPT PC PUT ENTER
  461.                 PROMPT A  PUT ENTER
  462.                 PROMPT X  PUT ENTER
  463.                 PROMPT CC PUT END
  464.                 PROMPT ;
  465.  
  466. \ ***************************************************************************
  467. \ Target stack
  468.  
  469. : tdepth        ( -- n )
  470.                 targ-sp0 TSP - ;
  471.  
  472. : show-stack    ( -- )          \ show top 4 items of stack
  473.                 savecursor cursor-off on> nosetcur
  474.                 %stack
  475.                 stkcol stkrow
  476.                 targ-sp0 4 - tdepth 4 - 0max -  ( first address )
  477.                 4 bounds
  478.                 do      2dup at
  479.                         TSP i <=
  480.                         if      i tc@ 8 .r 2 spaces
  481.                         else    10 spaces
  482.                         then
  483.                         1+
  484.                 loop
  485.                 at tdepth ?dup
  486.                 if      ."      [" 0 .r ." ]  "
  487.                 else    ."  [Empty]  "
  488.                 then
  489.                 off> nosetcur restcursor ;
  490.  
  491. : sp-check      ( -- )
  492.                 X targ-stack targ-sp0 between not
  493.                 abort" stack pointer invalid " ;
  494.  
  495. : set-sp        ( adr -- )
  496.                 dup targ-stack targ-sp0 between not abort" invalid stack address"
  497.                 dup =: X =: TSP put-regs ;
  498.  
  499. : T.S           sp-check
  500.                 X DUP targ-sp0 =
  501.                 IF      DROP ." Empty"
  502.                 ELSE    targ-sp0 1- DO   I TC@ .   -1 +LOOP
  503.                 THEN ;
  504.  
  505. EVM DEFINITIONS
  506. : CLR           ( -- )          \ clear target stack
  507.                 sp-check
  508.                 targ-sp0 set-sp
  509.                 show-stack ;
  510.  
  511. : PUSH          ( n -- )        \ push n to target stack
  512.                 sp-check
  513.                 X 1-  dup set-sp  TC!
  514.                 show-stack ;
  515.  
  516. : POP           ( -- n )        \ pop target stack
  517.                 sp-check
  518.                 X  dup 1+ set-sp  TC@
  519.                 show-stack ;
  520. FORTH DEFINITIONS
  521.  
  522. \ ***************************************************************************
  523. \ Display Source Code
  524.  
  525. 0 value srcfirst        \ first line in source window
  526. 0 value srclast         \ first line below source window
  527.  
  528. : show-line     ( line# -- )
  529.                 [ editor ]
  530.                 dup 4 .r space
  531.                 1- 0MAX ( editor numbers from 0 )
  532.                 #lineseginfo 2- srcwidth min
  533.                 srcwidth over - >r typeL r> spaces ;
  534.  
  535. : .source       ( line -- )     \ this will not work if file < 6 lines!
  536.                 savecursor cursor-off on> nosetcur
  537.                 %source
  538.                 dup srcfirst srclast within
  539.                 if      drop srcfirst
  540.                 else    dup maxaddr find-line =
  541.                         if  srcbot - srctop +  ( put me on last line )
  542.                         else  1- 1 max ( put me on second line )
  543.                         then
  544.                         dup =: srcfirst
  545.                 then
  546.                 srcbot 1+ srctop
  547.                 do      srcleft i at
  548.                         dup PC find-line = if  %source-rev   then
  549.                         dup show-line  %source
  550.                         1+
  551.                 loop
  552.                 =: srclast
  553.                 off> nosetcur restcursor ;
  554.  
  555. : show-source   PC find-line .source ;
  556.  
  557. EVM DEFINITIONS
  558. : L             ( line# -- )    \ list source
  559.                 dup =: srcfirst .source ;
  560. FORTH DEFINITIONS
  561.  
  562.  
  563. \ ***************************************************************************
  564. \ Disassembly window
  565.  
  566. DISASSEMBLER
  567. ' c@-t is tc@
  568. ' @-t is t@
  569. ' find-sym is ?symbol
  570. ' .symbol alias .symbol         \ so i can use it
  571. FORTH
  572.  
  573. 0 value disfirst        \ address of first instruction in window
  574. 0 value dislast         \ address of first instruction beyond window
  575.  
  576. : .1inst        ( tadr -- tadr2 )
  577.                 dup 5 u.r 2 spaces
  578.                 dup find-sym
  579.                 if      10 .id|n
  580.                 then
  581.                 disleft 19 + col inst
  582.                 disleft diswidth + col ;
  583.  
  584. : .dis          ( tadr -- )
  585.                 savecursor cursor-off on> nosetcur
  586.                 %dis
  587.                 dup disfirst dislast within
  588.                 if      drop disfirst
  589.                 else    dup =: disfirst
  590.                 then
  591.                 disbot 1+ distop
  592.                 do      disleft i at
  593.                         dup PC = if  %dis-rev   then
  594.                         .1inst       %dis
  595.                 loop
  596.                 =: dislast
  597.                 off> nosetcur restcursor ;
  598.  
  599.  
  600. : show-dis      PC .dis ;
  601.  
  602. EVM DEFINITIONS
  603. : U             ( tadr -- )     \ Unassemble
  604.                 dup =: disfirst .dis ;
  605.  
  606. FORTH DEFINITIONS
  607.  
  608. \ ***************************************************************************
  609. \ Watch Variables
  610.  
  611. 0 value watching       \ true if displaying watch variables
  612.  
  613. CREATE WATCHES   -1 , -1 , -1 , -1 ,
  614.  
  615. : .var          ( tadr -- )     \ display target variable
  616.                 dup find-sym if .id then
  617.                 dup ." [" 0 .r ." ] = " t? ;
  618.  
  619. : show-watches  ( -- )
  620.                 savecursor cursor-off on> nosetcur
  621.                 %watch
  622.                 watchcol watchrow
  623.                 watches 8 bounds
  624.                 do      i @ 1+
  625.                         if      2dup at space
  626.                                 i @ .var
  627.                                 watchend col  1+
  628.                         then
  629.                 2 +loop
  630.                 watchrow 4 + over
  631.                 ?do  2dup at watchend col  1+  loop
  632.                 2drop
  633.                 off> nosetcur restcursor ;
  634.  
  635. EVM DEFINITIONS
  636. : .W            ( -- )          \ set to display watch variables
  637.                 on> watching
  638.                 show-watches ;
  639.  
  640. : W             ( tadr -- )     \ add watch variable
  641.                 watches 8 bounds
  642.                 do      i @ 0<
  643.                         if      i !
  644.                                 .W
  645.                                 undo exit
  646.                         then
  647.                 2 +loop
  648.                 drop ." too many watch variables" ;
  649.  
  650. : -W            ( tadr -- )     \ remove watch variable
  651.                 watches 8 bounds
  652.                 do      dup i @ =
  653.                         if      drop i on       \ clear entry
  654.                                 .W
  655.                                 undo exit
  656.                         then
  657.                 2 +loop
  658.                 drop ." watch variable not found" ;
  659.  
  660. : NW            ( -- )          \ no watch variables
  661.                 watches 8 $ff fill
  662.                 .W ;
  663. FORTH DEFINITIONS
  664.  
  665. \ ***************************************************************************
  666. \ Breakpoints
  667.  
  668. create breaks 0 , 0 , 0 , 0 ,
  669.  
  670. : show-breaks   ( -- )
  671.                 savecursor cursor-off on> nosetcur
  672.                 %break
  673.                 watchcol watchrow
  674.                 breaks 8 bounds
  675.                 do      i @
  676.                         if      2dup at space
  677.                                 i @ .symbol
  678.                                 watchend col 1+
  679.                         then
  680.                 2 +loop
  681.                 watchrow 4 + over
  682.                 ?do  2dup at watchend col 1+  loop
  683.                 2drop
  684.                 off> nosetcur restcursor ;
  685.  
  686. : put-breaks    ( -- )  \ send breakpoints to EVM
  687.                 breaks 8 0 scan nip ( any breakpoints? )
  688.                 if      s" BR"
  689.                         breaks 8 bounds
  690.                         do      i @ ?dup
  691.                                 if      s"  " put
  692.                                 then
  693.                         2 +loop
  694.                         enter prompt
  695.                 then ;
  696.  
  697.  
  698. EVM DEFINITIONS
  699. : .B            ( -- )  \ set to show breakpoints
  700.                 off> watching
  701.                 show-breaks ;
  702.  
  703. : B             ( tadr -- )     \ set breakpoint
  704.                 breaks 8 bounds
  705.                 do      i @ 0=
  706.                         if      i !
  707.                                 .B
  708.                                 undo exit
  709.                         then
  710.                 2 +loop
  711.                 drop ." too many breakpoints" ;
  712.  
  713. : -B            ( tadr -- )     \ remove breakpoint
  714.                 breaks 8 bounds
  715.                 do      dup i @ =
  716.                         if      drop i off
  717.                                 .B
  718.                                 undo exit
  719.                         then
  720.                 2 +loop
  721.                 drop ." breakpoint not found" ;
  722.  
  723. : NB            ( -- )          \ no breakpoints
  724.                 breaks 8 erase
  725.                 .B ;
  726. FORTH DEFINITIONS
  727.  
  728. \ ***************************************************************************
  729. \ Display debugging screen
  730.  
  731. : show
  732.                 show-source
  733.                 show-dis
  734.                 show-regs
  735.                 show-stack
  736.                 watching if show-watches then ;
  737.  
  738. : scr           0 cmdtop at -line
  739.                 0 rows 1- at ;
  740.  
  741. : auto          ['] scr is cr ;
  742.  
  743. EVM DEFINITIONS
  744. : D             \ refresh display
  745.                 ok?  \ make sure EVM is alive
  746.                 ( statoff )  vocoff  get-regs
  747.                 dark frame show ;
  748.  
  749. : TOP           ( -- )          \ Put current PC at top of window
  750.                 off> srcfirst   show-source
  751.                 off> disfirst   show-dis ;
  752.  
  753. \ Modify registers   ( can't change SP )
  754.  
  755. : =A    ( n -- )   =: A   put-regs  show-regs ;
  756. : =X    ( n -- )   =: X   ?tsp  put-regs  show ;
  757. : =CC   ( n -- )   =: CC  put-regs  show-regs ;
  758. : =PC   ( n -- )   =: PC  put-regs  show ;
  759.  
  760. FORTH DEFINITIONS
  761.  
  762. \ ***************************************************************************
  763. \ Execution Control
  764.  
  765. : receive-trap  ( -- )
  766.                 (get-regs)      \ wait till EVM hits the next breakpoint
  767.                                 \ at which time it sends the registers
  768.                 s" NOBR" enter prompt ;         \ remove any breakpoints
  769.  
  770. : gofromtrap    ( -- )
  771. \                put-regs        \ put (modified) values back into target
  772.                 s" G" enter ;   \ excute from current pc
  773.  
  774. : exec>trap     ( -- )          \ execute until breakpoint
  775.                 gofromtrap
  776.                 receive-trap ;
  777.  
  778. : skip?         ( -- adr t | f )        \ if next instruction is a call,
  779.                                         \ return skip-to address and true.
  780.                 PC C@-T
  781.                 DUP 173 ( BSR ) = IF  DROP  PC 2 + TRUE  EXIT  THEN
  782.                     205 ( JSR ) = IF        PC 3 + TRUE  EXIT  THEN
  783.                 FALSE ;
  784.  
  785. EVM DEFINITIONS
  786. : G             ( -- )                  \ execute from current pc (go)
  787.                 put-breaks
  788.                 exec>trap
  789.                 show ;
  790.  
  791. : T             ( -- )                  \ Trace (single step)
  792. \                put-regs
  793.                 s" T" enter
  794.                 (get-regs) show ;
  795.  
  796. : GOTO          ( adr -- )              \ execute till address, redisplay.
  797.                 s" BR " put enter prompt
  798.                 exec>trap show ;
  799.  
  800. : S             ( -- )                          \ single step
  801.                 skip? if GOTO else T then ;
  802.  
  803. : STEPS         ( n -- )                \ multiple steps, no display update
  804. \                put-regs
  805.                 0
  806.                 ?do     skip?
  807.                         if      s" BR " put enter prompt
  808.                                 exec>trap prompt
  809.                         else    s" T" enter prompt
  810.                         then
  811.                 loop
  812.                 get-regs show ;
  813.  
  814.  
  815. : RET           ( -- )  \ goto end of subroutine
  816.                 SP $FF = abort" no subroutine has been called"
  817.                 SP 1+ T@ GOTO ;
  818.  
  819. : E             ( tadr -- )             \ EXECUTE SUBROUTINE
  820.                 PC DUP ROT
  821.                 S" MM 1E00" ENTER PROMPT
  822.                 $CD   PUT   ENTER PROMPT       \ JSR
  823.                 SPLIT PUT   ENTER PROMPT       \ tadr HI
  824.                       PUT   ENTER PROMPT       \ tadr LO
  825.                 $CC   PUT   ENTER PROMPT       \ JMP
  826.                 SPLIT PUT   ENTER PROMPT       \ current PC HI
  827.                       PUT   END   PROMPT       \ current PC LO
  828.                 $1E00 =: PC
  829.                 put-regs GOTO ;
  830.  
  831. : RESET         ( -- )          \ go to reset address
  832.                 $1FFE @-T DUP  ( reset address )
  833.                 S" MM 1E00" ENTER PROMPT
  834.                 $9B   PUT   ENTER PROMPT       \ SEI
  835.                 $9C   PUT   ENTER PROMPT       \ RSP
  836.                 $CC   PUT   ENTER PROMPT       \ JMP
  837.                 SPLIT PUT   ENTER PROMPT       \ ADR HI
  838.                       PUT   END   PROMPT       \ ADR LO
  839.                 0 =: A  0 =: X  targ-sp0 =: TSP  0 =: CC
  840.                 $1E00 =: PC  put-regs GOTO ;
  841.  
  842. \ change memory words
  843. : @     tc@ ;
  844. : !     tc! ;
  845. : dump  tdump ;
  846. : ?     t? ;
  847.  
  848. FORTH DEFINITIONS
  849.  
  850. : start         only forth also symbol also evm definitions
  851.                 read down reset
  852.                 auto d ;
  853.  
  854. : evminit       ( --- )
  855.                 defers initstuff
  856.                 sinit 9600 baud serial-on ;
  857.  
  858. : evmHELLO      ( --- )
  859.                 SP0 @  'TIB !
  860.                 >IN     OFF
  861.                 SPAN    OFF
  862.                 #TIB    OFF
  863.                 LOADING OFF
  864. \u NOSETCUR     NOSETCUR OFF
  865.                 ONLY FORTH ALSO DEFINITIONS
  866.                 DEFAULTSTATE
  867.                 DEFAULT
  868.                 >in @ bl word swap >in ! c@ 0=
  869.                 if      .hello
  870.                         .curfile
  871.                 then    OPEN-PRN  interpret ;           \ *** 12/18/90 AM
  872.  
  873. ' evminit is initstuff
  874. ' serial-off is byefunc
  875. fsave evm.exe
  876.  
  877.  
  878. \ ***************************************************************************
  879. \ Target Interpreter
  880.  
  881. comment:
  882. : TARG          ( -- )
  883.                 BEGIN   BL WORD ?UPPERCASE DUP C@
  884.                 WHILE   DUP ['] SYMBOL >BODY HASH @ (FIND)
  885.                         IF      EXECUTE DUP 256 <
  886.                                 IF      PUSH
  887.                                 ELSE    E
  888.                                 THEN
  889.                         ELSE    NUMBER DROP PUSH
  890.                         THEN
  891.                 REPEAT  DROP ;
  892.  
  893.  
  894. comment;
  895.  
  896.  
  897.