(* Emission of Alpha assembly code *)

open Misc
open Cmm
open Arch
open Proc
open Reg
open Mach
open Linearize
open Emitaux

(* Tradeoff between code size and code speed *)

let fastcode_flag = ref true

(* Output a label *)

let emit_label lbl =
  emit_string "$"; emit_int lbl

(* Output a pseudo-register *)

let emit_reg r =
  match r.loc with
    Reg r -> emit_string (register_name r)
  | _ -> fatal_error "Emit_alpha.emit_reg"

(* Layout of the stack frame *)

let stack_offset = ref 0
let uses_gp = ref false

let frame_size () =
  let size =
    !stack_offset +
    8 * (num_stack_slots.(0) + num_stack_slots.(1)) +
    (if !contains_calls then 8 else 0) +
    (if !uses_gp then 8 else 0) in
  Misc.align size 16

let slot_offset loc class =
  match loc with
    Incoming n -> frame_size() + n
  | Local n ->
      if class = 0
      then !stack_offset + n * 8
      else !stack_offset + (num_stack_slots.(0) + n) * 8
  | Outgoing n -> n

(* Output a stack reference *)

let emit_stack r =
  match r.loc with
    Stack s ->
      let ofs = slot_offset s (register_class r) in `{emit_int ofs}($sp)`
  | _ -> fatal_error "Emit_alpha.emit_stack"

(* Output an addressing mode *)

let emit_addressing addr r n =
  match addr with
    Iindexed ofs ->
      `{emit_int ofs}({emit_reg r.(n)})`
  | Ibased(s, 0) ->
      `{emit_symbol s}`
  | Ibased(s, ofs) ->
      `{emit_symbol s} + {emit_int ofs}`

(* Communicate live registers at call points to the assembler *)

let int_reg_number = [|
  0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12;
  16; 17; 18; 19; 20; 21; 22; 23
|]
  
let float_reg_number = [|
  0; 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
|]

let liveregs instr extra_msk =
  (* $13, $14, $15, $26 always live *)
  let int_mask = ref(0x00070020 lor extra_msk)
  and float_mask = ref 0 in
  let add_register = function
      {loc = Reg r; typ = (Int | Addr)} ->
        int_mask := !int_mask lor (1 lsl (31 - int_reg_number.(r)))
    | {loc = Reg r; typ = Float} ->
        float_mask := !float_mask lor (1 lsl (31 - float_reg_number.(r - 100)))
    | _ -> () in
  Reg.Set.iter add_register instr.live;
  Array.iter add_register instr.arg;
  emit_printf "	.livereg 0x%08x, 0x%08x\n" !int_mask !float_mask

let live_24 = 1 lsl (31 - 24)
let live_25 = 1 lsl (31 - 25)
let live_26 = 1 lsl (31 - 26)
let live_27 = 1 lsl (31 - 27)

(* Record live pointers at call points *)

type frame_descr =
  { fd_lbl: int;                        (* Return address *)
    fd_frame_size: int;                 (* Size of stack frame *)
    fd_live_offset: int list }          (* Offsets/regs of live addresses *)

let frame_descriptors = ref([] : frame_descr list)

let record_frame_label live =
  let lbl = new_label() in
  let live_offset = ref [] in
  Reg.Set.iter
    (function
        {typ = Addr; loc = Reg r} ->
          live_offset := (-1 - int_reg_number.(r)) :: !live_offset
      | {typ = Addr; loc = Stack s} as reg ->
          live_offset := slot_offset s (register_class reg) :: !live_offset
      | _ -> ())
    live;
  frame_descriptors :=
    { fd_lbl = lbl;
      fd_frame_size = frame_size();
      fd_live_offset = !live_offset } :: !frame_descriptors;
  lbl

let record_frame live =
  let lbl = record_frame_label live in `{emit_label lbl}:`

let emit_frame fd =
  `	.quad	{emit_label fd.fd_lbl} + 4\n`;
  `	.word	{emit_int fd.fd_frame_size}\n`;
  `	.word	{emit_int (List.length fd.fd_live_offset)}\n`;
  List.iter
    (fun n ->
      `	.word	{emit_int n}\n`)
    fd.fd_live_offset;
  `	.align	3\n`

(* Record calls to the GC -- we've moved them out of the way *)

type gc_call =
  { gc_lbl: label;                      (* Entry label *)
    gc_return_lbl: label;               (* Where to branch after GC *)
    gc_desired_size: int;               (* Required block size *)
    gc_frame: label;                    (* Label of frame descriptor *)
    gc_instr: instruction }             (* Record live registers *)

let call_gc_sites = ref ([] : gc_call list)

let emit_call_gc gc =
  `{emit_label gc.gc_lbl}:	ldiq	$25, {emit_int gc.gc_desired_size}\n`;
  liveregs gc.gc_instr 0;
  `{emit_label gc.gc_frame}:	bsr	caml_call_gc\n`;
  `	br	{emit_label gc.gc_return_lbl}\n`

(* Record calls to caml_fast_modify -- we've moved then out of the way *)

type modify_call =
  { mod_lbl: label;                     (* Entry label *)
    mod_return_lbl: label;              (* Where to branch after call *)
    mod_instr: instruction }            (* Record live registers *)

let modify_sites = ref ([] : modify_call list)

let emit_modify mc =
  let i = mc.mod_instr in
  `{emit_label mc.mod_lbl}:	mov	{emit_reg i.arg.(0)}, $25\n`;
  liveregs i (live_24 + live_25);
  `	bsr	caml_fast_modify\n`; (* Pointer to block in $25, header in $24 *)
  `	br	{emit_label mc.mod_return_lbl}\n`

(* Return the label occurring most frequently in an array of labels *)

let most_frequent_element v =
  let freq = Array.new (Array.length v) 0 in
  for i = 0 to Array.length v - 1 do
    try
      for j = 0 to i - 1 do
        if v.(i) = v.(j) then (freq.(j) <- freq.(j) + 1; raise Exit)
      done;
      freq.(i) <- 1
    with Exit ->
      ()
  done;
  let max_freq = ref 1 and max_freq_pos = ref 0 in
  for i = 1 to Array.length v - 1 do
    if freq.(i) > !max_freq then (max_freq := freq.(i); max_freq_pos := i)
  done;
  v.(!max_freq_pos)

(* Determine if $gp is used in the function *)

let rec instr_uses_gp i =
  match i.desc with
    Lend -> false
  | Lop(Iconst_int n) ->
      if n < -0x8000000 or n > 0x7FFFFFFF then true else instr_uses_gp i.next
  | Lop(Iconst_float s) -> true
  | Lop(Iconst_symbol s) -> true
  | Lop(Iextcall(_, _)) -> true
  | Lop(Iload(_, Ibased(_, _))) -> true
  | Lop(Istore(_, Ibased(_, _))) -> true
  | Lop(Iintop(Idiv | Imod)) -> true    (* divq and remq can be turned into *)
  | Lop(Iintop_imm((Idiv | Imod), _)) -> true (* a function call *)
  | Lop(Iintop_imm(_, n)) ->
      if n < -0x8000000 or n > 0x7FFFFFFF then true else instr_uses_gp i.next
  | Lswitch(jumptbl) ->
      let l = Array.length jumptbl in
      if l < 3 or l > 4 then true else instr_uses_gp i.next
  | _ ->
      instr_uses_gp i.next

(* Names of various instructions *)

let name_for_int_operation = function
    Iadd -> "addq"
  | Isub -> "subq"
  | Imul -> "mulq"
  | Idiv -> "divq"
  | Imod -> "remq"
  | Iand -> "and"
  | Ior -> "or"
  | Ixor -> "xor"
  | Ilsl -> "sll"
  | Ilsr -> "srl"
  | Iasr -> "sra"
  | _ -> Misc.fatal_error "Emit.name_for_int_operation"

let name_for_float_operation = function
    Iaddf -> "addt"
  | Isubf -> "subt"
  | Imulf -> "mult"
  | Idivf -> "divt"

let name_for_specific_operation = function
    Iadd4 -> "s4addq"
  | Iadd8 -> "s8addq"
  | Isub4 -> "s4subq"
  | Isub8 -> "s8subq"

let name_for_int_comparison = function
    Isigned Ceq -> "cmpeq", true     | Isigned Cne -> "cmpeq", false
  | Isigned Cle -> "cmple", true     | Isigned Cgt -> "cmple", false
  | Isigned Clt -> "cmplt", true     | Isigned Cge -> "cmplt", false
  | Iunsigned Ceq -> "cmpeq", true   | Iunsigned Cne -> "cmpeq", false
  | Iunsigned Cle -> "cmpule", true  | Iunsigned Cgt -> "cmpule", false
  | Iunsigned Clt -> "cmpult", true  | Iunsigned Cge -> "cmpult", false

(* Used for comparisons against 0 *)
let name_for_int_cond_branch = function
    Isigned Ceq -> "beq"     | Isigned Cne -> "bne"
  | Isigned Cle -> "ble"     | Isigned Cgt -> "bgt"
  | Isigned Clt -> "blt"     | Isigned Cge -> "bge"
  | Iunsigned Ceq -> "beq"   | Iunsigned Cne -> "bne"
  | Iunsigned Cle -> "beq"   | Iunsigned Cgt -> "bne"
  | Iunsigned Clt -> "#"     | Iunsigned Cge -> "br"
    (* Always false *)         (* Always true *)

let name_for_float_comparison = function
    Ceq -> "cmpteq", true   | Cne -> "cmpteq", false
  | Cle -> "cmptle", true   | Cgt -> "cmptle", false
  | Clt -> "cmptlt", true   | Cge -> "cmptlt", false

(* Output the assembly code for an instruction *)

(* Name of current function *)
let function_name = ref ""
(* Entry point for tail recursive calls *)
let tailrec_entry_point = ref 0
(* Label of trap for out-of-range accesses *)
let range_check_trap = ref 0

let emit_instr i =
    match i.desc with
      Lend -> ()
    | Lop(Imove | Ispill | Ireload) ->
        let src = i.arg.(0) and dst = i.res.(0) in
        if src.loc <> dst.loc then begin        
          match (src.loc, dst.loc) with
            (Reg rs, Reg rd) ->
              if src.typ = Float then
                `	fmov	{emit_reg src}, {emit_reg dst}\n`
              else
                `	mov	{emit_reg src}, {emit_reg dst}\n`
          | (Reg rs, Stack sd) ->
              if src.typ = Float then
                `	stt	{emit_reg src}, {emit_stack dst}\n`
              else
                `	stq	{emit_reg src}, {emit_stack dst}\n`
          | (Stack ss, Reg rd) ->
              if src.typ = Float then
                `	ldt	{emit_reg dst}, {emit_stack src}\n`
              else
                `	ldq	{emit_reg dst}, {emit_stack src}\n`
          | _ ->
              fatal_error "Emit_alpha: Imove"
        end
    | Lop(Iconst_int 0) ->
        `	clr	{emit_reg i.res.(0)}\n`
    | Lop(Iconst_int n) ->
        `	ldiq	{emit_reg i.res.(0)}, {emit_int n}\n`
    | Lop(Iconst_float s) ->
        `	ldit	{emit_reg i.res.(0)}, {emit_string s}\n`
    | Lop(Iconst_symbol s) ->
        `	lda	{emit_reg i.res.(0)}, {emit_symbol s}\n`
    | Lop(Icall_ind) ->
        liveregs i 0;
        `{record_frame i.live}	jsr	({emit_reg i.arg.(0)})\n`
    | Lop(Icall_imm s) ->
        liveregs i 0;
        `{record_frame i.live}	bsr	{emit_symbol s}\n`
    | Lop(Itailcall_ind) ->
        let n = frame_size() in
        if !contains_calls then begin
          `	ldq	$26, {emit_int(n - 8)}($sp)\n`;
          `	andnot	$26, 1, $26\n`
        end;
        if !uses_gp then
          `	ldq	$gp, {emit_int(n - 16)}($sp)\n`;
        if n > 0 then
          `	lda	$sp, {emit_int n}($sp)\n`;
        liveregs i live_26;
        `	jmp	({emit_reg i.arg.(0)})\n`
    | Lop(Itailcall_imm s) ->
        if s = !function_name then begin
          `	br	{emit_label !tailrec_entry_point}\n`
        end else begin
          let n = frame_size() in
          if !contains_calls then begin
            `	ldq	$26, {emit_int(n - 8)}($sp)\n`;
            `	andnot	$26, 1, $26\n`
          end;
          if !uses_gp then
            `	ldq	$gp, {emit_int(n - 16)}($sp)\n`;
          if n > 0 then
            `	lda	$sp, {emit_int n}($sp)\n`;
          liveregs i live_26;
          `	br	{emit_symbol s}\n`
        end
    | Lop(Iextcall(s, alloc)) ->
        if alloc then begin
          `	lda	$27, {emit_symbol s}\n`;
          liveregs i live_27;
          `{record_frame i.live}	bsr	caml_c_call\n`
        end else begin
          `	jsr	{emit_symbol s}\n`
        end
    | Lop(Istackoffset n) ->
        `	lda	$sp, {emit_int (-n)}($sp)\n`;
        stack_offset := !stack_offset + n
    | Lop(Iload(chunk, addr)) ->
        let load_instr =
          match chunk with
            Word -> if i.res.(0).typ = Float then "ldt" else "ldq"
          | Byte_unsigned -> "ldbu"
          | Byte_signed -> "ldb"
          | Sixteen_unsigned -> "ldwu"
          | Sixteen_signed -> "ldw" in
        `	{emit_string load_instr}	{emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n`
    | Lop(Istore(chunk, addr)) ->
        let store_instr =
          match chunk with
            Word -> if i.arg.(0).typ = Float then "stt" else "stq"
          | Byte_unsigned | Byte_signed -> "stb"
          | Sixteen_unsigned | Sixteen_signed -> "stw" in
        `	{emit_string store_instr}	{emit_reg i.arg.(0)}, {emit_addressing addr i.arg 1}\n`
    | Lop(Ialloc n) ->
        if !fastcode_flag then begin
          let lbl_cont = new_label() in
          `	subq	$13, {emit_int n}, $13\n`;
          `	cmpult	$13, $14, $25\n`;
          let lbl_call_gc = new_label() in
          let lbl_frame = record_frame_label i.live in
          `	bne	$25, {emit_label lbl_call_gc}\n`;
          call_gc_sites :=
            { gc_lbl = lbl_call_gc;
              gc_return_lbl = lbl_cont;
              gc_desired_size = n;
              gc_frame = lbl_frame;
              gc_instr = i } :: !call_gc_sites;
          `{emit_label lbl_cont}:	addq	$13, 8, {emit_reg i.res.(0)}\n`
        end else begin
          begin match n with
            16 -> liveregs i 0;
                  `{record_frame i.live}	bsr	caml_alloc1\n`
          | 24 -> liveregs i 0;
                  `{record_frame i.live}	bsr	caml_alloc2\n`
          | 32 -> liveregs i 0;
                  `{record_frame i.live}	bsr	caml_alloc3\n`
          | _  -> `	ldiq	$25, {emit_int n}\n`;
                  liveregs i live_25;
                  `{record_frame i.live}	bsr	caml_alloc\n`
          end;
          `	addq	$13, 8, {emit_reg i.res.(0)}\n`
        end
    | Lop(Iintop(Icomp cmp)) ->
        let (comp, test) = name_for_int_comparison cmp in
        `	{emit_string comp}	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`;
        if not test then
          `	xor	{emit_reg i.res.(0)}, 1, {emit_reg i.res.(0)}\n`
    | Lop(Iintop(Icheckbound)) ->
        if !range_check_trap = 0 then range_check_trap := new_label();
        `	cmpule	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, $25\n`;
        `	bne	$25, {emit_label !range_check_trap}\n`
    | Lop(Iintop op) ->
        let instr = name_for_int_operation op in
        `	{emit_string instr}	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
    | Lop(Iintop_imm(Idiv, n)) when n = 1 lsl (Misc.log2 n) ->
        let l = Misc.log2 n in
        `	addq	{emit_reg i.arg.(0)}, {emit_int(n-1)}, $25\n`;
        `	cmovge	{emit_reg i.arg.(0)}, {emit_reg i.arg.(0)}, $25\n`;
        `	sra	$25, {emit_int l}, {emit_reg i.res.(0)}\n`
    | Lop(Iintop_imm(Imod, n)) when n = 1 lsl (Misc.log2 n) ->
        let l = Misc.log2 n in
        `	and	{emit_reg i.arg.(0)}, {emit_int(n-1)}, $25\n`;
        `	subq	$25, {emit_int n}, $24\n`;
        `	cmovge	{emit_reg i.arg.(0)}, $25, $24\n`;
        `	cmoveq	$25, $25, $24\n`;
        `	move	$24, {emit_reg i.res.(0)}\n`
    | Lop(Iintop_imm(Icomp cmp, n)) ->
        let (comp, test) = name_for_int_comparison cmp in
        `	{emit_string comp}	{emit_reg i.arg.(0)}, {emit_int n}, {emit_reg i.res.(0)}\n`;
        if not test then
          `	xor	{emit_reg i.res.(0)}, 1, {emit_reg i.res.(0)}\n`

    | Lop(Iintop_imm(Icheckbound, n)) ->
        if !range_check_trap = 0 then range_check_trap := new_label();
        `	cmpule	{emit_reg i.arg.(0)}, {emit_int n}, $25\n`;
        `	bne	$25, {emit_label !range_check_trap}\n`
    | Lop(Iintop_imm(op, n)) ->
        let instr = name_for_int_operation op in
        `	{emit_string instr}	{emit_reg i.arg.(0)}, {emit_int n}, {emit_reg i.res.(0)}\n`
    | Lop(Iaddf | Isubf | Imulf | Idivf as op) ->
        let instr = name_for_float_operation op in
        `	{emit_string instr}	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
    | Lop(Ifloatofint) ->
        `	lda	$sp, -8($sp)\n`;
        `	stq	{emit_reg i.arg.(0)}, 0($sp)\n`;
        `	ldt	$f30, 0($sp)\n`;
        `	cvtqt	$f30, {emit_reg i.res.(0)}\n`;
        `	lda	$sp, 8($sp)\n`
    | Lop(Iintoffloat) ->
        `	lda	$sp, -8($sp)\n`;
        `	cvttqc	{emit_reg i.arg.(0)}, $f30\n`;
        `	stt	$f30, 0($sp)\n`;
        `	ldq	{emit_reg i.res.(0)}, 0($sp)\n`;
        `	lda	$sp, 8($sp)\n`
    | Lop(Ispecific sop) ->
        let instr = name_for_specific_operation sop in
        `	{emit_string instr}	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
    | Lreturn ->
        let n = frame_size() in
        if !contains_calls then
          `	ldq	$26, {emit_int(n - 8)}($sp)\n`;
        if !uses_gp then
          `	ldq	$gp, {emit_int(n - 16)}($sp)\n`;
        if n > 0 then
          `	lda	$sp, {emit_int n}($sp)\n`;
        liveregs i 0;
        `	ret	($26)\n`
    | Llabel lbl ->
        `{emit_label lbl}:\n`
    | Lbranch lbl ->
        `	br	{emit_label lbl}\n`
    | Lcondbranch(tst, lbl) ->
        begin match tst with
          Itruetest ->
            `	bne	{emit_reg i.arg.(0)}, {emit_label lbl}\n`
        | Ifalsetest ->
            `	beq	{emit_reg i.arg.(0)}, {emit_label lbl}\n`
        | Iinttest(Isigned _ | Iunsigned Ceq | Iunsigned Cne as cmp) ->
            `	subq	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, $25\n`;
            let branch = name_for_int_cond_branch cmp in
            `	{emit_string branch}	$25, {emit_label lbl}\n`
        | Iinttest cmp ->
            let (comp, test) = name_for_int_comparison cmp in
            `	{emit_string comp}	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, $25\n`;
            if test then
              `	bne	$25, {emit_label lbl}\n`
            else
              `	beq	$25, {emit_label lbl}\n`
        | Iinttest_imm(cmp, 0) ->
            let branch = name_for_int_cond_branch cmp in
            `	{emit_string branch}	{emit_reg i.arg.(0)}, {emit_label lbl}\n`
        | Iinttest_imm(Isigned _ | Iunsigned Ceq | Iunsigned Cne as cmp, n) ->
            `	subq	{emit_reg i.arg.(0)}, {emit_int n}, $25\n`;
            let branch = name_for_int_cond_branch cmp in
            `	{emit_string branch}	$25, {emit_label lbl}\n`
        | Iinttest_imm(cmp, n) ->
            let (comp, test) = name_for_int_comparison cmp in
            `	{emit_string comp}	{emit_reg i.arg.(0)}, {emit_int n}, $25\n`;
            if test then
              `	bne	$25, {emit_label lbl}\n`
            else
              `	beq	$25, {emit_label lbl}\n`
        | Ifloattest cmp ->
            let (comp, test) = name_for_float_comparison cmp in
            `	{emit_string comp}	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, $f30\n`;
            if test then
              `	fbne	$f30, {emit_label lbl}\n`
            else
              `	fbeq	$f30, {emit_label lbl}\n`
        | Ioddtest ->
            `	blbs	{emit_reg i.arg.(0)}, {emit_label lbl}\n`
        | Ieventest ->
            `	blbc	{emit_reg i.arg.(0)}, {emit_label lbl}\n`
        end
    | Lswitch jumptbl ->
        (* Switches with 1 or 2 cases have normally been eliminated before *)
        (* Do something for 3 and 4 cases *)
        begin match Array.length jumptbl with
          3 ->
            (* Should eliminate the branches that just fall through *)
            `	subq	{emit_reg i.arg.(0)}, 1, $25\n`;
            `	blt	$25, {emit_label jumptbl.(0)}\n`;
            `	beq	$25, {emit_label jumptbl.(1)}\n`;
            `	br	{emit_label jumptbl.(2)}\n`
        | 4 ->
            `	beq	{emit_reg i.arg.(0)}, {emit_label jumptbl.(0)}\n`;
            `	subq	{emit_reg i.arg.(0)}, 2, $25\n`;
            `	blt	$25, {emit_label jumptbl.(1)}\n`;
            `	beq	$25, {emit_label jumptbl.(2)}\n`;
            `	br	{emit_label jumptbl.(3)}\n`
        | _ ->
            let lbl_jumptbl = new_label() in
            `	lda     $25, {emit_label lbl_jumptbl}\n`;
            `	s4addq	{emit_reg i.arg.(0)}, $25, $25\n`;
            `	ldl	$25, 0($25)\n`;
            `	addq	$25, $gp, $25\n`;
            let likely_target = most_frequent_element jumptbl in
            liveregs i live_25;
            `	jmp	($25), {emit_label likely_target}\n`;
            `	.rdata\n`;
            `{emit_label lbl_jumptbl}:\n`;
            for i = 0 to Array.length jumptbl - 1 do
              `	.gprel32	{emit_label jumptbl.(i)}\n`
            done;
            `	.text\n`
        end
    | Lsetuptrap lbl ->
        `	br	$25, {emit_label lbl}\n`;
        if !uses_gp then
          `	ldgp	$gp, 0($27)\n`
    | Lpushtrap ->
        stack_offset := !stack_offset + 16;
        `	lda	$sp, -16($sp)\n`;
        `	stq	$15, 0($sp)\n`;
        `	stq	$25, 8($sp)\n`;
        `	mov	$sp, $15\n`
    | Lpoptrap ->
        `	ldq	$15, 0($sp)\n`;
        `	lda	$sp, 16($sp)\n`;
        stack_offset := !stack_offset - 16
    | Lraise ->
        `	mov	$15, $sp\n`;
        `	ldq	$15, 0($sp)\n`;
        `	ldq	$27, 8($sp)\n`;
        `	lda	$sp, 16($sp)\n`;
        liveregs i 0;
        `	jmp	$25, ($27)\n`   (* Keep retaddr in $25 for debugging *)

let rec emit_all i =
  match i.desc with Lend -> () | _ -> emit_instr i; emit_all i.next

(* Emission of a function declaration *)

let fundecl fundecl =
  function_name := fundecl.fun_name;
  fastcode_flag := fundecl.fun_fast;
  tailrec_entry_point := new_label();
  stack_offset := 0;
  call_gc_sites := [];
  modify_sites := [];
  uses_gp := instr_uses_gp fundecl.fun_body;
  if !uses_gp then contains_calls := true;
  range_check_trap := 0;
  `	.text\n`;
  `	.align	4\n`;
  `	.globl	{emit_symbol fundecl.fun_name}\n`;
  `	.ent	{emit_symbol fundecl.fun_name}\n`;
  `{emit_symbol fundecl.fun_name}:\n`;
  let n = frame_size() in
  if n > 0 then
    `	lda	$sp, -{emit_int n}($sp)\n`;
  if !contains_calls then
    `	stq	$26, {emit_int(n - 8)}($sp)\n`;
  if !uses_gp then begin
    `	stq	$gp, {emit_int(n - 16)}($sp)\n`;
    let lbl = new_label() in
    `	br	$27, {emit_label lbl}\n`;
    `{emit_label lbl}:	ldgp	$gp, 0($27)\n`
  end;
  `{emit_label !tailrec_entry_point}:`;
  emit_all fundecl.fun_body;
  List.iter emit_call_gc !call_gc_sites;
  List.iter emit_modify !modify_sites;
  if !range_check_trap > 0 then
    `{emit_label !range_check_trap}:	call_pal PAL_gentrap\n`;
  `	.end	{emit_symbol fundecl.fun_name}\n`

(* Emission of data *)

let emit_item = function
    Cdefine_symbol s ->
      `	.globl	{emit_symbol s}\n`;
      `{emit_symbol s}:\n`
  | Cdefine_label lbl ->
      `{emit_label (10000 + lbl)}:\n`
  | Cint8 n ->
      `	.byte	{emit_int n}\n`
  | Cint16 n ->
      `	.word	{emit_int n}\n`
  | Cint n ->
      `	.quad	{emit_int n}\n`
  | Cfloat f ->
      `	.double	{emit_string f}\n`
  | Csymbol_address s ->
      `	.quad	{emit_symbol s}\n`
  | Clabel_address lbl ->
      `	.quad	{emit_label (10000 + lbl)}\n`
  | Cstring s ->
      let l = String.length s in
      if l = 0 then ()
      else if l < 80 then
        `	.ascii	{emit_string_literal s}\n`
      else begin
        let i = ref 0 in
        while !i < l do
          let n = min (l - !i) 80 in
          `	.ascii	{emit_string_literal(String.sub s !i n)}\n`;
          i := !i + n
        done
      end
  | Cskip n ->
      if n > 0 then `	.space	{emit_int n}\n`
  | Calign n ->
      `	.align	{emit_int(Misc.log2 n)}\n`

let data l =
  `	.data\n`;
  List.iter emit_item l

(* Beginning / end of an assembly file *)

let begin_assembly() =
  `#include <alpha/pal.h>\n`;
  (* There are really two groups of registers:
      $sp and $15 always point to stack locations
      $0 - $14, $16-$23 never point to stack locations. *)
  `	.noalias $0,$sp;  .noalias $0,$15;  .noalias $1,$sp;  .noalias $1,$15\n`;
  `	.noalias $2,$sp;  .noalias $2,$15;  .noalias $3,$sp;  .noalias $3,$15\n`;
  `	.noalias $4,$sp;  .noalias $4,$15;  .noalias $5,$sp;  .noalias $5,$15\n`;
  `	.noalias $6,$sp;  .noalias $6,$15;  .noalias $7,$sp;  .noalias $7,$15\n`;
  `	.noalias $8,$sp;  .noalias $8,$15;  .noalias $9,$sp;  .noalias $9,$15\n`;
  `	.noalias $10,$sp; .noalias $10,$15; .noalias $11,$sp; .noalias $11,$15\n`;
  `	.noalias $12,$sp; .noalias $12,$15; .noalias $13,$sp; .noalias $13,$15\n`;
  `	.noalias $14,$sp; .noalias $14,$15; .noalias $16,$sp; .noalias $16,$15\n`;
  `	.noalias $17,$sp; .noalias $17,$15; .noalias $18,$sp; .noalias $18,$15\n`;
  `	.noalias $19,$sp; .noalias $19,$15; .noalias $20,$sp; .noalias $20,$15\n`;
  `	.noalias $21,$sp; .noalias $21,$15; .noalias $22,$sp; .noalias $22,$15\n`;
  `	.noalias $23,$sp; .noalias $23,$15\n\n`;
  (* The following .file directive is intended to prevent the generation
     of line numbers for the debugger, 'cos they make .o files larger
     and slow down linking. *)
  `	.file	1 \"{emit_string !Location.input_name}\"\n\n`

let end_assembly () =
  let lbl = Compilenv.current_unit_name() ^ "_frametable" in
  `	.rdata\n`;
  `	.globl	{emit_symbol lbl}\n`;
  `{emit_symbol lbl}:\n`;
  `	.quad	{emit_int (List.length !frame_descriptors)}\n`;
  List.iter emit_frame !frame_descriptors;
  frame_descriptors := []