|
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: 60452 (0xec24)
Types: s3xseg
Names: »S$E093«
└─⟦4498c64f7⟧ Bits:30009191 5704-sc2.V05.ccp
└─⟦95ee7795b⟧
└─⟦this⟧ »S$E093«
MACRO 00010000
.***************************************************************** 00020000
.* NAME $E093 * 00030000
.***************************************************************** 00040000
$E093 00050000
GBLB &ONE,&NOB,&N37,&MIN,&NDME,&NMSG,&N41,&NAPOR,&NTTSK 00070000
GBLB &NPP,&NMP,&NSWL,&NCS,&NITB,&NTSP,&N32,&NDF,&NCPU,&NRUF 00080000
GBLA &BSC,&MLA,&YK 00110000
LCLA &MIX 00130000
TEXT 00140000
* R-03,C-00 CHANGE LEVEL 00150000
AIF (&YK EQ '2').YK013 00155000
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
TBN $BDATR(,DTF),$BCMCN CONTROL STATION LINE ? SB 00913000
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 00952000
CLC LCBID#(1,DTF),POLID(,POL) THIS ENTRY IN LIST NOW ? SB 00954000
JNE CMOEXT NO - SKIP THIS ENTRY. SB 00956000
CMONSD EQU * * LOCAL SB 00958000
.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
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),X$0003 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
* ------------------------------------------- START ------------- @17 02170700
MVC CMBTS1+1(1),SAVTA2 MOVE IN TAS ATTR 2. RB 02171400
L LCBPL@(,DTF),PL LOAD PARM LIST REG. RB 02172100
TBN PL$OPC(,PL),OPGET GET OPERATION IN PROCESS ? RB 02172800
JF CMBTST NO-HANDLE ITB / TRANSPARENCY RB 02173500
SBF $BDATT(,DTF),$BCITB SET OFF ITB INDICATOR. RB 02174200
SBF CMBTS1+1,ALLBIT-TASITB LEAVE ITB INDICATOR SET. RB 02174900
J CMBTTT GO TO SET ITB OPERATION. RB 02175600
CMBTST EQU * * LOCAL RB 02176300
SBF $BDATT(,DTF),$BCRAN+$BCITB SET OF CURRENT TRANSP AND ITBRB 02177000
SBF CMBTS1+1,ALLBIT-TASITB-TASTSP LEAVE TRANSP AND ITB SET RB 02177700
CMBTTT EQU * * LOCAL RB 02178400
* ------------------------------------------- END --------------- @17 02179100
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
AIF (&NTTSK).TT120 02360500
AGO .TT130 02361000
.TT120 ANOP 02361500
AIF (&NAPOR).PT070 02362000
.TT130 ANOP 02362500
SPACE 1 02363000
******************************************************************* @18 02363500
************* 02364000
************* 02364500
TBN LCBAT3(,DTF),LCBPOR IS THIS A PORTLINE OPERATION ? 02365000
JT CMBOWN YES - THERE IS NO BLOCKING 02365500
************* 02366000
************* 02366500
******************************************************************* @18 02367000
SPACE 1 02367500
.PT070 ANOP 02368000
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
* ------------------------------------------- START ------------- @17 04412000
TBN IOBFLG(,IOB),$BCRAN TRANSPARENCY ? IXB 04414000
* ------------------------------------------- END --------------- @17 04416000
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
.YK013 ANOP 05185000
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
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 OR - FB 05314000
CLI TCBID(,XR2),X'E3' IS THIS TERMINATION TASK ? 05314500
JC CMDFNT,TRUNEQ NO - GO TO POST DFF. FB 05315000
SPACE 1 05315200
* THIS TASK IS IN TERMINATION - DO NOT POST DFF. TERMINATION WILL 05315400
* PURGE THIS TERMINAL SHORTLY. 05315600
SPACE 1 05315800
B $CC4FR GO TO FREEMAIN RECORD AREA. FB 05316000
J CMDFR1 RETURN WITHOUT POSTING DFF. FB 05317000
SPACE 1 05317500
CMDFNT EQU * * LOCAL FB 05318000
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
AIF (&YK EQ '2').YK015 05515000
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
AIF (&NTTSK).TT010 05760600
SPACE 1 05761200
******************************************************************* @18 05761800
************* 05762400
************* 05763000
L CMSDTF,DTF XR2 --> THE CURRENT DTF 05763600
TBN PLSWIT,CMSOPE DID TTASK PASS CONTROL TO CMDTFS 05764200
JT CMERCL YES - THIS IS A TTASK OPERATION 05765400
************* 05766000
************* 05766600
******************************************************************* @18 05767200
SPACE 1 05767800
.TT010 ANOP 05768400
L @LCB#1,DTF LOAD @ 1ST LCB. B 05770000
CMENTR EQU * * B 05780000
&MIX SETA (&ONE+&NTTSK) 05783000
AIF (&MIX EQ '2').C0305 05786000
TBN $BDDEV(,DTF),BSCA BSCA DTF ? 2 05800000
JF CMEANR NO-GO CHECK FOR ANOTHER LCB. 2 05810000
SPACE 1 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
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
BF CMEREC NO-GO HANDLE DATA REC LENGTH @18 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
BE CMEBCK YES-GO CHECK OTHER DTFS @18 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
BE 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 (&NTTSK).TT020 07250300
AGO .TT030 07250600
.TT020 ANOP 07250900
AIF (&NAPOR).PT005 07251200
.TT030 ANOP 07251500
SPACE 1 07251800
******************************************************************* @18 07252100
************* 07252400
************* 07252700
TBN LCBAT3(,DTF),LCBPOR IS THIS A PORTLINE DTF ? 07253000
JF CMENPR NO - CONTINUE 07253300
CLI $BDDEV(,DTF),X'60' IS THIS A TTASK OPERATION ? 07253600
JNE CMERC1 NO - CONTINUE 07253900
SLC $BDWKB(2,DTF),X$0002 DECREMENT THE DATA POINTER BY 2 07254200
L $BDWKB(,DTF),XR1 XR1 --> TTASK DATA IN TPBUFFER 07254500
J CMERC2 CONTINUE 07254800
CMERC1 EQU * 07255100
L $BDIOB(,DTF),IOB XR1 --> DTF'S IOB 07255400
L IOBTAR(,IOB),XR1 XR1 --> TRANSITION (INPUT DATA) 07255700
CMERC2 EQU * 07256000
MVC LCBID#(1,DTF),2(,XR1) SAVE THE TERMINAL ID 07256300
MVC CMENP2-2(1),2(,XR1) SAVE THE TERMINAL ID TO RESTORE 07256600
SBF LCBID#(,DTF),TPXCMD SET OFF THE COMMAND BIT 07256900
MVC $BDREL(2,DTF),4(,XR1) SAVE THE RECORD LENGTH 07257200
MVI CMEPRT-2,TUBID-1 ALTER THE CLC FOR PORTLINE 07257500
J CMECTL CONTINUE TO FIND THE PORT 07257800
CMENPR EQU * 07258100
************* 07258400
************* 07258700
******************************************************************* @18 07259000
SPACE 1 07259300
.PT005 ANOP 07259600
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+&NAPOR+&NTTSK 07460000
AIF (&MIX EQ '4').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
CMEPRT EQU * 07635000
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
CLI PLCHN-1(,PL),NOBIT IS THIS THE END OF THE CHAIN @25 07660100
JNE CMESLP NO - THEN CONTINUE NORMALLY @25 07660200
AIF (&NTTSK).TT040 07660500
AGO .TT050 07661000
.TT040 ANOP 07661500
AIF (&NAPOR).PT010 07662000
.TT050 ANOP 07662500
SPACE 1 07663000
******************************************************************* @18 07663500
************* 07664000
************* 07664500
B CMZDMY YES - CHECK IF PORTLINE GET 07666000
J CMESKP CONTINUE NORMALLY 07666500
************* 07667500
************* 07668000
******************************************************************* @18 07668500
SPACE 1 07669000
AGO .PT025 07669200
.PT010 ANOP 07669500
DC XL1'00' NO PARM LIST - U-PC @25 07669600
.PT025 ANOP 07669700
CMESLP EQU * @25 07669800
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
SPACE 1 07700100
AIF (&NTTSK).TT060 07700200
AGO .TT070 07700300
.TT060 ANOP 07700400
AIF (&NAPOR).PT060 07700500
.TT070 ANOP 07700600
******************************************************************* @18 07700700
************* 07700800
************* 07700900
TBN LCBAT3(,DTF),LCBPOR IS THIS A PORTLINE DTF ? 07701000
JF CMENP3 NO - CONTINUE 07701100
MVI LCBID#(,DTF),# MOVE THE PORT ID BACK INTO DTF 07701200
CMENP2 EQU * 07701300
MVI CMEPRT-2,TUBSID RESTORE THE CLC BACK FOR BSCA 07701400
CLI $BDDEV(,DTF),X'60' IS THIS A TTASK OPERATION ? 07701500
JNE CMENP3 NO - CONTINUE 07701600
ALC $BDWKB(2,DTF),X$0002 BUMP THE RECORD POINTER BY 2 07701700
MVC PLRECA(2,PL),$BDWKB(,DTF) MOVE THIS VALUE INTO RECORD ADDR 07701800
ST CMSPL,PL STORE THE CURRENT P.L. ADDRESS 07701900
J CMECHK RETURN ON ARR 07702000
CMENP3 EQU * 07702100
************* 07702200
************* 07702300
******************************************************************* @18 07702400
SPACE 1 07702500
.PT060 ANOP 07702600
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
* ------------------------------------------- START ------------- @17 07883000
L $BDIOB(,DTF),IOB LOAD THE IOB POINTER. B 07886000
TBN IOBFLG(,IOB),$BCRAN TRANSPARENCY ? IXB 07890000
* ------------------------------------------- END --------------- @17 07895000
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
AIF (&NTTSK).TT080 08582000
AGO .TT090 08584000
.TT080 ANOP 08586000
AIF (&NAPOR).PT020 08590500
.TT090 ANOP 08591000
SPACE 1 08591500
******************************************************************* @18 08592000
************* 08592500
************* 08593000
TBN LCBAT3(,DTF),LCBPOR IS THIS A PORTLINE DTF ? 08593500
JF CMERMS NO - CONTINUE 08594000
B CMZINL YES - GO TO THE PORTLINE ROUTINE 08594500
J CMEBCK CONTINUE 08595000
CMERMS EQU * 08595500
************* 08596000
************* 08596500
******************************************************************* @18 08597000
SPACE 1 08597500
.PT020 ANOP 08598000
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
.YK015 ANOP 08735000
AIF (&NTTSK).TT100 08735010
AGO .TT110 08735020
.TT100 ANOP 08735030
AIF (&NAPOR).PT030 08735040
.TT110 ANOP 08735050
TITLE '$E093/PORTLINE SUBROUTINES' 08735060
SPACE 10 08735070
********************************************************************@18 08735080
* @18 08735090
* THE FOLLOWING SUBROUTINES ARE FOR THE PORTLINE FUNCTIONS @18 08735100
* @18 08735110
********************************************************************@18 08735120
EJECT 08735130
*********************************************************************** 08735140
* * 08735150
* NAME : CMZDMY * 08735160
* * 08735170
* FUNCTION : ADD A DUMMY PARAMETER LIST TO LCBPLQ CHAIN TO BRING IN * 08735180
* DATA WHEN THERE IS NOT A GET AVAILABLE FOR THAT PORT * 08735190
* * 08735200
* OPERATION : * 08735210
* 1. IF NOT A PORT TUB, THEN PROC CHECK * 08735220
* 2. SET UP THE DUMMY PARAMETER LIST FOR A PORTLINE GET * 08735230
* 3. PUT THIS PARAMTER LIST ON LCBPLQ * 08735240
* 4. IF NOT PORT TUB WAS FOUND THEN U- * 08735250
* * 08735260
* EXTERNAL SUBROUTINES USED: * 08735270
* * 08735280
* INPUT: * 08735290
* XR1 --> THE LAST PARAMETER LIST IN LCBPLQ * 08735300
* XR2 --> THE LCB * 08735310
* * 08735320
* OUTPUT: * 08735330
* THE DUMMY PARAMETER LIST WILL BE ON LCBPLQ TO ACCEPT THE * 08735340
* INPUT DATA * 08735350
* * 08735360
* EXITS-NORMAL: * 08735370
* RETURN ON ARR * 08735380
* * 08735390
*********************************************************************** 08735400
SPACE 1 08735410
CMZDMY EQU * 08735420
ST CMZD70+3,ARR SAVE ARR FOR RETURN 08735430
TBN LCBAT3(,DTF),LCBPOR IS THIS A PORTLINE OPERATION ? 08735440
JT CMZD05 YES - CONTINUE 08735450
DC XL1'00' NO - INVALID OP END, PROC CHECK 08735460
CMZD05 EQU * 08735470
TBN 0(,DTF),X'88' IS THE A LINE 2 DTF ? 08735480
JT CMZD10 YES - USE THE LINE 2 DUMMY P.L. 08735490
MVC PLCHN(2,PL),@PRMD1 NO - USE THE LINE 1 DUMMY P.L. 08735500
J CMZD20 CONTINUE 08735510
CMZD10 EQU * 08735520
MVC PLCHN(2,PL),@PRMD2 USE THE LINE 2 DUMMY P.L. 08735530
CMZD20 EQU * 08735540
L PLCHN(,PL),PL XR1 --> DUMMMY PARAMETER LIST 08735550
MVI PLCHN-1(,PL),NOBIT ASSURE THIS IS THE END OF CHAIN 08735560
ST LCBPL@(,DTF),PL SAVE THE CURRENT P.L. ADDRESS 08735570
MVC PLINL(2,PL),LCBIBL(,DTF) MAX MESSAGE LENGTH 08735580
L @TUBQ,XR1 XR1 --> FIRST TUB 08735590
CMZD30 EQU * 08735600
CLI TUBCCP(,XR1),TUBSTP THIS THE END OF THE TUBS ? 08735610
JE CMZD60 YES - U- 08735620
TBN TUBPHY(,XR1),TUBAPT IS THIS A PORT TUB ? 08735630
JF CMZD40 NO - CONTINUE LOOKING 08735640
CLC LCBID#(1,DTF),TUBID-1(,XR1) THIS THE CORRECT PORT ? 08735650
JNE CMZD40 NO - CONTINUE LOOKING 08735660
CLC CMSDTF(2),TUBDTF(,XR1) IS THIS THE CORRECT DTF ? 08735670
JE CMZD50 YES - THIS IS THE RIGHT PORT 08735680
CMZD40 EQU * 08735690
TBN TUBCHR(,XR1),TUBCMN IS THIS A COMMAND MODE TUB ? 08735700
JF CMZD45 NO - THIS IS A SHORT TUB 08735710
LA TUBLNC-TUBLN(,XR1),XR1 YES - THIS IS A LONG TUB 08735720
CMZD45 EQU * 08735730
LA TUBLN(,XR1),XR1 BUMP TO THE NEXT PORT TUB 08735740
B CMZD30 TRY THE NEXT PORT 08735750
CMZD50 EQU * 08735760
L LCBPL@(,DTF),XR2 XR2 --> DUMMY PARAMETER LIST 08735770
ST PLTUBA(,XR2),XR1 SAVE TUB ADDRESS IN PL 08735780
L CMSDTF,DTF XR2 --> DTF 08735790
L LCBPL@(,DTF),PL XR1 --> PL 08735800
J CMZD70 RETURN ON ARR 08735810
CMZD60 EQU * 08735820
MVI $BDCMP(,DTF),$BCCAL SET CANCEL CODE FOR $CC4UF 08735830
L LCBPL@(,DTF),PL XR1 --> PL 08735840
SVC 0 #### TRANSIENT CALL #### 08735850
DC AL1(CCPRIB) CCP SVC RIB 08735860
DC AL1(CC4BE) ERROR TRANSIENT ID ($CC4BE) 08735870
CMZD70 EQU * 08735880
B # RETURN ON ARR 08735890
EJECT 08735900
*********************************************************************** 08735910
* * 08735920
* NAME : CMZINL * 08735930
* * 08735940
* FUNCTION : COMPUTE AMOUNT OF DATA TO MOVE FOR A PORTLINE OPERATION * 08735950
* AND GETMAIN TPBUFFER FOR THAT AMOUNT * 08735960
* * 08735970
* OPERATION : * 08735980
* * 08735990
* EXTERNAL SUBROUTINES USED: * 08736000
* * 08736010
* INPUT: * 08736020
* XR1 --> NO MATTER * 08736030
* XR2 --> LCB FOR THE ACTIVE LINE * 08736040
* * 08736050
* OUTPUT: * 08736060
* THE CORRECT TPBUFFER WILL BE GETMAINED TO PERFORM THE INPUT * 08736070
* OPERATION * 08736080
* * 08736090
* EXITS-NORMAL: * 08736100
* RETURN ON ARR * 08736110
* * 08736120
*********************************************************************** 08736130
SPACE 1 08736140
CMZINL EQU * 08736150
ST CMZI20+3,ARR SAVE THE ARR TO RESTORE 08736160
TBN LCBAT2(,DTF),LCBRCI IS THE LINE AT RECEIVE INIT ? 08736170
JF CMZI20 NO - DATA WAS ALREADY RECEIVED 08736180
SLC #BUFND(2),#BUFND ZERO THE STORAGE AREA 08736190
L LCBPL@(,DTF),PL XR1 --> PARAMETER LIST 08736200
TBN LCBID#(,DTF),TPXCMD COMMAND DATA ? 08736210
JF CMZI10 NO - DON'T ADD THE PCT LENGTH 08736220
MVC #BUFND(1),#PCTLN YES - MOVE IN THE PCT LENGTH 08736230
CMZI10 EQU * 08736240
ALC #BUFND(2),$BDREL(,DTF) ADD LENGTH FROM OTHER SYSTEM 08736250
ALC #BUFND(2),LNTHCC ADD LENGTH FOR CONTROL INFO 08736260
ALC #BUFND(2),X$0004 ADD FOUR BYTES FOR TPBUFFER P.L 08736270
B CMGBUF GETMAIN THE TPBUFFER 08736280
MVC $BDWKB(2,DTF),LCBIBA(,DTF) MOVE IN THE BUFFER POINTER 08736290
ALC $BDWKB(2,DTF),LNTHCC INCREMENT THE POINTER BY 13 08736300
MVC PLRECA(2,PL),$BDWKB(,DTF) INPUT BUFFER TO PLRECA 08736310
ALC PLRECA(2,PL),X$0003 ADD 3 TO PLRECA 08736320
CMZI20 EQU * 08736330
B # RETURN ON ARR 08736340
EJECT 08736350
*********************************************************************** 08736360
* * 08736370
* NAME : CMZNWR * 08736380
* * 08736390
* FUNCTION : ACCEPT NEW TP PARAMETER LIST FOR PORTLINE TUBS. * 08736400
* PERFORM THE FUNCTION REQUESTED IF IT CAN BE HANDLED * 08736410
* IMMEDIATELY. OTHERWISE PLACE THE PARAMETER LIST INTO * 08736420
* THE LCB LINE QUEUE OF WORK TO BE DONE. * 08736430
* * 08736440
* OPERATION : * 08736450
* * 08736460
* EXTERNAL SUBROUTINES USED: * 08736470
* * 08736480
* INPUT: * 08736490
* XR1 --> ADDRESS OF THE CURRENT PARAMETER LIST * 08736500
* XR2 --> LCB FOR THE ACTIVE LINE * 08736510
* * 08736520
* OUTPUT: * 08736530
* LCBPLQ - NEW REQUEST ADDED TO THIS QUEUE * 08736540
* DATA IS REMOVED FROM TUBDCH AND USER IS POSTED * 08736550
* * 08736560
* EXITS-NORMAL: * 08736570
* TO CMPAII - TO POST THE USER. * 08736580
* * 08736590
*********************************************************************** 08736600
SPACE 1 08736610
CMZNWR EQU * 08736620
ST CMZNAR+3,ARR SAVE THE ARR TO RETURN 08736630
SLC PL$RTC(2,PL),PL$RTC(,PL) ZERO THE RETURN CODE AREA 08736640
L PLTUBA(,PL),XR2 XR2 --> TUB 08736650
CLI TUBDCH-1(,XR2),NOBIT DATA ALREADY IN TPBUFFER 08736660
JE CMZNPT NO - CONTINUE 08736670
TBN PL$OPM(,PL),OPPUT NEW REQUEST A PUT ? 08736680
JF CMZDAT NO - GET DATA FROM TPBUFFER 08736690
MVI PLRTC(,PL),RCXDPD DATA PENDING RETURN CODE 08736700
MVI PL$RTC(,PL),RCXDPD DATA PENDING RETURN CODE 08736710
L TUBDTF(,XR2),DTF XR2 --> DTF @23 08736712
CLI $BDDEV(,DTF),X'60' IS THIS TASK-TO-TASK ? @23 08736714
JNE CMZPST NO - CONTINUE NORMALLY @23 08736716
SLC PLRECA(2,PL),LNTHCC DECREMENT PLRECA FOR FREMAIN @23 08736718
J CMZPST POST PARM LIST OWNER 08736720
CMZDAT EQU * 08736730
MVC PLRECA(2,PL),TUBDCH(,XR2) MOVE DATA ADDRESS INTO PARM LIST 08736740
L TUBDCH(,XR2),XR2 XR2 --> FIRST DATA BLOCK 08736750
A BCKREG,XR2 BACK UP 1 BYTE 08736760
MVC PL$RTC(2,PL),TPXRTC(,XR2) USER RETURN CODE TO PARM LIST 08736770
MVC PLEFFL(2,PL),TPXDLN(,XR2) EFFECTIVE INPUT LENGTH TO PL 08736780
TBN PLOPM(,PL),OP$SYS SYSTEM PARAMETER LIST 08736790
JF CMZUSR NO - CONTINUE 08736800
MVC PLINL(2,PL),TPXFRL(,XR2) SYSTEM GETMAIN LENGTH 08736810
SLC PLINL(2,PL),X$0004 -4 FOR GETMAIN PARM LIST 08736820
J CMZPFR GO SET CHAIN ADDRESS 08736830
CMZUSR EQU * 08736840
TBN TPXPID(,XR2),TPXCMD COMMAND DATA 08736850
JF CMZCHK NO - CONTINUE 08736860
SBN PLSWIT,CMSCMD INDICATE COMMAND DATA TO USER 08736870
J CMZPFR CONTINUE 08736880
CMZCHK EQU * 08736890
CLC PLEFFL(2,PL),PLINL(,PL) CHECK IF TOO MUCH DATA 08736900
JNH CMZPFR NO - CONTINUE 08736910
SBN PL$RTC(,PL),RCXDTR SET DATA TRUNCATED RETURN CODE 08736920
MVC PLEFFL(2,PL),PLINL(,PL) MAX INPUT FOR THIS USER 08736930
CMZPFR EQU * 08736940
L PLTUBA(,PL),XR1 XR1 --> PORT 08736950
MVC TUBDCH(2,XR1),TPXCHN(,XR2) REMOVE THE DATA FROM THE CHAIN 08736960
SBF TUBAT2(,XR1),TUBIIS SET OFF THE INPUT SCHEDULED BIT 08736970
L CMSPL,PL RESTORE XR1 TO THE PARM LIST 08736980
J CMZPST GO POST AND FREE THE DATA 08736990
CMZNPT EQU * 08737000
L CMSDTF,DTF XR2 --> DTF 08737010
SBN LCBAT3(,DTF),LCBPOR SET ON THE PORTLINE DTF BIT 08737020
AIF (&NTTSK).TT140 08737030
CLI $BDDEV(,DTF),X'60' IS THIS A TTASK OPERATION ? 08737040
BE CMZTNW YES - GO TO THE TTASK SUBROUTINE 08737050
.TT140 ANOP 08737060
TBN LCBAT2(,DTF),LCBACT+LCBRCI IS THE LINE ACTIVE AND POLLING? 08737070
TBN PL$OPM(,PL),OPPUT IS THIS A PUT OPERATION ? 08737080
JF CMZNAR NO - RETURN TO MAINLINE CODE 08737090
TBF LCBAT1(,DTF),LCBCRI+LCBPRI ALREADY REQUEST A STOP ? 08737100
SBN LCBAT1(,DTF),LCBPRI SET 'PRIORITY CANCEL' INDICATOR 08737110
JF CMZAII YES - POST THE PARAMETER LIST 08737120
CMZNP2 EQU * 08737130
LA 0(,PL),XR2 XR2 --> P.L. FOR $CC4BP 08737140
SVC 0 TRANSIENT CALL 08737150
DC AL1(CCPRIB) CCP SVC RIB 08737160
DC AL1(CC4BP) STOP INVITE TRANSIENT 08737170
J CMZAII POST THE PARAMETER LIST 08737180
CMZPST EQU * 08737190
B CMPOST 08737200
CMZAII EQU * 08737210
B CMPAII 08737220
CMZNAR EQU * 08737230
B # RETURN ON THE ARR 08737240
EJECT 08737250
AIF (&NTTSK).TT150 08737260
*********************************************************************** 08737270
* * 08737280
* NAME : CMZTNW * 08737290
* * 08737300
* FUNCTION : PERFORM THE NEW REQUEST OPERATIONS FOR THE TASK-TO-TASK * 08737310
* FUNCTION. IF AN OPERATION CANNOT GET TPBUFFER, THEN * 08737320
* PUT THE REQUEST BACK ON @PRLQ * 08737330
* * 08737340
* OPERATION : * 08737350
* * 08737360
* EXTERNAL SUBROUTINES USED: * 08737370
* * 08737380
* INPUT: * 08737390
* XR1 --> CURRENT PARAMETER LIST * 08737400
* XR2 --> LCB FOR THE ACTIVE LINE * 08737410
* * 08737420
* OUTPUT: * 08737430
* THE PARAMETER LIST IS POSTED, NEW REQUESTS ARE HANDLED. * 08737440
* * 08737450
* EXITS-NORMAL: * 08737460
* CMOPNT - FAKED OP END FOR ALL USER PUT OPERATIONS * 08737470
* CMOPND - CHECK FOR MORE WORK TO DO * 08737480
* CMPAII - POST THE USER AND RETURN * 08737490
* CMZNP2 - CALL TO $CC4BP-$CC4ZS TRANSIENTS * 08737500
* * 08737510
*********************************************************************** 08737520
SPACE 1 08737530
CMZTNW EQU * 08737540
SBN 03(,DTF),X'47' SET ON THE LINE ACTIVE BITS 08737550
SBN LCBAT2(,DTF),LCBACT SET THE LINE AS BEING ACTIVE 08737560
MVI $BDCMP(,DTF),$BCDNE MOVE IN 40 COMP CODE SO THE 08737570
* IOS WAIT ROUTINE IS NOT CALLED 08737580
TBN PL$OPM(,PL),OPGETM DID WE RUN OUT OF TPBUFFER ? 08737590
JF CMZT30 NO - CONTINUE 08737600
LA @PRLQ-1,XR2 XR2 --> NEW REQUEST QUEUE 08737610
CMZT10 EQU * 08737620
CLI 0(,XR2),NOBIT IS THIS THE END OF THE CHAIN ? 08737630
JE CMZT20 YES - PUT THE P.L. ON THE CHAIN 08737640
L PLCHN(,XR2),XR2 XR2 --> NEXT PARM LIST ON CHAIN 08737650
B CMZT10 LOOP 08737660
CMZT20 EQU * 08737670
ST PLCHN(,XR2),PL ADD THE PARM LIST TO THE CHAIN 08737680
LA @PRLQ-1,XR2 XR2 --> START OF NEW REQUEST Q 08737690
CMZT40 EQU * 08737700
L PLCHN(,XR2),XR2 XR2 --> NEXT PARM LIST IN CHAIN 08737710
TBF PL$OPM(,XR2),OPGETM DID GETMAIN FAIL FOR THIS P.L.? 08737720
BT CMOPND NO - GO HANDLE THE NEW REQUEST 08737730
CLI PLCHN-1(,PL),NOBIT ARE THERE ANY MORE ON THE CHAIN? 08737740
BNE CMZT40 YES - CHECK THEM OUT 08737750
TBN CMSWIT,CMFMPS WAS THE POST FOR A FREEMAIN ? 08737760
BT CMFRPS YES - BETTER CHECK IT OUT 08737770
B CMNWRK NO - CONTINUE NORMALLY 08737780
CMZT30 EQU * 08737790
TBN PLOPM(,PL),OPSTOP IS THIS A STOP INVITE ? 08737800
BT CMZNP2 YES - CALL $CC4BP-$CC4ZS 08737810
B CMSTOR MOVE IN THE COMMAND LENGTH 08737820
TBN PLOPC(,PL),OPPUT USER PUT OPERATION ? 08737830
TBF PLOPM(,PL),OP$SYS USER ? 08737840
BF CMPAII NO - POST THE P.L. AND CONTINUE 08737850
LA PLECB(,PL),XR1 POST THE USER PUT SUCCESSFUL 08737860
SVC 0 08737870
DC AL1(POSTRB) POST RIB 08737880
SBN PLSWIT,CMSOPE SET ON THE TTASK BIT 08737890
B CMOPNT HANDLE THE PUT AS AN OP END 08737900
EJECT 08737910
.TT150 ANOP 08737920
*********************************************************************** 08737930
* * 08737940
* NAME : CMZSSA * 08737950
* * 08737960
* FUNCTION : MOVE THE PORTLINE INFORMATION INTO THE TPBUFFER AREA * 08737970
* FOR EACH INPUT OPERATION. * 08737980
* * 08737990
* OPERATION : * 08738000
* * 08738010
* EXTERNAL SUBROUTINES USED: * 08738020
* * 08738030
* INPUT: * 08738040
* XR1 --> NO MATTER * 08738050
* XR2 --> LCB FOR THE ACTIVE LINE * 08738060
* * 08738070
* OUTPUT: * 08738080
* THE 17 BYTES PRECEEDING THE DATA IN TPBUFFER WILL HAVE THE * 08738090
* REQUIRED INFORMATION. * 08738100
* * 08738110
* EXITS-NORMAL: * 08738120
* RETURN ON THE ARR * 08738130
* * 08738140
*********************************************************************** 08738150
SPACE 1 08738160
CMZSSA EQU * 08738170
ST CMZS10+3,ARR SAVE THE ARR TO RETURN 08738180
L LCBIBA(,DTF),XR1 XR2 --> INPUT BUFFER AREA 08738190
SLC TPXRTC(4,XR1),TPXRTC(,XR1) CLEAR RETURN/DATA ADDRESS 08738200
MVC 7(1,XR1),13(,XR1) PORT ID INTO TPBUFFER 08738210
MVC $BDIND(1,DTF),13(,XR1) PORT ID INTO THE LCB 08738220
MVC 9(2,XR1),15(,XR1) LENGTH OF TEXT INTO TPBUFFER 08738230
SLC 9(2,XR1),X$0003 DECREMENT THE LENGTH BY THREE 08738240
SLC LCBIBA(2,DTF),X$0001 DECREMENT IBA TO GET TPBUFFER PL 08738250
L LCBIBA(,DTF),XR1 XR2 --> INPUT BUFFER AREA 08738260
ALC LCBIBA(2,DTF),X$0001 INCREMENT IBA BACK TO NORMAL 08738270
MVC 16(4,XR1),0(,XR1) MOVE GETMAIN/FREEMAIN PARMS 08738280
L LCBPL@(,DTF),PL RESTORE XR1 TO THE PARM LIST 08738290
CMZS10 EQU * 08738300
B # 08738310
EJECT 08738320
*********************************************************************** 08738330
* * 08738340
* NAME : CMZQUE * 08738350
* * 08738360
* FUNCTION : QUEUE THE PORTLINE DATA ON TUBDCH CHAIN. * 08738370
* * 08738380
* OPERATION : * 08738390
* * 08738400
* EXTERNAL SUBROUTINES USED: * 08738410
* * 08738420
* INPUT: * 08738430
* XR1 --> ADDRESS OF THE CURRENT PARAMETER LIST * 08738440
* XR2 --> LCB FOR THE ACTIVE LINE * 08738450
* * 08738460
* OUTPUT: * 08738470
* THE ADDRESS TO THE DATA IN TPBUFFER WILL BE IN THE TUBDCH * 08738480
* CHAIN. * 08738490
* * 08738500
* EXITS-NORMAL: * 08738510
* RETURN ON THE ARR * 08738520
* * 08738530
*********************************************************************** 08738540
SPACE 1 08738550
CMZQUE EQU * 08738560
ST CMZQ40+3,ARR SAVE THE ARR TO RETURN 08738570
L CMSDTF,DTF XR2 --> DTF 08738580
TBN PLOPC(,PL),OPDMY IS THIS A DUMMY PARAMETER LIST ? 08738590
JT CMZQ10 YES - QUEUE THE DATA 08738600
TBF PLOPM(,PL),OP$SYS IS THIS A USER OPERATION ? 08738610
TBF PL$OPM(,PL),OPPUT IS THIS A GET OPERATION ? 08738620
TBN $BDIND(,DTF),TPXCMD IS THE DATA COMMAND DATA ? 08738630
JF CMZQ40 IF NOT BOTH, DO NOT QUEUE DATA 08738640
SBN PLSWIT,CMSCMD INDICATE COMMAND DATA TO USER 08738650
CMZQ10 EQU * 08738660
L PLTUBA(,PL),XR2 XR2 --> PORT TUB 08738670
LA TUBDCH-TPXCHN(,XR2),XR2 XR2 --> DATA QUEUE IN THE TUB 08738680
CMZQ20 EQU * 08738690
CLI TPXCHN-1(,XR2),NOBIT END OF THE QUEUE ? 08738700
JE CMZQ30 YES - PUT NEW ENTRY ON THE QUEUE 08738710
L TPXCHN(,XR2),XR2 XR2 --> NEXT ENTRY ON THE QUEUE 08738720
A BCKREG,XR2 BACK UP ONE BYTE 08738730
B CMZQ20 TRY FOR THE END OF THE QUEUE 08738740
CMZQ30 EQU * 08738750
MVC TPXCHN(2,XR2),PLRECA(,PL) CHAIN IN TPBUFFER DATA 08738760
L TPXCHN(,XR2),XR2 XR2 --> NEW DATA IN TPBUFFER 08738770
A BCKREG,XR2 BACK UP ONE BYTE 08738780
MVC TPXRTC(2,XR2),PL$RTC(,PL) RETURN CODE TO TPBUFFER 08738790
MVI TPXCHN-1(,XR2),NOBIT MAKE THIS THE END OF THE CHAIN 08738800
CMZQ40 EQU * 08738810
B # RETURN ON ARR 08738820
.PT030 ANOP 08738830
MEND 08740000