forth/device/extra.fs

   1 \ tag: Useful device related functions
   2 \
   3 \ Copyright (C) 2003, 2004 Samuel Rydh
   4 \
   5 \ See the file "COPYING" for further information about
   6 \ the copyright and warranty status of this work.
   7 \
   8
   9
  10 : parent ( phandle -- parent.phandle|0 )
  11   >dn.parent @
  12 ;
  13
  14 \ -------------------------------------------------------------------
  15 \ property helpers
  16 \ -------------------------------------------------------------------
  17
  18 : int-property ( value name-str name-len -- )
  19         rot encode-int 2swap property
  20 ;
  21
  22 \ -------------------------------------------------------------------------
  23 \ property utils
  24 \ -------------------------------------------------------------------------
  25
  26 \ like property (except it takes a phandle as an argument)
  27 : encode-property ( buf len propname propname-len phandle -- )
  28         dup 0= abort" null phandle"
  29
  30   my-self >r 0 to my-self
  31   active-package >r active-package!
  32
  33   property
  34
  35   r> active-package!
  36   r> to my-self
  37 ;
  38
  39 \ -------------------------------------------------------------------
  40 \ device tree iteration
  41 \ -------------------------------------------------------------------
  42
  43 : iterate-tree ( phandle -- phandle|0 )
  44   ?dup 0= if device-tree @ exit then
  45
  46   \ children first
  47   dup child if
  48     child exit
  49   then
  50
  51   \ then peers
  52   dup peer if
  53     peer exit
  54   then
  55
  56   \ then peer of a parent
  57   begin >dn.parent @ dup while
  58     dup peer if peer exit then
  59   repeat
  60 ;
  61
  62 : iterate-tree-begin ( -- first_node )
  63   device-tree @
  64 ;
  65
  66
  67 \ -------------------------------------------------------------------
  68 \ device tree iteration
  69 \ -------------------------------------------------------------------
  70
  71 : iterate-device-type ( lastph|0 type-str type-len -- 0|nextph )
  72   rot
  73   begin iterate-tree ?dup while
  74     >r
  75     2dup " device_type" r@ get-package-property if 0 0 then
  76     dup 0> if 1- then
  77     strcmp 0= if 2drop r> exit then
  78     r>
  79   repeat
  80   2drop 0
  81 ;
  82
  83 \ -------------------------------------------------------------------
  84 \ device tree "cut and paste"
  85 \ -------------------------------------------------------------------
  86
  87 \ add a subtree to the current device node
  88 : link-nodes ( phandle -- )
  89   \ reparent phandle and peers
  90   dup begin ?dup while
  91     dup >dn.parent active-package !
  92     >dn.peer @
  93   repeat
  94
  95   \ add to list of children
  96   active-package >dn.child
  97   begin dup @ while @ >dn.peer repeat dup . !
  98 ;
  99
 100 : link-node ( phandle -- )
 101   0 over >dn.peer !
 102   link-nodes
 103 ;