mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-13 13:09:16 +02:00
* Final merges from trunk
git-svn-id: branches/fixes_2_0@3577 -
This commit is contained in:
daniel
parent
39b4d1f6d8
commit
304fc72b67
16
fv/app.pas
16
fv/app.pas
@ -1030,14 +1030,9 @@ var s:string;
|
||||
BEGIN { Compatability only }
|
||||
DoneSysError;
|
||||
DoneEvents;
|
||||
<<<<<<< .working
|
||||
drivers.donevideo;
|
||||
drivers.donekeyboard;
|
||||
{ DoneDosMem;}
|
||||
=======
|
||||
DoneScreen;
|
||||
{ DoneDosMem;}
|
||||
>>>>>>> .merge-right.r2720
|
||||
WriteShellMsg;
|
||||
{$ifdef Unix}
|
||||
s:=getenv('SHELL');
|
||||
@ -1048,22 +1043,11 @@ BEGIN { Compatability only }
|
||||
SwapVectors;
|
||||
Exec(GetEnv('COMSPEC'), '');
|
||||
SwapVectors;
|
||||
<<<<<<< .working
|
||||
<<<<<<< .working
|
||||
=======
|
||||
{$endif}
|
||||
>>>>>>> .merge-right.r3452
|
||||
{ InitDosMem;}
|
||||
drivers.initkeyboard;
|
||||
drivers.initvideo;
|
||||
<<<<<<< .working
|
||||
=======
|
||||
{ InitDosMem;}
|
||||
InitScreen;
|
||||
>>>>>>> .merge-right.r2720
|
||||
=======
|
||||
InitScreen;
|
||||
>>>>>>> .merge-right.r3455
|
||||
InitEvents;
|
||||
InitSysError;
|
||||
Redraw;
|
||||
|
||||
@ -1031,8 +1031,9 @@ function TDebugController.GetPointerAt(addr : CORE_ADDR) : CORE_ADDR;
|
||||
var
|
||||
st : string;
|
||||
p : longint;
|
||||
code : integer;
|
||||
begin
|
||||
Command('x /wx 0x'+hexstr(longint(addr),8));
|
||||
Command('x /wx 0x'+hexstr(PtrInt(addr),sizeof(PtrInt)*2));
|
||||
st:=strpas(GetOutput);
|
||||
p:=pos(':',st);
|
||||
while (p<length(st)) and (st[p+1] in [' ',#9]) do
|
||||
@ -1044,7 +1045,7 @@ begin
|
||||
while (st[p] in ['0'..'9','A'..'F','a'..'f']) do
|
||||
inc(p);
|
||||
Delete(st,p,High(st));
|
||||
GetPointerAt:=HexToCard(st);
|
||||
Val('$'+st,GetPointerAt,code);
|
||||
end;
|
||||
|
||||
procedure TDebugController.DoSelectSourceLine(const fn:string;line:longint);
|
||||
@ -1193,7 +1194,7 @@ begin
|
||||
begin
|
||||
if (ExitCode<>0) or (ExitAddr<>0) then
|
||||
WarningBox(#3'Run Time Error '+IntToStr(ExitCode)+#13+
|
||||
#3'Error address $'+IntToHex(ExitAddr,8),nil)
|
||||
#3'Error address $'+HexStr(ExitAddr,8),nil)
|
||||
else
|
||||
WarningBox(#3'Run Time Error',nil);
|
||||
end
|
||||
@ -1714,6 +1715,8 @@ procedure TBreakpointCollection.ShowBreakpoints(W : PFPWindow);
|
||||
PDL : PDisasLine;
|
||||
S : string;
|
||||
ps,qs,i : longint;
|
||||
HAddr : PtrInt;
|
||||
code : integer;
|
||||
begin
|
||||
for i:=0 to PDisassemblyWindow(W)^.Editor^.GetLineCount-1 do
|
||||
begin
|
||||
@ -1732,7 +1735,8 @@ procedure TBreakpointCollection.ShowBreakpoints(W : PFPWindow);
|
||||
end
|
||||
else
|
||||
begin
|
||||
If (P^.typ=bt_address) and (PDL^.Address=HexToCard(P^.Name^)) then
|
||||
Val('$'+P^.Name^,HAddr,code);
|
||||
If (P^.typ=bt_address) and (PDL^.Address=HAddr) then
|
||||
PDisassemblyWindow(W)^.Editor^.SetLineFlagState(i,lfBreakpoint,P^.state=bs_enabled);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -213,33 +213,34 @@ begin
|
||||
PaletteToStr:=C;
|
||||
end;
|
||||
|
||||
function StrToPalette(S: string): string;
|
||||
var I,P,X: integer;
|
||||
C: string;
|
||||
Hex: boolean;
|
||||
OK: boolean;
|
||||
function strtopalette(S: string): string;
|
||||
|
||||
{Converts a string in palette string format, i.e #$41#$42#$43 or
|
||||
#65#66#67 to an actual format.}
|
||||
|
||||
var i,p,x,len:byte;
|
||||
code:integer;
|
||||
|
||||
begin
|
||||
C:=''; I:=1;
|
||||
OK:=S<>'';
|
||||
while OK and (I<=length(S)) and (S[I]='#') do
|
||||
begin
|
||||
Inc(I); Hex:=false;
|
||||
if S[I]='$' then begin Inc(I); Hex:=true; end;
|
||||
P:=Pos('#',copy(S,I,High(S))); if P>0 then P:=I+P-1 else P:=length(S)+1;
|
||||
if Hex=false then
|
||||
begin
|
||||
X:=StrToInt(copy(S,I,P-I));
|
||||
OK:=(LastStrToIntResult=0) and (0<=X) and (X<=High(S));
|
||||
end
|
||||
else
|
||||
begin
|
||||
X:=HexToInt(copy(S,I,P-I));
|
||||
OK:=(LastHexToIntResult=0) and (0<=X) and (X<=255);
|
||||
end;
|
||||
if OK then C:=C+chr(X);
|
||||
Inc(I,P-I);
|
||||
end;
|
||||
StrToPalette:=C;
|
||||
i:=1;
|
||||
len:=0;
|
||||
while (i<=length(S)) and (s[i]='#') do
|
||||
begin
|
||||
s[i]:=#0;
|
||||
inc(i);
|
||||
p:=pos('#',s);
|
||||
if p=0 then
|
||||
p:=length(s)
|
||||
else
|
||||
p:=p-i;
|
||||
val(copy(s,i,p),x,code); {Val supports hexadecimal.}
|
||||
if code<>0 then
|
||||
break;
|
||||
inc(len);
|
||||
strtopalette[len]:=char(X);
|
||||
inc(i,p);
|
||||
end;
|
||||
strtopalette[0]:=char(len);
|
||||
end;
|
||||
|
||||
{$ifndef NODEBUG}
|
||||
|
||||
@ -75,7 +75,7 @@ var R,R2,R3,TabR,TabIR: TRect;
|
||||
Label31,Label41,
|
||||
Label51,Label52,Label53: PLabel;
|
||||
begin
|
||||
R.Assign(0,0,72,21);
|
||||
R.Assign(0,0,76,21);
|
||||
New(D, Init(R, dialog_compilerswitches));
|
||||
with D^ do
|
||||
begin
|
||||
@ -171,10 +171,11 @@ begin
|
||||
Dec(R2.A.Y);
|
||||
R2.B.Y:=R2.A.Y+1;
|
||||
|
||||
{ --- Sheet 3 --- }
|
||||
Count:=ProcessorSwitches^.ItemCount;
|
||||
R2.Copy(TabIR);
|
||||
R2.B.X:=R2.A.X+(R2.B.X-R2.A.X) div 2-2;
|
||||
Inc(R2.A.Y,CodegenSwitches^.ItemCount+2);
|
||||
R.Copy(TabIR);
|
||||
R2.Copy(R);
|
||||
R2.B.X:=R2.A.X+(R2.B.X-R2.A.X) div 2;
|
||||
R2.B.Y:=R2.A.Y+Count;
|
||||
Items:=nil;
|
||||
for I:=Count-1 downto 0 do
|
||||
@ -280,10 +281,12 @@ begin
|
||||
NewTabItem(CB3,
|
||||
NewTabItem(Label22,
|
||||
NewTabItem(CB2,
|
||||
NewTabItem(Label23,
|
||||
NewTabItem(RB3,
|
||||
nil))))),
|
||||
NewTabDef('~P~rocessor',RB1,
|
||||
NewTabItem(Label23,
|
||||
NewTabItem(RB1,
|
||||
nil))))))),
|
||||
nil)),
|
||||
NewTabDef(page_compiler_verbose,CB4,
|
||||
NewTabItem(Label31,
|
||||
NewTabItem(CB4,
|
||||
@ -300,7 +303,7 @@ begin
|
||||
NewTabItem(Label53,
|
||||
NewTabItem(RB6,
|
||||
nil)))))),
|
||||
nil)))))));
|
||||
nil))))))));
|
||||
Tab^.GrowMode:=0;
|
||||
Insert(Tab);
|
||||
|
||||
|
||||
@ -395,7 +395,7 @@ begin
|
||||
begin
|
||||
if PDL^.Address<>0 then
|
||||
begin
|
||||
Debugger^.Command('tbreak *0x'+IntToHex(PDL^.Address,8));
|
||||
Debugger^.Command('tbreak *0x'+HexStr(PDL^.Address,sizeof(pointer)*2));
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -486,7 +486,7 @@ begin
|
||||
begin
|
||||
if PDL^.Address<>0 then
|
||||
begin
|
||||
PB:=New(PBreakpoint,init_address(IntToHex(PDL^.Address,8)));
|
||||
PB:=New(PBreakpoint,init_address(HexStr(PDL^.Address,sizeof(pointer)*2)));
|
||||
BreakpointsCollection^.Insert(PB);
|
||||
WD^.Editor^.SetLineFlagState(CurY,lfBreakpoint,true);
|
||||
end
|
||||
|
||||
@ -144,8 +144,6 @@ function StrToInt(const S: string): longint;
|
||||
function StrToCard(const S: string): cardinal;
|
||||
function FloatToStr(D: Double; Decimals: byte): string;
|
||||
function FloatToStrL(D: Double; Decimals: byte; MinLen: byte): string;
|
||||
function HexToInt(S: string): longint;
|
||||
function HexToCard(S: string): cardinal;
|
||||
function GetStr(P: PString): string;
|
||||
function GetPChar(P: PChar): string;
|
||||
function BoolToStr(B: boolean; const TrueS, FalseS: string): string;
|
||||
@ -467,42 +465,6 @@ begin
|
||||
StrToCard:=L;
|
||||
end;
|
||||
|
||||
function HexToInt(S: string): longint;
|
||||
var L,I: longint;
|
||||
C: char;
|
||||
const HexNums: string[16] = '0123456789ABCDEF';
|
||||
begin
|
||||
S:=Trim(S); L:=0; I:=1; LastHexToIntResult:=0;
|
||||
while (I<=length(S)) and (LastHexToIntResult=0) do
|
||||
begin
|
||||
C:=Upcase(S[I]);
|
||||
if C in['0'..'9','A'..'F'] then
|
||||
begin
|
||||
L:=L*16+(Pos(C,HexNums)-1);
|
||||
end else LastHexToIntResult:=I;
|
||||
Inc(I);
|
||||
end;
|
||||
HexToInt:=L;
|
||||
end;
|
||||
|
||||
function HexToCard(S: string): cardinal;
|
||||
var L,I: cardinal;
|
||||
C: char;
|
||||
const HexNums: string[16] = '0123456789ABCDEF';
|
||||
begin
|
||||
S:=Trim(S); L:=0; I:=1; LastHexToCardResult:=0;
|
||||
while (I<=length(S)) and (LastHexToCardResult=0) do
|
||||
begin
|
||||
C:=Upcase(S[I]);
|
||||
if C in['0'..'9','A'..'F'] then
|
||||
begin
|
||||
L:=L*16+(Pos(C,HexNums)-1);
|
||||
end else LastHexToCardResult:=I;
|
||||
Inc(I);
|
||||
end;
|
||||
HexToCard:=L;
|
||||
end;
|
||||
|
||||
function FloatToStr(D: Double; Decimals: byte): string;
|
||||
var S: string;
|
||||
L: byte;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user