(*23.11.1985                                    *)
PROCEDURE INTERRUPT;                              
 VAR Z:CHAR;                                      
BEGIN                                             
 WRITELN("
'*' STOP  '?' SYNTAX");                
 WRITE("ELSE CONTINUE
==>");READLN(Z);            
 IF Z="*"THEN GOTO 9;                             
 IF Z="?"THEN                                     
  BEGIN                                           
(*\C-64                                           
   IF GENFLG=ONFILE THEN                          
     BEGIN CLOSE(CFILE);CLOSE(FFILE) END;         
(*C-64*)                                          
   GENFLG:=SYNTAX                                 
  END;                                            
END;(*INTERRUPT*)                                 
                                                  
PROCEDURE ERROR(N:INTEGER);                       
BEGIN                                             
 WRITELN(LIST,"^":INDEX AND 255);                 
 WRITELN(LIST,"**** ERROR",N," IN",ZNR);          
 FEHLER:=FEHLER+1;INTERRUPT                       
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                                             
 SYS(UHOLE);                                      
 IF SYM=255 THEN                                  
  BEGIN                                           
   WRITELN(LIST,"**** PROGRAM INCOMPLETE
");      
   GOTO 8                                         
  END                                             
END;(*GETSYM*)                                    
                                                  
FUNCTION SELSEARCH(I:INTEGER):INTEGER;            
(*AUFRUF: I INDIZIERT RECOREINTRAG              *)
(*LIEFERT ZEIGER AUF TYPEINTRAG ODER -1         *)
 VAR J:INTEGER;                                   
BEGIN                                             
 SELSEARCH:=-1;ID[0]:=-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]:=-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 SYS(UPOSI) END;                            
                                                  
BEGIN                                             
 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(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(*EINTRAG*)                                  
 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);               
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);                      
BEGIN                                             
 CASE GENFLG OF                                   
 MEMORY:BEGIN ADR:=PC;                            
(*\CROSS                                          
         ADR:=ADDU(PC,OFFSET);                    
(*CROSS*)                                         
         BYTE:=CODE;SYS(UGEN);                    
         PC:=ADDU(PC,1);                          
(*\C-64                                           
         IF PC>=OVERFLOW THEN                     
         BEGIN GENFLG:=ONFILE;                    
          OPEN(COMMAND,8,15,"S0:?$");             
          OPEN(CFILE,8,4,"0:C$,PRG,W");           
          OPEN(FFILE,8,5,"0:F$,PRG,W");           
          LBYTE:=PC;                              
          WRITE(CFILE,CHR(PC),CHR(HBYTE))         
         END                                      
(*C-64*)                                          
        END;                                      
(*\C-64                                           
 ONFILE:BEGIN WRITE(CFILE,CHR(CODE));             
         PC:=ADDU(PC,1);                          
        END;                                      
(*C-64*)                                          
 DETECT:BEGIN PC:=ADDU(PC,1);                     
         IF((ERRORPC>0)AND(PC>=ERRORPC))OR        
           ((ERRORPC<0)AND(PC<=ERRORPC))THEN      
          BEGIN ERROR(0);GOTO 9 END               
        END                                       
 ELSE(*SYNTAX, LEER*)                             
 END                                              
END;(*GEN*)                                       
                                                  
PROCEDURE GENA(ADR:INTEGER);                      
BEGIN                                             
 LBYTE:=ADR;GEN(ADR);GEN(HBYTE);                  
END;(*GENA*)                                      
                                                  
PROCEDURE GENOP(OP:INTEGER);                      
 VAR I:INTEGER;                                   
BEGIN                                             
 I:=0;WHILE OPCODE[I]<>OP DO I:=I+1;              
 GEN(I+32)                                        
END;(*GENOP*)                                     
                                                  
PROCEDURE GENROP(OP:INTEGER);                     
BEGIN                                             
 IF OP>=5 THEN GEN(MONSYM) (*EIN OPERAND   *)     
          ELSE GEN(DYASYM);(*ZWEI OPERANDEN*)     
 GEN(OP)                                          
END;(*GENROP*)                                    
                                                  
PROCEDURE FIXUP(VON,NACH:INTEGER);                
BEGIN                                             
(*\CROSS                                          
 VON:=ADDU(VON,OFFSET);                           
(*CROSS*)                                         
 CASE GENFLG OF                                   
 MEMORY:BEGIN LBYTE:=NACH;                        
         ADR:=VON        ;BYTE:=NACH ;SYS(UGEN);  
         ADR:=ADDU(VON,1);BYTE:=HBYTE;SYS(UGEN)   
        END                                       
(*\C-64                                           
 ;ONFILE:BEGIN FFILE^.V:=VON;FFILE^.N:=NACH;      
         PUT(FFILE)                               
        END                                       
(*C-64*)                                          
 ELSE (*SYNTAX,DETECT: LEER*)                     
 END                                              
END;(*FIXUP*)                                     
                                                  
PROCEDURE FRE;                                    
BEGIN GENA(0) END;                                
                                                  
PROCEDURE GENLDC(VALUE:INTEGER);                  
BEGIN GEN(LDCSYM);GENA(VALUE) END;