system.pp 3.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2020,2021 by the Free Pascal development team.
  4. System unit for The WebAssembly System Interface (WASI).
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. unit system;
  12. interface
  13. {$define FPC_IS_SYSTEM}
  14. {$I systemh.inc}
  15. const
  16. LineEnding = #10;
  17. LFNSupport = true;
  18. DirectorySeparator = '/';
  19. DriveSeparator = '';
  20. ExtensionSeparator = '.';
  21. PathSeparator = ':';
  22. AllowDirectorySeparators : set of char = ['\','/'];
  23. AllowDriveSeparators : set of char = [];
  24. { FileNameCaseSensitive and FileNameCasePreserving are defined below! }
  25. maxExitCode = 65535;
  26. MaxPathLen = 4096;
  27. AllFilesMask = '*';
  28. const
  29. UnusedHandle = -1;
  30. StdInputHandle = 0;
  31. StdOutputHandle = 1;
  32. StdErrorHandle = 2;
  33. FileNameCaseSensitive : boolean = true;
  34. FileNameCasePreserving: boolean = true;
  35. CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
  36. sLineBreak = LineEnding;
  37. DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsLF;
  38. var
  39. argc: longint;
  40. argv: PPChar;
  41. procedure DebugWrite(const P: PChar);
  42. procedure DebugWriteLn(const P: PChar);
  43. procedure DebugWriteChar(Ch: Char);
  44. procedure DebugWriteHexDigit(d: Byte);
  45. procedure DebugWriteHexByte(b: Byte);
  46. procedure DebugWriteHexWord(w: Word);
  47. procedure DebugWriteHexLongWord(lw: LongWord);
  48. implementation
  49. {$I wasitypes.inc}
  50. {$I wasiprocs.inc}
  51. {$I system.inc}
  52. function GetProcessID: SizeUInt;
  53. begin
  54. end;
  55. Procedure Randomize;
  56. Begin
  57. End;
  58. procedure System_exit;
  59. begin
  60. proc_exit(ExitCode);
  61. End;
  62. Function ParamCount: Longint;
  63. Begin
  64. End;
  65. function paramstr(l: longint) : string;
  66. begin
  67. end;
  68. procedure SysInitStdIO;
  69. begin
  70. OpenStdIO(Input,fmInput,StdInputHandle);
  71. OpenStdIO(Output,fmOutput,StdOutputHandle);
  72. OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
  73. OpenStdIO(StdOut,fmOutput,StdOutputHandle);
  74. OpenStdIO(StdErr,fmOutput,StdErrorHandle);
  75. end;
  76. function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
  77. begin
  78. end;
  79. procedure DebugWrite(const P: PChar);
  80. var
  81. our_iov: __wasi_ciovec_t;
  82. our_nwritten: longint;
  83. begin
  84. our_iov.buf := PByte(P);
  85. our_iov.buf_len := StrLen(P);
  86. fd_write(1, @our_iov, 1, @our_nwritten);
  87. end;
  88. procedure DebugWriteLn(const P: PChar);
  89. begin
  90. DebugWrite(P);
  91. DebugWriteChar(#10);
  92. end;
  93. procedure DebugWriteChar(Ch: Char);
  94. var
  95. CharArr: array [0..1] of Char;
  96. begin
  97. CharArr[0] := Ch;
  98. CharArr[1] := #0;
  99. DebugWrite(@CharArr);
  100. end;
  101. procedure DebugWriteHexDigit(d: Byte);
  102. const
  103. HexDigits: array [0..15] of Char = '0123456789ABCDEF';
  104. begin
  105. DebugWriteChar(HexDigits[d]);
  106. end;
  107. procedure DebugWriteHexByte(b: Byte);
  108. begin
  109. DebugWriteHexDigit(b shr 4);
  110. DebugWriteHexDigit(b and 15);
  111. end;
  112. procedure DebugWriteHexWord(w: Word);
  113. begin
  114. DebugWriteHexByte(w shr 8);
  115. DebugWriteHexByte(Byte(w));
  116. end;
  117. procedure DebugWriteHexLongWord(lw: LongWord);
  118. begin
  119. DebugWriteHexWord(lw shr 16);
  120. DebugWriteHexWord(Word(lw));
  121. end;
  122. begin
  123. { To be set if this is a GUI or console application }
  124. IsConsole := TRUE;
  125. {$ifdef FPC_HAS_FEATURE_DYNLIBS}
  126. { If dynlibs feature is disabled,
  127. IsLibrary is a constant, which can thus not be set to a value }
  128. { To be set if this is a library and not a program }
  129. IsLibrary := FALSE;
  130. {$endif def FPC_HAS_FEATURE_DYNLIBS}
  131. { Setup heap }
  132. InitHeap;
  133. SysInitExceptions;
  134. initunicodestringmanager;
  135. { Setup stdin, stdout and stderr }
  136. SysInitStdIO;
  137. { Reset IO Error }
  138. InOutRes:=0;
  139. {$ifdef FPC_HAS_FEATURE_THREADING}
  140. InitSystemThreads;
  141. {$endif}
  142. end.