*TITLEFOMOD -- WRITE ONE RECORD TO DISK USING DISP=MOD 00010002 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** *A AUTHOR J. M. PONTON 00020000 *A DESIGNER J. M. PONTON 00030000 *A LANGUAGE S/370 ASSEMBLER F 00040000 *A SYSTEM IBM 00050000 *A WRITTEN 07-26-85 00060000 * REVISED 8-09-85 RSK. 'CAPPED' FOR USE WITH 31 BIT ADDRESSING 00070000 * UNDER MVS/XA. 00080000 *A 00090000 *A 00100000 *A CALL FOMOD (DSNAME, DCB, DDNAME, RECORD) 00110000 *A INPUT DSNAME = DATASET NAME OF FILE. 00120000 *A INPUT DCB = ADDRESS OF DCB. 00130000 *A INPUT DDNAME = DD NAME THAT THE DSNAME IS ALLOCATED TO. 00140000 *A INPUT RECORD = RECORD TO BE WRITTEN. 00150000 *A 00160000 *A 00170000 *A 00180000 *A THIS PROGRAM PERFORMS THE FOLLOWING OPERATIONS: 00190000 *A 00200000 *A 1. ENQUE ON THE FILE USING 'DDNAME' AND 'DSNAME'. 00210000 *A THE FILE MUST BE PREVIOUSLY ALLOCATED. 00220000 *A 00230000 *A 2. OPEN THE FILE. 00240000 *A 00250000 *A 3. WRITE THE RECORD. THE WRITE WORKS LIKE DISP=MOD. 00260000 *A BASIC SEQUENTIAL ASSESS METHOD (BSAM). 00270000 *A 00280000 *A 4. DEQUE ON THE NAMES IN (1). THIS SHOULD RELEASE THE FILE. 00290000 *A 00300000 *A 6. CLOSE THE FILE. 00310000 * 00320000 * NOTE: THIS PROGRAM IS PATTERNED AFTER FOACCT WRITTEN BY 00330000 * FRANCIS COLLINS 08-10-75. 00340000 * 00350000 SPACE 00360000 R1 EQU 1 ADDRESS OF PARAMETER LIST. 00370000 R2 EQU 2 ADDRESS OF "RECORD"--RECORD TO BE WRITTEN. 00380000 R3 EQU 3 NOT USED. 00390000 R4 EQU 4 NOT USED. 00400000 R5 EQU 5 LENGTH OF DD-ENTRY IN TASK INPUT/OUTPUT TABLE. 00410000 R6 EQU 6 ADDRESS OF DD-ENTRY IN TASK INPUT/OUTPUT TABLE. 00420000 R7 EQU 7 ADDRESS OF ADDRESS OF UNIT CONTROL BLOCK. 00430000 R8 EQU 8 ADDRESS OF DDNAME PARAMETER FOR ENQUE AND DEQUE. 00440000 R9 EQU 9 ADDRESS OF DSNAME PARAMETER FOR ENQUE AND DEQUE. 00450000 R10 EQU 10 ADDRESS OF JOB FILE CONTROL BLOCK AREA. 00460000 R11 EQU 11 ADDRESS OF DATA CONTROL BLOCK. 00470000 R12 EQU 12 BASE REGISTER = ADDRESS OF FOMOD 00480000 R13 EQU 13 ADDRESS OF SAVE AREA 00490000 R14 EQU 14 ADDRESS TO RETURN TO 00500000 R15 EQU 15 ADDRESS OF PROGRAM 00510000 SPACE 00520000 B0T14 EQU B'10110111' USED TO TURN OFF BITS 1 AND 4. 00530000 B1T0 EQU B'10000000' USED TO TURN ON BIT 0. 00540000 B1T4 EQU B'00001000' USED TO TURN ON BIT 4. 00550000 * 00560000 SPACE 00570000 PRINT GEN 00580000 FOMOD CSECT 00590000 USING *,R15 00600000 B START 00610000 DC X'06',C'FOMOD ' 00620000 DROP R15 00630000 START STM R14,R12,12(R13) SAVE REGISTERS 00640000 LR R12,R15 00650000 USING FOMOD,R12 ESTABLISH REG 12 AS BASE 00660000 LA R11,SAVE 00670000 ST R11,8(R13) CHAIN SAVE AREA 00680000 ST R13,SAVE+4 POINTER TO OLD SAVE AREA 00690000 LR R13,R11 POINTER TO NEW SAVE 00700000 FOMOD AMODE ANY EXT 00710000 FOMOD RMODE 24 EXT 00720000 LA R4,FONEXT EXT 00730000 LA R5,RETURNIT EXT 00740000 BSM R5,R4 EXT 00750000 RETADD DC F'0' EXT 00760000 FONEXT DS 0H EXT 00770000 ST R5,RETADD EXT 00780000 SPACE 00790000 L R11,4(R1) ADDRESS OF ARG. CONTAINING DCB ADDRESS. 00800000 L R11,0(R11) DCB ADDRESS. 00810000 USING IHADCB,R11 00820000 LA R10,JFCBAREA JFCB ADDRESS. 00830000 L R9,0(R1) DSNAME ADDRESS. 00840000 L R8,8(R1) DDNAME ADDRESS. 00850000 SPACE 00860000 USING JFCB,R10 00870000 SPACE 00880000 L R2,12(R1) OBTAIN INPUT PARAMETERS. 00890000 LA R2,0(R2) CLEAR FIRST BYTE OF REGISTER. 00900000 SPACE 00910000 ENQ ((R8),(R9),E,13,SYSTEMS) 00920000 SPACE 00930000 OPEN ((R11),EXTEND) 00940000 EJECT 00950000 PUT (R11),(R2) WRITE THE RECORD 00960000 SPACE 00970000 CLOSE ((R11)) 00980000 DEQ ((R8),(R9),13,SYSTEMS) 00990000 SPACE 01000000 L R5,RETADD EXT 01010000 BSM 0,R5 EXT 01020000 RETURNIT DS 0H EXT 01030000 L R13,SAVE+4 RESTORE POINTER TO SAVE AREA 01040000 LM R14,R12,12(R13) RESTORE REGISTERS 01050000 SR R15,R15 ZERO RETURN CODE 01060000 BR R14 RETURN 01070000 EJECT 01080000 SYNEXIT SYNADAF ACSMETH=BSAM 01090000 ST R14,SYNADR14 SAVE R14 FOR RETURN 01100000 LA R1,8(R1) SKIP OVER FIRST 8 BYTES 01110000 ST R1,SYNADMSA EXT. PARAMETER LIST 01120000 LA R1,SYNADMSA 01130000 L R15,=V(FOPERR) CALL FOPERR 01140000 BALR R14,R15 01150000 SYNADRLS RELEASE SYNAD SAVE AREA 01160000 L R14,SYNADR14 RESTORE R14 TO LEAVE SYNAD EXIT 01170000 ABEND 402 01180000 DS 0F 01190000 JFCBPNTR DC X'87',AL3(JFCBAREA) 01200000 JFCBAREA DC 176X'0' 01210000 TIOTAD DC F'0' 01220000 SAVE DC 18F'0' 01230000 SYNADMSA DS F 01240000 SYNADRN DC A(SYNDSKA) ADDRESS OF RCD # FOR ERROR MESSAGE 01250000 SYNDSKA DC F'0' RCD # FOR FOPERR ERROR PRINT ROUTINE 01260000 SYNADR14 DS F 01270000 PRINT NOGEN 01280000 LTORG 01290000 JFCB DSECT 01300000 ORG JFCB+52 01310000 JFCBTSDM DS BL1 01320000 ORG JFCB+87 01330000 JFCBIND2 DS BL1 01340000 DCBD DSORG=PS 01350000 END 01360000