Initial commit.

1 files changed, 1666 insertions, 0 deletions

diff --git a/edc.c b/edc.c
new file mode 100644
index 0000000..6207874
--- /dev/null
+++ b/edc.c
@@ -0,0 +1,1666 @@
+#include "real.h"
+#include <gmp.h>
+#include <stdio.h>
+#include <stdbool.h>
+#include <string.h>
+#include <math.h>
+#include <setjmp.h>
+#include <stdint.h>
+#include <errno.h>
+#include <argp.h>
+
+#define MAX_INPUT_LEN 80
+#define STACK_SIZE 120
+
+// Placeholder functions to stave off warnings from macros
+// TODO: raise error if these are ever called.
+static inline Real mod_R_R(Real _, Real __) { ++_; return __; }
+static inline Real mod_R_Int(Real _, int __) { ++__; return _; }
+static inline Real mod_Int_R(int _, Real __) { ++_; return __; }
+static inline Real add_Int_R(int _, Real __) { ++_; return __; }
+static inline Real mul_Int_R(int _, Real __) { ++_; return __; }
+/* static inline Real add_Int_R(int _, Real __) { while(false) {++_; return __; }} */
+// Saves the state for error handling.
+jmp_buf env;
+// Error types
+#define BAD_COMMAND 1
+#define UNDERFLOW 2
+#define UNDERFLOW_REG 3
+#define OVERFLOW 4
+#define OVERFLOW_REG 5
+#define BAD_VALUE 6
+#define EXIT 7
+
+// Cells are what live on the stack and in registers.
+// They abstract over the underlying number type.
+typedef enum {
+  REAL = 1,
+  STRING = 2,
+  INTEGER = 3,
+  NATIVE = 4,
+} CellType;
+
+
+typedef struct {
+  int reference_count;
+  char register_in;
+  int register_location;
+  CellType type;
+  union {
+    Real r;
+    char *s;
+    mpz_t z;
+    int n;
+  };
+} StackCell;
+
+// Main stack.
+StackCell calc_stack[STACK_SIZE];
+int stack_top = -1;
+
+// Register stacks.
+StackCell registers[256][STACK_SIZE];
+int register_tops[256] = {0};
+
+// Global parameters.
+// The precision is a display precision: the numbers are lazily computed, but conceptually infinite.
+int precision = 10;
+
+// Alternative bases greater than 10 have additional digits given by uppercase letters A-F.
+// This agrees with both GMP and C's reading conventions; restricting to uppercase avoids collision with dc commands.
+// The maximum radix is accordingly 16 (minimum of course 2).
+int input_radix = 10;
+int output_radix = 10;
+
+// Functions to interact with the stack.
+// They are specialized according to cell type, so that errors can be caught early.
+// Most errors just print info about them and reset the parser (via longjmp).
+static inline void push(StackCell c) {
+  if (stack_top == STACK_SIZE - 1) {
+    longjmp(env, OVERFLOW);
+  }
+
+  ++stack_top;
+  calc_stack[stack_top] = c;
+
+}
+
+
+
+static inline void pushr(Real x) {
+  if (stack_top == STACK_SIZE - 1) {
+    longjmp(env, OVERFLOW);
+  }
+
+  ++stack_top;
+  StackCell new = {.type = REAL, .r = x, .register_location = -1};
+  calc_stack[stack_top] = new;
+
+}
+
+static inline void pushs(const char *string) { // NOTE: string passed in gets strdup'ed.
+  if (stack_top == STACK_SIZE - 1) {
+    longjmp(env, OVERFLOW);
+  }
+
+  ++stack_top;
+  char *persistent = strdup(string);
+  StackCell new = {.type = STRING, .s = persistent, .reference_count = 1, .register_location = -1};
+  calc_stack[stack_top] = new;
+
+}
+
+static inline void pushz(mpz_t integer) {
+  if (stack_top == STACK_SIZE - 1) {
+    longjmp(env, OVERFLOW);
+  }
+
+  ++stack_top;
+  StackCell new = {.type = INTEGER, .reference_count = 1, .register_location = -1};
+  mpz_init(new.z);
+  mpz_set(new.z, integer);
+  calc_stack[stack_top] = new;
+
+}
+
+static inline void pushn(int native) {
+  if (stack_top == STACK_SIZE - 1) {
+    longjmp(env, OVERFLOW);
+  }
+
+  ++stack_top;
+  StackCell new = {.type = NATIVE, .n = native, .register_location = -1};
+  calc_stack[stack_top] = new;
+
+}
+
+
+static inline StackCell pop(void) {
+  if (stack_top < 0) {
+    longjmp(env, UNDERFLOW);
+  }
+
+  --stack_top;
+  return calc_stack[stack_top + 1];
+
+}
+
+
+static inline Real popr(void) {
+  if (stack_top < 0) {
+    longjmp(env, UNDERFLOW);
+  }
+
+  StackCell top = calc_stack[stack_top];
+
+  if (top.type != REAL) {
+    longjmp(env, BAD_VALUE);
+  }
+
+
+  --stack_top;
+  return top.r;
+}
+
+
+static inline int popn(int min, int max) {
+  if (stack_top < 0) {
+    longjmp(env, UNDERFLOW);
+  }
+
+  StackCell top = calc_stack[stack_top];
+
+  if (top.type != NATIVE || top.n < min || top.n > max) {
+    longjmp(env, BAD_VALUE);
+  }
+
+  --stack_top;
+  return top.n;
+}
+
+
+
+static inline StackCell peek(void) {
+  if (stack_top < 0) {
+    longjmp(env, UNDERFLOW);
+  }
+
+  return calc_stack[stack_top];
+}
+
+#define gcz(var) do {							\
+    if (var.register_location > -1)					\
+      if (--registers[(int)var.register_in][(int)var.register_location].reference_count == 0) { \
+	mpz_clear(var.z);						\
+	var.register_location = -1;					\
+      }									\
+  } while (0)
+
+#define gcs(var) do {							\
+    if (var.register_location > -1)					\
+      if (--registers[(int)var.register_in][(int)var.register_location].reference_count == 0) { \
+	free(var.s);							\
+	var.register_location = -1;					\
+      }									\
+  } while (0)
+
+
+static inline void display(StackCell cell) {
+  switch (cell.type) {
+  case REAL:
+    print_R_Dec(cell.r, precision);
+    break;
+  case STRING:
+    printf(cell.s);
+#ifdef DEBUG
+    if (cell.register_location > -1)
+      printf(" reference count: %i", registers[(int)cell.register_in][(int)cell.register_location].reference_count);
+#endif
+    break;
+  case INTEGER:
+    mpz_out_str(stdout, output_radix, cell.z);
+#ifdef DEBUG
+    if (cell.register_location > -1)
+      printf(" reference count: %i", registers[(int)cell.register_in][(int)cell.register_location].reference_count);
+#endif
+    break;
+  case NATIVE: {
+    int n = (cell.n < 0) ? -cell.n : cell.n;
+    char converted[12];
+    char base_digits[16] = {'0', '1', '2', '3', '4', '5', '6', '7',
+			    '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'};
+    int index = 0;
+    while (n) {
+      converted[index] = n % output_radix;
+      n /= output_radix;
+      ++index;
+    }
+
+
+    if (cell.n < 0) {
+      putchar('-');
+    }
+
+    while(--index >= 0) {
+      putchar(base_digits[(int)converted[index]]);
+    }
+  }
+  }
+
+  putchar('\n');
+
+}
+
+static inline void displayf(StackCell cell) { // Freeing display.
+  switch (cell.type) {
+  case REAL:
+    print_R_Dec(cell.r, precision);
+    break;
+  case STRING:
+    printf(cell.s);
+    gcs(cell);
+    break;
+  case INTEGER:
+    mpz_out_str(stdout, output_radix, cell.z);
+    gcz(cell);
+    break;
+  case NATIVE: {
+    int n = (cell.n < 0) ? -cell.n : cell.n;
+    char converted[12];
+    char base_digits[16] = {'0', '1', '2', '3', '4', '5', '6', '7',
+			    '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'};
+    int index = 0;
+    while (n) {
+      converted[index] = n % output_radix;
+      n /= output_radix;
+      ++index;
+    }
+
+
+    if (cell.n < 0) {
+      putchar('-');
+    }
+
+    while(--index >= 0) {
+      putchar(base_digits[(int)converted[index]]);
+    }
+  }
+
+  }
+
+}
+
+typedef enum {
+  START,
+  DIGITS_OR_DECIMAL_OR_VINCULUM,
+  DIGITS,
+  TRIG,
+  HYPERB,
+  TRIG_OR_HYPERB,
+  STORE_REGISTER_NAME,
+  LOAD_REGISTER_NAME,
+  PUSHSTORE_REGISTER_NAME,
+  POPLOAD_REGISTER_NAME,
+  STRING_CONTENTS,
+  GREATER_THAN_REG,
+  LESS_THAN_REG,
+  EQUAL_REG,
+  NOT_CONTENTS,
+  NOT_GREATER_THAN_REG,
+  NOT_LESS_THAN_REG,
+  NOT_EQUAL_REG,
+  WAITING_TARGET_MACRO_DEPTH,
+  COMMENT_CONTENTS,
+  REGISTER_SET_NAME,
+  REGISTER_GET_NAME
+} ParseState;
+
+typedef struct {
+  int macro_depth;
+  unsigned int string_depth;
+  ParseState expecting;
+  char parse_stack[MAX_INPUT_LEN];
+  int stack_top;
+  bool integer;
+  int target_macro_depth;
+  bool inverse;
+} ParseVars;
+
+ParseVars pv = {0, 0, START, {0}, -1, true, 0, false};
+
+static inline void parse_push(char token) {
+  if (pv.stack_top == MAX_INPUT_LEN - 1) {
+    longjmp(env, OVERFLOW);
+  }
+
+  ++pv.stack_top;
+  pv.parse_stack[pv.stack_top] = token;
+}
+
+
+static inline void progress(ParseState next) {
+  pv.expecting = next;
+}
+
+static inline void reset(void) {
+  pv.expecting = START;
+  pv.stack_top = -1;
+  pv.integer = true;
+  pv.inverse = false;
+}
+
+
+// A global variable containing an mpz_t with value 1, so we don't need to constantly initialize it.
+mpz_t one;
+
+// This macro saves us a whole lotta work by abstracting away the patterns in ERA and GMP function names.
+// It's hard on the eyes, but copying out the type dispatching logic almost verbatim four times would be worse.
+// TODO: ensure that operation on ints don't over- or underflow, upgrading otherwise.
+// TODO: think extra hard about memory management with GMP integers and strings.
+// TODO: note reversing the stupid dc ordering.
+// TODO: note the difference from dc: a is only greater than b if it is /provably/ greater than b.
+//       to within the provided extra argument's level of precision.
+//       A is equal to B if it is not provable that they are different within precision.e
+
+#define upgradez(var) do {			\
+    if (var.type == NATIVE) {			\
+      mpz_t upgraded;				\
+      mpz_init(upgraded);			\
+      mpz_set_si(upgraded, var.n);		\
+      mpz_set(var.z, upgraded);			\
+      var.type = INTEGER;			\
+      var.reference_count = 1;			\
+    }						\
+  } while (0)
+
+#define upgrader(var) do {			\
+    if (var.type == INTEGER) {			\
+      mpz_t copy;				\
+      mpz_init_set(copy, var.z);		\
+      if (--var.reference_count == 0)		\
+	mpz_clear(var.z);			\
+      var.r = real_QZ(copy, one);		\
+      var.type = REAL;				\
+      mpz_clear(copy);				\
+    }						\
+  } while (0)
+
+
+#define pair(x, y)  ((x + y - 1) * (x + y - 2) / 2 + y)
+
+// Emacs' syntax highlighting and alignment for interesting macros is janky.
+#define dispatch(op, real_opname, commutative, integer_only, gmp_opname) do { \
+    StackCell b = pop();						\
+    StackCell a = pop();						\
+									\
+    if (integer_only) {							\
+      if (!((a.type == NATIVE || a.type == INTEGER)			\
+	    && (b.type == NATIVE || b.type == INTEGER))) {		\
+	longjmp(env, BAD_VALUE);}}					\
+									\
+									\
+    switch (pair(a.type, b.type)) {					\
+    case pair(NATIVE, NATIVE):						\
+      pushn(a.n op b.n);						\
+      break;								\
+    case pair(NATIVE, INTEGER):						\
+      if (commutative) {						\
+	mpz_t result;							\
+	mpz_init(result);						\
+	mpz_##gmp_opname##_ui(result, b.z, a.n);			\
+	pushz(result);							\
+	gcz(b);								\
+      } else {								\
+	mpz_t upgraded;							\
+	mpz_t result;							\
+	mpz_init(upgraded);						\
+	mpz_init(result);						\
+	mpz_set_si(upgraded, a.n);					\
+	mpz_##gmp_opname(result, upgraded, b.z);			\
+	pushz(result);							\
+	mpz_clear(upgraded);						\
+	gcz(b);								\
+      }									\
+									\
+      break;								\
+    case pair(NATIVE, REAL):						\
+      if (commutative) {						\
+	pushr(real_opname##_R_Int(b.r, a.n));				\
+      } else {								\
+	pushr(real_opname##_Int_R(a.n, b.r));				\
+      }									\
+									\
+      break;								\
+    case pair(INTEGER, NATIVE): {					\
+      mpz_t result;							\
+      mpz_init(result);							\
+      mpz_##real_opname##_ui(result, a.z, b.n);				\
+      pushz(result);							\
+      gcz(a);								\
+      break;								\
+    }									\
+    case pair(INTEGER, INTEGER): {					\
+      mpz_t result;							\
+      mpz_init(result);							\
+      mpz_##gmp_opname(result, a.z, b.z);				\
+      pushz(result);							\
+      gcz(a);								\
+      gcz(b);								\
+      break;								\
+    }									\
+    case pair(INTEGER, REAL):						\
+      pushr(real_opname##_R_R(real_QZ(a.z, one), b.r));			\
+      gcz(a);								\
+      break;								\
+    case pair(REAL, NATIVE):						\
+      pushr(real_opname##_R_Int(a.r, b.n));				\
+      break;								\
+    case pair(REAL, INTEGER):						\
+      pushr(real_opname##_R_R(a.r, real_QZ(b.z, one)));			\
+      gcz(b);								\
+      break;								\
+    case pair(REAL, REAL):						\
+      pushr(real_opname##_R_R(a.r, b.r));				\
+      break;								\
+    default:								\
+      longjmp(env, BAD_VALUE);						\
+    }									\
+  } while (0)
+
+// Ugly, but appreciably fast.
+static inline int count_digits(int n) {
+  if (n < 0) n = (n == INT_MIN) ? INT_MAX : -n;
+  if (n < 10) return 1;
+  if (n < 100) return 2;
+  if (n < 1000) return 3;
+  if (n < 10000) return 4;
+  if (n < 100000) return 5;
+  if (n < 1000000) return 6;
+  if (n < 10000000) return 8;
+  if (n < 100000000) return 9;
+  return 10;
+}
+
+
+#define dispatch_pred(op, op_neg, name, name_neg) do {		\
+    int prec = popn(0, INT_MAX);				\
+    StackCell b = pop();					\
+    StackCell a = pop();					\
+    bool result;						\
+    switch (pair(a.type, b.type)) {				\
+    case pair(NATIVE, NATIVE):					\
+      result = a.n op b.n;					\
+      break;							\
+    case pair(NATIVE, INTEGER):					\
+      result = mpz_cmp_si(b.z, a.n) op_neg 0;			\
+      gcz(b);							\
+      break;							\
+    case pair(INTEGER, NATIVE):					\
+      result = mpz_cmp_si(a.z, b.n) op 0;			\
+      gcz(a);							\
+      break;							\
+    case pair(INTEGER, INTEGER):				\
+      result = mpz_cmp(a.z, b.z) op 0;				\
+      gcz(a);							\
+      gcz(b);							\
+      break;							\
+    case pair(NATIVE, REAL): {					\
+      Bool r_lazy = not_B(name_neg##_R_QInt(b.r, a.n, 1));	\
+      force_B(r_lazy, prec);					\
+      result = boolValue(r_lazy) == LAZY_TRUE;			\
+      break;							\
+    }								\
+    case pair(REAL, NATIVE): {					\
+      Bool r_lazy = name##_R_QInt(b.r, a.n, 1);			\
+      force_B(r_lazy, prec);					\
+								\
+      result = boolValue(r_lazy) == LAZY_TRUE;			\
+      break;							\
+    }								\
+    case pair(INTEGER, REAL):					\
+    case pair(REAL, INTEGER):					\
+    case pair(REAL, REAL): {					\
+      if (a.type == INTEGER) {					\
+	upgrader(a);						\
+      }								\
+      if (b.type == INTEGER) {					\
+	upgrader(b);						\
+      }								\
+      Bool r_lazy = name##_R_R(a.r, b.r);			\
+      force_B(r_lazy, prec);					\
+      result = boolValue(r_lazy) == LAZY_TRUE;			\
+      break;							\
+    }								\
+    default:							\
+      longjmp(env, BAD_VALUE);					\
+      break;							\
+    }								\
+								\
+    reset();							\
+								\
+    if (result) {						\
+      interpret('l');						\
+      interpret(token);						\
+      interpret('x');						\
+    }								\
+  } while(0)
+
+
+#define special_func(name) do {			\
+    StackCell c = pop();			\
+    switch (c.type) {				\
+    case NATIVE:				\
+      pushr(name##_QInt(c.n, 1));		\
+      break;					\
+    case INTEGER:				\
+      pushr(name##_QZ(c.z, one));			\
+      gcz(c);					\
+      break;					\
+    case REAL:					\
+      pushr(name##_R(c.r));			\
+      break;					\
+    case STRING:				\
+      longjmp(env, BAD_VALUE);			\
+      break;					\
+    }						\
+  } while(0)
+
+
+#define invertible_special(name) do {		\
+    StackCell c = pop();			\
+    switch (c.type) {				\
+    case NATIVE:				\
+      if (pv.inverse)				\
+	pushr(a##name##_QInt(c.n, 1));		\
+      else					\
+	pushr(name##_QInt(c.n, 1));		\
+      break;					\
+    case INTEGER:				\
+      if (pv.inverse)				\
+	pushr(a##name##_QZ(c.z, one));		\
+      else					\
+	pushr(name##_QZ(c.z, one));		\
+      gcz(c);					\
+      break;					\
+    case REAL:					\
+      if (pv.inverse)				\
+	pushr(a##name##_R(c.r));		\
+      else					\
+	pushr(a##name##_R(c.r));		\
+      break;					\
+    case STRING:				\
+      longjmp(env, BAD_VALUE);			\
+      break;					\
+    }						\
+  } while(0)
+
+
+
+
+#define execute(command) do {			\
+    for (size_t i = 0; i < strlen(command); i++) { \
+      interpret(command[i]);			\
+    }						\
+  } while(false)
+
+// returns void because we need to handle errors with longjmp anyway.
+void interpret(char token) {
+  // The manpage very helpfully provides definitions of some redundant operators.
+
+  if (token == EOF) {
+    longjmp(env, EXIT);
+  }
+  switch (pv.expecting) {
+  case START:
+    switch (token) {
+      // Number entry.
+    case '_':
+      parse_push('-');
+      progress(DIGITS_OR_DECIMAL_OR_VINCULUM);
+      break;
+    case '0':
+    case '1':
+    case '2':
+    case '3':
+    case '4':
+    case '5':
+    case '6':
+    case '7':
+    case '8':
+    case '9':
+    case 'A':
+    case 'B':
+    case 'C':
+    case 'D':
+    case 'E':
+    case 'F':
+      parse_push(token);
+      progress(DIGITS_OR_DECIMAL_OR_VINCULUM);
+      break;
+
+      // Printing commands.
+    case 'p':
+      if (stack_top >= 0) {
+	display(peek());
+      }
+      break;
+    case 'm':
+      displayf(pop());
+      break;
+    case 'f':
+      for (int i = 0; i <= stack_top; i++) {
+	display(calc_stack[i]);
+      }
+      break;
+
+    case 'N': {// Negation.
+      StackCell a = pop();
+      switch (a.type) {
+      case NATIVE:
+	a.n *= -1;
+	pushn(a.n);
+	break;
+      case INTEGER: {
+	mpz_t result;
+	mpz_init(result);
+	mpz_neg(result, a.z);
+	pushz(result);
+	gcz(a);
+	break;
+      }
+      case REAL:
+	pushr(neg_R(a.r));
+	break;
+      default:
+        longjmp(env, BAD_VALUE);
+      }
+      break;
+    }
+    case 'M': {// Magnitude (absolute value).
+      StackCell a = pop();
+      switch (a.type) {
+      case NATIVE:
+	pushn(abs(a.n));
+	break;
+      case INTEGER:{
+	mpz_t result;
+	mpz_init(result);
+	mpz_abs(result, a.z);
+	pushz(result);
+	gcz(a);
+	break;
+      }
+      case REAL:
+	pushr(abs_R(a.r));
+	break;
+      default:
+	longjmp(env, BAD_VALUE);
+	break;
+      }
+      break;
+    }
+    case '+':
+      dispatch(+, add, true, false, add);
+      break;
+    case '-':
+      dispatch(-, sub, false, false, sub);
+      break;
+    case '*':
+      dispatch(*, mul, true, false, mul);
+      break;
+    case '/':  // Division by (real) zero has to be nonterminating because equality with zero is nonterminating. Otherwise, segfault.
+      dispatch(/, div, false, false, tdiv_q);
+      break;
+    case '%':
+      dispatch(%, mod, false, true, mod);
+      break;
+
+    case '~':
+      execute("SdSn lnld/ LnLd%");
+      break;
+    case '^': { // Has to be different because we must upgrade mixed terms.
+      StackCell b = pop();
+      StackCell a = pop();
+
+      switch (pair(a.type, b.type)) {
+      case pair(NATIVE, NATIVE): {
+	mpz_t result;
+	mpz_init(result);
+	mpz_ui_pow_ui(result, a.n, b.n);
+	pushz(result);
+      }
+	break;
+      case pair(INTEGER, NATIVE):{
+	mpz_t result;
+	mpz_init(result);
+	mpz_pow_ui(result, a.z, b.n);
+	pushz(result);
+	break;
+      }
+      case pair(NATIVE, INTEGER):
+      case pair(INTEGER, INTEGER):
+      case pair(REAL, INTEGER):
+      case pair(INTEGER, REAL):
+      case pair(REAL, REAL):
+	if (a.type == NATIVE)
+	  upgradez(a);
+	if (a.type == INTEGER)
+	  upgrader(a);
+	if (b.type == INTEGER)
+	  upgrader(b);
+	pushr(pow_R_R(a.r, b.r));
+	break;
+      default:
+	longjmp(env, BAD_VALUE);
+	break;
+      }
+      break;
+    }
+    case 'T': {
+      int arity = popn(1, 2);
+      switch (arity) {
+      case 1: {
+	StackCell d = pop();
+	StackCell c = pop();
+	StackCell b = pop();
+	StackCell a = pop();
+	Real x = popr();
+	if (a.type == NATIVE && b.type == NATIVE && c.type == NATIVE && d.type == NATIVE) {
+	  pushr(lft_R_Int(x, a.n, b.n, c.n, d.n));
+	} else {
+	  if (a.type == REAL || b.type == REAL || c.type == REAL || d.type == REAL || \
+	      a.type == STRING || b.type == STRING || c.type == STRING || d.type == STRING)
+	    longjmp(env, BAD_VALUE);
+
+	  upgradez(a); upgradez(b); upgradez(c); upgradez(d);
+	  pushr(lft_R_Z(x, a.z, b.z, c.z, d.z));
+	  gcz(a); gcz(b); gcz(c); gcz(d);
+	}
+
+	break;
+      }
+
+      case 2: {
+	StackCell h = pop();
+	StackCell g = pop();
+	StackCell f = pop();
+	StackCell e = pop();
+	StackCell d = pop();
+	StackCell c = pop();
+	StackCell b = pop();
+	StackCell a = pop();
+	Real y = popr();
+	Real x = popr();
+	if (a.type == NATIVE && b.type == NATIVE && c.type == NATIVE && d.type == NATIVE  && \
+	    e.type == NATIVE && f.type == NATIVE && g.type == NATIVE && h.type == NATIVE) {
+	  pushr(lft_R_R_Int(x, y, a.n, b.n, c.n, d.n, e.n, f.n, g.n, h.n));
+	} else {
+	  if (a.type == REAL || b.type == REAL || c.type == REAL || d.type == REAL || \
+	      a.type == STRING || b.type == STRING || c.type == STRING || d.type == STRING || \
+	      e.type == REAL || f.type == REAL || g.type == REAL || h.type == REAL || \
+	      e.type == STRING || f.type == STRING || g.type == STRING || h.type == STRING)
+	    longjmp(env, BAD_VALUE);
+
+	  upgradez(a); upgradez(b); upgradez(c); upgradez(d);
+	  upgradez(e); upgradez(f); upgradez(g); upgradez(h);
+	  pushr(lft_R_R_Z(x, y, a.z, b.z, c.z, d.z, e.z, f.z, g.z, h.z));
+	  gcz(a); gcz(b); gcz(c); gcz(d);
+	  gcz(e); gcz(f); gcz(g); gcz(h);
+
+	}
+
+	break;
+      }
+
+      default:
+	longjmp(env, BAD_VALUE);
+	break;
+      }
+
+      break;
+    }
+    case '|':
+      execute("Sm^Lm%");
+      break;
+
+    case 'v': { // Integers are pretty rarely squares.
+      special_func(sqrt);
+      break;
+    }
+    case 'e': // Exponential.
+      special_func(exp);
+      break;
+    case 'g': // natural loG.
+      special_func(log);
+      break;
+    case 't': // Trigonometric.
+      progress(TRIG);
+      break;
+    case 'h': // Hyperbolic.
+      progress(HYPERB);
+      break;
+    case 'n': // iNverse.
+      pv.inverse = true;
+      progress(TRIG_OR_HYPERB);
+      break;
+    case 'P': // π.
+      pushr(Pi);
+      break;
+    case 'X': // Xponential constant (e).
+      pushr(E);
+      break;
+
+      // Stack control.
+    case 'c':
+      for (int i = 0; i <= stack_top; i++) {
+	StackCell c = calc_stack[i];
+	switch (c.type) {
+	case INTEGER:
+	  gcz(c);
+	  break;
+	case STRING:
+	  gcs(c);
+	  break;
+	default:
+	  break;
+	}
+      }
+
+      stack_top = -1;
+
+      break;
+    case 'd':
+      push(peek());
+      break;
+    case 'r': {
+      StackCell top = pop();
+      StackCell next = pop();
+      push(top);
+      push(next);
+      break;
+    }
+    case 'R': {
+      int rotation_count = popn(-STACK_SIZE, STACK_SIZE);
+      bool rotation_positive = rotation_count > 0;
+      rotation_count = rotation_positive ? rotation_count : -rotation_count;
+      int rotation_start_idx = stack_top - rotation_count + 1;
+      if (rotation_start_idx < 0) {
+	rotation_start_idx = 0;
+	rotation_count = stack_top + 1;
+      }
+      StackCell to_rotate[rotation_count];
+      memcpy(to_rotate, calc_stack + rotation_start_idx, rotation_count * sizeof(StackCell));
+
+      for (int i = 0; i < rotation_count; i++) {
+	if (rotation_positive) {
+	  int rotated = (i == 0) ? rotation_count - 1 : (i - 1);
+	  calc_stack[rotation_start_idx + i] = to_rotate[rotated];
+	}
+	else {
+	  int rotated = (i == rotation_count - 1) ? 0 : i + 1;
+	  calc_stack[rotation_start_idx + i] = to_rotate[rotated];
+	}
+      }
+      break;
+    }
+
+      // Registers.
+    case 's':
+      progress(STORE_REGISTER_NAME);
+      break;
+    case 'l':
+      progress(LOAD_REGISTER_NAME);
+      break;
+    case 'S':
+      progress(PUSHSTORE_REGISTER_NAME);
+      break;
+    case 'L':
+      progress(POPLOAD_REGISTER_NAME);
+      break;
+
+      // Parameters.
+    case 'i':
+      input_radix = popn(2, 16);
+      break;
+    case 'o':
+      output_radix = popn(2, 16);
+      break;
+    case 'k':
+      precision = popn(0, INT_MAX);
+      break;
+    case 'I':
+      pushn(input_radix);
+      break;
+    case 'O':
+      pushn(output_radix);
+      break;
+    case 'K':
+      pushn(precision);
+      break;
+
+      // Strings.
+    case '[':
+      ++pv.string_depth;
+      progress(STRING_CONTENTS);
+      break;
+    case 'a': {
+      StackCell result = pop();
+      switch (result.type) {
+      case NATIVE: {
+	char low_byte[2] = {(char)result.n, '\0'};
+	pushs(low_byte);
+	break;
+      }
+      case INTEGER: {
+	char low_byte[2] = {(char)(mpz_get_ui(result.z)), '\0'};
+	pushs(low_byte);
+	gcz(result);
+	break;
+      }
+      case STRING: {
+	char low_byte[2] = {result.s[0], '\0'};
+	pushs(low_byte);
+        gcs(result);
+	break;
+      }
+
+      case REAL:
+	longjmp(env, BAD_VALUE); // Reals are conceptually infinite (and hard to work with digitally, the true reason).
+      }
+      break;
+    }
+
+    case 'x': {
+      StackCell c = pop();
+      if (c.type != STRING)
+	longjmp(env, BAD_VALUE);
+
+      char *macro = c.s;
+      int index = 0;
+      pv.string_depth = 0;
+      ++pv.macro_depth;
+      do {
+	interpret(macro[index]);
+	++index;
+      } while (macro[index] != '\0');
+      --pv.macro_depth;
+
+      gcs(c);
+
+      break;
+    }
+
+
+    case '>':
+      progress(GREATER_THAN_REG);
+      break;
+    case '<':
+      progress(LESS_THAN_REG);
+      break;
+    case '=':
+      progress(EQUAL_REG);
+      break;
+    case '!':
+      progress(NOT_CONTENTS);
+      break;
+    case '?': {
+      char *line[] = {malloc(MAX_INPUT_LEN)};
+      size_t len[] = {MAX_INPUT_LEN};
+      getline(line, len, stdin);
+      int i = 0;
+      while (line[0][i] != '\n') {
+	interpret(line[0][i]);
+	++i;
+      }
+      free(line[0]);
+      break;
+    }
+    case 'q':
+      pv.target_macro_depth -= 2;
+      if (pv.target_macro_depth < 0) {
+	longjmp(env, EXIT);
+      }
+      progress(WAITING_TARGET_MACRO_DEPTH);
+      break;
+    case 'Q':
+      pv.target_macro_depth -= popn(0, INT_MAX);
+      if (pv.target_macro_depth < 0) {
+	longjmp(env, EXIT);
+      }
+      progress(WAITING_TARGET_MACRO_DEPTH);
+      break;
+
+
+      // Status inquiry.
+
+    case 'Z': {
+      StackCell a = pop();
+      switch (a.type) {
+      case NATIVE:
+	pushn(count_digits(a.n));
+	break;
+      case INTEGER: {
+	pushn(mpz_sizeinbase(a.z, 10));
+	gcz(a);
+	break;
+      }
+      case REAL: {
+	Sign *sign = NULL;
+	int *count = NULL;
+	mpz_t digits;
+	mpz_init(digits);
+	retrieveInfo(a.r, sign, count, digits);
+	pushn(*count);
+	mpz_clear(digits);
+	break;
+      }
+      case STRING:
+        pushn(strlen(a.s));
+        gcs(a);
+	break;
+      }
+
+      break;
+    }
+    case 'z':
+      pushn(stack_top + 1);
+      break;
+
+      // Miscellaneous.
+    case '#':
+      progress(COMMENT_CONTENTS);
+      break;
+    case ':':
+      progress(REGISTER_SET_NAME);
+      break;
+    case ';':
+      progress(REGISTER_GET_NAME);
+      break;
+
+      // Ignored tokens.
+    case ' ':
+    case '\f':
+    case '\n':
+    case '\r':
+    case '\t':
+    case '\v':
+      break;
+
+    default:
+      longjmp(env, BAD_COMMAND);
+      break;
+    }
+
+    break;
+
+  case DIGITS_OR_DECIMAL_OR_VINCULUM:
+    switch (token) {
+    case '0':
+    case '1':
+    case '2':
+    case '3':
+    case '4':
+    case '5':
+    case '6':
+    case '7':
+    case '8':
+    case '9':
+    case 'A':
+    case 'B':
+    case 'C':
+    case 'D':
+    case 'E':
+    case 'F':
+      parse_push(token);
+      break;
+    case '.':
+    case '/':
+      pv.integer = false;
+      parse_push(token);
+      progress(DIGITS);
+      break;
+
+    default: {
+      parse_push('\0');
+      errno = -1;
+      long int attempt_read = strtol(pv.parse_stack, NULL, input_radix);
+      if (pv.integer && errno != ERANGE) {
+	pushn(attempt_read);
+      } else if (pv.integer) {
+	mpz_t integer;
+	mpz_init(integer);
+	mpz_set_str(integer, pv.parse_stack, input_radix);
+	pushz(integer);
+      } else {
+	mpq_t rational;
+	mpq_init(rational);
+	mpq_set_str(rational, pv.parse_stack, input_radix);
+	mpq_canonicalize(rational);
+	pushr(real_QZ(mpq_numref(rational), mpq_denref(rational)));
+	pv.integer = true;
+      }
+      reset();
+      interpret(token);
+      break;
+    }
+    }
+    break;
+
+  case DIGITS:
+    switch (token) {
+    case '0':
+    case '1':
+    case '2':
+    case '3':
+    case '4':
+    case '5':
+    case '6':
+    case '7':
+    case '8':
+    case '9':
+    case 'A':
+    case 'B':
+    case 'C':
+    case 'D':
+    case 'E':
+    case 'F':
+      parse_push(token);
+      break;
+    default: {
+      parse_push('\0');
+      errno = -1;
+      long int attempt_read = strtol(pv.parse_stack, NULL, input_radix);
+      if (pv.integer && errno != ERANGE) {
+	pushn(attempt_read);
+      } else if (pv.integer) {
+	mpz_t integer;
+	mpz_init(integer);
+	mpz_set_str(integer, pv.parse_stack, input_radix);
+	pushz(integer);
+      } else {
+	mpq_t rational;
+	mpq_init(rational);
+	mpq_set_str(rational, pv.parse_stack, input_radix);
+	mpq_canonicalize(rational);
+	pushr(real_QZ(mpq_numref(rational), mpq_denref(rational)));
+	pv.integer = true;
+      }
+      reset();
+      interpret(token);
+      break;
+    }
+    }
+    break;
+
+
+  case TRIG:
+    switch (token) {
+    case 's':
+      invertible_special(sin);
+      reset();
+      break;
+    case 'c':
+      invertible_special(cos);
+      reset();
+      break;
+    case 't':
+      invertible_special(tan);
+      reset();
+      break;
+    case 'S':
+      invertible_special(sec);
+      reset();
+      break;
+    case 'C':
+      invertible_special(cosec);
+      reset();
+      break;
+    case 'T':
+      invertible_special(cotan);
+      reset();
+      break;
+    default:
+      longjmp(env, BAD_COMMAND);
+      break;
+    }
+    break;
+  case HYPERB:
+    switch (token) {
+    case 's':
+      invertible_special(sinh);
+      reset();
+      break;
+    case 'c':
+      invertible_special(cosh);
+      reset();
+      break;
+    case 't':
+      invertible_special(tanh);
+      reset();
+      break;
+    case 'S':
+      invertible_special(sech);
+      reset();
+      break;
+    case 'C':
+      invertible_special(cosech);
+      reset();
+      break;
+    case 'T':
+      invertible_special(cotanh);
+      reset();
+      break;
+    default:
+      longjmp(env, BAD_COMMAND);
+      break;
+    }
+    break;
+  case TRIG_OR_HYPERB:
+    switch (token) {
+    case 't':
+      progress(TRIG);
+      break;
+    case 'h':
+      progress(HYPERB);
+      break;
+    default:
+      longjmp(env, BAD_COMMAND);
+      break;
+    }
+    break;
+
+
+  case STORE_REGISTER_NAME:
+    registers[(int)token][register_tops[(int)token]] = pop();
+    reset();
+    break;
+
+  case PUSHSTORE_REGISTER_NAME: {
+    if (register_tops[(int)token] == STACK_SIZE - 1) {
+      longjmp(env, OVERFLOW_REG);
+    }
+
+    ++register_tops[(int)token];
+    registers[(int)token][register_tops[(int)token]] = pop();
+    reset();
+  }
+    break;
+
+
+  case LOAD_REGISTER_NAME:
+    ++registers[(int)token][register_tops[(int)token]].reference_count;
+    push(registers[(int)token][register_tops[(int)token]]);
+    reset();
+    break;
+  case POPLOAD_REGISTER_NAME:
+    if (register_tops[(int)token] < 0) {
+      longjmp(env, UNDERFLOW_REG);
+    }
+
+    push(registers[(int)token][register_tops[(int)token]]);
+    --register_tops[(int)token];
+    reset();
+    break;
+
+
+  case STRING_CONTENTS:
+    switch (token) {
+    case '[':
+      parse_push(token);
+      ++pv.string_depth;
+      break;
+    case ']':
+      --pv.string_depth;
+      if (pv.string_depth == 0) {
+	parse_push('\0');
+	pushs(pv.parse_stack);
+	reset();
+      } else {
+	parse_push(token);
+      }
+      break;
+    default:
+      parse_push(token);
+      break;
+    }
+    break;
+
+
+  case GREATER_THAN_REG:
+    dispatch_pred(>, <=, gt, ltEq);
+    break;
+  case LESS_THAN_REG:
+    dispatch_pred(<, >=, lt, gtEq);
+    break;
+  case NOT_CONTENTS:
+    switch (token) {
+    case '>':
+      progress(NOT_GREATER_THAN_REG);
+      break;
+    case '<':
+      progress(NOT_LESS_THAN_REG);
+      break;
+    case '=':
+      progress(NOT_EQUAL_REG);
+      break;
+    default:
+      longjmp(env, BAD_COMMAND);
+      break;
+    }
+    break;
+  case NOT_GREATER_THAN_REG:
+    dispatch_pred(<=, >, ltEq, gt);
+    break;
+  case NOT_LESS_THAN_REG:
+    dispatch_pred(>=, <, gtEq, lt);
+    break;
+  case NOT_EQUAL_REG: {
+    int prec = popn(0, INT_MAX);
+    StackCell b = pop();
+    StackCell a = pop();
+    bool result;
+    switch (pair(a.type, b.type)) {
+    case pair(NATIVE, NATIVE):
+      result = a.n != b.n;
+      break;
+    case pair(NATIVE, INTEGER):
+      result = mpz_cmp_si(b.z, a.n) != 0;
+      gcz(b);
+      break;
+    case pair(INTEGER, NATIVE):
+      result = mpz_cmp_si(a.z, b.n) != 0;
+      gcz(a);
+      break;
+    case pair(INTEGER, INTEGER):
+      result = mpz_cmp(a.z, b.z) != 0;
+      gcz(a);
+      gcz(b);
+      break;
+    case pair(NATIVE, REAL): {
+      Bool r_neg_lazy = or_B_B(gt_R_QInt(b.r, a.n, 1), lt_R_QInt(b.r, a.n, 1));
+      force_B(r_neg_lazy, prec);
+
+      result = boolValue(r_neg_lazy) == LAZY_TRUE;
+      break;
+    }
+    case pair(REAL, NATIVE): {
+      Bool r_neg_lazy = or_B_B(gt_R_QInt(a.r, b.n, 1), lt_R_QInt(a.r, b.n, 1));
+      force_B(r_neg_lazy, prec);
+
+      result = boolValue(r_neg_lazy) == LAZY_TRUE;
+      break;
+    }
+    case pair(INTEGER, REAL):
+    case pair(REAL, INTEGER):
+    case pair(REAL, REAL): {
+      if (a.type == INTEGER) {
+	upgrader(a);
+      }
+
+      if (b.type == INTEGER) {
+	upgrader(b);
+      }
+
+      Bool r_neg_lazy = or_B_B(gt_R_R(a.r, b.r), lt_R_R(a.r, b.r));
+      force_B(r_neg_lazy, prec);
+      result = boolValue(r_neg_lazy) == LAZY_TRUE;
+      break;
+    }
+    default:
+      longjmp(env, BAD_VALUE);
+      break;
+    }
+
+    reset();
+
+    if (result) {
+      interpret('l');
+      interpret(token);
+      interpret('x');
+    }
+
+    break;
+  }
+
+  case EQUAL_REG: { // Has to be different because it's based on terminal fuziness.
+    int prec = popn(0, INT_MAX);
+    StackCell b = pop();
+    StackCell a = pop();
+    bool result;
+    switch (pair(a.type, b.type)) {
+    case pair(NATIVE, NATIVE):
+      result = a.n == b.n;
+      break;
+    case pair(NATIVE, INTEGER):
+      result = mpz_cmp_si(b.z, a.n) == 0;
+      gcz(b);
+      break;
+    case pair(INTEGER, NATIVE):
+      result = mpz_cmp_si(a.z, b.n) == 0;
+      gcz(a);
+      break;
+    case pair(INTEGER, INTEGER):
+      result = mpz_cmp(a.z, b.z) == 0;
+      gcz(a);
+      gcz(b);
+      break;
+    case pair(NATIVE, REAL): {
+      Bool r_neg_lazy = and_B_B(gt_R_QInt(b.r, a.n, 1), lt_R_QInt(b.r, a.n, 1));
+      force_B(r_neg_lazy, prec);
+
+      result = boolValue(r_neg_lazy) == LAZY_UNKNOWN;
+      break;
+    }
+    case pair(REAL, NATIVE): {
+      Bool r_neg_lazy = and_B_B(gt_R_QInt(a.r, b.n, 1), lt_R_QInt(a.r, b.n, 1));
+      force_B(r_neg_lazy, prec);
+
+      result = boolValue(r_neg_lazy) == LAZY_UNKNOWN;
+      break;
+    }
+    case pair(INTEGER, REAL):
+    case pair(REAL, INTEGER):
+    case pair(REAL, REAL): {
+      if (a.type == INTEGER) {
+	upgrader(a);
+      }
+
+      if (b.type == INTEGER) {
+	upgrader(b);
+      }
+
+      Bool r_neg_lazy = and_B_B(gt_R_R(a.r, b.r), lt_R_R(a.r, b.r));
+      force_B(r_neg_lazy, prec);
+      result = boolValue(r_neg_lazy) == LAZY_UNKNOWN;
+      break;
+    }
+
+    default:
+      longjmp(env, BAD_VALUE);
+      break;
+    }
+
+    reset();
+
+    if (result) {
+      interpret('l');
+      interpret(token);
+      interpret('x');
+    }
+
+    break;
+  }
+
+  case WAITING_TARGET_MACRO_DEPTH:
+    if (pv.macro_depth == pv.target_macro_depth) {
+      reset();
+    }
+
+    break;
+
+  case COMMENT_CONTENTS:
+    if (token == '\n') {
+      reset();
+    }
+
+    break;
+
+
+  case REGISTER_SET_NAME: {
+    int top = popn(0, 255);
+    StackCell pentultimate = pop();
+    pentultimate.register_in = token;
+    pentultimate.register_location = top;
+    registers[(int)token][top] = pentultimate;
+    reset();
+    break;
+  }
+
+  case REGISTER_GET_NAME: {
+    int index = popn(0, 255);
+    ++registers[(int)token][index].reference_count;
+    StackCell c = registers[(int)token][index];
+    push(c);
+    reset();
+    break;
+  }
+  }
+}
+
+int process(FILE *stream) {
+  while(true) {
+    char input = getc(stream);
+    switch (setjmp(env)) {
+    case BAD_COMMAND:
+      putchar('?');
+      putchar(input);
+      putchar('\n');
+      reset();
+      break;
+    case UNDERFLOW:
+      printf("!-\n");
+      reset();
+      break;
+    case UNDERFLOW_REG:
+      printf("!%c-\n", input);
+      reset();
+      break;
+    case OVERFLOW:
+      printf("!+\n");
+      reset();
+      break;
+    case OVERFLOW_REG:
+      printf("!%c+\n", input);
+      reset();
+      break;
+    case BAD_VALUE:
+      printf("!?\n");
+      reset();
+      break;
+    case EXIT:
+      return 0;
+      break;
+    default: {
+      interpret(input);
+      break;
+    }
+    }
+  }
+}
+
+
+const char *argp_program_version = "Exact Desk Calculator V0.1";
+const char *argp_program_bug_address = "duncannwilkie@gmail.com";
+static struct argp_option options[] = {
+  {.name = "expression", .key = 'e', .arg = "scriptexpression", .flags = 0,
+   .doc = "Add the commands in scriptexpression to the set of commands to be run while processing the input."},
+  {.name = "file", .key = 'f', .arg = "script-file", .flags = 0,
+   .doc = "Add the commands contained in the file script-file to the set of commands to be run while processing the input."},
+  { 0 }};
+
+error_t parser(int key, char *arg, struct argp_state *state) {
+  switch (key) {
+  case ARGP_KEY_INIT:
+    return 0;
+  case ARGP_KEY_ARG: // Non-option argument; filename.
+    if (strcmp(arg, "-")) {
+      printf("%s\n", argp_program_version);
+      process(stdin);
+      return 0;
+    } else {
+      FILE *contents = fopen(arg, "r");
+      process(contents);
+      fclose(contents);
+      return 0;
+    }
+  case 'e': { // Evaluate the script expression.
+    FILE *contents = fmemopen(arg, strlen(arg), "r");
+    process(contents);
+    fclose(contents);
+    return 0;
+  }
+  case 'f': { // Evaluate the file.
+    FILE *contents = fopen(arg, "r");
+    process(contents);
+    fclose(contents);
+    return 0;
+  }
+  case ARGP_KEY_ERROR:
+    argp_error(state, "argument parsing error.");
+    return 1;
+    break;
+
+  case ARGP_KEY_SUCCESS:
+    if (state->argc == 1) { // Only program name; interactive calculation.
+      printf("%s\n", argp_program_version);
+      process(stdin);
+    }
+    return 0;
+
+  case ARGP_KEY_NO_ARGS:
+  case ARGP_KEY_END:
+  case ARGP_KEY_FINI:
+    return 0;
+  default:
+    return ARGP_ERR_UNKNOWN;
+  }
+}
+
+static char args_doc[] = "[file ...]";
+static char doc[] = "\n"
+  "Run the exact desk calculator, "
+  "an implementation of the classic UNIX RPN desk calculator (dc) "
+  "using the exact real arithmetic and corresponding IC-Reals library "
+  "developed at Imperial College."
+
+  "\v"
+
+  "If any command-line parameters remain after processing the above, "
+  "these parameters are interpreted as the names of input files to be processed. "
+  "A file name of - refers to the standard input stream. "
+  "The standard input will processed if no script files or expressions specified.\n\n"
+
+  "See man edc for the language syntax.";
+
+static struct argp argp = {options, parser, args_doc, doc, NULL, NULL, NULL};
+// TODO: hypothesis testing.
+// TODO: make stack size a CLI argument.
+// TODO: IC-Real environment variables.
+// TODO: currently, | does a literal exponentiation; the mpz function would be faster.
+int main(int argc, char *argv[]) {
+
+  initReals();
+
+  mpz_init(one);
+  mpz_set_si(one, 1);
+
+  for (int i = 0; i < 256; i++) {
+    register_tops[i] = -1;
+  }
+
+  argp_parse(&argp, argc, argv, 0, NULL, NULL);
+
+
+
+  return 0;
+}