http://www.ietf.org/rfc/rfc4042.txt

utf_9.adb

with Interfaces;
package body UTF_9 is
	use type Interfaces.Unsigned_32;

	function From_UTF_9 (Single_Character : UTF_9_String) return Wide_Wide_Character is
		I : Natural := Single_Character'First;
		nonet : Interfaces.Unsigned_32 := UTF_9_Character'Pos (Single_Character (I));
		ucs4 : Interfaces.Unsigned_32 := nonet and 8#377#;
	begin
		while (nonet and 8#400#) /= 0 loop
			I := I + 1;
			nonet := UTF_9_Character'Pos (Single_Character (I));
			ucs4 := Interfaces.Shift_Left (ucs4, 8) or (nonet and 8#377#);
		end loop;
		return Wide_Wide_Character'Val (ucs4);
	end From_UTF_9;

	function To_UTF_9 (Single_Character : Wide_Wide_Character) return UTF_9_String is
		ucs4 : constant Interfaces.Unsigned_32 := Wide_Wide_Character'Pos (Single_Character);
		Result : UTF_9_String (1 .. 4);
		I : Natural := 1;
	begin
		if ucs4 > 8#400# then
			if ucs4 > 8#200000# then
				if ucs4 > 8#100000000# then
					Result (I) := UTF_9_Character'Val
						(8#400# or (Interfaces.Shift_Right (ucs4, 24) and 8#377#));
					I := I + 1;
				end if;
				Result (I) := UTF_9_Character'Val
					(8#400# or (Interfaces.Shift_Right (ucs4, 16) and 8#377#));
				I := I + 1;
			end if;
			Result (I) := UTF_9_Character'Val
				(8#400# or (Interfaces.Shift_Right (ucs4, 8) and 8#377#));
			I := I + 1;
		end if;
		Result (I) := UTF_9_Character'Val (ucs4 and 8#377#);
		return Result (1 .. I);
	end To_UTF_9;

end UTF_9;

utf_9.ads

package UTF_9 is

	type UTF_9_Character is new Wide_Wide_Character
		range Wide_Wide_Character'Val (0) .. Wide_Wide_Character'Val (8#777#);
	for UTF_9_Character'Size use 9;

	type UTF_9_String is array (Positive range <>) of UTF_9_Character;
	for UTF_9_String'Component_Size use 9;
	pragma Pack (UTF_9_String);

	function From_UTF_9 (Single_Character : UTF_9_String) return Wide_Wide_Character;
	function To_UTF_9 (Single_Character : Wide_Wide_Character) return UTF_9_String;

end UTF_9;