l4/pkg/ocaml/contrib/asmcomp/hppa/emit.mlp

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
   6 (*                                                                     *)
   7 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
   8 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 (*  under the terms of the Q Public License version 1.0.               *)
  10 (*                                                                     *)
  11 (***********************************************************************)
  12
  13 (* $Id: emit.mlp 9475 2009-12-16 10:04:38Z xleroy $ *)
  14
  15 (* Emission of HP PA-RISC assembly code *)
  16
  17 (* Must come before open Reg... *)
  18 module StringSet =
  19   Set.Make(struct
  20     type t = string
  21     let compare = compare
  22   end)
  23
  24 open Location
  25 open Misc
  26 open Cmm
  27 open Arch
  28 open Proc
  29 open Reg
  30 open Mach
  31 open Linearize
  32 open Emitaux
  33
  34 (* Tradeoff between code size and code speed *)
  35
  36 let fastcode_flag = ref true
  37
  38 (* Layout of the stack *)
  39 (* Always keep the stack 8-aligned. *)
  40
  41 let stack_offset = ref 0
  42
  43 let frame_size () =
  44   let size =
  45     !stack_offset +
  46     4 * num_stack_slots.(0) + 8 * num_stack_slots.(1) +
  47     (if !contains_calls then 4 else 0) in
  48   Misc.align size 8
  49
  50 let slot_offset loc cl =
  51   match loc with
  52     Incoming n -> -frame_size() - n
  53   | Local n ->
  54       if cl = 0
  55       then - !stack_offset - num_stack_slots.(1) * 8 - n * 4 - 4
  56       else - !stack_offset - n * 8 - 8
  57   | Outgoing n -> -n
  58
  59 (* Output a label *)
  60
  61 let emit_label lbl =
  62   emit_string "L$"; emit_int lbl
  63
  64 (* Output a symbol *)
  65
  66 let emit_symbol s =
  67   Emitaux.emit_symbol '$' s
  68
  69 (* Output a pseudo-register *)
  70
  71 let emit_reg r =
  72   match r.loc with
  73     Reg r -> emit_string (register_name r)
  74   | _ -> assert false
  75
  76 (* Output low address / high address prefixes *)
  77
  78 let low_prefix = "RR%"
  79 let high_prefix = "LR%"
  80
  81 let is_immediate n = (n < 16) && (n >= -16) (* 5 bits *)
  82
  83 let emit_int_low n = emit_string low_prefix; emit_int n
  84 let emit_int_high n = emit_string high_prefix; emit_int n
  85
  86 let emit_nativeint_low n = emit_string low_prefix; emit_nativeint n
  87 let emit_nativeint_high n = emit_string high_prefix; emit_nativeint n
  88
  89 let emit_symbol_low s =
  90   `RR%{emit_symbol s}-$global$`
  91
  92 let load_symbol_high s =
  93   `     addil   LR%{emit_symbol s}-$global$, %r27\n`
  94
  95 let load_symbol_offset_high s ofs =
  96   `     addil   LR%{emit_symbol s}-$global$+{emit_int ofs}, %r27\n`
  97
  98 (* Record imported and defined symbols *)
  99
 100 let used_symbols = ref StringSet.empty
 101 let defined_symbols = ref StringSet.empty
 102 let called_symbols = ref StringSet.empty
 103
 104 let use_symbol s =
 105   used_symbols := StringSet.add s !used_symbols
 106 let define_symbol s =
 107   defined_symbols := StringSet.add s !defined_symbols
 108 let call_symbol s =
 109   used_symbols := StringSet.add s !used_symbols;
 110   called_symbols := StringSet.add s !called_symbols
 111
 112 (* An external symbol is code if either it is branched to, or
 113    it is one of the caml_apply* caml_curry* caml_tuplify* special functions. *)
 114
 115 let code_imports = ["caml_apply"; "caml_curry"; "caml_tuplify"]
 116
 117 let match_prefix s pref =
 118   String.length s >= String.length pref
 119   && String.sub s 0 (String.length pref) = pref
 120
 121 let emit_import s =
 122   if not(StringSet.mem s !defined_symbols) then begin
 123     `   .import {emit_symbol s}`;
 124     if StringSet.mem s !called_symbols
 125     || List.exists (match_prefix s) code_imports
 126     then `, code\n`
 127     else `, data\n`
 128   end
 129
 130 let emit_imports () =
 131   StringSet.iter emit_import !used_symbols;
 132   used_symbols := StringSet.empty;
 133   defined_symbols := StringSet.empty;
 134   called_symbols := StringSet.empty
 135
 136 (* Output an integer load / store *)
 137
 138 let is_offset n = (n < 8192) && (n >= -8192) (* 14 bits *)
 139
 140 let is_offset_native n =
 141   n < Nativeint.of_int 8192 && n >= Nativeint.of_int (-8192)
 142
 143 let emit_load instr addr arg dst =
 144   match addr with
 145     Ibased(s, 0) ->
 146         use_symbol s;
 147         load_symbol_high s;
 148         `       {emit_string instr}     {emit_symbol_low s}(%r1), {emit_reg dst}\n`
 149   | Ibased(s, ofs) ->
 150         use_symbol s;
 151         load_symbol_offset_high s ofs;
 152         `       {emit_string instr}     {emit_symbol_low s}+{emit_int ofs}(%r1), {emit_reg dst}\n`
 153   | Iindexed ofs ->
 154       if is_offset ofs then
 155         `       {emit_string instr}     {emit_int ofs}({emit_reg arg.(0)}), {emit_reg dst}\n`
 156       else begin
 157         `       addil   {emit_int_high ofs}, {emit_reg arg.(0)}\n`;
 158         `       {emit_string instr}     {emit_int_low ofs}(%r1), {emit_reg dst}\n`
 159       end
 160
 161 let emit_store instr addr arg src =
 162   match addr with
 163     Ibased(s, 0) ->
 164         use_symbol s;
 165         load_symbol_high s;
 166         `       {emit_string instr}     {emit_reg src}, {emit_symbol_low s}(%r1)\n`
 167   | Ibased(s, ofs) ->
 168         use_symbol s;
 169         load_symbol_offset_high s ofs;
 170         `       {emit_string instr}     {emit_reg src}, {emit_symbol_low s}+{emit_int ofs}(%r1)\n`
 171   | Iindexed ofs ->
 172       if is_offset ofs then
 173         `       {emit_string instr}     {emit_reg src}, {emit_int ofs}({emit_reg arg.(1)})\n`
 174       else begin
 175         `       addil   {emit_int_high ofs}, {emit_reg arg.(0)}\n`;
 176         `       {emit_string instr}     {emit_reg src}, {emit_int_low ofs}(%r1)\n`
 177       end
 178
 179 (* Output a floating-point load / store *)
 180
 181 let emit_float_load addr arg dst doubleword =
 182   match addr with
 183     Ibased(s, 0) ->
 184         use_symbol s;
 185         load_symbol_high s;
 186         `       ldo     {emit_symbol_low s}(%r1), %r1\n`;
 187         `       fldws   0(%r1), {emit_reg dst}L\n`;
 188         if doubleword then
 189           `     fldws   4(%r1), {emit_reg dst}R\n`
 190   | Ibased(s, ofs) ->
 191         use_symbol s;
 192         load_symbol_offset_high s ofs;
 193         `       ldo     {emit_symbol_low s}+{emit_int ofs}(%r1), %r1\n`;
 194         `       fldws   0(%r1), {emit_reg dst}L\n`;
 195         if doubleword then
 196           `     fldws   4(%r1), {emit_reg dst}R\n`
 197   | Iindexed ofs ->
 198       if is_immediate ofs && (is_immediate (ofs+4) || not doubleword)
 199       then begin
 200         `       fldws   {emit_int ofs}({emit_reg arg.(0)}), {emit_reg dst}L\n`;
 201         if doubleword then
 202           `     fldws   {emit_int (ofs+4)}({emit_reg arg.(0)}), {emit_reg dst}R\n`
 203       end else begin
 204         if is_offset ofs then
 205           `     ldo     {emit_int ofs}({emit_reg arg.(0)}), %r1\n`
 206         else begin
 207           `     addil   {emit_int_high ofs}, {emit_reg arg.(0)}\n`;
 208           `     ldo     {emit_int_low ofs}(%r1), %r1\n`
 209         end;
 210         `       fldws   0(%r1), {emit_reg dst}L\n`;
 211         if doubleword then
 212           `     fldws   4(%r1), {emit_reg dst}R\n`
 213       end
 214
 215 let emit_float_store addr arg src doubleword =
 216   match addr with
 217     Ibased(s, 0) ->
 218         use_symbol s;
 219         load_symbol_high s;
 220         `       ldo     {emit_symbol_low s}(%r1), %r1\n`;
 221         `       fstws   {emit_reg src}L, 0(%r1)\n`;
 222         if doubleword then
 223           `     fstws   {emit_reg src}R, 4(%r1)\n`
 224   | Ibased(s, ofs) ->
 225         use_symbol s;
 226         load_symbol_offset_high s ofs;
 227         `       ldo     {emit_symbol_low s}+{emit_int ofs}(%r1), %r1\n`;
 228         `       fstws   {emit_reg src}L, 0(%r1)\n`;
 229         if doubleword then
 230           `     fstws   {emit_reg src}R, 4(%r1)\n`
 231   | Iindexed ofs ->
 232       if is_immediate ofs && (is_immediate (ofs+4) || not doubleword)
 233       then begin
 234         `       fstws   {emit_reg src}L, {emit_int ofs}({emit_reg arg.(1)})\n`;
 235         if doubleword then
 236           `     fstws   {emit_reg src}R, {emit_int(ofs+4)}({emit_reg arg.(1)})\n`
 237       end else begin
 238         if is_offset ofs then
 239           `     ldo     {emit_int ofs}({emit_reg arg.(1)}), %r1\n`
 240         else begin
 241           `     addil   {emit_int_high ofs}, {emit_reg arg.(1)}\n`;
 242           `     ldo     {emit_int_low ofs}(%r1), %r1\n`
 243         end;
 244         `       fstws   {emit_reg src}L, 0(%r1)\n`;
 245         if doubleword then
 246           `     fstws   {emit_reg src}R, 4(%r1)\n`
 247       end
 248
 249 (* Output an align directive. *)
 250
 251 let emit_align n =
 252   `     .align  {emit_int n}\n`
 253
 254 (* Record live pointers at call points *)
 255
 256 type frame_descr =
 257   { fd_lbl: int;                        (* Return address *)
 258     fd_frame_size: int;                 (* Size of stack frame *)
 259     fd_live_offset: int list }          (* Offsets/regs of live addresses *)
 260
 261 let frame_descriptors = ref([] : frame_descr list)
 262
 263 let record_frame live =
 264   let lbl = new_label() in
 265   let live_offset = ref [] in
 266   Reg.Set.iter
 267     (function
 268         {typ = Addr; loc = Reg r} ->
 269           live_offset := ((r lsl 1) + 1) :: !live_offset
 270       | {typ = Addr; loc = Stack s} as reg ->
 271           live_offset := slot_offset s (register_class reg) :: !live_offset
 272       | _ -> ())
 273     live;
 274   frame_descriptors :=
 275     { fd_lbl = lbl;
 276       fd_frame_size = frame_size();
 277       fd_live_offset = !live_offset } :: !frame_descriptors;
 278   `{emit_label lbl}:\n`
 279
 280 let emit_frame fd =
 281   `     .long   {emit_label fd.fd_lbl} + 3\n`;
 282   `     .short  {emit_int fd.fd_frame_size}\n`;
 283   `     .short  {emit_int (List.length fd.fd_live_offset)}\n`;
 284   List.iter
 285     (fun n ->
 286       ` .short  {emit_int n}\n`)
 287     fd.fd_live_offset;
 288   emit_align 4
 289
 290 (* Record floating-point constants *)
 291
 292 let float_constants = ref ([] : (int * string) list)
 293
 294 let emit_float_constants () =
 295   if Config.system = "hpux" then begin
 296     `   .space  $TEXT$\n`;
 297     `   .subspa $LIT$\n`
 298   end else
 299     `   .text\n`;
 300   emit_align 8;
 301   List.iter
 302     (fun (lbl, cst) ->
 303       `{emit_label lbl}:`;
 304       emit_float64_split_directive ".long" cst)
 305     !float_constants;
 306   float_constants := []
 307
 308 (* Describe the registers used to pass arguments to a C function *)
 309
 310 let describe_call arg =
 311   `     .CALL   RTNVAL=NO`;
 312   let pos = ref 0 in
 313   for i = 0 to Array.length arg - 1 do
 314     if !pos < 4 then begin
 315       match arg.(i).typ with
 316         Float -> `, ARGW{emit_int !pos}=FR, ARGW{emit_int(!pos + 1)}=FU`;
 317                  pos := !pos + 2
 318       | _     -> `, ARGW{emit_int !pos}=GR`;
 319                  pos := !pos + 1
 320     end
 321   done;
 322   `\n`
 323
 324 (* Output a function call *)
 325
 326 let emit_call s retreg =
 327   call_symbol s;
 328   `     bl      {emit_symbol s}, {emit_string retreg}\n`
 329
 330 (* Names of various instructions *)
 331
 332 let name_for_int_operation = function
 333     Iadd -> "add"
 334   | Isub -> "sub"
 335   | Iand -> "and"
 336   | Ior -> "or"
 337   | Ixor -> "xor"
 338   | _ -> assert false
 339
 340 let name_for_float_operation = function
 341     Iaddf -> "fadd,dbl"
 342   | Isubf -> "fsub,dbl"
 343   | Imulf -> "fmpy,dbl"
 344   | Idivf -> "fdiv,dbl"
 345   | _ -> assert false
 346
 347 let name_for_specific_operation = function
 348     Ishift1add -> "sh1add"
 349   | Ishift2add -> "sh2add"
 350   | Ishift3add -> "sh3add"
 351
 352 let name_for_int_comparison = function
 353     Isigned Ceq -> "="      | Isigned Cne -> "<>"
 354   | Isigned Cle -> "<="     | Isigned Cgt -> ">"
 355   | Isigned Clt -> "<"      | Isigned Cge -> ">="
 356   | Iunsigned Ceq -> "="    | Iunsigned Cne -> "<>"
 357   | Iunsigned Cle -> "<<="  | Iunsigned Cgt -> ">>"
 358   | Iunsigned Clt -> "<<"   | Iunsigned Cge -> ">>="
 359
 360 let name_for_float_comparison cmp neg =
 361   match cmp with
 362     Ceq -> if neg then "=" else "!="
 363   | Cne -> if neg then "!=" else "="
 364   | Cle -> if neg then "<=" else "!<="
 365   | Cgt -> if neg then ">" else "!>"
 366   | Clt -> if neg then "<" else "!<"
 367   | Cge -> if neg then ">=" else "!>="
 368
 369 let negate_int_comparison = function
 370     Isigned cmp -> Isigned(Cmm.negate_comparison cmp)
 371   | Iunsigned cmp -> Iunsigned(Cmm.negate_comparison cmp)
 372
 373 let swap_int_comparison = function
 374     Isigned cmp -> Isigned(Cmm.swap_comparison cmp)
 375   | Iunsigned cmp -> Iunsigned(Cmm.swap_comparison cmp)
 376
 377
 378 (* Output the assembly code for an instruction *)
 379
 380 (* Name of current function *)
 381 let function_name = ref ""
 382 (* Entry point for tail recursive calls *)
 383 let tailrec_entry_point = ref 0
 384 (* Label of trap for out-of-range accesses *)
 385 let range_check_trap = ref 0
 386
 387 let rec emit_instr i dslot =
 388     match i.desc with
 389       Lend -> ()
 390     | Lop(Imove | Ispill | Ireload) ->
 391         let src = i.arg.(0) and dst = i.res.(0) in
 392         begin match (src, dst) with
 393             {loc = Reg rs; typ = (Int | Addr)}, {loc = Reg rd} ->
 394               ` copy    {emit_reg src}, {emit_reg dst}\n`
 395           | {loc = Reg rs; typ = Float}, {loc = Reg rd; typ = Float} ->
 396               ` fcpy,dbl {emit_reg src}, {emit_reg dst}\n`
 397           | {loc = Reg rs; typ = (Int | Addr)}, {loc = Stack sd} ->
 398               let ofs = slot_offset sd 0 in
 399               ` stw     {emit_reg src}, {emit_int ofs}(%r30)\n`
 400           | {loc = Reg rs; typ = Float}, {loc = Stack sd} ->
 401               let ofs = slot_offset sd 1 in
 402               if is_immediate ofs then
 403               ` fstds   {emit_reg src}, {emit_int ofs}(%r30)\n`
 404               else begin
 405               ` ldo     {emit_int ofs}(%r30), %r1\n`;
 406               ` fstds   {emit_reg src}, 0(%r1)\n`
 407               end
 408           | {loc = Stack ss; typ = (Int | Addr)}, {loc = Reg rd} ->
 409               let ofs = slot_offset ss 0 in
 410               ` ldw     {emit_int ofs}(%r30), {emit_reg dst}\n`
 411           | {loc = Stack ss; typ = Float}, {loc = Reg rd} ->
 412               let ofs = slot_offset ss 1 in
 413               if is_immediate ofs then
 414               ` fldds   {emit_int ofs}(%r30), {emit_reg dst}\n`
 415               else begin
 416               ` ldo     {emit_int ofs}(%r30), %r1\n`;
 417               ` fldds   0(%r1), {emit_reg dst}\n`
 418               end
 419           | (_, _) ->
 420               assert false
 421         end
 422     | Lop(Iconst_int n) ->
 423         if is_offset_native n then
 424           `     ldi     {emit_nativeint n}, {emit_reg i.res.(0)}\n`
 425         else begin
 426           `     ldil    {emit_nativeint_high n}, {emit_reg i.res.(0)}\n`;
 427           `     ldo     {emit_nativeint_low n}({emit_reg i.res.(0)}), {emit_reg i.res.(0)}\n`
 428         end
 429     | Lop(Iconst_float s) ->
 430         let lbl = new_label() in
 431         float_constants := (lbl, s) :: !float_constants;
 432         `       ldil    {emit_string high_prefix}{emit_label lbl}, %r1\n`;
 433         `       ldo     {emit_string low_prefix}{emit_label lbl}(%r1), %r1\n`;
 434         `       fldds   0(%r1), {emit_reg i.res.(0)}\n`
 435     | Lop(Iconst_symbol s) ->
 436         use_symbol s;
 437         load_symbol_high s;
 438         `       ldo     {emit_symbol_low s}(%r1), {emit_reg i.res.(0)}\n`
 439     | Lop(Icall_ind) ->
 440         `       ble     0(4, {emit_reg i.arg.(0)})\n`; (* retaddr in %r31 *)
 441         `       copy    %r31, %r2\n`; (* in delay slot: save retaddr in %r2 *)
 442         record_frame i.live
 443     | Lop(Icall_imm s) ->
 444         emit_call s "%r2";
 445         fill_delay_slot dslot;
 446         record_frame i.live
 447     | Lop(Itailcall_ind) ->
 448         let n = frame_size() in
 449         `       bv      0({emit_reg i.arg.(0)})\n`;
 450         if !contains_calls (* in delay slot *)
 451         then `  ldwm    {emit_int(-n)}(%r30), %r2\n`
 452         else `  ldo     {emit_int(-n)}(%r30), %r30\n`
 453     | Lop(Itailcall_imm s) ->
 454         let n = frame_size() in
 455         if s = !function_name then begin
 456           `     b,n     {emit_label !tailrec_entry_point}\n`
 457         end else begin
 458           emit_call s "%r0";
 459           if !contains_calls (* in delay slot *)
 460           then `        ldwm    {emit_int(-n)}(%r30), %r2\n`
 461           else `        ldo     {emit_int(-n)}(%r30), %r30\n`
 462         end
 463     | Lop(Iextcall(s, alloc)) ->
 464         call_symbol s;
 465         if alloc then begin
 466           `     ldil    LR%{emit_symbol s}, %r22\n`;
 467           describe_call i.arg;
 468           emit_call "caml_c_call" "%r2";
 469           `     ldo     RR%{emit_symbol s}(%r22), %r22\n`;  (* in delay slot *)
 470           record_frame i.live
 471         end else begin
 472           describe_call i.arg;
 473           emit_call s "%r2";
 474           fill_delay_slot dslot
 475         end
 476     | Lop(Istackoffset n) ->
 477         `       ldo     {emit_int n}(%r30), %r30\n`;
 478         stack_offset := !stack_offset + n
 479     | Lop(Iload(chunk, addr)) ->
 480         let dest = i.res.(0) in
 481         begin match chunk with
 482           Byte_unsigned ->
 483             emit_load "ldb" addr i.arg dest
 484         | Byte_signed ->
 485             emit_load "ldb" addr i.arg dest;
 486             `   extrs   {emit_reg dest}, 31, 8, {emit_reg dest}\n`
 487         | Sixteen_unsigned ->
 488             emit_load "ldh" addr i.arg dest
 489         | Sixteen_signed ->
 490             emit_load "ldh" addr i.arg dest;
 491             `   extrs   {emit_reg dest}, 31, 16, {emit_reg dest}\n`
 492         | Single ->
 493             emit_float_load addr i.arg dest false;
 494             `   fcnvff,sgl,dbl {emit_reg dest}L, {emit_reg dest}\n`
 495         | Double | Double_u ->
 496             emit_float_load addr i.arg dest true
 497         | _ ->
 498             emit_load "ldw" addr i.arg dest
 499         end
 500     | Lop(Istore(chunk, addr)) ->
 501         let src = i.arg.(0) in
 502         begin match chunk with
 503           Byte_unsigned | Byte_signed ->
 504             emit_store "stb" addr i.arg src
 505         | Sixteen_unsigned | Sixteen_signed ->
 506             emit_store "sth" addr i.arg src
 507         | Single ->
 508             `   fcnvff,dbl,sgl  {emit_reg src}, %fr31L\n`;
 509             emit_float_store addr i.arg (phys_reg 127) (* %fr31 *) false
 510         | Double | Double_u ->
 511             emit_float_store addr i.arg src true
 512         | _ ->
 513             emit_store "stw" addr i.arg src
 514         end
 515     | Lop(Ialloc n) ->
 516         if !fastcode_flag then begin
 517           let lbl_cont = new_label() in
 518           `     ldw     0(%r4), %r1\n`;
 519           `     ldo     {emit_int (-n)}(%r3), %r3\n`;
 520           `     comb,>>= %r3, %r1, {emit_label lbl_cont}\n`;
 521           `     addi    4, %r3, {emit_reg i.res.(0)}\n`; (* in delay slot *)
 522           emit_call "caml_call_gc" "%r2";
 523           (* Cannot use %r1 to pass size, since clobbered by glue call code *)
 524           `     ldi     {emit_int n}, %r29\n`; (* in delay slot *)
 525           record_frame i.live;
 526           `     addi    4, %r3, {emit_reg i.res.(0)}\n`;
 527           `{emit_label lbl_cont}:\n`
 528         end else begin
 529           emit_call "caml_allocN" "%r2";
 530           (* Cannot use %r1 either *)
 531           `     ldi     {emit_int n}, %r29\n`; (* in delay slot *)
 532           record_frame i.live;
 533           `     addi    4, %r3, {emit_reg i.res.(0)}\n`
 534         end
 535     | Lop(Iintop Imul) ->
 536         `       stws,ma {emit_reg i.arg.(0)}, 8(%r30)\n`;
 537         `       stw     {emit_reg i.arg.(1)}, -4(%r30)\n`;
 538         `       fldws   -8(%r30), %fr31L\n`;
 539         `       fldws   -4(%r30), %fr31R\n`;
 540         `       xmpyu   %fr31L, %fr31R, %fr31\n`;
 541         `       fstws   %fr31R, -8(%r30)\n`; (* poor scheduling *)
 542         `       ldws,mb -8(%r30), {emit_reg i.res.(0)}\n`
 543     | Lop(Iintop Idiv) ->
 544         (* Arguments are assumed to be in %r26 and %r25, result in %r29 *)
 545         `       bl      $$divI, %r31\n`;
 546         fill_delay_slot dslot
 547     | Lop(Iintop Imod) ->
 548         (* Arguments are assumed to be in %r26 and %r25, result in %r29 *)
 549         `       bl      $$remI, %r31\n`;
 550         fill_delay_slot dslot
 551     | Lop(Iintop Ilsl) ->
 552         `       subi    31, {emit_reg i.arg.(1)}, %r1\n`;
 553         `       mtsar   %r1\n`;
 554         `       zvdep   {emit_reg i.arg.(0)}, 32, {emit_reg i.res.(0)}\n`
 555     | Lop(Iintop Ilsr) ->
 556         `       mtsar   {emit_reg i.arg.(1)}\n`;
 557         `       vshd    %r0, {emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n`
 558     | Lop(Iintop Iasr) ->
 559         `       subi    31, {emit_reg i.arg.(1)}, %r1\n`;
 560         `       mtsar   %r1\n`;
 561         `       vextrs  {emit_reg i.arg.(0)}, 32, {emit_reg i.res.(0)}\n`
 562     | Lop(Iintop(Icomp cmp)) ->
 563         let comp = name_for_int_comparison(negate_int_comparison cmp) in
 564         `       comclr,{emit_string comp} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`;
 565         `       ldi     1, {emit_reg i.res.(0)}\n`
 566     | Lop(Iintop Icheckbound) ->
 567         if !range_check_trap = 0 then range_check_trap := new_label();
 568         `       comclr,>> {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, %r0\n`;
 569         `       b,n     {emit_label !range_check_trap}\n`
 570     | Lop(Iintop op) ->
 571         let instr = name_for_int_operation op in
 572         `       {emit_string instr}     {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
 573     | Lop(Iintop_imm(Iadd, n)) ->
 574         `       addi    {emit_int n}, {emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n`
 575     | Lop(Iintop_imm(Isub, n)) ->
 576         `       addi    {emit_int(-n)}, {emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n`
 577     | Lop(Iintop_imm(Idiv, n)) ->
 578         let l = Misc.log2 n in
 579         `       comclr,>= {emit_reg i.arg.(0)}, %r0, %r1\n`;
 580         if not (l = 0) then
 581           `     zdepi   -1, 31, {emit_int l}, %r1\n`
 582         else
 583           `     xor     %r1, %r1, %r1\n`;
 584         `       add     {emit_reg i.arg.(0)}, %r1, %r1\n`;
 585         `       extrs   %r1, {emit_int(31-l)}, {emit_int(32-l)}, {emit_reg i.res.(0)}\n`
 586     | Lop(Iintop_imm(Imod, n)) ->
 587         let l = Misc.log2 n in
 588         `       comclr,>= {emit_reg i.arg.(0)}, %r0, %r1\n`;
 589         if not (l = 0) then
 590           `     zdepi   -1, 31, {emit_int l}, %r1\n`
 591         else
 592           `     xor     %r1, %r1, %r1\n`;
 593         `       add     {emit_reg i.arg.(0)}, %r1, %r1\n`;
 594         `       depi    0, 31, {emit_int l}, %r1\n`;
 595         `       sub     {emit_reg i.arg.(0)}, %r1, {emit_reg i.res.(0)}\n`
 596     | Lop(Iintop_imm(Ilsl, n)) ->
 597         let n = n land 31 in
 598         `       zdep    {emit_reg i.arg.(0)}, {emit_int(31-n)}, {emit_int(32-n)}, {emit_reg i.res.(0)}\n`
 599     | Lop(Iintop_imm(Ilsr, n)) ->
 600         let n = n land 31 in
 601         `       extru   {emit_reg i.arg.(0)}, {emit_int(31-n)}, {emit_int(32-n)}, {emit_reg i.res.(0)}\n`
 602     | Lop(Iintop_imm(Iasr, n)) ->
 603         let n = n land 31 in
 604         `       extrs   {emit_reg i.arg.(0)}, {emit_int(31-n)}, {emit_int(32-n)}, {emit_reg i.res.(0)}\n`
 605     | Lop(Iintop_imm(Icomp cmp, n)) ->
 606         let comp = name_for_int_comparison(negate_int_comparison(swap_int_comparison cmp)) in
 607         `       comiclr,{emit_string comp} {emit_int n}, {emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n`;
 608         `       ldi     1, {emit_reg i.res.(0)}\n`
 609     | Lop(Iintop_imm(Icheckbound, n)) ->
 610         if !range_check_trap = 0 then range_check_trap := new_label();
 611         `       comiclr,<< {emit_int n}, {emit_reg i.arg.(0)}, %r0\n`;
 612         `       b,n     {emit_label !range_check_trap}\n`
 613     | Lop(Iintop_imm(op, n)) ->
 614         assert false
 615     | Lop(Iaddf | Isubf | Imulf | Idivf as op) ->
 616         let instr = name_for_float_operation op in
 617         `       {emit_string instr} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
 618     | Lop(Inegf) ->
 619         `       fsub,dbl 0, {emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n`
 620     | Lop(Iabsf) ->
 621         `       fabs,dbl {emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n`
 622     | Lop(Ifloatofint) ->
 623         `       stws,ma {emit_reg i.arg.(0)}, 8(%r30)\n`;
 624         `       fldws,mb -8(%r30), %fr31L\n`;
 625         `       fcnvxf,sgl,dbl %fr31L, {emit_reg i.res.(0)}\n`
 626     | Lop(Iintoffloat) ->
 627         `       fcnvfxt,dbl,sgl {emit_reg i.arg.(0)}, %fr31L\n`;
 628         `       fstws,ma %fr31L, 8(%r30)\n`;
 629         `       ldws,mb -8(%r30), {emit_reg i.res.(0)}\n`
 630     | Lop(Ispecific sop) ->
 631         let instr = name_for_specific_operation sop in
 632         `       {emit_string instr}     {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
 633     | Lreloadretaddr ->
 634         let n = frame_size() in
 635         `       ldw     {emit_int(-n)}(%r30), %r2\n`
 636     | Lreturn ->
 637         let n = frame_size() in
 638         `       bv      0(%r2)\n`;
 639         `       ldo     {emit_int(-n)}(%r30), %r30\n` (* in delay slot *)
 640     | Llabel lbl ->
 641         `{emit_label lbl}:\n`
 642     | Lbranch lbl ->
 643         begin match dslot with
 644             None ->
 645               ` b,n     {emit_label lbl}\n`
 646           | Some i ->
 647               ` b       {emit_label lbl}\n`;
 648               emit_instr i None
 649         end
 650     | Lcondbranch(tst, lbl) ->
 651         begin match tst with
 652           Itruetest ->
 653             emit_comib "<>" "=" 0 i.arg lbl dslot
 654         | Ifalsetest ->
 655             emit_comib "=" "<>" 0 i.arg lbl dslot
 656         | Iinttest cmp ->
 657             let comp = name_for_int_comparison cmp
 658             and negcomp =
 659               name_for_int_comparison(negate_int_comparison cmp) in
 660             emit_comb comp negcomp i.arg lbl dslot
 661         | Iinttest_imm(cmp, n) ->
 662             let scmp = swap_int_comparison cmp in
 663             let comp = name_for_int_comparison scmp
 664             and negcomp =
 665               name_for_int_comparison(negate_int_comparison scmp) in
 666             emit_comib comp negcomp n i.arg lbl dslot
 667         | Ifloattest(cmp, neg) ->
 668             let comp = name_for_float_comparison cmp neg in
 669             `   fcmp,dbl,{emit_string comp}     {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
 670             `   ftest\n`;
 671             `   b       {emit_label lbl}\n`;
 672             fill_delay_slot dslot
 673         | Ioddtest ->
 674             emit_comib "OD" "EV" 0 i.arg lbl dslot
 675         | Ieventest ->
 676             emit_comib "EV" "OD" 0 i.arg lbl dslot
 677         end
 678   | Lcondbranch3(lbl0, lbl1, lbl2) ->
 679         begin match lbl0 with
 680           None -> ()
 681         | Some lbl -> emit_comib "=" "<>" 0 i.arg lbl None
 682         end;
 683         begin match lbl1 with
 684           None -> ()
 685         | Some lbl -> emit_comib "=" "<>" 1 i.arg lbl None
 686         end;
 687         begin match lbl2 with
 688           None -> ()
 689         | Some lbl -> emit_comib "=" "<>" 2 i.arg lbl None
 690         end
 691     | Lswitch jumptbl ->
 692         `       blr     {emit_reg i.arg.(0)}, 0\n`;
 693         fill_delay_slot dslot;
 694         for i = 0 to Array.length jumptbl - 1 do
 695           `     b       {emit_label jumptbl.(i)}\n`;
 696           `     nop\n`
 697         done
 698     | Lsetuptrap lbl ->
 699         `       bl      {emit_label lbl}, %r1\n`;
 700         fill_delay_slot dslot
 701     | Lpushtrap ->
 702         stack_offset := !stack_offset + 8;
 703         `       stws,ma %r5, 8(%r30)\n`;
 704         `       stw     %r1, -4(%r30)\n`;
 705         `       copy    %r30, %r5\n`
 706     | Lpoptrap ->
 707         `       ldws,mb -8(%r30), %r5\n`;
 708         stack_offset := !stack_offset - 8
 709     | Lraise ->
 710         `       ldw     -4(%r5), %r1\n`;
 711         `       copy    %r5, %r30\n`;
 712         `       bv      0(%r1)\n`;
 713         `       ldws,mb -8(%r30), %r5\n` (* in delay slot *)
 714
 715 and fill_delay_slot = function
 716     None -> `   nop\n`
 717   | Some i -> emit_instr i None
 718
 719 and emit_delay_slot = function
 720     None -> ()
 721   | Some i -> emit_instr i None
 722
 723 and emit_comb comp negcomp arg lbl dslot =
 724   if lbl >= 0 then begin
 725     `   comb,{emit_string comp} {emit_reg arg.(0)}, {emit_reg arg.(1)}, {emit_label lbl}\n`;
 726     fill_delay_slot dslot
 727   end else begin
 728     emit_delay_slot dslot;
 729     `   comclr,{emit_string negcomp}    {emit_reg arg.(0)}, {emit_reg arg.(1)}, %r0\n`;
 730     `   b,n     {emit_label (-lbl)}\n`
 731   end
 732
 733 and emit_comib comp negcomp cst arg lbl dslot =
 734   if lbl >= 0 then begin
 735     `   comib,{emit_string comp}        {emit_int cst}, {emit_reg arg.(0)}, {emit_label lbl}\n`;
 736     fill_delay_slot dslot
 737   end else begin
 738     emit_delay_slot dslot;
 739     `   comiclr,{emit_string negcomp}   {emit_int cst}, {emit_reg arg.(0)}, %r0\n`;
 740     `   b,n     {emit_label (-lbl)}\n`
 741   end
 742
 743 (* Checks if a pseudo-instruction expands to exactly one machine instruction
 744    that does not branch. *)
 745
 746 let is_one_instr i =
 747   match i.desc with
 748     Lop op ->
 749       begin match op with
 750         Imove | Ispill | Ireload ->
 751           begin match (i.arg.(0), i.res.(0)) with
 752             ({typ = Float; loc = Stack s}, _) -> is_immediate(slot_offset s 1)
 753           | (_, {typ = Float; loc = Stack s}) -> is_immediate(slot_offset s 1)
 754           | (_, _) -> true
 755           end
 756       | Iconst_int n -> is_offset_native n
 757       | Istackoffset _ -> true
 758       | Iload(_, Iindexed n) -> i.res.(0).typ <> Float & is_offset n
 759       | Istore(_, Iindexed n) -> i.arg.(0).typ <> Float & is_offset n
 760       | Iintop(Iadd | Isub | Iand | Ior | Ixor) -> true
 761       | Iintop_imm((Iadd | Isub | Ilsl | Ilsr | Iasr), _) -> true
 762       | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf -> true
 763       | Ispecific _ -> true
 764       | _ -> false
 765       end
 766   | Lreloadretaddr -> true
 767   | _ -> false
 768
 769 let no_interference res arg =
 770   try
 771     for i = 0 to Array.length arg - 1 do
 772       for j = 0 to Array.length res - 1 do
 773         if arg.(i).loc = res.(j).loc then raise Exit
 774       done
 775     done;
 776     true
 777   with Exit ->
 778     false
 779
 780 (* Emit a sequence of instructions, trying to fill delay slots for branches *)
 781
 782 let rec emit_all i =
 783   match i with
 784     {desc = Lend} -> ()
 785   | {next = {desc = Lop(Icall_imm _)
 786                   | Lop(Iextcall(_, false))
 787                   | Lop(Iintop(Idiv | Imod))
 788                   | Lbranch _
 789                   | Lsetuptrap _ }}
 790     when is_one_instr i ->
 791       emit_instr i.next (Some i);
 792       emit_all i.next.next
 793   | {next = {desc = Lcondbranch(_, _) | Lswitch _}}
 794     when is_one_instr i & no_interference i.res i.next.arg ->
 795       emit_instr i.next (Some i);
 796       emit_all i.next.next
 797   | _ ->
 798       emit_instr i None;
 799       emit_all i.next
 800
 801 (* Estimate the size of an instruction, in actual HPPA instructions *)
 802
 803 let is_float_stack r =
 804   match r with {loc = Stack _; typ = Float} -> true | _ -> false
 805
 806 let sizeof_instr i =
 807   match i.desc with
 808     Lend -> 0
 809   | Lop op ->
 810       begin match op with
 811         Imove | Ispill | Ireload ->
 812           if is_float_stack i.arg.(0) || is_float_stack i.res.(0)
 813           then 2 (* ldo/fxxx *) else 1
 814       | Iconst_int n ->
 815           if is_offset_native n then 1 else 2 (* ldi or ldil/ldo *)
 816       | Iconst_float _ -> 3 (* ldil/ldo/fldds *)
 817       | Iconst_symbol _ -> 2 (* addil/ldo *)
 818       | Icall_ind -> 2 (* ble/copy *)
 819       | Icall_imm _ -> 2 (* bl/nop *)
 820       | Itailcall_ind -> 2 (* bv/ldwm *)
 821       | Itailcall_imm _ -> 2 (* bl/ldwm *)
 822       | Iextcall(_, alloc) ->
 823           if alloc then 3 (* ldil/bl/ldo *) else 2 (* bl/nop *)
 824       | Istackoffset _ -> 1 (* ldo *)
 825       | Iload(chunk, addr) ->
 826           if i.res.(0).typ = Float
 827           then 4 (* addil/ldo/fldws/fldws *)
 828           else (match addr with Iindexed ofs when is_offset ofs -> 1 | _ -> 2)
 829              + (match chunk with Byte_signed -> 1 | Sixteen_signed -> 1 | _ -> 0)
 830       | Istore(chunk, addr) ->
 831           if i.arg.(0).typ = Float
 832           then 4 (* addil/ldo/fstws/fstws *)
 833           else (match addr with Iindexed ofs when is_offset ofs -> 1 | _ -> 2)
 834       | Ialloc _ -> if !fastcode_flag then 7 else 3
 835       | Iintop Imul -> 7
 836       | Iintop(Idiv | Imod) -> 3 (* ldil/ble/nop *)
 837       | Iintop Ilsl -> 3 (* subi/mtsar/zvdep *)
 838       | Iintop Ilsr -> 2 (* mtsar/vshd *)
 839       | Iintop Iasr -> 3 (* subi/mtsar/vextrs *)
 840       | Iintop(Icomp _) -> 2 (* comclr/ldi *)
 841       | Iintop Icheckbound -> 2 (* comclr/b,n *)
 842       | Iintop _ -> 1
 843       | Iintop_imm(Idiv, _) -> 4 (* comclr/zdepi/add/extrs *)
 844       | Iintop_imm(Imod, _) -> 5 (* comclr/zdepi/add/extrs/sub *)
 845       | Iintop_imm(Icomp _, _) -> 2 (* comiclr/ldi *)
 846       | Iintop_imm(Icheckbound, _) -> 2 (* comiclr/b,n *)
 847       | Iintop_imm(_, _) -> 1
 848       | Ifloatofint -> 3 (* stws,ma/fldws,mb/fcnvxf *)
 849       | Iintoffloat -> 3 (* fcnfxt/fstws/ldws *)
 850       | _ (* Inegf|Iabsf|Iaddf|Isubf|Imulf|Idivf|Ispecific _ *) -> 1
 851       end
 852   | Lreloadretaddr -> 1
 853   | Lreturn -> 2
 854   | Llabel _ -> 0
 855   | Lbranch _ -> 1 (* b,n *)
 856   | Lcondbranch(Ifloattest(_, _), _) -> 4 (* fcmp/ftest/b/nop *)
 857   | Lcondbranch(_, _) -> 2 (* comb/nop or comclr/b,n *)
 858   | Lcondbranch3(_, _, _) -> 6 (* worst case: three comib/nop or comclr/b,n *)
 859   | Lswitch tbl -> 2 + 2 * Array.length tbl (* blr/nop b/nop *)
 860   | Lsetuptrap _ -> 2 (* bl/nop *)
 861   | Lpushtrap -> 3 (* stws,ma/stw/copy *)
 862   | Lpoptrap -> 1 (* ldws,mb *)
 863   | Lraise -> 4 (* ldw/copy/bv/ldws,mb *)
 864
 865 (* Estimate the position of all labels in function body
 866    and rewrite long conditional branches with a negative label. *)
 867
 868 let fixup_cond_branches funbody =
 869   let label_position =
 870     (Hashtbl.create 87 : (label, int) Hashtbl.t) in
 871   let rec estimate_labels pos i =
 872     match i.desc with
 873       Lend -> ()
 874     | Llabel lbl ->
 875         Hashtbl.add label_position lbl pos; estimate_labels pos i.next
 876     | _ -> estimate_labels (pos + sizeof_instr i) i.next in
 877   let long_branch currpos lbl =
 878     try
 879       let displ = Hashtbl.find label_position lbl - currpos in
 880       (* Branch offset is stored in 12 bits, giving a range of
 881          -2048 to +2047. Here, we allow 10% error in estimating
 882          the code positions. *)
 883       displ < -1843 || displ > 1842
 884     with Not_found ->
 885       assert false in
 886   let rec fix_branches pos i =
 887     match i.desc with
 888       Lend -> ()
 889     | Lcondbranch(tst, lbl) ->
 890         if long_branch pos lbl then i.desc <- Lcondbranch(tst, -lbl);
 891         fix_branches (pos + sizeof_instr i) i.next
 892     | Lcondbranch3(opt1, opt2, opt3) ->
 893         let fix_opt = function
 894           None -> None
 895         | Some lbl -> Some(if long_branch pos lbl then -lbl else lbl) in
 896         i.desc <- Lcondbranch3(fix_opt opt1, fix_opt opt2, fix_opt opt3);
 897         fix_branches (pos + sizeof_instr i) i.next
 898     | _ ->
 899         fix_branches (pos + sizeof_instr i) i.next in
 900   estimate_labels 0 funbody;
 901   fix_branches 0 funbody
 902
 903 (* Emission of a function declaration *)
 904
 905 let fundecl fundecl =
 906   fixup_cond_branches fundecl.fun_body;
 907   function_name := fundecl.fun_name;
 908   fastcode_flag := fundecl.fun_fast;
 909   tailrec_entry_point := new_label();
 910   stack_offset := 0;
 911   float_constants := [];
 912   define_symbol fundecl.fun_name;
 913   range_check_trap := 0;
 914   let n = frame_size() in
 915   begin match Config.system with
 916   | "hpux" ->
 917     `   .code\n`;
 918     `   .align  4\n`;
 919     `   .export {emit_symbol fundecl.fun_name}, entry, priv_lev=3\n`;
 920     `{emit_symbol fundecl.fun_name}:\n`;
 921     `   .proc\n`;
 922     if !contains_calls then
 923       ` .callinfo frame={emit_int n}, calls, save_rp\n`
 924     else
 925       ` .callinfo frame={emit_int n}, no_calls\n`;
 926     `   .entry\n`
 927   | "linux" | "gnu" ->
 928     `   .text\n`;
 929     `   .align  8\n`;
 930     `   .globl  {emit_symbol fundecl.fun_name}\n`;
 931     `{emit_symbol fundecl.fun_name}:\n`
 932   | _ ->
 933     assert false
 934   end;
 935   if !contains_calls then
 936     `   stwm    %r2, {emit_int n}(%r30)\n`
 937   else if n > 0 then
 938     `   ldo     {emit_int n}(%r30), %r30\n`;
 939   `{emit_label !tailrec_entry_point}:\n`;
 940   emit_all fundecl.fun_body;
 941   if !range_check_trap > 0 then begin
 942     `{emit_label !range_check_trap}:\n`;
 943     emit_call "caml_ml_array_bound_error" "%r31";
 944     `   nop\n`
 945   end;
 946   if Config.system = "hpux"then begin
 947     `   .exit\n`;
 948     `   .procend\n`
 949   end;
 950   emit_float_constants()
 951
 952 (* Emission of data *)
 953
 954 let declare_global s =
 955   define_symbol s;
 956   if Config.system = "hpux"
 957   then `        .export {emit_symbol s}, data\n`
 958   else `        .globl  {emit_symbol s}\n`
 959
 960 let emit_item = function
 961     Cglobal_symbol s ->
 962       declare_global s
 963   | Cdefine_symbol s ->
 964       define_symbol s;
 965       `{emit_symbol s}:\n`
 966   | Cdefine_label lbl ->
 967       `{emit_label (lbl + 100000)}:\n`
 968   | Cint8 n ->
 969       ` .byte   {emit_int n}\n`
 970   | Cint16 n ->
 971       ` .short  {emit_int n}\n`
 972   | Cint32 n ->
 973       ` .long   {emit_nativeint n}\n`
 974   | Cint n ->
 975       ` .long   {emit_nativeint n}\n`
 976   | Csingle f ->
 977       emit_float32_directive ".long" f
 978   | Cdouble f ->
 979       emit_float64_split_directive ".long" f
 980   | Csymbol_address s ->
 981       use_symbol s;
 982       ` .long   {emit_symbol s}\n`
 983   | Clabel_address lbl ->
 984       ` .long   {emit_label(lbl + 100000)}\n`
 985   | Cstring s ->
 986       emit_string_directive "   .ascii  " s
 987   | Cskip n ->
 988       if n > 0 then
 989         if Config.system = "hpux"
 990         then `  .block  {emit_int n}\n`
 991         else `  .space  {emit_int n}\n`
 992   | Calign n ->
 993       emit_align n
 994
 995 let data l =
 996   `     .data\n`;
 997   List.iter emit_item l
 998
 999 (* Beginning / end of an assembly file *)
1000
1001 let begin_assembly() =
1002   if Config.system = "hpux" then begin
1003     `   .space $PRIVATE$\n`;
1004     `   .subspa $DATA$,quad=1,align=8,access=31\n`;
1005     `   .subspa $BSS$,quad=1,align=8,access=31,zero,sort=82\n`;
1006     `   .space $TEXT$\n`;
1007     `   .subspa $LIT$,quad=0,align=8,access=44\n`;
1008     `   .subspa $CODE$,quad=0,align=8,access=44,code_only\n`;
1009     `   .import $global$, data\n`;
1010     `   .import $$divI, millicode\n`;
1011     `   .import $$remI, millicode\n`
1012   end;
1013   used_symbols := StringSet.empty;
1014   defined_symbols := StringSet.empty;
1015   called_symbols := StringSet.empty;
1016   let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
1017   `     .data\n`;
1018   declare_global lbl_begin;
1019   `{emit_symbol lbl_begin}:\n`;
1020   let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
1021   `     .code\n`;
1022   declare_global lbl_begin;
1023   `{emit_symbol lbl_begin}:\n`
1024
1025
1026 let end_assembly() =
1027   `     .code\n`;
1028   let lbl_end = Compilenv.make_symbol (Some "code_end") in
1029   declare_global lbl_end;
1030   `{emit_symbol lbl_end}:\n`;
1031   `     .data\n`;
1032   let lbl_end = Compilenv.make_symbol (Some "data_end") in
1033   declare_global lbl_end;
1034   `{emit_symbol lbl_end}:\n`;
1035   `     .long   0\n`;
1036   let lbl = Compilenv.make_symbol (Some "frametable") in
1037   declare_global lbl;
1038   `{emit_symbol lbl}:\n`;
1039   `     .long   {emit_int (List.length !frame_descriptors)}\n`;
1040   List.iter emit_frame !frame_descriptors;
1041   frame_descriptors := [];
1042   emit_imports()