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
* <CL8'FM'> 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