|
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: 31750 (0x7c06)
Types: s3xseg
Names: »S$E085«
└─⟦827b5bd03⟧ Bits:30009184 5702-sc1.V16.ccp
└─⟦f17e99db6⟧
└─⟦this⟧ »S$E085«
MACRO 00010000
.********************************************************************** 00010100
.* NAME: $E085 V-13, M-00. * 00010300
.********************************************************************** 00016600
$E085 00020000
GBLB &ONE,&NOB,&NOM,&NSW,&N1050,&NMOVE,&NSCTL,&NBFR 00030000
GBLB &NPP,&NMP,&NSWL,&NCS,&N32,&NAS,&MOD4 00040000
LCLA &MIX 00051000
TEXT 00060000
* R-13,C-01 CHANGE LEVEL 00065000
TITLE '$E085/CMRSCH---RESCHEDULE-THE-TP-LINE' 00070000
*********************************************************************** 00071000
* * 00072000
* NAME--CMRSCH * 00073000
* * 00074000
* TITLE--RESCHEDULE THE TP LINE * 00075000
* * 00076000
* FUNCTION--TO SCHEDULE WORK ON LINES THAT NOT BUSY, OR TO STOP * 00077000
* POLLING ON A LINE AND SCHEDULE OF PUT OPERATION IF PUT * 00078000
* OPERATIONS ARE PENDING IN THE LINE QUEUE. * 00079000
* * 00080000
* OPERATION-- * 00081000
* . IF THE LINE IS BUSY, AND NO PUT OPERATION IS IN THE * 00082000
* QUEUE, THEN POST REQUESTOR IF TP WAS SCHEDULED. CHECK * 00083000
* FOR MORE WORK THAT CAN BE DONE. * 00084000
* * 00085000
* . IF LINE IS BUSY POLLING AND PUT IS IN THE QUEUE THEN * 00086000
* CANCEL THE GET AND HANDLE THE PUT. * 00087000
* * 00088000
* . CLEAR ANY BSCA OP ENDS LEFT IN THE LCB, AND ADJUST THE * 00089000
* OP END TOTAL COUNT (CCOECT). * 00090000
* * 00091000
* . IF MLTA OLT IS IN PROCESS CALL IN TRANSIENT TO CONTINUE* 00092000
* THE OLT OPERATION. * 00093000
* * 00094000
* . IF QUEUE FOR LINE IS EMPTY THEN POST THE REQUESTOR IF * 00095000
* TP WAS JUST SCHEDULED, CHECK FOR OTHER FUNCTION THAT * 00096000
* CAN BE PERFORMED BY 'CM'. * 00097000
* * 00098000
* . IF A BSCA POLL FOR STATUS OPERATION IN THE QUEUE HANDLE* 00099000
* IT BEFORE ANY OTHER OPERATION. * 00100000
* * 00101000
* . IF A PUT OPERATION CAN BE STARTED, PERFORM IT NEXT. * 00102000
* * 00103000
* . IF NEITHER OF ABOVE TWO, THEN TRY TO SCHEDULE AN INPUT * 00104000
* OPERATION. IF NO INPUT TO SCHEDULE THEN POST THE * 00105000
* REQUESTOR IF TP WAS JUST SCHEDULED. THEN CHECK FOR * 00106000
* OTHER 'CM' FUNCTION THAT CAN BE PERFORMED NOW. * 00107000
* * 00108000
* . IF A WRITE OPERATION CAN BE STARTED, THEN SET UP THE * 00109000
* OUTPUT DATA BUFFER FOR THE LINE. TRANSLATE THE DATA * 00110000
* AS REQUIRED OR SPECIFIED. ADD DEVICE DEPENDENT * 00111000
* CONTROL CHARACTERS. * 00112000
* * 00113000
* . IF NEW OPERATION ON A BSCA CARVE UP THE IOB(S) AND LINE* 00114000
* BUFFER(S) AS NECESSARY TO PERFORM THE OPERATION. SET * 00115000
* UP THE LINE DEPENDENT SECTION OF THE DTF. (POLLING/ * 00116000
* ADDRESSING CHARACTERS, SWITCH ID VERIFICATION IDS, * 00117000
* SWITCH LINE CALL/ANSWER OPTIONS). * 00118000
* * 00119000
* . IF BSCA OPERATION SET UP TO DO THE GET OR PUT-NORMAL, * 00120000
* PUT-BLOCK, PUT-END OF FILE, OR PUT EOT-TO-WACK * 00121000
* OPERATION AS APPROPRIATE. * 00122000
* * 00123000
* . IF MLTA OPERATION SET UP TO DO THE READ, WRITE WITH * 00124000
* THE APPROPRIATE DISCONNECT, CONTINUE OR CONVERSATIONAL * 00125000
* OPTION AS REQUIRED BY THE TERMINAL AND/OR CURRENT * 00126000
* LINE CIRCUMSTANCE. * 00127000
* * 00128000
* . ISSUE OF IOCS CALL AFTER THE DTF IS SET-UP. FOR BSCA, * 00129000
* CALL $$BSMS, FOR MLTA, CALL MLTIO1. * 00130000
* * 00131000
* . AFTER ISSUING THE IOCS CALL, TRACE THE RESULTS THRU * 00132000
* $CC4TT. * 00133000
* * 00134000
* . IF MLTA START OPERATION CODE INDICATES A START * 00135000
* FAILURE THE CAM IN A TRANSIENT TO DETERMINE THE * 00136000
* PROBLEM. OTHERWISE, POST THE REQUESTOR IF TP WAS * 00137000
* JUST SCHEDULED. CHECK FOR MORE WORK FOR 'CM' TO * 00138000
* PERFORM AT THIS TIME. * 00139000
* * 00140000
* . IF BSCA OPERATION IS COMPLETED WITHOUT AN OP END * 00141000
* INTERRUPT THEN FAKE AN OP END INTERRUPT TO KEEP THE * 00142000
* FUNCTION GOING TIL COMPLETION. POST THE REQUESTOR IF * 00143000
* TP WAS JUST SCHEDULED. CHECK FOR MORE WORK TO DO AT * 00144000
* THIS TIME. * 00145000
* * 00146000
* . IF CHECKING FOR MORE WORK TO BE DONE, THEN: * 00147000
* - CHECK FOR MLTA OLT START FAILURE. IF YES GO BACK * 00148000
* AND TRY TO RESCHEDULE THE OPERATION. * 00149000
* * 00150000
* - IF BSCA PARM LIST WAS JUST QUEUE WHICH IS THE * 00151000
* CONTINUATION OF A PREVIOUSLY STARTED LINE OPERATION, * 00152000
* THEN HANDLE THE NEXT OPERATION IT CAUSES. * 00153000
* * 00154000
* - IF THERE ARE ANY OP ENDS TO BE HANDLED THEN CALL * 00155000
* THE OP END HANDLER. * 00156000
* * 00157000
* - IF THERE IS A FREEMAIN POSTED OR A TP PARAMETER * 00158000
* LIST TO BE SCHEDULED, THEN CALL THE TP SCHEDULER. * 00159000
* * 00160000
* - IF THERE IS A LINE TO BE RESCHEDULED BECAUSE OF ERP * 00161000
* THEN GO BACK TO THE START OF THE RESCHEDULE FUNCTION.* 00162000
* * 00163000
* - IF THERE IS A CONSOLE FUNCTION PENDING THEN GIVE * 00164000
* CONTROL TO THE 'KM' CONSOLE MANAGEMENT FUNCTION. * 00165000
* * 00166000
* - OTHERWISE, IF NONE OF ABOVE, THEN WAIT FOR MORE * 00167000
* WORK. * 00168000
* * 00169000
* . IF POSTED WITH WORK TO DO, GIVE CONTROL TO THE 'KM' * 00170000
* FUNCTION. * 00171000
* * 00172000
* ENTRY POINTS * 00173000
* CMRSCH - RESCHEDULE WORK ON THE LINE. * 00174000
* CMPAII - POST REQUESTOR IF TP SCHEDULED. * 00175000
* CMTSRQ - CHECK FOR MORE WORK TO BE PERFORMED. * 00176000
* * 00177000
* INPUT-- * 00178000
* CMSLCB - ADDRESS OF DTF TO BE SCHEDULED. * 00179000
* CMSPL - ADDRESS OF TP PARAMETER LIST TO BE SCHEDULED. * 00180000
* CC@PRL - ADDRESS OF TP PARAMETER LIST LAST SCHEDULED. * 00181000
* CCOECT - OP END PENDING COUNT. * 00182000
* TCBMPK - POST MASK OF WORK TO DO. * 00183000
* #CMERP - ADDRESS OF DTF FOR RESCHEDULING BECAUSE OF ERP. * 00184000
* @KMQTB - ADDRESS OF CONSOLE PARAMETER LIST AWAITING * 00185000
* OPERATION. * 00186000
* * 00187000
* OUTPUT-- * 00188000
* CMSLCB - ADDRESS OF DTF FOR LINE SCHEDULED. * 00189000
* CMSPL - ADDRESS OF TP REQUEST SCHEDULED. * 00190000
* DTF(LCB),TUB - SET UP FOR THE OPERATION PERFORMED. * 00191000
* * 00192000
* EXTERNAL REFERENCES-- * 00193000
* $CC4BC - STOP POLLING TO HANDLE PUT ON BSCA LINE. * 00194000
* $CC4MT - HANDLE MLTA OLT CONTINUATION. * 00195000
* $CC4B0 - FORMAT 3270 COMMAND OUTPUT. * 00196000
* $CC4WR - HANDLE TRANSLATE ERRORS IN OUTPUT. * 00197000
* $CC4JX - X IS THE APPROPRIATE LINE TRANSLATE TRANSIENT. * 00198000
* $CC4SC - MLTA START CODE FAILURE TRANSIENT. * 00199000
* $CC4TT - CCP TRACE ROUTINE. * 00200000
* $CC4WC - SWITCH LINE CALL/ANSWER LOG TRANSIENT. * 00201000
* $CC4WT - CCP WAIT/POST ROUTINE. * 00202000
* CMIVGM - INVITE INPUT/GET OPERATION SCHEDULE ROUTINE. * 00203000
* CMRQBF - POST REQUESTOR OF TP SCHEDULED. * 00204000
* CMMCT - SET UP MULTI-COMPONENT TERMINAL ADDRESSES. * 00205000
* CMGINL - SET UP INPUT RECORD LENGTH. * 00206000
* CMPSCH - FIND SWITCH ID ENTRY IN SWITCH ID LIST. * 00207000
* CMASCH - FIND ADDRESSING ENTRY IN ADDRESSING LIST. * 00208000
* MLTIO1 - MLTA IOCS. * 00209000
* $$BSMS - BSCA IOCS. * 00210000
* * 00211000
* EXIT, NORMAL-- * 00212000
* - TO CMFRMN IF FREEMAIN POSTED OR TP REQUEST TO BE * 00213000
* HANDLED. * 00214000
* - TO CMRSCH IF ANOTHER LINE TO RESCHEDULE. * 00215000
* - TO CMPOND IF AN OP END TO BE HANDLED. * 00216000
* - TO KMINTR IF A CONSOLE OPERATION TO BE HANDLED. * 00217000
* * 00218000
*********************************************************************** 00219000
SPACE 00330000
CMRSCH EQU * RESCHEDULE THE LINE 00340000
AIF (&MOD4 NE '1').LJ005 00342000
SBN CMSWIT,KNONLY SET 'CONSOLE ONLY PL IN Q' 00344000
.LJ005 ANOP 00346000
L CMSLCB,XR2 POINT XR2 AT LCB 00350000
AIF (&NOB).C0400 00360000
SPACE 00370000
* CLEAR ANY OP END RESIDUAL LEFT FOR A BSCA DTF. B 00380000
SPACE 00400000
AIF (&NOM).M1100 00410000
TBN $BDDEV(,DTF),BSCA BSCA DTF ? 2 00420000
JF CMROLT NO-GO CHECK FOR MLTA OLT. 2 00430000
.M1100 AIF (&NSWL).S0050 00431000
&MIX SETA &NPP+&NMP+&NCS 00432000
AIF (&MIX EQ '3').S0060 00433000
TBN $BDATR(,DTF),$BCSWI SWITCHED SLB 00434000
TBF $BDATR(,DTF),$BCMPT * LINE ? SLB 00435000
JT CMROPE YES-DON'T CLEAR 'LCBOWN'. SLB 00436000
.S0050 ANOP 00437000
SLC LCBOWN(2,DTF),LCBOWN(,DTF) CLEAR LINE OWNERSHIP STATUS. B 00440000
.S0060 ANOP 00441000
CMROPE EQU * * B 00442000
SLC CCOECT,LCBOPE(1,DTF) REMOVE LINE OP END RESIDUAL. B 00450000
MVI LCBOPE(,DTF),NOBIT CLEAR LINE OP END COUNT. B 00460000
J CMLKPL GO CHECK FOR MORE LINE PARM'S. 2 00470000
SPACE 1 00480000
CMROLT EQU * * 2 00490000
.C0400 ANOP 00500000
AIF (&NOM).M1150 00501000
SPACE 00502000
* FOR MLTA, FIRST DETERMINE IF ANY SYSTEM INITIATED ONLINE TESTS M 00503000
* ARE PENDING. M 00504000
SPACE 00505000
CLI LCBOLT(,XR2),CMZERO IS ONLINE TEST COUNT ZERO M 00510000
JE CMLKPL YES-TO LOOK AT PARM LISM M 00520000
SPACE 00530000
* HAVE ON-LINE TEST REQUEST THAT NEEDS TO BE STARTED - CALL TRANSIENT M 00540000
SPACE 00550000
B $CC4PI BRANCH TO BRING IN TRANSIENT M 00560000
DC AL1(CC4MT) START ONLINE TEST M 00570000
SPACE 00580000
* RETURN AT ARR IF ONLINE TEST NOT STARTED M 00590000
SPACE 00600000
SBN CMSWIT,CMNOST INDICATE LINE I/O NOT STARTED M 00610000
SPACE 00620000
* RETURN AT ARR+4 IF ONLINE TEST STARTED M 00630000
SPACE 00640000
J CMBRCK JUMP TO SEE IF POST NEEDED M 00650000
SPACE 00720000
.M1150 ANOP 00721000
CMLKPL EQU * LOOK AT PARM LISTS IN THE QUEUE 00730000
CLI LCBPLQ-1(,XR2),CMZERO IS QUEUE EMPTY 00740000
JE CMBRCK JUMP TO BR TO CHECK OP END COUNT 00750000
SPACE 00760000
* REQUEST IN QUEUE FOR THE LINE READY TO GO 00770000
SPACE 00780000
* LOOK FOR NON-READ IF ANY TO EXECUTE NOW 00790000
* ELSE SEARCH THE QUEUE FOR A READ AND START ALL READS FOR WHICH 00800000
* THE NECESSARY HOLD BUFFER SPACE CAN BE OBTAINED 00810000
* ASSURE NO OP SCHEDULED TO TERMINAL IN ERROR RECOVERY 00820000
SPACE 00830000
L LCBPLQ(,XR2),XR1 POINT XR1 AT 1ST PARM LIST IN Q 00840000
CMRDCK EQU * 00850000
L PLTUBA(,XR1),XR2 POINT XR2 AT THE TUB 00860000
AIF (&NSWL).S0100 00870000
SPACE 1 00880000
* IGNORE SYSTEM REQUESTS IF A USER TASK OWNS THE SWITCHED LINE. SB 00890000
SPACE 1 00900000
AIF (&NOM).C0473 00910000
TBN TUBCHR(,XR2),TUBLNE BSCA LINE ? S2 00920000
.C0473 ANOP 00930000
TBN TUBAT1(,XR2),TUBSWC SWITCHED LINE ? SB 00940000
JF CMRFSH NO-GO CHECK REFRESH OPTION. SB 00950000
L TUBDTF(,XR2),DTF POINT TO THE DTF. SB 00960000
SPACE 00961000
* ------------------------------START--@07 00962000
TBN LCBATR(,DTF),LCBNIT LINE CONNECTED ? SB 00963000
JT CMOWNC YES - CHECK OWNING TUB SB 00964000
* LINE NOT CONNECTED - ALLOW REQUEST UNLESS SYSTEM REQUEST AND SB 00965000
* USER TASK OWNS THE LINE. SB 00966000
* ------------------------------END----@07 00967000
SPACE 00968000
CLC LCBTCB(2,DTF),CC0000 SWITCH LINE UNOWNED ? SB 00970000
JE CMRFSH YES-GO CHECK FOR REFRESH SB 00980000
CLC LCBTCB(2,DTF),CC@CPT CP OWN THE SWITCHED LINE ? SB 00990000
JE CMRFSH YES-GO CHECK REFRESH OPTION. SB 01000000
TBN PLOPM(,PL),OPREQR SYSTEM REQUEST ? SB 01010000
JT CMNXTP YES-SKIP THIS PARM LIST. SB 01020000
* ------------------------------START--@07 01021000
J CMRFSH NOT CONNECTED SO SCHEDULE SB 01022000
* LINE CONNECTED - CHECK TO SEE IF REQUEST IS FOR CONNECTED TUB. SB 01023000
CMOWNC EQU * * LOCAL SB 01024000
CLC PLTUBA(2,PL),LCBOWN(,DTF) YES - THIS TUB OWN THE LINE SB 01025000
JNE CMNXTP NO - LINE OWNED BY ANOTHER SB 01026000
* TUB SO SKIP THIS PL. SB 01027000
* ------------------------------END----@07 01028000
SPACE 01029000
CMRFSH EQU * * SB 01030000
L PLTUBA(,PL),XR2 POINT TO THE TUB. SB 01040000
.S0100 ANOP 01050000
AIF (&N32).T0700 01060000
SPACE 01070000
* IF OPERATION IS REFRESH OF SCREEN, THE SET TEMP OP CODE FOR PUT. 0B 01080000
SPACE 01090000
AIF (&NOM).T0600 01100000
TBN TUBCHR(,XR2),TUBLNE BSCA LINE ? 02 01110000
JF CMRXPT NO-GO CHECK PUT IN ERP. 02 01120000
.T0600 ANOP 01130000
* IF THE CLEAR KEY HAS BEEN HANDLED FOR A STOP INVITE PL 0B 01130600
* THEN DON'T RESCHEDULE IT,GO DE-QUE IT AND RETURN IT TO 0B 01131200
* THE USER PROGRAM 0B 01131800
SPACE 1 01132400
TBN PLOPM(,PL),OPSTOP STOP INVITE AND 0B 01133000
TBN TUBSCS(,XR2),TUBCLR CLEAR KEY ? 0B 01133600
JF CMRXE1 NO-CHECK REFRESH 0B 01134200
MVI PL$RTC(,PL),RCXCLR INTERNAL RET. CODE = CLEAR 0B 01134800
SBF TUBSCS(,XR2),TUBCLR SET OFF CLEAR IND. 0B 01135400
ST CMSPL,PL SAVE PL FOR DE-QUE 0B 01136000
L TUBDTF(,XR2),XR2 XR2--> DTF 0B 01136600
B CMRETC GO DEQUE STOP PL 0B 01137200
SPACE 1 01137800
CMRXE1 EQU * REFRESH CHECK 0B 01138400
TBN PL$OPC(,PL),OPRFSH REFRESH OPERATION REQUESTED ? 0B 01140000
JF CMRXER NO-GO TEST FOR TERM IN ERP. 0B 01150000
MNN PL$OPM(,PL),CCPUT ALTER OP CODE TO A PUT. 0B 01160000
CMRXER EQU * * 0B 01170000
SPACE 1 01180000
* IF POLL FOR STATUS OPERATION , HANDLE AS HIGHEST PRIORITY. 0B 01190000
SPACE 1 01200000
TBN PL$OPC(,PL),OPLSNS POLLING FOR STATUS ? 0B 01210000
JT CMTSRS YES-GO HANDLE STATUS POLL. 0B 01220000
CMRXPT EQU * * 0B 01230000
.T0700 ANOP 01240000
TBN PL$OPM(,XR1),OPPUT IS IT PUT 01250000
TBF TUBAT3(,XR2),TUBERP ASSURE NOT IN ERROR RECOVERY 01260000
JT CMSCHO JUMP IF PUT AND TUB NOT IN ERP 01270000
SPACE 01280000
CMNXTP EQU * CHECK NEXT PARM LIST 01290000
CLI PLCHN-1(,XR1),CMZERO ANY MORE PARM LISTS IN QUEUE 01300000
JE CMTSRS IF NOT JUMP TO TRY TO SCHEDULE RD01310000
SPACE 01320000
*MORE REQUESTS IN QUEUE-CHECK THAM FOR NON-READ 01330000
SPACE 01340000
AIF (&MOD4 NE '1').LJ008 01342000
SBF CMSWIT,KNONLY SET OFF 'CONSOLE ONLY PL IN Q' 01344000
.LJ008 ANOP 01346000
L PLCHN(,XR1),XR1 PT XR1 AT NEXT PARM LIST 01350000
B CMRDCK BR TO CHECK FOR NON READ 01360000
SPACE 01370000
* ALL READS IN THE QUEUE SO DO ANALYSIS IN TERMS OF ELIGIBLITY 01380000
* BECAUSE RECORD AREA OR HOLD BUFFER IS AVAILABLE 01390000
* MAY HAVE NON-READS IN QUEUE BUT THEY WILL BE TO TERMINALS IN ERROR 01400000
* RECOVERY 01410000
SPACE 01420000
CMTSRS EQU * TEST READ ELIGIBILITY 01430000
AIF (&MOD4 NE '1').LJ010 01431000
TBN CMSWIT,KNONLY CONSOLE ONLY PL IN Q AND -| 01432000
SBF CMSWIT,KNONLY SET IT OFF | 01433000
L CMSLCB,DTF XR2 --> BSCA DTF | 01434000
TBN $BDDEV(,DTF),X'08' LINE TWO AND -------------| 01435000
TBF PL$OPC(,PL),OPLSNS NOT POLL FOR STATUS ?-----| 01436000
JT CMBRCK YES - DON'T RESCHEDULE<---| 01437000
.LJ010 ANOP 01438000
B CMIVGM BRANCH TO DO READ GETMAIN ANALYSI01440000
TBN CMSWIT,CMRSLN IS RESCHEDULE SWITCH ON 01450000
JT CMTKFR JUMP IF RESCHEDULE ON 01460000
SPACE 01470000
* CANNOT RESCHEDULE THE LINE SO BRANCH TO SET OFF TP REQUEST POST BIT 01480000
* AND THEN CHECK THE OP END COUNT 01490000
SPACE 01500000
CMBRCK B CMPAII BR TO POST IF NEEDED 01510000
SPACE 01520000
CMTKFR EQU * TAKE FIRST REQUEST IN THE QUEUE 01530000
L CMSLCB,XR2 POINT XR2 AT THE LCB 01540000
L CMSPL,XR1 XR1 -> PLIST WITH ELIGIBLE READ 01550000
SPACE 01560000
CMSCHO EQU * SCHEDULE THE PARM LIST REQUEST 01570000
SPACE 01580000
ST CMSPL,XR1 SAVE PARM LIST ADDR 01590000
L PLTUBA(,XR1),XR2 POINT XR2 AT THE TUB 01600000
AIF (&NOM).M1200 01610000
MVC CMTCHR(1),TUBCHR(,XR2) MOVE TUB CHAR TO SAVE AREA M 01620000
AIF (&NOB).M1180 01620110
TBN TUBCHR(,XR2),TUBLNE BSCA LINE ? 2 01620120
JT CMTTAT NO-SHIP SAVE OF TUBCHR FIELD. 2 01620130
.M1180 ANOP 01620140
AIF (&NBFR).H4467 01620150
MVC TUBVHR(1,XR2),TUBCHR(,XR2) SAVE TUBCHR FIELD RM 01620200
.H4467 ANOP 01620300
AIF (&NSCTL).S5400 01630000
MVC CMSTMA(2),TUBTMA(,XR2) SAVE TERMINAL ADDRESS CM 01640000
.S5400 ANOP 01650000
CMTTAT EQU * * M 01655000
MVC SAVTA2(2),TUBTA2(,XR2) SAVE TERMINAL ATTRIBUTES M 01660000
.M1200 ANOP 01670000
CM3G1 EQU * TP REQUEST ROUTINE ENTRY POINT 01680000
* FOR RESCHEDULEING THE LINE 01690000
* LINE IS NOT BUSY 01700000
* XR1 CONTAINS ADDRESS OF THE PARAMETER LIST TO BE SCHEDULED 01710000
SPACE 01720000
L CMSDTF,XR2 POINT XR2 AT DTF 01730000
AIF (&NOB).C0474 01740000
AIF (&NOM).M1250 01750000
TBN $BDDEV(,DTF),BSCA BSCA DTF ? 2 01760000
JF CMNOBY NO-GO CHECK FOR GET OP CODE. 2 01770000
B CMTASV GO TO SAVE TAS BYTES. 2 01780000
SPACE 1 01790000
ST LCBPL@(,DTF),PL SAVE THE PARM LIST IN LCB. 2 01800000
AGO .C0474 01810000
.M1250 ANOP 01820000
B CMTASV NOW GO SET UP TAS SAVE AREAS. B 01830000
ST LCBPL@(,DTF),PL SAVE THE PARM LIST IN LCB. B 01840000
.C0474 ANOP 01850000
SPACE 01860000
CMNOBY EQU * LINE NOT BUSY 01870000
* DETERMINE IF OPERATION IS READ OR WRITE 01880000
SPACE 01890000
TBN PL$OPM(,XR1),OPGET IS IT READ 01900000
AIF (&NOM).M1254 01910000
BT CMREAD JUMP IF TRUE TO READ ROUTINE M 01920000
AGO .M1255 01930000
.M1254 ANOP 01940000
BT CMFORM BR IF READ TO FORM OP FOR MLMP.B 01950000
.M1255 ANOP 01960000
TITLE '$E085/CMWRIT----START-A-WRITE-OPERATION' 01970000
*********************************************************************** 01980000
* START A WRITE OPERATION ON THE TP LINE * 01990000
*********************************************************************** 02000000
SPACE 02060000
* XR1 POINTS TO THE PARM LIST 02070000
* XR2 POINTS TO THE DTF 02080000
SPACE 02090000
* FIRST SET UP PARAMETER LIST FOR MOVE OR TRANSLATE 02100000
SPACE 02110000
CMWRIT EQU * START WRITE OPERATION 02120000
AIF (&NOB).C0500 02130000
AIF (&ONE).C0480 02140000
TBN $BDDEV(,DTF),BSCA BSCA DTF ? 2 02150000
JF CMWMLT NO-GO TO HANDLE MLTA. 2 02160000
.C0480 ANOP 02170000
AIF (&N32).T0810 02180000
CLI CMSPHY,TUB5M2 THIS A 3270 ? 0B 02190000
TBN PL$OPC(,PL),OPUSER SYSTEM FUNCTION ? 0B 02200000
AIF (&MOD4 NE '1').LJ015 02201000
L PLTUBA(,PL),XR2 XR2 --> TUB 02202000
TBF TUBAT1(,XR2),TUBKNM AND NOT THE CONSOLE ? 02203000
L CMSLCB,XR2 XR2 --> BSCA DTF 02204000
.LJ015 ANOP 02205000
JC CMWXLT,FLSOHI NO-GO CHECK FOR TRANSLATION. 0B 02210000
CMW327 EQU * * 0B 02211000
* ------------------------------START--@07 02212000
AIF (&NSWL).T0805 02213000
AIF (&NCS).T0800 02214000
TBF $BDATR(,DTF),$BCMPT CONTROL STATION LINE ? 0B 02215000
JF CMB0C2 YES-CALL CONTROL STA. FORMAT 0B 02216000
.T0800 ANOP 02217000
B $CC4PI CALL PROGRAM INITIATION TO 0B 02230000
DC AL1(CC4S0) BRING IN 3275 SW FORMAT XIENT.0B 02240000
J CMWXLT GO CHECK FOR TRANSLATION. 0B 02241000
.T0805 ANOP 02242000
CMB0C2 EQU * * LOCAL 0B 02243000
B $CC4PI CALL PROGRAM INITIATION TO 0B 02244000
DC AL1(CC4B0) BRING IN 3270 FORMAT XIENT. 0B 02245000
* ------------------------------END----@07 02246000
SPACE 02250000
CMWXLT EQU * * 0B 02260000
.T0810 ANOP 02270000
AIF (&NAS).A0100 02280000
TBN $BDATT(,DTF),$BCASK IS THIS AN ASCII LINE, AND AB 02290000
TBF SAVTA1,TASTRN TAS SPECIFY TRANSLATE ? AB 02300000
JF CMWGOR NO--THEN JUST DO WRITE. AB 02310000
SPACE 02320000
AIF (&N32).T0900 02330000
* IF SYSTEM OR REFRESH OPTION TO A 3270, THEN THE DATA IS IN THE 0AB 02340000
* RESERVED PORTION OF THE BSCA LINE BUFFER. 0AB 02350000
SPACE 02360000
* RESERVED PORTION OF THE BSCA LINE BUFFER. 0AB 02370000
CLI CMSPHY,TUB5M2 THIS A 3270, AND 0AB 02375000
TBN PL$OPC(,PL),OPUSER SYSTEM FUNCTION ? 0AB 02380000
JC CMWREG,FLSOHI NO-GO USE REGULAR FIELDS. 0AB 02390000
MVC TRL+TLFRMA,LCBSRT(2,DTF) FROM MSG IS IN RESERVED BUFR.0AB 02400000
MVC TRL+TLTOL,LCBADJ(2,DTF) TRUE LENGTH IS IN THE LCB. 0AB 02410000
J CMWTBL GO TO FILL STANDARD TABLE DAT0AB 02420000
SPACE 02430000
.T0900 ANOP 02440000
AIF (&NAS).A0100 02450000
CMWREG EQU * REGULAR ADDRESS FILL VALUES. 0AB 02460000
MVC TRL+TLTOL,PLOUTL(2,PL) * AT START-UP TO TRANSLATE INTAB 02470000
MVC TRL+TLFRMA,PLRECA(2,PL) BUILD TRANSLATE PARAMETER LISTAB 02480000
TBN PLOPM(,PL),OPOLT ON LINE TEST REQUEST ? B 02490000
JF CMWTBL NO-SET UP STANDARD FIELDS. B 02500000
ALC TRL+TLFRMA(2),TWELVE BUMP PAST PARM LIST IN AREA. B 02510000
CMWTBL EQU * * AB 02520000
MVC TRL+TLTOA,LCBATL(2,DTF) * USE SPECIAL BLOCK SET ASIDE AB 02530000
LA TRL,XR1 LOAD REG TO POINT TO PARM LISTAB 02540000
B $CC4PI CALL IN TRANSIENT TRANSLATE AB 02550000
DC AL1(CC4JD) * ROUTINE. AB 02560000
SPACE 02570000
TBN TLRTC(,XR1),TLERR TRANSLATE ERROR ? AB 02580000
L CMSPL,PL POINT TO THE PARM LIST. AB 02590000
JF CMWGOR NO-GO GIVE OP TO MLMP. AB 02600000
B $CC4PI CALL TRANSIENT HANDLER. AB 02610000
DC AL1(CC4WR) REQUEST XLATE ERROR RTN. AB 02620000
SPACE 1 02630000
SBN LCBAT1(,DTF),LCBNTQ SET PARM LIST NOT QUEUED. AB 02640000
B CMRQBF EXIT HANDLING TP REQUEST. AB 02650000
SPACE 1 02660000
.A0100 ANOP 02670000
CMWGOR EQU * * B 02680000
B CMFORM GO TO GIVE OP REQUEST TO MLMP. B 02690000
SPACE 02700000
AIF (&ONE).C0500 02710000
EJECT 02715000
CMWMLT EQU * * 2 02720000
.C0500 ANOP 02730000
AIF (&NOM).M1300 02740000
* THIS SEGMENT IS THE MLTA WRITE SCHEDULER M 02741000
* FOR A WRITE IT IS DETERMINED WHETHER TO TRANSLATE THE DATA OR NOT M 02742000
* AFTER BEING MOVED TO THE LINE BUFFER, THE OP WILL BE ISSUED TO WRITEM 02743000
* THE DATA TO THE TERMINAL M 02744000
SPACE 02750000
AIF (&NSW).A5300 02760000
* IF THIS IS PUT DISCONNECT - THEN THERE IS NO DATA TO BE TRANSMIITEDSM 02780000
SPACE 02790000
TBN PLOPM(,XR1),OPDISC IS THIS PUT DISCONNECT SM 02800000
BT CMSIO JUMP IF PUT DISCONNECT SM 02810000
SPACE 02820000
.A5300 ANOP 02840000
SPACE 02850000
MVC TRL+TLFRMA(2),PLRECA(,XR1) MOVE FROM ADDR TO TRAN LIST. M 02860000
MVC TRL+TLTOA(2),$MDCRA(,XR2) MOVE TO ADDR TO TRAN/MOVE LIST M 02870000
SPACE 02880000
* INITIALIZE FROM LENGTH IN MOVE LIST TO THE SIZE OF THE LINE BUFFER M 02890000
* BYTES AVAILABLE IN LINE BUFFER IS STORED IN THE LCB M 02900000
SPACE 02910000
MVC TRL+TLTOL(2),LCBBFL(,XR2) MOVE SIZE OF LINE BUFFER TO M 02920000
* THE TRANS/MOVE LIST M 02930000
SPACE 02940000
MVI $MDCRL(,XR2),CMZERO SET DTF RECORD LENGTH TO ZERO M 02950000
TBN CMTCHR,TUBTYP IS IT TYPEWRITER TERMINAL M 02960000
JF CMPWLN JUMP IF NOT TYPEWRITER M 02970000
SPACE 02980000
AIF (&N1050).C5000 02990000
* HAVE TYPEWRITER DEVICE-MUST DETERMINE IF IT IS MULTI-COMPONENT0M 03020000
* TERMINAL AND IF YES - IS THE COMPONENT BEING WRITTEN TO A 0M 03030000
* TYPEWRITER COMPONENT 0M 03040000
SPACE 03050000
TBN CMTCHR,TUBMCT IS IT MCT 0M 03060000
TBF PL$MCT(,XR1),BIT5 IF THIS BIT IS OFF, THIS IS 0M 03070000
* * NOT A 1050 PRINTER. 0M 03080000
TBN PL$MCT(,XR1),BIT6 IF THIS BIT IS ON, 0M 03090000
* THIS IS NOT A 1050 PRINTER 0M 03100000
JT CMPWLN JUMP IF MCT AND NON-PRINTER 0M 03110000
SPACE 03120000
.C5000 ANOP 03140000
SPACE 03150000
* HAVE TYPEWRITER DEVICE - DETERMINE WHETHER TO ADD START OF LINE M 03160000
* AND/OR END OF LINE TYPEWRITER CONTROL CHARACTERS TO THE OUTPUT LINEM 03170000
SPACE 03180000
AIF (&NBFR).R5200 03190000
* FOR BUFFERRED RECEIVE TERMINAL - THERE IS NO NEED FOR IDLE CHARACTERM 03200000
* FOLLOWING THE CARRIAGE RETURN RM 03210000
* THEREFORE NEED TO ADD ONLY THE CARRAIGE RETURN BEFORE AND/OR AFTER RM 03220000
* THE USER DATA RM 03230000
MVI CMTYPZ,CMTYPL SET CONTROL CHAR LENGTH TO RM 03240000
* INCLUDE IDLES RM 03250000
TBN $MDTFR(,XR2),$MTBFR IS IT BUFFERRED RECEIVE TERM. RM 03260000
JF CMTYTS JUMP IF NOT BUFFERRED RECEIVE RM 03270000
SPACE 03280000
* HAVE BUFFERRED RECIEVE TERMINAL SO SET CONTROL CHARACTER LENGTH RM 03290000
* SUCH THAT IT DOES NOT INCLUDE THE IDLE CHARACTERS RM 03300000
SPACE 03310000
MVI CMTYPZ,CMTYBF SET CONTROL CHAR LENGTH TO RM 03320000
* EXCLUDE IDLE CHARACTERS RM 03330000
SPACE 03340000
.R5200 ANOP 03350000
CMTYTS EQU * TEST FOR DEVICE CONTROL CHARS M 03360000
TBF PLOPM(,XR1),OPSOL ARE START OF LINE CHARS WANTED M 03370000
JF CMTSEL JUMP IF NOT WANTED M 03380000
SPACE 03390000
* SEE IF ALREADY AT START OF LINE AND IDLES ARE NOT NEEDED M 03400000
SPACE 03410000
TBN CMTCHR,TUB@SL ARE WE AT START OF LINE M 03420000
TBF CMTCHR,TUBNID ARE IDLES NOT NEEDED M 03430000
JT CMTSEL JUMP IF AT START OF LINE AND NOM 03440000
* IDLES ARE NEEDED M 03450000
SPACE 03460000
* USER WANTS START OF LINE CONTROL CHARS M 03470000
SPACE 03480000
ALC $MDCRL(1,XR2),CMTYPZ ADD # CHARS TO DTF LENGTH M 03490000
SLC TRL+TLTOL(2),CMTYPZ SUBTRACT # CHAR FROM BYTES M 03500000
* * AVAILABLE IN LINE BUFFER M 03510000
SBN CMSLSW+1,CMASK SET OPSOL SWITCH NOT TO JUMP M 03520000
SPACE 03530000
* DETERMINE WHETHER TO ADD END OF LINE TYPEWRITER CONTROL CHARACTERS M 03540000
* TO THE USER MESSAGE M 03550000
SPACE 03560000
CMTSEL EQU * TEST FOR END OF LINE CHARS M 03570000
SBF CMTCHR,TUB@SL SET BIT TO INDICATE TERMINAL M 03580000
* NOT AT START OF LINE M 03590000
TBF PLOPM(,XR1),OPEOL ARE END OF LINE CHARS REQUESTEDM 03600000
JF CMPWLN JUMP IF NOT TO BE ADDED M 03610000
SPACE 03620000
* WE HAVE TYPERWRITER AND A USER WHO WANTS CCP TO APPEND TYPEWRITER M 03630000
* CONTROL CHARACTERS TO HIS MESSAGE M 03640000
* ADD 1 CARRIAGE RETURN AND 0 OR 15 IDLE CHARACTERS TO HIS MESSAGE M 03650000
SPACE 03660000
* ADD TO DTF LENGTH THE NBR OF CHARS ADDED M 03670000
* SUBTRACT THAT LENGTH FROM LENGTH AVAILABLE IN BUFFER M 03680000
* TURN TYPEWRITER SWITCH ON SO CHARACTERS WILL BE ADDED AT THAT POINT M 03690000
SPACE 03700000
SBN CMTCHR,TUB@SL SET BIT TO INDICATE TERM AT M 03710000
* START OF LINE 03720000
ALC $MDCRL(1,XR2),CMTYPZ ADD # CHARS TO DTF RECORD LNG. M 03730000
SLC TRL+TLTOL(2),CMTYPZ SUBTRACT THAT NUMBER FROM BYTESM 03740000
* AVAILABLE SITTING IN TRN/MV LSTM 03750000
SBN CMELSW+1,CMASK SET SWITCH TO FALL THRU M 03760000
SPACE 03770000
* DETERMINE LENGTH OF MOVE OR TRANSLATE M 03780000
* IF REQUEST LENGTH PLUS TYPEWRITER CONTROL CHARACTERS (IF ANY) IS M 03790000
* LESS THAN AVAILABLE BUFFER LENGTH - USE REQUESTED LENGTH M 03800000
* ELSE USE AVAILABLE LENGTH WHICH HAS ALREADY BEEN MODIFIED FOR ANY M 03810000
* TYPEWRITER CONTROL CHARACTERS THAT MAY BE NEEDED M 03820000
SPACE 03830000
* COMPARE REQUESTED LENGTH IN PARM LIST VS AVAILBALE LENGTH IN M 03840000
* TRANSLATE LIST. M 03850000
SPACE 03860000
CMPWLN EQU * COMPARE LENGTHS M 03870000
CLC PLOUTL(,XR1),TRL+TLTOL(2) COMPARE REQ VS AVAILABLE LENGTHM 03880000
JH CMTYSW JUMP IF WANT TO USE AVAILBLE M 03890000
* LENGTH /REQ GRTR AVAIL/ M 03900000
* AVAILABLE LENGTH ALREADY IN PARM LIST M 03910000
SPACE 03920000
* USE REQUESTED LENGTH M 03930000
SPACE 03940000
MVC TRL+TLTOL(2),PLOUTL(,XR1) MOVE REQ LENGTH TO TRN/MOVE LSTM 03950000
J CMSLSW JUMP TO TYPEWRITER SWITCH M 03960000
SPACE 03970000
CMTYSW EQU * M 03980000
SPACE 03990000
SBN PL$RTC(,XR1),RCXDTR SET DATA TRUNCATED RETURN CODE M 04000000
SPACE 04010000
* TYPEWRITER SWITCHES M 04020000
* IF ON /NO JUMP/ MOVE CONTROL CHARACTERS TO END OF LINE M 04030000
* OR START OF LINE AS APPROPRIATE M 04040000
* IF OFF /JUMP / JUMP AROUND ADDING OF CONTROL CHAR M 04050000
CMSLSW EQU * START OF LINE SWITCH M 04060000
JC CMELSW,X'00' IF ON JUMP TO END OF LINE SW. M 04070000
SPACE 04080000
* IF HERE - ADD CONTROL CHARS TO START OF LINE M 04090000
SPACE 04100000
L TRL+TLTOA,XR1 POINT XR1 AT TARGET ADDR M 04110000
B CMCRID BRANCH TO MOVE CARRIAGE RETURN M 04120000
* AND IDLE CHARACTERS M 04130000
SPACE 04140000
* DETERINE WHETHER FIRST CHARACTER IS TO BE CARRIAGE RETURN OR M 04150000
* IDLE CHARACTER. M 04160000
SPACE 04170000
TBN CMTCHR,TUBNID ARE IDLES NEEDED M 04180000
JF CMADDT JUMP IF IDLES NOT NEEDED M 04190000
MVI 0(,XR1),CMIDLE PLUG IDLE INTO FIRST POSITION M 04200000
SPACE 04210000
CMADDT EQU * ADD TO SIZE TO TRANSLATE/MOVE M 04220000
ALC TRL+TLTOA(2),CMTYPZ ADD # CHARS TO TARGET ADDR IN M 04230000
* TRANSLATE/MOVE LIST M 04240000
SBF CMSLSW+1,CMASK SET SWITCH TO JUMP M 04250000
SPACE 04260000
* SWITCH TO DETERMINE WHETHER TO ADD END OF LINE CONTROL CHARS OR NOT M 04270000
* DETERMINE WHETHER TO ADD M 04280000
SPACE 04290000
SPACE 04300000
CMELSW EQU * END OF LINE SWITCH M 04310000
JC CMTSTR,X'00' IF ON-JUMP TO TRANSLATE OR MOVEM 04320000
SPACE 04330000
L TRL+TLTOA,XR1 POINT XR1 AT 'TO' ADDR M 04340000
A TRL+TLTOL,XR1 ADD LENGTH OF MOVE SO XR1 IS M 04350000
* AT 1ST BYTE PAST DATA IN LINE BF 04360000
SPACE 04370000
B CMCRID BRANCH TO ADD CR AND IDLE CHARSM 04380000
SPACE 04390000
* TEST FOR TRANSLATE OR STRAIGHT MOVE M 04400000
SPACE 04410000
CMTSTR EQU * TEST FOR TRANSLATE M 04420000
SPACE 04430000
SBF CMTCHR,TUBNID SET OFF INDICATION IDLES NEEDEDM 04440000
SBF CMELSW+1,CMASK SET SWITCH TO JUMP M 04450000
SPACE 04460000
* FIRST ADD DATA LENGTH TO DTF LENGTH WHICH NOW SITS AT THE NUMBER M 04470000
* OF TYPEWRITER CONTROL CHARACTERS NEEDED IF ANY M 04480000
SPACE 04490000
ALC $MDCRL(,XR2),TRL+TLTOL(1) ADD DATA LENGTH TO DTF M 04500000
L CMSPL,XR1 POINT XR1 AT PARM LIST M 04510000
SPACE 04520000
AIF (&NMOVE).M5300 04530000
* TEST TRANSLATE BIT VM 04540000
* FOR SYSTEM ALWAYS TRANSLATE VM 04550000
SPACE 04560000
TBN SAVTA1,TASTRN DO WE TRANSLATE VM 04570000
TBF PLOPM(,XR1),OPREQR IS IT USER REQUEST VM 04580000
JT CMMOVE JUMP IF NO TRANSLATE VM 04590000
SPACE 04600000
.M5300 ANOP 04610000
* TRANSLATE DATA FROM REQUESTER RECORD AREA TO LINE BUFFER M 04620000
SPACE 04630000
LA TRL,XR1 POINT XR1 AT TRANSLATE TABLE M 04640000
MVC CMTWR(1),LCBELC(,XR2) MOVE TRANS TRANSIENT ID M 04650000
B $CC4PI BRANCH TO CALL IN TRANSIENT M 04660000
CMTWR DC AL1(0) TRANSLATE TRANSIENT ID M 04670000
SPACE 04680000
* XR1 NOW POINTS TO TRANSLATE TABLE AND NOT PARAMETER LIST M 04690000
* PLUG TRANSLATE RETURN CODE INTO RETURN CODE WORK AREA M 04700000
SPACE 04710000
TBN TLRTC(,XR1),TLERR WAS THERE ERROR IN TRANSLATION M 04720000
L CMSPL,XR1 POINT XR1 AT PARM LIST M 04730000
JF CMDOWR JUMP IF NO ERROR M 04740000
SPACE 04750000
* HAD TRANSLATE ERROR - CALL IN TRANSIENT TO HANDLE M 04760000
SPACE 04770000
B $CC4PI BRANCH TO BRING IN TRANSINET M 04780000
DC AL1(CC4WR) TRANLSATE ERROR TRANSIENT ID M 04790000
SPACE 04800000
J CMRQBF JUMP M 04810000
SPACE 04820000
AIF (&NMOVE).M5400 04830000
* MOVE DATA WITHOUT TRANSLATE FROM REQUESTER RECORD AREA TO LINE BFR.VM 04840000
SPACE 04850000
CMMOVE EQU * MOVE DATA TO LINE BUFFER VM 04860000
LA MVL,XR2 POINT XR2 AT MOVE PARM LIST VM 04870000
B $CC4MV BR TO MOVE ROUTINE VM 04880000
SPACE 04890000
.M5400 ANOP 04900000
CMDOWR EQU * START THE WRITE M 04910000
* BOTH READ AND WRITE USE SAME LOGIC SO FALL THROUGH TO READ START M 04920000
* OPERATION CODE M 04930000
L PLTUBA(,XR1),XR2 POINT XR2 AT THE TUB M 04940000
MVC TUBCHR(1,XR2),CMTCHR RESET TERMINAL CHARACTERISTICS M 04950000
L CMSDTF,XR2 POINT XR2 AT DTF M 04960000
TITLE '$E085/CMSIO/CMREAD----START-AN-MLTA-IO-OPERATION' 04970000
********************************************************************* M 04980000
* MLTA IOCS START I/O * M 04990000
********************************************************************* M 05000000
SPACE 05010000
* THIS SEGMENT STARTS ALL MLTA I/O - ALSO M 05020000
* THIS SEGMENT IS THE READ OPERATION SCHEDULER M 05030000
* THE OP CODE IS PLUGGED IN THE DTF - BEING FORMED BASED ON M 05040000
* THE PREVIOUS OPERATIONS ON THE LINE M 05050000
SPACE 05060000
* XR1 POINTS TO THE REQUEST WHICH IS BEING SCHEDULED M 05070000
SPACE 05080000
CMREAD EQU * READ SCHEDULER M 05090000
CMSIO EQU * START MLTA IO OPERATION M 05100000
B CMFORM BR TO FORM MLTA OP CODE M 05110000
B MLTIO1 BR TO IOCS M 05120000
B $CC4TT BRANCH TO TRACE ROUTINE M 05130000
DC AL1(TTMSIO) TRACE ID FOR MLTA START IO M 05140000
CLI $MDOSC(,XR2),CMZERO WAS START SUCCESSFUL M 05150000
JE CMPAII JUMP IF GOOD START M 05160000
SPACE 05170000
* BRING IN TRANSIENT TO ANALYZE THE NON-ZERO MLTA START CODE M 05180000
SPACE 05190000
B $CC4PI BR TO BRING IN TRANSIENT M 05200000
DC AL1(CC4SC) M 05210000
J CMPAII JUMP TO POST REQUESTOR M 05220000
.M1300 ANOP 05230000
MEND 05240000