|
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: 66040 (0x101f8)
Types: s3xseg
Names: »S$E092«
└─⟦d0bc1a931⟧ Bits:30009189 5704-sc1.V08.ccp
└─⟦64693a1c9⟧
└─⟦this⟧ »S$E092«
MACRO 00010000
.********************************************************************** 00020000
.* $E092 * 00040000
.********************************************************************** 00650000
$E092 00660000
GBLB &ONE,&NOB,&NOM,&MIN,&NDME,&N37,&NSCTL,&NBDA,&NPBY 00670000
GBLB &NPP,&NMP,&NSWL,&NCS,&N32,&NDF,&NRUF,&N41 00680000
GBLB &NSW,&N1050,&N2741,&NMOVE,&NSCTL,&NBFR 00700000
.* ARITHMETIC GLOBALS 00710000
GBLA &MLA,&BSC 00720000
.* ARITHMETIC LOCALS 00730000
LCLA &MIX 00740000
TEXT 00750000
* R-08,C-00 CHANGE LEVEL 00760000
TITLE '$E092 --- COMMON BSCA/MLTA SUBROUTINES' 00770000
SPACE 15 00780000
*********************************************************************** 00790000
* * 00800000
* * 00810000
* * 00820000
* COMMON M L T A / B S C A SUBROUTINES * 00830000
* * 00840000
* * 00850000
* * 00860000
*********************************************************************** 00870000
TITLE '$E092/CMPRLS---SEARCH NEW REQUEST PL QUEUE' 00880000
*********************************************************************** 00890000
* * 00900000
* NAME--CMPRLS * 00910000
* * 00920000
* TITLE--SEARCH NEW REQUEST PARAMETER LIST QUEUE FOR NEW REQUEST. * 00930000
* * 00940000
* FUNCTION-- * 00950000
* FIND FIRST NEW PUT ON PARAMETER LIST QUEUE AND * 00960000
* AND RETURN ITS ADDRESS. IF NO NEW PUTS RETURN ADDRESS * 00970000
* OF FIRST INPUT PARAMETER LIST. * 00980000
* OUTPUT * 00990000
* XR1 - ADDRESS OF PL TO HANDLED NEXT. * 01000000
* XR2 - ADDRESS OF POINTER TO PL TO HANDLED. * 01010000
* * 01020000
*********************************************************************** 01030000
SPACE 1 01040000
CMPRLS EQU * ONLY ENTRY POINT 01050000
ST CMPRLX+3,ARR SAVE RETURN ADDRESS 01060000
SBF $FLGC,#NTRAC SET OFF NO TRACE IND 01065000
LA @PRLQ-1,XR2 LEFT BYTE OF POINTER TO 1ST PL. 01070000
CMCKNX EQU * * LOCAL 01080000
L PLCHN(,XR2),PL @ OF NEXT PARAMETER LIST IN Q 01090000
TBN PLOPC(,PL),OPPUT IS OP A PUT ? 01100000
TBF PLOPM(,PL),OPSTOP * AND NOT STOP ? 01110000
JT CMPRLX YES - RETURN IT TO CALLER. 01120000
LA 0(,PL),XR2 ADDR OF CHAIN ADDRESS IN PL 01130000
CLI 0(,XR2),NOBIT ANY MORE PARM LISTS ON QUEUE ? 01140000
JE CMRDPL NO - NO PUTS, CHECK FOR READ 01150000
B CMCKNX YES - CHECK THE NEXT ONE FOR PUT 01160000
SPACE 1 01170000
CMRDPL EQU * * LOCAL 01180000
L @PRLQ,PL ADDRESS OF FIRST PL ON QUEUE 01190000
* * RETURN IT TO USER. 01200000
LA @PRLQ-1,XR2 ADDRESS OF POINTER TO IT. 01210000
CMPRLX B ## 01220000
TITLE '$E092/CMWPGY---COMMON PUT THEN GET OP END' 01230000
*********************************************************************** 01240000
* * 01250000
* NAME--CMWPGY * 01260000
* * 01270000
* TITLE--COMMON OP END ROUTINE FOR PUT PART OF PUT THEN GET. * 01280000
* * 01290000
* FUNCTION-- * 01300000
* WHEN THE PUT PART HAS OP ENDED, SCHEDULE A READ * 01310000
* OPERATION USING THE SAME PARAMETER LIST THAT WAS * 01320000
* USED FOR THE WRITE. * 01330000
* * 01340000
*********************************************************************** 01350000
SPACE 1 01360000
CMWPGY EQU * 01370000
ST CMWPSV+3,ARR SAVE RETURN ADDRESS 01380000
SPACE 01390000
* REFORMAT THE PARAMETER LIST FOR THE READ PORTION 01400000
SPACE 01410000
SLC PL$RTC(2,PL),PL$RTC(,PL) CLEAR INTERNAL RETURN CODE 01420000
SBF PL$OPM(,PL),OPPUT SET OFF PUT BIT 01430000
SBN PL$OPM(,PL),OPGET SET ON GET BIT 01440000
SPACE 01450000
TBF PLOPC(,PL),OPNOW USER PUT THEN GET ? 01460000
JT CMNWFM YES - JUST FREEMAIN, NO POST. 01470000
SPACE 2 01480000
TBN PL$OPM(,PL),OPNOW IF STILL A NO WAIT OPERATION 01490000
JT CMNWFM JUMP IF YES TO FREEMAIN 01500000
SPACE 1 01510000
********************************************************************* 01520000
* PUT WAIT - PART OF SYSTEM PUT NO WAIT INVITE CHANGED TO * 01530000
* PUT WAIT INVITE. * 01540000
********************************************************************* 01550000
SPACE 01560000
SBN PL$OPM(,PL),OPNOW SET NO WAIT BIT ON IN INTERNAL 01570000
* OP CODE MODIFIER FOR INVITE. 01580000
LA PLECB(,PL),XR1 ECB FOR THIS REQUEST 01590000
SVC 0 POST THIS ECB 01600000
DC AL1(POSTRB) * POST * 01610000
SPACE 1 01620000
L CMSPL,PL RESTORE PL ADDRESS 01630000
J CMWPGE JUMP TO RESTART THE LINE 01640000
SPACE 2 01650000
********************************************************************* 01660000
* PUT WAIT - PART OF USER PUT THEN GET -- JUST FREE PUT BUFFER * 01670000
* PUT NO WAIT - PART OF SYSTEM PUT NO WAIT INVITE * 01680000
********************************************************************* 01690000
SPACE 01700000
CMNWFM EQU * FREEMAIN PUT NO WAIT AREA 01710000
L PLRECA(,PL),XR2 POINT XR2 AT RECORD AREA OF 01720000
* AREA TO BE FREEMAINED. 01730000
B CMFMRT BR TO FREEMAIN INTERFACE ROUT. 01740000
SPACE 1 01750000
CMWPGE EQU * * 01755000
MVI PLRECA-1(,PL),NOBIT ZERO HOLD BUFFER ADDRESS 01760000
CMWPSV B *-* RETURN 01765000
$CC4CM TITLE '$E092/CMPOST---POST-ANALYSIS' 01780000
*********************************************************************** 01790000
* * 01800000
* NAME--CMPOST * 01810000
* * 01820000
* TITLE--COMMON POST ROUTINE * 01830000
* * 01840000
* FUNCTION-- * 01850000
* POST THE REQUESTOR THAT HIS REQUEST WAS * 01860000
* COMPLETED AND FREE UNNEEDED GETMAINED AREAS. * 01870000
* * 01880000
* OPERATION: 1. IF REQUEST IS A USER INVITE, POST TCBECB FOR OWNING * 01890000
* TASK THAT THE OPERATION IS COMPLETE. * 01900000
* * 01910000
* 2. IF REQUEST IS SYSTEM INVITE OR COMMAND INTERRUPT * 01920000
* GET POST $CC4CP. * 01930000
* 3. IF REQUEST IS AN INVITE OR COMMAND INTERRUPT GET * 01940000
* PUT TUB ON TCBINQ. * 01950000
* 4 IF REQUEST IS A NON COMMAND INTERRUPT GET OR A PUT * 01960000
* POST PLECB OF THE REQUESTS PARAMETER LIST. * 01970000
* 5. FREE ALL UNNEEDED GETMAINED AREAS. * 01980000
*********************************************************************** 01990000
SPACE 02000000
CMPOST EQU * POST THE PROPER TCB 02010000
ST CMMKRT+3,ARR RETURN ADDRESS 02020000
SPACE 02030000
TBN PL$OPM(,PL),OPPNW PUT NO WAIT 02040000
JT CMPSFM YES - NO POST, JUST FREEMAIN 02050000
SPACE 1 02060000
L PLTUBA(,PL),XR2 POINT XR2 AT TUB 02070000
SPACE 02080000
* CHECK NO POST BIT TO SEE IF NO TCB IS TO BE POSTED DUE TO THE 02090000
* COMPLETION OF THIS OPERATION 02100000
SPACE 02110000
AIF (&NOB).C1400 02120000
TBN PL$OPM(,PL),OPBNOP IS NO POST BIT ON ? B 02130000
BT CMMKRT JUMP IF NO POST BIT IS ON. B 02140000
.C1400 ANOP 02150000
AIF (&NOM).M1400 02160000
TBN PL$OPM(,PL),OPNPST IF PURGE OF MLTA PUT M 02170000
JT CMPSFM JUST FREE BUFFER M 02180000
.M1400 ANOP 02190000
SPACE 02200000
* IF REQUESTING TASK TERMINATED DO NOT POST - THIS IS 02210000
* DETERMINED BY OP BEING A USER OPERATION BUT TERMINATION 02220000
* SYSTEM TASK TCB IS NOW POINTED TO BY TUBTCB. 02230000
SPACE 02240000
L TUBTCB(,XR2),XR2 POINT XR2 AT TUB TCB 02250000
TBN TCBFG1(,XR2),TCBUSR+TCBNCL IS IT A SYSTEM TASK 02260000
TBF PLOPM(,PL),OP$SYS IS IT USER REQUEST 02270000
* ---------------------------- START -@30 02275000
JT CMJTFR YES- NO POST BUT FREE AREAS 02280000
* ---------------------------- END ---@30 02280500
* IF TASK IS IN TERMINATION,DON'T QUEUE UP INPUT 02283000
TBN TCBFG2(,XR2),TCBTRC TASK IN TERMINATION? 02285000
JT CMJTFR YES-GO FREE(DON'T POST) 02286000
SPACE 02290000
*********************************************************************** 02300000
* OKAY TO POST 02310000
*********************************************************************** 02320000
SPACE 02330000
* DETERMINE WHICH TCB TO POST 02340000
SPACE 1 02350000
ST PSTCB,XR2 SET DEFAULT TO POST TCB FROM TUB 02360000
SPACE 1 02370000
L PLTUBA(,PL),XR2 POINT XR2 AT TUB 02380000
AIF (&NPBY).NBY04 SKIP IF NO BUSY PRINTER 02380600
* 02381200
* BUSY PRINTER SUPPORT 02381800
* 02382400
********************************************************************* 02383000
* IF THIS IS THE SYSTEM INVITE FROM THE BUSY PRINTER CODE * 02383600
* NO FURTHER CHECK IS NECESSARY * 02384200
********************************************************************* 02384800
SPACE 1 02385400
TBN TUBAT4(,XR2),TUBWAT THIS TASK WAITING ON PRINTER? 02386000
SBF TUBAT4(,XR2),TUBWAT SET OFF WAITING BIT 02386600
JT CMPSPL YES- GO POST PLECB. 02387200
SPACE 1 02387800
.NBY04 ANOP 02388400
AIF (&NDME).D5200 02390000
TBN TUBAT2(,XR2),TUBDTA+TUBCMD IF COMMAND INTERRUPT MODE D 02400000
* ---------------------------- START -@26 02401000
JT CMPCIM YES- HANDLE CMD INT MODE. D 02402000
.D5200 ANOP D 02403000
TBN PL$OPM(,PL),OPINV WAS OPERATION A SYSTEM D 02404000
TBN PLOPM(,PL),OP$SYS * INVITE INPUT ? D 02405000
JF CMPSII NO-POST $CC4II D 02406000
CMPCIM EQU * * LOCAL D 02407000
* ---------------------------- END ---@26 02408000
* TERMINAL IN COMMAND INTERRUPT MODE OR SYS INVITE - POST CP TSB. D 02430000
SPACE 02440000
TBN PL$OPM(,PL),OPGET DID OP INVOLVE A READ D 02460000
MVC PSTCB(2),@CPTCB USE C.P.'S TCB FOR Q'ING 02465000
JT CMQINQ IF YES, PUT REQUEST ON TCBINQ D 02470000
J CMPSPL NO - JUST POST CP, MUST BE D 02480000
* * SYS PUT NO WAIT MADE WAIT. D 02490000
SPACE 02500000
* DETERMINE WHO TO POST. 02530000
SPACE 02540000
CMPSII EQU * DETERMINE WHAT ECB TO POST 02550000
TBN PL$OPM(,PL),OPINV WAS OP AN INVITE INPUT 02560000
TBF CMSWIT,CMSPSI STOP INV AND STATUS POLL 02570000
JF CMTSGT IF NOT INVITE-CHECK FOR GET. 02580000
SPACE 02590000
******************************************************************** 02600000
* INVITE INPUT OR COMMAND INTERRUPT READ - PUT TUB ON TCBINQ * 02610000
******************************************************************** 02620000
SPACE 02630000
CMQINQ EQU * * LOCAL 02640000
SPACE 02650000
ST TUBPL@(,XR2),PL PL ADDRESS INTO TUB 02660000
SBN TUBAT2(,XR2),TUBIIQ+TUBIIS INVITE DATA ON TCBINQ FOR THIS 02670000
* * TERMINAL. INPUT STILL OUT- 02680000
* * STANDING UNTIL ACCEPT RECVED. 02690000
SPACE 02700000
MVI TUBINQ-1(,XR2),NOBIT ZERO THIS TUB'S CHAIN POINTER 02710000
L PSTCB,XR2 POINT XR2 AT TCB 02720000
CLI TCBINQ-1(,XR2),NOBIT ARE THERE ANY TUBS IN THE QUEUE 02730000
JNE CMTUBC IF TUBS IN QUEUE - JUMP 02740000
SPACE 02750000
* NO TUBS AT ALL IN THE QUEUE 02760000
* ADD THIS TUB TO QUEUE BY PLACING IN THE TCB POINTER 02770000
SPACE 02780000
MVC TCBINQ(2,XR2),PLTUBA(,PL) PLACE TUB ADDR IN TCB TUB Q. 02790000
L PLTUBA(,PL),XR2 XR2---> TUB 02795000
J CMTBQD JUMP SINCE TUB IS QUEUED 02800000
SPACE 02810000
* HAVE TUBS IN THE QUEUE 02820000
SPACE 02830000
CMTUBC EQU * CHECK FURTHER DOWN TUB CHAIN 02840000
L TCBINQ(,XR2),XR2 POINT XR2 AT 1ST TUB IN THE 02850000
CMQLOP CLI TUBINQ-1(,XR2),NOBIT ANYMORE TUBS IN THE QUEUE 02860000
JE CMATUB JUMP IF NOT TO ADD NOW 02870000
SPACE 02880000
* HAVE MORE TUBS IN THE QUEUE 02890000
* GET ADDR OF NEXT TUB AND CONTINUE TO CHECK FOR END 02900000
SPACE 02910000
L TUBINQ(,XR2),XR2 POINT XR2 AT NEXT TUB 02920000
B CMQLOP BR TO TEST FOR END 02930000
SPACE 02940000
* FOUND END OF QUEUE SO ADD TUB TO QUEUE NOW 02950000
SPACE 02960000
CMATUB EQU * * LOCAL 02970000
MVC TUBINQ(2,XR2),PLTUBA(,PL) ADD THIS TUB TO THE QUEUE 02980000
CMTBQD EQU * TUB HAS BEEN QUEUED 02990000
AIF (&NDME).DME10 02995000
SPACE 1 03000000
TBN TUBAT2(,XR2),TUBDTA+TUBCMD IN COMMAND INT MODE? D 03002000
JT CMCIRD YES - GO POST C.P. D 03004000
.DME10 ANOP 03006000
SPACE 1 03008000
TBN PLOPM(,PL),OP$SYS SYSTEM INVITE ? 03010000
JF CMPSTB NO - GO POST TCB ECB. 03020000
SPACE 1 03030000
*-----------------------------------------------------------------* 03040000
* SYSTEM INVITE OR COMMAND INTERRUPT READ - POST $CC4CP * 03050000
*-----------------------------------------------------------------* 03060000
CMCIRD EQU * * 03065000
SPACE 1 03070000
LA $CPCM,XR1 ADDRESS OF $CC4CP ECB 03080000
SVC 0 POST ECB 03090000
DC AL1(POSTRB) * POST * 03100000
L CMSPL,PL RESTORE PL ADDRESS 03110000
J CMMKRT RETURN 03120000
SPACE 2 03130000
*-----------------------------------------------------------------* 03140000
* USER INVITE POST TCBECB IF $CC4II IS WAITING * 03150000
*-----------------------------------------------------------------* 03160000
SPACE 1 03170000
CMPSTB EQU * * LOCAL 03180000
LA ##,XR1 LOAD TCB ADDRESS TO POSTED 03190000
PSTCB EQU *-1 03200000
TBN TCBECB(,XR1),TCBACW IF $CC4II NOT WAITING 03210000
JF CMPSFM * DO NOT POST TCBECB BECAUSE 03220000
* * IT MAY BE BEING USED DURING 03230000
* * TRANSIENT LOAD. II WILL TEST 03240000
* * TCBIIQ WHEN AN ACCEPT COMES. 03250000
LA TCBECB(,XR1),XR1 ECB WITHIN TCB FOR TCBINQ 03260000
J CMPSOE GO POST $CC4CP 03270000
SPACE 3 03280000
******************************************************************* 03290000
* ANY PUT OR NON-COMMAND INTERRUPT GET - POST PLECB * 03300000
******************************************************************* 03310000
SPACE 1 03320000
CMTSGT EQU * * LOCAL 03330000
TBN PL$OPM(,PL),OPGET * GET OPERATION ? 03340000
TBF PLOPM(,PL),OP$SYS IS THIS A USER 03350000
* ----------------------------------------START----------------@3- 03353000
CLI PL$RTC(,PL),RCXEDT AND RET. CODE GREATER THAN 3 03356000
JC CMPSPL,FLSOHI YES OR SYSTEM OP - JUST POST 03360000
* -----------------------------------------END-----------------@3- 03365000
SPACE 1 03370000
*-----------------------------------------------------------------* 03380000
* USER GET -- MOVE DATA FROM HOLD BUFFER TO USERS RECORD AREA * 03390000
*-----------------------------------------------------------------* 03400000
SPACE 1 03410000
MVI #CMMVL+MVLTYP,SWAPTO INDICATE TO ADDR IN USER PGM 03420000
MVC #CMMVL+MVLTOL,PLINL(2,PL) DESIRED LENGTH IS TO LENGTH 03430000
MVC #CMMVL+MVLFRA,PLRECA(2,PL) HOLD BUFFER ADDR IS FROM ADDR 03440000
L PLTUBA(,PL),XR2 TUB ADDRESS 03450000
L TUBTCB(,XR2),XR2 TCB ADDRESS 03460000
MVC #CMMVL+MVLTOA,TCBWK(2,XR2) USERS RECORD AREA ADDRESS 03470000
SPACE 1 03480000
B CMMVRT INTERFACE TO SYSTEM MOVE ROUTINE 03490000
SPACE 1 03500000
******************************************************************* 03510000
* ANY PUT OR NON-COMMAND INTERRUPT GET - POST PLECB * 03520000
******************************************************************* 03530000
SPACE 1 03540000
CMPSPL EQU * * LOCAL 03550000
LA PLECB(,PL),XR1 ADDRESS OF ECB IN PARM LIST 03560000
SPACE 1 03570000
CMPSOE EQU * * LOCAL 03580000
SVC 0 POST ECB 03590000
DC AL1(POSTRB) * POST * 03600000
SPACE 1 03610000
******************************************************************* 03620000
* FREEMAIN PARAMETER LIST AND HOLD AREAS AS NECESSARY * 03630000
******************************************************************* 03640000
SPACE 1 03650000
CMPSFM EQU * * LOCAL 03660000
L CMSPL,PL PL ADDRESS 03670000
TBN PL$OPM(,PL),OPINV INVITE REQUEST ? 03680000
JT CMMKRT YES- NO FREEMAIN NEEDED 03690000
* * MUST BE PRESERVED UNTIL AN 03700000
* * ACCEPT OR STOP INVITE. 03710000
SPACE 1 03720000
*------------------------------------------------------------------* 03730000
* GET OR PUT -- FREE HOLD BUFFER AND PARAMETER LIST * 03740000
*------------------------------------------------------------------* 03750000
SPACE 1 03760000
L PLTUBA(,PL),XR2 TUB ADDRESS 03770000
L TUBDTF(,XR2),DTF DTF ADDRESS 03780000
AIF (&NOB).C1900 03790000
TBN $BDDEV(,DTF),BSCA BSCA DTF AND B 03800000
TBN PLOPM(,PL),OPSTOP STOP INVITE AND B 03804000
TBN LCBOPC(,DTF),LCBERP IF WAITING FOR EOT TO STATUS B 03810000
JT CMMKRT YES - EXIT, NO FREEMAIN B 03820000
* IF THE ERROR OCCURED ON A SYSTEM OP - C.P. WILL FREE THE AREA B 03822000
TBN LCBOPC(,DTF),LCBERP ERROR ON - B 03824000
TBN PLOPM(,PL),OP$SYS A SYSTEM OP ? B 03826000
JT CMMKRT YES - NO FREE NEEDED B 03828000
.C1900 ANOP 03830000
SPACE 1 03840000
CMJTFR EQU * * 03845000
B $CC4FR FREE GETMAINED AREA FOR REQUEST 03850000
SPACE 1 03860000
CMMKRT B *-* RETURN 03870000
TITLE '$E092/CMIVGM---INVITE-BUFFER-ANALYSIS' 03880000
*********************************************************************** 03890000
* * 03900000
* NAME--CMIVGM * 03910000
* * 03920000
* TITLE--INPUT OPERATION BUFFER ANALYSIS * 03930000
* * 03940000
* FUNCTION--ANALYSIS AND OBTAINING OF GETMAIN BUFFER FOR ALL * 03950000
* INPUT OPERATIONS IN THE LINE QUEUE THAT WE CAN GET * 03960000
* BUFFER SPACE FOR. * 03970000
* OPERATION-- * 03980000
* . IF BSCA POLL FOR STATUS IS IN THE QUEUE SET ALL * 03990000
* POLLING SKIP BITS ON. * 04000000
* . IF LCB CURRENTLY HAS A HOLD AREA FREEMAIN IT. * 04010000
* . IF GET OPERATION TO BE SCHEDULED SET UP TO HANDLE * 04020000
* IT. * 04030000
* . IF SYSTEM INVITE TO BSCA SWITCHED LINE OWNED BY A * 04040000
* USER PROGRAM, THEN IGNORE THE SYSTEM REQUEST FOR * 04050000
* NOW. * 04060000
* . DETERMINE STORAGE REQUIREMENTS TO SCHEDULE EACH * 04070000
* INVITE OPERATION. * 04080000
* . IF STORAGE NOT AVAILABLE IGNORE THE REQUEST. * 04090000
* . IF STORAGE IS AVAILABLE SET UP TO HANDLE IT. * 04100000
* . IF BSCA POLL FOR STATUS, SCHEDULE IT BY ITSELF. * 04110000
* . GETMAIN THE SPACE NEEDED TO SCHEDULE OPERATIONS ON * 04120000
* THE LINE. * 04130000
* . SET UP THE LCB HOLD AREA TO REFLECT THE SPACE * 04140000
* ACQUIRED. * 04150000
* . SET UP GETMAIN PARAMETER LIST IN THE ACQUIRED AREA. * 04160000
* * 04170000
* ENTRY POINT--CMIVGM * 04180000
* * 04190000
* INPUT--AT LEAST ONE PARM LIST IN THE LINE QUEUE. * 04200000
* * 04210000
* OUTPUT--XR1-ADDRESS OF THE LAST TP PARAMETER LIST IN THE QUEUE. * 04220000
* XR2-ADDRESS OF THE DTF. * 04230000
* CMSPL-ADDRESS OF LAST GET/INVITE PARAMETER LIST NOT IN * 04240000
* CCPERP. * 04250000
* * 04260000
* EXTERNAL REFERENCES-- * 04270000
* CMFMR2-FREE LCB HOLD BUFFER BEFORE STARTING * 04280000
* ANALYSIS. * 04290000
* CMSTOR-DETERMINE STORAGE NEED FOR INVITES. * 04300000
* CMBSKP-SET BSCA POLL SKIP BITS ON/OFF. * 04310000
* CMONSK/CMOFSK-SET MLTA POLL SKIP BITS * 04320000
* ON/OFF. * 04330000
* CMGMRT-GETMAIN HOLD BUFFER TO SCHEDULE * 04340000
* INVITES ON THE LINE. * 04350000
* * 04360000
* EXIT, NORMAL--TO NSI OF CALLER. * 04370000
* * 04380000
* EXIT, ERROR--TO CPHALT WITH A 4 BLITZ HALT IF THE GETMAIN FAILS. * 04390000
* * 04400000
*********************************************************************** 04410000
EJECT 04420000
CMIVGM EQU * GETMAIN ANALYSIS OF INVITE 04430000
* INPUTS IN LINE QUEUE 04440000
ST CMIVGX+3,ARR SAVE RETURN ADDRESS 04450000
L CMSDTF,DTF POINT XR2 AT THE LCB 04460000
SBF CMSWIT,CMRSLN SET OFF INDICATION THAT LINE 04470000
* CAN BE SCHEDULED FOR READ 04480000
SPACE 04490000
* POINT TO FIRST PARAMETER LIST IN THE LINE QUEUE 04500000
SPACE 04510000
L LCBPLQ(,DTF),PL POINT XR1 AT 1ST PARM LIST 04520000
AIF (&N32).T2000 04530000
SPACE 1 04540000
* IF BSCA POLL FOR STATUS ON TOP OF THE QUEUE, THEN SET ALL SKIP 0B 04550000
* BITS ON IN THE POLLING LIST. 0B 04560000
SPACE 1 04570000
TBN PL$OPC(,PL),OPLSNS POLLING FOR STATUS, AND 0B 04580000
TBN $BDDEV(,DTF),BSCA BSCA LINE, AND 0B 04590000
TBN $BDATR(,DTF),$BCMCN CONTROL STATION LINE ? 0B 04600000
JF CMINOR NO-GO HANDLE NORMAL REQUESTS. 0B 04610000
L LCBPOL(,DTF),XR1 POINT TO THE POLLING LIST. 0B 04620000
CMIALL EQU * * 0B 04630000
CLI POLID(,XR1),POLEND END OF LIST ? 0B 04640000
JNL CMINOR YES-GO TO NORMAL PROCESSING. 0B 04650000
MVC CMISTS+2,POLCNT(1,XR1) SET UP REG UPDATE. 0B 04660000
CMISTS LA #(,XR1),XR1 UPDATE FOR POLL CHAR COUNT. 0B 04670000
SBN 2(,XR1),POLSKP SET ON THE SKIP BIT. 0B 04680000
LA POLNXT(,XR1),XR1 POINT TO NEXT ENTRY. 0B 04690000
B CMIALL GO CHECK NEXT ENTRY. 0B 04700000
SPACE 1 04710000
CMINOR EQU * * 0B 04720000
L LCBPLQ(,DTF),PL POINT TO FIRST PARM LIST. 0B 04730000
.T2000 ANOP 04740000
SLC CMIIND(2),CMIIND ZERO LINE BUFFER NEEDED SIZE 05010000
SPACE 05020000
* DETERMINE IF OPERATION IS A READ 05030000
SPACE 05040000
CMDTII EQU * * LOCAL (LOOP BACK FROM CMINPL 05050000
TBN PL$OPM(,PL),OPGET DOES OP INVOLVE READ 05060000
JF CMNXPL JUMP IF NO READ 05070000
SPACE 05080000
* HAVE READ - NOW ASSURE THE TERMINAL IS NOT IN ERP 05090000
SPACE 05100000
L PLTUBA(,PL),XR2 POINT XR2 ATHE TUB 05110000
TBF TUBAT3(,XR2),TUBERP IS TERMINAL IN ERROR RECOVERY 05120000
L CMSDTF,DTF POINT XR2 BACK AT LCB 05130000
JF CMNXPL JUMP IF TERMINAL IN ERP OR WAIT 05140000
SPACE 05150000
AIF (&NSWL).S0470 05160000
***************************************************************** SB 05170000
* IGNORE BSCA SYS PARM LIST IF USER OWNS THE SWITCHED LINE. * SB 05180000
***************************************************************** SB 05190000
SPACE 1 05200000
AIF (&ONE).E0200 05210000
TBN $BDDEV(,DTF),BSCA BSCA DTF ? S2 05220000
.E0200 ANOP 05230000
&MIX SETA &NMP+&NPP+&NCS 05240000
AIF (&MIX EQ '3').S0450 05250000
TBN $BDATR(,DTF),$BCSWI SWITCHED LINE, AND SLB 05260000
TBF $BDATR(,DTF),$BCMPT * NOT MULTI-POINT LINE ? SLB 05270000
.S0450 ANOP 05280000
JF CMGMLT NO - HANDLE OP W/O MORE CHKS SB 05290000
TBN LCBATR(,DTF),LCBNIT LINE CONNECTED ? SB 05300000
JT CMCOWN YES- CHECK OWNING TUB SB 05310000
SPACE 1 05320000
* LINE NOT CONNECTED - ALLOW REQUEST UNLESS SYSTEM REQUEST AND SB 05330000
* USER TASK OWNS THE LINE. SB 05340000
SPACE 1 05350000
CLC LCBTCB(2,DTF),X$0000 SWITCH LINE OWNED ? SB 05360000
JE CMGMLT NO - HANDLE OPERATION NOW. SB 05370000
CLC LCBTCB(2,DTF),@CPTCB USER TASK OWN LINE ? SB 05380000
TBN PLOPM(,PL),OP$SYS SYSTEM REQUEST ? SB 05390000
JC CMGSBN,TRUNEQ YES-SKIP THIS PARM LIST. SB 05400000
J CMGMLT NOT CONNECTED SO SCHEDULE SB 05410000
SPACE 1 05420000
* LINE CONNECTED - CHECK TO SEE IF REQUEST IS FOR CONNECTED TUB SB 05430000
SPACE 1 05440000
CMCOWN EQU * * LOCAL SB 05450000
CLC PLTUBA(2,PL),LCBOWN(,DTF) YES - THIS TUB OWN THE LINE ? SB 05460000
JNE CMGSBN NO - LINE OWNED BY ANOTHER SB 05470000
* * TUB SO SKIP THIS PL SB 05480000
CMGMLT EQU * * LOCAL SB 05490000
.S0470 ANOP 05500000
SPACE 05500300
* --START-------------------@29 05500600
* DOES THIS LCB CURRENTLY POSSESS A GETMAIN AREA FOR ITS INPUTS. 05500900
* IF YES - FREEMAIN IT SO THAT THERE WILL BE A BETTER CHANCE OF 05501200
* GETTING ENOUGH STORAGE TO HANDLE ALL THE OUTSTANDING INVITE INPUTS 05501500
SPACE 05501800
CLI LCBIBA-1(,DTF),NOBIT IS INVITE BUFFER ADDR NULL 05502100
JE CMSZND JUMP IF NULL 05502400
SPACE 05502700
* HAVE GETMAIN AREA WHICH WE WILL NOW FREEMAIN 05503000
* GET ADDRESS OF RECORD AREA IN THE STORAGE AREA TO BE FREEMAINED 05503300
* FREEMAIN THE LCB HOLD BUFFER 05503600
SPACE 05503900
L LCBIBA(,DTF),XR2 POINT XR2 AT RECORD TO BE FM 05504200
B CMFMR2 BRANCH TO ISSUE FREEMAIN 05504500
* WE WILL GET BACK AT LEAST THIS 05504800
* MUCH SO BYPASS SETTING FREEMAIN 05505100
* DONE FLAG. 05505400
SPACE 05505700
* REFLECT THE FREEMAIN BY ZEROING THE LCB FIELD WHICH CONTAINS THE 05506000
* LENGTH OF THE LCB HOLD BUFFER 05506300
SPACE 05506600
L CMSDTF,DTF POINT XR2 AT THE LCB 05506900
MVI LCBIBA-1(,DTF),NOBIT ZERO HIGH ORDER BYTE OF BUFFER 05507200
* TO INDICATE NULLL BUFFER ADDR 05507500
SPACE 05507800
CMSZND EQU * SET SIZE NEEDED NOW TO ZERO 05508100
* --END---------------------@29 05508400
B CMSTOR BR TO DETERMINE SIZE NEEDED BY 05510000
* THIS TP REQUEST 05520000
* SIZE NEEDED RETURNED IN #BUFND 05530000
SPACE 05540000
* COMPARE WHAT IS NEEDED AGAINST WHAT IS AVAILABLE WITH A GETMAIN 05550000
SPACE 05560000
CLC #BUFND,#ANYS+1 COMPARE NEEDED VS AVAILABLE 05570000
JNH CMGMAV JUMP IF ENOUGH STORAGE AVAILABLE 05580000
SPACE 05590000
************************************************************** 05600000
*THERE IS NOT ENOUGH STORAGE AVAILABLE IN THE TP BUFFER TO 05610000
* SATISFY THIS READ -- CHECK THE NEXT ONE ON THE QUEUE 05620000
************************************************************** 05630000
SPACE 05640000
* SET GETMAIN NEEDED BIT ON 05650000
SPACE 05660000
SBN $CMFM,SKIP INDICATE NO POST FOR FREEMAIN 05666000
SBN LCBATR(,DTF),LCBGMN SET LCB GETMAIN NEEDED 05680000
TBN PL$OPM(,PL),OPGETM GETMAIN ALREADY INDICATED? 05682000
JT CMNDCR YES - 05684000
SBN PL$OPM(,PL),OPGETM SET GETMAIN NEEDED FOR PL 05686000
ALC CORCNT(1),X$0001 UP CORE COUNT +1 05688000
* ---------------------------- START -@27 05689000
SBF $CMFM,SKIP+POST SET OFF WAIT/POST IND. 05690000
* ------------------------------ END -@27 05692000
CMNDCR EQU * * 05695000
SPACE 05700000
* SET POLL SKIP BIT ON IF STATION CONTROL 05710000
SPACE 05720000
AIF (&ONE).E0552 05730000
TBN $BDDEV(,DTF),BSCA BSCA DTF ? 2 05740000
JF CMGML2 NO-GO TO HANDLE MLTA CASE. 2 05750000
.E0552 ANOP 05760000
AIF (&NOB).D0552 05770000
&MIX SETA &NCS+&NSWL 05780000
AIF (&MIX EQ '2').S0500 05790000
CMGSBN EQU * * C/SB 05800000
MVI CMB#SB,SBN1 SET OP TO SET ON SKIP BIT. C/SB 05810000
B CMBSKP GO TO BSCA SKIP BITS RTN. C/SB 05820000
SPACE 1 05830000
.S0500 ANOP 05840000
J CMNXPL GO TO CHECK NEXT PARM LIST. B 05850000
SPACE 1 05860000
AIF (&ONE).D0552 05870000
CMGML2 EQU * * 2 05880000
.D0552 ANOP 05890000
AIF (&NOM).M1600 05900000
AIF (&NSCTL).S5600 05910000
B CMONSK BR TO SET POLL SKIP BIT ON CSM 05920000
.S5600 ANOP 05930000
SPACE 05940000
J CMNXPL GO TO CHECK NEXT PARM LIST M 05950000
SPACE 05960000
.M1600 ANOP 05970000
*********************************************************************** 05980000
* STORAGE IS AVAILABLE * 05990000
*********************************************************************** 06000000
SPACE 06010000
CMGMAV EQU * STORAGE IS AVAILABLE 06020000
SBN CMSWIT,CMRSLN INDICATE READ CAN BE SCHEDULED 06030000
ST CMLPL,PL SAVE LAST SCHEDULED READ PL @ 06040000
* * WILL BE USED IN THE TRACE 06050000
SBF PL$OPM(,PL),OPGETM SET OFF GETMAIN NEEDED BIT 06060000
SPACE 06070000
* SET THE SKIP BIT OFF FOR THIS TERMINAL 06080000
SPACE 06090000
AIF (&ONE).C0553 06100000
TBN $BDDEV(,DTF),BSCA BSCA DTF ? 2 06110000
JF CMGML3 NO-GO TO HANDLE MLTA CASE. 2 06120000
.C0553 ANOP 06130000
AIF (&NOB).D0553 06140000
AIF (&MIX EQ '2').S0600 06150000
* --START--------------------@27 06151000
TBF LCBAT2(,DTF),LCBRCI NOT RECEIVE INITIAL 06152000
TBN LCBAT2(,DTF),LCBACT * AND LINE ACTIVE 06153000
JT CMGNSB YES - DON'T SET SKIP BIT. 06154000
* --END----------------------@27 06155000
MVI CMB#SB,SBF1 SET OP TO SET OFF SKIP BIT. C/SB 06160000
B CMBSKP GO TO BSCA SKIP BITS RTN. C/SB 06170000
SPACE 1 06180000
CMGNSB EQU * * LOCAL @27 06185000
.S0600 ANOP 06190000
AIF (&NOM).M1700 06200000
J CMNOSO GO COMPARE BUFFER SIZES. 2 06210000
SPACE 1 06220000
AIF (&ONE).D0553 06230000
CMGML3 EQU * * 2 06240000
.D0553 ANOP 06250000
AIF (&NSCTL).S5700 06260000
B CMOFSK BRANCH TO SET SKIP BIT OFF CM 06270000
.S5700 ANOP 06280000
SPACE 06290000
.M1700 ANOP 06300000
CMNOSO EQU * COMPARE HOLD BUFFER SIZE NEEDED 06310000
CLC CMIIND(2),#BUFND COMPARE PARM SIZE NEEDED VS 06320000
* LINE QUEUE SIZE NEEDED 06330000
JNL CMIV40 JUMP UNLESS PARM NEED GT LINE 06340000
SPACE 06350000
* STORAGE NEEDED BY CURRENT PARM LIST IS GREATER THAN THAT NEEDED BY 06360000
* PREVIOUS INPUTS TESTED FOR THIS LINE 06370000
* RESET THE BUFFER SIZE NEEDED FOR THIS LINE 06380000
SPACE 06390000
MVC CMIIND(2),#BUFND MOVE BUFFER SIZE NEEDED TO FIELD 06400000
SPACE 06410000
* GET THE NEXT PARAMETER LIST IN THE LINE QUEUE 06420000
* FIRST TEST TO SEE IF THERE IS ANOTHER PARM LIST IN THE LINE QUEUE 06430000
SPACE 06440000
CMIV40 EQU * 06450000
AIF (&N32).T3000 06460000
SPACE 1 06470000
* BSCA POLL FOR STATUS IS HIGHEST PRIORITY OPERATION ON THE LINE. 0B 06480000
SPACE 1 06490000
TBN $BDDEV(,DTF),BSCA BSCA DTF, AND 0B 06500000
TBN PL$OPC(,PL),OPLSNS POLLING FOR STATUS ? 0B 06510000
JT CMIV60 YES-GO HANDLE, TOP PRIORITY. 0B 06520000
.T3000 ANOP 06530000
CMNXPL EQU * GET NEXT PARM LIST 06540000
CLI PLCHN-1(,PL),NOBIT IS CHAIN POINTER NULL 06550000
JE CMIV60 JUMP IF NO MORE PARM LISTS 06560000
L PLCHN(,PL),PL LOAD ADDR OF NEXT PARM LIST 06570000
B CMDTII LOOP BACK TO CHECK NEW PL 06580000
SPACE 06590000
******************************************************************* 06600000
* HAVE LOOKED AT EVERY PARM LIST IN THE QUEUE * 06610000
******************************************************************* 06620000
SPACE 06630000
CMIV60 EQU * 06640000
SPACE 06650000
* DETERMINE IF WE ARE TO DO GETMAIN BY CHECKING STORAGE AREA NEEDED 06660000
* AND AVAILABLE WITH GETMAIN 06670000
* IF GREATER THAN ZERO - DO THE GETMAIN 06680000
SPACE 06690000
CLC CMIIND(2),X$0000 IS SIZE GREATER THAN ZERO 06700000
JE CMIV80 IF NOT, JUMP 06710000
SPACE 06720000
* MUST DO GETMAIN WHICH MUST WORK ELSE HAVE CCP INTERNAL ERROR 06730000
* PUT SIZE NEEDED INTO GETMAIN LIST AND THEN GO TO GETMAIN INTERFACE 06740000
SPACE 06750000
MVC GMLIST+GMSIZE(2),CMIIND MOVE SIZE NEEDED TO GETMAIN LIST 06760000
B CMGMRT BR TO GETMAIN INTERFACE ROUTINE 06770000
SPACE 06780000
* SET UP LCBIBA AND LCBIBL FIELDS IN THE LCB 06790000
SPACE 06800000
MVC LCBIBA(2,DTF),GMLIST+GMADDR MOVE RECORD ADDR TO LCB 06810000
ALC LCBIBA(2,DTF),X$0004 BYPASS FREE LIST 06820000
MVC LCBIBL(2,DTF),CMIIND REQUESTED LENGTH 06830000
SPACE 06840000
CMIV80 EQU * 06850000
CMIVGX B *-* RETURN 06860000
TITLE '$E092/CMGBUF---GETMAIN RIGHT SIZE INPUT HOLD BUFFER' 06870000
********************************************************************* 06880000
* NAME - CMGBUF * 06890000
* * 06900000
* FUNCTION - ADJUST INPUT HOLD BUFFER SIZE AFTER OP END BECAUSE * 06910000
* IT IS KNOWN HOW MUCH DATA CAME IN PRIOR TO CALLING * 06920000
* THE CHECK ROUTINE TO ACTUALLY CAUSE THE DATA TO BE * 06930000
* MOVED. THE BUFFER GETMAINED ORIGINALLY FOR THE LINE * 06940000
* JUST SAVES TPBUFF SPACE SO WE KNOW WE CAN GET SPACE * 06950000
* WHEN THE DATA COMES IN (OP END). * 06960000
********************************************************************* 06970000
SPACE 06980000
CMGBUF EQU * 06990000
ST CMGBFX+3,ARR SAVE RETURN ADDRESS 07000000
SPACE 1 07010000
CLI LCBIBA-1(,DTF),NOBIT IS THERE A CURRENT INVITE BUF ? 07020000
JE CMGIGM NO-GO RIGHT TO GETMAIN. 07030000
SPACE 07040000
* IF CURRENT BUFFER FOR READ IS LARGER THAN NEED, THEN FREE THE 07050000
* CURRENT BUFFER, AND GET ONLY WHAT IS NEEDED. 07060000
SPACE 07070000
CLC #BUFND,LCBIBL(2,DTF) CURRENT LARGER THAN NEEDED ? 07080000
JE CMGBFX NO-THEN MUST BE EQ, USE CURRENT 07090000
L LCBIBA(,DTF),XR2 LOAD @ OF CURRENT BUFFER. 07100000
B CMFMRT GO TO FREEMAIN RTN, FREE CUR'NT 07110000
SPACE 07120000
L CMSDTF,DTF RELOAD DTF REG. 07130000
MVI LCBIBA-1(,DTF),NOBIT ZERO INVITE BUF ADDR. 07140000
CMGIGM EQU * * 07150000
CLC #BUFND(2),#GMS+1 MAX AVAIL TO SATISFY GETMAIN ? 07160000
JH CMGINO NO-GO SET UP TO WAIT ON FREEMAN 07170000
MVC GMLIST+GMSIZE(2),#BUFND MOVE NEEDED LENGTH TO GM LIST. 07180000
B CMGMRT GO TO GETMAIN RTN. 07190000
SPACE 07200000
JOL CMGINO GETMAIN FAILED, GO WAIT. 07210000
SPACE 1 07220000
MVC LCBIBA(2,DTF),GMLIST+GMADDR ADDR OF GOT BUF IN LCB. 07230000
ALC LCBIBA(2,DTF),X$0004 BYPASS FREE LIST IN 1ST 4 BYTES 07240000
MVC LCBIBL(2,DTF),#BUFND LENGTH REQUESTED 07250000
SPACE 1 07255000
* * LENGTH RECEIVED BECAUSE OF 07260000
* * ROUND UP IN GETMAIN ROUTINE. 07270000
* * IF USED AMOUNT RECVED WE 07280000
* * WOULD FREE/GETMAIN AT OP END. 07290000
CMGBFX EQU * * 07300000
B ## RETURN 07310000
SPACE 2 07320000
* INDICATE GETMAIN NEEDED FOR THIS LINE. 07330000
CMGINO EQU * * 07340000
SBN PL$OPM(,PL),OPGETM SET GETMAIN NEEDED IN PARM LST. 07350000
SBN LCBATR(,DTF),LCBGMN SET GETMAIN NEEDED FOR LINE. 07360000
* ---------------------------- START -@27 07362000
SBF $CMFM,SKIP+POST SET OFF WAIT/POST IND. 07364000
* ------------------------------ END -@27 07366000
B CMPAII GO POST USER AS NECESSARY. 07380000
TITLE '$E092/CMSTOR---GETMAIN-SIZE-DETERMINATION' 07390000
*********************************************************************** 07400000
* * 07410000
* NAME--CMSTOR * 07420000
* * 07430000
* TITLE--GETMAIN SIZE DETERMINATION * 07440000
* * 07450000
* FUNCTION--THIS ROUTINE CALCULATES THE AMOUNT OF MAIN STORAGE * 07460000
* NEEDED FOR A PARTICULAR TYPE OF TP REQUEST. * 07470000
* * 07480000
* OPERATION-- * 07490000
* . ALWAYS ADD FOUR BYTES FOR THE GETMAIN PARM LIST. * 07500000
* . IF A POLL FOR STATUS OPERATION ADD 20. * 07510000
* . IF SYSTEM INVITE ONLY ADD #CCMCL, AND MOVE #CCMCL * 07520000
* INTO PLINL. * 07530000
* . IF USER INVITE ONLY ADD PLINL. * 07540000
* * 07550000
* INPUT-- * 07560000
* XR1--ADDRESS OF THE TP PARAMETER LIST. * 07570000
* XR2--ADDRESS OF THE DTF FOR THE TP PARAMETER LIST. * 07580000
* * 07590000
* OUTPUT-- * 07600000
* XR1--NOT ALTERED * 07610000
* XR2--NOT ALTERED * 07620000
* #BUFND--TOTAL AMOUNT OF STORAGE NEED FOR THE TP REQUEST. * 07630000
* * 07640000
* EXIT-- TO NSI OF CALLER. * 07650000
*********************************************************************** 07660000
SPACE 07670000
CMSTOR EQU * * 07680000
AIF (&NOB).NB010 07690000
AIF (&MIN).N0010 07700000
.NB010 ANOP 07710000
.* FOLLOWING CODE WILL BE IN $CC4B2 FOR MIN RES R 07720000
ST CMSTOX+3,ARR SAVE RETURN ADDRESS R 07730000
MVC #BUFND(2),X$0004 ADD 4 FOR GETMN LIST R 07740000
SPACE 07750000
* DETERMINE WHETHER IT IS SYSTEM OR USER REQUEST R 07760000
SPACE 07770000
AIF (&NOB).C0556 07780000
&MIX SETA &N32+&N37+&N41 07790000
AIF (&MIX EQ '3').T1100 07800000
AIF (&ONE).E0554 07810000
TBN $BDDEV(,DTF),BSCA BSCA DTF ? 7/R0/52 07820000
.E0554 ANOP 07830000
TBN PL$OPC(,PL),OPLSNS AND POLL FOR STATUS ? 7/R0/5B 07840000
JF CMSUSR NO-GO CHECK WHO IS USER. 7/R0/5B 07850000
ALC #BUFND(2),RELSNS USE RECL FOR SENSE OP 7/R0/5B 07860000
J CMSTOX GO TO EXIT. 7/R0/5B 07870000
SPACE 07880000
CMSUSR EQU * * 7/R0/5B 07890000
.C0556 ANOP 07900000
.T1100 ANOP 07910000
TBN PLOPM(,PL),OP$SYS IS IT SYSTEM REQUEST R 07920000
JF CMSTOY JUMP IF USER REQUEST R 07930000
AIF (&NRUF).F0100 07930700
SPACE 07932100
* IF RUF ON SCREEN, USE MAX RUF LENGTH AS SYSTEM INPUT LENGTH. WB 07932800
SPACE 07933500
L PLTUBA(,PL),XR2 XR2-> TUB. WB 07934200
TBN TUBSCS(,XR2),TUBRUF RUF ON THE SCREEN ? WB 07934900
L TUBDTF(,XR2),DTF XR2-> LCB(DTF). WB 07935600
MVC PLINL(2,PL),#RUFCL USE MAX RUF LENGTH. WB 07936300
JT CMSTOY GO EXIT FROM SUBROUTINE. WB 07937000
.F0100 ANOP 07938400
SPACE 07940000
* HAVE SYSTEM READ - USE MAX COMMAND LENGTH AS INPUT LENGTH R 07950000
SPACE 07960000
MVC PLINL(2,PL),#CCMCL MOVE MAX COMMAND LGTH TO PARM R 07970000
CMSTOY EQU * ADD INPUT LENGTH R 07980000
ALC #BUFND(2),PLINL(,PL) ADD INPUT LENGTH R 07990000
CMSTOX B *-* RETURN R 08000000
AGO .G0100 08010000
.N0010 ANOP 08020000
MVI CMID2,CTSTOR MOVE IN ID OF CODED NEEDED. MIN 08030000
CMCAL2 ST CMSTR@+3,ARR SAVE RETURN ADDRESS MIN 08040000
ST CMX1S2,PL SAVE XR1 (PL ADDRESS). MIN 08050000
SPACE 1 08060000
SVC 0 ##### TRANSIENT CALL ##### MIN 08070000
DC AL1(CCPRIB) CCP SVC RIB MIN 08080000
DC AL1(CC4B2) TRANSIENT $CC4B2. MIN 08090000
CMID2 DC XL1'00' KEY FOR TYPE CODE WANTED MIN 08100000
CMX1S2 DC XL2'00' PARAMETER LIST ADDRESS MIN 08110000
#BUFND DC XL2'00' BUFFER SIZE FOR LINE. MIN 08120000
SAVT2@ DC AL2(SAVTA2) ADDRESS OF SAVE TAS BYTE 2. MIN 08130000
SPACE 1 08140000
CMSTR@ B # RETURN TO CALLER. MIN 08150000
.G0100 ANOP 08160000
TITLE '$E092/CMGMRT---GETMAIN-INTERFACE-ROUTINE' 08170000
*********************************************************************** 08180000
* * 08190000
* NAME: CMGMRT * 08200000
* * 08220000
* FUNCTION: * 08230000
* PROVIDES A GENERALIZED INTERFACE FOR THE COMMUNICATIONS MANAGER* 08250000
* TO PERFORM A GETMAIN FOR HOLD BUFFER SPACE. * 08260000
* IT WILL STORE THE GETMAIN LIST IN THE 1ST FOUR BYTES OF * 08270000
* GETMAINED AREA FOR FUTURE FREEMAIN CALL. * 08280000
* * 08290000
* ENTRY POINT: CMGMRT. * 08300000
* * 08330000
* INPUT: * 08340000
* THE SIZE OF THE HOLD BUFFER NEEDED IS IN FIELD GMSIZE OF THE * 08360000
* GETMAIN PARAMETER LIST GMLIST IN THE COMMUNICATIONS MANAGER * 08370000
* MODULE. * 08380000
* * 08390000
* OUTPUT: * 08400000
* ADDRESS OF THE HOLD BUFFER GOTTEN WILL BE IN FIELD GMADDR OF * 08420000
* THE GETMAIN PARAMETER LIST GMLIST IN THE COMMUNICATIONS * 08430000
* MANAGER MODULE. * 08440000
* * 08450000
* XR2 - ADDRESS OF 1ST BYTE PAST FREEMAIN LIST * 08460000
* CONDITION REGISTER - PRESERVED AS SET BY $CC4GM. THE BINARY * 08470000
* OVERFLOW CONDITION IS SET IF GETMAIN FAILED. * 08480000
* * 08490000
* EXTERNAL REFERENCES: * 08500000
* . GETMAIN SERVICE ROUTINE ENTRY POINT ($CC4GM) * 08510000
* * 08520000
* EXITS, NORMAL: * 08530000
* TO INSTRUCTION FOLLOWING THE INVOKING OF THIS ROUTINE (ARR) * 08550000
* * 08560000
* ATTRIBUTES: * 08570000
* RESIDENT, REUSABLE * 08590000
* * 08600000
*********************************************************************** 08610000
EJECT 08620000
CMGMRT EQU * INTERFACE TO THE GETMAIN 08630000
ST CMGMR9+3,ARR SAVE THE ARR 08650000
ST CMGMR2+3,XR2 SAVE XR2 08660000
LA GMLIST,XR2 POINT XR2 AT GETMAIN LIST 08670000
MVI 0(,XR2),NOBIT NON WAIT REQUEST 08680000
SPACE 1 08690000
SVC 0 SVC TO GETMAIN ROUTINE 08700000
DC AL1(CCPRIB) CCP RIB 08710000
DC AL1(GMRIB) GETMAIN SUB RIB 08720000
JOL CMGMER IF GETMAIN FAILED, SET FLAGS 08730000
SPACE 1 08740000
* MOVE FREEMAIN LIST INTO 1ST 4 BYTES OF GETMAINED AREA 08750000
SPACE 1 08760000
L GMADDR(,XR2),XR2 ADDRESS OF GETMAINED AREA 08770000
MVC GMSIZE(4,XR2),GMLIST+GMSIZE FREEMAIN LIST TO 1ST 4 BYTES 08780000
CMGMR2 LA *-*,XR2 RESTORE XR2 08790000
CMGMR9 B *-* RETURN TO CALLER 08800000
SPACE 2 08810000
* INDICATE GETMAIN NEEDED FOR THIS LINE. 08820000
CMGMER EQU * * 08830000
SBN PL$OPM(,PL),OPGETM SET GETMAIN NEEDED IN PARM LST. 08840000
ALC CORCNT(1),X$0001 ADD ONE TO COUNT OF WAITERS 08844000
L GMFAIL,PSR INDICATE THE GETMAIN BOMBED 08846000
L CMSDTF,DTF DTF ADDRESS 08850000
SBN LCBATR(,DTF),LCBGMN SET GETMAIN NEEDED FOR LINE. 08860000
* ---------------------------- START -@27 08862000
SBF $CMFM,SKIP+POST SET OFF WAIT/POST IND. 08864000
* ------------------------------ END -@27 08866000
B CMGMR2 GO RETURN 08880000
TITLE '$E092/CMFMRT---FREEMAIN-INTERFACE-ROUTINE' 08890000
*********************************************************************** 08900000
* * 08910000
* NAME: CMFMRT * 08930000
* * 08940000
* FUNCTION: * 08950000
* PROVIDES A GENERALIZED INTERFACE TO PERFORM A FREEMAIN OF HOLD * 08970000
* BUFFER SPACE. IT WILL SET A CM FREEMAIN INDICTOER. * 08980000
* * 09000000
* ENTRY POINT: * 09010000
* CMFMRT - MAIN ENTRY POINT - SET CM FREEMAIN INDICATOR. * 09030000
* CMFMR2 - THIS ENTRY POINT WILL NOT SET THE INTERNAL FREEMAIN * 09050000
* INDICATION. * 09060000
* * 09070000
* INPUT: * 09080000
* INDEX REGISTER 2 CONTAINS THE ADDRESS OF THE 1ST BYTE BEYOND * 09100000
* THE GETMAIN/FREEMAIN PARAMETER LIST. * 09110000
* * 09120000
* OUTPUT: * 09130000
* THE HOLD BUFFER IS FREEMAINED * 09140000
* * 09150000
* EXTERNAL REFERENCES: * 09160000
* . FREEMAIN SERVICE ROUTINE ENTRY POINT ($CC4FM) * 09170000
* * 09180000
* EXITS, NORMAL: * 09190000
* TO INSTRUCTION FOLLOWING THE INVOKING OF THIS ROUTINE (ARR) * 09210000
* * 09220000
* ATTRIBUTES: * 09230000
* RESIDENT, REUSABLE * 09250000
* * 09260000
*********************************************************************** 09270000
SPACE 09290000
CMFMRT EQU * FREEMAIN INTERFACE ROUTINE 09300000
SBN #CMSWT,#CMFMD SET SWITCH TO INDICATE FREEMAIN 09310000
* OCCURRED IN CM 09320000
CMFMR2 EQU * ENTRY POINT WHICH DOES NOT SET 09340000
* INTERNAL FREEMAIN INDICATION 09350000
ST CMFMRX+3,ARR SAVE THE ARR 09370000
SPACE 09380000
* XR2 POINTS AT GETMAIN/FREEMAIN PARAMETER LIST 09390000
SPACE 09400000
SVC 0 GO TO FREEMAIN ROUTINE 09410000
DC AL1(CCPRIB) CCP RIB 09420000
DC AL1(FMRIB) FREEMAIN SUB RIB 09430000
SPACE 09440000
CMFMRX B *-* RETURN 09450000
TITLE '$E092/$CC4FR--FREE GETMAINED AREAS' 09460000
******************************************************************** 09470000
* NAME--$CC4FR * 09480000
* * 09490000
* FUNCTION : FREE GETMAINED AREAS FOR A SPECIFIC TP REQUEST. * 09500000
* ROUTINE USED BY TRANSIENTS AND RESIDENT CM CODE. * 09510000
* * 09520000
* OPERATION: * 09530000
* . IF SYSTEM PUT WAIT, EXIT * 09530100
* . IF PLRECA IS NON ZERO, FREE HOLD BUFFER, * 09530200
* ZERO PLRECA-1, * 09530300
* ZERO LCBIBA-1, IF IT POINTS TO AREA FREED. * 09530400
* . IF INVITE,ZERO TUBPL@-1. * 09530500
* . IF PUT NO WAIT OR USER INVITE, FREE PARAMETER LIST AREA. * 09530600
* * 09530700
* INPUT-- * 09540000
* XR1 - PARAMETER LIST ADDRESS * 09550000
* * 09560000
* OUTPUT - * 09570000
* XR1,XR2 - UNCHANGED * 09580000
* * 09580100
* EXTERNAL ROUTINES USED: * 09580200
* CMFMRT - FREEMAIN INTERFACE. * 09580300
* * 09580400
* EXITS: TO NEXT INSTRUCTION FOLLOWING CALL. * 09580500
* * 09580600
******************************************************************** 09590000
SPACE 1 09600000
$CC4FR EQU * 09610000
ST CMFRRT+3,ARR SAVE RETURN ADDRESS 09620000
ST CMFRX2+3,XR2 SAVE XR2 09630000
TBN PLOPM(,PL),OP$SYS IF SYSTEM 09640000
TBN PL$OPM(,PL),OPPUT * PUT 09650000
TBF PL$OPM(,PL),OPNOW * WAIT, 09660000
JT CMFRXT YES - NO FREEMAIN, NO GETMAINS 09670000
CLI PLRECA-1(,PL),NOBIT IS PLRECA NON ZER0 09680000
JE CMPLCK GO CHECK ON FREEING PL 09690000
SPACE 1 09700000
*------------------------------------------------------------------* 09710000
* FREE HOLD BUFFER IF NOT A SYSTEM PUT WAIT * 09720000
*------------------------------------------------------------------* 09730000
SPACE 1 09740000
L PLRECA(,PL),XR2 ADDRESS OF HOLD BUFFER. 09750000
SPACE 1 09760000
B CMFMRT GO FREE HOLD BUFFER. 09770000
SPACE 1 09780000
L PLTUBA(,PL),XR2 TUB ADDRESS 09790000
L TUBDTF(,XR2),DTF DTF ADDRESS 09800000
CLC LCBIBA(2,DTF),PLRECA(,PL) IS AREA FREED THE CURRENT BUFF 09810000
JNE CMIBOK NO - SKIP ZERO 09820000
MVI LCBIBA-1(,DTF),NOBIT ZERO LINE BUFFER ADDRESS 09830000
CMIBOK EQU * * 09840000
MVI PLRECA-1(,PL),NOBIT ZERO HOLD BUFFER ADDRESS. 09850000
CMPLCK EQU * * LOCAL 09860000
TBF PL$OPM(,PL),OPNOW IF WAIT OPERATION ? 09870000
JT CMFRXT DO NOT FREE PARAMETER LIST. 09880000
TBN PLOPC(,PL),OPNOW ORIGINALLY A NO WAIT OP? 09883000
JF CMFRXT NO - NO FREE NEEDED 09886000
TBN PLOPC(,PL),OPINV INVITE ? 09890000
JF CMFRPL NO - JUST FREE PL 09900000
L PLTUBA(,PL),XR2 TUB ADDRESS 09910000
MVI TUBPL@-1(,XR2),NOBIT NO LONGER AN OP ENDED INVITE 09920000
* * OUTSTANDING FOR TUB. 09930000
TBN PLOPM(,PL),OP$SYS IF SYSTEM INVITE - PL IN TUB 09940000
JT CMFRXT YES - DONT FREE PL 09950000
SPACE 1 09960000
*--------------------------------------------------------------------* 09970000
* PUT-NO-WAIT OR USER INVITE --- FREE PARAMETER LIST * 09980000
*--------------------------------------------------------------------* 09990000
SPACE 1 10000000
CMFRPL EQU * * LOCAL 10010000
LA 0(,PL),XR2 ADDR OF PARAMETER LIST 10020000
SPACE 10030000
B CMFMRT FREE PL AREA 10040000
SPACE 10050000
CMFRXT EQU * * LOCAL 10060000
CMFRX2 LA *-*,XR2 RESTORE XR2 10070000
CMFRRT B *-* RETURN 10080000
SPACE 10090000
TITLE '$E092/CMGMPT--GETMAIN PUT HOLD BUFFER' 10100000
*********************************************************************** 10110000
* * 10120000
* NAME--CMGMPT * 10130000
* * 10140000
* TITLE--GETMAIN PUT HOLD BUFFER AND MOVE DATA INTO IT. * 10150000
* * 10160000
* FUNCTION : * 10170000
* GETMAIN FOR : * 10180000
* USER PUT * 10190000
* USER PUT NO WAIT * 10200000
* SYSTEM PUT NO WAIT * 10210000
* * 10220000
*********************************************************************** 10230000
SPACE 1 10240000
CMGMPT EQU * 10250000
ST CMPTEX+3,ARR SAVE RETURN ADDRESS 10260000
MVC GMLIST+GMSIZE(2),PLOUTL(,PL) LENGTH OF RECORD AREA 10270000
ALC GMLIST+GMSIZE(2),X$0004 ADD 4 FOR FREEMAIN LIST 10280000
SPACE 1 10290000
B CMGMRT GETMAIN HOLD BUFFER 10300000
JOL CMPTEX IF FAILED, EXIT (FLAGS ARE SET) 10310000
SPACE 1 10320000
* MOVE USERS RECORD AREA TO HOLD BUFFER 10330000
SPACE 1 10340000
MVI #CMMVL+MVLTYP,NOBIT ASSUME SYSTEM REQ WITH NO SWAP 10350000
MVC #CMMVL+MVLFRA,PLRECA(2,PL) ASSUME SYS REQ,REC AREA IN PL 10360000
TBN PLOPM(,PL),OP$SYS IF SYS REQUEST 10370000
JT CMMVDT YES- MOVE DATA 10380000
MVI #CMMVL+MVLTYP,SWAPFR FROM ADDR IS IN USER PGM AREA 10390000
L PLTUBA(,PL),XR2 TUB ADDRESS 10400000
L TUBTCB(,XR2),XR2 TCB ADDRESS 10410000
MVC #CMMVL+MVLFRA,TCBWK(2,XR2) MOVE USERS REC AREA @ INTO FM@ 10420000
SPACE 1 10430000
CMMVDT EQU * * LOCAL 10440000
MVC PLRECA(2,PL),GMLIST+GMADDR ADDR OF GETMAINED BUFF INTO PL 10450000
ALC PLRECA(2,PL),X$0004 BYPASS FREEMAIN LIST 10460000
MVC #CMMVL+MVLTOA,PLRECA(2,PL) HOLD BUFF DATA AREA IS TO @ 10470000
MVC #CMMVL+MVLTOL,PLOUTL(2,PL) LGTH OF FROM AREA IS SAME 10480000
SPACE 1 10490000
B CMMVRT MOVE INTERFACE ROUTINE 10500000
SPACE 1 10510000
CMPTEX B *-* RETURN 10520000
TITLE '$E092/CMMVRT--MOVE INTERFACE ROUTINE' 10530000
*********************************************************************** 10540000
* * 10550000
* NAME--CMMVRT * 10560000
* * 10570000
* TITLE--MOVE INTERFACE ROUTINE * 10580000
* * 10590000
* FUNCTION-- * 10600000
* MOVE TO OR FROM AREA IN USERS PROGRAM * 10610000
*********************************************************************** 10620000
SPACE 1 10630000
CMMVRT EQU * 10640000
ST CMMVEX+3,ARR SAVE RETURN ADDRESS 10650000
L PLTUBA(,PL),XR2 ADDRESS OF TUB 10660000
MVC #CMMVL+MVLTCB,TUBTCB(2,XR2) USERS TCB ADDR FOR ATR S 10670000
LA #CMMVL,XR2 ADDR OF MOVE PARAMETER LIST 10680000
MVC MVLFRL(2,XR2),PLEFFL(,PL) LENGTH OF FROM AREA FROM PL 10690000
* * FIELD PLOUTL/PLEFFL. 10700000
SPACE 1 10710000
SVC 0 10720000
DC AL1(CCPRIB) SVC TO MOVE ROUTINE 10730000
DC AL1(MVRIB) 10740000
SPACE 10750000
CMMVEX B *-* RETURN TO CALLER 10760000
SPACE 3 10760400
* -- START -----------------@34 10760800
* THIS ROUTINE SKIPS THE TRACE SVC IF TRACE IS NOT ACTIVE. 10761200
SPACE 10761600
CMTRCE EQU * 10762000
ST CMTR03,ARR SAVE RETURN ADDRESS 10762400
ALC CMTR03,X$0002(2) POINT TO TRACE ID 10762800
CMTR03 EQU *+5 * 10763200
MVC CMTR09(1),# PUT IN TRACE ID 10763600
ALC CMTR03(2),X$0001 BUMP ARR TO RETURN ADDRESS 10764000
ST CMTR05,XR1 SAVE REG 1 10764400
L NCSYS@,XR1 XR1--> SYS COM 10764800
TBN NCDSP1(,XR1),BIT0 TRACE ACTIVE? 10765200
CMTR05 EQU *+3 10765600
LA #,XR1 RESTORE REG 1 10766000
JF CMTR20 NO RETURN 10766400
SVC 0 SUPVSR CALL 10766800
DC AL1(CCPRIB) CCP RIB 10767200
DC AL1(TRRIB) CCP RIB FOR TRACE 10767600
CMTR09 DC AL1(#) TRACE ID 10768000
CMTR20 EQU * * 10768400
L CMTR03,IAR RETURN 10768800
* -- END -------------------@34 10769200
TITLE '$E092/CMQUE---ADD-TP-REQUEST-TO-LINE-QUEUE' 10770000
*********************************************************************** 10780000
* * 10790000
* NAME--CMQUE * 10800000
* * 10810000
* TITLE--ADD TP REQUEST TO LINE QUEUE * 10820000
* * 10830000
* FUNCTION-- * 10840000
* ADD THIS REQUEST TO THE LINE QUEUE * 10850000
* MUST CHECK TO SEE IF THIS PARAMETER LIST IS TO BE ADDED TO THE * 10860000
* END OF THE LINE QUEUE OR IS TO BE PUT AT THE TOP OF THE QUEUE * 10870000
* IE IF RETRY OF PARM LIST IN ERP - IT WILL GO TO TOP OF QUEUE TO * 10880000
* MAINTAIN THE ORIGINAL ORDER OF THE LINE QUEUE * 10890000
* XR2 WILL BE USED TO POINT TO THE VARIOUS PARAMETER LISTS IN THE QUE * 10900000
* POINT XR2 AT LOCATION OF 1ST PARM LIST POINTER * 10910000
* * 10920000
* EXIT - IF GETMAINS NECESSARY ARE SUCCESSFUL, TO NSI OF CALLER * 10930000
* IF NOT, TO CMPAII. * 10940000
*********************************************************************** 10950000
SPACE 10960000
CMQUE EQU * QUEUE THIS TP REQUEST 10970000
ST CMQRET+3,ARR RETURN ADDRESS 10980000
SBN $FLGC,#INVPL SET IND-G.M. FROM PL AREA ONLY 10986000
SPACE 10990000
AIF (&NOB).C0456 11000000
L CMSPL,PL POINT TO THE TP PARM LIST. B 11010000
.C0456 ANOP 11020000
SPACE 11030000
TBF PL$OPM(,PL),OPNOW WAIT OPERATION 11040000
JT CMQOP YES - SKIP GETMAIN, JUST QUEUE 11050000
TBN PLOPM(,PL),OP$SYS IF SYSTEM 11060000
CLI PLOPC(,PL),OPINV * INVITE, PL IN TUB. 11070000
JC CMQOP,TRUAEQ YES - SKIP GETMAINS 11080000
TBF PLOPM(,PL),OP$SYS IF A USER 11090000
TBN PLOPC(,PL),OPINV * INVITE, 11100000
JT CMPLGT YES - JUST GETMAIN FOR PL 11110000
SBF $FLGC,#INVPL SET OFF INV PL ONLY IND. 11112000
SBN $FLGC,#PUTTP SET IND-G.M.FROM ANYWHERE 11114000
SPACE 1 11120000
*---------------------------------------------------------------------* 11130000
* PUT NO WAIT OR SYS PNW/INVITE - GETMAIN HOLD BUFFER 11140000
*---------------------------------------------------------------------* 11150000
SPACE 1 11160000
MVC GMLIST+GMSIZE(2),PLOUTL(,PL) PNW DATA LENGTH 11170000
ALC GMLIST+GMSIZE(2),X$0004 * + 4 = TOTAL GETMAIN AREA 11180000
TBN PLOPM(,PL),OP$SYS SYSTEM 11190000
TBN PLOPC(,PL),OPPUT+OPINV * PNW/INVITE ? 11200000
JF CMPNWP NO-ALSO NEED PNW PARM LIST. 11210000
SPACE 11220000
* SYSTEM PUT-NO-WAIT/INVITE 11230000
SPACE 11240000
CLC GMLIST+GMSIZE(2),#GMS+1 WILL GETMAIN WORK ? 11250000
JNH CMPNWG YES-GO DO. 11260000
J CMPNWS NO-MAKE WAIT OP AND DO IT. 11270000
SPACE 11280000
* SYSTEM PUT NO WAIT OR USER PUT NO WAIT 11290000
SPACE 11300000
CMPNWP EQU * * 11310000
ALC GMLIST+GMSIZE(2),PLGMLG * + PL LENGTH 11320000
CLC GMLIST+GMSIZE(2),#GMS+1 IS THERE ENOUGH ROOM ? 11330000
JNH CMPNWG YES - GO DO GETMAINS 11340000
TBN PLOPM(,PL),OP$SYS IF SYSTEM PUT NO WAIT ? 11350000
JT CMPNWS YES - MAKE PUT WAIT AND DO IT. 11360000
L CMSDTF,DTF DTF ADDRESS 11370000
SBF PL$OPM(,PL),OPNOW MAKE WAIT OPERATION 11380000
AIF (&ONE).E0570 11390000
TBN $BDDEV(,DTF),BSCA IF BSCA 2 11400000
BT CMBSOP YES-GO CHECK REJECT 2 11410000
.E0570 ANOP 11420000
AIF (&NOM).M1800 11430000
SBN LCBATR(,DTF),LCBGMN DTF NEEDED GETMAIN M 11440000
SBN PL$OPM(,PL),OPGETM NO - SET GETMAIN NEEDED FOR PL M 11450000
ALC CORCNT(1),X$0001 ADD ONE TO COUNT OF WAITERS 11454000
* ---------------------------- START -@27 11454500
SBF $CMFM,SKIP+POST SET OFF WAIT/POST IND. 11455000
* ------------------------------ END -@27 11455500
J CMPNWF SET OTHER FLAGS M 11470000
AGO .M1850 11480000
.M1800 ANOP 11490000
B CMBSOP GO CHECK REJECT ONLY B 11500000
.M1850 ANOP 11510000
SPACE 1 11520000
CMPNWG EQU * * LOCAL 11530000
B CMGMPT GETMAIN HOLD BUFFER AND MOVE 11540000
* * DATA INTO IT. 11550000
JNOL CMHBOK IF GETMAIN OK 11560000
* (PNW OP WILL NOT FAIL BECAUSE 11570000
* OF TEST ABOVE) 11580000
* HOLD BUFFER GETMAIN FAILURE 11590000
CMPNWF EQU * * 11600000
SBN PL$OPM(,PL),OPGETQ GETMAIN FAILED AT QUEUE TIME. 11610000
CMPNWS EQU * * 11620000
SBF PL$OPM(,PL),OPNOW MAKE WAIT OP 11630000
J CMQOP QUEUE IT TO WAIT FOR FREEMAIN 11640000
SPACE 1 11650000
CMHBOK EQU * * LOCAL 11660000
* 11660500
* BUSY PRINTER SUPPORT 11661000
* 11661500
AIF (&NPBY).NPY02 SKIP IF NO BUSY PRINTER 11662000
L PLTUBA(,PL),XR2 POINT TO TUB 11662500
CLI TUBPHY(,XR2),TUB5M2 TEST FOR 3735 11663000
JH CMNBYP IF YES, SKIP BUSY PRINT CODE 11663500
TBN TUBSCS(,XR2),TUBBPT IS BUSY PRINT ALLOWED? 11663600
JF CMNBYP NO, SKIP BUSY PRINT CODE 11663700
CLC PLOUTL(2,PL),X$0002 IS PUT LENGTH GR THN 2 11664000
JNH CMNBYP NO, SKIP PRINTER BSY STUFF 11664500
TBF PLOPM(,PL),OPREQR USER OPERATION AND 11665000
TBN PLOPC(,PL),OPPUT A PUT OPERATION AND 11665500
L PLRECA(,PL),XR2 FIND THE RECORD AREA 11666000
TBN WCC(,XR2),STPRT IS THE START PRINT BIT ON? 11666500
L PLTUBA(,PL),XR2 XR2----> TUB 11667000
JF CMNBYP JUMP IF NOT PRINTER OPERATION 11667500
SBN TUBAT4(,XR2),TUBBSY SET ON PRINTER BUSY BIT 11668000
CMNBYP EQU * 11668500
.NPY02 ANOP 11669000
TBN PLOPC(,PL),OPPUT+OPINV IF SYS PNW/INV ONLY GET BUFFER 11670000
JT CMQOP YES - GO QUEUE IT 11680000
TBN PLOPM(,PL),OP$SYS IF SYSTEM 11690000
TBN PLOPC(,PL),OPINV * INVITE, PL IN TUB. 11700000
JT CMQOP YES - SKIP GETMAINS 11710000
SBN $FLGC,#PUTTP SET 'GETMAIN FROM ANYWHERE' 11715000
SPACE 1 11720000
*---------------------------------------------------------------------* 11730000
* PUT-NO-WAIT OR USER INVITE - GETMAIN FOR PARAMETER LIST 11740000
*---------------------------------------------------------------------* 11750000
SPACE 1 11760000
CMPLGT EQU * * LOCAL 11770000
MVC GMLIST+GMSIZE(2),PLGMLG LENGTH OF GETMAIN FOR PL 11780000
SPACE 1 11790000
B CMGMRT GETMAIN FOR PARAMETER LIST 11800000
JNOL CMPTGT IF GETMAIN OK 11810000
* (PNW OP WILL NOT FAIL BECAUSE 11820000
* OF TEST ABOVE) 11830000
SBN PL$OPM(,PL),OPGETQ FAILED - MUST QUEUE AFTER FREE 11840000
J CMQOP QUEUE IT TO WAIT FOR FREEMAIN 11850000
SPACE 1 11860000
CMPTGT EQU * * LOCAL 11870000
L GMLIST+GMADDR,XR2 ADDRESS OF GETMAINED AREA 11880000
MVC PLLEN+3(PLLEN,XR2),PLECB+2(,PL) MOVE PL TO GETMAINED AREA 11890000
LA 4(,XR2),PL ADDR OF PL INTO XR1 11900000
ST CMSPL,PL SAVE ADDR OF PL WORKING WITH 11910000
SPACE 1 11920000
*---------------------------------------------------------------------* 11930000
* QUEUE THE REQUEST ON LINE QUEUE * 11940000
*---------------------------------------------------------------------* 11950000
SPACE 1 11960000
CMQOP EQU * 11970000
SBF $FLGC,#PUTTP+#INVPL SET BOTH IND.S OFF 11974000
L CMSDTF,XR2 RESTORE DTF ADDR TO XR2 11980000
TBN LCBATR(,XR2),LCB1PL IS THIS TO BE 1ST PL IN Q 11990000
SBF LCBATR(,XR2),LCB1PL SET OFF LCB1PL BIT 12000000
SPACE 12010000
LA LCBPLQ-1(,XR2),XR2 POINT XR2 AT PARM LIST ADDR 12020000
SPACE 12030000
JF CMTQND JUMP IF ADD TO END OF LINE Q 12040000
SPACE 12050000
* PUT THIS PARM LIST AT THE TOP OF THE QUEUE 12060000
SPACE 12070000
MVC PLCHN(2,PL),PLCHN(,XR2) CHAIN CURRENT Q OFF THIS PL 12080000
J CMADDQ JUMP TO ADD THIS GUY TO Q 12090000
SPACE 12100000
* DETERMINE IF POINTER IS NULL 12110000
* IF NULL STORE ADDR OF THIS PARM LIST IN THAT LOCATION 12120000
SPACE 12130000
CMTQND EQU * TEST FOR END OF QUEUE 12140000
CLI PLCHN-1(,XR2),NOBIT IS PARM LIST POINTER NULL 12150000
JE CMADDQ JUMP IF NULL TO ADD TO QUEUE 12160000
SPACE 12170000
*POINTER NOT NULL - SO TRY NEXT PARM LIST POINTER 12180000
SPACE 12190000
*THIS PARM LIST PTS TO ANOTHER PARM LIST IN LINE QUEUE 12200000
* GO DOWN LIST LOOKING FOR END OF QUEUE 12210000
*(HIGH ORDER BYTE OF ADDRESS - X'00') 12220000
SPACE 12230000
L PLCHN(,XR2),XR2 POINT XR2 AT NEXT PARM LIST 12240000
* IN THE LINE QUEUE 12250000
B CMTQND BR TO TEST FOR QUEUE END 12260000
SPACE 12270000
* FOUND END OF QUEUE SO ADD THIS PARAMETER LIST TO CHAIN HERE 12280000
SPACE 12290000
CMADDQ EQU * ADD PARM LIST TO QUEUE 12300000
ST PLCHN(,XR2),PL ADD PARM LIST TO QUEUE 12310000
SPACE 1 12320000
* IF GETMAIN FAILED, LEAVE ON QUEUE UNTIL FREEMAIN DONE 12330000
TBF PL$OPM(,PL),OPGETM+OPGETQ IF GETMAIN FAILED DO NOT RETURN 12340000
BF CMPAII * TO SCHEDULE OPERATION. 12350000
CMQRET B *-* RETURN 12360000
TITLE '$E092/CMDEQ---DEQUEUE PARAMETER LIST FROM LINE' 12370000
******************************************************************** 12380000
* * 12390000
* NAME: CMDEQ * 12390100
* * 12390200
* FUNCTION: DEQUEUE PARAMETER LIST FROM THE LINE QUEUE. * 12390300
* * 12390400
* OPERATION: MOVE CHAIN POINTER OF THIS PARAMETER LIST TO THE CHAIN 12390500
* POINTER OF PARAMETER LIST PRECEDING THIS ONE IN THE Q. * 12390600
* * 12390700
* INPUT: XR1 -> PL, XR2 -> DTF. * 12390800
* * 12390900
* OUTPUT: XR1 -> PL, XR2 -> CURRENT DTF. * 12391000
* * 12391100
******************************************************************** 12400000
SPACE 12410000
* TAKE THE POINTER FROM THIS PARM LIST AND PLACE IN PTR ADDR OF 12420000
* LOCATION THAT POINTED TO THE COMPLETED OPERATION 12430000
SPACE 12440000
CMDEQ EQU * DEQUEUE THE PARM LIST 12450000
ST CMDEQR+3,ARR SAVE RETURN ADDRESS 12460000
LA LCBPLQ-1(,DTF),XR2 LOAD PTR TO FIRST PARM LIST. 12470000
CMDQCK EQU * * LOCAL 12480000
CLC PLCHN(2,XR2),CMSPL NEXT PARM LIST TO DEQ ? 12490000
JE CMDCHN YES-GO TO DE-CHAIN IT. 12500000
L PLCHN(,XR2),XR2 UPDATE TO NEXT PARM LIST. 12510000
B CMDQCK GO BACK AND CHECK THIS ONE. 12520000
* MOVE PTR TO NEXT PARM LIST TO PREVIOUS PARM LIST POINTER 12530000
CMDCHN EQU * * LOCAL 12540000
MVC 1(2,XR2),PLCHN(,PL) MOVE POINTER 12550000
MVC PLRTC(2,PL),PL$RTC(,PL) SET EXTERNAL RETURN CODE NOW 12560000
* * THAT PLCHN ISNT USED. 12570000
L CMSDTF,DTF RESTORE DTF ADDR TO XR2. 12570100
CMDEQR B # RETURN 12580000
TITLE '$E092/CMSRPL--- SEARCH PARAMETER LIST CHAIN FOR LINE' 12590000
*********************************************************************** 12600000
* * 12610000
* NAME--CMSRPL * 12620000
* * 12630000
* TITLE--SEARCH PARAMETER LIST CHAIN FOR LINE FOR PL TO SCHEDULE * 12640000
* * 12650000
* FUNCTION-- * 12660000
* LOOK FOR NON-READ IF ANY TO EXECUTE NOW * 12670000
* ELSE SEARCH THE QUEUE FOR A READ AND START ALL READS FOR WHICH * 12680000
* THE NECESSARY HOLD BUFFER SPACE CAN BE OBTAINED * 12690000
* ASSURE NO OP SCHEDULED TO TERMINAL IN ERROR RECOVERY * 12700000
* * 12710000
* OUTPUT - XR1 WILL POINT TO PARAMETER LIST TO SCHEDULE * 12720000
* XR2 WILL POINT TO THE TUB. * 12730000
*********************************************************************** 12740000
SPACE 1 12750000
CMSRPL EQU * 12760000
ST CMSRRT+3,ARR 12770000
AIF (&NOB).C0469 12780000
TBN $BDDEV(,DTF),BSCA BSC DTF ? 12790000
JF CMSRP1 NO-DON'T SET TIMER IND. OFF 12800000
SBF LCBATR(,DTF),LCBTIM SET TIMER IND. OFF 12810000
CMSRP1 EQU * * 12820000
.C0469 ANOP 12830000
CLI LCBPLQ-1(,XR2),NOBIT IS QUEUE EMPTY 12840000
JNE CMSRP2 NO - CHECK THE QUEUE. 12840700
AIF (&NBDA).C0470 12841400
TBN $BDDEV(,DTF),BSCA BSC DTF ? 12841700
L $BDWKA(,DTF),XR1 XR1 --> WORKAREA 12842100
TBN $BWKMC(,XR1),X'01' IS DA WORKING? 12842800
JF CMSRP3 NO - DON'T CANCEL TIMEOUT. 12843500
TBF LCBAT1(,DTF),LCBNTQ+LCBINT NO PARM LIST OR REMOVED FROM Q? 12844200
JF CMSRP3 DON'T CANCEL TIMEOUT. 12844900
DC XL3'F38802' SIO TO CANCEL 2 SEC. T. O. 12845600
CMSRP3 EQU * * 12846300
.C0470 ANOP 12847000
B CMPAII BR TO CHECK OP END COUNT. 12847700
CMSRP2 EQU * * 12848400
SPACE 12860000
*********************************************************************** 12870000
* REQUEST IN QUEUE FOR THE LINE READY TO GO 12880000
*********************************************************************** 12890000
SPACE 12900000
L LCBPLQ(,XR2),PL POINT XR1 AT 1ST PARM LIST IN Q 12910000
CMRDCK EQU * 12920000
L PLTUBA(,PL),XR2 POINT XR2 AT THE TUB 12930000
AIF (&NSWL).S0100 12940000
SPACE 1 12950000
* IGNORE SYSTEM REQUESTS IF A USER TASK OWNS THE SWITCHED LINE. SB 12960000
SPACE 1 12970000
AIF (&ONE).E0600 12980000
TBN TUBCHR(,XR2),TUBLNE BSCA LINE ? S2 12990000
.E0600 ANOP 13000000
TBN TUBAT1(,XR2),TUBSWC SWITCHED LINE ? SB 13010000
JF CMRFSH NO-GO CHECK REFRESH OPTION. SB 13020000
L TUBDTF(,XR2),DTF POINT TO THE DTF. SB 13030000
TBN LCBATR(,DTF),LCBNIT LINE CONNECTED ? SB 13040000
JT CMOWNC YES- CHECK OWNING TUB SB 13050000
SPACE 1 13060000
* LINE NOT CONNECTED - ALLOW REQUEST UNLESS SYSTEM REQUEST AND SB 13070000
* USER TASK OWNS THE LINE. SB 13080000
SPACE 1 13090000
CLC LCBTCB(2,DTF),X$0000 SWITCH LINE OWNED ? SB 13100000
JE CMRFSH NO - HANDLE OPERATION NOW. SB 13110000
CLC LCBTCB(2,DTF),@CPTCB USER TASK OWN LINE ? SB 13120000
TBN PLOPM(,PL),OP$SYS * SYSTEM REQUEST ? SB 13130000
JC CMNXTP,TRUNEQ YES-SKIP THIS PARM LIST. SB 13140000
J CMRFSH NOT CONNECTED SO SCHEDULE SB 13150000
SPACE 1 13160000
* LINE CONNECTED - CHECK TO SEE IF REQUEST IS FOR CONNECTED TUB SB 13170000
SPACE 1 13180000
CMOWNC EQU * * LOCAL SB 13190000
CLC PLTUBA(2,PL),LCBOWN(,DTF) YES - THIS TUB OWN THE LINE ? SB 13200000
JNE CMNXTP NO - LINE OWNED BY ANOTHER SB 13210000
* * TUB SO SKIP THIS PL SB 13220000
CMRFSH EQU * * SB 13230000
L PLTUBA(,PL),XR2 POINT TO THE TUB. SB 13240000
.S0100 ANOP 13250000
AIF (&N32).T0700 13260000
SPACE 13270000
* IF OPERATION IS REFRESH OF SCREEN, THE SET TEMP OP CODE FOR PUT. 0B 13280000
SPACE 13290000
AIF (&ONE).E0700 13300000
TBN TUBCHR(,XR2),TUBLNE BSCA LINE ? 02 13310000
JF CMRXPT NO-GO CHECK PUT IN ERP. 02 13320000
.E0700 ANOP 13330000
TBN PLOPM(,PL),OPSTOP STOP INVITE AND - B 13330700
TBN TUBSCS(,XR2),TUBCLR * CLEAR KEY DEPRESSED ? B 13331400
JF CMRXE1 NO-CONTINUE B 13332100
SPACE 1 13332800
* PUT CLEAR RETURN CODE INTO PARM LIST AND GO DE-QUEUE IT B 13333500
SPACE 1 13334200
MVI PL$RTC(,PL),RCXCLR INT. RETURN CODE = CLEAR B 13334900
SBF TUBSCS(,XR2),TUBCLR SET OFF CLEAR IND. B 13335600
ST CMSPL,PL SAVE PL ADDRESS B 13336300
L TUBDTF(,XR2),XR2 XR2--> DTF B 13337000
B CMRETC GO DE-Q AND POST B 13337700
CMRXE1 EQU * * B 13338400
SPACE 2 13339100
TBN PL$OPC(,PL),OPRFSH REFRESH OPERATION REQUESTED ? 0B 13340000
JF CMRXER NO-GO TEST FOR TERM IN ERP. 0B 13350000
MNN PL$OPM(,PL),CCPUT ALTER OP CODE TO A PUT. 0B 13360000
J CMSCHO GO HANDLE NOW 0B 13364000
CMRXER EQU * * 0B 13370000
SPACE 1 13380000
* IF POLL FOR STATUS OPERATION , HANDLE AS HIGHEST PRIORITY. 0B 13390000
SPACE 1 13400000
TBN PL$OPC(,PL),OPLSNS POLLING FOR STATUS ? 0B 13410000
JT CMTSRS YES-GO HANDLE STATUS POLL. 0B 13420000
SPACE 1 13425000
CMRXPT EQU * * 0B 13430000
.T0700 ANOP 13440000
TBF PL$OPM(,PL),OPGETM GETMAIN NOT FAILED 13450000
TBN PL$OPM(,PL),OPPUT IS IT PUT 13460000
TBF TUBAT3(,XR2),TUBERP ASSURE NOT IN ERROR RECOVERY 13470000
JF CMNXTP NO- CHECK NEXT ONE 13480000
CLI PLRECA-1(,PL),NOBIT IF BUFFER IS ALREADY GETMAINED 13490000
JNE CMBFOK YES - SKIP GETMAIN 13500000
* * SKIPPED FOR PUT NO WAIT, 13510000
* * MLTA PUT-NOT FIRST TIME THRU, 13520000
* * DFF PUT WAIT( ALREADY DONE)OR 13530000
* * SYS PUT WAIT ( NONE NEEDED). 13540000
SPACE 1 13550000
* NON-DFF USER PUT WAIT - GETMAIN BUFFER FOR ADDRESSABILITY 13560000
SPACE 1 13570000
SBN $FLGC,#PUTTP INDICATE 'GETMAIN FOR PUT' REQ. 13575000
B CMGMPT GETMAIN HOLD BUFFER AND MOVE 13580000
* * DATA INTO IT. 13590000
SPACE 1 13600000
CMBFOK EQU * * LOCAL 13610000
TBN PL$OPM(,PL),OPGETM IF WAITING FOR GETMAIN 13620000
JT CMNXTP YES - GET NEXT PL IN QUEUE 13630000
J CMSCHO NO - RETURN IT TO BE SCHEDULED 13640000
SPACE 1 13650000
CMNXTP EQU * CHECK NEXT PARM LIST 13660000
CLI PLCHN-1(,PL),NOBIT ANY MORE PARM LISTS IN QUEUE 13670000
JE CMTSRS NO-GO TRY TO SCHEDULE READ. 13680000
SPACE 13690000
*MORE REQUESTS IN QUEUE-CHECK THAM FOR NON-READ 13700000
SPACE 13710000
L PLCHN(,PL),PL PT XR1 AT NEXT PARM LIST 13720000
B CMRDCK BR TO CHECK FOR NON READ 13730000
SPACE 13740000
* ALL READS IN THE QUEUE SO DO ANALYSIS IN TERMS OF ELIGIBLITY 13750000
* BECAUSE RECORD AREA OR HOLD BUFFER IS AVAILABLE 13760000
* MAY HAVE NON-READS IN QUEUE BUT THEY WILL BE TO TERMINALS IN ERROR 13770000
* RECOVERY 13780000
SPACE 13790000
CMTSRS EQU * TEST READ ELIGIBILITY 13800000
B CMIVGM BRANCH TO DO READ GETMAIN ANALYS 13810000
SPACE 1 13820000
TBN CMSWIT,CMRSLN IS RESCHEDULE SWITCH ON 13830000
BF CMPAII NO- CANNOT RESCHEDULE NOW. 13840000
SPACE 13850000
L CMLPL,PL LAST READ PL SCHEDULED - WILL 13860000
* * GO INTO TRACE FROM CMSPL 13870000
CMSCHO EQU * SCHEDULE THE PARM LIST REQUEST 13880000
ST CMSPL,PL SAVE PARM LIST ADDR 13890000
L PLTUBA(,PL),XR2 POINT XR2 AT THE TUB 13900000
CMSRRT B *-* RETURN 13910000
TITLE '$E092/$$BMCH--CCP-VERSION-TP-CHECK' 13920000
*********************************************************************** 13940000
* * 13950000
*TITLE: $$BMCH - TELEPROCESSING MULTIPLE WAIT. * 13960000
* * 13970000
*FUNCTION: THE FUNCTION OF THIS WAIT ROUTINE IS TO SCAN A LIST OF DTFS* 13980000
* AND, IF NECESSARY, PASS CONTROL AND THE DTF TO THE APPROPRIATE * 13990000
* DEVICE WAIT ROUTINE (BSCA, OR MLTA). THE USER IS THEN NOTIFIED * 14000000
* OF A COMPLETION VIA THE APPROPRIATE DTF. * 14010000
* * 14020000
*INPUT: INPUT TO THE ROUTINE IS THE WAIT LIST OF DTF'S. * 14030000
* * 14040000
*OUTPUT: OUTPUT FROM THE ROUTINE WILL BE REGISTER 2 POINTING AT THE * 14050000
* COMPLETED DTF, WHICH CONTAINS THE COMPLETION CODE. ON RETURN WITH* 14060000
* NO COMPLETIONS OR NO ACTIVE DTF'S, XR2 WILL POINT TO THE LAST DTF * 14070000
* IN THE LIST, ALSO WITH THE APPROPRIATE COMPLETION CODE. * 14080000
* * 14090000
*EXTERNAL ROUTINES: * 14100000
* MSBSCH - BSCA PROGRAM WAIT ROUTINE.(ADDR STORED AT CHBMBS BY * 14110000
* MLMP). * 14120000
* $MLCK0 - MLTA CHECK ROUTINE. (ADDR STORED AT CHBMML BY MLTA) * 14130000
* * 14140000
*********************************************************************** 14150000
SPACE 2 14200000
$$BMCH EQU * ENTRY POINT NAME FOR MLMP/MLTA 14200100
CMBMCH EQU * INTERNAL CM ENTRY POINT. 14210000
ST CHSTOR,ARR SAVE RETURN @ 14220000
MVI CHACTV,UNCOND INITIALIZE SWITCH TO FALL THRU 14230000
L @CKLST,LISTRG POINT REGISTER AT WAIT LIST 14240000
CHSTRT EQU * * 14260000
L DTFADR(,LISTRG),DTF POINT REG 2 TO DTF 14270000
TBN CHLSTS(,LISTRG),OPGONE COMPL. CODE DESTROYED ? 14280000
JF CHNODS NO - DONT RESTORE IT 14290000
MVI DTFCMP(,DTF),OPACC RESTORE COMPLETION CODE 14300000
CHNODS EQU * * 14310000
TBN CHLSTS(,LISTRG),CHLSKP IS ENTRY TO BE SKIPPED ? 14320000
JT CHSTND YES - GO TEST FOR END 14330000
TBN DTFATR(,DTF),FILOPN+FILEAC THIS FILE OPEN AND ACTIVE ? 14340000
JF CHSTND NO - GO CHECK FOR END 14350000
AIF (&NOM).H0300 14360000
AIF (&NOB).H0200 14370000
CLI DTFDEV(,DTF),BSCA BSCA ADAPTER ? 2 14380000
JNL CHBSCA YES - 2 14390000
.H0200 EJECT 14400000
******************************************************************* M 14410000
* PROCESS MLTA DTF * M 14420000
******************************************************************* M 14430000
SPACE 2 14440000
CHMLTA EQU * * LOCAL M 14450000
CLI CHCHEK,NOMLTA IS MLTA IN THE PROGRAM ? M 14460000
JE CHSTND NO - CHECK FOR END M 14470000
MVI CHACTV,NOOP SET ACTIVE DTF FOUND SWITCH M 14480000
ST CHSV1,LISTRG SAVE WAIT LIST POINTER M 14490000
L @CKLST,LISTRG POINT TO START OF WAIT LIST M 14500000
B *-* GO TO MLTA CHECK ROUTINE M 14510000
CHCHEK EQU *-2 ADDRESS FILLED IN BY M 14520000
CHBMML EQU *-1 * MLTA IOCS OPEN M 14530000
SPACE 14540000
CHSV1 EQU *+3 * M 14550000
LA *-*,LISTRG RESTORE WAIT LIST POINTER M 14560000
TBN DTFATR(,DTF),FILEAC OPERATION POSTED COMPLETE ? M 14570000
JF CHPNTR YES - SET POINTER M 14580000
AIF (&NOB).H0400 14590000
J CHSTND GO TEST FOR END OF LIST B 14600000
.H0300 SPACE 2 14610000
******************************************************************** B 14620000
* PROCESS BSCA DTF * B 14630000
******************************************************************** B 14640000
SPACE 1 14650000
CHBSCA EQU * * LOCAL B 14660000
CLI CHCKBS,NOBSCA IS BSCA IN THE PROGRAM? B 14670000
JE CHSTND BRANCH IF NOT B 14680000
CLI DTFCMP(,DTF),OPACC BSCA OPERATION PENDING ? B 14690000
JNE CHSTND NO - TEST FOR END OF LIST B 14700000
MVI CHACTV,NOOP SET ACTIVE DTF FOUND B 14710000
CHCKBS EQU *+2 * B 14720000
B *-* GO TO BSCA WAIT ROUTINE B 14730000
CHBMBS EQU *-1 ADDRESS OF MLMP WAIT(IOCS SETS)B 14740000
CLI DTFCMP(,DTF),OPACC COMPLETION POSTED ? B 14750000
JNE CHPNTR NO - BRANCH B 14760000
.H0400 EJECT 14770000
*********************************************************************** 14780000
* CHECK FOR END OF WAIT LIST * 14790000
*********************************************************************** 14800000
SPACE 2 14810000
CHSTND EQU * 14820000
&MIX SETA &MLA+&BSC 14830000
AIF (&MIX LE '1').Y0100 14840000
TBN CHLSTS(,LISTRG),CHLAST END OF WAIT LIST ? Y 14850000
JT CHEND YES - BRANCH Y 14860000
LA NEXT(,LISTRG),LISTRG POINT TO NEXT LIST ENTRY Y 14870000
B CHSTRT GO TEST NEXT ENTRY Y 14880000
.Y0100 ANOP 14890000
SPACE 2 14900000
*********************************************************************** 14910000
* PROCESS END OF LIST CONDITIONS * 14920000
*********************************************************************** 14930000
SPACE 1 14940000
CHEND EQU * * 14950000
L DTFADR(,LISTRG),DTF POINT XR2 TO DTF 14960000
CLI DTFCMP(,DTF),OPACC IS CODE OP ACCEPTED ? 14970000
JNE CHNOOP NO - BRANCH 14980000
SBN CHLSTS(,LISTRG),OPGONE SET BIT FOR DESTROYED CODE 14990000
CHNOOP EQU * * 15000000
MVI DTFCMP(,DTF),INACTV SET COMPLETION TO NO ACT DTF'S 15010000
** THE FOLLOWING BRANCH IS SET TO NOOP IF AN ACTIVE DTF IS FOUND ** 15020000
CHACTV EQU *+1 ACTIVE DTF SWITCH 15030000
BC CHPNTR,UNCOND BRANCH IF NO ACTIVE DTF'S 15040000
MVI DTFCMP(,DTF),NOCOMP SET NO COMPLETION RETURN CODE 15050000
EJECT 15060000
*********************************************************************** 15070000
* RESTORE POINTERS AND EXIT * 15080000
*********************************************************************** 15090000
SPACE 3 15100000
CHPNTR EQU * * 15110000
L DTFADR(,LISTRG),DTF POINT REGISTER TO DTF 15120000
CHSTOR EQU *+3 RETURN ADDRESS PLUGGED HERE 15130000
B # RETURN 15140000
TITLE '$E092/CMERPC--CHECK FOR PUT TO TERMINAL IN ERP' 15150000
******************************************************************** 15160000
* NAME -- CMERPC * 15170000
* * 15180000
* TITLE - CHECK FOR PUT TO TERMINAL IN ERP AND HANDLE IT. * 15190000
* * 15200000
* OPERATION - * 15210000
* CHECK FOR ERP. * 15220000
* IF TERMINAL IN ERP GOTO TRANSIENT $CC4MP. * 15230000
* ON RETURN , CHECK FOR PUT THEN GET. * 15240000
* IF ONLY PUT - IGNORE IT AND GO POST REQUESTER. * 15250000
* IF PUT THEN GET - RETURN TO ALLOW SCHEDULING OF GET. * 15260000
* * 15270000
* INPUT : XR1 - PL ADDRESS * 15280000
* * 15290000
* OUTPUT : XR1 - PL, XR2 - TUB. * 15300000
* * 15310000
* EXITS : IF PUT ONLY TO TERMINAL IN ERP - CMPAII * 15320000
* IF TERMINAL NOT IN ERP OR NOT PUT ONLY - RETURN * 15330000
******************************************************************** 15340000
SPACE 1 15350000
CMERPC EQU * * 15360000
ST CMERPR+3,ARR SAVE RETURN ADDRESS 15370000
L PLTUBA(,PL),XR2 TUB ADDRESS 15380000
TBN TUBAT3(,XR2),TUBERP IS TUB IN CCP ERP 15390000
TBN PLOPC(,PL),OPPUT DOES OP INVOLVE PUT 15400000
TBF PLOPM(,PL),OPSTOP TEST FOR NOT PURGE OPERATION 15410000
JF CMERPR JUMP IF PUT WILL NOT BE IGNORED 15420000
SPACE 15430000
****************************************************************** 15440000
* IGNORE PUT OPERATION BECAUSE TERMINAL IN ERROR RECOVERY 15450000
****************************************************************** 15460000
SPACE 15470000
SVC 0 ##### TRANSIENT CALL ###### 15480000
DC AL1(CCPRIB) CCP SVC RIB 15490000
DC AL1(CC4MP) IGNORE PUT TRANSIENT 15500000
* RETURNS TO ARR IF PUT ONLY 15510000
* TO ARR+4,IF PUT THEN INVITE 15520000
SPACE 15530000
B CMPAII BRANCH TO PERFORM POST CHECK 15540000
* IF THE OPERATION INVOLVED A READ - THE TRANSIENT WILL RETURN 15550000
* HERE -- CONTINUE TO DROP THROUGH AND SCHEDULE THE READ. 15560000
SPACE 15570000
CMERPR B *-* RETURN 15580000
MEND 15590000