home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / compiler / labels.ml < prev    next >
Encoding:
Text File  |  1993-09-24  |  1.6 KB  |  60 lines  |  [TEXT/MPS ]

  1. (* Handlings of local labels and backpatching *)
  2.  
  3. #open "misc";;
  4. #open "instruct";;
  5. #open "buffcode";;
  6.  
  7. type label_definition =
  8.     Label_defined of int
  9.   | Label_undefined of (int * int) list
  10. ;;
  11.  
  12. let label_table  = ref ([| |] : label_definition vect)
  13. ;;
  14.  
  15. let reset_label_table () =
  16.   label_table := (make_vect 16 (Label_undefined [])); ()
  17. ;;
  18.  
  19. let extend_label_table needed =
  20.   let old = vect_length !label_table in
  21.   let new_table = make_vect ((needed / old + 1) * old) (Label_undefined []) in
  22.   for i = 0 to pred old do
  23.     new_table.(i) <- (!label_table).(i)
  24.   done;
  25.   label_table := new_table; ()
  26. ;;
  27.  
  28. let define_label lbl =
  29.   if lbl >= vect_length !label_table then extend_label_table lbl;
  30.   match (!label_table).(lbl) with
  31.     Label_defined _ ->
  32.       fatal_error "define_label : already defined"
  33.   | Label_undefined L ->
  34.       let currpos = !out_position in
  35.         (!label_table).(lbl) <- (Label_defined currpos);
  36.         match L with
  37.             [] -> ()
  38.           |  _ -> do_list (fun (pos,orig) -> out_position := pos;
  39.                                              out_short (currpos - orig)) L;
  40.                   out_position := currpos
  41. ;;
  42.  
  43. let out_label_with_orig orig lbl =
  44.   if lbl == Nolabel then fatal_error "out_label: undefined label";
  45.   if lbl >= vect_length !label_table then extend_label_table lbl;
  46.   match (!label_table).(lbl) with
  47.     Label_defined def ->
  48.       out_short (def - orig)
  49.   | Label_undefined L ->
  50.       (!label_table).(lbl) <-
  51.         Label_undefined((!out_position, orig) :: L);
  52.       out_short 0
  53. ;;
  54.  
  55. let out_label l = out_label_with_orig !out_position l
  56. ;;
  57.  
  58.  
  59.  
  60.