API tools faq
paste
Guest User

Untitled

a guest
Feb 19th, 2018
258
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 27.78 KB | None | 0 0
raw download clone embed print report
  1. #!/usr/bin/perl
  2.  
  3. # Author: Phil Elwell <[email protected]>
  4. # Copyright (c) 2018, Raspberry Pi (Trading) Ltd.
  5. #
  6. # Redistribution and use in source and binary forms, with or without
  7. # modification, are permitted provided that the following conditions
  8. # are met:
  9. # 1. Redistributions of source code must retain the above copyright
  10. # notice, this list of conditions, and the following disclaimer,
  11. # without modification.
  12. # 2. Redistributions in binary form must reproduce the above copyright
  13. # notice, this list of conditions and the following disclaimer in the
  14. # documentation and/or other materials provided with the distribution.
  15. # 3. The names of the above-listed copyright holders may not be used
  16. # to endorse or promote products derived from this software without
  17. # specific prior written permission.
  18. #
  19. # ALTERNATIVELY, this software may be distributed under the terms of the
  20. # GNU General Public License ("GPL") version 2, as published by the Free
  21. # Software Foundation.
  22. #
  23. # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
  24. # IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
  25. # THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
  26. # PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
  27. # CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  28. # EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  29. # PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
  30. # PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
  31. # LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  32. # NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  33. # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  34.  
  35. # To Do:
  36. # * Consider using hashes for properties and node names
  37. # * &{/path} syntax
  38.  
  39. use strict;
  40. use integer;
  41. use POSIX qw(strftime);
  42.  
  43. my %elem_types = (
  44. '"' => [ 0 ], # string
  45. '.' => [ 1, 0xff ], # byte
  46. ';' => [ 2, 0xffff ], # 16-bit int
  47. ':' => [ 4, 0xffffffff ], # 32-bit int
  48. '#' => [ 8, 0xffffffffffffffff ], # 64-bit int
  49. );
  50.  
  51. my $comment = 0;
  52. my $show_includes = 0;
  53. my $pi_extras = 0;
  54. my $redo = 0;
  55. my $sort = 0;
  56. my $trace = 0;
  57. my $warnings = 0;
  58. my $cur_dt;
  59.  
  60. my @cmdline;
  61.  
  62. while ($ARGV[0] =~ /^-/)
  63. {
  64. my $arg = shift @ARGV;
  65.  
  66. if ($arg eq '-c')
  67. {
  68. $comment = 1;
  69. }
  70. elsif ($arg eq '-h')
  71. {
  72. usage();
  73. exit(0);
  74. }
  75. elsif ($arg eq '-i')
  76. {
  77. $show_includes = 1;
  78. }
  79. elsif ($arg eq '-p')
  80. {
  81. $pi_extras = 1;
  82. }
  83. elsif ($arg eq '-r')
  84. {
  85. my $firstline = <>;
  86. if ($firstline !~ /^\/\/ redo: ovmerge (.*)/)
  87. {
  88. print STDERR ("* Redo but input has no 'redo:' comment\n");
  89. usage();
  90. exit(1);
  91. }
  92. my $cmdline = $1;
  93. @ARGV = split(/\s/, $cmdline);
  94. last;
  95. }
  96. elsif ($arg eq '-s')
  97. {
  98. $sort = 1;
  99. }
  100. elsif ($arg eq '-t')
  101. {
  102. $trace = 1;
  103. }
  104. elsif ($arg eq '-w')
  105. {
  106. $warnings = 1;
  107. }
  108. else
  109. {
  110. print STDERR ("* Unknown option '$arg'\n");
  111. usage();
  112. exit(1);
  113. }
  114. }
  115.  
  116. usage() if (!@ARGV);
  117.  
  118. push @cmdline, @ARGV;
  119.  
  120. my @overlays;
  121.  
  122. foreach my $overlay (@ARGV)
  123. {
  124. $overlay =~ s/^([^,:]+)//;
  125. my $ovname = $1;
  126. my $dt = dtparse($ovname);
  127.  
  128. next if ($show_includes);
  129.  
  130. while ($overlay =~ /\G[,:]([^=,]+)(?:=([^,]+))?/g)
  131. {
  132. dtparam($dt, $1, $2);
  133. }
  134.  
  135. if ($overlay =~ /^,/)
  136. {
  137. delete_node(get_node($dt, '/__overrides__'));
  138. }
  139.  
  140. push @overlays, $dt;
  141. }
  142.  
  143. if ($overlays[0]->{'plugin'})
  144. {
  145. # Count and renumber the fragments in the base
  146. renumber_fragments($overlays[0], 0);
  147.  
  148. for (my $i = 1; $i < @overlays; $i++)
  149. {
  150. ovmerge($overlays[0], $overlays[$i]);
  151. }
  152. }
  153. else
  154. {
  155. my $base = $overlays[0];
  156.  
  157. if ($pi_extras)
  158. {
  159. # Pi firmware adds some labels and aliases that overlays
  160. # also require.
  161. my $aliases = get_child($base->{'root'}, 'aliases');
  162. my $i2c = get_prop($aliases, 'i2c1')->[1];
  163. set_prop($aliases, 'i2c', $i2c);
  164. set_prop($aliases, 'i2c_arm', $i2c);
  165.  
  166. $i2c = resolve_label($base, $i2c->[1]);
  167. add_label($base, $i2c, 'i2c');
  168. add_label($base, $i2c, 'i2c_arm');
  169. }
  170.  
  171. if (@overlays > 1)
  172. {
  173. # A real Pi base tree will have a __symbols__ node
  174. # Some overlays rely on one being present, so ensure one is
  175. get_child($base->{'root'}, '__symbols__') ||
  176. add_node($base->{'root'}, '__symbols__');
  177.  
  178. for (my $i = 1; $i < @overlays; $i++)
  179. {
  180. ovapply($base, $overlays[$i]);
  181. }
  182. }
  183.  
  184. }
  185.  
  186. if (@overlays)
  187. {
  188. if ($comment)
  189. {
  190. print("// redo: ovmerge");
  191. foreach my $opt (@cmdline)
  192. {
  193. if ($opt =~ /\s/)
  194. {
  195. print(" '$opt'");
  196. }
  197. else
  198. {
  199. print(" $opt");
  200. }
  201. }
  202. print("\n\n");
  203. }
  204.  
  205. dtdump($overlays[0]);
  206. }
  207.  
  208. exit(0);
  209.  
  210. sub dtparse
  211. {
  212. # DT = hash of:
  213. # 'root' => '/' node
  214. # 'plugin' => boolean true if /plugin/ tag is present.
  215. # 'labels' => hash of labels used in tree
  216. # 'includes' => array of included headers (array to preserve order)
  217. # 'memreserves' => array of memreseve [base,length] pairs
  218.  
  219. my ($filename) = @_;
  220.  
  221. my $state = [ read_tokens($filename, 0), 0, undef ];
  222. my $labels = {};
  223.  
  224. my $dt = { 'labels'=>$labels, 'includes'=>[], 'includes'=>[], 'memreserves'=>[] };
  225.  
  226. my $next = ${$state->[0]}[$state->[1]];
  227. my $got_header;
  228.  
  229. while ($next =~ /^(\/.+\/|#include)$/)
  230. {
  231. my $type = $next;
  232. $next = match($state, $next);
  233. if ($type eq '#include')
  234. {
  235. set_add($dt->{'includes'}, $next);
  236. $next = match($state, $next);
  237. }
  238. else
  239. {
  240. if (!$got_header)
  241. {
  242. die "* File missing /dts-v1/ tag\n" if ($type ne '/dts-v1/');
  243. $got_header = 1;
  244. }
  245. elsif ($type eq '/plugin/')
  246. {
  247. $dt->{'plugin'} = 1;
  248. }
  249. elsif ($type eq '/memreserve/')
  250. {
  251. my $start = get_int($state);
  252. my $length = get_int($state);
  253. set_add($dt->{'memreserves'}, [ $start, $length ]);
  254. }
  255. else
  256. {
  257. die "* Unexpected token '$type'\n";
  258. }
  259. $next = match($state, ';');
  260. }
  261. }
  262.  
  263. $cur_dt = $dt;
  264.  
  265. while (defined $next)
  266. {
  267. if ($next eq '/')
  268. {
  269. match($state, '/');
  270. $next = parse_node($state, undef, 0, '/');
  271. }
  272. else
  273. {
  274. my @newlabels;
  275. while ($next =~ /^(\w+):$/)
  276. {
  277. push @newlabels, $1;
  278. print("[Label: $1]\n") if ($trace);
  279. $next = match($state, $next);
  280. }
  281. if ($next =~ /^&(\w+)$/)
  282. {
  283. my $subnode = $labels->{$1};
  284. die "* Unknown label '$1'\n" if (!defined $subnode);
  285. match($state, $next);
  286. $next = parse_node($state, $subnode->[4], $subnode->[5], $subnode, @newlabels);
  287. }
  288. elsif ($next eq '/delete-node/')
  289. {
  290. $next = match($state, $next);
  291. if ($next =~ /^&(\w+)$/)
  292. {
  293. my $label = $1;
  294. my $subnode = $labels->{$label};
  295. die "* Unknown label '$1'\n" if (!defined $subnode);
  296. delete_node($subnode);
  297. match($state, $next);
  298. $next = match($state, ';');
  299. }
  300. }
  301. elsif ($next eq '#include')
  302. {
  303. $next = match($state, $next);
  304. set_add($dt->{'includes'}, $next);
  305. $next = match($state, $next);
  306. }
  307. else
  308. {
  309. die "* Unexpected token '$next'\n";
  310. }
  311. }
  312. }
  313.  
  314. $cur_dt = undef;
  315.  
  316. if ($state->[1] != @{$state->[0]})
  317. {
  318. # For now
  319. printf("* Junk at the end - %s ...\n", ${$state->[0]}[$state->[1]]);
  320. }
  321.  
  322. return $dt;
  323. }
  324.  
  325. sub dtdump
  326. {
  327. my ($dt) = @_;
  328. print("/dts-v1/;\n");
  329. print("/plugin/;\n") if ($dt->{'plugin'});
  330. print("\n");
  331. if (!set_empty($dt->{'includes'}))
  332. {
  333. foreach my $inc (set_vals($dt->{'includes'}))
  334. {
  335. print("#include $inc\n");
  336. }
  337. print("\n");
  338. }
  339. if (!set_empty($dt->{'memreserves'}))
  340. {
  341. foreach my $res (set_vals($dt->{'memreserves'}))
  342. {
  343. print('/memreserve/ ', $res->[0], ' ', $res->[1], ";\n");
  344. }
  345. print("\n");
  346. }
  347.  
  348. dump_node($dt->{'root'}, 0);
  349. }
  350.  
  351. sub dtparam
  352. {
  353. my ($dt, $param, $value) = @_;
  354.  
  355. my $overrides = get_node($dt, '/__overrides__');
  356. die "* No overrides found\n" if (!$overrides);
  357. my $ovr = get_prop($overrides, $param);
  358. die "* dtparam '$param' not found\n" if (!$ovr);
  359.  
  360. for (my $pos = 1; $pos < @$ovr; $pos += 2)
  361. {
  362. my $p = $ovr->[$pos];
  363. die "* Invalid override 1: $param\n" if (($p->[0] ne '<') || ($p->[1] != 4) || ($p->[2]->[0] !~ /^(&.*|0)$/));
  364. my $label = $1;
  365. $p = $ovr->[$pos+1];
  366. die "* Invalid override 2: $param\n" if ($p->[0] ne '"');
  367. my $decl = $p->[1];
  368. if ($label =~ /^&(.*)/)
  369. {
  370. my $node = resolve_label($dt, $1);
  371. die "* Missing label '$1'\n" if (!$node);
  372. if ($decl =~ /^([-a-zA-Z0-9_,]+)([.;:#])(\d+)$/)
  373. {
  374. # Integer parameter
  375. my ($prop, $type, $offset) = ($1, $2, $3);
  376. my ($size, $mask) = @{$elem_types{$type}};
  377. my $intval = integer_value($value) & $mask;
  378.  
  379. if ($prop eq 'reg')
  380. {
  381. my $regval = sprintf("%x", $intval);
  382. $node->[0] =~ s/@[0-9a-fA-F]*$/\@$regval/;
  383. }
  384.  
  385. # Locate the offset within the property
  386. my ($chunk, $chunk_idx) =
  387. find_prop_chunk($node, $prop, $offset, $size, $param, $prop ne 'reg');
  388.  
  389. if ($chunk)
  390. {
  391. # Check the override type matches the property type
  392. if (($chunk->[0] eq '<' && $chunk->[1] != $size) ||
  393. ($chunk->[0] eq '[' && $chunk->[1] != $size))
  394. {
  395. die "* Probably incorrect override property type for '$prop'\n";
  396. }
  397.  
  398. # Apply the override
  399. for (my $i = @{$chunk->[2]}; $i < $chunk_idx; $i++)
  400. {
  401. $chunk->[2]->[$i] = 0;
  402. }
  403. $chunk->[2]->[$chunk_idx] = $intval;
  404. }
  405. }
  406. elsif ($decl =~ /^([-a-zA-Z0-9_,]+)\?$/)
  407. {
  408. # boolean
  409. my ($prop) = ($1);
  410. my $bool;
  411. $value = boolean_value($value);
  412. if ($value)
  413. {
  414. set_prop($node, $prop);
  415. }
  416. else
  417. {
  418. delete_prop($node, $prop);
  419. }
  420. }
  421. elsif ($decl =~ /^([-a-zA-Z0-9_,]+)$/)
  422. {
  423. # string
  424. my ($prop) = ($1);
  425. set_prop($node, $prop, $value);
  426. }
  427. else
  428. {
  429. die "* Invalid parameter declaration '$decl'\n";
  430. }
  431. }
  432. else
  433. {
  434. $value = boolean_value($value);
  435. while ($decl =~ /\G([=!+-])(\d+)/g)
  436. {
  437. my ($op, $num) = ($1, $2);
  438. my $frag = get_node($dt, '/fragment@'.$num);
  439. die "* Param $param: no fragment $num\n" if (!$frag);
  440. # Enable or disable the fragment as needed
  441. if ($op eq '!')
  442. {
  443. $value = !$value;
  444. }
  445. elsif ($op eq '+')
  446. {
  447. $value = 1;
  448. }
  449. elsif ($op eq '-')
  450. {
  451. $value = 0;
  452. }
  453. $frag->[2]->[0]->[0] = ($value ? '__overlay__' : '__dormant__');
  454. }
  455. die "* Invalid override 3:$param\n" if (pos($decl) != undef);
  456. }
  457. }
  458. }
  459.  
  460. # Combine two (possibly partially overridden) overlays
  461. sub ovmerge
  462. {
  463. my ($base, $ov) = @_;
  464.  
  465. die "* Cannot merge a non-overlay\n" if (!$base->{'plugin'} || !$ov->{'plugin'});
  466.  
  467. # Combine the list of includes, removing any duplicates
  468. foreach my $inc (set_vals($ov->{'includes'}))
  469. {
  470. set_add($base->{'include'}, $inc);
  471. }
  472.  
  473. # Count and renumber the fragments in the overlay
  474. renumber_fragments($ov, $base->{'frag_count'});
  475.  
  476. # Uniquify and merge the overlay labels
  477. my %transform;
  478. my $base_labels = $base->{'labels'};
  479. my $ov_labels = $ov->{'labels'};
  480.  
  481. foreach my $l (keys(%$ov_labels))
  482. {
  483. my $nl = $l;
  484. my $n = $ov_labels->{$l};
  485. if ($base_labels->{$l})
  486. {
  487. my $i;
  488. for ($i = 1; ; $i++)
  489. {
  490. $nl = "${l}_$i";
  491. last if (!$base_labels->{$nl});
  492. }
  493. $transform{$l} = $nl;
  494. foreach my $ol (@{$n->[3]})
  495. {
  496. $ol = $nl if ($ol eq $l);
  497. }
  498. }
  499. $base_labels->{$nl} = $n;
  500. }
  501.  
  502. relabel_node($ov->{'root'}, \%transform, 0);
  503.  
  504. my $base_overrides = get_node($base, '/__overrides__');
  505. my $ov_overrides = get_node($base, '/__overrides__');
  506.  
  507. remove_node($base_overrides) if ($base_overrides);
  508.  
  509. # Merge the fragments
  510. foreach my $child (get_fragments($ov))
  511. {
  512. add_node($base->{'root'}, $child);
  513.  
  514. $base->{'frag_count'}++;
  515. }
  516.  
  517. # Merge the overrides
  518.  
  519. if ($ov_overrides)
  520. {
  521. $base_overrides ||= new_node('__overrides__');
  522. foreach my $ovr (@{$ov_overrides->[1]})
  523. {
  524. die "* Duplicate parameter '$ovr->[0]'\n" if (get_prop($base_overrides, $ovr->[0]));
  525.  
  526. set_prop($base_overrides, @$ovr);
  527. }
  528. }
  529.  
  530. add_node($base->{'root'}, $base_overrides) if ($base_overrides);
  531. }
  532.  
  533. # Apply an overlay to a base tree
  534. sub ovapply
  535. {
  536. my ($base, $ov) = @_;
  537.  
  538. die "* Cannot apply a non-overlay\n" if (!$ov->{'plugin'});
  539. die "* Cannot apply an overlay to an overlay\n" if ($base->{'plugin'});
  540.  
  541. # Combine the list of includes, removing any duplicates
  542. foreach my $inc (set_vals($ov->{'includes'}))
  543. {
  544. set_add($base->{'includes'}, $inc);
  545. }
  546.  
  547. my $base_overrides = get_node($base, '/__overrides__');
  548.  
  549. # Apply each fragment
  550.  
  551. foreach my $fragment (get_fragments($ov))
  552. {
  553. my $overlay = get_child($fragment, '__overlay__');
  554. next if (!$overlay);
  555. my $target_node;
  556. my $target = get_prop($fragment, 'target');
  557. if ($target)
  558. {
  559. die "* Invalid target reference\n"
  560. if (($target->[1]->[0] ne '<') ||
  561. ($target->[1]->[2]->[0] !~ /^&(.*)/));
  562. $target_node = $base->{'labels'}->{$1};
  563. die "* Label '$1' not found in base\n" if (!$target_node);
  564. }
  565. else
  566. {
  567. $target = get_prop($fragment, 'target-path');
  568. die "* Invalid target-path\n"
  569. if ($target->[1]->[0] ne '"');
  570. $target_node = get_node($base, $target->[1]->[1]);
  571. die "* Path '$target->[1]->[1]' not found in base\n" if (!$target_node);
  572. }
  573.  
  574. # Merge properties and subnodes
  575. apply_node($target_node, $overlay);
  576. }
  577. }
  578.  
  579. sub parse_node
  580. {
  581. my ($state, $parent, $depth, $node, @newlabels) = @_;
  582. # scalar name
  583. # array properties
  584. # array children
  585. # array labels
  586. # ref parent
  587. # scalar depth
  588.  
  589. my $next = match($state, '{');
  590.  
  591. $node = (get_child($parent, $node) || add_node($parent, $node)) if (!ref $node);
  592.  
  593. printf("parse_node(%s, %d ...) - %s\n", $node->[0], $depth) if ($trace);
  594.  
  595. # Parse the properties first
  596.  
  597. # Properties are "name=value;"
  598. while ($next ne '}')
  599. {
  600. my @childlabels;
  601. if ($next eq '/delete-node/')
  602. {
  603. $next = match($state, $next);
  604. if ($next =~ /^[-a-zA-Z0-9,._+#@]+$/)
  605. {
  606. delete_node(get_child($node, $next));
  607. match($state, $next);
  608. $next = match($state, ';');
  609. }
  610. next;
  611. }
  612. elsif ($next eq '/delete-property/')
  613. {
  614. $next = match($state, $next);
  615. if ($next =~ /^[-a-zA-Z0-9,._+#@]+$/)
  616. {
  617. delete_prop($node, $next);
  618. match($state, $next);
  619. $next = match($state, ';');
  620. }
  621. next;
  622. }
  623.  
  624. while ($next =~ /^(\w+):$/)
  625. {
  626. push @childlabels, $1;
  627. print("[Label: $1]\n") if ($trace);
  628. $next = match($state, $next);
  629. }
  630.  
  631. if ($next =~ /^[-a-zA-Z0-9,._+#@]+$/)
  632. {
  633. my $name = $next;
  634. $next = match($state, $next);
  635. if ($next eq '{')
  636. {
  637. $next = parse_node($state, $node, $depth + 1, $name, @childlabels);
  638. }
  639. elsif ($next eq '=')
  640. {
  641. my @prop;
  642.  
  643. print("* Ignoring label on property '$name'\n") if (@childlabels && $warnings);
  644. do
  645. {
  646. $next = match($state, $next);
  647. if ($next =~ /^"(.*)"$/)
  648. {
  649. # string
  650. push @prop, [ '"', $1 ];
  651. $next = match($state, $next);
  652. }
  653. elsif ($next =~ /&(.*)/)
  654. {
  655. # noderef string
  656. push @prop, [ '&', $1 ];
  657. $next = match($state, $next);
  658. }
  659. elsif (($next eq '<') || ($next eq '/bits/'))
  660. {
  661. my $elemsize = 4;
  662. if ($next eq '/bits/')
  663. {
  664. $next = match($state, $next);
  665.  
  666. if (($next != 8) && ($next != 16) &&
  667. ($next != 32) && ($next != 64))
  668. {
  669. die "* Invalid /bits/ value '$next'.\n";
  670. }
  671. $elemsize = $next/8;
  672. match($state, $next);
  673. }
  674. $next = match($state, '<');
  675.  
  676. # vector
  677. my $vals = [];
  678. while ($next ne '>')
  679. {
  680. push @$vals, $next;
  681. $next = match($state, $next);
  682. }
  683. push @prop, [ '<', $elemsize, $vals ];
  684. $next = match($state, '>');
  685. }
  686. else
  687. {
  688. # bytestring
  689. my $vals = [];
  690. $next = match($state, '[');
  691. while ($next ne ']')
  692. {
  693. push @$vals, $next;
  694. $next = match($state, $next);
  695. }
  696. $next = match($state, ']');
  697. push @prop, [ '[', 1, $vals ];
  698. }
  699. } while ($next eq ',');
  700. $next = match($state, ';');
  701. set_prop($node, $name, @prop);
  702. }
  703. else
  704. {
  705. print("* Ignoring label on property '$name'\n") if (@childlabels && $warnings);
  706. $next = match($state, ';');
  707. set_prop($node, $name);
  708. }
  709. }
  710. else
  711. {
  712. die "* Unexpected token '$next'\n";
  713. }
  714. }
  715.  
  716. my $labels = $cur_dt->{'labels'};
  717.  
  718. foreach my $newlabel (@newlabels)
  719. {
  720. my $labelled_node = map_find($labels, $newlabel);
  721. if ($labelled_node)
  722. {
  723. die "* Duplicated label '$newlabel'\n" if ($labelled_node != $node);
  724. print("* Duplicated label '$newlabel' (on the same node)\n") if ($warnings);
  725. }
  726. else
  727. {
  728. add_label($cur_dt, $node, $newlabel);
  729. }
  730. }
  731.  
  732. match($state, '}');
  733.  
  734. return match($state, ';');
  735. }
  736.  
  737. sub add_label
  738. {
  739. my ($dt, $node, $label) = @_;
  740.  
  741. map_add($dt->{'labels'}, $label, $node);
  742. push @{$node->[3]}, $label;
  743. print("* Multiple labels on '" . node_path($node) . "'\n") if ($warnings && @{$node->[3]} > 1);
  744. }
  745.  
  746. sub resolve_label
  747. {
  748. my ($dt, $label) = @_;
  749.  
  750. return $dt->{'labels'}->{$label};
  751. }
  752.  
  753. sub resolve_alias
  754. {
  755. my ($dt, $alias) = @_;
  756. my $aliases = get_node($dt, '/aliases');
  757. $alias = get_prop($aliases, $alias);
  758. return undef if (!$alias);
  759. if ($alias->[1][0] eq '&')
  760. {
  761. return resolve_label($dt, $alias->[1][1]);
  762. }
  763. else
  764. {
  765. return get_node($dt, $alias->[1][1]);
  766. }
  767. }
  768.  
  769. sub dump_node
  770. {
  771. my ($node, $depth) = @_;
  772. my $indent = "\t" x $depth;
  773.  
  774. print($indent, join(': ', @{$node->[3]}, $node->[0]), " {\n");
  775.  
  776. $indent = "\t" x $depth;
  777.  
  778. # Properties
  779. foreach my $prop (get_props($node))
  780. {
  781. my @terms;
  782. print($indent, "\t", $prop->[0]);
  783. for (my $i = 1; $i < @$prop; $i++)
  784. {
  785. my $chunk = $prop->[$i];
  786.  
  787. if (!ref $chunk)
  788. {
  789. print("");
  790. }
  791. if ($chunk->[0] eq '"')
  792. {
  793. push @terms, '"'.$chunk->[1].'"';
  794. }
  795. elsif ($chunk->[0] eq '&')
  796. {
  797. push @terms, '&'.$chunk->[1];
  798. }
  799. elsif ($chunk->[0] =~ '<')
  800. {
  801. push @terms, '<'.join(' ', @{$chunk->[2]}).'>';
  802. }
  803. elsif ($chunk->[0] eq '[')
  804. {
  805. push @terms, '['.join(' ', @{$chunk->[2]}).']';
  806. }
  807. else
  808. {
  809. push @terms, '?';
  810. }
  811. }
  812. print(' = ', join(', ', @terms)) if (@terms);
  813. print(";\n");
  814. }
  815.  
  816. # Sub-nodes
  817. foreach my $subnode (get_children($node))
  818. {
  819. dump_node($subnode, $depth + 1);
  820. }
  821.  
  822. print($indent, "};\n");
  823. }
  824.  
  825. sub read_tokens
  826. {
  827. my ($filename, $depth) = @_;
  828. my $linenum = 0;
  829. my $fh;
  830. my $tokens = [];
  831. my $in_comment = 0;
  832. my $if_count = 0;
  833.  
  834. print(" " x $depth, $filename, "\n") if ($show_includes);
  835. print("[read_tokens '$filename']\n") if ($trace);
  836. die "* Failed to open '$filename'\n" if (!open($fh, '<', $filename));
  837.  
  838. while (my $line = <$fh>)
  839. {
  840. $linenum++;
  841.  
  842. if ($in_comment)
  843. {
  844. next if ($line !~ s/^.*?\*\///);
  845. $in_comment = 0 ;
  846. }
  847.  
  848. if ($if_count)
  849. {
  850. $if_count-- if ($line =~ /^#endif/);
  851. next;
  852. }
  853.  
  854. if ($line =~ /^(?:#include|\/include\/)\s+(["<][^">]+[">])\s*$/)
  855. {
  856. my $incfile = $1;
  857. if ($incfile =~ /\.h.$/)
  858. {
  859. push @$tokens, '#include', $incfile;
  860. }
  861. elsif ($incfile =~ /\.dtsi?.$/)
  862. {
  863. my $dtsfile = search_path(substr($incfile, 1, -1));
  864. die "* Failed to find include file '$incfile'" if (!$dtsfile);
  865. my $inc_tokens = read_tokens($dtsfile, $depth + 1);
  866. push @$tokens, @$inc_tokens;
  867. }
  868. else
  869. {
  870. die "* Invalid include file '$incfile'\n";
  871. }
  872. next;
  873. }
  874. elsif ($line =~ /^#if(def)?\s/)
  875. {
  876. $if_count++;
  877. next;
  878. }
  879. elsif ($line =~ /^#/)
  880. {
  881. die "* Unrecognised directive ($filename:$linenum):\n$line\n";
  882. }
  883.  
  884. # Split the line into tokens
  885. $line =~ /^\s*/g;
  886. while ($line =~ /\G((?:\/(?:dts-v1|plugin|memreserve|bits|delete-node|delete-property)\/)|&[a-zA-Z_][a-zA-Z0-9_]*|[a-zA-Z_][a-zA-Z0-9_]*:|[-a-zA-Z0-9,._+#@]+|\(\-\d+\)|"(?:[^\\"]|\\.)*"|'(?:[^']|\\.)*'|\/\/|\/\*|[\/{};=<>,\[\]])\s*/cg)
  887. {
  888. my $tok = $1;
  889. if ($tok eq '//')
  890. {
  891. $line = '';
  892. last;
  893. }
  894. elsif ($tok eq '/*')
  895. {
  896. if ($line !~ /\G.*?\*\//cg)
  897. {
  898. $in_comment = 1;
  899. $line = '';
  900. last;
  901. }
  902. next;
  903. }
  904. push @$tokens, $tok;
  905. }
  906. if ($line !~ /\G[\r\n]*$/c)
  907. {
  908. $line = substr($line, pos($line));
  909. die "* Bad token at '$line'\n";
  910. }
  911. }
  912.  
  913. close($fh);
  914.  
  915. return $tokens;
  916. }
  917.  
  918. sub match
  919. {
  920. my ($state, $match) = @_;
  921. my $next = ${$state->[0]}[$state->[1]];
  922. print("[match '$match' @ $state->[1]]\n") if ($trace);
  923. die "* Unexpected token '$next' - expected '$match'\n" if ($next ne $match);
  924. return ${$state->[0]}[++$state->[1]];
  925. }
  926.  
  927. sub remove_node
  928. {
  929. my ($node) = @_;
  930. my $parent = $node->[4];
  931.  
  932. print("[remove_node($node->[0]\n") if ($trace);
  933.  
  934. return if (!$parent);
  935. $node->[4] = undef;
  936.  
  937. # Find the node in the parent
  938. my $found;
  939.  
  940. for (my $i = 0; $i < @{$parent->[2]}; $i++)
  941. {
  942. if ($parent->[2]->[$i] == $node)
  943. {
  944. $found = $i;
  945. last;
  946. }
  947. }
  948.  
  949. die "* Internal error - wrong parent/missing child\n" if (!defined $found);
  950.  
  951. # Remove from the parent
  952. splice(@{$parent->[2]}, $found, 1);
  953. }
  954.  
  955. sub delete_node
  956. {
  957. my ($node) = @_;
  958. my $found;
  959.  
  960. return if (!$node);
  961.  
  962. remove_node($node);
  963.  
  964. # Delete all labels referring to the node
  965. foreach my $label (@{$node->[3]})
  966. {
  967. map_del($cur_dt->{'labels'}, $label);
  968. }
  969.  
  970. print(" [Deleted labels]\n") if ($trace);
  971.  
  972. # Delete all subnodes
  973. while (@{$node->[2]})
  974. {
  975. delete_node($node->[2]->[0]);
  976. }
  977.  
  978. print(" [Deleted subnodes]\n") if ($trace);
  979. return 1;
  980. }
  981.  
  982. sub relabel_node
  983. {
  984. my ($node, $transform, $depth) = @_;
  985.  
  986. # Properties
  987. foreach my $prop (get_props($node))
  988. {
  989. if ($depth > 0)
  990. {
  991. for (my $i = 1; $i < @$prop; $i++)
  992. {
  993. my $chunk = $prop->[$i];
  994. if ($chunk->[0] eq '<')
  995. {
  996. foreach my $term (@{$chunk->[2]})
  997. {
  998. if ($term =~ /^&(.*)/)
  999. {
  1000. my $newlabel = $transform->{$1};
  1001. $term = '&'.$newlabel if ($newlabel);
  1002. }
  1003. }
  1004. }
  1005. }
  1006. }
  1007. }
  1008.  
  1009. # Sub-nodes
  1010. foreach my $subnode (get_children($node))
  1011. {
  1012. relabel_node($subnode, $transform, $depth + 1);
  1013. }
  1014. }
  1015.  
  1016. sub apply_node
  1017. {
  1018. my ($dst, $src) = @_;
  1019.  
  1020. # Properties
  1021. foreach my $prop (get_props($src))
  1022. {
  1023. set_prop($dst, @$prop);
  1024. }
  1025.  
  1026. # Sub-nodes
  1027. foreach my $subsrc (get_children($src))
  1028. {
  1029. my $subdst = get_child($dst, $subsrc->[0]) || add_node($dst, $subsrc->[0]);
  1030. apply_node($subdst, $subsrc);
  1031. }
  1032. }
  1033.  
  1034. sub search_path
  1035. {
  1036. my ($fname) = @_;
  1037. return $fname if (-r $fname);
  1038. return undef;
  1039. }
  1040.  
  1041. sub new_node
  1042. {
  1043. my ($name) = @_;
  1044. return [ $name, [], [], [] ];
  1045. }
  1046.  
  1047. sub add_node
  1048. {
  1049. my ($parent, $name) = @_;
  1050. my $node = (ref $name) ? $name : new_node($name);
  1051. $node->[4] = $parent;
  1052. if ($parent)
  1053. {
  1054. $node->[5] = $parent->[5] + 1;
  1055. push @{$parent->[2]}, $node;
  1056. }
  1057. else
  1058. {
  1059. die "* Invalid root node '$name'\n" if ($name ne '/');
  1060. $node->[5] = 0;
  1061. $cur_dt->{'root'} = $node;
  1062. }
  1063. return $node;
  1064. }
  1065.  
  1066. sub get_node
  1067. {
  1068. my ($dt, $path) = @_;
  1069.  
  1070. if ($path eq '/soc/dma')
  1071. {
  1072. print("");
  1073. }
  1074. my $node = $dt->{'root'};
  1075. if ($path =~ s/^([^\/]+)\//\//)
  1076. {
  1077. $node = resolve_alias($dt, $1);
  1078. }
  1079. return $node if ($path eq '/');
  1080. while ($node && $path =~ /\G\/([-a-zA-Z0-9,._+#@]+)/g)
  1081. {
  1082. my $name = $1;
  1083. $node = get_child($node, $name);
  1084. }
  1085.  
  1086. return $node;
  1087. }
  1088.  
  1089. sub get_child
  1090. {
  1091. my ($node, $name) = @_;
  1092.  
  1093. if ($node)
  1094. {
  1095. foreach my $child (@{$node->[2]})
  1096. {
  1097. return $child if (($child->[0] eq $name) ||
  1098. ($name !~ /@/ && $child->[0] =~ /^$name@/));
  1099. }
  1100. }
  1101. else
  1102. {
  1103. return $cur_dt->{'root'} if ($name eq '/');
  1104. }
  1105. return undef;
  1106. }
  1107.  
  1108. sub by_addr
  1109. {
  1110. my $a_addr = ($a->[0] =~ /@(.*)$/) ? hex($1) : undef;
  1111. my $b_addr = ($b->[0] =~ /@(.*)$/) ? hex($1) : undef;
  1112. return $a_addr <=> $b_addr if ($a_addr && $b_addr);
  1113. return -1 if ($a_addr);
  1114. return 1 if ($b_addr);
  1115. return $a->[0] cmp $b->[0];
  1116. }
  1117.  
  1118. sub get_children
  1119. {
  1120. my ($node) = @_;
  1121.  
  1122. return sort by_addr (@{$node->[2]}) if ($sort);
  1123. return (@{$node->[2]});
  1124. }
  1125.  
  1126. sub get_fragments
  1127. {
  1128. my ($ov) = @_;
  1129.  
  1130. my @fragments;
  1131.  
  1132. foreach my $child (get_children($ov->{'root'}))
  1133. {
  1134. push @fragments, $child if ($child->[0] =~ /^fragment@(\d+)$/);
  1135. }
  1136.  
  1137. return @fragments;
  1138. }
  1139.  
  1140. sub renumber_fragments
  1141. {
  1142. my ($ov, $offset) = @_;
  1143.  
  1144. my @fragments;
  1145. my @remap;
  1146. my $count = 0;
  1147. my $overrides;
  1148.  
  1149. foreach my $child (get_children($ov->{'root'}))
  1150. {
  1151. if ($child->[0] =~ /^fragment@(\d+)$/)
  1152. {
  1153. my $num = $1;
  1154. $remap[$num] = $count + $offset;
  1155. $child->[0] = sprintf('fragment@%d', $count + $offset);
  1156. push @fragments, $child;
  1157. $count++;
  1158. }
  1159. elsif ($child->[0] eq '__overrides__')
  1160. {
  1161. $overrides = $child;
  1162. }
  1163. }
  1164.  
  1165. $ov->{'frag_count'} = $count;
  1166.  
  1167. return if (!$overrides);
  1168.  
  1169. foreach my $ovr (@{$overrides->[1]})
  1170. {
  1171. for (my $pos = 1; $pos < @$ovr; $pos++)
  1172. {
  1173. my $p = $ovr->[$pos];
  1174. if (($p->[0] eq '<') && ($p->[2]->[0] eq '0'))
  1175. {
  1176. $pos++;
  1177. $ovr->[$pos]->[1] =~ s/\G([=!+-])(\d+)/$1.$remap[$2]/eg;
  1178. }
  1179. }
  1180. }
  1181. }
  1182.  
  1183. sub node_path
  1184. {
  1185. my ($node) = @_;
  1186. return '/' if ($node->[0] eq '/');
  1187. my $parent_path = node_path($node->[4]);
  1188. $parent_path = '' if ($parent_path eq "/");
  1189. return $parent_path.'/'.$node->[0];
  1190. }
  1191.  
  1192. sub get_prop
  1193. {
  1194. my ($node, $name) = @_;
  1195.  
  1196. foreach my $prop (@{$node->[1]})
  1197. {
  1198. return $prop if ($prop->[0] eq $name);
  1199. }
  1200.  
  1201. return undef;
  1202. }
  1203.  
  1204. sub get_props
  1205. {
  1206. my ($node) = @_;
  1207.  
  1208. return sort { $a->[0] cmp $b->[0] } (@{$node->[1]}) if ($sort);
  1209. return (@{$node->[1]});
  1210. }
  1211.  
  1212. sub add_prop
  1213. {
  1214. my ($node, $name, @vals) = @_;
  1215. my $new = [ $name, @vals ];
  1216. push @{$node->[1]}, $new;
  1217. return $new;
  1218. }
  1219.  
  1220. sub set_prop
  1221. {
  1222. my ($node, $name, @vals) = @_;
  1223.  
  1224. foreach my $prop (@{$node->[1]})
  1225. {
  1226. if ($prop->[0] eq $name)
  1227. {
  1228. if ($name eq 'status')
  1229. {
  1230. @vals = (['"', boolean_value($vals[0][1]) ? 'okay' : 'disabled']);
  1231. }
  1232. elsif ($name eq 'bootargs')
  1233. {
  1234. # Concatenate bootargs
  1235. @vals = (['"', get_prop($node, $name)->[1][1] .
  1236. ' ' . $vals[0][1]]);
  1237. }
  1238. splice(@$prop, 1, @$prop - 1, @vals);
  1239. return $prop;
  1240. }
  1241. }
  1242.  
  1243. return add_prop($node, $name, @vals);
  1244. }
  1245.  
  1246. sub delete_prop
  1247. {
  1248. my ($node, $name) = @_;
  1249.  
  1250. for (my $i = 0; $i < @{$node->[1]}; $i++)
  1251. {
  1252. my $prop = $node->[1]->[$i];
  1253. return splice(@{$node->[1]}, $i) if ($prop->[0] eq $name);
  1254. }
  1255.  
  1256. return undef;
  1257. }
  1258.  
  1259. sub find_prop_chunk
  1260. {
  1261. my ($node, $propname, $offset, $size, $ovrname, $create) = @_;
  1262.  
  1263. my $chunk;
  1264. my $prop = get_prop($node, $propname);
  1265. if (!$prop && $create)
  1266. {
  1267. $prop = set_prop($node, $propname, [ '<', $size, [] ]);
  1268. }
  1269. return (undef, 0) if (!$prop);
  1270.  
  1271. my $pos = 0;
  1272. for (my $i = 1; $i < @$prop; $i++)
  1273. {
  1274. $chunk = $prop->[$i];
  1275. my $type = $chunk->[0];
  1276. my $end;
  1277. if ($type eq '"')
  1278. {
  1279. $end = $pos + length($chunk->[1]) + 1;
  1280. }
  1281. elsif ($type eq '[')
  1282. {
  1283. $end = $pos + @{$chunk->[1]};
  1284. }
  1285. else
  1286. {
  1287. $end = $pos + $chunk->[1] * @{$chunk->[2]};
  1288. }
  1289. last if ($offset < $end);
  1290. $pos = $end;
  1291. }
  1292.  
  1293. $offset -= $pos;
  1294. die "* Unaligned override '$ovrname', property $prop\n" if ($offset % $size);
  1295. return ($chunk, $offset / $size);
  1296. }
  1297.  
  1298. sub integer_value
  1299. {
  1300. my ($value) = @_;
  1301. if ($value =~ /^(y|yes|on|true|down)?$/)
  1302. {
  1303. return 1;
  1304. }
  1305. elsif ($value =~ /^(n|no|off|false|none)$/)
  1306. {
  1307. return 0;
  1308. }
  1309. elsif ($value =~ /^up$/)
  1310. {
  1311. return 2;
  1312. }
  1313. elsif ($value =~ /^[0-9]/)
  1314. {
  1315. return eval($value);
  1316. }
  1317. die "* Bad boolean value '$value'\n";
  1318. }
  1319.  
  1320. sub boolean_value
  1321. {
  1322. my ($value) = @_;
  1323. if ($value =~ /^(y|yes|on|true|okay)?$/)
  1324. {
  1325. return 1;
  1326. }
  1327. elsif ($value =~ /^(n|no|off|false|disabled)$/)
  1328. {
  1329. return 0;
  1330. }
  1331. elsif ($value !~ /^[0-9]/)
  1332. {
  1333. die "* Bad boolean value '$value'\n";
  1334. }
  1335. return $value != 0;
  1336. }
  1337.  
  1338. sub set_add
  1339. {
  1340. my ($set, $val) = @_;
  1341.  
  1342. for (my $i = 0; $i < @$set; $i++)
  1343. {
  1344. return if ((ref $val && $set->[$i] == $val) ||
  1345. ($set->[$i] eq $val));
  1346.  
  1347. }
  1348. push @$set, $val;
  1349. }
  1350.  
  1351. sub set_vals
  1352. {
  1353. my ($set) = @_;
  1354. return @$set;
  1355. }
  1356.  
  1357. sub set_empty
  1358. {
  1359. my ($set) = @_;
  1360. return @$set == 0;
  1361. }
  1362.  
  1363. sub map_add
  1364. {
  1365. my ($map, $name, $val) = @_;
  1366. $map->{$name} = $val;
  1367. }
  1368.  
  1369. sub map_del
  1370. {
  1371. my ($map, $name) = @_;
  1372. delete $map->{$name};
  1373. }
  1374.  
  1375. sub map_find
  1376. {
  1377. my ($map, $name) = @_;
  1378. return $map->{$name};
  1379. }
  1380.  
  1381. sub get_int
  1382. {
  1383. my ($state) = @_;
  1384. my $next = $state->[0]->[$state->[1]];
  1385. return undef if ($next !~ /^[0-9]/);
  1386. match($state, $next);
  1387. return $next;
  1388. }
  1389.  
  1390. sub usage
  1391. {
  1392. print STDERR ("Usage: ovmerge <options> <ovspec>\n");
  1393. print STDERR (" Where <ovspec> is the name of an overlay, optionally followed by\n");
  1394. print STDERR (" a comma-separated list of parameters, each with optional '=<value>'\n");
  1395. print STDERR (" assignemts. The presens of any parameters, or a comma followed by\n");
  1396. print STDERR (" no parameters, removes the parameter declarations from merged overlay,\n");
  1397. print STDERR (" to avoid a potential name clash.\n");
  1398. print STDERR (" And <options> are any of:\n");
  1399. print STDERR (" -c - include 'redo' comment with command line\n");
  1400. print STDERR (" -h - display this help info\n");
  1401. print STDERR (" -i - show include hierarchy for each file\n");
  1402. print STDERR (" -p - emulate Pi firmware manipulation\n");
  1403. print STDERR (" -r - redo command comment in named files\n");
  1404. print STDERR (" -s - sort nodes and properties (for easy comparison)\n");
  1405. print STDERR (" -t - trace\n");
  1406. print STDERR (" -w - show warnings\n");
  1407. }
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!