This is an automated email from Gerrit.
"Antonio Borneo <borneo.anto...@gmail.com>" just uploaded a new patch set to
Gerrit, which you can find at https://review.openocd.org/c/openocd/+/7466
-- gerrit
commit 4f67d944ab8895b8a2f38e161324aa760969dcc7
Author: Antonio Borneo <borneo.anto...@gmail.com>
Date: Fri Jan 27 18:13:31 2023 +0100
tcl: add helper to parse devicetree properties
When OpenOCD runs on Linux platforms (e.g. STM32MP1xx, Raspberry
PI), it could be relevant to extract some system information from
the device tree of the platform.
Add some TCL procedure to help reading data from the devicetree
properties.
Change-Id: I5946b27587a1c6b09f1079dfb3976d8e8633d58a
Signed-off-by: Antonio Borneo <borneo.anto...@gmail.com>
diff --git a/tcl/devicetree.tcl b/tcl/devicetree.tcl
new file mode 100644
index 0000000000..e22c636ced
--- /dev/null
+++ b/tcl/devicetree.tcl
@@ -0,0 +1,54 @@
+# SPDX-License-Identifier: GPL-2.0-or-later OR BSD-2-Clause
+
+# Copyright (c) 2023 STMicroelectronics.
+# All rights reserved.
+
+# Helper functions to read a property in devicetree, typically the content of a
+# file in /proc/device-tree/ or /sys/firmware/devicetree/base/
+
+# Read a boolean property
+# Can be used to test if a property exists
+# @fname the full path of the property
+# @returns 0 if property is not present, 1 if property is present
+proc dt_get_bool { fname } {
+ file isfile $fname
+}
+
+# Read a string-list property
+# NUL separated strings are returned as elements in a list
+# @fname the full path of the property
+# @returns a list of strings, or error if property is missing or unreadable
+proc dt_get_string { fname } {
+ set fd [open $fname r]
+ fconfigure $fd -translation binary
+ set data [read $fd]
+ close $fd
+
+ if { [string length $data] == 0 || [string range $data end end] !=
"\x00" } {
+ error "property is not a list of NUL terminated strings:
'$fname'"
+ }
+
+ lrange [split $data "\x00"] 0 end-1
+}
+
+# Read a u32-list property
+# @fname the full path of the property
+# @returns a list of strings, or error if property is missing or unreadable
+proc dt_get_u32 { fname } {
+ set fd [open $fname r]
+ fconfigure $fd -translation binary
+ set data [read $fd]
+ close $fd
+
+ set len [string length $data]
+ if { $len == 0 || [expr { $len % 4 }] != 0 } {
+ error "property is not a list of u32: '$fname'"
+ }
+
+ unset -nocomplain result
+ for { set i 0 } { $i < $len } { incr i 4 } {
+ scan [string range $data $i [expr { $i + 3 }]] "%c%c%c%c" x3 x2
x1 x0
+ lappend result [format "0x%02x%02x%02x%02x" $x3 $x2 $x1 $x0]
+ }
+ return $result
+}
--
