Changeset 3021


Ignore:
Timestamp:
Jun 29, 2012 10:46:30 PM (12 months ago)
Author:
wmb
Message:

Changed OFW core code to allow phandle values to be origin-relative addresses instead of absolute (possibly run-time-relocated) addresses, thus making it much easier to encode phandle values in properties built at compile time.

Files:
21 edited

Legend:

Unmodified
Added
Removed

  • cpu/arm/mmp2/fw.bth

    r2899 r3021  
    4848 
    4949: (cpu-arch  ( -- adr len ) 
    50    " architecture" ['] root-node  get-package-property  drop 
     50   " architecture" root-phandle  get-package-property  drop 
    5151   get-encoded-string 
    5252; 

  • cpu/arm/mmp2/mmp2.bth

    r2390 r3021  
    7373 
    7474: (cpu-arch  ( -- adr len ) 
    75    " architecture" ['] root-node  get-package-property  drop 
     75   " architecture" root-phandle  get-package-property  drop 
    7676   get-encoded-string 
    7777; 

  • cpu/arm/olpc/banner.fth

    r3005 r3021  
    114114 
    115115: .ec 
    116    " ec-name" ['] root-node  get-package-property  0=  if  ( adr len ) 
     116   " ec-name" root-phandle  get-package-property  0=  if  ( adr len ) 
    117117      get-encoded-string  ." EC Firmware "  type 
    118118   then 

  • cpu/arm/olpc/prefw.fth

    r2899 r3021  
    5151 
    5252: (cpu-arch  ( -- adr len ) 
    53    " architecture" ['] root-node  get-package-property  drop 
     53   " architecture" root-phandle  get-package-property  drop 
    5454   get-encoded-string 
    5555; 

  • cpu/mips/bonito/forthmon.bth

    r1201 r3021  
    3939 
    4040: (cpu-arch  ( -- adr len ) 
    41    " architecture" ['] root-node  get-package-property  drop 
     41   " architecture" root-phandle  get-package-property  drop 
    4242   get-encoded-string 
    4343; 

  • cpu/mips/bonito/fw.bth

    r1201 r3021  
    4545 
    4646: (cpu-arch  ( -- adr len ) 
    47    " architecture" ['] root-node  get-package-property  drop 
     47   " architecture" root-phandle  get-package-property  drop 
    4848   get-encoded-string 
    4949; 

  • cpu/mips/broadcom/avx/fw.bth

    r1201 r3021  
    6161 
    6262: (cpu-arch  ( -- adr len ) 
    63    " architecture" ['] root-node  get-package-property  drop 
     63   " architecture" root-phandle  get-package-property  drop 
    6464   get-encoded-string 
    6565; 

  • cpu/mips/cobalt/fw.bth

    r1201 r3021  
    7373 
    7474: (cpu-arch  ( -- adr len ) 
    75    " architecture" ['] root-node  get-package-property  drop 
     75   " architecture" root-phandle  get-package-property  drop 
    7676   get-encoded-string 
    7777; 

  • cpu/x86/pc/alex/fw.bth

    r2865 r3021  
    5151 
    5252: (cpu-arch  ( -- adr len ) 
    53    " architecture" ['] root-node  get-package-property  drop 
     53   " architecture" root-phandle  get-package-property  drop 
    5454   get-encoded-string 
    5555; 

  • cpu/x86/pc/biosload/fw.bth

    r2865 r3021  
    5454 
    5555: (cpu-arch  ( -- adr len ) 
    56    " architecture" ['] root-node  get-package-property  drop 
     56   " architecture" root-phandle  get-package-property  drop 
    5757   get-encoded-string 
    5858; 

  • cpu/x86/pc/emu/fw.bth

    r1050 r3021  
    5151 
    5252: (cpu-arch  ( -- adr len ) 
    53    " architecture" ['] root-node  get-package-property  drop 
     53   " architecture" root-phandle  get-package-property  drop 
    5454   get-encoded-string 
    5555; 

  • cpu/x86/pc/lxdevel/fw.bth

    r2899 r3021  
    5555 
    5656: (cpu-arch  ( -- adr len ) 
    57    " architecture" ['] root-node  get-package-property  drop 
     57   " architecture" root-phandle  get-package-property  drop 
    5858   get-encoded-string 
    5959; 

  • cpu/x86/pc/neptune/fw.bth

    r2899 r3021  
    5454 
    5555: (cpu-arch  ( -- adr len ) 
    56    " architecture" ['] root-node  get-package-property  drop 
     56   " architecture" root-phandle  get-package-property  drop 
    5757   get-encoded-string 
    5858; 

  • cpu/x86/pc/newton/fw.bth

    r2865 r3021  
    5151 
    5252: (cpu-arch  ( -- adr len ) 
    53    " architecture" ['] root-node  get-package-property  drop 
     53   " architecture" root-phandle  get-package-property  drop 
    5454   get-encoded-string 
    5555; 

  • cpu/x86/pc/olpc/banner.fth

    r2679 r3021  
    2020 
    2121: .ec 
    22    " ec-name" ['] root-node  get-package-property  0=  if  ( adr len ) 
     22   " ec-name" root-phandle  get-package-property  0=  if  ( adr len ) 
    2323      get-encoded-string  ." EC Firmware "  type 
    2424   then 

  • cpu/x86/pc/olpc/fw.bth

    r2991 r3021  
    5454 
    5555: (cpu-arch  ( -- adr len ) 
    56    " architecture" ['] root-node  get-package-property  drop 
     56   " architecture" root-phandle  get-package-property  drop 
    5757   get-encoded-string 
    5858; 

  • cpu/x86/pc/olpc/via/banner.fth

    r2865 r3021  
    114114 
    115115: .ec 
    116    " ec-name" ['] root-node  get-package-property  0=  if  ( adr len ) 
     116   " ec-name" root-phandle  get-package-property  0=  if  ( adr len ) 
    117117      get-encoded-string  ." EC Firmware "  type 
    118118   then 

  • cpu/x86/pc/olpc/via/fw.bth

    r2987 r3021  
    5454 
    5555: (cpu-arch  ( -- adr len ) 
    56    " architecture" ['] root-node  get-package-property  drop 
     56   " architecture" root-phandle  get-package-property  drop 
    5757   get-encoded-string 
    5858; 

  • ofw/core/ofwcore.fth

    r3006 r3021  
    683683defer voc>phandle ' noop to voc>phandle 
    684684defer phandle>voc ' noop to phandle>voc 
     685defer dt-null     ' null to dt-null 
     686 
     687\ : : :  lastacf .name cr ; 
     688 
     689: rel-voc>phandle  ( voc -- ph )  origin -  ;  ' rel-voc>phandle to voc>phandle 
     690: rel-phandle>voc  ( ph -- voc )  origin +  ;  ' rel-phandle>voc to phandle>voc 
     691' 0 to dt-null 
    685692 
    686693\ TODO 
    … …  
    690697\ Either implement a true breadth-first search or don't specify it. 
    691698 
     699: cdev drop context token@  voc>phandle  ; 
     700: devc drop phandle>voc  context token!  definitions  ; 
    6927012 actions 
    693 action: drop context token@  voc>phandle ; 
    694 action: drop phandle>voc  context token!  definitions ; 
     702action: cdev ; 
     703action: devc ; 
    695704create current-device  use-actions 
    696705 
    … …  
    726735 
    727736headers 
    728 : >parent  ( node -- parent-node )  >voc-link  link@ voc>phandle  ; 
     737: >parent  ( node -- parent-node )  phandle>voc >voc-link  link@ voc>phandle  ; 
    729738: parent-device  ( -- parent-node )  current-device >parent  ; 
    730739 
    … …  
    740749 
    741750: pop-device  ( -- ) 
    742    parent-device                     ( parent-voc ) 
    743    non-null?  if  push-device  then 
     751   parent-device                     ( parent-phandle ) 
     752   dup dt-null <>  if  push-device  else  drop  then 
     753\    non-null?  if  push-device  then 
    744754; 
    745755 
    … …  
    11001110\ Internal factor used to implement first-child and next-child 
    11011111: set-child?  ( link-adr -- flag ) 
    1102    get-token?  if  push-device true  else  false  then 
     1112   get-token?  if  voc>phandle push-device true  else  false  then 
    11031113; 
    11041114 
    … …  
    11261136   /devnode-extra  unaligned-ualloc drop 
    11271137 
    1128    lastacf push-device           ( parent's-child-field ) 
     1138   lastacf voc>phandle push-device           ( parent's-child-field ) 
    11291139; 
    11301140: init-properties  ( -- )  (vocabulary)  lastacf 'properties token!  ; 
    … …  
    11511161: link-to-peer  ( parent's-child-field -- ) 
    11521162   dup token@ 'peer token!             ( parent's-child-field ) 
    1153    current-device swap token!         ( ) 
     1163   current-device phandle>voc swap token!         ( ) 
    11541164; 
    11551165: device-node?  ( voc -- flag ) 
    … …  
    11881198headers 
    11891199: new-node  ( -- ) 
    1190    (vocabulary)  current-device link,  ( )  \ Up-link to parent device 
     1200   (vocabulary)  current-device phandle>voc link,  ( )  \ Up-link to parent device 
    11911201 
    11921202   \ Save parent linkage address on stack for later use 
    … …  
    12671277   allot-package-data 
    12681278device-end 
    1269  
    1270 : root-device  ( -- )  only forth also  ['] root-node push-device  ; 
    1271  
    1272 : root-device?  ( -- flag )  parent-device null =  ; 
     1279: root-phandle  ( -- ph )  ['] root-node voc>phandle  ; 
     1280 
     1281: root-device  ( -- )  only forth also  root-phandle push-device  ; 
     1282 
     1283: root-device?  ( -- flag )  parent-device dt-null =  ; 
    12731284 
    12741285: finish-device  ( -- )  finish-package-data  pop-device  ; 
    … …  
    17331744   \ otherwise it starts at the current directory 
    17341745   dup 1 >=  if                        ( str$ ) 
    1735       over c@  ascii /  =  if  1 /string  ['] root-node push-device  then 
     1746      over c@  ascii /  =  if  1 /string  root-phandle push-device  then 
    17361747   then                                ( str$ ) 
    17371748 
    1738    current-device null =  ?not-found 
     1749   current-device dt-null =  ?not-found 
    17391750   device-context?  0= ?not-found 
    17401751   (find-device) 
    … …  
    19401951      'child token@                   ( first-node ) 
    19411952      begin  non-null?  while         ( node ) 
    1942          push-device                  ( ) 
     1953         voc>phandle push-device      ( ) 
    19431954         .nodeid                      ( ) 
    19441955         'peer token@                 ( node' ) 
    … …  
    19711982: .voc-name   ( a -- ) 
    19721983   dup device-node? if 
    1973       current-device   swap context token! (pwd) space   
     1984      current-device phandle>voc  swap context token! (pwd) space   
    19741985      context token! 
    19751986   else 
    … …  
    20512062headerless 
    20522063: relink-device  ( -- false ) 
    2053    current-device relink-voc  false 
     2064   current-device phandle>voc relink-voc  false 
    20542065; 
    20552066: relink-devices  ( -- ) 
    2056     ['] root-node push-package 
     2067    root-phandle push-package 
    20572068    ['] relink-device  (search-preorder)  drop 
    20582069    pop-package 
    … …  
    20772088 
    20782089: find-method  ( adr len phandle -- false | acf true ) 
    2079    fm-hook  (search-wordlist) 
     2090   fm-hook  phandle>voc (search-wordlist) 
    20802091; 
    20812092 
    … …  
    20992110: $call-self  ( adr len -- ) 
    21002111   my-self  if 
    2101       my-voc  fm-hook $find-word  if  execute  exit  then 
     2112      my-voc  fm-hook phandle>voc $find-word  if  execute  exit  then 
    21022113   then 
    21032114   my-self to error-instance 
    … …  
    21962207: (get-any)   ( adr len -- true | adr' len' false ) 
    21972208   begin  my-self   while            ( adr len )  \ Search up parent chain 
    2198       my-voc current token!         ( adr len ) 
     2209      my-voc phandle>voc current token!         ( adr len ) 
    21992210      2dup get-my-property  0=  if   ( adr len adr' len' ) 
    22002211         2swap 2drop false exit      ( adr' len' false )   \ Found 
    … …  
    24342445      \ Establish the initial parent 
    24352446      also                                               ( path$ )       
    2436       null to current-device                             ( path$ ) 
     2447      dt-null to current-device                          ( path$ ) 
    24372448      ['] (open-path) catch  dup  if  nip nip  then      ( error? ) 
    24382449      previous definitions                               ( error? ) 
    … …  
    25972608: (execute-phandle-method)  ( method-adr,len phandle -- ??? ) 
    25982609   0 to unit#-valid?              ( method-adr,len phandle ) 
    2599    dup >parent null open-parents  ( method-adr,len phandle ) 
     2610   dup >parent dt-null open-parents  ( method-adr,len phandle ) 
    26002611   push-device                    ( method-adr,len ) 
    26012612   " "  new-instance              ( method-adr,len ) 
    … …  
    26092620      current-device >r         ( phandle ) 
    26102621      0 to unit#-valid?         ( phandle ) 
    2611       null ['] open-parents catch  if  ( x x ) 
     2622      dt-null ['] open-parents catch  if  ( x x ) 
    26122623         2drop  0               ( 0 ) 
    26132624      else                      (   ) 
    … …  
    26752686   \ Root node has no parent, therefore the size of its parent's address 
    26762687   \ space is meaningless 
    2677    my-voc  ['] root-node =  if  0  exit  then 
     2688   my-voc  root-phandle =  if  0  exit  then 
    26782689 
    26792690   " #size-cells"    my-parent ihandle>phandle  ( adr len phandle ) 
    … …  
    27572768; 
    27582769headers 
     2770: encode-phandle  ( name$ -- adr len ) 
     2771   locate-device abort" encode-phandle - Can't find package"  encode-int 
     2772; 
    27592773 
    27602774\ From finddisp.fth 
    … …  
    28962910also magic-device-types definitions 
    28972911: display  ( -- ) 
    2898    'fb-node token@ origin =  if  current-device 'fb-node token!  then 
     2912   'fb-node token@ origin =  if  current-device phandle>voc  'fb-node token!  then 
    28992913; 
    29002914previous definitions 
    … …  
    29092923\ Create the standard system nodes 
    29102924 
     2925hex 
     2926\ debug devc 
    29112927root-device 
    29122928   new-device                           \ Node for software "library" packages 
    29132929      " packages" device-name 
    29142930 
    2915       new-device     current-device to client-services 
     2931      new-device     current-device phandle>voc  to client-services 
    29162932         " client-services" device-name 
    29172933      finish-device 
     2934 
    29182935   finish-device 
    29192936 
    … …  
    32493266 
    32503267: do-method?  ( -- ) 
    3251    method-name 2@  current-device (search-wordlist)  if  ( xt ) 
     3268   method-name 2@  current-device phandle>voc (search-wordlist)  if  ( xt ) 
    32523269      drop  pwd$                               ( path-adr,len ) 
    32533270      verbose-do-method?  if  2dup type cr  then 
    … …  
    32853302 
    32863303: most-tests  ( -- exit? ) 
    3287    " selftest"  current-device (search-wordlist)  if   ( xt ) 
     3304   " selftest"  current-device phandle>voc (search-wordlist)  if   ( xt ) 
    32883305 
    32893306      drop                                              ( ) 
    … …  
    35213538 
    35223539: >dbuf-header  ( adr -- 'dbuf ) 
    3523    dbuf-data>   ( 'dbuf ) 
    3524    dup dbuf-flag@ *dbuf-used* - abort" bad heap address." 
     3540   dbuf-data>                ( 'dbuf ) 
     3541   dup dbuf-flag@ case       ( 'dbuf ) 
     3542      *dbuf-used* of  endof  ( 'dbuf ) 
     3543      *dbuf-free* of 
     3544         true abort" Freeing or resizing already-free memory" 
     3545      endof 
     3546      true abort" bad heap address." 
     3547   endcase                   ( 'dbuf ) 
    35253548; 
    35263549: free-memory  ( adr -- ) 
    … …  
    40944117 
    40954118: setnode  ( nodeid | 0 -- ) 
    4096    dup 0=  if  drop ['] root-node then  (push-package) 
     4119   dup 0=  if  drop root-phandle then  (push-package) 
    40974120; 
    40984121 
    … …  
    41934216   0  'child                         ( last-nodeid &next-nodeid ) 
    41944217   begin  get-token?  while          ( last-nodeid next-nodeid ) 
    4195       nip  dup (select-package)      ( next-nodeid ) 
     4218      nip  dup voc>phandle (select-package)      ( next-nodeid ) 
    41964219      'peer                          ( last-nodeid' &next-nodeid ) 
    41974220   repeat                            ( last-nodeid' ) 
    41984221   (pop-package)                     ( nodeid ) 
     4222   dup  if  voc>phandle  then 
    41994223; 
    42004224 
    42014225: peer  ( phandle -- phandle' ) 
    42024226   dup 0=  if 
    4203       drop ['] root-node exit 
     4227      drop root-phandle exit 
    42044228   then                              ( nodeid ) 
    42054229 
    4206    dup  ['] root-node =  if 
     4230   dup  root-phandle =  if 
    42074231      drop 0  exit 
    42084232   then                              ( nodeid ) 
    … …  
    42104234   \ Select the first child of our parent 
    42114235   dup >parent (push-package)        ( nodeid ) 
    4212    'child token@ (select-package)    ( nodeid ) 
     4236   'child token@ voc>phandle (select-package)    ( nodeid ) 
    42134237 
    42144238   dup current-device  =  if         ( nodeid ) 
    … …  
    42184242      \ Search for the node preceding the argument node 
    42194243      begin                          ( nodeid ) 
    4220          'peer token@ 2dup  <>       ( nodeid next-nodeid flag ) 
     4244         'peer token@ voc>phandle 2dup  <>       ( nodeid next-nodeid flag ) 
    42214245      while                          ( nodeid next-nodeid ) 
    42224246         push-device                 ( nodeid ) 
    … …  
    42284252 
    42294253: parent  ( phandle -- phandle' ) 
    4230    dup ['] root-node =  if   ( root-phandle ) 
     4254   dup root-phandle =  if   ( root-phandle ) 
    42314255      drop 0 exit                    ( 0 ) 
    42324256   then                              ( parent-phandle ) 
    … …  
    44304454   ?dup  if                                              ( path$ ) 
    44314455      \ Establish the initial parent 
    4432       null to current-device                             ( path$ ) 
     4456      dt-null to current-device                             ( path$ ) 
    44334457      ?expand-alias                                      ( path$ ) 
    44344458      begin  canon-node  dup  0= until                   ( path$' ) 
    … …  
    48034827: resolve-ih-method  ( adr len ihandle -- xt ) 
    48044828   dup 0=  if  3drop ['] not-colon exit  then         ( adr len ihandle ) 
    4805    package(  my-voc $find-word  )package  ?not-colon  ( xt ) 
     4829   package(  my-voc phandle>voc $find-word  )package  ?not-colon  ( xt ) 
    48064830; 
    48074831: resolve-voc-method  ( adr len voc -- xt ) 
    … …  
    48484872 
    48494873   dup ['] package-execute =  if  ( [ adr len ] xt ) 
    4850       drop  2dup current-device   ( adr len voc ) 
     4874      drop  2dup current-device   ( adr len phandle ) 
    48514875      resolve-ph-method exit      ( -- xt ) 
    48524876   then                           ( xt ) 
    48534877 
    48544878   dup ['] apply-method =  if     ( [ adr len ] xt ) 
    4855       drop  2dup my-voc           ( adr len voc ) 
     4879      drop  2dup my-voc phandle>voc          ( adr len voc ) 
    48564880      resolve-voc-method exit     ( -- xt ) 
    48574881   then                           ( xt ) 
    48584882 
    48594883   dup ['] (apply-method) =  if   ( [ adr len ] xt ) 
    4860       drop  2dup my-voc           ( adr len voc ) 
     4884      drop  2dup my-voc phandle>voc          ( adr len voc ) 
    48614885      resolve-voc-method exit     ( -- xt ) 
    48624886   then                           ( xt ) 

  • ofw/inet/dhcp.fth

    r1548 r3021  
    9090 
    9191: root-property  ( name$ -- true | value false ) 
    92    ['] root-node get-package-property 
     92   root-phandle get-package-property 
    9393; 
    9494 
    … …  
    521521   bootp-name-buf count nip 0=  if   
    522522      file-name-buf c@ 0=  if 
    523          " architecture" ['] root-node get-package-property 0=  if  ( prop$ ) 
     523         " architecture" root-phandle get-package-property 0=  if  ( prop$ ) 
    524524            get-encoded-string                                      ( name$ ) 
    525525            bootp-name-buf place                                    ( ) 

  • ofw/inetv6/dhcp.fth

    r534 r3021  
    9090 
    9191: root-property  ( name$ -- true | value false ) 
    92    ['] root-node get-package-property 
     92   root-phandle get-package-property 
    9393; 
    9494 
    … …  
    478478   bootp-name-buf count nip 0=  if   
    479479      file-name-buf c@ 0=  if 
    480          " architecture" ['] root-node get-package-property 0=  if  ( prop$ ) 
     480         " architecture" root-phandle get-package-property 0=  if  ( prop$ ) 
    481481            get-encoded-string                                      ( name$ ) 
    482482            bootp-name-buf place                                    ( ) 
Note: See TracChangeset for help on using the changeset viewer.