|
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: 28203 (0x6e2b)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »V71«
└─⟦256585323⟧ Bits:30008759 50001598
└─⟦this⟧ »V71«
/* V71 FLYTTAR ÖVER ÅRETS ACK. VERBELOPP PÅ EN NY DISKETT
LÄGGER SEDAN 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
VERSION 1:6. Matchningsfel avhjälpt, rad 159 IF MAXV = 0 THEN ANTALBP = 0
PRG JÅ 780920 Version med datum återfinns i sista DCL-raden före PROC */
DCL INP POINTER,
1 TRANSTR BASED(INP),
2 KONTOT FIXED(11),
2 VERNRT FIXED(5),
2 BDATUMT FIXED(5),
2 PDATUMT FIXED(5),
2 BELOPPT FIXED(11),
2 TEXT CHAR(13),
TRANL BINARY INIT(34);
/* 34 BYTES */
DCL STACKPT POINTER, /* TOPP */
KONTONRV BASED(STACKPT) CHAR(11),
T BASED(STACKPT) CHAR(1);
DCL STACKPB POINTER, /* BOTTEN */
KONTONRB BASED(STACKPB) CHAR(11);
DCL HAELP POINTER, /* HJÄLPSTR FÖR INSERT AV NYTT 5-RECORD */
1 UTSTR BASED(HAELP),
2 VERNRV BINARY,
2 PDATUMV BINARY,
2 BELOPPV FIXED(11),
HAELL BINARY INIT(10);
/* 10 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(255) CHAR(34); /* INLÄSNINGSAREA FÖR KOPIA */
/* 8 670 BYTES */
DCL 1 TOPAREA,
2 CH1(90) CHAR(61); /* 90 GGR 5 = 450 ARBETSAREA FÖR SEKVENSER */
/* 5 490 BYTES */
DCL 1 AREA,
2 CH2(205) CHAR(61), /* INLÄSNING VERBELOP */
VERL BINARY INIT(61);
/* 12 505 BYTES */
DCL NR BINARY,
T1 CHAR(1),
T6 CHAR(6),
T11 CHAR(11),
FX5 FIXED(5),
P1 CHAR(8) INIT('-------9'),
FILTAB(3) CHAR(10) INIT(' K81 ',' K91 ',' VERBELOP'),
MAXT BINARY, /* NEDRÄKNING AV REST. ANTAL RECORDS I KOPIA */
MAXV BINARY,
RCODE BINARY,
FAS BINARY INIT(0), /* 0 = START, 1 = TR < REG, 2 = TR = REG, 3 = TR>REG*/
KOPIA FILE,
ANTALBP BINARY INIT(-1),
ANTALTP BINARY INIT(0),
ANTALTOT BINARY,
JT BINARY, /* NEDRÄKNIONG AV ANTAL LEDIGA RECORDS I AREAIN */
JV BINARY INIT(0),
HAELNR BINARY INIT(5),
HAELNRT BINARY,
TPOSTANT BINARY, /* URSPRUNGLIGT ANTAL RECORD I KOPIA */
LOADTEXT CHAR(100),
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 SKRIVSKYDDAD'),
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),
2 OP_KOD BINARY,
2 RADANT BINARY,
VERSION CHAR(47) INIT(' V7 Version 1.6 800701');
DISKETTK:PROC;
XN=FILTAB(FIRMA-7);
D0: FSTR3=STR;
I=3;
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 VERBELOP 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=3;
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;
XN=FILTAB(3);
FSTR1=STR;
I=3;
CALL CHOOSE(I);
OPEN VERIN;
FSTR2=STR;
I=4;
CALL CHOOSE(I);
OPEN VERUT;
I=0;
CALL CHOOSE(I);
CALL SEOF(VERIN);
MAXV=UNSPEC(VERIN);
IF MAXV = 0 THEN ANTALBP = 0;
UNSPEC(VERIN)=0;
RETURN;
END;
OPENTRAN:PROC;
OPEN KOPIA;
CALL SEOF(KOPIA);
MAXT=UNSPEC(KOPIA);
TPOSTANT=MAXT;
UNSPEC(KOPIA)=0;
RETURN;
END;
TRANSPOST:PROC;
DCL ANTALINP BINARY INIT(0);
IF (MAXT>0) ö (ANTALINP>0) THEN DO;
IF ANTALINP=0 THEN DO;
JT=255;
IF JT>MAXT THEN JT=MAXT;
MAXT=MAXT-JT;
CALL RD(KOPIA,AREAIN,JT,RCODE);
IF RCODE¬=0 THEN PUT SKIP LIST('LÄSFEL I KOPIA',RCODE);
ANTALINP=JT-1;
IF JT<255 THEN DO;
UNSPEC(INP)=ADDR(AREAIN);
UNSPEC(INP)=UNSPEC(INP)+JT*TRANL;
KONTOT='99999999999';
END;
INP=ADDR(AREAIN);
END;
ELSE DO;
ANTALINP=ANTALINP-1;
UNSPEC(INP)=UNSPEC(INP)+TRANL;
END;
T11=KONTOT;
RETURN;
END;
ELSE DO;
T11='99999999999';
RETURN;
END;
END;
STACKBYGG:PROC;
ANTALP2=ANTALP2+1;
IF HAELNRT>5 THEN DO;
UNSPEC(STACKPT)=UNSPEC(STACKPT)-VERL;
HAELNRT=6;
ST1: HAELNRT=HAELNRT-1;
UNSPEC(HAELP)=UNSPEC(STACKPT)+VERL-HAELNRT*HAELL;
IF HAELNRT=1 THEN GO TO ST2;
PDATUMV=0;
VERNRV=0;
BELOPPV=0;
GO TO ST1;
ST2: KONTONRV=T11;
ANTALTP=ANTALTP+1;
END;
ELSE DO;
UNSPEC(HAELP)=UNSPEC(STACKPT)+VERL-HAELNRT*HAELL;
END;
VERNRV=VERNRT;
FX5=PDATUMT;
CALL FXTOBIN(FX5,PDATUMV);
IF BDATUMT¬=PDATUMT THEN PDATUMV=-PDATUMV;
BELOPPV=BELOPPT;
HAELNRT=HAELNRT+1;
RETURN;
END;
SKRIV:PROC;
ANTALTOT=ANTALTP+ANTALBP;
IF ANTALTOT=0 THEN RETURN;
CALL WR(VERUT,T,ANTALTOT,RCODE);
IF RCODE¬=0 THEN PUT SKIP LIST('SKRIVFEL I UTFILEN',RCODE);
ANTALTP=0;
ANTALBP=0;
UNSPEC(STACKPT)=UNSPEC(STACKPB);
HAELNRT = HAELNR;
RETURN;
END;
VERPOST:PROC;
IF (MAXV>0) ö (JV>0) THEN DO;
IF JV=0 THEN DO;
ANTALBP = ANTALBP + 1;
CALL SKRIV;
JV=200;
IF JV>MAXV THEN JV=MAXV;
MAXV=MAXV-JV;
CALL RD(VERIN,AREA,JV,RCODE);
IF RCODE¬=0 THEN PUT SKIP LIST('LÄSFEL I INFIL',RCODE);
IF JV<200 THEN DO;
STACKPB=ADDR(AREA);
UNSPEC(STACKPB)=UNSPEC(STACKPB)+JV*VERL;
KONTONRB='99999999999';
END;
ELSE DO; JV = 199;
END;
STACKPB=ADDR(AREA);
STACKPT=ADDR(AREA);
V0:
END;
ELSE DO;
UNSPEC(STACKPB)=UNSPEC(STACKPB)+VERL;
ANTALBP=ANTALBP+1;
JV=JV-1;
END;
IF KONTONRB ¬= '99999999999' THEN DO
HAELNR=1 TO 5;
UNSPEC(HAELP)=UNSPEC(STACKPB)+VERL-HAELNR*HAELL;
IF PDATUMV=0 THEN GO TO V1;
ANTALP2=ANTALP2+1;
END;
V1: HAELNRT = HAELNR;
END;
ELSE DO;
KONTONRB='99999999999';
END;
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 DATCHECK(DATUM);
IF DATUM='0 ' THEN CALL PLOAD('Q ');
UNSPEC(P)=16570;
UNSPEC(PP)=16616;
D='0';
CALL DISKETTK; /* KOLLAR DISKETTER ÖPPNAR BEHÖVLIGA FILER */
PUT FILE(D) SKIP EDIT(VERSION)(A(96))('Generering av "VERBELOP" pågår')
(A(47));
CALL CORED(0); /* SLÄCKER CORSORN */
CALL OPENTRAN;
IF MAXT=0 THEN GO TO L2;
STACKPT=ADDR(AREA);
STACKPB=ADDR(AREA);
CALL VERPOST;
CALL TRANSPOST;
L1:
/* PUT SKIP LIST (T11, ' ', KONTONRB, FAS); */
IF T11<KONTONRB THEN DO;
IF T11>KONTONRV THEN FAS=3;
IF FAS=0 THEN HAELNRT=6;
IF FAS=2 THEN GO TO FEL;
IF FAS=3 THEN DO;
CALL SKRIV;
HAELNRT=6;
END;
FAS=1;
CALL STACKBYGG;
CALL TRANSPOST;
GO TO L1;
END;
IF T11=KONTONRB THEN DO;
IF T11='99999999999' THEN GO TO UT;
IF (FAS=1) ö (FAS=3) THEN CALL SKRIV;
FAS=2;
CALL STACKBYGG;
CALL TRANSPOST;
GO TO L1;
END;
IF T11>KONTONRB THEN DO;
FAS=3;
CALL VERPOST;
GO TO L1;
END;
L2: PUT FILE(D) SKIP EDIT(VERSION)(A(96))
('INGA KONTERINGAR HAR GJORTS SEDAN SENASTE BATCH')(A(47));
CALL OUTPUT(1,6);
GET SKIP LIST('');
GO TO SLUT;
UT: CALL SKRIV;
IF RCODE¬=0 THEN GO TO FEL;
CLOSE VERUT;
DATUM2=DATUM;
PUT SKIP(2) EDIT(' 2')(A(11))(DATUM1)(A(10))(DATUM2)(A(7))
(TPOSTANT)(PP1)(ANTALP1)(PP1)(ANTALP2)(PP1)
(TPOSTANT+ANTALP1-ANTALP2)(PP1) SKIP(RADANT - 11);
REWRITE FILE(KONTROL) FROM(KONTROL2);
GO TO SLUT1;
FEL: IF RCODE¬=0 THEN PUT FILE(D) SKIP EDIT(FELTAB(RCODE))(A(47));
ELSE PUT EDIT('FAS = ')(A(6))(FAS)(A(41));
GET SKIP LIST('');
GO TO SLUT;
SLUT:SLUT1:D=DATUM;
CALL LOAD('SORTTEST VERBELOP 4 11 0 Q',26);
END;