!standard 3.04.03 (00) 03-01-25 AI95-00345/04 !class amendment 03-08-07 !status work item 03-09-28 !status received 03-06-12 !priority Medium !difficulty Hard !subject Protected and task interfaces !summary It is proposed that limited interfaces, as introduced by AI-251, can be used as ancestors for protected and task types. The primitive operations of these interfaces are inherited by the protected or task type. If the operations are declared abstract in the interface, they must be overridden in the inheriting type. The overriding can be performed in the usual way by declaring overriding primitives of the protected or task type, or by declaring entries or protected subprograms that override the primitive of the interface once it has been transformed into a "prefix" notation a la AI-252. We also propose two language-defined limited interface types, tentatively named Task_Interface and Protected_Interface. Neither has any primitive operations. Every task type implicitly implements Task_Interface; every protected type implicitly implements Protected_Interface. "Normal" tagged types are not allowed to be derived from these interfaces, so specifying one of these interfaces as an ancestor of a user-defined interface type can be used as a way to require that the interface be implemented with a task or protected type. In addition, an Identity function is added to Ada.Task_Identification which takes Task_Interface'Class, and is equivalent to the 'Identity attribute, returning the task's ID. !problem The object-oriented features of Ada 95 are essentially disjoint with the multi-tasking features of Ada 95. This means that it is difficult to combine synchronization with type extension and polymorphism. Although there are some approaches to doing so using access discriminants, they tend to be a bit awkward, and they don't actually prevent unsynchronized access to the object designated by the access discriminant. !proposal (See wording.) !wording NOTE: This presumes AI-251 ("normal" interface types) and AI-252 ("object.operation" notation). We will identify where we are referring to AI-251 or AI-252 wording. Modify 3.4(4): Class-wide types Class-wide types are defined for (and belong to) each derivation class rooted at a tagged {or interface} type (see 3.9 {and 3.9.4}) ... Modify 3.9(13): For every subtype S of a tagged {or interface} type T (specific or class-wide), the following attribute is defined: Replace 3.9.3(1-2) with: An abstract type is a type intended for use as an ancestor of other types, but which is not allowed to have objects of its own. Static semantics Interface types (see 3.9.4) are abstract types. In addition, a tagged type that has the reserved word abstract in its declaration is an abstract type. The class-wide type (see 3.4.1) rooted at an abstract type is not itself an abstract type. Legality Rules Only a tagged type shall have the reserved word abstract in its declaration. In the wording of AI-251: Modify 3.9.4(1): An interface type is an abstract [tagged] type intended for use in providing a restricted form of multiple inheritance. A tagged {, task, or protected type, or another interface} type may be derived from multiple interface types. Change 3.9.4(2) to: interface_type_definition ::= [LIMITED] INTERFACE [and interface_list] In the wording of AI-252: Modify 4.1.3(9,15): Change "tagged" to "tagged or class-wide" Modify 6.3.1(10): Change "tagged" to "tagged or class-wide" [end of AI-252-relative modifications] Add after 6.3.1(24): Two subprograms or entries are type conformant (respectively mode conformant, subtype conformant, or fully conformant) if their profiles are type conformant (respectively mode conformant, subtype conformant, or fully conformant). Change 9.1(2) to: task_type_declaration ::= TASK TYPE defining_identifier [known_discriminant_part] [IS [NEW interface_list WITH] task_definition]; Add after 9.1(8): Each interface_subtype_mark of an interface_list appearing within a task_type_declaration shall denote a limited interface type. If a task_type_declaration includes an interface_list, then for each primtive subprogram inherited by the task type, one of the following shall apply: - the inherited subprogram shall be overridden with a primitive subprogram of the task type, in which case the overriding subprogram shall be subtype conformant with the inherited subprogram and not abstract; or - the first parameter of the inherited subprogram shall be of the task type or an access parameter designating the task type, and there shall be an entry_declaration with the same identifier within the task_type_declaration and either: * it shall be for a single entry with a profile that is type conformant with that of the inherited subprogram after omitting this first parameter, or * it shall be for a family of entries with entry index type the same as the type of the second parameter of the inherited subprogram and with profile that is type conformant with that of the inherited subprogram after omitting its first two parameters, in which case the inherited subprogram is said to be "implemented" by the conforming entry (family), and its profile after omitting the first (and second) parameter shall be subtype conformant with that of the entry (family); or - the inherited subprogram shall be a null procedure. If an inherited subprogram is implemented by an entry family, its second parameter shall be of mode IN. Add after 9.1(9.1/1): If a task_type_declaration includes an interface_list, the task type is derived from each interface named in the interface_list. Change 9.4(2) to: protected_type_declaration ::= PROTECTED TYPE defining_identifier [known_discriminant_part] IS [NEW interface_list WITH] protected_definition; Add after 9.4(10): Each interface_subtype_mark of an interface_list appearing within a protected_type_declaration shall denote a limited interface type. If a protected_type_declaration includes an interface_list, then for each primitive subprogram inherited by the protected type, one of the following shall apply: - the inherited subprogram shall be overridden with a primitive subprogram of the protected type, in which case the overriding subprogram shall be subtype conformant with the inherited subprogram and not abstract; or - the first parameter of the inherited subprogram shall be of the protected type or an access parameter designating the protected type, and there shall be a protected_operation_declaration with the same identifier within the protected_type_declaration and either: * it shall be for a protected subprogram or single entry with a profile that is type conformant with that of the inherited subprogram after omitting this first parameter, or * it shall be for a family of entries with entry index type the same as the type of the second parameter of the inherited subprogram and with profile that is type conformant with that of the inherited subprogram after omitting its first two parameters, in which case the inherited subprogram is said to be *implemented* by the conforming protected subprogram or entry (family), and its profile after omitting the first (and second) parameter shall be subtype conformant with that of the protected subprogram or entry (family); or - the inherited subprogram shall be a null procedure. If an inherited subprogram is implemented by a protected procedure or entry (family), then its first parameter shall be an access-to-variable parameter, or of mode OUT or IN OUT. If an inherited subprogram is implemented by an entry family, its second parameter shall be of mode IN. Modify 9.4(11): If a protected_type_declaration includes an interface_list, the protected type is derived from each interface named in the interface_list. Add at end of 9.7.2(1): A procedure call may appear rather than an entry call for cases where the procedure might be implemented by an entry. Change 9.7.2(3) to: entry_call_alternative ::= procedure_or_entry_call [sequence_of_statements] Add after 9.7.2(3): procedure_or_entry_call ::= procedure_call_statement | entry_call_statement Legality rules If a procedure_call_statement is used for a procedure_or_entry_call, the procedure_name or procedure_prefix of the procedure_call_statement shall denote an entry renamed as a procedure, a formal subprogram, or (a view of) a primitive subprogram of a limited interface whose first parameter is a controlling parameter (see 3.9.2). Static Semantics If a procedure_call_statement is used for a procedure_or_entry_call, and the procedure is implemented by an entry, then the procedure_name, or the procedure_prefix and possibly one or two of the parameters of the procedure_call_statement, determine the target object of the call, the entry or entry family, and the entry index, if any. If the procedure is not implemented by an entry, then the procedure call is equivalent to an entry call on an open entry of a newly created local task whose accept statement invokes the procedure's body. [AARM Implementation Note: the specified equivalence is intended to ensure that the call remains abortable, with a priority inherited from the invoker, and no delay_alternative, else part, or abortable part of the select_statement is executed.] Modify 9.7.4(4,6): change "entry_call_statement" to "procedure_or_entry_call" Add subclause 13.7.3: 13.7.3 The Package System.Interfaces Static Semantics The following language-defined library package exists: package System.Interfaces is type Task_Interface is limited interface; type Protected_Interface is limited interface; end System.Interfaces; Every task type has Task_Interface as an ancestor. Every protected type has Protected_Interface as an ancestor. Legality Rules Only a task type or another interface type may be derived from Task_Interface. Only a protected type or another interface type may be derived from Protected_Interface. Modify C.7.1(2): {with System.Interfaces;} package Ada.Task_Identification is type Task_ID is private; Null_Task_ID : constant Task_ID; {function Identity(T : System.Interfaces.Task_Interface'Class) return Task_ID;} ... !example with System.Interfaces; package Queues is type Queue is limited interface and System.Interfaces.Protected_Interface; -- Interface for a protected queue procedure Enqueue(Q: in out Queue; Elem : in Element_Type) is abstract; procedure Dequeue(Q: in out Queue; Elem : out Element_Type) is abstract; function Length(Q: Queue) return Natural is abstract; type Queue_Ref is access all Queue'Class; end Queues; protected type Bounded_Queue(Max: Natural) is new Queues.Queue with -- Implementation of a bounded, protectected queue entry Enqueue(Elem : in Element_Type); entry Dequeue(Elem : out Element_Type); function Length return Natural; private Data: Elem_Array(1..Max); In_Index: Positive := 1; Out_Index: Positive := 1; Num_Elems: Natural := 0; end My_Queue; task interface Worker is -- Interface for a worker task entry Queue_To_Service(Q : Queue_Ref) is abstract; end Server; type Worker_Ref is access all Worker'Class; task type Cyclic_Worker is new Worker with -- Implementation of a cyclic worker task entry Queue_To_Service(Q : Queue_Ref); end Cyclic_Server; task Worker_Manager is -- Task that manages servers and queues. entry Add_Worker_Task(W : Worker_Ref); entry Add_Queue_To_Be_Serviced(Q : Queue_Ref); end Worker_Manager; task body Worker_Manager is Worker_Array : array(1..100) of Worker_Ref; Queue_Array : array(1..10) of Queue_Ref; Num_Workers : Natural := 0; Next_Worker : Integer := Worker_Array'First; Num_Queues : Natural := 0; Next_Queue : Integer := Queue_Array'First; begin loop select accept Add_Worker_Task(W : Worker_Ref) do Num_Workers := Num_Workers + 1; Worker_Array(Num_Workers) := Worker_Ref(W); end Add_Worker_Task; -- Assign new task a queue to service if Num_Queues > 0 then -- Assign next queue to this worker Worker_Array(Num_Workers).Assign_Queue_To_Service( Queue_Array(Next_Queue)); -- Dynamically bound entry call -- Advance to next queue Next_Queue := Next_Queue mod Num_Queues + 1; end if; or accept Add_Queue_To_Be_Serviced(Q : Queue_Ref); Num_Queues := Num_Queues + 1; Queue_Array(Num_Queues) := Queue_Ref(Q); end Add_Queue_To_Be_Serviced; -- Assign queue to worker if enough workers if Num_Workers >= Num_Queues then -- This queue should be given one or more workers declare Offset : Natural := Num_Queues-1; begin while Offset < Num_Workers loop -- (re) assign queue to worker Worker_Array((Next_Worker + Offset - Num_Queues) mod Num_Workers + 1). Assign_Queue_To_Service(Queue_Array(Num_Queues)); -- Dynamically bound entry call Offset := Offset + Num_Queues; end loop; -- Advance to next worker Next_Worker := Next_Worker mod Num_Workers + 1; end; end if; or terminate; end select; end loop; end Worker_Manager; My_Queue : aliased Bounded_Queue(Max => 10); My_Server : aliased Cyclic_Server; begin Worker_Manager.Add_Worker_Task(My_Server'Access); Worker_Manager.Add_Queue_To_Be_Serviced(My_Queue'Access); ... !discussion During the Ada 95 design process, it was recognized that type extension might be useful for protected types (and possibly task types) as well as for record types. However, at the time, both type extension and protected types were somewhat controversial, and expending energy on a combination of these two controversial features was not practical. Since the design, however, this lack of extension of protected types has been identified as a possible target for future enhancements. In particular, a concrete proposal appeared in the May 2000 issue of ACM Transactions on Programming Languages in Systems (ACM TOPLAS), and this has formed the basis for a language amendment (AI-00250). However, in ARG discussions, the complexity of this proposal has been of concern, and more recently a simpler suggestion was made that rather than supporting any kind of implementation inheritance, interfaces for tasks and protected types might be defined, and then concrete implementations of these interfaces could be provided. Class-wide types for these interfaces would be defined, and calls on the operations (protected subprograms and entries) defined for these interfaces could be performed given only a class-wide reference to the task or protected object. An important advantage of eliminating inheritance of any code or data for tasks and protected types is that the "monitor"-like benefits of these constructs are preserved. All of the synchronizing operations are implemented in a single module, simplifying analysis and avoiding any inheritance "anomolies" that have been associated in the literature with combining inheritance with synchronization. After further investigation of interfaces specific to task and protected types, it became apparent that the tighter integration between inheritance and tasking features would not be accomplished unless task and protected types could implement "normal" (limited) interfaces as well. The next step was simply to drop the special syntax for task and protected interfaces completely, and define a way for entries and protected subprograms to effectively "override" (or at least implicitly "implement") "normal" inherited primitive subprograms. Drawing on the "prefix" notation proposed in AI-252, we now allow a normal primitive subprogram to be implemented by an entry or protected subprogram, so long as it conforms to the primitive subprogram's profile after dropping the first parameter. The first parameter must be controlling, and of mode [IN] OUT (or access-to-variable) if implemented by a protected procedure or entry, since protected procedures and entries are allowed to update the protected object. Note that this requirement is not imposed on task entries, since "constant" task objects are permitted as the prefix object in a task entry call. As with "normal" interfaces, a "concrete" type that inherits from an interface must override (or "implement") all abstract operations, but may inherit null procedures. Having dropped special syntax for task and protected interfaces and the associated abstract entries, we felt it was important not to lose the ability to use selective entry calls. Hence, we now permit within a selective entry call a dispatching call on a primitive of a limited interface type, since it might be implemented by an entry. Having loosened this rule, it made sense to allow the use of entries renamed as procedures and formal subprograms in these contexts as well, since they also might be implemented by an entry. To allow an interface to require that it be implemented by a task or protected type, we have specified language-defined interfaces, tentatively named Task_Interface and Protected_Interface. All task types implicitly implement Task_Interface; all protected types implicitly implement Protected_Interface. The interfaces cannot be implemented explicitly by "normal" tagged types. QUESTIONS: Where should these interfaces be declared, and what should they be called? Root_Task and Root_Protected are alternative names. And rather than System.Interfaces, they could be in a package called Ada.Tasking, perhaps. It might be useful to also provide a Synchonized_Interface (or Root_Synchronized?) to act as the common ancestor of Task_Interface and Protected_Interface, to cover the case where it doesn't matter whether a given interface is implemented by a task or a protected type, so long as it can safely be used concurrently from multiple tasks. Perhaps Task_Safe would be a better name? In general, how should language-defined interfaces be named, especially ones like these which more represent "predicates" than real interfaces? In Java, such interfaces are typically named using adjectives, such as "Cloneable". So perhaps "Is_Task" and "Is_Protected" and "Is_Task_Safe"? IMPLEMENTATION NOTES: Given a select statement like: select Sync_Obj.Add_Item(X); Put_Line("Add_Item completed"); or delay 5.0; Put_Line("Add_Item timed out"); end select; where "Sync_Obj" is a task or protected object, an implementation might translate this into, roughly: Status : Boolean; Param_Block : constant Add_Item_Params := (X => X); begin System.RTS.Timed_Rel_{Protected,Task}_Call( Called_Obj => Sync_Obj'Address, Params => Param_Block'Address, Name_Index => , Member_Index => 0, -- unless is member of entry family Delay_Amount => 5.0, Status => Status); if Status = True then Put_Line("Add_Item completed"); else Put_Line("Add_Item timed out"); end if; Timed_Rel_{Protected,Task}_Call sets Status to True if the entry call completes, False if it times out. To support a case where Sync_Obj is of type Limited_Interface'Class, and Add_Item is a primitive of Limited_Interface (called using prefix notation), it could instead be translated (roughly) into: Sync_Obj : Limited_Interface'Class ... type Call_Status is (Not_An_Entry, Completed, Not_Completed); Status : Call_Status := Not_An_Entry; Param_Block : constant Add_Item_Params := (X => X); begin Sync_Obj._Selective_Entry_Call( Params => Param_Block'Address, Slot_Num => , Selective_Call_Info => (Kind => Timed_Rel, Delay_Amount => 5.0), Status => Status); -- assume Status is now an in-out param if Status /= Not_Completed then if Call_Status = Not_An_Entry then Add_Item(Sync_Obj, X); -- Not an entry, -- call "normal" overriding end if; Put_Line("Add_Item completed"); else Put_Line("Add_Item timed out"); end if; Every limited interface would have to have one "implicit" primitive, say, _Selective_Entry_Call, which by default is null, leaving the Status as Not_An_Entry. However, if the interface is implemented by a task or protected type, and one of the interface's primitives is overridden by an entry, then _Selective_Entry_Call would have to be overridden with something which checked the slot number passed in, and if it corresponded to a primitive that was overridden by an entry, it would pass the name/family index of that entry to the appropriate RTS routine along with the Param_Block and the appropriate extra selective entry information, such as the relative delay amount. The status of this call would then determine the status of the call on _Selective_Entry_Call. If the primitive did not correspond to an entry, then the Status would be left as Not_An_Entry, and the compiler-generated code at the call site would then do a "normal" call on the overriding of the primitive, which might or might not be a wrapper. As far as distributed overhead, it would mean that every limited interface would need an implicit "null" procedure corresponding to _Selective_Entry_Call. This would purely be a space overhead, since it would never be called if the user didn't take advantage of this ability to call limited interface primitives in a select statement. If they did make such a call, and it did happen to correspond to an entry, then the overriding of _Selective_Entry_Call could make an "efficient" call on the appropriate RTS routine passing in the appropriate entry name/family indices, etc. If it didn't correspond to an entry, then _Selective_Entry_Call would return immediately to the compiler-generated code which would do a normal dispatching call on the primitive. So there wouldn't be too much overhead even when the feature was used. Entry families add a bit of additional complexity, but probably not so much as to justify disallowing implementing inherited subprograms using an entry family. --!corrigendum 03.0x.0x(0x) !ACATS test !appendix From: Randy Brukardt Sent: Thursday, June 12, 2003 7:43 PM Tucker wrote me: Here is an article I have submitted to the Ada User Journal. It might be of interest to ARG members. Rather than filling all of their mailboxes with it, I thought I would just fill yours ;-). Once you get it posted, could you send out an e-mail with a URL pointing to it? --- The article is posted at http://www.ada-auth.org/ai-files/grab_bag/oop_200y.pdf. Happy reading! [Editor's note: This article proposes protected interfaces.] **************************************************************** From: Robert I. Eachus Sent: Thursday, June 12, 2003 11:19 PM I was interested to compare the three cyclic type structure proposals as they appear in Tuck's examples. They all occupy about the same volume in number of lines, but the generalized incomplete type approach definitely looks the cleanest/most Ada-like. There are of course, plenty of reasons why any one of the three proposals might turn out to be problematical for other reasons, but I think this causes me to lean a little more in the direction I was leaning anyway. Oh, and the write-up of protected interfaces seems to me to be the best argument for adding interfaces to the language. I'll have to think about it (a lot). I like the idea of having all queue types match a potentially tasking safe interface. Some implementations could be tasking safe and others assume they are only visible in a single thread. A wonderful extension to Ada as an expository language for algorithm design. Now all we have to do is figure out how to actually implement it. ;-) **************************************************************** From: Pascal Leroy Sent: Friday, June 13, 2003 11:03 AM Is this really what Tucker is proposing? The way I read his paper, protected and non-protected interfaces are distinct beasts and do not mix. So if a queue has a protected interface, all of its implementations have to be protected. I might be misreading the intent of course, it's hard to know without an AI. But because the calling conventions of protected and non-protected operations are vastly different, I don't see how a class-wide type could indifferently designate a protected or a non-protected implementation. **************************************************************** From: Tucker Taft Sent: Friday, June 13, 2003 1:22 PM I was not proposing mixing protected interfaces and tagged interfaces. That would seem to be a bad idea, given that the semantics are so different. I'm not sure exactly what Robert Eachus had in mind, but if you want to mix protected and tagged, you will have to "wrap" one in the other. **************************************************************** From: Robert I. Eachus Sent: Friday, June 13, 2003 1:22 PM I don't think it is what Tucker is proposing, and a pragma would be useful. But Tucker's proposal certainly allows what I am thinking of. Imagine two implementations of a protected (class-wide) type. One version, say the parent is a "normal" protected object with all of the necessary baggage to support say a queue which is accessed by different threads/tasks. With Tucker's proposal you can also provide a child implementation which will fail in one of many ways, possibly by deadlock, if it is actually called by two different tasks. And maybe another child that works fine with at most two callers, but can livelock or deadlock with three or more. It would be nice to have a pragma that told the compiler that "this protected body assumes a single task," if only for documentation purposes. Even without it, the checks/overhead in the single thread version should be low. With a pragma, the compiler can choose a locking implementation which has very low overhead for passing through, and a much higher overhead--or even Program_Error--if a caller ever blocks. The interface is identical, and any compilers that do lock checking outside the protected object code don't need to change. Let me give an example. Suppose you have a protected object type that provides serialized access to a disk file, perhaps of a Sequential_IO file with a (Direct_IO) associated index. (Reading or writing would require several calls on the protected object.) The simple implementation would allow only one transaction in process at a time. (Begin_Transaction, Lookup, Read or Write, Close_Transaction.) The more complex implementation could allow for several transactions to be in progress at the same time. (File locking vs. record locking.) The key point is that this effectively adds a capability to Ada that has been there all along, but in general becomes too difficult to use. Right now you can customize generics, but that requires preplaning to provide the right generic formal parameters. A good example of this type of customization is providing different ">" operators as parameters to a sort routine allows the same sort routine to be used to sort on different keys. But allowing for full generality is just not possible. The original implementor of the generic has to think of all the possible customizations ahead of time, and provide the additional generic parameters to accomplish it. Does this sound something like the problem with variant records that tagged types solved? It does to me. Fortunately, I think that the hard work has already been done by existing compilers, what is needed is the (trivial?) bit of effort required to permit programmers to provide alternate bodies for generics. I'm working on writing this up. Basically think of it as adding derived generics to the language. The "new" generic has the same interface as its parent but provides a new body. It might be nice to allow the new body (assuming that the generic is a package) to call operations of the parent, but I think it is adequate to allow/require the programmer to create an instance of the parent generic if he wants to do that. **************************************************************** From: Alan Burns Sent: Monday, October 27, 2003 4:07 AM The last meeting of ARG asked for some further examples of the use of protected interfaces and task interfaces. In general there is no current way of giving more than one body to a PO or task. This would be useful even if no further components are added. Clients can link to an interface for a Server; actual Server can be one of many types. But also in a client server relation, it can be useful to ensure all server tasks provide a basic service: task type interface Basic_Server is entry basic server() is abstract; end Basic_Server; this could lead to many server components such as: task type interface Degraded_Server is new Basic_Server; or task type Fuller_Server is new Basic_Server with entry basic_service(); entry full service(); end Fuller_Server; For POs to ensure all POs have a mode change operation could be done with a suitable interface. Also to control visability over entries: The usual buffer: protected type Buffer is entry put(X: in Element); entry get(X : out Element); private ... end Buffer; Problem: Can't separate producer and consumer interface, but protected interface Producer is entry Put(X: in Element) is abstract; end producer; protected interface Consumer is entry Get(X : out Element) is abstract; end Consumer; then protected type Buffer is new Producer and Consumer with entry put(X: in Element); entry get(X : out Element); private ... end Buffer; or protected type ForwardingBuffer is new Producer and Consumer with entry put(X: in Element); entry get(X : out Element); private ... end Buffer; A further example comes from the use of a PO as a resource controller. Here the specification is often of the form: protected interface Resource_Controller is entry Get() is abstract; procedure Release() is abstract; private ... end Resource_Controller; This would allow many different implementations; also allow entries and procedures to be added (such as Release_All). **************************************************************** From: Tucker Taft Sent: Monday, January 12, 2004 3:51 PM Pascal grumbled a bit about task and protected interfaces not being unified with other kinds of interfaces. We have also discussed the possibility of allowing limited interfaces as ancestors of non-limited types. It would seem possible to allow limited interfaces to be ancestors of more than just limited tagged types and interfaces. Perhaps we should consider (or put on the "roadmap" for Ada 2015? ;-) allowing limited interfaces to be ancestors of non-limited interfaces/tagged types, as well as protected/task interfaces/types. It would mean that protected/task objects would need a "true" tag rather than a pseudo-tag, but I doubt if that would be a huge burden, since they often already include a pointer to some kind of type descriptor. Does anyone know of any specific semantic or implementation problems with allowing limited interfaces being ancestors of non-limited types and/or protected/task types? We might simplify the problem by restricting it to limited interfaces with no functions with controlling results (vaguely analogous to the restriction we have on tagged incomplete types), to avoid the morass associated with returning limited objects. Note that we don't allow a tagged limited private type to be non-limited in the full view to avoid ending up with assignment being applied to some limited extension of the partial view that has limited components. This isn't a problem for limited interfaces, since they don't have any components. **************************************************************** From: Randy Brukardt Sent: Monday, January 12, 2004 4:14 PM > Does anyone know of any specific semantic or implementation problems with > allowing limited interfaces being ancestors of non-limited types > and/or protected/task types? Steve can correct me if I'm wrong, but I believe the problem was with return-by-reference functions. With these interfaces, you couldn't tell at compile-time whether a function was return-by-reference or not. Of course, if 318 is adopted with the semantics discussed at the meeting, that would be no longer a problem. If that was in fact the only problem, we ought to reconsider the idea *IF* (and that's a big if) we have the stomach for the incompability in function definitions. **************************************************************** From: Tucker Taft Sent: Thursday, January 22, 2004 10:34 AM Here is the first write-up of this AI that includes "real" wording. In response to Pascal's concern that we weren't *really* integrating inheritance between tagged and task/protected types, I have modified this proposal to allow task/protected types to be derived from "normal" limited interfaces as well as from task/protected interfaces. I don't believe this imposes a significant added implementation burden, and clearly provides better integration of inheritance capabilities. However, it would be easy enough to "back out" this added capabiltiy, if it is felt to overburden the proposal. In my view it would also be nice to allow non-limited types to be derived from limited interfaces, but that depends on fixing the return-by-reference function morass, perhaps via the "aliased" return proposal. In any case, that idea is essentially unrelated to this AI, except in that it also provides further integration of inheritance capabilities. **************************************************************** From: Tucker Taft Sent: Thursday, January 22, 2004 10:34 AM Here is the first write-up of this AI that includes "real" wording. In response to Pascal's concern that we weren't *really* integrating inheritance between tagged and task/protected types, I have modified this proposal to allow task/protected types to be derived from "normal" limited interfaces as well as from task/protected interfaces. I don't believe this imposes a significant added implementation burden, and clearly provides better integration of inheritance capabilities. However, it would be easy enough to "back out" this added capabiltiy, if it is felt to overburden the proposal. In my view it would also be nice to allow non-limited types to be derived from limited interfaces, but that depends on fixing the return-by-reference function morass, perhaps via the "aliased" return proposal. In any case, that idea is essentially unrelated to this AI, except in that it also provides further integration of inheritance capabilities. [Editor's note: this is version /03.] **************************************************************** From: Robert I. Eachus Sent: Thursday, January 22, 2004 11:35 AM Tucker Taft wrote: > Here is the first write-up of this AI that includes "real" wording... I like it. I do have one nit to pick that is not a serious issue: > Legality Rules > > Only a tagged type shall have the reserved word abstract in its > declaration. A (hostile) reading of this rule is that abstract can only appear in (tagged) TYPE declarations. A clearer wording might be: "A type declaration that has the reserved word abstract in its definition shall be a tagged type." We could even go a little further and say: " ...a tagged view of a type." That makes it clear that private views must include tagged or with, and a derived abstract type must be derived from a tagged view. I admit I am being pedantic, but I think that is the proper way to read proposed wording. **************************************************************** From: Robert A. Duff Sent: Thursday, January 22, 2004 11:36 AM > "A type declaration that has the reserved word abstract in its > definition shall be a tagged type." Yes, that's better wording. Or just, "...shall be tagged". > We could even go a little further and say: " ...a tagged view of a > type." That makes it clear that private views must include tagged or > with, and a derived abstract type must be derived from a tagged view. I don't think we need to say "view". The RM contains many places where "type" must be interpreted to mean "view of a type". **************************************************************** From: Tucker Taft Sent: Thursday, January 22, 2004 11:47 AM > Robert Eachus said: > > > "A type declaration that has the reserved word abstract in its > > definition shall be a tagged type." > > Yes, that's better wording. Or just, "...shall be tagged". Well I think you need to say "shall be *for* a tagged type." A type declaration is not itself "tagged". In any case, I started from the admittedly somewhat awkward existing Ada 95 wording and tried to preserve the "spirit" of it: Only a tagged type is allowed to be declared abstract. became: Only a tagged type shall have the reserved word abstract in its declaration. I don't love it, but I'm not sure I really prefer the above proposed alternatives either. Any other opinions? > > We could even go a little further and say: " ...a tagged view of a > > type." That makes it clear that private views must include tagged or > > with, and a derived abstract type must be derived from a tagged view. > > I don't think we need to say "view". The RM contains many places where > "type" must be interpreted to mean "view of a type". I agree. **************************************************************** From: Robert I. Eachus Sent: Thursday, January 22, 2004 4:01 PM >I don't think we need to say "view". The RM contains many places where >"type" must be interpreted to mean "view of a type". I have no problem with that. And my proposed new wording was really a fishing expedition to find a better way to say it. One alternative is: a) "A type declaration that contains the reserved word abstract shall declare a tagged type." Of course, the temptation to replace "shall" by "must" must be resisted. ;-) b) A declaration of a non-tagged type is illegal if it contains the reserved word abstract." works and isn't too stilted. Better might be: c) "A type declaration that contains the reserved word abstract is illegal if it does not declare a tagged type." But althought the meaning is clear, it is technically nonsense. An illegal declaration doesn't declare anything. That brings us to: d) "A type declaration that contains the reserved word abstract is legal only if it declares a tagged type." Alternative d is shorter than c, and does a good job of making its intent clear. Can we go further and say: e) "An abstract type declaration shall declare a tagged type." That opens a can of worms, but I think it is one that is worth opening. Right now, the proposal says that task interface types and protected interface types are also abstract types. If we change the definitions around, we could have "abstract types", "task interface types", and "protected interface types" be exclusive. I could go through and make the other changes if people think it is worth it. As I see it, doing that would clean up a lot of awkward text, expecially in the proposed 3.9.4(1), and in the changes to 9.1 and 9.4. Abstract type does not seem to currently be heavily used in the RM, and in any case we would now not be changing the meaning of the technical term. What does get used is abstract subprogram. Adding abstract entries means that we should add that a call to an abstract entry must be dispatching. (Excuse me, shall be dispatching.) Tucker said: "In my view it would also be nice to allow non-limited types to be derived from limited interfaces, but that depends on fixing the return-by-reference function morass, perhaps via the "aliased" return proposal. In any case, that idea is essentially unrelated to this AI, except in that it also provides further integration of inheritance capabilities." If we do adopt the final alternative above, it might make it harder to do this. But I don't see any benefit to allowing non-tasks to inherit from task interfaces or non-protected types to inherit from protected interfaces (I also can't imagine syntax rules that would allow anything new other than protected types inheriting from a task interface, or vice versa.) So it does seem to be unrelated. **************************************************************** From: Tucker Taft Sent: Thursday, January 22, 2004 4:28 PM > Alternative d is shorter than c, and does a good job of making its > intent clear. Can we go further and say: > > e) "An abstract type declaration shall declare a tagged type." Now you are pretty much back to where I started with Ada 95. The whole point was to allow abstract types to include interfaces. I think this is a bug in the current wording of AI-251, by the way. > That opens a can of worms, but I think it is one that is worth opening. > Right now, the proposal says that task interface types and protected > interface types are also abstract types. If we change the definitions > around, we could have "abstract types", "task interface types", and > "protected interface types" be exclusive. Why would that be a good idea? An abstract type is one that is not allowed to have objects (aka "instances" in OO parlance). > ... I could go through and make > the other changes if people think it is worth it. As I see it, doing > that would clean up a lot of awkward text, expecially in the proposed > 3.9.4(1), and in the changes to 9.1 and 9.4. I don't agree at all. We didn't invent the notion of "abstract type." It is well established in the OO literature as a type that should not have any instances. That applies to all interface types, as well as all types explicitly declared "abstract." > Abstract type does not seem to currently be heavily used in the RM, and > in any case we would now not be changing the meaning of the technical > term. We would be changing the fundamental meaning of "abstract" type. > ... What does get used is abstract subprogram. Adding abstract > entries means that we should add that a call to an abstract entry must > be dispatching. (Excuse me, shall be dispatching.).. I'm not sure that is necessary. Entry queues are associated with objects, and calls are added to entry queues and then "serviced". I think that provides the implicit level of indirection that is equivalent to dispatching. On the other hand, we may need to say something more about protected subprogram calls when the prefix is class-wide. **************************************************************** From: Tucker Taft Sent: Thursday, January 22, 2004 12:02 PM Tucker Taft wrote: > ... I have modified this > proposal to allow task/protected types to be derived > from "normal" limited interfaces as well as from > task/protected interfaces. ... I suppose we could take one further step, and allow task types/interfaces to be derived from protected interfaces that have only abstract entry/entry families. Going the other way (deriving protected types/interfaces from task types) doesn't seem wise, because there are various operations you can apply to task_int'class which wouldn't make sense for protected objects (e.g. abort, 'identity). On the other hand, I don't know of any operations that can be applied to a protected object with only entries that couldn't also be applied to a task. Again, this is incremental functionality that is not essential to the basic proposal, and shouldn't be allowed to overburden it... **************************************************************** From: Randy Brukardt Sent: Thursday, January 22, 2004 7:16 PM Tucker Taft wrote: > > > ... I have modified this > > proposal to allow task/protected types to be derived > > from "normal" limited interfaces as well as from > > task/protected interfaces. ... > > I suppose we could take one further step, and allow > task types/interfaces to be derived from protected > interfaces that have only abstract entry/entry families. I don't know if that is useful. But the problem with this proposal is that it doesn't seem to help in all of the cases where you might want to mix implementations. For one thing, while a task can be derived from a "regular" limited interface, such an interface has to be devoid of operations -- making the capability fairly useless. For another thing, a lot of the capabilities that you might want don't seem to be possible. Consider a queue interface (I'm using fixed items here for simplicity; it's likely that this whole thing would be wrapped in a generic): package AQ is type Abstract_Queue is limited interface; procedure Add_Item (Queue : in out Abstract_Queue; Item : in Integer); procedure Remove_Item (Queue : in out Abstract_Queue; Item : out Integer); end AQ; Then the standard implementation would look something like: with AQ; package NQ is type Queue is new AQ.Abstract_Queue with private; procedure Add_Item (Queue : in out Queue; Item : in Integer); procedure Remove_Item (Queue : in out Queue; Item : out Integer); -- Raises Empty_Error if empty. Empty_Error : exception; end NQ; Of course, the interface could be used in other components that needed a queue. Now, say you want a version of a queue to use for multiple tasks, which blocks on empty rather than raising an exception. You'd write something like: with AQ; package PQ is protected type Blocking_Queue is new AQ.Abstract_Queue with procedure Add_Item (Item : in Integer); entry Remove_Item (Item : out Integer); private ... end Blocking_Queue; end PQ; But of course that isn't allowed, because Remove_Item isn't a procedure. Moreover, these aren't subtype conformant. Your wording fails to take into account the implied object of the calls. (Also, Remove_Item can't be a function, because of some stupid rule about "in out" parameters on functions. I've made it a procedure here for that reason - Ada functions are useless for O-O programming other than possibly constructors. But's that's another argument. Note that the usual work-arounds aren't going to work for a protected type, because you can't change the implied parameter's mode or handling.) with AQ; package PQ1 is protected type Blocking_Queue is new AQ.Abstract_Queue with procedure Add_Item (Item : in Integer); procedure Remove_Item (Item : out Integer); entry Blocking_Remove_Item (Item : out Integer); private ... end Blocking_Queue; end PQ1; Doesn't work either, because Remove_Item can't call Blocking_Remove_Item (can't call blocking operations in a protected object). A Remove_Item that raised an exception would work, but it would defeat the purpose of having the operation. So, you'd have to resort to a wrapper type (assuming the protected type in PQ above exists): with AQ, PQ; package PQ2 is type Blocking_Queue is new AQ.Abstract_Queue with record Real_Queue : PQ.Blocking_Queue; end record; procedure Add_Item (Queue : in out Blocking_Queue; Item : in Integer); procedure Remove_Item (Queue : in out Blocking_Queue; Item : out Integer); end PQ2; Now you can use your protected queue object in the other components. But now, it is no longer protected, unless you make the component itself visible (as I did above). So callers that want to use (say) a timed entry call would have to call the component of the queue, not an operation on the queue. That's pretty ugly. Moreover, if you're willing to write wrappers, you don't need the ability to use "regular" interfaces on protected types in the first place. Just write the wrapper and be done with it. The beauty of this idea is to get the compiler to write any needed wrappers. (Or generate its code so it doesn't need any.) Thus, I think that an entry should be able to "match" a procedure with the proper parameter list (and no family). (This would essentially be the prefix call mechanism in reverse.) The call would operate like a procedure call. We already allow this in Ada, as an entry can be renamed as a procedure. Allowing that would make the above example easy, and also would make a "regular" interface useful for a task. Without it, I don't see much point in the whole mechanism. Other than basic locks (which you should avoid anyway), there don't seem to be that many cases of wanting multiple implementations of protected objects or tasks. **************************************************************** From: Robert I. Eachus Sent: Thursday, January 22, 2004 7:33 PM Tucker Taft wrote: >>That opens a can of worms, but I think it is one that is worth opening. >>Right now, the proposal says that task interface types and protected >>interface types are also abstract types. If we change the definitions >>around, we could have "abstract types", "task interface types", and >>"protected interface types" be exclusive. > >Why would that be a good idea? An abstract type is one that >is not allowed to have objects (aka "instances" in OO parlance). > I think you are missing what I intended. What I don't like is the term "limited abstract type" as it is used in the current write-up: "Limited interface types that are specifically for use in defining task or protected types may also be defined (see 9.1 and 9.4).}" There is nothing really wrong with the sentence. But including the technical/syntax terms "task interface type" and protected interface type in "abstract types" makes for some complext wording. If you wanted to make the technical term something other than abstract type, that would be fine. But the idea is to have a name for those abstract types that may include task or protected components but are not abstract task types or abstract protected types. We got into this problem in Ada 83. Record types with discriminants that have default values are significantly different from other record types. But since Ada didn't introduce a technical term, it was one of those things that had to be taught specially so that Ada users understood that these types were somewhat magic. It seems to me we are creating a similar potential problem here. Non-limited abstract types are one category, abstract types that happen to be limited are another. But task abstract types and protected abstract types are special in other ways. I don't like the fact that adding a well understood qualifier ("limited") to another well understood term ("abstract type") suddenly brings in these two categories from left field. I think we all understand what the intent is here. I am just trying to look at the whole thing from outside and see how easy or hard it is to learn or teach. Having a separate technical term here would help. That is all that I am really trying to do. I think that keeping the technical meaning of "abstract type" unchanged, and adding "abstract task types" and "abstract protected types" as something else works. But I am not tied to a particular technical term or group of technical terms. Just as long as specifying "abstract types that include limited abstract types but not task abstract types or protected abstract types" isn't such a jawbreaker. >>... What does get used is abstract subprogram. Adding abstract >>entries means that we should add that a call to an abstract entry must >>be dispatching. (Excuse me, shall be dispatching.).. > >I'm not sure that is necessary. Entry queues are >associated with objects, and calls are added to entry >queues and then "serviced". I think that provides >the implicit level of indirection that is equivalent >to dispatching. On the other hand, we may need >to say something more about protected subprogram calls >when the prefix is class-wide. I was thinking about cases where an entry call maps to an abstract entry declaration, but there is no corresponding object. For there to be code like that the entry name must be bare. (Not object.entry) I haven't figured out if such calls can actually get executed. **************************************************************** From: Jean-Pierre Rosen Sent: Friday, January 23, 2004 2:19 AM > a) "A type declaration that contains the reserved word abstract shall > declare a tagged type." and later.... > d) "A type declaration that contains the reserved word abstract is legal > only if it declares a tagged type." I think that "shall" exactly means "is legal only if", and is both shorter and more in line with ISO-speak. **************************************************************** From: Tucker Taft Sent: Thursday, January 22, 2004 8:15 PM Randy Brukardt wrote: > Tucker Taft wrote: > >>>... I have modified this >>>proposal to allow task/protected types to be derived >>>from "normal" limited interfaces as well as from >>>task/protected interfaces. ... >> >>I suppose we could take one further step, and allow >>task types/interfaces to be derived from protected >>interfaces that have only abstract entry/entry families. > > > I don't know if that is useful. But the problem with this proposal is that > it doesn't seem to help in all of the cases where you might want to mix > implementations. > > For one thing, while a task can be derived from a "regular" limited > interface, such an interface has to be devoid of operations -- making the > capability fairly useless. Why must the interface be devoid of operations? In the original proposal I disallowed operations "outside" the task interface type, but I changed that in the current proposal, and no longer disallow primitive operations of a task/protected interface type. These are effectively dispatching operations, just like those of a tagged type, and would require essentially the same mechanism to implement them. The only difference is that there is no hierarchy of "concrete" task/protected types possible. The concrete types appear at the leaves only. I'm not sure what difference that would make from an implementation point of view... > > For another thing, a lot of the capabilities that you might want don't seem > to be possible. > > Consider a queue interface (I'm using fixed items here for simplicity; it's > likely that this whole thing would be wrapped in a generic): > > package AQ is > type Abstract_Queue is limited interface; > procedure Add_Item (Queue : in out Abstract_Queue; Item : in Integer); > procedure Remove_Item (Queue : in out Abstract_Queue; Item : out > Integer); > end AQ; > > Then the standard implementation would look something like: > with AQ; > package NQ is > type Queue is new AQ.Abstract_Queue with private; > procedure Add_Item (Queue : in out Queue; Item : in Integer); > procedure Remove_Item (Queue : in out Queue; Item : out Integer); > -- Raises Empty_Error if empty. > Empty_Error : exception; > end NQ; > > Of course, the interface could be used in other components that needed a > queue. > > Now, say you want a version of a queue to use for multiple tasks, which > blocks on empty rather than raising an exception. You'd write something > like: > > with AQ; > package PQ is > protected type Blocking_Queue is new AQ.Abstract_Queue with > procedure Add_Item (Item : in Integer); > entry Remove_Item (Item : out Integer); > private ... > end Blocking_Queue; > end PQ; > > But of course that isn't allowed, because Remove_Item isn't a procedure. > Moreover, these aren't subtype conformant. Your wording fails to take into > account the implied object of the calls. Apparently I wasn't being clear at all. If a protected type implements a limited interface, it must have primitive operations *outside* the type declaration that override those inherited from the interface. These will presumably be implemented in terms of protected operations of the type. E.g.: package PQ is protected type Blocking_Queue ... [as you have it] procedure Add_Item (Queue : in out Blocking_Queue; Item : in Integer); procedure Remove_Item (Queue : in out Blocking_Queue; Item : out Integer); end PQ; package body PQ is protected body Blocking_Queue ... [as you would expect] procedure Add_Item (Queue : in out Blocking_Queue; Item : in Integer) is begin Queue.Add_Item(Item); end Add_Item; procedure Remove_Item (Queue : in out Blocking_Queue; Item : out Integer) is begin Queue.Remove_Item(Item); end Remove_Item; end PQ; This is essentially the same thing you would have to do if you had a generic that took a limited private type with formal subprograms Add_Item and Remove_Item. To pass in a protected type to such a generic, you basically have to create "wrappers" that turn around and call the protected operations. The capability provided by interfaces is very similar to that provided by a generic with various formal subprograms, except of course it supports run-time polymorphism, rather than compile-time polymorphism. Since task and protected types can be passed in as the actual type for a limited private formal type, there seems some logic in allowing task and protected types to be derived from limited interface types. Since protected and task types generally already have type descriptors of some sort, giving them a structure that would allow them to also double as (limited) tagged type descriptors seems relatively straightforward. Whether the effort is worth it depends on the relative importance of this inheritance integration. > ... > Without [compiler-provided wrappers], > ... I don't see much point in the whole mechanism. Other than basic > locks (which you should avoid anyway), there don't seem to be that many > cases of wanting multiple implementations of protected objects or tasks. The advantage of the proposal seems to be that if you want a type to be *visibly* a protected or task type, but you *also* want it to implement some important interface, this gives you that capability. Alternatively, you could wrap the task or protected type in a visible tagged record type that implemented the various interfaces, but that seems to defeat the level of inheritance integration we might be trying to achieve. **************************************************************** From: Randy Brukardt Sent: Thursday, January 22, 2004 9:37 PM > Randy Brukardt wrote: > > Tucker Taft wrote: > > > >>>... I have modified this > >>>proposal to allow task/protected types to be derived > >>>from "normal" limited interfaces as well as from > >>>task/protected interfaces. ... > >> > >>I suppose we could take one further step, and allow > >>task types/interfaces to be derived from protected > >>interfaces that have only abstract entry/entry families. > > > > > > I don't know if that is useful. But the problem with this proposal is that > > it doesn't seem to help in all of the cases where you might want to mix > > implementations. > > > > For one thing, while a task can be derived from a "regular" limited > > interface, such an interface has to be devoid of operations -- making the > > capability fairly useless. > > Why must the interface be devoid of operations? Because the only things allowed in a task are entries, so you couldn't provide the needed concrete operations of the type. ... > Apparently I wasn't being clear at all. No, I thought that you were trying to provide an integration of interfaces, not a framework for wrappers that you could write yourself. > If a protected type implements a limited interface, it must have > primitive operations *outside* the type declaration that override > those inherited from the interface. These will presumably be > implemented in terms of protected operations of the type. E.g.: > > package PQ is > protected type Blocking_Queue ... [as you have it] > procedure Add_Item (Queue : in out Blocking_Queue; > Item : in Integer); > procedure Remove_Item (Queue : in out Blocking_Queue; > Item : out Integer); > end PQ; > package body PQ is > protected body Blocking_Queue ... [as you would expect] > procedure Add_Item (Queue : in out Blocking_Queue; > Item : in Integer) is > begin > Queue.Add_Item(Item); > end Add_Item; > procedure Remove_Item (Queue : in out Blocking_Queue; > Item : out Integer) is > begin > Queue.Remove_Item(Item); > end Remove_Item; > end PQ; > > This is essentially the same thing you would have to do > if you had a generic that took a limited private type with > formal subprograms Add_Item and Remove_Item. To pass > in a protected type to such a generic, you > basically have to create "wrappers" that turn around > and call the protected operations. The capability > provided by interfaces is very similar to that provided > by a generic with various formal subprograms, except > of course it supports run-time polymorphism, rather than > compile-time polymorphism. Since task and protected types > can be passed in as the actual type for a limited private > formal type, there seems some logic in allowing task > and protected types to be derived from limited interface > types. > > Since protected and task types generally already have type > descriptors of some sort, giving them a structure that would > allow them to also double as (limited) tagged type descriptors > seems relatively straightforward. Whether the effort is > worth it depends on the relative importance of this > inheritance integration. What integration? I don't see any integration here, I just see a wrapper that you have to write virtually all of yourself. And you could have written it yourself without any special interfaces at all (beyond the AI-251 ones). Indeed, this wrapper saves all of two lines of code (and the need to insert ".Q" in a few places). And it's less flexible than the hand-generated wrapper, because you can't have extra data if you need it. So what is it about this that makes it worth any effort at all? > > > ... > > Without [compiler-provided wrappers], > > ... I don't see much point in the whole mechanism. Other than basic > > locks (which you should avoid anyway), there don't seem to be that many > > cases of wanting multiple implementations of protected objects or tasks. > > The advantage of the proposal seems to be that if you want a > type to be *visibly* a protected or task type, but you *also* > want it to implement some important interface, this gives you > that capability. > > Alternatively, you could wrap the task or protected type > in a visible tagged record type that implemented the various interfaces, > but that seems to defeat the level of inheritance integration > we might be trying to achieve. This doesn't come close to the level of interface integration that *I* was expecting to get. Ada's problem has always been that many of its features are isolated from the others. That's especially true of the real-time ones. Here, we have a chance to provide a real bridge, and something that saves all of two lines of code isn't it. If it turns out that this bridge isn't useful or workable, then we shouldn't provide one that vaguely looks like it is simply because we can. We did that with return-by-reference functions, and it's obvious how well *that* one worked out. Anyway, my abstract view of interfaces is that there basically should be just one type. And all instances of that type ought to work the same way. Thus, you can create a protected interface simply by adding the word 'protected' to an existing one, and no code changes will be needed (other than to change the name). This is precisely the model that you are always talking about to allow interoperation of abstract types and interface types. In that case, I think it is rare that it actually will work, but in this case, it should always work - unchanged. In an ideal world, there would be no difference between the kinds of interfaces at all. Limited interfaces could have entries, and they'd match entries. (Obviously, the concrete type would have to be task or protected in that case.) If there are no entries, any of the items could be a concrete type (with procedures matching entries as noted above). Note that by adding prefix calls, we allow these subprograms to be called in either notation, so there is no notational reason for treating them differently. A protected subprogram call could still look natural. The compiler would generate a wrapper if needed to make the calls consistent. This is very similar to what's done for renames and formal subprograms (as you noted). Of course, the world is not ideal. Entry calls cause problems, because the implementation model for tasks and protected objects is probably very different. Mandating that there exist some sort of call that works on both might be a burden on implementations. I presumed that (and *only* that) is why you retained task and protected interfaces - so you could keep wrapperless entry calls straight. That way, entries are only allowed in task and protected interfaces, and you know how to call them. Anyway, it seems to me that there is another solution to the problem of entries. Protected types really don't have any interesting operations from outside of themselves other than entries. That's different than tasks. Moreover, the original problem is the extensibility of protected types. No one was asking for extensible tasks. So adding tasks to the equation makes it much hard to create an integrated solution. Thus, I propose dropping task interfaces altogether. Then, we simply allow limited interfaces to have entries. (In which case, the concrete type must be a protected object.) The compiler will need to make all of the subprogram calls have the right convention for the interface, but that's not difficult (if you can rename a protected procedure as a normal one, you can build the appropriate wrapper). The matching rules for protected objects would be as I stated before: subtype conformance with the profile with the PO added as the first parameter of the profile (mode in out for procedures, mode in for functions). And family-less entries match procedures. That would mean that if you are programming through interfaces, you do not even need to know if the actual implementation is a protected type or just a tagged type. You don't have to write any wrapper routines by hand. And if you need more powerful wrappers, you can certainly write them. This is our last chance to integrate protected types into the rest of the language. If we adopt separate-but-equal (which is essentially Tucker's proposal), we're not going to have enough leaway to ever fix it. (At least without major pain.) Sorry about the stream-of-consciousness, it's too much to go back and rewrite it all to match the final conclusion. **************************************************************** From: Tucker Taft Sent: Thursday, January 22, 2004 9:51 PM I'll have to think a while about Randy's response. So don't expect a quick answer... **************************************************************** From: Randy Brukardt Sent: Thursday, January 22, 2004 10:15 PM I think I'd rather have a *good* response, rather than a *quick* one. I'm sure there is something wrong with my idea (there always is :-), and we want to know what it is before we adopt it... **************************************************************** From: Pascal Leroy Sent: Friday, January 23, 2004 4:04 AM Since my name appears in this AI as a justification for its existence, I thought I would clarify what problem I am interested in solving, and how. In essence I concur with most of Randy's analysis, although with some differences. The problem that I am interested in is the situation where you have one interface that has some implementations based on vanilla tagged types and other implementations based on protected types (to provide for data protection and/or synchronization). I want to be able to operate on objects that implement this interface without having to distinguish the tagged case from the protected case. I am *not* interested in task types in this context. The reason is essentially that I don't believe that the existence of a thread of control is an "implementation detail" that can be hidden from clients: think of termination, scheduling, etc. Furthermore, I cannot think of a practical situation where some implementations of an abstraction would be task-based and others would be tagged-type-based (but that may only be a failure of my imagination). So adding task types to the mix is a misguided attempt at orthogonality, and is likely to kill the proposal. So now we are only dealing with tagged types and protected types. Where I disagree with Randy is in his attempt to add entries to limited interfaces. This is opening a big can of worms: now we'd have to deal with primitive entries, and class-wide entries, not to mention the confusion between dispatching calls and dispatching points :-). Furthermore, when I write an interface, I generally have no idea what operations might need to be synchronizing in some implementation. We could specify that (1) a protected type can be derived from a limited interface, and (2) primitive functions may be overridden by protected functions, and (3) primitive procedures may be overridden by *either* protected procedures or entries. Of course, the first parameter would be substituted as appropriate (similarly to AI 252), and the compiler would need to generate wrappers. Using Randy's example, this gives: type Abstract_Queue is limited interface; procedure Add_Item (Queue : in out Abstract_Queue; Item : in Integer); procedure Remove_Item (Queue : in out Abstract_Queue; Item : out Integer); Now here is a tagged implementation (just AI 251, really): type Tagged_Queue is new Abstract_Queue with private; procedure Add_Item (Queue : in out Tagged_Queue; Item : in Integer); procedure Remove_Item (Queue : in out Tagged_Queue; Item : out Integer); Here is an implementation with mere data protection: protected type Protected_Queue is new Abstract_Queue with procedure Add_Item (Item : in Integer); procedure Remove_Item (Item : out Integer); private ... end Protected_Queue; And here is an implementation with synchronization: protected type Synchronizing_Queue is new Abstract_Queue with procedure Add_Item (Item : in Integer); entry Remove_Item (Item : out Integer); private ... end Synchronizing_Queue; Note that this is a considerable simplification of the proposal, as there is no need for protected interfaces or task interfaces (and thus no need to argue about their syntax ;-) and tasks are unaffected by the change. Because we don't have formal protected or task types, generics are unaffected too. Although I obviously didn't try to write it, I believe that the RM wording would be relatively short (which is always good news). (I am noticing that Tuck's AI cleverly dodges the issue of whether we need new formal types for protected and task interfaces: this is a lose-lose situation; if you say "no", you make them unnecessarily different from normal interfaces; if you say "yes", boy, this gets hard.) **************************************************************** From: Tucker Taft Sent: Friday, January 23, 2004 7:39 AM > We could specify that (1) a protected type can be derived from a limited > interface, and (2) primitive functions may be overridden by protected > functions, and (3) primitive procedures may be overridden by *either* > protected procedures or entries. ... What you and Randy are proposing is certainly interesting. With this approach, I would recommend we also allow primitive operations to be overridden with "normal" primitive operations of the protected type, in case a single "high-level" operation is best implemented as multiple calls on protected operations (with intentionally preemptible gaps). Also, there might be changes in naming required, for example, the limited interface might have a primitive whose name is an operator symbol. A "human"-written wrapper would be needed for a case like that. I also don't see any reason why a task type couldn't implement a limited interface. Mostly all you are providing with this proposal is compiler-generated wrappers (or am I missing something)? You could have just as easily wrapped a task as a protected object in a tagged record, so it seems reasonable that the compiler should just as easily be able to generate wrappers for calling task entries as calling protected entries. What you are losing is the ability to use objects of type Prot_Int'Class (or Task_Int'Class) in any constructs that require entries, i.e. various forms of select statements. For task interfaces, you would be losing the ability of doing an abort or retrieving the task identity. Of course you could provide the abort/task-identity operations via a separate limited interface which only types containing/comprising a task would choose to implement. The real loss seems to be select statements. Perhaps there is some way to regain that? I can imagine various avenues: 1) Provide a standard "magic" interface that provides operations needed to implement a select statement, and allow calls through a class-wide object of that interface to be used in a select statement. This sounds hard and non-obvious. 2) Allow "normal" interfaces to have abstract entries, declared *inside* the interface definition, similar to the proposed task/protected interface syntax. Such an interface could *only* be implemented by a task or protected type. 3) Same as (2), but allow non-task/protected types to implement them by overriding entries with primitive procedures of the same name (declared "outside" the type with the "usual" AI-252 transformation). The semantics would be that the entry barrier is assumed to be true. 4) Allow *any* primitive procedure of an interface whose first parameter is controlling to be called in a select statement so long as "prefix" notation is used. *If* the procedure is overridden with an entry, then there is a barrier to worry about. Otherwise, the barrier is presumed true. I kind of like (4). This clearly links AI-252 and AI-345 pretty closely, and also avoids having to invent abstract entries. This also might "nudge" us in the direction of allowing protected operations to be called in "infix" rather than "prefix" notation (except in a select statement!), essentially making AI-252 work "both" ways. For upward compatibility, prefix notation would choose a protected operation before a primitive operation, and infix notation would choose a primitive operation before a protected operation, but if there is no ambiguity, either kind of operation could be called either way. I think select statements are pretty important if we are going to satisfy the requirements of the real-time community... **************************************************************** From: Pascal Leroy Sent: Friday, January 23, 2004 7:59 AM > With this approach, I would recommend we also allow primitive operations > to be overridden with "normal" primitive operations of the > protected type, in case a single "high-level" operation is > best implemented as multiple calls on protected operations > (with intentionally preemptible gaps). Also, there might be > changes in naming required, for example, the limited > interface might have a primitive whose name is an operator > symbol. A "human"-written wrapper would be needed for a case > like that. This makes sense, but it adds complexity. I would really try to keep the proposal dead simple if I were you. If operators are the only problem here, we might be better off allowing them as protected operation (I know, the syntax doesn't look too good because of the implicit parameter). > I also don't see any reason why a task type couldn't > implement a limited interface. Mostly all you are providing > with this proposal is compiler-generated wrappers (or am I > missing something)? You could have just as easily wrapped a > task as a protected object in a tagged record, so it seems > reasonable that the compiler should > just as easily be able to generate wrappers for calling task entries > as calling protected entries. Yes, that crossed my mind, but I guess that I see this facility as being part of the OO side of the language, not of the real-time side, so I cannot get excited about tasks. Note that as soon as an interface has a primitive function, it couldn't be implemented by a task. This means that if you want to write a fully general interface, you would have to restrict yourselves to procedures. So we would effectively invite people to avoid functions in interfaces, something that I don't like. > 4) Allow *any* primitive procedure of an interface whose first parameter > is controlling to be called in a select statement so long as "prefix" > notation is used. *If* the procedure is overridden with an entry, then > there is a barrier to worry about. Otherwise, the barrier is presumed true. > > I kind of like (4). This clearly links AI-252 and AI-345 > pretty closely, and also avoids having to invent abstract > entries. This also might "nudge" us in the direction of > allowing protected operations to be called in "infix" rather > than "prefix" notation (except in a select statement!), > essentially making AI-252 work "both" ways. For upward > compatibility, prefix notation would choose a protected > operation before a primitive operation, and infix notation > would choose a primitive operation before a protected > operation, but if there is no ambiguity, either kind of > operation could be called either way. > > I think select statements are pretty important if we are > going to satisfy the requirements of the real-time community... Of the solutions that you propose (4) also has my preference, but I guess I don't see select statements as such a big deal. Again, I don't see this capability as oriented towards the real-time community. But maybe Alan can comment on this. **************************************************************** From: Tucker Taft Sent: Friday, January 23, 2004 8:26 AM Pascal Leroy wrote: >>With this approach, I would recommend we also allow primitive operations >>to be overridden with "normal" primitive operations of the >>protected type, in case a single "high-level" operation is >>best implemented as multiple calls on protected operations >>(with intentionally preemptible gaps). Also, there might be >>changes in naming required, for example, the limited >>interface might have a primitive whose name is an operator >>symbol. A "human"-written wrapper would be needed for a case >>like that. > > This makes sense, but it adds complexity. I would really try to keep > the proposal dead simple if I were you. If operators are the only > problem here, we might be better off allowing them as protected > operation (I know, the syntax doesn't look too good because of the > implicit parameter). I don't see this adding complexity. If the user writes the wrappers themselves, it *simplifies* the job for the compiler, and it seems non-intuitive that you can't override in the "normal" way as well as via a protected operation. Anyone who has used protected types with generics or as the full type for a private type knows about wrappers. Yes perhaps they are a bit of a pain, but they also add important flexibility. Generally you try to have as few protected operations as possible. It seems quite likely that they won't necessarily map one-to-one with the operations of an interface, and the user will want to be able to implement some of the interface operations with a sequence of calls on protected operations. This same kind of "adaptation" to the needs of an interface will happen with tagged types. Its seems even more important to allow this kind of adaptation when implementing an interface with a protected type. >>I also don't see any reason why a task type couldn't >>implement a limited interface. Mostly all you are providing >>with this proposal is compiler-generated wrappers (or am I >>missing something)? You could have just as easily wrapped a >>task as a protected object in a tagged record, so it seems >>reasonable that the compiler should >>just as easily be able to generate wrappers for calling task entries >>as calling protected entries. > > Yes, that crossed my mind, but I guess that I see this facility as being > part of the OO side of the language, not of the real-time side, so I > cannot get excited about tasks. We have gone out of our way to make task and protected types have similar syntax and rules. It seems silly at this point to ignore the similarity for lack of interest from an OO perspective. And in OO land, active and passive objects are well understood and both are of interest. In fact a feature of Java is that it is easy to have an object implement the "runnable" interface. Why shouldn't we do the same thing if it is so natural in Ada? > ... Note that as soon as an interface has a > primitive function, it couldn't be implemented by a task. ... Not if we allow primitive operations to be overridden in the "normal" way as well. Remember that task entries can be called on *in* parameters of a task type. >>4) Allow *any* primitive procedure of an interface whose first parameter >> is controlling to be called in a select statement so long as "prefix" >> notation is used. *If* the procedure is overridden with an entry, then >> there is a barrier to worry about. Otherwise, the barrier is presumed true. > ... >>I think select statements are pretty important if we are >>going to satisfy the requirements of the real-time community... > > Of the solutions that you propose (4) also has my preference, but I > guess I don't see select statements as such a big deal. Again, I don't > see this capability as oriented towards the real-time community. But > maybe Alan can comment on this. The protected interface proposal was a simplification of the protected type extension proposal which arose in the real-time community. I don't think we should abandon their concerns as we try to do a better job of integrating it into other parts of the language. That sounds like burning bridges before you come to them! **************************************************************** From: Tucker Taft Sent: Friday, January 23, 2004 12:21 PM I like the idea of using limited interfaces as a way of integrating tagged, protected, and task types. It seems we could have two predefined interfaces, Task_Interface and Protected_Interface. Every task type would automatically implement Task_Interface, and every protected type would automatically implement Protected_Interface. At a minimum Task_Interface would have an Identity primitive function. Given that, the routines in Ada.Task_Identification and Ada.Task_Attributes could be used. It might be nice to have an explicit Abort_Task procedure that worked on Task_Interface, either as another primitive of Task_Interface, or as a class-wide operation that took Task_Interface'Class and just passed the result of calling Identity on the class-wide obj to the Abort_Task procedure in Ada.Task_Identification. It would also seem reasonable to allow a tagged type to implement the Task_Interface, presuming it had a task component. It could implement the Identify primitive function by returning the Identity attribute of its task component. It would seem if we went this route, then the unique syntax associated with task and protected types could be masked to some degree in generics, etc., but you could still specify that the actual type be a task, or at least implement Task_Interface. I also think we should endeavor to allow non-limited types to implement limited interfaces, which would then make them nearly universal. **************************************************************** From: Gary Dismukes Sent: Friday, January 23, 2004 12:33 PM Tuck wrote: > 4) Allow *any* primitive procedure of an interface whose first parameter > is controlling to be called in a select statement so long as "prefix" > notation is used. *If* the procedure is overridden with an entry, then > there is a barrier to worry about. Otherwise, the barrier is presumed true. > > I kind of like (4). This clearly links AI-252 and AI-345 pretty closely, > and also avoids having to invent abstract entries. This also might > "nudge" us in the direction of allowing protected operations to be > called in "infix" rather than "prefix" notation (except in a > select statement!), essentially making AI-252 work "both" ways. I find (4) appealing as well. Not sure what I think of allowing infix notation for protected operations, but that seems of minor importance. > I think select statements are pretty important if we are going to > satisfy the requirements of the real-time community... Yes, that certainly seems important, especially given that the request for this feature came largely from that community. **************************************************************** From: Randy Brukardt Sent: Friday, January 23, 2004 6:13 PM ... > I don't see this adding complexity. If the user writes the > wrappers themselves, it *simplifies* the job for the compiler, and > it seems non-intuitive that you can't override in the > "normal" way as well as via a protected operation. Anyone > who has used protected types with generics or as the > full type for a private type knows about wrappers. Yes > perhaps they are a bit of a pain, but they also add important > flexibility. Generally you try to have as few protected > operations as possible. It seems quite likely that they > won't necessarily map one-to-one with the operations of > an interface, and the user will want to be able to implement > some of the interface operations with a sequence of > calls on protected operations. This same kind of "adaptation" > to the needs of an interface will happen with tagged types. > Its seems even more important to allow this kind of > adaptation when implementing an interface with a protected type. It does add complexity, because you need a tag-like outer object for dispatching purposes, and that's something extra that the compiler would have to generate. And, as I said yesterday, it wouldn't save much work for the programmer - they'd end up writing nearly the same code if they explicitly wrapped it themselves. Moreover, if you provide the Task_Interface and Protected_Interface you suggested earlier (and those are good ideas), and the alternative (4), then the programmer writing such a wrapper can make it look like a task, complete with select statements and abort. So why add the complexity to the language? Of course, if it proves not to make much work either in wording or in implementation, then I won't object. But I have to wonder... ... > We have gone out of our way to make task and protected types > have similar syntax and rules. It seems silly at this point to ignore > the similarity for lack of interest from an OO perspective. > And in OO land, active and passive objects are well understood > and both are of interest. In fact a feature of Java is that > it is easy to have an object implement the "runnable" interface. > Why shouldn't we do the same thing if it is so natural in Ada? Tucker is correct here in terms of value. The main reason I didn't suggest this was implementation complexity. > ... > >>4) Allow *any* primitive procedure of an interface whose first parameter > >> is controlling to be called in a select statement so long as "prefix" > >> notation is used. *If* the procedure is overridden with an entry, then > >> there is a barrier to worry about. Otherwise, the barrier is presumed true. > ... > The protected interface proposal was a simplification of the > protected type extension proposal which arose in the real-time > community. I don't think we should abandon their concerns > as we try to do a better job of integrating it into other > parts of the language. That sounds like burning bridges > before you come to them! Absolutely. And I agree that (4) is the cleanest from a user perspective. The only reason I didn't suggest this was that I thought that implementation concerns would prevent a complete unification of entries and procedures. For instance, Janus/Ada uses different code (with different parameters) for task entry calls and protected entry calls. In particular, how the entry is identified is different (because there can be multiple accepts with a task, and only one for a PT). That's OK, because it is statically known which to generate. This would eliminate that, and require the task supervisor to somehow be able to determine the difference between a task and a protected object at runtime. And we'll also lose the strong typing of the entry definition (clearly, we can stick a small integer into an address, but we'll no longer know which it originally was). Also, since it is the entry call itself that implements Select statements, I don't quite see how to implement that for a call that never goes near the task supervisor (an ordinary procedure call). I don't think any of these is a huge deal for Janus/Ada. At worst, they'd be a performance hit for select statements, which is unlikely to matter to our customers. But I thought that other RTS's were much more aggressive about using this knowledge. For instance, I thought that the idea behind ceiling locking was to avoid all of the overhead of PO's completely, turning it all into a normal subprogram call. If that's done, I don't see how they'll be able to support a call that might be a task entry or might be a protected entry or might be neither, because the details are vastly different. The implementation I was suggesting for entries fulfilling procedures was to wrap them to make them into regular procedures. That we know how to do (because of renames), and there is no problem doing it. But I don't know how to wrap an entry (of either a task or protected type) and later call it as an entry (i.e. via a select statement). Ada 95 doesn't have access-to-entry, after all. And I especially don't know how to put that into a tag (for one thing, it won't fit). So, I think we need to talk to some other implementers about this further before spending too much time on it. If there isn't much problem, this is a vastly preferable solution to any of the others suggested. But I'd be surprised if the real-time folks think it is implementable. Which it why I suggested restricting it to protected types. In that case, select calls could be implemented however they are for protected entries, and one probably could figure out some way to map normal subprograms to that. (It would still be tough in our case, because the profiles wouldn't match...but probably surmountable.) And it would be easier still with abstract entries. **************************************************************** From: Tucker Taft Sent: Friday, January 23, 2004 8:38 PM > > >Tucker Taft wrote: > > >>With this approach, I would recommend we also allow primitive operations > > >>to be overridden with "normal" primitive operations of the > > >>protected type, in case a single "high-level" operation is > > >>best implemented as multiple calls on protected operations > > >>(with intentionally preemptible gaps). Also, there might be > > >>changes in naming required, for example, the limited > > >>interface might have a primitive whose name is an operator > > >>symbol. A "human"-written wrapper would be needed for a case like that. > ... > It does add complexity, because you need a tag-like outer object for > dispatching purposes, and that's something extra that the compiler would > have to generate. And, as I said yesterday, it wouldn't save much work for > the programmer - they'd end up writing nearly the same code if they > explicitly wrapped it themselves. I like your idea of having the compiler generate wrappers for protected operations that match the interface operation. I am simply arguing for allowing the user to write a wrapper if necessary because the interface operation should *not* be done as a single protected operation, but instead, requires a break in the middle (e.g. because it needs to call a potentially blocking operation), or because a loop is involved which you don't want to do while holding the lock. > Moreover, if you provide the Task_Interface and Protected_Interface you > suggested earlier (and those are good ideas), and the alternative (4), then > the programmer writing such a wrapper can make it look like a task, complete > with select statements and abort. So why add the complexity to the language? I'm not sure what complexity you are talking about now. I am simply arguing for allowing "normal" overriding of the interface type's primitive by one of the protected type's primitive subprogram, as well as the "new" overriding you and Pascal have proposed of an interface primitive by a protected type's protected operation. I don't see how this requires a "tag" that wouldn't have to be there anyway, since whether the compiler or the human writes a wrapper subprogram, it needs to end up in a dispatch table pointed to by the protected object. > Of course, if it proves not to make much work either in wording or in > implementation, then I won't object. But I have to wonder... I can't imagine how it would be more work in the implementation. And in the wording, it means simply allowing what is already allowed, namely overriding of an operation inherited from an ancestor. We would have to write more to disallow it, I suspect. > ... > Tucker is correct here in terms of value. The main reason I didn't suggest > this was implementation complexity. A wrapper is a wrapper. It doesn't matter whether the wrapper is calling a task entry or a protected entry as far as I can tell. > ... > Absolutely. And I agree that (4) is the cleanest from a user perspective. > The only reason I didn't suggest this was that I thought that implementation > concerns would prevent a complete unification of entries and procedures. > > For instance, Janus/Ada uses different code (with different parameters) for > task entry calls and protected entry calls. In particular, how the entry is > identified is different (because there can be multiple accepts with a task, > and only one for a PT). That's OK, because it is statically known which to > generate. > > This would eliminate that, and require the task supervisor to somehow be > able to determine the difference between a task and a protected object at > runtime. ... I don't think this is the simplest way to support this. I would expect that you would leave the existing code pretty much as is, so if you know you are calling a task entry, you would call directly to the task entry handling code, and if you know you are calling a protected entry, you would call directly to the protected entry, but if you don't know whether you are actually calling an entry at all, or whether it is a task entry or a protected entry, then you would call a new routine, which would at run-time decide which case it has, and *then* call the appropriate handler. This would mean no added overhead for existing code; only code that called "interface'Class.Operation()" in a select statement would have to incur the overhead of deciding whether we had a task entry, a protected entry, a protected subprogram, or a "regular" subprogram. > ... And we'll also lose the strong typing of the entry definition > (clearly, we can stick a small integer into an address, but we'll no longer > know which it originally was). I'm not sure what you mean by "strong" typing. I think if you follow the strategy above, you will still have the "strong" typing when it is known at compile-time to be a call on a task entry, whereas when it is a call on a class-wide interface object, you will have to do extra work to come up with the parameters to pass to the task or protected entry handlers. > ... Also, since it is the entry call itself that > implements Select statements, I don't quite see how to implement that for a > call that never goes near the task supervisor (an ordinary procedure call). Again, this new routine which handles interface'class "entry" calls would figure out what to do. > I don't think any of these is a huge deal for Janus/Ada. At worst, they'd be > a performance hit for select statements, which is unlikely to matter to our > customers. But I thought that other RTS's were much more aggressive about > using this knowledge. For instance, I thought that the idea behind ceiling > locking was to avoid all of the overhead of PO's completely, turning it all > into a normal subprogram call. If that's done, I don't see how they'll be > able to support a call that might be a task entry or might be a protected > entry or might be neither, because the details are vastly different. With the above approach, full optimization can be used for existing calls. The only overhead would be for calls on class-wide objects. > The implementation I was suggesting for entries fulfilling procedures was to > wrap them to make them into regular procedures. That we know how to do > (because of renames), and there is no problem doing it. But I don't know how > to wrap an entry (of either a task or protected type) and later call it as > an entry (i.e. via a select statement). Ada 95 doesn't have access-to-entry, > after all. And I especially don't know how to put that into a tag (for one > thing, it won't fit). I suspect that a way around this is not only "wrap" the entries and protected subprograms with regular subprograms, but also wrap the task or protected object in a tagged record object. Hence, a task or protected type that implements an interface is actually internally represented as a tagged record with one component, which is a task or protected object. In other words, such task and protected types have their existing layout, plus a tag added on the front. The "wrapper" subprograms would have no trouble skipping past this tag, implicitly selecting the task/protected component. Similarly, any direct call of a protected subprogram or entry would also implicitly select the task/protected component. Converting back from a task/protected object to a class-wide object would involve "backing up" to the tag preceding the component. > So, I think we need to talk to some other implementers about this further > before spending too much time on it. If there isn't much problem, this is a > vastly preferable solution to any of the others suggested. But I'd be > surprised if the real-time folks think it is implementable. > > Which it why I suggested restricting it to protected types. In that case, > select calls could be implemented however they are for protected entries, > and one probably could figure out some way to map normal subprograms to > that. (It would still be tough in our case, because the profiles wouldn't > match...but probably surmountable.) If you have to be able to handle protected entries, protected subprograms, and regular subprograms, handling task entries as well seems like a very small incremental effort, especially given the approach suggested above. > ... And it would be easier still with > abstract entries. True, though that would ultimately be less flexible, and more syntax invention. **************************************************************** From: Randy Brukardt Sent: Friday, January 23, 2004 10:11 PM Tucker said: ... > I'm not sure what complexity you are talking about now. The conceptual complexity of having operations match both ones inside the protected or task type and outside the protected or task type. But I don't feel that strongly about this. (And there is no doubt it would make concrete types easier to write.) ... > > Of course, if it proves not to make much work either in wording or in > > implementation, then I won't object. But I have to wonder... > > I can't imagine how it would be more work in the implementation. > And in the wording, it means simply allowing what is already > allowed, namely overriding of an operation inherited from > an ancestor. We would have to write more to disallow it, > I suspect. If true, go for it. :-) > > ... > > Tucker is correct here in terms of value. The main reason I didn't suggest > > this was implementation complexity. > > A wrapper is a wrapper. It doesn't matter whether the wrapper > is calling a task entry or a protected entry as far as I can > tell. That presumes you can figure out a way to write a wrapper that can call either. At least not from a select statement. I can do it for Janus/Ada, but it is very messy. It's not clear to me that it can be done for other compilers - at least not with the efficiency that real-time users will demand. > > This would eliminate that, and require the task supervisor to somehow be > > able to determine the difference between a task and a protected object at > > runtime. ... > > I don't think this is the simplest way to support this. > I would expect that you would leave the existing code pretty > much as is, so if you know you are calling a task entry, you > would call directly to the task entry handling code, and > if you know you are calling a protected entry, you would > call directly to the protected entry, but if you don't know > whether you are actually calling an entry at all, or whether > it is a task entry or a protected entry, then you would call > a new routine, which would at run-time decide which case it > has, and *then* call the appropriate handler. This would > mean no added overhead for existing code; only code that > called "interface'Class.Operation()" in a select statement would > have to incur the overhead of deciding whether we had a task entry, > a protected entry, a protected subprogram, or a "regular" > subprogram. That's what I was describing: how to write that new routine. It certainly isn't possible in the current Janus/Ada RTS (there isn't any way to tell a protected object from a task object at runtime - neither has a tag or other static descriptor). So you have to change the way all tasks and all POs are generated to add something that can tell that. (You could guess, of course, and it *usually* would work [because POs are on the finalization chain], but I don't think that's a good idea.) > > ... And we'll also lose the strong typing of the entry definition > > (clearly, we can stick a small integer into an address, but we'll no longer > > know which it originally was). > > I'm not sure what you mean by "strong" typing. I think if you > follow the strategy above, you will still have the "strong" typing > when it is known at compile-time to be a call on a task entry, > whereas when it is a call on a class-wide interface object, you > will have to do extra work to come up with the parameters to pass > to the task or protected entry handlers. I'm referring to the strong typing of the task supervisor. Certainly, once you punch a giant hole in it, the fact that the other paths remain strongly typed is much less valuable. > > ... Also, since it is the entry call itself that > > implements Select statements, I don't quite see how to implement that for a > > call that never goes near the task supervisor (an ordinary procedure call). > > Again, this new routine which handles interface'class "entry" calls > would figure out what to do. That's getting to be a pretty brilliant routine. Perhaps it will find bugs in your program, too?? :-) ... > With the above approach, full optimization can be used for existing > calls. The only overhead would be for calls on class-wide objects. Right. But I think the real-time folks will care about that cost. Unless, of course, they never use the feature (in which case, why the heck did they ask for it in the first place??) (Of course, there is precedent for them asking for an impossible-to-implement efficiently feature -- remember multi-way entry calls??) > > The implementation I was suggesting for entries fulfilling procedures was to > > wrap them to make them into regular procedures. That we know how to do > > (because of renames), and there is no problem doing it. But I don't know how > > to wrap an entry (of either a task or protected type) and later call it as > > an entry (i.e. via a select statement). Ada 95 doesn't have access-to-entry, > > after all. And I especially don't know how to put that into a tag (for one > > thing, it won't fit). > > I suspect that a way around this is not only "wrap" the entries > and protected subprograms with regular subprograms, but also > wrap the task or protected object in a tagged record object. > Hence, a task or protected type that implements an interface > is actually internally represented as a tagged record with > one component, which is a task or protected object. > In other words, such task and protected types have their > existing layout, plus a tag added on the front. > The "wrapper" subprograms would have no trouble skipping past > this tag, implicitly selecting the task/protected component. > Similarly, any direct call of a protected subprogram or entry > would also implicitly select the task/protected component. > Converting back from a task/protected object to a class-wide > object would involve "backing up" to the tag preceding > the component. Yes, that works fine for calling entries as procedures. But once you do that, you've lost access to the "entryness" of them. If you call that wrapper in a select statement (via a class-wide call), it would look just like a procedure to the compiler. It would have to, so it could be *called* like a procedure. If you made all subprograms in interfaces callable as entries, you'd have to implicitly add a boatload of parameters to them, and that would be distributed overhead for all of the applications that *don't* use select statements and entry calls. > If you have to be able to handle protected entries, protected subprograms, > and regular subprograms, handling task entries as well seems like > a very small incremental effort, especially given the approach > suggested above. Quite possibly. I'm afraid the entire idea is impossible. > > ... And it would be easier still with abstract entries. > > True, though that would ultimately be less flexible, > and more syntax invention. I certainly agree about more syntax invention. But at least I can see how to implement class-wide calls of it. --- Let me step back a moment and make sure that I understand your model for these select statements of class-wide procedure calls. Using a select statement to call a real procedure is clearly useless: the procedure is always ready, so the timeout or alternative will never run. But of course allowing that means that if it *is* an entry, then we have the timeout available -- which means that we want entry behavior in that case. A limited interface will have a tag of some sort, which will have the addresses of the various wrapper routines generated. These will be normal functions and procedures, and will be callable as such. (If not, you have horrible distributed overhead on interfaces.) That's true even if the actual operation is an entry. We know how to write these wrappers -- it's just renames of an entry to a procedure (an existing Ada feature). I hope we agree so far. Now, you want to be able to make class-wide calls on procedures via select statements. If the calls are class-wide, the actual routine will be looked up via the tag. Right? In which case, you're going to get the wrapper which is a procedure. Which is fine, except that that wrapper is going to *act* like a procedure -- it is always ready. How could it not be? The wrapper is just an ordinary subprogram, and it cannot provide the information necessary to query if a task is waiting at an appropriate accept statement or if POs barrier is open. All you have is a single subprogram pointer - to a subprogram that must be callable as a normal subprogram. I can think of ways to provide the necessary information, but they all have a distributed overhead. That's because any interface procedure can be called this way, and the code generated for a select statement needs to have some way to figure out if (a) this is an ordinary subprogram; or (b) this is a task entry, and its entry identifier; or (c) this is a protected entry, and its entry body address. Since you want to have ordinary subprograms for these as well, even inspection of the object won't work. You could put that into the wrappers somehow, but then you'd have to put that into *every* subprogram, or generate wrappers for *every* subprogram that's in an interface (because that information would have to exist for any possible call). Either of those would have nasty caching effects, and extra wrappers mean slower calls as well. I'm not even convinced that the above information is sufficient to make an entry call. It certainly isn't if families are involved, but I'm assuming we're not matching those here. Parameter passing is actually different in Janus/Ada for protected entries, because we insert the protected object and family info (or 0 if there is no family) in every call. So we have an incorrect parameter list, and to fix it, we'd need to know how many parameters there are -- meaning another piece of data. (And one that Janus/Ada doesn't currently even give to the RTS.) Anyway, I just don't see how to implement this without distributed overhead of some sort. And that's based on our implementation, which is relatively simple. It seems like it would be much worse for systems that actually cared about performance instead of using all of these lookup values. So, I'd like to hear where you expect to find the information needed to make an entry call when all you have is the address of an ordinary procedure. Perhaps you have some other implementation model in mind - please explain it. **************************************************************** From: Tucker Taft Sent: Friday, January 23, 2004 8:38 PM Randy Brukardt wrote: > Tucker said: > >>A wrapper is a wrapper. It doesn't matter whether the wrapper >>is calling a task entry or a protected entry as far as I can >>tell. > > > That presumes you can figure out a way to write a wrapper that can call > either. I think the issues might have gotten mixed together. First I was arguing for allowing task types to implement limited interfaces, without talking about select statements. My claim is that all you need is a compiler-generated wrapper for any primitive that is overridden by a task entry, and the wrapper can just as easily call a task entry as a protected entry. Later comes the discussion about select statements (see more below)... > ... > So, I'd like to hear where you expect to find the information needed to make > an entry call when all you have is the address of an ordinary procedure. > Perhaps you have some other implementation model in mind - please explain > it. Ok, I'll propose something more concrete. And then I'll put it into a new version of the AI... Given a select statement like: select Sync_Obj.Add_Item(X); Put_Line("Add_Item completed"); or delay 5.0; Put_Line("Add_Item timed out"); end select; where "Sync_Obj" is a task or protected object, we currently translate this into, roughly: Status : Boolean; Param_Block : constant Add_Item_Params := (X => X); begin System.RTS.Timed_Rel_{Protected,Task}_Call( Called_Obj => Sync_Obj'Address, Params => Param_Block'Address, Name_Index => , Member_Index => 0, -- unless is member of entry family Delay_Amount => 5.0, Status => Status); if Status = True then Put_Line("Add_Item completed"); else Put_Line("Add_Item timed out"); end if; Timed_Rel_{Protected,Task}_Call sets Status to True if the entry call completes, False if it times out. To support a case where Sync_Obj is of type Limited_Interface'Class, and Add_Item is a primitive of Limited_Interface (called using prefix notation), it could instead be translated (roughly) into: Sync_Obj : Limited_Interface'Class ... type Call_Status is (Not_An_Entry, Completed, Not_Completed); Status : Call_Status := Not_An_Entry; Param_Block : constant Add_Item_Params := (X => X); begin Sync_Obj._Selective_Entry_Call( Params => Param_Block'Address, Slot_Num => , Selective_Call_Info => (Kind => Timed_Rel, Delay_Amount => 5.0), Status => Status); -- assume Status is now an in-out param if Status /= Not_Completed then if Call_Status = Not_An_Entry then Add_Item(Sync_Obj, X); -- Not an entry, -- call "normal" overriding end if; Put_Line("Add_Item completed"); else Put_Line("Add_Item timed out"); end if; Every limited interface would have to have one "implicit" primitive, say, _Selective_Entry_Call, which by default is null, leaving the Status as Not_An_Entry. However, if the interface is implemented by a task or protected type, and one of the interface's primitives is overridden by an entry, then _Selective_Entry_Call would have to be overridden with something which checked the slot number passed in, and if it corresponded to a primitive that was overridden by an entry, it would pass the name/family index of that entry to the appropriate RTS routine along with the Param_Block and the appropriate extra selective entry information, such as the relative delay amount. The status of this call would then determine the status of the call on _Selective_Entry_Call. If the primitive did not correspond to an entry, then the Status would be left as Not_An_Entry, and the compiler-generated code at the call site would then do a "normal" call on the overriding of the primitive, which might or might not be a wrapper. As far as distributed overhead, it would mean that every limited interface would need an implicit "null" procedure corresponding to _Selective_Entry_Call. This would purely be a space overhead, since it would never be called if the user didn't take advantage of this ability to call limited interface primitives in a select statement. If they did make such a call, and it did happen to correspond to an entry, then the overriding of _Selective_Entry_Call could make an "efficient" call on the appropriate RTS routine passing in the appropriate entry name/family indices, etc. If it didn't correspond to an entry, then _Selective_Entry_Call would return immediately to the compiler-generated code which would do a normal dispatching call on the primitive. So there wouldn't be too much overhead even when the feature was used. **************************************************************** From: Randy Brukardt Sent: Monday, January 26, 2004 7:04 PM ... > Ok, I'll propose something more concrete. And then > I'll put it into a new version of the AI... ... Thanks for showing a possible implementation. Unfortunately, such an implementation wouldn't work for Janus/Ada (at least without a lot of modification to the runtime.) Janus/Ada puts the (user) parameters on the stack in the normal way, then passes the task supervisor parameters in registers to keep the two sets of parameters separate. (For protected entry calls, the PO and family info is duplicated, and passed both ways.) There is no separate "parameter block" pointer - we don't have enought registers on the Intel processors to have one. The call to _Selective_Entry_Call, would, by definition be a normal call with parameters pushed on the stack (as well as the return address). That means when it came to be time to make the actual call, the parameters would be in the wrong place. And you can't move them to the right place, because they don't "belong" to the current subprogram and thus aren't accessible. We'd also have problems because the second parameter of a PTE call is always the family number, and that wouldn't be part of the profile. I suspect that we'd be better off putting the entry info directly into the tag: type Interface_Tag_Entry_Kind is (Subprogram, Task_Entry, Protected_Entry); type Interface_Tag_Entry (Kind : Tag_Entry_Kind) is Subprogram_Address : System.Address; -- The address of the subprogram (wrapper), -- for normal calls. case Kind is when Subprogram => null; when Protected_Entry => Entry_Body : System.Address; when Task_Entry => Entry_Id : Entry_Index; end case; end record; (I think this could be done with two address slots per entry on most targets, because most machines don't allow code near the zero address. So you could tell a protected entry from a task entry by the size of the value, and null (0) would be normal procedure. And in any case, there are not a lot of tags out there, so it wouldn't be a huge disaster even if it needed three dwords.) Note: This only would be for interface tags; regular tagged tags wouldn't include this information (they can only include regular subprograms). Then generating something like the following for a select statement (this is the same example as Tucker's): declare My_Slot : Tag_Entry renames Sync_Obj'Tag(); Status : Call_Status := Completed; begin if My_Slot.Kind = Subprogram then My_Slot.Subprogram_Address.all; -- Call with above parameters. elsif My_Slot.Kind = Task_Entry then Status := Sup_Entry_Call (Kind => Timed_Call, Callee => Sync_Obj, Entry_Id => My_Slot.Entry_Id, Family_Offset => 0, Relative_Time => 5.0); -- The parameters here are in registers. else -- Protected_Entry Status := Sup_Entry_Call (Kind => Timed_Call, Callee => Sync_Obj, Entry_Body => My_Slot.Entry_Body, Family => 0, Relative_Time => 5.0); -- The parameters here are in registers. end if; This is bigger at the selective call site for a class-wide call, but only there. It does mean generating the code to evaluate the parameters three times, but it only will execute once on any given call, so that ought not be too bad (it would have caching effects). And the call selected would be nearly as efficient as a direct call would be (and could be optimized as a direct call, as all of this would be explicitly in the intermediate code)). This all presumes that everything that determines the call is known when the tag is generated. I think that's true. **************************************************************** From: Tucker Taft Sent: Monday, January 26, 2004 7:45 PM Glad to hear there is a possible way of handling this. Your approach of putting one set of parameters in registers and the other in the stack is clever. We don't have the luxury of playing such games since we are generally trying to hook into backends that are not Ada-specific, and have relatively conventional parameter passing conventions. In our model, entry bodies and protected subprogram bodies expect their parameters to all be bundled into a single record, the so-called parameter block. This simplifies requeue, among other things. Your approach is probably more efficient in the typical case... **************************************************************** From: Randy Brukardt Sent: Monday, January 26, 2004 7:50 PM > Your approach of putting one set of parameters in > registers and the other in the stack is clever. > We don't have the luxury of playing such games since > we are generally trying to hook into backends that > are not Ada-specific, and have relatively conventional > parameter passing conventions. We've done that as well, of course. The logical model is that the two sets of parameters are separate. Sometimes you're forced into putting them together, which is a real pain to straighten out again... > In our model, entry bodies and protected subprogram > bodies expect their parameters to all be bundled > into a single record, the so-called parameter block. > This simplifies requeue, among other things. Your > approach is probably more efficient in the typical case... Requeue is a mess, but the primary problem is hidden generic parameters (for sharing), which might have to disappear or change or appear. "Disappear" is easy enough, but I've never come up with a way to do the other cases. You can't copy the parameters, because we use value-result passing for small scalar types. And you certainly can't write over memory that you don't own! (We simply refuse to compile problem requeues - not a lot of complaints to date on that.) (This is one the places where a number of reasonable appearing choices work together to make something impossible to implement. C'est la vie.) **************************************************************** From: Tucker Taft Sent: Sunday, January 25, 2004 1:29 PM Here is version 4 of Task/Protected Interfaces. It might better be called "implementing interfaces with task or protected types" now, since I have dropped the special syntax for task and protected interface types, and defined rules for implementing the primitives of limited interface types using entries and protected subprograms. Significantly fewer RM sections are affected because of this change, and I think it also provides better integration between tagged, task, and protected types. Comments, flames, etc., are encouraged. **************************************************************** From: Randy Brukardt Sent: Monday, January 26, 2004 7:45 PM > Here is version 3 of Task/Protected Interfaces. We seem to have two version 3s. (That's because we had two version 2s.) This one will be numbered version 4 when posted. > It might better be called "implementing interfaces with task > or protected types" now, since I have dropped the special > syntax for task and protected interface types, and defined > rules for implementing the primitives of limited > interface types using entries and protected subprograms. > > Significantly fewer RM sections are affected because of this change, > and I think it also provides better integration between > tagged, task, and protected types. > > Comments, flames, etc., are encouraged. Well, except for select statements (which is new, of course), it certainly seems simpler. And it provides the grand integration of real-time and OOP features that we've been striving for. And it doesn't look like much incremental work over that needed to implement any interfaces. Indeed, it provides the "glue" that helps justify Interfaces themselves and also the prefix call notation of AI-252. (You certainly want to be able to call class-wide entries in the prefix notation; given that these are "just" procedures, it would be weird not be able to call class-wide interface procedures the same way. And then it would be weird not to be able to call other class-wide procedures the same way. And then it would weird not to be able to call other class-wide subprograms the same way.) It also makes me look at interfaces more favorably, because they not only solve a rare problem (multiple interface inheritance) that I can't get too excited about, but also the integration of protected types into O-O (and bring along tasks as an added bonus), as well as giving us formal tasks and protected types more or less for free. These are all things that have been requested in the past. **************************************************************** From: Robert I. Eachus Sent: Monday, January 26, 2004 8:59 PM I like the new approach, but I haven't looked through it thoroughly yet. However.... >Requeue is a mess, but the primary problem is hidden generic parameters (for >sharing), which might have to disappear or change or appear. "Disappear" is >easy enough, but I've never come up with a way to do the other cases. You >can't copy the parameters, because we use value-result passing for small >scalar types. And you certainly can't write over memory that you don't own! >(We simply refuse to compile problem requeues - not a lot of complaints to >date on that.) > >(This is one the places were a number of reasonable appearing choices work >together to make something impossible to implement. C'est la vie.) My position is that this is a very reasonable 1.1.3(6) restriction. (And I assume that the rest of the ARG feels the same way.) Not that I think requeues are not important, just that this sort of extreme corner case is what that paragraph is there for. **************************************************************** From: Tucker Taft Sent: Monday, January 26, 2004 11:43 PM > ... > Requeue is a mess, but the primary problem is hidden generic parameters (for > sharing), which might have to disappear or change or appear. "Disappear" is > easy enough, but I've never come up with a way to do the other cases. You > can't copy the parameters, because we use value-result passing for small > scalar types. When using a parameter block, we simply include the address of a temp as a component of the parameter block to deal with by-copy [IN] OUT parameters. > ... And you certainly can't write over memory that you don't own! > (We simply refuse to compile problem requeues - not a lot of complaints to > date on that.) I presume most other vendors have solved this somehow. I don't think we should bless a restricted requeue (despite Robert Eachus' comment). > (This is one the places were a number of reasonable appearing choices work > together to make something impossible to implement. C'est la vie.) Yes, that happens... **************************************************************** From: Randy Brukardt Sent: Tuesday, January 27, 2004 12:26 AM Tucker said, replying to me: > When using a parameter block, we simply include the address of a temp > as a component of the parameter block to deal with by-copy [IN] OUT > parameters. "Simply"? Sure, you can selectively turn off value-result passing for all entry calls. That has always seemed too much like admitting defeat to me. (You can punt on 2nd down, too, but that doesn't make it a good idea...) > > ... And you certainly can't write over memory that you don't own! > > (We simply refuse to compile problem requeues - not a lot of complaints to > > date on that.) > > I presume most other vendors have solved this somehow. > I don't think we should bless a restricted requeue (despite > Robert Eachus' comment). They don't have shared generics. At least ones with protected and task types declared in them. (The problem only can occur when doing an external requeue to an object of a task or protected type declared in a generic unit from some object whose type is not in that unit. This isn't common.) But I certainly don't want to "bless" such a restriction. I just was commenting that I didn't think that the "parameter block" really made much difference in the difficulty of requeue either way. (The generic parameter problem would occur either way.) **************************************************************** From: Tucker Taft Sent: Tuesday, January 27, 2004 1:09 AM It helps a bit I think because the parameter block holds the "primary" parameters to the entry, while the auxiliary parameters such as the static link, generic instance descriptors, entry index, etc., could be passed separately. The "primary" parameters don't change upon requeue, whereas the auxiliary parameters typically do. ****************************************************************