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

* patch from Joost van der Sluis to remove VIRTUALPASCAL define since VP is officially dead

Browse Source 
git-svn-id: trunk@374 -
This commit is contained in:
florian 2005-06-10 17:05:35 +00:00
parent 6a279f8569
commit 64c72bd312
11 changed files with 9 additions and 123 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -77,11 +77,7 @@ end ;
function MSecsToTimeStamp(MSecs: comp): TTimeStamp;
begin
result.Date := Round(msecs / msecsperday);
{$IFDEF VIRTUALPASCAL}
msecs:= msecs-result.date*msecsperday;
{$ELSE}
msecs:= comp(msecs-result.date*msecsperday);
{$ENDIF}
result.Time := Round(MSecs);
end ;
@ -317,11 +313,7 @@ var
df:string;
d,m,y,ly:word;
n,i:longint;
{$IFDEF VIRTUALPASCAL}
c:longint;
{$ELSE}
c:word;
{$ENDIF}
dp,mp,yp,which : Byte;
s1:string[4];
values:array[1..3] of longint;
@ -433,11 +425,7 @@ var
function GetElement: integer;
var
j: integer;
{$IFDEF VIRTUALPASCAL}
c: longint;
{$ELSE}
c: word;
{$ENDIF}
begin
result := -1;
Inc(Current);

6
rtl/objpas/sysutils/fina.inc
View File

@ -20,10 +20,6 @@
System Utilities For Free Pascal
}
{$IFDEF VIRTUALPASCAL}
{$J+}
{$ENDIF}
function ChangeFileExt(const FileName, Extension: string): string;
var i: longint;
begin
@ -97,9 +93,7 @@ Var S : String;
Begin
S:=FileName;
{$IFNDEF VIRTUALPASCAL}
DoDirSeparators(S);
{$ENDIF}
{$ifdef HasUnix}
Result:=fexpand(S);
{$else}

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

@ -19,11 +19,7 @@ Var ChPos,OldPos,ArgPos,DoArg,Len : SizeInt;
Procedure ReadInteger;
{$IFDEF VIRTUALPASCAL}
var Code: longint;
{$ELSE}
var Code: word;
{$ENDIF}
begin
If Value<>-1 then exit; // Was already read.
@ -213,11 +209,8 @@ begin
'D' : begin
if Checkarg(vtinteger,false) then
Str(Args[Doarg].VInteger,ToAdd)
{$IFNDEF VIRTUALPASCAL}
else if CheckArg(vtInt64,true) then
Str(Args[DoArg].VInt64^,toadd)
{$ENDIF}
;
Str(Args[DoArg].VInt64^,toadd);
Width:=Abs(width);
Index:=Prec-Length(ToAdd);
If ToAdd[1]<>'-' then
@ -229,13 +222,10 @@ begin
'U' : begin
if Checkarg(vtinteger,false) then
Str(cardinal(Args[Doarg].VInteger),ToAdd)
{$IFNDEF VIRTUALPASCAL}
else if CheckArg(vtInt64,false) then
Str(qword(Args[DoArg].VInt64^),toadd)
else if CheckArg(vtQWord,true) then
Str(Args[DoArg].VQWord^,toadd);
{$ENDIF}
;
Width:=Abs(width);
Index:=Prec-Length(ToAdd);
ToAdd:=StringOfChar('0',Index)+ToAdd

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

@ -27,12 +27,10 @@ type
CharArray = array[0..0] of char;
{ Processor dependent part, shared withs strings unit }
{$IFNDEF VIRTUALPASCAL} // in system there
{$ifdef FPC_USE_LIBC}
{$i cgenstr.inc}
{$endif FPC_USE_LIBC}
{$i strings.inc }
{$ENDIF}
{ Read generic string functions that are not implemented for the processor }
{$i genstr.inc}

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

@ -682,12 +682,10 @@ begin
end ;
{$IFNDEF VIRTUALPASCAL}
function IntToStr(Value: int64): string;
begin
System.Str(Value, result);
end ;
{$ENDIF}
function IntToStr(Value: QWord): string;
begin
@ -715,7 +713,6 @@ begin
end;
end ;
{$IFNDEF VIRTUALPASCAL} // overloading
function IntToHex(Value: int64; Digits: integer): string;
var i: integer;
begin
@ -730,7 +727,6 @@ begin
value := value shr 4;
end;
end ;
{$ENDIF}
function TryStrToInt(const s: string; var i : integer) : boolean;
@ -744,11 +740,7 @@ end;
if S does not represent a valid integer value EConvertError is raised }
function StrToInt(const S: string): integer;
{$IFDEF VIRTUALPASCAL}
var Error: longint;
{$ELSE}
var Error: word;
{$ENDIF}
begin
Val(S, result, Error);
if Error <> 0 then raise EConvertError.createfmt(SInValidInteger,[S]);
@ -756,11 +748,7 @@ end ;
function StrToInt64(const S: string): int64;
{$IFDEF VIRTUALPASCAL}
var Error: longint;
{$ELSE}
var Error: word;
{$ENDIF}
begin
Val(S, result, Error);
@ -781,11 +769,7 @@ end;
Default is returned in case S does not represent a valid integer value }
function StrToIntDef(const S: string; Default: integer): integer;
{$IFDEF VIRTUALPASCAL}
var Error: longint;
{$ELSE}
var Error: word;
{$ENDIF}
begin
Val(S, result, Error);
if Error <> 0 then result := Default;
@ -795,11 +779,7 @@ end ;
Default is returned in case S does not represent a valid integer value }
function StrToInt64Def(const S: string; Default: int64): int64;
{$IFDEF VIRTUALPASCAL}
var Error: longint;
{$ELSE}
var Error: word;
{$ENDIF}
begin
Val(S, result, Error);
if Error <> 0 then result := Default;
@ -1197,11 +1177,7 @@ function StrToBool(const S: string): Boolean;
Var
Temp : String;
D : Double;
{$IFDEF VIRTUALPASCAL}
Code: longint;
{$ELSE}
Code: word;
{$ENDIF}
begin
Temp:=upcase(S);

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

@ -64,13 +64,8 @@ Const
EmptyStr : string = '';
NullStr : PString = @EmptyStr;
{$IFDEF VIRTUALPASCAL}
EmptyWideStr : AnsiString = '';
NullWideStr : PString = @EmptyWideStr;
{$ELSE}
EmptyWideStr : WideString = '';
// NullWideStr : PWideString = @EmptyWideStr;
{$ENDIF}
function NewStr(const S: string): PString;
procedure DisposeStr(S: PString);
@ -109,22 +104,16 @@ function AdjustLineBreaks(const S: string): string;
function AdjustLineBreaks(const S: string; Style: TTextLineBreakStyle): string;
function IsValidIdent(const Ident: string): boolean;
function IntToStr(Value: integer): string;
{$IFNDEF VIRTUALPASCAL}
function IntToStr(Value: Int64): string;
{$ENDIF}
function IntToStr(Value: QWord): string;
function IntToHex(Value: integer; Digits: integer): string;
function IntToHex(Value: Int64; Digits: integer): string;
function StrToInt(const s: string): integer;
function TryStrToInt(const s: string; var i : integer) : boolean;
{$IFNDEF VIRTUALPASCAL}
function StrToInt64(const s: string): int64;
function TryStrToInt64(const s: string; var i : int64) : boolean;
{$ENDIF}
function StrToIntDef(const S: string; Default: integer): integer;
{$IFNDEF VIRTUALPASCAL}
function StrToInt64Def(const S: string; Default: int64): int64;
{$ENDIF}
function LoadStr(Ident: integer): string;
// function FmtLoadStr(Ident: integer; const Args: array of const): string;
Function Format (Const Fmt : String; const Args : Array of const) : String;

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

@ -207,9 +207,7 @@ Type
{$i sysinth.inc}
{ Read pchar handling functions declaration }
{$IFNDEF VIRTUALPASCAL}
{$i syspchh.inc}
{$ENDIF}
{ MCBS functions }
{$i sysansih.inc}

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

@ -174,9 +174,6 @@
Procedure CatchUnhandledException (Obj : TObject; Addr: Pointer; FrameCount: Longint; Frames: PPointer);[public,alias:'FPC_BREAK_UNHANDLED_EXCEPTION'];
Var
Message : String;
{$IFDEF VIRTUALPASCAL}
stdout:text absolute output;
{$ENDIF}
i : longint;
begin
Writeln(stdout,'An unhandled exception occurred at $',HexStr(Ptrint(Addr),sizeof(PtrInt)*2),' :');
@ -331,29 +328,19 @@ end;
function ExceptObject: TObject;
begin
{$IFDEF VIRTUALPASCAL}
// vpascal does exceptions more the delphi way...
// this needs to be written from scratch.
{$ELSE}
If RaiseList=Nil then
Result:=Nil
else
Result:=RaiseList^.FObject;
{$ENDIF}
end;
function ExceptAddr: Pointer;
begin
{$IFDEF VIRTUALPASCAL}
// vpascal does exceptions more the delphi way...
// this needs to be written from scratch.
{$ELSE}
If RaiseList=Nil then
Result:=Nil
else
Result:=RaiseList^.Addr;
{$ENDIF}
end;
function ExceptionErrorMessage(ExceptObject: TObject; ExceptAddr: Pointer;

8
rtl/os2/tests/getctry.pas
View File

@ -9,14 +9,10 @@ uses
DosCalls;
{$ELSE}
Os2Def,
{$IFDEF VIRTUALPASCAL}
Os2Base;
{$ELSE}
{$IFDEF SPEED}
{$IFDEF SPEED}
BseDos;
{$ELSE}
{$ELSE}
DosProcs, DosTypes;
{$ENDIF}
{$ENDIF}
{$ENDIF}

8
rtl/os2/tests/testkbd.pas
View File

@ -9,14 +9,10 @@ uses
{$IFDEF FPC}
KbdCalls;
{$ELSE}
{$IFDEF VIRTUALPASCAL}
Os2Base;
{$ELSE}
{$IFDEF SPEED}
{$IFDEF SPEED}
BseSub;
{$ELSE}
{$ELSE}
Os2Subs;
{$ENDIF}
{$ENDIF}
{$ENDIF}

34
rtl/win32/sysutils.pp
View File

@ -17,18 +17,11 @@
unit sysutils;
interface
{$IFNDEF VIRTUALPASCAL}
{$MODE objfpc}
{$ENDIF}
{ force ansistrings }
{$H+}
uses
{$IFDEF VIRTUALPASCAL}
vpglue,
strings,
crt,
{$ENDIF}
dos,
windows;
@ -172,13 +165,8 @@ Function DosToWinTime (DTime:longint;Var Wtime : TFileTime):longbool;
var
lft : TFileTime;
begin
{$IFDEF VIRTUALPASCAL}
DosToWinTime:=DosDateTimeToFileTime(longrec(dtime).hi,longrec(dtime).lo,lft) and
LocalFileTimeToFileTime(lft,Wtime);
{$ELSE}
DosToWinTime:=DosDateTimeToFileTime(longrec(dtime).hi,longrec(dtime).lo,@lft) and
LocalFileTimeToFileTime(lft,Wtime);
{$ENDIF}
end;
@ -304,15 +292,11 @@ Function FileSetDate (Handle,Age : Longint) : Longint;
Var
FT: TFileTime;
begin
{$IFDEF VIRTUALPASCAL}
Result := 0;
{$ELSE}
Result := 0;
if DosToWinTime(Age,FT) and
SetFileTime(Handle, ft, ft, FT) then
Exit;
Result := 0;
if DosToWinTime(Age,FT) and
SetFileTime(Handle, ft, ft, FT) then
Exit;
Result := GetLastError;
{$ENDIF}
end;
@ -351,13 +335,7 @@ function GetDiskFreeSpace(drive:pchar;var sector_cluster,bytes_sector,
freeclusters,totalclusters:longint):longbool;
stdcall;external 'kernel32' name 'GetDiskFreeSpaceA';
type
{$IFDEF VIRTUALPASCAL}
{&StdCall+}
TGetDiskFreeSpaceEx = function(drive:pchar;var availableforcaller,total,free):longbool;
{&StdCall-}
{$ELSE}
TGetDiskFreeSpaceEx = function(drive:pchar;var availableforcaller,total,free):longbool;stdcall;
{$ENDIF}
var
GetDiskFreeSpaceEx : TGetDiskFreeSpaceEx;
@ -841,11 +819,7 @@ begin
begin
kernel32dll:=LoadLibrary('kernel32');
if kernel32dll<>0 then
{$IFDEF VIRTUALPASCAL}
@GetDiskFreeSpaceEx:=GetProcAddress(0,'GetDiskFreeSpaceExA');
{$ELSE}
GetDiskFreeSpaceEx:=TGetDiskFreeSpaceEx(GetProcAddress(kernel32dll,'GetDiskFreeSpaceExA'));
{$ENDIF}
end;
end;