[comp.lang.ada] More on the Dining Philosopher Query...

schallen@dinl.uucp (Eric Schallenmueller) (11/30/90)

Having just received the VADS compiler and being a good programmer by reading
the nice manual, I discovered that Verdix includes a copy of the Dining
Philosophers program in their supply of examples.  I believe someone compiled
and executed the Professor's program with the VADS system.  Is it much
different than the one Verdix supplies?  (I plan on investigating this myself,
but I'm in that wonderful end of year push to get things done.)  

Did Prof. Feldman look at that example?  Did it get his blessing?  Is it 
portable?  I will try to examine this myself, but it will probably take two
to three weeks at the least.  Meanwhile, is anyone else game?

Eric Schallenmuller

Please ignore my views and opinions... everyone else does...

mfeldman@seas.gwu.edu (Michael Feldman) (12/01/90)

In article <1802@dinl.mmc.UUCP> schallen@dinl.uucp (Eric Schallenmueller) writes:
>Having just received the VADS compiler and being a good programmer by reading
>the nice manual, I discovered that Verdix includes a copy of the Dining
>Philosophers program in their supply of examples.  I believe someone compiled
>and executed the Professor's program with the VADS system.  Is it much
>different than the one Verdix supplies?  (I plan on investigating this myself,
>but I'm in that wonderful end of year push to get things done.)  
>
>Did Prof. Feldman look at that example?  Did it get his blessing?  Is it 
>portable?  I will try to examine this myself, but it will probably take two
>to three weeks at the least.  Meanwhile, is anyone else game?
>
>Eric Schallenmuller
>
>Please ignore my views and opinions... everyone else does...

Well, since I didn't realize that example is in the VADS library, I
took a look. Sure enough, here is the program. It is documented as being
in the public domain, so there's no harm in posting it to the group.
I haven't yet compiled it, but eyeballing the code gives me no reason to think
it's not portable. 

I tried to use my version as an example of design as well as portability, 
and think it's a successful design. If you compare this program to mine, 
you find the main difference to be that, while the VADS version is more 
"visual" (picture instead of text windows), mine is decomposed better in that
ONLY the head_waiter has any knowledge of graphics, location on screen,
etc. A philosopher thinks and eats, and communicates with the rest of
the world only to report states to the head_waiter, who handles ALL
the display functions, via a window manager that handles ALL the
physical screen handling. IMHO this is better design; perhaps you'll agree.

You might well argue that this is overkill, but remember that the screen
controller, window manager, and random number package are all perfectly
reusable components (although I wouldn't call them "industrial
strength") - indeed, I re-used them from many earlier projects.

So to answer the original question: does the Verdix program have my
blessing? well, I'm not a priest, so it's not for me to bless or curse
anything. What we're doing here is comparing some different Ada styles -
I would never go further than to say that styles are a matter of taste.
I'll play around with the VADS example to assess portability, though;
thanks for putting me on to it.

BTW: while my signature file indeed identifies me as a professor, "Mike"
is as good a name to call me by as any other. 

--- cut here ---
-- UNIT: procedure PHL
-- FILES: phl.a
-- COMPILE: ada phl.a -M phl -o phl
-- PURPOSE: tasking test and demonstration
-- DESCRIPTION: The dining philosophers problem.
--                 Usage: phl
-- .......................................................................... --
with text_io;
procedure phl is

	print_task_starts : constant boolean := true;

	term_type:	character := '1';

	subtype seat is integer range 0..4;

	task type output is
		entry put_cursor ( s : seat; at_table, eating : boolean);
		entry put_line(s: in string);
		entry put(s: in string);
		entry	term_type_entry(x: in character);
		entry	clear_screen;
	end output;

	o: output;

	task type dining_room is
		entry allocate_seat (s : out seat);
		entry enter;
		entry leave;
	end dining_room;

	dr:  dining_room;

	task type fork is
		entry pick_up;
		entry put_down;
	end fork;

	cutlery : array (0..4) of fork;

	task type philosopher;

	school : array (0..4) of philosopher;

	task rand_delay is
		entry rand;
	end rand_delay;

	task body output is

		term_type: character;	-- '1' for vt100, '2' for f100 
		clear_sc : constant string := ascii.esc & '*' ;
		use text_io;
		pnum : character;
		r_s : seat;
		r_at_table, r_eating : boolean;

		type xy_position is 
			record
				x : integer range 0 .. 79;
				y : integer range 0 .. 23;
			end record;

		eating_coords : array (seat) of xy_position :=
		( (28, 6),
			(25,12),
			(36,15),
			(46,12),
			(44, 6) );

		thinking_coords : array(seat) of xy_position :=
		( (20,21),
			(30,21),
			(40,21),
			(50,21), 
			(60,21) );

		procedure put( item: in string ; pos: in xy_position ) is

			xp : integer := pos.x;
			yp : integer := pos.y;
			elp : integer;
			type as is access string;
			s : as := new string'(item);
			xs : as := new string'(integer'image(xp));
			ys : as := new string'(integer'image(yp));

		begin
			if yp /= 23 then 
				elp := 79; 
			else 
				elp := 78; 
			end if; -- can't write 79,23

			if ( xp + s'length > elp ) then
				s := new string'( s( s'first .. s'first + elp - xp ) );
			end if;

			-- position and write string
			if term_type = '1' then 
				text_io.put( ascii.esc & "[" & ys(2..ys'last) & ";" & 
				                     xs(2..xs'last) & "H" & s.all );
			else
				text_io.put( ascii.esc & "=" & character'val(32 + yp) &
				                       character'val(32 + xp) & s.all );
			end if;
		end put;

	begin
		accept term_type_entry(x: in character) do
			term_type := x;
		end term_type_entry;

		loop
			select
				accept put_cursor(s : seat; at_table, eating : boolean) do
					r_s := s;
					r_at_table := at_table;
					r_eating := eating;

					pnum := character'val( r_s + 1 + character'pos('0') ); 
					if r_at_table then
						put( "  ", thinking_coords(r_s) );
						if r_eating then
							put( "P" & pnum & "E", eating_coords(r_s) );
						else
							put( "P" & pnum & " ", eating_coords(r_s) );
						end if;
					else
						put( "   ", eating_coords(r_s) );
						put( "P" & pnum, thinking_coords(r_s) );
					end if;
				end put_cursor;
			or
				accept put(s : in string) do
					text_io.put(s);
				end put;
			or
				accept put_line(s : in string) do
					text_io.put_line(s);
				end put_line;
			or
				accept clear_screen do
					if term_type = '1' then
						text_io.put(ascii.esc & "[2J" & ascii.esc & "[H");
					else
						text_io.put(clear_sc);
					end if;
					delay 0.1;
				end clear_screen;

			end select;
		end loop;
	end output;

	task body dining_room is

		seats_filled : integer range 0..5 := 0;
		seat_allocation : seat := 0;

	begin
		if print_task_starts then 
			o.put_line("dining room starting"); 
		end if; 

		o.clear_screen;
		o.put_line("                    non_stop eating and thinking!");
	
		o.put_line("   ");
		o.put_line("   ");
		o.put_line("   ");
		o.put_line("                                   ***");
		o.put_line("                                 *******");
		o.put_line("                               ***********");
		o.put_line("                             ******   ******");
		o.put_line("                           ******  @@@  ******");
		o.put_line("                           *****  @@@@@  *****");
		o.put_line("                            *****  @@@  *****");
		o.put_line("                             *****     *****");
		o.put_line("                              *************");
		o.put_line("                               ***********");
		o.put_line("   ");
		o.put_line("   ");

	loop
		select
			--allocate fixed seat numbers to each of the five philosophers
			accept allocate_seat (s : out seat) do
				s := seat_allocation;
				if seat_allocation < 4 then
					seat_allocation := seat_allocation + 1;
				end if;
				end;
			or when seats_filled < 5 =>
				accept enter do
					seats_filled := seats_filled + 1;
				end;
			or accept leave do
				seats_filled := seats_filled - 1;
			end;
		end select;
	end loop;
	end dining_room;

	task body fork is
	begin
		if print_task_starts then 
			o.put_line("fork starting");
		end if;

		loop
			accept pick_up;
			accept put_down;
		end loop;
	end fork;

	task body rand_delay is
		random : duration := 0.4;
	begin
		loop
			random := random + 0.05;
			if random > 0.7 then random := 0.4; end if;
			accept rand do
				delay random;
			end rand;
		end loop;
	end rand_delay;

	task body philosopher is
		s : seat;
	begin
		if print_task_starts then
			o.put_line("philosopher starting");
		end if;

		dr.allocate_seat(s); --obtain seat on joining institution;
		dr.enter;
		o.put_cursor(s, at_table => true, eating => false);
		rand_delay.rand;

		loop
			cutlery(s).pick_up;
			select
				cutlery((s+1) mod 5).pick_up; --obtained two forks;
				-- philosopher begins to eat
				o.put_cursor(s, at_table => true, eating => true);
				delay 1.0;
	
				cutlery((s+1) mod 5).put_down;
				cutlery(s).put_down;

		  		--leave the room to think
		  		dr.leave;
		  		o.put_cursor(s, at_table => false, eating => false);
		  		delay 1.2;

				-- enter dining room again
				dr.enter;
				o.put_cursor(s, at_table => true, eating => false);
				delay 0.9;
			or
				-- let someone else try for 2 forks
				delay 0.9;
				cutlery(s).put_down;
		  rand_delay.rand;
			end select;
	 
		end loop;
	end philosopher;

begin 
	text_io.put("is this a vt100 (1) or an f100 (2) -->");
	text_io.get(term_type);
	if term_type /= '1' and term_type /= '2' then
		text_io.put("that's not a 1 or a 2, i'll assume you have a vt100");
	end if;
	o.term_type_entry(term_type);
end phl;
-- .......................................................................... --
--
-- DISTRIBUTION AND COPYRIGHT:
--                                                           
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--                                                           
-- DISCLAIMER:
--                                                           
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.