|
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: 12561 (0x3111)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »V131«
└─⟦256585323⟧ Bits:30008759 50001598
└─⟦this⟧ »V131«
/* V13 KOPIERAR ETT ANTAL FILER FRÅN DRIVE 2 TILL DRIV 4
PRG JÅ 781004 */
DCL 1 FSTR1,
2 INFIL FILE;
DCL 1 FSTR2,
2 UTFIL FILE;
DCL 1 KATALOG_STR,
2 KATALOG FILE;
DCL 1 STR,
2 XN CHAR(24);
DCL 1 INDEX_STR,
2 TAL BINARY,
2 INDEX_XN CHAR(8),
2 REC_ANT BINARY,
2 LENGD BINARY,
2 DIV BINARY,
2 F_TRACK BINARY,
2 L_TRACK BINARY,
2 UNUSED BINARY,
2 REC#_B BINARY;
DCL 1 K_STR,
2 L_VERNR FIXED(5),
2 H_VERNR FIXED(5),
2 DATUM CHAR(6);
/* 14 BYTES */
DCL 1 TRANS_STR,
2 KONTONR FIXED(11),
2 VERNR FIXED(5),
2 REST CHAR(25);
DCL 1 AREA,
2 CH(255) CHAR(100);
DCL SVAR CHAR(25),
T1 CHAR(1),
T8 CHAR(8),
MAX BINARY,
SP BINARY,
VERSION CHAR(47) INIT(' V13 Version 1.2 790323'),
TEXT CHAR(52) INIT('DISK A 4 7 XXXXXX_Y 34 COPY TRANSFIL XXXXXX_Y 2 4 V7');
MOVEBUFF:PROC;
FSTR1=STR;
FSTR2=STR;
CALL CHOOSE(2);
OPEN INFIL;
CALL CHOOSE(4);
OPEN UTFIL;
CALL SEOF(INFIL);
I=UNSPEC(INFIL);
IF I=0 THEN RETURN;
UNSPEC(INFIL)=0;
J=255;
B1: IF J>I THEN J=I;
I=I-J;
CALL RD(INFIL,AREA,J,K);
IF K¬=0 THEN PUT SKIP LIST('LÄSFEL I',XN,K);
CALL WR(UTFIL,AREA,J,K);
IF K¬=0 THEN PUT SKIP LIST('SKRIVFEL I',XN,K);
IF I>0 THEN GO TO B1;
CLOSE UTFIL;
RETURN;
END;
/* H Ä R B Ö R J A R H U V U D P R O G R A M M E T */
START: CALL LOAD('┣0d┫',1);
GET SKIP LIST(SVAR);
PUT FILE(D) SKIP EDIT(VERSION)(A(94));
CALL DATCHECK(DATUM);
XN=' KONTOP ';
PUT FILE(D) EDIT(XN)(A(47));
CALL MOVEBUFF;
XN=' UKONTOP ';
PUT FILE(D) SKIP EDIT(VERSION)(A(94))(XN)(A(47));
CALL MOVEBUFF;
XN=' KSKONTOP';
PUT FILE(D) SKIP EDIT(VERSION)(A(94))(XN)(A(47));
CALL MOVEBUFF;
XN=' TRANSFIL';
PUT FILE(D) SKIP EDIT(VERSION)(A(94))(XN)(A(47));
FSTR1=STR;
OPEN INFIL;
CLOSE INFIL;
CALL CHOOSE(0);
OPEN INFIL;
ON ERROR GO TO L1;
READ FILE(INFIL) INTO(TRANS_STR);
L_VERNR=VERNR;
L1: CALL SEOF(INFIL);
MAX=UNSPEC(INFIL);
UNSPEC(INFIL)=MAX-1;
ON ERROR GO TO L2;
READ FILE(INFIL) INTO(TRANS_STR);
H_VERNR=VERNR;
L2: SP=(MAX+147)/148;
CALL CHOOSE(4);
I1: PUT FILE(D) SKIP EDIT(VERSION)(A(94))(' KATALOG')(A(47));
ON ERROR GO TO L3;
OPEN KATALOG;
INDEX_STR=KATALOG_STR;
IF F_TRACK=2 THEN GO TO L4;
L3: PUT FILE(D) SKIP EDIT(VERSION)(A(96))
('FEL DISKET I DRIVE# 4')(A(47))('SÄTT IN ARKIVDISKET')(A(47));
CALL OUTPUT(1,6);
GET SKIP LIST('');
GO TO I1;
L4: XN=' INDEX ';
PUT FILE(D) SKIP EDIT(VERSION)(A(94))(XN)(A(47));
FSTR1=STR;
OPEN INFIL;
INDEX_STR=FSTR1;
UNSPEC(INFIL)=REC_ANT-1;
READ FILE(INFIL) INTO(INDEX_STR);
IF 76 < L_TRACK+SP THEN DO;
PUT FILE(D) SKIP EDIT(VERSION)(A(96))('ARKIVDISKETTEN ÄR FULL')
(A(47))('BYT DISKETT')(A(47));
CALL OUTPUT(1,6);
GET SKIP LIST('');
GO TO I1;
END;
CALL SEOF(KATALOG);
WRITE FILE(KATALOG) FROM(K_STR);
CLOSE KATALOG;
T1='1';
UNSPEC(INFIL)=0;
ON ERROR GO TO I2;
READ KEY(DATUM) FILE(INFIL) INTO(INDEX_STR) KEYTO(INDEX_XN);
L5: T1=SUBSTR(INDEX_XN,8,1)+1;
T8=DATUM CAT '_' CAT T1;
ON ERROR GO TO I3;
READ KEY(T8) FILE(INFIL) INTO(INDEX_STR) KEYTO(INDEX_XN);
GO TO L5;
I2: T8=DATUM CAT '_' CAT T1;
I3: CALL CHOOSE(0);
T1=SP;
IF SP>0 THEN SUBSTR(TEXT,10,1)=T1;
SUBSTR(TEXT,12,8)=T8;
SUBSTR(TEXT,38,8)=T8;
CALL LOAD(TEXT,52);
END;