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