1signature OUT_HIGH  =
2sig
3  val outChar    :  char   -> unit
4  val outStr     :  string -> unit  (* the naked string *)
5  val outString  :  string -> unit  (* the string preceded by its length *)
6  val outNat1    :  int    -> unit
7  val outNat2    :  int    -> unit
8  val outInt4    :  int    -> unit
9  val outZero    :  int    -> unit
10  val outInstrV  :  int -> int -> unit
11end
12(*----------*)
13
14structure OutHigh: OUT_HIGH  =
15struct
16  open Powers2
17  open Out
18
19  val byteSmall   =  Word8.fromInt
20  val byteChar    =  byteSmall o Char.ord
21
22  val outNat1  =  outByte o byteSmall
23  val outChar  =  outByte o byteChar
24
25  val outStr  =  List.app outChar o String.explode
26  fun outString s  =  (outNat1 (String.size s);  outStr s)
27
28  fun outZero 0  =  ()
29  |   outZero n  =  (outNat1 0;  outZero (n-1))
30
31  fun outNat2 n  =  ( outNat1 (n div two8 );  outNat1 (n mod two8 ) )
32  fun outNat3 n  =  ( outNat1 (n div two16);  outNat2 (n mod two16) )
33
34  (* The following differs from Knuth's method since SML's integers
35     have 31 Bits only *)
36  fun splitInt4 n  =
37      if  n >= 0  then  (n div two24,  n mod two24)
38      else  let val n'  =  n  + two29
39                val n'' =  n' + two29
40            in  ((n'' div two24) + two7 + two6, n'' mod two24)  end
41
42  fun outInt4 n  =
43  let val (n1, nr)  =  splitInt4 n
44  in  outNat1 n1;  outNat3 nr  end
45
46  fun makeNat twoI n  =   if  n>= 0  then  n  else  n + twoI
47
48  fun outInstrV code n  =
49  let fun Code l  =  outNat1 (code + l)  in
50  if  abs n >= two23  then ( Code 4;  outInt4 n                 ) else
51  if  abs n >= two15  then ( Code 3;  outNat3 (makeNat two24 n) ) else
52  if  abs n >= two7   then ( Code 2;  outNat2 (makeNat two16 n) ) else
53  if      n <> 0      then ( Code 1;  outNat1 (makeNat two8  n) ) else  ()
54  end
55
56end
57