[OpenSPARC-T2-SAM] / obp / obp / arch / sun4v / ldom-variables.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: ldom-variables.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 
\    conditions are met: 
\ 
\  - 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
\ any nuclear facility. 
\ 
\ ========== Copyright Header End ============================================
id: @(#)ldom-variables.fth 1.6 07/09/12
purpose: 
copyright: Copyright 2007 Sun Microsystems, Inc.  All Rights Reserved
copyright: Use is subject to license terms.

\ FWARC 2006/055 and 2006/086

vocabulary ldom-variables
also ldom-variables definitions

headerless

1 		value ldv-major
0 		value ldv-minor
h# 4f42504c4456 value ldv-svc-handle	\ OBPLDV

\ LDOM Variable Data Message
struct
   /l	field >ldv-cmd
constant /ldv-hdr

\ LDOM Variable Data Respnse
struct
   /l   field >ldv-response
constant /ldv-response

\ LDOM Variable Updates Response
struct
   /l   field >ldv-updates-response
   /l	field >ldv-updates-size
constant /ldv-updates-hdr

/ldv-hdr /ldv-response + constant /ldv-response-pkt

d# 1024 constant MAX-VAR-SIZE
MAX-VAR-SIZE /ldv-hdr + buffer: ldv-buf

also domain-services
MAX-DS-PAYLOAD constant MAX-UPDATES-SIZE \ that OBP can currently handle
previous

0 value ldv-updates-buf		\ allocated on the fly for MD updates

0 value var-config-backup?	\ Differentiate between the two services

: ldv-cmd!  	   	( cmd pkt -- )  	>ldv-cmd l!  ;
: ldv-cmd@  	   	( pkt -- cmd )  	>ldv-cmd l@  ;
: >ldv-payload     	( pkt -- payload-adr )  /ldv-hdr +  ;
: ldv-response@  	( pkt -- response )  	>ldv-payload >ldv-response l@ ;
: >ldv-updates-payload	( pkt -- payload-adr )
   >ldv-payload /ldv-updates-hdr +
;
: ldv-updates-size@	( pkt -- size ) /ldv-hdr + >ldv-updates-size l@ ;

\ message types
0 	constant VAR-CONFIG-SET-REQ
1	constant VAR-CONFIG-DELETE-REQ
2	constant VAR-CONFIG-SET-RESP
3	constant VAR-CONFIG-DELETE-RESP

4	constant VAR-CONFIG-UPDATES-REQ
5	constant VAR-CONFIG-UPDATES-RESP

\ Response Result Codes
0	constant VAR-CONFIG-SUCCESS
1	constant VAR-CONFIG-NO-SPACE
2	constant VAR-CONFIG-INVALID-VAR
3	constant VAR-CONFIG-INVALID-VAL
4	constant VAR-CONFIG-NOT-PRESENT

\ To coordinate handoffs between Solaris and OBP the state of the 
\ domain-service channel is stored away.  If OBP needs to use the channel
\ after it has been closed it will attempt to re-register its needed service
0 constant LDV-CLOSED
1 constant LDV-OPEN
2 constant LDV-ERROR

LDV-CLOSED 	value ldv-service-state

\ By default when OBP requires the use of the LDOM variable service
\ it will first register it, then use it, then unregister.
true 		value ldv-unreg-on-complete?

\ Domain-service interfaces:
\ Send buffer on the given service channel
: send-ds-data  ( buf len svc-handle -- error? )
   [ also domain-services ] send-ds-data [ previous ]
;

\ Receive a packet of at most len from the given service channel
: receive-ds-data  ( buf len svc-handle -- len' 0 | error )
   [ also domain-services ] receive-ds-data [ previous ]
;
\ Attempt to register $svc-id with svc-handle.  Returns error/ack/nack
: register-domain-service ( maj min svc-han $svc-id -- maj/min ack? 0 | -1 )
   [ also domain-services ] register-domain-service [ previous ]
;

\ Unregister the domain service negotiated on svc-handle
: unregister-domain-service  ( svc-handle -- error? )
   [ also domain-services ] unregister-domain-service [ previous ]
;

also ldc

\ service IDs with Null Character embedded
: $var-config  		( -- $ )  " var-config"(00)"  ;
: $var-config-backup	( -- $ )  " var-config-backup"(00)"  ;

\ Both init-primary-service and init-secondary-service can be changed
\ to begin/while loops with multiple calls to reigster-domain-service
\ however right now we only support 1.0 so if we get a nack that's it.
: init-primary-service  ( -- error? )    
   ldv-major ldv-minor ldv-svc-handle $var-config
   register-domain-service  ?dup 0= if 			( maj/min ack? )
      nip 0=						( nack? )
   then
   dup 0= if  0 to var-config-backup?  then
;

: init-secondary-service  ( -- error? )  
   ldv-major ldv-minor ldv-svc-handle $var-config-backup
   register-domain-service ?dup 0= if 			( maj/min ack? )
      nip 0=						( nack? )
   then
   dup 0= if  -1 to var-config-backup?  then
;

\ Attempt to Register one of the two LDOM variable services
: ldv-init  ( -- error? )
   init-primary-service dup if			( error? )
      drop init-secondary-service		( error? )
   then						( error? )
   dup if
      LDV-CLOSED to ldv-service-state
   else
      LDV-OPEN to ldv-service-state
   then
;

\ Unregister the LDOM variable service
: ldv-close  ( -- )
   ldv-service-state LDV-OPEN <> if  exit  then		(  )
   ldv-svc-handle unregister-domain-service ?dup if	(  )
      \ If LDC is not up then it has been reset, treat this as closed LDC
      \ which can be re-opened for later operations.
      LDC-NOTUP = if					(  ) 
  	 LDV-CLOSED to ldv-service-state 		(  )
      else						(  )
         LDV-ERROR to ldv-service-state			(  )
      then						(  )
   else							(  )
      LDV-CLOSED to ldv-service-state			(  )
   then							(  )
   ldv-svc-handle 1+ to ldv-svc-handle	\ new handle in case of re-register
;

\ Bring up the ldom variable channel unless it is in the ERROR state
: check-ldv-channel-state  ( -- error? )
   ldv-service-state case
      LDV-OPEN 		of	 0	endof
      LDV-CLOSED	of ldv-init	endof
      LDV-ERROR		of 	-1	endof
   endcase
;

\ Store string as a null-terminated string and return pointer past the 
\ terminating null character.
: $cstrput ( str len dest-adr -- end-adr )
   swap  2dup ca+ >r  move  0 r@ c!  r> ca1+
;

d# 1024 buffer: str-buf

\ " foo" " bar" becomes " foo"(00)"bar"(00)"
: cat-with-nulls ( str len str2 len2 -- str' len' )
   dup 3 pick + >r
   str-buf $cstrput $cstrput drop
   str-buf r> 2+
;

\ add trailing 0
: to-cstr  ( buf len -- buf' len' )
   tuck str-buf $cstrput drop		( len )
   str-buf swap 1+			( buf len' )
;

\ Wrap set data in an LDV packet to be sent to the domain services layer
: assemble-set-pkt  ( $data $name -- pkt len )
   cat-with-nulls tuck ldv-buf			( $payload pkt )
   VAR-CONFIG-SET-REQ over ldv-cmd!		( payload-len $payload pkt )
   >ldv-payload swap move			( payload-len )
   ldv-buf swap /ldv-hdr +			( pkt len )
;

\ Wrap unset data to be sent to the domain services layer
: assemble-unset-pkt  ( $name -- pkt len )
   to-cstr tuck ldv-buf				( name-len $name pkt )
   VAR-CONFIG-DELETE-REQ over ldv-cmd!		( name-len $name pkt )
   >ldv-payload swap move			( name-len )
   ldv-buf swap /ldv-hdr +			( pkt len )
;

\ Request any updates from the SP since it last created an MD
: assemble-updates-req-pkt  ( -- pkt len )
   ldv-updates-buf				( pkt )
   VAR-CONFIG-UPDATES-REQ over ldv-cmd!		( pkt )
   /ldv-hdr					( pkt len )
;

: ldv-response?  ( cmd -- ldv-response? )
   dup VAR-CONFIG-DELETE-RESP = swap VAR-CONFIG-SET-RESP = or
;

: ldv-updates-response?  ( cmd -- ldv-updates-response? )
   VAR-CONFIG-UPDATES-RESP =
;

\ Note that the VAR-CONFIG-NOT-PRESENT error is ignored.  This error
\ might be triggered when a user does a set-default on a variable that's 
\ already a default
: wait-for-ldv-response  ( -- error )
   ldv-buf						( buf )
   begin
      dup /ldv-response-pkt ldv-svc-handle		( buf buf len handle )
      receive-ds-data ?dup if				( buf len' | buf error )
         dup LDC-NOTUP = if				( buf error )
	    cmn-warn[
	       " Waiting for LDOM Variable response but LDC is Not Up!"
	    ]cmn-end
	    \ Mark this service as closed so that it can be opened again
	    LDV-CLOSED to ldv-service-state		( buf error )
	 then						( buf error )
	 nip exit					( error )
      else
         /ldv-response-pkt <> if			( buf )
            cmn-warn[
	       " No LDOM Variable response from Domain Service Providor "
	    ]cmn-end
            drop -1 exit				( -1 )
         then						( buf )
      then
      dup ldv-cmd@ ldv-response?			( buf response? )
   until

   ldv-response@ case
      VAR-CONFIG-SUCCESS 	of  0 				endof
      VAR-CONFIG-NO-SPACE 	of  " No Space"			endof
      VAR-CONFIG-INVALID-VAR	of  " Invalid Variable" 	endof
      VAR-CONFIG-INVALID-VAL	of  " Invalid Value"		endof
      VAR-CONFIG-NOT-PRESENT    of  0 				endof
      0 swap
   endcase
   dup if
      cmn-warn[ ]cmn-end -1
   then
;

\ The updates response could be large.  The domain-service interface layer
\ should be updated to handle variable length packets until it is, we default
\ to the current max size of an OBP domain-service packet (8K)
: wait-for-updates-response  ( -- error )
  ldv-updates-buf					( buf )
   begin
      dup MAX-UPDATES-SIZE ldv-svc-handle		( buf buf len handle )
      receive-ds-data ?dup if				( buf len' | buf error )
         dup LDC-NOTUP = if				( buf error )
	    cmn-warn[ 
	       " Waiting for LDOM Variable updates but LDC is Not Up!"
	    ]cmn-end
	    \ Mark this service as closed so that it can be opened again
	    LDV-CLOSED to ldv-service-state		( buf error )
         then						( buf error )
         nip exit					( error )
      else						( but len' )
         0= if						( buf )
            drop -1 exit				( -1 )
         then						( buf )
      then
      dup ldv-cmd@ ldv-updates-response?		( buf response? )
   until						( buf )
   \ if the MD is larger than we can handle return error
   ldv-updates-size@ MAX-UPDATES-SIZE >	dup if		( error? )
      cmn-warn[ " LDOM Variable Updates Error - MD too large " ]cmn-end
   then
;

MAX-VAR-SIZE buffer: ascii-buffer-str

\ Return true if the LDOM variable being set is a byte array, false otherwise.
\ Currently, oem-logo is the only byte-array LDOM variable that users can modify
\ from Openboot. Any future byte-array variables will need to be added to the
\ check in this method.
: byte-variable? ( name-str name-len -- byte? )
   " oem-logo" $=
;

\ Convert a byte array to an ASCII string
: byte-var>ascii ( data1-addr data1-len -- data2-str data2-len )
   dup 2* -rot                         ( data2-len data1-str data1-len )
   0 ?do                               ( data2-len data1-str )
      dup i + c@                       ( data2-len data1-str byte )
      dup h# f and swap h# f0 and 4 >> ( data2-len data1-str u1 u2 )
      ascii-buffer-str i 2* +          ( data2-len data1-str u1 u2 data2-str )
      tuck swap (u.) rot swap move     ( data2-len data1-str u1 data2-str )
      1+ swap (u.) rot swap move       ( data2-len data1-str )
   loop                                ( data2-len data1-str )
   drop ascii-buffer-str swap          ( data2-str data2-len )
;

\ Convert an ascii string into a byte variable
: ascii>byte-var ( data1-str data1-len -- data2-str data2-len )
   dup 2/ -rot                         ( data2-len data1-str data1-len)
   0 ?do                               ( data2-len data1-str )
      dup i + 2 $number drop           ( data2-len data1-str byte )
      ascii-buffer-str i 2/ + c!       ( data2-len data1-str )
   2 +loop                             ( data2-len data1-str )
   drop ascii-buffer-str swap          ( data2-str data2-len )
;

: setenv-ldoms-var ( data-str data-len name-str name-len -- )
   2dup byte-variable? if
      2swap ascii>byte-var 2swap
   then
   $silent-setenv
;

headers

: ldom-variable-set  ( $data $name --  )
   2dup byte-variable? if
      2 pick 2* MAX-VAR-SIZE > if
         cmn-warn[ " byte array LDOM Variable exceeds maximum length." ]cmn-end
         2drop 2drop exit
      then
      2swap byte-var>ascii 2swap
   else
      2 pick MAX-VAR-SIZE > if
         cmn-warn[ " LDOM Variable exceeds maximum length." ]cmn-end
         2drop 2drop exit
      then
   then
   check-ldv-channel-state if  
      cmn-warn[ " Unable to update LDOM Variable" ]cmn-end
      2drop 2drop exit
   then
   assemble-set-pkt			( pkt len )
   ldv-svc-handle send-ds-data ?dup if	( status )
      LDC-NOTUP = if			(  )
         cmn-warn[
	    " Sending LDOM Variable Set request but LDC is Not Up!"
         ]cmn-end
	 \ Mark this service as closed so that it can be opened again
	 LDV-CLOSED to ldv-service-state  ( )
      else				(  )
         ldv-unreg-on-complete? if	(  )
            ldv-close			(  )
         then				(  )
      then				(  )
      cmn-warn[ " Error sending LDOM Variable Set request" ]cmn-end
      exit
   then
   wait-for-ldv-response if
      cmn-warn[ " Unable to set LDOM Variable" ]cmn-end
   then
   ldv-unreg-on-complete? if
      ldv-close
   then
;

: ldom-variable-delete  ( $name -- )
   check-ldv-channel-state if
      cmn-warn[ " Unable to update LDOM Variable" ]cmn-end
      2drop exit
   then
   assemble-unset-pkt			( pkt len )
   ldv-svc-handle send-ds-data ?dup if	( status )
      LDC-NOTUP = if			(  )
         cmn-warn[
	    " Sending LDOM Variable Delete request but LDC is Not Up!"
         ]cmn-end
	 \ Mark this service as closed so that it can be opened again
	 LDV-CLOSED to ldv-service-state  (  )
      else				(  )
         ldv-unreg-on-complete? if	(  )
            ldv-close			(  )
         then				(  )
      then				(  )
      cmn-warn[ " LDOM Variable Delete request failed!" ]cmn-end
      exit
   then
   wait-for-ldv-response if
      cmn-warn[ " Unable to Delete LDOM Variable" ]cmn-end
   then
   ldv-unreg-on-complete? if
      ldv-close
   then
;

headerless

\ Get the next string property in MD node
: get-next-str-prop  ( node prop -- ent|0 )
   begin				( node prop )
      over swap md-next-prop dup	( node prop,prop|0,0 )
   while
      dup md-prop-type ascii s = if	( node prop )
         nip exit			( prop )
      then				( node prop )
   repeat
   nip					( 0 )
;

\ Load nvram variables from the "variables" MD node
\ 1. Entry is an update to an existing variable... update variable
\ 2. Entry is an unknown variable... ignore
: get-md-variables  ( -- )
   0 " variables" md-find-node ?dup 0= if  exit  then  
   0					( node 0 )
   begin
      over swap get-next-str-prop ?dup	( [ node prop prop ] | [ node 0 ] )
   while
      dup md-decode-prop drop		( node prop $data )
      2 pick md-prop-name		( node prop $data $name )
      2dup $getenv if			( n p $data $name )
         2drop 2drop			( node prop )
      else				( n p $data $name $value )
         2drop  			( n p $data $name )
         setenv-ldoms-var		( node prop)
      then   
   repeat
   drop
;

: mem64-enabled-in-md? ( -- true | false )
   0 " openboot" md-find-node ?dup if                   	( node )
      " pci-mem64-support" ascii v md-find-prop ?dup if  	( prop )
         md-decode-prop drop exit                        		( data | 0 )
      then
  then
  false
;

: update-mem64-default ( -- )
   mem64-enabled-in-md? if
      " true"
   else
      " false"
   then 
   " pci-mem64?" $silent-change-default
;

\ Load nvram variables from a mini MD
\ 1. Entry is an update to an existing variable... update variable
\ 2. Entry is an unknown variable... ignore
\ 3. Entry is reserved word "_delete"... set-default on variable in prop-data
: update-ldom-variables  (  -- )
   ldv-updates-buf >ldv-updates-payload md-set-working-md
   0 " variables" md-find-node ?dup if
      0					( node 0 )
      begin
	 over swap get-next-str-prop ?dup ( [ node prop prop ] | [ node 0 ] )
      while
	 dup md-decode-prop drop	( node prop $data )
	 2 pick md-prop-name		( node prop $data $name )
	 2dup " _delete" $= if		( node prop $data $name )
	    2drop $set-default		( node prop )
	 else
	    2dup $getenv if		( n p $data $name )
	       2drop 2drop		( node prop )
	    else			( n p $data $name $value )
	       2drop  			( n p $data $name )
	       setenv-ldoms-var		( node prop)
	    then			( node prop )
	 then				( node prop )
       repeat
       drop				(  )
    then
    0 md-set-working-md			\ This Line is VERY IMPORTANT
;

\ Request a "mini-MD" from the SP that contains any ldom variable changes
\ since it created the guest MD
: get-variable-updates  ( -- )
   check-ldv-channel-state if			(  )
      cmn-warn[ " Unable to get LDOM Variable Updates" ]cmn-end
      exit					(  )
   then						(  )
   \ Only meaningful when talking to the SP
   var-config-backup? if			(  )
      MAX-UPDATES-SIZE alloc-mem to ldv-updates-buf	(  )
      assemble-updates-req-pkt			( pkt len )
      ldv-svc-handle send-ds-data ?dup if	( status )
         LDC-NOTUP = if				(  )
            cmn-warn[
	       " Sending LDOM Variable Update request but LDC is Not Up!"
            ]cmn-end
	    \ Mark this service as closed so that it can be opened again
	    LDV-CLOSED to ldv-service-state	(  )
         else					(  )
            ldv-unreg-on-complete? if		(  )
               ldv-close			(  )
            then				(  )
         then					(  )
         cmn-warn[ " LDOMs Variable Update request failed!" ]cmn-end
         ldv-updates-buf MAX-UPDATES-SIZE free-mem 	(  )
         exit					(  )
      then					(  )
      wait-for-updates-response 0= if		(  )
	 update-ldom-variables			(  )
      else
         cmn-warn[ " LDOMs Variable Update request failed!" ]cmn-end
      then					(  )
      ldv-updates-buf MAX-UPDATES-SIZE free-mem (  )
   then
   ldv-unreg-on-complete? if			(  )
      ldv-close					(  )
   then						(  )
;

previous		\ ldc

\ read ldom-variables from the MD and then ask for updates from the
\ domain-service providor if we are using the var-config-backup service.
\ Variables may have changed since the guest MD has been created
stand-init: LDOM variable init
   update-mem64-default
   get-md-variables
   get-variable-updates
   ?secure
   [ also nvdevice ]
   ['] ldom-variable-set    is variable-set
   ['] ldom-variable-delete is variable-unset
   [ previous ]
;

previous definitions

headers
\ Rather than register and unregister the LDOM Variable service
\ for an ldom-variable-delete of EVERY variable keep the service
\ registered until the set-defaults command is complete.
overload: set-defaults  ( -- )
   [ also ldom-variables ]
   false to ldv-unreg-on-complete?	\ keep the service registered
   set-defaults				\ set-defaults
   ldv-close				\ unregister the service
   true to ldv-unreg-on-complete?   	\ back to standard proceedure
   [ previous ]
;

headerless
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: ldom-variables.fth
	4	\
	5	\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
	6	\
	7	\ - Do no alter or remove copyright notices
	8	\
	9	\ - Redistribution and use of this software in source and binary forms, with
	10	\ or without modification, are permitted provided that the following
	11	\ conditions are met:
	12	\
	13	\ - Redistribution of source code must retain the above copyright notice,
	14	\ this list of conditions and the following disclaimer.
	15	\
	16	\ - Redistribution in binary form must reproduce the above copyright notice,
	17	\ this list of conditions and the following disclaimer in the
	18	\ documentation and/or other materials provided with the distribution.
	19	\
	20	\ Neither the name of Sun Microsystems, Inc. or the names of contributors
	21	\ may be used to endorse or promote products derived from this software
	22	\ without specific prior written permission.
	23	\
	24	\ This software is provided "AS IS," without a warranty of any kind.
	25	\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES,
	26	\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A
	27	\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN
	28	\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR
	29	\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
	30	\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN
	31	\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR
	32	\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE
	33	\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY,
	34	\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF
	35	\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
	36	\
	37	\ You acknowledge that this software is not designed, licensed or
	38	\ intended for use in the design, construction, operation or maintenance of
	39	\ any nuclear facility.
	40	\
	41	\ ========== Copyright Header End ============================================
	42	id: @(#)ldom-variables.fth 1.6 07/09/12
	43	purpose:
	44	copyright: Copyright 2007 Sun Microsystems, Inc. All Rights Reserved
	45	copyright: Use is subject to license terms.
	46
	47	\ FWARC 2006/055 and 2006/086
	48
	49	vocabulary ldom-variables
	50	also ldom-variables definitions
	51
	52	headerless
	53
	54	1 value ldv-major
	55	0 value ldv-minor
	56	h# 4f42504c4456 value ldv-svc-handle \ OBPLDV
	57
	58	\ LDOM Variable Data Message
	59	struct
	60	/l field >ldv-cmd
	61	constant /ldv-hdr
	62
	63	\ LDOM Variable Data Respnse
	64	struct
65	/l field >ldv-response
66	constant /ldv-response
67
68	\ LDOM Variable Updates Response
69	struct
70	/l field >ldv-updates-response
71	/l field >ldv-updates-size
72	constant /ldv-updates-hdr
73
74	/ldv-hdr /ldv-response + constant /ldv-response-pkt
75
76	d# 1024 constant MAX-VAR-SIZE
77	MAX-VAR-SIZE /ldv-hdr + buffer: ldv-buf
78
79	also domain-services
80	MAX-DS-PAYLOAD constant MAX-UPDATES-SIZE \ that OBP can currently handle
81	previous
82
83	0 value ldv-updates-buf \ allocated on the fly for MD updates
84
85	0 value var-config-backup? \ Differentiate between the two services
86
87	: ldv-cmd! ( cmd pkt -- ) >ldv-cmd l! ;
88	: ldv-cmd@ ( pkt -- cmd ) >ldv-cmd l@ ;
89	: >ldv-payload ( pkt -- payload-adr ) /ldv-hdr + ;
90	: ldv-response@ ( pkt -- response ) >ldv-payload >ldv-response l@ ;
91	: >ldv-updates-payload ( pkt -- payload-adr )
92	>ldv-payload /ldv-updates-hdr +
93	;
94	: ldv-updates-size@ ( pkt -- size ) /ldv-hdr + >ldv-updates-size l@ ;
95
96	\ message types
97	0 constant VAR-CONFIG-SET-REQ
98	1 constant VAR-CONFIG-DELETE-REQ
99	2 constant VAR-CONFIG-SET-RESP
100	3 constant VAR-CONFIG-DELETE-RESP
101
102	4 constant VAR-CONFIG-UPDATES-REQ
103	5 constant VAR-CONFIG-UPDATES-RESP
104
105	\ Response Result Codes
106	0 constant VAR-CONFIG-SUCCESS
107	1 constant VAR-CONFIG-NO-SPACE
108	2 constant VAR-CONFIG-INVALID-VAR
109	3 constant VAR-CONFIG-INVALID-VAL
110	4 constant VAR-CONFIG-NOT-PRESENT
111
112	\ To coordinate handoffs between Solaris and OBP the state of the
113	\ domain-service channel is stored away. If OBP needs to use the channel
114	\ after it has been closed it will attempt to re-register its needed service
115	0 constant LDV-CLOSED
116	1 constant LDV-OPEN
117	2 constant LDV-ERROR
118
119	LDV-CLOSED value ldv-service-state
120
121	\ By default when OBP requires the use of the LDOM variable service
122	\ it will first register it, then use it, then unregister.
123	true value ldv-unreg-on-complete?
124
125	\ Domain-service interfaces:
126	\ Send buffer on the given service channel
127	: send-ds-data ( buf len svc-handle -- error? )
128	[ also domain-services ] send-ds-data [ previous ]
129	;
130
131	\ Receive a packet of at most len from the given service channel
132	: receive-ds-data ( buf len svc-handle -- len' 0 \| error )
133	[ also domain-services ] receive-ds-data [ previous ]
134	;
135	\ Attempt to register $svc-id with svc-handle. Returns error/ack/nack
136	: register-domain-service ( maj min svc-han $svc-id -- maj/min ack? 0 \| -1 )
137	[ also domain-services ] register-domain-service [ previous ]
138	;
139
140	\ Unregister the domain service negotiated on svc-handle
141	: unregister-domain-service ( svc-handle -- error? )
142	[ also domain-services ] unregister-domain-service [ previous ]
143	;
144
145	also ldc
146
147	\ service IDs with Null Character embedded
148	: $var-config ( -- $ ) " var-config"(00)" ;
149	: $var-config-backup ( -- $ ) " var-config-backup"(00)" ;
150
151	\ Both init-primary-service and init-secondary-service can be changed
152	\ to begin/while loops with multiple calls to reigster-domain-service
153	\ however right now we only support 1.0 so if we get a nack that's it.
154	: init-primary-service ( -- error? )
155	ldv-major ldv-minor ldv-svc-handle $var-config
156	register-domain-service ?dup 0= if ( maj/min ack? )
157	nip 0= ( nack? )
158	then
159	dup 0= if 0 to var-config-backup? then
160	;
161
162	: init-secondary-service ( -- error? )
163	ldv-major ldv-minor ldv-svc-handle $var-config-backup
164	register-domain-service ?dup 0= if ( maj/min ack? )
165	nip 0= ( nack? )
166	then
167	dup 0= if -1 to var-config-backup? then
168	;
169
170	\ Attempt to Register one of the two LDOM variable services
171	: ldv-init ( -- error? )
172	init-primary-service dup if ( error? )
173	drop init-secondary-service ( error? )
174	then ( error? )
175	dup if
176	LDV-CLOSED to ldv-service-state
177	else
178	LDV-OPEN to ldv-service-state
179	then
180	;
181
182	\ Unregister the LDOM variable service
183	: ldv-close ( -- )
184	ldv-service-state LDV-OPEN <> if exit then ( )
185	ldv-svc-handle unregister-domain-service ?dup if ( )
186	\ If LDC is not up then it has been reset, treat this as closed LDC
187	\ which can be re-opened for later operations.
188	LDC-NOTUP = if ( )
189	LDV-CLOSED to ldv-service-state ( )
190	else ( )
191	LDV-ERROR to ldv-service-state ( )
192	then ( )
193	else ( )
194	LDV-CLOSED to ldv-service-state ( )
195	then ( )
196	ldv-svc-handle 1+ to ldv-svc-handle \ new handle in case of re-register
197	;
198
199	\ Bring up the ldom variable channel unless it is in the ERROR state
200	: check-ldv-channel-state ( -- error? )
201	ldv-service-state case
202	LDV-OPEN of 0 endof
203	LDV-CLOSED of ldv-init endof
204	LDV-ERROR of -1 endof
205	endcase
206	;
207
208	\ Store string as a null-terminated string and return pointer past the
209	\ terminating null character.
210	: $cstrput ( str len dest-adr -- end-adr )
211	swap 2dup ca+ >r move 0 r@ c! r> ca1+
212	;
213
214	d# 1024 buffer: str-buf
215
216	\ " foo" " bar" becomes " foo"(00)"bar"(00)"
217	: cat-with-nulls ( str len str2 len2 -- str' len' )
218	dup 3 pick + >r
219	str-buf $cstrput $cstrput drop
220	str-buf r> 2+
221	;
222
223	\ add trailing 0
224	: to-cstr ( buf len -- buf' len' )
225	tuck str-buf $cstrput drop ( len )
226	str-buf swap 1+ ( buf len' )
227	;
228
229	\ Wrap set data in an LDV packet to be sent to the domain services layer
230	: assemble-set-pkt ( $data $name -- pkt len )
231	cat-with-nulls tuck ldv-buf ( $payload pkt )
232	VAR-CONFIG-SET-REQ over ldv-cmd! ( payload-len $payload pkt )
233	>ldv-payload swap move ( payload-len )
234	ldv-buf swap /ldv-hdr + ( pkt len )
235	;
236
237	\ Wrap unset data to be sent to the domain services layer
238	: assemble-unset-pkt ( $name -- pkt len )
239	to-cstr tuck ldv-buf ( name-len $name pkt )
240	VAR-CONFIG-DELETE-REQ over ldv-cmd! ( name-len $name pkt )
241	>ldv-payload swap move ( name-len )
242	ldv-buf swap /ldv-hdr + ( pkt len )
243	;
244
245	\ Request any updates from the SP since it last created an MD
246	: assemble-updates-req-pkt ( -- pkt len )
247	ldv-updates-buf ( pkt )
248	VAR-CONFIG-UPDATES-REQ over ldv-cmd! ( pkt )
249	/ldv-hdr ( pkt len )
250	;
251
252	: ldv-response? ( cmd -- ldv-response? )
253	dup VAR-CONFIG-DELETE-RESP = swap VAR-CONFIG-SET-RESP = or
254	;
255
256	: ldv-updates-response? ( cmd -- ldv-updates-response? )
257	VAR-CONFIG-UPDATES-RESP =
258	;
259
260	\ Note that the VAR-CONFIG-NOT-PRESENT error is ignored. This error
261	\ might be triggered when a user does a set-default on a variable that's
262	\ already a default
263	: wait-for-ldv-response ( -- error )
264	ldv-buf ( buf )
265	begin
266	dup /ldv-response-pkt ldv-svc-handle ( buf buf len handle )
267	receive-ds-data ?dup if ( buf len' \| buf error )
268	dup LDC-NOTUP = if ( buf error )
269	cmn-warn[
270	" Waiting for LDOM Variable response but LDC is Not Up!"
271	]cmn-end
272	\ Mark this service as closed so that it can be opened again
273	LDV-CLOSED to ldv-service-state ( buf error )
274	then ( buf error )
275	nip exit ( error )
276	else
277	/ldv-response-pkt <> if ( buf )
278	cmn-warn[
279	" No LDOM Variable response from Domain Service Providor "
280	]cmn-end
281	drop -1 exit ( -1 )
282	then ( buf )
283	then
284	dup ldv-cmd@ ldv-response? ( buf response? )
285	until
286
287	ldv-response@ case
288	VAR-CONFIG-SUCCESS of 0 endof
289	VAR-CONFIG-NO-SPACE of " No Space" endof
290	VAR-CONFIG-INVALID-VAR of " Invalid Variable" endof
291	VAR-CONFIG-INVALID-VAL of " Invalid Value" endof
292	VAR-CONFIG-NOT-PRESENT of 0 endof
293	0 swap
294	endcase
295	dup if
296	cmn-warn[ ]cmn-end -1
297	then
298	;
299
300	\ The updates response could be large. The domain-service interface layer
301	\ should be updated to handle variable length packets until it is, we default
302	\ to the current max size of an OBP domain-service packet (8K)
303	: wait-for-updates-response ( -- error )
304	ldv-updates-buf ( buf )
305	begin
306	dup MAX-UPDATES-SIZE ldv-svc-handle ( buf buf len handle )
307	receive-ds-data ?dup if ( buf len' \| buf error )
308	dup LDC-NOTUP = if ( buf error )
309	cmn-warn[
310	" Waiting for LDOM Variable updates but LDC is Not Up!"
311	]cmn-end
312	\ Mark this service as closed so that it can be opened again
313	LDV-CLOSED to ldv-service-state ( buf error )
314	then ( buf error )
315	nip exit ( error )
316	else ( but len' )
317	0= if ( buf )
318	drop -1 exit ( -1 )
319	then ( buf )
320	then
321	dup ldv-cmd@ ldv-updates-response? ( buf response? )
322	until ( buf )
323	\ if the MD is larger than we can handle return error
324	ldv-updates-size@ MAX-UPDATES-SIZE > dup if ( error? )
325	cmn-warn[ " LDOM Variable Updates Error - MD too large " ]cmn-end
326	then
327	;
328
329	MAX-VAR-SIZE buffer: ascii-buffer-str
330
331	\ Return true if the LDOM variable being set is a byte array, false otherwise.
332	\ Currently, oem-logo is the only byte-array LDOM variable that users can modify
333	\ from Openboot. Any future byte-array variables will need to be added to the
334	\ check in this method.
335	: byte-variable? ( name-str name-len -- byte? )
336	" oem-logo" $=
337	;
338
339	\ Convert a byte array to an ASCII string
340	: byte-var>ascii ( data1-addr data1-len -- data2-str data2-len )
341	dup 2* -rot ( data2-len data1-str data1-len )
342	0 ?do ( data2-len data1-str )
343	dup i + c@ ( data2-len data1-str byte )
344	dup h# f and swap h# f0 and 4 >> ( data2-len data1-str u1 u2 )
345	ascii-buffer-str i 2* + ( data2-len data1-str u1 u2 data2-str )
346	tuck swap (u.) rot swap move ( data2-len data1-str u1 data2-str )
347	1+ swap (u.) rot swap move ( data2-len data1-str )
348	loop ( data2-len data1-str )
349	drop ascii-buffer-str swap ( data2-str data2-len )
350	;
351
352	\ Convert an ascii string into a byte variable
353	: ascii>byte-var ( data1-str data1-len -- data2-str data2-len )
354	dup 2/ -rot ( data2-len data1-str data1-len)
355	0 ?do ( data2-len data1-str )
356	dup i + 2 $number drop ( data2-len data1-str byte )
357	ascii-buffer-str i 2/ + c! ( data2-len data1-str )
358	2 +loop ( data2-len data1-str )
359	drop ascii-buffer-str swap ( data2-str data2-len )
360	;
361
362	: setenv-ldoms-var ( data-str data-len name-str name-len -- )
363	2dup byte-variable? if
364	2swap ascii>byte-var 2swap
365	then
366	$silent-setenv
367	;
368
369	headers
370
371	: ldom-variable-set ( $data $name -- )
372	2dup byte-variable? if
373	2 pick 2* MAX-VAR-SIZE > if
374	cmn-warn[ " byte array LDOM Variable exceeds maximum length." ]cmn-end
375	2drop 2drop exit
376	then
377	2swap byte-var>ascii 2swap
378	else
379	2 pick MAX-VAR-SIZE > if
380	cmn-warn[ " LDOM Variable exceeds maximum length." ]cmn-end
381	2drop 2drop exit
382	then
383	then
384	check-ldv-channel-state if
385	cmn-warn[ " Unable to update LDOM Variable" ]cmn-end
386	2drop 2drop exit
387	then
388	assemble-set-pkt ( pkt len )
389	ldv-svc-handle send-ds-data ?dup if ( status )
390	LDC-NOTUP = if ( )
391	cmn-warn[
392	" Sending LDOM Variable Set request but LDC is Not Up!"
393	]cmn-end
394	\ Mark this service as closed so that it can be opened again
395	LDV-CLOSED to ldv-service-state ( )
396	else ( )
397	ldv-unreg-on-complete? if ( )
398	ldv-close ( )
399	then ( )
400	then ( )
401	cmn-warn[ " Error sending LDOM Variable Set request" ]cmn-end
402	exit
403	then
404	wait-for-ldv-response if
405	cmn-warn[ " Unable to set LDOM Variable" ]cmn-end
406	then
407	ldv-unreg-on-complete? if
408	ldv-close
409	then
410	;
411
412	: ldom-variable-delete ( $name -- )
413	check-ldv-channel-state if
414	cmn-warn[ " Unable to update LDOM Variable" ]cmn-end
415	2drop exit
416	then
417	assemble-unset-pkt ( pkt len )
418	ldv-svc-handle send-ds-data ?dup if ( status )
419	LDC-NOTUP = if ( )
420	cmn-warn[
421	" Sending LDOM Variable Delete request but LDC is Not Up!"
422	]cmn-end
423	\ Mark this service as closed so that it can be opened again
424	LDV-CLOSED to ldv-service-state ( )
425	else ( )
426	ldv-unreg-on-complete? if ( )
427	ldv-close ( )
428	then ( )
429	then ( )
430	cmn-warn[ " LDOM Variable Delete request failed!" ]cmn-end
431	exit
432	then
433	wait-for-ldv-response if
434	cmn-warn[ " Unable to Delete LDOM Variable" ]cmn-end
435	then
436	ldv-unreg-on-complete? if
437	ldv-close
438	then
439	;
440
441	headerless
442
443	\ Get the next string property in MD node
444	: get-next-str-prop ( node prop -- ent\|0 )
445	begin ( node prop )
446	over swap md-next-prop dup ( node prop,prop\|0,0 )
447	while
448	dup md-prop-type ascii s = if ( node prop )
449	nip exit ( prop )
450	then ( node prop )
451	repeat
452	nip ( 0 )
453	;
454
455	\ Load nvram variables from the "variables" MD node
456	\ 1. Entry is an update to an existing variable... update variable
457	\ 2. Entry is an unknown variable... ignore
458	: get-md-variables ( -- )
459	0 " variables" md-find-node ?dup 0= if exit then
460	0 ( node 0 )
461	begin
462	over swap get-next-str-prop ?dup ( [ node prop prop ] \| [ node 0 ] )
463	while
464	dup md-decode-prop drop ( node prop $data )
465	2 pick md-prop-name ( node prop $data $name )
466	2dup $getenv if ( n p $data $name )
467	2drop 2drop ( node prop )
468	else ( n p $data $name $value )
469	2drop ( n p $data $name )
470	setenv-ldoms-var ( node prop)
471	then
472	repeat
473	drop
474	;
475
476	: mem64-enabled-in-md? ( -- true \| false )
477	0 " openboot" md-find-node ?dup if ( node )
478	" pci-mem64-support" ascii v md-find-prop ?dup if ( prop )
479	md-decode-prop drop exit ( data \| 0 )
480	then
481	then
482	false
483	;
484
485	: update-mem64-default ( -- )
486	mem64-enabled-in-md? if
487	" true"
488	else
489	" false"
490	then
491	" pci-mem64?" $silent-change-default
492	;
493
494	\ Load nvram variables from a mini MD
495	\ 1. Entry is an update to an existing variable... update variable
496	\ 2. Entry is an unknown variable... ignore
497	\ 3. Entry is reserved word "_delete"... set-default on variable in prop-data
498	: update-ldom-variables ( -- )
499	ldv-updates-buf >ldv-updates-payload md-set-working-md
500	0 " variables" md-find-node ?dup if
501	0 ( node 0 )
502	begin
503	over swap get-next-str-prop ?dup ( [ node prop prop ] \| [ node 0 ] )
504	while
505	dup md-decode-prop drop ( node prop $data )
506	2 pick md-prop-name ( node prop $data $name )
507	2dup " _delete" $= if ( node prop $data $name )
508	2drop $set-default ( node prop )
509	else
510	2dup $getenv if ( n p $data $name )
511	2drop 2drop ( node prop )
512	else ( n p $data $name $value )
513	2drop ( n p $data $name )
514	setenv-ldoms-var ( node prop)
515	then ( node prop )
516	then ( node prop )
517	repeat
518	drop ( )
519	then
520	0 md-set-working-md \ This Line is VERY IMPORTANT
521	;
522
523	\ Request a "mini-MD" from the SP that contains any ldom variable changes
524	\ since it created the guest MD
525	: get-variable-updates ( -- )
526	check-ldv-channel-state if ( )
527	cmn-warn[ " Unable to get LDOM Variable Updates" ]cmn-end
528	exit ( )
529	then ( )
530	\ Only meaningful when talking to the SP
531	var-config-backup? if ( )
532	MAX-UPDATES-SIZE alloc-mem to ldv-updates-buf ( )
533	assemble-updates-req-pkt ( pkt len )
534	ldv-svc-handle send-ds-data ?dup if ( status )
535	LDC-NOTUP = if ( )
536	cmn-warn[
537	" Sending LDOM Variable Update request but LDC is Not Up!"
538	]cmn-end
539	\ Mark this service as closed so that it can be opened again
540	LDV-CLOSED to ldv-service-state ( )
541	else ( )
542	ldv-unreg-on-complete? if ( )
543	ldv-close ( )
544	then ( )
545	then ( )
546	cmn-warn[ " LDOMs Variable Update request failed!" ]cmn-end
547	ldv-updates-buf MAX-UPDATES-SIZE free-mem ( )
548	exit ( )
549	then ( )
550	wait-for-updates-response 0= if ( )
551	update-ldom-variables ( )
552	else
553	cmn-warn[ " LDOMs Variable Update request failed!" ]cmn-end
554	then ( )
555	ldv-updates-buf MAX-UPDATES-SIZE free-mem ( )
556	then
557	ldv-unreg-on-complete? if ( )
558	ldv-close ( )
559	then ( )
560	;
561
562	previous \ ldc
563
564	\ read ldom-variables from the MD and then ask for updates from the
565	\ domain-service providor if we are using the var-config-backup service.
566	\ Variables may have changed since the guest MD has been created
567	stand-init: LDOM variable init
568	update-mem64-default
569	get-md-variables
570	get-variable-updates
571	?secure
572	[ also nvdevice ]
573	['] ldom-variable-set is variable-set
574	['] ldom-variable-delete is variable-unset
575	[ previous ]
576	;
577
578	previous definitions
579
580	headers
581	\ Rather than register and unregister the LDOM Variable service
582	\ for an ldom-variable-delete of EVERY variable keep the service
583	\ registered until the set-defaults command is complete.
584	overload: set-defaults ( -- )
585	[ also ldom-variables ]
586	false to ldv-unreg-on-complete? \ keep the service registered
587	set-defaults \ set-defaults
588	ldv-close \ unregister the service
589	true to ldv-unreg-on-complete? \ back to standard proceedure
590	[ previous ]
591	;
592
593	headerless