(* 18.3.1987 VERSION 1.4A AUFGETEILT *)           
(* 13.6.1985 *)                                   
                                                  
FUNCTION LEN(INDEX:INTEGER):INTEGER;              
(*LIEFERT DIE LAENGE EINES OBJEKTES (IN BYTES)  *)
(*DES INDIZIERTEN TYPS                          *)
BEGIN                                             
 CASE TABART[INDEX]OF                             
    STDTYP,AUFZHL,AUSSCH:                         
      BEGIN                                       
       IF INDEX=REALS THEN LEN:=5                 
                      ELSE LEN:=2                 
      END;                                        
    ELSE LEN:=TABA1[INDEX]                        
 END                                              
END;(*LEN*)                                       
                                                  
FUNCTION PARLENGTH(I:INTEGER):INTEGER;            
(*LIEFERT DIE LAENGE DES PARAMETERTEILS DES     *)
(*UNTERPROGRAMMS (IN BYTES)                     *)
 VAR J:INTEGER;                                   
BEGIN                                             
 J:=TABA2[I]+I;IF I=J THEN (*KEINE PARAMETER    *)
   PARLENGTH:=HEAD                                
 ELSE                                             
  IF TABA3[J]<0 THEN PARLENGTH:=TABA1[J]+2        
  ELSE PARLENGTH:=TABA1[J]+LEN(TABA3[J])          
END;(*PARLENGTH*)                                 
                                                  
FUNCTION ISLONG(I:INTEGER):BOOLEAN;               
(*TRUE, FALLS REAL ODER ZUSAMMENGESETZTER TYP   *)
BEGIN                                             
 CASE TABART[I] OF                                
  STDTYP,AUFZHL,AUSSCH:ISLONG:=I=REALS;           
  ELSE ISLONG:=TRUE                               
 END;(*CASE*)                                     
END;(*ISLONG*)                                    
                                                  
PROCEDURE FIXFRE;                                 
(*DER BLOCK BEGINNT NICHT HIER. (CODIERT SPRUNG)*)
BEGIN                                             
 IF FIXADR=0 THEN                                 
  BEGIN GEN(JMPSYM);FIXADR:=PC;FRE END            
END;(*FIXFRE*)                                    
                                                  
FUNCTION UNSCONST(COMP:BOOLEAN):INTEGER;          
(*LIEST KONSTANTE UND LIEFERT INDEX DES GRUND-  *)
(*TYPS. WERT BZW. ADRESSE IN NUM. STRINGLAENGE  *)
(*IN TABA1[STRNG].                              *)
(*FALLS COMP=TRUE,WIRD KONSTANTE MIT LADEBE-    *)
(*BEFEHLEN  AUF DEN STACK GEBRACHT.             *)
(* %%% VERSION 1.4A: SYNTAX-CHECK BEI STRINGS:  *)
 VAR I,ADR,ADR1:INTEGER;                          
     L         :INTEGER;                          
BEGIN                                             
 CASE SYM OF                                      
 INTNUM :BEGIN I:=INT;GETSYM END;                 
 REALNUM:BEGIN (*WERT IN FLOAT;NUM ENTHAELT ADR.*)
          IF COMP THEN                            
           BEGIN GEN(LRCSYM);COMP:=FALSE;         
            FOR I:=0 TO 4 DO GEN(PEEK(NUM+I));    
           END;                                   
          I:=REALS;GETSYM                         
         END;                                     
 34     :BEGIN (*ANFUEHRUNGSZEICHEN:            *)
          GETSYM;NUM:=SYM;I:=CHART;GETSYM;        
          IF SYM<>34 THEN (*STRING COMPILIEREN  *)
           BEGIN                                  
            IF COMP THEN                          
             BEGIN GEN(CSTSYM);ADR1:=PC;FRE END   
            ELSE FIXFRE;                          
            ADR:=PC; I:=STRNG; GENA(NUM); L:=2;   
            REPEAT                                
              L:=L+2; GENA(SYM); GETSYM;          
            UNTIL SYM=34;                         
            TABA1[STRNG]:= L; (* %%%VERSION 1.4A*)
            IF COMP THEN                          
             BEGIN (*CST LIEFERT ADRESSE->STACK*) 
              FIXUP(ADR1,PC);COMP:=FALSE          
             END;                                 
            NUM:=ADR                              
           END;                                   
          GETSYM                                  
         END;                                     
 147(*NIL*):BEGIN I:=NILS;GETSYM;NUM:=0 END       
 ELSE(*CASE*)                                     
         BEGIN I:=GETID;                          
          IF TABART[I]<>KONST THEN                
           BEGIN ERROR(103);I:=INT;NUM:=0 END     
          ELSE                                    
           BEGIN                                  
            TABA1[STRNG]:=TABA3[I]; (*LAENGE    *)
            NUM:=TABA2[I];I:=TABA1[I];            
           END                                    
         END                                      
 END;(*CASE*)                                     
 IF COMP THEN                                     
  BEGIN                                           
   GENLDC(NUM);IF I=REALS THEN GEN(LRSYM+3)       
  END;                                            
 UNSCONST:=I                                      
END;(*UNSCONST*)                                  
                                                  
FUNCTION GETCONST:INTEGER;                        
(*LIEFERT DEN INDEX DES GRUNDTYPS. WERT IN NUM  *)
 VAR I,X:INTEGER;                                 
BEGIN                                             
 IF(SYM=PLUS)OR(SYM=MINUS)THEN                    
  BEGIN X:=SYM;GETSYM END                         
 ELSE X:=STERN;                                   
 I:=UNSCONST(FALSE);                              
 IF X<>STERN THEN                                 
  BEGIN                                           
   IF I=INT THEN                                  
    BEGIN IF X=MINUS THEN NUM:=-NUM END ELSE      
   IF I=REALS THEN                                
    BEGIN IF X=MINUS THEN FLOAT:=-FLOAT END       
   ELSE  ERROR(105);                              
  END;                                            
 GETCONST:=I                                      
END;(*GETCONST*)                                  
                                                  
PROCEDURE CHECKCONST(TYP,ERR:INTEGER);            
(*PRUEFT KONSTANTEN AUF TYP.(NICHT REAL/STRING) *)
 VAR I:INTEGER;                                   
BEGIN                                             
 I:=GETCONST;                                     
 IF TABART[TYP]=AUSSCH THEN                       
  BEGIN                                           
   IF(NUM<TABA3[TYP])OR(NUM>TABA3[TYP]+TABA1[TYP])
   THEN ERROR(ERR);                               
   TYP:=TABA2[TYP]                                
  END;                                            
 IF I<>TYP THEN ERROR(ERR)                        
END;(*CHECKCONST*)                                
                                                  
PROCEDURE LBLDECL;                                
(*LIEST DEKLARATION. FUER JEDES LABEL WIRD EIN  *)
(*SPRUNGBEFEHL ERZEUGT. AUSSERDEM WIRD MIT 'ALC'*)
(*DER STACKPOINTER KORREKT INITIALISIERT.       *)
 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;                                
 VAR I,ADR:INTEGER;NAME:TBEZ;                     
BEGIN                                             
 REPEAT                                           
  IF SYM<>IDENT THEN ERROR(2)                     
  ELSE                                            
   BEGIN NAME:=ID;                                
    GETSYM;TEST(GLEICH,16);I:=GETCONST;           
    IF I=NILS THEN                                
     BEGIN I:=INT;NUM:=0;ERROR(506) END;          
    IF I=REALS THEN                               
     BEGIN FIXFRE;ADR:=PC;                        
      FOR I:=0 TO 4 DO GEN(PEEK(NUM+I));          
      NUM:=ADR;I:=REALS;                          
     END;                                         
    (*STRINGLAENGE NUR FUER STRING RELEVANT     *)
    EINTRAG(NAME,KONST,I,NUM,TABA1[STRNG]);       
   END;                                           
  TEST(SEMI,14);                                  
 UNTIL SYM<>IDENT                                 
END;(*CSTDECL*)