Semaphores in Ada - semaphore

I have been given the following code and asked to implement a semaphore.
with Ada.Text_IO; use Ada.Text_IO;
with Id_Dispenser;
with Semaphores; use Semaphores;
procedure Philos is
No_of_Philos : constant Positive := 5;
Meditation : constant Duration := 0.0;
type Table_Ix is mod No_of_Philos;
Forks : array (Table_Ix) of Binary_Semaphore (Initially_Available => True);
package Index_Dispenser is new Id_Dispenser (Element => Table_Ix);
use Index_Dispenser;
task type Philo;
task body Philo is
Philo_Nr : Table_Ix;
begin
Dispenser.Draw_Id (Id => Philo_Nr);
Put_Line (“Philosopher” & Table_Ix’Image (Philo_Nr) & “ looks for forks.”);
Forks (Philo_Nr).Wait; delay Meditation; Forks (Philo_Nr + 1).Wait;
Put_Line (“Philosopher” & Table_Ix’Image (Philo_Nr) & “ eats.”);
Forks (Philo_Nr).Signal; Forks (Philo_Nr + 1).Signal;
Put_Line (“Philosopher” & Table_Ix’Image (Philo_Nr) & “ dropped forks.”);
end Philo;
Table : array (Table_Ix) of Philo; pragma Unreferenced (Table);
begin
null;
end Philos;
The task requires a Semaphores package and a package Id_Dispenser. I am very new to Ada, but what is meant by a package? Does this mean both specification and body or just one, and how shall I go about implementing this?

As to "what is a package", check out the Packages section in the Ada Wikibook.
All packages have a specification part. Most also have a body (and if the spec promises one, for example by declaring a subprogram, there must actually be one).
You can find discussion of implementing a semaphore in the Wikibook section on Tasking, including code for a Semaphore_Protected_Type.
In your case, you need
package Semaphores is
protected type Binary_Semaphore (Initially_Available : Boolean) is
entry Wait;
procedure Signal;
private
Available : Boolean := Initially_Available;
end Binary_Semaphore;
...
end Semaphores;

What is meant by a package?
As suggested here, an Ada package provides for modular programming to support encapsulation.
The task requires a Semaphores package.
To this end, Ada offers protected types "which encapsulate and provide synchronized access to the private data of objects of the type without the introduction of an additional task." Additional discussion and examples may be found here.
In the context of the dining philosophers problem, this complete example is worth reading; it is included in the GNAT community edition in share/examples/gnat/simple_project. In particular, the package Chop exports protected type Stick; each instance of Stick has an entry Pick_Up and procedure Put_Down. The package Room can then hold an array of utensils available to the diners, corresponding to Forks in your fragment.
Sticks : array (Table_Type) of Chop.Stick;

Related

Memory issues when using spring.Nullable with DUnitX

Recently at my company we tried to use DUnitX with all it's blessings to test classes we wrote. Since those classes reflect entities in database all fields have to accept null values as well as specific type (e. g. Integer or string).
Since spring4d already have those we tried to use them:
INaleznosc = interface
['{D5D6C901-3DB9-4EC2-8070-EB0BEDBC7B06}']
function DajPodstawaVAT(): TNullableCurrency;
property PodstawaVAT: TNullableCurrency read DajPodstawaVAT;
end;
TNaleznosc = class(TInterfacedObject, INaleznosc)
strict private
FId: TNullableInt64;
FPodstawaVAT: Currency;
function TNaleznosc.DajPodstawaVAT(): TNullableCurrency;
published
property PodstawaVAT: TNullableCurrency read DajPodstawaVAT;
end;
INaleznoscFunkcje = interface
['{509288AB-110A-4A52-BE93-3723E5725F4B}']
function DajPodstawaVAT(pID: TNullableInt64): TNullableCurrency;
end;
function TNaleznosc.DajPodstawaVAT(): TNullableCurrency;
begin
FPodstawaVAT := FFunkcje.DajPodstawaVAT(FId);
end;
procedure TTestNaleznosc.PodstawaVATGetterNieWywolujefunkcji();
var
funkcjeNaleznosc: TMock<INaleznoscFunkcje>;
klasa: INaleznosc;
id: TNullableInteger;
begin
//initialize tested elements
funkcjeNaleznosc := TMock<INaleznoscFunkcje>.Create();
id := 15;
klasa := TNaleznosc.Create(funkcjeNaleznosc, id, zmienne);
//setup expected behaviour from mock
funkcjeNaleznosc.Setup.WillReturn(2).When.DajPodstawaVAT(id);
funkcjeNaleznosc.Setup.Expect.Once.When.DajPodstawaVAT(id);
//this triggers getter
klasa.PodstawaVAT;
end;
When this code is executed we get AV exception First chance exception at $00000000. Exception class $C0000005 with message 'access violation at 0x00000000: access of address 0x00000000'. Process Tests.exe (6556).
Eventually we narrowed this issue down to Move procedure in System.Rtti unit, TValueDataImpl.ExtractRawDataNoCopy function:
when Length(FData) is less or equal to 8 it works fine
when Length(FData) is between 9 and 32 at line 5905 of System unit (FISTP QWORD PTR [EDX+8] {Save Second 8}) whole call stack disappears beside two lines (we are not sure whether it's relevant or not, but it doesn't look like good sign) and after getting to topmost function (according to call stack) we get error.
Call stack before "saving second 8"
Call stack after "saving second 8"
Is it our fault or is it some issue with system/spring/dunitx units? How can we use nullable types and tests at the same time?
I am not sure if Delphi Mocks has a generic type parameter on its WillReturn method but if so then pass TNullableCurrency there - otherwise the compiler will infer the type from the parameter 2 you are passing and obviously internally it fails to put that into the TNullableCurrency it should return.
If it does not and only allows TValue then you need to pass one that contains a TNullableCurrency and not 2 which it would by using its implicit operator like so: TValue.From<TNullableCurrency>(2)
Furthermore I am not sure if they did fix the code in the SameValue routine in Delphi Mocks when the value to be compared is a record (as TNullableCurrency is)
Edit: no, they did not - see https://github.com/VSoftTechnologies/Delphi-Mocks/issues/39
You might want to consider giving Spring4D mocks a try which should be able to handle nullables.

Interfaces In PLSQL

Is it possible to use interfaces with objects in plsql?
For example say I have a bunch of objects and want to sort them by date with a generic function. Could I have something like the following?
create or replace interface DateInterface
(
member function get_date return date
)
/
create or replace type TypeA implements DateInterface
(
my_date date,
member function get_date return date
)
/
create or replace type body TypeA is
member function get_date return date is
begin
return my_date;
end;
end;
/
create or replace type dateTable as table of DateInterface;
/
function EarliestDate (dates dateTable) returns date is
l_earliestDate date;
begin
l_earliestDate := dates(1);
for i in dates.first .. dates.last
loop
if l_earliestDate.get_date > dates(i).get_date then
l_earliestDate := dates(i);
end if;
end loop;
return l_earliestDate;
end;
I know I could have them inherit a class, but is there anything for doing this with an interface which would be more flexible?
Oracle supports interfacing external sources like Java and C languages within its procedures and functions using the LANGUAGE clause in them. Implement the date sorting logic of the objects in a procedure or a function and interface with other programming languages.
For reference, see Oracle's documentation
I'm late to the party but Oracle has sort of OO support now in PLSQL:
https://docs.oracle.com/en/database/oracle/oracle-database/18/adobj/inheritance-in-sql-object-types.html#GUID-A5FE7A3B-7C1C-430A-8095-76AE955119C9
You have inheritance etc. with that. So you could do sort of an interface for PLSQL Object Type Objects
But it comes with problems. Eg. storing in tables.
See https://oracle-base.com/articles/8i/object-types

Delphi - accesing non UI units from inside a thread

I have the following situation.
We develop in DelphiXE.
We are putting the majority of our functions in a DATAMODULE.
function1 (database, transaction, paramInteger) : float
for example
function1 take parameters database (TIBDATABASE), the transaction TIBTRANSACTIOn and aditiona parameter integer. and return a float
function GetLastPretAch(DIBase : TIBDatabase; Tran : TIBTransaction; const aID : Integer) : Double;
var workQuery : TIBQuery;
begin
try
workQuery := TIBQuery.Create(Application);
try
workQuery.Close;
workQuery.Database := DIBase;
workQuery.Transaction := Tran;
workQuery.SQL.Clear;
workQuery.SQL.Add('SELECT * FROM GETLASTPRETACH(-1, :AARTNR)');
workQuery.ParamByName('AARTNR').AsInteger := aID;
workQuery.Open;
Result := workQuery.FieldByName('LASTPRET').AsFloat;
except
on e : Exception do begin
raise EMagisterException.Create(TranslateIbError(e));
end;
end;
finally
FreeAndNil(workQuery);
end;
end;
Now I want to use this functions from a thread. is this thread safe?
inside execute procedure like
ID := GetLastPretAch(database, transaction, 1);
is or not thread safe?
The answer to your question is Yes, you can use that function from inside a worker thread's execute procedure. You might want to consider refining your SQL to only SELECT the field LASTPRET instead of SELECT *.
For an extended discussion on what "thread safe" means refer to this SO question
What does threadsafe mean?
Looks like you're using IBX Components which, the last time I looked were most definitely NOT thread-safe. If you switched to a data access layer that was thread-safe, you should be fine with that code. FYI UIB (Unified Interbase components) are thread-safe.

InstallShield calling advapi32.dll method type mismatch error

I am trying to call Advapi32.LsaOpenPolicy() from basic MSI InstallShield code. I've successfully called other avdapi32.dll methods; But LsaOPenPolicy is throwing a mismatched type error.
My prototype is:
prototype INT Advapi32.LsaOpenPolicy(POINTER, POINTER, INT, POINTER);
The windows definition is:
NTSTATUS LsaOpenPolicy(
_In_ PLSA_UNICODE_STRING SystemName,
_In_ PLSA_OBJECT_ATTRIBUTES ObjectAttributes,
_In_ ACCESS_MASK DesiredAccess,
_Inout_ PLSA_HANDLE PolicyHandle
);
I've noted in C++ samples that the ObjectAttriibute structure is zeroed out. So I do something similar here in the InstallShield code -- pArray points to the array contents.
for i = 0 to 11
array(i) = 0;
endfor;
array(0) = 24;
// current error is 80020005 type mismatch.
try
i = POLICY_CREATE_ACCOUNT | POLICY_LOOKUP_NAMES;
pArray = array;
pPolicy = NULL;
nvOSResult = LsaOpenPolicy(NULL, pArray, i, pPolicy);
catch
Sprintf(errString, "0x%08x", Err.Number);
_Logger(hMSI, methodName, "LsaOpenPolicy Exception "+errString, INFORMATION, FALSE);
nvOSResult = Err.Number;
endcatch;
There not much other information I can find other than the 80020005 error thrown; I've tried a few different argument constructions, but I can't get past this.
I've posted this in an flexera and microsoft forum -- but I have gotten no traction there. (references for posterity: flexera-link, microsoft-link)
Any help or suggestions are welcome!
The answer to this question was to actually work-around the interface between installshield and the system DLLs by moving all the workings into a C++ DLL. As installation got more complex, I ended up with two separate DLL functions, one executed at dialog (non-admin) mode and one at deferred execution (admin) mode.
In order to pass information I used the MsiGetProperty() API using MSI properties for both input and output variables.
Note that for deferred execution, I needed a CAD function on the installshield side to marshal data into the custom action data location, and on the DLL side extract the data, again by using MsiGetProperty() but getting the "CustomActionData" property and then parse the resulting string which contained the marshaled data.

How to access thread and its components?

I create a thread
type
ss_thread = class;
ss_thread = class(TThread)
protected
Fff_id : string;
Fff_cmd : string;
Fff_host : string;
Fff_port : TIdPort;
procedure Execute; override;
public
constructor Create(const ff_id, ff_cmd: string; ff_host: string; ff_port: TIdPort);
end;
constructor ss_thread.Create(const ff_id, ff_cmd: string; ff_host: string; ff_port: TIdPort);
begin
inherited Create(False);
Fff_id := ff_id;
Fff_cmd := ff_cmd;
Fff_host := ff_host;
Fff_port := ff_port;
end;
...
id := 123;
...
nst_ss_thread.Create(id, cmd, host, port);
and doing something on
procedure ss_thread.Execute;
var
ws : TIdTCPClient;
data : TIdBytes;
i : integer;
list : TList;
begin
ws := TIdTCPClient.Create(nil);
ws.Host := Fff_host;
ws.Port := Fff_port;
....
How to access this thread 'ws' variable thru another thread using id:=123 of thread ?
Thanks
It cannot.
You've declared ws as a local variable inside ss_thread.execute, which means it's only visible there. It can't be seen outside ss_thread.execute, even by other parts of ss_thread.
If you want it visible from other places or threads, you need to move it to a more visible scope. For instance, if you want it visible from other places in ss_thread, move it to the interface declaration in private or protected sections, and if you want it visible from outside ss_thread move it to the published or public sections.
You'd better not. Thread objects are exactly made to insulate its variables from other threads.
Otherwise all kind of random non-reproducible errors would appear - http://en.wikipedia.org/wiki/Heisenbug
Parallel programming should have very clear separation and insulation. Because You can never predict the timing of execution and which statement would run earlier and which one later.
Imagine that easy scenario:
ws := TIdTCPClient.Create(nil);
ws.Host := Fff_host;
// at this point another thread gets access to ws variable,
// as You demanded - and changes it, so WS gets another value!
ws.Port := Fff_port;
How would you detect such a bug, if it happens only on client multi-processor computer under heavy load once a month ? In your workstation during debug sessions or simulation it would not be reproduced ever! How would you catch it and fix ?
As a rule of thumb, when doing parallel programming the data should be spleat into "shared immutable" and "private mutable" pieces, and when doing inter-thread communication you should - similar to inter-process communications - make some events/messages queue and pass commands and replies to/from threads, like it is done in Windows GDI or like in MPI
Then you thread would fetch "change ws variable" command from queue - in the proper moment when the change is allowed - and change it from inside. Thus you would assume control and assure that variables are only changed in that point and in that manner, that would not derail the code flow.
I suggest you to read OTL examples to see how inter-thread communication is done in more safe way that direct access to objects. http://otl.17slon.com/tutorials.htm

Resources