#include <exec/types.h>
#define new(a) a=neu((long int)(a+1L)-(long int)(a))
#define anzahl 84  /*Anzahl der in C implementierten Befehle*/

extern void dyninit(),uebrig(),beenden(),nprint();
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(),*fill(),*clear();
extern WORD *Do(),*While(),*For(),*nth();
extern WORD *cast(),*defobj(),*weltpos(),*farbe_rotat(),*drawobj();
extern WORD *world(),*zufall(),*change(),*reset();
extern WORD *killobjekt(),*objlist(),*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 zaehler,nenner;
              };
struct { int knotentyp;
         char zeichenkette[3];
       }befzeig[anzahl];
struct varlist *symbolliste=0L;
struct paar *system(),*nachladen(),*forbid();

/* 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=neu(sizeof(struct paar));
         hilf->CAR=copy(inhalt);
         hilf->CDR=merke->eintrag;
         hilf->knotentyp=1;
         merke->eintrag=hilf;
         merke->lokalzahl++;
         dispose(symbol);
      }
      else
      {  hilf=neu(sizeof(struct paar));
         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,"defobj");
   strcpy(befehle[56].name,"setpos");
   strcpy(befehle[57].name,"put");
   strcpy(befehle[58].name,"strech");
   strcpy(befehle[59].name,"color");
   strcpy(befehle[60].name,"rotate_z");
   strcpy(befehle[61].name,"rotate_y");
   strcpy(befehle[62].name,"rotate_x");
   strcpy(befehle[63].name,"print");
   strcpy(befehle[64].name,"view");
   strcpy(befehle[65].name,"random");
   strcpy(befehle[66].name,"float");
   strcpy(befehle[67].name,"nofloat");
   strcpy(befehle[68].name,"kill");
   strcpy(befehle[69].name,"killq");
   strcpy(befehle[70].name,"killo");
   strcpy(befehle[71].name,"varlist");
   strcpy(befehle[72].name,"objlist");
   strcpy(befehle[73].name,"open");
   strcpy(befehle[74].name,"close");
   strcpy(befehle[75].name,"princdat");
   strcpy(befehle[76].name,"sin");
   strcpy(befehle[77].name,"cos");
   strcpy(befehle[78].name,"atan");
   strcpy(befehle[79].name,"sqrt");
   strcpy(befehle[80].name,"log");
   strcpy(befehle[81].name,"exp");
   strcpy(befehle[82].name,"readdat");
   strcpy(befehle[83].name,"killfile");
   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);
}

/* 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();
   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));
            dispose(element);
            return(merke);
            /*Kopie des Symbolinhalts zurückgeben !*/
         }
      }
   }
   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(defobj(hilf));
                case 57:  return(weltpos(hilf,0));
                case 58:  return(weltpos(hilf,1));
                case 59:  return(weltpos(hilf,2));
                case 60:  return(farbe_rotat(hilf,0));
                case 61:  return(farbe_rotat(hilf,1));
                case 62:  return(farbe_rotat(hilf,2));
                case 63:  return(farbe_rotat(hilf,3));
                case 64:  return(drawobj(hilf));
                case 65:  return(world(hilf));
                case 66:  return(zufall(hilf));
                case 67:  return(change(hilf,1));
                case 68:  return(change(hilf,0));
                case 69:  return(reset(hilf,0));
                case 70 : return(reset(hilf,1));
                case 71 : return(killobjekt(hilf));
                case 72 : return(vlist(hilf));
                case 73 : return(objlist(hilf));
                case 74 : return(open_(hilf));
                case 75 : return(close_(hilf));
                case 76 : return(princ(hilf,1));
                case 77 : return(transzendent(hilf,0));
                case 78 : return(transzendent(hilf,1));
                case 79 : return(transzendent(hilf,2));
                case 80 : return(transzendent(hilf,3));
                case 81 : return(transzendent(hilf,4));
                case 82 : return(transzendent(hilf,5));
                case 83 : return(readdat(hilf));
                case 84 : return(ddelete(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;
              dispose(((struct paar*)hilf)->CAR); /*lambda löschen*/
              dispose(hilf);
              hilf=lambda(hilfx,element->CDR,typ);
              dispose(element);
              return(hilf);
           }
      }
   }
}

extern WORD *objektliste;

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

   coninit();
   dyninit();
   if(argc>2)
   {  printf("\nUsage : AmigaLisp [Programmname]\n");
      dynreinit();
      conreinit();
      exit(FALSE);
   }
   if(argc==2) /*Quelltext wird nachgeladen */
   {  BYTE dummy;
      dummy=load(*(++argv));
      if(!dummy)
      {  printf("\nLisp-Datei konnte nicht geladen werden.\n");
         dynreinit();
         conreinit();
         exit(FALSE);
      }
   }
   if(argc==0) /* von der Workbench aus gestartet !*/
   {  BYTE dummy;
      dummy=load("lisp/setup.lsp");
   }
   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;
           objektliste=0L;
           *eingabe=0;
        }
        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))
         {  dispose(hilf);
            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;
      return(leeres_atom);
   }
   else
   {  fehler(3,parameter);
      delete(parameter);
      return(0L);
   }
}