[project @ 2002-02-12 11:44:54 by simonmar]
[ghc-hetmet.git] / ghc / lib / std / cbits / ilxstubs.c
1 /* 
2  * (c) The GHC Team 2001
3  *
4  * $Id: ilxstubs.c,v 1.5 2001/08/17 11:13:04 rrt Exp $
5  *
6  * ILX stubs for external function calls
7  */
8
9 /*
10   All foreign imports from the C standard library are stubbed out here,
11   so that they are all in the same DLL (HSstd_cbits), and the ILX code
12   generator doesn't have to be told or guess which DLL they are in.
13   Calls to the Win32 API are annotated with the DLL they come from.
14
15   The general rule is that all foreign imports are assumed to be in
16   <current_package>_cbits.dll unless a DLL is explicitly given.
17 */
18
19
20 #include "Stg.h"
21 #include "HsStd.h"
22 #include <stdlib.h>
23 #include <stddef.h>
24 #include <dirent.h>
25 #include <limits.h>
26
27 /* From the RTS */
28
29     /* StgPrimFloat Add to mini-RTS, which is put in a DLL */
30
31     /* Need to be implemented in ILX RTS */
32 /*../PrelStable.lhs:37:foreign import unsafe freeStablePtr :: StablePtr a -> IO ()
33 ../PrelTopHandler.lhs:49:foreign import ccall "shutdownHaskellAndExit" 
34 ../PrelTopHandler.lhs:77:foreign import ccall "stackOverflow" unsafe
35 ../PrelTopHandler.lhs:80:foreign import ccall "stg_exit" unsafe */
36
37 void
38 stg_exit(I_ n)
39 {
40   fprintf(stderr, "doing stg_exit(%d)\n", n);
41   exit(n);
42 }
43
44 /* The code is in includes/Stable.h [sic] */
45 void
46 freeStablePtr(StgStablePtr sp)
47 {
48   fprintf(stderr, "Freeing stable ptr %p (NOT!)\n", sp);
49 }
50
51 void
52 shutdownHaskellAndExit(int n)
53 {
54   stg_exit(n);
55 }
56
57 void 
58 stackOverflow(void)
59 {
60 }
61
62 void *
63 _ErrorHdrHook(void)
64 {
65   return &ErrorHdrHook;
66 }
67
68 void
69 ErrorHdrHook(long fd)
70 {
71     const char msg[] = "\nFail: ";
72     write(fd, msg, sizeof(msg)-1);
73 }
74
75
76
77 /* Import directly from correct DLL */
78
79      /*../CPUTime.hsc:107:foreign import "GetCurrentProcess" unsafe getCurrentProcess :: IO (Ptr HANDLE)
80        ../CPUTime.hsc:108:foreign import "GetProcessTimes" unsafe getProcessTimes :: Ptr HANDLE -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO CInt */
81
82 int s_mkdir(const char *s) { return mkdir(s); }
83 int s_chmod(const char *s, mode_t m) { return chmod(s, m); }
84 int s_access(const char *s, int m) { return access(s, m); }
85 char *s_getcwd(char *s, size_t n) { return getcwd(s, n); }
86 int s_rmdir(const char *s) { return rmdir(s); }
87 int s_chdir(const char *s) { return chdir(s); }
88 int s_unlink(const char *s) { return unlink(s); }
89 int s_rename(const char *s1, const char *s2) { return rename(s1, s2); }
90 DIR *s_opendir(const char *s) { return opendir(s); }
91 struct dirent *s_readdir(DIR *d) { return readdir(d); }
92 int s_closedir(DIR *d) { return closedir(d); }
93 int s_stat(const char *s, struct stat *buf) { return stat(s, buf); }
94 int s_fstat(int f, struct stat* buf) { return fstat(f, buf); }
95 int s_open(const char *s, int f) { return open(s, f); }
96 int s_close(int f) { return close(f); }
97 int s_write(int f, const void *buf, size_t n) { return write(f, buf, n); }
98 int s_read(int f, void *buf, size_t n) { return read(f, buf, n); }
99 int s_lseek(int f, off_t off, int w) { return lseek(f, off, w); }
100 int s_isatty(int f) { return isatty(f); }
101 void *s_memcpy(void *d, const void *s, size_t n) { return memcpy(d, s, n); }
102 void *s_memmove(void *d, const void *s, size_t n) { return memmove(d, s, n); }
103 char *s_strerror(int e) { return strerror(e); }
104 int s_setmode(int a, int b) { return setmode(a,b); }
105 void *s_malloc(size_t n) { return malloc(n); }
106 void *s_realloc(void *p, size_t n) { return realloc(p, n); }
107 void s_free(void *p) { free(p); }
108 char *s_getenv(const char *s) { return getenv(s); }
109 struct tm *s_localtime(const time_t *p) { return localtime(p); }
110 struct tm *s_gmtime(const time_t *p) { return gmtime(p); }
111 time_t s_mktime(struct tm *p) { return mktime(p); }
112 time_t s_time(time_t *p) { return time(p); }
113 void s_ftime(struct timeb *p) { ftime(p); }