OpenCores
URL https://opencores.org/ocsvn/scarts/scarts/trunk

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [ada/] [i-cobol.ads] - Blame information for rev 20

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.