|
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;