File : i-cobol.ads
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-2015, 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 -- --
24 -- --
25 -- --
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;