source/texk/web2c/cpascal.h

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