system.pp 3.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170
  1. unit system;
  2. {$ASMMODE intel}
  3. interface
  4. {$ifdef FULL_RTL}
  5. {$DEFINE FPC_INCLUDE_SOFTWARE_MUL}
  6. {$DEFINE FPC_INCLUDE_SOFTWARE_MOD_DIV}
  7. {$I systemh.inc}
  8. {$endif FULL_RTL}
  9. const
  10. LineEnding = #13#10;
  11. { LFNSupport is a variable here, defined below!!! }
  12. DirectorySeparator = '\';
  13. DriveSeparator = ':';
  14. ExtensionSeparator = '.';
  15. PathSeparator = ';';
  16. AllowDirectorySeparators : set of char = ['\','/'];
  17. AllowDriveSeparators : set of char = [':'];
  18. { FileNameCaseSensitive and FileNameCasePreserving are defined separately below!!! }
  19. maxExitCode = 255;
  20. MaxPathLen = 256;
  21. const
  22. { Default filehandles }
  23. UnusedHandle = -1;
  24. StdInputHandle = 0;
  25. StdOutputHandle = 1;
  26. StdErrorHandle = 2;
  27. FileNameCaseSensitive : boolean = false;
  28. FileNameCasePreserving: boolean = false;
  29. CtrlZMarksEOF: boolean = true; (* #26 is considered as end of file *)
  30. sLineBreak = LineEnding;
  31. DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
  32. { Default memory segments (Tp7 compatibility) }
  33. seg0040 = $0040;
  34. segA000 = $A000;
  35. segB000 = $B000;
  36. segB800 = $B800;
  37. var
  38. AllFilesMask: string [3];
  39. {$ifndef RTLLITE}
  40. { System info }
  41. LFNSupport : boolean;
  42. {$ELSE RTLLITE}
  43. const
  44. LFNSupport = false;
  45. {$endif RTLLITE}
  46. {$ifndef FULL_RTL}
  47. type
  48. DWord = LongWord;
  49. Cardinal = LongWord;
  50. Integer = SmallInt;
  51. UInt64 = QWord;
  52. HRESULT = LongInt;
  53. {$endif FULL_RTL}
  54. procedure DebugWrite(const S: string);
  55. procedure DebugWriteLn(const S: string);
  56. implementation
  57. {$ifdef FULL_RTL}
  58. {$I system.inc}
  59. {$endif FULL_RTL}
  60. {$ifndef FULL_RTL}
  61. procedure fpc_Initialize_Units;[public,alias:'FPC_INITIALIZEUNITS']; compilerproc;
  62. begin
  63. end;
  64. procedure do_exit;[Public,Alias:'FPC_DO_EXIT'];
  65. begin
  66. asm
  67. mov ax, 4c00h
  68. int 21h
  69. end;
  70. end;
  71. {$endif not FULL_RTL}
  72. procedure DebugWrite(const S: string);
  73. begin
  74. asm
  75. mov si, S
  76. lodsb
  77. mov cl, al
  78. xor ch, ch
  79. mov ah, 2
  80. @@1:
  81. lodsb
  82. mov dl, al
  83. int 21h
  84. loop @@1
  85. end;
  86. end;
  87. procedure DebugWriteLn(const S: string);
  88. begin
  89. DebugWrite(S);
  90. DebugWrite(#13#10);
  91. end;
  92. {*****************************************************************************
  93. ParamStr/Randomize
  94. *****************************************************************************}
  95. function paramcount : longint;
  96. begin
  97. paramcount := 0;
  98. end;
  99. function paramstr(l : longint) : string;
  100. begin
  101. paramstr := '';
  102. end;
  103. procedure randomize;
  104. begin
  105. end;
  106. {*****************************************************************************
  107. System Dependent Exit code
  108. *****************************************************************************}
  109. procedure system_exit;
  110. begin
  111. asm
  112. mov al, byte [exitcode]
  113. mov ah, 4Ch
  114. int 21h
  115. end;
  116. end;
  117. {*****************************************************************************
  118. SystemUnit Initialization
  119. *****************************************************************************}
  120. procedure SysInitStdIO;
  121. begin
  122. { OpenStdIO(Input,fmInput,StdInputHandle);
  123. OpenStdIO(Output,fmOutput,StdOutputHandle);
  124. OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
  125. OpenStdIO(StdOut,fmOutput,StdOutputHandle);
  126. OpenStdIO(StdErr,fmOutput,StdErrorHandle);}
  127. end;
  128. function GetProcessID: SizeUInt;
  129. begin
  130. GetProcessID := 1;
  131. end;
  132. function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
  133. begin
  134. result := stklen;
  135. end;
  136. end.