(* INCLUDE-FILE FUER ASSEMBLER *)            
(* FLORIAN MATTHES 30.5.1986   *)            
                                             
(* ------------------------- START SCANNER *)
                                             
PROCEDURE GETCHAR;                           
BEGIN                                        
 IF P>=LINELENGTH THEN CH:=LINEEND           
 ELSE                                        
  BEGIN READ(SOURCEFILE,CH); P:=P+1 END;     
END; (* GETCHAR *)                           
                                             
PROCEDURE GETTOKEN;                          
 VAR I: INTEGER;                             
                                             
 PROCEDURE NUMBER(B:INTEGER);                
 (* UMWANDLUNG STRING IN ZAHL ZUR BASIS B *) 
  VAR CODE,SIGMA:INTEGER;                    
 BEGIN                                       
  SIGMA:=0;                                  
  WHILE CH IN HEXSET DO                      
   BEGIN                                     
    CODE:=ORD(CH)-ORD("0");                  
    IF CODE>9 THEN CODE:=CODE-7;             
    IF(CODE<0)OR(CODE>=B)THEN ERROR(7);      
    (* BERECHNE SIGMA:= SIGMA * B + CODE *)  
    GLOBALMND:=SIGMA;  (* 16 BIT *)          
    GLOBALMOR:=B;      (*  8 BIT *)          
    SYS(UMULTI);                             
    SIGMA:= ADDU(GLOBALERG,CODE);            
    GETCHAR;                                 
   END;                                      
  GLOBALVAL:= SIGMA; TOKEN:= KONST;          
 END;(* NUMBER *)                            
                                             
BEGIN (* GETTOKEN *)                         
 WHILE CH=" " DO GETCHAR;                    
 IF CH IN LITSET THEN                        
   BEGIN I:=1;                               
    GLOBALLBL:= EMPTYLBL;                    
    REPEAT                                   
      GLOBALLBL[I]:=CH; I:=I+1; GETCHAR      
    UNTIL NOT(CH IN LIT2SET);                
    TOKEN:=LBL;                              
   END                                       
 ELSE                                        
   IF CH IN NUMSET THEN                      
     NUMBER(10)                              
   ELSE                                      
    CASE CH OF                               
     HEX:BEGIN GETCHAR; NUMBER(16) END;      
     BIN:BEGIN GETCHAR; NUMBER(2)  END;      
     OKT:BEGIN GETCHAR; NUMBER(8)  END;      
     ELSE (* SONDERZEICHEN *)                
         BEGIN TOKEN:= CH; GETCHAR END       
    END;                                     
END; (* GETTOKEN *)                          
                                             
PROCEDURE GETXTOKEN;                         
(* WIE GETTOKEN. ZUSAETZLICH WERDEN        *)
(* (PSEUDO-) OPCODES ERKANNT               *)
BEGIN                                        
  GETTOKEN;                                  
  IF(TOKEN=LBL)AND(GLOBALLBL[4]=" ") THEN    
   (* LAENGE<=3 ZEICHEN *)                   
   BEGIN                                     
     GLOBALMODE:=ANYMODE(GLOBALLBL);         
     IF GLOBALMODE<>UNKNOWN THEN TOKEN:=OPC  
     ELSE                                    
     IF GLOBALLBL=EQUSTR THEN TOKEN:=EQU     
     ELSE                                    
     IF GLOBALLBL=DFDSTR THEN TOKEN:=DFD     
     ELSE                                    
     IF GLOBALLBL=ORGSTR THEN TOKEN:=ORG     
     ELSE                                    
     IF GLOBALLBL=IMPSTR THEN TOKEN:=IMP     
     ELSE                                    
     IF GLOBALLBL=EXPSTR THEN TOKEN:=EXP     
     ELSE                                    
     IF GLOBALLBL=ENDSTR THEN                
       TOKEN:=SOURCEEND;                     
   END;                                      
END; (* GETXTOKEN *)                         
                                             
PROCEDURE NEWLINE;                           
(* HOLE ERSTES TOKEN DER FOLGEZEILE *)       
BEGIN                                        
 WHILE P<LINELENGTH DO                       
  BEGIN                                      
    READ(SOURCEFILE,CH); P:=P+1              
  END;                                       
 P:=0; ZN:=ZN+1;                             
 IF ZN>=FILESIZE THEN TOKEN:=SOURCEEND       
 ELSE                                        
  BEGIN                                      
    CH:= " ";          (* ERZWINGE GETCHAR *)
    WRITELN("",ZN);               
    GETXTOKEN;                               
  END;                                       
END;(* NEWLINE *)                            
                                             
PROCEDURE BISENDE;                           
(* IGNORIERE DEN REST DER LFD. ZEILE *)      
BEGIN                                        
 WHILE P<LINELENGTH DO                       
  BEGIN                                      
   READ(SOURCEFILE,CH); P:=P+1               
  END;                                       
 TOKEN:= LINEEND;                            
END; (* BISENDE *)                           
                                             
PROCEDURE INIT;                              
(* KOPF DES EDITOR-FILES LESEN, ZEILEN-    *)
(* ZAEHLER ZURUECKSETZEN.                  *)
(* LINELENGTH ENTHAELT DIE ZEILENLAENGE    *)
  VAR I:INTEGER;                             
      A,B,C:CHAR;                            
BEGIN                                        
  ZN:=-1; LASTZN:= -1;                       
  READ(SOURCEFILE,C,C,C,A,B);                
  FILESIZE  :=ORD(A)+256*ORD(B);             
  LINELENGTH:=ORD(C);                        
  FOR I:=1 TO 2+3*LINELENGTH DO              
    READ(SOURCEFILE,C);                      
  IF EOF(SOURCEFILE) THEN                    
    BEGIN                                    
     WRITELN("FILE NOT FOUND"); ABORT     
    END;                                     
  TEXT;                                      
  P:= LINELENGTH; (* ERZWINGE ZEILENANFANG *)
  NEWLINE;                                   
END;(* INIT *)                               
                                             
(* -------------------------- ENDE SCANNER *)