home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
forth
/
compiler
/
fpc
/
source
/
evm.seq
< prev
next >
Wrap
Text File
|
1991-01-08
|
29KB
|
897 lines
\ EVM.SEQ 6805 EVM Support by Andrew McKewan
ONLY FORTH ALSO DEFINITIONS DECIMAL
\u sym-free sym-free
\u serial-off serial-off
ANEW EVM-STUFF
NOBASE ( don't change base in ABORT )
FLOAD TERM.SEQ \ Serial port
SINIT 9600 BAUD SERIAL-ON
FLOAD DISEVM.SEQ \ Disassembler
VOCABULARY EVM \ EVM Debugger Commands
ONLY FORTH ALSO EVM ALSO FORTH DEFINITIONS
\ ***************************************************************************
\ Target Memory Map
$2000 value targ-size
$100 value targ-origin
$0FFF value maxaddr \ maximum target address
$1FFE value reset-vector
$50 value targ-stack
$58 value targ-sp0
\ ***************************************************************************
\ Read object file
CREATE IMAGE $2000 ALLOT \ Max 8K target
: THERE IMAGE + ;
: C@-T THERE C@ ;
: C!-T THERE C! ;
: @-T THERE @ flip ;
HANDLE OBJFILE
: READ-OBJECT ( -- )
?FILEOPEN
SEQHANDLE OBJFILE $>HANDLE
" BIN" ">$ OBJFILE $>EXT
OBJFILE HOPEN ABORT" Object file not found"
IMAGE targ-size OBJFILE HREAD
targ-size <> ABORT" Error reading object file"
OBJFILE HCLOSE DROP ;
\ ***************************************************************************
\ Symbol Table
\ The symbol table is a table with a 4-byte entry per target byte.
\
\ bytes 0-1 : nfa of symbol or zero if no symbol at this address
\ bytes 2-3 : source line number
0 value sym-seg \ segment of symbol table
maxaddr 1+ 4 * constant sym-size \ symbol table size in bytes
: >sym ( tadr -- seg ofs ) sym-seg swap 4 * ;
: >lin ( tadr -- seg ofs ) sym-seg swap 4 * 2+ ;
: find-sym ( tadr -- nfa t | f ) \ find symbol for this address
>sym @L ?dup 0<> ;
: find-line ( tadr -- line# ) \ find source line number
>lin @L ;
\ Allocate symbol table
: sym-alloc ( -- )
sym-seg 0=
if sym-size paragraph alloc
abort" can't allocate symbol lookup table"
=: sym-seg drop
sym-seg 0 sym-size 0 lfill
then ;
: sym-free sym-seg
if sym-seg dealloc
abort" can't free symbol table segment"
off> sym-seg
then ;
\ Read symbol file
VOCABULARY SYMBOL \ vocabulary for symbol constants
: SRUN ( -- )
BL WORD DUP C@ \ ignore blank lines
IF NUMBER? NIP
IF DUP CONSTANT
last @ swap >sym !L
ELSE DROP
THEN
ELSE DROP
THEN ;
: SYMLOAD ( handle -- f )
SAVE> CURRENT SAVE> CONTEXT
SAVE> BASE SAVE> RUN
SAVE> WARNING
['] SRUN IS RUN
SYMBOL DEFINITIONS HEX
WARNING OFF
$FLOAD
RESTORE> WARNING
RESTORE> RUN RESTORE> BASE
RESTORE> CONTEXT RESTORE> CURRENT ;
HANDLE SYMFILE
: READ-SYMBOLS ( -- )
?FILEOPEN
sym-alloc
SEQHANDLE SYMFILE $>HANDLE
" SYM" ">$ SYMFILE $>EXT
SYMFILE SYMLOAD ?OPEN.ERROR ;
\ Read Line number file
0 value lastaddr \ last address where line number known
: add-lines ( adr -- ) \ fill in line number table
\ put loadline-1 into entries for
\ lastaddr to adr-1. Update lastaddr.
loadline @ 1- 1 max
over lastaddr
do dup i >lin !L
loop
drop =: lastaddr ;
: LRUN ( -- )
BL WORD DUP C@ \ blank line signals end of file
IF NUMBER? NIP \ so does bad number
IF dup lastaddr <>
if add-lines
else drop
then exit
THEN
THEN
drop ( here or bad # )
maxaddr 1+ add-lines \ fill in rest of addresses
[compile] \S ;
: LINLOAD ( handle -- f )
SAVE> BASE
SAVE> RUN
['] LRUN IS RUN
HEX
0 =: lastaddr
$FLOAD
RESTORE> RUN
RESTORE> BASE ;
HANDLE LINFILE
: READ-LINES ( -- )
?FILEOPEN
sym-alloc
SEQHANDLE LINFILE $>HANDLE
" LIN" ">$ LINFILE $>EXT
LINFILE LINLOAD ?OPEN.ERROR ;
\ Read Source File
: read-source ( -- )
?fileopen
[ editor ]
off> newfl
seqhandle hclose drop \ close current file
seqhandle ed1hndl $>handle \ copy file to edit handle
?readfile
seqhandle hopen drop \ open current file
;
: READ \ Read target files
READ-OBJECT
READ-SYMBOLS
READ-LINES
READ-SOURCE ;
\ ***************************************************************************
\ Build Motorola S-records
VARIABLE CKSUM
: CHAR ( c -- ) HLD @ C! 1 HLD +! ;
: DIGT ( n -- ) DUP 9 > IF 7 + THEN '0' + CHAR ;
: BYTE ( b -- ) DUP CKSUM +! 0 16 UM/MOD DIGT DIGT ;
: S-REC ( tadr len -- adr n )
\ Format a record from the target into the Motorola S-record
\ format. Return the address and length of the ASCII string.
PAD HLD ! CKSUM OFF
'S' CHAR '1' CHAR \ prefix
DUP 3 + BYTE \ length
OVER SPLIT BYTE BYTE \ address
BOUNDS ?DO I C@-T BYTE LOOP \ data
CKSUM @ NOT 255 AND BYTE \ checksum
PAD HLD @ OVER - ;
: S-EOF ( -- adr n ) " S9030000FC" ;
\ ***************************************************************************
\ Download to EVM
: WAIT ( char -- ) BEGIN DUP SKEY = UNTIL DROP ;
: PROMPT ASCII > WAIT ;
: STOP? KEY? IF KEY DROP QUIT THEN ;
: ECHO BEGIN SKEY? WHILE SKEY EMIT REPEAT ;
: STYPE ( adr len -- )
BOUNDS ?DO I C@ SEMIT ( ECHO ) LOOP ;
: ENTER 13 SEMIT ;
: SEND ( adr len -- ) STYPE ENTER 13 WAIT ;
: RECORD ( tadr len -- )
#OUT OFF OVER H.
S-REC SEND ;
: (DOWN) ( tadr len -- )
\ Download a series of S-records to the EVM board for the
\ given target address and length.
16 /MOD SWAP >R 0
?DO DUP 16 RECORD
16 +
STOP?
LOOP R> DUP
IF RECORD ELSE 2DROP THEN ;
: -ZEROS ( adr len -- adr len' )
DUP 0
?DO 2DUP + 1- C@-T ?LEAVE
1-
LOOP ;
: OK? KILL ENTER 10 MS
BEGIN SKEY?
WHILE SKEY ASCII > = IF EXIT THEN
REPEAT
1 ABORT" EVM off-line" ;
: HC05C8-DOWN ( -- )
OK? CR
" LOAD T" SEND
$20 $30 -ZEROS (DOWN)
$100 $1000 -ZEROS (DOWN)
$1FF4 $0C (DOWN)
S-EOF SEND
PROMPT ;
EVM DEFINITIONS
defer DOWN ' HC05C8-DOWN is DOWN
FORTH DEFINITIONS
\ ***************************************************************************
\ EVM debugging
: S" [COMPILE] " COMPILE STYPE ; IMMEDIATE
: PUT ( n -- )
SAVE> BASE
HEX (U.) STYPE
RESTORE> BASE ;
: GET ( -- n )
SKEY 16 DIGIT DROP 16 *
SKEY 16 DIGIT DROP + ;
: END ASCII . SEMIT ENTER ;
: REPLY ( char -- )
BEGIN SKEY 2DUP - WHILE EMIT REPEAT 2DROP ;
: ANSWER 10 WAIT
BEGIN 13 REPLY 10 WAIT
SKEY DUP '>' <>
WHILE CR EMIT
REPEAT DROP ;
\ ***************************************************************************
\ Read/Write Target Memory
: TC@ ( tadr -- c )
S" MM " PUT ENTER
ASCII = WAIT GET
PROMPT END PROMPT ;
: TC! ( c tadr -- )
S" MM " PUT ENTER
PROMPT PUT END PROMPT ;
: T@ ( tadr -- w )
S" MM " PUT ENTER
ASCII = WAIT GET 256 * PROMPT ENTER
ASCII = WAIT GET + PROMPT END
PROMPT ;
: T! ( w tadr -- )
S" MM " PUT ENTER
PROMPT SPLIT PUT ENTER
PROMPT PUT END
PROMPT ;
: TDUMP ( tadr len -- )
S" MD " OVER PUT
S" " 1- + PUT ENTER
CR ANSWER ;
: TASM ( adr #inst -- )
S" ASM " SWAP PUT ENTER 13 WAIT
1- 0 ?DO ASCII > REPLY ENTER LOOP
ASCII > REPLY END PROMPT ;
: T? TC@ . ;
\ ***************************************************************************
\ Registers
: RD S" RD" ENTER \ display registers
ASCII = WAIT ." S=" 13 REPLY
PROMPT ;
\ ***************************************************************************
\ Window Locations
\ Source Window
1 value srctop \ top row of source window
7 value srcbot \ bottom row of source window
0 value srcleft \ left margin of source window
75 value srcwidth \ width of source line (not including line #)
\ Disassembly Window
9 value distop \ top row of disassembly window
18 value disbot \ bottom row of disassembly window
1 value disleft \ left margin of disassembly window
53 value diswidth \ width of disassembly window
\ Command Window
disbot 2+ value cmdtop \ top row of command window
\ Register Window, 5 rows x 13 columns
9 value regrow \ upper-left row
55 value regcol \ upper-left column
\ Stack Window, 5 rows x 10 columns
9 value stkrow \ upper-left row
69 value stkcol \ upper-left column
\ Watch/Breakpoint Window, 4 rows
15 value watchrow \ upper-left row
55 value watchcol \ upper-left column
79 value watchend \ right column
: frame
savecursor cursor-off on> nosetcur
>norm \ black >bg yellow >fg
0 8 at ." ╔═════════════════════════════════════════════════════╦═════════════╦══════════╗"
0 9 at ." ║ ║ ║ ║"
0 10 at ." ║ ║ ║ ║"
0 11 at ." ║ ║ ║ ║"
0 12 at ." ║ ║ ║ ║"
0 13 at ." ║ ║ ║ ║"
0 14 at ." ║ ╠═════════════╩══════════╣"
0 15 at ." ║ ║ ║"
0 16 at ." ║ ║ ║"
0 17 at ." ║ ║ ║"
0 18 at ." ║ ║ ║"
0 19 at ." ╚═════════════════════════════════════════════════════╩════════════════════════╝"
off> nosetcur restcursor ;
\ ***************************************************************************
\ Color Scheme
: color ( bg fg -- ) \ define colors
create swap 16 * + ,
does> @ attrib c! ;
black yellow color %source
ltgray black color %source-rev
blue white color %dis
ltgray black color %dis-rev
green white color %register
brown white color %stack
ltgray blue color %watch
red white color %break
\ ***************************************************************************
\ GET/PUT REGISTER SET
EVM DEFINITIONS
0 value A
0 value X
0 value SP
0 value PC
0 value CC
0 value TSP targ-sp0 =: TSP \ Target stack pointer
FORTH DEFINITIONS
: .cc CC $10 and if ." H" else ." ." then
CC $08 and if ." I" else ." ." then
CC $04 and if ." N" else ." ." then
CC $02 and if ." Z" else ." ." then
CC $01 and if ." C" else ." ." then
space ;
: .REGS ." A=" A . ." X=" X . ." SP=" SP .
." PC=" PC . ." CC=" .cc ;
: regat ( n -- ) regcol swap regrow + at ;
: .rr ( n -- ) 4 .r 2 spaces ;
: show-regs
savecursor cursor-off on> nosetcur
%register
0 regat ." A = " A .rr
1 regat ." X = " X .rr
2 regat ." SP = " SP .rr
3 regat ." PC = " PC .rr
4 regat ." CC = " .cc
off> nosetcur restcursor ;
: ?tsp ( -- ) \ set TSP if X points to stack
X targ-stack targ-sp0 between if X =: TSP then ;
: (GET-REGS) ( -- )
ASCII = WAIT GET =: SP
ASCII = WAIT GET 256 * GET + =: PC
ASCII = WAIT GET =: A
ASCII = WAIT GET =: X ?tsp
ASCII = WAIT GET =: CC
PROMPT ;
: GET-REGS S" RD" ENTER
(GET-REGS) ;
: PUT-REGS ( -- )
S" RM" ENTER
PROMPT PC PUT ENTER
PROMPT A PUT ENTER
PROMPT X PUT ENTER
PROMPT CC PUT END
PROMPT ;
\ ***************************************************************************
\ Target stack
: tdepth ( -- n )
targ-sp0 TSP - ;
: show-stack ( -- ) \ show top 4 items of stack
savecursor cursor-off on> nosetcur
%stack
stkcol stkrow
targ-sp0 4 - tdepth 4 - 0max - ( first address )
4 bounds
do 2dup at
TSP i <=
if i tc@ 8 .r 2 spaces
else 10 spaces
then
1+
loop
at tdepth ?dup
if ." [" 0 .r ." ] "
else ." [Empty] "
then
off> nosetcur restcursor ;
: sp-check ( -- )
X targ-stack targ-sp0 between not
abort" stack pointer invalid " ;
: set-sp ( adr -- )
dup targ-stack targ-sp0 between not abort" invalid stack address"
dup =: X =: TSP put-regs ;
: T.S sp-check
X DUP targ-sp0 =
IF DROP ." Empty"
ELSE targ-sp0 1- DO I TC@ . -1 +LOOP
THEN ;
EVM DEFINITIONS
: CLR ( -- ) \ clear target stack
sp-check
targ-sp0 set-sp
show-stack ;
: PUSH ( n -- ) \ push n to target stack
sp-check
X 1- dup set-sp TC!
show-stack ;
: POP ( -- n ) \ pop target stack
sp-check
X dup 1+ set-sp TC@
show-stack ;
FORTH DEFINITIONS
\ ***************************************************************************
\ Display Source Code
0 value srcfirst \ first line in source window
0 value srclast \ first line below source window
: show-line ( line# -- )
[ editor ]
dup 4 .r space
1- 0MAX ( editor numbers from 0 )
#lineseginfo 2- srcwidth min
srcwidth over - >r typeL r> spaces ;
: .source ( line -- ) \ this will not work if file < 6 lines!
savecursor cursor-off on> nosetcur
%source
dup srcfirst srclast within
if drop srcfirst
else dup maxaddr find-line =
if srcbot - srctop + ( put me on last line )
else 1- 1 max ( put me on second line )
then
dup =: srcfirst
then
srcbot 1+ srctop
do srcleft i at
dup PC find-line = if %source-rev then
dup show-line %source
1+
loop
=: srclast
off> nosetcur restcursor ;
: show-source PC find-line .source ;
EVM DEFINITIONS
: L ( line# -- ) \ list source
dup =: srcfirst .source ;
FORTH DEFINITIONS
\ ***************************************************************************
\ Disassembly window
DISASSEMBLER
' c@-t is tc@
' @-t is t@
' find-sym is ?symbol
' .symbol alias .symbol \ so i can use it
FORTH
0 value disfirst \ address of first instruction in window
0 value dislast \ address of first instruction beyond window
: .1inst ( tadr -- tadr2 )
dup 5 u.r 2 spaces
dup find-sym
if 10 .id|n
then
disleft 19 + col inst
disleft diswidth + col ;
: .dis ( tadr -- )
savecursor cursor-off on> nosetcur
%dis
dup disfirst dislast within
if drop disfirst
else dup =: disfirst
then
disbot 1+ distop
do disleft i at
dup PC = if %dis-rev then
.1inst %dis
loop
=: dislast
off> nosetcur restcursor ;
: show-dis PC .dis ;
EVM DEFINITIONS
: U ( tadr -- ) \ Unassemble
dup =: disfirst .dis ;
FORTH DEFINITIONS
\ ***************************************************************************
\ Watch Variables
0 value watching \ true if displaying watch variables
CREATE WATCHES -1 , -1 , -1 , -1 ,
: .var ( tadr -- ) \ display target variable
dup find-sym if .id then
dup ." [" 0 .r ." ] = " t? ;
: show-watches ( -- )
savecursor cursor-off on> nosetcur
%watch
watchcol watchrow
watches 8 bounds
do i @ 1+
if 2dup at space
i @ .var
watchend col 1+
then
2 +loop
watchrow 4 + over
?do 2dup at watchend col 1+ loop
2drop
off> nosetcur restcursor ;
EVM DEFINITIONS
: .W ( -- ) \ set to display watch variables
on> watching
show-watches ;
: W ( tadr -- ) \ add watch variable
watches 8 bounds
do i @ 0<
if i !
.W
undo exit
then
2 +loop
drop ." too many watch variables" ;
: -W ( tadr -- ) \ remove watch variable
watches 8 bounds
do dup i @ =
if drop i on \ clear entry
.W
undo exit
then
2 +loop
drop ." watch variable not found" ;
: NW ( -- ) \ no watch variables
watches 8 $ff fill
.W ;
FORTH DEFINITIONS
\ ***************************************************************************
\ Breakpoints
create breaks 0 , 0 , 0 , 0 ,
: show-breaks ( -- )
savecursor cursor-off on> nosetcur
%break
watchcol watchrow
breaks 8 bounds
do i @
if 2dup at space
i @ .symbol
watchend col 1+
then
2 +loop
watchrow 4 + over
?do 2dup at watchend col 1+ loop
2drop
off> nosetcur restcursor ;
: put-breaks ( -- ) \ send breakpoints to EVM
breaks 8 0 scan nip ( any breakpoints? )
if s" BR"
breaks 8 bounds
do i @ ?dup
if s" " put
then
2 +loop
enter prompt
then ;
EVM DEFINITIONS
: .B ( -- ) \ set to show breakpoints
off> watching
show-breaks ;
: B ( tadr -- ) \ set breakpoint
breaks 8 bounds
do i @ 0=
if i !
.B
undo exit
then
2 +loop
drop ." too many breakpoints" ;
: -B ( tadr -- ) \ remove breakpoint
breaks 8 bounds
do dup i @ =
if drop i off
.B
undo exit
then
2 +loop
drop ." breakpoint not found" ;
: NB ( -- ) \ no breakpoints
breaks 8 erase
.B ;
FORTH DEFINITIONS
\ ***************************************************************************
\ Display debugging screen
: show
show-source
show-dis
show-regs
show-stack
watching if show-watches then ;
: scr 0 cmdtop at -line
0 rows 1- at ;
: auto ['] scr is cr ;
EVM DEFINITIONS
: D \ refresh display
ok? \ make sure EVM is alive
( statoff ) vocoff get-regs
dark frame show ;
: TOP ( -- ) \ Put current PC at top of window
off> srcfirst show-source
off> disfirst show-dis ;
\ Modify registers ( can't change SP )
: =A ( n -- ) =: A put-regs show-regs ;
: =X ( n -- ) =: X ?tsp put-regs show ;
: =CC ( n -- ) =: CC put-regs show-regs ;
: =PC ( n -- ) =: PC put-regs show ;
FORTH DEFINITIONS
\ ***************************************************************************
\ Execution Control
: receive-trap ( -- )
(get-regs) \ wait till EVM hits the next breakpoint
\ at which time it sends the registers
s" NOBR" enter prompt ; \ remove any breakpoints
: gofromtrap ( -- )
\ put-regs \ put (modified) values back into target
s" G" enter ; \ excute from current pc
: exec>trap ( -- ) \ execute until breakpoint
gofromtrap
receive-trap ;
: skip? ( -- adr t | f ) \ if next instruction is a call,
\ return skip-to address and true.
PC C@-T
DUP 173 ( BSR ) = IF DROP PC 2 + TRUE EXIT THEN
205 ( JSR ) = IF PC 3 + TRUE EXIT THEN
FALSE ;
EVM DEFINITIONS
: G ( -- ) \ execute from current pc (go)
put-breaks
exec>trap
show ;
: T ( -- ) \ Trace (single step)
\ put-regs
s" T" enter
(get-regs) show ;
: GOTO ( adr -- ) \ execute till address, redisplay.
s" BR " put enter prompt
exec>trap show ;
: S ( -- ) \ single step
skip? if GOTO else T then ;
: STEPS ( n -- ) \ multiple steps, no display update
\ put-regs
0
?do skip?
if s" BR " put enter prompt
exec>trap prompt
else s" T" enter prompt
then
loop
get-regs show ;
: RET ( -- ) \ goto end of subroutine
SP $FF = abort" no subroutine has been called"
SP 1+ T@ GOTO ;
: E ( tadr -- ) \ EXECUTE SUBROUTINE
PC DUP ROT
S" MM 1E00" ENTER PROMPT
$CD PUT ENTER PROMPT \ JSR
SPLIT PUT ENTER PROMPT \ tadr HI
PUT ENTER PROMPT \ tadr LO
$CC PUT ENTER PROMPT \ JMP
SPLIT PUT ENTER PROMPT \ current PC HI
PUT END PROMPT \ current PC LO
$1E00 =: PC
put-regs GOTO ;
: RESET ( -- ) \ go to reset address
$1FFE @-T DUP ( reset address )
S" MM 1E00" ENTER PROMPT
$9B PUT ENTER PROMPT \ SEI
$9C PUT ENTER PROMPT \ RSP
$CC PUT ENTER PROMPT \ JMP
SPLIT PUT ENTER PROMPT \ ADR HI
PUT END PROMPT \ ADR LO
0 =: A 0 =: X targ-sp0 =: TSP 0 =: CC
$1E00 =: PC put-regs GOTO ;
\ change memory words
: @ tc@ ;
: ! tc! ;
: dump tdump ;
: ? t? ;
FORTH DEFINITIONS
: start only forth also symbol also evm definitions
read down reset
auto d ;
: evminit ( --- )
defers initstuff
sinit 9600 baud serial-on ;
: evmHELLO ( --- )
SP0 @ 'TIB !
>IN OFF
SPAN OFF
#TIB OFF
LOADING OFF
\u NOSETCUR NOSETCUR OFF
ONLY FORTH ALSO DEFINITIONS
DEFAULTSTATE
DEFAULT
>in @ bl word swap >in ! c@ 0=
if .hello
.curfile
then OPEN-PRN interpret ; \ *** 12/18/90 AM
' evminit is initstuff
' serial-off is byefunc
fsave evm.exe
\ ***************************************************************************
\ Target Interpreter
comment:
: TARG ( -- )
BEGIN BL WORD ?UPPERCASE DUP C@
WHILE DUP ['] SYMBOL >BODY HASH @ (FIND)
IF EXECUTE DUP 256 <
IF PUSH
ELSE E
THEN
ELSE NUMBER DROP PUSH
THEN
REPEAT DROP ;
comment;