/*

    There are some gratuitous #define's here and a lot of stuff
  I added way back to ensure portability over a range of non-standard
  C compilers.  Nowadays where everyone has a compliant ANSI C. I
  should be able to strip all that away and work from a single C
  source.  However I have not had the time nor need to make that
  cleanup yet.  Consequently this may need a little tweaking on
  some systems, especially in the handling of interrupts.

  This source started off as BCPL and was manually converted to C,
  hence why some of the C is not in the normal idiom.

  - Graham

 */





#define GECUNIX
/*#define DEBUG*/
/* Set to TRUE if mucking about with innards and adding any debugging */

/* add #define EIGHTBITS 1 if using IBM or ISO 8-bit char sets - 
   this allows chars from 128 to 255 to be displayed as text. */
#define EIGHTBITS 0
/* current known problems: i[ALT-129]fred[ALT-129]   inserts the
   text fred[ALT-129]   into the file.  The top-bit set char should be
   an err, not a delim; errs should be notified, and end-delims should
   be heeded... */

/* If using IBM-PC Turbo C, set compile with -DTURBOC */
/* Zortech compiler doesn't appear to allow ^C trapping? */
/**************************************************/
/*                                                */
/*                                                */
/*                     E C C E                    */
/*                                                */
/*                                                */
/*     ECCE was designed by Hamish Dewar, now of  */
/* Clan Systems Ltd.  This implementation is by   */
/* Graham Toal, of Edinburgh Software Products.   */
/*                                                */
/* This source is released into the public domain */
/* by the author, without restriction.            */
/* (c) Graham Toal, 1984. (BCPL version)          */
/*                                                */
/**************************************************/

#define ISO 1
#define KNOWS_REGISTER 0
#define KNOWS_VOID 0
#define ALLOW_INTS 1
#define PANOS_CODE 0
#define IBM 0

/**************************************************************************/

#define MAXBUFF (2L*1024L*1024L)
#define READ "rb"
#define WRITE "wb"
#define NOTE_FILE "/tmp/Note0"
              /* Name of temp file for multiple contexts - system dependant */
#define NOTE_DISTINCT 9
              /* Index of variable part in name above (i.e. of '0')         */

#define A1EMERGENCY "/tmp/EcceSaved"
#define A2EMERGENCY "/tmp/EcceSav"
#define ECCETMP "/tmp/EcceTmp"
              /* File-names for when can't write to output file...
                 Ideally should allow these to be input, and also
                 allow a cli-loop using system("...") to give you
                 a chance to recover, but too much effort! */

/**************************************************************************/
#ifdef TURBOC
#define MSDOS /* Apologies if Turbo C exists for other machines! */
#endif
#ifdef __ZTC__
#define MSDOS /* and if Zortech C exists for other machines!! */
#endif

#ifdef MSDOS
#undef EIGHTBITS
#define EIGHTBITS 1
#undef IBM
#define IBM 1
#undef ISO
#define ISO 1
#undef KNOWS_REGISTER
#define KNOWS_REGISTER 1
#undef KNOWS_VOID
#define KNOWS_VOID 1
#undef ALLOW_INTS
#define ALLOW_INTS 1
#undef MAXBUFF
#define MAXBUFF (128L*1024L)
#undef READ
#define READ "r"
#undef WRITE
#define WRITE "w"
#undef A1EMERGENCY
#define A1EMERGENCY "Ecce.sav"
#undef A2EMERGENCY
#define A2EMERGENCY "C:\\Ecce.Sav"
#undef ECCETMP
#define ECCETMP "C:\\Ecce.Tmp"
#endif

#ifdef TURBOC
#undef ALLOW_INTS
#define ALLOW_INTS 0
#endif

/**************************************************************************/

#ifdef EMAS
#endif
/**************************************************************************/

#ifdef UNIX
#undef ALLOW_INTS
#define ALLOW_INTS 1
#endif
/**************************************************************************/

#ifdef GECUNIX
#endif
/**************************************************************************/

#ifdef PANOS
#undef PANOS_CODE
#define PANOS_CODE 1
#undef ALLOW_INTS
#define ALLOW_INTS 1
#undef KNOWS_REGISTER
#define KNOWS_REGISTER 1
#undef KNOWS_VOID
#define KNOWS_VOID 1
#endif
/**************************************************************************/

#ifdef ARTHUR
#define RISCOS 1
/* compatibility with old compiler */
#endif

#if RISCOS
#undef EIGHTBITS
#define EIGHTBITS 1
#undef ISO
#define ISO 1
#undef ALLOW_INTS
#define ALLOW_INTS 1
#undef KNOWS_REGISTER
#define KNOWS_REGISTER 1
#undef KNOWS_VOID
#define KNOWS_VOID 1
#endif
/**************************************************************************/

/* #define ISO */
/* Set to TRUE if using an ISO-C -- gives better type checking        */
/* If not ISO, compiler may still understand void and register... */
/* #define KNOWS_REGISTER */
/* #define KNOWS_VOID */
/* #define ALLOW_INTS */
/* File <signal.h> will only be included if ALLOW_INTS = TRUE */
/* Set to TRUE if you can use signal() on your machine to trap an
   interrupt character (esc, ^C, etc...)
*/

#include <stdio.h>

#define FALSE (0!=0)
#define TRUE (0==0)
/* If your compiler is brain damaged, set these to the
   appropriate magic numbers --- which won't be as portable! */

/* Assumes system include file STDIO only. */

#define ISLOWER(c) ('a'<=(c)&&(c)<='z')
#define TOUPPER(c) (ISLOWER(c)?(c)-'a'+'A':(c))

/* Types */

#if IBM
#ifdef __ZTC__
#define HUGE far
#else
#define HUGE huge
#endif
#endif

#if ISO
typedef int bool;
#if IBM
typedef char HUGE *cindex;
#else /* NOT IBM */
typedef char *cindex;
#endif /* IBM */
#define VOID (void)
#define NO_PARAMS void
#else /* NOT ISO */
#define bool int
#define VOID      /* (void) */
#define NO_PARAMS /* void */
#if IBM
#define cindex HUGE char *
#else /* NOT IBM */
#define cindex char *
#endif /* IBM */
#if KNOWS_VOID
/* ... */
#else /* NOT KNOWS_VOID */
#define void /* int? */
#endif /* KNOWS_VOID */

#if KNOWS_REGISTER
/* ... */
#else /* NOT KNOWS_REGISTER */
#define register /* auto */
#endif /* KNOWS_REGISTER */

  /* Andy is mad-keen on 'register' - it hardly matters in argument
     decoding which doesn't need to be fast. */
#endif /* ISO */

#if ISO
#include <string.h>
#define stringlen(s) strlen(s)
#define stringcopy(a, b) strcpy(a, b)
#else
int stringlen(s)
char *s;
{
/* Return length of s. */

  char *original = s;

  while (*s != 0) s++;
  return(s - original);
}

char *stringcopy(s1, s2)
register char *s1, *s2;
{
/* Copy s2 to s1. */
  char *original = s1;

  while (*s2 != 0) *s1++ = *s2++;
  *s1 = 0;
  return(original);
}
#endif


/* Consts */

#define    cr              '\n'
#define    bs              8
#define    bell            7
#define    nul             0
#define    del             127
#define    casebit         ('a'-'A')
#define    minusbit        casebit
#define    plusbit         0x80
#define    Max_command_units 127
#define    Max_file_name     127
#define    Max_prompt_length 127
#define    rep             1
#define    txt             2
#define    scope           4
#define    sign            8
#define    delim           16
#define    numb            32
#define    ext             64
#define    err             128
#define    dig             0
#define    pc              1
#define    lpar            2
#define    comma           3
#define    rpar            4
#define    plus            5
#define    minus           6
#define    pling           7
#define    star            8
#define    termin          15

#if ISO
/* Procedures below */

void init_globals (void); 
void free_buffers (void); 
void local_echo (int *sym);        /* Later, make this a char fn. */
void read_sym (void); 
bool fail_with (char *mess, char culprit); 
void percent (char Command_sym); 
void unchain(void); 
void stack(void); 
void execute_command(void); 
void Scan_sign(void);                        /* Could be a macro */
void Scan_scope(void);                       /* ditto macro */
void Scan_text(void); 
void Scan_repeat (void); 
bool analyse (void); 
void load_file (void); 
bool execute_unit (void); 
void execute_all (void); 
char case_op (char sym);                /* should be made a macro */
bool right (void); 
bool left (void); 
void right_star(void);                       /* Another macro */
void left_star(void);                        /* Likewise... */
void move (void); 
void move_back(void); 
void move_star (void); 
void move_back_star (void); 
void insert (void); 
void insert_back (void); 
bool verify(void); 
bool verify_back (void); 
bool find (void); 
bool find_back (void); 
#endif

/* Global variables */

static long  buffer_size;
static char *note_file;
static bool  ok;
static bool  printed;
static long  stopper;     /* BUG fixed here: stopper, and anything to do with
                    repeat counts should be a long (or as large as an cindex) */
static int   max_unit;
static char  pending_sym;
static cindex fbeg;
static cindex lbeg;
static cindex pp;
static cindex fp;
static cindex lend;
static cindex fend;
static int   type;
static char  command;
static long  repeat_count;
static long  limit;
static int   pointer;
static int   last_unit;
static int   this_unit;
static int   pos;
static int   endpos;
static int   sym;        /************* sym is an int so it can be tested
                                        against EOF ************/
static long  number;
static cindex pp_before;
static cindex fp_before;
static cindex ms;
static cindex ms_back;
static cindex ml;
static cindex ml_back;
static int   to_upper_case;
static int   to_lower_case;
static int   caseflip;
static bool  blank_line;
static char *eprompt;
static cindex noted;
static int   changes;
static bool  in_second;
static char *com_prompt;

#define prompt(s) fprintf(tty_out, s)    /* stderr unbuffered. */
                                        /* In fact, only used once! */
#if ISO
#define copy_string(from, to) (void) (stringcopy(to, from))
#else
#define copy_string(from, to) stringcopy(to, from)
/* If your C has no parameterised macros, change these by hand */
#endif

static int sym_type[] = { /* 0:127 */
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   err,                 /* */
   ext+numb+7,          /*!*/
   delim,               /*"*/
   err,                 /*#*/
   err,                 /*$*/
   ext+1,               /*%*/
   err,                 /*&*/
   delim,               /*'*/
   ext+2,               /*(*/
   ext+4,               /*)*/
   ext+numb+8,          /***/
   ext+5,               /*+*/
   ext+3,               /*,*/
   ext+6,               /*-*/
   delim,               /*.*/
   delim,               /*slash*/
   ext+numb+0,          /*0*/
   ext+numb+0,          /*1*/
   ext+numb+0,          /*2*/
   ext+numb+0,          /*3*/
   ext+numb+0,          /*4*/
   ext+numb+0,          /*5*/
   ext+numb+0,          /*6*/
   ext+numb+0,          /*7*/
   ext+numb+0,          /*8*/
   ext+numb+0,          /*9*/
   delim,               /*:*/
   ext+15,              /*;*/
   ext+2,               /*<*/
   delim,               /*=*/
   ext+4,               /*>*/
   0,                   /*?*/
   err,                 /*@*/
   scope,               /*A*/
   sign+rep,            /*B*/
   sign+rep,            /*C*/
   sign+scope+txt+rep,  /*D*/
   sign+rep,            /*E*/
   sign+scope+txt+rep,  /*F*/
   sign+rep,            /*G*/
   scope,               /*H*/
   sign+txt+rep,        /*I*/
   sign+rep,            /*J*/
   sign+rep,            /*K*/
   sign+rep,            /*L*/
   sign+rep,            /*M*/
   0,                   /*N*/
   err,                 /*O*/
   sign+rep,            /*P*/
   err,                 /*Q*/
   sign+rep,            /*R*/
   sign+txt,            /*S*/
   sign+scope+txt+rep,  /*T*/
   sign+scope+txt+rep,  /*U*/
   sign+txt,            /*V*/
   err,                 /*W*/
   err,                 /*X*/
   err,                 /*Y*/
   err,                 /*Z*/
   ext+2,               /*[*/
   0,                   /*\*/
   ext+4,               /*]*/
   ext+6,               /*^*/
   delim,               /*_*/
   err,                 /*@*/
   err,                 /*A*/
   sign+rep,            /*B*/
   sign+rep,            /*C*/
   sign+scope+txt+rep,  /*D*/
   sign+rep,            /*E*/
   sign+scope+txt+rep,  /*F*/
   sign+rep,            /*G*/
   err,                 /*H*/
   sign+txt+rep,        /*I*/
   sign+rep,            /*J*/
   sign+rep,            /*K*/
   sign+rep,            /*L*/
   sign+rep,            /*M*/
   err,                 /*N*/
   err,                 /*O*/
   sign+rep,            /*P*/
   err,                 /*Q*/
   sign+rep,            /*R*/
   sign+txt,            /*S*/
   sign+scope+txt+rep,  /*T*/
   sign+scope+txt+rep,  /*U*/
   sign+txt,            /*V*/
   err,                 /*W*/
   err,                 /*X*/
   err,                 /*Y*/
   err,                 /*Z*/
   ext+2,               /*[*/
   0,                   /*\*/
   ext+4,               /*]*/
   ext+6,               /*^*/
   delim                /*_*/
#if EIGHTBITS
/* By rights, ought to have different tables for IBM, ISO<n> */
/* but won't as will treat all same for the moment.          */

/* May change some of these to delim at users discretion */
 , err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err
#else
/* Not an eight-bit system so anything with bit7 set is an error */
 , err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err, 
   err, err, err, err, err, err, err, err
#endif
};

static cindex a;
static FILE *main_in;
static FILE *main_out;
static FILE *tty_in;
static FILE *tty_out;
static FILE *log_out;

static char *com;
static int  *link;
static char *text;
static long *num;
static long *lim;

/* Indexes into ARGV to pick up parameters - BCPL style */
#define    Program 0
#define    F       1
#define    T       2
#define    L       3
#define    B       4

/*****************************************************************************/
/* Andy Bray's header for rdargs  */
#if ISO
extern char *rdargs(char *, char *[], int, char *[], int);
#endif

#define RDARGS_MAX_KEYS  50
#define RDARGS_MAX_LEN_KEYSTR  256

/* Andy Bray's C parameter handling mechanism */

/* ported from Andy's BCPL library */

/*  Procedures:
      RDARGS(BCPL style key, C argv, C argc,
         BCPL style argument vector, size of arg vector)

      Key string is "item item item item..... item"

      Each item is Name[/switch]

      Switches are:
        /K key word must be present (cannot be derived from position)
        /S is just a switch, no associated data
        /A argument must be present
      K and S are mutually exclusive, A can be combined with K.

      Spaces are used to separate input arguments, commas are part of
      an argument

      Returns 0 if all OK, o/w a string indicating the error.

      Errors are:
         Unrecognised argument [ie -unknown]
         Excess parameters [cannot put parameter in vector]
         Missing parameter [no parameter following argument]
         Required parameter missing
         Duplicate parameter

         KEYSTRING too long [internal]
         Too many keys [internal]
         Bad switch in keystring [internal]
         Argument vector is too small

*/

static int argcmp(si, sm)
char *si, *sm;
{  register int n = stringlen(si);
   if (n > stringlen(sm)) return (FALSE);
   while (n-- > 0) if (TOUPPER(si[n]) != TOUPPER(sm[n])) return (FALSE);
   return (TRUE);
}

#define Kbit 4
#define Sbit 2
#define Abit 1

#define Freebits (Kbit|Sbit) /* if these bits are set, cannot put free here */

char *rdargs(key, Cargv, Cargc, Bargv, Bargc)
char *key;
char *Cargv[], *Bargv[];
int Cargc, Bargc;
{  char *keynames[RDARGS_MAX_KEYS];
   int  keyflags[RDARGS_MAX_KEYS];
   char keycopy[RDARGS_MAX_LEN_KEYSTR];

   register int nkeys;
   register char *keyp = keycopy;
   register int nfree;

   /* Phase 0 - clean output vector */
   for (nkeys = 0; nkeys <= Bargc; nkeys++) Bargv[nkeys] = (char *) 0;
   Bargv[0] = Cargv[0];
   nkeys = 0;

   /* Phase 1 - parse the key string */
   while (*key) {
      while (*key == ' ') key++;
      if (*key == '\0') break;
      keynames[nkeys] = keyp;
      keyflags[nkeys] = 0;
      while (*key != '\0' && *key != ' ' && *key != '/') {
         *keyp++ = *key++;
         if (keyp + 1 >= keycopy + sizeof(keycopy))
            return("Keystring too long");
      }
      *keyp++ = 0;
      if (*key == '/') {
         while (*++key != ' ' && *key != '\0') {
            switch (*key) {
               case 'A':
               case 'a':
                    keyflags[nkeys] |= Abit;
                    break;

               case 'S':
               case 's':
                    keyflags[nkeys] |= Sbit;
                    break;

               case 'K':
               case 'k':
                    keyflags[nkeys] |= Kbit;
                    break;

               default:
                    return ("Bad switch in key string");
            }
         }
      }
      nkeys++;
      if (nkeys == RDARGS_MAX_KEYS) return ("Too many keys");
   }

   /* Cargv points to prog name, ignore */
   Cargv++;
   Cargc--;

   /* process the input */

   if (Bargc < nkeys) return ("Argument vector is too small");

   nfree = 0; /* nfree points to next parameter to try for unflagged parms */

   while (Cargc-- > 0) {
      if (**Cargv == '-') { /* found key */
         register int itmp;
         register int found = FALSE;

         keyp = (*Cargv++) + 1; /* point to after - */
         for (itmp = 0; itmp < nkeys; itmp++)
            if (argcmp(keyp, keynames[itmp])) {
               if ((keyflags[itmp] & Sbit) != 0) Bargv[itmp+1] = keyp;
               else { /* not a switch - has a parameter */
                  if (Cargc < 1 || **Cargv == '-')
                     return("Missing parameter");
                  if (Bargv[itmp+1] != (char *)0)
                     return("Duplicate parameter");
                  Bargv[itmp+1] = *Cargv++;
                  Cargc--;
               }
               found = TRUE;
               break;
            }
         if (!found) return("Unrecognised argument");
      } else { /* keyless parm */
         while ((nfree < nkeys) &&
           ((Bargv[nfree+1] != (char *) 0) || 
             (keyflags[nfree] & Freebits) != 0))
                nfree++;
         if (nfree < Bargc) Bargv[1+nfree++] = *Cargv++;
         else return ("Excess parameters");
      }
   }
/****   
   for (nfree = 0; nfree <= nkeys; nfree++)
     if (((keyflags[nfree] & Abit) !=0) && (Bargv[nfree+1] == (char *)0))
        return ("Required parameter missing");
****/
   return ( (char *) 0);     
}     

/*****************************************************************************/

/*#define INVALID_PTR NULL ((cindex) -1)*/

#ifndef NULL
#define NULL 0
#endif

#define INVALID_PTR NULL

#if ISO
extern void exit(int rc);
#if IBM
#ifdef __ZTC__
extern char far *farmalloc(unsigned long bytes);
extern char *malloc(unsigned int bytes);
#define halloc(x,y) farmalloc(x)
#else
#ifdef TURBOC
extern char far *farmalloc(unsigned long bytes);
extern char *malloc(unsigned int bytes);
#define halloc(x,y) farmalloc(x)
#else
#include <malloc.h>
#endif
#endif
#else
extern char *malloc(int bytes);
#define halloc(x,y) malloc(x)
#endif
#else
extern exit();
#if IBM
#include <malloc.h>
#else
extern char *malloc();
#define halloc(x,y) malloc(x)
#endif
#endif

static IntSeen;

#if ALLOW_INTS
#if PANOS_CODE

#define SIGALARM   5
#define SIGPROF    (SIGALARM+256)
#define SIGVTALARM SIGALARM
#define SIGQUIT    6 /* escape */
#define SIGINT     SIGQUIT+256
#define CSignal 12543 /* random no - handle for PANOS event routine */
#define CONDSTOP   1
#define CONDEXCEPTION 2

typedef struct { unsigned int low; unsigned int high; } timeval;

extern unsigned int timerdiff() ;
extern gettimeofday() ;
extern alarm() ;

extern int XSetEventStatus() asm;
extern int XDeclareEventHandler() asm;
extern int OsWord() asm;
extern int Signal() asm;

static int GlobalEnv;
static int LastSignal;

#define NIL 0
#define OFF 0
#define ON  1

int default_SIGINT()  { return(Signal(-SIGINT,   NIL)); }
#define SIG_IGN &default_SIGINT
int default_SIGQUIT() { return(Signal(-SIGQUIT,  NIL)); }
int default_SIGALARM(){ return(Signal(-SIGALARM, NIL)); }
int default_SIGPROF() { return(Signal(-SIGPROF,  NIL)); }
int default_SIGothers(){ return(Signal(-LastSignal, NIL)); }

static int (*handler_SIGINT)()    = &default_SIGINT;
static int (*handler_SIGQUIT)()   = &default_SIGQUIT;
static int (*handler_SIGALARM)()  = &default_SIGALARM;
                                        /* SIGVTALRM equated to SIGALRM */
static int (*handler_SIGPROF)()   = &default_SIGPROF;
static int (*handler_SIGothers)() = &default_SIGothers;

static int AlarmType, AlarmInterval;

internal_handler (code, ed1, ed2, handle, env)
int code,ed1,ed2,handle,env;
{ 
  timeval time_buff, time_now;
  int time_zone;
  int (*user)();

  LastSignal = code;
  GlobalEnv = env; /* For attempts to unwind by default (local) handlers */
  user = 0;
  if (code == SIGQUIT) user = handler_SIGQUIT; 
  if (code == SIGINT)  user = handler_SIGINT;
  if (user) { (*user)(); asm { EXIT #0; RXP #20; } }
  if (code == SIGALARM) {
    if (AlarmType == SIGPROF) {
      (*handler_SIGPROF)();
      /* reset the clock */
      time_buff.low = AlarmInterval; time_buff.high = -1;
      OsWord(4, &time_buff);
      asm { EXIT #0; RXP #20; };
    } else { 
      (*handler_SIGALARM) ();
      asm { EXIT #0; RXP #20; };
    }
  }    
  /* Remaining handlers through one routine (temp bodge) */
  user = handler_SIGothers;
  if (user) { (*user)(); asm { EXIT #0; RXP #20; } }
}

int ckpsig(SIGtype, f)
int SIGtype, (*f)();
{ 
  if (SIGtype == SIGINT)   handler_SIGINT   = f;
  else if (SIGtype == SIGQUIT)  handler_SIGQUIT  = f;
  else if (SIGtype == SIGALARM) handler_SIGALARM = f;
  else if (SIGtype == SIGPROF)  handler_SIGPROF  = f;
  else                          handler_SIGothers= f;
  if (SIGtype < 10) {
    XDeclareEventHandler(&internal_handler,SIGtype,
                         2 /*call this only*/,  CSignal);
  }
  if ((SIGtype == SIGINT) || (SIGtype == SIGQUIT)) {
    XSetEventStatus(SIGQUIT, ON);
  }
}

alarm(seconds)
int seconds;
{ int rc, upcount;
  static timeval time_buff;
  
  if (seconds == 0) {
    rc = XSetEventStatus(SIGALARM, OFF);
    handler_SIGALARM = default_SIGALARM;
  } else {
    rc = XSetEventStatus(SIGALARM, ON);
    upcount = 0-(seconds*100);
    time_buff.low = upcount; time_buff.high = -1;
    AlarmType = SIGALARM;
    rc = OsWord(4, &time_buff);
  }
}

profile (millisecs)
int millisecs;
{ int rc, upcount;
  static timeval time_buff;
  
  if (millisecs == 0) {
    rc = XSetEventStatus(SIGALARM, OFF);
    handler_SIGPROF = &default_SIGPROF;
  } else {
    AlarmInterval = -(millisecs/10);       /* Convert to centisecs */
    upcount = AlarmInterval;
    time_buff.low = upcount; time_buff.high = -1;
    AlarmType = SIGPROF;
    rc = XSetEventStatus(SIGALARM, ON);
    rc = OsWord(4, &time_buff);
  }
}
#else
/* Not a system with no native signal() */
#include <signal.h>
#endif

#if PANOS_CODE
#define signal(a, b) ckpsig(a, b)
#endif


#if ISO
void gotint(int n) {
#else
void gotint(n)
  int n;
{
#endif

  n = n; /* Supress barmy warning message... */
  IntSeen = TRUE;
}
#endif

#define ARGC 4
static char *ARGV[ARGC+1];

#if ISO
int main(int argc, char **argv) {
#else
int main(argc, argv)
  int argc;
  char **argv;
{
#endif
char *errstr;

      /* some day consider a filter with command-line tty_in
         and stdin/stdout as main_* */

   errstr = rdargs("FROM/A TO LOG/K SIZE/K", argv, argc, ARGV, ARGC);

   if (ARGV[1] == NULL) {
      fprintf (stderr,
         "%s: {-from} infile {{-to} outfile}? {-log file}? {-size bytes}?\n",
          ARGV[Program]);
      exit (30);
   }

   if (errstr != 0) {
      fprintf (stderr, "%s: %s\n", ARGV[Program], errstr);
      exit (20);
   }
   IntSeen = FALSE;

   tty_in = stdin;
   tty_out = stderr;

   main_in = fopen (ARGV[F], READ);

   if (main_in == NULL) {
      fprintf (stderr, "File \"%s\" not found\n",ARGV[F]);
      exit (30);
   }

   if (ARGV[L] == 0) {
      log_out = NULL;
   } else {
      log_out = fopen (ARGV[L], WRITE);
      if (log_out == NULL) {
         fprintf (stderr, "%s: Warning - can't create \"%s\"\n",
          ARGV[Program], ARGV[L]);
      }
   }

   if (ARGV[B] == 0) {
      buffer_size = MAXBUFF;                  /* Find better algorithm */
   } else {
      long n = 0L;
      char *c = ARGV[B];
      while (('0'<= *c) && (*c <= '9')) n = n*10 + *c++ - '0';
      buffer_size = n;
   }

   if (buffer_size == 0) buffer_size = 20*1024;

   init_globals ();

   a[0]           = cr;
   a[buffer_size] = cr;

   fprintf (tty_out, "Ecce\n");

   if (main_in != NULL) load_file ();

#if ALLOW_INTS
#if PANOS_CODE
   signal(SIGQUIT, &gotint);
#else
#if IBM
   signal(SIGINT, gotint);
#else
   signal(SIGINT, &gotint);
#endif
#endif
#endif

   percent ('E'); /* Select either-case searches, case-flipping C command. */
   for (;;) {
      if (analyse ()) {
         printed = FALSE;
         execute_all ();
         command = 'P';
         repeat_count = 1L;
         if (!printed) execute_command ();
      }
#if ALLOW_INTS
      if (IntSeen) {
#if PANOS_CODE
        signal(SIGQUIT, &gotint);
#else
#if IBM
        signal(SIGINT, gotint);
#else
        signal(SIGINT, &gotint);
#endif
#endif
        IntSeen = FALSE;
        fprintf(stderr, "* Escape!\n");
      }
#endif
   }
}

void init_globals (NO_PARAMS) {
/*   int diff, margin;      USE THESE WITH ALLOCATION ALGORITHM */

   a = halloc (buffer_size+1L,1);

   note_file = malloc (Max_file_name+1);

   com  = malloc (Max_command_units+1); /* char */
   link = (int *)
          malloc ((Max_command_units+1)*sizeof(int));  /* cindex 0..Max_command_units */
   text = malloc (Max_command_units+1);      /* cindex 0..Max_command_units */

   num = (long *) malloc ((Max_command_units+1)*sizeof(long));
   lim = (long *) malloc ((Max_command_units+1)*sizeof(long));

   com_prompt = malloc (Max_prompt_length+1);

   if (a == NULL || note_file == NULL || com == NULL ||
    link == NULL || text == NULL || num == NULL || lim == NULL ||
    com_prompt == NULL) {
      fprintf (stderr, "Unable to claim buffer space\n");
      free_buffers();
      exit (40);
   }

   fprintf (stderr, "Buffer space = %d KBytes\n", buffer_size>>10);


   fbeg = a+1;
   lbeg = fbeg;
   pp = lbeg;
   fp = a+buffer_size;
   lend = fp;
   fend = lend;
   ms = INVALID_PTR;
   ms_back = INVALID_PTR;
   stopper = -buffer_size;
   max_unit = -1;
   pending_sym = cr;
   blank_line = TRUE;

   copy_string (NOTE_FILE, note_file);
                                    /* Temporary until can be bothered
                                       either to use stringlen() OR to
                                       use sprintf() and a pattern
                                       like "note%d" or whatever... */

   noted = INVALID_PTR;
   changes = 0;
   in_second = FALSE;
   copy_string (">", com_prompt);
}

void free_buffers (NO_PARAMS) {
               /* should call dealloc() or whatever in C -
                  this source was translated from my earlier BCPL one. */
/*
   freevec (a);
   freevec (lim);
   freevec (num);
   freevec (text);
   freevec (link);
   freevec (com);
   freevec (com_prompt);
   freevec (note_file);
*/
}

#if ISO
void local_echo (int *sym) {       /* Later, make this a char fn. */
#else
void local_echo (sym)
  int *sym;
{
#endif
  int lsym;
   if (blank_line) prompt (eprompt);
   lsym = fgetc (tty_in);

   if (lsym == EOF) {

#if ALLOW_INTS
      IntSeen = FALSE;
#if PANOS_CODE
      signal(SIGQUIT, SIG_IGN);
#else
      signal(SIGINT, SIG_IGN);
#endif
      fputc('\n', tty_out); /* Undo the prompt */
#endif

      percent ('c');
      exit (50);
   }

   if (log_out != NULL) {
      fputc (lsym, log_out);
   }
   blank_line = (lsym == cr);
   *sym = lsym;
}

void read_sym (NO_PARAMS) {
   if (pending_sym == 0) {
      do { local_echo (&sym); } while (sym == ' ');
                               /* Better test wanted for noise */
   } else {
      sym = pending_sym;   /* C has an ungetc() but not very standard... */
      pending_sym = 0;
   }
}

#if ISO
bool fail_with (char *mess, char culprit) {
#else
bool fail_with (mess, culprit)
  char *mess;
  char culprit;
{
#endif
 int dirn_sign;

   if (('a' <= culprit) && (culprit <= 'z')) {
      dirn_sign = '-';
   } else {
     if ((culprit & plusbit) != 0) {
        dirn_sign = '+';
     } else {
        dirn_sign = ' ';
     }
   }
   culprit = culprit & (~plusbit);
   if (('A' <= culprit) && (culprit <= 'Z'))
      culprit = culprit | casebit;
   fprintf (stderr, "* %s %c%c\n", mess, culprit, dirn_sign);
   do { read_sym (); } while (sym_type[sym] != sym_type[';']);
   return (ok = FALSE);
}


void read_item(NO_PARAMS) {
   int saved_digit;
   read_sym ();
   if (('a' <= sym) && (sym <= 'z'))
      sym = sym - casebit;
   type = sym_type[sym];
   if ((type & ext) == 0) return;

   switch (type & 15) {

      case star:
         number = 0L;
         return;

      case pling:
         number = stopper-1;
         return;

      case dig:
         saved_digit = sym;
         number = 0L;
         do {
            number = (number * 10) + (sym - '0');
            read_sym();
         } while (('0' <= sym) && (sym <= '9'));
         pending_sym = sym;
         sym = saved_digit; /* for printing in errors */
         return;

      default:
         return;
   }
}

#if ISO
void percent (char Command_sym) {
#else
void percent (Command_sym)
  char Command_sym;
{
#endif
   static char note_sec = '0'; /* This one MUST be a static */
   char Emergency[256];
   cindex P;
   int p;
   int sec_no; /************ sec_no is also an int for now -
                                because local_echo(&sym) expects it to be! */
   bool file_wanted; /* %s2 or %s2=fred ? */
   char sec_file[256], *sec_filep;
   ok = TRUE;
   if (!(('a' <= Command_sym | casebit) && (Command_sym | casebit <= 'z'))) {
      VOID fail_with ("letter for", '%');
      return;
   }
   switch (Command_sym) {

      case 'L':
         to_upper_case = ~0;
         to_lower_case = casebit;
/*         to_lower_case = 0; ---- standard ecce */
         caseflip = 0;
         break;

      case 'U':
         to_upper_case = ~casebit;
         to_lower_case = 0;
/*         to_lower_case = casebit; ---- standard ecce */
         caseflip = 0;
         break;

      case 'N':
         to_upper_case = ~0;
         to_lower_case = 0;
         caseflip = casebit;
         break;

      case 'E':
         to_upper_case = ~casebit; /* Only for searches - not in C command */
         to_lower_case = 0;
         caseflip = casebit;
         break;

      case 'V':
         fprintf (tty_out, "Ecce V2.5 in C Wed Jan 25 11:17:12 GMT 1989\n");
         break;

      case 'W':
      case 'C':
         do { read_sym (); } while (sym_type[sym] != sym_type[';']);
   
         if (ARGV[T] == NULL) {  /* ARGC == 2 => "from" only */
            p = F;         /* So use input file as output file */
         } else {
            p = T;
         }
      case 'c':
         if (in_second) { /* Copied bit */
         /*************** This block is copied from the %S code below;
           it ensures that the main edit buffer is pulled in when closing
           the edit and writing out the file.  This is a quick hack: I
           should change this and the copy in percent('S') so that both
           share the same subroutine ensure_main_edit() *****************/
            FILE *sec_out = fopen (note_file, WRITE);
            copy_string (">", com_prompt);
            if (sec_out == NULL) {
               VOID fail_with ("Cannot save context", ' ');
               break;
            }
            P = fbeg;
            for (;;) {
               if (P == pp) P = fp;
               if (P == fend) break;
               fputc (*P++, sec_out);
            }
            fclose (sec_out);
            pp = fbeg - 1;
            fp = fend + 1;
            fbeg = a+1;
            fend = a+buffer_size;
            lbeg = pp;
            do { --lbeg; } while (*lbeg != cr);
            lbeg++;
            lend = fp;
            while (*lend != cr) lend++;
            in_second = FALSE;
/*
            if (sec_no == 0) {
               / * do nothing. Else note it and re-select it if this is
                  a percent('W') ! * /
            }
 */
         }  /* End of copied bit */
         if (Command_sym == 'c') {
            ARGV[p] = A1EMERGENCY;
            main_out = fopen (ARGV[p], WRITE);
            if (main_out == 0) {
               ARGV[p] = A2EMERGENCY;
               main_out = fopen (ARGV[p], WRITE);
            }
            if (main_out == 0) {
               fprintf(stderr,
                       "Sorry - I can't save your edit (I tried hard...)\n");
               exit(90);
            }
            fprintf (tty_out, "Ecce abandoned: saving to %s\n", ARGV[F]);
         } else {
            main_out = fopen (ARGV[p], WRITE);
            if (main_out == 0) {
   
               fprintf (stderr,
                        "Can't create \"%s\" - supply alternative filename\n",
                        ARGV[p]);
   
/*               for (;;) {*/
                  eprompt = "File: ";
                  /* Read line to Emergency[] */
                  copy_string(ECCETMP, Emergency);
                  main_out = fopen (Emergency, WRITE);
/*                  if (main_out != NULL) break;*/
/*               }*/
   
               fprintf (stderr,
                  "Writing to file %s instead of %s\n", Emergency, ARGV[p]   );
            } else {
               if (p == T) {
                  fprintf (tty_out,
                           "Ecce %s to %s completing.\n", ARGV[F], ARGV[T]);
               } else {
                  fprintf (tty_out, "Ecce %s completing.\n", ARGV[F]);
               }
            }
         }
         /* ********* SERIOUS BUG!!! If in secondary input buffer, wrong
                      buffer is written out to output file!!! */
         P = fbeg;
         for (;;) {
            if (P == pp) P = fp;
            if (P == fend) break;
            fputc (*P++, main_out);
         }
         fclose (main_out);

         if (Command_sym == 'W') {
            pending_sym = cr;
            break;
         }

         if (log_out != NULL) {
            fclose (log_out);
         }
/*         fprintf (tty_out, "Ecce complete\n");      */
         free_buffers ();
         exit (0);

      case 'A':
         if (log_out != NULL) {
            fclose (log_out);
         }
         fprintf (stderr, "\nAborted!\n");
         free_buffers ();
         exit (60);

      case 'S':
         local_echo (&sec_no);
         file_wanted = FALSE;
         if (sym_type[sec_no] == sym_type[';']) {sec_no = 0;}
           /* '\0' means main '0' means 0,
              so a plain '%s' in secondary input means switch back to
              main and in main means switch to 0. */
         else if (sec_no == '=') {sec_no = '0'; file_wanted = TRUE;}
           /* Here '0' is explicit because we never want to switch to
              main with a '%s=fred' call. */
         else  {
            if (sec_no == '!') {sec_no = '?';}
            else if (sec_no == '=') {sec_no = '0'; file_wanted = TRUE;}
            else if (!(('0' <= sec_no) && (sec_no <= '9'))) {
               VOID fail_with ("%S", sec_no);
               return;
            }
            local_echo (&sym);
            if (sym == '=') {
               file_wanted = TRUE;
            } else if (sym_type[sym] != sym_type[';']) {
               VOID fail_with ("%S?", sym);
               return;
            }
         }
         if (file_wanted) {
           sec_filep = &sec_file[0];
           do {
             read_sym();
             *sec_filep++ = sym;
           } while (sym != '\n');
           *--sec_filep = '\0';
         }
         pending_sym = cr;
         note_file[NOTE_DISTINCT] = note_sec;
         if (in_second) {
            FILE *sec_out = fopen (note_file, WRITE);
            copy_string (">", com_prompt);
            if (sec_out == NULL) {
               VOID fail_with ("Cannot save context", ' ');
               return;
            }
            P = fbeg;
            for (;;) {
               if (P == pp) P = fp;
               if (P == fend) break;
               fputc (*P++, sec_out);
            }
            fclose (sec_out);
            pp = fbeg - 1;
            fp = fend + 1;
            fbeg = a+1;
            fend = a+buffer_size;
            lbeg = pp;
            do { --lbeg; } while (*lbeg != cr);
            lbeg++;
            lend = fp;
            while (*lend != cr) lend++;
            in_second = FALSE;
            if (sec_no == 0) {
               return;
            }
         }
         if (sec_no == 0) sec_no = '0';
         note_file[NOTE_DISTINCT] = sec_no;
         note_sec = sec_no;
         {
            FILE *sec_in = (file_wanted
                             ? fopen (sec_file, READ)
                             : fopen (note_file, READ));
            if (sec_in == NULL) {
               if (file_wanted) {
                  VOID fail_with ("Cannot open file", sym);
               } else {
                  VOID fail_with ("Unknown context", sym);
               }
               return;
            }
            copy_string ("X>", com_prompt);
            com_prompt[0] = sec_no;
            in_second = TRUE;
            *pp = cr;

            fbeg = pp + 1;
            fend = fp - 1;
            pp = fbeg;
            fp = fend;
            *fend = cr;
            lbeg = pp;
            P = pp;
            for (;;) {
               sym = fgetc(sec_in);
               if (sym == EOF) break;
               *P++ = sym;
               if (P == fend) {
                  VOID fail_with ("%S corrupt - no room", ' ');
                  fclose (sec_in);
                  return;
               }
            }
            fclose (sec_in);
            while (P != pp) *--fp = *--P;
            lend = fp;
            while (*lend != cr) lend++;
         }
         break;

      default:
         VOID fail_with ("Percent", Command_sym);
   }
   do { read_sym(); } while (sym_type[sym] != sym_type[';']);
}

void unchain(NO_PARAMS) {
   do {
      pointer = last_unit;
      if (pointer < 0) return;
      last_unit = link[pointer];
      link[pointer] = this_unit;
   } while (com[pointer] != '(');
}

void stack(NO_PARAMS) {
   com[this_unit]  = command;
   link[this_unit] = pointer;
   num[this_unit]  = repeat_count;
   lim[this_unit]  = limit;
   this_unit++;
}

/*------------------------------------------------------------------------*/
#ifdef DEBUG
#define dbug(s) \
fprintf(stderr,\
"%s(); this_unit=%d, com=%c (%c), link=%d, repeat=%d\n",\
s, this_unit, com[this_unit], command, link[this_unit], repeat_count);
#else
#define dbug(s) /* do nothing */
#endif
/*------------------------------------------------------------------------*/
void execute_command(NO_PARAMS) {
   cindex i;
   int sym;

   ok = TRUE;
   switch (command & (~plusbit)) {

      case 'p':
      case 'P':
         printed = TRUE;
         i = lbeg;
         for (;;) {
            if (i == noted) {
               fprintf (tty_out, "*** Note ***");
               if (i == lbeg) fputc ('\n', tty_out);
            }
            if (i == pp) {
               if (i != lbeg) fputc ('^', tty_out);
               i = fp;
            }
            if (i == lend) break;
            sym = (*i++)&255;
            /* should re-order tests below for speed:
                (check 32 <= sym <= 126 first) */
#if EIGHTBITS
            if (sym > 127) {
               fputc (sym, tty_out);/* possibly in inverse video highlight? */
            } else if ((sym < 32) || (sym == 127)) {
               fprintf (tty_out, "<%d>", sym);      /* or %2x ? */
#else
            if ((sym < 32) || (sym >= 127)) {
               fprintf (tty_out, "<%d>", sym);      /* or %2x ? */
#endif
            } else fputc (sym, tty_out);
         }
         if (i == fend) fprintf (tty_out, "*** End ***");
         fputc ('\n', tty_out);
         if (repeat_count == 1L) return;
         if ((command & minusbit) != 0) {
            move_back (); left_star();
         } else {
            move ();
         }
         return;

      case 'g':
      case 'G':
         local_echo (&sym);
         if (sym == ':') {
            local_echo (&sym);
            pending_sym = sym;
            if (sym != cr)
               printed = TRUE;
            ok = FALSE;
            return;
         }
         left_star();
         for (;;) {
            *pp++ = sym;
            if (sym == cr) break;
            local_echo (&sym);
         }
         lbeg = pp;
         if ((command & minusbit) != 0) {
            move_back();
            printed = TRUE;
         }
         return;

      case 'E':
         if (fp == lend) {
            ok = FALSE;
            return;
         }
         if (repeat_count == 0L) {
            fp = lend;
            ok = FALSE;
         } else fp++;
         return;

      case 'e':
         if (pp == lbeg) {
            ok = FALSE;
            return;
         }
         if (repeat_count == 0L) {
            pp = lbeg;
            ok = FALSE;
         } else --pp;
         return;

      case 'C':
         if (fp == lend) {
            ok = FALSE;
            return;
         }
         sym = *fp++;
         if (('a' <= (sym | casebit)) && ((sym | casebit) <= 'z')) {
            if (caseflip != 0) {
               *pp++ = sym ^ casebit;
            } else {
               *pp++ = ((sym ^ casebit) | to_lower_case) & to_upper_case;
            }
         } else {
            *pp++ = sym;
         }
         return;

      case 'c':
         if (pp == lbeg) {
            ok = FALSE;
            return;
         }
         sym = *--pp;
         if (('a' <= (sym | casebit)) && ((sym | casebit) <= 'z')) {
            if (caseflip != 0) {
               *--fp = sym ^ casebit;
            } else {
               *--fp = ((sym ^ casebit) | to_lower_case) & to_upper_case;
            }
         } else {
            *--fp = sym;
         }
         return;

      case 'l':
      case 'R':
         if (repeat_count == 0L) {
            right_star();
            ok = FALSE;
         } else VOID right ();
         ms_back = INVALID_PTR;  /* Should change all these '-1's to INVALID_PTR
 */
         return;

      case 'r':
      case 'L':
         if (repeat_count == 0L) {
            left_star();
            ok = FALSE;
         } else VOID left ();
         ms = INVALID_PTR;
         return;

      case 'B':
         *pp++ = cr;
         lbeg = pp;
         return;

      case 'b':
         *--fp = cr;
         lend = fp;
         return;

      case 'J':
         right_star();
         if (fp == fend) {
            ok = FALSE;
            return;
         }
         lend = ++fp;
         while (*lend != cr)
            lend++;
         return;

      case 'j':
         left_star();
         if (pp == fbeg) {
            ok = FALSE;
            return;
         }
         lbeg = --pp;
         do { --lbeg; } while (*lbeg != cr);
         lbeg++;
         return;

      case 'M':
         if (repeat_count == 0L) {
            move_star();
            ok = FALSE;
         } else {
            move ();
         }
         return;

      case 'm':
         if (repeat_count == 0L) {
            move_back_star();
            ok = FALSE;
         } else {
            move_back(); left_star(); /* Edinburgh compatibility */
         }
         return;

      case 'k':
      case 'K':
         if ((command & minusbit) != 0) {
            move_back();
            if (!ok) return;
         }
         pp = lbeg;
         fp = lend;
         if (lend == fend) {
            ok = FALSE;
            return;
         }
         lend = ++fp ;
         while (*lend != cr) lend++;
         return;

      case 'V':
         VOID verify ();
         return;

      case 'v':
         VOID verify_back ();
         return;

      case 'F':
         VOID find ();
         return;

      case 'f':
         VOID find_back ();
         return;

      case 'U':
         if (!find ()) return;
         pp = pp_before;
         lbeg = pp;
         do { --lbeg; } while (*lbeg != cr);
         lbeg++;
         return;

      case 'u':
         if (!find_back ()) return;
         fp = fp_before;
         lend = fp;
         while (*lend != cr)
            lend++;
         return;

      case 'D':
         if (!find ()) return;
         fp = ml;
         ms = fp;
         return;

      case 'd':
         if (!find_back ()) return;
         pp = ml_back;
         ms_back = pp;
         return;

      case 'T':
         if (!find ()) return;
         while (fp != ml) *pp++ = *fp++;
         return;

      case 't':
         if (!find_back ()) return;
         while (pp != ml_back) *--fp = *--pp;
         return;

      case 'I':
         insert ();
         return;

      case 'i':
         insert_back ();
         return;

      case 's':
      case 'S':
         if (fp == ms) {
            fp = ml;
         } else if (pp == ms_back) {
            pp = ml_back;
         } else {
            ok = FALSE;
            return;
         }
         if ((command & minusbit) != 0) {
            insert_back ();
         } else {
            insert ();
         }
         return;

      case '(':
         dbug("execute_command#1");
         num[pointer] = repeat_count;
         repeat_count = 1L;
         dbug("execute_command#2");
         return;

      case ')':
         dbug("execute_command#3");
         --(num[this_unit]);
         if ((0 != num[this_unit]) && (num[this_unit] != stopper)) {
            dbug("execute_command#4");
            this_unit = pointer;
         }
         repeat_count = 1L;
         dbug("execute_command#5");
         return;

      case '\\':
         dbug("execute_command#6");
         ok = FALSE;
         return;

      case '?':
         dbug("execute_command#7");
         return;

      case ',':
         dbug("execute_command#8");
         this_unit = pointer - 1;
         dbug("execute_command#9");
         return;

      case 'N':
         noted = pp;
         changes = fp-pp;
         return;

      case 'A':
         if ((noted == INVALID_PTR)
          || (noted >= pp)
          || (changes != fp-pp)) {                    /*BUG*/
            ok = FALSE;
            return;
         }
         note_file[NOTE_DISTINCT] = lim[this_unit]+'0';
         {
            FILE *note_out = fopen (note_file, WRITE);
            cindex p = noted;

            if (note_out == NULL) {
               ok = FALSE;
               return;
            }

            do {
               fputc (*p++, note_out);
            } while (p != pp);

            fclose (note_out);

            pp = noted;
            lbeg = pp;
            do { --lbeg; } while (*lbeg != cr);
            lbeg++;
         }
         noted = INVALID_PTR;
         return;

      case 'H':
         note_file[NOTE_DISTINCT] = lim[this_unit]+'0';
         {
            FILE *note_in = fopen (note_file, READ);
            if (note_in == NULL) {
               ok = FALSE;
               return;
            }

            { cindex p = pp;

               for (;;) {
                  sym = fgetc(note_in);
                  if (sym == EOF) break;
                  *p++ = sym;
                  if (p == fp) {
                     fclose (note_in);
                     ok = FALSE;
                     return;
                  }
               }
               pp = p;
            }
            lbeg = pp;
            do { --lbeg; } while (*lbeg != cr);
            lbeg++;
            fclose (note_in);
         }
         return;

      default:
         VOID fail_with ("Unrecognised command", command);
         return;
   }
}

void Scan_sign(NO_PARAMS) {
   read_sym ();
   if (sym_type[sym] == sym_type['+']) {
      command = command | plusbit;
   } else if ((sym_type[sym] == sym_type['-']) &&
            (('A' <= command) && (command <= 'Z'))) {
      command = command | minusbit;
   } else {
      pending_sym = sym;
   }
}

void Scan_scope(NO_PARAMS) {                      /* ditto macro */
   number = 1L;
   if (('D' != (command && (~(minusbit | plusbit)))) &&
                ((command && (~(minusbit | plusbit))) != 'U')) number = 0L;
   read_item ();
   if ((type & numb) == 0) pending_sym = sym;
   limit = number;
   if (('H' == command) || (command == 'A')) {
      if (!((0L <= limit) && (limit <= 9L))) limit = '?'-'0';
   }
}
 
void Scan_text(NO_PARAMS) {
   char last;

   read_sym ();
   last = sym;
   if ((sym_type[sym] & delim) == 0) {
      pending_sym = sym;
      VOID fail_with ("Text for", command);
      return;
   }
   if (('a' <= command) && (command <= 'z')) {
      text[endpos] = 0;
      for (;;) {
         local_echo (&sym);
         if (sym == last) break;
         if (sym == cr) {
            pending_sym = cr;
            break;
         }
         text[--endpos] = sym;
      }
      pointer = endpos--;
   } else {
      pointer = pos;
      for (;;) {
         local_echo (&sym);
         if (sym == last) break;
         if (sym == cr) {
            pending_sym = cr;
            break;
         }
         text[pos++] = sym;
      }
      text[pos++] = 0;
   }
   ok = TRUE;
}

void Scan_repeat (NO_PARAMS) {
   number = 1L;
   read_item ();
   if ((type & numb) == 0) pending_sym = sym;
   repeat_count = number;
}

bool analyse (NO_PARAMS) {
   int saved_type;

   ok = TRUE;
   pos = 0;
   endpos = Max_command_units;
   this_unit = 0;
   last_unit = -1;
   eprompt = com_prompt;
   do { read_item (); } while (type == sym_type[';']);
   command = sym;
   if (command == '%') {
      read_sym();
      if (sym_type[sym] == sym_type[';']) {
         pending_sym = sym;
         sym = 0;
      }
      percent (((('a' <= sym) && (sym <= 'z')) ? (sym - casebit) : sym  ));
      return (ok = FALSE); /* to inhibit execution */
   }
   if ((type & numb) != 0) {
      if (max_unit > 0) {
         num[max_unit] = number;
      } else {
         return (ok = FALSE);
      }
      read_item();
      if (type != sym_type[';'])
         VOID fail_with ("?", sym);
      pending_sym = sym;
      return (ok);
   }
   for (;;) {  /* on items */
      if ((type & err) != 0) {
         return (fail_with ("Command", command));
      }
      if ((type & delim) != 0) {
         return (fail_with ("Command before", command));
      }
      if ((type & numb) != 0) {
         return (fail_with ("Unexpected repetition count", command));
      }
      limit = 0L;
      pointer = 0;
      repeat_count = 1L;
      if ((type & ext) == 0) {
         saved_type = type;           /* All this needs a tidy-up */
         if ((saved_type & sign) != 0) Scan_sign ();
         if ((saved_type & scope) != 0) Scan_scope ();
         if ((saved_type & txt) != 0) Scan_text ();
         if (!ok) return (ok);
         if ((saved_type & rep) != 0) Scan_repeat ();
         type = saved_type;
      } else {
         switch (type & 15) {

            case termin:
               pending_sym = cr;  /* for skipping on error */
               unchain ();
               if (pointer >= 0) {
                  return (fail_with ("Missing", ')'));
               }
               max_unit = this_unit;
               repeat_count = 1L;
               command = ')';
               stack ();
               command = 0;
               stack ();
               return (ok);

            case lpar:
               command = '(';
               pointer = last_unit;
               last_unit = this_unit;
               break;

            case comma:
               command = ',';
               pointer = last_unit;
               last_unit = this_unit;
               break;

            case rpar:
               command = ')';
               Scan_repeat ();
               unchain ();
               if (pointer < 0) {
                  return (fail_with ("Missing", '('));
               }
               num[pointer] = repeat_count;
               break;
         }
      }
      stack ();
      read_item ();
      command = sym;
   }  /* on items */
/* NOT REACHED */
   return (ok);
}

void load_file (NO_PARAMS) {
   cindex p = fbeg;
   int sym;

   sym = fgetc(main_in);
   while (sym != EOF) {
      *p++ = sym;
      if (p == fend) {
         fprintf (stderr, "* File too large!\n");
         percent ('A');
      }
      sym = fgetc(main_in);
   }
   fclose (main_in);

   while (p != fbeg) *--fp = *--p;
   lend = fp;
   while (*lend != cr)
      lend++;
}

bool execute_unit (NO_PARAMS) {
   char culprit;

   command = com[this_unit];
   culprit = command;
   pointer = link[this_unit];

   repeat_count = num[this_unit];
   dbug("execute_unit");
   for (;;) {  /* On repeats of this_unit */
      if (IntSeen) {
        dbug("execute_unit#1");
        return (ok = FALSE);
      }
      execute_command ();
      --repeat_count;
      if (ok) {
         if (repeat_count == 0L || repeat_count == stopper) {
           dbug("execute_unit#2");
           return (ok);
         }
         continue;
      }
      ok = TRUE;
      for (;;) {  /* scanning for end of unit (e_g_ ')') */
         if (IntSeen) {
           dbug("execute_unit#3");
           return (ok = FALSE);
         }
         if (repeat_count < 0L ) {
           if (com[this_unit+1] == '\\') {
              this_unit++;
              dbug("execute_unit#4");
              return (ok = FALSE);
           }
           dbug("execute_unit#5");
           return (ok);
         }
         if ((com[this_unit+1] == '\\') || (com[this_unit+1] == '?')) {
            this_unit++;
            dbug("execute_unit#4");
            return (ok);
         }
/* indefinite repetition never fails (although it did till I found the bug!) */
         for (;;) {  /* scanning for end of sequence */
            if (IntSeen) {
              dbug("execute_unit#6");
              return (ok = FALSE);
            }
            this_unit++;
            command = com[this_unit];
            switch (command) {

               case '(':
                  this_unit = link[this_unit];
                  break; /* Skip over (...) as if it were single command. */

               case ',':
                  dbug("execute_unit#7");
                  return (ok);

               case ')': /* Should test for '\\' and '?' following? */
                  --num[this_unit];
                  repeat_count = num[this_unit];
                  dbug("execute_unit#9");
                  /* A bug was fixed here: something got lost in the
                     translation from BCPL to C -- the line below was
                     a 'break' which unfortunately broke out of the
                     enclosing case statement rather than the desired
                     for-loop! */
                  /* rely on enclosing for-loop to handle \ and ? correctly! */
                  goto breaklab;

               default: /* Possible bugfix - what happens on missing cases? */;
            }
            if (com[this_unit] == 0) {/* 0 denotes end of command-line. */
               dbug("execute_unit#10");
               return (fail_with ("Failure:", culprit));
            }
         }  /* end of seq */
         breaklab: ;
         dbug("execute_unit#11");
      }  /* find () ')' without \ or ? */
      dbug("execute_unit#12");
   } /* executing repeats */
   dbug("execute_unit#13");
/* NOT REACHED */
   return (ok);
}

void execute_all (NO_PARAMS) {
   eprompt = ":";
   this_unit = 0;
   dbug("execute_all");
   do {
      if (!execute_unit()) {
        dbug("execute_all#1");
      	return;
      }
      if (IntSeen) {
        dbug("execute_all#2");
        return;
      }
      this_unit++;
   } while (com[this_unit] != 0);
   dbug("execute_all#3");
   ok = TRUE;
}

#if ISO
char case_op (char sym) {               /* should be made a macro */
#else
char case_op (sym)
  char sym;
{
#endif
int chr = sym | casebit;
   if (('a' <= chr) && (chr <= 'z')) sym = (sym | to_lower_case)
                                                & to_upper_case;
   return (sym);
}

bool right (NO_PARAMS) {
   if (fp == lend) {
      return (ok = FALSE);
   }
   *pp++ = *fp++;
   return (ok = TRUE);
}

bool left (NO_PARAMS) {
   if (pp == lbeg) {
      return (ok = FALSE);
   }
   *--fp = *--pp;
   return (ok = TRUE);
}

void right_star(NO_PARAMS) {                      /* Another macro */
   while (fp != lend) *pp++ = *fp++;
}

void left_star(NO_PARAMS) {                       /* Likewise... */
   while (pp != lbeg) *--fp = *--pp;
}

void move (NO_PARAMS) {
   ok = TRUE;
   right_star ();
   if (fp == fend) {
      ok = FALSE;
      return;
   }
   *pp++ = *fp++;
   lbeg = pp;
   lend = fp;
   while (*lend != cr) lend++;
   ms_back = INVALID_PTR;
}

void move_back(NO_PARAMS) {
   ok = TRUE;
   left_star ();
   if (pp == fbeg) {
      ok = FALSE;
      return;
   }
   *--fp = *--pp;
   lend = fp;
   lbeg = pp;
   do { --lbeg; } while (*lbeg != cr);
   lbeg++;
   ms = INVALID_PTR;
}

void move_star (NO_PARAMS) {
   while (fp != fend) *pp++ = *fp++;
   lend = fend;
   lbeg = pp;
   do { --lbeg; } while (*lbeg != cr);
   lbeg++;
   ms_back = INVALID_PTR;
}

void move_back_star (NO_PARAMS) {
   while (pp != fbeg) *--fp = *--pp;
   lbeg = fbeg;
   lend = fp;
   while (*lend != cr)
      lend++;
   ms = INVALID_PTR;
}

void insert (NO_PARAMS) {
   int p = pointer;
   ml_back = pp;
   while (text[p] != 0) *pp++ = text[p++];
   ms_back = pp;
   ms = INVALID_PTR;
}

void insert_back (NO_PARAMS) {
   int p = pointer;
   ml = fp;
   while (text[p] != 0) *--fp = text[p++];
   ms = fp;
   ms_back = INVALID_PTR;
}

bool verify(NO_PARAMS) {
   int x = pointer;
   cindex y = fp-1;
   char if_sym;
   char sym ;

   do {
      sym = case_op (text[x++]);
      if_sym = case_op (*++y);
   } while (sym == if_sym);

   if (sym != 0) return (ok = FALSE);

   ms = fp;
   ml = y;
   ms_back = INVALID_PTR;

   return (ok = TRUE);
}

bool verify_back (NO_PARAMS) {
   int x = pointer - 1;
   int y = 0;
   char if_sym;
   char sym;

   do {
      sym = case_op (text[++x]);
      if_sym = case_op (*(pp - ++y));
   } while (sym == if_sym);

   if (sym != 0) return (ok = FALSE);

   ms_back = pp;
   ml_back = pp - y + 1;
   ms = INVALID_PTR;

   return (ok = TRUE);
}

bool find (NO_PARAMS) {
   char sym = text[pointer] | casebit;       /* Is this a bug? */
                                             /* probably not!  */
   pp_before = pp;
   limit = lim[this_unit];
   if (fp == ms) {
      if (!(right ())) move ();
   }
   for (;;) {
      if ((*fp | casebit) == sym) {
         if (verify ()) return (ok);
      }
      if (!right ()) {
         --limit;
         if (limit == 0L) break;
         move ();
         if (!ok) break;
      }
   }
/*  This is if you do not want a failed find to move the pointer...
   while (pp != pp_before) {
      if (!left ()) move_back();
   }
*/
   return (ok = FALSE);
}

bool find_back (NO_PARAMS) {
   fp_before = fp;
   limit = lim[this_unit];
   if (pp == ms_back) {
      if (!left ()) move_back ();
   }
   for (;;) {
      if (verify_back ()) return(ok);
      if (!left ()) {
         --limit;
         if (limit == 0L) break;
         move_back ();
         if (!ok) break;
      }
   }
/* Again for failed finds...
   while (fp != fp_before) {
      if (!right ()) move ();
   }
*/
   return (ok = FALSE);
}