524 lines
12 KiB
Ada
524 lines
12 KiB
Ada
with Ada.Text_IO,Ada;
|
|
use Ada.Text_IO;
|
|
|
|
procedure pointer is
|
|
|
|
type cell;
|
|
type list is access cell;
|
|
type cell is record
|
|
info : Integer;
|
|
next: list;
|
|
End record;
|
|
|
|
type tasks;
|
|
type listc is access tasks;
|
|
type tasks is record
|
|
num : Integer;
|
|
dur : Integer;
|
|
next: listc;
|
|
End record;
|
|
|
|
|
|
type Hcell;
|
|
type Hlistc is access Hcell;
|
|
type Hcell is record
|
|
Num: Integer;
|
|
First: listc;
|
|
Last : listc;
|
|
End record;
|
|
|
|
type returned3 is record
|
|
Num : integer;
|
|
listRet : list;
|
|
end record;
|
|
|
|
|
|
|
|
procedure afficher(liste: list) is
|
|
I : Integer := 1;
|
|
Aux : list;
|
|
begin
|
|
aux := liste;
|
|
if(aux = null) then
|
|
Put_line("empty list");
|
|
end if;
|
|
|
|
while(aux.all.next /= null)
|
|
loop
|
|
put_line(Integer'Image(I) & ": " & integer'Image(aux.all.info));
|
|
aux:=aux.all.next;
|
|
end loop;
|
|
put_line(Integer'Image(I) & ": " & integer'Image(aux.all.info));
|
|
end afficher;
|
|
|
|
procedure afficherR(liste:list; I : Integer := 1) is
|
|
|
|
begin
|
|
if(liste = null) then
|
|
Put_line("empty list");
|
|
end if;
|
|
|
|
if (liste.all.next = Null) then
|
|
put_line(Integer'Image(I) & ": " & integer'Image(liste.all.info));
|
|
else
|
|
put_line(Integer'Image(I) & ": " & integer'Image(liste.all.info));
|
|
afficherR(liste.all.next,I+1);
|
|
end if;
|
|
end afficherR;
|
|
|
|
Procedure afficherRrev(liste : list) is
|
|
begin
|
|
|
|
if (liste = null) then
|
|
Put_line("empty list");
|
|
else
|
|
if (liste.all.next = null) then
|
|
put_line(Integer'Image(liste.all.info));
|
|
else
|
|
AfficherRRev(liste.all.next);
|
|
put_line(Integer'Image(liste.all.info));
|
|
end if;
|
|
end if;
|
|
end afficherRrev;
|
|
|
|
|
|
procedure inserer(liste : in out list; val :integer) is
|
|
aux : list := liste;
|
|
P: list;
|
|
begin
|
|
if (aux /= null) then
|
|
while(aux.all.next /= null) loop
|
|
aux:= aux.all.next;
|
|
end loop;
|
|
P := new cell'(val,null);
|
|
aux.all.next := P;
|
|
else
|
|
P := new cell'(val,null);
|
|
liste := P;
|
|
end if;
|
|
end inserer;
|
|
|
|
procedure insererR(liste : in out list; Val : Integer) is
|
|
P: list := null;
|
|
begin
|
|
if (liste /= null) then
|
|
if (liste.all.next /= null) then
|
|
InsererR(liste.all.next,Val);
|
|
else
|
|
P := new cell'(val,null);
|
|
liste.all.next := P;
|
|
end if;
|
|
else
|
|
P := new cell'(val,null);
|
|
liste := P;
|
|
end if;
|
|
end insererR;
|
|
|
|
|
|
|
|
|
|
|
|
function saisir1 return list is
|
|
liste : list;
|
|
ended : boolean := false;
|
|
space : boolean := false;
|
|
charac : character := ' ';
|
|
Num: integer:=0;
|
|
val : integer := 0;
|
|
s : string(1..1);
|
|
I : integer := 0;
|
|
begin
|
|
while (not end_of_line) loop
|
|
while (not space and not end_of_line) loop
|
|
-- put_line("test");
|
|
get(charac);
|
|
if(charac = ' ') then ended := True; space := True;
|
|
else
|
|
s(1):=charac;
|
|
val := integer'Value(s);
|
|
put_Line("vous avez saisi " & charac);
|
|
Num := Num*10+val;
|
|
end if;
|
|
end loop;
|
|
space := False;
|
|
inserer(liste, Num);
|
|
Num := 0;
|
|
end loop;
|
|
return liste;
|
|
end saisir1;
|
|
|
|
|
|
|
|
|
|
function saisir2 return list is
|
|
liste : list;
|
|
ended : boolean := false;
|
|
space : boolean := false;
|
|
charac : character := ' ';
|
|
Num: integer:=0;
|
|
val : integer := 0;
|
|
s : string(1..1);
|
|
I : integer := 0;
|
|
aux : list;
|
|
first : boolean:= True;
|
|
|
|
begin
|
|
aux := liste; -- we set the
|
|
while (not end_of_line) loop
|
|
while (not space and not end_of_line) loop
|
|
-- put_line("test");
|
|
get(charac);
|
|
if(charac = ' ') then ended := True; space := True;
|
|
else
|
|
s(1):=charac;
|
|
val := integer'Value(s);
|
|
-- put_Line("vous avez saisi " & charac);
|
|
Num := Num*10+val;
|
|
end if;
|
|
end loop;
|
|
space := False;
|
|
if first then
|
|
liste := new cell'(Num,Null);
|
|
first:= False;
|
|
aux := liste;
|
|
else
|
|
aux.all.next := new cell'(Num, Null);
|
|
aux:= aux.all.next;
|
|
end if;
|
|
Num := 0;
|
|
end loop;
|
|
return liste;
|
|
end saisir2;
|
|
|
|
|
|
function saisir3 return returned3 is
|
|
liste : list;
|
|
ended : boolean := false;
|
|
space : boolean := false;
|
|
charac : character := ' ';
|
|
Num: integer:=0;
|
|
val : integer := 0;
|
|
s : string(1..1);
|
|
I : integer := 0;
|
|
aux : list;
|
|
first : boolean:= True;
|
|
count : integer := 0;
|
|
returned : returned3;
|
|
begin
|
|
aux := liste; -- we set the
|
|
while (not end_of_line) loop
|
|
while (not space and not end_of_line) loop
|
|
-- put_line("test");
|
|
get(charac);
|
|
if(charac = ' ') then ended := True; space := True;
|
|
else
|
|
s(1):=charac;
|
|
val := integer'Value(s);
|
|
-- put_Line("vous avez saisi " & charac);
|
|
Num := Num*10+val;
|
|
end if;
|
|
end loop;
|
|
space := False;
|
|
if first then
|
|
liste := new cell'(Num,Null);
|
|
first:= False;
|
|
aux := liste;
|
|
else
|
|
aux.all.next := new cell'(Num, Null);
|
|
aux:= aux.all.next;
|
|
end if;
|
|
Count := count +1;
|
|
Num := 0;
|
|
end loop;
|
|
returned.num := count;
|
|
returned.listRet := liste;
|
|
return returned;
|
|
end saisir3;
|
|
|
|
|
|
|
|
procedure addcirc(Listout, backup: HlistC) is
|
|
valuesR : returned3;
|
|
values : list;
|
|
L : Integer := 1;
|
|
add : listc;
|
|
add2 : listc;
|
|
auxc : listc;
|
|
auxc2 : listc;
|
|
aux : list;
|
|
N : Integer := 0;
|
|
Done: boolean := False; -- to check if the person entered the right number of variable
|
|
begin
|
|
Put_line("Please enter the number of processes");
|
|
declare
|
|
s : string := get_line;
|
|
begin
|
|
N := integer'Value(s);
|
|
listOut.all.num := N;
|
|
backup.all.num := N;
|
|
Put_line("Please type in each process' number of tasks separated by spaces");
|
|
while (not Done) loop
|
|
valuesR := saisir3;
|
|
declare
|
|
buff : string := get_line;
|
|
begin
|
|
null;
|
|
end;
|
|
if (valuesR.num = N) then
|
|
done:= True;
|
|
else
|
|
put_line("Please try again ;)");
|
|
end if;
|
|
end loop;
|
|
values :=valuesR.listRet;
|
|
for L in 1..N loop
|
|
if(L=1) then
|
|
listOut.all.first:= new tasks'(L,values.all.info,listOut.all.first);
|
|
backup.all.first:= new tasks'(L,values.all.info,backup.all.first);
|
|
auxc := listOut.all.first;
|
|
auxc2 := backup.all.first;
|
|
aux := values.all.next;
|
|
else
|
|
add:= new tasks'(L,aux.all.info,listOut.all.first);
|
|
add2:= new tasks'(L,aux.all.info,backup.all.first);
|
|
aux:= aux.all.next;
|
|
auxc.all.next:= add;
|
|
auxc2.all.next:= add2;
|
|
auxc := add;
|
|
auxc2 := add2;
|
|
if (L=N) then
|
|
listOut.all.last := auxc;
|
|
backup.all.last := auxc2;
|
|
end if;
|
|
end if;
|
|
end loop;
|
|
end;
|
|
end addcirc;
|
|
|
|
|
|
-- --== Took way too much space :/ ==--
|
|
|
|
procedure displayC(list: HlistC) is
|
|
aux : listc;
|
|
begin
|
|
aux := list.all.first;
|
|
Put_line("We have here" & Integer'Image(list.num) &" processes to run");
|
|
Put_Line("processus number" & Integer'Image(aux.all.num) &" with "& integer'Image(aux.all.dur) & " tasks left to perform");
|
|
if(list.all.num > 1) then
|
|
while(aux.all.next /= list.all.first) loop
|
|
aux := aux.all.next;
|
|
Put_Line("processus number" & Integer'Image(aux.all.num) &" with "& integer'Image(aux.all.dur) & " tasks left to perform");
|
|
end loop;
|
|
end if;
|
|
end displayC;
|
|
|
|
|
|
procedure DisplayCSmall(list:HlistC) is
|
|
aux : listc;
|
|
I : Integer :=1;
|
|
begin
|
|
aux := list.all.first;
|
|
new_line;
|
|
Put_line(" ══════════════════════");
|
|
Put_line(" processes :" & Integer'Image(list.num));
|
|
if (list.all.num>0) then
|
|
Put(" ║"&Integer'Image(aux.all.num) &" :"& integer'Image(aux.all.dur)&" ");
|
|
end if;
|
|
if(list.all.num > 1) then
|
|
while(aux.all.next /= list.all.first) loop
|
|
I := I+1;
|
|
aux := aux.all.next;
|
|
Put(" ║"&Integer'Image(aux.all.num) &" :"& integer'Image(aux.all.dur)&" ");
|
|
if(I mod 5 = 0) then
|
|
put("║");
|
|
New_line;
|
|
end if;
|
|
end loop;
|
|
end if;
|
|
if (list.all.num>0) then
|
|
put("║");
|
|
new_line;
|
|
else
|
|
new_line;
|
|
Put_line(" ══════════════════════");
|
|
Put_line(" ══════-THE END-═══════");
|
|
Put_line(" ══════════════════════");
|
|
end if;
|
|
end displayCsmall;
|
|
|
|
|
|
procedure runsilent (list : HlistC; Q : integer) is
|
|
aux: listc;
|
|
prev : listc := NULL;
|
|
Remove : Integer := 0 ; -- Number of processes to remove
|
|
L : Integer := 1;
|
|
begin
|
|
aux := list.all.first;
|
|
Put_line(" ══════════════════════");
|
|
For L in 1..list.all.num loop
|
|
-- Put_line("number :" & integer'Image(aux.all.num));
|
|
if (aux.all.dur>Q) then
|
|
aux.all.dur := aux.all.dur-Q;
|
|
Put_line(" n*" &Integer'Image(aux.all.num)& " :" &Integer'Image(aux.all.dur)& " ║"&Integer'Image(Q));
|
|
prev := aux;
|
|
aux := aux.all.next;
|
|
else
|
|
if(prev = NULL) then
|
|
Put_line(" n*" &Integer'Image(aux.all.num)& " : x ║" &Integer'Image(aux.all.dur));
|
|
-- prev stays NULL for it is now the first of the loop
|
|
-- also here we're supposed to free it
|
|
list.all.first := aux.all.next;
|
|
list.all.last.all.next:= aux;
|
|
aux := aux.all.next;
|
|
else
|
|
Put_line(" n*" &Integer'Image(aux.all.num)& " : x ║" &Integer'Image(aux.all.dur));
|
|
-- prev stays the same
|
|
prev.all.next := aux.all.next;
|
|
aux := aux.all.next;
|
|
end if;
|
|
remove := remove +1;
|
|
end if;
|
|
end loop;
|
|
list.all.num := list.all.num-remove;
|
|
end runsilent;
|
|
|
|
|
|
-- --== Remnant of the past took way too much display space ==--
|
|
|
|
-- procedure run(list : HlistC; Q : integer) is
|
|
-- aux: listc;
|
|
-- prev : listc := NULL;
|
|
-- Remove : Integer := 0 ; -- Number of processes to remove
|
|
-- L : Integer := 1;
|
|
-- begin
|
|
-- aux := list.all.first;
|
|
-- For L in 1..list.all.num loop
|
|
-- Put_line("number :" & integer'Image(aux.all.num));
|
|
-- if (aux.all.dur>Q) then
|
|
-- aux.all.dur := aux.all.dur-Q;
|
|
-- Put_line("process " &Integer'Image(aux.all.num)& " ran for " &Integer'Image(Q)& " tasks units and now still has "&Integer'Image(aux.all.dur)& " task units to perform");
|
|
-- prev := aux;
|
|
-- aux := aux.all.next;
|
|
-- else
|
|
-- if(prev = NULL) then
|
|
-- Put_line("process" &Integer'Image(aux.all.num)& " ran for" &Integer'Image(aux.all.dur)& " tasks and is finished");
|
|
-- -- prev stays NULL for it is now the first of the loop
|
|
-- -- also here we're supposed to free it
|
|
-- list.all.first := aux.all.next;
|
|
-- aux := aux.all.next;
|
|
-- else
|
|
-- Put_line("process " &Integer'Image(aux.all.num)& " ran for" &Integer'Image(aux.all.dur)& " tasks and is finished");
|
|
-- -- prev stays the same
|
|
-- prev.all.next := aux.all.next;
|
|
-- aux := aux.all.next;
|
|
-- end if;
|
|
-- remove := remove +1;
|
|
-- end if;
|
|
-- end loop;
|
|
-- list.all.num := list.all.num-remove;
|
|
-- end run;
|
|
|
|
procedure copy(l1,l2:Hlistc) is
|
|
I : Integer :=1;
|
|
aux1 : listc;
|
|
aux2 : listc;
|
|
add : listc;
|
|
|
|
|
|
|
|
begin -- we're actually leaving all the memory behind but well... we should free it
|
|
aux1 := l1.all.first;
|
|
l2.all.num := l1.all.num;
|
|
for L in 1..l1.all.num loop
|
|
if(L=1) then
|
|
l2.all.first:= new tasks'(L,aux1.all.num,l2.all.first);
|
|
aux2 := l2.all.first;
|
|
aux1:= aux1.all.next;
|
|
else
|
|
add:= new tasks'(L,aux1.all.num,l2.all.first);
|
|
aux1:= aux1.all.next;
|
|
aux2.all.next:= add;
|
|
aux2 := add;
|
|
if (L=l1.all.num) then
|
|
l2.all.last := aux2;
|
|
end if;
|
|
end if;
|
|
end loop;
|
|
end copy;
|
|
|
|
|
|
-- list1: list;
|
|
-- list2: list;
|
|
-- list3: list;
|
|
|
|
|
|
Q : Integer:= 0;
|
|
I : Integer:= 0;
|
|
stop:boolean := False;
|
|
list1 : Hlistc;
|
|
list2 : Hlistc;
|
|
begin
|
|
|
|
-- List3 := new cell'(3,NULL);
|
|
-- List2 := new cell'(2,List3);
|
|
-- List1 := new cell'(1,List2);
|
|
-- put_Line("afficher");
|
|
-- afficher(list1);
|
|
--
|
|
-- put_Line("afficherR");
|
|
-- afficherR(list1);
|
|
--
|
|
-- put_Line("afficherRrev");
|
|
-- afficherRrev(list1);
|
|
--
|
|
-- inserer(list1,4);
|
|
-- insererR(list1,5);
|
|
--
|
|
--
|
|
-- put_Line("afficher");
|
|
-- afficher(list1);
|
|
--
|
|
-- put_Line("afficherR");
|
|
-- afficherR(list1);
|
|
--
|
|
-- put_Line("afficherRrev");
|
|
-- afficherRrev(list1);
|
|
|
|
-- list1 := NULL;
|
|
-- list1 := saisir2;
|
|
-- afficher(list1);
|
|
|
|
list1:= new Hcell'(0,null,null);
|
|
list2:= new Hcell'(0,null,null);
|
|
addcirc(list1,list2);
|
|
displayc(list1);
|
|
displayc(list2);
|
|
while (not stop) loop
|
|
displaycsmall(list1);
|
|
Put_line("Please type the value of a quantum Q");
|
|
declare
|
|
s : string := get_line;
|
|
begin
|
|
Q := integer'Value(s);
|
|
while (list1.all.num > 0) loop
|
|
runsilent(list1,Q);
|
|
displayCsmall(list1);
|
|
end loop;
|
|
end;
|
|
Put_Line("press 1 if you want to try again with an other value for Q, anything else if you're good");
|
|
declare
|
|
Ans : Integer;
|
|
s: string := get_line;
|
|
begin
|
|
Ans := integer'Value(s);
|
|
if (Ans /= 1) then
|
|
stop := True;
|
|
else
|
|
copy(list2,list1);
|
|
end if;
|
|
end;
|
|
end loop;
|
|
end pointer;
|
|
|
|
|
|
|