1\ 7.6 Client Program Debugging command group 2 3\ Saved program state context 4variable __context 50 __context ! 6 7: saved-context __context @ @ ; 8 9 10\ 7.6.1 Registers display 11 12: ctrace ( -- ) 13 ; 14 15: .registers ( -- ) 16 ; 17 18: .fregisters ( -- ) 19 ; 20 21\ to ( param [old-name< >] -- ) 22 23 24\ 7.6.2 Program download and execute 25 26struct ( load-state ) 27 /n field >ls.entry 28 /n field >ls.file-size 29 /n field >ls.file-type 30 /n field >ls.param 31constant load-state.size 32create load-state load-state.size allot 33 34variable state-valid 350 state-valid ! 36 37variable file-size 38 39: !load-size file-size ! ; 40 41: load-size file-size @ ; 42 43 44\ File types identified by (load-state) 450 constant elf-boot 461 constant elf 472 constant bootinfo 483 constant xcoff 494 constant pe 505 constant aout 5110 constant fcode 5211 constant forth 5312 constant bootcode 5413 constant prep 55 56 57: init-program ( -- ) 58 \ Call down to the lower level for relocation etc. 59 s" (init-program)" $find if 60 execute 61 else 62 s" Unable to locate (init-program)!" type cr 63 then 64 ; 65 66: (find-bootdevice) ( param-str param-len -- bootpath-str bootpath-len) 67 \ Parse the <param> string which is a space-separated list of one or 68 \ more potential boot devices, and return the first one that can be 69 \ successfully opened. 70 71 \ Space-separated bootpath string 72 bl left-split \ bootpathstr bootpathstr-len bootdevstr bootdevstr-len 73 dup 0= if 74 75 \ None specified. As per IEEE-1275 specification, search through each value 76 \ in boot-device and use the first that returns a valid ihandle on open. 77 78 2drop \ drop the empty device string as we're going to use our own 79 80 s" boot-device" $find drop execute 81 bl left-split 82 begin 83 dup 84 while 85 2dup s" Trying " type type s" ..." type cr 86 2dup open-dev ?dup if 87 close-dev 88 2swap drop 0 \ Fake end of string so we exit loop 89 else 90 2drop 91 bl left-split 92 then 93 repeat 94 2drop 95 then 96 97 \ bootargs 98 2swap dup 0= if 99 \ None specified, use default from nvram 100 2drop s" boot-file" $find drop execute 101 then 102 103 \ Set the bootargs property 104 encode-string 105 " /chosen" (find-dev) if 106 " bootargs" rot (property) 107 then 108; 109 110\ Locate the boot-device opened by this ihandle (currently taken as being 111\ the first non-interposed package in the instance chain) 112 113: ihandle>boot-device-handle ( ihandle -- 0 | device-ihandle -1 ) 114 >r 0 115 begin r> dup >in.my-parent @ dup >r while 116 ( result ihandle R: ihandle.parent ) 117 dup >in.interposed @ 0= if 118 \ Find the first non-interposed package 119 over 0= if 120 swap drop 121 else 122 drop 123 then 124 else 125 drop 126 then 127 repeat 128 r> drop drop 129 130 dup 0<> if 131 -1 132 then 133; 134 135: $load ( devstr len ) 136 open-dev ( ihandle ) 137 dup 0= if 138 drop 139 exit 140 then 141 dup >r 142 " load-base" evaluate swap ( load-base ihandle ) 143 dup ihandle>phandle " load" rot find-method ( xt 0|1 ) 144 if swap call-package !load-size else cr ." Cannot find load for this package" 2drop then 145 146 \ If the boot device path doesn't contain an explicit partition id, e.g. cd:,\\:tbxi 147 \ then the interposed partition package may have auto-probed a suitable partition. If 148 \ this is the case then it will have set the " selected-partition-args" property in 149 \ the partition package to contain the new device arguments. 150 \ 151 \ In order to ensure that bootpath contains the partition argument, we use the contents 152 \ of this property if it exists to override the boot device arguments when generating 153 \ the full bootpath using get-instance-path. 154 155 my-self 156 r@ to my-self 157 " selected-partition-args" get-inherited-property 0= if 158 decode-string 2swap 2drop 159 ( myself-save partargs-str partargs-len ) 160 r@ ihandle>boot-device-handle if 161 ( myself-save partargs-str partargs-len block-ihandle ) 162 \ Override the arguments before get-instance-path 163 dup >in.arguments 2@ >r >r dup >r ( R: block-ihandle arg-len arg-str ) 164 >in.arguments 2! ( myself-save ) 165 r@ " get-instance-path" $find if 166 execute ( myself-save bootpathstr bootpathlen ) 167 then 168 \ Now write the original arguments back 169 r> r> r> rot >in.arguments 2! ( myself-save bootpathstr bootpathlen R: ) 170 rot ( bootpathstr bootpathlen myself-save ) 171 then 172 else 173 my-self " get-instance-path" $find if 174 execute ( myself-save bootpathstr pathlen ) 175 rot ( bootpathstr bootpathlen myself-save ) 176 then 177 then 178 to my-self 179 180 \ Set bootpath property in /chosen 181 encode-string " /chosen" (find-dev) if 182 " bootpath" rot (property) 183 then 184 185 r> close-dev 186 init-program 187 ; 188 189: load ( "{params}<cr>" -- ) 190 linefeed parse 191 (find-bootdevice) 192 $load 193; 194 195: dir ( "{paths}<cr>" -- ) 196 linefeed parse 197 ascii , split-after 198 2dup open-dev dup 0= if 199 drop 200 cr ." Unable to locate device " type 201 2drop 202 exit 203 then 204 -rot 2drop -rot 2 pick 205 " dir" rot ['] $call-method catch 206 if 207 3drop 208 cr ." Cannot find dir for this package" 209 then 210 close-dev 211; 212 213: go ( -- ) 214 state-valid @ 0= if 215 s" No valid state has been set by load or init-program" type cr 216 exit 217 then 218 219 \ Call any architecture-specific code 220 s" (arch-go)" $find if 221 execute 222 else 223 2drop 224 then 225 226 \ go 227 s" (go)" $find if 228 execute 229 then 230 ; 231 232 233\ 7.6.3 Abort and resume 234 235\ already defined !? 236\ : go ( -- ) 237\ ; 238 239 240\ 7.6.4 Disassembler 241 242: dis ( addr -- ) 243 ; 244 245: +dis ( -- ) 246 ; 247 248\ 7.6.5 Breakpoints 249: .bp ( -- ) 250 ; 251 252: +bp ( addr -- ) 253 ; 254 255: -bp ( addr -- ) 256 ; 257 258: --bp ( -- ) 259 ; 260 261: bpoff ( -- ) 262 ; 263 264: step ( -- ) 265 ; 266 267: steps ( n -- ) 268 ; 269 270: hop ( -- ) 271 ; 272 273: hops ( n -- ) 274 ; 275 276\ already defined 277\ : go ( -- ) 278\ ; 279 280: gos ( n -- ) 281 ; 282 283: till ( addr -- ) 284 ; 285 286: return ( -- ) 287 ; 288 289: .breakpoint ( -- ) 290 ; 291 292: .step ( -- ) 293 ; 294 295: .instruction ( -- ) 296 ; 297 298 299\ 7.6.6 Symbolic debugging 300: .adr ( addr -- ) 301 ; 302 303: sym ( "name< >" -- n ) 304 ; 305 306: sym>value ( addr len -- addr len false | n true ) 307 ; 308 309: value>sym ( n1 -- n1 false | n2 addr len true ) 310 ; 311