--:::::::::: --diners.adb --:::::::::: --- Supercommented edition, extra comments by Robert Dewar have three --- minus signs at the start. with Text_IO; --- This is an obsolete statement which could be removed, this particular --- package does not use Text_IO. with Room; --- Include this library package for two separate reasons. First we will --- be calling the Start_Serving entry below, but a little more subtly, --- this is a library package that declares a task -- not just a task --- type, but an actual task (the Maitre_D task that conrols the entire --- process). When a library package declares a task like this it will --- start up during elaboration, which means it starts up BEFORE the --- begin of the main program. procedure Diners is -- Dining Philosophers - Ada 95 edition -- This is the main program, responsible only for telling the -- Maitre_D to get busy. -- Michael B. Feldman, The George Washington University, -- July, 1995. begin --- Remember, by the begin, we have already started the Maitre_D task --- as noted above, if it is not already prepared to accept a call to --- the entry Start_Serving it soon will be. --Text_IO.New_Line; -- artifice to flush output buffer --- Commented out, and thus irrelevant to the program, probably some --- earlier version needed this, and the code got left around. This is --- a common occurrence in maintenance programming, but can often lead --- to unnecessary confusion. Room.Maitre_D.Start_Serving; --- OK, this is the real job of the main program. The actual work is done --- by the Maitre_D task. The Maitre_D task may or may not be ready to --- accept this call immediately. Remember we have two tasks running so --- far, the environment task, corresponding to the main program, and --- the Maitre_D task. Since there are no priorities, these two tasks --- are at the same priority, and depending on the dispatching scheme --- used by the compiler, and whether there are multiple processors, we --- may get here before Maitre_D does the accept, or the contrary may --- occur, but it doesn't matter, the one to arrive first waits for the --- one to arrive second, and the only purpose of this rendezvous is to --- let the Maitre_D proceed with its job. --- Another way to have programmed this would simply be to use a main --- program of begin-null-end, which looks like it does nothing, and --- write the Maitre_D task to start off autonomously (remove the accept --- call at the start). However, usually you want to syncrhonize things --- in a controlled manner, starting tasks at the appropriate point, and --- this call to Start_Serving shows how this is typically done. --- After the Start_Serving call, control immediately returns to the --- environment task and the two tasks carry on. The environment task --- has nothing more to do, and simply terminates, but a critical rule --- is that you have to wait to terminate till any tasks you started --- terminate. In the case of the environment task, this includes any --- tasks started up by library tasks, (e.g. Maitre_D in this case), so --- we will now wait for Maitre_D to finish. end Diners; --:::::::::: --society.ads --:::::::::: --- This package provides the unique identifiers (names) to be used by the --- philosophers. It also defines the number of philosophers. package Society is -- Dining Philosophers - Ada 95 edition -- Society gives unique ID's to people, and registers their names -- Michael B. Feldman, The George Washington University, -- July, 1995. subtype Unique_DNA_Codes is Positive range 1..5; --- Defines the number of philosophers. However, this is not as encapsulated --- as one would want to see, there is explicit code in the Room package --- that knows that there are five philosophers. This could most certainly --- be fixed with a little more abstraction in Room. Name_Register : array(Unique_DNA_Codes) of String(1..18) := --- And here are the names, note that these are ordinary strings, so there --- is no capability of variable length values. Consequently it is required --- to fill out to exactly 18 characters. A more Ada_95'ish solution would --- have been to use Ada.Strings.Unbounded.Unbounded_String here. ("Edsger Dijkstra ", "Bjarne Stroustrup ", "Chris Anderson ", "Tucker Taft ", "Jean Ichbiah "); end Society; --:::::::::: --room.ads --:::::::::: --- Room is the top level package that defines the Maitre_D task. This is --- the task that controls the entire process. It is a library level task, --- which means it starts up as soon as the library code is elaborated. with Chop; --- We need this to get the type Chop.Stick, and create the array of chop --- sticks that will be used by the philosophers. with Phil; --- We need this to create the philosopher tasks and start them off with Society; --- We need this to get the names of the philosophers package Room is -- Dining Philosophers - Ada 95 edition -- Room.Maitre_D is responsible for assigning seats at the -- table, "left" and "right" chopsticks, and for reporting -- interesting events to the outside world. -- Michael B. Feldman, The George Washington University, -- July, 1995. Table_Size : constant := 5; --- This seems a mistake, it is the number of philsophers at the --- table, but the use of the constant 5 here seems unfortunate, --- it would have been better to use Society.UNique_DNA_Codes'Last. --- This way you have to change only one thing in the program to --- change the number of philsophers. subtype Table_Type is Positive range 1 .. Table_Size; --- This declaration violates the rule about not using built in integer --- types, and it would be much cleaner if it were a separate type. Sticks : array (Table_Type) of Chop.Stick; --- This actually creates the appropriate number of protected chop --- stick objects, each with its own lock. We do this at the library --- level because we later reference chopsticks by number and the --- philosopher refereces the actual chopsticks by referencing this --- global array. --- --- That's OK, but a perhaps better organization would have been to --- declare the array of sticks in the body of Maitre_D, and then pass --- the actual chopsticks to the philosopher tasks, instead of passing --- chopstick numbers. It's always better to avoid global variables if --- it can be done without kludging things up. task Maitre_D is --- Here is the task definition, note that we do NOT use the word TYPE' --- in this definition, meaning that we are declaring a new task type, --- and declaring (and creating and starting) a single task of this type, --- all in a single operation. entry Start_Serving; --- The Maitre_D task will do an immediate hang on this entry point, --- waiting to be started up, at which time it will create the entry Report_State (Which_Phil : in Society.Unique_DNA_Codes; State : in Phil.States; How_Long : in Natural := 0; Which_Meal : in Natural := 0); --- An uncommented entry point which we are expected to understand --- solely from the names used, always a bit dubious. First the --- global understanding: --- --- The reason we define this Report_State procedure is for philosophers --- to report what they are doing, so the program has interesting output --- indicating the progress of the simulation. The reason it is an entry --- rather than a procedure, is that multiple philosophers may want to --- write information at the same time. Since our output routines in --- Windows and Screen are not thread safe, we can't call them directly. --- Instead Maitre_D allows one task at a time to write information, thus --- avoiding race conditions. If two tasks try to do output "at the same --- time" then one will have to wait for a moment while the other task --- completes its output operation. --- --- The low level documentation is that Which_Phil identifies the --- philsopher doing the output, State gives the state the philosopher --- is in, using the enumeration type defined in the Phil package. --- How_Long gives the length of time for the operation if appropriate --- (and defaults to zero, to be ignored, if not needed). Finally --- Which_Meal gives the meal number if appropriate. --- --- Really the documentation should be more complete, specifying for --- each state whether How_Long and Which_Meal are relevant, so let's --- do that using a chart --- How_Long Which_Meal --- Breathing not used not used --- Thinking think time not used --- Eating eating time meal number --- Done_Eating not used not used --- Got_One_Stick number of stick not used --- Got_Other_Stick number of stick not used --- Dying not used not used --- This may seem overkill, but it is really quite necessary. The client --- cannot be asked to look at the body to figure out what is going on. --- Furthermore, when we make the effort of documenting at this level, --- we find a nasty glitch, namely that How_Long is used to hold a stick --- number, which is really a type error. In fact we are depending here --- on the (mis)use of Standard.Integer to represent times for eating, --- times for thinking, and stick numbers. These should be three separate --- types. --- --- That would mean having separate strongly typed entries for each --- kind of reporting. This would be a FAR preferable interface, because --- then the equivalent of the above table would be clearly specified --- in the Ada code itself, and the compiler would make sure that each --- call was type correct. --- --- With the current interface, a caller could accidentally forget to --- pass the meal number to Eating (and it would be taken to be zero), --- or pass the meal number instead of a chop stick number when doing --- a Got_One_Stick call, which would just result in incorrect output --- at run time (as opposed to a compile time error if we adopted the --- preferable strongly typed approach). end Maitre_D; end Room; --:::::::::: --chop.ads --:::::::::: --- This unit contains a very simple protected type that implements a --- chopstick abstraction. A chopstick can be picked up by one person, --- and until it is put down, anyone else trying to pick up the same --- chopstick will have to wait. We put the protected type definition --- inside a package, because a protected type cannot serve as a --- library unit. Only the type is defined. To actually use the services --- of this package, one or more objects of type Stick must be defined. package Chop is -- Dining Philosophers - Ada 95 edition -- Chopstick is an Ada 95 protected type -- Michael B. Feldman, The George Washington University, -- July, 1995. protected type Stick is --- The name of the type will thus be Chop.Stick, a nice example of a --- name chosen to work well with full package qualification. entry Pick_Up; --- You pick up a chop stick before you can use it. If someone already --- has picked it up, you wait till they put it down. That is why this --- is an entry (you may have to wait). procedure Put_Down; --- You put down a chop stick when you are finished with it. It is only --- valid to put down a chop stick if you previously successfully --- picked it up. Since obviously there is no impediment to putting it --- down, this is a procedure, which means you won't ever have to wait --- here. However, in accordance with protected type semantics, there --- is a lock, so that you are ensured no race conditions with someone --- else accessing the same stick. private In_Use: Boolean := False; --- The private data, as usual, is none of the business of the client. --- It is for use only in the body. One of these Boolean's will be --- allocated for each stick that is declared. The purpose of the --- Boolean, as implied by its name is simply to indicate whether --- the corresponding stick has been picked up. Initially the stick --- is on the table! end Stick; --- This ends the protected type declaration end Chop; --- And this ends the package declaration (or informally package spec) --:::::::::: --random_generic.ads --:::::::::: --- A simple generic random number package. Really in Ada 95, we could simply --- use Ada.Numerics.Discrete_Random directly, but this program was originally --- written in Ada 83, and had to provide its own random number package since --- there was no standard random generator in Ada 83. --- When the program was converted for Ada 95, the easiest thing was to keep --- this spec intact, so that clients did not need to be modified, and simply --- change the body to use the new Ada 95 package. This is a nice example of --- how separation of spec and implementation allows you to make changes in --- the implementation (in this case completely replacing it) without clients --- being affected. generic type Result_Subtype is (<>); --- This form of generic type can be instantiated with any discrete type, --- i.e. any integer or enumeration type. package Random_Generic is -- Simple integer pseudo-random number generator package. -- Michael B. Feldman, The George Washington University, -- June 1995. function Random_Value return Result_Subtype; --- A call to Random_Value will return a pseudo-random value of type --- Result_Subtype. Note that this function is NOT thread safe, multiple --- tasks cannot call Random_Value from the same instantiation without --- synchronization. In Ada it is a good idea to always document what --- subprograms are thread safe and what are not. In this case, our --- separate philosopher tasks will instantiate separate copies of this --- generic, so all is well, we never have two tasks trying to use the --- same instantiation at the same time. end Random_Generic; --:::::::::: --phil.ads --:::::::::: --- The package phil introduces a single task type Philosopher. One such --- task will be started for each philosopher. The startup is done in --- the body of the Room package. with Society; --- To get the names of the philsophers, since we need the type for the --- discriminant. package Phil is -- Dining Philosophers - Ada 95 edition -- Philosopher is an Ada 95 task type with discriminant -- Michael B. Feldman, The George Washington University, -- July, 1995. task type Philosopher (My_ID : Society.Unique_DNA_Codes) is --- This introduces a new task type with a discriminant My_ID. The --- discriminant value is a value that is provided when the task is --- created, and which is available throughout the task execution. --- Typically it is a kind of startup parameter for the task, and --- as in this case, is often used to give a unique identity to a --- given task in a collection of tasks all of the same type. --- In Ada 83 task discriminants were not provided. The Ada 83 version --- of this program provided an initial entry used for identification. --- The task starts off anonymous, and immediately does a call of the --- form: --- accept Get_Name (My_ID : Society.Unique_DNA_Codes) do --- Who_Am_I := My_ID; --- end; --- This can of course still be used in Ada 95, but the discriminant --- approach is more efficient and neater. Note that in the Ada 83 --- approach, you must copy the My_ID value and stick it in a local --- variable, since My_ID is only accessible during the duration of --- the rendezvous. entry Start_Eating (Chopstick1 : in Positive; Chopstick2 : in Positive); --- A call to Start_Eating starts a given philosopher eating, using the --- two chopsticks. Not mentioned in the original code, but vital at --- the spec level is the guarantee that a philosopher picks up the --- first chop stick (Chopstick1) and waits till this is successfully --- grabbed before trying to pick up the second chop stick. This --- ordering guarantee is absolutely critical to the correct functioning --- of this program. --- Once started eating, a philosopher eats at random a few times, --- and then goes to sleep, terminating the task. The output of each --- philosopher task is recorded using calls to the Report_State --- entry of the Maitre_D task. As further explained there, the reason --- we don't just have the philosopher tasks do I/O directly is that --- this would cause coordination problems, race conditions, and improper --- access to shared variables, since multiple philosopher tasks might --- try to generate output at the same time. end Philosopher; type States is (Breathing, Thinking, Eating, Done_Eating, Got_One_Stick, Got_Other_Stick, Dying); --- This is used internally in the body to indicate the state of a --- philosopher. The reason it is exposed in the spec is that the --- Report_State entry takes a value of type States to indicate what --- kind of message needs to be output. --- Note: declarting a task type does NOT start any tasks. The client, --- in this case the Maitre_D task in Room, will have to declare ojects --- of this task type to actually create tasks of this type. end Phil; --:::::::::: --screen.ads --:::::::::: --- A simple screen output package, pretty much self explanatory. The --- only thing that should be added is that the subprograms in this --- package are not task safe, so if they are called from multiple --- tasks, the caller is responsible for proper synchronization. In --- our case, the Maitre_D task provides this syncrhonization by only --- allowing one task at a time to execute the code in the Repor_State --- entry. --- Another vital thing that is not documented is that this package is --- intended to work in conjunction with Text_IO, i.e. that the client --- can intermix Text_IO.Put statements with calls to MoveCursor, and --- the effect is as expected (i.e. the information output by Put appears --- at the expected location. Perhaps a cleaner more abstract interface --- would have been to include appropriate Put routines in the spec of --- this package, so this coordination would not be required. package Screen is -- simple ANSI terminal emulator -- Michael Feldman, The George Washington University -- July, 1995 ScreenHeight : constant Integer := 24; ScreenWidth : constant Integer := 80; subtype Height is Integer range 1..ScreenHeight; subtype Width is Integer range 1..ScreenWidth; type Position is record Row : Height := 1; Column: Width := 1; end record; --- Note, the style here of Pre/Post documentation refers to preconditions, --- those things that must be true before the call, and postconditions, --- those things that are true after the call is complete. This is a rather --- standard way of documenting code that either changes some hidden state, --- as in this case, or returns values. procedure Beep; -- Pre: none -- Post: the terminal beeps once procedure ClearScreen; -- Pre: none -- Post: the terminal screen is cleared procedure MoveCursor (To: in Position); -- Pre: To is defined -- Post: the terminal cursor is moved to the given position end Screen; --:::::::::: --windows.ads --:::::::::: --- A simple windowing package, which like screen is pretty much --- self explanatory. Note that once again, the subprograms in this --- package are not thread safe, and the caller must provide any --- required synchronization if multiple tasks execute these calls --- at the same time. In our case, the required synchronization is --- provided by the Maitre_D report interface. with Screen; package Windows is -- manager for simple, nonoverlapping screen windows -- Michael Feldman, The George Washington University -- July, 1995 type Window is private; --- It would be nice to have comments on this, since it is the --- fundamental ADT implemented by this package. Of course the --- name is a big hint, but it seems awkward to rely solely on --- the name. That's especially true since Window is not really --- a Window, but rather an abstract reference to a window. An --- object of type Window is a reference to a window that has been --- placed on the screen. Note that although there is a way of creating --- windows (Open), there is no way of removing them, which seems an --- omission for a generally usable package, though of course we don't --- need this in diners specifically. function Open (UpperLeft: Screen.Position; Height : Screen.Height; Width : Screen.Width) return Window; -- Pre: W, Height, and Width are defined -- Post: returns a Window with the given upper-left corner, -- height, and width --- The above comment is wrong, since there is no W. This kind of cut --- and paste error is easy to do, and unfortunately common. Really this --- is a bug, although a minor one, because we can easily figure out --- that W here should be UpperLeft, but it is a bug nevertheless. --- Furthermore, it is a bug that only affects comments and thus cannot --- be found by testing! procedure Title (W : in out Window; Name : in String; Under : in Character); -- Pre: W, Name, and Under are defined -- Post: Name is displayed at the top of the window W, underlined -- with the character Under. procedure Borders (W : in out Window; Corner, Down, Across : in Character); -- Pre: All parameters are defined -- Post: Draw border around current writable area in window with -- characters specified. Call this BEFORE Title. procedure MoveCursor (W : in out Window; P : in Screen.Position); -- Pre: W and P are defined, and P lies within the area of W -- Post: Cursor is moved to the specified position. -- Coordinates are relative to the -- upper left corner of W, which is (1, 1) procedure Put (W : in out Window; Ch : in Character); -- Pre: W and Ch are defined. -- Post: Ch is displayed in the window at -- the next available position. -- If end of column, go to the next row. -- If end of window, go to the top of the window. procedure Put (W : in out Window; S : in String); -- Pre: W and S are defined -- Post: S is displayed in the window, "line-wrapped" if necessary procedure New_Line (W : in out Window); -- Pre: W is defined -- Post: Cursor moves to beginning of next line of W; -- line is not blanked until next character is written private type Window is record First : Screen.Position; -- coordinates of upper left Last : Screen.Position; -- coordinates of lower right Current: Screen.Position; -- current cursor position end record; end Windows; --:::::::::: --room.adb --:::::::::: --- And here is the package that contains the real work of this program with Windows; --- We need Windows to do output operations with Chop; with Phil; with Society; --- The above three with statements are actually redundant, since they --- were with'ed in the spec. Any unit with'ed in the spec of a package --- is automatically also available in the body. with Calendar; --- Used to provide times in output pragma Elaborate (Phil); --- The reason we need this pragma Elaborate of (Phil) is that we --- are going to declare objects of type Phil.Philosopher at elaboration --- time, which starts tasks, and the task bodies must be elaborated --- before we declare such tasks, or we would get a tasking error. The --- normal "WITH" semantics guarantees that the spec of Phil is elaborated --- before we are, but not the body, for that you need the Elaborate_All --- pragma. --- --- Note that really in Ada 95 we should use pragma Elaborate_All, to do --- the transitive closure, i.e. this would cause all packages that are --- with'ed by Phil to be elaborated before us. That makes sense because --- we have no idea if those Phil.Philosopher tasks that we will start --- call other routines from packages with'ed by Phil. --- --- Unfortunately, if you do this, you get a circularity in elaboration order. --- This is caused by using a stand alone task. What happened here was that --- the program was developed for Ada 83, which did not have Elaborate_All, --- and thus got structured incorrectly. If you want to read more about this, --- see the section on elaboration in the GNAT user's guide, but be warned --- it is complex! package body Room is -- Dining Philosophers, Ada 95 edition -- A line-oriented version of the Room package -- Michael B. Feldman, The George Washington University, -- July, 1995. -- philosophers sign into dining room, giving Maitre_D their DNA code --- Translation: we start five tasks, using a different discriminant value --- for each task so they know who they are. Another technique that can be --- used in such a case is to start anonymous tasks, and then have them --- immediately do a Who_Am_I accept call. The creator then makes entry --- calls to give each task a name. That's the way things had to be done --- in Ada 83, before task discriminants existed, but this approach with --- discriminants is both neater and more efficient. --- The *aliased* keyword in the following declarations means that it is --- allowable to create accesses (pointers) to these objects using the --- attribute 'Access. Unlike C, where anyone can point to anything, --- creating aliases without limitation, in Ada you can only point to a --- declared variable if it is aliased. This is a compromise between the --- permissive view of C, and the restrictive view of Pascal (and Ada 83) --- where you can never point to a declared variable Dijkstra : aliased Phil.Philosopher (My_ID => 1); Stroustrup: aliased Phil.Philosopher (My_ID => 2); Anderson : aliased Phil.Philosopher (My_ID => 3); Ichbiah : aliased Phil.Philosopher (My_ID => 4); Taft : aliased Phil.Philosopher (My_ID => 5); --- Note: it is too bad that the above declarations know the complete --- set of philosophers. With a bit more effort, we could declare an --- array of tasks, based on the information in the Society package, --- so that only this package would need to be changed to change the --- number of philosophers. --- The *all* keyword in the following declaration means that the pointer --- type can point to any instance of the type, including aliased objects. type Philosopher_Ptr is access all Phil.Philosopher; --- Phils is an array of pointers to philosphers. Note that we can't --- simply make an array of philosophers, because they would all have --- to have the same discriminant in this case. Phils : array (Table_Type) of Philosopher_Ptr; --- Declare arrays for the output windows and seats to be used Phil_Windows : array(Table_Type) of Windows.Window; Phil_Seats : array (Society.Unique_DNA_Codes) of Table_Type; --- Here is the body of the Maitre_D task which does the real work task body Maitre_D is T : Natural; Start_Time : Calendar.Time; --- Calendar.Time represents a time of day Blanks : constant String := " "; begin --- Hang on Start_Serving accept, to wait for the signal to go. Note --- that there is null rendezvous code here, and no parameters, so this --- is simply a syncrhonization point. Both tasks arrive at this point --- with the first to arrive waiting for the second. Then when both --- have arrived, both continue on their way. accept Start_Serving; --- Record the starting time Start_Time := Calendar.Clock; -- Now Maitre_D assigns phils to seats at the table Phils := (Dijkstra'Access, Anderson'Access, Taft'Access, Ichbiah'Access, Stroustrup'Access); Phil_Seats := (1, 3, 5, 4, 2); -- which seat each phil occupies --- Declare a separate window for each philosopher. Again, this code --- knows too much about exactly how many philosophers are around, but --- it would be a lot more work to make it abstract this information --- from the SOciety package. Phil_Windows := (Windows.Open (( 1, 24), 7, 30), Windows.Open (( 9, 2), 7, 30), Windows.Open (( 9, 46), 7, 30), Windows.Open ((17, 7), 7, 30), Windows.Open ((17, 41), 7, 30)); for Which_Window in Phil_Windows'range loop Windows.Borders (Phil_Windows(Which_Window), '+', '|', '-'); end loop; -- and assigns them their chopsticks. --- A LOT is left unstated here in the original code! Each of the --- following calls to Start_Eating assigns two chop sticks to each --- philsopher in a circle around the table. --- From a logical point of view, it really does not matter which --- order these statements are in, though in practice, the ones we --- start off earlier are slightly more likely to eat earlier, but --- this is not guaranteed since there is a considerable randomness --- introduced in waiting times. --- Similarly, it would seem to matter little whether for example you --- give philsopher number one forks 1 and 2 as opposed to 2 and 1, but --- therein likes a VERY important idea. Have a close look at the set of --- assignments below. In each case the lower numbered fork comes first. --- Not stated in the original spec of Start_Eating, but in fact an --- important part of the spec, is that philsophers pick up the first --- chopstick first. For example, Philsopher number 5 from the table --- below will first pick up stick 1 and then once stick 1 is obtained --- will pick up stick 5. --- The trick (or clever algorithm if you like here, in fact it is often --- called the banker's algorithm) is that if everyone assigns things --- in an order like this, no deadlock is possible. If we assigned two --- philsophers forks (1,2) and (2,1), then one could pick up fork one --- and one could pick up fork 2, and they could starve waiting for --- one another. But such deadlocks are impossible if everyone allocates --- in order. This is pretty obvious in the two person case (1,2) vs --- (1,2), where one and only one person gets stick 1, and can then go --- on to stick 2. It is not so easy to see that this guarantee works --- for an arbitrary number of consumers and resources, but it does! Phils (1).Start_Eating (1, 2); Phils (3).Start_Eating (3, 4); Phils (2).Start_Eating (2, 3); Phils (5).Start_Eating (1, 5); Phils (4).Start_Eating (4, 5); --- Now we go into a loop accepting Report_State requests from any --- philsopher who feels like sending one. The infinite loop with a --- select inside is a very standard paradigm for a server. loop select accept Report_State (Which_Phil : in Society.Unique_DNA_Codes; State : in Phil.States; How_Long : in Natural := 0; Which_Meal : in Natural := 0) do --- OK we have the input parameters, so the following is really --- quite straightforward code that outputs the information in --- visible form on the screen. T := Natural (Calendar."-" (Calendar.Clock, Start_Time)); case State is when Phil.Breathing => Windows.Title(Phil_Windows(Phil_Seats(Which_Phil)), Society.Name_Register(Which_Phil), '-'); Windows.Put (Phil_Windows(Phil_Seats(Which_Phil)), "T =" & Integer'Image (T) & " " & "Breathing..."); Windows.New_Line (Phil_Windows(Phil_Seats(Which_Phil))); when Phil.Thinking => Windows.Put (Phil_Windows(Phil_Seats(Which_Phil)), "T =" & Integer'Image (T) & " " & "Thinking" & Integer'Image (How_Long) & " seconds."); Windows.New_Line (Phil_Windows(Phil_Seats(Which_Phil))); when Phil.Eating => Windows.Put (Phil_Windows(Phil_Seats(Which_Phil)), "T =" & Integer'Image (T) & " " & "Meal" & Integer'Image (Which_Meal) & "," & Integer'Image (How_Long) & " seconds."); Windows.New_Line (Phil_Windows(Phil_Seats(Which_Phil))); when Phil.Done_Eating => Windows.Put (Phil_Windows(Phil_Seats(Which_Phil)), "T =" & Integer'Image (T) & " " & "Yum-yum (burp)"); Windows.New_Line (Phil_Windows(Phil_Seats(Which_Phil))); when Phil.Got_One_Stick => Windows.Put (Phil_Windows(Phil_Seats(Which_Phil)), "T =" & Integer'Image (T) & " " & "First chopstick" & Integer'Image (How_Long)); Windows.New_Line (Phil_Windows(Phil_Seats(Which_Phil))); when Phil.Got_Other_Stick => Windows.Put (Phil_Windows(Phil_Seats(Which_Phil)), "T =" & Integer'Image (T) & " " & "Second chopstick" & Integer'Image (How_Long)); Windows.New_Line (Phil_Windows(Phil_Seats(Which_Phil))); when Phil.Dying => Windows.Put (Phil_Windows(Phil_Seats(Which_Phil)), "T =" & Integer'Image (T) & " " & "Croak"); Windows.New_Line (Phil_Windows(Phil_Seats(Which_Phil))); end case; -- State end Report_State; --- This branch of the select comes into action ONLY if all other --- tasks are waiting to close down, if everyone wants to close down, --- then any tasks at a terminate alternative take it and close down. --- Otherwise the Maitre_D task would hang forever waiting for the --- next call to Report_State. or terminate; end select; end loop; --- We will never terminate normally, because that was an infinite loop. --- As noted above, the way we exit is through the terminate alternative. end Maitre_D; end Room; --:::::::::: --phil.adb --:::::::::: --- This is the body of the philosopher task, which contains the actual --- code that will be executed for each philosopher. Remember that multiple --- copies of this code will be running (in separate tasks) at the same time. with Society; with Room; with Random_Generic; package body Phil is -- Dining Philosophers - Ada 95 edition -- Philosopher is an Ada 95 task type with discriminant. -- Chopsticks are assigned by a higher authority, which -- can vary the assignments to show different algorithms. -- Philosopher always grabs First_Grab, then Second_Grab. -- Philosopher is oblivious to outside world, but needs to -- communicate is life-cycle events the Maitre_D. --- The above comments really belong in the spec and not the body, since --- they are critical for the client in using this package. You should --- never have to read the body of a package to find out how to use it! -- Michael B. Feldman, The George Washington University, -- July, 1995. --- A road map of the basic outline of how this package works is useful --- at this stage (very often it is such high level comments that are --- critical in understanding the structure of a program, the low level --- comments are often somewhat redundant with respect to the actual code). --- A philosopher goes through the following stages: --- First wait for a Start_Eating call, till the entry call arrives, --- the task is in a dormant state, waiting on this entry. --- Now, start eating, the entire eating operation will be repeated --- a fixed number of times. The eating operation consists of: --- Pick up first chopstick (may have to wait) --- Pick up second chopstick (may have to wait) --- Eat for random length of time --- Put down chopsticks --- Think (without eating) for a random length of time --- After finishing all eating operations, the task terminates, called --- rather dramatically "Dying" in this program). subtype Think_Times is Positive range 1..8; --- This defines the possible range of think times. This is the time --- that the philosopher waits after eating. package Think_Length is new Random_Generic (Result_Subtype => Think_Times); --- We instantiate a version of the random number package for this type, --- so that calls to it generate results of type think times (i.e. results --- in the range 1 to 8). subtype Meal_Times is Positive range 1..10; package Meal_Length is new Random_Generic (Result_Subtype => Meal_Times); --- Same kind of declarations for eating times. task body Philosopher is -- My_ID is discriminant subtype Life_Time is Positive range 1..5; --- This defines the number of times each philosopher eats Who_Am_I : Society.Unique_DNA_Codes := My_ID; -- discrim --- There really is no need to copy this discriminant value, since --- it is available throughout the task. This is likely a hold over --- from the Ada 83 version, where, as noted in the spec comments, --- it is indeed necessary to do this copy. First_Grab : Positive; Second_Grab : Positive; --- These local variables record the chop stick values passed in --- by the entry call. These do need copying, as noted below. Meal_Time : Meal_Times; Think_Time : Think_Times; --- These variables record the random numbers used for eating and --- thinking times. begin --- The begin shows where the code of the task starts. -- get assigned the first and second chopsticks here accept Start_Eating (Chopstick1 : in Positive; Chopstick2 : in Positive) do --- This accept will just wait till someone (actually the Maitre_D --- task in Room, but we don't need to know that here) calls this --- entry point. --- At which point the rendezvous starts, and the calling task is --- stopped for a moment. We need to copy the chopstick values because --- the variables Chopstick1 and Chopstick2 are only available during --- the Rendezvous. First_Grab := Chopstick1; Second_Grab := Chopstick2; --- This end statement terminates the rendzevous, and the calling --- task proceeds on its way. end Start_Eating; --- And the philosopher task resumes here, first pausing to --- rendezvous with Maitre_D to report successful start up. --- Generally Maitre_D is always ready to accept such a call, --- so we won't get held up here. The exception occurs if some --- other philosopher task is trying to output at the same time. --- In that case, we may be held up for just a moment. Room.Maitre_D.Report_State (Who_Am_I, Breathing); --- The main loop through eating operations for Meal in Life_Time loop --- Grab our two sticks in order, reporting success. We definitely --- may have to wait for one or both of these sticks, but we will --- get them eventually (see discussion in body of Room for why this --- is the case). Room.Sticks (First_Grab).Pick_Up; Room.Maitre_D.Report_State (Who_Am_I, Got_One_Stick, First_Grab); Room.Sticks (Second_Grab).Pick_Up; Room.Maitre_D.Report_State (Who_Am_I, Got_Other_Stick, Second_Grab); --- Compute a random time to eat, and inform Maitre_D Meal_Time := Meal_Length.Random_Value; Room.Maitre_D.Report_State (Who_Am_I, Eating, Meal_Time, Meal); --- The delay statement simulates the eating operation by just waiting --- for the appropriate amount of time. This is just a simulation after --- all, philosopher tasks don't really eat anything :-) delay Duration (Meal_Time); --- We are done eating, so tell Maitre_D Room.Maitre_D.Report_State (Who_Am_I, Done_Eating); --- Now put down the sticks, unlike the pick up case, we don't have --- to wait for anyone else (though we might momentarily be held up --- on the lock on the chopstick protected type if someone else is --- trying to access the same stick at the same time.) Room.Sticks (First_Grab).Put_Down; Room.Sticks (Second_Grab).Put_Down; -- Think a random amount of time and tell Maitre_D Think_Time := Think_Length.Random_Value; Room.Maitre_D.Report_State (Who_Am_I, Thinking, Think_Time); delay Duration (Think_Time); --- end of loop through eating operations end loop; --- Tell Maitre_D we are dying (I think I would prefer sleeping :-) Room.Maitre_D.Report_State (Who_Am_I, Dying); --- And the task ends simply by coming to the end statement of the task, --- analogous to a procedure ending by hitting the end statement. There --- is no explicit termination statement in this case. end Philosopher; --- And that is the end of the package used to encapsulate the philosopher --- type and provide the code for the body of this task. end Phil; --:::::::::: --random_generic.adb --:::::::::: with Ada.Numerics.Discrete_Random; --- This is the standard Ada 95 random number generator package body Random_Generic is -- Body of random number generator package. -- Uses Ada 95 random number generator; hides generator parameters -- Michael B. Feldman, The George Washington University, -- June 1995. package Ada95_Random is new Ada.Numerics.Discrete_Random (Result_Subtype => Result_Subtype); -- Instantiate the standard Ada 95 random number package G: Ada95_Random.Generator; --- The Ada 95 package has a different kind of interface from --- Random_Generic. Instead of containing hidden state data (which --- incidentally results in non-obvious lack of thread safeness), --- the Ada 95 package separates the state into the notion of a --- generator, and the manipulation of state is explicit. The above --- declaration declares the generator object (this is indeed an --- example of classical object oriented programming). function Random_Value return Result_Subtype is --- This is defining the function that our generic spec (i.e. the spec --- of Random_Generic) provides to the client. begin --- We do our job by calling the Random routine in the Ada 85 package. --- In object oriented terms, we call the Random method of the generator --- sending it a message which results in its updating its internal state --- and returning us a random number as the result. return Ada95_Random.Random(Gen => G); end Random_Value; --- The begin section of a package body is elaboration code. This is code --- that is executed automatically when the package body is elaborated. For --- a generic package, this happens when the package is instantiated, before --- the client has accessed the package, so it can contain initialization --- code to get the package setup for proper use. begin --- In our case, the initialization consists of calling the Reset --- routine (in object oriented terms, using the reset method of the --- generator to send a message to the generator), which causes the --- generator to be set to a random state based on the current time --- of day, this ensures that the diners program generates different --- output each time it was run. If you comment out this statement, --- you will get the same pseudo-random numbers each time (this may --- be useful for debugging!) Ada95_Random.Reset(Gen => G); -- time-dependent initialization end Random_Generic; --:::::::::: --screen.adb --:::::::::: --- The body of the screen package is low level junk that uses something --- called ANSI escape sequences to control the cursor position. Assuming --- the purpose of reading this program in detail is to understand tasking, --- this body is irrelevant, and you can ignore it. In general you only --- need to read the specs of packages, unless you have some specific --- reason to mess with the body. For example, there are no ANSI escape --- sequences on some operating systems (e.g. NT), so you might need to --- completely replace this body if you were running on such a system, but --- this could be done in a manner which left the spec completely unchanged, --- and the client (in this case our Windows package) would not need any --- modification. For example, under Unix you might replace this package --- with the use of a standarded Curses library. with Text_IO; package body Screen is -- simple ANSI terminal emulator -- Michael Feldman, The George Washington University -- July, 1995 -- These procedures will work correctly only if the actual -- terminal is ANSI compatible. ANSI.SYS on a DOS machine -- will suffice. package Int_IO is new Text_IO.Integer_IO (Num => Integer); procedure Beep is begin Text_IO.Put (Item => ASCII.BEL); end Beep; procedure ClearScreen is begin Text_IO.Put (Item => ASCII.ESC); Text_IO.Put (Item => "[2J"); end ClearScreen; procedure MoveCursor (To: in Position) is begin Text_IO.New_Line; Text_IO.Put (Item => ASCII.ESC); Text_IO.Put ("["); Int_IO.Put (Item => To.Row, Width => 1); Text_IO.Put (Item => ';'); Int_IO.Put (Item => To.Column, Width => 1); Text_IO.Put (Item => 'f'); end MoveCursor; end Screen; --:::::::::: --windows.adb --:::::::::: --- The body of windows, is fairly straightforward, it is a nice example --- of how we build one abstraction (Windows) on top of another (Screen). --- This is called layering. with Text_IO, Screen; package body Windows is -- manager for simple, nonoverlapping screen windows -- Michael Feldman, The George Washington University -- July, 1995 function Open (UpperLeft: Screen.Position; Height : Screen.Height; Width : Screen.Width) return Window is Result: Window; begin Result.Current:= UpperLeft; Result.First := UpperLeft; Result.Last := (Row => UpperLeft.Row + Height - 1, Column => UpperLeft.Column + Width - 1); return Result; end Open; procedure EraseToEndOfLine (W : in out Window) is begin Screen.MoveCursor (W.Current); for Count in W.Current.Column .. W.Last.Column loop Text_IO.Put (' '); end loop; Screen.MoveCursor (W.Current); end EraseToEndOfLine; procedure Put (W : in out Window; Ch : in CHARACTER) is begin -- If at end of current line, move to next line if W.Current.Column > W.Last.Column then if W.Current.Row = W.Last.Row then W.Current.Row := W.First.Row; else W.Current.Row := W.Current.Row + 1; end IF; W.Current.Column := W.First.Column; end IF; -- If at First char, erase line if W.Current.Column = W.First.Column then EraseToEndOfLine (W); end IF; Screen.MoveCursor (To => W.Current); -- here is where we actually write the character! Text_IO.Put (Ch); W.Current.Column := W.Current.Column + 1; end Put; procedure Put (W : in out Window; S : in String) is begin for Count in S'Range loop Put (W, S (Count)); end loop; end Put; procedure New_Line (W : in out Window) is begin if W.Current.Column = 1 then EraseToEndOfLine (W); end IF; if W.Current.Row = W.Last.Row then W.Current.Row := W.First.Row; else W.Current.Row := W.Current.Row + 1; end IF; W.Current.Column := W.First.Column; end New_Line; procedure Title (W : in out Window; Name : in String; Under : in Character) is begin -- Put name on top line W.Current := W.First; Put (W, Name); New_Line (W); -- Underline name if desired, and reduce the writable area -- of the window by one line if Under = ' ' then -- no underlining W.First.Row := W.First.Row + 1; else -- go across the row, underlining for Count in W.First.Column..W.Last.Column loop Put (W, Under); end loop; New_Line (W); W.First.Row := W.First.Row + 2; -- reduce writable area end IF; end Title; procedure Borders (W : in out Window; Corner, Down, Across : in Character) is begin -- Put top line of border Screen.MoveCursor (W.First); Text_IO.Put (Corner); for Count in W.First.Column + 1 .. W.Last.Column - 1 loop Text_IO.Put (Across); end loop; Text_IO.Put (Corner); -- Put the two side lines for Count in W.First.Row + 1 .. W.Last.Row - 1 loop Screen.MoveCursor ((Row => Count, Column => W.First.Column)); Text_IO.Put (Down); Screen.MoveCursor ((Row => Count, Column => W.Last.Column)); Text_IO.Put (Down); end loop; -- Put the bottom line of the border Screen.MoveCursor ((Row => W.Last.Row, Column => W.First.Column)); Text_IO.Put (corner); for Count in W.First.Column + 1 .. W.Last.Column - 1 loop Text_IO.Put (Across); end loop; Text_IO.Put (Corner); -- Make the Window smaller by one character on each side W.First := (Row => W.First.Row + 1, Column => W.First.Column + 1); W.Last := (Row => W.Last.Row - 1, Column => W.Last.Column - 1); W.Current := W.First; end Borders; procedure MoveCursor (W : in out Window; P : in Screen.Position) is -- Relative to writable Window boundaries, of course begin W.Current.Row := W.First.Row + P.Row; W.Current.Column := W.First.Column + P.Column; end MoveCursor; begin Text_IO.New_Line; Screen.ClearScreen; Text_IO.New_Line; end Windows; --- This is the body of the Chop package, containing the body of the --- Chop.Stick protected type, which defines the operations. ------ --:::::::::: --chop.adb --:::::::::: package body Chop is -- Dining Philosophers - Ada 95 edition -- Chopstick is an Ada 95 protected type -- Michael B. Feldman, The George Washington University, -- July, 1995. protected body Stick is entry Pick_Up when not In_Use is --- The header shows that a client cannot enter here unless In_Use is --- False, that is, that the stick is on the table. If In_Use is True, --- then the caller hangs here waiting for In_Use to be set False. begin --- If we get in, we now own the lock on the protected type In_Use := True; --- And can safely change the private data, in this case setting the --- In_Use flag to True, indicating that the chop stick is now in use. --- This means that any further callers of Pick_Up will have to wait. -- And now we exit, releasing the lock end Pick_Up; procedure Put_Down is begin --- We now own the lock --- So we can modify In_Use to False indicating that the chop stick --- is returned to the table. In_Use := False; --- And now we exit the protected object and release the lock, as we --- exit a check is made to see if anyone waiting on an entry can get --- in, and indeed if there is anyone waiting, one of them will be --- allowed in at this point. end Put_Down; end Stick; --- That's the end of the body of the protected type end Chop; --- And that's the end of the containing package