|
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: 24648 (0x6048)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »V61«
└─⟦256585323⟧ Bits:30008759 50001598
└─⟦this⟧ »V61«
/* V61 FLYTTAR ÖVER ÅRETS ACK. VERTEXTER PÅ EN NY DISKETT
LÄGGER SEAD NYSKAPADE POSTER FRÅN TRANSFIL PÅ DEN NYA UPPLAGAN
OM NÅGON TYP AV LÄS ELLER SKRIVFEL UPPKOMMER LÄMNAS FELMEDDELANDE PÅ DISPLAY
& RUTINEN ÅTERGÅR TILL MENYN
V 0:1
PRG JÅ 780913 */
DCL UTP POINTER,
1 VERUTSTR BASED(UTP),
2 VERNRUT FIXED(5),
2 DATUMUT BINARY,
2 TEXTUT CHAR(13),
2 ANTALUT BINARY,
VERL BINARY INIT(20);
/* 20 BYTES */
DCL TRANP POINTER,
1 TRANSTR BASED(TRANP),
2 KONTO FIXED(11),
2 VERNR FIXED(5),
2 BDATUM FIXED(5),
2 PDATUM FIXED(5),
2 BELOPP FIXED(11),
2 TEXT CHAR(13),
TRANL BINARY INIT(34);
/* 34 BYTES */
DCL 1 KONTROL1,
2 ANTALP1 BINARY,
2 DATUM1 CHAR(6);
/* 8 BYTES */
DCL 1 KONTROL2,
2 ANTALP2 BINARY,
2 DATUM2 CHAR(6);
/* 8 BYTES */
DCL 1 FSTR1,
2 VERIN FILE;
DCL 1 FSTR2,
2 VERUT FILE;
DCL 1 FSTR3,
2 KONTROL FILE;
DCL 1 STR,
2 XN CHAR(24);
DCL 1 AREAIN,
2 CHIN(100) CHAR(100);
/* 10 000 BYTES */
DCL 1 AREAUT,
2 CH2(60) CHAR(100);
/* 6 000 BYTES */
DCL NR BINARY INIT(0),
VERMAX FIXED(5) INIT(0),
VERMIN FIXED(5) INIT(99999),
P1 CHAR(8) INIT('-------9'),
NAMN(2) CHAR(10) INIT('KVV/KWAROS','AROS'),
TPOSTANT BINARY,
T1 CHAR(1),
T6 CHAR(6),
FILTAB(3) CHAR(10) INIT(' K80 ',' K90 ',' VERTEXT '),
MAX BINARY,
RCODE BINARY INIT(0),
TRANSFIL FILE,
ANTALPIN BINARY,
ANTALPUT BINARY INIT(0),
FELTAB(10) CHAR(47) INIT(
'SEKTOR HEADER NOT FOUND',
'READ ERROR',
'WRITE ERROR',
'KEY NOT FOUND',
'NÅGON DISKETT HAR FLYTTATS',
'EN AV FILERNA ÄR FÖR LITEN',
'EN AV FILERNA ÄR SKRIVSKYDAD'),
P POINTER,
D BASED(P) CHAR(6),
DATUM CHAR(6),
PP POINTER,
1 STRX BASED(PP),
2 X CHAR(2),
2 Y CHAR(2),
2 FIRMA CHAR(1),
VERSION CHAR(47) INIT(' V6 Version 1.3 790412');
DCL READYTRACE BINARY INIT (0);
DISKETTK:PROC;
IF READYTRACE = 1 THEN PUT SKIP LIST ('DISKETTK PROC');
XN=FILTAB(FIRMA-7);
D0: FSTR3=STR;
I=2;
D1: CALL CHOOSE(I);
ON ERROR GO TO FEL1;
OPEN KONTROL;
ON ENDFILE GO TO FEL2;
READ FILE(KONTROL) INTO(KONTROL2);
D2: IF I=4 THEN GO TO D3;
I=4;
KONTROL1=KONTROL2;
GO TO D1;
FEL1: PUT FILE(D) SKIP EDIT(VERSION)(A(96))
('DISKETT MED VERTEXT FINNS INTE I DRIVE')(A(40))
(I)(A(7))('SÄTT IN RÄTT DISKETT & TRYCK "RETURN"')(A(47));
CALL OUTPUT(1,6);
GET SKIP LIST('');
I=2;
GO TO D1;
FEL2: ANTALP2=0;
DATUM2='******';
GO TO D2;
D3: PUT FILE(D) SKIP EDIT(VERSION)(A(96))('SENASTE BATCHDATUM')(A(47))
('INDISKETT')(A(10))(DATUM1)(A(37))('UTDISKETT')(A(10))(DATUM2)(A(37))
('OM OK SVARA "J"')(A(47));
CALL OUTPUT(1,6);
GET SKIP LIST(T1);
IF T1¬='J' THEN GO TO D0;
ANTALP2=0;
IF READYTRACE = 1 THEN PUT SKIP LIST ('SLUT DISKETTK');
RETURN;
END;
BUFFMOVE:PROC;
IF READYTRACE = 1 THEN PUT SKIP LIST ('BUFFMOVE');
XN=FILTAB(3);
FSTR1=STR;
I=2;
CALL CHOOSE(I);
OPEN VERIN;
FSTR2=STR;
I=4;
CALL CHOOSE(I);
OPEN VERUT;
I=0;
CALL CHOOSE(I);
CALL SEOF(VERIN);
MAX=UNSPEC(VERIN);
UNSPEC(VERIN)=0;
J=255;
B1: IF MAX=0 THEN DO;
OPEN VERIN;
GO TO B9;
END;
IF J>MAX THEN J=MAX;
MAX=MAX-J;
CALL RD(VERIN,AREAIN,J,RCODE);
IF RCODE¬=0 THEN PUT SKIP LIST('LÄSFEL I VERIN ',RCODE);
CALL WR(VERUT,AREAIN,J,RCODE);
IF RCODE¬=0 THEN PUT SKIP LIST('SKRIVFEL I VERUT ',RCODE);
ANTALP2=ANTALP2+J;
GO TO B1;
B9: UTP=ADDR(AREAUT);
IF READYTRACE = 1 THEN PUT SKIP LIST ('SLUT BUFFMOVE');
RETURN;
END;
OPENTRAN:PROC;
IF READYTRACE = 1 THEN PUT SKIP LIST ('OPENTRAN');
OPEN TRANSFIL;
CALL SEOF(TRANSFIL);
MAX=UNSPEC(TRANSFIL);
TPOSTANT=MAX;
UNSPEC(TRANSFIL)=0;
ANTALPIN=0;
IF READYTRACE = 1 THEN PUT SKIP LIST ('SLUT OPENTRAN');
RETURN;
END;
POSTIN:PROC;
IF READYTRACE = 1 THEN PUT SKIP LIST ('POSTIN');
IF ANTALPIN=0 THEN DO;
IF MAX=0 THEN DO;
RCODE=10;
RETURN;
END;
J=255;
IF J>MAX THEN J=MAX;
MAX=MAX-J;
CALL RD(TRANSFIL,AREAIN,J,RCODE);
IF RCODE¬=0 THEN PUT SKIP LIST('LÄSFEL I TRANSFIL',RCODE);
ANTALPIN=J-1;
TRANP=ADDR(AREAIN);
END;
ELSE DO;
ANTALPIN=ANTALPIN-1;
UNSPEC(TRANP)=UNSPEC(TRANP)+TRANL;
END;
IF READYTRACE = 1 THEN PUT SKIP LIST ('SLUT POSTIN');
RETURN;
END;
POSTUT:PROC;
IF READYTRACE = 1 THEN PUT SKIP LIST ('POSTUT');
ANTALP2=ANTALP2+1;
ANTALPUT=ANTALPUT+1;
IF (ANTALPUT=255) ö ((ANTALPIN=0) & (MAX=0)) THEN DO;
CALL WR(VERUT,AREAUT,ANTALPUT,RCODE);
IF RCODE¬=0 THEN PUT SKIP LIST('SKRIVFEL I TRANSFIL');
UTP=ADDR(AREAUT);
ANTALPUT=0;
END;
ELSE DO;
UNSPEC(UTP)=UNSPEC(UTP)+VERL;
END;
VERNRUT=VERNR;
CALL FXTOBIN(BDATUM,DATUMUT);
TEXTUT=TEXT;
IF READYTRACE = 1 THEN PUT SKIP LIST ('SLUT POSTUT');
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:
IF READYTRACE = 1 THEN PUT SKIP LIST ('START');
CALL DATCHECK(DATUM);
IF DATUM='0 ' THEN GO TO SLUT;
UNSPEC(P)=16570;
UNSPEC(PP)=16616;
D='0';
CALL DISKETTK;
PUT FILE(D) SKIP EDIT(VERSION)(A(96))('Generering av "VERTEXT" pågår')
(A);
CALL BUFFMOVE;
IF RCODE¬=0 THEN GO TO FEL;
CALL OPENTRAN;
IF MAX=0 THEN GO TO L3;
CALL POSTIN;
IF RCODE¬=0 THEN GO TO FEL;
NR=VERNR;
VERNRUT=VERNR;
CALL FXTOBIN(BDATUM,DATUMUT);
TEXTUT=TEXT;
ANTALUT=1;
L1:
IF READYTRACE = 1 THEN PUT SKIP LIST ('L1');
CALL POSTIN;
IF RCODE¬=0 THEN GO TO FEL;
IF NR>VERNR THEN DO;
PUT FILE(D) SKIP EDIT('VERNUMMER ÄR I OORDNING')(A);
GET SKIP LIST('');
GO TO SLUT;
END;
IF VERMAX<VERNR THEN VERMAX=VERNR;
IF VERMIN>VERNR THEN VERMIN=VERNR;
IF NR¬=VERNR THEN DO;
CALL POSTUT;
IF RCODE¬=0 THEN GO TO FEL;
ANTALUT=1;
NR=VERNR;
END;
ELSE DO;
ANTALUT=ANTALUT+1;
END;
GO TO L1;
L2:
IF READYTRACE = 1 THEN PUT SKIP LIST ('L2');
CALL POSTUT;
IF RCODE¬=0 THEN GO TO FEL;
CLOSE VERUT;
CALL CHOOSE(4);
OPEN TRANSFIL;
CLOSE TRANSFIL;
CALL CHOOSE(0);
DATUM2=DATUM;
TPOSTANT=VERMAX-VERMIN+1;
PUT SKIP(4) EDIT(NAMN(FIRMA-7))(A(19))('BATCHRAPORT')(A(25))
('19')(A(2))(SUBSTR(DATUM,1,2))(A)('-')(A)(SUBSTR(DATUM,3,2))(A)
('-')(A)(SUBSTR(DATUM,5,2))(A(6))('SID 1')(A) SKIP(2) EDIT
(' ')(A(35))('ANTAL POSTER')(A) SKIP EDIT
('BATCHFAS INDATUM UTDATUM TRANS VERIN VERUT DIFF')(A)
SKIP(2) EDIT(' 1')(A(11))(DATUM1)(A(10))(DATUM2)(A(7))
(TPOSTANT)(PP1)(ANTALP1)(PP1)(ANTALP2)(PP1)
(TPOSTANT+ANTALP1-ANTALP2)(PP1);
REWRITE FILE(KONTROL) FROM(KONTROL2);
GO TO SLUT1;
L3:
IF READYTRACE = 1 THEN PUT SKIP LIST ('L3');
PUT FILE(D) SKIP EDIT(VERSION)(A(96))
('INGA KONTERINAR HAR GJORTS SEDAN SENASTE BATCH')(A(47));
CALL OUTPUT(1,6);
GET SKIP LIST('');
GO TO SLUT;
FEL:
IF READYTRACE = 1 THEN PUT SKIP LIST ('FEL');
IF RCODE=10 THEN GO TO L2;
PUT FILE(D) SKIP EDIT(VERSION)(A(96))(FELTAB(RCODE))(A(47));
CALL OUTPUT(1,6);
GET SKIP LIST('');
GO TO SLUT;
SLUT:
IF READYTRACE = 1 THEN PUT SKIP LIST ('SLUT');
D=DATUM;
CALL PLOAD('Q ');
SLUT1:
IF READYTRACE = 1 THEN PUT SKIP LIST ('SLUT1');
D=DATUM;
CALL LOAD
('COPY TRANSFIL KOPIA 2 2 S KOPIA SORTFIL SORTTEST KOPIA 2 6 0 V13',64);
END;