kmx git

\ ========== 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 )
;
openbios/openboot/obp/pkg/confvar/definitions/vocab-util.fth

Commit

obp/pkg/confvar/definitions/vocab-util.fth
