FOPA TITLE 'FOGM3D --GM3DPARM SEQUENTIAL WRITE, DIRECT READ AND WRI*00010001 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** TE.' 00020001 *AINDMFOGM3D -- GM3DPARM BUILD SEQUENTIALLY, READ/WRITE DIRECT 00030001 *TITLE FOGM3D -- GM3DPARM OPERATIONS, SUMMARY 00040001 * AUTHOR RALPH E. MCMILLAN 00050001 * DESIGNER RALPH E. MCMILLAN 00060001 * LANGUAGE ASSEMBLER F 00070001 * SYSTEM S/370 00080001 * WRITTEN 11-10-82 00090001 * REVISED COPIED FROM FOPARM. 00100001 * REVISED 07-11-83 PKC. TRANSFERRED CODE FROM FOSCDK TO HANDLE 00110001 * DIRECT USE OF MORE THAN 65536 BLOCKS. 00120001 * MARKED BY D68 AND D69 IN COLS. 69-71. 00130001 * REVISED 12-12-83 RSK. REMOVED TRACK OVERFLOW SPECIFICATION. 00140001 * REVISED 08-31-84 RDK. MODIFIED LRECL AND BLKSIZ FOR 00150001 * EXTENDED HEADERS AND 3380 TRACKSIZE. 00160001 * REVISED 07-23-85 RSK. CHANGED TO BE ABLE TO BE CALLED BY 31 00170001 * BIT PROGRAMS AND TO BE ABLE TO MOVE DATA 00180001 * ABOVE 16MEG LINE. CHANGES MARKED BY 'EXT'. 00190001 * REVISED 09-11-85 DWD1.MODIFIED LRECL AND BLKSIZ FOR 00200001 * NEW COMPRESSED TRACE HEADER. ADDED 00210001 * CALLS TO USTHPK AND USTHUP. ADDED COMMON/P 00220001 * AND COUNT SUBROUTINE TO COUNT I/O'S. 00230001 * REVISED 03-04-86 DCB. MODIFIED LRECL, BLKSIZ, AND BUFFER IN 00240001 * ORDER TO ALLOW SUBROUTINE USTHPK TO BUILD 00250001 * PACKED TRACE HEADERS 244 BYTES IN LENGTH. 00260001 * REVISED 04-04-88 TJT. MODIFIED LRECL, BLKSIZ, AND BUFFER IN 00270001 * ORDER TO ALLOW SUBROUTINE USTHPK TO BUILD 00280001 * PACKED TRACE HEADERS 252 BYTES IN LENGTH. 00290001 * THIS WILL RESULT IN THERE BEING 93 HEADERS 00300001 * STORED IN EACH BLOCK EXCEPT IN THE 1ST BLK 00310001 * WHICH USES THE 1ST LREC FOR OVERHEAD... 00320001 * REVISED 01-23-89 TJT. MODIFIED LRECL, BLKSIZ, AND BUFFER IN 00330001 * ORDER TO ALLOW SUBROUTINE USTHPK TO BUILD 00340001 * PACKED TRACE HEADERS 256 BYTES IN LENGTH. 00350001 * THIS WILL RESULT IN THERE BEING 91 HEADERS 00360001 * STORED IN EACH BLOCK EXCEPT IN THE 1ST BLK 00370001 * WHICH USES THE 1ST LREC FOR OVERHEAD... 00380001 * REVISED 10/13/93 REM. CHANGE THE WHERE AMODE SWITCH IS MADE. 00390001 * 00400001 * 00410001 * CALL FOGMOS (&STMT) 00420001 * &STMT= ERROR RETURN. 00430001 * OPEN BSAM DCB FOR SEQUENTIAL WRITE TO BUILD GM3DPARM FILE. 00440001 * 00450001 * CALL FOGMWS (DATA, &STMT) 00460001 * INPUT DATA = 96-WORD RECORD TO BE WRITTEN. ANY 00470001 * &STMT= ERROR RETURN. 00480001 * WRITE SEQUENTIALLY TO BUILD THE GM3DPARM FILE. 00490001 * 00500001 * CALL FOGMCS 00510001 * CLOSE THE BSAM DCB OF THE GM3DPARM FILE. 00520001 * 00530001 * CALL FOGMOD (&STMT) 00540001 * &STMT= ERROR RETURN. 00550001 * OPEN THE BDAM DCB FOR DIRECT READ AND WRITE, GM3DPARM FILE. 00560001 * 00570001 * CALL FOGMRD (DATA, DA, &STMT) 00580001 * OUTPUT DATA = 96-WORD AREA TO READ RECORD INTO. ANY 00590001 * INPUT DA = RELATIVE RECORD NUMBER. I4 00600001 * &STMT= ERROR RETURN. 00610001 * READ INTO DATA THE RECORD WITH RELATIVE RECORD NUMBER DA ON 00620001 * THE GM3DPARM FILE. 00630001 * 00640001 * CALL FOGMWD (DATA, DA, &STMT) 00650001 * INPUT DATA = 96-WORD RECORD TO BE WRITTEN. ANY 00660001 * INPUT DA = RELATIVE RECORD NUMBER. I4 00670001 * &STMT= ERROR RETURN. 00680001 * WRITE DIRECT FROM DATA TO RELATIVE RECORD DA ON THE GM3DPARM 00690001 * FILE. 00700001 * 00710001 * CALL FOGMCD 00720001 * CLOSE THE BDAM DCB OF THE GM3DPARM FILE. 00730001 * 00740001 * ALL RECORDS MUST BE WRITTEN USING THE FOGMWS ENTRY BEFORE BEING 00750001 * READ WITH FOGMRD OR REWRITTEN WITH FOGMWD. THE BSAM DCB SHOULD 00760001 * NOT BE OPEN AT THE SAME TIME OR AFTER THE BDAM DCB IS OPENED. 00770001 * A DIRECT READ OR WRITE ON A RECORD WHICH WAS NOT WRITTEN 00780001 * SEQUENTIALLY WILL RESULT IN AN ABEND WITH A SYSTEM COMPLETION 00790001 * CODE OF 001. 00800001 * 00810001 * RECORDS ARE BLOCKED BY THIS PROGRAM AND ARE ADDRESSED BY A 00820001 * RELATIVE RECORD NUMBER WHICH IS CONVERTED INTO A BLOCK NUMBER 00830001 * (RELATIVE DISK ADDRESS) AND RECORD NUMBER WHEN READING OR 00840001 * WRITING. 00850001 * 00860001 * 00870001 * DD-CARD FOR PREPARATION STEP: 00880001 * 00890001 * //GM3DPARM DD DSN=&&GM3DPARM,UNIT=SYSDA,DCB=DSORG=DA, 00900001 * // SPACE=(TRK,(10),CONTIG),DISP=(NEW,PASS) 00910001 * 00920001 * DD-CARD FOR PROCESSING STEP: 00930001 * 00940001 * //GM3DPARM DD DSN=&&GM3DPARM,DISP=(MOD,DELETE) 00950001 * 00960001 * USER ABEND CODES: 335 - BDAM I/O ERROR. SYNADF MESSAGE. 00970001 * 00980001 * STATEMENTS BEGINNING WITH "**D" WERE USED FOR DEBUGGING. 00990001 * 01000001 * 01010001 * END 01020001 EJECT 01030001 *TITLE FOGMOS -- GM3DPARM OPEN FOR SEQ. WRITE TO BUILD FILE 01040001 *A AUTHOR RALPH E. MCMILLAN 01050001 *A DESIGNER RALPH E. MCMILLAN 01060001 *A LANGUAGE ASSEMBLER F 01070001 *A SYSTEM S/370 01080001 *A WRITTEN 11-10-82 01090001 *A REVISED 11-29-82 REM. REPLACE ABEND WITH ERROR JUMP FOR 01100001 *A DD MISSING. 01110001 *A 01120001 *A 01130001 *A CALL FOGMOS (&STMT) 01140001 *A 01150001 *A IN/OUT ARGUMENT TYPE DESCRIPTION 01160001 *A 01170001 *A &STMT ERROR RETURN STATEMENT NUMBER. 01180001 *A 01190001 *A OPEN BSAM DCB FOR SEQUENTIAL WRITE TO BUILD GM3DPARM FILE. 01200001 *A 01210001 *A ALL RECORDS MUST BE WRITTEN USING THE FOGMWS ENTRY BEFORE BEING 01220001 *A READ WITH FOGMRD OR REWRITTEN WITH FOGMWD. THE BSAM DCB SHOULD 01230001 *A NOT BE OPEN AT THE SAME TIME OR AFTER THE BDAM DCB IS OPENED. 01240001 *A A DIRECT READ OR WRITE ON A RECORD WHICH WAS NOT WRITTEN 01250001 *A SEQUENTIALLY WILL RESULT IN AN ABEND WITH A SYSTEM COMPLETION 01260001 *A CODE OF 001. 01270001 *A 01280001 *A DD-CARD FOR PREPARATION STEP: 01290001 *A 01300001 *A //GM3DPARM DD DSN=&&GM3DPARM,UNIT=SYSDA,DCB=DSORG=DA, 01310001 *A // SPACE=(TRK,(10),CONTIG),DISP=(NEW,PASS) 01320001 *A 01330001 *A DD-CARD FOR PROCESSING STEP: 01340001 *A 01350001 *A //GM3DPARM DD DSN=&&GM3DPARM,DISP=(MOD,DELETE) 01360001 *A 01370001 *AEND 01380001 EJECT 01390001 *TITLE FOGMWS -- GM3DPARM WRITE SEQUENTIALLY TO BUILD FILE 01400001 *A AUTHOR RALPH E. MCMILLAN 01410001 *A DESIGNER RALPH E. MCMILLAN 01420001 *A LANGUAGE ASSEMBLER F 01430001 *A SYSTEM S/370 01440001 *A WRITTEN 11-10-82 01450001 *A REVISED 11-29-82 SAS. REPLACED ABEND WITH ERROR JUMP FOR 01460001 *A DD MISSING. 01470001 *A 01480001 *A 01490001 *A CALL FOGMWS (DATA, &STMT) 01500001 *A 01510001 *A IN/OUT ARGUMENT TYPE DESCRIPTION 01520001 *A 01530001 *A OUT DATA 96-WORD RECORD TO BE WRITTEN. ANY 01540001 *A &STMT ERROR RETURN STATEMENT NUMBER. 01550001 *A TYPE 01560001 *A 01570001 *A WRITE SEQUENTIALLY TO BUILD THE GM3DPARM FILE. 01580001 *A 01590001 *A ALL RECORDS MUST BE WRITTEN USING THE FOGMWS ENTRY BEFORE BEING 01600001 *A READ WITH FOGMRD OR REWRITTEN WITH FOGMWD. THE BSAM DCB SHOULD 01610001 *A NOT BE OPEN AT THE SAME TIME OR AFTER THE BDAM DCB IS OPENED. 01620001 *A A DIRECT READ OR WRITE ON A RECORD WHICH WAS NOT WRITTEN 01630001 *A SEQUENTIALLY WILL RESULT IN AN ABEND WITH A SYSTEM COMPLETION 01640001 *A CODE OF 001. 01650001 *A 01660001 *A AN INTERNAL SEQUENTIAL COUNTER IS USED FOR SEQUENTIAL WRITES IN 01670001 *A ORDER TO DETERMINE BLOCK AND RECORD NUMBERS. 01680001 *A 01690001 *A DD-CARD FOR PREPARATION STEP: 01700001 *A 01710001 *A //GM3DPARM DD DSN=&&GM3DPARM,UNIT=SYSDA,DCB=DSORG=DA, 01720001 *A // SPACE=(TRK,(10),CONTIG),DISP=(NEW,PASS) 01730001 *A 01740001 *A DD-CARD FOR PROCESSING STEP: 01750001 *A 01760001 *A //GM3DPARM DD DSN=&&GM3DPARM,DISP=(MOD,DELETE) 01770001 *A 01780001 *A 01790001 *AEND 01800001 EJECT 01810001 *TITLE FOGMCS -- GM3DPARM CLOSE SEQUENTIAL 01820001 *A AUTHOR RALPH E. MCMILLAN 01830001 *A DESIGNER RALPH E. MCMILLAN 01840001 *A LANGUAGE ASSEMBLER F 01850001 *A SYSTEM S/370 01860001 *A WRITTEN 11-10-82 01870001 *A 01880001 *A 01890001 *A CALL FOGMCS 01900001 *A 01910001 *A 01920001 *A WRITE THE CURRENT BUFFER IF NECESSARY AND CLOSE THE BSAM DCB OF 01930001 *A THE GM3DPARM FILE. 01940001 *AEND 01950001 EJECT 01960001 *TITLE FOGMOD -- GM3DPARM OPEN FOR DIRECT READ AND WRITE 01970001 *A AUTHOR RALPH E. MCMILLAN 01980001 *A DESIGNER RALPH E. MCMILLAN 01990001 *A LANGUAGE ASSEMBLER F 02000001 *A SYSTEM S/370 02010001 *A WRITTEN 11-10-82 02020001 *A 02030001 *A 02040001 *A CALL FOGMOD (&STMT) 02050001 *A 02060001 *A IN/OUT ARGUMENT TYPE DESCRIPTION 02070001 *A 02080001 *A &STMT ERROR RETURN STATEMENT NUMBER. 02090001 *A 02100001 *A 02110001 *A 02120001 *A OPEN THE BDAM DCB FOR DIRECT READ AND WRITE, GM3DPARM FILE. 02130001 *A IF THIS IS THE PREPARATION STEP (MAXBLK NOT = 0), THEN STORE THE 02140001 *A MAXIMUM BLOCK AND RECORD NUMBERS IN THE FIRST RECORD ON THE FILE. 02150001 *A IF THIS IS THE PROCESS STEP (MAXBLK = 0), THEN RETRIEVE THE 02160001 *A MAXIMUM BLOCK AND RECORD NUMBERS FROM THE FIRST RECORD ON THE 02170001 *A FILE. 02180001 *A 02190001 *A ALL RECORDS MUST BE WRITTEN USING THE FOGMWS ENTRY BEFORE BEING 02200001 *A READ WITH FOGMRD OR REWRITTEN WITH FOGMWD. THE BSAM DCB SHOULD 02210001 *A NOT BE OPEN AT THE SAME TIME OR AFTER THE BDAM DCB IS OPENED. 02220001 *A A DIRECT READ OR WRITE ON A RECORD WHICH WAS NOT WRITTEN 02230001 *A SEQUENTIALLY WILL RESULT IN AN ABEND WITH A SYSTEM COMPLETION 02240001 *A CODE OF 001. 02250001 *A 02260001 *A DD-CARD FOR PREPARATION STEP: 02270001 *A 02280001 *A //GM3DPARM DD DSN=&&GM3DPARM,UNIT=SYSDA,DCB=DSORG=DA, 02290001 *A // SPACE=(TRK,(10),CONTIG),DISP=(NEW,PASS) 02300001 *A 02310001 *A DD-CARD FOR PROCESSING STEP: 02320001 *A 02330001 *A //GM3DPARM DD DSN=&&GM3DPARM,DISP=(MOD,DELETE) 02340001 *A 02350001 *A 02360001 *AEND 02370001 EJECT 02380001 *TITLE FOGMRD -- GM3DPARM READ TRACE HEADER DIRECT 02390001 *A AUTHOR RALPH E. MCMILLAN 02400001 *A DESIGNER RALPH E. MCMILLAN 02410001 *A LANGUAGE ASSEMBLER F 02420001 *A LANGUAGE S/370 02430001 *A WRITTEN 11-10-82 02440001 *A 02450001 *A 02460001 *A CALL FOGMRD (DATA, DA, &STMT) 02470001 *A 02480001 *A IN/OUT ARGUMENT TYPE DESCRIPTION 02490001 *A 02500001 *A OUT DATA ANY 96-WORD AREA TO READ RECORD INTO. 02510001 *A IN/OUT DA I4 RELATIVE RECORD NUMBER. RETURNED AS 02520001 *A DA + 1. 02530001 *A &STMT ERROR RETURN STATEMENT NUMBER. 02540001 *A 02550001 *A 02560001 *A THE RELATIVE RECORD NUMBER IS CONVERTED TO A BLOCK AND RECORD 02570001 *A NUMBER. THE BLOCK IS READ INTO THE CURRENT BUFFER AND THE 02580001 *A APPROPRIATE RECORD IS RETURNED IN DATA. THE NEXT RELATIVE RECORD 02590001 *A NUMBER IS RETURNED IN DA. 02600001 *A 02610001 *A ALL RECORDS MUST BE WRITTEN USING THE FOGMWS ENTRY BEFORE BEING 02620001 *A READ WITH FOGMRD OR REWRITTEN WITH FOGMWD. THE BSAM DCB SHOULD 02630001 *A NOT BE OPEN AT THE SAME TIME OR AFTER THE BDAM DCB IS OPENED. 02640001 *A A DIRECT READ OR WRITE ON A RECORD WHICH WAS NOT WRITTEN 02650001 *A SEQUENTIALLY WILL RESULT IN AN ABEND WITH A SYSTEM COMPLETION 02660001 *A CODE OF 001. 02670001 *A 02680001 *A DD-CARD FOR PREPARATION STEP: 02690001 *A 02700001 *A //GM3DPARM DD DSN=&&GM3DPARM,UNIT=SYSDA,DCB=DSORG=DA, 02710001 *A // SPACE=(TRK,(10),CONTIG),DISP=(NEW,PASS) 02720001 *A 02730001 *A DD-CARD FOR PROCESSING STEP: 02740001 *A 02750001 *A //GM3DPARM DD DSN=&&GM3DPARM,DISP=(MOD,DELETE) 02760001 *A 02770001 *A 02780001 * USER ABEND CODES: 333 - BSAM DCB OPEN NOT COMPLETED. DD MISSING. 02790001 * 334 - BDAM DCB OPEN NOT COMPLETED. DD MISSING. 02800001 * 336 - INVALID DATE IN PACKED FILE. 02810001 *AEND 02820001 EJECT 02830001 *TITLE FOGMWD -- GM3DPARM WRITE TRACE HEADER DIRECT 02840001 *A AUTHOR RALPH E. MCMILLAN 02850001 *A DESIGNER RALPH E. MCMILLAN 02860001 *A LANGUAGE ASSEMBLER F 02870001 *A LANGUAGE S/370 02880001 *A WRITTEN 11-10-82 02890001 *A 02900001 *A 02910001 *A CALL FOGMWD (DATA, DA, &STMT) 02920001 *A 02930001 *A IN/OUT ARGUMENT TYPE DESCRIPTION 02940001 *A 02950001 *A OUT DATA ANY 96-WORD AREA TO BE WRITTEN. 02960001 *A IN/OUT DA I4 RELATIVE RECORD NUMBER. RETURNED AS 02970001 *A DA + 1. 02980001 *A &STMT ERROR RETURN STATEMENT NUMBER. 02990001 *A 03000001 *A 03010001 *A THE RELATIVE RECORD NUMBER IS CONVERTED TO A BLOCK AND RECORD 03020001 *A NUMBER. IF THE BLOCK NUMBER DOES NOT AGREE WITH THE CURRENT 03030001 *A BLOCK IN THE WRITE BUFFER, THE CORRECT BLOCK IS READ DIRECT 03040001 *A FROM THE DISK. THE RECORD IS THEN MOVED INTO ITS APPROPRIATE 03050001 *A PLACE. THE NEXT SEQUENTIAL RECORD NUMBER IS RETURNED IN DA. 03060001 *A 03070001 *A ALL RECORDS MUST BE WRITTEN USING THE FOGMWS ENTRY BEFORE BEING 03080001 *A READ WITH FOGMRD OR REWRITTEN WITH FOGMWD. THE BSAM DCB SHOULD 03090001 *A NOT BE OPEN AT THE SAME TIME OR AFTER THE BDAM DCB IS OPENED. 03100001 *A A DIRECT READ OR WRITE ON A RECORD WHICH WAS NOT WRITTEN 03110001 *A SEQUENTIALLY WILL RESULT IN AN ABEND WITH A SYSTEM COMPLETION 03120001 *A CODE OF 001. 03130001 *A 03140001 *A DD-CARD FOR PREPARATION STEP: 03150001 *A 03160001 *A //GM3DPARM DD DSN=&&GM3DPARM,UNIT=SYSDA,DCB=DSORG=DA, 03170001 *A // SPACE=(TRK,(10),CONTIG),DISP=(NEW,PASS) 03180001 *A 03190001 *A DD-CARD FOR PROCESSING STEP: 03200001 *A 03210001 *A //GM3DPARM DD DSN=&&GM3DPARM,DISP=(MOD,DELETE) 03220001 *A 03230001 *A 03240001 * USER ABEND CODES: 333 - BSAM DCB OPEN NOT COMPLETED. DD MISSING. 03250001 * 334 - BDAM DCB OPEN NOT COMPLETED. DD MISSING. 03260001 * 334 - BDAM DCB OPEN NOT COMPLETED. DD MISSING. 03270001 *AEND 03280001 EJECT 03290001 *TITLE FOGMCD -- GM3DPARM CLOSE DIRECT ACCESS 03300001 *A AUTHOR RALPH E. MCMILLAN 03310001 *A DESIGNER RALPH E. MCMILLAN 03320001 *A LANGUAGE ASSEMBLER F 03330001 *A LANGUAGE S/370 03340001 *A WRITTEN 11-10-82 03350001 *A 03360001 *A 03370001 *A CALL FOGMCD 03380001 *A 03390001 *A 03400001 *A WRITE THE CURRENT BUFFER IF NECESSARY AND CLOSE THE BDAM DCB OF 03410001 *A THE GM3DPARM FILE. 03420001 *AEND 03430001 SPACE 3 03440001 *DWD1 03450001 EXTRN USTHPK,USTHUP 03460001 * 03470001 PRINT GEN 03480001 FOGM3D MENTRYPT 2,(FOGMOS,FOGMWS,FOGMCS,FOGMOD,FOGMRD,FOGMWD, X03490001 FOGMCD) 03500001 EJECT 03510001 R0 EQU 0 03520001 R1 EQU 1 03530001 R2 EQU 2 ADDRESS OF DATA. 03540001 R3 EQU 3 03550001 R4 EQU 4 03560001 R5 EQU 5 03570001 R6 EQU 6 03580001 R7 EQU 7 03590001 R8 EQU 8 03600001 R9 EQU 9 03610001 R10 EQU 10 ADDRESS OF DATA CONTROL BLOCK. 03620001 R11 EQU 11 BAL TO INTERNAL SUB. BOR TO RETURN. 03630001 R12 EQU 12 BASE ADDRESS (SAVEAREA). 03640001 R13 EQU 13 03650001 R14 EQU 14 03660001 R15 EQU 15 03670001 SPACE 3 03680001 * 03690001 * R6 = BASE REGISTER ADDRESS OF COMMON P. 03700001 * R12 = BASE REGISTER. 03710001 * R13 = ADDRESS OF SAVE AREA. 03720001 * 03730001 LR R12,R13 USE R12 AS BASE REGISTER 03740001 DROP R13 TO REDUCE COMPLICATIONS 03750001 USING SAVEAREA,R12 IN SYNAD EXIT. 03760001 USING IHADCB,R10 R10 = ADDRESS OF DATA CONTROL BLOCK. 03770001 L R6,=V(P) R6 = ADDRESS OF COMMON P AREA, USED TO 03780001 USING PDSECT,R6 COUNT I/O OF EACH PROCESS. 03790001 * 03800001 **************** ADDRESSING MODE SWITCH ****************** EXT 03810001 FOGM3D AMODE ANY EXT 03820001 FOGM3D RMODE 24 EXT 03830001 B *(R2) 03840001 B OPENSQ 03850001 B WRITESQ 03860001 B CLOSESQ 03870001 B OPENDR 03880001 B READDR 03890001 B WRITEDR 03900001 B CLOSEDR 03910001 EJECT 03920001 ***************************************************************** 03930001 * 03940001 * OPEN BSAM DCB 03950001 * 03960001 ***************************************************************** 03970001 OPENSQ LA R10,BSAMDCB 03980001 TM DCBOFLGS,X'10' 03990001 BO RETURN 04000001 * 04010001 **D 04020001 **D OPEN (PRTDCB,(OUTPUT)) 04030001 * 04040001 * 04050001 LA R11,RETURN 04060001 OPENBSAM DS 0H 04070003 * 04080001 LA R5,FOISXX2 CHANGE TO 24 BIT ADDR & SAVE OLD 04090001 LA R4,FOISXX1 04100001 BSM R5,R4 04110001 FOISXX1 DS 0H 04120001 * 04130001 OPEN (BSAMDCB,(OUTPUT)) 04140003 * 04150001 BSM 0,R5 CHANGE BACK TO INPUT AMODE 04160001 FOISXX2 DS 0H 04170001 * 04180001 L R5,BLKSIZ CALCULATE NUMBER OF RECORDS/BLOCK 04190001 SR R4,R4 04200001 D R4,LRECL 04210001 ST R5,NREC 04220001 BCTR R5,0 04230001 ST R5,NRECM1 04240001 TM DCBOFLGS,X'10' 04250001 BOR R11 04260001 B ERRRET 04270001 EJECT 04280001 ***************************************************************** 04290001 * 04300001 * SEQUENTIAL WRITE - USING BSAM DCB 04310001 * 04320001 ***************************************************************** 04330001 WRITESQ LA R10,BSAMDCB 04340001 LR R9,R1 SAVE REGISTER 1 04350001 TM DCBOFLGS,X'10' 04360001 BO *+8 04370001 BAL R11,OPENBSAM 04380001 L R2,0(,R9) A(DATA) 04390001 L R5,SEQREC 04400001 LA R5,1(,R5) RELATIVE RECORD NUMBER 04410001 ST R5,SEQREC 04420001 ST R5,SYNDSKA SAVE REL RCD # FOR ERROR MSG 04430001 SR R4,R4 04440001 A R5,NRECM1 04450001 D R4,NREC R5=BLOCK # R4=RECORD NUMBER 04460001 C R5,CBLK 04470001 BE WBUFADD 04480001 TM FLAG,X'80' DOES CURRENT BLOCK NEED WRITTEN 04490001 BNO CHKBLK 04500001 * 04510001 LA R11,FOWSXX2 CHANGE TO 24 BIT ADDR & SAVE OLD 04520001 LA R3,FOWSXX1 04530001 BSM R11,R3 04540001 FOWSXX1 DS 0H 04550001 * 04560001 WRITE BSMWDEC1,SF,BSAMDCB,BUFFER,'S' 04570001 CHECK BSMWDEC1 04580001 * 04590001 BSM 0,R11 CHANGE BACK TO INPUT AMODE 04600001 FOWSXX2 DS 0H 04610001 * 04620001 *DWD1 04630001 ** 04640001 ** GO COUNT THIS I/O 04650001 ** 04660001 BAL R14,COUNT ACCUMULATE I/O COUNT 04670001 ** 04680001 L R3,CBLK SAVE MAX BLOCK NUMBER 04690001 ST R3,MAXBLK 04700001 * 04710001 * 04720001 **D L R3,ABUFFER 04730001 **D MVC BUF+1(132),0(R3) 04740001 **D PUT PRTDCB,BUF 04750001 **D A R3,=F'9568' 04760001 **D MVC BUF+1(132),0(R3) 04770001 **D PUT PRTDCB,BUF 04780001 * 04790001 * 04800001 NI FLAG,X'7F' TURN OFF WRITE FLAG 04810001 CHKBLK ST R5,CBLK 04820001 WBUFADD LR R5,R4 CALCULATE ADDRESS FOR NEW DATA 04830001 L R3,LRECL 04840001 MR R4,R3 04850001 A R5,ABUFFER 04860001 LR R4,R5 04870001 LR R5,R3 04880001 * 04890001 * 04900001 **D MVI BUF+1,C' ' 04910001 **D MVI BUF+2,C' ' 04920001 **D MVC BUF+3(130),0(R2) 04930001 **D PUT PRTDCB,BUF 04940001 * 04950001 * 04960001 *DWD1 04970001 * R2 = ADDRESS OF TRACE HEADER 04980001 * R3 = LENGTH OF TRACE HEADER(NOT USED BY USTHPK) 04990001 * R4 = ADDRESS OF BLOCK 05000001 * R5 = LENGTH OF TRACE HEADER(NOT USED BY USTHPK) 05010001 * R13= ADDRESS REGISTER SAVE AREA 05020001 * R15= ADDRESS OF TRACE HEADER PACK SUBROUTINE 05030001 LA R13,SAVEAREA 05040001 ST R2,TRACE SAVE ADDRESS OF TRACE IN PARM LIST 05050001 STCM R4,7,BLOCK SAVE ADDRESS OF BLOCK IN PARM LIST 05060001 LA R1,CALLPARM GET ADDRESS OF PARM LIST 05070001 L R15,AUSTHPK GET ADDRESS OF COMPRESS ROUTINE 05080001 BALR R14,R15 MOVE COMPRESSED HEADER INTO BLOK 05090001 * 05100001 OI FLAG,X'80' SET FLAG TO WRITE BLOCK 05110001 B RETURN 05120001 EJECT 05130001 ***************************************************************** 05140001 * 05150001 * CLOSE BSAM DCB 05160001 * 05170001 **************************************************************** 05180001 CLOSESQ LA R10,BSAMDCB 05190001 TM DCBOFLGS,X'10' 05200001 BZ RETURN 05210001 TM FLAG,X'80' DOES WRITE BUFFER NEED WRITTEN? 05220001 BNO CLOSESQ1 05230001 * 05240001 LA R11,FOCSXX2 CHANGE TO 24 BIT ADDR & SAVE OLD 05250001 LA R3,FOCSXX1 05260001 BSM R11,R3 05270001 FOCSXX1 DS 0H 05280001 * 05290001 WRITE BSMWDEC2,SF,BSAMDCB,BUFFER,'S' 05300001 CHECK BSMWDEC2 05310001 * 05320001 BSM 0,R11 05330001 FOCSXX2 DS 0H CHANGE BACK TO INPUT AMODE 05340001 * 05350001 *DWD1 05360001 ** 05370001 ** GO COUNT THIS I/O 05380001 ** 05390001 BAL R14,COUNT ACCUMULATE I/O COUNT 05400001 ** 05410001 L R3,CBLK SAVE MAX BLOCK NUMBER 05420001 ST R3,MAXBLK 05430001 NI FLAG,X'7F' TURN OFF WRITE FLAG 05440001 CLOSESQ1 DS 0H 05450001 * 05460001 LA R11,FOCSXX4 CHANGE TO 24 BIT ADDR & SAVE OLD 05470001 LA R3,FOCSXX3 05480001 BSM R11,R3 05490001 FOCSXX3 DS 0H 05500001 * 05510001 CLOSE (BSAMDCB) 05520002 * 05530001 BSM 0,R11 CHANGE BACK TO INPUT AMODE 05540001 FOCSXX4 DS 0H 05550001 * 05560001 B RETURN 05570001 EJECT 05580001 ************************************************************** 05590001 * 05600001 * OPEN BDAM DCB 05610001 * 05620001 ************************************************************** 05630001 OPENDR LA R10,BDAMDCB 05640001 TM DCBOFLGS,X'10' 05650001 BO RETURN 05660001 LA R11,RETURN 05670001 **D 05680001 **D OPEN (PRTDCB,(OUTPUT)) 05690001 *D68 05700001 OPENBDAM DS 0H 05710001 * 05720001 LA R5,FOIDXX2 CHANGE TO 24 BIT ADDR & SAVE OLD 05730001 LA R3,FOIDXX1 05740001 BSM R5,R3 05750001 FOIDXX1 DS 0H 05760001 * 05770001 TM DCBDSORG,DCBDSGDA D68 05780001 BZ OPENBDM1 NOT DSORG=DA D68 05790001 TM DCBOPTCD,DCBOPTRB D68 05800001 BZ OPENBDM1 REL BLK ADDR NOT SPEC D68 05810001 ** OPEN SHADOW ELEMENT FOR ABS ADDR TYPE BDAM. D69 05820001 OPEN (BDAMABS,(UPDAT)) OPEN ABSOLUTE DCB D69 05830001 *D68 05840001 OPENBDM1 OPEN (BDAMDCB,(UPDAT)) OPEN RELATIVE DCB 05850001 * 05860001 BSM 0,R5 05870001 FOIDXX2 DS 0H CHANGE BACK TO INPUT AMODE 05880001 * 05890001 L R5,BLKSIZ COMPUTE NUMBER OF RECORDS/BLOCK 05900001 SR R4,R4 05910001 D R4,LRECL 05920001 ST R5,NREC 05930001 BCTR R5,0 05940001 ST R5,NRECM1 05950001 TM DCBOFLGS,X'10' 05960001 BNO ERRRET 05970001 LA R5,1 READ FIRST BLOCK FROM FILE 05980001 ST R5,CBLK 05990001 BCTR R5,0 06000001 ST R5,BLKREF 06010001 * 06020003 LA R4,FOIDXX4 CHANGE TO 24 BIT ADDR & SAVE OLD 06030003 LA R3,FOIDXX3 06040003 BSM R4,R3 06050003 FOIDXX3 DS 0H 06060003 * 06070003 LA R5,BLKREF+1 06080001 READ BDMRDEC1,DI,(R10),BUFFER,'S',0,(R5) 06090001 *D68 06100001 ORG *-2 CANCEL BALR D68 06110001 LA R0,BLKREF2 LOC TO PUT MBBCCHHR D68 06120001 LR R5,R0 SAVE FOR LATER D68 06130001 L R15,=V(USRBCT) TRK O'FLOW CONVERT MODULE D68 06140001 TM DCBRECFM,DCBRECTO D68 06150001 BO READDIR1 IT IS TRACKS O'FLOW D68 06160001 L R15,=V(USRBCN) NON TRACK O'FLOW MODULE D68 06170001 READDIR1 BALR R14,R15 CALL CONVERT ROUTINE D68 06180001 * NOW DO THE REAL READ WITH MBBCCHHR TYPE CALL D69 06190001 READ BDMRDEC1,DI,BDAMABS,,,,(R5),MF=E D69 06200001 *D68 06210001 CHECK BDMRDEC1 06220001 * 06230001 BSM 0,R4 06240001 FOIDXX4 DS 0H CHANGE BACK TO INPUT AMODE 06250001 * 06260001 *DWD1 06270001 ** 06280001 ** GO COUNT THIS I/O 06290001 ** 06300001 BAL R14,COUNT ACCUMULATE I/O COUNT 06310001 ** 06320001 L R4,MAXBLK CHECK FOR STORING OR RETRIEVING 06330001 LTR R4,R4 MAX RECORD AND BLOCK NUMBERS 06340001 BZ INIT MUST RETRIEVE NUMBERS 06350001 ST R4,BUFFER STORE NUMBERS IN RECORD AND WRITE 06360001 L R4,SEQREC IT BACK TO DISK 06370001 ST R4,BUFFER+4 06380001 L R5,CBLK 06390001 BCTR R5,0 SUBTRACT 1 FOR REAL BLOCK NUMBER 06400001 ST R5,BLKREF 06410001 * 06420003 LA R4,FOIDXX6 CHANGE TO 24 BIT ADDR & SAVE OLD 06430003 LA R3,FOIDXX5 06440003 BSM R4,R3 06450003 FOIDXX5 DS 0H 06460003 * 06470003 LA R5,BLKREF+1 06480001 WRITE BDMWDEC1,DI,(R10),BUFFER,'S',0,(R5) 06490001 *D68 06500001 ORG *-2 CANCEL BALR D68 06510001 LA R0,BLKREF2 LOC TO PUT MBBCCHHR D68 06520001 LR R5,R0 SAVE FOR LATER D68 06530001 L R15,=V(USRBCT) TRK O'FLOW CONVERT MODULE D68 06540001 TM DCBRECFM,DCBRECTO D68 06550001 BO WRITDIR1 IT IS TRACKS O'FLOW D68 06560001 L R15,=V(USRBCN) NON TRACK O'FLOW MODULE D68 06570001 WRITDIR1 BALR R14,R15 CALL CONVERT ROUTINE D68 06580001 * NOW DO THE REAL WRITE WITH MBBCCHHR TYPE CALL D68 06590001 WRITE BDMWDEC1,DI,BDAMABS,,,,(R5),MF=E D69 06600001 *D68 06610001 CHECK BDMWDEC1 06620001 * 06630001 BSM 0,R4 06640001 FOIDXX6 DS 0H CHANGE BACK TO INPUT AMODE 06650001 * 06660001 *DWD1 06670001 ** 06680001 ** GO COUNT THIS I/O 06690001 ** 06700001 BAL R14,COUNT ACCUMULATE I/O COUNT 06710001 ** 06720001 B WFLGOFF 06730001 INIT L R4,BUFFER RETRIEVE MAX RECORD AND BLOCK 06740001 ST R4,MAXBLK NUMBERS FROM FIRST RECORD 06750001 L R4,BUFFER+4 06760001 ST R4,SEQREC 06770001 WFLGOFF NI FLAG,X'7F' TURN OFF WRITE FLAG 06780001 BR R11 06790001 B ERRRET 06800001 EJECT 06810001 ************************************************************** 06820001 * 06830001 * RANDOM READ - USE BDAM DCB 06840001 * 06850001 ************************************************************** 06860001 READDR LA R10,BDAMDCB 06870001 LR R9,R1 SAVE REGISTER 1 06880001 TM DCBOFLGS,X'10' 06890001 BO *+8 06900001 BAL R11,OPENBDAM 06910001 L R2,0(,R9) A(BUFFER) 06920001 L R4,4(,R9) A(RECORD NUMBER) 06930001 L R5,0(,R4) RELATIVE RECORD NUMBER 06940001 ST R5,SYNDSKA SAVE IT FOR ERROR MSG 06950001 LA R5,1(,R5) ADD 1 TO GET REAL RECORD NUMBER 06960001 C R5,SEQREC IS IT IN RANGE 06970001 BH ERRRET NO 06980001 ST R5,0(,R4) RETURN IT AS NEXT SEQ NUMBER 06990001 SR R4,R4 07000001 A R5,NRECM1 07010001 D R4,NREC R5=BLOCK # R4=RECORD NUMBER 07020001 C R5,CBLK IS BLOCK IN CURRENT BUFFER? 07030001 BE RBUFMV YES 07040001 TM FLAG,X'80' BLOCK NEED WRITTEN BEFORE READ? 07050001 BNO READBDAM NO 07060001 L R3,CBLK YES - SO WRITE BLOCK FIRST 07070001 BCTR R3,0 07080001 ST R3,BLKREF 07090001 * 07100003 LA R8,FORDXX2 CHANGE TO 24 BIT ADDR & SAVE OLD 07110003 LA R7,FORDXX1 07120003 BSM R8,R7 07130003 FORDXX1 DS 0H 07140003 * 07150003 LA R3,BLKREF+1 07160001 WRITE BDMWDEC2,DI,(R10),BUFFER,'S',0,(R3) 07170001 *D68 07180001 ORG *-2 CANCEL BALR D68 07190001 LA R0,BLKREF2 LOC TO PUT MBBCCHHR D68 07200001 LR R3,R0 SAVE FOR LATER D68 07210001 L R15,=V(USRBCT) TRK O'FLOW CONVERT MODULE D68 07220001 TM DCBRECFM,DCBRECTO D68 07230001 BO WRITDIR2 IT IS TRACKS O'FLOW D68 07240001 L R15,=V(USRBCN) NON TRACK O'FLOW MODULE D68 07250001 WRITDIR2 BALR R14,R15 CALL CONVERT ROUTINE D68 07260001 * NOW DO THE REAL WRITE WITH MBBCCHHR TYPE CALL D68 07270001 WRITE BDMWDEC2,DI,BDAMABS,,,,(R3),MF=E D69 07280001 *D68 07290001 CHECK BDMWDEC2 07300001 * 07310001 BSM 0,R8 07320001 FORDXX2 DS 0H CHANGE BACK TO INPUT AMODE 07330001 * 07340001 *DWD1 07350001 ** 07360001 ** GO COUNT THIS I/O 07370001 ** 07380001 BAL R14,COUNT ACCUMULATE I/O COUNT 07390001 ** 07400001 NI FLAG,X'7F' TURN OFF WRITE FLAG 07410001 * 07420001 READBDAM ST R5,CBLK NOW - SAVE CURRENT BLOCK # AND 07430001 BCTR R5,0 READ THE BLOCK 07440001 ST R5,BLKREF 07450001 * 07460003 LA R8,FORDXX4 CHANGE TO 24 BIT ADDR & SAVE OLD 07470003 LA R7,FORDXX3 07480003 BSM R8,R7 07490003 FORDXX3 DS 0H 07500003 * 07510003 LA R5,BLKREF+1 07520001 READ BDMRDEC2,DI,(R10),BUFFER,'S',0,(R5) 07530001 *D68 07540001 ORG *-2 CANCEL BALR D68 07550001 LA R0,BLKREF2 LOC TO PUT MBBCCHHR D68 07560001 LR R5,R0 SAVE FOR LATER D68 07570001 L R15,=V(USRBCT) TRK O'FLOW CONVERT MODULE D68 07580001 TM DCBRECFM,DCBRECTO D68 07590001 BO READDIR2 IT IS TRACKS O'FLOW D68 07600001 L R15,=V(USRBCN) NON TRACK O'FLOW MODULE D68 07610001 READDIR2 BALR R14,R15 CALL CONVERT ROUTINE D68 07620001 * NOW DO THE REAL READ WITH MBBCCHHR TYPE CALL D68 07630001 READ BDMRDEC2,DI,BDAMABS,,,,(R5),MF=E D69 07640001 *D68 07650001 CHECK BDMRDEC2 07660001 * 07670003 BSM 0,R8 07680003 FORDXX4 DS 0H CHANGE BACK TO INPUT AMODE 07690003 * 07700003 * 07710001 *DWD1 07720001 ** 07730001 ** GO COUNT THIS I/O 07740001 ** 07750001 BAL R14,COUNT ACCUMULATE I/O COUNT 07760001 ** 07770001 RBUFMV LR R5,R4 RECORD NUMBER 07780001 L R3,LRECL 07790001 MR R4,R3 07800001 LA R4,BUFFER(R5) 07810001 LR R5,R3 07820001 * 07830001 **D 07840001 **D MVI BUF+1,C' ' 07850001 **D MVC BUF+2(131),0(R4) 07860001 **D PUT PRTDCB,BUF 07870001 * 07880001 * 07890001 *DWD1 07900001 LA R13,SAVEAREA 07910001 ST R2,TRACE1 SAVE ADDRESS OF TRACE IN PARM LIST 07920001 ST R4,BLOCK1 SAVE ADDRESS OF BLOCK IN PARM LIST 07930001 LA R1,CALLPRM1 GET ADDRESS OF PARM LIST 07940001 L R15,AUSTHUP GET ADDRESS OF UNPACK ROUTINE 07950001 BALR R14,R15 MOVE HEADER FROM BLOCK 07960001 * 07970001 L R4,SFLAG GET RETURN CODE 07980001 LTR R4,R4 TEST IF ERROR 07990001 BZ RETURN 08000001 ABEND 336 ERROR - DATE GIVEN FOR TRACE HEADER 08010001 B RETURN 08020001 EJECT 08030001 **************************************************************** 08040001 * 08050001 * RANDOM WRITE - USE BDAM DCB 08060001 * 08070001 **************************************************************** 08080001 WRITEDR LA R10,BDAMDCB 08090001 TM DCBOFLGS,X'10' 08100001 BO *+8 08110001 BAL R11,OPENBDAM 08120001 L R2,0(,R1) A(BUFFER) 08130001 L R4,4(,R1) A(RECORD NUMBER) 08140001 L R5,0(,R4) RELATIVE RECORD NUMBER 08150001 ST R5,SYNDSKA SAVE IT FOR ERROR MSG 08160001 LA R5,1(,R5) ADD 1 TO GET REAL RECORD NUMBER 08170001 C R5,SEQREC IS IT IN RANGE 08180001 BH ERRRET NO 08190001 ST R5,0(,R4) RETURN IT AS NEXT SEQ NUMBER 08200001 SR R4,R4 08210001 A R5,NRECM1 08220001 D R4,NREC R5=BLOCK # R4=RECORD # 08230001 C R5,CBLK DOES RECORD BELONG IN CURRENT BUFFER 08240001 BE RECMV YES 08250001 TM FLAG,X'80' BLOCK NEED WRITTEN? 08260001 BNO WRBDAM 08270001 L R3,CBLK 08280001 BCTR R3,0 08290001 ST R3,BLKREF 08300001 * 08310003 LA R8,FOWDXX2 CHANGE TO 24 BIT ADDR & SAVE OLD 08320003 LA R7,FOWDXX1 08330003 BSM R8,R7 08340003 FOWDXX1 DS 0H 08350003 * 08360003 LA R3,BLKREF+1 08370001 WRITE BDMWDEC3,DI,(R10),BUFFER,'S',0,(R3) 08380001 *D68 08390001 ORG *-2 CANCEL BALR D68 08400001 LA R0,BLKREF2 LOC TO PUT MBBCCHHR D68 08410001 LR R3,R0 SAVE FOR LATER D68 08420001 L R15,=V(USRBCT) TRK O'FLOW CONVERT MODULE D68 08430001 TM DCBRECFM,DCBRECTO D68 08440001 BO WRITDIR3 IT IS TRACKS O'FLOW D68 08450001 L R15,=V(USRBCN) NON TRACK O'FLOW MODULE D68 08460001 WRITDIR3 BALR R14,R15 CALL CONVERT ROUTINE D68 08470001 * NOW DO THE REAL WRITE WITH MBBCCHHR TYPE CALL D68 08480001 WRITE BDMWDEC3,DI,BDAMABS,,,,(R3),MF=E D69 08490001 *D68 08500001 CHECK BDMWDEC3 08510001 * 08520003 BSM 0,R8 08530003 FOWDXX2 DS 0H CHANGE BACK TO INPUT AMODE 08540003 * 08550003 *DWD1 08560001 ** 08570001 ** GO COUNT THIS I/O 08580001 ** 08590001 BAL R14,COUNT ACCUMULATE I/O COUNT 08600001 ** 08610001 SPACE 08620001 **D 08630001 **D L R3,ABUFFER 08640001 **D MVC BUF+1(4),=C'RWD ' 08650001 **D MVC BUF+5(128),0(R3) 08660001 **D PUT PRTDCB,BUF 08670001 **D A R3,=F'9568' 08680001 **D MVC BUF+5(128),0(R3) 08690001 **D PUT PRTDCB,BUF 08700001 **D 08710001 SPACE 2 08720001 WRBDAM ST R5,CBLK READ DIRECT FROM FILE 08730001 BCTR R5,0 08740001 ST R5,BLKREF 08750001 * 08760003 LA R8,FOWDXX4 CHANGE TO 24 BIT ADDR & SAVE OLD 08770003 LA R7,FOWDXX3 08780003 BSM R8,R7 08790003 FOWDXX3 DS 0H 08800003 * 08810003 LA R5,BLKREF+1 08820001 READ BDMRDEC3,DI,(R10),BUFFER,'S',0,(R5) 08830001 *D68 08840001 ORG *-2 CANCEL BALR D68 08850001 LA R0,BLKREF2 LOC TO PUT MBBCCHHR D68 08860001 LR R5,R0 SAVE FOR LATER D68 08870001 L R15,=V(USRBCT) TRK O'FLOW CONVERT MODULE D68 08880001 TM DCBRECFM,DCBRECTO D68 08890001 BO READDIR3 IT IS TRACKS O'FLOW D68 08900001 L R15,=V(USRBCN) NON TRACK O'FLOW MODULE D68 08910001 READDIR3 BALR R14,R15 CALL CONVERT ROUTINE D68 08920001 * NOW DO THE REAL READ WITH MBBCCHHR TYPE CALL D68 08930001 READ BDMRDEC3,DI,BDAMABS,,,,(R5),MF=E D69 08940001 *D68 08950001 CHECK BDMRDEC3 08960001 * 08970003 BSM 0,R8 08980003 FOWDXX4 DS 0H CHANGE BACK TO INPUT AMODE 08990003 * 09000003 *DWD1 09010001 ** 09020001 ** GO COUNT THIS I/O 09030001 ** 09040001 BAL R14,COUNT ACCUMULATE I/O COUNT 09050001 ** 09060001 **D 09070001 **D L R3,ABUFFER 09080001 **D MVC BUF+1(4),=C'RWR ' 09090001 **D MVC BUF+5(128),0(R3) 09100001 **D PUT PRTDCB,BUF 09110001 **D A R3,=F'9568' 09120001 **D MVC BUF+5(128),0(R3) 09130001 **D PUT PRTDCB,BUF 09140001 * 09150001 RECMV LR R5,R4 CALCULATE ADDRESS FOR RECORD 09160001 L R3,LRECL 09170001 MR R4,R3 09180001 LA R4,BUFFER(R5) 09190001 LR R5,R3 09200001 **D 09210001 **D MVC BUF+1(3),=C'RW ' 09220001 **D MVC BUF+4(129),0(R2) 09230001 **D PUT PRTDCB,BUF 09240001 * 09250001 *DWD1 09260001 * R2 = ADDRESS OF TRACE HEADER 09270001 * R3 = LENGTH OF TRACE HEADER(NOT USED BY USTHPK) 09280001 * R4 = ADDRESS OF BLOCK 09290001 * R5 = LENGTH OF TRACE HEADER(NOT USED BY USTHPK) 09300001 * R13= ADDRESS REGISTER SAVE AREA 09310001 * R15= ADDRESS OF TRACE HEADER PACK SUBROUTINE 09320001 LA R13,SAVEAREA 09330001 ST R2,TRACE SAVE ADDRESS OF TRACE IN PARM LIST 09340001 STCM R4,7,BLOCK SAVE ADDRESS OF BLOCK IN PARM LIST 09350001 LA R1,CALLPARM GET ADDRESS OF PARM LIST 09360001 L R15,AUSTHPK GET ADDRESS OF COMPRESS ROUTINE 09370001 BALR R14,R15 MOVE COMPRESSED HEADER INTO BLOK 09380001 * 09390001 OI FLAG,X'80' SET WRITE FLAG 09400001 B RETURN 09410001 EJECT 09420001 **************************************************************** 09430001 * 09440001 * CLOSE BDAM DCB 09450001 * 09460001 **************************************************************** 09470001 CLOSEDR LA R10,BDAMDCB 09480001 TM DCBOFLGS,X'10' 09490001 BZ RETURN 09500001 TM FLAG,X'80' DOES CURRENT BUFFER NEED WRITTEN? 09510001 BNO CLOSEBD1 09520001 L R3,CBLK 09530001 BCTR R3,0 WRITE RECORD DIRECT 09540001 ST R3,BLKREF 09550001 * 09560003 LA R8,FOCDXX2 CHANGE TO 24 BIT ADDR & SAVE OLD 09570003 LA R7,FOCDXX1 09580003 BSM R8,R7 09590003 FOCDXX1 DS 0H 09600003 * 09610003 LA R3,BLKREF+1 09620001 WRITE BDMWDEC4,DI,(R10),BUFFER,'S',0,(R3) 09630001 *D68 09640001 ORG *-2 CANCEL BALR D68 09650001 LA R0,BLKREF2 LOC TO PUT MBBCCHHR D68 09660001 LR R3,R0 SAVE FOR LATER D68 09670001 L R15,=V(USRBCT) TRK O'FLOW CONVERT MODULE D68 09680001 TM DCBRECFM,DCBRECTO D68 09690001 BO WRITDIR4 IT IS TRACKS O'FLOW D68 09700001 L R15,=V(USRBCN) NON TRACK O'FLOW MODULE D68 09710001 WRITDIR4 BALR R14,R15 CALL CONVERT ROUTINE D68 09720001 * NOW DO THE REAL WRITE WITH MBBCCHHR TYPE CALL D68 09730001 WRITE BDMWDEC4,DI,BDAMABS,,,,(R3),MF=E D69 09740001 *D68 09750001 CHECK BDMWDEC4 09760001 * 09770003 BSM 0,R8 09780003 FOCDXX2 DS 0H CHANGE BACK TO INPUT AMODE 09790003 * 09800003 *DWD1 09810001 ** 09820001 ** GO COUNT THIS I/O 09830001 ** 09840001 BAL R14,COUNT ACCUMULATE I/O COUNT 09850001 ** 09860001 NI FLAG,X'7F' TURN OFF WRITE FLAG 09870001 CLOSEBD1 DS 0H 09880004 * 09890003 LA R8,FOCDXX4 CHANGE TO 24 BIT ADDR & SAVE OLD 09900003 LA R7,FOCDXX3 09910003 BSM R8,R7 09920003 FOCDXX3 DS 0H 09930003 * 09940003 CLOSE (BDAMDCB) 09950004 CLOSE (BDAMABS) CLOSE SHADOW DCB. D69 09960001 * 09970003 BSM 0,R8 09980003 FOCDXX4 DS 0H CHANGE BACK TO INPUT AMODE 09990003 * 10000003 RETURN DS 0H EXT 10010001 STDRET 10020001 SPACE 10030001 ERRRET DS 0H EXT 10040001 L R13,4(,R13) 10050001 LM R14,R12,12(R13) 10060001 LA R15,4 RETURN ERROR CODE 10070001 BR R14 10080001 EJECT 10090001 *************************************************************** 10100001 * 10110001 * SYNAD EXIT FOR INPUT/OUTPUT ERRORS. 10120001 * 10130001 *************************************************************** 10140001 BSAMERR SYNADAF ACSMETH=BSAM 10150001 B BDAMERR1 10160001 BDAMERR SYNADAF ACSMETH=BDAM 10170001 BDAMERR1 ST R14,SYNADR14 SAVE R14 FOR RETURN. 10180001 LA R1,8(,R1) SKIP FIRST 8 BYTES OF SYNADAF MESSAGE. 10190001 ST R1,SYNADMSA ESTABLISH PARAMETER LIST FOR FOPERR. 10200001 LA R1,SYNADMSA 10210001 L R15,=V(FOPERR) CALL FOPERR TO PRINT SYNADAF MESSAGE. 10220001 BALR R14,R15 10230001 SYNADRLS RELEASE SYNAD SAVE AREA. 10240001 L R14,SYNADR14 RESTORE R14 TO LEAVE SYNAD EXIT. 10250001 AB335 ABEND 335 10260001 EJECT 10270001 *DWD1 10280001 ******************************************************************** 10290001 * 10300001 * COUNT SUBROUTINE - THE COUNT SUBR WILL ADD 1 TO LOC KPWKIO 10310001 * IN KP-AREA OF COMMON P FOR EVERY I/O 10320001 * REQUEST FOR EACH PROCESS. 10330001 * 10340001 ******************************************************************** 10350001 SPACE 1 10360001 COUNT DS 0H 10370001 L R8,KPWKIO ADD 1 TO I/O COUNT 10380001 LA R8,1(R8) FOR THIS PROCESS AND 10390001 ST R8,KPWKIO SAVE IT 10400001 BR R14 RETURN 10410001 SPACE 10420001 * 10430001 EJECT 10440001 BLKREF DS F 10450001 FLAG DC F'0' 10460001 *********************************************************************** 10470001 * *** *** *** *** *** *** *** *** * 10480001 *DWD1 - NOTE: IF YOU CHANGE THE BLOCKSIZE HERE, YOU MUST ALSO CHANGE * 10490001 * IT IN THE DCB'S. * 10500001 *TJT1 - NOTE: IF YOU CHANGE THE BLOCKSIZE HERE, YOU MUST ALSO CHANGE * 10510001 * IT IN SPGEOM AS IT USES IT FOR VECTOR LENGTHS. * 10520001 * *** *** *** *** *** *** *** *** * 10530001 *********************************************************************** 10540001 LRECL DC F'256' LOGICAL RECORD LENGTH 10550001 BLKSIZ DC F'23296' BLOCK SIZE 10560001 *DWD1 - FORTRAN PRAMETER LIST FOR CALL TO USTHPK AND USTHUP 10570001 CALLPARM EQU * 10580001 TRACE DS F ADDRESS OF TRACE BUFFER 10590001 DC X'80' END OF PARM LIST FLAG 10600001 BLOCK DS AL3(0) CURRENT BLOCK POINTER 10610001 *DWD1 10620001 CALLPRM1 EQU * 10630001 TRACE1 DS F ADDRESS OF TRACE BUFFER 10640001 BLOCK1 DS F CURRENT BLOCK POINTER 10650001 REVDAT DC A(STARTDTE) POINTER TO START DATE 10660001 DC X'80' END OF PARM LIST FLAG 10670001 STATUS DC AL3(SFLAG) CURRENT BLOCK POINTER 10680001 *DWD1 10690001 *TJT1 STARTDTE DC C' 860303' START DATE 10700001 *TJT2 STARTDTE DC C' 880404' START DATE 10710001 STARTDTE DC C' 890123' START DATE 10720001 SFLAG DS F 10730001 * 10740001 NREC DS F NUMBER OF RECORDS/BLOCK (COMPUTED) 10750001 NRECM1 DS F NUMBER OF RECORDS/BLOCK-1 (COMPUTED) 10760001 SEQREC DC F'1' SEQUENCE NUMBER FOR SEQUENTIAL WRITE 10770001 CBLK DC F'0' CURRENT BLOCK NUMBER IN BUFFER 10780001 MAXBLK DC F'0' 10790001 ABUFFER DC A(BUFFER) 10800001 *DWD1 10810001 AUSTHPK DC V(USTHPK) 10820001 AUSTHUP DC V(USTHUP) 10830001 * 10840001 SYNADR14 DS F SAVE R14 FOR RETURN FROM SYNAD EXIT. 10850001 SYNADMSA DS F ADDRESS OF SYNADAF MESSAGE, PLUS 8. 10860001 SYNADRN DC A(SYNDSKA) ADDRESS OF RECORD # FOR ERROR MSG 10870001 SYNDSKA DC F'0' RCD # FOR FOPERR ERROR PRINT ROUTINE 10880001 SPACE 2 10890001 **D 10900001 **D BUF DC 133C' ' 10910001 **D PRTDCB DCB BLKSIZE=133,DDNAME=DEBUG,LRECL=133,MACRF=(PM), X 10920001 **D RECFM=FBA,DSORG=PS 10930001 * MAKE SURE X IS IN COLUMN 72 WHEN TAKING OUT "**D" 10940001 * 10950001 SPACE 2 10960001 *************************************************************** 10970001 * 10980001 * BSAM DATA CONTROL BLOCK 10990001 * 11000001 *************************************************************** 11010001 BSAMDCB DCB DSORG=PS,DDNAME=GM3DPARM,RECFM=F,LRECL=23296, X11020001 MACRF=(WL),DEVD=DA,BLKSIZE=23296,SYNAD=BSAMERR 11030001 SPACE 2 11040001 *************************************************************** 11050001 * 11060001 * BDAM DATA CONTROL BLOCK 11070001 * 11080001 *************************************************************** 11090001 BDAMDCB DCB DSORG=DA,DDNAME=GM3DPARM,RECFM=F,MACRF=(RIC,WIC), X11100001 OPTCD=RF,SYNAD=BDAMERR,BLKSIZE=23296 11110001 *************************************************************** 11120001 BDAMABS DCB DSORG=DA,DDNAME=GM3DPARM,RECFM=F,MACRF=(RIC,WIC), X11130001 OPTCD=AF,SYNAD=BDAMERR D69 11140001 *************************************************************** 11150001 *D68 11160001 BLKREF2 DC D'0' LOC TO PUT MBBCCHHR D68 11170001 LTORG , D68 11180001 PRINT NOGEN D69 11190001 DCBD DSORG=DA,DEVD=DA D69 11200001 PRINT GEN D69 11210001 *DWD1 11220001 ********************************************************************* 11230001 * 11240001 * THE FOLLOWING DSECT REPRESENTS THE LAYOUT OF COMMON P THRU 11250001 * THE KP-AREA - WHEN COMMON P IS CHANGED, THIS DSECT SHOULD 11260001 * ALSO BE CHANGED. 11270001 * 11280001 * THE FOLLOWING STATEMENT IS PLACE HERE TO AID IN PANVALET SCANS 11290001 * FOR COMMON P 11300001 * COMMON /P/ STARTP 11310001 ********************************************************************* 11320001 PDSECT DSECT 11330001 STARTP DS CL8 11340001 LCNAME DS 22F 11350001 ACNAME DS 40F 11360001 LHJBNO DS 40F 11370001 KPNA DS 33F 11380001 KPTRIO DS F 11390001 KPWKIO DS F 11400001 KPRESV DS 21F 11410001 * 11420001 *D68 11430001 *************************************************************** 11440001 *************************************************************** 11450001 FOGM3D CSECT D69 11460001 *DWD1 11470001 DS 0F'0' ALIGN ON WORD BOUNDRY 11480001 BUFFER DC 23296X'00' BUFFER TO HOLD BLOCK OF RECORDS 11490001 *************************************************************** 11500001 *************************************************************** 11510001 END 11520001