diff options
Diffstat (limited to 'slof/fs/node.fs')
| -rw-r--r-- | slof/fs/node.fs | 663 |
1 files changed, 663 insertions, 0 deletions
diff --git a/slof/fs/node.fs b/slof/fs/node.fs new file mode 100644 index 0000000..4ae52b0 --- /dev/null +++ b/slof/fs/node.fs @@ -0,0 +1,663 @@ +\ ***************************************************************************** +\ * Copyright (c) 2004, 2007 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 +\ ****************************************************************************/ + + +\ Device nodes. + +VARIABLE device-tree +VARIABLE current-node +: get-node current-node @ dup 0= ABORT" No active device tree node" ; + +STRUCT + cell FIELD node>peer + cell FIELD node>parent + cell FIELD node>child + cell FIELD node>properties + cell FIELD node>words + cell FIELD node>instance + cell FIELD node>instance-size + cell FIELD node>space? + cell FIELD node>space + cell FIELD node>addr1 + cell FIELD node>addr2 + cell FIELD node>addr3 +END-STRUCT + +: find-method ( str len phandle -- false | xt true ) + node>words @ voc-find dup IF link> true THEN ; + +\ Instances. +#include "instance.fs" + +1000 CONSTANT max-instance-size +3000000 CONSTANT space-code-mask + +: create-node ( parent -- new ) + max-instance-size alloc-mem dup max-instance-size erase >r + align wordlist >r wordlist >r + here 0 , swap , 0 , r> , r> , r> , /instance-header , 0 , 0 , 0 , 0 , ; + +: peer node>peer @ ; +: parent node>parent @ ; +: child node>child @ ; +: peer dup IF peer ELSE drop device-tree @ THEN ; + + +: link ( new head -- ) \ link a new node at the end of a linked list + BEGIN dup @ WHILE @ REPEAT ! ; +: link-node ( parent child -- ) + swap dup IF node>child link ELSE drop device-tree ! THEN ; + +\ Set a node as active node. +: set-node ( phandle -- ) + current-node @ IF previous THEN + dup current-node ! + ?dup IF node>words @ also context ! THEN + definitions ; +: get-parent get-node parent ; + + +: new-node ( -- phandle ) \ active node becomes new node's parent; + \ new node becomes active node +\ XXX: change to get-node, handle root node creation specially + current-node @ dup create-node + tuck link-node dup set-node ; + +: finish-node ( -- ) +\ we should resize the instance template buffer, but that doesn't help with our +\ current implementation of alloc-mem anyway, so never mind. XXX + get-node parent set-node ; + +: device-end ( -- ) 0 set-node ; + +\ Properties. +CREATE $indent 100 allot VARIABLE indent 0 indent ! +#include "property.fs" + +\ Unit address. +: #address-cells s" #address-cells" rot parent get-property + ABORT" parent doesn't have a #address-cells property!" + decode-int nip nip ; +: my-#address-cells get-node #address-cells ; \ bit of a misnomer... "my-" + +: encode-phys ( phys.hi ... phys.low -- str len ) + encode-first? IF encode-start ELSE here 0 THEN + my-#address-cells 0 ?DO rot encode-int+ LOOP ; + +: decode-phys + my-#address-cells BEGIN dup WHILE 1- >r decode-int r> swap >r REPEAT drop + my-#address-cells BEGIN dup WHILE 1- r> swap REPEAT drop ; +: decode-phys-and-drop + my-#address-cells BEGIN dup WHILE 1- >r decode-int r> swap >r REPEAT 3drop + my-#address-cells BEGIN dup WHILE 1- r> swap REPEAT drop ; +: reg >r encode-phys r> encode-int+ s" reg" property ; + + +: >space node>space @ ; +: >space? node>space? @ ; +: >address dup >r #address-cells dup 3 > IF r@ node>addr3 @ swap THEN + dup 2 > IF r@ node>addr2 @ swap THEN + 1 > IF r@ node>addr1 @ THEN r> drop ; +: >unit dup >r >address r> >space ; + +: my-space ( -- phys.hi ) + my-self ihandle>phandle >space ; +: my-address my-self ihandle>phandle >address ; +: my-unit my-self ihandle>phandle >unit ; + +\ Return lower 64 bit of address +: my-unit-64 ( -- phys.lo+1|phys.lo ) + my-unit ( phys.lo ... phys.hi ) + my-self ihandle>phandle #address-cells ( phys.lo ... phys.hi #ad-cells ) + CASE + 1 OF EXIT ENDOF + 2 OF lxjoin EXIT ENDOF + 3 OF drop lxjoin EXIT ENDOF + dup OF 2drop lxjoin EXIT ENDOF + ENDCASE +; + +: set-space get-node dup >r node>space ! true r> node>space? ! ; +: set-address my-#address-cells 1 ?DO + get-node node>space i cells + ! LOOP ; +: set-unit set-space set-address ; +: set-unit-64 ( phys.lo|phys.hi -- ) + my-#address-cells 2 <> IF + ." set-unit-64: #address-cells <> 2 " abort + THEN + xlsplit set-unit +; + +\ Never ever use this in actual code, only when debugging interactively. +\ Thank you. +: set-args ( arg-str len unit-str len -- ) + s" decode-unit" get-parent $call-static set-unit set-my-args ; + +: $cat-unit dup parent 0= IF drop EXIT THEN + dup >space? not IF drop EXIT THEN + dup >r >unit s" encode-unit" r> parent $call-static dup IF + dup >r here swap move s" @" $cat here r> $cat + ELSE 2drop THEN ; + +\ Getting basic info about a node. +: node>name dup >r s" name" rot get-property IF r> (u.) ELSE 1- r> drop THEN ; +: node>qname dup node>name rot ['] $cat-unit CATCH IF drop THEN ; +: node>path here 0 rot BEGIN dup WHILE dup parent REPEAT 2drop + dup 0= IF [char] / c, THEN + BEGIN dup WHILE [char] / c, node>qname here over allot swap move + REPEAT drop here 2dup - allot over - ; + +: interposed? ( ihandle -- flag ) + \ We cannot actually detect if an instance is interposed; instead, we look + \ if an instance is part of the "normal" chain that would be opened by + \ open-dev and friends, if there were no interposition. + dup instance>parent @ dup 0= IF 2drop false EXIT THEN + ihandle>phandle swap ihandle>phandle parent <> ; +: instance>qname dup >r interposed? IF s" %" ELSE 0 0 THEN + r@ ihandle>phandle node>qname $cat r> instance>args 2@ + dup IF 2>r s" :" $cat 2r> $cat ELSE 2drop THEN ; +: instance>qpath \ With interposed nodes. + here 0 rot BEGIN dup WHILE dup instance>parent @ REPEAT 2drop + dup 0= IF [char] / c, THEN + BEGIN dup WHILE [char] / c, instance>qname here over allot swap move + REPEAT drop here 2dup - allot over - ; +: instance>path \ Without interposed nodes. + here 0 rot BEGIN dup WHILE + dup interposed? 0= IF dup THEN instance>parent @ REPEAT 2drop + dup 0= IF [char] / c, THEN + BEGIN dup WHILE [char] / c, instance>qname here over allot swap move + REPEAT drop here 2dup - allot over - ; + +: .node node>path type ; +: pwd get-node .node ; + +: .instance instance>qpath type ; +: .chain dup instance>parent @ ?dup IF recurse THEN + cr dup . instance>qname type ; + + +\ Alias helper +defer find-node +: set-alias ( alias-name len device-name len -- ) + encode-string + 2swap s" /aliases" find-node dup IF set-property ELSE drop THEN ; + +: find-alias ( alias-name len -- false | dev-path len ) + s" /aliases" find-node dup IF + get-property 0= IF 1- dup 0= IF nip THEN ELSE false THEN + THEN ; + +: .alias ( alias-name len -- ) + find-alias dup IF type ELSE ." no alias available" THEN ; + +: (.print-alias) ( lfa -- ) + link> dup >name name>string + \ Don't print name property + 2dup s" name" string=ci IF 2drop drop + ELSE cr type space ." : " execute type + THEN ; + +: (.list-alias) ( phandle -- ) + node>properties @ cell+ @ BEGIN dup WHILE dup (.print-alias) @ REPEAT drop ; + +: list-alias ( -- ) + s" /aliases" find-node dup IF (.list-alias) THEN ; + +: devalias ( "{alias-name}<>{device-specifier}<cr>" -- ) + parse-word parse-word dup IF set-alias + ELSE 2drop dup IF .alias + ELSE 2drop list-alias THEN THEN ; + +\ sub-alias does a single iteration of an alias at the begining od dev path +\ expression. de-alias will repeat this until all indirect alising is resolved +: sub-alias ( arg-str arg-len -- arg' len' | false ) + 2dup + 2dup [char] / findchar ?dup IF ELSE 2dup [char] : findchar THEN + ( a l a l [p] -1|0 ) IF nip dup ELSE 2drop 0 THEN >r + ( a l l p -- R:p | a l -- R:0 ) + find-alias ?dup IF ( a l a' p' -- R:p | a' l' -- R:0 ) + r@ IF 2swap r@ - swap r> + swap $cat strdup ( a" l-p+p' -- ) + ELSE ( a' l' -- R:0 ) r> drop ( a' l' -- ) THEN + ELSE ( a l -- R:p | -- R:0 ) r> IF 2drop THEN false ( 0 -- ) THEN +; + +: de-alias ( arg-str arg-len -- arg' len' ) + BEGIN over c@ [char] / <> dup IF drop 2dup sub-alias ?dup THEN + WHILE 2swap 2drop REPEAT +; + + +\ Display the device tree. +: +indent ( not-last? -- ) + IF s" | " ELSE s" " THEN $indent indent @ + swap move 4 indent +! ; +: -indent ( -- ) -4 indent +! ; +: ls-node ( node -- ) + cr $indent indent @ type + dup peer IF ." |-- " ELSE ." +-- " THEN node>qname type ; +: (ls) ( node -- ) + child BEGIN dup WHILE dup ls-node dup child IF + dup peer +indent dup recurse -indent THEN peer REPEAT drop ; +: ls ( -- ) get-node dup cr node>path type (ls) 0 indent ! ; + +: show-devs ( {device-specifier}<eol> -- ) + skipws 0 parse dup IF de-alias ELSE 2drop s" /" THEN ( str len ) + find-node dup 0= ABORT" No such device path" (ls) +; + + +VARIABLE interpose-node +2VARIABLE interpose-args +: interpose ( arg len phandle -- ) interpose-node ! interpose-args 2! ; +: open-node ( arg len phandle -- ihandle | 0 ) + current-node @ >r set-node create-instance set-my-args + ( and set unit-addr ) +\ XXX: assume default of success for nodes without open method + s" open" ['] $call-my-method CATCH IF 2drop true THEN + 0= IF my-self destroy-instance 0 to my-self THEN + my-self my-parent to my-self r> set-node + \ Handle interposition. + interpose-node @ IF my-self >r to my-self + interpose-args 2@ interpose-node @ + interpose-node off recurse r> to my-self THEN ; +: close-node ( ihandle -- ) + my-self >r to my-self + s" close" ['] $call-my-method CATCH IF 2drop THEN + my-self destroy-instance r> to my-self ; + +: close-dev ( ihandle -- ) + my-self >r to my-self + BEGIN my-self WHILE my-parent my-self close-node to my-self REPEAT + r> to my-self ; + +: new-device ( -- ) + my-self new-node node>instance @ dup to my-self instance>parent ! + get-node my-self instance>node ! ; +: finish-device ( -- ) + ( check for "name" property here, delete this node if not there ) + finish-node my-parent my-self max-instance-size free-mem to my-self ; + +: split ( str len char -- left len right len ) + >r 2dup r> findchar IF >r over r@ 2swap r> 1+ /string ELSE 0 0 THEN ; +: generic-decode-unit ( str len ncells -- addr.lo ... addr.hi ) + dup >r -rot BEGIN r@ WHILE r> 1- >r [char] , split 2swap + $number IF 0 THEN r> swap >r >r REPEAT r> 3drop + BEGIN dup WHILE 1- r> swap REPEAT drop ; +: generic-encode-unit ( addr.lo ... addr.hi ncells -- str len ) + 0 0 rot ?dup IF 0 ?DO rot (u.) $cat s" ," $cat LOOP 1- THEN ; +: hex-decode-unit ( str len ncells -- addr.lo ... addr.hi ) + base @ >r hex generic-decode-unit r> base ! ; +: hex-encode-unit ( addr.lo ... addr.hi ncells -- str len ) + base @ >r hex generic-encode-unit r> base ! ; + +: handle-leading-/ ( path len -- path' len' ) + dup IF over c@ [char] / = IF 1 /string device-tree @ set-node THEN THEN ; +: match-name ( name len node -- match? ) + over 0= IF 3drop true EXIT THEN + s" name" rot get-property IF 2drop false EXIT THEN + 1- string=ci ; \ XXX should use decode-string +0 VALUE #search-unit CREATE search-unit 4 cells allot +: match-unit ( node -- match? ) + node>space search-unit #search-unit 0 ?DO 2dup @ swap @ <> IF + 2drop false UNLOOP EXIT THEN cell+ swap cell+ swap LOOP 2drop true ; +: match-node ( name len node -- match? ) + dup >r match-name r> match-unit and ; \ XXX e3d +: find-kid ( name len -- node|0 ) + dup -1 = IF \ are we supposed to stay in the same node? -> resolve-relatives + 2drop get-node + ELSE + get-node child >r BEGIN r@ WHILE 2dup r@ match-node + IF 2drop r> EXIT THEN r> peer >r REPEAT + r> 3drop false + THEN ; +: set-search-unit ( unit len -- ) + dup 0= IF to #search-unit drop EXIT THEN + s" #address-cells" get-node get-property THROW + decode-int to #search-unit 2drop + s" decode-unit" get-node $call-static + #search-unit 0 ?DO search-unit i cells + ! LOOP ; +: resolve-relatives ( path len -- path' len' ) + \ handle .. + 2dup 2 = swap s" .." comp 0= and IF + get-node parent ?dup IF + set-node drop -1 + ELSE + s" Already in root node." type + THEN + THEN + \ handle . + 2dup 1 = swap c@ [CHAR] . = and IF + drop -1 + THEN + ; +: find-component ( path len -- path' len' args len node|0 ) + [char] / split 2swap ( path'. component. ) + [char] : split 2swap ( path'. args. node-addr. ) + [char] @ split ['] set-search-unit CATCH IF 2drop 2drop 0 EXIT THEN + resolve-relatives find-kid ; + +: .find-node ( path len -- phandle|0 ) + current-node @ >r + handle-leading-/ current-node @ 0= IF 2drop r> set-node 0 EXIT THEN + BEGIN dup WHILE \ handle one component: + find-component ( path len args len node ) dup 0= IF + 3drop 2drop r> set-node 0 EXIT THEN + set-node 2drop REPEAT 2drop + get-node r> set-node ; +' .find-node to find-node +: find-node ( path len -- phandle|0 ) de-alias find-node ; + +: delete-node ( phandle -- ) + dup node>parent @ node>child @ ( phandle 1st peer ) + 2dup = IF + node>peer @ swap node>parent @ node>child ! + EXIT + THEN + dup node>peer @ + BEGIN 2 pick 2dup <> WHILE + drop + nip dup node>peer @ + dup 0= IF 2drop drop unloop EXIT THEN + REPEAT + drop + node>peer @ swap node>peer ! + drop +; + + +: open-dev ( path len -- ihandle|0 ) + de-alias current-node @ >r + handle-leading-/ current-node @ 0= IF 2drop r> set-node 0 EXIT THEN + my-self >r 0 to my-self + 0 0 >r >r BEGIN dup WHILE \ handle one component: + ( arg len ) r> r> get-node open-node to my-self + find-component ( path len args len node ) dup 0= IF + 3drop 2drop my-self close-dev r> to my-self r> set-node 0 EXIT THEN + set-node >r >r REPEAT 2drop + \ open final node + r> r> get-node open-node to my-self + my-self r> to my-self r> set-node ; +: select-dev open-dev dup to my-self ihandle>phandle set-node ; + +: find-device ( str len -- ) \ set as active node + find-node dup 0= ABORT" No such device path" set-node ; +: dev skipws 0 parse find-device ; + +: (lsprop) ( node --) + dup cr $indent indent @ type ." node: " node>qname type + false +indent (.properties) cr -indent ; +: (show-children) ( node -- ) + child BEGIN dup WHILE + dup (lsprop) dup child IF false +indent dup recurse -indent THEN peer + REPEAT drop +; +: lsprop ( {device-specifier}<eol> -- ) + skipws 0 parse dup IF de-alias ELSE 2drop s" /" THEN + find-device get-node dup dup + cr ." node: " node>path type (.properties) cr (show-children) 0 indent ! ; + + +\ node>path does not allot the memory, since it is internally only used +\ for typing. +\ The external variant needs to allot memory ! + +: (node>path) node>path ; + +: node>path ( phandle -- str len ) + node>path dup allot +; + +\ Support for support packages. + +\ The /packages node. +0 VALUE packages + +\ We can't use the standard find-node stuff, as we are required to find the +\ newest (i.e., last in our tree) matching package, not just any. +: find-package ( name len -- false | phandle true ) + 0 >r packages child BEGIN dup WHILE dup >r node>name 2over string=ci r> swap + IF r> drop dup >r THEN peer REPEAT 3drop r> dup IF true THEN ; + +: open-package ( arg len phandle -- ihandle | 0 ) open-node ; +: close-package ( ihandle -- ) close-node ; +: $open-package ( arg len name len -- ihandle | 0 ) + find-package IF open-package ELSE 2drop false THEN ; + + +\ Pseudocode in C Syntax +\ if((addr>=child)&&(addr<=child+size) +\ return (addr - child) + parent +\ else return false +\ +: translate-range ( child parent size addr -- taddr true | addr false ) + swap 3 pick + over \ calculate child+size address + ( child parent size addr child+size ) + > IF \ verify if addr is below child+size address + ( child parent addr ) + 2 pick over \ fetch child and addr for compare + ( child parend addr child addr ) + <= IF \ verify if addr is above child address + ( child parent addr ) + 2 pick - + nip true \ pick child, calculate addr-child + parent, drop child and return true + ( taddr true ) + ELSE + 2drop false \ drop child parent size and return false + ( addr false ) + THEN + ELSE + ( child parent addr ) + nip nip false \ drop child parent size and return false + ( addr false ) + THEN +; + +\ helper function based on decode-int to decode an integer property +\ from a prop-encoded-array +\ my-property cannot be used since this depends on a current instance +: get-property-decoded ( addr len -- n ) + get-node get-property + IF cr cr cr ." get-property-decoded: no such property" EXIT THEN decode-int nip nip +; + +0 VALUE pci-phys-hi +1C000000 CONSTANT pci-stop-mapping-code +\ Explanation to pci-stop-mapping-code: +\ Bits 26..28 are unsused in phys.hi in the IEEE 1275 PCI binding +\ and set to 0. Use value where these bits are set in pci-phys-hi to communicate that +\ translation sould stop. + +\ Helper function to extract one element of the child parent size tuple coded +\ into the ranges properties array, element being exactly one of child, parent +\ and size +: extract-range-element ( ranges-addr ranges-len #cells -- element ranges-addr' ranges-len' ) + \ -rot decode-int 3 roll 1 > IF 20 lshift -rot decode-int 3 roll + THEN -rot + CASE + 1 OF decode-int -rot ENDOF + 2 OF decode-int 20 lshift -rot decode-int 3 roll + -rot ENDOF + 3 OF + BEGIN + dup 0= IF + false ( ranges-addr ranges-len false ) + ELSE + decode-int + pci-phys-hi \ for PCI phys.hi lies on the stack below addr + space-code-mask and + <> \ compare phys.hi + THEN + WHILE + \ discard phys.mid, phys.lo, parent, and size values. Then go to next PCI ranges tuple + 18 dup -rot - -rot + swap + REPEAT + + dup 0= IF ( ranges-addr ranges-len ) + pci-stop-mapping-code to pci-phys-hi ( ranges-addr ranges-len ) + ELSE + \ ranges size >= 8, since phys.hi + \ was read in ELSE of WHILE condition + decode-int 20 lshift -rot decode-int 3 roll + -rot + THEN + ENDOF + ENDCASE +; + +\ Function to convert a whole child parent size sequence into decoded-int format +: extract-range ( ranges-addr ranges-len -- child parent size ranges-addr' ranges-len' ) + \ child + s" #address-cells" get-property-decoded + extract-range-element + \ exit criterium for PCI: ranges-len is 0 and false on top of stack + pci-phys-hi pci-stop-mapping-code = IF EXIT THEN ( ranges-addr ranges-len ) + + \ parent ( child ranges-addr' ranges-len' ) + decode-phys ( child ranges-addr" ranges-len" phys.lo .. phys.hi ) + my-#address-cells 1 > IF 20 lshift + THEN ( child ranges-addr''' ranges-len''' parent ) + -rot ( child parent ranges-addr''' ranges-len''' ) + + \ size + s" #size-cells" get-property-decoded ( child parent ranges-addr''' ranges-len''' #size-cells ) + extract-range-element ( child parent size ranges-addr"" ranges-len"" ) +; + +\ Function to process a whole array one or more of child parent size sequences +\ Prerequisite: Empty ranges handing is assumed to already exist. +: translate-ranges-node ( addr ranges-addr ranges-len -- taddr true|false ) + BEGIN + dup 0 > \ ranges-len > 0 + WHILE + extract-range + pci-phys-hi pci-stop-mapping-code = + IF ( addr ranges-addr ranges-len ) + nip nip EXIT ( false ) + THEN + ( addr child parent size ranges-addr' ranges-len' ) + 2rot ( parent size ranges-addr' ranges-len' addr child ) + 5 roll ( size ranges-addr' ranges-len' addr child parent ) + 5 roll ( ranges-addr' ranges-len' addr child parent size ) + 3 roll ( ranges-addr' ranges-len' child parent size addr ) + translate-range ( ranges-addr' ranges-len' taddr true | ranges-addr' ranges-len' addr false ) + IF nip nip true EXIT + ELSE ( ranges-addr' ranges-len' addr ) + -rot + ( addr ranges-addr' ranges-len' ) + THEN + REPEAT + ( ranges-addr' ranges-len' taddr true | ranges-addr' ranges-len' false ) + \ remove addr ranges-addr' ranges-len' from stack + nip nip \ leaving the 0 ranges-len' as false + ( false ) +; + +\ Helper function to search the first ranges in current node or one of its parents +\ and make that node the 'current node' +\ Prerequisite: root node must have a ranges property +\ Returns address, length, true if ranges property was found, otherwise false. +: translate-set-to-next-ranges-node ( -- addr-ranges len-ranges true|false ) + s" ranges" 2dup get-node get-property + IF + ( addr len true ) + get-parent dup set-node get-property + IF + cr cr cr + s" no translatable address space due to missing ranges property" type + cr cr cr + false + ELSE + true + THEN + ELSE + ( addr len addr-ranges len-ranges ) + rot drop rot drop true + THEN + ( ranges-addr ranges-len true|false ) +; + +: translate-address-end ( phandle-start taddr true|phandle-start false ) + \ get back to the node where translation was started + dup IF + rot ( taddr true phandle-start ) + set-node ( taddr true ) + ELSE + swap ( phandle-start false ) + set-node ( false ) + THEN +; + +\ Function to step up the device tree up to the root node. +\ Contains empty ranges handling. +\ Returns the translated address and true, when the address is translatable, otherwise false. +: translate-ranges ( addr -- taddr true|false ) + BEGIN + \ set-node semantic required here to continue from nodes found below. + translate-set-to-next-ranges-node + not IF false EXIT THEN ( false ) \ address is not translatable + \ due to missing ranges property in the hierarchy. + ( phandle-start addr ranges-addr ranges-len ) + dup 0= + IF + \ empty ranges property detected, assume 1 : 1 translation + 2drop true + ( phandle-start addr true ) + ELSE + ( phandle-start addr ranges-addr ranges-len ) + translate-ranges-node + ( phandle-start taddr true|phandle-start false ) + THEN + dup IF + ( phandle-start taddr true ) \ found a translation + drop + get-parent + dup 0= + IF \ arrived at root node, stop translation + drop true dup + ( phandle-start taddr true true ) + ELSE + \ go to parent and continue + set-node false + ( phandle-start taddr true phandle-parent false ) + THEN + ELSE + true \ address translation failed, exit loop + ( phandle-start false true ) + THEN + UNTIL + ( phandle-start taddr true|phandle-start false ) +; + + +: translate-address-back-to-start-node ( phandle-start taddr true|phandle-start false ) + \ get back to the node where translation was started + dup IF + rot ( taddr true phandle-start ) + set-node ( taddr true ) + ELSE + swap ( phandle-start false ) + set-node ( false ) + THEN +; + +: translate-address ( addr -- taddr true|false ) + get-node swap \ save current node ( phandle-start addr ) + translate-ranges ( phandle-start taddr true|phandle-start false ) + translate-address-back-to-start-node ( taddr true|false ) +; + + +: translate-address-pci ( phys.lo phys.mid phys.hi -- taddr true|false ) + to pci-phys-hi ( phys.lo phys.mid ) + lxjoin ( phys.addr ) + get-node \ save current node ( phys.addr phandle-start ) + swap ( phandle-start phys.addr ) + translate-ranges \ fetches phys.hi for PCI ( phandle-start taddr true|phandle-start false ) + translate-address-back-to-start-node ( taddr true|false ) +; + +\ device tree translate-address +#include <translate.fs> |