File: dbf\unsigned.adb
1 --::::::::::
2 --unsigned.adb
3 --::::::::::
4 -- Developed by (C) Wasiliy W. Molostoff 1994, 1995.
5 -- Moscow, Russia,
6 -- Voice: 7 (095) 398-23-38
7 -- e-mail: edv@edv.msk.ru
8 -- This is free software; you can freely redistribute it and/or
9 -- modify it without any restrictions. Please report any errors.
10 -- All corrections will be made as soon as possible.
11 with unchecked_conversion;
12
13 package body unsigned is
14
15 use_dir_cvt: constant boolean := TRUE;
16
17 function to_long_word (buf: byte_string) return long_word is
18 item: long_word := 0;
19 begin
20 for b in reverse buf'range
21 loop
22 item := item * 2 ** byte'size + long_word (buf(b));
23 end loop;
24 return item;
25 end;
26
27 function to_byte_string (item: long_word) return long_word_bytes is
28 buf: long_word_bytes := (others => 0);
29 tmp: long_word := item;
30 begin
31 for b in buf'range
32 loop
33 buf (b) := byte (tmp mod 2 ** byte'size);
34 tmp := tmp / 2 ** byte'size;
35 exit when tmp = 0;
36 end loop;
37 return buf;
38 end;
39
40 function value (item: long_word_bytes) return long_word is
41 begin
42 return to_long_word (item);
43 end;
44
45 function value (item: word_bytes) return word is
46 begin
47 return word (to_long_word (item));
48 end;
49
50 function value (item: word) return word_bytes is
51 begin
52 return to_byte_string (long_word (item)) (word_bytes'range);
53 end;
54
55 function value (item: long_word) return long_word_bytes is
56 begin
57 return to_byte_string (item);
58 end;
59
60 function value (item: byte_string) return standard.string is
61
62 -- subtype bs_type is byte_string (item'range);
63 -- subtype ss_type is string (item'range);
64
65 -- function to_ss is new unchecked_conversion (bs_type, ss_type);
66 begin
67 -- if use_dir_cvt
68 -- then
69 -- return to_ss (item);
70 -- else
71 declare
72 x: standard.string (item'range);
73 b: constant := character'pos (character'last) + 1;
74 begin
75 if character'pos(character'last) = byte'pos(byte'last)
76 then
77 for i in x'range
78 loop
79 x(i) := standard.character'val (item (i));
80 end loop;
81 else
82 for i in x'range
83 loop
84 x(i) := standard.character'val(item(i) rem b);
85 end loop;
86 end if;
87 return x;
88 end;
89 -- end if;
90 end;
91
92 function value (item: standard.string) return byte_string is
93
94 -- subtype bs_type is byte_string (item'range);
95 -- subtype ss_type is string (item'range);
96
97 -- function to_bs is new unchecked_conversion (ss_type, bs_type);
98 begin
99 -- if use_dir_cvt
100 -- then
101 -- return to_bs (item);
102 -- else
103 declare
104 x: byte_string (item'range);
105 begin
106 for i in x'range
107 loop
108 x(i) := standard.character'pos (item (i));
109 end loop;
110 return x;
111 end;
112 -- end if;
113 end;
114
115 end unsigned;
116