gcc/ada/s-auxdec.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                       S Y S T E M . A U X _ D E C                        --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                            $Revision: 1.11 $
  10 --                                                                          --
  11 --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/Or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  Or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- Or FITNESS FOr A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- fOr  mOre details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- As a special exception,  if other files  instantiate  generics from this --
  25 -- unit, Or you link  this unit with other files  to produce an executable, --
  26 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  27 -- covered  by the  GNU  General  Public  License.  This exception does not --
  28 -- however invalidate  any other reasons why  the executable file  might be --
  29 -- covered by the  GNU Public License.                                      --
  30 --                                                                          --
  31 -- GNAT was Originally developed  by the GNAT team at  New YOrk University. --
  32 -- It is now maintained by Ada COre Technologies Inc (http://www.gnat.com). --
  33 --                                                                          --
  34 ------------------------------------------------------------------------------
  35
  36 pragma Style_Checks (All_Checks);
  37 --  Turn off alpha ordering check on subprograms, this unit is laid
  38 --  out to correspond to the declarations in the DEC 83 System unit.
  39
  40 with System.Soft_Links;
  41
  42 package body System.Aux_DEC is
  43
  44    package SSL renames System.Soft_Links;
  45
  46    -----------------------------------
  47    -- Operations on Largest_Integer --
  48    -----------------------------------
  49
  50    --  It would be nice to replace these with intrinsics, but that does
  51    --  not work yet (the back end would be ok, but GNAT itself objects)
  52
  53    type LIU is mod 2 ** Largest_Integer'Size;
  54    --  Unsigned type of same length as Largest_Integer
  55
  56    function To_LI   is new Unchecked_Conversion (LIU, Largest_Integer);
  57    function From_LI is new Unchecked_Conversion (Largest_Integer, LIU);
  58
  59    function "not" (Left : Largest_Integer) return Largest_Integer is
  60    begin
  61       return To_LI (not From_LI (Left));
  62    end "not";
  63
  64    function "and" (Left, Right : Largest_Integer) return Largest_Integer is
  65    begin
  66       return To_LI (From_LI (Left) and From_LI (Right));
  67    end "and";
  68
  69    function "or"  (Left, Right : Largest_Integer) return Largest_Integer is
  70    begin
  71       return To_LI (From_LI (Left) or From_LI (Right));
  72    end "or";
  73
  74    function "xor" (Left, Right : Largest_Integer) return Largest_Integer is
  75    begin
  76       return To_LI (From_LI (Left) xor From_LI (Right));
  77    end "xor";
  78
  79    --------------------------------------
  80    -- Arithmetic Operations on Address --
  81    --------------------------------------
  82
  83    --  It would be nice to replace these with intrinsics, but that does
  84    --  not work yet (the back end would be ok, but GNAT itself objects)
  85
  86    Asiz : constant Integer := Integer (Address'Size) - 1;
  87
  88    type SA is range -(2 ** Asiz) .. 2 ** Asiz - 1;
  89    --  Signed type of same size as Address
  90
  91    function To_A   is new Unchecked_Conversion (SA, Address);
  92    function From_A is new Unchecked_Conversion (Address, SA);
  93
  94    function "+" (Left : Address; Right : Integer) return Address is
  95    begin
  96       return To_A (From_A (Left) + SA (Right));
  97    end "+";
  98
  99    function "+" (Left : Integer; Right : Address) return Address is
 100    begin
 101       return To_A (SA (Left) + From_A (Right));
 102    end "+";
 103
 104    function "-" (Left : Address; Right : Address) return Integer is
 105       pragma Unsuppress (All_Checks);
 106       --  Because this can raise Constraint_Error for 64-bit addresses
 107
 108    begin
 109       return Integer (From_A (Left - Right));
 110    end "-";
 111
 112    function "-" (Left : Address; Right : Integer) return Address is
 113    begin
 114       return To_A (From_A (Left) - SA (Right));
 115    end "-";
 116
 117    ------------------------
 118    -- Fetch_From_Address --
 119    ------------------------
 120
 121    function Fetch_From_Address (A : Address) return Target is
 122       type T_Ptr is access all Target;
 123       function To_T_Ptr is new Unchecked_Conversion (Address, T_Ptr);
 124       Ptr : constant T_Ptr := To_T_Ptr (A);
 125
 126    begin
 127       return Ptr.all;
 128    end Fetch_From_Address;
 129
 130    -----------------------
 131    -- Assign_To_Address --
 132    -----------------------
 133
 134    procedure Assign_To_Address (A : Address; T : Target) is
 135       type T_Ptr is access all Target;
 136       function To_T_Ptr is new Unchecked_Conversion (Address, T_Ptr);
 137       Ptr : constant T_Ptr := To_T_Ptr (A);
 138
 139    begin
 140       Ptr.all := T;
 141    end Assign_To_Address;
 142
 143    ---------------------------------
 144    -- Operations on Unsigned_Byte --
 145    ---------------------------------
 146
 147    --  It would be nice to replace these with intrinsics, but that does
 148    --  not work yet (the back end would be ok, but GNAT itself objects)
 149
 150    type BU is mod 2 ** Unsigned_Byte'Size;
 151    --  Unsigned type of same length as Unsigned_Byte
 152
 153    function To_B   is new Unchecked_Conversion (BU, Unsigned_Byte);
 154    function From_B is new Unchecked_Conversion (Unsigned_Byte, BU);
 155
 156    function "not" (Left : Unsigned_Byte) return Unsigned_Byte is
 157    begin
 158       return To_B (not From_B (Left));
 159    end "not";
 160
 161    function "and" (Left, Right : Unsigned_Byte) return Unsigned_Byte is
 162    begin
 163       return To_B (From_B (Left) and From_B (Right));
 164    end "and";
 165
 166    function "or"  (Left, Right : Unsigned_Byte) return Unsigned_Byte is
 167    begin
 168       return To_B (From_B (Left) or From_B (Right));
 169    end "or";
 170
 171    function "xor" (Left, Right : Unsigned_Byte) return Unsigned_Byte is
 172    begin
 173       return To_B (From_B (Left) xor From_B (Right));
 174    end "xor";
 175
 176    ---------------------------------
 177    -- Operations on Unsigned_Word --
 178    ---------------------------------
 179
 180    --  It would be nice to replace these with intrinsics, but that does
 181    --  not work yet (the back end would be ok, but GNAT itself objects)
 182
 183    type WU is mod 2 ** Unsigned_Word'Size;
 184    --  Unsigned type of same length as Unsigned_Word
 185
 186    function To_W   is new Unchecked_Conversion (WU, Unsigned_Word);
 187    function From_W is new Unchecked_Conversion (Unsigned_Word, WU);
 188
 189    function "not" (Left : Unsigned_Word) return Unsigned_Word is
 190    begin
 191       return To_W (not From_W (Left));
 192    end "not";
 193
 194    function "and" (Left, Right : Unsigned_Word) return Unsigned_Word is
 195    begin
 196       return To_W (From_W (Left) and From_W (Right));
 197    end "and";
 198
 199    function "or"  (Left, Right : Unsigned_Word) return Unsigned_Word is
 200    begin
 201       return To_W (From_W (Left) or From_W (Right));
 202    end "or";
 203
 204    function "xor" (Left, Right : Unsigned_Word) return Unsigned_Word is
 205    begin
 206       return To_W (From_W (Left) xor From_W (Right));
 207    end "xor";
 208
 209    -------------------------------------
 210    -- Operations on Unsigned_Longword --
 211    -------------------------------------
 212
 213    --  It would be nice to replace these with intrinsics, but that does
 214    --  not work yet (the back end would be ok, but GNAT itself objects)
 215
 216    type LWU is mod 2 ** Unsigned_Longword'Size;
 217    --  Unsigned type of same length as Unsigned_Longword
 218
 219    function To_LW   is new Unchecked_Conversion (LWU, Unsigned_Longword);
 220    function From_LW is new Unchecked_Conversion (Unsigned_Longword, LWU);
 221
 222    function "not" (Left : Unsigned_Longword) return Unsigned_Longword is
 223    begin
 224       return To_LW (not From_LW (Left));
 225    end "not";
 226
 227    function "and" (Left, Right : Unsigned_Longword) return Unsigned_Longword is
 228    begin
 229       return To_LW (From_LW (Left) and From_LW (Right));
 230    end "and";
 231
 232    function "or"  (Left, Right : Unsigned_Longword) return Unsigned_Longword is
 233    begin
 234       return To_LW (From_LW (Left) or From_LW (Right));
 235    end "or";
 236
 237    function "xor" (Left, Right : Unsigned_Longword) return Unsigned_Longword is
 238    begin
 239       return To_LW (From_LW (Left) xor From_LW (Right));
 240    end "xor";
 241
 242    -------------------------------
 243    -- Operations on Unsigned_32 --
 244    -------------------------------
 245
 246    --  It would be nice to replace these with intrinsics, but that does
 247    --  not work yet (the back end would be ok, but GNAT itself objects)
 248
 249    type U32 is mod 2 ** Unsigned_32'Size;
 250    --  Unsigned type of same length as Unsigned_32
 251
 252    function To_U32   is new Unchecked_Conversion (U32, Unsigned_32);
 253    function From_U32 is new Unchecked_Conversion (Unsigned_32, U32);
 254
 255    function "not" (Left : Unsigned_32) return Unsigned_32 is
 256    begin
 257       return To_U32 (not From_U32 (Left));
 258    end "not";
 259
 260    function "and" (Left, Right : Unsigned_32) return Unsigned_32 is
 261    begin
 262       return To_U32 (From_U32 (Left) and From_U32 (Right));
 263    end "and";
 264
 265    function "or"  (Left, Right : Unsigned_32) return Unsigned_32 is
 266    begin
 267       return To_U32 (From_U32 (Left) or From_U32 (Right));
 268    end "or";
 269
 270    function "xor" (Left, Right : Unsigned_32) return Unsigned_32 is
 271    begin
 272       return To_U32 (From_U32 (Left) xor From_U32 (Right));
 273    end "xor";
 274
 275    -------------------------------------
 276    -- Operations on Unsigned_Quadword --
 277    -------------------------------------
 278
 279    --  It would be nice to replace these with intrinsics, but that does
 280    --  not work yet (the back end would be ok, but GNAT itself objects)
 281
 282    type QWU is mod 2 ** 64;  -- 64 = Unsigned_Quadword'Size
 283    --  Unsigned type of same length as Unsigned_Quadword
 284
 285    function To_QW   is new Unchecked_Conversion (QWU, Unsigned_Quadword);
 286    function From_QW is new Unchecked_Conversion (Unsigned_Quadword, QWU);
 287
 288    function "not" (Left : Unsigned_Quadword) return Unsigned_Quadword is
 289    begin
 290       return To_QW (not From_QW (Left));
 291    end "not";
 292
 293    function "and" (Left, Right : Unsigned_Quadword) return Unsigned_Quadword is
 294    begin
 295       return To_QW (From_QW (Left) and From_QW (Right));
 296    end "and";
 297
 298    function "or"  (Left, Right : Unsigned_Quadword) return Unsigned_Quadword is
 299    begin
 300       return To_QW (From_QW (Left) or From_QW (Right));
 301    end "or";
 302
 303    function "xor" (Left, Right : Unsigned_Quadword) return Unsigned_Quadword is
 304    begin
 305       return To_QW (From_QW (Left) xor From_QW (Right));
 306    end "xor";
 307
 308    -----------------------
 309    -- Clear_Interlocked --
 310    -----------------------
 311
 312    procedure Clear_Interlocked
 313      (Bit       : in out Boolean;
 314       Old_Value : out Boolean)
 315    is
 316    begin
 317       SSL.Lock_Task.all;
 318       Old_Value := Bit;
 319       Bit := False;
 320       SSL.Unlock_Task.all;
 321    end Clear_Interlocked;
 322
 323    procedure Clear_Interlocked
 324      (Bit          : in out Boolean;
 325       Old_Value    : out Boolean;
 326       Retry_Count  : in Natural;
 327       Success_Flag : out Boolean)
 328    is
 329    begin
 330       SSL.Lock_Task.all;
 331       Old_Value := Bit;
 332       Bit := False;
 333       Success_Flag := True;
 334       SSL.Unlock_Task.all;
 335    end Clear_Interlocked;
 336
 337    ---------------------
 338    -- Set_Interlocked --
 339    ---------------------
 340
 341    procedure Set_Interlocked
 342      (Bit       : in out Boolean;
 343       Old_Value : out Boolean)
 344    is
 345    begin
 346       SSL.Lock_Task.all;
 347       Old_Value := Bit;
 348       Bit := True;
 349       SSL.Unlock_Task.all;
 350    end Set_Interlocked;
 351
 352    procedure Set_Interlocked
 353      (Bit          : in out Boolean;
 354       Old_Value    : out Boolean;
 355       Retry_Count  : in Natural;
 356       Success_Flag : out Boolean)
 357    is
 358    begin
 359       SSL.Lock_Task.all;
 360       Old_Value := Bit;
 361       Bit := True;
 362       Success_Flag := True;
 363       SSL.Unlock_Task.all;
 364    end Set_Interlocked;
 365
 366    ---------------------
 367    -- Add_Interlocked --
 368    ---------------------
 369
 370    procedure Add_Interlocked
 371      (Addend       : in Short_Integer;
 372       Augend       : in out Aligned_Word;
 373       Sign         : out Integer)
 374    is
 375    begin
 376       SSL.Lock_Task.all;
 377       Augend.Value := Augend.Value + Addend;
 378
 379       if Augend.Value < 0 then
 380          Sign := -1;
 381       elsif Augend.Value > 0 then
 382          Sign := +1;
 383       else
 384          Sign := 0;
 385       end if;
 386
 387       SSL.Unlock_Task.all;
 388    end Add_Interlocked;
 389
 390    ----------------
 391    -- Add_Atomic --
 392    ----------------
 393
 394    procedure Add_Atomic
 395      (To           : in out Aligned_Integer;
 396       Amount       : in Integer)
 397    is
 398    begin
 399       SSL.Lock_Task.all;
 400       To.Value := To.Value + Amount;
 401       SSL.Unlock_Task.all;
 402    end Add_Atomic;
 403
 404    procedure Add_Atomic
 405      (To           : in out Aligned_Integer;
 406       Amount       : in Integer;
 407       Retry_Count  : in Natural;
 408       Old_Value    : out Integer;
 409       Success_Flag : out Boolean)
 410    is
 411    begin
 412       SSL.Lock_Task.all;
 413       Old_Value := To.Value;
 414       To.Value  := To.Value + Amount;
 415       Success_Flag := True;
 416       SSL.Unlock_Task.all;
 417    end Add_Atomic;
 418
 419    procedure Add_Atomic
 420      (To           : in out Aligned_Long_Integer;
 421       Amount       : in Long_Integer)
 422    is
 423    begin
 424       SSL.Lock_Task.all;
 425       To.Value := To.Value + Amount;
 426       SSL.Unlock_Task.all;
 427    end Add_Atomic;
 428
 429    procedure Add_Atomic
 430      (To           : in out Aligned_Long_Integer;
 431       Amount       : in Long_Integer;
 432       Retry_Count  : in Natural;
 433       Old_Value    : out Long_Integer;
 434       Success_Flag : out Boolean)
 435    is
 436    begin
 437       SSL.Lock_Task.all;
 438       Old_Value := To.Value;
 439       To.Value  := To.Value + Amount;
 440       Success_Flag := True;
 441       SSL.Unlock_Task.all;
 442    end Add_Atomic;
 443
 444    ----------------
 445    -- And_Atomic --
 446    ----------------
 447
 448    type IU is mod 2 ** Integer'Size;
 449    type LU is mod 2 ** Long_Integer'Size;
 450
 451    function To_IU   is new Unchecked_Conversion (Integer, IU);
 452    function From_IU is new Unchecked_Conversion (IU, Integer);
 453
 454    function To_LU   is new Unchecked_Conversion (Long_Integer, LU);
 455    function From_LU is new Unchecked_Conversion (LU, Long_Integer);
 456
 457    procedure And_Atomic
 458      (To           : in out Aligned_Integer;
 459       From         : in Integer)
 460    is
 461    begin
 462       SSL.Lock_Task.all;
 463       To.Value  := From_IU (To_IU (To.Value) and To_IU (From));
 464       SSL.Unlock_Task.all;
 465    end And_Atomic;
 466
 467    procedure And_Atomic
 468      (To           : in out Aligned_Integer;
 469       From         : in Integer;
 470       Retry_Count  : in Natural;
 471       Old_Value    : out Integer;
 472       Success_Flag : out Boolean)
 473    is
 474    begin
 475       SSL.Lock_Task.all;
 476       Old_Value := To.Value;
 477       To.Value  := From_IU (To_IU (To.Value) and To_IU (From));
 478       Success_Flag := True;
 479       SSL.Unlock_Task.all;
 480    end And_Atomic;
 481
 482    procedure And_Atomic
 483      (To           : in out Aligned_Long_Integer;
 484       From         : in Long_Integer)
 485    is
 486    begin
 487       SSL.Lock_Task.all;
 488       To.Value  := From_LU (To_LU (To.Value) and To_LU (From));
 489       SSL.Unlock_Task.all;
 490    end And_Atomic;
 491
 492    procedure And_Atomic
 493      (To           : in out Aligned_Long_Integer;
 494       From         : in Long_Integer;
 495       Retry_Count  : in Natural;
 496       Old_Value    : out Long_Integer;
 497       Success_Flag : out Boolean)
 498    is
 499    begin
 500       SSL.Lock_Task.all;
 501       Old_Value := To.Value;
 502       To.Value  := From_LU (To_LU (To.Value) and To_LU (From));
 503       Success_Flag := True;
 504       SSL.Unlock_Task.all;
 505    end And_Atomic;
 506
 507    ---------------
 508    -- Or_Atomic --
 509    ---------------
 510
 511    procedure Or_Atomic
 512      (To           : in out Aligned_Integer;
 513       From         : in Integer)
 514    is
 515    begin
 516       SSL.Lock_Task.all;
 517       To.Value  := From_IU (To_IU (To.Value) or To_IU (From));
 518       SSL.Unlock_Task.all;
 519    end Or_Atomic;
 520
 521    procedure Or_Atomic
 522      (To           : in out Aligned_Integer;
 523       From         : in Integer;
 524       Retry_Count  : in Natural;
 525       Old_Value    : out Integer;
 526       Success_Flag : out Boolean)
 527    is
 528    begin
 529       SSL.Lock_Task.all;
 530       Old_Value := To.Value;
 531       To.Value  := From_IU (To_IU (To.Value) or To_IU (From));
 532       Success_Flag := True;
 533       SSL.Unlock_Task.all;
 534    end Or_Atomic;
 535
 536    procedure Or_Atomic
 537      (To           : in out Aligned_Long_Integer;
 538       From         : in Long_Integer)
 539    is
 540    begin
 541       SSL.Lock_Task.all;
 542       To.Value  := From_LU (To_LU (To.Value) or To_LU (From));
 543       SSL.Unlock_Task.all;
 544    end Or_Atomic;
 545
 546    procedure Or_Atomic
 547      (To           : in out Aligned_Long_Integer;
 548       From         : in Long_Integer;
 549       Retry_Count  : in Natural;
 550       Old_Value    : out Long_Integer;
 551       Success_Flag : out Boolean)
 552    is
 553    begin
 554       SSL.Lock_Task.all;
 555       Old_Value := To.Value;
 556       To.Value  := From_LU (To_LU (To.Value) or To_LU (From));
 557       Success_Flag := True;
 558       SSL.Unlock_Task.all;
 559    end Or_Atomic;
 560
 561    ------------------------------------
 562    -- Declarations for Queue Objects --
 563    ------------------------------------
 564
 565    type QR;
 566
 567    type QR_Ptr is access QR;
 568
 569    type QR is record
 570       Forward  : QR_Ptr;
 571       Backward : QR_Ptr;
 572    end record;
 573
 574    function To_QR_Ptr   is new Unchecked_Conversion (Address, QR_Ptr);
 575    function From_QR_Ptr is new Unchecked_Conversion (QR_Ptr, Address);
 576
 577    ------------
 578    -- Insqhi --
 579    ------------
 580
 581    procedure Insqhi
 582      (Item   : in  Address;
 583       Header : in  Address;
 584       Status : out Insq_Status)
 585    is
 586       Hedr : constant QR_Ptr := To_QR_Ptr (Header);
 587       Next : constant QR_Ptr := Hedr.Forward;
 588       Itm  : constant QR_Ptr := To_QR_Ptr (Item);
 589
 590    begin
 591       SSL.Lock_Task.all;
 592
 593       Itm.Forward  := Next;
 594       Itm.Backward := Hedr;
 595       Hedr.Forward := Itm;
 596
 597       if Next = null then
 598          Status := OK_First;
 599
 600       else
 601          Next.Backward := Itm;
 602          Status := OK_Not_First;
 603       end if;
 604
 605       SSL.Unlock_Task.all;
 606    end Insqhi;
 607
 608    ------------
 609    -- Remqhi --
 610    ------------
 611
 612    procedure Remqhi
 613      (Header : in  Address;
 614       Item   : out Address;
 615       Status : out Remq_Status)
 616    is
 617       Hedr : constant QR_Ptr := To_QR_Ptr (Header);
 618       Next : constant QR_Ptr := Hedr.Forward;
 619
 620    begin
 621       SSL.Lock_Task.all;
 622
 623       Item := From_QR_Ptr (Next);
 624
 625       if Next = null then
 626          Status := Fail_Was_Empty;
 627
 628       else
 629          Hedr.Forward := To_QR_Ptr (Item).Forward;
 630
 631          if Hedr.Forward = null then
 632             Status := OK_Empty;
 633
 634          else
 635             Hedr.Forward.Backward := Hedr;
 636             Status := OK_Not_Empty;
 637          end if;
 638       end if;
 639
 640       SSL.Unlock_Task.all;
 641    end Remqhi;
 642
 643    ------------
 644    -- Insqti --
 645    ------------
 646
 647    procedure Insqti
 648      (Item   : in  Address;
 649       Header : in  Address;
 650       Status : out Insq_Status)
 651    is
 652       Hedr : constant QR_Ptr := To_QR_Ptr (Header);
 653       Prev : constant QR_Ptr := Hedr.Backward;
 654       Itm  : constant QR_Ptr := To_QR_Ptr (Item);
 655
 656    begin
 657       SSL.Lock_Task.all;
 658
 659       Itm.Backward  := Prev;
 660       Itm.Forward   := Hedr;
 661       Hedr.Backward := Itm;
 662
 663       if Prev = null then
 664          Status := OK_First;
 665
 666       else
 667          Prev.Forward := Itm;
 668          Status := OK_Not_First;
 669       end if;
 670
 671       SSL.Unlock_Task.all;
 672    end Insqti;
 673
 674    ------------
 675    -- Remqti --
 676    ------------
 677
 678    procedure Remqti
 679      (Header : in  Address;
 680       Item   : out Address;
 681       Status : out Remq_Status)
 682    is
 683       Hedr : constant QR_Ptr := To_QR_Ptr (Header);
 684       Prev : constant QR_Ptr := Hedr.Backward;
 685
 686    begin
 687       SSL.Lock_Task.all;
 688
 689       Item := From_QR_Ptr (Prev);
 690
 691       if Prev = null then
 692          Status := Fail_Was_Empty;
 693
 694       else
 695          Hedr.Backward := To_QR_Ptr (Item).Backward;
 696
 697          if Hedr.Backward = null then
 698             Status := OK_Empty;
 699
 700          else
 701             Hedr.Backward.Forward := Hedr;
 702             Status := OK_Not_Empty;
 703          end if;
 704       end if;
 705
 706       SSL.Unlock_Task.all;
 707    end Remqti;
 708
 709 end System.Aux_DEC;