Author: wmb Date: 2007-09-20 00:17:59 +0200 (Thu, 20 Sep 2007) New Revision: 629
Modified: cpu/x86/pc/olpc/setwp.fth Log: OLPC manufacturing data - new "change-tag" and "add-tag" commands.
Modified: cpu/x86/pc/olpc/setwp.fth =================================================================== --- cpu/x86/pc/olpc/setwp.fth 2007-09-19 22:17:16 UTC (rev 628) +++ cpu/x86/pc/olpc/setwp.fth 2007-09-19 22:17:59 UTC (rev 629) @@ -32,10 +32,10 @@
\ Find RAM address of tag, given FLASH address : tag>ram-adr ( adr len -- ram-adr ) - drop 2+ ( adr' ) \ Address of "ww" tag + drop ( adr' ) \ Address of "ww" tag rom-pa mfg-data-offset + - ( offset )
- dup /flash-block u>= abort" Bad ww offset" \ Sanity check + dup /flash-block u>= abort" Bad tag offset" \ Sanity check
mfg-data-buf + ( ram-adr ) ; @@ -44,7 +44,8 @@ : mfg-data-setup ( tag$ -- ram-adr ) get-mfg-data 2dup find-tag 0= if ." No " type ." tag" cr abort then ( tag$ adr len ) - tag>ram-adr >r ( tag$ r: ram-adr ) + \ The 2+ below skips the length bytes to the tagname field + tag>ram-adr 2+ >r ( tag$ r: ram-adr ) r@ 2 $= 0= abort" Tag mismatch in RAM" ( r: ram-adr ) r> ; @@ -69,3 +70,66 @@ board-revision h# b48 < abort" Only supported on B4 and later" set-wp ; + +: ?tagname-valid ( tagname$ -- tagname$ ) + dup 2 <> abort" Tag name must be 2 characters long" +; +: tag-setup ( tagname$ -- ram-value$ ) + ?tagname-valid + get-mfg-data + 2dup find-tag 0= if ." No " type ." tag" cr abort then ( tagname$ value$ ) + 2nip ( value$ ) + tuck tag>ram-adr swap ( ram-value$ ) +; + +: value-mismatch? ( new-value$ old-value$ -- flag ) + dup if + \ non-empty old value string + 2dup + 1- c@ 0= if ( new-value$ old-value$ ) + \ Old value ends in null character; subtract that from the count + 1- ( new-value$ old-value$' ) + then ( new-value$ old-value$ ) + rot <> ( new-adr old-adr flag ) + nip nip ( old-len new-value$ ) + else ( new-value$ old-value$ ) + \ empty old value string; new one had better be empty too + 2drop 0<> nip ( flag ) + then +; + +: $change-tag ( value$ tagname$ -- ) + tag-setup ( new-value$ old-value$ ) + 2over 2over value-mismatch? abort" New value and old value have different lengths" + drop swap move ( ) + put-mfg-data +; + +: change-tag ( "tagname" "new-value" -- ) + safe-parse-word ( tagname$ ) + 0 parse ( tagname$ new-value$ ) + 2swap $change-tag +; + +: ram-last-mfg-data ( -- adr ) + mfg-data-buf /flash-block + last-mfg-data +; + +: $add-tag ( value$ name$ -- ) + ?tagname-valid ( value$ name$ ) + 2dup find-tag abort" Tagname already exists" ( value$ name$ ) + get-mfg-data + ram-last-mfg-data >r ( value$ name$ r: adr ) + 2 pick 1+ over + 3 + ( value$ name$ record-len r: adr ) + r@ over - mfg-data-buf u<= abort" Not enough space for new tag" + r@ over - swap ?erased ( value$ name$ r: adr ) + r@ 2- swap move ( value$ r: adr ) + dup 1+ dup r@ 3 - c! invert r@ 4 - c! ( value$ r: adr ) + 0 r@ 5 - c! ( value$ r: adr ) + r> 5 - over - ( value$ data-adr ) + swap move + put-mfg-data +; + +: add-tag ( "name$" "value$" -- ) + safe-parse-word 0 parse 2swap $add-tag +;