ld: Write types into TPI stream of PDB

6 files changed, 738 insertions, 0 deletions

diff --git a/ld/testsuite/ld-pe/pdb-types1-hashlist.d b/ld/testsuite/ld-pe/pdb-types1-hashlist.d
new file mode 100644
index 00000000000..b75f08c1de7
--- /dev/null
+++ b/ld/testsuite/ld-pe/pdb-types1-hashlist.d
@@ -0,0 +1,13 @@
+
+*:     file format binary
+
+Contents of section .data:
+ 0000 5b4f0200 e29b0300 a99a0300 90160300  *
+ 0010 32970300 d6540100 fad50000 c3b00000  *
+ 0020 6a270200 7b000100 31de0000 2bf50200  *
+ 0030 b59b0300 73cf0300 10b90000 84240300  *
+ 0040 64150100 2e8a0000 88fe0000 c0660000  *
+ 0050 ffd80200 b0260100 7c060200 e3240200  *
+ 0060 63ff0100 fb6b0300 0ad90100 523c0200  *
+ 0070 4d5e0200 8a940200 4b710300 6aa90300  *
+ 0080 0a2c0300 67e10300 4a3d0300           *
\ No newline at end of file
diff --git a/ld/testsuite/ld-pe/pdb-types1-skiplist.d b/ld/testsuite/ld-pe/pdb-types1-skiplist.d
new file mode 100644
index 00000000000..52c10fa501d
--- /dev/null
+++ b/ld/testsuite/ld-pe/pdb-types1-skiplist.d
@@ -0,0 +1,5 @@
+
+*:     file format binary
+
+Contents of section .data:
+ 0000 00100000 00000000                    *
\ No newline at end of file
diff --git a/ld/testsuite/ld-pe/pdb-types1-typelist.d b/ld/testsuite/ld-pe/pdb-types1-typelist.d
new file mode 100644
index 00000000000..ff2d91c311e
--- /dev/null
+++ b/ld/testsuite/ld-pe/pdb-types1-typelist.d
@@ -0,0 +1,60 @@
+
+*:     file format binary
+
+Contents of section .data:
+ 0000 0a000110 12000000 02000000 0a000110  ................
+ 0010 12000000 01000000 0a000110 22000000  ............"...
+ 0020 02000000 0a000110 74000000 03000000  ........t.......
+ 0030 0a000210 01100000 0c000100 0a000210  ................
+ 0040 02100000 0a800000 12000112 03000000  ................
+ 0050 01100000 02100000 03100000 0e000810  ................
+ 0060 02100000 00000300 06100000 0e000315  ................
+ 0070 04100000 74000000 180000f1 0a000512  ....t...........
+ 0080 75000000 0100f2f1 0a000512 75000000  u...........u...
+ 0090 1f01f2f1 22000312 0d150300 09100000  ...."...........
+ 00a0 00006e75 6d3100f1 0d150300 0a100000  ..num1..........
+ 00b0 00006e75 6d3200f1 22000515 02000000  ..num2..".......
+ 00c0 0b100000 00000000 00000000 04003c75  ..............<u
+ 00d0 6e6e616d 65642d74 61673e00 1e000515  nnamed-tag>.....
+ 00e0 00008002 00000000 00000000 00000000  ................
+ 00f0 0000666f 6f006261 7200f2f1 0a000210  ..foo.bar.......
+ 0100 0d100000 0c000100 06000112 00000000  ................
+ 0110 1a000910 02100000 0d100000 0e100000  ................
+ 0120 00000000 0f100000 00000000 1a000910  ................
+ 0130 02100000 0d100000 0e100000 00000300  ................
+ 0140 06100000 00000000 12000612 00000000  ................
+ 0150 10100000 00000000 11100000 32000312  ............2...
+ 0160 0d150300 75000000 00006e75 6d00f2f1  ....u.....num...
+ 0170 11150000 10100000 6d657468 6f6400f1  ........method..
+ 0180 0f150200 12100000 6d657468 6f643200  ........method2.
+ 0190 1e000515 02000002 13100000 00000000  ................
+ 01a0 00000000 0400666f 6f006261 7200f2f1  ......foo.bar...
+ 01b0 22000312 0d150300 75000000 00006e75  ".......u.....nu
+ 01c0 6d3100f1 0d150300 10000000 00006e75  m1............nu
+ 01d0 6d3200f1 1a000615 02000000 15100000  m2..............
+ 01e0 04003c75 6e6e616d 65642d74 61673e00  ..<unnamed-tag>.
+ 01f0 16000615 00008002 00000000 00006261  ..............ba
+ 0200 7a007175 7800f2f1 16000615 02000002  z.qux...........
+ 0210 15100000 04006261 7a007175 7800f2f1  ......baz.qux...
+ 0220 52000312 02150300 00007265 6400f2f1  R.........red...
+ 0230 02150300 01006772 65656e00 02150300  ......green.....
+ 0240 0380ffff ffff626c 756500f1 02150300  ......blue......
+ 0250 02800080 79656c6c 6f7700f1 02150300  ....yellow......
+ 0260 0a800000 00000100 00007075 72706c65  ..........purple
+ 0270 00f3f2f1 1e000715 00008002 23000000  ............#...
+ 0280 00000000 636f6c6f 75720063 6f6c6f75  ....colour.colou
+ 0290 723200f1 1e000715 05000002 23000000  r2..........#...
+ 02a0 19100000 636f6c6f 75720063 6f6c6f75  ....colour.colou
+ 02b0 723200f1 0a000312 04140000 19100000  r2..............
+ 02c0 06000a00 010000f1 0a000210 1d100000  ................
+ 02d0 0c000100 0a000312 02150300 00006100  ..............a.
+ 02e0 22000715 01000800 75000000 1f100000  ".......u.......
+ 02f0 71757578 3a3a6e65 73746564 5f656e75  quux::nested_enu
+ 0300 6d00f2f1 52000312 00140000 14100000  m...R...........
+ 0310 0400f2f1 09140000 1e100000 01140000  ................
+ 0320 14100000 1e100000 00000000 0e150000  ................
+ 0330 02100000 73746174 69635f6d 656d6265  ....static_membe
+ 0340 7200f2f1 10150000 20100000 6e657374  r....... ...nest
+ 0350 65645f65 6e756d00 1a000515 01000000  ed_enum.........
+ 0360 21100000 00000000 00000000 04007175  !.............qu
+ 0370 757800f1                             ux..            
\ No newline at end of file
diff --git a/ld/testsuite/ld-pe/pdb-types1a.s b/ld/testsuite/ld-pe/pdb-types1a.s
new file mode 100644
index 00000000000..a2ee9a9972f
--- /dev/null
+++ b/ld/testsuite/ld-pe/pdb-types1a.s
@@ -0,0 +1,27 @@
+.equ CV_SIGNATURE_C13, 4
+
+.equ T_LONG, 0x0012
+
+.equ LF_MODIFIER, 0x1001
+
+.section ".debug$T", "rn"
+
+.long CV_SIGNATURE_C13
+
+# Type 1000, volatile long
+.mod1:
+.short .mod2 - .mod1 - 2
+.short LF_MODIFIER
+.long T_LONG
+.short 2 # volatile
+.p2align 2
+
+# Type 1001, const long
+.mod2:
+.short .types_end - .mod2 - 2
+.short LF_MODIFIER
+.long T_LONG
+.short 1 # const
+.p2align 2
+
+.types_end:
diff --git a/ld/testsuite/ld-pe/pdb-types1b.s b/ld/testsuite/ld-pe/pdb-types1b.s
new file mode 100644
index 00000000000..89ee6e3840f
--- /dev/null
+++ b/ld/testsuite/ld-pe/pdb-types1b.s
@@ -0,0 +1,461 @@
+.equ CV_SIGNATURE_C13, 4
+
+.equ T_CHAR, 0x0010
+.equ T_LONG, 0x0012
+.equ T_ULONG, 0x0022
+.equ T_INT4, 0x0074
+.equ T_UINT4, 0x0075
+.equ T_UQUAD, 0x0023
+
+.equ LF_VTSHAPE, 0x000a
+.equ LF_MODIFIER, 0x1001
+.equ LF_POINTER, 0x1002
+.equ LF_PROCEDURE, 0x1008
+.equ LF_MFUNCTION, 0x1009
+.equ LF_ARGLIST, 0x1201
+.equ LF_FIELDLIST, 0x1203
+.equ LF_BITFIELD, 0x1205
+.equ LF_METHODLIST, 0x1206
+.equ LF_BCLASS, 0x1400
+.equ LF_VBCLASS, 0x1401
+.equ LF_INDEX, 0x1404
+.equ LF_VFUNCTAB, 0x1409
+.equ LF_ENUMERATE, 0x1502
+.equ LF_ARRAY, 0x1503
+.equ LF_STRUCTURE, 0x1505
+.equ LF_UNION, 0x1506
+.equ LF_ENUM, 0x1507
+.equ LF_MEMBER, 0x150d
+.equ LF_STMEMBER, 0x150e
+.equ LF_METHOD, 0x150f
+.equ LF_NESTTYPE, 0x1510
+.equ LF_ONEMETHOD, 0x1511
+
+.equ LF_USHORT, 0x8002
+.equ LF_LONG, 0x8003
+.equ LF_UQUADWORD, 0x800a
+
+.equ CV_PTR_NEAR32, 0xa
+.equ CV_PTR_64, 0xc
+
+.section ".debug$T", "rn"
+
+.long CV_SIGNATURE_C13
+
+# Type 1000, const long
+.mod1:
+.short .mod2 - .mod1 - 2
+.short LF_MODIFIER
+.long T_LONG
+.short 1 # const
+.p2align 2
+
+# Type 1001, volatile unsigned long
+.mod2:
+.short .mod3 - .mod2 - 2
+.short LF_MODIFIER
+.long T_ULONG
+.short 2 # volatile
+.p2align 2
+
+# Type 1002, const volatile int
+.mod3:
+.short .ptr1 - .mod3 - 2
+.short LF_MODIFIER
+.long T_INT4
+.short 3 # const volatile
+.p2align 2
+
+# Type 1003, const long * (64-bit pointer)
+.ptr1:
+.short .ptr2 - .ptr1 - 2
+.short LF_POINTER
+.long 0x1000
+.long (8 << 13) | CV_PTR_64
+
+# Type 1004, volatile unsigned long * (32-bit pointer)
+.ptr2:
+.short .arglist1 - .ptr2 - 2
+.short LF_POINTER
+.long 0x1001
+.long (4 << 13) | CV_PTR_NEAR32
+
+# Type 1005, arg list of types 1000, 1001, 1002
+.arglist1:
+.short .proc1 - .arglist1 - 2
+.short LF_ARGLIST
+.long 3 # no. entries
+.long 0x1000
+.long 0x1001
+.long 0x1002
+
+# Type 1006, procedure, return type 1001, arg list 1005
+.proc1:
+.short .arr1 - .proc1 - 2
+.short LF_PROCEDURE
+.long 0x1001
+.byte 0 # calling convention
+.byte 0 # attributes
+.short 3 # no. parameters
+.long 0x1005
+
+# Type 1007, array[3] of const long *
+.arr1:
+.short .bitfield1 - .arr1 - 2
+.short LF_ARRAY
+.long 0x1003 # element type
+.long T_INT4 # index type
+.short 24 # length in bytes
+.byte 0 # name
+.byte 0xf1 # padding
+
+# Type 1008, bitfield of uint32_t, position 0, length 1
+.bitfield1:
+.short .bitfield2 - .bitfield1 - 2
+.short LF_BITFIELD
+.long T_UINT4
+.byte 1
+.byte 0
+.byte 0xf2 # padding
+.byte 0xf1 # padding
+
+# Type 1009, bitfield of uint32_t, position 1, length 31
+.bitfield2:
+.short .fieldlist1 - .bitfield2 - 2
+.short LF_BITFIELD
+.long T_UINT4
+.byte 31
+.byte 1
+.byte 0xf2 # padding
+.byte 0xf1 # padding
+
+# Type 100a, field list (1008 as num1, 1009 as num2)
+.fieldlist1:
+.short .struct1 - .fieldlist1 - 2
+.short LF_FIELDLIST
+.short LF_MEMBER
+.short 3 # public
+.long 0x1008
+.short 0 # offset
+.asciz "num1"
+.byte 0xf1 # padding
+.short LF_MEMBER
+.short 3 # public
+.long 0x1009
+.short 0 # offset
+.asciz "num2"
+.byte 0xf1 # padding
+
+# Type 100b, anonymous struct, field list 100a
+.struct1:
+.short .struct2 - .struct1 - 2
+.short LF_STRUCTURE
+.short 2 # no. members
+.short 0 # property
+.long 0x100a # field list
+.long 0 # type derived from
+.long 0 # type of vshape table
+.short 4 # size
+.asciz "<unnamed-tag>"
+
+# Type 100c, forward declaration of struct foo
+.struct2:
+.short .ptr3 - .struct2 - 2
+.short LF_STRUCTURE
+.short 0 # no. members
+.short 0x280 # property (has unique name, forward declaration)
+.long 0 # field list
+.long 0 # type derived from
+.long 0 # type of vshape table
+.short 0 # size
+.asciz "foo" # name
+.asciz "bar" # unique name
+.byte 0xf2 # padding
+.byte 0xf1 # padding
+
+# Type 100d, pointer to 100c
+.ptr3:
+.short .arglist2 - .ptr3 - 2
+.short LF_POINTER
+.long 0x100c
+.long (8 << 13) | CV_PTR_64
+
+# Type 100e, empty arg list
+.arglist2:
+.short .mfunc1 - .arglist2 - 2
+.short LF_ARGLIST
+.long 0 # no. entries
+
+# Type 100f, member function of 100c, return type 1001
+.mfunc1:
+.short .mfunc2 - .mfunc1 - 2
+.short LF_MFUNCTION
+.long 0x1001
+.long 0x100c
+.long 0x100d # type of "this" pointer
+.byte 0 # calling convention
+.byte 0 # attributes
+.short 0 # no. parameters
+.long 0x100e # arg list
+.long 0 # "this" adjustment
+
+# Type 1010, member function of 100c, return type 1001, arg list 1005
+.mfunc2:
+.short .methodlist1 - .mfunc2 - 2
+.short LF_MFUNCTION
+.long 0x1001
+.long 0x100c
+.long 0x100d # type of "this" pointer
+.byte 0 # calling convention
+.byte 0 # attributes
+.short 3 # no. parameters
+.long 0x1005 # arg list
+.long 0 # "this" adjustment
+
+# Type 1011, method list for both member functions 100f and 1010
+.methodlist1:
+.short .fieldlist2 - .methodlist1 - 2
+.short LF_METHODLIST
+.short 0 # attributes
+.short 0 # padding
+.long 0x100f
+.short 0 # attributes
+.short 0 # padding
+.long 0x1010
+
+# Type 1012, field list (uint32_t as num1)
+.fieldlist2:
+.short .struct3 - .fieldlist2 - 2
+.short LF_FIELDLIST
+.short LF_MEMBER
+.short 3 # public
+.long T_UINT4
+.short 0 # offset
+.asciz "num"
+.byte 0xf2 # padding
+.byte 0xf1 # padding
+.short LF_ONEMETHOD
+.short 0 # method attribute
+.long 0x100f # method type
+.asciz "method"
+.byte 0xf1
+.short LF_METHOD
+.short 2 # no. overloads
+.long 0x1011 # method list
+.asciz "method2"
+
+# Type 1013, struct foo, field list 1012
+.struct3:
+.short .fieldlist3 - .struct3 - 2
+.short LF_STRUCTURE
+.short 2 # no. members
+.short 0x200 # property (has unique name)
+.long 0x1012 # field list
+.long 0 # type derived from
+.long 0 # type of vshape table
+.short 4 # size
+.asciz "foo" # name
+.asciz "bar" # unique name
+.byte 0xf2 # padding
+.byte 0xf1 # padding
+
+# Type 1014, field list (uint32_t as num1, char as num2)
+.fieldlist3:
+.short .union1 - .fieldlist3 - 2
+.short LF_FIELDLIST
+.short LF_MEMBER
+.short 3 # public
+.long T_UINT4
+.short 0 # offset
+.asciz "num1"
+.byte 0xf1 # padding
+.short LF_MEMBER
+.short 3 # public
+.long T_CHAR
+.short 0 # offset
+.asciz "num2"
+.byte 0xf1 # padding
+
+# Type 1015, anonymous union (field list 1014)
+.union1:
+.short .union2 - .union1 - 2
+.short LF_UNION
+.short 2 # no. members
+.short 0 # property
+.long 0x1014
+.short 4 # size
+.asciz "<unnamed-tag>"
+
+# Type 1016, forward declaration of union baz
+.union2:
+.short .union3 - .union2 - 2
+.short LF_UNION
+.short 0 # no. members
+.short 0x280 # property (has unique name, forward declaration)
+.long 0 # field list
+.short 0 # size
+.asciz "baz"
+.asciz "qux"
+.byte 0xf2 # padding
+.byte 0xf1 # padding
+
+# Type 1017, union baz (field list 1014)
+.union3:
+.short .fieldlist4 - .union3 - 2
+.short LF_UNION
+.short 2 # no. members
+.short 0x200 # property (has unique name, forward declaration)
+.long 0x1014 # field list
+.short 4 # size
+.asciz "baz"
+.asciz "qux"
+.byte 0xf2 # padding
+.byte 0xf1 # padding
+
+# Type 1018, field list for enum (red = 0, green = 1, blue = -1, yellow = 0x8000, purple = 0x100000000)
+.fieldlist4:
+.short .enum1 - .fieldlist4 - 2
+.short LF_FIELDLIST
+.short LF_ENUMERATE
+.short 3 # public
+.short 0 # value
+.asciz "red"
+.byte 0xf2 # padding
+.byte 0xf1 # padding
+.short LF_ENUMERATE
+.short 3 # public
+.short 1 # value
+.asciz "green"
+.short LF_ENUMERATE
+.short 3 # public
+.short LF_LONG
+.long 0xffffffff # value
+.asciz "blue"
+.byte 0xf1 # padding
+.short LF_ENUMERATE
+.short 3 # public
+.short LF_USHORT
+.short 0x8000 # value
+.asciz "yellow"
+.byte 0xf1 # padding
+.short LF_ENUMERATE
+.short 3 # public
+.short LF_UQUADWORD
+.quad 0x100000000 # value
+.asciz "purple"
+.byte 0xf3 # padding
+.byte 0xf2 # padding
+.byte 0xf1 # padding
+
+# Type 1019, forward reference to enum
+.enum1:
+.short .enum2 - .enum1 - 2
+.short LF_ENUM
+.short 0 # no. elements
+.short 0x280 # property (has unique name, forward ref)
+.long T_UQUAD # underlying type
+.long 0 # field list
+.asciz "colour"
+.asciz "colour2"
+.byte 0xf1 # padding
+
+# Type 101a, enum (field list 1018)
+.enum2:
+.short .fieldlist5 - .enum2 - 2
+.short LF_ENUM
+.short 5 # no. elements
+.short 0x200 # property (has unique name)
+.long T_UQUAD # underlying type
+.long 0x1018 # field list
+.asciz "colour"
+.asciz "colour2"
+.byte 0xf1 # padding
+
+# Type 101b, field list referencing other field list 1018
+.fieldlist5:
+.short .vtshape1 - .fieldlist5 - 2
+.short LF_FIELDLIST
+.short LF_INDEX
+.short 0 # padding
+.long 0x1018
+
+# Type 101c, virtual function table shape
+.vtshape1:
+.short .ptr4 - .vtshape1 - 2
+.short LF_VTSHAPE
+.short 1 # no. descriptors
+.byte 0 # descriptor (CV_VTS_near)
+.byte 0xf1 # padding
+
+# Type 101d, pointer to 101c
+.ptr4:
+.short .fieldlist6 - .ptr4 - 2
+.short LF_POINTER
+.long 0x101c
+.long (8 << 13) | CV_PTR_64
+
+# Type 101e, fieldlist for enum
+.fieldlist6:
+.short .enum3 - .fieldlist6 - 2
+.short LF_FIELDLIST
+.short LF_ENUMERATE
+.short 3 # public
+.short 0 # value
+.asciz "a"
+
+# Type 101f, nested enum
+.enum3:
+.short .fieldlist7 - .enum3 - 2
+.short LF_ENUM
+.short 1 # no. elements
+.short 0x8 # property (is nested)
+.long T_UINT4 # underlying type
+.long 0x101e # field list
+.asciz "quux::nested_enum"
+.byte 0xf2 # padding
+.byte 0xf1 # padding
+
+# Type 1020, field list for struct quux
+.fieldlist7:
+.short .struct4 - .fieldlist7 - 2
+.short LF_FIELDLIST
+.short LF_BCLASS
+.short 0 # attributes
+.long 0x1013 # base class
+.short 4 # offset within class
+.byte 0xf2 # padding
+.byte 0xf1 # padding
+.short LF_VFUNCTAB
+.short 0 # padding
+.long 0x101d # pointer to vtshape
+.short LF_VBCLASS
+.short 0 # attribute
+.long 0x1013 # type index of direct virtual base class
+.long 0x101d # type index of virtual base pointer
+.short 0 # virtual base pointer offset
+.short 0 # virtual base offset from vbtable
+.short LF_STMEMBER
+.short 0 # attribute
+.long 0x1001 # volatile unsigned long
+.asciz "static_member"
+.byte 0xf2 # padding
+.byte 0xf1 # padding
+.short LF_NESTTYPE
+.short 0 # padding
+.long 0x101f # enum type
+.asciz "nested_enum"
+
+# Type 1021, struct quux, field list 1020
+.struct4:
+.short .types_end - .struct4 - 2
+.short LF_STRUCTURE
+.short 1 # no. members
+.short 0 # property
+.long 0x1020 # field list
+.long 0 # type derived from
+.long 0 # type of vshape table
+.short 4 # size
+.asciz "quux" # name
+.byte 0xf1 # padding
+
+.types_end:
diff --git a/ld/testsuite/ld-pe/pdb.exp b/ld/testsuite/ld-pe/pdb.exp
index 2e5f83477aa..5661438c9e9 100644
--- a/ld/testsuite/ld-pe/pdb.exp
+++ b/ld/testsuite/ld-pe/pdb.exp
@@ -977,7 +977,179 @@ proc test4 { } {
     }
 }
 
+proc test5 { } {
+    global as
+    global ar
+    global ld
+    global objdump
+    global srcdir
+    global subdir
+
+    if ![ld_assemble $as $srcdir/$subdir/pdb-types1a.s tmpdir/pdb-types1a.o] {
+	unsupported "Build pdb-types1a.o"
+	return
+    }
+
+    if ![ld_assemble $as $srcdir/$subdir/pdb-types1b.s tmpdir/pdb-types1b.o] {
+	unsupported "Build pdb-types1b.o"
+	return
+    }
+
+    if ![ld_link $ld "tmpdir/pdb-types1.exe" "--pdb=tmpdir/pdb-types1.pdb tmpdir/pdb-types1a.o tmpdir/pdb-types1b.o"] {
+	unsupported "Create PE image with PDB file"
+	return
+    }
+
+    set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-types1.pdb 0002"]
+
+    if ![string match "" $exec_output] {
+	fail "Could not extract TPI stream"
+	return
+    } else {
+	pass "Extracted TPI stream"
+    }
+
+    # check values in TPI header, and save anything interesting
+
+    set fi [open tmpdir/0002]
+    fconfigure $fi -translation binary
+
+    seek $fi 8 current
+
+    set data [read $fi 4]
+    binary scan $data i first_type
+
+    if { $first_type != 0x1000 } {
+	fail "Incorrect first type value in TPI stream."
+    } else {
+	pass "Correct first type value in TPI stream."
+    }
+
+    set data [read $fi 4]
+    binary scan $data i end_type
+
+    # end_type is one greater than the last type in the stream
+    if { $end_type != 0x1023 } {
+	fail "Incorrect end type value in TPI stream."
+    } else {
+	pass "Correct end type value in TPI stream."
+    }
+
+    set data [read $fi 4]
+    binary scan $data i type_list_size
+
+    set data [read $fi 2]
+    binary scan $data s hash_stream_index
+
+    seek $fi 2 current
+
+    set data [read $fi 4]
+    binary scan $data i hash_size
+
+    if { $hash_size != 4 } {
+	fail "Incorrect hash size in TPI stream."
+    } else {
+	pass "Correct hash size in TPI stream."
+    }
+
+    set data [read $fi 4]
+    binary scan $data i num_buckets
+
+    if { $num_buckets != 0x3ffff } {
+	fail "Incorrect number of buckets in TPI stream."
+    } else {
+	pass "Correct number of buckets in TPI stream."
+    }
+
+    set data [read $fi 4]
+    binary scan $data i hash_list_offset
+
+    set data [read $fi 4]
+    binary scan $data i hash_list_size
+
+    set data [read $fi 4]
+    binary scan $data i skip_list_offset
+
+    set data [read $fi 4]
+    binary scan $data i skip_list_size
+
+    seek $fi 8 current
+
+    set type_list [read $fi $type_list_size]
+
+    close $fi
+
+    set fi [open tmpdir/pdb-types1-typelist w]
+    fconfigure $fi -translation binary
+    puts -nonewline $fi $type_list
+    close $fi
+
+    # check type list
+
+    set exp [file_contents "$srcdir/$subdir/pdb-types1-typelist.d"]
+    set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types1-typelist"]
+    if ![string match $exp $got] {
+	fail "Incorrect type list in TPI stream."
+    } else {
+	pass "Correct type list in TPI stream."
+    }
+
+    # extract hash list and skip list
+
+    set index_str [format "%04x" $hash_stream_index]
+
+    set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-types1.pdb $index_str"]
+
+    if ![string match "" $exec_output] {
+	fail "Could not extract TPI hash stream."
+    } else {
+	pass "Extracted TPI hash stream."
+    }
+
+    set fi [open tmpdir/$index_str]
+    fconfigure $fi -translation binary
+
+    seek $fi $hash_list_offset
+    set hash_list [read $fi $hash_list_size]
+
+    seek $fi $skip_list_offset
+    set skip_list [read $fi $skip_list_size]
+
+    close $fi
+
+    # check hash list
+
+    set fi [open tmpdir/pdb-types1-hashlist w]
+    fconfigure $fi -translation binary
+    puts -nonewline $fi $hash_list
+    close $fi
+
+    set exp [file_contents "$srcdir/$subdir/pdb-types1-hashlist.d"]
+    set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types1-hashlist"]
+    if ![string match $exp $got] {
+	fail "Incorrect hash list in TPI stream."
+    } else {
+	pass "Correct hash list in TPI stream."
+    }
+
+    # check skip list
+
+    set fi [open tmpdir/pdb-types1-skiplist w]
+    fconfigure $fi -translation binary
+    puts -nonewline $fi $skip_list
+    close $fi
+
+    set exp [file_contents "$srcdir/$subdir/pdb-types1-skiplist.d"]
+    set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types1-skiplist"]
+    if ![string match $exp $got] {
+	fail "Incorrect skip list in TPI stream."
+    } else {
+	pass "Correct skip list in TPI stream."
+    }
+}
+
 test1
 test2
 test3
 test4
+test5