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; 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); processStacks; declare procedure processStacks is stackSpace:array(1..m) 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 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_line(stackSpace(x)); end loop; reAllocate(k); else stackSpace(tok(k)):=y; end if; end push; function pop(k: in integer) return input is y:input:=nothing; begin if top(k)=base(k) then put("Overflow 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:=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; end; -----RA1----- AvailSpace:=m; j:=n; 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:=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 := 1-EqualAllocate; alpha:=integerequalAllocate*availSpace/float(n); -----RA4----- beta:=growthAllocate*availSpace/float(totalnc); -----RA5----- newBase(1):=base(1); sigma:=0.0; for j:=2..n loop Tau:= sigma + alpha + growth(j-1) * beta; newBase:=newBase(j-1)+(top(j-1)-base(j-1)) + float_type'floor(tau) - float_type'floor(sigma); sigma:=tau; end loop; -----RA6----- top(k):=top(k):=top(k)-1; moveStack; top(k):=top(k)+1; for j in 1..n loop oldTop(j):=top(j); end loop; end reAllocate; end; for j in 1..n loop base(j):=top(j):= float_type'floor(float((j-1)/n*m)); oldTop:=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_line(pop(sNum)); end if; end loop; end processStacks; end; end init; begin init; end multiStack;