[OpenSPARC-T2-SAM] / obp / obp / pkg / confvar / definitions / vocab-util.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: vocab-util.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: @(#)vocab-util.fth 1.4 02/05/24
purpose:
copyright: Copyright 2000-2002 Sun Microsystems, Inc.  All Rights Reserved
copyright: Use is subject to license terms.

exported-headers

\ byte-keyword is treated as a byte value, therefore one and only one
\ byte-keyword can be accepted by SETENV.
\ bit-keyword is treated as a bit value, therefore multiple bit-keywords
\ can be accepted by SETENV, as long as *different* bits are set in
\ the stream of keywords accepted by SETENV.
\ Both bit-keywords and byte-keywords may be defined in a 
\ single keyword vocabulary.

4 actions
action: c@      ;  \ return value
action: 2drop   ;  \ should not be used
action:         ;  \ should not be used
action: /c + c@ ;  \ return mask

: byte-keyword create c, h# ff c, use-actions ;
: bit-keyword  create dup c, c,   use-actions ;

unexported-words

d# 20 buffer: invalid-value 

: save-value ( str len -- )  invalid-value $cat ;

: ?invalid-value ( flag -- str len )
   if
      0 invalid-value c! (.d) save-value "  (invalid value)" save-value 
      invalid-value count
   then
;

alias value> get ( acf -- value ) ( 0 perform-action ) 
: mask>          ( acf -- mask  )   3 perform-action ;

: next-keyword ( str len -- rem len str len' true | false )
   begin				( str len)
      bl left-parse-string		( rem len str len')
      dup 0<> if			( rem len str len')
         true exit			( rem len str len' true)
      else				( rem len str len')
         2drop				( rem len)
      then				( rem len)
   dup 0= until				( rem len str len')
   2drop false				( rem len str len' true | false)
;

: wrong-keyword ( voc -- )
   cr ." Options:" also execute words previous cr cr abort 
;

\ Accepts both byte-keywords and bit-keywords; For byte-keywords checks
\ the validity of the keywords and returns the associated value n;
\ For bit-keywords checks the validity and applicability of every
\ bit-keyword in the stream; Multiple bit-keywords are not allowed,
\ for example
\ setenv post-trigger none none
\ will result in error.

: voc-string>value ( adr,len voc -- n )
   over 0=  if  wrong-keyword  then  \ Empty string can't contain a valid keyword
   >r 0 0 2>r				( adr len)		( R: voc c-n c-mask)   
   begin  next-keyword  while		( rem,len adr len)	( R: voc c-n c-mask)
     2r> r@ -rot 2>r search-wordlist if	( rem,len acf)		( R: voc c-n c-mask)
       dup mask>			( rem,len acf mask)	( R: voc c-n c-mask)
       r@ and  if			( rem,len acf)		( R: voc c-n c-mask)
          2r> r> wrong-keyword \ Keyword not permitted	( ??? )	( R:) 
       else				( rem,len acf)		( R: voc c-n c-mask)
          r> over mask> or swap		( rem,len mask acf)	( R: voc c-n)
          value> r> or >r >r		( rem,len)		( R: voc c-n c-mask)
       then				( rem,len)		( R: voc c-n c-mask) 
     else				( rem,len)		( R: voc c-n c-mask) 
       2r> r> wrong-keyword    \ No such keyword 	( ???)	( R:)
     then				( rem,len)		( R: voc c-n c-mask)
   repeat				( rem,len)		( R: voc c-n c-mask)
   r> drop r> r> drop			( n )
;

d# 255 buffer: keywords
 
: add-keyword ( addr len -- )  keywords $cat "  " keywords $cat ;

\ Works with both byte-keywords and bit-keywords. For byte-keywords
\ simply tries to match the value n to the associated byte-keyword.
\ For bit-keywords tries to match all bits set in n to the associated
\ bit-keywords and returns the list of all "matching" bit-keywords.

: voc-value>string ( n voc -- adr,len false | n true )
   0 keywords c!			( n voc)
   swap >r 0 swap			( alf voc)		( R: n)
   begin  another-word?  while		( alf voc anf)		( R: n)
     dup name> 				( alf voc anf acf)	( R: n)
     dup mask> h# ff =  if ( byte kwrd) ( alf voc anf acf)	( R: n)
        value> r@ = keywords c@ 0= and  if ( alf voc anf)	( R: n)
           -rot r> 3drop name>string	( adr,len) 
           false exit			( adr,len false)
        then				( alf voc anf)		( R: n)
     else  ( bit keyword)		( alf voc anf addr)	( R: n)
        value> r@ over and =  if	( alf voc anf)		( R: n)
           dup name>string add-keyword	( alf voc anf)		( R: n)
        then				( alf voc anf)		( R: n)
     then				( alf voc anf)		( R: n)
     drop				( alf voc)		( R: n)
   repeat				( )                     ( R: n)
   keywords count dup  if  r> drop false exit  then ( adr,len ) 
   2drop r> true			( true )
;
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: vocab-util.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: @(#)vocab-util.fth 1.4 02/05/24
	43	purpose:
	44	copyright: Copyright 2000-2002 Sun Microsystems, Inc. All Rights Reserved
	45	copyright: Use is subject to license terms.
	46
	47	exported-headers
	48
	49	\ byte-keyword is treated as a byte value, therefore one and only one
	50	\ byte-keyword can be accepted by SETENV.
	51	\ bit-keyword is treated as a bit value, therefore multiple bit-keywords
	52	\ can be accepted by SETENV, as long as different bits are set in
	53	\ the stream of keywords accepted by SETENV.
	54	\ Both bit-keywords and byte-keywords may be defined in a
	55	\ single keyword vocabulary.
	56
	57	4 actions
	58	action: c@ ; \ return value
	59	action: 2drop ; \ should not be used
	60	action: ; \ should not be used
	61	action: /c + c@ ; \ return mask
	62
	63	: byte-keyword create c, h# ff c, use-actions ;
	64	: bit-keyword create dup c, c, use-actions ;
65
66	unexported-words
67
68	d# 20 buffer: invalid-value
69
70	: save-value ( str len -- ) invalid-value $cat ;
71
72	: ?invalid-value ( flag -- str len )
73	if
74	0 invalid-value c! (.d) save-value " (invalid value)" save-value
75	invalid-value count
76	then
77	;
78
79	alias value> get ( acf -- value ) ( 0 perform-action )
80	: mask> ( acf -- mask ) 3 perform-action ;
81
82	: next-keyword ( str len -- rem len str len' true \| false )
83	begin ( str len)
84	bl left-parse-string ( rem len str len')
85	dup 0<> if ( rem len str len')
86	true exit ( rem len str len' true)
87	else ( rem len str len')
88	2drop ( rem len)
89	then ( rem len)
90	dup 0= until ( rem len str len')
91	2drop false ( rem len str len' true \| false)
92	;
93
94	: wrong-keyword ( voc -- )
95	cr ." Options:" also execute words previous cr cr abort
96	;
97
98	\ Accepts both byte-keywords and bit-keywords; For byte-keywords checks
99	\ the validity of the keywords and returns the associated value n;
100	\ For bit-keywords checks the validity and applicability of every
101	\ bit-keyword in the stream; Multiple bit-keywords are not allowed,
102	\ for example
103	\ setenv post-trigger none none
104	\ will result in error.
105
106	: voc-string>value ( adr,len voc -- n )
107	over 0= if wrong-keyword then \ Empty string can't contain a valid keyword
108	>r 0 0 2>r ( adr len) ( R: voc c-n c-mask)
109	begin next-keyword while ( rem,len adr len) ( R: voc c-n c-mask)
110	2r> r@ -rot 2>r search-wordlist if ( rem,len acf) ( R: voc c-n c-mask)
111	dup mask> ( rem,len acf mask) ( R: voc c-n c-mask)
112	r@ and if ( rem,len acf) ( R: voc c-n c-mask)
113	2r> r> wrong-keyword \ Keyword not permitted ( ??? ) ( R:)
114	else ( rem,len acf) ( R: voc c-n c-mask)
115	r> over mask> or swap ( rem,len mask acf) ( R: voc c-n)
116	value> r> or >r >r ( rem,len) ( R: voc c-n c-mask)
117	then ( rem,len) ( R: voc c-n c-mask)
118	else ( rem,len) ( R: voc c-n c-mask)
119	2r> r> wrong-keyword \ No such keyword ( ???) ( R:)
120	then ( rem,len) ( R: voc c-n c-mask)
121	repeat ( rem,len) ( R: voc c-n c-mask)
122	r> drop r> r> drop ( n )
123	;
124
125	d# 255 buffer: keywords
126
127	: add-keyword ( addr len -- ) keywords $cat " " keywords $cat ;
128
129	\ Works with both byte-keywords and bit-keywords. For byte-keywords
130	\ simply tries to match the value n to the associated byte-keyword.
131	\ For bit-keywords tries to match all bits set in n to the associated
132	\ bit-keywords and returns the list of all "matching" bit-keywords.
133
134	: voc-value>string ( n voc -- adr,len false \| n true )
135	0 keywords c! ( n voc)
136	swap >r 0 swap ( alf voc) ( R: n)
137	begin another-word? while ( alf voc anf) ( R: n)
138	dup name> ( alf voc anf acf) ( R: n)
139	dup mask> h# ff = if ( byte kwrd) ( alf voc anf acf) ( R: n)
140	value> r@ = keywords c@ 0= and if ( alf voc anf) ( R: n)
141	-rot r> 3drop name>string ( adr,len)
142	false exit ( adr,len false)
143	then ( alf voc anf) ( R: n)
144	else ( bit keyword) ( alf voc anf addr) ( R: n)
145	value> r@ over and = if ( alf voc anf) ( R: n)
146	dup name>string add-keyword ( alf voc anf) ( R: n)
147	then ( alf voc anf) ( R: n)
148	then ( alf voc anf) ( R: n)
149	drop ( alf voc) ( R: n)
150	repeat ( ) ( R: n)
151	keywords count dup if r> drop false exit then ( adr,len )
152	2drop r> true ( true )
153	;