* /* START OF SPECIFICATIONS **** 00050002 *01* PROCESSOR = ASSEMXF-370R 00100002 **** END OF SPECIFICATIONS ***/ 00150002 TITLE 'IGG019VA - GET LOCATE FIXED RECORDS (OCR) ' 00400019 IGG019VA CSECT 00800019 *********************************************************** @YM00638 00850002 *MODULE-NAME @YM00638 00900002 * IGG019VA @YM00638 00950002 * @YM00638 01000002 *DESCRIPTIVE-NAME @YM00638 01050002 * OCR GET, LOCATE MODE, FIXED RECORDS @YM00638 01100002 * @YM00638 01150002 *COPYRIGHT @YM00638 01160002 * NONE @YM00638 01170002 * @YM00638 01180002 *CHANGE-ACTIVITY @YM00638 01190002 * 01200019 * RELEASE 20 ADDITIONS/CHANGES/DELETIONS 01500020 *A553000,554000 A33921 01800020 *C608000 A33921 02100020 * RELEASE 21 ADDITIONS/CHANGES/DELETIONS 02400020 * RELEASE 22 ADDITIONS/CHANGES/DELETIONS 02700020 * RELEASE 23 ADDITIONS/CHANGES/DELETIONS 03000020 * RELEASE 24 ADDITIONS/CHANGES/DELETIONS 03300020 * RELEASE 25 ADDITIONS/CHANGES/DELETIONS 03600020 * RELEASE 26 ADDITIONS/CHANGES/DELETIONS 03900020 * RELEASE 27 ADDITIONS/CHANGES/DELETIONS 04200020 * 04800019 * 05200019 * STATUS - CHANGE LEVEL 00 RELEASE 20 05600020 * 06000019 * 06400019 * 06800019 *FUNCTION-GET- TO LOCATE THE ADDRESS OF LOGICAL SEQUENTIAL RECORDS 07200019 * WITHIN A BUFFER FOR THE USER 07600019 * RELEASE- CAUSES THE REMAINING CONTENTS OF THE CURRENT BUFFER 08000019 * TO BE IGNORED 08400019 * 08800019 *ENTRY POINTS 09200019 * LABEL OCR010 09600019 * LABEL OCR020 10000019 * 10400019 *ENTRY INSTRUCTION SEQUENCE 10800019 * GET RELESE 11200019 * LA 1,DCB LA 1,DCB 11600019 * L 15,48(1) L 15,48(1) 12000019 * BALR 14,15 BALR 14,8(15) 12400019 * 12800019 *INPUT FROM USER AS ADDRESSES IN FOLLOWING REGISTERS 13200019 * REG 0 USED IN MOVE MODE(NOT APPLICABLE IN LOCATE MODE) 13600019 * REG 1 DCB ADDRESS 14000019 * REG 13 WORK-SAVE ADDRESS 14400019 * REG 14 USER IN-LINE RETURN ADDRESS 14800019 * REG 15 THIS ROUTINES INITIAL BASE ADDRESS 15200019 * 15600019 *OUTPUT REGISTER ADDRESSES AS FOLLOWS 16000019 * REG 0 NOT APPLICABLE 16400019 * REG 1 RECORD ADDRESS LOCATED FOR USER 16800019 * REG 13 WORK-SAVE ADDRESS 17200019 * REG 14 RETURN ADDRESS 17600019 * REG 15 RETURN CODE 18000019 * REG 2-12 AS UPON ENTRY TO THIS ROUTINE 18400019 * 18800019 *EXTERNAL ROUTINES 19200019 * 19600019 * IGG019VE - INPUT ERROR ROUTINE WHICH DETECTS, CORRECTS DEV-DEP 20000019 * ERRORS AND RETURNS BLOCK OF DATA. 20400019 * IGG019CC END OF BLOCK ROUTINE WHICH SCHEDULES REQUESTS. 20800019 *EXITS 21200019 * OCR025 BRANCH TO USER,RETURNS PARAMETERS 21600019 * OCR034 BRANCH AND LINK TO END OF BLOCK ROUTINE 22000019 * OCR072 BRANCH AND LINK TO END OF BLOCK ROUTINE 22400019 * OCR080 BRANCH AND LINK TO INPUT ERROR ROUTINE 22800019 * OCR110 BRANCH TO USER, RETURNS PARAMETERS 23200019 * 23600019 *TABLES/WORKAREAS 24000019 * 24400019 * USER SAVE/WORK AREA-LAST 13 WORDS USED 24800019 * DCB 25200019 * 25600019 * IOB 26000019 * 26400019 *ATTRIBUTES---REENTRANT,REUSABLE,PROBLEM PROGRAM MODE 26800019 * 27200019 ********************************************************************** 27600019 * 28000019 * ALL REGISTER EQUATES HAVE AN 'R' AT THE END OF THE SYMBOL 28400019 * 28800019 *********************************************************************** 29200019 * 29600019 PARA1R EQU 1 PARAMETER REGISTER 1 30000019 BUFADR EQU 1 ADDRESS OF BUFFER 30400019 DCBR EQU 2 DCB ADDRESS 30800019 IOBADR EQU 3 IOB ADDRESS 31200019 EOBADR EQU 4 EOB ADDRESS 31600019 RECADR EQU 5 RECORD ADDRESS 32000019 LRECLR EQU 6 RECORD LENGTH 32400019 WORK3R EQU 6 WORK REGISTER 32800019 WORK1R EQU 7 WORK REGISTER 33200019 CON255R EQU 7 WORK REGISTER-CONTAINS 255 33600019 BASER EQU 8 BASE REGISTER 34000019 SAVR EQU 13 USER SAVE AREA 34400019 RETR EQU 14 RETURN ADDRESS 34800019 WORK2R EQU 14 WORK REGISTER 35200019 ENTRYR EQU 15 ENTRY ADDRESS 35600019 LNGHR EQU 15 WORK REGISTER-CONTAINS BUFFER LNGH 36000019 *********************************************************************** 36400019 * 36800019 EOFBIT EQU X'40' DCBORBYT-END OF FILE BIT 37200019 BUFPRIME EQU X'20' DCBORBYT-BUFFERS PRIMED BIT 37600019 ERRFLGS EQU X'3F' DCBIFLGS-DCB ERROR FLGS OFF 38000019 BUF EQU 0 OFFSET OF BUFFER ADDRESS IN CCW 38400019 CNT EQU 6 OFFSET OF COUNT IN CCW 38800019 LINECNT EQU 28 OFFSET OF LINE COUNT IN ERROR CNTRS 39200019 NOERROR EQU X'00' TESTS FOR RETURN CODE OF ZERO 39600019 C255 EQU 255 USED TO CLEAR 256 BYTES OF CORE 40000019 C256 EQU 256 USED TO INCREMENT POINTER BY 256 40400019 ADDRESS EQU 3 LENGTH OF AN ADDRESS 40800019 ONE EQU 1 USED TO INCREMENT BY 1 41200019 USERREG EQU 36 SAVE AREA OFFSET TO REG2 41600019 RETREG EQU 20 SAVE AREA OFFSET TO REG14 42000019 SAVREG EQU 20 SAVE AREA OFFSET TO STORE REGISTERS 42400019 * 42800019 EJECT 43200019 USING IGG019VA,ENTRYR USE ENTRY POINT AS A BASE (REG 15) 43600019 USING IHADCB,PARA1R USE DCB ADDRESS AS A BASE (REG 1) 44000019 * 44400019 OCR010 B OCR030 BRANCH AROUND RELEASE 44800019 ZEROS DC X'00000000' FILL FOR ENTRY AT +8 -USE AS CONST=0 45200019 * 45600019 OCR020 MVC DCBRECAD+1(ADDRESS),DCBEOBAD+1 INITIALIZE FOR RELEASE 46000019 OCR025 BR RETR RETURN TO USER 46400019 * 46800019 OCR030 STM RETR,BASER,SAVREG(SAVR) SAVE REGISTERS 47200019 * 47600019 DROP ENTRYR DROP REG 15 AS BASE FOR MODULE 48000019 DROP PARA1R DROP REG 1 AS BASE FOR DCB 48400019 USING IGG019VA,BASER NEW BASE REG ADDRESSABILITY 48800019 USING IHADCB,DCBR NEW DCB REG ADDRESSABILITY 49200019 * 49600019 LR BASER,ENTRYR LOAD BASE ADDRESS 50000019 LR DCBR,PARA1R LOAD DCB ADDRESS 50400019 LM IOBADR,RECADR,DCBIOBA LOAD WORK REG2 50800019 TM DCBORBYT,BUFPRIME ARE THE BUFFERS PRIMED 51200019 BNZ OCR035 YES, BRANCH 51600019 *********************************************************************** 52000019 * 52400019 * PRIME BUFFERS SUBROUTINE 52800019 * 53200019 *********************************************************************** 53600019 * 54000019 NI DCBIFLGS,ERRFLGS MAKE SURE ERROR FLAGS ARE OFF 54400019 * 54800019 SR WORK3R,WORK3R CLEAR REGISTER 55200019 CLI DCBBUFNO,ONE IF BUFFER NUMBER IS ONE A33921 55300020 BE OCR0341 GO TO OCR0341 A33921 55400020 IC WORK3R,DCBBUFNO GET NUMBER OF BUFFERS 55600019 BCTR WORK3R,0 DECREMENT BY 1 FOR LOCATE MODE 56000019 * 56400019 OCR033 L IOBADR,0(IOBADR) GET ADDRESS OF NEXT IOB 56800019 ST IOBADR,DCBIOBA STORE THAT IOB ADDRESS TO THE DCB 57200019 * 57600019 BAL RETR,OCR040 BRANCH AND LINK TO CLEAR BUFFERS 58000019 * 58400019 L ENTRYR,DCBEOB LOAD ADDRESS OF END OF BLOCK RTN 58800019 OCR034 BALR RETR,ENTRYR BRANCH AND LINK TO EOB ROUTINE 59200019 BCT WORK3R,OCR033 IF MORE IOBS, BRANCH TO SCHEDULE 59600019 L IOBADR,0(IOBADR) GET IOB ADDRESS THAT WAS NOT SCHED 60000019 ST IOBADR,DCBIOBA STORE TO DCB 60400019 OCR0341 OI DCBORBYT,BUFPRIME SET BUFFERS PRIMED SWITCH ON A33921 60800020 * 61200019 *********************************************************************** 61600019 OCR035 AH RECADR,DCBLRECL DETERMINE NEXT RECORD ADDRESS 62000019 CR RECADR,EOBADR END OF BLOCK ADDRESS 62400019 BL OCR085 NO, BRANCH TO GIVE ADDRESS OF REC 62800019 LA RETR,OCR070 LOAD CORRECT RETURN ADDRESS 63200019 * 63600019 EJECT 64000019 *********************************************************************** 64400019 * 64800019 * CLEAR BUFFER SUBROUTINE 65200019 * 65600019 *********************************************************************** 66000019 OCR040 SR WORK1R,WORK1R CLEAR REGISTER 66400019 IC WORK1R,DCBOFFSR GET OFFSET OF CHANNEL PROGRAM 66800019 AR WORK1R,IOBADR GET ADDRESS OF CHANNEL PROGRAM 67200019 L BUFADR,BUF(WORK1R) LOAD BUFFER ADDRESS 67600019 LA BUFADR,ONE(BUFADR) CLEAR HI BYTE AND INCREMENT BY 1 68000019 SH BUFADR,CNT(WORK1R) SUBTRACT RECORD LENGTH 68400019 LH LNGHR,DCBBUFL LOAD LENGTH OF BUFFER 68800019 LA CON255R,C255 LOAD CONSTANT = 255 69200019 BCTR LNGHR,0 DECREMENT LENGTH BY 1 69600019 * 70000019 OCR050 CR LNGHR,CON255R COMPARE LENGTH TO CLEAR WITH 255 70400019 BNH OCR060 IF 255 OR LESS,BRANCH 70800019 * 71200019 EX CON255R,OCR055E CLEAR 256 BYTES 71600019 * 72000019 SR LNGHR,CON255R SUBTRACT 255 FROM AMOUNT TO BE CLEAR 72400019 BCTR LNGHR,0 SUBTRACT ONE MORE BYTE 72800019 LA BUFADR,C256(BUFADR) UPDATE AREA ADDRESS 73200019 B OCR050 BRANCH TO TEST FOR MORE 73600019 * 74000019 OCR055E XC 0(1,BUFADR),0(BUFADR) CLEAR INSTRUCTION USED BY EX INSTR 74400019 * 74800019 OCR060 EX LNGHR,OCR055E CLEARS LESS THAN 256 BYTES 75200019 BR RETR RETURN TO CALLING ROUTINE 75600019 * 76000019 *********************************************************************** 76400019 * 76800019 EJECT 77200019 OCR070 TM DCBORBYT,EOFBIT TEST IF END OF FILE IS ON 77600019 BO OCR075 IF YES, DO NOT SCHEDULE,BRANCH 78000019 L ENTRYR,DCBEOB LOAD EOB ROUTINE ADDRESS 78400019 OCR072 BALR RETR,ENTRYR BRANCH AND LINK TO EOB RTN 78800019 * 79200019 OCR075 L ENTRYR,DCBGERR LOAD GERR ROUTINE ADDRESS 79600019 * 80000019 OCR080 BALR RETR,ENTRYR BRANCH AND LINK TO GERR ROUTINE 80400019 * 80800019 OCR085 CLC DCBERRCN+1(ADDRESS),ZEROS ARE COUNTERS SPECIFIED 81200019 BE OCR090 NO, BRANCH 81600019 * 82000019 * 82400019 L WORK1R,DCBERRCN LOAD ADR OF 32 BYTE COUNT AREA 82800019 L WORK2R,LINECNT(WORK1R) LOAD NO. OF LINES READ 83200019 LA WORK2R,ONE(WORK2R) ADD 1 TO COUNT 83600019 ST WORK2R,LINECNT(WORK1R) STORE COUNT 84000019 * 84400019 OCR090 LR PARA1R,RECADR RECORD ADDRESS TO REGISTER 1 84800019 ST PARA1R,DCBRECAD STORE RECORD ADDRESS TO DCB 85200019 AH RECADR,DCBLRECL DETERMINE ADDRESS OF NEXT RECORD 85600019 L WORK1R,DCBEOBAD LOAD EOB ADDRESS 86000019 SR ENTRYR,ENTRYR CLEAR REG 15 86400019 CR RECADR,WORK1R COMPARE NEXT REC ADR TO EOB ADDRESS 86800019 BL OCR100 IF LESS,BRANCH 87200019 CLI DCBEIB+1,NOERROR IS RETURN CODE = 0 87600019 BE OCR100 YES,BRANCH 88000019 IC ENTRYR,DCBEIB+1 LOAD RETURN CODE 88400019 XC DCBEIB+1(ONE),DCBEIB+1 CLEAR RETURN CODE SAVE AREA 88800019 * 89200019 OCR100 LM DCBR,BASER,USERREG(SAVR) RESTORE USER REGISTERS 89600019 L RETR,RETREG(SAVR) RESTORE RETURN REGISTER 90000019 OCR110 BR RETR RETURN TO USER 90400019 * 90800019 CNOP 0,8 PAD MODULE TO DOUBLE WORD 91200002 DCBD DSORG=PS,DEVD=OR @YM00635 91600002 END 92000019