[OpenSPARC-T2-SAM] / obp / obp / pkg / confvar / accesstypes.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: accesstypes.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: @(#)accesstypes.fth 1.10 06/11/09
purpose:
copyright: Copyright 2006 Sun Microsystems, Inc.  All Rights Reserved
copyright: Use is subject to license terms.

headerless

variable config-buffer

: config-byte@	( apf -- byte )		config-adr c@  ;
: config-short@ ( apf -- short )	config-adr w@  ;
: config-xint@  ( apf -- double )	config-adr x@  ;
: config-int@	( apf -- int )		config-adr unaligned-l@  ;

: same-as-default? ( apf data len -- acf data,len,false | acf true )
   rot >r					( data len )
   r@ token@ -rot r@ nodefault? if		( acf data len' )
      r> drop false				( acf data len' false )
   else						( data len' acf )
      2dup r> >config-default swap comp if	( acf data len' )
         false					( acf ptr len false )
      else					( acf len ptr )
         2drop true				( acf true )
      then
   then
;

[ifdef] SUN4V

\ LDOM Variable hooks (FWARC 2006/055)
defer variable-set    ( $data $name -- )
defer variable-unset  ( $name -- )

: dont-set    ( $data $name -- )  2drop 2drop  ;
: dont-unset  ( $name -- )        2drop        ;

['] dont-set   is variable-set
['] dont-unset is variable-unset

: config-store ( apf adr len -- )
   options-open? 0= if  3drop  exit  then	( )
   2 pick body> >r
   same-as-default? if				( apf )
      3 perform-action				( )
      r@ >name name>string 			( $name ) 	( r: acf )
      variable-unset				( )       	( r: acf )
   else						( apf adr len )	( r: acf )
      rot set					( )		( r: acf )
      r@ get r@ decode ?dup 0= if		( addr len | addr ) ( r: acf )
         drop r@ get				( addr,len ) ( r: acf )
      then					( addr,len ) ( r: acf )
      r@ >name name>string			( $data $name )	( r: acf )
      variable-set				( ) ( r: acf )
   then						( ) ( r: acf )
   r> drop					( )
;

: null-config-string  ( -- adr len )  " "(00)"(00)" ;

\ Must still inform ldom-variable backing store of 0 length strings.. 
\ example: set-default nvramrc
: release-config-resource ( str 0 apf -- )  
   -rot 2drop null-config-string config-store
;

[else]

: config-store ( apf adr len -- )
   options-open? 0= if  3drop  exit  then	( )
   same-as-default? if				( apf adr,len )
      3 perform-action				( )
   else						( apf adr,len )
      rot set					( )
   then						( )
;

: release-config-resource ( str 0 apf -- )  token@ 3 perform-action  2drop  ;

[then]

: setup-data ( data apf -- apf adr data adr )  swap config-buffer tuck  ;

: config-byte! ( byte apf -- )		setup-data c! /c config-store  ;
: config-short! ( short apf -- )	setup-data w! /w config-store  ;
: config-int! ( int apf -- )		setup-data l! /l config-store  ;
: config-xint! ( int apf -- )		setup-data x! /x config-store  ;

: config-string@ ( apf -- str,len )
   dup get-config-buffer ?dup if		( apf adr,len )
      rot 2drop count				( adr,len )
   else						( apf adr )
      over nodefault? if			( apf adr )
         nip 0					( adr,0 )
      else					( apf adr )
         drop >config-default count		( adr,len )
      then					( adr,len )
   then						( adr,len )
;

: config-long-string@ ( apf -- str,len )
   dup get-config-buffer ?dup if		( apf adr,len )
      rot drop 1-				( adr,len )
   else						( apf adr )
      over nodefault? if			( apf adr )
         nip 0					( adr,0 )
      else					( apf adr )
         drop >config-default cscount		( adr,len )
      then					( adr,len )
   then						( adr,len )
;

: config-string! ( str,len apf -- )
   over if
      >r r@ >config-len 2- min			( str,len' )
      dup 2+ dup >r				( str len len' )
      alloc-mem pack				( mem )
      r> 2dup r> -rot				( mem len apf mem len )
      config-store				( mem len )
      free-mem					( -- )
   else						( str len apf )
      release-config-resource			( -- )
   then						( -- )
;

: config-long-string! ( str,len apf -- )
   over if
      >r r@ >config-len 1- min			( str,len' )
      dup 1+ dup >r  alloc-mem  place-cstr  r>	( mem len' )
      2dup r> -rot  config-store		( mem len' )
      free-mem					( )
   else						( str len apf )
      release-config-resource			( )
   then						( )
;

: config-getbytes ( apf -- adr,len )
   dup get-config-buffer ?dup if		( apf adr,len )
      rot drop					( adr,len )
      /w - swap wa1+ swap			( adr', len' )
   else						( apf adr )
      over nodefault? if			( apf adr )
         nip 0					( adr,0 )
      else					( apf adr )
         drop >config-default			( adr )
         dup wa1+ swap w@			( adr,len )
      then					( adr,len )
   then						( adr,len )
;

: config-setbytes ( adr len apf -- )
   over if					( adr len apf )
      >r r@ >config-len /w - min		( str,len' )
      dup /w + dup >r				( str len len' )
      alloc-mem dup >r				( str len mem )
      2dup w!					( str len mem )
      wa1+ swap move				( )
      r> r> 2dup r> -rot			( mem len apf mem len )
      config-store				( mem len )
      free-mem					( )
   else						( adr len apf )
      release-config-resource			( )
   then						( )
;
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: accesstypes.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: @(#)accesstypes.fth 1.10 06/11/09
	43	purpose:
	44	copyright: Copyright 2006 Sun Microsystems, Inc. All Rights Reserved
	45	copyright: Use is subject to license terms.
	46
	47	headerless
	48
	49	variable config-buffer
	50
	51	: config-byte@ ( apf -- byte ) config-adr c@ ;
	52	: config-short@ ( apf -- short ) config-adr w@ ;
	53	: config-xint@ ( apf -- double ) config-adr x@ ;
	54	: config-int@ ( apf -- int ) config-adr unaligned-l@ ;
	55
	56	: same-as-default? ( apf data len -- acf data,len,false \| acf true )
	57	rot >r ( data len )
	58	r@ token@ -rot r@ nodefault? if ( acf data len' )
	59	r> drop false ( acf data len' false )
	60	else ( data len' acf )
	61	2dup r> >config-default swap comp if ( acf data len' )
	62	false ( acf ptr len false )
	63	else ( acf len ptr )
	64	2drop true ( acf true )
65	then
66	then
67	;
68
69	[ifdef] SUN4V
70
71	\ LDOM Variable hooks (FWARC 2006/055)
72	defer variable-set ( $data $name -- )
73	defer variable-unset ( $name -- )
74
75	: dont-set ( $data $name -- ) 2drop 2drop ;
76	: dont-unset ( $name -- ) 2drop ;
77
78	['] dont-set is variable-set
79	['] dont-unset is variable-unset
80
81	: config-store ( apf adr len -- )
82	options-open? 0= if 3drop exit then ( )
83	2 pick body> >r
84	same-as-default? if ( apf )
85	3 perform-action ( )
86	r@ >name name>string ( $name ) ( r: acf )
87	variable-unset ( ) ( r: acf )
88	else ( apf adr len ) ( r: acf )
89	rot set ( ) ( r: acf )
90	r@ get r@ decode ?dup 0= if ( addr len \| addr ) ( r: acf )
91	drop r@ get ( addr,len ) ( r: acf )
92	then ( addr,len ) ( r: acf )
93	r@ >name name>string ( $data $name ) ( r: acf )
94	variable-set ( ) ( r: acf )
95	then ( ) ( r: acf )
96	r> drop ( )
97	;
98
99	: null-config-string ( -- adr len ) " "(00)"(00)" ;
100
101	\ Must still inform ldom-variable backing store of 0 length strings..
102	\ example: set-default nvramrc
103	: release-config-resource ( str 0 apf -- )
104	-rot 2drop null-config-string config-store
105	;
106
107	[else]
108
109	: config-store ( apf adr len -- )
110	options-open? 0= if 3drop exit then ( )
111	same-as-default? if ( apf adr,len )
112	3 perform-action ( )
113	else ( apf adr,len )
114	rot set ( )
115	then ( )
116	;
117
118	: release-config-resource ( str 0 apf -- ) token@ 3 perform-action 2drop ;
119
120	[then]
121
122	: setup-data ( data apf -- apf adr data adr ) swap config-buffer tuck ;
123
124	: config-byte! ( byte apf -- ) setup-data c! /c config-store ;
125	: config-short! ( short apf -- ) setup-data w! /w config-store ;
126	: config-int! ( int apf -- ) setup-data l! /l config-store ;
127	: config-xint! ( int apf -- ) setup-data x! /x config-store ;
128
129	: config-string@ ( apf -- str,len )
130	dup get-config-buffer ?dup if ( apf adr,len )
131	rot 2drop count ( adr,len )
132	else ( apf adr )
133	over nodefault? if ( apf adr )
134	nip 0 ( adr,0 )
135	else ( apf adr )
136	drop >config-default count ( adr,len )
137	then ( adr,len )
138	then ( adr,len )
139	;
140
141	: config-long-string@ ( apf -- str,len )
142	dup get-config-buffer ?dup if ( apf adr,len )
143	rot drop 1- ( adr,len )
144	else ( apf adr )
145	over nodefault? if ( apf adr )
146	nip 0 ( adr,0 )
147	else ( apf adr )
148	drop >config-default cscount ( adr,len )
149	then ( adr,len )
150	then ( adr,len )
151	;
152
153	: config-string! ( str,len apf -- )
154	over if
155	>r r@ >config-len 2- min ( str,len' )
156	dup 2+ dup >r ( str len len' )
157	alloc-mem pack ( mem )
158	r> 2dup r> -rot ( mem len apf mem len )
159	config-store ( mem len )
160	free-mem ( -- )
161	else ( str len apf )
162	release-config-resource ( -- )
163	then ( -- )
164	;
165
166	: config-long-string! ( str,len apf -- )
167	over if
168	>r r@ >config-len 1- min ( str,len' )
169	dup 1+ dup >r alloc-mem place-cstr r> ( mem len' )
170	2dup r> -rot config-store ( mem len' )
171	free-mem ( )
172	else ( str len apf )
173	release-config-resource ( )
174	then ( )
175	;
176
177	: config-getbytes ( apf -- adr,len )
178	dup get-config-buffer ?dup if ( apf adr,len )
179	rot drop ( adr,len )
180	/w - swap wa1+ swap ( adr', len' )
181	else ( apf adr )
182	over nodefault? if ( apf adr )
183	nip 0 ( adr,0 )
184	else ( apf adr )
185	drop >config-default ( adr )
186	dup wa1+ swap w@ ( adr,len )
187	then ( adr,len )
188	then ( adr,len )
189	;
190
191	: config-setbytes ( adr len apf -- )
192	over if ( adr len apf )
193	>r r@ >config-len /w - min ( str,len' )
194	dup /w + dup >r ( str len len' )
195	alloc-mem dup >r ( str len mem )
196	2dup w! ( str len mem )
197	wa1+ swap move ( )
198	r> r> 2dup r> -rot ( mem len apf mem len )
199	config-store ( mem len )
200	free-mem ( )
201	else ( adr len apf )
202	release-config-resource ( )
203	then ( )
204	;