(*==============================================*)
(*  5.9.1985                                    *)
(* INCLUDE-FILE "P.DECL.P"                      *)
(*==============================================*)
                                                  
PROCEDURE LBLDECL;                                
(* LIEST DEKLARATION. FUER JEDES LABEL WIRD EIN *)
(* SPRUNGBEFEHL ERZEUGT. AUSSERDEM WIRD MIT ALC *)
(* DER STACKPOINTER KORREKT INITIALISIERT.      *)
(* DAS TATSAECHLICHE ZIEL UND DAS ARGUMENT FUER *)
(* ALC WERDEN BEIM LESEN DES LABELS NACHGETRAGEN*)
 VAR X:INTEGER;                                   
BEGIN                                             
 FIXFRE;                                          
 REPEAT                                           
  IF SYM<>INTNUM THEN ERROR(106)                  
  ELSE                                            
   BEGIN GETSYM;                                  
    FOR X:=0 TO LBLIND-1 DO                       
     IF LBL[X].VAL=NUM THEN ERROR(166);           
    IF LBLIND > MXLBL THEN ERROR(401)             
    ELSE                                          
     BEGIN                                        
      WITH LBL[LBLIND] DO                         
       BEGIN                                      
        ADR:=PC;VAL:=NUM;LEV:=-LVL;(*UNDEFINIERT*)
       END;                                       
      GEN(ALCSYM); FRE; GEN(JMPSYM); FRE;         
      (* PLATZ FUER DX-2 UND SPRUNGZIEL FREI!   *)
      LBLIND:=LBLIND+1                            
     END                                          
   END;                                           
  X:=SYM;GETSYM                                   
 UNTIL X<>KOMMA;                                  
 IF X<>SEMI THEN ERROR(14)                        
END;(* LBLDECL *)                                 
                                                  
PROCEDURE CSTDECL;                                
(* KONSTANTENDEKLARATION LESEN. STRINGS UND     *)
(* REELLE ZAHLEN KOMPILIEREN. ADRESSEN UND WERTE*)
(* IN DER BEZEICHNERTABELLE SPEICHERN.          *)
 VAR I,L  :INTEGER;                               
     NAME :TBEZ;                                  
BEGIN                                             
 REPEAT                                           
  IF SYM<>IDENT THEN ERROR(2)                     
  ELSE                                            
   BEGIN NAME:=ID;                                
    GETSYM; TEST(GLEICH,16); I:=GETCONST;         
    L:= TABA1[STRNG];    (* LAENGE FUER STRINGS *)
    IF I=NILS THEN                                
     BEGIN I:=INT; NUM:=0; ERROR(506) END;        
    IF I=REALS THEN                               
     IF REALVALUE.SIGN=0 THEN                     
      BEGIN NUM:=KC;                              
        FOR I:=0 TO 4 DO GENK(REALVALUE.S[I]);    
        I:=REALS; L:=1;                           
      END                                         
     ELSE L:= REALVALUE.SIGN;     (* NUM = ADR. *)
    EINTRAG (NAME,KONST,I,NUM,L);                 
   END;                                           
  TEST(SEMI,14);                                  
 UNTIL SYM<>IDENT                                 
END;(* CSTDECL *)                                 
                                                  
FUNCTION TYP:INTEGER;                             
(* LIEFERT INDEX AUF TYPEINTRAG UND MACHT EVTL. *)
(* SELBST NEUE EINTRAEGE IN DER BEZEICHNER-     *)
(* TABELLE. SO ENTSTANDENE 'NAMENLOSE' EINTRAEGE*)
(* DUERFEN NUR AM TABELLENENDE BEI TYPDECL MIT  *)
(* NAMEN VERSEHEN WERDEN.                       *)
(* ALLE LOKALEN FUNKTIONEN LIEFERN TYP-ZEIGER.  *)
                                                  
 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;                        
         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; TEST(KLZU,4);                   
        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;         
           GETSYM;                                
           IF (I=STRINGID) AND (SYM=EKLAUF) THEN  
            BEGIN    (* NEUEN STRINGTYP ANLEGEN *)
             GETSYM; J:=UNSCONST(FALSE);          
             IF J<>INT THEN ERROR(511);           
             IF NUM>255 THEN ERROR(114);          
             I:= TX;                              
             EINTRAG(DUMMY,STRTYP,NUM+1,0,0);     
             TEST(EKLZU,12);                      
            END;                                  
           IF TABART[I]=SAMET THEN I:=TABA1[I];   
          END; (* TYPBEZEICHNER *)                
        END  (* IDENT*)                           
   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:=MEMLEN(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 + MEMLEN(K); TABA3[I]:=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]:=CHR(-ORD(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]:=CHR(-ORD(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]:=CHR(-ORD(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 (*OF*),8);                           
    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]:=CHR(-ORD(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+MEMLEN(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 *)                                   
 IF SYM=151 (* PACKED *) THEN GETSYM;             
 CASE SYM OF                                      
  129 (* ARRAY  *):                               
     BEGIN GETSYM; TEST(EKLAUF,11); TYP:=FELD END;
  154 (* RECORD *):TYP:=RECRD;                    
  PFEIL           :TYP:=POINT;                    
  138 (* FILE   *):TYP:=SEQ;                      
  156 (* SET    *):TYP:=SETS                      
  ELSE TYP:= SIMPLETYPE                           
 END (* CASE *)                                   
END; (* TYP *)                                    
                                                  
PROCEDURE TYPDECL;                                
(* TYPDEKLARATIONEN LESEN. FORWARD-ZEIGERTYPEN  *)
(* NACHTRAGEN, 'NAMENLOSE' TYPEN EVTL. MIT NAMEN*)
(* VERSEHEN                                     *)
 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]:=CHR(-ORD(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; (* WHILE *)                             
    NAME[0]:=CHR(-ORD(NAME[0]));                  
    IF (TABBEZ[I,0]="*") 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 :I??
AR;                              
     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                (* NEUE LOKALE VARIABLE: *)
    BEGIN TABA1[I]:=DX; TABA2[I]:=LVL;            
     IF ISREF THEN                                
       BEGIN TABA3[I]:=-K; DX:= DX+2 END          
     ELSE                                         
       BEGIN TABA3[I]:= K;                        
        IF ISPARM THEN DX:=DX + STACKLEN(K)       
                  ELSE DX:=DX + MEMLEN  (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 *)