gdb: Add the $_poke utility function

Add the $_poke utility function so it is possible to use poke in
breakpoint condition for example.

The expression must return a poke boolean.

gdb/ChangeLog-2021

@@ -1,3 +1,4 @@
+<<<<<<< HEAD:gdb/ChangeLog-2021
 2021-07-06  Tom de Vries  <tdevries@suse.de>
 
 	* dwarf2/read.c (scan_partial_symbols): Skip top-level imports of
@@ -576,6 +577,17 @@
 	* silent-rules.mk (ECHO_CCLD, ECHO_AR, ECHO_RANLIB): New.
 
 2021-06-16  Tom de Vries  <tdevries@suse.de>
+=======
+2021-05-10  Jose E. Marchesi  <jose.marchesi@oracle.com>
+
+	* configure.ac: Support --enable-poke.
+	* configure: Regenerate.
+	* Makefile.in (POKE_OBS): Define based on @POKE_OBS@.
+	(DEPFILES): Add POKE_OBS.
+	* poke.c: New file.
+
+2021-05-07  Tom de Vries  <tdevries@suse.de>
+>>>>>>> Integrate GNU poke in GDB:gdb/ChangeLog
 
 	PR symtab/26327
 	* dwarf2/cu.h (dwarf2_cu::ancestor): Remove.

gdb/Makefile.in

@@ -682,6 +682,9 @@ SER_HARDWIRE = @SER_HARDWIRE@
 # This is remote-sim.o if a simulator is to be linked in.
 SIM_OBS = @SIM_OBS@
 
+# Object files to integrate with GNU poke.
+POKE_OBS = @POKE_OBS@
+
 # Target-dependent object files.
 TARGET_OBS = @TARGET_OBS@
 
@@ -1588,7 +1591,8 @@ HFILES_WITH_SRCDIR = \
 # variables analogous to SER_HARDWIRE which get defaulted in this
 # Makefile.in
 
-DEPFILES = $(TARGET_OBS) $(SER_HARDWIRE) $(NATDEPFILES) $(SIM_OBS)
+DEPFILES = $(TARGET_OBS) $(SER_HARDWIRE) $(NATDEPFILES) $(SIM_OBS) \
+           $(POKE_OBS)
 
 SOURCES = $(SFILES) $(ALLDEPFILES) $(YYFILES) $(CONFIG_SRCS)
 # Don't include YYFILES (*.c) because we already include *.y in SFILES,

gdb/NEWS

@@ -404,6 +404,12 @@ GNU/Linux/OpenRISC		or1k*-*-linux*
      need to focus on the command window for such key combinations to
      work.
 
+* DDB now supports GNU poke, the extensible editor for structured
+  binary data.
+
+  To build GDB with poke support, pass --with-poke to configure (this
+  requires libpoke, the GNU poke library).
+
 * New commands
 
 set debug event-loop
@@ -469,6 +475,18 @@ show python dont-write-bytecode
   When set to 'auto' (the default) Python will check the
   PYTHONDONTWRITEBYTECODE environment variable.
 
+poke STR
+  Execute a Poke statement or declaration.
+
+poke-add-type EXPR
+  Make Poke aware of a GDB type given an expression.
+
+poke-add-types REGEXP
+  Make Poke aware of GDB types based on a regexp.
+
+poke-dump-types
+  Dump the definition of all the GDB types known to poke.
+
 * Changed commands
 
 break [PROBE_MODIFIER] [LOCATION] [thread THREADNUM]

gdb/configure

@@ -749,6 +749,7 @@ LTLIBICONV
 LIBICONV
 zlibinc
 zlibdir
+POKE_OBS
 MIG
 WINDRES
 DLLTOOL
@@ -850,6 +851,7 @@ infodir
 docdir
 oldincludedir
 includedir
+runstatedir
 localstatedir
 sharedstatedir
 sysconfdir
@@ -892,6 +894,7 @@ enable_profiling
 enable_codesign
 with_pkgversion
 with_bugurl
+with_poke
 with_system_zlib
 with_gnu_ld
 enable_rpath
@@ -1001,6 +1004,7 @@ datadir='${datarootdir}'
 sysconfdir='${prefix}/etc'
 sharedstatedir='${prefix}/com'
 localstatedir='${prefix}/var'
+runstatedir='${localstatedir}/run'
 includedir='${prefix}/include'
 oldincludedir='/usr/include'
 docdir='${datarootdir}/doc/${PACKAGE}'
@@ -1253,6 +1257,15 @@ do
   | -silent | --silent | --silen | --sile | --sil)
     silent=yes ;;
 
+  -runstatedir | --runstatedir | --runstatedi | --runstated \
+  | --runstate | --runstat | --runsta | --runst | --runs \
+  | --run | --ru | --r)
+    ac_prev=runstatedir ;;
+  -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \
+  | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \
+  | --run=* | --ru=* | --r=*)
+    runstatedir=$ac_optarg ;;
+
   -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
     ac_prev=sbindir ;;
   -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
@@ -1390,7 +1403,7 @@ fi
 for ac_var in	exec_prefix prefix bindir sbindir libexecdir datarootdir \
 		datadir sysconfdir sharedstatedir localstatedir includedir \
 		oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
-		libdir localedir mandir
+		libdir localedir mandir runstatedir
 do
   eval ac_val=\$$ac_var
   # Remove trailing slashes.
@@ -1543,6 +1556,7 @@ Fine tuning of the installation directories:
   --sysconfdir=DIR        read-only single-machine data [PREFIX/etc]
   --sharedstatedir=DIR    modifiable architecture-independent data [PREFIX/com]
   --localstatedir=DIR     modifiable single-machine data [PREFIX/var]
+  --runstatedir=DIR       modifiable per-process data [LOCALSTATEDIR/run]
   --libdir=DIR            object code libraries [EPREFIX/lib]
   --includedir=DIR        C header files [PREFIX/include]
   --oldincludedir=DIR     C header files for non-gcc [/usr/include]
@@ -1640,6 +1654,7 @@ Optional Packages:
                           library
   --with-pkgversion=PKG   Use PKG in the version string in place of "GDB"
   --with-bugurl=URL       Direct users to URL to report a bug
+  --with-poke             Build GDB with poke support (default is NO)
   --with-system-zlib      use installed libz
   --with-gnu-ld           assume the C compiler uses GNU ld default=no
   --with-libiconv-prefix[=DIR]  search for libiconv in DIR/include and DIR/lib
@@ -4863,7 +4878,7 @@ else
     We can't simply define LARGE_OFF_T to be 9223372036854775807,
     since some C++ compilers masquerading as C compilers
     incorrectly reject 9223372036854775807.  */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
+#define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31))
   int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
 		       && LARGE_OFF_T % 2147483647 == 1)
 		      ? 1 : -1];
@@ -4909,7 +4924,7 @@ else
     We can't simply define LARGE_OFF_T to be 9223372036854775807,
     since some C++ compilers masquerading as C compilers
     incorrectly reject 9223372036854775807.  */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
+#define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31))
   int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
 		       && LARGE_OFF_T % 2147483647 == 1)
 		      ? 1 : -1];
@@ -4933,7 +4948,7 @@ rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
     We can't simply define LARGE_OFF_T to be 9223372036854775807,
     since some C++ compilers masquerading as C compilers
     incorrectly reject 9223372036854775807.  */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
+#define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31))
   int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
 		       && LARGE_OFF_T % 2147483647 == 1)
 		      ? 1 : -1];
@@ -4978,7 +4993,7 @@ else
     We can't simply define LARGE_OFF_T to be 9223372036854775807,
     since some C++ compilers masquerading as C compilers
     incorrectly reject 9223372036854775807.  */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
+#define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31))
   int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
 		       && LARGE_OFF_T % 2147483647 == 1)
 		      ? 1 : -1];
@@ -5002,7 +5017,7 @@ rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
     We can't simply define LARGE_OFF_T to be 9223372036854775807,
     since some C++ compilers masquerading as C compilers
     incorrectly reject 9223372036854775807.  */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
+#define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31))
   int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
 		       && LARGE_OFF_T % 2147483647 == 1)
 		      ? 1 : -1];
@@ -8230,6 +8245,69 @@ if test "$ac_res" != no; then :
 fi
 
 
+# Integration with GNU poke is done through the libpoke library.
+
+# Check whether --with-poke was given.
+if test "${with_poke+set}" = set; then :
+  withval=$with_poke; with_poke=$withval
+else
+  with_poke=no
+fi
+
+if test "x$with_poke" = "xyes"; then
+  # Note that we need a libpoke with support for registering foreign
+  # IO devices, hence the symbol pk_register_iod.
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pk_register_iod in -lpoke" >&5
+$as_echo_n "checking for pk_register_iod in -lpoke... " >&6; }
+if ${ac_cv_lib_poke_pk_register_iod+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lpoke  $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char pk_register_iod ();
+int
+main ()
+{
+return pk_register_iod ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_poke_pk_register_iod=yes
+else
+  ac_cv_lib_poke_pk_register_iod=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_poke_pk_register_iod" >&5
+$as_echo "$ac_cv_lib_poke_pk_register_iod" >&6; }
+if test "x$ac_cv_lib_poke_pk_register_iod" = xyes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_LIBPOKE 1
+_ACEOF
+
+  LIBS="-lpoke $LIBS"
+
+fi
+
+  POKE_OBS="poke.o"
+else
+  POKE_OBS=
+fi
+
+
 # Link in zlib if we can.  This allows us to read compressed debug sections.
 
   # Use the system's zlib library.

gdb/configure.ac

@@ -478,6 +478,21 @@ AC_SEARCH_LIBS(gethostbyname, nsl)
 # Some systems (e.g. Solaris) have `socketpair' in libsocket.
 AC_SEARCH_LIBS(socketpair, socket)
 
+# Integration with GNU poke is done through the libpoke library.
+AC_ARG_WITH([poke],
+            AS_HELP_STRING([--with-poke],
+                           [Build GDB with poke support (default is NO)]),
+            [with_poke=$withval], [with_poke=no])
+if test "x$with_poke" = "xyes"; then
+  # Note that we need a libpoke with support for registering foreign
+  # IO devices, hence the symbol pk_register_iod.
+  AC_CHECK_LIB(poke, pk_register_iod)
+  POKE_OBS="poke.o"
+else
+  POKE_OBS=
+fi
+AC_SUBST(POKE_OBS)
+
 # Link in zlib if we can.  This allows us to read compressed debug sections.
 AM_ZLIB
 

gdb/doc/ChangeLog-1991-2021

@@ -1,4 +1,14 @@
+<<<<<<< HEAD:gdb/doc/ChangeLog-1991-2021
 2021-07-02  Pedro Alves  <pedro@palves.net>
+=======
+2021-05-10  Jose E. Marchesi  <jose.marchesi@oracle.com>
+
+	* Makefile.in (GDB_DOC_FILES): Add poke.texi.
+	* poke.texi: New file.
+	* gdb.texinfo (Data): Add meny entry for Poke and @include poke.texi.
+
+2021-05-07  Tom de Vries  <tdevries@suse.de>
+>>>>>>> Integrate GNU poke in GDB:gdb/doc/ChangeLog
 
 	* gdb.texinfo (TUI): <TUI Mouse Support>: New node/section.
 

gdb/doc/Makefile.in

@@ -138,6 +138,7 @@ GDB_DOC_FILES = \
 	$(srcdir)/gdb.texinfo \
 	$(srcdir)/guile.texi \
 	$(srcdir)/python.texi \
+        $(srcdir)/poke.texi \
 	$(GDB_DOC_SOURCE_INCLUDES) \
 	$(GDB_DOC_BUILD_INCLUDES)
 

gdb/doc/gdb.texinfo

@@ -10292,6 +10292,7 @@ being passed the type of @var{arg} as the argument.
 * Caching Target Data::         Data caching for targets
 * Searching Memory::            Searching memory for a sequence of bytes
 * Value Sizes::                 Managing memory allocated for values
+* Poke::                        Poking at data using GNU poke.
 @end menu
 
 @node Expressions
@@ -13833,6 +13834,9 @@ Show the maximum size of memory, in bytes, that @value{GDBN} will
 allocate for the contents of a value.
 @end table
 
+@c Poke docs live in a separate file.
+@include poke.texi
+
 @node Optimized Code
 @chapter Debugging Optimized Code
 @cindex optimized code, debugging

gdb/doc/poke.texi

@@ -0,0 +1,417 @@
+@c Copyright (C) 2022 Free Software Foundation, Inc.
+@c Permission is granted to copy, distribute and/or modify this document
+@c under the terms of the GNU Free Documentation License, Version 1.3 or
+@c any later version published by the Free Software Foundation; with the
+@c Invariant Sections being ``Free Software'' and ``Free Software Needs
+@c Free Documentation'', with the Front-Cover Texts being ``A GNU Manual,''
+@c and with the Back-Cover Texts as in (a) below.
+@c
+@c (a) The FSF's Back-Cover Text is: ``You are free to copy and modify
+@c this GNU Manual.  Buying copies from GNU Press supports the FSF in
+@c developing GNU and promoting software freedom.''
+
+@node Poke
+@section Poking at data using GNU @samp{poke}
+@cindex GNU poke
+@cindex poke
+
+@uref{http://jemarch.net/poke.html,GNU poke} is an interactive,
+extensible editor for binary data that implements a full-fledged
+procedural, interactive domain specific language called @dfn{Poke}
+(with capital P) that is specifically designed in order to describe
+the layout of structured binary data and to operate on it.
+
+@value{GDBN} integrates with GNU @samp{poke} by mean of the
+@file{libpoke} library and offers the possibility of executing Poke
+code from within the debugger, to inspect and modify data in the
+target's memory.  This feature is available only if @value{GDBN} was
+configured using @option{--enable-poke}.
+
+As we shall see in the sections below, @value{GDBN} uses the
+integration mechanisms provided by @file{libpoke} in order to make
+certain @value{GDBN} abstractions (such as symbols and types) visible from the
+Poke side, making the integration bidirectional.
+
+Note that this section documents the integration of GNU @samp{poke}
+and @value{GDBN} and how to use it, but it doesn't describe GNU
+@samp{poke} nor the Poke language in detail. @xref{Top,,, poke, The
+GNU poke Manual}, for more information.
+
+@menu
+* The @code{poke} Command::  Executing Poke from @value{GDBN}.
+* Poking the Target Memory::    Accessing the target's memory from Poke.
+* @value{GDBN} Types and Poke::         Accessing @value{GDBN} types from Poke.
+* @value{GDBN} Values and Poke::        Accessing @value{GDBN} values from Poke.
+@end menu
+
+@node The @code{poke} Command
+@subsection The @code{poke} Command
+
+The @code{poke} command allows to execute arbitrary Poke code from the
+@value{GDBN} prompt.
+
+@table @code
+@item poke @var{src}
+@var{src} is either a Poke expression, statement or definition.
+@end table
+
+For example, this executes a simple Poke expression and shows the
+result:
+
+@smallexample
+(@value{GDBP}) poke 2 + 3UL
+0x5UL
+@end smallexample
+
+This declares a couple of Poke types and a variable:
+
+@smallexample
+(@value{GDBP}) poke type byte = uint<8>
+(@value{GDBP}) poke type Packet = struct @{ byte magic == 0x4a; byte sz; \
+                                       byte[sz] payload; @}
+(@value{GDBP}) poke Packet @{ sz = 4 @}
+Packet @{
+  magic=0x4aUB,
+  sz=0x4UB,
+  payload=[0x0UB,0x0UB,0x0UB,0x0UB]
+@}
+(@value{GDBP}) poke var p = Packet @{ sz = 4 @}
+(@value{GDBP}) poke p.payload
+[0x0UB,0x0UB,0x0UB,0x0UB]
+@end smallexample
+
+This executes a Poke statement:
+
+@smallexample
+(@value{GDBP}) poke for (i in [1,2,3]) printf "%v\n", i
+0x00000001
+0x00000002
+0x00000003
+@end smallexample
+
+This shows how the Poke incremental compiler handles and reports
+invalid input:
+
+@smallexample
+(@value{GDBP}) poke 2 + fjsdio
+<stdin>:1:5: error: undefined variable 'fjsdio'
+2 + fjsdio;
+    ^~~~~~
+@end smallexample
+
+The standard @command{load} Poke directive loads a Poke source file
+and executes it in the incremental compiler.  The list of directories
+where @command{load} looks for files is in the variable
+@code{load_path}:
+
+@smallexample
+(@value{GDBP}) poke load_path
+".:/home/jemarch/.local/share/poke:%DATADIR%/pickles:%DATADIR%"
+@end smallexample
+
+This loads a file @file{foo.pk} if it is found in the load path:
+
+@smallexample
+(@value{GDBP}) poke load foo
+@end smallexample
+
+Poke source files often contain definitions that conceptually apply to
+some definite domain, like some given file format or a protocol.  We
+call these files @dfn{pickles}.  For example, @file{elf.pk} is a
+pickle that provides facilities to poke ELF object files.  The GNU
+@samp{poke} editor comes with lots of already written pickles for many
+file formats and other domains.  If you happen to have GNU poke
+installed (and not just @file{libpoke}) you can also use the many
+pickles distributed with the editor.  For example:
+
+@smallexample
+(@value{GDBP}) poke load "std-types.pk"
+(@value{GDBP}) poke load elf
+(@value{GDBP}) poke Elf64_Rela @{@}
+Elf64_Rela @{
+  r_offset=0x0UL#B,
+  r_info=Elf64_RelInfo @{
+    r_sym=0x0U,
+    r_type=0x0U
+  @},
+  r_addend=0x0L
+@}
+@end smallexample
+
+The reason why @file{std-types.pk} has to be loaded before
+@file{elf.pk} is explained later in this manual.
+
+@node Poking the Target Memory
+@subsection Poking the Target Memory
+
+@value{GDBN} configures @file{libpoke} to access the target's memory
+as an IO space device called @code{<gdb>}, which is automatically
+opened when the poke incremental compiler is started.
+
+This means that the default IO space in the running poke will provide
+access to the virtual address space of the current @value{GDBN}
+inferior.
+
+For example, suppose that a string table is at offset 0x5ff0 bytes in
+the target's memory.  We could map an array of Poke strings from it by
+issuing:
+
+@smallexample
+(@value{GDBP}) poke string[3] @@ 0x5ff0#B
+["int", "long", "_pid"]
+@end smallexample
+
+And we can write to the target's memory:
+
+@smallexample
+(@value{GDBP}) poke string[] @@ 0x5ff0#B = ["foo", "bar", "baz"]
+@end smallexample
+
+Note that the fact the current IO space is the @value{GDBN} target memory
+doesn't mean you cannot access other IO spaces.  This is how you would
+write the string table above to a file @file{strtab.out}:
+
+@smallexample
+(@value{GDBP}) poke var f = open ("strtab.out", IOS_F_WRITE | IOS_F_CREATE)
+(@value{GDBP}) poke string[] @@ f : 0#B = string[3] @@ 0x5ff0#B
+(@value{GDBP}) poke close (f)
+@end smallexample
+
+If you close the default IO space you can re-open the @value{GDBN} target space
+with @code{open ("<gdb>")}.
+
+@node @value{GDBN} Types and Poke
+@subsection @value{GDBN} Types and Poke
+
+Maybe the strongest side of the Poke language is that it provides a
+very rich and dynamic mechanism to describe the layout of data
+structures.  This is done by defining @dfn{Poke types}.
+
+For example, this is the definition of a signed 13-bit integral type
+that could be used to poke immediate fields in SPARC instructions:
+
+@smallexample
+type simm13 = int<13>;
+@end smallexample
+
+And this is a simplified version of the structure of a 64-bit ELF file
+showing more advanced Poke capabilities like field constraints, field
+labels, absent fields, and methods:
+
+@smallexample
+type Elf64_File =
+  struct
+  @{
+    Elf64_Ehdr ehdr : ehdr.e_ident.ei-mag == [0x7fUB, 'E', 'L', 'F'];
+
+    Elf64_Shdr[ehdr.e_shnum] shdr @@ ehdr.e_shoff
+      if ehdr.e_shnum > 0;
+
+    Elf64_Phdr[ehdr.e_phnum] phdr @@ ehdr.e_phoff
+      if ehdr.e_phnum > 0;
+
+    /* Given an offset into the ELF file's section string table, return
+       the string.  */
+
+    method get_section_name = (offset<Elf_Word,B> offset) string:
+      @{
+        var strtab = ehdr.e_shstrndx;
+        return string @@ (shdr[strtab].sh_offset + offset);
+      @}
+  @};
+@end smallexample
+
+This is all good and well for GNU @samp{poke} as a standalone binary editor,
+but when it comes to @value{GDBN} we want to poke at data structures
+in the target memory of the debugged program.  These structures are
+described by language-specific types, which @value{GDBN} abstracts as
+@value{GDBN} types, not Poke types.
+
+For example, say we are debugging a C program that contains the
+following type:
+
+@smallexample
+struct person
+@{
+  int age;
+  char *name;
+  char *postal_address;
+@};
+@end smallexample
+
+If we wanted to poke at a struct person from poke, we would need to
+write a Poke struct type that is equivalent to that C type.  This is
+often not trivial, because the physical layout of data structures is
+almost always not well defined in programming languages.
+
+Fortunately, @value{GDBN} provides a few commands to translate
+@value{GDBN} types to Poke types and inspect them.
+
+@table @code
+@item poke-add-type @var{expr}
+@var{expr} is a @value{GDBN} expression that must evaluate to a type.
+
+Translate a @value{GDBN} type to Poke and define it in the running
+poke incremental compiler.  If the given type depends on other types
+that are not known to poke, add these as well.
+
+Types for which @value{GDBN} doesn't know how to create a Poke
+equivalence are simply ignored.
+
+@item poke-add-types @var{regexp}
+@var{regexp} is a regular expression.
+
+Translate all known types whose name matches @var{regexp} to Poke and
+define them in the running poke incremental compiler.  If the matched
+types depend on other types that are not known to poke, add these as
+well.
+
+Types for which @value{GDBN} doesn't know how to create a Poke
+equivalence are simply ignored.
+
+@item poke-dump-types
+Dump the Poke definition of all translated types, one definition per
+line.
+@end table
+
+Using these commands, we can add a type for the @code{struct person} C
+type above like this:
+
+@smallexample
+(@value{GDBN}) poke-add-type struct person
+added type int
+added type struct_person
+@end smallexample
+
+Note how two types are added: the requested @code{struct person} and
+also @code{int}, since the struct contains a field of that basic C
+type.  Let's take a look to the type definitions:
+
+@smallexample
+(@value{GDBN}) poke-dump-types
+type int = int<32>;
+type struct_person = struct @{int age; offset<uint<64>,B> name @@ 8#B; \
+offset<uint<64>,B> postal_address;@};
+@end smallexample
+
+If now we want to access a given variable of type @code{struct person}
+in the current target, we just use the created Poke types:
+
+@smallexample
+(@value{GDBN}) poke struct_person @@ 0xf00e#B
+struct_person @{
+  age=0x28,
+  name=0x5555555547b4UL#B,
+  postal_address=0x5555555547c5UL#B
+@}
+(@value{GDBN}) poke string @@ (struct_person @@ 0xf00e#B).postal_address
+"Foo Street number 13"
+@end smallexample
+
+If we wanted to add all the types known to @value{GDBN} to poke, we could so do
+by:
+
+@smallexample
+(@value{GDBN}) poke-add-types .*
+@end smallexample
+
+The @command{poke-dump-types} is useful to generate Poke files with
+type definitions to be used in GNU @samp{poke}, like this:
+
+@smallexample
+$ gdb -batch -ex poke-add-types .\* -ex poke-dump-types \
+      -ex quit foo.so > foo-types.pk
+@end smallexample
+
+@node @value{GDBN} Values and Poke
+@subsection @value{GDBN} Values and Poke
+
+Poke variables are not the same than @value{GDBN} symbols, and live in
+a separated world of their own.  However, it is possible to refer to
+GDB values by using the @code{$IDENTIFIER} notation in Poke programs.
+
+Consider for example a C program with the following variable:
+
+@smallexample
+short counter;
+@end smallexample
+
+In @value{GDBN} we can access to the value of that variable like this:
+
+@smallexample
+(@value{GDBN}) p counter
+$1 = 0
+@end smallexample
+
+And from the poke side:
+
+@smallexample
+(@value{GDBN}) poke $counter
+0x0H
+@end smallexample
+
+Note how the @value{GDBN} value is visible using the right type, in
+the case above a signed 16-bit integer.  If we accessed a C value of a
+pointer type, like @code{char *str;}, we would get an offset with unit
+bytes instead:
+
+@smallexample
+(@value{GDBN}) poke $str
+0x0UL#B
+@end smallexample
+
+Since many @value{GDBN} values are pointers, it is possible to access
+the address of a value by using the @code{$addr::IDENTIFIER} notation.
+For example, given the C @code{struct person} defined above and a
+variable @code{struct person jemarch;}:
+
+@smallexample
+(@value{GDBN}) poke struct_person @@ $addr::jemarch
+struct_person @{
+  age=0x28,
+  name=0x5555555547b4UL#B,
+  postal_address=0x5555555547c5UL#B
+@}
+@end smallexample
+
+Poke can read registers in the target by using the @code{$reg::REGNAME}
+notation.  The read is done in the context of the selected frame.
+
+The following example shows how poke could be used to decode the value of the
+@code{EFLAGS} register of the x86 ISA:
+
+@smallexample
+(@value{GDBN}) poke type EFlags_T =
+  struct uint<32>
+  @{
+    uint<27> other_flags;
+    uint<1> AF;
+    uint<1> r2 = 0;
+    uint<1> PF;
+    uint<1> r1 = 1;
+    uint<1> CF;
+  @}
+(@value{GDBN}) poke $reg::eflags as EFlags_T
+EFlags_T @{
+  other_flags=(uint<27>) 0x12,
+  AF=(uint<1>) 0x0,
+  r2=(uint<1>) 0x0,
+  PF=(uint<1>) 0x1,
+  r1=(uint<1>) 0x1,
+  CF=(uint<1>) 0x0
+@}
+@end smallexample
+
+It can also be useful to interpret the content of a register as an address.  To
+do so, it is possible to use the @code{$reg::REGNAME#B} notation.
+
+For example, the following can be used to inspect the current stack frame:
+
+@smallexample
+(@value{GDBN}) poke load "std-types.pk"
+(@value{GDBN}) poke load ios
+(@value{GDBN}) poke ios_dump_bytes :ios get_ios :from $reg::sp#B
+                                   :size ($reg::fp - $reg::sp)#B
+                                   :group_by 1#B
+00007fffffffddd0: 0d f0 ad de 00 00 00 00  ef be ad de 00 00 00 00
+@end smallexample

gdb/poke.c

@@ -0,0 +1,932 @@
+/* GDB integration with GNU poke.
+
+   Copyright (C) 2021 Free Software Foundation, Inc.
+
+   This file is part of GDB.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include "defs.h"
+#include "command.h"
+#include "arch-utils.h"
+#include "target.h"
+#include "gdbcmd.h"
+#include "user-regs.h"
+extern "C" {
+#include <libpoke.h>
+}
+#include <ctype.h>
+#include <vector>
+#include <algorithm>
+
+/* Global poke incremental compiler.  */
+
+static pk_compiler poke_compiler;
+static bool poke_compiler_lives = false;
+
+/* Global vector of the Poke code used to define types.  This is
+   filled in by poke_add_type and used by poke_dump_types.  */
+
+static std::vector<std::string> type_poke_strings;
+
+/* Terminal hook that flushes the terminal.  */
+
+static void
+poke_term_flush (void)
+{
+  /* Do nothing here.  */
+}
+
+/* Terminal hook that prints a fixed string.  */
+
+static void
+poke_puts (const char *str)
+{
+  gdb_printf ("%s", str);
+}
+
+/* Terminal hook that prints a formatted string.  */
+
+__attribute__ ((__format__ (__printf__, 1, 2)))
+static void
+poke_printf (const char *format, ...)
+{
+  va_list ap;
+  char *str;
+  int r;
+
+  va_start (ap, format);
+  r = vasprintf (&str, format, ap);
+  if (r == -1)
+    error (_("out of memory in vasprintf")); /* XXX fatal */
+  va_end (ap);
+
+  gdb_printf ("%s", str);
+  free (str);
+}
+
+/* Terminal hook that indents to a given level.  */
+
+static void
+poke_term_indent (unsigned int lvl, unsigned int step)
+{
+  gdb_printf ("\n%*s", (step * lvl), "");
+}
+
+/* Terminal hook that starts a styling class.  */
+
+static void
+poke_term_class (const char *class_name)
+{
+  /* Do nothing here.  */
+}
+
+/* Terminal hook that finishes a styling class.  */
+
+static int
+poke_term_end_class (const char *class_name)
+{
+  /* Just report success.  */
+  return 1;
+}
+
+/* Terminal hook that starts a terminal hyperlink.  */
+
+static void
+poke_term_hyperlink (const char *url, const char *id)
+{
+  /* Do nothing here.  */
+}
+
+/* Terminal hook that finishes a terminal hyperlink.  */
+
+static int
+poke_term_end_hyperlink (void)
+{
+  /* Just report success.  */
+  return 1;
+}
+
+/* Terminal hook that returns the current terminal foreground
+   color.  */
+
+static struct pk_color
+poke_term_get_color (void)
+{
+  /* Just return the default foreground color.  */
+  struct pk_color dfl = {-1,-1,-1};
+  return dfl;
+}
+
+/* Terminal hook that returns the current terminal background
+   color.  */
+
+static struct pk_color
+poke_term_get_bgcolor (void)
+{
+  /* Just return the default background color.  */
+  struct pk_color dfl = {-1,-1,-1};
+  return dfl;
+}
+
+/* Terminal hook that sets the terminal foreground color.  */
+
+static void
+poke_term_set_color (struct pk_color color)
+{
+  /* Do nothing.  */
+}
+
+/* Terminal hook that sets the terminal background color.  */
+
+static void
+poke_term_set_bgcolor (struct pk_color color)
+{
+  /* Do nothing.  */
+}
+
+/* Implementation of the poke terminal interface, that uses the hooks
+   defined above.  */
+
+static struct pk_term_if poke_term_if =
+  {
+    .flush_fn = poke_term_flush,
+    .puts_fn = poke_puts,
+    .printf_fn = poke_printf,
+    .indent_fn = poke_term_indent,
+    .class_fn = poke_term_class,
+    .end_class_fn = poke_term_end_class,
+    .hyperlink_fn = poke_term_hyperlink,
+    .end_hyperlink_fn = poke_term_end_hyperlink,
+    .get_color_fn = poke_term_get_color,
+    .get_bgcolor_fn = poke_term_get_bgcolor,
+    .set_color_fn = poke_term_set_color,
+    .set_bgcolor_fn = poke_term_set_bgcolor,
+  };
+
+/* Foreign IO device hook that returns an unique name identifying the
+   kind of device.  */
+
+static const char *
+iod_get_if_name (void)
+{
+  return "GDB";
+}
+
+/* Foreign IO device hook that recognizes whether a given IO space
+   handler refer to this kind of device, and normalizes it for further
+   use.  */
+
+static char *
+iod_handler_normalize (const char *handler, uint64_t flags, int *error)
+{
+  char *new_handler = nullptr;
+
+  if (strcmp (handler, "<gdb>") == 0)
+    new_handler = xstrdup (handler);
+  if (error != nullptr)
+    *error = PK_IOD_OK;
+
+  return new_handler;
+}
+
+/* Foreign IO device hook that opens a new device.  */
+
+static int iod_opened_p = 0;
+
+static void *
+iod_open (const char *handler, uint64_t flags, int *error, void *data)
+{
+  iod_opened_p = 1;
+  return &iod_opened_p;
+}
+
+/* Foreign IO device hook that reads data from a device.  */
+
+static int
+iod_pread (void *dev, void *buf, size_t count, pk_iod_off offset)
+{
+  int ret = target_read_memory (offset, (gdb_byte *) buf, count);
+  return ret == -1 ? PK_IOD_ERROR : PK_IOD_OK;
+}
+
+/* Foreign IO device hook that writes data to a device.  */
+
+static int
+iod_pwrite (void *dev, const void *buf, size_t count, pk_iod_off offset)
+{
+  int ret = target_write_memory (offset, (gdb_byte *) buf, count);
+  return ret == -1 ? PK_IOD_ERROR : PK_IOD_OK;
+}
+
+/* Foreign IO device hook that returns the flags of an IO device. */
+
+static uint64_t
+iod_get_flags (void *dev)
+{
+  return PK_IOS_F_READ | PK_IOS_F_WRITE;
+}
+
+/* Foreign IO device hook that returns the size of an IO device, in
+   bytes.  */
+
+static pk_iod_off
+iod_size (void *dev)
+{
+  return (gdbarch_addr_bit (get_current_arch ()) == 32
+	  ? 0xffffffff : 0xffffffffffffffff);
+}
+
+/* Foreign IO device hook that flushes an IO device.  */
+
+static int
+iod_flush (void *dev, pk_iod_off offset)
+{
+  /* Do nothing here.  */
+  return PK_OK;
+}
+
+/* Foreign IO device hook that closes a given device.  */
+
+static int
+iod_close (void *dev)
+{
+  iod_opened_p = 0;
+  return PK_OK;
+}
+
+/* Implementation of the poke foreign IO device interface, that uses
+   the hooks defined above.  */
+
+static struct pk_iod_if iod_if =
+  {
+    iod_get_if_name,
+    iod_handler_normalize,
+    iod_open,
+    iod_close,
+    iod_pread,
+    iod_pwrite,
+    iod_get_flags,
+    iod_size,
+    iod_flush
+  };
+
+/* Handler for alien tokens.  */
+
+static struct pk_alien_token alien_token;
+
+static struct pk_alien_token *
+poke_alien_token_handler (const char *id, char **errmsg)
+{
+  /* In GDB alien poke tokens with the form $addr::FOO provide the
+     address of the symbol `FOO' as an offset in bytes, i.e. it
+     resolves to the GDB value &foo as a Poke offset with unit bytes.
+
+     $FOO, on the other hand, provide the value of the symbol FOO
+     incarnated in a proper Poke value.  */
+
+  if (strncmp (id, "addr::", 6) == 0)
+    {
+      CORE_ADDR addr;
+
+      std::string expr = "&";
+      expr += id + 6;
+
+      try
+	{
+	  addr = parse_and_eval_address (expr.c_str ());
+	}
+      catch (const gdb_exception_error &except)
+	{
+	  goto error;
+	}
+
+      alien_token.kind = PK_ALIEN_TOKEN_OFFSET;
+      alien_token.value.offset.magnitude = addr;
+      alien_token.value.offset.width
+	= HOST_CHAR_BIT * sizeof (decltype (addr));
+      alien_token.value.offset.signed_p = 0;
+      alien_token.value.offset.unit
+	= (gdbarch_addressable_memory_unit_size (target_gdbarch ())
+	   * 8);
+    }
+  else if (strncmp (id, "reg::", 5) == 0)
+    {
+      const std::string regname { id + 5 };
+
+      if (!target_has_registers ())
+	{
+	  *errmsg
+	    = xstrdup (string_printf (_("cannot read register '%s': "
+					"target has no registers"),
+				      regname.c_str ()).c_str ());
+	  return nullptr;
+	}
+
+      frame_info *frame = get_selected_frame ();
+      struct gdbarch *gdbarch = get_frame_arch (frame);
+      const int regnum
+	= user_reg_map_name_to_regnum (gdbarch, regname.c_str (),
+				       regname.length ());
+
+      if (regnum == -1)
+	{
+	  *errmsg = xstrdup (string_printf (_("unknown register '%s'"),
+					    regname.c_str ()).c_str ());
+	  return nullptr;
+	}
+
+      struct value *reg_value;
+
+      try
+	{
+	  reg_value = value_of_register (regnum, frame);
+	}
+      catch (const gdb_exception_error &except)
+	{
+	  *errmsg
+	    = xstrdup (string_printf (_("failed to fetch register '%s' "
+					"for selected frame"),
+				      regname.c_str ()).c_str ());
+	  return nullptr;
+	}
+
+      struct type *type = value_type (reg_value);
+
+      alien_token.kind = PK_ALIEN_TOKEN_INTEGER;
+      alien_token.value.integer.magnitude
+	= value_as_long (reg_value);
+      alien_token.value.integer.width
+	= TYPE_LENGTH (type) * HOST_CHAR_BIT;
+      alien_token.value.integer.signed_p
+	= !type->is_unsigned ();
+    }
+  else
+    {
+      struct value *value;
+
+      try
+	{
+	  value = parse_and_eval (id);
+	}
+      catch (const gdb_exception_error &except)
+	{
+	  goto error;
+	}
+
+      struct type *type = value_type (value);
+
+      if (can_dereference (type))
+	{
+	  alien_token.kind = PK_ALIEN_TOKEN_OFFSET;
+	  alien_token.value.offset.magnitude
+	    = value_as_address (value);
+	  alien_token.value.offset.width
+	    = TYPE_LENGTH (type) * HOST_CHAR_BIT;
+	  alien_token.value.offset.signed_p = 0;
+	  alien_token.value.offset.unit
+	    = gdbarch_addressable_memory_unit_size (target_gdbarch ()) * 8;
+	}
+      else if (is_integral_type (type))
+	{
+	  alien_token.kind = PK_ALIEN_TOKEN_INTEGER;
+	  alien_token.value.integer.magnitude
+	    = value_as_long (value);
+	  alien_token.value.integer.width
+	    = TYPE_LENGTH (type) * HOST_CHAR_BIT;
+	  alien_token.value.integer.signed_p
+	    = !type->is_unsigned ();
+	}
+      else
+	goto error;
+    }
+
+  *errmsg = nullptr;
+  return &alien_token;
+
+ error:
+  std::string emsg = "can't access GDB variable '";
+  emsg += id;
+  emsg += "'";
+  *errmsg = xstrdup (emsg.c_str ());
+  return nullptr;
+}
+
+/* Given a string, prefix it in order to avoid collision with Poke's
+   keywords.  */
+
+static const std::vector<std::string> poke_keywords
+  {
+    "pinned", "struct", "union", "else", "while", "until",
+    "for", "in", "where", "if", "sizeof", "fun", "method",
+    "type", "var", "unit", "break", "continue", "return",
+    "string", "as", "try", "catch", "raise", "void", "any",
+    "print", "printf", "isa", "unmap", "big", "little",
+    "load", "lambda", "assert",
+  };
+
+static std::string
+normalize_poke_identifier (std::string prefix, std::string str)
+{
+  if (std::find (poke_keywords.begin (),
+		 poke_keywords.end (),
+		 str) != poke_keywords.end ())
+    str = prefix + str;
+
+  return str;
+}
+
+/* Given a GDB type name, mangle it to a valid Poke type name.  */
+
+static std::string
+gdb_type_name_to_poke (std::string str, struct type *type = nullptr)
+{
+  for (int i = 0; i < str.length (); ++i)
+    if (!(str.begin()[i] == '_'
+	  || (str.begin()[i] >= 'a' && str.begin()[i] <= 'z')
+	  || (str.begin()[i] >= '0' && str.begin()[i] <= '9')
+	  || (str.begin()[i] >= 'A' && str.begin()[i] <= 'Z')))
+      str.begin()[i] = '_';
+
+  if (type)
+    {
+      /* Prepend struct and union tags with suitable prefixes.  This
+	 is to avoid ending with recursive typedefs in C programs.  */
+      if (type->code () == TYPE_CODE_STRUCT)
+	str = "struct_" + str;
+      else if (type->code () == TYPE_CODE_UNION)
+	str = "union_" + str;
+    }
+
+  return str;
+}
+
+/* Command to feed the poke compiler with the definition of some given
+   GDB type.  */
+
+static void poke_command (const char *args, int from_tty);
+
+static std::string
+poke_add_type (struct type *type)
+{
+  std::string type_name;
+  std::string str = "";
+
+  if (type != nullptr)
+    {
+      if (type->name () != nullptr)
+	type_name = type->name ();
+
+      /* Do not try to add a type that is already defined.  */
+      if (type_name != ""
+	  && pk_decl_p (poke_compiler,
+			gdb_type_name_to_poke (type_name, type).c_str (),
+			PK_DECL_KIND_TYPE))
+	return type_name;
+
+      switch (type->code ())
+	{
+	case TYPE_CODE_PTR:
+	  {
+	    str = ("offset<uint<"
+		   + (std::to_string (TYPE_LENGTH (type) * HOST_CHAR_BIT))
+		   + ">,B>");
+	    break;
+	  }
+	case TYPE_CODE_TYPEDEF:
+	  {
+	    struct type *target_type = check_typedef (type);
+	    std::string target_type_code = poke_add_type (target_type);
+
+	    if (target_type_code == "")
+	      goto skip;
+
+	    if (target_type->name () != nullptr)
+	      str += gdb_type_name_to_poke (target_type->name (), target_type);
+	    else
+	      str += target_type_code;
+	    break;
+	  }
+	case TYPE_CODE_INT:
+	  {
+	    size_t type_length = TYPE_LENGTH (type) * HOST_CHAR_BIT;
+
+	    if (type_length > 64)
+	      goto skip;
+
+	    if (type->is_unsigned ())
+	      str += "u";
+	    str += "int<";
+	    str += std::to_string (type_length);
+	    str += ">";
+	    break;
+	  }
+	case TYPE_CODE_ARRAY:
+	  {
+	    struct type *target_type = TYPE_TARGET_TYPE (type);
+	    size_t target_type_length = TYPE_LENGTH (target_type);
+	    std::string target_type_code
+	      = poke_add_type (target_type);
+
+	    if (target_type_code == "")
+	      goto skip;
+
+	    if (target_type->name ())
+	      str = gdb_type_name_to_poke (target_type->name (), target_type);
+	    else
+	      str = target_type_code;
+
+	    str += "[";
+	    str += std::to_string (TYPE_LENGTH (type) / target_type_length);
+	    str += "]";
+	    break;
+	  }
+	case TYPE_CODE_STRUCT:
+	  {
+	    size_t natural_bitpos = 0;
+	    str += "struct {";
+
+	    for (int idx = 0; idx < type->num_fields (); idx++)
+	      {
+		std::string field_name
+		  = normalize_poke_identifier ("__f",
+					       type->field (idx).name ());
+		struct type *field_type
+		  = check_typedef (type->field (idx).type ());
+		size_t field_bitpos = type->field (idx).loc_bitpos ();
+
+		if (idx > 0)
+		  str += " ";
+		if (field_type->name () != nullptr)
+		  {
+		    if (poke_add_type (field_type) == "")
+		      goto skip;
+		    str += gdb_type_name_to_poke (field_type->name (),
+						  field_type);
+		  }
+		else
+		  {
+		    std::string pstr = poke_add_type (field_type);
+		    if (pstr == "")
+		      goto skip;
+		    str += pstr;
+		  }
+		str += " ";
+		if (field_name != "")
+		  str += field_name;
+		if (field_bitpos != natural_bitpos)
+		  {
+		    const size_t target_byte_size
+		      = (gdbarch_addressable_memory_unit_size (target_gdbarch ())
+			 * 8);
+		    str += " @ " + (field_bitpos % target_byte_size == 0
+				    ? std::to_string (field_bitpos
+						      / target_byte_size) + "#B"
+				    : std::to_string (field_bitpos) + "#b");
+		  }
+		str += ";";
+
+		natural_bitpos
+		  = field_bitpos + TYPE_LENGTH (field_type) * HOST_CHAR_BIT;
+	      }
+
+	    str += "}";
+	    break;
+	  }
+	default:
+	  goto skip;
+	  break;
+	}
+
+      if (type_name != "")
+	{
+	  std::string poke_type_name
+	    = gdb_type_name_to_poke (type_name, type);
+
+	  std::string deftype = "type ";
+	  deftype += poke_type_name;
+	  deftype += " = ";
+	  deftype += str;
+
+	  type_poke_strings.push_back (deftype);
+	  poke_command (deftype.c_str(), 0 /* from_tty */);
+	  gdb_printf ("added type %s\n", poke_type_name.c_str ());
+	}
+    }
+
+  return str;
+
+ skip:
+  return "";
+}
+
+/* Definition of a handler for unhandled Poke exceptions.  */
+
+static const char *poke_exception_handler="\
+fun gdb_exception_handler = (Exception exception) void:\
+{\
+  if (exception.code != EC_exit && exception.code != EC_signal)\
+  {\
+    print (\"unhandled \"\
+           + (exception.name == \"\" ? \"unknown\" : exception.name)\
+           + \" exception\n\");\
+\
+    if (exception.location != \"\" || exception.msg != \"\")\
+    {\
+      if (exception.location != \"\")\
+        print (exception.location + \" \");\
+      print (exception.msg + \"\n\");\
+    }\
+  }\
+}";
+
+/* Call the default poke exception handler.  */
+
+static void
+poke_handle_exception (pk_val exception)
+{
+  pk_val handler = pk_decl_val (poke_compiler, "gdb_exception_handler");
+
+  if (handler == PK_NULL)
+    error (_("Couldn't get a handler for poke gdb_exception_handler"));
+  if (pk_call (poke_compiler, handler, nullptr, nullptr, 1, exception)
+      == PK_ERROR)
+    error (_("Couldn't call gdb_exception_handler in poke"));
+}
+
+/* Start the poke incremental compiler.  */
+
+static void
+start_poke (void)
+{
+  pk_val exit_exception;
+
+  /* Note how we are creating an incremental compiler without the
+     standard Poke types (int, etc) because they collide with the C
+     types.  */
+  poke_compiler = pk_compiler_new_with_flags (&poke_term_if,
+					      PK_F_NOSTDTYPES);
+  if (poke_compiler == nullptr)
+    error (_("Couldn't start the poke incremental compiler."));
+  poke_compiler_lives = true;
+
+  /* Install the handler for alien tokens that recognizes GDB
+     symbols.  */
+  pk_set_alien_token_fn (poke_compiler, poke_alien_token_handler);
+
+  /* Use hexadecimal output by default.  */
+  pk_set_obase (poke_compiler, 16);
+
+  /* Use `tree' printing mode by default.  */
+  pk_set_omode (poke_compiler, PK_PRINT_TREE);
+
+  /* Define a handler that we will use for processing unhandled Poke
+     exceptions.  */
+  if (pk_compile_buffer (poke_compiler, poke_exception_handler,
+			 nullptr, &exit_exception) != PK_OK
+      || exit_exception != PK_NULL)
+    error (_("Could not define the Poke default exception handler"));
+
+  /* Install our foreign IO device interface to access the target's
+     memory, and open it.  */
+  if (pk_register_iod (poke_compiler, &iod_if) != PK_OK)
+    error (_("Could not register the foreign IO device interface in poke."));
+
+  if (pk_compile_buffer (poke_compiler, "open (\"<gdb>\");", nullptr,
+			 &exit_exception) != PK_OK
+      || exit_exception != PK_NULL)
+    {
+      if (exit_exception != PK_NULL)
+	poke_handle_exception (exit_exception);
+      error (_("Could not open <gdb>"));
+    }
+
+  /* Provide access to pickles installed by poke applications.  */
+  pk_val pk_load_path = pk_decl_val (poke_compiler, "load_path");
+  std::string load_path = pk_string_str (pk_load_path);
+  load_path += ":%DATADIR%/pickles";
+  pk_decl_set_val (poke_compiler, "load_path",
+		   pk_make_string (load_path.c_str ()));
+}
+
+/* Function to finalize the poke subsystem.  This is registered with
+   make_final_cleanup in _initialize_poke.  */
+
+static void
+poke_finalize (void *arg)
+{
+  if (poke_compiler_lives)
+    {
+      pk_val val, exit_exception;
+      if (pk_compile_statement (poke_compiler,
+				"try close (get_ios); catch if E_no_ios {}",
+				nullptr, &val, &exit_exception) != PK_OK
+	  || exit_exception != PK_NULL)
+	error (_("Error while closing an IOS on exit."));
+
+      pk_compiler_free (poke_compiler);
+      poke_compiler_lives = false;
+    }
+}
+
+/* Command to dump the Poke definition of known types.  */
+
+static void
+poke_dump_types (const char *args, int from_tty)
+{
+  if (!poke_compiler_lives)
+    start_poke ();
+
+  for (const std::string &s : type_poke_strings)
+    printf ("%s;\n", s.c_str ());
+}
+
+/* Commands to add GDB types to the running poke compiler.  */
+
+static void
+poke_add_type_command (const char *args, int from_tty)
+{
+  if (!poke_compiler_lives)
+    start_poke ();
+
+  std::string type_name = skip_spaces (args);
+  type_name = gdb_type_name_to_poke (type_name);
+
+  expression_up expr = parse_expression (args);
+  struct value *val = evaluate_type (expr.get ());
+  struct type *type = value_type (val);
+
+  poke_add_type (type);
+}
+
+static void
+poke_add_types (const char *args, int from_tty)
+{
+  if (!poke_compiler_lives)
+    start_poke ();
+
+  std::string symbol_name_regexp = skip_spaces (args);
+  global_symbol_searcher spec (TYPES_DOMAIN, symbol_name_regexp.c_str ());
+  std::vector<symbol_search> symbols = spec.search ();
+  for (const symbol_search &p : symbols)
+    {
+      QUIT;
+
+      struct symbol *sym = p.symbol;
+      struct type *type = sym->type ();
+
+      if (type)
+	poke_add_type (type);
+    }
+}
+
+/* Command to execute a poke statement or declaration.  */
+
+static void
+poke_command (const char *args, int from_tty)
+{
+  if (!poke_compiler_lives)
+    start_poke ();
+
+  int what; /* 0 -> declaration, 1 -> statement */
+  const char *end;
+  std::string cmd;
+  pk_val exit_exception = PK_NULL;
+
+#define IS_COMMAND(input, cmd) \
+  (strncmp ((input), (cmd), sizeof (cmd) - 1) == 0 \
+   && ((input)[sizeof (cmd) - 1] == ' ' || (input)[sizeof (cmd) - 1] == '\t'))
+
+  args = skip_spaces (args);
+  if (args == nullptr)
+    return;
+
+  if (IS_COMMAND (args, "fun"))
+    {
+      what = 0;
+      cmd = args;
+    }
+  else
+    {
+      if (IS_COMMAND (args, "var")
+	  || IS_COMMAND (args, "type")
+	  || IS_COMMAND (args, "unit"))
+	what = 0;
+      else
+	what = 1;
+
+      cmd = args;
+      cmd += ';';
+    }
+
+  pk_set_lexical_cuckolding_p (poke_compiler, 1);
+
+  if (what == 0)
+    {
+      /* Declaration.  */
+      if (pk_compile_buffer (poke_compiler, cmd.c_str (),
+			     &end, &exit_exception) != PK_OK
+	  || exit_exception != PK_NULL)
+	goto error;
+    }
+  else
+    {
+      /* Statement.  */
+      pk_val val;
+
+      if (pk_compile_statement (poke_compiler, cmd.c_str (), &end,
+				&val, &exit_exception) != PK_OK
+	  || exit_exception != PK_NULL)
+	goto error;
+
+      if (val != PK_NULL)
+	{
+	  pk_print_val (poke_compiler, val, &exit_exception);
+	  poke_puts ("\n");
+	}
+    }
+
+  pk_set_lexical_cuckolding_p (poke_compiler, 0);
+#undef IS_COMMAND
+ error:
+  if (exit_exception != PK_NULL)
+    poke_handle_exception (exit_exception);
+}
+
+static struct value *
+poke_internal_fn (struct gdbarch *gdbarch,
+		  const struct language_defn *language,
+		  void *cookie, int argc, struct value **argv)
+{
+  if (argc != 1)
+    error ("_poke_poc requires only one argument");
+
+  struct type *type = value_type (argv[0]);
+  if (type->code () != TYPE_CODE_ARRAY
+      || TYPE_TARGET_TYPE (type) != builtin_type (gdbarch)->builtin_char)
+    error ("_poke_poc's first argument must have type 'const char *'");
+
+  gdb::array_view<const gdb_byte> content = value_contents (argv[0]);
+  const char *poke_expr = reinterpret_cast<const char *> (content.begin ());
+  const char *poke_end = reinterpret_cast<const char *> (content.end () - 1);
+  gdb_assert (*poke_end) == '\0');
+  pk_val val;
+  pk_val exit_exception = PK_NULL;
+  if (pk_compile_statement (poke_compiler, poke_cmd, &poke_end,
+			    &val, &exit_exception) != PK_OK
+      || exit_exception != PK_NULL)
+    {
+      poke_handle_exception (exit_exception);
+      error ("Error compiling poke call");
+    }
+
+  /* Do the best we can to convert a poke value to a GDB value.  */
+  switch (pk_val_kind (val))
+    {
+    case PK_VAL_INT:
+    case PK_VAL_UINT:
+    default:
+      error ("Poke");
+    }
+
+  return value_from_longest (builtin_type (gdbarch)->builtin_int, 0);
+}
+
+/* Initialize the poke GDB subsystem.  */
+
+void _initialize_poke (void);
+void
+_initialize_poke ()
+{
+  add_com ("poke-add-type", class_vars, poke_add_type_command, _("\
+Make Poke aware of a GDB type given an expression.\n\
+Usage: poke-add-type EXPRESSION\n"));
+
+  add_com ("poke-add-types", class_vars, poke_add_types, _("\
+Make Poke aware of GDB types based on a regexp.\n\
+Usage: poke-add-type REGEXP\n"));
+
+  add_com ("poke-dump-types", class_vars, poke_dump_types, _("\
+Dump the definition of all the GDB types known to poke.\n\
+Usage: poke-dump-types\n"));
+
+  add_com ("poke", class_vars, poke_command, _("\
+Execute a Poke statement or declaration.\n\
+Usage: poke [STMT]\n"));
+
+  add_internal_function ("_poke", _("\
+Run the expression in poke", poke_internal_fn, nullptr);
+
+  make_final_cleanup (poke_finalize, nullptr);
+}