changemem: program to change heap/stack size in program files

progs/changemem.pas

@@ -0,0 +1,173 @@
+program changemem;
+const ProgramMagic = $00100AFE;
+type ProgramHeader = record
+		magic:integer;
+		heapSize:integer;
+		stackSize:integer;
+		mainPtr:integer;
+	end;
+
+var filename:string;
+    h:ProgramHeader;
+
+procedure showHex(value:integer);
+var i:integer;
+    digit:integer;
+    digits:array[1..8] of char;
+    ch:char;
+begin
+	for i := 1 to 8 do
+	begin
+		digit := value and 15;
+		value := value shr 4;
+
+		if digit < 10 then
+			ch := chr(digit + ord('0'))
+		else
+			ch := chr(digit - 10 + ord('A'));
+		digits[i] := ch;
+	end;
+	for i := 8 downto 1 do
+		write(digits[i]);
+end;
+
+procedure showValue(labl:string; value:integer);
+begin
+	write(labl:20, ' ');
+	write(value:8, ' (');
+	showHex(value);
+	writeln(')');
+end;
+
+procedure showHeader(var h:ProgramHeader);
+begin
+	showValue('heap size', h.heapSize);
+	showValue('stack size', h.stackSize);
+	showValue('main entry point', h.mainPtr);
+end;
+
+procedure readHeader(var filename:string;var h:ProgramHeader);
+var f:file;
+begin
+	writeln('reading file ', filename);
+	open(f, filename, ModeReadOnly);
+	if IOResult(f) <> 0 then
+	begin
+		writeln('Error opening file: ', ErrorStr(IOResult(f)));
+		halt;
+	end
+	else
+	begin
+		read(f, h);
+		if IOResult(f) <> 0 then
+		begin
+			writeln('Error reading header: ', ErrorStr(IOResult(f)));
+			halt;
+		end;
+		close(f);
+	end;
+end;
+
+procedure writeHeader(var filename:string;var h:ProgramHeader);
+var f:file;
+begin
+	writeln('writing file ', filename);
+	open(f, filename, ModeModify);
+	if IOResult(f) <> 0 then
+	begin
+		writeln('Error opening file: ', ErrorStr(IOResult(f)));
+		halt;
+	end
+	else
+	begin
+		write(f, h);
+		if IOResult(f) <> 0 then
+		begin
+			writeln('Error writing header: ', ErrorStr(IOResult(f)));
+			halt;
+		end;
+		close(f);	
+	end;
+end;
+
+procedure modifyHeader(var filename:string;var h:ProgramHeader);
+var done:boolean;
+    ch:char;
+    changed:boolean;
+
+	function getNewValue(descr:string):integer;
+	var buf:string;
+	    v,e:integer;
+	begin
+		getNewValue := 0;
+		write('New ',descr, ' size (decimal)> ');
+		readln(buf);
+		val(buf, v, e);
+		if(e > 0 ) or (v <= 0) then
+			writeln('invalid size')
+		else
+			getNewValue := v;
+	end;
+	
+	procedure changeStackSize;
+	var v:integer;
+	begin
+		v := getNewValue('stack');
+		if v > 0 then
+		begin
+			h.stackSize := v;
+			changed := true;
+		end;	
+	end;
+
+	procedure changeHeapSize;
+	var v:integer;
+	begin
+		v := getNewValue('heap');
+		if v > 0 then
+		begin
+			h.heapSize := v;
+			changed := true;
+		end;
+	end;
+
+begin
+	changed := false; done := false;
+
+	while not done do
+	begin
+		writeln(filename, ' header:');
+		showHeader(h);
+		writeln('Change H)eap size   Change S)tack size   eX)it');
+		write('> ');
+		read(ch);
+		writeln;
+		case upcase(ch) of
+		'S': changeStackSize;
+		'H': changeHeapSize;
+		'X': done := true;
+		else
+			writeln('invalid command');
+		end;
+	end;
+
+	if changed then
+		writeHeader(filename, h);
+end;
+
+begin
+	if ParamCount > 0 then
+		filename := ParamStr(1)
+	else
+	begin
+		write('File name> ');
+		readln(filename);
+	end;
+
+	readHeader(filename, h);
+
+	if h.magic <> ProgramMagic then
+		writeln('invalid magic value ', h.magic)
+	else
+		modifyHeader(filename, h);
+end.