-- This program addresses some of the problems of the first concbank.adb program with Text_Io, Ada.Integer_Text_Io; use Text_Io, Ada.Integer_Text_Io; with Ada.Float_Text_Io; use Ada.Float_Text_Io; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; procedure Concbankt is type Account is record Balance : Integer; Interest : Float; end record; type Accountptr is access Account; function Makeaccount(B : Integer) return Accountptr is A : Accountptr; begin A := new Account; A.Balance := B; A.interest := 0.02; -- 2% interest return A; end Makeaccount; -- Our banking institution just got bailed out by the federal government. -- In order to improve customer service, we'd like to make it so that -- if you try to withdraw an amount that's greater than your current balance, -- instead of bouncing your check we will suspend your transaction until -- enough funds are available. To do this, each "withdraw transaction" -- is implemented as a separate task, which can be suspended and resumed. -- Each such "withdrawer" task defines two rendezvous points: Setup, -- which is called only once, merely records the amount to be withdrawn -- (Wamt) and the account to withdraw from (pointer B). The other entry, -- "Wake", is called from a banker process after every deposit transaction. -- The withdraw transaction is only processed after "Wake" is called. --- withdrawer task: task type Withdrawer is entry Setup(B : Accountptr; WAmt : Integer); entry Wake; end Withdrawer; task body Withdrawer is A : Accountptr; Amt : Integer; Stop : Boolean := False; begin accept Setup(B : Accountptr; WAmt : Integer) do A := B; Amt := WAmt; end Setup; -- In the following while loop, Wake calls are accepted repeated -- until the stop variable is set to true, which signals that the -- transaction has finally been processed. while not(Stop) loop select accept Wake do if (A.Balance >= Amt) then A.Balance := A.Balance - Amt; Stop := True; -- stop select loop Put("finished suspended withdraw transaction"); New_Line; else Put("still not enough funds!"); New_Line; end if; end Wake; or -- this works the way you hope: delay 1.0 -- 10*60.0; -- delay 10 minutes Stop := True; Put("Transaction canceled after time limit reached"); New_Line; end select; end loop; end Withdrawer; -- We also set a global array of pointers to suspended withdrawer tasks: type WTASK is access Withdrawer; type Wtaskarray is array(0..100) of WTASK; -- banker task provides the banking service: task type Banker is entry Setaccount(X : Accountptr); entry Withdraw(X : Integer); entry Deposit(X : Integer); entry Inquiry(X : out Integer); entry Quit; end Banker; task body Banker is A : Accountptr; Stop : Boolean := False; Wdtask : Wtaskarray; WN : Integer :=0; -- number of actual tasks in array. Suspend : Boolean; -- determines if transaction needs to be suspended Amt : Integer; I : Integer; begin accept Setaccount(X : Accountptr) do A := X; end Setaccount; while not(Stop) loop -- infinite loop select accept Inquiry(X : out Integer) do X := A.Balance; end Inquiry; or accept Deposit(X : Integer) do A.Balance := A.Balance + X; end Deposit; Put("just processed deposit"); -- not part of rendevous point New_Line; I := 0; while ( I= X) then Suspend := False; else Suspend := True; end if; end Withdraw; -- either withdraw immediately, or create new task to suspend withdraw if not(Suspend) then -- make withdraw immediately A.Balance := A.Balance - Amt; else -- create new withdraw task: Wdtask(WN) := new Withdrawer; Wdtask(WN).Setup(A,Amt); WN := WN + 1; end if; or accept Quit do Stop := True; end Quit; end select; end loop; end Banker; Myaccount : Accountptr; Mybanker : Banker; -- the banker thread, waiting for "setaccount" X : Integer; begin -- body of main procedure will provide the client thread Myaccount := Makeaccount(100); Mybanker.Setaccount(Myaccount); -- banker enters into server loop Mybanker.Withdraw(400); -- make this asynchronous. delay(3.0); Mybanker.Deposit(600); Mybanker.Inquiry(X); Put("my balance is now "); Put(X,Width=>6); New_Line; Mybanker.Quit; end Concbankt;