polyorb_hi-unprotected_queue.adb 34.8 KB
Newer Older
1 2 3 4 5 6 7 8
------------------------------------------------------------------------------
--                                                                          --
--                          PolyORB HI COMPONENTS                           --
--                                                                          --
--         P O L Y O R B _ H I . U N P R O T E C T E D _ Q U E U E          --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
--                   Copyright (C) 2014-2015 ESA & ISAE.                    --
--                                                                          --
-- PolyORB-HI is free software; you can redistribute it and/or modify under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion. PolyORB-HI is distributed in the hope that it will be useful, but  --
-- WITHOUT ANY WARRANTY; without even the implied warranty of               --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367
--                                                                          --
--              PolyORB-HI/Ada is maintained by the TASTE project           --
--                      (taste-users@lists.tuxfamily.org)                   --
--                                                                          --
------------------------------------------------------------------------------

with PolyORB_HI.Output;

package body PolyORB_HI.Unprotected_Queue is

   use PolyORB_HI.Port_Kinds;
   use PolyORB_HI.Output;

   ----------------
   -- Read_Event --
   ----------------

   procedure Read_Event
     (P : out Port_Type;
      Valid : out Boolean;
      Not_Empty : Boolean)
   is
   begin
      Valid := Not_Empty;

      if Valid then
         P := Global_Data_History (GH_First);

         pragma Debug (Put_Line
                         (Verbose,
                          CE
                            + ": Read_Event: read valid event [data] on "
                            + Thread_Port_Images (P)));
      end if;
   end Read_Event;

   -------------
   -- Dequeue --
   -------------

   procedure Dequeue
     (T : Port_Type;
      P : out Port_Stream_Entry;
      Not_Empty : out Boolean)
   is
      Is_Empty  : Boolean renames Empties (T);
      First     : Big_Port_Index_Type renames Firsts (T);
      Last      : Big_Port_Index_Type renames Lasts (T);
      FIFO_Size : Integer renames Thread_FIFO_Sizes (T);
      P_Kind    : Port_Kind renames Thread_Port_Kinds (T);
      Offset    : Integer renames Thread_FIFO_Offsets (T);
   begin
      --  This subprogram is called only when the thread has IN
      --  ports.

      pragma Assert (Is_In (P_Kind));

      if Is_Empty then
         --  If the FIFO is empty, return the latest received value
         --  during the previous dispatches.

         pragma Debug (Put_Line
                         (Verbose,
                          CE
                            + ": Dequeue: Empty queue for "
                            + Thread_Port_Images (T)));

         P := Get_Most_Recent_Value (T);

      elsif FIFO_Size = 0 then
         --  If the FIFO is empty or non-existent, return the
         --  latest received value during the previous dispatches.

         pragma Debug (Put_Line
                         (Verbose,
                          CE
                            + ": Dequeue: NO FIFO for "
                            + Thread_Port_Images (T)));

         P := Get_Most_Recent_Value (T);

      else
         pragma Debug (Put_Line
                         (Verbose,
                          CE
                            + ": Dequeue: dequeuing "
                            + Thread_Port_Images (T)));

         if First = Last then
            --  Update the value of N_Empties only when this is the
            --  first time we mark the partial queue as empty.

            if not Is_Empty and then Is_Event (P_Kind) then
               N_Empties := N_Empties + 1;
            end if;

            Is_Empty := True;
         end if;

         P := Global_Data_Queue (First + Offset - 1);

         if First = FIFO_Size then
            First := Default_Index_Value;
         elsif Global_Data_Queue_Size > 0
           and then FIFO_Size > 1 then
            First := Big_Port_Index_Type'Succ (First);
         end if;

         --  Shift the First index of the global history queue

         H_Increment_First (GH_First);
      end if;

      --  Update the barrier

      Not_Empty := N_Empties < N_Ports;
   end Dequeue;

   -------------
   -- Read_In --
   -------------

   function Read_In (T : Port_Type) return Port_Stream_Entry is
      P         : Port_Stream_Entry;
      Is_Empty  : Boolean renames Empties (T);
      First     : Integer renames Firsts (T);
      FIFO_Size : Integer renames Thread_FIFO_Sizes (T);
      Offset    : Integer renames Thread_FIFO_Offsets (T);
      P_Kind    : Port_Kind renames Thread_Port_Kinds (T);
   begin
      --  This subprogram is called only when the thread has IN
      --  ports.

      pragma Assert (Is_In (P_Kind));

      if Is_Empty or else FIFO_Size = 0 then
         --  If the FIFO is empty or non-existent return the
         --  latest received value during the previous dispatches.

         pragma Debug (Put_Line
                         (Verbose,
                          CE
                            + ": Read_In: Empty queue for port "
                            + Thread_Port_Images (T)
                            + ". Reading the last stored value."));

         P := Get_Most_Recent_Value (T);
      else
         pragma Debug (Put_Line
                         (Verbose,
                          CE
                            + ": Read_In: Reading the oldest element in the"
                            + " queue of port  "
                            + Thread_Port_Images (T)));

         P := Global_Data_Queue (First + Offset - 1);
         pragma Debug (Put_Line
                         (Verbose,
                          CE
                            + ": Read_In: Global reading position: "
                            + Integer'Image (First + Offset - 1)));
      end if;

      pragma Debug (Put_Line
                      (Verbose,
                       CE
                         + ": Read_In: Value read from port "
                         + Thread_Port_Images (T)));
      return P;
   end Read_In;

   --------------
   -- Read_Out --
   --------------

   function Read_Out (T : Port_Type) return Port_Stream_Entry is
   begin
      --  There is no need here to go through the Get_ routine
      --  since we are sending, not receiving.

      pragma Debug (Put_Line
                      (Verbose,
                       CE
                         + ": Read_Out: Value read from port "
                         + Thread_Port_Images (T)));

      return Most_Recent_Values (T);
   end Read_Out;

   ----------------
   -- Is_Invalid --
   ----------------

   function Is_Invalid (T : Port_Type) return Boolean is
   begin
      return not (Value_Put (T));
   end Is_Invalid;

   -----------------
   -- Set_Invalid --
   -----------------

   procedure Set_Invalid (T : Port_Type) is
   begin
      pragma Debug (Put_Line
                      (Verbose,
                       CE
                         + ": Set_Invalid: Setting INVALID for sending: port "
                         + Thread_Port_Images (T)));

      Value_Put (T) := False;
   end Set_Invalid;

   --------------
   -- Store_In --
   --------------

   procedure Store_In (P : Port_Stream_Entry; T : Time; Not_Empty : out Boolean) is
      Thread_Interface : constant Thread_Interface_Type
        := Stream_To_Interface (P.Payload);
      PT                : Port_Type renames Thread_Interface.Port;
      Is_Empty          : Boolean   renames Empties (PT);
      First             : Integer   renames Firsts (PT);
      Last              : Integer   renames Lasts (PT);
      P_Kind            : Port_Kind renames Thread_Port_Kinds (PT);
      FIFO_Size         : Integer   renames Thread_FIFO_Sizes (PT);
      Offset            : Integer   renames Thread_FIFO_Offsets (PT);
      Urgency           : Integer   renames Urgencies (PT);
      Overflow_Protocol : Overflow_Handling_Protocol
        renames Thread_Overflow_Protocols (PT);
      Replace           : Boolean := False;
   begin
      --  This subprogram is called only when the thread has IN
      --  ports.

      pragma Assert (Is_In (P_Kind));

      --  Set PT as initialized

      Initialized (PT) := True;

      if Has_Event_Ports then
         if Is_Event (P_Kind) then
            --  If the FIFO is full apply the overflow-policy
            --  indicated by the user.

            if FIFO_Size > 0 then
               if not Is_Empty
                 and then (Last = First - 1
                             or else (First = 1 and then Last = FIFO_Size))
               then
                  declare
                     Frst : Integer;
                     GDH : Big_Port_Type_Array renames Global_Data_History;
                  begin
                     case Overflow_Protocol is
                        when DropOldest =>
                           --  Drop the oldest element in the FIFO

                           Global_Data_Queue (First + Offset - 1) := P;
                           pragma Debug
                             (Put_Line
                                (Verbose,
                                 CE
                                   + ": Store_In: FIFO is full."
                                   + " Dropping oldest element."
                                   + " Global storage position: "
                                   + Integer'Image (First + Offset - 1)));

                           Last := First;

                           if First = FIFO_Size then
                              First := Default_Index_Value;
                           elsif Global_Data_Queue_Size > 0
                             and then FIFO_Size > 1
                           then
                              First := Big_Port_Index_Type'Succ (First);
                           end if;

                           --  Search the oldest element in the history

                           Frst := GH_First;
                           loop
                              if GDH (Frst) = PT then
                                 exit;
                              end if;
                              Frst := Frst + 1;
                              if Frst > Global_Data_Queue_Size then
                                 exit;
                              end if;
                           end loop;

                           if Frst > Global_Data_Queue_Size then
                              --  Second configuration, We have only
                              --  searched from GH_First to Queue_Size,
                              --  continue from the beginning to GH_Last.

                              --  ---------------------------------------------
                              --  |xxxxxxxxx|x|               |x|xxxxxxxxxxxxx|
                              --  ---------------------------------------------
                              --   1         GH_Last          GH_First    Queue_Size
                              Frst := 1;
                              loop
                                 exit when GDH (Frst) = PT;
                                 Frst := Frst + 1;
                              end loop;
                           end if;

                        when DropNewest =>
                           --  Drop the newest element in the FIFO

                           Global_Data_Queue (Last + Offset - 1) := P;
                           pragma Debug
                             (Put_Line
                                (Verbose,
                                 CE
                                   + ": Store_In: FIFO is full."
                                   + " Dropping newest element"
                                   + " Global storage position: "
                                   + Integer'Image (Last + Offset - 1)));

                           --  Search the newest element in the history

                           Frst := GH_Last;
                           loop
                              if GDH (Frst) = PT then
                                 exit;
                              end if;
                              Frst := Frst - 1;
                              if Frst < 1 then
                                 exit;
                              end if;
                           end loop;

                           if Frst < 1 then
                              --  Continue the search from the end
                              Frst := Global_Data_Queue_Size;
                              loop
                                 exit when GDH (Frst) = PT;
                                 Frst := Frst - 1;
                              end loop;
                           end if;
368

369
                        when Error =>
370 371 372
                           Put_Line (Verbose,
                                     CE + ": Store_In: FIFO is full");
                           --  XXX SHould raise an exception there !
373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998
                     end case;

                     --  Remove event in the history and shift
                     --  others with the same urgency

                     pragma Debug
                       (Put_Line
                          (Verbose,
                           CE
                             + ": Store_In: FIFO is full."
                             + " Removed element in history at"
                             + Integer'Image (Frst)));

                     loop
                        exit when Frst = Global_Data_Queue_Size
                          or else Urgencies (GDH (Frst)) < Urgency;
                        GDH (Frst) := GDH (Frst + 1);
                        Frst := Frst + 1;
                     end loop;

                     if Frst = Global_Data_Queue_Size
                       and then Urgencies (GDH (Frst)) < Urgency then
                        --  Continue suppressing from the beginning
                        Frst := 1;
                        GDH (Global_Data_Queue_Size) := GDH (Frst);
                        loop
                           exit when Urgencies (GDH (Frst)) < Urgency;
                           GDH (Frst) := GDH (Frst + 1);
                           Frst := Frst + 1;
                        end loop;
                     end if;
                  end;
                  Replace := True;
               else
                  --  Update the value of N_Empties only when this is the
                  --  first time we mark the partial queue as NOT empty.

                  if Is_Empty then
                     N_Empties := N_Empties - 1;
                  end if;

                  Is_Empty := False;

                  if Last = FIFO_Size then
                     Last := Default_Index_Value;
                  elsif Global_Data_Queue_Size  > 0 then
                     Last := Big_Port_Index_Type'Succ (Last);
                  end if;

                  Global_Data_Queue (Last + Offset - 1) := P;
                  pragma Debug (Put_Line
                                  (Verbose,
                                   CE
                                     + ": Store_In: Global storage position: "
                                     + Integer'Image (Last + Offset - 1)));

               end if;

               --  Update the oldest updated port value
               declare
                  Frst : Integer := GH_Last;
                  Lst  : constant Integer := GH_Last;
                  GDH  : Big_Port_Type_Array renames Global_Data_History;
               begin

                  --  Add an entry in the history
                  if not Replace then
                     H_Increment_Last (GH_Last);
                  end if;

                  if GH_First /= GH_Last then
                     --  Search the first entry with a higher urgency
                     --  and shift other entries
                     if Frst = Global_Data_Queue_Size
                       and then Urgencies (GDH (Frst)) < Urgency then
                        GDH (GH_Last) := GDH (Frst);
                        Frst := Frst - 1;
                     end if;
                     loop
                        if Urgencies (GDH (Frst)) >= Urgency then
                           exit;
                        end if;
                        GDH (Frst + 1) := GDH (Frst);
                        Frst := Frst - 1;
                        exit when (GH_First <= Lst
                                     and then Frst < GH_First)
                          or else Frst < 1;
                     end loop;

                     if Frst < 1 and then GH_First > Lst then
                        --  Continue the search from the end
                        Frst := Global_Data_Queue_Size;
                        if Urgencies (GDH (Frst)) < Urgency then
                           GDH (1 mod GDH'Length) := GDH (Frst);
                           Frst := Frst - 1;
                           loop
                              if Urgencies (GDH (Frst)) >= Urgency then
                                 exit;
                              end if;
                              GDH (Frst + 1) := GDH (Frst);
                              Frst := Frst - 1;
                              exit when Frst < GH_First;
                           end loop;
                        end if;
                     end if;
                  end if;

                  --  Insert the port of the event
                  if Frst = Global_Data_Queue_Size then
                     GDH (1 mod GDH'Size) := PT;
                     --  The modulo avoids warning when accessing
                     --  GDH (1) while Queue_Size = 0
                     pragma Debug (Put_Line
                                     (Verbose,
                                      CE
                                        + ": Store_In: Insert event"
                                        + " in history at: "
                                        + Integer'Image (1)));
                  else
                     GDH (Frst + 1) := PT;
                     pragma Debug (Put_Line
                                     (Verbose,
                                      CE
                                        + ": Store_In: Insert event"
                                        + " in history at: "
                                        + Integer'Image (Frst + 1)));
                  end if;
               end;

            end if;

            --  Update the most recent value corresponding to port PT

            Set_Most_Recent_Value (PT, P, T);

            pragma Debug (Put_Line
                            (Verbose,
                             CE
                               + ": Store_In: Enqueued Event [Data] message"
                               + " for port "
                               + Thread_Port_Images (PT)));

            --  Update the barrier

            Not_Empty := True;
         end if;
      end if;

      --  If this is a data port, we only override the
      --  Most_Recent_Value corresponding to the port.

      if not Is_Event (P_Kind) then
         pragma Debug (Put_Line
                         (Verbose,
                          CE
                            + ": Store_In: Storing Data message in DATA port "
                            + Thread_Port_Images (PT)));

         Set_Most_Recent_Value (PT, P, T);

         pragma Debug (Put_Line
                         (Verbose,
                          CE
                            + ": Store_In: Stored Data message in DATA port "
                            + Thread_Port_Images (PT)));

      end if;
   end Store_In;

   ---------------
   -- Store_Out --
   ---------------

   procedure Store_Out (P : Port_Stream_Entry; T : Time) is
      Thread_Interface : constant Thread_Interface_Type
        := Stream_To_Interface (P.Payload);
      PT               : Port_Type renames Thread_Interface.Port;
   begin
      pragma Debug (Put_Line
                      (Verbose,
                       CE
                         + ": Store_Out: Storing value for sending: port "
                         + Thread_Port_Images (PT)));

      --  Mark as valid for sending

      Value_Put (PT) := True;

      pragma Debug (Put_Line
                      (Verbose,
                       CE
                         + ": Store_Out: Value stored for sending: port "
                         + Thread_Port_Images (PT)));

      --  No need to go through the Set_ routine since we are
      --  sending, not receiving.

      Most_Recent_Values (PT) := P;
      Time_Stamps (PT) := T; -- overwritten below
                             --  Maxime workaround for backdoor accesses
      Time_Stamps (PT) := Ada.Real_time.clock;

   end Store_Out;

   -----------
   -- Count --
   -----------

   function Count (T : Port_Type) return Integer is
      Is_Empty  : Boolean renames Empties (T);
      First     : Integer renames Firsts (T);
      Last      : Integer renames Lasts (T);
      P_Kind    : Port_Kind renames Thread_Port_Kinds (T);
      FIFO_Size : Integer renames Thread_FIFO_Sizes (T);
   begin
      --  This subprogram is called only when the thread has IN
      --  ports.

      pragma Assert (Is_In (P_Kind));

      if not Initialized (T) then
         pragma Debug (Put_Line
                         (Verbose,
                          CE
                            + ": Count: Not initialized port: "
                            + Thread_Port_Images (T)));

         return -1;

      elsif Is_Empty then
         pragma Debug (Put_Line
                         (Verbose,
                          CE
                            + ": Count: Empty FIFO for port "
                            + Thread_Port_Images (T)));

         return 0;

      elsif FIFO_Size = 0 then
         pragma Debug (Put_Line
                         (Verbose,
                          CE
                            + ": Count: No FIFO for port "
                            + Thread_Port_Images (T)));

         return 0;

      else
         pragma Debug (Put_Line
                         (Verbose,
                          CE
                            + ": Count: FIFO exists for port "
                            + Thread_Port_Images (T)));

         if Last >= First then
            --  First configuration

            --  -------------------------------------------------------
            --  |         |x|xxxxxxxxxxxxxxxxxxxxxxxxx|x|             |
            --  -------------------------------------------------------
            --            First                       Last

            return (Last - First) + 1;

         else
            --  Second configuration

            --  -------------------------------------------------------
            --  |xxxxxxxxx|x|                         |x|xxxxxxxxxxxxx|
            --  -------------------------------------------------------
            --            Last                        First

            return FIFO_Size - First + Last + 1;
         end if;
      end if;
   end Count;

   ---------------------------
   -- Get_Most_Recent_Value --
   ---------------------------

   function Get_Most_Recent_Value
     (P : Port_Type)
     return Port_Stream_Entry
   is
      First     : Integer renames Firsts (P);
      Last      : Integer renames Lasts (P);
      P_Kind    : Port_Kind renames Thread_Port_Kinds (P);
      FIFO_Size : Integer renames Thread_FIFO_Sizes (P);
      Offset    : Integer renames Thread_FIFO_Offsets (P);
      T         : constant Time := Clock;
      S         : Port_Stream_Entry;
   begin
      if Has_Event_Ports then
         if Is_Event (P_Kind) then
            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Get_Most_Recent_Value: event [data] port "
                    + Thread_Port_Images (P)));

            S := Most_Recent_Values (P);
         end if;
      end if;
      if not Is_Event (P_Kind) then
         if FIFO_Size = 1 then
            --  Immediate connection

            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Get_Most_Recent_Value: data port "
                    + Thread_Port_Images (P)
                    + ". Immediate connection"));
            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Get_Most_Recent_Value: First  ="
                    + Integer'Image (First)));
            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Get_Most_Recent_Value: Last  = "
                    + Integer'Image (Last)));
            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Get_Most_Recent_Value: Offset = "
                    + Integer'Image (Offset)));
            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Get_Most_Recent_Value: Global_Data_Queue_Size = "
                    + Integer'Image (Global_Data_Queue_Size)));

            S :=  Global_Data_Queue (First + Offset - 1);

            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Get_Most_Recent_Value: Most recent value for"
                    + " data port "
                    + Thread_Port_Images (P)
                    + " got. Immediate connection"));
         else
            --  Delayed connection: The element indexed by First is
            --  the oldest element and the element indexed by Last
            --  is the most recent element.

            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Get_Most_Recent_Value: data port "
                    + Thread_Port_Images (P)
                    + ". Delayed connection"));
            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Get_Most_Recent_Value: First  = "
                    + Integer'Image (First)));
            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Get_Most_Recent_Value: Last  = "
                    + Integer'Image (Last)));
            pragma Debug
              (Put_Line
                 (Verbose,
                  " Offset = " + Integer'Image (Offset)));
            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Get_Most_Recent_Value: Global_Data_Queue_Size = "
                    + Integer'Image (Global_Data_Queue_Size)));

            if Time_Stamps (P) <= T then
               pragma Debug
                 (Put_Line
                    (Verbose,
                     CE + ": Get_Most_Recent_Value: Getting NEW value"));

               S := Global_Data_Queue (Last + Offset - 1);
            else
               pragma Debug
                 (Put_Line
                    (Verbose,
                     CE + ": Get_Most_Recent_Value: Getting OLD value"));

               S := Global_Data_Queue (First + Offset - 1);
            end if;

            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Get_Most_Recent_Value: Most recent value"
                    + " for data port "
                    + Thread_Port_Images (P)
                    + " got. Delayed connection"));
         end if;
      end if;

      return S;
   end Get_Most_Recent_Value;

   ---------------------------
   -- Set_Most_Recent_Value --
   ---------------------------

   procedure Set_Most_Recent_Value
     (P : Port_Type;
      S : Port_Stream_Entry;
      T : Time)
   is
      First     : Big_Port_Index_Type renames Firsts (P);
      Last      : Big_Port_Index_Type renames Lasts (P);
      P_Kind    : Port_Kind renames Thread_Port_Kinds (P);
      FIFO_Size : Integer renames Thread_FIFO_Sizes (P);
      Offset    : Integer renames Thread_FIFO_Offsets (P);
   begin
      if Global_Data_Queue_Size = 0 then
         --  XXX Actually, if the queue has a null size, this
         --  function is never called, hence we can exit
         --  immediatly. This should be captured with a proper
         --  pre-condition. We need this trap to avoid GNATProve
         --  attempting to prove the code below in this particular
         --  case.
         return;
      end if;

      if Has_Event_Ports then
         if Is_Event (P_Kind) then
            pragma Debug (Put_Line
                            (Verbose,
                             CE
                               + ": Set_Most_Recent_Value: event [data] port "
                               + Thread_Port_Images (P)));

            Most_Recent_Values (P) := S;

            pragma Debug (Put_Line
                            (Verbose,
                             CE
                               + ": Set_Most_Recent_Value: event [data] port "
                               + Thread_Port_Images (P)
                               + ". Done."));
         end if;
      end if;
      if not Is_Event (P_Kind) then
         Time_Stamps (P) := T;

         if FIFO_Size = 1 then
            --  Immediate connection

            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Set_Most_Recent_Value: data port "
                    + Thread_Port_Images (P)
                    + ". Immediate connection"));
            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Set_Most_Recent_Value: First  ="
                    + Integer'Image (First)));
            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Set_Most_Recent_Value: Last  = "
                    + Integer'Image (Last)));
            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Set_Most_Recent_Value: Offset = "
                    + Integer'Image (Offset)));
            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Set_Most_Recent_Value: Global_Data_Queue_Size = "
                    + Integer'Image (Global_Data_Queue_Size)));

            Global_Data_Queue (First + Offset - 1) := S;

            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Set_Most_Recent_Value: Most recent value"
                    + " for data port "
                    + Thread_Port_Images (P)
                    + " set. Immediate connection"));
         else
            --  Delayed connection: The element indexed by First must be
            --  the oldest element and the element indexed by Last
            --  is the most recent element.
            --  XXX JH: why?

            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Set_Most_Recent_Value: data port "
                    + Thread_Port_Images (P)
                    + ". Delayed connection"));
            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Set_Most_Recent_Value: First  = "
                    + Integer'Image (First)));
            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Set_Most_Recent_Value: Last  = "
                    + Integer'Image (Last)));
            pragma Debug
              (Put_Line
                 (Verbose,
                  " Offset = " + Integer'Image (Offset)));
            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Set_Most_Recent_Value: Global_Data_Queue_Size = "
                    + Integer'Image (Global_Data_Queue_Size)));

            Global_Data_Queue (First + Offset - 1) :=
              Global_Data_Queue (Last + Offset - 1);
            Global_Data_Queue (Last + Offset - 1)  := S;

            pragma Debug
              (Put_Line
                 (Verbose,
                  CE
                    + ": Set_Most_Recent_Value: Most recent value"
                    + " for data port "
                    + Thread_Port_Images (P)
                    + " set. Delayed connection"));
         end if;
      end if;
   end Set_Most_Recent_Value;

   --------------------
   -- Get_Time_Stamp --
   --------------------

   function Get_Time_Stamp (P : Port_Type) return Time is
   begin
      pragma Debug (Put_Line
                      (Verbose,
                       CE
                         + ": Get_Time_Stamp: port "
                         + Thread_Port_Images (P)));

      return Time_Stamps (P);
   end Get_Time_Stamp;

   -----------------------
   -- H_Increment_First --
   -----------------------

   procedure H_Increment_First (F : in out Big_Port_Index_Type) is
   begin
      if Big_Port_Index_Type'Last > 0 then
         if F < Big_Port_Index_Type'Last then
            F := Big_Port_Index_Type'Succ (F);
         else
            F := Default_Index_Value;
         end if;

         pragma Debug (Put_Line
                         (Verbose,
                          CE
                            + ": H_Increment_First: F ="
                            + Integer'Image (F)));
      end if;
   end H_Increment_First;

   ----------------------
   -- H_Increment_Last --
   ----------------------

   procedure H_Increment_Last (L : in out Big_Port_Index_Type) is
   begin
      if Big_Port_Index_Type'Last > 0 then
         if L < Big_Port_Index_Type'Last then
            L := Big_Port_Index_Type'Succ (L);
         else
            L := Default_Index_Value;
         end if;

      pragma Debug (Put_Line
                    (Verbose,
                     CE
                     + ": H_Increment_Last: L ="
                     + Integer'Image (L)));
      end if;
   end H_Increment_Last;

   --------
   -- CE --
   --------

   function CE return String is
   begin
      return Entity_Image (Current_Entity);
   end CE;

end PolyORB_HI.Unprotected_Queue;