RDC TITLE 'DMSRDC (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00010000 * MODULE NAME - DMSRDC 00011000 * 00012000 * FUNCTION- READ CARDS AND ASSIGN THE FILE NAME INDICATED 00013000 * 00014000 * ATTRIBUTES- DISK RESIDENT, TRANSIENT 00015000 * NOTE: READCARD MUST BE GENMOD'D WITH THE SYSTEM OPTION 00015100 * 00016000 * ENTRY POINT- READCARD 00017000 * 00018000 * ENTRY CONDITIONS- 00019000 * GPR1 = A(PLIST) 00020000 * PLIST IN FORM 00021000 * CL8'READCD' 00022000 * 00023000 * CL*'FN/*' 00024000 * CL*'FT/*' NOT PRESENT IF SPECIAL READ 00025000 * OPTIONAL, 00026000 * CL8'FENCE' 00027000 * @VA14498 00027500 * EXIT CONDITION-R15 CONTAINS RESULT CODE 00028000 * 0- NO ERRORS 00029000 * 8 - READER EMPTY OR NOT READY 00030100 * 20 - ILLEGAL * IN FILEID 00030200 * 24 - NO FILEID 00030300 * INCOMPLETE FILEID 00030400 * 36 - DEVICE INVALID, NONEXISTENT OR UNSUPPORTED @VA14498 00030420 * DISK NOT ACCESSED @VA14498 00030440 * DISK IS READ/ONLY @VA14498 00030460 * 100- ERROR WRITING FILE 00030500 * ERROR READING CARDS 00030600 * @VA14498 00034600 * CALLS TO OTHER ROUTINES 00040000 * DMSBRD,DMSFNS,DMSERS,DMSSTT,DMSCWR,DMSCIO,DMSCPF, @VA14498 00041100 * DMSLAD @VA14498 00041700 * @VA14498 00042300 * EXTERNAL REFERENCES 00043000 * FVS, ADT, NUCON 00044000 * 00045000 * TABLES/WORK AREAS 00046000 * 00047000 * REGISTER USAGE- 00048000 * R15- SUBROUTINE LINKAGE AND RETURN CODE 00049000 * R14- RETURN 00050000 * R12- BASE 00051000 * R1- PLIST POINTER(ON ENTRY) 00052000 * R2- PLIST POINTER 00053000 * R13 - NOT USED 00054100 * ALL OTHERS - WORK REGISTERS 00054200 * 00056000 * OPERATION: @VA14498 00057000 * 00058000 * READCARD INITIALIZES BLOCK LENGTH AND RECORD SIZE THEN-- 00059000 * 00060000 * IF SPECIAL READ MODE (*): READCARD READS THE FIRST CARD FROM 00061000 * THE CARD READER VIA A CALL TO DMSCIO, IF THE CARD IS NOT 00062100 * A READ CONTROL CARD, READCARD PRINTS AN INFORMATION MESSAGE 00063000 * AND WILL THEN ASSUME A FILEID OF 'READCARD CMSUT1' 00064100 * (THE USER MAY LATER RENAME THE FILE IDENTIFICATION TO WHAT WAS 00065000 * INTENDED.) IF AN ASTERISK WAS SPECIFIED ONLY IN THE 00066000 * FILENAME FIELD, READCARD WILL TAKE THE FILENAME, @VA14498 00067000 * FILETYPE AND FILEMODE FROM THE READ CONTROL CARD AND @VA14498 00068000 * PLACE THAT INFORMATION IN THE PARAMETER LIST. IF 00069000 * ASTERISKS WERE PLACED IN THE FILENAME AND FILETYPE 00070000 * FIELDS, AND NO MODE SPECIFIED, THE FILENAME AND 00071000 * FILETYPE FROM THE READ CARD WILL BE PLACED IN THE 00072000 * PARAMETER LIST AND A DEFAULT MODE OF A1 WILL BE PLACED 00073000 * INTO THE PARAMETER LIST. IF '* * FM' WAS SPECIFIED, 00074000 * THE FILENAME AND FILETYPE ARE TAKEN FROM THE READ 00075000 * CARD AND PUT INTO THE PARAMETER LIST AND THE MODE 00076000 * SPECIFIED IS THE DISK UPON WHICH THE FILE WILL BE 00077000 * PLACED. THE CONTROL CARD INFORMATION IS TYPED AT 00078000 * THE CONSOLE VIA A CALL TO CONWRITE. IF '* * MODE', 00079000 * THE MODE IN EFFECT IS TYPED AS PART OF THE CONTROL CARD 00080000 * INFORMATION. 00081000 * 00082000 * IF THE EXISTENCE OF A FILE WITH THE INTENDED 00083000 * IDENTIFICATION HAS BEEN ESTABLISHED, READCARD WILL @VA14498 00084000 * ERASE THE COPY OF THE OLD FILE ONCE VERIFICATION OF 00085000 * THE INPUT FILE IS OBTAINED. NEXT, IT READS A BLOCK 00086000 * OF CARDS AS DESCRIBED BELOW. IF NEITHER ANOTHER READ 00087000 * CONTROL CARD NOR AN END-OF-FILE IS ENCOUNTERED DURING 00088000 * READING, READCARD CALLS THE DMSBWR FUNCTION PROGRAM TO 00089000 * PLACE THE CARD IMAGES INTO A DISK FILE IT REPEATS 00090100 * THIS PROCEDURE FOR THE NEXT BLOCK OF CARDS IN THE 00091000 * READER. 00092000 * 00093000 * IF ANOTHER READ CONTROL CARD APPEARS IN THE INPUT 00094000 * STREAM, SCAN IS CALLED TO FORMAT IT AND CONWRITE TO 00095000 * TYPE IT AT THE TERMINAL. IT THEN WRITES THE 00096100 * REMAINING IMAGE OF THE PREVIOUS FILE INTO THE DISK 00097000 * FILE, CALLS THE FINIS COMMAND PROGRAM TO CLOSE THAT 00098000 * FILE, AND RETURNS TO PROCESS THE NEW FILE OF CARDS 00099000 * FOLLOWING THE SECOND CONTROL CARD IN THE PRESCRIBED 00100000 * MANNER. READCARD REPEATS THIS PROCEDURE FOR EACH 00101100 * LOGICAL FILE OF CARDS IN THE READER. 00102000 * 00103000 * 00104000 * WHEN AN END-OF-FILE IS ENCOUNTERED DURING THE READING 00105000 * OF CARDS, READCARD PLACES THE REMAINING IMAGES INTO THE 00106000 * LAST DISK FILE, CALLS FINIS TO CLOSE THAT FILE, CALLS CP 00107000 * CLOSE TO CLOSE THE CARD READER OPERATION, AND RETURNS 00108000 * TO THE CALLING PROGRAM, THUS, DURING PROCESSING, 00109000 * READCARD CONVERTS EACH CARD FILE IN THE CARD READER TO 00110000 * A CORRESPONDINGLY NAMED DISK FILE. 00111000 * 00112000 * NO SPECIAL READ MODE. READCARD CALLS THE ERASE COMMAND 00113100 * PROGRAM TO ERASE THE IDENTICALLY NAMED FILE(IF ONE 00114000 * EXISTS AND IF THERE ARE CARDS TO BE READ). NEXT,IT 00115000 * READS A BLOCK OF CARDS,. IT THEN CALLS THE DMSBWR 00116000 * FUNCTION PROGRAM TO WRITE THE IMAGES INTO A DISK 00117000 * FILE. READCARD REPEATS THIS PROCEDURE FOR EACH BLOCK 00118000 * OF CARDS UNTIL AN END-OF-FILE OCCURS. AT THIS TIME, 00119000 * IT WRITES THE REMAINING IMAGES INTO THE DISK FILE, 00120000 * CLOSES THAT FILE (VIA DMSFNS),CLOSES THE CARD READER 00121000 * (VIA CP CLOSE ROUTINE), AND RETURNS TO THE 00122000 * CALLING PROGRAM. THUS, IF THE SPECIAL READ MODE IS 00123000 * NOT SELECTED, READCARD CREATES A SINGLE FILE FROM THE 00124000 * CARDS IN THE READER. 00125000 * 00126000 * IN EITHER CASE, (SPECIAL READ MODE(*) OR NOT), 00127000 * READCARD WILL READ THE FIRST DATA RECORD AND COMPARE 00128000 * ITS RECORD LENGTH AGAINST THE SPECIFIED LENGTH. IF 00129000 * IT GETS AN INCORRECT LENGTH, IT CHECKS TO SEE IF AN 00130000 * ERROR HAS BEEN ENCOUNTERED AND BRANCHES OUT WITH THE 00131000 * APPROPRIATE ERROR CODE. IF THERE IS NO ERROR 00132000 * AND IT IS THE FIRST CARD, IT ASSUMES THE FILE RECORD 00133100 * LENGTH TO BE EQUAL TO THE LENGTH OF THE FIRST RECORD READ 00134000 * AND CONTINUES TO READ AND WRITE AS DESCRIBED IN THE 00135000 * READ MODE DESCRIPTIONS DEPENDING ON WHICH WAS SPECIFIED. 00136000 * (THEREFORE, READCARD WILL NOT READ VARIABLE LENGTH 00137100 * FILES). BEFORE CLOSING THE CARD READER THE RECORD 00138000 * LENGTH IS CHECKED AND IF THE LENGTH IS NOT 80 BYTES 00139100 * THE MESSAGE "RECORD LENGTH = XXX BYTES" IS 00140000 * TYPED. 00141000 * 00142000 * THE FORMAT OF THE CARD EXPECTED BY READCARD IS 00143000 * EITHER THE CMS VER 3.1 "OFFLINE READ..." CONTROL 00144000 * CARD OR THE FOLLOWING FORMAT WHICH IS PRODUCED BY 00145000 * THE PUNCH COMMAND. 00146000 * 00147000 * 00148000 * COL - - - - - -- -- -- -- -- -- -- -- -- -- 00149000 * 1 2 6 7 8 16 17 25 26 28 29 35 36 44 45 00150000 * : READ B B FILENAME B FILETYPE B FM B VOLID B MM/DD/YY B HH 00151100 * 00154000 *. 00155000 EJECT 00156000 DMSRDC CSECT 00157000 READCARD EQU DMSRDC 00158000 ENTRY READCARD 00159000 BALR 12,0 SET BASE REG 00160000 USING *,12 TELL ASSEMBLER WHO IT IS 00161000 USING NUCON,R0 FAKE OUT FOR ADDRESSES WE NEED 00162000 TM BATFLAGS,BATRUN IS BATCH RUNNING? V0742 00162100 BZ NOTBAT BRANCH IF NOT @VM03203 00162200 LR R2,R1 SAVE PLIST POINTR @VM03203 00162300 OI BATFLAG2,BATDCMS TELL BATCH WHO'S CALLING @VM03203 00162400 LR R1,R2 BATABEND NEEDS PLIST @VM03203 00162500 L R15,ABATABND ENTER BATCH AT 'ABEND' POINT@VM03203 00162600 BR R15 AND DON'T COME BACK.... @VM03203 00162700 NOTBAT EQU * CONTINUE ... @VM03203 00162800 STM R0,R15,SAVE SAVE REGS 00163000 SR R2,R2 CLEAR DIAGNOSE AREA V0305 00163100 ST R2,DIAGAREA ... V0305 00163200 L R2,=XL4'0000000C' ASSUME DEVICE '00C' V0305 00163300 LA R4,INVMES SET FOR 'INVALID' MESSAGE V0305 00163400 DC X'83',X'23',XL2'0024' ISSUE DEVICE TYPE DIAGNOSE V0305 00163500 BC 1,ERR13A DEVICE NOT ATTACHED - ERROR V0305 00163600 ST R3,DIAGAREA RESULTS STORED V0305 00163700 CLI DEVCLASS,CLASURI UNIT RECORD INPUT CLASS? V0305 00163800 BNE ERR13 NO, WE ARE THROUGH V0305 00163900 TM DEVTYPE,TYPRDR IS IT A READER? V0305 00164000 BZ ERR13 NO, ERROR V0305 00164100 DEVOK LA R2,151 SET FOR MAXIMUM RECL V0402 00164200 STH R2,UNIT+12 SET INITIAL LRECL FOR READ 00165000 ST R2,LRECL * 00166000 LA R2,5 ASSUME BLOCK SIZE OF 5 V0402 00167100 ST R2,BLKSIZE * 00168000 SR R10,R10 NO. CARDS READ THIS FILE 00169000 SR R11,R11 TOTAL NO. CARDS READ 00170000 MVI SWS,X'00' RESET SWITCHES 00171000 MVI SWS2,X'00' ... V0402 00171100 OI SWS2,RPLIST HANDLING REAL COMMAND PLIST V0402 00171200 MVC FILENOIT(2),=XL2'0001' SET ITEM COUNT 00172000 OI SWS,FIRST FIRST READ SWITCH 00173000 MVC FMODE(2),=CL2'A ' INITIALIZE DEFAULT MODE V0402 00173100 * CHECK PLIST 00174000 L R1,SAVE+4 RESTORE POINTER TO PARMS 00175000 CKPLIST CLI 8(R1),X'FF' FENCE @VM08930 00175050 BE ERR01 @VM08930 00175100 CLI 16(R1),X'FF' FENCE @VM08930 00175150 BE CK1 @VM08930 00175200 CLI 24(R1),X'FF' FILEMODE OMITTED? @VM08930 00175250 BE CHKTYPE YES @VM08930 00175300 CLI 24(R1),C'*' FILEMODE EQUAL ASTERISK? @VM08930 00175350 BE CHKTYPE YES @VM08930 00175400 MVC MODE(2),24(R1) EXPLICIT MODE @VM08930 00175450 MVC FMODE(2),24(R1) @VM08930 00175500 OI SWS2,FMGIVN EXPLICIT MODE @VM08930 00175550 CHKTYPE CLI 16(R1),C'*' IS FT AN *? @VM08930 00177100 BE CK1 YES, SEE IF FN = * @VA01240 00177200 CLI 8(R1),X'FF' FENCE? 00178000 BE ERR01 PARM ERROR IF IT IS 00179000 CLI 8(R1),C'*' ASTERISK 00180000 BE CK2 YES,CK FOR FT=* 00181000 CLI 16(R1),C'*' ASTERISK? 00182000 BE ERR01A ERROR 00183000 MVC NAME(18),8(R1) SAVE FN,FT,FM 00184000 * 00185000 CK3 TM SWS,FIRST+SPMODE+SETFM 00186000 BO CK4 IF ALL ABLVE SWITCHES ON 00187000 TM SWS,SETFM SETTING FILE MODE? 00188000 BZ CK3A NO 00189000 MVC MODE(2),FMODE SET FM FROM INITIAL VALUE 00190000 B CK4 00191000 CK3A CLI 24(R1),X'FF' FILE MODE? 00192000 BE CK3B NO. FM NOT ENTERED. 00193000 CLC 24(3,R1),=C'* ' WAS FM = *? 00194000 BNE CK4 OKAY,IT'S SET 00195000 CK3B MVC MODE(2),=CL2'A1' DEFAULT MODE = A1 00196000 B CK4 00197000 * 00198000 CK1 TM SWS,SPMODE IS IT ALL READY SPECIAL 00199000 BO ERR01A ERROR IF IT IS 00200000 CLI 8(R1),C'*' ASTERISK 00201000 BE SETSW YES @VM08931 00202000 CLI 16(R1),C'*' FILETYPE EQUAL '*'? @VM08931 00202100 BE ERR01A YES @VM08931 00202200 B ERR01C FILETYPE OMITTED. @VM08931 00202300 SETSW OI SWS,SPMODE SIGNAL SPECIAL @VM08931 00203000 B CK2B V0402 00204100 * 00205000 CK2 TM SWS,SPMODE IS IT SPECIAL 00206000 BO ERR01A ERROR 00207000 CLI 16(R1),C'*' FT=* 00208000 BNE ERR01A ERROR IF IT DOES NOT P1094 00209000 OI SWS,SETFM+SPMODE 00210000 CLI 24(R1),X'FF' MODE? 00211000 BNE CK2A YES, USE IT 00212000 CK2A1 MVC FMODE(2),=CL2'A ' V0402 00213100 B CK2B 00214000 CK2A CLI 24(R1),C'*' IS FILEMODE AN ASTERISK 00215000 BE CK2A1 IF SO, DEFAULT TO A1 P3073 00216000 TM SWS2,RPLIST REAL COMMAND PLIST? V0402 00216100 BZ CK4 BRANCH IF CONTROL CARD PLIST V0402 00216200 CLI 25(R1),X'40' MODE NO. EXPLICITLY GIVEN? V0402 00216300 BE CKMV BRANCH IF NOT V0402 00216400 OI SWS2,FMGIVN EXPLICIT MODE NO. GIVEN V0402 00216500 CKMV EQU * V0402 00216600 MVC FMODE(2),24(R1) MOVE IN GIVEN MODE 00217000 CK2B MVC MODE(2),FMODE 00218000 * 00219000 CK4 MVC UNIT+12(2),LRECL+2 SET INITIAL CNTR 00220000 XC UNIT+14(2),UNIT+14 CLEAR BYTES READ 00221000 L R8,BUFFER BUFFER ADDRESS 00222000 ST R8,UNIT+8 00223000 MVI UNIT+8,X'80' TURN ON SPECIAL FLAG 00224000 L R9,BLKSIZE 00225000 NI SWS2,255-RPLIST V0402 00225100 CLI MODE+1,X'40' IS 2ND CHAR MISSING? P3073 00227000 BNE READ NO P3073 00228000 MVI MODE+1,C'1' DEFAULT VALUE 1 P3073 00229000 * 00230000 READ TM SWS1,CTRL TEST FOR ASSUMED CONTROL CARD 00231000 BNO READ1B NOT ONE 00232000 NI SWS1,255-CTRL TURN OFF SWITCH 00233000 B READ1D SKIP READ SINCE CARD IS IN BUFFER 00234000 READ1B LA R1,UNIT READ CARD 00235000 SVC 202 CALL CMS 00236000 DC AL4(ERR03) ERROR RET 00237000 READ1 LA R11,1(R11) TOTAL READ 00238000 READ1D TM SWS,FIRST 1ST READ? 00239000 BZ READCD1 NO 00240000 READ1C TM SWS,SPMODE+FIRSTSP IS IT SPECIAL 00241000 BM CKCTRL SKIP FILE SETUP FOR NOW 00242000 MVC FILE,=CL8'STATEW' SET COMMAND 00243000 MVC FILENAME(18),NAME MOVE FILE NAME 00244000 LA R1,FILE CALL STATEW 00245000 L R15,ASTATEW TO SEE IF OLD EXISTS @V305066 00246000 BALR R14,R15 ... @V305066 00246100 C R15,=F'36' WAS DISK NOT ACCESSED? @VA09236 00246300 BE DEVERR GIVE MSG @VA09236 00246500 C R15,=F'28' WAS FILE NOT FOUND BY STATE? 00248000 BE SKERASE NOT THERE, SKIP ERASE 00249000 LTR R15,R15 EVERYTHING OKAY 00250000 BZ ERASE YES, GO ERASE EXISTING FILE 00251000 LA R15,24 SET ERROR CODE(MSG WAS GIVEN BY STATE) 00252000 B RETURN1 GO BACK 00253000 * 00257000 ERASE MVC FILE(8),=CL8'ERASE' 00258000 LA R1,FILE ERASE OLD FILE 00259000 L R15,AERASE ERASE @V305066 00260000 BALR R14,R15 ... @V305066 00260100 B SKRWCK SKIP R/W CHECK @VA14498 00261000 SKERASE EQU * 00262000 LA R1,FILE CALL ADTLKW @VA14498 00262100 L R15,VCADTLKW TO CHECK IF R/W DISK @VA14498 00262200 BALR R14,R15 IF NOT ... @VA14498 00262300 BC 2,DEVERR2 GIVE ERROR MSG @VA14498 00262400 * @VA14498 00262500 SKRWCK EQU * @VA14498 00262600 MVC FILE(8),=CL8'WRBUF' SET FOR WRITE 00263000 MVC FILEBUFF(4),BUFFER SET BUFFER START AREA 00264000 NI SWS,255-(FIRST+FIRSTSP) TURN OFF 1ST SWITCH 00265000 * 00266000 READCD1 TM SWS,SPMODE SPECIAL READ? 00267000 BZ READ1A NO,CONTINUE 00268000 CLC 0(5,R8),ASSUME IS IT 12-2-9 READ CARD 00269000 BE READCD1A 00270000 CLC 0(7,R8),=C'OFFLINE' IS IT OLD OFFLINE HEADER 00271000 BNE READ1A NO 00272000 * SCAN FOR 'READ' AFTER OFFLINE 00272050 LA R4,8(R8) SET POINTER V0014 00272100 LA R5,68 SET COUNTER V0014 00272150 CKOFF2 CLI 0(R4),C' ' IS CHAR A NON-BLANK V0014 00272200 BNE CKOFF1 IF SO LOOK FOR 'READ' V0014 00272250 LA R4,1(R4) OTHERWISE,INCR PTR V0014 00272300 BCT R5,CKOFF2 AND LOOK AGAIN V0014 00272350 B READ1A V0014 00272400 CKOFF1 CLC 0(4,R4),=CL4'READ' IS IT REALLY? V0150 00272451 BNE READ1A IF NOT, GO BACK V0014 00272500 READCD1A OI SWS,EOF+CCARD TURN ON SWITCHES 00273000 MVC CCSAVE(80),0(R8) SAVE CNTRL CARD 00274000 READCD1B L R7,BUFFER SET LENGTH 00275000 SR R8,R7 IN FCB FOR WRITE 00276000 LTR R10,R10 ANY CARDS TO WRITE 00277000 BZ READNULL NO,NULL FILE 00278000 LTR R8,R8 ANY LEFT TO WRITE 00279000 BZ READ4 NO 00280000 STH R8,FILESIZE+2 SET SIZE 00281000 L R1,BLKSIZE CALCULATE ACTUAL NUMBER TO WRITE 00282000 SR R1,R9 SUBTRACT NUMBER NOT READ 00283000 STH R1,FILENOIT 00284000 B READ2A 00285000 * 00286000 READ1A LA R10,1(R10) INCR NO. CARDS THIS FILE 00287000 BCT R9,READ3 DECR BLOCK COUNT THIS RECORD 00288000 * END OF BLOCK, WRITE IT 00289000 READ2 MVC FILENOIT(2),BLKSIZE+2 00290000 SR R1,R1 CLEAR REG 00291000 LH R1,BLKSIZE+2 GET NO RECORDS 00292000 MH R1,LRECL+2 CALCULATE NUMBER BYTE RECORD 00293000 ST R1,FILESIZE 00294000 READ2A LA R1,FILE WRITE BUFFER 00295000 L R15,AWRBUF WRBUF @V305066 00296000 BALR R14,R15 ... @V305066 00296100 BNZ ERR02 DISK WRITE ERROR @V305066 00296200 TM SWS,EOF IS IT END OF FILE 00298000 BO READ4 YES 00299000 L R9,BLKSIZE SET BLOCKSIZE 00300000 L R8,BUFFER RESET BEGINNING OF BUFFER 00301000 ST R8,UNIT+8 * 00302000 OI UNIT+8,X'80' SPECIAL READ SWITCH FOR CARDIO 00303000 B READ 00304000 READ3 L R1,LRECL INCR BUFFER POINTER 00305000 AR R8,R1 * 00306000 ST R8,UNIT+8 NEXT READ IN AREA 00307000 OI UNIT+8,X'80' SPECIAL READ SWITCH FOR CARDIO 00308000 B READ 00309000 * LOOK FOR CONTROL CARD 00310000 CKCTRL CLC 0(6,R8),ASSUME CONTROL CARD ? 00311000 BE TYPCTRL V0402 00312100 CKCTRL1A EQU * P3073 00315000 CLC 0(7,R8),=C'OFFLINE' IS IT OFFLINE CARD 00316000 BNE CKCTRL1 V0402 00316100 LA R0,68 SET COUNTER V0150 00317050 LA R1,8(,R8) POINT TO CARD V0150 00317100 *SCAN FOR READ AFTER 'OFFLINE CARD' 00317150 CKC1 CLI 0(R1),C' ' IS CHAR A NON-BLANK? V0150 00317200 BNE CKC2 IF SO, LOOK FOR 'READ' V0150 00317250 LA R1,1(R1) IF NOT, GO AGAIN V0150 00317300 BCT R0,CKC1 DECR CNTR V0150 00317350 B CKCTRL1 IF NOT, ASSUME HEADER V0150 00317400 * 00317450 CKC2 CLC 0(4,R1),=CL4'READ' IS IT REALLY?? V0150 00317500 BNE CKCTRL1 IF NOT ASSUME HEADER V0150 00317550 B TYPCTRL 00318000 CKCTRL1 XC CCSAVE(80),CCSAVE CLEAR 00319000 MVC CCSAVE(29),ASSUME ASSUMED 00320000 OI SWS1,CTRL TURN ON SW FOR CONTROL CARD ASSUMED 00321000 DMSERR NUM=702,LET=I,TEXT='READ CONTROL CARD MISSING. G00322000 FOLLOWING ASSUMED:' 00323000 B TYPCTRL1 00324000 * 00325000 TYPCTRL MVC CCSAVE(80),0(R8) MOVE IN CNTRL CARD 00326000 TYPCTRL1 EQU * V0402 00327100 LA R8,CCSAVE ADDRESS THE CONTROL CARD @VA00982 00327250 CLC CCSAVE(8),=C'OFFLINE ' OFFLINE READ? @VA00982 00327300 BNE RDCARD NO, READ CARD @VA00982 00327350 LA R8,8(R8) BYPASS CONTROL WORD @VA00982 00327400 RDCARD LA R0,4 NO WORDS TO BYPASS @VA00982 00327450 LA R1,CCSAVE+69 CALCULATE MAXIMUM @VA00982 00327500 SR R1,R8 AREA TO SCAN @VA00982 00327550 CKBLNK CLI 0(R8),C' ' SKIP BLANKS @VA00982 00327600 BNE BYPASS PASS ON NON-BLANKS @VA00982 00327650 LA R8,1(R8) NEXT CHAR POSITION @VA00982 00327700 ADVBLNK EQU * @VA06148 00327760 BCT R1,CKBLNK CHECK NEXT @VA06148 00327770 B MVMODE MODE POSITION BY DEFAULT @VA00982 00327800 SPACE 1 00327850 CHKCHAR CLI 0(R8),C' ' CHECK FOR NON BLANK @VA00982 00327900 LA R8,1(R8) NEXT POSITION ANYWAY @VA00982 00327950 BE ADVBLNK GO TO SCAN FOR NEXT NON-BLANK @VA06148 00328010 BCT R1,CHKCHAR KEEP ON TRUCKIN' @VA00982 00328050 B MVMODE SHOULDN'T REALLY GET HERE @VA00982 00328100 SPACE 1 00328150 BYPASS BCT R0,CHKCHAR MORE WORDS TO SKIP @VA00982 00328200 MVMODE TM SWS2,FMGIVN MODE SPECIFIED? @VA00982 00328250 BO MVE2 YES, SETUP THE WHOLE THING @VA00982 00328300 MVC 0(1,R8),FMODE SET MODE LETTER @VA00982 00328350 B TYPCTRLA @VA00982 00328400 MVE2 MVC 0(2,R8),FMODE MODE LETTER AND NUMBER @VA00982 00328450 SPACE 1 00328500 TYPCTRLA LA R0,CCSAVE 00334000 DMSERR LET=I,NUM=702,TEXT='...................................X00335000 ....................................',SUB=(CHARA,(0)) 00336000 LA R0,71 LENGTH FOR SCAN MODULE @VA00982 00337100 * 00338000 LA R1,CCSAVE POINT TO CARD 00340000 L R15,ASCANN GO TO SCAN TO FORMAT PARAMETERS 00341000 BALR R14,R15 ON CTRL CARD TO PLIST 00342000 OI SWS,FIRSTSP INDICATE FIRST PASS ON SP CTRL CARD 00344000 * 00345000 * ON RETURN R1 POINTS TO LIST OF PARAMETERS 00346000 CLC 0(5,R1),ASSUME IS IT READ CNTRL CARD? V0014 00347100 BE CKPLIST 00348000 LA R1,8(R1) SET PLIST POINTER 00351000 B CKPLIST 00352000 * 00353000 * CLOSE THE FILE- IF NO MORE, CLOSE READER. 00354000 READ4 MVC FILE(8),=CL8'FINIS' CLOSE FILE 00355000 LA R1,FILE * 00356000 L R15,AFINIS FINIS @V305066 00357000 BALR R14,R15 ... @V305066 00357100 BNZ ERR02 DISK ERROR @V305066 00357200 READ5 TM SWS,CCARD IS CONTROL CARD PRESENT 00359000 BZ CLOSE NO 00360000 NI SWS,255-(EOF+CCARD) TURN OFF SOME SWITCHES 00361000 OI SWS,FIRST TURN ON OTHERS 00362000 LA R10,0 RESET COUNTER 00363000 B TYPCTRL1 00364000 CLOSE LA R1,CLOSIO CLOSE CARD READER 00365000 SVC 202 00366000 DC AL4(ERR03) CARD READER ERROR 00367000 TM SWS1,NOEOF WAS THIS SPECIAL CASE P0709 00368000 BNO CLOSE1 NO P0709 00369000 LR R15,R6 RETURN CODE P0709 00370000 B CLOSE2 P0709 00371000 CLOSE1 LA R15,0 RETURN CODE P0709 00372000 CLOSE2 CLC LRECL,=F'80' IS LRECL 80 CHARS P0709 00373000 BE RETURN YES, THEN DON'T NEED MESSAGE 00374000 LA R0,LRECL POINT TO LENGTH 00375000 DMSERR LET=I,NUM=738, P3021X00376000 TEXT='RECORD LENGTH IS ''...'' BYTES', P3021X00377000 SUB=(DECA,(0)) P3021 00378000 LA R15,0 00379000 * 00380000 RETURN LM R0,R14,SAVE RESTORE 00381000 BR R14 RETURN 00382000 * 00383000 RETURN1 LR R6,R15 SAVE CODE 00384000 LA R1,CLOSERDR CLOSE RDR HOLD 00385000 SVC 202 HAVE CMS COMMUNICATE THE REQUEST 00386000 DC AL4(*+4) 00387000 LR R15,R6 RESTORE CODE 00388000 B RETURN RETURN 00389000 EJECT 00390000 * 00391000 ERR01 DMSERR NUM=42,LET=E,TEXT='NO FILEID SPECIFIED' 00392000 LA R15,24 00393000 B RETURN 00394000 * 00395000 ERR01A DMSERR NUM=62,LET=E,TEXT='INVALID * IN FILEID' 00396100 LA R15,20 SET RETURN CODE P1096 00397000 B RETURN 00398000 * 00399000 ERR01C DMSERR NUM=54,LET=E,TEXT='INCOMPLETE FILEID SPECIFIED' 00400000 * 00401000 LA R15,24 00402000 B RETURN 00403000 ERR02 LA R0,FILENAME 00404000 DMSERR NUM=105,LET=S, P3061X00405000 TEXT=('ERROR ''..'' WRITING FILE', P3061X00406000 ' ''....................'' ', P3061X00407000 'ON DISK'),SUB=(DEC,(15),CHAR8A,(0)),RENT=NO @VA08020 00408000 LA R15,100 00409000 B RETURN1 GO CLOSE RDR 00410000 * 00411000 * 00412000 ERR03 CH R15,H1 IS IT EOF 00413000 BE RDEOF YES 00414000 CH R15,H2 IS IT READY 00415000 BE REREAD NO,TRY AGAIN 00416000 CH R15,H5 INCORRECT LENGTH? 00417000 BE SETLEN 00418000 CH R15,=H'3' IS ERROR CODE OTHER THAN 3 00419000 BNE RETURN MSG WAS GIVEN IN CARDIO MODULE 00420000 ERR03A DMSERR NUM=124,LET=S,TEXT='ERROR READING CARD FILE' 00421000 LA R15,100 ERROR CODE 00422000 B RETURN1 CLOSE RDR 00423000 * 00424000 * 00428000 RDEOF LTR R11,R11 ANY CARDS READ AT ALL 00429000 BZ REREAD NO, NO DATA IN READER V0699 00430100 OI SWS,EOF TURN ON END OF FILE SWITCH 00431000 B READCD1B 00432000 * 00433000 REREAD DMSERR NUM=205,LET=W,TEXT='READER EMPTY OR NOT READY' 00434000 LA R15,8 00435000 TM SWS,FIRST IS IT FIRST READ P0709 00436000 BO RETURN1 YES P0709 00437000 LR R6,R15 SAVE CODE P0709 00438000 OI SWS,EOF FORCE END OF FILE P0709 00439000 OI SWS1,NOEOF SET INDICATOR P0709 00440000 B READCD1B FINISH UP P0709 00441000 READNULL DMSERR NUM=701,LET=I,TEXT='(NULL FILE)' 00442000 LA R15,0 00443000 B READ5 00444000 * 00445000 SETLEN TM SWS,FIRST WAS IT FIRST READ 00446000 BZ ERR03A NO,ERROR,QUIT 00447000 SR R1,R1 CLEAR REG 00448000 LH R1,UNIT+14 00449000 ST R1,LRECL SAVE REC LEN 00450000 STH R1,UNIT+12 SET LEN IN PARM LIST 00451000 MVI UNIT+8,X'00' TURN OFF SPECIAL FLAG 00452000 LA R2,0 SET TO CALCULATE 00453000 LA R3,800 BLOCK LENGTH 00454000 DR R2,R1 DIVIDE AND 00455000 ST R3,BLKSIZE SAVE RESULTS 00456000 LR R9,R3 RESET BLK COUNT 00457000 B READ1 CONTINUE WITH NEW LRECL AND BLKSIZE 00458000 DEVERR LA R3,FILEMODE POINT TO MODE LETTER @VA09236 00458150 DMSERR TEXT='DISK ''..'' NOT ACCESSED',NUM=69, X00458300 LET=E,SUB=(CHARA,((R3),1)),TYPCALL=SVC @VA09236 00458450 L R15,=F'36' GIVE RETCODE @VA09236 00458600 B RETURN1 @VA09236 00458750 * 00459000 DEVERR2 LA R3,FILEMODE POINT TO MODE LETTER @VA14498 00459100 DMSERR TEXT='DISK ''..'' IS READ/ONLY',NUM=37, X00459200 LET=E,SUB=(CHARA,((R3),1)),TYPCALL=SVC @VA14498 00459300 L R15,=F'36' GIVE RETCODE @VA14498 00459400 B RETURN1 @VA14498 00459500 * 00460000 ERR13 LA R4,UNSMES SET FOR 'UNSUPPORTED' MESSAGE V0305 00460100 ERR13A DMSERR NUM=008,LET=E,RENT=NO, X00460200 TEXT='DEVICE ''...'' .......................', X00460300 SUB=(HEX,(2),CHARA,((4),23)) V0305 00460400 LA R15,36 SET RETURN CODE V0305 00460500 LM R0,R14,SAVE RESTORE REGISTERS V0305 00460600 BR R14 RETURN V0305 00460700 EJECT 00461000 * SAVE AREAS, CONSTANTS AND EQUATES. 00462000 DS 0D 00463000 CCSAVE1 DC 4C' ' LENGTH AREA 00464000 CCSAVE DS 80C CONTROL CARD BUFFER 00465000 SAVE DS 16F 00466000 SWS DS 1C SWITCHES 00467000 SWS1 DC X'00' 00468000 CTRL EQU X'01' CNTRL CARD ASSUMED SWITCH 00469000 NOEOF EQU X'02' INTERVENTION REQ'D ON RDR P0709 00470000 SWS2 DS 1C V0402 00470100 RPLIST EQU X'80' REAL COMMAND PLIST V0402 00470200 FMGIVN EQU X'40' EXPLICIT MODE NO. GIVEN V0402 00470300 BUFFER DC A(IOAREA) 00471000 NAME DS 8C SAVE FILENAME 00472000 TYPE DS 8C SAVE FILE TYPE 00473000 MODE DS 2C SAVE FILEMODE 00474000 FMODE DS 2C FILEMODE 00475000 H1 DC H'1' 00476000 H2 DC H'2' 00477000 H5 DC H'5' 00478000 LRECL DS 1F RECORD LENGTH 00479000 BLKSIZE DS 1F BLOCK SIZE 00480000 FIRSTSP EQU X'80' 1ST PASS ON SPMODE CCARD 00481000 CCARD EQU X'40' CONTROL CARD PRESENT 00482000 EOF EQU X'20' END OF FILE 00483000 FIRST EQU X'10' FIRST READ OF FILE 00484000 RECL132 EQU X'08' 132 CHAR RECORDS 00485000 RECL96 EQU X'04' 96 CHAR RECORDS 00486000 SETFM EQU X'02' FILEMODE WAS SPECIFIED 00487000 SPMODE EQU X'01' SPECIAL MODE READ 00488000 * SUPPLIED CONTROL CARD-THIS ORDER 00489000 ASSUME DC C':READ ' P3073 00490000 DC C'READCARD CMSUT1 A1 ' P3073 00491000 DIAGAREA DS 0F V0305 00491100 DEVCLASS DS 1C V0305 00491200 DEVTYPE DS 1C V0305 00491300 DEVSTAT DS 1C V0305 00491400 DEVFLAG DS 1C V0305 00491500 CLASURI EQU X'20' V0305 00491600 TYPRDR EQU X'80' V0305 00491700 INVMES DC CL24'INVALID OR NONEXISTENT ' V0305 00491800 UNSMES DC CL24'UNSUPPORTED DEVICE TYPE ' V0305 00491900 EJECT 00492000 * I/O PARAMETER LSITS 00493000 CLOSIO DS 0H 00494000 DC CL8'CP' 00495000 DC CL8'CLOSE' 00496000 DC CL8'00C' 00497000 DC 8X'FF' 00498000 * 00499000 CLOSERDR DC CL8'CP' CALL CP TO DO THE WORK 00500000 DC CL8'CLOSE' CLOSE THE RDR 00501000 DC CL8'RDR' * 00502000 DC CL8'HOLD' AND HOLD THE FILE 00503000 DC 8X'FF' FENCE 00504000 UNIT DS 0F 00505000 DC CL8'CARDRD' 00506000 DS 1F BUFFER LOCATION 00507000 DS 1F LRECL 00508000 DS 2C NO. BYTES READ 00509000 * 00510000 NULMSG DS 0F 00511000 DC CL8'TYPLIN' 00512000 DC AL1(1),AL3(NULLM),C'B',AL3(L'NULLM) 00513000 NULLM DC C'(NULL FILE)' MESSAGE FOR EMPTY FILE 00514000 TYPLIN DS 0F 00515000 DC CL8'TYPLIN' 00516000 DC AL1(1),AL3(BUFFER),C'B',AL3(72) 00517000 * 00518000 FILE DS 0D 00519000 FILECOMM DC CL8'*' COMMAND 00520000 FILENAME DC CL8'*' FILENAME 00521000 FILETYPE DC CL8'*' FILETYPE 00522000 FILEMODE DC CL2'*' FILEMODE 00523000 FILEITNO DC H'0' ITEM NUMBER 00524000 FILEBUFF DC A(*) BUFFER AREA 00525000 FILESIZE DC A(800) BUFFER SIZE 00526000 FILEFV DC CL2'F' FIXED/VARIABLE FLAG 00527000 FILENOIT DC H'1' NUMBER OF ITEMS 00528000 FILENORD DC F'0' 00529000 IOAREA DS 800C 00530000 LTORG 00531000 * 00532000 FVS 00533000 ADT 00534000 REGEQU 00535000 NUCON 00536000 END 00537000