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