From abd24366c87b3d92585e310539681c054c32a6d0 Mon Sep 17 00:00:00 2001 From: Lacroix Raphael Date: Wed, 4 Nov 2020 22:07:21 +0100 Subject: [PATCH] added code --- pointer.adb | 471 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 471 insertions(+) create mode 100644 pointer.adb diff --git a/pointer.adb b/pointer.adb new file mode 100644 index 0000000..b2a72bc --- /dev/null +++ b/pointer.adb @@ -0,0 +1,471 @@ +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: HlistC) is + valuesR : returned3; + values : list; + L : Integer := 1; + add : listc; + auxc : 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; + 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); + auxc := listOut.all.first; + aux := values.all.next; + else + add:= new tasks'(L,aux.all.info,listOut.all.first); + aux:= aux.all.next; + auxc.all.next:= add; + auxc := add; + if (L=N) then + listOut.all.last := auxc; + 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; + + + + +-- list1: list; +-- list2: list; +-- list3: list; + + +Q : Integer:= 0; +I : Integer:= 0; +list1 : 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); + addcirc(list1); + displayc(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; +end pointer; + + +