Skip to content

Commit 47dc44d

Browse files
reznikmmreznikmm
committed
Add Job_Scheduler to LSP server.
Refs #1141
1 parent 8141f7e commit 47dc44d

11 files changed

+791
-35
lines changed

‎source/ada/lsp-ada_indexing.ads

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
------------------------------------------------------------------------------
22
-- Language Server Protocol --
33
-- --
4-
-- Copyright (C) 2023, AdaCore --
4+
-- Copyright (C) 2023-2024, AdaCore --
55
-- --
66
-- This is free software; you can redistribute it and/or modify it under --
77
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -22,7 +22,7 @@ with GNATCOLL.VFS;
2222

2323
with LSP.Ada_Configurations;
2424
with LSP.Ada_Handlers;
25-
private with LSP.Server_Jobs;
25+
with LSP.Server_Jobs;
2626
private with LSP.Server_Message_Visitors;
2727
limited with LSP.Servers;
2828
private with LSP.Structures;
@@ -42,6 +42,9 @@ package LSP.Ada_Indexing is
4242
Project_Stamp : LSP.Ada_Handlers.Project_Stamp;
4343
Files : File_Sets.Set);
4444

45+
type Indexing_Job (<>) is new LSP.Server_Jobs.Abstract_Server_Job
46+
with private;
47+
4548
private
4649

4750
-- Indexing of sources is performed in the background as soon as

‎source/server/lsp-job_schedulers.adb

Lines changed: 121 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,121 @@
1+
------------------------------------------------------------------------------
2+
-- Language Server Protocol --
3+
-- --
4+
-- Copyright (C) 2024, AdaCore --
5+
-- --
6+
-- This is free software; you can redistribute it and/or modify it under --
7+
-- terms of the GNU General Public License as published by the Free Soft- --
8+
-- ware Foundation; either version 3, or (at your option) any later ver- --
9+
-- sion. This software is distributed in the hope that it will be useful, --
10+
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
11+
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
12+
-- License for more details. You should have received a copy of the GNU --
13+
-- General Public License distributed with this software; see file --
14+
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
15+
-- of the license. --
16+
------------------------------------------------------------------------------
17+
18+
with Ada.Unchecked_Conversion;
19+
with Ada.Unchecked_Deallocation;
20+
with System.Storage_Elements;
21+
with LSP.Server_Jobs;
22+
23+
package body LSP.Job_Schedulers is
24+
25+
procedure Free is new Ada.Unchecked_Deallocation
26+
(LSP.Server_Jobs.Server_Job'Class, LSP.Server_Jobs.Server_Job_Access);
27+
28+
----------------
29+
-- Create_Job --
30+
----------------
31+
32+
procedure Create_Job
33+
(Self : in out Job_Scheduler'Class;
34+
Message : in out LSP.Server_Messages.Server_Message_Access) is
35+
begin
36+
Self.Message := Message;
37+
Message := null;
38+
end Create_Job;
39+
40+
--------------
41+
-- Has_Jobs --
42+
--------------
43+
44+
function Has_Jobs (Self : Job_Scheduler'Class) return Boolean is
45+
begin
46+
return Self.Message.Assigned;
47+
end Has_Jobs;
48+
49+
----------
50+
-- Hash --
51+
----------
52+
53+
function Hash (Tag : Ada.Tags.Tag) return Ada.Containers.Hash_Type is
54+
function Cast is new Ada.Unchecked_Conversion
55+
(Ada.Tags.Tag, System.Address);
56+
begin
57+
return Ada.Containers.Hash_Type'Mod
58+
(System.Storage_Elements.To_Integer (Cast (Tag)));
59+
end Hash;
60+
61+
-------------
62+
-- Process --
63+
-------------
64+
65+
procedure Process_High_Priority_Job
66+
(Self : in out Job_Scheduler'Class;
67+
Client : in out
68+
LSP.Client_Message_Receivers.Client_Message_Receiver'Class;
69+
Waste : out LSP.Server_Messages.Server_Message_Access)
70+
is
71+
Job : LSP.Server_Jobs.Server_Job_Access;
72+
begin
73+
Waste := null;
74+
75+
-- Process the most recent message if any
76+
if Self.Message.Assigned then
77+
declare
78+
Cursor : constant Handler_Maps.Cursor :=
79+
Self.Handlers.Find (Self.Message'Tag);
80+
begin
81+
if Handler_Maps.Has_Element (Cursor) then
82+
Job := Handler_Maps.Element (Cursor).Create_Job (Self.Message);
83+
Self.Message := null;
84+
else
85+
Waste := Self.Message;
86+
Self.Message := null;
87+
return;
88+
end if;
89+
end;
90+
else
91+
null; -- TBD: find next job here
92+
end if;
93+
94+
while Job.Assigned loop
95+
Job.Execute (Client);
96+
97+
if Job.Is_Done then
98+
-- TBD: Call complete?
99+
Waste := Job.Message;
100+
Free (Job);
101+
exit;
102+
else
103+
raise Program_Error with "Unimplemeted";
104+
-- TBD: put job back to the queue
105+
end if;
106+
end loop;
107+
end Process_High_Priority_Job;
108+
109+
----------------------
110+
-- Register_Handler --
111+
----------------------
112+
113+
procedure Register_Handler
114+
(Self : in out Job_Scheduler'Class;
115+
Tag : Ada.Tags.Tag;
116+
Handler : LSP.Server_Message_Handlers.Server_Message_Handler_Access) is
117+
begin
118+
Self.Handlers.Include (Tag, Handler);
119+
end Register_Handler;
120+
121+
end LSP.Job_Schedulers;

‎source/server/lsp-job_schedulers.ads

Lines changed: 82 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,82 @@
1+
------------------------------------------------------------------------------
2+
-- Language Server Protocol --
3+
-- --
4+
-- Copyright (C) 2024, AdaCore --
5+
-- --
6+
-- This is free software; you can redistribute it and/or modify it under --
7+
-- terms of the GNU General Public License as published by the Free Soft- --
8+
-- ware Foundation; either version 3, or (at your option) any later ver- --
9+
-- sion. This software is distributed in the hope that it will be useful, --
10+
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
11+
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
12+
-- License for more details. You should have received a copy of the GNU --
13+
-- General Public License distributed with this software; see file --
14+
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
15+
-- of the license. --
16+
------------------------------------------------------------------------------
17+
18+
with Ada.Containers.Hashed_Maps;
19+
with Ada.Tags;
20+
21+
with LSP.Client_Message_Receivers;
22+
with LSP.Server_Message_Handlers;
23+
with LSP.Server_Messages;
24+
25+
package LSP.Job_Schedulers is
26+
pragma Preelaborate;
27+
28+
type Job_Scheduler is tagged limited private;
29+
30+
procedure Register_Handler
31+
(Self : in out Job_Scheduler'Class;
32+
Tag : Ada.Tags.Tag;
33+
Handler : LSP.Server_Message_Handlers.Server_Message_Handler_Access);
34+
-- Register server message handler per message tag.
35+
36+
function Has_Jobs (Self : Job_Scheduler'Class) return Boolean;
37+
-- Return true if there are any jobs in the queue.
38+
39+
procedure Create_Job
40+
(Self : in out Job_Scheduler'Class;
41+
Message : in out LSP.Server_Messages.Server_Message_Access);
42+
-- Create a job to process a server message. The scheduler takes ownership
43+
-- of the message and will return it to the server when the job is done.
44+
45+
procedure Process_High_Priority_Job
46+
(Self : in out Job_Scheduler'Class;
47+
Client :
48+
in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class;
49+
Waste : out LSP.Server_Messages.Server_Message_Access);
50+
-- Execute jobs with highest priority (Immediate, Fence).
51+
-- When a job is done the routine returns (in Waste) the message to be
52+
-- deallocated by the server. The Client is used to send messages during
53+
-- the execution of the job.
54+
55+
procedure Process_Job
56+
(Self : in out Job_Scheduler'Class;
57+
Client :
58+
in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class;
59+
Waste : out LSP.Server_Messages.Server_Message_Access) is null;
60+
-- Execute jobs with ordinal priority (Low, High).
61+
-- When a job is done the routine returns (in Waste) the message to be
62+
-- deallocated by the server. The Client is used to send messages during
63+
-- the execution of the job.
64+
65+
private
66+
67+
function Hash (Tag : Ada.Tags.Tag) return Ada.Containers.Hash_Type;
68+
69+
package Handler_Maps is new Ada.Containers.Hashed_Maps
70+
(Ada.Tags.Tag,
71+
LSP.Server_Message_Handlers.Server_Message_Handler_Access,
72+
Hash,
73+
Ada.Tags."=",
74+
LSP.Server_Message_Handlers."=");
75+
76+
type Job_Scheduler is tagged limited record
77+
Message : LSP.Server_Messages.Server_Message_Access;
78+
-- Last added message
79+
Handlers : Handler_Maps.Map;
80+
end record;
81+
82+
end LSP.Job_Schedulers;

0 commit comments

Comments
 (0)