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