annotate keiko/primtab.h @ 1:b5139af1a420 tip basis

Fixed permissions on compile scripts
author Mike Spivey <mike@cs.ox.ac.uk>
date Fri, 13 Oct 2017 17:27:58 +0100
parents bfdcc3820b32
children
rev   line source
0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
1 /*
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
2 * primtab.h
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
3 *
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
4 * This file is part of the Oxford Oberon-2 compiler
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
5 * Copyright (c) 2006--2016 J. M. Spivey
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
6 * All rights reserved
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
7 *
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
8 * Redistribution and use in source and binary forms, with or without
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
9 * modification, are permitted provided that the following conditions are met:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
10 *
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
11 * 1. Redistributions of source code must retain the above copyright notice,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
12 * this list of conditions and the following disclaimer.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
13 * 2. Redistributions in binary form must reproduce the above copyright notice,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
14 * this list of conditions and the following disclaimer in the documentation
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
15 * and/or other materials provided with the distribution.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
16 * 3. The name of the author may not be used to endorse or promote products
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
17 * derived from this software without specific prior written permission.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
18 *
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
19 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
20 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
21 * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
22 * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
23 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
24 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
25 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
26 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
27 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
28 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
29 */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
30
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
31 #include "obx.h"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
32 #include <math.h>
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
33 #include <ctype.h>
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
34
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
35 /* Types for each kind of argument */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
36 typedef int type_C, type_I;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
37 typedef longint type_L;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
38 typedef float type_F;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
39 typedef double type_D;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
40 typedef void *type_P, *type_Q, *type_X;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
41 typedef void type_V;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
42
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
43 /* Size of each kind in argument words */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
44 #define size_C 1
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
45 #define size_I 1
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
46 #define size_F 1
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
47 #define size_P 1
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
48 #define size_L 2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
49 #define size_D 2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
50 #define size_X 2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
51 #define size_Q 2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
52
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
53 /* How to fetch each kind of argument */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
54 #define arg_I(j) bp[HEAD+j].i
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
55 #define arg_C(j) align_byte(bp[HEAD+j].i)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
56 #define arg_L(j) get_long(&bp[HEAD+j])
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
57 #define arg_F(j) bp[HEAD+j].f
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
58 #define arg_D(j) get_double(&bp[HEAD+j])
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
59 #define arg_P(j) pointer(bp[HEAD+j])
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
60 #define arg_X(j) pointer(bp[HEAD+j])
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
61 #define arg_Q(j) ptrcast(void, get_long(&bp[HEAD+j]))
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
62
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
63 /* How to return each kind of result via ob_res */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
64 #define res_I(v) ob_res.i = v
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
65 #define res_C(v) ob_res.i = v
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
66 #define res_F(v) ob_res.f = v
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
67 #define res_P(v) ob_res.a = address(v)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
68 #define res_L(v) put_long(&ob_res, v)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
69 #define res_D(v) put_double(&ob_res, v)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
70 #define res_Q(v) put_long(&ob_res, (ptrtype) v)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
71 #define res_V(v) v
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
72
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
73 /* Three kinds of primitive:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
74 DIRECT -- defined by a function "void prim(value *bp)"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
75 WRAPPER -- defined by an foreign function prim that declared in one of
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
76 the included header files. We generate a wrapper P_prim.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
77 INDIRECT -- defined by an internal function in some library module, with
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
78 a natural type. We generate a wrapper that includes a
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
79 declaration of the function.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
80
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
81 Call WRAPPER(name, res, a1, a2, ..., an) where res and a1, ..., an are
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
82 type letters for the result and arguments. */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
83
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
84 #define DIRECT(name) void name(value *bp);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
85 #define WRAPPER(...) WRAP(_WRAP, 0, __VA_ARGS__)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
86 #define INDIRECT(...) WRAP(_INDIR, 0, __VA_ARGS__)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
87
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
88 /* WRAP(mac, base, name, res, a1, ..., an) is
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
89
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
90 mac(name, res,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
91 (type_a1, ..., type_an),
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
92 (arg_a1(base), arg_a2(base+s1), arg_a3(base+s1+s2), ...,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
93 arg_an(base+s1+s2+...s(n-1))))
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
94
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
95 where si = size_ai. */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
96
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
97 #define WRAP(mac, base, ...) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
98 SELECT(__VA_ARGS__, WRAP6, WRAP5, WRAP4, WRAP3, \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
99 WRAP2, WRAP1, WRAP0)(mac, base, __VA_ARGS__)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
100
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
101 #define SELECT(n, r, a1, a2, a3, a4, a5, a6, t, ...) t
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
102
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
103 #define WRAP0(mac, base, name, res) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
104 mac(name, res, (void), ())
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
105 #define WRAP1(mac, base, name, res, a1) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
106 mac(name, res, (type_##a1), (arg_##a1(base)))
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
107 #define WRAP2(mac, base, name, res, a1, a2) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
108 mac(name, res, (type_##a1, type_##a2), (args2(base, a1, a2)))
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
109 #define WRAP3(mac, base, name, res, a1, a2, a3) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
110 mac(name, res, \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
111 (type_##a1, type_##a2, type_##a3), \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
112 (args3(base, a1, a2, a3)))
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
113 #define WRAP4(mac, base, name, res, a1, a2, a3, a4) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
114 mac(name, res, \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
115 (type_##a1, type_##a2, type_##a3, type_##a4), \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
116 (args4(base, a1, a2, a3, a4)))
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
117 #define WRAP5(mac, base, name, res, a1, a2, a3, a4, a5) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
118 mac(name, res, \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
119 (type_##a1, type_##a2, type_##a3, type_##a4, type_##a5), \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
120 (args5(base, a1, a2, a3, a4, a5)))
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
121 #define WRAP6(mac, base, name, res, a1, a2, a3, a4, a5, a6) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
122 mac(name, res, \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
123 (type_##a1, type_##a2, type_##a3, type_##a4, type_##a5, type_##a6), \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
124 (args6(base, a1, a2, a3, a4, a5, a6)))
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
125
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
126 #define args2(j, a1, a2) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
127 arg_##a1(j), arg_##a2(j+size_##a1)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
128 #define args3(j, a1, a2, a3) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
129 arg_##a1(j), args2(j+size_##a1, a2, a3)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
130 #define args4(j, a1, a2, a3, a4) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
131 arg_##a1(j), args3(j+size_##a1, a2, a3, a4)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
132 #define args5(j, a1, a2, a3, a4, a5) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
133 arg_##a1(j), args4(j+size_##a1, a2, a3, a4, a5)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
134 #define args6(j, a1, a2, a3, a4, a5, a6) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
135 arg_##a1(j), args5(j+size_##a1, a2, a3, a4, a5, a6)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
136
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
137 /* How to generate a wrapper function with (_INDIR) or without (_WRAP)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
138 a declaration of the function being wrapped. */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
139 #define _WRAP(name, res, atypes, args) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
140 __WRAP(, name, res, args)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
141 #define _INDIR(name, res, atypes, args) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
142 __WRAP(type_##res name atypes;, name, res, args)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
143 #define __WRAP(decl, name, res, args) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
144 void P_##name(value *bp) { decl FPINIT; res_##res(name args); }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
145
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
146 #define WRAPPERS(prims) prims(DIRECT, INDIRECT, WRAPPER)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
147
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
148 /* How to generate entries in the primitive table */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
149 #define DPRIM(name, ...) { #name, name },
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
150 #define IPRIM(name, ...) DPRIM(P_##name)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
151
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
152 #define TABLE(prims) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
153 struct primdef primtab[] = { \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
154 prims(DPRIM, IPRIM, IPRIM) \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
155 { NULL, NULL } \
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
156 };
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
157
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
158 /* If dynamic linking is enabled, we don't need a static table of
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
159 primitives; if not, then we make a table and dltrap(dynlink.c)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
160 will search it. Note that we can have statically generated wrappers
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
161 for speed even if FFI is available. */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
162
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
163 #ifdef DYNLINK
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
164 #define PRIMTAB(prims) WRAPPERS(prims)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
165 #else
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
166 #define PRIMTAB(prims) WRAPPERS(prims) TABLE(prims)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
167 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
168
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
169 /* Variation for the compilers course with offset to compensate for
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
170 dummy static link */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
171
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
172 #define PWRAPPER(...) WRAP(_WRAP, 1, __VA_ARGS__)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
173 #define PINDIRECT(...) WRAP(_INDIR, 1, __VA_ARGS__)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
174 #define PWRAPPERS(prims) prims(DIRECT, PINDIRECT, PWRAPPER)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
175
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
176 #ifdef DYNLINK
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
177 #define PPRIMTAB(prims) PWRAPPERS(prims)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
178 #else
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
179 #define PPRIMTAB(prims) PWRAPPERS(prims) TABLE(prims)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
180 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
181