#ifdef __BCPLUSPLUS__
// old-style C++

// There are some expected warnings under the Borland C++ compiler;
// these pragmas turn them off.
#pragma warn -ext
#pragma warn -sig

// Also, the default stack isn't nearly big enough.
unsigned _stklen=32768U;

// header files have a .h
#include <stdio.h>
#include <iostream.h>
#include <stdlib.h>
#include <ctype.h>
#include <string.h>

#include <cstring.h>
#include <except.h>

#define exception xmsg
#else
// new-style C++
#include <cstdio>
#include <iostream>
#include <cstdlib>
#include <cctype>
#include <cstring>
#include <string>
#include <exception>

#  ifdef __DJGPP__
// This is a bug in my version of DJGPP. This doesn't do anything but suppress
// a fatal linker error; it's correct standard-compliant C++ anyway so it won't
// be a problem even when the bug is fixed.
int finite;
#  endif

using namespace std; 

//define the old-style xmsg
class xmsg : public exception
{
  string w;

public:
  virtual const char* what() const throw ()
    {
      return w.c_str();
    }

  const char* why() const throw()
    { // backwards compatibility
      return what();
    }

  xmsg(string s) : exception() 
    {
      w=s;
    }

  xmsg(const char* a) : exception()
    {
      w=string(a);
    }
  
  ~xmsg() throw () {};
};

#endif

#define MYHEAPSIZE 32766
// My computer runs out of memory before hitting this heap size limit in an
// Overload program.

// wmw-dependent
#define NORMALNUMCHAR1 ':'
#define NORMALNUMCHAR2 '*'

#define DEBUGOV debugov

#define ITOS ((*su)->car)
#define TOS (su->car)

#define OVCMD(a) InsBefore(&ITOS, new TListEl("(" #a ")",1),1); goto eval
#define OVCMD2(a) InsBefore(&ITOS, new TListEl("(" a ")",1),1); goto eval

// A list may or may not have a listend element;
// any element with no cdr is automatically end-of-list.
enum TLEType {nonquoting=0, quoting=1, pointer=2, listend=3};
enum TCompress {notcompressed=0, normalint=1};

class TListEl;

TListEl** ListElList;

int debugov=1;
// Debug levels:
// 3: Display memory allocation and 2
// 2: Display program state every step, pressing [Return]
// 1: Display program state every step, not pausing
// 0: Don't debug

class TListEl
{
public:
  // Data
  TListEl* car; //first child
  TListEl* cdr; //next sibling
  TListEl* uncar; //parent if first child; either parent or 0 if younger child
  TListEl* uncdr; //previous sibling
  TListEl* pointsto; //target of pointer here
  TLEType LEType; //quoting, nonquoting, pointer, listend
  TCompress compressed; //what compression scheme is used here?
  unsigned long compressedto; //data used by compressor

  // Memory management
  int gcstatus;
  size_t lelpos;
  TListEl* copiedto;

  // Helper functions
  void ClearPointers(void)
    {
      car=cdr=uncar=uncdr=pointsto=copiedto=0;
    };
  void MarkGC(int m, int p);
  void PointerUpdate(int m);
  void Decompress(void);
  void EnsureCar(void);
  void EnsureCdr(void);
  void EnsureUncar(void);
  void Collapse(void);

  // Output
  string ToString(int,TListEl*,TListEl*);

  // Construction, destruction, and allocation
  TListEl(void)
    {
      ClearPointers();
      compressed=normalint;
      compressedto=1;
      gcstatus=0;
      LEType=nonquoting;
    };
  TListEl(TListEl* copyfrom,int);
  TListEl(TListEl* pointsto);
  TListEl(const char*,int);
  TListEl(const unsigned long,TLEType);
  void* operator new(size_t sz);
  void operator delete(void* p);
  operator unsigned long(void);
};

TListEl::operator unsigned long(void)
{
  if(compressed==normalint) return compressedto;
  else if(car)
  {
    unsigned long pbil[200];
    int pbilloc=1;
    pbil[0]=1;
    TListEl* t=car;
    while(t&&t->LEType!=listend)
    {
      switch(((unsigned long)*t)-1)
      {
      case ':':
        pbil[pbilloc]=pbil[pbilloc-1];
        pbilloc++;
        break;
      case '*':
        pbilloc--;
        pbil[pbilloc-1]+=pbil[pbilloc];
        break;
      case 0: //assume this is () not <> for now
        pbil[pbilloc++]=0;
        break;
      case '!':
        pbilloc--;
        break;
      default:
        throw xmsg("ID:Number representation is too complex to work out "
                   "its value");
      }
      if(pbilloc>=199) throw xmsg("ID:Out of stack translating numeric value");
      t=t->cdr;
      if(!pbilloc) throw xmsg("Err:That function can't be a number "
			      "because it takes 2+ arguments");
    }
    if(pbilloc==1) return pbil[0];
    throw xmsg("Err:That function can't be a number because it "
               "returns 2+ results");
  }
  else if(LEType==listend) {EnsureCdr(); return 1;}
  else throw xmsg("Err:Pointers don't have a numeric value");
}

void TListEl::MarkGC(int m, int p)
{
  TListEl* tailrec=this; //optimize tail-recursion by hand
  TListEl* t;
  while(tailrec)
  {
    t=tailrec;
    tailrec=0;
    if(!(t->gcstatus&m)) //prevent garbage-collection loop
    {
      t->gcstatus|=m;
      if(t->car) tailrec=t->car;
      if(t->cdr) {if(tailrec) tailrec->MarkGC(m,p); tailrec=t->cdr;}
    }
    if(p&&t->pointsto&&t->LEType==pointer)
    {
      if(tailrec) tailrec->MarkGC(m,p);
      t->pointsto->gcstatus|=p;
      tailrec=t->pointsto;
      while(tailrec->uncar||tailrec->uncdr)
      {
        if(tailrec->uncar) tailrec=tailrec->uncar;
        if(tailrec->uncdr) tailrec=tailrec->uncdr;
      }
    }
  }
}

void TListEl::Collapse(void)
{
  TListEl* t=this;
  int instars=1;
  unsigned long starcount=0;
  while(t)
  {
    if(t->car) t->car->Collapse(); //recurse
    if(instars==2)
    { //can't collapse this, look for sublists to collapse
      t=t->cdr;
      continue;
    }
    if(t->gcstatus&8)
      instars=2; // there's something pointing here; can't collapse it
    else if(t->LEType==pointer||t->LEType==listend)
      instars=2; // not a list
    else if(t->compressed==normalint&&t->compressedto==NORMALNUMCHAR1+1&&
	    instars)
      starcount++;
    else if(t->compressed==normalint&&t->compressedto==NORMALNUMCHAR2+1&&
	    starcount)
    {
      instars=0;
      starcount--;
      if(!starcount&&(!t->cdr||t->cdr->LEType==listend))
      { // identified a number
	while(t->compressedto==NORMALNUMCHAR2+1)
	{
	  t=t->uncdr;
	  if(!t) throw xmsg("IE:Notational collapser has got confused");
	  starcount++;
	}
	//uncar will be the list that contains this element
	//(which is getting collapsed); this element will be destroyed
	//in the next garbage collection
	uncar->compressedto=starcount+1;
	uncar->compressed=normalint;
	uncar->car=0;
	if(debugov>=3)
	  cerr << "Collapsing list to number $" << hex << starcount+1 << "; ";
	return; // this list no longer exists
      }
      else if(!starcount)
	instars=2;
    }
    else instars=2;
    t=t->cdr;
  }
}

void TListEl::PointerUpdate(int m)
{
  TListEl* tailrec=this; //optimize tail-recursion by hand
  TListEl* t;
  while(tailrec)
  {
    t=tailrec;
    tailrec=0;
    if(t->pointsto&&(t->pointsto->gcstatus&m)&&t->copiedto&&t->pointsto->copiedto)
    {
      if(debugov>=3)
      {
        cerr << "Updating pointer: [_0" << hex << t->lelpos << "] pointing to ]_0" <<
	  t->pointsto->lelpos << "[ which was copied to [_0" <<
	  t->pointsto->copiedto->lelpos << "]; original copied to [_0" <<
	  t->copiedto->lelpos << "]. ";
      }
      t->copiedto->pointsto=t->pointsto->copiedto;
    }
    if(t->car) tailrec=t->car;
    if(t->cdr) {if(tailrec) tailrec->PointerUpdate(m); tailrec=t->cdr;}
  }
}

void TListEl::Decompress(void)
{
  if(compressed!=normalint||(LEType!=nonquoting&&LEType!=quoting)) return;
  compressed=notcompressed;
  if(!compressedto)
  { // wmw-dependent
    car=new TListEl('!'+1,nonquoting); car->uncar=this;
    car->cdr=new TListEl(1,quoting);
    car->cdr->uncdr=car; car->cdr->uncar=this;
    return;
  }
  compressedto--;
  if(!compressedto)
  {
    car=new TListEl;
    car->LEType=listend;
    car->uncar=this;
    return;
  }
  string s; unsigned long ul=compressedto;
  while(ul--) s+=NORMALNUMCHAR1;
  while(compressedto--) s+=NORMALNUMCHAR2;
  car=new TListEl(s.c_str(),0);
  TListEl* e=car;
  while(e) {e->uncar=this; e=e->cdr;}
}

void TListEl::EnsureCar(void)
{
  Decompress();
  if(!car)
  {
    if(LEType==pointer)
    {
      LEType=nonquoting;
      car=new TListEl;
      car->LEType=pointer;
      car->pointsto=pointsto;
      car->uncar=this;
      pointsto=0;
    }
    else if(LEType==listend)
    {
      LEType=nonquoting;
      compressed=normalint;
      compressedto=1;
      Decompress();
    }
    else throw xmsg("IE:car pointer has gone missing in EnsureCar");
  }
}

void TListEl::EnsureCdr(void)
{
  if(cdr) return;
  if(LEType==listend)
  {
    LEType=nonquoting;
    compressed=normalint;
    compressedto=1;
  }
  cdr=new TListEl;
  cdr->uncdr=this;
  cdr->LEType=listend;
  cdr->uncar=this->uncar;
}

void TListEl::EnsureUncar(void)
{
  TListEl* temp=this;
  while(temp->uncdr) temp=temp->uncdr;
  if(!(temp->uncar))
  {
    temp->uncar=new TListEl(1,quoting);
    temp->uncar->car=temp;
    temp->uncar->compressed=notcompressed;
  }
  uncar=temp->uncar;
}

void* TListEl::operator new(size_t sz)
{
  void* a=malloc(sz);
  if(!a) throw xmsg("ID:Out of memory");
  size_t i=MYHEAPSIZE;
  while(i--) {if(!ListElList[i]) break;}
  if(i==((size_t)0-(size_t)1)) throw xmsg("ID:Too many TListEls allocated");
  ((TListEl*)a)->lelpos=i;
  ListElList[i]=(TListEl*)a;
  if(DEBUGOV>=3) cerr << "Allocate [_0" << hex << i << "]; ";
  return a;
}

void TListEl::operator delete(void* p)
{
  if(!p) return;
  if(DEBUGOV>=3) cerr << "Free [_0" << hex << ((TListEl*)p)->lelpos << "]; ";
  ListElList[((TListEl*)p)->lelpos]=0;
  free(p);
}

void ClearGC(void);

// Creates a pointer TListEl.
TListEl::TListEl(TListEl* newtarget)
{
  ClearPointers();
  LEType=pointer;
  compressed=notcompressed;
  pointsto=newtarget;
  gcstatus=0;
}

// Copy constructor. Make a duplicate of the list with internal
// pointers updated.  This uses pointers rather than references, to
// simplify things (in this situation, pointers are simpler than
// references).
TListEl::TListEl(TListEl* copyfrom, int dogcstatus)
{
  ClearPointers();
  if(dogcstatus) {ClearGC(); copyfrom->MarkGC(4,0);}
  copyfrom->copiedto=this;
  if(copyfrom->car) car=new TListEl(copyfrom->car,0);
  if(copyfrom->cdr&&!dogcstatus) cdr=new TListEl(copyfrom->cdr,0);
  if(debugov>=3) cerr << "Copied [_0" << hex << copyfrom->lelpos << "] to [_0"
		      << lelpos << "]; ";
  LEType=copyfrom->LEType;
  compressed=copyfrom->compressed;
  compressedto=copyfrom->compressedto;
  if(car) car->uncar=this;
  if(cdr) cdr->uncdr=this;
  pointsto=copyfrom->pointsto;
  if(dogcstatus)
  {
    copyfrom->PointerUpdate(4); if(dogcstatus!=2) ClearGC();
  }
  gcstatus=0;
}

//Create a ListEl, not connected to anything, that represents an integer/char.
TListEl::TListEl(const unsigned long i, TLEType q)
{
  ClearPointers();
  compressed=normalint;
  compressedto=i;
  gcstatus=0;
  LEType=q;
}

//Translate a string into a set of ListEls. Parsed syntax:
//Most characters represent a nonquoting integer of their character code plus 1.
//A double-quote is an instruction to take the next character literally.
//Quoting sublists are in parentheses, nonquoting sublists are between angle brackets.
//Square brackets are used for various abbreviations:
// ]pointer[ points to [pointer target]
// [(comment)] is ignored altogether
// [#44] represents the string for a number; so ([#56]) is quoting 56, and
//                                              <[#92]> is nonquoting 92.
// [$1b] represents the string for a number, but in hexadecimal.
// The value of parse determines whether these characters are parsed or not.
// If it's 0, a ListEl representing the input string (rather than one represented by
// the input string) is returned.
TListEl::TListEl(const char* s, int parse)
{
  TListEl* temp;
  ClearPointers();
  LEType=nonquoting;
  if(parse)
  {
    if(*s=='\"') s++;
    else if(*s==')'||*s=='>'||!*s) {LEType=listend; gcstatus=0; return;}
    else if(*s=='('||*s=='<')
    {
      int brackmatch=1;
      if(*s=='(') LEType=quoting;
      car=new TListEl(s+1,parse);
      temp=car;
      while(temp) {temp->uncar=this; temp=temp->cdr;}
      compressed=notcompressed;
      while(brackmatch)
      {
        s++; if(*s=='\"') {s++; if(*s) continue;}
        if(*s=='('||*s=='<') brackmatch++;
        if(*s==')'||*s=='>') brackmatch--;
        if(*s=='[') while(*s!=']'&&*s) s++;
        if(!*s) throw xmsg("Err:Unexpected end of string when parsing "
                           "(check brackets are matched)");
      }
    }
    else if(*s=='[')
    {
      if(!s[1]) throw xmsg("Err: Unmatched '[' at end of program");
      else if(s[1]=='(')
      {
	int brackmatch=1;
	while(brackmatch)
	{
	  s++; if(*s=='\"') {s++; if(*s) continue;}
	  if(*s=='('||*s=='<'||*s=='[') brackmatch++;
	  if(*s==')'||*s=='>'||*s==']') brackmatch--;
	  if(!*s) throw xmsg("Err:Unexpected end of string in comment "
			     "(check brackets are matched)");
	}
	s++;
      }
      else throw xmsg("ID:Unimplemented '[' directive");
    }
  }
  if(!car)
  {
    compressed=normalint;
    compressedto=*s+1;
  }
  else compressed=notcompressed;
  gcstatus=0;
  if(*(s+1)) cdr=new TListEl(s+1,parse);
  if(cdr) {cdr->uncdr=this; cdr->uncar=uncar;}
}

// The opposite. If parsed is 0, the ListEl is forced to represent a string;
// if it's 1, a string representing the ListEl is returned.
string TListEl::ToString(int parsed, TListEl* ip, TListEl* su)
{
  string s;
  TListEl* curel=this;
  static char buf[50]; //easily enough to hold a decimal 64-bit number
  while(curel) //this would be better done with recursion but most compilers
  {            //don't optimize tail-recursion, so it's done by hand
    if(parsed)
    {
      if(curel->gcstatus&8)
      {
        sprintf(buf+1,"%lx",(unsigned long)(curel->lelpos));
        *buf='0';
        s+=string("[_")+string(buf)+string("]");
      }
      if(curel==ip) s+=string("[_ip]");
      if(curel==su) s+=string("[_stack]");
      if(curel->LEType==nonquoting&&curel->car)
        s+=string("<")+curel->car->ToString(1,ip,su)+string(">");
      else if(curel->LEType==quoting&&curel->car)
        s+=string("(")+curel->car->ToString(1,ip,su)+string(")");
      else if(curel->LEType==listend) ; //do nothing, listends are invisible
      else if(curel->compressed==normalint&&(curel->LEType==quoting||
					     curel->LEType==nonquoting))
      {
        // If it's printable and nonquoting, just output it as a character,
        // otherwise as a number representation
        if(curel->LEType==nonquoting&&isprint(curel->compressedto-1))
        {
          switch(curel->compressedto-1)
          {
          case '<':case '>':case '(':case ')':case '[':case ']':case '\"':
            s+=(char)'\"'; break;
          }
          s+=(char)(curel->compressedto-1);
        }
        else if(curel->compressedto==1)
        {
          if(curel->LEType==nonquoting) s+=string("<>");
          else if(curel->LEType==quoting) s+=string("()");
          else throw xmsg("IE:Impossible compression to 1 in a ListEl");
        }
        else
        {
          sprintf(buf,"%lx",curel->compressedto);
          if(curel->LEType==nonquoting)
	    s+=string("<[$")+string(buf)+string("]>");
          else if(curel->LEType==quoting)
	    s+=string("([$")+string(buf)+string("])");
          else throw xmsg("IE:Impossible compression method in a ListEl");
        }
      }
      else if(curel->LEType==pointer)
      {
        sprintf(buf+1,"%lx",(unsigned long)(curel->pointsto->lelpos));
        *buf='0';
        s+=string("]_")+string(buf)+string("[");
      }
      else throw xmsg(string("IE:car pointer has gone missing"));
    }
    else
    {
      if(curel->LEType==pointer)
      { //output what's at the other end of the pointer as a string
        curel->pointsto->EnsureCar();
        s+=curel->pointsto->car->ToString(0,0,0);
      }
      else if(curel->LEType==listend) ; //do nothing in this situation
      else s+=(char)(((unsigned long)*curel)-1);
    }
    curel=curel->cdr;
  }
  return s;
}

void ClearGC(void)
{
  size_t ul;
  ul=MYHEAPSIZE;
  while(ul--) if(ListElList[ul])
  {
    ListElList[ul]->gcstatus=0;
    ListElList[ul]->copiedto=0;
  }
}

void GCollect(TListEl* su, TListEl* ip)
{
  size_t ul;
  ul=MYHEAPSIZE;
  //Find the outermost containing list of the ip
  while(ip&&(ip->uncdr||ip->uncar))
  {
    if(ip->uncdr) ip=ip->uncdr;
    if(ip->uncar) ip=ip->uncar;
  }
  while(su&&(su->uncdr||su->uncar))
  {
    if(su->uncdr) su=su->uncdr;
    if(su->uncar) su=su->uncar;
  }
  su->EnsureCar();
  ClearGC();
  if(ip) ip->MarkGC(1,8);
  su->MarkGC(2,8);
  while(ul--) if(ListElList[ul]&&!ListElList[ul]->gcstatus)
    delete ListElList[ul];
}

void CollapseNumbers(void)
{
  size_t ul;
  ul=MYHEAPSIZE;
  while(ul--)
  {
    if(ListElList[ul]&&!ListElList[ul]->uncar&&!ListElList[ul]->uncdr)
      ListElList[ul]->Collapse();
  }
}

void InsBefore(TListEl** before, TListEl* source, int repoint)
{
  TListEl* newcopy=new TListEl(source,1);
  TListEl* temp;
  if(newcopy->LEType==listend)
  {
    newcopy->LEType=nonquoting;
    newcopy->compressed=normalint;
    newcopy->compressedto=1;
  }
  newcopy->uncdr=(*before)->uncdr;
  newcopy->cdr=*before; (*before)->uncdr=newcopy;
  if(newcopy->uncdr) newcopy->uncdr->cdr=newcopy;
  newcopy->uncar=(*before)->uncar;
  if(newcopy->uncar)
    if(newcopy->uncar->car==*before) newcopy->uncar->car=newcopy;
  temp=newcopy;
  while(temp) {temp->uncar=newcopy->uncar; temp=temp->cdr;}
  if(repoint) *before=newcopy;
}

void Detach(TListEl* target)
{
  if(target->uncdr) target->uncdr->cdr=target->cdr;
  if(target->cdr) target->cdr->uncdr=target->uncdr;
  if(target->uncar)
    if(target->uncar->car==target)
    {
      target->uncar->car=target->cdr;
      target->cdr->uncar=target->uncar;
      if(!target->cdr)
      {
	target->uncar->car=new TListEl;
	target->uncar->car->LEType=listend; //must be something in a list
      }
    }
  target->uncar=target->uncdr=target->cdr=0;
}

TListEl* NextIp(TListEl** /*su*/, TListEl** ip)
{
  if(!*ip) return 0;
  if((*ip)->LEType==listend) return 0;
  (*ip)->EnsureCdr();
  return (*ip)->cdr;
}

static int pointerfrozen=0;
void RunCommand(unsigned long cmd, TListEl** su, TListEl** ip)
{
  TListEl* temp, *temp2, *temp3, *temp4;
  unsigned long tempul;
  int tempch;
  if(cmd==0) throw xmsg("Err:Executing nonquoting list with value 0");
  switch(cmd-1) //wmw-dependent
  {
    // Intrinsic commands
  case 'A': //move pointer to its car, or replace list with its car
    if(ITOS->LEType==pointer&&!pointerfrozen)
    {
      ITOS->pointsto->EnsureCar();
      ITOS->pointsto=ITOS->pointsto->car;
    }
    else if((ITOS->LEType==quoting||ITOS->LEType==nonquoting)&&
	    ITOS->car&&ITOS->car->LEType==pointer&&!pointerfrozen)
    {
      ITOS->car->pointsto->EnsureCar();
      ITOS->car->pointsto=ITOS->car->pointsto->car;
    }
    else
    {
      ITOS->EnsureCar();
      temp=ITOS;
      Detach(ITOS);
      InsBefore(&ITOS,temp->car,1);
    }
    break;
  case 'D': //move pointer to its cdr, or replace list with its cdr
    if(ITOS->LEType==pointer&&!pointerfrozen)
    {
      ITOS->pointsto->EnsureCdr();
      ITOS->pointsto=ITOS->pointsto->cdr;
    }
    else if((ITOS->LEType==quoting||ITOS->LEType==nonquoting)&&
	    ITOS->car&&ITOS->car->LEType==pointer&&!pointerfrozen)
    {
      ITOS->car->pointsto->EnsureCdr();
      ITOS->car->pointsto=ITOS->car->pointsto->cdr;
    }
    else
    {
      ITOS->EnsureCar();
      ITOS->car->EnsureCdr();
      Detach(ITOS->car); //leaving only the cdr behind
    }
    break;
  case 'd': //move pointer to its uncdr, or to end if it's at the start
    if(ITOS->LEType==pointer&&!pointerfrozen)
    {
      if(ITOS->pointsto->uncdr)
	ITOS->pointsto=ITOS->pointsto->uncdr;
      else while(ITOS->pointsto->LEType!=listend)
      {
	ITOS->pointsto->EnsureCdr();
	ITOS->pointsto=ITOS->pointsto->cdr;
      }
    }
    else if((ITOS->LEType==quoting||ITOS->LEType==nonquoting)&&
	    ITOS->car&&ITOS->car->LEType==pointer&&!pointerfrozen)
    {
      if(ITOS->car->pointsto->uncdr)
	ITOS->car->pointsto=ITOS->car->pointsto->uncdr;
      else while(ITOS->car->pointsto->LEType!=listend)
      {
	ITOS->car->pointsto->EnsureCdr();
	ITOS->car->pointsto=ITOS->car->pointsto->cdr;
      }
    }
    else throw xmsg("Err:Attempted 'd' on a nonpointer or frozen pointer");
    break;
  case 'a': //move pointer to its uncar, or quote a list
    if(ITOS->LEType==pointer&&!pointerfrozen)
    {
      ITOS->pointsto->EnsureUncar();
      ITOS->pointsto=ITOS->pointsto->uncar;
    }
    else if((ITOS->LEType==quoting||ITOS->LEType==nonquoting)&&
	    ITOS->car&&ITOS->car->LEType==pointer&&!pointerfrozen)
    {
      ITOS->car->pointsto->EnsureUncar();
      ITOS->car->pointsto=ITOS->car->pointsto->uncar;
    }
    else
    {
      temp=ITOS;
      Detach(ITOS);
      InsBefore(&ITOS,new TListEl(1,quoting),1);
      ITOS->EnsureCar();
      ITOS->car=temp;
      temp->uncar=ITOS;
      temp->cdr=0;
    }
    break;
  case ',': //return a pointer to the IP
    temp=new TListEl;
    temp->LEType=pointer;
    temp->pointsto=*ip;
    temp2=new TListEl;
    temp2->compressed=notcompressed;
    temp2->LEType=quoting;
    temp2->car=temp;
    temp->uncar=temp2;
    InsBefore(&ITOS,temp2,1);
    break;
  case '.': //return a pointer to the SP
    if(!pointerfrozen)
    {
      temp=new TListEl;
      temp->LEType=pointer;
      temp->pointsto=ITOS;
      temp2=new TListEl;
      temp2->compressed=notcompressed;
      temp2->LEType=quoting;
      temp2->car=temp;
      temp->uncar=temp2;
      InsBefore(&ITOS,temp2,1);
    }
    else
    {
      temp=ITOS;
      if(temp->LEType!=pointer&&temp->car&&
	 (!temp->car->cdr||temp->car->cdr->LEType==listend))
	temp=temp->car;
      if(temp->LEType!=pointer||!(temp->pointsto))
	throw xmsg("Err:Attempted '.' on a nonpointer with frozen pointers");
      temp=temp->pointsto;
      Detach(ITOS);
      temp->EnsureUncar();
      *su=temp->uncar; //change the stack
    }
    break;
  case '*': //concat second element before first
    ITOS->EnsureCdr();
    ITOS->cdr->EnsureCdr();
    ITOS->EnsureCar();
    ITOS->cdr->EnsureCar();
    temp=ITOS->cdr->car;
    if(temp->LEType==listend)
    {
      Detach(ITOS->cdr); //destroy the second element of the stack, and we're done
      break;
    }
    while(temp->cdr) temp=temp->cdr;
    if(temp->LEType==listend) {temp=temp->uncdr; Detach(temp->cdr);}
    temp->cdr=ITOS->car;
    Detach(ITOS);
    temp->cdr->uncdr=temp;
    while(temp) {temp->uncar=ITOS; temp=temp->cdr;}
    break;
  case '^': //eval
  eval: ITOS->EnsureCar();
  temp=ITOS->car;
  while(temp->cdr) temp=temp->cdr;
  if(temp->LEType!=listend) {temp->EnsureCdr(); temp=temp->cdr;}
  temp->LEType=pointer;
  temp->pointsto=NextIp(su,ip);
  if(temp->pointsto->LEType==pointer)
    temp->pointsto=temp->pointsto->pointsto;
  *ip=ITOS->car;
  Detach(ITOS);
  return;
  case '~': //swap
    ITOS->EnsureCdr();
    ITOS->cdr->EnsureCdr();
    if(ITOS->cdr->cdr) ITOS->cdr->cdr->uncdr=ITOS;
    temp=ITOS->cdr->cdr;
    temp2=ITOS->cdr;
    temp2->cdr=ITOS;
    ITOS->cdr=temp;
    temp2->uncdr=0;
    ITOS->uncdr=temp2;
    temp2->uncar=*su;
    ITOS=temp2;
    break;
  case '@': //deep swap
    ITOS->EnsureCdr();
    ITOS->cdr->EnsureCdr();
    ITOS->cdr->cdr->EnsureCdr();
    temp=ITOS->cdr;
    temp2=ITOS->cdr->cdr;
    if(temp2->cdr) temp2->cdr->uncdr=temp;
    temp->cdr=temp2->cdr;
    temp->uncdr=temp2;
    temp2->cdr=temp;
    temp2->uncdr=ITOS;
    ITOS->cdr=temp2;
    break;
  case '?': //read via pointer
    if(ITOS->LEType==pointer&&!pointerfrozen)
    {
      temp=ITOS->pointsto;
      Detach(ITOS);
      InsBefore(&ITOS,temp,1);
    }
    else if((ITOS->LEType==quoting||ITOS->LEType==nonquoting)&&
	    ITOS->car&&ITOS->car->LEType==pointer&&!pointerfrozen)
    {
      temp=ITOS->car->pointsto;
      Detach(ITOS);
      InsBefore(&ITOS,temp,1);
    }
    else
    {
      throw xmsg("Err:Non-pointer input to '?'");
    }
    break;
  case '=': //write via pointer
    temp=0;
    if(ITOS->LEType==pointer&&!pointerfrozen)
      temp=ITOS->pointsto;
    else if((ITOS->LEType==quoting||ITOS->LEType==nonquoting)&&
	    ITOS->car&&ITOS->car->LEType==pointer&&!pointerfrozen)
      temp=ITOS->car->pointsto;
    if(!temp) throw xmsg("Err:Non-pointer input to '='");
    Detach(ITOS);
    temp->EnsureCdr();
    temp2=temp->cdr;
    Detach(temp);
    InsBefore(&temp2,ITOS,1);
    Detach(ITOS);
    break;
  case '/': //insert SE2 before TOS's target
    temp=0;
    if(ITOS->LEType==pointer&&!pointerfrozen)
      temp=ITOS->pointsto;
    else if((ITOS->LEType==quoting||ITOS->LEType==nonquoting)&&
	    ITOS->car&&ITOS->car->LEType==pointer&&!pointerfrozen)
      temp=ITOS->car->pointsto;
    if(!temp) throw xmsg("Err:Non-pointer input to '/'");
    Detach(ITOS);
    InsBefore(&temp,ITOS,1);
    Detach(ITOS);
    break;
  case '\\': //detach TOS's target
    temp=0;
    if(ITOS->LEType==pointer&&!pointerfrozen)
      temp=ITOS->pointsto;
    else if((ITOS->LEType==quoting||ITOS->LEType==nonquoting)&&
	    ITOS->car&&ITOS->car->LEType==pointer&&!pointerfrozen)
      temp=ITOS->car->pointsto;
    if(!temp) throw xmsg("Err:Non-pointer input to '\\'");
    Detach(ITOS);
    Detach(temp);
    break;
  case 'z': // modify next instruction (freeze pointers)
    pointerfrozen = 2;
    break;
  case 'i': // input one character
    tempch=getchar();
    if(tempch==EOF) tempul=0;
    else tempul=(unsigned long)((unsigned char)(tempch))+1;
    InsBefore(&ITOS,new TListEl(tempul,nonquoting),1);
    break;
  case 'o': // output one character
    tempul=(unsigned long)*ITOS;
    if(!tempul)
    {
      *ip=0;
      return;
    }
    putchar(tempul-1);
    fflush(stdout); //for slow programs without newlines
    Detach(ITOS);
    break;
  case 'c': // call/cc
    tempul=MYHEAPSIZE;
    temp2=0;
    // The purpose of this loop is to link all top-level lists together
    // into one mega-list that contains all information about the program.
    GCollect(*su,*ip);
    temp3=NextIp(su,ip);
    while(tempul--)
    {
      if(ListElList[tempul]&&!(ListElList[tempul]->gcstatus&128)&&
	 (!ListElList[tempul]->uncar)&&(!ListElList[tempul]->uncdr))
      {
	temp=new TListEl(1,quoting);
	temp->car=ListElList[tempul];
	ListElList[tempul]->uncar=temp;
	temp->compressed=notcompressed; //we need to quote each list
	temp->gcstatus=128; //prevent an infinite loop
	if(temp2)
	{
	  temp2->uncdr=temp;
	  temp->cdr=temp2;
	}
	temp2=temp;
      }
    }
    temp=new TListEl(1,quoting);
    temp->car=temp2;
    temp->compressed=notcompressed;
    temp2->uncar=temp;
    GCollect(temp,*ip); //include temp (which contains the stack) in this
    temp2=new TListEl(temp,2); //Copy, updating pointers, keeping GC info
    temp->car->uncar=0;
    temp=temp->car; //the old temp's getting garbage-collected
    //Dequote and delink all the temporarily-linked lists
    while(temp)
    {
      temp->car->uncar=0;
      temp->car=0;
      temp=temp->cdr;
    }
    //To make the copied state into a continuation, we need to append a
    //copy of the IP at the end, prepend each list with z and follow it
    //with z!, and before the IP put code to set the stack pointer to what
    //we want. The copiedto info is still valid and will let us know what
    //the old stack and IP correspond to in the new list. Code is also
    //included to retain TOS through the call, so the continuation can
    //return a value.
    temp=(*su)->copiedto;
    temp3=temp3->copiedto;
    ClearGC(); //GC clear delayed to this point
    temp4=temp2->car;
    //Append a z! to every list
    while(temp4->LEType!=listend)
    {
      temp4->EnsureCdr();
      InsBefore(&temp4,new TListEl('z'+1,nonquoting),0);
      temp4=temp4->cdr;
      InsBefore(&temp4,new TListEl('z'+1,nonquoting),0);
      InsBefore(&temp4,new TListEl('!'+1,nonquoting),0);
    }
    InsBefore(&temp4,new TListEl(1,quoting),1);
    temp4->EnsureCar();
    InsBefore(&(temp4->car), new TListEl(temp), 1);
    temp4=temp4->cdr;
    InsBefore(&temp4, new TListEl(':'+1,nonquoting),0);
    InsBefore(&temp4, new TListEl('A'+1,nonquoting),0);
    InsBefore(&temp4, new TListEl('@'+1,nonquoting),0);
    InsBefore(&temp4, new TListEl('='+1,nonquoting),0);
    InsBefore(&temp4, new TListEl('A'+1,nonquoting),0);
    InsBefore(&temp4, new TListEl('z'+1,nonquoting),0);
    InsBefore(&temp4, new TListEl('.'+1,nonquoting),0);
    InsBefore(&temp4, new TListEl(temp3),0);
    // Move the most-of-a-continuation created rather than the usual copy
    // (we know nothing outside the continuation is pointing to it)
    ITOS->uncdr=temp2;
    temp2->cdr=ITOS;
    ITOS=temp2;
    temp2->uncar=*su;
    // and finally, eval the old TOS.
    OVCMD(~^);
    // break; implied by OVCMD
  case 'C': // capture the state of the program
    InsBefore(&ITOS,new TListEl(1,quoting),1);
    ITOS->EnsureCar();
    tempul=MYHEAPSIZE;
    while(tempul--)
    {
      if(ListElList[tempul]&&
	 (!ListElList[tempul]->uncar)&&(!ListElList[tempul]->uncdr))
      {
	temp=new TListEl(1,quoting);
	InsBefore(&(ITOS->car),temp,1);
	delete temp;
	// We can't rely on auto-garbage-collect for this, because
	// we're messing with the garbage collector to compile the list.
	ITOS->car->LEType=pointer;
	ITOS->car->compressed=notcompressed;
	ITOS->car->pointsto=ListElList[tempul];
      }
    }
    break;

    // Debug commands
  case 27:
    debugov=(unsigned long)*ITOS;
    Detach(ITOS);
    break;

    // Commands with multiple functions, some of which are intrinsic,
    // or where intrinsic code is used to tell between them
  case 'L':
    temp=0;
    if(ITOS->LEType==pointer&&!pointerfrozen)
      temp=ITOS->pointsto;
    else if((ITOS->LEType==quoting||ITOS->LEType==nonquoting)&&
	    ITOS->car&&ITOS->car->LEType==pointer&&!pointerfrozen)
      temp=ITOS->car->pointsto;
    if(!temp) temp=ITOS;
    temp->EnsureCar();
    temp=temp->car;
    tempul=0;
    while(temp&&temp->LEType!=listend)
    {
      temp=temp->cdr;
      tempul++;
    }
    Detach(ITOS);
    InsBefore(&ITOS,new TListEl(tempul,quoting),1);
    break;
  case '-': // numeric subtraction or pointer difference
    temp=0;
    if(ITOS->LEType==pointer&&!pointerfrozen)
      temp=ITOS->pointsto;
    else if((ITOS->LEType==quoting||ITOS->LEType==nonquoting)&&
	    ITOS->car&&ITOS->car->LEType==pointer&&!pointerfrozen)
      temp=ITOS->car->pointsto;
    if(!temp)
    { //numeric subtraction
      ITOS->EnsureCdr();
      tempul=(unsigned long)*ITOS;
      Detach(ITOS);
      ITOS->EnsureCdr();
      if((unsigned long)*ITOS<=tempul)
	tempul=0;
      else
	tempul=(unsigned long)*ITOS-tempul;
      Detach(ITOS);
      InsBefore(&ITOS,new TListEl(tempul,quoting),1);
      break;
    }
    Detach(ITOS); //pointer difference
    if(ITOS->LEType==pointer&&!pointerfrozen)
      temp2=ITOS->pointsto;
    else if((ITOS->LEType==quoting||ITOS->LEType==nonquoting)&&
	    ITOS->car&&ITOS->car->LEType==pointer&&!pointerfrozen)
      temp2=ITOS->car->pointsto;
    else throw xmsg("Err:Top two stack elements must be both pointers or "
		    "both not pointers in '-'");
    Detach(ITOS);
    tempul=0;
    while(temp!=temp2)
    {
      if(!(temp->cdr)||temp->LEType==listend)
      {
	tempul=0;
	break;
      }
      tempul++;
      temp=temp->cdr;
    }
    InsBefore(&ITOS,new TListEl(tempul,quoting),1);
    break;
    // Optimized non-intrinsic commands
  case '\'': // quote one element
    *ip=NextIp(su,ip);
    InsBefore(&ITOS,new TListEl(1,quoting),1);
    ITOS->EnsureCar();
    InsBefore(&(ITOS->car),*ip,1);
    break;
  case ':': // duplicate
    ITOS->EnsureCdr();
    InsBefore(&ITOS,ITOS,1); break;
  case '!': // pop
    ITOS->EnsureCdr();
    temp=ITOS;
    Detach(ITOS);
    if(pointerfrozen&&temp->LEType==quoting||temp->LEType==nonquoting)
    { //Undelimit the list
      temp->EnsureCar();
      temp2=temp->car;
      while(temp2)
      {
	temp2->uncar=0;
	temp2=temp2->cdr;
      }
      temp->car=0;
      temp->compressed=normalint;
      temp->compressedto=1;
    }
    break;
  case '0': InsBefore(&ITOS,new TListEl(0,quoting),1); break; //push a 0
  case '1': InsBefore(&ITOS,new TListEl(1,quoting),1); break; //push a 1
  case '2': InsBefore(&ITOS,new TListEl(2,quoting),1); break; //push a 2
  case '3': InsBefore(&ITOS,new TListEl(3,quoting),1); break; //push a 3
  case '4': InsBefore(&ITOS,new TListEl(4,quoting),1); break; //push a 4
  case '5': InsBefore(&ITOS,new TListEl(5,quoting),1); break; //push a 5
  case '6': InsBefore(&ITOS,new TListEl(6,quoting),1); break; //push a 6
  case '7': InsBefore(&ITOS,new TListEl(7,quoting),1); break; //push a 7
  case '8': InsBefore(&ITOS,new TListEl(8,quoting),1); break; //push an 8
  case '9': InsBefore(&ITOS,new TListEl(9,quoting),1); break; //push a 9
  case 'S': //output ITOS as a string
    ITOS->EnsureCar();
    cout << ITOS->car->ToString(0,0,0);
    Detach(ITOS);
    break;
  case 'n': cout << (char)'\n'; break; //output a newline
  case 'p': //deparse a list into a string. Doesn't include the
    //delimiters of the list itself.
    ITOS->EnsureCar();
    temp=ITOS->car;
    Detach(ITOS);
    temp=new TListEl(temp->ToString(1,0,0).c_str(),0);
    temp2=new TListEl;
    temp2->compressed=notcompressed;
    temp2->LEType=quoting;
    temp2->car=temp;
    temp->uncar=temp2;
    InsBefore(&ITOS,temp2,1);
    break;
  case 'P': //parse a string into a list
    ITOS->EnsureCar();
    temp=ITOS->car;
    Detach(ITOS);
    temp=new TListEl(temp->ToString(0,0,0).c_str(),1);
    temp->EnsureUncar();
    InsBefore(&ITOS,temp->uncar,1);
    break;
  case 'V': //input a number
    tempul=0;
    tempch='0';
    while(isdigit(tempch))
    {
      tempul*=10;
      tempul+=tempch-'0';
      tempch=getchar();
    }
    ungetc(tempch,stdin);
    InsBefore(&ITOS,new TListEl(tempul,quoting),1);
    break;
  case 'v': //output a number
    ITOS->EnsureCdr();
    cout << dec << (unsigned long)*ITOS;
    Detach(ITOS);
    break;
  case 'O': // x 10
    ITOS->EnsureCdr();
    tempul=(unsigned long)*ITOS;
    Detach(ITOS);
    InsBefore(&ITOS,new TListEl(tempul*10,quoting),1);
    break;
  case '}': // increment
    ITOS->EnsureCdr();
    tempul=(unsigned long)*ITOS;
    Detach(ITOS);
    InsBefore(&ITOS,new TListEl(tempul+1,quoting),1);
    break;
  case '{': // decrement
    ITOS->EnsureCdr();
    tempul=(unsigned long)*ITOS;
    Detach(ITOS);
    InsBefore(&ITOS,new TListEl(tempul?tempul-1:0,quoting),1);
    break;
  case 'g': // negate
    ITOS->EnsureCdr();
    tempul=(unsigned long)*ITOS;
    Detach(ITOS);
    InsBefore(&ITOS,new TListEl(!tempul,quoting),1);
    break;
  case '+': // numeric addition
    ITOS->EnsureCdr();
    tempul=(unsigned long)*ITOS;
    Detach(ITOS);
    ITOS->EnsureCdr();
    tempul+=(unsigned long)*ITOS;
    Detach(ITOS);
    InsBefore(&ITOS,new TListEl(tempul,quoting),1);
    break;
  case 'U': // upto (based at 1)
    ITOS->EnsureCdr();
    tempul=(unsigned long)*ITOS;
    Detach(ITOS);
    InsBefore(&ITOS,new TListEl(1,quoting),1);
    ITOS->EnsureCar();
    tempul++;
    while(--tempul) InsBefore(&(ITOS->car), new TListEl(tempul,quoting),1);
    break;
  case 'u': // upto (based at 0)
    ITOS->EnsureCdr();
    tempul=(unsigned long)*ITOS;
    Detach(ITOS);
    InsBefore(&ITOS,new TListEl(1,quoting),1);
    ITOS->EnsureCar();
    tempul++;
    while(tempul--) InsBefore(&(ITOS->car), new TListEl(tempul,quoting),1);
    break;
  case 't': // totalling loop, doesn't quote
    ITOS->EnsureCdr();
    ITOS->cdr->EnsureCar();
    ITOS->cdr->EnsureCdr();
    temp=ITOS->cdr;
    ITOS->cdr=temp->car;
    temp2=temp->car;
    temp2->uncdr=ITOS;
    tempul=0;
    while(temp2->LEType!=listend)
    {
      temp2->uncar=ITOS->uncar;
      temp2->EnsureCdr();
      temp2=temp2->cdr;
      tempul++;
    }
    if(tempul) tempul--;
    temp2->uncdr->cdr=temp->cdr;
    temp->cdr->uncdr=temp2->uncdr;
    temp->car=temp->cdr=temp->uncar=temp->uncdr=0;
    temp->compressed=normalint; temp->compressedto=1;
    temp2->car=temp2->cdr=temp2->uncar=temp2->uncdr=0;
    temp2->compressed=normalint; temp2->compressedto=1;
    InsBefore(&ITOS,new TListEl(tempul,quoting),1);
    InsBefore(&ITOS,new TListEl("(^^)",1),1);
    goto eval;
  case 'T': // totalling loop, quotes
    ITOS->EnsureCdr();
    ITOS->cdr->EnsureCar();
    temp=ITOS->cdr->car;
    temp2=ITOS->cdr;
    tempul=0;
    while(temp&&temp->LEType!=listend)
    {
      InsBefore(&temp2,new TListEl(1,quoting),0);
      temp2->uncdr->car=temp;
      temp2->uncdr->compressed=notcompressed;
      temp->uncar=temp2->uncdr;
      temp->uncdr=0;
      tempul++;
      temp=temp->cdr;
      if(temp) temp->uncdr->cdr=0;
    }
    temp2->car=0;
    temp2->compressed=normalint;
    temp2->compressedto=1;
    Detach(temp2);
    if(tempul) tempul--;
    InsBefore(&ITOS,new TListEl(tempul,quoting),1);
    InsBefore(&ITOS,new TListEl("(^^)",1),1);
    goto eval;
  case ';': //numeric wimpmode
    temp=ITOS;
    while(temp->LEType!=pointer&&!(temp->car&&temp->car->LEType==pointer))
    {
      temp=temp->cdr; //Note: cdr isn't ensured here
      if(!temp) throw xmsg("Err: No pointers on stack in ; command");
    }
    tempul=0;
    while(temp->uncdr)
    {
      temp=temp->uncdr;
      Detach(temp->cdr);
      tempul*=10;
      tempul+=(unsigned long)*temp;
    }
    Detach(temp);
    InsBefore(&ITOS,new TListEl(tempul,quoting),1);
    break;

    // Non-optimized non-intrinsic commands
  case '`': OVCMD(~^); //apply
  case '&': OVCMD(~*); //swapconcat
  case 'l': OVCMD(.A*^); // infinite loop the TOS
  case 'w': OVCMD(.Aza*(~:@^^!)*^); // do-while-loop the TOS, normal
  case 'W': OVCMD(.Aza*(`^)*^); //do-while-loop the TOS, popping
  case 'f': OVCMD(`^); // repeat the TOS SE2 times
  case 'N': OVCMD(0+); //normalize
  case 'e': //each-loop                         (C++ \\ is Overload \)
    OVCMD2("1.~!za*(zA)&(Ad/')*:a'~&(&*)*@T''&&.Add:d\\\\(:@/a?)*^");
  case 's': OVCMD2("':&'~*a(&'`*)*"); //curried substituted application
  case 'k': OVCMD2("a'!&"); //constant-function generator
  case '_': OVCMD2("~zaza'z&'A**^"); //dip
  case 'I': OVCMD2("g'~~^^"); //swap-if
  case 'x': OVCMD2("H.aDA~'Df?"); //read variable
  case 'X': OVCMD2("H.aDA~'Df="); //write variable
#if 0
  case 'O': OVCMD(25**); // times 10
  case '}': OVCMD((:)~*(*)*); // increment
  case '{': OVCMD(:(:)`(!!()())*~(*)`*); //decrement
  case '+': OVCMD2("(})f"); // addition
#endif
  }
  if(pointerfrozen>0) pointerfrozen--;
  *ip=NextIp(su,ip);
}

int main(int argc, char** argv)
{
  size_t ul;
  ListElList=new TListEl*[MYHEAPSIZE];
  ul=MYHEAPSIZE; while(ul--) ListElList[ul]=0;
  // End of initialisation
  try
  {
    TListEl* su=new TListEl; //starts empty
    string prgf;
    FILE* in;
    if(argc>1&&(*argv[1]!='-'||argv[1][1]))
      in=fopen(argv[1],"r");
    else
      in=stdin;
    {
      int c;
      if(!in) throw xmsg(string("Err:Can't open '")+string(argv[1])+
                         string("'"));
      while((c=getc(in))>0) prgf+=(char)c;
      fclose(in);
    }
    if(in!=stdin) fclose(in);
    if(argc>2) sscanf(argv[2],"%d",&debugov);
    TListEl* program=new TListEl(prgf.c_str(),1);
    TListEl* ip=program;
    TListEl* temp;
    GCollect(su,ip);
    while(ip&&ip->LEType!=listend)
    {
      if(ip->LEType==quoting)
      {
	if(pointerfrozen)
	{
	  temp=ip;
	  ip=NextIp(&su,&ip);
	  temp->EnsureCdr();
	  if(temp->uncdr)
	    temp->uncdr->cdr=temp->cdr;
	  else if(temp->uncar)
	  {
	    temp->uncar->car=temp->cdr;
	    temp->cdr->uncar=temp->uncar;
	  }
	  temp->cdr->uncdr=temp->uncdr;
	  su->car->uncdr=temp;
	  temp->cdr=su->car;
	  su->car=temp;
	  temp->uncar=su;
	  temp->uncdr=0;
	  pointerfrozen=0;
	}
	else
	{
	  InsBefore(&TOS,ip,1);
	  ip=NextIp(&su,&ip);
	}
      }
      else if(ip->LEType==pointer)
      {
        ip=ip->pointsto;
      }
      else
      {
	RunCommand((unsigned long)*ip,&su,&ip);
	if(!ip) break;
      }
      GCollect(su,ip);
      ul=ip->gcstatus;
      ip->gcstatus&=8; //don't want this to be collapsed
      CollapseNumbers();
      GCollect(su,ip); //second collection after collapse
      if(debugov>=1)
      {
        ul=MYHEAPSIZE;
        while(ul--)
        {
          program=ListElList[ul];
          if(!program) continue;
          while(program->uncdr||program->uncar)
          {
            if(program->uncdr) program=program->uncdr;
            if(program->uncar) program=program->uncar;
          }
          if(!(program->gcstatus&16))
            cerr << program->ToString(1,ip,su) << (char)'\n';
          program->MarkGC(16,0);
        }
        cerr << (char)'\n';
      }
      if(debugov>=2&&ip) getchar();
    }
  }
  catch(xmsg a)
  {
    cerr << a.why() << (char)'\n';
  }
  catch(...)
  {
    cerr << "IE:Unhandled exception (unknown type).\n";
  }
  // Start of uninitialisation
  ul=MYHEAPSIZE; while(ul--) if(ListElList[ul]) delete ListElList[ul];
  delete ListElList;
  return 0;
}