Changeset 3021


Ignore:
Timestamp:
Jun 29, 2012, 10:46:30 PM (3 years 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.