\ ========== Copyright Header Begin ==========================================
\ Hypervisor Software File: hashdevice.fth
\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
\ - Do no alter or remove copyright notices
\ - Redistribution and use of this software in source and binary forms, with
\ or without modification, are permitted provided that the following
\ - Redistribution of source code must retain the above copyright notice,
\ this list of conditions and the following disclaimer.
\ - Redistribution in binary form must reproduce the above copyright notice,
\ this list of conditions and the following disclaimer in the
\ documentation and/or other materials provided with the distribution.
\ Neither the name of Sun Microsystems, Inc. or the names of contributors
\ may be used to endorse or promote products derived from this software
\ without specific prior written permission.
\ This software is provided "AS IS," without a warranty of any kind.
\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES,
\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A
\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN
\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR
\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN
\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR
\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE
\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY,
\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF
\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
\ You acknowledge that this software is not designed, licensed or
\ intended for use in the design, construction, operation or maintenance of
\ ========== Copyright Header End ============================================
id: @(#)hashdevice.fth 1.15 06/10/11
copyright: Copyright 2006 Sun Microsystems, Inc. All Rights Reserved
copyright: Use is subject to license terms.
\ For any config-variable we create an entry in the options dictionary that
\ acf of the hash routine /token
\ optional default data ??
\ the hash entry is in another vocabulary and contains:
\ acf of the options routine /token
\ pointer to user space /l
\ the user space pointer points to a memory buffer in this format:
\ this makes the model very simple, if the user buffer is 0 then the device
\ is unbacked and has either no default, or is the default.
\ if the pointer is non-zero then it has been backed by data from the real
\ nv device and instead of using the dictionary as the backing (the default
\ case) we use the (user-pointer + (/l + 1 + 3))
\ The ref-count field is there for garbage collection.
\ A hash code with bit 31 clear marks that hash as deleted.
\ When the code starts it reads from the nvdevice and creates the memory
\ buffer for any hash codes it finds and copies the data from the device
\ into the memory, if more than 1 copy of a hash are in the device then
\ we release the prior allocated resources, reallocate and increment the
\ reference field. If any reference field exceeds some arbitrary value
\ then we will garbage collect.
\ Garbage collection is simple:
\ seek to offset 0 in the device
\ rewite the magic number
\ for each word in the hash vocabulary:
\ IF the user pointer is non zero AND
\ the acf of the config-variable isn't 'crash' THEN
\ write the data to the device
\ When you set an option the option is just appended onto the end of the
0 value nvgarbage-collect?
h# 8000.0000 constant valid-hash-mask
false value token-store-disabled? \ Disable backing store
: valid-hash? ( hash# -- flag ) valid-hash-mask and ;
create hash-primes d# 2971 w, d# 8747 w, d# 1031 w, d# 1151 w, d# 2861 w,
: create-nvhash ( str,len -- hash )
\nvdebug ." Hashing: " 2dup type ." = "
over c@ h# 5f and d# 6 lshift ( str,len mod )
over h# 1f and or valid-hash-mask or -rot ( mod str,len )
0 tuck ?do ( mod str hash )
over i + c@ ( mod str hash char )
hash-primes i 5 mod wa+ w@ * + ( mod str hash' )
lwsplit + ( mod str hash )
d# 12 lshift n->l ( mod hash' )
dup valid-hash-mask and if ( mod hash' )
abort" HASH/Valid Collision"
\ Compute a magic number.
\ The actual value used at runtime will include the size of the fixed
\ data region, and may include a platform dependant key.
" NVRAM magic" create-nvhash constant nvmagic-hash
nvmagic-hash value nvmagic#
: make-hash$ ( hash -- str len ) base @ >r hex <# u#s u#> r> base ! ;
: find-hash? ( hash -- acf,true | str,len, 0 )
make-hash$ ['] nvhash-keys $vfind ( acf,true | str,len, 0 )
: check-nvgarbage-collect ( ref -- )
4 > nvgarbage-collect? or to nvgarbage-collect?
: hash@ ( apf -- hash ) >hash unaligned-l@ ;
: hash! ( hash apf -- ) >hash unaligned-l! ;
: buffer@ ( apf -- ptr ) >buffer >user unaligned-l@ ;
: buffer! ( apf body -- ) >buffer >user unaligned-l! ;
: alloc-buffer ( len ref -- ptr )
>r /mem-data + dup alloc-mem ( len' mem )
tuck >alloc-size l! ( mem )
r> over >ref-count c! ( mem )
: release-buffer? ( apf -- ref )
dup buffer@ ?dup if ( apf mem )
dup >alloc-size l@ ( apf ptr len )
over >ref-count c@ ( apf ptr len ref )
-rot free-mem ( apf ref )
: simple-crc ( adr len seed -- crc )
wbsplit + -rot bounds ?do ( crc )
i c@ + wbsplit + ( crc' )
: load-token-data ( apf -- )
\nvdebug ." ----> Loading: " dup hash@ .x
nvbuffer dup 3 nvoption-read dup c@ >r ( apf adr ) ( r: crc )
1+ unaligned-w@ ( apf nlen )
\nvdebug ." CRC: " nvbuffer c@ .x
\nvdebug ." LEN: " dup .x
over release-buffer? ( apf nlen ref )
2dup 1+ alloc-buffer ( apf nlen ref mem )
swap check-nvgarbage-collect ( apf nlen mem )
swap >r ( apf mem ) ( r: crc nlen )
>data r> 2dup nvoption-read ( mem apf adr nlen ) ( r: crc )
\nvdebug ." Data: " 2dup dump
tuck dup simple-crc r> ( mem apf nlen crc' crc ) ( r: )
\nvdebug 2dup xor if ." BAD CRC" cr then
rot swap free-mem ( apf )
cmn-error[ " Invalid token '" cmn-append token@ ( token )
>name name>string type cmn-append " '" ]cmn-end ( )
: write-4bytes ( data -- ) nvbuffer tuck l! /l nvoption-write ;
: write-2bytes ( data -- ) nvbuffer tuck w! /w nvoption-write ;
: write-1byte ( data -- ) nvbuffer tuck c! 1 nvoption-write ;
nvoption-ftell -1 write-4bytes nvoption-seek
dup if 7 + else drop 4 then ( len' )
nvoption-size over 4 + - > throw ( )
\ A record is at least 7 bytes long; (hash:4, crc:1, len:2, data:len)
\ but to complete a device update you need an EOF marker of 4 bytes
: (write-record) ( adr len hash -- )
over check-space ( str len hash )
2dup dup simple-crc write-1byte ( str len )
dup write-2bytes ( str len )
?dup if nvoption-write else drop then ( )
: get-token-data ( apf -- adr,len )
\nvdebug ." getting token data '" dup token@ >name name>string type ." ' "
dup buffer@ dup if ( adr ptr )
nip dup >data ( ptr mem )
swap >alloc-size l@ /mem-data - ( mem len )
\ Write the magic number to indicate the nvdevice is valid.
\ We include the size of the fixed-data-region to ensure that changes in
\ the fixed region size will cause a re-init of the device - This makes
\ it safe to upgrade and downgrade OBPs that have different sized fixed
\ regions. This should also be a very rare event!
nvmagic# write-4bytes ( )
: ((garbage-collect)) ( -- )
\nvdebug1 ." garbage collecting" cr
write-magic ( alf voc-acf )
0 ['] nvhash-keys ( alf voc-acf )
begin another-word? while ( alf voc-acf anf )
name> ( alf voc-acf acf )
dup >body >option token@ ( alf voc-acf acf acf )
\nvdebug1 dup >name name>string ( alf voc-acf acf str,len )
\nvdebug1 ." Writing: " type space ( alf voc-acf acf )
['] crash <> >r ( alf voc-acf acf )
dup execute r> over and if ( alf voc-acf acf adr,len )
\nvdebug1 dup .x ." bytes, "
rot ( alf voc-acf adr len acf )
\nvdebug1 ." Hash: " dup >body hash@ .x cr
>body dup >r hash@ (write-record) ( alf voc-acf )
0 r> buffer@ >ref-count c! ( alf voc-acf )
else ( alf voc-acf acf adr len )
\nvdebug1 ." No data!" cr
0 to nvgarbage-collect? ( -- )
\nvdebug1 ." done - " nvoption-size .x ." bytes available" cr
: (garbage-collect) ['] ((garbage-collect)) catch drop ;
: write-record ( adr len hash -- )
nvoption-ftell nvbuffer /l nvoption-read nvoption-seek
nvbuffer l@ l->n -1 <> if ( adr len hash )
\ The device somehow got out of step as the EOF marker isn't at
\ the right point. About all we can do is garbage collect and
(garbage-collect) ( adr len hash )
: garbage-collect ( -- ) nvgarbage-collect? if (garbage-collect) then ;
: (delete-this-token) ( apf -- )
\nvdebug ." deleting token '" dup token@ >name name>string type ." ' "
dup release-buffer? drop ( apf )
token-store-disabled? 0= if ( apf )
hash@ h# 7fff.ffff and ( hash' )
write-4bytes write-eof ( )
: delete-this-token ( apf -- )
dup ['] (delete-this-token) catch if ( apf ?? )
drop (garbage-collect) ( apf )
['] (delete-this-token) catch if drop then ( -- )
: (set-token-data) ( data len apf -- )
\nvdebug ." setting token data '" dup token@ >name name>string type ." ' "
dup >r buffer@ ?dup if ( adr len mem )
\nvdebug ." free existing resource, "
dup >ref-count c@ ( adr len mem ref )
dup check-nvgarbage-collect ( adr len mem ref )
swap dup >alloc-size l@ ( adr len ref mem alloc'd )
free-mem 1+ ( adr len ref )
0 r@ buffer! ( adr len ref )
token-store-disabled? 0= if ( ref adr len )
2dup r@ hash@ write-record ( ref adr len )
\nvdebug ." alloc resource"
rot over swap ( adr len len ref )
alloc-buffer ( adr len mem )
dup r> buffer! ( adr len mem )
\nvdebug ." 0 len.. using no resources"
0 r> buffer! 2drop ( -- )
variable write-errors? write-errors? on
: set-token-data ( data len apf -- )
\nvdebug ." Wrapper set-token-data: pos " nvoption-ftell .x
\nvdebug ." ,bytes left: " nvoption-size .x cr
3dup ['] (set-token-data) catch >r ( data len apf ? ? ? )
\nvdebug ." set token failed attempt 1: " cr
(garbage-collect) ( data len apf )
nvoption-ftell >r ( data len apf )
['] (set-token-data) catch if ( data len apf )
3drop write-errors? @ if ( -- )
." No space left in device" ( -- )
\nvdebug ." Wrapper set-token-data: completed @ "
\nvdebug nvoption-ftell .x ." , " nvoption-size .x cr
: accumulate-dead-keys ( apf -- )
#deleted-keys 1+ dup is #deleted-keys
d# 100 > nvgarbage-collect? or to nvgarbage-collect?
action: get-token-data ; \ GET
action: set-token-data ; \ SET
action: load-token-data ; \ LOAD
action: delete-this-token ; \ DELETE (updates device)
action: accumulate-dead-keys ; \ RELEASE (just release resource)
: create-config-hash ( hash# -- acf )
\nvdebug ." Hash: " dup .x ." = "
dup find-hash? if ( hash# acf )
also nvhash-keys definitions ( hash# adr,len )
['] $header behavior >r ( -- )
['] ($header) to $header ( -- )
r> to $header ( h2-acf h1-acf )
lastacf swap ( acf hash# )
['] crash token, ( acf hash# )
0 4 user#, unaligned-l! ( acf )
previous definitions ( acf )
0 is #deleted-keys ( flag 0 )
drop nvoption-ftell ( flag pos )
nvbuffer dup 4 nvoption-read ( flag pos buffer )
l@ dup -1 n->l <> if ( flag pos hash# )
\nvdebug ." Read Hash Key: " dup .x
dup valid-hash? if ( flag pos hash# )
nip create-config-hash ( flag acf )
2 perform-action ( flag )
valid-hash-mask or ( flag pos hash# )
find-hash? if ( flag pos )
4 perform-action ( flag pos )
else ( flag pos str,len )
4 + nvoption-seek ( flag )
nvoption-ftell false ( flag pos false )
false value options-open?
: open-nvtoken-region ( dev$ -- ok? )
nvoption-open dup if true to options-open? then
: nvtoken-region-ok? ( -- flag )
0 nvoption-seek nvbuffer 4 nvoption-read nvbuffer l@ nvmagic# =
: init-nvtoken-region ( -- )
0 ['] nvhash-keys begin another-word? while
name> >body release-buffer? drop
: load-nvtoken-data ( -- )
4 nvoption-seek scan-nvtokens
: config-create \ name ( len -- )
['] $header behavior >r ( len -- )
['] ($header) to $header ( len -- )
parse-word ( len adr,len' )
2dup create-nvhash ( len adr,len' hash )
create-config-hash -rot ( len adr,len' )
also options definitions ( len acf adr,len' )
r> to $header ( len acf )
previous definitions ( len acf )
lastacf swap >body token! ( -- )
: $config-create ( adr,len len' -- )
['] $header behavior >r ( adr,len len' -- )
['] ($header) to $header ( adr,len len' -- )
-rot 2dup create-nvhash ( len' adr,len hash )
create-config-hash -rot ( len' acf adr,len )
also options definitions ( len' acf adr,len )
r> to $header ( len' acf )
previous definitions ( len' acf )
lastacf swap >body token! ( -- )
: nodefault-create \ name ( len -- )
h# 8000.0000 or config-create
: $nodefault-create ( $name len -- )
h# 8000.0000 or $config-create
: >config-len ( apf -- len ) /token + unaligned-l@ h# 8000.0000 invert and ;
: nodefault? ( apf -- flag ) /token + unaligned-l@ h# 8000.0000 and ;
: <no-default> ( -- addr ) p" <no default>" ;
: >config-default ( apf -- adr ) /token /l + + ;
: get-config-buffer ( apf -- adr,len )
token@ execute exit ( adr, len )
>config-default 0 ( adr 0 )
: config-adr ( apf -- adr )
dup get-config-buffer if nip exit then
drop dup nodefault? if drop <no-default> else >config-default then
projects / OpenSPARC-T2-SAM / blob