![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to client.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / debugging|
Return to client.fs CVS log | Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / debugging |
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.