mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-17 06:39:34 +02:00
atari: dummy sysutils unit. to be implemented.
git-svn-id: trunk@34590 -
This commit is contained in:
parent
175cc52e8d
commit
bfe904fb16
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -8406,6 +8406,7 @@ rtl/atari/sysheap.inc svneol=native#text/plain
|
|||||||
rtl/atari/sysos.inc svneol=native#text/plain
|
rtl/atari/sysos.inc svneol=native#text/plain
|
||||||
rtl/atari/sysosh.inc svneol=native#text/plain
|
rtl/atari/sysosh.inc svneol=native#text/plain
|
||||||
rtl/atari/system.pp svneol=native#text/plain
|
rtl/atari/system.pp svneol=native#text/plain
|
||||||
|
rtl/atari/sysutils.pp svneol=native#text/plain
|
||||||
rtl/atari/tthread.inc svneol=native#text/plain
|
rtl/atari/tthread.inc svneol=native#text/plain
|
||||||
rtl/avr/avr.inc svneol=native#text/plain
|
rtl/avr/avr.inc svneol=native#text/plain
|
||||||
rtl/avr/int64p.inc svneol=native#text/plain
|
rtl/avr/int64p.inc svneol=native#text/plain
|
||||||
|
347
rtl/atari/sysutils.pp
Normal file
347
rtl/atari/sysutils.pp
Normal file
@ -0,0 +1,347 @@
|
|||||||
|
{
|
||||||
|
This file is part of the Free Pascal run time library.
|
||||||
|
Copyright (c) 2016 by Free Pascal development team
|
||||||
|
|
||||||
|
Sysutils unit for Atari
|
||||||
|
|
||||||
|
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.
|
||||||
|
|
||||||
|
**********************************************************************}
|
||||||
|
|
||||||
|
unit sysutils;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$MODE objfpc}
|
||||||
|
{$MODESWITCH OUT}
|
||||||
|
{ force ansistrings }
|
||||||
|
{$H+}
|
||||||
|
{$modeswitch typehelpers}
|
||||||
|
{$modeswitch advancedrecords}
|
||||||
|
|
||||||
|
{$DEFINE OS_FILESETDATEBYNAME}
|
||||||
|
{$DEFINE HAS_SLEEP}
|
||||||
|
{$DEFINE HAS_OSERROR}
|
||||||
|
|
||||||
|
{OS has only 1 byte version for ExecuteProcess}
|
||||||
|
{$define executeprocuni}
|
||||||
|
|
||||||
|
{ used OS file system APIs use ansistring }
|
||||||
|
{$define SYSUTILS_HAS_ANSISTR_FILEUTIL_IMPL}
|
||||||
|
{ OS has an ansistring/single byte environment variable API }
|
||||||
|
{$define SYSUTILS_HAS_ANSISTR_ENVVAR_IMPL}
|
||||||
|
|
||||||
|
{ Include platform independent interface part }
|
||||||
|
{$i sysutilh.inc}
|
||||||
|
|
||||||
|
{ Platform dependent calls }
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
{ dos,} sysconst;
|
||||||
|
|
||||||
|
{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
|
||||||
|
{$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
|
||||||
|
|
||||||
|
{ Include platform independent implementation part }
|
||||||
|
{$i sysutils.inc}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{****************************************************************************
|
||||||
|
File Functions
|
||||||
|
****************************************************************************}
|
||||||
|
{$I-}{ Required for correct usage of these routines }
|
||||||
|
|
||||||
|
|
||||||
|
(****** non portable routines ******)
|
||||||
|
|
||||||
|
function FileOpen(const FileName: rawbytestring; Mode: Integer): THandle;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function FileGetDate(Handle: THandle) : LongInt;
|
||||||
|
begin
|
||||||
|
result:=-1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function FileSetDate(Handle: THandle; Age: LongInt) : LongInt;
|
||||||
|
begin
|
||||||
|
result:=0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function FileSetDate(const FileName: RawByteString; Age: LongInt) : LongInt;
|
||||||
|
begin
|
||||||
|
result:=-1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function FileCreate(const FileName: RawByteString) : THandle;
|
||||||
|
begin
|
||||||
|
result:=-1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function FileCreate(const FileName: RawByteString; Rights: integer): THandle;
|
||||||
|
begin
|
||||||
|
{$WARNING FIX ME! To do: FileCreate Access Modes}
|
||||||
|
FileCreate:=FileCreate(FileName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function FileCreate(const FileName: RawByteString; ShareMode: integer; Rights : integer): THandle;
|
||||||
|
begin
|
||||||
|
{$WARNING FIX ME! To do: FileCreate Access Modes}
|
||||||
|
FileCreate:=FileCreate(FileName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function FileRead(Handle: THandle; out Buffer; Count: LongInt): LongInt;
|
||||||
|
begin
|
||||||
|
FileRead:=-1;
|
||||||
|
if (Count<=0) or (Handle=0) or (Handle=-1) then exit;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function FileWrite(Handle: THandle; const Buffer; Count: LongInt): LongInt;
|
||||||
|
begin
|
||||||
|
FileWrite:=-1;
|
||||||
|
if (Count<=0) or (Handle=0) or (Handle=-1) then exit;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function FileSeek(Handle: THandle; FOffset, Origin: LongInt) : LongInt;
|
||||||
|
begin
|
||||||
|
FileSeek:=-1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function FileSeek(Handle: THandle; FOffset: Int64; Origin: Longint): Int64;
|
||||||
|
begin
|
||||||
|
FileSeek:=FileSeek(Handle,LongInt(FOffset),LongInt(Origin));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure FileClose(Handle: THandle);
|
||||||
|
begin
|
||||||
|
if (Handle=0) or (Handle=-1) then exit;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function FileTruncate(Handle: THandle; Size: Int64): Boolean;
|
||||||
|
begin
|
||||||
|
FileTruncate:=False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function DeleteFile(const FileName: RawByteString) : Boolean;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function RenameFile(const OldName, NewName: RawByteString): Boolean;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
(****** end of non portable routines ******)
|
||||||
|
|
||||||
|
|
||||||
|
function FileAge (const FileName : RawByteString): Longint;
|
||||||
|
begin
|
||||||
|
result:=-1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function FileExists (const FileName : RawByteString) : Boolean;
|
||||||
|
begin
|
||||||
|
result:=false;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
|
||||||
|
begin
|
||||||
|
result:=-1; { We emulate Linux/Unix behaviour, and return -1 on errors. }
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
|
||||||
|
begin
|
||||||
|
result:=-1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Procedure InternalFindClose(var Handle: THandle);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
(****** end of non portable routines ******)
|
||||||
|
|
||||||
|
Function FileGetAttr (Const FileName : RawByteString) : Longint;
|
||||||
|
begin
|
||||||
|
FileGetAttr := -1
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Function FileSetAttr (Const Filename : RawByteString; Attr: longint) : Longint;
|
||||||
|
begin
|
||||||
|
FileSetAttr := -1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{****************************************************************************
|
||||||
|
Disk Functions
|
||||||
|
****************************************************************************}
|
||||||
|
|
||||||
|
// New easier DiskSize()
|
||||||
|
//
|
||||||
|
function DiskSize(Drive: AnsiString): Int64;
|
||||||
|
begin
|
||||||
|
DiskSize := -1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DiskSize(Drive: Byte): Int64;
|
||||||
|
begin
|
||||||
|
DiskSize := -1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// New easier DiskFree()
|
||||||
|
//
|
||||||
|
function DiskFree(Drive: AnsiString): Int64;
|
||||||
|
begin
|
||||||
|
DiskFree := -1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DiskFree(Drive: Byte): Int64;
|
||||||
|
begin
|
||||||
|
DiskFree := -1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DirectoryExists(const Directory: RawByteString): Boolean;
|
||||||
|
begin
|
||||||
|
result:=false;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{****************************************************************************
|
||||||
|
Locale Functions
|
||||||
|
****************************************************************************}
|
||||||
|
|
||||||
|
Procedure GetLocalTime(var SystemTime: TSystemTime);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Procedure InitAnsi;
|
||||||
|
Var
|
||||||
|
i : longint;
|
||||||
|
begin
|
||||||
|
{ Fill table entries 0 to 127 }
|
||||||
|
for i := 0 to 96 do
|
||||||
|
UpperCaseTable[i] := chr(i);
|
||||||
|
for i := 97 to 122 do
|
||||||
|
UpperCaseTable[i] := chr(i - 32);
|
||||||
|
for i := 123 to 191 do
|
||||||
|
UpperCaseTable[i] := chr(i);
|
||||||
|
Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
|
||||||
|
|
||||||
|
for i := 0 to 64 do
|
||||||
|
LowerCaseTable[i] := chr(i);
|
||||||
|
for i := 65 to 90 do
|
||||||
|
LowerCaseTable[i] := chr(i + 32);
|
||||||
|
for i := 91 to 191 do
|
||||||
|
LowerCaseTable[i] := chr(i);
|
||||||
|
Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Procedure InitInternational;
|
||||||
|
begin
|
||||||
|
InitInternationalGeneric;
|
||||||
|
InitAnsi;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SysErrorMessage(ErrorCode: Integer): String;
|
||||||
|
begin
|
||||||
|
Result:=Format(SUnknownErrorCode,[ErrorCode]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetLastOSError: Integer;
|
||||||
|
begin
|
||||||
|
result:=-1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{****************************************************************************
|
||||||
|
OS utility functions
|
||||||
|
****************************************************************************}
|
||||||
|
|
||||||
|
function GetPathString: String;
|
||||||
|
begin
|
||||||
|
result := '';
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function GetEnvironmentVariable(Const EnvVar : String) : String;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function GetEnvironmentVariableCount : Integer;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function GetEnvironmentString(Index : Integer) : {$ifdef FPC_RTL_UNICODE}UnicodeString{$else}AnsiString{$endif};
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ExecuteProcess (const Path: RawByteString; const ComLine: RawByteString;Flags:TExecuteFlags=[]):
|
||||||
|
integer;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ExecuteProcess (const Path: RawByteString;
|
||||||
|
const ComLine: array of RawByteString;Flags:TExecuteFlags=[]): integer;
|
||||||
|
var
|
||||||
|
CommandLine: RawByteString;
|
||||||
|
I: integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Commandline := '';
|
||||||
|
for I := 0 to High (ComLine) do
|
||||||
|
if Pos (' ', ComLine [I]) <> 0 then
|
||||||
|
CommandLine := CommandLine + ' ' + '"' + ToSingleByteFileSystemEncodedFileName(ComLine [I]) + '"'
|
||||||
|
else
|
||||||
|
CommandLine := CommandLine + ' ' + ToSingleByteFileSystemEncodedFileName(Comline [I]);
|
||||||
|
ExecuteProcess := ExecuteProcess (Path, CommandLine);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure Sleep(Milliseconds: cardinal);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{****************************************************************************
|
||||||
|
Initialization code
|
||||||
|
****************************************************************************}
|
||||||
|
|
||||||
|
Initialization
|
||||||
|
InitExceptions;
|
||||||
|
InitInternational; { Initialize internationalization settings }
|
||||||
|
OnBeep:=Nil; { No SysBeep() on Atari for now. }
|
||||||
|
|
||||||
|
Finalization
|
||||||
|
DoneExceptions;
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user