\ ========== Copyright Header Begin ==========================================
\ Hypervisor Software File: ui-cvars.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: @(#)ui-cvars.fth 1.9 07/02/07
copyright: Copyright 2007 Sun Microsystems, Inc. All Rights Reserved
copyright: Use is subject to license terms.
: $find-option ( adr len -- false | xt true )
['] options search-wordlist
: find-option ( adr len -- false | xt true )
2dup $find-option if ( adr len xt )
." Unknown option: " type cr ( )
: getenv-default \ name ( -- )
parse-word dup if ( adr len )
do-get-default ( str,len )
2drop ." Usage: get-default option-name" cr ( )
: set-default \ name ( -- )
parse-word dup if ( adr len )
2drop ." Usage: set-default option-name" cr ( )
." Setting NVRAM parameters to default values." cr
: to-column: \ name ( col# -- ) ( -- )
create c, does> c@ to-column
d# 24 to-column: value-column
d# 55 to-column: default-column
: (type-entry) ( adr,len -- )
drop cr value-column exit? ?leave
: $type-entry ( adr len -- )
tuck 2dup text? if d# 24 else 8 then ( len adr len len' )
min rot over ( adr len' len len' )
> >r (type-entry) r> if ." ..." then ( )
: $type-entry-long ( adr len acf -- ) decode (type-entry) ;
\ XXX should be done using "string-property" or "driver" or something
\ create name " options" 1+ ", does> count ; \ Include null byte in count
: show-config-entry ( acf -- )
value-column r@ get r@ decode $type-entry
r> do-get-default default-column $type-entry
: show-current-value ( acf -- )
dup .name ." = " value-column
>r r@ get r> ( adr len acf ) $type-entry-long cr
." Variable Name" value-column ." Value"
default-column ." Default Value" cr cr
0 ['] options ( alf voc-acf )
another-word? exit? if if 3drop then false then
while ( alf' voc-acf anf )
dup name>string " name" $= if ( alf' voc-acf anf )
\ Don't display the "name" property
else ( alf' voc-acf anf )
name> show-config-entry ( alf' voc-acf )
: (printenv) ( adr len -- )
nip nip show-current-value
: usage ( -- ) ." Usage: setenv option-name value" cr ;
: list ( addr count -- ) \ a version of "type" used for displaying nvramrc
i c@ newline = if cr else i c@ emit then
: $set-default ( name$ -- )
: $getenv ( name$ -- true | value$ false )
2dup $find-option if ( name$ xt )
>r r@ get r> decode false ( value$ false )
: printenv \ [ option-name ] ( -- )
parse-word dup if (printenv) else 2drop printenv-all then
: $setenv ( value$ name$ -- )
2dup $find-option if ( value$ name$ xt )
r> drop ." Invalid value; previous value retained." cr
\ We've passed all the error checks, now set the option value.
r@ set r> show-current-value ( )
\ Used to set nvram variables without the unabashed verbosity of $setenv
\ For example, when loading and setting ldom-variables from the MD
: $silent-setenv ( value$ name$ -- )
2dup $find-option if ( value$ name$ xt )
\ We've passed all the error checks, now set the option value.
: $silent-change-default ( value$ name$ -- )
$find-option if ( value$ xt )
>r r@ encode if ( ) ( R: xt )
\ We've passed all the error checks, now change the default value.
r> 7 perform-action ( ) ( R: )
: setenv \ name value ( -- )
parse-word -1 parse strip-blanks ( name$ value$ )
?dup 0= if 3drop usage exit then 2swap ( value$ name$ )
2 pick over or 0= if 2drop 2drop usage exit then ( value$ name$ )
\ Note - the following code should really be in it's own file. Leaving it
\ here temporarily to avoid depend.mk problems.
\ Define handler to set keyboard layout for commodity keyboards
\ NVRAM variable to hold layout string - defaults to empty string
0 0 d# 32 config-string keyboard-layout
\ Working buffers. Concatenated length of all layout names should be under 512
h# 200 value keylayoutlen
keylayoutlen buffer: keylayouts
keyselectlen buffer: keyselect
: callkbd stdin @ $call-method ; ( ??? -- ??? )
\ Routine called from <F1> keypress to ask for keyboard layout.
\ Select US keyboard to guarantee numbers are in known location
" US-English" " set-keyboard-layout" callkbd
dup 2 = \ Layout will fail with code 2 if keyboard
if \ is hardware identifiable
cr ." Keyboard has hardware country identification, "
." cannot select layout." cr exit
cr ." Unable to set default layout for prompt. Internal failure" cr exit
\ Get list of all layout names, so we can print them and ask for a
\ selection by number (since alphabetic keys may be scrambled).
keylayouts keylayoutlen " get-layout-names" callkbd
." No keyboard layout names returned. Internal failure." cr exit
base @ d# 10 base ! swap dup ( base len len )
\ Now that we have the list of layout names, parse them out of list
\ (they are separated by nulls) and print them out.
cr ." Please select a national keyboard layout:" cr ( base len len )
keylayouts swap ( base len buffer len )
0 -rot ( base len count buffer len )
begin ( base len count buffer len )
dup while ( base len count buffer len )
\ Print out names three to a line
rot dup 3 mod 0= if cr then ( base len buffer len count )
1+ dup 2 u.r space -rot ( base len count' buffer len )
0 left-parse-string ( base len count' buffer' len'
\ Maximum length name is under 32 bytes - line 'em up.
tuck type d# 20 swap - spaces ( base len count' buffer' len' )
\ Loop asking for keyboard number
base @ d# 10 base ! over ( len base len)
cr ." Keyboard number: " ( len base len )
keyselect keyselectlen accept ( len base len input-len )
keyselect swap ( len base len keyselect input-len )
$number ( len base len [ true| n false ] )
." Please type a number" cr 0
\ User has typed a keyboard number. Walk keylayouts again to find it.
0 rot keylayouts swap ( len n count buffer len )
begin ( len n count buffer len )
dup while ( len n count buffer len )
0 left-parse-string ( len n count buffer len' name namlen )
2>r 2swap 1+ 2dup = 2r> rot if ( len buffer len n count name namelen )
\ We've reached the keyboard number requested. Set it.
2dup " set-keyboard-layout" callkbd
." Failed to set keyboard layout to " type cr
" keyboard-layout" $setenv ( len buffer len' n count )
2drop 2swap ( len n count buffer len' )
\ Ran out of buffer looking for that keyboard number.
." Unrecognized keyboard number " .d cr
['] (ask-layout) is (ask-layout
projects / OpenSPARC-T2-SAM / blob