initc.pp 3.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141
  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. const clib = 'crtdll';
  22. function geterrnolocation: Plibcint; cdecl;external clib name '__error';
  23. function fpgetCerrno:libcint;
  24. begin
  25. fpgetCerrno:=geterrnolocation^;
  26. end;
  27. procedure fpsetCerrno(err:libcint);
  28. begin
  29. geterrnolocation^:=err;
  30. end;
  31. procedure cygwin_crt0(p : pointer);cdecl;external;
  32. {
  33. procedure do_global_dtors;cdecl;external;
  34. this does not work because
  35. do_global_dtors is a static C function PM
  36. it is inserted into the atexit chain,
  37. but how do we call this from FPC ???
  38. it seems to be done in exit function
  39. but that one ends with _exit that is system dependent !! }
  40. { avoid loading of cygwin _exit code
  41. so that exit returns
  42. apparently this is not enough anymore
  43. use longjmp instead PM }
  44. var
  45. entryjmpbuf,exitjmpbuf : jmp_buf;
  46. const
  47. exitjmpbufset : boolean = false;
  48. procedure _exit(status : longint);cdecl;
  49. begin
  50. if exitjmpbufset then
  51. longjmp(exitjmpbuf,1)
  52. else
  53. RunError(status);
  54. end;
  55. procedure C_exit(status : longint);cdecl;external name '_exit';
  56. const
  57. STD_INPUT_HANDLE = $fffffff6;
  58. STD_OUTPUT_HANDLE = $fffffff5;
  59. STD_ERROR_HANDLE = $fffffff4;
  60. procedure UpdateStdHandle(var t:TextRec;var stdHandle:Thandle;newHandle:Thandle);
  61. { Check if the stdHandle is the same as the one in the TextRec, then
  62. also update the TextRec }
  63. begin
  64. if t.Handle=stdHandle then
  65. t.Handle:=newHandle;
  66. stdHandle:=newHandle;
  67. end;
  68. function entry : longint;
  69. begin
  70. longjmp(entryjmpbuf,1);
  71. entry:=0;
  72. end;
  73. var
  74. ConsoleMode: DWORD;
  75. ConsoleModeValid : boolean;
  76. initialization
  77. ConsoleModeValid:=GetConsoleMode(GetStdHandle(STD_INPUT_HANDLE), @ConsoleMode);
  78. if setjmp(entryjmpbuf)=0 then
  79. begin
  80. cygwin_crt0(@entry);
  81. end;
  82. if ConsoleModeValid then
  83. SetConsoleMode(GetStdHandle(STD_INPUT_HANDLE), ConsoleMode);
  84. { Reinitialize std handles that can be changed }
  85. UpdateStdHandle(TextRec(Input),StdInputHandle,GetStdHandle(STD_INPUT_HANDLE));
  86. UpdateStdHandle(TextRec(Output),StdOutputHandle,GetStdHandle(STD_OUTPUT_HANDLE));
  87. TextRec(StdOut).Handle:=StdOutputHandle;
  88. UpdateStdHandle(TextRec(Stderr),StdErrorHandle,GetStdHandle(STD_ERROR_HANDLE));
  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.10 2003-12-11 09:21:52 marco
  105. * patch from peter
  106. Revision 1.9 2003/11/03 09:42:28 marco
  107. * Peter's Cardinal<->Longint fixes patch
  108. Revision 1.8 2003/09/08 18:25:45 peter
  109. * popstack to cdecl
  110. Revision 1.7 2002/09/07 16:01:28 peter
  111. * old logs removed and tabs fixed
  112. }