Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/libgnat/i-cobol.ads @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
1 ------------------------------------------------------------------------------ | |
2 -- -- | |
3 -- GNAT COMPILER COMPONENTS -- | |
4 -- -- | |
5 -- I N T E R F A C E S . C O B O L -- | |
6 -- -- | |
7 -- S p e c -- | |
8 -- (ASCII Version) -- | |
9 -- -- | |
10 -- Copyright (C) 1993-2017, Free Software Foundation, Inc. -- | |
11 -- -- | |
12 -- This specification is derived from the Ada Reference Manual for use with -- | |
13 -- GNAT. The copyright notice above, and the license provisions that follow -- | |
14 -- apply solely to the contents of the part following the private keyword. -- | |
15 -- -- | |
16 -- GNAT is free software; you can redistribute it and/or modify it under -- | |
17 -- terms of the GNU General Public License as published by the Free Soft- -- | |
18 -- ware Foundation; either version 3, or (at your option) any later ver- -- | |
19 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- | |
20 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
21 -- or FITNESS FOR A PARTICULAR PURPOSE. -- | |
22 -- -- | |
23 -- As a special exception under Section 7 of GPL version 3, you are granted -- | |
24 -- additional permissions described in the GCC Runtime Library Exception, -- | |
25 -- version 3.1, as published by the Free Software Foundation. -- | |
26 -- -- | |
27 -- You should have received a copy of the GNU General Public License and -- | |
28 -- a copy of the GCC Runtime Library Exception along with this program; -- | |
29 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
30 -- <http://www.gnu.org/licenses/>. -- | |
31 -- -- | |
32 -- GNAT was originally developed by the GNAT team at New York University. -- | |
33 -- Extensive contributions were provided by Ada Core Technologies Inc. -- | |
34 -- -- | |
35 ------------------------------------------------------------------------------ | |
36 | |
37 -- This version of the COBOL interfaces package assumes that the COBOL | |
38 -- compiler uses ASCII as its internal representation of characters, i.e. | |
39 -- that the type COBOL_Character has the same representation as the Ada | |
40 -- type Standard.Character. | |
41 | |
42 package Interfaces.COBOL is | |
43 pragma Preelaborate (COBOL); | |
44 | |
45 ------------------------------------------------------------ | |
46 -- Types And Operations For Internal Data Representations -- | |
47 ------------------------------------------------------------ | |
48 | |
49 type Floating is new Float; | |
50 type Long_Floating is new Long_Float; | |
51 | |
52 type Binary is new Integer; | |
53 type Long_Binary is new Long_Long_Integer; | |
54 | |
55 Max_Digits_Binary : constant := 9; | |
56 Max_Digits_Long_Binary : constant := 18; | |
57 | |
58 type Decimal_Element is mod 2**4; | |
59 type Packed_Decimal is array (Positive range <>) of Decimal_Element; | |
60 pragma Pack (Packed_Decimal); | |
61 | |
62 type COBOL_Character is new Character; | |
63 | |
64 Ada_To_COBOL : array (Standard.Character) of COBOL_Character := ( | |
65 COBOL_Character'Val (000), COBOL_Character'Val (001), | |
66 COBOL_Character'Val (002), COBOL_Character'Val (003), | |
67 COBOL_Character'Val (004), COBOL_Character'Val (005), | |
68 COBOL_Character'Val (006), COBOL_Character'Val (007), | |
69 COBOL_Character'Val (008), COBOL_Character'Val (009), | |
70 COBOL_Character'Val (010), COBOL_Character'Val (011), | |
71 COBOL_Character'Val (012), COBOL_Character'Val (013), | |
72 COBOL_Character'Val (014), COBOL_Character'Val (015), | |
73 COBOL_Character'Val (016), COBOL_Character'Val (017), | |
74 COBOL_Character'Val (018), COBOL_Character'Val (019), | |
75 COBOL_Character'Val (020), COBOL_Character'Val (021), | |
76 COBOL_Character'Val (022), COBOL_Character'Val (023), | |
77 COBOL_Character'Val (024), COBOL_Character'Val (025), | |
78 COBOL_Character'Val (026), COBOL_Character'Val (027), | |
79 COBOL_Character'Val (028), COBOL_Character'Val (029), | |
80 COBOL_Character'Val (030), COBOL_Character'Val (031), | |
81 COBOL_Character'Val (032), COBOL_Character'Val (033), | |
82 COBOL_Character'Val (034), COBOL_Character'Val (035), | |
83 COBOL_Character'Val (036), COBOL_Character'Val (037), | |
84 COBOL_Character'Val (038), COBOL_Character'Val (039), | |
85 COBOL_Character'Val (040), COBOL_Character'Val (041), | |
86 COBOL_Character'Val (042), COBOL_Character'Val (043), | |
87 COBOL_Character'Val (044), COBOL_Character'Val (045), | |
88 COBOL_Character'Val (046), COBOL_Character'Val (047), | |
89 COBOL_Character'Val (048), COBOL_Character'Val (049), | |
90 COBOL_Character'Val (050), COBOL_Character'Val (051), | |
91 COBOL_Character'Val (052), COBOL_Character'Val (053), | |
92 COBOL_Character'Val (054), COBOL_Character'Val (055), | |
93 COBOL_Character'Val (056), COBOL_Character'Val (057), | |
94 COBOL_Character'Val (058), COBOL_Character'Val (059), | |
95 COBOL_Character'Val (060), COBOL_Character'Val (061), | |
96 COBOL_Character'Val (062), COBOL_Character'Val (063), | |
97 COBOL_Character'Val (064), COBOL_Character'Val (065), | |
98 COBOL_Character'Val (066), COBOL_Character'Val (067), | |
99 COBOL_Character'Val (068), COBOL_Character'Val (069), | |
100 COBOL_Character'Val (070), COBOL_Character'Val (071), | |
101 COBOL_Character'Val (072), COBOL_Character'Val (073), | |
102 COBOL_Character'Val (074), COBOL_Character'Val (075), | |
103 COBOL_Character'Val (076), COBOL_Character'Val (077), | |
104 COBOL_Character'Val (078), COBOL_Character'Val (079), | |
105 COBOL_Character'Val (080), COBOL_Character'Val (081), | |
106 COBOL_Character'Val (082), COBOL_Character'Val (083), | |
107 COBOL_Character'Val (084), COBOL_Character'Val (085), | |
108 COBOL_Character'Val (086), COBOL_Character'Val (087), | |
109 COBOL_Character'Val (088), COBOL_Character'Val (089), | |
110 COBOL_Character'Val (090), COBOL_Character'Val (091), | |
111 COBOL_Character'Val (092), COBOL_Character'Val (093), | |
112 COBOL_Character'Val (094), COBOL_Character'Val (095), | |
113 COBOL_Character'Val (096), COBOL_Character'Val (097), | |
114 COBOL_Character'Val (098), COBOL_Character'Val (099), | |
115 COBOL_Character'Val (100), COBOL_Character'Val (101), | |
116 COBOL_Character'Val (102), COBOL_Character'Val (103), | |
117 COBOL_Character'Val (104), COBOL_Character'Val (105), | |
118 COBOL_Character'Val (106), COBOL_Character'Val (107), | |
119 COBOL_Character'Val (108), COBOL_Character'Val (109), | |
120 COBOL_Character'Val (110), COBOL_Character'Val (111), | |
121 COBOL_Character'Val (112), COBOL_Character'Val (113), | |
122 COBOL_Character'Val (114), COBOL_Character'Val (115), | |
123 COBOL_Character'Val (116), COBOL_Character'Val (117), | |
124 COBOL_Character'Val (118), COBOL_Character'Val (119), | |
125 COBOL_Character'Val (120), COBOL_Character'Val (121), | |
126 COBOL_Character'Val (122), COBOL_Character'Val (123), | |
127 COBOL_Character'Val (124), COBOL_Character'Val (125), | |
128 COBOL_Character'Val (126), COBOL_Character'Val (127), | |
129 COBOL_Character'Val (128), COBOL_Character'Val (129), | |
130 COBOL_Character'Val (130), COBOL_Character'Val (131), | |
131 COBOL_Character'Val (132), COBOL_Character'Val (133), | |
132 COBOL_Character'Val (134), COBOL_Character'Val (135), | |
133 COBOL_Character'Val (136), COBOL_Character'Val (137), | |
134 COBOL_Character'Val (138), COBOL_Character'Val (139), | |
135 COBOL_Character'Val (140), COBOL_Character'Val (141), | |
136 COBOL_Character'Val (142), COBOL_Character'Val (143), | |
137 COBOL_Character'Val (144), COBOL_Character'Val (145), | |
138 COBOL_Character'Val (146), COBOL_Character'Val (147), | |
139 COBOL_Character'Val (148), COBOL_Character'Val (149), | |
140 COBOL_Character'Val (150), COBOL_Character'Val (151), | |
141 COBOL_Character'Val (152), COBOL_Character'Val (153), | |
142 COBOL_Character'Val (154), COBOL_Character'Val (155), | |
143 COBOL_Character'Val (156), COBOL_Character'Val (157), | |
144 COBOL_Character'Val (158), COBOL_Character'Val (159), | |
145 COBOL_Character'Val (160), COBOL_Character'Val (161), | |
146 COBOL_Character'Val (162), COBOL_Character'Val (163), | |
147 COBOL_Character'Val (164), COBOL_Character'Val (165), | |
148 COBOL_Character'Val (166), COBOL_Character'Val (167), | |
149 COBOL_Character'Val (168), COBOL_Character'Val (169), | |
150 COBOL_Character'Val (170), COBOL_Character'Val (171), | |
151 COBOL_Character'Val (172), COBOL_Character'Val (173), | |
152 COBOL_Character'Val (174), COBOL_Character'Val (175), | |
153 COBOL_Character'Val (176), COBOL_Character'Val (177), | |
154 COBOL_Character'Val (178), COBOL_Character'Val (179), | |
155 COBOL_Character'Val (180), COBOL_Character'Val (181), | |
156 COBOL_Character'Val (182), COBOL_Character'Val (183), | |
157 COBOL_Character'Val (184), COBOL_Character'Val (185), | |
158 COBOL_Character'Val (186), COBOL_Character'Val (187), | |
159 COBOL_Character'Val (188), COBOL_Character'Val (189), | |
160 COBOL_Character'Val (190), COBOL_Character'Val (191), | |
161 COBOL_Character'Val (192), COBOL_Character'Val (193), | |
162 COBOL_Character'Val (194), COBOL_Character'Val (195), | |
163 COBOL_Character'Val (196), COBOL_Character'Val (197), | |
164 COBOL_Character'Val (198), COBOL_Character'Val (199), | |
165 COBOL_Character'Val (200), COBOL_Character'Val (201), | |
166 COBOL_Character'Val (202), COBOL_Character'Val (203), | |
167 COBOL_Character'Val (204), COBOL_Character'Val (205), | |
168 COBOL_Character'Val (206), COBOL_Character'Val (207), | |
169 COBOL_Character'Val (208), COBOL_Character'Val (209), | |
170 COBOL_Character'Val (210), COBOL_Character'Val (211), | |
171 COBOL_Character'Val (212), COBOL_Character'Val (213), | |
172 COBOL_Character'Val (214), COBOL_Character'Val (215), | |
173 COBOL_Character'Val (216), COBOL_Character'Val (217), | |
174 COBOL_Character'Val (218), COBOL_Character'Val (219), | |
175 COBOL_Character'Val (220), COBOL_Character'Val (221), | |
176 COBOL_Character'Val (222), COBOL_Character'Val (223), | |
177 COBOL_Character'Val (224), COBOL_Character'Val (225), | |
178 COBOL_Character'Val (226), COBOL_Character'Val (227), | |
179 COBOL_Character'Val (228), COBOL_Character'Val (229), | |
180 COBOL_Character'Val (230), COBOL_Character'Val (231), | |
181 COBOL_Character'Val (232), COBOL_Character'Val (233), | |
182 COBOL_Character'Val (234), COBOL_Character'Val (235), | |
183 COBOL_Character'Val (236), COBOL_Character'Val (237), | |
184 COBOL_Character'Val (238), COBOL_Character'Val (239), | |
185 COBOL_Character'Val (240), COBOL_Character'Val (241), | |
186 COBOL_Character'Val (242), COBOL_Character'Val (243), | |
187 COBOL_Character'Val (244), COBOL_Character'Val (245), | |
188 COBOL_Character'Val (246), COBOL_Character'Val (247), | |
189 COBOL_Character'Val (248), COBOL_Character'Val (249), | |
190 COBOL_Character'Val (250), COBOL_Character'Val (251), | |
191 COBOL_Character'Val (252), COBOL_Character'Val (253), | |
192 COBOL_Character'Val (254), COBOL_Character'Val (255)); | |
193 | |
194 COBOL_To_Ada : array (COBOL_Character) of Standard.Character := ( | |
195 Standard.Character'Val (000), Standard.Character'Val (001), | |
196 Standard.Character'Val (002), Standard.Character'Val (003), | |
197 Standard.Character'Val (004), Standard.Character'Val (005), | |
198 Standard.Character'Val (006), Standard.Character'Val (007), | |
199 Standard.Character'Val (008), Standard.Character'Val (009), | |
200 Standard.Character'Val (010), Standard.Character'Val (011), | |
201 Standard.Character'Val (012), Standard.Character'Val (013), | |
202 Standard.Character'Val (014), Standard.Character'Val (015), | |
203 Standard.Character'Val (016), Standard.Character'Val (017), | |
204 Standard.Character'Val (018), Standard.Character'Val (019), | |
205 Standard.Character'Val (020), Standard.Character'Val (021), | |
206 Standard.Character'Val (022), Standard.Character'Val (023), | |
207 Standard.Character'Val (024), Standard.Character'Val (025), | |
208 Standard.Character'Val (026), Standard.Character'Val (027), | |
209 Standard.Character'Val (028), Standard.Character'Val (029), | |
210 Standard.Character'Val (030), Standard.Character'Val (031), | |
211 Standard.Character'Val (032), Standard.Character'Val (033), | |
212 Standard.Character'Val (034), Standard.Character'Val (035), | |
213 Standard.Character'Val (036), Standard.Character'Val (037), | |
214 Standard.Character'Val (038), Standard.Character'Val (039), | |
215 Standard.Character'Val (040), Standard.Character'Val (041), | |
216 Standard.Character'Val (042), Standard.Character'Val (043), | |
217 Standard.Character'Val (044), Standard.Character'Val (045), | |
218 Standard.Character'Val (046), Standard.Character'Val (047), | |
219 Standard.Character'Val (048), Standard.Character'Val (049), | |
220 Standard.Character'Val (050), Standard.Character'Val (051), | |
221 Standard.Character'Val (052), Standard.Character'Val (053), | |
222 Standard.Character'Val (054), Standard.Character'Val (055), | |
223 Standard.Character'Val (056), Standard.Character'Val (057), | |
224 Standard.Character'Val (058), Standard.Character'Val (059), | |
225 Standard.Character'Val (060), Standard.Character'Val (061), | |
226 Standard.Character'Val (062), Standard.Character'Val (063), | |
227 Standard.Character'Val (064), Standard.Character'Val (065), | |
228 Standard.Character'Val (066), Standard.Character'Val (067), | |
229 Standard.Character'Val (068), Standard.Character'Val (069), | |
230 Standard.Character'Val (070), Standard.Character'Val (071), | |
231 Standard.Character'Val (072), Standard.Character'Val (073), | |
232 Standard.Character'Val (074), Standard.Character'Val (075), | |
233 Standard.Character'Val (076), Standard.Character'Val (077), | |
234 Standard.Character'Val (078), Standard.Character'Val (079), | |
235 Standard.Character'Val (080), Standard.Character'Val (081), | |
236 Standard.Character'Val (082), Standard.Character'Val (083), | |
237 Standard.Character'Val (084), Standard.Character'Val (085), | |
238 Standard.Character'Val (086), Standard.Character'Val (087), | |
239 Standard.Character'Val (088), Standard.Character'Val (089), | |
240 Standard.Character'Val (090), Standard.Character'Val (091), | |
241 Standard.Character'Val (092), Standard.Character'Val (093), | |
242 Standard.Character'Val (094), Standard.Character'Val (095), | |
243 Standard.Character'Val (096), Standard.Character'Val (097), | |
244 Standard.Character'Val (098), Standard.Character'Val (099), | |
245 Standard.Character'Val (100), Standard.Character'Val (101), | |
246 Standard.Character'Val (102), Standard.Character'Val (103), | |
247 Standard.Character'Val (104), Standard.Character'Val (105), | |
248 Standard.Character'Val (106), Standard.Character'Val (107), | |
249 Standard.Character'Val (108), Standard.Character'Val (109), | |
250 Standard.Character'Val (110), Standard.Character'Val (111), | |
251 Standard.Character'Val (112), Standard.Character'Val (113), | |
252 Standard.Character'Val (114), Standard.Character'Val (115), | |
253 Standard.Character'Val (116), Standard.Character'Val (117), | |
254 Standard.Character'Val (118), Standard.Character'Val (119), | |
255 Standard.Character'Val (120), Standard.Character'Val (121), | |
256 Standard.Character'Val (122), Standard.Character'Val (123), | |
257 Standard.Character'Val (124), Standard.Character'Val (125), | |
258 Standard.Character'Val (126), Standard.Character'Val (127), | |
259 Standard.Character'Val (128), Standard.Character'Val (129), | |
260 Standard.Character'Val (130), Standard.Character'Val (131), | |
261 Standard.Character'Val (132), Standard.Character'Val (133), | |
262 Standard.Character'Val (134), Standard.Character'Val (135), | |
263 Standard.Character'Val (136), Standard.Character'Val (137), | |
264 Standard.Character'Val (138), Standard.Character'Val (139), | |
265 Standard.Character'Val (140), Standard.Character'Val (141), | |
266 Standard.Character'Val (142), Standard.Character'Val (143), | |
267 Standard.Character'Val (144), Standard.Character'Val (145), | |
268 Standard.Character'Val (146), Standard.Character'Val (147), | |
269 Standard.Character'Val (148), Standard.Character'Val (149), | |
270 Standard.Character'Val (150), Standard.Character'Val (151), | |
271 Standard.Character'Val (152), Standard.Character'Val (153), | |
272 Standard.Character'Val (154), Standard.Character'Val (155), | |
273 Standard.Character'Val (156), Standard.Character'Val (157), | |
274 Standard.Character'Val (158), Standard.Character'Val (159), | |
275 Standard.Character'Val (160), Standard.Character'Val (161), | |
276 Standard.Character'Val (162), Standard.Character'Val (163), | |
277 Standard.Character'Val (164), Standard.Character'Val (165), | |
278 Standard.Character'Val (166), Standard.Character'Val (167), | |
279 Standard.Character'Val (168), Standard.Character'Val (169), | |
280 Standard.Character'Val (170), Standard.Character'Val (171), | |
281 Standard.Character'Val (172), Standard.Character'Val (173), | |
282 Standard.Character'Val (174), Standard.Character'Val (175), | |
283 Standard.Character'Val (176), Standard.Character'Val (177), | |
284 Standard.Character'Val (178), Standard.Character'Val (179), | |
285 Standard.Character'Val (180), Standard.Character'Val (181), | |
286 Standard.Character'Val (182), Standard.Character'Val (183), | |
287 Standard.Character'Val (184), Standard.Character'Val (185), | |
288 Standard.Character'Val (186), Standard.Character'Val (187), | |
289 Standard.Character'Val (188), Standard.Character'Val (189), | |
290 Standard.Character'Val (190), Standard.Character'Val (191), | |
291 Standard.Character'Val (192), Standard.Character'Val (193), | |
292 Standard.Character'Val (194), Standard.Character'Val (195), | |
293 Standard.Character'Val (196), Standard.Character'Val (197), | |
294 Standard.Character'Val (198), Standard.Character'Val (199), | |
295 Standard.Character'Val (200), Standard.Character'Val (201), | |
296 Standard.Character'Val (202), Standard.Character'Val (203), | |
297 Standard.Character'Val (204), Standard.Character'Val (205), | |
298 Standard.Character'Val (206), Standard.Character'Val (207), | |
299 Standard.Character'Val (208), Standard.Character'Val (209), | |
300 Standard.Character'Val (210), Standard.Character'Val (211), | |
301 Standard.Character'Val (212), Standard.Character'Val (213), | |
302 Standard.Character'Val (214), Standard.Character'Val (215), | |
303 Standard.Character'Val (216), Standard.Character'Val (217), | |
304 Standard.Character'Val (218), Standard.Character'Val (219), | |
305 Standard.Character'Val (220), Standard.Character'Val (221), | |
306 Standard.Character'Val (222), Standard.Character'Val (223), | |
307 Standard.Character'Val (224), Standard.Character'Val (225), | |
308 Standard.Character'Val (226), Standard.Character'Val (227), | |
309 Standard.Character'Val (228), Standard.Character'Val (229), | |
310 Standard.Character'Val (230), Standard.Character'Val (231), | |
311 Standard.Character'Val (232), Standard.Character'Val (233), | |
312 Standard.Character'Val (234), Standard.Character'Val (235), | |
313 Standard.Character'Val (236), Standard.Character'Val (237), | |
314 Standard.Character'Val (238), Standard.Character'Val (239), | |
315 Standard.Character'Val (240), Standard.Character'Val (241), | |
316 Standard.Character'Val (242), Standard.Character'Val (243), | |
317 Standard.Character'Val (244), Standard.Character'Val (245), | |
318 Standard.Character'Val (246), Standard.Character'Val (247), | |
319 Standard.Character'Val (248), Standard.Character'Val (249), | |
320 Standard.Character'Val (250), Standard.Character'Val (251), | |
321 Standard.Character'Val (252), Standard.Character'Val (253), | |
322 Standard.Character'Val (254), Standard.Character'Val (255)); | |
323 | |
324 type Alphanumeric is array (Positive range <>) of COBOL_Character; | |
325 -- pragma Pack (Alphanumeric); | |
326 | |
327 function To_COBOL (Item : String) return Alphanumeric; | |
328 function To_Ada (Item : Alphanumeric) return String; | |
329 | |
330 procedure To_COBOL | |
331 (Item : String; | |
332 Target : out Alphanumeric; | |
333 Last : out Natural); | |
334 | |
335 procedure To_Ada | |
336 (Item : Alphanumeric; | |
337 Target : out String; | |
338 Last : out Natural); | |
339 | |
340 type Numeric is array (Positive range <>) of COBOL_Character; | |
341 -- pragma Pack (Numeric); | |
342 | |
343 -------------------------------------------- | |
344 -- Formats For COBOL Data Representations -- | |
345 -------------------------------------------- | |
346 | |
347 type Display_Format is private; | |
348 | |
349 Unsigned : constant Display_Format; | |
350 Leading_Separate : constant Display_Format; | |
351 Trailing_Separate : constant Display_Format; | |
352 Leading_Nonseparate : constant Display_Format; | |
353 Trailing_Nonseparate : constant Display_Format; | |
354 | |
355 type Binary_Format is private; | |
356 | |
357 High_Order_First : constant Binary_Format; | |
358 Low_Order_First : constant Binary_Format; | |
359 Native_Binary : constant Binary_Format; | |
360 High_Order_First_Unsigned : constant Binary_Format; | |
361 Low_Order_First_Unsigned : constant Binary_Format; | |
362 Native_Binary_Unsigned : constant Binary_Format; | |
363 | |
364 type Packed_Format is private; | |
365 | |
366 Packed_Unsigned : constant Packed_Format; | |
367 Packed_Signed : constant Packed_Format; | |
368 | |
369 ------------------------------------------------------------ | |
370 -- Types For External Representation Of COBOL Binary Data -- | |
371 ------------------------------------------------------------ | |
372 | |
373 type Byte is mod 2 ** COBOL_Character'Size; | |
374 type Byte_Array is array (Positive range <>) of Byte; | |
375 -- pragma Pack (Byte_Array); | |
376 | |
377 Conversion_Error : exception; | |
378 | |
379 generic | |
380 type Num is delta <> digits <>; | |
381 | |
382 package Decimal_Conversions is | |
383 | |
384 -- Display Formats: data values are represented as Numeric | |
385 | |
386 function Valid | |
387 (Item : Numeric; | |
388 Format : Display_Format) return Boolean; | |
389 | |
390 function Length | |
391 (Format : Display_Format) return Natural; | |
392 | |
393 function To_Decimal | |
394 (Item : Numeric; | |
395 Format : Display_Format) | |
396 return Num; | |
397 | |
398 function To_Display | |
399 (Item : Num; | |
400 Format : Display_Format) return Numeric; | |
401 | |
402 -- Packed Formats: data values are represented as Packed_Decimal | |
403 | |
404 function Valid | |
405 (Item : Packed_Decimal; | |
406 Format : Packed_Format) return Boolean; | |
407 | |
408 function Length | |
409 (Format : Packed_Format) return Natural; | |
410 | |
411 function To_Decimal | |
412 (Item : Packed_Decimal; | |
413 Format : Packed_Format) return Num; | |
414 | |
415 function To_Packed | |
416 (Item : Num; | |
417 Format : Packed_Format) return Packed_Decimal; | |
418 | |
419 -- Binary Formats: external data values are represented as Byte_Array | |
420 | |
421 function Valid | |
422 (Item : Byte_Array; | |
423 Format : Binary_Format) return Boolean; | |
424 | |
425 function Length | |
426 (Format : Binary_Format) | |
427 return Natural; | |
428 | |
429 function To_Decimal | |
430 (Item : Byte_Array; | |
431 Format : Binary_Format) return Num; | |
432 | |
433 function To_Binary | |
434 (Item : Num; | |
435 Format : Binary_Format) return Byte_Array; | |
436 | |
437 -- Internal Binary formats: data values are of type Binary/Long_Binary | |
438 | |
439 function To_Decimal (Item : Binary) return Num; | |
440 function To_Decimal (Item : Long_Binary) return Num; | |
441 | |
442 function To_Binary (Item : Num) return Binary; | |
443 function To_Long_Binary (Item : Num) return Long_Binary; | |
444 | |
445 private | |
446 pragma Inline (Length); | |
447 pragma Inline (To_Binary); | |
448 pragma Inline (To_Decimal); | |
449 pragma Inline (To_Display); | |
450 pragma Inline (To_Long_Binary); | |
451 pragma Inline (Valid); | |
452 | |
453 end Decimal_Conversions; | |
454 | |
455 ------------------------------------------ | |
456 -- Implementation Dependent Definitions -- | |
457 ------------------------------------------ | |
458 | |
459 -- The implementation dependent definitions are wholly contained in the | |
460 -- private part of this spec (the body is implementation independent) | |
461 | |
462 private | |
463 ------------------- | |
464 -- Binary Format -- | |
465 ------------------- | |
466 | |
467 type Binary_Format is (H, L, N, HU, LU, NU); | |
468 | |
469 subtype Binary_Unsigned_Format is Binary_Format range HU .. NU; | |
470 | |
471 High_Order_First : constant Binary_Format := H; | |
472 Low_Order_First : constant Binary_Format := L; | |
473 Native_Binary : constant Binary_Format := N; | |
474 High_Order_First_Unsigned : constant Binary_Format := HU; | |
475 Low_Order_First_Unsigned : constant Binary_Format := LU; | |
476 Native_Binary_Unsigned : constant Binary_Format := NU; | |
477 | |
478 --------------------------- | |
479 -- Packed Decimal Format -- | |
480 --------------------------- | |
481 | |
482 -- Packed decimal numbers use the IBM mainframe format: | |
483 | |
484 -- dd dd ... dd dd ds | |
485 | |
486 -- where d are the Digits, in natural left to right order, and s is | |
487 -- the sign digit. If the number of Digits os even, then the high | |
488 -- order (leftmost) Digits is always a 0. For example, a six digit | |
489 -- number has the format: | |
490 | |
491 -- 0d dd dd ds | |
492 | |
493 -- The sign digit has the possible values | |
494 | |
495 -- 16#0A# non-standard plus sign | |
496 -- 16#0B# non-standard minus sign | |
497 -- 16#0C# standard plus sign | |
498 -- 16#0D# standard minus sign | |
499 -- 16#0E# non-standard plus sign | |
500 -- 16#0F# standard unsigned sign | |
501 | |
502 -- The non-standard signs are recognized on input, but never generated | |
503 -- for output numbers. The 16#0F# distinguishes unsigned numbers from | |
504 -- signed positive numbers, but is treated as positive for computational | |
505 -- purposes. This format provides distinguished positive and negative | |
506 -- zero values, which behave the same in all operations. | |
507 | |
508 type Packed_Format is (U, S); | |
509 | |
510 Packed_Unsigned : constant Packed_Format := U; | |
511 Packed_Signed : constant Packed_Format := S; | |
512 | |
513 type Packed_Representation_Type is (IBM); | |
514 -- Indicator for format used for packed decimal | |
515 | |
516 Packed_Representation : constant Packed_Representation_Type := IBM; | |
517 -- This version of the spec uses IBM internal format, as described above | |
518 | |
519 ----------------------------- | |
520 -- Display Decimal Formats -- | |
521 ----------------------------- | |
522 | |
523 -- Display numbers are stored in standard ASCII format, as ASCII strings. | |
524 -- For the embedded signs, the following codes are used: | |
525 | |
526 -- 0-9 positive: 16#30# .. 16#39# (i.e. natural ASCII digit code) | |
527 -- 0-9 negative: 16#20# .. 16#29# (ASCII digit code - 16#10#) | |
528 | |
529 type Display_Format is (U, LS, TS, LN, TN); | |
530 | |
531 Unsigned : constant Display_Format := U; | |
532 Leading_Separate : constant Display_Format := LS; | |
533 Trailing_Separate : constant Display_Format := TS; | |
534 Leading_Nonseparate : constant Display_Format := LN; | |
535 Trailing_Nonseparate : constant Display_Format := TN; | |
536 | |
537 subtype COBOL_Digits is COBOL_Character range '0' .. '9'; | |
538 -- Digit values in display decimal | |
539 | |
540 COBOL_Space : constant COBOL_Character := ' '; | |
541 COBOL_Plus : constant COBOL_Character := '+'; | |
542 COBOL_Minus : constant COBOL_Character := '-'; | |
543 -- Sign values for Leading_Separate and Trailing_Separate formats | |
544 | |
545 subtype COBOL_Plus_Digits is COBOL_Character | |
546 range COBOL_Character'Val (16#30#) .. COBOL_Character'Val (16#39#); | |
547 -- Values used for embedded plus signs in nonseparate formats | |
548 | |
549 subtype COBOL_Minus_Digits is COBOL_Character | |
550 range COBOL_Character'Val (16#20#) .. COBOL_Character'Val (16#29#); | |
551 -- Values used for embedded minus signs in nonseparate formats | |
552 | |
553 end Interfaces.COBOL; |