paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 04:59:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revisions 33 via svnmerge from

Browse Source 
/trunk

git-svn-id: branches/fixes_2_0@37 -
This commit is contained in:
michael 2005-05-20 19:52:03 +00:00
parent 0e8c2c83fa
commit a23cf740db
67 changed files with 503 additions and 1416 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -4187,6 +4187,7 @@ rtl/unix/unixutil.pp svneol=native#text/plain
rtl/unix/unxdeclh.inc svneol=native#text/plain
rtl/unix/unxovl.inc svneol=native#text/plain
rtl/unix/unxovlh.inc svneol=native#text/plain
rtl/unix/uuid.inc svneol=native#text/plain
rtl/unix/varutils.pp svneol=native#text/plain
rtl/unix/video.pp svneol=native#text/plain
rtl/unix/x86.pp svneol=native#text/plain

12
fcl/image/fpimgcmn.pp
View File

@ -18,19 +18,7 @@ unit FPImgCmn;
interface
{$ifdef VER1_0}
type
{$ifdef CPU68K}
{ 1.0 m68k cpu compiler does not allow
types larger than 32k....
if we remove range checking all should be fine PM }
TByteArray = array[0..0] of byte;
{$R-}
{$else not CPU68K}
TByteArray = array[0..maxint] of byte;
{$endif CPU68K}
PByteArray = ^TByteArray;
{$endif VER1_0}
function Swap(This : Longword): longword;
function Swap(This : integer): integer;

21
fcl/image/fpreadbmp.pp
View File

@ -104,31 +104,14 @@ end;
procedure TFPReaderBMP.SetupRead(nPalette, nRowBits: Integer; Stream : TStream);
{$ifdef VER1_0}
type
tcolinfo = ARRAY [0..0] OF TColorRGBA;
pcolinfo = ^tcolinfo;
var
ColInfo: pcolinfo;
{$else}
var
ColInfo: ARRAY OF TColorRGBA;
{$endif}
i: Integer;
begin
if nPalette>0 then
begin
GetMem(FPalette, nPalette*SizeOf(TFPColor));
{$ifdef VER1_0}
GetMem(ColInfo, nPalette*Sizeof(TColorRGBA));
if BFI.ClrUsed>0 then
Stream.Read(ColInfo^[0],BFI.ClrUsed*SizeOf(TColorRGBA))
else // Seems to me that this is dangerous.
Stream.Read(ColInfo^[0],nPalette*SizeOf(TColorRGBA));
for i := 0 to nPalette-1 do
FPalette[i] := RGBAToFPColor(ColInfo^[i]);
{$else}
SetLength(ColInfo, nPalette);
if BFI.ClrUsed>0 then
Stream.Read(ColInfo[0],BFI.ClrUsed*SizeOf(TColorRGBA))
@ -136,15 +119,11 @@ begin
Stream.Read(ColInfo[0],nPalette*SizeOf(TColorRGBA));
for i := 0 to High(ColInfo) do
FPalette[i] := RGBAToFPColor(ColInfo[i]);
{$endif}
end
else if BFI.ClrUsed>0 then { Skip palette }
Stream.Position := Stream.Position + BFI.ClrUsed*SizeOf(TColorRGBA);
ReadSize:=((nRowBits + 31) div 32) shl 2;
GetMem(LineBuf,ReadSize);
{$ifdef VER1_0}
FreeMem(ColInfo, nPalette*Sizeof(TColorRGBA));
{$endif}
end;
procedure TFPReaderBMP.InternalRead(Stream:TStream; Img:TFPCustomImage);

6
fcl/net/fpsock.pp
View File

@ -187,11 +187,7 @@ type
implementation
uses
{$IFDEF VER1_0}
Linux;
{$ELSE}
baseunix,Unix;
{$ENDIF}
resourcestring
SSocketNoEventLoopAssigned = 'No event loop assigned';
@ -202,11 +198,9 @@ resourcestring
SSocketAcceptError = 'Connection accept failed: %s';
SSocketIsActive = 'Cannot change parameters while active';
{$ifndef VER1_0}
Const
Sys_EAGAIN = ESYSEAGAIN;
Sys_EINPROGRESS = ESYSEINPROGRESS;
{$endif}
// TSocketStream

9
fcl/xml/sax.pp
View File

@ -40,13 +40,8 @@ const
type
{$IFDEF ver1_0}
SAXString = String;
SAXChar = Char;
{$ELSE}
SAXString = WideString;
SAXChar = WideChar;
{$ENDIF}
PSAXChar = ^SAXChar;
{ Exceptions }
@ -627,11 +622,7 @@ end;
procedure TSAXAttributes.BadIndex(Index: Integer);
begin
{$ifdef VER1_0}
raise ESAXAttributeIndexError.Create(Index) at get_caller_addr(get_frame);
{$else VER1_0}
raise ESAXAttributeIndexError.Create(Index) at pointer(get_caller_addr(get_frame));
{$endif VER1_0}
end;

2
fcl/xml/xmlread.pp
View File

@ -373,9 +373,7 @@ begin
end;
{$IFDEF FPC}
{$IFNDEF VER1_0}
{$DEFINE UsesFPCWidestrings}
{$ENDIF}
{$ENDIF}
{$IFDEF UsesFPCWidestrings}

2
fcl/xml/xmlwrite.pp
View File

@ -423,9 +423,7 @@ end;
// -------------------------------------------------------------------
{$IFDEF FPC}
{$IFNDEF VER1_0}
{$DEFINE UsesFPCWidestrings}
{$ENDIF}
{$ENDIF}
{$IFDEF UsesFPCWidestrings}

12
packages/base/gdbint/gdbint.pp
View File

@ -423,12 +423,8 @@ uses
initc,
{$endif win32}
{$ifdef unix}
{$ifdef ver1_0}
linux,
{$else}
baseunix,
{$endif}
{$endif}
baseunix,
{$endif}
{$ifdef go32v2}
go32,
dpmiexcp,
@ -2401,7 +2397,7 @@ begin
OldSigInt:=Signal(SIGINT,SignalHandler(@SIG_DFL));
{$else}
{$ifdef Unix}
OldSigInt:={$ifdef VER1_0}Signal{$else}fpSignal{$endif}(SIGINT,SignalHandler(SIG_DFL));
OldSigInt:=fpSignal(SIGINT,SignalHandler(SIG_DFL));
{$else}
OldSigInt:=Signal(SIGINT,SignalHandler(SIG_DFL));
{$endif}
@ -2432,7 +2428,7 @@ begin
gdb_init;
{$ifdef supportexceptions}
{$ifdef unix}
{$ifdef VER1_0}Signal{$else}fpsignal{$endif}(SIGINT,OldSigInt);
fpsignal(SIGINT,OldSigInt);
{$else}
Signal(SIGINT,OldSigInt);
{$endif}

49
packages/base/libasync/unix/libasync.pp
View File

@ -40,11 +40,7 @@ type
implementation
{$ifdef VER1_0}
uses Linux;
{$else}
uses baseunix, Unix;
{$endif}
const
MaxHandle = SizeOf(TFDSet) * 8 - 1;
@ -76,7 +72,7 @@ begin
while Assigned(IOCallback) do
begin
if (IOCallback^.SavedHandleFlags and Open_NonBlock) = 0 then
{$ifdef VER1_0}fcntl{$else}fpfcntl{$endif}(IOCallback^.IOHandle, F_SetFl, IOCallback^.SavedHandleFlags);
fpfcntl(IOCallback^.IOHandle, F_SetFl, IOCallback^.SavedHandleFlags);
IOCallback := IOCallback^.Next;
end;
@ -92,12 +88,12 @@ var
begin
if Handle^.Data.HighestHandle < 0 then
// No I/O checks to do, so just wait...
AsyncResult := {$ifdef VER1_0}Select{$else}fpselect{$endif}(0, nil, nil, nil, TimeOut)
AsyncResult := fpselect(0, nil, nil, nil, TimeOut)
else
begin
CurReadFDSet := PFDSet(Handle^.Data.FDData)[0];
CurWriteFDSet := PFDSet(Handle^.Data.FDData)[1];
AsyncResult := {$ifdef VER1_0}Select{$else}fpselect{$endif}(Handle^.Data.HighestHandle + 1,
AsyncResult := fpselect(Handle^.Data.HighestHandle + 1,
@CurReadFDSet, @CurWriteFDSet, nil, TimeOut);
if AsyncResult > 0 then
@ -108,13 +104,8 @@ begin
begin
CurIOCallback := PIOCallbackData(Handle^.Data.CurIOCallback);
Handle^.Data.NextIOCallback := CurIOCallback^.Next;
{$ifdef VER1_0}
if (FD_IsSet(CurIOCallback^.IOHandle,CurReadFDSet)) and
(FD_IsSet(CurIOCallback^.IOHandle, PFDSet(Handle^.Data.FDData)[0])) and
{$else}
if (fpFD_ISSET(CurIOCallback^.IOHandle,CurReadFDSet) > 0) and
(fpFD_ISSET(CurIOCallback^.IOHandle, PFDSet(Handle^.Data.FDData)[0]) > 0) and
{$endif}
Assigned(CurIOCallback^.ReadCallback) then
begin
CurIOCallback^.ReadCallback(CurIOCallback^.ReadUserData);
@ -124,13 +115,8 @@ begin
CurIOCallback := PIOCallbackData(Handle^.Data.CurIOCallback);
if Assigned(CurIOCallback) and
{$ifdef VER1_0}
(FD_IsSet(CurIOCallback^.IOHandle, CurWriteFDSet)) and
(FD_IsSet(CurIOCallback^.IOHandle, PFDSet(Handle^.Data.FDData)[1])) and
{$else}
(fpFD_ISSET(CurIOCallback^.IOHandle, CurWriteFDSet) > 0) and
(fpFD_ISSET(CurIOCallback^.IOHandle, PFDSet(Handle^.Data.FDData)[1]) > 0) and
{$endif}
Assigned(CurIOCallback^.WriteCallback) then
begin
CurIOCallback^.WriteCallback(CurIOCallback^.WriteUserData);
@ -154,15 +140,15 @@ begin
if not Assigned(Handle^.Data.FDData) then
begin
GetMem(Handle^.Data.FDData, SizeOf(TFDSet) * 2);
{$ifdef VER1_0}FD_ZERO{$else}fpFD_ZERO{$endif}(PFDSet(Handle^.Data.FDData)[0]);
{$ifdef VER1_0}FD_ZERO{$else}fpFD_ZERO{$endif}(PFDSet(Handle^.Data.FDData)[1]);
fpFD_ZERO(PFDSet(Handle^.Data.FDData)[0]);
fpFD_ZERO(PFDSet(Handle^.Data.FDData)[1]);
end;
if Data^.IOHandle > Handle^.Data.HighestHandle then
Handle^.Data.HighestHandle := Data^.IOHandle;
end;
Data^.SavedHandleFlags := {$ifdef VER1_0}fcntl{$else}fpfcntl{$endif}(Data^.IOHandle, F_GetFl);
{$ifdef VER1_0}fcntl{$else}fpfcntl{$endif}(Data^.IOHandle, F_SetFl, Data^.SavedHandleFlags or Open_NonBlock);
Data^.SavedHandleFlags := fpfcntl(Data^.IOHandle, F_GetFl);
fpfcntl(Data^.IOHandle, F_SetFl, Data^.SavedHandleFlags or Open_NonBlock);
case Data^.IOHandle of
StdInputHandle:
@ -176,16 +162,16 @@ begin
case i of
Open_RdOnly:
if cbRead in CallbackTypes then
{$ifdef VER1_0}FD_Set{$else}fpFD_SET{$endif}(Data^.IOHandle, PFDSet(Handle^.Data.FDData)[0]);
fpFD_SET(Data^.IOHandle, PFDSet(Handle^.Data.FDData)[0]);
Open_WrOnly:
if cbWrite in CallbackTypes then
{$ifdef VER1_0}FD_Set{$else}fpFD_SET{$endif}(Data^.IOHandle, PFDSet(Handle^.Data.FDData)[1]);
fpFD_SET(Data^.IOHandle, PFDSet(Handle^.Data.FDData)[1]);
Open_RdWr:
begin
if cbRead in CallbackTypes then
{$ifdef VER1_0}FD_Set{$else}fpFD_SET{$endif}(Data^.IOHandle, PFDSet(Handle^.Data.FDData)[0]);
fpFD_SET(Data^.IOHandle, PFDSet(Handle^.Data.FDData)[0]);
if cbWrite in CallbackTypes then
{$ifdef VER1_0}FD_Set{$else}fpFD_SET{$endif}(Data^.IOHandle, PFDSet(Handle^.Data.FDData)[1]);
fpFD_SET(Data^.IOHandle, PFDSet(Handle^.Data.FDData)[1]);
end;
end;
end;
@ -197,22 +183,17 @@ begin
exit;
if cbRead in CallbackTypes then
{$ifdef VER1_0}FD_CLR{$else}fpFD_CLR{$endif}(IOHandle, PFDSet(Handle^.Data.FDData)[0]);
fpFD_CLR(IOHandle, PFDSet(Handle^.Data.FDData)[0]);
if cbWrite in CallbackTypes then
{$ifdef VER1_0}FD_CLR{$else}fpFD_CLR{$endif}(IOHandle, PFDSet(Handle^.Data.FDData)[1]);
fpFD_CLR(IOHandle, PFDSet(Handle^.Data.FDData)[1]);
end;
function asyncGetTicks: Int64; cdecl;
var
Time: TimeVal;
begin
{$ifdef ver1_0}
GetTimeOfDay(time);
Result := Int64(Time.Sec) * 1000 + Int64(Time.USec div 1000);
{$else}
fpGetTimeOfDay(@time,nil);
Result := Int64(Time.tv_Sec) * 1000 + Int64(Time.tv_USec div 1000);
{$endif}
fpGetTimeOfDay(@time,nil);
Result := Int64(Time.tv_Sec) * 1000 + Int64(Time.tv_USec div 1000);
end;

11
packages/base/libc/stdlibh.inc
View File

@ -137,20 +137,9 @@ function mkstemp(__template:Pchar):longint;cdecl;external clib name 'mkstemp';
function mkstemp64(__template:Pchar):longint;cdecl;external clib name 'mkstemp64';
function mkdtemp(__template:Pchar):Pchar;cdecl;external clib name 'mkdtemp';
// **************** detect whether system symbol is hidden. Should be as of 1.9.4
{$ifdef VER1_0}
{$define __SYSTEMONLY}
{$endif}
{$ifdef VER1_1}
{$define __SYSTEMONLY}
{$endif}
{$ifdef VER1_9_2}
{$define __SYSTEMONLY}
{$endif}
// **************** End of detect
function __system(__command:Pchar):longint;cdecl;external clib name 'system';
{$ifndef __SYSTEMONLY}
function system(__command:Pchar):longint;cdecl;external clib name 'system';
{$endif}
function canonicalize_file_name(__name:Pchar):Pchar;cdecl;external clib name 'canonicalize_file_name';
function realpath(__name:Pchar; __resolved:Pchar):Pchar;cdecl;external clib name 'realpath';

22
packages/base/netdb/netdb.pp
View File

@ -115,11 +115,7 @@ Function GetProtocolByNumber(proto: Integer; Var H : TProtocolEntry) : boolean;
Implementation
uses
{$ifdef VER1_0}
Linux,
{$else}
BaseUnix,
{$endif}
sysutils;
@ -441,7 +437,7 @@ Var
SA : TInetSockAddr;
Sock,L : Longint;
Al,RTO : Longint;
ReadFDS : {$ifdef VER1_0}FDSet{$ELSE}TFDSet{$ENDIF};
ReadFDS : TFDSet;
begin
Result:=False;
@ -468,20 +464,16 @@ begin
sendto(sock,qry,qrylen+12,0,SA,SizeOf(SA));
// Wait for answer.
RTO:=TimeOutS*1000+TimeOutMS;
{$ifdef VER1_0}FD_ZERO{$else}fpFD_ZERO{$endif}(ReadFDS);
{$ifdef VER1_0}
FD_Set(Sock,readfds);
{$else}
fpFD_ZERO(ReadFDS);
fpFD_Set(sock,readfds);
{$endif}
if {$ifdef ver1_0}Select{$else}fpSelect{$endif}(Sock+1,@readfds,Nil,Nil,RTO)<=0 then
if fpSelect(Sock+1,@readfds,Nil,Nil,RTO)<=0 then
begin
{$ifdef VER1_0}fdclose{$ELSE}fpclose{$endif}(Sock);
fpclose(Sock);
exit;
end;
AL:=SizeOf(SA);
L:=recvfrom(Sock,ans,SizeOf(Ans),0,SA,AL);
{$ifdef VER1_0}fdclose{$ELSE}fpclose{$endif}(Sock);
fpclose(Sock);
// Check lenght answer and fields in header data.
If (L<12) or not CheckAnswer(Qry,Ans) Then
exit;
@ -594,11 +586,7 @@ begin
if LIP4Count > 0 then begin
inc(LIP4Count); // we loop to LIP4Count-1 later
if LIP4Count > MaxIP4Mapped then LIP4Count := MaxIP4Mapped;
{$ifdef VER1_0}
if LIP4Count > High(Addresses)+1 then LIP4Count := High(Addresses)+1;
{$else}
if LIP4Count > Length(Addresses) then LIP4Count := Length(Addresses);
{$endif}
for i := 0 to LIP4Count-2 do begin
Addresses[i] := NoAddress6;
Addresses[i].u6_addr16[5] := $FFFF;

2
packages/base/pasjpeg/jconfig.inc
View File

@ -112,7 +112,5 @@
{$IFDEF FPC}
{$MODE DELPHI}
{$GOTO ON}
{$IFNDEF VER1_0}
{$DEFINE DELPHI_STREAM}
{$ENDIF}
{$ENDIF}

9
packages/extra/gtk2/glib/gtypes.inc
View File

@ -11,15 +11,6 @@
dword = Cardinal;
qword = Int64;
{$ENDIF}
{$IFDEF VER1_0}
PLongint = ^Longint;
PSmallInt = ^SmallInt;
PByte = ^Byte;
PWord = ^Word;
PDWord = ^DWord;
PDouble = ^Double;
PPchar = ^Pchar;
{$ENDIF}
PPPchar = ^PPchar;
PPPgchar = ^PPgchar;

4
packages/extra/winunits/comobj.pp
View File

@ -18,18 +18,15 @@ unit comobj;
interface
{$ifndef VER1_0}
function CreateClassID : ansistring;
function CreateComObject(const ClassID: TGUID) : IUnknown;
function CreateRemoteComObject(const MachineName : WideString;const ClassID : TGUID) : IUnknown;
function CreateOleObject(const ClassName : string) : IDispatch;
function GetActiveOleObject(const ClassName: string) : IDispatch;
{$endif VER1_0}
implementation
{$ifndef VER1_0}
uses
windows,activex;
@ -74,7 +71,6 @@ unit comobj;
end;
{$endif VER1_0}
end.
{

3
packages/extra/winunits/jedi.inc
View File

@ -830,9 +830,6 @@
{$IFDEF FPC}
{$MODE Delphi}
{$IFDEF VER1_0}
Please use FPC 1.1 or later to compile this.
{$ELSE}
{$DEFINE SUPPORTS_OUTPARAMS}
{$DEFINE SUPPORTS_WIDECHAR}
{$DEFINE SUPPORTS_WIDESTRING}

2
rtl/atari/system.pas
View File

@ -12,7 +12,7 @@
**********************************************************************}
{$define ATARI}
unit {$ifdef VER1_0}sysatari{$else}{$ifdef VER0_99}sysatari{$ELSE}system{$endif}{$ENDIF};
unit system;
{--------------------------------------------------------------------}
{ LEFT TO DO: }

28
rtl/bsd/i386/syscall.inc
View File

@ -38,13 +38,6 @@ procedure actualsyscall; assembler; {inline requires a dummy push IIRC}
jb .LErrorcode
ret
.LErrorcode:
{$ifdef VER1_0}
{$ifdef ErrnoWord}
movw %ax,Errno
{$else}
movl %eax,Errno
{$endif}
{$else}
{$ifdef REGCALL}
movl fpc_threadvar_relocate_proc,%ecx
testl %ecx,%ecx
@ -76,18 +69,17 @@ procedure actualsyscall; assembler; {inline requires a dummy push IIRC}
{$endif}
.LNoThread:
{$endif REGCALL}
{$endif}
mov $-1,%eax
end;
function FpSysCall(sysnr:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif} assembler; [public,alias:'FPC_DOSYS0'];
function FpSysCall(sysnr:TSysParam):TSysResult; oldfpccall; assembler; [public,alias:'FPC_DOSYS0'];
asm
movl sysnr,%eax
call actualsyscall
end;
function FpSysCall(sysnr,param1:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif} assembler;[public,alias:'FPC_DOSYS1'];
function FpSysCall(sysnr,param1:TSysParam):TSysResult; oldfpccall; assembler;[public,alias:'FPC_DOSYS1'];
asm
movl sysnr,%eax
@ -96,7 +88,7 @@ function FpSysCall(sysnr,param1:TSysParam):TSysResult; {$ifndef VER1_0} oldfpcca
addl $4,%esp
end;
function FpSysCall(sysnr,param1:integer):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif}assembler;[public,alias:'FPC_DOSYS1w'];
function FpSysCall(sysnr,param1:integer):TSysResult; oldfpccall;assembler;[public,alias:'FPC_DOSYS1w'];
asm
movl sysnr,%eax
@ -105,7 +97,7 @@ function FpSysCall(sysnr,param1:integer):TSysResult; {$ifndef VER1_0} oldfpccall
add $2,%esp
end;
function FpSysCall(sysnr,param1,param2:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif}assembler; [public,alias:'FPC_DOSYS2'];
function FpSysCall(sysnr,param1,param2:TSysParam):TSysResult; oldfpccall;assembler; [public,alias:'FPC_DOSYS2'];
asm
movl sysnr,%eax
@ -115,7 +107,7 @@ function FpSysCall(sysnr,param1,param2:TSysParam):TSysResult; {$ifndef VER1_0} o
addl $8,%esp
end;
function FpSysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif}assembler;[public,alias:'FPC_DOSYS3'];
function FpSysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; oldfpccall;assembler;[public,alias:'FPC_DOSYS3'];
asm
movl sysnr,%eax
@ -126,7 +118,7 @@ function FpSysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; {$ifndef VE
addl $12,%esp
end;
function FpSysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult;{$ifndef VER1_0} oldfpccall;{$endif} assembler;[public,alias:'FPC_DOSYS4'];
function FpSysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult;oldfpccall; assembler;[public,alias:'FPC_DOSYS4'];
asm
movl sysnr,%eax
@ -139,7 +131,7 @@ asm
end;
function FpSysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult;{$ifndef VER1_0} oldfpccall;{$endif} assembler;[public,alias:'FPC_DOSYS5'];
function FpSysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult;oldfpccall; assembler;[public,alias:'FPC_DOSYS5'];
asm
movl sysnr,%eax
@ -152,7 +144,7 @@ function FpSysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResul
addl $20,%esp
end;
function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):int64; {$ifndef VER1_0} oldfpccall;{$endif} assembler;[public,alias:'FPC_DOSYS6'];
function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):int64; oldfpccall; assembler;[public,alias:'FPC_DOSYS6'];
asm
movl sysnr,%eax
@ -166,7 +158,7 @@ asm
addl $24,%esp
end;
function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6,param7:TSysParam):int64;{$ifndef VER1_0} oldfpccall;{$endif} assembler; [public,alias:'FPC_DOSYS7'];
function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6,param7:TSysParam):int64;oldfpccall; assembler; [public,alias:'FPC_DOSYS7'];
asm
movl sysnr,%eax
@ -181,7 +173,7 @@ asm
addl $28,%esp
end;
function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6,param7,param8:TSysParam):int64;{$ifndef VER1_0} oldfpccall;{$endif} assembler; [public,alias:'FPC_DOSYS8'];
function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6,param7,param8:TSysParam):int64;oldfpccall; assembler; [public,alias:'FPC_DOSYS8'];
asm
movl sysnr,%eax

20
rtl/bsd/i386/syscallh.inc
View File

@ -36,16 +36,16 @@ Type
TSysParam = Longint;
function do_sysCall(sysnr:TSysParam):TSysResult;{$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS0';
function do_sysCall(sysnr,param1:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif}external name 'FPC_DOSYS1';
//function do_sysCall(sysnr,param1:integer):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif}external name 'FPC_DOSYS1w';
function do_sysCall(sysnr,param1,param2:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS2';
function do_sysCall(sysnr,param1,param2,param3:TSysParam):TSysResult;{$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS3';
function do_sysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult;{$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS4';
function do_sysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS5';
function do_sysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):int64;{$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS6';
function do_sysCall(sysnr,param1,param2,param3,param4,param5,param6,param7:TSysParam):int64; {$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS7';
function do_sysCall(sysnr,param1,param2,param3,param4,param5,param6,param7,param8:TSysParam):int64; {$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS8';
function do_sysCall(sysnr:TSysParam):TSysResult;oldfpccall; external name 'FPC_DOSYS0';
function do_sysCall(sysnr,param1:TSysParam):TSysResult; oldfpccall;external name 'FPC_DOSYS1';
//function do_sysCall(sysnr,param1:integer):TSysResult; oldfpccall;external name 'FPC_DOSYS1w';
function do_sysCall(sysnr,param1,param2:TSysParam):TSysResult; oldfpccall; external name 'FPC_DOSYS2';
function do_sysCall(sysnr,param1,param2,param3:TSysParam):TSysResult;oldfpccall; external name 'FPC_DOSYS3';
function do_sysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult;oldfpccall; external name 'FPC_DOSYS4';
function do_sysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; oldfpccall; external name 'FPC_DOSYS5';
function do_sysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):int64;oldfpccall; external name 'FPC_DOSYS6';
function do_sysCall(sysnr,param1,param2,param3,param4,param5,param6,param7:TSysParam):int64; oldfpccall; external name 'FPC_DOSYS7';
function do_sysCall(sysnr,param1,param2,param3,param4,param5,param6,param7,param8:TSysParam):int64; oldfpccall; external name 'FPC_DOSYS8';
{$endif}

4
rtl/bsd/ossysc.inc
View File

@ -81,10 +81,6 @@ begin
Fpftruncate:=Do_syscall(syscall_nr___syscall,syscall_nr_ftruncate,0,fd,0,lo(flength),hi(flength));
end;
{$ifdef VER1_0}
{$DEFINE FPC_LITTLE_ENDIAN}
{$endif}
Function Fpmmap(start:pointer;len:size_t;prot:cint;flags:cint;fd:cint;offst:off_t):pointer; [public, alias: 'FPC_SYSC_MMAP'];

2
rtl/bsd/system.pp
View File

@ -21,7 +21,7 @@
{ If you use an aout system, set the conditional AOUT}
{ $Define AOUT}
Unit {$ifdef VER1_0}SysBSD{$else}System{$endif};
Unit System;
Interface

2
rtl/bsd/x86_64/syscall.inc
View File

@ -242,7 +242,7 @@ procedure actualsyscall; assembler; {inline requires a dummy push IIRC}
.LSyscOK:
end;
function do__sysCall(sysnr,param1,param2,param3,param4,param5,param6,param7,Param8:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS8';
function do__sysCall(sysnr,param1,param2,param3,param4,param5,param6,param7,Param8:TSysParam):TSysResult; oldfpccall; external name 'FPC_DOSYS8';
// Hmm, we have to do something different :)
asm

16
rtl/bsd/x86_64/syscallh.inc
View File

@ -33,16 +33,16 @@ Type
TSysParam = int64;
function do_sysCall(sysnr:TSysParam):TSysResult;{$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS0';
function do_sysCall(sysnr,param1:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif}external name 'FPC_DOSYS1';
function do_sysCall(sysnr,param1,param2:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS2';
function do_sysCall(sysnr,param1,param2,param3:TSysParam):TSysResult;{$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS3';
function do_sysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult;{$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS4';
function do_sysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS5';
function do_sysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):int64;{$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS6';
function do_sysCall(sysnr:TSysParam):TSysResult;oldfpccall; external name 'FPC_DOSYS0';
function do_sysCall(sysnr,param1:TSysParam):TSysResult; oldfpccall;external name 'FPC_DOSYS1';
function do_sysCall(sysnr,param1,param2:TSysParam):TSysResult; oldfpccall; external name 'FPC_DOSYS2';
function do_sysCall(sysnr,param1,param2,param3:TSysParam):TSysResult;oldfpccall; external name 'FPC_DOSYS3';
function do_sysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult;oldfpccall; external name 'FPC_DOSYS4';
function do_sysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; oldfpccall; external name 'FPC_DOSYS5';
function do_sysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):int64;oldfpccall; external name 'FPC_DOSYS6';
// special
function do__sysCall(sysnr,param1,param2,param3,param4,param5,param6,param7,Param8:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS8';
function do__sysCall(sysnr,param1,param2,param3,param4,param5,param6,param7,Param8:TSysParam):TSysResult; oldfpccall; external name 'FPC_DOSYS8';
{$endif}
{

8
rtl/emx/system.pas
View File

@ -15,16 +15,12 @@
****************************************************************************}
unit {$ifdef VER1_0}sysemx{$else}System{$endif};
unit System;
interface
{Link the startup code.}
{$ifdef VER1_0}
{$l prt1.oo2}
{$else}
{$l prt1.o}
{$endif}
{$l prt1.o}
{$I systemh.inc}

270
rtl/freebsd/tthread.inc
View File

@ -15,275 +15,6 @@
}
{$IFDEF VER1_0} // leaving the old implementation in for now...
type
PThreadRec=^TThreadRec;
TThreadRec=record
thread : TThread;
next : PThreadRec;
end;
var
ThreadRoot : PThreadRec;
ThreadsInited : boolean;
// MainThreadID: longint;
Const
ThreadCount: longint = 0;
function ThreadSelf:TThread;
var
hp : PThreadRec;
sp : Pointer;
begin
sp:=SPtr;
hp:=ThreadRoot;
while assigned(hp) do
begin
if (sp<=hp^.Thread.FStackPointer) and
(sp>(hp^.Thread.FStackPointer-hp^.Thread.FStackSize)) then
begin
Result:=hp^.Thread;
exit;
end;
hp:=hp^.next;
end;
Result:=nil;
end;
//function SIGCHLDHandler(Sig: longint): longint; cdecl;//this is std linux C declaration as function
procedure SIGCHLDHandler(Sig: longint); cdecl;
begin
fpwaitpid(-1, nil, WNOHANG);
end;
procedure InitThreads;
var
Act, OldAct: Baseunix.PSigActionRec;
begin
ThreadRoot:=nil;
ThreadsInited:=true;
// This will install SIGCHLD signal handler
// signal() installs "one-shot" handler,
// so it is better to install and set up handler with sigaction()
GetMem(Act, SizeOf(SigActionRec));
GetMem(OldAct, SizeOf(SigActionRec));
Act^.sa_handler := TSigAction(@SIGCHLDHandler);
Act^.sa_flags := SA_NOCLDSTOP {or SA_NOMASK or SA_RESTART};
Fillchar(Act^.sa_mask,sizeof(Act^.sa_mask),0); //Do not block all signals ??. Don't need if SA_NOMASK in flags
FpSigAction(SIGCHLD, Act, OldAct);
FreeMem(Act, SizeOf(SigActionRec));
FreeMem(OldAct, SizeOf(SigActionRec));
end;
procedure DoneThreads;
var
hp : PThreadRec;
begin
while assigned(ThreadRoot) do
begin
ThreadRoot^.Thread.Destroy;
hp:=ThreadRoot;
ThreadRoot:=ThreadRoot^.Next;
dispose(hp);
end;
ThreadsInited:=false;
end;
procedure AddThread(t:TThread);
var
hp : PThreadRec;
begin
{ Need to initialize threads ? }
if not ThreadsInited then
InitThreads;
{ Put thread in the linked list }
new(hp);
hp^.Thread:=t;
hp^.next:=ThreadRoot;
ThreadRoot:=hp;
inc(ThreadCount, 1);
end;
procedure RemoveThread(t:TThread);
var
lasthp,hp : PThreadRec;
begin
hp:=ThreadRoot;
lasthp:=nil;
while assigned(hp) do
begin
if hp^.Thread=t then
begin
if assigned(lasthp) then
lasthp^.next:=hp^.next
else
ThreadRoot:=hp^.next;
dispose(hp);
exit;
end;
lasthp:=hp;
hp:=hp^.next;
end;
Dec(ThreadCount, 1);
if ThreadCount = 0 then DoneThreads;
end;
{ TThread }
function ThreadProc(args:pointer): Integer;cdecl;
var
FreeThread: Boolean;
Thread : TThread absolute args;
begin
while Thread.FHandle = 0 do fpsleep(1);
if Thread.FSuspended then Thread.suspend();
try
Thread.Execute;
except
Thread.FFatalException := TObject(AcquireExceptionObject);
end;
FreeThread := Thread.FFreeOnTerminate;
Result := Thread.FReturnValue;
Thread.FFinished := True;
Thread.DoTerminate;
if FreeThread then
Thread.Free;
fpexit(Result);
end;
constructor TThread.Create(CreateSuspended: Boolean);
var
Flags: Integer;
begin
inherited Create;
AddThread(self);
FSuspended := CreateSuspended;
Flags := CLONE_VM + CLONE_FS + CLONE_FILES + CLONE_SIGHAND + SIGCHLD;
{ Setup 16k of stack }
FStackSize:=16384;
Getmem(FStackPointer,FStackSize);
inc(FStackPointer,FStackSize);
FCallExitProcess:=false;
{ Clone }
FHandle:= Clone(@ThreadProc,FStackPointer,Flags,self);
// if FSuspended then Suspend;
FThreadID := FHandle;
IsMultiThread := TRUE;
FFatalException := nil;
end;
destructor TThread.Destroy;
begin
if not FFinished and not Suspended then
begin
Terminate;
WaitFor;
end;
if FHandle <> -1 then
fpkill(FHandle, SIGKILL);
dec(FStackPointer,FStackSize);
Freemem(FStackPointer);
FFatalException.Free;
FFatalException := nil;
inherited Destroy;
RemoveThread(self);
end;
procedure TThread.CallOnTerminate;
begin
FOnTerminate(Self);
end;
procedure TThread.DoTerminate;
begin
if Assigned(FOnTerminate) then
Synchronize(@CallOnTerminate);
end;
const
{ I Don't know idle or timecritical, value is also 20, so the largest other
possibility is 19 (PFV) }
Priorities: array [TThreadPriority] of Integer =
(-20,-19,-10,9,10,19,20);
function TThread.GetPriority: TThreadPriority;
var
P: Integer;
I: TThreadPriority;
begin
P := fpGetPriority(Prio_Process,FHandle);
Result := tpNormal;
for I := Low(TThreadPriority) to High(TThreadPriority) do
if Priorities[I] = P then
Result := I;
end;
procedure TThread.SetPriority(Value: TThreadPriority);
begin
fpSetPriority(Prio_Process,FHandle,Priorities[Value]);
end;
procedure TThread.SetSuspended(Value: Boolean);
begin
if Value <> FSuspended then
if Value then
Suspend
else
Resume;
end;
procedure TThread.Suspend;
begin
FSuspended := true;
fpKill(FHandle, SIGSTOP);
end;
procedure TThread.Resume;
begin
fpKill(FHandle, SIGCONT);
FSuspended := False;
end;
procedure TThread.Terminate;
begin
FTerminated := True;
end;
function TThread.WaitFor: Integer;
var
status : longint;
begin
if FThreadID = MainThreadID then
fpwaitpid(0,@status,0)
else
fpwaitpid(FHandle,@status,0);
Result:=status;
end;
{$ELSE}
{
What follows, is a short description on my implementation of TThread.
Most information can also be found by reading the source and accompanying
@ -580,7 +311,6 @@ procedure TThread.SetPriority(Value: TThreadPriority);
begin
ThreadSetPriority(FHandle, Priorities[Value]);
end;
{$ENDIF}
{
$Log: tthread.inc,v $

6
rtl/i386/fastmove.inc
View File

@ -25,12 +25,6 @@ the following restrictions:
Version: 1.40 - 16-SEP-2004
}
{$ifndef VER1_0}
{$if (FPC_VERSION>1) or ((FPC_RELEASE>=9) and (FPC_PATCH>6))}
{ $define USE_FASTMOVE}
{$endif}
{$endif}
{$ifdef USE_FASTMOVE}
{$ifndef FPC_SYSTEM_HAS_MOVE}

2
rtl/i386/mathuh.inc
View File

@ -27,7 +27,7 @@ function GetPrecisionMode: TFPUPrecisionMode;
function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
function GetExceptionMask: TFPUExceptionMask;
function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
procedure ClearExceptions(RaisePending: Boolean {$ifndef VER1_0}=true{$endif});
procedure ClearExceptions(RaisePending: Boolean =true);
procedure SetSSECSR(w : dword);
function GetSSECSR : dword;

12
rtl/inc/ctypes.pp
View File

@ -36,11 +36,7 @@ Type
cInt32 = longint;
cUInt32= cardinal;
cInt64 = int64;
{$ifndef VER1_0}
cUInt64= qword;
{$else}
cUInt64= int64;
{$endif}
cuchar = byte;
cchar = shortint;
@ -48,21 +44,13 @@ Type
cUInt = Cardinal; { minimum range is : 32-bit }
{$ifdef cpu64}
cLong = int64;
{$ifdef VER1_0}
cuLong = int64;
{$else}
cuLong = qword;
{$endif}
{$else}
cLong = longint;
cuLong = Cardinal;
{$endif}
clonglong = int64;
{$ifndef VER1_0}
culonglong = qword;
{$else VER1_0}
culonglong = int64;
{$endif VER1_0}
cshort = smallint;
cushort = word;

17
rtl/inc/dos.inc
View File

@ -61,32 +61,15 @@ const
Leap := true;
end;
{$IFDEF VER1_0}
{ Necessary to avoid internal error 10... :-( }
var
DC: cardinal;
I64: int64;
{$ENDIF VER1_0}
begin
GetDate (Y, Mo, D, WD);
GetTime (H, Mi, S, S100);
{$IFDEF VER1_0}
DC := D + DayTable [Leap, Mo] + (Y div 400) * 97;
DC := DC + ((Y mod 400) div 100) * 24 + (Y mod 100) div 4;
I64 := S100 * 10 + S * 1000;
I64 := I64 + cardinal (Mi) * 60*1000;
I64 := I64 + int64 (H) * 60*60*1000;
I64 := I64 + int64 (DC) * 24*60*60*1000;
I64 := I64 + int64 (Y) * 365*24*60*60*1000;
GetMsCount := I64;
{$ELSE VER1_0}
GetMsCount := S100 * 10 + S * 1000 + cardinal (Mi) * 60*1000
+ int64 (H) * 60*60*1000
+ int64 (D + DayTable [Leap, Mo]
+ (Y div 400) * 97 + ((Y mod 400) div 100) * 24 + (Y mod 100) div 4)
* 24*60*60*1000
+ int64 (Y) * 365*24*60*60*1000;
{$ENDIF VER1_0}
end;
{$ENDIF HAS_GETMSCOUNT}

6
rtl/inc/genmath.inc
View File

@ -175,7 +175,6 @@ type
End;
{$ifndef VER1_0}
function float64_to_int64_round_to_zero(a : float64) : int64;
var
aSign : flag;
@ -217,7 +216,6 @@ type
z:=-z;
result:=z;
end;
{$endif VER1_0}
Function ExtractFloat32Frac(a : Float32) : longint;
Begin
@ -300,11 +298,7 @@ type
f64.low:=f64.high;
f64.high:=l;
{$endif cpuarm}
{$ifdef VER1_0}
result:=float64_to_int32_round_to_zero(f64);
{$else VER1_0}
result:=float64_to_int64_round_to_zero(f64);
{$endif VER1_0}
end
else
begin

5
rtl/inc/heaptrc.pp
View File

@ -16,11 +16,6 @@
unit heaptrc;
interface
{ 1.0.x doesn't have good rangechecking for cardinals }
{$ifdef VER1_0}
{$R-}
{$endif}
{$goto on}
Procedure DumpHeap;

2
rtl/inc/int64.inc
View File

@ -309,10 +309,8 @@
((_f1>fpc_mul_qword) or (f1>fpc_mul_qword)))) then
HandleErrorFrame(215,get_frame);
end;
{$ifndef VER1_0}
{ when bootstrapping, we forget about overflow checking for qword :) }
f1overflowed:=f1overflowed or ((f1 and (1 shl 63))<>0);
{$endif VER1_0}
f1:=f1 shl 1;
bitpos:=bitpos shl 1;
end;

5
rtl/inc/matrix.pp
View File

@ -28,10 +28,6 @@ unit matrix;
{*****************************************************************************}
{$ifdef VER1_0}
{1.0 has too much macro bugs :( }
interface implementation end.
{$else}
interface
@ -827,7 +823,6 @@ implementation
{$i mmatimp.inc}
end.
{$endif VER1_0}
{
$Log: matrix.pp,v $
Revision 1.4 2005/02/14 17:13:22 peter

85
rtl/inc/objects.pp
View File

@ -750,42 +750,15 @@ type
function CallVoidConstructor(Ctor: pointer; Obj: pointer; VMT: pointer): pointer;
begin
{$ifdef VER1_0}
asm
{$ifdef cpui386}
movl Obj, %esi
{$endif}
{$ifdef cpum68k}
move.l Obj, a5
{$endif}
end;
CallVoidConstructor := VoidConstructor(Ctor)(VMT, Obj);
{$else}
CallVoidConstructor := VoidConstructor(Ctor)(Obj, VMT);
{$endif}
end;
function CallPointerConstructor(Ctor: pointer; Obj: pointer; VMT: pointer; Param1: pointer): pointer;
{$undef FPC_CallPointerConstructor_Implemented}
begin
{$ifdef VER1_0}
asm
{$ifdef cpui386}
{$define FPC_CallPointerConstructor_Implemented}
movl Obj, %esi
{$endif}
{$ifdef cpum68k}
{$define FPC_CallPointerConstructor_Implemented}
move.l Obj, a5
{$endif}
end;
CallPointerConstructor := PointerConstructor(Ctor)(VMT, Obj, Param1)
{$else}
{ 1.1 does not esi to be loaded }
{$define FPC_CallPointerConstructor_Implemented}
CallPointerConstructor := PointerConstructor(Ctor)(Obj, VMT, Param1)
{$endif}
end;
{$ifndef FPC_CallPointerConstructor_Implemented}
{$error CallPointerConstructor function not implemented}
@ -794,19 +767,6 @@ end;
function CallVoidMethod(Method: pointer; Obj: pointer): pointer;
begin
{$ifdef VER1_0}
{ load the object pointer }
{$ifdef CPUI386}
asm
movl Obj, %esi
end;
{$endif CPUI386}
{$ifdef CPU68K}
asm
move.l Obj, a5
end;
{$endif CPU68K}
{$endif VER1_0}
CallVoidMethod := VoidMethod(Method)(Obj)
end;
@ -814,26 +774,7 @@ end;
function CallPointerMethod(Method: pointer; Obj: pointer; Param1: pointer): pointer;
{$undef FPC_CallPointerMethod_Implemented}
begin
{$ifdef VER1_0}
asm
{$ifdef cpui386}
{$define FPC_CallPointerMethod_Implemented}
movl Obj, %esi
{$endif}
{$ifdef cpum68k}
{$define FPC_CallPointerMethod_Implemented}
move.l Obj, a5
{$endif}
{$ifdef cpupowerpc}
{$define FPC_CallPointerMethod_Implemented}
{ for the powerpc, we don't need to load self, because we use standard calling conventions
so self should be in a register anyways }
{$endif}
end;
{$else}
{ 1.1 does not esi to be loaded }
{$define FPC_CallPointerMethod_Implemented}
{$endif}
CallPointerMethod := PointerMethod(Method)(Obj, Param1)
end;
{$ifndef FPC_CallPointerMethod_Implemented}
@ -855,38 +796,12 @@ end;
function CallVoidMethodLocal(Func: pointer; Frame: Pointer; Obj: pointer): pointer;
begin
{$ifdef VER1_0}
{ load the object pointer }
{$ifdef CPUI386}
asm
movl Obj, %esi
end;
{$endif CPUI386}
{$ifdef CPU68K}
asm
move.l Obj, a5
end;
{$endif CPU68K}
{$endif VER1_0}
CallVoidMethodLocal := VoidMethodLocal(Func)(Frame)
end;
function CallPointerMethodLocal(Func: pointer; Frame: Pointer; Obj: pointer; Param1: pointer): pointer;
begin
{$ifdef VER1_0}
{ load the object pointer }
{$ifdef CPUI386}
asm
movl Obj, %esi
end;
{$endif CPUI386}
{$ifdef CPU68K}
asm
move.l Obj, a5
end;
{$endif CPU68K}
{$endif VER1_0}
CallPointerMethodLocal := PointerMethodLocal(Func)(Frame, Param1)
end;

2
rtl/inc/system.inc
View File

@ -453,9 +453,7 @@ end;
function random(l:int64): int64;
begin
{$ifndef VER1_0}
random := int64((qword(cardinal(genrand_MT19937)) or ((qword(cardinal(genrand_MT19937)) shl 32))) and $7fffffffffffffff) mod l;
{$endif VER1_0}
end;
function random: extended;

13
rtl/inc/systemh.inc
View File

@ -73,13 +73,8 @@ Type
Longint = +(-2147483647-1)..$7fffffff;
Byte = 0..255;
Word = 0..65535;
{$ifndef ver1_0}
DWord = LongWord;
Cardinal = LongWord;
{$else}
Longword = cardinal;
Dword = cardinal;
{$endif}
Integer = SmallInt;
{$endif HAS_INTERNAL_INTTYPES}
@ -222,9 +217,7 @@ Type
PUCS4Char = ^UCS4Char;
TUCS4CharArray = array[0..$effffff] of UCS4Char;
PUCS4CharArray = ^TUCS4CharArray;
{$ifndef VER1_0}
UCS4String = array of UCS4Char;
{$endif VER1_0}
UTF8String = type ansistring;
PUTF8String = ^UTF8String;
@ -280,11 +273,7 @@ Type
PPWideChar = ^PWideChar;
{ 1.0.x also has HASWIDECHAR defined, but doesn't support it
fully, setting WChar to Word as fallback (PFV) }
{$ifndef VER1_0}
WChar = Widechar;
{$else}
WChar = Word;
{$endif}
UCS2Char = WideChar;
PUCS2Char = PWideChar;
{$else}
@ -323,9 +312,7 @@ type
PointerArray = array [0..512*1024*1024 - 2] of Pointer;
PPointerArray = ^PointerArray;
{$ifndef VER1_0}
TBoundArray = array of Integer;
{$endif VER1_0}
TPCharArray = packed array[0..(MaxLongint div SizeOf(PChar))-1] of PChar;
PPCharArray = ^TPCharArray;

13
rtl/linux/gpm.pp
View File

@ -189,7 +189,7 @@ function gpm_getevent(var event:Tgpm_event):longint;
function Gpm_Getchar : longint;}
function gpm_repeat(millisec:longint):longint;
function gpm_fitvaluesM(var x,y:longint; margin:longint):longint;
function gpm_fitvalues(var x,y:longint):longint;{$ifndef VER1_0}inline;{$endif}
function gpm_fitvalues(var x,y:longint):longint;inline;
function gpm_pushroi(x1:longint;y1:longint;x2:longint;y2:longint;
mask:longint;fun:Tgpmhandler;xtradata:pointer):Pgpm_roi;
function gpm_poproi(which:Pgpm_roi):Pgpm_roi;
@ -198,8 +198,7 @@ function gpm_lowerroi(which:Pgpm_roi;after:Pgpm_roi):Pgpm_roi;
{Should be pointer because proc accepts nil.}
function gpm_getsnapshot(eptr:Pgpmevent):longint;
{Overload for compatibility.}
function gpm_getsnapshot(var eptr:Tgpmevent):longint;
{$ifndef VER1_0}inline;{$endif}
function gpm_getsnapshot(var eptr:Tgpmevent):longint;inline;
{$endif}
@ -362,7 +361,7 @@ var conn:Tgpmconnect;
begin
fpsigemptyset(new_sigset);
fpsigaddset(new_sigset,SIGTSTP);
fpsigprocmask(SIG_BLOCK,{$ifdef ver1_0}@{$endif}new_sigset,{$ifdef ver1_0}@{$endif}old_sigset);
fpsigprocmask(SIG_BLOCK,new_sigset,old_sigset);
{Open a completely transparent gpm connection.}
conn.eventmask:=0;
@ -702,8 +701,7 @@ begin
end;
end;
function gpm_fitvalues(var x,y:longint):longint;
{$ifndef VER1_0}inline;{$endif}
function gpm_fitvalues(var x,y:longint):longint;inline;
begin
gpm_fitvalues:=gpm_fitvaluesm(x,y,-1);
@ -943,8 +941,7 @@ begin
end;
end;
function gpm_getsnapshot(var eptr:Tgpmevent):longint;
{$ifndef VER1_0}inline;{$endif}
function gpm_getsnapshot(var eptr:Tgpmevent):longint;inline;
begin
gpm_getsnapshot:=gpm_getsnapshot(@eptr);

42
rtl/linux/i386/syscall.inc
View File

@ -19,7 +19,7 @@
{$ASMMODE ATT}
function FpSysCall(sysnr:TSysParam):TSysResult; assembler; {$ifndef VER1_0} oldfpccall; {$endif}[public,alias:'FPC_SYSCALL0'];
function FpSysCall(sysnr:TSysParam):TSysResult; assembler; oldfpccall;[public,alias:'FPC_SYSCALL0'];
asm
{ load the registers... }
@ -28,9 +28,6 @@ asm
cmpl $-4095,%eax
jb .LSyscOK
negl %eax
{$ifdef VER1_0}
movl %eax,Errno
{$else}
{$ifdef REGCALL}
movl fpc_threadvar_relocate_proc,%ecx
testl %ecx,%ecx
@ -58,12 +55,11 @@ asm
movl %edx,(%eax)
.LNoThread:
{$endif REGCALL}
{$endif ver1_0}
movl $-1,%eax
.LSyscOK:
end;
function FpSysCall(sysnr,param1 : TSysParam):TSysResult; assembler; {$ifndef VER1_0} oldfpccall; {$endif}[public,alias:'FPC_SYSCALL1'];
function FpSysCall(sysnr,param1 : TSysParam):TSysResult; assembler; oldfpccall;[public,alias:'FPC_SYSCALL1'];
asm
{ load the registers... }
@ -73,9 +69,6 @@ asm
cmpl $-4095,%eax
jb .LSyscOK
negl %eax
{$ifdef VER1_0}
movl %eax,Errno
{$else}
{$ifdef REGCALL}
movl fpc_threadvar_relocate_proc,%ecx
testl %ecx,%ecx
@ -103,12 +96,11 @@ asm
movl %edx,(%eax)
.LNoThread:
{$endif REGCALL}
{$endif ver1_0}
movl $-1,%eax
.LSyscOK:
end;
function FpSysCall(sysnr,param1,param2 : TSysParam):TSysResult; assembler; {$ifndef VER1_0} oldfpccall; {$endif} [public,alias:'FPC_SYSCALL2'];
function FpSysCall(sysnr,param1,param2 : TSysParam):TSysResult; assembler; oldfpccall; [public,alias:'FPC_SYSCALL2'];
asm
{ load the registers... }
@ -119,9 +111,6 @@ asm
cmpl $-4095,%eax
jb .LSyscOK
negl %eax
{$ifdef VER1_0}
movl %eax,Errno
{$else}
{$ifdef REGCALL}
movl fpc_threadvar_relocate_proc,%ecx
testl %ecx,%ecx
@ -149,12 +138,11 @@ asm
movl %edx,(%eax)
.LNoThread:
{$endif REGCALL}
{$endif ver1_0}
movl $-1,%eax
.LSyscOK:
end;
function FpSysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; assembler; {$ifndef VER1_0} oldfpccall; {$endif} [public,alias:'FPC_SYSCALL3'];
function FpSysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; assembler; oldfpccall; [public,alias:'FPC_SYSCALL3'];
asm
{ load the registers... }
@ -166,9 +154,6 @@ asm
cmpl $-4095,%eax
jb .LSyscOK
negl %eax
{$ifdef VER1_0}
movl %eax,Errno
{$else}
{$ifdef REGCALL}
movl fpc_threadvar_relocate_proc,%ecx
testl %ecx,%ecx
@ -196,12 +181,11 @@ asm
movl %edx,(%eax)
.LNoThread:
{$endif REGCALL}
{$endif ver1_0}
movl $-1,%eax
.LSyscOK:
end;
function FpSysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; assembler; {$ifndef VER1_0} oldfpccall; {$endif} [public,alias:'FPC_SYSCALL4'];
function FpSysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; assembler; oldfpccall; [public,alias:'FPC_SYSCALL4'];
asm
{ load the registers... }
@ -214,9 +198,6 @@ asm
cmpl $-4095,%eax
jb .LSyscOK
negl %eax
{$ifdef VER1_0}
movl %eax,Errno
{$else}
{$ifdef REGCALL}
movl fpc_threadvar_relocate_proc,%ecx
testl %ecx,%ecx
@ -244,12 +225,11 @@ asm
movl %edx,(%eax)
.LNoThread:
{$endif REGCALL}
{$endif ver1_0}
movl $-1,%eax
.LSyscOK:
end;
function FpSysCall(sysnr,param1,param2,param3,param4,param5 : TSysParam):TSysResult; assembler; {$ifndef VER1_0} oldfpccall; {$endif}[public,alias:'FPC_SYSCALL5'];
function FpSysCall(sysnr,param1,param2,param3,param4,param5 : TSysParam):TSysResult; assembler; oldfpccall;[public,alias:'FPC_SYSCALL5'];
asm
{ load the registers... }
@ -263,9 +243,6 @@ asm
cmpl $-4095,%eax
jb .LSyscOK
negl %eax
{$ifdef VER1_0}
movl %eax,Errno
{$else}
{$ifdef REGCALL}
movl fpc_threadvar_relocate_proc,%ecx
testl %ecx,%ecx
@ -293,14 +270,13 @@ asm
movl %edx,(%eax)
.LNoThread:
{$endif REGCALL}
{$endif ver1_0}
movl $-1,%eax
.LSyscOK:
end;
{$ifdef notsupported}
{ Only 5 params are pushed, so it'll not work as expected (PFV) }
function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6 : TSysParam):TSysResult; assembler; {$ifndef VER1_0} oldfpccall; {$endif}[public,alias:'FPC_SYSCALL6'];
function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6 : TSysParam):TSysResult; assembler; oldfpccall;[public,alias:'FPC_SYSCALL6'];
asm
{ load the registers... }
@ -314,9 +290,6 @@ asm
cmpl $-4095,%eax
jb .LSyscOK
negl %eax
{$ifdef VER1_0}
movl %eax,Errno
{$else}
{$ifdef REGCALL}
movl fpc_threadvar_relocate_proc,%ecx
testl %ecx,%ecx
@ -344,7 +317,6 @@ asm
movl %edx,(%eax)
.LNoThread:
{$endif REGCALL}
{$endif ver1_0}
movl $-1,%eax
.LSyscOK:
end;

14
rtl/linux/i386/syscallh.inc
View File

@ -34,14 +34,14 @@ Type
TSysParam = Longint;
function Do_SysCall(sysnr:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL0';
function Do_SysCall(sysnr,param1:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL1';
function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL2';
function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL3';
function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL4';
function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL5';
function Do_SysCall(sysnr:TSysParam):TSysResult; oldfpccall; external name 'FPC_SYSCALL0';
function Do_SysCall(sysnr,param1:TSysParam):TSysResult; oldfpccall; external name 'FPC_SYSCALL1';
function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult; oldfpccall; external name 'FPC_SYSCALL2';
function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; oldfpccall; external name 'FPC_SYSCALL3';
function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; oldfpccall; external name 'FPC_SYSCALL4';
function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; oldfpccall; external name 'FPC_SYSCALL5';
{$ifdef notsupported}
function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL6';
function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult; oldfpccall; external name 'FPC_SYSCALL6';
{$endif notsupported}
{

2
rtl/linux/system.pp
View File

@ -22,7 +22,7 @@
{ If you use an aout system, set the conditional AOUT}
{ $Define AOUT}
Unit {$ifdef VER1_0}Syslinux{$else}System{$endif};
Unit System;
Interface

2
rtl/morphos/system.pp
View File

@ -20,7 +20,7 @@
**********************************************************************}
unit {$ifdef VER1_0}SysMorph{$else}System{$endif};
unit System;
interface

270
rtl/netbsd/tthread.inc
View File

@ -15,275 +15,6 @@
}
{$IFDEF VER1_0} // leaving the old implementation in for now...
type
PThreadRec=^TThreadRec;
TThreadRec=record
thread : TThread;
next : PThreadRec;
end;
var
ThreadRoot : PThreadRec;
ThreadsInited : boolean;
// MainThreadID: longint;
Const
ThreadCount: longint = 0;
function ThreadSelf:TThread;
var
hp : PThreadRec;
sp : Pointer;
begin
sp:=SPtr;
hp:=ThreadRoot;
while assigned(hp) do
begin
if (sp<=hp^.Thread.FStackPointer) and
(sp>(hp^.Thread.FStackPointer-hp^.Thread.FStackSize)) then
begin
Result:=hp^.Thread;
exit;
end;
hp:=hp^.next;
end;
Result:=nil;
end;
//function SIGCHLDHandler(Sig: longint): longint; cdecl;//this is std linux C declaration as function
procedure SIGCHLDHandler(Sig: longint); cdecl;
begin
fpwaitpid(-1, nil, WNOHANG);
end;
procedure InitThreads;
var
Act, OldAct: Baseunix.PSigActionRec;
begin
ThreadRoot:=nil;
ThreadsInited:=true;
// This will install SIGCHLD signal handler
// signal() installs "one-shot" handler,
// so it is better to install and set up handler with sigaction()
GetMem(Act, SizeOf(SigActionRec));
GetMem(OldAct, SizeOf(SigActionRec));
Act^.sa_handler := TSigAction(@SIGCHLDHandler);
Act^.sa_flags := SA_NOCLDSTOP {or SA_NOMASK or SA_RESTART};
Fillchar(Act^.sa_mask,sizeof(Act^.sa_mask),0); //Do not block all signals ??. Don't need if SA_NOMASK in flags
FpSigAction(SIGCHLD, Act, OldAct);
FreeMem(Act, SizeOf(SigActionRec));
FreeMem(OldAct, SizeOf(SigActionRec));
end;
procedure DoneThreads;
var
hp : PThreadRec;
begin
while assigned(ThreadRoot) do
begin
ThreadRoot^.Thread.Destroy;
hp:=ThreadRoot;
ThreadRoot:=ThreadRoot^.Next;
dispose(hp);
end;
ThreadsInited:=false;
end;
procedure AddThread(t:TThread);
var
hp : PThreadRec;
begin
{ Need to initialize threads ? }
if not ThreadsInited then
InitThreads;
{ Put thread in the linked list }
new(hp);
hp^.Thread:=t;
hp^.next:=ThreadRoot;
ThreadRoot:=hp;
inc(ThreadCount, 1);
end;
procedure RemoveThread(t:TThread);
var
lasthp,hp : PThreadRec;
begin
hp:=ThreadRoot;
lasthp:=nil;
while assigned(hp) do
begin
if hp^.Thread=t then
begin
if assigned(lasthp) then
lasthp^.next:=hp^.next
else
ThreadRoot:=hp^.next;
dispose(hp);
exit;
end;
lasthp:=hp;
hp:=hp^.next;
end;
Dec(ThreadCount, 1);
if ThreadCount = 0 then DoneThreads;
end;
{ TThread }
function ThreadProc(args:pointer): Integer;cdecl;
var
FreeThread: Boolean;
Thread : TThread absolute args;
begin
while Thread.FHandle = 0 do fpsleep(1);
if Thread.FSuspended then Thread.suspend();
try
Thread.Execute;
except
Thread.FFatalException := TObject(AcquireExceptionObject);
end;
FreeThread := Thread.FFreeOnTerminate;
Result := Thread.FReturnValue;
Thread.FFinished := True;
Thread.DoTerminate;
if FreeThread then
Thread.Free;
fpexit(Result);
end;
constructor TThread.Create(CreateSuspended: Boolean);
var
Flags: Integer;
begin
inherited Create;
AddThread(self);
FSuspended := CreateSuspended;
Flags := CLONE_VM + CLONE_FS + CLONE_FILES + CLONE_SIGHAND + SIGCHLD;
{ Setup 16k of stack }
FStackSize:=16384;
Getmem(FStackPointer,FStackSize);
inc(FStackPointer,FStackSize);
FCallExitProcess:=false;
{ Clone }
FHandle:= Clone(@ThreadProc,FStackPointer,Flags,self);
// if FSuspended then Suspend;
FThreadID := FHandle;
IsMultiThread := TRUE;
FFatalException := nil;
end;
destructor TThread.Destroy;
begin
if not FFinished and not Suspended then
begin
Terminate;
WaitFor;
end;
if FHandle <> -1 then
fpkill(FHandle, SIGKILL);
dec(FStackPointer,FStackSize);
Freemem(FStackPointer);
FFatalException.Free;
FFatalException := nil;
inherited Destroy;
RemoveThread(self);
end;
procedure TThread.CallOnTerminate;
begin
FOnTerminate(Self);
end;
procedure TThread.DoTerminate;
begin
if Assigned(FOnTerminate) then
Synchronize(@CallOnTerminate);
end;
const
{ I Don't know idle or timecritical, value is also 20, so the largest other
possibility is 19 (PFV) }
Priorities: array [TThreadPriority] of Integer =
(-20,-19,-10,9,10,19,20);
function TThread.GetPriority: TThreadPriority;
var
P: Integer;
I: TThreadPriority;
begin
P := fpGetPriority(Prio_Process,FHandle);
Result := tpNormal;
for I := Low(TThreadPriority) to High(TThreadPriority) do
if Priorities[I] = P then
Result := I;
end;
procedure TThread.SetPriority(Value: TThreadPriority);
begin
fpSetPriority(Prio_Process,FHandle,Priorities[Value]);
end;
procedure TThread.SetSuspended(Value: Boolean);
begin
if Value <> FSuspended then
if Value then
Suspend
else
Resume;
end;
procedure TThread.Suspend;
begin
FSuspended := true;
fpKill(FHandle, SIGSTOP);
end;
procedure TThread.Resume;
begin
fpKill(FHandle, SIGCONT);
FSuspended := False;
end;
procedure TThread.Terminate;
begin
FTerminated := True;
end;
function TThread.WaitFor: Integer;
var
status : longint;
begin
if FThreadID = MainThreadID then
fpwaitpid(0,@status,0)
else
fpwaitpid(FHandle,@status,0);
Result:=status;
end;
{$ELSE}
{
What follows, is a short description on my implementation of TThread.
Most information can also be found by reading the source and accompanying
@ -580,7 +311,6 @@ procedure TThread.SetPriority(Value: TThreadPriority);
begin
ThreadSetPriority(FHandle, Priorities[Value]);
end;
{$ENDIF}
{
$Log: tthread.inc,v $

10
rtl/objpas/classes/bits.inc
View File

@ -18,21 +18,13 @@
Procedure BitsError (Msg : string);
begin
{$ifdef VER1_0}
Raise EBitsError.Create(Msg) at longint(get_caller_addr(get_frame));
{$else VER1_0}
Raise EBitsError.Create(Msg) at get_caller_addr(get_frame);
{$endif VER1_0}
end;
Procedure BitsErrorFmt (Msg : string; const Args : array of const);
begin
{$ifdef VER1_0}
Raise EBitsError.CreateFmt(Msg,args) at longint(get_caller_addr(get_frame));
{$else VER1_0}
Raise EBitsError.CreateFmt(Msg,args) at get_caller_addr(get_frame);
{$endif VER1_0}
end;
procedure TBits.CheckBitIndex (Bit : longint;CurrentSize : Boolean);
@ -96,7 +88,7 @@ end;
{ ******************** TBits ***************************** }
constructor TBits.Create(theSize : longint {$ifndef VER1_0} = 0 {$endif});
constructor TBits.Create(theSize : longint = 0 );
begin
FSize := 0;
FBits := nil;

4
rtl/objpas/convutil.inc
View File

@ -23,7 +23,6 @@ unit convutils;
interface
{$ifndef VER1_0}
{$mode objfpc}
{$H+}
@ -203,11 +202,9 @@ function Convert ( const Measurement : Double; const FromType, ToType : TConvT
function Convert ( const Measurement : Double; const FromType1, FromType2, ToType1, ToType2 : TConvType ) :TConvUtilFloat;
{$endif VER1_0}
Implementation
{$ifndef VER1_0}
ResourceString // Note, designations for FFU's are guesses.
txtauSquareMillimeters = 'Square millimeters (mm^2)';
@ -647,7 +644,6 @@ initialization
finalization
setlength(theunits,0);
setlength(thefamilies,0);
{$endif VER1_0}
end.
{

10
rtl/objpas/math.pp
View File

@ -27,10 +27,6 @@ unit math;
interface
{$MODE objfpc}
{$ifdef VER1_0}
{ we don't assume cross compiling from 1.0.x-m68k ... }
{$define FPC_HAS_TYPE_EXTENDED}
{$endif VER1_0}
uses
sysutils;
@ -114,7 +110,6 @@ interface
EqualsValue = 0;
LessThanValue = Low(TValueRelationship);
GreaterThanValue = High(TValueRelationship);
{$ifndef ver1_0}
{$ifopt R+}
{$define RangeCheckWasOn}
{$R-}
@ -138,7 +133,6 @@ interface
{$Q+}
{$undef OverflowCheckWasOn}
{$endif}
{$endif ver1_0}
{ Min/max determination }
function MinIntValue(const Data: array of Integer): Integer;
@ -356,11 +350,9 @@ procedure momentskewkurtosis(const data : PFloat; Const N : Integer;
function norm(const data : array of float) : float;
function norm(const data : PFloat; Const N : Integer) : float;
{$ifndef ver1_0} // default params
function ifthen(val:boolean;const iftrue:integer; const iffalse:integer= 0) :integer; {$ifdef MATHINLINE}inline; {$endif}
function ifthen(val:boolean;const iftrue:int64 ; const iffalse:int64 = 0) :int64; {$ifdef MATHINLINE}inline; {$endif}
function ifthen(val:boolean;const iftrue:double ; const iffalse:double =0.0):double; {$ifdef MATHINLINE}inline; {$endif}
{$endif}
{ include cpu specific stuff }
{$i mathuh.inc}
@ -1373,7 +1365,6 @@ begin
end;
{$endif}
{$ifndef ver1_0} // default params
function ifthen(val:boolean;const iftrue:integer; const iffalse:integer= 0) :integer;
begin
if val then result:=iftrue else result:=iffalse;
@ -1388,7 +1379,6 @@ function ifthen(val:boolean;const iftrue:double ; const iffalse:double =0.0):dou
begin
if val then result:=iftrue else result:=iffalse;
end;
{$endif}
end.
{

4
rtl/objpas/sysutils/dati.inc
View File

@ -258,7 +258,7 @@ end ;
{ IncMonth increments DateTime with NumberOfMonths months,
NumberOfMonths can be less than zero }
function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer {$ifndef ver1_0} = 1 {$endif}): TDateTime;
function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer = 1 ): TDateTime;
var
Year, Month, Day: word;
S : Integer;
@ -753,7 +753,6 @@ begin
EncodeTime(Time shr 11, (Time shr 5) and 63, (Time and 31) shl 1,0);
end;
{$ifndef VER1_0}
function TryStrToDate(const S: string; out Value: TDateTime): Boolean;
begin
@ -799,7 +798,6 @@ function TryStrToDateTime(const S: string; out Value: TDateTime): Boolean;
// function TryStrToDateTime(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
{$endif VER1_0}
{
$Log: dati.inc,v $

4
rtl/objpas/sysutils/datih.inc
View File

@ -110,7 +110,7 @@ function DayOfWeek(DateTime: TDateTime): integer;
function Date: TDateTime;
function Time: TDateTime;
function Now: TDateTime;
function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer {$ifndef ver1_0} = 1 {$endif}): TDateTime;
function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer = 1 ): TDateTime;
function IsLeapYear(Year: Word): boolean;
function DateToStr(Date: TDateTime): string;
function TimeToStr(Time: TDateTime): string;
@ -122,14 +122,12 @@ function FormatDateTime(FormatStr: string; DateTime: TDateTime):string;
procedure DateTimeToString(var Result: string; const FormatStr: string; const DateTime: TDateTime);
Function DateTimeToFileDate(DateTime : TDateTime) : Longint;
Function FileDateToDateTime (Filedate : Longint) :TDateTime;
{$ifndef VER1_0}
function TryStrToDate(const S: string; out Value: TDateTime): Boolean;
// function TryStrToDate(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
function TryStrToTime(const S: string; out Value: TDateTime): Boolean;
// function TryStrToTime(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
function TryStrToDateTime(const S: string; out Value: TDateTime): Boolean;
// function TryStrToDateTime(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
{$endif VER1_0}
{ FPC Extra }
Procedure GetLocalTime(var SystemTime: TSystemTime);

32
rtl/objpas/sysutils/sysformt.inc
View File

@ -4,11 +4,7 @@ Var ChPos,OldPos,ArgPos,DoArg,Len : SizeInt;
Width,Prec : Longint;
Left : Boolean;
Fchar : char;
{$ifdef ver1_0}
vl : int64;
{$else}
vq : qword;
{$endif}
{
ReadFormat reads the format string. It returns the type character in
@ -274,7 +270,6 @@ begin
if CheckArg(vtPChar,false) then
hs:=Args[doarg].VPChar
else
{$ifndef VER1_0}
if CheckArg(vtPWideChar,false) then
hs:=WideString(Args[doarg].VPWideChar)
else
@ -284,7 +279,6 @@ begin
if CheckArg(vtWidestring,false) then
hs:=WideString(Args[doarg].VWideString)
else
{$endif VER1_0}
if CheckArg(vtAnsiString,true) then
hs:=ansistring(Args[doarg].VAnsiString);
Index:=Length(hs);
@ -299,31 +293,6 @@ begin
// Insert(':',ToAdd,5);
end;
'X' : begin
{$ifdef ver1_0}
if Checkarg(vtinteger,false) then
begin
vl:=Args[Doarg].VInteger and int64($ffffffff);
index:=16;
end
else
begin
CheckArg(vtInt64,true);
vl:=Args[DoArg].VInt64^;
index:=31;
end;
If Prec>index then
ToAdd:=HexStr(vl,index)
else
begin
// determine minimum needed number of hex digits.
Index:=1;
While (DWord(1 shl (Index*4))<=DWord(Args[DoArg].VInteger)) and (index<8) do
inc(Index);
If Index>Prec then
Prec:=Index;
ToAdd:=HexStr(int64(vl),Prec);
end;
{$else}
if Checkarg(vtinteger,false) then
begin
vq:=Cardinal(Args[Doarg].VInteger);
@ -347,7 +316,6 @@ begin
Prec:=Index;
ToAdd:=HexStr(vq,Prec);
end;
{$endif}
end;
'%': ToAdd:='%';
end;

2
rtl/objpas/sysutils/sysint.inc
View File

@ -20,7 +20,6 @@ procedure InitInternationalGeneric;
fillchar(SysLocale,sizeof(SysLocale),0);
{ keep these routines out of the executable? }
{$ifndef VER1_0}
{$ifndef FPC_NOGENERICANSIROUTINES}
widestringmanager.UpperAnsiStringProc:=@GenericAnsiUpperCase;
widestringmanager.LowerAnsiStringProc:=@GenericAnsiLowerCase;
@ -33,7 +32,6 @@ procedure InitInternationalGeneric;
widestringmanager.StrLowerAnsiStringProc:=@GenericAnsiStrLower;
widestringmanager.StrUpperAnsiStringProc:=@GenericAnsiStrUpper;
{$endif FPC_NOGENERICANSIROUTINES}
{$endif}
end;
{

24
rtl/objpas/sysutils/sysstr.inc
View File

@ -409,81 +409,61 @@ end ;
function AnsiUpperCase(const s: string): string;{$ifdef SYSUTILSINLINE}inline;{$endif}
begin
{$ifndef ver1_0}
result:=widestringmanager.UpperAnsiStringProc(s);
{$endif}
end;
function AnsiLowerCase(const s: string): string;{$ifdef SYSUTILSINLINE}inline;{$endif}
begin
{$ifndef ver1_0}
result:=widestringmanager.LowerAnsiStringProc(s);
{$endif}
end;
function AnsiCompareStr(const S1, S2: string): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
begin
{$ifndef ver1_0}
result:=widestringmanager.CompareStrAnsiStringProc(s1,s2);
{$endif}
end;
function AnsiCompareText(const S1, S2: string): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
begin
{$ifndef ver1_0}
result:=widestringmanager.CompareTextAnsiStringProc(s1,s2);
{$endif}
end;
function AnsiStrComp(S1, S2: PChar): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
begin
{$ifndef ver1_0}
result:=widestringmanager.StrCompAnsiStringProc(s1,s2);
{$endif}
end;
function AnsiStrIComp(S1, S2: PChar): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
begin
{$ifndef ver1_0}
result:=widestringmanager.StrICompAnsiStringProc(s1,s2);
{$endif}
end;
function AnsiStrLComp(S1, S2: PChar; MaxLen: cardinal): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
begin
{$ifndef ver1_0}
result:=widestringmanager.StrLCompAnsiStringProc(s1,s2,maxlen);
{$endif}
end;
function AnsiStrLIComp(S1, S2: PChar; MaxLen: cardinal): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
begin
{$ifndef ver1_0}
result:=widestringmanager.StrLICompAnsiStringProc(s1,s2,maxlen);
{$endif}
end;
function AnsiStrLower(Str: PChar): PChar;{$ifdef SYSUTILSINLINE}inline;{$endif}
begin
{$ifndef ver1_0}
result:=widestringmanager.StrLowerAnsiStringProc(Str);
{$endif}
end;
function AnsiStrUpper(Str: PChar): PChar;{$ifdef SYSUTILSINLINE}inline;{$endif}
begin
{$ifndef ver1_0}
result:=widestringmanager.StrUpperAnsiStringProc(Str);
{$endif}
end;
@ -1176,13 +1156,9 @@ end;
function TryFloatToCurr(const Value: Extended; var AResult: Currency): Boolean;
begin
{$ifndef VER1_0}
Result:=(Value>=MinCurrency) and (Value<=MaxCurrency);
if Result then
AResult := Value;
{$else VER1_0}
Result:=false;
{$endif VER1_0}
end;
function FloatToCurr(const Value: Extended): Currency;

2
rtl/objpas/sysutils/sysstrh.inc
View File

@ -44,7 +44,6 @@ const
MinDateTime: TDateTime = -657434.0; { 01/01/0100 12:00:00.000 AM }
MaxDateTime: TDateTime = 2958465.99999; { 12/31/9999 11:59:59.999 PM }
{$ifndef VER1_0}
{$if defined(FPC_HAS_TYPE_EXTENDED) or defined(FPC_HAS_TYPE_FLOAT128)}
MinCurrency: Currency = -922337203685477.5807;
MaxCurrency: Currency = 922337203685477.5807;
@ -52,7 +51,6 @@ const
MinCurrency: Currency = -922337203685477.0000;
MaxCurrency: Currency = 922337203685477.0000;
{$endif}
{$endif VER1_0}
Type
TTextLineBreakStyle = (tlbsLF, tlbsCRLF,tlbsCR); // Must move to system unit, and add Mac tlbsCR too ?

8
rtl/objpas/sysutils/sysutilh.inc
View File

@ -29,13 +29,7 @@
type
{ some helpful data types }
{$IFDEF VER1_0}
(* System type alias cannot be used under version *)
(* 1.0 because of different names of System unit. *)
THandle = longint;
{$ELSE VER1_0}
THandle = System.THandle;
{$ENDIF VER1_0}
TProcedure = procedure;
@ -211,10 +205,8 @@ Type
{ MCBS functions }
{$i sysansih.inc}
{$ifndef VER1_0}
{ wide string functions }
{$i syswideh.inc}
{$endif VER1_0}
{ Read filename handling functions declaration }
{$i finah.inc}

15
rtl/objpas/sysutils/sysutils.inc
View File

@ -70,10 +70,8 @@
{ MCBS functions }
{$i sysansi.inc}
{$ifndef VER1_0}
{ wide string functions }
{$i syswide.inc}
{$endif VER1_0}
{ CPU Specific code }
{$i sysutilp.inc}
@ -262,11 +260,7 @@ begin
else
E:=Exception.CreateFmt (SUnKnownRunTimeError,[Errno]);
end;
{$ifdef VER1_0}
Raise E at longint(Address){$ifdef ENHANCEDRAISE},longint(Frame){$endif};
{$else VER1_0}
Raise E at Address,Frame;
{$endif VER1_0}
end;
{$IFDEF HAS_OSERROR}
@ -408,14 +402,7 @@ end;
procedure Abort;
begin
{$ifdef VER1_0}
Raise EAbort.Create(SAbortError) at Longint(Get_Caller_addr(Get_Frame));
{$else VER1_0}
Raise EAbort.Create(SAbortError)
{$IFNDEF VIRTUALPASCAL}
at Pointer(Get_Caller_addr(Get_Frame));
{$ENDIF}
{$endif VER1_0}
Raise EAbort.Create(SAbortError) at Pointer(Get_Caller_addr(Get_Frame));
end;
procedure OutOfMemoryError;

269
rtl/openbsd/tthread.inc
View File

@ -15,274 +15,6 @@
}
{$IFDEF VER1_0} // leaving the old implementation in for now...
type
PThreadRec=^TThreadRec;
TThreadRec=record
thread : TThread;
next : PThreadRec;
end;
var
ThreadRoot : PThreadRec;
ThreadsInited : boolean;
// MainThreadID: longint;
Const
ThreadCount: longint = 0;
function ThreadSelf:TThread;
var
hp : PThreadRec;
sp : Pointer;
begin
sp:=SPtr;
hp:=ThreadRoot;
while assigned(hp) do
begin
if (sp<=hp^.Thread.FStackPointer) and
(sp>(hp^.Thread.FStackPointer-hp^.Thread.FStackSize)) then
begin
Result:=hp^.Thread;
exit;
end;
hp:=hp^.next;
end;
Result:=nil;
end;
//function SIGCHLDHandler(Sig: longint): longint; cdecl;//this is std linux C declaration as function
procedure SIGCHLDHandler(Sig: longint); cdecl;
begin
fpwaitpid(-1, nil, WNOHANG);
end;
procedure InitThreads;
var
Act, OldAct: Baseunix.PSigActionRec;
begin
ThreadRoot:=nil;
ThreadsInited:=true;
// This will install SIGCHLD signal handler
// signal() installs "one-shot" handler,
// so it is better to install and set up handler with sigaction()
GetMem(Act, SizeOf(SigActionRec));
GetMem(OldAct, SizeOf(SigActionRec));
Act^.sa_handler := TSigAction(@SIGCHLDHandler);
Act^.sa_flags := SA_NOCLDSTOP {or SA_NOMASK or SA_RESTART};
Fillchar(Act^.sa_mask,sizeof(Act^.sa_mask),0); //Do not block all signals ??. Don't need if SA_NOMASK in flags
FpSigAction(SIGCHLD, Act, OldAct);
FreeMem(Act, SizeOf(SigActionRec));
FreeMem(OldAct, SizeOf(SigActionRec));
end;
procedure DoneThreads;
var
hp : PThreadRec;
begin
while assigned(ThreadRoot) do
begin
ThreadRoot^.Thread.Destroy;
hp:=ThreadRoot;
ThreadRoot:=ThreadRoot^.Next;
dispose(hp);
end;
ThreadsInited:=false;
end;
procedure AddThread(t:TThread);
var
hp : PThreadRec;
begin
{ Need to initialize threads ? }
if not ThreadsInited then
InitThreads;
{ Put thread in the linked list }
new(hp);
hp^.Thread:=t;
hp^.next:=ThreadRoot;
ThreadRoot:=hp;
inc(ThreadCount, 1);
end;
procedure RemoveThread(t:TThread);
var
lasthp,hp : PThreadRec;
begin
hp:=ThreadRoot;
lasthp:=nil;
while assigned(hp) do
begin
if hp^.Thread=t then
begin
if assigned(lasthp) then
lasthp^.next:=hp^.next
else
ThreadRoot:=hp^.next;
dispose(hp);
exit;
end;
lasthp:=hp;
hp:=hp^.next;
end;
Dec(ThreadCount, 1);
if ThreadCount = 0 then DoneThreads;
end;
{ TThread }
function ThreadProc(args:pointer): Integer;cdecl;
var
FreeThread: Boolean;
Thread : TThread absolute args;
begin
while Thread.FHandle = 0 do fpsleep(1);
if Thread.FSuspended then Thread.suspend();
try
Thread.Execute;
except
Thread.FFatalException := TObject(AcquireExceptionObject);
end;
FreeThread := Thread.FFreeOnTerminate;
Result := Thread.FReturnValue;
Thread.FFinished := True;
Thread.DoTerminate;
if FreeThread then
Thread.Free;
fpexit(Result);
end;
constructor TThread.Create(CreateSuspended: Boolean);
var
Flags: Integer;
begin
inherited Create;
AddThread(self);
FSuspended := CreateSuspended;
Flags := CLONE_VM + CLONE_FS + CLONE_FILES + CLONE_SIGHAND + SIGCHLD;
{ Setup 16k of stack }
FStackSize:=16384;
Getmem(FStackPointer,FStackSize);
inc(FStackPointer,FStackSize);
FCallExitProcess:=false;
{ Clone }
FHandle:= Clone(@ThreadProc,FStackPointer,Flags,self);
// if FSuspended then Suspend;
FThreadID := FHandle;
IsMultiThread := TRUE;
FFatalException := nil;
end;
destructor TThread.Destroy;
begin
if not FFinished and not Suspended then
begin
Terminate;
WaitFor;
end;
if FHandle <> -1 then
fpkill(FHandle, SIGKILL);
dec(FStackPointer,FStackSize);
Freemem(FStackPointer);
FFatalException.Free;
FFatalException := nil;
inherited Destroy;
RemoveThread(self);
end;
procedure TThread.CallOnTerminate;
begin
FOnTerminate(Self);
end;
procedure TThread.DoTerminate;
begin
if Assigned(FOnTerminate) then
Synchronize(@CallOnTerminate);
end;
const
{ I Don't know idle or timecritical, value is also 20, so the largest other
possibility is 19 (PFV) }
Priorities: array [TThreadPriority] of Integer =
(-20,-19,-10,9,10,19,20);
function TThread.GetPriority: TThreadPriority;
var
P: Integer;
I: TThreadPriority;
begin
P := fpGetPriority(Prio_Process,FHandle);
Result := tpNormal;
for I := Low(TThreadPriority) to High(TThreadPriority) do
if Priorities[I] = P then
Result := I;
end;
procedure TThread.SetPriority(Value: TThreadPriority);
begin
fpSetPriority(Prio_Process,FHandle,Priorities[Value]);
end;
procedure TThread.SetSuspended(Value: Boolean);
begin
if Value <> FSuspended then
if Value then
Suspend
else
Resume;
end;
procedure TThread.Suspend;
begin
FSuspended := true;
fpKill(FHandle, SIGSTOP);
end;
procedure TThread.Resume;
begin
fpKill(FHandle, SIGCONT);
FSuspended := False;
end;
procedure TThread.Terminate;
begin
FTerminated := True;
end;
function TThread.WaitFor: Integer;
var
status : longint;
begin
if FThreadID = MainThreadID then
fpwaitpid(0,@status,0)
else
fpwaitpid(FHandle,@status,0);
Result:=status;
end;
{$ELSE}
{
What follows, is a short description on my implementation of TThread.
@ -580,7 +312,6 @@ procedure TThread.SetPriority(Value: TThreadPriority);
begin
ThreadSetPriority(FHandle, Priorities[Value]);
end;
{$ENDIF}
{
$Log: tthread.inc,v $

35
rtl/os2/crt.pas
View File

@ -14,11 +14,6 @@ unit crt;
interface
{$IFNDEF VER1_0}
{$INLINE ON}
{$ENDIF VER1_0}
{$i crth.inc}
procedure Window32 (X1, Y1, X2, Y2: dword);
@ -181,10 +176,7 @@ begin
end;
procedure GetScreenCursor (var X, Y: dword);
{$IFNDEF VER1_0}
inline;
{$ENDIF VER1_0}
procedure GetScreenCursor (var X, Y: dword);inline;
(* Return current cursor postion - 0-based. *)
var
X0, Y0: word;
@ -199,20 +191,14 @@ begin
end;
procedure SetScreenCursor (X, Y: dword);
{$IFNDEF VER1_0}
inline;
{$ENDIF VER1_0}
procedure SetScreenCursor (X, Y: dword); inline;
(* Set current cursor postion - 0-based. *)
begin
VioSetCurPos (Y, X, VioHandle);
end;
procedure RemoveLines (Row: dword; Cnt: dword);
{$IFNDEF VER1_0}
inline;
{$ENDIF VER1_0}
procedure RemoveLines (Row: dword; Cnt: dword); inline;
(* Remove Cnt lines from screen starting with (0-based) Row. *)
var
ScrEl: word;
@ -223,10 +209,7 @@ begin
end;
procedure ClearCells (X, Y, Cnt: dword);
{$IFNDEF VER1_0}
inline;
{$ENDIF VER1_0}
procedure ClearCells (X, Y, Cnt: dword); inline;
(* Clear Cnt cells in line Y (0-based) starting with position X (0-based). *)
var
ScrEl: word;
@ -284,20 +267,14 @@ begin
end;
procedure WriteNormal (C: char; X, Y: dword);
{$IFNDEF VER1_0}
inline;
{$ENDIF VER1_0}
procedure WriteNormal (C: char; X, Y: dword); inline;
(* Write C to console at X, Y (0-based). *)
begin
VioWrtCharStrAtt (@C, 1, Y, X, TextAttr, VioHandle);
end;
procedure WriteBell;
{$IFNDEF VER1_0}
inline;
{$ENDIF VER1_0}
procedure WriteBell; inline;
(* Write character #7 - beep. *)
begin
DosBeep (800, 250);

2
rtl/os2/system.pas
View File

@ -15,7 +15,7 @@
****************************************************************************}
unit {$ifdef VER1_0}sysos2{$else}System{$endif};
unit System;
interface

2
rtl/palmos/system.pp
View File

@ -16,7 +16,7 @@
{$define PALMOS}
{$ASMMODE DIRECT}
unit {$ifdef VER1_0}syspalm{$else}system{$endif};
unit system;
{$I os.inc}

2
rtl/sparc/mathu.inc
View File

@ -112,7 +112,7 @@ function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
end;
procedure ClearExceptions(RaisePending: Boolean {$ifndef VER1_0}=true{$endif});
procedure ClearExceptions(RaisePending: Boolean =true);
begin
set_fsr(get_fsr and $fffffc1f);
end;

2
rtl/sparc/mathuh.inc
View File

@ -26,7 +26,7 @@ function GetPrecisionMode: TFPUPrecisionMode;
function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
function GetExceptionMask: TFPUExceptionMask;
function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
procedure ClearExceptions(RaisePending: Boolean {$ifndef VER1_0}=true{$endif});
procedure ClearExceptions(RaisePending: Boolean =true);
{
$Log: mathuh.inc,v $

2
rtl/unix/classes.pp
View File

@ -46,10 +46,8 @@ initialization
finalization
CommonCleanup;
{$ifndef VER1_0}
if ThreadsInited then
DoneThreads;
{$endif}
end.
{
$Log: classes.pp,v $

8
rtl/unix/ctypes.inc
View File

@ -29,11 +29,7 @@ Type
cInt32 = longint;
cUInt32= cardinal;
cInt64 = int64;
{$ifndef VER1_0}
cUInt64= qword;
{$else}
cUInt64= int64;
{$endif}
cuchar = byte;
cchar = shortint;
@ -47,11 +43,7 @@ Type
cuLong = Cardinal;
{$endif}
clonglong = int64;
{$ifndef VER1_0}
culonglong = qword;
{$else VER1_0}
culonglong = int64;
{$endif VER1_0}
cshort = smallint;
cushort = word;

4
rtl/unix/linux.pp
View File

@ -18,11 +18,7 @@
**********************************************************************}
{$ifdef VER1_0}
{$i linuxold.inc}
{$else}
{$i linuxnew.inc}
{$endif}
{
$Log: linux.pp,v $

78
rtl/unix/linuxold.inc
View File

@ -13,11 +13,7 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{$ifdef VER1_0}
unit linux;
{$else}
unit oldlinux;
{$endif}
Interface
@ -1557,24 +1553,24 @@ function MUnMap (P : Pointer; Size : Longint) : Boolean;
Function IOperm (From,Num : Cardinal; Value : Longint) : boolean;
Function IoPL(Level : longint) : Boolean;
{$ifdef cpui386}
Procedure WritePort (Port : Longint; Value : Byte);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure WritePort (Port : Longint; Value : Word);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure WritePort (Port : Longint; Value : Longint);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure WritePortB (Port : Longint; Value : Byte);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure WritePortW (Port : Longint; Value : Word);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure WritePortL (Port : Longint; Value : Longint);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure WritePortL (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure WritePortW (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure WritePortB (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure ReadPort (Port : Longint; Var Value : Byte);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure ReadPort (Port : Longint; Var Value : Word);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure ReadPort (Port : Longint; Var Value : Longint);{$ifndef VER1_0}oldfpccall;{$endif}
function ReadPortB (Port : Longint): Byte;{$ifndef VER1_0}oldfpccall;{$endif}
function ReadPortW (Port : Longint): Word;{$ifndef VER1_0}oldfpccall;{$endif}
function ReadPortL (Port : Longint): LongInt;{$ifndef VER1_0}oldfpccall;{$endif}
Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure WritePort (Port : Longint; Value : Byte);oldfpccall;
Procedure WritePort (Port : Longint; Value : Word);oldfpccall;
Procedure WritePort (Port : Longint; Value : Longint);oldfpccall;
Procedure WritePortB (Port : Longint; Value : Byte);oldfpccall;
Procedure WritePortW (Port : Longint; Value : Word);oldfpccall;
Procedure WritePortL (Port : Longint; Value : Longint);oldfpccall;
Procedure WritePortL (Port : Longint; Var Buf; Count: longint);oldfpccall;
Procedure WritePortW (Port : Longint; Var Buf; Count: longint);oldfpccall;
Procedure WritePortB (Port : Longint; Var Buf; Count: longint);oldfpccall;
Procedure ReadPort (Port : Longint; Var Value : Byte);oldfpccall;
Procedure ReadPort (Port : Longint; Var Value : Word);oldfpccall;
Procedure ReadPort (Port : Longint; Var Value : Longint);oldfpccall;
function ReadPortB (Port : Longint): Byte;oldfpccall;
function ReadPortW (Port : Longint): Word;oldfpccall;
function ReadPortL (Port : Longint): LongInt;oldfpccall;
Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);oldfpccall;
Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);oldfpccall;
Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);oldfpccall;
{$endif}
{**************************
@ -1641,7 +1637,7 @@ Uses Strings;
{$endif}
Procedure Do_SysCall( callnr:longint;var regs : SysCallregs );{$ifndef ver1_0}oldfpccall;{$endif}assembler;
Procedure Do_SysCall( callnr:longint;var regs : SysCallregs );oldfpccall;assembler;
{
This function puts the registers in place, does the call, and then
copies back the registers as they are after the SysCall.
@ -5636,7 +5632,7 @@ begin
end;
Procedure WritePort (Port : Longint; Value : Byte);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure WritePort (Port : Longint; Value : Byte);oldfpccall;
{
Writes 'Value' to port 'Port'
}
@ -5648,7 +5644,7 @@ begin
end ['EAX','EDX'];
end;
Procedure WritePort (Port : Longint; Value : Word);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure WritePort (Port : Longint; Value : Word);oldfpccall;
{
Writes 'Value' to port 'Port'
}
@ -5663,7 +5659,7 @@ end;
Procedure WritePort (Port : Longint; Value : Longint);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure WritePort (Port : Longint; Value : Longint);oldfpccall;
{
Writes 'Value' to port 'Port'
}
@ -5677,7 +5673,7 @@ begin
end;
Procedure WritePortB (Port : Longint; Value : Byte);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure WritePortB (Port : Longint; Value : Byte);oldfpccall;
{
Writes 'Value' to port 'Port'
}
@ -5689,7 +5685,7 @@ begin
end ['EAX','EDX'];
end;
Procedure WritePortW (Port : Longint; Value : Word);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure WritePortW (Port : Longint; Value : Word);oldfpccall;
{
Writes 'Value' to port 'Port'
}
@ -5704,7 +5700,7 @@ end;
Procedure WritePortL (Port : Longint; Value : Longint);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure WritePortL (Port : Longint; Value : Longint);oldfpccall;
{
Writes 'Value' to port 'Port'
}
@ -5719,7 +5715,7 @@ end;
Procedure WritePortl (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure WritePortl (Port : Longint; Var Buf; Count: longint);oldfpccall;
{
Writes 'Count' longints from 'Buf' to Port
}
@ -5736,7 +5732,7 @@ end;
Procedure WritePortW (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure WritePortW (Port : Longint; Var Buf; Count: longint);oldfpccall;
{
Writes 'Count' words from 'Buf' to Port
}
@ -5753,7 +5749,7 @@ end;
Procedure WritePortB (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure WritePortB (Port : Longint; Var Buf; Count: longint);oldfpccall;
{
Writes 'Count' bytes from 'Buf' to Port
}
@ -5770,7 +5766,7 @@ end;
Procedure ReadPort (Port : Longint; Var Value : Byte);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure ReadPort (Port : Longint; Var Value : Byte);oldfpccall;
{
Reads 'Value' from port 'Port'
}
@ -5785,7 +5781,7 @@ end;
Procedure ReadPort (Port : Longint; Var Value : Word);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure ReadPort (Port : Longint; Var Value : Word);oldfpccall;
{
Reads 'Value' from port 'Port'
}
@ -5800,7 +5796,7 @@ end;
Procedure ReadPort (Port : Longint; Var Value : Longint);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure ReadPort (Port : Longint; Var Value : Longint);oldfpccall;
{
Reads 'Value' from port 'Port'
}
@ -5815,7 +5811,7 @@ end;
function ReadPortB (Port : Longint): Byte;{$ifndef VER1_0}oldfpccall;{$endif} assembler;
function ReadPortB (Port : Longint): Byte;oldfpccall; assembler;
{
Reads a byte from port 'Port'
}
@ -5828,7 +5824,7 @@ end ['EAX','EDX'];
function ReadPortW (Port : Longint): Word;{$ifndef VER1_0}oldfpccall;{$endif} assembler;
function ReadPortW (Port : Longint): Word;oldfpccall; assembler;
{
Reads a word from port 'Port'
}
@ -5840,7 +5836,7 @@ end ['EAX','EDX'];
function ReadPortL (Port : Longint): LongInt;{$ifndef VER1_0}oldfpccall;{$endif} assembler;
function ReadPortL (Port : Longint): LongInt;oldfpccall; assembler;
{
Reads a LongInt from port 'Port'
}
@ -5851,7 +5847,7 @@ end ['EAX','EDX'];
Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);oldfpccall;
{
Reads 'Count' longints from port 'Port' to 'Buf'.
}
@ -5868,7 +5864,7 @@ end;
Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);oldfpccall;
{
Reads 'Count' words from port 'Port' to 'Buf'.
}
@ -5885,7 +5881,7 @@ end;
Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);oldfpccall;
{
Reads 'Count' bytes from port 'Port' to 'Buf'.
}

370
rtl/unix/uuid.inc Normal file
View File

@ -0,0 +1,370 @@
{
$Id: sysutils.pp,v 1.59 2005/03/25 22:53:39 jonas Exp $
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by Florian Klaempfl
member of the Free Pascal development team
Sysutils unit for linux
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
Const
KernelUUID = '/proc/sys/kernel/random/uuid';
PreferKernelUUID = False;
Procedure GetURandomBytes(Var Buf; NBytes : Integer);
Var
fd,I : Integer;
P : PByte;
begin
P:=@Buf;
fd:=FileOpen('/dev/urandom',fmOpenRead);
if (fd>=0) then
Try
While (NBytes>0) do
begin
I:=FileRead(fd,P^,nbytes);
If I>0 then
begin
Inc(P,I);
Dec(NBytes,I);
end;
end;
Finally
FileClose(Fd);
end
else
GetRandomBytes(Buf,NBytes);
end;
Const
MAX_ADJUSTMENT = 10;
IPPROTO_IP = 0;
AF_INET = 2;
SOCK_DGRAM = 2;
IF_NAMESIZE = 16;
SIOCGIFCONF = $8912;
SIOCGIFHWADDR = $8927;
Type
{$ifdef FreeBSD}
{$DEFINE SOCK_HAS_SINLEN} // BSD definition of scoketaddr
{$endif}
{$ifdef SOCK_HAS_SINLEN}
sa_family_t=cuchar;
{$else}
sa_family_t=cushort;
{$endif}
Type
in_addr = packed record
case boolean of
true: (s_addr : cuint32); // inaddr_t=cuint32
false: (s_bytes : packed array[1..4] of byte);
end;
TSockAddr = packed Record // if sa_len is defined, sa_family_t is smaller
{$ifdef SOCK_HAS_SINLEN}
sa_len : cuchar;
{$endif}
case integer of
0: (sa_family: sa_family_t;
sa_data: packed array[0..13] of Byte);
1: (sin_family: sa_family_t;
sin_port: cushort;
sin_addr: in_addr;
sin_zero: packed array[0..7] of Byte);
end;
PSockAddr = ^TSockAddr;
Sockaddr = TSockAddr; // Kylix compat
{$packrecords c}
tifr_ifrn = record
case integer of
0 : (ifrn_name: array [0..IF_NAMESIZE-1] of char);
end;
tifmap = record
mem_start : cardinal;
mem_end : cardinal;
base_addr : word;
irq : byte;
dma : byte;
port : byte;
end;
TIFrec = record
ifr_ifrn : tifr_ifrn;
case integer of
0 : (ifru_addr : TSockAddr);
1 : (ifru_dstaddr : TSockAddr);
2 : (ifru_broadaddr : TSockAddr);
3 : (ifru_netmask : TSockAddr);
4 : (ifru_hwaddr : TSockAddr);
5 : (ifru_flags : word);
6 : (ifru_ivalue : longint);
7 : (ifru_mtu : longint);
8 : (ifru_map : tifmap);
9 : (ifru_slave : Array[0..IF_NAMESIZE-1] of char);
10 : (ifru_newname : Array[0..IF_NAMESIZE-1] of char);
11 : (ifru_data : pointer);
end;
TIFConf = record
ifc_len : longint;
case integer of
0 : (ifcu_buf : pointer);
1 : (ifcu_req : ^tifrec);
end;
tuuid = record
time_low : cardinal;
time_mid : Word;
time_hi_and_version : Word;
clock_seq : Word;
node : Array[0..5] of byte;
end;
Function SocketCall(SockCallNr,a1,a2,a3,a4,a5,a6:longint):longint;
var
Args:array[1..6] of longint;
begin
args[1]:=a1;
args[2]:=a2;
args[3]:=a3;
args[4]:=a4;
args[5]:=a5;
args[6]:=a6;
SocketCall:=do_Syscall(syscall_nr_socketcall,sockcallnr,longint(@args));
end;
function SocketCall(SockCallNr,a1,a2,a3:longint):longint;
begin
SocketCall:=SocketCall(SockCallNr,a1,a2,a3,0,0,0);
end;
function fpsocket (domain:cint; xtype:cint; protocol: cint):cint;
begin
fpSocket:=SocketCall(1,Domain,xtype,Protocol);
end;
Var
MacAddr : Packed Array[1..6] of byte = (0,0,0,0,0,0);
MacAddrTried : Byte = 0 ;
Last : TTimeVal = (tv_sec:0;tv_usec:0);
ClockSeq : Word = 0;
AdjustMent : Integer = 0;
Function GetMacAddr : Boolean;
var
i,j,n,Sd : Integer;
buf : Array[0..1023] of byte;
ifc : TIfConf;
ifr : TIFRec;
ifp : ^TIFRec;
p : PChar;
begin
Result:=MacAddrTried>0;
If Result then
Result:=MacAddrTried>1
else
begin
MacAddrTried:=1;
sd:=fpSocket(AF_INET,SOCK_DGRAM,IPPROTO_IP);
if (sd<0) then
exit;
Try
ifc.ifc_len:=Sizeof(Buf);
ifc.ifcu_buf:=@buf;
if fpioctl(sd, SIOCGIFCONF, @ifc)<0 then
Exit;
n:= ifc.ifc_len;
i:=0;
While (Not Result) and (I<N) do
begin
ifp:=@PByte(ifc.ifcu_buf)[i];
move(ifp^.ifr_ifrn.ifrn_name,ifr.ifr_ifrn.ifrn_name,IF_NAMESIZE);
if (fpioctl(sd, SIOCGIFHWADDR, @ifr) >= 0) then
begin
P:=Pchar(@ifr.ifru_hwaddr.sa_data);
Result:=(p[0]<>#0) or (p[1]<>#0) or (p[2]<>#0)
or (p[3]<>#0) or (p[4]<>#0) or (p[5]<>#0);
If Result Then
begin
Move(P^,MacAddr,SizeOf(MacAddr));
MacAddrTried:=2;
// DumpMacAddr;
end;
end;
I:=I+sizeof(tifrec);
end;
Finally
fileClose(sd);
end;
end;
end;
Function GetClock(Var ClockHigh,ClockLow : Cardinal; Var RetClockSeq : Word) : boolean;
Var
TV : TTImeVal;
ClockReg : QWord;
OK : Boolean;
begin
OK:=True;
Repeat
FPGetTimeOfDay(@Tv,Nil);
If (Last.tv_sec=0) and (last.tv_sec=0) then
begin
GetRandomBytes(ClockSeq,SizeOf(ClockSeq));
ClockSeq:=ClockSeq and $1FFF;
last:=TV;
Dec(last.tv_sec);
end;
if (tv.tv_sec<last.tv_sec) or
((tv.tv_sec=last.tv_sec) and (tv.tv_usec<last.tv_usec)) then
begin
ClockSeq:=(ClockSeq+1) and $1FFF;
Adjustment:=0;
Last:=Tv;
end
else if (tv.tv_sec=last.tv_sec) and (tv.tv_usec=last.tv_usec) then
begin
If Adjustment>=MAX_ADJUSTMENT then
OK:=False
else
inc(AdjustMent);
end
else
begin
AdjustMent:=0;
Last:=tv;
end;
Until OK;
ClockReg:=tv.tv_usec*10+adjustment;
Inc(ClockReg,tv.tv_sec*10000000);
Inc(ClockReg,($01B21DD2 shl 32) + $13814000);
ClockHigh :=Hi(ClockReg);
ClockLow :=Lo(ClockReg);
RetClockSeq :=ClockSeq;
Result :=True;
end;
Procedure UUIDPack(Const UU : TUUID; Var GUID : TGUID);
Var
tmp : Cardinal;
P : PByte;
begin
P:=@GUID;
tmp:=uu.time_low;
P[3]:=tmp and $FF;
tmp:=tmp shr 8;
P[2]:=tmp and $FF;
tmp:=tmp shr 8;
P[1]:=tmp and $FF;
tmp:=tmp shr 8;
P[0]:=tmp and $FF;
tmp:=uu.time_mid;
P[5]:=tmp and $FF;
tmp:=tmp shr 8;
P[4]:=tmp and $FF;
tmp:=uu.time_hi_and_version;
P[7]:=tmp and $FF;
tmp:=tmp shr 8;
P[6]:=tmp and $FF;
tmp:=uu.clock_seq;
P[9]:=tmp and $FF;
tmp:=tmp shr 8;
P[8]:=tmp and $FF;
Move(uu.node,P[10],6);
end;
Procedure DumpMacAddr;
var
I : Integer;
begin
Write('Mac Addr: ');
For i:=1 to 6 do
write(hexstr(MacAddr[i],2),':');
end;
Function CreateMacGUID(Var GUID : TGUID) : Boolean;
Var
UU : TUUId;
ClockMid : Cardinal;
begin
Result:=GetMacAddr;
If Result then
begin
// DumpMacAddr;
// Writeln;
GetClock(ClockMid,uu.time_low,uu.clock_seq);
uu.Clock_seq:=uu.Clock_seq or $8000;
uu.time_mid:=lo(clockMid);
uu.time_hi_and_version:=hi(ClockMid) or $1000;
move(MacAddr,uu.node,sizeof(MacAddr));
UUIDPack(UU,GUID);
end;
end;
Function CreateKernelGUID(Var GUID : TGUID) : Boolean;
Const
UUIDLen = 36;
Var
fd: Longint;
S : String;
begin
fd:=FileOpen(KernelUUID,fmOpenRead);
Result:=(Fd>=0);
if Result then
begin
SetLength(S,UUIDLen);
SetLength(S,FileRead(fd,S[1],UUIDLen));
Result:=(Length(S)=UUIDLen);
If Result then
begin
GUID:=StringToGUID('{'+S+'}');
//Writeln('Kernel ID = ',GuidToString(GUID));
end;
end;
end;
Function CreateGUID(out GUID : TGUID) : Integer;
begin
if PreferKernelUUID then
begin
if not CreateKernelGUID(Guid) then
if not CreateMACGuid(Guid) then
GetRandomBytes(GUID,SizeOf(Guid));
end
else
if not CreateMACGuid(Guid) then
if not CreateKernelGUID(Guid) then
GetRandomBytes(GUID,SizeOf(Guid));
Result:=0;
end;

5
rtl/win32/system.pp
View File

@ -14,10 +14,7 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{$ifndef VER1_0}
{ $define MT}
{$endif VER1_0}
unit {$ifdef VER1_0}SysWin32{$else}System{$endif};
unit System;
interface
{$ifdef SYSTEMDEBUG}

4
rtl/win32/sysutils.pp
View File

@ -896,11 +896,7 @@ Type
PFNSHGetFolderPath = Function(Ahwnd: HWND; Csidl: Integer; Token: THandle; Flags: DWord; Path: PChar): HRESULT; stdcall;
{$ifdef VER1_0}
Const
{$else}
var
{$endif}
SHGetFolderPath : PFNSHGetFolderPath = Nil;
CFGDLLHandle : THandle = 0;

4
rtl/win32/video.pp
View File

@ -339,11 +339,7 @@ begin
if LineCounter>y2 then
y2:=LineCounter;
end;
{$ifdef VER1_0}
Word(LineBuf^[BufCounter].UniCodeChar) := WordRec(VideoBuf^[BufCounter]).One;
{$else}
LineBuf^[BufCounter].UniCodeChar := Widechar(WordRec(VideoBuf^[BufCounter]).One);
{$endif}
{ If (WordRec(VideoBuf^[BufCounter]).Two and $80)<>0 then
LineBuf^[BufCounter].Attributes := $100+WordRec(VideoBuf^[BufCounter]).Two
else }

2
rtl/x86_64/mathuh.inc
View File

@ -27,7 +27,7 @@ function GetPrecisionMode: TFPUPrecisionMode;
function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
function GetExceptionMask: TFPUExceptionMask;
function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
procedure ClearExceptions(RaisePending: Boolean {$ifndef VER1_0}=true{$endif});
procedure ClearExceptions(RaisePending: Boolean =true);
procedure SetSSECSR(w : dword);