home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / compiler / Buffcode.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  1.1 KB  |  49 lines  |  [TEXT/R*ch]
  1. (* To buffer bytecode during emission *)
  2.  
  3. local
  4.   open Obj Fnlib Mixture Config Opcodes;
  5.  
  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.   fun make_buffer n = CharArray.array(n, #"\000");
  11.  
  12. in
  13.  
  14. val out_buffer = ref (make_buffer 64);
  15. val out_position = ref 0;
  16.  
  17. fun realloc_out_buffer () =
  18.   let val len = CharArray.length (!out_buffer)
  19.       val new_buffer = make_buffer (2 * len)
  20.   in
  21.     CharArray.copy { src = !out_buffer, si = 0, len = NONE,
  22.                      dst = new_buffer, di = 0 };
  23.     out_buffer := new_buffer
  24.   end;
  25.  
  26. fun init_out_code () = (out_position := 0);
  27.  
  28. fun out (b : int) =
  29. (
  30.   if !out_position < CharArray.length (!out_buffer) then () else
  31.     realloc_out_buffer();
  32.   CharArray.update(!out_buffer, !out_position, Char.chr(andb_ b 255));
  33.   incr out_position
  34. );
  35.  
  36. fun out_short s =
  37.   (out s; out (rshiftuns_ s 8))
  38. ;
  39.  
  40. fun out_long l =
  41. (
  42.   out l;
  43.   out (rshiftuns_ l 8);
  44.   out (rshiftuns_ l 16);
  45.   out (rshiftuns_ l 24)
  46. );
  47.  
  48. end;
  49.