Add submodule dependency filesHEADmaster

Change-Id: Iaf8d18082d3991dec7c0ebbea540f092188eb4ec

1 files changed, 310 insertions, 0 deletions

diff --git a/roms/openbios/forth/debugging/client.fs b/roms/openbios/forth/debugging/client.fs
new file mode 100644
index 000000000..5ee600320
--- /dev/null
+++ b/roms/openbios/forth/debugging/client.fs
@@ -0,0 +1,310 @@
+\ 7.6 Client Program Debugging command group
+
+\ Saved program state context
+variable __context
+0 __context !
+
+: saved-context __context @ @ ;
+
+
+\ 7.6.1    Registers display
+
+: ctrace    ( -- )
+  ;
+  
+: .registers    ( -- )
+  ;
+
+: .fregisters    ( -- )
+  ;
+
+\ to    ( param [old-name< >] -- )
+
+
+\ 7.6.2    Program download and execute
+
+struct ( load-state )
+  /n field >ls.entry
+  /n field >ls.file-size
+  /n field >ls.file-type
+  /n field >ls.param
+constant load-state.size
+create load-state load-state.size allot
+
+variable state-valid
+0 state-valid !
+
+variable file-size
+
+: !load-size file-size ! ;
+
+: load-size file-size @ ;
+
+
+\ File types identified by (load-state)
+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
+13 constant prep
+
+
+: 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 @ 0= if
+    s" No valid state has been set by load or init-program" type cr
+    exit 
+  then
+
+  \ Call any architecture-specific code
+  s" (arch-go)" $find if
+    execute
+  else
+    2drop
+  then  
+
+  \ go
+  s" (go)" $find if
+    execute
+  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 )
+  ;