[project @ 2001-06-28 14:15:04 by simonmar]
[packages/pretty.git] / cbits / writeError.c
1 /*
2 * (c) The GRASP/AQUA Project, Glasgow University, 1998
3 *
4 * $Id: writeError.c,v 1.1 2001/06/28 14:15:04 simonmar Exp $
5 *
6 * hPutStr Runtime Support
7 */
8
9 /*
10 Writing out error messages. This is done outside Haskell
11 (i.e., no use of the IO implementation is made), since it
12 might be in an unstable state (e.g., hClose stderr >> error "foo")
13
14 (A secondary reason is that ``error'' is used by the IO
15 implementation in one or two places.)
16
17 */
18
19 #include "Rts.h"
20 #include "RtsUtils.h"
21 #include "HsCore.h"
22
23 HsAddr
24 addrOf_ErrorHdrHook(void)
25 {
26 return &ErrorHdrHook;
27 }
28
29 void
30 writeErrString__ (HsAddr msg_hdr, HsAddr msg, HsInt len)
31 {
32 int count = 0;
33 char* p = (char*)msg;
34 char nl = '\n';
35
36 resetNonBlockingFd(2);
37
38 /* Print error msg header */
39 if (msg_hdr) {
40 ((void (*)(int))msg_hdr)(2/*stderr*/);
41 }
42
43 while ( (count = write(2,p,len)) < len) {
44 if (errno != EINTR ) {
45 return;
46 }
47 len -= count;
48 p += count;
49 }
50 write(2, &nl, 1);
51 }