Return to extra.fs CVS log

Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / device

Annotation of qemu/roms/openbios/forth/device/extra.fs, revision 1.1

1.1     ! root        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: ;

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.