1 /* -*- mode: C; mode: fold -*-
2 Copyright (C) 2010-2017,2018 John E. Davis
3
4 This file is part of the S-Lang Library.
5
6 The S-Lang Library is free software; you can redistribute it and/or
7 modify it under the terms of the GNU General Public License as
8 published by the Free Software Foundation; either version 2 of the
9 License, or (at your option) any later version.
10
11 The S-Lang Library is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with this library; if not, write to the Free Software
18 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
19 USA.
20 */
21 #include "config.h"
22
23 #include <stdio.h>
24 #include <string.h>
25 #include <slang.h>
26
27 SLANG_MODULE(varray);
28
29 #ifdef HAVE_MMAP
30
31 # include <sys/types.h>
32 # include <sys/stat.h>
33 # ifdef HAVE_SYS_MMAN_H
34 # include <sys/mman.h>
35 # endif
36
37 # ifndef MAP_FAILED
38 # define MAP_FAILED -1
39 # endif
40
41 typedef struct
42 {
43 size_t size_mmapped;
44 VOID_STAR addr;
45 VOID_STAR data;
46 }
47 MMap_Type;
48
free_mmap_type(MMap_Type * m)49 static void free_mmap_type (MMap_Type *m)
50 {
51 if (m == NULL)
52 return;
53 if (m->addr != NULL)
54 (void) munmap ((char *) m->addr, m->size_mmapped);
55 SLfree ((char *)m);
56 }
57
unmmap_array(SLang_Array_Type * at)58 static void unmmap_array (SLang_Array_Type *at)
59 {
60 if (at->client_data != NULL)
61 free_mmap_type ((MMap_Type *) at->client_data);
62
63 at->data = NULL;
64 at->client_data = NULL;
65 }
66
mmap_file(char * file,size_t offset,size_t num_bytes)67 static MMap_Type *mmap_file (char *file, size_t offset, size_t num_bytes)
68 {
69 FILE *fp;
70 int fd;
71 struct stat st;
72 VOID_STAR addr;
73 MMap_Type *m;
74
75 fp = fopen (file, "rb");
76 if (fp == NULL)
77 {
78 SLang_verror (SL_OBJ_NOPEN, "mmap_array: unable to open %s for reading", file);
79 return NULL;
80 }
81 fd = fileno (fp);
82
83 if (-1 == fstat (fd, &st))
84 {
85 SLang_verror (SL_INTRINSIC_ERROR, "mmap_array: stat %s failed", file);
86 fclose (fp);
87 return NULL;
88 }
89
90 if (NULL == (m = (MMap_Type *) SLmalloc (sizeof (MMap_Type))))
91 {
92 fclose (fp);
93 return NULL;
94 }
95
96 m->size_mmapped = num_bytes + offset;
97 addr = (VOID_STAR)mmap (NULL, m->size_mmapped, PROT_READ, MAP_SHARED, fd, 0);
98 if (addr == (VOID_STAR)MAP_FAILED)
99 {
100 SLang_verror (SL_INTRINSIC_ERROR, "mmap_array: mmap %s failed", file);
101 SLfree ((char *) m);
102 fclose (fp);
103 return NULL;
104 }
105 m->addr = addr;
106 m->data = (VOID_STAR) ((char *)addr + offset);
107
108 fclose (fp);
109
110 return m;
111 }
112
113 #if 0
114 static int pop_off_t (off_t *op)
115 {
116 #if defined(HAVE_LONG_LONG) && (SIZEOF_OFF_T == SIZEOF_LONG_LONG) && (SIZEOF_LONG_LONG > SIZEOF_LONG)
117 return SLang_pop_long_long (op);
118 #else
119 long ofs;
120 if (-1 == SLang_pop_long (&ofs))
121 return -1;
122 *op = (off_t) ofs;
123 return 0;
124 #endif
125 }
126 #endif
127
pop_size_t(size_t * sp)128 static int pop_size_t (size_t *sp)
129 {
130 #if defined(HAVE_LONG_LONG) && (SIZEOF_SIZE_T == SIZEOF_LONG_LONG) && (SIZEOF_LONG_LONG > SIZEOF_LONG)
131 return SLang_pop_ulong_long (sp);
132 #else
133 unsigned long s;
134 if (-1 == SLang_pop_ulong (&s))
135 return -1;
136 *sp = (size_t) s;
137 return 0;
138 #endif
139 }
140
141 /* usage:
142 * a = mmap_array (file, offset, type, [dims]);
143 */
mmap_array(void)144 static void mmap_array (void)
145 {
146 SLang_Array_Type *a, *a_dims;
147 char *file;
148 SLtype type;
149 SLindex_Type *dims;
150 unsigned int num_dims;
151 unsigned int i;
152 SLuindex_Type num_elements;
153 size_t offset;
154 size_t sizeof_type;
155 size_t num_bytes;
156 MMap_Type *m;
157
158 m = NULL;
159 a_dims = NULL;
160 file = NULL;
161
162 if (-1 == SLang_pop_array_of_type (&a_dims, SLANG_ARRAY_INDEX_TYPE))
163 return;
164
165 num_dims = a_dims->num_elements;
166 dims = (SLindex_Type *)a_dims->data;
167
168 if (-1 == SLang_pop_datatype (&type))
169 goto return_error;
170
171 switch (type)
172 {
173 case SLANG_CHAR_TYPE:
174 case SLANG_UCHAR_TYPE:
175 sizeof_type = 1;
176 break;
177
178 case SLANG_SHORT_TYPE:
179 case SLANG_USHORT_TYPE:
180 sizeof_type = sizeof(short);
181 break;
182
183 case SLANG_INT_TYPE:
184 case SLANG_UINT_TYPE:
185 sizeof_type = sizeof (int);
186 break;
187
188 case SLANG_LONG_TYPE:
189 case SLANG_ULONG_TYPE:
190 sizeof_type = sizeof (long);
191 break;
192
193 case SLANG_FLOAT_TYPE:
194 sizeof_type = sizeof (float);
195 break;
196
197 case SLANG_DOUBLE_TYPE:
198 sizeof_type = sizeof (double);
199 break;
200
201 case SLANG_COMPLEX_TYPE:
202 sizeof_type = 2 * sizeof (double);
203 break;
204
205 default:
206 SLang_verror (SL_NOT_IMPLEMENTED, "mmap_array: unsupported data type");
207 goto return_error;
208 }
209
210 num_elements = 1;
211 for (i = 0; i < num_dims; i++)
212 {
213 if (dims[i] < 0)
214 {
215 SLang_verror (SL_INVALID_PARM, "mmap_array: dims array must be positive");
216 goto return_error;
217 }
218
219 num_elements *= dims[i];
220 }
221 if (num_dims == 0)
222 num_elements = 0;
223
224 num_bytes = sizeof_type * num_elements;
225
226 if (-1 == pop_size_t (&offset))
227 goto return_error;
228
229 if (-1 == SLang_pop_slstring (&file))
230 goto return_error;
231
232 if (NULL == (m = mmap_file (file, offset, num_bytes)))
233 goto return_error;
234
235 if (NULL == (a = SLang_create_array (type, 1, m->data, dims, num_dims)))
236 goto return_error;
237
238 a->free_fun = unmmap_array;
239 a->client_data = (VOID_STAR) m;
240
241 m = NULL; /* done with this */
242
243 (void) SLang_push_array (a, 1);
244
245 /* drop */
246
247 return_error:
248 if (m != NULL)
249 free_mmap_type (m);
250 if (a_dims != NULL)
251 SLang_free_array (a_dims);
252 if (file != NULL)
253 SLang_free_slstring (file);
254 }
255 #endif /* HAVE_MMAP */
256
257 static SLang_Intrin_Fun_Type Module_Intrinsics [] =
258 {
259 #ifdef HAVE_MMAP
260 MAKE_INTRINSIC_0("mmap_array", mmap_array, SLANG_VOID_TYPE),
261 #endif
262 SLANG_END_INTRIN_FUN_TABLE
263 };
264
init_varray_module_ns(char * ns_name)265 int init_varray_module_ns (char *ns_name)
266 {
267 SLang_NameSpace_Type *ns;
268
269 if (NULL == (ns = SLns_create_namespace (ns_name)))
270 return -1;
271
272 if (-1 == SLns_add_intrin_fun_table (ns, Module_Intrinsics, NULL))
273 return -1;
274
275 return 0;
276 }
277
278