MACRO 00030020 MIEDQFA &X 00060022 .*A-000000-999999 @X31X8Q0 00060208 .*A513900 @OX12563 00060300 LCLC &CH 00060522 LCLA &A 00061022 * CHANGE ACTIVITY = AS FOLLOWS: 00061261 * ****************** MICROFICHE FLAGS *********************** SUPT CODE 00061561 * A281400,751500,752100,756900,759600 A44866 00062061 * C283500 A44866 00062161 * A473700 A42363 00062261 * C085200,487800,495900,501000,501900,826200-826500 A42363 00062361 * D243700 A42363 00062461 * A487800,831300 M2321 00062561 * C085200,495300,661700 M2321 00062661 * A206100 M6298 00062761 * C085200,183600-184200 M6298 00062861 * D176100-176400 M6298 00062961 * A221300,221320 A49211 00063061 * C085200,221200 A49211 00063161 * D220800 A49211 00063261 * A757100 A49228 00063361 * C738000,756000 A49228 00063461 * A284700 A41025 00063561 * C085200,089100-092100 A41025 00063661 * D088200-088500 A41025 00063761 * A238200 A42400 00063861 * C085200 A42400 00063961 * C085200,153903,155080 A47133 00064061 * A054900,056100,096300,150300,153900,154100,154500,154800 S21101 00064161 * A155060,155080,156600,166800,167100,178800,179400,180000 S21101 00064261 * A180600,180800,180840,217800,235500,340800,456300,479100 S21101 00064361 * A485400,504600,661500,840300 S21101 00064461 * C021300,026700,027300,030300,032400-033300,037200,040500 S21101 00064561 * C063300,071700,076200,085200,092700,105900,112200,116700 S21101 00064661 * C121200,130500-131100,139800,141000,143400,145200,146100 S21101 00064761 * C154120,155066-155084,161100,163500,180220,182700,186900 S21101 00064861 * C188400,192000,218400,220800-221100,236100-237000,238400 S21101 00064961 * C238599,239400,653700,257100,260400-261600,262200-269700 S21101 00065061 * C287400,288000,288600,329100,331200,339900,345000,346800 S21101 00065161 * C362100,363000,388200,399000,399900,404400,405300,426300 S21101 00065261 * C431700,435600,438000,438600,535800,547800,558600,574500 S21101 00065361 * C612600,691200,709500,726600,729300,766500,767100,767700 S21101 00065461 * C774000,793200,821100,822000,827400,857100-857400 S21101 00065561 * D117900-119100,129900,132900-138000,147000-148200 S21101 00065661 * D154600-154800,179100,180300-180818,218700,219600,226500 S21101 00065761 * D229800,230400,232800,249600,258000-258900,259500-259800 S21101 00065861 * D270300-270600,333300-334200,339300,527100-528300,859800 S21101 00065961 * A451300,485760-485940,513601-513810,539730-539970,540700 S22026 00066061 * A765930-766140,766600,860800 S22026 00066161 * C067800,450300,550800-551700 S22026 00066261 * D513000 S22026 00066361 * C341400 A44895 00066461 * A228300 SA54922 00066561 * C221320 SA54922 00066661 * A562500,282900 SA54262 00066761 * C478500-479300 SA52972 00066861 * A514800 SA57087 00066961 * A518100 SA55393 00067061 * D551400-552600 SA56898 00067161 * C485880 SA57333 00067261 * A153900,219900,223500,428700,438900,503700,521700 SA52971 00067361 * C153000-153250,153600,153903-153994,154120,155070-155400 SA52971 00067461 * C164400-164500,181040-181240,217900,220500,220900-221040 SA52971 00067561 * C221200-221360,222600-222900,225000-226800,227400-228000 SA52971 00067661 * C234000-235600,429000-429150,478500-479300,484200-484800 SA52971 00067761 * C500700-500800,504700-504840,513600-513619,522300-531600 SA52971 00067861 * C532800-533400 SA52971 00067961 * D001800-006600,154000-154100,163800,228400,485500, SA52971 00068061 * D507300-507600,532200 SA52971 00068161 * A445500,515400,738300,741900,753100,755700 SA52984 00068261 * C445200,445800,755940 SA52984 00068361 * D449400-457200,743400-743700 SA52984 00068461 * D055800,790500-791100,795600-798000 SA51078 00068561 * A202600-202700,214300,795600-796600 SA51078 00068661 * C231900 SA51078 00068761 * A033070-033490 SA51783 00068861 * D145200,150400-150580,154900-155070,156000-156900,178900 SA51783 00068961 * D179500,179800-179900,180100-180840 SA51783 00069061 * A148510-148650,148860-149040 SA51783 00069161 * A154126-154150,181280-181440,215420-215680,221040-221220 SA50192 00069261 * A221382-221392 SA50192 00069361 * C220980 SA50192 00069461 * D221040-221200 SA50192 00069561 * A056150,549650,553850-554060 S22024 00069661 * D550500 S22024 00069761 * A256230-256470 SA61800 00069861 * C350100,359400 SA59522 00069961 * D358200 SA59522 00070061 * A460200,546240,554400 SA61767 00070161 * C546020 SA61767 00070261 * D238400 SA61768 00070361 * C238406-238408,238420,238460,238484,238496-238599 SA61768 00070461 * A509700 SA62949 00070561 * C 358000 SA62976 00070661 * A 661760 SA63623 00070761 * C481800 SA66617 00070861 * A522300 SA66626 00070961 * A786900 SA68051 00071061 * D787800 @SA68051 00071161 .*C013390 @Z30X8QE 00071208 * A207600 @YA03936 00171161 * A602700,603000 @SA70861 00271161 * C495440 @SA70861 00371161 * A786900 @SA68051 00371261 * A38910,384600 @SA69655 00371361 *A482700 @YA05477 00371461 .*D814500 @SA73185 00471461 .*A202800 @YA06869 00571461 *A482100 @YA08105 00601461 *D518170-518310 @YA08105 00631461 *A733200,751500 @YA07705 00640400 *A154200 @SA71965 00649400 *A504600 @SA74867 00658400 *D513780-513810 @OX11340 00667400 *A056300,445740,445961 @OZ09304 00668400 *C445560-445590 @OZ09304 00669400 *C439140 @OZ09304 00670400 *A056350,385800,389280 @OZ14195 00671400 *A056350 @OS79957 00672400 *C445932-445961 @OS79957 00673400 *A514900 @OX11340 00676400 *C 554050 @Y17XA0Z 00682400 *A615600 @OS77389 00683400 *A452100,759300,782700 @OX20639 00683586 *D456000,459000,463800 @OX20639 00683686 *A455400,455700,459600,459900 @OX20639 00683786 *A445930 @OY20265 00683886 *A389300 @OZ30296 00683986 SPACE 3 00690022 .********************************************************************** 00720022 AIF ('&X' NE 'CORE').CDS 00750020 &A SETA 1 . S22025 00780022 IEDQFA1 TITLE '''IEDQFA'' - CPB INITIALIZATION - CORE ONLY' . S22025 00790022 IEDQFA1 CSECT 00810020 AGO .OK 00840020 .CDS AIF ('&X' NE 'DISK').BOTH 00870020 &A SETA 2 00900020 IEDQFA2 TITLE '''IEDQFA'' - CPB INITIALIZATION - DISK ONLY' . S22025 00930022 IEDQFA2 CSECT 00960020 AGO .OK 00990020 .BOTH ANOP 01020020 &A SETA 3 01050020 IEDQFA3 TITLE '''IEDQFA'' - CPB INITIALIZATION - CORE AND DISK' S22025 01080022 IEDQFA CSECT 01110020 IEDQFA3 EQU * . 01140020 .OK ANOP 01170020 &CH SETC 'IEDQFA&A' 01200020 ENTRY IEDQFQ . 01230020 *********************************************************************** 01260020 * * 01290020 * TITLE: MIEDQFA - CPB INITIALIZATION * 01320022 * * 01320552 AIF ('&X' NE 'CORE').TAG1 01321022 * MODULE NAME = IEDQFA1 * 01322022 * * 01323022 * DESCRIPTIVE NAME = CPB INITIALIZATION - CORE ONLY * 01324022 AGO .TAG3 01325022 .TAG1 AIF ('&X' NE 'DISK').TAG2 01326022 * MODULE NAME = IEDQFA2 * 01327022 * * 01328022 * DESCRIPTIVE NAME = CPB INITIALIZATION - DISK ONLY * 01329022 AGO .TAG3 01330022 .TAG2 ANOP 01331022 * MODULE NAME = IEDQFA(3) * 01332022 * * 01333022 * DESCRIPTIVE NAME = CPB INITIALIZATION - CORE AND DISK * 01334022 .TAG3 ANOP 01335022 * * 01336022 * COPYRIGHT = 'NONE' * 01337022 * * 01338022 * STATUS -- CHANGE LEVEL 8 @Z30X8QE 01339008 * * 01410020 *FUNCTION -- THIS ROUTINE CONSISTS OF 2 PARTS * 01440020 * 1. FA - THIS ROUTINE WILL INITIALIZE CPBS TO WRITE OR READ * 01470020 * BUFFER UINTS TO OR FROM DISK. * 01500020 * 2. FQ - THIS ROUTINE WILL HANDLE CPBS AFTER DISK I/O HAS BEEN * 01530020 * COMPLETED. * 01560020 * * 01590020 *ENTRY POINTS -- THIS MODULE HAS TWO ENTRY POINTS * 01620020 * 1. 'IEDQFA' - TO QUEUE A BUFFER ON DISK OR TO OBTAIN FULL * 01650020 * BUFFERS FROM A MESSAGE QEUUE * 01680020 * 2. 'IEDQFQ' - TO HANDLE CPBS AFTER DISK OPERATIONS AND FILL * 01710020 * BUFFERS FROM DATA IN CPBS WHICH HAVE READ A RECORD * 01740020 * OR FROM UNITS IN A MAIN STORAGE QUEUE. * 01770020 * CALLING SEQUENCE * 01800020 * L R1,ELEMAD * 01830020 * L R15,QCBSTCHN-1 * 01860020 * LA R15,2(R15) * 01890020 * BR R15 * 01920020 * * 01950020 *INPUT -- ENTRY IS ALWAYS FROM THE DISPATCHER. DIFFERENT INPUT * 01980020 * IS EXPECTED AT THE TWO ENTRY POINTS * 02010020 * 1. IEDQFA - * 02040020 * A. BUFFER TO BE WRITTEN ON DISK. IT WILL CONTAIN THE * 02070020 * RELATIVE RECORD NIMBERS FOR THE UNITS OF THE BUFFER * 02100020 * THE BUFFER IS POSTED TO THE DISK I/O QCB FROM THE S21101 02130020 * DESTINATION SCHEDULER. * 02160020 * B. BUFFERS TO BE FLAGGED SERVICED, INTERCEPTED, OR CANCELED * 02190020 * ON THE MESSAGE QUEUES * 02220020 * POSTED BY BUFFER DISPOSITION, INTERCEPT, OR CANCEL * 02250020 * C. ERB - AN ERB WILL BE POSTED TO OBTAIN FULL BUFFERS. * 02280020 * SEND SCHEDULER WILL POST THE ERB TO OBTAIN FULL BUFFERS * 02310020 * TO SATISFY AN INITIAL REQUEST FOR SENDING * 02340020 * BUFFER DISPOSTION WILL POST THE ERB FOR RECALL * 02370020 * EOBCHECK WILL POST FOR RECALLED BUFFERS * 02400020 * THE GET SCHEDULER WILL POST TO OBTAIN FULL BUFFERS TO * 02430020 * SATISFY A GET * 02460020 * PCI APPENDAGE WILL POST TO GET BUFFERS FOR * 02490020 * SUBSEQUENT TRANSMISSION * 02520020 * THE ADDRESS OF THE FIRST BYTE OF DATA TO PUT IN THE * 02550020 * BUFFER WILL BE IN SCBDEOB * 02580020 * * 02610020 * 2. IEDQFQ * 02640020 * A. QCB - THE CPB CLEANUP QCB WILL BE POSTED TO ITSELF S21101 02670020 * TO INITIATE CLEANING UP OF THE CPBS. * 02700020 * THE QCB WILL BE POSTED BY DISK END APPENDAGE AFTER DISKS21101 02730020 * I/O IS COMPLETE AND THE COMPLETED CPBS HAVE BEEN * 02760020 * PLACED ON THE AVTDKAPQ. * 02790020 * B. BUFFER - A BUFFER UNIT WILL BE POSTED TO SATISFY * 02820020 * A REQUEST FROM FQ. * 02850020 * BUFFER RETURN WILL POST THE AVAILABLE UNIT TO THE * 02880020 * CLEANUP QCB * 02910020 * * 02940020 *OUTPUT -- THE COMBINED OUTPUT OF FA AND FQ WILL BE * 02970020 * 1. BUFFERS WRITTEN ON DISK * 03000020 * 2. ERB WITH FULL BUFFERS POSTED TO ACTIVATE QCB OF THE GET S21101 03030020 * SCHEDULER. * 03060020 * 3. ERB WITH RECALLED BUFFERS POSTED TO THE SPECIFIED QCB. * 03090020 * 4. DUPLICATE HEADERS POSTED TO SPECIFIED QCB. * 03120020 * 5. CPBS PUT BACK INTO THE FREE POOL. * 03150020 * * 03180020 *EXTERNAL ROUTINES -- * 03210020 * 'IEDQDISP' - DSPPOSTR - PLACE AN ELEMENT ON THE READY S21101 03240020 * QUEUE BY PRIORITY. S21101 03250020 * IGG019RC-WTORTN-DISK ERROR HANDLING 99226 03300022 * ANY EXTERNAL SUBROUTINE WHOSE ADDRESS IS IN THE PRFTIC SA51783 03307022 * FIELD OF A BUFFER POSTED TO IEDQFA WITH 'EE' PRIORITY SA51783 03314022 * TO REQUEST A CPB. SA51783 03321022 * THESE SUBROUTINES ARE: SA51783 03328022 * 'BUILDCPB' - IN IEDQGQ SA51783 03335022 * 'NEWPFEFO' - IN IGG019RP SA51783 03342022 * 'UPFEFO' - IN IGG019RP SA51783 03349022 * * 03360020 *EXITS-NORMAL -- FA - WHEN THERE ARE NO MORE CPBS AVAILABLE * 03390020 * OR ELEMENTS TO PROCESS, EXIT IS TO EXCP DRIVER. WHO WILL * 03420020 * RETURN TO THE DISPATCHER. * 03450020 * FQ - WHEN ALL CPBS HAVE BEEN PROCESSED EXIT IS TO FA * 03480020 * * 03510020 *EXITS-ERROR-BRANCH TO THE WTORTN OF IGG019RC ON DISK ERRORS 99226 03540022 * A LOGICAL READ ERROR MAY OCCUR WHEN PERFORMING A RECALL 99226 03570022 * A LOGICAL READ ERROR MAY OCCUR WHEN A REQUEST IN MADE TO * 03600020 * READ A RECORD AND THE RECORD NUMBER OF RECORD WHEN READ * 03630020 * DOES NOT AGREE WITH THE REQUESTED RECORD NUMBER. * 03660020 * APPROPRIATE ERROR FLAGS ARE SET AND THE ERB IS RETURNED * 03690020 * TO THE SPECIFIED QCB. S21101 03720020 * * 03750020 *TABLES/WORKAREAS -- * 03780020 * LOCAL FLAGS IN THE TIC FIELD OF THE BUFFERS ARE * 03810020 * XBUFFER,XSPECIAL,XREUSDSK,XPARTIAL,XNONREUS. * 03840020 * IN THE ERB STATUS FIELD FLAGS ARE * 03870020 * XMSG,XXUSED,XXINQ,XCOMPL,XERROR * 03900020 * LOCAL CONSTANTS - XMASK FOR TERM DSECT * 03930020 * DSECTS USED - LCB,SCB,PRF,TRM,AVT,QCB,CPB,DATA,DCB,DISP * 03960020 * AVTFIELDS - ACTIB,APLKN,APLKF,AVFCT,BFDSB,BFREB,BFRTB,BIT1 * 03990020 * BIT2,CADDR,DATLN,DKAPQ,DKENQ,DOUBL,DSKCT,EA,EINPR,EZERO,FCPB * 04020020 * RC,RO,HDRSZ,IA,INCPQ,KEYLE,MHCOB,NCPBQ,NOBFQ,PARM,PARM3, S21101 04050020 * REUSQ,TRNMPT,RUFTN,TXTSZ,UMALN. * 04080020 * * 04110020 *ATTRIBUTES -- REUSEABLE, REFRESHABLE, ENABLED, RESIDENT * 04140020 * * 04170020 *NOTES -- THE OPERATION OF THIS MODULE DOES NOT DEPEND UPON A * 04200020 * PARTICULAR INTERNAL REPRESENTATION OF THE EXTERNAL CHARACTER * 04230020 * SET. * 04260020 * * 04290020 ********************************************************************** 04320020 * * 04350020 ********************************************************************** 04380020 * * 04410020 R0 EQU 0 . WORK REG 04440020 * ADDR OF LAST THING POSTED 04470020 R1 EQU 1 . PARAMETER REG 04500020 * WORK REG 04530020 R2 EQU 2 . ADDRESS OF CPB UNIT 04560020 * ADDRESS OF QCB OT POST TO 04590020 * ADDRESS OF BUFFER UNIT 04620020 RSCB EQU 3 . SCB ADDRESS 04650020 R3 EQU 3 . 04680020 RLCB EQU 4 . LCB ADDRESS 04710020 R5 EQU 5 . WORK REG 04740020 * DUMMY CPB REG 04770020 RPRF EQU 6 . BUFFER PREFIX ADDRESS 04800020 RPREFIX EQU 6 . BUFFER PREFIX ADDRESS 04830020 R6 EQU 6 . 04860020 RQCB EQU 7 . 04890020 R7 EQU 7 . 04920020 R8 EQU 8 . NUMBER OF UNITS IN BFR 04950020 * ADDR OF LAST UNIT OF BFR 04980020 RPQ EQU 9 . ADDRESS OF PRIORITY 05010020 * DEST QCB 05040020 R9 EQU 9 . 05070020 * WORK REG 05100020 * ADDRESS TO MOVE FROM 05130020 RDCB EQU 10 . ADDRESS OF DCB 05160020 R10 EQU 10 . VALUE OF ADDR FOR RECORD 05190020 R11 EQU 11 . DISPATCHER BASE 05220020 * WORK REG 05250020 * COUNT TO MOVE 05280020 RBASE EQU 12 . PROGRAM BASE REG 05310020 RSAVE EQU 13 . ADDR OF AVT SAVE 2 05340020 R14 EQU 14 . ADDRESS TO MOVE TO 05370020 * WORK REG 05400020 R15 EQU 15 . ADDRESS OF CPB 05430020 ********************************************************************** 05460020 ** * 05490020 * CONDITIONS FOR BCR INSTRUCTIONS S21101 05500020 * S21101 05510020 ONES EQU 1 . S21101 05512020 PLUS EQU 2 . S21101 05514020 NOTZERO EQU 7 . S21101 05516020 ZERO EQU 8 . S21101 05518020 EQUAL EQU 8 . S21101 05518420 NOTMINUS EQU 11 . S21101 05518820 NOTONES EQU 14 . S21101 05519220 LASTNOFF EQU X'04' SA52971 05519300 DCBOPEN EQU X'10' . 05520020 XXCTUSED EQU X'80' . THE DISABLED CT IS BEING REFER'D 05550020 XCTZERO EQU X'7F' . 05610020 LGB EQU X'80' . DSORG TO INDICATE LGB S22024 05615022 INCR EQU 4 . INCREMENT VALUE FOR ADDR S21101 05620020 DIV4 EQU 2 . VALUE TO DIVIDE BY 4 S21101 05630020 EIGHT EQU 8 MASK FOR ICM @OZ09304 05632000 AD EQU 7 ICM/STCM MASK Y02027 05635006 FOUR EQU 4 CONSTANT @OS79957 05635600 FIVE EQU 5 CONSTANT @OS79957 05636200 TWO EQU 2 . @OZ14195 05637000 * 05640020 * 05670020 * THE FOLLOWING FLAGS ARE IN THE ERB STATUS BYTE 05700020 * X'08' MUST NEVER BE ON 05730020 * 05760020 * 05790020 XXHMSG EQU X'80' . END OF MSG RCVD IN HM 05820020 XRDERR EQU X'20' . LOGICAL RD ERR FROM DISK 05850020 * INITIATE MODE WITH CORE QUEUES - THE NTXT IS NOT THERE YET 05880020 * IF A LOGICAL READ ERROR OCCURS IN INITIATE MODE - FA WILL 05910020 * DROP THE ERB LEAVING LCBDLNK SWITCH SET TO 'NOT POSTABLE' 05940020 * PCI WILL NOT POST THE ERB. LOGICAL READ ERROR WILL ALSO BE 05970020 * SET IN ERBST. WHEN HM RECEIVES A BFR IN INIT MODE UNDER 06000020 * THESE CONDITIONS - THE ERB FOR THE DESTINATION LINE WILL 06030020 * BE REPOSTED TO FA WITH AN E0 PRIORITY REQUESTING 06060020 * THE BUFFERS OF THIS MESSAGE AGAIN. THE DESTINATION LCB 06090020 * WILL BE FOUND FROM THE LCBINSRCE CHAIN OF THE SOURCE LCB. 06120020 XCOMPL EQU X'02' . 06150020 * COMPLETE REQUEST HAS BEEN DONE 06180020 XXXINQ EQU X'10' . ERB IS IN BFR RTN Q 06210020 XMSG EQU X'40' . END OF MSG FROM THE QUEUE 06240020 * 06270020 * 06300020 * THE FOLLOWING FLAGS ARE IN THE BUFFER TIC FIELD S21101 06330020 * 06360020 * 06390020 XPARTIAL EQU X'40' . 06420020 * NOT A COMPLETE BFR - NO PRFX HERE 06450020 XREUSDSK EQU X'20' . 06480020 * BFR TO BE QUEUED ON REUSABLE DISK 06510020 XSPECIAL EQU X'80' . 06540020 * THE SPECIAL OPERATION REQUIRED IS DONE BUT BFR NOT WRITTEN 06570020 XBUFFER EQU X'01' . 06600020 * FEFO PTR DONE BUT BFR NOT WRITTEN 06630020 XNRDISK EQU X'10' . TO BE QUEUED ON MR DISK 06660020 XSRVCD EQU X'02' . TO BE FLAGGED SERVICED 06690020 * * 06720020 ONE EQU 1 . 06750020 PCIADD EQU X'50' . S22026 06780022 XLOGEOM EQU X'80' . NO PCI SPEC.- END OF INIT 06810020 * IAL REQUEST FOR LINE 06840020 * PRFTIC FLAGS WILL BE AS FOLLOWS 06870020 * X'28' - TO BE QUEUED ON REUS DISK 06900020 * X'18' - TO BE QUEUED ON NONREUS DISK 06930020 * AS SET BY DEST SCHEDULER 06960020 * X'88' - SPECIAL FLAG - 2 OPERATIONS WERE TO BE 06990020 * PERFORMED AS A RESULT OF THIS BUFFER BUT CPBS WERE 07020020 * NOT AVAILABLE FOR BOTH 07050020 * X'48' - PARTIAL BUFFER ONLY - NOT ENOUGH CPBS WERE 07080020 * AVAILABLE TO QUEUE THE LAST UNITS 07110020 * WITH THIS FLAG THE SCB ADXR AND NO. OF UNITS LEFT 07140020 * TO QUEUE IN THE BUFFER WILL BE IN THE FIRST S21101 07170020 * WORD . THE VALUE OF ADDR IS IN THE SCB 07200020 * X'01'- FEFO PTR HAS BEEN WRITTEN BUT NOT THE BUFFER 07230020 * X'02' - TO BE FLAGGED SERVICED 07260020 * * 07290020 * ERB STATUS WILL BE AS FOLLOWS 07320020 * IT MUST NEVER HAVE THE X'08' BIT ON 07350020 * X'04' - TRANSMISSION ERROR - TREAT THE REQUEST 07380020 * AS COMPLETED 07410020 * X'02' / COMPLETE - ALL INFO THAT WAS REQUESTED HANDLED 07440020 * ALL CPBS ARE NOT IN 07470020 * XX'20' - ERB IS ALREADY IN THE BFR REQ Q 07500020 * * 07530020 *********************************************************************** 07560020 * 07590020 * THIS ROUTINE WILL INITIALIZE CPB(S) TO WRITE UNIT(S) OF A S21101 07620020 * BUFFER TO DISK OR TO READ DISK RECORDS TO SATISFY A REQUEST 07650020 * MADE BY AN ERB. 07680020 * 07710020 *********************************************************************** 07740020 USING AVTSAVE2,RSAVE . S22025 07770022 USING IEDQLCB,RLCB . 07800020 USING IEDQDATA,R2 . 07830020 USING IEDQSCB,RSCB . 07860020 USING IEDQPRF,RPREFIX . 07890020 USING IEDQDISP,R11 . 07920020 USING IEDQQCB,RQCB . 07950020 USING IEDQPQCB,RPQ . 07980020 USING IHADCB,R10 . 08010020 USING IEDQCPB,R15 . 08040020 *********************************************************************** 08070020 EJECT 08100020 *STCB FOR DISK I/O QCB * 08130020 SPACE 2 08160020 DC AL1(DSPMCPL2) . 08190020 DC AL1(PROCESS-&CH) . 08220020 SPACE 2 08250020 CPBINIT EQU * . 08280020 USING *,RBASE . 08310020 LR RBASE,R15 . 08340020 SR R0,R0 . 08370020 * CLEAR POST REG 08400020 &CH IEDHJN NOCPBQ . MODULE ID AND DATE 08430022 SPACE 3 08550020 * THIS SECTION DEALS WITH A NEWLY POSTED ELEMENT - IF IT IS 08580020 * A BUFFER IT WILL GET THE SCB PRI FOR THE PRILVL QCB AND 08610020 * SAVE IT. IF A MESSAGE IS TO BE SERVICED IT WILL FORCE THIS 08640020 * REQUEST TO BE HANDLED FIRST. 08670020 SPACE 3 08700020 MVI PRFKEY-IEDQPRF(R1),XCTZERO . 08760020 LR RPRF,R1 . 08790020 TM PRFTIC,CPBTICC . IS THIS A BFR 08880020 BNO TESTQ . BR NOT BFR A41025 08910020 LA R2,0(RPRF) . INSURE POSITIVE R2 A41025 08920020 NI PRFTIC,CPBTICC+XNRDISK+XREUSDSK 09240020 * THESE ARE THE ONLY VALID FLAGS AT THIS POINT S21101 09270020 L RLCB,PRFLCB-1 . LCB ADDR 09300020 L RSCB,LCBSCBA-1 . SCB ADDR 09330020 IC R2,SCBPRI . SAVEPRTY QCB 09360020 L RQCB,SCBDESTQ-1 . 09390020 ST RQCB,PRFQCBA-1 . 09420020 STC R2,PRFKEY . 09450020 AIF (&A NE 1).F002 09480020 B SRVCDMSG . 09510020 AGO .F003 09540020 .F002 ANOP 09570020 CLI PRFPRI,PRIDKSRV . 09600020 BE SRVCDMSG . 09630020 CLI PRFPRI,PRIFEFO . IS THIS A REQUEST AN UP S21101 09640020 * DATE OF A FEFO POINTER S21101 09650020 BE UPFEFO . YES, GO UPDATE DISK PTRS21101 09652020 * NO, NOT SO S21101 09654020 LH R1,PRFSIZE . 09660020 BAL R14,SUBTRKEY . 09690020 AH R1,AVTKEYLE . 09720020 STC R1,PRFPRI . 09750020 TM PRFSTAT1,PRFNLSTN . LAST BFR FOR LOCK 09780020 BO CKINIT . BR NO - NO FLAG NEEDED 09810020 TM PRFSTAT1,PRFDUPLN+PRFERMGN . 09840020 * DUPL HDR OR ERRMSG FOR ORGIGINAL MSG 09870020 BNZ CKINIT . BR IF EITHER 09900020 TM QCBFLAG,QCBPROC . IS THIS THE LOCK LINE DEST 09930020 BO CKINIT . BR IF NOT LINE DEST 09960020 TM SCBSTATE,SCBLCK1N+SCBMSGLN . LOCK 09990020 BZ CKINIT . BR NOT LOCK 10020020 BM EXTLOCK . 10050020 NI SCBSTATE,X'FF'-(SCBLCK1N+SCBMSGLN) . FLAGS OFF 10080020 EXTLOCK EQU * . 10110020 OI PRFTIC,XBUFFER . SET FLAG NOT TO WRITE FEFO 10140020 CKINIT EQU * . 10170020 ST RPRF,AVTDOUBL . 10200020 CLC AVTDOUBL+1(3),SCBDEOB+1 . WAS THE LAST SUCCESSFUL EOB 10230020 * IN THIS BUFFER 10260020 BNE TESTQ . 10290020 MVC SCBDEOB+1(3),PRFCRCD . SET ADDR THIS RECORD 10320020 .F003 ANOP 10350020 TESTQ EQU * . 10380020 NC AVTNCPBQ+1(2),AVTNCPBQ+1 . 10410020 BZ TESTELEM . 10440020 LA R2,AVTNCPBQ . ADDR OF NO CPBQ 10470020 LR R15,RPRF . SET FOR QMGR 10500020 BAL R11,ENQMGRB . 10530020 SPACE 3 10560020 * CHECKS FOR MORE ELEMENTS TO BE PROCESSED BEFORE THE EXITS21101 10590020 SPACE 3 10620020 PROCESS EQU * . 10650020 ICM RPREFIX,AD,AVTNCPBQ+ONE ANY CPBS THERE Y02027 10680006 BZ CALLEXCP . 10710020 MVC AVTNCPBQ+1(3),PRFLINK . DELINK ELEM 10770020 TESTELEM EQU * . 10800020 AIF (&A NE 1).F004 10830020 B ERB . 10860020 AGO .F005 10890020 .F004 ANOP 10920020 TM PRFTIC,CPBTICC . IS THIS A BFR 10950020 BNO ERB . 10980020 SPACE 3 11010020 * WILL WRITE A BUFFER OF DISK ALONG WITH THE FEFO POINTER 11040020 * IF NEEDED AND WILL HANDLE CANCELED MESSAGE REQUESTS AND 11070020 * SERVICED MESSAGES. 11100020 SPACE 3 11130020 * 11160020 * FOR A BUFFER WHICH HAS BEEN PARTIALLY WRITTEN ON DISK, THE FIRST 11190020 * OF THE UNITS NOT WRITTEN WILL APPEAR ON THE NCPBQ. S21101 11220020 * THE TIC FIELD WILL HAVE X'18' INDICATING A PARTIALLY QUEUED 11250020 * BUFFER AND A '20' TO INDICATE REUSEABLE DISK OR X'40' FOR NON- 11280020 * REUSABLE DISK. PRFKEY WILL HAVE THE VALUE 11310020 * OF ADDRESS FOR THIS UNIT IN BYTES 2,3,4, 11340020 * AND THE NUMBER OF REMAINING UNITS IN BYTE 1 11370020 * 11400020 TM PRFTIC,XPARTIAL . HAS THIS BFR BEEN PARTIALLY 11430020 BNO CKSERVD . WRITTEN ON DISK - BR NO 11460020 SR R8,R8 . 11490020 IC R8,PRFKEY . NO. OF UNITS LEFT 11520020 L R10,PRFKEY . VALUE OF ADDR 11550020 REQUEST EQU * . 11580020 BAL R9,BIGSUBR . 11610020 BAL R9,SAVE . 11640020 STCM R10,AD,CPBADDR+ONE SET ABSOLUTE RECORD NO. Y02027 11670006 ST R10,DATFEFO-1-IEDQDATA(R6) . SET REC NO THIS REC 11700020 MVI DATFLAGS-IEDQDATA(R6),DATNPRFX . SET FLAG 11730020 XC DATCOUNT-IEDQDATA(2,R6),DATCOUNT-IEDQDATA(R6) . 11760020 BAL R11,EXCPINQ1 . 11940020 BCT R8,NEXTXTRA . DECR NO UNITS IN BFR 11970020 IC R1,AVTDOUBL . 12000020 STC R1,DATCOUNT-IEDQDATA(R6) . SET SIZE OF DATA IN 12030020 B PROCESS . LAST UNIT 12060020 NEXTXTRA EQU * . 12090020 LA R10,INCR(0,R10) . ADD 4 TO ADDR S21101 12120020 NEXTRA EQU * . 12150020 LH R2,AVTDOUBL . 12180020 L R6,PRFTIC . NEST UNIT 12210020 STC R2,PRFTIC . RESTORE PARTIAL FLAGS 12240020 STCM R2,PLUS,PRFPRI RESTORE SIZE OF LAST UNITY02027 12270006 B REQUEST . 12330020 SAVE EQU * . 12360020 ICM R2,PLUS,PRFPRI SAVE SIZE OF ALST UNIT Y02027 12390006 IC R2,PRFTIC . SAVE FLAGS 12450020 STH R2,AVTDOUBL . SAVE ALL 12480020 BR R9 . RETURN 12510020 RENQELEM EQU * . 12540020 TM PRFTIC,XPARTIAL+CPBTICC .IS THIS A PARTIAL BFR 12570020 BNO ENQUEUE . BR NO 12600020 ST R10,PRFKEY . VALUE OF ADDR 12630020 STC R8,PRFKEY . COUNT OF REMAINING UNITS 12660020 ENQUEUE EQU * . 12690020 * THIS ELEMENT MUST BE PUT FIRST ON THE FIFO NCPBQ 12720020 ICM R14,AD,AVTNCPBQ+1 GET TOP OF QUEUE Y02027 12750006 STCM R14,AD,PRFLINK CHAIN TO BUFFER Y02027 12760006 ST RPREFIX,AVTNCPBQ . PUT ELEM FIRST ON CHAIN 12780020 BNZ CALLEXCP . BR YES 12840020 ST RPREFIX,AVTNCPBQ+4 . IF NO SET PTR TO LAST 12870020 B CALLEXCP . 12900020 BIGSUBR EQU * . 12930020 BAL R14,REQCPB . 12960020 L R1,CPBXREAF . UNIT ADDR 13020020 BAL R14,UNITFREE . FREE BUFFER S21101 13050020 FREEUNIT EQU * . 13140020 L RQCB,PRFQCBA-1 . 13170020 BAL R14,WRKD . 13200020 BR R9 . 13230020 .F005 ANOP 13260020 AIF (&A EQ 1).F006 13830020 WRKD EQU * . 13860020 MVI CPBRDWR,CPBWRKC . 13890020 ST RPREFIX,CPBXREAF . ADDR OF START OF BFR TO WR 13920020 MVI CPBXDWR,CPBWRC . INTO DATA FIELD 13950020 * A '00' FLAG INDICATES THAT THIS RECORD HAD A PREFIX S21101 13980020 * THE FEFO POINTER IS SET TO 0. 14010020 BR R14 . RETURN 14040020 REQCPB1 EQU * . 14070020 LA R2,0(R3) . INSURE R2 IS POSITIVE S21101 14100020 * AND NON ZERO S21101 14110020 LNR R2,R2 . 14130020 REQCPB EQU * . 14160020 ICM R15,AD,AVTFCPB+ONE ANY CPBS THERE Y02027 14190006 BZ RENQELEM . BR NO 14220020 MVC AVTFCPB+1(3),CPBNEXT . DELINK 14280020 LTR R2,R2 . 14310020 BCR NOTMINUS,R14 . S21101 14340020 L R2,CPBXREAF . SET UNIT ADDR FOR WR DATA 14400020 * TO PASS ON - IT SHOULD REMAIN THE SAME 14430020 MVI CPBRDWR,CPBWRC . WRITE DATA COMMAND 14460020 MVI CPBXDWR,CPBNOPC . NOP COMMAND CODE 14490020 MVC CPBADDR+1(3),PRFCHDR . SET VALUE OF ADDR 14550020 TM PRFSTAT1,PRFNHDRN . IS THIS A HEADER 14580020 BCR 1,R14 . BR IF NOT HDR S21101 14610020 SETCRCD EQU * . 14640020 MVC CPBADDR+1(3),PRFCRCD . SET ADDR OF THIS BFR IF HDR 14670020 BR R14 . 14850020 UPFEFO EQU * . SA51783 14851022 MVI PRFSTAT1,X'FF'-PRFNLSTN-PRFNHDRN . SA51783 14852022 * FLAG AS PRIFEFO REQUEST SA51783 14853022 NOSPEC EQU * . SA51783 14854022 BAL R14,REQCPB . GO REQUEST A CPB SA51783 14855022 SPACE 14856022 L R11,AVTEA . SET DSP BASE FOR SUBRTN SA51783 14857022 L R14,PRFTIC . SAVE RETURN ADDRESS SA51783 14858022 ST R15,PRFTIC . PASS ADDRESS OF CPB SA51783 14859022 LR R15,R14 . SET RETURN ADDRESS SA51783 14860022 BALR R14,R15 . RETURN TO CALLING SBRTN SA51783 14861022 SPACE 14862022 BAL R11,EXCPINQ1 . GO ENQUEUE CPB SA51783 14863022 B PROCESS . GO PROCESS NEXT ELEMENT SA51783 14864022 SPACE 14865022 CKSERVD EQU * . 14880020 CLI PRFSTAT1,X'FF'-PRFNLSTN-PRFNHDRN . SA51783 14886022 * PRIFEFO REQUEST SA51783 14892022 BE NOSPEC . BR YES SA51783 14898022 SPACE 14904022 L RLCB,PRFLCB-1 . LCB ADDRESS 14910020 L RQCB,PRFQCBA-1 . 14940020 SR R11,R11 . 14970020 IC R11,PRFKEY . 15000020 BAL R14,FINDEST2 . 15030020 TM PRFSTAT1,PRFNLSTN . IS THIS A LAST BFR 15060020 BO CKCNCLD . BR NO 15090020 TM PRFTIC,XSRVCD . TO BE FLAGGED SERVICED 15120020 BNO CKCNCLD . BR NO 15150020 B JUSTONE . ALL OTHER PROCESSING IS DONE 15180020 .F006 ANOP 15210020 SRVCDMSG EQU * . 15240020 OI PRFTIC,XSRVCD . SET FOR LATER IN CASE OF 15270020 TM PRFSTAT1,PRFNHDRN . IS THIS A HDR-EOM SA52971 15300022 BNO HDRLAST . BR YES, IF NOT HDR-EOM, SA52971 15305022 MVC PRFCRCD(3),PRFCHDR . SET REC NOS AND FLAGS SA52971 15310022 MVC PRFCORE(3),PRFCHDR . SA52971 15315022 NI PRFSTAT1,X'FF'-PRFNHDRN .TO LOOK LIKE HDR-EOM SA52971 15320022 HDRLAST EQU * . SA52971 15325022 SR R11,R11 . 15330020 IC R11,PRFTQBCK . GET PRI LEVEL SA52971 15360022 BAL R14,FINDEST2 . 15390020 TM QCBFLAG,QCBPROC . APPLICATION PROGRAM S21101 15390122 BO FEFORSET . YES - BR S21101 15390222 *** THIS SUBROUTINE DESTROYS REGS 0,1,2, AND 11. THE QCB SA52971 15390322 * EXTENSION IS RETURNED IN REG2. RETURN IS TO +0 IF THIS SA52971 15390622 * IS NOT A CONCENTRATOR AND TO +4 IF IT IS A CONCENTRATOR. SA52971 15390922 BAL R10,FINDLVL . GO SEE IF PRI LVL SA52971 15391222 B SETSDFFO . BR IF NOT A CONC SA52971 15391522 TM QCBEFLG-IEDQQCBE(R2),QCBEOPL . SA52971 15391822 * IS THIS A PLVL CONC SA52971 15392122 BNO SETSDFFO . BR IF NOT PLVL SA52971 15392422 *** WHEN MARKING SRVCD, IF CONC IS PLVL QUEUED, THE SCB USED SA52971 15392722 * IS NOT THE REAL ONE, SINCE 'SCBFEFO' CANNOT BE UPDATED, SA52971 15393022 * HM03 WILL UPDATE THE QCB EXTENSION; THEREFORE, THE SA52971 15393322 * EQUIVALENT OF SCBFEFO (PRFSRCE) MUST NOW BE UPDATED WITH THESA52971 15393622 * CORRECT FEFO POINTER. SA52971 15393922 MVC PRFSRCE(3),QCBEFEFO-IEDQQCBE(R2) SAVE FEFO SA52971 15394222 XC QCBEHDR-IEDQQCBE(3,R2),QCBEHDR-IEDQQCBE(R2) ZERO SA52971 15394522 * HDR PTR AS HM03 FLAG SA52971 15394822 B FEFORSET . GO DON'T RESET 'SENDING'SA52971 15395122 SETSDFFO EQU * . SA52971 15395422 NI QCBFLAG,X'FF'-QCBSDFFO . RESET CURRENTLY SENDING SA52971 15395722 FEFORSET EQU * . SA52971 15396022 LR R1,R6 . SET COMPARE REG WITH BFRSA52971 15396322 * ADDRESS SA52971 15396622 AIF (&A NE 3).F006AA . SA52971 15396922 TM PRFCRCD+L'PRFCRCD-1,CPBQTYPE IS THIS DISK ADDR SA52971 15397222 BNZ TSTLF . YES, WE'RE SET FOR COMP SA52971 15397522 L R1,PRFCRCD-1 . GET FEFO CHAIN ADDRESS SA52971 15397822 TSTLF EQU * . SA52971 15398122 .F006AA ANOP , . SA52971 15398422 CLC PRFCRCD-IEDQPRF(3,R1),QCBLFEFO LAST MSG SA52971 15398722 BNE NOQCB . NO, BR S22025 15399522 MVI QCBDATFL,DATSENT . FLAG MESSAGE SERVICED S21101 15411021 MVC QCBDATSQ(2),PRFTQBCK+1 . SAVE SEQ OUT SA52971 15412022 * IS THIS SCAN START SA50192 15412622 CLC PRFCRCD-IEDQPRF(,R1),QCBPFEFO . SA50192 15413222 BNE NOQCB . BR NO SA50192 15413822 SPACE 15414422 OI QCBDATFL,DATIFEFO . SET INITIAL FEFO SA50192 15415022 NOQCB EQU * . S21101 15416021 BAL R14,DECRMGCT . 15420020 TM QCBDSFLG,QCBDISK CORE ONLY @SA71965 15423000 BNZ NOQCB1 BRANCH IF NO @SA71965 15426000 NC QCBFFEFO,QCBFFEFO FEFO CHAIN EMPTY @SA71965 15429000 BNZ NOQCB1 BRANCH IF NO @SA71965 15432000 XC QCBLFEFO,QCBLFEFO ERASE NONUNIQUE @SA71965 15435000 * CORE QUEUE BRF ADDR @SA71965 15438000 NOQCB1 EQU * @SA71965 15441000 L R1,PRFTIC . SAVE NEXT UNIT 15450020 MVI SCBHBFNO,AVTEZERO . CLEAR FOR NEXT MSG 15570020 CLI PRFNBUNT,ONE . 15720020 BE JUSTONE . 15750020 IC R5,PRFNBUNT . NO. OF UNITS IN THIS BFR 15780020 MVI PRFNBUNT,ONE . REPLACE NUMBER OF UNITS 15810020 BCTR R5,0 . FREED 15840020 * FREE ALL BUT FIRST UNIT - 1 HAS NEXT UNIT ADDR 15870020 STC R5,PRFNBUNT-IEDQPRF(R1) . NEW NO. OF UNITS 15900020 BAL R14,RTNBFR . 15930020 L RQCB,PRFQCBA-1 . RESTORE QCB ADDR 15960020 JUSTONE EQU * . 15990020 AIF (&A NE 3).F008 16020020 LA R15,FROMDISK . SET RTN ADDR 16050020 TM QCBDSFLG,QCBCORE . MSG IN CORE 16080020 BCR NOTONES,R15 . BR NO S21101 16110020 * 16140020 * WHEN A MSG IS READ TO SEND, SCBQTYPE IS SET TO INDICATE WHICH 16170020 * TYPE OF Q THE MSG IS BEING SENT FROM. 16200020 * 16230020 * PRFTIC WILL BE FLAGGED WITH A X'80' IF A SPECIAL CONDITION EXISTS 16260020 * 16290020 TM PRFTIC,XSPECIAL . HAS THIS MSG BEEN FREED FROM 16320020 BCR ONES,R15 . THE CORE Q - BR YES S21101 16350020 LR R7,R15 . 16410020 TM PRFCHDR+L'PRFCHDR-1,CPBQTYPE SENT FROM CORE SA52971 16440022 BNZ DISKMSG . NO, BR SA52971 16450022 .F008 AIF (&A EQ 2).F009 16470020 TM LCBSTAT1,LCBINITN . SENDING INIT MSG 16500020 BNO FREEIT . BR NO 16530020 * IF INITIATE MODE - THE MSG COULD BE FLAGGED SERVICED ( AS 16560020 * IN THE CASE OF ADDRESSING ERRORS) BEFORE THE MESSAGE HAS 16590020 * COMPLETELY ARRIVED. - IF THIS HAPPENS, THE MSG SHOULD 16620020 * NOT BE FLAGGED SERVICED BUT ADDED TO THE FEFO Q WHEN 16650020 * IT IS COMPLETELY RECEIVED. 16680020 L R1,PRFCORE-1 . ADDR OF A BFR OF THIS 16740020 * MSG IN THE QUEUE. 16770020 L R1,PRFLCB-1-IEDQPRF(R1) . ADDR OF SRCE LCB 16800020 TM LCBSTAT1-IEDQLCB(R1),LCBINITN+LCBRECVN . 16830020 * IS SRCE LINE STILL TRANSMITTING AN INIT MODE MSG 16860020 BNO FREEIT . BR NO 16890020 L R7,LCBINSRC-1-IEDQLCB(R1) . ADDR OF DEST LINE 16920020 LA R7,0(R7) . CLEAR FOR COMPARE 16950020 LA RLCB,0(RLCB) . CLEAR FOR COMPARE 16980020 CLR R7,RLCB . STILL SENDING TO THIS LINE 17010020 BNE FREEIT . BR NO 17040020 * IF THE LCB HAS REACHED BFR DISPOSITION - THE EOM BFR 17070020 * HAS REACHED DEST. SCH. - BD WILL FREE ALL UNUSED BFRS 17100020 * BEFORE POSTING THE EOM BFR TO H M. 17130020 NC LCBLSPCI-IEDQLCB(2,R1),LCBLSPCI-IEDQLCB(R1) . 17160020 * HAVE THE BFRS BEEN FREED 17190020 BZ FREEIT . BR IF BFRS HAVE BEEN BFRRE 17220020 * BY BD 17250020 NI LCBSTAT1-IEDQLCB(R1),X'FF'-LCBINITN . 17280020 * RESET INIT MODE FOR THIS SOURCE TO FORCE MSG INTO FEFO 17310020 B POSTBFR . DO NOT FREE MSG FROM Q 17340020 FREEIT EQU * . 17370020 L R15,ADFREEMS . FREE MSG FROM CORE QUEUE UNI 17400020 BALR R7,R15 . UNITS 17430020 L RQCB,PRFQCBA-1 . RESTORE QCB ADDR 17460020 AIF (&A NE 3).F009 17490020 TM QCBDSFLG,QCBREUS+QCBNREUS . 17520020 * WAS THIS MSG DISK QUEUED ALSO 17550020 BZ POSTBFR . BR NO 17580020 * 17670020 * THIS SPECIAL FLAG MEANS THE MSG HAS BEEN FREED FROM THE CORE Q 17700020 * BUT NOT FLAGGED SERVICED ON DISK. 17730020 * 17760020 .F009 AIF (&A EQ 1).F010 17790020 AIF (&A EQ 2).F009A 17820020 FROMDISK EQU * . 17850020 OI PRFTIC,XSPECIAL . FLAG SPECIAL - FREED FROM CORE 17880020 LPR R2,R2 . RESET 2 17940020 .F009A ANOP 17970020 BAL R14,REQCPB1 . SET A CPB 18000020 USING IEDQDATA,R2 S21101 18003021 MVI DATFLAGS,DATSENT . FLAG MSG SERVICED S21101 18006021 TM PRFSVFFO+L'PRFSVFFO-1,CPBQTYPE DISK ADDR SA52971 18016000 BNZ DISKADDR BRANCH YES SA52971 18026000 NI PRFSVFFO+L'PRFSVFFO-1,X'FF'-LASTNOFF INSURE SA52971 18036000 * PROPER CORE ADDRESS SA52971 18046000 DISKADDR EQU * SA52971 18056000 MVC DATFEFO(3),PRFSRCE . SET FEFO PTR SA52971 18104022 MVC DATSEQOT(2),PRFTQBCK+1 . SET SEQ OUT SA52971 18124022 CLC QCBPFEFO,PRFCRCD . IS THIS PFEFO SA50192 18128022 BNE NOTPFEFO . BR NO SA50192 18132022 SPACE 18136022 OI DATFLAGS,DATIFEFO . SET INITIAL FEFO SA50192 18140022 NOTPFEFO EQU * . SA50192 18144022 BAL R11,EXCPINQ1 . 18150020 .F010 ANOP 18180020 POSTBFR EQU * . 18210020 LR R1,RPREFIX . FREE THIS UNIT 18240020 BAL R14,UNITFREE . S21101 18270020 B PROCESS . GO GET NEXT ELEM 18300020 DECRMGCT EQU * . 18330020 LH R11,QCBMSGCT . DECREASE MSGCT BY ONE M6298 18360020 BCTR R11,0 . M6298 18390020 STH R11,QCBMSGCT . M6298 18420020 BR R14 . 18450020 AIF (&A EQ 1).F011 18480020 CKCNCLD EQU * . 18510020 TM PRFSTAT1,PRFCNCLN . 18540020 BNO CKDUPLHD . BR NO 18570020 AIF (&A NE 3).F010BB 18600020 TM QCBDSFLG,QCBCORE . CORE W/ DISK BACKUP 18630020 LA R7,NOBACKUP . SET RTN ADDR 18660020 BCR NOTONES,R7 . BR IF DISK ONLY S21101 18690020 * IF YES - FREE THE MSG FROM THE CORE QUEUE 18720020 TM LCBSTAT1,LCBINITN . INIT MODE 18750020 BNO DISKMSG . BR NO - FREE MSG 18780020 TM LCBINSRC+2,XXXON . BEING SENT 18810020 BCR NOTONES,R7 . BR IF BEING SENT-NO FREE S21101 18840020 DISKMSG EQU * . 18870020 L R15,ADFREEMS . ADDR OF SUBROUTINE 18900020 MVC AVTDOUBL+4(3),PRFCRCD . DISK ADDR OF BFR 18930020 TM PRFSTAT1,PRFNHDRN . THIS A HDR 18960020 BNO CRCDOK . BR IF HDR 18990020 MVC AVTDOUBL+4(3),PRFCHDR . ADDR OF HDR ON DISK 19020020 CRCDOK EQU * . 19050020 L R2,QCBCFHDR-1 . ADDR OF FIRST ON P QCB 19080020 LA R2,0(R2) . CLEAR HI 19110020 CKCRCD EQU * . 19140020 LTR R2,R2 . IS ONE THERE 19170020 BCR ZERO,R7 . IF NO - RETURN S21101 19200020 ST R2,AVTDOUBL . ADDR OF BFR TO FREE 19230020 CLC AVTDOUBL+4(3),PRFCRCD-IEDQPRF(R2) . 19260020 * THIS THE HDR COPY OF THIS MSG 19290020 BE HAVEADDR-FREEMSG(R15) . BR YES - THIS IS IT - GO 19320020 * FREE IT 19350020 L R2,PRFNHDR-IEDQPRF(R2) . NEXT HDR IN Q 19380020 SRL R2,8 . SHIFT ADDR OVER 19410020 B CKCRCD . GO LOOK AT THIS ONE 19440020 NOBACKUP EQU * . 19470020 .F010BB ANOP 19500020 L RQCB,PRFQCBA-1 . RESTORE QCB ADDR 19530020 TM PRFSTAT1,PRFNHDRN . HDR SEG 19560020 BNO WRITE . YES - PUT CNCLD FLAG WITH BFR 19590020 TM PRFTIC,XSPECIAL . 19620020 BO WRITEBFR . CNCLD FLAG HAS BEEN DONE 19650020 BAL R14,REQCPB1 . 19680020 BAL R14,DECRMGCT . 19710020 XC DATFLAGS-IEDQDATA(6,R2),DATFLAGS-IEDQDATA(R2) . 19740020 * CLEAR DATA FIELD 19770020 MVI DATFLAGS-IEDQDATA(R2),DATCNCLD .SET CNCLD FLAG 19800020 OI PRFTIC,XBUFFER+XSPECIAL . FLAG FOR CNCL DONE AND FEFO 19830020 BAL R11,EXCPINQ1 . 19860020 B WRITEBFR . TO WRITE OUT THIS BFR 19890020 CKDUPLHD EQU * . 19920020 * FROM BFR PRFX INTO SCB PRF WORK AREA 19950020 TM PRFSTAT1,PRFDUPLN . IS THIS A DUPL HDR 19980020 BNO WRITEBFR . BR NO 20010020 BAL R8,SETFEFO . 20040020 BAL R14,REQCPB . 20070020 NI PRFTIC,X'FF'-XBUFFER . SET FLAG OFF 20100020 LR R10,R6 . 20130020 L R6,CPBXREAF . ADDR OF CPB UNIT 20160020 LH R14,AVTKEYLE . 20190020 EX R14,TRANSFER . TRANSFER DATA TO CPB UNIT 20220020 BAL R14,WRKD . 20250020 * SAVE PRI LEVEL ON DISK SA51078 20260022 MVC PRFPLQCB,PRFKEY-IEDQPRF(R10) . SA51078 20270022 XC DATFLAGS-IEDQDATA(8,R6),DATFLAGS-IEDQDATA(R6) . CLEAR 20280020 LR R2,R10 SAVE REG @YA06869 20283061 SR R11,R11 CLEAR FOR IC @YA06869 20286061 IC R11,PRFPLQCB GET PRIORITY LEVEL @YA06869 20292061 BAL R14,FINDEST2 GET PRIORITY QCB @YA06869 20298061 MVC DATFLAGS-IEDQDATA(,R6),QCBDATFL SET DATA FLAGS @YA06869 20304061 LR R10,R2 RESTORE REG @YA06869 20307061 BAL R14,SETCRCD . SET REC. NO. AND DATA SET 20310020 BAL R11,EXCPINQ1 . 20340020 LR R1,R10 . 20370020 L R2,LCBRCQCB . ADDR TO POST TO 20400020 MVI PRFPRI-IEDQPRF(R1),PRIRCQCB . SET PRTY 20430020 LA R14,PROCESS . SET RTN ADDR 20460020 NI PRFTIC-IEDQPRF(R1),X'FF'-XBUFFER . FLAG OFF 20490020 B POST . POST BFR 20520020 CNCLDCK EQU * . 20550020 TM PRFSTAT1,PRFNHDRN . IF NOT A HDR - IGNORE IT 20580020 BO NOSET . 20610020 BAL R14,DECRMGCT . M6298 20620020 OI DATFLAGS-IEDQDATA(R6),DATCNCLD . SET CNCLD FLAG 20640020 B NOSET . CONTINUE 20670020 WRITEBFR EQU * . 20700020 TM PRFSTAT1,PRFNLSTN . IS THIS A LAST SEG 20730020 BO WRITE . BR NO 20760020 LH R1,PRFSRCE SOURCE OFFSET @YA03936 20762061 N R1,AVTCLRHI CLEAR HI HALF @YA03936 20764061 LTR R1,R1 SOURCE SPECIFIED? @YA03936 20766061 BZ NOTPROC BRANCH IF NO @YA03936 20768061 L R15,AVTRNMPT CORRECT OFFSET TO @YA03936 20770061 BALR R14,R15 AN ADDRESS @YA03936 20772061 TM TRMSTATE-IEDQTRM(R1),TRMPROC PUT PROCESS? @YA03936 20774061 BNO NOTPROC BRANCH IF NO @YA03936 20776061 CLC TRMSTAT+1-IEDQTRM(2,R1),AVTFZERO DCB CLOSED @YA03936 20778061 BE CKBFRFLG BRANCH IF YES @YA03936 20780061 NOTPROC EQU * @YA03936 20782061 TM LCBSTAT1,LCBINITN+LCBRECVN 20790020 * RECEIVING AN INITIATE MODE MESSAGE 20820020 BNO CKBFRFLG . BR NO 20850020 NI LCBSTAT1,LCBINITF . INIT OFF 20880020 TM LCBINSRC+2,XXXON . IS THIS INIT MODE MSG 20910020 * CURRENTLY BEING SENT 20940020 BO CKBFR . BR IF NOT BEING SENT 20970020 * DO NOT PUT THIS MSG IN THE FEFO CHAIN 21000020 OI PRFTIC,XBUFFER . 21030020 B WRITE . 21060020 XXXON EQU X'01' . 21090020 CKBFR EQU * . 21120020 NI LCBINSRC+2,X'FF'-XXXON . TURN SRC BIT OFF 21150020 CKBFRFLG EQU * . 21180020 BAL R8,SETFEFO . 21210020 WRITE EQU * . 21240020 SR R8,R8 . 21270020 IC R8,PRFNBUNT . NO. OF UNITS TO WRITE 21300020 BAL R9,BIGSUBR . 21330020 BAL R14,SETCRCD . SET REC. NO. AND DATA SET 21360020 OI PRFTIC,XPARTIAL . SET PARTIAL FLAGS 21390020 BAL R9,SAVE . 21420020 MVC PRFPLQCB,PRFKEY . SAVE PRI LEVEL ON DISK SA51078 21430022 XC DATFLAGS-IEDQDATA(8,R6),DATFLAGS-IEDQDATA(R6) . CLEAR 21450020 TM PRFSTAT1,PRFCNCLN . MSG TO BE CNCLD 21480020 BO CNCLDCK . BR YES TO CK IF HDR 21510020 NOSET EQU * . 21540020 * IS THIS HDR LAST SA50192 21542022 TM PRFSTAT1,PRFNHDRN+PRFNLSTN . SA50192 21544022 BNZ NOTHDRL . BR NO SA50192 21546022 SPACE 21548022 SR R11,R11 . CLEAR REG SA50192 21550022 IC R11,PRFPLQCB QCB PRIORITY LEVEL SA50192 21552022 BAL R14,FINDEST2 . GET PRIORITY QCB SA50192 21554022 SPACE 21556022 CLC QCBLFEFO,PRFCRCD . LAST MSG ON QUEUE SA50192 21558022 BNE NOTHDRL . BR NO SA50192 21560022 SPACE 21562022 * SET DATA FLAGS SA50192 21564022 MVC DATFLAGS-IEDQDATA(,R6),QCBDATFL . SA50192 21566022 NOTHDRL EQU * . SA50192 21568022 BAL R11,EXCPINQ1 . 21570020 BCT R8,WRITEUNT . ARE ANY UNITS LEFT BR-YES 21600020 B PROCESS . BR NO 21630020 WRITEUNT EQU * . 21660020 MVC AVTDOUBL+5(3),PRFXTRA . VALUE OF ADDR FOR 21690020 L R10,AVTDOUBL+4 . THE NEXT UNIT 21720020 B NEXTRA . PROCESS THE UNITS 21750020 SETFEFO EQU * . 21780020 MVC AVTSAVE2+64(6),QCBDATFL SET UP WORK AREA S21101 21790022 TM PRFTIC,XBUFFER . HAS THE FEFO PTR BEEN WRITTEN 21810020 BCR ONES,R8 . BR YES S21101 21840020 MVC AVTSAVE2+65(3),PRFCHDR SAVE CURRENT HDR S21101 21870020 TM PRFSTAT1,PRFNHDRN . 21900020 BO TESTFEFO . 21930020 MVC AVTSAVE2+65(3),PRFCRCD SAVE CURRENT RCD S21101 21960020 TESTFEFO EQU * . 21990020 BAL R14,REQCPB1 GETG CPB S21101 21997022 MVI QCBDATFL,AVTEZERO . SAVE FLAGS FOR LFEFO SA52971 22004022 XC QCBDATSQ(2),QCBDATSQ . SAVE SEQ NO. FOR LFEFO SA52971 22011022 NC QCBFFEFO(3),QCBFFEFO . 22020020 BNZ TSTLFEFO . BR IF ONE THERE SA52971 22050022 MVC QCBFFEFO(3),AVTSAVE2+65 .SET FEFO A49211 22090022 * THIS MOVE CANNOT BE DONE EARLIER SINCE THERE MAY BE NO CPBS A49211 22092022 TSTLFEFO EQU * . SA52971 22094022 NC QCBPFEFO(3),QCBPFEFO . SCAN START POINT SET SA52971 22096022 BNZ WRFEFO . BR YES SA50192 22098022 MVC QCBPFEFO(3),AVTSAVE2+65 .SET FOR FIRST TIME SA52971 22100022 MVC QCBPREVF(3),AVTSAVE2+65 .SET FOR FIRST TIME SA52971 22102022 OI QCBDATFL,DATIFEFO . SET INITIAL FEFO SA50192 22104022 TM PRFSTAT1,PRFNHDRN . TEXT BFR SA50192 22110022 BO SETDATFL . BR YES SA50192 22116022 SPACE 22122022 BAL R14,CPBFREEA . GO LET CPB GO SA52971 22129022 B SETLFEFO . SET LAST FEFO POINTER A49211 22138022 SETDATFL EQU * . SA50192 22138222 XC DATFLAGS(6),DATFLAGS . CLEAR DATA FIELD SA50192 22138422 MVC DATFLAGS,QCBDATFL . SET DATA FLAGS SA50192 22138622 BAL R11,EXCPINQ1 . GO ENQUEUE CPB SA50192 22138822 B SETLFEFO . SET LAST FEFO POINTER SA50192 22139022 SPACE 22139222 WRFEFO EQU * . 22140020 * IF ONLY 1 THERE THE MSG COULD HAVE BEEN READ BUT THE 22170020 * FEFO PTR MAY NOT BE UPDATED YET , SO THE SCB IN WHICH 22200020 * THE FEFO PTR WAS SAVED MUST BE UPDATED. 22230020 ST R15,AVTSAVE2+4 . SAVE SA52971 22260022 ST R8,AVTSAVE2 . SAVE R8 22320020 LR R8,R9 . SET PQCB FOR SUBR 22350020 LA R9,QCBLFEFO . PASS PTR TO FEFO TO CHNGSA52971 22360022 LA R10,AVTSAVE2+65 . PASS PTR TO NEW FEFO SA52971 22370022 L R15,AVTHM02 . FIND HM03 FROM HM02 - 4 22380020 SH R15,AVTHA4 . 22410020 L R15,0(R15) . ADDR HM03 22440020 BALR R14,R15 . 22470020 LR R9,R8 . RESTORE SA52971 22500022 L R8,AVTSAVE2 . RESTORE RTN REG 22710020 L R15,AVTSAVE2+4 . RESTORE SA52971 22740022 AIF (&A EQ 2).F010A 22830020 TM QCBDSFLG,QCBCORE . CORE ALSO 22860020 BNO NOCORE . BR NO 22890020 NC QCBCFHDR(3),QCBCFHDR . IS ONE THERE 22920020 BZ NOCORE . BR NO 22950020 MVC AVTSAVE2+61(3),QCBCFHDR . ADDR FIRST IN Q S21101 22980020 COREFEFO EQU * . 23010020 L R2,AVTSAVE2+60 . MSG HDR S21101 23040020 CLC PRFCRCD-IEDQPRF(3,R2),QCBLFEFO . 23070020 * IS THIS THE MSG IN CORE TO PUT THE FEFO 23100020 * PTR IN 23130020 BE SETCFEFO . BR YES 23160020 CLC PRFNHDR-IEDQPRF(,R2),AVTFZERO SA51078 23190022 * IS THIS THE LSAT MSG ON Q 23220020 BE NOCORE . 23250020 MVC AVTSAVE2+61(3),PRFNHDR-IEDQPRF(R2) . NEXTMSG S21101 23280020 B COREFEFO . 23310020 SETCFEFO EQU * . 23340020 MVC DATFEFO-IEDQDATA(3,R2),AVTSAVE2+65 S21101 23370020 .F010A ANOP , . SA52971 23400022 NOCORE EQU * . SA52971 23490022 L R2,CPBXREAF . 23580020 MVC CPBADDR+1(3),QCBLFEFO FEFO PTR TO WRITE S21101 23610020 MVC DATFLAGS(6),AVTSAVE2+64 SET DATA FIELD OF RECORD S21101 23620020 BAL R11,EXCPINQ1 . 23730020 SETLFEFO EQU * . 23760020 OI PRFTIC,XBUFFER . FEFO PTR HAS BEEN DONE 23790020 MVC QCBLFEFO(3),AVTSAVE2+65 UPDATE LAST FEFO S21101 23820020 AIF (&A EQ 1).F010B A42400 23830000 TM QCBDSFLG,QCBTSQ TSO QUEUES S22028 23840222 BZ LSTCB NO-BRANCH S22028 23840422 L R14,AVTTSOPT ADDR TSINPUT QCB SA61768 23840600 L R14,TSIDEST-IEDQTSI(R14) ADDR HM STCB SA61768 23840800 B FOUNDHM FOUND HM STCB S22028 23841022 LSTCB DS 0H S22028 23841222 L R14,QCBSTCHN-1 ADDR OF FURST STCB SA61768 23842000 CLI08 EQU * . A42400 23844000 CLI 0(R14),DSPMCPL6 IS THIS HM STCB SA61768 23846000 BE FOUNDHM . BE YES A42400 23848000 L R14,4(R14) ADDR OF NEXT STCB SA61768 23848400 B CLI08 . IS THIS IT A42400 23848800 FOUNDHM EQU * . A42400 23849200 LR R0,RBASE SAVE BASE REG SA61768 23849600 LA RBASE,6(R14) SET HM BASE SA61768 23853600 L R2,0(R14) ADDR OF FIND STCA IN HM SA61768 23857652 BALR R14,R2 HM WILL SAVE & REST REGSSA61768 23861652 LR RBASE,R0 RESTORE BASE SA61768 23865652 .F010B ANOP A42400 23869900 BR R8 . 23870000 .F011 ANOP 23880020 TITLE '''IEDQFQ'' - CPB CLEANUP' . S22025 23910022 * CONTROL RECEIVED HERE WHEN CPB'S HAVE BEEN FREED BY DISKS21101 23940020 * END APPENDAGE AND THE QCB POSTED TO ITSELF, OR A BUFFER 23970020 * UNIT WAS POSTED BECAUSE AN EARLIER OPEARTION WAS OUT 24000020 * OF BUFFER UNITS 24030020 SPACE 3 24060020 DC C'IEDQFQ' . 24090020 IEDQFQ DS 0H . 24120020 *********************************************************************** 24150020 * 24180020 * STCB FOR CPB CLEANUP QCB 24210020 * 24240020 DC AL1(DSPMCPL2) . 24270020 DC X'00' . 24300020 * * 24330020 *********************************************************************** 24360020 CPBCLNUP EQU * . 24390020 USING *,R15 . 24420020 L RBASE,BASE . 24450020 DROP R15 . 24480020 USING IEDQCPB,R15 . 24510020 AIF (&A NE 1).F012 24540020 B CALLBUFF . 24570020 AGO .F013 24600020 .F012 ANOP 24630020 LA R7,0(R7) . CLEAR HI 24660020 LA R1,0(R1) . CLEAR HI 24690020 CLR R1,R7 . 24780020 * WAS THE ELEMENT POSTED THE QCB 24810020 BNE CALLBUFF . 24840020 MVI QCBPRI,AVTEZERO . WET THE NOT POSTED FLAG 24870020 * FOR DISK END APPENDAGE 24900020 SPACE 3 24930020 * PUT ANY WRITE CPB'S BACK IN THE FREE POOL, AND PUT READ 24990020 * CPB'S ON THE ENABLED QUEUE. 25020020 SPACE 3 25050020 EMTYAPPQ EQU * . 25080020 LA R1,AVTDKAPQ . APP. CPB Q 25110020 BAL R14,DEQMGRC . 25170020 B APPQEMTY . IF NONE THERE 25200020 EJECT , 99226 25231022 * 99226 25232022 * WHEN THE CPB COMES BACK FROM APPENDAGE, A TEST IS MADE TO 99226 25233022 * DETERMINE IF THERE WAS A DISK ERROR. IF SO IT PICKS UP A 99226 25234022 * WTO ROUTINE IN IGG019RC TO HANDLE IT 99226 25235022 * 99226 25236022 CPBER EQU X'01' . CPB FLAG FROM DISK ERROR 99226 25237022 TM CPBFLAG,CPBER . DID CPB HAVE I/O ERROR 99226 25238022 BZ GOODCPB . NO, GOOD CPB 99226 25239022 * YES, I/O ERROR 99226 25240022 LR R7,R15 . GET CPB FOR WTO 99226 25241022 L R15,AVTFL . GET ADDRESS OF IGG019RC 99226 25242022 L R15,4(,R15) . GET 2ND WORD OF RC 99226 25243022 BALR R14,R15 . CALL DISK ERROR WTO RTN 99226 25244022 * 99226 25245022 LR R15,R7 . RESTORE CPB BASE 99226 25246022 GOODCPB EQU * 99226 25247022 TM CPBSEEK,X'80' . THIS ONE FIXED 25260020 BO PUTONENQ . 25290020 LA R14,EMTYAPPQ . 25320020 BAL R11,CKWRITE . 25350020 PUTONENQ EQU * . 25380020 LA R2,AVTDKENQ . ENABLED Q 25410020 LA R11,EMTYAPPQ . SET RETN ADDR 25440020 B ENQMGRC . 25470020 APPQEMTY EQU * . 25500020 LA R1,AVTDKENQ . ENABLED Q 25560020 BAL R14,DEQMGRC . 25590020 B CPBSGONE . IF NONE THERE 25620020 TM CPBFLAG,CPBER CPB HAVE I/O ERROR SA61800 25623000 BZ GOODCPB1 BR NO SA61800 25626000 LR R7,R15 GET CPB FOR WTO SA61800 25629000 L R15,AVTFL ADDR OF IGG019RC SA61800 25632000 L R15,4(,R15) ADDR OF WTO RTN IN 19RC SA61800 25635000 BALR R14,R15 CALL DISK ERROR WTO RTN SA61800 25638000 * SA61800 25641000 LR R15,R7 RESTORE CPB BASE SA61800 25644000 GOODCPB1 EQU * SA61800 25647000 TM CPBSEEK,X'80' . THIS ONE FIXED 25650020 LA R11,CALCKERB . 25680020 BCR ONES,R11 . S21101 25710020 LA R14,APPQEMTY . 25740020 B CKWRITE . 25770020 CPBSGONE EQU * . 25920020 SR R0,R0 . CLEAR R0 FOR POST REG 26010020 B PROCESS . S21101 26040020 CKWRITE EQU * . 26190020 OI CPBSEEK,X'80' . FLAG FIXED 27000020 TM CPBRDWR,CPBWRITB . 27090020 * IS THIS A WRITE OF ANY KIND 27120020 BO CPBFREEA . 27150020 BR R11 . 27180020 .F013 AIF (&A EQ 1).F016 27210020 EXCPINQ1 EQU * . 27240020 LA R14,ENQMGRC . ADDR OF Q MGR 27270020 B EXCPINPT . 27300020 .F016 ANOP 27330020 CALLBUFF EQU * . 27360020 L RBASE,ADRFA01 . RESET BASE REG 27390020 DROP RBASE . 27420020 USING IEDQFA01,RBASE . 27450020 B BUFFER . AND ADJUST ADDRESSIBILITY 27480020 DROP RBASE . 27510020 USING CPBINIT,RBASE . 27540020 AIF (&A EQ 1).F017 27570020 CALCKERB EQU * . 27600020 L RBASE,ADRFA01 . 27630020 DROP RBASE . 27660020 USING IEDQFA01,RBASE . 27690020 B CKERB . 27720020 TRANSFER EQU * . 27750020 MVC PRFSUNIT-1(0),PRFSUNIT-1-IEDQPRF(R10) . 27780020 .F017 ANOP 27810020 USING CPBINIT,RBASE . 27840020 TITLE '''IEDQFA'' - ERB' . S22025 27870022 * AN ERB HAS BEEN POSTED REQUESTING A MESSAGE - THIS SECTION 27900020 * WILL DETERMINE THE TYPE OF REQUEST, HOW MUCH DATA IS NEEDED 27930020 * AND WHETHER TO GET IT FROM DISK OR CORE QUEUES. 27960020 SPACE 3 27990020 ERB EQU * . 28020020 LR RLCB,RPREFIX . 28050020 SH RLCB,DCH . 28080020 L RSCB,LCBSCBA-1 SCB ADDR SA52971 28090022 TM LCBERBST,LCBERROR . TRANS ERROR ON SEND 28110020 BNO NOERROR . BR IF NO ERROR 28140020 ERBERROR EQU * . A44866 28150021 L RBASE,ADRFA01 . SET SECOND BASE REG 28170020 BAL R5,FREEBFRS-IEDQFA01(RBASE) 28200020 * FREE ATTACHED BFRS IF ANY 28230020 ADRTAG EQU * . LABEL FOR ADDRESSIBILITY 28260020 L R2,LCBRCQCB . SET TO POST THE ERB TO 28290020 LA R2,AVTEZERO(R2) CLEAR HI BYTE SA54262 28300022 LA R1,LCBERB . THE SPECIFIED QCB 28320020 MVI LCBERBPY,PRIDSPLB-1 . SET PRIORITY FOR POST A44866 28350021 LA R14,CALLPROC-ADRTAG(R5) . SET RTN 28380020 B POST-ADRTAG(R5) . POST THE ERB 28410020 NOERROR EQU * 28440020 CLI LCBERBPY,PRIINTRQ . INITIAL REQUEST A41025 28480020 BNE QTYPSET . BR NOT INIT A41025 28490020 NC LCBERBCH(3),LCBERBCH . ANY BFRS THERE A41025 28492020 BNZ QTYPSET . BR IF BFRS THERE A41025 28494020 NI SCBQTYPE,X'0F' . CLEAR FOR LATER TEST FOR A41025 28496020 * HDR READ A41025 28498020 QTYPSET EQU * A41025 28498420 MVI SCBCPBNO,AVTEZERO . 28500020 MVI SCBNXCPB,EONE . SET NO OF NEXT CPB TO GET 28530020 XC AVTDOUBL(7),AVTDOUBL . CLEAR WORK AREA 28560020 * THE ERBPY FIELD WILL SERVE AS A FLAG - IF IT IS NON ZERO 28590020 * A BUFSIZE MUST BE PLACED IN ERBQB+1. IF THE KEY 28620020 * IS ZERO THE SIZE IS THERE. 28650020 LA R7,SZTHERE . SET RTN ADDR 28680020 TM LCBSTAT1,LCBRCLLN . IF THIS A RECALL - NOT 28710020 BCR ONES,R7 . TO BE COMPUTED NOW S21101 28740020 CLI LCBERBKY,AVTEZERO . 28770020 BCR EQUAL,R7 . BR IF ALREADY DONE S21101 28800020 NC LCBERBCH(3),LCBERBCH . ARE BUFFERS THERE 28830020 BCR ZERO,R7 . BR IF NO BUFFER YET S21101 28860020 * COMPUTE ZIZE YET 28890020 L RPRF,LCBERBCH-1 . 28920020 B OFFSET . RTN SET ALREADY 28950020 SZTHERE EQU * . 28980020 OI LCBERBCT+1,XXCTUSED . FLAG FOR APPENDAGE 29010020 IC R7,LCBERBCT+1 . DISABLED CT 29040020 MVI LCBERBCT+1,AVTEZERO . ZERO CT 29070020 LA R7,4096-XXCTUSED(R7) . CLEAR HI BIT OF LOW BYTE 29100020 IC R2,LCBERBCT . ENABLED CT 29130020 AR R2,R7 . ADD CTS 29160020 STC R2,LCBERBCT . SET NEW CR 29190020 L RSCB,LCBSCBA-1 . 29220020 BAL R14,FINDESTQ . 29250020 TM LCBSTAT1,LCBRCLLN . RECALL ? 29280020 BO RECALL . BR YES 29310020 AIF (&A NE 3).F026 29340020 TM QCBDSFLG,QCBCORE . 29370020 * IS THERE A CORE COPY 29400020 BNO DISKONLY . BR NO 29430020 .F026 AIF (&A EQ 2).F027 29460020 TM LCBERBST,XRDERR . INIT AND NTXT NOT THERE 29490020 BO FIXSCSEG . 29520020 CLI LCBERBPY,PRISBPCI . SB PCI REQ 29550020 BNE INITREQ . BR NO TO GET ALL BFRS 29580020 CKPREV EQU * . 29610020 AIF (&A NE 1).F026A 29640020 B CALLFQ . 29670020 AGO .F028 29700020 .F026A ANOP 29730020 TM SCBQTYPE,SCBCOREQ . DID THIS MSG COME FROM CORE 29760020 BO CALLFQ . BR YES 29790020 .F027 ANOP 29820020 SPACE 3 29850020 * WILL BUILD CPB'S FOR A DISK READ 29880020 SPACE 3 29910020 DISKONLY EQU * . 29940020 NI LCBERBST,X'FF'-LCBRDERR .. RESET ERROR BIY 29970020 XC AVTDOUBL+3(5),AVTDOUBL+3 INITIALIZE 30000020 * TH SCSEG AND SCHDR FIELDS ARE SET BE SND SCH OR GET SCH. IF A HDR 30030020 * IS NOT EXPECTED NEXT SCHDR IS NOT INITIALIZED. SCSEG IS ALWAYS 30060020 * INITIALIZED TO THE NEXT SEG TO READ FOR SCHEDULER 30090020 L R9,SCBSCSEG-1 . ADDR OF CURRENT SEG 30120020 LA R2,1 . 30150020 TM SCBQTYPE,X'70' . IF QTYPE NOT ALREADY SET - 30180020 BZ HDRNEXT1 . A HDR IS EXPECTED NEXT 30210020 CLC SCBSCSEG(3),SCBCRCD . HAS THIS RECORD (IF IT HAS 30240020 * A PREFIX) BEEN READ BEFORE? ---- IF THE LAST BFR FILLED 30270020 * WAS FILLED WITH DATA FROM WITHIN THIS PRFX RECORD AND COMPLETED 30300020 * A REQUEST - TOO MUCH DATA WILL BE READ SINCE IT IS OTHERWISE 30330020 * ASSUMED THAT THE PRFX WAS READ ON A PREVIOUS OPERATION. 30360020 BE HDRNEXT .M BR IF READ TO READ ONLY 30390020 * THIS RECORD AND NO MORE. 30420020 * SCBCPBNO IS THE NO, OF CPBS BUILT TO READ AND THE NO. 30450020 * LEFT TO GET FROM APPENDAGE 30480020 * SCBNXCPB IS THE NO. OF THE CPB THAT IS EXPECTED NEXT 30510020 * CPBBFRNO CONTAINS THE NUMBER FO THE LOGICAL BFR IN WHICH THE 30540020 * FIRST BYTE OF DATA IN THE UNIT IS TO BE PLACED. 30570020 * CPBBFRCT CONTAINS THE NUMBER OF THE BYTE IN THE LAST UNIT 30600020 * OF THE LAST BFR IN WHICH THE FIRST BYTE OF DATA IS PLACED. 30630020 * CPBWKACT CONTAINS THE NUMBER OF TH BYTE IN THE CPB WORK AREA 30660020 * WHICH IS TO BE THE FIRST BYTE TRANSFERRED. 30690020 * CPBNUMB CONTAINS THE NUMBER OF THE CPB FOR THIS ERB. 30720020 * AVTDOUBL+3 HAS THE NO. OF UNITS REQUESTED SO FAR 30750020 * AVT DOUBL +4 HAS THE NO, OF UNITS IN 1 BFR 30780020 * AVTDOUBL+5 HAS WKACT 30810020 * WKACT SHOULD BE 0 EXCEPT FOR FISRT RECALL , FIRST READ OR SBPCI 30840020 * AVTDOUBL+6 HAS NUMB 30870020 * AVTDOUBL+7 HAS BFRNO 30900020 * SCBUNTCTILL HAVE WHERE IN THE NEXT UNIT 30930020 * TO BE READ FROM SIDK DATA TRANSFER WILL START. 30960020 TM SCBSTAT1,PRFNLSTN . LAST SEG 30990020 BNO FIXNTXT . BR YES 31020020 FIXED EQU * . 31050020 MVC AVTDOUBL+5(1),SCBUNTCT .CT OF BYTE TO READ 31080020 L R10,LCBDCBPT . DCB ADDR 31110020 MVC AVTDOUBL+4(1),LCBERBQB . NO UNITS PER BFR 31140020 NC LCBERBCH(3),LCBERBCH . ARE THERE ANY BFRS 31170020 BZ TRYNEXT . BR NO 31200020 LA R6,LCBERBLK-1 . 31230020 L R14,AVTDOUBL+4 . GET BFR NO 31260020 COUNT EQU * . 31290020 NC PRFLINK(3),PRFLINK . IS THIS THE LAST BFR 31320020 BZ LASTUNIT . BR YES 31350020 L R6,PRFLINK-1 . NEXT BFR 31380020 AR R14,R2 . ADD 1 TO BFR NO 31410020 ST R14,AVTDOUBL+4 . 31440020 B COUNT . 31470020 LASTUNIT EQU * . 31500020 IC R14,PRFNBUNT . NO OF UNITS IS BFR 31530020 MVI AVTDOUBL+3,AVTEZERO . SET NO REQD UNITS TO 0 31560020 EX R14,CLINOUNT . NO IN 1 BFR = NO FOR BFR 31590020 BE TRYNEXT . BR YES 31620020 IC R10,AVTDOUBL+4 . NO. TO BE PUT IN BFR 31650020 SR R10,R14 . - NO THERE ALREADY 31680020 BCTR R10,0 . -1 31710020 STC R10,AVTDOUBL+3 . = NO UNITS REQD SO FAR 31740020 TRYNEXT EQU * . 31770020 BAL R14,READCPB . 31800020 * RECORED TO BE READ. 31830020 * THE NEXT TEXT IS THE LAST RECORD THAT CAN BE READ UNTIL THE 31860020 * NEXT PREFIX HAS BEEN READ. THE NTXT IS ALWAYS A HIGHER VALUE 31890020 * OF ADDRESS THAN THE ADDITIONAL RECORDS. 31920020 * THIS ERB SHOULD BE DROPPED NOW AND BEGIN PROCESSING THE NEXT 31950020 * ELEMENT. 31980020 CLC SCBSCSEG(3),SCBNTXT . HAS THE NEST TXT BEEN 32010020 * READ 32040020 BH PROCESS . BR YES(SCSEG=LAST ADDR +1) 32070020 L R14,AVTDOUBL . ADD 1 TO NO UNITS 32100020 AR R14,R2 . REQUESETD SO FAR 32130020 ST R14,AVTDOUBL . 32160020 EX R14,CLINOUNT . R14 HAS NO OF UNITS THAT 32190020 * HAVE BEEN READ - COMPARE TO THE NO. TO READ IN DOUBL+4 32220020 BNE TRYNEXT . BR IF MORE TO READ FOR 1 BFR 32250020 CLI LCBERBPY,PRISBPCI . SB PCI REQ 32280020 BE PROCESS . BR YES 32310020 * IF THIS IS NOT AN INITIAL REQ OF RIRST SUBSEQUENT REQ ONLY 32340020 * ONE BFR AT A TIME SHOULD BR FILLED. 32370020 L R14,AVTDOUBL+4 . ADD 1 TO NO OF BFRS THAT 32400020 AR R14,R2 . UNITS HAVE BEEN READ FOR 32430020 ST R14,AVTDOUBL+4 . 32460020 MVI AVTDOUBL+3,AVTEZERO . SET NO UNITS REQD =0 FOR NEW 32490020 EX R14,CLIREQ . HAS THE NO. OF BFRS REQ- 32520020 * UESTED BEEN FILLED 32550020 BH TRYNEXT . BR NO 32580020 B PROCESS .. BR YES 32610020 CLIREQ CLI LCBERBCT,X'00' . 32640020 CLINOUNT CLI AVTDOUBL+4,X'00' . 32670020 READCPB EQU * . 32700020 L R15,AVTFCPB . ADDR OF FIRST IF ONE THERE 32730020 LA R15,0(R15) . CLEAR HI BYTE 32760020 LTR R15,R15 . ANY THERE 32790020 BZ CKENQ . BR NO 32820020 MVC AVTFCPB+1(3),CPBNEXT . 32850020 ST R14,CPBSEEK . KEEP RTN ADDR 32880020 IC R14,CPBADDR . S21101 32910020 ST R9,CPBADDR . SET ADDRESS S21101 32920020 STC R14,CPBADDR . S21101 32930020 ST RLCB,CPBAERBF . SET LCB ADDR FOR THIS READ 32940020 IC R14,SCBCPBNO . NO OF LAS< CPB 32970020 AR R14,R2 . PLUS 1 33000020 STC R14,SCBCPBNO . 33030020 XC CPBINWKA(5),CPBINWKA . 33060020 STC R14,CPBNUMB . SET NUMBER OF CPB 33090020 LA R9,INCR(R9) . ADD FOUR TO REC. NO. S21101 33120020 IC R11,SCBSCSEG-1 . SAVE HI BYTE 33150022 ST R9,SCBSCSEG-1 . KEEP REC NO 33160022 STC R11,SCBSCSEG-1 . RESTORE HI BYTE 33170022 MVI CPBRDWR,CPBRDKC . READ K & D 33180020 MVI CPBXDWR,CPBRDC . READ DATA 33210020 BAL R11,EXCPINQ2 . PUT CPB ON INPUT Q 33240020 LA R2,1 . RESET R2 33270020 L R14,CPBSEEK . RESTORE RETURN 33300020 BR R14 . 33450020 .F028 AIF (&A EQ 1).F029 33480020 CKENQ EQU * . 33510020 CLI SCBCPBNO,AVTEZERO . HAVE ANY CPBS BEEN GOTTEN 33540020 BNE CALLEXCP . FOR THIS REQ. BR YES 33570020 LA R6,LCBERB . NO - RE-ENQ THE ERB 33600020 B ENQUEUE . 33630020 .F029 AIF (&A EQ 1).F033 33660020 FIXNTXT EQU * . 33690020 * SINCE THERE IS NO NTXT, THE LAST ADD.REC. WILL BE IN NTXT 33720020 MVI AVTDOUBL,AVTEZERO . 33750020 MVC AVTDOUBL+1(3),SCBXTRA . 33780020 MVC SCBNTXT(3),SCBCRCD . 33810020 L R10,AVTDOUBL . 33840020 LTR R10,R10 . 33870020 BZ FIXED . BR IF NO XTRA RECORDS 33900020 BAL R14,SBTRKEY1 . 33960020 SH R10,CONST . ADJUST R10 S21101 33990020 ST R10,AVTDOUBL . LAST XTRA FOR NTXT 34020020 MVC SCBNTXT(3),AVTDOUBL+1 . 34050020 B FIXED . 34080020 CONST DC H'8' . CONSTANT S21101 34090020 HDRNEXT1 EQU * . 34110020 BAL R14,READCPB . GET A CPB A44895 34140022 BAL R14,QTYPE . SET QTYPE A44895 34150022 B PROCESS . CONTINUE A44895 34160022 HDRNEXT EQU * . 34170020 BAL R14,READCPB . 34200020 B PROCESS . 34230020 SPACE 3 34260020 .F033 ANOP 34290020 QTYPE EQU * . 34320020 MVI SCBUNTCT,AVTEZERO . SET START CNT TO FIRST 34350020 AIF (&A EQ 2).F034 34380020 OI SCBQTYPE,SCBCOREQ . SET FLG FOR CORE READ 34410020 AIF (&A EQ 1).F035 34440020 TM QCBDSFLG,QCBCORE . 34470020 BCR ONES,R14 . S21101 34500020 .F034 ANOP 34530020 QTYPE1 EQU * . 34560020 NI SCBQTYPE,X'0F' . CLEAR QTYPE 34590020 OI SCBQTYPE,SCBREUS . ASSUME REUS DISK 34620020 TM QCBDSFLG,QCBREUS . 34650020 BCR ONES,R14 . S21101 34680020 XI SCBQTYPE,SCBREUS+SCBNREUS . 34710020 .F035 ANOP 34740020 BR R14 . 34770020 AIF (&A EQ 2).F036 34800020 * WILL INITIALIZE TO GET A MESSAGE FROM A CORE Q 34830020 SPACE 3 34860020 INITREQ EQU * . 34890020 TM SCBQTYPE,X'70' . HAS QTYPE BEEN SET ALREADY - 34920020 BNZ CKPREV . BR YES - ONE READ DONE FOR 34950020 * THIS MSG LAREADY 34980020 OI SCBQTYPE,SCBCOREQ ASSUME CORE SA59522 35010000 AIF (&A NE 1).F035A 35040020 B CALLFQ . 35070020 AGO .F036 35100020 .F035A ANOP 35130020 TM QCBDSFLG,QCBREUS+QCBNREUS . ANY DISK 35160020 BZ CALLFQ . BR NO 35190020 MVC AVTDOUBL+1(3),QCBCFHDR . YES- FIND CORE COPY OF MSG 35220020 COMPARE EQU * . 35250020 NC AVTDOUBL+1(3),AVTDOUBL+1 . LAST MSG 35280020 BZ NOMSG . BR YES 35310020 L R2,AVTDOUBL . ADDR THIS MSG 35340020 CLC SCBSCHDR(3),PRFCRCD-IEDQPRF(R2) . 35370020 * IS THIS THE MSG TO SEND 35400020 BE LOSTMSG1 . TO CHECK FOR LOST MSG 35430020 MVC AVTDOUBL+1(3),PRFNHDR-IEDQPRF(R2) . NEXT MSG 35460020 B COMPARE . 35490020 LOSTMSG1 EQU * . 35520020 TM DATFLAGS-IEDQDATA(R2),DATLOSTN . LOST MSG 35550020 BNO RESETSCH . BR NOT LOST TO GET FROM CORE 35580020 * OTHERWISE FREE MSG FROM CORE Q AND SET TO READ FROM DISK 35610020 LR R6,R2 . SET FAKE BFR ADDR 35640020 L R15,ADFREEMS . BASE FOR SUBR 35670020 BAL R7,HAVEADDR-FREEMSG(R15) . ENTRY PT FOR THIS 35700020 L RSCB,LCBSCBA-1 . RESTORE SCB ADDR 35730020 L R7,SCBDESTQ-1 . RESTORE QCB ADDR 35760020 NOMSG EQU * . 35790020 NI SCBQTYPE,X'FF'-SCBCOREQ RESET CORE BIT SA62976 35820005 XC AVTDOUBL(6),AVTDOUBL . CLEAR WORK AREA 35850020 L R9,SCBSCSEG-1 . 35880020 LA R2,1 . 35910020 BAL R14,READCPB GET A CPB SA59522 35940000 BAL R14,QTYPE1 SET QUING MEDIUM SA59522 35950000 B PROCESS PROCESS NEXT ELEMEMT SA59522 35960000 .F036 ANOP 35970020 RECALL EQU * . 36000020 MVC SCBSCSEG(3),SCBDEOB+1 . SET FIELDS FROM RECALL 36030020 ST R7,AVTDOUBL . SAVE R7 36060020 IC R7,SCBDEOB . TO LOOK NORMAL 36090020 STC R7,SCBUNTCT . 36120020 LA R7,NOSIZE . SET RTN ADDR 36150020 TM LCBSTAT1,LCBRECVN . RECV SIDE 36180020 BCR ONES,R7 . BR YES - RECALL BFR THAT S21101 36210020 * IS THERE - DO NOT CHANGE S21101 36220020 * THE DSIZE S21101 36230020 * THERE - DO NOT CHANGE THE DSIZE 36240020 TM LCBCHAIN,LCBBFRSZ . SPECIAL BD RECALL 36270020 BCR ONES,R7 . S21101 36300020 CLI LCBERBKY,AVTEZERO . HAS SIZE BEEN COMPUTED 36330020 BNE USELCB . SEND REQUEST 36360020 NOSIZE EQU * . 36390020 L R7,AVTDOUBL . RESET R7 36420020 TM SCBQTYPE,X'F0' . IS THIS A FIRST RECLL 36450020 BZ FIRSTRCL . FROM ANYBODY BUT BT 36480020 NC LCBERBCH(2),LCBERBCH . ANY BFRS THEER 36510020 AIF (&A NE 2).F037 36540020 BNZ DISKONLY . 36570020 AGO .F037A 36600020 .F037 ANOP 36630020 BNZ CKPREV . BR YES - ONE READ DONE 36660020 .F037A ANOP 36690020 AIF (&A EQ 1).F038A 36720020 AIF (&A EQ 2).F038 36750020 TM SCBQTYPE,SCBCOREQ . 36780020 BNO OKREUS . BR NOT CORE 36810020 * THIS IS A FIRST RECALL FROM BT 36840020 .F038A ANOP 36870020 TM LCBSTAT1,LCBSENDN . SENDING 36900020 BO BTSEND . BR YES - ADDR OF HDR IS THERE 36930020 AIF (&A NE 3).F038B 36960020 TM QCBDSFLG,QCBREUS+QCBNREUS . ANY DISK 36990020 BNZ NOMSG . RECALL ON RCV SIDE - GET 37020020 * FROM DISK 37050020 .F038B ANOP 37080020 MVC SCBSCHDR(3),SCBCCHDR . GET ADDR OF HDR 37110020 BTSEND EQU * . 37140020 L R2,SCBSCSEG-1 . ADDR OF UNIT TO GET 37170020 TM DATFLAGS-IEDQDATA(R2),DATNPRFX . DOES IT HAVE PRFX 37200020 BNO CALLFQ . 37230020 L R6,SCBSCHDR-1 . HDR ADDR 37260020 BTTIC EQU * . 37290020 LR R2,R6 . SET FOR LOOP TO FIND PRFX THAT 37320020 B BTTIC2 . GOES WITH THIS EXTRA UNIT 37350020 BTTIC1 EQU * . 37380020 L R2,PRFTIC-IEDQPRF(R2) . ADDR NEXT UNIT 37410020 BTTIC2 EQU * . 37440020 NC PRFTIC+1-IEDQPRF(2,R2),PRFTIC+1-IEDQPRF(R2) . MORE THERE 37470020 BZ BTBFR . BR NO TO GET NEXT BFR 37500020 CLC PRFTIC+1-IEDQPRF(3,R2),SCBSCSEG . THIS IT 37530020 BNE BTTIC1 . BR IF NOT THE ONE 37560020 LH R2,SCBSCAN . SAVE SEQ OUT NO 37590020 MVC SCBSRCE(PRFSTXT-PRFSRCE),PRFSRCE . SET PRFX FOR BFR 37620020 STH R2,SCBSCAN . SAVE SEQ OUT NO 37650020 OI SCBSTAT1,PRFNHDRN . INSURE NOT A HDR BFR 37680020 B CALLFQ . 37710020 BTBFR EQU * . 37740020 MVC AVTDOUBL+1(3),PRFNTXT . GET NEXT BFR IN QUEUE 37770020 L R6,AVTDOUBL . 37800020 B BTTIC . 37830020 AGO .F039 37860020 .F038 ANOP 37890020 B OKREUS . 37920020 .F039 ANOP 37950020 FIRSTRCL EQU * . 37980020 AIF (&A NE 1).F040 38010020 OI SCBQTYPE,SCBCOREQ . 38040020 B CKTHERE . 38070020 AGO .F040A 38100020 .F040 ANOP 38130020 LA R1,QCBDSFLG . ASSUME NOT BD 38160020 LA R2,X'10' . SET CC FOR EX BRANCH 38190020 TM LCBCHAIN,LCBBFRSZ . BD RCLL 38220020 BNO NOTBD . BR NO 38250020 LA R1,SCBHBFNO . SET TO TEST DCB NOT QCB 38280020 LA R2,X'80' . SET CC FOR BR 38310020 NOTBD EQU * . 38340020 AIF (&A EQ 2).F039A 38370020 OI SCBQTYPE,SCBCOREQ . SET FOR CORE RECALL 38400020 TM 0(R1),QCBREUS+QCBNREUS . ANY DISK 38430020 BZ CKTHERE . 38460020 PUTRET EQU * @SA69655 38470061 NI SCBQTYPE,X'FF'-SCBCOREQ .SET NOT CORE 38490020 .F039A ANOP 38520020 OI SCBQTYPE,SCBREUS . SET RES DISK 38550020 TM 0(R1),QCBREUS . 38580020 AIF (&A NE 3).F039A1 @OZ14195 38587000 BRNCHQ EQU * @OZ14195 38594000 .F039A1 ANOP @OZ14195 38601000 EX R2,BRANCH . 38610020 XI SCBQTYPE,SCBREUS+SCBNREUS . 38640020 OKREUS EQU * . 38670020 L R9,SCBSCSEG-1 . RECORD TO READ 38700020 LA R2,1 . INITIALIZE R2 FOR ADDS 38730020 MVC AVTDOUBL+5(1),SCBDEOB . 38760020 B HDRNEXT . 38790020 BRANCH NOP OKREUS . COND CODE FILLED BY EX S21101 38820020 .F040A ANOP 38850020 AIF (&A EQ 2).F040B 38880020 CKTHERE EQU * . 38910020 AIF (&A EQ 1).F040A1 @SA69655 38916061 CLI QCBDSFLG,QCBFQCB PUT PROCESS ENTRY @SA69655 38922061 BE PUTRET NO, BRANCH @SA69655 38928061 NC LCBTTCIN,LCBTTCIN TTCIN ZERO? @OZ14195 38928500 BNZ CALLFQ NO @OZ14195 38929000 TM LCBSTAT2,LCBDIAL DIAL LINE @OZ14195 38929500 BO CALLFQ YES @OZ14195 38930000 TM LCBCHAIN,LCBBFRSZ BD RECALL @OZ30296 38930186 BO CALLFQ YES, BRANCH @OZ30296 38930286 * THIS CODE WILL ALLOW THE CAPABILITY TO RETRIEVE A @OZ14195 38930500 * MESSAGE BY INPUT SEQUENCE NUMBER FOR A TERMINAL THAT @OZ14195 38931000 * IS CORE QUEUED. @OZ14195 38931500 OI SCBQTYPE,SCBREUS SET REUS @OZ14195 38932000 NI SCBQTYPE,AVTEFF-SCBCOREQ TURN OFF CORE BIT @OZ14195 38932500 TM SCBSCSEG+TWO,CPBQTYPE CHECK TYPE OF QUEUES @OZ14195 38933000 B BRNCHQ GO SET APPROPRIATE BIT @OZ14195 38933500 .F040A1 ANOP @SA69655 38934061 CALLFQ EQU * . 38940020 L RBASE,ADRFA01 . 38970020 B CALLFQA-IEDQFA01(RBASE) . 39000020 .F040B ANOP 39030020 AIF (&A NE 3).F040C 39060020 RESETSCH EQU * . 39090020 L RBASE,ADRFA01 . 39120020 B RESETA-IEDQFA01(RBASE) . 39150020 .F040C ANOP 39180020 ADRFA01 DC A(IEDQFA01) . 39210020 EONE EQU X'01' . 39240020 BASE DC A(CPBINIT) . 39270020 DROP RBASE . 39330020 TITLE '''IEDQFA'', ''IEDQFQ'' - COMMON SUBROUTINES' . S22025 39340022 USING *,RBASE . 39360020 * THIS SPECTION IS A GOUUP OF COMMON SUBROUTINES USED BY 39390020 * BOTH SECTIONS OF CODE. 39420020 SPACE 3 39450020 IEDQFA01 EQU * . 39480020 AIF (&A EQ 1).F018 39510020 CPBFREE EQU * . 39540020 LA R14,GOAPQEMT . SET RTN ADDR 39570020 * WILL FREE CPB - NO CHECKING - RETURN 39600020 CPBFREEA EQU * . 39630020 L R1,AVTFCPB . LINK CPB INTO THE 39660020 ST R15,AVTFCPB . CPB FREE POOL 39690020 ST R1,CPBNEXTF . 39720020 MVI CPBFLAG,AVTEZERO . ZERO ALL FLAGS 39750020 BR R14 . RETURN 39780020 .F018 ANOP 39810020 ENQMGRB EQU * . 39840020 BALR R14,0 . 39870020 USING *,R14 . S21101 39900020 L R14,ADENQMGR . 39930020 BR R14 . 39960020 DROP R14 . S21101 39990020 OFFSET EQU * . 40020020 BALR R15,0 . SET ADDRESSIBLITY 40050020 USING *,15 . 40080020 L R15,ADROFFST . ADDR OF SUBROUTINE 40110020 BR R15 . 40140020 USELCB EQU * . 40170020 BALR R15,0 . SET ADDRESSIBLITY 40200020 USING *,15 . 40230020 L R15,ADROFFST . ADDR OF SUBROUTINE 40260020 USING IEDQCPB,R15 . 40290020 B USELCBA-OFFSETA(R15) . 40320020 AIF (&A EQ 1).F040D 40350020 ENQMGRC EQU * . 40380020 BALR R14,0 . 40410020 USING *,R14 . S21101 40440020 L R14,ADMGRX . 40470020 BR R14 . 40500020 DROP R14 . S21101 40530020 ADMGRX DC A(ENQMGRCA) . 40560020 .F040D ANOP 40590020 ADROFFST DC A(OFFSETA) . 40620020 ADENQMGR DC A(ENQMGRBA) . 40650020 DCH DC AL2(LCBERB-IEDQLCB) . 40680020 TAG1 EQU * . 40710020 AIF (&A NE 1).F030 40740020 B CALPROC1 . 40770020 AGO .F032 40800020 .F030 AIF (&A EQ 2).F031 40830020 L RSCB,LCBSCBA-1 . SCB ADDRESS 40860020 TM SCBQTYPE,SCBCOREQ . FROM CORE 40890020 BO CALPROC1 . BR YES 40920020 .F031 ANOP 40950020 GOAPQEMT EQU * . 40980020 L RBASE,BASE1 . SET NEW BASE 41010020 B APPQEMTY-CPBINIT(RBASE) . 41040020 .F032 ANOP 41070020 CALLPROC EQU * . 41100020 L RSCB,LCBSCBA-1 . 41130020 CALPROC1 EQU * . 41160020 L RBASE,BASE1 . 41190020 DROP RBASE . 41220020 USING CPBINIT,RBASE . 41250020 SR R0,R0 . CLEAR R0 FOR POST REG 41280020 B PROCESS . 41310020 DROP RBASE . 41340020 USING IEDQFA01,RBASE . 41370020 .F032A ANOP 41400020 UNITFREE EQU * . 41430020 * WILL POST A UNIT TO THE AVAILABLE BFR QUEUE 41460020 MVI PRFNBUNT-IEDQPRF(R1),X'01' .SET NO. UNITS 41490020 MVI PRFTIC-IEDQPRF(R1),CPBTICC . 41520020 RTNBFR EQU * . 41550020 LA R2,AVTBFRTB . ADDR OF BFR RTN QCB 41580020 MVI PRFPRI-IEDQPRF(R1),PRIBFRTB .PRIORITY 41610020 POST EQU * . 41640020 ST R2,PRFQCBA-1-IEDQPRF(R1) FOR POST 41670020 NOSTORE EQU * . 41700020 LA R0,0(R1) . DEEP ADDR LAST ELEM POSTED 41730020 L R11,AVTEA . 41760020 B DSPPOSTR . POST AND RETURN 41790020 AIF (&A EQ 1).F019 41820020 EXCPINQ2 EQU * . 41850020 * WILL ENQUEUE A CPB ON THE FIFO EXCP INPUT Q 41880020 BALR R14,0 . 41910020 USING *,R14 . 41940020 L R14,ADMGRCC . 41970020 DROP R14 . 42000020 EXCPINPT EQU * . 42030020 LA R2,AVTINCPQ . EXCP DRIVER INPUTQ 42060020 LR R1,R15 . CPB ADDR IN 1 42090020 BR R14 . 42120020 ADMGRCC DC A(ENQMGRC) . 42150020 .F019 ANOP 42180020 * WILL BRANCH TO EXCP DRIVER IF ANY DISK OR DSPDISK OF NOT 42210020 CALLEXCP EQU * . 42240020 AIF (&A EQ 1).F020 42270020 BALR R14,0 . SET ADDRESSIBILITY 42300020 USING *,R14 . 42330020 AIF (&A EQ 2).F019A 42360020 TM AVTBIT1,AVTDISKN . DISK SPEC. 42390020 BZ NOFL . BR NO 42420020 .F019A ANOP 42450020 ICM R15,AD,AVTFL+1 IS DISK OPENED Y02027 42480006 * IF YES 42600020 BCR NOTZERO,R15 . S21101 42630020 * IS NO 42660020 NOFL EQU * . 42690020 .F020 ANOP 42720020 L R11,AVTEA . 42750020 B DSPDISP . 42780020 AIF (&A EQ 1).F021 42810020 DROP R14 . 42840020 .F021 ANOP 42870020 FINDLVL EQU * . SA52971 42874022 *** THIS SUBROUTINE DESTROYS REGS 0,1,2, AND 11. THE QCB SA52971 42878022 * EXTENSION IS RETURNED IN REG2. RETURN IS TO +0 IF THIS SA52971 42882022 * IS NOT A CONCENTRATOR AND TO +4 IF IT IS A CONCENTRATOR. SA52971 42886022 TM SCBQTYPE,SCBCONC . IS THIS A CONCENTRATOR SA52971 42890022 BCR 8,R10 . BR IF NOT SA52971 42894022 LH R2,QCBEXTO . EXT OFFSET S22026 42900022 AR R2,RQCB . QCBE ADDR S22026 42901022 TM QCBEFLG-IEDQQCBE(R2),QCBEOPL . S22026 42902022 * PRTY LEVEL QUEUEING S22026 42903022 BZ 4(,R10) . BR IF CONC SA52971 42904022 SR R0,R0 . ZERO IC REG SA52971 42905022 LA R11,QCBMEND-QCBPSIZE . INIT TO ZEROETH PRI QCB SA52971 42906022 BALR R1,AVTEZERO . SET LOOP POINT SA52971 42907022 SPACE 1 . SA52971 42908022 IC R0,QCBELGTH-IEDQQCBE(,R2) GET EXTENSION LENGTH SA52971 42909022 AR R2,R0 . POINT TO NEXT EXTENSION SA52971 42910022 LA R11,QCBPSIZE(,R11) . POINT TO NEXT PRI QCB SA52971 42911022 CLR R11,RPQ . IS THIS THE ONE SA52971 42912022 BCR 7,R1 . NO, GO LOOK AT NEXT SA52971 42913022 B 4(,R10) . RETURN TO +4 SA52971 42914022 FINDESTQ EQU * . SA52971 42915022 * WILL FIND THE ADDRESS OF BOTH THE MASTER AND PRTY LVL QCBS 42930020 L RQCB,SCBDESTQ-1 . ADDR OF QCB 42960020 SR R11,R11 . 42990020 IC R11,SCBPRI . OFFSET TO PRTY QCB 43020020 FINDEST2 EQU * . 43050020 LA RPQ,QCBMEND-IEDQQCB(RQCB) . 43080020 * ADDR OF FIRST PRTY QCB 43110020 LTR R11,R11 . IS THERE MORE THAN ONE 43140020 BCR ZERO,R14 . BR NO S21101 43170020 LA R1,QCBPEND-IEDQPQCB . SIZE OF A PQCB 43200020 MR R10,R1 . SIZE X NUMBER 43230020 AR RPQ,R11 . ADDR OF THIS PQCB 43260020 BR R14 . 43290020 * WILL DEQUEUE AND ELMENT FROM A FIFO Q 43320020 AIF (&A EQ 1).F025 43350020 DEQMGRC EQU * . 43380020 * IN PUT PARAMETERS - R1 - Q ADDR 43410020 * RETURN WILL BE AT R14 IF NONE OR 4(R14) IF ONE THERE 43440020 DROP RBASE 43470006 USING CPBINIT,RBASE 43480006 TS AVTEZERO(R1) LOCK Q FOR UPDATE Y02027 43490006 BNE DEQMGRC YES, LOOP TILL APP. DONE Y02027 43500006 ICM R15,AD,1(R1) ADDR OF FIRST ON Q Y02027 43510006 BNZ DEQMGRC1 ELEMENT ON Q Y02027 43520006 MVI AVTEZERO(R1),AVTEZERO CLEAR Q LOCK Y02027 43530006 BR R14 RETURN Y02027 43540006 DEQMGRC1 EQU * Y02027 43550006 DROP RBASE 43560006 USING IEDQFA01,RBASE 43570006 MVC 1(3,R1),CPBNEXT . DELINK THE CPB 43590020 MVI AVTEZERO(R1),AVTEZERO CLEAR Q LOCK Y02027 43600006 B 4(R14) . RETURN TO +4 IF ONE THERE 43620020 SBTRKEY1 EQU * . 43650020 LH R1,SCBSIZE . GET SIZE 43680020 .F025 ANOP 43710020 SUBTRKEY EQU * . 43740020 BALR R11,0 . SET ADDRESSIBILITY 43770020 LA R10,INCR(0,R10) . INCREASE ADDRESS S21101 43800020 SH R1,AVTKEYLE . SUBTR. KEY LENGTH FROM SIZE 43830020 BCR PLUS,R11 . BR IF PLUS TO SUBRT S21101 43860020 BR R14 . BR IF ALL UNITS HAVE BEEN COUNT 43890020 AIF (&A EQ 2).F051 . SA52971 43893022 ADFREEMS DC A(FREEMSG) . ADDR OF SUBROUTINE SA52971 43896022 .F051 ANOP , . SA52971 43899022 * SA52971 43902022 * END OF COMMON AREA SA52971 43905022 * SA52971 43908022 DC 40A(0) XXXXXXXXXX PATCH AREA XXXXXXXXXXX @OZ09304 43914000 TITLE '''IEDQFQ'' - CPB CLEANUP' . S22025 43920022 AIF (&A EQ 1).F041A 43950020 * THIS SECTION DEALS WITH A CPB FROM A DISK READ. IT HANDLES 44160020 * ERROR CONDITIONS AND GETTING CPB'S OUT OR ORDER. 44190020 SPACE 3 44220020 CKERB EQU * . 44250020 L RLCB,CPBAERBF . ADDR OF ERB ASSOCIATED 44280020 * WITH THIS READ 44310020 L RSCB,LCBSCBA-1 . 44340020 LNR R2,R2 . SET FLAG FOR FREE CPB 44370020 TM LCBERBST,XCOMPL . 44400020 * HAS THIS REQUEST BEEN COMPLETED PREVIOUSLY 44430020 BO ERBCPB . 44460020 TM LCBERBST,XXXINQ . IS THIS ERB WAITING FOR BFR 44490020 BO NOBFRQ YES-PLACE CPB ON NOBFQ SA52984 44520022 CLC CPBNUMB(1),SCBNXCPB . 44550020 BE CPBCK IF NEXT ONE GO AHEAD SA52984 44553022 TSLOOP EQU * @OZ09304 44556000 TS AVTDKENQ FIELD BEING USED @OZ09304 44556700 BNZ TSLOOP YES, BRANCH AND LOOP @OZ09304 44557400 LA R2,AVTDKENQ-(CPBNEXTF-IEDQCPB) SET ADDRESS FOR @OZ09304 44559000 * START OF LOOP @OZ09304 44559700 ICM R15,EIGHT,AVTDKENQ INSERT IN USE BYTE @OZ09304 44560400 SEARCHLP EQU * SA52984 44562022 LR R14,R2 SET TO NEXT CPB SA52984 44565022 SRCHLP EQU * Y02027 44568006 ICM R2,AD,CPBNEXT-IEDQCPB(R14) IS THIS THE LAST CPB Y02027 44571006 BNZ CPBCK1 IF NOT-CHECK THIS ONE SA52984 44574022 MVI AVTDKENQ,AVTEZERO FREE FIELD @OZ09304 44577000 LA R2,AVTDKAPQ . 44580022 L R14,AENQMGR . ADDR OF Q MGR S22026 44582022 BALR R11,R14 ENQ CPB Y02027 44583006 B GOAPQEMT . 44585022 CPBCK1 EQU * SA52984 44586022 L R2,CPBNEXTF-IEDQCPB(R14) NEXT CPB SA52984 44587022 TM CPBRDWR-IEDQCPB(R2),CPBWRITB IS IT WRITE CPB SA52984 44588022 BO SEARCHLP YES SA52984 44589022 CLC CPBAERB(3),CPBAERB-IEDQCPB(R2) SAME LCB SA52984 44590022 BNE SEARCHLP NO-GET NEXT ONE SA52984 44591022 CLC SCBNXCPB(1),CPBNUMB-IEDQCPB(R2) NEXT THIS LCB SA52984 44592022 BNE SEARCHLP NO-GET NEXT ONE SA52984 44593022 ICM R15,EQUAL,CPBNEXTF-IEDQCPB(R14) SAVE HIGH BYTE @OY20265 44593186 CS R2,R15,CPBNEXTF-IEDQCPB(R14) REPLACE THIS CPB @OS79957 44593200 * WITH NEXT FOR THIS LCB@OS79957 44593400 BNE SRCHLP CS FAILED, RECHAIN @OS79957 44593600 XC CPBNEXT-IEDQCPB(3,R15),CPBNEXT-IEDQCPB(R15) @OS79957 44593800 * CLEAR LINK POINTER @OS79957 44594000 OC CPBNEXT(3),CPBNEXT-IEDQCPB(R2) GET NEW LINK PTR@OS79957 44594300 BNZ END BR IF NOT LAST IN CHAIN@OS79957 44594600 STCM R15,AD,AVTDKENQ+FIVE SET NEW LAST @OS79957 44594700 END EQU * @OS79957 44594900 MVI AVTDKENQ,AVTEZERO FREE FIELD @OZ09304 44596500 LR R15,R2 NEW CPB TO PROCESS SA52984 44597022 CPBCK EQU * SA52984 44598022 L R2,CPBXREAF . 44610020 TM DATFLAGS,DATNPRFX . 44640020 BO CKRECNO . 44670020 CLC CPBADDR+1(3),PRFCRCD-IEDQPRF(R2) . 44700020 * WAS THERE A LOGICAL READ ERROR 44730020 BNE RDERROR . BR YES 44760020 CKEOB EQU * . 44790020 TM LCBERBST,LCBERROR+LCBRDERR . 44820020 * READ ERROR OR LINE ERROR 44850020 BNZ ANYBFRS . BR IF EITHER 44880020 B NEXTCPB . BR TO PROCESS THIS CPB 44910020 AENQMGR DC A(ENQMGRCA) . ADDR OF Q MGR S22026 45130022 CKRECNO EQU * . 45150020 CLC CPBADDR+1(3),DATFEFO . 45180020 BE CKEOB . 45210020 .F041A ANOP @OX20639 45220086 RDERROR EQU * . 45240020 OI LCBERBST,XRDERR . SET RDERR FLAG 45270020 ANYBFRS EQU * . 45300020 ** SET FLAG TO UPDATE ONLY THE CPB COUNT OF ALL SCB FIELDS 45330020 LNR R2,R2 . SET FLAG 45360020 MVC SCBSCSEG(3),CPBADDR+1 . SET FOR NEXT READ IF INIT 45390020 BAL R14,FREECPBA . 45420020 TM LCBSTAT1,LCBINITN . 45450020 BNO NOTINIT . BR IF NOT INIT 45480020 TM LCBERBST,LCBERROR . LINE ERROR ON SEND 45510020 BO NOTINIT . BR YES 45540020 AIF (&A EQ 1).F041B @OX20639 45550086 LA R14,GOAPQEMT . SET RTN ADDR 45570020 .F041B ANOP @OX20639 45580086 INITPOST EQU * . 45630020 MVI LCBERBKY,XCTZERO . SET FIRST BYTE OF ERB S21101 45640020 * . NON ZERO SO HM WILL KNOW S21101 45650020 * . NOT TO POST S21101 45652020 TM LCBERBST,XXHMSG . EOM RCVD IN HM YET 45660020 BCR 14,R14 . BR IF NO TO DROP ERB 45690020 LA R2,AVTDSIOB . ADDR TO POST ERB TO FA 45720020 LA R1,LCBERB . 45750020 CLI LCBERBPY,PRIINTRQ . INITIAL REQUEST 45780020 BE POST . YES - LEAVE THE PRTY 45810020 MVI LCBERBPY,PRISBPCI . SET LOW PRTY 45840020 B POST . POST ERB TO FA 45870020 NOTINIT EQU * . 45930020 BAL R5,FREEBFRS . 45960020 AIF (&A EQ 1).F041C @OX20639 45970086 LA R14,GOAPQEMT . 45990020 .F041C ANOP @OX20639 46000086 LA R1,LCBERB . 46020020 L RSCB,LCBSCBA-1 SCB ADDRESS SA61767 46022000 TM SCBQTYPE,SCBCONC . CONC S22026 46025022 BZ CHKRCALL . BRANCH IF NO S22026 46030022 TM LCBERBST,LCBERROR . LINE ERROR S22026 46035022 BO POSTERR . BRANCH IF YES S22026 46040022 CHKRCALL EQU * . S22026 46045022 TM LCBSTAT1,LCBRCLLN . RECALL 46050020 BO ERBRCQCB . BR YES 46080020 POSTERR EQU * . S22026 46090022 MVI LCBERBPY,PRIDSPLB-1 . POST WITH LOWER PRTY 46110020 TM LCBERBST,LCBERROR . LINE ERROR 46140020 BO ERBRCQCB . BR YES TO RETURN ERB 46170020 * IS RECALL ERB SHOULD BE POSTED TO RCQCB WITH NO BFRS 46200020 * IS NOT RECALL POST AN EOM BFR TO MH WITH ERR BITS SET 46230020 LA R15,ABCODE3 . SET 15 TO ABEND CODE 46260020 BAL R14,AVTABEND . SET 14 TO ADDR OF ABEND 46290020 * AND GO TO THE RTN TO ABEND 46320020 ABCODE3 EQU X'03' . LOGICAL READ ERROR 46350020 EJECT 46410020 * THIS SECTION DEALS WITH A CPB UNIT THAT IS THE NEXT READ 46440020 * EXPECTED OR A CORE UNIT. 46470020 SPACE 3 46500020 AIF (&A EQ 2).F042 46530020 FIXSCSEG EQU * . 46560020 USING CPBINIT,RBASE . 46590020 NI LCBERBST,X'FF'-LCBRDERR .RESET READ ERROR 46620020 AIF (&A NE 3).F042A 46650020 TM SCBQTYPE,SCBCOREQ . CORE QUEUEING 46680020 BNO DISKONLY . BR NO 46710020 .F042A ANOP 46740020 L RBASE,ADRFA01 .. SET UP SECOND BASE 46770020 USING IEDQFA01,RBASE . 46800020 L R2,SCBCORE-1 . ADD LAST BFR THERE 46830020 TM PRFSTAT1-IEDQPRF(R2),PRFNLSTN . THIS NOW LAST 46860020 BO CKNTXT . BR NOW LAST NOW 46890020 MVC SCBSCSEG(3),SCBCORE . RESET BFR ADDR 46920020 B CALLFQA . 46950020 CKNTXT EQU * . 46980020 NC PRFNTXT-IEDQPRF(3,R2),PRFNTXT-IEDQPRF(R2) . 47010020 BZ INITERR . 47040020 MVC SCBSCSEG(3),PRFNTXT-IEDQPRF(R2) . ADDR NEXT BFR 47070020 B CALLFQA . 47100020 .F042 AIF (&A EQ 1).F043 47130020 NEXTCPB EQU * . 47160020 MVC SCBSCSEG(3),CPBADDR+1 . RESET SCSEG 47190020 L R2,CPBXREAF . 47220020 .F043 ANOP 47250020 NEXTCPB1 EQU * . 47280020 TM DATFLAGS-IEDQDATA(R2),DATNPRFX . 47310020 * DOES IS HAVE A PREFIX 47340020 BO CKBFRA . BR NO PRFX 47370020 LA R11,FIXPRFX1 . SET RTN ADDR A42363 47380021 LH R7,PRFSCAN-IEDQPRF(R2) . SAVE SCAN PRT (NO IDLES) 47400020 STH R7,DATSCAN-IEDQDATA(R2) . WHILE PROCESSING THIS UNIT 47430020 LH R7,SCBSCAN . SAVE SEQ OUT NO 47460020 TM PRFSTAT1-IEDQPRF(R2),PRFNHDRN . 47490020 * IS I T A HEADER 47520020 BO FIXPRFX . BR NO 47550020 TM DATFLAGS-IEDQDATA(R2),DATLOSTN LOST MSG 47580020 BNO CONTINUE . BR NO 47610020 OI SCBERR3,SCBLOSTN . SET SCB ERR BIT 47640020 CONTINUE EQU * . 47670020 * ALLOW CNCL MSG IF RECALL 47700020 TM LCBSTAT1,LCBRCLLN . RECALL 47730020 BO FIXSCHDR . 47760020 BAL R14,FINDESTQ . 47790020 * ALLOW INTCP MSG IF RECALL 47820020 TM DATFLAGS-IEDQDATA(R2),DATCNCLD+DATSENT HAS THIS SA52971 47850022 * MSG BEEN CANCELLED OR SA52971 47870122 * SENT SA52971 47890122 BNZ RTNSCHD . BR IF EITHER SA52971 47910022 AIF (&A EQ 1).F044 47940020 LR R5,R15 . SAVE 15 47970020 LH R1,PRFDEST-IEDQPRF(R2) . TRM OFFSET 48000020 N R1,AVTCLRHI . SET UP ADDR OF TNT TO 48030020 L R15,AVTRNMPT . CONVERT OFFSET TO TRM 48060020 BALR R14,R15 . ENTRY ADDRESS 48090020 USING IEDQTRM,R1 . 48120020 LR R15,R5 . RESTORE 15 48150020 TM TRMSTATE,TRMLIST+TRMPROC LIST OR PROCESS ENTRY SA66617 48180054 * INTERCEPTED SA66617 48190054 BNZ NOINTC . BR NO 48210020 CLI SCBUNTCT,AVTEZERO FIRST READ OF HDR @YA08105 48220061 BNE NOINTC BR NO @YA08105 48230061 TM TRMSTATE,TRMHELDN . IS THE TRM INTERCEPTED 48240020 BO FLAGINTC . BR YES 48270020 TM SCBSTATE,SCBLCK1N+SCBMSGLN LOCK MODE @YA05477 48273061 BNZ NOINTC BRANCH IF YES @YA05477 48276061 TM LCBSTAT1,LCBINITN INITIATE MODE @YA05477 48279061 BO NOINTC BRANCH IF YES @YA05477 48282061 NC QCBINTFF(3),QCBINTFF POSSIBLE RELEASE @YA05477 48285061 BNZ NOINTC BRANCH IF NO @YA05477 48288061 CLC SCBSCHDR(3),QCBFFEFO SENDING FEFO MSG @YA05477 48291061 BNE RTNSCHD BRANCH IF NO @YA05477 48294061 NOINTC EQU * . 48300020 .F044 ANOP 48330020 NC SCBFEFO(3),SCBFEFO . HAS IT BEEN UPDATED ALREADY 48360020 BNZ NOFEFOUP . BR YES 48390020 MVC SCBFEFO(3),DATFEFO-IEDQDATA(R2) SET THE FEFO PTR SA52971 48420022 NOFEFOUP EQU * . 48510020 * SAVE FEFO PTR 48540020 MVC LCBTTBIN(2),PRFDEST-IEDQPRF(R2) . 48570020 TM SCBQTYPE,SCBCONC . CONC S22026 48576022 BZ NOTCONCC . BRANCH IF NO S22026 48582022 MVC LCBTTCIN(2),PRFDEST-IEDQPRF(R2) SA57333 48588022 NOTCONCC EQU * . S22026 48594022 FIXOSEQ EQU * . 48600020 LH R7,DATSEQOT . 48630020 B FIXPRFX1 . ALL HEADERS COME HERE 48660020 * BRANCH TO AVOID TEST FOR RETRIEVE 48690020 FIXPRFX EQU * . 48720020 NC LCBTTCIN(2),LCBTTCIN . IF ZERO THIS IS A RETRIEVE 48750020 BCR 7,R11 . BR NOT RETR TO FIXPRFX1 A42363 48780021 TM LCBSTAT2,LCBDIAL IF 0, COULD BE DIAL M2321 48787021 BCR 1,R11 BRANCH IF DIAL-IT IS NOT M2321 48794021 * RETRIEVE M2321 48801021 MVC SCBSCHDR(3),PRFCHDR-IEDQPRF(R2) . 48810020 * SET HDR ADDR THAT CORRESPONDS TO THIS BFR 48840020 FIXPRFX1 EQU * . 48870020 MVC SCBSRCE(PRFSTXT-PRFSRCE),PRFSRCE-IEDQPRF(R2) . 48900020 MVC SCBCHDR(3),SCBSCHDR . SET HDR ADDR 48930020 STH R7,SCBSCAN . RESTORE SEQ OUT NO 48960020 BAL R7,SIZECK . 48990020 LH R7,PRFSIZE-IEDQPRF(R2) . GET SIZE OF BFR 49020020 XC DATCOUNT(2),DATCOUNT . 49050020 CH R7,AVTKEYLE . 49080020 BH CKBFRA . 49110020 STC R7,CPBINWKA . 49140020 B FIXWKACT . 49170020 FIXSCHDR EQU * . 49200020 AIF (&A EQ 1).F045 49230020 MVC SCBSCHDR(3),PRFCRCD-IEDQPRF(R2) . SET SCHDR TO THIS 49260020 AIF (&A EQ 2).F046 49290020 TM SCBQTYPE,SCBCOREQ . IS THIS CORE 49320020 BNO CKBDRCL . BR NOT CORE - SCHDR IS OK 49350020 .F045 ANOP 49380020 MVC SCBSCHDR(3),PRFCORE-IEDQPRF(R2) . RESET SCHDR TO THIS 49410020 .F046 ANOP 49440020 CKBDRCL EQU * . 49470020 NC LCBTTCIN(2),LCBTTCIN . RETRIEVE 49500020 BNZ NOTRET1 NOT RETRIEVE, CONTINUE M2321 49530021 TM LCBSTAT2,LCBDIAL IS THIS DIAL LCB? M2321 49537021 BO NOTRET1 YES,CANT BE RETRIEVE @SA70861 49544061 TM DATFLAGS-IEDQDATA(R2),DATCNCLD CANCELLED MSG? @SA70861 49545061 BNO FIXOSEQ NO, HANDLE RETRIEVE @SA70861 49546061 OI PRFSTAT1-IEDQPRF(R2),PRFCNCLN @SA70861 49547061 * SET MSG CANCELLED @SA70861 49548061 B FIXOSEQ HANDLE RETRIEVE @SA70861 49549061 NOTRET1 EQU * M2321 49551021 TM LCBCHAIN,LCBBFRSZ . SPECIAL RECALL 49560020 BCR 14,R11 . BR NO TO FIXPRFX1 A42363 49590021 TM SCBQTYPE,SCBCOREQ . IS THIS CORE Q'D A42363 49600021 BCR 1,R11 . BR YES TO FIXPRFX1 A42363 49610021 AIF (&A EQ 1).F046A 49620020 * IS DUPL HDR ON DISK - SCBMBSSA WILL HAVE XTRA OR NTXT 49650020 LR R1,RSCB . SET FOR MBSSA ( REUS DSK) 49680020 TM SCBQTYPE,SCBNREUS . IS IT REUS 49710020 BNO ONEOK . BR IF REUS 49740020 LA R1,4(R1) . SET FOR MBSSA+4 N NON REUS) 49770020 ONEOK EQU * . 49800020 .F046A ANOP 49830020 TM SCBHBFNO,X'0F' . FIRST BD RCLL 49860020 BNZ NOTFIRST . 49890020 MVC SCBTRANS(3),SCBSCHDR . SET HDR ADDR FOR NEXT RCLL 49920020 NOTFIRST EQU * . 49950020 AIF (&A EQ 1).F046B 49980020 MVC SCBMBSSA-IEDQSCB(3,R1),PRFXTRA-IEDQPRF(R2) . 50010020 * ASSUME MORE THAN 1 UNIT IN BFR - IF NOT SET NTXT 50040020 NC PRFXTRA-IEDQPRF(3,R2),PRFXTRA-IEDQPRF(R2) SA52971 50070022 * MORE THAN ONE UNIT SA52971 50080022 BCR 7,R11 . BR MORE THAN 1 A42363 50100021 MVC SCBMBSSA-IEDQSCB(3,R1),PRFNTXT-IEDQPRF(R2) . 50130020 .F046B ANOP 50160020 BR R11 . BR TO FIXPRFX1 A42363 50190021 SPACE 3 50220020 * THIS SECTION DEALS WITH FREEING THE LINE AFTER FINDING 50250020 * A CANCLED OR INTERCEPTED MESSAGE AND WILL PUT AN INTERCEPTED 50280020 * MESSAGE IN THE INTERCEPT QUEUE. 50310020 SPACE 3 50340020 RTNSCHD EQU * . 50370020 NI QCBFLAG,X'FF'-QCBSDFFO . RESET FLAG - NO LONGER SA52971 50380022 * SENDING FROM QUEUE SA52971 50390022 CLC SCBSCHDR(3),QCBFFEFO . IS THIS THE FIRST FEFO MSG 50400020 BNE RTNSCHD1 . BR NO 50430020 MVC QCBFFEFO(3),DATFEFO-IEDQDATA(R2) . UPDATE FEFO 50460020 OC QCBFFEFO(3),QCBFFEFO ONLY FEFO MSG? @SA74867 50461000 BNZ ANYHELD NO, CHECK FOR HELD MSGS@SA74867 50462000 MVC QCBFFEFO(3),SCBFEFO MOVE FROM SCB - MAY @SA74867 50463000 * HAVE BEEN UPDATED @SA74867 50464000 * WHILE READING 1ST FEFO@SA74867 50465000 ANYHELD EQU * @SA74867 50466000 NC QCBINTFF(3),QCBINTFF . ANY HELD MSGS ON LEVEL SA52971 50470022 BNZ RTNSCHD1 . BR SOME THERE SA52971 50472022 MVC QCBPFEFO(3),QCBPREVF . SET PTR TO MSG THAT IS SA52971 50474022 * PREVIOUS TO THE FIRST SA52971 50476022 * UNSENT MSG IN THE FEFOSA52971 50478022 * CHAIN SA52971 50480022 MVC QCBPREVF(3),PRFCRCD-IEDQPRF(R2) SET PTR TO MSG SA52971 50482022 * PREVIOUS TO FFEFO SA52971 50484022 RTNSCHD1 EQU * . 50490020 AIF (&A NE 3).F047 50520020 TM SCBQTYPE,SCBCOREQ . IS THIS MSG CORE QUEUED 50550020 BO CORERTN . BR YES 50580020 .F047 AIF (&A EQ 1).F048 50610020 LH R14,AVTDSKCT . DECR FOR THIS READ 50640020 BCTR R14,0 . 50670020 STH R14,AVTDSKCT . 50700020 BAL R14,CPBFREEA . FREE THE CPB 50790020 RTNSCHED EQU * . 50820020 LA R14,GOAPQEMT . 50850020 AIF (&A EQ 2).F049 50880020 B XTNSCHED . 50910020 .F048 ANOP 50940020 CORERTN EQU * . 50970020 TM QCBDSFLG,QCBDISK ANY DISK SA62949 50974005 BNZ NOMSGCT IF DISK, MSGCT DONE SA62949 50978005 LH R14,QCBMSGCT LOAD COUNT SA62949 50982005 BCTR R14,0 DECREMENT SA62949 50986005 STH R14,QCBMSGCT STORE COUNT SA62949 50990005 NOMSGCT EQU * SA62949 50994005 LR R6,R2 . 51000020 ST R2,AVTDOUBL . SET MSG ADDR 51030020 L R15,ADFREEMS . 51060020 BAL R7,HAVEADDR-FREEMSG(R15) . 51090020 RTNSCHD2 EQU * . 51120020 LA R14,CALLPROC . SO CPB Q WILL NOT BE CHECKED 51150020 XTNSCHED EQU * . 51180020 .F049 ANOP 51210020 L RSCB,LCBSCBA-1 . SCB ADDR 51240020 NI SCBQTYPE,X'FF'-SCBBFMM . SET NOT MIDDLE OF MSGL 51270020 L RQCB,SCBDESTQ-1 . DEST Q ADDR 51330020 *** THIS SUBROUTINE DESTROYS REGS 0,1,2, AND 11. THE QCB SA52971 51360022 * EXTENSION IS RETURNED IN REG2. RETURN IS TO +0 IF THIS SA52971 51360422 * IS NOT A CONCENTRATOR AND TO +4 IF IT IS A CONCENTRATOR. SA52971 51360822 BAL R10,FINDLVL . GO FIND QCB EXTENSION SA52971 51361222 B RESETLCB . BR NOT CONC SA52971 51361622 NI QCBEFLG-IEDQQCBE(R2),255-QCBEDATA . S22026 51362022 * RESET QCBEDATA S22026 51362122 LA R1,LCBERB . ERB ADDR S22026 51363022 L R2,AVTCSCH . CONC SCH ADDR S22026 51366022 SH R2,AVTHA2 . SUB TWO S22026 51369022 B POST . POST ERB TO Q9 S22026 51372022 RESETLCB EQU * . S22026 51375022 LA R2,AVTBFRTB . ADDR OF BFR RTB QCB 51390020 CLI LCBFLAG1,LCBPLCB PLCB @YM08981 51390400 BNE NOTPLCB BR NO @YM08981 51390800 XC SCBERRST,SCBERRST CLEAR ERROR WORD @YM08981 51391200 * TO RESET ANY BITS THAT @YM08981 51391600 * MAY HAVE BEEN SET DUE @YM08981 51392000 * TO A PREVIOUS DIAL @YM08981 51392400 * CONTACT ERROR OR PURGE @YM08981 51392800 * EXIT TAKEN PRIOR TO @YM08981 51393200 * DIAL CONTACT @YM08981 51393600 B NOBSDIAL SKIP EP ONLY CODE @YM08981 51394000 NOTPLCB EQU * @YM08981 51394400 TM LCBSTAT2,X'06' BSC DIAL @OX12563 51395000 BNO NOBSDIAL BR IF NO @OX12563 51400000 MVC LCBSTAT1(1),LCBSENS0 SET LINE STATE @OX12563 51405000 MVC SCBBSCFM(1),LCBSENS1 SET FORMAT BITS @OX12563 51410000 NOBSDIAL EQU * @OX12563 51415000 ST R2,SCBDESTQ-1 . INTO SCB FOR BD POST 51420020 CLI LCBERBPY,PRIAPERB . IS THIS AN APPL. PGM. 51450020 BE ERBRCQCB . YES - RETURN ERB NOT LCB 51480020 CLI LCBRSKEY,DSPBUFSC IS THIS A BFRD TERM SA57087 51485022 BNE POSTLCB BR IF NOT BFRD SA57087 51490022 XI LCBSTAT1,LCBRECVN+LCBSENDN RESET LCBSTATE @OX11340 51492000 OI LCBSTAT2,LCBNEGRP SET NEG RESP FLG SA57087 51495022 NI QCBSTAT,X'FF'-QCBSEND RESET SENDING FLG SA57087 51500022 POSTLCB EQU * SA57087 51505022 LR R2,RLCB . 51510020 LR R1,R2 . 51540020 MVI LCBPRI,PRILNFRE SET LCB PRIORITY SA52984 51550022 B POST . 51570020 AIF (&A EQ 1).F050 51600020 SET14 EQU * . 51630020 LA R14,GOAPQEMT . 51660020 B POST . 51690020 FLAGINTC EQU * . 51720020 * IF TERMINAL IS IN LOCK MODE SEND THE RESPONSE ANYWAY 51750020 TM SCBSTATE,SCBLCK1N+SCBMSGLN .LOCKED TERMINAL 51780020 BNZ NOINTC . BR IF LOCKED TO SEND ANYWAY 51810020 TM LCBSTAT1,LCBINITN . INITIATE MODE 51840020 BNO OKHOLD . BR NOT INIT TO HOLD MSG 51870020 NI LCBSTAT1,LCBINITF . SET NOT INIT 51900020 MVC DATFEFO-IEDQDATA(3,R2),QCBFFEFO . SET FOR MOVES LATER 51930020 L R5,PRFLCB-1-IEDQPRF(R2) . SRCE LCB ADDR 51960020 TM LCBSTAT1-IEDQLCB(R5),LCBINITN . STILL INIT MODE 51990020 BNO OKHOLD . BR NO TO HOLD MSG 52020020 NI LCBSTAT1-IEDQLCB(R5),LCBINITF .RESET INIT MODE 52050020 B RTNSCHD1 . GO TO RETURN THE LINE 52080020 OKHOLD EQU * . 52110020 TM QCBDSFLG,QCBREUS+QCBNREUS . ANY DISK 52140020 BZ RTNSCHD . BR NO 52170020 MVC SCBSCHDR(3),PRFCRCD-IEDQPRF(R2) RESET SCB SA52971 52176022 *** IF DISK QUEUED, THIS IS A NOP. IF CORE WITH DISK BACK UP, SA52971 52182022 * THIS WILL SET THE DISK ADDRESS OF THE HEADER INSTEAD OF THE SA52971 52188022 * MAIN STORAGE ADDRESS OF THE HEADER SA52971 52194022 NC QCBINTFF(3),QCBINTFF . ANY FEFO MSGS THERE 52200020 BNZ RTNSCHD . BR IF SOME ALREADY THERESA52971 52230022 CLC SCBSCHDR(3),QCBFFEFO FIRST FEFO MESSAGE SA66626 52530054 BNE RTNSCHD NO,DON'T UPDATE INTFF SA66626 52830054 MVC QCBINTFF(3),PRFCRCD-IEDQPRF(R2) . 53190020 B RTNSCHD . FREE THE CPB THIS TIME 53250020 .F050 AIF (&A EQ 1).F052 . SA52971 53280022 ERBCPB EQU * . 53370020 BAL R14,FREECPBA . 53400020 LA R6,LCBERBCH-5 . SET ERBCH FOR LINK FIELD 53430020 BAL R14,BFRLINK . GO LIND THE LAST BFR 53460020 L R6,PRFLINK-1 . NEXT IN CHAIN 53490020 BFRLINK EQU * 53520020 NC PRFLINK(3),PRFLINK . ANOTHER THERE 53550020 BCR NOTZERO,R14 . BR NOT ZER0 TO GET NEXT S21101 53580020 B CKENQERB . 53610020 .F052 ANOP 53640020 SPACE 3 53670020 * THIS SECTION WILL POST THE ERB AFTER A REQUEST IS COMPLETED 53700020 * IF NECESSARY OR WILL FREE THE ERB TO BE POSTED AGAIN FRO 53730020 * ANOTHER REQUEST. 53760020 SPACE 3 53790020 * TO CKREQ WHEN END OF MESSAGE GOTTEN FROM THE QUEUE 53820020 * TO CKREQ WHEN THE REQUEST HAS BEEN COMPLETED -- BUFFERS FILLED 53850020 CKREQ EQU * . 53880020 L RSCB,LCBSCBA-1 . RESTORE IN CASE OF DISP BAL 53910020 BAL R11,FIXDEOB . CC WILL REMAIN UNCHANGED 53940020 BO FIXRECAL . BR YES 53970020 TM SCBQTYPE,SCBCONC . CONC S22026 53973022 BZ NOTCONCA . BRANCH IF NO 53976022 L RSCB,LCBSCBDA-1 . LINE SCB ADDR S22026 53979022 MVI LCBERBPY,PRIFSPCI . SET TO POST BUFFERS S22026 53985022 TM SCBSTAT1,SCBCBGN . CONC MSG BEGIN S22026 53988022 L RSCB,LCBSCBA-1 . RESET SCB ADDR S22026 53991022 BO LOGICEOM . BRANCH IF YES 53994022 NOTCONCA EQU * . S22026 53997022 CLI LCBERBPY,PRIINTRQ . 54000020 * IS THIS AN INITIAL REQ 54030020 BE LOGICEOM . BR YES 54060020 CMIDMSG EQU * . S22026 54070022 CLI LCBERBPY,PRIAPERB . APPLICATION PGM ERB 54090020 BE ERBRCQCB . BR YES 54120020 AIF (&A EQ 1).F053 54150020 LA R5,GOAPQEMT . 54180020 AIF (&A EQ 2).F054 54210020 TM SCBQTYPE,SCBCOREQ . 54240020 BNO CKRQTYPE . 54270020 .F053 ANOP 54300020 LA R5,CALPROC1 . 54330020 CKRQTYPE EQU * . 54360020 .F054 ANOP 54390020 CLI LCBERBPY,PRIFSPCI . 54420020 BNE FREEBFRS . 54450020 TM SCBQTYPE,SCBCONC . CONCENTRATOR S22026 54456022 BZ NOTCONCD . BRANCH IF NO S22026 54462022 MVI LCBERBPY,PRIINTRQ-1 . RESET PRIORITY 54468022 NOTCONCD EQU * . S22026 54474022 L RDCB,LCBDCBPT . 54480020 L R2,DCBMH-1 . 54510020 CLI LCBFLAG1,LCBPLCB THIS A PLCB @YM06085 54516000 BNE GOTMH BR NO, HAVE MH ADDRESS @YM06085 54522000 L R2,LCBMHA-1 GET PROPER MH QCB @YM06085 54528000 GOTMH EQU * @YM06085 54534000 LA R15,PRIMHBFR . 54540020 B FREEBFR1 . 54570020 FREEBFRS EQU * . 54600020 TM LCBSTAT1,LCBRCLLN IS THIS A RECALL SA61767 54602000 BO NOCONC IF RECALL NO NEED TO SA61767 54602500 * RESET EDATA SA61767 54603000 BAL R14,FINDESTQ GET QCB & PQCB SA61767 54603500 BAL R10,FINDLVL QCBE ADDR IF CONC SA52971 54604022 B NOCONC BRANCH IF NOT CONC SA52971 54606022 L R1,LCBERBCH-1 BUFFER ADDR SA52971 54608022 LA R1,AVTEZERO(R1) CLEAR HI-ORDER BYTE SA52971 54610022 LTR R1,R1 BUFFER THERE SA52971 54612022 BZ NOCONC BRANCH IF NO SA52971 54614022 TM PRFSTAT1-IEDQPRF(R1),PRFNHDRN SA52971 54616022 * HEADER BUFFER SA52971 54618022 BO NOCONC BRANCH IF NO SA52971 54620022 NI QCBEFLG-IEDQQCBE(R2),255-QCBEDATA SA52971 54622022 * RESET QCBEDATA SA52971 54624022 NI SCBQTYPE,AVTEFF-SCBBFMM RESET MIDDLE MSG BIT SA61767 54625000 NOCONC EQU * SA52971 54626022 LA R15,PRIBFRTB . SET PRTY FOR SUBRTN 54630020 LA R2,AVTBFRTB . 54660020 FREEBFR1 EQU * . 54690020 BALR R14,0 . 54720020 NC LCBERBCH(3),LCBERBCH . 54750020 BCR ZERO,R5 . S21101 54780020 L R1,LCBERBCH-1 . 54810020 STC R15,PRFPRI-IEDQPRF(R1) . SET PRIORITY 54840020 MVC LCBERBCH(3),PRFLINK-IEDQPRF(R1) . 54870020 B POST . 54900020 LOGICEOM EQU * . 54930020 OI LCBERBST,LCBDLNKN . SET FOR PCI 54960020 L RDCB,LCBDCBPT . DCB ADDR S22024 54965022 TM LCBERBST,XMSG . HAS EOM BEEN DONE 54990020 BO POSTERB . BR YES 55020020 TM DCBPCI,PCIADD . PCI=ADD SPECIFIED S22026 55080022 BNZ POSTERB . BRANCH IF YES S22026 55100022 TM SCBQTYPE,SCBBBFTM+SCBCONC . S22026 55120022 NI PRFSTAT1,PRFNLSTF . SET LAST SEG IN BFR 55290020 POSTERB EQU * . 55320020 MVI LCBERBPY,PRIACTIV . 55350020 LA R2,AVTACTIB . ACTIVATE QCB 55380020 TM DCBDSORG,LGB . IS BLOCK DCB OR LGB S22024 55385022 BNO RCPOST . BRANCH IF DCB S22024 55390022 L R2,AVTSAVTP GET POINTER TO SECONDARY S22024 55395022 * AVT S22024 55400022 L R2,SAVTCNIR-IEDNSVTD(R2) NIR QCB ADDR @Y17XA0Z 55402000 RCPOST EQU * . 55410020 LA R1,LCBERB . 55440020 L RSCB,LCBSCBA-1 SCB ADDRESS SA61767 55450000 AIF (&A NE 3).F055 55470020 TM SCBQTYPE,SCBCOREQ . 55500020 BNO SET14 . 55530020 .F055 AIF (&A NE 2).F056A 55560020 B SET14 . 55590020 AGO .F056 55620020 .F056A ANOP 55650020 LA R14,CALPROC1 . 55680020 B POST . 55710020 .F056 ANOP 55740020 FIXDEOB EQU * . 55770020 NI LCBERBST,X'FF'-XCOMPL . RESET REQUEST COMPLETE 55800020 TM LCBSTAT1,LCBRCLLN . RECALL 55830020 BCR NOTONES,R11 . S21101 55860020 L R2,SCBSCSEG-1 . UPDATE SCB DEOB 55890020 ST R2,SCBDEOB . 55920020 IC R2,SCBUNTCT . 55950020 STC R2,SCBDEOB . 55980020 BR R11 . 56010020 FIXRECAL EQU * . 56040020 L RPREFIX,LCBERBCH-1 . ADDR FIRST BFR 56070020 OI PRFSTAT1,PRFDUPLN . SER DUPL FLAG 56100020 MVI LCBERBPY,PRIRCQCB . SET PRTY FOR RECALLS 56130020 MVI SCBUNTCT,AVTEZERO . 56160020 MVI SCBNXCPB,AVTEZERO . SET FOR MH 56190020 ERBRCQCB EQU * . 56220020 L R2,LCBRCQCB . 56250020 LA R2,AVTEZERO(R2) CLEAR HI BYTE SA54262 56260022 * LEAVE PRTY SET TO D0 FOR AN APPL PGM 56280020 B RCPOST . 56310020 EJECT 56340020 * THIS SECTION OF CODE WILL INITIALIZE THE FIELDS NEEDED 56370020 * TO CONSTRUCT A BUFFER FROM A UNIT OF DATA. THE UNIT IS 56400020 * A CPB UNIT JUST READ FROM DISK OR A UNIT IN THE CORE QUEUE 56430020 * THESE ARE THE FIELDS AND THRIR MEANINGS 56460020 * CPBINWKA - THE COUNT OF DATA TO BE MOVED FROM THE UNIT 56490020 * INTO THE BUFFER. 56520020 * CPBWKACT - THE COUNT OF DATA IN THE UNIT THAT HAS NOT YET 56550020 * BEEN TRANSFERED INTO A BUFFER. 56580020 * DATCOUNT - THE COUNT OF DATA IN A UNNIT THAT DOES NOT HAVE 56610020 * A PREFIX - IF =0 - UNIT IS FULL 56640020 * CPBTOUNT - THE COUNT OF DATA TO BE MOVED INTO A BUFFER UNIT 56670020 * TO FILL THE UNIT OF THE BUFFER 56700020 * CPBUNTCT - COUNT OF DATA BYTES ALREADY IN A BUFFER UNIT. 56730020 * SCBUNTCT - THE COUNT OF DATA BYTES ALREADY TRANSFERRED OUT 56760020 * OF THE UNIT QUEUED AT SCBSCSEG. 56790020 SPACE 3 56820020 CKBFRA EQU * . 56850020 MVC CPBINWKA(1),AVTKEYLE+1 . SET COUNT OF DATA IN WKA TO 56880020 * KEYLE 56910020 CLI DATCOUNT,AVTEZERO . IS COUNT =0 56940020 BE FIXWKACT . 56970020 MVC CPBINWKA(1),DATCOUNT . CORRECT CONUT 57000020 FIXWKACT EQU * . 57030020 CLI SCBUNTCT,AVTEZERO . ANY NOT MOVED 57060020 BE HAVEBUF . BR NO 57090020 IC R8,SCBUNTCT . AMT LEFT TO MOVE 57120020 IC R14,CPBINWKA . TOTAL DATA THERE 57150020 SR R14,R8 . SUBTRACT FOR AMY LEFT 57180020 STC R14,CPBINWKA . NEW AMT OF DATA THERE 57210020 STC R8,CPBWKACT . SET AMT MOVED ALREADY 57240020 HAVEBUF EQU * . 57270020 NC LCBERBCH(3),LCBERBCH . ANY BFRS THERE 57300020 BNZ BFRTHERE . BR YES 57330020 LR R8,R15 . SAVE CPB ADDR 57360020 LA R7,SIZTHERE . 57390020 CLI LCBERBKY,AVTEZERO . 57420020 BCR EQUAL,R7 . S21101 57450020 TM DATFLAGS,DATNPRFX . 57480020 BO USELCB . 57510020 LR RPRF,R2 . 57540020 BAL R7,OFFSET . 57570020 SIZTHERE EQU * . 57600020 LR R15,R8 . RSTORE CPB ADDR 57630020 LA RPRF,LCBERBLK-1 . INITIALIZE 57660020 LA R8,LCBERB . 57690020 * SET UP AMOUNT OF DATA TO BE MOVED INTO THE NEW UNIT 57720020 NEWBUFB EQU * . 57750020 LA R14,AVTUMALN(R2) . SET FOR MOVE 57780020 MVC CPBTOUNT(1),AVTKEYLE+1 . COUNT TO UNT = KEYLE 57810020 CLC LCBERBQB+1(2),AVTKEYLE . BFR LARGER THAT KEYLE 57840020 BH NEWBUFC . BR YES 57870020 MVC CPBTOUNT(1),LCBERBQB+2 . CORRECT COUNT 57900020 NEWBUFC EQU * . 57930020 SR R7,R7 . 57960020 * SET R7 TO INDICATE A PREFIX IS NEEDED 57990020 * GET A NEW UNIT 58020020 BAL R9,GETBFR . 58050020 NEWBUFD EQU * . 58080020 LA R9,AVTUMALN(R5) . ADDR TO MOVE FROM 58110020 NEWBUFA EQU * . 58140020 AIF (&A EQ 1).F056C 58170020 LA R1,0(R1) . MAKE R1 POSITIVE 58200020 .F056C ANOP 58230020 SPACE 3 58260020 * THIS SECTION WILL DETERMINE WHETHER THE BUFFER UNIT AND 58290020 * CPB UNIT ( OR QUEUED UNIT IN CORE) CAN BE SWAPPED OR DATA 58320020 * MUST BE TRANSFERRED. 58350020 SPACE 3 58380020 CLI CPBWKACT,AVTEZERO . ANY MOVED 58410020 * IF ANY HAS ALREADY BEEN MOVED FROM THE WORK UNIT BR TO 58440020 * SKIP OVER IT 58470020 BNE MOVEWKBS(R7) . 58500020 TM DATFLAGS,DATNPRFX . UNIT HAVE PRFS 58530020 * IF NOT - ONE MAY OR MAY NOT BE NEEDED - GO CHECK 58560020 BO SETMOVE1(R7) . 58590020 * THE UNIT HAS A PREFIX 58620020 LTR R7,R7 . IS A PRFX NEEDED 58650020 BNZ SETMOVE . BR NO 58680020 AIF (&A EQ 1).F056D 58710020 * HAVE PRFX AND NEED PRFX - IS DISK AND NOT A HDR - IDLE 58740020 * CHARACTERS MUST BE REMOVED. 58770020 TM PRFSTAT1-IEDQPRF(R2),PRFNHDRN . HDR 58800020 BNO MAYSWAP . BR HDR 58830020 TM LCBSTAT1,LCBRCLLN+LCBRECVN . 58860020 * LEAVE IDLES IF RECALL ON RCV OR FROM BD 58890020 BO MAYSWAP . BR IF RECALL 58920020 TM LCBCHAIN,LCBBFRSZ . FROM BD 58950020 BO MAYSWAP . BR YES 58980020 CLI DATSCAN+1-IEDQDATA(R2),AVTEZERO . ANY IDLES 59010020 BZ MAYSWAP . BR IF NO IDLES TO REMOVE 59040020 LNR R1,R1 . SET FLAG FOR IDLES 59070020 .F056D ANOP 59100020 MAYSWAP EQU * . 59130020 CLC CPBTOUNT(1),CPBINWKA . IS THE AMT OF DATA THE 59160020 * UNIT CAN HODD LESS THAN AMT TO MOVE IN WKA 59190020 BL MOVUNT2(R7) . 59220020 CLI CPBUNTCT,AVTEZERO . ANY ALREADY IN UNIT 59250020 BNE PARTFULL . BR IF DATA THERE 59280020 AIF (&A EQ 3).F057 59310020 AIF (&A NE 1).F058 59340020 B MOVUNT2(R7) . 59370020 AGO .F059 59400020 .F057 ANOP 59430020 * THE UNIT AND BFR UNIT CAN BE SWAPPED IF NOT CORE QUEUED 59460020 TM SCBQTYPE,SCBCOREQ . 59490020 BO MOVUNT2(R7) . 59520020 .F058 ANOP 59550020 LTR R1,R1 . ANY IDLES TO REMOVE 59580020 BM BLDPRF1 . BR YES TO MOVE DATA 59610020 * SWAP CPB UNIT AND BFR 59640020 ST R5,CPBXREAF . 59670020 MVI CPBWKACT,AVTEZERO . 59700020 LTR R7,R7 . PRFX NEEDED 59730020 BNZ TICLINK . BR NO 59760020 TM PRFSTAT1-IEDQPRF(R2),PRFNHDRN . HDR 59790020 BNO NOMOVE . BR NO - YES SET UP THE ADDR 59820020 MVC PRFCHDR-IEDQPRF(3,R2),SCBSCHDR . OF CORRECT HDR 59850020 NOMOVE EQU * . 59880020 STH R7,PRFSIZE-IEDQPRF(R2) . 59910020 LR R5,R2 . 59940020 BAL R7,FIXIT . 59970020 .F059 ANOP 60000020 AIF (&A EQ 1).F059A 60030020 ADDWKA EQU * . 60060020 IC R11,CPBINWKA . 60090020 MVI CPBINWKA,AVTEZERO . 60120020 .F059A ANOP 60150020 STORE EQU * . 60180020 N R11,XMASK . 60210020 AH R11,PRFSIZE . 60240020 STH R11,PRFSIZE . 60270020 NC LCBTTCIN(2),LCBTTCIN RETRIEVE? @SA70861 60275061 BNZ NOTRET3 BRANCH IF NO @SA70861 60280061 TM LCBSTAT2,LCBDIAL DIAL LCB? @SA70861 60285061 BNO NOTRET4 BRANCH IF NO @SA70861 60290061 NOTRET3 EQU * @SA70861 60295061 NI PRFSTAT1,PRFCNCLF 60300020 NOTRET4 EQU * @SA70861 60310061 IC R14,CPBWKACT . 60330020 STC R14,SCBUNTCT . 60360020 CH R11,LCBERBQB+1 . 60390020 BNL BUFCPB . 60420020 BFNOTFUL EQU * . 60450020 CLI CPBINWKA,AVTEZERO . ALL WKA BEEN MOVED 60480020 BNE NXTUNT . BR YE NO 60510020 BFRFULL EQU * . 60540020 LA R2,0(R2) . CLEAR FOR LTR 60570020 BAL R14,FREECPBA . 60600020 TM SCBSTAT1,PRFNLSTN . LAST BFR 60630020 BO CKENQERB . 60660020 AIF (&A NE 3).F060 60690020 TM SCBQTYPE,SCBCOREQ . 60720020 BO ENDMSG1 . 60750020 .F060 AIF (&A EQ 1).F061 60780020 NC SCBXTRA(3),SCBXTRA . ANY XTRA RECORDS 60810020 BZ ENDMSG . BR NO 60840020 CLC CPBADDR+1(3),SCBCRCD . HAS THIS PRFX ONLY BEEN 60870020 BE CKENQERB . READ - BR YES TO READ XTRA AND 60900020 * FIX NTXT - IF ONLY PRFX READ NTXT COULD BE TXT QBCK CHN 60930020 CLC CPBADDR+1(3),SCBNTXT . LAST XTRA READ 60960020 BNE CKENQERB . BR NO TO INIT NEXT READ 60990020 ENDMSG EQU * . 61020020 CLI CPBINWKA,AVTEZERO . ALL MOVED 61050020 BNE CKENQERB . NO - NOT EOM 61080020 BAL R10,SETEOM . 61110020 .F061 ANOP 61140020 ENDMSG1 EQU * . 61170020 LA R14,CKENQERB . 61200020 NC LCBERBCH(2),LCBERBCH . THIS BFR BEEN FREED YET 61230020 BCR ZERO,R14 . BR IF FREED S21101 61260020 B FULLBUF . 61290020 SETEOM EQU * . 61320020 NI PRFSTAT1,PRFNLSTF . SET NOT LAST OFF 61350020 OI LCBERBST,LCBEOMSG . SET EOM GOTTEN 61380020 MVI SCBUNTCT,AVTEZERO . SET TO 0 FRO MH 61410020 MVI SCBNXCPB,AVTEZERO . SET FOR MH 61440020 BR R10 . RETURN 61470020 CKENQERB EQU * . 61500020 TM LCBERBST,LCBEOMSG . END OF MSG GOTTEN 61530020 BO CKREQ . 61560020 AIF (&A EQ 1).F061AA 61560300 TM LCBERBST,LCBERROR LCB ERROR @OS77389 61560600 BNO NOSNDERR NO, BRANCH @OS77389 61560900 NI LCBERBST,AVTEFF-LCBPRCPG TURN OFF BFR REQUEST @OS77389 61561200 B POSTERR @OS77389 61561500 NOSNDERR EQU * @OS77389 61561800 .F061AA ANOP 61562100 CLI LCBERBCT,AVTEZERO . 61590020 BNE ENQERB . 61620020 OI LCBERBCT+1,XXCTUSED . FLAG THE DISABLED COUNT 61650020 CLI LCBERBCT+1,XXCTUSED . IS THE DISABLED CT 0 61680020 BNE ADDCTS . BR IF DISA. CT NOT 0 61710020 NI LCBERBCT+1,X'FF'-XXCTUSED . 61740020 * SET DISABLED COUNT FLAG OF 61770020 OI LCBERBST,LCBDLNKN . SET FOR PCI 61800020 LH R11,LCBERBCT . 61830020 LTR R11,R11 . 61860020 BZ CKREQ . 61890020 TM LCBERBST,LCBDLNKN . 61920020 BNO CKREQ . 61950020 NI LCBERBST,LCBDLNKF . 61980020 B ENQERB . 62010020 SPACE 3 62040020 * THIS SECTION WILL DETERMINE HAW TO BUILD THE BUFFER UNIT WHEN 62070020 * DATA IS TO BE MOVED. 62100020 SPACE 3 62130020 SETMOVE1 EQU * . 62160020 * IF UNIT DOES NOT HAVE A PREFIX - BR *+(R7) 62190020 B BUILDPRF . 62220020 B MAYSWAP . 62250020 MOVEWKBS EQU * . 62280020 * IF PART OF WORK AREA HAS BEEN MOVED - BR TO *+(R7) 62310020 B MOVEWKA . 62340020 B MOVUNT2+4 . 62370020 AIF (&A EQ 1).F061A 62400020 TICLINK EQU * . 62430020 LR R5,R2 . 62460020 LA R7,ADDWKA . RETURN ADDRESS 62490020 B LINKTIC . USE COMMON CODE 62520020 * 62550020 .F061A ANOP 62580020 * IF MORE DATA IN WORK AREA THAN NEEDED IN UNIT 62610020 MOVUNT2 EQU * . 62640020 * COULD SWAP IF NOT CORE QUEUED 62670020 B BLDPRF1 . 62700020 LA R7,MOVEWKB . SET RETURN ADDRESS 62730020 LINKTIC EQU * . 62760020 ST R5,PRFTIC-IEDQPRF(R8) . 62790020 MVI PRFTIC-IEDQPRF(R8),CPBTICC . 62820020 LR R8,R5 . 62850020 XC PRFLINK-IEDQPRF(6,R8),PRFLINK-IEDQPRF(R8) . 62880020 MVI PRFTIC+3-IEDQPRF(R8),X'02' . 62910020 MVI PRFTIC-IEDQPRF(R8),CPBTICC . SET TIC 62940020 BR R7 . RETURN 62970020 * 63000020 MOVEUNTA EQU * . 63030020 * HERE TO MOVE AMOUNT OF DATA NEEDED IN NEW UNIT 63060020 LR R8,R5 . 63090020 IC R11,CPBTOUNT . 63120020 MOVESET EQU * . 63150020 LA R7,4095(R11) . SUBRT ONE FOR MOVE 63180020 EX R7,MOVE . MOVE DATA 63210020 IC R14,CPBWKACT . ADD AMOUNT MOVED THIS 63240020 AR R14,R11 . TIME TO AMOUNT ALREADY 63270020 STC R14,CPBWKACT . MOVED FROM WORK AREA 63300020 IC R14,CPBINWKA . SUBTR AMOUNT MOVED 63330020 SR R14,R11 . FROM AMOUNT LEFT TO 63360020 STC R14,CPBINWKA . MOVE FROM WORK AREA 63390020 B STORE . 63420020 BFRTHERE EQU * . 63450020 BAL R14,LAST . 63480020 B NEWBUFB . BR IF LAST BFR FULL 63510020 LA R14,AVTUMALN(R2) . FROM ADDR + 12 63540020 LA R7,4 . SET NO PRFX NEEDED 63570020 LTR R11,R11 . 63600020 BP NEWBUFA . THE LAST UNIT NOT FULL 63630020 BAL R9,ADDNBUNT . 63660020 B NEWBUFD . 63690020 PARTFULL EQU * . 63720020 LA R14,AVTUMALN(R2) . SET 14 FOR MOVE 63750020 B MOVEWKB . BR TO MOVE DATA 63780020 MOVEWKA EQU * . 63810020 LA R14,AVTUMALN(R2) . FROM ADDR + 12 63840020 B BUILDPRF . 63870020 IDLETEST EQU * . 63900020 TM LCBSTAT1,LCBRCLLN+LCBRECVN . SHOULD IDLES 63930020 BO SAVEIDLE . RESERVE CHARACTERS ARE TO BE 63960020 * BE SAVED - ---- YES IF THIS IS A BD RECALL OR A 63990020 * RECALL ON THE RECEIVE SIDE - BT 64020020 TM LCBCHAIN,LCBBFRSZ . BD RECALL 64050020 BO SAVEIDLE . 64080020 B BLDPRF2 . SAVED 64110020 BLDPRF1 EQU * . 64140020 * WILL ENTER HERE ONLY IF HAVE A PREFIX AND NEED ONE BUT 64170020 * A SWAP IS NOT POSSIBLE. 64200020 SR R1,R1 . 64230020 IC R1,DATSCAN+1-IEDQDATA(R2) . NO. IDLES 64260020 * SHOULD ALSO BE SKIPPED 64290020 LA R11,AVTTXTSZ . SIZE OF TXT PRF 64320020 TM SCBSTAT1,PRFNHDRN . IS THIS IS HCR 64350020 BO IDLETEST . BR NOT HDR TO TEST FOR IDLES 64380020 MVC PRFHQBCK-IEDQPRF(PRFSHDR-PRFSTXT,R5),PRFHQBCK-IEDQPRF(R2) 64410020 *********************** 64440020 * UPDATE HDR ONLY FIELDS SINCE THE HDR IS STILL AVAILABLE 64470020 LA R11,AVTHDRSZ . CORRECT SIZE FOR HDR 64500020 SAVEIDLE EQU * . 64530020 LH R7,DATSCAN-IEDQDATA(R2) . SAVE SCAN AND IDLES 64560020 SR R1,R1 . IDLES SHOULD REMAIN IN HDRS 64590020 BLDPRF2 EQU * . 64620020 AR R1,R11 . NO IDLES + SIZE OF PRFX 64650020 IC R9,CPBINWKA . SUBTR PRF SIZE FROM COUNT 64680020 SR R9,R1 . OF DATA TO MOVE FROM WK AREA 64710020 STC R9,CPBINWKA . 64740020 STC R1,CPBWKACT . SET AMT MOVED 64770020 B BLDPRF3 . TREAT AS NEW BFR NOT NEW REC 64800020 BUILDPRF EQU * . 64830020 * ENTER HDRE IF NEED A PREFIX BUT DO NOT HAVE ONE 64860020 LA R11,AVTTXTSZ . INITIALIZE TXT PRF SIZE 64890020 OI SCBSTAT1,PRFNHDRN . THIS MUST NOT BE HDR 64920020 BLDPRF3 EQU * . 64950020 MVC PRFSRCE-IEDQPRF(AVTTXTSZ-4,R5),SCBSRCE . 64980020 NI SCBSTAT1,X'D7' . INTERCPT AND DULP OFF 65010020 STH R7,PRFSCAN-IEDQPRF(R5) . ZERO THE SCAN PRT 65040020 STC R11,CPBUNTCT . SET AMT IN UNIT NOW 65070020 IC R9,CPBTOUNT . 65100020 SR R9,R11 . 65130020 STC R9,CPBTOUNT . 65160020 STH R11,PRFSIZE-IEDQPRF(R5) . 65190020 * NEXT MOVE TO UNIT ADDR + PRFX SIZE + 12 65220020 BAL R7,FIXIT . 65250020 * SET FOR DEOB FOR EOB'S - THE THE QUEEU ADDR OF 65280020 MVC PRFCRCD(3),SCBSCSEG . THIS RECORD 65310020 TM PRFSTAT1,PRFNHDRN . IS THIS A HDR 65340020 BNO MOVEWKB BRANCH IF NOT HEADER S21101 65370021 MVC PRFCHDR(3),SCBSCHDR . SET HDR ADDRESS 65400020 MOVEWKB EQU * . 65430020 SR R9,R9 . 65460020 IC R9,CPBUNTCT . 65490020 LA R9,AVTUMALN(R9,R5) . 65520020 SR R11,R11 . CLEAR FOR IC AND ADD 65550020 IC R11,CPBWKACT . ADD WKACT TO 65580020 AR R14,R11 . THE FROM ADDRESS 65610020 CLC CPBTOUNT(1),CPBINWKA . MORE IN UNT THAN WKA 65640020 BNH MOVEUNTA . 65670020 * HERE TO MOVE AMOUNT OF DATA AVAILABLE 65700020 IC R11,CPBINWKA . 65730020 B MOVESET . 65760020 FIXIT EQU * . 65790020 OI SCBSTAT1,PRFNHDRN . INSURE NHDR FOR NEXT TIME 65820020 IC R11,PRFLINK-1 . 65850020 ST R5,PRFLINK-1 . 65880020 STC R11,PRFLINK-1 . 65910020 LR RPRF,R5 . NEW BFR ADDR 65940020 XC PRFLINK(7),PRFLINK . CLEAR LINK AND TIC 65970020 MVI PRFTIC+3,X'02' . 66000020 MVI PRFTIC,CPBTICC . SET TIC OP CODE 66030020 LR R8,R5 . NEW LAST UNIT ADDR 66060020 ST RLCB,PRFLCB-1 . SET LCB ADDR 66090020 MVI PRFNBUNT,X'01' . SET NUMB UNITS 66120020 OI PRFSTAT1,PRFNLSTN . SET NOT LAST SEG 66150020 NC LCBTTCIN(2),LCBTTCIN . IS THIS RETRIEVE S21101 66160021 BNZ NOTRET2 BR NOT RETRIEVE M2321 66170021 TM LCBSTAT2,LCBDIAL IF 0, COULD BE DIAL-IF M2321 66172021 BCR 14,R7 NOT DIAL, THIS IS RETR. M2321 66174021 NOTRET2 EQU * M2321 66176021 TM LCBCHAIN,LCBBFRSZ IS THIS FROM BD SA63623 66177052 BOR R7 BR IF YES A63623 66178052 IC R9,SCBUNTCT . THIS BYTE ADDRESS WITH IN 66180020 STC R9,PRFNTXT . THIS RECORD 66210020 BR R7 . 66240020 NXTUNT EQU * . 66270020 BAL R9,ADDNBUNT . 66300020 MVC CPBTOUNT(1),AVTKEYLE+1 . SET AMT TO MOVE TO UNIT 66330020 BAL R7,LINKTIC . 66360020 LA R14,AVTUMALN(R2) . FROM ADDR +12 66390020 LH R11,PRFSIZE . DATA THERE 66420020 LH R9,LCBERBQB+1 . SIZE NEEDED 66450020 SR R9,R11 . AMT LEFT TO GET 66480020 MVI CPBUNTCT,AVTEZERO . AMOUNT ALREADY IN UNIT =0 66510020 CH R9,AVTKEYLE . THIS UNIT TO BE FILLED 66540020 BH MOVEWKB . BR YES 66570020 STC R9,CPBTOUNT . RESET COUNT TO MOVE 66600020 B MOVEWKB . 66630020 SETMOVE EQU * . 66660020 * HERE IF UNIT HAS A PREFIX AND ONE IS NOT NEEDED - SET 66690020 * TO SKIP OVER THE PREFIX 66720020 TM SCBSTAT1,PRFLOCK . THIS LOCK MODE MSG 66750020 BNO NOLOCK . BR NO 66780020 OI PRFSTAT1,PRFLOCK . SET LOCK IN THIS BFR 66810020 NOLOCK EQU * . 66840020 SR R1,R1 . 66870020 IC R1,DATSCAN+1-IEDQDATA(R2) . IDLES IN BFR 66900020 LA R1,AVTTXTSZ(R1) . + SIZE OF PRFX 66930020 STC R1,CPBWKACT . INTO WKACT FOR AMT MOVED 66960020 IC R11,CPBINWKA . 66990020 SR R11,R1 . SUBTR SIZE OF TXT AND IELES 67020020 STC R11,CPBINWKA . 67050020 CLI CPBUNTCT,AVTEZERO . ANY IN THIS UNIT ALREADY 67080020 BNE MOVEWKB . BR YES 67110020 B MOVUNT2+4 . 67140020 ADDCTS EQU * . 67170020 SR R0,R0 . ADD THE DISABLED CT TO THE 67200020 IC R0,LCBERBCT+1 . 67230020 MVI LCBERBCT+1,AVTEZERO . 67260020 LA R11,AVTE80-1 . SET FOR NR TO CLEAR 67290020 NR R0,R11 . FLAG FROM DISABLED COUNT 67320020 IC R11,LCBERBCT . 67350020 AR R11,R0 . 67380020 STC R11,LCBERBCT . 67410020 ENQERB EQU * . 67440020 BAL R11,FIXDEOB . 67470020 LA R15,LCBERB . ELEM ADDR 67500020 LA R2,AVTNCPBQ . 67530020 BAL R11,ENQMGRB . 67560020 B TAG1 . 67590020 BUFCPB EQU * . 67620020 TM PRFSTAT1,PRFNLSTN . LAST BFR FULL 67650020 BO NOCOMPL . BR NOT LAST BUT FULL 67680020 OI LCBERBST,LCBCOMPL . SET REQ COMPLETE 67710020 NOCOMPL EQU * . 67740020 BAL R14,FULLBUF . 67770020 L RLCB,PRFLCB-1 . 67800020 L RSCB,LCBSCBA-1 . 67830020 TM LCBERBST,XCOMPL . REQ COMPLETE 67860020 BO BFRFULL . 67890020 CLI CPBINWKA,AVTEZERO . ALL WK AREA MOVED 67920020 BE BFNOTFUL . 67950020 B HAVEBUF . 67980020 LASTTEST EQU * . 68010020 IC R1,CPBWKACT . COUNT INTO WORK AREA 68040020 CLI CPBINWKA,AVTEZERO . ALL MOVED 68070020 BNE LASTEST . BR NO 68100020 SR R1,R1 . SET TO 0 68130020 LASTEST EQU * . 68160020 STC R1,SCBUNTCT . RESET UNTCT 68190020 BR R9 . 68220020 SPACE 3 68250020 * THIS SECTION WILL FIND THE LAST UNIT OF THE LAST BUFFER 68280020 * ASSOCIATED WITH THE ERB AND THE AMOUNT OF DATA IN IT. 68310020 SPACE 3 68340020 LAST EQU * . 68370020 L RPRF,LCBERBCH-1 . 68400020 B CKNEXTA . 68430020 CKNEXT EQU * . 68460020 L RPRF,PRFLINK-1 . ADDR NEXT BFR 68490020 CKNEXTA EQU * . 68520020 NC PRFLINK(3),PRFLINK . IS THERE A NEXT BFR 68550020 BNZ CKNEXT . 68580020 TM LCBSTAT1,LCBRCLLN+LCBRECVN . RECALL BFR THERE 68610020 BO DATTEST . BR TO NOT CHANGE BFR SIZE 68640020 TM LCBCHAIN,LCBBFRSZ . IF IT IS SPECIAL RECALL 68670020 BNO LAST1 . BR NOT SPECIAL RECALL 68700020 DATTEST EQU * . 68730020 TM DATFLAGS-IEDQDATA(R2),DATNPRFX . IF A PRFX HAS BEEN 68760020 BCR 14,R14 . READ ASSUME LAST BFR IS FULL 68790020 LAST1 EQU * . 68820020 LR R11,R2 . SAVE R2 68850020 LA R2,((SCBSIZE-IEDQSCB)-(PRFSIZE-IEDQPRF))(R3) . 68880020 * USE LAST SAVED PRFX 68910020 BAL R7,SIZECK . CHECK BFR SIZE 68940020 LR R2,R11 . RESTORE 2 68970020 LH R7,AVTKEYLE . GT KEYLENGTH 69000020 LR R8,RPRF . 69030020 LH R11,PRFSIZE . 69060020 CH R11,LCBERBQB+1 . IS BFR FULL 69090020 BCR EQUAL,R14 . IF YES, RETURN S21101 69120020 LH R1,LCBERBQB+1 . SIZE THERE ALREADY 69150020 BFRUNIT EQU * . 69180020 SR R11,R7 . SIZE THERE - KEY 69210020 SR R1,R7 . SIZE TO GET - KEY 69240020 NC PRFTIC+1-IEDQPRF(2,R8),PRFTIC+1-IEDQPRF(R8) . 69270020 BZ RETURN . BR IF NO NEXT UNIT 69300020 L R8,PRFTIC-IEDQPRF(R8) . NEXT UNIT ADDR 69330020 B BFRUNIT . 69360020 RETURN EQU * . 69390020 LR R5,R8 . SET LAST UNIT ADDR 69420020 LTR R11,R11 . LAST UNIT FULL 69450020 BNM SETUNTCT . BR IF FULL 69480020 AR R11,R7 . ADD FOR AMOUNT THERE 69510020 AR R1,R7 . ADJUST SIZE ALSO 69540020 SETUNTCT EQU * . 69570020 STC R11,CPBUNTCT . SET COUNT ALREADY IN UNT 69600020 CR R1,R7 . IS SIZE LEFT TO MOVE LESS 69630020 BL SUBTREM . THAN KEY -- BR YES 69660020 LR R1,R7 . RESET FOR STC 69690020 SUBTREM EQU * . 69720020 SR R1,R11 . SIZE LEFT - AMT THERE 69750020 STC R1,CPBTOUNT . IS COUNT TO MOVE TO UNIT 69780020 LR R5,R8 . 69810020 B 4(R14) . 69840020 SPACE 3 69870020 * THIS SECTION WILL FREE A CPB IF DISK QUEUEING AND INITIALIZE 69900020 * FOR THE NEXT OPERATION, WAIT FOR THE NEXT CPB IF ONE, OR 69930020 * IF THE REQUEST IS COMPLETE, FREE THE ERB TO WAIT FOR THE 69960020 * NEXT REQUEST. IF CORE QUEUED THE NEXT UNIT OF THE 69990020 * MESSAGE IF FOUND IN THE CORE QUEUE AND INITIALIZED FOR DATA 70020020 * TRANSFER OR IF THE REQUEST IF COMPLETE IT WILL SET UP TO 70050020 * WAIT FOR THE NEXT REQUEST. 70080020 SPACE 3 70110020 * WILL SUBTR 1 FROM CPB COUNT AND GO TO APPQEMTY 70140020 * WILL RETURN 70170020 FREECPBA EQU * . 70200020 IC R1,SCBCPBNO . 70230020 BCTR R1,0 . 70260020 STC R1,SCBCPBNO . 70290020 LTR R2,R2 . TEST FLAG NOT TO UPDATE 70320020 BM NOUNTCT . BR IF NO UPDATE 70350020 BAL R9,LASTTEST . 70380020 NOUNTCT EQU * . 70410020 AIF (&A NE 3).F062 70440020 TM SCBQTYPE,SCBCOREQ . 70470020 BO CORECPB . 70500020 .F062 AIF (&A EQ 1).F063 70530020 IC R1,SCBNXCPB . SAVE HI BYTEM 70560020 LA R1,1(R1) . ADD ONE TO NO. OF NEXT CPB 70590020 STC R1,SCBNXCPB . RESTORE HI BYTE 70620020 LH R1,AVTDSKCT . SUBTR ONE FROM DISK CT 70650020 BCTR R1,0 . 70680020 STH R1,AVTDSKCT . 70710020 LTR R2,R2 . COMPRTEST TO UPDATE FLAG 70740020 BM TESTLAST . BR NO UPDATE 70770020 CLI CPBINWKA,AVTEZERO . ANY DATA LEFT 70800020 BNE TESTLAST . BR YES 70830020 TM DATFLAGS-IEDQDATA(R2),DATNPRFX . HAVE A PRFX 70860020 BNO CKLAST2 . BR YES 70890020 L R9,CPBADDR . ADDR THIS RECORD 70920020 LA R9,INCR(R9) . ADD FOUR S21101 70950020 IC R11,SCBSCSEG-1 . 70980020 ST R9,SCBSCSEG-1 . 71010020 STC R11,SCBSCSEG-1 . 71040020 B TESTLAST . 71070020 CKLAST2 EQU * . 71100020 NC SCBXTRA(3),SCBXTRA . ANY XTRAS 71130020 BZ CKLAST3 . BR NO 71160020 MVC SCBSCSEG(3),SCBXTRA . 71190020 B TESTLAST . 71220020 CKLAST3 EQU * . 71250020 MVC SCBSCSEG(3),SCBNTXT . 71280020 TESTLAST EQU * . 71310020 CLI SCBCPBNO,AVTEZERO . 71340020 BE CPBFREEA . IF 0 RETURN 71370020 B CPBFREE . IF NOT RETURN TO APPQEMTY 71400020 .F063 AIF (&A EQ 2).F064 71430020 CORECPB EQU * . 71460020 NC PRFTIC+1-IEDQPRF(2,R2),PRFTIC+1-IEDQPRF(R2) . 71490020 BZ GETCORE . 71520020 CLI CPBINWKA,AVTEZERO . ANY DATA LEFT 71550020 BNE DEOBSET . BR YES 71580020 MVC SCBSCSEG(3),PRFTIC+1-IEDQPRF(R2) . 71610020 L R2,PRFTIC-IEDQPRF(R2) . 71640020 B DEOBSET . 71670020 GETCORE EQU * . 71700020 CLI CPBINWKA,AVTEZERO . ALL DATA MOVED 71730020 BNE DEOBSET . BR NO 71760020 TM SCBSTAT1,PRFNLSTN . 71790020 BNO SETCPBNA . 71820020 TM LCBSTAT1,LCBINITN . INIT MODE 71850020 BNO MOVENTXT . BR NOT INIT 71880020 NC SCBNTXT(3),SCBNTXT . IS THE BUFFER THERE 71910020 BNZ MOVENTXT . BR YES 71940020 INITERR EQU * . 71970020 OI LCBERBST,LCBRDERR . SET LOGICAL READ ERROR 72000020 LA R14,TAG1 . SET RTN ADDR 72030020 B INITPOST . 72060020 MOVENTXT EQU * . 72090020 MVC SCBSCSEG(3),SCBNTXT . 72120020 L R2,SCBSCSEG-1 . 72150020 DEOBSET EQU * . 72180020 TM LCBERBST,XCOMPL . REQ COMPLETE 72210020 BO SETCPBNO . BR YES 72240020 XC AVTDOUBL(5),AVTDOUBL . CLEAR WORK AREA 72270020 B NEXTCPB1 . 72300020 SETCPBNA EQU * . 72330020 BAL R10,SETEOM . 72360020 SETCPBNO EQU * . 72390020 MVI SCBCPBNO,AVTEZERO . 72420020 BR R14 . 72450020 .F064 ANOP 72480020 * SILL GET SIZE OF BFR THAT IS QUEUED IF FROM BD REQ. 72510020 SIZECK EQU * . 72540020 TM LCBSTAT1,LCBRCLLN+LCBRECVN . 72570020 BO SIZECK1 . 72600020 TM LCBCHAIN,LCBBFRSZ . RECALL FROM BFR DISPOSITION 72630020 BCR NOTONES,R7 . BR NOT BD RECALL S21101 72660020 * WHEN ENTERED HERE FROM 'OFFSET' - THIS ROUTINE HAS NO BASE 72690020 SIZECK1 EQU * . 72720020 LH R8,PRFSIZE-IEDQPRF(R2) . SIZE IN BFR READ 72750020 STH R8,LCBERBQB+1 . SET TO BUILD BFRS SAME SIZE 72780020 SR R10,R10 . AS THE BFR ON THE QUEUE 72810020 BALR R1,0 . 72840020 LA R10,1(R10) . ADD ON E TO COMPUTE NO UNITS 72870020 SH R8,AVTKEYLE . LESS ONE UNIT 72900020 BCR PLUS,R1 . BR IF NOT ALL UNITS S21101 72930020 STH R10,LCBERBQB-1 . SET NO UNITS IN BFR TO RECALL 72960020 BR R7 . RETURN 72990020 ADDNBUNT EQU * . 73020020 IC R11,PRFNBUNT . 73050020 LA R11,1(R11) . 73080020 STC R11,PRFNBUNT . 73110020 B NOSET11 . 73140020 GETBFR EQU * . 73170020 SR R11,R11 . 73200020 NOSET11 EQU * . 73230020 NC AVTBFREB+1(3),AVTBFREB+1 ARE ANY BFRS THERE 73260020 BZ NOBFRS . 73290020 LH R5,AVTAVFCT . SUBTR. ONE FROM AV BF CT 73320020 N R5,AVTCLRHI CLEAR HIGH BYTES @YA07705 73330000 BCTR R5,0 . 73350020 STH R5,AVTAVFCT . 73380020 L R5,AVTBFREB . ADDR OF UNIT 73410020 L R1,PRFLINK-1-IEDQPRF(R5) ADDR OF NEXT UNIT 73440020 ST R1,AVTBFREB . INTO BFR REQ QCB 73470020 CLRBFR EQU * 73500020 XC PRFLINK-1-IEDQPRF(8,R5),PRFLINK-1-IEDQPRF(R5) . 73530020 MVI PRFTIC-IEDQPRF(R5),8 . SET TIC OP CODE 73560020 BR R9 . 73590020 NOBFRS EQU * . 73620020 AIF (&A NE 3).F065 73650020 TM SCBQTYPE,SCBCOREQ . READ FROM CORE 73680020 BO PUTERB . BR YES NO CPB CHAIN 73710020 .F065 AIF (&A EQ 1).F065B 73740020 * SAVE NEEDED REGS FOR RTN ON R9 WHEN BFR IS AVAILABLE 73770020 STM R6,R11,CPBSEKFL . SAVE REGS FOR STATUS A49228 73800022 ST R14,CPBUNUSD . 73830020 MVI CPBSEEK,X'FF' STE FLAG IN ORIG CPB SA52984 73840022 NOBFRQ EQU * SA52984 73850022 L R1,AVTNOBFQ . 73860020 ST R1,CPBNEXTF . 73890020 ST R15,AVTNOBFQ . 73920020 AIF (&A EQ 2).F065C 73950020 B TESTFLAG 73980020 .F065B ANOP 74010020 PUTERB EQU * . 74040020 LTR R11,R11 . 74070020 BZ TESTFLAG . 74100020 BCTR R11,0 . 74130020 STC R11,PRFNBUNT . 74160020 TESTFLAG EQU * . 74190020 .F065C ANOP 74220020 AIF (&A EQ 1).F066 74226022 TM LCBERBST,XXXINQ . IS THE ERB ALREADY IN THE 74232022 BO GOAPQEMT . 74238022 .F066 ANOP 74244022 IC R11,CPBWKACT . RESTORE SCBUNTCT 74250020 STC R11,SCBUNTCT . 74280020 OI LCBERBST,XXXINQ . FLAG ON 74430020 MVC LCBERBLK(3),AVTBFRTB+1 . 74460020 IC R1,LCBERBPY . 74490020 STC R1,LCBERB . 74520020 LA R1,LCBERB . 74550020 MVI LCBERBPY,PRIDSKBF . 74580020 ST R1,AVTBFRTB . 74610020 B TAG1 . 74640020 SPACE 3 74670020 * THIS SECTION DEALS WITH A UNIT POSTED TO CPB CLEANUP AS A 74700020 * RESULT OF AS ERB APPEARING IN THE BUFFER RETURN QUEUE BECAUSE 74730020 * THERE WERE NO UNITS AVAILABLE. 74760020 SPACE 3 74790020 BUFFER EQU * . 74820020 LR R5,R1 . SET NEW UNIT ADDR 74850020 L RLCB,PRFLCB-1-IEDQPRF(R1) . LCB ADDR 74880020 NI LCBERBST,X'FF'-XXXINQ . RESET FLAG 74910020 L RSCB,LCBSCBA-1 . 74940020 IC R1,LCBERB . 74970020 STC R1,LCBERBPY . 75000020 AIF (&A NE 3).F068 75030020 TM SCBQTYPE,SCBCOREQ . READ FROM CORE 75060020 BO SETCPBAD . BR YES TO RECOMPUTE CPB AD 75090020 .F068 AIF (&A EQ 1).F069 75120020 LH R1,AVTAVFCT . DECR. CT. OF AV. UNITS 75150020 N R1,AVTCLRHI CLEAR HIGH BYTES @YA07705 75155000 TM LCBERBST,LCBERROR . IS THERE AN ERROR A44866 75160021 BO NODECR . BR YES, BFR RETURN A44866 75170021 BCTR R1,0 . 75180020 STH R1,AVTAVFCT . 75210020 NODECR EQU * . A44866 75220021 LA RLCB,0(RLCB) . CLEAR HI BYTE 75240020 LA R15,AVTNOBFQ-(CPBNEXTF-IEDQCPB) INITIALIZE FOR LP 75270022 CKCPB EQU * . 75300020 LR R14,R15 . SAVE ADDR LAST CPB 75310022 CKCPBA EQU * SA52984 75320022 L R15,CPBNEXTF-IEDQCPB(R14) . NEXT CPB 75330020 L R2,CPBAERBF . ERB ADDR 75360020 LA R2,0(0,R2) . CLEAR HI BYTE 75390020 CR RLCB,R2 . SAME LCB 75420020 BNE CKCPB . NO, GO CHECK NEXT CPB S22025 75450022 MVC CPBNEXT-IEDQCPB(3,R14),CPBNEXT . REMOVE CPB 75570020 CLI CPBSEEK,X'FF' IS THIS THE ORIG. SA52984 75573022 BE HAVECPB YES-PROCESS SA52984 75576022 LR R6,R14 SAVE ADDR OF CPB PREVUS SA52984*75579022 TO THIS SA52984 75582022 LA R2,AVTDKENQ PUT THIS CPB ON Q SA52984 75585022 BAL R11,ENQMGRC TO BE PROCESSED LATER SA52984 75588022 LR R14,R6 RESTORE ADDR OF PREV SA52984 75591022 B CKCPBA CONTINUE SEARCH SA52984 75594022 HAVECPB EQU * SA52984 75597022 * RESTORE NEEDED REGS FOR RTN ON R9 75600020 L R2,CPBXREAF . UNIT ADDR 75630020 LM R6,R11,CPBSEKFL . RESTORE REGS FOR STATUS A49228 75660022 L R14,CPBUNUSD . 75690020 TM LCBERBST,LCBERROR . LINE ERROR A44866 75695021 BNO CLRBFR . BRANCH IF NOT A44866 75700021 MVC PRFLINK-IEDQPRF(3,R5),AVTBFREB+1 . A44866 75705021 ST R5,AVTBFREB . RETURN BFR JUST GOTTEN A44866 75710021 LTR R11,R11 . IS THI NEW UNIT A SINGLE A49228 75710822 * UNIT BFR OR A SUBSEQUENT UNIT OF THE LAST BFR A49228 75711622 BZ ANYBFRS . BR IF NOT A SUBS. UNIT A49228 75712422 BCTR R11,0 . DECR. NO. UNITS IN LAST A49228 75713222 STC R11,PRFNBUNT . SINCE THIS ONE WAS COUNTEA49228 75714022 B ANYBFRS . RETURN EXTRA BFRS & ERB A44866 75715021 .F069 AIF (&A EQ 2).F070 75750020 SETCPBAD EQU * . 75780020 * AND START OVER FOR THIS CPB 75810020 MVC PRFLINK-IEDQPRF(3,R5),AVTBFREB+1 . 75840020 ST R5,AVTBFREB . REPLACE BFR IN THE POOL 75870020 LA R15,AVTDOUBL-(CPBINWKA-IEDQCPB) SET DOUBL AS CPB S22025 75900022 * WORK AREA S22025 75910022 L R2,SCBSCSEG-1 . SET 2 TO UNIT ADDR 75930020 CLM R2,AD,PRFCORE-IEDQPRF(R2) BFR STILL IN CORE Q @OX20639 75940086 BNE RDERROR NO, BRANCH @OX20639 75950086 XC AVTDOUBL(6),AVTDOUBL . 75960020 TM LCBERBST,LCBERROR . LINE ERROR A44866 75966021 BNO NEXTCPB1 . BRANCH IF NOT A44866 75972021 L RBASE,BASE1 . RESET BASE A44866 75978021 B ERBERROR-CPBINIT(RBASE) . RETURN BUFFERS & ERB A44866 75984021 SPACE 3 76020020 * THIS SECTION DETERMINES WHAT TO DO WITH A BUFFER THAT IS FULL 76050020 SPACE 3 76080020 .F070 ANOP 76110020 FULLBUF EQU * . 76140020 IC R1,LCBERBCT . 76170020 BCTR R1,0 . 76200020 STC R1,LCBERBCT . RESET ENABLED CT -1 76230020 OI LCBERBCT+1,XXCTUSED . FLAG DIABLED CT 76260020 IC R11,LCBERBCT+1 . GET DISABLED CT 76290020 MVI LCBERBCT+1,AVTEZERO . ZERO THE COUNT 76320020 IC R1,LCBERBCT . GET NEW ENABLED CT 76350020 AR R1,R11 . ADD COUNTS 76380020 STC R1,LCBERBCT . 76410020 NI LCBERBCT,X'FF'-XXCTUSED . FLAG OFF 76440020 CLI LCBERBCT,AVTEZERO . 76470020 BNE RTNPRI . BR NO 76500020 OI LCBERBST,XCOMPL . SET REQ COMPLETE 76530020 RTNPRI EQU * . 76560020 BAL R9,LASTTEST . SET UP SCBUNTCT 76590020 TM SCBQTYPE,SCBCONC . CONC S22026 76593022 BZ NOTCONCB . BRANCH IF NO S22026 76596022 L RSCB,LCBSCBDA-1 . LINE SCB ADDR S22026 76599022 TM SCBSTAT1,SCBCBGN . CONC MSG BEGIN S22026 76602022 L RSCB,LCBSCBA-1 . RESET SCB ADDR S22026 76605022 BZ CONCMID . BRANCH IF NO S22026 76608022 BR R14 . BRANCH S22026 76611022 NOTCONCB EQU * . S22026 76614022 CLI LCBERBPY,PRIINTRQ . INIT REQ 76620020 BCR EQUAL,R14 . BR YES S21101 76650020 CONCMID EQU * . S22026 76660022 CLI LCBERBPY,PRIAPERB . APPLICATION ERB 76680020 BCR EQUAL,R14 . BR YES S21101 76710020 TM LCBSTAT1,LCBRCLLN . IS THIS RECALL 76740020 BCR ONES,R14 . BR YES -DON'T POST TO MH S21101 76770020 L R1,LCBERBCH-1 . BFR ADDR FORNPOST 76800020 MVC LCBERBCH(3),PRFLINK-IEDQPRF(R1) . DECHAIN BFR 76830020 MVI PRFPRI-IEDQPRF(R1),PRIMHBFR . 76860020 L RDCB,LCBDCBPT . 76890020 MVC PRFQCBA-IEDQPRF(3,R1),DCBMH . SET QCB ADDR FOR MH 76920020 CLI LCBFLAG1,LCBPLCB THIS A PLCB @YM06085 76927000 BNE NOSTORE BR NO, HAVE PROPER MH @YM06085 76934000 MVC PRFQCBA-IEDQPRF(3,R1),LCBMHA GET PROPER MH QCB @YM06085 76941000 B NOSTORE . 76950020 MOVE MVC 0(0,R9),0(R14) . 76957000 BASE1 DC A(CPBINIT) . 76964000 XMASK DC X'000000FF' . 76971000 AIF (&A NE 3).F071 76980020 SPACE 3 77010020 * THIS SECTION INITIALIZES THE CPB ADDRESS AND BUFFER SIZE 77040020 * FOR A CORE QUEUED OPERATION. 77070020 SPACE 3 77100020 RESETA EQU * . 77130020 MVC SCBSCHDR(3),AVTDOUBL+1 . 77160020 MVC SCBSCSEG(3),SCBSCHDR . 77190020 .F071 AIF (&A EQ 2).F072 77220020 CALLFQA EQU * . 77250020 L R2,SCBSCSEG-1 . 77280020 L RPRF,SCBSCHDR-1 . 77310020 TM LCBSTAT1,LCBRCLLN . RECALL 77320021 BNO SETCPB . BR NO 77330021 ST R6,AVTDOUBL . SET BFR ADDR 77332021 CLC AVTDOUBL+1(3),PRFCORE . 77334021 * IS THIS BFR STILL IN THE CORE QUEUE 77336021 BE SETCPB . BR YES 77338021 LA R5,ERBRCQCB . SET RTN ADDR 77338421 B FREEBFRS . RETURN 0 TP BD 77338821 SETCPB EQU * . 77339221 BALR R7,0 TO EXTEND BASE @Y17XA0Z 77339400 USING *,R7 TELL ASSEMBLER @Y17XA0Z 77339600 LA R7,HAVESIZE . SET RTN 77340020 DROP R7 DROP EXTENDED BASE @Y17XA0Z 77350000 CLI LCBERBKY,AVTEZERO . SIZE THERE 77370020 BCR EQUAL,R7 . BR IF EQUAL TO SIZE THERES21101 77400020 TM PRFSTAT1,PRFNHDRN . THIS A HDR 77430020 BNO OFFSET . 77460020 L RPREFIX,PRFCHDR . GET ADDR OF HDR 77490020 SRL RPREFIX,8 . SHIFT OUT LOW BYTE 77520020 B OFFSET . 77550020 HAVESIZE EQU * . 77580020 XC AVTDOUBL(7),AVTDOUBL . CLEAR FOR WORK AREA 77880020 LA R15,AVTDOUBL-(CPBINWKA-IEDQCPB) SET DOUBL AS CPB S22025 77910022 * WORK AREA S22025 77950022 IC R9,LCBERBQB . 78000020 * THE NO OF UNITS PER BUFFER WILL BE IN ERBQB 78030020 IC R8,LCBERBCT . 78060020 MR R8,R8 . 78090020 STC R9,SCBCPBNO . 78120020 B NEXTCPB1 . BR TO PROCESS THIS BFR UNIT 78150020 .F072 ANOP 78180020 THREE EQU 3 LENGTH @OX20639 78230086 AIF (&A EQ 2).F077 78300020 SPACE 3 78330020 * THIS SECTION WILL FREE A MESSAGE FROM THE CORE QUEUE AND 78360020 * UPDATE THE MSUNIT COUNT. 78390020 SPACE 3 78420020 FREEMSG EQU * . 78450020 DROP 12 . 78480020 USING *,R15 . 78510020 MVC AVTDOUBL+1(3),PRFCHDR . GET ADDR OF CORE UNIT THIS 78540020 TM PRFSTAT1,PRFNHDRN . 78570020 BO USECHDR . 78600020 MVC AVTDOUBL+1(3),PRFCORE . 78630020 USECHDR EQU * . 78660020 L R2,AVTDOUBL . MSG HDR CAME FROM 78690020 HAVEADDR EQU * SA68051 78700054 LA R2,0(,R2) . CLEAR HIGH ORDER BYTE 78720020 * THE MSG MUST BE REMOVED FROM THE HDR CHAIN 78750020 * R6 DOES NOT HAVE A BFR ADDR, R2 HAS THE HDR ADDR OF MSG 78810020 L R10,AVTCADDR . NO. OF CORE UNITS IN USE 78840020 LR R8,R9 . 78870020 DROP RPREFIX . 78900020 USING PRFSUNIT,R8 . 78930020 * SET BASE SO THAT QCBCFHDR WILL COINCIDE WILH 78960020 * PRFNHDR 78990020 LA R8,((QCBCFHDR-IEDQPQCB)-(PRFNHDR-PRFSUNIT))(R8) . 79020020 COMPARE1 EQU * . 79140020 CLC PRFNHDR(3),PRFCORE-IEDQPRF(R2) . 79170020 * IS THIS THE MSG TO REMOVE 79200020 BE TAKEOUT . BR UES 79230020 LNR R2,R2 . SET FLAG FOR RTN HERE 79260020 NC PRFNHDR(3),PRFNHDR . IS THIS THE LAST ONE 79290020 BCR ZERO,R7 . BR YES - MSG NOT THERE S21101 79320020 LPR R2,R2 . RESET FLAG FOR NO RTN 79350020 MVC AVTDOUBL+5(3),PRFNHDR . ADDR OF NEXT MSG 79380020 L R8,AVTDOUBL+4 . 79410020 LA R8,PRFSUNIT-IEDQPRF(R8) .SET BASE FOR USIGN 79440020 B COMPARE1 . 79470020 TAKEOUT EQU * . 79500020 MVC PRFNHDR(3),PRFNHDR-IEDQPRF(R2) . 79530020 * LINK NHDR OF THIS MSG SA51078 79560022 * INTO NHDR OF PREV ONE SA51078 79660022 DROP R8 . 79830020 USING IEDQPRF,RPREFIX . 79860020 LR R8,R6 . SET 8 FOR MOVE 79890020 TM PRFSTAT1,PRFNHDRN . IS THIS A HDR 79920020 BNO MVCCRCD . BR IF HDR TO SET CRCD TO 79950020 * DISK HDR ADDRESS 79980020 LA R8,PRFCHDR-PRFCRCD(R8) . IF NOT HDR SET TO UPDATE 80010020 * THE CHDR FIELD TO THE REAL ADDRESS OF THE DISK HDR 80040020 MVCCRCD EQU * . 80070020 MVC PRFCRCD-IEDQPRF(3,R8),PRFCRCD-IEDQPRF(R2) . 80100020 * UPDATE TO THE PROPER DISK ADDRESS OF THE HDR TO WRITE 80130020 * THE SERVICED FLAG 80160020 TM DATFLAGS,DATLOSTN+DATINITL . THIS MSG LOST 80190020 BM LOSTMSG . BR IF LOST BUT NOT INIT 80220020 * TO FREE 1 UNIT 80250020 TM PRFSTAT1-IEDQPRF(R2),PRFDUPLN . 80280020 * IS THIS A DUPL HDR 80310020 BNO ALLDUPL . BR YES 80340020 * WHEN IN CORE QUEUES DUPL HDRS ARE COUNTED IN FIRST TIC 80370020 CLI PRFNBUNT-IEDQPRF(R2),EONE . ONLY 1 UNIT IN BFR 80400020 BH GETTIC . BR MORE THAN 1 80430020 MVC AVTDOUBL+5(3),PRFNTXT-IEDQPRF(R2) . 80460020 L R14,AVTDOUBL+4 . ADDR NEXT BFR 80490020 B GETDUPCT . 80520020 GETTIC EQU * . 80550020 L R14,PRFTIC-IEDQPRF(R2) . ADDR NEXT UNIT 80580020 GETDUPCT EQU * . 80610020 LA R14,0(R14) . CLEAR HI BYTE 80640020 LTR R14,R14 . MORE BUFFERS FOR THIS DUPL 80670020 BZ LOSTMSG . BR NO TO FREE 1 UNIT 80700020 * THERE IS NO COUNT TO UPDATE IN THIS CASE 80730020 SR R11,R11 . 80760020 IC R11,PRFTIC-IEDQPRF(R14) .NUMBER OF DUPL HDRS 80790020 LTR R11,R11 . 80820020 BZ ALLDUPL . BR IF NONE LEFT 80850020 BCTR R11,0 . DECR COUNT 80880020 STC R11,PRFTIC-IEDQPRF(R14) .RESTORE 80910020 LOSTMSG EQU * . 80940020 XC PRFTIC+1-IEDQPRF(3,R2),PRFTIC+1-IEDQPRF(R2) . 80970020 MVI PRFNBUNT-IEDQPRF(R2),EONE . SET TO 1 UNIT 81000020 LR R1,R2 . POST FREED UNIT 81030020 LA R2,AVTBFRTB . 81060020 OI PRFCORE+2-IEDQPRF(R1),EONE . SET ADDR BAD 81090020 MVI PRFPRI-IEDQPRF(R1),PRIBFRTB . 81120020 ST R7,AVTDOUBL+4 . SAVE RETURN ADDR 81150020 L R7,ADRTNBFR . 81180020 BAL R14,POST-RTNBFR(R7) . 81210020 L R7,AVTDOUBL+4 . RESTORE RETURN ADDR 81240020 BCTR R10,R0 . 81270020 CKCMIN EQU * . 81300020 ST R10,AVTCADDR . RESTORE CADDR 81330020 CL R10,AVTCMIN . HAS THE NO. OF CORE UNITS 81360020 BNL CKCMAX . REACHED THE MINIMUN BR NO 81390020 OI AVTSYSER,AVTCMINN . SET FLAG FOR MIN 81420020 CKCMAX EQU * . 81480020 CL R10,AVTCMAX . HAS CADDR BECOME LOWER 81510020 BCR 10,R7 . BR NO 81540020 NI AVTSYSER,AVTCMAXF . MAX OFF 81570020 NI AVTBIT3,AVTRECVF . SET REV SWITCH ON 81600020 BR R7 . RETURN 81630020 ALLDUPL EQU * . 81660020 LA R5,1(R5) . RESET NO. OF UNITS 81690020 ST R7,AVTDOUBL+4 . SAVE RTN ADDR 81720020 SR R8,R8 . 81750020 SETBFR EQU * . 81780020 L R1,AVTDOUBL . BFR ADDRESS 81810020 OI PRFCORE+2-IEDQPRF(R1),EONE . SET BAD ADDR 81840020 IC R8,PRFNBUNT-IEDQPRF(R1) . NO UNITX 81870020 L R7,ADRTNBFR . 81900020 BALR R14,R7 . 81930020 SR R10,R8 . SUBTRACT NO IN THIS BFR 81960020 L R1,AVTDOUBL . FROM CADDR 81990020 BAL R7,CKCMIN . 82020020 L R7,AVTDOUBL+4 . RTN ADDR 82050020 TM PRFSTAT1-IEDQPRF(R1),PRFNLSTN . 82080020 BCR ZERO,R7 . S21101 82110020 * IF THE LAST BFR WAS THE LAST SEGMENT RETURN 82140020 NC PRFNTXT-IEDQPRF(3,R1),PRFNTXT-IEDQPRF(R1) . 82170020 BCR ZERO,R7 . BR IF NO NTXT S21101 82200020 MVC AVTDOUBL+1(3),PRFNTXT-IEDQPRF(R1) . 82230020 * ADDR OF NEXT TXT BFR 82260020 B SETBFR . 82290020 ADRTNBFR DC A(RTNBFR) . 82320020 DROP 15 . 82350020 USING IEDQCPB,R15 . 82380020 .F077 ANOP 82410020 SPACE 3 82440020 * WILL GET THE BUFFER SIZE FROM THE TERMINAL TABLE OR DCB 82470020 * FOR BUILDING THE BUFFERS. 82500020 SPACE 3 82530020 USING *,15 . 82560020 OFFSETA EQU * . 82590020 TM LCBSTAT1,LCBSENDN . SEND OPERATION A42363 82620021 BO OFFSET1 . BR YES A42363 82630021 TM LCBSTAT1,LCBRCLLN . THIS A RECALL A42363 82640021 BNO OFFSET1 . BR NOT RECALL A42363 82650021 * THIS CODE TO EXECUTE ONLY IF RECEIVE RECALL - TEST FOR A42363 82660021 * RCV AND RCLL WILL CAUSE RETRIEVE TO PROGRAM CK A42363 82670021 L R1,ADRSZCK1 . 82680020 TM LCBCHAIN,LCBBFRSZ . SPECIAL RECALL 82710020 BCR ONES,R1 . S21101 82740020 OFFSET1 EQU * . 82770020 LH R1,PRFDEST . 82800020 TM PRFSTAT1,PRFNHDRN . IS THIS A HDR 82830020 BNO TERMENTR . BR YES 82860020 * IF NOT A HDR DOES NOT CONTAIN THE DEST OFFSET 82890020 USELCBA EQU * . 82920020 LH R1,LCBTTCIN . DEST OFFSET 82950020 TERMENTR EQU * . 82980020 N R1,AVTCLRHI . 83010020 LTR R1,R1 . IS TTCIN 0 - TTCIN IS THE ONLY 83040020 * ONE OF THE FIELDS PICKED UP THAT CAN BE 0 83070020 BNZ TTCINOK . BR IF NOT 0 - THIS ISNOT 83100020 * RETRIEVE 83130020 TM LCBSTAT2,LCBDIAL IS THIS DIAL LCB M2321 83140021 BO TTCINOK YES,BRANCH -NOT RETRIEVE M2321 83150021 MVC LCBERBQB+1(2),AVTKEYLE . IF RETRIEVE - SET TO BUILD 83160020 MVI LCBERBQB,X'01' . SINGLE UNIT BFRS 83190020 MVI LCBERB,X'00' . 83220020 BR R7 . RETURN 83250020 TTCINOK EQU * . 83280020 L R15,AVTRNMPT . 83310020 BALR R14,R15 . 83340020 * TERM TABLE ENTRY ADDRESS IS IN R1, IF BUFFER SIZE IS 83370020 * SPECIFIED IN T TABLE, PUT IT IN LCBERBQP+1, IF NOT 83400020 * USE DCBBFSZE. 83430020 USING *,15 . 83460020 LR R15,R14 . RESET ADDRESSIBILITY 83490020 USING IEDQTRM,R1 . 83520020 TM TRMDEVFL,X'80' . IS A BFR SZ SPECIFIED 83550020 BNO USEDCBA . 83580020 * IF FROM T TABLE 83610020 SR R10,R10 . ZERO REG 83640020 LA R14,TRMOPNO+1 . LOC OF BFR SZ IF NO OPT 83670020 TM TRMSTATE,TRMOPTFN . ARE OP. SPECIFIED 83700020 BNO NONE . BR NO 83730020 LR R14,R10 . ZERO 14 83760020 IC R14,TRMOPNO . NO OF OPT FIELDS 83790020 LA R14,TRMOPT+1(R14) . ADDR OF OPT FIELDS + 1 + NO 83820020 * OF OPT FIELDS GIVES THE LOCATION OF BFR SIZE 83850020 DROP R1 . 83880020 NONE EQU * . 83910020 MVC LCBERBQB+1(2),0(R14) . SET ERBQB 83940020 LH R1,LCBERBQB+1 . 83970020 L R11,ADSBTR . 84000020 BALR R14,R11 . 84030020 SRL R10,DIV4 . ADJUST R10 S21101 84040020 B SIZEDONE . 84060020 USEDCBA EQU * . 84090020 L RDCB,LCBDCBPT . DCB ADDR 84120020 LH R1,DCBBFSZE . SET SIZE AND NUMBER OF 84150020 STH R1,LCBERBQB+1 . UNITS IN BFR IN 84180020 IC R10,DCBUNTCT . ERBQB AND ERBQB+1 84210020 SIZEDONE EQU * . 84240020 STC R10,LCBERBQB . 84270020 MVI LCBERBKY,AVTEZERO . SET SIZE THERE FLAG 84300020 BR R7 . 84330020 ADSBTR DC A(SUBTRKEY) . 84360020 ADRSZCK1 DC A(SIZECK1) . 84390020 USING IEDQCPB,R15 . 84420020 * WILL ENQUEUE AN ELEMENT ( BFR ,ERB, OR CPB) ON A FIFO Q 84450020 ENQMGRBA EQU * . 84480020 USING ENQMGRBA,R14 84490006 * INPUT PARAMETERS - R2 - Q ADDR, R15 - ELEM ADDR 84510020 * R14 - BASE REG R1 - SCRATCH REG ½ 15 WILL BE KEPT 84540020 XC PRFLINK-IEDQPRF(3,R15),PRFLINK-IEDQPRF(R15) . 84570020 * CLEAR LINK FIELD OF BFR OR ERB 84600020 LTR R2,R2 . SET POSITIVE COND CODE 84630020 BAL R14,NOMPCK SKIP TS INSTRUCTION Y02027 84660006 AIF (&A EQ 1).F023 84690020 ENQMGRCA EQU * . 84720020 * WHEN ENTERED HERE THE HI BYTE OF 14 IS 0 84750020 .F023 ANOP 84780020 USING *,R14 . 84810020 MPLOOP EQU * Y02027 84813006 TS AVTEZERO(R2) LOCK Q FOR UPDATE Y02027 84817006 BNE MPLOOP YES, LOOP TILL APP. DONE Y02027 84824006 NOMPCK EQU * Y02027 84831006 L R1,4(R2) . ADDR LASR ON Q 84840020 LA R1,PRFLINK-IEDQPRF(R1) . SET ADDR OF LINK FIELD 84870020 AIF (&A EQ 1).F024 84900020 SPM R14 . RESET COND CODE 84930020 BP ENQBFR . BR IF A BFR OR ERB 84960020 LA R1,((CPBNEXT-IEDQCPB)-(PRFLINK-IEDQPRF))(R1) . 84990020 * IF IT WAS A CPB CORRECT THE ADDR OF LINK FIELD 85020020 XC CPBNEXT(3),CPBNEXT . ZERO CPB LINK FIELD 85050020 .F024 ANOP 85080020 ENQBFR EQU * . 85110020 ST R15,4(R2) . SET NEW LAST ELEM 85140020 NC 1(3,R2),1(R2) . IS ONE ON THE Q 85170020 BNZ ENQNMTY . BR IF YES 85200020 MVC 1(3,R2),5(R2) . IF NOT SET ADDR OF FIRST 85230020 MVI AVTEZERO(R2),AVTEZERO CLEAR Q LOCK Y02027 85240006 BR R11 . RETURN 85260020 ENQNMTY EQU * . 85290020 MVC 0(3,R1),5(R2) . LINK THIS ONE TO PREVIOUS 85320020 MVI AVTEZERO(R2),AVTEZERO CLEAR Q LOCK Y02027 85330006 BR R11 . LAST ONE AND RETURN 85350020 TITLE '''IEDQFA'' - DSECTS' . S22025 85380022 * TPRIOR 85410020 TPRIOR 85440020 EJECT , . S22025 85470022 * DCBD 85500020 DCBD DSORG=TX . 85530020 DCBBFSZE EQU DCBBUFSI . 85560020 EJECT , . S22025 85590022 * TDISPD 85620020 TDISPD 85650020 EJECT , . S22025 85680022 * TCPBD 3330 S21101 85710021 TCPBD 3330 S21101 85720021 EJECT , . S22025 85770022 * TDATD 85800020 TDATAD 85830020 EJECT , . S22025 85860022 * TSCBD 85890020 TSCBD 85920020 XFEFO EQU SCBFEFO . 85950020 SCBSQOUT EQU SCBCLSEG+1-IEDQSCB . 86010020 EJECT , . S22025 86040022 * TQCBD 86070020 TQCBED . QCBE DSECT S22026 86080022 TQCBD 86100020 EJECT , . S22025 86130022 * TPRFD 86160020 TPRFD 86190020 EJECT , . S22025 86220022 * TLCBD 86250020 TLCBD 86280020 LCBNSRCD EQU X'01' . IN-SOURCE CHAIN FLAG S22025 86310022 EJECT , . S22025 86320022 * TTRMD 86340020 TTRMD 86370020 EJECT , . S22025 86400022 * TAVTD , . S22025 86430022 TAVTD , . S22025 86460022 TTSID S22028 86470022 MEND 86490020