|
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: 6083 (0x17c3)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »PACKA_S«
└─⟦febfac1c4⟧ Bits:30008721 DDMQ1-0162
└─⟦this⟧ »PACKA_S«
/* PACKA ÄR ETT RENSINGSPROGRAM SOM RENSAR BORT ALLA POSTER SOM BÖRJAR MED
"¬¬¬¬¬" MED HJÄLP AV PACKNING
PROGRAMMET ANROPAS MED "PACKA ********" ******** = FILEN SOM SKA RENSAS
PRG JÅ 791116 */
DCL 1 INFIL_STR,
2 INFIL FILE,
1 UTFIL_STR,
2 UTFIL FILE,
1 INAREA,
2 CH(100) CHAR(130),
REC_LENGD BINARY,
MAX BINARY,
MAX_POST BINARY,
I BINARY,
ANTAL_OK BINARY,
RCODE BINARY,
P_ID POINTER,
ID CHAR(5) BASED(P_ID),
P_UD POINTER,
UD CHAR(5) BASED(P_UD),
VERSION CHAR(37)
INIT('PACKA Version 2.1 791116');
GET_REC_LENGD:PROC(INFIL_GRL,REC_LENGD_GRL);
DCL INFIL_GRL CHAR(24),
REC_LENGD_GRL CHAR(2);
SUBSTR(REC_LENGD_GRL,1,2)=SUBSTR(INFIL_GRL,13,2);
RETURN;
END;
PUT FILE(D) SKIP EDIT(VERSION)(A(74))('FIL:')(A(29));
CALL KFILE(INFIL);
PUT FILE(D) SKIP EDIT(VERSION)(A(74));
OPEN INFIL;
UTFIL_STR=INFIL_STR;
CALL GET_REC_LENGD(INFIL,REC_LENGD);
CALL SEOF(INFIL);
MAX=UNSPEC(INFIL);
UNSPEC(INFIL)=0;
MAX_POST=13000/REC_LENGD;
IF MAX_POST>255 THEN MAX_POST=255;
START: IF MAX=0 THEN DO;
CLOSE UTFIL;
GO TO EXIT;
END;
IF MAX_POST>MAX THEN MAX_POST=MAX;
MAX=MAX-MAX_POST;
CALL RD(INFIL,INAREA,MAX_POST,RCODE);
IF RCODE¬=0 THEN GO TO FEL;
P_ID=ADDR(INAREA);
P_UD=ADDR(INAREA);
ANTAL_OK=0;
DO I=1 TO MAX_POST;
IF ID='¬¬¬¬¬' THEN DO;
END;
ELSE DO;
ANTAL_OK=ANTAL_OK+1;
IF ANTAL_OK¬=I THEN SUBSTR(UD,1,REC_LENGD)=SUBSTR(ID,1,REC_LENGD);
UNSPEC(P_UD)=UNSPEC(P_UD)+REC_LENGD;
END;
UNSPEC(P_ID)=UNSPEC(P_ID)+REC_LENGD;
END;
IF ANTAL_OK>0 THEN CALL WR(UTFIL,INAREA,ANTAL_OK,RCODE);
IF RCODE=0 THEN GO TO START;
FEL: PUT FILE(D) EDIT('LÄS- ELLER SKRIV-FEL')(A(21))(RCODE)(A(16));
CALL OUTPUT(1,6);
GET SKIP LIST('');
EXIT:
END;