|
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: 37846 (0x93d6)
Types: s3xseg
Names: »S$E085«
└─⟦d0bc1a931⟧ Bits:30009189 5704-sc1.V08.ccp
└─⟦64693a1c9⟧
└─⟦this⟧ »S$E085«
MACRO 00010000
.********************************************************************** 00020000
.* NAME: $E085 * 00030000
.********************************************************************** 00040000
$E085 00050000
GBLB &NOB,&MIN,&NINT,&NPBY 00060000
GBLB &NPP,&NMP,&NSWL,&NCS,&NITB,&NTSP,&N32,&NAS,&NCPU 00070000
LCLA &MIX 00090000
TEXT 00100000
* R-08,C-00 CHANGE LEVEL 00110000
AIF (&NOB).C0500 00120000
TITLE '$E085/CMBSCH---RESCHEDULE-A-BSCA-LINE' 00130000
*********************************************************************** 00140000
* * 00150000
* NAME--CMBSCH, RESCHEDULE A BSCA LINE. * 00160000
* * 00170000
* FUNCTION--TO SCHEDULE WORK ON AN INACTIVE LINE. * 00200000
* * 00230000
* OPERATION-- * 00240000
* * 00310000
* . CLEAR ANY BSCA OP ENDS LEFT IN THE LCB, AND ADJUST THE * 00320000
* OP END TOTAL COUNT (#OPEND). * 00330000
* * 00340000
* . IF QUEUE FOR LINE IS EMPTY THEN POST THE REQUESTOR IF * 00350000
* TP WAS JUST SCHEDULED, CHECK FOR OTHER FUNCTION THAT * 00360000
* CAN BE PERFORMED BY 'CM'. * 00370000
* * 00380000
* . IF A BSCA POLL FOR STATUS OPERATION IN THE QUEUE HANDLE* 00390000
* IT BEFORE ANY OTHER OPERATION. * 00400000
* * 00410000
* . IF A PUT OPERATION CAN BE STARTED, PERFORM IT NEXT. * 00420000
* * 00430000
* . IF NEITHER OF ABOVE TWO, THEN TRY TO SCHEDULE AN INPUT * 00440000
* OPERATION. IF NO INPUT TO SCHEDULE THEN POST THE * 00450000
* REQUESTOR IF TP WAS JUST SCHEDULED. THEN CHECK FOR * 00460000
* OTHER 'CM' FUNCTION THAT CAN BE PERFORMED NOW. * 00470000
* * 00480000
* . IF A WRITE OPERATION CAN BE STARTED, THEN SET UP THE * 00490000
* OUTPUT DATA BUFFER FOR THE LINE. TRANSLATE THE DATA * 00500000
* AS REQUIRED OR SPECIFIED. ADD DEVICE DEPENDENT * 00510000
* CONTROL CHARACTERS. * 00520000
* * 00530000
* . IF NEW OPERATION ON A BSCA CARVE UP THE IOB(S) AND LINE* 00540000
* BUFFER(S) AS NECESSARY TO PERFORM THE OPERATION. SET * 00550000
* UP THE LINE DEPENDENT SECTION OF THE DTF. (POLLING/ * 00560000
* ADDRESSING CHARACTERS, SWITCH ID VERIFICATION IDS, * 00570000
* SWITCH LINE CALL/ANSWER OPTIONS). * 00580000
* * 00590000
* . IF BSCA OPERATION SET UP TO DO THE GET OR PUT-NORMAL, * 00600000
* PUT-BLOCK, PUT-END OF FILE, OR PUT EOT-TO-WACK * 00610000
* OPERATION AS APPROPRIATE. * 00620000
* * 00630000
* . ISSUE OF IOCS CALL AFTER THE DTF IS SET-UP. FOR BSCA, * 00640000
* CALL $$BSMS. * 00650000
* * 00660000
* . AFTER ISSUING THE IOCS CALL, TRACE THE RESULTS. * 00670000
* * 00690000
* . IF BSCA OPERATION IS COMPLETED WITHOUT AN OP END * 00700000
* INTERRUPT THEN FAKE AN OP END INTERRUPT TO KEEP THE * 00710000
* FUNCTION GOING TIL COMPLETION. POST THE REQUESTOR IF * 00720000
* TP WAS JUST SCHEDULED. CHECK FOR MORE WORK TO DO AT * 00730000
* THIS TIME. * 00740000
* * 00750000
* ENTRY POINTS * 01000000
* CMBSCH - SCHEDULE WORK ON A BSCA LINE * 01010000
* CMNOBY - SCHEDULE FOLLOWING REQUEST BY OWNER OF LINE(CMBREQ)* 01020000
* CMFORB - FORM OP CODE FOR MLMP FOR INTERNAL REQUEST. * 01030000
* * 01040000
* INPUT-- * 01050000
* CMSDTF - ADDRESS OF DTF TO BE SCHEDULED. * 01060000
* CMSPL - ADDRESS OF TP PARAMETER LIST TO BE SCHEDULED. * 01070000
* #OPEND - OP END PENDING COUNT. * 01090000
* * 01110000
* OUTPUT-- * 01120000
* CMSDTF - ADDRESS OF DTF FOR LINE SCHEDULED. * 01130000
* CMSPL - ADDRESS OF TP REQUEST SCHEDULED. * 01140000
* DTF(LCB),TUB - SET UP FOR THE OPERATION PERFORMED. * 01150000
* * 01160000
* EXTERNAL REFERENCES-- * 01170000
* $CC4B0 - FORMAT 3270 COMMAND OUTPUT. * 01180000
* $CC4JD - TRANSLATE FROM EBCDIC TO ASCII. * 01190000
* $CC4WR - HANDLE TRANSLATE ERRORS IN OUTPUT. * 01200000
* $CC4WC - SWITCH LINE CALL/ANSWER LOG TRANSIENT. * 01210000
* $TRACE - CCP TRACE ROUTINE. * 01220000
* CMSRPL - SEARCH LINE QUEUE FOR PL TO SCHEDULE ON LINE. * 01230000
* CMTASV - SAVE TERMINAL ATTRIBUTES. * 01240000
* CMBTAS - SETUP DTF AND IOB. * 01250000
* CMGINL - SET UP INPUT RECORD LENGTH. * 01260000
* CMPSCH - FIND SWITCH ID ENTRY IN SWITCH ID LIST. * 01270000
* CMASCH - FIND ADDRESSING ENTRY IN ADDRESSING LIST. * 01280000
* * 01290000
* EXIT, NORMAL-- * 01300000
* - TO CMFRMN IF FREEMAIN POSTED OR TP REQUEST TO BE * 01310000
* HANDLED. * 01320000
* - TO CMPOND IF AN OP END TO BE HANDLED. * 01330000
* * 01340000
* CHANGE ACTIVITY * 01342000
* RELEASE 7 * 01344000
* @01 INCR/ES0705 BUSY PRINTER SUPPORT * 01346000
* * 01348000
*********************************************************************** 01350000
SPACE 01360000
CMBSCH EQU * RESCHEDULE THE LINE B 01370000
L CMSDTF,DTF POINT XR2 AT DTF B 01380000
SPACE 01390000
******************************************************************** B 01400000
* LINE INACTIVE AFTER OP END - * B 01410000
* MAKE SURE OP END COUNTS AND OWNERSHIP FLAG ARE ZERO * B 01420000
******************************************************************** B 01430000
SPACE 1 01440000
AIF (&NSWL).S0050 01450000
&MIX SETA &NPP+&NMP+&NCS 01460000
AIF (&MIX EQ '3').S0060 01470000
TBN $BDATR(,DTF),$BCSWI SWITCHED SLB 01480000
TBF $BDATR(,DTF),$BCMPT * LINE ? SLB 01490000
JT CMROPE YES-DON'T CLEAR 'LCBOWN'. SLB 01500000
.S0050 ANOP 01510000
SLC LCBOWN(2,DTF),LCBOWN(,DTF) CLEAR LINE OWNERSHIP STATUS. B 01520000
.S0060 ANOP 01530000
CMROPE EQU * * LOCAL B 01540000
SLC #OPEND,LCBOPE(1,DTF) REMOVE LINE OP END RESIDUAL. B 01550000
MVI LCBOPE(,DTF),NOBIT CLEAR LINE OP END COUNT. B 01560000
SPACE 01570000
* FREE INPUT HOLD BUFFER NOW IN CASE A PUT NEEDS THE CORE B 01571400
SPACE 1 B 01572100
CLI LCBIBA-1(,DTF),NOBIT ANY TO FREE? B 01572800
JE CMNROP NO-SKIP FREE MAIN CALL B 01573500
LA 0(,DTF),XR1 XR1-->DTF B 01574200
L LCBIBA(,DTF),XR2 XR2-->AREA TO BE FREED B 01574900
MVI LCBIBA-1(,XR1),NOBIT ZERO OUT IBA B 01575600
B CMFMRT GO FREE THE AREA B 01576300
LA 0(,XR1),XR2 RESTORE DTF POINTER B 01577000
CMNROP EQU * * B 01577700
SBN LCBATR(,DTF),LCBTIM SET DEFAULT TO RESCHED NEEDED B 01590000
TBF CMSWIT,CMFMPS FREEMAIN POSTED B 01600000
CLI LCBNW#(,DTF),NOBIT * OR NEW REQT TO HANDLE ? B 01610000
BC CMPAII,FLSNEQ YES - HANDLE WHILE LINE INACT. B 01620000
SPACE 01650000
******************************************************************** B 01660000
* NEW REQUEST SCHEDULE -- * B 01670000
* SEARCH PARAMETER LIST QUEUE FOR PUT REQUEST TO SCHEDULE OR * B 01680000
* IF NO PUT, ALL READS THAT CAN BE SCHEDULED. * B 01690000
******************************************************************** B 01700000
SPACE 01710000
B CMSRPL LCB PL QUEUE SEARCH ROUTINE B 01720000
* XR1 RETURNS PL ADDRESS B 01730000
SPACE 01740000
* XR1 CONTAINS ADDRESS OF PUT PARAMETER LIST TO BE SCHEDULED OR THE B 01750000
* LAST READ PL THAT A BUFFER COULD BE OBTAINED FOR. B 01760000
SPACE 01770000
B CMTASV NOW GO SET UP TAS SAVE AREAS. B 01780000
SPACE 01790000
CMNOBY EQU * * B 01800000
L CMSDTF,DTF POINT XR2 AT DTF B 01810000
ST LCBPL@(,DTF),PL SAVE THE PARM LIST IN LCB. B 01820000
SPACE 1 01830000
******************************************************************** B 01840000
* DETERMINE IF OPERATION IS A READ OR WRITE B 01850000
******************************************************************** B 01860000
SPACE 1 01870000
TBN PL$OPM(,PL),OPGET IS IT READ B 01880000
JT CMFORB JUMP IF TRUE TO READ ROUTINE B 01890000
L PLTUBA(,PL),XR2 XR2----> TUB @01 01890500
* @01 01891000
* BUSY PRINTER SUPPORT CODE @01 01891500
* @01 01892000
AIF (&NPBY).NBY02 BUSY PRINT SUPPORTED? @01 01892500
* IF NON DFF TERMINAL, SKIP THIS SECTION OF BUSY PRINT CODE 01892600
TBN TUBTA1(,XR2),TASDFF IS THIS A DFF TERMINAL? @01 01892700
JF CMNBY2 IF NO, SKIP BUSY PRINT CODE @01 01892800
CLI TUBPHY(,XR2),TUB5M2 TEST FOR 3735 @01 01893000
JH CMNBY2 IF YES, SKIP BUSY PRINT CODE @01 01893500
TBN TUBSCS(,XR2),TUBBPT IS BUSY PRINT ALLOWED @01 01893600
JF CMNBY2 NO, SKIP BUSY PRINT CODE @01 01893700
CLC PLOUTL(2,PL),X$0002 IS PUT LENGTH GR THN 2 @01 01894000
JNH CMNBY2 NO, SKIP PRINTER BSY STUFF @01 01894500
TBF PLOPM(,PL),OPREQR USER OP? @01 01895000
TBN PLOPC(,PL),OPPUT AND PUT? @01 01895500
L PLRECA(,PL),XR2 FIND RECORD AREA @01 01896000
TBN WCC(,XR2),STPRT IS START PRINT BIT ON? @01 01896500
L PLTUBA(,PL),XR2 XR2----> TUB @01 01897000
JF CMNBY2 NOT ALL OF THE ABOVE - JUMP @01 01897500
SBN TUBAT4(,XR2),TUBBSY SET ON PRINTER BUSY BIT @01 01898000
CMNBY2 EQU * @01 01898500
.NBY02 ANOP @01 01899000
L TUBDTF(,XR2),DTF RESTORE DTF REGISTER @01 01899500
TITLE '$E085/CMBSCH----START-A-WRITE-OPERATION' 01900000
******************************************************************* B 01910000
* START A WRITE OPERATION ON THE BSCA LINE * B 01920000
******************************************************************* B 01930000
SPACE 01940000
AIF (&N32).T0810 02000000
CLI CMSPHY,TUB5M2 THIS A 3270 ? 0B 02010000
TBN PL$OPC(,PL),OPUSER SYSTEM FUNCTION ? 0B 02020000
JC CMWXLT,FLSOHI NO-GO CHECK FOR TRANSLATION. 0B 02030000
AIF (&NSWL).T0805 02030800
AIF (&NCS).T0800 02031600
TBF $BDATR(,DTF),$BCMPT NOT SWITCHED LINE ? B 02032400
JF CMB0C2 YES - CALL CONTROL LINE FORMAT B 02033200
.T0800 ANOP 02034000
SVC 0 #### TRANSIENT CALL #### 0B 02034800
DC AL1(CCPRIB) CCP SVC RIB 0B 02035600
DC AL1(CC4S0) BRING IN 3275 FORMAT XIENT. 0B 02036400
* ------START------------------@23 02036800
J CMREFH GO CHECK FOR TRANSLATION. 0B 02037200
* ------END--------------------@23 02037600
.T0805 ANOP 02038000
CMB0C2 EQU * * LOCAL B 02038800
SVC 0 ##### TRANSIENT CALL ##### 0B 02040000
DC AL1(CCPRIB) CCP SVC RIB 0B 02050000
DC AL1(CC4B0) BRING IN 3270 FORMAT XIENT. 0B 02060000
* ------START------------------@23 02061000
CMREFH EQU * * LOCAL 0B 02062000
TBN PL$OPC(,PL),OPRFSH REFRESH OPERATION ? 0B 02063000
JT CMWXLT YES-DON'T UPDATE LENGTH 0B 02064000
SLC LCBADJ(2,DTF),LCBSRT(,DTF) DETERMINE LENGTH OF OUTPUT 0B 02065000
* ------END--------------------@23 02066000
SPACE 02070000
CMWXLT EQU * * LOCAL 0B 02080000
.T0810 ANOP 02090000
AIF (&NAS).A0100 02100000
TBN $BDATT(,DTF),$BCASK IS THIS AN ASCII LINE, AND AB 02110000
TBF SAVTA1,TASTRN TAS SPECIFY TRANSLATE ? AB 02120000
JF CMFORB NO--THEN JUST DO WRITE. AB 02130000
SPACE 02140000
AIF (&N32).T0900 02150000
* IF SYSTEM OR REFRESH OPTION TO A 3270, THEN THE DATA IS IN THE 0AB 02160000
* RESERVED PORTION OF THE BSCA LINE BUFFER. 0AB 02170000
SPACE 02180000
CLI CMSPHY,TUB5M2 THIS A 3270, AND 0AB 02200000
TBN PL$OPC(,PL),OPUSER SYSTEM FUNCTION ? 0AB 02210000
JC CMWREG,FLSOHI NO-GO USE REGULAR FIELDS. 0AB 02220000
MVC #CMTRL+TLFRMA,LCBSRT(2,DTF) FM MSG IS IN RESERVED BUFR.0AB 02230000
MVC #CMTRL+TLTOL,LCBADJ(2,DTF) TRU LENGTH IS IN THE LCB. 0AB 02240000
J CMWTBL GO FILL STANDARD TABLE DATA. 0AB 02250000
SPACE 02260000
.T0900 ANOP 02270000
AIF (&NAS).A0100 02280000
CMWREG EQU * * LOCAL AB 02290000
MVC #CMTRL+TLTOL,PLOUTL(2,PL) * AT START-UP TO TRANSLATE INTAB 02300000
MVC #CMTRL+TLFRMA,PLRECA(2,PL) BUILD TRANSLATE PARM LIST AB 02310000
AIF (&NCPU).T0840 02315000
TBN PLOPM(,PL),OPOLT ON LINE TEST REQUEST ? AUB 02320000
JF CMWTBL NO-SET UP STANDARD FIELDS. AUB 02330000
ALC #CMTRL+TLFRMA(2),OLTLNG BUMP PAST OLT PL TO TEXT. AUB 02340000
.T0840 ANOP 02345000
CMWTBL EQU * * LOCAL AB 02350000
MVC #CMTRL+TLTOA,LCBATL(2,DTF) *USE SPECIAL BLOCK SET ASIDE AB 02360000
LA #CMTRL,XR1 LOAD REG TO POINT TO PARM LISTAB 02370000
SVC 0 ##### TRANSIENT CALL ##### AB 02380000
DC AL1(CCPRIB) CCP SVC RIB AB 02390000
DC AL1(CC4JD) TRANSLATE TRANSIENT AB 02400000
SPACE 02410000
TBN TLRTC(,XR1),TLERR TRANSLATE ERROR ? AB 02420000
L CMSPL,PL POINT TO THE PARM LIST. AB 02430000
JF CMFORB NO-GO GIVE OP TO MLMP. AB 02440000
SPACE 1 02450000
SVC 0 ##### TRANSIENT CALL ##### AB 02460000
DC AL1(CCPRIB) CCP SVC RIB AB 02470000
DC AL1(CC4WR) REQUEST XLATE ERROR RTN. AB 02480000
SPACE 1 02490000
TBN LCBAT2(,DTF),LCBACT LINE ACTIVE ? (BETWEEN EOT) AB 02493000
JF CMWPII NO-JUST POST IF NO WAIT OP. AB 02496000
SBN LCBAT1(,DTF),LCBNTQ SET PARM LIST NOT QUEUED. AB 02500000
CMWPII EQU * * AB 02505000
B CMPAII EXIT HANDLING TP REQUEST. AB 02510000
SPACE 1 02520000
.A0100 ANOP 02530000
TITLE '$E085/CMBSCH---FORM MLMP REQUEST FOR READ OR WRITE' 02540000
******************************************************************** B 02550000
* FORM BSCA TP REQUEST FOR MLMP -- READ OR WRITE * B 02560000
******************************************************************** B 02570000
SPACE 1 02580000
CMFORB EQU * * B 02590000
SPACE 02600000
* IF LINE IS ACTIVE GO FORM NEXT OPERATION - DTF ALREADY SET UP. B 02610000
SPACE 02620000
TBN LCBAT2(,DTF),LCBACT LINE ACTIVE? (BETWEEN EOT) B 02630000
BT CMFVFY YES - GO SET UP NEXT OP. B 02640000
SPACE 1 02650000
*------------------------------------------------------------------- B 02660000
* LINE NOT ACTIVE * B 02670000
*------------------------------------------------------------------- B 02680000
SPACE 1 02690000
AIF (&MIN).N0070 02700000
.* THIS CODE WILL BE IN TRANSIENT $CC4B2 FOR MIN RES SYSTEM RB 02710000
SBF $BDATT(,DTF),$BCCNV+$BCGET SET OFF INPUT/OUTPUT IND'S. RB 02720000
SBF LCBOPC(,DTF),LCBERP RESET BSCA TERM ERP IND. RB 02730000
AIF (&NITB).I0400 02740000
MVI $BDITB(,DTF),NOBIT ZERO ITB COUNT BYTE RIB 02750000
.I0400 ANOP 02760000
MNN LCBOPC(,DTF),PL$OPM(,PL) SAVE OP FOR CNFLICT CHECK. RB 02770000
TBN PL$OPM(,PL),OPGET THIS A GET OPERATION ? RB 02780000
L PLTUBA(,PL),TUB POINT TO THE TUB. RB 02790000
JT CMFGET YES-GO SET UP DTF FOR GET OP. RB 02800000
SPACE 02810000
******************************************************************** RB 02820000
* SET UP DTF FOR ** PUT ** OPERATION. * RB 02830000
******************************************************************** RB 02840000
SPACE 02850000
SBF LCBAT2(,DTF),LCBPUT SET OFF PUT PENDING IND. RB 02860000
SBN $BDATT(,DTF),$BCOUT SET OUTPUT FILE INDICAOR. RB 02870000
MVI $BDOPC(,DTF),$BOPUT SET OP CODE FOR PUT. RB 02880000
SPACE 02890000
* SET CURRENT ATTRIBUTTES, BLOCK LENGTH, AND OWNERSHIP STATUS. RB 02900000
SPACE 02910000
B CMBTAS GO SET UP DTF/IOB/TUB/LCB. RB 02920000
SPACE 02930000
SBN $BDAT1(,DTF),$BCPUT SET PUT SPAN FILE INDICATOR. RB 02940000
MVC $BDBKL(2,DTF),LCBKLC(,DTF) FILL IN DTF BLOCK LENGTH. RB 02950000
AIF (&NITB).I0600 02960000
TBN $BDATT(,DTF),$BCITB ITB MODE ? RIB 02970000
JF CMFLIN NO-GO DO COMMON LINE SETUP. RIB 02980000
MVC $BDITB(1,DTF),TUBBKF(,TUB) MOVE BLK FACTOR TO WRK AREA.RIB 02990000
SLC $BDITB(1,DTF),X$0001 FIND NUMBER OF ITB CHARS. RIB 03000000
ALC LCBKLC(2,DTF),$BDITB(,DTF) ADD # ITB CHAR TO BUF RIB 03010000
AIF (&NTSP).I0500 03020000
TBN $BDATT(,DTF),$BCRAN TRANSPARENCY MODE ? RIXB 03030000
JF CMFTB1 NO-GO SET ITB LENGTH TO ONE.RIXB 03040000
ALC $BDITB(2,DTF),$BDITB(,DTF) DOUBLE THE ITB COUNT TO ADDRIXB 03050000
ALC LCBKLC(2,DTF),$BDITB(,DTF) * 4 TIMES BLOCK FACTOR FOR RIXB 03060000
ALC LCBKLC(2,DTF),$BDITB(,DTF) * TOTAL OF 5 TIMES BLK FAC RIXR 03070000
ALC LCBKLC(2,DTF),X$0002 THEN ADD 2 FOR PUT-ITB-TRP RIXB 03080000
MVC $BDITB(2,DTF),FIVE SET ITB LENGTH TO FIVE. RIXB 03090000
J CMFLIN GO SET UP LINE DEPENDENCIES.RIXB 03100000
SPACE 03110000
CMFTB1 EQU * * LOCAL RIXB 03120000
.I0500 ANOP 03130000
MVI $BDITB(,DTF),1 SET ITB LENGTH COUNT TO ONE. RIB 03140000
.I0600 ANOP 03150000
J CMFLIN GO DETERMINE LINE SETUP NEEDS.RB 03160000
EJECT 03170000
******************************************************************** RB 03180000
* SET UP DTF FOR ** GET ** OPERATION. RB 03190000
******************************************************************** RB 03200000
SPACE 03210000
CMFGET EQU * * LOCAL RB 03220000
SBN $BDATT(,DTF),$BCINP+$BCGET SET INPUT FILE INDICATORS. RB 03230000
MVI $BDOPC(,DTF),$BOGET SET OP CODE FOR GET. RB 03240000
MVC $BDBKL(2,DTF),LCBBFL(,DTF) USE MAXIMUM LINE BLOCK LEN. RB 03250000
MVC LCBKLC(2,DTF),$BDBKL(,DTF) FILL IN CURRENT MAX BLOCK LENRB 03260000
SBN LCBAT2(,DTF),LCBRCI INDICATE RECEIVE INITIAL. RB 03270000
SPACE 2 03280000
AGO .N0075 03290000
.N0070 MVI CMID2,CTFORB MOVE IN ID OF CODE DESIRED MIN B 03300000
B CMCAL2 CALL $CC4B2 TO CHECK LINE MIN B 03310000
* OPEN AND SPECIAL CASES MIN B 03320000
.N0075 ANOP 03330000
******************************************************************** B 03340000
* COMMON GET AND PUT DTF SETUP B 03350000
******************************************************************** B 03360000
SPACE 03370000
CMFLIN EQU * * LOCAL B 03380000
AIF (&NCS).S1000 03390000
&MIX SETA &NPP+&NMP+&NSWL 03400000
AIF (&MIX EQ '3').S0900 03410000
TBN $BDATR(,DTF),$BCMCN CONTROL STATION LINE ? CLB 03420000
JF CMFLCS NO-GO TO END OF CS CODE. CLB 03430000
.S0900 ANOP 03440000
SPACE 03450000
******************************************************************** CB 03460000
* SET CONTROL STATION ONLY DTF FIELDS * CB 03470000
******************************************************************** CB 03480000
SPACE 03490000
MVC $BDLST(2,DTF),LCBPOL(,DTF) MOVE IN POLLING LIST ADDR. CB 03500000
MVC $BDIND(1,DTF),LCBLID(,DTF) FILL DESIRED ID IN THE LIST CB 03512000
MVC $BDLID(1,DTF),LCBLID(,DTF) FILL DESIRED ID IN THE LIST CB 03514000
TBN $BDOPC(,DTF),$BOGET GET 'POLL' REQUEST ? CB 03520000
JT CMFIGR YES-GO FIGURE BUFFER CONFIG. CB 03530000
MVC LCBID#(1,DTF),TUBSID(,TUB) FILL ID OF DESIRED TERM. CB 03550000
LA LCBADL(,DTF),XR1 FILL IN SELECTION 'ADDRESSING'CB 03560000
ST $BDLST(,DTF),XR1 * LIST ADDRESS. CB 03570000
B CMASCH GO TO FIND THE SEL'T ENTRY. CB 03580000
SPACE 03590000
MVC LCBADL+8(9,DTF),8(,POL) MOVE IN MAX LEN SEL'T ENTRY. CB 03600000
MVI CMFLA+2,LCBADL+3 REFRESH INSTRUCTION DISPL. CB 03610000
ALC CMFLA+2,POLCNT(1,POL) SET TO END OF SELECT LIST. CB 03620000
CMFLA EQU * * MODIFICATION CB 03630000
MVI #(,DTF),ONETIM END OF LIST: OPEN LIST IND. CB 03640000
AIF (&MIX EQ '3').S1000 03650000
J CMFIGR GO TO FIGURE BUFFER CONFIG. CLB 03660000
SPACE 03670000
CMFLCS EQU * * LOCAL CB 03680000
.S1000 ANOP 03690000
AIF (&NSWL).S1200 03700000
&MIX SETA &NPP+&NMP+&NCS 03710000
AIF (&MIX EQ '3').S1100 03720000
TBN TUBAT1(,TUB),TUBSWC SWITCHED LINE ? SLB 03730000
.S1100 ANOP 03740000
TBF LCBAT3(,DTF),LCBENB AND LINE NOT ENABLED ? SB 03750000
JF CMFLSW NO-SKIP SWITCH LINE CODE. SB 03760000
SPACE 03770000
******************************************************************** SB 03780000
* SET SWITCHED LINE ONLY DTF FIELDS * SB 03790000
******************************************************************** SB 03800000
SPACE 03810000
MVC LCBID#(1,DTF),TUBSID(,TUB) USE TUB BSCA ID FOR SEARCH. SB 03820000
SBF $BDATR(,DTF),$BCMAN+$BCANS SET OFF SWL LINE TYPES. SB 03830000
TBN SAVTA1,TASCNC SWITCHED CALL ? SB 03840000
JT CMFSMN YES-GO CHECK FOR MANUAL OPERATSB 03850000
SBN $BDATR(,DTF),$BCANS SET DTF FOR ANSWER. SB 03860000
CMFSMN EQU * * LOCAL SB 03870000
TBN SAVTA1,TASAUT AUTO OPERATION ? SB 03880000
JT CMFSRQ YES-GO CHECK REQUESTOR. SB 03890000
SBN $BDATR(,DTF),$BCMAN SET MANUAL OPERATION IN DTF. SB 03900000
CMFSRQ EQU * * LOCAL SB 03910000
L LCBPL@(,DTF),PL POINT TO THE PARM LIST. SB 03920000
TBN PLOPM(,PL),OP$SYS SYSTEM REQUEST ? SB 03930000
JT CMFSNB YES-GO SET ENABLED STATUS. SB 03940000
SPACE 03950000
* ISSUE PHONE CONNECT MESSAGE TO CONSOLE OPERATOR SB 03960000
SPACE 03970000
SVC 0 ##### TRANSIENT CALL ##### SB 03980000
DC AL1(CCPRIB) CCP SVC RIB SB 03990000
DC AL1(CC4WC) BRING IN SWITCH MESSAGE RTN. SB 04000000
SPACE 1 04010000
CMFSNB EQU * * LOCAL 04020000
SBN LCBAT3(,DTF),LCBENB SET LINE ENABLED. SB 04030000
MVC $BDRID(2,DTF),LCBPOL(,DTF) FILL IN SWITCH LIST ADDRESS. SB 04040000
SBN $BDADD(,DTF),$BCSWD SET SWITCH LIST USED IND. SB 04050000
MVI $BDRLN(,DTF),POLACT SET ID TO USE ACTIVE ENTRIES.SB 04060000
TBN $BDATR(,DTF),$BCANS ANSWER LINE, AND SB 04070000
TBN LCBOPC(,DTF),OPGET * GET OPERATION ? SB 04080000
JT CMFIGR YES-GO HANDLE ANSWER-VERIFY IDSB 04090000
SPACE 1 04100000
CMFSCL EQU * * LOCAL SB 04110000
SBF $BDADD(,DTF),$BCSWD SET OFF SWITCH LIST USED. SB 04120000
TBF SAVTA2,TASVFY RECEIVE ID VERIFY ? SB 04130000
JF CMFSNV NO-GO SET FOR NO VERIFY. SB 04140000
B CMPSCH CALL SWITCH LIST SEARCH RTN. SB 04150000
SPACE 1 04160000
* CONTROL IS RETURNED TO NSI IF THE ID IS FOUND IN THE LIST. SB 04170000
SPACE 1 04180000
J CMFSID GO SET UP ID IN THE DTF. SB 04190000
SPACE 1 04200000
* CONTROL RETURNS TO NSI+3 IF IF THE ID WAS NOT FOUND. SB 04210000
SPACE 1 04220000
CMFSNV EQU * * LOCAL SB 04230000
MVI $BDRLN(,DTF),NOBIT SET ZERO LENGTH ID TO RECEIVE.SB 04240000
J CMFIGR GO TO FIGURE THE IOB'S NEEDED.SB 04250000
SPACE 1 04260000
CMFSID EQU * * LOCAL 04270000
MVC $BDRLN(1,DTF),POLCNT(,POL) PUT RECEIVE ID LENGTH IN DTF.SB 04280000
LA POLCH1(,POL),POL UPDATE REG TO FIRST ID CHAR. SB 04290000
ST $BDRID(,DTF),POL STORE ADDRESS OF ID IN DTF. SB 04300000
AIF (&NMP).S1110 04310000
J CMFIGR GO TO FIGURE THE IOB'S NEEDEDSTB 04320000
SPACE 1 04330000
.S1110 ANOP 04340000
CMFLSW EQU * * LOCAL SB 04350000
.S1200 ANOP 04360000
AIF (&NMP).S1130 04370000
&MIX SETA &NPP+&NSWL+&NCS 04380000
AIF (&MIX EQ '3').S1120 04390000
TBN $BDATR(,DTF),$BCMPT MULTI-POINT TRIBUTARY ? TLB 04400000
JF CMFIGR NO-SKIP MP TRIB CODE. TLB 04410000
SPACE 1 04420000
* MULTI-POINT TRIBUTARY SUPPORT. TLB 04430000
SPACE 1 04440000
.S1120 ANOP 04450000
SBF $BDPSC-1(,DTF),POLBIT SET BSCA CHARACTERS FOR POLL. TB 04460000
SBF $BDPSC(,DTF),POLBIT ( I SEND - PUT,ETC ) TB 04470000
TBN $BDOPC(,DTF),$BOGET GETTING ? TB 04480000
JF CMFIGR NO-I'AM PUTTING. TB 04490000
SBN $BDPSC-1(,DTF),POLBIT SET ON FOR BEING ADDRESSED, TB 04500000
SBN $BDPSC(,DTF),POLBIT ( I RECEVIE - GET, ETC) TB 04510000
.S1130 ANOP 04520000
SPACE 04530000
********************************************************************* 04540000
* FIGURE OUT THE SPACE REQUIREMENTS FOR IOBS AND BUFFERS. B 04550000
********************************************************************* 04560000
SPACE 04570000
CMFIGR EQU * * B 04580000
MVC $BDIOB(2,DTF),LCBSRT(,DTF) RESTORE BUFFER START ADDRESS. B 04590000
CLI $BDWKA-1(,DTF),NOBIT WORK AREA ADDRESS SET YET ? B 04591300
JE CMNWKA NO - DON'T SET RETRY COUNT B 04591600
L $BDWKA(,DTF),WKA XR1-->WORK AREA B 04592000
MVC WKERRD(1,WKA),$BDERR(,DTF) RESTORE ERROR RETRY COUNT B 04593000
* --START-------------------@32 04593500
SLC DCOUNT(2,WKA),DCOUNT(,WKA) ZERO DELAY COUNT. B 04594000
* ---END--------------------@32 04594200
CMNWKA EQU * * LOCAL B 04594500
AIF (&N32).T1200 04600000
L LCBPL@(,DTF),PL RELOAD THE PL REG. 0B 04610000
SPACE 04620000
* IF SYSTEM OR REFRESH OF 3270 SYSTEM, THEN RESERVE THE FIRST PART 0B 04630000
* OF THE LINE BUFFER FOR THE OUTPUT. 0B 04640000
SPACE 04650000
CLI CMSPHY,TUB5M2 THIS A 3270 TERMINAL ? 0B 04660000
TBN PL$OPM(,PL),OPPUT PUT OPERATION ? 0B 04670000
TBN PL$OPC(,PL),OPUSER SYSTEM FUNCTION ? 0B 04680000
JC CMFIGL,FLSOHI NO-GO HANDLE REGULARILY. 0B 04690000
ALC $BDIOB(2,DTF),MAXMSG RESERVE LINE BUFFER SPACE. 0B 04700000
MVC LCBKLC(2,DTF),LCBADJ(,DTF) USE ADJUSTED LEN FOR BLK LEN. B 04710000
CMFIGL EQU * * LOCAL 0B 04720000
.T1200 ANOP 04730000
AIF (&MIN).N0080 04740000
.* THIS FOLLOWING CODE WILL BE IN TRANSIENT $CC4B2 04750000
L LCBKLC(,DTF),WORK BLOCK SIZE REQUIRED IN WORK RB 04760000
LA LINFO(,WORK),WORK ALLOW FOR MAX LINE CONTROL RB 04770000
ST LCBWRK(,DTF),WORK SAVE COMPUTED VALUE. RB 04780000
SPACE 04790000
******************************************************************** RB 04800000
* INITIALIZE IOB * RB 04810000
******************************************************************** RB 04820000
SPACE 04830000
L $BDIOB(,DTF),IOB LOAD PTR TO IOB. RB 04840000
MVC IOBQ(1,IOB),$BDDEV(,DTF) BUILD IOB Q CODE. RB 04850000
MVC IOBDBL(2,IOB),LCBWRK(,DTF) PUT BUFFER LENGTH INTO IOB. RB 04860000
ST IOBNXT(,IOB),IOB POINT 1ST IOB TO SELF. RB 04870000
ST IOBDTF(,IOB),DTF POINT IOB BACK TO DTF. RB 04880000
MVI IOBERR(,IOB),X'00' SET ERROR COUNT TO ZERO. RB 04890000
ST IOBDAT(,IOB),IOB SET @ OF IOB RB 04900000
ALC IOBDAT(2,IOB),IOBLEN * DATA AREA. RB 04910000
MVC IOBFLG(1,IOB),$BDATT(,DTF) SET IOB FLAG BYTE. RB 04920000
MVI IOBFLA(,IOB),TXTSNT INITIALIZE TEXT INDICATORS. RB 04930000
MVI IOBCMP(,IOB),DONE INITIALIZE BUFFER STATUS. RB 04940000
TBN $BDATT(,DTF),$BCINP GET FILE ? RB 04950000
JF CMFMOR NO-GO CONTINUE CARVING. RB 04960000
MVI IOBCMP(,IOB),READY ELSE SET BUFFER STATUS TO READRB 04970000
MVI IOBFLA(,IOB),X'00' ZERO TEXT DIRECTION INDICATOR.RB 04980000
CMFMOR EQU * * LOCAL RB 04990000
MVC IOBNEX(2,IOB),IOBDAT(,IOB) DETERMINE START ADDRESS FOR RB 05000000
ALC IOBNEX(2,IOB),IOBDBL(,IOB) * ANOTHER IOB. RB 05010000
CMFMUL EQU * * LOCAL RB 05020000
MVC IOBDBN(2,IOB),IOBNEX(,IOB) DETERMINE ADDRESS OF NEXT RB 05030000
ALC IOBDBN(2,IOB),IOBLEN * DATA AREA. RB 05040000
MVC IOB2NX(2,IOB),IOBDBN(,IOB) DETERMINE END ADDRESS FOR RB 05050000
ALC IOB2NX(2,IOB),IOBDBL(,IOB) * POSSIBLE NEXT IOB/BUFFER. RB 05060000
CLC IOB2NX(2,IOB),LCBBND(,DTF) ANOTHER IOB/BUFFER FIT ? RB 05070000
JH CMFCLN NO-GO CLEAN-UP THIS OPEN. RB 05080000
L IOBNEX(,IOB),IBX LOAD REG WITH IOB NEXT @. RB 05090000
MVC IOBDTF(IOBDTF+1,IBX),IOBDTF(,IOB) COPY THE IOB. RB 05100000
ST IOBNXT(,IOB),IBX CHAIN NEXT IOB TO LAST. RB 05110000
MVC IOBDAT(2,IBX),IOBDBN(,IOB) MOVE IN NEW DATA BUFFER @. RB 05120000
MVC IOBNEX(2,IBX),IOB2NX(,IOB) MOVE PTR TO NEXT IOB AREA. RB 05130000
LA 0(,IBX),IOB MAKE LAST IOB IN CHAIN CURRENTRB 05140000
L IOBDTF(,IOB),DTF RESTORE DTF REGISTER. RB 05150000
B CMFMUL GO TO MULTIPLE IOB LOGIC RB 05160000
SPACE 05170000
* IOB AND BUFFER ALLOCATION DONE, PERFORM FINAL CLEAN-UP ACTIVITY. RB 05180000
SPACE 05190000
CMFCLN EQU * * LOCAL RB 05200000
MVI $BDCMP(,DTF),$BCDNE MARK DTF DONE. RB 05210000
MVC $BDINT(2,DTF),LCB$L0(,DTF) RESTORE C/S @ OF $$BSL0. RB 05220000
MVI $BDNDX(,DTF),X'00' SET LINE INIT TRANS. ID TO RB 05230000
L IOBNXT(,IOB),IOB POINT TO 1ST IOB. RB 05240000
SBN IOBFLA(,IOB),FIRST SET FIRST BUFFER INDICATOR. RB 05250000
L LCBPL@(,DTF),PL RELOAD THE PARM LIST REG RB 05260000
SPACE 1 05270000
AGO .N0085 05280000
.N0080 ANOP 05290000
MVI CMID2,CTRLB MOVE IN FLAG OF CODE TO MIN B 05300000
* EXECUTE IN THE TRANSIENT MIN B 05310000
B CMCAL2 CALL IN TRANSIENT $CC4B2 MIN B 05320000
.N0085 ANOP 05330000
SPACE 4 05340000
******************************************************************** B 05350000
* FINAL SETUP OF OP CODE AND RECORD LENGTH BEFORE IOS CALL B 05360000
******************************************************************** B 05370000
SPACE 05380000
CMFVFY EQU * * B 05390000
TBF LCBAT2(,DTF),LCBABT OPERATION AN ABORT, OR B 05400000
TBF LCBAT1(,DTF),LCBEOT SEARCH FOR EOT INDICATED ? B 05410000
JT CMFVUR NO-GO USE USER RECORD AREA. B 05420000
SPACE 1 05430000
*------------------------------------------------------------------* B 05440000
* SEARCH FOR EOT-- SET TO READ 1 CHAR INTO DUMMY BUFFER * B 05450000
*------------------------------------------------------------------* B 05460000
SPACE 1 05470000
MVC $BDREL(2,DTF),X$0001 SET RECORD LENGTH TO ONE. B 05480000
MVC $BDWKB(2,DTF),FNDEOT USE DUMMY DATA AREA TO FIND EOTB 05490000
* ------START------------------@09 05491000
L $BDWKA(,DTF),WKA XR1-->WORK AREA 05492000
MVI WKERRD(,WKA),BIT7 SET RETRY COUNT TO 1 05493000
L LCBPL@(,DTF),PL XR1--> ACTIVE PARM LIST 05494000
* --------END------------------@09 05495000
TBN LCBOPC(,DTF),OPPUT PUT OP CODE ? B 05500000
JT CMFVPT YES-MUST BE ABORT, GO SEND EOT.B 05510000
J CMBSCL GO TO CALL MLMP IOCS. B 05520000
SPACE 05530000
CMFVUR EQU * * LOCAL B 05540000
MVC $BDWKB(2,DTF),PLRECA(,PL) FILL IN DATA AREA @ IN DTF. B 05550000
TBN $BDATT(,DTF),$BCINP GET OPERATION ? B 05560000
JF CMFVPT NO-GO SET UP FINAL PUT DTF. B 05570000
SPACE 1 05580000
*------------------------------------------------------------------* B 05590000
* GET OPERATION * B 05600000
*------------------------------------------------------------------* B 05610000
SPACE 1 05620000
AIF (&NINT).CT050 05630000
* START THE INTERVAL TIMER RUNNING NB 05640000
SPACE 1 05650000
LA TIMIOB,XR2 XR2-->TIMER IOB NB 05660000
MVI TIFLAG(,XR2),X'02' IND.'TIME IS IN TIMER UNITS' NB 05670000
SVC 0 * NB 05680000
DC AL1(STMRIB) START THE TIMER NB 05690000
SPACE 1 05700000
L PLTUBA(,PL),XR2 XR2-->TUB NB 05710000
L TUBDTF(,XR2),DTF XR2--->DTF NB 05720000
.CT050 ANOP 05730000
TBN PLOPC(,PL),OPRVI RVI B 05740000
TBF PLOPC(,PL),OPORDR-OPRVI SEND OP CODE? B 05750000
JF CMFGIL NO-GO GET INPUT LENGTH. B 05760000
SBN LCBOPC(,DTF),LCBRVI SET SEND RVI INDICATOR B 05770000
CMFGIL EQU * * LOCAL B 05780000
&MIX SETA &NCS+&NSWL 05790000
AIF (&MIX EQ '2').T1250 05800000
TBN LCBAT2(,DTF),LCBRCI RECEIVE INITIAL ON A C/SB 05810000
JT CMBSIO YES-GO TO BSCA IOCS CALL. C/SB 05820000
.T1250 ANOP 05830000
SPACE 1 05840000
* IF NOT RECEIVE INITIAL,MLMP MAY MOVE DATA PRIOR TO $$BMCH CALL B 05850000
* ,THEREFORE GETMAIN AND SET UP DTF TO BE READY. B 05860000
SPACE 1 05870000
B CMGINL COMPUTE BUFFER LENGTH AND B 05880000
* * GETMAIN. B 05890000
CMBSCL EQU * * 05895000
J CMBSIO GO TO BSCA IOCS CALL. B 05900000
SPACE 2 05910000
*------------------------------------------------------------------* B 05920000
* PUT OPERATION * B 05930000
*------------------------------------------------------------------* B 05940000
SPACE 1 05950000
CMFVPT EQU * * LOCAL B 05960000
MVI $BDOPC(,DTF),$BOPUT SET OP CODE TO NORMAL PUT. B 05970000
MVI $BDCMP(,DTF),$BCREQ SET CMP TO OP REQUESTED. B 05980000
TBN LCBAT2(,DTF),LCBSET SEND EOT ORDERED ? B 05990000
JT CMFVET YES-GO SETUP SEND EOT. B 06000000
MVC $BDREL(2,DTF),PLOUTL(,PL) PUT OUTL INTO DTF RECORD LEN. B 06010000
AIF (&NCPU).T1270 06015000
TBN PLOPM(,PL),OPOLT ON LINE TEST REQUEST ? UB 06020000
JF CMFNLT NO-JUMP PAST OLT CODE. UB 06030000
SPACE 06040000
* ONLINE TEST REQUEST FROM CONSOLE TO BE SENT TO OTHER CPU. UB 06050000
* PLRECA POINTS TO A 12 BYTE MLMP OLT PARAMETER LIST FOLLOWED UB 06060000
* BY AN OPTIONAL USER SPECIFIED OLT MSG. PLOUTL TO TOTAL LGTH.UB 06070000
SPACE 06080000
MVC $BDRFT(2,DTF),$BDWKB(,DTF) FILL IN MLMP OLT PARM LIST @.UB 06090000
ALC $BDWKB(2,DTF),OLTLNG BUMP PAST OLT PARM LIST UB 06100000
* * TO OLT MESSAGE. UB 06110000
SLC $BDREL(2,DTF),OLTLNG REDUCE LENGTH TO OLT LENGTH, UB 06120000
* *MESSAGE ONLY, EXCLUDE OLT PL.UB 06130000
CMFNLT EQU * * LOCAL UB 06140000
.T1270 ANOP 06145000
SPACE 06150000
AIF (&N32).T1300 06160000
* IF SYSTEM REQUEST OR REFRESH OPERATION, THEN USE RESERVED AREA IN0B 06170000
* THE LINE BUFFER. 0B 06180000
SPACE 06190000
CLI CMSPHY,TUB5M2 THIS A 3270 ? 0B 06200000
TBN PL$OPC(,PL),OPUSER SYSTEM FUNCTION ? 0B 06210000
JC CMFVMD,FLSOHI NO-GO VERIFY THE MODE. 0B 06220000
MVC $BDWKB(2,DTF),LCBSRT(,DTF) SET CORRECT ADDRESS FOR OUTPU0B 06230000
MVC $BDREL(2,DTF),LCBADJ(,DTF) USE CORRECT LENGTH OF THE DAT0B 06240000
CMFVMD EQU * * LOCAL 0B 06250000
.T1300 ANOP 06260000
AIF (&NAS).A0200 06270000
SPACE 06280000
* IF THIS IS AN ASCII TRANSLATE SITUATION, THEN USE RESERVED ASCII AB 06290000
* TRANSLATION BUFFER AS FROM ADDRESS. AB 06300000
SPACE 06310000
TBN $BDATT(,DTF),$BCASK ASCI LINE, AND AB 06320000
TBF SAVTA1,TASTRN * TRANSLATION DONE ? AB 06330000
JF CMFVOP NO-GO VERIFY OP CODE. AB 06340000
MVC $BDWKB(2,DTF),LCBATL(,DTF) USE ASCI XLATE BUFFER IN WKB. B 06350000
CMFVOP EQU * * LOCAL AB 06360000
.A0200 ANOP 06370000
AIF (&N32).T1400 06380000
TBN PLOPC(,PL),OPGET GET TO BE PERFORMED NEXT ? 0B 06390000
JT CMFPEW YES-GO DO PUT EOT TO WACK. 0B 06400000
TBN PLOPC(,PL),OPMSG IS OP REQUESTED A 0B 06410000
* ----------START--------------@ 06415000
TBF PLOPC(,PL),OPORDR-OPRUF * PUT-EOT ? 0B 06420000
* -----------END---------------@ 06425000
SPACE 1 06430000
* SET PUT-EOT TO ACK OR WACK FOR 3270 SYSTEM FOR PUT-MSG. 0B 06440000
SPACE 1 06450000
JF CMFPT0 NO-NOT PUT-MSG, USE REGULAR OP0B 06460000
CMFPEW EQU * * LOCAL 0B 06470000
L PLTUBA(,PL),TUB POINT TO THE TUB. 0B 06480000
CLI TUBPHY(,TUB),TUB5M2 3270 SYSTEM ? 0B 06490000
L LCBPL@(,DTF),PL XR1 --> PARM LIST 06495000
JH CMFPT0 NO-GO CHECK FOR PUT OF ZERO LE0B 06500000
MVI $BDOPC(,DTF),$BOPEW SET PUT-EOT TO ACK/WACK. 0B 06510000
SBN LCBAT2(,DTF),LCBSET SET SEND EOT IND. 0B 06520000
TBN PL$OPC(,PL),OPUSER IF INTERNALLY SET UP SYS OP 0B 06540000
JT CMBSIO YES - DONT DO CHECK ON PLOUTL 0B 06550000
* * DTF IS SET UP DIFFERENTY. 0B 06560000
J CMFVPM GO CHECK LENGTH 0B 06570000
SPACE 1 06580000
CMFPT0 EQU * * LOCAL 0B 06590000
.T1400 ANOP 06600000
TBF PL$OPC(,PL),OPUSER USER FUNCTION, AND B 06620000
TBF PLOPC(,PL),OPMSG RECORD MODE ? B 06630000
JT CMFVRC YES-GO HANDLE RECORDS. B 06640000
TBN PLOPC(,PL),OPMSG IS OP REQUESTED A B 06650000
TBF PLOPC(,PL),OPORDR-OPRUF * PUT EOT? B 06660000
CLC $BDREL(2,DTF),X$0000 ZERO LENGTH PUT-MSG ? B 06670000
JC CMFVPB,FLSNEQ NO-GO SET PUT BLOCK OP CODE. B 06680000
SBN LCBAT2(,DTF),LCBSET SET SEND EOT IND. B 06690000
CMFVET EQU * * LOCAL B 06700000
TBN LCBAT2(,DTF),LCBABT ABORT OF A - 06701800
TBN LCBOPC(,DTF),OPPUT * PUT ? 06702700
JF CMFABT NO-CONTINUE 06703600
L $BDWKA(,DTF),WKA XR1-->WORK AREA 06704500
MVI WKERRD(,WKA),NOBIT SET RETRY COUNT TO 0 06705400
MVC DCOUNT(2,WKA),X$FFFC SET DELAY COUNT VERY HIGH 06706300
B CMFRTN GO WAIT FOR OP END 06707200
CMFABT EQU * LOCAL 06708100
MVI $BDOPC(,DTF),$BOPEF SET PUT END OF FILE OP CODE B 06710000
B CMFAKE GO FAKE CALL TO MLMP, FORCE CHKB 06720000
SPACE 06730000
CMFVPB EQU * * LOCAL B 06740000
MVI $BDOPC(,DTF),$BOPEB SET OP CODE TO PUT END OF BLOCKB 06750000
AIF (&N32).T1405 06760000
CMFVPM EQU * * LOCAL 0B 06770000
.T1405 ANOP 06780000
CLC PLOUTL(2,PL),LCBKLC(,DTF) OUTL GREATER THAN BLOCK LEN ? B 06790000
JNH CMBSIO NO-GO CALL MLMP IOCS. B 06800000
MVC $BDREL(2,DTF),LCBKLC(,DTF) TRUNCATE TO BLOCK LENGTH. B 06810000
J CMFVSM GO SET TRUNCATED IND. B 06820000
SPACE 06830000
CMFVRC EQU * * LOCAL B 06840000
L PLTUBA(,PL),TUB LOAD THE TUB REG. B 06850000
TBF SAVTA2,TASITB+TASPAN+TASVRL MLMP VARIABLE SUPPORT ? B 06860000
CLC $BDREL(2,DTF),TUBRCL(,TUB) OUTL LT TAS RECORD LEN ? B 06870000
JC CMBSIO,FLSOEQ YES-CALL MLMP, ALL IS SET. B 06880000
JL CMFVSM OUTL LT TAS RECL, BLANKS NEEDEDB 06890000
MVC $BDREL(2,DTF),TUBRCL(,TUB) USE TAS RECORD LEN FOR PUT. B 06900000
CMFVSM EQU * * LOCAL B 06910000
SBN LCBAT2(,DTF),LCBTRC SET TRUNCATED INDICATOR. B 06920000
TITLE '$E085/CMBSCH---BSCA RESCHEDULE LINE - MLMP IOS CALL' 06930000
****************************************************************** B 06940000
* ISSUE START I/O OPERATION TO MLMP (BSCA IOS) - READ OR WRITE* B 06950000
****************************************************************** B 06960000
SPACE 1 06970000
CMBSIO EQU * * LOCAL B 06980000
AIF (&NINT).CT055 06981000
TBN LCBOPC(,DTF),OPPUT PUT OPERATION 06982000
JF CMTROF NO-CONTINUE 06983000
SBF $FLGC,#NTRAC SET OFF NO TRACE INDICATOR 06984000
CMTROF EQU * * 06985000
.CT055 ANOP 06986000
SPACE 1 06987000
L LCBPL@(,DTF),PL RELOAD THE PL REG. B 06990000
* -----START-------------------@19 06990500
SBF LCBAT2(,DTF),LCBSEC SET OFF SECOND BLOCK IND. B 06991000
TBN LCBAT2(,DTF),LCBRCI RECEIVE INITIAL ? B 06991500
JT CMSDTX YES-GO TO MLMP B 06992000
SBN LCBAT2(,DTF),LCBSEC SET ON SECOND BLOCK IND. B 06992500
TBN PL$OPM(,PL),OPGET GET OPERATION AND B 06993000
TBF LCBAT1(,DTF),LCBEOT * NOT SEARCH EOT B 06993500
JF CMSDTX NO-CALL MLMP B 06994000
TBN LCBAT2(,DTF),LCBTRC DATA TRUNCATED ? B 06994030
SBF LCBAT2(,DTF),LCBTRC SET OFF DATA TRUNCATED. B 06994060
JT CMSDTX YES - GO TO MLMP. B 06994090
TBF SAVTA2,TASREC+TASBLK MESSAGE MODE TERMINAL ? B 06994120
JT CMBNOG YES - DON'T GO TO MLMP. B 06994150
TBN SAVTA2,TASREC RECORD MODE TERMINAL ? B 06994180
L $BDIOB(,DTF),XR1 XR1 -> IOB. B 06994210
CLI IOBCMP(,XR1),PROCES IOB IN PROCESS ? B 06994240
L LCBPL@(,DTF),PL XR1 -> PARM LIST. B 06994270
JC CMBNOG,FLSNEQ NO-DON'T FAKE AN OP END. B 06994300
ALC #OPEND(1),X$0001 UP OP END COUNT BY ONE. B 06994330
ALC LCBOPE(1,DTF),X$0001 BUMP LINE OP END COUNT BY ONE. B 06994360
CMBNOG EQU * * LOCAL. B 06994390
* GET OPERATION AND NOT RECEIVE INITIAL AND NOT SEARCH EOT, THEN B 06994500
* DON'T CALL MLMP. MLMP HAS ALREADY STARTED THE NEXT GET. WAIT FOR B 06995000
* THE OP-END AND CALL CHECK TO MOVE THE DATA. B 06995500
MVI DTFCMP(,DTF),OPACC SET COMP TO OP ACCEPTED. B 06996000
SBF $BDAT1(,DTF),$BCNOW SET OFF SPANNED RECORDS B 06996500
L $BDWKA(,DTF),WKA XR1 -> MLMP WORKAREA B 06997000
SBF $BWFG3(,WKA),F3MOVE SET OFF DATA MOVED IND. B 06997500
L LCBPL@(,DTF),PL XR1 -> PARAMETER LIST B 06998000
J CMTRGT GO AROUND CALL FOR MLMP B 06998500
CMSDTX EQU * * LOCAL B 06999000
* -----END---------------------@19 06999500
B $$BSMS ##### MLMP IOS CALL ###### B 07000000
SPACE 07010000
CMTRGT EQU * * LOCAL B 07015000
B CMTRCE TRACE SIO VIA TRACE SUBROUTINE B 07020000
DC AL1(CCPRIB) CCP RIB B 07030000
DC AL1(TRRIB) TRACE SUBRIB B 07040000
DC AL1(TTBSIO) ID FOR BSCA START IO B 07050000
SPACE 07060000
SBN LCBAT2(,DTF),LCBACT SET LINE ACTIVE IND. B 07070000
AIF (&NCPU).T1500 07075000
TBN PLOPM(,PL),OPOLT ON LINE TEST REQUEST ? UB 07080000
L $BDWKA(,DTF),WKA XR1-> MLMP WORK AREA. B 07090000
JF CMFAKR NO-GO CHECK FOR ERROR POSTED. UB 07100000
SBN $BWFG3(,WKA),$BWRFT SET RFT STARTED IND. UB 07110000
SBN LCBAT2(,DTF),LCBSET SET SEND EOT INDICATOR. UB 07120000
AGO .T1600 07122000
.T1500 L $BDWKA(,DTF),WKA XR1-> MLMP WORK AREA. B 07124000
.T1600 ANOP 07126000
CMFAKR EQU * * LOCAL B 07130000
TBN ACKSD(,WKA),AKERR ERROR POST PENDING FROM MLMP ? B 07140000
JF CMNFAK NO - CHECK OTHERS B 07150000
SBF ACKSD(,WKA),AKERR SET OFF ERROR CONDITION 07152000
CLI LCBOPE(,DTF),NOBIT OP ENDS = 00 ? 07154000
JE CMFAKE YES - FAKE AN OP END 07156000
CMNFAK EQU * * LOCAL B 07158000
TBN $BWFG3(,WKA),F3MOVE RECORD MOVED INDICATOR ON ? B 07160000
JF CMFEOT NO-GO CHECK EOT POSTED IN IOB. B 07170000
SBN LCBOPC(,DTF),LCBMVD SET ON DATA MOVED INDICATOR. B 07180000
TBF LCBOPE(,DTF),ALLBIT OP END COUNT = 0 ? 07181200
JT CMFAKE YES - GO FAKE AN OP END 07181800
SPACE 2 07182400
* IF A BLOCK MODE TERMINAL,THEN MLMP HAS ALREADY MOVED THE DATA; 07182480
* HOWEVER,THE MAX RECORD LENGTH WAS USED. WE MUST CALCULATE THE 07182560
* TRUE RECORD LENGTH BEFORE POSTING THE USER. 07182640
SPACE 2 07182720
TBF SAVTA2,TASMSG NOT MESSAGE MODE ? 07182800
JF CMFEOT NO-CHECK EOT POSTED 07182880
SLC SAVCAT-2(2),SAVCAT SUB TAR FROM CAR 07183000
SLC SAVCAT-2(2),X$0001 DECREMENT FOR SOH OR STX 07183600
TBN SAVTA2,TASTSP TRANSPARENCY ? 07184200
JF CMNXPR NO-GOPOST 07184800
SLC SAVCAT-2(2),X$0001 DECREMENT FOR DLE 07185400
CMNXPR EQU * * 07186000
L LCBPL@(,DTF),PL XR1-->PARM LIST 07186600
MVC PLEFFL(2,PL),SAVCAT-2 PLUG NEW LENGTH 07187200
J CMFRTN GO TO POSTING LOGIC 07187800
SPACE 2 07188400
CMFEOT EQU * * LOCAL B 07210000
L $BDIOB(,DTF),IOB POINT TO THE IOB. B 07220000
CLI IOBCMP(,IOB),$BCEOT EOT POSTED IN THE IOB ? B 07230000
JNE CMFRTN NO-GO EXIT NORMALLY. B 07240000
CMFAKE EQU * * LOCAL B 07250000
ALC #OPEND(1),X$0001 UP OP END COUNT BY ONE. B 07260000
ALC LCBOPE(1,DTF),X$0001 BUMP LINE OP END COUNT. B 07270000
CMFRTN EQU * * LOCAL B 07280000
AIF (&NINT).CT060 07290000
SBF LCBATR(,DTF),LCBTIM SET TIMER IND. OFF B 07300000
.CT060 ANOP 07310000
B CMPAII GO TO POSTING LOGIC B 07320000
.C0500 ANOP 07330000
MEND 07340000