openfirmware

openfirmware@openfirmware.info

3007 discussions

[commit] r2913 - forth/lib ofw/core
by repository service 22 Mar '12

22 Mar '12

Author: wmb Date: Thu Mar 22 01:21:57 2012 New Revision: 2913 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2913 Log: Debugger - improved the "up" command so it will skip past the method call machinery to find the caller that the user cares about. Modified: forth/lib/debug.fth forth/lib/rstrace.fth ofw/core/ofwcore.fth Modified: forth/lib/debug.fth ============================================================================== --- forth/lib/debug.fth Wed Mar 21 23:25:54 2012 (r2912) +++ forth/lib/debug.fth Thu Mar 22 01:21:57 2012 (r2913) @@ -75,26 +75,28 @@ ; bug definitions headerless -\ Go up the return stack until we find the return address left by our caller -: caller-ip ( rp -- ip ) - begin - na1+ dup @ dup in-dictionary? if ( rs-adr ip ) - ip>token token@ - dup ['] execute = over defer? or swap <ip @ body> = or - else - drop false - then - until ( rs-adr ) - @ ip>token -; +\ Go up the return stack until we find an interesting caller : up1 ( rp -- ) - caller-ip - dup find-cfa ( ip cfa ) - dup ['] catch = if 2drop exit then - cr ." [ Up to " dup .name ." ]" cr ( ip cfa ) - over token@ .name ( ip cfa ) - >body swap 'unnest (debug) + begin na1+ dup rp0 @ <> while ( rs-adr ) + dup @ ( rs-adr ip ) + dup in-dictionary? if ( rs-adr ip ) + find-cfa dup indirect-call? if ( rs-adr xt ) + drop ( rs-adr ) + else ( rs-adr xt ) + nip ( rs-adr ) + scrolling-debug? if ( xt ) + cr ." [ Up to " dup .name ." ]" cr + then ( xt ) + (debug ( ) + exit ( -- ) + then ( rs-adr ) + else ( rs-adr ip ) + drop ( rs-adr ) + then ( rs-adr ) + repeat ( rs-adr ) + drop ( ) ; + defer to-debug-window ' noop is to-debug-window defer restore-window ' noop is restore-window : .debug-short-help ( -- ) @@ -183,19 +185,12 @@ d# 78 rmargin ! .debug-short-help ." Callers: " rp0 @ the-rp na1+ rslist kill-line cr - \ XXX the following is wrong when popping up - the-ip <ip @ = if - #line @ is stack-line \ So the initial stack is displayed in the right place - then d# 40 rmargin ! the-ip debug-see cr - \ When popping up from an interior word, display the initial stack on - \ the line where the cursor will be. - the-ip <ip @ <> if - the-ip ip>position if ( col row ) - drop is stack-line ( ) - then + \ Display the initial stack on the cursor line + the-ip ip>position 0= if ( col row ) + is stack-line drop ( ) then ; : setup-debug-display ( -- ) Modified: forth/lib/rstrace.fth ============================================================================== --- forth/lib/rstrace.fth Wed Mar 21 23:25:54 2012 (r2912) +++ forth/lib/rstrace.fth Thu Mar 22 01:21:57 2012 (r2913) @@ -103,9 +103,9 @@ \ boring? is a hook for Open Firmware. It recognizes words like \ $call-method that are essentially indirect calls. Such words \ just clutter up the stack display and should be elided for clarity. -defer boring? -: (boring?) ( ip -- flag ) drop false ; -' (boring?) is boring? +defer indirect-call? +: (indirect-call?) ( xt -- flag ) ['] catch = ; +' (indirect-call?) is indirect-call? : rtraceword ( rs-end rs-adr -- rs-end rs-adr' ) @+ ( rs-end rs-adr' ip ) @@ -120,7 +120,7 @@ find-cfa ( rs-end rs-adr xt ) - dup boring? if ( rs-end rs-adr xt ) + dup indirect-call? if ( rs-end rs-adr xt ) drop exit ( -- rs-end rs-adr ) then ( rs-end rs-adr xt ) Modified: ofw/core/ofwcore.fth ============================================================================== --- ofw/core/ofwcore.fth Wed Mar 21 23:25:54 2012 (r2912) +++ ofw/core/ofwcore.fth Thu Mar 22 01:21:57 2012 (r2913) @@ -4772,20 +4772,21 @@ [then] also hidden -: method-call? ( ip -- flag ) - dup ['] $call-self = if drop true exit then ( ip ) - dup ['] $call-method = if drop true exit then ( ip ) - dup ['] $call-parent = if drop true exit then ( ip ) - dup ['] call-package = if drop true exit then ( ip ) - dup ['] $vexecute = if drop true exit then ( ip ) - dup ['] $vexecute? = if drop true exit then ( ip ) - dup ['] $package-execute? = if drop true exit then ( ip ) - dup ['] package-execute = if drop true exit then ( ip ) - dup ['] apply-method = if drop true exit then ( ip ) - dup ['] (apply-method) = if drop true exit then ( ip ) - dup ['] (execute-method) = if drop true exit then ( ip ) - dup ['] execute-device-method = if drop true exit then ( ip ) +: method-call? ( xt -- flag ) + dup (indirect-call?) if drop true exit then ( xt ) + dup ['] $call-self = if drop true exit then ( xt ) + dup ['] $call-method = if drop true exit then ( xt ) + dup ['] $call-parent = if drop true exit then ( xt ) + dup ['] call-package = if drop true exit then ( xt ) + dup ['] $vexecute = if drop true exit then ( xt ) + dup ['] $vexecute? = if drop true exit then ( xt ) + dup ['] $package-execute? = if drop true exit then ( xt ) + dup ['] package-execute = if drop true exit then ( xt ) + dup ['] apply-method = if drop true exit then ( xt ) + dup ['] (apply-method) = if drop true exit then ( xt ) + dup ['] (execute-method) = if drop true exit then ( xt ) + dup ['] execute-device-method = if drop true exit then ( xt ) drop false ; -' method-call? to boring? +' method-call? to indirect-call? previous

1 0

[commit] r2912 - forth/lib
by repository service 21 Mar '12

21 Mar '12

Author: wmb Date: Wed Mar 21 23:25:54 2012 New Revision: 2912 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2912 Log: ## Lines starting with '## ' will be removed from the log message. ## File(s) to commit recursively: ## forth/lib/decomp.fth Decompiler - fixed oops in last checkin (indentation for "loop") Modified: forth/lib/decomp.fth Modified: forth/lib/decomp.fth ============================================================================== --- forth/lib/decomp.fth Wed Mar 21 23:16:33 2012 (r2911) +++ forth/lib/decomp.fth Wed Mar 21 23:25:54 2012 (r2912) @@ -309,7 +309,7 @@ : .do ( ip -- ip' ) .." do " +indent +branch ; : .?do ( ip -- ip' ) .." ?do " +indent +branch ; -: .loop ( ip -- ip' ) .." loop " cr +branch ; +: .loop ( ip -- ip' ) -indent .." loop " cr +branch ; : .+loop ( ip -- ip' ) -indent .." +loop " cr +branch ; : .of ( ip -- ip' ) .." of " +branch ; : .$of ( ip -- ip' ) .." $of " +branch ;

1 0

[commit] r2911 - forth/lib
by repository service 21 Mar '12

21 Mar '12

Author: wmb Date: Wed Mar 21 23:16:33 2012 New Revision: 2911 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2911 Log: rstrace - set the default value for boring? so the debugger works before OFW is loaded. Modified: forth/lib/rstrace.fth Modified: forth/lib/rstrace.fth ============================================================================== --- forth/lib/rstrace.fth Wed Mar 21 23:15:39 2012 (r2910) +++ forth/lib/rstrace.fth Wed Mar 21 23:16:33 2012 (r2911) @@ -99,8 +99,14 @@ then ( rs-adr n ) drop ( rs-adr ) ; + +\ boring? is a hook for Open Firmware. It recognizes words like +\ $call-method that are essentially indirect calls. Such words +\ just clutter up the stack display and should be elided for clarity. defer boring? : (boring?) ( ip -- flag ) drop false ; +' (boring?) is boring? + : rtraceword ( rs-end rs-adr -- rs-end rs-adr' ) @+ ( rs-end rs-adr' ip ) dup reasonable-ip? 0= if ( rs-end rs-adr ip )

1 0

[commit] r2910 - forth/lib
by repository service 21 Mar '12

21 Mar '12

Author: wmb Date: Wed Mar 21 23:15:39 2012 New Revision: 2910 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2910 Log: Debugger - factored (trace so it's not so crazy long, and cleaned up a few minor glitches. Modified: forth/lib/debug.fth Modified: forth/lib/debug.fth ============================================================================== --- forth/lib/debug.fth Wed Mar 21 23:14:01 2012 (r2909) +++ forth/lib/debug.fth Wed Mar 21 23:15:39 2012 (r2910) @@ -37,8 +37,7 @@ variable step? step? on variable res headers -false value first-time? -d# 10 circular-stack: locations +false value redisplay? : (debug) (s low-adr hi-adr -- ) unbug 1 cnt ! ip> ! <ip ! pnext @@ -47,7 +46,7 @@ slow-next? on then step? on - true is first-time? + true is redisplay? ; headerless : 'unnest (s pfa -- pfa' ) @@ -116,6 +115,7 @@ ." $ Display top of stack as adr,len text string" cr ." \ Display Forth return stack as numbers (like the data stack)" cr ." Q Quit: abandon execution of the debugged word" cr + ." V Visual: toggle between 2-D and scrolling" cr ; d# 24 constant cmd-column : to-cmd-column ( -- ) cmd-column to-column ; @@ -141,8 +141,6 @@ : save-result-loc ( -- ) #out @ to result-col #line @ to result-line ; : to-result-loc ( -- ) result-col result-line at-xy ; -0 value rp-mark - \ set-package is a hook for Open Firmware. When Open Firmware is loaded, \ set-package should be set to a word that sets the active package to the \ package corresponding to the current instance. set-package is called @@ -165,72 +163,82 @@ variable hex-stack \ Show the data stack in hex? : save# ( -- ) #-buf /#buf - #buf-save d# 72 move hld @ hld-save ! ; : restore# ( -- ) #buf-save #-buf /#buf - d# 72 move hld-save @ hld ! ; +0 value the-ip +0 value the-rp : (.rs ( -- ) show-rstack @ 0= if exit then ." return-stack: " push-hex - rp0 @ rp@ - /n / - 6 do \ It appears that skipping the first 6 entries on the stack skips the debug goo on the rs - rp@ i /n * + @ . - loop + \ Skip the debugger's footprint on the return stack + rp0 @ the-rp 5 na+ ?do i @ . /n +loop pop-base ; -: (trace ( -- ) - first-time? if +: setup-scrolling-display ( -- ) + ??cr + the-ip <ip @ = if ." : " else ." Inside " then + <ip @ find-cfa .name +; +: setup-2d-display ( -- ) + page + d# 78 rmargin ! + .debug-short-help + ." Callers: " rp0 @ the-rp na1+ rslist kill-line cr + \ XXX the following is wrong when popping up + the-ip <ip @ = if + #line @ is stack-line \ So the initial stack is displayed in the right place + then + d# 40 rmargin ! + the-ip debug-see + cr + \ When popping up from an interior word, display the initial stack on + \ the line where the cursor will be. + the-ip <ip @ <> if + the-ip ip>position if ( col row ) + drop is stack-line ( ) + then + then +; +: setup-debug-display ( -- ) + redisplay? if scrolling-debug? if - ??cr - ip@ <ip @ = if ." : " else ." Inside " then - <ip @ find-cfa .name + setup-scrolling-display else - page - d# 78 rmargin ! - ." Callers: " rp0 @ rp@ na1+ rslist kill-line cr - \ XXX the following is wrong when popping up - ip@ <ip @ = if - #line @ is stack-line \ So the initial stack is displayed in the right place - then - d# 40 rmargin ! - ip@ debug-see - cr -\ ip@ <ip @ <> if -\ ip@ ip>position if ( col row ) -\ swap -\ is stack-line -\ then -\ #line @ is stack-line \ So the initial stack is displayed in the right place - \ then + setup-2d-display then 0 show-rstack ! - false is first-time? - rp@ is rp-mark + false is redisplay? then - - begin - step? @ if to-debug-window then +; +: show-debug-stack ( -- ) + scrolling-debug? if save# - scrolling-debug? if - cmd-column 2+ to-column + cmd-column 2+ to-column - hex-stack @ if push-hex then - ." ( " .s \ Show data stack - hex-stack @ if pop-base then - show-rstack @ if (.rs then \ Show return stack - ." )" - restore# - - cr - ['] noop is indent - ip@ .token drop \ Show word name - ['] (indent) is indent - to-cmd-column - else - save-result-loc - show-partial-stack + hex-stack @ if push-hex then + ." ( " .s \ Show data stack + hex-stack @ if pop-base then + show-rstack @ if (.rs then \ Show return stack + ." )" + restore# + + cr + ['] noop is indent + the-ip .token drop \ Show word name + ['] (indent) is indent + to-cmd-column + else + save-result-loc + show-partial-stack - ip@ ip-set-cursor - #line @ to stack-line - then - + the-ip ip-set-cursor + #line @ to stack-line + then +; +: debug-interact ( -- ) + save# + begin + step? @ if to-debug-window then + show-debug-stack step? @ key? or if step? on res off key dup bl < if drop bl then @@ -238,28 +246,35 @@ restore-window scrolling-debug? if reset-page then case - ascii D of ip@ token@ executer ['] (debug try endof \ Down - ascii U of rp@ ['] up1 try endof \ Up - ascii C of step? @ 0= step? ! true endof \ Continue - ascii F of + ascii D of the-ip token@ executer ['] (debug try endof \ Down + ascii U of the-rp ['] up1 try endof \ Up + ascii C of \ Continue + step? @ 0= step? ! + step? @ 0= if true to scrolling-debug? true to redisplay? then + true + endof + + ascii F of \ Forth cr ." Type 'resume' to return to debugger" cr set-package interact unset-package false - endof \ Forth - ascii G of debug-off cr exit endof \ Go - ascii H of cr .debug-long-help false endof \ Help - ascii R of cr rp0 @ rp@ na1+ (rstrace false endof \ RSTrace - ascii S of cr <ip @ body> (see) false endof \ See - ascii ? of cr .debug-short-help false endof \ Short Help + endof + ascii G of debug-off cr true endof \ Go + ascii H of cr .debug-long-help false endof \ Help + ascii R of cr rp0 @ the-rp na1+ (rstrace false endof \ RSTrace + ascii S of cr <ip @ body> (see) false endof \ See + ascii ? of cr .debug-short-help false endof \ Short Help ascii $ of space 2dup type cr to-cmd-column false endof \ String ascii Q of cr ." unbug" abort true endof \ Quit - ascii ( of ip@ set-<ip false endof - ascii < of ip@ ta1+ set-<ip 1 cnt ! false endof - ascii ) of ip@ ip> ! 1 cnt ! false endof - ascii * of ip@ find-cfa dup <ip ! 'unnest ip> ! false endof - ascii \ of show-rstack @ 0= show-rstack ! false endof - ascii X of hex-stack @ 0= hex-stack ! false endof - ascii V of scrolling-debug? 0= to scrolling-debug? - scrolling-debug? 0= if true to first-time? then false endof + ascii ( of the-ip set-<ip false endof + ascii < of the-ip ta1+ set-<ip 1 cnt ! false endof + ascii ) of the-ip ip> ! 1 cnt ! false endof + ascii * of the-ip find-cfa dup <ip ! 'unnest ip> ! false endof + ascii \ of show-rstack @ 0= show-rstack ! false endof \ toggle return stack display + ascii X of hex-stack @ 0= hex-stack ! false endof \ toggle heX stack display + ascii V of \ toggle Visual (2D) mode + scrolling-debug? 0= to scrolling-debug? + scrolling-debug? 0= if true to redisplay? then false + endof ( default ) true swap endcase else @@ -267,11 +282,17 @@ then until restore# - scrolling-debug? 0= if to-result-loc then - ip@ token@ dup ['] unnest = swap ['] exit = or if - cr true is first-time? +; +: (trace ( -- ) + ip@ to the-ip + rp@ to the-rp + setup-debug-display + debug-interact +\ scrolling-debug? 0= if to-result-loc then + the-ip token@ dup ['] unnest = swap ['] exit = or if + cr true is redisplay? then - pnext + slow-next? @ if pnext then ; ' (trace 'debug token!

1 0

[commit] r2909 - forth/lib
by repository service 21 Mar '12

21 Mar '12

Author: wmb Date: Wed Mar 21 23:14:01 2012 New Revision: 2909 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2909 Log: Decompiler - fixed the indentation logic (it sometimes messed up on repeated conditionals or loops) and added h#/d# number prefixes. Modified: forth/lib/decomp.fth Modified: forth/lib/decomp.fth ============================================================================== --- forth/lib/decomp.fth Wed Mar 21 06:42:47 2012 (r2908) +++ forth/lib/decomp.fth Wed Mar 21 23:14:01 2012 (r2909) @@ -54,7 +54,7 @@ defer (see) hidden definitions -d# 200 2* /n* constant /positions +d# 300 2* /n* constant /positions /positions buffer: positions 0 value end-positions \ 0 value line-after-; @@ -70,14 +70,14 @@ 2 /n* +loop ( ip ) drop true ( true ) ; -0 value the-ip +0 value decompiler-ip : add-position ( ip -- ) - the-ip find-position if ( ) + decompiler-ip find-position if ( ) end-positions positions /positions + >= ( flag ) abort" Decompiler position table overflow" ( ) end-positions dup 2 na+ is end-positions ( adr ) then ( adr ) - #out @ #line @ wljoin the-ip rot 2! ( ) + #out @ #line @ wljoin decompiler-ip rot 2! ( ) ; : ip>position ( ip -- true | #out #line false ) find-position if ( ) @@ -91,10 +91,20 @@ ip>position 0= if at-xy then ; +headers +defer indent +: (indent) ( -- ) lmargin @ #out @ - 0 max spaces ; +' (indent) is indent +headerless + +: +indent ( -- ) 3 lmargin +! cr ; +: -indent ( -- ) ??cr -3 lmargin +! ; +\ : <indent ( -- ) ??cr -3 lmargin +! indent 3 lmargin +! ; + headerless \ Like ." but goes to a new line if needed. : cr". ( adr len -- ) - dup ?line ( adr len ) + dup ?line indent ( adr len ) add-position ( adr len ) magenta-letters type cancel ( ) ; @@ -198,21 +208,9 @@ then ; -headers -defer indent -: (indent) ( -- ) - #out @ lmargin @ > if cr then - lmargin @ #out @ - spaces -; -' (indent) is indent -headerless - -: +indent ( -- ) 3 lmargin +! indent ; -: -indent ( -- ) -3 lmargin +! indent ; -: <indent ( -- ) -3 lmargin +! indent 3 lmargin +! ; : .begin ( -- ) .." begin " +indent ; -: .then ( -- ) -indent .." then " ; +: .then ( -- ) -indent .." then" cr ; \ Extent holds the largest known extent of the current word, as determined \ by branch targets seen so far. This is used to decide if an exit should @@ -220,10 +218,10 @@ variable extent extent off : +extent ( possible-new-extent -- ) extent @ umax extent ! ; : +branch ( ip-of-branch -- next-ip ) ta1+ /branch + ; -: .endof ( ip -- ip' ) .." endof" indent +branch ; -: .endcase ( ip -- ip' ) indent .." endcase" indent ta1+ ; -: .$endof ( ip -- ip' ) .." $endof" indent +branch ; -: .$endcase ( ip -- ip' ) indent .." $endcase" indent ta1+ ; +: .endof ( ip -- ip' ) .." endof" cr +branch ; +: .endcase ( ip -- ip' ) .." endcase" cr ta1+ ; +: .$endof ( ip -- ip' ) .." $endof" cr +branch ; +: .$endcase ( ip -- ip' ) .." $endcase" cr ta1+ ; : add-break ( break-address break-type -- ) end-breaks @ breaks /breaks + >= ( adr,type full? ) @@ -283,36 +281,36 @@ : scan-;code ( ip -- ip' | 0 ) does-ip? 0= if drop 0 then ; : .;code (s ip -- ip' ) does-ip? if - cr lmargin @ spaces ." does> " + ??cr .." does> " else - 0 lmargin ! indent .." ;code " cr disassemble 0 + ??cr 0 lmargin ! .." ;code " cr disassemble 0 then ; : .branch ( ip -- ip' ) dup forward-branch? if - <indent .." else" indent + -indent .." else" +indent else - -indent .." repeat " + -indent .." repeat" cr then +branch ; : .?branch ( ip -- ip' ) dup forward-branch? if dup while? if - <indent .." while" indent + -indent .." while" +indent else - .." if " +indent + .." if" +indent then else - -indent .." until " + -indent .." until " cr then +branch ; : .do ( ip -- ip' ) .." do " +indent +branch ; : .?do ( ip -- ip' ) .." ?do " +indent +branch ; -: .loop ( ip -- ip' ) -indent .." loop " +branch ; -: .+loop ( ip -- ip' ) -indent .." +loop " +branch ; +: .loop ( ip -- ip' ) .." loop " cr +branch ; +: .+loop ( ip -- ip' ) -indent .." +loop " cr +branch ; : .of ( ip -- ip' ) .." of " +branch ; : .$of ( ip -- ip' ) .." $of " +branch ; @@ -343,8 +341,15 @@ : pretty-. ( n -- ) base @ d# 10 = if (.) else (u.) then ( adr len ) - dup ?line add-position - green-letters type cancel space + dup 3 + ?line indent add-position + green-letters + base @ case + d# 10 of ." d# " endof + d# 16 of ." h# " endof + d# 8 of ." o# " endof + d# 2 of ." b# " endof + endcase + type cancel space ; : .compiled ( ip -- ip' ) @@ -354,6 +359,7 @@ ta1+ ( ip' ) ; : .word ( ip -- ip' ) + indent dup token@ check-[compile] ( ip xt ) >name name>string ( ip adr len ) dup ?line add-position ( ip adr len ) @@ -378,7 +384,7 @@ headers : skip-(') ( ip -- ip' ) ta1+ ta1+ ; headerless -: .is ( ip -- ip' ) .." to " ta1+ dup token@ .name ta1+ ; +: .is ( ip -- ip' ) .." to " ta1+ dup token@ .name ta1+ ; : .string ( ip -- ip' ) cword-name .string-tail +str ; : .nstring ( ip -- ip' ) ta1+ dup ncount " n""" .string-tail +nstr ; @@ -387,7 +393,7 @@ : .unnest ( ip -- ip' ) dup extent @ u>= if - 0 lmargin ! indent .." ; " drop 0 + ??cr 0 lmargin ! .." ;" drop 0 else .." exit " ta1+ then @@ -498,8 +504,9 @@ init-positions ( apf ) dup scan-pf next-break 3 lmargin ! indent ( apf ) begin ( adr ) - dup is the-ip ( adr ) - ?cr break-addr @ over = if ( adr ) + dup is decompiler-ip ( adr ) + ?cr ( adr ) + break-addr @ over = if ( adr ) begin ( adr ) break-type @ execute ( adr ) next-break break-addr @ over <> ( adr done? ) @@ -525,7 +532,7 @@ pop-base ; \ Display category of word -: .: ( acf definer -- ) .definer space space >body .pf ; +: .: ( acf definer -- ) .definer cr ( space space ) >body .pf ; : debug-see ( apf -- ) page-mode? >r no-page find-cfa ['] : .:

1 0

[commit] r2908 - cpu/x86/pc/olpc
by repository service 21 Mar '12

21 Mar '12

Author: quozl Date: Wed Mar 21 06:42:47 2012 New Revision: 2908 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2908 Log: Q2F08 Modified: cpu/x86/pc/olpc/versions.fth Modified: cpu/x86/pc/olpc/versions.fth ============================================================================== --- cpu/x86/pc/olpc/versions.fth Wed Mar 21 06:23:54 2012 (r2907) +++ cpu/x86/pc/olpc/versions.fth Wed Mar 21 06:42:47 2012 (r2908) @@ -2,7 +2,7 @@ \ The overall firmware revision macro: FW_MAJOR F -macro: FW_MINOR 07 +macro: FW_MINOR 08 \ The EC microcode macro: EC_VERSION 1_2_1

1 0

[commit] r2907 - cpu/x86/pc/olpc/via
by repository service 21 Mar '12

21 Mar '12

Author: quozl Date: Wed Mar 21 06:23:54 2012 New Revision: 2907 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2907 Log: Q3C03 Modified: cpu/x86/pc/olpc/via/fw-version.fth Modified: cpu/x86/pc/olpc/via/fw-version.fth ============================================================================== --- cpu/x86/pc/olpc/via/fw-version.fth Wed Mar 21 05:35:14 2012 (r2906) +++ cpu/x86/pc/olpc/via/fw-version.fth Wed Mar 21 06:23:54 2012 (r2907) @@ -1,3 +1,3 @@ \ The overall firmware revision macro: FW_MAJOR C -macro: FW_MINOR 02 +macro: FW_MINOR 03

1 0

[commit] r2906 - cpu/arm/olpc/1.75
by repository service 21 Mar '12

21 Mar '12

Author: quozl Date: Wed Mar 21 05:35:14 2012 New Revision: 2906 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2906 Log: Q4D06 Modified: cpu/arm/olpc/1.75/fw-version.fth Modified: cpu/arm/olpc/1.75/fw-version.fth ============================================================================== --- cpu/arm/olpc/1.75/fw-version.fth Wed Mar 21 05:01:28 2012 (r2905) +++ cpu/arm/olpc/1.75/fw-version.fth Wed Mar 21 05:35:14 2012 (r2906) @@ -1,4 +1,4 @@ \ The overall firmware revision macro: FW_PREFIX Q4 macro: FW_MAJOR D -macro: FW_MINOR 05 +macro: FW_MINOR 06

1 0

[commit] r2905 - in cpu: arm/olpc x86/pc/olpc x86/pc/olpc/via
by repository service 21 Mar '12

21 Mar '12

Author: quozl Date: Wed Mar 21 05:01:28 2012 New Revision: 2905 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2905 Log: OLPC - make help consistent across platforms Modified: cpu/arm/olpc/help.fth cpu/x86/pc/olpc/help.fth cpu/x86/pc/olpc/via/help.fth Modified: cpu/arm/olpc/help.fth ============================================================================== --- cpu/arm/olpc/help.fth Wed Mar 21 00:56:47 2012 (r2904) +++ cpu/arm/olpc/help.fth Wed Mar 21 05:01:28 2012 (r2905) @@ -5,26 +5,24 @@ blue-letters ." INSTALLATION:" cancel mcr \ ================================================================================ ." fs-update u:\os1.zd4 Install OS from USB drive to internal storage" mcr - ." flash u:\q4b07.rom Install firmware from USB drive" mcr - ." flash ext:\q4b07.rom Install firmware from external SD card" mcr + ." flash u:\q4d06.rom Install firmware from USB drive" mcr blue-letters ." DIRECTORY LISTING:" cancel mcr ." dir u:\ List USB drive root directory" mcr ." dir u:\boot\ List USB drive /boot directory" mcr - ." dir int:\boot\*.zip List .zip files in internal SD /boot directory" mcr + ." dir int:\boot\*.zip List .zip files in internal /boot directory" mcr blue-letters ." BOOTING:" cancel mcr ." boot Start the OS from list of default locations" mcr - ." printenv boot-device Show the list of default locations used by boot" mcr ." boot u:\test.fth Start the OS from a specific location" mcr blue-letters ." CONFIGURATION VARIABLES FOR BOOTING:" cancel mcr ." boot-device Kernel or boot script paths. Example: ext:\boot\olpc.fth" mcr - ." boot-file Default kernel command line. Example: console=ttyS0,115200" mcr + ." boot-file Default kernel command line. Example: debug" mcr ." ramdisk Initial RAMDISK path. Example: int:\boot\initrd.img" mcr blue-letters ." MANAGING CONFIGURATION VARIABLES:" cancel mcr ." printenv [ <name> ] Show configuration variables" mcr ." setenv <name> <value> Set configuration variable" mcr ." editenv <name> Edit configuration variable" mcr blue-letters ." DIAGNOSTICS:" cancel mcr - ." test <device-name> Test device. Example: test mouse" mcr + ." test <device-name> Test a device. Example: test mouse" mcr ." test-all Test all devices that have test routines" mcr ." menu Graphical interface to selftests" mcr blue-letters ." More information: " cancel mcr Modified: cpu/x86/pc/olpc/help.fth ============================================================================== --- cpu/x86/pc/olpc/help.fth Wed Mar 21 00:56:47 2012 (r2904) +++ cpu/x86/pc/olpc/help.fth Wed Mar 21 05:01:28 2012 (r2905) @@ -2,28 +2,29 @@ warning @ warning off : help ( -- ) - blue-letters ." UPDATES:" cancel mcr + blue-letters ." INSTALLATION:" cancel mcr \ ================================================================================ - ." update-nand u:\os.img Rewrite OS on NAND from USB drive" mcr - ." flash u:\q2f07.rom Rewrite firmware from USB drive" mcr + ." update-nand u:\os.img Install OS from USB drive to internal storage" mcr + ." flash u:\q2f08.rom Install firmware from USB drive" mcr blue-letters ." DIRECTORY LISTING:" cancel mcr - ." dir u:\ List USB drive root directory" mcr - ." dir u:\boot\ List USB drive /boot directory" mcr - ." dir nand:\boot\*.rom List .rom files in NAND /boot directory" mcr + ." dir u:\ List USB drive root directory" mcr + ." dir u:\boot\ List USB drive /boot directory" mcr + ." dir nand:\boot\*.rom List .rom files in internal /boot directory" mcr blue-letters ." BOOTING:" cancel mcr - ." boot Start the OS" mcr - ." boot u:\vmlinuz Start the OS from a specific location" mcr + ." boot Start the OS from list of default locations" mcr + ." boot u:\test.fth Start the OS from a specific location" mcr blue-letters ." CONFIGURATION VARIABLES FOR BOOTING:" cancel mcr - ." boot-device Kernel or boot script path. Example: nand:\boot\olpc.fth" mcr - ." boot-file Default cmdline. Example: console=ttyS0,115200" mcr - ." ramdisk initrd pathname. Example: disk:\boot\initrd.imz" mcr + ." boot-device Kernel or boot script paths. Example: nand:\boot\olpc.fth" mcr + ." boot-file Default kernel command line. Example: debug" mcr + ." ramdisk Initial RAMDISK path. Example: disk:\boot\initrd.imz" mcr blue-letters ." MANAGING CONFIGURATION VARIABLES:" cancel mcr - ." printenv [ <name> ] Show configuration variables" mcr - ." setenv <name> <value> Set configuration variable" mcr - ." editenv <name> Edit configuration variable" mcr + ." printenv [ <name> ] Show configuration variables" mcr + ." setenv <name> <value> Set configuration variable" mcr + ." editenv <name> Edit configuration variable" mcr blue-letters ." DIAGNOSTICS:" cancel mcr - ." test <device-name> Test device. Example: test mouse" mcr - ." test-all Test all devices that have test routines" mcr + ." test <device-name> Test a device. Example: test mouse" mcr + ." test-all Test all devices that have test routines" mcr + ." menu Graphical interface to selftests" mcr blue-letters ." More information: " cancel mcr green-letters ." http://wiki.laptop.org/go/OFW_FAQ" cancel cr ; Modified: cpu/x86/pc/olpc/via/help.fth ============================================================================== --- cpu/x86/pc/olpc/via/help.fth Wed Mar 21 00:56:47 2012 (r2904) +++ cpu/x86/pc/olpc/via/help.fth Wed Mar 21 05:01:28 2012 (r2905) @@ -2,29 +2,27 @@ warning @ warning off : help ( -- ) - blue-letters ." UPDATES:" cancel mcr + blue-letters ." INSTALLATION:" cancel mcr \ ================================================================================ - ." fs-update u:\os1.zd4 Rewrite the OS on internal SD from USB drive" mcr - ." flash u:\q3a64.rom Rewrite the firmware from USB drive" mcr - ." flash ext:\q3a64.rom Rewrite the firmware from external SD file" mcr + ." fs-update u:\os1.zd4 Install OS from USB drive to internal storage" mcr + ." flash u:\q3c03.rom Install firmware from USB drive" mcr blue-letters ." DIRECTORY LISTING:" cancel mcr ." dir u:\ List USB drive root directory" mcr ." dir u:\boot\ List USB drive /boot directory" mcr - ." dir int:\boot\*.zip List .zip files in internal SD /boot directory" mcr + ." dir int:\boot\*.zip List .zip files in internal /boot directory" mcr blue-letters ." BOOTING:" cancel mcr ." boot Start the OS from list of default locations" mcr - ." printenv boot-device Show the list of default locations used by boot" mcr ." boot u:\test.fth Start the OS from a specific location" mcr blue-letters ." CONFIGURATION VARIABLES FOR BOOTING:" cancel mcr ." boot-device Kernel or boot script paths. Example: ext:\boot\olpc.fth" mcr - ." boot-file Default kernel command line. Example: console=ttyS0,115200" mcr + ." boot-file Default kernel command line. Example: debug" mcr ." ramdisk Initial RAMDISK path. Example: int:\boot\initrd.img" mcr blue-letters ." MANAGING CONFIGURATION VARIABLES:" cancel mcr ." printenv [ <name> ] Show configuration variables" mcr ." setenv <name> <value> Set configuration variable" mcr ." editenv <name> Edit configuration variable" mcr blue-letters ." DIAGNOSTICS:" cancel mcr - ." test <device-name> Test device. Example: test mouse" mcr + ." test <device-name> Test a device. Example: test mouse" mcr ." test-all Test all devices that have test routines" mcr ." menu Graphical interface to selftests" mcr blue-letters ." More information: " cancel mcr

1 0

[commit] r2904 - cpu/x86 forth/lib ofw/core
by repository service 20 Mar '12

20 Mar '12

Author: wmb Date: Wed Mar 21 00:56:47 2012 New Revision: 2904 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2904 Log: Improvements to the 2D debugger. Modified: cpu/x86/kerncode.fth forth/lib/debug.fth forth/lib/decomp.fth forth/lib/rstrace.fth ofw/core/ofwcore.fth Modified: cpu/x86/kerncode.fth ============================================================================== --- cpu/x86/kerncode.fth Tue Mar 20 23:37:14 2012 (r2903) +++ cpu/x86/kerncode.fth Wed Mar 21 00:56:47 2012 (r2904) @@ -299,13 +299,7 @@ \ Run time word for ?do code (?do) (s l i -- ) ax pop bx pop ax bx cmp = if bran1 #) jmp then -[ifdef] big-endian-t - bx push ax push - ip dx mov 0 [ip] ax mov ?bswap-ax ax dx add rp adec dx 0 [rp] mov - ax pop bx pop \ i in ax l in bx -[else] - ip dx mov 0 [ip] dx add rp adec dx 0 [rp] mov -[then] + rp adec ip 0 [rp] mov ip ainc 80000000 # bx add rp adec bx 0 [rp] mov bx ax sub rp adec ax 0 [rp] mov \ ??? how about sp rp xchg ... dx push bx push ax push sp rp xchg @@ -313,17 +307,9 @@ \ Run time word for do code (do) (s l i -- ) -[ifdef] big-endian-t ax pop bx pop \ i in ax l in bx + rp adec ip 0 [rp] mov - bx push ax push - ip dx mov 0 [ip] ax mov ?bswap-ax ax dx add rp adec dx 0 [rp] mov - ax pop bx pop \ i in ax l in bx -[else] - ax pop bx pop \ i in ax l in bx - - ip dx mov 0 [ip] dx add rp adec dx 0 [rp] mov -[then] ip ainc 80000000 # bx add rp adec bx 0 [rp] mov bx ax sub rp adec ax 0 [rp] mov \ ??? how about sp rp xchg ... dx push bx push ax push sp rp xchg @@ -344,7 +330,13 @@ code (leave) (s -- ) mloclabel pleave - 2 /n* [rp] ip mov 3 /n* # rp add + 2 /n* [rp] ip mov +[ifdef] big-endian-t + 0 [ip] ax mov ?bswap-ax ax ip add +[else] + 0 [ip] ip add +[then] + 3 /n* # rp add c; code (?leave) (s f -- ) ax pop ax ax or pleave jne c; Modified: forth/lib/debug.fth ============================================================================== --- forth/lib/debug.fth Tue Mar 20 23:37:14 2012 (r2903) +++ forth/lib/debug.fth Wed Mar 21 00:56:47 2012 (r2904) @@ -38,6 +38,8 @@ variable res headers false value first-time? +d# 10 circular-stack: locations + : (debug) (s low-adr hi-adr -- ) unbug 1 cnt ! ip> ! <ip ! pnext slow-next? @ 0= if @@ -119,11 +121,21 @@ : to-cmd-column ( -- ) cmd-column to-column ; 0 value stack-line -d# 50 constant stack-column +d# 45 constant stack-column \ 0 0 2value result-loc 0 value result-line 0 value result-col : to-stack-location ( -- ) stack-column stack-line at-xy kill-line ; +: show-partial-stack ( -- ) + to-stack-location + + ." \ " + depth 0< if ." Stack Underflow" sp0 @ sp! exit then + depth 0= if ." Empty" exit then + depth 4 > if ." .. " then + depth depth 5 - 0 max ?do depth i - 1- pick n. loop +; + \ : save-result-loc ( -- ) #out @ #line @ to result-loc ; \ : to-result-loc ( -- ) result-loc at-xy ; : save-result-loc ( -- ) #out @ to result-col #line @ to result-line ; @@ -170,38 +182,51 @@ ip@ <ip @ = if ." : " else ." Inside " then <ip @ find-cfa .name else + page + d# 78 rmargin ! + ." Callers: " rp0 @ rp@ na1+ rslist kill-line cr + \ XXX the following is wrong when popping up + ip@ <ip @ = if + #line @ is stack-line \ So the initial stack is displayed in the right place + then + d# 40 rmargin ! ip@ debug-see - 0 is stack-line \ So the initial stack is displayed in the right place cr +\ ip@ <ip @ <> if +\ ip@ ip>position if ( col row ) +\ swap +\ is stack-line +\ then +\ #line @ is stack-line \ So the initial stack is displayed in the right place + \ then then 0 show-rstack ! false is first-time? rp@ is rp-mark then + begin step? @ if to-debug-window then save# scrolling-debug? if cmd-column 2+ to-column - else - save-result-loc - to-stack-location - then - hex-stack @ if push-hex then - ." ( " .s \ Show data stack - hex-stack @ if pop-base then - show-rstack @ if (.rs then \ Show return stack - ." )" - restore# + hex-stack @ if push-hex then + ." ( " .s \ Show data stack + hex-stack @ if pop-base then + show-rstack @ if (.rs then \ Show return stack + ." )" + restore# - scrolling-debug? if cr ['] noop is indent ip@ .token drop \ Show word name ['] (indent) is indent to-cmd-column else + save-result-loc + show-partial-stack + ip@ ip-set-cursor #line @ to stack-line then @@ -233,6 +258,8 @@ ascii * of ip@ find-cfa dup <ip ! 'unnest ip> ! false endof ascii \ of show-rstack @ 0= show-rstack ! false endof ascii X of hex-stack @ 0= hex-stack ! false endof + ascii V of scrolling-debug? 0= to scrolling-debug? + scrolling-debug? 0= if true to first-time? then false endof ( default ) true swap endcase else Modified: forth/lib/decomp.fth ============================================================================== --- forth/lib/decomp.fth Tue Mar 20 23:37:14 2012 (r2903) +++ forth/lib/decomp.fth Wed Mar 21 00:56:47 2012 (r2904) @@ -528,7 +528,7 @@ : .: ( acf definer -- ) .definer space space >body .pf ; : debug-see ( apf -- ) page-mode? >r no-page - d# 48 rmargin ! find-cfa ['] : page .: + find-cfa ['] : .: r> is page-mode? ; : .constant ( acf definer -- ) over >data @ pretty-. .definer drop ; Modified: forth/lib/rstrace.fth ============================================================================== --- forth/lib/rstrace.fth Tue Mar 20 23:37:14 2012 (r2903) +++ forth/lib/rstrace.fth Wed Mar 21 00:56:47 2012 (r2904) @@ -28,16 +28,20 @@ over na1+ @ reasonable-ip? if ( rs-adr n ) \ The third entry is a reasonable IP so it could be a do loop frame \ Make sure it points just past a loop end - over na1+ @ ( rs-adr n n2 ) - ip>token -1 na+ token@ ( rs-adr n xt ) - dup ['] (loop) = swap ['] (+loop) = or if ( rs-adr n ) - \ The two numbers span the +- boundary, so probably a do loop - ." Do loop frame inside " - over na1+ @ ip>token .current-word ( rs-adr n ) - over @ ( rs-adr n n1 ) - ." i: " tuck + . ( rs-adr n1 ) - ." limit: " minus0 + . ( rs-adr ) - 2 na+ exit + over na1+ @ dup @ + ( rs-adr n n2 ) + dup reasonable-ip? if ( rs-adr n adr ) + ip>token -1 na+ token@ ( rs-adr n xt ) + dup ['] (loop) = swap ['] (+loop) = or if ( rs-adr n ) + \ The two numbers span the +- boundary, so probably a do loop + ." Do loop frame inside " + over na1+ @ ip>token .current-word ( rs-adr n ) + over @ ( rs-adr n n1 ) + ." i: " tuck + . ( rs-adr n1 ) + ." limit: " minus0 + . ( rs-adr ) + 2 na+ exit + then ( rs-adr n ) + else ( rs-adr n n2 ) + drop ( rs-adr n ) then ( rs-adr n ) then ( rs-adr n ) then ( rs-adr n ) @@ -73,6 +77,67 @@ repeat ( end-adr adr ) 2drop ; +: skip-catch ( rs-adr -- rs-adr' ) 3 na+ ; +: skip-do-or-n ( rs-adr n -- rs-adr' ) + over @ reasonable-ip? 0= if ( rs-adr n ) + \ The second number is not an IP so it could be a do loop frame + over na1+ @ reasonable-ip? if ( rs-adr n ) + \ The third entry is a reasonable IP so it could be a do loop frame + \ Make sure it points to an offset that points just past a loop end + over na1+ @ dup @ + ( rs-adr n n2 ) + dup reasonable-ip? if ( rs-adr n adr ) + ip>token -1 na+ token@ ( rs-adr n xt ) + dup ['] (loop) = swap ['] (+loop) = or if ( rs-adr n ) + \ The two numbers span the +- boundary, so probably a do loop + drop ( rs-adr ) + 2 na+ exit ( -- rs-adr ) + then ( rs-adr n ) + else ( rs-adr n n2 ) + drop ( rs-adr n ) + then ( rs-adr n ) + then ( rs-adr n ) + then ( rs-adr n ) + drop ( rs-adr ) +; +defer boring? +: (boring?) ( ip -- flag ) drop false ; +: rtraceword ( rs-end rs-adr -- rs-end rs-adr' ) + @+ ( rs-end rs-adr' ip ) + dup reasonable-ip? 0= if ( rs-end rs-adr ip ) + skip-do-or-n exit ( -- rs-end rs-adr ) + then ( rs-end rs-adr ) + + dup in-catch? if ( rs-end rs-adr ip ) + drop skip-catch ( rs-end rs-adr' ) + exit ( -- rs-end rs-adr' ) + then ( rs-end rs-adr ip ) + + find-cfa ( rs-end rs-adr xt ) + + dup boring? if ( rs-end rs-adr xt ) + drop exit ( -- rs-end rs-adr ) + then ( rs-end rs-adr xt ) + + dup ['] interpret-do-defined = if ( rs-end rs-adr xt ) + \ Set rs-adr = rs-end so the caller will exit + 2drop dup exit ( -- rs-end rs-adr' ) + then ( rs-end rs-adr xt ) + + >name name>string ( rs-end rs-adr adr len ) + dup #out @ + rmargin @ >= if ( rs-end rs-adr adr len ) + \ Set rs-adr = rs-end so the caller will exit + 2drop ." ..." ( rs-end rs-adr ) + drop dup exit ( -- rs-end rs-adr' ) + then ( rs-end rs-adr adr len ) + + type space ( rs-end rs-adr ) +; +: rslist ( end-adr start-adr -- ) + begin 2dup u> while ( end-adr adr ) + rtraceword ( end-adr adr' ) + repeat ( end-adr adr ) + 2drop +; headers forth definitions : rstrace ( -- ) \ Return stack backtrace Modified: ofw/core/ofwcore.fth ============================================================================== --- ofw/core/ofwcore.fth Tue Mar 20 23:37:14 2012 (r2903) +++ ofw/core/ofwcore.fth Wed Mar 21 00:56:47 2012 (r2904) @@ -4770,3 +4770,22 @@ [ifdef] do-autoload ' do-drop-in is do-autoload [then] + +also hidden +: method-call? ( ip -- flag ) + dup ['] $call-self = if drop true exit then ( ip ) + dup ['] $call-method = if drop true exit then ( ip ) + dup ['] $call-parent = if drop true exit then ( ip ) + dup ['] call-package = if drop true exit then ( ip ) + dup ['] $vexecute = if drop true exit then ( ip ) + dup ['] $vexecute? = if drop true exit then ( ip ) + dup ['] $package-execute? = if drop true exit then ( ip ) + dup ['] package-execute = if drop true exit then ( ip ) + dup ['] apply-method = if drop true exit then ( ip ) + dup ['] (apply-method) = if drop true exit then ( ip ) + dup ['] (execute-method) = if drop true exit then ( ip ) + dup ['] execute-device-method = if drop true exit then ( ip ) + drop false +; +' method-call? to boring? +previous

1 0

Jump to page:

2025

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

openfirmware