(* 16.3.1987 VERSION 1.4A *)                      
(* 13.6.1985 *)                                   
                                                  
FUNCTION TYP:INTEGER;                             
(*LIEFERT INDEX AUF TYPEINTRAG UND MACHT EVTL.  *)
(*SELBST NEUE EINTRAEGE IN DER BEZEICHNERTABELLE*)
(*DIE LOKALEN FUNKTIONEN LIEFERN TYP-ZEIGER     *)
 VAR ISPACKED:BOOLEAN;                            
                                                  
 FUNCTION PACKEDLENGTH(VAR I:INTEGER):INTEGER;    
 (*LIEFERT DIE LAENGE DES GEPACKTEN TYPS I.     *)
 (*FALLS GEPACKT WURDE, VORZEICHENWECHSEL VON I *)
 BEGIN                                            
  PACKEDLENGTH:=LEN(I);                           
  IF ISPACKED THEN                                
  CASE TABART[I] OF                               
   STDTYP,AUFZHL:                                 
    IF TABA1[I]<256 THEN                          
      BEGIN I:=-I;PACKEDLENGTH:=1 END;            
   AUSSCH:                                        
    BEGIN                                         
     IF(TABA3[I]>=0)AND(TABA1[I]+TABA3[I]<256)THEN
       BEGIN I:=-I;PACKEDLENGTH:=1 END            
    END                                           
   ELSE(*CASE LEER*)                              
  END(*CASE*)                                     
 END;(*PACKEDLENGTH*)                             
                                                  
 FUNCTION SIMPLETYPE:INTEGER;                     
  VAR I,J:INTEGER;                                
                                                  
  FUNCTION AUSTYP:INTEGER;                        
   VAR X:INTEGER;                                 
  BEGIN                                           
   I:=GETCONST;X:=NUM;TEST(174,1);J:=GETCONST;    
   IF ISLONG(J) THEN                              
     BEGIN ERROR(50);I:=INT;NUM:=0 END;           
   IF I<>J THEN BEGIN ERROR(107);J:=I END;        
   IF X>NUM THEN BEGIN ERROR(102);NUM:=X END;     
   AUSTYP:=TX;EINTRAG(DUMMY,AUSSCH,NUM-X,I,X);    
  END;(*AUSTYP*)                                  
                                                  
 BEGIN(*SIMPLETYPE*)                              
  CASE SYM OF                                     
  KLAUF:BEGIN J:=TX;I:=0;                         
       REPEAT GETSYM;                             
        IF SYM<>IDENT THEN ERROR(2)               
        ELSE                                      
         BEGIN EINTRAG(ID,KONST,0,I,0);I:=I+1 END;
        GETSYM                                    
       UNTIL SYM<>KOMMA;                          
       TEST(KLZU,4);EINTRAG(DUMMY,AUFZHL,I-1,0,0);
       (*VERWEISE AUF GRUNDTYP NACHTRAGEN       *)
       FOR I:=J TO TX-2 DO TABA1[I]:=TX-1;I:=TX-1 
      END;                                        
  IDENT:                                          
      BEGIN I:=POSITION(ID);                      
       IF(TABART[I]=KONST)AND(I>=0)THEN I:=AUSTYP 
       ELSE                                       
        BEGIN                                     
         IF I<0 THEN BEGIN ERROR(104);I:=INT END; 
         IF NOT INTEST(I,STDTYP,SAMET) THEN       
          BEGIN ERROR(103);I:=INT END;            
         IF TABART[I]=SAMET THEN I:=TABA1[I];     
         GETSYM;                                  
        END                                       
      END                                         
  ELSE(*CASE*)I:=AUSTYP                           
  END;(*CASE*)                                    
  SIMPLETYPE:=I                                   
 END;(*SIMPLETYPE*)                               
                                                  
 FUNCTION FELD:INTEGER;                           
 (*LIEST <SKALARTYP>,<SKTYP>...] OF.. UND       *)
 (*LIEFERT TYP-ZEIGER AUF GESAMTES FELD         *)
  VAR I,J,X:INTEGER;                              
 BEGIN                                            
  I:=SIMPLETYPE;                                  
  IF ISLONG(I)OR(I=INT)THEN ERROR(113);           
  IF SYM=KOMMA THEN                               
   BEGIN GETSYM;J:=FELD END                       
  ELSE                                            
   BEGIN                                          
    TEST(EKLZU,12);TEST(149(*OF*),8);J:=TYP       
   END;                                           
  FELD:=TX;X:=PACKEDLENGTH(J)*(TABA1[I]+1);       
  EINTRAG(DUMMY,FELDTYP,X,I,J)                    
 END;(*FELD*)                                     
                                                  
 FUNCTION RECRD:INTEGER;                          
 (*LIEFERT INDEX AUF RECORDEINTRAG, DER DEN KOPF*)
 (*DER SELEKTORLISTE BILDET (AENDERT TX)        *)
   VAR INDEX,LAENGE,LASTLINK:INTEGER;             
                                                  
  PROCEDURE FIELDLIST;                            
  (*REKURSIVE AUFRUFE UEBER VARIABEL!           *)
   VAR I,J,K:INTEGER;B1:BOOLEAN;                  
                                                  
   PROCEDURE DEFINIERE;                           
   (*DEFINIERE SELEKTOR I MIT TYP K (GLOBAL!)   *)
   (*ERWEITERE SELEKTOR-LISTE (LASTLINK/INDEX)  *)
   BEGIN                                          
    TABA1[I]:=LAENGE;TABA2[I]:=-1;                
    LAENGE:=LAENGE+PACKEDLENGTH(K);               
    TABA3[I]:=K;K:=ABS(K);                        
    IF LASTLINK<>-1 THEN TABA2[LASTLINK]:=I       
                    ELSE INDEX:=I;                
    LASTLINK:=I                                   
   END;(*DEFINIERE*)                              
                                                  
   PROCEDURE FEST;                                
   BEGIN                                          
    IF SYM=IDENT THEN                             
     BEGIN                                        
      I:=TX;ID[0]:=-ID[0];                        
      EINTRAG(ID,SELECT,0,0,0);GETSYM;            
      WHILE SYM=KOMMA DO                          
       BEGIN GETSYM;                              
        IF SYM<>IDENT THEN ERROR(2)               
        ELSE                                      
         BEGIN                                    
          ID[0]:=-ID[0];                          
          EINTRAG(ID,SELECT,0,0,0);GETSYM         
         END                                      
       END;                                       
      TEST(DPKT,5);J:=TX;K:=TYP;                  
      (*TYPEN NACHTRAGEN VON I BIS J-1*)          
      WHILE I<J DO                                
       BEGIN DEFINIERE;I:=I+1 END;                
     END                                          
   END;(*FEST*)                                   
                                                  
   PROCEDURE VARIABEL;                            
    VAR LENALT,MAX:INTEGER;COND:BOOLEAN;          
   BEGIN                                          
    IF SYM<>IDENT THEN ERROR(2);                  
    I:=POSITION(ID);                              
    IF I<0 THEN (*TAGFIELD*)                      
     BEGIN ID[0]:=-ID[0];                         
      EINTRAG(ID,SELECT,0,0,0);GETSYM;            
      TEST(DPKT,5)                                
     END;                                         
    K:=GETID;(*TAGFIELD TYPE*)                    
    IF ISLONG(K)THEN BEGIN ERROR(110);K:=INT END; 
    IF I<0 THEN (*TYP NACHTRAGEN*)                
      BEGIN I:=TX-1;DEFINIERE END;                
    TEST(149,8);(*OF*)                            
    LENALT:=LAENGE;MAX:=LAENGE;COND:=TRUE;        
    WHILE(SYM<>KLZU)AND(SYM<>137) (*END*) DO      
     BEGIN                                        
      IF NOT(COND)THEN ERROR(14);(*";" FEHLTE*)   
      IF SYM<>SEMI THEN                           
       BEGIN                                      
        REPEAT                                    
         CHECKCONST(K,111);                       
         COND:=SYM=KOMMA;IF COND THEN GETSYM;     
        UNTIL NOT COND;                           
        TEST(DPKT,5);TEST(KLAUF,9);FIELDLIST;     
        IF LAENGE>MAX THEN MAX:=LAENGE;           
        LAENGE:=LENALT;TEST(KLZU,4)               
       END;                                       
      COND:=SYM=SEMI;IF COND THEN GETSYM;         
     END;                                         
    LAENGE:=MAX;                                  
   END;(*VARIABEL*)                               
                                                  
  BEGIN (*FIELDLIST*)                             
   B1:=SYM<>131;(*CASE*)                          
   WHILE B1 DO                                    
    BEGIN FEST;B1:=SYM=SEMI;IF B1 THEN GETSYM;    
    END;                                          
   IF SYM=131 (*CASE*) THEN                       
    BEGIN GETSYM;VARIABEL END;                    
  END;(*FIELDLIST*)                               
                                                  
 BEGIN (*RECRD*)                                  
  GETSYM;INDEX:=-1;LASTLINK:=-1;LAENGE:=0;        
  FIELDLIST;TEST(137,13);(*END*)                  
  RECRD:=TX;EINTRAG(DUMMY,VERBTYP,LAENGE,INDEX,0) 
 END;(*RECRD*)                                    
                                                  
 FUNCTION POINT:INTEGER;                          
 (*ZEIGERTYP EVTL. MIT VORAUS-VEREINBARUNG      *)
  VAR I:INTEGER;                                  
 BEGIN                                            
  GETSYM;IF SYM<>IDENT THEN ERROR(2);             
  I:=POSITION(ID);                                
  IF I<0 THEN                                     
   (*VORAUS-VEREINBARUNG: ERWEITERE LISTE:      *)
   BEGIN ID[0]:=-ID[0];                           
    I:=TX;EINTRAG(ID,NUL,FWDTYP,0,0);FWDTYP:=I    
   END                                            
  ELSE                                            
   IF NOT INTEST(I,STDTYP,SAMET)THEN              
    BEGIN ERROR(103);I:=INT END;                  
  POINT:=TX;EINTRAG(DUMMY,ZEIGTYP,2,I,0);GETSYM   
 END;(*POINT*)                                    
                                                  
 FUNCTION SEQ:INTEGER;                            
  VAR I:INTEGER;                                  
 BEGIN                                            
  GETSYM;TEST(149,8);I:=TYP;SEQ:=TX;              
  EINTRAG(DUMMY,SEQTYP,6+LEN(I),I,0)              
 END;(*SEQ*)                                      
                                                  
 FUNCTION SETS:INTEGER;                           
  VAR I:INTEGER;                                  
 BEGIN                                            
  GETSYM;TEST(149,8);I:=SIMPLETYPE;SETS:=TX;      
  IF ISLONG(I) THEN BEGIN ERROR(109);I:=INT END;  
  IF(TABART[I]=AUSSCH)AND((TABA3[I]<0)OR          
    (TABA3[I]+TABA1[I]>95))THEN ERROR(501);       
  EINTRAG(DUMMY,MENGE,12,I,0)                     
 END;(*SETS*)                                     
                                                  
BEGIN (*TYP*)                                     
 ISPACKED:=SYM=151;IF ISPACKED THEN GETSYM;       
 CASE SYM OF                                      
  129(*ARRAY*):BEGIN                              
                GETSYM;TEST(EKLAUF,11);TYP:=FELD  
               END;                               
  154(*RECRD*):TYP:=RECRD;                        
  PFEIL       :TYP:=POINT;                        
  138(*FILE *):TYP:=SEQ;                          
  156(*SET  *):TYP:=SETS                          
  ELSE TYP:=SIMPLETYPE                            
 END(*CASE*)                                      
END;(*TYP*)                                       
                                                  
PROCEDURE TYPDECL;                                
 VAR I,J,P,Q:INTEGER;NAME:TBEZ;                   
BEGIN(*TYPDECL*)                                  
 REPEAT                                           
  IF SYM<>IDENT THEN ERROR(2)                     
  ELSE                                            
   BEGIN NAME:=ID;                                
    GETSYM;TEST(GLEICH,16);I:=TYP;                
    (*DURCHSUCHE LISTE DER FWD.TYPDECLARATIONEN:*)
    NAME[0]:=-NAME[0];                            
    P:=FWDTYP;WHILE P<>-1 DO                      
     BEGIN                                        
      IF TABBEZ[P]=NAME THEN                      
       BEGIN                                      
        TABA2[P+1]:=I;(*VERVOLLSTAENDIGE FWDDCL.*)
        IF P=FWDTYP THEN FWDTYP  :=TABA1[P]       
                    ELSE TABA1[Q]:=TABA1[P];      
       END;                                       
      Q:=P;P:=TABA1[P]                            
     END;                                         
    NAME[0]:=-NAME[0];                            
    IF(TABBEZ[I,0]=STERN)AND(TX-1=I) THEN         
     BEGIN TX:=TX-1;                              
      EINTRAG(NAME,TABART[I],TABA1[I],TABA2[I],   
            TABA3[I])                             
     END                                          
    ELSE EINTRAG(NAME,SAMET,I,0,0);               
   END;                                           
  TEST(SEMI,14)                                   
 UNTIL SYM<>IDENT;                                
END;(*TYPDECL*)                                   
                                                  
PROCEDURE PARDCL(ISPARM,ISREF:BOOLEAN);           
(*LIEST PARAMETERGRUPPE.                        *)
(*ISREF =TRUE => CALL BY REFERENCE              *)
(*ISPARM=TRUE => TYPBEZEICHNER MUSS FOLGEN      *)
 VAR I,J,K:INTEGER;ABSFLG:BOOLEAN;                
BEGIN I:=TX;                                      
 REPEAT (*SPEICHERE PROVISORISCH ALLE BEZEICHNER*)
  IF SYM<>IDENT THEN ERROR(2)                     
  ELSE BEGIN EINTRAG(ID,VARBLE,0,0,0);GETSYM END; 
  J:=SYM;GETSYM;                                  
 UNTIL J<>KOMMA;                                  
 IF J<>DPKT THEN ERROR(5);                        
 J:=TX;                                           
 IF ISPARM THEN                                   
  BEGIN K:=GETID;                                 
   IF NOT INTEST(K,STDTYP,SAMET) THEN             
    BEGIN ERROR(103);K:=INT END;                  
   IF TABART[K]=SAMET THEN K:=TABA1[K];           
  END                                             
 ELSE                                             
  BEGIN K:=TYP;IF FWDTYP<>-1 THEN ERROR(118) END; 
 IF ISPARM AND NOT ISREF AND (TABART[K]=SEQTYP)   
  THEN ERROR(121);                                
 IF SYM=EKLAUF THEN (*ABSOLUTE ADRESSIERUNG     *)
  BEGIN GETSYM;                                   
   IF GETCONST<>INT THEN ERROR(511);              
   TEST(EKLZU,12);ABSFLG:=TRUE;                   
   IF ISPARM THEN                                 
    BEGIN ERROR(512);ABSFLG:=FALSE END;           
  END                                             
 ELSE ABSFLG:=FALSE;                              
 (*TRAGE TYPEN IN BEZEICHNERTABELLE NACH        *)
 WHILE I<J DO                                     
  BEGIN                                           
   IF ABSFLG THEN                                 
    BEGIN TABA1[I]:=NUM;TABA2[I]:=0;TABA3[I]:=K   
   END ELSE                                       
    BEGIN TABA1[I]:=DX;TABA2[I]:=LVL;             
     IF ISREF                                     
      THEN BEGIN TABA3[I]:=-K;DX:=DX+2      END   
      ELSE BEGIN TABA3[I]:= K;DX:=DX+LEN(K) END;  
    END;                                          
   I:=I+1                                         
  END;                                            
END;(*PARDCL*)                                    
                                                  
PROCEDURE VARDECL;                                
(*VEREINBARE LOKALE VARIABLEN:                  *)
BEGIN                                             
 REPEAT PARDCL(FALSE,FALSE);                      
  TEST(SEMI,14)                                   
 UNTIL SYM<>IDENT;                                
END;(*VARDECL*)