|
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: 39878 (0x9bc6)
Types: s3xseg
Names: »S$E093«
└─⟦d0bc1a931⟧ Bits:30009189 5704-sc1.V08.ccp
└─⟦64693a1c9⟧
└─⟦this⟧ »S$E093«
MACRO 00010000
.***************************************************************** 00020000
.* NAME $E093 * 00030000
.***************************************************************** 00040000
$E093 00050000
GBLB &ONE,&NOB,&N37,&MIN,&NDME,&NMSG,&N41 00070000
GBLB &NPP,&NMP,&NSWL,&NCS,&NITB,&NTSP,&N32,&NDF,&NCPU,&NRUF 00080000
GBLA &BSC,&MLA 00110000
LCLA &MIX 00130000
TEXT 00140000
* R-06,C-00 CHANGE LEVEL 00150000
AIF (&NOB).C0580 00160000
&MIX SETA &NSWL+&NCS 00280000
AIF (&MIX EQ '2').S0700 00290000
TITLE '$E093/CMBSKP---BSCA-POLL-SKIP-BIT-ROUTINE' 00300000
***************************************************************** C/SB 00310000
* * C/SB 00320000
* NAME--CMBSKP * C/SB 00330000
* * C/SB 00340000
* TITLE--BSCA POLL SKIP BIT ROUTINE * C/SB 00350000
* * C/SB 00360000
* FUNCTION--SET THE SKIP ENTRY INDICATOR ON/OFF IN THE BSCA * C/SB 00370000
* POLLING LIST OR THE BSCA SWITCHED LINE ID * C/SB 00380000
* VERIFICATION LIST. * C/SB 00390000
* * C/SB 00400000
* OPERATION-- * C/SB 00410000
* . IF THIS DTF OR THIS PARTICULAR OPERATION DOES * C/SB 00420000
* NOT INVOLVE ONE OF THE BSCA LIST THEN RETURN * C/SB 00430000
* WITHOUT SETTING SKIP BIT. * C/SB 00440000
* . OTHERWISE, FIND THE ENTRY IN THE APPROP LIST. * C/SB 00450000
* . SET THE SKIP BIT AS SPECIFIED FOR ALL ENTRIES * C/SB 00460000
* FOR THE SAME TERMINAL. * C/SB 00470000
* * C/SB 00480000
* ENTRY POINTS--CMBSKP-ALL FUNCTIONS ABOVE. * C/SB 00490000
* * C/SB 00530000
* INPUT-- * C/SB 00540000
* XR1--ADDRESS OF THE TP PARAMETER LIST. * C/SB 00550000
* XR2--SAVED AD RESTORED. * C/SB 00560000
* CMB#SB--SBN2(X'7A') SET THE SKIP BIT ON, OR * C/SB 00570000
* SBF2(X'7B') SET THE SKIP BIT OFF. * C/SB 00580000
* TUBSID--ID OF THE ENTRY(S) TO PERFORM THE OPERATION * C/SB 00590000
* FOR. * C/SB 00600000
* OUTPUT-- * C/SB 00610000
* XR1-ADDRESS OF THE TP PARAMETER LIST. * C/SB 00620000
* XR2-RESTORED TO ENTRY VALUE. * C/SB 00630000
* POLLING/SWITCHED ID LIST-SKIP BIT FOR APPROPRIATE * C/SB 00640000
* ID SET AS SPECIFIED. * C/SB 00650000
* * C/SB 00660000
* EXIT, NORMAL--TO NSI OF CALLER. * C/SB 00670000
* * C/SB 00710000
***************************************************************** C/SB 00720000
SPACE 00730000
CMBSKP EQU * * C/SB 00740000
SPACE 00750000
ST CMBXIT+3,ARR SAVE THE ARR C/SB 00760000
ST CMON1B+3,PL SAVE XR1 C/SB 00770000
ST CMBXR2+3,XR2 SAVE XR2 C/SB 00780000
L PLTUBA(,PL),TUB POINT XR1 AT TUB C/SB 00790000
L TUBDTF(,TUB),DTF POINT XR2 AT DTF C/SB 00800000
&MIX SETA &NPP+&NMP+&NSWL 00810000
AIF (&MIX EQ '3').S0600 00820000
TBN $BDATR(,DTF),$BCSWI MULTI-TERMINAL LINE ? C/SLB 00830000
JF CMOEXT NO-GO EXIT. C/SLB 00840000
AIF (&NSWL).S0600 00850000
TBF $BDATR(,DTF),$BCMPT SWITCHED SB 00860000
TBN TUBTA1(,TUB),TASCNC * CALL ? SB 00870000
JT CMOEXT YES-DON'T SET SKIP BITS. SB 00880000
.S0600 ANOP 00890000
MVC LCBID#(1,DTF),TUBSID(,TUB) MOVE POLL LIST ID TO SAVE. C/SB 00900000
AIF (&NSWL).S0640 00910000
* --------------------------------------------- START @18 00912000
TBN $BDATR(,DTF),$BCMCN CONTROL STATION LINE ? SB 00914000
JT CMONSD YES SKIP SWITCHED CHECKING SB 00916000
TBF $BDATR(,DTF),$BCMPT SWITCHED, SB 00920000
TBN TUBTA2(,TUB),TASVFY * NO ID VERIFY ? SB 00930000
JF CMONSD YES - GO PROCESS LIST. SB 00933000
TBF $BDATR(,DTF),$BCMPT SWITCHED AND SB 00936000
CLI CMB#SB,SBF1 * ACTIVATE ENTRY ? SB 00940000
JC CMONO#,TRUAEQ YES-GO BUILD SWITCHED ENTRY. SB 00950000
L LCBNO#(,DTF),POL POINT TO SWITCHED LIST. SB 00951000
CLC LCBID#(1,DTF),POLID(,POL) THIS ENTRY IN LIST NOW ? SB 00952000
JNE CMOEXT NO - SKIP THIS ENTRY. SB 00953000
CMONSD EQU * * LOCAL SB 00954000
* ----------------------------------------------- END @18 00955000
.S0640 ANOP 00960000
L LCBPOL(,DTF),POL LOAD PTR TO POLLING LIST C/SB 00970000
CMOCHK EQU * * C/SB 00980000
CLI POLID(,POL),POLEND END OF LIST ? C/SB 00990000
JNL CMOEXT YES-GO EXIT. C/SB 01000000
MVC CMOSTS+2,POLCNT(1,POL) SET UP LA TO STATUS BYTE C/SB 01010000
CLC POLID(1,POL),LCBID#(,DTF) THIS ENTRY SAME AS REQ D? C/SB 01020000
CMOSTS LA #(,POL),POL UP PTR TO STATUS BYTE C/SB 01030000
JNE CMONXT NO-IGNORE IT, GOTO NXT ENT. C/SB 01040000
CMB#SB EQU * * C/SB 01050000
SBN POLCNT+1(,POL),POLSKP SET POLL SKIP BIT ON / OFF. C/SB 01060000
*-- CC4BG MUST KNOW IF POLL HAS ACTUALLY BEEN DONE-----------@39 0106010
TBN POLCNT+1(,POL),POLSKP SETTING SKIP BIT ON? 0106100
JT CMONXT YES- DO NOT SET POLL PENDG 0106200
SBN POLCNT+1(,POL),X'01' INDICATE POLL PENDING 0106300
*-- IF SKIP BIT IS 01 THEN POLL PENDING- TURNED OFF IN CC4M1(2)--- @39 0106400
CMONXT EQU * * C/SB 01070000
LA POLNXT(,POL),POL UP PTR TO NEXT POLL LIST ENTC/SB 01080000
B CMOCHK GO CHECK THIS NEXT ENTRY. C/SB 01090000
SPACE 01100000
AIF (&NSWL).S0660 01110000
CMONO# EQU * * SB 01120000
L LCBNO#(,DTF),POL XR1-> NO VERIFY ID ENTRY. SB 01130000
TBN POLCNT+1(,POL),POLSKP SKIP IND ALREADY OFF ? SB 01140000
JF CMOEXT YES-NAME OF NON-VERIFY AS SET.SB 01150000
MVC POLID(,POL),LCBID#(1,DTF) SET ID/NAME OF NON-VERIFY. SB 01160000
SBF POLCNT+1(,POL),POLSKP SET OFF THE SKIP BIT. SB 01170000
.S0660 ANOP 01180000
CMOEXT EQU * * C/SB 01190000
CMON1B EQU * * C/SB 01200000
LA *-*,PL RESTORE PARM LIST REG. C/SB 01210000
CMBXR2 EQU * * C/SB 01220000
LA #,XR2 RELOAD CALLER'S XR2. C/SB 01230000
CMBXIT EQU * * C/SB 01240000
B # RETURN TO CALLER. C/SB 01250000
EJECT 01260000
***************************************************************** C/SB 01270000
* * C/SB 01280000
* ENTRY POINT- CMASCH - ADDRESS LIST SEARCH * C/SB 01290000
* CMPSCH - POLL LIST SEARCH * C/SB 01300000
* * C/SB 01310000
* FUNCTION : GIVEN ID ENTRY BYTE IN DTF SAVE AREA, FIND THE * C/SB 01320000
* CORRESPONDING ENTRY IN THE POLL LIST AND RETURN A * C/SB 01330000
* POINTER TO THE PHYSICAL TERMINAL ADDRESS. * C/SB 01340000
* * C/SB 01350000
* INPUT: XR1-> DON'T CARE, XR2-> DTF. * C/SB 01350001
* * C/SB 01350002
* OUTPUT: XR1-> POLL LIST ENTRY, XR2-> DTF. * C/SB 01350003
* * C/SB 01350004
* EXITS-NORMAL: TO NSI OF CALLER. * C/SB 01350005
* -ERROR: CMASCH/CMPSCH WILL RETURN TO NSI+3 IF THE * C/SB 01350006
* ENTRY IS NOT FOUND. * C/SB 01350007
* * C/SB 01350008
***************************************************************** C/SB 01380000
SPACE 01390000
CMASCH EQU * ADDRESS LIST ENTRY POINT. C/SB 01400000
L LCBSEL(,DTF),POL LOAD ADDR LIST REGISTER. C/SB 01410000
J CMPNXT GO ENTER MAINLINE CODE. C/SB 01420000
SPACE 01430000
CMPSCH EQU * FIRST LEVEL SUBROUTINE. C/SB 01440000
L LCBPOL(,DTF),POL LOAD POLL LIST REGISTER. C/SB 01450000
CMPNXT EQU * * C/SB 01460000
ST LCBWRK(,DTF),ARR SAVE RETURN NSI. C/SB 01470000
CMPCHK EQU * * C/SB 01480000
CLC POLID(1,POL),LCBID#(,DTF) THIS WANTED TERMINAL ENTRY? C/SB 01490000
JE CMPFND YES-GO SET UP RETURN REG. C/SB 01500000
MVC CMPLA+2,POLCNT(1,POL) USE COUNT TO GET NEXT ENTRY C/SB 01510000
CMPLA EQU * * C/SB 01520000
LA #(,POL),POL UP REG PAST PHYSICAL ADDR C/SB 01530000
LA POLNXT(,POL),POL UP REG PAST ID/COUNT/STATUS C/SB 01540000
AIF (&NSWL).S0680 01550000
CLI POLID(,POL),POLEND END OF LIST ? SB 01560000
BL CMPCHK NO-CONTINUE THE SEARCH. SB 01570000
ALC LCBWRK(2,DTF),THREE ADD 3 TO NSI ADDR FOR RETURN. SB 01580000
* RETURN TO NSI +3 ONLY FOR SWITCHED ID LIST. EITHER BOTH USER , SB 01590000
* AND CMASCH ARE IN CORE, OR BOTH ARE IN THE SAME TRANSIENT. SB 01600000
SPACE 1 01610000
AGO .S0690 01620000
.S0680 ANOP 01630000
B CMPCHK GO TO CHECK NEXT ENTRY. CB 01640000
.S0690 ANOP 01650000
SPACE 01660000
CMPFND EQU * * C/SB 01670000
L LCBWRK(,DTF),IAR RETURN TO CALLER. C/SB 01680000
.S0700 ANOP 01690000
&MIX SETA (&BSC+&MLA) 01700000
AIF (&MIX LE '1').Y0050 01710000
TITLE '$E093/CMCSKP--SET-BSCA-CHECK-LIST-BIT-ON/OFF' 01720000
******************************************************************** YB 01730000
* * YB 01740000
* ENTRY POINT- CMCSKP - SET CHECK LIST SKIP BIT * YB 01750000
* * YB 01760000
* FUNCTION : * YB 01770000
* SET SKIP BIT ON OR OFF IN CHECK LIST FOR BSCA DTF'S. * YB 01780000
* TO SET THE SKIP BIT ON, MOVE SBN2 INTO CMC#SB. * YB 01790000
* TO SET THE SKIP BIT OFF, MOVE SBF2 INTO CMC#SB. * YB 01800000
* * YB 01810000
* ON ENTRY: XR1 -> IOB * YB 01820000
* ON EXIT: XR1=IOB, XR2=DTF. * YB 01830000
******************************************************************** YB 01840000
SPACE 01850000
CMCSKP EQU * * YB 01860000
ST CMCSXT+3,ARR SAVE RETURN @. YB 01870000
L @CKLST,XR2 LOAD CHECK LIST @ IN XR2. YB 01880000
CMCSCK EQU * * YB 01890000
CLC CKLDTF(2,XR2),IOBDTF(,IOB) THIS LIST ENTRY FOR THIS DTF?YB 01900000
JE CMC#SB YES-GO SET SKIP BIT. YB 01910000
LA CKLEN(,XR2),XR2 LOAD @ OF NEXT ENTRY. YB 01920000
B CMCSCK GO AND CHECK THIS NEXT ENTRY. YB 01930000
SPACE 01940000
CMC#SB EQU * * YB 01950000
SBN CKLSTS(,XR2),CKLSKP SET SKIP AS SET BY CALLER. YB 01960000
L CKLDTF(,XR2),DTF RESTORE DTF REGISTER. YB 01970000
CMCSXT EQU * * YB 01980000
B # RETURN TO CALLER. YB 01990000
.Y0050 ANOP 02000000
AIF (&MIN).N0400 02010000
TITLE '$E093/CMBTAS--SET-DTF-AND-IOB-FROM-TAS' 02020000
******************************************************************** RB 02030000
* * RB 02040000
* NAME--CMBTAS * RB 02050000
* * RB 02060000
* TITLE--BSCA SET DTF AND IOB FROM TAS * RB 02070000
* * RB 02080000
* FUNCTION--SET DTF AND IOB ATTRIBUTES AND OWNERSHIP STATUS. * RB 02090000
* * RB 02100000
* ENTRY REGS: XR2=DTF * RB 02110000
* EXIT REGS: XR1=TUB, XR2=DTF. * RB 02120000
* * RB 02130000
******************************************************************** RB 02140000
SPACE 02150000
CMBTAS EQU * * RB 02160000
ST CMBTXT+3,ARR SAVE RETURN @. RB 02170000
SBF $BDATT(,DTF),$BCRAN+$BCITB SET OF CURRENT TRANSP AND ITBRB 02180000
MVC CMBTS1+1(1),SAVTA2 MOVE IN TAS ATTR 2. RB 02190000
SBF CMBTS1+1,ALLBIT-TASITB-TASTSP LEAVE TRANSP AND ITB SET RB 02200000
ALC CMBTS1+1(1),CMBTS1+1 CORRECT TO DTF BIT DEFINITION.RB 02210000
CMBTS1 EQU * * RB 02220000
SBN $BDATT(,DTF),# SET TAS TRANSP AND ITB RB 02230000
MNN $BDAT1(,DTF),SAVTA2 MOVE IN SPAN AND RECSEP IND'S.RB 02240000
SBF $BDAT1(,DTF),ALLBIT-$BCSEP-$BCSPN-$BCPLR SET OTHERS OFF.RB 02250000
L LCBPL@(,DTF),PL LOAD PARM LIST REG. RB 02260000
TBN PL$OPC(,PL),OPUSER SYSTEM FUNCTION ? RB 02270000
L PLTUBA(,PL),TUB LOAD REG TO POINT TO TUB. RB 02280000
JT CMBSYS YES-GO SET SYSTEM BLOCK LEN. RB 02290000
SPACE 02300000
* DETERMINE THE BLOCK LENGTH GIVEN THE TAS RECORD LENGTH AND RB 02310000
* BLOCKING FACTOR. RB 02320000
SPACE 02330000
MVC LCBKLC(2,DTF),TUBRCL(,TUB) MOVE IN CURRENT RECORD LGTH. RB 02340000
MVC LCBOWN(1,DTF),TUBBKF(,TUB) PUT BLOCK FACTOR IN WRK AREA.RB 02350000
CMBLAD EQU * * RB 02360000
SLC LCBOWN(1,DTF),X$0001 DECREMENT BLOCKING FACTOR. 0 ?RB 02370000
JE CMBOWN YES-GO SET OWNERSHIP STATUS.B RB 02380000
ALC LCBKLC(2,DTF),TUBRCL(,TUB) ADD ANOTHER RECORD LENGTH. RB 02390000
B CMBLAD GO TO CHECK FOR MORE RECORDS. RB 02400000
SPACE 02410000
CMBSYS EQU * SET SYSTEM BLOCK LENGTH. RB 02420000
MVC LCBKLC(2,DTF),#CCMCL MOVE IN MAX COMMAND LENGTH. RB 02430000
SPACE 02440000
* SET OWNERSHIP STATUS IN THE TUB AND THE LCB. RB 02450000
SPACE 02460000
CMBOWN EQU * SET OWNERSHIP. RB 02470000
* DON'T SET TUB OWNERSHIP IF ERROR COMP CODE 02471000
SPACE 1 02472000
L $BDIOB(,DTF),XR1 XR1--> CURRENT IOB 02473000
CLI IOBCMP(,XR1),$BCEOT HIGHER THAN X'42' AND ------| 02474000
TBF IOBCMP(,XR1),BIT0 * LESS THAN X'80'----| 02475000
TBN LCBAT2(,DTF),LCBACT * AND LINE ACTIVE ?--| 02475500
L LCBPL@(,DTF),PL XR1--> PARM LIST | 02476000
L PLTUBA(,PL),TUB XR1 --> TUB | 02477000
JC CMNOWN,TRUAHI JUMP IF ERROR RETURN CODE<--| 02478000
SBN TUBAT2(,TUB),TUBOWN SET TUB OWNERSHIP. RB 02480000
CMNOWN EQU * * 02485000
MVC LCBOWN(2,DTF),TUBTCB(,TUB) SAVE TCB @ OF OWNER IN LCB. RB 02490000
AIF (&NSWL).S0900 02500000
&MIX SETA &NPP+&NMP+&NCS 02510000
AIF (&MIX EQ '3').S0800 02520000
TBN TUBAT1(,TUB),TUBSWC SWITCHED LINE ? RSLB 02530000
JF CMBTXT NO-GO EXIT. RSLB 02540000
.S0800 ANOP 02550000
ST LCBOWN(,DTF),TUB SET ADDRESS OF OWNING TUB. RSB 02560000
.S0900 ANOP 02570000
J CMBTXT GO TO RETURN. RB 02580000
AGO .N0500 02590000
.N0400 ANOP 02600000
TITLE '$E093/CMTASV--INTERFACE TO $CC4B1' 02610000
************************************************************** MIN B 02620000
* CALL IN TRANSIENT FORM OF 'CMTASV', 'CMBTAS' AND 'CMFORB'* MIN B 02630000
************************************************************** MIN B 02640000
SPACE 1 02650000
CMTASV EQU * CALL $CC4B1 FOR TASV MIN B 02660000
MVI CMTID1,CTTASV MOVE IN ID MIN B 02670000
J CMCAL1 CALL THE TRANSIENT MIN B 02680000
SPACE 02690000
CMREJT MVI CMTID1,CTREJC MOVE IN ID MIN B 02700000
J CMCAL1 CALL THE TRANSIENT MIN B 02710000
CMBTAS EQU * * MIN B 02720000
MVI CMTID1,CTBTAS MOVE IN ID FOR 'CMBTAS'. MIN B 02730000
CMCAL1 EQU * * MIN B 02740000
ST CMRTN1+3,ARR SAVE THE RETURN ADDRESS. MIN B 02750000
SPACE 1 02760000
SVC 0 ##### TRANSIENT CALL ##### MIN B 02770000
DC AL1(CCPRIB) CCP SVC RIB MIN B 02780000
DC AL1(CC4B1) CALL IN MIN XIENT #2. MIN B 02790000
CMTID1 DC AL1(0) ID OF MIN SYST FUNCTION MIN B 02800000
SAVTA1 DC XL1'0' TERMINAL ATTRIB BYTE 1. MIN B 02810000
SAVTA2 DC XL1'0' TERMINAL ATTRIB BYTE 2. MIN B 02820000
SAVRCL DC XL2'00' TERM ATTR SET RECORD LGTH. MIN B 02830000
CMSPHY DC AL1(0) SAVE ARE FOR TUBPHY. MIN B 02840000
SPACE 1 02850000
CMRTN1 EQU * * MIN B 02860000
B # RETURN TO CALLER. MIN B 02870000
.N0500 ANOP 02880000
AIF (&MIN).N0600 02890000
TITLE '$E093/CMTASV--SET-AND-SAVE-TAS-VALUE-IN-CORE' 02900000
******************************************************************** RB 02910000
* * RB 02920000
* NAME--CMTASV * RB 02930000
* * RB 02940000
* TITLE--SET AND SAVE TERMINAL ATTRIBUTES * RB 02950000
* * RB 02960000
* FUNCTION--SET AND SAVE TAS BYTES 1 AND 2 , TUBPHY AND TUBRCL.* RB 02970000
* * RB 02980000
* ENTRY REGS: XR1-> PL. * RB 02990000
* EXIT REGS: SAME AS ENTRY. * RB 03000000
******************************************************************** RB 03010000
SPACE 03020000
CMTASV EQU * RB 03030000
ST CMBTXT+3,ARR SAVE THE RETURN ADDRESS. RB 03040000
ST CMTSX1+3,PL SAVE THE PL REG. RB 03050000
SBF PL$OPC(,PL),OPUSER RESET FUNCTION INDICATOR. RB 03060000
TBF PLOPM(,PL),OP$SYS USER REQUEST, AND RB 03070000
TBF PL$OPC(,PL),OPRFSH+OPLSNS * NOT POLL STATUS OR REFRESH ?RB 03080000
L PLTUBA(,PL),TUB LOAD THE TUB REG. RB 03090000
MVC CMSPHY,TUBPHY(1,TUB) SAVE THE TUBPHY BYTE IN CORE. RB 03100000
JF CMTSYS NO-GO SET SYSTEM TAS VALUES. RB 03110000
MVC SAVRCL,TUBRCL(4,TUB) SAVE THE USER TAS VALUES. RB 03120000
J CMTSX1 GO TO EXIT. RB 03130000
SPACE 03140000
CMTSYS EQU * FILL SYSTEM TAS VALUE. RB 03150000
MVI SAVTA1,TASAUT SET SET AUTO CONNECT VALUE RB 03160000
MVI SAVTA2,TASMSG SET MESSAGE MODE IN TAS 2. RB 03170000
L CMTSX1+3,PL RELOAD THE PL REG. RB 03180000
SBN PL$OPC(,PL),OPUSER INDICATE SYSTEM FUNCTION. RB 03190000
CMTSX1 EQU * * RB 03200000
LA #,PL RELOAD THE USER PL REG. RB 03210000
CMBTXT EQU * * RB 03220000
B # RETURN. RB 03230000
.N0600 ANOP 03240000
TITLE '$E093/CMGINL--DETERMINE-THE-OPERATION-INPUT-LENGTH' 03250000
******************************************************************** B 03260000
* * B 03270000
* NAME--CMGINL * B 03280000
* * B 03290000
* TITLE--DETERMINE THE OPERATION INPUT LENGTH * B 03300000
* * B 03310000
* FUNCTION-- * B 03320000
* DETERMINE THE INPUT RECORD LENGTH. SET TRUNCATED * B 03330000
* INDICATOR IF INPUT LENGTH IS LESS THAN ACTUAL DATA * B 03340000
* LENGTH. * B 03350000
* * B 03360000
* OPERATION-- * B 03370000
* . SET THE INPUT LENGTH FOR THE OPERATION. * B 03380000
* - POLL FOR STATUS, USE 20. * B 03390000
* - RECORD MODE INPUT - USE PLINL IF PLINL LESS THAN * B 03400000
* TUBRCL * B 03410000
* - USE TUBRCL IF PLINL GREATER * B 03420000
* THAN TUBRCL. * B 03430000
* * B 03440000
* . IF NOT MLMP VARIABLE LENGTH RECORD SUPPORT ADJUST * B 03450000
* INPUT LENGTH IF LESS DATA IS AVAILABLE IN THE ACTUAL* B 03460000
* LINE BUFFER THAN IS REQUESTED. * B 03470000
* * B 03480000
* . IF MORE DATA IS AVAILABLE IN LINE BUFFER THAN * B 03490000
* REQUESTED, THEN SET THE TRUNCATED DATA INDICATOR. * B 03500000
* * B 03510000
* . IF PURE GET REQUEST OR A MESSAGE MODE INPUT AT * B 03520000
* OTHER THAN RECEIVE INITIAL TIME RETURN TO USER * B 03530000
* AFTER PERFORMING THE ABOVE FUNCTIONS. * B 03540000
* * B 03550000
* . OTHERWISE, ADD 4 BYTES FOR GETMAIN PARAMETER LIST. * B 03560000
* * B 03570000
* . FREE THE CURRENT LCB HOLD BUFFER IF IT IS LARGER THAN B 03580000
* NEEDED, AND GETMAIN THE EXACT HOLD AREA NEEDED. * B 03590000
* * B 03600000
* . IF GETMAIN AREA NOT AVAILABLE, WAIT FOR IT TO BE * B 03610000
* AVAILABLE. * B 03620000
* * B 03630000
* . OTHERWISE, SET UP THE ACQUIRED AREA FOR THE INVITE * B 03640000
* INPUT OPERATION. * B 03650000
* * B 03660000
* ENTRY POINT--CMGINL * B 03670000
* * B 03680000
* INPUT-- * B 03690000
* XR2 - ADDRESS OF THE DTF * B 03700000
* * B 03710000
* OUTPUT-- * B 03720000
* XR1 - NOT RESTORED. * B 03730000
* XR2 - ADDRESS OF THE DTF. * B 03740000
* $BDREL - SET UP FOR INPUT LENGTH OF THE NEXT RECORD. * B 03750000
* * B 03760000
* EXTERNAL REFERENCES-- * B 03770000
* CMFMRT - FREEMAIN CURRENT HOLD BUFFER IF LARGER * B 03780000
* THAN IS NEEDED. * B 03790000
* CMGMRT - GETMAIN EXACT BUFFER NEEDED. * B 03800000
* * B 03810000
* EXIT, NORMAL--TO NSI OF CALLER. * B 03820000
* * B 03830000
* EXIT, ERROR--IF SPACE IS NOT AVAILABLE, EXIT TO CMPAII AND WAIT * B 03840000
* UNTIL THE REQUIRED SPACE IS AVAILABLE. * B 03850000
* * B 03860000
******************************************************************** B 03870000
SPACE 03880000
CMGINL EQU * * B 03890000
ST CMGIXT+3,ARR SAVE RETURN @. B 03900000
L LCBPL@(,DTF),PL LOAD PARM LIST PTR TO GET THE B 03910000
TBF $BDAT1(,DTF),$BCRES SPANNING RECORD IN PROCESS ? B 03920000
TBF LCBAT1(,DTF),LCBEOT OR SENDING EOT ? B 03930000
BF CMGIXT YES-GO EXIT EVERYTING'S DONE. B 03940000
SPACE 1 03950000
*------------------------------------------------------------------* B 03960000
* NOT PROCESSING SPANNED RECORD * B 03970000
*------------------------------------------------------------------* B 03980000
SPACE 1 03990000
MVC $BDREL(2,DTF),PLINL(,PL) MOVE INL TO DTF RECL AREA. B 04000000
MVC $BDWKB(2,DTF),PLRECA(,PL) MOVE CURRENT RECORD ADDR TO DTFB 04010000
&MIX SETA &N32+&N37+&N41 04020000
AIF (&MIX EQ '3').T1500 04030000
TBN PL$OPC(,PL),OPLSNS POLL FOR STATUS OP ? 7/0/5B 04040000
JF CMGIUT NOGO CHECK UNIT TYPE OF OP7/0/5B 04050000
SPACE 1 04060000
*----------------------------------------------------------------7/0/5B 04070000
* POLL FOR STATUS 7/0/5B 04080000
*----------------------------------------------------------------7/0/5B 04090000
SPACE 1 04100000
MVC $BDREL(2,DTF),RELSNS USE STANDARD STATUS RECL. 7/0/5B 04110000
J CMGIRL GO USE THIS LENGTH FOR GET7/0/5B 04120000
.T1500 ANOP 04130000
SPACE 1 04140000
*------------------------------------------------------------------* B 04150000
* NOT POLL FOR STATUS * B 04160000
*------------------------------------------------------------------* B 04170000
SPACE 1 04180000
CMGIUT EQU * * B 04190000
TBN SAVTA2,TASREC RECORD MODE ? B 04200000
JF CMGIBK NO-GO CHECK DATA LEFT IN BLOCK.B 04210000
MVC $BDWKB(2,DTF),LCBIBA(,DTF) USE INVITE BUF AREA FOR MLMP. B 04215000
L PLTUBA(,PL),TUB LOAD THE TUB REG. B 04220000
CLC $BDREL(2,DTF),TUBRCL(,TUB) INL LT TAS RECL ? B 04230000
JL CMGIMX YES-GO FILL MAX RECL ACCEPTABLEB 04240000
MVC $BDREL(2,DTF),TUBRCL(,TUB) OTHERWISE USE TAS RECORD LEN. B 04250000
CMGIMX EQU * * B 04260000
MVC $BDMRL(2,DTF),$BDREL(,DTF) FILL MAX REC LEN ACCEPTABLE. B 04270000
SPACE 04280000
CMGIBK EQU * * B 04290000
TBF SAVTA2,TASITB+TASVRL+TASPAN MLMP VARIABLE RECORD SUPPORT?B 04300000
JF CMGII@ YES-GO GET II RECORD @. B 04310000
L $BDIOB(,DTF),IOB POINT TO THE IOB. B 04320000
CLI IOBCMP(,IOB),PROCES IOB BEING PROCESSED ? B 04330000
JE CMGIDX YES-IOB READY, GO CK DATA LEN. B 04340000
CLI IOBCMP(,IOB),$BCEOT EOT OR IOB COMPLETE ? B 04350000
TBF SAVTA2,TASMSG AND NOT MESSAGE MODE INPUT ? B 04360000
JC CMGI00,TRUAEQ EOT TO RECORD/BLOCK, 0 IN-LEN. B 04370000
TBF SAVTA2,TASMSG MESSAGE MODE? B 04373000
JC CMGIRL,TRUAHI REC OR BLK AND MSG MODE--JUMP B 04376000
JNL CMGIXT NOT COMPLETE, WAIT FOR OP END. B 04380000
MVC $BDBKX(2,DTF),IOBTAR(,IOB) SET UP BKX LIKE MLMP WILL. B 04390000
ALC $BDBKX(2,DTF),X$0001 UPDATE FOR -STX-. B 04400000
AIF (&NTSP).I0600 04410000
TBN $BDATT(,DTF),$BCRAN TRANSPARENCY MODE ? XB 04420000
JF CMGIDX NOT TRANSP, GO CK DATA LEGTH. XB 04430000
ALC $BDBKX(2,DTF),X$0001 UPDATE FOR -DLE-. XB 04440000
.I0600 ANOP 04450000
CMGIDX EQU * * B 04460000
CLC $BDBKX(2,DTF),IOBCAR(,IOB) DATA LEFT IN BUFFER ? B 04470000
JNL CMGIXT NO-GO EXIT, WAIT FOR OP END. B 04480000
MVC LCBWRK(2,DTF),IOBCAR(,IOB) FIND THE NUMBER OF DATA B 04490000
SLC LCBWRK(2,DTF),$BDBKX(,DTF) * CHARACTERS LEFT IN BUFFER. B 04500000
CLC $BDREL(2,DTF),LCBWRK(,DTF) INL LT MAX LINE DATA LEFT. B 04510000
JNL CMGIAL NO-GO SET TO GET ALL DATA. B 04520000
SBN LCBAT2(,DTF),LCBTRC SET BLOCK TRUNCATED IND. B 04530000
J CMGII@ GO CHECK INVITE RECORD @. B 04540000
SPACE 04550000
CMGI00 EQU * * 04560000
SLC $BDREL(2,DTF),$BDREL(,DTF) ZERO OUT INPUT RECORD LENGTH. B 04570000
J CMGII@ GO CHECK INVITE RECORD LENGTH. B 04580000
SPACE 04590000
CMGIAL EQU * * B 04600000
* ACTUAL AMOUNT OF DATA FOR MLMP TO MOVE, MAY BE LESS THAN PLINL B 04610000
MVC $BDREL(2,DTF),LCBWRK(,DTF) MOVE MAX LINE LEN TO RECL. B 04620000
SPACE 1 04630000
*------------------------------------------------------------------* B 04640000
* DETERMINE SIZE OF HOLD BUFFER NEEDED * B 04650000
*------------------------------------------------------------------* B 04660000
SPACE 1 04670000
CMGII@ EQU * * B 04680000
L LCBPL@(,DTF),PL LOAD @ OF CURRENT PARM LIST. B 04690000
TBN PLOPM(,PL),OP$SYS SYSTEM REQUEST ? B 04700000
AIF (&NRUF).F0100 04701000
L PLTUBA(,PL),XR2 XR2-> TUB. WB 04703000
TBF TUBSCS(,XR2),TUBRUF AND NOT A RUF ? WB 04704000
L TUBDTF(,XR2),DTF XR2-> LCB (DTF). WB 04705000
.F0100 ANOP 04707000
JT CMGISR YES-GO SET UP SYSTEM RECORD LENB 04710000
AIF (&NMSG).E0100 04720000
TBN SAVTA2,TASMSG GET-MSG MODE ? GB 04730000
JT CMGIMG YES-GO CHECK RECEIVE INIT IND.GB 04740000
.E0100 ANOP 04750000
CMGIRL EQU * * B 04760000
MVC #BUFND,$BDREL(2,DTF) USE CURRENT RECORD LEN AND ADD B 04770000
J CMGICB GO ADD GETMAIN CONTROL BYTES. B 04780000
SPACE 1 04790000
AIF (&NMSG).E0110 04800000
*------------------------------------------------------------------* GB 04810000
* USER GET MESSAGE * GB 04820000
*------------------------------------------------------------------* GB 04830000
SPACE 1 04840000
CMGIMG EQU * * GB 04850000
TBN LCBAT2(,DTF),LCBRCI RECEIVE INITIAL TIME ? GB 04860000
JF CMGIXT NO-GO EXIT, BUFFERS ARE SET. GB 04870000
SPACE 1 04880000
.E0110 ANOP 04890000
*------------------------------------------------------------------* B 04900000
* SYSTEM REQUEST OR USER GET MESSAGE * B 04910000
*------------------------------------------------------------------* B 04920000
SPACE 1 04930000
CMGISR EQU * * B 04940000
MVC #BUFND,PLINL(2,PL) USE PARM LIST INL FOR SYST. B 04950000
SPACE 1 04960000
*------------------------------------------------------------------* B 04970000
* ANY CALL EXCEPT USER GET MESSAGE PRIOR TO 1ST OP END. * B 04980000
*------------------------------------------------------------------* B 04990000
SPACE 1 05000000
CMGICB EQU * * B 05010000
ALC #BUFND(2),X$0004 * GETMAIN PARM LIST REQ'MTS. B 05020000
SPACE 05030000
B CMGBUF GETMAIN RIGHT SIZE BUFFER B 05040000
* IF SPACE NOT AVAILABLE, CMGBUF B 05040100
* *DOES NOT RETRUN, B CMPAII. B 05040200
SPACE 05050000
MVC $BDWKB(2,DTF),LCBIBA(,DTF) USE INVITE BUF AREA FOR MLMP. B 05060000
L LCBPL@(,DTF),PL LOAD PARM LIST REG. B 05070000
&MIX SETA &N32+&N37+&N41 05073000
AIF (&MIX EQ '3').T1700 05076000
TBN PL$OPC(,PL),OPLSNS POLLING FOR STATUS ? 0/5/7B 05080000
JF CMGMOV NO-GO DO MOVE OF RECORD @.0/5/7B 05090000
TBN PL$OPC(,PL),OPGET IF OP WAS INPUT , PLRECA 0/5/7B 05100000
* * MUST BE SET TO GET 0/5/7B 05110000
* * DATA RATHER THAN STATUS.0/5/7B 05120000
JF CMGIXT NO-NOT INVITE, SKIP MOVE. 0/5/7B 05130000
* (PUT MUST PRESERVE REC @) 0/5/7B 05140000
CMGMOV EQU * * LOCAL 0/5/7B 05150000
.T1700 ANOP 05155000
MVC PLRECA(2,PL),$BDWKB(,DTF) PUT INVITE @ INTO PARM LIST. B 05160000
CMGIXT EQU * * B 05170000
B ## RETURN B 05180000
AIF (&NDF).F0200 05190000
TITLE '$E093/CMDFFQ---QUEUE REQUEST FOR DFF TASK' 05200000
******************************************************************** FB 05210000
* * FB 05220000
* NAME: CMDFFQ * FB 05230000
* * FB 05240000
* TITLE: QUEUE REQUEST FOR DFF TASK AND POST. * FB 05250000
* * FB 05260000
* INPUT: XR1-> PL * FB 05260100
* * FB 05260200
* OUTPUT: XR1- UNCHANGED * FB 05260300
* XR2- DESTROYED * FB 05260400
* * FB 05260500
* EXIT-NORMAL: TO NSI OF CALLER. * FB 05260600
* * FB 05260700
******************************************************************** FB 05270000
SPACE 1 05280000
CMDFFQ EQU * * FB 05290000
ST CMDFRT+3,ARR RETURN ADDRESS FB 05300000
ST CMDFR1+3,XR1 SAVE XR1 FB 05310000
* ---------------------------- START @20 05311000
L PLTUBA(,PL),XR2 LOAD POINTER TO THE TUB. FB 05312000
L TUBTCB(,XR2),XR2 XR2-> TCB OWNING THIS TUB. FB 05313000
TBF TCBFG2(,XR2),TCBTRC TASK IN TERMINATION AND FB 05314000
CLI TCBID(,XR2),TRMTSK * TERMINATION TASK ? FB 05314500
JC CMDFNT,TRUNEQ NO - GO TO POST DFF. FB 05315000
CLI PLOPC(,PL),OPACI IS THIS ACCEPT INPUT PL ? FB 05315100
JNE CMDNAC NO - DON'T SET INVITE PL FB 05315200
L PLTUBA(,PL),XR2 POINT TO THE TUB FB 05315300
L TUBPL@(,XR2),PL POINT TO THE INVITE PL FB 05315400
CMDNAC EQU * * LOCAL FB 05315500
B $CC4FR GO TO FREEMAIN RECORD AREA. FB 05316000
J CMDFR1 RETURN WITHOUT POSTING DFF. FB 05317000
CMDFNT EQU * * LOCAL FB 05318000
* ------------------------------ END @20 05319000
MVI PLCHN-1(,PL),NOBIT ZERO CHAIN FIELD OF PL FB 05320000
LA @DFFQ-1,XR2 ADDRESS OF QUEUE FB 05330000
CMDFEN EQU * * LOCAL FB 05340000
CLI PLCHN-1(,XR2),NOBIT IS CHAIN PTR NULL FB 05350000
JE CMDFAD YES - ADD TO DFF QUEUE END FB 05360000
L PLCHN(,XR2),XR2 POINT TO NEXT QUEUE ENTRY FB 05370000
B CMDFEN TEST FOR END FB 05380000
SPACE 1 05390000
CMDFAD EQU * * LOCAL FB 05400000
ST PLCHN(,XR2),PL ADD PARM LIST TO END OF QUEUE FB 05410000
SPACE 1 05420000
* POST DFF FB 05430000
SPACE 1 05440000
LA $DFECB,XR1 ADDRESS OF DFF ECB FB 05450000
SVC 0 FB 05460000
DC AL1(POSTRB) POST DFF FB 05470000
SPACE 1 05480000
CMDFR1 LA *-*,XR1 RESTORE XR1 FB 05490000
CMDFRT B *-* RETURN FB 05500000
.F0200 ANOP 05510000
TITLE '$E093/CMDTFS---BSCA DTF SETUP FOR CHECK' 05520000
******************************************************************** B 05530000
* * B 05540000
* NAME : CMDTFS * B 05550000
* * B 05560000
* FUNCTION : SET UP DTF FOR BSCA LINE PRIOR TO GOING TO IOCS CHECK* B 05570000
* ROUTINE. * B 05580000
* * B 05590000
* OPERATION : * B 05600000
* CHECK FOR BSCA DTF'S WITH OPERATION COMPLETE, WHEN FIND ONE * B 05610000
* DO 1 OF THE FOLLOWING: * B 05620000
* 1. IF ABORTING THE LINE, GO TO CHECK WITH NO DTF SETTING UP. * B 05630000
* 2 .IF OLT RUNNING/OUTPUT SELECT/OR DATA MOVED, NO DTF SETUP * B 05640000
* NEEDED PRIOR TO CALLING CHECK. * B 05650000
* 3. IF RECEIVE INITIAL, SET UP DTF AND IOB FOR TERMINAL READING* B 05660000
* UNLESS EOT RECEIVED TO RECEIVE INITIAL, IF SO CALL CHECK* B 05670000
* 4. IF NOT RECEIVE INITIAL, VALIDATE INPUT LINE BUFFER SIZE. * B 05680000
* * B 05680100
* EXTERNAL SUBROUTINES USED: * B 05680200
* CMCSKP - SET CHECK LIST SKIP BITS. * B 05680300
* CMTASV - SAVE TERMINAL ATTRIBUTES. * B 05680400
* CMBTAS - FILL DTF/IOB OWNERSHIP. * B 05680500
* CMGINL - GETMAIN BUFFER FOR AMOUNT OF DATA RECEIVED. * B 05680600
* $CC4BI - CHECK FOR DATA MODE ESCAPE. * B 05680700
* * B 05680800
* INPUT: * B 05680900
* LCB#1 - ADDRESS LCB CHAIN. * B 05681000
* @CKLST - ADDRESS OF CHECK LIST. * B 05681100
* * B 05681200
* OUTPUT: * B 05681300
* CHECK LIST - SKIP BITS SET SO CMBMCH WILL HANDLE OP END. * B 05681400
* DTF - THE OP ENDING DTF IS SETUP FOR MLMP. * B 05681500
* XR1, XR2 - DESTROYED. * B 05681600
* * B 05681700
* EXITS-NORMAL: 1- TO NSI OF CALLER. * B 05681800
* 2 - IF OP END WHILE PARAMETER LIST HAS TEMPORARILY BEEN * B 05681900
* RETURNED TO USER PROGRAM (BLOCK/RECORD MODE), EXIT * B 05682000
* TO CMOPND. * B 05682100
* * B 05682200
******************************************************************** B 05690000
SPACE 05700000
CMDTFS EQU * * ENTRY POINT B 05710000
ST CMDTFX+3,ARR SAVE RETURN ADDRESS B 05720000
SPACE 05730000
* LOCATE ANY BSCA DTF'S. B 05740000
SPACE 05750000
SBF CMSWIT,CMBSCK RESET BSCA DTF CHECK SCDEDULED.B 05760000
L @LCB#1,DTF LOAD @ 1ST LCB. B 05770000
CMENTR EQU * * B 05780000
AIF (&ONE).C0305 05790000
TBN $BDDEV(,DTF),BSCA BSCA DTF ? 2 05800000
JF CMEANR NO-GO CHECK FOR ANOTHER LCB. 2 05810000
SPACE 05820000
******************************************************************** 2 05830000
* BSCA DTF FOUND - CHECK FOR OP END * 2 05840000
******************************************************************** 2 05850000
SPACE 1 05860000
.C0305 ANOP 05870000
SPACE 05880000
ST CMSDTF,DTF SAVE THE DTF ADDRESS. B 05890000
&MIX SETA (&BSC+&MLA) 05900000
AIF (&MIX LE '1').Y0100 05910000
* SET CHECK LIST TO IGNORE DTF IF DATA IS NOT READY TO GO. YB 05920000
L $BDIOB(,DTF),IOB LOAD PTR TO 1ST IOB. YB 05930000
MVI CMC#SB,SBN2 SET OP TO SET SKIP ON. YB 05940000
SPACE 05950000
B CMCSKP GO TO CHECK LIST SKIP BIT RTN.YB 05960000
SPACE 05970000
* IF THERE IS ALREADY A BSCA DTF SET UP FOR CHECK, THEN DONT SET YB 05980000
* UP ANOTHER BSCA DTF FOR CHECK. SOME INTERNAL FIELDS WILL BE YB 05990000
* LOST IF ANOTHER DTF WHERE SET UP. YB 06000000
SPACE 06010000
TBN CMSWIT,CMBSCK BSCA DTF SET FOR CHECK ? YB 06020000
JT CMEANR YES-DON'T SET UP ANOTHER ONE. YB 06030000
TBF LCBOPE(,DTF),ALLBIT ANY OP ENDS FOR THIS LINE ? YB 06040000
JF CMEXPM YES-GO EXAMINE PARM LIST STAT YB 06050000
CMEANR EQU * * (LOOP BACK FOR ANOTHER DTF)YB 06060000
CLI LCBCHN-1(,DTF),NOBIT ANOTHER DTF ? YB 06070000
BE CMECHK NO-GO TO CALL CHECK. YB 06080000
L LCBCHN(,DTF),DTF POINT TO NEXT DTF. YB 06090000
B CMENTR GO TEST FOR BSCA DTF. YB 06100000
.Y0100 ANOP 06110000
SPACE 1 06120000
******************************************************************** B 06130000
* BSCA DTF WITH OP END FOUND - CHECK FOR PARAMETER LIST * B 06140000
******************************************************************** B 06150000
SPACE 1 06160000
* EXAMINE THE PARM LIST, IGNORE OP END INTERRUPT IF PARM LIST NOT B 06170000
* QUEUED. B 06180000
SPACE 06190000
CMEXPM EQU * * LOCAL B 06200000
TBN LCBAT1(,DTF),LCBNTQ PARM LIST REMOVED FROM QUEUE ? B 06210000
JF CMBDTF NO-GO SETUP DTF FOR $$BMCH B 06220000
* * WILL RETURN TO CMEANR B 06230000
SBN LCBAT1(,DTF),LCBINT SET OP END W/ NO PARM LIST Q'D.B 06240000
SLC LCBOPE(1,DTF),X$0001 DECREMENT LINE OP END COUNT. B 06250000
SLC #OPEND,X$0001(1) SUBTRACT 1 FROM OP END COUNT. B 06260000
B CMOPND GO CHECK FOR OTHER OP END'S. B 06270000
SPACE 3 06280000
******************************************************************** B 06290000
* SET UP DTF FOR THIS LINE * B 06300000
******************************************************************** B 06310000
SPACE 1 06320000
CMBDTF EQU * * B 06330000
SBN CMSWIT,CMBSCK SET DTF SCHEDULED FOR CHECK B 06340000
&MIX SETA (&BSC+&MLA) 06350000
AIF (&MIX LE '1').Y0150 06360000
MVI CMC#SB,SBF2 SET OP TO SET SKIP OFF. YB 06370000
SPACE 06380000
B CMCSKP GO TO CHECK LIST SET SKIP RTN.YB 06390000
.Y0150 ANOP 06400000
SPACE 06410000
******************************************************************* B 06420000
* IF LINE IS BEING ABORTED, THEN GO TO CHECK WITH NO SETTING UP.* B 06430000
******************************************************************* B 06440000
SPACE 06450000
TBN LCBAT2(,DTF),LCBABT LINE ABORT IN PROCESS ? B 06460000
BT CMEBCK YES-NO DTF SETTING UP,NEXT DTF B 06470000
SPACE 06480000
* SAVE THE TAS ATTRIBUTES FROM THE TUB IN SAVE AREA. B 06490000
SPACE 06500000
TBN $BDAT1(,DTF),$BCRES SPANNING RECORD IN PROCESS ? B 06510000
BT CMEBCK YES - DONT SETUP DTF, MLMP IS B 06520000
* * SEARCHING FOR RECORD SEP. B 06530000
L LCBPL@(,DTF),PL LOAD PARM LIST OF ACTIVE TERM, B 06540000
SPACE 06550000
B CMTASV GO TO TAS SAVE SUBROUTINE. B 06560000
SPACE 06570000
AIF (&NSWL).S1060 06580000
SPACE 06590000
* SET ON LINE CONNECTED INDICATOR FOR SWITCHED LINES. SLB 06600000
SPACE 06610000
&MIX SETA &NCS+&NPP+&NMP 06620000
AIF (&MIX EQ '3').S1050 06630000
TBN $BDATR(,DTF),$BCSWI SWITCHED SLB 06640000
TBF $BDATR(,DTF),$BCMPT * LINE ? SLB 06650000
JF CMEXCK NO-DON'T SET CONNECTED. SLB 06660000
.S1050 ANOP 06670000
SBN LCBATR(,DTF),LCBNIT SET SWITCHED LINE CONNECTED. SB 06680000
CMEXCK EQU * * LOCAL SB 06690000
.S1060 ANOP 06700000
SPACE 06710000
******************************************************************** B 06720000
* IF OUTPUT OPERATION - NO DTF SETUP NEEDED PRIOR TO CHECK * B 06730000
******************************************************************** B 06740000
SPACE 06750000
TBF LCBOPC(,DTF),LCBMVD DATA MOVED OR B 06760000
TBF PL$OPM(,PL),OPPUT OUTPUT (SELECTION) OPERATION ? B 06770000
SBF LCBOPC(,DTF),LCBMVD SET OFF DATA MOVED IND. B 06780000
BF CMEBCK YES-GO CHECK FOR ANOTHER DTF. B 06790000
SPACE 06810000
TBN LCBAT2(,DTF),LCBRCI RECEIVE INITIAL ON LINE ? B 06820000
JF CMEREC NO-GO HANDLE DATA RECORD LENGTHB 06830000
SPACE 1 06840000
******************************************************************** B 06850000
* RECEIVE INITIAL ON THE LINE * B 06860000
* IF LINE INIT OR ONLINE TEST STILL IN PROGRESS - DTF SETUP * B 06870000
* IS ALREADY DONE. * B 06880000
******************************************************************** B 06890000
SPACE 1 06900000
L $BDIOB(,DTF),IOB POINT TO THE IOB B 06910000
TBN IOBFLA(,IOB),FIRST LINE INIT STILL IN PROCESS ? B 06920000
BT CMEBCK YES-GO TO CHECK OTHER DTF'S. B 06930000
L $BDWKA(,DTF),$BWK POINT TO BSCA WORK AREA. B 06940000
TBN LCBAT2(,DTF),LCBRFT WAS DTF SETUP FOR OLT ON PRIOR B 06950000
* * PASS ? B 06960000
JF CMERFF NO-CHECK FOR RFT COMING IN. B 06970000
TBN $BWFG3(,$BWK),$BWRFT OLT STILL RUNNING OR STATUS MSGB 06980000
BT CMEBCK YES-GO CHECK FOR OTHER DTF'S. B 06990000
SBF LCBAT2(,DTF),LCBRFT OLT NO LONGER RUNNING, SET OFF.B 07000000
J CMERCI GO HANDLE THE RECEIVE INITIAL. B 07010000
SPACE 1 07020000
CMERFF EQU * * LOCAL B 07030000
TBN $BWFG3(,$BWK),$BWRFT OLT RUNNING OR STATUS MESSAGE B 07040000
JF CMERCI NO-GO HANDLE RECEIVE INITIAL. B 07050000
SBN LCBAT2(,DTF),LCBRFT SET RFT STARTED AND RUNNING. B 07060000
CMERCI EQU * * LOCAL B 07070000
SPACE 07080000
*----------------------------------------------------------------* B 07090000
* IF CANCEL SUCCESSFUL (NO DATA) -- NO DTF SETUP PRIOR TO CHECK * B 07100000
*----------------------------------------------------------------* B 07110000
SPACE 07120000
L $BDIOB(,DTF),IOB LOAD THE IOB REG. B 07130000
CLI IOBCMP(,IOB),$BCNEG NEGATIVE RESPONSE ? B 07140000
JE CMEBCK YES-GO CHECK OTHER DTFS B 07150000
TBF LCBAT1(,DTF),LCBCRI+LCBPRI CANCEL PENDING ON THE LINE ? B 07160000
JT CMERCL NO - SET UP FOR RECEIVE B 07170000
CLI IOBCMP(,IOB),$BCEOT CANCEL OK ? B 07180000
JE CMEBCK YES-GO CHECK FOR OTHER DTF'S. B 07190000
SPACE 07200000
*----------------------------------------------------------------* B 07210000
* DATA RECEIVED -- SET UP DTF * B 07220000
*----------------------------------------------------------------* B 07230000
SPACE 07240000
CMERCL EQU * * LOCAL B 07250000
AIF (&NPP).P0100 07260000
AGO .P0150 07270000
.P0100 AIF (&NMP).P0200 07280000
.P0150 ANOP 07290000
TBF $BDATR(,DTF),$BCSWI MULTI-TERM IND OFF ? P/TB 07300000
JT CMEOWN YES-PARM @ IN DTF, GO LOAD P/TB 07310000
.P0200 ANOP 07320000
AIF (&NCS).S1100 07330000
MVC LCBID#(1,DTF),$BDIND(,DTF) MOVE IN CONTROL STATION ID. CB 07340000
TBN $BDATR(,DTF),$BCMCN CONTROL STATION ? CB 07350000
JT CMECTL YES-GO FIND PARM LIST FOR CS. CB 07360000
.S1100 ANOP 07370000
AIF (&NSWL).S1200 07380000
SPACE 07390000
* FILL TERM ID FOR SWITCHED LINE IF SWITCHED ID LIST WAS USED. SB 07400000
SPACE 1 07410000
TBN $BDADD(,DTF),$BCSWD SWITCHED ID LIST USED ? SB 07420000
JF CMEOWN NO-TERM ADDRESS IN 'LCBPL@'. SB 07430000
MVC LCBID#(1,DTF),$BDRLN(,DTF) MOVE IN SWITCHED TERM ID. SB 07440000
.S1200 ANOP 07450000
&MIX SETA &NCS+&NSWL 07460000
AIF (&MIX EQ '2').S1300 07470000
SPACE 1 07480000
* FIND PARM LIST FOR MULTI-TERMINAL LINE. C/SB 07490000
SPACE 1 07500000
CMECTL EQU * * LOCAL C/SB 07510000
L LCBPLQ(,DTF),PL LOAD PTR TO FIRST PARM LIST.C/SB 07520000
CMEXID EQU * * LOCAL C/SB 07530000
ST LCBPL@(,DTF),PL SAVE @ OF CURRENT PARM LIST.C/SB 07540000
TBN PL$OPC(,PL),OPSTCM IS STOP INVITE TURNED GET C/SB 07550000
* * STILL RECVING DATA. C/SB 07560000
JT CMESIJ YES - HANDLE IT LIKE GET. C/SB 07570000
TBN PL$OPM(,PL),OPGET THIS A GET PARM LIST ? C/SB 07580000
TBF PLOPM(,PL),OPSTOP * AND NOT A STOP C/SB 07590000
JF CMENXT NO-GO TO GET NEXT PARM LIST.C/SB 07600000
CMESIJ EQU * * LOCAL C/SB 07610000
L PLTUBA(,PL),TUB LOAD @ OF THIS TERMS TUB. C/SB 07620000
CLC TUBSID(1,TUB),LCBID#(,DTF) THIS RESPONDING TERM'S TUB C/SB 07630000
L LCBPL@(,DTF),PL RELOAD PARM LIST @. C/SB 07640000
JE CMESKP YES-GO SET SKIP BIT ON. C/SB 07650000
CMENXT EQU * * LOCAL C/SB 07660000
L PLCHN(,PL),PL LOAD REG TO NEXT PARM LIST @C/SB 07670000
B CMEXID GO BACK TO EXAMINE THIS ID. C/SB 07680000
SPACE 07690000
CMESKP EQU * * LOCAL C/SB 07700000
MVC LCBLID(1,DTF),LCBID#(,DTF) SAVE LAST TERMINAL ID C/SB 07704000
SPACE 07710000
* SAVE THE TAS ATTRIBUTTES FOR NEW TERMINAL. 07720000
SPACE 07730000
B CMTASV GO TO TAS SAVE SUBROUTINE. B 07740000
SPACE 07750000
.S1300 ANOP 07760000
* SET DTF AND IOB ATTRIBUTES, OWN, RECEIVE IND'S, AND BLOCK LENGTH. B 07770000
* ALSO SET LINE OWNERSHIP STATUS. 07780000
SPACE 07790000
CMEOWN EQU * * LOCAL B 07800000
SPACE 07810000
B CMBTAS RTN TO FILL DTF/IOB/OWNERSHIP. B 07820000
SPACE 07830000
AIF (&NITB).I0800 07840000
TBN SAVTA2,TASREC+TASITB RECORD MODE AND ITB ? IB 07850000
JF CMEIOB NO-GO CORRECT THE IOB'S. IB 07860000
MVC $BDITB(1,DTF),TUBBKF(,TUB) PUT BLOCK FACTOR IN TEMP WORKIB 07870000
AIF (&NTSP).I0700 07880000
TBN TUBTA2(,TUB),TASTSP TRANSPARENCY ? IXB 07890000
JF CMEITB NO-GO SET FOR ITB ONLY. IXB 07900000
ALC LCBKLC(2,DTF),$BDITB(,DTF) ADD 3 TIMES BLOCKING FACTOR IXB 07910000
ALC LCBKLC(2,DTF),$BDITB(,DTF) * BUFFER LENGTH FOR ITB IXB 07920000
ALC LCBKLC(2,DTF),$BDITB(,DTF) * TRANSPARENT GET. IXB 07930000
MVI $BDITB(,DTF),3 SET ITB LENGTH TO 3. IXB 07940000
J CMEIOB GO CORRECT IOB ATTRIBUTTES. IXB 07950000
SPACE 07960000
.I0700 ANOP 07970000
CMEITB EQU * * LOCAL IXB 07980000
ALC LCBKLC(2,DTF),$BDITB(,DTF) ADD BLK FACTOR FOR ITB ONLY. IB 07990000
MVI $BDITB(,DTF),1 SET ITB LENGTH TO 1. IB 08000000
.I0800 ANOP 08010000
SPACE 08020000
* CORRECT ALL IOB'S IN THE CHAIN FOR ANY NEW ATTRIBUTTES SET. 08030000
SPACE 08040000
CMEIOB EQU * * LOCAL B 08050000
L $BDIOB(,DTF),IOB LOAD THE IOB POINTER. B 08060000
CMBTIB EQU * * LOCAL B 08070000
MVC IOBFLG(1,IOB),$BDATT(,DTF) MOVE ATTR. BYTE TO IOB. B 08080000
CLC IOBNXT(2,IOB),$BDIOB(,DTF) ANOTHER IOB IN THE CHAIN ? B 08090000
L IOBNXT(,IOB),IOB LOAD @ OF NEXT IOB. B 08100000
BNE CMBTIB YES-GO FILL THE NEXT IOB. B 08110000
SPACE 1 08120000
* IF NOT A GOOD DATA BLOCK, DON'T CHECK DME, RECORD LENGTH, ETC. B 08130000
SPACE 1 08140000
TBF IOBCMP(,IOB),ALLBIT-$BCEOT GOOD DATA BLOCK? B 08150000
JF CMEBCK NO-GO CHECK OTHER DTF'S. B 08160000
SPACE 08170000
*----------------------------------------------------------------* B 08180000
* GOOD DATA RECEIVED * B 08190000
*----------------------------------------------------------------* B 08200000
SPACE 08210000
AIF (&NDME).D0300 08220000
SPACE 1 08230000
L LCBPL@(,DTF),PL POINT TO THE PARM LIST. DB 08240000
L PLTUBA(,PL),TUB POINT TO THE TUB. DB 08250000
TBF TUBAT2(,TUB),TUBCMD NOT COMMAND MODE, DB 08260000
TBN TUBAT2(,TUB),TUBDTA , IS IN DATA MODE, AND DB 08270000
TBN TUBAT1(,TUB),TUBREQ * IS THE REQUESTOR ? DB 08280000
JF CMEREC NO-GO CHECK RECORD LENGTH. DB 08290000
AIF (&N32).D0100 08300000
TBN TUBSCS(,TUB),TUBCLR CLEAR KEY HIT ? 0DB 08310000
AIF (&NCPU).D0050 08320000
JT CMEBIC YES-GO TO INQUIRY XIENT. 0DB 08330000
AGO .D0100 08340000
.D0050 ANOP 08350000
JF CMEREC NO-GO CHECK RECORD LENGTH. 0DB 08360000
AGO .D0200 08370000
.D0100 AIF (&NCPU).D0200 08380000
CLI TUBPHY(,TUB),TUBCPU CPU TERMINAL ? UDB 08390000
JNE CMEREC NO-GO CHECK RECORD LENGTH. UDB 08400000
.D0200 ANOP 08410000
SPACE 08420000
*----------------------------------------------------------------* DB 08430000
* CLEAR KEY ON DATA MODE 3270 OR CPU -- CHECK FOR DME * DB 08440000
*----------------------------------------------------------------* DB 08450000
SPACE 08460000
CMEBIC EQU * * LOCAL DB 08470000
LA CMDME,XR1 POINT XR1 TO DME STRING. DB 08480000
SVC 0 ##### TRANSIENT CALL ##### DB 08490000
DC AL1(CCPRIB) CCP SVC RIB DB 08500000
DC AL1(CC4BI) BSCA DME INQUIRY. DB 08510000
.D0300 ANOP 08520000
SPACE 08530000
******************************************************************** B 08540000
* ALL READS --- DETERMINE BUFFER SIZE NEEDED - ADJUST HOLD BUFFER* B 08550000
******************************************************************** B 08560000
SPACE 08570000
CMEREC EQU * * B 08580000
SPACE 1 08590000
B CMGINL COMPUTE AMOUNT OF DATA TO MOVE B 08600000
* GETMAIN RIGHT SIZE BUFFER B 08610000
* * NOW THAT WE KNOW HOW MUCH B 08620000
* * DATA CAME IN. B 08630000
SPACE 08640000
CMEBCK EQU * * (WITHIN CMBDTF) B 08650000
&MIX SETA (&BSC+&MLA) 08660000
AIF (&MIX LE '1').Y0250 08670000
B CMEANR GO CHECK FOR ANOTHER DTF. YB 08680000
SPACE 2 08690000
.Y0250 ANOP 08700000
CMECHK EQU * * EXIT B 08710000
CMDTFX B *-* RETURN B 08720000
.C0580 ANOP 08730000
MEND 08740000