|
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: 29718 (0x7416)
Types: s3xseg
Names: »S$E050«
└─⟦827b5bd03⟧ Bits:30009184 5702-sc1.V16.ccp
└─⟦f17e99db6⟧
└─⟦this⟧ »S$E050«
MACRO 00010000
.********************************************************************** 00020000
.* * 00030000
.* NAME: $E050 * 00040000
.* * 00050000
.* MODIFICATION LEVEL: VERSION 10 MODIFICATION LEVEL 14 OF 5702-SC1 * 00060000
.* * 00070000
.* FUNCTION: * 00080000
.* * 00090000
.* . CCP GENERATION SECOND PASS MACRO-INSTRUCTION -- GENERATE * 00100000
.* GENERAL ENTRY INTERCEPT LOGIC IN MODULE $CC4#1 OF CCP RESIDENT * 00110000
.* ROUTINE. * 00120000
.* * 00130000
.* INPUT: * 00140000
.* * 00150000
.* . GLOBAL BOOLEAN VARIABLES: * 00160000
.* * 00170000
.* . &DPF -- 1=DPF SYSTEM / 0=NOT DPF SYSTEM * 00180000
.* * 00190000
.* . &DFF -- 1=DISPLAY FORMAT FACILITY IN SYSTEM / 0=NOT * 00200000
.* * 00210000
.* . SYMBOLIC PARAMETER: * 00220000
.* * 00230000
.* . &RPG -- 1=RPG II SUPPORTED IN SYSTEM / 0=NOT SUPPORTED * 00240000
.* * 00250000
.********************************************************************** 00260000
$E050 &RPG-0 00270000
.* 00280000
GBLB &DPF . DUAL PROGRAM FEATURE 00290000
.* . 1=SUPPORTED / 0=NOT 00300000
.* 00310000
GBLB &MOD4 . MODEL 4 SYSTEM 00312000
.* . 1=SUPPORTED / 0=NOT 00314000
.* 00316000
GBLB &DFF . DISPLAY FORMAT FACILITY 00320000
.* . 1=SUPPORTED / 0=NOT 00330000
.* 00340000
LCLC &# . USED FOR SINGLE BLANK 00350000
.* 00360000
TEXT 00370000
.* 00380000
&# SETC ' ' . SINGLE BLANK 00390000
.* 00400000
TITLE 'GENERAL&#.ENTRY&#.INTERCEPT' 00410000
*********************************************************************** 00420000
* G E N E R A L E N T R Y I N T E R C E P T * 00430000
*********************************************************************** 00440000
* * 00450000
* FUNCTION: * 00460000
* * 00470000
* . INTERCEPT *ALL* INVOCATIONS OF DSM GENERAL ENTRY (BRANCHES TO * 00480000
* LOCATION 4). THE PRIMARY PURPOSE OF THE INTERCEPT IS TO * 00490000
* ASSURE THE SERIAL USE, BY THE CCP PROGRAM LEVEL, OF THE * 00500000
* NON-REENTRANT DSM SUPERVISOR. * 00510000
.* 00520000
AIF (&DPF NE '1').IG010 . SKIP IF NO DPF SUPPORT 00530000
.* 00540000
* * 00550000
* . IF THE INVOCATION IS FROM THE OTHER PROGRAM LEVEL, PASS IT ON * 00560000
* DIRECTLY TO DSM GENERAL ENTRY. * 00570000
.* 00580000
.IG010 ANOP . CONTINUE HERE 00590000
.* 00600000
* * 00610000
* . FOR RIB OF X'00' FROM CCP PROGRAM LEVEL, PROVIDE IN INDEX * 00620000
* REGISTER 2 THE ADDRESS OF THE CCP PROGRAM LEVEL COMMUNICATION * 00630000
* AREA. * 00640000
* * 00650000
* . IF THE INVOCATION IS A HALT/SYSLOG REQUEST, HANDLE IT VIA THE * 00660000
* CCP SUBSTITUTE HALT/SYSLOG PROCESSOR. * 00670000
* * 00680000
* . IF THE INVOCATION IS FROM WITHIN THE DSM SUPERVISOR'S OWN * 00690000
* MAIN STORAGE AREA: * 00700000
* * 00710000
* . DETERMINE IF DISK ERROR LOG REQUEST; IF SO, SET ON THE * 00720000
* ERROR-LOG-IN-PROGRESS BIT IN THE SYSTEM COMMUNICATION * 00730000
* AREA. * 00740000
* * 00750000
* . IN ANY CASE, PASS THE INVOCATION ON TO DSM GENERAL * 00760000
* ENTRY. * 00770000
* * 00780000
* . FOR RIB INDICATING PROGRAM LOAD/FETCH, MODIFY THOSE FIELDS IN * 00790000
* THE PLCA WHICH CONTROL RELOCATION, AND PASS ON THE INVOCATION * 00800000
* TO DSM GENERAL ENTRY. * 00810000
* * 00820000
* . FOR A RIB REQUESTING TRANSIENT BY C/S/N, PASS THE INVOCATION * 00830000
* ON TO DSM GENERAL ENTRY. * 00840000
* * 00850000
* . FOR RIB INDICATING REQUEST FOR SPECIFIC TRANSIENT, PASS THE * 00860000
* INVOCATION DIRECTLY ON TO GENERAL ENTRY UNLESS: * 00870000
* * 00880000
* . OPEN/CLOSE/ALLOCATE -- PASS INVOCATION TO CCP DATA * 00890000
* MANAGEMENT ROUTINE $CC4OC. * 00900000
* * 00910000
* . EOJ -- PASS INVOCATION TO CCP TERMINATION INTERFACE * 00920000
* ROUTINE CC4TI1. * 00930000
.* 00940000
AIF (&RPG NE '1').IG020 . SKIP IF RPG NOT SUPPORTED 00950000
.* 00960000
* . RPG HALT PROCESSOR -- PASS INVOCATION TO SUBSTITUTE RPG * 00970000
* HALT PROCESSOR TRANSIENT. * 00980000
.* 00990000
.IG020 ANOP . CONTINUE HERE 01000000
.* 01010000
* * 01020000
* . FOR A RIB OF X'01' -- REQUEST CCP SERVICE -- ROUTE CONTROL * 01030000
* ACCORDING TO SUB-RIB (BYTE FOLLOWING RIB): * 01040000
* * 01050000
* . 00 -- COMMUNICATIONS OPERATION REQUEST -- ROUTE TO * 01060000
* $CC4II. * 01070000
* * 01080000
* . 01 -- CANCEL CURRENT TASK -- ROUTE TO CC4TI2. * 01090000
.* 01100000
AIF (&RPG NE '1').IG030 . SKIP IF RPG NOT SUPPORTED 01110000
.* 01120000
* * 01130000
* . 02 -- GENERALIZED MOVE REQUEST -- ROUTE TO $CC4MX. * 01140000
.* 01150000
.IG030 ANOP . CONTINUE HERE 01160000
.* 01170000
* * 01180000
* ENTRY POINT: IGNTRY * 01190000
* * 01200000
* INPUT: RIB -- AND POSSIBLY SUB-RIB -- AS DESCRIBED ABOVE * 01210000
* * 01220000
* OUTPUT: * 01230000
* * 01240000
* . IN $CCCOM -- BIT DPDSX IN BYTE $DPFLH SET ON AND OFF TO * 01250000
* INDICATE DSM GENERAL ENTRY IS / IS NOT BUSY FOR THE PROGRAM * 01260000
* LEVEL. * 01270000
* * 01280000
* . IN SYSTEM COMMUNICATION AREA -- BIT NCDERP IN BYTE NCMBSV SET * 01290000
* ON WHEN DISK ERROR LOGGING IS REQUESTED. * 01300000
* * 01310000
* . IN PROGRAM LEVEL COMMUNICATION AREA -- THE CELLS NPQ, NPCYL, * 01320000
* AND NPRLF ON A PROGRAM LOAD/FETCH REQUEST. * 01330000
* * 01340000
* EXTERNAL REFERENCES: * 01350000
* * 01360000
* . TO CCP ROUTINES: * 01370000
* * 01380000
* . CCPSAV/CCPRST -- FOR SAVING REGISTERS / RESTORING * 01390000
* REGISTERS * 01400000
.* 01410000
AIF (&DPF NE '1').IG040 . SKIP IF DPF NOT SUPPORTED 01420000
.* 01430000
* * 01440000
* . DPTIAR -- FOR DETERMINING WHETHER THE INVOCATION IS * 01450000
* FROM THE CCP LEVEL OR THE OTHER LEVEL * 01460000
.* 01470000
.IG040 ANOP . CONTINUE HERE 01480000
.* 01490000
* * 01500000
* . $CC4WT -- TO WAIT THE INVOKING TASK WHEN DSM GENERAL * 01510000
* ENTRY IS BUSY FOR THE PROGRAM LEVEL * 01520000
* * 01530000
* . $CC4PS -- TO POST ANY WAITING TASK THAT DSM GENERAL * 01540000
* ENTRY HAS BECOME AVAILABLE * 01550000
* * 01560000
* . $CC4H1 -- CCP TRANSIENT -- FOR HALT/SYSLOG REQUEST FROM * 01570000
* OTHER THAN THE COMMUNICATIONS TASK * 01580000
* * 01590000
* . $CC4H2 -- CCP TRANSIENT -- FOR HALT/SYSLOG REQUEST FROM * 01600000
* THE COMMUNICATIONS TASK * 01610000
.* 01620000
AIF (&RPG NE '1').IG050 . SKIP IF RPG NOT SUPPORTED 01630000
.* 01640000
* * 01650000
* . $CC4HF -- CCP TRANSIENT -- FOR INVOCATION OF RPG HALT * 01660000
* PROCESSOR * 01670000
.* 01680000
.IG050 ANOP . CONTINUE HERE 01690000
.* 01700000
* * 01710000
* . TO CCP SERVICE ROUTINES AS DEFINED UNDER 'FUNCTION' * 01720000
* ABOVE * 01730000
* * 01740000
* EXIT, NORMAL: * 01750000
* * 01760000
* . AS DEFINED IN 'FUNCTION' ABOVE -- ULTIMATELY TO INVOKER * 01770000
* AT INSTRUCTION IMMEDIATELY FOLLOWING HIS BRANCH. * 01780000
* * 01790000
* EXIT, ERROR: * 01800000
* * 01810000
* . TO THE CCP ROUTINE CC4TI2, WITH A TASK COMPLETION CODE OF * 01820000
* X'80' IF A CCP SERVICE REQUEST WAS MADE WITH INVALID SUB-RIB. * 01830000
* * 01840000
* . TO THE CCP ROUTINE CC4TI2, WITH A TASK COMPLETION CODE SET BY * 01850000
* THE SUBSTITUTE HALT/SYSLOG PROCESSOR, WHEN THE TASK HAS * 01860000
* HALTED INVALIDLY. * 01870000
* * 01880000
* TABLES/WORKAREAS: * 01890000
* * 01900000
* . IGRTBL -- TABLE OF RIBS FOR WHICH SPECIAL ROUTING IS MADE, * 01910000
* WITH ADDRESS TO WHICH EACH IS TO BE ROUTED. * 01920000
* * 01930000
* . IGSTBL -- TABLE OF SUB-RIBS FOR CCP SERVICE REQUEST, WITH * 01940000
* ADDRESS OF ROUTINE TO WHICH EACH IS TO BE ROUTED. * 01950000
* * 01960000
*********************************************************************** 01970000
EJECT 01980000
*********************************************************************** 01990000
* I N I T I A L I Z A T I O N * 02000000
*********************************************************************** 02010000
SPACE 2 02020000
$CC4IG EQU * SECTION NAME 02030000
SPACE 1 02040000
* POINTER CONSTANTS -- THESE REPRESENT, RESPECTIVELY: 02050000
* 02060000
* . THE ADDRESS OF THE REAL ENTRY POINT OF THIS ROUTINE 02070000
* . THE ADDRESS OF THE LOCATION IN THIS ROUTINE IN WHICH IS TO BE 02080000
* STORED THE ADDRESS OF TRUE GENERAL ENTRY 02090000
SPACE 1 02100000
DC AL2(IGNTRY) ADDRESS OF $CC4IG REAL ENTRY 02110000
DC AL2(IG@ENT) ADDRESS OF TRUE NCENTR ADDRESS 02120000
SPACE 1 02130000
* EFFECTIVE ENTRY POINT OF THE INTERCEPT 02140000
SPACE 1 02150000
IGNTRY EQU * TRUE ENTRY POINT OF THIS ROUTINE 02160000
SPACE 1 02170000
ST CCARR,ARR SAVE THE ARR FIRST 02180000
.* 02190000
AIF (&DPF NE '1').IG110 . SKIP IF DPF *NOT* SUPPORTED 02200000
.* 02210000
SPACE 1 02220000
* IF THIS IS FROM THE *OTHER* LEVEL IN A DPF MACHINE, ROUTE DIRECTLY 02230000
* TO TRUE GENERAL ENTRY 02240000
SPACE 1 02250000
B DPTIAR RETURNS EQUAL IF IN *CCP* LEVEL 02260000
L CCARR,ARR RESTORE ARR CONTENTS 02270000
JNE IGSENT JUMP IF FROM *OTHER* LEVEL 02280000
.* 02290000
.IG110 ANOP . CONTINUE HERE 02300000
.* 02310000
SPACE 1 02320000
* IF THE RIB IS X'00' -- REQUEST ADDRESS OF PLCA -- PROVIDE THE ADDRESS 02330000
* DIRECTLY, THEN BEGIN RETURN TO INVOKER 02340000
SPACE 1 02350000
ST IGTR00+3,ARR SET ADDRESS OF RIB FOR COMPARE 02360000
IGTR00 CLI ####,X'00' SEE IF RIB IS X'00' 02370000
JNE IGN00 JUMP IF *NOT* REQUEST PLCA ADDR 02380000
SPACE 1 02390000
ALC CCARR(2),CC0001 ADVANCE RETURN ADDRESS 02400000
L CC@PCA,XR2 XR2 -> PLCA 02410000
L CCARR,IAR RETURN TO INVOKER WITH PLCA ADDR 02420000
SPACE 1 02430000
IGN00 EQU * CONTINUE IF RIB *NOT* X'00' 02440000
SPACE 1 02450000
* SAVE THE INVOKER'S REGISTERS, THEN ESTABLISH REGISTERS FOR THE 02460000
* REMAINDER OF INITIALIZATION: 02470000
* 02480000
* . XR2 -> CURRENT SAVE LEVEL IN INVOKER'S TASK CONTROL BLOCK 02490000
* . XR1 -> INVOKER'S RIB 02500000
SPACE 1 02510000
BC CCPSAV,X'97' SAVE INVOKER'S REGISTERS 02520000
SPACE 1 02530000
* TRACE THIS ENTRY -- TRACE TYPE IS "05" 02540000
SPACE 1 02550000
B $CC4TT TRACE GENERAL ENTRY 02560000
DC XL1'05' TRACE TYPE IS "05" 02570000
SPACE 1 02580000
LA $CCCOM,XR1 XR1 -> CCP COMMUNICATION AREA 02590000
IG@COM EQU *-1 02600000
L @CURTB(,XR1),XR2 XR2 -> INVOKER'S TCB 02610000
L TCBSAV(,XR2),XR2 XR2 -> CURRENT TCB SAVE LEVEL 02620000
L TCBARR-TCBSAV(,XR2),XR1 XR1 -> INVOKER'S RIB 02630000
SPACE 1 02640000
* IF THE INVOCATION IS A HALT/SYSLOG REQUEST, ROUTE CONTROL TO THE 02650000
* SPECIAL HALT/SYSLOG INTERFACE, AFTER SETTING THE TRANSIENT 02660000
* NUMBER ACCORDING TO INVOKING TASK 02670000
SPACE 1 02680000
CLI 0(,XR1),X'85' NORMAL HALT/SYSLOG REQUEST? 02690000
JE IGHS JUMP IF IT IS 02700000
CLI 0(,XR1),X'C5' HALT/SYSLOG REQUEST WITH REFRESH 02710000
JNE IGNHS JUMP IF IT IS *NOT* 02720000
SPACE 1 02730000
IGHS L CCURTB,XR1 XR1 -> INVOKER'S TCB 02740000
MVI IGHSX,CC4H1 SET TRANSIENT NUMBER FOR NON-CM 02750000
CLI TCBID(,XR1),C'C' SEE IF COMMUNICATIONS TASK 02760000
JNE IGHNCM JUMP IF *NOT* COMMUNICATIONS TSK 02770000
MVI IGHSX,CC4H2 SET TRANSIENT NUMBER FOR CM TASK 02780000
SPACE 1 02790000
IGHNCM LA IG@HS,XR1 XR1 -> HALT/SYSLOG INTERFACE 02800000
B IGSET@ JUMP TO RESTORE AND ENTER I'FACE 02810000
IGNHS EQU * CONTINUE HERE IF NOT HALT/SYSLOG 02820000
SPACE 1 02830000
* IF INVOCATION FROM WITHIN THE DSM SUPERVISOR ITSELF (OTHER THAN 02840000
* HALT/SYSLOG REQUEST), SET DISK-ERROR-LOGGING IN PROGRESS 02850000
* IF RIB X'D0', THEN IN ANY CASE ENTER DSM SUPERVISOR DIRECTLY 02860000
SPACE 1 02870000
ST IGSVD0+3,XR1 SAVE ADDRESS OF RIB 02880000
CLC TCBARR-TCBSAV(2,XR2),IG@COM COMPARE INVOKER ARR TO $CCCOM 02890000
JNL IGTCPF JUMP IF NOT WITHIN SUPERVISOR 02900000
SPACE 1 02910000
CLI 0(,XR1),X'D0' SEE IF DISK-ERROR-LOG RIB 02920000
JNE IGND0 JUMP IF *NOT* DISK-ERROR-LOG 02930000
SPACE 1 02940000
L NCSYS@,XR1 XR1 -> SYSTEM COMMUNICATION AREA 02950000
SBN NCMBSV(,XR1),NCDERP SET DISK ERP LOG IN PROGRESS 02960000
IGND0 L CCURTB,XR1 XR1 -> CURRENT TASK'S TCB 02970000
TBN TCBTSK(,XR1),TCBDSM DETERMINE IF TASK IN SUPVR 02980000
IGSVD0 LA ####,XR1 RESTORE XR1 IN ANY CASE 02990000
JF IGOTHR JUMP IF *NOT* IN SUPVR 03000000
SPACE 1 03010000
B CCPRST RESTORE INVOKER'S REGISTERS 03020000
IGSENT L IG@ENT,IAR ENTER TRUE GENERAL ENTRY 03030000
SPACE 1 03040000
* ENTRY *NOT* FROM WITHIN DSM SUPERVISOR -- DETERMINE WHETHER ENTRY 03050000
* FOR DSM FUNCTION OR CCP FUNCTION 03060000
SPACE 1 03070000
IGTCPF CLI 0(,XR1),X'01' SEE IF RIB FOR CCP FUNCTION 03080000
JNE IGOTHR JUMP IF *NOT* CCP FUNCTION 03090000
EJECT 03100000
*********************************************************************** 03110000
* R I B 0 1 -- R E Q U E S T C C P F U N C T I O N * 03120000
*********************************************************************** 03130000
SPACE 2 03140000
* RIB IS X'01' -- REQUEST CCP FUNCTION -- SUB-RIB IMMEDIATELY FOLLOWS 03150000
* THIS RIB IN ENTERER'S CODE: 03160000
* 03170000
* . MOVE THE SUB-RIB INTO OUR SEARCH/COMPARE LOOP CODE 03180000
* 03190000
* . ADVANCE THE *SAVED* ARR BY 2 TO SET ENTERER'S RETURN ADDRESS 03200000
* 03210000
* . JOIN THE SEARCH/COMPARE LOOP CODE TO: 03220000
* 03230000
* . MATCH THE SUB-RIB TO A CCP ROUTINE ADDRESS 03240000
* . RESTORE INDEX REGISTERS TO VALUES UPON ENTRY 03250000
* . TRANSFER CONTROL TO THAT CCP ROUTINE 03260000
SPACE 1 03270000
MVC IGRIB(1),1(,XR1) MOVE ENTERER'S *SUB-RIB* TO US 03280000
CLI 1(,XR1),X'00' SEE IF COMMUNICATIONS I/O SUBRIB 03290000
JE IGNRST JUMP IF SO--DO NOT SET RESTORE 03300000
SPACE 1 03310000
MVI IGCRST+1,BR SUBRIB NOT 00 -- SET RESTORE 03320000
IGNRST EQU * CONTINUE HERE 03330000
SPACE 1 03340000
ALC TCBARR-TCBSAV(2,XR2),CC0002 SET *SAVED* ARR TO RETURN 03350000
SPACE 1 03360000
LA IGSTBL-1,XR1 XR1 -> SUB-RIB/ROUTINE TABLE 03370000
J IGLOOP JOIN LOOP CODE TO ROUTE CONTROL 03380000
EJECT 03390000
*********************************************************************** 03400000
* R I B M A Y R E Q U I R E E N T R Y T O D S M * 03410000
*********************************************************************** 03420000
SPACE 2 03430000
* REQUEST IS FOR PROGRAM LOAD OR SYSTEM TRANSIENT. WE MUST NOT ENTER 03440000
* THE DSM SUPERVISOR (WHOSE CODE IS NON-REENTRANT) IF SOME OTHER 03450000
* TASK, HAVING ALREADY ENTERED THE DSM SUPERVISOR, HAS YIELDED 03460000
* CONTROL BEFORE LEAVING THE SUPERVISOR. IT IS THE RESPONSIBILITY 03470000
* OF $CC4IG TO ASSURE THAT SUCH A RECURSIVE ENTRY INTO THE DSM 03480000
* SUPERVISOR DOES NOT OCCUR. THUS ... 03490000
* 03500000
* DETERMINE IF ANY TASK IS LOGICALLY DWELLING IN THE DSM SUPERVISOR -- 03510000
* IF *NOT*, JUMP TO BEGIN ENTRY TO THAT SUPERVISOR 03520000
SPACE 1 03530000
IGOTHR TBN CCDPFH,DPDSX FALSE IF *NO ONE* IN SUPERVISOR 03540000
JF IGENTR JUMP IF FREE TO ENTER SUPERVISOR 03550000
SPACE 1 03560000
* THE ENTERER'S TASK IS *NOT* FREE TO ENTER THE DSM SUPERVISOR. THUS 03570000
* WE MUST "WAIT" THE ENTERER'S TASK. 03580000
SPACE 1 03590000
B $CC4WT INVOKE WAIT ROUTINE 03600000
DC AL2(WPBDSX) EVENT TO AWAIT: DSM SUPVR FREE 03610000
DC AL1(1) NUMBER OF EVENTS TO AWAIT: ONE 03620000
DC AL1(DPREG+DPDSP) CONTROL: SAVE REGS, NON-DISP'BLE 03630000
SPACE 1 03640000
* RETURN FROM WAIT COMES HERE. AT THIS POINT, THE DSM SUPERVISOR MAY 03650000
* HAVE BEEN AGAIN ENTERED BY ANOTHER TASK BEFORE THIS TASK COULD 03660000
* GAIN CONTROL. THUS WE MUST AGAIN CHECK THE STATUS OF SUPERVISOR 03670000
* ENTRY. 03680000
SPACE 1 03690000
B IGOTHR BRANCH TO RE-CHECK ENTRY STATUS 03700000
EJECT 03710000
*********************************************************************** 03720000
* D I S T I N G U I S H E N T R Y T Y P E * 03730000
*********************************************************************** 03740000
SPACE 2 03750000
* AT THIS POINT, WE MUST DISTINGUISH THE TYPE OF REQUEST, DETERMINABLE 03760000
* BY INSPECTION OF THE RIB NOW HELD IN "IGRIB": 03770000
* 03780000
* . IF RIB < X'80', THIS IS PROGRAM LOAD/FETCH/OVERLAY REQUEST 03790000
* . IF RIB = X'80' OR X'C0', THIS IS REQUEST TRANSIENT BY C/S/N 03800000
* . IF RIB = X'8X' OR X'CX', THIS IS REQUEST FOR STANDARD TRANSIENT 03810000
SPACE 1 03820000
IGENTR EQU * PREPARE TO ENTER DSM SUPERVISOR 03830000
SPACE 1 03840000
MVC IGRIB(1),0(,XR1) GET MODIFIABLE RIB FOR COMPARE 03850000
SBF IGRIB,X'40' MAKE X'CX' RIB LOOK LIKE X'8X' 03860000
SPACE 1 03870000
MVC IG$CSN(4),3(,XR1) MOVE RIB + POSSIBLE C/S/N TO US 03880000
ALC TCBARR-TCBSAV(2,XR2),CC0001 SET SAVED RETURN ADDRESS 03890000
SPACE 1 03900000
CLI IGRIB,X'80' LO=LOAD / EQ=XNT BY CSN / HI=XNT 03910000
JNE IGNFCS JUMP IF *NOT* FETCH XNT BY C/S/N 03920000
SPACE 1 03930000
* RIB WAS X'80' OR X'C0' -- FETCH TRANSIENT BY C/S/N -- WE MUST: 03940000
* 03950000
* . FURTHER MODIFY THE SAVED RETURN ADDRESS BEYOND ENTERER'S C/S/N 03960000
* . JUMP TO ENTER THE DSM SUPERVISOR OURSELVES 03970000
SPACE 1 03980000
ALC TCBARR-TCBSAV(2,XR2),IG0003 MODIFY SAVED RETURN ADDRESS 03990000
J IGXNCE JUMP TO START *OUR* ENTRY TO DSM 04000000
SPACE 1 04010000
* REQUEST IS EITHER LOAD/FETCH OR FETCH SYSTEM TRANSIENT BY RIB. 04020000
* WE MUST: 04030000
* 04040000
* . OVERLAY THE "C/S/N" WE MOVED TO OUR CODE WITH A NOP JUMP 04050000
* . IF THIS WAS REQUEST SYSTEM TRANSIENT BY RIB, POINT TO OUR TABLE 04060000
* OF INTERCEPTED RIBS AND GO RIB-COMPARE ROUTINE 04070000
SPACE 1 04080000
IGNFCS MVC IG$CSN(3),IGJNOP+2 MOVE IN NOP JUMP 04090000
LA IGRTBL-1,XR1 XR1 -> TABLE OF INTERCEPTED RIBS 04100000
CLI IGRIB,X'81' THIS A FIND? 04105000
JH IGLOOP JUMP IF FETCH SYSTEM XNT BY RIB 04110000
EJECT 04120000
*********************************************************************** 04130000
* P R O G R A M L O A D / F E T C H / O V E R L A Y * 04140000
*********************************************************************** 04150000
SPACE 2 04160000
* REQUEST IS FOR LOAD OR FETCH OF PROGRAM -- WE MUST: 04170000
* 04180000
* . SET "NPCYL" OF THE PLCA WITH THE C/S OF USER ROOT PHASE (IN CASE 04190000
* THIS IS AN OVERLAY-LOAD RIB OF X'40') 04200000
* . SET "NPRLF" OF THE PLCA WITH THE RELOCATION FACTOR OF THE 04210000
* *USER* PROGRAM 04220000
SPACE 1 04230000
L CCURTB,XR1 XR1 --> ENTERER'S TCB 04400200
TBN TCBTSK(,XR1),TCBSYT SYSTEM TASK ? 04400400
JT IGXNCE YES - JUMP 04400600
SPACE 1 04400800
ST IGRST2+3,XR2 SAVE XR2 04401000
L CC@PCA,XR2 XR2 --> PLCA 04401200
L TCBCDE(,XR1),XR1 XR1 --> ENTERER'S CDE 04401400
TBN CDEAT2(,XR1),CDEPAK FROM SYSTEM PACK ? 04401600
JF IGRBFN NO JUMP (PROGRAM PACK) 04401800
SPACE 1 04402000
MVI NPQ(,XR2),## MOVE SYSTEM Q BYTE TO LEVEL Q 04402200
IGSYSQ EQU *-2 STARTUP PLUGS SYS Q BYTE HERE 04402400
MVC NPOLIB(2,XR2),IGNCLB RESET C/S OF PACK DIRECTORY 04402600
IGRBFN CLI IGRIB,X'81' FIND RIB ? 04402800
JE IGRST2 YES - GO SET EXIT TO G.I. 04403000
CLI IG$RIB,X'40' OVERLAY LOAD RIB ? 04403200
JNE IGNT40 NO,SKIP SET-UP FOR OVERLAYS 04403400
SPACE 1 04403600
MVC NPCYL(2,XR2),CDECS(,XR1) MOVE IN ROOT PHASE C/S 04403800
MVC NPRLF(2,XR2),CDELOD(,XR1) MOVE BASE LOAD ADDRESS 04404000
SLC NPRLF(2,XR2),CDELNK(,XR1) RLF=LOAD ADDRESS-LINK ADDRESS 04404200
J IGRST2 GO SET UP EXIT TO GEN ENTRY 04404400
SPACE 1 04404600
IGNCLB DS XL2 SET TO SYSTEM DIR C/S 04404800
IGNPLB DS XL2 SET TO PROGRAM DIR C/S 04405000
IGCLST EQU * * 04405200
DC 10XL1'0' LOAD FETCH PARM LIST 04405400
SPACE 2 04405600
IGNT40 TBN IG$RIB,X'10' FETCH RIB ? 04405800
JF IGRST2 BYPASS FETCH CONVERSION 04406000
SPACE 1 04406200
TBN IG$RIB,X'08' IF ANY FETCH OTHER THAN WITH 04406400
* ADDRESS - STOP RIGHT NOW 04406600
JT IGBDFC IF OK - JUMP 04406800
B CPHALT GO HALT WITH U- 95(CD1345) 04407000
DC XL2'1F5D' SUB HALT 04407200
SPACE 3 04407400
IGBDFC EQU * * 04407600
L IGRST2+3,XR2 XR2 --> TCB SAVED REG'S 04407800
L TCBXR2-TCBSAV(,XR2),XR2 XR2 --> USER PARM LIST POINTER 04408000
MVC IGCLST+9,9(10,XR2) MOVE USER'S LIST TO OUR LIST 04408200
MVI IGJP1#,NOOP NOOP BYPASS LOAD OF PARM PTR 04408400
SBF IG$RIB,X'10' CHANGE FETCH TO LOAD 04408600
MVI IGJP2#,NOOP INSURE USER RETURN FETCH SET 04408800
SPACE 2 04409000
* RESET REGISTERS TO PREPARE TO BRANCH TO DSM SUPERVISOR 04420000
SPACE 1 04430000
IGRST2 LA ####,XR2 XR2 -> TCB SAVED REGISTERS 04440000
IGXNCE LA IG@NCE,XR1 XR1 -> ADDRESS OF OUR ENTRY 04450000
J IGSET@ JUMP TO SET IG@WTG ADDRESS 04460000
EJECT 04470000
*********************************************************************** 04480000
* I D E N T I F Y R I B A N D R O U T E S E R V I C E * 04490000
*********************************************************************** 04500000
SPACE 2 04510000
* THIS ROUTINE WILL SEARCH A SPECIFIED TABLE OF RIBS (OR SUB-RIBS) 04520000
* IN ORDER TO ESTABLISH A GO-TO ADDRESS -- A SPECIFIC 04530000
* ADDRESS IF A (SUB-) RIB MATCH IS FOUND, A DEFAULT ADDRESS IF A 04540000
* MATCH IS NOT FOUND. UPON ENTRY: 04550000
* 04560000
* . XR1 -> HI-ORDER BYTE - 1 OF A RIB/ADDRESS TABLE 04570000
* 04580000
* . THE SEARCH ARGUMENT IS IN THE CELL "IGRIB" 04590000
SPACE 1 04600000
IGLOOP CLI 1(,XR1),## COMPARE TABLE-RIB TO SEARCH-RIB 04610000
IGRIB EQU *-2 SEARCH-(SUB-)RIB KEPT HERE 04620000
SPACE 1 04630000
TBF 1(,XR1),X'40' WILL BE TRUE EXCEPT FOR STOPPER 04640000
SPACE 1 04650000
LA +3(,XR1),XR1 ADVANCE TABLE POINTER TO NEXT 04660000
BC IGLOOP,X'11' LOOP IF NEITHER MATCH NOR STOP 04670000
SPACE 1 04680000
* WHEN CONTROL COMES HERE, EITHER A MATCH OR THE TABLE STOPPER HAS 04690000
* BEEN FOUND. TO ROUTE CONTROL TRANSPARENTLY, WE MUST: 04700000
* 04710000
* . SET AN IAR-LOAD INSTRUCTION WITH THE ADDRESS OF THE GO-TO ADDR 04720000
* 04730000
* . RESTORE THE *SAVED* ARR, XR1 AND XR2 04740000
* 04750000
* . *NOT* REDUCE THE "LEVEL" OF REGISTER SAVE 04760000
* 04770000
* . ROUTE CONTROL TO THE ESTABLISHED GO-TO ADDRESS WITHOUT 04780000
* DESTROYING THE ARR. CONTROL WILL GO: 04790000
* 04800000
* . TO THE CCP FUNCTION ROUTINE ON A RIB OF X'01' AND A 04810000
* PROPER SUB-RIB 04820000
* . TO THE ERROR ROUTINE "IGCERR" ON A RIB OF X'01' AND AN 04830000
* *IMPROPER* SUB-RIB 04840000
* . TO THE CCP "PSEUDO" ROUTINE FOR SUBSTITUTE TRANSIENT 04850000
* REQUESTS 04860000
* . TO THE DSM SUPERVISOR (VIA OUR ROUTINE "IG$NCE") ON 04870000
* NON-SUBSTITUTE TRANSIENT REQUESTS AND ON *ALL* LOAD/FETCH 04880000
* REQUESTS 04890000
SPACE 1 04900000
IGSET@ ST IG@WTG,XR1 SET ADDR OF GO-TO ADDRESS 04910000
L TCBARR-TCBSAV(,XR2),ARR RESTORE THE ARR 04920000
L TCBXR1-TCBSAV(,XR2),XR1 RESTORE XR1 04930000
L TCBXR2-TCBSAV(,XR2),XR2 RESTORE XR2 04940000
SPACE 1 04950000
IGCRST BC CCPRST,##+NOP RESTORE SAVE LEVEL UNLESS NOP 04960000
MVI IGCRST+1,NOP ASSURE RESTORE TO NOP 04970000
SPACE 1 04980000
L ####,IAR GO TO APPROPRIATE ROUTINE 04990000
IG@WTG EQU *-1 ADDRESS OF GO-TO ADDR SET HERE 05000000
EJECT 05010000
*********************************************************************** 05020000
* H A L T / S Y S L O G S E R V I C E R O U T I N E S * 05030000
*********************************************************************** 05040000
SPACE 2 05050000
.* 05060000
.* AIF (&RPG NE '1').IG500 . SKIP IF RPG NOT SUPPORTED 05070000
.* 05080000
* RIB IS X'8F' -- CALL UPON RPG HALT PROCESSOR -- INVOKE CCP TRANSIENT 05090000
SPACE 1 05100000
IGRPGH EQU * 05110000
MVI IGHSX,CC4HF SET TRANSIENT NUMBER OF RPG PROC 05120000
SPACE 1 05130000
.* 05140000
.IG500 ANOP . CONTINUE HERE 05150000
.* 05160000
* RIB IS X'85' -- CALL UPON HALT/SYSLOG -- INVOKE CCP TRANSIENT 05170000
SPACE 1 05180000
IGHSLG B $CC4PI INVOKE TRANSIENT AREA HANDLER 05190000
IGHSX DC AL1(##) ID OF HALT/SYSLOG TRANSIENT 05200000
SPACE 1 05210000
J IGRET1 JUMP IF *NOT* TERMINATED 05220000
SPACE 1 05230000
B CC4TI2 INVOKE TERMINATION OF TASK 05240000
DC AL1(##) TERMINATION CODE 05250000
SPACE 1 05260000
B CCPRET RETURN TO DSM XNT 05270000
SPACE 5 05280000
*********************************************************************** 05290000
* E N T E R T R U E G E N E R A L E N T R Y * 05300000
*********************************************************************** 05310000
SPACE 2 05320000
* RIB REQUIRES BRANCH TO "TRUE" GENERAL ENTRY -- WE MUST: 05330000
* 05340000
* . MARK (IN $DPFLH OF $CCCOM) THAT THE DSM SUPERVISOR IS BUSY 05350000
* 05360000
* . MARK (IN ENTERER'S TCBTSK BYTE) THAT THE TASK IS IN DSM SUPVR 05370000
* 05380000
* . BRANCH TO THE *TRUE* ENTRY POINT FOR GENERAL ENTRY 05390000
SPACE 1 05400000
IG$NCE SBN CCDPFH,DPDSX INDICATE DSM SUPERVISOR ENTERED 05410000
MVC IGTSKI(2),CCURTB SET @ OF CURRENT TASK 05420000
SBN ####,TCBDSM INDICATE TASK IN DSM SUPVR 05430000
IGTSKI EQU *-1 ADDR OF ENTERER'S TCBTSK BYTE 05440000
SPACE 1 05450000
IGDSMT TBN ####,## DOES OTHER LEVEL 'OWN' DSM 05460000
JF IGGOFL NO, JUMP 05470000
IGENAB JC IGGOFL,BRNOP SET TO SIO IF CCP PRIORITY 05480000
IGGOFL JC IGGO,BR SKIP PARM LIST LOAD FOR LOADER 05482000
IGJP1# EQU *-2 * 05484000
LA IGCLST,XR2 XR2 --> LOAD/FETCH PARM LIST 05486000
MVI IGJP1#,BR CLEAR NOOP FROM ABOVE JUMP 05488000
SPACE 1 05490000
IGGO B *-* GO TO TRUE GENERAL ENTRY POINT 05500000
IG@ENT EQU *-1 ADDRESS OF *TRUE* GENERAL ENTRY 05510000
SPACE 1 05520000
IG$RIB DC XL1'00' ENTERER'S RIB 05530000
IG$CSN DC XL3'000000' ENTERER'S CSN ON RIB OF 80/C0 05540000
EJECT 05550000
*********************************************************************** 05560000
* R E T U R N F R O M T R U E G E N E R A L E N T R Y * 05570000
*********************************************************************** 05580000
SPACE 2 05590000
* WHEN CONTROL RETURNS HERE, THE TASK WHICH ENTERED GENERAL ENTRY 05600000
* HAS LOGICALLY RELEASED CONTROL OF THE DSM SUPERVISOR. WE MUST: 05610000
* 05620000
* . MARK (IN $DPFLH OF $CCCOM) THAT THE DSM SUPERVISOR IS FREE 05630000
* 05640000
* . MARK (IN ENTERER'S TCBTSK BYTE) THAT HE IS *NOT* IN DSM SUPVR 05650000
* 05660000
* . POST *ANY* TASK WAITING FOR THE SUPERVISOR THAT THE SUPERVISOR 05670000
* IS FREE 05680000
* 05690000
* . RESTORE THE PROGRAM-PACK Q-BYTE IN THE PLCA 05700000
* 05710000
* . PROCEED TO RETURN TO THE INVOKER OF GENERAL ENTRY 05720000
SPACE 1 05730000
SBF CCDPFH,DPDSX MARK DSM SUPERVISOR FREE 05740000
MVC IGTSKO(2),CCURTB SET @ OF CURRENT TASK 05750000
SBF ####,TCBDSM INDICATE TASK *NOT* IN DSM SUPVR 05760000
IGTSKO EQU *-1 ADDR OF ENTERER'S TCBTSK BYTE 05770000
SPACE 1 05780000
IGDISA JC IGRET,BRNOP SET TO SIO IF CCP PRIORITY 05790000
SPACE 1 05800000
IGRET B $CC4PS INVOKE CCP POST ROUTINE 05810000
DC AL2(WPBDSX) COMPLETED EVENT: DSM SUPVR FREED 05820000
IG0003 DC AL2(0003) TCB TO POST: *ANY* AWAITING THIS 05830000
SPACE 1 05840000
L CC@PCA,XR2 XR2 -> PLCA 05850000
MVI NPQ(,XR2),## RESTORE PROGRAM-PACK Q-BYTE 05860000
IGNPQ EQU *-2 PGM PACK Q-BYTE INITIALIZED HERE 05870000
SPACE 1 05873000
MVC NPOLIB(2,XR2),IGNPLB RESTORE LIB C/S 05876000
EJECT 05880000
*********************************************************************** 05890000
* R E T U R N T O I N V O K E R * 05900000
*********************************************************************** 05910000
SPACE 2 05920000
* RETURN TO THE INVOKER OF GENERAL ENTRY THROUGH THE CCP DISPATCHER, 05930000
* USING THE TASK EXIT LOGIC OF THE DISPATCHER 05940000
* 05950000
* FIRST, POINT: 05960000
* 05970000
* . XR1 -> CCP COMMUNICATION AREA 05980000
* . XR2 -> INVOKER'S TCB 05990000
SPACE 1 06000000
IGRET0 EQU * 06001000
LA $CCCOM,XR1 XR1 --> COMMON 06002000
L @CURTB(,XR1),XR2 XR2 --> ENTERER'S TCB 06003000
JC IGRET2,BR DON'T RESET ARR FOR FETCH 06004000
IGJP2# EQU *-2 * 06005000
L TCBSAV(,XR2),XR1 XR1 --> SAVE AREA 06006000
MVC TCBARR-TCBSAV(2,XR1),IGCLST+7 SET USER FETCH ENTRY PNT. 06007000
MVI IGJP2#,BR CLEAR NOOP 06008000
SPACE 1 06009000
IGRET1 EQU * 06010000
LA $CCCOM,XR1 XR1 -> CCP COMMUNICATION AREA 06020000
IGRETN L @CURTB(,XR1),XR2 XR2 -> ENTERER'S TCB 06030000
SPACE 1 06040000
* NOW PERFORM THE TASK EXIT TO DISPATCHER 06050000
SPACE 1 06060000
IGRET2 EQU * * 06065000
SBN $DPFLG(,XR1),DPXSMC SPECIFY TASK IS EXITING 06070000
SBF $DPFLG(,XR1),DPREG+DPDSP DON'T SAVE REGS, DISPATCHABLE 06080000
SBN $DPFLH(,XR1),DPNTRC SPECIFY DO NOT TRACE EXIT 06090000
SBN TCBTSK(,XR2),TCBDSV SPECIFY RESTORE REGISTERS 06100000
B $CC4DP EXIT DIRECTLY TO THE DISPATCHER 06110000
EJECT 06120000
*********************************************************************** 06130000
* C O N S T A N T S A N D W O R K S P A C E * 06140000
*********************************************************************** 06150000
SPACE 2 06160000
* CONSTANT 06170000
SPACE 1 06180000
IGJNOP JC *+3,X'00' NOP JUMP USED AS CONSTANT 06190000
IG@HS DC AL2(IGHSLG) ADDR OF HALT/SYSLOG INTERFACE 06200000
SPACE 5 06210000
*********************************************************************** 06220000
* T A B L E S * 06230000
*********************************************************************** 06240000
SPACE 2 06250000
* TABLE OF TRANSIENT REQUEST RIBS INTERCEPTED BY CCP 06260000
SPACE 1 06270000
IGRTBL EQU * ADDR OF HI-ORDER OF TABLE 06280000
SPACE 1 06290000
DC XL1'82' RIB FOR OPEN 06300000
DC AL2($CC4OC) OPEN/CLOSE/ALLOC INTERFACE 06310000
DC XL1'83' RIB FOR CLOSE 06320000
DC AL2($CC4OC) OPEN/CLOSE/ALLOC INTERFACE 06330000
DC XL1'84' RIB FOR 'EOJ' 06340000
DC AL2(CC4TI1) TERMINATION INTERFACE ROUTINE 06350000
DC XL1'8B' RIB FOR ALLOCATE 06360000
DC AL2($CC4OC) OPEN/CLOSE/ALLOC INTERFACE 06370000
.* 06380000
AIF (&RPG NE '1').IG800 . SKIP IF RPG *NOT* SUPPORTED 06390000
.* 06400000
DC XL1'8F' RIB FOR RPG HALT PROCESSOR 06410000
DC AL2(IGRPGH) HALT PROCESSOR INTERFACE 06420000
.* 06430000
.IG800 ANOP . CONTINUE HERE 06440000
.* 06450000
SPACE 1 06460000
DC XL1'FF' TABLE STOPPER PSEUD-RIB 06470000
IG@NCE DC AL2(IG$NCE) OUR INTERFACE TO GENERAL ENTRY 06480000
SPACE 1 06490000
* TABLE OF CCP SUB-RIBS 06500000
SPACE 1 06510000
IGSTBL EQU * HI-ORDER ADDRESS OF TABLE 06520000
DC XL1'00' SUB-RIB FOR COMMUNICATIONS I/O 06530000
DC AL2($CC4II) COMMUNICATIONS I/O I'FACE ROUT 06540000
.* 06550000
SPACE 1 06560000
DC XL1'01' SUB-RIB FOR FORCED TERMINATION 06570000
DC AL2(CC4TI2) ROUTINE FOR FORCED TERMINATION 06580000
.* 06590000
AIF (&RPG NE '1').IG810 . SKIP IF NO RPG SUPPORT 06600000
.* 06610000
SPACE 1 06620000
DC XL1'02' GENERALIZED MOVE REQUEST 06630000
DC AL2($CC4MX) GENERALIZED MOVE ROUTINE 06640000
.* 06650000
.IG810 ANOP . CONTINUE HERE 06660000
.* 06670000
SPACE 1 06680000
DC XL1'FF' TABLE STOPPER PSEUDO SUB-RIB 06690000
DC AL2(IGCERR) SUB-RIB ERROR 06700000
SPACE 5 06710000
*********************************************************************** 06720000
* I N V A L I D S U B - R I B E R R O R * 06730000
*********************************************************************** 06740000
SPACE 2 06750000
* INVALID SUB-RIB -- BRANCH TO TERMINATION INTERFACE ROUTINE WITH 06760000
* AN ERROR COMPLETION CODE 06770000
SPACE 1 06780000
IGCERR B CC4TI2 BRANCH TO ERROR ENTRY 06790000
DC XL1'80' TASK COMPLETION CODE 06800000
SPACE 5 06810000
.* 06820000
MEND 06830000