All pastes #270004 Raw Edit

Someone

public text v1 · immutable
·published 2006-12-06 23:57 UTC
rendered paste body
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:=base(j)-newBase(j);
							for l in (base(j)+1)..top(j) loop
								staceSpace(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;
				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;