/* Befehlsmodul (Modul 3) */

#include <exec/types.h>
#define new(a) a=neu((ULONG)sizeof(int)+8L)
#define anzahl 26  /*Anzahl der implementierten C-Befehle*/

extern void dyninit(),nprint(),rprint();
extern char *edit();
extern WORD *input();
extern void output();
extern WORD *car(),*cdr(),*cons();
extern WORD *copy();
extern void delete(),dispose();
extern WORD *neu();
extern WORD *evaluate();
extern void initsymbol();
extern long int length();
extern BYTE bildaus;
extern WORD *leeres_atom,*wahr;
struct paar { int knotentyp;
              WORD *CAR;
              WORD *CDR;
            };
struct atom { int knotentyp;
              char zeichenkette[2];
            };
struct bruch { int knotentyp;         /*Dies beiden Strukturen dienen*/
               char kennung[2];       /*dem leichteren Zugriff auf */
               int zaehler,nenner;    /*Zahlen*/
             };
struct dezimal{int knotentyp;
               char kennung[2];
               float wert;
              };
/* fehler gibt die Fehlermeldungen aus !*/

#define zeigeraus output(zeiger);nprint("\n")
#define err rprint("\nFehler : ")
#define war rprint("\nWarnung : ")

extern BYTE bildaus;

void fehler(nummer,zeiger)
int nummer;
WORD *zeiger;
{  BYTE merke;    /*auch wenn Systemmeldungen unterdrückt werden sollen,*/
   merke=bildaus; /*müssen Fehlermeldungen ausgegeben werden. */
   bildaus=1;
   switch(nummer)
   {case 1 :  err;nprint("Nicht genug Parameter :");
              zeigeraus; break;
    case 2 :  err;nprint("Parameter ungeeignet :");
              zeigeraus;break;
    case 3 :  err;nprint("Zuviele Parameter :");
              zeigeraus;break;
    case 4 :  err;nprint("'dos.library' konnte nicht geöffnet werden.\n");
              break;
    case 5 :  err;nprint("Quelltext konnte nicht geladen werden.\n");
              break;
    case 6 :  err;nprint("Quelltext zu lang.\n"); break;
    case 7 :  err;nprint("dynamisch verwalteter Speicher ist voll.\n");
              nprint("Das Betriebssystem kann außerdem keinen weiteren Speicher bereitstellen.\n");
              nprint("Der Interpreter muß verlassen werden.\n");
              break;
    case 8 :  err;nprint("\nDer Computerspeicher ist voll.\n");
              nprint("Der Interpreter muß verlassen werden.\n");break;
    case 9 :  err;nprint("Parameter bezeichnet keine Liste : ");
              zeigeraus;break;
    case 10:  war;nprint("String unbegrenzt - [\"] fehlt : ");
              zeigeraus;break;
    case 11:  war;nprint("Klammer [)] überflüssig.\n");break;
    case 12:  war;nprint("Punkt [.] falsch gesetzt.\n");break;
    case 13:  war;nprint("Klammer [)] fehlt.\n");break;
    case 14:  war;nprint("Symbol noch nicht definiert : ");
              zeigeraus;break;
    case 15:  war;nprint("zuviele Argumente : ");
              zeigeraus;break;
    case 16:  war;nprint("nicht genug Argumente für Lambda-Term.\n");
              break;
    case 17:  war;nprint("&aux oder &rest zuviel angegeben.\n");break;
    case 18:  err;nprint("Liste der Parameter falsch : ");
              zeigeraus;break;
    case 19:  err;nprint("Grafikmodus bereits eingeschaltet.\n");break;
    case 20:  err;nprint("'intuition.library' kann nicht geöffnet werden.\n");
              break;
    case 21:  err;nprint("'graphics.library' kann nicht geöffnet werden.\n");
              break;
    case 22:  err;nprint("Der Grafikscreen kann nicht geöffnet werden.\n");
              break;
    case 23:  err;nprint("Grafikmodus nicht eingeschaltet.\n");break;
    case 24:  err;nprint("Wert außerhalb [-190;190]\n");break;
    case 25:  err;nprint("Wert außerhalb [-218;218]\n");break;
    case 27:  war;nprint("syntaktisch falsche Zahl eingegeben");break;
    case 28:  war;nprint("Zahl zu groß : ");zeigeraus;
              nprint("Die Zahl wird als Null interpretiert.\n");break;
    case 29:  err;nprint("Division durch Null !\n");break;
    case 30:  err;nprint("Zahl zu groß für ASCII !\n");break;
    case 31:  err;nprint("Bildschirmgrenze überschritten !\n");break;
    case 32:  err;nprint("Liste beginnt nicht mit einem Befehl :");
              zeigeraus;break;
    case 33:  war;nprint("Bruch wurde approximiert !\n");break;
    case 34:  err;nprint("Datei nicht geöffnet !\n");break;
    case 35:  war;nprint("Daten konnten nicht geschrieben werden !\n");break;
    case 36:  war;nprint("Die Evaluierung wurde abgebrochen.\n");break;
    case 37:  err;nprint("Wert außerhalb des Definitionsbereichs von sqrt oder log.");
              break;
    case 38:  war;nprint("Klammer (]) erwartet\n");break;
    case 39:  war;nprint("Klammer (]) überflüssig\n");break;
    case 40:  err;nprint("Komponenten müssen zu (reellen) Zahlen auswerten: ");
              zeigeraus;break;
   }
   bildaus=merke;
}

/* genug_parameter überprüft, ob mindestens min und höchstens max */
/* Parameter zur Verfügung stehen und gibt gg. Fehlermeldungen aus*/
/* bei max =-1 dürfen beliebig viele Parameter auftreten.*/

BYTE genug_parameter(parameter,min,max)
struct paar *parameter;
int min,max;
{  register int i=0;
   struct paar *merke;

   merke=parameter;
   while((parameter!=0L)&&(parameter->knotentyp==1))
   {  i++;
      parameter=parameter->CDR;
   }
   if((parameter==0L)&&(i>=min)&&((i<=max)||(max==-1)))
      return(1); /*Parameter ok.*/
   else
   {  if(parameter!=0L)
         fehler(2,merke);
      else
         if(i<min)
            fehler(1,merke);
         else
            fehler(3,merke);
      return(0);
   }
}

/* carcdr beschafft sich die Parameter für car bzw cdr und */
/* ruft diese Fkt auf.*/

struct atom *carcdr(parameter,typ)
struct paar *parameter;
BYTE typ;                 /* = 0:car, 1:cdr 2:cadr*/
{  struct atom *para1;

   if(genug_parameter(parameter,1,1))
   {  para1=parameter->CAR;
      dispose(parameter);
      parameter=evaluate(para1);
      if(parameter!=-1L)
        if(typ==1)
           return(cdr(parameter));
        else
           if(!typ)
              return(car(parameter));
           else
              if(parameter->CDR!=0L)
              { para1=cdr(parameter);
                if((para1==-1)||(para1->knotentyp!=1))
                {  if(para1!=-1)
                   {  fehler(2,para1); delete(para1); }
                   return(-1L);
                }
                return(car(para1));
              }
              else
              { fehler(2,parameter);
                delete(parameter);
                return(-1L);
              }
      else
        return(-1L);
   }
   else
   {  delete(parameter);
      return(-1L);
   }
}

BYTE error; /*Fehlerport für evalquote*/

/*evalquote wertet mit , gekennz. Atome aus*/

struct paar* evalquote(parameter)
struct paar* parameter;
{
   if(parameter!=0L)
     if(parameter->knotentyp==1)
     {  parameter->CAR=evalquote(parameter->CAR);
        parameter->CDR=evalquote(parameter->CDR);
        return(parameter);
     }
     else
     {  register struct atom *hilf;
        hilf=parameter;
        if(hilf->zeichenkette[0]==',')
        /*Auswertung muß erfolgen !*/
        {  strcpy(hilf->zeichenkette,&(hilf->zeichenkette[1]));/*,weg*/
           hilf=evaluate(hilf);
           if(hilf==-1L)
           {  hilf=0L;
              error=1;
           }
           return(hilf);
        }
        else
           return(hilf);
     }
   else
      return(0L);
}

/* quote_ gibt einen Zeiger auf das nachfolgende Listenelement zurück.*/

struct paar *quote(parameter)
struct paar *parameter;
{  register struct paar *para1;

   if(genug_parameter(parameter,1,1))
   {  para1=parameter->CAR;
      dispose(parameter);error=0;
      para1=evalquote(para1);
      if(error)
      {  delete(para1);
         return(-1L);
      }
      else
         return(para1);
   }
   else
   {  delete(parameter);
      return(-1L);
   }
}

struct paar *list(parameter)
struct paar *parameter;
{  BYTE argaus();
   BYTE hilf;
   if(genug_parameter(parameter,1,-1))
   {  hilf=argaus(parameter);
      if(hilf)
         return(parameter);
      else
         return(-1L);
   }
   else
   {  delete(parameter);
      return(-1L);
   }
}


WORD *set(parameter,typ)
struct paar *parameter;
BYTE typ; /* 0:set, 1:setq */
{
   if(genug_parameter(parameter,2,2))
   {  register struct atom *hilf;

      if(typ)
         hilf=parameter->CAR;
      else
         hilf=evaluate(parameter->CAR);
      if((hilf==-1L)||(hilf==0L)||(hilf->knotentyp==1))
      {  delete(parameter->CDR);
         dispose(parameter);
         if(hilf!=-1L)
         { fehler(2,hilf);
           delete(hilf);
         }
         return(-1L);
      }
      else
        if(befehl(hilf->zeichenkette)||
           (hilf->zeichenkette[0]=='"')||
           (hilf->zeichenkette[0]=='æ')||
           ((hilf->zeichenkette[0]=='t')&&(hilf->zeichenkette[1]==0)))
        {  /*erster Parameter ist kein Symbol !!!*/
           fehler(2,hilf);
           delete(parameter->CDR);
           dispose(parameter);
           delete(hilf);
           return(-1L);
        }
        else
        {  struct paar *hilf2;
           hilf2=parameter->CDR;
           dispose(parameter);
           parameter=hilf2->CAR;
           dispose(hilf2);
           parameter=evaluate(parameter);
           if(parameter==-1L)
           {  dispose(hilf);
              return(-1L);
           }
           else
           {  initsymbol(hilf,parameter,1);
              return(parameter);
           }
        }
     }
   else
   {  delete(parameter);
      return(-1L);
   }
}

/* reset löscht eine Variable wieder */

struct varlist { int knotentyp;
                 struct varlist *links,*rechts;
                 struct paar *eintrag;
                 struct atom *name;
                 int lokalzahl;
               };

WORD *reset(parameter,typ)
struct paar *parameter;
BYTE typ; /* 0:kill, 1:killq */
{
   if(genug_parameter(parameter,1,1))
   {  register struct atom *hilf;

      if(typ)
         hilf=parameter->CAR;
      else
         hilf=evaluate(parameter->CAR);
      dispose(parameter);
      if((hilf==-1L)||(hilf==0L)||(hilf->knotentyp==1))
      {  if(hilf!=-1L)
         { fehler(2,hilf);
           delete(hilf);
         }
         return(-1L);
      }
      else
        if(befehl(hilf->zeichenkette)||
           (hilf->zeichenkette[0]=='"')||
           (hilf->zeichenkette[0]=='æ')||
           ((hilf->zeichenkette[0]=='t')&&(hilf->zeichenkette[1]==0)))
        {  /*erster Parameter ist kein Symbol !!!*/
           fehler(2,hilf);
           delete(hilf);
           return(-1L);
        }
        else
        {  struct varlist *variable;
           variable=suchsymbol(hilf,1);
           if(variable)
           {  if(!(variable->lokalzahl))  /*ist nicht lokal*/
              {  delsymbol(hilf);
                 return(wahr);
              }
              else
              {  dispose(hilf);
                 return(0L);     /*ist lokal !!!*/
              }
           }
           else
           {  dispose(hilf);
              return(0L);
           }
        }
   }
   else
   {  delete(parameter);
      return(-1L);
   }
}
WORD *cons_(parameter)
struct paar *parameter;
{
   if(genug_parameter(parameter,2,2))
   {  register WORD *hilf1, *hilf2;
      hilf1=parameter->CAR;
      hilf2=((struct paar*)(parameter->CDR))->CAR;
      dispose(parameter->CDR);
      dispose(parameter);
      hilf1=evaluate(hilf1);
      hilf2=evaluate(hilf2);
      if((hilf1==-1L)||(hilf2==-1L))
      {  delete(hilf1);
         delete(hilf2);
         return(-1L);
      }
      else
         return(cons(hilf1,hilf2));
   }
   else
   {  delete(parameter);
      return(-1L);
   }
}

/* eval beschafft sich einen Parameter und wertet ihn zweimal aus.*/

struct paar *eval(parameter)
struct paar *parameter;
{  register struct paar *para1;

   if(genug_parameter(parameter,1,1))
   {  para1=parameter->CAR;
      dispose(parameter);
      para1=evaluate(para1);
      if(para1!=-1L)
         para1=evaluate(para1);
      return(para1);
   }
   else
   {  delete(parameter);
      return(-1L);
   }
}

/* Divisionsalgorithmus */

int ggt(a,b)
int a,b;
{  register int h;
   if(a<b)
   {  h=b;b=a;a=h; }
   while(b)
   {  h=a%b;
      a=b;
      b=h;
   }
   return(a);
}

/* Prozedur zum Kürzen von Brüchen */

int betrag(x)
int x;
{  if(x<0)
      return((-1)*x);
   else
      return(x);
}

int kzae,knen;

void kuerzen(x,y)
int x,y;
{  register int i,j;
   int vz=1;
   i=x;
   j=y;
   if((!i)||(!j))   /*Ergebnis: 0*/
   {  kzae=0;knen=1;return();
   }
   if(i<0)
   {  vz=-1;i*=-1;
   }
   if(j<0)
   {  if(vz) vz=1;
      else   vz=-1;
      j*=-1;
   }
   i=ggt(i,j);

   kzae=betrag(x)*vz/i;
   knen=betrag(y)/i;
}

BYTE fehlerport=1; /*bei Typumwandlung Fehler aufgetreten ? 1=nein*/

/* string_int wandelt einen Atominhalt in eine Zahl um*/

float potenz[19]={ 1.0e0,1.0e1,1.0e2,1.0e3,1.0e4,1.0e5,1.0e6,1.0e7,
                   1.0e8,1.0e9,
                   1.0e10,1.0e11,1.0e12,1.0e13,1.0e14,1.0e15,1.0e16,1.0e17,
                   1.0e18 };
/* ist genauer als exp(log(10)*exponent); */

struct atom* string_int(zeiger)
char *zeiger;
{  extern BYTE varzeichen();
   short int vz=0,Bruch=1;
   int i=0,zaehler=0,nenner=0;
   float wert=0.0,merke=0.0;
   struct bruch *knoten;

   fehlerport=1;
   if(*zeiger=='-')
   {  vz=1;zeiger++;
   }
   while((*zeiger>=48)&&(*zeiger<58))
   {  /*Zähler berechnen*/
      zaehler*=10;
      wert*=10;
      zaehler+=(int)(*zeiger)-48;
      wert+=(float)(*zeiger++)-48.0;
   }
   if(wert>2.1e9)    /*Der Nenner war zu groß*/
      Bruch=0; /*Jetzt nur Dezimalbruch*/
   if((*zeiger=='.')&&(*(zeiger+1)>=48)&&(*(zeiger+1)<58))
   {  Bruch=0;i=0;   /* "." kann auch Konkatenationssymbol sein */
      zeiger++;
      while((*zeiger>=48)&&(*zeiger<58))
      {  i++;
         wert*=10;
         wert+=(float)(*zeiger++)-48.0;
      }
      while(i-->0)    /*Wieder durch 10^i dividieren*/
         wert/=10.0;
      if((*zeiger=='e')||(*zeiger=='E'))
      {  int exponent=0,i=0;
         short int vz=0;
         zeiger++;
         if(*zeiger=='-')
         {  zeiger++;
            vz=1;
         }
         while((*zeiger>=48)&&(*zeiger<58)&&(i<2))
            exponent=exponent*10+(int)(*zeiger++)-48;
         if((i==2)||(exponent>18))
         {  while((*zeiger>=48)&&(*zeiger<58))
               zeiger++;
            fehler(28,0L);
            wert=0.0;
         }
         else  /*den Exponenten setzen*/
            if(vz) wert/=potenz[exponent];
            else   wert*=potenz[exponent];
      }
   }
   else if(*zeiger=='/')  /*Es folgt ein Nenner*/
   {  zeiger++;
      while((*zeiger>=48)&&(*zeiger<58))
      {
         nenner*=10;
         nenner+=(int)(*zeiger)-48;
         merke*=10;
         merke+=(float)(*zeiger++)-48;
      }
      if((merke==0.0)&&(nenner==0))     /*Division durch 0*/
      {  zaehler=0;nenner=1;wert=0.0;
         fehler(27,0L);
      }
      else
        if((merke>2.1e9)||(!Bruch))     /*Bruch zu groß*/
        {  Bruch=0;
           wert/=merke;
        }
   }
   else  /*nur eine ganze Zahl */
      nenner=1;
   if(varzeichen(*zeiger)&&(*zeiger!='.')) /*nach der Zahl folgt etwas*/
      fehler(27,0L);
   knoten=neu(sizeof(struct bruch));
   knoten->knotentyp=2;
   knoten->kennung[0]='æ';
   if(Bruch)
   {   knoten->kennung[1]='B';
       kuerzen(zaehler,nenner);
       if(vz)
          kzae*=-1;
       ((struct bruch*)knoten)->zaehler=kzae;
       ((struct bruch*)knoten)->nenner=knen;
   }
   else
   {   knoten->kennung[1]='F'; /*Kennung für Fließkomma*/
       if(vz)
          wert*=-1.0;
       ((struct dezimal*)knoten)->wert=wert;
   }
   return(knoten);
}

/* int_string wandelt einen Zahlknoten in einen String um */

char *int_string(zahl)
struct bruch *zahl;
{  static char text[80]; /*damit der Rückgabezeiger nicht verfällt*/
   if(zahl->kennung[1]=='B')
      if(zahl->nenner!=1)
         sprintf(text,"%d/%d",zahl->zaehler,zahl->nenner);
      else
         sprintf(text,"%d",zahl->zaehler);
   else  /*Fließkommazahl ausgeben*/
      sprintf(text,"%.6f",((struct dezimal*)zahl)->wert);
   return(text);
}

/* getint liest eine ganze Zahl aus einem Zahlenknoten */

int getint(knoten)
struct bruch *knoten;
{  if(knoten->kennung[1]=='B')
      return(knoten->zaehler/knoten->nenner);
   else
      return((int)(((struct dezimal*)knoten)->wert));
}

/* getfloat liest eine Fließkommazahl aus einem Zahlenknoten*/

float getfloat(knoten)
struct bruch *knoten;
{  if(knoten->kennung[1]=='B')
      return((float)(knoten->zaehler)/(float)(knoten->nenner));
   else
      return(((struct dezimal*)knoten)->wert);
}

/* transzendent realisiert die reelen transzendenten und die (reele) Wurzelfunktionen*/
extern float sin(),cos(),atan(),sqrt(),log(),exp();
struct knoten *transzendent(parameter,typ)
struct paar *parameter;
BYTE typ;
{  if(genug_parameter(parameter,1,1))
   {  struct dezimal *hilf;
      hilf=evaluate(parameter->CAR);
      dispose(parameter);
      if((hilf!=-1L)&&(hilf!=0L)&&(hilf->knotentyp==2)&&
         (hilf->kennung[0]=='æ'))
      {  float a;
         a=getfloat(hilf);
         if(((typ==4)&&(a<=0.0))||((typ==3)&&(a<0.0)))
         {  dispose(hilf);
            fehler(37,0L);    /*Funktion hier nicht definiert.*/
            return(-1L);
         }
         switch(typ)
         { case 0 : a=sin(a); break;
           case 1 : a=cos(a); break;
           case 2 : a=atan(a);break;
           case 3 : a=sqrt(a);break;
           case 4 : a=log(a); break;
           case 5 : a=exp(a); break;
         }
         hilf->kennung[1]='F';
         hilf->wert=a;
         return(hilf);
      }
      else
      {  if(hilf!=-1L)
         {  fehler(2,hilf); delete(hilf);
         }  return(-1L);
      }
   }
   else
   {  delete(parameter);
      return(-1L);
   }
}

/* change wandelt eine Zahl in einen Bruch um, falls typ=0 */
/* falls typ=1 wandelt change in Fließkommazahl um*/

extern float abs();

struct knoten *change(parameter,typ)
struct paar *parameter;
BYTE typ;
{  if(genug_parameter(parameter,1,1))
   {  struct dezimal *hilf;
      int nenner,zaehler;

      hilf=evaluate(parameter->CAR);
      dispose(parameter);
      if((hilf==-1L)||(hilf==0L)||(hilf->knotentyp!=2)||
         (hilf->kennung[0]!='æ'))
      {  if(hilf!=-1L)
         {  fehler(2,hilf);
            delete(hilf);
         }
         return(-1L);
      }
      if((hilf->kennung[1]=='B')&&(!typ))
         return(hilf);
      else if(hilf->kennung[1]=='B')
      {  hilf->kennung[1]='F';
         hilf->wert=(float)(((struct bruch*)hilf)->zaehler)/
                    (float)(((struct bruch*)hilf)->nenner);
         return(hilf);
      }
      if(typ)           /*falls float in float umgewandelt werden soll*/
         return(hilf);
      nenner=1;zaehler=0;
      if(hilf->wert==0.0)
         zaehler=0;
      else
      { int lauf=0;
        while((abs(hilf->wert)<1000000.0)&&(lauf<9))
        {  hilf->wert*=10.0;nenner*=10;lauf++;
        }
        zaehler=(int)(hilf->wert);
        kuerzen(zaehler,nenner);
        zaehler=kzae;nenner=knen;
      }
      ((struct bruch*)hilf)->zaehler=zaehler;
      ((struct bruch*)hilf)->nenner=nenner;
      hilf->kennung[1]='B';
      return(hilf);
   }
   else
   {  delete(parameter);
      return(-1L);
   }
}

void negieren(zahl) /*multipliziert reelle Zahl mit -1*/
struct bruch *zahl;
{  if(zahl->kennung[1]=='B') zahl->zaehler*=-1;
   else ((struct dezimal*)zahl)->wert*=-1.0;
}
struct atom *quad(zahl)
struct bruch *zahl;
{ if(zahl->kennung[1]=='B')
  { zahl->zaehler*=zahl->zaehler;
    zahl->nenner*=zahl->nenner;
  }
  else ((struct dezimal*)zahl)->wert*=((struct dezimal*)zahl)->wert;
  return(zahl);
}
/* plus addiert zwei Zahlen beliebigen Typs, Ergebnis im ersten Parameter */
/* die Parameter müssen ! ausgewertet sein */
struct atom *plus(zahl1,zahl2,typ)  /*typ==1 : Subtraktion*/
struct bruch *zahl1,*zahl2;
BYTE typ;
{ int a,b,h;
  float c,d;
  struct paar *merke;
  if((zahl1->knotentyp==2)&&(zahl2->knotentyp==2)) /*reel*/
  { if((zahl1->kennung[1]=='B')&&(zahl2->kennung[1]=='B'))
    { h=ggt(zahl1->nenner,zahl2->nenner);    /* zwei Brüche */
      a=zahl2->nenner/h;b=zahl1->nenner/h;
      if(typ)
        zahl1->zaehler=zahl1->zaehler*a-zahl2->zaehler*b;
      else
        zahl1->zaehler=zahl1->zaehler*a+zahl2->zaehler*b;
      zahl1->nenner=h*a*b;
      kuerzen(zahl1->zaehler,zahl1->nenner);
      zahl1->zaehler=kzae;
      zahl1->nenner=knen;
      dispose(zahl2);
      return(zahl1);
    }
    /*Fließkomma oder Umwandlung*/
    c=getfloat(zahl1);
    d=getfloat(zahl2); dispose(zahl2);
    zahl1->kennung[1]='F';
    if(typ)
       ((struct dezimal*)zahl1)->wert=c-d;
    else
       ((struct dezimal*)zahl1)->wert=c+d;
    return(zahl1);
  }
  else /*komplex*/
  {  if((zahl1->knotentyp==4)&&(zahl2->knotentyp==4))
     {  ((struct paar*)zahl1)->CAR=plus(((struct paar*)zahl1)->CAR,
             ((struct paar*)zahl2)->CAR,typ);
        ((struct paar*)zahl1)->CDR=plus(((struct paar*)zahl1)->CDR,
             ((struct paar*)zahl2)->CDR,typ);
        dispose(zahl2);
        if(getfloat(((struct paar*)zahl1)->CDR)==0.0)
        {  dispose(((struct paar*)zahl1)->CDR);  /*reell machen*/
           merke=zahl1;zahl1=((struct paar*)zahl1)->CAR; dispose(merke);
        }
        return(zahl1);
     }
     if(zahl1->knotentyp==2) /*erster Parameter reell, zweiter komplex*/
     {  ((struct paar*)zahl2)->CAR=plus(zahl1,((struct paar*)zahl2)->CAR,typ);
        if(typ)
          negieren(((struct paar*)zahl2)->CDR);
        if(getfloat(((struct paar*)zahl2)->CDR)==0.0)
        {  dispose(((struct paar*)zahl2)->CDR);
           merke=zahl2;zahl2=((struct paar*)zahl2)->CAR; dispose(merke);
        }
        return(zahl2);
     }
     ((struct paar*)zahl1)->CAR=plus(((struct paar*)zahl1)->CAR,zahl2,typ);
     /*erster komplex...*/
     if(getfloat(((struct paar*)zahl1)->CDR)==0.0)
     {  dispose(((struct paar*)zahl1)->CDR);
        merke=zahl1;zahl1=((struct paar*)zahl1)->CAR; dispose(merke);
     }
     return(zahl1);
  }
}

struct atom* mal(zahl1,zahl2,typ) /*typ==1 : Division, gibt -1 bei Division durch 0 zurück*/
struct bruch *zahl1,*zahl2;
BYTE typ;
{ int a,b,h;
  float c,d;
  struct bruch *r1,*r2,*i1,*i2;
  struct paar *merke;
  if((zahl1->knotentyp==2)&&(zahl2->knotentyp==2)) /*reel*/
  { if((zahl1->kennung[1]=='B')&&(zahl2->kennung[1]=='B'))
    { if(typ)
      { zahl1->zaehler*=zahl2->nenner; zahl1->nenner*=zahl2->zaehler;
        if(zahl1->nenner==0)
        { fehler(29,0L); dispose(zahl2); dispose(zahl1); return(0L); }
        if(zahl1->nenner<0) { zahl1->nenner*=-1; zahl1->zaehler*=-1; }
      }
      else
      { zahl1->zaehler*=zahl2->zaehler; zahl1->nenner*=zahl2->nenner; }
      dispose(zahl2);
      kuerzen(zahl1->zaehler,zahl1->nenner);
      zahl1->zaehler=kzae;
      zahl1->nenner=knen;
      return(zahl1);
    }
    /*Fließkomma oder Umwandlung*/
    c=getfloat(zahl1);
    d=getfloat(zahl2); dispose(zahl2);
    zahl1->kennung[1]='F';
    if(typ)
    {  if(d==0.0)
       { dispose(zahl1); dispose(zahl2); fehler(29,0L); return(0L); }
       ((struct dezimal*)zahl1)->wert=c/d;
    }
    else
      ((struct dezimal*)zahl1)->wert=c*d;
    return(zahl1);
  }
  else /*komplex*/
  {  if((!typ)&&(zahl1->knotentyp==4)&&(zahl2->knotentyp==4))
     { r1=copy(((struct paar*)zahl1)->CAR);
       i1=copy(((struct paar*)zahl1)->CDR);
       r2=copy(((struct paar*)zahl2)->CAR);
       i2=copy(((struct paar*)zahl2)->CDR);
       r1=mal(r1,r2,0); /*r2 ex. nicht mehr*/
       i1=mal(i1,i2,0);
       r2=mal(((struct paar*)zahl1)->CAR,((struct paar*)zahl2)->CDR,0);
       i2=mal(((struct paar*)zahl1)->CDR,((struct paar*)zahl2)->CAR,0);
       plus(r1,i1,1);
       ((struct paar*)zahl1)->CAR=plus(i2,r2,0);
       ((struct paar*)zahl1)->CAR=r1;
       dispose(zahl2);
       if(getfloat(((struct paar*)zahl1)->CDR)==0.0)
       {  dispose(((struct paar*)zahl1)->CDR);
          merke=zahl1;zahl1=((struct paar*)zahl1)->CAR; dispose(merke);
       }
       return(zahl1);
     }
     if(typ&&(zahl2->knotentyp==4))
     { r2=copy(((struct paar*)zahl2)->CAR);
       i2=copy(((struct paar*)zahl2)->CDR);
       negieren(((struct paar*)zahl2)->CDR);
       zahl1=mal(zahl1,zahl2,0);
       r2=copy(r1=plus(quad(r2),quad(i2),0));
       if(((struct paar*)zahl1)->CAR=mal(((struct paar*)zahl1)->CAR,r1,1))
       { ((struct paar*)zahl1)->CDR=mal(((struct paar*)zahl1)->CDR,r2,1);
         if(getfloat(((struct paar*)zahl1)->CDR)==0.0)
         {  dispose(((struct paar*)zahl1)->CDR);
            merke=zahl1;zahl1=((struct paar*)zahl1)->CAR; dispose(merke);
         }
         return(zahl1);
       }
       else
       { dispose(((struct paar*)zahl1)->CDR);
         dispose(r2); dispose(zahl1);
         return(0L);
       }
     }
     if(zahl1->knotentyp==2) /*erster Parameter reell, zweiter komplex, typ 0*/
     { r1=copy(zahl1);
       ((struct paar*)zahl2)->CAR=mal(((struct paar*)zahl2)->CAR,r1,0);
       ((struct paar*)zahl2)->CDR=mal(((struct paar*)zahl2)->CDR,zahl1,0);
       if(getfloat(((struct paar*)zahl2)->CDR)==0.0)
       {  dispose(((struct paar*)zahl2)->CDR);
          merke=zahl2;zahl2=((struct paar*)zahl2)->CAR; dispose(merke);
       }
       return(zahl2);
     }
     if(!typ)  /*erster Parameter komplex, zweiter reell*/
     { r1=copy(zahl2);
       ((struct paar*)zahl1)->CAR=mal(((struct paar*)zahl1)->CAR,r1,0);
       ((struct paar*)zahl1)->CDR=mal(((struct paar*)zahl1)->CDR,zahl2,0);
       if(getfloat(((struct paar*)zahl1)->CDR)==0.0)
       {  dispose(((struct paar*)zahl1)->CDR);
          merke=zahl1;zahl1=((struct paar*)zahl1)->CAR; dispose(merke);
       }
       return(zahl1);
     }
     else
     { r1=copy(zahl2);
       if(((struct paar*)zahl1)->CAR=mal(((struct paar*)zahl1)->CAR,r1,1))
       { ((struct paar*)zahl1)->CDR=mal(((struct paar*)zahl1)->CDR,zahl2,1);
         if(getfloat(((struct paar*)zahl1)->CDR)==0.0)
         {  dispose(((struct paar*)zahl1)->CDR);
            merke=zahl1;zahl1=((struct paar*)zahl1)->CAR; dispose(merke);
         }
         return(zahl1);
       }
       else
       { dispose(((struct paar*)zahl1)->CDR);
         dispose(zahl2); dispose(zahl1);
         return(0L);
       }
     }
  }
}
/* rechnen führt die Grundrechenarten auf der übergebenen Parameter-*/
/* struktur aus*/
/* werden nur Brüche übergeben, so ist das Ergebnis ein Bruch, */
/* findet sich mindestens ein Dezimalbruch, so ist das Ergebnis ebenfalls*/
/* eine Fließkommazahl, treten komplexe Zahlen auf, so wird komplex gerechnet*/
struct atom *rechnen(parameter,art)
struct paar *parameter;
char art;
{  if((art=='%')||(art==':')) /* 2-Parameter-Befehle*/
   {  if(genug_parameter(parameter,2,2))
      {  struct bruch *merke1,*merke2;
         int i;
         merke1=evaluate(parameter->CAR);
         if((!merke1)||(merke1==-1L)||(merke1->knotentyp!=2)||
            (merke1->kennung[0]!='æ'))
         { if(merke1!=-1L) {fehler(2,merke1); delete(merke1);}
           delete(parameter->CDR); dispose(parameter); return(-1L);
         }
         merke2=evaluate(((struct paar*)parameter->CDR)->CAR);
         dispose(parameter->CDR); dispose(parameter);
         if((!merke2)||(merke2==-1L)||(merke2->knotentyp!=2)||
            (merke2->kennung[0]!='æ'))
         { if(merke2!=-1L) {fehler(2,merke2); delete(merke2);}
           delete(merke2); return(-1L);
         }
         i=getint(merke2); dispose(merke2);
         if(i==0) { fehler(29,0L); dispose(merke1); return(-1L); }
         switch(art)
         { case '%' : merke1->zaehler=getint(merke1)%i; break;
           case ':' : merke1->zaehler=getint(merke1)/i; break;
         }
         merke1->nenner=1; merke1->kennung[1]='B';
         return(merke1);
      }
      else { delete(parameter); return(-1L); }
   }
   if(genug_parameter(parameter,2,-1))
   { struct atom *merke,*neu;
     struct paar *hilf;
     merke=evaluate(parameter->CAR);
     hilf=parameter; parameter=parameter->CDR; dispose(hilf);
     if((!merke)||(merke==-1L)||(merke->knotentyp==1)||(merke->knotentyp==3)
       ||((merke->knotentyp!=4)&&(merke->zeichenkette[0]!='æ')))
     {  if(merke!=-1L) { fehler(2,merke); delete(merke); }
        delete(parameter); return(-1L);
     }
     if(merke->knotentyp==4)
     { if((((struct bruch*)((struct paar*)merke)->CAR)->knotentyp!=2)||
          (((struct bruch*)((struct paar*)merke)->CDR)->knotentyp!=2)||
          (((struct bruch*)((struct paar*)merke)->CAR)->kennung[0]!='æ')||
          (((struct bruch*)((struct paar*)merke)->CDR)->kennung[0]!='æ'))
       { fehler(2,merke);delete(merke);delete(parameter);
         return(-1L);
     } }
     while(parameter!=0L)
     { neu=evaluate(parameter->CAR);
       hilf=parameter; parameter=parameter->CDR; dispose(hilf);
       if((!neu)||(neu==-1L)||(neu->knotentyp==1)||(neu->knotentyp==3)
       ||((neu->knotentyp!=4)&&(neu->zeichenkette[0]!='æ')))
       {  if(neu!=-1L) { fehler(2,neu); delete(neu);delete(merke); }
          delete(parameter); return(-1L);
       }
       /*Korrektheitstest für kompl. Zahlen*/
       if(neu->knotentyp==4)
       { if((((struct bruch*)((struct paar*)neu)->CAR)->knotentyp!=2)||
            (((struct bruch*)((struct paar*)neu)->CDR)->knotentyp!=2)||
            (((struct bruch*)((struct paar*)neu)->CAR)->kennung[0]!='æ')||
            (((struct bruch*)((struct paar*)neu)->CDR)->kennung[0]!='æ'))
         { delete(merke);fehler(2,neu);delete(neu);delete(parameter);
           return(-1L);
       } }
       switch(art)
       { case '+' : merke=plus(merke,neu,0); break;
         case '-' : merke=plus(merke,neu,1); break;
         case '*' : merke= mal(merke,neu,0); break;
         case '/' : if(!(merke=mal(merke,neu,1)))
                    { delete(parameter); return(-1L); }
                    break;
       }
     }
     return(merke);
   }
   else
   { delete(parameter); return(-1L); }
}
/* cast wandelt eine reelle Zahl in eine ganze Zahl um*/

struct bruch *cast(parameter)
struct paar *parameter;
{  if(genug_parameter(parameter,1,1))
   {  struct bruch *hilf;
      hilf=evaluate(parameter->CAR);
      dispose(parameter);
      if((hilf!=-1L)&&(hilf!=0L)&&(hilf->knotentyp==2)&&
         (hilf->kennung[0]=='æ'))
         if(hilf->kennung[1]=='B')
         {  hilf->zaehler/=hilf->nenner;
            hilf->nenner=1;
            return(hilf);
         }
         else
         {  hilf->zaehler=(int)(((struct dezimal*)hilf)->wert);
            hilf->kennung[1]='B';
            hilf->nenner=1;
            return(hilf);
         }
      else
      {  if(hilf!=-1L)
         {  fehler(3,hilf);
            delete(hilf);
         }
         return(-1L);
      }
   }
   else
   {  delete(parameter);
      return(-1L);
   }
}

/* datentyp wertet den nachfolgenden Parameter aus und wendet auf*/
/* ihn listp atom oder null an.*/

struct atom *datentyp(parameter,typ)
struct paar *parameter;
BYTE typ; /*1=listp,2=atom,3=null*/
{  register struct atom *hilf;

   if(genug_parameter(parameter,1,1))
   {  hilf=evaluate(parameter->CAR);
      dispose(parameter);
      parameter=hilf;
      if(parameter==-1L)
         return(-1L);
      else
      {  if((parameter==0L)||
            ((typ==1)&&(parameter->knotentyp==1))||
            ((typ==2)&&(parameter->knotentyp==2)) )
         {  hilf=neu((ULONG)sizeof(int)+3L);
            hilf->knotentyp=2;
            hilf->zeichenkette[0]='t';
            hilf->zeichenkette[1]=0;
         }
         else
            hilf=0L;
         delete(parameter);
         return(hilf);
      }
   }
   else
   {  delete(parameter);
      return(-1L);
   }
}

/* verhaeltnis vergleicht zwei Knoteninhalte und gibt zurück :*/
/* 0 falls gleich, 1 falls k1 < k2, 2 falls k1 > k2*/

BYTE verhaeltnis(knoten1,knoten2)
struct atom *knoten1,*knoten2;
{  struct atom *merke;             /*zwei komplexe Zahlen*/
   int a,b,c,d;
   if((knoten1->knotentyp==4)&&(knoten2->knotentyp==4))
   {  if((((struct bruch*)((struct paar*)knoten1)->CAR)->knotentyp==2)&&
         (((struct bruch*)((struct paar*)knoten2)->CAR)->knotentyp==2)&&
         (((struct bruch*)((struct paar*)knoten1)->CAR)->kennung[0]=='æ')&&
         (((struct bruch*)((struct paar*)knoten2)->CAR)->kennung[0]=='æ'))
      { a=getfloat(((struct paar*)knoten1)->CAR);
        b=getfloat(((struct paar*)knoten1)->CDR);delete(knoten1);
        c=getfloat(((struct paar*)knoten2)->CAR);
        d=getfloat(((struct paar*)knoten2)->CDR);delete(knoten2);
        if((a==c)&&(b==d)) return(0);
        if(a*a+b*b<=c*c+d*d) return(1); /*sonst Beträge vergleichen*/
        return(2);
      }
   }
   if(knoten1->knotentyp==4)   /*komplex/reell gemischt*/
   {  if((((struct bruch*)((struct paar*)knoten1)->CDR)->knotentyp==2)&&
         (((struct bruch*)((struct paar*)knoten1)->CDR)->kennung[0]=='æ'))
      { if(getfloat(((struct paar*)knoten1)->CDR)==0.0)
        { dispose(((struct paar*)knoten1)->CDR);
          merke=knoten1; knoten1=((struct paar*)knoten1)->CAR; dispose(merke);
        }
        else
        { a=getfloat(((struct paar*)knoten1)->CAR);
          b=getfloat(((struct paar*)knoten1)->CDR);delete(knoten1);
          c=getfloat(knoten2);
          delete(knoten1);delete(knoten2);
          if(a*a+b*b<=c*c) return(1); /*sonst Beträge vergleichen*/
          return(2);
        }
   }  }
   if(knoten2->knotentyp==4)
   {  if((((struct bruch*)((struct paar*)knoten2)->CDR)->knotentyp==2)&&
         (((struct bruch*)((struct paar*)knoten2)->CDR)->kennung[0]=='æ'))
      { if(getfloat(((struct paar*)knoten2)->CDR)==0.0)
        { dispose(((struct paar*)knoten2)->CDR);
          merke=knoten2;knoten2=((struct paar*)knoten2)->CAR; dispose(merke);
        }
        else
        { a=getfloat(((struct paar*)knoten2)->CAR);
          b=getfloat(((struct paar*)knoten2)->CDR);delete(knoten2);
          c=getfloat(knoten1);
          delete(knoten1);delete(knoten2);
          if(a*a+b*b>=c*c) return(1); /*sonst Beträge vergleichen*/
          return(2);
        }
   }  }
   if((knoten1->knotentyp!=2)||(knoten2->knotentyp!=2))
   {  if(knoten1->knotentyp!=2) fehler(2,knoten1);
                           else fehler(2,knoten2);
      delete(knoten1);delete(knoten2);
      return(3);
   }
   else
   {  if((knoten1->zeichenkette[0]=='"')&&(knoten2->zeichenkette[0]=='"'))
      /*Strings werden verglichen*/
      {  register char *z1,*z2;
         char hilf1,hilf2;

         z1=&(knoten1->zeichenkette[1]);
         z2=&(knoten2->zeichenkette[1]);
         while((*z1!='"')&&(*z1==*z2))
         {  z1++;z2++;  }
         hilf1=*z1;hilf2=*z2;
         dispose(knoten1);dispose(knoten2);
         if(hilf1==hilf2)
            return(0);
         else
           if(hilf1=='"')
              return(1);
           else
              if(hilf2=='"')
                 return(2);
              else
                 if(hilf1 > hilf2)
                    return(2);
                 else
                    return(1);
      }
      else
        if((knoten1->zeichenkette[0]=='æ')&&(knoten2->zeichenkette[0]=='æ'))
        {  register float i,j;
           BYTE fehlerp=1;
           if((knoten1->zeichenkette[1]=='B')&&
              (knoten2->zeichenkette[1]=='B'))
           {  register int iz,in;
              /* Auf Hauptnenner bringen */              /*Brüche werden*/
              kuerzen(((struct bruch*)knoten1)->zaehler, /*exakt verglichen*/
                      ((struct bruch*)knoten1)->nenner);
              iz=kzae;in=knen;                           /*Kürzen gg. weg-*/
              kuerzen(((struct bruch*)knoten2)->zaehler, /*lassen, da dies*/
                      ((struct bruch*)knoten2)->nenner); /*beim Rechenen */
              if((iz==kzae)&&(in==knen))                 /*automatisch...*/
              { dispose(knoten1);dispose(knoten2);return(0); }
           }
           i=getfloat(knoten1);
           j=getfloat(knoten2);
           dispose(knoten1);dispose(knoten2);
           if(i==j)
             return(0);
           else
             if(i<j)
                return(1);
             else
                return(2);
        }
        else
        {  if(knoten1->zeichenkette[0]!='æ')
              fehler(2,knoten1);
           else
              fehler(2,knoten2);
           dispose(knoten1);dispose(knoten2);
           return(3);
        }
   }
}

extern int dateiw;  /*Dateihandle für Zieldatei*/
extern BYTE datflag;

struct paar *princ(parameter,typ)
struct paar *parameter;
BYTE typ; /*0: princ, 1:princdat*/
{  if(typ&&(dateiw==-1L)) /*File noch nicht geöffnet*/
   {  delete(parameter);
      fehler(34,0L);
      return(-1L);
   }
   if(genug_parameter(parameter,1,-1))
   {  extern WORD *leeres_atom;
      struct paar *merke;
      register struct atom *hilf;
      hilf=0L;
      do
      {  delete(hilf);
         hilf=evaluate(parameter->CAR);
         if(hilf!=-1L)
         {  if((hilf!=0L)&&(hilf->knotentyp==2)&&(hilf->zeichenkette[0]
               =='"')&&(!typ))
            {  register char *zeig;
               zeig=&(hilf->zeichenkette[1]);  /* " weglassen */
               while(*zeig!='"') zeig++;
               *zeig=0;
               nprint(&(hilf->zeichenkette[1]));
               *zeig='"';
            }
            else
            {  BYTE merke;
               merke=bildaus;
               bildaus=1;
               if(typ)
                  datflag=0;
               output(hilf);
               bildaus=merke;
               if(typ)
               {  int d;
                  d=write(dateiw," ",1); /*Trennung*/
                  if((datflag==2)||(d!=1))
                     fehler(35,0L);
                  datflag=1;
               }
            }
            merke=parameter->CDR;
            dispose(parameter);parameter=merke;
         }
         else
         {  delete(parameter->CDR);
            dispose(parameter);
         }
      }while((parameter!=0L)&&(hilf!=-1L));
      if(hilf!=-1L)
      {  delete(hilf);
         return(leeres_atom);
      }
      else
         return(-1L);
   }
   else
   {  delete(parameter);
      return(-1L);
   }
}