|
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: 43434 (0xa9aa)
Types: s3xseg
Names: »S$E040«
└─⟦827b5bd03⟧ Bits:30009184 5702-sc1.V16.ccp
└─⟦f17e99db6⟧
└─⟦this⟧ »S$E040«
MACRO 00010000
$E040 00020000
GBLB &D45 5445 DEVICE SUPPORT 00030000
GBLB &MTK MULTI-TASKING USERS 00040000
GBLB &DPF DUAL PROGRAMMING FEATURE 00050000
GBLB &SHR DISK FILE SHARING 00060000
GBLB &MIN MINIMUM CORE OPTIONS 00070000
GBLB &MOD4 MODEL 4 SYSTEM 00072000
GBLB &UR41 3741 SUPPORT 00075000
LCLC &# 00080000
LCLC &C CHARACTER LOCAL 00090000
TEXT 00100000
&# SETC ' ' 00110000
TITLE 'TASK&#.DISPATCHER&#.--&#.$CC4DP' 00120000
* MACRO $E040 1/7/73 00130000
SPACE 2 00140000
*********************************************************************** 00150000
* * 00160000
* NAME -- $CC4DP * 00170000
* * 00180000
* TITLE -- TASK DISPATCHER + I/O SCHEDULER * 00190000
* * 00200000
* FUNCTION-- * 00210000
* * 00220000
* . DISPATCH ANY READY SYSTEM OR USER TASK. * 00230000
* . ALLOW A USER TASK TO EXIT THE MUST-COMPLETE STATE. * 00240000
* . ROUTE CONTROL FOLLOWING A TELEPROCESSING OR CONSOLE * 00250000
* INTERRUPT TO A CCP TASK TO PROCESS THAT INTERRUPT. * 00260000
* . GIVE CONTROL BACK TO AN INTERRUPTED USER TASK FOLLOWING * 00270000
* INTERRUPT PROCESSING. * 00280000
* . DETERMINE WHICH DISK IOB'S SHOULD BE SCHEDULED INTO * 00290000
* EITHER THE DISK I/O DISPATCHER OR DISK I/O WAIT * 00300000
* ROUTINE OF THE DISK SYSTEM MONITOR. * 00310000
* . CAUSE THE CCP TO WAIT WHEN NO WORK CAN BE PERFORMED. * 00320000
* * 00330000
* ENTRY POINT -- $CC4DP * 00340000
* * 00350000
* INPUT -- VARIABLE FIELDS AND FLAG BYTES IN $CCCOM TO INDICATE WHAT * 00360000
* ACTIONS ARE TO BE TASKED BY THE DISPATCHER. * 00370000
* * 00380000
* . THE ADDRESS OF THE RETURNING (OR CURRENT TASK) * 00390000
* CURRENTLY RUNNING UNDER THE CCP IN THE $CCCOM FIELDS * 00400000
* @CURTB AND @LASTB. * 00410000
* . $CCCOM FIELD $DPFLH WHICH INDICATES THE TYPE OF ENTRY * 00420000
* BEING MADE TO THE DISPATCHER. THIS CAN BE EITHER A * 00430000
* NORMAL EXIT FROM A TASK (NO INDICATORS ARE SET), OR IT * 00440000
* CAN BE AN ENTRY FROM ONE OF THE INTERRUPT LEVELS CAUSED * 00450000
* BY AN INTERRUPT LEVEL ROUTINE RESETTING THE CCP * 00460000
* INSTRUCTION ADDRESS REGISTER TO WREST CONTROL FROM THE * 00470000
* CURRENT TASK AND FORCING CONTROL TO RESUME IN THE CCP * 00480000
* DISPATCHER. * 00490000
* . AN INDICATION IN THE $CCCOM FIELD $DPFLG AS TO WHETHER * 00500000
* THE EXITING TASK IS RELINQUISHING CONTROL AS IT MUST * 00510000
* WAIT FOR SOME EVENT OR IT IS ONLY EXITING THE * 00520000
* MUST-COMPLETE STATE. * 00530000
* * 00540000
* WHEN A TASK IS EXITING THE MUST-COMPLETE STATE, THE CCP * 00550000
* DISPATCHER WILL ALLOW ANY OF THE SYSTEM TASKS * 00560000
* (COMMUNICATION, TERMINATION, OR COMMAND PROCESSOR) TO RUN * 00570000
* AND THEN GIVE CONTROL IMMEDIATELY BACK TO THE TASK THAT * 00580000
* LAST EXITED THE MUST-COMPLETE STATE IF THAT TASK IS * 00590000
* STILL DISPATCHABLE. * 00600000
* * 00610000
* EXT REF -- * 00620000
* * 00630000
* . DISK SYSTEM MONITOR NCEIOS + NCEIOW ENTRY POINTS, $CCCOM, * 00640000
* CCP REGISTER SAVE AND RESTORE ROUTINE, CCP WAIT AND POST * 00650000
* ROUTINES. * 00660000
* * 00670000
* EXIT, NORMAL -- * 00680000
* * 00690000
* . TO THE INSTRUCTION ADDRESSED BY THE TCB ARR FIELD OF * 00700000
* THE TO BE DISPATCHED TCB. * 00710000
* . IF NO READY TASKS EXIST BUT DISK IOBS ARE IN PROCESS, * 00720000
* THEN $CC4DP WILL BRANCH TO DSMS DIODWT ENTRY. * 00730000
* . IF NEITHER OF THE ABOVE ARE APPLICABLE, THE DISPATCHER * 00740000
&C SETC 'APL' MINSYS 00750000
AIF (&MIN).ISMIN MINSYS? 00760000
&C SETC 'HPL' NON-MINSYS 00770000
.ISMIN ANOP 00780000
* WILL &C ALLOWING, IN A DPF SYSTEM, THE OTHER PROGRAM * 00790000
* LEVEL TO GAIN CONTROL OF THE CPU. * 00800000
* * 00810000
* EXIT, ERROR -- NONE * 00820000
* * 00830000
* TABLES -- * 00840000
* * 00850000
* . TCB CHAINS, $CCCOM, DISPATCHER WORKAREA IN $CCCOM, * 00860000
* DISK IOBS * 00870000
* * 00880000
* ATTRIBUTES -- RESIDENT, SERIALLY REUSEABLE, MUST COMPLETE. * 00890000
* * 00900000
*********************************************************************** 00910000
TCBREG EQU XR1 TASK CONTROL BLOCK REGISTER 00920000
COMREG EQU XR2 CCP COMMUNICATION AREA REGISTER 00930000
EJECT 00940000
*---------------------------------------------------------------------* 00950000
* INITIAL ENTRY LOGIC OF THE DISPATCHER.... * 00960000
* WILL SAVE THE REGISTERS IN THE TCB IF REQUIRED AND WILL SAVE * 00970000
* ADDRESS OF THE LAST RETURNING TASK. WILL ALSO DETERMINE * 00980000
* IF THE LAST TASK WAS A USER OR SYSTEM TASK, AND WILL SET * 00990000
* THE DISPATCHABILITY BIT OF THE TCB ACCORDING TO THE VALUES * 01000000
* IN THE DISPATCHER CONTROL FLAG IN CCPCOM. * 01010000
*---------------------------------------------------------------------* 01020000
SPACE 2 01030000
$CC4DP ST CCXR2,XR2 SAVE INPUT REG TWO 01040000
LA $CCCOM,COMREG SET UP COMM AREA BASE REG 01050000
ST $CCXR1(,COMREG),XR1 SAVE INPUT REG ONE 01060000
ST $CCARR(,COMREG),ARR SAVE INPUT ARR 01070000
SPACE 2 01080000
L @CURTB(,COMREG),TCBREG SET @ OF LAST ACTIVE TASK TCB 01090000
ST TCBPSR(,TCBREG),PSR SAVE ENTRY PSR IN TCB 01100000
SPACE 1 01110000
BC $CC4TT,BR97 INVOKE TRACE AT THIS POINT 01120000
* AND RESET THE FALSE BIT 01130000
DC AL1(TTDPA) GO TO TRACE FOR INITIAL $CC4DP 01140000
SPACE 1 01150000
AIF (&MOD4 NE '1').MD410 01150600
* INCREMENT THE FIELD LIGHTS FOR A MOD 4 SYSTEM 01151200
SPACE 1 01151800
L @KMWK(,COMREG),XR1 XR1 --> CONSOLE WORK AREA 01152400
MZZ DPLITE,#KMLIT(,XR1) HI ORDER BITS IN WORK AREA 01153000
ALC DPLITE(1),DPLITE ADD IT TO ITSELF 01153600
MZZ #KMLIT(,XR1),DPLITE PUT RESULT IN WORK AREA 01154200
MVI DPLITE,NOBIT INIT TO ZIP FOR NEXT PASS 01154800
JNOL DPLIO IF NO OVERFLOW - JUMP 01155400
SBN #KMLIT(,XR1),BIT2 FIELD LIGHT = #3 01156000
DPLIO EQU * * 01156600
DC XL2'3112' SIO AND Q CODE FOR FIELD LIGHTS 01157200
DC AL2($CCCOM+$KMWK+#KMLIT) ADDRESS OF LIGHT MASK 01157800
L @CURTB(,COMREG),TCBREG XR1 --> LAST ACTIVE TCB 01158400
.MD410 ANOP 01159000
DPAAA TBN $DPFLH(,COMREG),DPINT IS THIS AN ENTRY FOLLOWING AN 01160000
* INTERRUPT LEVEL PROCESS 01170000
JF DPAA NO, DON'T SET THE RESUME TCB @ 01180000
ST @RITCB(,COMREG),TCBREG YES, SET ADDR OF TCB TO USE 01190000
* FOR RESUME INTERRUPTED TASK 01200000
J DPAAB + SKIP SAVING $DPFLG AS THE 01210000
* INTERRUPT HANDLER DID IT 01220000
DPAA MVC TCBFLG(1,TCBREG),$DPFLG(,COMREG) SAVE $DPFLG IN THE TCB 01230000
* OF THE RETURNING TASK 01240000
DPAAB TBN TCBTSK(,TCBREG),TCBSYT IS THE RETURNING TASK A SYSTEM 01250000
* TASK 01260000
JT DPAB YES, SKIP NSI 01270000
ST @LUSTB(,COMREG),TCBREG SET @ OF LAST USER TCB TO RUN 01280000
DPAB TBN $DPFLG(,COMREG),DPREG ARE THE TCB REGISTERS TO BE SAVD 01290000
JF DPABA NO, DON'T SAVE REGISTERS 01300000
SBN TCBTSK(,TCBREG),TCBDSV SET DISPATCHER SAVED REGISTERS 01310000
* INDICATOR FOR TCBXIT ROUTINE 01320000
B CCPSV2 GO TO STANDARD REGISTER SAVE RTN 01330000
* ALTERNATE ENTRY POINT 01340000
DPABA TBN $DPFLG(,COMREG),DPDSP IS THE TCB TO BE MARKED AS NON- 01350000
* DISPATCHABLE /I.E. WAITING FOR 01360000
* SOME EVENT/ 01370000
JF DPAC NO, KEEP IT DISPATCHABLE 01380000
SBF TCBTSK(,TCBREG),TCBDSP YES, SET TCBDSP TO ZERO 01390000
DPAC SBF $DPFLH(,COMREG),DPINT TURN OFF THE DISPATCHER 01400000
* INTERRUPT ENTRY INDICATOR 01410000
SPACE 2 01420000
*********************************************************************** 01430000
* END OF DISPATCHER INITIAL ENTRY LOGIC * 01440000
*********************************************************************** 01450000
EJECT 01460000
*---------------------------------------------------------------------* 01470000
* DETERMINE IF ANY INTERRUPTS HAVE TO BE PROCESSED AND IF THE * 01480000
* INTERRUPT PROCESSING TASKS CAN BE DISPATCHED * 01490000
*---------------------------------------------------------------------* 01500000
SPACE 3 01510000
*********************************************************************** 01520000
* THIS IS ALSO THE INTERNAL ENTRY POINT FOR RECURSION * 01530000
*********************************************************************** 01540000
SPACE 1 01550000
DPACA L @CMTCB(,COMREG),TCBREG GET @ OF FIRST CCP SYSTEM TCB 01560000
SPACE 1 01570000
*------SEE IF COMM TASK WAITING ON DISK I/O---------------------------* 01580000
SPACE 1 01590000
TBN TCBWMK(,TCBREG),WPADIO COMM TASK WAITING ON DISK I/O 01600000
JF DPCKCM NO, CHECK FOR TP INTERRUPT 01610000
SPACE 1 01620000
TBN TCBPMK(,TCBREG),WPADIO HAS DISK WAIT BEEN POSTED 01630000
BT DPXIT YES, GO TO COMMUNICATIONS TASK 01640000
J DPNOGO NO, MAKE WHOLE SYSTEM WAIT 01650000
SPACE 1 01660000
*---------------------------------------------------------------------* 01670000
* IF THE COMMUNICATIONS TASK IS WAITING FOR WORK, SEE IF THERE * 01680000
* ARE INTERRUPTS PENDING TO BE PROCESSED * 01690000
*---------------------------------------------------------------------* 01700000
SPACE 1 01710000
DPCKCM TBN TCBWMK(,XR1),WPAAII IS COMMUNICATIONS TASK WAITING 01720000
* FOR WORK TO DO?? 01730000
JF DPAD NO, SKIP TO DISPATCHABILITY TEST 01740000
* OF SYSTEM TASKS 01750000
SPACE 1 01760000
*------COMM. TASK CAN HANDLE INTERRUPTS, ARE THERE ANY?---------------* 01770000
SPACE 1 01780000
CLI #OPEND(,COMREG),NOBIT ANY PENDING INTERRUPTS ?? 01790000
TBF $DPFLH(,COMREG),DPCI ANY CONSOLE INTERRUPT ?? 01800000
BC DPXIT,ANY+HI+LO+FALSE YES, EXIT TO COMM. TASK 01810000
EJECT 01820000
*********************************************************************** 01830000
* NO INTERRUPT OCCURRED, THEREFORE SCAN THE SYSTEM TASK QUEUE TO * 01840000
* SEE IF ANY OF THEM ARE DISPATCHABLE ANYWAY * 01850000
*********************************************************************** 01860000
SPACE 2 01870000
SPACE 1 01880000
*********************************************************************** 01890000
* AT ENTRY TCBREG-@ OF COMM. TASK TCB * 01900000
*********************************************************************** 01910000
SPACE 1 01920000
DPAD B DPTEST SEE IF TASK CAN BE DISPATCHED 01930000
CLI TCBNXT-1(,TCBREG),0 ARE WE AT THE END OF THE SYSTEM 01940000
* TASK QUEUE 01950000
*******NOTE THE ASSUMPTION THAT HIGH BYTE OF ZERO /I.E. NO TCB IN 1ST 01960000
*******X'100' OF MAIN STORAGE***************************************** 01970000
SPACE 1 01980000
JE DPAE YES, END OF CHAIN REACHED, GO 01990000
* TO RESUME INTERRUPTED TASK RTN 02000000
L TCBNXT(,TCBREG),TCBREG STEP TO NEXT SYSTEM TASK TCB 02010000
B DPAD AND SEE IF NEXT TCB IS READY 02020000
EJECT 02030000
*********************************************************************** 02040000
* END OF TESTING FOR DISPATCHABILITY OF CCP SYSTEM TASKS. NOW * 02050000
* SEE IF THERE IS AN INTERRUPTED USER TASK WHICH CAN BE RESUMED * 02060000
*********************************************************************** 02070000
SPACE 2 02080000
DPAE TBN $DPFLH(,COMREG),DPSMC IS A SMC FUNCTION IN EFFECT 02090000
JT DPBA YES, SKIP RESUME INTERRUPTED 02100000
* TASK LOGIC 02110000
TBN $DPFLH(,COMREG),DPRIT NO, IS THE INT. TASK BIT ON 02120000
JF DPBA NO, FORGET THIS PATH 02130000
SPACE 1 02140000
*---------------------------------------------------------------------* 02150000
* IF THERE IS AN INTERRUPTED USER TASK, IT COULD BE IN AN * 02160000
* ENDLESS LOOP. IF SO IT CAN'T BE RESUMED IF THE COMMAND * 02170000
* PROCESSOR IS WAITING FOR THE TRANSIENT AREA OR DISK I/0. * 02180000
*---------------------------------------------------------------------* 02190000
SPACE 1 02200000
L @CPTCB(,COMREG),XR1 GET CMD PROC TCB @ 02210000
SPACE 1 02220000
AIF (&MTK).DPJOE MULTI-TASKING?? 02230000
TBF TCBWMK(,XR1),WPADIO+WPATA IS C.P. WAITING ON DISK OR T.A. 02240000
JT DPAEB NO, ALLOW INT. TASK TO RESUME 02250000
SPACE 1 02260000
TBF TCBPMK(,XR1),WPADIO+WPATA YES, IS EITHER EVENT COMPLETE ? 02270000
JT DPNOGO NO, HOLD THE SYSTEM UNTIL C.P. 02280000
* CAN RUN 02290000
SPACE 1 02300000
AGO .DPJGF 02310000
.DPJOE ANOP 02320000
SPACE 1 02330000
TBN TCBWMK(,XR1),WPADIO IS C.P. WAITING ON DISK I/0 ? 02340000
TBF TCBPMK(,XR1),WPADIO AND NOT YET POSTED ? 02350000
JT DPNOGO YES, HOLD THE SYSTEM FOR C.P. 02360000
SPACE 1 02370000
TBN TCBWMK(,XR1),WPATA IS C.P. WAITING FOR XSIENT AREA 02380000
TBF TCBPMK(,XR1),WPATA AND NOT YET POSTED ? 02390000
JF DPAEB NO, O.K. TO RESUME INT. TASK 02400000
SPACE 1 02410000
EXTRN TACTCB 02420000
L TACTCB,XR1 LOAD @ OF TCB WHO OWNS T.A. 02430000
B DPTEST GO SEE IF HE'S READY TO RUN 02440000
J DPNOGO NOT READY, WAIT FOR HIM 02450000
.DPJGF ANOP 02460000
SPACE 2 02470000
*------O.K. TO RESUME INT. TASK---------------------------------------* 02480000
SPACE 1 02490000
DPAEB L @RITCB(,COMREG),TCBREG GET USER TCB @ TO RESUME 02500000
SPACE 1 02510000
SPACE 1 02520000
*********************************************************************** 02530000
* ENTRY FOR RESUMING A SUSPENDED TASK BY OPERATOR COMMAND * 02540000
*********************************************************************** 02550000
SPACE 1 02560000
DPAEA MVC DPAF+3(2),TCBSAV(,TCBREG) GET THE @ OF THE TCB REGISTER 02570000
* SAVE AREA LAST USED 02580000
ALC DPAF+3(2),X$0002(,COMREG) STEP THE ADDRESS UP TO THE ARR 02590000
DPAF L ####,ARR SET THE ARR FROM THE TCB 02600000
MVC DPAG+3(2),DPAF+3 GET THE TCBSAV ADDRESS TO REUSE 02610000
DPAG MVC ####(2),TCBIAR(,TCBREG) SINCE THE RESUME ADDRESS IS 02620000
* ACCESSED FROM THE TCBARR FIELD, 02630000
* SET THE TCBARR FROM THE TCBIAR 02640000
SPACE 2 02650000
SBF $DPFLH(,COMREG),DPRIT TURN OFF THE RESUME TASK BIT 02660000
SPACE 1 02670000
L DP@XTA,IAR GO TO TASK INVOKE BEYOND ARR 02680000
* RESET INSTRUCTION 02690000
DP@XTA DC AL2(DPXITA) @ OF INSTRUCTION AFTER ARR RESET 02700000
SPACE 1 02710000
*********************************************************************** 02720000
* END OF RESUME INTERRUPTED TASK ROUTINE * 02730000
*********************************************************************** 02740000
SPACE 1 02750000
SPACE 1 02760000
*********************************************************************** 02770000
* PUSH THROUGH ANY PENDING DISK I/O * 02780000
*********************************************************************** 02790000
SPACE 1 02800000
DPBA LA DPIOB,XR1 SET UP REG FOR DIODWT ENTRY 02810000
@DWT2 EQU *+3 *S* PLUGGED BY INITIALIZATION 02820000
B #### *S* GO TO NCEIOW WITH A COMPLETE 02830000
* IOB TO ALLOW HIM TO START WHAT 02840000
* EVER CAN BE STARTED 02850000
J DPBAA 02860000
DPIOB EQU * DUMMY IOB FOR DISK WAIT 02870000
DC XL2'0000' 02880000
DC XL1'40' ALWAYS POSTED 02890000
DC XL1'A0' DEVICE Q-BYTE (5444) 02900000
ORG DPIOB+IOBFLG 02910000
DC AL1(NODTF) INDICATE NO DTF IN THIS IOB 02920000
ORG DPIOB+IOBXR2+1 02930000
EJECT 02940000
*********************************************************************** 02950000
* DISPATCH ANY READY USER TCB * 02960000
*********************************************************************** 02970000
SPACE 1 02980000
DPBAA L @LUSTB(,XR2),XR1 GET @ OF LAST USER TCB TO RUN 02990000
AIF (&MTK EQ '0').DP1A SKIP IF SINGLE TASK SYSTEM 03000000
TBN TCBFLG(,XR1),DPXSMC IS TASK EXITING A CCP FUNCTION? 03010000
.DP1A ANOP BYPASS INSTRUCTION IF ONE-TASK 03020000
SBF TCBFLG(,XR1),DPXSMC RESET EXIT MUST COMPLETE BIT 03030000
AIF (&MTK NE '1').DP1 MULTI-TASKING VERSION? 03040000
BT DPTEST YES, SEE IF IT CAN STILL RUN 03050000
SPACE 1 03060000
*------TASK IS NOT EXITING, CHECK USER TCB CHAIN FOR A READY TCB------* 03070000
SPACE 1 03080000
DPBAB L TCBNXT(,XR1),XR1 GET @ OF USER TCB FOLLOWING 03090000
* THE LAST ONE TO RUN 03100000
B DPTEST SEE IF IT CAN RUN 03110000
CLC TCBNXT(2,XR1),@LUSTB(,XR2) HAVE ALL TCB'S BEEN CHECKED 03120000
BNE DPBAB NO, GO TO NEXT USER TCB 03130000
SPACE 1 03140000
*------------ALL USER TCB'S HAVE BEEN CHECKED--SEE IF LAST ONE--------* 03150000
*------------TO EXIT IS STILL READY-----------------------------------* 03160000
SPACE 1 03170000
L TCBNXT(,XR1),XR1 GET @ OF LAST USER TCB TO RUN 03180000
.DP1 ANOP 03190000
B DPTEST GO SEE IF IT CAN RUN 03200000
J DPNOGO MUST NOT HAVE BEEN ELIGIBLE, 03210000
SPACE 1 03220000
*------EXIT THE TEST OF USER TCB DISPATCHABILITY----------------------* 03230000
SPACE 1 03240000
SPACE 3 03250000
*---------------------------------------------------------------------* 03260000
* DETERMINE IF A TCB IS ELIGIBLE TO RUN--COMMON SUBROUTINE * 03270000
*---------------------------------------------------------------------* 03280000
SPACE 3 03290000
DPTEST ST DPTRET+3,ARR SAVE THE ARR FOR RETURN 03300000
TBN $DPFLH(,XR2),DPSMC IS A MUST COMPLETE FUNCTION 03310000
* CURRENTLY IN EFFECT 03320000
JF DPT001 NO, CONTINUE 03330000
SPACE 1 03340000
*------A MUST COMPLETE FUNCTION IS IN PROGRESS, DISPATCH ONLY---------* 03350000
*------THE TASK WHO CAUSED THE FUNCTION TO START----------------------* 03360000
SPACE 1 03370000
CLI TCBID(,XR1),C'C' IS THIS CM TASK?? 03380000
JE DPT001 YES, BYPASS LOCK TEST 03390000
SPACE 1 03400000
TBN TCBFLG(,XR1),DPFSMC IS THIS THE CORRECT TASK 03410000
JT DPT001 YES - CHECK DISPATCHABILITY 03420000
TBN TCBTSK(,XR1),TCBDSM THIS TASK IN DSM ? 03423000
JF DPTRET NO - DON'T DISPATCH IT 03426000
SPACE 1 03430000
*------DETERMINE IF THIS TCB CAN BE DISPATCHED------------------------* 03440000
SPACE 1 03450000
DPT001 TBN TCBTSK(,XR1),TCBDSP+TCBATV IS THIS TCB READY TO RUN 03460000
AIF (&SHR).J1 FILE SHARING?? 03470000
JT DPBAC YES, GO TO INVOKE THE TASK 03480000
AGO .NJ1 03490000
.J1 BT DPBAC YES, GO INVOKE THE TASK 03500000
.NJ1 ANOP 03510000
DPTRET B #### NO, EXIT TO SCAN OF TCB'S 03520000
EJECT 03530000
*********************************************************************** 03540000
* ALL TCBS HAVE BEEN CHECKED FOR DISPATCHABILITY AND NONE FOUND * 03550000
* TO BE READY. CHECK FOR BUSY I/O TO DETERMINE WHETHER TO GO TO * 03560000
* DISK I/O WAIT OF DSM OR APL AND LET THE OTHER LEVEL RUN * 03570000
* * 03580000
* ENTRY WILL COME TO THIS LABEL IF ONE OF THE INTERRUPT * 03590000
* DRIVEN SYSTEM TASKS IS WAITING FOR DISK I/O COMPLETION. * 03600000
*********************************************************************** 03610000
SPACE 2 03620000
*---------------------------------------------------------------------* 03630000
* DISK I/O WAIT SCHEDULING ROUTINE--WILL SEND WAIT REQUESTS ON * 03640000
* TO DISK WAIT IN PRIORITY ORDER OF CCP SYSTEM TASKS OR * 03650000
* FOR USER TASKS FOR THE OLDEST ONE WAITING FOR DISK I/O * 03660000
*---------------------------------------------------------------------* 03670000
SPACE 2 03680000
DPNOGO L @CMTCB(,XR2),XR1 GET @ OF HIGHEST PRIORTY SYS TASK03690000
DPNA TBN TCBWMK(,XR1),WPADIO IS THIS TCB WAITING ON DISK 03700000
JF DPNAA NO, GO TO NEXT TCB 03710000
TBN TCBPMK(,XR1),WPADIO YES, IS IT POSTED YET 03720000
JF DPWAIT NO, GO TO DISK I/O WAIT OF DSM 03730000
SPACE 1 03740000
*------THIS TASK NOT WAITING, ANY MORE SYSTEM TASKS TO DO-------------* 03750000
SPACE 1 03760000
DPNAA CLI TCBNXT-1(,XR1),NOBIT END OF SYSTEM TASK CHAIN 03770000
L TCBNXT(,XR1),XR1 GET NEXT TCB @ IN CASE 03780000
BNE DPNA NOT LAST, GO CHECK NEXT TCB 03790000
SPACE 2 03800000
*------END OF SYSTEM TASK CHECKS, SEE IF ANY USER TCB IS WAITING ON I/O 03810000
SPACE 2 03820000
L @LUSTB(,XR2),XR1 GET @ OF LAST USER TO HAVE CPU 03830000
SPACE 1 03840000
AIF (&MTK NE '1').DP2 MULTI-TASKING???? 03850000
DPNAAB L TCBNXT(,XR1),XR1 GET @ OF OLDEST USER TASK TO 03860000
.DP2 ANOP 03870000
* NOT HAVE CPU 03880000
SPACE 1 03890000
TBN TCBWMK(,XR1),WPADIO IS HE WAITING ON DISK I/O 03900000
TBF TCBJOB(,XR1),TCBTRM AND NOT BEING TERMINATED? 03910000
AIF (&MTK).DP3 MULTI-TASKING? 03920000
TBF TCBPMK(,XR1),WPADIO AND NOT YET POSTED ? 03930000
JF DPURCK NOT WAITING FOR DISK I/O, GO 03940000
* CHECK U.R. WAIT 03950000
AGO .DP5 03960000
.DP3 ANOP 03970000
JF DPNAAA NO, SEE IF MORE TCB'S TO TEST 03980000
SPACE 1 03990000
TBN TCBPMK(,XR1),WPADIO YES, IS IT POSTED YET 04000000
JF DPWAIT NO, GO TO DISK I/O WAIT FOR THIS 04010000
* USER TASK 04020000
SPACE 1 04030000
*------THIS TASK NOT WAITING ON DISK I/O, SEE IF ANY MORE TCB'S-------* 04040000
*------NEED TO BE CHECKED---------------------------------------------* 04050000
SPACE 1 04060000
DPNAAA ST DPN@A,XR1 SAVE TCB @ 04070000
CLC DPN@A(2),@LUSTB(,XR2) ARE WE CURRENTLY LOOKING AT THE 04080000
* LAST TASK WHICH HAD THE CPU 04090000
BNE DPNAAB NO, GO TO NEXT TCB IN CHAIN 04100000
SPACE 1 04110000
*------ALL USER TASKS HAVE BEEN CHECKED, EXIT THIS ROUTINE------------* 04120000
SPACE 1 04130000
J DPURCK GO TO UNIT RECORD CHECK ROUTINE 04140000
.DP5 ANOP 04150000
EJECT 04160000
*---------------------------------------------------------------------* 04170000
* GO TO DISK I/O WAIT ROUTINE OF DSM * 04180000
* INPUT IS XR2=$CCCOM, XR1=TCB FOR WAIT * 04190000
*---------------------------------------------------------------------* 04200000
SPACE 2 04210000
DPWAIT EQU * PREPARE TO ENTER NCEIOW S4146 04220000
ST @CURTB(,XR2),XR1 SET AS TCB OF CURRENT TASK 04230000
LA 0(,XR1),XR2 PUT TCB @ INTO XR2 FOR LATER 04240000
L TCBIOB(,XR1),XR1 GET @ OF IOB FOR WAIT 04250000
ST IOBTCB(,XR1),XR2 SAVE @ OF TCB FOR CCP TRACE 04260000
SPACE 1 04270000
B $CC4TT GO TO TRACE FOR THIS WAIT 04280000
DC AL1(TTDPW) DISPATCHER DISK WAIT TRACE ID 04290000
SPACE 1 04300000
TBN IOBCMP(,XR1),BIT1 IS THE IOB COMPLETE ALREADY? 04310000
TBF IOBCMP(,XR1),BIT0+BIT2+BIT3 AND BEEN WAITED UPON ? 04320000
JT DPIOPS YES, BYPASS INVOKING NCEIOW 04330000
SPACE 1 04340000
DPGOWT B #### GO TO DSM DISK I/O WAIT (NCEIOW) 04350000
@DWT1 EQU *-1 @ OF WAIT PLUGGED BY CCP STARTUP 04360000
SPACE 1 04370000
*------POST THE TCB THAT THE DISK OPERATION HAS COMPLETED-------------* 04380000
SPACE 1 04390000
DPIOPS ST DPPOSS,XR2 SAVE @ OF TCB FOR POST S4146 04400000
SBN TCBTSK(,XR2),TCBDSV SET REGS SAVED BIT IN CASE S4146 04410000
* RE-ENTERED AFTER DISK ERP S4146 04420000
AIF (&MOD4 NE '1').MD499 04421000
SPACE 1 04422000
L NCSYS@,XR2 XR2 --> SYSCOM S310336 04423000
SBF NCMBSV(,XR2),NCDERP TURN OFF CCP/DLOG S310336 04424000
* JUST IN CASE S310336 04425000
L DPPOSS,XR2 RE LOAD XR2 TO @ OF TCB S310336 04426000
.MD499 ANOP 04427000
B $CC4PS POST DISK I/O COMPLETED S4146 04430000
DC AL2(256*WPADIO) DISK I/O POST MASK 04440000
DPPOSS DS XL2 *M* @ OF TASK TO POST DISK I/O 04450000
DPN@A EQU DPPOSS @ OF TCB BEING TESTED 04460000
AIF (&SHR NE '1').NSHR 04470000
SPACE 1 04480000
*---------------------------------------------------------------------* 04490000
* SEE IF THIS IOB OWNED AN SQB WHICH CAN NOW BE RELEASED * 04500000
*---------------------------------------------------------------------* 04510000
SPACE 1 04520000
SPACE 1 04530000
*---------------------------------------------------------------------* 04540000
* EQUATES USED FOR FIELD + BIT TESTING IN FILE SHARING SYSTEMS * 04550000
*---------------------------------------------------------------------* 04560000
SPACE 1 04570000
DTFATR EQU 3 DTF ATTRIBUTE BYTES 04580000
DIRECT EQU BIT2 DIRECT ORGANIZATION 04590000
UPDATE EQU BIT6 UPDATE DTF 04600000
RANDOM EQU BIT2 RANDOM PROCESSING 04610000
SPACE 1 04620000
WRITE EQU BIT6 IOB OP BIT - WRITE 04630000
READ EQU BIT7 IOB OP BIT - READ 04640000
SPACE 1 04650000
TBN IOBQB(,XR1),WRITE WAS A WRITE OP JUST COMPLETED 04660000
TBF IOBQB(,XR1),READ AND 04670000
TBF IOBFLG(,XR1),NODTF IS THERE A RELATED DTF ? 04680000
JF DPRCIR NO, JUMP 04690000
SPACE 1 04700000
L TCBSAV(,XR2),XR2 LOAD CURRENT TCB REGS 04710000
CLC IOBDTF(2,XR1),TCBXR2-TCBSAV(,XR2) INDEX IOB ? 04720000
JNE DPRCIR YES, FORGET SQB DEQUEUE 04730000
SPACE 1 04740000
L TCBXR2-TCBSAV(,XR2),XR1 LOAD @ OF THE DTF 04750000
SPACE 1 04760000
TBN DTFATR-1(,XR1),UPDATE IS THIS AN UPDATE DTF 04770000
JF DPRCIR NO, JUMP 04780000
SPACE 1 04790000
TBF DTFATR-1(,XR1),DIRECT IS THIS A DIRECT FILE ? 04800000
TBF DTFATR(,XR1),RANDOM OR A RANDOM FILE ? 04810000
JT DPRCIR JUMP IF NEITHER 04820000
SPACE 1 04830000
*------ IF THE FILE HAS AN SQB, IT MAY NOW BE RELEASED --------------* 04840000
SPACE 1 04850000
L DPPOSS,XR1 PUT THE TCB @ IN XR1 04860000
LA $CCCOM,XR2 LOAD @ OF $CCCCOM 04870000
L @SQB(,XR2),XR2 LOAD @ OF THE FIRST SQB 04880000
SPACE 1 04890000
DPCSQB TBN SQBFLG(,XR2),SQBFRE IS THIS SQB FREE ? 04900000
JT DPNXSQ YES, TRY THE NEXT 04910000
SPACE 1 04920000
CLC SQBIOB(2,XR2),TCBIOB(,XR1) IS THIS SQB OWNED BY THE 04930000
* IOB JUST COMPLETED ? 04940000
JE DPFRSQ YES, GO RELEASE IT 04950000
SPACE 1 04960000
DPNXSQ TBN SQBFLG(,XR2),SQBLST IS THIS THE LAST SQB ? 04970000
LA SQBLN(,XR2),XR2 LOAD @ OF NEXT SQB ANYWAY 04980000
BF DPCSQB NO, GO TEST THIS ONE 04990000
J DPRCIR NO SQB FOUND FOR THIS IOB, JUMP 05000000
SPACE 1 05010000
*------ THE COMPLETED IOB OWNED AN SQB WHICH MAY NOW BE FREED --------* 05020000
SPACE 1 05030000
DPFRSQ B RQDPFR GO TO SQB RELEASE ROUTINE 05040000
* TO FREE THIS SQB AND POST 05050000
* ANY TASKS WAITNG FOR THE 05060000
* ENQUEUED RECORDS 05070000
SPACE 1 05080000
L TCBIOB(,XR1),XR2 LOAD @ OF COMPLETED IOB 05090000
AIF (&D45 NE '1').N45 IS 5445 SUPPORTED ? 05100000
SPACE 1 05110000
DEV45 EQU X'40' 5445 Q-BYTE BIT 05120000
SPACE 1 05130000
TBN IOBQB(,XR2),DEV45 IS THIS A 5445 ? 05140000
JT DPZCHR YES, JUMP 05150000
SPACE 1 05160000
.N45 ANOP 05170000
MVI IOBSB(,XR2),X'FF' PUT BAD SECTOR @ IN IOB 05180000
AIF (&D45 NE '1').O45 SKIP IF NO 5445 SUPPORT 05190000
J DPRCIR JUMP OVER NSI 05200000
SPACE 1 05210000
DPZCHR MVI IOBHH(,XR2),X'FF' PUT BAD HEAD @ IN IOB 05220000
.O45 ANOP 05230000
SPACE 1 05240000
DPRCIR L DPPOSS,XR2 LOAD TCB @ 05250000
SPACE 1 05260000
SPACE 2 05270000
.NSHR ANOP 05280000
SPACE 1 05290000
MVI TCBIOB-1(,XR2),NOBIT RESET TCBIOB @ HIGH BYTE TO ZERO 05300000
SPACE 1 05310000
*------END OF DISK I/O WAIT INVOKING ROUTINE, RECURSE THROUGH DISPATCH 05320000
SPACE 1 05330000
LA $CCCOM,XR2 RESET THE @ OF $CCCOM 05340000
B DPACA GO TO INTERNAL ENTRY POINT 05350000
SPACE 1 05360000
*---------------------------------------------------------------------* 05370000
* END OF DISPATCHERS DISK I/O WAIT TESTING ROUTINE * 05380000
*---------------------------------------------------------------------* 05390000
SPACE 1 05400000
EJECT 05410000
SPACE 1 05420000
*------POST ANY TASKS THAT MIGHT BE AWAITING UNIT RECORD DEVICE ------* 05430000
*------TO BECOME READY/NOT BUSY---------------------------------------* 05440000
SPACE 1 05450000
DPURCK EQU * UNIT RECORD CHECKING ROUTINE 05460000
SBN $DPFLH(,COMREG),DPNTRC+DPPOST INDICATE NO TRACE AND TURN 05470000
* 'OFF' THE POST-DISPATCHABLE 05480000
* TASK-BIT 05490000
BC $CC4PS,BR97 GO POST ALL WAITOR'S FOR READY 05500000
DC AL2(WPBTIO) TIO STATUS BIT MASK 05510000
DC XL2'00FF' GENERAL POST MASK 05520000
SPACE 1 05530000
TBN $DPFLH(,COMREG),DPPOST DID POST MAKE ANY TASK READY? 05540000
AIF (&MIN NE '1').NMIN1 MIN SYS ?? 05550000
SPACE 1 05560000
JF DPRCUR SKIP THE APL AND RECURSE 05570000
APL 0,0 NO, LET OTHER LEVEL RUN 05580000
SPACE 1 05590000
.NMIN1 ANOP 05600000
AIF (&MIN).MIN1 05610000
JF DPRSET YES, RECURSE THRU DISPATCHER 05620000
SPACE 1 05630000
*------INDICATE DISPATCHER IN FINAL HALT PREPARATION LOGIC -----------* 05640000
SPACE 1 05650000
SBN $DPFLH(,COMREG),DPHALT TURN ON HALT PREPARATION BIT 05660000
SPACE 1 05670000
*------DON'T HALT IF ANY INTERRUPTS SINCE LAST TESTS------------------* 05680000
SPACE 1 05690000
TBF #OPEND(,COMREG),ALLBIT ANY OP-ENDS SINCE LAST TESTING? 05700000
TBF $DPFLH(,COMREG),DPCI OR ANY CONSOLE INTERRUPT? 05710000
JF DPRSET YES, DON'T HALT 05720000
SPACE 1 05730000
*------NO INTERRUPTS, PREPARE TO HALT---------------------------------* 05740000
SPACE 1 05750000
SPACE 1 05760000
* PREPARE FOR DISPATCHER'S "NO WORK" HALT 05770000
SPACE 1 05780000
AIF (&MOD4 NE '1').MD430 05781000
* ISSUE THE NO WORK HALT ( A BLANK HPL ) 05782000
SPACE 1 05783000
DP@HPL HPL 0,0 BLANK HPL (NO HALT LIGHTS) 05784000
DPLITE EQU *-1 USE HPL AS WORK FIELD 05785000
AGO .MD440 05786000
.MD430 ANOP 05787000
LA DPHTBL,XR1 XR1 -> FIRST BYTE OF HALT CODES 05790000
SLC DPMVCH+4(1),X$0001(,COMREG) DECR HALT-CODE POINTER BY 1 05800000
JNL DPMVCH IF POINTER > 0, GO MOVE CODE IN 05810000
SPACE 1 05820000
MVI DPMVCH+4,9 HALT-CODE PTR=0 -- RESET TO 9 05830000
SPACE 1 05840000
DPMVCH MVC DP@HPL+2(1),##+9(,XR1) MOVE IN RIGHT HALT CODE 05850000
SPACE 1 05860000
DPENAB JC DP@HPL,BRNOP SET TO SIO IF CCP PRIORITY 05870000
SPACE 1 05880000
* ISSUE THE "NO WORK" HALT -- BLITZ FOLLOWED BY SEQUENTIALLY ADVANCING 05890000
* DECIMAL DIGIT 05900000
SPACE 1 05910000
DP@HPL HPL ##,X'19' HALT -- NO WORK TO DO 05920000
SPACE 1 05930000
DPDISA JC DPRSET,BRNOP SET TO SIO IF CCP PRIORITY 05940000
.MD440 ANOP 05945000
SPACE 1 05950000
DPRSET SBF $DPFLH(,COMREG),DPHALT TURN OFF HALT PREP. 05960000
* FLAG BIT IN $CCCOM 05970000
.MIN1 ANOP 05980000
DPRCUR B DPACA ENTRY HERE WHEN OTHER LEVEL 05990000
* WAITS--RECURSE THROUGH DISPATCH 06000000
AIF (&MOD4).MD460 06005000
@DPACA EQU DPRCUR+3 EQUATE FOR LOAD INSTRUCTION 06010000
AIF (&MIN).NMIN2 MIN-SYS??? 06020000
SPACE 1 06030000
* TABLE OF HALT CODES -- SEQUENCED 6 5 4 3 2 1 0 9 8 7 06040000
SPACE 1 06050000
DPHTBL EQU * HI-ORDER ADDRESS OF TABLE 06060000
DC XL10'7D5D1B5776036F5F7F07' TABLE OF HALT CODES 6543210987 06070000
.NMIN2 ANOP 06080000
.MD460 ANOP 06085000
EJECT 06090000
*********************************************************************** 06100000
* INVOKE A READY USER TASK * 06110000
*********************************************************************** 06120000
SPACE 2 06130000
DPBAC TBN TCBTSK(,TCBREG),TCBRSM IS THIS A SUSPENDED USER TASK 06140000
* TO BE RESUMED BY OPERATOR 06150000
* COMMAND. 06160000
JF DPXIT NO, INVOKE IT NORMALLY 06170000
SBF TCBTSK(,TCBREG),TCBRSM YES, TURN OFF THE SUSPENDED TASK 06180000
* RESUME BIT AND INVOKE TASK VIA 06190000
* THE RESUME INTERRUPTED TASK RTN 06200000
B DPAEA GO TO R.I.T. ROUTINE 06210000
SPACE 2 06220000
*********************************************************************** 06230000
* EXIT TO THE TASK TO BE INVOKED--INPUT TCBREG HAS THE TCB * 06240000
* ADDRESS IN IT * 06250000
*********************************************************************** 06260000
SPACE 2 06270000
DPXIT L X$0000(,COMREG),ARR ZERO THE ARR FOR POSSIBLE COBOL 06280000
* PROGRAM INITIAL ENTRY 06290000
SPACE 1 06300000
DPXITA ST @CURTB(,COMREG),TCBREG SET @ OF CURRENT TCB 06310000
SPACE 2 06320000
*---------------------------------------------------------------------* 06330000
* BECAUSE AN INTERRUPT HANDLING TASK CAN BE BE INVOKED DUE TO * 06340000
* AN INTERRUPT, IT MAY NOT HAVE IT'S DISPATCHABILITY BIT ON. * 06350000
* THEREFORE TURN IT ON PRIOR TO INVOKING THE TASK * 06360000
*---------------------------------------------------------------------* 06370000
SPACE 2 06380000
SBN TCBTSK(,TCBREG),TCBDSP TURN ON DISPATCHABLE BIT 06390000
SPACE 1 06400000
SPACE 1 06410000
MVC $DPFLG(1,COMREG),TCBFLG(,TCBREG) RESTORE THE DISPATCHERS 06420000
* FIRST CONTROL BYTE IN $CCCOM 06430000
* FROM THIS TASKS $DPFLG SAVE BYTE 06440000
SPACE 1 06450000
TBN TCBTSK(,TCBREG),TCBDSV DID DISPATCHER SAVE REGISTERS 06460000
JF DPXITB NO, DON'T DECREMENT SAVE ADDRESS 06470000
SLC TCBSAV(2,TCBREG),LTCBSV DECREMENT THE TCB SAVE @ 06480000
SBF TCBTSK(,TCBREG),TCBDSV SET SAVED INDICATOR OFF 06490000
DPXITB L TCBPSR(,TCBREG),PSR RELOAD THE USER'S PSR 06500000
L TCBSAV(,TCBREG),XR1 GET SAVE AREA @ 06510000
LA TCBXR2-TCBSAV+2(,XR1),XR1 STEP TO @ OF RESUME FIELD 06520000
ST DPLIAR+3,XR1 INITIALIZE THE RESUME INST. 06530000
L TCBXR2-TCBARR(,XR1),XR2 RELOAD REGISTER 2 06540000
L TCBXR1-TCBARR(,XR1),XR1 RELOAD REGISTER 1 06550000
SPACE 1 06560000
DPLIAR L ####,IAR RELOAD THE IAR TO GIVE CONTROL 06570000
* TO THE TASK 06580000
TITLE 'DISK&#.I/O&#.INTERCEPT&#.ROUTINE&#.--&#.$CC4IO' 06590000
*---------------------------------------------------------------------* 06600000
* * 06610000
* TITLE -- CCP DISK I/O INTERCEPT ROUTINE * 06620000
* * 06630000
* NAME -- $CC4IO * 06640000
* * 06650000
* FUNCTION -- * 06660000
* * 06670000
* . TO INTERCEPT ALL ENTRIES TO LOCATION EIGHT WITHIN DSM AND TO * 06680000
* ROUTE THEM TO DISK IOS AND BACK TO THE INVOKER THROUGH * 06690000
* THE CCP DISPATCHER * 06700000
* * 06710000
* OPERATION -- * 06720000
* * 06730000
* . IF DISK ERP IS IN PROCESS ALLOW THE DISK IOS ENTRY TO CONTINUE * 06740000
* WITH NO ACTION TAKEN BY THIS ROUTINE * 06750000
* * 06760000
* . TRACE THE DISK IOS ENTRY VIA CCP TRACE (ID=02) * 06770000
* * 06780000
AIF (&DPF EQ '0').NPDF1 SKIP IF NON-DPF 06790000
* . DETERMINE IF THE ENTRY IS FROM THE NON-CCP PROGRAM LEVEL AND * 06800000
* TAKE NO ACTION IF IT IS * 06810000
* * 06820000
.NPDF1 ANOP 06830000
* . SAVE THE INVOKERS REGISTERS IN THE CURRENT TCB * 06840000
* * 06850000
AIF (&SHR EQ '0').NSHR1 SKIP IF NOT FILE SHARING GEN 06860000
* . IF THE SYSTEM IS A MULTI-TASKING SYSTEM AND THE INPUT IOB * 06870000
* HAS AN ASSOCIATED DTF, GO TO THE FILE SHARING ROUTINE * 06880000
* * 06890000
.NSHR1 ANOP 06900000
* . ALLOW THE DISK IOS REQUEST TO BE SCHEDULED BY INVOKING NCEIOS * 06910000
* BUT FORCING IT TO RETURN TO THIS ROUTINE * 06920000
* * 06930000
AIF (&SHR EQ '0').NSHR2 SKIP IF NOT FILE SHARING 06940000
* . FORCE A DISK WAIT IF THERE IS AN ASSOCIATED DTF * 06950000
* * 06960000
.NSHR2 ANOP 06970000
* . EXIT THROUGH THE DISPATCHER BACK TO THE INVOKER * 06980000
* * 06990000
* ENTRY POINT -- $CC4IO * 07000000
* * 07010000
* INPUT -- THE DISK IOB ADDRESS IN REGISTER ONE * 07020000
* * 07030000
* OUTPUT -- THE APPROPRIATE BITS SET IN $CCCOM $DPFLG TO INDICATE * 07040000
* WHAT ACTION THE DISPATCHER IS TO TAKE WITH THE TASK * 07050000
* * 07060000
* EXTERNAL REFERENCES -- * 07070000
* * 07080000
* . CCP TRACE ROUTINE $CC4TT * 07090000
* * 07100000
AIF (&DPF EQ '0').NDPF3 07110000
* . IAR DETERMINATION ROUTINE (DPTIAR) * 07120000
* * 07130000
.NDPF3 ANOP 07140000
* . CCP REGISTER SAVE ROUTINE (CCPSAV) * 07150000
* * 07160000
* . CURRENT TCB ADDRESS (@CURTB IN $CCCOM) * 07170000
* * 07180000
* . CURRENT TCB TCBTSK BYTE * 07190000
* * 07200000
* . DSM DISK IOS (NCEIOS) * 07210000
* * 07220000
AIF (&SHR EQ '0').NSHR4 SKIP IF NOT FILE SHARING 07230000
* . CCP FILE SHARING ENQUEUE ROUTINE ($CC4DI) * 07240000
* * 07250000
.NSHR4 ANOP 07260000
* . CCP DISPATCHER ($CC4DP) * 07270000
* * 07280000
* EXITS -- * 07290000
* * 07300000
* . TO DISK I/O WAIT (NCEIOW) IF DISK ERP IS IN PROGRESS * 07310000
* * 07320000
* . TO DISK IOS (NCEIOS) IF DISK ERP IS IN PROGRESS * 07330000
* * 07340000
AIF (&DPF EQ '0').NDPF5 SKIP IF NON-DPF 07350000
* . TO DISK IOS (NCEIOS) IF THE CURRENT IAR IS NOT THE CCP IAR * 07360000
* * 07370000
.NDPF5 ANOP 07380000
* . CCP DISPATCHER AFTER SCHEDULING THE DISK I/O * 07390000
* * 07400000
* ATTRIBUTES -- * 07410000
* . RESIDENT, SERIALLY REUSEABLE, GENERATED CODE * 07420000
* * 07430000
*---------------------------------------------------------------------* 07440000
EJECT 07450000
$CC4IO JC IOGOA,BR97 RESET THE FALSE BIT FOR TEST 07460000
SPACE 1 07470000
*---------------------------------------------------------------------* 07480000
* AT ENTRY TO THE CCP INTERCEPT ROUTINE, DETERMINE IF DISK * 07490000
* ERROR RECOVERY PROCEDURES ARE IN PROGRESS. IF YES THEN EXIT * 07500000
*---------------------------------------------------------------------* 07510000
SPACE 2 07520000
IOGOA TBF ####,NCDERP IS DISK ERP IN PROGRESS 07530000
AIF (&DPF).DP8 DPF SYSTEM?? 07540000
JT IONERR NO, CONTINUE 07550000
L SSDIOD,IAR YES, CONTINUE WITHOUT INTERCEPT 07560000
IONERR EQU * 07570000
AGO .DP9 07580000
.DP8 ANOP 07590000
JF IOEXBC YES, EXIT TO DISK IOS 07600000
.DP9 ANOP 07610000
SPACE 1 07620000
*------DISK ERP NOT ACTIVE, CONTINUE WITH INTERCEPT HANDLING----------* 07630000
SPACE 1 07640000
ST CCARR,ARR STORE THE ARR FOR TRACE + USER 07650000
AIF (&DPF NE '1').DP10 07700000
SPACE 1 07710000
B DPTIAR DETERMINE IF THIS IS CCP 07720000
JE IOA YES, IS CCP CALLING 07730000
SPACE 1 07740000
*------NOT CCP ENTERING OR DISK ERP NOT IN PROGRESS, PROCEED WITH ----* 07750000
*------OTHER LEVEL I/O REQUEST IF BOTH CCP TRANSIENT AREAS FREE. IF---* 07760000
*------DISK I/O REQUEST IS FOR PROGRAM SPINDLE AND CCP IS NOT IN DSM--* 07770000
*------APL BACK TO CCP TO PREVENT DISK ARM CONTENTION ----------------* 07780000
SPACE 1 07790000
L CCARR,ARR RESTORE THE INPUT ARR 07800000
SPACE 1 @10 07801000
* **** BEFORE DEFERRING NON-CCP I/O, CHECK TO SEE IF STARTED IN @10 07802000
* **** SUPERVSIOR. IF IT IS, DO NOT DEFER, BUT START IMMEDIATELY. @10 07803000
SPACE 1 @10 07804000
CLC CCARR(2),#### I/O REQUEST FROM SUPERVISOR? @10 07805000
SUPEND EQU *-1 BEGINNING OF PLCA 1. @10 07806000
JL IOEXBC YES, GO START THE I/O REQUEST@10 07807000
SPACE 1 @10 07808000
EXTRN TACBF1 EXTERN FOR TRANSIENT AREA CHECK 07810000
EXTRN TACBF2 EXTERN FOR TRANSIENT AREA CHECK 07820000
TAVAIL EQU BIT0 IF ON, T.A. IS AVAILABLE 07830000
MZZ IOQSTS+1,IOBQB(,XR1) OBTAIN Q-CODE OF I/O REQUEST 07840000
MZZ IOQTST+1,IOBQB(,XR1) OBTAIN Q-CODE OF I/O REQUEST 07850000
IOAGIN APL 0 GO TO CCP LEVEL 07860000
SPACE 1 07870000
TBN CCDPFH,DPDSX DOES CCP NEED DSM T.A. ? 07880000
JF IOCTAT NO, JUMP 07890000
SPACE 1 07900000
IOTAST TBN ####,## DOES OTHER LEVEL OWN DSM T.A? 07910000
JT IOEXBC YES, LET I/O REQUEST PASS 07920000
SPACE 1 07930000
IOQSTS CLI IOSYSQ,## ARM CONTENTION FOR SYS PACK ? 07940000
JE IONOLQ YES, HOLD REQUEST UNTIL CCP THRU 07950000
SPACE 1 07960000
IOCTAT TBN TACBF1,TAVAIL Q-THIS CCP TRANSIENT AREA FREE? 07970000
TBN TACBF2,TAVAIL Q-THIS CCP TRANSIENT AREA FREE? 07980000
JT IOEXBC GO TO IOS ONLY IF BOTH ARE FREE 07990000
SPACE 1 08000000
IOQTST CLI IOPGMQ,## ARM CONTENTION FOR PGM PACK ? 08010000
JNE IOEXBC NO, LET I/O REQUEST PASS 08020000
SPACE 1 08030000
IONOLQ L IOLOOP,IAR SET IAR FOR LOOP BACK 08040000
SPACE 1 08050000
IOPGMQ DC AL1(##) STORAGE FOR Q BYTE CHECK 08060000
IOSYSQ DC AL1(##) STORAGE FOR Q BYTE CHECK 08070000
IOLOOP DC AL2(IOAGIN) SET UP FOR RETURN LOOP 08080000
SPACE 1 08090000
IOEXBC L SSDIOD,IAR PROCEED TO DISK IOS ROUTINE 08100000
SPACE 1 08110000
*------IS CCP ROUTINE THAT HAS BEEN INTERCEPTED-----------------------* 08120000
.DP10 ANOP 08130000
IOA EQU * 08131000
AIF (&UR41 EQ '0').DP15 3741 SUPPORT? 08132000
TBN IOBQB(,XR1),X'40' 3741 IOB? 08133000
TBF IOBQB(,XR1),X'B8' YES? 08134000
JF IOA41 NO, GO AROUND 08135000
L CCARR,ARR YES, DO NOT PROCESS 08136000
L SSDIOD,IAR THIS REQUEST 08137000
IOA41 EQU * 08138000
.DP15 ANOP 08139000
SPACE 1 08140000
B $CC4TT INVOKE CCP TRACE 08142000
DC AL1(TTIOD) TRACE ID FOR DISK I/O DISPATCH 08144000
* ENTRY 08146000
B CCPSAV SAVE INPUT REGISTERS 08150000
SPACE 1 08160000
AIF (&SHR NE '1').DP20 FILE SHARING SYSTEM??? 08170000
SPACE 1 08180000
*------GO TO FILE SHARE IF DTF EXISTS FOR THE IOB---------------------* 08190000
SPACE 1 08200000
TBF IOBFLG(,XR1),NODTF ANY DTF FOR THIS IOB? 08210000
BT $CC4DI GO TO FILE SHARE MODULE IF YES 08220000
SPACE 1 08230000
*------------END OF FILE SHARING LOGIC--------------------------------* 08240000
.DP20 ANOP 08250000
SPACE 1 08260000
L CCURTB,XR2 CCP LEVEL, GET CURRENT TCB @ 08270000
SBN TCBTSK(,XR2),TCBDSV SET DISPATCHER SAVED REGS BIT-1 08280000
SPACE 1 08290000
IOAA B #### GO TO DISK IOS 08300000
SSDIOD EQU IOAA+3 *S* @ OF DSM IOS EPA 08310000
SPACE 1 08320000
AIF (&SHR).DP22 FILE SHARING SUPPORT ? 08330000
J IORET RETURN TO INVOKER 08340000
AGO .DP23 08350000
.DP22 ANOP 08360000
TBN IOBFLG(,XR1),NODTF ANY DTF FOR THIS IOB?? 08370000
JT IORET YES, SKIP FORCING A WAIT 08380000
J DWTRCW GO FORCE TASK TO WAIT 08390000
.DP23 ANOP 08400000
SPACE 2 08410000
*********************************************************************** 08420000
* END OF DIODSP ROUTINE * 08430000
*********************************************************************** 08440000
TITLE 'DISK&#.WAIT&#.INTERCEPT&#.ROUTINE&#.--&#.$CC4IW' 08450000
*---------------------------------------------------------------------* 08460000
* * 08470000
* TITLE -- CCP DISK I/O WAIT INTERCEPT ROUTINE * 08480000
* * 08490000
* NAME -- $CC4IW * 08500000
* * 08510000
* FUNCTION -- * 08520000
* * 08530000
* . TO INTERCEPT ALL ENTRIES TO LOCATION TWELVE WITHIN DSM AND TO * 08540000
* ROUTE THEM TO DISK I/O WAIT AND BACK TO THE INVOKER THROUGH * 08550000
* THE CCP DISPATCHER * 08560000
* * 08570000
* OPERATION -- * 08580000
* * 08590000
* . IF DISK ERP IS IN PROCESS ALLOW THE WAIT ENTRY TO CONTINUE * 08600000
* WITH NO ACTION TAKEN BY THIS ROUTINE * 08610000
* * 08620000
* . IF THE IOB IS MARKED COMPLETE, DON'T TRACE THE ENTRY * 08630000
* * 08640000
* . TRACE THE DISK WAIT ENTRY VIA CCP TRACE (ID=03) * 08650000
* * 08660000
AIF (&DPF EQ '0').NPDF6 SKIP IF NON-DPF 08670000
* . DETERMINE IF THE ENTRY IS FROM THE NON-CCP PROGRAM LEVEL AND * 08680000
* TAKE NO ACTION IF IT IS * 08690000
* * 08700000
.NPDF6 ANOP 08710000
* . SAVE THE INVOKERS REGISTERS IN THE CURRENT TCB * 08720000
* * 08730000
* . IF THE IOB IS MARKED COMPLETE, DON'T CAUSE THE TASK TO WAIT, * 08740000
* ELSE INDICATE TO THE DISPATCHER THAT THE TASK IS TO WAIT * 08750000
* FOR DISK I/O COMPLETE * 08760000
* * 08770000
* . EXIT TO THE CCP DISPATCHER VIA WAIT ($CC4WT) * 08780000
* * 08790000
* ENTRY POINT -- $CC4IW * 08800000
* * 08810000
* INPUT -- THE DISK IOB ADDRESS IN REGISTER ONE * 08820000
* * 08830000
* OUTPUT -- THE APPROPRIATE BITS SET IN $CCCOM $DPFLG TO INDICATE * 08840000
* WHAT ACTION THE DISPATCHER IS TO TAKE WITH THE TASK * 08850000
* * 08860000
* EXTERNAL REFERENCES -- * 08870000
* * 08880000
* . CCP TRACE ROUTINE $CC4TT * 08890000
* * 08900000
AIF (&DPF EQ '0').NDPF7 08910000
* . IAR DETERMINATION ROUTINE (DPTIAR) * 08920000
* * 08930000
.NDPF7 ANOP 08940000
* . CCP REGISTER SAVE ROUTINE (CCPSAV) * 08950000
* * 08960000
* . CURRENT TCB ADDRESS (@CURTB IN $CCCOM) * 08970000
* * 08980000
* . CURRENT TCB TCBTSK BYTE * 08990000
* * 09000000
* EXITS -- * 09010000
* * 09020000
* . DSM DISK I/O WAIT ROUTINE (NCEIOW) * 09030000
* * 09040000
* . CCP DISPATCHER ($CC4DP) * 09050000
* * 09060000
AIF (&DPF EQ '0').NDPF8 SKIP IF NON-DPF 09070000
* . TO DISK I/O WAIT (NCEIOW) IF THE CURRENT IAR IS NOT THE CCP IAR* 09080000
* * 09090000
.NDPF8 ANOP 09100000
* . CCP DISPATCHER TO CAUSE THE TASK TO WAIT/EXIT * 09110000
* * 09120000
* ATTRIBUTES -- * 09130000
* * 09140000
* . RESIDENT, SERIALLY REUSEABLE, GENERATED CODE * 09150000
* * 09160000
*---------------------------------------------------------------------* 09170000
EJECT 09180000
$CC4IW JC IWGOA,BR97 RESET THE FALSE BIT FOR TEST 09190000
SPACE 1 09200000
*---------------------------------------------------------------------* 09210000
* AT ENTRY TO THE CCP INTERCEPT ROUTINE, DETERMINE IF DISK * 09220000
* ERROR RECOVERY PROCEDURES ARE IN PROGRESS. IF YES THEN EXIT * 09230000
*---------------------------------------------------------------------* 09240000
SPACE 2 09250000
IWGOA TBF ####,NCDERP IS DISK ERP IN PROGRESS 09260000
AIF (&DPF).DP30 DPF SYSTEM?? 09270000
JT IWNERR NOT IN DISK ERP 09280000
L @DWT1,IAR IS IN DISK ERP, CONTINUE TO IOS 09290000
IWNERR EQU * NOT IN DISK ERP 09300000
AGO .DP31 09310000
.DP30 ANOP 09320000
JF IWEXC YES, EXIT TO DISK IOS 09330000
.DP31 ANOP 09340000
SPACE 1 09350000
*------DISK ERP NOT ACTIVE, CONTINUE WITH INTERCEPT HANDLING----------* 09360000
SPACE 1 09370000
ST CCARR,ARR SAVE INPUT ARR 09380000
SPACE 1 09470000
IWNTRC EQU * EQUATE FOR NO TRACE JUMP 09510000
SPACE 1 09520000
AIF (&DPF NE '1').DP35 DPF SYSTEM ?? 09530000
B DPTIAR GO SEE IF THIS IS CCP ENTERING 09540000
JE DWTA YES 09550000
SPACE 1 09560000
*------NOT CCP IAR, EXIT AND PROCEED TO DPF'S DISK WAIT REQUEST-------* 09570000
SPACE 1 09580000
L CCARR,ARR RESTORE THE ARR FOR CONTINUATION 09590000
APL 0 LET CCP LEVEL RUN 09600000
IWEXC L @DWT1,IAR PROCEED TO DISK IOS WAIT ROUTINE 09610000
SPACE 1 09620000
.DP35 ANOP 09630000
SPACE 2 09640000
*********************************************************************** 09650000
* CCP ENTRY PROCESS * 09660000
*********************************************************************** 09670000
SPACE 2 09680000
DWTA EQU * 09680700
AIF (&UR41 EQ '0').DP37 3741 SUPPORT? 09681400
TBN IOBQB(,XR1),X'40' YES, IS THIS A 3741 IOB? 09682100
TBF IOBQB(,XR1),X'B8' IS IT READ OR WRITE? 09682800
JF DW3741 NO, JUMP AROUND 09683500
L CCARR,ARR YES, DONT PROCESS THIS 09684200
L @DWT1,IAR REQUEST 09684900
DW3741 EQU * 09685600
.DP37 ANOP 09686300
B $CC4TT INVOKE CCP TRACE 09687000
DC AL1(TTIOW) TRACE ID FOR DISK WAIT INTERCEPT 09687700
SPACE 1 09688400
B CCPSAV GO SAVE REGISTERS IN TCB 09690000
SPACE 1 09700000
L CCURTB,XR2 GET @ OF CURRENT TCB 09710000
SBN TCBTSK(,XR2),TCBDSV INDICATE THAT DISPATCHER SAVED 09720000
* SO THAT THEY WILL BE RESTORED 09730000
TBN IOBCMP(,XR1),BIT1 IS THIS IOB MARKED COMPLETE 09740000
TBF IOBCMP(,XR1),BIT0+BIT2+BIT3 WAS THE IOB WAITED ? 09750000
JF DWTACA NO, PUT INTO WAIT 09760000
SPACE 1 09770000
*------END OF INTERCEPT FOR DISK IOS, RETURN TO USER PROGRAM----------* 09780000
SPACE 2 09790000
IORET SBN CCDPFL,DPXSMC SET EXIT INTERCEPT BIT 09800000
IORETA SBF CCDPFL,DPREG+DPDSP SET REG + DISP BITS OFF 09810000
SBN CCDPFH,DPNTRC DON'T HAVE THIS DISP. ENTRY 09820000
* TRACED 09830000
B $CC4DP EXIT VIA DISPATCHER 09840000
SPACE 1 09850000
SPACE 1 09860000
SPACE 1 09870000
DWTACA SBN CCDPFH,DPNTRC DON'T TRACE WAIT ENTRY TO $CC4DP 09880000
DWTRCW ST TCBIOB(,XR2),XR1 SAVE THE @ OF THE WAITED ON IOB 09890000
SBF CCDPFL,DPREG MAKE SURE THAT REGS AREN'T SAVED 09900000
SPACE 2 09910000
*------GO TO CCP WAIT ROUTINE TO WAIT ON DISK I/O COMPLETION----------* 09920000
SPACE 2 09930000
DWTAC B $CC4WT EXIT VIA CCP WAIT ROUTINE 09940000
DC AL2(256*WPADIO) DISK WAIT MASK DEFINITION 09950000
DC IL1'1' WAIT COUNT OF ONE 09960000
DWWTFL DC AL1(DPDSP) TURN ON TO FORCE A WAIT FOR THIS 09970000
* TASK CONTROL BLOCK 09980000
SPACE 2 09990000
AIF (&DPF NE '1').DP40 DPF SYSTEM ?? 10000000
TITLE 'CCP&#.-&#.NON&#.CCP&#.IAR&#.DETERMINATION&#.ROUTINE' 10010000
*---------------------------------------------------------------------* 10020000
* ROUTINE TO DETERMINE IF THE CURRENT IAR IS FOR CCP OR NOT * 10030000
* IF YES, THE ROUTINE WILL SET THE EQUAL BIT OF THE PSR ON * 10040000
* IF NOT, THE EQUAL BIT OF THE PSR WILL BE OFF * 10050000
*---------------------------------------------------------------------* 10060000
SPACE 2 10070000
SPACE 2 10080000
DPTIAR ST DPTIEX+3,## STORE CCP'S IAR VALUE 10090000
DPIARQ EQU DPTIAR+1 EQUATE FOR Q-BYTE EXTRN 10100000
DPTIMY CLC DPTIEX+3(2),DPTICI IS THIS THE CCP ENTERING 10110000
ST DPTIEX+3,ARR SAVE RETURN ADDRESS 10120000
DPTIEX B #### RETURN TO INVOKER 10130000
* EQUAL IF CCP IS ACTIVE PROGRAM LEVEL 10140000
* NOT EQUAL IF NOT CCP ACTIVE 10150000
SPACE 1 10160000
DPTICI DC AL2(DPTIMY) @ OF COMPARE INSTRUCT FOR 10170000
* ACTIVE IAR VALUE 10180000
SPACE 1 10190000
*------END OF CCP IAR DETERMINATION ROUTINE---------------------------* 10200000
SPACE 2 10210000
.DP40 ANOP 10220000
* END MACRO $E040 1/7/73 10230000
* END OF CCP DISPATCHER $CC4DP 10240000
MEND 10250000