//! @file vif.h
//! @author J. Marcel van der Veer
//
//! @section Copyright
//
// This file is part of VIF - vintage FORTRAN compiler.
// Copyright 2020-2025 J. Marcel van der Veer <algol68g@xs4all.nl>.
//
//! @section License
//
// This program is free software; you can redistribute it and/or modify it 
// under the terms of the GNU General Public License as published by the 
// Free Software Foundation; either version 3 of the License, or 
// (at your option) any later version.
//
// This program is distributed in the hope that it will be useful, but 
// WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 
// or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 
// more details. You should have received a copy of the GNU General Public 
// License along with this program. If not, see <http://www.gnu.org/licenses/>.

//! @section Synopsis
//!
//! VIF include file.

// This is a monolithic include file to avoid cluttering the installation directory.

#if ! defined (__VIF_H__)
#define __VIF_H__

#define _GNU_SOURCE

#include <complex.h>
#include <ctype.h>
#include <endian.h>
#include <errno.h>
#include <float.h>
#include <inttypes.h>
#include <libgen.h>
#include <limits.h>
#include <math.h>
#include <quadmath.h>
#include <signal.h>
#include <stdarg.h>
#include <stddef.h>
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <sys/stat.h>
#include <sys/time.h>
#include <sys/utsname.h>
#include <time.h>
#include <unistd.h>

#define prototype

#define PACKAGE "vif"

#define NO_IDENT ((IDENT *) NULL)
#define NO_INTRINS ((INTRINS *) NULL)
#define NO_LABEL ((LBL *) NULL)
#define NO_MODE ((MODE *) NULL)
#define NO_TEXT ((char *) NULL)
#define NO_FUN NULL
#define NO_FTNFILE ((FTNFILE *) NULL)
#define NO_FTN_LINE ((FTN_LINE *) NULL)
#define NO_FILE ((FILE *) NULL)
#define NO_REF_INTEGER ((int_4 *) NULL)
#define NO_EXPR ((EXPR *) NULL)
#define NO_REF_TEXT ((char **) NULL)

#define STDF_IN 5
#define STDF_OUT 6
#define STDF_PUN 6
#define STDF_ERR 7

typedef char *FORMAT;

// Flags for gcc when compiling generated code from FORTRAN.

#if defined (BOOTSTRAP)
  #define CFLAGS "-pipe -ggdb -I. -Isrc/include -L. -I../include -Wno-implicit-function-declaration -Wno-incompatible-pointer-types -fdiagnostics-plain-output -fdiagnostics-show-location=once"
  #define LD_FLAGS "-rdynamic -Lsrc/lib -L../lib -lvif -lquadmath -lm"
#else
  #define CFLAGS "-pipe -ggdb -I. -Isrc/include -L. -I../include -Wno-implicit-function-declaration -Wno-incompatible-pointer-types -fdiagnostics-plain-output -fdiagnostics-show-location=once -z execstack"
  #define LD_FLAGS "-rdynamic -L./src/lib -lvif -lquadmath -lm"
#endif
#define OFLAGS "-O2"

enum {NOTYPE, ETYPE, INTEGER, LOGICAL, REAL, COMPLEX, CHARACTER};
enum {UNFORMATTED = 1, STDFORMAT, FORMATTED };
enum {SOURCE = 0, TEMP, MACRO };
enum {HEADER = 0, BANNER, LIST, MESSAGES, JCL, SYMBOLS, CONSTANTS, STRINGS, PARAMETERS, TYPEDEF, FREQ, COMMON, PROTOTYPE, STAT, TITLE, PRE, DECL, REFDECL, EQUIV, FMT, DATA, NESTED, BODY, POST, MAXPHA };
enum {EXPR_OTHER = 0, EXPR_VAR, EXPR_CONST, EXPR_SLICE, EXPR_SUBSTR };
enum {LEXEME = 0, DECLAR, WORD, LABEL, INT_NUMBER, FLT_NUMBER, TEXT };
enum {STATIC = 0, AUTOMATIC };

// Shorthands to improve code legibility.

#define int_2 int16_t
#define int_4 int32_t
#define int_8 int64_t

#define unt_2 uint16_t
#define unt_4 uint32_t
#define unt_8 uint64_t
#define unt_16 unsigned __int128

#define logical_4 unsigned

#define real_4 float
#define real_8 double
#define real_16 __float128

#define complex_8 float complex
#define complex_16 double complex
#define complex_32 __complex128

// MAX_STRLEN = 2 ** MAX_STRLENS - 1
#define MAX_STRLEN 4095
#define MAX_STRLENS 12
extern int_4 strlens[MAX_STRLENS];

#define ERR (-32)
#define SKIP // 
#define TRUE 1
#define FALSE 0
#define MAX_LRECL 32760
#define MAX_MACRO_DEPTH 25
#define MAX_NEST 9
#define INCREMENT 500
#define INDENT 2
#define LINES_PER_PAGE 50
#define LINE_WIDTH 122
#define MAX_ARGS 16
#define MAX_COMMONS 100
#define MAX_DIMS 6
#define MAX_IDENTS 1000
#define MAX_LABELS 1000
#define MAX_MODULES 5000
#define MAX_PRIO 9
#define MAX_ERROR 5
#define MAX_WARNS MAX_ERROR
#define RETURN "goto _l0;\n"
#define M_LOG10_2 0.30102999566398119521373889472449q

#define NOT_LOCAL(idf) ((idf)->common != LOCAL)
#define LOCAL 0
#define EXTERN 1

#define WITHIN (curret != END_OF_LINE && curret != END_OF_MODULE)

#define NOT_ASSIGNMENT 0
#define MACRO_DECLARATION 1
#define ASSIGNMENT 2

#define IS_NOT_ASSIGNMENT (statement_type () == NOT_ASSIGNMENT)
#define IS_MACRO_DECLARATION (statement_type () == MACRO_DECLARATION)
#define IS_ASSIGNMENT (statement_type () == ASSIGNMENT)

#define END_OF_MODULE (-3)
#define END_OF_LINE (-2)
#define EXPECT_NONE (NULL)
#define START_OF_LINE (-1)
#define ARG TRUE
#define NOARG FALSE
#define CONST TRUE
#define NOCONST FALSE
#define FUN TRUE
#define NOFUN FALSE
#define UNIQ TRUE
#define NOUNIQ FALSE
#define NOPATCH 0
#define NOTYPE 0
#define NOLEN 0
#define FORMAL TRUE
#define ACTUAL FALSE
#define CAST TRUE
#define NOCAST FALSE
#define PROTEST TRUE
#define QUIET FALSE

#define EXPECT_LABEL "label"
#define INTERNAL_CONSISTENCY "internal consistency"

#define ABS(n) ((n) > 0 ? (n) : -(n))
#define MAXIMISE(u, v) ((u) = _max (u, v))
#define MINIMISE(u, v) ((u) = _min (u, v)) 

#define IS_JCL(c) (c == '/' || CUR_LIN.jcl)
#define IS_COMMENT(c) (strchr ("cd*!#", tolower (c)) != NULL || IS_JCL (c))
#define IS_VAR(n) (isalpha(n[0]) || n[0] == '_' || n[0] == '$')
#define _EXPCHAR(n) (tolower (n) != '\0' && strchr ("edqx", tolower (n)) != NULL)
#define _IDFCHAR(n) (tolower (n) != '\0' && strchr ("abcdefghijklmnopqrstuvwxyz0123456789_ $", tolower (n)) != NULL)
#define CUR_LIN (source[curlin])
#define POS(n) (tolower (CUR_LIN.text[n]))
#define EXPONENT(n) _EXPCHAR (POS (n))
#define CUR_COL (POS (curcol)) 

#define UNSCAN {curlin = prelin; curcol = precol; strcpy (curlex, prelex); curret = preret;}

#define SAVE_POS(n)\
  int_4 _cl_##n= curlin, _cc_##n= curcol;\
  int_4 _pl_##n= prelin, _pc_##n= precol;\
  int_4 _pr_##n= preret, _cr_##n= curret;\
  NEW_RECORD (_clr_##n); RECCPY (_clr_##n, curlex);\
  NEW_RECORD (_cpr_##n); RECCPY (_cpr_##n, prelex);

#define RESTORE_POS(n) {\
  curlin = _cl_##n;\
  curcol = _cc_##n;\
  prelin = _pl_##n;\
  precol = _pc_##n;\
  preret = _pr_##n;\
  curret = _cr_##n;\
  RECCPY (curlex, _clr_##n);\
  RECCPY (prelex, _cpr_##n);\
}

#define MSG(sev, num, text, info)\
  if (prelin < 1) {\
    message (&source[curlin], curcol, (sev), (num), (text), (info));\
  } else {\
    message (&source[prelin], precol, (sev), (num), (text), (info));\
  }

extern int_4 _srecordf (char *, const char *, ...);
extern void _vif_backtr(int_4);

#define ERROR(num, s, t) {MSG ("error", (num), (s), (t));}
#define MODE_ERROR(num, s, t) {\
  RECORD _txt_;\
  _srecordf(_txt_, "%s to %s", (s), (t));\
  ERROR (num, "cannot convert", _txt_);\
  }
#define PRECISION_LOSS(num, s, t) {\
  RECORD _txt_;\
  _srecordf(_txt_, "%s to %s", (s), (t));\
  WARNING (num, "possible precision loss", _txt_);\
  }
#define SYNTAX(num, s) {ERROR ((num), "syntax", (s));}
#define EXPECT(num, s) {ERROR ((num), "expected", (s));}
#define ADJACENT(num, s) {ERROR ((num), "adjacent", (s));}
#define WARNING(num, s, t) {MSG ("warning", (num), (s), (t));}
#define ECHO(num, s, t) {MSG ("info", (num), (s), (t));}
#define SCANER(num, s, t) {MSG ("fatal", (num), (s), (t)); exit (EXIT_FAILURE);}
#define FATAL(num, s, t) {message (NULL, ERR, "fatal", (num), (s), (t)); exit (EXIT_FAILURE);}
#define OVERFLOW(num, t) {fprintf (stderr, "\n** exception  ** f%d: fatal: overflow, (%s)\n", (num), (t)); _vif_backtr (SIGTERM);}

#define TOKEN(s) EQUAL (curlex, (s))
#define CHECKPOINT(num, s) {if (!EQUAL (curlex, (s))) {EXPECT ((num), (s));}}
#define CHECKDIGIT(num, s) {if (!isdigit (s)) {EXPECT ((num), "digit");}}
#define IS_NUMBER(u) ((u) == INT_NUMBER || (u) == FLT_NUMBER)

#define FMT_TEXT ((char *) 1)
#define FMT_INT ((char *) 2)
#define FMT_REAL ((char *) 3)
#define FMT_LOGICAL ((char *) 4)
#define FMT_CHAR ((char *) 5)
#define FMT_TERM ((char *) 6)
extern int_4 __scale__;

// REAL*32

#define FLT128_LEN 7                   // Do NOT change this!
#define FLT256_LEN 15                  // Do NOT change this!
#define FLT256_GUARD 2                 // Guard digits.
#define FLT256_DIG (72 - FLT256_GUARD) // 240 * log10 (2) minus guard digits.

typedef unt_2 REAL16[8];
typedef unt_2 REAL32[FLT256_LEN + 1]; // One for exponent.

struct __real_32__
{
  REAL32 value;
};
typedef struct __real_32__ real_32;

struct __complex_64__
{
  struct __real_32__ re, im;
};
typedef struct __complex_64__ complex_64;

#define xsub(a, b) xadd (a, b, 1)
#define xsum(a, b) xadd (a, b, 0)

// In Fortran, only EQUIVALENCE can alias names.

#define _p_ * restrict

//

#define RECLN 2048
typedef char RECORD[RECLN + 1]; 
#define RECCLR(z) memset ((z), '\0', RECLN + 1)
#define RECCPY(dst, src) bufcpy (dst, src, RECLN);
#define NEW_RECORD(z) RECORD z; RECCLR(z)
#define NEW_STATIC_RECORD(z) static RECORD z; RECCLR(z)

typedef struct FTNFILE FTNFILE;
struct FTNFILE {
  FILE *unit;
  char *name, *form, *action, *disp, *buff, *rewind;
  int_4 lrecl, vers, in_stream, record, records, redirect, buff_init, buff_pos, buff_len, memopen_len;
};

#define NEW_FTN_FILE(fp, fmt, act, recl)\
  ((FTNFILE) {.unit = fp, .form = fmt, .action = act, .lrecl = recl, .in_stream = FALSE})

#define MAX_SOURCE_FILES 1500

// MAX_FILES should be 100.
#define MAX_FILES 100

extern FTNFILE _ffile[MAX_FILES];

typedef struct CALLS CALLS;
struct CALLS {
  char *name;
  int_8 calls;
};

typedef struct C_SRC C_SRC;
struct C_SRC
{
  int_4 proc, phase;
  char *text;
};
extern C_SRC *object;

typedef struct FTN_LINE FTN_LINE;
struct FTN_LINE
{
  FTN_LINE *file;
  int_4 num, isn, len, label, jcl, diag, proc, cpp;
  char *text;
};
extern FTN_LINE *source, *files;
extern int_4 MAX_FTN_LINES;

typedef struct MODE MODE;
struct MODE
{
  int_4 type, len, dim, save, fun;
};

#define PLAIN_MODE(t, l) ((MODE) {.type = type, .len = len, .dim = 0, .fun = FALSE})
#define TYPE(z, t, l) ((z)->mode.type == t && (z)->mode.len == l)
#define IS_ROW(m) ((m).dim > 0)
#define IS_SCALAR(m) ((m).dim == 0)

typedef struct IDENT IDENT;
struct IDENT
{
  char *name, *var_name, *parm;
  int_4 arg, call, common, const_ref, external, intrinsic, line, macro, nest, save, source, used, variable; 
  IDENT *alias, *equiv;
  MODE mode;
  int_4 patch1, patch2;
  char *lwb[MAX_DIMS], *upb[MAX_DIMS], *len[MAX_DIMS];
  char *size;
};
#define C_NAME(z) ((z)->name)
#define F_NAME(z) ((z)->var_name)

typedef struct IMPLICIT IMPLICIT;
struct IMPLICIT
{
  MODE mode;
};

typedef struct LBL LBL;
struct LBL
{
  int_4 index, num, line, jumped, patch, nonexe, data, format, renum;
};
extern LBL *lbl;

typedef struct EXPR EXPR;
struct EXPR
{
  RECORD str, elem;
  int_4 variant, value, opt;
  IDENT *idf;
  MODE mode;
};

typedef struct INTRINS INTRINS;
struct INTRINS
{
  char *ffun, *bfun, *cfun;
  int_4 rtyp, rlen, alen;
  int_4 anum, atyp;
  real_32 (*f1) (real_32);
  real_32 (*f2) (real_32, real_32);
  complex_64 (*f3) (complex_64);
};

extern char *action_default;
extern char *action_read;
extern char *action_readwrite;
extern char *action_write;
extern char *commons[], *modules[];
extern char *disp_delete;
extern char *disp_keep;
extern char *disp_new;
extern char *disp_old;
extern char *form_formatted;
extern char *form_unformatted;

extern IDENT globals[], locals[];

extern IMPLICIT implic[];

extern int_4 curlin, curcol;
extern int_4 curret, preret;
extern int_4 end_statements;
extern int_4 indent;
extern int_4 jcllin;
extern int_4 lhs_factor;
extern int_4 macro_depth;
extern int_4 macro_nest;
extern int_4 MAX_C_SRC;
extern int_4 MAX_C_SRC;
extern int_4 MAX_FTN_LINES;
extern int_4 n_c_src;
extern int_4 nerrors, merrors, nwarns;
extern int_4 nloctmps, nglobtmps, func;
extern int_4 optimise;
extern int_4 page, line, ncommons, nmodules;
extern int_4 pnprocs, nprocs, nglobals, nlocals, nlabels, nftnlines, nfiles;
extern int_4 prelin, precol;

extern LBL labels[];

extern logical_4 abend;
extern logical_4 brief;
extern logical_4 use_strcasecmp;
extern logical_4 compile_only;
extern logical_4 f4_do_loops;
extern logical_4 gcc_ftn_lines;
extern logical_4 hollerith;
extern logical_4 implicit_r8;
extern logical_4 keep;
extern logical_4 no_warnings;
extern logical_4 pretty;
extern logical_4 quiet_mode;
extern logical_4 renum;
extern logical_4 tidy;
extern logical_4 syntax_only;
extern logical_4 trace;

extern RECORD curlex, prelex;
extern RECORD hdate;
extern RECORD hmodule, hsection;
extern RECORD libnam, modnam, procnam;
extern RECORD program, block;
extern RECORD retnam;
extern RECORD stat_start;

extern char *bufcat (char *, char *, int_4);
extern char *bufcpy (char *, char *, int_4);
extern char *bufrep (char *, char *);
extern char *_bufsub (char *, char *, int_4, int_4);
extern char *c_name (char *);
extern char *concat (char *, char *, char *);
extern char *edit_f (char *);
extern char *edit_fmt (int_4);
extern char *edit_i (char *);
extern char *edit_tmp (int_4);
extern char *edit_unit (int_4);
extern char *edit_v (char *);
extern char *edit_vn (char *, int_4);
extern char *encode (char *, char *);
extern char *f2c_type (char *, MODE *, int_4, int_4);
extern char *f_strallocat (char *, char *);
extern char *f_stralloc (char *);
extern char *get_uniq_str (char *, char *);
extern char *idf_full_c_name (RECORD, IDENT *);
extern char *intnot (char *, int_8, int_4);
extern char *newpage (char *, char *);
extern char *pretty_float (char *);
extern char *ptr_to_array (IDENT *, int_4, int_4, int_4);
extern char *qtype (MODE *);
extern char *_strlower (char *);
extern char *wtype (MODE *, int_4, int_4);
extern char *xfixed (char *, real_32, int_4, int_4, int_4);
extern char *xfloat (char *, real_32, int_4, int_4, int_4, int_4, int_4, char);
extern char *xsubfixed (char *, real_32, logical_4, int_4);
extern char *xtoa (char *, real_32, int_4);

extern IDENT *add_local (char *, int_4, int_4, int_4, int_4, int_4, int_4, int_4);
extern IDENT *add_nest (char *, int_4, MODE *);
extern IDENT *extf_decl (char *, MODE *);
extern IDENT *find_local (char *, MODE *);
extern IDENT *impl_decl (char *, MODE *);
extern IDENT *void_decl (char *, MODE *);

extern int_4 add_block (char *);
extern int_4 code (int_4, int_4, char *);
extern int_4 code_real_32_const (char *);
extern int_4 code_uniq_str (char *);
extern int_4 format_str (char *str);
extern int_4 impl_do (void);
extern int_4 mix_len (EXPR *, EXPR *);
extern int_4 new_charlen (int_4);
extern int_4 ord (char);
extern int_4 patch (int_4, char *);
extern int_4 scan (char *);
extern int_4 scan_fmt (void);
extern int_4 scan_fmt (void);
extern int_4 statement_type (void);

extern LBL *find_label (char *);

extern logical_4 accept_mode (int_4, int_4, int_4, int_4);
extern logical_4 coerce (EXPR *, EXPR *);
extern logical_4 express (EXPR *, int_4, int_4);
extern logical_4 find_module (char *);
extern logical_4 fold_expr (EXPR *, int_4);
extern logical_4 fold_intrinsic (INTRINS *, EXPR *, EXPR *);
extern logical_4 intrinsic_call (char *, EXPR *);
extern logical_4 is_intrins (char *, INTRINS **);
extern logical_4 is_int4 (char *, int_4 *);
extern logical_4 is_macro_decl (char *);
extern logical_4 is_specific (char *);
extern logical_4 lookahead (char *);
extern logical_4 reserved (char *);
extern logical_4 same_name (char *, char *);
extern logical_4 valid_expr (EXPR *);

extern void assign (EXPR *);
extern void banner (int_4, int_4, char *);
extern void call (void);
extern void code_comment (void);
extern void code_common (void);
extern void code_exts (IDENT *, int_4, int_4, int_4, int_4);
extern void code_idfs (IDENT *, int_4, int_4, int_4, int_4);
extern void code_index (RECORD, IDENT *, int_4);
extern void code_parms (RECORD);
extern void code_row_len (IDENT *);
extern void common (void);
extern void common (void);
extern void compute_row_size (RECORD, IDENT *);
extern void cpp_direct (int_4, int_4, int_4);
extern void decl_autosave (void);
extern void decl_data (void);
extern void decl_equiv (void);
extern void decl_macros (void);
extern void default_impl (void);
extern void diagnostic (int_4, char *);
extern void dimension (void);
extern void do_data (int_4 *);
extern void do_io (char *, int_4 *);
extern void equivalence (void);
extern void executable (void);
extern void exprio (EXPR *, int_4, logical_4);
extern void externals (void);
extern void factor (EXPR *);
extern void factor_function_call (EXPR *, RECORD);
extern void factor_integer_number (EXPR *, char *);
extern void factor_slice_char (EXPR *, IDENT *);
extern void factor_slice (EXPR *, IDENT *);
extern void factor_variable (EXPR *, IDENT *, MODE *, RECORD);
extern void *f_malloc (size_t);
extern void fold_int_4 (char *, char *);
extern void format (LBL *);
extern void *f_realloc (void *, size_t);
extern void compile_nested_intrinsic (char *);
extern void gen_statements (LBL *, int_4);
extern void get_decls (void);
extern void get_dims (IDENT *, int_4);
extern void get_impl (void);
extern void get_source (char *, int_4);
extern void idfs_impl (void);
extern void idfs_unused (void);
extern void implicit (void);
extern void impl_type (char *, MODE *);
extern void inline_args (RECORD *, int_4 *);
extern void intrinsics (void);
extern void jump (void);
extern void macro (EXPR *, IDENT *);
extern void merge_commons (void);
extern void message (FTN_LINE *, int_4, char *, int_4, char *, char *);
extern void norm_mode (MODE *);
extern void option (char *);
extern void parameter (void);
extern void patch_args (void);
extern void patch_args (void);
extern void proc_listing (int_4);
extern void recursion (EXPR *, RECORD, IDENT *);
extern void tidy_source (char *);
extern void RTE (const char *, const char *);
extern void RTW (const char *, const char *);
extern void scan_modules (void);
extern void skip_card (int_4);
extern void subprograms (void);
extern void vif_backspace (void);
extern void vif_close (void);
extern void vif_endfile (void);
extern void vif_jcl (void);
extern void vif_open (void);
extern void vif_rewind (void);
extern void write_object (char *);
extern void write_tidy (char *);

// ++++ MACROS

#define ln(x) log(x)

static inline logical_4 EQUAL (char *s, char *t)
{
  if (s == NULL || t == NULL) {
    return s == t;
  } else {
    return strcasecmp (s, t) == 0;
  }
}

static inline logical_4 MATCH (char *t)
{
  if (EQUAL (curlex, t)) {
    return TRUE;
  } else {
    NEW_RECORD (str);
    _srecordf (str, "\"%s\"", t); // Stringize t
    return EQUAL (curlex, str);
  } 
}

static logical_4 LEQUAL (char *s, char *t)
{
  if (s == NULL || t == NULL) {
    return s == t;
  } else {
    return strncasecmp (s, t, strlen (s)) == 0;
  }
}

static inline void BUG (char *s)
{
  fprintf (stderr, "%d %s\n", curlin, source[curlin].text);
  message (NULL, ERR, "fatal", 4001, "compiler bug", (s));
  exit (EXIT_FAILURE);
}

#define _write_err(rc, funit, action)\
  fflush (_ffile[(funit)].unit);\
  if ((rc) < 1 || ferror (_ffile[(funit)].unit)) {\
    action;\
  }

#define _read_err(rc, funit, action_end, action_err)\
  if (feof (_ffile[(funit)].unit)) {\
    action_end;\
  }\
  if ((rc) < 1 || ferror (_ffile[(funit)].unit)) {\
    action_err;\
  }

#define _write_eol(funit) {\
  (void) _vif_printf ((funit), "\n", NULL, NOTYPE, 0);\
  fflush (_ffile[(funit)].unit);\
  }

#define _read_eol(funit) {\
  (void) _vif_scanf ((funit), NULL, NULL, NOTYPE, 0);\
  }

#define _abs(a) ({__typeof__ (a) _u = (a); _u >= 0 ? _u : -_u;})
#define _dim_(a, b) ({__typeof__ (a) _a = (a); __typeof__ (b) _b = (b); _a > _b ? _a - _b : 0;})
#define _max(a, b) ({__typeof__ (a) _a = (a); __typeof__ (b) _b = (b); _a > _b ? _a : _b;})
#define _min(a, b) ({__typeof__ (a) _a = (a); __typeof__ (b) _b = (b); _a < _b ? _a : _b;})
#define _imod(a, b) ({__typeof__ (a) _a = (a), _b = (b), _q = (__typeof__ (a)) (_a / _b); (_a - _q * _b);})
#define _sign(a, b) ({__typeof__ (a) _a = _abs (a); b >= 0 ? _a : -_a;})

#define _ichar(s) ((int_4) ((s)[0]))

// AINT
static inline real_4 _aintf (real_4 x) {return truncf (x);}
static inline real_8 _aintd (real_8 x) {return trunc (x);}
static inline real_16 _aintq (real_16 x) {return truncq (x);}

// NINT
static inline int_4 _nintf (real_4 x) {return (int_4) (x) >= 0.0 ? floorf (x + 0.5) : -floorf (0.5 - x);}
static inline int_4 _nintd (real_8 x) {return (int_4) (x >= 0.0 ? floor (x + 0.5) : -floor (0.5 - x));}
static inline int_4 _nintq (real_16 x) {return (int_4) (x >= 0.0q ? floorq (x + 0.5q) : -floorq (0.5q - x));}

// ANINT
static inline real_4 _anintf (real_4 x) {return (x) >= 0.0 ? floorf (x + 0.5) : -floorf (0.5 - x);}
static inline real_8 _anintd (real_8 x) {return (x >= 0.0 ? floor (x + 0.5) : -floor (0.5 - x));}
static inline real_16 _anintq (real_8 x) {return (x >= 0.0q ? floor (x + 0.5q) : -floor (0.5q - x));}

// COMPLEX*32

static inline complex_32 CMPLXQ (real_16 re, real_16 im) {complex_32 z; __real__ z = re; __imag__ z = im; return z;}
extern complex_32 qxcmplx (real_32, real_32);

// COMPLEX*64

#define CMPLXX(re, im) (complex_64){re, im}
#define CMPLXZ(re) (complex_64){re, X_0}

// RTS

extern char *_char (int);
extern char *__strtok_r (char *, const char *, char **);
extern char *_strupper (char *);
extern char **_vif_jit (char *, char *);

extern void _pi4 (real_4 *);
extern void _pi8 (real_8 *);
extern void _pi16 (real_16 *);
extern void _pi32 (real_32 *);

extern complex_16 _dcmplxq (complex_32);
extern complex_16 _up_complex (complex_16, int_4);

extern complex_32 _qcmplxd (complex_16);
extern complex_32 _up_complex_32 (complex_32, int_4);

extern complex_8 _cmplxd (complex_16);
extern complex_8 _up_complex_8 (complex_8, int_4);

extern int_4 _backspace (char *, int_4);
extern int_4 _i1mach (int_4 *);
extern int_4 _index (char *, char *);
extern int_4 _init_file_buffer (int_4);
extern int_4 _rewind (char *, int_4);
extern int_4 _set_record (char *, int_4, int_4);
extern int_4 _sys (char *, char *, char *, const char *, ...);
extern int_4 _str_to_int4 (char *);
extern int_4 _up_int_4 (int_4, int_4);
extern int_4 _vif_printf (int_4, char *, void *, int_4, int_4);
extern int_4 _vif_scanf (int_4, char *, void *, int_4, int_4);
extern int_4 _xerclr (void);
extern int_4 _xermsg (char *, char *, char *, int_4 *, int_4 *);
extern int_4 _xgetf (int_4 *);
extern int_4 _xint4 (real_32);
extern int_4 _xsetf (int_4 *);

extern int_8 _up_int_8 (int_8, int_4);
extern int_8 _xint8 (real_32);
extern int_8 _xnint8 (real_32);

extern real_16 acotanq (real_16);
extern real_16 cotanq (real_16);
extern real_16 _qext (real_8);
extern real_16 _up_real_16 (real_16, int_4);
extern real_16 _strtoquad (char *, char **);
extern real_16 xtoquad (real_32);
extern real_16 _zabs_32 (real_16 re, real_16 im);
extern real_16 cximagq (complex_64);
extern real_16 cxrealq (complex_64);

extern real_32 _quadtop (real_32 *, real_16);
extern real_32 quadtox (real_16);
extern real_32 _xerf (real_32);
extern real_32 _aintx (real_32);
extern real_32 _xI (real_32);
extern real_32 _xmod (real_32, real_32);
extern real_32 _xdimx (real_32, real_32);
extern real_32 _anintx (real_32);
extern real_32 _zabs_64 (real_32 re, real_32 im);

extern real_4 acotanf (real_4);
extern real_4 cotanf (real_4);
extern real_4 _up_real_4 (real_4, int_4);
extern real_4 _zabs_8 (real_4 re, real_4 im);

extern real_8 acotan (real_8);
extern real_8 cotan (real_8);
extern real_8 _drand48 (void);
extern real_8 _seconds (void);
extern real_8 _str_to_real8 (char *);
extern real_8 _up_real_8 (real_8, int_4);
extern real_8 _zabs_16 (real_8 re, real_8 im);

extern void _cputim (real_8 *);
extern void _cputyd (int_4 *);
extern void _fcheck (char *, int_4, char *, char *);
extern void _fclose (int_4);
extern void _fprintf_real_32 (char *, char *, real_32, int_4, int_4);
extern void _fregister (char *, int_4, int_4, char *, char *, char *, char *);
extern void _funregister (char *, int_4);
extern void _ioend_read (char *, int_4);
extern void _ioerr (char *, int_4);
extern void _ioerr_read (char *, int_4);
extern void _ioerr_write (char *, int_4);
extern void _merfi (real_8 *, real_8 *, int_4 *);
extern void _qhex (real_16 *);
extern void _skip_eol (FILE *);
extern void _srand48 (int_4 *);
extern void _vif_exit (void);
extern void _vif_freq (CALLS *);
extern void _vif_init (void);
extern void _xhex (real_32 *);

extern complex_64 _coctotop (complex_64 *, real_32);
extern complex_64 _cquadtop (complex_64 *, complex_32);
extern complex_64 cxcos (complex_64);
extern complex_64 cxflt(complex_8);
extern complex_64 cxdbl(complex_16);
extern complex_64 cxdiv (complex_64, complex_64);
extern complex_64 cxexp (complex_64);
extern complex_64 cxlog (complex_64);
extern complex_64 cxmul (complex_64, complex_64);
extern complex_64 cxneg (complex_64);
extern complex_64 cxquad(complex_32);
extern complex_64 cxreal32(real_32);
extern complex_64 cxsin (complex_64);
extern complex_64 cxsqrt (complex_64);
extern complex_64 cxsub (complex_64, complex_64);
extern complex_64 cxsum (complex_64, complex_64);
extern complex_64 cxtan (complex_64);

extern int_4 xsgn (const real_32 *);

extern logical_4 xeq (real_32, real_32); 
extern logical_4 xge (real_32, real_32); 
extern logical_4 xgt (real_32, real_32);  
extern logical_4 xis0 (const real_32 *);
extern logical_4 xis_minf (const real_32 *);
extern logical_4 xis_nan (const real_32 *);
extern logical_4 xis_pinf (const real_32 *);
extern logical_4 xle (real_32, real_32);  
extern logical_4 xlt (real_32, real_32);
extern logical_4 xneq (real_32, real_32);
extern logical_4 xnot0 (const real_32 *);

extern real_32 atox (char *);
extern real_32 cximag (complex_64);
extern real_32 cxreal (complex_64);
extern real_32 dbltox (real_8);
extern real_32 flttox (real_4);
extern real_32 inttox (int_4);
extern real_32 strtox (char *, char **);
extern real_32 xabs (real_32);
extern real_32 xacosh (real_32);
extern real_32 xacos (real_32);
extern real_32 xacotan (real_32);
extern real_32 xadd (real_32, real_32, int_4);
extern real_32 xasinh (real_32);
extern real_32 xasin (real_32);
extern real_32 xatan2 (real_32, real_32);
extern real_32 xatanh (real_32);
extern real_32 xatan (real_32);
extern real_32 xcosh (real_32);
extern real_32 xcos (real_32);
extern real_32 xcotan (real_32);
extern real_32 xdiv (real_32, real_32);
extern real_32 xexp (real_32);
extern real_32 _xhypot (real_32, real_32);
extern real_32 xfrac (real_32);
extern real_32 xlog10 (real_32);
extern real_32 xlog (real_32);
extern real_32 xmul (real_32, real_32);
extern real_32 xneg (real_32);
extern real_32 xpwr (real_32, int_4);
extern real_32 xround (real_32);
extern real_32 xsfmod (real_32, int_4 *);
extern real_32 xsinh (real_32);
extern real_32 xsin (real_32);
extern real_32 xsqrt (real_32);
extern real_32 xtanh (real_32);
extern real_32 xtan (real_32);
extern real_32 xtenup (int_4);
extern real_32 xtrunc (real_32);
extern real_4 xtoflt (real_32);
extern real_8 xtodbl (real_32);

// SLATEC message handling routines.

extern int_4 _j4save (int_4 _p_, int_4 _p_, logical_4 _p_);
extern int_4 _xerabt (char _p_, int_4 *);
extern int_4 _xerbla (char _p_, int_4 _p_);
extern int_4 _xerclr (void);
extern int_4 _xerdmp (void);
extern int_4 _xermax (int_4 _p_);
extern int_4 _xermsg (char _p_, char _p_, char _p_, int_4 _p_, int_4 _p_);
extern int_4 _xerprn (char _p_, int_4 _p_, char _p_, int_4 _p_);
extern int_4 _xersve (char _p_, char _p_, char _p_, int_4 _p_, int_4 _p_, int_4 _p_, int_4 _p_);
extern int_4 _xgetf (int_4 _p_);
extern int_4 _xgetua (int_4 _p_, int_4 _p_);
extern int_4 _xgetun (int_4 _p_);
extern int_4 _xsetf (int_4 _p_);
extern int_4 _xsetua (int_4 _p_, int_4 _p_);
extern int_4 _xsetun (int_4 _p_);

#endif
