1 /* foreign4.c
2  * Copyright 1984-2017 Cisco Systems, Inc.
3  *
4  * Licensed under the Apache License, Version 2.0 (the "License");
5  * you may not use this file except in compliance with the License.
6  * You may obtain a copy of the License at
7  *
8  * http://www.apache.org/licenses/LICENSE-2.0
9  *
10  * Unless required by applicable law or agreed to in writing, software
11  * distributed under the License is distributed on an "AS IS" BASIS,
12  * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13  * See the License for the specific language governing permissions and
14  * limitations under the License.
15  */
16 
17 #include <stdio.h>
18 #include <stdlib.h>
19 
20 #if defined(_REENTRANT) || defined(_WIN32)
21 # ifdef _WIN32
22 #  include <Windows.h>
23 #  define SCHEME_IMPORT
24 #  include "scheme.h"
25 # else
26 #  include <pthread.h>
27 #  include "scheme.h"
28 # endif
29 # undef EXPORT
30 #endif
31 
32 typedef signed char i8;
33 typedef unsigned char u8;
34 typedef unsigned short u16;
35 #ifdef _WIN32
36 typedef __int64 i64;
37 # define EXPORT extern __declspec (dllexport)
38 #else
39 typedef long long i64;
40 # define EXPORT
41 #endif
42 
43 /* To help make sure that argument and result handling doesn't
44    read or write too far, try to provide functions that allocate
45    a structure at the end of a memory page (where the next page is
46    likely to be unmapped) */
47 
48 #if defined(__linux__) || (defined(__APPLE__) && defined(__MACH__))
49 
50 # include <stdlib.h>
51 # include <sys/mman.h>
52 # include <unistd.h>
53 # include <inttypes.h>
54 
malloc_at_boundary(int sz)55 EXPORT void *malloc_at_boundary(int sz)
56 {
57   intptr_t alloc_size = getpagesize();
58   char *p;
59   p = mmap(NULL, 2 * alloc_size, PROT_READ | PROT_WRITE, MAP_ANON | MAP_PRIVATE, -1, 0);
60   mprotect(p + alloc_size, alloc_size, PROT_NONE);
61   return p + alloc_size - sz;
62 }
63 
free_at_boundary(void * p)64 EXPORT void free_at_boundary(void *p)
65 {
66   intptr_t alloc_size = getpagesize();
67   munmap((void *)(((intptr_t)p) & ~(alloc_size-1)), 2 * alloc_size);
68 }
69 
70 #elif defined(_WIN32)
71 
malloc_at_boundary(int sz)72 EXPORT void *malloc_at_boundary(int sz)
73 {
74   SYSTEM_INFO si;
75   char *p;
76   DWORD dummy;
77   GetSystemInfo(&si);
78   p = VirtualAlloc(NULL, 2 * si.dwPageSize, MEM_COMMIT | MEM_RESERVE, PAGE_READWRITE);
79   VirtualProtect(p + si.dwPageSize, si.dwPageSize, PAGE_NOACCESS, &dummy);
80   return p + si.dwPageSize - sz;
81 }
82 
free_at_boundary(void * p)83 EXPORT void free_at_boundary(void *p)
84 {
85   SYSTEM_INFO si;
86   GetSystemInfo(&si);
87   VirtualFree((void *)(((intptr_t)p) & ~(si.dwPageSize-1)), 0, MEM_RELEASE);
88 }
89 
90 #else
91 
malloc_at_boundary(int sz)92 EXPORT void *malloc_at_boundary(int sz)
93 {
94   return malloc(sz);
95 }
96 
free_at_boundary(void * p)97 EXPORT void free_at_boundary(void *p)
98 {
99   free(p);
100 }
101 
102 #endif
103 
104 #if defined(_REENTRANT) || defined(_WIN32)
105 
106 typedef struct in_thread_args_t {
107   double (*proc)(double arg);
108   double arg;
109   int n_times;
110 } in_thread_args_t;
111 
in_thread(void * _proc_and_arg)112 void *in_thread(void *_proc_and_arg)
113 {
114   in_thread_args_t *proc_and_arg = _proc_and_arg;
115   int i;
116 
117   for (i = 0; i < proc_and_arg->n_times; i++) {
118     proc_and_arg->arg = proc_and_arg->proc(proc_and_arg->arg);
119   }
120 
121   return NULL;
122 }
123 
124 #if defined(_WIN32)
125 # define os_thread_t unsigned
126 # define os_thread_create(addr, proc, arg) (((*(addr)) = _beginthread(proc, 0, arg)) == -1)
127 # define os_thread_join(t) WaitForSingleObject((HANDLE)(intptr_t)(t), INFINITE)
128 #else
129 # define os_thread_t pthread_t
130 # define os_thread_create(addr, proc, arg) pthread_create(addr, NULL, in_thread, proc_and_arg)
131 # define os_thread_join(t) pthread_join(t, NULL)
132 #endif
133 
134 #ifdef FEATURE_PTHREADS
call_in_unknown_thread(double (* proc)(double arg),double arg,int n_times,int do_fork,int do_deactivate)135 EXPORT double call_in_unknown_thread(double (*proc)(double arg), double arg, int n_times,
136                                      int do_fork, int do_deactivate) {
137   os_thread_t t;
138   in_thread_args_t *proc_and_arg = malloc(sizeof(in_thread_args_t));
139 
140   proc_and_arg->proc = proc;
141   proc_and_arg->arg = arg;
142   proc_and_arg->n_times = n_times;
143 
144   if (do_fork) {
145     if (!os_thread_create(&t, in_thread, proc_and_arg)) {
146       if (do_deactivate)
147         Sdeactivate_thread();
148       os_thread_join(t);
149       if (do_deactivate)
150         Sactivate_thread();
151     }
152   } else {
153     in_thread(proc_and_arg);
154   }
155 
156   arg = proc_and_arg->arg;
157   free(proc_and_arg);
158 
159   return arg;
160 }
161 #endif /* FEATURE_PTHREADS */
162 #endif
163 
spin_a_while(int amt,unsigned a,unsigned b)164 EXPORT unsigned spin_a_while(int amt, unsigned a, unsigned b)
165 {
166   int i;
167 
168   /* A loop that the compiler is unlikely to optimize away */
169   for (i = 0; i < amt; i++) {
170     a = a + 1;
171     b = b + a;
172   }
173 
174   return a;
175 }
176 
177 #define GEN(ts, init, sum)                                              \
178   EXPORT ts f4_get_ ## ts () {                                          \
179     ts r = init;                                                        \
180     return r;                                                           \
181   }                                                                     \
182   EXPORT double f4_sum_ ## ts (ts v) {                                  \
183     return sum(v);                                                      \
184   }                                                                     \
185   EXPORT double f4_sum_two_ ## ts (ts v1, ts v2) {                      \
186     return sum(v1) + sum(v2);                                           \
187   }                                                                     \
188   EXPORT double f4_sum_pre_double_ ## ts (double v0, ts v) {            \
189     return v0 + sum(v);                                                 \
190   }                                                                     \
191   EXPORT double f4_sum_pre_double_double_ ## ts (double v0, double v1, ts v) { \
192     return v0 + v1 + sum(v);                                            \
193   }                                                                     \
194   EXPORT double f4_sum_pre_double_double_double_double_ ## ts (double v0, double v1, double v2, double v3, ts v) { \
195     return v0 + v1 + v2 + v3 + sum(v);                                  \
196   }                                                                     \
197   EXPORT double f4_sum_pre_double_double_double_double_double_double_double_double_ ## ts \
198   (double v0, double v1, double v2, double v3, double v4, double v5, double v6, double v7, ts v) { \
199     return v0 + v1 + v2 + v3 + v4 + v5 + v6 + v7 + sum(v);              \
200   }                                                                     \
201   EXPORT double f4_sum_ ## ts ## _post_double (ts v, double v0) {       \
202     return v0 + sum(v);                                                 \
203   }                                                                     \
204   EXPORT double f4_sum_pre_int_ ## ts (int v0, ts v) {                  \
205     return (double)v0 + sum(v);                                         \
206   }                                                                     \
207   EXPORT double f4_sum_pre_int_int_ ## ts (int v0, int v1, ts v) {      \
208     return (double)v0 + (double)v1 + sum(v);                            \
209   }                                                                     \
210   EXPORT double f4_sum_pre_int_int_int_int_ ## ts (int v0, int v1, int v2, int v3, ts v) { \
211     return (double)v0 + (double)v1 + (double)v2 + (double)v3 + sum(v);  \
212   }                                                                     \
213   EXPORT double f4_sum_pre_int_int_int_int_int_int_ ## ts (int v0, int v1, int v2, int v3, int v4, int v5, ts v) { \
214     return (double)v0 + (double)v1 + (double)v2 + (double)v3 + (double)v4 + (double)v5 + sum(v); \
215   }                                                                     \
216   EXPORT double f4_sum_ ## ts ## _post_int (ts v, int v0) {             \
217     return (double)v0 + sum(v);                                         \
218   }                                                                     \
219   EXPORT double f4_cb_send_ ## ts (double (*cb)(ts)) {                  \
220     ts r = init;                                                        \
221     return cb(r) + 1.0;							\
222   }                                                                     \
223   EXPORT double f4_cb_send_two_ ## ts (double (*cb)(ts, ts)) {          \
224     ts r1 = init;                                                       \
225     ts r2 = init;                                                       \
226     return cb(r1, r2) + 1.0;                                            \
227   }                                                                     \
228   EXPORT double f4_cb_send_pre_int_ ## ts (double (*cb)(int, ts)) {     \
229     ts r = init;                                                        \
230     return cb(8, r) + 1.0;                                              \
231   }                                                                     \
232   EXPORT double f4_cb_send_pre_int_int_ ## ts (double (*cb)(int, int, ts)) { \
233     ts r = init;                                                        \
234     return cb(8, 9, r) + 1.0;                                           \
235   }                                                                     \
236   EXPORT double f4_cb_send_pre_int_int_int_int_ ## ts (double (*cb)(int, int, int, int, ts)) { \
237     ts r = init;                                                        \
238     return cb(8, 9, 10, 11, r) + 1.0;                                   \
239   }                                                                     \
240   EXPORT double f4_cb_send_pre_int_int_int_int_int_int_ ## ts (double (*cb)(int, int, int, int, int, int, ts)) { \
241     ts r = init;                                                        \
242     return cb(8, 9, 10, 11, 12, 13, r) + 1.0;                           \
243   }                                                                     \
244   EXPORT double f4_cb_send_pre_double_ ## ts (double (*cb)(double, ts)) { \
245     ts r = init;                                                        \
246     return cb(8.25, r) + 1.0;                                           \
247   }                                                                     \
248   EXPORT double f4_cb_send_pre_double_double_ ## ts (double (*cb)(double, double, ts)) { \
249     ts r = init;                                                        \
250     return cb(8.25, 9.25, r) + 1.0;                                     \
251   }                                                                     \
252   EXPORT double f4_cb_send_pre_double_double_double_double_ ## ts (double (*cb)(double, double, double, double, ts)) { \
253     ts r = init;                                                        \
254     return cb(8.25, 9.25, 10.25, 11.25, r) + 1.0;                       \
255   }                                                                     \
256   EXPORT double f4_cb_send_pre_double_double_double_double_double_double_double_double_ ## ts \
257   (double (*cb)(double, double, double, double, double, double, double, double, ts)) { \
258     ts r = init;                                                        \
259     return cb(8.25, 9.25, 10.25, 11.25, 12.25, 13.25, 14.25, 15.25, r) + 1.0; \
260   }                                                                     \
261   EXPORT double f4_sum_cb_ ## ts (ts (*cb)()) {                         \
262     ts v = cb();                                                        \
263     return sum(v);                                                      \
264   }
265 
266 #define TO_DOUBLE(x) ((double)(x))
267 GEN(i8, -11, TO_DOUBLE)
268 GEN(u8, 129, TO_DOUBLE)
269 GEN(short, -22, TO_DOUBLE)
270 GEN(u16, 33022, TO_DOUBLE)
271 GEN(long, 33, TO_DOUBLE)
272 GEN(int, 44, TO_DOUBLE)
273 GEN(i64, 49, TO_DOUBLE)
274 GEN(float, 55.0, TO_DOUBLE)
275 GEN(double, 66.0, TO_DOUBLE)
276 
277 /* Some ABIs treat a struct containing a single field different that
278    just the field */
279 #define GEN_1(t1, v1)                                                   \
280   typedef struct struct_ ## t1 { t1 x; } struct_ ## t1;                 \
281   static double _f4_sum_struct_ ## t1 (struct_ ## t1 v) {               \
282     return (double)v.x;                                                 \
283   }                                                                     \
284   static struct_ ## t1 init_struct_ ## t1 = { v1 };                     \
285   GEN(struct_ ## t1, init_struct_ ## t1, _f4_sum_struct_ ## t1)
286 
287 GEN_1(i8, -12)
288 GEN_1(u8, 212)
289 GEN_1(short, -23)
290 GEN_1(u16, 33023)
291 GEN_1(long, 34)
292 GEN_1(int, 45)
293 GEN_1(i64, 48)
294 GEN_1(float, 56.0)
295 GEN_1(double, 67.0)
296 
297 #define GEN_2(t1, t2, v1, v2)                                           \
298   typedef struct struct_ ## t1 ## _ ## t2 { t1 x; t2 y; } struct_ ## t1 ## _ ## t2; \
299   static double _f4_sum_struct_ ## t1 ## _ ## t2 (struct_ ## t1 ## _ ## t2 v) { \
300     return (double)v.x + (double)v.y;                                   \
301   }                                                                     \
302   static struct_ ## t1 ## _ ## t2 init_struct_ ## t1 ## _ ## t2 = { v1, v2 }; \
303   GEN(struct_ ## t1 ## _ ## t2, init_struct_ ## t1 ## _ ## t2, _f4_sum_struct_ ## t1 ## _ ## t2)
304 
305 #define GEN_2_SET(t, x)                         \
306   GEN_2(t, i8, 1+x, 10)                         \
307   GEN_2(t, short, 2+x, 20)                      \
308   GEN_2(t, long, 3+x, 30)                       \
309   GEN_2(t, i64, 5+x, 50)                        \
310   GEN_2(short, t, 6, 60+x)                      \
311   GEN_2(long, t, 7, 70+x)                       \
312   GEN_2(i64, t, 9, 90+x)                        \
313   GEN_2(i8, t, 10, 100+x)
314 
315 GEN_2_SET(int, 0)
316 GEN_2_SET(float, 0.5)
317 GEN_2_SET(double, 0.25)
318 
319 GEN_2(int, int, 4, 40)
320 GEN_2(float, float, 4.5, 40.5)
321 GEN_2(double, double, 4.25, 40.25)
322 
323 #define GEN_3(t1, t2, t3, v1, v2, v3)                                   \
324   typedef struct struct_ ## t1 ## _ ## t2 ## _ ## t3 { t1 x; t2 y; t3 z; } struct_ ## t1 ## _ ## t2 ## _ ## t3; \
325   static double _f4_sum_struct_ ## t1 ## _ ## t2 ## _ ## t3 (struct_ ## t1 ## _ ## t2 ## _ ## t3 v) { \
326     return (double)v.x + (double)v.y + (double)v.z;                     \
327   }                                                                     \
328   static struct_ ## t1 ## _ ## t2 ## _ ## t3 init_struct_ ## t1 ## _ ## t2 ## _ ## t3 = { v1, v2, v3 }; \
329   GEN(struct_ ## t1 ## _ ## t2 ## _ ## t3, init_struct_ ## t1 ## _ ## t2 ## _ ## t3, _f4_sum_struct_ ## t1 ## _ ## t2 ## _ ## t3)
330 
331 #define GEN_3_SET(t, x)                           \
332   GEN_3(t, i8, int, 1+x, 10, 100)                 \
333   GEN_3(t, short, int, 2+x, 20, 200)              \
334   GEN_3(t, long, int, 3+x, 30, 300)               \
335   GEN_3(t, i64, int, 5+x, 50, 500)                \
336   GEN_3(short, t, int, 6, 60+x, 600)              \
337   GEN_3(long, t, int, 7, 70+x, 700)               \
338   GEN_3(i64, t, int, 9, 90+x, 900)                \
339   GEN_3(i8, t, int, 10, 100+x, 1000)
340 
341 GEN_3_SET(int, 0)
342 GEN_3_SET(float, 0.5)
343 GEN_3_SET(double, 0.25)
344 
345 GEN_3(i8, i8, i8, 4, 38, 127)
346 GEN_3(short, short, short, 4, 39, 399)
347 GEN_3(int, int, int, 4, 40, 400)
348 GEN_3(float, float, float, 4.5, 40.5, 400.5)
349 GEN_3(double, double, double, 4.25, 40.25, 400.25)
350 
351 typedef struct struct_i8_i8_i8_i8_i8 { i8 x, y, z, w, q; } struct_i8_i8_i8_i8_i8;
_f4_sum_struct_i8_i8_i8_i8_i8(struct_i8_i8_i8_i8_i8 v)352 static double _f4_sum_struct_i8_i8_i8_i8_i8 (struct_i8_i8_i8_i8_i8 v) {
353   return (double)v.x + (double)v.y + (double)v.z + (double)v.w + (double)v.q;
354 }
355 static struct struct_i8_i8_i8_i8_i8 init_struct_i8_i8_i8_i8_i8 = { 1, 2, 3, 4, 5 };
356 GEN(struct_i8_i8_i8_i8_i8, init_struct_i8_i8_i8_i8_i8, _f4_sum_struct_i8_i8_i8_i8_i8)
357 
358 typedef struct struct_i8_i8_i8_i8_i8_i8_i8 { i8 x, y, z, w, q, r, s; } struct_i8_i8_i8_i8_i8_i8_i8;
_f4_sum_struct_i8_i8_i8_i8_i8_i8_i8(struct struct_i8_i8_i8_i8_i8_i8_i8 v)359 static double _f4_sum_struct_i8_i8_i8_i8_i8_i8_i8 (struct struct_i8_i8_i8_i8_i8_i8_i8 v) {
360   return (double)v.x + (double)v.y + (double)v.z + (double)v.w + (double)v.q + (double)v.r + (double)v.s;
361 }
362 static struct struct_i8_i8_i8_i8_i8_i8_i8 init_struct_i8_i8_i8_i8_i8_i8_i8 = { 1, 2, 3, 4, 5, 6, 7 };
363 GEN(struct_i8_i8_i8_i8_i8_i8_i8, init_struct_i8_i8_i8_i8_i8_i8_i8, _f4_sum_struct_i8_i8_i8_i8_i8_i8_i8)
364 
365 /* Some ABIs treat a union containing a single field different that
366    just the field */
367 #define GEN_U1(t1, v1)                                                \
368   typedef union union_ ## t1 { t1 x; } union_ ## t1;                  \
369   static double _f4_sum_union_ ## t1 (union_ ## t1 v) {               \
370     return (double)v.x;                                               \
371   }                                                                   \
372   static union_ ## t1 init_union_ ## t1 = { v1 };                     \
373   GEN(union_ ## t1, init_union_ ## t1, _f4_sum_union_ ## t1)
374 
375 GEN_U1(i8, -17)
376 GEN_U1(u8, 217)
377 GEN_U1(short, -27)
378 GEN_U1(u16, 33027)
379 GEN_U1(long, 37)
380 GEN_U1(int, 47)
381 GEN_U1(i64, 49)
382 GEN_U1(float, 57.0)
383 GEN_U1(double, 77.0)
384 
385 #define GEN_U2(t1, t2, v1)                                              \
386   typedef union union_ ## t1 ## _ ## t2 { t1 x; t2 y; } union_ ## t1 ## _ ## t2; \
387   static double _f4_sum_union_ ## t1 ## _ ## t2 (union_ ## t1 ## _ ## t2 v) { \
388     return (double)v.x;                                                 \
389   }                                                                     \
390   static union_ ## t1 ## _ ## t2 init_union_ ## t1 ## _ ## t2 = { v1 }; \
391   GEN(union_ ## t1 ## _ ## t2, init_union_ ## t1 ## _ ## t2, _f4_sum_union_ ## t1 ## _ ## t2)
392 
393 GEN_U2(i8, int, 18)
394 GEN_U2(short, int, 28)
395 GEN_U2(long, int, 38)
396 GEN_U2(int, int, 48)
397 GEN_U2(i64, int, 43)
398 GEN_U2(float, int, 58.0)
399 GEN_U2(double, int, 68.0)
400