DSK TITLE 'DMSDSK (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * 00004000 * 00005000 * 00006000 * 00007000 * MODULE NAME: 00008000 * 00009000 * DMSDSK (DISK) 00010000 * 00011000 * FUNCTION: 00012000 * 00013000 * TO DUMP A DISK FILE TO CARDS, OR TO LOAD FILES FROM 00014000 * CARDS TO DISK. 00015000 * 00016000 * ATTRIBUTES: 00017000 * 00018000 * TRANSIENT (WITH SYSTEM OPTION); SERIALLY REUSABLE. 00019000 * 00020000 * ENTRY POINTS: 00021000 * 00022000 * DMSDSK - SEE FUNCTION DESCRIPTION 00023000 * 00024000 * ENTRY CONDITIONS: 00025000 * 00026000 * DISK: 00027000 * GPR1 - A(PLIST) 00028000 * PLIST - CL8'DISK ' 00029000 * CL8'LOAD ' OPERATION 00030000 * XL8'FF' 00031000 * 00032000 * OR CL8'DISK ' 00033000 * CL8'DUMP ' OPERATION 00034000 * CL8' ' FILENAME 00035000 * CL8' ' FILETYPE 00036000 * CL8' ' FILEMODE 00037000 * XL8'FF....FF' FENCE 00038000 * 00039000 * EXIT CONDITIONS: 00040000 * 00041000 * NORMAL - 00042000 * GPR15 = 0 : THE DISK DUMP OR LOAD COMPLETED NORMALLY 00043000 * 00044000 * ERROR - 00045000 * GPR15 = XX: ERROR CODE 00046000 * 28 FILE NOT FOUND 00047000 * 24 INVALID FUNCTION 00048000 * 24 NO FUNCTION SPECIFIED 00049000 * 24 INCOMPLETE FILEID 00050000 * 20 INVALID '*' IN FILEID 00051000 * 8 READER EMPTY OR NOT READY 00052000 * 24 INVALID PARAMETER 00053000 * 32 END CARD MISSING IN INPUT DECK 00054000 * 32 INVALID CARD IN INPUT DECK 00055000 * 36 SPECIFIED DISK IS READ/ONLY 00056000 * 36 DISK MODE NOT ACCESSED 00056500 * 100 ALL I/O ERRORS 00057000 * 00058000 * CALLS TO OTHER ROUTINES: 00059000 * 00060000 *| DMSCIO - READ/PUNCH CARDS 00061000 *| DMSCPF - CLOSE READER/PUNCH 00062000 *| DMSCWR - WRITE LINE TO TERMINAL WITH AUTO, CARRIAGE RET 00063000 *| DMSERS - ERASE A GIVEN FILE FROM USER DISK 00064000 *| DMSFNS - CLOSE A GIVEN FILE; SCRATCH ENTRY FROM ADT 00065000 *| DMSALG - HALT EXECUTION DURING RUNNING PROGRAM 00066000 *| DMSBRD - READ A DISK RECORD 00067000 *| DMSSTT - VERIFY EXISTENCE OF GIVEN FILE ; LOCATE COPY 00068000 *| OF FST ENTRY 00069000 *| DMSAUD - RESERVE SPACE ON DISK FOR NEW COPY OF UFD 00070000 *| DMSBWR - WRITE A DISK RECORD 00071000 * 00072000 * EXTERNAL REFERENCES: 00073000 * 00074000 * ADT - ACTIVE DISK TABLE 00075000 * FSTB - FILE STATUS TABLE BLOCK 00076000 * FVS - FIXED VARIABLE STORAGE: V-CONS FOR CMS ROUTINES 00077000 * 00078000 * TABLES/WORKAREAS: 00079000 * 00080000 * SEE EXTERNAL REFERENCES 00081000 * 00082000 * REGISTER USAGE: 00083000 * 00084000 * GPR1 - A(PLIST) FOR SVC CALLS 00085000 * GPR2 - MODULE ADDRESSABILITY 00086000 * GPR13 - A (FVS) 00087000 * GPR14 - RETURN 00088000 * GPR15 - ERROR CODE RETURN 00089000 * 00090000 * NOTES: 00090100 * DISK MUST BE GENMOD'D WITH THE SYSTEM OPTION, E.G.: 00090200 * LOAD DMSDSK (ORIGIN TRANS 00090300 * GENMOD DISK (SYSTEM 00090400 * 00090500 * OPERATION: 00091000 * 00092000 * THE OPERATION OF DISK DEPENDS ON WHETHER THE CALLING 00093000 * PROGRAM SPECIFIES DUMP OR LOAD. 00094000 * 00095000 * DUMP: DISK COPIES THE FILE DESIGNATION FROM THE 00096000 * PARAMETER LIST INTO BYTES 58 - 76 OF AN 89-BYTE 00097000 * BUFFER. (THE FIRST FOUR BYTES OF THE BUFFER CONTAIN 00098000 * AN IDENTIFIER CONSISTING OF AN INTERNAL 00099000 * REPRESENTATION OF A 12-2-9 PUNCH AND THE CHARACTERS 00100000 * 'CMS'.) THEN DISK TEMPORARILY CHANGES THE 00101000 * CHARACTERISTICS OF THE FILE IN THE 40-BYTE FST ENTRY 00102000 * TO MAKE IT APPEAR AS A FILE OF 800-BYTE FIXED-LENGTH 00103000 * RECORDS. (THE CORRECT FST ENTRY IS RESTORED WHEN THE 00104000 * FILE HAS BEEN DUMPED, OF COURSE.) DISK MOVES THE 00105000 * INITIAL VALUE FOR SEQUENCING 00106000 * (001) INTO BYTES 77-80 OF THE BUFFER. DISK NEXT 00107000 * CALLS THE DMSBRD FUNCTION 00108000 * PROGRAM TO READ THE FIRST 50 BYTES OF THE TEMPORARY 00109000 * COPY INTO 00110000 * BYTES 6-55 OF THE BUFFER AND THEN THE DMSCIO FUNCTION 00111000 * PROGRAM TO PUNCH 00112000 * THE CONTENTS OF THE BUFFER. HAVING PUNCHED THE FIRST 00113000 * CARD, DISK INCREMENTS THE SEQUENCE NUMBER (BYTES 00114000 * 77-80 OF THE OUTPUT BUFFER) AND OVERLAYS BYTES 6-55 00115000 * OF THE BUFFER WITH THE NEXT 50 BYTES OF THE FILE 00116000 * BY CALLING DMSBRD. IT THEN PUNCHES THE CONTENTS OF 00117000 * THE 00118000 * BUFFER. DISK REPEATS THIS PROCESS FOR EACH 00119000 * SUBSEQUENT 50 BYTES OF DATA IN THE TEMPORARY DISK 00120000 * FILE. WHEN THE END-OF-FILE IS ENCOUNTERED, DISK 00121000 * GENERATES AN END CARD (ONE WITH N IN COLUMN 5) AND 00122000 * PUNCHES IT, 00123000 *| CALLS THE CP CLOSE COMMAND TO CLOSE PUNCH 00124000 * OPERATIONS, RESTORES 00125000 * THE FST ENTRY TO ITS CORRECT VALUE, AND RETURNS TO 00126000 * THE CALLER. 00127000 * 00128000 * LOAD: DISK CALLS THE DMSERS COMMAND PROGRAM TO ERASE 00129000 * THE TEMPORARY FILE 00130000 *| 'DISK CMSUT1' CREATED DURING A PREVIOUS LOAD OPERATION. 00131000 * NEXT, IT CALLS THE 00132000 * DMSCIO FUNCTION PROGRAM TO READ THE FIRST CARD. (IF 00133000 * THIS CARD WAS 00134000 * PRODUCED BY THE DUMP PORTION OF DISK, IT WILL CONTAIN 00135000 * AN IDENTIFIER IN COLUMNS 1-4.) DISK THEN CHECKS THE 00136000 * IDENTIFIER IN THE CARD. IF INVALID, IT ISSUES A 00137000 * MESSAGE TO THE EFFECT THAT THERE IS AN ILLEGAL CARD 00138000 * IN THE DISK 00139000 *| LOAD DECK, CALLS THE CP CLOSE COMMAND TO CLOSE 00140000 * CARD READER OPERATIONS (WITH THE 'HOLD' OPTION) 00141000 *| AND RETURNS TO THE CALLING PROGRAM. 00142000 * IF THE IDENTIFIER IS VALID, DISK DETERMINES WHETHER 00143000 * THE CARD IS AN END CARD (THAT IS, ONE WITH N IN THE 00144000 * FIFTH BYTE). IF IT IS NOT, DISK MOVES THE FILE DATA 00145000 * PORTION OF THE CARD (50 BYTES IN COLUMNS 6-55) INTO 00146000 * THE NEXT AVAILABLE LOCATION IN AN 800-BYTE OUTPUT 00147000 * BUFFER. DISK THEN READS THE NEXT CARD, WHICH IT 00148000 * PROCESSES SIMILARLY. WHEN THE ENTIRE 800-BYTE OUTPUT 00149000 * BUFFER HAS BEEN FILLED WITH DATA FROM THE 00150000 * INPUT CARDS, DISK CALLS THE DMSBWR FUNCTION PROGRAM 00151000 * TO WRITE THE CONTENTS OF 00152000 * THE BUFFER INTO A FILE DESIGNATED AS DISK CMSUT1. 00153000 * DISK REPEATS THE PROCESS OF FILLING THE OUTPUT BUFFER 00154000 * AND WRITING ITS CONTENTS INTO THE DISK FILE UNTIL THE 00155000 * END CARD IS READ. 00156000 * 00157000 * WHEN THE END CARD IS READ, DISK CALLS THE DMSFNS 00158000 * COMMAND PROGRAM 00159000 * TO CLOSE THE TEMPORARY FILE CREATED FROM THE FILE IN 00160000 * THE CARD DECK. 00161000 * IT THEN CALLS THE DMSERS COMMAND PROGRAM TO ERASE THE 00162000 * FILE (IF ANY) THAT HAS THE SAME 00163000 * DESIGNATION AS THE CARD FILE JUST CONVERTED TO A DISK 00164000 * FILE. NEXT, DISK CALLS 00165000 *| THE DMSLFSP FUNCTION TO LOCATE THE FILE STATUS 00166000 * TABLE FOR THE 00167000 * DISK FILE. (THIS FILE IS AGAIN DISK CMSUT1. 00168000 * SUBSEQUENTLY, DISK MOVES THE DESIGNATION FOR THE CARD 00169000 * FILE FROM THE END CARD INTO THE CORRESPONDING 00170000 * LOCATIONS IN THE FILE STATUS TABLE. THIS COMPLETES 00171000 * THE CONVERSION OF THE FIRST CARD FILE IN THE CARD 00172000 * READER TO A DISK FILE, AND DISK 00173000 * CALLS THE DMSCWR FUNCTION PROGRAM TO TYPE A MESSAGE 00174000 * AT THE TERMINAL TO THE 00175000 * EFFECT THAT THE FILE HAS BEEN LOADED. DISK PROCESSES 00176000 * TEH NEXT FILE IN THE CARD READER IN A SIMILAR MANNER. 00177000 * 00178000 * WHEN AN END-OF-FILE ON THE CARD READER IS 00179000 * ENCOUNTERED, DISK CALLS 00180000 *| THE CP CLOSE COMMAND TO CLOSE CARD READER 00181000 * OPERATIONS AND RETURNS 00182000 * TO THE CALLING PROGRAM. 00183000 * 00184000 * NOTES: DMSAUD IS CALLED AT THE APPROPRIATE TIME WHEN 00185000 * DISK LOAD IS 00186000 * BEING EXECUTED, TO UPDATE THE DIRECTORY FOR THE FILE 00187000 * BEING LOADED. 00188000 * 00189000 * DISK IS A FEASIBLE WAY TO TRANSFER VARIABLE-LENGTH 00190000 * FILES, SUCH AS MODULE'S OR SCRIPT FILES, BETWEEN ONE 00191000 * USER AND ANOTHER. 00192000 * 00193000 * DISK DUMP CAN DUMP FILES FROM ANY DISK. DISK LOAD 00194000 * LOADS FILES ONTO THE A-DISK. THE MODE NUMBER OF THE 00195000 * FILE IS RETAINED. 00196000 * 00197000 *. 00198000 EJECT 00199000 EJECT 00200000 DMSDSK START X'E000' MUST BE TRANSIENT-DISK-RESIDENT 00201000 USING *,BASE 00202000 LR BASE,15 SET BASE 00203000 LR CMSRET,14 SAVE CMS RETURN ADDRESS 00204000 * NOTE: ALREADY HAS NUCLEUS PROTECT KEY 00205000 USING NUCON,R0 00206000 MVI DSKFLAG,0 CLEAR DEFAULT FILEID FLAG 00207000 L R13,AFVS 'FVS' INFO 00208000 USING FVSECT,R13 ... 00209000 LA R6,EXIT2 SET R6 'SWITCH' 00210000 LA R1,8(,R1) POINT TO FUNCTION 00211000 CLC 0(8,1),=CL8'DUMP' IS IT 'DUMP' MODE 00212000 BE DKDUMP YES, GO TO DUMP 00213000 CLC 0(8,1),=CL8'LOAD' IS IT 'LOAD' MODE 00214000 BE DKLOAD YES, GO TO LOAD 00215000 CLI 0(R1),X'FF' ANY FUNCTION SPECIFIED? 00216000 BE ERR47E NO, ERROR 00217000 B ERR14E YES, BUT IT'S A BAD ONE. 00218000 EJECT 00219000 ********************************************************************** 00220000 * 00221000 * 'DISK DUMP' 00222000 * 00223000 * NOTE: DUMPS FROM ANY SPECIFIED DISK 00224000 * 00225000 ********************************************************************** 00226000 * 00227000 DKDUMP EQU * 00228000 OI DSKFLAG,DUMP 00229000 LA R1,8(,R1) POINT TO FILEID 00230000 CLI 0(1),X'FF' FILENAME GIVEN? 00231000 BE ERR54E NO 00232000 LR R7,R1 SAVE FILEID PTR 00233000 CLI 0(R1),C'*' '*' IS ILLEGAL 00234000 BE ERR62E 00235000 LA R1,8(,R1) POINT TO FILETYPE 00236000 CLI 0(1),X'FF' FILETYPE? 00237000 BE ERR54E NO 00238000 CLI 0(R1),C'*' '*' IS BAD FOR FILETYPE TOO 00239000 BE ERR62E 00240000 MVC STLIST+8(16),0(R7) MOVE NAME AND TYPE 00241000 MVC STMODE(2),ADISK DEFAULT TO A-DISK 00242000 LA R1,8(,R1) POINT TO FILEMODE 00243000 CLI 0(1),X'FF' MODE? 00244000 BE DK1 NO 00245000 CLI 8(R1),X'FF' ANY GARBAGE AFTER MODE? 00246000 BNE ERR70E YES. 00247000 MVC STMODE(2),0(R1) USE MODE FROM USER 00248000 DK1 LA R1,STLIST CALL 00249000 L R15,ASTATE STATE @V305066 00250000 BALR R14,R15 ... @V305066 00250500 BNZ STERROR ERROR EXIT @V305066 00251000 MVC RMODE(1),FVSFSTM USE STATEFST MODE-LETTER FOR RDBUF 00252000 LA R6,EXIT1 SET R6 'SWITCH' TO RESTORE FST-ENTRY 00253000 L R1,STATER1 GET ADDRESS OF ACTUAL FST-ENTRY 00254000 MVC SAVFST40(40),0(R1) SAVE IT FOR LATER RESTORING 00255000 USING FSTSECT,R1 REFERENCE THE FST-ENTRY ... 00256000 MVC RNAME(16),FSTN FILL IN NAME & TYPE, 00257000 MVC FNAME(16),FSTN EVERYTHING ALSO 00258000 MVC FNAME+17(1),FSTM+1 GET MODE NUMBER FROM FST 00259000 MVC FNAME+16(1),RMODE GET LETTER FROM STATE FST 00260000 MVC FSTSAVE(20),20(R1) SAVE CRUCIAL 'OLD' FST INFO, 00261000 * 00262000 * FUDGE FST-ENTRY SO THAT FILE LOOKS LIKE 800-BYTE FIXED RECORDS 00263000 * (WE'LL RESTORE IT LATER, OF COURSE) 00264000 * 00265000 OI UFDBUSY,WRBIT PREVENT 'KX' WHILE FST-ENTRY IS FUDGED JS 00266000 LA R7,DK4 SET R7 FOR VARIABLE FILES 00267000 LH R0,FSTDBC NO. OF 800-BYTE ITEMS INTO R0 00268000 SR R14,R14 CLEAR 'REMAINDER' FLAG @VA04989 00268100 CLI FSTFV,C'V' IS IT VARIABLE ? 00269000 BE LDNBLKS YES, BYPASS THE FUDGING @VA06143 00270000 LH R15,FSTIC IF FIXED, GET NO. OF ITEMS, 00271000 N R15,F65535 NO NEGATIVE NUMBERS FROM 'LH' PLEASE 00272000 M R14,FSTIL R15 (SIC) TIMES ITEM-SIZE GIVES TOTAL BYTES 00273000 D R14,F800 DIVIDE BY 800 00274000 LR R0,R15 PUT NO. OF BLKS TO READ IN R0 @VA05914 00274100 LDNBLKS EQU * @VA06143 00274400 LR R9,R0 GET NO. 800-BYTE BLOCKS @VA07139 00274700 LTR R14,R14 COULD CONCEIVABLY COME OUT EVEN 00275000 BZ MVIF FORGET IT IF YES 00276000 LA R9,1(,R9) ADD SHORT BLOCK TO COUNT @VA06143 00277000 LA R15,49(,R14) REMAINDER PLUS 49 INTO R15, 00278000 SR R14,R14 AND DIVIDE BY 50 00279000 D R14,FIFTY TO GET NO. OF 50-BYTE CHUNKS LEFT OVER JS 00280000 LR R8,R15 PLACE THIS IN R8 FOR LATER 00281000 LA R7,DK3A SET R7 'SWITCH' FOR DK3A INSTEAD. 00282000 MVIF MVI FSTFV,C'F' SET F/V FLAG TO F, 00283000 MVC FSTIL,F800 FORCE ITEM LENGTH OF 800 BYTES, 00284000 STH R9,FSTIC SET ITEM COUNT=NO.PHYS BLOKS@VA04989 00285300 MVC SEQNO,=CL4'0001' INITIALIZE SEQUENCING INFORMATION 00286000 MVC PSEQNO,=PL2'1' ... 00287000 MVI DATAOUT-1,C' ' CLEAR 'N' FLAG 00288000 SR R9,R9 @VA04989 00288100 STH R9,RBLOKNO INIT DISK READ BLOK NUMBER @VA04989 00288150 LTR R0,R0 MAKE SURE 'QUOTIENT' NOT ZERO 00289000 BZ DK3A IF IT IS, READ JUST 'REMAINDER' 00290000 DK2 LA COUNT,16 16 50-BYTE CHUNKS PER 800-BYTE BUFFER JS 00291000 DK2A LA POINTR,BUFFER START AT BEGINNING OF BUFFER 00292000 DSKREAD EQU * @VA04989 00292100 LH R9,RBLOKNO GET CURRENT BLOK NUMBER @VA04989 00292150 LA R9,1(,R9) AND UPDATE IT... @VA04989 00292200 STH R9,RBLOKNO ... @VA04989 00292250 LA R1,READDSK READ AN 800-BYTE 00293000 L R15,ARDBUF READ AN 800-BYTE @V305066 00294000 BALR R14,R15 ... @V305066 00294100 BNZ EOFCHK ... @V305066 00294200 CLI AVAIL(R1),NOITEM WAS DATA BLOCK NULL? @VA04989 00294250 BE DSKREAD IF SO, FORGET THIS BLOCK @VA04989 00294300 STCM R9,3,BLOKNOUT STORE BLOK NUMBER IN CARD @VA04989 00294350 DK3 MVC DATAOUT(50),0(POINTR) MOVE 50 BYTES TO CARD BUFFER, 00296000 LA 1,PUNCH PUNCH CARD 00297000 SVC X'CA' ... 00298000 DC AL4(ERR118S) PUNCH ERROR 00299000 AP PSEQNO,=PL2'1' UPDATE SEQ. NO. 00300000 UNPK SEQNO(4),PSEQNO(2) ... 00301000 OI SEQNO+3,X'F0' ... 00302000 LA POINTR,50(,POINTR) ADVANCE TO NEXT 50-BYTE CHUNK, 00303000 BCT COUNT,DK3 ITERATE THRU 800-BYTE BLOCK 00304000 BCT R0,DK2 ITERATE LARGER LOOP PER NO. OF ITEMS. JS 00305000 BR R7 WE'RE ALL DONE IF NO. ITEMS EXHAUSTED. JS 00306000 DK3A LA R7,DK4 IF ANY LEFT, FORCE QUITTING THE NEXT TIME 00307000 LA R0,1 ONE 800-BYTE RECORD TO GO 00308000 LR COUNT,R8 REMAINDER INTO 'COUNT' INSTEAD OF 16, JS 00309000 B DK2A AND GO 'FINISH UP'... 00310000 DROP R1 00311000 * 00312000 EOFCHK C 15,=F'12' TEST FOR EOF 00313000 BNE ERR104S NOT EOF, MUST BE ERROR 00314000 DK4 MVC DATAOUT(50),FSTSAVE NOW OUTPUT THE FST INFO 00315000 MVI DATAOUT-1,C'N' INDICATE END CARD 00316000 LA 1,PUNCH PUNCH CARD 00317000 SVC X'CA' ... 00318000 DC AL4(ERR118S) ... 00319000 B ERRETN RETURN 00320000 SPACE 3 00321000 * ERROR FROM 'STATE' CALL... 00322000 * 00323000 STERROR CH R15,=H'28' 00324000 BE ERR2E FILE NOT FOUND 00325000 CH R15,RET36 DISK MODE ACCESSED? @VA06214 00325300 BER CMSRET NO, RETURN TO CMS @VA06214 00325600 LR R0,R15 00326000 B RESTERR SYNTAX OR DISK ERROR 00327000 ERR2E EQU * 00328000 DMSERR NUM=2,LET=E,SUB=(CHAR8A,STNAME),TEXT='FILE ''..........*00329000 ..........'' NOT FOUND' 00330000 LA R0,28 RETURN CODE = 28 00331000 B RESTERR 00332000 EJECT 00333000 ********************************************************************** 00334000 * 00335000 * 'DISK LOAD' 00336000 * 00337000 * DATE/TIME IS THAT OF NEW LOADED FILE 00338000 * (NOT THE OLD ONE ON CARDS) 00339000 * 00340000 ********************************************************************** 00341000 * 00342000 DKLOAD EQU * 00343000 TM BATFLAGS,BATRUN BATCH MONITOR RUNNING? V0742 00343100 BZ NOTBAT @VM03203 00343200 OI BATFLAG2,BATDCMS TELL BATCH WHO'S CALLING @VM03203 00343300 LA R5,8 @VA10475 00343400 SR R1,R5 POINT AT COMMAND @VA10475 00343500 LR R14,CMSRET SO BATCH RETURNS TO CMS @VM03203 00343600 L R15,ABATABND ENTER BATCH AT 'ABEND' POINT@VM03203 00343700 BR R15 AND DON'T COME BACK.... @VM03203 00343800 NOTBAT EQU * @VM03203 00343900 MVC WRTMODE(2),ADISK INITIAL. TO A-DISK FOR WRITES 00344000 CLI 8(R1),X'FF' END OF LINE? 00345000 BNE ERR70E IF NOT, ERROR 00346000 ERAST LA R1,WRTDSK ERASE OLD TEMP FILE 00347000 L R15,AERASE ERASE @V305066 00348000 BALR R14,R15 ... @V305066 00349000 CH R15,RET36 IS DISK R/O OR NOT ACCESSED? @VA06214 00349300 BNE NOTHREAD NEITHER, CONTINUE @VA06214 00349600 L R9,IADT GET ADDRESS OF ADT @VA06214 00349900 USING ADTSECT,R9 @VA06214 00350200 CLC ADTID,BLANKS IS THERE AN 'A' DISK? @VA06214 00350500 DROP R9 @VA06214 00350800 BER CMSRET NO,DISK NOT ACCESSED,RTN TO CMS @VA06214 00351100 B ERR37E YES, PRINT R/O MESSAGE @VA06214 00351400 NOTHREAD MVI EOFFLG,X'F0' SIGNAL NOTHING READ YET @VA06214 00351700 * 00353000 * LOOP TO READ FROM CARDS AND WRITE ON DISK ONE OR MORE FILES... 00354000 DKLOP3 LA COUNT,16 16 CARDS/800 BYTE BUFFER 00355000 LA POINTR,BUFFER INITIALIZE 800 BYTE BUFFER 00356000 XC BUFFER(200),BUFFER CLEAR 800-BYTE BUFFER BEFORE FILLING 00357000 MVC BUFFER+200(200),BUFFER ... 00358000 MVC BUFFER+400(200),BUFFER ... 00359000 MVC BUFFER+600(200),BUFFER ... 00360000 DKLOP2 LA 1,READ READ A CARD 00361000 SVC X'CA' ... 00362000 DC AL4(CRDEOF) TEST FOR EOF 00363000 MVI EOFFLG,X'00' EOF ERROR IF ENCOUNTERED NOW 00364000 CLC CARDIN(4),CARDOUT TEST FOR 12-2-9 CMS IN COL.1-4 00365000 BNE ERR78E ILLEGAL CARD 00366000 CLI BLOKNIN,BLANK 'OLD' DISK DUMP FORMAT? @VA04989 00366100 * SINCE X'40'= D'16384', IT CANNOT BE VALID BLOK NUMBER @VA04989 00366150 BE *+10 IF SO, SKIP NSI... @VA04989 00366200 MVC WBLOKNO(2),BLOKNIN GET BLOK NUM FROM INPUT CARD@VA04989 00366250 CLI CARDIN+4,C'N' TEST FOR END CARD 00367000 BE DKLEND END CARD READ 00368000 MVC 0(50,POINTR),DATAIN STORE IN 800 BYTE BUFFER 00369000 LA POINTR,50(0,POINTR) INCREMENT BUFFER POINTER 00370000 BCT COUNT,DKLOP2 FILL THE ENTIRE 800 BYTE BUFFER 00371000 LA R1,WRTDSK WRITE CARDS ON A-DISK 00372000 L R15,AWRBUF ... @V305066 00373000 BALR R14,R15 ... @V305066 00374000 BNZ WRTERR ... @V305066 00375000 B DKLOP3 RE-INITIALIZE BUFFER 00376000 * 00377000 * 00378000 DKLEND LA R1,WRTDSK FINISH WORK FILE 00379000 C POINTR,ABUFFER ARE WE AT VERY BEGINNING OF BLOCK ? 00380000 BE DKLFIN BE IF YES, NO PARTIAL OUTPUT THERE. 00381000 L R15,AWRBUF IF NOT, CALL 'WRBUF' TO OUTPUT 00382000 BALR R14,R15 PARTIALLY-FILLED BLOCK 00383000 BNZ WRTERR (HOPEFULLY NO ERROR) 00384000 DKLFIN L R15,AFINIS NOW CLOSE WORK FILE VIA FINIS 00385000 BALR R14,R15 ... 00386000 BNZ WRTERR BAD NEWS IF ERROR WRITING 00387000 MVC FNAME(18),FNAMIN YES, USE IT'S OWN FILEID... 00388000 ERASIT MVC ERASE+8(16),FNAME ERASE OLD FILE IF IT EXISTS 00389000 LA 1,ERASE ... 00390000 L R15,AERASE ERASE @V305066 00391000 BALR R14,R15 ... @V305066 00391500 OI UFDBUSY,UPBIT PREVENT 'KX' UNTIL 'UPDISK' IS FINISHED.. 00393000 L R15,VCFSTLKP CALL FSTLKP TO FIND WHERE @VM03093 00394100 LA R1,WRTDSK FINISHED WORK-FILE IS 00395000 BALR 14,15 ... 00396000 LH R15,28(R1) SAVE 1ST CHAIN-LINK ADDRESS TEMPORARILY, 00397000 MVC 20(18,R1),DATAIN RESET BOTTOM OF FST EXCEPT FOR YEAR, 00398000 MVC 0(16,R1),FNAME RESET FST NAME AND TYPE 00399000 CLI FNAME+17,C'Y' WAS FST MODE 'SY' ? 00400000 BE RSCHN BE IF YES (LEAVE MODE A1) 00401000 MVC 24(2,R1),FNAME+16 RESET MODE 00402000 RSCHN STH R15,28(R1) RESTORE 1ST CHAIN-LINK-ADDRESS IN FST JS 00403000 MVC FILOAD(8),FNAME PLACE NAME, 00404000 MVC FILOAD1(8),FNAME+8 TYPE, AND 00405000 MVC FILOAD2(2),FNAME+16 MODE FOR TYPING 00406000 L R15,AUPDISK UPDATE DIRECTORY (R0 INTACT FROM FSTLKP) 00407000 BALR R14,R15 ... (R1 OK ALSO) 00408000 LR R9,R0 V(ADT) INTO R9 (FOR LATER) 00409000 USING FSTSECT,R1 (BRIEFLY) 00410000 LM R0,R1,FSTT REAL FILETYPE INTO R0-R1, 00411000 DROP R1 00412000 L R15,ATYPSRCH CHECK REAL FILETYPE 00413000 BALR R14,R15 VIA "TYPSRCH" 00414000 USING ADTSECT,R9 (BRIEFLY) 00415000 O R15,ADTFTYP-3 "OR" IN THE POSSIBLE BIT 00416000 ST R15,ADTFTYP-3 FOR THE REAL FILETYPE. 00417000 DROP R9 00418000 LA R1,TYPE TYPE 'FILENAME FILETYPE FILEMODE' 00419000 SVC X'CA' MESSAGE 00420000 MVI EOFFLG,X'FF' EOF DEFINITELY OK IF ENCOUNTERED NOW 00421000 B DKLOP3 00422000 * 00423000 * 00424000 CRDEOF BCT 15,RDRERR IF GPR15 = 1, EOF, OTHERWISE READER ERROR 00425000 TM EOFFLG,X'FF' IS THIS A LEGAL PLACE FOR EOD ? 00426000 BZ ERR77E ERROR IF FLAG = '00' 00427000 BO ERRETN AND RETURN 00428000 REMPTY DMSERR NUM=205,LET=W,TEXT='READER EMPTY OR NOT READY' 00429000 LA R0,8 RETURN CODE = 8 00430000 B RESTERR AND FINISH UP. 00431000 EJECT 00432000 ********************************************************************** 00433000 * 00434000 * ERROR ROUTINES 00435000 * 00436000 ********************************************************************** 00437000 DS 0F 00438000 ERR14E LR R0,R1 USE R0 FOR FUNCTION PTR 00439000 DMSERR NUM=14,LET=E,SUB=(CHARA,(R0)),TEXT='INVALID FUNCTION ''*00440000 ........''' 00441000 LA R0,24 SET ERROR CODE = 24 00442000 B RESTERR RETURN 00443000 SPACE 2 00444000 WRTERR CH R15,=H'12' WAS IT READ/ONLY DISK ? 00445000 BNE ERR105S NOPE, SOME OTHER BEAUTY... 00446000 SPACE 2 00447000 ERR37E DMSERR NUM=37,LET=E,SUB=(CHARA,WRTMODE),TEXT='DISK ''..'' IS R*00448000 EAD/ONLY' 00449000 LA R15,36 RETURN CODE = 36 00450000 B ERRETNA 00451000 SPACE 2 00452000 ERR47E EQU * 00453000 DMSERR NUM=47,LET=E,TEXT='NO FUNCTION SPECIFIED' 00454000 LA R0,24 SET ERROR CODE = 24 00455000 B RESTERR RETURN 00456000 SPACE 2 00457000 ERR54E EQU * 00458000 DMSERR NUM=54,LET=E,TEXT='INCOMPLETE FILEID SPECIFIED' 00459000 LA R0,24 SET ERROR CODE = 24 00460000 B RESTERR RETURN 00461000 RDRERR BCT R15,ERR124S FATAL IF R15 NOT= 2 00462000 CLI EOFFLG,X'F0' IF R15 WAS 2, IS FLAG STILL X'F0' ? 00463000 BE REMPTY DEFINITELY READER EMPTY IF YES 00464000 XR R15,R15 WE DID READ A FILE, SO '2' MEANS 00465000 B ERRETN THE RDR IS NOW EMPTY AGAIN... 00466000 ERR124S DMSERR NUM=124,LET=S,TEXT='ERROR READING CARD FILE' 00467000 LA 15,100 SET ERROR CODE = 100 00468000 B ERRETNA 00469000 SPACE 00470000 ERR62E EQU * 00471000 DMSERR NUM=62,LET=E,TEXT='INVALID ''*'' IN FILEID' 00472100 LA R0,20 RETURN CODE = 20 00473000 B RESTERR 00474000 SPACE 2 00475000 ERR70E LA R0,8(,R1) 00476000 DMSERR NUM=70,LET=E,SUB=(CHARA,(R0)),TEXT='INVALID PARAMETER '*00477000 '........''' 00478000 LA R0,24 SET ERROR CODE = 24 00479000 B RESTERR RETURN 00480000 ERR77E EQU * 00481000 DMSERR NUM=77,LET=E,TEXT='END CARD MISSING FROM INPUT DECK' 00482000 LA 15,32 SET ERROR CODE = 32 00483000 B ERRETN 00484000 ERR78E DMSERR NUM=78,LET=E,TEXT='INVALID CARD IN INPUT DECK' 00485000 LA R15,32 RETURN CODE = 32 00486000 B ERRETNA 00487000 ERR104S EQU * V0314 00487100 LR R7,R15 SAVE RETURN CODE FOR MSG V0314 00487200 SPACE 2 00488000 DMSERR NUM=104,LET=S,SUB=(DEC,(R7),CHAR8A,RNAME),TEXT='ERROR '+00489000 '..'' READING FILE ''....................'' FROM DISK',R+00489100 ENT=NO V0314 00489200 LA R15,100 RETURN CODE = 100 00491000 B ERRETN 00492000 SPACE 2 00493000 ERR105S LR R7,R15 USE R7 FOR WRITE ERROR 00494000 DMSERR NUM=105,LET=S,SUB=(DEC,(R7),CHAR8A,WRTID),TEXT='ERROR '*00495000 '..'' WRITING FILE ''....................'' ON DISK', *00496000 RENT=NO 00497000 LA R15,100 RETURN CODE = 100 00498000 B ERRETNA 00499000 SPACE 2 00500000 ERR118S DMSERR NUM=118,LET=S,TEXT='ERROR PUNCHING FILE' 00501000 LA R15,100 RETURN CODE = 100 00502000 B ERRETN 00503000 SPACE 2 00504000 EJECT 00505000 * FINISH UP & RETURN TO CALLER (R15 NOW HOLDS ERROR-CODE) 00506000 ERRETNA OI DSKFLAG,RDRHOLD KEEP THE RDR FILE 00507000 SPACE 00508000 ERRETN LR R0,R15 SAVE ERROR-CODE, 00509000 TM DSKFLAG,DUMP WERE WE DISK DUMPING? @VA05212 00510000 BZR R6 NO; BRANCH TO EXIT1 OR EXIT2 @VA05212 00510500 LA R1,STLIST YES; USE STATE'S PLIST FOR FINIS @VA05212 00511000 L R15,AFINIS AND CLOSE THE DUMPED FILE @VA05212 00511500 BALR R14,R15 @VA05212 00512000 BR R6 CONTINUE OR BRANCH TO 'EXIT2' ... 00513000 EXIT1 LA R1,STLIST FIND WHERE FILE WE DUMPED IS 00514000 L R15,ASTATE STATE @V305066 00515000 BALR R14,R15 ... @V305066 00515500 BNZ EXIT2 ERROR EXIT @V305066 00516000 L R1,STATER1 R1 TELLS WHERE IT IS, 00517000 MVC 0(40,R1),SAVFST40 RESTORE FST-ENTRY WE FUDGED UP 00518000 EXIT2 TM DSKFLAG,DUMP HAVE WE DISK DUMPED? 00519000 BO CLOSPUN YES, CLOSE THE PUNCH... 00520000 TM DSKFLAG,RDRHOLD HOLD THE RDR FILE? 00521000 BNZ HOLD YES. 00522000 MVC CLDEV(8),RDRDEV NO, CLOSE THE RDR NORMALLY 00523000 MVC CLDEV+8(8),FENCE 00524000 B CLOSRDR 00525000 HOLD MVC CLDEV(16),RDRDEV 'HOLD' THE ACTIVE RDR FILE 00526000 MVC CLDEVF(EIGHT),FENCE PUT THE FENCE UP @VA05931 00526500 CLOSRDR EQU * 00527000 LA 1,CLOSE CLOSE READER 00528000 SVC X'CA' ... 00529000 B RESTERR GO TO RESTORE ERR CODE 00530000 CLOSPUN MVC CLDEV(8),PUNDEV SUB PUNCH DEVICE NAME 00531000 MVC CLDEVN,NAME SPECIFY 'NAME' @VA05931 00531700 MVC CLDEVF,FNAME SET FN FT @VA05931 00532300 LA R1,CLOSE CLOSE THE PUNCH 00533000 SVC X'CA' ... 00534000 RESTERR LR R14,CMSRET RESTORE RETURN-REG 00535000 KXCHK WRBIT 00536000 LTR R15,R0 RESTORE ERROR-CODE & CHECK IT 00538000 BCR 8,R14 EXIT FORTHWITH IF RETURN-CODE = 0. 00539000 LA R1,WRTDSK ERASE WORK FILE IF WE HAD AN ERROR, 00540000 SVC X'CA' (MAY STILL BE THERE) 00541000 DC AL4(*+4) ... 00542000 LTR R15,R0 NOW RESTORE ERROR-CODE 00543000 BR R14 AND EXIT TO CALLER. 00544000 EJECT 00545000 ********************************************************************** 00546000 * 00547000 * CMS PARAMETER LISTS 00548000 * 00549000 ********************************************************************** 00550000 * 00551000 DS 0D 00552000 READDSK DC CL8'RDBUF' 00553000 RNAME DC CL8'FILENAME' (FILLED IN) 00554000 DC CL8'FILETYPE' (FILLED IN) 00555000 RMODE DC CL2' ' MODE-LETTER (LEAVE NUMBER BLANK) 00556000 RBLOKNO DC H'0' PHYSICAL BLOK NUMBER @VA04989 00557100 ABUFFER DC A(BUFFER) 00558000 DC F'800' 800 BYTES AT A CLIP 00559000 DC CL2'F' 00560000 DC H'1' 00561000 DC F'0' 00562000 AVAIL EQU 37 BYTE AFTER F/V FOR DATA AVAI@VA04989 00562100 NOITEM EQU X'00' MEANS DATA BLOCK NULL (HOLE)@VA04989 00562150 * 00563000 DS 0D 00564000 WRTDSK DC CL8'ERASE' WORK FILE TO ERASE, WRBUF, & FINIS... JS 00565000 WRTID DC CL8'DISK' 00566000 DC CL8'CMSUT1' 00567000 WRTMODE DC CL2'A1' 00568000 WBLOKNO DC H'0' PHYSICAL BLOK NUMBER @VA04989 00569100 DC A(BUFFER) 00570000 DC F'800' 00571000 DC CL2'F' 00572000 DC H'1' 00573000 DC F'0' 00574000 * 00575000 DS 0D 00576000 ERASE DC CL8'ERASE' TO ERASE OLD FILE (IF ANY) 00577000 DC CL16' ' (NAME & TYPE FILLED IN) 00578000 DC CL2'A ' A-DISK 00579000 * 00580000 DS 0D 00581000 PUNCH DC CL8'CARDPH' 00582000 DC A(CARDOUT) 00583000 DS 0D 00584000 READ DC CL8'CARDRD' 00585000 DC A(CARDIN) 00586000 DC F'0' 00587000 * 00588000 DS 0D 00589000 TYPE DC CL8'TYPLIN' 00590000 DC AL1(1) 00591000 DC AL3(FILOAD) 00592000 DC C'B' 00593000 DC AL3(FILOAD4) 00594000 * 00595000 CLOSE DC CL8'CP' 00596000 DC CL8'CLOSE' 00597000 CLDEV DC CL8'RDR' 00598000 CLDEVN DC CL8' ' 'NAME' IF CLOSING PUNCH @VA05931 00598700 CLDEVF DC CL16' ' FN FT IF CLOSING PUNCH @VA05931 00599300 FENCE DC 8X'FF' 00600000 PUNDEV DC CL8'PUN' 00601000 RDRDEV DC CL8'RDR' 00602000 DC CL8'HOLD' 00603000 NAME DC CL8'NAME' @VA05931 00603300 EIGHT EQU 8 @VA05931 00603600 * 00604000 DS 0F 00605000 STLIST DC CL8'STATE' 00606000 STNAME DC CL16' ' 00607000 STMODE DS CL2' ' MODE (FILLED IN) 00608000 BLNK2 DC CL2' ' (PURPOSELY BLANK) 00609000 DC F'0' BECOMES A(STATEFST) 00610000 EJECT 00611000 ********************************************************************** 00612000 * 00613000 * 'CMS' DISK DUMP CARD FORMAT 00614000 * 00615000 ********************************************************************** 00616000 DS 0D 00617000 CARDOUT DC X'02' 00618000 DC C'CMS ' 00619000 DATAOUT DS CL50 DATA 00620000 BLOKNOUT DC CL2' ' PHYSICAL BLOK NUMBER @VA04989 00621100 FNAME DC CL19' ' FILE NAME, TYPE, MODE 00622000 SEQNO DC C'0001' SEQ. NUMBER 00623000 DS 0D 00624000 CARDIN DS CL5 "12-2-9 CMS" 00625000 DATAIN DS CL50 DATA 00626000 BLOKNIN DS CL2 PHYSICAL BLOK NUMBER @VA04989 00627100 FNAMIN DS CL19 FILE NAME,TYPE,MODE 00628000 SEQIN DS CL4 00629000 EJECT 00630000 ********************************************************************** 00631000 * 00632000 * STORAGE AND DEFINITIONS 00633000 * 00634000 ********************************************************************** 00635000 * 00636000 * DEFINITIONS 00637000 * 00638000 REGEQU 00639000 BASE EQU R2 00640000 CMSRET EQU R3 00641000 COUNT EQU R4 00642000 POINTR EQU R5 00643000 BLANK EQU X'40' @VA04989 00643100 RET36 DC H'36' @VA06214 00643300 BLANKS DC CL6' ' @VA06214 00643600 * 00644000 * STORAGE 00645000 * 00646000 DS 0F 00647000 FIFTY DC F'50' 00648000 SAVFST40 DS 10F 40-BYTE ENTRY SAVED HERE FOR RESTORING JS 00649000 FSTSAVE DC CL50' ' (SAME LENGTH AS 'DATAOUT) 00650000 PSEQNO DS CL2 00651000 EOFFLG DS CL1 00652000 DSKFLAG DC X'00' 00653000 DEFALL EQU X'80' DISK 'LOAD' FIRST PHYSICAL RDR FILE 00654000 RDRHOLD EQU X'40' HOLD RDR FILE IN CASE OF ERROR 00655000 DUMP EQU X'08' DISK 'DUMP' CALLED 00656000 ADISK DC CL2'A1' 00657000 * 00658000 FILOAD DC CL9' ' NAME 00659000 FILOAD1 DC CL9' ' TYPE 00660000 FILOAD2 DC CL3' ' MODE 00661000 * 'LOADED' OMITTED TO SAVE TYPING TIME 00662000 FILOAD4 EQU *-FILOAD (LENGTH FOR TYPLIN) 00663000 * 00664000 * EXTERNS 00665000 * 00666000 * 00667000 LTORG 00668000 * 00669000 BUFFER DS 0D BEGINNING OF 800-BYTE DISK-BUFFER... 00670000 * 00671000 EJECT @VA05212 00671500 NUCON 00672000 EJECT 00673000 FVS 00674000 AFT 00675000 ADT 00676000 EJECT 00677000 FSTB 00678000 END 00679000