w32tex
About: TeX Live provides a comprehensive TeX system including all the major TeX-related programs, macro packages, and fonts that are free software. Windows sources.
  Fossies Dox: w32tex-src.tar.xz  ("unofficial" and yet experimental doxygen-generated source code documentation)  

support.c
Go to the documentation of this file.
1 /*
2  * support.c
3  *
4  * This file is part of the Oxford Oberon-2 compiler
5  * Copyright (c) 2006--2016 J. M. Spivey
6  * All rights reserved
7  *
8  * Redistribution and use in source and binary forms, with or without
9  * modification, are permitted provided that the following conditions are met:
10  *
11  * 1. Redistributions of source code must retain the above copyright notice,
12  * this list of conditions and the following disclaimer.
13  * 2. Redistributions in binary form must reproduce the above copyright notice,
14  * this list of conditions and the following disclaimer in the documentation
15  * and/or other materials provided with the distribution.
16  * 3. The name of the author may not be used to endorse or promote products
17  * derived from this software without specific prior written permission.
18  *
19  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
20  * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
21  * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
22  * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
23  * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
24  * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
25  * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
26  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
27  * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
28  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
29  */
30 
31 #include "obx.h"
32 #include <stdarg.h>
33 #include <string.h>
34 #include <errno.h>
35 
36 /* Assorted runtime support routines */
37 
38 void panic(const char *msg, ...) {
39  va_list va;
40 
41  mybool bug = FALSE;
42 
43  if (*msg == '*') {
44  bug = TRUE; msg++;
45  }
46 
47  fflush(stdout);
48  fprintf(stderr, "Fatal error: ");
49  va_start(va, msg);
50  vfprintf(stderr, msg, va);
51  va_end(va);
52  fprintf(stderr, "\n");
53  if (bug)
54  fprintf(stderr, "Please report bugs to %s\n", PACKAGE_BUGREPORT);
55  fflush(stderr);
56  error_exit(3);
57 }
58 
59 
60 /* The DIV and MOD instructions must give the correct results, even if
61  C is wrong. Correct means that b * (a DIV b) + a MOD b = a, and
62  (-a) DIV (-b) = a DIV b, and if b > 0 then 0 <= a MOD b < b. */
63 
64 void int_div(value *sp) {
65  int a = sp[1].i, b = sp[0].i;
66  int quo = a / b;
67  int rem = a - b * quo;
68  if (rem != 0 && (rem ^ b) < 0) quo--;
69  sp[1].i = quo;
70 }
71 
72 void int_mod(value *sp) {
73  int a = sp[1].i, b = sp[0].i;
74  int rem = a % b;
75  if (rem != 0 && (rem ^ b) < 0) rem += b;
76  sp[1].i = rem;
77 }
78 
79 void long_div(value *sp) {
80  longint a = get_long(&sp[2]), b = get_long(&sp[0]);
81  longint quo = a / b;
82  longint rem = a - b * quo;
83  if (rem != 0 && (rem ^ b) < 0) quo--;
84  put_long(&sp[2], quo);
85 }
86 
87 void long_mod(value *sp) {
88  longint a = get_long(&sp[2]), b = get_long(&sp[0]);
89  longint rem = a % b;
90  if (rem != 0 && (rem ^ b) < 0) rem += b;
91  put_long(&sp[2], rem);
92 }
93 
94 void long_flo(value *sp) {
96 }
97 
98 #ifndef M64X32
99 void long_add(value *sp) {
100  put_long(sp+2, get_long(sp+2) + get_long(sp));
101 }
102 
103 void long_sub(value *sp) {
104  put_long(sp+2, get_long(sp+2) - get_long(sp));
105 }
106 
107 void long_mul(value *sp) {
108  put_long(sp+2, get_long(sp+2) * get_long(sp));
109 }
110 
111 void long_neg(value *sp) {
112  put_long(sp, -get_long(sp));
113 }
114 
115 void long_cmp(value *sp) {
116  longint a = get_long(sp+2), b = get_long(sp);
117  sp[3].i = (a < b ? -1 : a > b ? 1 : 0);
118 }
119 
120 void long_ext(value *sp) {
121  put_long(sp-1, (longint) sp[0].i);
122 }
123 
125  if (get_long(sp+2) == 0)
126  runtime_error(E_DIV, sp[0].i, ptrcast(value, sp[1].a), NULL);
127 }
128 #endif
129 
130 #ifndef FLOATOPS
131 void flo_add(value *sp) { sp[1].f = sp[1].f + sp[0].f; }
132 void flo_sub(value *sp) { sp[1].f = sp[1].f - sp[0].f; }
133 void flo_mul(value *sp) { sp[1].f = sp[1].f * sp[0].f; }
134 void flo_div(value *sp) { sp[1].f = sp[1].f / sp[0].f; }
135 void flo_neg(value *sp) { sp[0].f = - sp[0].f; }
136 void flo_float(value *sp) { sp[0].f = (float) sp[0].i; }
137 void flo_fix(value *sp) { sp[0].i = (int) sp[0].f; }
138 
139 void flo_cmpl(value *sp) {
140  float a = sp[1].f, b = sp[0].f;
141  sp[1].i = (a > b ? 1 : a == b ? 0 : -1);
142 }
143 
144 void flo_cmpg(value *sp) {
145  float a = sp[1].f, b = sp[0].f;
146  sp[1].i = (a < b ? -1 : a == b ? 0 : 1);
147 }
148 
149 void dbl_add(value *sp) {
151 }
152 
153 void dbl_sub(value *sp) {
155 }
156 
157 void dbl_mul(value *sp) {
159 }
160 
161 void dbl_div(value *sp) {
163 }
164 
165 void dbl_neg(value *sp) {
166  put_double(sp, - get_double(sp));
167 }
168 
170  put_double(sp-1, (double) sp[0].i);
171 }
172 
173 void dbl_fix(value *sp) {
174  sp[1].i = (int) get_double(sp);
175 }
176 
177 void dbl_cmpl(value *sp) {
178  double a = get_double(sp+2), b = get_double(sp);
179  sp[3].i = (a > b ? 1 : a == b ? 0 : -1);
180 }
181 
182 void dbl_cmpg(value *sp) {
183  double a = get_double(sp+2), b = get_double(sp);
184  sp[3].i = (a < b ? -1 : a == b ? 0 : 1);
185 }
186 
188  put_double(sp-1, (double) sp[0].f);
189 }
190 
192  sp[1].f = (float) get_double(sp);
193 }
194 
196  if (sp[2].f == 0.0f)
197  runtime_error(E_FDIV, sp[0].i, ptrcast(value, sp[1].a), NULL);
198 }
199 
201  if (get_double(sp+2) == 0.0)
202  runtime_error(E_FDIV, sp[0].i, ptrcast(value, sp[1].a), NULL);
203 }
204 #endif
205 
206 
207 /* Conversions between int and floating point */
208 
209 #ifndef GCOV
210 /* These are not done inline in interp() because that upsets the
211  gcc optimiser on i386, adding overhead to every instruction. */
212 double flo_conv(int x) {
213  return (double) x;
214 }
215 
216 double flo_convq(longint x) {
217  return (double) x;
218 }
219 #endif
220 
221 /* obcopy -- like strncpy, but guarantees termination with zero */
222 void obcopy(char *dst, int dlen, const char *src, int slen, value *bp) {
223  if (slen == 0 || dlen < slen) {
224  strncpy(dst, src, dlen);
225  if (dst[dlen-1] != '\0')
226  liberror("string copy overflows destination");
227  } else {
228  strncpy(dst, src, slen);
229  if (dst[slen-1] != '\0')
230  liberror("source was not null-terminated");
231  memset(&dst[slen], '\0', dlen-slen);
232  }
233 }
234 
235 #ifndef UNALIGNED_MEM
236 double get_double(value *v) {
237  dblbuf dd;
238  dd.n.lo = v[0].i;
239  dd.n.hi = v[1].i;
240  return dd.d;
241 }
242 
243 void put_double(value *v, double x) {
244  dblbuf dd;
245  dd.d = x;
246  v[0].i = dd.n.lo;
247  v[1].i = dd.n.hi;
248 }
249 
251  dblbuf dd;
252  dd.n.lo = v[0].i;
253  dd.n.hi = v[1].i;
254  return dd.q;
255 }
256 
258  dblbuf dd;
259  dd.q = x;
260  v[0].i = dd.n.lo;
261  v[1].i = dd.n.hi;
262 }
263 #endif
264 
265 /* find_symbol -- find a procedure from its CP. Works for modules too. */
266 proc find_symbol(word p, proc *table, int nelem) {
267  int a = 0, b = nelem;
268 
269  if (p == 0) return NULL;
270  if (nelem == 0 || p < table[0]->p_addr) return NULL;
271 
272  /* Binary search */
273  /* Inv: 0 <= a < b <= nelem, table[a] <= x < table[b],
274  where table[nelem] = infinity */
275  while (a+1 != b) {
276  int m = (a+b)/2;
277  if (table[m]->p_addr <= p)
278  a = m;
279  else
280  b = m;
281  }
282 
283  return table[a];
284 }
285 
286 #ifdef WINDOWS
287 #ifdef OBXDEB
288 #define OBGETC 1
289 #endif
290 #endif
291 
292 /* obgetc -- version of getc that compensates for Windows quirks */
293 int obgetc(FILE *fp) {
294 #ifdef OBGETC
295  /* Even if Ctrl-C is trapped, it causes a getc() call on the console
296  to return EOF. */
297  for (;;) {
298  int c = getc(fp);
299  if (c == EOF && intflag && prim_bp != NULL) {
300  value *cp = valptr(prim_bp[CP]);
301  debug_break(cp , prim_bp, NULL, "interrupt");
302  continue;
303  }
304  return c;
305  }
306 #else
307  return getc(fp);
308 #endif
309 }
310 
311 /* get_errno -- fetch the value of errno, for use as a primitive */
312 int get_errno(void) {
313  return errno;
314 }
bp
Definition: action.c:1035
cp
Definition: action.c:1035
#define b
Definition: jpegint.h:372
@ FALSE
Definition: dd.h:101
@ TRUE
Definition: dd.h:102
int v
Definition: dviconv.c:10
#define fflush
Definition: xxstdio.h:24
char * strncpy()
mpz_t * f
Definition: gen-fib.c:34
#define c(n)
Definition: gpos-common.c:150
#define a(n)
Definition: gpos-common.c:148
#define slen
Definition: hpcdtoppm.c:1329
static void error_exit(j_common_ptr cinfo)
Definition: jerror.c:70
#define NULL
Definition: ftobjs.h:61
small capitals from c petite p
Definition: afcover.h:72
small capitals from c petite p scientific i
Definition: afcover.h:80
#define EOF
Definition: afmparse.c:59
#define PACKAGE_BUGREPORT
Definition: config.h:93
int errno
#define getc
Definition: line.c:39
#define fprintf
Definition: mendex.h:64
float x
Definition: cordic.py:15
#define CP
Definition: obcommon.h:76
#define E_FDIV
Definition: obcommon.h:117
int64_t longint
Definition: obcommon.h:61
#define E_DIV
Definition: obcommon.h:116
int mybool
Definition: obcommon.h:37
#define ptrcast(t, a)
Definition: obx.h:69
#define valptr(v)
Definition: obx.h:57
void runtime_error(int num, int line, value *bp, uchar *pc)
Definition: xmain.c:252
#define liberror(msg)
Definition: obx.h:265
unsigned short word
Definition: picttoppm.c:64
#define fp
bstring c int memset(void *s, int c, int length)
Definition: obx.h:103
Definition: texview.c:48
Definition: table.h:30
#define FILE
Definition: t1stdio.h:34
m
Definition: tex4ht.c:3990
return() int(((double) *(font_tbl[cur_fnt].wtbl+(int)(*(font_tbl[cur_fnt].char_wi+(int)(ch - font_tbl[cur_fnt].char_f)% 256)))/(double)(1L<< 20)) *(double) font_tbl[cur_fnt].scale)
#define sp
Definition: stack.c:11
double d
Definition: obcommon.h:69
longint q
Definition: obcommon.h:70
int lo
Definition: obcommon.h:67
struct dblbuf::@1891 n
int hi
Definition: obcommon.h:67
Definition: obx.h:51
#define va_start(pvar)
Definition: varargs.h:30
#define va_end(pvar)
Definition: varargs.h:38
char * va_list
Definition: varargs.h:22
void flo_float(value *sp)
Definition: support.c:136
void dbl_float(value *sp)
Definition: support.c:169
void flo_div(value *sp)
Definition: support.c:134
void long_neg(value *sp)
Definition: support.c:111
void panic(const char *msg,...)
Definition: support.c:38
void flo_cmpg(value *sp)
Definition: support.c:144
void long_flo(value *sp)
Definition: support.c:94
void dbl_add(value *sp)
Definition: support.c:149
void dbl_cmpl(value *sp)
Definition: support.c:177
void flo_mul(value *sp)
Definition: support.c:133
void flo_zcheck(value *sp)
Definition: support.c:195
void flo_fix(value *sp)
Definition: support.c:137
int get_errno(void)
Definition: support.c:312
void long_mod(value *sp)
Definition: support.c:87
void flo_cmpl(value *sp)
Definition: support.c:139
void flo_trunc(value *sp)
Definition: support.c:191
void long_ext(value *sp)
Definition: support.c:120
void flo_neg(value *sp)
Definition: support.c:135
void dbl_widen(value *sp)
Definition: support.c:187
void flo_sub(value *sp)
Definition: support.c:132
double flo_convq(longint x)
Definition: support.c:216
void long_div(value *sp)
Definition: support.c:79
void dbl_neg(value *sp)
Definition: support.c:165
void long_add(value *sp)
Definition: support.c:99
void dbl_cmpg(value *sp)
Definition: support.c:182
void long_mul(value *sp)
Definition: support.c:107
void flo_add(value *sp)
Definition: support.c:131
void obcopy(char *dst, int dlen, const char *src, int slen, value *bp)
Definition: support.c:222
void dbl_div(value *sp)
Definition: support.c:161
int obgetc(FILE *fp)
Definition: support.c:293
void dbl_mul(value *sp)
Definition: support.c:157
void long_cmp(value *sp)
Definition: support.c:115
proc find_symbol(word p, proc *table, int nelem)
Definition: support.c:266
void long_sub(value *sp)
Definition: support.c:103
void put_double(value *v, double x)
Definition: support.c:243
void long_zcheck(value *sp)
Definition: support.c:124
double get_double(value *v)
Definition: support.c:236
void dbl_sub(value *sp)
Definition: support.c:153
void int_mod(value *sp)
Definition: support.c:72
void dbl_zcheck(value *sp)
Definition: support.c:200
void int_div(value *sp)
Definition: support.c:64
double flo_conv(int x)
Definition: support.c:212
longint get_long(value *v)
Definition: support.c:250
void dbl_fix(value *sp)
Definition: support.c:173
void put_long(value *v, longint x)
Definition: support.c:257