[OpenSPARC-T2-SAM] / obp / obp / dev / sun4v-devices / vcommon / probe.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: probe.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: @(#)probe.fth 1.6 07/05/01
purpose:
copyright: Copyright 2007 Sun Microsystems, Inc.  All Rights Reserved
copyright: Use is subject to license terms.

headerless

fload ${BP}/dev/utilities/cif.fth	\ for phandle>devname

h# 100 dup constant MAX-PATH-LEN buffer: path-buf

defer package-to-path  ( len buf phandle -- len' )
0 " package-to-path" do-cif is package-to-path

: phandle>devname  ( phandle -- $path )
   path-buf tuck MAX-PATH-LEN swap rot package-to-path
;

: $=  ( $str1 $str2 -- =? )
   rot tuck =  if  comp 0=  else  3drop false  then
;

0 value builtin-phandle

: init-builtin-drivers  ( -- )
   " /packages/SUNW,builtin-drivers" find-package 0= if
	cmn-error[ " "tCan't find builtin-drivers package" ]cmn-end
        abort
  then
  to builtin-phandle
;

: md-next-fwd  ( node fwd|0 -- entry|0 )
   begin
      over swap md-next-prop dup	( node next )
   while
      dup md-prop-type ascii a = if	( node next )
         dup md-prop-name " fwd" $= if	( node next )
            nip exit			( entry )
         then				( node next )
      then				( node next )
   repeat
   nip					( 0 )
;

: md-applyto-fwds  ( ??? acf node -- ??? )
   0 				        ( ?? acf node 0 )
   begin
      2dup md-next-fwd nip dup		( ?? acf node next-fwd|0 next-fwd|0 )
   while
      dup md-decode-prop drop		( ?? acf node next-fwd fwd-node ) 
      -rot >r >r swap >r r@		( ?? fwd-node acf )
      catch ?dup if   
         r> r> r> 3drop throw
      then
      r> r> r>				( acf node next-fwd )
   repeat   
   3drop				(  )
;

: required-prop  ( node $name type -- val,type | buf,len,type )
   >r 3dup r>				( node $name node $name type )
   md-find-prop ?dup 0= if
      rot md-node-name			( prop-name$ node-name$ )
      cmn-error[ " Missing ""%s"" property in ""%s"" node of " cmn-append 
              " the Machine Description " 
      ]cmn-end				( )
      abort 				( )
   else
      nip nip nip md-decode-prop
   then
;

\ peel the extra 0 off the MD_PROP_DATA version of compatible
: get-compatible-prop ( node -- $compatible | 0 )
   " compatible" -1 md-find-prop dup if 	( entry | 0 ) 
      md-decode-prop ascii d = if  
         1- 
      then
   then
;

: get-cfg-handle  ( node -- cfg-handle )
   " cfg-handle" ascii v required-prop drop
;

\ Cycle through the compatible property looking for a matching driver
: find-fcode-driver  ( node -- acf true | false )
   dup get-compatible-prop ?dup if
      begin 				( node $comp )
         decode-string ?dup		( node $comp' $entry )
      while
         builtin-phandle find-method if	( node $comp acf )
            nip nip nip true exit	( acf true )
         then				( node $comp )
      repeat				( node $comp )
      3drop				( node )
   then

   \ fall back to name property
   " name" -1 md-find-prop dup if
      md-decode-prop drop 		( $name )
      builtin-phandle find-method	( acf,true | false )
   then
;

: load-fcode-driver  ( acf -- )
   catch ?dup if
      cmn-fatal[ " Unable to load FCODE driver" ]cmn-end
   then
;

\ Service channel nodes have a corresponding platform_service node in the MD
: find-platform-service  ( 0 node -- svc-node|0 )
   dup md-node-name " platform_service" $= if
      nip
   else
      drop
   then
;

: svc-channel?  ( md-node -- svc-node|0 )
   0 ['] find-platform-service rot md-applyto-fwds
;

\ Create standard MD based properties for virtual devices with no FCODE driver
: create-standard-props  ( md-node -- )
   dup " name" -1 required-prop drop 	encode-string " name"       property
   dup get-cfg-handle 		 	encode-int    " reg"        property

   get-compatible-prop ?dup if 	 	
	encode-string " compatible" property
   then

;

\ Create service channel specific properties
: create-svc-channel-props  ( svc-node -- )
   dup " flags" ascii v required-prop drop encode-int " flags" 	  property
   dup " mtu"	ascii v required-prop drop encode-int " mtu" 	  property
       " sid"	ascii v required-prop drop encode-int " channel#" property

\ append glvc to the compatible property
   " compatible" get-my-property 0= if
      1- encode-string
   else
      0 0 encode-bytes
   then	
   " glvc" encode-string encode+ " compatible" property
;


\ retrieve the ino property from the node or it's associated service channel
: get-ino-prop  ( node -- prop|0 )
   dup " ino" -1 md-find-prop ?dup 0= if	( node )
      svc-channel? dup if			( node )
         " ino" -1 md-find-prop			( prop|0 )
      then					( prop|0 )
   else						( node prop )
      nip					( prop )
   then						( prop|0 )
;

\ for PROP_VAL  interrupts = 1
\ for PROP_DATA interrupts = vector containing 1-n for each entry in PROP_DATA 
: create-interrupts-prop  ( md-node -- ) 
   get-ino-prop ?dup if 				( prop )
      md-decode-prop ascii v = if	\ PROP_VAL	( val )
         drop 1 encode-int				( str,len )
      else				\ PROP_DATA	( buf,len )
         nip 0 0 encode-bytes				( str',len' )
         rot  /x / 0 ?do
            i 1+ encode-int encode+			( str,len'' )
         loop
      then
      " interrupts" property				(  )
   then
;

\ Create a devalias based on $path,$name.
\ If a devalias '$name' is already present don't create a new one.
: $devalias  ( $path $name -- )
   " /aliases" find-package  if		( $path $name alias-phandle )
      3dup get-package-property if	( $path $name al-ph )
	 my-self >r 0 to my-self	( $path $name al-h )	( r: my-s )
	 push-package			( $path $name )		( r: my-s )
	    property			(  )			( r: my-s )
	 pop-package			(  )			( r: my-s )
	 r> to my-self			(  )
      else				( $path $name al-ph $prop )
	 3drop 3drop drop		(  )
      then				(  )
   else					( $path $name )
      2drop 2drop			(  )
   then					(  )
;

\ If the virtual device node contains a devalias prop, create
\ a devalias pointing to this device with that as the name
\
\ Note: phandle>devname (rather than ihandle>devname) is used so that the
\       devalias doesn't include device arguments.  This is important because
\       MD pointers are passed in as dev-args during probe time.
: create-devalias  ( node -- )
   " devalias" ascii s md-find-prop ?dup if	( prop )
      my-self ihandle>phandle phandle>devname 	( prop $path )
      encode-string rot				( $path prop )
      md-decode-prop drop			( $path $name )
      $devalias					(  )
   then						(  )
;


\ Create virtual device based on an MD node
: create-device-node ( md-node --  )
   dup get-cfg-handle					( node cfg-h )
   over encode-int rot encode-unit			( node $args $reg )
   new-device set-args					( node )
      dup create-interrupts-prop			( node )
      dup find-fcode-driver if				( node )
         dup load-fcode-driver drop			( node )
      else						( node )
         dup create-standard-props			( node )
         dup svc-channel? ?dup if			( node svc-node )
            create-svc-channel-props			( node )
         then						( node )
      then						( node )
      create-devalias					(  )
   finish-device
;

\ Add an entry into nexus's interrupt-map property based on child's MD node.
\ Interrupt map is an array with entries of type:
\ [<child-unit-address> <child-ispec> <iparent.phandle> <iparent.ispec>]
\ 
\ <iparent.ispec> is an integer -> type PROP_VAL  (ino[0]) 
\          or array of integers -> type PROP_DATA (ino[x]) 
\
\               <child-unit-address>      = cfg-handle
\               <child-ispec>             = x + 1
\               <iparent.phandle>         = vnexus phandle
\               <iparent.ispec>           = ino[x]
\

0 value tmp-cfg

: add-interrupt-map-entry ( xdr,len node -- xdr,len' )
   dup get-cfg-handle to tmp-cfg
   get-ino-prop ?dup if
      md-decode-prop ascii v = if \ PROP VAL
         -rot					( ino xdr,len )
         tmp-cfg en+				( ino xdr'len' )
         1 en+					( ino xdr'len' )
         my-interrupt-parent en+		( ino xdr'len' )
         rot en+				( xdr'len' )
      else		\ PROP DATA		( xdr,len data,len )
         0 ?do					( xdr,len data )
            -rot				( data xdr,len )
            tmp-cfg en+				( data xdr',len' )
            i /x / 1+ en+			( data xdr',len' )
            my-interrupt-parent en+		( data xdr',len' )
            2 pick i + x@ en+			( data xdr',len' )
            rot					( xdr',len' data )
         /x +loop				( xdr',len' data )
         drop					( xdr',len' )
      then
   then
;

headers

\ Create children of virtual-devices nexus
: create-virtual-devices ( -- )
   init-builtin-drivers   
   0 " virtual-devices" md-find-node 			( node|0 )
   ?dup if
      ['] create-device-node swap md-applyto-fwds	(  )
   then
;

\ Create children of virtual-devices nexus
: create-channel-devices ( -- )
   init-builtin-drivers   
   0 " channel-devices" md-find-node 			( node|0 )
   ?dup if
      ['] create-device-node swap md-applyto-fwds	(  )
   then
;

\ Create interrupt-map for virtual-devices nexus
: create-interrupt-map  ( -- )
   0 " virtual-devices" md-find-node
   ?dup if
      0 0 encode-bytes rot				( xdr,len node )
      ['] add-interrupt-map-entry swap md-applyto-fwds	( xdr',len' )
      " interrupt-map" property				(  )
   then
;
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: probe.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: @(#)probe.fth 1.6 07/05/01
	43	purpose:
	44	copyright: Copyright 2007 Sun Microsystems, Inc. All Rights Reserved
	45	copyright: Use is subject to license terms.
	46
	47	headerless
	48
	49	fload ${BP}/dev/utilities/cif.fth \ for phandle>devname
	50
	51	h# 100 dup constant MAX-PATH-LEN buffer: path-buf
	52
	53	defer package-to-path ( len buf phandle -- len' )
	54	0 " package-to-path" do-cif is package-to-path
	55
	56	: phandle>devname ( phandle -- $path )
	57	path-buf tuck MAX-PATH-LEN swap rot package-to-path
	58	;
	59
	60	: $= ( $str1 $str2 -- =? )
	61	rot tuck = if comp 0= else 3drop false then
	62	;
	63
	64	0 value builtin-phandle
65
66	: init-builtin-drivers ( -- )
67	" /packages/SUNW,builtin-drivers" find-package 0= if
68	cmn-error[ " "tCan't find builtin-drivers package" ]cmn-end
69	abort
70	then
71	to builtin-phandle
72	;
73
74	: md-next-fwd ( node fwd\|0 -- entry\|0 )
75	begin
76	over swap md-next-prop dup ( node next )
77	while
78	dup md-prop-type ascii a = if ( node next )
79	dup md-prop-name " fwd" $= if ( node next )
80	nip exit ( entry )
81	then ( node next )
82	then ( node next )
83	repeat
84	nip ( 0 )
85	;
86
87	: md-applyto-fwds ( ??? acf node -- ??? )
88	0 ( ?? acf node 0 )
89	begin
90	2dup md-next-fwd nip dup ( ?? acf node next-fwd\|0 next-fwd\|0 )
91	while
92	dup md-decode-prop drop ( ?? acf node next-fwd fwd-node )
93	-rot >r >r swap >r r@ ( ?? fwd-node acf )
94	catch ?dup if
95	r> r> r> 3drop throw
96	then
97	r> r> r> ( acf node next-fwd )
98	repeat
99	3drop ( )
100	;
101
102	: required-prop ( node $name type -- val,type \| buf,len,type )
103	>r 3dup r> ( node $name node $name type )
104	md-find-prop ?dup 0= if
105	rot md-node-name ( prop-name$ node-name$ )
106	cmn-error[ " Missing ""%s"" property in ""%s"" node of " cmn-append
107	" the Machine Description "
108	]cmn-end ( )
109	abort ( )
110	else
111	nip nip nip md-decode-prop
112	then
113	;
114
115	\ peel the extra 0 off the MD_PROP_DATA version of compatible
116	: get-compatible-prop ( node -- $compatible \| 0 )
117	" compatible" -1 md-find-prop dup if ( entry \| 0 )
118	md-decode-prop ascii d = if
119	1-
120	then
121	then
122	;
123
124	: get-cfg-handle ( node -- cfg-handle )
125	" cfg-handle" ascii v required-prop drop
126	;
127
128	\ Cycle through the compatible property looking for a matching driver
129	: find-fcode-driver ( node -- acf true \| false )
130	dup get-compatible-prop ?dup if
131	begin ( node $comp )
132	decode-string ?dup ( node $comp' $entry )
133	while
134	builtin-phandle find-method if ( node $comp acf )
135	nip nip nip true exit ( acf true )
136	then ( node $comp )
137	repeat ( node $comp )
138	3drop ( node )
139	then
140
141	\ fall back to name property
142	" name" -1 md-find-prop dup if
143	md-decode-prop drop ( $name )
144	builtin-phandle find-method ( acf,true \| false )
145	then
146	;
147
148	: load-fcode-driver ( acf -- )
149	catch ?dup if
150	cmn-fatal[ " Unable to load FCODE driver" ]cmn-end
151	then
152	;
153
154	\ Service channel nodes have a corresponding platform_service node in the MD
155	: find-platform-service ( 0 node -- svc-node\|0 )
156	dup md-node-name " platform_service" $= if
157	nip
158	else
159	drop
160	then
161	;
162
163	: svc-channel? ( md-node -- svc-node\|0 )
164	0 ['] find-platform-service rot md-applyto-fwds
165	;
166
167	\ Create standard MD based properties for virtual devices with no FCODE driver
168	: create-standard-props ( md-node -- )
169	dup " name" -1 required-prop drop encode-string " name" property
170	dup get-cfg-handle encode-int " reg" property
171
172	get-compatible-prop ?dup if
173	encode-string " compatible" property
174	then
175
176	;
177
178	\ Create service channel specific properties
179	: create-svc-channel-props ( svc-node -- )
180	dup " flags" ascii v required-prop drop encode-int " flags" property
181	dup " mtu" ascii v required-prop drop encode-int " mtu" property
182	" sid" ascii v required-prop drop encode-int " channel#" property
183
184	\ append glvc to the compatible property
185	" compatible" get-my-property 0= if
186	1- encode-string
187	else
188	0 0 encode-bytes
189	then
190	" glvc" encode-string encode+ " compatible" property
191	;
192
193
194	\ retrieve the ino property from the node or it's associated service channel
195	: get-ino-prop ( node -- prop\|0 )
196	dup " ino" -1 md-find-prop ?dup 0= if ( node )
197	svc-channel? dup if ( node )
198	" ino" -1 md-find-prop ( prop\|0 )
199	then ( prop\|0 )
200	else ( node prop )
201	nip ( prop )
202	then ( prop\|0 )
203	;
204
205	\ for PROP_VAL interrupts = 1
206	\ for PROP_DATA interrupts = vector containing 1-n for each entry in PROP_DATA
207	: create-interrupts-prop ( md-node -- )
208	get-ino-prop ?dup if ( prop )
209	md-decode-prop ascii v = if \ PROP_VAL ( val )
210	drop 1 encode-int ( str,len )
211	else \ PROP_DATA ( buf,len )
212	nip 0 0 encode-bytes ( str',len' )
213	rot /x / 0 ?do
214	i 1+ encode-int encode+ ( str,len'' )
215	loop
216	then
217	" interrupts" property ( )
218	then
219	;
220
221	\ Create a devalias based on $path,$name.
222	\ If a devalias '$name' is already present don't create a new one.
223	: $devalias ( $path $name -- )
224	" /aliases" find-package if ( $path $name alias-phandle )
225	3dup get-package-property if ( $path $name al-ph )
226	my-self >r 0 to my-self ( $path $name al-h ) ( r: my-s )
227	push-package ( $path $name ) ( r: my-s )
228	property ( ) ( r: my-s )
229	pop-package ( ) ( r: my-s )
230	r> to my-self ( )
231	else ( $path $name al-ph $prop )
232	3drop 3drop drop ( )
233	then ( )
234	else ( $path $name )
235	2drop 2drop ( )
236	then ( )
237	;
238
239	\ If the virtual device node contains a devalias prop, create
240	\ a devalias pointing to this device with that as the name
241	\
242	\ Note: phandle>devname (rather than ihandle>devname) is used so that the
243	\ devalias doesn't include device arguments. This is important because
244	\ MD pointers are passed in as dev-args during probe time.
245	: create-devalias ( node -- )
246	" devalias" ascii s md-find-prop ?dup if ( prop )
247	my-self ihandle>phandle phandle>devname ( prop $path )
248	encode-string rot ( $path prop )
249	md-decode-prop drop ( $path $name )
250	$devalias ( )
251	then ( )
252	;
253
254
255	\ Create virtual device based on an MD node
256	: create-device-node ( md-node -- )
257	dup get-cfg-handle ( node cfg-h )
258	over encode-int rot encode-unit ( node $args $reg )
259	new-device set-args ( node )
260	dup create-interrupts-prop ( node )
261	dup find-fcode-driver if ( node )
262	dup load-fcode-driver drop ( node )
263	else ( node )
264	dup create-standard-props ( node )
265	dup svc-channel? ?dup if ( node svc-node )
266	create-svc-channel-props ( node )
267	then ( node )
268	then ( node )
269	create-devalias ( )
270	finish-device
271	;
272
273	\ Add an entry into nexus's interrupt-map property based on child's MD node.
274	\ Interrupt map is an array with entries of type:
275	\ [<child-unit-address> <child-ispec> <iparent.phandle> <iparent.ispec>]
276	\
277	\ <iparent.ispec> is an integer -> type PROP_VAL (ino[0])
278	\ or array of integers -> type PROP_DATA (ino[x])
279	\
280	\ <child-unit-address> = cfg-handle
281	\ <child-ispec> = x + 1
282	\ <iparent.phandle> = vnexus phandle
283	\ <iparent.ispec> = ino[x]
284	\
285
286	0 value tmp-cfg
287
288	: add-interrupt-map-entry ( xdr,len node -- xdr,len' )
289	dup get-cfg-handle to tmp-cfg
290	get-ino-prop ?dup if
291	md-decode-prop ascii v = if \ PROP VAL
292	-rot ( ino xdr,len )
293	tmp-cfg en+ ( ino xdr'len' )
294	1 en+ ( ino xdr'len' )
295	my-interrupt-parent en+ ( ino xdr'len' )
296	rot en+ ( xdr'len' )
297	else \ PROP DATA ( xdr,len data,len )
298	0 ?do ( xdr,len data )
299	-rot ( data xdr,len )
300	tmp-cfg en+ ( data xdr',len' )
301	i /x / 1+ en+ ( data xdr',len' )
302	my-interrupt-parent en+ ( data xdr',len' )
303	2 pick i + x@ en+ ( data xdr',len' )
304	rot ( xdr',len' data )
305	/x +loop ( xdr',len' data )
306	drop ( xdr',len' )
307	then
308	then
309	;
310
311	headers
312
313	\ Create children of virtual-devices nexus
314	: create-virtual-devices ( -- )
315	init-builtin-drivers
316	0 " virtual-devices" md-find-node ( node\|0 )
317	?dup if
318	['] create-device-node swap md-applyto-fwds ( )
319	then
320	;
321
322	\ Create children of virtual-devices nexus
323	: create-channel-devices ( -- )
324	init-builtin-drivers
325	0 " channel-devices" md-find-node ( node\|0 )
326	?dup if
327	['] create-device-node swap md-applyto-fwds ( )
328	then
329	;
330
331	\ Create interrupt-map for virtual-devices nexus
332	: create-interrupt-map ( -- )
333	0 " virtual-devices" md-find-node
334	?dup if
335	0 0 encode-bytes rot ( xdr,len node )
336	['] add-interrupt-map-entry swap md-applyto-fwds ( xdr',len' )
337	" interrupt-map" property ( )
338	then
339	;