|
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: 10981 (0x2ae5)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »PROGCOP1«
└─⟦3c3b1dc2e⟧ Bits:30008749 50001582
└─⟦this⟧ »PROGCOP1«
/* PROGRAM-ID. PROGCOP1.
DATE-WRITTEN. 81-04-15.
AUTHOR. OLLE.
REMARKS. PROGRAMMET KOPIERAR IN ANGIVNA SEKVENSER
FRÅN ETT PROGRAM IN I ETT ANNAT. RECORD-
LÄNGDEN BLIR 79 POS. SPECIELL ARBETSFIL AN-
VÄNDS. PROGRAMMET FÅR INTE BLI STÖRRE ÄN
1600 STATEMENTS. */
DCL WHATIN1 FILE,
WHATIN2 FILE,
ARBFIL FILE;
/* WORKING-STORAGE SECTION. */
DCL DATUM CHAR (6),
RADANT CHAR (3),
R CHAR (2),
K BINARY INIT (0),
JJJ BINARY INIT (1),
SVAR CHAR (4),
INSERTTAB (30) BINARY INIT ((30)0),
FILNAMN1 CHAR (8),
FILNAMN2 CHAR (8);
FRAGA: PROC;
F10:
DCL JJ (30) BINARY INIT (103,113,123,150,160,170,197,
207,217,244,254,264,291,301,311,338,348,358
,385,395,405,432,442,452,479,489,499,526,
536,546);
J = JJ(JJJ);
CALL MOVEBUFF (J);
CALL TYPIST (SVAR,4);
CALL TYPIST ('┣10┫',1);
F99:
RETURN;
END;
SVARA: PROC;
S10:
PUT FILE (D) EDIT (SVAR) (A(4));
INSERTTAB (JJJ) = SVAR;
JJJ = JJJ + 1;
IF JJJ = 31 THEN JJJ = 1;
S99:
RETURN;
END;
/* PROCEDURE DIVISION. */
A10:
PUT FILE (D) SKIP EDIT ('PROGRAMNAMN,filen som skall uppdateras:')(A);
CALL KFILE (WHATIN1);
GET SKIP LIST (FILNAMN1);
PUT FILE (D) EDIT (FILNAMN1) (A(8));
OPEN WHATIN1;
PUT FILE (D) EDIT ('PROGRAMNAMN,filen som lämnar uppgifter:') (A);
CALL KFILE (WHATIN2);
GET SKIP LIST (FILNAMN2);
PUT FILE (D) EDIT (FILNAMN2) (A(8));
OPEN WHATIN2;
GET SKIP LIST (SVAR);
PUT FILE (D) SKIP EDIT (' PROGRAM-1 PROGRAM-2')(A(47));
PUT FILE (D) EDIT (' in efter rad fr.o.m - t.o.m. ') (A(47));
CALL FRAGA;
JJJ = 0;
A20:
GET SKIP LIST (SVAR);
CALL KEYFUN (K);
IF K = 140 THEN GO TO B10;
CALL SVARA;
CALL FRAGA;
GO TO A20;
B10:
J = 1;
IFIL1 = 0;
IFIL2 = 0;
OPEN ARBFIL;
B20:
GET SKIP LIST (FILNAMN1);
CALL TYPIST (FILNAMN1,8);
CALL TYPIST ('┣10┫',1);
CALL KFILE (WHATIN1);
OPEN WHATIN1;
UNSPEC (WHATIN1) = IFIL1;
B30:
ON ERROR GO TO C10;
ON ENDFILE GO TO D20;
READ FILE (WHATIN1) INTO (PGMPOST1);
IF UNSPEC (WHATIN1) = INSERTTAB (J) - 1 THEN GO TO B50;
WRITE FILE (ARBFIL) FROM (PGMPOST1);
IFIL1 = IFIL1 + 1;
GO TO B30;
B50:
J = J + 1;
GET SKIP LIST (FILNAMN2);
CALL TYPIST (FILNAMN2,8);
CALL TYPIST ('┣10┫',1);
CALL KFILE (WHATIN2);
OPEN WHATIN2;
UNSPEC (WHATIN2) = INSERTTAB (J) -1;
IFIL2 = UNSPEC (WHATIN2);
B60:
ON ERROR GO TO C20;
ON ENDFILE GO TO D10;
READ FILE (WHATIN2) INTO (PGMPOST2);
IF UNSPEC (WHATIN2) > INSERTTAB (J + 1) THEN GO TO B70;
WRITE FILE (ARBFIL) FROM (PGMPOST2);
IFIL2 = IFIL2 + 1;
GO TO B60;
B70:
J = J + 2;
GO TO B20;
C10:
PUT SKIP LIST ('LÄSFEL I FIL1 ',ONCODE);
GO TO D20;
C20:
PUT SKIP LIST ('LÄSFEL I FIL2 ',ONCODE);
GO TO D20;
D10:
GO TO B20;
D20:
END;