#include "df0:include/exec/types.h"
#include "df0:include/stdio.h"

#define anzahl 84 /*Diese Konstante muß stimmen, sonst ev. Guru !*/

/*Befehle für dynamische Struturen*/

/* neue Ausgabebefehle */
extern void nprint();
char zp[15];  /*Für die Ausgabe von Zahlen*/
#define dprint(a) sprintf(zp,"%d",a);nprint(zp)

int dateiw=-1L;  /*Dateihandle für Schreiboperationen*/
int dateir=-1L;  /*Handle für Lesedatei*/

extern char* AllocMem();
extern void  FreeMem();
extern ULONG OpenLibrary();
extern ULONG Open();
extern ULONG Read();
extern void fehler(),beenden(),conreinit();
unsigned long int *truedynber=0L,*freizeiger=0L;
ULONG *segmente[257]; /*8 MByte adressierbar*/
int anzSeg; /*Anzahl der belegten 32K-Segmente*/
BYTE bildaus=1;  /*Ausgabe gestattet ?*/
BYTE muell=0;    /*GarbageCollection erforderlich ?*/
char *textpuffer; /* Zeigt auf eingelesenen Programmtext */
char *filepuffer;
WORD *leeres_atom=0L;
extern struct { int knotentyp;
                char zeichenkette[3]; } befzeig[];
/* Lisp-Strukturen */

struct {  int knotentyp;      /*kein Rückgabewert*/
          char zeichenkette;
       } leer;
struct {  int knotentyp;      /*t - Wert*/
          char zeichenkette[2];
       } tr;
WORD *wahr=0L;

struct paar {  int knotentyp;  /* 1 = Punktepaar */
                               /* 2 = Atom */
               WORD *CAR,*CDR; /* 3 = Variablenverkettung */
            };                 /* 4 = Grafikstack */
struct atom {  int knotentyp;         /*Dummy-Struktur*/
               char zeichenkette[2];  /*Länge wird dynamisch festgelegt*/
            };
struct bruch { int knotentyp;     /* spezielles Atom */
               char kennung[2];
               int zaehler,nenner;
             };
struct dezimal{int knotentyp;
               char kennung[2];
               float wert;
              };

/* Speicherverwaltung mit eigener Garbage-Collection */
/* ------------------------------------------------- */

#define wait { int i,j; for(i=0;i<60000;i++) for(j=0;j<1000;j++) ; }
/* dyninit initialisiert die Routinen und reserviert durch das Betriebs-*/
/* System einen Speicherbereich, der später die Knoten aufnimmt.*/

void dyninit()
{  int i,j;
   truedynber = AllocMem(32768L,1L);
   if(truedynber<=0L)
   {  fehler(8,0L);
      wait;
      beenden();
      conreinit();
      exit(FALSE);
   }
   anzSeg=0; /*nur das Basissegment angelegt*/
   leeres_atom=&leer; /*Zeiger auf leeres Atom setzen*/
   leer.knotentyp=2;leer.zeichenkette=(char)0;
   wahr=&tr;
   tr.knotentyp=2;tr.zeichenkette[0]='t';tr.zeichenkette[1]=0;
   *truedynber=32764L+(ULONG)(truedynber); /*Marken setzen*/
   *((ULONG*)(*truedynber))=0xfffffffeL;
   freizeiger=truedynber;
   /*Textpuffer reservieren*/
   textpuffer=AllocMem(32768L,1L);
   if(textpuffer<=0L)
   {  FreeMem(truedynber,32768L);
      fehler(8,0L); /*kein Platz für Textpuffer*/
      wait;
      beenden();
      conreinit();
      exit(FALSE);
   }
   filepuffer=AllocMem(32768L,1L);
   if(filepuffer<=0L)
   {  FreeMem(truedynber,32768L);  /*Ausgabe auf Diskette puffern*/
      FreeMem(textpuffer,32768L);
      fehler(8,0L);
      wait;
      beenden();
      conreinit();
      exit(FALSE);
   }
}

/* angliedern - fügt benachbarte leere Bereiche zu einem neuen */
/* zusammen. */

void angliedern()
{  register ULONG *lauf;
   ULONG merke;
   BYTE flag=1;

   lauf=truedynber;
   while(*lauf!=0xfffffffeL)
   {  if((*lauf)&1L)
         lauf=((*lauf)&0x7ffffffeL); /*Feld besetzt*/
      else
      {  if(flag)  /*neue Startposition*/
         {  freizeiger=lauf;
            flag=0;
         }
         if((*((ULONG*)(*lauf)))&1L) /*nur ein Feld frei*/
            lauf=(*lauf);
         else
         {
            merke=*((ULONG*)(*lauf)); /*angliedern*/
            if(merke!=0xfffffffeL)
               *lauf=merke;
            else
               lauf=(*lauf);
         }
      }
   }
}

/* new(zeiger) setzt den Zeiger auf einen genügend großen Bereich */
#define new(a) a=neu((ULONG)sizeof(int)+8L)
char *neu(laenge)
unsigned long int laenge;
{  register ULONG *lauf;
   ULONG hilf;
   void dynreinit();
   if(laenge%2L)   /* Länge muß gerade sein (gerade Adressen) */
      laenge++;
   lauf=freizeiger;
   while(((*lauf)&1L)||((*lauf - (ULONG)(lauf))<laenge+4L))
      lauf=(*lauf)&0x7ffffffeL;     /*genügend gr. Ber. suchen */
   if(*lauf==0xfffffffeL)
   {  angliedern(); /*Platz schaffen*/
      lauf=freizeiger;
      while(((*lauf)&1L)||((*lauf - (ULONG)(lauf))<laenge+4L))
         lauf=(*lauf)&0x7ffffffeL;     /*genügend gr. Ber. suchen */
      if(*lauf==0xfffffffeL)
      {  segmente[anzSeg]=AllocMem(32768L,1L);
         if((segmente[anzSeg]>0L)&&(anzSeg<=256))
         {  *lauf=((ULONG)segmente[anzSeg])|0x80000001;
            *(lauf=segmente[anzSeg])=32764L+(ULONG)segmente[anzSeg];
            *((ULONG*)(*segmente[anzSeg++]))=0xfffffffe;
         }             /*bei Bedarf Speicher hinzufügen...*/
         else
         {  fehler(7,0L);
            wait;
            beenden();
            dynreinit();
            conreinit();
            exit(FALSE);
         }
      }
   }
   if((*lauf)-(ULONG)(lauf)<laenge+8L)
   {  freizeiger=*lauf;
      *lauf |= 1L;       /*Bereich kann nicht unterteilt werden*/
   }
   else
   {  hilf=*lauf; /*Bereich wird zweigeteilt*/
      freizeiger=(*lauf=(ULONG)(lauf)+laenge+5L)&0xfffffffeL;
      *((unsigned long int*)((*lauf)&0xfffffffeL))=hilf;
   }
   return((char*)(++lauf)); /*Zeiger auf Bereich zurück*/
}

/* dispose(zeiger) gibt den Bereich, auf den Zeiger zeigt, für neue */
/* Benutzung frei. Der Wert von Zeiger ändert sich nicht. Auf *zeiger */
/* darf aber keinesfalls mehr zugegriffen werden ! */

void dispose(zeiger)
unsigned long int *zeiger;
{  if((zeiger!=0L)&&(zeiger!=-1L)&&(zeiger!=leeres_atom)&&(zeiger!=wahr)&&
      (((ULONG)zeiger<(ULONG)(&befzeig[0]))||((ULONG)zeiger>=(ULONG)
        (&befzeig[anzahl]))))
   {  muell=1;
      (*(--zeiger))&=0xfffffffeL;  /*Bereich freigeben */
   }
}

/* dynreinit gibt den vom System reservierten Speicherbereich frei */

void dynreinit()
{
   if(truedynber!=0L)           /*sicher ist sicher*/
   {  int i=0;
      FreeMem(truedynber,32768L);
      for(i=0;i<anzSeg;i++)
         FreeMem(segmente[i],32768L);
      FreeMem(textpuffer,32768L);
      FreeMem(filepuffer,32768L);
   }
}

/* GarbageCollection */

struct varlist { int knotentyp;
                 struct varlist *links,*rechts;
                 struct paar *eintrag;
                 struct atom *name;
               };
struct lastpos { int knotentyp;
                 struct lastpos *next;
                 float x,y,richtung;
               };
extern WORD *objektliste;

/* kontrolle korrigiert Referenzen nach dem Umkopieren*/
#define kontrolle(a) if(((ULONG)(a)>(ULONG)start)&&((ULONG)(a)<(ULONG)ende)){ a=(ULONG)(a)-differenz;i++;}

void garbage_collection()   /* V. 3.0 */
{  ULONG *lauf,*start,*ende,*merke;
   register ULONG *source,*target;
   register struct paar *pa;
   extern WORD *symbolliste;
   int anz,i;
   ULONG differenz;

   if(!muell)
      return();
   muell=0;
   angliedern();
   lauf=freizeiger;
   while(*lauf!=0xfffffffe)
   { if(*lauf&1L) lauf=(*lauf)&0x7ffffffe; /*Bereich voll*/
     else if(*((ULONG*)(*lauf))==0xfffffffe)
             lauf=*lauf; /*der letzte freie Bereich bleibt.*/
     else /*leeren Bereich entfernen*/
     {  start=lauf;
        differenz=(*lauf)-(ULONG)lauf;
        lauf=*lauf;
        anz=0;
        while(((*lauf)&1L)&&(!((*lauf)&0x80000000))) /*solange belegt*/
        {  merke=*lauf&0xfffffffe;
           *lauf-=differenz;
           anz++;
           lauf=merke;
        }
        if((*lauf)&0x80000000||(*lauf==0xfffffffe))
        /*Segmentgrenze erreicht, Umkopieren zwecklos*/
        { if(*lauf!=0xfffffffe)
            lauf=(*lauf)&0x7ffffffe;
        }
        else
        { ende=lauf+1;    /*4 Bytes zusätzlich zum Anschluß*/
          target=start;   /*Das ist die Marke des freien Bereichs, der*/
          source=*start;  /*damit vergrößert wird.*/
          while((ULONG)source<(ULONG)ende) /*den Bereich kopieren*/
             *target++=*source++;
          lauf=truedynber;       /*nun die Referenzen korrigieren*/
          i=0;
          kontrolle(symbolliste)
          kontrolle(objektliste)
          while((i<anz)&&(*lauf!=0xfffffffe))
          {  if((*lauf)&1L) /*belegt*/
             {  pa=lauf+1L;
                if((pa->knotentyp==1)||(pa->knotentyp==5))
                /*Paar oder Grafikobjekt gefunden*/
                {  kontrolle(pa->CAR);
                   kontrolle(pa->CDR);
                }
                else
                if(pa->knotentyp==3) /*Variablenliste*/
                {  kontrolle(((struct varlist*)pa)->rechts)
                   kontrolle(((struct varlist*)pa)->links)
                   kontrolle(((struct varlist*)pa)->eintrag)
                   kontrolle(((struct varlist*)pa)->name)
                }
                else
                if(pa->knotentyp==4)
                   kontrolle(((struct lastpos*)pa)->next)
             }
             lauf=(*lauf)&0xfffffffe;
          }
          lauf=(ULONG)(ende-1)-differenz;
          /*auf den Anfang des nächsten freien Bereichs setzen*/
        }
     }
   }
}

/* uebrig zählt die belegten Knoten und den freien Speicherplatz */

void uebrig()
{  register ULONG *lauf;
   long int frei=0L,knoten[5];
   lauf=truedynber;
   knoten[0]=knoten[1]=knoten[2]=knoten[3]=knoten[4]=0L;
   while(*lauf!=0xfffffffeL)
   {  if((*lauf)&1L) /*Knoten belegt*/
      { if(!((*lauf)&0x80000000L))
           knoten[(*(lauf+1))-1L]++;
      }
      else           /*Knoten frei*/
         frei+=((*lauf)-((ULONG)lauf)-4L);
      lauf=(*lauf)&0x7ffffffeL;
   }
   dprint((anzSeg+1)*32768);nprint(" Bytes reserviert, davon\n");
   dprint(frei);nprint(" Bytes für Programme und Daten frei\n");
   dprint(knoten[0]);nprint(" Punktepaar-Knoten aktiv\n");
   dprint(knoten[1]);nprint(" atomare Knoten aktiv\n");
   dprint(knoten[2]);nprint(" Variablenverkettungsknoten aktiv\n");
   dprint(knoten[4]);nprint(" Grafik-Objekt-Knoten aktiv");
   /*Knotentyp 3 z.Z. nicht benutzt*/
}

char *textpointer=0L;

BYTE load(name)
char *name;
{  ULONG filehandle;
   ULONG dosbase;
   dosbase=OpenLibrary("dos.library",0L);
   if(dosbase==0L)
   {  fehler(4,0L);
      return(0);
   }
   else
   {  ULONG laenge;
      filehandle=Open(name,1005L);
      if(filehandle!=0L)
      {  laenge=Read(filehandle,textpuffer,20000L);
         Close(filehandle);
         CloseLibrary(dosbase);
         if(laenge<0L)
         {  fehler(5,0L);
            return(0);
         }
         else
           if(laenge>=20000L)
           {  fehler(6,0L);
              return(0);
           }
           else
           {  *((char*)(textpuffer+laenge))=0;
              textpointer=textpuffer;  /*Interpreter auf Anfang setzen*/
              return(1);
           }
      }
      else
      {  fehler(5,0L);
         CloseLibrary(dosbase);
         return(0);
      }
   }
}

/* Allgemeines */

long int length(string)
char *string;
{  register long int i;
   i=0;
   while(*string++)
      i++;
   return(i);
}

/* Der Lisp - Interpreter */
/* ---------------------- */

extern struct atom* string_int();
extern char* int_string();

/* copy kopiert eine komplette Baumstruktur, die aber auch nur aus einem*/
/* Atom bestehen darf.*/

WORD *copy(wurzel)
WORD *wurzel;
{
   if((wurzel==0L)||(wurzel==wahr)||(((ULONG)wurzel>=(ULONG)(&befzeig[0]))&&
       ((ULONG)wurzel<(ULONG)(&befzeig[anzahl]))))
   /*Ende eines Astes erreicht*/
      return(wurzel);
   else
   {  if(*((int*)wurzel)==2) /*Atom gefunden*/
      {  register struct atom *hilf1;
         hilf1=wurzel;
         if(hilf1->zeichenkette[0]!='æ') /*keine Zahl*/
         {  struct atom *hilf2;
            hilf2=neu(length(hilf1->zeichenkette)+(ULONG)(sizeof(int))+1L);
            hilf2->knotentyp=2;
            strcpy(hilf2->zeichenkette,hilf1->zeichenkette);
            return(hilf2);
         }
         else  /* Zahl ! */
         {  struct bruch *hilf2;
            hilf2=neu(sizeof(struct bruch));
            hilf2->knotentyp=2;
            hilf2->kennung[0]='æ';
            if(hilf1->zeichenkette[1]=='B')
            {  hilf2->zaehler=((struct bruch*)hilf1)->zaehler;
               hilf2->nenner= ((struct bruch*)hilf1)->nenner;
               hilf2->kennung[1]='B';
            }
            else /*Fließkommazahl*/
            {  hilf2->kennung[1]='F';
               ((struct dezimal*)hilf2)->wert=((struct dezimal*)hilf1)->wert;
            }
            return(hilf2);
         }
      }
      else  /*Punktepaar gefunden*/
      {  register struct paar *hilf1,*hilf2;
         hilf1=wurzel;
         hilf2=neu(sizeof(struct paar));
         hilf2->knotentyp=1;
         hilf2->CAR=copy(hilf1->CAR);
         hilf2->CDR=copy(hilf1->CDR);
         return(hilf2);
      }
   }
}

/* delete entfernt eine Baumstruktur aus dem Speicher, deren Wurzel*/
/* übergeben wird.*/

void delete(zeiger)
int *zeiger;
{  if((zeiger!=0L)&&(zeiger!=-1L))
     if(*zeiger==2) /*Atom soll gelöscht werden*/
        dispose(zeiger);
     else
     {  register struct paar *hilf;
        hilf=zeiger;
        delete(hilf->CAR);
        delete(hilf->CDR);
        dispose(hilf);
     }
}

/* cons bildet eine Liste aus einem Atom und einer Restliste oder einem*/
/* weiteren Atom und gibt einen Zeiger auf diese zurück*/

struct paar *cons(element,restliste)
struct paar *restliste;
struct atom *element;
{  register struct paar *kopf;

   kopf=neu(sizeof(struct paar));
   kopf->CDR=restliste;
   kopf->CAR=element; /*Eingänge gehen verloren*/
   kopf->knotentyp=1;

   return(kopf);
}

struct atom *car(liste)       /*car gibt einen Zeiger auf das erste*/
struct paar *liste;           /*Element einer Liste an*/
{  void output();             /*Vorsicht : Der Rückgabewert kann*/
   if(liste!=0L)              /*auch Zeiger auf ein Paar sein.*/
   { if(*((int*)liste)==2)
     {  fehler(9,liste);
        delete(liste);
        return(-1L);
     }
     else
     {  WORD *merke;
        merke=liste->CAR;     /*Restliste und Verbindungsknoten löschen*/
        delete(liste->CDR);
        dispose(liste);
        return(merke);
     }
   }
   else return(0L);
}

struct paar *cdr(liste)       /*cdr gibt ein Zeiger auf die restliche*/
struct paar *liste;           /*Liste zurück. Der Zeiger*/
{  void output();             /*kann auch 0 sein*/
   if(liste!=0L)
   { if(*((int*)liste)==2)
     {  fehler(9,liste);
        delete(liste);
        return(-1L);
     }
     else
     {  WORD *merke;
        merke=liste->CDR;
        delete(liste->CAR);
        dispose(liste);
        return(merke);
     }
   }
   else
      return(0L);
}

/* datprint ruft nprint auf oder schickt den Text an eine Datei */
BYTE datflag=1; /*wählt den Ausgabeort, siehe princ*/
void datprint(text)
char *text;
{  if(datflag==1)
      nprint(text);
   else if(datflag!=2)
   {  int i=0,j;
      register char *z;
      z=text;
      while(*z++!=0) i++; /*Länge des Textes ermitteln*/
      j=write(dateiw,text,i);
      if(j!=i)
         datflag=2; /*nicht mehr weiterschreiben*/
   }
}


/* listout gibt eine Liste oder ein Atom aus (ohne äußere Klammern)*/

void listout(kopf)
int *kopf;
{  if(kopf!=0L)
   { if(*kopf == 2) /*Atom !*/
       if(((struct atom*)kopf)->zeichenkette[0]=='#')
       {  datprint(" #Primitive ");
          sprintf(zp,"%d",(int)(((struct atom*)kopf)->zeichenkette[1]));
          datprint(zp);
       }
       else
          if(((struct atom*)kopf)->zeichenkette[0]!='æ')
          {  if(((struct atom*)kopf)->zeichenkette[0]!=0)
             {  datprint(" ");
                datprint(((struct atom*)kopf)->zeichenkette);
                datprint(" ");
             }
          }
          else
          {  datprint(" ");
             datprint(int_string(kopf)); /*Zahl ausgeben*/
             datprint(" ");
          }
     else
     { register struct paar *hilf;
       hilf=kopf;
       /*Erster Teil des Punktepaares :*/
       if((hilf->CAR==0L)||(*((int*)(hilf->CAR))==1))/*CAR bezeichnet*/
       {  datprint("(");        /*ein Punktepaar oder NIL-Zeiger       */
          listout(hilf->CAR);
          datprint(")");
       }
       else
          listout(hilf->CAR);
       /*Zweiter Teil des Punktepaares :*/
       if((hilf->CDR != 0L)&&(*((int*)(hilf->CDR))==2))
          datprint("."); /*linksseitiger Baum*/
       listout(hilf->CDR);
     }
   }
}

/* output ruft listout auf und setzt gegebenenfalls umschließende ()*/

void output(kopf)
int *kopf;
{  if((kopf!=-1L)&&bildaus)
     if((kopf==0L)||(*kopf==1))
     {  datprint("(");
        listout(kopf);
        datprint(")");
     }
     else
        listout(kopf);
}

extern BYTE genug_parameter();
extern struct paar *evaluate();

/*readdat liest eine Datei aus*/

extern void initsymbol();
extern int befehl();
WORD *input();
struct atom *readdat(parameter)
struct paar *parameter;
{  if(genug_parameter(parameter,1,1))
   {  struct atom *merke;
      struct paar *hilf;
      char name[41],*l1,*l2;
      int j=0,i=0;
      merke=evaluate(parameter->CAR);
      dispose(parameter);
      if((merke==-1L)||(!merke)||(merke->knotentyp!=2)||
         (merke->zeichenkette[0]!='\"'))
      {  if(merke!=-1L)
         {  fehler(2,merke);
            delete(merke);
         }
         delete(parameter);
         return(-1L);
      }
      l1=&(merke->zeichenkette[1]);l2=name;       /*Dateiname kopieren*/
      while((i++<40)&&(*l1!='\"')) *l2++=*l1++;
      *l2=0; dispose(merke); /*Stringende*/
      dateir=open(name,0,i);
      if(dateir<=0L)
        return(0L);
      l1=filepuffer;
      do
         i=read(dateir,l1++,1);
      while((i==1)&&(++j<32768));
      close(dateir);
      dateir=-1L;
      if(j>=32768)   /*Puffer voll !*/
        return(0L);
      i=textpointer; /*aktuelle Position zwischenspeichern*/
      hilf=input(filepuffer);
      textpointer=i;
      return(hilf); /*gelesene Liste zurückgeben*/
   }
   else { delete(parameter); return(-1L); }
}

/*open öffnet eine Datei zum Schreiben */
struct atom *open_(parameter)
struct paar *parameter;
{  extern struct paar *evaluate();
   if(dateiw!=-1L)
   {  delete(parameter);
      return(0L);
   }
   if(genug_parameter(parameter,1,1))
   {  struct atom *hilf;
      hilf=evaluate(parameter->CAR);
      dispose(parameter);
      if((hilf!=-1L)&&(hilf!=0L)&&(hilf->knotentyp==2)&&(hilf->zeichenkette[0]=='\"'))
      {  int i=1,dummy;
         while(hilf->zeichenkette[i]!='\"') i++;
         hilf->zeichenkette[i]=0; /*Anführungszeichen entfernen*/
         dateiw=creat(&hilf->zeichenkette[1],i);
         dispose(hilf);
         if(dateiw==-1L)
            return(0L);
         else
         {  dummy=write(dateiw,"(",1);
            return(wahr);
         }
      }
      else
      {  if(hilf!=-1L)
         {  fehler(2,parameter);
            delete(parameter);
         }
         return(-1L);
      }
   }
   else
   {  delete(parameter);
      return(-1L);
   }
}

struct atom *close_(parameter)
struct paar *parameter;
{  if(genug_parameter(parameter,0,0))
   {  if(dateiw!=-1L)
      {  int dummy;
         dummy=write(dateiw,")",1); /*Liste abschließen*/
         close(dateiw);
      }
      return(leeres_atom);
   }
   else
   {  delete(parameter);
      return(-1L);
   }
}

struct atom *ddelete(parameter)
struct paar *parameter;
{  if(genug_parameter(parameter,1))
   {  struct atom *merke;
      merke=evaluate(parameter->CAR);dispose(parameter);
      if((merke==-1L)||(!merke)||(merke->knotentyp!=2)||
         (merke->zeichenkette[0]!='\"'))
      {  if(merke!=-1L)
         {  fehler(2,merke);
            delete(merke);
         }
         delete(parameter);
         return(-1L);
      }
      else
      { ULONG filehandle;
        ULONG dosbase;
        char *z;
        dosbase=OpenLibrary("dos.library",0L);
        if(dosbase==0L)
        {  fehler(4,0L);
           return(0);
        }
        z=&(merke->zeichenkette[1]);
        while(*z!='\"') z++;
        *z=0;
        if(DeleteFile(&(merke->zeichenkette[1])))
        {  dispose(merke);
           CloseLibrary(dosbase);
           return(wahr);
        }
        dispose(merke);
        CloseLibrary(dosbase);
        return(0L);
      }
   }
   else
   {  delete(parameter); return(-1L);
   }
}

char *leerweg(zeig) /*überliest Leerzeichen*/
char *zeig;
{ register char *zeiger;
  zeiger=zeig;
  while((*zeiger==10)||(*zeiger==13)||(*zeiger==' ')||(*zeiger==';'))
  {  if(*zeiger==';')                       /*Kommentare*/
       while((*zeiger!=10)&&(*zeiger!=13))
          zeiger++;
     zeiger++;
  }
  return(zeiger);
}

/* varzeichen evaluiert zu true, wenn das übergebene Zeichen in einem*/
/* Variablennamen erlaubt ist*/

BYTE varzeichen(zeichen)
char zeichen;
{ if((zeichen!=10)&&(zeichen!=13)&&(zeichen!=';')&&(zeichen!=' ')
     &&(zeichen!=')')&&(zeichen!='(')&&(zeichen!=0)&&
     (zeichen!=39))
     return(1);
  else
     return(0);
}

/* atomin liest ein einzelnes Atom aus einem String ein. Der textpointer*/
/* muß auf das erste Zeichen des Atoms zeigen*/

WORD *atomin()
{
  register struct atom *knoten;
  register char *hilf;
  long int i=0L;
  extern BYTE compare();

  if((*textpointer!=0)&&(*textpointer!=')')&&(*textpointer!='.'))
  {
    hilf=textpointer;
    /* Eine ZAHL gelesen */
    if(((*hilf=='-')&&varzeichen(*(hilf+1)))||
       ((*hilf<58)&&(*hilf>47)))
    {  knoten=string_int(hilf);
       while(varzeichen(*textpointer)&&((*textpointer!='.')
             ||((*(textpointer+1)>=48)&&(*(textpointer+1)<58))))
          textpointer++;
       return(knoten);
    }
    /* Wahrheitswert TRUE gelesen */
    if((*hilf=='t')&&((!varzeichen(*(hilf+1)))||(*(hilf+1)=='.')))
    {  textpointer++;
       return(wahr);      /* true wird nur als Zeiger gesp.*/
    }
    /* Wahrheitswert NIL gelesen */
    if((*hilf=='n')&&(*(hilf+1)=='i')&&(*(hilf+2)=='l')&&
       ((!varzeichen(*(hilf+3)))||(*(hilf+3)=='.')))
    {  textpointer+=3;
       return(0L);    /* nil wird zu () */
    }
    /* Knotengröße für Strings/Variablen ermitteln */
    if(*hilf=='"') /*Es liegt ein String vor*/
    {  hilf++;
       while((*hilf!='"')&&(*hilf!=0))
       {  hilf++;
          i++;
       }
       i+=2L; /*Platz für die Anführungszeichen*/
    }
    else  /* Platz für Symbol ermitteln*/
       while(varzeichen(*hilf)&&(*hilf!='.'))
       {   hilf++;i++;
       }
    knoten=neu(i+(ULONG)(sizeof(int))+2L); /*gegen +1L ändern*/
    /*Knoten mit Inhalt füllen*/
    knoten->knotentyp=2;
    hilf=&(knoten->zeichenkette[0]);
    if(*textpointer=='"') /*String kopieren*/
    {  *(hilf++)='"';
       while((*(textpointer+1L)!=0)&&(*(textpointer+1L)!='"'))
         *(hilf++)=*(++textpointer);
       *(hilf++)='"';
       *hilf=0;
       if(*(++textpointer)==0)/*Quelltextende erreicht !*/
          fehler(10,knoten);
       else
          textpointer++;
    }
    else /*Symbol kopieren*/
    {  while(varzeichen(*textpointer)&&(*textpointer!='.'))
          *(hilf++)=*(textpointer++);
       *hilf=0;
    }
    return(knoten);
  }
  else
  {  if(*textpointer==')')
     {  fehler(11,0L);
        textpointer++;
     }
     else
        if(*textpointer=='.')
        {  fehler(12,0L);
           textpointer++;
        }
     return(0L);
  }
}

/* listin liest eine Liste aus einem String ein. Der textpointer muß auf*/
/* das erste Zeichen nach der geöffneten Anfangsklammer zeigen*/

WORD *listin(klammern)
BYTE klammern;

{ register struct paar *knoten;
  WORD *input();
  textpointer=leerweg(textpointer);
  if((*textpointer!=0)&&(*textpointer!=')'))
  {
    knoten=neu(sizeof(struct paar));
    knoten->knotentyp=1;
    knoten->CAR=input(textpointer);
    textpointer=leerweg(textpointer);
    if((*textpointer!=0)&&(*textpointer!='.'))   /*Es folgt liste*/
    {
       knoten->CDR=listin(1);
    }
    else
    {  if(*textpointer!=0)
          knoten->CDR=input(++textpointer);
       else
          knoten->CDR=0L;
    }
    textpointer=leerweg(textpointer);
  }
  else
     knoten=0L;
  if(*textpointer==')')
  { if(klammern == 0)
       textpointer++;
  }
  else
    if(klammern==0)
       fehler(13,0L);
  return(knoten);
}

WORD *input(was)
char *was;
{  textpointer=leerweg(was);
   if(*textpointer=='(')
   {  textpointer++;
      return(listin(0));  /*bisher 0 Klammern geöffnet*/
   }
   else
      if(*textpointer==39)                      /*(quote ...) er-*/
      {  register struct paar *hilfsk1,*hilfsk2;/*zeugen*/
         register struct atom *hilfsat;
         hilfsat=neu((ULONG)sizeof(int)+8L);
         hilfsat->knotentyp=2;
         strcpy(hilfsat->zeichenkette,"quote");
         hilfsk1=neu(sizeof(struct paar));
         hilfsk2=neu(sizeof(struct paar));
         hilfsk1->knotentyp=hilfsk2->knotentyp=1;
         hilfsk1->CAR=hilfsat;hilfsk1->CDR=hilfsk2;
         hilfsk2->CAR=input(++textpointer);
         hilfsk2->CDR=0L;
         return(hilfsk1);
      }
      else
         return(atomin());
}

extern char *newcon();  /*aus Modul8*/

char *edit()
{  static char puffer[255];
   char *merke,*z;
   if(textpointer) textpointer=leerweg(textpointer);
   if((textpointer==0L)||(*textpointer==0))
   {  do
        merke=newcon();
      while(*merke==0);
      z=puffer;           /*Kopie der Eingabe anlegen, damit auch*/
      while(*merke!=0)    /*read auf newcon zugreifen kann.      */
        *z++=*merke++;
      *z=0;
      return(puffer);
   }
   else
      return(textpointer);
}