DataMuseum.dk

Presents historical artifacts from the history of:

Q1 computer

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Q1 computer

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦6eb4b6d21⟧ Q1_Text, reclen=79

    Length: 13667 (0x3563)
    Types: Q1_Text, reclen=79
    Notes: q1file
    Names: »MERGE_S«

Derivation

└─⟦febfac1c4⟧ Bits:30008721 DDMQ1-0162
    └─⟦this⟧ »MERGE_S« 

Text

/* MERGE GÖR MERGE PÅ FIL1 OCH FIL2 OCH RESULTATET LÄGES I FIL1                
    EN SKRATCHFIL BEHÖVS SOM MELANRESULTATET LÄGS I                            
    PRG JÅ 791119 */                                                           
                                                                               
                                                                               
DCL FIL1             FILE,                                                     
    FIL2             FILE,                                                     
    UTFIL            FILE,                                                     
                                                                               
    1 IN1_ST,                                                                  
      2 IN1          CHAR(78),                                                 
                                                                               
    1 IN2_ST,                                                                  
      2 IN2          CHAR(78),                                                 
                                                                               
    1 UT_ST,                                                                   
      2 UT           CHAR(78),                                                 
                                                                               
    1 TOM_STR,                                                                 
      2 CH4          CHAR(78)        INIT('¬¬¬¬¬¬¬¬'),                         
                                                                               
    1 IN2_STR(82),                                                             
      2 CH5          CHAR(78),                                                 
                                                                               
    1 UT_STR(82),                                                              
      2 CH6          CHAR(78),                                                 
                                                                               
    P                POINTER,                                                  
    IN(82)           CHAR(78)        BASED(P),                                 
    BLOCK            BINARY          INIT(82),                                 
    TOT              BINARY          INIT(0),                                  
    VERSION          CHAR(37)                                                  
    INIT('MERGE Version 1.1              791119');                             
                                                                               
TO_SMAL:PROC(T24S);                                                            
DCL T24S             CHAR(24);                                                 
        PUT FILE(D) EDIT(SUBSTR(T24S,3,8))(A(9))('ÄR FÖR LITEN')(A(28));       
        CALL OUTPUT(1,6);                                                      
        GET SKIP LIST('');                                                     
        STOP;                                                                  
END;                                                                           
                                                                               
                                                                               
ANT_GET:PROC(T24A,AA,BB,CC);                                                   
DCL T24A             CHAR(24),                                                 
    AA               CHAR(2),                                                  
    BB               CHAR(2),                                                  
    CC               CHAR(2);                                                  
        SUBSTR(AA,1,2)=SUBSTR(T24A,15,2);                                      
        SUBSTR(BB,1,2)=SUBSTR(T24A,17,2);                                      
        SUBSTR(CC,1,2)=SUBSTR(T24A,19,2);                                      
    RETURN;                                                                    
END;                                                                           
                                                                               
                                                                               
MAX_GET:PROC(T24,ANT);                                                         
DCL T24              CHAR(24),                                                 
    ANT              BINARY,                                                   
    A                BINARY,                                                   
    B                BINARY,                                                   
    C                BINARY;                                                   
        CALL ANT_GET(T24,A,B,C);                                               
        A=A&255;                                                               
        ANT=A*(C-B+1);                                                         
    RETURN;                                                                    
END;                                                                           
                                                                               
                                                                               
FIL_OPEN:PROC;                                                                 
        CALL KFILE(FIL1);                                                      
        CALL KFILE(FIL2);                                                      
        CALL KFILE(UTFIL);                                                     
        OPEN FIL1;                                                             
        OPEN FIL2;                                                             
        OPEN UTFIL;                                                            
        CALL SEOF(FIL1);                                                       
        CALL SEOF(FIL2);                                                       
        I=UNSPEC(FIL1)+UNSPEC(FIL2);                                           
        CALL MAX_GET(FIL1,J);                                                  
        IF J<I THEN CALL TO_SMAL(FIL1);                                        
        CALL MAX_GET(UTFIL,J);                                                 
        IF J<I THEN CALL TO_SMAL(UTFIL);                                       
        UNSPEC(FIL1)=0;                                                        
        UNSPEC(FIL2)=0;                                                        
        DO I=1 TO BLOCK;                                                       
           IN2_STR(I)=TOM_STR;                                                 
        END;                                                                   
                                                                               
        ON ENDFILE GO TO OK;                                                   
        READ FILE(FIL2) INTO(IN2_STR);                                         
OK:     UNSPEC(FIL2)=0;                                                        
        CLOSE FIL2;                                                            
    RETURN;                                                                    
END;                                                                           
                                                                               
IN1_POST:PROC;                                                                 
        ON ENDFILE GO TO IN1SL;                                                
        READ FILE(FIL1) INTO(IN1_ST);                                          
    RETURN;                                                                    
IN1SL:  IN1_ST=TOM_STR;                                                        
    RETURN;                                                                    
END;                                                                           
                                                                               
                                                                               
IN2_POST:PROC;                                                                 
        K=1;                                                                   
        DO J=2 TO BLOCK;                                                       
           IF IN(J)<IN(K) THEN K=J;                                            
        END;                                                                   
        IN2_ST=IN2_STR(K);                                                     
        IN2_STR(K)=TOM_STR;                                                    
    RETURN;                                                                    
END;                                                                           
                                                                               
UT_POST:PROC;                                                                  
DCL ANT_UT           BINARY          INIT(1);                                  
        UT_STR(ANT_UT)=UT_ST;                                                  
        ANT_UT=ANT_UT+1;                                                       
        IF ANT_UT<=BLOCK THEN RETURN;                                          
        ON ENDFILE GO TO OK_UT;                                                
        WRITE FILE(UTFIL) FROM(UT_STR);                                        
OK_UT:  ANT_UT=1;                                                              
    RETURN;                                                                    
END;                                                                           
                                                                               
                                                                               
STOPP_TEST:PROC;                                                               
        IF SUBSTR(IN1,1,8)¬='¬¬¬¬¬¬¬¬' THEN RETURN;                            
        IF SUBSTR(IN2,1,8)¬='¬¬¬¬¬¬¬¬' THEN RETURN;                            
        ON ENDFILE GO TO OK_ST;                                                
        WRITE FILE(UTFIL) FROM(UT_STR);                                        
OK_ST:  CLOSE UTFIL;                                                           
        OPEN UTFIL;                                                            
        OPEN FIL1;                                                             
        DO I=0 TO TOT BY BLOCK;                                                
           ON ENDFILE GO TO OK1;                                               
           READ FILE(UTFIL) INTO(IN2_STR);                                     
OK1:       ON ENDFILE GO TO OK2;                                               
           WRITE FILE(FIL1) FROM(IN2_STR);                                     
OK2:    END;                                                                   
                                                                               
        UNSPEC(FIL1)=TOT;                                                      
        CLOSE FIL1;                                                            
        OPEN FIL2;                                                             
        CLOSE FIL2;                                                            
        OPEN UTFIL;                                                            
        CLOSE UTFIL;                                                           
        STOP;                                                                  
END;                                                                           
                                                                               
                                                                               
                                                                               
/*  H Ä R   B Ö R J A R   H U V U D P O G R A M M E T  */                      
                                                                               
        P=ADDR(IN2_STR(1));                                                    
        CALL FIL_OPEN;                                                         
        CALL IN1_POST;                                                         
        CALL IN2_POST;                                                         
        PUT FILE(D) SKIP EDIT(VERSION)(A(74));                                 
LOOP:   IF IN1<IN2 THEN DO;                                                    
           UT=IN1;                                                             
           CALL IN1_POST;                                                      
        END;                                                                   
        ELSE DO;                                                               
           CALL STOPP_TEST;                                                    
           UT=IN2;                                                             
           CALL IN2_POST;                                                      
        END;                                                                   
        CALL UT_POST;                                                          
        TOT=TOT+1;                                                             
        GO TO LOOP;                                                            
                                                                               
END;