mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 07:26:24 +02:00
* removed warnings
This commit is contained in:
peter
parent
b3c0d3b03c
commit
17f26f6577
@ -516,6 +516,10 @@ end;
|
||||
|
||||
function strpas(p:pchar):string;[public,alias:'FPC_PCHAR_TO_SHORTSTR'];
|
||||
begin
|
||||
{$ifndef NEWATT}
|
||||
{ remove warning }
|
||||
strpas:='';
|
||||
{$endif}
|
||||
asm
|
||||
cld
|
||||
movl p,%edi
|
||||
@ -525,8 +529,7 @@ begin
|
||||
repne
|
||||
scasb
|
||||
movl %ecx,%eax
|
||||
|
||||
{$ifdef NEWATT1}
|
||||
{$ifdef NEWATT}
|
||||
movl __RESULT,%edi
|
||||
{$else}
|
||||
movl 8(%ebp),%edi
|
||||
@ -769,7 +772,10 @@ end;
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.41 1999/03/01 15:40:55 peter
|
||||
|
||||
@ -17,6 +17,9 @@
|
||||
|
||||
function strpas(p : pchar) : string;
|
||||
begin
|
||||
{$ifndef NEWATT}
|
||||
strpas:='';
|
||||
{$endif}
|
||||
asm
|
||||
cld
|
||||
movl p,%edi
|
||||
@ -74,7 +77,10 @@ end ['EDI','ESI','EBX','EAX','ECX'];
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.3 1999/03/01 15:41:01 peter
|
||||
|
||||
@ -18,8 +18,8 @@
|
||||
****************************************************************************}
|
||||
|
||||
|
||||
Const
|
||||
{ Type of exception. Currently only one. }
|
||||
Const
|
||||
{ Type of exception. Currently only one. }
|
||||
FPC_EXCEPTION = 1;
|
||||
{ types of frames for the exception address stack }
|
||||
cExceptionFrame = 1;
|
||||
@ -42,7 +42,7 @@ Type
|
||||
|
||||
TExceptObjectClass = Class of TObject;
|
||||
|
||||
Const
|
||||
Const
|
||||
CatchAllExceptions = -1;
|
||||
|
||||
Var ExceptAddrStack : PExceptAddr;
|
||||
@ -50,10 +50,10 @@ Var ExceptAddrStack : PExceptAddr;
|
||||
|
||||
|
||||
Function PushExceptAddr (Ft: Longint): PJmp_buf ;[Public, Alias : 'FPC_PUSHEXCEPTADDR'];
|
||||
|
||||
var Buf : PJmp_buf;
|
||||
|
||||
var Buf : PJmp_buf;
|
||||
NewAddr : PExceptAddr;
|
||||
|
||||
|
||||
begin
|
||||
{$ifdef excdebug}
|
||||
writeln ('In PushExceptAddr');
|
||||
@ -78,9 +78,9 @@ end;
|
||||
|
||||
Procedure PushExceptObj (Obj : TObject; AnAddr : Pointer);
|
||||
|
||||
var
|
||||
var
|
||||
Newobj : PExceptObject;
|
||||
|
||||
|
||||
begin
|
||||
{$ifdef excdebug}
|
||||
writeln ('In PushExceptObject');
|
||||
@ -115,6 +115,7 @@ begin
|
||||
{$ifdef excdebug}
|
||||
writeln ('In RaiseException');
|
||||
{$endif}
|
||||
Raiseexcept:=nil;
|
||||
PushExceptObj(Obj,AnAddr);
|
||||
If ExceptAddrStack=Nil then
|
||||
DoUnhandledException (Obj,AnAddr);
|
||||
@ -172,8 +173,8 @@ begin
|
||||
begin
|
||||
Writeln ('Internal error.');
|
||||
halt (255);
|
||||
end;
|
||||
if Not ((Objtype = TExceptObjectClass(CatchAllExceptions)) or
|
||||
end;
|
||||
if Not ((Objtype = TExceptObjectClass(CatchAllExceptions)) or
|
||||
(ExceptObjectStack^.FObject is ObjType)) then
|
||||
Catches:=Nil
|
||||
else
|
||||
|
||||
@ -4,7 +4,7 @@
|
||||
Copyright (c) 1998 by the Free Pascal development team
|
||||
|
||||
Disk functions from Delphi's sysutils.pas
|
||||
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
@ -80,6 +80,7 @@ Function SetCurrentDir (Const NewDir : String) : Boolean;
|
||||
|
||||
begin
|
||||
ChDir (NewDir);
|
||||
SetCurrentDir:=true;
|
||||
end;
|
||||
|
||||
|
||||
@ -87,6 +88,7 @@ Function CreateDir (Const NewDir : String) : Boolean;
|
||||
|
||||
begin
|
||||
MkDir (NewDir);
|
||||
CreateDir:=true;
|
||||
end;
|
||||
|
||||
|
||||
@ -94,13 +96,17 @@ Function RemoveDir (Const Dir : String) : Boolean;
|
||||
|
||||
begin
|
||||
ChDir (Dir);
|
||||
RemoveDir:=true;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
}
|
||||
@ -116,6 +116,7 @@ Var SInfo : Stat;
|
||||
TAttr : Longint;
|
||||
|
||||
begin
|
||||
TAttr:=$ffffffff;
|
||||
P:=pglob(Info.FindHandle);
|
||||
Result:=Fstat(p^.name,SInfo);
|
||||
Info.FindHandle:=Longint(P^.Next);
|
||||
@ -208,6 +209,7 @@ Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
|
||||
|
||||
begin
|
||||
//!! Still Needs doing
|
||||
Result:=0;
|
||||
end;
|
||||
|
||||
|
||||
@ -220,8 +222,6 @@ end;
|
||||
|
||||
Function RenameFile (Const OldName, NewName : String) : Boolean;
|
||||
|
||||
Var P1,P2 : String;
|
||||
|
||||
begin
|
||||
RenameFile:=Linux.FRename(OldNAme,NewName);
|
||||
end;
|
||||
@ -267,12 +267,15 @@ end;
|
||||
Procedure InitInternational;
|
||||
|
||||
begin
|
||||
InitAnsi;
|
||||
InitAnsi;
|
||||
end;
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.7 1999/02/24 15:57:29 michael
|
||||
|
||||
@ -58,8 +58,8 @@ function DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp;
|
||||
|
||||
begin
|
||||
result.Time := Trunc(Frac(DateTime) * MSecsPerDay);
|
||||
result.Date := 1
|
||||
+ DateDelta
|
||||
result.Date := 1
|
||||
+ DateDelta
|
||||
+ Trunc(System.Int(DateTime));
|
||||
end ;
|
||||
|
||||
@ -111,7 +111,6 @@ const
|
||||
D100 = D4 * 25 - 1; { number of days in 100 years }
|
||||
D400 = D100 * 4 + 1; { number of days in 400 years }
|
||||
var
|
||||
i:Longint;
|
||||
l:longint;
|
||||
ly:boolean;
|
||||
begin
|
||||
@ -131,8 +130,6 @@ end ;
|
||||
Hour, Minute, Second and MilliSecond }
|
||||
|
||||
procedure DecodeTime(Time: TDateTime; var Hour, Minute, Second, MilliSecond: word);
|
||||
var l:TDateTime;
|
||||
|
||||
begin
|
||||
{ l := Trunc(Frac(time) * MSecsPerDay);
|
||||
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
|
||||
if (n = 3) then begin
|
||||
y := values[0];
|
||||
m := values[1];
|
||||
m := values[1];
|
||||
d := values[2];
|
||||
end
|
||||
else if (n = 2) then begin
|
||||
@ -334,7 +331,8 @@ var
|
||||
Len, Current: integer; PM: boolean;
|
||||
|
||||
function GetElement: integer;
|
||||
var i, j: integer; c: word;
|
||||
var
|
||||
j: integer; c: word;
|
||||
begin
|
||||
result := -1;
|
||||
Inc(Current);
|
||||
@ -581,7 +579,7 @@ Var YY,MM,DD,H,m,s,msec : Word;
|
||||
|
||||
begin
|
||||
Decodedate (DateTime,YY,MM,DD);
|
||||
If (YY<1980) or (YY>2099) then
|
||||
If (YY<1980) or (YY>2099) then
|
||||
Result:=0
|
||||
else
|
||||
begin
|
||||
@ -605,7 +603,10 @@ end;
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.7 1999/02/10 22:15:10 michael
|
||||
|
||||
@ -94,7 +94,7 @@ end;
|
||||
S1 = S2 = 0 }
|
||||
|
||||
function CompareStr(const S1, S2: string): Integer;
|
||||
var i, count, count1, count2: integer;
|
||||
var count, count1, count2: integer;
|
||||
begin
|
||||
result := 0;
|
||||
Count1 := Length(S1);
|
||||
@ -184,26 +184,32 @@ end ;
|
||||
|
||||
function AnsiCompareStr(const S1, S2: string): integer;
|
||||
begin
|
||||
result:=0;
|
||||
end ;
|
||||
|
||||
function AnsiCompareText(const S1, S2: string): integer;
|
||||
begin
|
||||
result:=0;
|
||||
end ;
|
||||
|
||||
function AnsiStrComp(S1, S2: PChar): integer;
|
||||
begin
|
||||
result:=0;
|
||||
end ;
|
||||
|
||||
function AnsiStrIComp(S1, S2: PChar): integer;
|
||||
begin
|
||||
result:=0;
|
||||
end ;
|
||||
|
||||
function AnsiStrLComp(S1, S2: PChar; MaxLen: cardinal): integer;
|
||||
begin
|
||||
result:=0;
|
||||
end ;
|
||||
|
||||
function AnsiStrLIComp(S1, S2: PChar; MaxLen: cardinal): integer;
|
||||
begin
|
||||
result:=0;
|
||||
end ;
|
||||
|
||||
function AnsiStrLower(Str: PChar): PChar;
|
||||
@ -230,10 +236,12 @@ end ;
|
||||
|
||||
function AnsiLastChar(const S: string): PChar;
|
||||
begin
|
||||
result:=nil;
|
||||
end ;
|
||||
|
||||
function AnsiStrLastChar(Str: PChar): PChar;
|
||||
begin
|
||||
result:=nil;
|
||||
end ;
|
||||
|
||||
{==============================================================================}
|
||||
@ -419,6 +427,7 @@ end ;
|
||||
|
||||
function LoadStr(Ident: integer): string;
|
||||
begin
|
||||
result:='';
|
||||
end ;
|
||||
|
||||
{ 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;
|
||||
begin
|
||||
result:='';
|
||||
end;
|
||||
|
||||
Const
|
||||
@ -970,7 +980,10 @@ const
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.15 1999/04/04 10:19:07 peter
|
||||
|
||||
@ -197,27 +197,21 @@ unit typinfo;
|
||||
{$ASMMODE ATT}
|
||||
|
||||
function CallIntegerFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Integer;assembler;
|
||||
|
||||
Label LINoPush;
|
||||
|
||||
asm
|
||||
movl S,%esi
|
||||
movl Address,%edi
|
||||
// ? Indexed function
|
||||
movl Index,%eax
|
||||
xorl %eax,%eax
|
||||
jnz LINoPush
|
||||
jnz .LINoPush
|
||||
movl IValue,%eax
|
||||
pushl %eax
|
||||
LINoPush:
|
||||
.LINoPush:
|
||||
call (%edi)
|
||||
// now the result should be in EAX, untested yet (FK)
|
||||
end;
|
||||
|
||||
function CallIntegerProc(s : Pointer;Address : Pointer;Value : Integer; INdex,IVAlue : Longint) : Integer;assembler;
|
||||
|
||||
label LIPNoPush;
|
||||
|
||||
asm
|
||||
movl S,%esi
|
||||
movl Address,%edi
|
||||
@ -227,36 +221,30 @@ unit typinfo;
|
||||
// ? Indexed procedure
|
||||
movl Index,%eax
|
||||
xorl %eax,%eax
|
||||
jnz LIPNoPush
|
||||
jnz .LIPNoPush
|
||||
movl IValue,%eax
|
||||
pushl %eax
|
||||
LIPNoPush:
|
||||
.LIPNoPush:
|
||||
call (%edi)
|
||||
// now the result should be in EAX, untested yet (FK)
|
||||
end;
|
||||
|
||||
function CallExtendedFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Extended;assembler;
|
||||
|
||||
Label LINoPush;
|
||||
|
||||
asm
|
||||
movl S,%esi
|
||||
movl Address,%edi
|
||||
// ? Indexed function
|
||||
movl Index,%eax
|
||||
xorl %eax,%eax
|
||||
jnz LINoPush
|
||||
jnz .LINoPush
|
||||
movl IValue,%eax
|
||||
pushl %eax
|
||||
LINoPush:
|
||||
.LINoPush:
|
||||
call (%edi)
|
||||
//!! now What ??
|
||||
end;
|
||||
|
||||
function CallExtendedProc(s : Pointer;Address : Pointer;Value : Extended; INdex,IVAlue : Longint) : Integer;assembler;
|
||||
|
||||
label LIPNoPush;
|
||||
|
||||
asm
|
||||
movl S,%esi
|
||||
movl Address,%edi
|
||||
@ -267,27 +255,24 @@ unit typinfo;
|
||||
// ? Indexed procedure
|
||||
movl Index,%eax
|
||||
xorl %eax,%eax
|
||||
jnz LIPNoPush
|
||||
jnz .LIPNoPush
|
||||
movl IValue,%eax
|
||||
pushl %eax
|
||||
LIPNoPush:
|
||||
.LIPNoPush:
|
||||
call (%edi)
|
||||
end;
|
||||
|
||||
function CallBooleanFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Boolean;assembler;
|
||||
|
||||
Label LBNoPush;
|
||||
|
||||
asm
|
||||
movl S,%edi
|
||||
movl Address,%edi
|
||||
// ? Indexed function
|
||||
movl Index,%eax
|
||||
xorl %eax,%eax
|
||||
jnz LBNoPush
|
||||
jnz .LBNoPush
|
||||
movl IValue,%eax
|
||||
pushl %eax
|
||||
LBNoPush:
|
||||
.LBNoPush:
|
||||
call (%edi)
|
||||
// now the result should be in EAX, untested yet (FK)
|
||||
end;
|
||||
@ -297,27 +282,21 @@ unit typinfo;
|
||||
|
||||
Procedure CallSStringFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint;
|
||||
Var Res: Shortstring);assembler;
|
||||
|
||||
Label LSSNoPush;
|
||||
|
||||
asm
|
||||
movl S,%esi
|
||||
movl Address,%edi
|
||||
// ? Indexed function
|
||||
movl Index,%eax
|
||||
xorl %eax,%eax
|
||||
jnz LSSNoPush
|
||||
jnz .LSSNoPush
|
||||
movl IValue,%eax
|
||||
pushl %eax
|
||||
LSSNoPush:
|
||||
.LSSNoPush:
|
||||
call (%edi)
|
||||
//!! now what ?? MVC
|
||||
end;
|
||||
|
||||
Procedure CallSStringProc(s : Pointer;Address : Pointer;Value : ShortString; INdex,IVAlue : Longint);assembler;
|
||||
|
||||
label LSSPNoPush;
|
||||
|
||||
asm
|
||||
movl S,%esi
|
||||
movl Address,%edi
|
||||
@ -328,10 +307,10 @@ unit typinfo;
|
||||
// ? Indexed procedure
|
||||
movl Index,%eax
|
||||
xorl %eax,%eax
|
||||
jnz LSSPNoPush
|
||||
jnz .LSSPNoPush
|
||||
movl IValue,%eax
|
||||
pushl %eax
|
||||
LSSPNoPush:
|
||||
.LSSPNoPush:
|
||||
call (%edi)
|
||||
//!! now what ? MVC
|
||||
end;
|
||||
@ -677,6 +656,7 @@ unit typinfo;
|
||||
(PPointer(Instance.ClassType)+Longint(PropInfo^.GetProc)),
|
||||
Index,IValue);
|
||||
end;
|
||||
Result:=Value;
|
||||
end;
|
||||
|
||||
procedure SetFloatProp(Instance : TObject;PropInfo : PPropInfo;
|
||||
@ -696,7 +676,7 @@ unit typinfo;
|
||||
ftExtended:
|
||||
PExtended(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
|
||||
ftcomp:
|
||||
PComp(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
|
||||
PComp(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Comp(Value);
|
||||
{ Uncommenting this code results in a internal error!!
|
||||
ftFixed16:
|
||||
PFixed16(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
|
||||
@ -717,6 +697,7 @@ unit typinfo;
|
||||
|
||||
begin
|
||||
{!!!!!!!!!!!}
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
procedure SetVariantProp(Instance : TObject;PropInfo : PPropInfo;
|
||||
@ -730,6 +711,7 @@ unit typinfo;
|
||||
|
||||
begin
|
||||
{!!!!!!!!!!!!}
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
procedure SetMethodProp(Instance : TObject;PropInfo : PPropInfo;
|
||||
@ -781,7 +763,10 @@ end.
|
||||
|
||||
{
|
||||
$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 ??
|
||||
|
||||
Revision 1.17 1998/12/15 22:43:13 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user