(*13.6.1985                                     *)
PROCEDURE EXPAND (VAR TYP:INTEGER);               
(*AUSSCHNITT-TYP AN GRUNDTYP ANPASSEN           *)
BEGIN                                             
 IF TABART[TYP]=AUSSCH THEN TYP:=TABA2[TYP]       
END;(*EXPAND*)                                    
                                                  
PROCEDURE TYPTEST                                 
(VAR TYP1:INTEGER;TYP2,ERR:INTEGER);              
(*TYPANPASSUNG TYP1 AN TYP 2, EVTL. ERROR(ERR)  *)
(*FUER LAUFZEITTEST UND INT->FLOAT MUSS DAS     *)
(*OBJEKT MIT TYP1 AUF DEM STACK LIEGEN          *)
BEGIN                                             
 IF TABART[TYP2]=AUSSCH THEN                      
  BEGIN                                           
   IF TYP1=TABA2[TYP2] THEN                       
     BEGIN                                        
      IF TSTFLG THEN (* LAUFZEITTEST COMPILIEREN*)
       BEGIN GEN(TSTSYM);GENA(TABA3[TYP2]);       
        GENA(TABA3[TYP2]+TABA1[TYP2])             
       END;                                       
      TYP2:=TYP1                                  
     END;                                         
  END                                             
 ELSE                                             
  IF TABART[TYP1]=AUSSCH THEN TYP1:=TYP2;         
 IF TYP2=REALS THEN                               
  IF TYP1=INT THEN                                
   BEGIN GEN(FLTSYM);TYP1:=REALS END;             
 IF TYP1<>TYP2 THEN                               
  CASE TABART[TYP2]OF                             
   ZEIGTYP:BEGIN (*AUSNAHME: T1 IST NIL         *)
            IF(TABART[TYP1]<>ZEIGTYP)OR           
              ((TABA2[TYP1]<>TABA2[TYP2])AND      
               (TABA2[TYP1]>=0)) THEN ERROR(ERR); 
           END;                                   
   MENGE:  BEGIN (*AUSNAHME: T1 IST LEERE MENGE *)
            IF TABART[TYP1]<>MENGE THEN ERROR(ERR)
            ELSE                                  
             BEGIN TYP2:=TABA2[TYP2];EXPAND(TYP2);
              IF(TABA2[TYP1]<>TYP2)AND            
                (TABA2[TYP1]>=0) THEN ERROR(ERR); 
             END                                  
           END;                                   
   FELDTYP:BEGIN (*AUSNAHME: T1 IST STRING      *)
            IF(TABA3[TYP2]<>CHART) OR             
              (TABA3[TYP1]<>CHART) OR             
              (TABA1[TYP2]<>TABA1[TYP1])          
            THEN ERROR(ERR)                       
           END                                    
   ELSE(*CASE*)ERROR(ERR)                         
  END(*CASE*)                                     
END;(*TYPTEST*)                                   
                                                  
PROCEDURE GENLS(OPC:INTEGER;VAR V:VARDESCRIPTOR); 
(*LADE DEN INHALT EINER VARIABLEN               *)
BEGIN                                             
 CASE V.ACCESS OF                                 
  BASEOFFSET:BEGIN                                
              IF LVL=V.LEVEL THEN                 
               BEGIN                              
                GEN(OPC+2);GENA(V.OFFSET)         
               END                                
              ELSE                                
               BEGIN GEN(OPC);                    
                GENA(V.OFFSET);GEN(LVL-V.LEVEL)   
               END                                
             END;                                 
  ABSOLUTE  :GEN(OPC+3);                          
  BASESTACK :BEGIN                                
              GEN(OPC+1);GEN(LVL-V.LEVEL)         
             END                                  
 END;(*CASE*)                                     
END;(*GENLS*)                                     
                                                  
PROCEDURE GENF(VAR V:VARDESCRIPTOR);              
(*LADE DIE ADRESSE EINER VARIABLEN              *)
BEGIN                                             
 CASE V.ACCESS OF                                 
  BASEOFFSET:BEGIN                                
              IF LVL=V.LEVEL THEN                 
               BEGIN                              
                GEN(FSYM+2);GENA(V.OFFSET)        
               END                                
              ELSE                                
               BEGIN GEN(FSYM);                   
                GENA(V.OFFSET);GEN(LVL-V.LEVEL)   
               END                                
             END;                                 
  BASESTACK :BEGIN                                
              GEN(FSYM+1);GEN(LVL-V.LEVEL)        
             END                                  
  ELSE(*CASE,LEER*)                               
 END;(*CASE*)                                     
END;(*GENF*)                                      
                                                  
PROCEDURE VARIABLE(I:INTEGER;VAR V:VARDESCRIPTOR);
(*AUFRUF: I ZEIGT AUF VARIABLEN- ODER SELEKTOR- *)
(*        EINTRAG; SYM=IDENT.                   *)
(*BEI RUECKKEHR:                                *)
(*V ENTHAELT INFORMATIONEN FUER GENLS/GENF      *)
 VAR W:INTEGER;R:REAL;                            
BEGIN                                             
 WITH V DO BEGIN                                  
 ISPACKED:=FALSE;                                 
 IF(I>=0)AND(TABART[I]=VARBLE) THEN               
  BEGIN                                           
   OFFSET:=TABA1[I];LEVEL:=TABA2[I];              
   VTYP:=TABA3[I];ACCESS:=BASEOFFSET;             
   IF LEVEL=0 THEN (*ABSOLUTE ADRESSE           *)
    BEGIN GENLDC(OFFSET);                         
     OFFSET:=0;ACCESS:=ABSOLUTE                   
    END;                                          
   IF VTYP<0 THEN(*CALL BY REFERENCE:           *)
    BEGIN                                         
     GENLS(LSYM,V);OFFSET:=0;                     
     VTYP:=-VTYP;ACCESS:=ABSOLUTE                 
    END                                           
  END                                             
 ELSE                                             
  IF TABART[I]=SELECT THEN                        
   BEGIN (*ABSOLUTE  RECORDADRESSE => STACK     *)
    ACCESS:=BASEOFFSET;LEVEL:=LVL;                
    OFFSET:=WITHADR;GENLS(LSYM,V);                
    ACCESS:=ABSOLUTE;OFFSET:=TABA1[I];            
    VTYP  :=TABA3[I];ISPACKED:=VTYP<0;            
    IF ISPACKED THEN VTYP:=-VTYP                  
   END                                            
  ELSE                                            
   BEGIN (*UNDEFINIERTER BEZEICHNER => DEFAULT  *)
    ERROR(59);VTYP:=INT;LEVEL:=LVL;               
    OFFSET:=0;ACCESS:=BASEOFFSET                  
   END;                                           
 GETSYM;(*RECORD V ENTHAELT BESCHREIBUNG        *)
 WHILE(SYM=EKLAUF)OR(SYM=PUNKT)OR(SYM=PFEIL)DO    
  CASE SYM OF                                     
  EKLAUF:(*ARRAY*)                                
   BEGIN GETSYM;                                  
    REPEAT                                        
     IF TABART[VTYP]<>FELDTYP THEN ERROR(138);    
     W:=TABA2[VTYP];(*W IST ZEIGER AUF INDEXTYP *)
     I:=EXPRESSION;TYPTEST(I,W,139);              
     VTYP:=TABA3[VTYP];                           
     IF VTYP>=0 THEN I:=LEN(VTYP)                 
     ELSE (*PACKED*)                              
      BEGIN VTYP:=-VTYP;ISPACKED:=TRUE;I:=1 END;  
     IF TABART[W]=AUSSCH THEN                     
      BEGIN (*UG SUBTRAHIEREN / OFFSET ANPASSEN *)
       R:=TABA3[W];                               
       IF ABS(R*I)>=4096 THEN(*VERMEIDE OVERFLOW*)
        BEGIN GENLDC(TABA3[W]);GENOP(MINUS) END   
       ELSE OFFSET:=OFFSET-I*TABA3[W]             
      END;                                        
     GENLDC(I);GENOP(STERN);                      
     IF ACCESS=BASEOFFSET THEN ACCESS:=BASESTACK  
     ELSE GEN(ADUSYM);                            
     I:=SYM;GETSYM                                
    UNTIL I<>KOMMA;                               
    IF I<>EKLZU THEN ERROR(12);                   
   END;                                           
  PUNKT:                                          
   BEGIN GETSYM;                                  
    IF TABART[VTYP]<>VERBTYP THEN ERROR(140)      
    ELSE                                          
     BEGIN                                        
      IF SYM<>IDENT THEN ERROR(2);                
      I:=SELSEARCH(VTYP);GETSYM;                  
      IF I>=0 THEN                                
       BEGIN                                      
        OFFSET:=OFFSET+TABA1[I];                  
        VTYP:=TABA3[I];ISPACKED:=VTYP<0;          
        IF ISPACKED THEN VTYP:=-VTYP              
       END ELSE ERROR(152)                        
     END                                          
   END;                                           
  PFEIL:                                          
   BEGIN GETSYM;                                  
    IF TABART[VTYP]=ZEIGTYP THEN                  
     BEGIN (*HOLE ADRESSE DES DYN. OBJEKTES     *)
      IF(ACCESS<>BASEOFFSET)AND(OFFSET<>0) THEN   
       BEGIN                                      
        GENLDC(OFFSET);GEN(ADUSYM);OFFSET:=0      
       END;                                       
      GENLS(LSYM,V);ACCESS:=ABSOLUTE;             
      OFFSET:=0;VTYP:=TABA2[VTYP]                 
     END ELSE                                     
     IF TABART[VTYP]=SEQTYP THEN                  
      BEGIN (*FILE-BUFFER ADRESSE UEBERGEBEN:   *)
       OFFSET:=OFFSET+6;VTYP:=TABA2[VTYP]         
      END                                         
     ELSE ERROR(141)                              
   END                                            
  END;(*CASE & WHILE*)                            
 IF (ACCESS<>BASEOFFSET)AND(OFFSET<>0) THEN       
 BEGIN (*GESAMTE ADR. AUF DEN STACK             *)
  GENLDC(OFFSET);GEN(ADUSYM);(*OFFSET=0         *)
 END                                              
 END(*WITH*)                                      
END;(*VARIABLE*)                                  
                                                  
PROCEDURE ZUW1(I:INTEGER);                        
(*BEREITE ZUWEISUNG VOR: VARIABLE AUSWERTEN. BEI*)
(*ZUSAMMENGESETZEN OBJEKTEN ADR. AUF DEN STACK  *)
BEGIN                                             
 VARIABLE(I,ZU);                                  
 IF(TABART[ZU.VTYP] IN [FELDTYP..SEQTYP])OR       
   ZU.ISPACKED THEN GENF(ZU);                     
  (*SEQTYP FUER READ/WRITE*)                      
END;(*ZUW1*)                                      
                                                  
PROCEDURE ZUW2(ERGTYP:INTEGER);                   
(*ZUWEISUNGSBEFEHLE CODIEREN. ARRAY/RECORD ETC. *)
(*ADRESSE DURCH ZUW1 AUF DEM STACK              *)
BEGIN                                             
 TYPTEST(ERGTYP,ZU.VTYP,144);                     
 CASE TABART[ZU.VTYP]OF                           
  FELDTYP,VERBTYP:                                
    BEGIN GEN(MOVSYM);GENA(LEN(ZU.VTYP)) END;     
  SEQTYP:ERROR(146);                              
  MENGE :GEN(SSASYM)                              
  ELSE                                            
   IF ZU.VTYP=REALS THEN GENLS(SRSYM,ZU) ELSE     
   IF ZU.ISPACKED   THEN GEN(SPASYM)     ELSE     
    GENLS(SSYM,ZU)                                
 END(*CASE*)                                      
END;(*ZUW2*)