|
|
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: 24384 (0x5f40)
Types: s3xseg
Names: »S$E087«
└─⟦827b5bd03⟧ Bits:30009184 5702-sc1.V16.ccp
└─⟦f17e99db6⟧
└─⟦this⟧ »S$E087«
MACRO 00010000
.********************************************************************** 00020000
.* NAME: $E087 V-14, M-00. * 00040000
.********************************************************************** 00650000
$E087 00660000
GBLB &ONE,&NOB,&NOM,&N2741,&NSCTL 00670000
GBLB &NPP,&NMP,&NSWL,&NCS,&N32,&NDF,&MOD4 00680000
LCLA &MIX 00700000
TEXT 00710000
* R-14,C-00 CHANGE LEVEL 00720000
TITLE '$E087/CMBUSY---LINE-IS-BUSY,-TRY-TO-ABORT' 00730000
*********************************************************************** 00740000
* TP LINE BUSY - DETERMINE IF ABORT NEEDED * 00750000
*********************************************************************** 00760000
SPACE 00770000
* LINE IS BUSY AND MAY HAVE MORE HONORABLE REQUEST WAITING IN THE QUEUE 00780000
SPACE 00790000
* IF PREVIOUS OP WAS READ - TRY TO ABORT 00800000
* DON'T CARE IF STARTED OR NOT BECAUSE RETURN CODE OF 44 OR NON-44 WILL 00810000
* REFLECT THIS 00820000
SPACE 00830000
SPACE 00840000
CMBUSY EQU * LINE IS BUSY 00850000
AIF (&ONE).C0510 00860000
TBN $BDDEV(,DTF),BSCA BSCA DTF ? 2 00870000
JF CMBOPX NO-GO CHECK MLTA BUSY. 2 00880000
.C0510 ANOP 00890000
AIF (&NOB).C0530 00900000
TBN LCBAT2(,DTF),LCBRCI+LCBPUT RECEIVE INIT AND PUT PENDING. B 00910000
JF CMPAII NO-GO POST AS NECESSARY. B 00920000
B $CC4PI GO TO CALL IN THE B 00930000
DC AL1(CC4BC) CANCEL OPERATION TRANSIENT. B 00940000
CCPUT DC AL1(OPPUT) REFRESH OP CODE VALUE. B 00950000
* LINKAGE INDICATOR TO 'BC', CALLB 00960000
* IS FROM RESIDENT CODE. B 00970000
SPACE 00980000
AIF (&NOM).M1400 00990000
J CMPAII GO TO POST USER. 2 01000000
SPACE 01010000
CMBOPX EQU * * 2 01020000
.C0530 ANOP 01030000
TBN $MDOPC(,XR2),MLREAD IS BUSY OP A READ M 01040000
AIF (&N2741).B5100 01050000
CLI $MDTTP(,XR2),ML2741 IS THIS 2741 1M 01060000
JC CMPAII,ANY+FALSE+EQ JUMP IF NOT READ OR IF 2741 1M 01070000
AGO .B5150 01080000
.B5100 ANOP 01090000
JF CMPAII JUMP IF NOT READ M 01100000
.B5150 ANOP 01110000
SPACE 01120000
* ATTEMPT TO ABORT THE PREVIOUS READ M 01130000
SPACE 01140000
CMDOAB EQU * START ABORT M 01150000
SPACE 01160000
MVI $MDOPC(,XR2),MLABRT MOVE ABORT OP CODE TO DTF M 01170000
B MLTIO1 BR TO MLTA IOCS M 01180000
B $CC4TT BR TO TRACE M 01190000
DC AL1(TTMSIO) MLTA START IO TRACE ID M 01200000
.M1400 ANOP 01210000
TITLE '$E087/CMPAII----DETERMINE-IF-POST-NEEDED' 01220000
*********************************************************************** 01230000
* DETERMINE NECESSITY OF CM POSTING REQUESTER * 01240000
*********************************************************************** 01250000
SPACE 01260000
* IF NO WAIT REQUEST THEN POST WPAAII BIT 01270000
* TO INDICATE THE TP REQUEST HAS BEEN SCHEDULED 01280000
SPACE 01290000
CMPAII EQU * DETERMINE IS POST NEEDED 01300000
SPACE 01310000
* DO NOT POST UNLESS TP REQ SWITCH IS ON SINCE IF IT IS OFF 01320000
* WE ARE ONLY RESCHEDULING THE LINE AND THE POST FOR INITIAL SCHEDULING 01330000
* HAS ALREADY OCCURRED 01340000
SPACE 01350000
TBN CMSWIT,CMTPRQ WAS TP REQUEST SCHEDULED 01360000
JF CMTSRQ JUMP IF NOT ON 01370000
SPACE 01380000
* POST BIT ON - DETERMINE IF THIS OPERATION REQUIRES POSTING REQUESTOR 01390000
SPACE 01400000
L CMSPL,XR1 RESET XR1 -> PARM LIST 01410000
* ------------------------------START-@07 01412000
TBN PLOPM(,XR1),OPDISC DISCONNECT OPERATION ? 01414000
JT CMPOST YES - GO POST 01416000
* ------------------------------END---@07 01418000
TBF PL$OPM(,XR1),OPNOW IS IT WAIT OP 01420000
JT CMRQBF JUMP IF USER WAIT OP 01430000
* OR NOT STOP OP REQUEST 01440000
AIF (&NDF).T1000 01450000
SPACE 01460000
* IF ORIGINAL OP REQUEST WAS A WAIT OPERATION, THEN THIS IS 1) A @15 01470000
* DFF GET CONVERTED TO AN INVITE OR 2) A SYS WAIT-TYPE OP @15 01480000
* IF 1) DON'T POST - WAIT FOR OP END BEFORE POSTING @15 01483000
* IF 2) POST NOW (SYSTEM PUT-WAIT HAS BEEN DISCARDED BY CM) @15 01486000
SPACE 01490000
TBN PLOPM(,PL),OP$SYS SYSTEM OP? @15 01493000
JT CMPOST YES - GO POST @15 01496000
TBN PLOPC(,PL),OPNOW ORIGINALLY A NOWAIT ? FB 01500000
JF CMRQBF NO-DON'T POST, THIS IS DFF GETFB 01510000
.T1000 ANOP 01520000
CMPOST EQU * * LOCAL 01525000
SPACE 01530000
B CMPSRQ BR TO POST REQUESTER-TP SCHEDULED01540000
SPACE 01550000
* SET TP REQUEST POST BIT OFF 01560000
SPACE 01570000
CMRQBF SBF CMPMSK,WPAAII SET TP REQ POST BIT OFF 01580000
SBF CMSWIT,CMTPRQ TURN OFF TP REQUEST SWITCH 01590000
SPACE 01600000
* CHECK TO SEE IF THERE IS ANY MORE WORK TO DO BEFORE EXITING 01610000
SPACE 01620000
CMTSRQ EQU * TEST FOR MORE WORK TO DO 01630000
SPACE 01640000
* DETERMINE IF AN ATTEMPT TO START AN ONLINE TEST FAILED 01650000
* IF YES - THEN BRANCH BACK AND SEE IF LINE CAN BE RESCHEDULED 01660000
SPACE 01670000
TBN CMSWIT,CMNOST DID ONLINE TEST START FAIL 01680000
SBF CMSWIT,CMNOST SET OFF ONLINE TEST NOT STARTED 01690000
BT CMTSBY BRANCH IF ONLINE TEST START FAIL 01700000
AIF (&NOB).C0550 01710000
L CMSDTF,DTF RELOAD THE DTF REG. B 01720000
AIF (&ONE).C0540 01730000
TBN $BDDEV(,DTF),BSCA BSCA DTF ? 2 01740000
.C0540 ANOP 01750000
TBN LCBAT1(,DTF),LCBINT INTERRUPT RCV, AND B 01760000
TBF LCBAT1(,DTF),LCBNTQ * PARM LIST QUEUED ? B 01770000
JF CMTSOE NO-GO TEST FOR MORE WORK B 01780000
SBF LCBAT1(,DTF),LCBINT RESET INTERRUPT IND. B 01790000
B CMFORM NOW GO FORM NEXT LINE OP CODE. B 01800000
.C0550 ANOP 01810000
SPACE 01820000
CMTSOE EQU * TEST OP END COUNT 01830000
SPACE 01840000
CLI CCOECT,CMZERO IS OP END COUNT ZERO 01850000
BNE CMCHEK BR TO ISSUE CHECK MACRO 01860000
SPACE 01870000
* TEST FREEMAIN POST BIT TO SEE IF IT HAS BEEN SET ON WITHIN $CC4CM 01880000
SPACE 01890000
CMTSFM EQU * TEST FREEMAIN POST BIT 01900000
TBN CMPMSK+1,WPBFR FREEMAIN POSTED 01910000
BT CMFRMN BR TO FREEMAIN ANALYSIS ROUTINE 01920000
AIF (&MOD4 NE '1').LJ005 01920200
SPACE 2 01920400
* DETERMINE IF THE CONSOLE KEYBOARD NEEDS TO BE ENABLED 01920600
SPACE 1 01920800
LA $CCCOM,XR1 XR1 --> CCP COMMON AREA 01921000
L @KMWK(,XR1),XR2 XR2 --> CONSOLE WORK AREA 01921200
TBN #KMSWT(,XR2),#KMERQ NEED TO BE ENABLED? 01921400
JF CMTSPB NO - GO CHECK FOR NEW REQUEST 01921600
SPACE 1 01921800
MVI CMSXNT,CC4X5 INITIALLY 'ENABLE ONLY' XIENT 01922000
TBN #KMSW2(,XR2),#KMCMN COMMAND PROCESSOR? 01922200
JF CMCLXN NO -CALL CC4X5 01922400
MVI CMSXNT,CC4XB SET TO CALL XB 01922600
SBF #KMSW2(,XR2),#KMTHR+#KMITO SET OFF INTO AND THRU SWITCH 01922800
MVC #KMFSE-1(2,XR2),#KMFNX-2(,XR2) PUT IN C/S AND- 01923000
MVC #KMFSE(1,XR2),#KMFNX(,XR2) * --N 01923200
TBN #KMSW2(,XR2),#KMCMF DISPLAY ? 01923400
JF CMCLXN NO - CALL XB 01923600
MVI CMSXNT,CC4XF SET TO CALL XF 01923800
MVC #KMFSS(3,XR2),#KMFD1(,XR2) MOVE IN C/S/N 01924000
CMCLXN EQU * * 01924200
B $CC4PI CALL TRANSIENT AREA HANDLER 01924400
CMSXNT DC AL1(CC4X5) XIENT ID(ALTERED AS REQUIRED) 01924600
SPACE 1 01924800
* CC4X5 RETURNS HERE 01925000
J CMTSPB GO AROUND 01925200
SPACE 1 01925400
* CC4XB AND CC4XF RETURN HERE 01925600
SPACE 1 01925800
CMTRCN EQU * * 01926000
LA $CCCOM,PL XR1 --> CONSOLE -- 01926200
L @KMWK(,PL),PL * PARM -- 01926400
LA #KMDPL(,PL),PL * LIST 01926600
ST CMSPL,PL SAVE IT FOR RESCHEDULE 01926800
L PLTUBA(,PL),XR2 XR2 --> TUB 01927000
L TUBDTF(,XR2),XR2 XR2 --> DTF 01927200
ST CMSLCB,XR2 SAVE IT FOR RESCHEDULE 01927400
SBN LCBAT2(,DTF),LCBPUT SET 'PUT PENDING' 01927600
B CMTSBY GO TRY TO DO PUT 01927800
CMTSPB EQU * * 01928000
.LJ005 ANOP 01928200
SPACE 01930000
* TEST TP REQUEST POST BIT TO SEE IF TP REQUEST STILL NEEDS TO BE 01940000
* SCHEDULED 01950000
SPACE 01960000
TBN CMPMSK,WPAAII IS TP REQUEST POST BIT ON 01970000
BT CMREQ IF TRUE-BRANCH BACK TO SCHEDULE 01980000
* THE REQUEST 01990000
EJECT 02000000
*********************************************************************** 02010000
* DETERMINE IF THERE IS A LINE THAT NEEDS TO BE RESCHEDULED 02020000
* DUE TO BEING IN ERP 02030000
*********************************************************************** 02040000
SPACE 02050000
CMDERP EQU * DETERMINE IF LINE NEEDS TO BE 02060000
* RESCHEDULED BACAUSE OF ERP 02070000
LA $CCCOM,XR1 POINT XR2 AT CCP COMM AREA 02080000
L @CMWK(,XR1),XR2 POINT XR1 AT CM WORK AREA 02090000
MVC CMSLCB(2),#CMERP(,XR2) MOVE ERP DTF@ TO SAVE AREA 02100000
SPACE 02110000
* IF THE ADDRSS IS VALID 2-BYTE ADDRESS - THEN TRY TO RESCHEDULE THE 02120000
* LINE 02130000
SPACE 02140000
CLI #CMERP-1(,XR2),NOBIT IS IT NULL DTF ADDRESS 02150000
MVI #CMERP-1(,XR2),NOBIT CLEAR THE DTF@ 02160000
AIF (&NOB).C0700 02170000
JE CMCIOX NO-GO CHECK FOR CONSOLE WORK. B 02180000
L CMSLCB,XR2 POINT TO THE DTF. B 02190000
AIF (&NOM).C0600 02200000
TBN $BDDEV(,XR2),BSCA BSCA DTF ? 2 02210000
BF CMTBSY NO-GO CHECK FOR MLTA BUSY. 2 02220000
.C0600 ANOP 02230000
TBN LCBAT2(,XR2),LCBACT LINE ACTIVE ? B 02240000
BF CMRSCH NO-GO RESCHEDULE WORK ON IT. B 02250000
B CMBUSY GO PERFORM BUSY ACTION. B 02260000
SPACE 1 02270000
CMCIOX EQU * * B 02280000
AIF (&MOD4).LJ010 02285000
AGO .C0800 02290000
.C0700 ANOP 02300000
BNE CMTSBY IF DTF@ NOT NULL - BRANCH BACK 02310000
.C0800 ANOP 02320000
* RESCHEDULE THE LINE 02330000
SPACE 2 02340000
* DETERMINE IF CONSOLE OUTPUT NEEDS TO BE SCHEDULED 02350000
* IF CONSOLE IS NOT BUSY AND PARAMETER LIST IS IN THE QUEUE 02360000
* BRANCH BACK TO SCHEDULE SOME OUTPUT 02370000
SPACE 02380000
CLI @KMQTB-1(,XR1),NOBIT IS THERE PARM LIST IN OUTPUT Q 02390000
L @KMWK(,XR1),XR2 POINT XR1 AT KM WORK AREA 02400000
TBF #KMSWT(,XR2),#KMBSY TEST FOR CONSOLE NOT BUSY 02410000
BC KMINTR,NONE+EQ+FALSE BRANCH IF CONSOLE NOT BUSY AND 02420000
* THERE ARE PARM LISTS IN THE 02430000
.LJ010 ANOP 02435000
TITLE '$E087/CMWAIT----WAIT' 02440000
*********************************************************************** 02450000
* $ C C 4 C M W A I T * 02460000
*********************************************************************** 02470000
SPACE 02480000
* NO MORE WORK FOR $CC4CM TO DO SO ISSUE WAIT 02490000
SPACE 02500000
SPACE 02510000
*********************************************************************** 02520000
*********************************************************************** 02530000
* ISSUE WAIT 02540000
* REGISTERS ARE SAVED SO WE RESUME HERE AFTER WAIT IS POSTED 02550000
SPACE 1 02560000
CMWAIT EQU * ISSUE WAIT 02570000
B $CC4WT 02580000
CMWTMK EQU * WAIT MASK 02590000
DC AL2(256*WPAAII) WAIT MASK - TP REQ AND SOMETIMES 02600000
* FREEMAIN 02610000
DC IL1'1' WAIT COUNT OF 1 02620000
DC AL1(DPDSP+DPREG) SAVE REGS AND MAKE CM NON-DISP 02630000
B $CC4CM RESUME AFTER WAIT-BRANCH TO BEGIN02640000
************************************************************************02650000
TITLE '$E087/CMIVGM---INVITE-BUFFER-ANALYSIS' 02660000
*********************************************************************** 02670000
* * 02680000
* NAME--CMIVGM * 02690000
* * 02700000
* TITLE--INVITE BUFFER ANALYSIS * 02710000
* * 02720000
* FUNCTION--ANALYSIS AND OBTAINING OF GETMAIN BUFFER FOR INVITE * 02730000
* INPUT OPERATIONS IN THE LINE QUEUE. * 02740000
* * 02750000
* OPERATION-- * 02760000
* . IF BSCA POLL FOR STATUS IS IN THE QUEUE SET ALL * 02770000
* POLLING SKIP BITS ON. * 02780000
* . IF LCB CURRENTLY HAS A HOLD AREA FREEMAIN IT. * 02790000
* . IF GET OPERATION TO BE SCHEDULED SET UP TO HANDLE * 02800000
* IT. * 02810000
* . IF SYSTEM INVITE TO BSCA SWITCHED LINE OWNED BY A * 02820000
* USER PROGRAM, THEN IGNORE THE SYSTEM REQUEST FOR * 02830000
* NOW. * 02840000
* . DETERMINE STORAGE REQUIREMENTS TO SCHEDULE EACH * 02850000
* INVITE OPERATION. * 02860000
* . IF STORAGE NOT AVAILABLE IGNORE THE REQUEST. * 02870000
* . IF STORAGE IS AVAILABLE SET UP TO HANDLE IT. * 02880000
* . IF BSCA POLL FOR STATUS, SCHEDULE IT BY ITSELF. * 02890000
* . GETMAIN THE SPACE NEEDED TO SCHEDULE OPERATIONS ON * 02900000
* THE LINE. * 02910000
* . SET UP THE LCB HOLD AREA TO REFLECT THE SPACE * 02920000
* ACQUIRED. * 02930000
* . SET UP GETMAIN PARAMETER LIST IN THE ACQUIRED AREA. * 02940000
* * 02950000
* ENTRY POINT--CMIVGM * 02960000
* * 02970000
* INPUT--AT LEAST ONE PARM LIST IN THE LINE QUEUE. * 02980000
* * 02990000
* OUTPUT--XR1-ADDRESS OF THE LAST TP PARAMETER LIST IN THE QUEUE. * 03000000
* XR2-ADDRESS OF THE DTF. * 03010000
* CMSPL-ADDRESS OF LAST GET/INVITE PARAMETER LIST NOT IN * 03020000
* CCPERP. * 03030000
* * 03040000
* EXTERNAL REFERENCES-- * 03050000
* CMFMR2-FREE LCB HOLD BUFFER BEFORE STARTING * 03060000
* ANALYSIS. * 03070000
* CMSTOR-DETERMINE STORAGE NEED FOR INVITES. * 03080000
* CMBSKP-SET BSCA POLL SKIP BITS ON/OFF. * 03090000
* CMONSK/CMOFSK-SET MLTA POLL SKIP BITS * 03100000
* ON/OFF. * 03110000
* CMGMRT-GETMAIN HOLD BUFFER TO SCHEDULE * 03120000
* INVITES ON THE LINE. * 03130000
* * 03140000
* EXIT, NORMAL--TO NSI OF CALLER. * 03150000
* * 03160000
* EXIT, ERROR--TO CPHALT WITH A 4 BLITZ HALT IF THE GETMAIN FAILS. * 03170000
* * 03180000
*********************************************************************** 03190000
SPACE 03200000
CMIVGM EQU * GETMAIN ANALYSIS OF INVITE 03210000
* INPUTS IN LINE QUEUE 03220000
ST CMIVGX+3,ARR SAVE RETURN ADDRESS 03230000
L CMSLCB,XR2 POINT XR2 AT THE LCB 03240000
SBF LCBATR(,XR2),LCBGMN SET OFF GETMAIN NEEDED IN LCB 03250000
SBF CMSWIT,CMRSLN SET OFF INDICATION THAT LINE 03260000
* CAN BE SCHEDULED FOR READ 03270000
SPACE 03280000
* POINT TO FIRST PARAMETER LIST IN THE LINE QUEUE 03290000
SPACE 03300000
L LCBPLQ(,XR2),XR1 POINT XR1 AT 1ST PARM LIST 03310000
AIF (&N32).T2000 03320000
SPACE 1 03330000
* IF BSCA POLL FOR STATUS ON TOP OF THE QUEUE, THEN SET ALL SKIP 0B 03340000
* BITS ON IN THE POLLING LIST. 0B 03350000
SPACE 1 03360000
TBN PL$OPC(,PL),OPLSNS POLLING FOR STATUS, AND 0B 03370000
TBN $BDDEV(,DTF),BSCA BSCA LINE, AND 0B 03380000
TBN $BDATR(,DTF),$BCMCN CONTROL STATION LINE ? 0B 03390000
JF CMINOR NO-GO HANDLE NORMAL REQUESTS. 0B 03400000
L LCBPOL(,DTF),XR1 POINT TO THE POLLING LIST. 0B 03410000
CMIALL EQU * * 0B 03420000
CLI POLID(,XR1),POLEND END OF LIST ? 0B 03430000
JNL CMINOR YES-GO TO NORMAL PROCESSING. 0B 03440000
MVC CMISTS+2,POLCNT(1,XR1) SET UP REG UPDATE. 0B 03450000
CMISTS LA #(,XR1),XR1 UPDATE FOR POLL CHAR COUNT. 0B 03460000
SBN 2(,XR1),SKIP SET ON THE SKIP BIT. 0B 03470000
LA POLNXT(,XR1),XR1 POINT TO NEXT ENTRY. 0B 03480000
B CMIALL GO CHECK NEXT ENTRY. 0B 03490000
SPACE 1 03500000
CMINOR EQU * * 0B 03510000
L LCBPLQ(,DTF),PL POINT TO FIRST PARM LIST. 0B 03520000
.T2000 ANOP 03530000
SPACE 03540000
SPACE 03750000
SLC CMIIND(2),CMIIND ZERO LINE BUFFER NEEDED SIZE 03770000
SPACE 03780000
* DETERMINE IF OPERATION IS A READ 03790000
SPACE 03800000
CMDTII EQU * DETERMINE IF OP IS INVITE INPUT 03810000
TBN PL$OPM(,XR1),OPGET DOES OP INVOLVE READ 03820000
JF CMNXPL JUMP IF NO READ 03830000
SPACE 03840000
* HAVE READ - NOW ASSURE THE TERMINAL IS NOT IN ERP 03850000
SPACE 03860000
L PLTUBA(,XR1),XR2 POINT XR2 ATHE TUB 03870000
TBN TUBAT3(,XR2),TUBERP IS TERMINAL IN ERROR RECOVERY 03880000
L CMSLCB,XR2 POINT XR2 BACK AT LCB 03890000
JT CMNXPL JUMP IF TERMINAL IN ERP 03900000
SPACE 03910000
* HAVE READ TO TERMINAL NOT IN ERROR RECOVERY 03920000
* DETERMINE IF OPERATION IS AN INVITE INPUT 03930000
SPACE 03940000
TBN PL$OPM(,XR1),OPIVIN IS IT INVITE INPUT 03950000
JT CMGTST JUMP IF INVITE 03960000
SPACE 03970000
* HAVE GET TO BE SCHEDULED 03980000
* SINCE USING USER RECORD AREA - DON'T NEED HOLD BUFFER 03990000
SPACE 04000000
SBN CMSWIT,CMRSLN INDICATE READ CAN BE SCHEDULED 04010000
ST CMSPL,XR1 SAVE @ OF ELIGIBLE READ. 04020000
AIF (&ONE).C0551 04030000
TBN $BDDEV(,DTF),BSCA BSCA DTF ? 2 04040000
JF CMGML1 NO-GO TO HANDLE MLTA CASE. 2 04050000
.C0551 ANOP 04060000
AIF (&NOB).D0551 04070000
&MIX SETA &NSWL+&NCS 04080000
AIF (&MIX EQ '2').S0400 04090000
MVI CMB#SB,SBF2 SET OP TO SET OFF SKIP BIT. C/SB 04100000
J CMXSKP GO TO BSCA SKIP BITS TRN. C/SB 04110000
SPACE 1 04120000
AGO .S0410 04130000
.S0400 ANOP 04140000
J CMNXPL GO TO CHECK NEXT PARM LIST. B 04150000
SPACE 1 04160000
.S0410 ANOP 04170000
AIF (&ONE).D0551 04180000
CMGML1 EQU * * 2 04190000
.D0551 ANOP 04200000
AIF (&NOM).M1500 04210000
AIF (&NSCTL).S5500 04220000
B CMOFSK BRANCH TO SET SKIP BIT OFF CM 04230000
.S5500 ANOP 04240000
J CMNXPL JUMP TO CHECK NEXT PARM LIST M 04250000
SPACE 04260000
.M1500 ANOP 04270000
* WE HAVE AN INVITE INPUT RIGHT HERE ON OUR STAGE 04280000
SPACE 04290000
CMGTST EQU * CHECK STORAGE NEEDS FOR INVITE 04300000
AIF (&NSWL).S0470 04310000
SPACE 1 04320000
* IGNORE SYSTEM PARM LIST IF USER OWNS THE SWITCHED LINE. SB 04330000
SPACE 1 04340000
AIF (&NOB).S0430 04350000
TBN $BDDEV(,DTF),BSCA BSCA DTF ? S2 04360000
.S0430 ANOP 04370000
&MIX SETA &NMP+&NPP+&NCS 04380000
AIF (&MIX EQ '3').S0450 04390000
TBN $BDATR(,DTF),$BCSWI SWITCHED LINE, AND SLB 04400000
TBF $BDATR(,DTF),$BCMPT * NOT MULTI-POINT LINE ? SLB 04410000
.S0450 ANOP 04420000
* ------------------------------START-@07 04421000
JF CMGMLT NO - HANDLE OP W/O MORE CHKS SLB 04422000
TBN LCBATR(,DTF),LCBNIT LINE CONNECTED ? SLB 04423000
JT CMCOWN YES - CHECK OWNING TUB SLB 04424000
SPACE 04425000
* LINE NOT CONNECTED - ALLOW REQUEST UNLESS SYSTEM REQUEST AND 04426000
* USER TASK OWNS THE LINE. 04427000
SPACE 04428000
CLC LCBTCB(2,DTF),CC0000 SWITCH LINE UNOWNED ? SB 04430000
JE CMGMLT YES--HANDLE OPERATION NOW. SB 04440000
CLC LCBTCB(2,DTF),CC@CPT CP OWN THE SWITCHED LINE ? SB 04450000
TBN PLOPM(,PL),OPREQR SYSTEM REQUEST ? SB 04460000
JC CMGSBN,TRUNEQ YES - SKIP THIS PARM LIST. SB 04470000
J CMGMLT NOT CONNECTED SO SCHEDULE SB 04471000
SPACE 04472000
* LINE CONNECTED - CHECK TO SEE IF REQUEST IS FOR CONNECTED TUB. 04473000
SPACE 04474000
CMCOWN EQU * * LOCAL 04475000
CLC PLTUBA(2,PL),LCBOWN(,DTF) YES - THIS TUB OWN THE LINE ? 04476000
JNE CMGSBN NO - LINE OWNED BY ANOTHER 04477000
* * TUB SO SKIP THIS PL. 04478000
* ------------------------------END---@07 04479000
CMGMLT EQU * * SB 04480000
.S0470 ANOP 04490000
SPACE 04490400
* DOES THIS LCB CURRENTLY POSSESS A GETMAIN AREA FOR ITS INVITE INPUTS 04490800
* IF YES - FREEMAIN IT SO THAT THERE WILL BE A BETTER CHANCE OF 04491200
* GETTING ENOUGH STORAGE TO HANDLE ALL THE OUTSTANDING INVITE INPUTS 04491600
SPACE 04492000
CLI LCBIBA-1(,XR2),NOBIT IS INVITE BUFFER ADDR NULL 04492400
JE CMSZND JUMP IF NULL 04492800
SPACE 04493200
* HAVE GETMAIN AREA WHICH WE WILL NOW FREEMAIN 04493600
* GET ADDRESS OF RECORD AREA IN THE STORAGE AREA TO BE FREEMAINED 04494000
* FREEMAIN THE LCB HOLD BUFFER 04494400
SPACE 04494800
L LCBIBA(,XR2),XR2 POINT XR2 AT RECORD TO BE FM 04495200
B CMFMR2 BRANCH TO ISSUE FREEMAIN 04495600
SPACE 04496000
* REFLECT THE FREEMAIN BY ZEROING THE LCB FIELD WHICH CONTAINS THE 04496400
* LENGTH OF THE LCB HOLD BUFFER 04496800
SPACE 04497200
L CMSLCB,XR2 POINT XR2 AT THE LCB 04497600
MVI LCBIBA-1(,XR2),CMZERO ZERO HIGH ORDER BYTE OF BUFFER 04498000
* TO INDICATE NULLL BUFFER ADDR 04498400
CMSZND EQU * 04498800
B CMSTOR BR TO DETERMINE SIZE NEEDED BY 04500000
* THIS TP REQUEST 04510000
* SIZE NEEDED RETURNED IN #BUFND 04520000
SPACE 04530000
* COMPARE WHAT IS NEEDED AGAINST WHAT IS AVAILABLE WITH A GETMAIN 04540000
SPACE 04550000
CLC #BUFND,CC#BMX COMPARE NEEDED VS AVAILABLE 04560000
JNH CMGMAV JUMP IF ENOUGH STORAGE AVAILABLE 04570000
SPACE 04580000
*THERE IS NOT ENOUGH STORAGE AVAILABLE IN THE TP BUFFER TO 04590000
* SATISFY THIS INVITE INPUT 04600000
SPACE 04610000
* SET GETMAIN NEEDED BIT ON 04620000
SPACE 04630000
SBN PL$OPM(,XR1),OPGETM SET NEED GETMAIN BIT ON 04640000
SBN LCBATR(,XR2),LCBGMN SET LCB GETMAIN NEEDED 04650000
SBN CMWTMK+1,WPBFR SET ON FREEMAIN BIT IN WAIT MASK 04660000
SPACE 04670000
SPACE 04680000
* SET POLL SKIP BIT ON IF STATION CONTROL 04690000
SPACE 04700000
AIF (&ONE).C0552 04710000
TBN $BDDEV(,DTF),BSCA BSCA DTF ? 2 04720000
JF CMGML2 NO-GO TO HANDLE MLTA CASE. 2 04730000
.C0552 ANOP 04740000
AIF (&NOB).D0552 04750000
&MIX SETA &NCS+&NSWL 04760000
AIF (&MIX EQ '2').S0500 04770000
CMGSBN EQU * * C/SB 04780000
MVI CMB#SB,SBN2 SET OP TO SET ON SKIP BIT. C/SB 04790000
CMXSKP EQU * * C/SB 04800000
B CMBSKP GO TO BSCA SKIP BITS RTN. C/SB 04810000
SPACE 1 04820000
.S0500 ANOP 04830000
J CMNXPL GO TO CHECK NEXT PARM LIST. B 04840000
SPACE 1 04850000
AIF (&ONE).D0552 04860000
CMGML2 EQU * * 2 04870000
.D0552 ANOP 04880000
AIF (&NOM).M1600 04890000
AIF (&NSCTL).S5600 04900000
B CMONSK BR TO SET POLL SKIP BIT ON CM 04910000
.S5600 ANOP 04920000
SPACE 04930000
CMSDQ EQU * JUMP TO LOOK AT NEXT PARM LIST M 04940000
J CMNXPL GO TO CHECK NEXT PARM LIST M 04950000
SPACE 04960000
.M1600 ANOP 04970000
*********************************************************************** 04980000
* STORAGE IS AVAILABLE * 04990000
*********************************************************************** 05000000
SPACE 05010000
CMGMAV EQU * STORAGE IS AVAILABLE 05020000
SBN CMSWIT,CMRSLN INDICATE READ CAN BE SCHEDULED 05030000
ST CMSPL,XR1 SAVE @ OF ELIGIBLE READ. 05040000
SBF PL$OPM(,XR1),OPGETM SET OFF GETMAIN NEEDED BIT 05050000
SPACE 05060000
* SET THE SKIP BIT OFF FOR THIS TERMINAL 05070000
SPACE 05080000
AIF (&ONE).C0553 05090000
TBN $BDDEV(,DTF),BSCA BSCA DTF ? 2 05100000
JF CMGML3 NO-GO TO HANDLE MLTA CASE. 2 05110000
.C0553 ANOP 05120000
AIF (&NOB).D0553 05130000
AIF (&MIX EQ '2').S0600 05140000
MVI CMB#SB,SBF2 SET OP TO SET OFF SKIP BIT. C/SB 05150000
B CMBSKP GO TO BSCA SKIP BITS RTN. C/SB 05160000
SPACE 1 05170000
.S0600 ANOP 05180000
AIF (&NOM).M1700 05190000
J CMNOSO GO COMPARE BUFFER SIZES. 2 05200000
SPACE 1 05210000
AIF (&ONE).D0553 05220000
CMGML3 EQU * * 2 05230000
.D0553 ANOP 05240000
AIF (&NSCTL).S5700 05250000
B CMOFSK BRANCH TO SET SKIP BIT OFF CM 05260000
.S5700 ANOP 05270000
SPACE 05280000
.M1700 ANOP 05290000
CMNOSO EQU * COMPARE HOLD BUFFER SIZE NEEDED 05300000
CLC CMIIND(2),#BUFND COMPARE PARM SIZE NEEDED VS 05310000
* LINE QUEUE SIZE NEEDED 05320000
JNL CMIV40 JUMP UNLESS PARM NEED GT LINE 05330000
SPACE 05340000
* STORAGE NEEDED BY CURRENT PARM LIST IS GREATER THAN THAT NEEDED BY 05350000
* PREVIOUS INVITE INPUTS TESTED FOR THIS LINE 05360000
* RESET THE BUFFER SIZE NEEDED FOR THIS LINE 05370000
SPACE 05380000
MVC CMIIND(2),#BUFND MOVE BUFFER SIZE NEEDED TO FIELD 05390000
SPACE 05400000
* GET THE NEXT PARAMETER LIST IN THE LINE QUEUE 05410000
* FIRST TEST TO SEE IF THERE IS ANOTHER PARM LIST IN THE LINE QUEUE 05420000
SPACE 05430000
CMIV40 EQU * 05440000
AIF (&N32).T3000 05450000
SPACE 1 05460000
* BSCA POLL FOR STATUS IS HIGHEST PRIORITY OPERATION ON THE LINE. 0B 05470000
SPACE 1 05480000
TBN $BDDEV(,DTF),BSCA BSCA DTF, AND 0B 05490000
TBN PL$OPC(,PL),OPLSNS POLLING FOR STATUS ? 0B 05500000
JT CMIV60 YES-GO HANDLE, TOP PRIORITY. 0B 05510000
.T3000 ANOP 05520000
CMNXPL EQU * GET NEXT PARM LIST 05530000
CLI PLCHN-1(,XR1),NOBIT IS CHAIN POINTER NULL 05540000
JE CMIV60 JUMP IF NO MORE PARM LISTS 05550000
L PLCHN(,XR1),XR1 LOAD ADDR OF NEXT PARM LIST 05560000
B CMDTII LOOP BACK TO CHECK NEW PARM LIST 05570000
SPACE 05580000
*********************************************************************** 05590000
* HAVE LOOKED AT EVERY PARM LIST IN THE QUEUE * 05600000
*********************************************************************** 05610000
SPACE 05620000
CMIV60 EQU * 05630000
SPACE 05640000
* DETERMINE IF WE ARE TO DO GETMAIN BY CHECKING STORAGE AREA NEEDED 05650000
* AND AVAILABLE WITH GETMAIN 05660000
* IF GREATER THAN ZERO - DO THE GETMAIN 05670000
SPACE 05680000
CMTIND EQU * TEST INVITE BUFR NEEDED 05690000
CLC CMIIND(2),CC0000 IS SIZE GREATER THAN ZERO 05700000
JE CMIV80 IF NOT, JUMP 05710000
SPACE 05720000
* MUST DO GETMAIN WHICH MUST WORK ELSE HAVE CCP INTERNAL ERROR 05730000
* PUT SIZE NEEDED INTO GETMAIN LIST AND THEN GO TO GETMAIN INTERFACE 05740000
SPACE 05750000
MVC GMLIST+GMSIZE(2),CMIIND MOVE SIZE NEEDED TO GETMAIN LIST 05760000
B CMGMRT BR TO GETMAIN INTERFACE ROUTINE 05770000
JOL CMGMER JUMP IF GM FAILED TO ERROR 05780000
SPACE 05790000
* GETMAIN WORKED PROPERLY 05800000
* SET UP LCBIBA AND LCBIBL FIELDS IN THE LCB 05810000
SPACE 05820000
MVC LCBIBA(2,XR2),GMLIST+GMADDR MOVE RECORD ADDR TO LCB 05830000
MVC LCBIBL(2,XR2),CMIIND MOVE REC LENGTH TO LCB 05840000
ALC LCBIBA(2,XR2),CC0004 ADD 4 TO POINT LCBIBA TO 1ST BYTE05850000
* OF DATA IN THE GETMAIN AREA 05860000
SPACE 05870000
* MOVE GETMAIN PARM LIST TO STORAGE JUST OBTAINED 05880000
SPACE 05890000
L GMLIST+GMADDR,XR2 POINT XR2 AT BEGINNING 05900000
* OF AREA JUST GETMAINED 05910000
MVC 3(4,XR2),GMLIST+GMSIZE MOVE GETMAIN LIST TO NEW AREA 05920000
SPACE 05930000
CMIV80 EQU * 05940000
CMXR2 EQU * READY TO RETURN 05950000
CMIVGX B *-* RETURN 05960000
SPACE 3 05970000
CMGMER EQU * CCP INTERNAL ERROR 05980000
* GETMAIN FAILED WHEN HE SHOULD NOT HAVE 05990000
H#4BZ EQU * 06000000
B CPHALT BRANCH TO HALT ROUTINE. 06010000
DC AL1(#BLITZ) SUBHALT. 06020000
DC AL1(#4) SUBHALT. 06030000
MEND 06040000