* removed warnings

This commit is contained in:
peter 1999-04-08 11:30:57 +00:00
parent b3c0d3b03c
commit 17f26f6577
8 changed files with 89 additions and 68 deletions

View File

@ -516,6 +516,10 @@ end;
function strpas(p:pchar):string;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; function strpas(p:pchar):string;[public,alias:'FPC_PCHAR_TO_SHORTSTR'];
begin begin
{$ifndef NEWATT}
{ remove warning }
strpas:='';
{$endif}
asm asm
cld cld
movl p,%edi movl p,%edi
@ -525,8 +529,7 @@ begin
repne repne
scasb scasb
movl %ecx,%eax movl %ecx,%eax
{$ifdef NEWATT}
{$ifdef NEWATT1}
movl __RESULT,%edi movl __RESULT,%edi
{$else} {$else}
movl 8(%ebp),%edi movl 8(%ebp),%edi
@ -769,7 +772,10 @@ end;
{ {
$Log$ $Log$
Revision 1.42 1999-04-07 16:21:10 pierre Revision 1.43 1999-04-08 11:30:57 peter
* removed warnings
Revision 1.42 1999/04/07 16:21:10 pierre
+ no assembler if systemdebug defined + no assembler if systemdebug defined
Revision 1.41 1999/03/01 15:40:55 peter Revision 1.41 1999/03/01 15:40:55 peter

View File

@ -17,6 +17,9 @@
function strpas(p : pchar) : string; function strpas(p : pchar) : string;
begin begin
{$ifndef NEWATT}
strpas:='';
{$endif}
asm asm
cld cld
movl p,%edi movl p,%edi
@ -74,7 +77,10 @@ end ['EDI','ESI','EBX','EAX','ECX'];
{ {
$Log$ $Log$
Revision 1.4 1999-03-30 16:58:51 peter Revision 1.5 1999-04-08 11:30:58 peter
* removed warnings
Revision 1.4 1999/03/30 16:58:51 peter
* use assembler and remove all rets * use assembler and remove all rets
Revision 1.3 1999/03/01 15:41:01 peter Revision 1.3 1999/03/01 15:41:01 peter

View File

@ -18,8 +18,8 @@
****************************************************************************} ****************************************************************************}
Const Const
{ Type of exception. Currently only one. } { Type of exception. Currently only one. }
FPC_EXCEPTION = 1; FPC_EXCEPTION = 1;
{ types of frames for the exception address stack } { types of frames for the exception address stack }
cExceptionFrame = 1; cExceptionFrame = 1;
@ -42,7 +42,7 @@ Type
TExceptObjectClass = Class of TObject; TExceptObjectClass = Class of TObject;
Const Const
CatchAllExceptions = -1; CatchAllExceptions = -1;
Var ExceptAddrStack : PExceptAddr; Var ExceptAddrStack : PExceptAddr;
@ -50,10 +50,10 @@ Var ExceptAddrStack : PExceptAddr;
Function PushExceptAddr (Ft: Longint): PJmp_buf ;[Public, Alias : 'FPC_PUSHEXCEPTADDR']; Function PushExceptAddr (Ft: Longint): PJmp_buf ;[Public, Alias : 'FPC_PUSHEXCEPTADDR'];
var Buf : PJmp_buf; var Buf : PJmp_buf;
NewAddr : PExceptAddr; NewAddr : PExceptAddr;
begin begin
{$ifdef excdebug} {$ifdef excdebug}
writeln ('In PushExceptAddr'); writeln ('In PushExceptAddr');
@ -78,9 +78,9 @@ end;
Procedure PushExceptObj (Obj : TObject; AnAddr : Pointer); Procedure PushExceptObj (Obj : TObject; AnAddr : Pointer);
var var
Newobj : PExceptObject; Newobj : PExceptObject;
begin begin
{$ifdef excdebug} {$ifdef excdebug}
writeln ('In PushExceptObject'); writeln ('In PushExceptObject');
@ -115,6 +115,7 @@ begin
{$ifdef excdebug} {$ifdef excdebug}
writeln ('In RaiseException'); writeln ('In RaiseException');
{$endif} {$endif}
Raiseexcept:=nil;
PushExceptObj(Obj,AnAddr); PushExceptObj(Obj,AnAddr);
If ExceptAddrStack=Nil then If ExceptAddrStack=Nil then
DoUnhandledException (Obj,AnAddr); DoUnhandledException (Obj,AnAddr);
@ -172,8 +173,8 @@ begin
begin begin
Writeln ('Internal error.'); Writeln ('Internal error.');
halt (255); halt (255);
end; end;
if Not ((Objtype = TExceptObjectClass(CatchAllExceptions)) or if Not ((Objtype = TExceptObjectClass(CatchAllExceptions)) or
(ExceptObjectStack^.FObject is ObjType)) then (ExceptObjectStack^.FObject is ObjType)) then
Catches:=Nil Catches:=Nil
else else

View File

@ -4,7 +4,7 @@
Copyright (c) 1998 by the Free Pascal development team Copyright (c) 1998 by the Free Pascal development team
Disk functions from Delphi's sysutils.pas Disk functions from Delphi's sysutils.pas
See the file COPYING.FPC, included in this distribution, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
@ -80,6 +80,7 @@ Function SetCurrentDir (Const NewDir : String) : Boolean;
begin begin
ChDir (NewDir); ChDir (NewDir);
SetCurrentDir:=true;
end; end;
@ -87,6 +88,7 @@ Function CreateDir (Const NewDir : String) : Boolean;
begin begin
MkDir (NewDir); MkDir (NewDir);
CreateDir:=true;
end; end;
@ -94,13 +96,17 @@ Function RemoveDir (Const Dir : String) : Boolean;
begin begin
ChDir (Dir); ChDir (Dir);
RemoveDir:=true;
end; end;
{ {
$Log$ $Log$
Revision 1.1 1998-10-11 13:42:04 michael Revision 1.2 1999-04-08 11:31:00 peter
* removed warnings
Revision 1.1 1998/10/11 13:42:04 michael
+ Added disk and directory functions + Added disk and directory functions
} }

View File

@ -116,6 +116,7 @@ Var SInfo : Stat;
TAttr : Longint; TAttr : Longint;
begin begin
TAttr:=$ffffffff;
P:=pglob(Info.FindHandle); P:=pglob(Info.FindHandle);
Result:=Fstat(p^.name,SInfo); Result:=Fstat(p^.name,SInfo);
Info.FindHandle:=Longint(P^.Next); Info.FindHandle:=Longint(P^.Next);
@ -208,6 +209,7 @@ Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
begin begin
//!! Still Needs doing //!! Still Needs doing
Result:=0;
end; end;
@ -220,8 +222,6 @@ end;
Function RenameFile (Const OldName, NewName : String) : Boolean; Function RenameFile (Const OldName, NewName : String) : Boolean;
Var P1,P2 : String;
begin begin
RenameFile:=Linux.FRename(OldNAme,NewName); RenameFile:=Linux.FRename(OldNAme,NewName);
end; end;
@ -267,12 +267,15 @@ end;
Procedure InitInternational; Procedure InitInternational;
begin begin
InitAnsi; InitAnsi;
end; end;
{ {
$Log$ $Log$
Revision 1.8 1999-02-28 13:18:10 michael Revision 1.9 1999-04-08 11:31:01 peter
* removed warnings
Revision 1.8 1999/02/28 13:18:10 michael
+ Added internationalization support + Added internationalization support
Revision 1.7 1999/02/24 15:57:29 michael Revision 1.7 1999/02/24 15:57:29 michael

View File

@ -58,8 +58,8 @@ function DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp;
begin begin
result.Time := Trunc(Frac(DateTime) * MSecsPerDay); result.Time := Trunc(Frac(DateTime) * MSecsPerDay);
result.Date := 1 result.Date := 1
+ DateDelta + DateDelta
+ Trunc(System.Int(DateTime)); + Trunc(System.Int(DateTime));
end ; end ;
@ -111,7 +111,6 @@ const
D100 = D4 * 25 - 1; { number of days in 100 years } D100 = D4 * 25 - 1; { number of days in 100 years }
D400 = D100 * 4 + 1; { number of days in 400 years } D400 = D100 * 4 + 1; { number of days in 400 years }
var var
i:Longint;
l:longint; l:longint;
ly:boolean; ly:boolean;
begin begin
@ -131,8 +130,6 @@ end ;
Hour, Minute, Second and MilliSecond } Hour, Minute, Second and MilliSecond }
procedure DecodeTime(Time: TDateTime; var Hour, Minute, Second, MilliSecond: word); procedure DecodeTime(Time: TDateTime; var Hour, Minute, Second, MilliSecond: word);
var l:TDateTime;
begin begin
{ l := Trunc(Frac(time) * MSecsPerDay); { l := Trunc(Frac(time) * MSecsPerDay);
Hour := l div 3600000;l := l mod 3600000; Hour := l div 3600000;l := l mod 3600000;
@ -305,7 +302,7 @@ else if (df = 'M/D/Y') then begin
else if (df = 'Y/M/D') then begin else if (df = 'Y/M/D') then begin
if (n = 3) then begin if (n = 3) then begin
y := values[0]; y := values[0];
m := values[1]; m := values[1];
d := values[2]; d := values[2];
end end
else if (n = 2) then begin else if (n = 2) then begin
@ -334,7 +331,8 @@ var
Len, Current: integer; PM: boolean; Len, Current: integer; PM: boolean;
function GetElement: integer; function GetElement: integer;
var i, j: integer; c: word; var
j: integer; c: word;
begin begin
result := -1; result := -1;
Inc(Current); Inc(Current);
@ -581,7 +579,7 @@ Var YY,MM,DD,H,m,s,msec : Word;
begin begin
Decodedate (DateTime,YY,MM,DD); Decodedate (DateTime,YY,MM,DD);
If (YY<1980) or (YY>2099) then If (YY<1980) or (YY>2099) then
Result:=0 Result:=0
else else
begin begin
@ -605,7 +603,10 @@ end;
{ {
$Log$ $Log$
Revision 1.8 1999-02-24 15:56:28 michael Revision 1.9 1999-04-08 11:31:02 peter
* removed warnings
Revision 1.8 1999/02/24 15:56:28 michael
+ Small fixes. Moved getlocaltime to system-dependent files + Small fixes. Moved getlocaltime to system-dependent files
Revision 1.7 1999/02/10 22:15:10 michael Revision 1.7 1999/02/10 22:15:10 michael

View File

@ -94,7 +94,7 @@ end;
S1 = S2 = 0 } S1 = S2 = 0 }
function CompareStr(const S1, S2: string): Integer; function CompareStr(const S1, S2: string): Integer;
var i, count, count1, count2: integer; var count, count1, count2: integer;
begin begin
result := 0; result := 0;
Count1 := Length(S1); Count1 := Length(S1);
@ -184,26 +184,32 @@ end ;
function AnsiCompareStr(const S1, S2: string): integer; function AnsiCompareStr(const S1, S2: string): integer;
begin begin
result:=0;
end ; end ;
function AnsiCompareText(const S1, S2: string): integer; function AnsiCompareText(const S1, S2: string): integer;
begin begin
result:=0;
end ; end ;
function AnsiStrComp(S1, S2: PChar): integer; function AnsiStrComp(S1, S2: PChar): integer;
begin begin
result:=0;
end ; end ;
function AnsiStrIComp(S1, S2: PChar): integer; function AnsiStrIComp(S1, S2: PChar): integer;
begin begin
result:=0;
end ; end ;
function AnsiStrLComp(S1, S2: PChar; MaxLen: cardinal): integer; function AnsiStrLComp(S1, S2: PChar; MaxLen: cardinal): integer;
begin begin
result:=0;
end ; end ;
function AnsiStrLIComp(S1, S2: PChar; MaxLen: cardinal): integer; function AnsiStrLIComp(S1, S2: PChar; MaxLen: cardinal): integer;
begin begin
result:=0;
end ; end ;
function AnsiStrLower(Str: PChar): PChar; function AnsiStrLower(Str: PChar): PChar;
@ -230,10 +236,12 @@ end ;
function AnsiLastChar(const S: string): PChar; function AnsiLastChar(const S: string): PChar;
begin begin
result:=nil;
end ; end ;
function AnsiStrLastChar(Str: PChar): PChar; function AnsiStrLastChar(Str: PChar): PChar;
begin begin
result:=nil;
end ; end ;
{==============================================================================} {==============================================================================}
@ -419,6 +427,7 @@ end ;
function LoadStr(Ident: integer): string; function LoadStr(Ident: integer): string;
begin begin
result:='';
end ; end ;
{ FmtLoadStr returns the string resource Ident and formats it accordingly } { FmtLoadStr returns the string resource Ident and formats it accordingly }
@ -426,6 +435,7 @@ end ;
function FmtLoadStr(Ident: integer; const Args: array of const): string; function FmtLoadStr(Ident: integer; const Args: array of const): string;
begin begin
result:='';
end; end;
Const Const
@ -970,7 +980,10 @@ const
{ {
$Log$ $Log$
Revision 1.16 1999-04-08 10:19:41 peter Revision 1.17 1999-04-08 11:31:03 peter
* removed warnings
Revision 1.16 1999/04/08 10:19:41 peter
* pchar support for %s * pchar support for %s
Revision 1.15 1999/04/04 10:19:07 peter Revision 1.15 1999/04/04 10:19:07 peter

View File

@ -197,27 +197,21 @@ unit typinfo;
{$ASMMODE ATT} {$ASMMODE ATT}
function CallIntegerFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Integer;assembler; function CallIntegerFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Integer;assembler;
Label LINoPush;
asm asm
movl S,%esi movl S,%esi
movl Address,%edi movl Address,%edi
// ? Indexed function // ? Indexed function
movl Index,%eax movl Index,%eax
xorl %eax,%eax xorl %eax,%eax
jnz LINoPush jnz .LINoPush
movl IValue,%eax movl IValue,%eax
pushl %eax pushl %eax
LINoPush: .LINoPush:
call (%edi) call (%edi)
// now the result should be in EAX, untested yet (FK) // now the result should be in EAX, untested yet (FK)
end; end;
function CallIntegerProc(s : Pointer;Address : Pointer;Value : Integer; INdex,IVAlue : Longint) : Integer;assembler; function CallIntegerProc(s : Pointer;Address : Pointer;Value : Integer; INdex,IVAlue : Longint) : Integer;assembler;
label LIPNoPush;
asm asm
movl S,%esi movl S,%esi
movl Address,%edi movl Address,%edi
@ -227,36 +221,30 @@ unit typinfo;
// ? Indexed procedure // ? Indexed procedure
movl Index,%eax movl Index,%eax
xorl %eax,%eax xorl %eax,%eax
jnz LIPNoPush jnz .LIPNoPush
movl IValue,%eax movl IValue,%eax
pushl %eax pushl %eax
LIPNoPush: .LIPNoPush:
call (%edi) call (%edi)
// now the result should be in EAX, untested yet (FK) // now the result should be in EAX, untested yet (FK)
end; end;
function CallExtendedFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Extended;assembler; function CallExtendedFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Extended;assembler;
Label LINoPush;
asm asm
movl S,%esi movl S,%esi
movl Address,%edi movl Address,%edi
// ? Indexed function // ? Indexed function
movl Index,%eax movl Index,%eax
xorl %eax,%eax xorl %eax,%eax
jnz LINoPush jnz .LINoPush
movl IValue,%eax movl IValue,%eax
pushl %eax pushl %eax
LINoPush: .LINoPush:
call (%edi) call (%edi)
//!! now What ?? //!! now What ??
end; end;
function CallExtendedProc(s : Pointer;Address : Pointer;Value : Extended; INdex,IVAlue : Longint) : Integer;assembler; function CallExtendedProc(s : Pointer;Address : Pointer;Value : Extended; INdex,IVAlue : Longint) : Integer;assembler;
label LIPNoPush;
asm asm
movl S,%esi movl S,%esi
movl Address,%edi movl Address,%edi
@ -267,27 +255,24 @@ unit typinfo;
// ? Indexed procedure // ? Indexed procedure
movl Index,%eax movl Index,%eax
xorl %eax,%eax xorl %eax,%eax
jnz LIPNoPush jnz .LIPNoPush
movl IValue,%eax movl IValue,%eax
pushl %eax pushl %eax
LIPNoPush: .LIPNoPush:
call (%edi) call (%edi)
end; end;
function CallBooleanFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Boolean;assembler; function CallBooleanFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Boolean;assembler;
Label LBNoPush;
asm asm
movl S,%edi movl S,%edi
movl Address,%edi movl Address,%edi
// ? Indexed function // ? Indexed function
movl Index,%eax movl Index,%eax
xorl %eax,%eax xorl %eax,%eax
jnz LBNoPush jnz .LBNoPush
movl IValue,%eax movl IValue,%eax
pushl %eax pushl %eax
LBNoPush: .LBNoPush:
call (%edi) call (%edi)
// now the result should be in EAX, untested yet (FK) // now the result should be in EAX, untested yet (FK)
end; end;
@ -297,27 +282,21 @@ unit typinfo;
Procedure CallSStringFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint; Procedure CallSStringFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint;
Var Res: Shortstring);assembler; Var Res: Shortstring);assembler;
Label LSSNoPush;
asm asm
movl S,%esi movl S,%esi
movl Address,%edi movl Address,%edi
// ? Indexed function // ? Indexed function
movl Index,%eax movl Index,%eax
xorl %eax,%eax xorl %eax,%eax
jnz LSSNoPush jnz .LSSNoPush
movl IValue,%eax movl IValue,%eax
pushl %eax pushl %eax
LSSNoPush: .LSSNoPush:
call (%edi) call (%edi)
//!! now what ?? MVC //!! now what ?? MVC
end; end;
Procedure CallSStringProc(s : Pointer;Address : Pointer;Value : ShortString; INdex,IVAlue : Longint);assembler; Procedure CallSStringProc(s : Pointer;Address : Pointer;Value : ShortString; INdex,IVAlue : Longint);assembler;
label LSSPNoPush;
asm asm
movl S,%esi movl S,%esi
movl Address,%edi movl Address,%edi
@ -328,10 +307,10 @@ unit typinfo;
// ? Indexed procedure // ? Indexed procedure
movl Index,%eax movl Index,%eax
xorl %eax,%eax xorl %eax,%eax
jnz LSSPNoPush jnz .LSSPNoPush
movl IValue,%eax movl IValue,%eax
pushl %eax pushl %eax
LSSPNoPush: .LSSPNoPush:
call (%edi) call (%edi)
//!! now what ? MVC //!! now what ? MVC
end; end;
@ -677,6 +656,7 @@ unit typinfo;
(PPointer(Instance.ClassType)+Longint(PropInfo^.GetProc)), (PPointer(Instance.ClassType)+Longint(PropInfo^.GetProc)),
Index,IValue); Index,IValue);
end; end;
Result:=Value;
end; end;
procedure SetFloatProp(Instance : TObject;PropInfo : PPropInfo; procedure SetFloatProp(Instance : TObject;PropInfo : PPropInfo;
@ -696,7 +676,7 @@ unit typinfo;
ftExtended: ftExtended:
PExtended(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value; PExtended(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
ftcomp: ftcomp:
PComp(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value; PComp(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Comp(Value);
{ Uncommenting this code results in a internal error!! { Uncommenting this code results in a internal error!!
ftFixed16: ftFixed16:
PFixed16(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value; PFixed16(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
@ -717,6 +697,7 @@ unit typinfo;
begin begin
{!!!!!!!!!!!} {!!!!!!!!!!!}
Result:=nil;
end; end;
procedure SetVariantProp(Instance : TObject;PropInfo : PPropInfo; procedure SetVariantProp(Instance : TObject;PropInfo : PPropInfo;
@ -730,6 +711,7 @@ unit typinfo;
begin begin
{!!!!!!!!!!!!} {!!!!!!!!!!!!}
Result:=nil;
end; end;
procedure SetMethodProp(Instance : TObject;PropInfo : PPropInfo; procedure SetMethodProp(Instance : TObject;PropInfo : PPropInfo;
@ -781,7 +763,10 @@ end.
{ {
$Log$ $Log$
Revision 1.18 1999-01-19 16:08:12 pierre Revision 1.19 1999-04-08 11:31:04 peter
* removed warnings
Revision 1.18 1999/01/19 16:08:12 pierre
?? is callSStringProc a function ?? ?? is callSStringProc a function ??
Revision 1.17 1998/12/15 22:43:13 peter Revision 1.17 1998/12/15 22:43:13 peter