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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [s-auxdec-vms_64.ads] - Blame information for rev 801

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

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                       S Y S T E M . A U X _ D E C                        --
6
--                                                                          --
7
--                                 S p e c                                  --
8
--                                                                          --
9
--          Copyright (C) 1996-2010, Free Software Foundation, Inc.         --
10
--                                                                          --
11
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12
-- terms of the  GNU General Public License as published  by the Free Soft- --
13
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
17
--                                                                          --
18
-- As a special exception under Section 7 of GPL version 3, you are granted --
19
-- additional permissions described in the GCC Runtime Library Exception,   --
20
-- version 3.1, as published by the Free Software Foundation.               --
21
--                                                                          --
22
-- You should have received a copy of the GNU General Public License and    --
23
-- a copy of the GCC Runtime Library Exception along with this program;     --
24
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
27
-- GNAT was originally developed  by the GNAT team at  New York University. --
28
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
29
--                                                                          --
30
------------------------------------------------------------------------------
31
 
32
--  This package contains definitions that are designed to be compatible
33
--  with the extra definitions in package System for DEC Ada implementations.
34
 
35
--  These definitions can be used directly by withing this package, or merged
36
--  with System using pragma Extend_System (Aux_DEC)
37
 
38
--  This is the VMS 64 bit version
39
 
40
with Ada.Unchecked_Conversion;
41
 
42
package System.Aux_DEC is
43
   pragma Preelaborate;
44
 
45
   type Short_Integer_Address is
46
     range -2 ** (32 - 1) .. +2 ** (32 - 1) - 1;
47
   --  Integer literals cannot appear naked in an address context, as a
48
   --  result the bounds of Short_Address cannot be given simply as 2^32 etc.
49
 
50
   subtype Short_Address is Address
51
     range Address (Short_Integer_Address'First) ..
52
           Address (Short_Integer_Address'Last);
53
   for Short_Address'Object_Size use 32;
54
   --  This subtype allows addresses to be converted from 64 bits to 32 bits
55
   --  with an appropriate range check. Note that since this is a subtype of
56
   --  type System.Address, the same limitations apply to this subtype. Namely
57
   --  there are no visible arithmetic operations, and integer literals are
58
   --  not available.
59
 
60
   Short_Memory_Size : constant := 2 ** 32;
61
   --  Defined for convenience of porting
62
 
63
   type Integer_8  is range -2 **  (8 - 1) .. +2 **  (8 - 1) - 1;
64
   for Integer_8'Size  use  8;
65
 
66
   type Integer_16 is range -2 ** (16 - 1) .. +2 ** (16 - 1) - 1;
67
   for Integer_16'Size use 16;
68
 
69
   type Integer_32 is range -2 ** (32 - 1) .. +2 ** (32 - 1) - 1;
70
   for Integer_32'Size use 32;
71
 
72
   type Integer_64 is range -2 ** (64 - 1) .. +2 ** (64 - 1) - 1;
73
   for Integer_64'Size use 64;
74
 
75
   type Integer_8_Array  is array (Integer range <>) of Integer_8;
76
   type Integer_16_Array is array (Integer range <>) of Integer_16;
77
   type Integer_32_Array is array (Integer range <>) of Integer_32;
78
   type Integer_64_Array is array (Integer range <>) of Integer_64;
79
   --  These array types are not in all versions of DEC System, and in fact it
80
   --  is not quite clear why they are in some and not others, but since they
81
   --  definitely appear in some versions, we include them unconditionally.
82
 
83
   type Largest_Integer is range Min_Int .. Max_Int;
84
 
85
   type AST_Handler is private;
86
 
87
   No_AST_Handler : constant AST_Handler;
88
 
89
   type Type_Class is
90
     (Type_Class_Enumeration,
91
      Type_Class_Integer,
92
      Type_Class_Fixed_Point,
93
      Type_Class_Floating_Point,
94
      Type_Class_Array,
95
      Type_Class_Record,
96
      Type_Class_Access,
97
      Type_Class_Task,             -- also in Ada 95 protected
98
      Type_Class_Address);
99
 
100
   function "not" (Left        : Largest_Integer) return Largest_Integer;
101
   function "and" (Left, Right : Largest_Integer) return Largest_Integer;
102
   function "or"  (Left, Right : Largest_Integer) return Largest_Integer;
103
   function "xor" (Left, Right : Largest_Integer) return Largest_Integer;
104
 
105
   Address_Zero       : constant Address;
106
   No_Addr            : constant Address;
107
   Address_Size       : constant := Standard'Address_Size;
108
   Short_Address_Size : constant := 32;
109
 
110
   function "+" (Left : Address; Right : Integer) return Address;
111
   function "+" (Left : Integer; Right : Address) return Address;
112
   function "-" (Left : Address; Right : Address) return Integer;
113
   function "-" (Left : Address; Right : Integer) return Address;
114
 
115
   pragma Import (Intrinsic, "+");
116
   pragma Import (Intrinsic, "-");
117
 
118
   generic
119
      type Target is private;
120
   function Fetch_From_Address (A : Address) return Target;
121
 
122
   generic
123
      type Target is private;
124
   procedure Assign_To_Address (A : Address; T : Target);
125
 
126
   --  Floating point type declarations for VAX floating point data types
127
 
128
   pragma Warnings (Off);
129
   --  ??? needs comment
130
 
131
   type F_Float is digits 6;
132
   pragma Float_Representation (VAX_Float, F_Float);
133
 
134
   type D_Float is digits 9;
135
   pragma Float_Representation (Vax_Float, D_Float);
136
 
137
   type G_Float is digits 15;
138
   pragma Float_Representation (Vax_Float, G_Float);
139
 
140
   --  Floating point type declarations for IEEE floating point data types
141
 
142
   type IEEE_Single_Float is digits 6;
143
   pragma Float_Representation (IEEE_Float, IEEE_Single_Float);
144
 
145
   type IEEE_Double_Float is digits 15;
146
   pragma Float_Representation (IEEE_Float, IEEE_Double_Float);
147
 
148
   pragma Warnings (On);
149
 
150
   Non_Ada_Error : exception;
151
 
152
   --  Hardware-oriented types and functions
153
 
154
   type Bit_Array is array (Integer range <>) of Boolean;
155
   pragma Pack (Bit_Array);
156
 
157
   subtype Bit_Array_8  is Bit_Array (0 ..  7);
158
   subtype Bit_Array_16 is Bit_Array (0 .. 15);
159
   subtype Bit_Array_32 is Bit_Array (0 .. 31);
160
   subtype Bit_Array_64 is Bit_Array (0 .. 63);
161
 
162
   type Unsigned_Byte is range 0 .. 255;
163
   for  Unsigned_Byte'Size use 8;
164
 
165
   function "not" (Left        : Unsigned_Byte) return Unsigned_Byte;
166
   function "and" (Left, Right : Unsigned_Byte) return Unsigned_Byte;
167
   function "or"  (Left, Right : Unsigned_Byte) return Unsigned_Byte;
168
   function "xor" (Left, Right : Unsigned_Byte) return Unsigned_Byte;
169
 
170
   function To_Unsigned_Byte (X : Bit_Array_8) return Unsigned_Byte;
171
   function To_Bit_Array_8   (X : Unsigned_Byte) return Bit_Array_8;
172
 
173
   type Unsigned_Byte_Array is array (Integer range <>) of Unsigned_Byte;
174
 
175
   type Unsigned_Word is range 0 .. 65535;
176
   for  Unsigned_Word'Size use 16;
177
 
178
   function "not" (Left        : Unsigned_Word) return Unsigned_Word;
179
   function "and" (Left, Right : Unsigned_Word) return Unsigned_Word;
180
   function "or"  (Left, Right : Unsigned_Word) return Unsigned_Word;
181
   function "xor" (Left, Right : Unsigned_Word) return Unsigned_Word;
182
 
183
   function To_Unsigned_Word (X : Bit_Array_16) return Unsigned_Word;
184
   function To_Bit_Array_16  (X : Unsigned_Word) return Bit_Array_16;
185
 
186
   type Unsigned_Word_Array is array (Integer range <>) of Unsigned_Word;
187
 
188
   type Unsigned_Longword is range -2_147_483_648 .. 2_147_483_647;
189
   for  Unsigned_Longword'Size use 32;
190
 
191
   function "not" (Left        : Unsigned_Longword) return Unsigned_Longword;
192
   function "and" (Left, Right : Unsigned_Longword) return Unsigned_Longword;
193
   function "or"  (Left, Right : Unsigned_Longword) return Unsigned_Longword;
194
   function "xor" (Left, Right : Unsigned_Longword) return Unsigned_Longword;
195
 
196
   function To_Unsigned_Longword (X : Bit_Array_32) return Unsigned_Longword;
197
   function To_Bit_Array_32 (X : Unsigned_Longword) return Bit_Array_32;
198
 
199
   type Unsigned_Longword_Array is
200
      array (Integer range <>) of Unsigned_Longword;
201
 
202
   type Unsigned_32 is range 0 .. 4_294_967_295;
203
   for  Unsigned_32'Size use 32;
204
 
205
   function "not" (Left        : Unsigned_32) return Unsigned_32;
206
   function "and" (Left, Right : Unsigned_32) return Unsigned_32;
207
   function "or"  (Left, Right : Unsigned_32) return Unsigned_32;
208
   function "xor" (Left, Right : Unsigned_32) return Unsigned_32;
209
 
210
   function To_Unsigned_32 (X : Bit_Array_32) return Unsigned_32;
211
   function To_Bit_Array_32 (X : Unsigned_32) return Bit_Array_32;
212
 
213
   type Unsigned_Quadword is record
214
      L0 : Unsigned_Longword;
215
      L1 : Unsigned_Longword;
216
   end record;
217
 
218
   for Unsigned_Quadword'Size      use 64;
219
   for Unsigned_Quadword'Alignment use
220
     Integer'Min (8, Standard'Maximum_Alignment);
221
 
222
   function "not" (Left        : Unsigned_Quadword) return Unsigned_Quadword;
223
   function "and" (Left, Right : Unsigned_Quadword) return Unsigned_Quadword;
224
   function "or"  (Left, Right : Unsigned_Quadword) return Unsigned_Quadword;
225
   function "xor" (Left, Right : Unsigned_Quadword) return Unsigned_Quadword;
226
 
227
   function To_Unsigned_Quadword (X : Bit_Array_64) return Unsigned_Quadword;
228
   function To_Bit_Array_64 (X : Unsigned_Quadword) return Bit_Array_64;
229
 
230
   type Unsigned_Quadword_Array is
231
      array (Integer range <>) of Unsigned_Quadword;
232
 
233
   function To_Address      (X : Integer)           return Short_Address;
234
   pragma Pure_Function (To_Address);
235
 
236
   function To_Address_Long (X : Unsigned_Longword) return Short_Address;
237
   pragma Pure_Function (To_Address_Long);
238
 
239
   function To_Integer      (X : Short_Address)     return Integer;
240
 
241
   function To_Unsigned_Longword (X : Short_Address) return Unsigned_Longword;
242
   function To_Unsigned_Longword (X : AST_Handler)   return Unsigned_Longword;
243
 
244
   --  Conventional names for static subtypes of type UNSIGNED_LONGWORD
245
 
246
   subtype Unsigned_1  is Unsigned_Longword range 0 .. 2** 1-1;
247
   subtype Unsigned_2  is Unsigned_Longword range 0 .. 2** 2-1;
248
   subtype Unsigned_3  is Unsigned_Longword range 0 .. 2** 3-1;
249
   subtype Unsigned_4  is Unsigned_Longword range 0 .. 2** 4-1;
250
   subtype Unsigned_5  is Unsigned_Longword range 0 .. 2** 5-1;
251
   subtype Unsigned_6  is Unsigned_Longword range 0 .. 2** 6-1;
252
   subtype Unsigned_7  is Unsigned_Longword range 0 .. 2** 7-1;
253
   subtype Unsigned_8  is Unsigned_Longword range 0 .. 2** 8-1;
254
   subtype Unsigned_9  is Unsigned_Longword range 0 .. 2** 9-1;
255
   subtype Unsigned_10 is Unsigned_Longword range 0 .. 2**10-1;
256
   subtype Unsigned_11 is Unsigned_Longword range 0 .. 2**11-1;
257
   subtype Unsigned_12 is Unsigned_Longword range 0 .. 2**12-1;
258
   subtype Unsigned_13 is Unsigned_Longword range 0 .. 2**13-1;
259
   subtype Unsigned_14 is Unsigned_Longword range 0 .. 2**14-1;
260
   subtype Unsigned_15 is Unsigned_Longword range 0 .. 2**15-1;
261
   subtype Unsigned_16 is Unsigned_Longword range 0 .. 2**16-1;
262
   subtype Unsigned_17 is Unsigned_Longword range 0 .. 2**17-1;
263
   subtype Unsigned_18 is Unsigned_Longword range 0 .. 2**18-1;
264
   subtype Unsigned_19 is Unsigned_Longword range 0 .. 2**19-1;
265
   subtype Unsigned_20 is Unsigned_Longword range 0 .. 2**20-1;
266
   subtype Unsigned_21 is Unsigned_Longword range 0 .. 2**21-1;
267
   subtype Unsigned_22 is Unsigned_Longword range 0 .. 2**22-1;
268
   subtype Unsigned_23 is Unsigned_Longword range 0 .. 2**23-1;
269
   subtype Unsigned_24 is Unsigned_Longword range 0 .. 2**24-1;
270
   subtype Unsigned_25 is Unsigned_Longword range 0 .. 2**25-1;
271
   subtype Unsigned_26 is Unsigned_Longword range 0 .. 2**26-1;
272
   subtype Unsigned_27 is Unsigned_Longword range 0 .. 2**27-1;
273
   subtype Unsigned_28 is Unsigned_Longword range 0 .. 2**28-1;
274
   subtype Unsigned_29 is Unsigned_Longword range 0 .. 2**29-1;
275
   subtype Unsigned_30 is Unsigned_Longword range 0 .. 2**30-1;
276
   subtype Unsigned_31 is Unsigned_Longword range 0 .. 2**31-1;
277
 
278
   --  Function for obtaining global symbol values
279
 
280
   function Import_Value         (Symbol : String) return Unsigned_Longword;
281
   function Import_Address       (Symbol : String) return Address;
282
   function Import_Largest_Value (Symbol : String) return Largest_Integer;
283
 
284
   pragma Import (Intrinsic, Import_Value);
285
   pragma Import (Intrinsic, Import_Address);
286
   pragma Import (Intrinsic, Import_Largest_Value);
287
 
288
   --  For the following declarations, note that the declaration without a
289
   --  Retry_Count parameter means to retry infinitely. A value of zero for
290
   --  the Retry_Count parameter means do not retry.
291
 
292
   --  Interlocked-instruction procedures
293
 
294
   procedure Clear_Interlocked
295
     (Bit       : in out Boolean;
296
      Old_Value : out Boolean);
297
 
298
   procedure Set_Interlocked
299
     (Bit       : in out Boolean;
300
      Old_Value : out Boolean);
301
 
302
   type Aligned_Word is record
303
      Value : Short_Integer;
304
   end record;
305
 
306
   for Aligned_Word'Alignment use Integer'Min (2, Standard'Maximum_Alignment);
307
 
308
   procedure Clear_Interlocked
309
     (Bit          : in out Boolean;
310
      Old_Value    : out Boolean;
311
      Retry_Count  : Natural;
312
      Success_Flag : out Boolean);
313
 
314
   procedure Set_Interlocked
315
     (Bit          : in out Boolean;
316
      Old_Value    : out Boolean;
317
      Retry_Count  : Natural;
318
      Success_Flag : out Boolean);
319
 
320
   procedure Add_Interlocked
321
     (Addend       : Short_Integer;
322
      Augend       : in out Aligned_Word;
323
      Sign         : out Integer);
324
 
325
   type Aligned_Integer is record
326
      Value : Integer;
327
   end record;
328
 
329
   for Aligned_Integer'Alignment use
330
     Integer'Min (4, Standard'Maximum_Alignment);
331
 
332
   type Aligned_Long_Integer is record
333
      Value : Long_Integer;
334
   end record;
335
 
336
   for Aligned_Long_Integer'Alignment use
337
     Integer'Min (8, Standard'Maximum_Alignment);
338
 
339
   --  For the following declarations, note that the declaration without a
340
   --  Retry_Count parameter mean to retry infinitely. A value of zero for
341
   --  the Retry_Count means do not retry.
342
 
343
   procedure Add_Atomic
344
     (To           : in out Aligned_Integer;
345
      Amount       : Integer);
346
 
347
   procedure Add_Atomic
348
     (To           : in out Aligned_Integer;
349
      Amount       : Integer;
350
      Retry_Count  : Natural;
351
      Old_Value    : out Integer;
352
      Success_Flag : out Boolean);
353
 
354
   procedure Add_Atomic
355
     (To           : in out Aligned_Long_Integer;
356
      Amount       : Long_Integer);
357
 
358
   procedure Add_Atomic
359
     (To           : in out Aligned_Long_Integer;
360
      Amount       : Long_Integer;
361
      Retry_Count  : Natural;
362
      Old_Value    : out Long_Integer;
363
      Success_Flag : out Boolean);
364
 
365
   procedure And_Atomic
366
     (To           : in out Aligned_Integer;
367
      From         : Integer);
368
 
369
   procedure And_Atomic
370
     (To           : in out Aligned_Integer;
371
      From         : Integer;
372
      Retry_Count  : Natural;
373
      Old_Value    : out Integer;
374
      Success_Flag : out Boolean);
375
 
376
   procedure And_Atomic
377
     (To           : in out Aligned_Long_Integer;
378
      From         : Long_Integer);
379
 
380
   procedure And_Atomic
381
     (To           : in out Aligned_Long_Integer;
382
      From         : Long_Integer;
383
      Retry_Count  : Natural;
384
      Old_Value    : out Long_Integer;
385
      Success_Flag : out Boolean);
386
 
387
   procedure Or_Atomic
388
     (To           : in out Aligned_Integer;
389
      From         : Integer);
390
 
391
   procedure Or_Atomic
392
     (To           : in out Aligned_Integer;
393
      From         : Integer;
394
      Retry_Count  : Natural;
395
      Old_Value    : out Integer;
396
      Success_Flag : out Boolean);
397
 
398
   procedure Or_Atomic
399
     (To           : in out Aligned_Long_Integer;
400
      From         : Long_Integer);
401
 
402
   procedure Or_Atomic
403
     (To           : in out Aligned_Long_Integer;
404
      From         : Long_Integer;
405
      Retry_Count  : Natural;
406
      Old_Value    : out Long_Integer;
407
      Success_Flag : out Boolean);
408
 
409
   type Insq_Status is (Fail_No_Lock, OK_Not_First, OK_First);
410
 
411
   for Insq_Status use
412
     (Fail_No_Lock => -1,
413
      OK_Not_First =>  0,
414
      OK_First     => +1);
415
 
416
   type Remq_Status is (
417
     Fail_No_Lock,
418
     Fail_Was_Empty,
419
     OK_Not_Empty,
420
     OK_Empty);
421
 
422
   for Remq_Status use
423
     (Fail_No_Lock   => -1,
424
      Fail_Was_Empty =>  0,
425
      OK_Not_Empty   => +1,
426
      OK_Empty       => +2);
427
 
428
   procedure Insqhi
429
     (Item   : Address;
430
      Header : Address;
431
      Status : out Insq_Status);
432
 
433
   procedure Remqhi
434
     (Header : Address;
435
      Item   : out Address;
436
      Status : out Remq_Status);
437
 
438
   procedure Insqti
439
     (Item   : Address;
440
      Header : Address;
441
      Status : out Insq_Status);
442
 
443
   procedure Remqti
444
     (Header : Address;
445
      Item   : out Address;
446
      Status : out Remq_Status);
447
 
448
private
449
 
450
   Address_Zero : constant Address := Null_Address;
451
   No_Addr      : constant Address := Null_Address;
452
 
453
   --  An AST_Handler value is from a typing point of view simply a pointer
454
   --  to a procedure taking a single 64 bit parameter. However, this
455
   --  is a bit misleading, because the data that this pointer references is
456
   --  highly stylized. See body of System.AST_Handling for full details.
457
 
458
   type AST_Handler is access procedure (Param : Long_Integer);
459
   No_AST_Handler : constant AST_Handler := null;
460
 
461
   --  Other operators have incorrect profiles. It would be nice to make
462
   --  them intrinsic, since the backend can handle them, but the front
463
   --  end is not prepared to deal with them, so at least inline them.
464
 
465
   pragma Import (Intrinsic, "not");
466
   pragma Import (Intrinsic, "and");
467
   pragma Import (Intrinsic, "or");
468
   pragma Import (Intrinsic, "xor");
469
 
470
   --  Other inlined subprograms
471
 
472
   pragma Inline_Always (Fetch_From_Address);
473
   pragma Inline_Always (Assign_To_Address);
474
 
475
   --  Synchronization related subprograms. Mechanism is explicitly set
476
   --  so that the critical parameters are passed by reference.
477
   --  Without this, the parameters are passed by copy, creating load/store
478
   --  race conditions. We also inline them, since this seems more in the
479
   --  spirit of the original (hardware intrinsic) routines.
480
 
481
   pragma Export_Procedure
482
     (Clear_Interlocked,
483
      External        => "system__aux_dec__clear_interlocked__1",
484
      Parameter_Types => (Boolean, Boolean),
485
      Mechanism       => (Reference, Reference));
486
   pragma Export_Procedure
487
     (Clear_Interlocked,
488
      External        => "system__aux_dec__clear_interlocked__2",
489
      Parameter_Types => (Boolean, Boolean, Natural, Boolean),
490
      Mechanism       => (Reference, Reference, Value, Reference));
491
   pragma Inline_Always (Clear_Interlocked);
492
 
493
   pragma Export_Procedure
494
     (Set_Interlocked,
495
      External        => "system__aux_dec__set_interlocked__1",
496
      Parameter_Types => (Boolean, Boolean),
497
      Mechanism       => (Reference, Reference));
498
   pragma Export_Procedure
499
     (Set_Interlocked,
500
      External        => "system__aux_dec__set_interlocked__2",
501
      Parameter_Types => (Boolean, Boolean, Natural, Boolean),
502
      Mechanism       => (Reference, Reference, Value, Reference));
503
   pragma Inline_Always (Set_Interlocked);
504
 
505
   pragma Export_Procedure
506
     (Add_Interlocked,
507
      External        => "system__aux_dec__add_interlocked__1",
508
      Mechanism       => (Value, Reference, Reference));
509
   pragma Inline_Always (Add_Interlocked);
510
 
511
   pragma Export_Procedure
512
     (Add_Atomic,
513
      External        => "system__aux_dec__add_atomic__1",
514
      Parameter_Types => (Aligned_Integer, Integer),
515
      Mechanism       => (Reference, Value));
516
   pragma Export_Procedure
517
     (Add_Atomic,
518
      External        => "system__aux_dec__add_atomic__2",
519
      Parameter_Types => (Aligned_Integer, Integer, Natural, Integer, Boolean),
520
      Mechanism       => (Reference, Value, Value, Reference, Reference));
521
   pragma Export_Procedure
522
     (Add_Atomic,
523
      External        => "system__aux_dec__add_atomic__3",
524
      Parameter_Types => (Aligned_Long_Integer, Long_Integer),
525
      Mechanism       => (Reference, Value));
526
   pragma Export_Procedure
527
     (Add_Atomic,
528
      External        => "system__aux_dec__add_atomic__4",
529
      Parameter_Types => (Aligned_Long_Integer, Long_Integer, Natural,
530
                          Long_Integer, Boolean),
531
      Mechanism       => (Reference, Value, Value, Reference, Reference));
532
   pragma Inline_Always (Add_Atomic);
533
 
534
   pragma Export_Procedure
535
     (And_Atomic,
536
      External        => "system__aux_dec__and_atomic__1",
537
      Parameter_Types => (Aligned_Integer, Integer),
538
      Mechanism       => (Reference, Value));
539
   pragma Export_Procedure
540
     (And_Atomic,
541
      External        => "system__aux_dec__and_atomic__2",
542
      Parameter_Types => (Aligned_Integer, Integer, Natural, Integer, Boolean),
543
      Mechanism       => (Reference, Value, Value, Reference, Reference));
544
   pragma Export_Procedure
545
     (And_Atomic,
546
      External        => "system__aux_dec__and_atomic__3",
547
      Parameter_Types => (Aligned_Long_Integer, Long_Integer),
548
      Mechanism       => (Reference, Value));
549
   pragma Export_Procedure
550
     (And_Atomic,
551
      External        => "system__aux_dec__and_atomic__4",
552
      Parameter_Types => (Aligned_Long_Integer, Long_Integer, Natural,
553
                          Long_Integer, Boolean),
554
      Mechanism       => (Reference, Value, Value, Reference, Reference));
555
   pragma Inline_Always (And_Atomic);
556
 
557
   pragma Export_Procedure
558
     (Or_Atomic,
559
      External        => "system__aux_dec__or_atomic__1",
560
      Parameter_Types => (Aligned_Integer, Integer),
561
      Mechanism       => (Reference, Value));
562
   pragma Export_Procedure
563
     (Or_Atomic,
564
      External        => "system__aux_dec__or_atomic__2",
565
      Parameter_Types => (Aligned_Integer, Integer, Natural, Integer, Boolean),
566
      Mechanism       => (Reference, Value, Value, Reference, Reference));
567
   pragma Export_Procedure
568
     (Or_Atomic,
569
      External        => "system__aux_dec__or_atomic__3",
570
      Parameter_Types => (Aligned_Long_Integer, Long_Integer),
571
      Mechanism       => (Reference, Value));
572
   pragma Export_Procedure
573
     (Or_Atomic,
574
      External        => "system__aux_dec__or_atomic__4",
575
      Parameter_Types => (Aligned_Long_Integer, Long_Integer, Natural,
576
                          Long_Integer, Boolean),
577
      Mechanism       => (Reference, Value, Value, Reference, Reference));
578
   pragma Inline_Always (Or_Atomic);
579
 
580
   --  Inline the VAX Queue Functions
581
 
582
   pragma Inline_Always (Insqhi);
583
   pragma Inline_Always (Remqhi);
584
   pragma Inline_Always (Insqti);
585
   pragma Inline_Always (Remqti);
586
 
587
   --  Provide proper unchecked conversion definitions for transfer
588
   --  functions. Note that we need this level of indirection because
589
   --  the formal parameter name is X and not Source (and this is indeed
590
   --  detectable by a program)
591
 
592
   function To_Unsigned_Byte_A is new
593
     Ada.Unchecked_Conversion (Bit_Array_8, Unsigned_Byte);
594
 
595
   function To_Unsigned_Byte (X : Bit_Array_8) return Unsigned_Byte
596
     renames To_Unsigned_Byte_A;
597
 
598
   function To_Bit_Array_8_A is new
599
     Ada.Unchecked_Conversion (Unsigned_Byte, Bit_Array_8);
600
 
601
   function To_Bit_Array_8 (X : Unsigned_Byte) return Bit_Array_8
602
     renames To_Bit_Array_8_A;
603
 
604
   function To_Unsigned_Word_A is new
605
     Ada.Unchecked_Conversion (Bit_Array_16, Unsigned_Word);
606
 
607
   function To_Unsigned_Word (X : Bit_Array_16) return Unsigned_Word
608
     renames To_Unsigned_Word_A;
609
 
610
   function To_Bit_Array_16_A is new
611
     Ada.Unchecked_Conversion (Unsigned_Word, Bit_Array_16);
612
 
613
   function To_Bit_Array_16 (X : Unsigned_Word) return Bit_Array_16
614
     renames To_Bit_Array_16_A;
615
 
616
   function To_Unsigned_Longword_A is new
617
     Ada.Unchecked_Conversion (Bit_Array_32, Unsigned_Longword);
618
 
619
   function To_Unsigned_Longword (X : Bit_Array_32) return Unsigned_Longword
620
     renames To_Unsigned_Longword_A;
621
 
622
   function To_Bit_Array_32_A is new
623
     Ada.Unchecked_Conversion (Unsigned_Longword, Bit_Array_32);
624
 
625
   function To_Bit_Array_32 (X : Unsigned_Longword) return Bit_Array_32
626
     renames To_Bit_Array_32_A;
627
 
628
   function To_Unsigned_32_A is new
629
     Ada.Unchecked_Conversion (Bit_Array_32, Unsigned_32);
630
 
631
   function To_Unsigned_32 (X : Bit_Array_32) return Unsigned_32
632
     renames To_Unsigned_32_A;
633
 
634
   function To_Bit_Array_32_A is new
635
     Ada.Unchecked_Conversion (Unsigned_32, Bit_Array_32);
636
 
637
   function To_Bit_Array_32 (X : Unsigned_32) return Bit_Array_32
638
     renames To_Bit_Array_32_A;
639
 
640
   function To_Unsigned_Quadword_A is new
641
     Ada.Unchecked_Conversion (Bit_Array_64, Unsigned_Quadword);
642
 
643
   function To_Unsigned_Quadword (X : Bit_Array_64) return Unsigned_Quadword
644
     renames To_Unsigned_Quadword_A;
645
 
646
   function To_Bit_Array_64_A is new
647
     Ada.Unchecked_Conversion (Unsigned_Quadword, Bit_Array_64);
648
 
649
   function To_Bit_Array_64 (X : Unsigned_Quadword) return Bit_Array_64
650
     renames To_Bit_Array_64_A;
651
 
652
   pragma Warnings (Off);
653
   --  Turn warnings off. This is needed for systems with 64-bit integers,
654
   --  where some of these operations are of dubious meaning, but we do not
655
   --  want warnings when we compile on such systems.
656
 
657
   function To_Address_A is new
658
     Ada.Unchecked_Conversion (Integer, Short_Address);
659
   pragma Pure_Function (To_Address_A);
660
 
661
   function To_Address (X : Integer) return Short_Address
662
     renames To_Address_A;
663
   pragma Pure_Function (To_Address);
664
 
665
   function To_Address_Long_A is new
666
     Ada.Unchecked_Conversion (Unsigned_Longword, Short_Address);
667
   pragma Pure_Function (To_Address_Long_A);
668
 
669
   function To_Address_Long (X : Unsigned_Longword) return Short_Address
670
     renames To_Address_Long_A;
671
   pragma Pure_Function (To_Address_Long);
672
 
673
   function To_Integer_A is new
674
     Ada.Unchecked_Conversion (Short_Address, Integer);
675
 
676
   function To_Integer (X : Short_Address) return Integer
677
     renames To_Integer_A;
678
 
679
   function To_Unsigned_Longword_A is new
680
     Ada.Unchecked_Conversion (Short_Address, Unsigned_Longword);
681
 
682
   function To_Unsigned_Longword (X : Short_Address) return Unsigned_Longword
683
     renames To_Unsigned_Longword_A;
684
 
685
   function To_Unsigned_Longword_A is new
686
     Ada.Unchecked_Conversion (AST_Handler, Unsigned_Longword);
687
 
688
   function To_Unsigned_Longword (X : AST_Handler) return Unsigned_Longword
689
     renames To_Unsigned_Longword_A;
690
 
691
   pragma Warnings (On);
692
 
693
end System.Aux_DEC;

powered by: WebSVN 2.1.0

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