1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
|
/* cpascal.h: implement various bits of standard and other Pascal that
we use in the change files. Public domain.
This is the top-level include file for all the web2c-generated C
programs except TeX and Metafont themselves, which use texmf.h.
It's not included by the web2c programs themselves. */
#ifndef CPASCAL_H
#define CPASCAL_H
#ifdef WIN32
#pragma warning( disable : 4018 4244 )
#endif
/* We must include this first, to resolve many C issues. */
#include <w2c/config.h>
/* We only use getopt in the applications, not in web2c itself. */
#include <kpathsea/getopt.h>
/* Almost everybody needs path searching. May as well always include
them and simplify the change files. */
#include <kpathsea/progname.h>
#include <kpathsea/proginit.h>
#include <kpathsea/tex-file.h>
#include <kpathsea/variable.h>
/* Help messages. */
#include "help.h"
/* Allow translation files. */
#define Xchr(x) xchr[x]
/* Pieces of predefined Pascal web2c doesn't convert. */
/* Absolute value. Without the casts to integer here, the Ultrix and
AIX compilers (at least) produce bad code (or maybe it's that I don't
understand all the casting rules in C) for tests on memory fields.
Specifically, a test in diag_round (in Metafont) on a quarterword
comes out differently without the cast, thus causing the trap test to
fail. (A path at line 86 is constructed slightly differently). */
/* If the system had an abs #define already, get rid of it. */
#undef abs
#define abs(x) ((integer)(x) >= 0 ? (integer)(x) : (integer)-(x))
#define chr(x) (x)
#define ord(x) (x)
#define odd(x) ((x) & 1)
#define round(x) zround ((double) (x))
#define trunc(x) ((integer) (x))
#undef floor /* MacOSX */
#define floor(x) ((integer)floor((double)(x)))
#define input stdin
#define output stdout
#define maxint INTEGER_MAX
#define nil NULL
#define floorunscaled(i) ((i)>>16)
#define floorscaled(i) ((i)&(-65536))
#define roundunscaled(i) ((((i)>>15)+1)>>1)
#define roundfraction(i) ((((i)>>11)+1)>>1)
#ifndef TeX
/* In TeX, the half routine is always applied to positive integers.
In MF and MP, it isn't; therefore, we can't portably use the C shift
operator -- whether zeros or the sign bit will be shifted in on
negative left operands is implementation-defined.
It might be worth going through MF and using halfp where possible, as
in MP. */
#define half(i) ( ((i)<0) ? (((i)+1)>>1) : ((i)>>1) )
#endif
#define halfp(i) ((i) >> 1)
/* Standard Pascal file routines. These are used for both binary and
text files, but binary is more common. If you want it 100% right,
fix the change files to pass the fopen mode to reset in all cases and
send me the changes; it doesn't matter for Unix, so I'm not going to
spend any more time on it. */
#define reset(f,n) f = xfopen (n, FOPEN_R_MODE)
#define rewrite(f,n) f = xfopen (n, FOPEN_W_MODE)
#define resetbin(f,n) f = xfopen (n, FOPEN_RBIN_MODE)
#define rewritebin(f,n) f = xfopen (n, FOPEN_WBIN_MODE)
#if defined(read)
#undef read
#endif
#define read(f,b) ((b) = getc (f))
/* We hope this will be efficient than the `x = x - 1' that decr would
otherwise be translated to. Likewise for incr. */
#define decr(x) --(x)
#define incr(x) ++(x)
/* `real' is used for noncritical floating-point stuff. */
typedef double real;
/* C doesn't need to distinguish between text files and other files. */
typedef FILE *text;
/* Extra stuff used in various change files for various reasons. */
/* Pascal has no address-of operator, and we need pointers to integers
to set up the option table. */
#define addressof(x) (&(x))
/* So dvicopy can use stdin/stdout. */
#if defined (__DJGPP__) || defined (WIN32)
#include <io.h>
/* Don't set console device to binary. */
#define makebinaryfile(arg) ((void)(!isatty(fileno(arg)) && setmode(fileno(arg), O_BINARY)), arg)
#else
#define makebinaryfile(arg) (arg)
#endif
/* It's not worth fixing fixwrites to handle Pascal-style n:m write
specifiers for reals, so the change files call print_real instead. */
#define printreal(r,n,m) fprintreal (stdout, r, n, m)
/* Write the byte X to the file F. */
#define putbyte(x,f) \
do { if (putc ((char) (x) & 255, f) == EOF) \
FATAL1 ("putbyte(%ld) failed", (long) x); } while (0)
/* To work around casting problems. */
#define ucharcast(x) ((unsigned char) (x))
#define int64cast(x) ((integer64) (x))
#define stringcast(x) ((string) (x))
#define conststringcast(x) ((const_string) (x))
#define ustringcast(x) ((unsigned char *) (x))
/* For throwing away input from the file F. */
#define vgetc(f) (void) getc (f)
/* The fixwrites program outputs this, for diagnostics and such, that
aren't worth checking the return value on. */
#define Fputs(f,s) (void) fputs (s, f)
/* `aopenin' is used for all kinds of input text files, so it
needs to know what path to use. Used by BibTeX, MF, TeX. */
#define aopenin(f,p) open_input (&(f), p, FOPEN_RBIN_MODE)
#define aopenout(f) open_output (&(f), FOPEN_W_MODE)
#define aclose close_file
/* Used in BibTeX for subsidiary aux files. */
#define aopeninwithdirname(f,p,s) open_input_with_dirname (&(f), p, s)
/* How to output to the GF or DVI file. */
#define WRITE_OUT(a, b) \
if ((size_t) fwrite ((char *) &OUT_BUF[a], sizeof (OUT_BUF[a]), \
(size_t) ((size_t)(b) - (size_t)(a) + 1), OUT_FILE) \
!= (size_t) ((size_t) (b) - (size_t) (a) + 1)) \
FATAL_PERROR ("fwrite");
#ifdef GFTODVI
#define writedvi WRITE_OUT
#define OUT_FILE dvifile
#define OUT_BUF dvibuf
#endif
/* PatGen 2 uses this. */
#define input2ints(a,b) zinput2ints (&a, &b)
/* We need this only if TeX is being debugged. */
#define input3ints(a,b,c) zinput3ints (&a, &b, &c)
/* Allocate an array of a given type. Add 1 to size to account for the
fact that Pascal arrays are used from [1..size], unlike C arrays which
use [0..size). */
#define xmallocarray(type,size) ((type*)xmalloc((size+1)*sizeof(type)))
/* Same for reallocating an array. */
#define xreallocarray(ptr,type,size) ((type*)xrealloc(ptr,(size+1)*sizeof(type)))
/* Allocate and clear an array of a given type. Add 1 to nmemb and size. */
#define xcallocarray(type,nmemb,size) ((type*)xcalloc(nmemb+1,(size+1)*sizeof(type)))
/* BibTeX needs this to dynamically reallocate arrays. Too bad we can't
rely on stringification, or we could avoid the ARRAY_NAME arg.
Actually allocate one more than requests, so we can index the last
entry, as Pascal wants to do. */
#define BIBXRETALLOCNOSET(array_name, array_var, type, size_var, new_size) \
fprintf (logfile, "Reallocated %s (elt_size=%ld) to %ld items from %ld.\n", \
array_name, (long) sizeof (type), (long) new_size, (long) size_var); \
XRETALLOC (array_var, new_size + 1, type)
/* Same as above, but also increase SIZE_VAR when no more arrays
with the same size parameter will be resized. */
#define BIBXRETALLOC(array_name, array_var, type, size_var, new_size) do { \
BIBXRETALLOCNOSET(array_name, array_var, type, size_var, new_size); \
size_var = new_size; \
} while (0)
/* Same as above, but for the pseudo-TYPE ASCII_code[LENGTH+1]. */
#define BIBXRETALLOCSTRING(array_name, array_var, length, size_var, new_size) \
fprintf (logfile, "Reallocated %s (elt_size=%ld) to %ld items from %ld.\n", \
array_name, (long) (length + 1), (long) new_size, (long) size_var); \
XRETALLOC (array_var, (new_size) * (length + 1), ASCIIcode)
/* Need precisely int for getopt, etc. */
#define cinttype int
/* Need this because web2c doesn't translate `var1,var2:^char' correctly
-- var2 lacks the *. */
#define cstring string
#define constcstring const_string
/* For strings of unsigned chars, used as array indices. */
#define constw2custring const_w2custring
typedef unsigned char *w2custring;
typedef const unsigned char *const_w2custring;
/* Not all C libraries have fabs, so we'll roll our own. */
#undef fabs
#define fabs(x) ((x) >= 0.0 ? (x) : -(x))
/* TeX et al. have a variable free, but we also need the C routine. */
#define libcfree free
/* We have a system-dependent prompt in tex.ch. We don't want it in the
string pool, since (now that the pools are compiled into the
binaries), that would make the .fmt unsharable. So go through this
circumlotion to print a C string. The lack of the closing ) is
intentional, since the code adds more text sometimes. Although the
eof character can be changed with stty or whatever, we're certainly
not going to try to extract the actual value from a terminal struct.
Anyone who is savvy enough to change it will not be confused. */
#ifdef WIN32
#define promptfilenamehelpmsg "(Press Enter to retry, or Control-Z to exit"
#else
#define promptfilenamehelpmsg "(Press Enter to retry, or Control-D to exit"
#endif
/* We use this rather than a simple fputs so that the string will end up
in the .log file, too. */
#define printcstring(STR) \
do { \
const_string ch_ptr = (STR); \
while (*ch_ptr) \
printchar(*(ch_ptr++)); \
} while (0)
/* Tangle removes underscores from names. Put them back for things that
are defined in C with _'s. */
#define extendfilename extend_filename
#define findsuffix find_suffix
#define makesuffix make_suffix
#define FOPENRBINMODE FOPEN_RBIN_MODE
#define FOPENRMODE FOPEN_R_MODE
#define getoptlongonly getopt_long_only
#define hasarg has_arg
#define ISDIRSEP IS_DIR_SEP
#define kpsebibformat kpse_bib_format
#define kpsebstformat kpse_bst_format
#define kpsefindfile kpse_find_file
#define kpsefindmf kpse_find_mf
#define kpsefindmft kpse_find_mft
#define kpsefindofm kpse_find_ofm
#define kpsefindovf kpse_find_ovf
#define kpsefindtex kpse_find_tex
#define kpsefindtfm kpse_find_tfm
#define kpsefindvf kpse_find_vf
#define kpseinnameok kpse_in_name_ok
#define kpseinitprog kpse_init_prog
#define kpsesetprogramname kpse_set_program_name
#define kpseresetprogramname kpse_reset_program_name
#define kpsegfformat kpse_gf_format
#define kpselastformat kpse_last_format
#define kpsemaketexdiscarderrors kpse_make_tex_discard_errors
#define kpsemfformat kpse_mf_format
#define kpsemftformat kpse_mft_format
#define kpsempformat kpse_mp_format
#define kpseocpformat kpse_ocp_format
#define kpseofmformat kpse_ofm_format
#define kpseoplformat kpse_opl_format
#define kpseotpformat kpse_otp_format
#define kpseoutnameok kpse_out_name_ok
#define kpseovpformat kpse_ovp_format
#define kpseovfformat kpse_ovf_format
#define kpseopenfile kpse_open_file
#define kpsepkformat kpse_pk_format
#define kpsetfmformat kpse_tfm_format
#define kpsevfformat kpse_vf_format
#define kpsewebformat kpse_web_format
#define kpsevarvalue kpse_var_value
#define kpsesetprogramenabled kpse_set_program_enabled
#define kpsesrccmdline kpse_src_cmdline
#define kpsesrccompile kpse_src_compile
#define recorderchangefilename recorder_change_filename
#define recorderenabled recorder_enabled
#define removesuffix remove_suffix
#define texmfyesno texmf_yesno
/* We need a new type for the argument parsing, too. */
typedef struct option getoptstruct;
/* We never need the `link' system call, which may be declared in
<unistd.h>, but we do have variables named `link' in the webs. */
#undef link
#define link link_var
/* Throw away VMS' library routine `getname', as WEB uses that name. */
#ifdef VMS
#undef getname
#define getname vms_getname
#endif
/* Apparently POSIX 2008 has getline and glibc 2.9.90 exports it.
tangle, weave, et al. use that symbol; try to define it away to
something that a standard won't usurp. */
#ifdef getline
#undef getline
#endif
#define getline web2c_getline
/* Declarations for the routines we provide ourselves in lib/. */
#include "lib/lib.h"
extern int loadpoolstrings (integer);
#endif /* not CPASCAL_H */
|