|
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: 52070 (0xcb66)
Types: s3xseg
Names: »S$E072«
└─⟦4498c64f7⟧ Bits:30009191 5704-sc2.V05.ccp
└─⟦95ee7795b⟧
└─⟦this⟧ »S$E072«
MACRO 00010000
.********************************************************************** 00020000
.* NAME: $E072 * 00030000
.********************************************************************** 00040000
$E072 00050000
GBLB &NOB,&MIN,&NCS,&N32,&NDME,&NSWL,&NAS,&NDF,&NRUF 00060000
GBLB &NMSG,&N37,&NINT,&N41,&NPBY,&NAPOR,&NTTSK 00080000
LCLA &MIX 00090000
TEXT 00100000
* R-05,C-00 CHANGE LEVEL 00110000
AIF (&NOB).C0300 00120000
TITLE '$E072/CMBOPE----BSCA OPERATION END HANDLING' 00130000
*********************************************************************** 00140000
* * 00150000
* NAME--CMBOPE * 00160000
* * 00170000
* TITLE--BSCA OP END ANALYSIS * 00180000
* * 00190000
* FUNCTION--ANALYSE EACH OP END FOR A TP LINE AND DETERMINE WHAT * 00200000
* IF ANYTHING MUST BE DONE TO COMPLETE THE CURRENT TP * 00210000
* OPERATION. ROUTE COMPLETED OPERATION BACK TO THE USER. * 00220000
* RESCHEDULE WORK ON THE LINE IF NO MORE OP ENDS TO BE * 00230000
* HANDLED. * 00240000
* * 00250000
* OPERATION-- * 00260000
* * 00270000
* . IF ABORT OPERATION, HANDLE THE ABORT UNTIL IT IS * 00280000
* COMPLETE. THEN RESCHEDULE THE LINE. * 00290000
* * 00300000
* . IF STOP INVITE REQUEST CALL $CC4BQ * 00310000
* * 00320000
* . FIND THE OP ENDED PARAMETER LIST AND SET ON THE POLL * 00330000
* SKIP BIT. * 00340000
* * 00350000
* . TRACE THE OP END AFTER CALLING CHECK * 00360000
* * 00370000
* . IF AN ERROR OCCURRED CALL $CC4BE. ON RETURN * 00380000
* EITHER POST THE RESULTS TO THE USER, RESCHEDULE THE * 00390000
* LINE, OR HANDLE THE DATA IN THE LINE BUFFER. * 00400000
* * 00410000
* . IF WRITE OP END, THEN * 00420000
* - IF BSCA RECORD WAS SHORTED THEN DEFINED AT * 00430000
* ASSIGNMENT TIME, CALL TRANSIENT TO FILL OUT THE * 00440000
* RECORD TO CORRECT LENGTH. * 00450000
* * 00460000
* - SET UP THE RETURN CODE FOR THE RESULTS OF THE * 00470000
* OPERATION. * 00480000
* * 00490000
* - IF BSCA IS NOT COMPLETE, CALL RESCHEDULE FUNCTION * 00500000
* TO COMPLETE THE OPERATION. * 00510000
* - EOT MUST BE SENT. * 00520000
* - OPERATION NOT COMPLETE BECAUSE CLEAR KEY IS * 00530000
* BEING HANDLED. * 00540000
* * 00550000
* - IF BSCA OPERATION IS COMPLETE, THEN * 00560000
* - FREE THE DFF HOLD BUFFER IF DFF PUT. * 00570000
* * 00580000
* - IF PUT-THEN-GET, THEN SET UP THE GET OPERATION IN * 00590000
* THE INTERNAL OP CODE, THEN RESCHEDULE THE LINE. * 00600000
* * 00610000
* - IF OPERATION IS COMPLETED SET UP TO POST THE * 00620000
* REQUESTOR OF THE RESULTS. * 00630000
* * 00640000
* . IF READ OP END, THEN * 00650000
* - IF BSCA RECEIVE INITIAL WAS LAST OP, CHECK FOR ANY * 00660000
* CONFLICTING OPERATION IN THE LINE QUEUE, AND REJECT * 00670000
* THEM IF ANY FOUND. * 00680000
* * 00690000
* - IF BSCA MESSAGE MODE INPUT, SET UP TO CONSOLIDATE * 00700000
* ALL BLOCKS INTO ONE MESSAGE. SET UP TO RESCHEDULE * 00710000
* LINE AND GET TO EOT BEFORE RETURNING TO THE USER. * 00720000
* * 00730000
* - IF DATA MODE ESCAPE RECOGNIZED IN THE INPUT DATA * 00740000
* STREAM THEN SET UP POST OF THE COMMAND PROCESSOR. * 00750000
* * 00760000
* - IF VALID INPUT DATA, MOVE, TRANSLATE, TRUNCATE THE * 00770000
* DATA AS REQUIRED. * 00780000
* * 00790000
* - IF 3270 BSCA INPUT CHECK FOR CLEAR KEY HIT AND * 00800000
* HANDLE IT. * 00810000
* * 00820000
* . IF COMPLETED DATA OPERATION, THEN * 00830000
* - REMOVE THE TP REQUEST FROM THE LINE QUEUE. * 00840000
* - FREE UP PUT-NO-WAIT HOLD BUFFERS. * 00850000
* - POST THE REQUESTOR OF THE TP OPERATION THAT IT IS * 00860000
* COMPLETE. * 00870000
* - QUEUE INVITE INPUT PARAMETER LIST ONTO THE TCB. * 00880000
* - CHECK FOR MORE OP ENDS AND HANDLE IF THERE ARE * 00890000
* SOME, OTHERWISE GO AND RESCHEDULE LINE. * 00900000
* * 00910000
* ENTRY POINT-- * 00920000
* CMBOPE * 00930000
* * 00940000
* INPUT-- * 00950000
* OUTPUT-- * 00960000
* #OPEND - ADJUSTED FOR OP ENDS HANDLED. * 00970000
* CMSLCB - ADDRESS OF DTF HANDLED FOR LAST OP END. * 00980000
* CMSPL - ADDRESS TO TP PARAMETER LIST FOR LAST OP END. * 00990000
* TCBINQ - QUEUE OF INVITES THAT HAVE COMPLETED. * 01000000
* * 01010000
* EXTERNAL REFERENCES-- * 01020000
* $CC4BQ - BSCA STOP II QUEUE ANALYSIS TRANSIENT. * 01030000
* $CC4TT - CCP TRACE ROUTINE. * 01040000
* $CC4BE - BSCA ERP TRANSIENT. * 01050000
* $CC4BR - BSCA REJECT TRANSIENT. * 01060000
* $CC4B5 - 3735 SENSE/STATUS TRANSIENT. * 01070000
* $CC4BA - 3270 SENSE/STATUS TRANSIENT. * 01080000
* $CC4JE - TRANSLATE ASCII TO EBCDIC * 01090000
* $CC4B0 - 3270 INPUT FORMAT TRANSIENT. * 01100000
* $CC4BB - BSCA RECORD BLANK TRANSIENT. * 01110000
* CMBSKP - BSCA SKIP BIT ON/OFF ROUTINE. * 01120000
* CMGINL - INPUT RECORD LENGTH ROUTINE. * 01130000
* CMFMRT - FREEMAIN ROUTINE. * 01140000
* CMGMRT - GETMAIN ROUTINE. * 01150000
* CMPSRQ - POST TP SCHEDULED ROUTINE. * 01160000
* CMPOST - POST OP END FOR READ OR PUT NO WAIT * 01170000
* CMPWGY - OP END FOR PUT PART OF PUT THEN GET. * 01180000
* * 01190000
* EXIT, NORMAL-- * 01200000
* TO CMBSCH TO RESCHEDULE THE LINE * 01210000
* * 01220000
*********************************************************************** 01230000
SPACE 4 01240000
CMBOPE EQU * * B 01250000
TBN $FLGC,#NTRAC NO TRACE AND - 01251000
CLI $BDCMP(,DTF),$BCNEG * 44 COMP CODE ? 01252000
JC CMTRAC,TRUAEQ YES- CONTINUE 01253000
SBF $FLGC,#NTRAC NO-SET OFF NO TRACE IND 01254000
CMTRAC EQU * * 01255000
SPACE 1 01260000
* TRACE THE OP END COMPLETION CODE. B 01270000
SPACE 01280000
B CMTRCE CALL TRACE. B 01290000
DC AL1(CCPRIB) CCP RIB B 01300000
DC AL1(TRRIB) TRACE SUBRIB B 01310000
DC AL1(TTMOPN) TRACE OP END STATUS. B 01320000
SPACE 1 01330000
AIF (&N32).D0018 01330100
* -----------START------------------------@16 01330200
L LCBPL@(,DTF),PL XR1--> PARM LIST B 01330300
ST CMSPL,PL SAVE THE PARM LIST REG. @20 01330350
L PLTUBA(,PL),XR1 XR1 -> TUB. B 01330400
TBN LCBAT3(,DTF),LCBSTS STATUS POLL CURRENT OP - B 01330500
CLI TUBPHY(,XR1),TUB5M2 * AND 3270 TYPE TERMINAL ? B 01330700
JC CMRSEN,FLSOHI NO - PROCESS THE OP END. B 01330800
L $BDWKB(,DTF),XR1 XR1 -> RECORD AREA. B 01330900
AIF (&NAS).D0016 01331000
TBN $BDATT(,DTF),$BCASK TEST FOR A ASCII LINE 7AB 01331100
JF CMNOAS NO,TAKE THE JUMP 7AB 01331200
CLC SNSTAS(2,XR1),CMSTAS STATUS MESSAGE RECEIVED ? 7AB 01331300
J CMYSAS CONTINUE WITH STATUS CHECK 7AB 01331400
CMNOAS EQU * * LOCAL 7AB 01331500
.D0016 ANOP 01331600
CLC SNSTAS(2,XR1),CMSTUS STATUS MESSAGE RECEIVED ? B 01331700
CMYSAS EQU * @20 01331720
L LCBPL@(,DTF),PL XR1--> PARAMETER LIST @20 01331740
BNE CMBYNS NO - GO CALL $CC4BE @20 01331760
* -----------END--------------------------@16 01332400
.D0018 ANOP 01332500
CMRSEN EQU * 01333000
SBF LCBAT3(,DTF),LCBSTS SET OFF STATUS POLL OP. @20 01333200
CLI $BDCMP(,DTF),CPURGE IS PURGE OPERATION COMPLETE 01333500
JNE CMRSEP NO, CHECK OP END 01334000
L $BDWKA(,DTF),WKA POINT TO BSCA WORK AREA 01334500
SBF ACKSD(,WKA),AKERR SET OFF MLMP ERROR INDICATOR 01335000
CMRSEP EQU * LOCAL 01335500
L LCBPL@(,DTF),PL XR1--> PARM LIST 01336000
AIF (&NTTSK).TT010 01336030
SPACE 1 01336060
******************************************************************* @18 01336090
************* 01336120
************* 01336150
CLI $BDDEV(,DTF),X'60' IS THIS TASK-TO-TASK ? 01336180
BE CMSBFL YES - GO TO READ OP END HANDLING 01336210
************* 01336240
************* 01336270
******************************************************************* @18 01336300
SPACE 1 01336330
.TT010 ANOP 01336360
* -----------START--------------------@06-@02 01336500
TBN PL$OPM(,PL),OPPUT PUT IN PROCESS ? B 01337000
JT CMCABT YES - LEAVE ON RVI MASK. B 01337500
SBF LCBOPC(,DTF),LCBRVI SET OFF SEND RVI INDICATOR. B 01338000
CMCABT EQU * * LOCAL B 01338500
* -----------END----------------------@06-@02 01339000
TBN LCBAT2(,DTF),LCBABT LINE ABORT IN PROCESS ? B 01340000
JF CMSTPX NO-GO CHECK FOR STOP RECEIVE . B 01350000
SPACE 1 01360000
******************************************************************* B 01370000
* ABORT IN PROCESS * B 01380000
******************************************************************* B 01390000
SPACE 1 01400000
TBN LCBOPC(,DTF),OPPUT ABORT OF A PUT OPERATION ? B 01410000
JF CMRABT NO - MUST BE READ ABORT B 01420000
SPACE 1 01430000
* ABORT OF A PUT B 01440000
SPACE 1 01450000
L $BDWKA(,DTF),WKA POINT TO BSCA WORK AREA. B 01455000
SBF ACKSD(,WKA),AKERR SET OFF MLMP ERROR IND. B 01460000
J CMRNAR GO RESCHEDULE THE LINE. B 01475000
SPACE 1 01480000
* ABORT OF A READ B 01490000
SPACE 1 01500000
CMRABT EQU * * LOCAL B 01510000
CLI $BDCMP(,DTF),$BCDNE CCP PURGE COMPLETE ? B 01520000
BE CMPBMP NO-GO BUMP TO NEXT BLOCK. B 01530000
L $BDWKA(,DTF),WKA POINT TO BSCA WORK AREA. B 01540000
SBF BSFLGD(,WKA),FWDABT SET OFF FORWARD ABORT. B 01550000
CMRNAR EQU * * LOCAL B 01555000
SLC LCBAT2(2,DTF),LCBAT2(,DTF) CLEAR LCBAT1 AND LCBAT2. B 01560000
B CMBSCH GO TO RESCHEDULE THE LINE. B 01570000
SPACE 2 01580000
CMSTPX EQU * * LOCAL B 01590000
TBN LCBAT1(,DTF),LCBCRI STOP INVITE REQUESTED ? B 01600000
JF CMBCMP NO-GO HANDLE THE OP END. B 01610000
SPACE 1 01620000
******************************************************************* B 01630000
* STOP INVITE * B 01640000
******************************************************************* B 01650000
SPACE 1 01660000
&MIX SETA &NSWL+&NCS 01670000
AIF (&MIX EQ '2').S0200 01680000
USING CMBSKP,XR1 01690000
LA CMBSKP,XR1 LOAD @ OF POLL SKIP BIT RTN.C/SB 01700000
MVI CMB#SB(,XR1),SBN1 SET OP: SET SKIP BIT ON. C/SB 01710000
.S0200 SVC 0 #### TRANSIENT CALL ##### B 01720000
DC AL1(CCPRIB) CCP SVC RIB B 01730000
DC AL1(CC4BQ) * B 01740000
SPACE 01750000
* $CC4BQ RETURNS CONTROL TO: B 01760000
* NSI, IF LINE IS STOPPED SUCCESSFULLY. B 01770000
* NSI+4, IF STOP FAILED, BUT CONTINUE OP END HANDLING. B 01780000
* NSI+7, IF STOP FAILED, AND ABORT IS REQUIRED. 01790000
SPACE 01800000
B CMBSCH LINE STOPPED, RESCHEDULE WORK. B 01810000
J CMBCMP NOT STOPPED, HANDLE THE OP END.B 01820000
B CMBSTP NOT STOPPED, ABORT THE LINE. B 01830000
SPACE 3 01840000
********************************************************************* B 01850000
* COMPLETION CODE ANALYSIS FOR BSCA * B 01860000
********************************************************************* B 01870000
SPACE 01880000
CMBCMP EQU * * LOCAL B 01890000
ST CMSPL,PL SAVE THE PARM LIST REG. B 01900000
CLI $BDCMP(,DTF),$BCDNE SUCCESSFUL DATA ? B 01910000
JE CMBSCS YES-GO HANDLE IT. B 01920000
CLI $BDCMP(,DTF),$BCEOT EOT RECEIVED, AND B 01930000
TBF LCBAT2(,DTF),LCBRCI * NOT RECEIVE INITIAL ? B 01940000
JC CMBSCS,TRUAEQ YES-GO HANDLE THE EOT. B 01950000
JNE CMBERR NOT EOT-GO TO ERP TRANSIENT. B 01960000
TBF LCBAT1(,DTF),LCBCRI+LCBPRI EOT TO CANCEL REQUEST ? B 01970000
JF CMBSCS YES-EOT IS OK THEN. B 01980000
SPACE 1 01990000
* EOT TO RECEIVE INITIAL IS INVALID. B 02000000
SPACE 1 02010000
CMBERR EQU * * LOCAL B 02020000
SPACE 1 02030000
AIF (&NINT).CT010 02040000
* INSTITUTE INTERVAL TIMER POLLING IF APPLICABLE NB 02050000
SPACE 1 02060000
CLI $BDCMP(,DTF),$BCNEG 44 COMPLETION CODE NB 02070000
TBN $BDATT(,DTF),$BCINP AND POLLING ? NB 02080000
JC CMBSER,FLSNEQ NO-CALL TRANSIENT NB 02090000
SPACE 1 02100000
L PLTUBA(,PL),XR2 XR2--> TUB NB 02110000
CLI TUBPHY(,XR2),TUB375 3735'S ? NB 02120000
L TUBDTF(,DTF),XR2 XR2-->DTF NB 02130000
JE CMBSER YES-CALL TRANSIENT NB 02140000
SPACE 1 02150000
******************************************************************* NB 02160000
* NO RESPONSE TO POLL OF 3270S * NB 02170000
******************************************************************* NB 02180000
SPACE 02190000
* CLEAN UP THE LCB AND TUB NB 02200000
SPACE 1 02210000
SLC LCBAT2(2,DTF),LCBAT2(,DTF) SET OFF LCB ATTRIBUTES NB 02220000
L PLTUBA(,PL),XR2 XR2-->TUB NB 02230000
SBF TUBAT2(,XR2),TUBOWN RESET TUB OWNERSHIP NB 02240000
SBN $FLGC,#NTRAC IND NO TRACING TO BE DONE 02245000
SPACE 1 02250000
* SET UP THE INTERVAL TIMER FOR A WAIT NB 02260000
SPACE 1 02270000
LA TIMIOB,XR2 XR2-->TIMER IOB NB 02280000
MVI TIFLAG(,XR2),ALLBIT SET TO CANCEL REMAINING TIME NB 02290000
SVC 0 * NB 02300000
DC AL1(TTMRIB) RETURN TIME REMAINING NB 02310000
SPACE 1 02320000
TBN TIMOPE,VALOPE OP END SINCE LAST HERE? NB 02330000
SBF TIMOPE,VALOPE RESET IT NB 02340000
JT ST1MIN YES-GO PUT 1 MIN. IN THE IOB NB 02350000
SPACE 1 02360000
TBN TIMOPE,POL1MN POLLING FROM A MINUTE AND- NB 02370000
CLC TITIME(4,XR2),ZROTIM TIME ZERO ? NB 02380000
SBF TIMOPE,POL1MN SET OFF INDICATER NB 02390000
JC SETIND,TRUNEQ NO-GO SET 'POLL FOR A MIN.' NB 02400000
SPACE 1 02440000
MVC TITIME(3,XR2),WATIME MAKE IT TIME SPECIFIED NB 02450000
USETIM EQU * * NB 02460000
MVI TIFLAG(,XR2),X'02' INTERRUPT WHEN TIME EXPIRED NB 02470000
SBF TIMIOB+7,ALLBIT SET TO POST ON TIMER OP END NB 02475000
SVC 0 * NB 02480000
DC AL1(STMRIB) START TIMER RUNNING NB 02490000
SPACE 1 02500000
* INDICATE THAT A WAIT ON THE INTERVAL TIMER HAS STARTED SO NB 02510000
* THAT CM WILL RESCHEDULE THE LINE WHEN NEXT ENTERED NB 02520000
SPACE 1 02530000
L CMSDTF,XR2 XR2-->CURRENT DTF NB 02540000
SBN LCBATR(,DTF),LCBTIM SET IND. IN LCB NB 02550000
SPACE 1 02560000
B $CC4CM GO ISSUE THE WAIT NB 02580000
SPACE 1 02590000
ST1MIN EQU * * LOCAL NB 02600000
MVC TITIME(4,XR2),PLTIME PUT POLL TIME IN TIME IOB NB 02610000
SPACE 1 02620000
SETIND EQU * * LOCAL NB 02630000
SBN TIMOPE,POL1MN SET IND.'POLL FOR A MINUTE' NB 02640000
SPACE 1 02650000
AIF (&NPBY).NBY03 BUSY PRINTER SUPPORT? NB 02650800
* ------------------------------START--------------------------@09 02651600
L CMSDTF,DTF RELOAD DTF REGISTER. NB 02652400
TBN LCBAT3(,DTF),LCBBYP BUSY PRINTER IN QUEUE? 02653200
JF CMNPR1 NO - DON'T BOTHER TO CLEANUP 02654000
SVC 0 #### TRANSIENT CALL #### NB 02654800
DC AL1(CCPRIB) CCP SVC RIB NB 02655600
DC AL1(CC4BG) BUSY PRINTER CLEANUP XSIENT. NB 02656400
CMNPR1 EQU * * LOCAL 02657200
* ------------------------------END----------------------------@09 02658000
.NBY03 ANOP * 02658800
B CMBSCH GO RESCHEDULE THE LINE NB 02660000
SPACE 1 02670000
* HAVE BSCA ERROR (DETECTED BY MLMP), CALL BSCA ERROR TRANSIENT B 02680000
SPACE 1 02690000
CMBSER EQU * * B 02700000
SBF $FLGC,#NTRAC INDICATE TRACE TO RESUME 02705000
SBN TIMOPE,VALOPE IND. OP END TO TIMER CODE NB 02710000
.CT010 ANOP 02720000
AIF (&NPBY).NBY04 BUSY PRINTER SUPPORT? 02720500
AIF (&NINT EQ '0').NBY04 SKIP IF INTERVAL POLLING. 02721000
* ------------------------------START--------------------------@09 02721500
CLI $BDCMP(,DTF),$BCNEG * 44 COMP CODE? 02722000
TBN $BDATT(,DTF),$BCINP AND POLLING? 02722500
JC CMBER1,FLSNEQ NO - CALL ERROR TRANSIENT. 02723000
TBN LCBAT3(,DTF),LCBBYP BUSY PRINTER IN QUEUE? 02723500
JF CMBER1 NO - CALL ERROR TRANSIENT. 02724000
SVC 0 #### TRANSIENT CALL #### 02724500
DC AL1(CCPRIB) CCP SVC RIB 02725000
DC AL1(CC4BG) BUSY PRINTER CLEANUP TRANSIENT. 02725500
B CMBSCH GO RESCHEDULE WORK ON THE LINE.B 02726000
CMBER1 EQU * * LOCAL 02726500
* ------------------------------END----------------------------@09 02727000
.NBY04 ANOP 02727500
CMBYNS EQU * * LOCAL B 02728000
SVC 0 #### TRANSIENT CALL ##### B 02730000
DC AL1(CCPRIB) CCP SVC RIB B 02740000
DC AL1(CC4BE) ERROR DETERMINATION TRANSIENT. B 02750000
SPACE 1 02760000
* $CC4BE RETURNS CONTROL TO B 02770000
* NSI, POST COMPLETE AND RESCHEDULE LINE (HARD ERROR, NO DATA, B 02780000
* JUST LET USER KNOW AND FORGET IT). ALSO USED IF ERROR ON B 02790000
* SYSTEM READ AND NEED TO BYPASS NORMAL ERP. B 02800000
* NSI+4, TO ONLY RESCHEDULE THE LINE (TUB IN ERP, PL @ SAVED, B 02810000
* OPERATION MAY BE RETRIED SO DON'T FREE OR POST.) B 02820000
* NSI+8, TO ANALYZE OP END AS IF NO ERROR. ALSO FOR AUTOMATIC B 02830000
* BYPASS OF NORMAL ERP IF SYSTEM PUT THAT CANNOT BE PUT B 02840000
* INTO ERP OPERATOR WAIT. B 02850000
SPACE 1 02860000
B CMRETC SET UP TO RETURN TO USER. B 02870000
SPACE 02880000
B CMBSCH GO RESCHEDULE WORK ON THE LINE.B 02890000
EJECT 02900000
******************************************************************* B 02910000
* OP COMPLETED SUCCESSFULLY * B 02920000
* DETEMINE WHAT KIND OF OPERATION IT WAS AND HANDLE IT ACCORDINGLY* B 02930000
******************************************************************* B 02940000
SPACE 1 02950000
CMBSCS EQU * * LOCAL * B 02960000
AIF (&NINT).CT020 02970000
SBN TIMOPE,VALOPE IND. OP END TO TIMER CODE 02980000
SBF $FLGC,#NTRAC INDICATE TRACE TO RESUME @28 02985000
.CT020 ANOP 02990000
TBF LCBOPC(,DTF),LCBERP IF NOT WAITING FOR EOT TO B 03000000
* * STATUS MESSAGE.(IF ON PL$OPM B 03010000
* * IS NOT ORIG OP,IT IS A INV.) B 03020000
TBN PL$OPM(,PL),OPPUT WAS IT WRITE B 03030000
BT CMWEND BRANCH IF WRITE B 03040000
$CC4CM TITLE '$E072/CMREND---READ-OP-END-HANDLER' 03050000
******************************************************************** B 03060000
* BSCA READ OP END HANDLER * B 03070000
******************************************************************** B 03080000
SPACE 03090000
* CHECK FOR SEARCH EOT OPERATION. IF SEARCH FOR EOT, AND EOT IS NOT B 03100000
* FOUND, CONTINUE SEARCH. IF EOT WAS FOUND, THEN DETERMINE B 03110000
* IF PARM LIST MUST BE DEQ'D. IF EOT IS FOUND FOR GET-MSG, B 03120000
* GO TO GET-MSG EOT PROCESSING LOGIC. B 03130000
SPACE 03140000
TBN LCBAT1(,DTF),LCBEOT SEARCH FOR EOT ON LINE ? B 03150000
JF CMPSAV NO-GO CHECK COMPLETION CODE. B 03160000
CLI $BDCMP(,DTF),$BCEOT EOT FOUND ? B 03170000
JNE CMPBKL NO-GO UPDATE BLK LEN TO NXT BLKB 03180000
&MIX SETA &N32+&N37+&N41 03183000
AIF (&MIX EQ '3').T1000 03186000
TBN PLOPM(,PL),OPSTOP STOP INVITE AND 0/5/7B 03190000
TBN PL$OPC(,PL),OPLSNS * POLL FOR STATUS ? 0/5/7B 03200000
JF CMCKDQ NO - GO CHECK FOR DEQUEUE 0/5/7B 03210000
SBN LCBAT1(,DTF),LCBDEQ SET TO DEQUEUE 0/5/7B 03220000
SBN LCBOPC(,DTF),LCBERP SET SEARCH FOR EOT TO 0/5/7B 03230000
* * TO INSURE DEQUEUE. 0/5/7B 03240000
SBN CMSWIT,CMSPSI SET INTERNAL IND. ON 0/5/7B 03250000
MVI PL$RTC(,PL),RCXSPI MOVE IN STOPPED RTN CODE. 0/5/7B 03260000
CMCKDQ EQU * * LOCAL 0/5/7B 03270000
.T1000 ANOP 03275000
SPACE 1 03280000
*----------------------------------------------------------------* B 03290000
* EOT FOUND DURING SEARCH FOR EOT * B 03300000
*----------------------------------------------------------------* B 03310000
SPACE 1 03320000
TBN LCBAT1(,DTF),LCBDEQ DEQUE WHEN EOT FOUND ? B 03330000
SLC LCBAT2(2,DTF),LCBAT2(,DTF) CLEAR LCBAT1 AND LCBAT2. B 03340000
L PLTUBA(,PL),XR2 LOAD REG TO THE TUB. B 03350000
SBF TUBAT2(,XR2),TUBOWN SET OFF TUB OWN INDICATOR. B 03360000
BF CMREDO DON'T DEQ-GO RESCHEDULE LINE. B 03370000
TBN PL$OPC(,PL),OPGET GET OP BEING HANDLED ? B 03380000
JF CMRERP NO-GO CHECK FOR ERP. B 03390000
SBF TUBAT2(,XR2),TUBIIS SET OFF INVITE SCHEDULED. B 03400000
TBN TUBAT2(,XR2),TUBDTA+TUBCMD DME ? B 03410000
JF CMRERP IF NOT DME, CAN REUSE LINE BUF.B 03420000
L TUBDTF(,XR2),DTF DTF ADDRESS B 03430000
MVI LCBIBA-1(,DTF),NOBIT IF DME - ASSIGN BUFF TO PL B 03440000
L PLTUBA(,PL),XR2 TUB ADDRESS B 03450000
CMRERP EQU * * LOCAL B 03460000
CLI TUBAT2(,XR2),TUBDTA+TUBCMD DATA MODE ESCAPE RECOGNIZED ? B 03470000
L TUBDTF(,XR2),DTF POINT TO THE DTF. B 03480000
TBF LCBOPC(,DTF),LCBERP SEARCHING FOR EOT TO STATUS MSGB 03490000
BC CMBDEQ,FLSNLO ERP/DME-GO DEQ THE REQUEST. B 03500000
J CMREXT GO TO EXIT FROM READ OP END. B 03510000
SPACE 03520000
*----------------------------------------------------------------* B 03530000
* EOT NOT FOUND DURING SEARCH FOR EOT * B 03540000
*----------------------------------------------------------------* B 03550000
SPACE 03560000
CMPBKL EQU * * LOCAL B 03570000
&MIX SETA &NMSG+&NTTSK+&NAPOR 03573000
AIF (&MIX EQ '3').E0300 03576000
TBN SAVTA2,TASMSG * GET MSG MODE ? GB 03590000
JF CMPBMP NO-GO TO BUMP BKX FOR NXT BLK GB 03600000
SPACE 1 03610000
* IF GET-MSG THEN SET DATA TRUNCATED INDICATOR BEFORE CONTINUING GB 03620000
* TO SEARCH GB 03630000
SBN PL$RTC(,PL),RCXDTR SET DATA TRUNCATED RET CODE GB 03640000
.E0300 ANOP 03650000
CMPBMP EQU * * B 03660000
ALC $BDBKX(2,DTF),$BDBKL(,DTF) UPDATE BLK PTR TO GET NEXT BLKB 03670000
B CMFORB GO FORM NEXT OP ON THE LINE. B 03680000
SPACE 3 03690000
*----------------------------------------------------------------* B 03700000
* NOT SEARCH FOR EOT * B 03710000
*----------------------------------------------------------------* B 03720000
SPACE 1 03730000
CMPSAV EQU * * LOCAL B 03740000
MVC PL$RTC(1,PL),$BDCMP(,DTF) SAVE THE COMPLETION CODE. B 03750000
SBF PL$RTC(,PL),BIT1 SET OFF X'40' IN RETURN CODE. B 03760000
SPACE 1 03770000
* HAVE A SUCCESSFUL READ OPERATION. B 03780000
* CHECK FOR RECEIVE INITIAL AND DATA RETURNED. IF YES, CHECK FOR B 03790000
* CONFLICTING REQUESTS IN THE BSCA LINE QUEUE. B 03800000
* IF NOT RECEIVE INITIAL AND DATA IS RETURNED, GO HANDLE THE DATA B 03810000
* ONLY SITUATION. B 03820000
* IF EOT WAS RECEIVED FOR CANCEL RECEIVE INITIAL OPERATION, THEN B 03830000
* CHECK WHETHER PRIORITY CANCEL OR STOP POLLING REQUEST. B 03840000
* OTHERWISE EOT WAS RECEIVED FOR DATA. CHECK FOR MESSAGE MODE B 03850000
* PROCESSING. IF GET-MSG, CLEAN UP THE OPERATION. B 03860000
SPACE 03870000
TBF PL$RTC(,PL),$BCEOT-BIT1 DATA RECEIVED FOR A B 03880000
TBN LCBAT2(,DTF),LCBRCI RECEIVE INITIAL ON THE LINE ? B 03890000
SBF LCBAT2(,DTF),LCBRCI+LCBPUT SET OFF RCVI AND PUT IND'S. B 03900000
JT CMREJC YES-DATA HIT, CHECK CONFLICTS. B 03910000
L PLTUBA(,PL),TUB LOAD TUB REG. B 03920000
CLI $BDCMP(,DTF),$BCEOT EOT RECEIVED ? B 03930000
BNE CMB327 NOT EOT, DATA FOR NON-RCVI. B 03940000
SPACE 1 03950000
*----------------------------------------------------------------* B 03960000
* EOT RECEIVED - NO DATA * B 03970000
*----------------------------------------------------------------* B 03980000
SPACE 1 03990000
TBN LCBAT1(,DTF),LCBPRI PRIORITY CANCEL REQUESTED ? B 04000000
SLC LCBAT2(2,DTF),LCBAT2(,DTF) CLEAR LCBAT1 AND LCBAT2. B 04010000
SBF TUBAT2(,TUB),TUBOWN SET OFF TUB OWN INDICATOR. B 04020000
JF CMNRX1 NOT PROIRITY CANCEL JUMP B 04023000
MVC LCBLID(1,DTF),$BDIND(,DTF) SAVE LAST POLLED TERM ID B 04026000
B CMBSCH RESCHEDULE IF EOT TO PRI. B 04030000
CMNRX1 EQU * * LOCAL 04035000
SBF TUBAT2(,TUB),TUBIIS SET OFF INPUT SCHEDULED. B 04040000
SPACE 04050000
******************************************************************** B 04060000
* COMMON EOT HANDLING CODE * B 04070000
******************************************************************** B 04080000
SPACE 1 04090000
CMREXT EQU * * LOCAL B 04100000
L LCBPL@(,DTF),PL POINT TO THE PARM LIST B 04110000
AIF (&NRUF).F0100 04110800
SPACE 04112400
* IF RUF PGM REQUEST, HANDLE LIKE A USER GET-MSG OPERATION. WB 04113200
SPACE 04114000
L PLTUBA(,PL),XR2 XR2-> TUB. WB 04114800
TBN TUBSCS(,XR2),TUBRUF RUF ON THE SCREEN ? WB 04115600
L TUBDTF(,XR2),DTF XR2-> LCB(DTF). WB 04116400
JT CMRGOM YES-GO HANDLE AS USER GET-MSG.WB 04117200
.F0100 ANOP 04118800
CLI PLOPM(,PL),OP$SYS USER REQUEST, AND B 04120000
&MIX SETA &NMSG+&NTTSK+&NAPOR 04123000
AIF (&MIX EQ '3').E0350 04126000
TBN SAVTA2,TASMSG GET-MSG MODE ? GB 04140000
JC CMRGOM,TRUALO YES-GO HANDLE GET-MESSAGE. GB 04150000
.E0350 ANOP 04160000
BNL CMBDEQ IF SYSTEM INVITE, PASS RECA B 04170000
* * TO $CC4CP ALWAYS. B 04180000
SPACE 1 04190000
* USER INPUT OP -- EOT AND NOT MESSAGE MODE - NO HOLD BUFFER B 04200000
SPACE 1 04210000
SLC PLEFFL(2,PL),PLEFFL(,PL) ZERO EFFL. SO II WON'T FREE B 04220000
L PLTUBA(,PL),XR2 POINT TO THE TUB. B 04230000
MVI PLRECA-1(,PL),NOBIT MAKE SURE PLRECA 0,NO BUFFER B 04240000
L TUBDTF(,XR2),DTF POINT TO THE DTF. B 04250000
B CMBDEQ GO DEQUE THIS REQUEST. B 04260000
&MIX SETA &NMSG+&NTTSK+&NAPOR 04263000
AIF (&MIX EQ '3').E0400 04266000
SPACE 04280000
* USER GET-MSG -- EOT RECEIVED. RESTORE PARM LIST GB 04290000
* RECORD ADDRESS AND IN LENGTH, AND THE DTF RECORD LENGTH. GB 04300000
* THEN GO DIRECTLY TO TEST FOR TRANSLATION. GB 04310000
SPACE 04320000
CMRGOM EQU * * LOCAL GB 04330000
MVC PLRECA(4,PL),LCBMR@(,DTF) RESTORE RECA AND INL. GB 04340000
CLI PL$RTC(,PL),RCXCLR CLEAR RETURN CODE GOING BACK ?GB 04350000
JNE CMGWOC NO - RETURN DATA GB 04360000
* GET MSG WITH CLEAR KEY RESPONSE. GB 04370000
MVI LCBIBA-1(,DTF),NOBIT BUFFER NO LONGER IS FOR LINE. GB 04380000
B CMBDEQ GO DEQUEUE GB 04390000
CMGWOC EQU * * LOCAL 04400000
SBF PL$RTC(,PL),$BCEOT SET OFF EOT R.C. FOR GET-MSG. GB 04410000
MVC $BDREL(2,DTF),LCBMRL(,DTF) RESTORE THE DTF RECORD LEN. GB 04420000
B CMRBMV GO TO CHECK FOR XLATE. GB 04430000
SPACE 04440000
.E0400 ANOP 04450000
EJECT 04460000
******************************************************************** B 04470000
* DATA RECEIVED FOR RECEIVE INITIAL * B 04480000
******************************************************************** B 04490000
SPACE 1 B 04500000
* IF THE TASK THAT THIS REQUEST IS FOR HAS A WAIT TYPE OP OR A B 04510000
* PUT NO WAIT BLOCK OR RECORD ON THE LINE QUEUE, THEN HE ISNT B 04520000
* WAITING FOR THIS OP END. REJECT THAT OP ON THE LINE QUEUE SO B 04530000
* HE CAN RECEIVE THIS DATA AND WE CAN FREE THE HOLD BUFFER. B 04540000
SPACE 1 04550000
* REMOVE CONFLICTING ACCEPTED REQUESTS. ONLY INVITES AND/OR B 04560000
* PUT-NO-WAITS-MESSAGE REQUESTS MAY STAY IN THE QUEUE. BECAUSE OF B 04570000
* BSCA LINE HANDLING, AT OP END TIME NO MORE THAN ONE GET OR PUT B 04580000
* FOR RECORD, BLOCK, MESSAGE, OR PUT-NO-WAIT FOR RECORD OR BLOCK B 04590000
* COULD BE IN THE LINE QUEUE AND THEREFORE HAVE TO BE REMOVED. B 04600000
SPACE 04610000
CMREJC EQU * * LOCAL B 04620000
AIF (&MIN).N0100 04630000
L LCBPL@(,DTF),PL RELOAD THE PL REG. RB 04640000
SPACE 04650000
* SAVE PARM LIST AND DTF DATA ADDR'S AND LENGTHS. THEY WILL BE RB 04660000
*USED ONLY BY GET-MESSAGE PROCESSING. RB 04670000
SPACE 04680000
&MIX SETA &NMSG+&NTTSK+&NAPOR 04683000
AIF (&MIX EQ '3').E0600 04686000
MVC LCBMR@(4,DTF),PLRECA(,PL) SAVE RECORD ADDR AND LENGTH. RGB 04700000
SLC LCBMRL(2,DTF),LCBMRL(,DTF) ZERO OUT INCREMENT REC LGTH.RGB 04710000
.E0600 ANOP 04720000
SBF LCBAT1(,DTF),LCBPRI SET OFF PRIORITY CANCEL IND. RB 04730000
MVC CMIIND,LCBOWN(2,DTF) SAVE TCB @ OF OWNER. RB 04740000
TBF PL$OPC(,PL),OPLSNS+OPRFSH POLL FOR STATUS,OR REFRESH OR RB 04750000
TBF SAVTA2,TASMSG * GET-MESSAGE MODE RB 04760000
JF CMRECX YES-GO READY FOR RECORD CHECK.RB 04770000
LA LCBPLQ-1(,DTF),PL LOAD REG. TO DTF PL QUEUE. RB 04780000
CMREQR EQU * * LOCAL RB 04790000
CLC PLCHN(2,PL),CMSPL NEXT PL SAME AS OP ENDED ? RB 04800000
L PLCHN(,PL),PL LOAD REG TO NEXT PARM LIST. RB 04810000
JE CMRZRO YES-SKIP IT, CHECK FOR ANOTHERRB 04820000
L PLTUBA(,PL),XR2 LOAD WORK REG WITH TUB @. RB 04830000
CLC CMIIND,TUBTCB(2,XR2) THIS TUB FOR SAME OWNER ? RB 04840000
JNE CMRZRO NO-GO CHECK FOR ANOTHER. RB 04850000
TBN PLOPC(,PL),OPNOW NO WAIT OPERATION ? RB 04860000
JF CMRCAN NO-GO CANCEL ANY WAIT OP'S. RB 04870000
TBN PLOPC(,PL),OPINV THIS AN INVITE INPUT ? RB 04880000
JT CMRZRO YES-GO CHECK FOR ANOTHER. RB 04890000
TBN PLOPM(,PL),OP$SYS SYSTEM REQUEST ? RB 04900000
JT CMRZRO YES-TREAT AS PUT-MSG/NOWAIT. RB 04910000
TBN PLOPC(,PL),OPMSG PUT/MSG REQUEST ? RB 04920000
JT CMRZRO YES - OK TO KEEP RB 04930000
SPACE 04940000
* REJECT THIS OP SO TASK CAN ACCEPT THE DATA RECEIVED FOR HIM RB 04950000
SPACE 1 04960000
CMRCAN EQU * * LOCAL RB 04970000
SVC 0 #### TRANSIENT CALL ##### RB 04980000
DC AL1(CCPRIB) CCP SVC RIB RB 04990000
DC AL1(CC4BR) * BSCA OP REJECT TRANSIENT RB 05000000
J CMRECX GO CHECK THE RECORD AREA. RB 05010000
SPACE 05020000
CMRZRO EQU * * LOCAL RB 05030000
CLI PLCHN-1(,PL),NOBIT ANOTHER PARM LIST IN CHAIN ? RB 05040000
BNE CMREQR YES-GO CHECK FOR REQUEST REJ RB 05050000
L CMSDTF,DTF RELOAD THE DTF REG. RB 05060000
L LCBPL@(,DTF),PL RELOAD THE PL REG. RB 05070000
CMRECX EQU * * LOCAL RB 05080000
AGO .C0145 05090000
.N0100 ANOP 05100000
B CMREJT CALL REJT LOGIC IN$CC4B1. MIN B 05110000
.C0145 ANOP 05120000
L PLTUBA(,PL),TUB POINT TO THE TUB. B 05130000
EJECT 05140000
********************************************************************* B 05150000
* DATA RECEIVED FOR NON-RECEIVE INITIAL (ALSO EXECUTED FOR RECV INT* B 05160000
********************************************************************* B 05170000
SPACE 1 05180000
CMB327 EQU * * LOCAL 05190000
AIF (&N32).T0010 05200000
TBN TUBSCS(,TUB),TUBCLR CLEAR KEY HIT ? 0B 05210000
SBF TUBSCS(,TUB),TUBCLR SET OFF CLEAR KEY HIT. 0B 05220000
AIF (&NDME).D0300 05230000
JT CMRCRC YES-GO SET CLEAR RETURN CODE.0DB 05240000
AGO .T0010 05250000
.D0300 ANOP 05260000
JF CMR327 NO-GO CHECK TERMINAL TYPE. 0B 05270000
.T0010 ANOP 05280000
AIF (&NDME).D0500 05290000
TBF TUBSCS(,TUB),TUBDME+TUBDMF DME HANDLED BY INQUIRY XIENT DB 05300000
JT CMR327 NO-GO TO CHECK FOR 3270. DB 05310000
AIF (&N32).D0400 05320000
TBN TUBSCS(,TUB),TUBDMF DME FAILED ? 0DB 05330000
.D0400 ANOP 05340000
SBF TUBSCS(,TUB),TUBDME+TUBDMF RESET THE DME INDICATORS. DB 05350000
AIF (&N32).D0500 05360000
JF CMREOT NO-GO SET SEARCH FOR EOT. 0DB 05370000
* DATA MODE ESCAPE FAILED. 05380000
.D0500 ANOP 05390000
AIF (&N32).D0600 05400000
* CLEAR KEY. 05410000
CMRCRC EQU * * LOCAL 0B 05420000
L LCBPL@(,DTF),PL POINT TO THE PARM LIST. 0B 05430000
MVI PL$RTC(,PL),RCXCLR SET CLEAR RETURN CODE. 0B 05440000
.D0600 ANOP 05450000
&MIX SETA &N32+&NDME 05460000
AIF (&MIX EQ '2').D0700 05470000
CMREOT EQU * * LOCAL 0/DB 05480000
SBN LCBAT1(,DTF),LCBEOT+LCBDEQ SET SEARCH EOT AND THEN DEQ0/DB 05490000
B CMFORB GO FORM THE OPERATION. 0/DB 05500000
SPACE 1 05510000
CMR327 EQU * * LOCAL 0/DB 05520000
.D0700 ANOP 05530000
&MIX SETA &N32+&N37 05540000
AIF (&MIX EQ '2').A0020 05550000
CLI TUBPHY(,TUB),TUB375 THIS A 3270 OR 3735 ? 0/5B 05560000
.A0020 ANOP 05560500
AIF (&N41).N4101 05561000
TBN TUBPHY(,TUB),TUB374 THIS A 3741 7B 05563000
TBF TUBPHY(,TUB),ALLBIT-TUB374 THIS A 3741 7B 05564000
.N4101 ANOP 05566000
&MIX SETA &N32+&N37+&N41 05567000
AIF (&MIX EQ '3').T0015 05568000
L $BDWKB(,DTF),XR1 POINT TO LOGICAL DATA AREA 0/57B 05570000
.T0015 ANOP 05570200
AIF (&N41).N4102 05570500
JF CMS37E NOT A 3741 TAKE THE JUMP 7B 05571500
CLC S374ST(2,XR1),CMSME CHECK 3741 STATUS MESSAGE 7B 05572000
AIF (&NAS).T0020 05572500
TBN $BDATT(,DTF),$BCASK TEST FOR A ASCII LINE 7AB 05573000
JF CMS374 NO,TAKE THE JUMP 7AB 05573500
CLC S374ST(2,XR1),CMSMA CHECK 3741 STATUS MESSAGE 7AB 05574000
.T0020 ANOP 05574500
CMS374 EQU * * LOCAL 7B 05575000
JNE CMRPLS NO-CHECK POLL FOR STATUS 7B 05575500
SVC 0 TRANSIENT CALL 7B 05576000
DC AL1(CCPRIB) CCP RIB 7B 05576500
DC AL1(CC4B7) 3741 STATUS TRANSIENT 7B 05577000
B CMFORB GO REQ NEXT OP ON THE LINE 7B 05577500
CMS37E EQU * * LOCAL 7B 05578000
.N4102 ANOP 05579000
AIF (&N37).T0050 05580000
JNE CMRN37 NOT 3735, GO CHECK 3270. 5B 05590000
SPACE 1 05600000
******************************************************************** 5B 05610000
* 3735 - CHECK FOR STATUS MESSAGE * 5B 05620000
******************************************************************** 5B 05630000
SPACE 1 05640000
CLC S375NL(3,XR1),CMNULS THIS NUL-S-NUL MESSAGE ? 5B 05650000
AIF (&NAS).T0040 05660000
TBN $BDATT(,DTF),$BCASK THIS A ASCII LINE ? 5AB 05670000
JF CMR375 NO-GO TO 3735 JUMP COND. 5AB 05680000
CLC S375NL(3,XR1),CMNULA THIS NUL-S-NUL (ASCII) MSG ? 5AB 05690000
CMR375 EQU * * LOCAL 5AB 05700000
.T0040 ANOP 05710000
JNE CMRCMD NO-GO CHECK COMMAND MODE. 5B 05720000
SVC 0 #### TRANSIENT CALL ##### 5B 05730000
DC AL1(CCPRIB) CCP SVC RIB 5B 05740000
DC AL1(CC4B5) 3735 STATUS TRANSIENT 5B 05750000
SPACE 1 05760000
B CMFORB GO REQUEST NEXT OP ON THE LINE5B 05770000
SPACE 1 05780000
CMRN37 EQU * * LOCAL 5B 05790000
.T0050 ANOP 05800000
AIF (&N32).A0060 05810000
JNL CMRCMD NOT 3270, GO CHECK COMMAND MOD0B 05820000
SPACE 1 05830000
******************************************************************** 0B 05840000
* 3270 - NOT CLEAR KEY * 0B 05850000
******************************************************************** 0B 05860000
SPACE 1 05870000
* IGNORE CHECKING FOR CLEAR KEY IF NOT THE FIRST TEXT BLOCK. 0B 05880000
* ALL NON-FIRST TEXT BLOCKS BEGIN WITH A 'SBA' = X'11'. 0B 05890000
SPACE 05900000
TBN LCBAT2(,DTF),LCBSEC SECOND BLOCK OF DATA ? 0B 05903000
JT CMRCMD YES-DON'T CHECK FOR CLEAR KEY 0B 05906000
AIF (&NAS).A0030 05930000
TBN $BDATT(,DTF),$BCASK THIS A ASCI LINE ? 0AB 05940000
JF CMRSTS NO-GO CHECK EBCDIC STATUS MSG0AB 05950000
CLC SNSTAS(2,XR1),CMSTAS THIS ASCI '%R' STATUS MSG ? 0AB 05960000
J CMRNEB GO TO CONDITIONAL JUMP. 0AB 05970000
SPACE 1 05980000
.A0030 ANOP 05990000
CMRSTS EQU * * LOCAL 0B 06000000
CLC SNSTAS(2,XR1),CMSTUS THIS A STATUS MESSAGE ? 0B 06010000
CMRNEB EQU * * LOCAL 0B 06020000
JNE CMRAID NO-GO CHECK AID. 0B 06030000
SVC 0 #### TRANSIENT CALL ##### 0B 06040000
DC AL1(CCPRIB) CCP SVC RIB 0B 06050000
DC AL1(CC4BA) THE 3270 SENSE STATUS XIENT. 0B 06060000
SPACE 06070000
B CMFORB GO FORM NEXT OP ON THE LINE. 0B 06080000
SPACE 06090000
CMRAID EQU * * LOCAL 0B 06100000
AIF (&NCS).T0052 06101000
AIF (&NSWL).T0051 06102000
TBN $BDATR(,DTF),$BCMCN SWITCHED LINE ? 0B 06103000
JF CMSAID YES - DON'T UPDATE TO CS AID 0B 06104000
.T0051 ANOP 06105000
LA 2(,XR1),XR1 BUMP POINTER FOR CONTROL STA. 0B 06106000
CMSAID EQU * * LOCAL 06107000
.T0052 ANOP 06108000
AIF (&NAS).A0050 06110000
TBN $BDATT(,DTF),$BCASK THIS A ASCI LINE ? 0AB 06120000
JF CMRADE NO-GO CHECK EBCDIC AID VALUE.0AB 06130000
CLI AID(,XR1),ASCCLR THIS ASCI CLEAR INDICATION ? 0AB 06140000
J CMRPLS GO TO CONDTIONAL JUMP. 0AB 06150000
SPACE 1 06160000
CMRADE EQU * * LOCAL 0AB 06170000
.A0050 ANOP 06180000
CLI AID(,XR1),AIDCLR CLEAR KEY HIT ? 0B 06190000
.A0060 ANOP 06190900
&MIX SETA &N32+&N41 06191800
AIF (&MIX EQ '2').T0053 06192700
SPACE 1 06193600
********************------------------------*************************** 06195400
* WHEN ENTERING AT THIS LABEL EQUAL CONDITION MUST BE OFF 06196300
* UNLESS THE 3270 CLEAR KEY HAS BEEN DEPRESSED 06197200
********************------------------------*************************** 06198100
SPACE 1 06199000
CMRPLS EQU * * LOCAL 0B 06200000
L CMSPL,PL GET PARM LIST @ TO. 0/7B 06210000
TBN PL$OPC(,PL),OPLSNS POLLING FOR STATUS ? 0/7B 06220000
SBF PL$OPC(,PL),OPLSNS SET OFF POLL FOR STATUS IND.0/7B 06230000
JF CMRCLR NO-GO SET CLEAR INDICATOR. 0/7B 06240000
L PLTUBA(,PL),XR2 POINT TO THE TUB. 0/7B 06250000
SBF TUBSCS(,XR2),TUBSSP SET OFF STATUS POLL IND. 0/7B 06260000
AIF (&N41).A0051 06260300
SPACE 2 06260600
* THE 3741 HAS INDICATED THAT A STATUS MESSAGE WILL BE SENT 06261200
* BUT HAS SENT DATA INSTEAD - THIS INDICATES THAT THE 3741 HAS 06261500
* MALFUNCTIONED AND WILL NOW ATTEMPT TO SEND THE ENTIRE DISKETTE. 06261800
* CCP MUST SET UP A FORWARD ABORT TO PREVENT THIS. FIRST MUST 06262100
* CANCEL USER PROGRAM AND FREE NECESSARY AREAS(PL,BUFF). 06262400
SPACE 1 06262700
TBN TUBPHY(,XR2),TUB374 IS THIS - 06263000
TBF TUBPHY(,XR2),ALLBIT-TUB374 A 3741 ? 06263300
JF CMNABT NO - JUMP 06263600
* CANCEL USER PROGRAM 06263900
L TUBTCB(,XR2),XR2 XR2--> USER TO BE CANCELED 06264200
B CC4TI GO POST TERMINATION 06264500
DC XL1'40' COMPLETION CODE 06264800
* FREE PL AND BUFFER 06265100
B $CC4FR GO FREE 06265400
* SET UP FORWARB ABORT 06265700
L CMSDTF,DTF XR2--> DTF 06266000
SBN LCBAT2(,DTF),LCBABT INDICATE FORWARD ABORT 06266300
B CMBSTP GO DO IT 06266600
CMNABT EQU * * 06266900
SPACE 1 06267500
.A0051 ANOP 06267800
L TUBDTF(,XR2),DTF RELOAD THE DTF REG. 0/7B 06270000
MNN PL$OPM(,PL),PL$OPC(,PL) RESTORE ORIGINAL OP CODE. 0/7B 06280000
CMRCLR EQU * * LOCAL 0/7B 06290000
JNE CMRCMD NOT CLEAR KEY-CHK COMD MODE 0/7B 06300000
.T0053 ANOP 06304000
AIF (&N32).T0100 06306000
SPACE 06310000
* INDICATE CLEAR KEY HIT IF NOT SYSTEM USER. 0B 06320000
SPACE 06330000
* ZERO OUT PLRECA IN THE PL(AT THIS TIME THE GETMAINED ADDRESS 06332000
* IS IN IBA AND PLRECA) 06334000
SPACE 1 06336000
MVI PLRECA-1(,PL),NOBIT ZERO OUT PLRECA 0B 06338000
TBN PLOPM(,PL),OP$SYS SYSTEM USER ? 0B 06340000
SBN LCBAT1(,DTF),LCBEOT SET SEARCH EOT, DON'T DEQUE. 0B 06350000
SBN PL$OPC(,PL),OPRFSH SET REFRESH OPERATION NEEDED. 0B 06360000
MNN PL$OPC(,PL),PL$OPM(,PL) SAVE THE CURRENT OP CODE. 0B 06370000
L PLTUBA(,PL),TUB XR1 --> TUB 0B 06372200
AIF (&NRUF).T0055 06372500
SBF TUBSCS(,TUB),TUBRUF RESET PRUF INDICATOR 0B 06373000
.T0055 ANOP 06373500
JT CMGOFB GO TO FORM OP FOR MLMP 0B 06374500
* -START-----------------------@14 06374700
SBN TUBSCS(,TUB),TUBCLR INDICATE CLEAR KEY DEPRESSED 0B 06375000
AIF (&NDME EQ '0').T0070 06375500
B CMRCRC GO GIVE 07 RETURN CODE 0B 06376500
.T0070 ANOP 06377000
* --END------------------------@14 06377200
CMGOFB EQU * * * * * * * 06377500
B CMFORB GO FORM NEXT OP FOR MLMP 0B 06378000
SPACE 06420000
.T0100 ANOP 06430000
EJECT 06440000
******************************************************************** B 06450000
* ANY TERMINAL AND NOT A STATUS MESSAGE * B 06460000
******************************************************************** B 06470000
SPACE 06480000
* ZERO LCB BUFFER ADDRESS BECAUSE BUFFER NOW ASSIGNED TO OP ENDED PL. B 06491000
SPACE 06492000
CMRCMD EQU * * LOCAL B 06493000
MVI LCBIBA-1(,DTF),NOBIT ZERO HIGH ORDER BYTE OF BUF AD B 06494000
SPACE 1 06495000
L LCBPL@(,DTF),PL POINT TO THE PARM LIST. B 06500000
TBN PLOPM(,PL),OP$SYS SYSTEM REQUEST ? B 06510000
JF CMRDAT NO-GO HANDLE DATA MODE. B 06520000
AIF (&NRUF).F0200 06520800
SPACE 06522400
* IF RUF PGM REQUEST, HANDLE LIKE A USER GET-MSG OPERATION. WB 06523200
SPACE 06524000
L PLTUBA(,PL),XR2 XR2-> TUB. WB 06524800
TBN TUBSCS(,XR2),TUBRUF RUF ON THE SCREEN ? WB 06525600
L TUBDTF(,XR2),DTF XR2-> LCB(DTF). WB 06526400
JT CMRMSG YES-GO HANDLE AS GET-MSG. WB 06527200
.F0200 ANOP 06528800
SBN LCBAT1(,DTF),LCBEOT+LCBDEQ SET SEARCH EOT AND DEQ THEN B 06530000
CMRDAT EQU * * LOCAL B 06540000
&MIX SETA &NMSG+&NTTSK+&NAPOR 06560000
AIF (&MIX EQ '3').E0100 06580000
TBF PLOPM(,PL),OP$SYS USER REQUEST, AND GB 06610000
TBN SAVTA2,TASMSG * GET-MSG MODE ? GB 06620000
JF CMRBMV NO-GO CHECK FOR XLATE NOW. GB 06630000
SPACE 1 06640000
******************************************************************** GB 06650000
* GET-MSG -- BLOCK DATA, DO NOT TRANSLATE UNTIL EOT RECEIVED * GB 06660000
******************************************************************** GB 06670000
SPACE 1 06680000
CMRMSG EQU * * GB 06685000
CLC $BDREL(2,DTF),PLINL(,PL) THIS HUNK FILL UP REST OF AREAGB 06690000
JNE CMRBFL NO-GO TO UPDATE CONTROL PTRS. GB 06700000
SBN LCBAT1(,DTF),LCBEOT+LCBDEQ SET SEARCH EOT/ DEQ ON FIND. GB 06710000
CMRBFL EQU * * LOCAL GB 06720000
ALC PLRECA(2,PL),$BDREL(,DTF) UP REC ADDR TO NEXT FREE AREA.GB 06730000
SLC PLINL(2,PL),$BDREL(,DTF) DECREMENT COUNT OF FREE SPACE.GB 06740000
ALC LCBMRL(2,DTF),$BDREL(,DTF) KEEP COUNT OF TOTAL DATA IN. GB 06750000
B CMFORB GO TO GET THE NEXT BLOCK. GB 06760000
SPACE 06770000
.E0100 ANOP 06780000
* NON USER GET-MSG OR WHEN EOT RECEIVED FOR GET-MSG (CMRGOM) B 06790000
CMRBMV EQU * * B 06800000
SPACE 1 06810000
******************************************************************** B 06820000
* TRANSLATE DATA * B 06830000
******************************************************************** B 06840000
SPACE 1 06850000
MVC #CMTRL+TLFRML,$BDREL(2,DTF) SET TRANSLATE PARM LIST B 06860000
MVC #CMTRL+TLTOL,PLINL(2,PL) * B 06870000
MVC #CMTRL+TLFRMA,PLRECA(2,PL) * B 06880000
MVC #CMTRL+TLTOA,PLRECA(2,PL) * B 06890000
TBF PLOPM(,PL),OP$SYS USER REQUEST, AND B 06900000
TBN SAVTA1,TASTRN DON'T TRANSLATE ? B 06910000
JT CMSETL YES-SET LENGTH B 06920000
AIF (&NAS).A0100 06930000
TBN $BDATT(,DTF),$BCASK ASCII ADAPTER ? AB 06940000
JF CMRLCX NO-GO CHECK FOR LOWER CASE. AB 06950000
LA #CMTRL,XR1 POINT TO TRANSLATE LIST. AB 06960000
SVC 0 #### TRANSIENT CALL ##### B 06970000
DC AL1(CCPRIB) CCP SVC RIB B 06980000
DC AL1(CC4JE) * TRANSLATE ASCII TO EBCDIC. AB 06990000
* * HARDWARE VALIDATES ALL AB 07000000
* * ASCII CHARS, SO NO AB 07010000
* * TRANSLATION ERRORS. AB 07020000
SPACE 07030000
L LCBPL@(,DTF),PL RELOAD THE PARM LIST REG. AB 07040000
CMRLCX EQU * * LOCAL AB 07050000
.A0100 ANOP 07060000
* -----------START------------------------@10 07061000
TBN PLOPM(,PL),OP$SYS SYSTEM REQUEST ? 07064000
JT CMSETL YES - DON'T FORCE UPPER CASE 07066000
* -----------END--------------------------@10 07068000
TBF SAVTA1,TASCAS FORCE UPPER CASE CHARS ? B 07070000
JF CMSETL NO-SET LENGTH B 07080000
SPACE 07090000
* FIND AND USE SHORTEST OF PLINL OR $BDREL FOR FORCE UPPER CASE. B 07100000
SPACE 07110000
MVC LCBWRK(2,DTF),PLINL(,PL) SAVE INL IN WORK AREA. B 07120000
CLC $BDREL(2,DTF),PLINL(,PL) FROM AREA GT THAN TO AREA ? B 07130000
JH CMRUCX YES-THEN USE PLINL AS IS SET. B 07140000
MVC LCBWRK(2,DTF),$BDREL(,DTF) ELSE USE DTF RECORD LENGTH. B 07150000
SPACE 1 07160000
******************************************************************** B 07170000
* UPPER CASE TRANSLATE * B 07180000
******************************************************************** B 07190000
SPACE 1 07200000
CMRUCX EQU * * LOCAL B 07210000
L PLRECA(,PL),XR1 LOAD ADDR OF START OF BUFFER. B 07220000
CMRUPX EQU * * LOCAL B 07230000
CLI 0(,XR1),BLANK THIS CHAR BLANK OR GREATER ? B 07240000
JL CMRUPC NO-GO UP TO NEXT CHARACTER. B 07250000
SBN 0(,XR1),BLANK SET ON UPPER CASE ZONE BIT. B 07260000
CMRUPC EQU * * LOCAL B 07270000
LA 1(,XR1),XR1 INCREMENT REG TO NEXT CHAR. B 07280000
SLC LCBWRK(2,DTF),X$0001 DECREMENT COUNT, ANY LEFT ? B 07290000
BNZ CMRUPX YES-GO CHECK NEXT CHAR. B 07300000
L LCBPL@(,DTF),PL RELOAD THE PARM LIST REG. B 07310000
SPACE 1 07320000
******************************************************************** B 07330000
* SET USER RECORD LENGTH * B 07340000
******************************************************************** B 07350000
SPACE 1 07360000
CMSETL EQU * * LOCAL B 07370000
TBF PLOPM(,PL),OP$SYS USER REQUEST, AND B 07380000
TBN LCBAT2(,DTF),LCBTRC * TRUNCATED BLOCK INDICATED ? B 07390000
* -----------START------------------------@04 07394000
SBF LCBAT2(,DTF),LCBTRC SET OFF TRUNCATED IND. B 07398000
JF CMSBFL NO-GO SET BSCA EFFL COUNT. B 07402000
* -----------END--------------------------@04 07406000
TBN SAVTA2,TASBLK BLOCK READ OPERATION ? B 07420000
JT CMSBLK YES-GO BUMP BKX PAST THIS BLK. B 07430000
CLC PLINL(2,PL),SAVRCL INL LESS THAN TAS RECL ? B 07440000
JNL CMSBFL NO-MORE REC'S IN THE BLOCK. B 07450000
SLC $BDBKX(2,DTF),PLINL(,PL) ADJUST BKX TO GET THE NEXT REC.B 07460000
CMSBLK EQU * * B 07470000
ALC $BDBKX(2,DTF),SAVRCL BUMP TO NEXT REC/BLK. B 07480000
SBN PL$RTC(,PL),RCXDTR SET TRUNCATED IND TO USEER. B 07490000
CMSBFL EQU * * B 07500000
MVC PLEFFL(,PL),$BDREL(2,DTF) MOVE IN RETURNED RECORD LEN. B 07510000
AIF (&NTTSK).TT020 07510400
AGO .TT030 07510800
.TT020 ANOP 07511200
AIF (&NAPOR).PT030 07511600
.TT030 ANOP 07512000
SPACE 1 07512400
******************************************************************* @18 07512800
************* 07513200
************* 07513600
TBN LCBAT3(,DTF),LCBPOR IS THIS A PORTLINE OPERATION ? 07514000
JF CMDEFL NO - CONTINUE 07514400
SLC PLEFFL(2,PL),X$0003 DECREMENT PLEFFL BY THREE 07514800
CLI $BDDEV(,DTF),X'60' IS THIS A TTASK OPERATION ? 07515200
JNE CMDEFL NO - CONTINUE 07515600
ALC PLRECA(2,PL),X$0003 INCREMENT PLRECA BY 3 07516000
J CMRETC GO TO FINAL OP END HANDLING 07516400
CMDEFL EQU * 07516800
************* 07517200
************* 07517600
******************************************************************* @18 07518000
SPACE 1 07518400
.PT030 ANOP 07518800
AIF (&N32).T0210 07520000
TBN PLOPM(,PL),OP$SYS SYSTEM REQUEST, AND 0B 07530000
CLI CMSPHY,TUB5M2 A 3270 TERMINAL ? 0B 07540000
JC CMRETC,FLSOHI NO-GO SET RETURN CODE. 0B 07550000
L PLTUBA(,PL),XR2 XR2 -> TUB B 07550060
TBN TUBSCS(,XR2),TUBRUF RUF DAT ON THE SCREEN ? B 07550120
JF CMCFRM NO-CALL FORMAT TRANSIENT B 07550240
MVC CMRFCK(2),TUBPIL(,XR2) SAVE MAX COMMAND LEN FOR PRUF B 07550300
SLC CMRFCK(2),CMSEVN SUBTRACT SEVEN FOR RIGHT SHIFT B 07550360
CLC PLEFFL(2,PL),CMRFCK INPUT DAT > MAXIMUM LENGTH ? B 07550420
JNH CMCFRM NO-CALL FORMATTING TRANSIENT B 07550480
MVC PLEFFL(2,PL),CMRFCK SET DATA LEN TO MAX DATA B 07550540
SBN PL$RTC(,PL),RCXDTR SET TRUNCATED DATA TO USER B 07550600
CMCFRM EQU * * LOCAL B 07550660
L TUBDTF(,XR2),DTF XR2 -> DTF(LCB) B 07550730
AIF (&NSWL).T0208 07550800
AIF (&NCS).T0206 07551600
TBF $BDATR(,DTF),$BCMPT NOT MULTI-POINT LINE ? B 07552400
JF CMB0C1 NO - CALL CONTROL LINE FORMAT B 07553200
.T0206 ANOP 07554000
SVC 0 #### TRANSIENT CALL #### B 07554800
DC AL1(CCPRIB) CCP SVC RIB B 07555600
DC AL1(CC4S0) * 3275 SWITCHED LINE FORMATING B 07556400
J CMRETC GO SET RETURN CODE B 07557200
.T0208 ANOP 07558000
CMB0C1 EQU * * LOCAL 07558800
SVC 0 #### TRANSIENT CALL ##### B 07560000
DC AL1(CCPRIB) CCP SVC RIB B 07570000
DC AL1(CC4B0) * 3270 COMMAND INPUT FORMATING0B 07580000
* * ALWAYS RETURNS HERE 0B 07590000
.T0210 ANOP 07600000
J CMRETC GO SET RETURN CODE. B 07610000
SPACE 07620000
$CC4CM TITLE '$E072/CMWEND---WRITE-OP-END' 07630000
****************************************************************** B 07640000
* BSCA WRITE OP END HANDLING * B 07650000
****************************************************************** B 07660000
SPACE 07670000
* COME HERE ON SUCCESSFUL OP END OF A WRITE OPERATION B 07680000
* IF NOT PUT THEN GET - DEQUEUE THE PARAMETER LIST. B 07690000
* IF PUT THEN GET, REFORMAT PARM LIST AND GO BACK TO RESCHED LINE. B 07700000
SPACE 07710000
CMWEND EQU * WRITE OP END HANDLER 07720000
L PLTUBA(,PL),XR1 XR1 --> TUB @28 07721000
TBN TUBOTC(,XR1),X'20' IS THIS A SYS/34 DEVICE ? @28 07722000
JF CMBN34 NO - CONTINUE @28 07723000
SLC TUBER@(2,XR1),TUBER@(,XR1) YES - CLEAR THE SYS/34 @28 07724000
* RETRY COUNTER @28 07725000
CMBN34 EQU * @28 07726000
L LCBPL@(,DTF),PL XR1 --> CURRENT P.L. @28 07727000
TBF PLOPM(,PL),OP$SYS USER REQUEST, AND B 07730000
TBN LCBAT2(,DTF),LCBTRC * BLOCK TRUNCATED IND ON ? B 07740000
SBF LCBAT2(,DTF),LCBTRC SET OFF THE TRUNCATED IND. B 07750000
JF CMWRVI NO-GO CHECK FOR RVI RECEIVED. B 07760000
CLC PLOUTL(2,PL),SAVRCL OUTL LESS THAN TAS RECL ? B 07770000
JNL CMWTRC NO-THEN OUTPUT WAS TRUNCATED. B 07780000
SPACE 1 07790000
******************************************************************** B 07800000
* USER REQUEST - PAD WITH BLANKS * B 07810000
******************************************************************** B 07820000
SPACE 1 07830000
SVC 0 #### TRANSIENT CALL ##### B 07840000
DC AL1(CCPRIB) CCP SVC RIB B 07850000
DC AL1(CC4BB) * PAD RECORD AREA WITH BLANKS B 07860000
DC AL2($$BSMS) ADCON FOR MLMP IOCS. B 07870000
DC AL2($$BMCH) ADCON FOR CHECK. B 07880000
SPACE 1 07890000
* BB RETURNS TO NSI+4 IF AN ERROR OCCURS. B 07900000
* BB RETURNS TO NSI+11 IF A NORMAL OPERATION OCCURRED (CMWRVI). B 07910000
SPACE 1 07920000
B CMBOPE GO HANDLE ERROR CASE. B 07930000
SPACE 1 07940000
CMWTRC EQU * * LOCAL B 07950000
* SKIPPED BY BB RETURN. B 07960000
SBN PL$RTC(,PL),RCXDTR SET TRUNCATED RETURN CODE. B 07970000
SPACE 1 07980000
CMWRVI EQU * * LOCAL B 07990000
TBN LCBOPC(,DTF),LCBRVI RVI RECEIVED ? B 08000000
* -----------START------------------------@06 08002000
SBF LCBOPC(,DTF),LCBRVI SET OFF SEND RVI INDICATOR. B 08004000
* -----------END--------------------------@06 08006000
JF CMWEOT NO-GO CHECK FOR SEND EOT NEED B 08010000
MVI PL$RTC(,PL),RCXRVI SET RVI RETURN CODE. B 08020000
CMWEOT EQU * * LOCAL B 08030000
TBN LCBAT2(,DTF),LCBSET SEND EOT OPERATION ? B 08040000
JF CMWETX NO-CHECK FOR SEND EOT. B 08050000
SPACE 1 08060000
******************************************************************** B 08070000
* SENT EOT - OPERATION REQUIRED IT. * B 08080000
******************************************************************** B 08090000
SPACE 1 08100000
SLC LCBAT2(2,DTF),LCBAT2(,DTF) CLEAR LCBAT1 AND LCBAT2. B 08110000
L PLTUBA(,PL),XR2 LOAD REG TO THE TUB. B 08120000
SBF TUBAT2(,XR2),TUBOWN SET OFF TUB OWN INDICATOR. B 08130000
AIF (&NRUF).F0300 08130500
SPACE 08131500
* SET OFF RUF INDICATION FOR A SUCCESSFUL USER PUT OPEND. WB 08132000
SPACE 08132500
TBF PLOPM(,PL),OP$SYS USER OPERATION ? WB 08133000
JF CMWRFH NO-SKIP RUF SETS. WB 08133500
SBF TUBSCS(,XR2),TUBRUF SET-OFF RUF INDICATOR. WB 08134000
SPACE 08134500
* SET ON RUF INDICATOR FOR A USER PUT/RUF-MSG OPERATION. WB 08135000
SPACE 08135500
TBN PLOPC(,PL),OPRUF RUF OPERATION WB 08136000
TBF PLOPC(,PL),OPORDR-OPRUF * CODE ? WB 08136500
JF CMWRFH NO-DON'T SET-ON RUF IND. WB 08137000
SBN TUBSCS(,XR2),TUBRUF SET-ON RUF INDICATOR. WB 08137500
CMWRFH EQU * * WB 08138000
.F0300 ANOP 08139000
L TUBDTF(,XR2),DTF RELOAD THE DTF REG. B 08140000
AIF (&N32).T0300 08150000
SPACE 08160000
* WAS THIS A EOT FOR SCREEN REFRESH OPTION, THEN GO TO RESCHEDULE. 0B 08170000
SPACE 08180000
TBN PL$OPC(,PL),OPRFSH REFRESH OPERATION ? 0B 08190000
SBF PL$OPC(,PL),OPRFSH SET OFF REFRESH INDICATOR. 0B 08200000
JF CMWPGX NO-GO TEST FOR PUT THEN GET 0B 08210000
MNN PL$OPM(,PL),PL$OPC(,PL) RESTORE ORIGINAL OP CODE. 0B 08220000
B CMREDO GO TO REDO WORK CHECK ON LINE.0B 08230000
SPACE 08240000
CMWPGX EQU * * LOCAL B 08250000
.T0300 ANOP 08260000
SPACE 08270000
* DETERMINE IF OP WAS PUT THEN GET B 08280000
SPACE 08290000
TBN PLOPC(,PL),OPGET WAS IT PUT THEN GET B 08300000
JF CMRETC JUMP IF NOT B 08310000
SPACE 08320000
B CMWPGY HANDLE PUT THE GET B 08330000
SPACE 08340000
J CMREDO JUMP TO RESTART THE LINE B 08350000
SPACE 1 08360000
******************************************************************** B 08370000
* NOT A SEND EOT OPERAION - DETERMINE IF EOT NEEDED ANYWAY * B 08380000
******************************************************************** B 08390000
SPACE 1 08400000
CMWETX EQU * * LOCAL B 08410000
TBN PL$OPC(,PL),OPUSER SYSTEM FUNCTION ? B 08420000
JT CMWSET YES-GO SET SEND EOT. B 08430000
TBN PLOPC(,PL),OPMSG IS THIS A PUT-MSG B 08440000
TBF PLOPC(,PL),OPORDR-OPRUF * OPERATION ? B 08450000
JT CMWSET YES-GO SET SEND EOT. B 08460000
TBN PLOPC(,PL),OPGET GET FOLLOW PUT OPERATION ? B 08470000
JF CMRETC NO B 08480000
CMWSET EQU * * B 08490000
SBN LCBAT2(,DTF),LCBSET SET SEND EOT. B 08500000
B CMFORB GO TO FORM NEXT OP ON LINE. B 08510000
TITLE '$E072/CMRETC---READ/WRITE OP END HANDLING' 08520000
******************************************************************** B 08530000
* FINAL BSCA READ/WRITE OP END HANDLING (COULD BE IN ERP) * B 08540000
******************************************************************** B 08550000
SPACE 1 08560000
CMRETC EQU * * B 08570000
TBN LCBAT1(,DTF),LCBEOT SEARCH EOT ? B 08580000
BT CMFORB YES-GO FORM NEXT OP FOR LINE. B 08590000
SPACE 08605000
TBN PLOPC(,PL),OPGET GET OPERATION ? B 08610000
JF CMRACT NO-GO TEST LINE ACTIVE. B 08620000
L PLTUBA(,PL),XR2 POINT TO THE TUB. B 08630000
SBF TUBAT2(,XR2),TUBIIS SET OFF INVITE SCHEDULED. B 08640000
L TUBDTF(,XR2),DTF POINT TO THE DTF. B 08650000
CMRACT EQU * * LOCAL B 08660000
TBN LCBAT2(,DTF),LCBACT LINE ACTIVE ? B 08670000
JF CMBDEQ NO-GO AND JUST DEQUE. B 08680000
SBN LCBAT1(,DTF),LCBNTQ SET ID ACTIVE PARM LST REMOVED B 08690000
SPACE 08700000
******************************************************************** B 08710000
* DEQUEUE THE PARAMETER LIST * B 08720000
******************************************************************** B 08730000
SPACE 08740000
CMBDEQ EQU * * B 08750000
SPACE 08750900
TBN PL$OPC(,PL),OPGET GET OPERATION IN PROCESS ? B 08751800
JF CMNCCT NO - DON'T UPDATE DATA COUNT. B 08752700
L $BDWKA(,DTF),XR2 XR1 -> BSCA WORKAREA. B 08753600
MVC WCOUNT(2),PLEFFL(,PL) SAVE IN TEMPORARY COUNTER. B 08754500
ALC $BWRCT(4,XR2),WCOUNT TOTAL DATA COUNT. B 08755400
L PLTUBA(,PL),XR2 POINT TO THE TUB. B 08756300
L TUBDTF(,XR2),DTF POINT TO THE DTF. B 08757200
CMNCCT EQU * * B 08758100
SPACE 08759000
B CMDEQ DEQUEUE PL FROM LINE QUEUE B 08760000
SPACE 08770000
AIF (&NDF).F0400 08780000
L PLTUBA(,PL),XR2 TUB ADDRESS FB 08790000
TBN TUBAT2(,XR2),TUBDTA+TUBCMD COMMAND INTERRUPT MODE?(DME) FB 08800000
JT CMGOII YES - DONT GO TO DFF TASK. FB 08810000
TBN TUBTA1(,XR2),TASDFF IF A NON-DFF REQUEST OR FB 08820000
TBF PLOPM(,PL),OP$SYS * SYSTEM REQ TO DFF TERMINAL, FB 08830000
CLI PL$OPM(,PL),OPINV * OR A DFF INVITE FB 08840000
JC CMGOII,FLSOEQ YES - BYPASS POST OF DFF TASK.FB 08850000
SPACE 1 08860000
****************************************************************** FB 08870000
* DFF REQUEST - GET,PUT OR STOP INVITE. POST DFF IF NECESSARY* FB 08880000
****************************************************************** FB 08890000
SPACE 1 08900000
L TUBDTF(,XR2),DTF DTF ADDRESS FB 08910000
TBN PLOPC(,PL),OPPUT PUT REQUEST FB 08920000
TBF LCBAT2(,DTF),LCBACT AND LINE INACTIVE (EOT SENT) FB 08930000
JT CMGOII YES - JUST RETURN TO II FB 08940000
CLI PL$RTC(,PL),RCXEDT IF NO DATA TRANSMITTED FB 08950000
JH CMGOII YES - JUST RETURN TO II FB 08960000
SPACE 1 08970000
* POST DFF TASK FOR THE FOLLOWING USER OPS TO DFF TERMINAL: FB 08980000
* 1. SUCCESSFUL GET. FB 08990000
* 2. STOP INVITE WITH DATA (BECAME A GET). FB 09000000
* 3. SUCCESSFUL PUT WHEN EOT NOT SENT. FB 09010000
SPACE 1 09020000
B CMDFFQ QUEUE REQ FOR DFF AND POST. FB 09030000
J CMREDO RESCHED LINE IF NEEDED FB 09040000
SPACE 09050000
CMGOII EQU * * LOCAL FB 09060000
.F0400 ANOP 09070000
SPACE 1 09080000
AIF (&NTTSK).TT040 09080500
AGO .TT050 09081000
.TT040 ANOP 09081500
AIF (&NAPOR).PT020 09082000
.TT050 ANOP 09082500
******************************************************************* @18 09083000
************* 09083500
************* 09084000
L PLTUBA(,PL),XR2 XR2 --> TUB 09084500
TBN TUBPHY(,XR2),TUBAPT IS THIS A PORTLINE TUB ? 09085000
BT CMZQUE YES - QUEUE THE DATA ON TUBDCH 09085500
CLI PLOPC(,PL),OPDMY IS THIS A DUMMY PARM LIST ? 09086000
JE CMREDO YES - NOTHING TO POST 09086500
************* 09087000
************* 09087500
******************************************************************* @18 09088000
SPACE 1 09088500
.PT020 ANOP 09089000
B CMPOST POST REQUESTOR AND FREE BUFS B 09090000
SPACE 09100000
******************************************************************** B 09110000
* IF LINE NOT ACTIVE - GO RESTART LINE, OTHERWISE HANDLE AN OP END B 09120000
******************************************************************** B 09130000
SPACE 09140000
CMREDO EQU * * B 09150000
L PLTUBA(,PL),XR2 POINT TO THE TUB B 09160000
L TUBDTF(,XR2),DTF POINT TO THIS LINES DTF. B 09170000
&MIX SETA &N32+&N37+&N41 09180000
AIF (&MIX EQ '3').T0500 09190000
TBN PL$OPC(,PL),OPLSNS POLLING FOR STATUS ? 7/0/5B 09200000
JT CMEACT YES-DON'T DESTROY USER OP.7/0/5B 09210000
.T0500 ANOP 09220000
MNN PL$OPC(,PL),PL$OPM(,PL) SAVE CURRENT OP FOR ERP. B 09230000
CMEACT EQU * * LOCAL B 09240000
TBN LCBAT2(,DTF),LCBACT LINE ACTIVE ? B 09250000
BT CMOPND YES-GO CHECK OP END COUNT. B 09260000
B CMBSCH BR TO RESTART THE LINE B 09270000
.C0300 ANOP 09280000
MEND 09290000