173 lines
3.2 KiB
ObjectPascal
173 lines
3.2 KiB
ObjectPascal
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.
|