MVE TITLE 'DMSMVE (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 * 00003000 * 00004000 * 00005000 * 00006000 * 00007000 * 00008000 * 00009000 * MODULE NAME: 00010000 * 00011000 * DMSMVE (MOVEFILE COMMAND) 00012000 * 00013000 * FUNCTION: 00014000 * 00015000 * TO TRANSFER DATA BETWEEN TWO SPECIFIED DDNAMES. THE 00016000 * DDNAMES MAY SPECIFY ANY DEVICES OR DISK FILES 00017000 * SUPPORTED BY THE CMS SYTEM. 00018000 * 00019000 * ATTRIBUTES: 00020000 * 00021000 * REENTRANT, DISK RESIDENT 00022000 * 00023000 * ENTRY POINTS: 00024000 * 00025000 * DMSMVE 00026000 * 00027000 * EXIT CONDITIONS: 00028000 * 00029000 * RC = 0 NORMAL RETURN - MOVE COMPLETED 00030000 * 00031000 * ERROR RETURNS AND MESSAGES: 00032000 * 00033000 * 024 002E INPUT FILE NOT FOUND 00034000 * 024 003E INVALID OPTION 'OPTION' 00035000 * 024 070E INVALID PARAMETER 'PARAM' 00036000 * 028 073E UNABLE TO OPEN FILE 00037000 * 036 037E OUTPUT DISK IS READ/ONLY 00038000 * 036 069E OUTPUT DISK IS NOT ACCESSED 00039000 * 040 075E DEVICE ILLEGAL FOR MOVE INPUT OR OUTPUT 00040000 * 040 041E INPUT AND OUTPUT FILES ARE THE SAME 00041000 * 088 130S BLOCKSIZE < 9 FOR V FORMAT FILE 00042000 * 100 127S UNSUPPORTED DEVICE 00043000 * 100 128S INPUT I/O ERROR 00044000 * 100 129S OUTPUT I/O ERROR 00045000 * 225I PDS MEMBER 'MEMBER' MOVED 00046000 * 226I END OF PDS MOVE 00047000 * 088 232E INVALID RECFM -- SPANNED RECORDS NOT SUPPORT@VA13188 00047500 * 00048000 * EXTERNAL REFERENCES: 00049000 * 00050000 * OSFST 00051000 * 00052000 * CALLS TO OTHER ROUTINES 00053000 * 00054000 * OS MACROS EXECUTED: 00055000 * 00056000 * FIND SVC 18 POINT TO NEXT MEMBER 00057000 * OPEN INPUT SVC 19 OPEN INPUT DDNAME 00058000 * OPEN OUTPUT SVC 19 OPEN OUTPUT DDNAME 00059000 * GET BALR READ DATA FROM INPUT DCB 00060000 * PUT BALR WRITE DATA TO OUTPUT DCB 00061000 * CLOSE LEAVE SVC 20 CLOSE DCB'S (NO REWIND ON TAPE) 00062000 * GETMAIN SVC 10 ALLOCATE STORAGE AREA 00063000 * FREEMAIN SVC 10 FREE STORAGE AREA 00064000 * SYNADEF SVC 68 GET SYNAD ERROR MESSAGE TEXT 00065000 * SYNADRLS SVC 68 RELEASE SYNADEF MESSAGE BUFFER 00066000 * 00067000 * CMS FUNCTIONS USED: 00068000 * 00069000 * OS SIMULATION (SVC 10, 19, 20, 68, GET AND PUT) 00070000 * 00071000 * STATE SVC 202 TO DETERMINE WHETHER INPUT FILE 00072000 * EXISTS 00073000 * 00074000 * STATEW SVC 202 TO DETERMINE WHETHER OUTPUT FILE 00075000 * EXISTS 00076000 * 00077000 * DMSERR SVC 203 TO TYPE OUT ERROR MESSAGES 00078000 * 00079000 * STRINIT SVC 203 TO INITIALIZE STORAGE FOR 00080000 * GETMAIN 00081000 * 00082000 * ADTLKP BALR TO DETERMINE WHETHER OUTPUT DISK 00083000 * IS READ/WRITE 00084000 * 00085000 * TABLES / WORKAREAS: 00086000 * 00087000 * A WORK AREA OF 50 DOUBLEWORDS IS ALLOCATED, USING 00088000 * GETMAIN, TO HOLD THE DCB'S AND OTHER STORAGE. 00089000 * 00090000 * THE OS SIMULATION ROUTINES ALLOCATE I/O BUFFERS AS 00091000 * NEEDED. 00092000 * 00093000 * REGISTER USAGE: 00094000 * 00095000 * R0 - R1, R13 - R15 LINKAGE REGISTERS 00096000 * 00097000 * R2 - R9 WORK REGISTERS 00098000 * 00099000 * OPERATION: 00100000 * 00101000 * THE INPUT DDNAME IS OPENED WITH PARAMETERS SPECIFIED SO THAT 00102000 * A STANDARD OS DCB EXIT ROUTINE IS TAKEN. (THAT IS, THE OS 00103000 * SIMULATION ROUTINES FILL IN THE DCB WITH WHATEVER INFORMATION 00104000 * IS AVAILABLE FROM THE FILEDEF, AND THEN PASS CONTROL TO 00105000 * AN EXIT ROUTINE IN THE 'MOVE' CODE, TO GIVE IT AN OPPORTUNITY 00106000 * TO MAKE ANY ADDITIONS OR CHNGES BEFORE THE OPEN IS COMPLETE.) 00107000 * THE EXIT ROUTNE FILLS IN THE RECFM, LRECL AND BLKSIZE FIELDS, 00108000 * IF THEY WERE NOT ALREADY FILLED IN BY THE FILEDEF. 00109000 * THE LOGIC DEPENDS UPON THE INPUT DEVICE TYPE. IF A DISK 00110000 * FILE, IT IS CHECKED FOR EXISTENCE, AND THE RECFM AND LRECL 00111000 * FIELDS OF THE DCB ARE FILLED IN FROM THE FST. FOR OTHER 00112000 * DEVICES, SUITABLE DFAULTS ARE USED IF NOT SPECIFIED IN THE 00113000 * FILEDEF FOR THE DDNAME. 00114000 * 00115000 * THE OUTPUT DDNAME IS OPENED, AND SIMILAR ACTION IS TAKEN IN 00116000 * THE EXIT ROUTINE. 00117000 * 00118000 * THE DATA IS TRANSFERRED IN A GET-PUT LOOP, WITH TRUNCATION 00119000 * OR PADDING DONE AS NECESSARY. 00120000 * 00121000 * IF THE PDS OPTION IS SPECIFIED AND THE INPUT IS FROM 00122000 * DISK, THE FCBMVPDS BIT IS SET AND AN OS FIND MACRO IS 00123000 * ISSUED BEFORE AN OUTPUT DCB IS OPENED TO POSITION 00124000 * THE INPUT FILE AT THE NEXT MEMBER. THE INPUT MEMBER NAME 00125000 * IS THEN STORED IN THE OUPUT CMSCB FOR USE AS THE OUTPUT 00126000 * FILENAME. AFTER END OF FILE IS REACHED ON A MEMBER, THE 00127000 * MESSAGE DMSMVE225I IS TYPED AND THE 00128000 * OUTPUT DCB IS CLOSED AND CONTROL IS PASSED TO DO A FIND 00129000 * ON THE NEXT MEMBER. WHEN ALL THE MEMBERS HAVE BEEN 00130000 * MOVED TO SEPERATE CMS FILES, MOVEFILE TYPES OUT 00131000 * MESSAGE DMSMVE226I, CLOSES THE INPUT AND OUTPUT DCBS 00132000 * AND RETURNS CONTROL TO THE CALLER. 00133000 * 00134000 * AFTER EOF IS REACHED ON THE INPUT DCB, THE DCB'S ARE CLOSED 00135000 * WITH THE 'LEAVE' OPTION (IN CASE THEY ARE TAPES, TO 00136000 * PREVENT REWINDING). 00137000 * 00138000 *. 00139000 EJECT 00140000 * DMSMVE ROUTINE WRITTEN SEPTEMBER, 1971, BY JOHN XENAKIS TO IMPLEMENT 00141000 * THE CMS 'MOVE' COMMAND. 00142000 * MACRO DEFINITIONS 00143000 SPACE 3 00144000 MACRO 00145000 &NM XENTER &DCB,&FLAG 00146000 * FOR AN EXPLANATION OF WHAT THIS MACRO DOES, SEE THE COMMENTS 00147000 * PRECEDING THE SYMBOL 'SAVETR' IN THE 'MOVESECT' WORK AREA DEFINITION. 00148000 DROP TR 00149000 USING &DCB.DCB,R1 00150000 &NM STM R14,R12,EXSAVE SAVE REGISTERS 00151000 L TR,SAVETR RESTORE TEMP AREA POINTER 00152000 L BR,SAVEBR RESTORE BASE REGISTER 00153000 MVI PBYTE,&FLAG INDICATE EXIT ROUTINE 00154000 USING MOVESECT,TR RESTORE USING'S 00155000 USING IHADCB,R1 00156000 * POINT TO FCB FOR FILE 00157000 L FCBR,DCBDEBAD POINT TO DEB 00158000 SH FCBR,=AL2(IHADEB-FCBINIT) DISPLACE BACK TO FCB 00159000 MEND 00160000 SPACE 3 00161000 MACRO 00162000 &NM DEFAULT &RECFM,&BLOCK 00163000 &NM MVC DEFAREA,=AL2(256*REC&RECFM,&BLOCK) SET DEFAULTS 00164000 MEND 00165000 SPACE 3 00166000 MACRO 00167000 FCBTAB &IO 00168000 &IO.TAB B &IO.DUM 00 DUMMY DEVICE 00169000 B &IO.PTR 04 PRINTER 00170000 B &IO.RDR 08 CARD READER 00171000 B &IO.CON 0C CONSOLE 00172000 B &IO.TAP 10 TAPE 00173000 B &IO.DSK 14 DISK 00174000 B &IO.PCH 18 CARD PUNCH 00175000 B &IO.CRT 1C CRT 00176000 &IO.TABL EQU *-&IO.TAB TABLE LENGTH 00177000 MEND 00178000 EJECT 00179000 MACRO 00180000 DEFINE &LIST 00181000 LCLA &I 00182000 &I SETA 0 00183000 .LOOP ANOP 00184000 &I SETA &I+1 00185000 AIF (&I GT N'&SYSLIST).MEND 00186000 IN&SYSLIST(&I) EQU DCB&SYSLIST(&I)-IHADCB+INDCB 00187000 OUT&SYSLIST(&I) EQU DCB&SYSLIST(&I)-IHADCB+OUTDCB 00188000 AGO .LOOP 00189000 .MEND MEND 00190000 * REGEQU MACRO GIVES STANDARD CMS REGISTER EQUATES. 00191000 REGEQU 00192000 SPACE 5 00193000 XR EQU R3 SCRATCH REGISTER 00194000 PR EQU XR PLIST POINTER 00195000 FCBR EQU R4 POINTER TO CURRENT FCB 00196000 TR EQU R5 TEMP AREA POINTER 00197000 INP EQU R6 INPUT BUFFER POINTER 00198000 INL EQU R7 INPUT BUFFER LENGTH 00199000 OUTP EQU R8 OUTPUT BUFFER POINTER 00200000 OUTL EQU R9 OUTPUT BUFFER LENGTH 00201000 RR EQU R10 INTERNAL RETURN REGISTER 00202000 BR EQU R12 00203000 SPACE 5 00204000 USING IHADCB,R1 POINTER TO DCB IN EXIT ROUTINES 00205000 USING FCBSECT,FCBR POINTER TO FCB 00206000 USING DMSMVE,BR BASE REGISTER 00207000 USING MOVESECT,TR TEMP AREA POINTER 00208000 MOVESECT DSECT 00209000 SPACE 3 00210000 * INPUT DATA CONTROL BLOCK 00211000 INDCB DCB DDNAME=INMOVE,EODAD=ENDREAD,SYNAD=INSYNAD, P0503*00212000 MACRF=GL,DSORG=PS 00213000 EJECT 00214000 * OUTPUT DATA CONTROL BLOCK 00215000 OUTDCB DCB DDNAME=OUTMOVE,SYNAD=OUTSYNAD, P0503*00216000 MACRF=PL,DSORG=PS 00217000 EJECT 00218000 * EQUATES FOR DCB'S 00219000 SPACE 00220000 DCBLEN EQU *-INDCB LENGTH OF BOTH DCB'S COMBINED 00221000 SPACE 00222000 * THE FOLLOWING ARE THE FLAG VALUES CONTAINED IN THE DCBRECFM FIELD 00223000 * OF THE DCB'S. 00224000 RECF EQU X'80' FIXED RECORD FORMAT 00225000 RECV EQU X'40' VARYING RECORD FORMAT 00226000 RECU EQU X'C0' UNDEFINED RECORD FORMAT 00227000 RECUV EQU X'40' U OR V RECORD FORMAT 00228000 RECUF EQU X'80' U OR F RECORD FORMAT 00229000 SPNND EQU X'48' VARIABLE SPANNED FORMAT @VA13188 00229500 SPACE 2 00230000 * POINTERS TO FCB'S FOR INPUT AND OUTPUT FCB'S 00231000 INFCB DS A POINTER TO INPUT FCB P0503 00232000 OUTFCB DS A POINTER TO OUTPUT FCB P0503 00233000 SPACE 5 00234000 * OPEN/CLOSE PARAMETER LIST 00235000 OPLIST OPEN (*-*,INPUT,*-*,OUTPUT),MF=L P0503 00236000 LISTLEN EQU *-OPLIST 00237000 SPACE 5 00238000 DS 0D 00239000 PLIST DS CL64 PLIST FOR STATE, ADTLKP,ETCP0503 00240000 SPACE 00241000 RC DC X'00' RETURN CODE FROM DMSMVE 00242000 SPACE 00243000 CONFLAG DC X'00' NON-ZERO MEANS CONSOLE INPUT 00244000 SPACE 1 00245000 DEFLRECL DC H'0' DEFAULT LRECL @V201122 00246000 SPACE 1 00247000 PDSOPT DC X'00' PDS OPTION FLAG - INDICATES PDS O@V201122 00248000 SPACE 1 00249000 DOSF DS X SAVE OF NUCON'S DOSFLAGS @V305001 00250000 SPACE 1 00251000 SAVEFN DS 8X FILE NAME SAVE AREA FOR PDS MOVES@V201122 00252000 SPACE 1 00253000 MVEMEMBR DS 2F AREA FOR CURRENT MEMBER NAME @V201122 00254000 DS H NECESSARY FOR ITEM NUMBER @VA03059 00255000 EJECT 00256000 * THE FOLLOWING IS A WORK AREA USED BY THE EXIT ROUTINES 00257000 DEFAREA DS 0F DEFAULT ATTRIBUTE AREA 00258000 DEFRECFM DS X DEFAULT RECORD FORMAT 00259000 DS X 00260000 DEFBLKSI DS H DEFAULT BLOCKSIZE 00261000 SPACE 2 00262000 * THE FOLLOWING BYTE CONTAINS A CODE INDICATING WHERE WE ARE IN THE 00263000 * DMSMVE ROUTINE. THE LOGIC OF THE ROUTINE REQUIRES ONLY THAT IT 00264000 * KNOW WHETHER IT IS IN AN EXIT ROUTINE OR NOT, BUT WE KEEP DIFFERENT 00265000 * INDICATORS FOR THE DIFFERENT EXIT ROUTINES FOR DEBUGGING PURPOSES. 00266000 SPACE 00267000 PBYTE DS X 00268000 SPACE 00269000 MAIN EQU 0 NOT IN ANY EXIT ROUTINE 00270000 INEX EQU 4 INDCB DCB EXIT ROUTINE 00271000 OUTEX EQU 8 OUTDCB DCB EXIT ROUTINE 00272000 INSYEX EQU 12 INDCB SYNAD EXIT ROUTINE 00273000 OUTSYEX EQU 16 OUTDCB SYNAD EXIT ROUTINE 00274000 SPACE 5 00275000 * THE FOLLOWING FIELDS ARE USED BY EXIT ROUTINES. WHEN ENTERING AN 00276000 * EXIT ROUTINE, REGISTER 1 WILL POINT TO THE DCB FOR THE EXIT ROUTINE. 00277000 * THEREFORE, BY USING REGISTER 1, WE CAN MAKE THE FOLLOWING FIELDS 00278000 * ADDRESSABLE IN AN EXIT ROUTINE. 00279000 * WE USE 'SAVETR' TO RE-ESTABLISH ADDRESSABILITY TO THE MOVESECT 00280000 * WORK AREA. 00281000 * WE USE 'SAVEBR' TO RE-ESTABLISH THE BASE REGISTER FOR THE DMSMVE 00282000 * ROUTINE. 00283000 * WE USE 'EXSAVE' TO SAVE OUR REGISTERS UPON ENTRY TO THE EXIT ROUTINE. 00284000 SPACE 00285000 SAVETR DS A POINTER TO MOVESECT WORK AREA 00286000 SAVEBR DS A POINTER TO DMSMVE (SAVE BASE REG 00287000 EXSAVE DS 15F REGISTER SAVE AREA 00288000 SPACE 5 00289000 * THE FOLLOWING FIELD IS INCREMENTED EACH TIME A RECORD IS READ FROM 00290000 * THE INPUT DCB. 00291000 RECNUM DS F RECORD NUMBER 00292000 SPACE 2 00293000 * THE FOLLOWING IS THE REGISTER 13 SAVE AREA TO BE USED BY THE PUT 00294000 * AND GET ROUTINES. 00295000 SAVE13 DS F SAVE REG 13 AT ENTRY TO DMSMVE 00296000 GPSAVE DS 18F GET/PUT SAVE AREA 00297000 SPACE 2 00298000 MOVELEN EQU (*-MOVESECT+7)/8 LENGTH OF WORK AREA IN *00299000 DOUBLE WORDS 00300000 DMSMVE CSECT 00301000 SAVE (14,12),,* SAVE REGISTERS 00302000 LR BR,R15 SET BASE REGISTER 00303000 LR PR,R1 POINTER TO PLIST 00304000 SPACE 00305000 * THE FOLLOWING CALL TO STRINIT (STORAGE INITIALIZATION) IS NECESSARY 00306000 * IF 'GETMAIN' IS TO BE CALLED. IT INITIALIZES THE GETMAIN POINTERS 00307000 * SO THAT SUBSEQUENT GETMAINS WILL NOT ATTEMPT TO ALLOCATE THE SPACE 00308000 * OCCUPIED BY THIS ROUTINE. 00309000 SPACE 00310000 STRINIT P0503 00311000 USING NUCON,R0 @V305001 00312000 DMSKEY NUCLEUS @V305001 00313000 IC R2,DOSFLAGS GET NUCON'S DOSFLAGS @V305001 00314000 NI DOSFLAGS,255-DOSSVC TURN OFF DOS SVC HANDLE @V305001 00315000 DMSKEY RESET @V305001 00316000 SPACE 00317000 * WE NOW ALLOCATE OUR WORK AREA FOR THE MOVESECT AREA DEFINED ABOVE. 00318000 GETMAIN R,LV=8*MOVELEN UNCONDITIONAL GETMAIN 00319000 LR TR,R1 POINT TO WORK AREA 00320000 STC R2,DOSF SAVE DOSFLAGS FOR NOW @V305001 00321000 MVI PBYTE,MAIN WE ARE NOT IN AN EXIT ROUTINE 00322000 MVI RC,0 RC FROM DMSMVE IS 0 SO FAR 00323000 MVI CONFLAG,0 NOT CONSOLE INPUT 00324000 MVC INDCB(DCBLEN),DCBS MOVE DUMMY DCB'S INTO WORK AREA 00325000 MVC OPLIST(LISTLEN),LISTS COPY DUMMY OPEN/CLOSE LIST 00326000 ST TR,SAVETR 00327000 ST BR,SAVEBR 00328000 ST R13,SAVE13 SAVE OLD REG 13 00329000 LA R13,GPSAVE POINT TO NEW SAVE AREA 00330000 XC INFCB(8),INFCB CLEAR OUT INPUT FCB ADDR@V201122 00331000 XC DEFLRECL(3),DEFLRECL ZERO PDSOPT AND LRECL @V201122 00332000 LA R15,8 SETUP INCREMENT @V201122 00333000 AR PR,R15 UP PTR @V201122 00334000 CLI 0(PR),X'FF' INPUT DDNAME SPECIFIED @V201122 00335000 BE DDSET NO, 'INMOVE' DEFAULT @V201122 00336000 CLI 0(PR),C'(' OPTION SPECIFIED @V201122 00337000 BE CKOPT YES, CHECK OPTIONS @V201122 00338000 MVC INDDNAM(8),0(PR) SET INPUT DDNAME @V201122 00339000 AR PR,R15 UP PTR @V201122 00340000 CLI 0(PR),X'FF' OUTPUT DDNAME SPECIFIED @V201122 00341000 BE DDSET NO, 'OUTMOVE' DEFAULT @V201122 00342000 CLI 0(PR),C'(' OPTION SPECIFIED @V201122 00343000 BE CKOPT YES, CHECK OPTION @V201122 00344000 MVC OUTDDNAM(8),0(PR) SET OUTPUT DDNAME @V201122 00345000 AR PR,R15 UP PTR @V201122 00346000 CLI 0(PR),X'FF' END OF INPUT LINE @V201122 00347000 BE DDSET YES, CONTINUE @V201122 00348000 CLI 0(PR),C'(' OPTION SPECIFIED? @V201122 00349000 BNE PARMERR NO, THEN INVALID PARM @V201122 00350000 CKOPT AR PR,R15 UP PTR @V201122 00351000 CLC 0(3,PR),=CL3'PDS' PDS OPTION SPECIFIED @V201122 00352000 BNE OPTERR NO, THEN OPTION ERROR @V201122 00353000 AR PR,R15 UP PTR @V201122 00354000 CLI 0(PR),C')' DELIMITER SPECIFIED @V201122 00355000 BE SETPDSSW YES, SET PDS MOVE SW @V201122 00356000 CLI 0(PR),X'FF' DELIMITER? @V201122 00357000 BNE OPTERR NO, THEN INVALID OPTION @V201122 00358000 SETPDSSW OI PDSOPT,FCBMVPDS SET PDS SWITCH @V201122 00359000 DDSET EQU * P0503 00360000 LA PR,INDDNAM CHK FOR INDD EQUAL '*' @VM08900 00361000 CLI INDDNAM,C'*' ASTERISK INVALID DDNAME @VM08900 00362000 BE INVALID ABORT WITH RC=24 @VM08900 00363000 LA PR,OUTDDNAM CHK FOR OUTDD EQUAL '*' @VM08900 00364000 CLI OUTDDNAM,C'*' ASTERISK INVALID DDNAME @VM08900 00365000 BE INVALID ABORT WITH RC=24 @VM08900 00366000 CLC INDDNAM,OUTDDNAM ARE DDNAMES THE SAME? P0503 00367000 BE SAMEERR ERROR IS THEY ARE P0503 00368000 * PROCESS INPUT DDNAME 00369000 IN EQU * P0503 00370000 MVC PLIST(FILEDEFL),FILEDEFP COPY OVER 'FILEDEF' PLIST P0503 00371000 MVC PLIST+8(8),INDDNAM INSERT INPUT DDNAME P0503 00372000 LA R1,PLIST POINT TO PLIST P0503 00373000 SVC 202 CALL FILEDEF P0503 00374000 DC AL4(BADFDEF) TO BADFDEF ON FILEDEF ERRORP0503 00375000 LA R1,INDCB POINT TO INPUT DCB P0503 00376000 LPR FCBR,R0 POINT TO FCB FOR INPUT DD P0503 00377000 LTR R0,R0 DID THE FCB ALREADY EXIST? P0503 00378000 BP *+8 SKIP IF IT DID P0503 00379000 BAL RR,NOFCB TYPE INFORMATION MESSAGE P0503 00380000 ST FCBR,INFCB SAVE POINTER TO INPUT FCB P0503 00381000 SPACE 00382000 * THE FIELD FCBDEV IN THE FCB CONTAINS A CODE INDICATING THE TYPE OF 00383000 * DEVICE WHICH WAS GIVEN IN THE FILEDEF. 00384000 SR R15,R15 00385000 IC R15,FCBDEV GET DEVICE CODE 00386000 CH R15,=AL2(INTABL) GREATER THAN TABLE LENGTH? 00387000 BNL UNSUP YES -- UNSUPPORTED DEVICE 00388000 B *+4(R15) GO HANDLE SPECIFIC DEVICE 00389000 SPACE 00390000 FCBTAB IN 00391000 EJECT 00392000 * HANDLE SPECIFIC DEVICES FOR INPUT. 00393000 SPACE 00394000 * DUMMY DEVICE USED AS INPUT. ERROR. 00395000 INDUM EQU * 00396000 LA XR,=CL8'DUMMY' SYMBOL FOR ERROR MESSAGE 00397000 B ILLIN ILLEGAL INPUT DEVICE 00398000 SPACE 00399000 * PRINTER DEVICE USED AS INPUT 00400000 INPTR EQU * 00401000 LA XR,=CL8'PRINTER' SYMBOL FOR ERROR MESSAGE 00402000 B ILLIN ILLEGAL INPUT DEVICE 00403000 SPACE 00404000 * CARD READER USED AS INPUT. 00405000 * FOR THIS DEVICE, THE DEFAULT RECORD FORMAT IS FIXED, AND THE 00406000 * DEFAULT BLOCK SIZE IS 80. 00407000 INRDR EQU * 00408000 DEFAULT F,80 SET DEFAULTS 00409000 B INSET GO SET DEFAULTS P0503 00410000 SPACE 00411000 * CONSOLE DEVICE INPUT. 00412000 * FOR THIS DEVICE, THE DEFAULT RECORD FORMAT IS UNDEFINED, AND THE 00413000 * DEFAULT BLOCKSIZE IS 130. 00414000 * FOR THIS INPUT DEVICE, WE TYPE OUT AN INFORMATIONAL MESSAGE, 00415000 * CONSOLE INPUT -- TYPE NULL LINE FOR END OF DATA. 00416000 INCON EQU * 00417000 MVI CONFLAG,X'FF' SET CONSOLE INPUT FLAG 00418000 USING NUCON,0 V0742 00419000 DMSEXS OI,BATFLAGS,BATMOVE FOR BATCH 'MOVES' V0742 00420000 DEFAULT U,130 SET DEFAULTS 00421000 B CONIN GO TYPE MESSAGE 00422000 * NOTE THAT CONIN WILL TYPE OUT ERROR MESSAGE AND BRANCH TO DEFSET. 00423000 SPACE 00424000 * TAPE SPECIFIED AS INPUT DEVICE. 00425000 * UNLESS THE GUY TOLD US IN THE FILEDEF, WE HAVE NO IDEA WHAT TO 00426000 * EXPECT ON THE TAPE. FOR THAT REASON, WE USE 'UNDEFINED' AS 00427000 * THE RECORD FORMAT, AND A VERY LARGE VALUE, 3600, AS THE BLOCK 00428000 * SIZE. (WE WOULD REALLY LIKE TO USE 65K AS THE BLOCKSIZE, JUST 00429000 * TO BE SURE, BUT THAT WOULD MEAN ALLOCATING A 65K BUFFER, AND 00430000 * THAT'S REALLY TOO MUCH.) 00431000 * IF THE TAPE TURNS OUT TO HAVE FIXED RECORDS, IT SHOULDN'T MATTER 00432000 * TO THIS ROUTINE, AS LONG AS THE OS SIMULATION ROUTINES TELL 00433000 * ME WHAT THE LENGTH OF EACH RECORD IS. 00434000 INTAP EQU * 00435000 DEFAULT U,3600 SET DEFAULTS 00436000 B INSET GO SET DEFAULTS P0503 00437000 SPACE 00438000 * DISK FILE INPUT DEVICE. 00439000 * IN THIS CASE, THERE CAN'T BE ANY DEFAULTS, SINCE THE INPUT FILE 00440000 * MUST ALREADY EXIST. WE FILL 00441000 * IN THE DCB FROM THE FST (FILE STATUS BLOCK) FOR THE FILE. 00442000 INDSK EQU * 00443000 MVC PLIST(8),=CL8'STATE' FORM A 'STATE' PLIST 00444000 MVC PLIST+8(18),FCBDSNAM COPY FNAME, FTYPE, AND FMODE 00445000 LA R1,PLIST POINT TO PLIST 00446000 SVC X'CA' EXECUTE THE 'STATE' 00447000 DC AL4(*+4) ERROR RETURN ADDRESS 00448000 LA R1,INDCB RESTORE R1 00449000 LTR R15,R15 DID THE FILE EXIST? 00450000 BZ INDSK1 GO SET DCB FIELDS IF SO 00451000 LA XR,FCBDSNAM POINT TO FNAME, FTYPE FMODE 00452000 B NOINPUT TYPE OUT ERROR MESSAGE 00453000 SPACE 00454000 * WE SET THE FIELDS IN THE DCB DEPENDING ON THE VALUES IN THE FST 00455000 * (FILE STATUS BLOCK) FOR THE FILE. 00456000 INDSK1 EQU * 00457000 L XR,PLIST+28 XR -> FST FOR FILE 00458000 USING FSTSECT,XR 00459000 MVI DEFRECFM,RECF SET FIXED DEFAULT RECFM 00460000 CLI FSTFV,C'F' BUT IS FILE REALLY FIXED? 00461000 BE *+8 DON'T OVERRIDE IF SO 00462000 MVI DEFRECFM,RECU SET U FORMAT IF VARYING 00463000 MVC DEFBLKSI,FSTIL+2 COPY BLOCKSIZE FROM FST 00464000 NI FCBIOSW2,255-FCBMMV TRN BIT OFF @VA03059 00465000 NI FCBIOSW2,255-FCBMVPDS TURN OFF PDS OPTION SWIT@V201122 00466000 OI FCBIOSW2,FCBMVFIL THIS IS A MOVEFILE @VA05054 00467000 TM PDSOPT,FCBMVPDS IS PDS OPTION SPECIFIED @V201122 00468000 BNO GETOSFST NO, GET OS FST ADDR @V201122 00469000 OI FCBIOSW2,FCBMVPDS SET MOVE PDS SWITCH @V201122 00470000 XC MVEMEMBR(10),MVEMEMBR CLEAR FIELD @VA03059 00471000 GETOSFST L XR,FCBOSFST GET OS FST ADDRESS @V201122 00472000 LTR XR,XR IS IT FILLED IN @V201122 00473000 BZ INSET NO, USE CMS FST @V201122 00474000 USING OSFST,XR OSFST BASE @V201122 00475000 MVC DEFRECFM(1),OSFSTRFM FILL IN RECFM FROM DSCB@V201122 00476000 MVC DEFBLKSI(2),OSFSTBLK FILL DSCB BLOCKSIZE @V201122 00477000 MVC DEFLRECL(2),OSFSTLRL+2 FILL IN LRECL FROM DSCB@V201122 00478000 B INSET GO SET DEFAULTS P0503 00479000 DROP XR 00480000 SPACE 2 00481000 * INPUT DEVICE IS CARD PUNCH. ERROR. 00482000 INPCH EQU * 00483000 LA XR,=CL8'PUNCH' POINT TO SYMBOL FOR ERROR MESS 00484000 B ILLIN ILLEGAL INPUT DEVICE 00485000 SPACE 00486000 * INPUT DEVICE IS CRT. I DIDN'T EVEN KNOW THAT CMS SUPPORTED CRT'S. 00487000 INCRT EQU * 00488000 LA XR,=CL8'CRT' POINT TO SYMBOL FOR ERROR MESS 00489000 B ILLIN ILLEGAL INPUT DEVICE 00490000 SPACE 3 00491000 INSET EQU * P0503 00492000 BAL RR,DEFSET SET DEFAULTS IN DCB P0503 00493000 OUT EQU * P0503 00494000 MVC PLIST(FILEDEFL),FILEDEFP COPY OVER 'FILEDEF' PLIST P0503 00495000 MVC PLIST+8(8),OUTDDNAM INSERT OUTPUT DDNAME P0503 00496000 LA R1,PLIST POINT TO FILEDEF PLIST P0503 00497000 SVC 202 CALL FILEDEF P0503 00498000 DC AL4(BADFDEF) TO BADFDEF ON FILEDEF ERRORP0503 00499000 LA R1,OUTDCB POINT TO OUTPUT DCB P0503 00500000 LPR FCBR,R0 POINT TO FCB FOR FILE P0503 00501000 LTR R0,R0 DID THE FCB ALREADY EXIST? P0503 00502000 BP *+8 SKIP IF IT DID P0503 00503000 BAL RR,NOFCB TYPE INFORMATION MESSAGE P0503 00504000 MVC SAVEFN(8),FCBDSNAM SAVE OUTPUT FILE NAME @V201122 00505000 ST FCBR,OUTFCB SAVE POINTER TO OUTPUT FCB P0503 00506000 SR R15,R15 00507000 IC R15,FCBDEV GET DEVICE CODE FROM FCB 00508000 CH R15,=AL2(OUTTABL) LONGER THAN DEVICE TABLE? 00509000 BNL UNSUP YES -- UNSUPPORTED DEVICE 00510000 B *+4(R15) 00511000 FCBTAB OUT 00512000 EJECT 00513000 * HANDLE VARIOUS OUTPUT DEVICES. 00514000 SPACE 00515000 * THE FOLLOWING CODE PERFORMS THE CHORE OF SETTING DEFAULTS FOR 00516000 * THE OUTPUT DCB FIELDS FOR RECORD FORMAT, BLOCKSIZE AND 00517000 * LOGICAL RECORD LENGTH. IT SIMPLY COPIES THESE FIELDS FROM 00518000 * THE INPUT DCB, WHICH HAS ALREADY BEEN OPENED. 00519000 OUTCOPY EQU * 00520000 MVC DEFRECFM,INRECFM COPY DEFAULT RECFM 00521000 MVC DEFBLKSI,INBLKSI COPY DEFAULT BLOCKSIZE 00522000 B OUTSET GO SET DEFAULTS P0503 00523000 SPACE 2 00524000 * DUMMY OUTPUT DEVICE. AS DEFAULTS, COPY FIELDS FROM INPUT DCB. 00525000 OUTDUM EQU OUTCOPY 00526000 SPACE 00527000 * OUTPUT DEVICE IS PRINTER. THE DEFAULT RECORD FORMAT IS UNDEFINED, 00528000 * AND THE DEFAULT BLOCKSIZE IS 133. 00529000 OUTPTR EQU * 00530000 DEFAULT U,132 SET DEFAULTS P3002 00531000 B OUTSET GO SET DEFAULTS P0503 00532000 SPACE 00533000 * OUTPUT DEVICE IS CARD READER. ERROR. 00534000 OUTRDR EQU * 00535000 LA XR,=CL8'READER' SYMBOL FOR ERROR MESSAGE 00536000 B ILLOUT ILLEGAL OUTPUT DEVICE 00537000 SPACE 00538000 * OUTPUT DEVICE IS CONSOLE. 00539000 * THE DEFAULT RECORD FORMAT IS UNDEFINED, AND THE DEFAULT BLOCKSIZE 00540000 * IS 130. 00541000 OUTCON EQU * 00542000 DEFAULT U,130 00543000 B OUTSET GO SET DEFAULTS P0503 00544000 SPACE 00545000 * OUTPUT DEVICE IS TAPE. 00546000 OUTTAP EQU * 00547000 L R1,INFCB POINT TO INPUT FCB P0503 00548000 CLI FCBDEV-FCBSECT(R1),FCBTAP INPUT DDNAME FOR TAPE? 00549000 BNE OUTCOPY OK IF NOT 00550000 CLC FCBTAPID(8),FCBTAPID-FCBSECT(R1) SAME AS OUTPUT TAPEID? 00551000 BE SAMEERR ERROR IF SO 00552000 B OUTCOPY OTHERWISE, GO COPY DEFAULTS 00553000 SPACE 00554000 * THE OUTPUT DEVICE IS DISK. 00555000 * BUT BEFORE WE FILL IN THE FIELDS, WE DO A QUICK CHECK TO SEE 00556000 * WHETHER THE GUY IS ALLOWED TO WRITE ON THE DISK THAT HE'S 00557000 * SPECIFIED. 00558000 OUTDSK EQU * 00559000 L R1,INFCB POINT TO INPUT FCB P0503 00560000 CLI FCBDEV-FCBSECT(R1),FCBDSK WAS INPUT DD FOR A DISK FILE? 00561000 BNE OUTDSK0 NOTHING TO CHECK IF NOT 00562000 CLC FCBDSNAM(18),FCBDSNAM-FCBSECT(R1) SAME DSNAME AS OUTPUT? 00563000 BE SAMEERR ERROR IF SO 00564000 SPACE 00565000 OUTDSK0 EQU * 00566000 GETADT FCBOP CALL ADTLKP 00567000 USING ADTSECT,R1 ACTIVE DISK TABLE PTR IN R1 00568000 LA XR,=CL8'DOS DISK' INSERT FOR MESSAGE @VA14621 00568100 TM ADTFLG2,ADTFDOS DOS DISK ? @VA14621 00568200 BO ILLOUT YES, ERROR 075E @VA14621 00568300 LA XR,=CL8'OS DISK' INSET FOR MESSAGE @VA14621 00568400 TM ADTFLG2,ADTFROS OS DISK ? @VA14621 00568500 BO ILLOUT YES, ERROR 075E @VA14621 00568600 TM ADTFLG1,ADTFRO+ADTFRW IS DISK ACCESSED? @VA05240 00569000 BZ ACERR NO -- ERROR @VA05240 00570000 TM ADTFLG1,ADTFRW IS IT READ/WRITE DISK? 00571000 LA R1,OUTDCB RESTORE R1 00572000 USING IHADCB,R1 00573000 BNO ROERR NO -- ERROR -- IT'S READONLY 00574000 LTR R15,R15 WAS THERE AN ERROR IN ADTLKP? 00575000 BNZ ROERR GO IF YES 00576000 B OUTCOPY GO COPY 00577000 SPACE 2 00578000 * OUTPUT DEVICE IS CARD PUNCH. THE DEFAULT RECORD FORMAT IS FIXED, 00579000 * AND THE DEFAULT BLOCKSIZE IS 80. 00580000 OUTPCH EQU * 00581000 DEFAULT F,80 SET DEFAULTS 00582000 B OUTSET GO SET DEFAULTS P0503 00583000 SPACE 00584000 * THE OUTPUT DEVICE IS CRT. 00585000 OUTCRT EQU * 00586000 LA XR,=CL8'CRT' SYMBOL FOR ERROR MESSAGE 00587000 B ILLOUT ILLEGAL OUTPUT DEVICE 00588000 OUTSET EQU * P0503 00589000 LA R1,OUTDCB RESTORE DCB POINTER P0503 00590000 BAL RR,DEFSET GO SET DEFAULTS P0503 00591000 B OPEN GO OPEN THE DCB'S P0503 00592000 * THIS ROUTINE CHECKS TO SEE IF THE USER SPECIFIED RECFM, BLKSI, 00593000 * AND LRECL IN HIS FILEDEF. IF HE DIDN'T, THEN THIS ROUTINE FILLS 00594000 * IN THE DEFAULT VALUES. (THE DEFAULT LRECL IS BLKSI.) 00595000 * THIS CODE ALSO CHECKS FOR AN ERRONEOUS BLOCKSIZE WITH V-TYPE FILES -- 00596000 * THE BLOCKSIZE MUST BE AT LEAST 8 TO ALLOW SPACE FOR THE BLOCK 00597000 * DESCRIPTOR WORK AND THE RECORD DESCRIPTOR WORD. 00598000 DEFSET EQU * 00599000 * COPY FIELDS FROM FCB TO DCB 00600000 MVC DCBRECFM,FCBRECFM COPY RECORD FORMAT P0503 00601000 MVC DCBBLKSI,FCBBLKSZ COPY BLOCKSIZE P0503 00602000 MVC DCBLRECL,FCBLRECL COPY LOGICAL REC LENGTH P0503 00603000 CLI DCBRECFM,0 WAS RECFM SPECIFIED? 00604000 BNE *+10 SKIP IF IT WAS 00605000 MVC DCBRECFM,DEFRECFM COPY DEFAULT RECORD FORMAT 00606000 CLC DCBBLKSI,=H'0' WAS BLOCKSIZE SPECIFIED? 00607000 BNE *+10 SKIP IF IT WAS 00608000 MVC DCBBLKSI,DEFBLKSI COPY DEFAULT VALUE IF NOT 00609000 CLC DCBLRECL,=H'0' WAS LRECL SPECIFIED? 00610000 BNE *+10 SKIP IF IT WAS 00611000 MVC DCBLRECL,DEFLRECL SET DEFAULT LRECL @V201122 00612000 TM DCBRECFM,RECUF RECFM= VARIABLE @V201122 00613000 BCR 1,RR NO, RETURN TO CALLER @V201122 00614000 SPACE 1 00615000 * COME HERE FOR RECFM=V SPECIFIED IN FILEDEF 00616000 DEFSETV EQU * P0503 00617000 SR R0,R0 P0503 00618000 ICM R0,B'0011',DCBBLKSI GET DCB BLOCKSIZE P0503 00619000 CH R0,H8 IS IT SMALLER THAN 9 ? @VA07210 00620000 BNH ERVB YES...,ERROR @VA07210 00621000 SH R0,=H'4' COMPUTE DEFAULT LRECL P0503 00622000 * NOTE, FOR FOLLOWING INSTRUCTION, THAT FIRST TWO BYTES OF 00623000 * REG 0 ARE ZERO. 00624000 CLM R0,B'1100',DCBLRECL WAS LRECL SPECIFIED? P0503 00625000 BCR 7,RR (BNE 0(RR)) RETURN IF IT WAS P0503 00626000 STH R0,DCBLRECL STORE DEFAULT LRECL IF NOT P0503 00627000 BR RR RETURN TO CALLER P0503 00628000 * OPEN THE INPUT AND OUTPUT DCB'S 00629000 OPEN EQU * P0503 00630000 OPEN (INDCB,INPUT),MF=(E,OPLIST+4) OPEN INPUT DCB @V201122 00631000 LA R1,INDCB POINT TO INPUT DCB P0503 00632000 TM DCBOFLGS,X'10' WAS OPEN SUCCESSFUL? P0503 00633000 BZ NOOPEN ERROR IF NOT P0503 00634000 FNDMEMBR L FCBR,INFCB GET FCB ADDRESS @V201122 00635000 TM FCBIOSW2,FCBMVPDS IS PDS MOVE OPTION ON @V201122 00636000 BNO OPENOUT NO, OPEN OUTPUT DCB @V201122 00637000 OI FCBIOSW2,FCBMMV ST SWITCH FOR FIND @VM03203 00638000 FIND INDCB,MVEMEMBR,D GET NEXT MEMBER NAME @V201122 00639000 SR R0,R0 R0= 0 FOR POSSIBLE SYNAD@V201122 00640000 LA R1,INDCB R1= A(DCB) POSSIBLE SYNA@V201122 00641000 LA R14,CLOSE R14= RETURN POSSIBLE SYN@V201122 00642000 CH R15,=H'4' NOT FOUND ERROR @V201122 00643000 BE ENDMVPDS YES, TYPE END PDS MOVE M@V201122 00644000 LTR R15,R15 FIND SUCCESSFUL ? @V201122 00645000 BNZ INSYNAD NO, PRINT ERROR MSG @V201122 00646000 MVC MVEMEMBR+8(2),FCBITEM GET ITEM NUMBER @VA03059 00647000 LM R14,R15,MVEMEMBR GET NEW MEMBER NAME @V201122 00648000 L FCBR,OUTFCB GET ADDRESS OF OUTPUT FC@V201122 00649000 STM R14,R15,FCBDSNAM USE MEMBER NAME AS FILEN@V201122 00650000 LA R15,8 SET LOOP LIMIT @V201122 00651000 C0LOOP LA R14,FCBDSNAM-1 GET MEMBER NAME ADDRESS @V201122 00652000 AR R14,R15 GET ADDR OF BYTE FOR CHE@V201122 00653000 CLI 0(R14),X'C0' IS THIS A X'C0' BYTE @V201122 00654000 BNE CKNXT NO, CHECK NEXT BYTE @V201122 00655000 MVI 0(R14),C' ' YES, REPLACE IT WITH BLA@V201122 00656000 CKNXT BCT R15,C0LOOP CHECK NEXT BYTE FOR X'C0@V201122 00657000 OPENOUT OPEN (OUTDCB,OUTPUT),MF=(E,OPLIST+4) OPEN OUTPUT DCB @V201122 00658000 LA R1,OUTDCB POINT TO OUTPUT DCB P0503 00659000 TM DCBOFLGS,X'10' WAS OPEN SUCCESSFUL? P0503 00660000 BZ NOOPEN ERROR IF NOT P0503 00661000 * CONTROL COMES TO THIS POINT AFTER BOTH DCB'S HAVE BEEN OPENED, AND 00662000 * IT IS TIME TO ENTER THE MAIN COPYING LOOP. 00663000 START EQU * 00664000 XC RECNUM,RECNUM ZERO RECORDS READ SO FAR 00665000 SPACE 00666000 * BOTH DCB'S HAVE BEEN OPENED FOR 'LOCATE' MODE. 00667000 * FOR INDCB, THIS WAS SPECIFIED BY 'MACRF=GL', OR, MACRO FORM = 00668000 * GET LOCATE. THIS MEANS THAT A GET MACRO WILL RETURN IN REGISTER 00669000 * R1 THE ADDRESS OF AN INPUT BUFFER ALLOCATED BY THE OS SIMULATION 00670000 * ROUTINES, WHICH CONTAINS THE NEXT RECORD OF INPUT. 00671000 * FOR OUTDCB, LOCATE MODE IS INDICATED BY 'MACRF=PL', OR MACRO 00672000 * FORMAT = PUT LOCATE. THIS MEANS THAT EACH PUT MACRO ALLOCATES THE 00673000 * THE NEXT (OR FIRST) OUTPUT BUFFER. THE FIRST PUT MACRO ALLOCATES 00674000 * THE FIRST OUTPUT BUFFER. THIS ROUTINE THEN FILLS IN THAT BUFFER. 00675000 * THE NEXT PUT MACRO WRITES OUT THE CONTENTS OF THE LAST BUFFER 00676000 * AND ALLOCATES A NEW BUFFER (PROBABLY IN THE SAME LOCATION AS THE 00677000 * LAST ONE) WHICH THIS ROUTINE CAN THEN FILL IN. THE CLOSE MACRO 00678000 * WILL CAUSE THE LAST BUFFER TO BE WRITTEN OUT ON THE FILE. 00679000 SPACE 00680000 * BY USING 'LOCATE' MODE, DATA MOVEMENT SHOULD BE REDUCED TO A 00681000 * MINIMUM. FURTHERMORE, ALL PADDING AND TRUNCATION CAN BE TAKEND CARE 00682000 * OF AS DESIRED BY THIS ROUTINE. 00683000 LOOP EQU * 00684000 GET INDCB GET ADDRESS OF INPUT BUFFER 00685000 LR INP,R1 INP -> INPUT BUFFER 00686000 CLI RC,0 WAS THERE AN I/O ERROR? 00687000 BNE CLOSE ALL THROUGH IF SO 00688000 SPACE 00689000 * THE LENGTH OF THE INPUT RECORD IS STORED IN THE LRECL FIELD 00690000 * OF INDCB. WE MUST NOW COMPUTE THE LENGTH OF THE OUTPUT RECORD. 00691000 * IF THE OUTPUT DCB IS FIXED RECORD FORMAT, THEN THAT LRECL IS 00692000 * THE SIZE OF THE OUTPUT RECORD. IF NOT, THEN IT'S THE SIZE OF 00693000 * THE INPUT RECORD, UP TO A MAXIMUM OF THE BLOCKSIZE OF THE 00694000 * OUTPUT DCB. 00695000 SPACE 00696000 * THERE IS SOME ADDITIONAL COMPLICATIONS FOR V-TYPE FILES. WHEN A GET 00697000 * IS EXECUTED FOR THESE FILES, THE FIRST TWO BYTES OF THE DATA CONTAIN 00698000 * THE DATA LENGTH, AND THE NEXT TWO BYTES ARE RESERVED. 00699000 * THESE FOUR BYTES SHOULD NOT BE CONSIDERED PART 00700000 * OF THE DATA WHEN COPYING. 00701000 * SIMILARLY, WHEN CREATING A V-TYPE OUTPUT RECORD, THE TWO BYTE RECORD 00702000 * LENGTH MUST BE PLACED IN THE FIRST FOUR BYTES OF THE DATA AREA, 00703000 * AND THE NEXT TWO ZEROED. 00704000 SPACE 00705000 * FINALLY NOTE ALSO THAT WHENEVER A DCBBLKSI OR DCBRECFM FIELD IS 00706000 * LOADED (VIA AN LH) INTO A REGISTER, THE HIGH ORDER BYTES MUST 00707000 * BE ZEROED, SINCE THESE FIELDS ARE REALLY LOGICAL HALFWORDS. 00708000 SPACE 00709000 LH INL,INLRECL GET INDCB LRECL 00710000 N INL,=A(X'FFFF') ZERO HIGH BYTES 00711000 TM INRECFM,RECUF IS IT U OR F? 00712000 BO *+12 SKIP IF YES 00713000 LA INP,4(,INP) V -> DATA AREA 4 BYTES BEYOND 00714000 SH INL,=H'4' V -> DATA AREA 4 BYTES SHORTER 00715000 TM INRECFM,SPNND SPANNED RECORDS @VA13188 00715300 BO RCFMERR NOT SUPPORTED @VA13188 00715600 SPACE 00716000 TM OUTRECFM,RECUV U OR V FILE? 00717000 BO OUTUV GO HANDLE IF SO 00718000 SPACE 00719000 * OTHERWISE, THE LENGTH OF THE OUTPUT RECORD IS OUTLRECL. 00720000 LH OUTL,OUTLRECL GET LRECL 00721000 N OUTL,=A(X'FFFF') ZERO HIGH BYTES 00722000 B OUTE GO FINISH UP 00723000 SPACE 00724000 * FOR U FILES, THE LENGTH OF THE OUTPUT BUFFER MUST NOT 00725000 * EXCEED THE FILE BLOCKSIZE. 00726000 * FOR V FILES THE MAX IS BLOCKSIZE-4. 00727000 OUTUV EQU * 00728000 LR OUTL,INL START WITH THE INPUT DATA LEN 00729000 TM OUTRECFM,RECU U TYPE OUTPUT? 00730000 BO NOTVAR SKIP IF SO @VA13188 00731000 LA OUTL,4(,OUTL) V -> BUFFER LENGTH IS 4 LONGER 00732000 NOTVAR EQU * @VA13188 00732200 TM OUTRECFM,SPNND SPANNED RECORDS @VA13188 00732400 BO RCFMERR NOT SUPPORTED @VA13188 00732600 LH XR,OUTBLKSI GET OUTPUT DCB BLOCKSIZE 00733000 N XR,=A(X'FFFF') CLEAR HIGH BYTES 00734000 TM OUTRECFM,RECU U TYPE OUTPUT? 00735000 BO *+8 SKIP IF SO 00736000 SH XR,=H'4' V -> USE BLOCKSIZE-4 00737000 CR XR,OUTL DOES BUFFER LENGTH EXCEED BLKSIZ 00738000 BH *+6 SKIP IF NO 00739000 LR OUTL,XR OTHERWISE, USE BLOCKSIZE 00740000 SPACE 00741000 OUTE EQU * 00742000 STH OUTL,OUTLRECL STORE BUFFER LENGTH IN OUTDCB 00743000 SPACE 00744000 * ALLOCATE AN OUTPUT BUFFER, WRITING OUT THE PREVIOUS ONE, IF ANY. 00745000 PUT OUTDCB 00746000 LR OUTP,R1 POINT TO BUFFER 00747000 CLI RC,0 WAS THERE AN I/O ERROR? 00748000 BNE CLOSE ALL THROUGH IF SO 00749000 SPACE 00750000 * INCREASE RECORD BY 1. 00751000 L R1,RECNUM 00752000 LA R1,1(,R1) 00753000 ST R1,RECNUM 00754000 SPACE 00755000 * FOR V-TYPE FILES, WE MUST STORE THE TWO BYTE BUFFER LENGTH 00756000 * FIELD IN THE FIRST TWO BYTES OF THE BUFFER. ALSO, WE MUST 00757000 * UPDATE THE BUFFER ADDRESS AND LENGTH REGISTERS IN PREPARATION FOR 00758000 * THE DATA MOVE. 00759000 TM OUTRECFM,RECUF U OR F RECORD FORMAT? 00760000 BO NOTV GO IF SO -- NOT V 00761000 MVC 0(2,OUTP),OUTLRECL COPY BUFFER LEN INTO BUFFER 00762000 MVC 2(2,OUTP),=H'0' SET NEXT TWO BYTES TO ZERO 00763000 SH OUTL,=H'4' DATA LENGTH IS 4 LESS 00764000 LA OUTP,4(,OUTP) DATA TARGET IS 4 BEYOND 00765000 NOTV EQU * 00766000 SPACE 00767000 ICM INL,B'1000',=C' ' USE BLANK AS PAD CHARACTER 00768000 MVCL OUTP,INP PERFORM THE MOVE 00769000 B LOOP GO FOR NEXT RECORD 00770000 * INDCB SYNAD EXIT ROUTINE. 00771000 INSYNAD EQU * 00772000 XENTER IN,INSYEX 00773000 NI FCBIOSW2,255-FCBMVPDS TURN OFF PDS MOVE OPTIO@V201122 00774000 BAL RR,SYNADAF CALL SYNADAF 00775000 B INSYNER TYPE ERROR MESSAGE 00776000 SPACE 3 00777000 * OUTDCB SYNAD EXIT ROUTINE 00778000 OUTSYNAD EQU * 00779000 XENTER OUT,OUTSYEX 00780000 BAL RR,SYNADAF CALL SYNADAF 00781000 B OUTSYNER TYPE ERROR MESSAGE 00782000 SPACE 2 00783000 * THE SYNADAF MACRO CALL IS USED TO OBTAIN AN ERROR MESSAGE WHICH 00784000 * WILL INDICATE THE REASON FOR THE I/O ERROR. 00785000 SYNADAF EQU * 00786000 SYNADAF ACSMETH=QSAM 00787000 SPACE 00788000 * FOR CMS, THE ERROR MESSAGE IS 29 BYTES LONG, STARTING AT THE 00789000 * 54'TH BYTE OFF OF REGISTER R1. 00790000 LR XR,R1 COPY POINTER INTO XR 00791000 BR RR RETURN TO CALLER 00792000 SPACE 5 00793000 * RELEASE SPACE ALLOCATED BY SYNADEF MACRO. 00794000 SYNADRLS EQU * 00795000 SYNADRLS 00796000 B CLOSE 00797000 * CONTROL COMES HERE WHEN AN END-OF-FILE CONDITION IS DETECTED ON 00798000 * THE INPUT FILE. 00799000 ENDREAD EQU * 00800000 L FCBR,INFCB GET INPUT FCB ADDR @V201122 00801000 TM FCBIOSW2,FCBMVPDS IS MOVE PDS SW ON @V201122 00802000 BNO CLOSE NO, CLOSE FILE @V201122 00803000 LA R1,INDCB GET ADDR OF INPUT DCB @V201122 00804000 MVC DCBRECAD+1(3),DCBEOBAD+1 SET NEXT BUFFER ADDR EO@V201122 00805000 LA PR,MVEMEMBR GET MEMBER NAME ADDRESS @V201122 00806000 BAL RR,MEMMOVOK TYPE MEMBER MOVED OK MSG. @V201122 00807000 L FCBR,OUTFCB GET OUTPUT FCB ADDRESS @V201122 00808000 L XR,FCBINIT GET FCBOPCB SWITCH @V201122 00809000 NI FCBINIT,255-FCBOPCB DON'T LET CLOSE FREE FCB @V201122 00810000 CLOSE (OUTDCB,LEAVE),MF=(E,OPLIST+4) CLOSE OUTPUT DCB @V201122 00811000 ST XR,FCBINIT RESTORE FCBOPCB SWITCH @V201122 00812000 B FNDMEMBR OPEN NEW OUTPUT FILE @V201122 00813000 * CONTROL COMES HERE EITHER NORMALLY, AS A RESULT OF AN END-OF-FILE, 00814000 * OR ABNORMALLY, AFTER AN ERROR MESSAGE. 00815000 * WE MUST FIRST CHECK TO SEE IF WE ARE IN AN EXIT ROUTINE, SINCE 00816000 * WE WILL HAVE TO RETURN FROM THAT BEFORE WE CAN CLEAN UP AND RETURN. 00817000 CLOSE EQU * 00818000 CLI PBYTE,MAIN ARE WE IN AN EXIT ROUTINE? 00819000 BNE EXEX YES -- EXIT FROM EXIT ROUTINE 00820000 L FCBR,INFCB GET ADDRESS OF INPUT FCB@V201122 00821000 LTR FCBR,FCBR IS IT ZERO? @VA07463 00822200 BZ CLOSE1 BRANCH IF YES @VA07463 00822300 SR RR,RR CLEAR A REGISTER @VA07463 00822400 CLI RC,INPTERR I/O ERROR ON CLOSE? @VA07463 00822500 BNL CLOSEO BRANCH IF YES @VA07463 00822600 LA R1,INDCB POINT TO INPUT DCB @VA07463 00822700 TM DCBOFLGS,DCBOPEN IS DCB OPEN? @VA07463 00822800 BZ CLOSEO BRANCH IF NOT @VA07463 00822900 CLOSE (INDCB,LEAVE),MF=(E,OPLIST+4) CLOSE INPUT @VA07463 00823000 ST RR,INFCB CLEAR FCB ADDRESS @VA07463 00823100 CLOSEO EQU * @VA07463 00823200 NI FCBIOSW2,255-FCBMVPDS TURN OFF MOVE PDS SWITCH@V201122 00824000 L FCBR,OUTFCB GET ADDRESS OF OUTPUT FC@V201122 00825000 LTR FCBR,FCBR IS FCB ADDR ZERO @V201122 00826000 BZ CLOSEO1 BRANCH IF YES, BYPASS CLOSE @VA07463 00827100 MVC FCBDSNAM(8),SAVEFN RESTORE FOR PDS MOVE @V201122 00828000 CLI RC,OUTPTERR I/O ERROR ON OUTPUT? @VA07463 00829200 BE CLOSEO1 BRANCH IF YES @VA07463 00829250 LA R1,OUTDCB POINT TO OUTPUT DCB @VA07463 00829300 TM DCBOFLGS,DCBOPEN IS IT OPEN? @VA07463 00829350 BZ CLOSEO1 BRANCH IF NOT @VA07463 00829400 CLOSE (OUTDCB,LEAVE),MF=(E,OPLIST+4) CLOSE OUTPUT FILE@VA07463 00829450 ST RR,OUTFCB CLEAR FCB ADDRESS @VA07463 00829500 CLOSEO1 EQU * @VA07463 00829550 L FCBR,INFCB POINT TO INPUT FCB @VA07463 00829600 LTR FCBR,FCBR IS THERE ONE? @VA07463 00829650 BZ CLOSEO2 BRANCH IF NOT @VA07463 00829700 TM FCBINIT,FCBOPCB 'TEMPORARY' BIT ON? @VA07463 00829750 BZ CLOSEO2 BRANCH IF NOT @VA07463 00829800 MVC PLIST(FILEDFCL),FILEDEFC COPY 'CLEAR' PLIST @VA07463 00829850 MVC PLIST+8(8),INDDNAM INSERT INPUT DDNAME @VA07463 00829900 LA R1,PLIST POINT TO PLIST @VA07463 00829950 SVC 202 CALL FILEDEF @VA07463 00830000 DC AL4(*+4) @VA07463 00830050 CLOSEO2 EQU * @VA07463 00830100 L FCBR,OUTFCB GET POINTER TO OUTPUT FCB @VA07463 00830150 LTR FCBR,FCBR IS THERE ONE? @VA07463 00830200 BZ CLOSE1 BRANCH IF NOT @VA07463 00830250 TM FCBINIT,FCBOPCB 'TEMPORARY' FCB? @VA07463 00830300 BZ CLOSE1 BRANCH IF NOT @VA07463 00830350 MVC PLIST(FILEDFCL),FILEDEFC MOVE 'CLEAR' FILEDEF @VA07463 00830400 MVC PLIST+8(8),OUTDDNAM INSET OUTPUT DDNAME @VA07463 00830450 LA R1,PLIST POINT TO PLIST @VA07463 00830500 SVC 202 CALL FILEDEF @VA07463 00830550 DC AL4(*+4) @VA07463 00830600 SPACE 1 00832000 CLOSE1 EQU * P0503 00833000 CLI RC,IOERR WAS RETURN CODE I/O ERROR? @VA07463 00833200 BNH CLOSE2 BRANCH IF NOT @VA07463 00833400 MVI RC,IOERR SET TO I/O ERROR @VA07463 00833600 CLOSE2 EQU * @VA07463 00833800 L R13,SAVE13 RESTORE OLD R13 00834000 LA R0,8*MOVELEN LENGTH OF WORKSPACE 00835000 IC R2,DOSF GET SAVED DOSFLAGS @V305001 00836000 LR R1,TR ADDRESS OF WORKSPACE 00837000 FREEMAIN R,LV=(0),A=(1) FREE WORKSPACE 00838000 DMSKEY NUCLEUS @V305001 00839000 NI BATFLAGS,255-BATMOVE FOR BATCH 'MOVES' @V305001 00840000 STC R2,DOSFLAGS RESET NUCON'S DOSFLAGS @V305001 00841000 DMSKEY RESET @V305001 00842000 SR R15,R15 00843000 IC R15,RC GET RETURN CODE FOR ROUTINE 00844000 RETURN (14,12),RC=(15) 00845000 * EXIT FROM AN EXIT ROUTINE (DCB EXIT ROUTINE, OR SYNAD EXIT ROUTINE) 00846000 EXEX EQU * 00847000 MVI PBYTE,MAIN INDICATE 'OUT OF EXIT ROUTINE' 00848000 LM R14,R12,EXSAVE RESTORE REGISTERS 00849000 BR R14 RETURN FROM EXIT ROUTINE 00850000 SPACE 2 00851000 * ERROR IN OPEN MACRO (X'10' IN DCBOFLGS WAS NOT TURNED ON 00852000 * BY OPEN) 00853000 NOOPEN EQU * 00854000 MVI RC,28 SET RETURN CODE = 28 00855000 B CLOSE GO FINISH UP 00856000 * CONSOLE INPUT INFORMATIONAL MESSAGE 00857000 CONIN EQU * 00858000 DMSERR NUM=706,LET=I, *00859000 TEXT='TERM INPUT -- TYPE NULL LINE FOR END OF DATA' 00860000 LA R1,INDCB RESTORE R1 00861000 B INSET P0503 00862000 SPACE 2 00863000 BADFDEF EQU * @VA00824 00864000 LA XR,8(,R1) GET DDNAME ADDR. @VA00824 00865000 INVALID DMSERR NUM=86,LET=E,TEXT='INVALID DDNAME ''........''', X00866000 SUB=(CHARA,(XR)) @VA00824 00867000 MVI RC,24 SET RETURN CODE @VA00824 00868000 B CLOSE @VA00824 00869000 SPACE 3 00870000 * FILEDEF HAD NOT PREVIOUSLY BEEN MADE. 00871000 NOFCB EQU * P0503 00872000 LR XR,R1 SAVE DCB POINTER P0503 00873000 LA R0,DCBDDNAM POINT TO DDNAME P0503 00874000 DMSERR NUM=708,LET=I,MF=I,RENT=NO, P0503*00875000 SUB=(CHARA,(R0),CHARA,(R0)), P0503*00876000 TEXT=('DISK FILE ''FILE ........ A1'' ', P0503*00877000 'ASSUMED FOR DDNAME ''........''') P0503 00878000 LR R1,XR RESTORE DCB POINTER P0503 00879000 SPACE 1 00880000 * BY SETTING THE FCBOPCB BIT, WE WILL FORCE 'CLOSE' TO CLEAR THE 00881000 * THE FILEDEF. WE WANT THIS TO HAPPEN, SINCE WE CREATED THE FCB 00882000 * IN THE FIRST PLACE. 00883000 OI FCBINIT,FCBOPCB SET 'MADE BY OPEN' BIT P0503 00884000 BR RR RETURN TO CALLER P0503 00885000 SPACE 3 00886000 * UNSUPPORTED DEVICE 00887000 * DEVICE CODE IN FCB IS GREATER THAN THIS ROUTINE EXPECTS. 00888000 UNSUP EQU * 00889000 LA XR,FCBDD 00890000 DMSERR NUM=127,LET=S,SUB=(CHARA,(XR)), *00891000 TEXT='UNSUPPORTED DEVICE FOR FILE ''........''' 00892000 MVI RC,100 00893000 B CLOSEO1 GO FINISH UP @VA07463 00894100 SPACE 3 00895000 * A DISK FILE WAS SPECIFIED AS INPUT, BUT THE FILE DOES NOT EXIST. 00896000 NOINPUT EQU * 00897000 DMSERR NUM=2,LET=E,SUB=(CHAR8A,(XR)), *00898000 TEXT='FILE ''....................'' NOT FOUND' 00899000 MVI RC,24 00900000 B CLOSE 00901000 SPACE 3 00902000 * AN INVALID OPTION WAS SPECIFIED 00903000 OPTERR DMSERR NUM=3,LET=E,SUB=(CHARA,(PR)), X00904000 TEXT='INVALID OPTION ''........''' @V201122 00905000 MVI RC,24 SET RETURN CODE @V201122 00906000 B CLOSE CLOSE FILES @V201122 00907000 SPACE 3 00908000 PARMERR DMSERR NUM=70,LET=E,SUB=(CHARA,(PR)), X00909000 TEXT='INVALID PARAMETER ''........''' @V201122 00910000 MVI RC,24 SET RETURN CODE @V201122 00911000 B CLOSE CLOSE FILES @V201122 00912000 SPACE 3 00913000 * MEMBER MOVED SUCCESSFULLY 00914000 MEMMOVOK DMSERR NUM=225,LET=I,SUB=(CHARA,(PR)), X00915000 TEXT='PDS MEMBER ''........'' MOVED' @V201122 00916000 BR RR RETURN TO CALLER @V201122 00917000 SPACE 3 00918000 * END OF PDS MOVE 00919000 ENDMVPDS DMSERR NUM=226,LET=I,TEXT='END OF PDS MOVE' @V201122 00920000 B CLOSE RETURN TO CALLER @V201122 00921000 SPACE 3 00922000 * ILLEGAL INPUT DEVICE (DUMMY, PRINTER, PUNCH, CRT) 00923000 ILLIN EQU * 00924000 LA R14,=CL6'INPUT' 00925000 B ILL 00926000 SPACE 00927000 * ILLEGAL OUTPUT DEVICE (READER, CRT) 00928000 ILLOUT EQU * 00929000 LA R14,=CL6'OUTPUT' 00930000 SPACE 00931000 ILL EQU * 00932000 DMSERR NUM=75,LET=E,MF=I,RENT=NO, *00933000 SUB=(CHARA,(XR),CHARA,(R14)), *00934000 TEXT=' ........ ILLEGAL FOR ......' @VA14621 00935000 MVI RC,40 00936000 B CLOSE 00937000 SPACE 3 00938000 * OUTPUT DISK FILE IS ON A READ-ONLY DISK. 00939000 ROERR EQU * 00940000 LA XR,FCBDSMD 00941000 DMSERR NUM=37,LET=E,SUB=(CHARA,((XR),1)), @VA05240*00942000 TEXT='OUTPUT DISK ''..'' IS READ/ONLY' 00943000 MVI RC,36 00944000 B CLOSE 00945000 SPACE 3 00946000 * OUTPUT DISK IS NOT ACCESSED 00947000 ACERR LA XR,FCBDSMD @VA05240 00948000 DMSERR NUM=69,LET=E,SUB=(CHARA,((XR),1)), @VA05240*00949000 TEXT='OUTPUT DISK ''..'' IS NOT ACCESSED' @VA05240 00950000 MVI RC,36 @VA05240 00951000 B CLOSE @VA05240 00952000 SPACE 3 00953000 * SYNAD EXIT WAS TAKEN ON INDCB. 00954000 INSYNER EQU * 00955000 * NOTE XR -> SYNADAF ERROR MESSAGE BUFFER 00956000 DMSERR NUM=128,LET=S, P0503*00957000 MF=I,RENT=NO, *00958000 SUB=(DECA,RECNUM,CHARA,54(XR)), *00959000 TEXT='I/O ERROR ON INPUT AFTER READING ......... RECORDS*00960000 : .............................' 00961000 MVI RC,INPTERR SET INPUT I/O ERROR @VA07463 00962100 B SYNADRLS COMPLETE SYNAD PROCESSING 00963000 SPACE 3 00964000 * SYNAD EXIT WAS TAKEN ON OUTPUT DCB 00965000 OUTSYNER EQU * 00966000 * NOTE XR -> SYNADAF ERROR MESSAGE BUFFER 00967000 DMSERR NUM=129,LET=S, *00968000 MF=I,RENT=NO, *00969000 SUB=(DECA,RECNUM,CHARA,54(XR)), *00970000 TEXT='I/O ERROR ON OUTPUT WRITING RECORD NUMBER ........*00971000 .: .............................' 00972000 MVI RC,OUTPTERR SET OUTPUT I/O ERROR @VA07463 00973100 B SYNADRLS COMPLETE SYNAD PROCESSING 00974000 SPACE 3 00975000 * THE INPUT DDNAME IS THE SAME AS THE OUTPUT DDNAME. 00976000 SAMEERR EQU * 00977000 DMSERR NUM=41,LET=E, *00978000 TEXT='INPUT AND OUTPUT FILES ARE THE SAME' 00979000 MVI RC,40 00980000 B CLOSE 00981000 SPACE 3 00982000 * V RECORD FORMAT, BUT BLOCKSIZE IS LESS THAN 9. 00983000 ERVB EQU * 00984000 LA XR,FCBDD POINT TO DDNAME 00985000 DMSERR NUM=130,LET=S,SUB=(CHARA,(XR)), *00986000 TEXT='BLOCKSIZE ON V FORMAT FILE ........ IS LESS THAN 9*00987000 ' 00988000 MVI RC,88 00989000 B CLOSE 00990000 SPACE 3 @VA13188 00990100 RCFMERR DS 0H @VA13188 00990200 DMSERR NUM=232,LET=E,TEXT='INVALID RECFM -- SPANNED RECORDS NO*00990300 T SUPPORTED' @VA13188 00990400 MVI RC,88 FUNCTIONAL ERROR @VA13188 00990500 B CLOSE CLOSE FILES AND EXIT @VA13188 00990600 SPACE 3 @VA13188 00990700 * DUMMY INPUT DCB 00991000 DCBS DCB DDNAME=INMOVE,EODAD=ENDREAD,SYNAD=INSYNAD, P0503*00992000 MACRF=GL,DSORG=PS 00993000 SPACE 3 00994000 DCB DDNAME=OUTMOVE,SYNAD=OUTSYNAD, P0503*00995000 MACRF=PL,DSORG=PS 00996000 * OPEN/CLOSE I/O LIST 00997000 LISTS OPEN (*-*,INPUT,*-*,OUTPUT),MF=L P0503 00998000 SPACE 3 00999000 * PLIST FOR 'FILEDEF DDNAME DISK ( NOCHANGE' 01000000 FILEDEFP DC CL16'FILEDEF',CL8'DISK',CL8'(',CL8'NOCHANGE' P0503 01001000 DC 8X'FF' P0503 01002000 FILEDEFL EQU *-FILEDEFP LENGTH OF PLIST P0503 01004000 FILEDEFC DC CL16'FILEDEF',CL8'CLEAR' @VA07463 01004100 DC 8X'FF' @VA07463 01004200 FILEDFCL EQU *-FILEDEFC @VA07463 01004300 SPACE 2 01004400 H8 DC H'8' @VA07463 01004500 INPTERR EQU 101 @VA07463 01004600 OUTPTERR EQU 102 @VA07463 01004700 IOERR EQU 100 @VA07463 01004800 DCBOPEN EQU X'10' @VA07463 01004900 LTORG 01005000 ADT P0503 01006000 FSTB P0503 01007000 NUCON P0503 01008000 CMSCB P0503 01009000 OSFST @V201122 01010000 DCBD DSORG=PS,DEVD=DA P0503 01011000 * DEFINE VARIOUS FIELDS INSIDE EACH OF THE DCB'S. 01012000 DEFINE LRECL,BLKSI,RECFM,DDNAM P0503 01013000 END , 01014000