|
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: 9717 (0x25f5)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »KSDEMOS«
└─⟦a1fc8f6a5⟧ Bits:30008659 DDMQ1-0099_KSAM_DEMO_1_OF_2
└─⟦this⟧ »KSDEMOS«
DCL 1 KSSTRUCT,
2 RC CHAR(1), /*RETURN CODE FOR READ*/
2 KSKEY CHAR(9),
2 DATARECORD CHAR(71);
DCL 1 KSREC,
2 RCODE CHAR(1),
2 FILENAME CHAR(7);
DCL SKEY CHAR(9); /*KEY FOR SEARCH*/
DCL N CHAR(3);
DCL STEST FILE; /*REGULAR FILE*/
DCL KTEST FILE; /* KSAM FILE*/
DCL 1 SRECSTRUC,
2 SSN CHAR(9),
2 NAME CHAR(20),
2 STREET CHAR(30),
2 CITY CHAR(10),
2 STATE CHAR(11);
DELAY: PROCEDURE;
DCL J BINARY;
DCL SLOW FLOAT INIT(1);
DLOOP:DO J=1 TO 100;
SLOW=(((SLOW*6)/5)+2);
END;
END;
SEARCH: PROCEDURE;
PUT FILE(D)SKIP LIST('BEGIN');
CALL OUTPUT(1,6);
READ KEY(SKEY) FILE(STEST) INTO(SRECSTRUC);
CALL OUTPUT(1,6);
PUT FILE(D) LIST(' END');
T:PUT SKIP LIST(' ');
END;
KOERROR: PROCEDURE;/*KSAM FILE OPEN ERROR*/
IF RCODE=1 THEN PUT SKIP(2) LIST('FILE NOT FOUND ON INDEX');
ELSE PUT SKIP(2) LIST('FORMAT ERROR:FILE NOT ACCESSIBLE');
END;
KRERROR: PROCEDURE;/*KSAM READ ERROR*/
IF RC=2 THEN PUT SKIP(2) LIST('FORMAT ERROR ON READ');
ELSE IF RC=3 THEN PUT SKIP(2) LIST('FILE NOT OPENED');
ELSE PUT SKIP(2) LIST('KEY NOT FOUND IN FILE');
END;
KSR: PROCEDURE;
DCL KSSTR POINTER;
DCL KSCNTL POINTER;
DCL KSCNTLAREA(16) CHAR(128);
/*OPEN KSAM FILE*/
READREC:DO;
/*READ RECORD FROM KSAM FILE*/
KSKEY=SKEY;
KSSTR=ADDR(KSSTRUCT);
KSCNTL=ADDR(KSCNTLAREA(1));
PUT FILE(D) SKIP LIST('BEGIN');
CALL OUTPUT(1,6);
CALL KSREAD(KSCNTL, KSSTR);
CALL OUTPUT(1,6);
PUT FILE(D) LIST(' END');
IF RC¬=' ' THEN READERROR:DO;
CALL KRERROR;
RETURN;
END;
END;
END;
SRERROR: PROCEDURE; /*REGULAR FILE READ ERROR*/
IF ONCODE=1 THEN PUT SKIP LIST('DISK FORMAT ERROR');
ELSE IF ONCODE=2 THEN PUT SKIP LIST('READ ERROR');
ELSE IF ONCODE=3 THEN PUT SKIP LIST('WRITE ERROR');
ELSE IF ONCODE=4 THEN PUT SKIP LIST('KEY NOT FOUND');
ELSE PUT SKIP LIST('FILE NOT OPENED OR DISK REMOVED ON OPEN');
END;
PRINTREC: PROCEDURE;
PUT SKIP(3) LIST('SOCIAL SECURITY NO:',SSN);
PUT SKIP LIST('NAME:',NAME);
PUT SKIP LIST('STREET ADDRESS:',STREET);
PUT SKIP LIST('CITY:',CITY,'STATE:',STATE);
END;
ON ERROR GO TO T;
OPEN STEST;
/* OPEN KSAM FILE */
KSSTR=ADDR(KSREC);
KSCNTL=ADDR(KSCNTLAREA(1));
FILENAME='KTEST ';
CALL KSOPEN(KSCNTL,KSSTR);
IF RCODE¬=' ' THEN OPENERROR: DO;
CALL KOERROR;
END;
LOOP:PUT FILE(D) SKIP LIST('EXIT PROGRAM?(TYPE YES OR NO:)');
GET SKIP LIST(N);
IF N='YES' THEN GO TO FINI;
ELSE PUT FILE(D) SKIP LIST('ENTER KEY:');
GET SKIP LIST(SKEY);
PUT FILE(D) SKIP LIST ('GET READY TO TIME REGULAR SEARCH');
CALL DELAY;
CALL SEARCH;
IF ONCODE>0 THEN READWRONG:DO;
CALL SRERROR;
GO TO LOOP;
END;
ELSE CALL PRINTREC;
PUT FILE(D) SKIP LIST('GET READY TO TIME KSAM SEARCH');
CALL DELAY;
CALL KSR;
IF RCODE¬=' ' THEN GO TO LOOP;
ELSE IF RC¬=' ' THEN GO TO LOOP;
ELSE TRANSFER:DO;
SSN=KSKEY;
NAME=SUBSTR(DATARECORD,1,20);
STREET=SUBSTR(DATARECORD,21,30);
CITY=SUBSTR(DATARECORD,51,10);
STATE=SUBSTR(DATARECORD,61,11);
END;
CALL PRINTREC;
GO TO LOOP;
FINI:END;