Version 1.4 of ais/ai-00250.txt

Unformatted version of ais/ai-00250.txt version 1.4
Other versions for file ais/ai-00250.txt

!standard 09.04 (05)          00-12-13 AI95-00250/02
!standard 09.05.02 (02)
!standard 09.05.03 (02)
!class amendment 00-12-04
!status work item 00-12-04
!status received 00-12-04
!priority Medium
!difficulty Hard
!subject Protected Types, Extensible, Tagged, Abstract
!summary
It is proposed to add to Ada a facility for "tagged protected types", allowing extensibility of protected types in a way similar to tagged types.
!problem
At the present time there is a disconnect between the extensible portions of the language and the concurrent portions. Through tagged types, one may construct trees of co-operating types, all which have been extended from some root type, and one may dispatch or redispatch to the appropriate subprogram, depending upon the type of an object and its primitive subprograms. When concurrency is included, however, there is also a requirement to sequentialize access to various constructs, and to synchronize the actions of tasks.
When types that have objects interacting with tasks are extended in a concurrent environment, there is often a requirement to modify the code which must be executed sequentially, and to modify the conditions of synchronization. Currently in the language, the mechanisms to synchronize tasks and sequentialize access to objects do not integrate well with the object oriented programming paradigms of the language. When attempting to connect Ada programs to services that require both extensibility / dispatching and concurrency / protection, the lack of a smooth integration between the OO paradigm and concurrency causes one to write a significant amount of intricate, relatively fragile, code.
!proposal
It is proposed to add to Ada a facility for "tagged protected types", allowing extensibility of protected types in a way similar to tagged types.
Proposal paragraphs are numbered to facilitate referencing them in discussions. Paragraphs with minor numbers (with a trailing lower-case letter, e.g. (28.a)) are explanations/discussions.
Syntax:
Here is the proposed revised syntax (protected_type_declaration is here for reference only -- it isn't changed):
( 1) protected_type_declaration ::=
protected type defining_identifier [known_discriminant_part] is protected_definition;
( 2) protected_definition ::=
[[ABSTRACT] tagged_definition]
{protected_operation_declaration}
[PRIVATE
{protected_element_declaration} [barrier_strengthener]]
END [protected_identifier] | [ABSTRACT] NEW subtype_indication WITH PRIVATE | [ABSTRACT] TAGGED PRIVATE
( 4) tagged_definition ::=
TAGGED | NEW subtype_indication WITH
( 5) protected_operation_declaration ::=
-- as before ... | abstract_subprogram_declaration | abstract_entry_declaration
( 6) protected_element_declaration ::=
-- as before... | entry_body_profile
( 7) entry_body_profile ::=
entry defining_identifier entry_body_formal_part entry_barrier;
( 8) entry_barrier ::=
[AND] WHEN condition
( 9) barrier_strengthener ::=
entry <> and when Condition;
(10) abstract_entry_declaration ::=
entry defining_identifier [(discrete_subtype_definition)] parameter_profile is abstract;
(10.a) abstract_subprogram_declaration, abstract_entry_declaration, entry_body_profile, barrier_strengthener, as well as the "AND WHEN" form of entry barriers are only allowed if the protected_definition includes a tagged_definition.
Static Semantics:
(11) We have allowed ABSTRACT, and TAGGED or "NEW subtype_indication WITH",
following the "IS." In the case of "NEW subtype_indication WITH" the subtype indication would have to specify a tagged protected type as the parent. This form defines a "protected extension" of its parent.
(12) If the word ABSTRACT appears, no objects of the protected
type may be created. In addition one or more of the protected operations may be declared ABSTRACT, as may one or more of the primitive operations of the protected type (remember that the primitives of a protected type are defined outside the protected type declaration, just like that of any other type).
(13) If the "NEW ... WITH PRIVATE" or "TAGGED PRIVATE" form is
used, the type declaration must appear in the visible part of a package, or as a generic formal type. In the non- generic case, a non-private tagged protected declaration must appear in the private part of the package, and in the NEW ... WITH case, it must be a descendant of the specified ancestor protected type. If ABSTRACT does not appear, the full type must not be abstract.
(14) In the generic formal type case, the corresponding actual
parameter must be a protected tagged type, descended from the specified ancestor type in the NEW ... WITH case. If ABSTRACT does not appear, the actual type must not be abstract.
(14.a) [NOTE: It is not clear there is a lot of value in the TAGGED PRIVATE case, except perhaps for generic mix-ins. However, it may be valuable to identify a type as protected tagged, even if none of its protected operations are directly visible, simply to indicate that the type supports simultaneous access from multiple tasks, and to enable extensions that take advantage of the parent type's mutex.]
(15) A protected tagged type does not match/complete a non-protected
(limited) tagged type, because the rules for extension are different.
(16) The Class attribute may be applied to a tagged protected type.
Presuming PT is a tagged protected type, PT'Class supports implicit conversion from all descendants of PT, and their corresponding class-wide types; i.e., PT'Class covers all of PT's descendants, and their class-wide types.
(17) Within a protected extension, the private operations and the
data components of the parent are visible only if the extension is declared within the immediate scope of the full declaration of the parent protected type. This includes within a child unit, if the parent is defined immediately within a library package. This ensures that changes to the private components and operations do not affect code outside the subsystem within which it is defined.
(18) If NPT is an extension of PT, or a descendant of an extension
[of PT], explicit conversion from NPT to PT is not permitted, except within the body of NPT itself. Even within the body, it is only permitted if PT is the immediate parent of NPT, or if NPT has visibility on the private declaration part of all intervening extensions (e.g. in a child package). It is always legal to convert to PT'Class, and to convert from PT'Class to NPT'Class (a run-time tag check is required in this case).
(Definition of the primitive operations:)
(19) The primitive operations of a tagged protected type are the
set of all its "normal" primitive operations (defined outside the protected type, just as for other tagged types) together with its protected operations. A derived protected type can hence override the inherited protected operations, or add new ones as well.
(Definition of barrier specifications:)
(20) For each (non-abstract) entry_declaration of a tagged
protected type, whether in the visible or the private part of the protected type, there must be a corresponding entry_body_profile following in the private part of the protected type, and each entry_body_profile shall correspond to a prior entry_declaration. if an entry_declaration overrides an inherited entry, the entry_barrier of the corresponding entry_body_profile shall use the "AND WHEN" form; otherwise, the when form shall be used.
(20.a) Comment: to allow entry overriding, one needs to place the barriers into the type declaration to avoid dependencies between bodies as a derived protected type needs to know its ancestors' barriers. Hence the introduction of the entry_body_profile. See also the "discussion" section below.
(20.b) Strictly speaking the "AND WHEN" form is redundant. One could also take the simple "WHEN" to be an implicit "AND WHEN" if it occurred for an entry that overrides some inherited entry. However, requiring the explicit use of "AND WHEN" in such cases helps guard against accidentally overriding entries, since an overriding entry using just "WHEN" will be flagged as erroneous by the compiler. Also, such use of "WHEN" for two different semantics could be very misleading anyway.
(20.c) Note that (20) applies only to tagged protected types. Common untagged protected types are intended to remain unchanged by this proposal.
(21) The barrier of an entry that overrides an inherited ancestor
entry is the conjunction of the ancestor's barrier and then the condition given in the overriding entry_body_profile after the "AND WHEN".
(21.a) Hence "AND WHEN" is a short circuit evaluated AND.
(21.b) Also note that only barrier strengthening is allowed. Barriers are viewed as synchronization constraints, and the derived type is required to satisfy at least those already imposed of its ancestor types. (If a derived type overrides an entry, but wishes to keep the barrier unchanged, the barrier "AND WHEN TRUE" may be used.)
(22) An abstract entry has no barrier and no entry_body_profile.
(22.a) If an abstract entry needs a barrier, one can just as well supply a concrete entry instead that implements the desired synchronization.
(23) From within a protected extension, it is possible to call an
overridden protected subprogram of an ancestor type, using the following syntax:
(24) ancestor_protected_subtype_mark .
protected_subprogram_identifier actual_parameter_part
(25) To preserve abstraction, analogous to the conversion
restriction above [(17)], this kind of call would only be permitted if the ancestor is the immediate parent, or if the extension has visibility on the private declarations of all intervening extensions (e.g. is in a child package).
(26) To redispatch as part of an internal protected operation call,
the following syntax is proposed:
(27) protected_subtype_mark'Class .
protected_subprogram_identifier actual_parameter_part
(28) Supporting this new syntax comes down to defining the
meaning of an expanded name where the prefix denotes an ancestor/classwide subtype of a protected extension, and the selector_name denotes a potentially overridden protected subprogram, when inside the body of the protected extension.
(28.a) The above special kinds of expanded names are not strictly necessary; we could alternatively require the use of a view conversion applied to the protected extension's identifier, where the extension's identifier identifies the "current instance." For example:
PT(NPT).Proc(3,5)
could be used to call the PT implementation of "proc" rather than the NPT one which overrides it. It would be important to consider this form an "internal" call so no new lock is acquired. The syntax "PT.Proc(3,5)" seems more natural, and is probably worth supporting.
(Additional ancestor call syntax for entries:)
(29) Within an entry_body of an entry in a derived type that
overrides an entry inherited from an ancestor type, it is possible to call the overridden entry body. Such an "ancestor entry call" is seen as an internal procedure call; it does not involve requeueing. (See dynamic semantics, [(37)] below.) The syntax for ancestor calls is
(30) ancestor_entry_call_statement ::=
ancestor_subtype_mark . entry_name [actual_parameter_part];
(31) where entry_name must correspond to the entry_name of the
entry_body within which the ancestor_entry_call_statement occurs. The same visibility requirements as specified for similar calls of overridden protected subprograms apply (see [(17), (25)]).
(32) To allow compile-time checking, the entry name used in an ancestor
entry call, when the entry being referenced is a member of an entry family, shall consist of the entry identifier followed by the named entry index in parentheses. Hence given the entry family (in an extension NPT of PT, overriding an entry familiy from PT)
entry Something (for B in Boolean) (...) when ... is X : Boolean := ...; begin PT.Something (B) (...); -- This is allowed PT.Something (False) (...); -- This is not, even if -- B = False! PT.Something (X) (...); -- Neither is this! end Something;
(32.a) This rule is intended to avoid the necessity of a run-time check to verify that the ancestor call actually invokes the right parent entry. (I.e., in this example, to verify that B = False or B = X, for if it's not, this is not an ancestor call but calling some other entry, which is still forbidden.)
(32.b) The proposal only allows an ancestor entry call from within an overriding entry body to the overridden entry. The intention is to facilitate reuse by subclassing. There is no class-wide pendant to the ancestor entry call.
(Barrier strengthener:)
(33) The occurrence of a barrier_strengthener "ENTRY <>" in a
tagged protected type declaration is equivalent to explicitly overriding all inherited entries that have not been overridden in this protected type, strengthening their barriers as indicated by the "ENTRY <>" clause, and implementing them as call-throughs to the overridden entry body using ancestor entry calls (see [(37)] below).
(33.a) The Wellings, et. al. paper (see the !discussion) discusses the barrier_strengthener in the context of generic mix-ins only, but the semantics is vastly simplified if it is generally allowed. See that paper for an extended motivation for the introduction of this feature.
(33.b) Paragraph 33 applies only to tagged protected types. Untagged protected types cannot have a barrier strengthener.
Dynamic Semantics:
(34) When a protected extension is defined, a single mutex is
used for the components and operations inherited from the parent, as well as the new components and operations defined in the extension.
(35) There remains only one entry queue per entry, whether an
entry is inherited or overridden in an extension. This means that all entry calls or requeues to a given entry are added to its one entry queue, and when serviced, all are handled by the "current" entry body, which is either an inherited one or an overriding one. This may be considered equivalent to saying that all entry calls or requeues are "dispatching." for example, if an inherited entry does a requeue to another entry, it always "redispatches" to any overriding body of the target entry.
(36) Protected subprograms, on the other hand, work the same
way as "normal" primitive subprograms, namely an internal call from one protected subprogram to another is statically bound, unless the classwide subtype is used as the prefix of the call.
(Additional semantics for ancestor_entry_call_statements:)
(37) Ancestor entry calls also are internal calls of the
overridden entry. No requeueing occurs. The overridden entry body is executed like a protected procedure called from the overriding entry. The entry body executing an ancestor_entry_call and the execution of the called ancestor entry body together are part of the same protected action.
(37.a) Note that even with entry overriding and ancestor calls, there is only one queue per entry, and since external entry calls and requeues always dispatch, the entry body dispatched to is always the one defined for a leaf type in the derivation tree (which may be inherited), never an intermediary, overridden entry. Overridden entry bodies can only be executed through ancestor entry calls, which are allowed only within the overriding entry bodies.
(37.b) Also note that an ancestor entry call may or may not return. If the called ancestor entry requeues, the call will not return. Any code following in the overriding entry after an ancestor entry call will not get executed in this case. If the ancestor entry does not requeue but returns normally, control returns to the overriding entry.
(38) The barrier condition of the ancestor entry is re-evaluated
in an ancestor_entry_call_statement, though, with the value of the 'Count attribute as it was when the barrier of the overriding entry was evaluated when the overriding entry began its execution. If that re-evaluation of the ancestor part of the barrier yields FALSE, PROGRAM_ERROR is raised in the overriding entry where the ancestor entry call occurs.
(38.a) This can happen only if the overriding entry somehow changed the state such that the ancestor barrier now has become FALSE. Due to barrier strengthening, it must have been TRUE when the overriding entry started executing. But since the "child" has visibility of its ancestors' state, it may well have changed that. However, the ancestor entry clearly was programmed under the assumption that its barrier is TRUE whenever it executes (the precondition aspect of a barrier...), so calling it when the barrier actually is FALSE violates this precondition and should be considered an error. Hence the raising of the exception PROGRAM_ERROR in this case.
!discussion
This proposal is based on Tucker Taft's similar proposal (see the appendix), as well as the following papers:
[1] Wellings, A.J.; Johnson, B.; Sanden, B.; Kienzle, J., Wolf,
Th., and Michell, S.: "Integrating Object-Oriented Programming and Protected Objects in Ada 95", ACM TOPLAS 22 (3), May 2000; pp. 506 - 539. A plain ASCII version of that paper is in the appendix. (Slightly abridged.)
[2] Taft, T.: LSN-1030, 92-06-01. Also in the appendix.
The above proposal implements one variant discussed in [1] to allow the overriding of entries, including the possibility to re-use the overridden ones.
The original proposal from Tucker Taft seems to focus more on class-wide programming than on the "re-use by subclassing" aspect. The impression is that somehow all tagged protected types in a hierarchy were designed and implemented in one fell swoop, and hence the designer would be well aware of the different barriers involved. This proposal does not take that view. Extending an already existing hierarchy is considered a normal case, and in this use of tagged protected types, the designer of the extensions may not know the bodies of the already existing ancestors in the hierarchy that is being extended.
Irrespective of the ancestor entry call facility, an overriding entry must therefore have knowledge of the barrier of the entry that is overridden. How else can an overriding entry integrate meaningfully into the synchronization constraints imposed by the ancestors? Hence even without the re-use aspect, barriers must be exposed, so that the overriding entry (and its implementor!) knows what it (or he or she) is supposed to do. If this were not so, entry overriding of concrete entries would only be possible with some knowledge of the ancestors' bodies, which should be avoided. (Abstract entries, having neither barriers nor bodies, could still be overridden without problems.)
Furthermore, this proposal assumes that the added complexity is (a) not that much (in particular, there still is only one mutex per protected object, and only one queue per entry), and (b) is worthwhile because it leads to a much more complete solution. (Albeit it doesn't fully solve all difficulties...) Also, it is felt that the addition of ancestor entry calls is not a big additional complexity, given that barriers must be exposed somehow to the derived types anyway.
As for examples: of course there are no concrete, real-world sized ones, given that there is no implementation of all this yet. However, one case where tagged protected types would be very convenient and would represent a big advantage over current approaches (or "work-arounds") is in multitasked CORBA servers. CORBA classes are mapped by the standard IDL-to-Ada mapping onto tagged types. In a multitasked server, one has to (a) employ great care, and (b) resort to rather complex implementation approaches to ensure task-safety of one's CORBA objects, especially if inheritance is involved. If tagged protected types were available in the language, safeguarding against concurrent modifications of objects' states and also synchronizing between objects or invocations would become much simpler and more intuitive.
!wording
!example
[This is from Tucker's version: it should have been updated - ED]
Examples based on May 2000 TOPLAS article
Signal Example:
package Signals is protected type Signal is abstract tagged procedure Send; entry Wait is abstract; private Signal_Arrived : Boolean := True; end Signal; type All_Signals is access Signal'Class; end Signals; package body Signals is protected body Signal is procedure Send is begin Signal_Arrived := True; end Send; end Signal; end Signals;
Now to create a persistent signal:
package Signals.Persistent is protected type Persistent_Signal is new Signal with entry Wait; end Persistent_Signal; end Signals.Persistent; package body Signals.Persistent is protected body Persistent_Signal is entry Wait when Signal_Arrived is begin Signal_Arrived := False; end; end Persistent_Signal; end Signals.Persistent;
To create a transient signal:
package Signals.Transient is protected type Transient_Signal is new Signal with procedure Send; entry Wait; end Transient_Signal; end Signals.Transient; package body Signals.Transient is protected body Transient_Signal is procedure Send is begin if Wait'Count = 0 then return; end if; Signal.Send; end Send; entry Wait when Signal_Arrived is begin Signal_Arrived := False; end; end Transient_Signal; end Signals.Transient;
Now, of course,
My_Signal : All_Signals := new ...; My_Signal.Send;
will dispatch to the appropriate signal handler.
Advanced Resource Control Example:
This example involves adding an Allocate_N operation to an existing resource controller that originally only supported allocating a single resource at a time.
package Rsc_Controller is Max_Resources_Available : constant Natural := 100; -- For example No_Resources_Allocated : exception; -- raised by deallocate
protected type Simple_Resource_Controller is tagged entry Allocate; procedure Deallocate; entry Hold; entry Resume; private Free : Natural := Max_Resources_Available; Taken : Natural := 0; Locked : Boolean := False; end Simple_Resource_Controller; end Rsc_Controller;
package body Rsc_Controller is protected body Simple_Resource_Controller is entry Allocate when Free > 0 and not Locked and Hold'Count = 0 is begin Free := Free -1; -- allocate resource Taken := Taken + 1; end Allocate; procedure Deallocate is begin if Taken = 0 then raise No_Resources_Allocated; end if; Free := Free + 1; -- return resource Taken := Taken - 1; end Deallocate; entry Hold when not Locked is begin Locked := True; end Hold; entry Resume when Locked is begin Locked := False; end Resume; end Simple_Resource_Controller; end Rsc_Controller;
package Rsc_Controller.Advanced is protected type Advanced_Resource_Controller is new Simple_Resource_Controller with entry Allocate_N (N : in Natural); procedure Deallocate; pragma overriding(Deallocate); private entry Wait_For_N (Boolean)(N : in Natural); -- Entry family with two members, used as a parking lot -- for Allocate_N requests that cannot be immediately -- satisfied. Current_Queue : Boolean := False; -- Indicates which of the two 'Wait_For_N' entry queues is the one -- that currently shall be used. (Two queues are used: one queue -- is used when trying to satisfy requests, requests that cannot -- be satisfied are requeued to the other. Then, the roles of the -- two queues are swapped. This avoids problems when the calling -- tasks have different priorities.) Changed : Boolean := False; -- Set whenever something is deallocated. Needed for correct -- implementation of 'Allocate_N' and 'Wait_For_N'. Reset each -- time outstanding calls to these routines have been serviced. -- 'Changed' actually encodes the history information 'Wait_For_N' -- is only accepted after a call to 'Deallocate'. end Advanced_Resource_Controller; end Rsc_Controller.Advanced;
package body Rsc_Controller.Advanced protected body Advanced_Resource_Controller is procedure Deallocate is -- Overridden to account for new history information encoding -- needed for access to parameter in the barrier of Allocate_N. begin Changed := True; Simple_Resource_Controller.Deallocate; end Deallocate; entry Allocate_N (N : in Natural) when Free > 0 and not Locked and Hold'Count = 0 is begin if Free >= N then Free := Free - N; Taken := Taken + N; else requeue Wait_For_N(Current_Queue); end if; end Allocate_N; entry Wait_For_N (for Queue in Boolean)(N : in Natural) when not Locked and Hold'Count = 0 and (Queue = Current_Queue) and Changed is begin if Wait_For_N(Queue)'Count = 0 then Current_Queue := not Current_Queue; Changed := False; end if; if Free >= N then Free := Free - N; Taken := Taken + N; else requeue Wait_For_N(not Queue); end if; end Wait_For_N; end Advanced_Resource_Controller; end Rsc_Controller.Advanced;
!ACATS test
!appendix

/* ---------- "LSN on Extensible Protected Types" ---------- */
From stt  Mon Jun  1 18:46:55 1992
From: stt (Tucker Taft)
Subject: LSN on Extensible Protected Types

!topic LSN on Extensible protected types
!key LSN-1030
!reference MS-9.5;4.0
!reference MS-3.4.1;4.0
!from Tucker Taft 92-06-01
!discussion

[Note, we are numbering this LSN 1030 to avoid colliding with
Art's sequence numbers for non-MRT LSNs]

Now that we have pretty much agreed to have OOP in Ada 9X,
as well as some kind of special syntax to support fast
mutual exclusion (e.g. protected types), it seems appropriate
to reopen the question of whether there should be a way
to have extensible protected types. In an early
Mapping Document we suggested a syntax, but gave no
further explanation, and after some thought about implementation
concerns, we dropped the idea.

Recently, Ted Baker and others
have been experimenting with adding concurrency control
to abstract data types, and have found that the lack of
"tagged" protected types makes the solutions awkward.
In particular, one must shift from using a syntax-based
non-queued mutual exclusion over to an explicit locking
approach, using a protected object as a component.
Here is an example of the approach:

     package Synch_Pkg is
         -- Define a type to be used as a component,
         -- and a type to be used as an exclusive handle on
         -- the component
         protected type Lock is
             entry Acquire;
             procedure Release;
         private record
             Locked : Boolean := False;
         end Lock;

         type Exclusive_Handle(On_Lock : access Lock) is
           new System.Controlled with null;

         procedure Initialize(Handle : in out Exclusive_Handle);
         procedure Finalize(Handle : in out Exclusive_Handle);
     end Synch_Pkg;

     package body Synch_Pkg is
         protected body Lock is
             entry Acquire when not Locked is
             begin
                 Locked := True;
             end Acquire;
             procedure Release is
             begin
                 Locked := False;
             end Release;
         end Lock;

         type Exclusive_Handle(On_Lock : access Lock) is
           new System.Controlled with null;
             -- Declare an object of this type
             -- to acquire a lock; it will be released
             -- automatically.

         procedure Initialize(Handle : in out Exclusive_Handle) is
         begin
             Handle.On_Lock.Acquire;  -- acquire lock during init
         end Initialize;

         procedure Finalize(Handle : in out Exclusive_Handle) is
         begin
             Handle.On_Lock.Release;  -- release lock when exiting
         end Finalize;
     end Synch_Pkg;

Given the above package, we can embed such a lock
in the root type of a tagged class, or we can use a generic
to add it to any type. Here is how you could use it
with a tagged type:

     with Synch_Pkg;
     package Whatever is
         type Concurrent_Type is tagged record
             Lock : Synch_Pkg.Lock;
             -- Other components to be added by extension
         end record;
     end Whatever;

Now we can extend the root pkg with some components,
and define some operations:

     with Whatever;
     package Another_Pkg is
         type Extension is new Whatever.Concurrent_Type with record
             Some_Component;
         end record;
         procedure Some_Operation(X : in out Extension);
     end Another_Pkg;

     with Synch_Pkg;
     package body Another_Pkg is
         procedure Some_Operation(X : in out Extension) is
             Handle : Synch_Pkg.Exclusive_Handle(X.Lock'ACCESS);
             -- X.Lock is now acquired
         begin
             X.Some_Component := X.Some_Component + 1;
             -- X.Lock is released automatically
         end Some_Operation;
     end Another_Pkg;

Here is how you could add a "lock" to any type with
a generic:

    with Synch_Pkg;
    generic
        type Contents_Type is limited private;
          -- Type to be inside the locked box
    package Locking_Pkg is
        type Locked_Box is limited private;
          -- Type representing the locked box
        generic
            with procedure Operation(Contents : in out Contents_Type);
        procedure Locking_Operation(Box : in out Locked_Box);
          -- Instantiate this to produce a locking operation
    private
        type Locked_Box is record
            Contents : Contents_Type;
            Lock : Synch_Pkg.Lock;
        end record;
    end Locking_Pkg;

    package body Locking_Pkg is
        procedure Locking_Operation(Box : in out Locked_Box) is
            Handle : Synch_Pkg.Exclusive_Handle(Box.Lock'ACCESS);
            -- Box.Lock is now acquired
        begin
            Operation(Box.Contents);
            -- Box.Lock is released automatically
        end Locking_Operation;
    end Locking_Pkg;

We could use a more complex lock if we wanted to,
e.g. one that provided both exclusive read/write and
shared read/only type access, with two different "Handle"
types, one that got the exclusive lock when initialized,
the other than got the shared lock when initialized.

By using finalization to release the locks, we get automatic
release on unhandled exceptions and abort/ATC.

Unfortunately, these approaches have some drawbacks:

   a) They require that each locking operation include the declaration
      of the local "handle" object. The generic approach ensures that
      this is always done, but it is a bit clumsy.

   b) The locking is queued, rather than non-queued.

   c) There is no protection against priority inversion.

   d) Getting a shared lock still requires the Lock component
      to be read/write, so either the Lock would have to be
      pointed-to, or the object would have to be an IN OUT parameter
      even when the operation was a read-only operation.

   e) One locking operation cannot call another such operation, because
      deadlock would occur when the second operation tried
      to initialize the exclusive handle. With the generic approach,
      there is presumably a full set of non-locking operations that operate
      on the "contents" type, so this is less of a problem.

Arguably a more natural approach is to simply make the type
a tagged protected type (or the moral equivalent), and then
add more protected operations and components as part of type
extension. A possible syntax for this would be (upper case = bold):

    PROTECTED TYPE identifier [discriminant_part] IS
     [TAGGED | NEW subtype_indication WITH]
        {protected_operation_declaration}
      PRIVATE
        {protected_operation_declaration}
      RECORD
        component_list
      END [protected_simple_name];

We have allowed TAGGED or "NEW subtype_indication WITH" following
the "IS." In the case of "NEW subtype_indication WITH" the subtype
indication would have to specify a tagged protected type as the parent.
By so doing, a single non-queued lock would be used for the
components and operations inherited from the parent, as well as
the new components and operations defined in the derived type.

This seems like a relatively straightforward approach. There
are nevertheless some subtle semantic and implemention issues associated
with overriding existing entries, or even just adding new ones.
The general idea would be that for a tagged protected type,
at the end of a protected operation, one would "redispatch"
to reevaluate all of the entry barriers. One would *not* be
able to optimize barrier evaluation, since in general one
operation might be overridden while another might not be.
Similarly, a "requeue" would always be a redispatch,
meaning that the requeuer could not build in any knowledge
of the target entry's barrier.

(Note: By "redispatch" we mean that one goes back to the
"original" tag of the object, even if some intermediate
conversions to ancestor types have occurred implicitly or explicitly
as part of calling inherited operations.)

Even the number of entries wouldn't be knowable statically
when generating the code for a protected operation, because
it might be inherited into a type that has more entries.
The storage allocation problem for a protected type might
also be a little trickier, if a bit-vector approach is used for
entry barriers, or an array of entries is used, since one would be
adding potentially more components as well as more entries.

One possible approach to solving some of these problems
is to regenerate the code for *all* of the protected operations,
even those that are inherited "as is." However, this does
not necessarily solve the problem, since we probably want
a redispatch for entry-queue servicing
to occur at the end of a protected operation even
if it is reached by explicit conversion to a parent type.

Here is an example of a possible tagged protected
type with an extension, to illustrate some of the
conversion and "redispatching" issues.

     protected type PT1 is tagged
       -- A simple exclusive lock
         procedure Release;
         entry Acquire;
     private record
         Locked : Boolean := False;
     end PT1;

     protected body PT1 is
         procedure Release is
         begin
             Locked := False;
         end Release;
         entry Acquire when not Locked is
         begin
             Locked := True;
         end Acquire;
     end PT1;

     protected type PT2 is new PT1 with
       -- Add operations to support shared locks
         procedure Release_Shared;
         entry Acquire_Shared;
         entry Acquire;  -- Override
         -- inherit Release as is.
     private record
         Reader_Count : Natural := 0;
     end PT2;

     protected body PT2 is
         procedure Release_Shared is
         begin
             Reader_Count := Reader_Count - 1;
         end Release_Shared;
         entry Acquire_Shared when not Locked is
         begin
             Reader_Count := Reader_Count + 1;
         end Acquire_Shared;

         entry Acquire when not Locked and then Reader_Count = 0 is
            -- Obviously this is non-optimal;
            -- A single counter would be better, where < 0 means exclusive,
            -- and > 0 means shared. But this is an example, remember?
         begin
             Locked := True;
         end Acquire;
     end PT2;

Suppose we have an instance of PT2, and we convert it to
PT1 and call Release. We still want both entries of the
object to be serviced, even though the operation was called after
converting to a type that only had one entry.

A more interesting question is what happens if we convert it to
PT1 and call the entry Acquire. In this case, does it use the barrier
expression and body from PT1.Acquire, or PT2.Acquire?
It seems just too weird (and painful to implement
if using a bit-vector approach to barrier expressions)
to allow it to reach PT1.Acquire.
Hence, we could consider the semantics of an entry call to be
roughly, add the call to the appropriate queue, and then
redispatch to service the queues. In other words, it wouldn't
matter whether you converted a tagged protected object to some
ancestor type, an entry call would end up the same place,
namely the "true" entry based on the original tag of the object.

This distinction between subprogram and entry operations
is somewhat disconcerting, but from an implementation
point of view, it tends to agree with the general approach
of "directly" calling protected subprograms, while only
indirectly calling entries via the RTS. Similarly, it jibes
with the fact that the caller always executes their "own"
protected subprograms, whereas entry body execution and
barrier evaluation takes place somewhere in the "ether."
Finally, it is consistent with calls between protected subprograms,
since these bypass the locking completely, and can be totally
statically bound, corresponding to calls between primitives
of non-protected types. Entries may not call one another directly,
and redispatching does seem appropriate for "requeue."

We could "punt" on the issue and simply disallow overriding
existing entries, but that will only lead the user to
asking "why on earth did you put in that restriction?"
And of course, for situations where one is just using
mutual exclusion and no entries, there is no issue about
which barriers to evaluate and which entry bodies to execute.
Certainly, in the above example it would be natural
to have class-wide operations on PT1'CLASS that call only
Acquire and Release, but we certainly want such operations
to get our overridden Acquire instead of the original one.

All of the above issues seem relatively soluble. The question is
whether the benefit of being able to naturally combine the
OOP concepts and protected type concepts is sufficient to
justify whatever added implementation (and conceptual) complexity
is involved. Or, alternatively, is it cheaper to just implement
tagged protected types than to take flak about having no good
support for concurrent object oriented programming.

Note that if barriers were restricted to being
boolean variables, then we would have to override protected
procedures to make them update additional boolean variables,
but we wouldn't have to update entries just to change their
barrier. Interesting tradeoff, and probably one that is
better left to the designer (since they can choose to use
boolean variables instead of expressions if they so desire).

By the way, with a "PT2" kind of lock (readers and writers)
there is a classic fairness issue that can be partially
resolved by disallowing new readers if there are too many
writers stacked up. This implies using Acquire'COUNT
in the barrier for Acquire_Shared (and perhaps vice-versa).
This is a case where it is more difficult to solve this
problem without 'COUNT in a barrier, since the writers
may all stack up between calls to Acquire_Shared.

We welcome comments on these issues!

****************************************************************

From: Tucker Taft
Sent: Wednesday, November 22, 2000 3:06 PM

I received the May 2000 issue of TOPLAS today, and lo and behold
it included an article on integrating object-oriented programming
and Protected objects in Ada 95, with our very own Steve Michell
as a co-author. The article inspired me to produce an alternative,
simpler proposal than that implied by the article, more along the lines
of the original LSN-1030. I have included the proposal here.
Steve may want to prepare his own alternative as well, if he
is not satisfied with this one. Alternatively, he could refine
this one.
-Tuck
---------------
!standard 09.04    (04)                               00-11-21  AI95-xxx/01
!standard 09.05.02 (02)
!class amendment 00-11-21
!priority Medium
!difficulty Hard
!subject Protected Types, Extensible, Tagged, Abstract

!summary

This proposes that protected types support extensibility similar
to the way that record types are extensible in Ada 95. In an
extension of a "tagged" protected type, additional data components
and protected operations can be defined, and inherited
protected operations can be overridden. This proposal is
based on work done during the original Ada 9X project (in particular
LSN-1030 -- See appendix below) as well as more recent writings by
Burns and Welling [Concurrency in Ada], and Wellings, Johnson,
Sanden, Kienzle, Wolf, and Michell [ACM TOPLAS May 2000, vol 22.3].

!question


!recommendation


Here is the proposed revised syntax (protected_type_declaration is here for
reference only -- it isn't changed):

   protected_type_declaration ::=
     PROTECTED TYPE defining_identifier [known_discriminant_part] IS
       protected_definition;

   protected_definition ::=
     [ABSTRACT] [TAGGED | NEW subtype_indication WITH]
        {protected_operation_declaration}
      [PRIVATE
        {protected_element_declaration}]
      END [protected_identifier]
    | [ABSTRACT] NEW subtype_indication WITH PRIVATE
    | [ABSTRACT] TAGGED PRIVATE

   protected_operation_declaration  ::=
      -- as before ...
      | abstract_subprogram_declaration
      | abstract_entry_declaration

   abstract_entry_declaration ::=
     ENTRY defining_identfier [(discrete_subtype_definition)]
       parameter_profile IS ABSTRACT;

We have allowed ABSTRACT, and TAGGED or "NEW subtype_indication WITH",
following the "IS." In the case of "NEW subtype_indication WITH" the subtype
indication would have to specify a tagged protected type as the parent.
This form defines a "protected extension" of its parent.

If the word ABSTRACT appears, no objects of the protected type may
be created. In addition one or more of the protected operations
may be declared ABSTRACT, as may one or more of the primitive
operations of the protected type (remember that the primitives
of a protected type are defined *outside* the protected type
declaration, just like that of any other type).

If the "NEW ... WITH PRIVATE" or "TAGGED PRIVATE" form is used, the type
declaration must appear in the visible part of a package, or as a generic
formal type. In the non-generic case, a non-private tagged
protected declaration must appear in the private part of the package, and
in the NEW ... WITH case, it must be a descendant of the specified
ancestor protected type. If ABSTRACT does not appear, the full
type must not be abstract. In the generic formal type case,
the corresponding actual parameter must be a protected tagged type,
descended from the specified ancestor type in the NEW ... WITH case.
If ABSTRACT does not appear, the actual type must not be abstract.

[NOTE: It is not clear there is a lot of value in the TAGGED PRIVATE
case, except perhaps for generic mix-ins. However, it may be valuable
to identify a type as protected tagged, even if none of its protected
operations are directly visible, simply to indicate that the type
supports simultaneous access from multiple tasks, and to enable
extensions that take advantage of the parent type's mutex.]

A protected tagged type does not match/complete a non-protected
(limited) tagged type, because the rules for extension are different.

The Class attribute may be applied to a tagged protected type.
Presuming PT is a tagged protected type, PT'Class supports
implicit conversion from all descendants of PT, and their
corresponding class-wide types; i.e., PT'Class covers all of
PT's descendants, and their class-wide types.

Within a protected extension, the private operations
and the data components of the parent are visible only if the extension
is declared within the immediate scope of the full declaration of the
parent protected type. This includes within a child unit, if the
parent is defined immediately within a library package. This ensures
that changes to the private components and operations do not affect
code outside the subsystem within which it is defined.

If NPT is an extension of PT, or a descendant of an extension,
explicit conversion from NPT to PT is not permitted, except
within the body of NPT itself. Even within the body, it is
only permitted if PT is the immediate parent of NPT, or if
NPT has visibility on the private declaration part of all intervening
extensions (e.g. in a child package). It is always legal to convert
to PT'Class, and to convert from PT'Class to NPT'Class (a run-time tag check
is required in this case). Analogous rules would makes sense
for non-protected private type extensions, because converting
to an ancestor specific type is privacy-breaking if any extensions
are private. It was probably a mistake that Ada 95 allowed such
conversions, and a configuration pragma to disallow them has been
discussed in the past (probably should be another amendment AI).

From within a protected extension, it is possible to call an overridden
protected subprogram of an ancestor type, using the following syntax:

    ancestor_protected_subtype_mark .
      protected_subprogram_identifier actual_parameter_part

To preserve abstraction, analogous to the conversion restriction above,
this kind of call would only be permitted if the ancestor
is the immediate parent, or if the extension has visibility on
the private declarations of all intervening extensions (e.g. is
in a child package).

To redispatch as part of an internal protected operation call, the
following syntax is proposed:

    protected_subtype_mark'Class .
      protected_subprogram_identifier actual_parameter_part

Supporting this new syntax comes down to defining the meaning of an expanded
name where the prefix denotes an ancestor/classwide subtype of a protected
extension, and the selector_name denotes a potentially overridden protected
subprogram, when inside the body of the protected extension. [Note that
there is no need for identifying the entry of an ancestor once it
has been overridden, since this proposal presumes there is only one
entry queue per entry, and only one entry body handling it -- see
Dynamic Semantics below.]

The above special kinds of expanded names are not strictly necessary;
we could alternatively require the use of a view conversion applied to
the protected extension's identifier, where the extension's identifier
identifies the "current instance." For example:

    PT(NPT).Proc(3,5)

could be used to call the PT implementation of "proc" rather than
the NPT one which overrides it. It would be important to consider
this form an "internal" call so no new lock is acquired.
The syntax "PT.Proc(3,5)" seems more natural, and is probably
worth supporting.

        Dynamic Semantics

When a protected extension is defined,
a single mutex is used for the components and operations
inherited from the parent, as well as the new components and
operations defined in the extension.

There remains only one entry queue per entry, whether an entry
is inherited or overridden in an extension. This means that all
entry calls or requeues to a given entry are added to its
one entry queue, and when serviced, all are handled by
the "current" entry body, which is either an inherited
one or an overriding one. This may be considered equivalent to
saying that all entry calls/requeues are "dispatching." For example,
if an inherited entry does a requeue to another entry, it always
"redispatches" to any overriding body of the target entry.

Protected subprograms, on the other hand, work the same
way as "normal" primitive subprograms, namely an internal call from
one protected subprogram to another is statically bound,
unless the classwide subtype is used as the prefix of the call.

!discussion

This proposal is a combination of ideas from LSN-1030, and those
arising out of the more recent writings. The more recent proposals
suggest various mechanisms for allowing calling of overridden
entries, but those suggestions require substantial added complexity
in terms of exposing entry barriers, incrementally strengthening
entry barriers, dealing with ancestor barriers that are no longer
true at the point of requeue/call, etc. For this proposal, the added benefit
of calling overridden entries was not felt to outweigh this added
complexity.

Certainly one of the challenges with extensible protected types
is the lack of compelling examples. There seems almost a faith
that inheritance is a "good" thing, and hence it should be supported
for protected types. However, there are some indications that
polymorphism is in some ways a more important capability than
(implementation) inheritance. Hence, the ability to "pass the buck"
to overridden code seems less critical. More important is the
ability to do "classwide" programming with protected types.
This also implies that abstract protected types are important,
and in many cases, the type hierarchy will be very shallow, with
just an abstract type at the root of the hierarchy, and multiple
concrete descendants just one level down forming the leaves of the
hierarchy. There are some examples that might justify more than
two levels in the tree, but they seem more the exception than
the rule. Note that in the DRAGOON language built on Ada 83,
only the leaves were allowed to be non-abstract.

One thing that seems to have been forgotten in the writings
on extensible protected types is that they are still types,
and hence in addition to the protected operations, they also
have "normal" primitive operations. In many situations, it
may be better to only expose the "normal" primitive operations,
and hide the protected operations completely. This is possible
in Ada 95 as it is, by declaring the type as "limited private,"
and then completing it with a protected type. This proposal
would also allow a type to be declared "protected tagged private."
Such a type would have no visible protected operations. However,
it would be extensible in a way that would allow an extension
to share the lock with the original type. This capability is
difficult to achieve currently, and could represent an important
new OO flexibility.

-------------------------------------------
Examples based on May 2000 TOPLAS article

Signal Example:

package Signals is
    protected type Signal is abstract tagged
        procedure Send;
        entry Wait is abstract;
    private
        Signal_Arrived : Boolean := True;
    end Signal;
    type All_Signals is access Signal'Class;
end Signals;
package body Signals is
    protected body Signal is
        procedure Send is
        begin
            Signal_Arrived := True;
        end Send;
    end Signal;
end Signals;

Now to create a persistent signal:

package Signals.Persistent is
    protected type Persistent_Signal is new Signal with
        entry Wait;
    end Persistent_Signal;
end Signals.Persistent;
package body Signals.Persistent is
    protected body Persistent_Signal is
        entry Wait when Signal_Arrived is
        begin
            Signal_Arrived := False;
        end;
    end Persistent_Signal;
end Signals.Persistent;

To create a transient signal:

package Signals.Transient is
    protected type Transient_Signal is new Signal with
        procedure Send;
        entry Wait;
    end Transient_Signal;
end Signals.Transient;
package body Signals.Transient is
    protected body Transient_Signal is
        procedure Send is
        begin
            if Wait'Count = 0 then
                return;
            end if;
            Signal.Send;
        end Send;
        entry Wait when Signal_Arrived is
        begin
            Signal_Arrived := False;
        end;
    end Transient_Signal;
end Signals.Transient;

Now, of course,

    My_Signal : All_Signals := new ...;
    My_Signal.Send;

will dispatch to the appropriate signal handler.


Advanced Resource Control Example:

This example involves adding an Allocate_N operation to an
existing resource controller that originally only supported
allocating a single resource at a time.

package Rsc_Controller is
    Max_Resources_Available : constant Natural := 100; -- For example
    No_Resources_Allocated : exception; -- raised by deallocate

    protected type Simple_Resource_Controller is tagged
        entry Allocate;
        procedure Deallocate;
        entry Hold;
        entry Resume;
    private
        Free : Natural := Max_Resources_Available;
        Taken : Natural := 0;
        Locked : Boolean := False;
    end Simple_Resource_Controller;
end Rsc_Controller;

package body Rsc_Controller is
    protected body Simple_Resource_Controller is
        entry Allocate when Free > 0 and not Locked and
            Hold'Count = 0 is
        begin
            Free := Free -1; -- allocate resource
            Taken := Taken + 1;
        end Allocate;
        procedure Deallocate is
        begin
            if Taken = 0 then
                raise No_Resources_Allocated;
            end if;
            Free := Free + 1; -- return resource
            Taken := Taken - 1;
        end Deallocate;
        entry Hold when not Locked is
        begin
            Locked := True;
        end Hold;
        entry Resume when Locked is
        begin
            Locked := False;
        end Resume;
    end Simple_Resource_Controller;
end Rsc_Controller;


package Rsc_Controller.Advanced is
    protected type Advanced_Resource_Controller is
      new Simple_Resource_Controller with
        entry Allocate_N (N : in Natural);
        procedure Deallocate;
            pragma Overriding(Deallocate);
    private
        entry Wait_For_N (Boolean)(N : in Natural);
        -- Entry family with two members, used as a parking lot
        -- for Allocate_N requests that cannot be immediately
        -- satisfied.
        Current_Queue : Boolean := False;
        -- Indicates which of the two 'Wait_For_N' entry queues is the one
        -- that currently shall be used. (Two queues are used: one queue
        -- is used when trying to satisfy requests, requests that cannot
        -- be satisfied are requeued to the other. Then, the roles of the
        -- two queues are swapped. This avoids problems when the calling
        -- tasks have different priorities.)
        Changed : Boolean := False;
        -- Set whenever something is deallocated. Needed for correct
        -- implementation of 'Allocate_N' and 'Wait_For_N'. Reset each
        -- time outstanding calls to these routines have been serviced.
        -- 'Changed' actually encodes the history information 'Wait_For_N'
        -- is only accepted after a call to 'Deallocate'.
    end Advanced_Resource_Controller;
end Rsc_Controller.Advanced;

package body Rsc_Controller.Advanced
    protected body Advanced_Resource_Controller is
        procedure Deallocate is
        -- Overridden to account for new history information encoding
        -- needed for access to parameter in the barrier of Allocate_N.
        begin
            Changed := True;
            Simple_Resource_Controller.Deallocate;
        end Deallocate;
        entry Allocate_N (N : in Natural) when
          Free > 0 and not Locked and Hold'Count = 0 is
        begin
            if Free >= N then
                Free := Free - N;
                Taken := Taken + N;
            else
                requeue Wait_For_N(Current_Queue);
            end if;
        end Allocate_N;
        entry Wait_For_N (for Queue in Boolean)(N : in Natural) when
          not Locked and Hold'Count = 0 and
          (Queue = Current_Queue) and Changed is
        begin
            if Wait_For_N(Queue)'Count = 0 then
                Current_Queue := not Current_Queue;
                Changed := False;
            end if;
            if Free >= N then
                Free := Free - N;
                Taken := Taken + N;
            else
                requeue Wait_For_N(not Queue);
            end if;
        end Wait_For_N;
    end Advanced_Resource_Controller;
end Rsc_Controller.Advanced;

****************************************************************

From: Tucker Taft
Sent: Saturday, November 25, 2000 2:06 PM

Jean-Pierre Rosen wrote:
>
> We had a paper at Ada-Europe about all the semantic implications, which
> convinced me that it was really not simple...
> Does your proposal address all these issues ? And what problems does it solve
> that cannot be solved with a protected type embedded into a tagged type ?

I think perhaps the most important is the issue of sharing a lock
between a parent type and a descendant type.

> The big argument for inheritance is that it avoids code duplication. I would
> expect most of protected operations to be in the range of tens of LOC, so
> duplication is not a big deal, especially considering that a typical PO user:
> - is sensitive about execution speed
> - wants to see exactly what is executed

I agree that inheritance is not all it is cracked up to be,
especially for types with any synchronization. On the other hand,
polymorphism can be quite useful, and the ability to share a lock
could also be an important paradigm in a layered system.

I know when we were designing our Ada 95 run-time system, there
was a natural application for extensible protected types. We have
a low-level "thread" abstraction, which is extended to become
a higher-level "Ada task" abstraction. It would be nice if
the higher-level abstraction and the lower-level abstraction could
all share a single lock. We currently use tagged types, with
a protected object inside, but it is a bit awkward and unnatural.

****************************************************************

From: Stephen Michell
Sent: Wednesday, December 13, 2000 11:15 AM

Attached is an AI for a language extension to include tagged protected types
prepared largely by Thomas Wolf following the paper that Wellings et al.
published in TOPLAS this May, and combining some of Tucker's proposals on
these issues. The AI includes 2 annexes, a copy of the LSN 1030 and an
abridged copy of the TOPLAS paper (abridged since it leaves out sect 3 -
explanation of protected types for those unfamiliar with Ada). I am sending
the appendices as 2 additional mail messages since the amount of material is
substantial. Hopefully, this lets you delete the ones that duplicate material
for you.

By now all 6 authors should be on the ARG mailing list to participate in
discussions.

I'm not sure how Randy wants to handle this as an AI. There should probably
not be 2 AI's on the same topic. Probably we need to have some rousing
discussion, and then some amended version of these proposals should go into
the AI.

On with the show...

****************************************************************

--  Appendix 2: TOPLAS paper in ASCII version
--
--  Appeared in ACM TOPLAS 22(3), pp. 506 -- 539
--
--  Note: Footnotes are near the bottom, just above the
--  bibliography.
--
--  Also note that one of the authors has changed affiliation
--  since this work was begun. The current coordinates are:
--    Th. Wolf, Paranor AG, Wahlendorf, Bern, Switzerland,
--    E-Mail : twolf@acm.org

Integrating Object-Oriented Programming and
Protected Objects in Ada 95

(FOOTNOTE 1)

A.J. Wellings
Department of Computer Science
University of York, UK
Email: andy@cs.york.ac.uk

B. Johnson and B. Sanden
Department of Computer Science
Colorado Technical University, USA
Email: bjohnson@cos.coloradotech.edu, bsanden@acm.org

J. Kienzle and T. Wolf
Software Engineering Laboratory
Swiss Federal Institute of Technology in Lausanne,
Switzerland
Email: Joerg.Kienzle@epfl.ch, twolf@acm.org

S. Michell
Maurya Software
Ontario, Canada
Email: steve@maurya.on.ca

-------------------------------------------------------

ABSTRACT:
Integrating concurrent and object-oriented programming has
been an active research topic since the late 1980s. There is
now a plethora of methods for achieving this integration. The
majority of approaches have taken a sequential object-oriented
language and made it concurrent. A few approaches have taken a
concurrent language and made it object-oriented. The most
important of this latter class is the Ada 95 language
which is an extension to the object-based concurrent
programming language Ada 83.

Arguably, Ada 95 does not fully integrate its models of
concurrency and object-oriented programming. For example,
neither tasks nor protected objects are extensible. This paper
discusses ways in which protected objects can be made more
extensible.

CATEGORIES AND SUBJECT DESCRIPTORS: D.3.3 [Programming
Languages]: Language Constructs and Features -- Concurrent
programming structures and inheritance

GENERAL TERMS: Concurrency, Languages

ADDITIONAL KEYWORDS AND PHRASES: concurrent object-oriented
programming, inheritance anomaly, Ada 95.

----------------------------------------------------------

1. Introduction

Arguably, Ada 95 does not fully integrate its models of
concurrent and object-oriented programming [Atkinson and
Weller 1993],[Wellings et al.1996],[Burns and Wellings1998].
For example, neither tasks nor protected objects are extensible.
When Ada 95 was designed, the extensions to Ada 83 for object-
oriented programming were, for the most part, considered separate
to extensions to the concurrency model. Although some
consideration was given to abandoning protected types and instead
using Java-like synchronised methods in their place, there was no
public debate of this issue. Similarly, there was no public debate
on the issues associated with allowing protected types or tasks to
be extended.

The purpose of this paper is to discuss ways in which the Ada 95
concurrency model can be better integrated with object-oriented
programming. The paper is structured as follows. Section 2
introduces the main problems associated with the integration of
object-oriented and concurrent programming. Section 3 then
describes the main features of the Ada 95 language that are
relevant to this work. Section 4 argues that Ada 95 does not have
a well-integrated object-oriented concurrency model. To achieve
better integration, Section 5 proposes that Ada's protected type
mechanism be made extensible and discusses the main syntactic and
semantic issues. Sections 6 then considers how extensible protected
types integrate with Ada's general model of abstraction and
inheritance. Sections 7 and 8 discuss how the proposals address the
inheritance anomaly and how they can be used in conjunction with the
current object-oriented mechanisms. Section 9 presents some extended
examples and Section 10 draws conclusions from this work.


2. Concurrent Object-Oriented Programming

Integrating concurrent and object-oriented programming has been an
active research topic since the late 1980s. There is now a plethora
of methods for achieving this integration (see [Wyatt et al. 1992]
for a review). The majority of approaches have taken a sequential
object-oriented language and made it concurrent (for example, the
various versions of concurrent Eiffel [Meyer 1993],[Caromel 1993],
[Karaorman and Bruno1993] ). A few approaches have taken a
concurrent language and made it object-oriented. The most important
of this latter class is the Ada 95 language which is an extension
to the object-based concurrent programming language Ada 83. A full
discussion of this language will be given in the next section.

In general, there are two main issues for concurrent object-
oriented programming:

  *  the relationship between concurrent activities and objects --
     here the distinction is often between the concept of an active
     object (which by definition will execute concurrently with
     other active objects, for example [Maio et al. 1989; Mitchell
     and Wellings 1996; Newman1998] and where concurrent execution
     is created by the use of asynchronous method calls (or early
     returns from method calls) ([Yonezawa et al. 1986; Yokote and
     Tororo 1987; Corradi and  Leonardi 1990])

  *  the way in which concurrent activities communicate and
     synchronise (and yet avoid the so-called inheritance anomaly
     [Matsuoka and Yonezawa1993]) -- see [Mitchell and Wellings 1996]
     for a summary of the various proposals.

Perhaps the most interesting recent development in concurrent
object-oriented programming is Java [Lea 1997; Oaks and Wong 1997].
Here we have, notionally, a new language which is able to design a
concurrency model within an object-oriented framework without worrying
about backward compatibility issues. The Java model integrates
concurrency into the object-oriented framework by the combination of
the active object concept and asynchronous method calls. All descendants
of the pre-defined class Thread have the pre-defined methods "run" and
"start". When "start" is called, a new thread is created, which executes
"run". Subclassing Thread and overriding the "run" method allows an
application to express active objects. (It is also possible to obtain
"start" and "run" by implementing the interface Runnable.) Other methods
available on the Thread class allow for a wide range of thread control.
Communication and synchronisation is achieved by allowing any method
of any object to be specified as `synchronised'. Synchronised methods
execute with a mutual exclusion lock associated with the object. All
classes in Java are derived from the Object class that has methods
which implement a simple form of condition synchronisation. A thread can,
therefore, wait for notification of a single event. When used in
conjunction with synchronised methods, the language provides the
functionality similar to that of a simple monitor [Hoare 1974].

Arguably, Java provides an elegant, although simplistic, model of
object-oriented concurrency.


3. The Ada 95 Programming Language

[Scrapped. This section explains how protected types, tagged types,
and child packages work today in Ada 95. I guess we may well skip
this for this audience...! --  Th. Wolf]

4. Making Concurrent Programming in Ada 95 more Object-Oriented

Now that the dust is beginning to settle around the Ada 95
standard, it is important to begin to look to the future. The
object-oriented paradigm has largely been welcomed by the Ada
community. Even the real-time community, which was originally
sceptical of the facilities and worried about the impact they
would have on predictability, is beginning to see some of the
advantages. Furthermore, as people become more proficient in the
use of the language they begin to realise that better integration
between the concurrency and object-oriented features would be
beneficial. The goal of this paper is to continue the debate on
how best to achieve full integration in any future version of the
language.

There are the following classes of basic types in Ada:

   * scalar types - such as integer types, enumeration types, real
     types, etc.
   * structured types - such as record types and array types
   * protected types
   * task types
   * access types

Access types are special as they provide the mechanism by which
pointers to the other types can be created. Note that, although
access types to subprograms (procedures and functions) can be
created, subprograms are not a basic type of the language.

In providing tagged types, Ada 95 has provided a mechanism whereby
a structured type can be extended. It should be stressed, though,
that only record types can be extended, not array types. This is
understandable as the record is the primary mechanism for grouping
together items which will represent the heterogeneous attributes
of the objects. Furthermore, variable length array manipulation is
already catered for in the language. Similarly, scalar types can
already be extended using subtypes and derived types. Allowing
records to be extended thus is consistent with allowing variable
length arrays, subtypes and derived types.

A protected type is similar to a record in that it groups items
together. (In the case of a protected type, these items must be
accessed under mutual exclusion.) It would be consistent, then,
to allow a protected type to be extended with additional items.
The following sections will discuss some of the issues in allowing
extensible protected types. The issues associated with extensible
task types are the subject of on-going research.


5. Extensible Protected Types

To make protected types more integrated with the object-oriented
programming model requires modifications to the Ada 95 syntax and
semantics. The modifications center around the notion of an
extensible (tagged) protected type. The requirements for extensible
protected types are easy to articulate. In particular, they should
allow:

   * new data fields to be added,
   * new functions, procedures and entries to be added,
   * functions, procedures and entries to be overridden,
   * class-wide programming to be performed.

These simple requirements raise many complex semantic issues.
Furthermore, any proposed extensions should be fully integrated
with the Ada model of object-oriented programming.

5.1 Declaration and Primitive Operations

For consistency with the usage elsewhere in Ada, the word
`tagged' indicates that a protected type is extensible. As
described in section 3.1, a protected type encapsulates the
operations that can be performed on its protected data.
Consequently, the primitive operations of a tagged protected
type are, in effect, already defined. They are, of course, similar
to primitive operations of other tagged types in spirit but not
in syntax, since other primitive operations are defined by being
declared in the same package specification as a tagged type.

Consider the following example:

       protected type T is tagged --  new proposed syntax
         procedure W (...);
         function X (...) return ...;
         entry Y (...);
       private
         -- data attributes of T
       end T;

       O : T;

W, X, and Y can be viewed as primitive operations on T.
Interestingly, the call O.X takes a syntactic form similar to that
in most object-oriented languages. Indeed, Ada's protected object
syntax is in conflict with the language's usual representation of
an `object' (see Section 3.2).


5.2 Inheritance

Tagged protected types can be extended in the same manner as
tagged types. Hence,

     protected type T1 is new T with
       procedure W (...); -- override T.W
       procedure Z (...); -- a new method
     private
       -- new attributes of T1
     end T1;

The issue of overriding protected entries will be considered in
section 5.4.

One consideration is whether or not private fields in the parent
type (T) can be seen in the child type (T1). In protected types,
all data has to be declared as private so that it can not be
changed without first obtaining mutual exclusion. There are four
possible approaches to this visibility issue:

  1. Prevent a child protected object from accessing the parent's
     data. This would limit the child's power to modify the
     behaviour of its parent object, it only being allowed to
     invoke operations in its parent.
  2. Allow a child protected object full access to private data
     declared in its parent. This would be more flexible but has
     the potential to compromise the parent abstraction.
  3. Provide an additional keyword to distinguish between data
     that is fully private and data that is private but visible
     to child types. This keyword would be used in a similar way
     to "private" (much like C++ uses its keyword `protected' to
     permit descendent classes direct access to inherited data
     items).
  4. Allow child protected types to access private components of
     their parent protected type if they are declared in a child
     of the package in which their parent protected type is
     declared. This would be slightly inconsistent with the way
     protected types currently work in Ada because protected
     types do not rely on using packages to provide encapsulation.

The remainder of this paper will assume the second method, as it
provides the most flexibility and requires no new keywords. It
is also consistent with normal tagged types.

If a procedure in a child protected type calls a procedure or
function in its parent, it should not have to wait to obtain
the lock on the protected object before entering the parent,
otherwise deadlock would occur. There is one lock for each
instance of a protected type and the same lock should be used
when the protected object is converted to a parent type. This
is consistent with the current Ada approach when one procedure/
function calls another in the same protected object.


5.3 Dispatching and re-dispatching

Given a hierarchy of tagged protected types, it is possible to
create class-wide types and accesses to class-wide types; for
example:

     type Pt is access T'Class;

     P: Pt := new . . .; -- some type in the hierarchy

     P.W(...); -- dispatches to the appropriate projected object.

Of course from within P.W, it should be possible to convert back
to the class-wide type and re-dispatch to another primitive
operation. Unfortunately, an operation inside a tagged protected
type does not have the option of converting the object (on which
it was originally dispatched) to a class-wide type because this
object is passed implicitly to the operation. There are two
possible strategies which can be taken:

  1. make all calls to other operations from within a tagged
     protected type dispatching, or
  2. use some form of syntactic change to make it possible to
     specify whether to re-dispatch or not.

The first strategy is not ideal because it is often useful to
be able to call an operation in the same type or a parent type
without re-dispatching. In addition, the first strategy is
inconsistent with ordinary tagged types where re-dispatching is
not automatic.

A solution according to the second strategy uses calls of the
form "type.operation", where type is the type to which the
implicit protected object should be converted. The following is
an example of this syntax for a re-dispatch:

       protected body T is
         ...
         procedure P (...) is
         begin
           . . .
           T'Class.Q (...);
           . . .
         end P;
       end T;

T'Class indicates the type to which the protected object (which
is in the hierarchy of type T'Class but which is being viewed
as type T) that was passed implicitly to P should be view
converted. This allows it to define which Q procedure to call.
This syntax is also necessary to allow an operation to call an
overridden operation in its parent, for example:

       protected body T1 is -- an extension of T
         ...
         procedure W (...) is -- overrides the W procedure of T
         begin
           . . .
           T.W(...); -- calls the parent operation
           . . .
         end W;

       end T1;

This new syntax does not conflict with any other part of the
language because it is strictly only a type that precedes the
period. If it could be an instance of a protected type then the
call could be mis-interpreted as an external call: the Ada
Reference Manual [Intermetrics 1995] distinguishes between
external and internal calls by the use, or not, of the full
protected object name [Burns and Wellings 1998]. The call
would then be a bounded error.

Requeuing can also lead to situations where re-dispatching is
desirable. Just as with procedures, re-dispatching would only
occur when explicitly requested, so for example, in a protected
type T, requeue E would not dispatch whereas requeue T'Class.E
would dispatch. Requeuing to a parent entry would require barrier
re-evaluation. Requeues from other protected objects or from accept
statements in tasks could also involve dispatching to the correct
operation in a similar way.


5.4 Entry Calls

Allowing entries to be primitive operations of extensible protected
types raises many inter-related complex issues. These include:

  1. Can a child entry call its parent's entry? -- From an object-
     oriented perspective, it is essential to allow the child
     entry to call its parent. This is how reuse is achieved.
     Unfortunately, from the protected object perspective, calling
     an entry is a potentially suspending operation and these are
     not allowed within the body of a protected operation (see
     section 3.1). It is clear that a compromise is required and
     that a child entry must be able to extend the facilities
     provided by its parent.

  2. What is the relationship, if any, between the parent's barrier
     and the child's barrier? -- There are three possibilities: no
     relationship, the child can weaken the parent's barrier, or
     the child can strengthen the parent's barrier. Frĝlund [Frĝlund
     1992] suggests that as the child method extends the parent's
     method, the child must have more restrictive synchronisation
     constraints, in order to ensure that the parent's state remains
     consistent (FOOTNOTE 2). However, he also indicates that if the
     behaviour of the child method totally redefines that of the
     parent, it should be possible to redefine the synchronisation
     constraints. Alternatively, it can also be argued that the
     synchronisation constraints of the child should weaken those
     of the parent, not strengthen them, in order to avoid violating
     the substitutability property of subtypes [Liskov and Wing1994].

  3. How many queues does an implementation need to maintain for an
     overridden entry? -- If there is no relationship between the
     parent and the child barrier, it is necessary to maintain a
     separate entry queue for each overridden entry. If there is
     more than one queue, the 'Count attribute should reflect this.
     Hence 'Count might give different values when called from the
     parent or when called from the child. A problem with using
     separate entry queues with different barriers for overridden
     and overriding entries is that it is harder to theorise about
     the order of entries being serviced. Normally entries are
     serviced in first-in, first-out (FIFO) order but with separate
     queues, each with a separate barrier, this might not be
     possible. For example, a later call to an overridden entry
     will be accepted before an earlier call to an overriding entry
     if the barrier for the overridden entry becomes true with the
     overriding entry's barrier remaining false.

  4. What happens if a parent entry requeues to another entry? --
     When an entry call requeues to another entry, control is not
     returned to the calling entry but to the task which originally
     made the entry call (see section 3.1). This means that when a
     child entry calls its parent and the parent entry requeues,
     control is not returned to the child. Given that the code of
     the parent is invisible to the child, this would effectively
     prohibit the child entry from undertaking any post-processing.

In order to reduce the number of options for discussion, for the
remainder of the paper it is assumed that child entries must
strengthen their parent's barrier. The syntax "AND WHEN" is used
to indicate this (FOOTNOTE 3). To avoid having the body of a child
protected object depend on the body of its parent, it is necessary
to move the declaration of the barrier from the body to the
specification of the protected type (private part). Consider

       protected type T is tagged
         entry E;
       private
         I: Integer := 0;
         entry E when E'Count > 1;
         -- barrier given in the private part
       end T;

       protected type T1 is new T with
          entry E;
       private
          entry E and when I > 0;
       end T1;

       A: T1;

If a call was made to A.E, this would be statically defined as a
call to T1.E and would be subject to its barrier (E'Count > 1 and
then I > 0). The barrier would be repeated in the entry body.


Even with barrier strengthening, the issue of barrier evaluation
must be addressed. Consider the case where a tagged protected
object is converted to its parent type (using a view conversion
external to the protected type) and then an entry is called on
that type. It is not clear which barrier needs to be passed. There
are three possible strategies that can be taken:

  1. Use the barrier associated with the exact entry which is
     being called, ignoring any barrier associated with an entry
     which overrides this exact entry. As the parent type does not
     know about new data added in the child, it could be argued
     that allowing an entry in the parent to execute when the child
     has strengthened the barrier for that entry should be safe.
     Unfortunately, this is not the case. Consider a bounded buffer
     which has been extended so that the Put and Get operations can
     be locked. Here, if the lockable buffer is viewed converted
     to a normal buffer and Get/Put called with only the buffer
     barriers evaluated, a locked buffer will be accessible even
     if it is locked. Furthermore, this approach would also mean
     that there would be separate entry queues for overridden
     entries. The problems associated with maintaining more than
     one entry queue per overridden entry have already been
     mentioned.

  2. Use the barrier associated with the entry to which
     dispatching would occur if the object was converted to a
     class wide type (i.e., the barrier of the entry of the
     object's actual type). This is the strongest barrier and
     would allow safe re-dispatching in the entry body. This
     method results in one entry queue per entry instead of one
     for each entry and every overridden entry. However, it is
     perhaps misleading as it is the parent's code which is
     executed but the child's barrier expression that is
     evaluated.

  3. Allow view conversions from inside the protected object but
     require that all external calls are dispatching calls. Hence,
     there is only one entry queue, and all external calls would
     always invoke the primitive operations of the object's actual
     type. The problem with this approach is that currently Ada
     does not dispatch by default. Consequently, this approach
     would introduce an inconsistency between the way tagged types
     and extensible protected types are treated.

For the remainder of this paper, it is assumed that external calls
to protected objects always dispatch (FOOTNOTE 4).


5.4.1 Calling the Parent Entry and Parent Requeues

So far this section has discussed the various issues associated
with overridden entry calls. However, details of how the child
entry actually calls its parent have been left unspecified. The
main problem is that Ada forbids an entry from explicitly calling
another entry (see section 3.1). There are several approaches to
this problem.

  1. Use requeue. -- Although Ada forbids nested entry calls, it
     does allow an entry call to be requeued. Hence, the child can
     only requeue to the parent. Requeue gives the impression of
     calling the parent but it is not possible for the child to do
     any post-processing once the parent entry has executed (as the
     call returns to the caller of the child entry). As a requeue,
     the parent's barrier would have to be re-evaluated. Given that
     the child barrier has strengthened the parent's barrier, the
     parent's barrier would normally be open. If this is not the
     case, an exception is raised (to queue the call would require
     more than one entry queue (FOOTNOTE 5)). Furthermore, if
     atomicity is to be maintained and the parent requeue is to be
     part of the same protected action, the parent entry must be
     serviced before any other entries whose barriers also happen
     to be open. Hence, this requeue has slightly different
     semantics from a requeue between unrelated entries.

  2. Allow the child entry to call the parent entry and treat that
     call as a procedure call. -- It is clear that calling the
     parent entry is different from a normal entry call; special
     syntax has already been introduced to facilitate it (see
     section 5.3). In this approach, the parent call is viewed as
     a procedure call and therefore not a potentially suspending
     operation. However, the parent's barrier is still a potential
     cause for concern. One option is to view the barrier as an
     assertion and raise an exception if it is not True (FOOTNOTE
     6). The other option is not to test the barrier at all, based
     on the premise that the barrier was true when the child was
     called and, therefore, need not be re-evaluated until the
     whole protected action is completed.

With either of these approaches, there is still the problem that
control is not returned to the child if the parent entry requeues
requests to other entries for servicing. This, of course, could
be made illegal and an exception raised. However, requeue is an
essential part of the Ada 95 model and to effectively forbid its
use with extensible protected types would be a severe restriction.

The remainder of this paper will assume a model where parent calls
are treated as procedure calls (the issue of the assertion is left
open) and requeue in the parent is allowed. A consequence of this
is that no post-processing is allowed after a parent call.


6. Integration into the Full Ada 95 Model

The above section has considered the basic extensible protected
type model. Of course, any proposal for the introduction of such
a facility must also consider the full implications of its
introduction. This section considers the following topics:

   * private types,
   * abstract types, and
   * generics and mix-in inheritance

6.1 Private Types

The encapsulation mechanism of Ada 95, the package, gives the
programmer great control over the visibility of the entities
declared in a package. In particular, Ada 95 supports the notion
of private and limited private types, i.e. types whose internal
structure is hidden for clients of the packages (where the types
are declared) and that can be modified only through the primitive
operations declared in these packages (for these types). A
protected type is a limited type, hence it is necessary to show
how extensible protected types integrate into limited private
types. The following illustrates how this is easily achieved.

In order to make a type private, its full definition is moved to
the private part of the package. This can also be done for
extensible protected types:

     package Example1 is

        protected type Pt0 is tagged private;

     private

        protected type Pt0 is tagged
          --  primitive operations.
          ...
        private
          --  data items etc.
          ...
        end Pt0;

     end Example1;

Note that in this example, the primitive operations of type Pt0
are all declared in the private part of the package and are thus
visible only in child packages of package Example1. Other packages
cannot do anything with type Pt0, because they do not have access
to the type's primitive operations. Nevertheless, this construct
can be useful for class-wide programming using access types, e.g.
through

     type Pt_Ref is access Pt0'Class;

Private types can also give a finer control over visibility. One
might declare a type and make some of its primitive operations
publicly visible while other primitive operations would be private
(and thus visible only to child packages). For example:


     package Example2 is

       protected type Pt1 is tagged
         --  public primitive operations, visible anywhere
         ...
       with private
         --  data items etc., see (1) below
         ...
       end Pt1;

     private

       protected type Pt1 is tagged
         --  private primitive operations, visible only in child
         --  packages
         ...
       private
         --  data items etc., see (2) below
         ...
       end Pt1;

     end Example2;

Note that the public declaration of type Pt1 uses "with private"
instead of only "private" to start its private section. This is
supposed to give a syntactical indication that the public view
of Pt1 is an incomplete type that must be completed later on in
the private part of the package.

The private parts of the incomplete and the full declaration of
Pt1 also have different visibility scopes:

  1. The items declared in the private part of the public
     incomplete declaration are visible to types derived
     from Pt1 anywhere.

  2. The items declared in the private part of the full
     declaration of Pt1 are visible to types derived from Pt1
     in child packages of package Example2 only.

Extensible protected types thus offer even more visibility control
than ordinary tagged types: the latter must declare all their data
components either in the public or the private part, whereas an
extensible protected type may choose to make some of them public
(to descendants only) and some of them private.

Alternatively a protected type can be declared to have a private
extension. Given a protected type Pt2:

     package Base is

       protected type Pt2 is tagged
         ...
       private
         ...
       end Pt2;

     end Base;

A private extension can then be written as:

     with Base;
     package Example3 is

       protected type Pt3 is new Base.Pt2 with private;

     private

       protected type Pt3 is new Base.Pt2 with
         --  Additional primitive operations
         ...
       private
         --  Additional data items
         ...
       end Pt3;

     end Example3;

Here, only the features inherited from Pt2 are publicly visible,
the additional features introduced in the private part of the
package are private and hence visible only in child packages of
package Example3.

Private types can be used in Ada 95 to implement hidden and
semi-hidden inheritance, two forms of implementation inheritance
(as opposed to interface inheritance, i.e. subtyping). For
instance, one may declare a tagged type publicly as a root type
(i.e., not derived from any other type) while privately deriving
it from another tagged type to reuse the latter's implementation.
This hidden inheritance is also possible with extensible protected
types. Given the above package Base, hidden inheritance from Pt2
can be implemented as follows:

     with Base;
     package Example4 is

       --  the public view of Pt4 is a root type
       protected type Pt4 is tagged
         --  primitive operations, visible anywhere
         ...
       with private
         --  data items etc.
         ...
       end Pt4;

     private
       --  the private view of Pt4 is derived from Pt2
       protected type Pt4 is new Base.Pt2 with
         --  additional primitive operations, visible only in
         --  child packages
         ...
       with private
         --  additional data items etc.
         ...
       end Pt4;

     end Example4;

The derivation of Pt4 from Pt2 is not publicly visible: operations
and data items inherited from Pt2 cannot be accessed by other
packages. If some of the primitive operations inherited from Pt2
should in fact be visible in the public view of Pt4, too, Pt4 must
re-declare them and implement them as call-throughs to the
privately inherited primitive operations of Pt2. In child packages
of package Example4, the derivation relationship is exposed and
hence these inherited features are accessible in child packages.

Semi-hidden inheritance is similar in spirit, but exposes part of
the inheritance relation. Given an existing hierarchy of extensible
protected types:

     package Example5_Base is

       protected type Pt5 is tagged
         ...
       private
         ...
       end Pt5;

       protected type Pt6 is new Pt5 with
         ...
       private
         ...
       end Pt6;

     end Example5_Base;

One can now declare a new type Pt7 that uses interface inheritance
from Pt5, but implementation inheritance from some type derived from
Pt5, e.g. from Pt6:


     with Example5_Base; use Example5_Base;
     package Example5 is

       protected type Pt7 is new Pt5 with
         ...
       with private
         ...
       end Pt7;

     private

       protected type Pt7 is new Pt6 with
         ...
       private
         ...
       end Pt7;

     end Example5;

As these examples show, extensible protected types offer the
same expressive power concerning private types as ordinary
tagged types. In fact, because protected types are an
encapsulation unit in their own right (in addition to the
encapsulation provided by packages), extensible protected
types offer an even greater visibility control than ordinary
tagged types. Primitive operations of an extensible protected
type declared in the type's private section are visible only
within that type itself or within a child extension of that
type. Combining this kind of visibility (which is similar to
Java's `protected' declarator) with the visibility rules for
packages gives some visibility specifications that do not exist
for ordinary tagged types.

There is one difficulty with this scheme, though. It is currently
possible in Ada 95 to define a limited private type that is
implemented as a protected type. This raises the question whether
the following should be legal:

     package Example6 is

       type T is tagged limited private;

     private

       protected type T is tagged
         ...
       private
         ...
       end T;

     end Example6;

Here, although child packages could treat T as an extensible
protected type, other client packages could do very little with
the type. Furthermore, the mixture of protected and non-protected
views of one and the same type may give rise to incalculable
implementation problems because in some cases accesses to an
object would have to be done under mutual exclusion even if the
view of the object's type was not protected, simply because its
full view was a protected type. Consequently, the kind of
private completion shown in Example6 is probably best disallowed.


6.2 Abstract Extensible Protected Types

Ada 95 allows tagged types and their primitive operations to be
abstract. This means that instances of the type cannot be created.
An abstract type can be an extension of another abstract type. A
concrete tagged type can be an extension from an abstract type.
An abstract primitive operation can only be declared for an
abstract type. However, an abstract type can have non-abstract
primitive operations.

The Ada 95 model can easily be applied to extensible protected
types. The following examples illustrate the integration:

     protected type Ept is abstract tagged

        --  Concrete operations:
        function F (...) return ...;
        procedure P (...);
        entry E (...);

        --  Abstract operations:
        function F1 (...) return ... is abstract;
        procedure P1 (...) is abstract;
        entry E1 (...) is abstract;
     private
        ...;
        entry E (...) when Cond;

     end Ept;

The one issue that is perhaps not obvious concerns whether an
abstract entry can have a barrier. On the one hand, an abstract
entry cannot be called so any barrier is superfluous. On the
other hand, the programmer may want to define an abstraction
where it is appropriate to guard an abstract entry. For example:

     protected type Lockable_Operation is abstract tagged
        procedure Lock;
        procedure Unlock;
        entry Operation (...) is abstract;
     private
        Locked : Boolean := False;
        entry Operation (...) when not Locked;
     end Lockable_Operation;

The bodies of Lock and Unlock set the Locked variable to the
corresponding values. Now because of the barrier strengthening
rule, the when not Locked barrier will automatically be enforced
on any concrete implementation of the operation.

The above example can be rewritten with a concrete entry for
Operation that has a null body. It should be noted, however, that
with a concrete null-operation, one cannot force concrete children
to supply an implementation for the entry. With an abstract entry,
one can.


6.3 Generics and Mix-in Inheritance

Ada 95 does not support multiple inheritance. However, it does
support various approaches which can be used to achieve the desired
effect. One such approach is mix-in inheritance where a generic
package which can take a parameter of a tagged type is declared.
A version of Ada with extensible protected types must also allow
them to be parameters to generics and hence take part in mix-in
inheritance.

As with normal tagged types, two kinds of generic formal
parameters can be defined:

     generic
        type Base_Type is [abstract] protected tagged private;
        type Derived_From is [abstract] new protected Derived
           [with private];

In the former, the generic body has no knowledge of the extensible
protected type actual parameter. In the latter, the actual type
must be a type in the tree of extensible protected types rooted
at Derived.

Unfortunately, these facilities are not enough to cope with
situations involving entries. Consider the case of a predefined
lock which can be mixed in with any other protected object to
define a lockable version. Without extra functionality, there is
no way to express this. For these reasons, the generic modifier
ENTRY <> is used to mean all the entries of the actual parameter.
The lockable mix-in type can now be achieved:

     generic
        type Base_Type is [abstract] protected tagged private;

     package Lockable_G is

        protected type Lockable_Type is new Base_Type with

           procedure Lock;
           procedure Unlock;

        private

           Locked : Boolean := False;

           entry <> and when not Locked;

        end Lockable_Type;

     end Lockable_G;

The code ENTRY <> AND WHEN not Locked indicates that all entries
in the parent protected type should have their barriers
strengthened by the boolean expression not Locked.

The entry <> feature makes it possible to modify the barriers of
entries that are unknown at the time the generic unit is written.
At the time the generic unit is instantiated, the entries of the
actual generic parameter supplied for Base_Type are known, and
ENTRY <> then denotes a well-defined set of primitive operations.

This generic barrier modifier is similar to Frĝlund's "all-except"
specifier [Frĝlund1992], except that the latter also applies
to primitive operations that are added later on in further
derivations, whereas ENTRY <> does not. If new primitive
operations are added in further derivations, it is the
programmer's responsibility to make sure that these new entries
get the right barriers (i.e., include when not Locked).


7. Inheritance Anomaly

The combination of the object-oriented paradigm with mechanisms
for concurrent programming may give rise to the so-called
"inheritance anomaly" [Matsuoka and Yonezawa1993]. An inheritance
anomaly exists if the synchronization between operations of a
class is not local but may depend on the whole set of operations
present for the class. When a subclass adds new operations, it may
therefore become necessary to change the synchronization defined
in the parent class to account for these new operations. This
section examines how extensible protected types can deal with this
inheritance anomaly.

Synchronization for extensible protected types is done via entry
barriers. An entry barrier can be interpreted in two slightly
different ways:

   * as a precondition (which must become a guard when concurrency
     is introduced in an object-oriented programming language, as
     [Meyer1997] argues). In this sense, entries are the equivalent
     of partial operations [Herlihy and Wing1994].
   * as a synchronization constraint.

The use of entry barriers (i.e., guards) for synchronization makes
extended protected types immune against one of the kinds of
inheritance anomalies identified by [Matsuoka and Yonezawa1993]:
guards are not subject to inheritance anomalies caused by a
partitioning of states.

To avoid a major break of encapsulation, it is mandatory for a
concurrent object-oriented programming language to have a way to
re-use existing synchronization code defined for a parent class
and to incrementally modify this inherited synchronization in a
child class. In our proposal, this is given by the AND WHEN clause,
which incrementally modifies an inherited entry barrier and hence
the inherited synchronization code.

Inheritance anomalies in Ada 95 with extended protected types can
still occur, though. [Bloom 1979] suggested that the application
programmers need to be able to express synchronization between
processes according to the following constraints (Bloom's original
analysis was in the context of a client-server model):

  1. The type of request -- The server might wish to accept
     requests in an order which is determined by the type of
     request message. In object-oriented terms, the type of a
     message is the method that is to be invoked in the called
     object. Therefore given an object with, say, methods A, B,
     and C, the server might wish to execute method A in preference
     to B and B in preference to C etc.

  2. The order of request -- A server might wish to service
     requests in FIFO, priority of caller, or non-deterministic
     order. In the object model, this requires the methods to be
     executed according to the order of method invocations.

  3. Request Parameters -- The arguments of a request often dictate
     whether a message can or cannot be accepted. For example, a
     method get (n) to obtain n items from a buffer can only be
     accepted if n items are available. hence in an object model
     it is necessary potentially to block certain method calls
     according to the values of their parameters.

  4. Local State -- A server might not be in a position to
     synchronize with a client if it is in a certain state, for
     example when a bounded buffer is empty or full. In the object
     model, this synchronization is based on information contained
     in instance variables of the object.

  5. History Information -- This is synchronization based on
     whether a given request (method invocation, in the object
     model) has occurred. This is often closely related to local
     state since past executions may well have changed the state,
     however it is sometimes convenient to maintain it as a separate
     category as it may be easier to express certain constraints
     this way.

As [Mitchell and Wellings 1996] argue, the root cause of
inheritance anomalies lies in a lack of expressive power of
concurrent object-oriented programming languages: if not all five
criteria identified by Bloom are fulfilled, inheritance anomalies
may occur. Ada 95 satisfies only three of these criteria;
synchronization based on history information cannot be expressed
directly using entry barriers (local state must instead be used to
record execution history), and synchronization based on request
parameter values also is not possible directly in Ada 95.
The example for the resource controller shown in section 9.2
exhibits both of these inheritance anomalies. Because the barrier
of entry Allocate_N cannot depend on the parameter N itself, an
internal requeue to Wait_For_N must be used instead. The
synchronization constraint for Wait_For_N itself is history-
sensitive: the operation should be allowed only after a call to
Deallocate has freed some resources. As a result, Deallocate must
be overridden to record this history information in local state,
although both the synchronization constraints for Deallocate
itself as well as its functionality remain unchanged.

The ENTRY <> modifier has been introduced in section 6.3 to allow
protected types created using mix-in inheritance to affect the
barriers of their parent type. In the Lockable_G example presented
in section 6.3, all the barriers are strengthened by adding the
condition not Locked. It may well be that the inherited procedures
need to be similarly guarded. This gives rise to an Ada-specific
inheritance anomaly. As synchronization is done via barriers,
only entries can be synchronised, but not procedures. If the
synchronization constraints of a subtype should restrict an
inherited primitive operation that was implemented as a procedure
in the parent type, the subtype would have to override this
procedure by an entry. However, when using class-wide programming,
a task may assume that a protected operation is implemented as a
procedure (as that is what the base type indicates) and is
therefore non-blocking. At run-time the call might dispatch to an
entry and block on the barrier, which would make the call illegal
if it occurred within a protected action. For these reasons,
overriding procedures with entries should not be allowed for
extensible protected types.

As discussed in section 6.3, further Ada-specific inheritance
anomalies that might arise when mix-in inheritance is used can be
avoided by providing additional functionality for generics. The
new generic barrier modifier ENTRY <> alone is not sufficient to
avoid the introduction of new Ada-specific inheritance anomalies.
Because the generic mix-in class must define the synchronization
for the complete class resulting from the combination of the mix-in
class with some a priori unknown base class, the ENTRY <> barrier
modifier was introduced. It allows the mix-in class to impose its
own synchronization constraints on an unknown set of inherited
operations. However, it is also necessary to have a way for the
mix-in class to adapt the synchronization of its additional
primitive operations to the synchronization constraints imposed
by an actual base type. When the generic mix-in is instantiated
with some base type to create a new result type, it must be
possible to parametrise the mix-in's synchronization based upon
the base type in order to obtain the correct synchronization for
the new result type. How such a parametrisation could be obtained
is still a topic of on-going research.


8. Interaction with Tagged Types

So far, the discussion has focused on how protected types can be
extended. This section now considers the interaction between tagged
types and protected tagged types.

Consider the following which defines a simple buffer:

     package Simple_Buffer is
        type Data_T is tagged private;
        procedure Write (M : in out Data_T; X : Integer);
        procedure Read  (M : in Data_T;     X : out Integer);
     private
        type Data_T is tagged
          record
            I : Integer := 4;
          end record; -- say
     end Simple_Buffer;

Such a buffer can only be used safely in a sequential environment.
To make a pre-written buffer safe for concurrent access requires it
to be encapsulated in a protected type. The following illustrates
how this can easily be achieved.

     protected type Buffer is tagged
        procedure Write (X : Integer);
        procedure Read  (X : out Integer);
     private
        D : Simple_Buffer.Data_T;
     end Buffer;

The buffer can now only be accessed through its protected
interface.

Of course if the Buffer protected type is extended, the following
will dispatch on the buffer.


     type B is access Buffer'Class;

     Buf : B := new ...;

     Buf.Write(3);

Alternatively, Simple_Buffer.Data_T can be made protected but not
encapsulated by the following:

     protected type Buffer is tagged
        procedure Write
          (M : in out Simple_Buffer.Data_T; X : Integer);
        procedure Read
          (M : in out Single_Data_T;        X : out Integer);
     private
       ..;
     end Buffer;

This would allow the buffer to be accessed directly (without
the protection overheads) where the situation dictates that it
is safe to do so.

Combining extensible protected types with class-wide tagged types
allow for even more powerful paradigms. Consider

     protected type Buffer is tagged
       procedure Write (M : in out Simple_Buffer.Data_T'Class;
                        X : Integer);
       procedure Read  (M : in out Single_Data_T'Class;
                        X : out Integer);
     private
      ..;
     end Buffer;

Here, both the protected type and the tagged type can be easily
extended. The program can arrange for dispatching on the Buffer
and from within the Write/Read routines. Further, by using access
discriminants the data can be encapsulated and protected from any
concurrent use.

     type Ad is access Simple_Buffer.Data_T'Class;

     protected type Buffer(A : Ad) is tagged
        -- a normal discriminant

        procedure Write (X : Integer);
        procedure Read  (X : out Integer);
     private
      ...
     end Buffer;

     type B is access Buffer'Class;

     B1 : B := new Buffer(new Simple_Buffer.Data_T)...;

Here, B1 will dispatch to the correct buffer and Write/Read will
dispatch to the correct data which will be encapsulated.


9. Examples

This section presents two examples illustrating the principles
discussed in this paper. They assume all external calls dispatch,
there is no post-processing after parent calls, no checking of
parents' barriers, and that the child has access to the parent's
state.

9.1 Signals

In concurrent programming, signals are often used to inform tasks
that events have occurred. Signals often have different forms:
there are transient and persistent signals, those that wake up
only a single task and those that wake up all tasks. This section
illustrates how these abstractions can be built using extensible
protected types.

Consider first, an abstract definition of a signal.

     package Signals is

       protected type Signal is abstract
         procedure Send;
         entry Wait is abstract;
       private
         Signal_Arrived : Boolean := True;
       end Signal;

       type All_Signals is access Signal'Class;

     end Signals;

     package body Signals is

       protected body Signal is abstract
         procedure Send is
         begin
           Signal_Arrived := True;
         end Send;
       end Signal;

     end Signals;

Now to create a persistent signal:

     with Signals; use Signals;
     package Persistent_Signals is

       protected type Persistent_Signal is new Signal with
         entry Wait;
       private
         entry Wait when Signal_Arrived;
       end Persistent_Signal;
     end Persistent_Signals;

     package body Persistent_Signals is

       protected body Persistent_Signal is

         entry Wait when Signal_Arrived is
         begin
           Signal_Arrived := False;
         end Wait;

       end Persistent_Signal;

     end Persistent_Signals;

To create a transient signal

     with Signals; use Signals;
     package Transient_Signals is

       protected type Transient_Signal is new Signal with
         procedure Send;
         entry Wait;
       private
         entry Wait when Signal_Arrived;
       end Transient_Signal;

     end Transient_Signals;

     package body Transient_Signals is

       protected body Transient_Signal is

         procedure Send is
         begin
           if Wait'Count = 0 then
             return;
           end if;
           Signal.Send;
         end Send;

         entry Wait when Signal_Arrived is
         begin
           Signal_Arrived := False;
         end Wait;

       end Transient_Signal;

     end Transient_Signals;

To create a signal which will release all tasks.

     generic
       type Base_Signal is new protected Signal;
     package Release_All_Signals is

       protected type Release_All_Signal is new Base_Signal with
         entry Wait;
       private
         entry Wait and when True;
       end Release_All_Signal;

     end Release_All_Signals;

     package body Release_All_Signals is

       protected body Release_All_Signal

         entry Wait and when True is
         begin
           if Wait'Count /= 0 then
             return;
           end if;
           Base_Signal.Wait;
         end Wait;
       end Release_All_Signal;

     end Release_All_Signals;

Now, of course,

     My_Signal : All_Signals := ...;

     My_Signal.Send;

will dispatch to the appropriate signal handler.


9.2 Advanced Resource Control

Resource allocation is a fundamental problem in all aspects of
concurrent programming. Its consideration exercises all Bloom's
criteria (see section 7) and forms an appropriate basis for
assessing the synchronisation mechanisms of concurrent languages,
such as Ada.

Consider the problem of constructing a resource controller that
allocates some resource to a group of client agents. There are
a number of instances of the resource but the number is bounded;
contention is possible and must be catered for in the design of
the program. [Mitchell and Wellings 1996] propose the following
resource controller problem as a benchmark for concurrent object-
oriented programming languages.

   Implement a resource controller with 4 operations:

   * Allocate: to allocate one resource,
   * Deallocate: to deallocate a resource (which thus becomes
     available again for allocation)
   * Hold: to inhibit allocation until a call to
   * Resume: which allows allocation again.

   There are the following constraints on these operations:

   1. Allocate is accepted when resources are available and the
      controller is not held (synchronization on local state and
      history)
   2. Deallocate is accepted when resources have been allocated
      (synchronization on local state)
   3. calls to Hold must be serviced before calls to Allocate
      (synchronization on type of request)
   4. calls to Resume are accepted only when the controller is held
      (synchronization on history information).

In Ada 95, not all history information can be expressed directly
in barriers. However, it is possible to use local state variables
to record execution history.

The following solution simplifies the presentation by modelling
the resources by a counter indicating the number of free resources.
Requirement 2 is interpreted as meaning that an exception can be
raised if an attempt is made to deallocate resources which have not
yet been allocated. hence, it is represented by a protected procedure
rather than an entry.

package Rsc_Controller is

   Max_Resources_Available : constant Natural := 100;
   --  For example

   No_Resources_Allocated : exception; -- raised by Deallocate

   protected type Simple_Resource_Controller is tagged

      entry Allocate;
      procedure Deallocate;
      entry Hold;
      entry Resume;

   private

      Free   : Natural := Max_Resources_Available;
      Taken  : Natural := 0;
      Locked : Boolean := False;

      entry Allocate   when Free > 0 and not Locked and   -- req. 1
                            Hold'Count = 0;               -- req. 3
      entry Hold       when not Locked;
      entry Resume     when Locked;                       -- req. 4

   end Simple_Resource_Controller;

end Rsc_Controller;

The body of this package simply keeps track of the resources taken
and freed, and sets and resets the Locked variable.

package body Rsc_Controller is

   protected body Simple_Resource_Controller is

      entry Allocate   when Free > 0 and not Locked and
                            Hold'Count = 0 is
      begin
         Free := Free -1; -- allocate resource
         Taken := Taken + 1;
      end Allocate;

      procedure Deallocate is
      begin
         if Taken = 0 then
            raise No_Resources_Allocated;
         end if;
         Free := Free + 1; -- return resource
         Taken := Taken - 1;
      end Deallocate;

      entry Hold       when not Locked is
      begin
         Locked := True;
      end Hold;

      entry Resume     when Locked is
      begin
         Locked := False;
      end Resume;
   end Simple_Resource_Controller;

end Rsc_Controller;

[Mitchell and Wellings 1996] then extend the problem to consider
the impact of inheritance:

   Extend this resource controller to add a method: Allocate_N
   which takes an integer parameter N and then allocates N
   resources. The extension is subject to the following additional
   requirements:

   5. Calls to Allocate_N are accepted only when there are at
      least N available resources.
   6. Calls to Deallocate must be serviced before calls to
      Allocate or Allocate_N.

The additional constraint that calls must be serviced in a
FIFO_Within_Priorities fashion is ignored here. [Mitchell and
Wellings 1996] also do not implement this, and in Ada 95, it
would be done through pragmas.

Note that this specification is flawed, and the implementation
shown in [Mitchell and Wellings 1996] also exhibits this flaw: if
Deallocate is called when no resources are allocated, the resource
controller will deadlock and not service any calls to Deallocate,
Allocate, or Allocate_N. In this implementation, this has been
corrected implicitly, because calling Deallocate when no resources
are allocated is viewed as an error and an exception is raised.

Requirement 5 is implemented by requeueing to Wait_For_N if not
enough resources are available.

Requirement 6 is implicitly fulfilled because calls to Deallocate
are never queued since Deallocate is implemented as a procedure.

with Rsc_Controller; use Rsc_Controller;

package Advanced_Controller is

   protected type Advanced_Resource_Controller is
     new Simple_Resource_Controller with

      entry Allocate_N (N : in Natural);

      procedure Deallocate;
      --  Ada-specific anomaly: because barriers cannot access
      --  parameters, we must also override this method so that
      --  we can set 'Changed' (see below).

   private

      entry Allocate_N when
              Free > 0 and not Locked and          --  req. 1
              Hold'Count = 0;                      --  req. 3

      --  Note: Ada does not allow access to parameters in a
      --  barrier (purely for efficiency reasons). Such cases
      --  must in Ada always be implemented by using internal
      --  suspension of the method through a requeue statement.
      --  Everything below is just necessary overhead in Ada 95
      --  to implement the equivalent of having access to
      --  parameters in barriers.

      Current_Queue : Boolean := False;
      --  Indicates which of the two 'Wait_For_N' entry queues
      --  is the one that currently shall be used. (Two queues
      --  are used: one queue is used when trying to satisfy
      --  requests, requests that cannot be satisfied are requeued
      --  to the other. Then, the roles of the two queues are
      --  swapped. This avoids problems when the calling tasks
      --  have different priorities.)

      Changed       : Boolean := False;
      --  Set whenever something is deallocated. Needed for
      --  correct implementation of 'Allocate_N' and 'Wait_For_N'.
      --  Reset each time outstanding calls to these routines have
      --  been serviced. 'Changed' actually encodes the history
      --  information "'Wait_For_N' is only accepted after a call
      --  to 'Deallocate'".

      entry Wait_For_N (for Queue in Boolean) (N : in Natural);
      --  This declares two entries with names "Wait_For_N (True)"
      --  and "Wait_For_N (False)". 'Allocate_N' requeues to one of
      --  the entries if less than N resources are currently avail-
      --  able. Two entries are used to ensure correct behavior if
      --  calling tasks have different priorities.

      entry Wait_For_N (for Queue in Boolean) when
               not Locked and Hold'Count = 0 and
               (Queue = Current_Queue) and Changed;

   end Advanced_Resource_Controller;

end Advanced_Controller;

package body Advanced_Controller is

   protected body Advanced_Resource_Controller is

      procedure Deallocate is
        --  Overridden to account for new history information
        --  encoding needed for access to parameter in the barrier
        --  of Allocate_N.
      begin
         Changed := True;
         Simple_Resource_Controller.Deallocate;
      end Deallocate;

      entry Allocate_N (N : in Natural) when
                Free > 0 and
                not Locked and
                Hold'Count = 0 is
      begin
         if Free >= N then
            Free := Free - N;
            Taken := Taken + N;
         else
            requeue Wait_For_N (Current_Queue);
         end if;
      end Allocate_N;

      entry Wait_For_N (for Queue in Boolean)(N : in Natural)
        when not Locked and Hold'Count = 0 and
             (Queue = Current_Queue) and Changed is
      begin
         if Wait_For_N(Queue)'Count = 0 then
            Current_Queue := not Current_Queue;
            Changed := False;
         end if;
         if Free >= N then
            Free := Free - N;
            Taken := Taken + N;
         else
            requeue Wait_For_N(not Queue);
         end if;
      end Wait_For_N;

   end Advanced_Resource_Controller;

end Advanced_Controller;


10. Conclusions

This paper has argued that Ada 95's model of concurrency is not
well integrated with its object-oriented model. It has focussed
on the issue of how to make protected types extensible and yet
avoid the pitfalls of the inheritance anomaly. The approach
adopted has been to introduce the notion of a tagged protected
type which has the same underlying philosophy as normal tagged
types.

Although the requirements for extensible protected types are
easily articulated, there are many potential solutions. The
paper has explored the major issues and, where appropriate,
has made concrete proposals. Ada is an extremely expressive
language with many orthogonal features. The paper has shown
that the introduction of extensible protected types does not
undermine that orthogonality, and that the proposal fits in
well with limited private types, generics and normal tagged
types.

The work presented here, however, has not been without its
difficulties. The major one is associated with overridden
entries. It is a fundamental principle of object-oriented
programming that a child object can build upon the function-
ality provided by its parent. The child can call its parent
to access that functionality, and therefore extend it. In
Ada, calling an entry is a potentially suspending operation
and this is not allowed from within a protected object. Hence,
overriding entries gives a conflict between the object-oriented
and the protected type models. Furthermore, Ada allows an entry
to requeue a call to another entry. When the requeued entry is
serviced, control is not returned to the entry which issued
the requeue request. Consequently, if a parent entry issues a
requeue, control is never returned to the child. This again
causes a conflict with the object-oriented programming model,
where a child is allowed to undertake post-processing after a
parent call. The paper has discussed these conflicts in detail
and has proposed a range of potential compromise solutions.

Ada 95 is an important language -- the only international
standard for object-oriented real-time distributed programming.
It is important that it continues to evolve. This paper has
tried to contribute to the growing debate of how best to fully
integrate the protected type model of Ada into the object-
oriented model. It is clear that introducing extensible
protected types is a large change to Ada and one that is only
acceptable at the next major revision of the language. Many
of the complications come from the ability to override entries.
One possible major simplification of the proposal made here would
be not to allow these facilities. Entries would be considered
'final' (using Java terminology). Such a simplification might
lead to an early transition path between current Ada and a more
fully integrated version.


ACKNOWLEDGEMENTS

The authors gratefully acknowledge the contributions of Oliver
Kiddle and Kristina Lundqvist to the ideas discussed in this
paper. We also would like to acknowledge the participants at
the 9th International Workshop on Real-Time Ada Issues who
gave us some feedback on some of our initial ideas.


FOOTNOTES:

1. This paper extends and unifies the approaches described in
   [Kiddle and Wellings 1998] and [Michell and Lundqvist 1999].

2. Where the child has access to its parent's state, barrier
   strengthening is not a sufficient condition to ensure the
   consistency of that state, as the child can make the barrier
   false before calling the entry. See also the discussion in
   section 5.4.1

3. It is assumed that AND WHEN is a short circuit control form.

4. To harmonize with regular tagged types a new pragma could be
   introduced called "External_Calls_Always_Dispatch" which can
   be applied to regular tagged types.

5. With the requeue approach and multiple entry queues, there
   need not be any relationship between the parent and the child
   barriers. Such an approach has already been ruled out in the
   previous subsection.

6. Special consideration would need to be given to barriers which
   use the 'Count attribute in the parent, since these will clearly
   change when the child begins execution.


BIBLIOGRAPHY

Atkinson, C. and Weller, D. 1993. Integrating Inheritance and
Synchronisation in Ada9X. Proceedings of TRI'Ada 93, ACM.

Bloom, T. 1979. Evaluating synchronisation mechanisms.
Proceedings of the Seventh ACM Symposium on Operating System
Principles}. Pacific Grove, 24--32.

Brinch-Hansen, P. 1972. Structured multiprogramming. CACM 15, 7,
574--578.

Burns, A. and Wellings, A.J. 1998. Concurrency in Ada, Second ed.
Cambridge University Press.

Caromel, D. 1993. Toward a method of object-oriented concurrent
programming. Communications of the ACM 36, 9, 90--102.

Corradi, A and Leonardi, L 1990. Parellism in object-oriented
programming languages. In IEEE Conference on Computer Languages,
271--280.

Frĝlund, S. 1992. Inheritance of synchronization constraints in
cocurrent object-oriented programming languages. Proceedings of
ECOOP '92, LNCS. Vol. 615. Springer, 185--196.

Herlihy, M. and Wing, J. 1994. Linearizability: A correctness
criterion for concurrent objects. ACM Transactions on Programming
Languages and Systems, 12, 3, 463--492.

Hoare, C. 1974. Monitors - an operating system structuring
concept. CACM 17,10, 549--557.

Intermetrics. 1995. Ada 95 reference manual. ANSI/ISO/IEC-8652:
1995, Intermetrics.

Karaorman, M and Bruno, J. 1993. Introducing concurrency to a
sequential language. Communications of the ACM 36, 9, 103--16.

Kiddle, O.P. and Wellings, AJ. 1998. Extended protected types.
Proceedings of ACM SIGAda Annual International Conference
(SIGAda 98). 229--239.

Lea, D.1997. Concurrent Programming in Java. Addison Wesley.

Liskov, B. and Wing, J. 1994. A behavioral notion of subtyping.
ACM Transactions on Programming Languages and Systems 16, 6,
1811--1841.

Maio, A.D. al. 1989. DRAGOON: An Ada-based object oriented
language for concurrent, real-time distributed systems. In
Ada: The Design Choice, Proceedings Ada-Europe Conference,
Madrid, A.Alvarez, Ed. Cambridge University Press, 39--48.

Matsuoka, S. and Yonezawa, A. 1993. Analysis of inheritance
anomaly in object-oriented concurrent programming languages.
In Research Directions in Concurrent Object-Oriented Programming.
MIT Press, 107--150.

Meyer, B. 1993. Systematic concurrent object-oriented programming.
Communications of the ACM 36, 9, 56--80.

Meyer, B. 1997. Object-Oriented Software Construction, Second ed.
Prentice Hall.

Michell, S. and Lundqvist, K. Extendable Dispatchable Task
Communication Mechanisms. In Proceedings of IRTAW9, Ada Letters.

Mitchell, S.E. and Wellings, A.J. 1996. Synchronisation,
concurrent object-oriented programming and the inheritance
anomaly. Computer Languages 22, 1.

Newman, R. 1998. The classiC programming language and design of
synchronous concurrent object oriented languages. Journal of
Systems Architecture 45, 5, 387--407.

Oaks, S. and Wong, H. 1997. Java Thread. O'Reilly.

Wellings, A.J., Mitchell, S., and Burns, A.1996. Object-oriented
programming with protected types in Ada95. International Journal
of Mini and Micro Computers 18, 3, 130--136.

Wirth, N. 1988. The programming language Oberon. Software -
Practice and Experience 18, 7, 671--690.

Wyatt, B., Kavi, K., and Hufnagel, S. 1992. Parallelism in
object-oriented languages: a survey. IEEE Software 9, 6, 56--66.

Yokote, Y. and Tororo, M. 1987. Concurrent programming in
concurrentsmalltalk. In Object-Oriented Concurrent Programming.
MIT Press, 129--158.

Yonezawa, A, Briot, J.-P., and Shibayama, E. 1986. Object-
oriented concurrent programming in ABCL/1. In ACM SIGPLAN
Notices - Proceedings of OOPSLA 86. 258--268.

****************************************************************

From: Robert Dewar
Sent: Wednesday, December 13, 2000 11:11 AM

And of course we also need a rousing discussion of whether this extension
seems worth while in the first place, and whether anyone is interested in
implementing it. There is no point in designing features that no one will
implement.

****************************************************************

From: Pascal Leroy
Sent: Wednesday, December 13, 2000 3:01 PM

My opinion exactly. I am perfectly happy to discuss an extension as long as
there is at least one vendor who thinks there is sufficient interest out
there to justify the implementation effort. In the case at hand, the
implementation seems quite costly to me (although that's only a gut feeling,
I didn't do any design work). So someone will need to make a business case
showing that yes, this is going to benefit real users, and the benefits more
than offset the costs.

****************************************************************

From: Randy Brukardt
Sent: Wednesday, December 13, 2000 4:56 PM

My sentiments exactly.

If we're going to spend a lot of time on nice-to-have features, I'd rather
spend the time on Tucker's Interfaces and Object.Op proposals: I know I can
find uses for them in Claw. And I wouldn't be surprised that we can come up
with a business case for the first (given that something like it is available
in Java), and I suspect that the "Erhard's students problem" would justify the
second.

****************************************************************

From: Stephen Michell
Sent: Wednesday, December 13, 2000 3:32 PM

Thomas presented a fairly good example of how it would have helped him at the
IRTAW in Spain in September. Maybe he can present it to this forum.

****************************************************************

From: Robert Dewar
Sent: Wednesday, December 13, 2000 4:11 PM

More significantly, is to find at least one vendor who is willing to
champion this extension. Right now, speaking for Ada Core Technologies,
we do not see a customer demand for this feature -- of course that can
always change in the future.

****************************************************************

From: Pascal Leroy
Sent: Thursday, December 14, 2000 1:55 AM
To: ARG@ACM.ORG
Subject: Re: Ai on extensible protected types

> <<Thomas presented a fairly good example of how it would have helped him
> at the IRTAW in Spain in September. Maybe he can present it to this forum.
> >>

It is not hard to make a _technical_ case for this AI.  From a language
lawyer standpoint, Tuck's proposal is very attractive, and surely would be
helpful to a number of users.  It makes the language more useful, more
uniform, etc.

But what is really needed here is a _business_ case.  This new feature would
have a significant implementation cost.  So the question is not: would it
help users?  Surely it would.  The question is: of all the possible
extensions, is this among the most important ones?  In other words: would
Thomas be able to convince his compiler vendor (whoever that is) to
implement the feature?

The ARG cannot ignore that new features have a significant opportunity cost:
if a vendor decides to implement an extension, they won't be doing other
work to improve the usability of their compiler/environment.  The Ada market
being what it is, I don't see vendors increasing significantly their R&D
expenses just to keep up with the extensions that the ARG is coming up with.
Each time we discuss an extension, we must carefully weight the costs and
the benefits, and ask ourselves if what we are doing is the best for the Ada
community.

> More significantly, is to find at least one vendor who is willing to
> champion this extension. Right now, speaking for Ada Core Technologies,
> we do not see a customer demand for this feature -- of course that can
> always change in the future.

Speaking for Rational, this issue has been mentioned as an annoyance a
number of times by customers, but I don't think that at this point we would
see it as a priority.  (As you say, this could change.)

****************************************************************

From: Thomas Wolf
Sent: Thursday, December 14, 2000 2:13 AM

> Similarly, the AI is missing an example; I left Tucker's there. We discussed
> at the ARG meeting that proposals ought to be accompanied by examples of use
> (and if possible, a test program -- the latter is premature). In theory, I'm
> supposed to reject proposals without them -- so, Steve, et. al., please
> update Tucker's example appropriately (or construct a new one).

These examples are in the ASCII version of the Wellings et. al.
TOPLAS paper, which should be in the appendices of this AI.
(Steve's message entitled "AI on EPT - appendix 2".)

****************************************************************

From: Ted Baker
Sent: Thursday, December 14, 2000 7:23 AM

I agree that adding inheritance to protected types has no strong
business case that I know of, and that in general, additions to
the language will need a strong business case to justify the cost
to implementors.  I don't think we will get more people to use Ada
for real commercial projects, or to teach it, by adding more bells.
(One possible exception being the multiple inheritance issue
brought up by Tucker.)  On the other hand, we can kill what remains
of the Ada market by forcing implementors to break their implementations
by adding a bunch of new features, which could either bankrupt the
implementors or cause them to turn out buggy new releases to support
the new features.

****************************************************************

From: Robert Dewar
Sent: Thursday, December 14, 2000 7:59 AM

<<brought up by Tucker.)  On the other hand, we can kill what remains
of the Ada market by forcing implementors to break their implementations
by adding a bunch of new features, which could either bankrupt the
implementors or cause them to turn out buggy new releases to support
the new features.
>>

Don't worry, ARG decisions about extensions will never force the
implementors to do anything. The ARG is not in a position to mandate
implementors to do anything. Neither for that matter is WG9.

We have a language, Ada 95, which implementors provide. If the ARG
figures out extensions, vendors will provide them if and only if
they make money by doing so (i.e. capture more business, or can
charge more or ...)

If Ada 0X comes out, vendors may or may not implement it (same
considerations apply -- purely commercial ones).

My concern is not in killing the Ada market or causing problems for
vendors, my concern is for wasting time in the ARG when it could
be doing more useful things.

****************************************************************

From: Stephen Michell
Sent: Thursday, December 14, 2000 9:20 AM

I understand. The problem with such a feature, of course, is that 99% of all
programs do not use concurrency in any meaningful way - and certainly don't
use the Ada tasking model. On the other hand, if one is going to build
embedded systems where the management of events is important and there is
limited OS support for these things, then the Ada tasking mechanisms are very
useful, and are used. Heck - SAAB uses full Ada tasking for the Gripen flight
control system. Many such people were reluctant to consider OO in such systems
even a few years ago, but are now considering its use in these systems.

The EPT proposal addresses a significant disconnect between these paradigms
which may encourage more people to use OO in embedded systems where
concurrency is used.

Of course the vendors know their customer base more than we, as non-vendors
do, but I assume that they will not stand up and say that there is no interest
in the community until they have had serious discussions with people that may
be interested.

In the end, if there is no interest, of course it will not get implemented. In
the meantime, there is a fairly carefully thought through proposal for
consideration, and there is a reference implementation being built. I would
hope that folks would keep an open mind and see if the interest develops.

****************************************************************

From: Robert Dewar
Sent: Thursday, December 14, 2000 8:59 AM

<<I understand. The problem with such a feature, of course, is that 99% of all
programs do not use concurrency in any meaningful way - and certainly don't
use the Ada tasking model. On the other hand, if one is going to build
>>

THat's way way off, we find MOST of our customers using Ada tasking these
days. Yes there are some exceptions, but if you are saying that in your
environment 99% of programs do not use Ada tasking, then you are in
a different world from most of our customers.

<<In the end, if there is no interest, of course it will not get implemented.
In the meantime, there is a fairly carefully thought through proposal for
consideration, and there is a reference implementation being built. I would
hope that folks would keep an open mind and see if the interest develops.
>>

I would wait till this reference implementation is built, and see how it
works out in practice, and presumably this means that there is one vendor
interested enough to push the idea, which is just fine.

****************************************************************

From: Robert Dewar
Sent: Thursday, December 14, 2000 9:21 AM

Just to follow up on SM's cclaim that 99% of programs do not use
concurrency.

One surprising thing we are finding is that even in the safety-critical
market, there is a lot of demand for high level concurrency solutions.
You also see this in Aonix's work in Raven, and WRS' work in producing
a certified kernel with Raven-style tasking capability. Needless to say
in the GNAT world, we DO see a commercial benefit in pursuing that line
of action (and it should come as no surprise to find out that we are
indeed doing so :-)

****************************************************************

From: Mike Kamrad
Sent: Thursday, December 14, 2000 9:08 AM

>My concern is not in killing the Ada market or causing problems for
>vendors, my concern is for wasting time in the ARG when it could
>be doing more useful things.

What would those useful things be?  You have stated very clearly that the
TC effort wasn't useful.  If the ARG doesn't weigh in on extensions, then
what's left...m

****************************************************************

From: Robert Dewar
Sent: Thursday, December 14, 2000 9:18 AM

er um .. who ever said that the ARG should not work on extensions. I have
said repeatedly that I thought the most important item on the agenda was
to finish off the work items on Unchecked_Union and recursive types!

The fact that I am dubious about one particular extension should not be
for a moment generalized in the above wrong direction.

I think the MOST valuable thing for the ARG to do is to concentrate on
extensions that DO meet the commercially important criterion. A very
good measure of this is when at least one implementation (and in the
case of unchecked union, several implementations) have gone off on
their own and done something.

Tuck's multiple inheritance proposal may be in this category too, have not
had time to think about that -- anyway, let's finish off important old
work before we embark on new :-)

****************************************************************

From: Randy Brukardt
Sent: Thursday, December 14, 2000 8:17 PM

The good news here is that (IMHO) the technical work on the original three
amendments is essentially done. Tucker still has to churn out RM-style
wording for "with type" and "unchecked_union", but otherwise these are
finished. Of course, implementing them may turn up additional technical
problems. But they should be stable enough for implementors to look at them
seriously. (Tucker and I both indicated that we would be doing so soon, I
don't know if other implementors are.) [The three AIs I'm refering to are
AI-216 (unchecked_union), AI-217 (with type), and AI-218 (pragma Overriding,
etc.)] Probably the most likely way to find problems in these AIs is for
implementors to try to implement them (remember the benefits that the U/I
teams had on Ada 95?).

Of course, wordsmithing on the AIs will probably take another couple of
meetings to complete (but I know you don't find that particularly
interesting).

We still have other amendments to deal with (including the related access
conversions AI which is needed to make "with type" more usable); but I think
we can afford to cautiously look at other things. Still, we have to be
careful not to take on so much at once that we make no progress on anything.

****************************************************************

Questions? Ask the ACAA Technical Agent