PROGRAM MERGE(INPUT,OUTPUT);                                
(*DIESES PROGRAMM IST EIN BEISPIEL FUER DIE VERWENDUNG DER*)
(*ANPASSUNGSROUTINEN FUER FILES. GLEICHZEITIG WIRD EIN    *)
(*BEISPIEL FUER INCLUDE-FILES GEGEBEN.                    *)
(*BEIM UEBERSETZEN MUSS DIE DISKETTE MIT DEM INCLUDE-FILE *)
(*'FILE.INC' EINGELEGT SEIN.                              *)
(*11.11.1985                                              *)
(*QUELLE: N.WIRTH: ALGORITHMEN & DATENSTRUKTUREN KAP.2.3.2*)
                                                            
 TYPE ITEM=RECORD                                           
            KEY:INTEGER                                     
            (* HIER KOENNEN WEITERE FELDER STEHEN *)        
           END;                                             
      TAPE=FILE OF ITEM;                                    
                                                            
 VAR KOMMANDO: TEXT;        (*<------ NUR PASCAL 1.4----- *)
     C       : TAPE;                                        
     BUF     : ITEM;                                        
                                                            
  (*$"FILE.INC" INCLUDE-DATEI LESEN   NUR PASCAL 1.4----- *)
                                                            
  PROCEDURE LIST(VAR F: TAPE);                              
  (*ZEIGE DEN INHALT VON F AN*)                             
    VAR X: ITEM;                                            
  BEGIN RESET(F);                                           
   WHILE NOT EOF(F) DO                                      
     BEGIN                                                  
       X.KEY:=F^.KEY;GET(F);                                
       WRITE(X.KEY:4)                                       
     END;                                                   
   WRITELN                                                  
  END;(* LIST *)                                            
                                                            
  PROCEDURE NATURALMERGE;                                   
  (* SORTIERE FILE C. BENUTZT ZWEI HILFSFILES A UND B     *)
    VAR L  : INTEGER;  (* ANZAHL DER LAEUFE AUF C         *)
        EOR: BOOLEAN;  (* END OF RUN, ENDE DES LAUFS      *)
        A,B: TAPE;     (* HILFSFILES                      *)
                                                            
    PROCEDURE COPY(VAR X,Y: TAPE);                          
    (* KOPIERE KOMPONENTE VON X NACH Y, AKTUALISIERE EOR  *)
      VAR BUF: ITEM;                                        
    BEGIN                                                   
      BUF.KEY:=X^.KEY; GET(X);                              
      Y^.KEY:=BUF.KEY; PUT(Y);                              
      IF EOF(X) THEN EOR:= TRUE                             
                ELSE EOR:= BUF.KEY>X^.KEY                   
    END;(* COPY *)                                          
                                                            
    PROCEDURE COPYRUN(VAR X,Y: TAPE);                       
    (* KOPIERE LAUF VON X NACH Y                          *)
    BEGIN                                                   
      REPEAT COPY(X,Y) UNTIL EOR                            
    END;(* COPYRUN *)                                       
                                                            
    PROCEDURE DISTRIBUTE;                                   
    (* KOPIERE LAUEFE VON C ABWECHSELND AUF A UND B       *)
    BEGIN                                                   
      REPEAT                                                
        COPYRUN(C,A);                                       
        IF NOT EOF(C) THEN COPYRUN(C,B)                     
      UNTIL EOF(C)                                          
    END;(* DISTRIBUTE *)                                    
                                                            
    PROCEDURE MERGE;                                        
    (* MISCHE FILE A UND B ZU FILE C                      *)
                                                            
      PROCEDURE MERGERUN;                                   
      (* MISCHE LAEUFE VON A UND B ZU LAEUFEN AUF C       *)
      BEGIN                                                 
        REPEAT                                              
          IF A^.KEY<B^.KEY THEN                             
           BEGIN COPY(A,C);                                 
             IF EOR THEN COPYRUN(B,C)                       
           END                                              
          ELSE                                              
           BEGIN COPY(B,C);                                 
             IF EOR THEN COPYRUN(A,C)                       
           END                                              
        UNTIL EOR                                           
      END;(* MERGERUN *)                                    
                                                            
    BEGIN (* MERGE *)                                       
      REPEAT                                                
        MERGERUN; L:=L+1                                    
      UNTIL EOF(A) OR EOF(B);                               
      WHILE NOT EOF(A) DO                                   
        BEGIN                                               
          COPYRUN(A,C); L:=L+1                              
        END;                                                
      WHILE NOT EOF(B) DO                                   
        BEGIN                                               
          COPYRUN(B,C); L:=L+1                              
        END                                                 
    END;(* MERGE *)                                         
                                                            
  BEGIN (* NATURALMERGE *)                                  
   ALLOC(A); ALLOC(B);      (*<------ NUR PASCAL 1.4----- *)
   REPEAT                                                   
     REWRITE(A); REWRITE(B); RESET(C);                      
     DISTRIBUTE;                                            
     RESET(A); RESET(B); REWRITE(C);                        
     L:=0; MERGE; LIST(C)                                   
   UNTIL L=1;                                               
   FREE(A); FREE(B)         (*<------ NUR PASCAL 1.4----- *)
  END; (* NATURALMERGE *)                                   
                                                            
BEGIN (* HAUPTPROGRAMM *)                                   
 WRITELN("SORTIEREN EINES SEQUENTIELLEN FILES:");           
 WRITELN("EINGABEZAHLEN: (0 AM ENDE)");                     
 OPEN(KOMMANDO,8,15,"I0");  (*<------ NUR PASCAL 1.4----- *)
 ALLOC(C);                  (*<------ NUR PASCAL 1.4----- *)
 REWRITE(C); READ(BUF.KEY);                                 
 REPEAT                                                     
   C^.KEY:=BUF.KEY; PUT(C);                                 
   READ(BUF.KEY)                                            
 UNTIL BUF.KEY=0;                                           
 LIST(C);                                                   
 NATURALMERGE;                                              
 FREE(C)                    (*<------ NUR PASCAL 1.4----- *)
END.