|
DataMuseum.dkPresents historical artifacts from the history of: IBM System/3 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about IBM System/3 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 22606 (0x584e)
Types: s3xseg
Names: »S$E055«
└─⟦827b5bd03⟧ Bits:30009184 5702-sc1.V16.ccp
└─⟦f17e99db6⟧
└─⟦this⟧ »S$E055«
MACRO 00010000
$E055 00020000
GBLB &SHR 00030000
GBLB &D45 5445 DISK SUPPORT 00040000
LCLC &# 00050000
TEXT 00060000
AIF (&SHR).SHROK 00070000
MEXIT 00080000
.SHROK ANOP 00090000
&# SETC ' ' 00100000
TITLE 'FILE&#.SHARING&#.ENQUEUE-DEQUEUE&#.ROUTINE&#.-&#.$CC4DI' 00110000
* BEGIN MACRO '$E055' 3/16/73 00120000
*********************************************************************** 00130000
* * 00140000
* TITLE * 00150000
* . FILE SHARING ENQUEUE-DEQUEUE ROUTINE * 00160000
* * 00170000
* NAME * 00180000
* . $CC4DI * 00190000
* * 00200000
* LEVEL * 00210000
* . VERSION 8 MOD LEVEL 0 OF 5702-SC1 * 00220000
* * 00230000
* FUNCTION * 00240000
* . ALLOW FILE SHARING IN UPDATE MODE AMONG THE USER PROGRAMS * 00250000
* WHILE MAINTAINING FILE INTEGRITY. * 00260000
* . ALLOW SEVERAL PROGRAMS TO ACCESS ADDED RECORDS IN INDEXED * 00270000
* FILES CONCURRENTLY WHILE INSURING THAT ONLY ONE DTF IS * 00280000
* ACTUALLY ADDING AT ANY TIME. * 00290000
* * 00300000
* OPERATION * 00310000
* . $CC4DI COMPRISES THREE ROUTINES: * 00320000
* 1. $CC4DI - IOB ENQUEUE-DEQUEUE ROUTINE * 00330000
* 2. $CC4RQ - SQB RELEASE ROUTINE * 00340000
* 3. $CC4AO - ADDER VALIDITY CHECK ROUTINE * 00350000
* * 00360000
* . AT ENTRY TO $CC4DI, INTERCEPTED DISK I/O REQUESTS ARE * 00370000
* EXAMINED. IF THE REQUEST IS A READ AND THE DTF IS OPENED * 00380000
* FOR UPDATE, THEIOB IS ADDED AT THE END OF A QUEUE OF IOB'S * 00390000
* AWAITING ENQUEUED DATA SECTORS, THE SQB OWNED BY THE IOB * 00400000
* (IF ANY) IS LOCATED AND THE SQB RELEASE ROUTINE IS * 00410000
* ENTERED. IF THE REQUEST IS NOT TO READ, OR THE DTF IS NOT * 00420000
* OPENED FOR UPDATE, THE ADDER VALIDITY CHECK ROUTINE IS * 00430000
* ENTERED. * 00440000
* * 00450000
* . THE SQB RELEASE ROUTINE WILL FIRST FREE THE INPUT SQB, THEN * 00460000
* EXAMINE THE IOB QUEUE FOR I/O REQUESTS WHICH MAY NOW BE * 00470000
* HONORED. THE DISK ADDRESS AND N-BYTE OF THE QUEUED IOB * 00480000
* IS COMPARED TO THE DISK ADDRESSES IN EACH ACTIVE SQB FOR * 00490000
* CONFLICT. IF THERE IS NO CONFLICT, THE IOB MAY BE FREED, * 00500000
* AND AN SQB IS BUILT TO REFLECT THE DATA EXTENT OF THE I/O * 00510000
* REQUEST. THE TASK WHICH OWNED THE FREED IOB IS POSTED OUT * 00520000
* OF THE WAIT. ALL IOBS ON THE QUEUE ARE THUS EXAMINED. IF * 00530000
* A QUEUED IOB WHICH CANNOT BE FREED BELONGS TO THE CURRENT * 00540000
* TASK, THE CCP WAIT ROUTINE ($CC4WT) WILL BE INVOKED TO * 00550000
* CAUSE THE CURRENT TASK TO WAIT. * 00560000
* * 00570000
* . THE ADDER VALIDITY CHECK ROUTINE TESTS THE I/O REQUEST TO * 00580000
* DETERMINE IF IT IS AN ADD. IF SO, THE SDF FOR THE FILE IS * 00590000
* LOCATED AND TESTED TO SEE IF THE TASK IS ALLOWED TO ADD. * 00600000
* IF SO, AND NO OTHER DTF IS CURRENTLY ADDING, THE DTF ADDRESS * 00610000
* IS STORED IN THE SDF AND BECOMES THE CURRENT ADDER. * 00620000
* OTHERWISE, THE RESIDENT TERMINATION ROUTINE IS INVOKED * 00630000
* TO TERMINATE THE TASK. * 00640000
* * 00650000
* ENTRY POINTS * 00660000
* . $CC4DI - IOB ENQUE ROUTINE * 00670000
* . $CC4RQ - SQB RELEASE ROUTINE * 00680000
* . RQDPFR - DISK WAIT INTERCEPT ENTRY TO SQB RELEASE * 00690000
* * 00700000
* INPUT * 00710000
* * 00720000
* . XR1 CONTAINING IOB ADDRESS - INPUT TO $CC4DI * 00730000
* . XR2 CONTAINING SQB ADDRESS - INPUT TO SQB RELEASE * 00740000
* OUTPUT * 00750000
* . IOB FIELDS IOBCHN AND IOBTCB MODIFIED FOR QUEUED IOB * 00760000
* . SQB BUILT OR FREED * 00770000
* * 00780000
* EXTERNAL REFERENCES * 00790000
* . CCPSAV - SAVE REGISTERS ROUTINE * 00800000
* . CCPRET - RETURN ROUTINE * 00810000
* . $CC4WT - WAIT ROUTINE * 00820000
* . CC4TI2 - RESIDENT TERMINATION ROUTINE * 00830000
* * 00840000
* EXITS, NORMAL * 00850000
* . RETURN TO CALLER VIA CCPRET * 00860000
* . RETURN TO DISK WAIT INTERCEPT VIA ARR * 00870000
* * 00880000
* EXITS, ERROR * 00890000
* . CC4TI2 - TO TERMINATE AN INVALID ADDER * 00900000
* * 00910000
* TABLES * 00920000
* . $CCCOM * 00930000
* . IOB * 00940000
* . DTF * 00950000
* . SQB * 00960000
* . SDF * 00970000
* * 00980000
* ATTRIBUTES * 00990000
* . RESIDENT * 01000000
* . REUSEABLE * 01010000
* * 01020000
*********************************************************************** 01030000
SPACE 2 01040000
*------EQUATES DEFINED WITHIN THIS MODULE-----------------------------* 01050000
SPACE 2 01060000
DTFCHA EQU 5 OPEN DTF CHAIN POINTER 01070000
DTFOPC EQU 15 DTF OP CODE FIELD 01080000
DTFUPD EQU X'02' DTF ATTRIBUTE FOR UPDATE 01090000
DTFOPU EQU X'20' DTF OP-CODE FOR UPDATE 01100000
DTFOPA EQU X'40' DTF OP-CODE FOR ADD 01110000
DTFOPR EQU X'80' DTF OP CODE FOR READ 01120000
SPACE 1 01130000
DFNDTF EQU 1 SHORT DTF CHAIN FIELD 01140000
DFCHN EQU 3 ORIGIN OF OPEN DTF CHAIN 01150000
DFADD EQU 13 VALID ADD INDICATORS 01160000
DFADTF EQU 21 @ OF CURRENT ADDING DTF 01170000
SPACE 1 01180000
*------REGISTER EQUATES FOR SQB SEARCH ROUTINE------------------------* 01190000
SPACE 1 01200000
DIOLD EQU XR2 INDEX REG FOR OWNING IOB 01210000
DINEW EQU XR1 INDEX REG FOR WANTING IOB 01220000
CSREG EQU XR2 C/S TABLE REGISTER 01230000
EJECT 01240000
*---------------------------------------------------------------------* 01250000
* BEGINNING OF $CC4DI - SQB ENQ/DEQ ROUTINE * 01260000
*---------------------------------------------------------------------* 01270000
SPACE 2 01280000
$CC4DI ST CCARR,ARR SAVE THE INVOKER'S ARR 01290000
B CCPSAV SAVE INPUT REGISTERS 01300000
SPACE 1 01310000
CLC IOBDTF(2,XR1),CCXR2 IS THIS AN INDEX IOB ? 01320000
BNE $CC4AO YES, FORGET ENQ/DEQ 01330000
CLI $CCCOM+#MAXUS,X'01' IS THIS A MULTI-TASKING RUN ? 01340000
BE $CC4AO NO, FORGET ENQ/DEQ 01350000
SPACE 1 01360000
L IOBDTF(,XR1),XR2 GET IOB DTF @ VALUE 01370000
SPACE 1 01380000
*------ DETERMINE IF THIS IS AN UPDATE DTF DOING A READ --------------* 01390000
SPACE 1 01400000
SPACE 1 01410000
TBN DTFATR-1(,XR2),DTFUPD IS THIS AN UPDATE DTF? 01420000
TBN IOBQB(,XR1),READ IS THIS A READ OPERATION? 01430000
BF $CC4AO NOT UPDATE AND READ, EXIT TO 01440000
* ADDER VALIDITY CHECK ROUTINE 01450000
EJECT 01460000
*---------------------------------------------------------------------* 01470000
* QUEUE THE IOB ONTO THE DISK IOB QUEUE, CLEAR ANY EXISTING SQB * 01480000
* FOR THE READ IOB, AND GO BUILD ANOTHER SQB FOR THE NEW READ * 01490000
* OPERATION IN THE CCP RELEASE SQB ROUTINE * 01500000
*---------------------------------------------------------------------* 01510000
SPACE 1 01520000
LA DIIOBQ,XR2 GET THE @ OF THE IOB QUE PTR 01530000
SPACE 1 01540000
DICKIQ CLC IOBCHN(2,XR2),CC0000 ANY IOB'S IN THE PENDING QUE? 01550000
JE DIQIT NO, GO QUEUE THE NEW IOB 01560000
SPACE 1 01570000
*------ARE IOB'S IN QUEUE, GO TO END OF QUEUE-------------------------* 01580000
SPACE 1 01590000
L IOBCHN(,XR2),XR2 GET @ OF NEXT IOB AND SEE IF 01600000
* THERE ARE MORE 01610000
B DICKIQ SEE IF MORE IOB'S ARE QUEUED 01620000
SPACE 2 01630000
*------END OF QUEUE REACHED, PUT THIS IOB ONTO THE BOTTOM-------------* 01640000
SPACE 1 01650000
DIQIT ST IOBCHN(,XR2),XR1 QUEUE THE CURRENT IOB OFF OF THE 01660000
* LAST ONE IN THE QUEUE 01670000
SLC IOBCHN(2,XR1),IOBCHN(,XR1) MAKE THE CURRENT IOB THE LAST 01680000
LA $CCCOM,XR2 GET @ OF C.C.P. COMM. AREA 01690000
SPACE 1 01700000
*------SAVE THE @ OF THE CURRENT TASK IN THE QUEUED IOB---------------* 01710000
SPACE 1 01720000
MVC IOBTCB(2,XR1),@CURTB(,XR2) SET THE @ OF THE TCB WHICH THIS 01730000
* IOB BELONGS TO 01740000
SPACE 1 01750000
*---------------------------------------------------------------------* 01760000
* FREE ANY SQB THAT MIGHT BE ASSOCIATED WITH THIS IOB * 01770000
*---------------------------------------------------------------------* 01780000
SPACE 1 01790000
L @SQB(,XR2),XR2 GET @ OF SQB LIST START 01800000
SPACE 1 01810000
DICLC1 CLC SQBIOB(2,XR2),CCXR1 DOES THIS SQB 'BELONG' TO THE 01820000
* CURRENTLY INPUT IOB? 01830000
JNE DI0010 NO, SKIP TO NEXT SQB 01840000
SPACE 1 01850000
*------IOB @ MATCHES, INSURE THAT TCB @ DOES TOO----------------------* 01860000
SPACE 1 01870000
CLC SQBTCB(2,XR2),IOBTCB(,XR1) DOES THE SQB @ THE CURRENT TCB? 01880000
JE RQRSQB YES, GO TO SQB RELEASE ROUTINE 01890000
SPACE 1 01900000
*------SQB NOT FOUND YET, SEE IF THERE ARE MORE SQB'S-----------------* 01910000
SPACE 1 01920000
DI0010 TBN SQBFLG(,XR2),SQBLST IS THIS THE 'LAST ' SQB? 01930000
LA SQBLN(,XR2),XR2 STEP TO NEXT IN CASE=NO 01940000
BF DICLC1 NO LAST SQB, CHECK NEXT SQB 01950000
SPACE 1 01960000
*------GO TO SQB RELEASE LOGIC----------------------------------------* 01970000
SPACE 1 01980000
J $CC4RR GO TO INTERNAL EPA OF SQB RELSE 01990000
EJECT 02000000
*---------------------------------------------------------------------* 02010000
*------AT ENTRY XR2 IS THE @ OF THE SQB TO FREE-----------------------* 02020000
SPACE 1 02030000
RQDPFR EQU * DISPATCHER'S ENTRY POINT TO 02040000
* FREE THE SQB FOR THE IOB WHICH 02050000
* JUST COMPLETED. 02060000
MVI RQDPSW+1,BRNOP SET DISPATCHER EXIT SWITCH 02070000
ST RQDPRA+3,ARR SAVE THE RETURN ADDRESS 02080000
ST RQSRX1+3,XR1 SAVE THE INPUT XR1 02090000
J RQRSQB GO RELEASE THE SQB 02100000
SPACE 02110000
DIIOBQ EQU * LEFT-HAND ADDRESSING EQUATE 02120000
DC AL2(####) @ OF FIRST DISK IOB ENQUEUED 02130000
$CC4RQ ST CCARR,ARR SAVE THE INPUT ARR 02140000
B CCPSAV SAVE THE INPUT REGISTERS IN TCB 02150000
SPACE 1 02160000
RQRSQB EQU * INTERNAL ENTRY POINT FROM 02170000
* SQB ENQUEUE ROUTINE TO RELEASE 02180000
* WITHOUT SAVING REGISTERS 02190000
SPACE 1 02200000
SBN SQBFLG(,XR2),SQBFRE INDICATE AVAILABLE SQB 02210000
SBF SQBFLG(,XR2),SQBOWN TURN OFF 'OWNED' DATA BIT 02220000
SPACE 1 02230000
*------ENTRY POINT WHEN THE IOB HAD NO PRIOR SQB TO RELEASE-----------* 02240000
SPACE 1 02250000
$CC4RR EQU * INTERNAL EPA # 2 02260000
MVI RQWASW+1,BR97 SET EXIT SWITCH TO 'NOT WAIT' 02270000
SPACE 1 02280000
*---------------------------------------------------------------------* 02290000
* SCAN THE CHAIN OF ENQUEUED DISK IOB'S AND RELEASE THEM ONE AT * 02300000
* A TIME DEPENDING UPON THE AVAILABILITY OF SQB'S. THE CURRENT * 02310000
* IOB IS ON THE BOTTOM OF THE CHAIN AND WILL BE PROCESSED LAST * 02320000
*---------------------------------------------------------------------* 02330000
LA DIIOBQ,XR2 GET THE @ OF THE START OF THE 02340000
* ENQUEUED IOB CHAIN 02350000
SPACE 1 02360000
RQCKIB CLC IOBCHN(2,XR2),CC0000 ANY (MORE) QUEUED IOB'S? 02370000
JNE RQ0010 YES, GO PROCESS THIS ONE 02380000
SPACE 1 02390000
*---------------------------------------------------------------------* 02400000
* END OF ENQUEUED IOB'S, DETERMINE HOW TO EXIT, EITHER WITH * 02410000
* A WAIT FOR THE CURRENT TASK OR DIRECTLY TO THE INVOKER * 02420000
*---------------------------------------------------------------------* 02430000
SPACE 1 02440000
RQDPSW JC RQWASW,BR97+## JUMP IF NOT INVOKED BY DISPATCHR 02450000
MVI RQDPSW+1,BR97 RESET DISP ENTRY SWITCH 02460000
RQSRX1 LA ####,XR1 RESTORE INPUT XR1 02470000
RQDPRA B #### RETURN TO DISPATCHER VIA ARR 02480000
SPACE 02490000
RQWASW JC RQRET,BR97+## EXIT WITH OR WITHOUT WAIT??? 02500000
SPACE 1 02510000
*------WAIT FOR DATA AVAILABILITY FOR THE CURRENT TASK----------------* 02520000
SPACE 1 02530000
B $CC4WT GO TO CCP WAIT 02540000
DC AL2(256*WPASQB) ENQ'D DATA WAIT MASK 02550000
DC AL1(1) WAIT COUNT OF ONE 02560000
DC AL1(DPREG+DPDSP) WAIT AND SAVE REG'S 02570000
SPACE 1 02580000
*------WHEN WAITING TASK RESUMES, AN SQB WILL HAVE BEEN BUILT AND THE-* 02590000
*------TASK WILL BE READY TO RUN--------------------------------------* 02600000
SPACE 1 02610000
RQRET B CCPRET RETURN, EITHER TO INVOKER OR TO 02620000
* CCP DISK INTERCEPT TO CONTINUE 02630000
* (IF TASK WAS WAITED FOR C/S/N) 02640000
SPACE 1 02650000
EJECT 02660000
*---------------------------------------------------------------------* 02670000
* DETERMINE IF AN SQB CAN BE ALLOCATED TO THE IOB JUST FOUND * 02680000
*---------------------------------------------------------------------* 02690000
SPACE 1 02700000
RQ0010 ST RQSAVQ,XR2 SAVE THE @ OF WHAT JUST POINTED 02710000
* TO THIS IOB 02720000
SPACE 1 02730000
L IOBCHN(,XR2),XR2 GET @ OF IOB TO TEST 02740000
SPACE 02750000
SPACE 02760000
*---------------------------------------------------------------------* 02770000
* CALCULATE THE BEGINNING AND ENDING DISK ADDRESSES OF THE IOB * 02780000
*---------------------------------------------------------------------* 02790000
SPACE 02800000
LA DINEWT,XR1 LOAD @ OF THE CALC WORK AREA 02810000
USING DINEWT,XR1 02820000
MVC DINQB(1,XR1),IOBQB(,XR2) MOVE THE IOB Q-BYTE 02830000
SBF DINQB(,XR1),BIT5+BIT6+BIT7 TURN OFF NON-DEVICE BITS 02840000
SPACE 02850000
AIF (&D45 NE '1').DIN45 SKIP IF NOT 5445 SUPPORT 02860000
TBN IOBQB(,XR2),DEV45 IS THIS A 5445 IOB ? 02870000
JT DICALC YES, GO CALC C/H/R @ 02880000
SPACE 02890000
*------ DEVICE IS A 5444 ---------------------------------------------* 02900000
SPACE 02910000
.DIN45 ANOP 02920000
MVC DINBEG-1(2,XR1),IOBSB(,XR2) MOVE IOB C/S TO WORK AREA 02930000
MVI DINBEG(,XR1),X'00' ZERO UNUSED BYTE FOR 5444 02940000
MVC DINEND(3,XR1),DINBEG(,XR1) MOVE C/S TO CALC AREA 02950000
MVC DINBYT(1,XR1),IOBNB(,XR2) MOVE N-BYTE 02960000
SPACE 02970000
DIADD ALC DINEND-1(2,XR1),CC0004 STEP THE C/S BY ONE SECTOR 02980000
TBN DINEND-1(,XR1),X'60' TEST FOR VALID C/S 02990000
BT DIADD KEEP ADDING UNTIL C/S IS VALID 03000000
ALC DINBYT(1,XR1),DIFF(,XR1) SUB ONE FROM N-BYTE 03010000
JNOL RQDEVT IF MINUS, WE'RE DONE 03020000
B DIADD ADD UNTIL # OF SECTORS MINUS 03030000
SPACE 03040000
AIF (&D45 NE '1').DONE SKIP IF NO 5445 SUPPORT 03050000
*------ DEVICE IS A 5445 ---------------------------------------------* 03060000
SPACE 03070000
DICALC MVC DINBEG(3,XR1),IOBR(,XR2) MOVE IOB C/H/R TO WORK AREA 03080000
MVC DINBYT(4,XR1),IOBN(,XR2) MOVE C/H/R/N TO CALC AREA 03090000
SPACE 03100000
DIADD5 ALC DINEND(1,XR1),CC0001 ADD ONE TO RECORD # 03110000
CLI DINEND(,XR1),X'15' VALID RECORD ADDRESS ? 03120000
JNE DISUB YES, JUMP 03130000
MVI DINEND(,XR1),X'01' SET RECORD @ TO FIRST ON TRK 03140000
ALC DINEND-1(1,XR1),CC0001 ADD ONE TO TRACK @ 03150000
CLI DINEND-1(,XR1),X'14' VALID TRACK @ ? 03160000
JNE DISUB YES, JUMP 03170000
MVI DINEND-1(,XR1),X'00' SET TRACK @ FIRST ON CYL 03180000
ALC DINEND-2(1,XR1),CC0001 BUMP CYLINDER @ 03190000
DISUB ALC DINBYT(1,XR1),DIFF(,XR1) SUB ONE FROM N-BYTE 03200000
BOL DIADD5 LOOP UNTIL N-BYTE GOES MINUS 03210000
.DONE ANOP 03220000
DROP XR1 03230000
EJECT 03240000
*------GET THE @ OF THE FIRST SQB IN THE SYSTEM-----------------------* 03250000
SPACE 1 03260000
RQDEVT EQU * 03270000
LA $CCCOM,XR1 GET @ OF CCP COMM. AREA 03280000
L @SQB(,XR1),XR1 GET @ OF FIRST SQB 03290000
SPACE 1 03300000
DIBACK TBN SQBFLG(,XR1),SQBFRE IS THIS SQB 'ACTIVE' 03310000
JT RQOK1 NO, GO TO NEXT SQB 03320000
SPACE 1 03330000
*------DETERMINE IF THE SQB AND IOB HAVE THE SAME DEVICE TYPE---------* 03340000
SPACE 1 03350000
CLC SQBQB(1,XR1),DINQB DO THE IOB AND SQB ADDRESS 03360000
* THE SAME DISK DEVICE ? 03370000
JNE RQOK1 NOT SAME DEVICE, O.K. TO DEQ IOB 03380000
SPACE 1 03390000
*---------------------------------------------------------------------* 03400000
* DETERMINE IF THIS IOB'S NEEDED C/S/N'S CONFLICT WITH THE * 03410000
* CURRENT SQB BEING LOOKED AT * 03420000
*---------------------------------------------------------------------* 03430000
SPACE 1 03440000
CLC DINEND(3),SQBBEG(,XR1) DOES THE END OF THE NEW 03450000
* IOB COME AFTER THE START OF THE 03460000
* RELEASED SQB? 03470000
JNH RQOK1 NO, THEREFORE IS O.K. TO DEQ IOB 03480000
SPACE 1 03490000
*------YES, CHECK FOR ADDITIONAL CONFLICT-----------------------------* 03500000
SPACE 1 03510000
CLC DINBEG(3),SQBEND(,XR1) DOES THE IOB'S BEGINNING DISK @ 03520000
* COME AFTER THE RELEASED SQB'S 03530000
* ENDING C/S?? 03540000
JNL RQOK1 YES, THEREFORE IS GO TO DEQ 03550000
SPACE 1 03560000
*------THE C/S/N'S CONFLICT, SEE IF THEY BELONG TO THE SAME TASK------* 03570000
SPACE 1 03580000
CLC SQBTCB(2,XR1),IOBTCB(,XR2) IS THE 'OWNING TCB OF THE DATA 03590000
* THE SAME AS THE 'WANTORS' TCB 03600000
JE RQOK1 YES, THERE THEREFORE THE IOB 03610000
* CAN BE DEQUED AND PROCEED 03620000
SPACE 1 03630000
EJECT 03640000
*---------------------------------------------------------------------* 03650000
* NOTE--C.C.P. FILE SHARING DOES NOT PROTECT THE USER FROM * 03660000
* HAVING THE SAME DATA IN CORE FOR TWO DIFFERENT DTF'S. * 03670000
*---------------------------------------------------------------------* 03680000
SPACE 3 03690000
*---------------------------------------------------------------------* 03700000
* NOT SAME TCB, SO SEE IF THE WANTING IOB'S TCB IS THE CURRENT * 03710000
* TASK CONTROL BLOCK * 03720000
*---------------------------------------------------------------------* 03730000
SPACE 1 03740000
RQ0020 CLC IOBTCB(2,XR2),CCURTB IS THE WANTING IOB'S TCB 03750000
* THE CURRENT TASK? 03760000
BNE RQCKIB NO, DON'T SET WAIT SWITCH ON 03770000
SPACE 1 03780000
*------YES, THERE FORE SET EXIT LOGIC TO WAIT-------------------------* 03790000
SPACE 1 03800000
MVI RQWASW+1,BRNOP SET EXIT LOGIC TO DROP INTO WAIT 03810000
B RQCKIB AND GO CHECK FOR MORE IOB'S 03820000
SPACE 2 03830000
RQOK1 TBN SQBFLG(,XR1),SQBLST END OF ALL SQB'S YET? 03840000
LA SQBLN(,XR1),XR1 STEP TO NEXT IN CASE NOT 03850000
BF DIBACK AND LOOP IS NOT YET DONE 03860000
SPACE 1 03870000
*---------------------------------------------------------------------* 03880000
* DONE WITH SQB CHECKING, GO BUILD AN SQB FOR THE IOB CURRENTLY * 03890000
* BEING PROCESSED * 03900000
*---------------------------------------------------------------------* 03910000
EJECT 03920000
*---------------------------------------------------------------------* 03930000
* O.K. TO RELEASE THIS IOB, SEE IF ANY SQB'S ARE AVAILABLE * 03940000
*---------------------------------------------------------------------* 03950000
SPACE 1 03960000
LA $CCCOM,XR1 GET @ OF CCP COMM. AREA 03970000
L @SQB(,XR1),XR1 GET @ OF SQB LIST 03980000
SPACE 1 03990000
RQCK02 TBN SQBFLG(,XR1),SQBFRE IS THIS A FREE SQB? 04000000
JT RQDEQI YES, GO DEQ IOB AND ENQ DATA 04010000
SPACE 1 04020000
*------NOT AVAILABLE, STEP TO NEXT SQB--------------------------------* 04030000
SPACE 1 04040000
TBN SQBFLG(,XR1),SQBLST IS THIS THE LAST SQB? 04050000
LA SQBLN(,XR1),XR1 STEP TO NEXT IN CASE = NO 04060000
BF RQCK02 NOT LAST , GO TO NEXT ONE 04070000
SPACE 1 04080000
*------NONE AVAILABLE, TERMINATE THE TASK-----------------------------* 04090000
SPACE 1 04100000
B CC4TI2 GO TO TERMINATION ROUTINE 04110000
DC AL1(TCCSQB) COMPLETION CODE - INSUFF SQB'S 04120000
EJECT 04130000
*---------------------------------------------------------------------* 04140000
* DEQUEUE THE WAITING IOB AND ENQ THE DATA WHICH IT WANTS * 04150000
* XR1=AVAILABLE SQB @ * 04160000
* XR2=WAITING IOB @ * 04170000
*---------------------------------------------------------------------* 04180000
SPACE 1 04190000
SPACE 1 04200000
RQDEQI ALC RQDQMV+3(2),CC0001 STEP THE MOVE TO @ TO THE RIGHT 04210000
* HAND END 04220000
RQDQMV MVC ####(2),IOBCHN(,XR2) MEND THE WAITING IOB CHAIN BY 04230000
* POINTING WHAT THIS IOB POINTS TO 04240000
* TO WHAT POINTED TO THIS IOB 04250000
RQSAVQ EQU RQDQMV+3 SAVED IOB CHAIN POINTER 04260000
SPACE 1 04270000
*------BUILD AN SQB FOR THIS IOB--------------------------------------* 04280000
SPACE 1 04290000
ST SQBIOB(,XR1),XR2 SET IOB @ INTO SQB 04300000
SPACE 1 04310000
MVC SQBTCB(2,XR1),IOBTCB(,XR2) SET 'OWNING' TCB @ INTO SQB 04320000
SPACE 1 04330000
SBF SQBFLG(,XR1),SQBFRE INDICATE NOT-FREE SQB 04340000
SBN SQBFLG(,XR1),SQBOWN INDICATE 'OWNED' SQB 04350000
SPACE 1 04360000
*------SET UP THE DATA ADDRESSES ENQUEUED BY THIS SQB-----------------* 04370000
SPACE 1 04380000
MVC SQBEND(7,XR1),DINEND SET DEVICE Q-BYTE AND 04390000
* STARTING AND ENDING DISK 04400000
* ADDRESSES INTO THE SQB 04410000
SPACE 1 04420000
*------DETERMINE WHETHER A WAITING TASK NEEDS POSTING-----------------* 04430000
SPACE 1 04440000
CLC IOBTCB(2,XR2),CCURTB DOES THE IOB BELONG TO THE 04450000
* CURRENT TASK? 04460000
JE RQCKBK YES, SKIP POST 04470000
SPACE 1 04480000
*------NO, POST THE WAITING TASK--------------------------------------* 04490000
SPACE 1 04500000
MVC RQPST@(2),IOBTCB(,XR2) SET @ OF POSTEE (TCB) 04510000
SPACE 1 04520000
B $CC4PS GO TO C.C.P. POST 04530000
DC AL2(256*WPASQB) ENQUEED DATA POST MASK 04540000
RQPST@ DC AL2(####) @ OF TCB TO POST (POSTEE) 04550000
SPACE 1 04560000
*------MEND THE CHAIN ADDRESS AND LOOP BACK FOR MORE WORK TEST--------* 04570000
SPACE 1 04580000
RQCKBK SLC RQSAVQ(2),CC0001 DECREMENT FOR CORRECT @ VALUE 04590000
L RQSAVQ,XR2 GET @ OF PRIOR CHAIN POINTER 04600000
B RQCKIB AND LOOP FOR MORE WORK 04610000
EJECT 04620000
*---------------------------------------------------------------------* 04630000
* DATA AREAS FOR THE CONFLICT TESTS * 04640000
*---------------------------------------------------------------------* 04650000
SPACE 1 04660000
*------TABLE FOR THE 'WANTORS' START + END C/S VALUES 04670000
SPACE 04680000
DINEWT EQU * START OF 'WANTORS' TABLE 04690000
DINQB DS XL1 'WANTORS' Q-BYTE 04700000
DINBEG DS XL3 BEGIN DISK ADDRESS 04710000
DINEND DS XL3 ENDING DISK ADDRESS+1 04720000
DINBYT DS XL1 'WANTORS' N-BYTE 04730000
SPACE 04740000
DIFF DC XL1'FF' CONSTANT FOR DECREMENTING N-BYTE 04750000
SPACE 04760000
TITLE 'FILE&#.SHARING&#.ADDING&#.VALIDITY&#.CHECK&#.ROUTINE&#.' 04770000
*********************************************************************** 04780000
* IF CLOSE IS DOING THE I/O, EXIT IMMEDIATELY * 04790000
*********************************************************************** 04800000
SPACE 04810000
$CC4AO L CCURTB,XR2 LOAD CURRENT TCB @ 04820000
TBN TCBDMG(,XR2),TCBOCF IS CLOSE PURGING THIS IOB ? 04830000
JT AORETN YES, FORGET SINGLE ADDER CHECK 04840000
SPACE 2 04850000
*********************************************************************** 04860000
* INITIALIZE THE TEST INSTRUCTION WITH THE TCB'S FILE BIT MASK * 04870000
*********************************************************************** 04880000
SPACE 04890000
MVC AOTSTA+1(1),TCBFBM(,XR2) STORE THE TCB FILE BIT MASK 04900000
SPACE 2 04910000
*********************************************************************** 04920000
* EXIT IF THE CURRENT OPERATION IS NOT AN ADD * 04930000
*********************************************************************** 04940000
SPACE 04950000
L CCXR2,XR2 LOAD INPUT DTF @ 04960000
TBN DTFOPC(,XR2),DTFOPA IS THIS AN ADD ? 04970000
JF AORETN NO, EXIT 04980000
SPACE 04990000
SPACE 05000000
*********************************************************************** 05010000
* THE OPERATION IS AN ADD AND THE CALLER IS NOT CLOSE. FIND THE * 05020000
* SHORT DTF FOR THE CALLER'S DTF. * 05030000
*********************************************************************** 05040000
SPACE 05050000
LA $CCCOM,XR2 LOAD @ OF CCCOM 05060000
L @DFCT(,XR2),XR2 GET THE FIRST SHORT DTF @ 05070000
SPACE 05080000
AONSDF ST AODFND+3,XR2 SAVE THIS SHORT DTF @ 05090000
CLI DFCHN-1(,XR2),X'00' ANY OPEN DTFS ON THIS CHAIN 05100000
JE AONEXT NO, GET THE NEXT SHORT DTF 05110000
SPACE 05120000
CLC DFCHN(2,XR2),CCXR2 IS THIS DTF ADDRESSED BY THE IOB 05130000
L DFCHN(,XR2),XR2 LOAD DTF @ 05140000
JE AODFND YES, JUMP TO TEST 05150000
SPACE 05160000
AONDTF CLI DTFCHA-1(,XR2),X'00' LAST DTF ON THE OPEN CHAIN ? 05170000
JE AONEXT YES, GET THE NEXT SHORT DTF 05180000
SPACE 05190000
CLC DTFCHA(2,XR2),CCXR2 ) DOES THE NEXT DTF MATCH IOB DTF 05200000
L DTFCHA(,XR2),XR2 LOAD NEXT DTF @ ANYWAY 05210000
JE AODFND YES, JUMP 05220000
B AONDTF NO, TRY THE NEXT 05230000
SPACE 05240000
AONEXT L AODFND+3,XR2 RESTORE SHORT DTF @ 05250000
L DFNDTF(,XR2),XR2 LOAD @ OF NEXT DTF 05260000
B AONSDF GO TRY THIS OPEN CHAIN 05270000
SPACE 2 05280000
*********************************************************************** 05290000
* THE SHORT DTF HAS BEEN LOCATED. INSURE THAT THE CURRENT * 05300000
* TASK IS A VALID ADDER TO THIS FILE. * 05310000
*********************************************************************** 05320000
SPACE 05330000
AODFND LA ####,XR2 LOAD @ OF THE SHORT DTF 05340000
AOTSTA TBN DFADD(,XR2),## IS THIS TASK ALLOWED TO ADD ? 05350000
JF AOABND NO, GO TERMINATE HIM 05360000
SPACE 2 05370000
*********************************************************************** 05380000
* IF NO OTHER DTF IS ADDING TO THE FILE, MAKE THIS DTF THE * 05390000
* CURRENT ADDER. IF AN ADDER IS ALREADY ON THE FILE, INSURE THAT *05400000
* IT IS THIS DTF. * 05410000
*********************************************************************** 05420000
SPACE 05430000
CLI DFADTF-1(,XR2),X'00' IS ANYONE ALREADY ADDING ? 05440000
JE AOFADR NO, JUMP 05450000
SPACE 05460000
CLC DFADTF(2,XR2),CCXR2 IS THIS DTF THE CURRENT ADDER ? 05470000
JNE AOABND TWO ADDERS TABOO, GO TERMINATE 05480000
AOFADR MVC DFADTF(2,XR2),CCXR2 MAKE THIS DTF THE CURRENT ADDER 05490000
SPACE 05500000
*********************************************************************** 05510000
* RETURN TO THE CALLER IF EVERYTHING IS OK. TERMINATE THE TASK * 05520000
* IF NOT. * 05530000
*********************************************************************** 05540000
SPACE 05550000
SPACE 05560000
AORETN B CCPRET RETURN 05570000
SPACE 05580000
AOABND B CC4TI2 GO TO ABNORMAL TERM ROUTINE 05590000
DC AL1(TCCIVA) 05600000
SPACE 1 05610000
* END MACRO $E055 05620000
MEND 05630000