(*==============================================*)
(* 5.9.1986                                     *)
(* INCLUDE-FILE "P.IFACE.P"                     *)
(*==============================================*)
                                                  
PROCEDURE ERROR(N:INTEGER);                       
(* N<0 --> UNTERBRECHUNG, SONST FEHLERMELDUNG   *)
 VAR Z     : CHAR;                                
     EXPL  : STRING;                              
     ERRTXT: TEXT;                                
     ERRNUM: INTEGER;                             
BEGIN                                             
 IF N>=0 THEN                                     
  BEGIN                                           
   FEHLER:= FEHLER+1;                             
   IF GENFLG=ONFILE THEN                          
     BEGIN CLOSE(CFILE); CLOSE(FFILE) END;        
   GENFLG:=SYNTAX;                                
   WRITE(LIST,"^":INDEX," ERROR",N);              
  END                                             
 ELSE WRITE(LIST,"BREAK");                        
 WRITELN(LIST," IN",ZNR);                         
 REPEAT                                           
  WRITE("'*' STOP");                              
  IF N>=0 THEN WRITE("  '?' EXPLANATION");        
  WRITE(#13 "ELSE CONTINUE" #13 "==>");           
  READLN(Z);                                      
  IF Z="*" THEN GOTO 9;                           
  IF (N>=0) AND (Z="?") THEN                      
   BEGIN                                          
    OPEN(ERRTXT,8,6,"0:ERRORS.TXT,S,R");          
    REPEAT                                        
     READLN(ERRTXT, ERRNUM, EXPL);                
    UNTIL (ERRNUM>=N) OR EOF(ERRTXT);             
    CLOSE(ERRTXT);                                
    IF ERRNUM<>N THEN                             
      EXPL:="NO MESSAGE FOUND";                   
    WRITELN(LIST,EXPL);                           
   END;                                           
 UNTIL Z<>"?";                                    
END; (* ERROR *)                                  
                                                  
FUNCTION INTEST(I:INTEGER;B,C:TART):BOOLEAN;      
(* TYP MIT INDEX I IM INTERVALL [B..C] ?        *)
 VAR A:TART;                                      
BEGIN                                             
 A:=TABART[I];                                    
 IF A>=B THEN                                     
  IF A<=C THEN INTEST:=TRUE                       
  ELSE INTEST:=FALSE                              
 ELSE INTEST:=FALSE                               
END;(* INTEST *)                                  
                                                  
PROCEDURE GETSYM;                                 
BEGIN                                             
 BANK:=1; SYS(UHOLE);                             
 IF SYM=EOFILE THEN                               
  BEGIN                                           
   WRITE(LIST,"**** PROGRAM INCOMPLETE" #13 #13); 
   GOTO 8                                         
  END                                             
END;(* GETSYM *)                                  
                                                  
FUNCTION SELSEARCH (I:INTEGER):INTEGER;           
(* AUFRUF: I INDIZIERT RECORDEINTRAG            *)
(* LIEFERT ZEIGER AUF TYPEINTRAG ODER -1        *)
 VAR J:INTEGER;                                   
BEGIN                                             
 SELSEARCH:=-1; ID[0]:=CHR(-ORD( ID[0]));         
 I:=TABA2[I];                                     
 WHILE I>=0 DO                                    
  IF TABBEZ[I]=ID THEN                            
    BEGIN SELSEARCH:=I; I:=-1 END                 
  ELSE I:=TABA2[I];                               
 ID[0]:=CHR(-ORD(ID[0]));                         
END;(* SELSEARCH *)                               
                                                  
FUNCTION POSITION (VAR ID:TBEZ):INTEGER;          
(* FINDE BEZEICHNER ID IN BEZTAB UND BERUECK-   *)
(* SICHTIGT WITH-STATEMENT.                     *)
                                                  
 PROCEDURE DUMMY(TX:INTEGER; VAR TABB,ID:TBEZ);   
 BEGIN                                            
  BANK:=1; SYS(UPOSI)                             
 END; (* DUMMY *)                                 
                                                  
BEGIN (* POSITION *)                              
 IF WITHIND=0 THEN DUMMY(TX,TABBEZ[TX],ID)        
 ELSE                                             
  BEGIN                                           
   POS:=SELSEARCH(WITHIND);                       
   IF POS=-1 THEN DUMMY(TX,TABBEZ[TX],ID)         
  END;                                            
 POSITION:=POS                                    
END; (* POSITION *)                               
                                                  
(*UPOSI:                                        *)
(*======                                        *)
(*LABEL 2;                                      *)
(*VAR J:INTEGER;                                *)
(*BEGIN                                         *)
(* POS:=-1;                                     *)
(* IF (ID[0]<>STERN)AND(ORD(ID[0])>0)THEN       *)
(*  FOR J:=TX-1 DOWNTO 0 DO                     *)
(*   IF TABBEZ[J]=ID THEN                       *)
(*    BEGIN POS:=J GOTO 2 END;                  *)
(* 2:                                           *)
(*END;                                          *)
                                                  
PROCEDURE EINTRAG(VAR ID:TBEZ; ART:TART;          
                  A1,A2,A3:INTEGER);              
(* TRAGE ID MIT INFOS IN BEZEICHNERTABELLE EIN  *)
 VAR I:INTEGER;                                   
BEGIN                                             
 IF TX>TXMAX THEN ERROR(402)                      
 ELSE                                             
  BEGIN                                           
   I:=POSITION(ID);                               
   IF I>=LAST THEN ERROR(101);                    
   TABA1 [TX]:=A1;  TABA2[TX]:=A2;                
   TABA3 [TX]:=A3; TABART[TX]:=ART;               
   TABBEZ[TX]:=ID; TX:=TX+1                       
  END                                             
END;(* EINTRAG *)                                 
                                                  
FUNCTION GETID:INTEGER;                           
(* HOLE INDEX AUF BEZEICHNER, EVTL.FEHLERMELDUNG*)
 VAR I:INTEGER;                                   
BEGIN                                             
 IF SYM<>IDENT THEN                               
  BEGIN ERROR(2); GETID:=INT END                  
 ELSE                                             
  BEGIN I:= POSITION(ID);                         
   IF I<0 THEN                                    
     BEGIN ERROR(104);I:=INT END;                 
   GETID:=I; GETSYM                               
  END                                             
END;(* GETID *)                                   
                                                  
PROCEDURE TEST(AUF,FEHLER:INTEGER);               
(* PRUEFE AUF ZEICHEN. FALLS FEHLER, TRENN-     *)
(* ZEICHEN GESONDERT BEHANDELN.                 *)
BEGIN                                             
 IF SYM=AUF THEN GETSYM                           
 ELSE                                             
  BEGIN ERROR(FEHLER);                            
   CASE AUF OF                                    
    SEMI,KOMMA,DPKT,PUNKT,KLAUF,KLZU,EKLAUF,EKLZU,
    GLEICH,170:                                   
     BEGIN                                        
      CASE SYM OF                                 
       SEMI,KOMMA,DPKT,PUNKT,KLAUF,KLZU,EKLAUF,   
       EKLZU,GLEICH,170:                          
          GETSYM;                                 
       ELSE (* CASE, NICHTS *)                    
     END (* CASE *)                               
    END;                                          
   ELSE (* CASE, NICHTS *)                        
   END (* CASE *)                                 
  END                                             
END;(* TEST *)                                    
                                                  
PROCEDURE GEN (CODE:INTEGER);                     
(* 1 BYTE CODE SPEICHERN, UMSCHALTUNG AUF FILE, *)
(* FALLS FREIER SPEICHERBEREICH UEBERSCHRITTEN. *)
  VAR EA: INTEGER;                                
BEGIN                                             
 CASE GENFLG OF                                   
 MEMORY: BEGIN                                    
          EA:= ADDU(PC,OFFSET);                   
          IF HBYTE(EA)<HBYTEOVERFLOW THEN         
           BEGIN BANK:=0; POKE(EA,CODE) END       
          ELSE                                    
           BEGIN GENFLG:=ONFILE;                  
            OPEN(COMMAND,8,15,"S0:?$");           
            OPEN(CFILE,8,CSEK,"0:C$,P,W");        
            OPEN(FFILE,8,FSEK,"0:F$,P,W");        
            WRITE(CFILE,CHR(EA),CHR(HBYTE(EA)),   
                  CHR(CODE))                      
           END;                                   
         END; (* MEMORY *)                        
 ONFILE: WRITE(CFILE,CHR(CODE));                  
 DETECT: BEGIN                                    
          IF PC=ERRORPC THEN                      
           BEGIN ERROR(0); GOTO 9 END;            
         END                                      
 ELSE (* SYNTAX, LEER *)                          
 END;                                             
 PC:= ADDU(PC,1);                                 
END; (* GEN *)                                    
                                                  
PROCEDURE GENA (ADR:INTEGER);                     
(* ADRESSE (L/H) ERZEUGEN                       *)
BEGIN                                             
 GEN(ADR); GEN(HBYTE(ADR));                       
END; (* GENA *)                                   
                                                  
PROCEDURE GENOP(OP:INTEGER);                      
(* OPERATIONSCODE ERZEUGEN, UMWANDLUNG OPERA-   *)
(* TIONSSZMBOL IN P-CODE DURCH SUCHE IN OPCODE  *)
 VAR I:INTEGER;                                   
BEGIN                                             
 I:=0; WHILE OPCODE[I]<>OP DO I:=I+1;             
 GEN(I+ADDSYM)                                    
END;(* GENOP *)                                   
                                                  
PROCEDURE GENROP(OP:INTEGER);                     
(* REELLE OPERATION CODIEREN                    *)
BEGIN                                             
 IF OP>=5 THEN GEN(MONSYM)     (* EIN OPERAND   *)
          ELSE GEN(DYASYM);    (* ZWEI OPERANDEN*)
 GEN(OP)                                          
END;(* GENROP *)                                  
                                                  
PROCEDURE FIXUP (VON,NACH:INTEGER);               
(* 2-BYTE-WERTE NACHTRAGEN (Z.B. SPRUENGE)      *)
BEGIN                                             
 CASE GENFLG OF                                   
 MEMORY:BEGIN                                     
         BANK:= 0;                                
         POKE(     ADDU(VON,OFFSET)   ,NACH);     
         POKE(ADDU(ADDU(VON,OFFSET),1),           
              HBYTE(NACH));                       
        END;                                      
 ONFILE:BEGIN FFILE^.V:=ADDU(VON,OFFSET);         
         FFILE^.N:=NACH; PUT(FFILE)               
        END                                       
 ELSE (* SYNTAX,DETECT: LEER *)                   
 END                                              
END;(* FIXUP *)                                   
                                                  
PROCEDURE FRE;                                    
(* PLATZ FUER SPAETERES FIXUP LASSEN            *)
BEGIN                                             
 GENA(0)                                          
END; (* FRE *)                                    
                                                  
PROCEDURE GENREAL;                                
(* DIE ZAHL REALVALUE.R COMPILIEREN             *)
 VAR I: INTEGER;                                  
BEGIN                                             
  FOR I:=0 TO 4 DO                                
    GEN(ORD(REALVALUE.S[I]));                     
END; (* GENREAL *)                                
                                                  
PROCEDURE GENLDC (VALUE:INTEGER);                 
(* 2-BYTE KONSTANTE AUF STACK LADEN             *)
BEGIN                                             
 IF VALUE=0 THEN GEN(LC0SYM) ELSE                 
 IF (VALUE>=0) AND (VALUE<=255) THEN              
   BEGIN GEN(LCBSYM); GEN(VALUE) END              
 ELSE                                             
   BEGIN GEN(LDCSYM); GENA(VALUE) END;            
END; (* GENLDC *)                                 
                                                  
PROCEDURE GENK (VALUE:CHAR);                      
(* EIN BYTE IM KONSTANTENSPEICHER ABLEGEN.      *)
(* KC ZEIGT JEWEILS AUF NAECHSTE FREIE ENDGUEL- *)
(* TIGE (!) ADRESSE IN BANK 1.                  *)
  VAR KBUFFERP: TPKBUFFER;                        
BEGIN                                             
 IF KBUFFERZ>KBUFFERSIZE THEN (* NEUE SEITE     *)
  BEGIN                                           
   NEW(KBUFFERP);KBUFFERP^.NEXT:=NIL;KBUFFERZ:=0; 
   IF KBUFFERROOT=NIL THEN KBUFFERROOT:=KBUFFERP  
   ELSE KBUFFER^.NEXT:=KBUFFERP;                  
   KBUFFER:=KBUFFERP;                             
  END;                                            
 KBUFFER^.B[KBUFFERZ]:=VALUE;                     
 KBUFFERZ:=KBUFFERZ+1; KC:=KC+1;                  
END; (* GENK *)