March 2012 - openfirmware - mail.coreboot.org

[commit] r2904 - cpu/x86 forth/lib ofw/core
by repository service March 20, 2012

March 20, 2012

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

[commit] r2903 - forth/lib
by repository service March 20, 2012

March 20, 2012

Author: wmb Date: Tue Mar 20 23:37:14 2012 New Revision: 2903 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2903 Log: ANSI terminal interface - make it possible to turn off color text support. Modified: forth/lib/ansiterm.fth Modified: forth/lib/ansiterm.fth ============================================================================== --- forth/lib/ansiterm.fth Tue Mar 20 22:04:53 2012 (r2902) +++ forth/lib/ansiterm.fth Tue Mar 20 23:37:14 2012 (r2903) @@ -40,10 +40,12 @@ ; : page ( -- ) 0 0 at-xy kill-screen ; -true [if] +true value ansi-colors? + headerless : color: ( adr len "name" -- ) - create ", does> .esc[ count (type [char] m (emit + create ", + does> ansi-colors? if .esc[ count (type [char] m (emit else drop then ; headers " 0" color: default-colors @@ -66,7 +68,7 @@ " 45" color: magenta-screen " 46" color: cyan-screen " 47" color: white-screen -[then] + \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \

1 0

[commit] r2902 - ofw/core
by repository service March 20, 2012

March 20, 2012

Author: quozl Date: Tue Mar 20 22:04:53 2012 New Revision: 2902 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2902 Log: core - stack effect comment fix Modified: ofw/core/deblock.fth Modified: ofw/core/deblock.fth ============================================================================== --- ofw/core/deblock.fth Tue Mar 20 10:37:24 2012 (r2901) +++ ofw/core/deblock.fth Tue Mar 20 22:04:53 2012 (r2902) @@ -205,7 +205,7 @@ : size ( -- size.low size.high ) deblock-fd ['] dfsize catch if drop 0 0 then ; -: position ( -- offset.low offset.high -- ) +: position ( -- offset.low offset.high ) deblock-fd ['] dftell catch if drop 0 0 then ; : seek ( offset.low offset.high -- error? )

1 0

[commit] r2901 - cpu/arm forth/lib
by repository service March 20, 2012

March 20, 2012

Author: wmb Date: Tue Mar 20 10:37:24 2012 New Revision: 2901 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2901 Log: Debugger - 2D display of debugged word instead of scrolling. Not perfect yet, but pretty good. Revert to old behavior with "true to scrolling-debug?" Modified: cpu/arm/kerncode.fth forth/lib/debug.fth forth/lib/decomp.fth forth/lib/objects.fth Modified: cpu/arm/kerncode.fth ============================================================================== --- cpu/arm/kerncode.fth Mon Mar 19 22:52:46 2012 (r2900) +++ cpu/arm/kerncode.fth Tue Mar 20 10:37:24 2012 (r2901) @@ -235,7 +235,7 @@ \rel ldrvc r0,[ip] \rel addvc ip,ip,r0 \abs ldrvc ip,[ip] - ldrvc pc,[ip],1cell + nxtvc inc rp,3cells inc ip,1cell c; @@ -248,7 +248,7 @@ \rel ldrvc r0,[ip] \rel addvc ip,ip,r0 \abs ldrvc ip,[ip] - ldrvc pc,[ip],1cell + nxtvc inc rp,3cells inc ip,1cell c; @@ -270,7 +270,7 @@ \rel ldreq r0,[ip] \rel addeq ip,ip,r0 \abs ldreq ip,[ip] - ldreq pc,[ip],1cell + nxteq ( r: loop-end-offset l+0x8000 i-l-0x8000 ) psh ip,rp \ save the do offset address inc ip,1cell @@ -312,7 +312,7 @@ code (?leave) ( f -- ) cmp tos,#0 pop tos,sp - ldreq pc,[ip],1cell + nxteq inc rp,2cells \ get rid of the loop indices ldr ip,[rp],1cell \rel ldr r0,[ip] \ branch @@ -665,7 +665,7 @@ \ ldmia sp!,{r0,r2} \ mov tos,#0 \ cmp r2,r0 -\ ldrlt pc,[ip],1cell +\ nxtlt \ cmp r2,r1 \ mvnle tos,#0 \ c; @@ -936,6 +936,15 @@ -rot >>a or ( low2 r: high2 ) r> ( d2 ) ; +: du* ( d1 u -- d2 ) \ Double result + tuck u* >r ( d1.lo u r: d2.hi ) + um* r> + ( d2 ) +; +: du*t ( ud.lo ud.hi u -- res.lo res.mid res.hi ) \ Triple result + tuck um* 2>r ( ud.lo u r: res.mid0 res.hi0 ) + um* ( res.lo res.mid1 r: res.mid0 res.hi0 ) + 0 2r> d+ ( res.lo res.mid res.hi ) +; code fill ( adr cnt char -- ) orr r2,tos,tos,lsl #8 Modified: forth/lib/debug.fth ============================================================================== --- forth/lib/debug.fth Mon Mar 19 22:52:46 2012 (r2900) +++ forth/lib/debug.fth Tue Mar 20 10:37:24 2012 (r2901) @@ -26,6 +26,8 @@ only forth also definitions +false value scrolling-debug? + hex headerless variable slow-next? slow-next? off @@ -35,6 +37,7 @@ variable step? step? on variable res headers +false value first-time? : (debug) (s low-adr hi-adr -- ) unbug 1 cnt ! ip> ! <ip ! pnext slow-next? @ 0= if @@ -42,6 +45,7 @@ slow-next? on then step? on + true is first-time? ; headerless : 'unnest (s pfa -- pfa' ) @@ -51,7 +55,6 @@ <ip ! <ip @ ip> @ u>= if <ip @ 'unnest ip> ! then ; -false value first-time? headers \ Enter and leave the debugger forth definitions @@ -60,7 +63,7 @@ begin dup defer? while behavior repeat dup colon-cf? 0= abort" Not a colon definition" - >body dup 'unnest (debug) true is first-time? + >body dup 'unnest (debug) ; \ Debug the caller : debug-me (s -- ) ip@ find-cfa (debug ; @@ -113,9 +116,21 @@ ." Q Quit: abandon execution of the debugged word" cr ; d# 24 constant cmd-column -0 value rp-mark : to-cmd-column ( -- ) cmd-column to-column ; +0 value stack-line +d# 50 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 ; +\ : 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 ; +: 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 @@ -150,9 +165,15 @@ ; : (trace ( -- ) first-time? if - ??cr - ip@ <ip @ = if ." : " else ." Inside " then - <ip @ find-cfa .name + scrolling-debug? if + ??cr + ip@ <ip @ = if ." : " else ." Inside " then + <ip @ find-cfa .name + else + ip@ debug-see + 0 is stack-line \ So the initial stack is displayed in the right place + cr + then 0 show-rstack ! false is first-time? rp@ is rp-mark @@ -160,24 +181,37 @@ begin step? @ if to-debug-window then save# - cmd-column 2+ to-column + 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 - ." )" cr + ." )" restore# - ['] noop is indent - ip@ .token drop \ Show word name - ['] (indent) is indent - to-cmd-column + scrolling-debug? if + cr + ['] noop is indent + ip@ .token drop \ Show word name + ['] (indent) is indent + to-cmd-column + else + ip@ ip-set-cursor + #line @ to stack-line + then step? @ key? or if step? on res off - key dup bl < if drop bl then dup emit upc + key dup bl < if drop bl then + scrolling-debug? if dup emit else to-result-loc then upc restore-window - reset-page + 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 @@ -206,6 +240,7 @@ then until restore# + scrolling-debug? 0= if to-result-loc then ip@ token@ dup ['] unnest = swap ['] exit = or if cr true is first-time? then Modified: forth/lib/decomp.fth ============================================================================== --- forth/lib/decomp.fth Mon Mar 19 22:52:46 2012 (r2900) +++ forth/lib/decomp.fth Tue Mar 20 10:37:24 2012 (r2901) @@ -54,9 +54,50 @@ defer (see) hidden definitions +d# 200 2* /n* constant /positions +/positions buffer: positions +0 value end-positions +\ 0 value line-after-; + +: init-positions ( -- ) positions is end-positions ; +: find-position ( ip -- true | adr false ) + end-positions positions ?do ( ip ) + i 2@ nip ( ip that-ip ) + over = if ( ip ) + drop i false ( adr false ) + unloop exit ( adr false -- ) + then ( ip ) + 2 /n* +loop ( ip ) + drop true ( true ) +; +0 value the-ip +: add-position ( ip -- ) + the-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! ( ) +; +: ip>position ( ip -- true | #out #line false ) + find-position if ( ) + true ( true ) + else ( adr ) + 2@ drop lwsplit ( #out #line ) + false ( #out #line false ) + then ( true | #out #line false ) +; +: ip-set-cursor ( ip -- ) + ip>position 0= if at-xy then +; + headerless \ Like ." but goes to a new line if needed. -: cr". ( adr len -- ) dup ?line magenta-letters type cancel ; +: cr". ( adr len -- ) + dup ?line ( adr len ) + add-position ( adr len ) + magenta-letters type cancel ( ) +; : .." ( -- ) [compile] " compile cr". ; immediate \ Positional case defining word @@ -103,13 +144,14 @@ defer disassemble ' nulldis is disassemble headerless + \ Breaks is a list of places in a colon definition where control \ is transferred without there being a branch nearby. \ Each entry has two items: the address and a number which indicates \ what kind of branch target it is (either a begin, for backward branches, \ a then, for forward branches, or an exit. -80 /n* constant /breaks +d# 40 2* /n* constant /breaks /breaks buffer: breaks variable end-breaks @@ -185,7 +227,7 @@ : add-break ( break-address break-type -- ) end-breaks @ breaks /breaks + >= ( adr,type full? ) - abort" Decompiler internal table overlow" ( adr,type ) + abort" Decompiler table overflow" ( adr,type ) end-breaks @ breaks > if ( adr,type ) over end-breaks @ /n 2* - >r r@ 2@ ( adr,type adr prev-adr,type ) ['] .endof = -rot = and if ( adr,type ) @@ -280,7 +322,7 @@ dup immediate? if .." [compile] " then ; -: put" (s -- ) ascii " emit space ; +: put" (s -- ) ascii " emit space ; : cword-name (s ip -- ip' $ name$ ) dup token@ ( ip acf ) @@ -294,24 +336,41 @@ 2 pick over + 3 + ?line ( $ name$ ) \ Keep word and string on the same line cr". space ( $ ) red-letters type ( ) - .." "" " ( ) + magenta-letters ( ) + ." "" " ( ) + cancel ( ) +; + +: pretty-. ( n -- ) + base @ d# 10 = if (.) else (u.) then ( adr len ) + dup ?line add-position + green-letters type cancel space +; + +: .compiled ( ip -- ip' ) + dup token@ check-[compile] ( ip xt ) + >name name>string ( ip adr len ) + type space ( ip ) + ta1+ ( ip' ) +; +: .word ( ip -- ip' ) + dup token@ check-[compile] ( ip xt ) + >name name>string ( ip adr len ) + dup ?line add-position ( ip adr len ) + type space ( ip ) + ta1+ ( ip' ) ; - -: pretty-n. ( n -- ) green-letters n. cancel ; -: pretty-. ( n -- ) green-letters . cancel ; - -: .word ( ip -- ip' ) dup token@ check-[compile] ?cr .name ta1+ ; : skip-word ( ip -- ip' ) ta1+ ; -: .inline ( ip -- ip' ) ta1+ dup unaligned-@ pretty-n. na1+ ; +: .inline ( ip -- ip' ) ta1+ dup unaligned-@ pretty-. na1+ ; : skip-inline ( ip -- ip' ) ta1+ na1+ ; : .wlit ( ip -- ip' ) ta1+ dup unaligned-w@ 1- pretty-. wa1+ ; : skip-wlit ( ip -- ip' ) ta1+ wa1+ ; : .llit ( ip -- ip' ) ta1+ dup unaligned-l@ 1- pretty-. la1+ ; : skip-llit ( ip -- ip' ) ta1+ la1+ ; -: .dlit ( ip -- ip' ) ta1+ dup d@ (d.) green-letters type ." . " cancel 2 na+ ; +: .dlit ( ip -- ip' ) ta1+ dup d@ (d.) add-position green-letters type ." . " cancel 2 na+ ; : skip-dlit ( ip -- ip' ) ta1+ 2 na+ ; : skip-branch ( ip -- ip' ) +branch ; -: .compile ( ip -- ip' ) .." compile " ta1+ .word ; +: .compile ( ip -- ip' ) .." compile " ta1+ .compiled ; : skip-compile ( ip -- ip' ) ta1+ ta1+ ; : skip-string ( ip -- ip' ) ta1+ +str ; : skip-nstring ( ip -- ip' ) ta1+ +nstr ; @@ -436,8 +495,10 @@ : .token ( ip -- ip' ) dup token@ execution-class .execution-class ; \ Decompile the parameter field of colon definition : .pf ( apf -- ) + 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 ) begin ( adr ) break-type @ execute ( adr ) @@ -460,23 +521,28 @@ : dump-body ( pfa -- ) push-hex - dup @ pretty-n. 2 spaces 8 emit.ln + dup @ pretty-. 2 spaces 8 emit.ln pop-base ; \ Display category of word : .: ( acf definer -- ) .definer space space >body .pf ; -: .constant ( acf definer -- ) over >data @ pretty-n. .definer drop ; -: .2constant ( acf definer -- ) over >data dup @ pretty-n. na1+ @ pretty-n. .definer drop ; +: debug-see ( apf -- ) + page-mode? >r no-page + d# 48 rmargin ! find-cfa ['] : page .: + r> is page-mode? +; +: .constant ( acf definer -- ) over >data @ pretty-. .definer drop ; +: .2constant ( acf definer -- ) over >data dup @ pretty-. na1+ @ pretty-. .definer drop ; : .vocabulary ( acf definer -- ) .definer drop ; : .code ( acf definer -- ) .definer >code disassemble ; : .variable ( acf definer -- ) - over >data n. .definer ." value = " >data @ pretty-n. + over >data n. .definer ." value = " >data @ pretty-. ; : .create ( acf definer -- ) over >body n. .definer ." value = " >body dump-body ; : .user ( acf definer -- ) - over >body @ n. .definer ." value = " >data @ pretty-n. + over >body @ n. .definer ." value = " >data @ pretty-. ; : .defer ( acf definer -- ) .definer ." is " cr >data token@ (see) @@ -485,7 +551,7 @@ .definer >body token@ .name ; : .value ( acf definer -- ) - swap >data @ pretty-n. .definer + swap >data @ pretty-. .definer ; @@ -560,7 +626,7 @@ \ top level of the decompiler SEE : ((see ( acf -- ) - td 64 rmargin ! + d# 48 rmargin ! dup dup definer dup definition-class .definition-class .immediate ??cr Modified: forth/lib/objects.fth ============================================================================== --- forth/lib/objects.fth Mon Mar 19 22:52:46 2012 (r2900) +++ forth/lib/objects.fth Tue Mar 20 10:37:24 2012 (r2901) @@ -138,8 +138,12 @@ \ if it happens to be near the end of a line. [ifdef] install-decomp -: .action ( ip -- ip' ) dup token@ .name ta1+ dup token@ .name ta1+ ; also hidden also +: .action ( ip -- ip' ) + d# 15 ?line \ Just a guess + dup token@ >name name>string cr". space ta1+ + .compiled +; ' to ' .action ' skip-(') install-decomp ' addr ' .action ' skip-(') install-decomp previous previous

1 0

[commit] r2900 - cpu/x86/pc/olpc/via
by repository service March 19, 2012

March 19, 2012

Author: quozl Date: Mon Mar 19 22:52:46 2012 New Revision: 2900 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2900 Log: OLPC - add fs-resize, no change to fs-update, fs-resize enlarges the second partition to fill remaining space on eMMC or microSD, may be followed up with manual use of "resize2fs /dev/mmcblk0p2", does not require initramfs or olpc-os-builder support. #11690 Modified: cpu/x86/pc/olpc/via/fsupdate.fth Modified: cpu/x86/pc/olpc/via/fsupdate.fth ============================================================================== --- cpu/x86/pc/olpc/via/fsupdate.fth Mon Mar 19 21:05:21 2012 (r2899) +++ cpu/x86/pc/olpc/via/fsupdate.fth Mon Mar 19 22:52:46 2012 (r2900) @@ -93,6 +93,41 @@ fexit ; +h# 1be. 2value pt \ device byte offset to start of partition table +h# 10 value /pe \ size of a partition entry +/pe buffer: pe \ partition entry buffer + +: pe-seek ( partition# -- ) + 1- /pe * 0 pt d+ ( d.pos ) + " seek" nandih $call-method drop ( ) +; + +: pe-read ( partition# -- ) pe-seek pe /pe " read" nandih $call-method drop ; +: pe-write ( partition# -- ) pe-seek pe /pe " write" nandih $call-method drop ; + +: pe-start@ ( pe -- start ) pe h# 08 + le-l@ ; +: pe-length@ ( pe -- length ) pe h# 0c + le-l@ ; +: pe-length! ( length pe -- ) pe h# 0c + le-l! ; + +: pe-is-set? ( partition# -- flag ) pe-read pe-start@ pe-length@ or ; + +: (resize:) ( -- ) + 4 pe-is-set? abort" partition 4 is non-zero" + 3 pe-is-set? abort" partition 3 is non-zero" + " size" nandih $call-method d# 512 um/mod swap drop + ( d-end ) + 2 pe-read ( d-end ) + pe-start@ dup >r ( d-end p-start ) ( r: p-start ) + pe-length@ + swap ( p-end d-end ) ( r: p-start ) + 2dup > abort" partition ends beyond device size" + 2dup < if ( p-end d-end ) ( r: p-start ) + nip r> - pe-length! ( ) ( r: ) + 2 pe-write ( ) ( r: ) + else ( p-end d-end ) ( r: p-start ) + r> 3drop ( ) ( r: ) + then ( ) ( r: ) +; + : data: ( "filename" -- ) safe-parse-word ( filename$ ) nb-zd-#sectors -1 <> if ( filename$ ) @@ -243,6 +278,12 @@ safe-parse-word $fs-update ; +: fs-resize ( -- ) + open-nand + [ also nand-commands ] (resize:) [ previous ] + close-nand +; + : do-fs-update ( img$ -- ) tuck load-base h# c00000 + swap move ( len ) load-base h# c00000 + swap ( adr len )

1 0

[commit] r2899 - cpu/arm/mmp2 cpu/arm/olpc cpu/x86/pc/lxdevel cpu/x86/pc/neptune cpu/x86/pc/olpc cpu/x86/pc/olpc/via forth/kernel forth/lib ofw/core
by repository service March 19, 2012

March 19, 2012

Author: wmb Date: Mon Mar 19 21:05:21 2012 New Revision: 2899 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2899 Log: Eliminated the last vestiges of the long-obsolete p" format. Modified: cpu/arm/mmp2/fw.bth cpu/arm/olpc/prefw.fth cpu/x86/pc/lxdevel/fw.bth cpu/x86/pc/neptune/fw.bth cpu/x86/pc/olpc/fw.bth cpu/x86/pc/olpc/via/fw.bth forth/kernel/kernel.fth forth/lib/decomp.fth forth/lib/editcmd.fth ofw/core/ofwcore.fth Modified: cpu/arm/mmp2/fw.bth ============================================================================== --- cpu/arm/mmp2/fw.bth Mon Mar 19 20:46:09 2012 (r2898) +++ cpu/arm/mmp2/fw.bth Mon Mar 19 21:05:21 2012 (r2899) @@ -478,13 +478,6 @@ quit ; -\ This helps with TeraTerm, which sends ESC-O as the arrow key prefix -also hidden also keys-forth definitions -warning @ warning off -: esc-o key lastchar ! [""] esc-[ do-command ; -warning ! -previous previous definitions - tag-file @ fclose tag-file off .( --- Saving fw.dic ...) Modified: cpu/arm/olpc/prefw.fth ============================================================================== --- cpu/arm/olpc/prefw.fth Mon Mar 19 20:46:09 2012 (r2898) +++ cpu/arm/olpc/prefw.fth Mon Mar 19 21:05:21 2012 (r2899) @@ -218,13 +218,6 @@ [then] devalias nfs net//obp-tftp:last//nfs -\ This helps with TeraTerm, which sends ESC-O as the arrow key prefix -also hidden also keys-forth definitions -warning @ warning off -: esc-o key lastchar ! [""] esc-[ do-command ; -warning ! -previous previous definitions - \ GUI false value gui-safeboot? Modified: cpu/x86/pc/lxdevel/fw.bth ============================================================================== --- cpu/x86/pc/lxdevel/fw.bth Mon Mar 19 20:46:09 2012 (r2898) +++ cpu/x86/pc/lxdevel/fw.bth Mon Mar 19 21:05:21 2012 (r2899) @@ -488,13 +488,6 @@ " begin-select /display 3 my-space 4 + config-w! unselect" evaluate ; -\ This helps with TeraTerm, which sends ESC-O as the arrow key prefix -also hidden also keys-forth definitions -warning @ warning off -: esc-o key lastchar ! [""] esc-[ do-command ; -warning ! -previous previous definitions - .( --- Saving fw.dic ...) " fw.dic" $save-forth cr Modified: cpu/x86/pc/neptune/fw.bth ============================================================================== --- cpu/x86/pc/neptune/fw.bth Mon Mar 19 20:46:09 2012 (r2898) +++ cpu/x86/pc/neptune/fw.bth Mon Mar 19 21:05:21 2012 (r2899) @@ -438,13 +438,6 @@ quit ; -\ This helps with TeraTerm, which sends ESC-O as the arrow key prefix -also hidden also keys-forth definitions -warning @ warning off -: esc-o key lastchar ! [""] esc-[ do-command ; -warning ! -previous previous definitions - tag-file @ fclose tag-file off .( --- Saving fw.dic ...) Modified: cpu/x86/pc/olpc/fw.bth ============================================================================== --- cpu/x86/pc/olpc/fw.bth Mon Mar 19 20:46:09 2012 (r2898) +++ cpu/x86/pc/olpc/fw.bth Mon Mar 19 21:05:21 2012 (r2899) @@ -659,13 +659,6 @@ fload ${BP}/cpu/x86/pc/olpc/diskspeed.fth \ Mass storage speed test -\ This helps with TeraTerm, which sends ESC-O as the arrow key prefix -also hidden also keys-forth definitions -warning @ warning off -: esc-o key lastchar ! [""] esc-[ do-command ; -warning ! -previous previous definitions - tag-file @ fclose tag-file off .( --- Saving fw.dic ...) Modified: cpu/x86/pc/olpc/via/fw.bth ============================================================================== --- cpu/x86/pc/olpc/via/fw.bth Mon Mar 19 20:46:09 2012 (r2898) +++ cpu/x86/pc/olpc/via/fw.bth Mon Mar 19 21:05:21 2012 (r2899) @@ -756,13 +756,6 @@ fload ${BP}/cpu/x86/pc/olpc/diskspeed.fth \ Mass storage speed test -\ This helps with TeraTerm, which sends ESC-O as the arrow key prefix -also hidden also keys-forth definitions -warning @ warning off -: esc-o key lastchar ! [""] esc-[ do-command ; -warning ! -previous previous definitions - tag-file @ fclose tag-file off .( --- Saving fw.dic ...) Modified: forth/kernel/kernel.fth ============================================================================== --- forth/kernel/kernel.fth Mon Mar 19 20:46:09 2012 (r2898) +++ forth/kernel/kernel.fth Mon Mar 19 21:05:21 2012 (r2899) @@ -367,35 +367,10 @@ get-escaped-string compile-string ; immediate -: [""] \ word (s Compile-time: -- ) - (s Run-time: -- pstr ) - compile (p") safe-parse-word ", -; immediate - -\ Obsolete -: ["] \ string" (s -- str ) - compile (p") ," -; immediate - : \ \ rest-of-line (s -- ) \ skips rest of line -1 parse 2drop ; immediate -: compile-pstring ( adr len -- ) - state @ if - compile (p") ", - else - switch-string "temp npack - then -; -: "" \ name ( -- pstr ) - safe-parse-word compile-pstring -; immediate - -: p" \ string" ( -- pstr ) - get-escaped-string compile-pstring -; immediate - : c" \ string" ( -- pstr ) ascii " parse compile-pstring ; immediate @@ -636,7 +611,6 @@ if skipstr $abort else skipstr 2drop then ; : ?throw ( flag throw-code -- ) swap if throw else drop then ; -: (p") (s -- str-addr ) skipstr ( addr len ) drop 1- ; nuser 'lastacf \ acf of latest definition : lastacf ( -- acf ) 'lastacf token@ ; Modified: forth/lib/decomp.fth ============================================================================== --- forth/lib/decomp.fth Mon Mar 19 20:46:09 2012 (r2898) +++ forth/lib/decomp.fth Mon Mar 19 21:05:21 2012 (r2899) @@ -351,7 +351,7 @@ ( 14 ) [compile] exit ( 15 ) [compile] (wlit) ( 16 ) [compile] (') ( 17 ) [compile] (of) ( 18 ) [compile] (endof) ( 19 ) [compile] (endcase) - ( 20 ) [compile] (p") ( 21 ) [compile] (is) + ( 20 ) [compile] dummy ( 21 ) [compile] (is) ( 22 ) [compile] (dlit) ( 23 ) [compile] (llit) ( 24 ) [compile] (n") ( 25 ) [compile] isdefer ( 26 ) [compile] isuser ( 27 ) [compile] isvalue @@ -372,7 +372,7 @@ ( 14 ) .unnest ( 15 ) .wlit ( 16 ) .(') ( 17 ) .of ( 18 ) .endof ( 19 ) .endcase - ( 20 ) .string ( 21 ) .is + ( 20 ) dummy ( 21 ) .is ( 22 ) .dlit ( 23 ) .llit ( 24 ) .nstring ( 25 ) .is ( 26 ) .is ( 27 ) .is Modified: forth/lib/editcmd.fth ============================================================================== --- forth/lib/editcmd.fth Mon Mar 19 20:46:09 2012 (r2898) +++ forth/lib/editcmd.fth Mon Mar 19 21:05:21 2012 (r2899) @@ -40,8 +40,8 @@ nuser lastchar \ most-recently-typed character nuser beforechar \ next most-recently-typed character -: do-command ( prefix-string -- ) - name-buf "copy +: do-command ( prefix$ -- ) + name-buf place name-buf lastchar @ add-char-to-name name-buf count keys token@ search-wordlist ( false | cfa true ) if catch drop else not-found then @@ -67,7 +67,7 @@ lastchar @ dup bl h# 7e between swap h# a0 h# fe between or - if lastchar @ printable-char else nullstring do-command then + if lastchar @ printable-char else " " do-command then redisplay finished @ until close-display @@ -182,8 +182,9 @@ : ^x finished on ; \ XXX for testing on systems where ^C is magic : ^y yank ; -: ^{ key lastchar ! [""] esc- do-command ; -: esc-o only forth also definitions beep beep beep ; +: ^{ key lastchar ! " esc-" do-command ; + +: esc-v only forth also definitions beep beep beep ; \ Reset search order : esc-h erase-previous-word ; : esc-d erase-next-word ; : esc-f forward-word ; @@ -195,7 +196,8 @@ : esc-del erase-next-word ; \ ANSI cursor keys -: esc-[ key lastchar ! [""] esc-[ do-command ; +: esc-[ key lastchar ! " esc-[" do-command ; +: esc-o key lastchar ! " esc-[" do-command ; \ TeraTerm uses esc-o as the arrow prefix : esc-[A previous-line ; : esc-[B next-line ; : esc-[C forward-character ; Modified: ofw/core/ofwcore.fth ============================================================================== --- ofw/core/ofwcore.fth Mon Mar 19 20:46:09 2012 (r2898) +++ ofw/core/ofwcore.fth Mon Mar 19 21:05:21 2012 (r2899) @@ -2370,7 +2370,7 @@ ; : (open-node) ( -- ) "open" (apply-method) 0= if ( okay? ) - close-chain p" open failed" throw ( ) + close-chain true abort" open failed" ( ) then ; : open-node ( -- ) recursive

1 0

[commit] r2898 - in forth: kernel lib
by repository service March 19, 2012

March 19, 2012

Author: wmb Date: Mon Mar 19 20:46:09 2012 New Revision: 2898 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2898 Log: Colorized the decompiler output. Modified: forth/kernel/kernel.fth forth/lib/decomp.fth Modified: forth/kernel/kernel.fth ============================================================================== --- forth/kernel/kernel.fth Sat Mar 17 02:51:04 2012 (r2897) +++ forth/kernel/kernel.fth Mon Mar 19 20:46:09 2012 (r2898) @@ -369,12 +369,12 @@ : [""] \ word (s Compile-time: -- ) (s Run-time: -- pstr ) - compile ("s) safe-parse-word ", + compile (p") safe-parse-word ", ; immediate \ Obsolete : ["] \ string" (s -- str ) - compile ("s) ," + compile (p") ," ; immediate : \ \ rest-of-line (s -- ) \ skips rest of line @@ -383,7 +383,7 @@ : compile-pstring ( adr len -- ) state @ if - compile ("s) ", + compile (p") ", else switch-string "temp npack then @@ -636,7 +636,7 @@ if skipstr $abort else skipstr 2drop then ; : ?throw ( flag throw-code -- ) swap if throw else drop then ; -: ("s) (s -- str-addr ) skipstr ( addr len ) drop 1- ; +: (p") (s -- str-addr ) skipstr ( addr len ) drop 1- ; nuser 'lastacf \ acf of latest definition : lastacf ( -- acf ) 'lastacf token@ ; Modified: forth/lib/decomp.fth ============================================================================== --- forth/lib/decomp.fth Sat Mar 17 02:51:04 2012 (r2897) +++ forth/lib/decomp.fth Mon Mar 19 20:46:09 2012 (r2898) @@ -56,7 +56,7 @@ hidden definitions headerless \ Like ." but goes to a new line if needed. -: cr". ( adr len -- ) dup ?line type ; +: cr". ( adr len -- ) dup ?line magenta-letters type cancel ; : .." ( -- ) [compile] " compile cr". ; immediate \ Positional case defining word @@ -280,28 +280,38 @@ dup immediate? if .." [compile] " then ; -: put" (s -- ) ascii " emit space ; +: put" (s -- ) ascii " emit space ; -: .cword (s ip -- ip' ) \ Display run-time word, e.g. (is) sans '()' - dup token@ ?cr ( ip acf ) - >name name>string ( ip adr len ) - swap 1+ swap 2 - type space ( ip ) \ Remove parentheses - ta1+ +: cword-name (s ip -- ip' $ name$ ) + dup token@ ( ip acf ) + >name name>string ( ip name$ ) + swap 1+ swap 2 - ( ip name$' ) \ Remove parentheses + rot ta1+ -rot ( ip' name$ ) + 2 pick count ( ip name$ $ ) + 2swap ( ip $ name$ ) +; +: .string-tail ( $ name$ -- ) + 2 pick over + 3 + ?line ( $ name$ ) \ Keep word and string on the same line + cr". space ( $ ) + red-letters type ( ) + .." "" " ( ) ; + +: pretty-n. ( n -- ) green-letters n. cancel ; +: pretty-. ( n -- ) green-letters . cancel ; + : .word ( ip -- ip' ) dup token@ check-[compile] ?cr .name ta1+ ; : skip-word ( ip -- ip' ) ta1+ ; -: .inline ( ip -- ip' ) ta1+ dup unaligned-@ n. na1+ ; +: .inline ( ip -- ip' ) ta1+ dup unaligned-@ pretty-n. na1+ ; : skip-inline ( ip -- ip' ) ta1+ na1+ ; -: .wlit ( ip -- ip' ) ta1+ dup unaligned-w@ 1- . wa1+ ; +: .wlit ( ip -- ip' ) ta1+ dup unaligned-w@ 1- pretty-. wa1+ ; : skip-wlit ( ip -- ip' ) ta1+ wa1+ ; -: .llit ( ip -- ip' ) ta1+ dup unaligned-l@ 1- . la1+ ; +: .llit ( ip -- ip' ) ta1+ dup unaligned-l@ 1- pretty-. la1+ ; : skip-llit ( ip -- ip' ) ta1+ la1+ ; -: .dlit ( ip -- ip' ) ta1+ dup d@ (d.) type ." . " 2 na+ ; +: .dlit ( ip -- ip' ) ta1+ dup d@ (d.) green-letters type ." . " cancel 2 na+ ; : skip-dlit ( ip -- ip' ) ta1+ 2 na+ ; : skip-branch ( ip -- ip' ) +branch ; -: .quote ( ip -- ip' ) .word .word ; -: skip-quote ( ip -- ip' ) ta1+ ta1+ ; -: .compile ( ip -- ip' ) ." compile " ta1+ .word ; +: .compile ( ip -- ip' ) .." compile " ta1+ .word ; : skip-compile ( ip -- ip' ) ta1+ ta1+ ; : skip-string ( ip -- ip' ) ta1+ +str ; : skip-nstring ( ip -- ip' ) ta1+ +nstr ; @@ -309,11 +319,9 @@ headers : skip-(') ( ip -- ip' ) ta1+ ta1+ ; headerless -: .is ( ip -- ip' ) ." to " ta1+ dup token@ .name ta1+ ; -: .string-tail ( ip -- ip' ) dup count type +str ; -: .string ( ip -- ip' ) .cword .string-tail put" ; -: .pstring ( ip -- ip' ) ?cr ." p" put" ta1+ .string-tail put" ; -: .nstring ( ip -- ip' ) ?cr put" ta1+ dup ncount type +nstr put" ; +: .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 ; \ Use this version of .branch if the structured conditional code is not used \ : .branch ( ip -- ip' ) .word dup <w@ . /branch + ; @@ -325,7 +333,6 @@ .." exit " ta1+ then ; - : dummy ; \ classify each word in a definition @@ -344,7 +351,7 @@ ( 14 ) [compile] exit ( 15 ) [compile] (wlit) ( 16 ) [compile] (') ( 17 ) [compile] (of) ( 18 ) [compile] (endof) ( 19 ) [compile] (endcase) - ( 20 ) [compile] ("s) ( 21 ) [compile] (is) + ( 20 ) [compile] (p") ( 21 ) [compile] (is) ( 22 ) [compile] (dlit) ( 23 ) [compile] (llit) ( 24 ) [compile] (n") ( 25 ) [compile] isdefer ( 26 ) [compile] isuser ( 27 ) [compile] isvalue @@ -365,7 +372,7 @@ ( 14 ) .unnest ( 15 ) .wlit ( 16 ) .(') ( 17 ) .of ( 18 ) .endof ( 19 ) .endcase - ( 20 ) .pstring ( 21 ) .is + ( 20 ) .string ( 21 ) .is ( 22 ) .dlit ( 23 ) .llit ( 24 ) .nstring ( 25 ) .is ( 26 ) .is ( 27 ) .is @@ -447,36 +454,38 @@ : .immediate ( acf -- ) immediate? if .." immediate" then ; -: .definer ( acf definer-acf -- acf ) .name dup .name ; +: .definer ( acf definer-acf -- acf ) + magenta-letters .name dup blue-letters .name cancel +; : dump-body ( pfa -- ) push-hex - dup @ n. 2 spaces 8 emit.ln + dup @ pretty-n. 2 spaces 8 emit.ln pop-base ; \ Display category of word : .: ( acf definer -- ) .definer space space >body .pf ; -: .constant ( acf definer -- ) over >data ? .definer drop ; -: .2constant ( acf definer -- ) over >data dup ? na1+ ? .definer drop ; +: .constant ( acf definer -- ) over >data @ pretty-n. .definer drop ; +: .2constant ( acf definer -- ) over >data dup @ pretty-n. na1+ @ pretty-n. .definer drop ; : .vocabulary ( acf definer -- ) .definer drop ; : .code ( acf definer -- ) .definer >code disassemble ; : .variable ( acf definer -- ) - over >data n. .definer .." value = " >data ? + over >data n. .definer ." value = " >data @ pretty-n. ; : .create ( acf definer -- ) - over >body n. .definer .." value = " >body dump-body + over >body n. .definer ." value = " >body dump-body ; : .user ( acf definer -- ) - over >body ? .definer .." value = " >data ? + over >body @ n. .definer ." value = " >data @ pretty-n. ; : .defer ( acf definer -- ) - .definer .." is " cr >data token@ (see) + .definer ." is " cr >data token@ (see) ; : .alias ( acf definer -- ) .definer >body token@ .name ; : .value ( acf definer -- ) - swap >data ? .definer + swap >data @ pretty-n. .definer ; @@ -487,7 +496,6 @@ .definer >body ." (Body: " dump-body ." ) " cr ; - \ Classify a word based on its acf alias isalias noop create iscreate

1 0

[commit] r2897 - in cpu/arm: mmp2 olpc
by repository service March 17, 2012

March 17, 2012

Author: quozl Date: Sat Mar 17 02:51:04 2012 New Revision: 2897 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2897 Log: OLPC - stack effect comment fixes Modified: cpu/arm/mmp2/hash.fth cpu/arm/olpc/rtc.fth Modified: cpu/arm/mmp2/hash.fth ============================================================================== --- cpu/arm/mmp2/hash.fth Fri Mar 16 23:18:06 2012 (r2896) +++ cpu/arm/mmp2/hash.fth Sat Mar 17 02:51:04 2012 (r2897) @@ -69,7 +69,7 @@ 0 to #hash-buf then ; -: hash-update ( adr len -- adr' len' ) +: hash-update ( adr len -- ) dup #hashed + to #hashed ( adr len ) begin dup while ( adr len ) 2dup /hash-block #hash-buf - min ( adr len adr this ) Modified: cpu/arm/olpc/rtc.fth ============================================================================== --- cpu/arm/olpc/rtc.fth Fri Mar 16 23:18:06 2012 (r2896) +++ cpu/arm/olpc/rtc.fth Sat Mar 17 02:51:04 2012 (r2897) @@ -77,7 +77,7 @@ then get-time .date space .time cr get-time 2nip 2nip nip - d# 2011 < dup if ." Date in RTC is too early" cr then + d# 2011 < dup if ." Date in RTC is too early" cr then ( -- flag ) close ;

1 0

[commit] r2896 - cpu/arm/olpc
by repository service March 16, 2012

March 16, 2012

Author: wmb Date: Fri Mar 16 23:18:06 2012 New Revision: 2896 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2896 Log: OLPC XO-1.75 - trac #11704 - Raydium touchscreen driver - calibrate touchscreen during selftest and don't hang indefinitely if the touchscreen is spewing events. Modified: cpu/arm/olpc/exc7200-touchscreen.fth cpu/arm/olpc/rm3150-touchscreen.fth cpu/arm/olpc/touchscreen-common.fth Modified: cpu/arm/olpc/exc7200-touchscreen.fth ============================================================================== --- cpu/arm/olpc/exc7200-touchscreen.fth Fri Mar 16 02:04:15 2012 (r2895) +++ cpu/arm/olpc/exc7200-touchscreen.fth Fri Mar 16 23:18:06 2012 (r2896) @@ -53,6 +53,7 @@ begin pad? if . . . . . cr then key? until + key drop ; : track ( x y z down? contact# -- ) Modified: cpu/arm/olpc/rm3150-touchscreen.fth ============================================================================== --- cpu/arm/olpc/rm3150-touchscreen.fth Fri Mar 16 02:04:15 2012 (r2895) +++ cpu/arm/olpc/rm3150-touchscreen.fth Fri Mar 16 23:18:06 2012 (r2896) @@ -95,6 +95,9 @@ ; : discard-n ( .. #events -- ) 5 * 0 ?do drop loop ; +\ Needs 2 seconds of no-touch +: calibrate ( -- ) h# 20 0 ts-b! ; + : selftest ( -- error? ) open 0= if \ ." Touchscreen open failed" true exit @@ -104,7 +107,12 @@ \ Being able to open the touchpad is good enough in SMT mode smt-test? if close false exit then - final-test? 0= if + calibrate \ Needs 2 seconds of no-touch + + targets? if + ." Calibrating touchscreen" cr + d# 2000 ms + else ." Touchscreen test will start in 4 seconds" cr d# 4000 ms then @@ -115,7 +123,10 @@ begin key? while key drop repeat \ Consume already-queued trackpad events to prevent premature exit - begin pad-events ?dup while discard-n repeat + d# 100 0 do + pad-events ?dup 0= if leave then ( .. #events ) + discard-n ( ) + loop background begin Modified: cpu/arm/olpc/touchscreen-common.fth ============================================================================== --- cpu/arm/olpc/touchscreen-common.fth Fri Mar 16 02:04:15 2012 (r2895) +++ cpu/arm/olpc/touchscreen-common.fth Fri Mar 16 23:18:06 2012 (r2896) @@ -143,8 +143,6 @@ pixcolor ! ; -: handle-key ( -- exit? ) true ; - false value selftest-failed? \ Success/failure flag for final test mode : exit-test? ( -- flag ) targets? if ( ) @@ -165,7 +163,7 @@ then ( ) \ If not final test mode, we only exit via a key - no targets - key? if handle-key else false then ( exit ? ) + key? dup if key drop then ( exit? ) ; 0 value pressure

1 0

[commit] r2895 - cpu/arm/mmp2
by repository service March 16, 2012

March 16, 2012

Author: wmb Date: Fri Mar 16 02:04:15 2012 New Revision: 2895 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2895 Log: ARM MMP2 timer driver - removed some dead code. Modified: cpu/arm/mmp2/timer.fth Modified: cpu/arm/mmp2/timer.fth ============================================================================== --- cpu/arm/mmp2/timer.fth Fri Mar 16 02:02:28 2012 (r2894) +++ cpu/arm/mmp2/timer.fth Fri Mar 16 02:04:15 2012 (r2895) @@ -57,11 +57,6 @@ cmps tos,r0 = until c; -[else] -: timer0@ ( -- n ) 1 h# 0140a4 io! h# 0140a4 io@ drop h# 0140a4 io@ ; -: timer1@ ( -- n ) 1 h# 0140a8 io! h# 0140a8 io@ drop h# 0140a8 io@ ; -: timer2@ ( -- n ) 1 h# 0140ac io! h# 0140ac io@ drop h# 0140ac io@ ; -[then] : timer0-status@ ( -- n ) h# 014034 io@ ; : timer1-status@ ( -- n ) h# 014038 io@ ;

1 0