home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / compiler / Patch.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  1.2 KB  |  40 lines  |  [TEXT/R*ch]
  1. local
  2.  
  3.   open Code_dec Symtable;
  4.  
  5.   prim_val set_nth_char_ : string -> int -> char -> unit = 3 "set_nth_char";
  6.   prim_val andb_      : int -> int -> int = 2 "and";
  7.   prim_val rshiftsig_ : int -> int -> int = 2 "shift_right_signed";
  8.   prim_val rshiftuns_ : int -> int -> int = 2 "shift_right_unsigned";
  9.  
  10.  
  11.   fun patch_short buff pos v =
  12.   (
  13.     (* `set_nth_char` must not check the length of buff, *)
  14.     (* because buff may be allocated outside the heap! *)
  15.     set_nth_char_ buff pos (Char.chr (andb_ v 255));
  16.     set_nth_char_ buff (pos+1) (Char.chr (rshiftuns_ v 8))
  17.   );
  18.  
  19. in
  20.  
  21. (* To relocate a block of object bytecode *)
  22.  
  23. fun patch_object buff offset =
  24.   List.app (fn
  25.     (Reloc_literal sc, pos) =>
  26.       patch_short buff (pos + offset) (get_slot_for_literal sc)
  27.   | (Reloc_getglobal uid, pos) =>
  28.       patch_short buff (pos + offset) (get_slot_for_variable uid)
  29.   | (Reloc_setglobal uid, pos) =>
  30.       patch_short buff (pos + offset) (get_slot_for_defined_variable uid)
  31.   | (Reloc_tag(id, stamp), pos) =>
  32.       (* `buff' is not a true string! *)
  33.       set_nth_char_ buff (pos + offset)
  34.         (Char.chr (get_num_of_exn(id,stamp)))
  35.   | (Reloc_primitive name, pos) =>
  36.       patch_short buff (pos + offset) (get_num_of_prim name))
  37. ;
  38.  
  39. end;
  40.