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 intcast(x) ((integer) (x))
 127 #define int64cast(x) ((integer64) (x))
 128 #define stringcast(x) ((string) (x))
 129 #define conststringcast(x) ((const_string) (x))
 130 #define ustringcast(x) ((unsigned char *) (x))
 131
 132 /* For throwing away input from the file F.  */
 133 #define vgetc(f) (void) getc (f)
 134
 135 /* The fixwrites program outputs this, for diagnostics and such, that
 136    aren't worth checking the return value on.  */
 137 #define Fputs(f,s) (void) fputs (s, f)
 138
 139 /* `aopenin' is used for all kinds of input text files, so it
 140    needs to know what path to use.  Used by BibTeX, MF, TeX.  */
 141 #define aopenin(f,p) open_input (&(f), p, FOPEN_RBIN_MODE)
 142 #define aopenout(f)  open_output (&(f), FOPEN_W_MODE)
 143 #define aclose close_file
 144
 145 /* For faking arrays in tftopl.  */
 146 typedef unsigned char *pointertobyte;
 147 #define casttobytepointer(e) ((pointertobyte) e)
 148
 149 /* How to output to the GF or DVI file.  */
 150 #define WRITE_OUT(a, b)                                                 \
 151   if ((size_t) fwrite ((char *) &OUT_BUF[a], sizeof (OUT_BUF[a]),       \
 152                     (size_t) ((size_t)(b) - (size_t)(a) + 1), OUT_FILE) \
 153       != (size_t) ((size_t) (b) - (size_t) (a) + 1))                    \
 154     FATAL_PERROR ("fwrite");
 155
 156 #ifdef GFTODVI
 157 #define writedvi WRITE_OUT
 158 #define OUT_FILE dvifile
 159 #define OUT_BUF dvibuf
 160 #endif
 161
 162 /* PatGen 2 uses this.  */
 163 #define input2ints(a,b) zinput2ints (&a, &b)
 164
 165 /* We need this only if TeX is being debugged.  */
 166 #define input3ints(a,b,c) zinput3ints (&a, &b, &c)
 167
 168 /* Allocate an array of a given type. Add 1 to size to account for the
 169    fact that Pascal arrays are used from [1..size], unlike C arrays which
 170    use [0..size). */
 171 #define xmallocarray(type,size) ((type*)xmalloc((size+1)*sizeof(type)))
 172 /* Same for reallocating an array. */
 173 #define xreallocarray(ptr,type,size) ((type*)xrealloc(ptr,(size+1)*sizeof(type)))
 174 /* Allocate and clear an array of a given type. Add 1 to nmemb and size. */
 175 #define xcallocarray(type,nmemb,size) ((type*)xcalloc(nmemb+1,(size+1)*sizeof(type)))
 176
 177 /* BibTeX needs this to dynamically reallocate arrays.  Too bad we can't
 178    rely on stringification, or we could avoid the ARRAY_NAME arg.
 179    Actually allocate one more than requests, so we can index the last
 180    entry, as Pascal wants to do.  */
 181 #define BIBXRETALLOCNOSET(array_name, array_var, type, size_var, new_size) \
 182   fprintf (logfile, "Reallocated %s (elt_size=%ld) to %ld items from %ld.\n", \
 183            array_name, (long) sizeof (type), (long) new_size, (long) size_var); \
 184   XRETALLOC (array_var, new_size + 1, type)
 185 /* Same as above, but also increase SIZE_VAR when no more arrays
 186    with the same size parameter will be resized.  */
 187 #define BIBXRETALLOC(array_name, array_var, type, size_var, new_size) do { \
 188   BIBXRETALLOCNOSET(array_name, array_var, type, size_var, new_size); \
 189   size_var = new_size; \
 190 } while (0)
 191 /* Same as above, but for the pseudo-TYPE ASCII_code[LENGTH+1].  */
 192 #define BIBXRETALLOCSTRING(array_name, array_var, length, size_var, new_size) \
 193   fprintf (logfile, "Reallocated %s (elt_size=%ld) to %ld items from %ld.\n", \
 194            array_name, (long) (length + 1), (long) new_size, (long) size_var); \
 195   XRETALLOC (array_var, (new_size) * (length + 1), ASCIIcode)
 196
 197 /* Need precisely int for getopt, etc. */
 198 #define cinttype int
 199
 200 /* Need this because web2c doesn't translate `var1,var2:^char' correctly
 201    -- var2 lacks the *.  */
 202 #define cstring string
 203
 204 #define constcstring const_string
 205
 206 /* For strings of unsigned chars, used as array indices.  */
 207 #define constw2custring const_w2custring
 208 typedef unsigned char *w2custring;
 209 typedef const unsigned char *const_w2custring;
 210
 211 /* Not all C libraries have fabs, so we'll roll our own.  */
 212 #undef fabs
 213 #define fabs(x) ((x) >= 0.0 ? (x) : -(x))
 214
 215 /* TeX et al. have a variable free, but we also need the C routine.  */
 216 #define libcfree free
 217
 218 /* We have a system-dependent prompt in tex.ch.  We don't want it in the
 219    string pool, since (now that the pools are compiled into the
 220    binaries), that would make the .fmt unsharable.  So go through this
 221    circumlotion to print a C string.  The lack of the closing ) is
 222    intentional, since the code adds more text sometimes.  Although the
 223    eof character can be changed with stty or whatever, we're certainly
 224    not going to try to extract the actual value from a terminal struct.
 225    Anyone who is savvy enough to change it will not be confused.  */
 226 #ifdef WIN32
 227 #define promptfilenamehelpmsg "(Press Enter to retry, or Control-Z to exit"
 228 #else
 229 #define promptfilenamehelpmsg "(Press Enter to retry, or Control-D to exit"
 230 #endif
 231
 232 /* We use this rather than a simple fputs so that the string will end up
 233    in the .log file, too.  */
 234 #define printcstring(STR)        \
 235   do {                           \
 236     const_string ch_ptr = (STR); \
 237     while (*ch_ptr)              \
 238       printchar(*(ch_ptr++));    \
 239   } while (0)
 240
 241 \f
 242 /* Tangle removes underscores from names.  Put them back for things that
 243    are defined in C with _'s.  */
 244 #define extendfilename  extend_filename
 245 #define findsuffix      find_suffix
 246 #define makesuffix      make_suffix
 247 #define FOPENRBINMODE   FOPEN_RBIN_MODE
 248 #define FOPENRMODE      FOPEN_R_MODE
 249 #define getoptlongonly  getopt_long_only
 250 #define hasarg          has_arg
 251 #define ISDIRSEP        IS_DIR_SEP
 252 #define kpsebibformat   kpse_bib_format
 253 #define kpsebstformat   kpse_bst_format
 254 #define kpsefindfile    kpse_find_file
 255 #define kpsefindmf      kpse_find_mf
 256 #define kpsefindmft     kpse_find_mft
 257 #define kpsefindofm     kpse_find_ofm
 258 #define kpsefindovf     kpse_find_ovf
 259 #define kpsefindtex     kpse_find_tex
 260 #define kpsefindtfm     kpse_find_tfm
 261 #define kpsefindvf      kpse_find_vf
 262 #define kpseinnameok    kpse_in_name_ok
 263 #define kpseinitprog    kpse_init_prog
 264 #define kpsesetprogramname kpse_set_program_name
 265 #define kpseresetprogramname kpse_reset_program_name
 266 #define kpsegfformat    kpse_gf_format
 267 #define kpselastformat  kpse_last_format
 268 #define kpsemaketexdiscarderrors kpse_make_tex_discard_errors
 269 #define kpsemfformat    kpse_mf_format
 270 #define kpsemftformat   kpse_mft_format
 271 #define kpsempformat    kpse_mp_format
 272 #define kpseocpformat   kpse_ocp_format
 273 #define kpseofmformat   kpse_ofm_format
 274 #define kpseoplformat   kpse_opl_format
 275 #define kpseotpformat   kpse_otp_format
 276 #define kpseoutnameok   kpse_out_name_ok
 277 #define kpseovpformat   kpse_ovp_format
 278 #define kpseovfformat   kpse_ovf_format
 279 #define kpseopenfile    kpse_open_file
 280 #define kpsepkformat    kpse_pk_format
 281 #define kpsetfmformat   kpse_tfm_format
 282 #define kpsevfformat    kpse_vf_format
 283 #define kpsewebformat   kpse_web_format
 284 #define kpsevarvalue    kpse_var_value
 285 #define kpsesetprogramenabled   kpse_set_program_enabled
 286 #define kpsesrccmdline  kpse_src_cmdline
 287 #define kpsesrccompile  kpse_src_compile
 288 #define recorderchangefilename  recorder_change_filename
 289 #define recorderenabled recorder_enabled
 290
 291 /* We need a new type for the argument parsing, too.  */
 292 typedef struct option getoptstruct;
 293 \f
 294 /* We never need the `link' system call, which may be declared in
 295    <unistd.h>, but we do have variables named `link' in the webs.  */
 296 #undef link
 297 #define link link_var
 298
 299 /* Throw away VMS' library routine `getname', as WEB uses that name.  */
 300 #ifdef VMS
 301 #undef getname
 302 #define getname vms_getname
 303 #endif
 304
 305 /* Apparently POSIX 2008 has getline and glibc 2.9.90 exports it.
 306    tangle, weave, et al. use that symbol; try to define it away so
 307    something that a standard won't usurp.  */
 308 #ifdef getline
 309 #undef getline
 310 #endif
 311 #define getline web2c_getline
 312
 313 \f
 314 /* Declarations for the routines we provide ourselves in lib/.  */
 315 #include "lib/lib.h"
 316
 317 extern int loadpoolstrings (integer);
 318
 319 #endif /* not CPASCAL_H */