sysutils.pp 7.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2004 by Karoly Balogh
  4. Sysutils unit for Gameboy Advance.
  5. This unit is based on the MorphOS one and is adapted for Gameboy Advance
  6. simply by stripping out all stuff inside funcs and procs.
  7. Copyright (c) 2006 by Francesco Lombardi
  8. Based on Amiga version by Carl Eric Codere, and other
  9. parts of the RTL
  10. See the file COPYING.FPC, included in this distribution,
  11. for details about the copyright.
  12. This program is distributed in the hope that it will be useful,
  13. but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  15. **********************************************************************}
  16. {$IFNDEF FPC_DOTTEDUNITS}
  17. unit sysutils;
  18. {$ENDIF FPC_DOTTEDUNITS}
  19. interface
  20. {$MODE objfpc}
  21. {$MODESWITCH OUT}
  22. {$IFDEF UNICODERTL}
  23. {$MODESWITCH UNICODESTRINGS}
  24. {$ELSE}
  25. {$H+}
  26. {$ENDIF}
  27. {$modeswitch typehelpers}
  28. {$modeswitch advancedrecords}
  29. {$DEFINE HAS_SLEEP}
  30. {$DEFINE HAS_OSERROR}
  31. { used OS file system APIs use ansistring }
  32. {$define SYSUTILS_HAS_ANSISTR_FILEUTIL_IMPL}
  33. { OS has an ansistring/single byte environment variable API }
  34. {$define SYSUTILS_HAS_ANSISTR_ENVVAR_IMPL}
  35. { Include platform independent interface part }
  36. {$i sysutilh.inc}
  37. implementation
  38. {$IFDEF FPC_DOTTEDUNITS}
  39. uses
  40. TP.DOS, System.SysConst;
  41. {$ELSE FPC_DOTTEDUNITS}
  42. uses
  43. dos, sysconst;
  44. {$ENDIF FPC_DOTTEDUNITS}
  45. { Include platform independent implementation part }
  46. {$i sysutils.inc}
  47. {****************************************************************************
  48. File Functions
  49. ****************************************************************************}
  50. function FileOpen(const FileName: rawbytestring; Mode: Integer): LongInt;
  51. begin
  52. result := -1;
  53. end;
  54. function FileGetDate(Handle: LongInt) : Int64;
  55. begin
  56. result := -1;
  57. end;
  58. function FileSetDate(Handle: Longint; Age: Int64) : LongInt;
  59. begin
  60. result := -1;
  61. end;
  62. function FileCreate(const FileName: RawByteString) : LongInt;
  63. begin
  64. result := -1;
  65. end;
  66. function FileCreate(const FileName: RawByteString; Rights: integer): LongInt;
  67. begin
  68. result := -1;
  69. end;
  70. function FileCreate(const FileName: RawByteString; ShareMode: integer; rights : integer): LongInt;
  71. begin
  72. result := -1;
  73. end;
  74. function FileRead(Handle: LongInt; Out Buffer; Count: LongInt): LongInt;
  75. begin
  76. result := -1;
  77. end;
  78. function FileWrite(Handle: LongInt; const Buffer; Count: LongInt): LongInt;
  79. begin
  80. result := -1;
  81. end;
  82. function FileSeek(Handle, FOffset, Origin: LongInt) : LongInt;
  83. begin
  84. result := -1;
  85. end;
  86. function FileSeek(Handle: LongInt; FOffset: Int64; Origin: Longint): Int64;
  87. begin
  88. result := -1;
  89. end;
  90. procedure FileClose(Handle: LongInt);
  91. begin
  92. end;
  93. function FileTruncate(Handle: THandle; Size: Int64): Boolean;
  94. begin
  95. result := false;
  96. end;
  97. function DeleteFile(const FileName: RawByteString) : Boolean;
  98. begin
  99. result := false;
  100. end;
  101. function RenameFile(const OldName, NewName: RawByteString): Boolean;
  102. begin
  103. result := false;
  104. end;
  105. (****** end of non portable routines ******)
  106. Function FileAge (Const FileName : RawByteString): Int64;
  107. begin
  108. result := -1;
  109. end;
  110. function FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
  111. begin
  112. Result := False;
  113. end;
  114. Function FileExists (Const FileName : RawByteString; FollowLink : Boolean) : Boolean;
  115. Begin
  116. result := false;
  117. end;
  118. Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
  119. begin
  120. result := -1;
  121. end;
  122. Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
  123. begin
  124. result := -1;
  125. end;
  126. Procedure InternalFindClose(var Handle: THandle);
  127. begin
  128. end;
  129. Function FileGetAttr (Const FileName : RawByteString) : Longint;
  130. begin
  131. result := -1;
  132. end;
  133. Function FileSetAttr (Const Filename : RawByteString; Attr: longint) : Longint;
  134. begin
  135. result := -1;
  136. end;
  137. {****************************************************************************
  138. Disk Functions
  139. ****************************************************************************}
  140. Procedure AddDisk(const path:string);
  141. begin
  142. end;
  143. Function DiskFree(Drive: Byte): int64;
  144. Begin
  145. result := -1;
  146. End;
  147. Function DiskSize(Drive: Byte): int64;
  148. Begin
  149. result := -1;
  150. End;
  151. function DirectoryExists(const Directory: RawByteString; FollowLink : Boolean): Boolean;
  152. begin
  153. result := false;
  154. end;
  155. {****************************************************************************
  156. Misc Functions
  157. ****************************************************************************}
  158. procedure sysBeep;
  159. begin
  160. end;
  161. Procedure Sleep(Milliseconds : Cardinal);
  162. var
  163. i,j : Cardinal;
  164. calib : Cardinal;
  165. begin
  166. {$warning no idea if this calibration value is correct (FK) }
  167. { I estimated it roughly on the CPU clock of 16 MHz and 1+3 clock cycles for the loop }
  168. calib:=4000000;
  169. for i:=1 to Milliseconds do
  170. asm
  171. ldr r0,calib
  172. .L1:
  173. sub r0,r0,#1
  174. bne .L1
  175. end;
  176. end;
  177. Function GetLastOSError : Integer;
  178. begin
  179. Result:=-1;
  180. end;
  181. {****************************************************************************
  182. Locale Functions
  183. ****************************************************************************}
  184. Procedure GetLocalTime(var SystemTime: TSystemTime);
  185. begin
  186. end ;
  187. function SysErrorMessage(ErrorCode: Integer): String;
  188. begin
  189. { Result:=StrError(ErrorCode);}
  190. result := '';
  191. end;
  192. {****************************************************************************
  193. OS utility functions
  194. ****************************************************************************}
  195. Function GetEnvironmentVariable(Const EnvVar : String) : String;
  196. begin
  197. result := '';
  198. end;
  199. Function GetEnvironmentVariableCount : Integer;
  200. begin
  201. result := -1;
  202. end;
  203. Function GetEnvironmentString(Index : Integer) : {$ifdef FPC_RTL_UNICODE}UnicodeString{$else}AnsiString{$endif};
  204. begin
  205. result := '';
  206. end;
  207. function ExecuteProcess (const Path: RawByteString; const ComLine: RawByteString;Flags:TExecuteFlags=[]): integer;
  208. begin
  209. result := -1;
  210. end;
  211. function ExecuteProcess (const Path: RawByteString;
  212. const ComLine: array of RawByteString;Flags:TExecuteFlags=[]): integer;
  213. begin
  214. result := -1;
  215. end;
  216. function ExecuteProcess(const Path: UnicodeString; const ComLine: UnicodeString;
  217. Flags: TExecuteFlags = []): Integer;
  218. begin
  219. { TODO : implement }
  220. result := -1;
  221. end;
  222. function ExecuteProcess(const Path: UnicodeString;
  223. const ComLine: Array of UnicodeString; Flags:TExecuteFlags = []): Integer;
  224. var
  225. CommandLine: UnicodeString;
  226. I: integer;
  227. begin
  228. Commandline := '';
  229. for I := 0 to High (ComLine) do
  230. if Pos (' ', ComLine [I]) <> 0 then
  231. CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
  232. else
  233. CommandLine := CommandLine + ' ' + Comline [I];
  234. ExecuteProcess := ExecuteProcess (Path, CommandLine,Flags);
  235. end;
  236. {****************************************************************************
  237. Initialization code
  238. ****************************************************************************}
  239. Initialization
  240. InitExceptions;
  241. Finalization
  242. FreeTerminateProcs;
  243. DoneExceptions;
  244. end.