|
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: 26162 (0x6632)
Types: s3xseg
Names: »S$E075«
└─⟦4498c64f7⟧ Bits:30009191 5704-sc2.V05.ccp
└─⟦95ee7795b⟧
└─⟦this⟧ »S$E075«
MACRO 00010000
.********************************************************************** 00020000
.* NAME: $E075 * 00030000
.********************************************************************** 00040000
$E075 00050000
GBLB &NOM,&NDME,&NSW,&NBFR,&NMOVE,&NSCTL,&N2741 00060000
TEXT 00070000
.* : 00080000
* R-01,C-00 00090000
AIF (&NOM).MEND 00110000
TITLE '$E075/CMMOPE---MLTA OP END HANDLING' 00120000
*********************************************************************** 00130000
* * 00140000
* NAME--CMMOPE * 00150000
* * 00160000
* TITLE--MLTA OP END ANALYSIS * 00170000
* * 00180000
* FUNCTION--ANALYSIS EACH OP END FOR A TP LINE AND DETERMINE WHAT * 00190000
* IF ANYTHING MUST BE DONE TO COMPLETE THE CURRENT TP * 00200000
* OPERATION. ROUTE COMPLETED OPERATION BACK TO THE USER. * 00210000
* RESCHEDULE WORK ON THE LINE IF NO MORE OP ENDS TO BE * 00220000
* HANDLED. * 00230000
* * 00240000
* OPERATION-- * 00250000
* * 00260000
* . IF ABORT OPERATION, HANDLE THE ABORT UNTIL IT IS * 00270000
* COMPLETE. THEN RESCHEDULE THE LINE. * 00280000
* * 00290000
* . IF STOP INVITE REQUEST CALL $CC4SQ * 00300000
* * 00310000
* . IF SWALLOW THE DATA OPERATION, THEN IGNORE DATA. * 00320000
* * 00330000
* . IF MLTA OLT OP END CALL TRANSIENT TO HANDLE THE * 00340000
* OPERATION. THEN GO TO SCHEDULE THE NEXT OPERATION. * 00350000
* * 00360000
* . FIND THE OP ENDED PARAMETER LIST AND SET ON THE POLL * 00370000
* SKIP BIT. * 00380000
* * 00390000
* . TRACE THE OP END AFTER CALLING CHECK THRU $CC4TT. * 00400000
* * 00410000
* . IF AN ERROR OCCURRED CALL $CC4MA. ON RETURN * 00420000
* EITHER POST THE RESULTS TO THE USER, RESCHEDULE THE * 00430000
* LINE, OR HANDLE THE DATA IN THE LINE BUFFER. * 00440000
* * 00450000
* . IF WRITE OP END, THEN * 00460000
* - SET UP THE RETURN CODE FOR THE RESULTS OF THE * 00470000
* OPERATION. * 00480000
* * 00490000
* - IF PUT-THEN-GET, THEN SET UP THE GET OPERATION IN * 00500000
* THE INTERNAL OP CODE, THEN RESCHEDULE THE LINE. * 00510000
* * 00520000
* - IF OPERATION IS COMPLETED SET UP TO POST THE * 00530000
* REQUESTOR OF THE RESULTS. * 00540000
* * 00550000
* . IF READ OP END, THEN * 00560000
* * 00570000
* - IF DATA MODE ESCAPE RECOGNIZED IN THE INPUT DATA * 00580000
* STREAM THEN SET UP POST OF THE COMMAND PROCESSOR. * 00590000
* * 00600000
* - IF VALID INPUT DATA, MOVE, TRANSLATE, TRUNCATE THE * 00610000
* DATA AS REQUIRED. * 00620000
* * 00630000
* . IF COMPLETED DATA OPERATION, THEN * 00640000
* - REMOVE THE TP REQUEST FROM THE LINE QUEUE. * 00650000
* - FREE UP PUT-NO-WAIT HOLD BUFFERS. * 00660000
* - POST THE REQUESTOR OF THE TP OPERATION THAT IT IS * 00670000
* COMPLETE. * 00680000
* * 00690000
* ENTRY POINT-- CMMOPE: HANDLE MLTA OP END. * 00700000
* * 00710000
* INPUT-- XR2 -> DTF THAT OP ENDED. * 00720000
* * 00730000
* OUTPUT-- * 00740000
* CMSDTF - ADDRESS OF DTF HANDLED FOR LAST OP END. * 00750000
* CMSPL - ADDRESS TO TP PARAMETER LIST FOR LAST OP END. * 00760000
* * 00770000
* EXTERNAL REFERENCES-- * 00780000
* $CC4SQ - MLTA STOP II QUEUE ANALYSIS TRANSIENT. * 00790000
* $CC4SK - MLTA SKIP BIT TRANSIENT. * 00800000
* $CC4T2 - MLTA OLT OP END TRANSIENT. * 00810000
* $CC4TT - CCP TRACE ROUTINE. * 00820000
* $CC4MA - MLTA ERP TRANSIENT. * 00830000
* $CC4JX - X IS APPROPRIATE TRANSLATE TRANSIENT. * 00840000
* $CC4WR - TRANSLATE ERROR TRANSIENT. * 00850000
* CMFMRT - FREEMAIN ROUTINE. * 00860000
* CMONSK - MLTA POLL LIST SKIP BIT ON ROUTINE. * 00870000
* CMWPGY - PUT-THEN-GET SUBROUTINE. * 00880000
* CMSTOR - DETERMINE PARM LIST STORAGE NEEDS. * 00890000
* CMGMRT - GETMAIN ROUTINE. * 00900000
* CMPOST - POST TP COMPLETE. * 00910000
* CMMVRT - INTERFACE TO CCP MOVE ROUTINE. * 00920000
* * 00930000
* EXIT, NORMAL--TO CMMTBY - TEST LINE BUSY FOR RESCHEDULING. * 00940000
* TO CMMSCH - RESCHEDULE WORK ON A LINE * 00950000
* TO CMPAII - POST REQUESTOR AFTER ERROR OP END. * 00960000
* * 00970000
*********************************************************************** 00980000
EJECT 00990000
CMMOPE EQU * * < ENTRY POINT > M 01000000
SPACE 01010000
******************************************************************* M 01020000
* MLTA ABORT CHECK AND HANDLING * M 01030000
******************************************************************* M 01040000
SPACE 01050000
TBN LCBATR(,XR2),LCBSTP WAS ABORT TO STOP READ M 01060000
JF CMSWL JUMP IF INDICATOR OFF M 01070000
SPACE 01080000
* BRING IN TRANSIENT TO HANDLE OP END FOR STOP READ REQUEST M 01090000
SPACE 01100000
SVC 0 ##### TRANSIENT CALL ####### M 01110000
DC AL1(CCPRIB) CCP SVC RIB. M 01120000
DC AL1(CC4SQ) TRANSIENT ID M 01130000
SPACE 01140000
CMSWL EQU * * LOCAL M 01150000
SPACE 01160000
* IGNORE THE OP END IS BOTH LCB SWALLOW AND BIT BUCKET BITS ARE ON M 01170000
* NO MATTER WHAT TYPE OF OPERATION WAS SCHEDULED M 01180000
SPACE 01190000
TBN LCBATR(,XR2),LCBSWL+LCBTBK IS OP END TO BE IGNORED M 01200000
JT CMSWLP JUMP IF IGNORE OP END M 01210000
SPACE 1 01220000
* IF 2741 BIT BUCKET BIT ON OR M 01230000
* IF SWALLOW SET AND THE OP END IS FOR AN INPUT OPERATION M 01240000
* THEN SWALLOW (BIT BUCKET) THE DATA M 01250000
SPACE 01260000
TBF $MDOPC(,XR2),MLWRIT ASSURE IT WAS NOT WRITE OP M 01270000
JF CMTABT JUMP IF WRITE M 01280000
SPACE 01290000
* HAVE NON-WRITE OP - IF SWALLOW OR BIT BUCKET ON M 01300000
* BIT BUCKET THE DATA THAT CAME IN M 01310000
SPACE 01320000
TBF LCBATR(,XR2),LCBSWL+LCBTBK ISBIT BUCKET OR SWALLOW ON M 01330000
JT CMTABT JUMP IF NEITHER SWALLOW OR BIT M 01340000
* BUCKET SET ON M 01350000
SPACE 01360000
******************************************************************* M 01370000
* BIT BUCKET THE DATA THAT JUST CAME IN * M 01380000
******************************************************************* M 01390000
SPACE 01400000
CMSWLP EQU * * LOCAL. 01410000
SBF LCBATR(,XR2),LCBSWL+LCBTBK RESET LCB IGNORE OP END BITS M 01420000
SPACE 01430000
* HAVE SWALLOW BIT SET - THUS MAY HAVE SKIP BIT OFF WHICH NEEDS TO BE M 01440000
* TURNED ON M 01450000
SPACE 01460000
* THIS TRANSIENT WILL SET ALL SKIP BITS ON FOR A POLLING LIST M 01470000
* SOME WILL BE TURNED BACK OFF WHEN WE RESCHEDULE THE LINE. M 01480000
SPACE 01490000
SVC 0 ##### TRANSIENT CALL ##### M 01500000
DC AL1(CCPRIB) CCP SVC RIB. M 01510000
DC AL1(CC4SK) SET POLL SKIP BITS M 01520000
SPACE 01530000
J CMJTBY JUMP TO TEST FOR LINE BUSY. M 01540000
EJECT 01550000
* IF OPERATION WAS SUCCESSFUL ABORT - THEN BR TO RESCHEDULE THE LINE M 01560000
SPACE 01570000
CMTABT EQU * * LOCAL M 01580000
CLI $MDOPC(,XR2),$MCABT WAS OP AN ABORT M 01590000
JNE CMDFSV JUMP IF NOT ABORT M 01600000
SPACE 01610000
* HAD ABORT ATTEMPT - IF RETURN CODE 44 - JUMP TO HANDLE M 01620000
SPACE 01630000
CLI $MDCMP(,XR2),$MCTNR WAS COMP CODE 44 M 01640000
JNE CMDFSV JUMP IF UNSUCCESSFUL ABORT M 01650000
SPACE 01660000
* HAD ABORT ATTEMPT M 01670000
* ABORT WAS SUCCESSFUL SO LINE IS NOW FREE TO SCHEDULE NEXT OP M 01680000
* IF HOLD BUFFER HAS BEEN GETMAINED FOR THIS LINE - FREEMAIN IT NOW M 01690000
SPACE 01700000
CLI LCBIBA-1(,XR2),NOBIT IS HOLD BUFFER POINTER NULL M 01710000
JE CMJPRS JUMP IF NO HOLD BUFFER M 01720000
SPACE 01730000
* HAVE HOLD BUFFER WHICH NEEDS TO BE FREEMAINED M 01740000
SPACE 01750000
L LCBIBA(,XR2),XR2 POINT XR2 AT HOLD BUFFER M 01760000
B CMFMRT BRANCH TO FREEMAIN M 01770000
SPACE 01780000
L CMSDTF,XR2 POINT XR2 BACK AT DTF M 01790000
MVI LCBIBA-1(,XR2),NOBIT SET HOLD BUFFER ADDR NULL M 01800000
SPACE 01810000
CMJPRS EQU * * LOCAL. 01820000
B CMMSCH BRANCH TO RESCHEDULE THE LINE M 01830000
SPACE 2 01840000
* DETERMINE IF OP END WAS FOR ONLINE TEST M 01850000
SPACE 01860000
CMDFSV EQU * * LOCAL. 01870000
SBN LCBATR(,XR2),LCBNIT SET INITIAL OP BIT ON M 01880000
TBN LCBATR(,XR2),LCBOLR TEST LCB BIT FOR ONLINE TEST M 01890000
JF CMPARM IF NOT OLT, JUMP TO WORK WITH M 01900000
* PARM LIST M 01910000
SPACE 01920000
* OP END WAS FOR ONLINE TEST REQUEST M 01930000
* FOR WHICH THERE IS NO PARM LIST M 01940000
SPACE 01950000
SVC 0 ###### TRANSIENT CALL ##### M 01960000
DC AL1(CCPRIB) CCP SVC RIB. M 01970000
DC AL1(CC4T2) OP END OF ONLINE TEST M 01980000
SPACE 01990000
CMJTBY EQU * * LOCAL. 02000000
B CMMTBY BRANCH TO TEST IF LINE IS BUSY M 02010000
EJECT 02020000
********************************************************************* M 02030000
* LOCATE OP ENDED PARAMETER LIST * M 02040000
********************************************************************* M 02050000
SPACE 02060000
* XR2 POINTS AT DTF FOR THE LINE THAT OP ENDED. M 02070000
SPACE 02080000
CMPARM EQU * * LOCAL. M 02090000
L LCBPLQ(,XR2),XR1 POINT XR1 AT 1ST PL IN QUEUE M 02100000
SPACE 02110000
******************************************************************** M 02120000
* SET UP FOR FINDING OF PARM LIST WHICH OP ENDED * M 02130000
******************************************************************** M 02140000
SPACE 02150000
AIF (&NSCTL).C0100 02160000
MVC CMSTMA(2),$MDTMA(,XR2) SAVE THE TERMINAL ADDR OF THE CM 02170000
* TERMINAL WHICH OP ENDED CM 02180000
SPACE 02190000
.C0100 ANOP 02200000
* SET UP TEST INSTRUCTION FOR EITHER A READ OR WRITE MLTA OP CODE M 02210000
* DEPENDING ON THE OP CODE IN THE DTF WHICH OP ENDED M 02220000
SPACE 02230000
MVI CMTBOP+1,OPGET SET UP TEST INSTR FOR READ M 02240000
SPACE 02250000
AIF (&NSW).S0100 02260000
SPACE 02270000
* WAS OP END FOR WRITE DISCONNECT TO MLTA SWITCHED LINE SM 02280000
SPACE 02290000
CLI $MDOPC(,XR2),$MWTDS WAS OP A WRITE DISCONNECT SM 02300000
JNE CMTSWR JUMP IF OP WAS NOT WRITE DISC SM 02310000
SPACE 02320000
* HAD OP END OF WRITE DISCONNECT SO SET LCBNIT TO INDICATE LINE DISC SM 02330000
SPACE 02340000
SBF LCBATR(,XR2),LCBNIT INDICATE LINE IS DISCONNECTED SM 02350000
J CMOPUT JUMP TO LOOK FOR WRITE OP END SM 02360000
SPACE 02370000
.S0100 ANOP 02380000
SPACE 02390000
CMTSWR EQU * * LOCAL. M 02400000
TBN $MDOPC(,XR2),MLWRIT WAS OP END FOR A WRITE M 02410000
JF CMMVSC JUMP IF NOT WRITE OP END M 02420000
CMOPUT EQU * * LOCAL. M 02430000
MVI CMTBOP+1,OPPUT SET UP TEST FOR WRITE OP END M 02440000
SPACE 02450000
* GET THE TERMINAL FEATURE TYPES BYTE FROM MLTA DTF FOR TESTING M 02460000
SPACE 02470000
CMMVSC EQU * * LOCAL. M 02480000
AIF (&NSCTL).C0200 02490000
MVC MLSTCL(1),$MDTFT(,XR2) SAVE TERMINAL FEATURES CM 02500000
.C0200 ANOP 02510000
EJECT 02520000
*********************************************************************** 02530000
* FIND PARAMETER LIST WITH OP CODE THAT MATCHES OP END * 02540000
*********************************************************************** 02550000
* XR1 POINTS AT FIRST PARM LIST IN LINE QUEUE M 02560000
SPACE 02570000
CMTBOP TBN PL$OPM(,XR1),# TEST FOR OP CODE MATCH M 02580000
AIF (&NSCTL).C0300 02590000
JF CMNXPM JUMP IF NO MATCH CM 02600000
SPACE 02610000
******************************************************************** 02620000
* FOUND PL WITH MATCHING OP CODE CM 02630000
******************************************************************** 02640000
SPACE 02650000
TBN MLSTCL,$MTPLT IS IT STATION CONTROL CM 02660000
JF CMMTCH JUMP IF NOT SINCE HAVE PL CM 02670000
SPACE 02680000
******************************************************************** 02690000
* STATION CONTROL -- ALSO SEARCH THE TUBS FOR THE PARAMETER CM 02700000
* LIST WHOSE TERMINAL ADDRESS MATCHES TERMINAL ADDR CM 02710000
* IN DTF WHICH OP ENDED. CM 02720000
******************************************************************** 02730000
SPACE 02740000
L PLTUBA(,XR1),XR2 POINT XR2 AT TUB. CM 02750000
CLC CMSTMA-1(1),TUBTMA-1(,XR2) COMPARE DTF TMA WITH TUB TMA CM 02760000
JE CMMTCH JUMP IF THEY MATCH CM 02770000
AGO .C0400 02780000
.C0300 ANOP 02790000
JT CMMTCH JUMP IF HAVE PARM LIST M 02800000
.C0400 ANOP 02810000
SPACE 02820000
* NO MATCH SO GET NEXT PARAMETER LIST IN QUEUE TO TEST AGAIN M 02830000
SPACE 02840000
CMNXPM EQU * * LOCAL. 02850000
L PLCHN(,XR1),XR1 POINT XR1 AT NEXT PL IN QUEUE M 02860000
B CMTBOP BRANCH TO TRY TO MATCH AGAIN M 02870000
EJECT 02880000
******************************************************************** M 02890000
* PUT RETURN CODE IN PARAMETER LIST * M 02900000
******************************************************************** M 02910000
SPACE 02920000
* XR1 POINTS AT THE OP ENDED PARM LIST M 02930000
SPACE 02940000
CMMTCH EQU * * LOCAL. M 02950000
SPACE 02960000
L CMSDTF,XR2 POINT XR2 AT DTF M 02970000
MVC CMSRTC(1),PL$RTC(,XR1) SAVE RETURN CODE FROM START OP.M 02980000
MVC PL$RTC(1,XR1),$MDCMP(,XR2) MOVE COMPLETION CODE TO PL M 02990000
SPACE 2 03000000
******************************************************************** M 03010000
* TRACE CALL * M 03020000
******************************************************************** M 03030000
SPACE 03040000
B CMTRCE CALL M 03050000
DC AL1(CCPRIB) * THE CCP M 03060000
DC AL1(TRRIB) * TRACE M 03070000
DC AL1(TTMOPN) * TP OP END. M 03080000
SPACE 2 03090000
AIF (&NSCTL).C0500 03100000
TBN PL$OPM(,XR1),OPGET WAS OP END FOR A READ CM 03110000
JF CMMCMP JUMP IF NOT READ CM 03120000
SPACE 03130000
******************************************************************** CM 03140000
* STATION CONTROL READ -- SET SKIP BIT * CM 03150000
******************************************************************** CM 03160000
SPACE 03170000
B CMONSK BR TO SET POLL SKIP BIT ON CM 03180000
.C0500 ANOP 03190000
SPACE 3 03200000
CMMCMP EQU * * LOCAL. M 03210000
SPACE 03220000
ST CMSPL,XR1 SAVE PARM LIST ADDR M 03230000
SPACE 03240000
SBF PL$RTC(,XR1),BIT1 SET BIT OFF TO FORM RET CODE M 03250000
SPACE 03260000
* TEST FOR TP ERROR (COMPLETION CODE X'40' OR X'42' ARE OK) M 03270000
SPACE 03280000
TBF PL$RTC(,XR1),MLSCCS TEST FOR SUCCESSFUL OP END M 03290000
JT CMMSCS JUMP IF SUCCESSFUL M 03300000
AIF (&N2741).T0100 03310000
SPACE 03320000
* IF TERMINAL INTERRUPT FROM 2741 - HANDLE AS GOOD OP END 4M 03330000
SPACE 03340000
CLI $MDTTP(,XR2),ML2741 IS IT 2741 4M 03350000
JNE CMMERR JUMP IF NOT 2741 4M 03360000
SPACE 03370000
CLI PL$RTC(,XR1),MLCITP WAS IT TERMINAL INTERRPUT 4M 03380000
TBN PL$OPM(,XR1),OPPUT WAS IT OUTPUT OPERATION 4M 03390000
JC CMSCC1,NONE+FALSE+HI+LO JUMP IF TERMINAL INTERRUPT 4M 03400000
* FROM THE 2741 4M 03410000
.T0100 ANOP 03420000
EJECT 03430000
*********************************************************************** 03440000
* TP ERROR - CALL TRANSIENT TO HANDLE 03450000
*********************************************************************** 03460000
SPACE 03470000
CMMERR EQU * * LOCAL. M 03480000
SVC 0 ###### TRANSIENT CALL ##### M 03490000
DC AL1(CCPRIB) CCP SVC RIB. M 03500000
DC AL1(CC4MA) MLTA ERROR HANDLER M 03510000
SPACE 03520000
* RETURN TO NSI - TO DEQUEUE THE CURRENT PARM LIST. M 03530000
* NSI+4 - TO RESCHEDULE WORK ON THE LINE. M 03540000
AIF (&NBFR).T0200 03550000
* NSI+8 - TO HANDLE SUCCESSFUL DATA RECEIVED. BM 03560000
* NSI+12 - TO POST PARM LIST AND NOT RESCHEDULE THE LINE.BM 03570000
.T0200 SPACE 03580000
*--> NSI 03590000
B CMMDEQ DEQUEUE THE PARAMETER LIST M 03600000
SPACE 03610000
*--> NSI+4 03620000
B CMMTBY GO TEST LINE FOR BUSY. M 03630000
AIF (&NBFR).T0300 03640000
.* THE FOLLOWING TWO BRANCHES ARE GENERATED ONLY FOR 2740 SYSTEMS BM 03650000
SPACE 03660000
*--> NSI+8 03670000
B CMMSCS B TO HANDLE AS IF SUCCESS BM 03680000
SPACE 03690000
*--> NSI+12 03700000
B CMPAII BRANCH AROUND RESCHEDULING BM 03710000
.T0300 ANOP 03720000
EJECT 03730000
********************************************************************* M 03740000
* SUCCESSFUL OP END FOR MLTA * M 03750000
********************************************************************* M 03760000
SPACE 03770000
CMMSCS EQU * * LOCAL. M 03780000
SPACE 03790000
* AT THIS POINT SET ANY BITS ON IN THE RETURN CODE FROM THE RETURN M 03800000
* CODE SAVED AS PART OF THE START OF THE OPERATION M 03810000
SPACE 03820000
SBN PL$RTC(,XR1),# RESET RETURN CODE FROM OP M 03830000
CMSRTC EQU *-2 Q BYTE OF SBN INSTRUCTION M 03840000
SPACE 03850000
CMSCC1 EQU * GOOD OP END BUT AT THIS LABEL M 03860000
* THE RETURN CODE IS NOT RESET M 03870000
* DETERMINE WHAT KIND OF OP COMPLETED BY CHECKING THE OP CODE M 03880000
* RESIDING IN THE PARAMETER LIST M 03890000
SPACE 03900000
TBN PL$OPM(,XR1),OPPUT WAS IT WRITE M 03910000
JF CMRDME BRANCH IF READ M 03920000
TITLE '$E075/CMMOPE---MLTA WRITE OP END' 03930000
****************************************************************** M 03940000
* MLTA WRITE OP END HANDLING * M 03950000
****************************************************************** M 03960000
SPACE 2 03970000
TBN PLOPC(,XR1),OPGET IF NOT A PUT THEN GET M 03980000
BF CMMDEQ GO DEQUEUE PARM LIST M 03990000
SPACE 04000000
B CMWPGY WRITE - CHECK PUT THEN GET M 04010000
SPACE 04020000
B CMMSCH RESCHEDULE THE LINE M 04030000
TITLE '$E075/CMMOPE---MLTA READ OP END' 04040000
****************************************************************** M 04050000
* MLTA READ OP END HANDLING * M 04060000
****************************************************************** M 04070000
SPACE 04080000
CMRDME EQU * * LOCAL. M 04090000
SPACE 04100000
* GET TUB ADDRESS FROM THE PARAMETER LIST M 04110000
SPACE 04120000
CLI PLOPC(,XR1),OPINV IS OPERATION AN INVITE M 04124000
L PLTUBA(,XR1),XR1 POINT XR1 TO TUB M 04130000
JE CMUGET YES. LEAVE TUBIIS ON M 04134000
SBF TUBAT2(,XR1),TUBIIS SET OFF INVITE SCHEDULED M 04140000
CMUGET EQU * M 04144000
MVC SAVTA2(2),TUBTA2(,XR1) MOVE TERM ATTR TO SAVE AREA M 04150000
EJECT 04160000
AIF (&NDME).D0100 04170000
******************************************************************** DM 04180000
* DATA MODE ESCAPE CHECK * DM 04190000
******************************************************************** DM 04200000
SPACE 04210000
* IF THIS TERMINAL IS IN DATA MODE AND IS ALSO A REQUESTING TERMINAL DM 04220000
* FOR THE PROGRAM TO WHICH IT IS CURRENTLY ALLOCATED - THEN CM MUST DM 04230000
* CHECK FOR A DATA MODE ESCAPE COMMAND DM 04240000
SPACE 04250000
TBF TUBAT2(,XR1),TUBCMD TUB NOT IN COMMAND MODE, BUT DM 04260000
TBN TUBAT2(,XR1),TUBDTA * IS IN DATA MODE, AND DM 04270000
TBN TUBAT1(,XR1),TUBREQ * IS REQUESTER OF PROGRAM ? DM 04280000
JF CMMDAT JUMP IF NOT DATA MODE ESCAPE. DM 04290000
SPACE 04300000
* BUILD TRANSLATE LIST TO TRANSLATE 1ST 6 BYTES OF THE RECORD. O DM 04310000
SPACE 04320000
* USE THE SPECIAL TRANSLATE LIST PROVIDED JUST FOR THIS PURPOSE. DM 04330000
* ALL FIELDS IN THE TRANSLATE LIST ARE SET EXCEPT FOR THE FROM ADDR. DM 04340000
SPACE 04350000
LA CMDMTL,XR1 POINT TO XLATE PARM LIST. DM 04360000
MVC TLFRMA(2,XR1),$MDCRA(,XR2) MOVE 'FROM' ADDR TO TL DM 04370000
MVC CMTDME(1),LCBLLE(,XR2) MOVE TRANSLATE TRANSIENT ID DM 04380000
SVC 0 ##### TRANSIENT CALL ##### DM 04390000
DC AL1(CCPRIB) CCP SVC RIB. DM 04400000
CMTDME DC AL1(0) TRANSLATE TRANSIENT ID DM 04410000
SPACE 04420000
* COMPARE TRANSLATE INPUT AGAINST DATA MODE ESCAPE COMMAND SEQUENCE DM 04430000
SPACE 04440000
CLC CMDMEB+5(6),CMDME CHECK FOR DME COMMAND DM 04450000
JNE CMMDAT JUMP IF NOT DATA MODE ESCAPE DM 04460000
SPACE 3 04470000
******************************************************************** DM 04480000
* DATA MODE ESCAPE SEQUENCE RECEIVED * DM 04490000
******************************************************************** DM 04500000
SPACE 1 04510000
L CMSPL,XR1 POINT XR1 AT PARM LIST DM 04520000
L PLTUBA(,XR1),XR2 POINT XR2 AT TUB DM 04530000
SBN TUBAT2(,XR2),TUBCMD PUT TUB IN COMMAND INTERRUPT DM 04540000
* * MODE (CIM). DM 04550000
ST TUBDM@(,XR2),XR1 STORE PARM LIST ADDR IN TUB DM 04560000
L TUBDTF(,XR2),XR2 XR2--> DTF FOR THIS LINE. DM 04570000
B CMMDEQ BR TO DEQUEUE THE PARM LIST DM 04580000
EJECT 04590000
.D0100 ANOP 04600000
CMMDAT EQU * * LOCAL. M 04610000
L CMSPL,XR1 POINT XR1 AT PARM LIST. M 04620000
SPACE 04630000
******************************************************************** M 04640000
* INVITE INPUT OP END -- COMPARE HOLD BUFFER SPACE AVAIL TO NEED * M 04650000
******************************************************************** M 04660000
SPACE 04670000
B CMSTOR DETERMINE STORAGE NEEDED BY OP.M 04680000
SPACE 04690000
B CMGBUF GO GET LEAST AMOUNT NEEDED. M 04700000
SPACE 04710000
L CMSPL,XR1 XR1--> TP PARM LIST. M 04720000
SPACE 04730000
* MOVE THE HOLD BUFFER ADDRESS TO THE PARM LIST M 04740000
SPACE 04750000
MVC PLRECA(2,XR1),LCBIBA(,XR2) MOVE HOLD BUF ADDR TO PL M 04760000
MVI LCBIBA-1(,XR2),NOBIT ZERO HIGH ORDER BYTE OF BUF AD M 04770000
SPACE 04780000
******************************************************************** M 04790000
* SET UP PARAMETER LIST FOR MOVE OR TRANSLATE * M 04800000
******************************************************************** M 04810000
SPACE 04820000
* ANALYZE THE RECORD LENGTH REQUESTED BY THE USER AGAINST THE RECORD M 04830000
* LENGTH ACTUALLY RECEIVED AS A RESULT OF THE READ M 04840000
* IF RECEIVED EQUAL OR LESS THAN REQUESTED - GIVE USER ONLY WHAT RECV M 04850000
* IF RECEIVED GREATER THAN LENGTH REQUESTED, TRANSLATE ONLY UP TO M 04860000
* LENGTH REQUESTED BY USER AND PUT INDICATION IN RETURN CODE THAT M 04870000
* ALTHOUGH READ WAS SUCCESSFUL, TERMINAL OPERATOR TRANSMITTED MORE M 04880000
* DATA THAN WAS REQUESTED BY THE USER M 04890000
SPACE 04900000
* MOVE IN 'FROM' AND 'TO' ADDRESSES WHICH ARE THE SAME FOR BOTH THE M 04910000
* TRANSLATE AND THE MOVE LIST M 04920000
SPACE 04930000
MVC #CMMVL+MVLFRA(2),$MDCRA(,XR2) MOVE FROM ADDR TO MV LIST. M 04940000
MVC #CMMVL+MVLTOA(2),PLRECA(,XR1) MOVE TO ADDR TO MOVE LIST. M 04950000
SPACE 04960000
AIF (&NMOVE).F0100 04970000
* DETERMINE IF TRANSLATE WAS REQUESTED VM 04980000
* FOR SYSTEM REQUEST - ALWAYS TRANSLATE VM 04990000
SPACE 05000000
TBF PLOPM(,XR1),OP$SYS IS IT USER REQUEST, AND VM 05010000
TBN SAVTA1,TASTRN IS DON'T TRANSLATE SPECIFIED ?VM 05020000
JT CMRMOV YES-JUMP TO STRAIGHT MOVE. VM 05030000
.F0100 ANOP 05040000
EJECT 05050000
******************************************************************** M 05060000
* TRANSLATE * M 05070000
******************************************************************** M 05080000
SPACE 05090000
MVC #CMTRL+TLFRML(2),$MDCRL(,XR2) 'FROM' AREA LENGTH TO TL M 05100000
MVC #CMTRL+TLTOL(2),PLINL(,XR1) 'TO' AREA LENGTH TO TL M 05110000
SPACE 05120000
* DETERMINE IF UPPER OR LOWER CASE REQUESTED. M 05130000
* FOR SYSTEM REQUEST - ALWAYS TRANSLATE TO UPPER CASE. M 05140000
SPACE 05150000
TBF PLOPM(,XR1),OP$SYS IS IT USER REQUEST, AND M 05160000
TBN SAVTA1,TASCAS * LOWER CASE XLATE SPECIFIED ? M 05170000
LA #CMTRL,XR1 POINT XR1 AT TRANSLATE LIST M 05180000
SPACE 05190000
* MOVE IN ID OF UPPER CASE TRANSLATE TRANSIENT M 05200000
SPACE 05210000
MVC CMTRD(1),LCBLCE(,XR2) MOVE UPPER CASE TRANSIENT ID M 05220000
JF CMDOTR JUMP IF NOT USER LOWER CASE XL.M 05230000
SPACE 05240000
* MOVE IN TRANSIENT ID OF TRANSLATE TRANSIENT FOR LOWER CASE EBCDIC M 05250000
SPACE 05260000
MVC CMTRD(1),LCBLLE(,XR2) MOVE IN LOWER CASE TRANS ID M 05270000
SPACE 05280000
* TRANSLATE THE DATA FROM THE LINE BUFFER TO THE RECORD AREA POINTED M 05290000
* TO BY THE PARAMETER LIST M 05300000
* THE TRANSLATE ROUTINE WILL ALWAYS POST CLEAR THE INPUT AREA TO BLKS M 05310000
SPACE 05320000
CMDOTR EQU * * LOCAL M 05330000
SVC 0 ###### TRANSIENT CALL ##### M 05340000
DC AL1(CCPRIB) CCP SVC RIB. M 05350000
CMTRD DC AL1(0) TRANSLATE TRANSIENT ID M 05360000
SPACE 05370000
TBN TLRTC(,XR1),TLERR WAS THERE TRANSLATE ERROR M 05380000
* X'10' - INVALID CHAR REPLACED M 05390000
L CMSPL,XR1 POINT XR1 AT PARM LIST M 05400000
JF CMTCR JUMP IF NO TRANSLATE ERROR M 05410000
SPACE 05420000
* HAD TRANSLATE ERROR. M 05430000
SPACE 05440000
SVC 0 ###### TRANSIENT CALL ###### M 05450000
DC AL1(CCPRIB) CCP SVC RIB. M 05460000
DC AL1(CC4WR) TRANSLATE ERROR TRANSIENT ID M 05470000
SPACE 05480000
* RETURN TO NSI - TO DEQUEUE AND HANDLE AS A USER ERROR. M 05490000
* NSI+4 - TO HANDLE AS TERMINAL IN CCP ERP. M 05500000
SPACE 05510000
*--> NSI. M 05520000
B CMMDEQ JUMP AND HANDLE AS TP ERROR M 05530000
SPACE 1 05540000
*--> NSI+4. M 05550000
B CMMSCH BR TO RESCHEUDLE THE LINE M 05560000
EJECT 05570000
******************************************************************** M 05580000
* IF LAST CHARACTER OF THIS MESSAGE A CARRIAGE RETURN, SET * M 05590000
* TUB BIT SO IDLES WILL BE SENT WITH NEXT MESSAGE. * M 05600000
******************************************************************** M 05610000
SPACE 1 05620000
CMTCR EQU * * LOCAL M 05630000
L PLTUBA(,XR1),XR1 POINT XR1 AT THE TUB M 05640000
SBF TUBCHR(,XR1),TUB@SL+TUBNID SET OFF LINE LOCATION BITS M 05650000
TBN #CMTRL+TLRTC,TLCREL WAS LAST CHAR A CARRIAGE RET M 05660000
JF CMNOCR JUMP IF NOT CARRIAGE RETURN M 05670000
SPACE 05680000
* LAST CHARACTER TRANSLATED WAS CARRIAGE RETURN SO TYPEWRITER M 05690000
* IS AT THE START OF A NEW LINE. M 05700000
SPACE 05710000
SBN TUBCHR(,XR1),TUB@SL SET AT START OF LINE BIT ON M 05720000
SPACE 05730000
* DETERMINE FROM LENGTH OF INPUT WHETHER IDLE CHARACTERS ARE STILL M 05740000
* NEEDED AT BEGINNING OF NEXT OUTPUT. (MUST HAVE TIME FOR CARRIAGEM 05750000
* TO RETURN TO HOME POSITION.) M 05760000
AIF (&NBFR).T0400 05770000
* BUFFERED RECEIVE TERMINALS DO NOT NEED IDLE CHARACTERS FOR CR. BM 05780000
SPACE 05790000
L CMSDTF,XR2 POINT XR2 AT THE DTF BM 05800000
TBF $MDTFR(,XR2),$MTBFR BUFFERED RECEIVE, OR LESS BM 05810000
CLI #CMTRL+TLTOL,CMCRTM THAN MAX HANDLED W/O IDLES ? BM 05820000
JC CMNOCR,ANY+LO+FALSE JUMP-LESS THAN MAX/OR BUFF RCVBM 05830000
AGO .T0500 05840000
.T0400 ANOP 05850000
SPACE 05860000
CLI #CMTRL+TLTOL,CMCRTM LESS THAN MAX HANDLED W/O IDLESM 05870000
JL CMNOCR JUMP-LESS THAN MAX W/O IDLES. M 05880000
.T0500 ANOP 05890000
SPACE 05900000
* INPUT LINE FOLLOWED BY CARRIAGE RETURN INDICATES THAT IDLES ARE M 05910000
* NEEDED ON NEXT OUTPUT TO THIS TERMINAL. M 05920000
SPACE 05930000
SBN TUBCHR(,XR1),TUBNID SET ON IDLES NEEDED BIT M 05940000
SPACE 05950000
CMNOCR EQU * * LOCAL M 05960000
AIF (&NMOVE).F0200 05970000
J CMSEFL JUMP TO SET THE LGTH FOR USER VM 05980000
EJECT 05990000
******************************************************************** VM 06000000
* PERFORM STRAIGHT MOVE ON DATA WITHOUT TRANSLATING OR ANALYZING IT VM 06010000
* NOTE: NO CLEARING OF END OF SHORT RECORD IS DONE. VM 06020000
******************************************************************** VM 06030000
SPACE 06040000
CMRMOV EQU * * LOCAL. VM 06050000
SPACE 06060000
* DETERMINE WHICH IS LESS - THE LENGTH OF THE RECORD REQUESTED, OR VM 06070000
* THE LENGTH OF THE DATA KEYED. USE THE LESSER OF THE TWO. VM 06080000
SPACE 06090000
MVC #CMMVL+MVLTOL(2),$MDCRL(,XR2) USE ACTUAL LENGTH. VM 06100000
CLC $MDCRL(2,XR2),PLINL(,XR1) COMPARE ACTUAL VS ASKED LGTH VM 06110000
JNH CMDOMV JUMP IF ACTUAL LESS OR EQUAL. VM 06120000
SPACE 06130000
* USE REQUESTED LENGTH. VM 06140000
SPACE 06150000
MVC #CMMVL+MVLTOL(2),PLINL(,XR1) USE REQUESTED RECORD LGTH. VM 06160000
SPACE 06170000
CMDOMV EQU * * LOCAL VM 06180000
MVI #CMMVL+MVLTYP,NOBIT SET TYPE FOR NO ATR SWAP. VM 06190000
B CMMVRT BR TO MOVE ROUTINE VM 06200000
.F0200 ANOP 06210000
EJECT 06220000
******************************************************************** M 06230000
* COMPARE LENGTH REQUESTED VS LENGTH RECEIVED AND IF RECEVIED GREATER M 06240000
* SET BIT ON IN RETURN CODE TO INDICATE MESSAGE TRUNCATED M 06250000
******************************************************************** M 06260000
SPACE 06270000
CMSEFL EQU * * LOCAL. M 06280000
L CMSPL,XR1 POINT TO THE TP PARM LIST. M 06290000
MVC PLEFFL(2,XR1),#CMTRL+TLTOL MOVE EFFECTIVE READ LENGTH M 06300000
CLC PLEFFL(2,XR1),PLINL(,XR1) COMPARE ACTUAL VS ASKED LENGTH M 06310000
JNH CMMDEQ JUMP TO DEQ IF ACTUAL LT OR EQ.M 06320000
SBN PL$RTC(,XR1),RCXDTR SET DATA TRUNCATED. ACTUAL GT. M 06330000
MVC PLEFFL(2,XR1),PLINL(,XR1) SET EFFECTIVE LENGTH TO ASKED M 06340000
TITLE '$E075/CMMOPE---MLTA OP END HANDLING, DEQUEUE PARM LIST' 06350000
******************************************************************** M 06360000
* DEQUEUE READ OR WRITE MLTA PARAMETER LIST * M 06370000
******************************************************************** M 06380000
SPACE 06390000
* TAKE CHAIN ADDR POINTER FROM THIS PARM LIST AND PLACE IN CHAIN ADDR M 06400000
* OF PARM LIST THAT POINTED TO THIS PARM LIST. M 06410000
SPACE 06420000
CMMDEQ EQU * * WITHIN CMMOPE. M 06430000
B CMDEQ GO TO DEQUEUE SUBROUTINE. M 06440000
SPACE 06450000
B CMPOST POST REQUESTOR AS NECESSARY M 06460000
SPACE 06470000
B CMMSCH RESCHEDULE THE LINE M 06480000
.MEND ANOP 06490000
MEND 06500000