summaryrefslogtreecommitdiffstats
path: root/qemu/roms/SLOF/slof/fs/property.fs
blob: cb99fbe9d26c7be79c51e54b5b8ec19ef772680e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
\ *****************************************************************************
\ * Copyright (c) 2004, 2008 IBM Corporation
\ * All rights reserved.
\ * This program and the accompanying materials
\ * are made available under the terms of the BSD License
\ * which accompanies this distribution, and is available at
\ * http://www.opensource.org/licenses/bsd-license.php
\ *
\ * Contributors:
\ *     IBM Corporation - initial implementation
\ ****************************************************************************/


\ Properties 5.3.5

\ Words on the property list for a node are actually executable words,
\ that return the address and length of the property's data.  Special
\ nodes like /options can have their properties use specialized code to
\ dynamically generate their data; most nodes just use a 2CONSTANT.

\ Put the type as byte before the property
\   { int = 1, bytes = 2, string = 3 }
\ This is used by .properties for pretty print

\ Flag for type encoding, encode-* resets, set-property set the flag
true value encode-first?

: decode-int  over >r 4 /string r> 4c@ swap 2swap swap bljoin ;
: decode-64 decode-int -rot decode-int -rot 2swap swap lxjoin ;
: decode-string ( prop-addr1 prop-len1 -- prop-addr2 prop-len2 str len )
   dup 0= IF 2dup EXIT THEN \ string properties with zero length
   over BEGIN dup c@ 0= IF 1+ -rot swap 2 pick over - rot over - -rot 1-
    EXIT THEN 1+ AGAIN ;

\ Remove a word from a wordlist.
: (prune) ( name len head -- )
  dup >r (find) ?dup IF r> BEGIN dup @ WHILE 2dup @ = IF
  >r @ r> ! EXIT THEN @ REPEAT 2drop ELSE r> drop THEN ;
: prune ( name len -- )  last (prune) ;

: set-property ( data dlen name nlen phandle -- )
    true to encode-first?
    get-current >r  node>properties @ set-current
    2dup prune  $2CONSTANT  r> set-current ;
: delete-property ( name nlen -- )
    get-node get-current >r  node>properties @ set-current
    prune r> set-current ;
: property ( data dlen name nlen -- )  get-node set-property ;
: get-property ( str len phandle -- true | data dlen false )
  ?dup 0= IF cr cr cr ." get-property for " type ."  on zero phandle"
  cr cr true EXIT THEN
  node>properties @ voc-find dup IF link> execute false ELSE drop true THEN ;
: get-package-property ( str len phandle -- true | data dlen false )
  get-property ;
: get-my-property ( str len -- true | data dlen false )
  my-self ihandle>phandle get-property ;
: get-parent-property ( str len -- true | data dlen false )
  my-parent ihandle>phandle get-property ;

: get-inherited-property ( str len -- true | data dlen false )
   my-self ihandle>phandle
   BEGIN
      3dup get-property 0= IF
         \ Property found
         rot drop rot drop rot drop false EXIT
      THEN
      parent dup 0= IF
         \ Root node has been reached, but property has not been found
         3drop true EXIT
      THEN
   AGAIN
;

\ Print out properties.

20 CONSTANT indent-prop

: .prop-int ( str len -- )
   space
   400 min 0
   ?DO
      i over + dup                                 ( str act-addr act-addr )
      c@ 2 0.r 1+ dup c@ 2 0.r 1+ dup c@ 2 0.r 1+ c@ 2 0.r ( str )
      i c and c = IF                           \ check for multipleof 16 bytes
	 cr indent @ indent-prop + 1+ 0        \ linefeed + indent
	 DO
	    space                              \ print spaces
	 LOOP
      ELSE
	 space space                           \ print two spaces
      THEN
   4 +LOOP
   drop
;

: .prop-bytes ( str len -- )
   2dup -4 and .prop-int                       ( str len )

   dup 3 and dup IF                            ( str len len%4 )
      >r -4 and + r>                           ( str' len%4 )
      bounds                                   ( str' str'+len%4 )
      DO
	 i c@ 2 0.r                            \ Print last 3 bytes
      LOOP
   ELSE
      3drop
   THEN
;

: .prop-string ( str len )
   2dup space type
   cr indent @ indent-prop + 0 DO space LOOP   \ Linefeed
   .prop-bytes
;

: .propbytes ( xt -- )
   execute dup
   IF
      over cell- @ execute
   ELSE
      2drop
   THEN
;
: .property ( lfa -- )
    cr indent @ 0
    ?DO
	space
    LOOP
    link> dup >name name>string 2dup type nip ( len )
    indent-prop swap -                        ( xt 20-len )
    dup 0< IF drop 0 THEN 0                   ( xt number-of-space 0 )
    ?DO
	space
    LOOP
    .propbytes
;
: (.properties) ( phandle -- )
  node>properties @ cell+ @ BEGIN dup WHILE dup .property @ REPEAT drop ;
: .properties ( -- )
  get-node (.properties) ;

: next-property ( str len phandle -- false | str' len' true )
  ?dup 0= IF device-tree @ THEN  \ XXX: is this line required?
  node>properties @
  >r 2dup 0= swap 0= or IF 2drop r> cell+ ELSE r> voc-find THEN
  @ dup IF link>name name>string true THEN ;


\ encode-* words and all helpers

\ Start a encoded property string
: encode-start ( -- prop 0 )
   ['] .prop-int compile,
   false to encode-first?
   here 0
;

: encode-int ( val -- prop prop-len )
   encode-first? IF
      ['] .prop-int compile,             \ Execution token for print
      false to encode-first?
   THEN
   here swap lbsplit c, c, c, c, /l
;
: encode-bytes ( str len -- prop-addr prop-len )
   encode-first? IF
      ['] .prop-bytes compile,           \ Execution token for print
      false to encode-first?
   THEN
   here over 2dup 2>r allot swap move 2r>
;
: encode-string ( str len -- prop-addr prop-len )
   encode-first? IF
      ['] .prop-string compile,          \ Execution token for print
      false to encode-first?
   THEN
   encode-bytes 0 c, char+
;

: encode+ ( prop1-addr prop1-len prop2-addr prop2-len -- prop-addr prop-len )
   nip + ;
: encode-int+  encode-int encode+ ;
: encode-64    xlsplit encode-int rot encode-int+ ;
: encode-64+   encode-64 encode+ ;


\ Helpers for common nodes.  Should perhaps remove "compatible", as it's
\ not typically a single string.
: device-name  encode-string s" name"        property ;
: device-type  encode-string s" device_type" property ;
: model        encode-string s" model"       property ;
: compatible   encode-string s" compatible"  property ;