Newsgroup: it.comp.lang.pascal
Titolo: Turbo Pascal e l'inferno della memoria DOS

Ho realizzato, come esercizio di Programmazione II, un programma per la 
gestione di pile implementate con array. Volendo strafare, ho inserito 
un'opzione di compilazione per avere array di dimensioni illimitate, 
allocandoli e deallocandoli dinamicamente con GetMem e FreeMem. Avendo 
già realizzato qualcosa di simile senza problemi credevo di poterlo far 
funzionare anche stavolta. Invece succede sempre qualcosa di strano: 
elementi a caso dell'array vengono sovrascritti da valori assolutamente 
casuali. Solo il primo elemento (l'unico dichiarato esplicitamente) 
viene sempre preservato. In generale gli elementi dichiarati 
esplicitamente non vengono mai sovrascritti. Quelli "dichiarati" 
allocando memoria con GetMem, invece, pare vengano considerati "memoria 
libera" e abusati dal programma. Non posso sapere in quale punto del 
programma l'array viene sovrascritto, dato che il valutatore di 
espressioni mi mostra sempre e solo il primo elemento, quello dichiarato 
esplicitamente. Non solo, spesso la stessa GetMem (ma come l'hanno 
programmata???) sovrascrive aree contenenti codice eseguibile causando 
strani comportamenti del programma. La fregatura credo sia che la 
variabile risiede in una unit e non nel program - avrebbe senso la cosa?
Ecco a voi (la unit della gestione della pila è senza commenti, ma è 
abbastanza banale, non dovreste avere problemi ad orientarvi):
program stacka;
{ gestione pile con array - interfaccia utente }
uses
	astack, prog2ui;
begin
	{ inizializzazione }
	createS(pila);
	continua:= TRUE;
	while continua do begin	{ ciclo comandi }
		x:= 0;
		Write('comando: ');
		ReadLn(c);
		case c of
			'q': begin	{ interrompi }
				continua:= FALSE;
			end;
            'P': begin	{ push sullo stack }
				if fullS(pila) then
					WriteLn(
'Raggiunta massima capacita'' dello stack'
					)
				else begin
					Prompt('x: ', x);
					push(x, pila);
				end;
			end;
            'o': begin	{ pop dallo stack }
				if emptyS(pila) then
					WriteLn('Stack vuoto')
				else begin
    				pop(x, pila);
					WriteLn(x);
				end;
			end;
            't': begin	{ stampa cima dello stack }
				if emptyS(pila) then
					WriteLn('Stack vuoto')
				else
					WriteLn(topOf(pila));
			end;
            'p': begin	{ stampa stack }
				stampaS(pila);
			end;
			'?': begin	{ lista comandi }
				WriteLn('q'#$09'esci dal programma');
				WriteLn('P'#$09'push sullo stack');
				WriteLn('o'#$09'pop dallo stack');
				WriteLn('t'#$09'stampa cima dello stack');
				WriteLn('p'#$09'stampa stack');
				WriteLn('?'#$09'sommario comandi');
			end;
			else begin	{ tutti gli altri casi }
				WriteLn('comando non valido');
			end;
		end;
	end;
end.
unit astack;
{$DEFINE dynamic}
interface
	const
		{$IFDEF DYNAMIC}
		{$R-}
		{$ELSE}
		N = 10;
		{$ENDIF}
		Nullo = 0;
	type
		ElementT = Integer;
		{$IFDEF DYNAMIC}
		Elements = Array[1..10] of ElementT;
		{ pila dinamica - oltre alle dimensioni
		e all'array degli elementi conserviamo
		un puntatore all'array per le operazioni
		di allocazione della memoria}
		Stack = record
			top: Integer;
			elements: Elements;
			pElements: ^Elements;
		end;
	    {$ELSE}
		IndexT = 1..N;
		Stack = record
			top: Integer;
			elements: Array[IndexT] of ElementT;
		end;
		{$ENDIF}
	var
		pila: Stack;
		x: ElementT;
	procedure	createS	(var s: Stack);
	function	emptyS		(s: Stack): Boolean;
	function	fullS		(s: Stack): Boolean;
	procedure	push		(x: ElementT; var s: Stack);
	function	topOf		(s: Stack): ElementT;
	procedure	pop		(var x: ElementT; var s: Stack);
	procedure	stampaS	(s: Stack);
implementation
	procedure createS(var s: Stack);
		{$IFDEF DYNAMIC}
		{$ELSE}
		var i: IndexT;
		{$ENDIF}
	begin
		s.top:= 0;
		{$IFDEF DYNAMIC}
		s.pElements:= @s.elements;
		{$ELSE}
		for i:= 1 to N do
			s.elements[i]:= 0;
		{$ENDIF}
	end;
	function emptyS(s: Stack): Boolean;
	begin
		emptyS:= (s.top = 0);
	end;
	function fullS(s: Stack): Boolean;
	begin
		{$IFDEF DYNAMIC}
		fullS:= MaxAvail < ((s.top + 1) * SizeOf(ElementT));
		{$ELSE}
		fullS:= (s.top = N);
		{$ENDIF}
	end;
	procedure push(x: ElementT; var s: Stack);
	begin
		if not fullS(s) then begin
			s.top:= s.top + 1;
			{$IFDEF DYNAMIC}
			GetMem(s.pElements, s.top * SizeOf(ElementT));
			{$ENDIF}
			s.elements[s.top]:= x;
		end;
	end;
	function topOf(s: Stack): ElementT;
	begin
		topOf:= s.elements[s.top];
	end;
	procedure pop(var x: ElementT; var s: Stack);
	begin
		if not emptyS(s) then begin
			x:= s.elements[s.top];
			s.top:= s.top - 1;
			{$IFDEF DYNAMIC}
			if s.top > 0 then
			FreeMem(s.pElements, s.top * SizeOf(ElementT));
			{$ENDIF}
		end;
	end;
	procedure stampaS(s: Stack);
		{$IFDEF DYNAMIC}
		var i: Integer;
		{$ELSE}
		var i: IndexT;
		{$ENDIF}
	begin
		for i:= s.top downto 1 do
			WriteLn(s.elements[i]);
	end;
end.
unit prog2ui;
interface
    type
		ElementT = Integer;
	var
		continua, found: Boolean;	{ variabili del ciclo }
		c: Char;			{ carattere del comando }
	{ chiede all'utente un valore }
	procedure Prompt(prompt: String; var val: ElementT);
implementation
	procedure Prompt(prompt: String; var val: ElementT);
	begin
		Write(prompt);{ scrive la richiesta }
		ReadLn(val);	{ legge il valore }
	end;
end.

	s.pElements:=@s.elements;
 
Stai facendo una pre-allocazione dello stack con 10 elementi?
Questa e` programmazione sporca, non dovresti farlo. Vedi 4
Il mio consiglio e` di creare *una* sola versione del programma: o
allocazione statica o dinamica. Mischiandole hai fatto molta confusione.
ciao
Kronos
PS: ho qui un'implementazione di stack dinamico (in C pero`), se ti
interessa contattami in email.
-- 
Home: 
http://kronoz.cjb.net
Se il  destino di un uomo  e` annegare, anneghera` anche  in un bicchier
d'acqua.
Proverbio yddish

confusione. 
sě, ma nota gli $IFDEF
non sono mica lě per bellezza

 non sono mica li` per bellezza
Visti, pero` ribadisco la mia osservazione: stai facendo casino. In
particolare (con la correzione di Elements) tutti i riferimenti a
s.elementes[qualcosa] sono sbagliati.
Guarda questo:
{$X+}
var sp, size: integer;
    stackp: ^integer = nil;
    t:integer;
function push (el: integer): integer;
var tmp: ^integer;
begin
	if (stackp = nil) then
	begin
		{Init}
		size := 25;
 
		stackp := getmem(size * sizeof(integer));
		if (stackp = nil) then
			exit;
		sp := 0;
 
	end;
 
	sp := sp + 1;
 
	if (sp = size) then
	begin
		{stack pieno}
		var ptr: ^integer;
		var c: integer;
 
		size := size + 25;
		ptr := getmem(size * sizeof(integer));
		if (ptr = nil) then
			exit;
 
		for c := 0 to (size-25) - 1 do
			(ptr + c)^ := (stackp + c)^;
 
		freemem(stackp, (size - 25));
		stackp := ptr;
	end;
 
	tmp := stackp + sp;
	tmp^ := el;
 
	push := 1;
end;
function pop: integer;
var tmp: integer;
begin
	if (stackp = nil) then
	begin
		{Stack non ancora inizializzato}
		pop := 0;
		exit;
	end;
	tmp := (stackp + sp)^;
	sp := sp - 1;
	if (sp = 0) then
	begin
		{Finito libero memoria}
		freemem(stackp, size);
		stackp := nil;
	end;
	pop := tmp;
end;
begin
	for t:=1 to 30 do
		push(t);
	for t:=1 to 30 do
		writeln(pop);
 
	{Serve a pulire}
	writeln(pop);
end.
Occhio che uso le estensioni GNU, non e` ISO Pascal. Con qualche
variabile aggiuntiva e qualche typecast dovresti riuscire a renderlo un
po' piu` standard.
ciao
Kronos
-- 
Home: 
http://kronoz.cjb.net
I went to God just to see
And I was looking at me
Saw heaven and hell were lies
When I'm God everyone dies