#include <exec/types.h>
#define anzahl 78
/*Anzahl der in C implementierten Befehle*/

extern void dyninit(),uebrig(),beenden(),nprint(),rprint(),b_allow();
extern char *edit();
extern WORD *input();
extern void output(),garbage_collection(),conreinit(),coninit();
extern WORD *car(),*cdr(),*cons();
extern WORD *copy(),*read_();
extern void delete(),dispose(),fehler();
extern WORD *neu(),*strcat_(),*strlen_(),*substr(),*ascii(),*chr();
extern WORD *carcdr(),*quote(),*cons_(),*set(),*eval(),*rechnen();
extern WORD *datentyp(),*equal(),*relation(),*not(),*logik(),*cond();
extern WORD *lambda(),*defun(),*princ(),*terpri(),*auswerten(),*list();
extern WORD *pic(),*endpic(),*draw(),*ellipse(),*ellipsef(),*fill(),*clear();
extern WORD *Do(),*While(),*For(),*nth();
extern WORD *cast(),*polygon(),*rgb();
extern WORD *zufall(),*change(),*reset(),*exchange(),*append();
extern WORD *open_(),*close_(),*transzendent();
extern WORD *readdat(),*ddelete();
extern BYTE genug_parameter(),load();
extern BYTE bildaus;

struct paar { int knotentyp;
              WORD *CAR;
              WORD *CDR;
            };
struct atom { long int knotentyp;
              char zeichenkette[2];
            };
struct varlist { int knotentyp;           /*Knotentyp = 3*/
                 struct varlist *links;   /*Mit dieser Struktur wird*/
                 struct varlist *rechts;  /*der Variablenbaum aufgebaut*/
                 struct paar *eintrag;
                 struct atom *name;
                 int lokalzahl;
               };
struct bruch { int knotentyp;
               char kennung[2];
               int zaehler,nenner;
             };
struct dezimal{int knotentyp;
               char kennung[2];
               float wert;
              };
struct { int knotentyp;
         char zeichenkette[3];
       }befzeig[anzahl];
struct varlist *symbolliste=0L;
struct paar *system(),*nachladen(),*forbid();
extern struct paar *PNeu();
char tracesymb[81];  /* für Debugger-Funktionen */
BYTE trace=0;

void tcpy(zeig)  /* kopiert das aktuelle Symbol in den Puffer tracesymb*/
char *zeig;
{ int i=0;
  char *z;
  z=tracesymb;
  while((i++<80)&&(*zeig))
    *z++=*zeig++;
  *z=0;
}

/* compare vergleicht zwei Strings und gibt Wahrheitswert zurück*/

BYTE compare(string1,string2)
char *string1,*string2;
{  if((*string1!='æ')||(*string2!='æ'))
   {  while((*string1==*string2)&&(*string1!=0))
      {  string1++;
         string2++;
      }
      if((*string1==0)&&(*string2==0))
         return(1);
      else
         return(0);
   }
   else /*Es sollen Zahlen verglichen werden*/
      if(*(string1+1)=='B')
      { if((*((int*)(string1+2L))==*((int*)(string2+2L)))&& /*Zähler*/
           (*((int*)(string1+2L+sizeof(int)))==*((int*)(string2+2L+sizeof(int)))))/*Nenner*/
           return(1);
        else
           return(0);
      }
      else /*Fließkommazahl*/
      { if( *((float*)(string1+2L)) == *((float*)(string2+2L)))
           return(1);
        else
           return(0);
      }
}

struct { char name[9];
         int nummer  ; }befehle[anzahl]; /*feste Befehle*/

/* suchsymbol sucht ein Symbol im Symbolbaum und gibt einen*/
/* Zeiger auf den zugehörigen Verknüpfungsknoten zurück.*/
/* modus gibt an, ob Fehlermeldungen bei Nicht-*/
/* finden ausgegeben werden (1=Fehler,0=kein Fehler)*/

ULONG *last; /*Adresse des Zeigers auf den letzten Knoten*/

struct varlist *suchsymbol(symbol,modus)
struct atom *symbol;
BYTE modus;
{  register struct varlist *lauf;
   BYTE flag=1;
   char *z1,*z2;
   lauf=symbolliste;
   last=0L;
   while((lauf!=0L)&&flag)
   {  z1=symbol->zeichenkette;
      z2=lauf->name->zeichenkette;
      while((*z1==*z2)&&(*z1)) { z1++; z2++; }
      if(*z1==*z2) flag=0;
      else
      { if((*z1)<(*z2))
        {  last=(ULONG*)lauf+1L;lauf=lauf->links;}
        else
        {  last=(ULONG*)lauf+2L;lauf=lauf->rechts;}
      }
   }
   if(flag) /*Symbol nicht vorhanden*/
   {  if(modus)
         fehler(14,symbol);
      return(0L);
   }
   else
      return(lauf);
}

struct paar *searchsymbol(symbol)
struct atom *symbol;
{  struct varlist *merke;
   merke=suchsymbol(symbol,1);
   if(merke==0L) return(0L);
   else return(merke->eintrag->CAR);
}

/* initsymbol weist einem symbol eine Kopie dessen zu, auf das*/
/* inhalt zeigt. Gegebenenfalls wird*/
/* das Symbol erst angelegt.*/

void initsymbol(symbol,inhalt,typ)
struct atom *symbol;
BYTE typ; /*typ==0 : keine Überprüfung, ob Symbol schon vorhanden */
WORD *inhalt;
{  register struct varlist *merke;
   register struct paar *hilf;

   merke=suchsymbol(symbol,0);
   if(typ&&(merke!=0L))
   {  /*Das Symbol befindet sich bereits in der Liste !*/
      delete(merke->eintrag->CAR);     /*alter Inhalt löschen */
      merke->eintrag->CAR=copy(inhalt);/*neuer Inhalt setzen  */
      dispose(symbol);
   }
   else
   {  if(merke!=0L) /*neues Symbol gleichen Namens*/
      {  hilf=PNeu();
         hilf->CAR=copy(inhalt);
         hilf->CDR=merke->eintrag;
         hilf->knotentyp=1;
         merke->eintrag=hilf;
         merke->lokalzahl++;
         dispose(symbol);
      }
      else
      {  hilf=PNeu();
         hilf->CAR=copy(inhalt);
         hilf->CDR=0L;
         hilf->knotentyp=1;
         merke=neu(sizeof(struct varlist));
         merke->name=symbol;
         merke->rechts=merke->links=0L;
         merke->eintrag=hilf;
         merke->knotentyp=3;
         if(typ)
            merke->lokalzahl=0;
         else
            merke->lokalzahl=1;
         if(symbolliste==0L)
            symbolliste=merke;  /*erster Eintrag*/
         else
            *last=(ULONG)merke; /*sonst anketten*/
      }
   }
}

/* delsymbol entfernt das neueste Symbol des Namens*/
/* symbol aus dem Symbolbaum */

void delsymbol(symbol)
struct atom *symbol;
{  register struct varlist *hilf;
   struct paar *merke;

   hilf=suchsymbol(symbol,0);
   if(hilf!=0L)   /*Symbol vorhanden ?*/
      if((hilf->eintrag->CDR)!=0L) /*mehrere Symbole*/
      {  merke=hilf->eintrag;
         hilf->lokalzahl--;
         hilf->eintrag=merke->CDR;
         delete(merke->CAR);
         dispose(merke);
         dispose(symbol);
      }
      else /*nur ein Symbol dieses Namens*/
      {  register struct varlist *lauf;
         delete(hilf->eintrag->CAR);
         dispose(hilf->name);
         dispose(hilf->eintrag);
         /*linkes Ende des rechten Teilbaums suchen*/
         if(!(hilf->rechts)) /*rechter Teilbaum leer*/
            hilf->rechts=hilf->links;
         else
         {  lauf=hilf->rechts; /*nicht leer*/
            while(lauf->links)
               lauf=lauf->links;
            lauf->links=hilf->links; /*linken Teilbaum anketten*/
         }
         if(!last)
            symbolliste=hilf->rechts;
         else
            *last=(ULONG)(hilf->rechts); /*hilf abschneiden*/
         dispose(hilf);
         dispose(symbol);
      }
}

/* Hier wird die Variablenliste ausgegeben */

int anzcr; /*Carriage-returns*/

void rekaus(lauf)
struct varlist *lauf;
{  if(lauf!=0L)
   {  rekaus(lauf->links);
      nprint(lauf->name->zeichenkette);nprint(" ");
      anzcr=(anzcr+1)%6; if(!anzcr) nprint("\n");
      rekaus(lauf->rechts);
   }
}

struct atom *vlist(parameter)
struct paar* parameter;
{  extern WORD *leeres_atom;
   if(parameter!=0L)
   {  fehler(2,parameter);
      delete(parameter);
      return(-1L);
   }
   nprint("\nDie Liste aller Variablensymbole :");
   if(symbolliste==0L) nprint(" ist leer !\n");
   else
   {  nprint("\n");
      anzcr=0;
      rekaus(symbolliste);
      nprint("\n");
   }
   return(leeres_atom);
}

/* initbefehl initialisiert die Befehlsliste*/

void initbefehl()
{  register char i,j=1;
   char *merke[9],*z1,*z2; /*zum Sortieren der Befehle*/
   BYTE flag;
   int hilf;
   strcpy(befehle[0].name,"car");  /*die Befehle... */
   strcpy(befehle[1].name,"cdr");
   strcpy(befehle[2].name,"quote");
   strcpy(befehle[3].name,"set");
   strcpy(befehle[4].name,"setq");
   strcpy(befehle[5].name,"cons");
   strcpy(befehle[6].name,"eval");
   strcpy(befehle[7].name,"+");
   strcpy(befehle[8].name,"-");
   strcpy(befehle[9].name,"*");
   strcpy(befehle[10].name,"/");
   strcpy(befehle[11].name,"mod");
   strcpy(befehle[12].name,">");
   strcpy(befehle[13].name,"<");
   strcpy(befehle[14].name,">=");
   strcpy(befehle[15].name,"<=");
   strcpy(befehle[16].name,"eql");
   strcpy(befehle[17].name,"eq");
   strcpy(befehle[18].name,"equal");
   strcpy(befehle[19].name,"listp");
   strcpy(befehle[20].name,"atom");
   strcpy(befehle[21].name,"null");
   strcpy(befehle[22].name,"not");
   strcpy(befehle[23].name,"and");
   strcpy(befehle[24].name,"or");
   strcpy(befehle[25].name,"cond");
   strcpy(befehle[26].name,"defun");
   strcpy(befehle[27].name,"free");
   strcpy(befehle[28].name,"load");
   strcpy(befehle[29].name,"princ");
   strcpy(befehle[30].name,"terpri");
   strcpy(befehle[31].name,"forbid");
   strcpy(befehle[32].name,"allow");
   strcpy(befehle[33].name,"defmacro");
   strcpy(befehle[34].name,"progn");
   strcpy(befehle[35].name,"cadr");
   strcpy(befehle[36].name,"list");
   strcpy(befehle[37].name,"strcat");
   strcpy(befehle[38].name,"strlen");
   strcpy(befehle[39].name,"substr");
   strcpy(befehle[40].name,"ascii");
   strcpy(befehle[41].name,"chr");
   strcpy(befehle[42].name,"read");
   strcpy(befehle[43].name,"graphic");
   strcpy(befehle[44].name,"text");
   strcpy(befehle[45].name,"draw");
   strcpy(befehle[46].name,"ellipse");
   strcpy(befehle[47].name,"fill");
   strcpy(befehle[48].name,"clear");
   strcpy(befehle[49].name,"while");
   strcpy(befehle[50].name,"do");
   strcpy(befehle[51].name,"count");
   strcpy(befehle[52].name,"nth");
   strcpy(befehle[53].name,"div");
   strcpy(befehle[54].name,"cast");
   strcpy(befehle[55].name,"random");
   strcpy(befehle[56].name,"float");
   strcpy(befehle[57].name,"nofloat");
   strcpy(befehle[58].name,"kill");
   strcpy(befehle[59].name,"killq");
   strcpy(befehle[60].name,"varlist");
   strcpy(befehle[61].name,"open");
   strcpy(befehle[62].name,"close");
   strcpy(befehle[63].name,"princdat");
   strcpy(befehle[64].name,"sin");
   strcpy(befehle[65].name,"cos");
   strcpy(befehle[66].name,"atan");
   strcpy(befehle[67].name,"sqrt");
   strcpy(befehle[68].name,"log");
   strcpy(befehle[69].name,"exp");
   strcpy(befehle[70].name,"readdat");
   strcpy(befehle[71].name,"killfile");
   strcpy(befehle[72].name,"help");
   strcpy(befehle[73].name,"polygon");
   strcpy(befehle[74].name,"rgb");
   strcpy(befehle[75].name,"ellipsef");
   strcpy(befehle[76].name,"append");
   strcpy(befehle[77].name,"exchange");
   for(i=0;i<(char)anzahl;i++)
   {  befzeig[i].knotentyp=2;    /*feste Befehlsknoten einrichten*/
      befzeig[i].zeichenkette[0]='#';
      befzeig[i].zeichenkette[1]=i+1;
      befzeig[i].zeichenkette[2]=0;
      befehle[i].nummer=(int)i+1;  /*Befehlsreihenfolge festlegen*/
   }
   do   /*Bubble-Sort*/
   {  flag=0;
      for(i=0;i<(char)anzahl-j;i++)
      {  z1=befehle[i].name;z2=befehle[i+1].name;
         while((*z1==*z2)&&(*z1)) {z1++;z2++;}
         if((*z1)>(*z2))
         {  strcpy(merke,befehle[i].name);
            strcpy(befehle[i].name,befehle[i+1].name);
            strcpy(befehle[i+1].name,merke);
            hilf=befehle[i].nummer;
            befehle[i].nummer=befehle[i+1].nummer;
            befehle[i+1].nummer=hilf;
            flag=1;
         }
      }
      j++;
   }while(flag);
}

/* Funktion hilf zum Erklären der Befehle */
char hilfdatei[16];
char hilfzeile[72];
struct atom *help(parameter)
struct paar *parameter;
{  int i,j;
   WORD *evaluate();
   if(parameter==0L)
   {  nprint("Befehlsübersicht :\n");
      for(i=0;i<anzahl;i++)
      {  nprint(befehle[i].name);nprint(" "); }
      return(leeres_atom);
   }
   if(genug_parameter(parameter,1,1))
   {  struct atom *hilf;
      int i=0,handle;
      BYTE flag=1;
      char *z1,*z2,zeichen;
      hilf=evaluate(parameter->CAR);dispose(parameter);
      if((hilf!=-1L)&&(hilf!=0L)&&(hilf->knotentyp==2)&&
         (hilf->zeichenkette[0]=='\"')) /*Syntax o.k.*/
      {  z1=&(hilf->zeichenkette[1]);z2=hilfdatei;
         while((i++<8)&&(*z1!='\"'))
           *z2++=*z1++;              /*Dateinamen erstellen*/
         *z2=0;i=0;
         dispose(hilf);
         if((handle=open(":help/ALisp.help",0,i))!=-1)
         {  while(flag&&(10==read(handle,hilfzeile,10)))
            { i=0; while((i<10)&&(hilfzeile[i]!='æ')) i++;
              if(i<10)
              {  read(handle,&hilfzeile[10],i); /*8 Zeichen + CR*/
                 j=0; while((j<8)&&(hilfzeile[i+1+j]==hilfdatei[j])) j++;
                 if((j==8)||((hilfdatei[j]==0)&&(hilfzeile[i+1+j]=='.')))
                    flag=0; /*gefunden */
                 else
                    read(handle,hilfzeile,10); /*mind. 10 Zeichen lang*/
              }
            }
            if(!flag) /* Text ausgeben :*/
            {  i=1;
               while((i!=0)&&(!flag))
               { i=read(handle,hilfzeile,70);
                 if(i>0)
                 {  hilfzeile[i]=0;z1=hilfzeile;
                    while((*z1)&&(*z1!='ø')) z1++;
                    if(*z1=='ø') { *z1=0; flag=1; }
                    nprint(hilfzeile);
                 }
               }
            }
            else
              nprint("Es gibt zu diesem Begriff keine Informationen.\n");
            close(handle);
         }
         else
           nprint("ALisp.help nicht gefunden.\n");
         return(leeres_atom);
      }
      else
      {  if(hilf!=-1L)
         {  fehler(2,hilf); delete(hilf); }
         return(-1L);
      }
   }
   else
   { delete(parameter);return(-1L); }
}

/* befehl sucht in der Liste Befehle binär nach einer Zeichenkette und*/
/* gibt deren Nummer zurück. Ist sie nicht vorhanden, wird 0 zu-*/
/* rückgegeben.*/

int befehl(string)
char *string;
{  int anfang=0,ende,mitte;
   BYTE flag=1;
   register char *z1,*z2;

   ende=anzahl-1;
   do
   {  mitte=(anfang+ende)>>1;
      z1=string; z2=befehle[mitte].name;
      while((*z1==*z2)&&(*z1)) { z1++; *z2++; }
      if(*z1==*z2)
         flag=0;
      else
         if((*z1)<(*z2))
            ende=mitte-1;
         else
            anfang=mitte+1;
   }while(flag&&(anfang<=ende));
   if(flag) return(0);
   else     return(befehle[mitte].nummer);
}

/* evaluate ist die Auswertefunktion !*/
/* was ausgewertet ist, wird vernichtet !*/

WORD *evaluate(knoten)
int *knoten;
{  static int escounter=0;
   extern char *textpointer;
   extern BYTE escape();
   tracesymb[0]=0;
   if(knoten==0L)    /*falls NIL ausgewertet werden soll...*/
      return(0L);
   else
   if(*knoten==2) /*Atom soll ausgewertet werden !*/
   {  register struct atom *element;

      element=knoten;
      if((element->zeichenkette[0]=='"')||
         (element->zeichenkette[0]=='æ')||
         ((element->zeichenkette[0]=='t')&&(element->zeichenkette[1]==0)))
         return(element);
      /*Zeichenketten und Zahlen evaluieren zu sich selbst*/
      else
      {  int hilf;

         if((hilf=befehl(element->zeichenkette))>0)/*Atom wird zu C-Befehl*/
         {  dispose(knoten);
            return(&befzeig[hilf-1]);
         }
         else /*Symbol liegt vor*/
         {  WORD *merke;
            merke=copy(searchsymbol(element));
            if(trace)
              strcpy(tracesymb,element->zeichenkette);
            dispose(element);
            return(merke);
            /*Kopie des Symbolinhalts zurückgeben !*/
         }
      }
   }
   else if(*knoten==4) /* komplexe Zahlen */
   {  struct atom *merke1,*merke2;
      merke1=((struct paar*)knoten)->CAR=evaluate(((struct paar*)knoten)->CAR);
      if(merke1==-1L)
      {  delete(((struct paar*)knoten)->CDR);
         dispose(knoten);
         return(-1L);
      }
      merke2=((struct paar*)knoten)->CDR=evaluate(((struct paar*)knoten)->CDR);
      if(merke2==-1L)
      {  delete(((struct paar*)knoten)->CAR);
         dispose(knoten);
         return(-1L);
      }
      if((merke1->knotentyp!=2)||(merke2->knotentyp!=2)||
         (merke1->zeichenkette[0]!='æ')||(merke2->zeichenkette[0]!='æ'))
      {  fehler(40,knoten);
         delete(knoten);
         return(-1L);
      }
      if(((merke2->zeichenkette[1]=='B')&&(((struct bruch*)merke2)->zaehler==0))||
         ((merke2->zeichenkette[1]!='B')&&(((struct dezimal*)merke2)->wert==0.0)))
      { /*Zahl ist reell !*/
        dispose(merke2); dispose(knoten); return(merke1);
      }
      return(knoten);
   }
   else    /*Liste soll ausgewertet werden !*/
   {  register struct paar *element;
      register struct atom *hilf;
      BYTE flag=0; /*flag ==1 => Liste aber kein Lambda-Term*/

      escounter++;
      if(escounter==5) /*Zähler, damit nicht zuviel Rechenzeit auf*/
      {  escounter=0;  /*die Tastenabfrage verschwendet wird.     */
         if(escape())
         {  fehler(36,0L);
            delete(knoten);
            textpointer=0L; /*Rest nicht mehr auswerten*/
            return(-1L);
         }
      }
      element=knoten;
      hilf=evaluate(element->CAR);
      if(hilf==-1L)            /*Fehler aufgetreten!*/
      {  delete(element->CDR); /*also Auswertung abbrechen!*/
         dispose(element);
         return(-1L);
      }
      else
      { if((hilf!=0L)&&(hilf->knotentyp==1))
        {  struct atom* hilf2;
           hilf2=((struct paar*)(hilf))->CAR;
           if((hilf2==0)||(hilf2->knotentyp==1))
              flag=1;
           else
              flag=(compare(hilf2->zeichenkette,"lambda")==0)&&
                   (compare(hilf2->zeichenkette,"macro")==0);
        }
        if((hilf==0L)||((hilf->knotentyp==2)&&(hilf->zeichenkette[0]!='#'))
                     ||flag)
        /*wenn die Liste nicht mit einem Befehl beginnt...*/
        {  fehler(32,hilf);
           delete(hilf);
           delete(element->CDR);
           dispose(element);
           return(-1L);
        }
        else  /*Liste beginnt mit einem Befehl !*/
           if(hilf->knotentyp==2) /*C-Befehl*/
           {  int merke;
              merke=(int)(hilf->zeichenkette[1]);
              dispose(hilf);
              hilf=element->CDR;
              dispose(element);
              switch(merke)
              { case 1:   return(carcdr(hilf,0));
                case 2:   return(carcdr(hilf,1));
                case 3:   return(quote(hilf));
                case 4:   return(set(hilf,0));
                case 5:   return(set(hilf,1));
                case 6:   return(cons_(hilf));
                case 7:   return(eval(hilf));
                case 8:   return(rechnen(hilf,'+'));
                case 9:   return(rechnen(hilf,'-'));
                case 10:  return(rechnen(hilf,'*'));
                case 11:  return(rechnen(hilf,'/'));
                case 12:  return(rechnen(hilf,'%'));
                case 13:  return(relation(hilf,2));
                case 14:  return(relation(hilf,4));
                case 15:  return(relation(hilf,1));
                case 16:  return(relation(hilf,5));
                case 17:  return(relation(hilf,3));
                case 18:  return(equal(hilf,1));
                case 19:  return(equal(hilf,2));
                case 20:  return(datentyp(hilf,1));
                case 21:  return(datentyp(hilf,2));
                case 22:  return(datentyp(hilf,3));
                case 23:  return(not(hilf));
                case 24:  return(logik(hilf,'&'));
                case 25:  return(logik(hilf,'|'));
                case 26:  return(cond(hilf));
                case 27:  return(defun(hilf,1));
                case 28:  return(system(hilf));
                case 29:  return(nachladen(hilf));
                case 30:  return(princ(hilf,0));
                case 31:  return(terpri(hilf));
                case 32:  return(forbid(hilf,0));
                case 33:  return(forbid(hilf,1));
                case 34:  return(defun(hilf,0));
                case 35:  return(auswerten(hilf));
                case 36:  return(carcdr(hilf,2));
                case 37:  return(list(hilf));
                case 38:  return(strcat_(hilf));
                case 39:  return(strlen_(hilf));
                case 40:  return(substr(hilf));
                case 41:  return(ascii(hilf));
                case 42:  return(chr(hilf));
                case 43:  return(read_(hilf));
                case 44:  return(pic(hilf));
                case 45:  return(endpic(hilf));
                case 46:  return(draw(hilf));
                case 47:  return(ellipse(hilf));
                case 48:  return(fill(hilf));
                case 49:  return(clear(hilf));
                case 50:  return(While(hilf));
                case 51:  return(Do(hilf));
                case 52:  return(For(hilf));
                case 53:  return(nth(hilf));
                case 54:  return(rechnen(hilf,':'));
                case 55:  return(cast(hilf));
                case 56:  return(zufall(hilf));
                case 57:  return(change(hilf,1));
                case 58:  return(change(hilf,0));
                case 59:  return(reset(hilf,0));
                case 60:  return(reset(hilf,1));
                case 61:  return(vlist(hilf));
                case 62:  return(open_(hilf));
                case 63:  return(close_(hilf));
                case 64:  return(princ(hilf,1));
                case 65:  return(transzendent(hilf,0));
                case 66:  return(transzendent(hilf,1));
                case 67:  return(transzendent(hilf,2));
                case 68:  return(transzendent(hilf,3));
                case 69:  return(transzendent(hilf,4));
                case 70:  return(transzendent(hilf,5));
                case 71:  return(readdat(hilf));
                case 72:  return(ddelete(hilf));
                case 73:  return(help(hilf));
                case 74:  return(polygon(hilf));
                case 75:  return(rgb(hilf));
                case 76:  return(ellipsef(hilf));
                case 77:  return(append(hilf));
                case 78:  return(exchange(hilf));
              }
           }
           else /*Lambda - Term oder Macro gefunden !*/
           {  struct paar *hilfx;
              BYTE typ=1;
              /*hilf zeigt jetzt auf den Lambda-Term*/
              /*element->CDR zeigt auf die Werteliste*/
              hilfx=((struct paar*)hilf)->CDR;
              if(((struct atom*)(((struct paar*)hilf)->CAR))->
                 zeichenkette[0]=='m') /*Macro !*/
              {  typ=0;
                 if(trace)
                 { rprint("\nMacroexpansion : ");nprint(tracesymb); }
              }
              else
                if(trace)
                { rprint("\nFunktionsaufruf : ");nprint(tracesymb); }
              dispose(((struct paar*)hilf)->CAR); /*lambda löschen*/
              dispose(hilf);
              hilf=lambda(hilfx,element->CDR,typ);
              dispose(element);
              return(hilf);
           }
      }
   }
}

extern void transfer1();
extern BYTE edcheck();

main(argc,argv)
int argc;
char *argv[];
{
   WORD *zeiger,*merke;
   char *eingabe;
   BYTE flag=1;

   coninit();
   dyninit();
   tracesymb[0]=0;
   if(argc>2)
   {  printf("\nUsage : AmigaLisp [Programmname]\n");
      dynreinit();
      conreinit();
      exit(FALSE);
   }
   if(argc==2) /*Quelltext wird nachgeladen */
   {  BYTE dummy;
      dummy=load(*(++argv),0);
      if(!dummy)
      {  printf("\nLisp-Datei konnte nicht geladen werden.\n");
         dynreinit();
         conreinit();
         exit(FALSE);
      }
      else
        if(edcheck()) transfer1();
   }
   if(argc==0) /* von der Workbench aus gestartet !*/
   {  BYTE dummy;
      dummy=load(":lisp/setup.lsp",0);
   }
   initbefehl();
   do
   {  eingabe=edit();
      if(*eingabe==1)
      {
         flag=0;
         beenden();
         dynreinit();
         conreinit();
      }
      else if(*eingabe==2)
      {  extern char* textpointer;
         dynreinit();
         dyninit();       /*Alle Variablen löschen*/
         textpointer=0L;
         symbolliste=0L;
         *eingabe=0;
      }
      else if(*eingabe==3)
      {  extern BYTE breakmenu();
         BYTE dummy;
         dummy=breakmenu();
      }
      else
      {  merke=input(eingabe);
         zeiger=evaluate(merke);
         output(zeiger);
         delete(zeiger);
         garbage_collection();
      }
   }while(flag);
}

struct atom *system(parameter)
struct paar *parameter;
{  extern WORD *leeres_atom;
   if(parameter==0L)
   {  uebrig();
      return(leeres_atom); /*kein Rückgabewert*/
   }
   else
   {  fehler(3,parameter);
      delete(parameter);
      return(-1L);
   }
}

struct atom *nachladen(parameter)
struct paar *parameter;
{  if(genug_parameter(parameter,1,1))
   {  register struct atom *hilf;
      extern WORD *wahr;
      hilf=evaluate(parameter->CAR);
      dispose(parameter);
      if((hilf!=0L)&&(hilf!=-1L)&&(hilf->knotentyp!=1)&&(hilf->
         zeichenkette[0]=='"'))
      {  char *help;
         help=hilf->zeichenkette+1L;
         while(*help!='"') help++;
         *help=0;
         if(load(hilf->zeichenkette+1L,0))
         {  dispose(hilf);
            if(edcheck()) transfer1(); /*Quelltext direkt mitladen*/
            return(wahr);
         }
         else
         {  dispose(hilf);
            return(0L);
         }
      }
      else
      {  if(hilf!=-1L)
            fehler(2,hilf);
         delete(hilf);
         return(-1L);
      }
   }
   else
   {  delete(parameter);
      return(-1L);
   }
}

WORD *terpri(parameter)
struct paar *parameter;
{  extern WORD *leeres_atom;
   if(parameter==0L)
   {  nprint("\n");
      return(leeres_atom);
   }
   else
   {  fehler(3,parameter);
      delete(parameter);
      return(-1L);
   }
}

struct paar *forbid(parameter,typ)
struct paar *parameter;
BYTE typ;
{  extern WORD *leeres_atom;
   if(parameter==0L)
   {  bildaus=typ;b_allow();
      return(leeres_atom);
   }
   else
   {  fehler(3,parameter);
      delete(parameter);
      return(0L);
   }
}