(* Handlings of local labels and backpatching *)

local 
  open Fnlib Instruct Buffcode
in

datatype label_definition =
    Label_defined of int
  | Label_undefined of (int * int) list
;

val label_table  = ref (Array.fromList [] : label_definition Array.array)
;

fun reset_label_table () =
  label_table := Array.array(16, Label_undefined [])
;

fun extend_label_table needed =
  let val old = Array.length (!label_table)
      val new_table = 
        Array.array((needed div old + 1) * old, Label_undefined [])
  in
    Array.copy { src= !label_table, dst= new_table, di=0 };
    label_table := new_table
  end;

fun define_label lbl =
(
  if lbl < Array.length (!label_table) then () else 
    extend_label_table lbl;
  case Array.sub(!label_table, lbl) of
      Label_defined _ =>
        fatalError "define_label : already defined"
    | Label_undefined L =>
        let val currpos = !out_position in
          Array.update(!label_table, lbl, Label_defined currpos);
          case L of
              [] => ()
            |  _ => (* Backpatching the list L of pending labels: *)
              (List.app (fn (pos,orig) => 
                           (out_position := pos;
                            out_long (currpos - orig)))
                        L;
               out_position := currpos)
        end
);

fun out_label_with_orig orig lbl =
(
  if lbl = Nolabel then 
    fatalError "out_label: undefined label"
  else if lbl >= Array.length (!label_table) then
    extend_label_table lbl
  else ();
  case Array.sub(!label_table, lbl) of
      Label_defined def =>
        out_long (def - orig)
    | Label_undefined L =>
        (Array.update(!label_table, lbl,
           Label_undefined ((!out_position, orig) :: L));
         out_long 0)
);

fun out_label l = out_label_with_orig (!out_position) l;

end;
