qemu/roms/SLOF/slof/fs/property.fs

   1 \ *****************************************************************************
   2 \ * Copyright (c) 2004, 2008 IBM Corporation
   3 \ * All rights reserved.
   4 \ * This program and the accompanying materials
   5 \ * are made available under the terms of the BSD License
   6 \ * which accompanies this distribution, and is available at
   7 \ * http://www.opensource.org/licenses/bsd-license.php
   8 \ *
   9 \ * Contributors:
  10 \ *     IBM Corporation - initial implementation
  11 \ ****************************************************************************/
  12
  13
  14 \ Properties 5.3.5
  15
  16 \ Words on the property list for a node are actually executable words,
  17 \ that return the address and length of the property's data.  Special
  18 \ nodes like /options can have their properties use specialized code to
  19 \ dynamically generate their data; most nodes just use a 2CONSTANT.
  20
  21 \ Put the type as byte before the property
  22 \   { int = 1, bytes = 2, string = 3 }
  23 \ This is used by .properties for pretty print
  24
  25 \ Flag for type encoding, encode-* resets, set-property set the flag
  26 true value encode-first?
  27
  28 : decode-int  over >r 4 /string r> 4c@ swap 2swap swap bljoin ;
  29 : decode-64 decode-int -rot decode-int -rot 2swap swap lxjoin ;
  30 : decode-string ( prop-addr1 prop-len1 -- prop-addr2 prop-len2 str len )
  31    dup 0= IF 2dup EXIT THEN \ string properties with zero length
  32    over BEGIN dup c@ 0= IF 1+ -rot swap 2 pick over - rot over - -rot 1-
  33     EXIT THEN 1+ AGAIN ;
  34
  35 \ Remove a word from a wordlist.
  36 : (prune) ( name len head -- )
  37   dup >r (find) ?dup IF r> BEGIN dup @ WHILE 2dup @ = IF
  38   >r @ r> ! EXIT THEN @ REPEAT 2drop ELSE r> drop THEN ;
  39 : prune ( name len -- )  last (prune) ;
  40
  41 : set-property ( data dlen name nlen phandle -- )
  42     true to encode-first?
  43     get-current >r  node>properties @ set-current
  44     2dup prune  $2CONSTANT  r> set-current ;
  45 : delete-property ( name nlen -- )
  46     get-node get-current >r  node>properties @ set-current
  47     prune r> set-current ;
  48 : property ( data dlen name nlen -- )  get-node set-property ;
  49 : get-property ( str len phandle -- true | data dlen false )
  50   ?dup 0= IF cr cr cr ." get-property for " type ."  on zero phandle"
  51   cr cr true EXIT THEN
  52   node>properties @ voc-find dup IF link> execute false ELSE drop true THEN ;
  53 : get-package-property ( str len phandle -- true | data dlen false )
  54   get-property ;
  55 : get-my-property ( str len -- true | data dlen false )
  56   my-self ihandle>phandle get-property ;
  57 : get-parent-property ( str len -- true | data dlen false )
  58   my-parent ihandle>phandle get-property ;
  59
  60 : get-inherited-property ( str len -- true | data dlen false )
  61    my-self ihandle>phandle
  62    BEGIN
  63       3dup get-property 0= IF
  64          \ Property found
  65          rot drop rot drop rot drop false EXIT
  66       THEN
  67       parent dup 0= IF
  68          \ Root node has been reached, but property has not been found
  69          3drop true EXIT
  70       THEN
  71    AGAIN
  72 ;
  73
  74 \ Print out properties.
  75
  76 20 CONSTANT indent-prop
  77
  78 : .prop-int ( str len -- )
  79    space
  80    400 min 0
  81    ?DO
  82       i over + dup                                 ( str act-addr act-addr )
  83       c@ 2 0.r 1+ dup c@ 2 0.r 1+ dup c@ 2 0.r 1+ c@ 2 0.r ( str )
  84       i c and c = IF                           \ check for multipleof 16 bytes
  85          cr indent @ indent-prop + 1+ 0        \ linefeed + indent
  86          DO
  87             space                              \ print spaces
  88          LOOP
  89       ELSE
  90          space space                           \ print two spaces
  91       THEN
  92    4 +LOOP
  93    drop
  94 ;
  95
  96 : .prop-bytes ( str len -- )
  97    2dup -4 and .prop-int                       ( str len )
  98
  99    dup 3 and dup IF                            ( str len len%4 )
 100       >r -4 and + r>                           ( str' len%4 )
 101       bounds                                   ( str' str'+len%4 )
 102       DO
 103          i c@ 2 0.r                            \ Print last 3 bytes
 104       LOOP
 105    ELSE
 106       3drop
 107    THEN
 108 ;
 109
 110 : .prop-string ( str len )
 111    2dup space type
 112    cr indent @ indent-prop + 0 DO space LOOP   \ Linefeed
 113    .prop-bytes
 114 ;
 115
 116 : .propbytes ( xt -- )
 117    execute dup
 118    IF
 119       over cell- @ execute
 120    ELSE
 121       2drop
 122    THEN
 123 ;
 124 : .property ( lfa -- )
 125     cr indent @ 0
 126     ?DO
 127         space
 128     LOOP
 129     link> dup >name name>string 2dup type nip ( len )
 130     indent-prop swap -                        ( xt 20-len )
 131     dup 0< IF drop 0 THEN 0                   ( xt number-of-space 0 )
 132     ?DO
 133         space
 134     LOOP
 135     .propbytes
 136 ;
 137 : (.properties) ( phandle -- )
 138   node>properties @ cell+ @ BEGIN dup WHILE dup .property @ REPEAT drop ;
 139 : .properties ( -- )
 140   get-node (.properties) ;
 141
 142 : next-property ( str len phandle -- false | str' len' true )
 143   ?dup 0= IF device-tree @ THEN  \ XXX: is this line required?
 144   node>properties @
 145   >r 2dup 0= swap 0= or IF 2drop r> cell+ ELSE r> voc-find THEN
 146   @ dup IF link>name name>string true THEN ;
 147
 148
 149 \ encode-* words and all helpers
 150
 151 \ Start a encoded property string
 152 : encode-start ( -- prop 0 )
 153    ['] .prop-int compile,
 154    false to encode-first?
 155    here 0
 156 ;
 157
 158 : encode-int ( val -- prop prop-len )
 159    encode-first? IF
 160       ['] .prop-int compile,             \ Execution token for print
 161       false to encode-first?
 162    THEN
 163    here swap lbsplit c, c, c, c, /l
 164 ;
 165 : encode-bytes ( str len -- prop-addr prop-len )
 166    encode-first? IF
 167       ['] .prop-bytes compile,           \ Execution token for print
 168       false to encode-first?
 169    THEN
 170    here over 2dup 2>r allot swap move 2r>
 171 ;
 172 : encode-string ( str len -- prop-addr prop-len )
 173    encode-first? IF
 174       ['] .prop-string compile,          \ Execution token for print
 175       false to encode-first?
 176    THEN
 177    encode-bytes 0 c, char+
 178 ;
 179
 180 : encode+ ( prop1-addr prop1-len prop2-addr prop2-len -- prop-addr prop-len )
 181    nip + ;
 182 : encode-int+  encode-int encode+ ;
 183 : encode-64    xlsplit encode-int rot encode-int+ ;
 184 : encode-64+   encode-64 encode+ ;
 185
 186
 187 \ Helpers for common nodes.  Should perhaps remove "compatible", as it's
 188 \ not typically a single string.
 189 : device-name  encode-string s" name"        property ;
 190 : device-type  encode-string s" device_type" property ;
 191 : model        encode-string s" model"       property ;
 192 : compatible   encode-string s" compatible"  property ;