with Ada_Store.PoST.Input_Queue; package Ada_Store.PoST.Device is type Instance is abstract tagged private; type Instance_Ptr is access all Instance'Class; type Unit is range 1 .. 9; type Device_Mode is ( Input, Output, Both ); type Device_Status is ( Closed, Idle, Busy, Locked, Off_Line, Error ); -- -- The following functions only set the Current_Status entry, they -- follow the correct presedence rules and should be used. -- procedure Open (Device : in out Instance'Class; Unit_ID : in Unit); procedure Open (Device : in out Instance) is abstract; procedure Close (Device : in out Instance); procedure Lock (Device : in out Instance); procedure UnLock (Device : in out Instance); procedure ReStart (Device : in out Instance); -- -- Query functions -- function Current_Mode (Device : in Instance) return Device_Mode; function Current_Status (Device : in Instance) return Device_Status; function Unit_ID (Device : in Instance) return Unit; -- -- Flushes any internal data -- procedure Flush (Device : in out Instance; Flush_Mode : in Device_Mode) is abstract; -- -- Accept an Input Message. -- procedure Accept_Input (Device : in out Instance; Input : in Input_Queue.Message_Ptr) is abstract; -- -- exceptions raised, possibly not by this base, but by members of the -- class -- Device_Not_Found : exception; Incorrect_Status : exception; Incorrect_Mode : exception; Transport_Error : exception; Invalid_Input : exception; private type Instance is abstract tagged record Unit_ID : Unit := 1; Current_Mode : Device_Mode := Output; Current_Status : Device_Status := Closed; end record; end Ada_Store.PoST.Device;
package body Ada_Store.PoST.Device is procedure Open (Device : in out Instance'Class; Unit_ID : in Unit) is begin if Device.Current_Status = Closed then Device.Current_Status := Idle; Device.Unit_ID := Unit_ID; Open(Device); else raise Incorrect_Status; end if; end Open; procedure Close (Device : in out Instance) is begin if Device.Current_Status /= Closed or Device.Current_Status /= Locked then Device.Current_Status := Closed; else raise Incorrect_Status; end if; end Close; procedure Lock (Device : in out Instance) is begin if Device.Current_Status /= Locked then Device.Current_Status := Locked; else raise Incorrect_Status; end if; end Lock; procedure UnLock (Device : in out Instance) is begin if Device.Current_Status = Locked then Device.Current_Status := Idle; else raise Incorrect_Status; end if; end unLock; procedure ReStart (Device : in out Instance) is begin if Device.Current_Status = Off_Line or Device.Current_Status = Error then Device.Current_Status := Idle; else raise Incorrect_Status; end if; end ReStart; function Current_Mode (Device : in Instance) return Device_Mode is begin return Device.Current_Mode; end Current_Mode; function Current_Status (Device : in Instance) return Device_Status is begin return Device.Current_Status; end Current_Status; function Unit_ID (Device : in Instance) return Unit is begin return Device.Unit_ID; end Unit_ID; end Ada_Store.PoST.Device;
Copyright ©
1996 Simon Johnston &
Addison Wesley Longman