* /* START OF SPECIFICATIONS **** 00050002 *01* PROCESSOR = ASSEMXF-370R 00100002 **** END OF SPECIFICATIONS ***/ 00150002 TITLE 'IGG019VC - GET MOVE FIXED RECORDS (OCR)' 00300019 IGG019VC CSECT 00600019 *********************************************************** @YM00638 00650002 *MODULE-NAME @YM00638 00700002 * IGG019VC @YM00638 00750002 * @YM00638 00800002 *DESCRIPTIVE-NAME @YM00638 00850002 * OCR GET, MOVE MODE, FIXED RECORDS @YM00638 00860002 * @YM00638 00870002 *COPYRIGHT @YM00638 00880002 * NONE @YM00638 00890002 * @YM00638 00892002 *CHANGE-ACTIVITY @YM00638 00894002 * 00900019 * RELEASE 20 ADDITIONS/CHANGES/DELETIONS 01200020 * RELEASE 21 ADDITIONS/CHANGES/DELETIONS 01500020 * RELEASE 22 ADDITIONS/CHANGES/DELETIONS 01800020 * RELEASE 23 ADDITIONS/CHANGES/DELETIONS 02100020 * RELEASE 24 ADDITIONS/CHANGES/DELETIONS 02400020 * RELEASE 25 ADDITIONS/CHANGES/DELETIONS 02700020 * RELEASE 26 ADDITIONS/CHANGES/DELETIONS 03000020 * RELEASE 27 ADDITIONS/CHANGES/DELETIONS 03300020 * 03600019 * 03900019 * STATUS - CHANGE LEVEL 00 RELEASE 20 04200020 * 04500019 * 04800019 *FUNCTION-GET- TO MOVE A LOGICAL RECORD FROM A BUFFER TO A USER 05100019 * WORKAREA. IF THE BUFFER IS EMPTIED A NEW ONE IS ACCEPTED 05400019 * AFTER THE OLD ONE HAS BEEN SCHEDULED FOR REFILLING 05700019 * BY THE END OF BLOCK ROUTINE 06000019 * RELEASE- CAUSES THE REMAINING CONTENTS OF THE CURRENT BUFFER 06300019 * TO BE IGNORED 06600019 * 06900019 *ENTRY POINTS 07200019 * LABEL OCR010 07500019 * LABEL OCR020 07800019 * 08100019 *ENTRY INSTRUCTION SEQUENCE 08400019 * GET RELEASE 08700019 * LA 1,DCB LA 1,DCB 09000019 * L 15,48(1) L 15,48(1) 09300019 * BALR 14,15 BALR 14,8(15) 09600019 * 09900019 *INPUT FROM USER AS ADDRESSES IN FOLLOWING REGISTERS 10200019 * REG 0 USED IN MOVE MODE-CONTAINS ADDRESS OF INPUT AREA 10500019 * REG 1 DCB ADDRESS 10800019 * REG 13 WORK-SAVE ADDRESS 11100019 * REG 14 USER IN-LINE RETURN ADDRESS 11400019 * REG 15 THIS ROUTINES INITIAL BASE ADDRESS 11700019 * 12000019 *OUTPUT REGISTER ADDRESSES AS FOLLOWS 12300019 * REG 0 NOT APPLICABLE 12600019 * REG 1 RECORD ADDRESS LOCATED FOR USER 12900019 * REG 13 WORK-SAVE ADDRESS 13200019 * REG 14 RETURN ADDRESS 13500019 * REG 15 RETURN CODE 13800019 * REG 2-12 AS UPON ENTRY TO THIS ROUTINE 14100019 * 14400019 *EXTERNAL ROUTINES 14700019 * 15000019 * IGG019VE - INPUT ERROR ROUTINE WHICH DETECTS, CORRECTS DEVICE 15300019 * ERRORS AND RETURNS BLOCK OF DATA. 15600019 * IGG019CC END OF BLOCK ROUTINE WHICH SCHEDULES REQUESTS. 15900019 *EXITS 16200019 * OCR025 BRANCH TO USER,RETURNS PARAMETERS 16500019 * OCR034 BRANCH AND LINK TO END OF BLOCK ROUTINE 16800019 * OCR090 BRANCH AND LINK TO END OF BLOCK ROUTINE 17100019 * OCR040 BRANCH AND LINK TO INPUT ERROR ROUTINE 17400019 * OCR105 BRANCH TO USER, RETURNS PARAMETERS 17700019 * 18000019 *TABLES/WORKAREAS 18300019 * 18600019 * USER SAVE/WORK AREA-LAST 13 WORDS USED 18900019 * DCB 19200019 * 19500019 * IOB 19800019 * 20100019 *ATTRIBUTES---REENTRANT,REUSABLE,PROBLEM PROGRAM MODE 20400019 * 20700019 ******************************************************************* 21000019 * 21300019 * ALL REGISTER EQUATES HAVE AN 'R' AT THE END OF THE SYMBOL 21600019 * 21900019 *********************************************************************** 22200019 PARA1R EQU 1 PARAMETER REGISTER 1 22500019 BUFADR EQU 1 ADDRESS OF BUFFER 22800019 DCBR EQU 2 DCB ADDRESS 23100019 IOBADR EQU 3 IOB ADDRESS 23400019 EOBADR EQU 4 EOB ADDRESS 23700019 RECADR EQU 5 RECORD ADDRESS 24000019 LRECLR EQU 6 RECORD LENGTH 24300019 WORK3R EQU 6 WORK REGISTER 24600019 WORK1R EQU 7 WORK REGISTER 24900019 CON255R EQU 7 WORK REGISTER-CONTAINS 255 25200019 BASER EQU 8 BASE REGISTER 25500019 SAVR EQU 13 USER SAVE AREA 25800019 RETR EQU 14 RETURN ADDRESS 26100019 WORK2R EQU 14 WORK REGISTER 26400019 ENTRYR EQU 15 ENTRY ADDRESS 26700019 LNGHR EQU 15 WORK REGISTER-CONTAINS BUFFER LNGH 27000019 *********************************************************************** 27300019 EOFBIT EQU X'40' DCBORBYT-END OF FILE BIT 27600019 BUFPRIME EQU X'20' DCBORBYT-BUFFERS PRIMED BIT 27900019 ERRFLGS EQU X'3F' DCBIFLGS-DCB ERROR FLGS OFF 28200019 BUF EQU 0 OFFSET OF BUFFER ADDRESS IN CCW 28500019 CNT EQU 6 OFFSET OF COUNT IN CCW 28800019 LINECNT EQU 28 OFFSET OF LINE COUNT IN ERROR CNTRS 29100019 NOERROR EQU X'00' TESTS FOR RETURN CODE OF ZERO 29400019 C255 EQU 255 USED TO CLEAR 256 BYTES OF CORE 29700019 C256 EQU 256 USED TO INCREMENT POINTER BY 256 30000019 ADDRESS EQU 3 LENGTH OF AN ADDRESS 30300019 ONE EQU 1 USED TO INCREMENT BY 1 30600019 USERREG EQU 36 SAVE AREA OFFSET TO REG2 30900019 RETREG EQU 20 SAVE AREA OFFSET TO REG14 31200019 SAVREG EQU 20 SAVE AREA OFFSET TO STORE REGISTERS 31500019 REG0SAV EQU 28 OFFSET IN SAVE AREA FOR REGISTER 0 31800019 RELEASE EQU X'F0' USED IF BUFFER IS TO BE RELEASED 32100019 LNGH EQU 2 LENGTH OF LRECL AND BUFL 32400019 * 32700019 * 33000019 * 33300019 EJECT 33600019 USING IGG019VC,ENTRYR USE ENTRY POINT AS A BASE (REG 15) 33900019 USING IHADCB,PARA1R USE DCB ADDRESS AS A BASE (REG 1) 34200019 * 34500019 OCR010 B OCR030 BRANCH AROUND RELEASE 34800019 ZEROS DC X'00000000' FILL FOR ENTRY AT +8 - USE AS CON=0 35100019 * 35400019 OCR020 CLC DCBEOBAD+1(ADDRESS),DCBRECAD+1 END OF BLOCK YET 35700019 BCR 8,RETR YES, RETURN TO USER 36000019 OI DCBIOBA,RELEASE SET RELEASE SWITCH 36300019 OCR025 BR RETR RETURN TO USER 36600019 OCR030 STM RETR,BASER,SAVREG(SAVR) SAVE REGISTERS 36900019 * 37200019 DROP ENTRYR DROP REG 15 AS BASE FOR MODULE 37500019 DROP PARA1R DROP REG 1 AS BASE FOR DCB 37800019 USING IGG019VC,BASER NEW BASE REG ADDRESSABILITY 38100019 USING IHADCB,DCBR NEW DCB REG ADDRESSABILITY 38400019 * 38700019 LR BASER,ENTRYR LOAD BASE ADDRESS 39000019 LR DCBR,PARA1R LOAD DCB ADDRESS 39300019 LM IOBADR,RECADR,DCBIOBA LOAD WORK REGS 39600019 TM DCBORBYT,BUFPRIME ARE THE BUFFERS PRIMED 39900019 BNZ OCR035 YES,BRANCH 40200019 * 40500019 *********************************************************************** 40800019 * 41100019 * PRIME BUFFERS SUBROUTINE 41400019 * 41700019 *********************************************************************** 42000019 NI DCBIFLGS,ERRFLGS MAKE SURE ERROR FLAGS ARE OFF 42300019 * 42600019 SR WORK3R,WORK3R CLEAR A WORK REGISTER 42900019 IC WORK3R,DCBBUFNO GET NUMBER OF BUFFERS 43200019 B OCR033 BRANCH TO SCHEDULE BUFFERS 43500019 * 43800019 OCR032 L IOBADR,0(IOBADR) GET NEXT IOB ADDRESS 44100019 ST IOBADR,DCBIOBA STORE ADDRESS OF NEXT IOB TO THE DCB 44400019 OCR033 BAL RETR,OCR060 BRANCH AND LINK TO CLEAR THE BUFFER 44700019 * 45000019 L ENTRYR,DCBEOB LOAD ADDRESS OF END OF BLOCK ROUTINE 45300019 * 45600019 OCR034 BALR RETR,ENTRYR BRANCH AND LINK TO EOB ROUTINE 45900019 BCT WORK3R,OCR032 IF MORE IOBS TO SCHEDULE ,BRANCH 46200019 OI DCBORBYT,BUFPRIME SET BUFFERS PRIMED SWITCH ON 46500019 * 46800019 *********************************************************************** 47100019 * 47400019 OCR035 TM DCBIOBA,RELEASE RELEASE CALLED FOR 47700019 BO OCR055 BRANCH TO SCHEDULE BUFFER 48000019 * 48300019 CR RECADR,EOBADR HAS END OF BLOCK BEEN REACHED YET 48600019 BL OCR045 NO, BRANCH 48900019 OCR037 L ENTRYR,DCBGERR LOAD ADDRESS OF SYNCH AND ERROR PROC 49200019 OCR040 BALR RETR,ENTRYR BRANCH AND LINK TO GERR RTN 49500019 OCR045 CLC DCBERRCN+1(ADDRESS),ZEROS ARE COUNTERS SPECIFIED 49800019 BE OCR050 NO, BRANCH 50100019 * 50400019 L WORK1R,DCBERRCN LOAD ADR OF 32 BYTE COUNT AREA 50700019 L WORK2R,LINECNT(WORK1R) LOAD NO. OF LINES READ 51000019 LA WORK2R,ONE(WORK2R) ADD 1 TO COUNT 51300019 ST WORK2R,LINECNT(WORK1R) STORE COUNT 51600019 OCR050 L PARA1R,REG0SAV(SAVR) MAKE WORK AREA ADDRESSABEL 51900019 LH LRECLR,DCBLRECL LOAD LENGTH OF RECORD--LESS THAN 256 52200019 BCTR LRECLR,0 DECREMENT BY 1 52500019 * 52800019 EX LRECLR,OCR076E MOVE RECORD TO WORK AREA 53100019 * 53400019 CLC DCBBUFL(LNGH),DCBLRECL MORE THAN 1 REC IN A BUFFER 53700019 BH OCR110 YES, BRANCH 54000019 * 54300019 MVC DCBRECAD+1(ADDRESS),DCBEOBAD+1 SIMULATE END OF BLOCK 54600019 OCR055 LA RETR,OCR085 LOAD RETURN ADDRESS FOR SUBROUTINE 54900019 EJECT 55200019 *********************************************************************** 55500019 * 55800019 * CLEAR BUFFER SUBROUTINE 56100019 * 56400019 *********************************************************************** 56700019 OCR060 SR WORK1R,WORK1R CLEAR REGISTER 57000019 IC WORK1R,DCBOFFSR GET OFFSET OF CHANNEL PROGRAM 57300019 AR WORK1R,IOBADR GET ADDRESS OF CHANNEL PROGRAM 57600019 L BUFADR,BUF(WORK1R) LOAD BUFFER ADDRESS 57900019 LA BUFADR,ONE(BUFADR) CLEAR HI BYTE AND INCREMENT BY 1 58200019 SH BUFADR,CNT(WORK1R) SUBTRACT RECORD LENGTH 58500019 LH LNGHR,DCBBUFL LOAD LENGTH OF BUFFER 58800019 LA CON255R,C255 LOAD CONSTANT = 255 59100019 BCTR LNGHR,0 DECREMENT LENGTH BY 1 59400019 * 59700019 OCR070 CR LNGHR,CON255R COMPARE LENGTH TO CLEAR TO 255 60000019 BNH OCR080 IF 255 OR LESS,BRANCH 60300019 * 60600019 EX CON255R,OCR075E CLEAR 256 BYTES 60900019 * 61200019 SR LNGHR,CON255R SUBTRACT 255 FROM AMOUNT TO BE CLEAR 61500019 BCTR LNGHR,0 SUBTRACT ONE MORE 61800019 * 62100019 LA BUFADR,C256(BUFADR) INCREMENT BUFFER ADDRESS BY 256 62400019 B OCR070 BRANCH TO CLEAR NEXT PORTION OF BUF 62700019 * 63000019 OCR075E XC 0(1,BUFADR),0(BUFADR) CLEAR INSTRUCTION USED BY EXECUTE 63300019 OCR076E MVC 0(1,PARA1R),0(RECADR) MOVE INSTRUCTION USED BY EXECUTE 63600019 * 63900019 * 64200019 * 64500019 OCR080 EX LNGHR,OCR075E CLEAR REMAINDER OF BUFFER 64800019 BR RETR BRANCH TO CALLING ROUTINE 65100019 *********************************************************************** 65400019 EJECT 65700019 OCR085 TM DCBORBYT,EOFBIT TEST IF END OF FILE IS ON 66000019 BO OCR095 IF YES, DO NOT SCHEDULE, BRANCH 66300019 L ENTRYR,DCBEOB LOAD END OF BLOCK ROUTINE ADDRESS 66600019 OCR090 BALR RETR,ENTRYR BRANCH AND LINK TO END OF BLOCK RTN 66900019 * 67200019 OCR095 TM DCBIOBA,RELEASE IS RELEASE SWITCH ON 67500019 BO OCR037 YES, BRANCH TO GET NEW BUFFER 67800019 * 68100019 SR ENTRYR,ENTRYR CLEAR REGISTER 68400019 CLI DCBEIB+1,NOERROR IS RETURN CODE = 0 68700019 BE OCR100 YES, BRANCH TO RESTORE REGS 69000019 * 69300019 IC ENTRYR,DCBEIB+1 LOAD RETURN CODE 69600019 XC DCBEIB+1(ONE),DCBEIB+1 CLEAR RETURN CODE SAVE AREA 69900019 * 70200019 OCR100 LM DCBR,BASER,USERREG(SAVR) RESTORE USER REGISTERS 70500019 L PARA1R,REG0SAV(SAVR) RESTORE WORK AREA ADDRESS 70800019 L RETR,RETREG(SAVR) RESTORE RETURN ADDRESS 71100019 OCR105 BR RETR RETURN TO USER 71400019 * 71700019 OCR110 L RECADR,DCBRECAD LOAD ADDRESS OF CURRENT RECORD 72000019 AH RECADR,DCBLRECL DETERMINE NEXT RECORD ADDRESS 72300019 ST RECADR,DCBRECAD STORE ADDRESS OF NEXT RECORD 72600019 CLC DCBEOBAD+1(ADDRESS),DCBRECAD+1 IS IT END OF BLOCK YET 72900019 BNH OCR055 YES, BRANCH 73200019 SR ENTRYR,ENTRYR SET RETURN CODE TO ZERO 73500019 B OCR100 BRANCH TO RETURN TO USER 73800019 CNOP 0,8 PAD MODULE TO DOUBLE WORD 74100019 DCBD DSORG=PS,DEVD=OR @YM00635 74400002 END 74700019