--- /dev/null
+\ 7.6 Client Program Debugging command group
+
+
+\ 7.6.1 Registers display
+
+: ctrace ( -- )
+ ;
+
+: .registers ( -- )
+ ;
+
+: .fregisters ( -- )
+ ;
+
+\ to ( param [old-name< >] -- )
+
+
+\ 7.6.2 Program download and execute
+
+struct ( saved-program-state )
+ /n field >sps.entry
+ /n field >sps.file-size
+ /n field >sps.file-type
+constant saved-program-state.size
+create saved-program-state saved-program-state.size allot
+
+variable state-valid
+0 state-valid !
+
+variable file-size
+
+: !load-size file-size ! ;
+
+: load-size file-size @ ;
+
+
+\ File types identified by (init-program)
+
+0 constant elf-boot
+1 constant elf
+2 constant bootinfo
+3 constant xcoff
+4 constant pe
+5 constant aout
+10 constant fcode
+11 constant forth
+12 constant bootcode
+
+
+: init-program ( -- )
+ \ Call down to the lower level for relocation etc.
+ s" (init-program)" $find if
+ execute
+ else
+ s" Unable to locate (init-program)!" type cr
+ then
+ ;
+
+: (find-bootdevice) ( param-str param-len -- bootpath-str bootpath-len)
+ \ Parse the <param> string which is a space-separated list of one or
+ \ more potential boot devices, and return the first one that can be
+ \ successfully opened.
+
+ \ Space-separated bootpath string
+ bl left-split \ bootpathstr bootpathstr-len bootdevstr bootdevstr-len
+ dup 0= if
+
+ \ None specified. As per IEEE-1275 specification, search through each value
+ \ in boot-device and use the first that returns a valid ihandle on open.
+
+ 2drop \ drop the empty device string as we're going to use our own
+
+ s" boot-device" $find drop execute
+ bl left-split
+ begin
+ dup
+ while
+ 2dup s" Trying " type type s" ..." type cr
+ 2dup open-dev ?dup if
+ close-dev
+ 2swap drop 0 \ Fake end of string so we exit loop
+ else
+ 2drop
+ bl left-split
+ then
+ repeat
+ 2drop
+ then
+
+ \ bootargs
+ 2swap dup 0= if
+ \ None specified, use default from nvram
+ 2drop s" boot-file" $find drop execute
+ then
+
+ \ Set the bootargs property
+ encode-string
+ " /chosen" (find-dev) if
+ " bootargs" rot (property)
+ then
+;
+
+\ Locate the boot-device opened by this ihandle (currently taken as being
+\ the first non-interposed package in the instance chain)
+
+: ihandle>boot-device-handle ( ihandle -- 0 | device-ihandle -1 )
+ >r 0
+ begin r> dup >in.my-parent @ dup >r while
+ ( result ihandle R: ihandle.parent )
+ dup >in.interposed @ 0= if
+ \ Find the first non-interposed package
+ over 0= if
+ swap drop
+ else
+ drop
+ then
+ else
+ drop
+ then
+ repeat
+ r> drop drop
+
+ dup 0<> if
+ -1
+ then
+;
+
+: $load ( devstr len )
+ open-dev ( ihandle )
+ dup 0= if
+ drop
+ exit
+ then
+ dup >r
+ " load-base" evaluate swap ( load-base ihandle )
+ dup ihandle>phandle " load" rot find-method ( xt 0|1 )
+ if swap call-package !load-size else cr ." Cannot find load for this package" 2drop then
+
+ \ If the boot device path doesn't contain an explicit partition id, e.g. cd:,\\:tbxi
+ \ then the interposed partition package may have auto-probed a suitable partition. If
+ \ this is the case then it will have set the " selected-partition-args" property in
+ \ the partition package to contain the new device arguments.
+ \
+ \ In order to ensure that bootpath contains the partition argument, we use the contents
+ \ of this property if it exists to override the boot device arguments when generating
+ \ the full bootpath using get-instance-path.
+
+ my-self
+ r@ to my-self
+ " selected-partition-args" get-inherited-property 0= if
+ decode-string 2swap 2drop
+ ( myself-save partargs-str partargs-len )
+ r@ ihandle>boot-device-handle if
+ ( myself-save partargs-str partargs-len block-ihandle )
+ \ Override the arguments before get-instance-path
+ dup >in.arguments 2@ >r >r dup >r ( R: block-ihandle arg-len arg-str )
+ >in.arguments 2! ( myself-save )
+ r@ " get-instance-path" $find if
+ execute ( myself-save bootpathstr bootpathlen )
+ then
+ \ Now write the original arguments back
+ r> r> r> rot >in.arguments 2! ( myself-save bootpathstr bootpathlen R: )
+ rot ( bootpathstr bootpathlen myself-save )
+ then
+ else
+ my-self " get-instance-path" $find if
+ execute ( myself-save bootpathstr pathlen )
+ rot ( bootpathstr bootpathlen myself-save )
+ then
+ then
+ to my-self
+
+ \ Set bootpath property in /chosen
+ encode-string " /chosen" (find-dev) if
+ " bootpath" rot (property)
+ then
+
+ r> close-dev
+ init-program
+ ;
+
+: load ( "{params}<cr>" -- )
+ linefeed parse
+ (find-bootdevice)
+ $load
+;
+
+: dir ( "{paths}<cr>" -- )
+ linefeed parse
+ ascii , split-after
+ 2dup open-dev dup 0= if
+ drop
+ cr ." Unable to locate device " type
+ 2drop
+ exit
+ then
+ -rot 2drop -rot 2 pick
+ " dir" rot ['] $call-method catch
+ if
+ 3drop
+ cr ." Cannot find dir for this package"
+ then
+ close-dev
+;
+
+: go ( -- )
+ state-valid @ not if
+ s" No valid state has been set by load or init-program" type cr
+ exit
+ then
+
+ \ Call the architecture-specific code to launch the client image
+ s" (go)" $find if
+ execute
+ else
+ ." go is not yet implemented"
+ 2drop
+ then
+ ;
+
+
+\ 7.6.3 Abort and resume
+
+\ already defined !?
+\ : go ( -- )
+\ ;
+
+
+\ 7.6.4 Disassembler
+
+: dis ( addr -- )
+ ;
+
+: +dis ( -- )
+ ;
+
+\ 7.6.5 Breakpoints
+: .bp ( -- )
+ ;
+
+: +bp ( addr -- )
+ ;
+
+: -bp ( addr -- )
+ ;
+
+: --bp ( -- )
+ ;
+
+: bpoff ( -- )
+ ;
+
+: step ( -- )
+ ;
+
+: steps ( n -- )
+ ;
+
+: hop ( -- )
+ ;
+
+: hops ( n -- )
+ ;
+
+\ already defined
+\ : go ( -- )
+\ ;
+
+: gos ( n -- )
+ ;
+
+: till ( addr -- )
+ ;
+
+: return ( -- )
+ ;
+
+: .breakpoint ( -- )
+ ;
+
+: .step ( -- )
+ ;
+
+: .instruction ( -- )
+ ;
+
+
+\ 7.6.6 Symbolic debugging
+: .adr ( addr -- )
+ ;
+
+: sym ( "name< >" -- n )
+ ;
+
+: sym>value ( addr len -- addr len false | n true )
+ ;
+
+: value>sym ( n1 -- n1 false | n2 addr len true )
+ ;
Code Review / kvmfornfv.git / blobdiff