Training courses

Kernel and Embedded Linux

Bootlin training courses

Embedded Linux, kernel,
Yocto Project, Buildroot, real-time,
graphics, boot time, debugging...

Bootlin logo

Elixir Cross Referencer

   1
   2
   3
   4
   5
   6
   7
   8
   9
  10
  11
  12
  13
  14
  15
  16
  17
  18
  19
  20
  21
  22
  23
  24
  25
  26
  27
  28
  29
  30
  31
  32
  33
  34
  35
  36
  37
  38
  39
  40
  41
  42
  43
  44
  45
  46
  47
  48
  49
  50
  51
  52
  53
  54
  55
  56
  57
  58
  59
  60
  61
  62
  63
  64
  65
  66
  67
  68
  69
  70
  71
  72
  73
  74
  75
  76
  77
  78
  79
  80
  81
  82
  83
  84
  85
  86
  87
  88
  89
  90
  91
  92
  93
  94
  95
  96
  97
  98
  99
 100
 101
 102
 103
 104
 105
 106
 107
 108
 109
 110
 111
 112
 113
 114
 115
 116
 117
 118
 119
 120
 121
 122
 123
 124
 125
 126
 127
 128
 129
 130
 131
 132
 133
 134
 135
 136
 137
 138
 139
 140
 141
 142
 143
 144
 145
 146
 147
 148
 149
 150
 151
 152
 153
 154
 155
 156
 157
 158
 159
 160
 161
 162
 163
 164
 165
 166
 167
 168
 169
 170
 171
 172
 173
 174
 175
 176
 177
 178
 179
 180
 181
 182
 183
 184
 185
 186
 187
 188
 189
 190
 191
 192
 193
 194
 195
 196
 197
 198
 199
 200
 201
 202
 203
 204
 205
 206
 207
 208
 209
 210
 211
 212
 213
 214
 215
 216
 217
 218
 219
 220
 221
 222
 223
 224
 225
 226
 227
 228
 229
 230
 231
 232
 233
 234
 235
 236
 237
 238
 239
 240
 241
 242
 243
 244
 245
 246
 247
 248
 249
 250
 251
 252
 253
 254
 255
 256
 257
 258
 259
 260
 261
 262
 263
 264
 265
 266
 267
 268
 269
 270
 271
 272
 273
 274
 275
 276
 277
 278
 279
 280
 281
 282
 283
 284
 285
 286
 287
 288
 289
 290
 291
 292
 293
 294
 295
 296
 297
 298
 299
 300
 301
 302
 303
 304
 305
 306
 307
 308
 309
 310
 311
 312
 313
 314
 315
 316
 317
 318
 319
 320
 321
 322
 323
 324
 325
 326
 327
 328
 329
 330
 331
 332
 333
 334
 335
 336
 337
 338
 339
 340
 341
 342
 343
 344
 345
 346
 347
 348
 349
 350
 351
 352
 353
 354
 355
 356
 357
 358
 359
 360
 361
 362
 363
 364
 365
 366
 367
 368
 369
 370
 371
 372
 373
 374
 375
 376
 377
 378
 379
 380
 381
 382
 383
 384
 385
 386
 387
 388
 389
 390
 391
 392
 393
 394
 395
 396
 397
 398
 399
 400
 401
 402
 403
 404
 405
 406
 407
 408
 409
 410
 411
 412
 413
 414
 415
 416
 417
 418
 419
 420
 421
 422
 423
 424
 425
 426
 427
 428
 429
 430
 431
 432
 433
 434
 435
 436
 437
 438
 439
 440
 441
 442
 443
 444
 445
 446
 447
 448
 449
 450
 451
 452
 453
 454
 455
 456
 457
 458
 459
 460
 461
 462
 463
 464
 465
 466
 467
 468
 469
 470
 471
 472
 473
 474
 475
 476
 477
 478
 479
 480
 481
 482
 483
 484
 485
 486
 487
 488
 489
 490
 491
 492
 493
 494
 495
 496
 497
 498
 499
 500
 501
 502
 503
 504
 505
 506
 507
 508
 509
 510
 511
 512
 513
 514
 515
 516
 517
 518
 519
 520
 521
 522
 523
 524
 525
 526
 527
 528
 529
 530
 531
 532
 533
 534
 535
 536
 537
 538
 539
 540
 541
 542
 543
 544
 545
 546
 547
 548
 549
 550
 551
 552
 553
 554
 555
 556
 557
 558
 559
 560
 561
 562
 563
 564
 565
 566
 567
 568
 569
 570
 571
 572
 573
 574
 575
 576
 577
 578
 579
 580
 581
 582
 583
 584
 585
 586
 587
 588
 589
 590
 591
 592
 593
 594
 595
 596
 597
 598
 599
 600
 601
 602
 603
 604
 605
 606
 607
 608
 609
 610
 611
 612
 613
 614
 615
 616
 617
 618
 619
 620
 621
 622
 623
 624
 625
 626
 627
 628
 629
 630
 631
 632
 633
 634
 635
 636
 637
 638
 639
 640
 641
 642
 643
 644
 645
 646
 647
 648
 649
 650
 651
 652
 653
 654
 655
 656
 657
 658
 659
 660
 661
 662
 663
 664
 665
 666
 667
 668
 669
 670
 671
 672
 673
 674
 675
 676
 677
 678
 679
 680
 681
 682
 683
 684
 685
 686
 687
 688
 689
 690
 691
 692
 693
 694
 695
 696
 697
 698
 699
 700
 701
 702
 703
 704
 705
 706
 707
 708
 709
 710
 711
 712
 713
 714
 715
 716
 717
 718
 719
 720
 721
 722
 723
 724
 725
 726
 727
 728
 729
 730
 731
 732
 733
 734
 735
 736
 737
 738
 739
 740
 741
 742
 743
 744
 745
 746
 747
 748
 749
 750
 751
 752
 753
 754
 755
 756
 757
 758
 759
 760
 761
 762
 763
 764
 765
 766
 767
 768
 769
 770
 771
 772
 773
 774
 775
 776
 777
 778
 779
 780
 781
 782
 783
 784
 785
 786
 787
 788
 789
 790
 791
 792
 793
 794
 795
 796
 797
 798
 799
 800
 801
 802
 803
 804
 805
 806
 807
 808
 809
 810
 811
 812
 813
 814
 815
 816
 817
 818
 819
 820
 821
 822
 823
 824
 825
 826
 827
 828
 829
 830
 831
 832
 833
 834
 835
 836
 837
 838
 839
 840
 841
 842
 843
 844
 845
 846
 847
 848
 849
 850
 851
 852
 853
 854
 855
 856
 857
 858
 859
 860
 861
 862
 863
 864
 865
 866
 867
 868
 869
 870
 871
 872
 873
 874
 875
 876
 877
 878
 879
 880
 881
 882
 883
 884
 885
 886
 887
 888
 889
 890
 891
 892
 893
 894
 895
 896
 897
 898
 899
 900
 901
 902
 903
 904
 905
 906
 907
 908
 909
 910
 911
 912
 913
 914
 915
 916
 917
 918
 919
 920
 921
 922
 923
 924
 925
 926
 927
 928
 929
 930
 931
 932
 933
 934
 935
 936
 937
 938
 939
 940
 941
 942
 943
 944
 945
 946
 947
 948
 949
 950
 951
 952
 953
 954
 955
 956
 957
 958
 959
 960
 961
 962
 963
 964
 965
 966
 967
 968
 969
 970
 971
 972
 973
 974
 975
 976
 977
 978
 979
 980
 981
 982
 983
 984
 985
 986
 987
 988
 989
 990
 991
 992
 993
 994
 995
 996
 997
 998
 999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
# Copyright 2010-2020 Free Software Foundation, Inc.

# 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/>.

# Return true if the target supports DWARF-2 and uses gas.
# For now pick a sampling of likely targets.
proc dwarf2_support {} {
    if {[istarget *-*-linux*]
	|| [istarget *-*-gnu*]
	|| [istarget *-*-elf*]
	|| [istarget *-*-openbsd*]
	|| [istarget arm*-*-eabi*]
	|| [istarget arm*-*-symbianelf*]
	|| [istarget powerpc-*-eabi*]} {
	return 1
    }

    return 0
}

# Build an executable from a fission-based .S file.
# This handles the extra work of splitting the .o into non-dwo and dwo
# pieces, making sure the .dwo is available if we're using cc-with-tweaks.sh
# to build a .dwp file.
# The arguments and results are the same as for build_executable.
#
# Current restrictions:
# - only supports one source file
# - cannot be run on remote hosts

proc build_executable_from_fission_assembler { testname executable sources options } {
    verbose -log "build_executable_from_fission_assembler $testname $executable $sources $options"
    if { [llength $sources] != 1 } {
	error "Only one source file supported."
    }
    if [is_remote host] {
	error "Remote hosts are not supported."
    }

    global srcdir subdir
    set source_file ${srcdir}/${subdir}/${sources}
    set root_name [file rootname [file tail $source_file]]
    set output_base [standard_output_file $root_name]
    set object_file ${output_base}.o
    set dwo_file ${output_base}.dwo
    set object_options "object $options"
    set objcopy [gdb_find_objcopy]

    set result [gdb_compile $source_file $object_file object $options]
    if { "$result" != "" } {
	return -1
    }

    set command "$objcopy --extract-dwo $object_file $dwo_file"
    verbose -log "Executing $command"
    set result [catch "exec $command" output]
    verbose -log "objcopy --extract-dwo output: $output"
    if { $result == 1 } {
	return -1
    }

    set command "$objcopy --strip-dwo $object_file"
    verbose -log "Executing $command"
    set result [catch "exec $command" output]
    verbose -log "objcopy --strip-dwo output: $output"
    if { $result == 1 } {
	return -1
    }

    set result [gdb_compile $object_file $executable executable $options]
    if { "$result" != "" } {
	return -1
    }

    return 0
}

# Return a list of expressions about function FUNC's address and length.
# The first expression is the address of function FUNC, and the second
# one is FUNC's length.  SRC is the source file having function FUNC.
# An internal label ${func}_label must be defined inside FUNC:
#
#  int main (void)
#  {
#    asm ("main_label: .globl main_label");
#    return 0;
#  }
#
# This label is needed to compute the start address of function FUNC.
# If the compiler is gcc, we can do the following to get function start
# and end address too:
#
# asm ("func_start: .globl func_start");
# static void func (void) {}
# asm ("func_end: .globl func_end");
#
# however, this isn't portable, because other compilers, such as clang,
# may not guarantee the order of global asms and function.  The code
# becomes:
#
# asm ("func_start: .globl func_start");
# asm ("func_end: .globl func_end");
# static void func (void) {}
#

proc function_range { func src {options {debug}} } {
    global decimal gdb_prompt

    set exe [standard_temp_file func_addr[pid].x]

    gdb_compile $src $exe executable $options

    gdb_exit
    gdb_start
    gdb_load "$exe"

    # Compute the label offset, and we can get the function start address
    # by "${func}_label - $func_label_offset".
    set func_label_offset ""
    set test "p ${func}_label - ${func}"
    gdb_test_multiple $test $test {
	-re ".* = ($decimal)\r\n$gdb_prompt $" {
	    set func_label_offset $expect_out(1,string)
	}
    }

    # Compute the function length.
    global hex
    set func_length ""
    set test "disassemble $func"
    gdb_test_multiple $test $test {
	-re ".*$hex <\\+($decimal)>:\[^\r\n\]+\r\nEnd of assembler dump\.\r\n$gdb_prompt $" {
	    set func_length $expect_out(1,string)
	}
    }

    # Compute the size of the last instruction.
    if { $func_length == 0 } then {
	set func_pattern "$func"
    } else {
	set func_pattern "$func\\+$func_length"
    }
    set test "x/2i $func+$func_length"
    gdb_test_multiple $test $test {
	-re ".*($hex) <$func_pattern>:\[^\r\n\]+\r\n\[ \]+($hex).*\.\r\n$gdb_prompt $" {
	    set start $expect_out(1,string)
	    set end $expect_out(2,string)

	    set func_length [expr $func_length + $end - $start]
	}
    }

    return [list "${func}_label - $func_label_offset" $func_length]
}

# Extract the start, length, and end for function called NAME and
# create suitable variables in the callers scope.
proc get_func_info { name {options {debug}} } {
    global srcdir subdir srcfile

    upvar 1 "${name}_start" func_start
    upvar 1 "${name}_len" func_len
    upvar 1 "${name}_end" func_end

    lassign [function_range ${name} \
		 [list ${srcdir}/${subdir}/$srcfile] \
		 ${options}]  \
	func_start func_len
    set func_end "$func_start + $func_len"
}

# A DWARF assembler.
#
# All the variables in this namespace are private to the
# implementation.  Also, any procedure whose name starts with "_" is
# private as well.  Do not use these.
#
# Exported functions are documented at their definition.
#
# In addition to the hand-written functions documented below, this
# module automatically generates a function for each DWARF tag.  For
# most tags, two forms are made: a full name, and one with the
# "DW_TAG_" prefix stripped.  For example, you can use either
# 'DW_TAG_compile_unit' or 'compile_unit' interchangeably.
#
# There are two exceptions to this rule: DW_TAG_variable and
# DW_TAG_namespace.  For these, the full name must always be used,
# as the short name conflicts with Tcl builtins.  (Should future
# versions of Tcl or DWARF add more conflicts, this list will grow.
# If you want to be safe you should always use the full names.)
#
# Each tag procedure is defined like:
#
# proc DW_TAG_mumble {{attrs {}} {children {}}} { ... }
#
# ATTRS is an optional list of attributes.
# It is run through 'subst' in the caller's context before processing.
#
# Each attribute in the list has one of two forms:
#   1. { NAME VALUE }
#   2. { NAME VALUE FORM }
#
# In each case, NAME is the attribute's name.
# This can either be the full name, like 'DW_AT_name', or a shortened
# name, like 'name'.  These are fully equivalent.
#
# Besides DWARF standard attributes, assembler supports 'macro' attribute
# which will be substituted by one or more standard or macro attributes.
# supported macro attributes are:
#
#  - MACRO_AT_range { FUNC }
#  It is substituted by DW_AT_low_pc and DW_AT_high_pc with the start and
#  end address of function FUNC in file $srcdir/$subdir/$srcfile.
#
#  - MACRO_AT_func { FUNC }
#  It is substituted by DW_AT_name with FUNC and MACRO_AT_range.
#
# If FORM is given, it should name a DW_FORM_ constant.
# This can either be the short form, like 'DW_FORM_addr', or a
# shortened version, like 'addr'.  If the form is given, VALUE
# is its value; see below.  In some cases, additional processing
# is done; for example, DW_FORM_strp manages the .debug_str
# section automatically.
#
# If FORM is 'SPECIAL_expr', then VALUE is treated as a location
# expression.  The effective form is then DW_FORM_block, and VALUE
# is passed to the (internal) '_location' proc to be translated.
# This proc implements a miniature DW_OP_ assembler.
#
# If FORM is not given, it is guessed:
# * If VALUE starts with the "@" character, the rest of VALUE is
#   looked up as a DWARF constant, and DW_FORM_sdata is used.  For
#   example, '@DW_LANG_c89' could be used.
# * If VALUE starts with the ":" character, then it is a label
#   reference.  The rest of VALUE is taken to be the name of a label,
#   and DW_FORM_ref4 is used.  See 'new_label' and 'define_label'.
# * If VALUE starts with the "%" character, then it is a label
#   reference too, but DW_FORM_ref_addr is used.
# * Otherwise, VALUE is taken to be a string and DW_FORM_string is
#   used.  In order to prevent bugs where a numeric value is given but
#   no form is specified, it is an error if the value looks like a number
#   (using Tcl's "string is integer") and no form is provided.
# More form-guessing functionality may be added.
#
# CHILDREN is just Tcl code that can be used to define child DIEs.  It
# is evaluated in the caller's context.
#
# Currently this code is missing nice support for CFA handling, and
# probably other things as well.

namespace eval Dwarf {
    # True if the module has been initialized.
    variable _initialized 0

    # Constants from dwarf2.h.
    variable _constants
    # DW_AT short names.
    variable _AT
    # DW_FORM short names.
    variable _FORM
    # DW_OP short names.
    variable _OP

    # The current output file.
    variable _output_file

    # Note: The _cu_ values here also apply to type units (TUs).
    # Think of a TU as a special kind of CU.

    # Current CU count.
    variable _cu_count

    # The current CU's base label.
    variable _cu_label

    # The current CU's version.
    variable _cu_version

    # The current CU's address size.
    variable _cu_addr_size
    # The current CU's offset size.
    variable _cu_offset_size

    # Label generation number.
    variable _label_num

    # The deferred output array.  The index is the section name; the
    # contents hold the data for that section.
    variable _deferred_output

    # If empty, we should write directly to the output file.
    # Otherwise, this is the name of a section to write to.
    variable _defer

    # The abbrev section.  Typically .debug_abbrev but can be .debug_abbrev.dwo
    # for Fission.
    variable _abbrev_section

    # The next available abbrev number in the current CU's abbrev
    # table.
    variable _abbrev_num

    # The string table for this assembly.  The key is the string; the
    # value is the label for that string.
    variable _strings

    # Current .debug_line unit count.
    variable _line_count

    # Whether a file_name entry was seen.
    variable _line_saw_file

    # Whether a line table program has been seen.
    variable _line_saw_program

    # A Label for line table header generation.
    variable _line_header_end_label

    # The address size for debug ranges section.
    variable _debug_ranges_64_bit

    proc _process_one_constant {name value} {
	variable _constants
	variable _AT
	variable _FORM
	variable _OP

	set _constants($name) $value

	if {![regexp "^DW_(\[A-Z\]+)_(\[A-Za-z0-9_\]+)$" $name \
		  ignore prefix name2]} {
	    error "non-matching name: $name"
	}

	if {$name2 == "lo_user" || $name2 == "hi_user"} {
	    return
	}

	# We only try to shorten some very common things.
	# FIXME: CFA?
	switch -exact -- $prefix {
	    TAG {
		# Create two procedures for the tag.  These call
		# _handle_DW_TAG with the full tag name baked in; this
		# does all the actual work.
		proc $name {{attrs {}} {children {}}} \
		    "_handle_DW_TAG $name \$attrs \$children"

		# Filter out ones that are known to clash.
		if {$name2 == "variable" || $name2 == "namespace"} {
		    set name2 "tag_$name2"
		}

		if {[info commands $name2] != {}} {
		    error "duplicate proc name: from $name"
		}

		proc $name2 {{attrs {}} {children {}}} \
		    "_handle_DW_TAG $name \$attrs \$children"
	    }

	    AT {
		set _AT($name2) $name
	    }

	    FORM {
		set _FORM($name2) $name
	    }

	    OP {
		set _OP($name2) $name
	    }

	    default {
		return
	    }
	}
    }

    proc _read_constants {} {
	global srcdir hex decimal
	variable _constants

	# DWARF name-matching regexp.
	set dwrx "DW_\[a-zA-Z0-9_\]+"
	# Whitespace regexp.
	set ws "\[ \t\]+"

	set fd [open [file join $srcdir .. .. include dwarf2.h]]
	while {![eof $fd]} {
	    set line [gets $fd]
	    if {[regexp -- "^${ws}($dwrx)${ws}=${ws}($hex|$decimal),?$" \
		     $line ignore name value ignore2]} {
		_process_one_constant $name $value
	    }
	}
	close $fd

	set fd [open [file join $srcdir .. .. include dwarf2.def]]
	while {![eof $fd]} {
	    set line [gets $fd]
	    if {[regexp -- \
		     "^DW_\[A-Z_\]+${ws}\\(($dwrx),${ws}($hex|$decimal)\\)$" \
		     $line ignore name value ignore2]} {
		_process_one_constant $name $value
	    }
	}
	close $fd

	set _constants(SPECIAL_expr) $_constants(DW_FORM_block)
    }

    proc _quote {string} {
	# FIXME
	return "\"${string}\\0\""
    }

    proc _nz_quote {string} {
	# For now, no quoting is done.
	return "\"${string}\""
    }

    proc _handle_DW_FORM {form value} {
	switch -exact -- $form {
	    DW_FORM_string  {
		_op .ascii [_quote $value]
	    }

	    DW_FORM_flag_present {
		# We don't need to emit anything.
	    }

	    DW_FORM_data4 -
	    DW_FORM_ref4 {
		_op .4byte $value
	    }

	    DW_FORM_ref_addr {
		variable _cu_offset_size
		variable _cu_version
		variable _cu_addr_size

		if {$_cu_version == 2} {
		    set size $_cu_addr_size
		} else {
		    set size $_cu_offset_size
		}

		_op .${size}byte $value
	    }

	    DW_FORM_sec_offset {
		variable _cu_offset_size
		_op .${_cu_offset_size}byte $value
	    }

	    DW_FORM_ref1 -
	    DW_FORM_flag -
	    DW_FORM_data1 {
		_op .byte $value
	    }

	    DW_FORM_sdata {
		_op .sleb128 $value
	    }

	    DW_FORM_ref_udata -
	    DW_FORM_udata {
		_op .uleb128 $value
	    }

	    DW_FORM_addr {
		variable _cu_addr_size

		_op .${_cu_addr_size}byte $value
	    }

	    DW_FORM_data2 -
	    DW_FORM_ref2 {
		_op .2byte $value
	    }

	    DW_FORM_data8 -
	    DW_FORM_ref8 -
	    DW_FORM_ref_sig8 {
		_op .8byte $value
	    }

	    DW_FORM_data16 {
		_op .8byte $value
	    }

	    DW_FORM_strp {
		variable _strings
		variable _cu_offset_size

		if {![info exists _strings($value)]} {
		    set _strings($value) [new_label strp]
		    _defer_output .debug_string {
			define_label $_strings($value)
			_op .ascii [_quote $value]
		    }
		}

		_op .${_cu_offset_size}byte $_strings($value) "strp: $value"
	    }

	    SPECIAL_expr {
		set l1 [new_label "expr_start"]
		set l2 [new_label "expr_end"]
		_op .uleb128 "$l2 - $l1" "expression"
		define_label $l1
		_location $value
		define_label $l2
	    }

	    DW_FORM_block1 {
		set len [string length $value]
		if {$len > 255} {
		    error "DW_FORM_block1 length too long"
		}
		_op .byte $len
		_op .ascii [_nz_quote $value]
	    }

	    DW_FORM_block2 -
	    DW_FORM_block4 -

	    DW_FORM_block -

	    DW_FORM_ref2 -
	    DW_FORM_indirect -
	    DW_FORM_exprloc -

	    DW_FORM_strx -
	    DW_FORM_strx1 -
	    DW_FORM_strx2 -
	    DW_FORM_strx3 -
	    DW_FORM_strx4 -

	    DW_FORM_GNU_addr_index -
	    DW_FORM_GNU_str_index -
	    DW_FORM_GNU_ref_alt -
	    DW_FORM_GNU_strp_alt -

	    default {
		error "unhandled form $form"
	    }
	}
    }

    proc _guess_form {value varname} {
	upvar $varname new_value

	switch -exact -- [string range $value 0 0] {
	    @ {
		# Constant reference.
		variable _constants

		set new_value $_constants([string range $value 1 end])
		# Just the simplest.
		return DW_FORM_sdata
	    }

	    : {
		# Label reference.
		variable _cu_label

		set new_value "[string range $value 1 end] - $_cu_label"

		return DW_FORM_ref4
	    }

	    % {
		# Label reference, an offset from .debug_info.
		set new_value "[string range $value 1 end]"

		return DW_FORM_ref_addr
	    }

	    default {
		return DW_FORM_string
	    }
	}
    }

    # Map NAME to its canonical form.
    proc _map_name {name ary} {
	variable $ary

	if {[info exists ${ary}($name)]} {
	    set name [set ${ary}($name)]
	}

	return $name
    }

    proc _handle_attribute { attr_name attr_value attr_form } {
	variable _abbrev_section
	variable _constants

	_handle_DW_FORM $attr_form $attr_value

	_defer_output $_abbrev_section {
	    _op .uleb128 $_constants($attr_name) $attr_name
	    _op .uleb128 $_constants($attr_form) $attr_form
	}
    }

    # Handle macro attribute MACRO_AT_range.

    proc _handle_macro_at_range { attr_value } {
	if {[llength $attr_value] != 1} {
	    error "usage: MACRO_AT_range { func }"
	}

	set func [lindex $attr_value 0]
	global srcdir subdir srcfile
	set src ${srcdir}/${subdir}/${srcfile}
	set result [function_range $func $src]

	_handle_attribute DW_AT_low_pc [lindex $result 0] \
	    DW_FORM_addr
	_handle_attribute DW_AT_high_pc \
	    "[lindex $result 0] + [lindex $result 1]" DW_FORM_addr
    }

    # Handle macro attribute MACRO_AT_func.

    proc _handle_macro_at_func { attr_value } {
	if {[llength $attr_value] != 1} {
	    error "usage: MACRO_AT_func { func file }"
	}
	_handle_attribute DW_AT_name [lindex $attr_value 0] DW_FORM_string
	_handle_macro_at_range $attr_value
    }

    proc _handle_DW_TAG {tag_name {attrs {}} {children {}}} {
	variable _abbrev_section
	variable _abbrev_num
	variable _constants

	set has_children [expr {[string length $children] > 0}]
	set my_abbrev [incr _abbrev_num]

	# We somewhat wastefully emit a new abbrev entry for each tag.
	# There's no reason for this other than laziness.
	_defer_output $_abbrev_section {
	    _op .uleb128 $my_abbrev "Abbrev start"
	    _op .uleb128 $_constants($tag_name) $tag_name
	    _op .byte $has_children "has_children"
	}

	_op .uleb128 $my_abbrev "Abbrev ($tag_name)"

	foreach attr $attrs {
	    set attr_name [_map_name [lindex $attr 0] _AT]

	    # When the length of ATTR is greater than 2, the last
	    # element of the list must be a form.  The second through
	    # the penultimate elements are joined together and
	    # evaluated using subst.  This allows constructs such as
	    # [gdb_target_symbol foo] to be used.

	    if {[llength $attr] > 2} {
	        set attr_value [uplevel 2 [list subst [join [lrange $attr 1 end-1]]]]
	    } else {
	        set attr_value [uplevel 2 [list subst [lindex $attr 1]]]
	    }

	    if { [string equal "MACRO_AT_func" $attr_name] } {
		_handle_macro_at_func $attr_value
	    } elseif { [string equal "MACRO_AT_range" $attr_name] } {
		_handle_macro_at_range $attr_value
	    } else {
		if {[llength $attr] > 2} {
		    set attr_form [uplevel 2 [list subst [lindex $attr end]]]

		    if { [string index $attr_value 0] == ":" } {
			# It is a label, get its value.
			_guess_form $attr_value attr_value
		    }
		} else {
		    # If the value looks like an integer, a form is required.
		    if [string is integer $attr_value] {
			error "Integer value requires a form"
		    }
		    set attr_form [_guess_form $attr_value attr_value]
		}
		set attr_form [_map_name $attr_form _FORM]

		_handle_attribute $attr_name $attr_value $attr_form
	    }
	}

	_defer_output $_abbrev_section {
	    # Terminator.
	    _op .byte 0x0 Terminator
	    _op .byte 0x0 Terminator
	}

	if {$has_children} {
	    uplevel 2 $children

	    # Terminate children.
	    _op .byte 0x0 "Terminate children"
	}
    }

    proc _emit {string} {
	variable _output_file
	variable _defer
	variable _deferred_output

	if {$_defer == ""} {
	    puts $_output_file $string
	} else {
	    append _deferred_output($_defer) ${string}\n
	}
    }

    proc _section {name {flags ""} {type ""}} {
	if {$flags == "" && $type == ""} {
	    _emit "        .section $name"
	} elseif {$type == ""} {
	    _emit "        .section $name, \"$flags\""
	} else {
	    _emit "        .section $name, \"$flags\", %$type"
	}
    }

    # SECTION_SPEC is a list of arguments to _section.
    proc _defer_output {section_spec body} {
	variable _defer
	variable _deferred_output

	set old_defer $_defer
	set _defer [lindex $section_spec 0]

	if {![info exists _deferred_output($_defer)]} {
	    set _deferred_output($_defer) ""
	    eval _section $section_spec
	}

	uplevel $body

	set _defer $old_defer
    }

    proc _defer_to_string {body} {
	variable _defer
	variable _deferred_output

	set old_defer $_defer
	set _defer temp

	set _deferred_output($_defer) ""

	uplevel $body

	set result $_deferred_output($_defer)
	unset _deferred_output($_defer)

	set _defer $old_defer
	return $result
    }

    proc _write_deferred_output {} {
	variable _output_file
	variable _deferred_output

	foreach section [array names _deferred_output] {
	    # The data already has a newline.
	    puts -nonewline $_output_file $_deferred_output($section)
	}

	# Save some memory.
	unset _deferred_output
    }

    proc _op {name value {comment ""}} {
	set text "        ${name}        ${value}"
	if {$comment != ""} {
	    # Try to make stuff line up nicely.
	    while {[string length $text] < 40} {
		append text " "
	    }
	    append text "/* ${comment} */"
	}
	_emit $text
    }

    proc _compute_label {name} {
	return ".L${name}"
    }

    # Return a name suitable for use as a label.  If BASE_NAME is
    # specified, it is incorporated into the label name; this is to
    # make debugging the generated assembler easier.  If BASE_NAME is
    # not specified a generic default is used.  This proc does not
    # define the label; see 'define_label'.  'new_label' attempts to
    # ensure that label names are unique.
    proc new_label {{base_name label}} {
	variable _label_num

	return [_compute_label ${base_name}[incr _label_num]]
    }

    # Define a label named NAME.  Ordinarily, NAME comes from a call
    # to 'new_label', but this is not required.
    proc define_label {name} {
	_emit "${name}:"
    }

    # A higher-level interface to label handling.
    #
    # ARGS is a list of label descriptors.  Each one is either a
    # single element, or a list of two elements -- a name and some
    # text.  For each descriptor, 'new_label' is invoked.  If the list
    # form is used, the second element in the list is passed as an
    # argument.  The label name is used to define a variable in the
    # enclosing scope; this can be used to refer to the label later.
    # The label name is also used to define a new proc whose name is
    # the label name plus a trailing ":".  This proc takes a body as
    # an argument and can be used to define the label at that point;
    # then the body, if any, is evaluated in the caller's context.
    #
    # For example:
    #
    # declare_labels int_label
    # something { ... $int_label }   ;# refer to the label
    # int_label: constant { ... }    ;# define the label
    proc declare_labels {args} {
	foreach arg $args {
	    set name [lindex $arg 0]
	    set text [lindex $arg 1]

	    upvar $name label_var
	    if {$text == ""} {
		set label_var [new_label]
	    } else {
		set label_var [new_label $text]
	    }

	    proc ${name}: {args} [format {
		define_label %s
		uplevel $args
	    } $label_var]
	}
    }

    # This is a miniature assembler for location expressions.  It is
    # suitable for use in the attributes to a DIE.  Its output is
    # prefixed with "=" to make it automatically use DW_FORM_block.
    # BODY is split by lines, and each line is taken to be a list.
    # (FIXME should use 'info complete' here.)
    # Each list's first element is the opcode, either short or long
    # forms are accepted.
    # FIXME argument handling
    # FIXME move docs
    proc _location {body} {
	variable _constants
	variable _cu_label
	variable _cu_version
	variable _cu_addr_size
	variable _cu_offset_size

	foreach line [split $body \n] {
	    # Ignore blank lines, and allow embedded comments.
	    if {[lindex $line 0] == "" || [regexp -- {^[ \t]*#} $line]} {
		continue
	    }
	    set opcode [_map_name [lindex $line 0] _OP]
	    _op .byte $_constants($opcode) $opcode

	    switch -exact -- $opcode {
		DW_OP_addr {
		    _op .${_cu_addr_size}byte [lindex $line 1]
		}

		DW_OP_regx {
		    _op .uleb128 [lindex $line 1]
		}

		DW_OP_pick -
		DW_OP_const1u -
		DW_OP_const1s {
		    _op .byte [lindex $line 1]
		}

		DW_OP_const2u -
		DW_OP_const2s {
		    _op .2byte [lindex $line 1]
		}

		DW_OP_const4u -
		DW_OP_const4s {
		    _op .4byte [lindex $line 1]
		}

		DW_OP_const8u -
		DW_OP_const8s {
		    _op .8byte [lindex $line 1]
		}

		DW_OP_constu {
		    _op .uleb128 [lindex $line 1]
		}
		DW_OP_consts {
		    _op .sleb128 [lindex $line 1]
		}

		DW_OP_plus_uconst {
		    _op .uleb128 [lindex $line 1]
		}

		DW_OP_piece {
		    _op .uleb128 [lindex $line 1]
		}

		DW_OP_bit_piece {
		    _op .uleb128 [lindex $line 1]
		    _op .uleb128 [lindex $line 2]
		}

		DW_OP_skip -
		DW_OP_bra {
		    _op .2byte [lindex $line 1]
		}

		DW_OP_implicit_value {
		    set l1 [new_label "value_start"]
		    set l2 [new_label "value_end"]
		    _op .uleb128 "$l2 - $l1"
		    define_label $l1
		    foreach value [lrange $line 1 end] {
			switch -regexp -- $value {
			    {^0x[[:xdigit:]]{1,2}$} {_op .byte $value}
			    {^0x[[:xdigit:]]{4}$} {_op .2byte $value}
			    {^0x[[:xdigit:]]{8}$} {_op .4byte $value}
			    {^0x[[:xdigit:]]{16}$} {_op .8byte $value}
			    default {
				error "bad value '$value' in DW_OP_implicit_value"
			    }
			}
		    }
		    define_label $l2
		}

		DW_OP_implicit_pointer -
		DW_OP_GNU_implicit_pointer {
		    if {[llength $line] != 3} {
			error "usage: $opcode LABEL OFFSET"
		    }

		    # Here label is a section offset.
		    set label [lindex $line 1]
		    if { $_cu_version == 2 } {
			_op .${_cu_addr_size}byte $label
		    } else {
			_op .${_cu_offset_size}byte $label
		    }
		    _op .sleb128 [lindex $line 2]
		}

		DW_OP_GNU_variable_value {
		    if {[llength $line] != 2} {
			error "usage: $opcode LABEL"
		    }

		    # Here label is a section offset.
		    set label [lindex $line 1]
		    if { $_cu_version == 2 } {
			_op .${_cu_addr_size}byte $label
		    } else {
			_op .${_cu_offset_size}byte $label
		    }
		}

		DW_OP_deref_size {
		    if {[llength $line] != 2} {
			error "usage: DW_OP_deref_size SIZE"
		    }

		    _op .byte [lindex $line 1]
		}

		DW_OP_bregx {
		    _op .uleb128 [lindex $line 1]
		    _op .sleb128 [lindex $line 2]
		}

		default {
		    if {[llength $line] > 1} {
			error "Unimplemented: operands in location for $opcode"
		    }
		}
	    }
	}
    }

    # Emit a DWARF CU.
    # OPTIONS is a list with an even number of elements containing
    # option-name and option-value pairs.
    # Current options are:
    # is_64 0|1    - boolean indicating if you want to emit 64-bit DWARF
    #                default = 0 (32-bit)
    # version n    - DWARF version number to emit
    #                default = 4
    # addr_size n  - the size of addresses in bytes: 4, 8, or default
    #                default = default
    # fission 0|1  - boolean indicating if generating Fission debug info
    #                default = 0
    # BODY is Tcl code that emits the DIEs which make up the body of
    # the CU.  It is evaluated in the caller's context.
    proc cu {options body} {
	variable _cu_count
	variable _abbrev_section
	variable _abbrev_num
	variable _cu_label
	variable _cu_version
	variable _cu_addr_size
	variable _cu_offset_size

	# Establish the defaults.
	set is_64 0
	set _cu_version 4
	set _cu_addr_size default
	set fission 0
	set section ".debug_info"
	set _abbrev_section ".debug_abbrev"

	foreach { name value } $options {
	    set value [uplevel 1 "subst \"$value\""]
	    switch -exact -- $name {
		is_64 { set is_64 $value }
		version { set _cu_version $value }
		addr_size { set _cu_addr_size $value }
		fission { set fission $value }
		default { error "unknown option $name" }
	    }
	}
	if {$_cu_addr_size == "default"} {
	    if {[is_64_target]} {
		set _cu_addr_size 8
	    } else {
		set _cu_addr_size 4
	    }
	}
	set _cu_offset_size [expr { $is_64 ? 8 : 4 }]
	if { $fission } {
	    set section ".debug_info.dwo"
	    set _abbrev_section ".debug_abbrev.dwo"
	}

	_section $section

	set cu_num [incr _cu_count]
	set my_abbrevs [_compute_label "abbrev${cu_num}_begin"]
	set _abbrev_num 1

	set _cu_label [_compute_label "cu${cu_num}_begin"]
	set start_label [_compute_label "cu${cu_num}_start"]
	set end_label [_compute_label "cu${cu_num}_end"]

	define_label $_cu_label
	if {$is_64} {
	    _op .4byte 0xffffffff
	    _op .8byte "$end_label - $start_label"
	} else {
	    _op .4byte "$end_label - $start_label"
	}
	define_label $start_label
	_op .2byte $_cu_version Version
	_op .${_cu_offset_size}byte $my_abbrevs Abbrevs
	_op .byte $_cu_addr_size "Pointer size"

	_defer_output $_abbrev_section {
	    define_label $my_abbrevs
	}

	uplevel $body

	_defer_output $_abbrev_section {
	    # Emit the terminator.
	    _op .byte 0x0 Terminator
	    _op .byte 0x0 Terminator
	}

	define_label $end_label
    }

    # Emit a DWARF TU.
    # OPTIONS is a list with an even number of elements containing
    # option-name and option-value pairs.
    # Current options are:
    # is_64 0|1    - boolean indicating if you want to emit 64-bit DWARF
    #                default = 0 (32-bit)
    # version n    - DWARF version number to emit
    #                default = 4
    # addr_size n  - the size of addresses in bytes: 4, 8, or default
    #                default = default
    # fission 0|1  - boolean indicating if generating Fission debug info
    #                default = 0
    # SIGNATURE is the 64-bit signature of the type.
    # TYPE_LABEL is the label of the type defined by this TU,
    # or "" if there is no type (i.e., type stubs in Fission).
    # BODY is Tcl code that emits the DIEs which make up the body of
    # the TU.  It is evaluated in the caller's context.
    proc tu {options signature type_label body} {
	variable _cu_count
	variable _abbrev_section
	variable _abbrev_num
	variable _cu_label
	variable _cu_version
	variable _cu_addr_size
	variable _cu_offset_size

	# Establish the defaults.
	set is_64 0
	set _cu_version 4
	set _cu_addr_size default
	set fission 0
	set section ".debug_types"
	set _abbrev_section ".debug_abbrev"

	foreach { name value } $options {
	    switch -exact -- $name {
		is_64 { set is_64 $value }
		version { set _cu_version $value }
		addr_size { set _cu_addr_size $value }
		fission { set fission $value }
		default { error "unknown option $name" }
	    }
	}
	if {$_cu_addr_size == "default"} {
	    if {[is_64_target]} {
		set _cu_addr_size 8
	    } else {
		set _cu_addr_size 4
	    }
	}
	set _cu_offset_size [expr { $is_64 ? 8 : 4 }]
	if { $fission } {
	    set section ".debug_types.dwo"
	    set _abbrev_section ".debug_abbrev.dwo"
	}

	_section $section

	set cu_num [incr _cu_count]
	set my_abbrevs [_compute_label "abbrev${cu_num}_begin"]
	set _abbrev_num 1

	set _cu_label [_compute_label "cu${cu_num}_begin"]
	set start_label [_compute_label "cu${cu_num}_start"]
	set end_label [_compute_label "cu${cu_num}_end"]

	define_label $_cu_label
	if {$is_64} {
	    _op .4byte 0xffffffff
	    _op .8byte "$end_label - $start_label"
	} else {
	    _op .4byte "$end_label - $start_label"
	}
	define_label $start_label
	_op .2byte $_cu_version Version
	_op .${_cu_offset_size}byte $my_abbrevs Abbrevs
	_op .byte $_cu_addr_size "Pointer size"
	_op .8byte $signature Signature
	if { $type_label != "" } {
	    uplevel declare_labels $type_label
	    upvar $type_label my_type_label
	    if {$is_64} {
		_op .8byte "$my_type_label - $_cu_label"
	    } else {
		_op .4byte "$my_type_label - $_cu_label"
	    }
	} else {
	    if {$is_64} {
		_op .8byte 0
	    } else {
		_op .4byte 0
	    }
	}

	_defer_output $_abbrev_section {
	    define_label $my_abbrevs
	}

	uplevel $body

	_defer_output $_abbrev_section {
	    # Emit the terminator.
	    _op .byte 0x0 Terminator
	    _op .byte 0x0 Terminator
	}

	define_label $end_label
    }

    # Emit a DWARF .debug_ranges unit.
    # OPTIONS is a list with an even number of elements containing
    # option-name and option-value pairs.
    # Current options are:
    # is_64 0|1    - boolean indicating if you want to emit 64-bit DWARF
    #                default = 0 (32-bit)
    #
    # BODY is Tcl code that emits the content of the .debug_ranges
    # unit, it is evaluated in the caller's context.
    proc ranges {options body} {
	variable _debug_ranges_64_bit

	foreach { name value } $options {
	    switch -exact -- $name {
		is_64 { set _debug_ranges_64_bit [subst $value] }
		default { error "unknown option $name" }
	    }
	}

	set section ".debug_ranges"
	_section $section

	proc sequence {{ranges {}}} {
	    variable _debug_ranges_64_bit

	    # Emit the sequence of addresses.
	    set base ""
	    foreach range $ranges {
		set range [uplevel 1 "subst \"$range\""]
		set type [lindex $range 0]
		switch -exact -- $type {
		    base {
			set base [lrange $range 1 end]

			if { $_debug_ranges_64_bit } then {
			    _op .8byte 0xffffffffffffffff "Base Marker"
			    _op .8byte $base "Base Address"
			} else {
			    _op .4byte 0xffffffff "Base Marker"
			    _op .4byte $base "Base Address"
			}
		    }
		    range {
			set start [lindex $range 1]
			set end [lrange $range 2 end]

			if { $_debug_ranges_64_bit } then {
			    _op .8byte $start "Start Address"
			    _op .8byte $end "End Address"
			} else {
			    _op .4byte $start "Start Address"
			    _op .4byte $end "End Address"
			}
		    }
		    default { error "unknown range type: $type " }
		}
	    }

	    # End of the sequence.
	    if { $_debug_ranges_64_bit } then {
		_op .8byte 0x0 "End of Sequence Marker (Part 1)"
		_op .8byte 0x0 "End of Sequence Marker (Part 2)"
	    } else {
		_op .4byte 0x0 "End of Sequence Marker (Part 1)"
		_op .4byte 0x0 "End of Sequence Marker (Part 2)"
	    }
	}

	uplevel $body
    }


    # Emit a DWARF .debug_line unit.
    # OPTIONS is a list with an even number of elements containing
    # option-name and option-value pairs.
    # Current options are:
    # is_64 0|1    - boolean indicating if you want to emit 64-bit DWARF
    #                default = 0 (32-bit)
    # version n    - DWARF version number to emit
    #                default = 4
    # addr_size n  - the size of addresses in bytes: 4, 8, or default
    #                default = default
    #
    # LABEL is the label of the current unit (which is probably
    # referenced by a DW_AT_stmt_list), or "" if there is no such
    # label.
    #
    # BODY is Tcl code that emits the parts which make up the body of
    # the line unit.  It is evaluated in the caller's context.  The
    # following commands are available for the BODY section:
    #
    #   include_dir "dirname" -- adds a new include directory
    #
    #   file_name "file.c" idx -- adds a new file name.  IDX is a
    #   1-based index referencing an include directory or 0 for
    #   current directory.

    proc lines {options label body} {
	variable _line_count
	variable _line_saw_file
	variable _line_saw_program
	variable _line_header_end_label

	# Establish the defaults.
	set is_64 0
	set _unit_version 4
	set _unit_addr_size default
	set _line_saw_program 0
	set _line_saw_file 0
	set _default_is_stmt 1

	foreach { name value } $options {
	    switch -exact -- $name {
		is_64 { set is_64 $value }
		version { set _unit_version $value }
		addr_size { set _unit_addr_size $value }
		default_is_stmt { set _default_is_stmt $value }
		default { error "unknown option $name" }
	    }
	}
	if {$_unit_addr_size == "default"} {
	    if {[is_64_target]} {
		set _unit_addr_size 8
	    } else {
		set _unit_addr_size 4
	    }
	}

	set unit_num [incr _line_count]

	set section ".debug_line"
	_section $section

	if { "$label" != "" } {
	    # Define the user-provided label at this point.
	    $label:
	}

	set unit_len_label [_compute_label "line${_line_count}_start"]
	set unit_end_label [_compute_label "line${_line_count}_end"]
	set header_len_label [_compute_label "line${_line_count}_header_start"]
	set _line_header_end_label [_compute_label "line${_line_count}_header_end"]

	if {$is_64} {
	    _op .4byte 0xffffffff
	    _op .8byte "$unit_end_label - $unit_len_label" "unit_length"
	} else {
	    _op .4byte "$unit_end_label - $unit_len_label" "unit_length"
	}

	define_label $unit_len_label

	_op .2byte $_unit_version version

	if {$is_64} {
	    _op .8byte "$_line_header_end_label - $header_len_label" "header_length"
	} else {
	    _op .4byte "$_line_header_end_label - $header_len_label" "header_length"
	}

	define_label $header_len_label

	_op .byte 1 "minimum_instruction_length"
	_op .byte $_default_is_stmt "default_is_stmt"
	_op .byte 1 "line_base"
	_op .byte 1 "line_range"
	_op .byte 10 "opcode_base"

	# The standard_opcode_lengths table.  The number of arguments
	# for each of the standard opcodes.  Generating 9 entries here
	# matches the use of 10 in the opcode_base above.  These 9
	# entries match the 9 standard opcodes for DWARF2, making use
	# of only 9 should be fine, even if we are generating DWARF3
	# or DWARF4.
	_op .byte 0 "standard opcode 1"
	_op .byte 1 "standard opcode 2"
	_op .byte 1 "standard opcode 3"
	_op .byte 1 "standard opcode 4"
	_op .byte 1 "standard opcode 5"
	_op .byte 0 "standard opcode 6"
	_op .byte 0 "standard opcode 7"
	_op .byte 0 "standard opcode 8"
	_op .byte 1 "standard opcode 9"

	proc include_dir {dirname} {
	    _op .ascii [_quote $dirname]
	}

	proc file_name {filename diridx} {
	    variable _line_saw_file
	    if "! $_line_saw_file" {
		# Terminate the dir list.
		_op .byte 0 "Terminator."
		set _line_saw_file 1
	    }

	    _op .ascii [_quote $filename]
	    _op .sleb128 $diridx
	    _op .sleb128 0 "mtime"
	    _op .sleb128 0 "length"
	}

	proc program {statements} {
	    variable _line_saw_program
	    variable _line_header_end_label
	    variable _line

	    set _line 1

	    if "! $_line_saw_program" {
		# Terminate the file list.
		_op .byte 0 "Terminator."
		define_label $_line_header_end_label
		set _line_saw_program 1
	    }

	    proc DW_LNE_set_address {addr} {
		_op .byte 0
		set start [new_label "set_address_start"]
		set end [new_label "set_address_end"]
		_op .uleb128 "${end} - ${start}"
		define_label ${start}
		_op .byte 2
		if {[is_64_target]} {
		    _op .8byte ${addr}
		} else {
		    _op .4byte ${addr}
		}
		define_label ${end}
	    }

	    proc DW_LNE_end_sequence {} {
		variable _line
		_op .byte 0
		_op .uleb128 1
		_op .byte 1
		set _line 1
	    }

	    proc DW_LNE_user { len opcode } {
		set DW_LNE_lo_usr 0x80
		set DW_LNE_hi_usr 0xff
		if { $DW_LNE_lo_usr <= $opcode
		     && $opcode <= $DW_LNE_hi_usr } {
		    _op .byte 0
		    _op .uleb128 $len
		    _op .byte $opcode
		    for {set i 1} {$i < $len} {incr i} {
			_op .byte 0
		    }
		} else {
		    error "unknown vendor specific extended opcode: $opcode"
		}
	    }

	    proc DW_LNS_copy {} {
		_op .byte 1
	    }

	    proc DW_LNS_negate_stmt {} {
		_op .byte 6
	    }

	    proc DW_LNS_advance_pc {offset} {
		_op .byte 2
		_op .uleb128 ${offset}
	    }

	    proc DW_LNS_advance_line {offset} {
		variable _line
		_op .byte 3
		_op .sleb128 ${offset}
		set _line [expr $_line + $offset]
	    }

	    # A pseudo line number program instruction, that can be used instead
	    # of DW_LNS_advance_line.  Rather than writing:
	    #   {DW_LNS_advance_line [expr $line1 - 1]}
	    #   {DW_LNS_advance_line [expr $line2 - $line1]}
	    #   {DW_LNS_advance_line [expr $line3 - $line2]}
	    # we can just write:
	    #   {line $line1}
	    #   {line $line2}
	    #   {line $line3}
	    proc line {line} {
		variable _line
		set offset [expr $line - $_line]
		DW_LNS_advance_line $offset
	    }

	    proc DW_LNS_set_file {num} {
		_op .byte 4
		_op .sleb128 ${num}
	    }

	    foreach statement $statements {
		uplevel 1 $statement
	    }
	}

	uplevel $body

	rename include_dir ""
	rename file_name ""

	# Terminate dir list if we saw no files.
	if "! $_line_saw_file" {
	    _op .byte 0 "Terminator."
	}

	# Terminate the file list.
	if "! $_line_saw_program" {
	    _op .byte 0 "Terminator."
	    define_label $_line_header_end_label
	}

	define_label $unit_end_label
    }

    proc _empty_array {name} {
	upvar $name the_array

	catch {unset the_array}
	set the_array(_) {}
	unset the_array(_)
    }

    # Emit a .gnu_debugaltlink section with the given file name and
    # build-id.  The buildid should be represented as a hexadecimal
    # string, like "ffeeddcc".
    proc gnu_debugaltlink {filename buildid} {
	_defer_output .gnu_debugaltlink {
	    _op .ascii [_quote $filename]
	    foreach {a b} [split $buildid {}] {
		_op .byte 0x$a$b
	    }
	}
    }

    proc _note {type name hexdata} {
	set namelen [expr [string length $name] + 1]

	# Name size.
	_op .4byte $namelen
	# Data size.
	_op .4byte [expr [string length $hexdata] / 2]
	# Type.
	_op .4byte $type
	# The name.
	_op .ascii [_quote $name]
	# Alignment.
	set align 2
	set total [expr {($namelen + (1 << $align) - 1) & -(1 << $align)}]
	for {set i $namelen} {$i < $total} {incr i} {
	    _op .byte 0
	}
	# The data.
	foreach {a b} [split $hexdata {}] {
	    _op .byte 0x$a$b
	}
    }

    # Emit a note section holding the given build-id.
    proc build_id {buildid} {
	_defer_output {.note.gnu.build-id a note} {
	    # From elf/common.h.
	    set NT_GNU_BUILD_ID 3

	    _note $NT_GNU_BUILD_ID GNU $buildid
	}
    }

    # The top-level interface to the DWARF assembler.
    # FILENAME is the name of the file where the generated assembly
    # code is written.
    # BODY is Tcl code to emit the assembly.  It is evaluated via
    # "eval" -- not uplevel as you might expect, because it is
    # important to run the body in the Dwarf namespace.
    #
    # A typical invocation is something like:
    #    Dwarf::assemble $file {
    #        cu 0 2 8 {
    #            compile_unit {
    #            ...
    #            }
    #        }
    #        cu 0 2 8 {
    #        ...
    #        }
    #    }
    proc assemble {filename body} {
	variable _initialized
	variable _output_file
	variable _deferred_output
	variable _defer
	variable _label_num
	variable _strings
	variable _cu_count
	variable _line_count
	variable _line_saw_file
	variable _line_saw_program
	variable _line_header_end_label
	variable _debug_ranges_64_bit

	if {!$_initialized} {
	    _read_constants
	    set _initialized 1
	}

	set _output_file [open $filename w]
	set _cu_count 0
	_empty_array _deferred_output
	set _defer ""
	set _label_num 0
	_empty_array _strings

	set _line_count 0
	set _line_saw_file 0
	set _line_saw_program 0
	set _debug_ranges_64_bit [is_64_target]

	# Not "uplevel" here, because we want to evaluate in this
	# namespace.  This is somewhat bad because it means we can't
	# readily refer to outer variables.
	eval $body

	_write_deferred_output

	catch {close $_output_file}
	set _output_file {}
    }
}