with ada.text_io; use ada.text_io;
with ada.integer_text_io; use ada.integer_text_io;
procedure multistack is
type input is ( duckett, miller, adamson, vicars, lloyd, gonzales, frankenfield, robinson, boulware, sebesta, morgan, thompson, wimbush, graffo, carmona, binkley, hutson, moore, rutherford, reagan, rachelle, nothing);
package inputIO is new ada.text_io.enumeration_io(input); use inputIO;
procedure init is
m:integer:=0;
lNot:integer:=0;
n:integer:=0;
begin --init
put_line("::Mutilple Stack Management Program::");
put_line("Please enter stackSize::");
get(m);
put_line("Please enter number of stacks::");
get(n);
put_line("Please enter the value a L sub zero::");
get(lNot);
declare
procedure processStacks is
stackSpace:array(lNot..(m+lNot)) of input;
top:array(1..n) of integer;
oldTop:array(1..n) of integer;
base:array(1..(n+1)) of integer;
sNum:integer:=0;
inVal:input:=nothing;
type command is (push, pop, quit, nothing);
package commandIO is new ada.text_io.enumeration_io(command); use commandIO;
com:command:=nothing;
begin --processStacks
declare
function pop(k: in integer) return input is
y:input:=nothing;
begin
if top(k)=base(k) then
put("Underflow has occured, now printing::");
else
y:=stackSpace(top(k));
top(k):=top(k)-1;
end if;
return y;
end pop;
procedure reAllocate(k: in integer) is
growth:array(1..n) of integer;
newBase:array(1..n) of integer;
availSpace, totalnc, j:integer:=0;
sigma, tau, growthAllocate, alpha, beta:float:=0.0;
equalAllocate:float:=0.15;
minSpace:integer:=(n*11)/100; --allow integer data type to truncate for me
begin
declare
procedure moveStack is
d:integer:=0;
begin
-----MS1-----
for j in 2..n loop
if newBase(j)<base(j) then
d:=base(j)-newBase(j);
for l in (base(j)+1)..top(j) loop
stackSpace(l-d):=stackSpace(l);
end loop;
base(j):=newBase(j);
top(j):=top(j)-d;
end if;
end loop;
-----MS2-----
for j in n..2 loop
if newBase(j)>base(j) then
d:=newBase(j)-base(j);
for l in top(j)..(base(j)-1) loop
stackSpace(l+d):=stackSpace(l);
end loop;
base(j):=newBase(j);
top(j):=top(j)+d;
end if;
end loop;
end moveStack;
begin
-----RA1-----
AvailSpace:=m;
j:=n;
totalnc:=0;
while j>0 loop
availSpace:=availSpace - (top(j)-base(j));
if top(j) > oldTop(j) then
growth(j):= top(j)-oldTop(j);
totalnc:=totalnc+growth(j);
else
growth(j):=0;
end if;
j:=j-1;
end loop;
-----RA2-----
if availSpace < (minSpace-1) then
put_line("Insufficient memory for re-packing, now halting");
raise program_error;
end if;
-----RA3-----
GrowthAllocate := float(1)-EqualAllocate;
alpha:=equalAllocate*float(availSpace)/float(n);
-----RA4-----
beta:=growthAllocate*float(availSpace)/float(totalnc);
-----RA5-----
newBase(1):=base(1); sigma:=0.0;
for j in 2..n loop
Tau:= sigma + alpha + float(growth(j-1)) * beta;
newBase(j):=newBase(j-1)+(top(j-1)-base(j-1)) + integer(float'floor(tau)) - integer(float'floor(sigma));
sigma:=tau;
end loop;
-----RA6-----
top(k):=top(k)-1;
moveStack;
top(k):=top(k)+1;
for j in 1..n loop
oldTop(j):=top(j);
end loop;
end;
end reAllocate;
procedure push(k: in out integer; y: in input) is
temp:integer:=0;
begin
top(k):=top(k)+1;
if top(k) > base(k+1) then
put_line("Overflow occured, now calculating new memory allocation");
put_line("Core Dump::");
temp:=top(k);
for x in (base(k))..(top(k)-1) loop
put(stackSpace(x)); new_line;
end loop;
reAllocate(k);
else
stackSpace(top(k)):=y;
end if;
end push;
begin
for j in 1..n loop
base(j) := integer(float'floor(float((j-1))/float(n)*float(m)))+lNot;
-- put(base(j));
top(j) := integer(float'floor(float((j-1))/float(n)*float(m)))+lNot;
-- put(top(j));
oldTop(j):=top(j);
end loop;
loop
put_line("Enter command (push, pop, or quit)");
put("::");
get(com);
if com = quit then
exit;
elsif com = push then
put("Enter stack to push onto::");
get(sNum);
new_line;
put("Enter element::");
get(inVal);
new_line;
push(sNum, inVal);
elsif com = pop then
put("Enter which stack to pop::");
new_line;
get(sNum);
put(pop(sNum)); new_line;
end if;
end loop;
end;
end processStacks;
begin
processStacks;
end;
end init;
begin
init;
end multiStack;