mfeldman@seas.gwu.edu (Michael Feldman) (01/26/91)
I have had a _lot_ of requests today for the Portable Diners, so I
thought I'd impose on the net and post it again. If you have a copy
already, you can bypass this message - now.
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of shell archive."
# Contents: BUILD.DINERS READ.ME chopbody.ada chopspec.ada diners.ada
# file.list io_libs.ada philbody.ada philspec.ada ranbody.ada
# ranspec.ada roombody.ada roombody.cms roomspec.ada vtbody.ada
# vtspec.ada winbody.ada winspec.ada
# Wrapped by mfeldman@gwusun on Fri Jan 25 17:12:46 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'BUILD.DINERS' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'BUILD.DINERS'\"
else
echo shar: Extracting \"'BUILD.DINERS'\" \(703 characters\)
sed "s/^X//" >'BUILD.DINERS' <<'END_OF_FILE'
X# Unix compilation script for Dining Philosophers. You will have to
X# edit the script for your own Ada compiler and linker.
Xdate
Xalias COMPILE= (fill in the path to your Ada compiler)
Xalias LINK= (fill in the path to your Ada linker)
XSOURCE= (fill in the path to your source directory)
XCOMPILE $SOURCE/io_libs.ada
XCOMPILE $SOURCE/vtspec.ada
XCOMPILE $SOURCE/ranspec.ada
XCOMPILE $SOURCE/winspec.ada
XCOMPILE $SOURCE/chopspec.ada
XCOMPILE $SOURCE/philspec.ada
XCOMPILE $SOURCE/roomspec.ada
XCOMPILE $SOURCE/diners.ada
XCOMPILE $SOURCE/vtbody.ada
XCOMPILE $SOURCE/ranbody.ada
XCOMPILE $SOURCE/winbody.ada
XCOMPILE $SOURCE/chopbody.ada
XCOMPILE $SOURCE/philbody.ada
XCOMPILE $SOURCE/roombody.ada
Xdate
XLINK diners
Xdate
END_OF_FILE
if test 703 -ne `wc -c <'BUILD.DINERS'`; then
echo shar: \"'BUILD.DINERS'\" unpacked with wrong size!
fi
chmod +x 'BUILD.DINERS'
# end of 'BUILD.DINERS'
fi
if test -f 'READ.ME' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'READ.ME'\"
else
echo shar: Extracting \"'READ.ME'\" \(3257 characters\)
sed "s/^X//" >'READ.ME' <<'END_OF_FILE'
XA Modest Exercise in Ada Program Portability
XMichael B. Feldman
XDept. of Electrical Engineering and Computer Science
XThe George Washington University
XWashington, DC 20052
X202-994-5253
Xmfeldman@seas.gwu.edu
X
XHere is an exercise in Ada program portability. It is an implementation
Xof the famous Dining Philosophers problem, first posed by E. Dijkstra in
X1971. Five philosophers, sitting around a circular table, spend their lives
Xthinking and eating Chinese food. Between each pair of philosphers lies
Xa single chopstick; a philosopher must capture both chopsticks to eat.
X
XThis problem has been a classic in operating systems and concurrent programming
Xcircles. To avoid deadlock, someone must ensure that all philosophers don't
Xgrab their left chopsticks simultaneously, refusing to budge until they
Xhave grabbed their right sticks. In this implementation, a Head_Waiter task,
Xexported from package Room, takes care of this.
X
XHead_Waiter uses a simple window manager package to allow philosophers to
Xdisplay their states in separate windows on a vt100-compatible terminal.
X
XA second version of Room is included in case the terminal is line-oriented
Xor cannot handle ANSI terminal control.
X
XThis exercise has been successfully compiled and executed, without needing to
Xchange any source code, under products from the following vendors at GWU:
X
XIBM-PC Meridian AdaZ
XIBM-PC AETech IntegrAda (same compiler as Janus Ada)
X
XHP9000/300 Verdix VADS (HP/UX)
XHP9000/300 TeleSoft Telegen2 (HP/UX vers. 7.0)
X
XHP9000/800 Irvine Compiler Corporation ICC Ada (HP/UX)
X
XSun-3 Alsys
XSun-3 Verdix VADS (SunOS 4.0)
XSun-3 TeleSoft Telegen2 (SunOS 4.0)
XSun-3 Meridian AdaVantage (SunOS 4.0)
X
XThe exercise can be run on line-oriented terminals such as IBM 3270's
Xusing an alternative package body for Room, given here as roombody.cms.
XUsing this alternative, which does not use the vt100 or windows packages,
Xthe exercise has been compiled and run on
X
XIBM 4381 TeleSoft Telegen2 (VM/CMS)
XMacintosh Meridian AdaVantage (MacOS)
X
XI have had reports from the Ada newsgroups indicating success compiling
Xand running under DEC, Intermetrics, and Tartan products.
X
XPlease try this on your favorite compiler and let me know if your
Xexperience differs from mine.
X
XHere is the list of files in the distribution:
X
X
X-rwxr--r-- 1 mfeldman 703 Nov 25 17:14 BUILD.DINERS
X-rw-r--r-- 1 mfeldman 377 Nov 25 16:49 chopbody.ada
X-rw-r--r-- 1 mfeldman 297 Nov 25 16:50 chopspec.ada
X-rw-r--r-- 1 mfeldman 451 Nov 25 17:07 diners.ada
X-rw-r--r-- 1 mfeldman 261 Nov 17 10:22 io_libs.ada
X-rw-r--r-- 1 mfeldman 1577 Nov 25 16:56 philbody.ada
X-rw-r--r-- 1 mfeldman 645 Nov 25 16:52 philspec.ada
X-rw-r--r-- 1 mfeldman 1587 Nov 25 17:01 ranbody.ada
X-rw-r--r-- 1 mfeldman 413 Nov 25 17:00 ranspec.ada
X-rw-r--r-- 1 mfeldman 3767 Nov 25 17:09 roombody.ada
X-rw-r--r-- 1 mfeldman 2568 Nov 25 17:05 roombody.cms
X-rw-r--r-- 1 mfeldman 566 Nov 25 16:57 roomspec.ada
X-rw-r--r-- 1 mfeldman 633 Nov 17 12:07 vtbody.ada
X-rw-r--r-- 1 mfeldman 595 Nov 17 10:23 vtspec.ada
X-rw-r--r-- 1 mfeldman 6007 Nov 25 17:03 winbody.ada
X-rw-r--r-- 1 mfeldman 2692 Nov 25 17:02 winspec.ada
END_OF_FILE
if test 3257 -ne `wc -c <'READ.ME'`; then
echo shar: \"'READ.ME'\" unpacked with wrong size!
fi
# end of 'READ.ME'
fi
if test -f 'chopbody.ada' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'chopbody.ada'\"
else
echo shar: Extracting \"'chopbody.ada'\" \(377 characters\)
sed "s/^X//" >'chopbody.ada' <<'END_OF_FILE'
XPACKAGE BODY Chop IS
X-- Package body for chopstick task, intended for use with
X-- dining philosophers. It is really just a simple binary semaphore.
X-- Michael B. Feldman, November 1990
X
X TASK BODY Stick IS
X
X BEGIN
X
X LOOP
X SELECT
X ACCEPT Pick_Up;
X ACCEPT Put_Down;
X OR
X TERMINATE;
X END SELECT;
X END LOOP;
X
X END Stick;
X
XEND Chop;
END_OF_FILE
if test 377 -ne `wc -c <'chopbody.ada'`; then
echo shar: \"'chopbody.ada'\" unpacked with wrong size!
fi
# end of 'chopbody.ada'
fi
if test -f 'chopspec.ada' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'chopspec.ada'\"
else
echo shar: Extracting \"'chopspec.ada'\" \(297 characters\)
sed "s/^X//" >'chopspec.ada' <<'END_OF_FILE'
XPACKAGE Chop IS
X-- Specification for a chopstick task, intended for use with
X-- dining philosophers. It is really just a binary semaphore.
X-- Michael B. Feldman, The George Washington University, November 1990.
X
X TASK TYPE Stick IS
X ENTRY Pick_Up;
X ENTRY Put_Down;
X END Stick;
X
XEND Chop;
END_OF_FILE
if test 297 -ne `wc -c <'chopspec.ada'`; then
echo shar: \"'chopspec.ada'\" unpacked with wrong size!
fi
# end of 'chopspec.ada'
fi
if test -f 'diners.ada' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'diners.ada'\"
else
echo shar: Extracting \"'diners.ada'\" \(451 characters\)
sed "s/^X//" >'diners.ada' <<'END_OF_FILE'
XWITH Room;
XPROCEDURE Diners IS
X
X-- Main procedure for dining philosophers.
X-- The endless loop is a device to keep the main program alive, because
X-- some Ada implementations kill off library tasks when the main procedure
X-- is completed. This device makes the program entirely portable.
X
X-- Michael B. Feldman, The George Washington University, November 1990.
X
XBEGIN
X Room.Head_Waiter.Open_The_Room;
X LOOP
X DELAY 20.0;
X END LOOP;
XEND Diners;
X
END_OF_FILE
if test 451 -ne `wc -c <'diners.ada'`; then
echo shar: \"'diners.ada'\" unpacked with wrong size!
fi
# end of 'diners.ada'
fi
if test -f 'file.list' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'file.list'\"
else
echo shar: Extracting \"'file.list'\" \(917 characters\)
sed "s/^X//" >'file.list' <<'END_OF_FILE'
X-rwxr--r-- 1 asademo 703 Nov 25 17:14 BUILD.DINERS
X-rw-r--r-- 1 asademo 377 Nov 25 16:49 chopbody.ada
X-rw-r--r-- 1 asademo 297 Nov 25 16:50 chopspec.ada
X-rw-r--r-- 1 asademo 451 Nov 25 17:07 diners.ada
X-rw-r--r-- 1 asademo 261 Nov 17 10:22 io_libs.ada
X-rw-r--r-- 1 asademo 1577 Nov 25 16:56 philbody.ada
X-rw-r--r-- 1 asademo 645 Nov 25 16:52 philspec.ada
X-rw-r--r-- 1 asademo 1587 Nov 25 17:01 ranbody.ada
X-rw-r--r-- 1 asademo 413 Nov 25 17:00 ranspec.ada
X-rw-r--r-- 1 asademo 3767 Nov 25 17:09 roombody.ada
X-rw-r--r-- 1 asademo 2568 Nov 25 17:05 roombody.cms
X-rw-r--r-- 1 asademo 566 Nov 25 16:57 roomspec.ada
X-rw-r--r-- 1 asademo 633 Nov 17 12:07 vtbody.ada
X-rw-r--r-- 1 asademo 595 Nov 17 10:23 vtspec.ada
X-rw-r--r-- 1 asademo 6007 Nov 25 17:03 winbody.ada
X-rw-r--r-- 1 asademo 2692 Nov 25 17:02 winspec.ada
END_OF_FILE
if test 917 -ne `wc -c <'file.list'`; then
echo shar: \"'file.list'\" unpacked with wrong size!
fi
# end of 'file.list'
fi
if test -f 'io_libs.ada' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'io_libs.ada'\"
else
echo shar: Extracting \"'io_libs.ada'\" \(261 characters\)
sed "s/^X//" >'io_libs.ada' <<'END_OF_FILE'
X-- Precompiled instantiations of Integer_IO and
X-- Float_IO for the predefined Integer and Float types
X
XWITH Text_IO;
XPACKAGE My_Int_IO IS
X NEW Text_IO.Integer_IO (Num => Integer);
X
XWITH Text_IO;
XPACKAGE My_Flt_IO IS
X NEW Text_IO.Float_IO (Num => Float);
END_OF_FILE
if test 261 -ne `wc -c <'io_libs.ada'`; then
echo shar: \"'io_libs.ada'\" unpacked with wrong size!
fi
# end of 'io_libs.ada'
fi
if test -f 'philbody.ada' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'philbody.ada'\"
else
echo shar: Extracting \"'philbody.ada'\" \(1577 characters\)
sed "s/^X//" >'philbody.ada' <<'END_OF_FILE'
XWITH Room;
XWITH Random;
XPACKAGE BODY Phil IS
X
X-- Body of philosopher task.
X
X-- The philosopher needs to "with" package Room in order to report its states.
X-- Package Random is used to generate a (pseudo-)random-length meal and
X-- thinking time. This produces very useful nondeterminism.
X
X-- Michael B. Feldman, The George Washington University, November 1990.
X
X TASK BODY Philosopher IS
X
X Who_Am_I : Positive;
X First_Grab : Positive;
X Second_Grab: Positive;
X Meal_Time : Natural;
X Think_Time : Natural;
X
X BEGIN
X ACCEPT Come_To_Life (My_ID : Positive;
X Chopstick1 : Positive;
X Chopstick2 : Positive) DO
X Who_Am_I := My_ID;
X First_Grab := Chopstick1;
X Second_Grab := Chopstick2;
X
X END Come_To_Life;
X
X Room.Head_Waiter.Report_State(Who_Am_I, Breathing);
X
X LOOP
X
X Room.Sticks(First_Grab).Pick_Up;
X Room.Head_Waiter.Report_State(Who_Am_I, Got_One_Stick, First_Grab);
X
X Room.Sticks(Second_Grab).Pick_Up;
X Room.Head_Waiter.Report_State(Who_Am_I, Got_Other_Stick, Second_Grab);
X
X Meal_Time := Random.Random_Int(10);
X Room.Head_Waiter.Report_State(Who_Am_I, Eating, Meal_Time);
X
X DELAY Duration(Meal_Time);
X Room.Head_Waiter.Report_State(Who_Am_I, Done_Eating);
X
X Room.Sticks(First_Grab).Put_Down;
X Room.Sticks(Second_Grab).Put_Down;
X
X Think_Time := Random.Random_Int(10);
X Room.Head_Waiter.Report_State(Who_Am_I, Thinking, Think_Time);
X DELAY Duration(Think_Time);
X
X END LOOP;
X
X END Philosopher;
X
XEND Phil;
END_OF_FILE
if test 1577 -ne `wc -c <'philbody.ada'`; then
echo shar: \"'philbody.ada'\" unpacked with wrong size!
fi
# end of 'philbody.ada'
fi
if test -f 'philspec.ada' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'philspec.ada'\"
else
echo shar: Extracting \"'philspec.ada'\" \(645 characters\)
sed "s/^X//" >'philspec.ada' <<'END_OF_FILE'
XPACKAGE Phil IS
X-- Specification for dining philosopher task.
X-- Assumption is that head waiter will name a philosopher and assign
X-- the chopsticks to be used by that philosopher.
X-- Philosopher states are used by monitoring program (Head_Waiter).
X-- Michael B. Feldman, The George Washington University, November 1990.
X
X
X TASK TYPE Philosopher IS
X
X ENTRY Come_To_Life (My_ID : Positive;
X Chopstick1 : Positive;
X Chopstick2 : Positive);
X
X END Philosopher;
X
X TYPE States IS (Breathing, Thinking, Eating, Done_Eating,
X Got_One_Stick, Got_Other_Stick);
X
XEND Phil;
END_OF_FILE
if test 645 -ne `wc -c <'philspec.ada'`; then
echo shar: \"'philspec.ada'\" unpacked with wrong size!
fi
# end of 'philspec.ada'
fi
if test -f 'ranbody.ada' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'ranbody.ada'\"
else
echo shar: Extracting \"'ranbody.ada'\" \(1587 characters\)
sed "s/^X//" >'ranbody.ada' <<'END_OF_FILE'
X
Xwith CALENDAR;
Xuse CALENDAR;
Xpackage body RANDOM is
X
X-- Body of random number generator package.
X-- Adapted from the Ada literature by
X-- Michael B. Feldman, The George Washington University, November 1990.
X
X MODULUS : constant := 9317;
X
X type INT_16 is range -2 ** 15 .. 2 ** 15 - 1;
X type INT_32 is range -2 ** 31 .. 2 ** 31 - 1;
X subtype SEED_RANGE is INT_16 range 0 .. (MODULUS - 1);
X SEED, DEFAULT_SEED : SEED_RANGE;
X
X procedure SET_SEED(N : POSITIVE) is separate;
X function UNIT_RANDOM return FLOAT is separate;
X function RANDOM_INT(N : POSITIVE) return POSITIVE is separate;
Xbegin
X DEFAULT_SEED := INT_16(INT_32(SECONDS(CLOCK)) mod MODULUS);
X SEED := DEFAULT_SEED;
Xend RANDOM;
X
Xseparate(RANDOM)
Xprocedure SET_SEED(N : POSITIVE) is
Xbegin
X SEED := SEED_RANGE(N);
Xend SET_SEED;
X
Xseparate(RANDOM)
Xfunction UNIT_RANDOM return FLOAT is
X MULTIPLIER : constant := 421;
X INCREMENT : constant := 2073;
X RESULT : FLOAT;
Xbegin
X SEED := (MULTIPLIER * SEED + INCREMENT) mod MODULUS;
X RESULT := FLOAT(SEED) / FLOAT(MODULUS);
X return RESULT;
Xexception
X when CONSTRAINT_ERROR | NUMERIC_ERROR =>
X SEED := INT_16((MULTIPLIER * INT_32(SEED) + INCREMENT) mod MODULUS);
X RESULT := FLOAT(SEED) / FLOAT(MODULUS);
X return RESULT;
Xend UNIT_RANDOM;
X
Xseparate(RANDOM)
Xfunction RANDOM_INT(N : POSITIVE) return POSITIVE is
X RESULT : INTEGER range 1 .. N;
Xbegin
X RESULT := INTEGER(FLOAT(N) * UNIT_RANDOM + 0.5);
X return RESULT;
Xexception
X when CONSTRAINT_ERROR | NUMERIC_ERROR =>
X return 1;
Xend RANDOM_INT;
END_OF_FILE
if test 1587 -ne `wc -c <'ranbody.ada'`; then
echo shar: \"'ranbody.ada'\" unpacked with wrong size!
fi
# end of 'ranbody.ada'
fi
if test -f 'ranspec.ada' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'ranspec.ada'\"
else
echo shar: Extracting \"'ranspec.ada'\" \(413 characters\)
sed "s/^X//" >'ranspec.ada' <<'END_OF_FILE'
Xpackage RANDOM is
X
X-- Simple pseudo-random number generator package.
X-- Adapated from the Ada literature by
X-- Michael B. Feldman, The George Washington University, November 1990.
X
X procedure SET_SEED(N : POSITIVE);
X function UNIT_RANDOM return FLOAT;
X --returns a float >=0.0 and <1.0
X function RANDOM_INT(N : POSITIVE) return POSITIVE;
X --return a random integer in the range 1..N
X
Xend RANDOM;
X
END_OF_FILE
if test 413 -ne `wc -c <'ranspec.ada'`; then
echo shar: \"'ranspec.ada'\" unpacked with wrong size!
fi
# end of 'ranspec.ada'
fi
if test -f 'roombody.ada' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'roombody.ada'\"
else
echo shar: Extracting \"'roombody.ada'\" \(3579 characters\)
sed "s/^X//" >'roombody.ada' <<'END_OF_FILE'
XWITH Windows;
XWITH Chop;
XWITH Phil;
XWITH Calendar;
XPRAGMA Elaborate(Phil);
XPACKAGE BODY Room IS
X
X-- Body of Room package. The room contains a set of philosopher tasks
X-- and a set of windows in which philosophers report their states.
X-- The task Head_Waiter takes care of the window management.
X-- Head_Waiter also assigns chopsticks to philosophers. To avoid deadlock,
X-- this version of Head_Waiter commands four of the five philosophers to
X-- pick up their left sticks first; the fifth is told to pick up his\
X-- right stick first, which breaks the deadlock potential.
X-- Michael B. Feldman, The George Washington University, November 1990.
X
X
X Phils: ARRAY(Table_Type) OF Phil.Philosopher;
X Phil_Windows: ARRAY(Table_Type) OF Windows.Window;
X
X TASK BODY Head_Waiter IS
X
X T : Integer;
X Start_Time: Calendar.Time;
X
X BEGIN
X
X ACCEPT Open_The_Room;
X Start_Time := Calendar.Clock;
X
X Windows.Open(Phil_Windows(1),1,23,7,30);
X Windows.Borders(Phil_Windows(1),'+','|','-');
X Windows.Title(Phil_Windows(1), "Eddy Dijkstra",'-');
X Phils(1).Come_To_Life(1,1,2);
X
X Windows.Open(Phil_Windows(3),9,50,7,30);
X Windows.Borders(Phil_Windows(3),'+','|','-');
X Windows.Title(Phil_Windows(3), "Grady Booch",'-');
X Phils(3).Come_To_Life(3,3,4);
X
X Windows.Open(Phil_Windows(2),9,2,7,30);
X Windows.Borders(Phil_Windows(2),'+','|','-');
X Windows.Title(Phil_Windows(2), "Putnam Texel",'-');
X Phils(2).Come_To_Life(2,2,3);
X
X Windows.Open(Phil_Windows(5),17,41,7,30);
X Windows.Borders(Phil_Windows(5),'+','|','-');
X Windows.Title(Phil_Windows(5), "Bjarne Stroustrup",'-');
X Phils(5).Come_To_Life(5,1,5);
X
X Windows.Open(Phil_Windows(4),17,8,7,30);
X Windows.Borders(Phil_Windows(4),'+','|','-');
X Windows.Title(Phil_Windows(4), "Jean Ichbiah",'-');
X Phils(4).Come_To_Life(4,4,5);
X
X LOOP
X SELECT
X ACCEPT Report_State(Which_Phil: Table_Type;
X State: Phil.States;
X How_Long: Natural := 0) DO
X T := Integer(Calendar."-"(Calendar.Clock,Start_Time));
X Windows.Put_String(Phil_Windows(Which_Phil),
X "T=" & Integer'Image(T) & " ");
X
X CASE State IS
X WHEN Phil.Breathing =>
X Windows.Put_String(Phil_Windows(Which_Phil), "Breathing...");
X Windows.New_Line(Phil_Windows(Which_Phil));
X
X WHEN Phil.Thinking =>
X Windows.Put_String(Phil_Windows(Which_Phil),
X "Thinking" & Integer'Image(How_Long) & " seconds.");
X Windows.New_Line(Phil_Windows(Which_Phil));
X
X WHEN Phil.Eating =>
X Windows.Put_String(Phil_Windows(Which_Phil),
X "Eating" & Integer'Image(How_Long) & " seconds.");
X Windows.New_Line(Phil_Windows(Which_Phil));
X
X WHEN Phil.Done_Eating =>
X Windows.Put_String(Phil_Windows(Which_Phil), "Yum-yum (burp)");
X Windows.New_Line(Phil_Windows(Which_Phil));
X
X WHEN Phil.Got_One_Stick =>
X Windows.Put_String(Phil_Windows(Which_Phil),
X "First chopstick" & Integer'Image(How_Long));
X Windows.New_Line(Phil_Windows(Which_Phil));
X
X WHEN Phil.Got_Other_Stick =>
X Windows.Put_String(Phil_Windows(Which_Phil),
X "Second chopstick" & Integer'Image(How_Long));
X Windows.New_Line(Phil_Windows(Which_Phil));
X
X END CASE;
X
X END Report_State;
X OR
X TERMINATE;
X END SELECT;
X
X END LOOP;
X
X END Head_Waiter;
X
XEND Room;
END_OF_FILE
if test 3579 -ne `wc -c <'roombody.ada'`; then
echo shar: \"'roombody.ada'\" unpacked with wrong size!
fi
# end of 'roombody.ada'
fi
if test -f 'roombody.cms' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'roombody.cms'\"
else
echo shar: Extracting \"'roombody.cms'\" \(2443 characters\)
sed "s/^X//" >'roombody.cms' <<'END_OF_FILE'
XWITH Text_IO;
XWITH Chop;
XWITH Phil;
XWITH Calendar;
XPRAGMA Elaborate(Phil);
XPACKAGE BODY Room IS
X
X-- A line-oriented version of the Room package, for line-oriented
X-- terminals like IBM 3270's where the user cannot do ASCII screen control.
X-- This is the only file in the dining philosophers system that needs
X-- changing to use in a line-oriented environment.
X-- Michael B. Feldman, The George Washington University, November 1990.
X
X
X Phils: ARRAY(Table_Type) OF Phil.Philosopher;
X
X TYPE Phil_Names IS (Dijkstra, Texel, Booch, Ichbiah, Stroustrup);
X
X TASK BODY Head_Waiter IS
X
X T : Integer;
X Start_Time: Calendar.Time;
X Phil_Names: CONSTANT ARRAY(1..5) OF String(1..18) :=
X ("Eddy Dijkstra ",
X "Putnam Texel ",
X "Grady Booch ",
X "Jean Ichbiah ",
X "Bjarne Stroustrup ");
X Blanks : CONSTANT String := " ";
X
X BEGIN
X
X ACCEPT Open_The_Room;
X Start_Time := Calendar.Clock;
X
X Phils(1).Come_To_Life(1,1,2);
X Phils(3).Come_To_Life(3,3,4);
X Phils(2).Come_To_Life(2,2,3);
X Phils(5).Come_To_Life(5,1,5);
X Phils(4).Come_To_Life(4,4,5);
X
X LOOP
X SELECT
X ACCEPT Report_State(Which_Phil: Table_Type;
X State: Phil.States;
X How_Long: Natural := 0) DO
X T := Integer(Calendar."-"(Calendar.Clock,Start_Time));
X Text_IO.Put( "T=" & Integer'Image(T) & " "
X & Blanks(1..Which_Phil) & Phil_Names(Which_Phil));
X
X CASE State IS
X
X WHEN Phil.Breathing =>
X Text_IO.Put("Breathing");
X WHEN Phil.Thinking =>
X Text_IO.Put( "Thinking"
X & Integer'Image(How_Long)
X & " seconds.");
X WHEN Phil.Eating =>
X Text_IO.Put( "Eating"
X & Integer'Image(How_Long)
X & " seconds.");
X WHEN Phil.Done_Eating =>
X Text_IO.Put("Yum-yum (burp)");
X WHEN Phil.Got_One_Stick =>
X Text_IO.Put( "First chopstick"
X & Integer'Image(How_Long));
X WHEN Phil.Got_Other_Stick =>
X Text_IO.Put( "Second chopstick"
X & Integer'Image(How_Long));
X
X END CASE;
X Text_IO.New_Line;
X
X END Report_State;
X OR
X TERMINATE;
X END SELECT;
X
X END LOOP;
X
X END Head_Waiter;
X
XEND Room;
END_OF_FILE
if test 2443 -ne `wc -c <'roombody.cms'`; then
echo shar: \"'roombody.cms'\" unpacked with wrong size!
fi
# end of 'roombody.cms'
fi
if test -f 'roomspec.ada' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'roomspec.ada'\"
else
echo shar: Extracting \"'roomspec.ada'\" \(566 characters\)
sed "s/^X//" >'roomspec.ada' <<'END_OF_FILE'
XWITH Chop;
XWITH Phil;
XPACKAGE Room IS
X
X-- Specification of dining room package, which exports a set of
X-- chopsticks and a head waiter task.
X--
X-- Michael B. Feldman, The George Washington University, November 1990.
X
X
X Table_Size: CONSTANT := 5;
X SUBTYPE Table_Type IS Positive RANGE 1..Table_Size;
X
X Sticks: ARRAY(Table_Type) OF Chop.Stick;
X
X TASK Head_Waiter IS
X ENTRY Open_The_Room;
X ENTRY Report_State(Which_Phil: Table_Type;
X State: Phil.States;
X How_Long: Natural := 0);
X END Head_Waiter;
X
XEND Room;
X
END_OF_FILE
if test 566 -ne `wc -c <'roomspec.ada'`; then
echo shar: \"'roomspec.ada'\" unpacked with wrong size!
fi
# end of 'roomspec.ada'
fi
if test -f 'vtbody.ada' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'vtbody.ada'\"
else
echo shar: Extracting \"'vtbody.ada'\" \(633 characters\)
sed "s/^X//" >'vtbody.ada' <<'END_OF_FILE'
Xwith TEXT_IO; use TEXT_IO;
Xpackage body VT100 is
X use ASCII;
X----------------------------------------------------------
X-- Procedures for drawing pictures on VT100
X-- ClearScreen and SetCursorAt are trminal-specific
X----------------------------------------------------------
X
X procedure ClearScreen is
X begin
X PUT( ESC & "[2J" );
X end ClearScreen;
X
X procedure SetCursorAt(A: WIDTH; D : DEPTH) is
X
X begin
X NEW_LINE;
X PUT( ESC & "[" );
X PUT( D, 1 );
X PUT( ';' );
X PUT( A, 1 );
X PUT( 'f' );
X end SetCursorAt;
X
Xend VT100;
X
X-- .......................................................................... --
END_OF_FILE
if test 633 -ne `wc -c <'vtbody.ada'`; then
echo shar: \"'vtbody.ada'\" unpacked with wrong size!
fi
# end of 'vtbody.ada'
fi
if test -f 'vtspec.ada' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'vtspec.ada'\"
else
echo shar: Extracting \"'vtspec.ada'\" \(595 characters\)
sed "s/^X//" >'vtspec.ada' <<'END_OF_FILE'
X
Xwith TEXT_IO, MY_INT_IO; use TEXT_IO, MY_INT_IO;
Xpackage VT100 is
X use ASCII;
X----------------------------------------------------------
X-- Procedures for drawing pictures of the solution on VDU.
X-- ClearScreen and SetCursorAt are device-specific
X----------------------------------------------------------
X
X SCREEN_DEPTH : constant INTEGER := 24;
X SCREEN_WIDTH : constant INTEGER := 80;
X
X subtype DEPTH is INTEGER range 1..SCREEN_DEPTH;
X subtype WIDTH is INTEGER range 1..SCREEN_WIDTH;
X
X
X procedure ClearScreen;
X
X procedure SetCursorAt( A: WIDTH; D : DEPTH);
X
Xend VT100;
X
END_OF_FILE
if test 595 -ne `wc -c <'vtspec.ada'`; then
echo shar: \"'vtspec.ada'\" unpacked with wrong size!
fi
# end of 'vtspec.ada'
fi
if test -f 'winbody.ada' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'winbody.ada'\"
else
echo shar: Extracting \"'winbody.ada'\" \(6007 characters\)
sed "s/^X//" >'winbody.ada' <<'END_OF_FILE'
XPACKAGE BODY Windows is
X
X-- Body of window manager package.
X-- Adapted by
X-- Michael B. Feldman, The George Washington University, November 1990.
X
X CursorRow: RowRange := 1; -- Current cursor position
X CursorCol: ColRange := 1;
X
X PROCEDURE Open ( w: in out WINDOW;
X row: RowRange;
X column: ColRange;
X height: RowLength;
X width: ColLength) is
X --put the window's cursor in upper left corner
X BEGIN
X w.CurrentRow := row;
X w.firstrow := row;
X w.lastrow := row + height - 1;
X w.CurrentColumn := column;
X w.firstcolumn := column;
X w.lastcolumn := column + width - 1;
X END Open;
X
X PROCEDURE Close (w: in out WINDOW) IS
X BEGIN
X null;
X END Close;
X
X PROCEDURE Title (w : in out WINDOW;
X name : STRING;
X under : CHARACTER) IS
X -- Put name at the top of the window. If under <> ' ', underline
X -- the title.
X i: ColRange;
X BEGIN
X -- put name on top line
X w.CurrentColumn := w.firstcolumn;
X w.CurrentRow := w.firstrow;
X put_string (w, name);
X new_line (w);
X -- Underline name if desired, and move the first line of the window
X -- below the title
X IF under = ' ' THEN
X w.firstrow := w.firstrow + 1;
X ELSE
X FOR i IN w.firstcolumn .. w.lastcolumn LOOP
X put (w, under);
X END LOOP;
X new_line (w);
X w.firstrow := w.firstrow + 2;
X END IF;
X END Title;
X
X
X PROCEDURE GotoRowColumn (w : in out WINDOW;
X row : RowRange;
X column : ColRange) IS
X -- Relative to writable window boundaries, of course
X BEGIN
X w.CurrentRow := w.firstrow + row;
X w.CurrentColumn := w.firstcolumn + column;
X END GotoRowColumn;
X
X
X PROCEDURE Borders (w : in out WINDOW;
X corner, down, across: CHARACTER) IS
X -- Draw border around current writable area in window with characters.
X -- Call this BEFORE Title.
X i: RowRange;
X j: ColRange;
X BEGIN
X -- put top line of border
X SetCursorAt (w.firstcolumn, w.firstrow);
X TEXT_IO.put (corner);
X FOR j IN w.firstcolumn + 1 .. w.lastcolumn - 1 LOOP
X TEXT_IO.put (across);
X END LOOP;
X TEXT_IO.put (corner);
X
X -- put the two side lines
X FOR i IN w.firstrow + 1 .. w.lastrow - 1 LOOP
X SetCursorAt (w.firstcolumn, i);
X TEXT_IO.put (down);
X SetCursorAt (w.lastcolumn, i);
X TEXT_IO.put (down);
X END LOOP;
X
X -- put the bottom line of the border
X SetCursorAt (w.firstcolumn, w.lastrow);
X TEXT_IO.put (corner);
X FOR j IN w.firstcolumn + 1 .. w.lastcolumn - 1 LOOP
X TEXT_IO.put (across);
X END LOOP;
X TEXT_IO.put (corner);
X
X -- Put the cursor at the very end of the window
X CursorRow := w.lastrow;
X CursorCol := w.lastcolumn + 1;
X
X -- Make the window smaller by one character on each side
X w.firstrow := w.firstrow + 1;
X w.CurrentRow := w.firstrow;
X w.lastrow := w.lastrow - 1;
X w.firstcolumn := w.firstcolumn + 1;
X w.CurrentColumn := w.firstcolumn;
X w.lastcolumn := w.lastcolumn - 1;
X END Borders;
X
X
X PROCEDURE EraseToEndOfLine (w: in out WINDOW) IS
X i: ColRange;
X BEGIN
X SetCursorAt (w.CurrentColumn, w.CurrentRow);
X FOR i IN w.CurrentColumn .. w.lastcolumn LOOP
X TEXT_IO.put (' ');
X END LOOP;
X SetCursorAt (w.CurrentColumn, w.CurrentRow);
X CursorCol := w.CurrentColumn;
X CursorRow := w.CurrentRow;
X END EraseToEndOfLine;
X
X
X PROCEDURE put (w: in out WINDOW;
X ch: CHARACTER) IS
X
X -- If after end of line, move to first character of next line
X -- If about to write first character on line, blank rest of line.
X -- put character.
X
X BEGIN
X IF ch = ASCII.CR THEN
X new_line(w);
X RETURN;
X END IF;
X
X -- If at end of current line, move to next line
X IF w.CurrentColumn > w.lastcolumn THEN
X IF w.CurrentRow = w.lastrow THEN
X w.CurrentRow := w.firstrow;
X ELSE
X w.CurrentRow := w.CurrentRow + 1;
X END IF;
X w.CurrentColumn := w.firstcolumn;
X END IF;
X
X -- If at w.first char, erase line
X IF w.CurrentColumn = w.firstcolumn THEN
X EraseToEndOfLine (w);
X END IF;
X
X -- Put physical cursor at window's cursor
X IF (CursorCol /= w.CurrentColumn) OR (CursorRow /= w.CurrentRow)
X THEN
X SetCursorAt (w.CurrentColumn, w.CurrentRow);
X CursorRow := w.CurrentRow;
X END IF;
X
X IF ch = ASCII.BS THEN
X -- Special backspace handling
X IF w.CurrentColumn /= w.firstcolumn THEN
X TEXT_IO.put(ch);
X w.CurrentColumn := w.CurrentColumn - 1;
X END IF;
X ELSE
X TEXT_IO.put (ch);
X w.CurrentColumn := w.CurrentColumn + 1;
X END IF;
X CursorCol := w.CurrentColumn;
X END put;
X
X
X PROCEDURE new_line (w: in out WINDOW) IS
X col: ColRange;
X
X -- If not after line, blank rest of line.
X -- Move to first character of next line
X
X BEGIN
X IF w.CurrentColumn = 0 THEN
X EraseToEndOfLine (w);
X END IF;
X IF w.CurrentRow = w.lastrow THEN
X w.CurrentRow := w.firstrow;
X ELSE w.CurrentRow := w.CurrentRow + 1;
X END IF;
X w.CurrentColumn := w.firstcolumn;
X END new_line;
X
X
X PROCEDURE put_string (w: in out WINDOW;
X s: STRING) IS
X BEGIN
X FOR i in s'first .. s'last LOOP
X put (w, s(i));
X END LOOP;
X END put_string;
X
X
XBEGIN -- Windows
X ClearScreen;
X SetCursorAt (1, 1);
XEND Windows;
END_OF_FILE
if test 6007 -ne `wc -c <'winbody.ada'`; then
echo shar: \"'winbody.ada'\" unpacked with wrong size!
fi
# end of 'winbody.ada'
fi
if test -f 'winspec.ada' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'winspec.ada'\"
else
echo shar: Extracting \"'winspec.ada'\" \(2692 characters\)
sed "s/^X//" >'winspec.ada' <<'END_OF_FILE'
Xwith TEXT_IO, VT100; use TEXT_IO, VT100;
XPACKAGE Windows IS
X
X-- Simple output-only window manager for 24x80 terminals.
X-- Adapted by
X-- Michael B. Feldman, The George Washington University, November 1990.
X
X
X ScreenRows : constant integer := 24;
X ScreenColumns : constant integer := 80;
X
X TYPE WINDOW is private;
X
X SUBTYPE RowRange is integer range 1.. ScreenRows;
X SUBTYPE ColRange is integer range 1.. ScreenColumns;
X SUBTYPE RowLength is integer range 1.. ScreenRows;
X SUBTYPE ColLength is integer range 1.. ScreenColumns;
X
X
X PROCEDURE Open ( w: in out WINDOW; -- Window variable returned
X row : RowRange; -- Upper left corner
X column: ColRange;
X height: RowLength; -- Size of window
X width : ColLength);
X
X -- Create a window variable and open the window for writing.
X -- No checks for overlap of windows are made.
X
X
X PROCEDURE Close ( w: in out WINDOW);
X -- Close window and clear window variable.
X
X
X PROCEDURE Title (w : in out WINDOW;
X name : STRING;
X under : CHARACTER);
X
X -- Put a title name at the top of the window. If the parameter
X -- under <> 0C or ' ', underline the title with the specified character.
X
X
X PROCEDURE Borders (w : in out WINDOW;
X corner, down, across: CHARACTER);
X
X -- Draw border around current writable area in window with characters
X -- specified. Call this BEFORE Title.
X
X
X PROCEDURE GotoRowColumn (w : in out WINDOW;
X row : RowRange;
X column : ColRange);
X
X -- Goto the row and column specified. Coordinates are relative to the
X -- upper left corner of window, which is (1, 1)
X
X
X PROCEDURE put (w: in out WINDOW; ch: CHARACTER);
X
X -- put one character to the window.
X -- If end of column, go to the next row.
X -- If end of window, go to the top of the window.
X
X
X PROCEDURE put_string (w: in out WINDOW;
X s: STRING);
X
X -- put a string to window.
X
X
X PROCEDURE new_line (w: in out WINDOW);
X
X -- Go to beginning of next line. Next line is
X -- not blanked until next character is written
X
X
X PRIVATE
X type WINDOW is
X RECORD
X CurrentRow, -- Current cursor row
X firstrow,
X lastrow : RowRange;
X CurrentColumn, -- Current cursor column
X firstcolumn,
X lastcolumn : ColRange;
X END RECORD;
X
XEND Windows;
END_OF_FILE
if test 2692 -ne `wc -c <'winspec.ada'`; then
echo shar: \"'winspec.ada'\" unpacked with wrong size!
fi
# end of 'winspec.ada'
fi
echo shar: End of shell archive.
exit 0