|
DataMuseum.dkPresents historical artifacts from the history of: Q1 computer |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Q1 computer Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 13667 (0x3563)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »MERGE_S«
└─⟦febfac1c4⟧ Bits:30008721 DDMQ1-0162
└─⟦this⟧ »MERGE_S«
/* 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;