Return to client.fs CVS log

Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / debugging

Annotation of qemu/roms/openbios/forth/debugging/client.fs, revision 1.1

1.1     ! root        1: \ 7.6 Client Program Debugging command group
        !             2: 
        !             3: 
        !             4: \ 7.6.1    Registers display
        !             5: 
        !             6: : ctrace    ( -- )
        !             7:   ;
        !             8:   
        !             9: : .registers    ( -- )
        !            10:   ;
        !            11: 
        !            12: : .fregisters    ( -- )
        !            13:   ;
        !            14: 
        !            15: \ to    ( param [old-name< >] -- )
        !            16: 
        !            17: 
        !            18: \ 7.6.2    Program download and execute
        !            19: 
        !            20: struct ( saved-program-state )
        !            21:   /n field >sps.entry
        !            22:   /n field >sps.file-size
        !            23:   /n field >sps.file-type
        !            24: constant saved-program-state.size
        !            25: create saved-program-state saved-program-state.size allot
        !            26: 
        !            27: variable state-valid
        !            28: 0 state-valid !
        !            29: 
        !            30: variable file-size
        !            31: 
        !            32: : !load-size file-size ! ;
        !            33: 
        !            34: : load-size file-size @ ;
        !            35: 
        !            36: 
        !            37: \ File types identified by (init-program)
        !            38: 
        !            39: 0  constant elf-boot
        !            40: 1  constant elf
        !            41: 2  constant bootinfo
        !            42: 3  constant xcoff
        !            43: 4  constant pe
        !            44: 5  constant aout
        !            45: 10 constant fcode
        !            46: 11 constant forth
        !            47: 
        !            48: 
        !            49: : init-program    ( -- )
        !            50:   \ Call down to the lower level for relocation etc.
        !            51:   s" (init-program)" $find if
        !            52:     execute
        !            53:   else
        !            54:     s" Unable to locate (init-program)!" type cr
        !            55:   then
        !            56:   ;
        !            57: 
        !            58: : (encode-bootpath) ( param-str param-len -- bootpath-str bootpath-len)
        !            59:   \ Parse the <param> string from a load/boot command and set both
        !            60:   \ the bootargs and bootpath properties as appropriate.
        !            61: 
        !            62:   \ bootpath
        !            63:   bl left-split        \ argstr argstr-len bootdevstr bootdevstr-len
        !            64:   dup 0= if
        !            65: 
        !            66:     \ None specified. As per IEEE-1275 specification, search through each value
        !            67:     \ in boot-device and use the first that returns a valid ihandle on open.
        !            68: 
        !            69:     2drop              \ drop the empty device string as we're going to use our own
        !            70: 
        !            71:     s" boot-device" $find drop execute 
        !            72:     bl left-split
        !            73:     begin 
        !            74:       dup 
        !            75:     while
        !            76:       2dup s" Trying " type type s" ..." type cr
        !            77:       2dup open-dev ?dup if
        !            78:         close-dev
        !            79:        2swap drop 0    \ Fake end of string so we exit loop
        !            80:       else
        !            81:         2drop
        !            82:         bl left-split
        !            83:       then
        !            84:     repeat
        !            85:     2drop
        !            86:   then
        !            87: 
        !            88:   \ Set the bootpath property
        !            89:   2dup encode-string
        !            90:   " /chosen" (find-dev) if
        !            91:     " bootpath" rot (property)
        !            92:   then
        !            93: 
        !            94:   \ bootargs
        !            95:   2swap dup 0= if
        !            96:     \ None specified, use default from nvram
        !            97:     2drop s" boot-file" $find drop execute
        !            98:   then
        !            99: 
        !           100:   \ Set the bootargs property
        !           101:   encode-string
        !           102:   " /chosen" (find-dev) if
        !           103:     " bootargs" rot (property)
        !           104:   then
        !           105: ;
        !           106: 
        !           107: : $load ( devstr len )
        !           108:   open-dev ( ihandle )
        !           109:   dup 0= if
        !           110:     drop
        !           111:     exit
        !           112:   then
        !           113:   dup >r
        !           114:   " load-base" evaluate swap ( load-base ihandle )
        !           115:   dup ihandle>phandle " load" rot find-method ( xt 0|1 )
        !           116:   if swap call-package !load-size else cr ." Cannot find load for this package" 2drop then
        !           117:   r> close-dev
        !           118:   init-program
        !           119:   ;
        !           120: 
        !           121: : load    ( "{params}<cr>" -- )
        !           122:   linefeed parse
        !           123:   (encode-bootpath)
        !           124:   $load
        !           125: ;
        !           126: 
        !           127: : dir ( "{paths}<cr>" -- )
        !           128:   linefeed parse
        !           129:   split-path-device
        !           130:   open-dev dup 0= if
        !           131:     drop
        !           132:     exit
        !           133:   then
        !           134:   -rot 2 pick
        !           135:   " dir" rot ['] $call-method catch
        !           136:   if
        !           137:     3drop
        !           138:     cr ." Cannot find dir for this package"
        !           139:   then
        !           140:   close-dev
        !           141: ;
        !           142: 
        !           143: : go    ( -- )
        !           144:   state-valid @ not if
        !           145:     s" No valid state has been set by load or init-program" type cr
        !           146:     exit 
        !           147:   then
        !           148: 
        !           149:   \ Call the architecture-specific code to launch the client image
        !           150:   s" (go)" $find if
        !           151:     execute
        !           152:   else
        !           153:     ." go is not yet implemented"
        !           154:     2drop
        !           155:   then
        !           156:   ;
        !           157: 
        !           158: 
        !           159: \ 7.6.3    Abort and resume
        !           160: 
        !           161: \ already defined !?
        !           162: \ : go    ( -- )
        !           163: \   ;
        !           164: 
        !           165:   
        !           166: \ 7.6.4    Disassembler
        !           167: 
        !           168: : dis    ( addr -- )
        !           169:   ;
        !           170:   
        !           171: : +dis    ( -- )
        !           172:   ;
        !           173: 
        !           174: \ 7.6.5    Breakpoints
        !           175: : .bp    ( -- )
        !           176:   ;
        !           177: 
        !           178: : +bp    ( addr -- )
        !           179:   ;
        !           180: 
        !           181: : -bp    ( addr -- )
        !           182:   ;
        !           183: 
        !           184: : --bp    ( -- )
        !           185:   ;
        !           186: 
        !           187: : bpoff    ( -- )
        !           188:   ;
        !           189: 
        !           190: : step    ( -- )
        !           191:   ;
        !           192: 
        !           193: : steps    ( n -- )
        !           194:   ;
        !           195: 
        !           196: : hop    ( -- )
        !           197:   ;
        !           198: 
        !           199: : hops    ( n -- )
        !           200:   ;
        !           201: 
        !           202: \ already defined
        !           203: \ : go    ( -- )
        !           204: \   ;
        !           205: 
        !           206: : gos    ( n -- )
        !           207:   ;
        !           208: 
        !           209: : till    ( addr -- )
        !           210:   ;
        !           211: 
        !           212: : return    ( -- )
        !           213:   ;
        !           214: 
        !           215: : .breakpoint    ( -- )
        !           216:   ;
        !           217: 
        !           218: : .step    ( -- )
        !           219:   ;
        !           220: 
        !           221: : .instruction    ( -- )
        !           222:   ;
        !           223: 
        !           224: 
        !           225: \ 7.6.6    Symbolic debugging
        !           226: : .adr    ( addr -- )
        !           227:   ;
        !           228: 
        !           229: : sym    ( "name< >" -- n )
        !           230:   ;
        !           231: 
        !           232: : sym>value    ( addr len -- addr len false | n true )
        !           233:   ;
        !           234: 
        !           235: : value>sym    ( n1 -- n1 false | n2 addr len true )
        !           236:   ;

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.