Browse Source

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

git-svn-id: trunk@374 -
florian 20 years ago
parent
commit
64c72bd312

+ 0 - 12
rtl/objpas/sysutils/dati.inc

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

+ 0 - 6
rtl/objpas/sysutils/fina.inc

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

+ 1 - 11
rtl/objpas/sysutils/sysformt.inc

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

+ 0 - 2
rtl/objpas/sysutils/syspch.inc

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

+ 0 - 24
rtl/objpas/sysutils/sysstr.inc

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

+ 0 - 11
rtl/objpas/sysutils/sysstrh.inc

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

+ 0 - 2
rtl/objpas/sysutils/sysutilh.inc

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

+ 0 - 13
rtl/objpas/sysutils/sysutils.inc

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

+ 2 - 6
rtl/os2/tests/getctry.pas

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

+ 2 - 6
rtl/os2/tests/testkbd.pas

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

+ 4 - 30
rtl/win32/sysutils.pp

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