Introduction to Ada 95 Compact summary of Ada Page Language structures 1 Executable statements 6 Reserved words 9 Types and subtypes 13 Exceptions defined 15 Named numbers 16 Library units 17 Types of types 19 Examples declaring types 21 Declaring objects 22 Tasking 24 Generics 28 SUMMARY OF Ada LANGUAGE STRUCTURES and other information 1 This summary was extracted from ANSI/ISO/IEC-8652:1995. It is not intended to be 100% complete. Hopefully it will be useful as a memory aid in writing Ada programs. Notation is kept as simple as possible. -- DECLARATIONS means Ada declaration(s) can be inserted \_ optional means this part or section is optional / ( all optional cases not necessarily shown) ... means more of the same allowed, use common sense occasionally a statement will be shown in a structure, this is just a reminder of something useful or required. COMPILATION UNITS: These are the structures that can be compiled in a single compilation. Keep in mind that Ada allows virtually unlimited nesting. Almost any structure can be nested in almost any other structure. Every compilation unit can be preceded by pragmas and context clauses. procedure NAME is -- structure of a main procedure (program) -- DECLARATIONS begin -- EXECUTABLE STATEMENTS return ; -- allowed, but not usually present exception \_ optional -- EXCEPTION HANDLERS / end NAME ; procedure NAME ( PARAMETER : in out TYPE ; ... ) is -- DECLARATIONS begin -- EXECUTABLE STATEMENTS return ; -- allowed exception \_ optional -- EXCEPTION HANDLERS / end NAME ; function NAME ( PARAMETER : TYPEx ; ...) return TYPEy is -- DECLARATIONS begin -- EXECUTABLE STATEMENTS return OBJECT ; -- of TYPEy required exception \_ optional -- EXCEPTION HANDLERS / end NAME ; 2 package NAME is -- DECLARATIONS private \_ optional -- MORE DECLARATIONS / end NAME ; package body NAME is -- DECLARATIONS _ begin \ -- EXECUTABLE STATEMENTS \_ optional exceptions / -- EXCEPTION HANDLERS _/ end NAME ; package MY_NAME is -- DECLARATIONS procedure PROC ; function FUNCT(PARAMETER:TYPEx;...) return TYPEy ; end MY_NAME ; package body MY_NAME is -- DECLARATIONS procedure PROC is -- PROCEDURE STUFF end PROC ; function FUNCT(PARAMETER:TYPEx;...) return TYPEy is -- FUNCTION STUFF end FUNCT ; end MY_NAME ; package P_NAME is task NAME is --DECLARATIONS entry LIKE_PROC(PARAMETER:TYPE;...) ; ... end NAME ; end P_NAME ; package body P_NAME is task body NAME is -- task body parallels package body -- DECLARATIONS begin -- EXECUTABLE STATEMENTS accept LIKE_PROC(PARAMETER:TYPE;...) do -- EXECUTABLE STATEMENTS end LIKE_PROC ; -- EXECUTABLE STATEMENTS ... exception \_ optional -- EXCEPTION HANDLERS / end NAME ; end P_NAME ; 3 package body P_NAME is -- A more complicated body task body NAME is -- DECLARATIONS begin loop select accept LIKE_PROC(PARAMETER:TYPE;...) do -- EXECUTABLE STATEMENTS end LIKE_PROC ; or accept ... end ... end select ; end loop ; end NAME ; end P_NAME ; separate ( SOME_PACKAGE ) procedure SOME_PROCEDURE is -- DECLARATIONS begin -- EXECUTABLE STATEMENTS exception \_ optional -- EXCEPTION HANDLERS / end SOME_PROCEDURE ; separate ( SOME_PACKAGE ) function SOME_FUNCTION return CHARACTER is -- DECLARATIONS begin -- EXECUTABLE STATEMENTS exception \_ optional -- EXCEPTION HANDLERS / end SOME_FUNCTION ; separate ( SOME_PACKAGE ) task body SOME_TASK is -- DECLARATIONS begin -- EXECUTABLE STATEMENTS exception \_ optional -- EXCEPTION HANDLERS / end SOME_TASK ; separate ( SOME_PACKAGE ) package body SOME_BODY is -- DECLARATIONS begin -- EXECUTABLE STATEMENTS exception \_ optional -- EXCEPTION HANDLERS / end SOME_BODY ; 4 separate( SOME_PACKAGE.SOME_BODY ) package body SUB_SUB_UNIT is -- DECLARATIONS begin -- EXECUTABLE STATEMENTS exception \_ optional -- EXCEPTION HANDLERS / end SOME_BODY ; generic -- FORMAL GENERIC PARAMETERS procedure GENERIC_PROCEDURE is -- DECLARATIONS begin -- EXECUTABLE STATEMENTS exception \_ optional -- EXCEPTION HANDLERS / end GENERIC_PROCEDURE ; generic -- FORMAL GENERIC PARAMETERS function GENERIC_FUNCTION is -- DECLARATIONS begin -- EXECUTABLE STATEMENTS exception \_ optional -- EXCEPTION HANDLERS / end GENERIC_FUNCTION ; generic -- FORMAL GENERIC PARAMETERS package GENERIC_PACKAGE is -- DECLARATIONS private \_ optional -- PRIVATE DECLARATIONS / end GENERIC_PACKAGE ; with GENERIC_PROCEDURE ; procedure ACTUAL_PROCEDURE is new GENERIC_PROCEDURE ( TYPES ) ; with GENERIC_FUNCTION ; function ACTUAL_FUNCTION is new GENERIC_FUNCTION ( TYPES ) ; with GENERIC_PACKAGE ; package ACTUAL_PACKAGE is new GENERIC_PACKAGE ( TYPES ) ; 5 procedure JUST_SPECIFICATION ; procedure SPECIFICATION ( Parameters... ) ; function SPECIFICATION ( Parameters ... ) return TYPEy ; CONTEXT CLAUSEs any number of the following. with LIBRARY_UNIT_NAME ; with NAME_1 , NAME_2, ... ; with NAME_1 ; use NAME_1 ; use NAME_1 , NAME_2, ... ; 6 EXECUTABLE STATEMENT STRUCTURES declare \_ optional -- DECLARATIONS / begin -- EXECUTABLE STATEMENTS return ; -- allowed exception \_ optional -- EXCEPTION HANDLERS / end ; LOOP_NAME : loop -- EXECUTABLE STATEMENTS exit ; \ exit when A>B ; \_ optional in any loop exit ANY_LOOP_NAME ; / exit ANY_LOOP_NAME when A>B ; / end loop ; while A>B loop -- EXECUTABLE STATEMENTS end loop ; for NAME in P..Q loop -- EXECUTABLE STATEMENTS end loop ; for NAME in reverse P..Q loop -- P <= Q -- EXECUTABLE STATEMENTS end loop ; 7 if BOOLEAN_EXPRESSION then -- EXECUTABLE STATEMENTS end if ; if BOOLEAN_EXPRESSION then -- EXECUTABLE STATEMENTS elsif BOOLEAN_EXPRESSION2 then \_ optional -- EXECUTABLE STATEMENTS / ... else \_ optional -- EXECUTABLE STATEMENTS / end if ; if BOOL_EXP1 and then BOOL_EXP2 ... then -- EXECUTABLE STATEMENTS elsif BOOL_EXP3 or else BOOL_EXP4 ... then -- EXECUTABLE STATEMENTS else -- EXECUTABLE STATEMENTS end if ; case NAME is -- NAME is an object of a discrete type when VALUE1 => -- VALUE's are legal for object NAME -- EXECUTABLE STATEMENTS when VALUE2 => -- EXECUTABLE STATEMENTS when VALUE3 | VALUE5 | VALUE7 => -- EXECUTABLE STATEMENTS when VALUE12 .. VALUE20 => -- EXECUTABLE STATEMENTS ... when others => \_ optional -- EXECUTABLE STATEMENTS / end case ; 8 Renaming declarations All of these must appear in a declarative region where the entity on the right side of the renames declaration is visible. The "existing" may be selected, e.g. SOME_PACKAGE.OBJECT_NAME_IN_PACKAGE Renaming is sometimes used to allow a short name in a localized scope. NEW_IDENTIFIER_NAME : SOME_TYPE_MARK renames EXISTING_OBJECT_NAME ; NEW_EXCEPTION_NAME : exception renames EXISTING_EXCEPTION_NAME ; package NEW_PACKAGE_NAME renames EXISTING_PACKAGE_NAME ; procedure NEW_PROCEDURE_NAME ( formal ) renames EXISTING_PROCEDURE_NAME ; procedure NEW_TASK_ENTRY_NAME ( formal ) renames EXISTING_TASK_ENTRY_NAME ; function NEW_FUNCTION_NAME ( formal ) return TYPEX renames EXISTING_FUNCTION_NAME ; function NEW_ENUMERATION_LITERAL return EXISTING_ENUMERATION_TYPE renames EXISTING_ENUMERATION_LITERAL ; subtype NEW_TYPE_NAME is EXISTING_TYPE_NAME ; -- renaming a type Note: The existing entity is still visible. Either or both the new and existing function names may be quoted operators, e.g. "+" The ( formal ) can have different names for formal parameters but must have the same number of parameters of the same type in the same order as the existing entity. Some restrictions apply. RESERVED WORDS 9 Reserved words as the name implies are reserved for the language. Reserved words must not be used as names of objects, types, procedures, or anything else. There are relatively few "reserved words" . But don't be complacent. The next pages cover a lot of types,objects and other names that are not technically reserved words but can create havoc if used in the wrong place! Some common pairs of reserved words are shown. Spaces are important in Ada. Word use or some uses ____ ________________ abort Statement in a task, abort means kill the task abs Function that returns absolute value abstract Declare a type or subprogram to be abstract, generic formal type abstract tagged limited private accept Statement in a task, the executable entry point access Used in defining access ( pointer ) types aliased Declare a variable of an aliased type all A selector. If XXX is an access variable then XXX.all is the object pointed to and Boolean binary operator and then Conditional "short circuit" array Used to define array types at Used as part of representation specification begin Always has pairing " end " body Used in " package body " and " task body " case Executable control structure and in defining records constant What follows can not be changed, trying causes error declare Can precede " begin " in executable structure, allows putting declarations in middle of executable code delay Statement in tasking, allows other tasks to run, then wakes up after delayed time has elapsed delta Part of type declaration for fixed point digits Part of type declaration for floating point 10 do Used in tasking " accept...do...end " The FORTRAN " DO " is " for " in Ada else Part of " if ... then ... else ... end if ; " else Part of selective wait in tasks else Part of conditional entry in tasks elsif Watch the SPELLING! one word in Ada, means else if end ; Ends a structure e.g. begin, procedure, package, end USER_NAME ; task etc. Optional user name is allowed, thus must always be followed by a semicolon end case ; Ends " case " control structure end loop ; Ends " loop " control structure end if ; Ends " if " control structure end record ; Ends definition of a record data structure end select ; Ends " select " control structure in tasks entry Task entry definition (not procedure or function entry) exception Statement in " begin ... exception ... end " specifies a place to put executable code for exception handlers exception Used to define user created exceptions exit Statement in a loop structure, 4 forms available for Statement introducing one type of loop for Used in type definitions function Statement defining a function generic Used in creating generic packages goto One word! Use it sparingly, only when needed. There are scope rules that apply if Conditional statement in Used in type definitions in As in input parameter to a procedure in Used with " for " in iteration such as " for I in 1..N loop ... end loop " in out As in both input and output parameter in a procedure is Used in type,procedure,function, and package definition is new Used to get new type or generic instantiation is access all Used as type Ptr is access all T; for aliased T's limited Used with " private " loop Executable structure, always closed by " end loop " 11 mod Binary modulo operator in expressions mod (at mod) Rare usage in representation specifications new (is new) Used in instantiation of generic packages new Used to get more storage with " access " types new (is new) Used to create new types not Boolean unary operator null ; The null statement, sometimes needed if no other code null Used in place of some values when needed but not known of Used as part of a type definition, such as " array(1..N) of INTEGER " or Boolean binary operator Statement in " select " tasking structure or else Conditional expression " short circuit " others Used where some cases are specified and all else is lumped under others. Many forms out As in output parameter of a procedure package A container for declarations and code package body A container that is used with a corresponding package specification pragma A directive to the compiler private Statement between visible and private declarations procedure First word of a procedure definition protected Used on objects, subprograms, entries, types, bodies declarations and units. raise Statement to cause an exception to be raised range Part of a type specification record Start of a record data structure definition rem Binary arithmetic operator, remainder after division This is precisely defined in Ada renames Used to help get around name hiding and to avoid using selectors dot notation requeue Used to requeue an entry return Can be used in a procedure, not usually needed 12 return VALUE ; Must be used in a function for the returned value reverse Used with " for " to get the loop to run backward select Statement in a task to control entry separate Used for partial compilation, only needed in rare cases. Separate compilation is normal with Ada and usually does not need the reserved word " separate " subtype Used in place of " type " when just constraining a type tagged Created a record that is expandable, a tagged type task Introduces a task definition task type Introduces a task type definition terminate Used on students that don't complete homework on time and rarely needed in tasks then Used in " if ... then ... else ..." structure type Used to declare a user defined type until Wait for a definition until ... use Usually follows a " with " Used in representation specification when Statement in case and exception handlers Usually of the form " when XXX => " when others => Means else, e.g. all others while Used to introduce a loop, user does initialization and computing values that control the condition with Makes a previously compiled package specification available in this compilation Usually " with XXX ; use XXX ; " xor Boolean binary operator, exclusive or TYPES AND SUBTYPES DEFINED IN ISO 8652:1995 13 The types defined in the package standard are always available ( unless the user hides them by defining the same name ). Other types are listed under the package that must be " withed " to make the types available. The exact definition of some types is implementation defined. This means the user may want to do some experiments when using a new Ada compiler. type comment ____ _______ BOOLEAN objects of this type take values TRUE or FALSE CHARACTER objects of this type are exactly one character. e.g. 'A' DURATION this is a fixed point type used with the " delay " statement in tasking and in the package CALENDAR FLOAT objects of this type are represented by hardware floating point numbers INTEGER objects of this type are represented by hardware integers the number of bits can vary. In some 16 bits while in other compilers 32 or 64 bits. NATURAL integer in range 0..INTEGER'LAST POSITIVE integer in range 1..INTEGER'LAST STRING objects of this type must be constrained by (1..N) where N is a positive value. Watch out for null filling, not blank filled. "this is a string literal" strings are technically arrays of characters optional types, may or may not be present SHORT_SHORT_INTEGER -- in some compilers SHORT_INTEGER LONG_INTEGER -- in some compilers SHORT_FLOAT -- in some compilers, 32 bit LONG_FLOAT -- in most compilers, 64 bit LONG_LONG_FLOAT -- in some compilers, 128 bit from the package TEXT_IO type comment ____ _______ COUNT e.g. page length, line length FIELD e.g. width FILE_MODE enumeration literal IN_FILE or OUT_FILE FILE_TYPE e.g. type of file NUMBER_BASE e.g. 2, 10, 16 POSITIVE_COUNT e.g. spacing amount TYPE_SET enumeration literal LOWER_CASE or UPPER_CASE from the package SYSTEM 14 type comment ____ _______ ADDRESS the type definition for address. not necessarily INTEGER NAME enumeration type for target names PRIORITY subtype of INTEGER for task priorities from the package CALENDAR type comment ____ _______ DAY_DURATION fixed point seconds in a day 0.0 .. 86_400.0 DAY_NUMBER days in month 1 .. 31 MONTH_NUMBER months in year 1 .. 12 TIME a private type ( usually a record ) holds date and time YEAR_NUMBER year 1901 .. 2099 from the package UNCHECKED_DEALLOCATION type comment ____ _______ OBJECT generic format parameter NAME is access OBJECT pointer to what is deallocated from the package UNCHECKED_CONVERSION type comment ____ _______ SOURCE generic formal parameter TARGET generic formal parameter note: source object is usually required to be the same length as the target object. This is implementation dependent. This can be used to put a integer into a floating point object or other similar atrocities. SOME EXCEPTIONS DEFINED IN ISO 8652:1995 15 The user may provide exception handlers for these exceptions but should not declare local exceptions by these names. If the user does not provide the exception handler, the Ada run time that " calls " the main procedure will handle the exception. Usually with some message. Only one or a few causes of each exception are listed. CONSTRAINT_ERROR e.g. subscript out of range PROGRAM_ERROR e.g. something illegal at run time STORAGE_ERROR e.g. out of memory for this program TASKING_ERROR e.g. calling a task that has terminated An exception handler is of the form: begin ... exception when NUMERIC_ERROR => ... some executable code end ; from the package TEXT_IO DATA_ERROR e.g. illegal data read by GET DEVICE_ERROR e.g. input or output can not be completed END_ERROR e.g. hit end of file LAYOUT_ERROR e.g. bad line or page format. Too much of something MODE_ERROR e.g. trying to write IN_FILE or read OUT_FILE NAME_ERROR e.g. illegal file name STATUS_ERROR e.g. trying to use unopened file USE_ERROR e.g. improper use of a file from package CALENDAR TIME_ERROR e.g. not a legal date and/or time SOME NAMED NUMBERS DEFINED IN ISO 8652:1995 16 Named numbers can be used any place a number of the corresponding type can be used. Named numbers are defined by the format " XXX : constant := ... ; " from the package SYSTEM FINE_DELTA -- smallest delta in fixed point range -1.0 .. 1.0 MAX_DIGITS -- largest number of digits in floating point constraint MAX_INT -- largest positive value of all integer types MAX_MANTISSA -- largest number of bits in fixed point model number MEMORY_SIZE -- number of storage units available somewhere MIN_INT -- most negative of all integer types STORAGE_UNIT -- number of bits in a storage unit SYSTEM_NAME -- the default target name TICK -- the basic clock period in seconds from the package TEXT_IO UNBOUNDED SOME PRAGMAS DEFINED IN ISO 8652:1995 ( see annexes for definitions) CONTROLLED ELABORATE INLINE INTERFACE LIST MEMORY_SIZE OPTIMIZE PACK PAGE e.g. pragma PAGE ; PRIORITY e.g. pragma PRIORITY(5) ; SHARED STORAGE_UNIT SUPPRESS LIBRARY UNITS DEFINED IN ISO 8652:1995 17 Ada 95 Library Packages Library Name and some renamed for compatibility with '83 Ada Ada.Asynchronous_Task_Control Ada.Calendar Calendar Ada.Characters Ada.Characters.Handling Ada.Characters.Latin_1 Ada.Command_Line Ada.Decimal Ada.Direct_IO Direct_IO Ada.Dynamic_Priorities Ada.Exceptions Ada.Finalization Ada.Interrupts Ada.Interrupts.Names Ada.IO_Exceptions IO_Exceptions Ada.Numerics Ada.Numerics.Complex_Elementary_Functions Ada.Numerics.Complex_Types Ada.Numerics.Discrete_Randon Ada.Numerics.Elementary_Functions Ada.Numerics.Float_Random Ada.Numerics.Generic_Complex_Elementary_Functions Ada.Numerics.Generic_Complex_Types Ada.Numerics.Generic_Elementary_Functions Ada.Numerics.Random_Numbers Ada.Real_Time Ada.Sequential_IO Sequential_IO Ada.Storage_IO Ada.Streams Ada.Streams.Stream_IO Ada.Strings Ada.Strings.Bounded Ada.Strings.Fixed Ada.Strings.Maps Ada.Strings.Maps.Constants Ada.Strings.Unbounded Ada.Strings.Wide_Bounded Ada.Strings.Wide_Fixed Ada.Strings.Wide_Maps Ada.Strings.Wide_Maps.Wide_Constants Ada.Strings.Wide_Unbounded Ada.Synchronous_Task_Control Ada.Tags Ada.Task_Attributes Ada.Task_Identification Ada.Text_IO Text_IO 18 Integer_IO Modular_IO Float_IO Fixed_IO Decimal_IO Enumeration_IO Ada.Text_IO.Complex_IO Ada.Text_IO.Editing Ada.Text_IO.Text_Strings Ada.Unchecked_Conversion Unchecked_Conversion Ada.Unchecked_Deallocation Unchecked_Deallocation Ada.Wide_Text_IO Integer_IO Modular_IO Float_IO Fixed_IO Decimal_IO Enumeration_IO Ada.Wide_Text_IO.Complex_IO Ada.Wide_Text_IO.Editing Ada.Wide_Text_IO.Text_Strings Interfaces Interfaces.C Interfaces.C.Pointers Interfaces.C.Strings Interfaces.COBOL Interfaces.Fortran System System.Address_To_Access_Conversion System.Machine_Code Machine_code System.RPC System.Storage_Elements System.Storage_Pools Note: most packages contain procedures and functions as well as type and object definitions. TYPES OF TYPES 19 It is possible that the following chart will help clarify the terminology related to Ada types. This is a chart showing classes of types. |-- private [limited] [aliased] | type ---| |-- composite --|-- record --|-- tagged ----|-- Users | | | | | |-- untagged --|-- Users | | | |-- array ---|-- constrained ----|-- Users | | | | | |-- unconstrained --|-- String | | |-- Users | | | |-- task | |-- tagged | |-- protected | | |-- scalar --|-- real --|-- floating --|-- Float | | | |-- Users | | | | | |-- fixed -----|-- Duration | | |-- Users binary | | |-- Users decimal | | | | | | |-- modular --|-- Users | |-- discrete --|-- integer --| | | | | | |-- signed --|-- Integer | | |-- Positive | | |-- Natural | | |-- Users | | | |- enumeration -|-- Character | |-- Boolean | |-- Users | |-- access --|-- access-to-object |-- access-to-subprogram The classes "real" and "integer" together form the class numeric types. There is a long list of attributes defined in ISO 8652:1995 in Annex K 20 Types of executable statements |-- null |-- assignment |-- procedure call |-- sequential --|-- entry call | |-- code | |-- delay | |-- abort | |-- requeue | |-- simple ----| | | | | |-- exit | |-- control -----|-- goto | |-- raise | |-- return | statement --| | | |-- if | |-- case | |-- sequential --|-- loop | | |-- block |-- compound --| | |-- accept |-- parallel ----|-- entry |-- select EXAMPLES DECLARING VARIOUS TYPES OF TYPES : 21 ( Remember : types do not take up space in storage types just define structures ) type of type task type MINE ; -- task type FOR_ME_ONLY is private ; -- private type FOR_YOU_ONLY is limited private ; -- limited type NODE ; -- define structure later type LINK is access NODE ; -- LINK is an access type to NODE -- access -- Composite type NODE is -- record record X : INTEGER ; Y : FLOAT ; Z : STRING(1..10) ; L : LINK ; end record ; type MY_ARRAY is array(0..5) of integer ; -- array type COMPLEX_MATRIX is array( INTEGER range <> , INTEGER range <> ) of complex ; -- Scalar -- Real type HIS_FLOAT is new FLOAT ; -- floating type HER_FLOAT is digits 6 range -3.0..1.1E30 ; -- floating type OUR_FLOAT is digits 5 ; -- floating type MY_FIXED is delta 0.001 range -0.5 .. 0.5 ; -- fixed -- Discrete type HIS_INTEGER is new INTEGER ; -- integer type HER_INTEGER is range -7 .. 35 ; -- integer type STATUS is ( ON , OFF , STAND_BY , READY ) ; -- enumeration DECLARING OBJECTS OF THE TYPES GIVEN ABOVE : 22 ( Remember: objects take up storage and can have values the object name is first, followed by a colon, followed by the type name ) MY_FIRST : MINE ; -- a task object MY_SECOND : MINE ; -- another task object SOMETHING : FOR_ME_ONLY ; -- don't know structure SOMETHING_ELSE : FOR_YOU_ONLY ; -- know even less START : LINK ; BOX_1 : NODE ; BOX_2 : NODE ; A : MY_ARRAY ; C : COMPLEX_MATRIX(0..4,-2..21) ; TARGET_X : HIS_FLOAT ; TARGET_Y : HER_FLOAT ; TARGET_Z : OUR_FLOAT ; TARGET_RANGE : MY_FIXED ; MY_RANGE : MY_FIXED ; SCRATCH : HIS_INTEGER ; TEMPORARY : HER_INTEGER ; RECEIVE : STATUS ; TRANSMIT : STATUS ; 23 Records with discriminants and variant parts type MY_RECORD ( DISCRIM_1 : INTEGER := 3 ; DISCRIM_2 : BOOLEAN := FALSE ) is record STUFF : INTEGER := DISCRIM_1 ; WHICH : BOOLEAN := DISCRIM_2 ; OTHER : FLOAT := 7.5 ; end record ; A_RECORD : MY_RECORD ( 7, TRUE ) ; B_RECORD : MY_RECORD ; type SHAPE is ( CIRCLE , TRIANGLE ) ; type FIGURE ( WHICH : SHAPE ) is record case WHICH is when CIRCLE => RADIUS : POSITIVE ; when TRIANGLE => SIDE_1 : POSITIVE ; SIDE_2 : POSITIVE ; SIDE_3 : POSITIVE ; when others => end case ; end record ; ROUND : FIGURE ( CIRCLE ) := ( CIRCLE, 7 ) ; POINTED : FIGURE ( TRIANGLE ) := ( TRIANGLE , 4, 5, 7 ) ; LONG : FIGURE ( WHICH => CIRCLE ) := ( WHICH => CIRCLE , RADIUS => 9 ) ; STRUCTURES RELATED TO TASKING. 24 Control of tasks can be very complicated. The language provides several structures for various cases. The skeletons below may be used inside the task body after the task begin. For simplicity the "entry" and "accept" are shown without the optional parameters. package XXX is task YYY is -- or task type YYY is entry ZZZ ... ; end YYY ; end XXX ; package body XXX is task body YYY is -- optional declarations begin *** STRUCTURES BELOW GO HERE *** end YYY ; end XXX ; The user of a task then writes: with XXX; ... XXX.YYY.ZZZ ...; -- the user waits here til ZZZ rendezvous 1. A simple accept, one shot only then task terminates accept ZZZ do accept ZZZ ; -- statements -- statements end ZZZ ; -- statements 2. A simple accept, can be used many times, exists until sponsor dies loop loop accept ZZZ do accept ZZZ ; -- statements -- statements end ZZZ ; -- statements end loop ; end loop ; 3. A pair of entries that must go 1,2,1,2,1,2... loop accept ZZ1 do -- statements end ZZ1 ; -- statements accept ZZ2 do -- statements end ZZ2 ; -- statements end loop ; 4. A pair of entries that can be used in any order, may live forever 25 loop select accept ZZ1 do -- statements end ZZ1 ; -- statements or accept ZZ2 do -- statements end ZZ2 ; -- statements end select ; end loop ; 5. A pair of entries that can be used in any order, the task XXX terminates when there is no possible callers for ZZ1 or ZZ2. loop select accept ZZ1 do -- statements end ZZ1 ; -- statements or accept ZZ2 do -- statements end ZZ2 ; -- statements or terminate ; end select ; end loop ; 6. A pair of entries that can be used in any order, each time through the loop, if neither ZZ1 nor ZZ2 has a caller waiting the statements in the "else" part are executed. Watch out! You have no control over the loop timing or the context switching algorithm. loop select accept ZZ1 do -- statements end ZZ1 ; -- statements or accept ZZ2 do -- statements end ZZ2 ; -- statements else -- statements end select ; end loop ; 7. A pair of entries that can be used in any order, If there are 26 no callers for ZZ1 or ZZ2 control goes to some other task. After a delay of at least T seconds, this task comes around the loop again. loop select accept ZZ1 do -- statements end ZZ1 ; -- statements or accept ZZ2 do -- statements end ZZ2 ; -- statements or delay T ; end select ; end loop ; 8. Guards may be used inside the "select" structure on the "accept", "terminate" and "delay", but not on the "else". Just one of the cases from 5,6 or 7 may be used in any given structure. Guards are of the form : when BOOLEAN_EXPRESSION => If the BOOLEAN_EXPRESSION is true the normal action is taken. If false it is as though the structure following the guard did not exists. The three cases below use the "no rendezvous" form of the "accept" just for brevity. 8a select when BOOL1 => accept ZZ1 ; -- statements or when BOOL2 => accept ZZ2 ; -- statements or when BOOL3 => terminate ; end select ; 8b select when BOOL1 => accept ZZ1 ; -- statements or when BOOL2 => accept ZZ2 ; -- statements or when BOOL3 => delay T ; end select ; 8c no guard is allowed after "else" in select 9. The following constructs can be used anywhere, not just in task bodies 27 delay number_of_seconds; delay until value_of_type_time; 9.7.2 Timed Entry Call select some_task.some_entry; -- canceled if no rendezvous in 2.5 seconds or delay 2.5; end select; 9.7.3 Conditional Entry call select some_task.some_entry; -- if no immediate rendezvous, do else part else -- EXECUTABLE STATEMENTS end select; 9.7.4 Asynchronous Transfer of Control select some_task.some_entry; -- only run if lower part does not finish -- EXECUTABLE STATEMENTS -- before rendezvous then abort -- EXECUTABLE STATEMENTS will run till rendezvous of above end select; select delay 7.2; -- EXECUTABLE STATEMENTS -- only run if lower part takes 7.2+ seconds then abort -- EXECUTABLE STATEMENTS -- killed after 7.2 seconds end select; 10. To have a procedure PERIODIC called approximately every 1 second and desiring no overall slippage over long time intervals, the following task can be set up. Just for variety, the task is defined in a procedure rather than in a package. with Ada.Calendar ; use Ada.Calendar ; procedure TEST is task GO_PERIOD ; -- task specification task body GO_PERIOD is INTERVAL : constant DURATION := 1.0 ; -- seconds NEXT_TIME : TIME ; begin NEXT_TIME := CLOCK ; -- now loop delay until NEXT_TIME; -- do this about once per second NEXT_TIME := NEXT_TIME + INTERVAL ; end loop ; end GO_PERIOD ; begin -- task started just before "do something" -- do something end TEST ; This is "GENERIC" summary information extracted from ISO 8652:1995 28 Generic packages, procedures and functions definition instantiation 1. GENERIC LIBRARY UNITS The three structures for a generic library unit are: generic -- *** generic formal part goes here (see below) package NAME is -- typical package specification -- DO NOT duplicate declarations given above in generic formal part end NAME ; package body NAME is -- typical package body begin \__ optional -- package initialization code / exception \__ optional -- exception handlers / end NAME ; -- NAME will be the library unit name "withed" and instantiated generic -- *** generic formal part goes here (see below) procedure NAME(...) ; procedure NAME(...) is -- typical procedure declarations -- DO NOT duplicate declarations given above in generic formal part begin -- typical procedure code exception \__ optional -- exception handlers / end NAME ; -- <-- NAME will be the procedure name "withed" and instantiated generic -- *** generic formal part goes here (see below) function NAME(...) return TYPEX ; function NAME(...) return TYPEX is -- typical function declarations -- DO NOT duplicate declarations given above in generic formal part begin -- typical function code exception \__ optional -- exception handlers / end NAME ; -- <-- NAME will be the function name "withed" and instantiated 2. GENERIC FORMAL PART 29 Listed below are the statements that can occur in the generic formal part. Note: Upon generic instantiation the things denoted FORMAL can be supplied as 1) positional actual generic parameters 2) named actual generic parameters, or 3) not supplied because a default is provided. The same rules apply for parameters in generic instantiation as for procedure calls. The positional order of generic parameters is determined by the sequential order in which the things denoted FORMAL ( a type ) or FORMAL_OBJECT ( an object ) or FORMAL_SUBPROGRAM ( a procedure or function ) occur in the generic formal part. *** generic formal part statements: -- one form of formal generic object parameter FORMAL_OBJECT : SOME_TYPE := default_value ; -- default is optional Note: "SOME_TYPE" can be a language predefined type or a previously defined formal type ( e.g. some FORMAL ) SOME_TYPE may be preceded by "in", "out", or "in out" -- twenty forms of formal generic type parameters type FORMAL is private ; -- class of all nonlimited types type FORMAL is limited private ; -- class of all types type FORMAL is tagged private ; -- class of all nonlimited tagged types type FORMAL is tagged limited private ;-- class of all tagged types type FORMAL is abstract tagged private;-- class of what is says type FORMAL is abstract tagged limited private ; -- class of what it says type FORMAL(...) is private ; -- record type,discriminant provided type FORMAL is (<>) ; -- a discrete type,integer and enum type FORMAL is range <> ; -- an integer type type FORMAL is digits <> ; -- a floating type type FORMAL is mod <> ; -- a modular type type FORMAL is delta <> ; -- a fixed point type type FORMAL is delta <> digits <>; -- a decimal fixed point type type FORMAL is access SOME_TYPE ; -- an access type type FORMAL is access all SOME_TYPE ; -- for aliased access types type FORMAL is access constant SOME ; -- for access to a constant type type FORMAL is new SOME_TYPE ; -- a derived type type FORMAL is new SOME with private ; -- a derived tagged type type FORMAL is access procedure ; -- a procedure type FORMAL is access function return SOME ; -- a function -- two forms of formal generic array type parameters type FORMAL is array (SOME_TYPE range <> ) of SOME_TYPE_2 ; -- unconstrained type FORMAL is array (SOME_DISCRETE_TYPE) of SOME_TYPE_2 ; -- constrained -- three forms of formal generic procedure parameters 30 with procedure FORMAL_PROCEDURE(JUNK_NAME : SOME_TYPE ; ...) ; -- no default with procedure FORMAL_PROCEDURE(JUNK_NAME : SOME_TYPE ; ...) is DEFAULT_NAME ; with procedure FORMAL_PROCEDURE(JUNK_NAME : SOME_TYPE ; ...) is <> ; -- its own name is the default -- three forms of formal generic function parameters with function FORMAL_FUNCTION(JUNK_NAME : SOME_TYPE ; ...) return SOME_TYPE_2 ; -- no default with function FORMAL_FUNCTION(JUNK_NAME : SOME_TYPE ; ...) return SOME_TYPE_2 is DEFAULT_NAME ; with function FORMAL_FUNCTION(JUNK_NAME : SOME_TYPE ;...) return SOME_TYPE_2 is <> ; -- its own name is the default -- Note: FORMAL_SUBPROGRAM is written "+" or ">" for operators -- two forms of formal generic packages with package FORMAL_PACKAGE is new SOME_GENERIC_PACKAGE(ACTUAL_ARGUMENTS); with package FORMAL_PACKAGE is new SOME_GENERIC_PACKAGE(<>); Once instantiated, the above forms with the "FORMAL" and "SOME_TYPE" things replaced by the actual generic parameters are put into the package specification or procedure declarative section or the function declarative section depending on the kind of generic unit. 3. GENERIC INSTANTIATION Remember that the generic library unit must be "withed" but can not have a "use". A generic instantiation can occur any where a declaration can occur. The three forms of generic instantiation are: package YOUR_NAME is new GENERIC_PACKAGE_NAME( ACTUAL_GENERIC_PARAMETERS) ; -- may be followed by " use YOUR_NAME ; " procedure YOUR_NAME is new GENERIC_PROCEDURE_NAME ( ACTUAL_GENERIC_PARAMETERS ) ; -- do not confuse the procedure parameters with the generic parameters ! function YOUR_NAME is new GENERIC_FUNCTION_NAME ( ACTUAL_GENERIC_PARAMETERS ) ; 4. REFERENCES ISO 8652:1995 chapter 12 Barnes chapter 17