(*==============================================*)
(*  5.9.1985                                    *)
(* INCLUDE-FILE "P.SIZE.P"                      *)
(*==============================================*)
                                                  
FUNCTION STACKLEN (INDEX:INTEGER):INTEGER;        
(* LIEFERT DIE LAENGE EINES OBJEKTES (IN BYTES) *)
(* DES INDIZIERTEN TYPS AUF DEM STACK ODER IM   *)
(* PARAMTERTEIL EINER PROZEDUR / FUNKTION       *)
BEGIN                                             
 CASE TABART [INDEX] OF                           
    STDTYP,AUFZHL,AUSSCH:                         
      BEGIN                                       
       IF INDEX=REALS THEN STACKLEN:=5            
                      ELSE STACKLEN:=2            
      END;                                        
    ELSE STACKLEN:=TABA1[INDEX]                   
 END; (* CASE *)                                  
END; (* STACKLEN *)                               
                                                  
FUNCTION MEMLEN(INDEX:INTEGER):INTEGER;           
(* LIEFERT DIE LAENGE EINES OBJEKTES (IN BYTES) *)
(* DES INDIZIERTEN TYPS IM SPEICHER             *)
BEGIN                                             
 MEMLEN:=2;                                       
 CASE TABART[INDEX] OF                            
  STDTYP,AUFZHL:                                  
    IF INDEX=REALS THEN MEMLEN:=5                 
    ELSE                                          
     IF TABA1[INDEX]<=255 THEN MEMLEN:=1;         
   AUSSCH:                                        
    IF (TABA3[INDEX]>=0) AND                      
       (TABA1[INDEX]+TABA3[INDEX]<=255)           
      THEN MEMLEN:=1;                             
  ELSE (* CASE *) MEMLEN:=TABA1[INDEX]            
 END; (* CASE *)                                  
END; (* MEMLEN *)                                 
                                                  
FUNCTION LENPARAM(BLK:INTEGER): INTEGER;          
(* LIEFERT DIE LAENGE DES PARAMETERTEILS DES    *)
(* INDIZIERTEN UNTERPROGRAMMES (IN BYTES)       *)
  VAR LASTPAR: INTEGER;                           
BEGIN                                             
 LASTPAR:= BLK+TABA2[BLK];                        
 IF LASTPAR=BLK THEN LENPARAM:=0                  
 ELSE                                             
  IF TABA3[LASTPAR]<0 THEN (* VARIABLENPARAMETER*)
    LENPARAM:=TABA1[LASTPAR] - HEAD               
  ELSE                                            
    LENPARAM:=TABA1[LASTPAR] - 2 - HEAD +         
              STACKLEN(TABA3[LASTPAR]);           
END; (* LENPARAM *)                               
                                                  
FUNCTION LENFCTRES1(BLK:INTEGER): INTEGER;        
(* LIEFERT DIE LAENGE DES FUNKTIONSERGEBNISSES  *)
(* UNTERHALB DES SEGMENTDESKRIPTORS             *)
 VAR ERGTYP: INTEGER;                             
BEGIN                                             
 IF TABART[BLK]<>FKT THEN LENFCTRES1:=0           
 ELSE                                             
  BEGIN                                           
   ERGTYP:=TABA3[BLK+TABA2[BLK]+1];               
   IF INTEST(ERGTYP,FELDTYP,VERBTYP) THEN         
     LENFCTRES1:=2                                
   ELSE                                           
     LENFCTRES1:=STACKLEN(ERGTYP)                 
  END;                                            
END; (* LENFCTRES1 *)                             
                                                  
FUNCTION LENFCTRES2(BLK:INTEGER): INTEGER;        
(* LIEFERT DIE LAENGE EINES EVTL. VORHANDENEN   *)
(* 'LANGEN FUNKTIONSERGEBNISSES' (HINTER DEN    *)
(* PARAMETERN AUF DEM STACK GESPEICHERT)        *)
 VAR ERGTYP: INTEGER;                             
BEGIN                                             
 LENFCTRES2:=0;                                   
 IF TABART[BLK]=FKT THEN                          
  BEGIN                                           
   ERGTYP:=TABA3[BLK+TABA2[BLK]+1];               
   IF INTEST(ERGTYP,FELDTYP,VERBTYP) THEN         
     LENFCTRES2:=MEMLEN(ERGTYP);                  
  END;                                            
END; (* LENFCTRES2 *)                             
                                                  
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, DESHALB RESER- *)
(* VIERE PLATZ FUER SPRUNG, MERKE ADRESSE       *)
BEGIN                                             
 IF FIXADR=0 THEN                                 
  BEGIN GEN(JMPSYM); FIXADR:=PC; FRE END;         
END; (* FIXFRE *)                                 
                                                  
FUNCTION UNSCONST (COMPILE:BOOLEAN):INTEGER;      
(* LIEST KONSTANTE UND LIEFERT INDEX DES GRUND- *)
(* TYPS. WERT BZW. ADRESSE IN NUM. STRINGLAENGE *)
(* IN TABA1[STRNG].                             *)
(* FALLS COMPILE, GENERIERE LADEBEFEHLE, SO DASS*)
(* WERT (ADR. BEI STRINGS) AUF DEM STACK IST.   *)
 VAR I, J  : INTEGER;                             
     BUFFER: PACKED ARRAY[0..255] OF CHAR;        
BEGIN                                             
 CASE SYM OF                                      
 INTNUM :BEGIN I:=INT; GETSYM  END;               
 REALNUM:BEGIN                 (* WERT IN FLOAT *)
          REALVALUE.R   :=FLOAT; GETSYM;          
          REALVALUE.SIGN:=0;   (* -->WERT IN .R *)
          IF COMPILE THEN                         
           BEGIN                                  
            COMPILE:=FALSE; GEN(LRCSYM); GENREAL  
           END;                                   
          I:= REALS;                              
         END;                                     
 STRCST,HASH: (* STRINGKONSTANTE / CHARKONSTANTE*)
         BEGIN J:=0;                              
          REPEAT                                  
           IF SYM=STRCST THEN                     
             IF (ORD(ID[0])=255) OR               
                (J+ORD(ID[0])>255) THEN           
             BEGIN ERROR(23); GETSYM END          
            ELSE                                  
             BEGIN                                
              BANK:= 1;                           
              FOR I:=1 TO ORD(ID[0]) DO           
               BEGIN J:=J+1;                      
                BUFFER[J]:= CHR(PEEK(NUM+I-1));   
               END;                               
              GETSYM                              
             END                                  
           ELSE                                   
            BEGIN GETSYM;                         
             IF SYM<>INTNUM THEN ERROR(106);      
             IF J>=255 THEN ERROR(23)             
             ELSE                                 
              BEGIN                               
               J:=J+1; BUFFER[J]:=CHR(NUM)        
              END;                                
             GETSYM;                              
            END;                                  
          UNTIL (SYM<>STRCST) AND (SYM<>HASH);    
          IF J=1 THEN                             
           BEGIN NUM:=ORD(BUFFER[1]);I:= CHART END
          ELSE                                    
           BEGIN                                  
            BUFFER[0]:=CHR(J); NUM:= KC;          
            FOR I:=0 TO J DO GENK(BUFFER[I]);     
            I:=STRNG; TABA1[STRNG]:=J+1;          
            TABA2[STRNG]:=0;                      
           END;                                   
         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, IF*)
            TABA2[STRNG]:=0;       (* STRING    *)
            REALVALUE.SIGN:=TABA3[I];(* IF REAL *)
            NUM:=TABA2[I]; I:=TABA1[I];           
           END;                                   
         END                                      
 END; (* CASE *)                                  
 UNSCONST:=I;                                     
 IF COMPILE THEN                                  
  BEGIN GENLDC(NUM);                              
   IF I=REALS THEN                                
    BEGIN GEN(LRSYM+3);                           
     IF REALVALUE.SIGN<0 THEN GENROP(5); (* +/- *)
    END                                           
  END                                             
END;(* UNSCONST *)                                
                                                  
FUNCTION GETCONST:INTEGER;                        
(* LIEFERT DEN INDEX DES GRUNDTYPS. WERT IN NUM *)
(* ODER REALVALUE. STRINGS BEREITS COMPILIERT.  *)
 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                              
      IF REALVALUE.SIGN=0 THEN                    
        REALVALUE.R:=-REALVALUE.R                 
      ELSE REALVALUE.SIGN:=-REALVALUE.SIGN;       
    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 *)