initc.pp 3.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149
  1. {
  2. $Id$
  3. }
  4. unit initc;
  5. interface
  6. type libcint = longint;
  7. plibcint = ^libcint;
  8. {$LINKLIB cygwin}
  9. {$linklib kernel32}
  10. { this unit is just ment to run
  11. startup code to get C code to work correctly PM }
  12. function fpgetCerrno:libcint;
  13. procedure fpsetCerrno(err:libcint);
  14. {$ifndef ver1_0}
  15. property cerrno:libcint read fpgetCerrno write fpsetcerrno;
  16. {$endif}
  17. implementation
  18. uses
  19. windows;
  20. {$i textrec.inc}
  21. function geterrnolocation: Plibcint; cdecl;external name '___errno';
  22. function fpgetCerrno:libcint;
  23. begin
  24. fpgetCerrno:=geterrnolocation^;
  25. end;
  26. procedure fpsetCerrno(err:libcint);
  27. begin
  28. geterrnolocation^:=err;
  29. end;
  30. procedure cygwin_crt0(p : pointer);cdecl;external;
  31. {
  32. procedure do_global_dtors;cdecl;external;
  33. this does not work because
  34. do_global_dtors is a static C function PM
  35. it is inserted into the atexit chain,
  36. but how do we call this from FPC ???
  37. it seems to be done in exit function
  38. but that one ends with _exit that is system dependent !! }
  39. { avoid loading of cygwin _exit code
  40. so that exit returns
  41. apparently this is not enough anymore
  42. use longjmp instead PM }
  43. var
  44. entryjmpbuf,exitjmpbuf : jmp_buf;
  45. const
  46. exitjmpbufset : boolean = false;
  47. procedure _exit(status : longint);cdecl;
  48. begin
  49. if exitjmpbufset then
  50. longjmp(exitjmpbuf,1)
  51. else
  52. RunError(status);
  53. end;
  54. procedure C_exit(status : longint);cdecl;external name '_exit';
  55. const
  56. STD_INPUT_HANDLE = $fffffff6;
  57. STD_OUTPUT_HANDLE = $fffffff5;
  58. STD_ERROR_HANDLE = $fffffff4;
  59. procedure UpdateStdHandle(var t:TextRec;var stdHandle:Thandle;newHandle:Thandle);
  60. { Check if the stdHandle is the same as the one in the TextRec, then
  61. also update the TextRec }
  62. begin
  63. if t.Handle=stdHandle then
  64. t.Handle:=newHandle;
  65. stdHandle:=newHandle;
  66. end;
  67. function entry : longint;
  68. begin
  69. longjmp(entryjmpbuf,1);
  70. entry:=0;
  71. end;
  72. var
  73. ConsoleMode: DWORD;
  74. ConsoleModeValid : boolean;
  75. initialization
  76. ConsoleModeValid:=GetConsoleMode(GetStdHandle(STD_INPUT_HANDLE), @ConsoleMode);
  77. if setjmp(entryjmpbuf)=0 then
  78. begin
  79. cygwin_crt0(@entry);
  80. end;
  81. if ConsoleModeValid then
  82. SetConsoleMode(GetStdHandle(STD_INPUT_HANDLE), ConsoleMode);
  83. { Reinitialize std handles that can be changed }
  84. UpdateStdHandle(TextRec(Input),StdInputHandle,GetStdHandle(STD_INPUT_HANDLE));
  85. UpdateStdHandle(TextRec(Output),StdOutputHandle,GetStdHandle(STD_OUTPUT_HANDLE));
  86. UpdateStdHandle(TextRec(ErrOutput),StdErrorHandle,GetStdHandle(STD_ERROR_HANDLE));
  87. TextRec(StdOut).Handle:=StdOutputHandle;
  88. TextRec(StdErr).Handle:=StdErrorHandle;
  89. finalization
  90. { should we pass exit code ?
  91. its apparently only used by _exit so it doesn't matter PM }
  92. if setjmp(exitjmpbuf)=0 then
  93. begin
  94. exitjmpbufset:=true;
  95. { C_exit(errorcode);
  96. this code does not work correctly anymore
  97. C function _exit is not called at end of exit function
  98. thus the code of exit does not return at all
  99. disabled PM }
  100. end;
  101. end.
  102. {
  103. $Log$
  104. Revision 1.13 2004-11-04 09:32:31 peter
  105. ErrOutput added
  106. Revision 1.12 2004/09/14 20:08:58 hajny
  107. * use errno from cygwin (like in fixes branch)
  108. Revision 1.11 2004/09/12 17:41:40 hajny
  109. * hopefully fixed the problem with missing __error symbol
  110. Revision 1.10 2003/12/11 09:21:52 marco
  111. * patch from peter
  112. Revision 1.9 2003/11/03 09:42:28 marco
  113. * Peter's Cardinal<->Longint fixes patch
  114. Revision 1.8 2003/09/08 18:25:45 peter
  115. * popstack to cdecl
  116. Revision 1.7 2002/09/07 16:01:28 peter
  117. * old logs removed and tabs fixed
  118. }