(*==============================================*)
(* 15.10.1986                                   *)
(* U1: 30.6.1989 / 8.7.1989                     *)
(* INCLUDE-FILE "P.CALL2.P"                     *)
(*==============================================*)
                                                  
 BEGIN (* STD *)                                  
  PARAMS:=[20..23,27,31,32,40..43,77,87];         
  IF NOT(I IN PARAMS) THEN TEST(KLAUF,9);         
  IF I<62 THEN    (* TRENNUNG NUR FUER COMPILER *)
  CASE I OF                                       
  (*----------------------------------PROZEDUREN*)
  16: (* OPEN    *)                               
     BEGIN FADR; CHKKOM;                          
      INTEXP; CHKKOM; INTEXP;                     
      IF SYM=KOMMA THEN                           
       BEGIN GETSYM; STREXP END                   
      ELSE GENLDC(0);                             
      GEN(OPNSYM) END;                            
  17: (* CLOSE   *) BEGIN FADR; GEN(CLSSYM) END;  
  18: (* GET     *) BEGIN FADR; GEN(SICSYM);      
       GENLDC(MEMLEN(TABA2[FIND])); GEN(GTSYM);   
       GEN(CLRSYM) END;                           
  19: (* PUT     *) BEGIN FADR; GEN(SOCSYM);      
       GENLDC(MEMLEN(TABA2[FIND])); GEN(PUTSYM);  
       GEN(CLRSYM) END;                           
  20: (* WRITE   *) RW(FALSE,FALSE);              
  21: (* WRITELN *) RW(TRUE ,FALSE);              
  22: (* READ    *) RW(FALSE,TRUE );              
  23: (* READLN  *) RW(TRUE ,TRUE );              
  24: (* GETKEY  *)                               
     BEGIN                                        
      IF SYM<>IDENT THEN ERROR(2);                
      ZUW1(POSITION(ID));                         
      TYPTEST(ZU.VTYP,CHART,116);                 
      GEN(KEYSYM); ZUW2(ZU.VTYP);                 
     END;                                         
  25: (* POKE    *)                               
     BEGIN INTEXP;CHKKOM; INTEXP; GEN(POKSYM) END;
  26: (* SYS, EVTL. MIT REGISTERUEBERGABE:      *)
     BEGIN INTEXP;                                
      IF SYM<>KOMMA THEN GENLDC(0)                
      ELSE                                        
       BEGIN GETSYM; GETVARADR(V);                
        IF MEMLEN(V.VTYP)<4 THEN ERROR(507);      
       END;                                       
      GEN(SYSSYM);                                
     END;                                         
  27: (* HALT *) GEN(HLTSYM);                     
  28: (* NEW  *)                                  
     BEGIN                                        
      IF SYM<>IDENT THEN ERROR(2);                
      ZUW1(POSITION(ID));                         
      IF TABART[ZU.VTYP]<>ZEIGTYP THEN ERROR(116);
      (* LAENGE DES OBJEKTES IST PARAMETER *)     
      GENLDC(MEMLEN(TABA2[ZU.VTYP]));             
      GEN(NEWSYM); ZUW2(ZU.VTYP);                 
     END;                                         
  29: (* MARK *)                                  
     BEGIN                                        
      IF SYM<>IDENT THEN ERROR(2);                
      ZUW1(POSITION(ID));                         
      IF TABART[ZU.VTYP]<>ZEIGTYP THEN ERROR(116);
      GENLDC(HEAPPTR);      (* ADR. HEAPPOINTER *)
      V.ACCESS:=ABSOLUTE; GENLS(LSYM,V);          
      ZUW2(ZU.VTYP);                              
     END;                                         
  30: (* RELEASE *)                               
     BEGIN                                        
      GENLDC(HEAPPTR);      (* ADR. HEAPPOINTER *)
      IF TABART[EXPRESSION]<>ZEIGTYP THEN         
         ERROR(116);                              
      V.ACCESS:=ABSOLUTE; GENLS(SSYM,V);          
     END;                                         
  31: (* SLOW *) GEN(SLOWSYM);                    
  32: (* FAST *) GEN(FASTSYM);                    
  33: (* INSERT *)                                
     BEGIN STREXP; CHKKOM; GETVARADR(V);          
      IF TABART[V.VTYP]<>STRTYP THEN ERROR(133);  
      CHKKOM; INTEXP;                             
      GEN(INSSYM); GEN(TABA1[V.VTYP]-1);          
     END;                                         
  34: (* DELETE *)                                
     BEGIN                                        
      GETVARADR(V);                               
      IF TABART[V.VTYP]<>STRTYP THEN ERROR(133);  
      CHKKOM; INTEXP; CHKKOM;                     
      INTEXP; GEN(DELSYM) END;                    
  (*----------------------------------FUNKTIONEN*)
  35: (* ORD     *)                               
     BEGIN                                        
      IF ISLONG(EXPRESSION)THEN ERROR(144);       
      STD:=INT                                    
     END;                                         
  36: (* CHR     *)                               
     BEGIN INTEXP; STD:=CHART END;                
  37,38: (* SUCC / PRED *)                        
     BEGIN X:=EXPRESSION;                         
      IF ISLONG(X) THEN                           
        BEGIN ERROR(144); X:=INT END;             
      GENLDC(1);                                  
      IF I=37 (* SUCC *) THEN GENOP(PLUS)         
                         ELSE GENOP(MINUS);       
      IF TSTFLG THEN            (* LAUFZEITTEST *)
       CASE TABART[X] OF                          
        AUSSCH:BEGIN GEN(TSTSYM); GENA(TABA3[X]); 
                GENA(TABA3[X]+TABA1[X])           
               END;                               
        AUFZHL:BEGIN GEN(TSTSYM); GENA(0);        
                GENA(TABA1[X])                    
               END                                
        ELSE (* KEIN TEST *)                      
       END; (* CASE *)                            
      STD:=X;                                     
     END;                                         
  39:(* PEEK *)                                   
     BEGIN INTEXP; GEN(PEKSYM); STD:=INT END;     
  40:(* EOLN *)                                   
     BEGIN                                        
      FOPER(2); IF FIND<>TXTF THEN ERROR(173);    
      STD:=BOOL                                   
     END;                                         
  41: (* EOF    *)BEGIN FOPER(0); STD:=BOOL END;  
  42: (* STATUS *)BEGIN FOPER(4); STD:=INT  END;  
  43: (* KEYPRESSED *)                            
     BEGIN                                        
      GEN(KEYSYM); GENLDC(0); GENOP(172); (* <> *)
      STD:=BOOL                                   
     END;                                         
  44: (* ODD    *)                                
     BEGIN                                        
      INTEXP; GENLDC(1); GENOP(128); (*LDC 1,AND*)
      STD:=BOOL                                   
     END;                                         
  45: (* ABS *)                                   
     BEGIN X:=EXPRESSION;                         
      IF X<>REALS THEN                            
       BEGIN TYPTEST(X,INT,125); GEN(ABISYM) END  
      ELSE GENROP(6);                             
      STD:=X                                      
     END;                                         
  46,47,48,49,50,51,52:                           
     BEGIN (* SQRT,LN,EXP,SIN,COS,TAN,ARCTAN *)   
      X:=EXPRESSION; TYPTEST(X,REALS,125);        
      GENROP(I-46+7); STD:=REALS                  
     END;                                         
  53,54,55: (* INT,ROUND,TRUNC  *)                
     BEGIN                                        
      IF EXPRESSION<>REALS THEN ERROR(125);       
      IF I=54 (* ROUND *) THEN                    
       BEGIN                                      
         GEN(LRCSYM); REALVALUE.R:=0.5; GENREAL;  
         GENROP(0); (* + *)                       
       END;                                       
      IF I=55 (* TRUNC *) THEN GEN(TRCSYM)        
                          ELSE GEN(INTSYM);       
      STD:=INT                                    
     END;                                         
  56,57: (* POWER, SQR *)                         
     BEGIN X:=EXPRESSION;                         
      TYPTEST(X,REALS,125);                       
      IF I=57 (* SQR *) THEN                      
       BEGIN                                      
        GEN(LRCSYM); REALVALUE.R:=2.0; GENREAL    
       END                                        
      ELSE                                        
       BEGIN CHKKOM;                              
        X:=EXPRESSION; TYPTEST(X,REALS,125);      
       END;                                       
      GENROP(4); STD:=REALS                       
     END;                                         
  58: (* ADDU  *)                                 
     BEGIN INTEXP;                                
      CHKKOM; INTEXP; GEN(ADUSYM); STD:=INT       
     END;                                         
  59: (* RANDOM *)                                
     BEGIN INTEXP; GEN(RNDSYM); STD:=REALS END;   
  60: (* HBYTE *)                                 
     BEGIN INTEXP; GEN(HBYSYM); STD:=INT END;     
  61: (* SIZEOF *)                                
     BEGIN I:=GETID;                              
      IF NOT(TABART[I] IN [STDTYP..ZEIGTYP]) THEN 
       ERROR(103);                                
      GENLDC(MEMLEN(I)); STD:=INT                 
     END;                                         
  END (* CASE *)                                  
  ELSE                                            
  CASE I OF                                       
  62: (* ADR *)                                   
     BEGIN GETVARADR(V); STD:=INT END;            
  63: (* CONCAT *)                                
     BEGIN STREXP; IF SYM<>KOMMA THEN ERROR(22);  
      REPEAT                                      
       GETSYM; STREXP; GEN(CCTSYM);               
      UNTIL SYM<>KOMMA;                           
      STD:=STRNG; TABA1[STRNG]:=0; TABA2[STRNG]:=1
     END;                                         
  64: (* COPY *)                                  
     BEGIN STREXP; CHKKOM; INTEXP;                
      CHKKOM; INTEXP; GEN(COPYSYM);               
      STD:=STRNG; TABA1[STRNG]:=0; TABA2[STRNG]:=1
     END;                                         
  65: (* LENGTH *)                                
     BEGIN STREXP; GEN(LENSYM); STD:=INT  END;    
  66: (* POS *)                                   
     BEGIN STREXP; CHKKOM; STREXP;                
      GEN(POSSYM); STD:=INT END;                  
  67: (* VAL *)                                   
     BEGIN STREXP; GEN(VALSYM); STD:=REALS END;   
  68: (* STR *)                                   
     BEGIN X:= EXPRESSION;                        
      TYPTEST(X,REALS,125);                       
      IF SYM<>DPKT THEN GENLDC(0)                 
      ELSE BEGIN GETSYM; INTEXP END;              
      IF SYM<>DPKT THEN GENLDC(-8)                
      ELSE BEGIN GETSYM; INTEXP END;              
      GEN(STRSYM);                                
      STD:=STRNG; TABA1[STRNG]:=0; TABA2[STRNG]:=1
     END;                                         
  (*----------------------------------PROZEDUREN*)
  69: (* GRAPHIC (MODUS,[LOESCH],[TEXTZEILE])   *)
    BEGIN                                         
     INTEXP; CHKSEP; DEFAULTEXP(0);               
     DEFAULTEXP(19); GENGRF;                      
    END;                                          
  70: (* PAINT ([FARBE],[KOORDINATEN],[MODUS])  *)
    BEGIN                                         
     DEFAULTEXP(1); GETDEFXY; CHKSEP;             
     DEFAULTEXP(0); GENGRF;                       
    END;                                          
  71: (* DISPLAY ([FARBE],[KOORDINATEN]         *)
      (*          STRING,[M])                   *)
    BEGIN                                         
     DEFAULTEXP(1); GETDEFXY; CHKSEP;             
     STREXP; CHKSEP; DEFAULTEXP(0); GENGRF;       
    END;                                          
  72: (* BOX([FARBE],KOORDINATEN,[KOORDINATEN], *)
      (* [WINKEL],[AUSMALFLAG])                 *)
    BEGIN                                         
     DEFAULTEXP(1); GETXY; CHKSEP;                
     GETDEFXY; CHKSEP; DEFAULTEXP(0);             
     DEFAULTEXP(0); GENGRF;                       
    END;                                          
  73: (* CIRCLE([FARBE],[KOORDINATEN],XRADIUS,  *)
      (* [YRADIUS],[START],[ENDE],[WINKEL],     *)
      (* [SEGMENTWINKEL]                        *)
    BEGIN                                         
     DEFAULTEXP(1); GETDEFXY; CHKSEP;             
     INTEXP; CHKSEP; X:=SYM; DEFAULTEXP(0);       
     DEFAULTEXP(0); DEFAULTEXP(360);              
     DEFAULTEXP(0); DEFAULTEXP(2);                
     GENGRF; GEN(ORD((X=KOMMA)OR(X=KLZU)));       
    END;                                          
  74: (* DRAW([FARBE],[KOORDINATEN],KOORDINATEN *)
      (* <,KOORDINATEN>)                        *)
    BEGIN                                         
     DEFAULTEXP(1);                               
     IF SYM<>KOMMA THEN                           
            (* ANFANGSPUNKT MIT LOCATE EXPLIZIT *)
      BEGIN GETXY; GEN(EXTSYM); GEN(LOCEXT) END;  
     CHKKOM;                                      
     REPEAT                                       
      GETXY; GENGRF; X:=SYM;                      
      IF X=KOMMA THEN                             
       BEGIN GETSYM;                              
        GEN(ALCSYM); GENA(2); (* FARBE AUF STACK*)
       END;                                       
     UNTIL X<>KOMMA;                              
    END;                                          
  75: (* LOCATE([KOORDINATEN])                  *)
    BEGIN                                         
     GETDEFXY; GENGRF;                            
    END;                                          
  76: (* COLOR(FARBE, FARBCODE)                 *)
    BEGIN                                         
     INTEXP; CHKKOM; INTEXP; GENGRF;              
    END;                                          
  77: (* SCNCLR / SCNCLR(MODUS)                 *)
    BEGIN                                         
     IF SYM=KLAUF THEN                            
      BEGIN                                       
       GETSYM; INTEXP; TEST(KLZU,4);              
      END ELSE GENLDC(-1);                        
     GENGRF;                                      
    END;                                          
  78: (* WINDOW *)                                
   BEGIN                                          
    INTEXP; CHKKOM; INTEXP; CHKKOM; INTEXP;       
    CHKKOM; INTEXP; CHKSEP;  DEFAULTEXP(0); GENGRF
   END;                                           
  79,81,84: (* WIDTH,VOL,TEMPO (INT)            *)
    BEGIN INTEXP; GENGRF END;                     
  80: (* SOUND (STIMME, FREQUENZ,DAUER,[RICHTUNG],
         [MAXFREQ],[STUFE],[WELLE],[IMPULSBR.]) *)
    BEGIN INTEXP;                                 
     CHKKOM; INTEXP; CHKKOM; INTEXP; CHKSEP;      
      DEFAULTEXP(0); DEFAULTEXP(0); DEFAULTEXP(0);
     DEFAULTEXP(2); DEFAULTEXP(2048); GENGRF      
    END;                                          
  82: (* FILTER([FREQ.],[TIEFP.],[BANDP.],        
         [HOCHP.],[RESONANZ]                    *)
    BEGIN                                         
     FOR X:= 1 TO 5 DO DEFAULTEXP(-1);            
     GENGRF                                       
    END;                                          
  83: (* PLAY (STRINGAUSDRUCK)                  *)
    BEGIN STREXP; GENGRF END;                     
  85: (* ENVELOPE (NUMMER,[ANSCHLAG],[ABSCHWELL], 
      [HALTE],[AUSKLING],[WELLE],[IMPULSBREITE] *)
    BEGIN INTEXP; CHKSEP;                         
     FOR X:= 1 TO 6 DO DEFAULTEXP(-1);            
     GENGRF                                       
    END;                                          
  86,87,88,89,90,91,92:                           
      (* RWINDOW,RGR,RCLR,RDOT,POT,PEN,JOY      *)
     BEGIN                                        
      IF I<>87 (* RGR *) THEN INTEXP              
      ELSE GENLDC(0);                             
      GEN(IFKSYM); GEN(I-86); STD:=INT            
     END;                                         
  END; (* CASE *)                                 
  IF NOT(I IN PARAMS) THEN TEST(KLZU,4);          
 END; (* STD *)                                   
                                                  
BEGIN (* CALL *)                                  
 IF TABA1[I]=0 THEN CALL:=STD(I) ELSE             
 BEGIN                                            
  NPAR:=TABA2[I];                                 
  IF NPAR<>0 THEN            (* MIT PARAMETERN  *)
   BEGIN                     (* 'PROLOG'        *)
    IF TABART[I]=FKT THEN    (* ERGEBNIS & HEAD *)
     BEGIN                                        
      GEN(ALCSYM); GENA(HEAD+LENFCTRES1(I))       
     END                                          
    ELSE GEN(MSTSYM);        (* NUR HEAD        *)
    TEST(KLAUF,9); J:=I+1;                        
    REPEAT           (* PARAMETER AUF DEN STACK *)
     TYPFORM:=TABA3[J];                           
     IF TYPFORM<0 THEN                            
      BEGIN                                       
       (* REFERENCE=> ABSOLUTE ADR. AUF STACK   *)
       GETVARADR(V);                              
       IF V.VTYP<>-TYPFORM THEN                   
        BEGIN        (* STRINGS EVTL. LIBERALER *)
         IF PARTEST OR                            
          (TABART[V.VTYP  ]<>STRTYP) OR           
          (TABART[-TYPFORM]<>STRTYP) OR           
          (TABA1[V.VTYP]<TABA1[-TYPFORM]) THEN    
          ERROR(127)                              
        END;                                      
      END (* REFERENCE *)                         
     ELSE                                         
      BEGIN                    (* CALL BY VALUE *)
       OLD:=COMPILINGPARAMETER;(* U1: >> *)       
       COMPILINGPARAMETER:=TRUE;                  
       K:=EXPRESSION; TYPTEST(K,TYPFORM,127);     
       COMPILINGPARAMETER:=OLD;(* U1: << *)       
       CASE TABART[TYPFORM] OF                    
        FELDTYP,VERBTYP:                          
         (* ADRESSE BEREITS GELADEN, RESERVIERE *)
         (* NOCH DEN PLATZ FUER DAS OBJEKT:     *)
          BEGIN                                   
           GEN(ALCSYM); GENA(MEMLEN(TYPFORM)-2);  
          END;                                    
        STRTYP:                                   
          BEGIN                                   
           (* STRING MIT MAXIMALLAENGE (!) AUF *) 
           (* DEM STACK HINTERLASSEN, DABEI    *) 
           (* PRUEFUNG AUF UEBERSCHREITUNG.    *) 
           GEN(LDSTRSYM); GEN(TABA1[TYPFORM]-1)   
          END                                     
        ELSE (* CASE, LEER *)                     
       END; (* CASE *)                            
      END;(* VALUE *)                             
     J:=J+1; K:=SYM; GETSYM;                      
    UNTIL K<>KOMMA;                               
    IF K<>KLZU THEN ERROR(4);                     
    IF J<>I+NPAR+1 THEN ERROR(126);               
   END (* MIT PARAMETERN *)                       
  ELSE                                            
   IF SYM=KLAUF THEN                              
    BEGIN ERROR(126);                             
     REPEAT GETSYM UNTIL SYM=KLZU; GETSYM         
    END;                                          
                                                  
  GEN(CUPSYM); GENA(TABA1[I]);                    
  GEN(LVL-ABS(TABA3[I]));  (* STATIC LEVEL UPRO *)
                                    (* 'EPILOG' *)
  (* BEI RUECKKEHR IST DER KORREKTE WERT AUF    *)
  (* DEM STACK. FALLS STRING, WERT IN MAXIMAL-  *)
  (* LAENGE UND MIT DUMMY-ADRESSE SOFORT (!)    *)
  (* AUF DEN STACK LADEN:                       *)
  IF TABART[I]=FKT THEN                           
   BEGIN J:=TABA3[I+NPAR+1]; CALL:=J;             
    (* U1: >>*)                                   
    CASE TABART[J] OF                             
    FELDTYP,VERBTYP:                              
     IF COMPILINGPARAMETER THEN ERROR(508);       
    STRTYP:                                       
     BEGIN                                        
      GEN(LDSTRSYM); GEN(TABA1[J]-1);             
      GENLDC(TABA1[J]-1);                         
      CALL:=STRNG; TABA1[STRNG]:=0;TABA2[STRNG]:=1
     END;                                         
    ELSE (* NOTHING *)                            
    END;                                          
    (* U1: <<*)                                   
   END;                                           
 END (* NICHT STANDARD *)                         
END; (* CALL *)