ibm:vm370-lib:cms:dmsrdc.assemble_src
Table of Contents
DMSRDC Source
References
- Fixes Applied : 2
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [R14498DS]
Source Listing
- DMSRDC.ASSEMBLE.txt
- 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
ibm/vm370-lib/cms/dmsrdc.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator