|
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: 34544 (0x86f0)
Types: s3xseg
Names: »S$E092«
└─⟦827b5bd03⟧ Bits:30009184 5702-sc1.V16.ccp
└─⟦f17e99db6⟧
└─⟦this⟧ »S$E092«
MACRO 00010000
.********************************************************************** 00020000
.* NAME: $E092 V-15, M-00. * 00040000
.********************************************************************** 00650000
$E092 00660000
GBLB &NOB,&NSWL,&NTSP,&N32,&NAS,&MIN,&NMSG,&NCS,&NPP,&NMP 00670000
GBLB &N37,&N41,&NRUF,&MOD4 00690000
LCLA &MIX 00710000
TEXT 00720000
* R-15,C-00 CHANGE LEVEL 00730000
AIF (&NOB).C0580 00760000
TITLE '$E092/CMFVFY---FINAL-OP-CODE-VERFICATION' 00770000
* FINAL VERIFICATION OF OP CODE AND RECORD LENGTH BEFORE IOS CALL B 00780000
SPACE 00790000
CMFVFY EQU * * B 00800000
TBF LCBAT2(,DTF),LCBABT OPERATION AN ABORT, OR B 00810000
TBF LCBAT1(,DTF),LCBEOT SEARCH FOR EOT INDICATED ? B 00820000
JT CMFVUR NO-GO USE USER RECORD AREA. B 00830000
MVC $BDREL(2,DTF),CC0001 SET RECORD LENGTH TO ONE. B 00840000
* -----START-------------------@04 00841000
L $BDWKA(,DTF),WKA XR1-->WORK AREA B 00842000
MVI WKERRD(,WKA),X'01' SET RETRY COUNT TO 1 @05 00843000
L LCBPL@(,DTF),PL XR1--> PARM LIST B 00844000
* ------END--------------------@04 00845000
MVC $BDWKB(2,DTF),FNDEOT USE DUMMY DATA AREA TO FIND EOTB 00850000
TBN LCBOPC(,DTF),OPPUT PUT OP CODE ? B 00860000
JT CMFVPT YES-MUST BE ABORT, GO SEND EOT.B 00870000
J CMBIOS GO TO CALL MLMP IOCS. B 00880000
SPACE 00890000
CMFVUR EQU * * B 00900000
MVC $BDWKB(2,DTF),PLRECA(,PL) FILL IN DATA AREA @ IN DTF. B 00910000
TBN $BDATT(,DTF),$BCINP GET OPERATION ? B 00920000
JF CMFVPT NO-GO SET UP FINAL PUT DTF. B 00930000
TBN PLOPC(,PL),OPRVI RVI B 00940000
TBF PLOPC(,PL),OPORDR-OPRVI * SEND OP CODE ? B 00950000
JF CMFGIL NO-GO GET INPUT LENGTH. B 00960000
SBN LCBOPC(,DTF),LCBRVI SET SEND RVI INDICATOR FOR MLMPB 00970000
CMFGIL EQU * * B 00980000
&MIX SETA &NCS+&NSWL 00990000
AIF (&MIX EQ '2').T1200 01000000
TBN LCBAT2(,DTF),LCBRCI RECEIVE INITIAL ON A C/SB 01010000
&MIX SETA &NPP+&NMP 01020000
AIF (&MIX EQ '2').T1100 01030000
TBN $BDATR(,DTF),$BCSWI MULTI-TERMINAL LINE ? C/SLB 01040000
.T1100 ANOP 01050000
JT CMBIOS YES-GO TO BSCA IOCS CALL. C/SB 01060000
.T1200 ANOP 01070000
B CMGINL GO TO RTN TO SET THE RECORD LENB 01080000
SPACE 01090000
J CMBIOS GO TO BSCA IOCS CALL. B 01100000
SPACE 01110000
CMFVPT EQU * * B 01120000
MVI $BDOPC(,DTF),$BOPUT SET OP CODE TO NORMAL PUT. B 01130000
MVI $BDCMP(,DTF),$BCREQ SET CMP TO OP REQUESTED. B 01140000
TBN LCBAT2(,DTF),LCBSET SEND EOT ORDERED ? B 01150000
JT CMFVET YES-GO SETUP SEND EOT. B 01160000
MVC $BDREL(2,DTF),PLOUTL(,PL) PUT OUTL INTO DTF RECORD LEN. B 01170000
TBN PLOPM(,PL),OPOLT ON LINE TEST REQUEST ? B 01180000
JF CMFNLT NO-JUMP PAST OLT CODE. B 01190000
MVC $BDRFT(2,DTF),$BDWKB(,DTF) FILL IN MLMP OLT PARM LIST @. B 01200000
ALC $BDWKB(2,DTF),TWELVE BUMP PAST OLT PARM LIST IN AREAB 01210000
CMFNLT EQU * * B 01220000
SPACE 01230000
AIF (&N32).T1300 01240000
* IF SYSTEM REQUEST OR REFRESH OPERATION, THEN USE RESERVED AREA IN0B 01250000
* THE LINE BUFFER. 0B 01260000
SPACE 01270000
CLI CMSPHY,TUB5M2 THIS A 3270 ? 0B 01280000
TBN PL$OPC(,PL),OPUSER SYSTEM FUNCTION ? 0B 01290000
AIF (&MOD4 NE '1').LJ020 01291000
L PLTUBA(,PL),TUB XR1 --> TUB 01292000
TBF TUBAT1(,TUB),TUBKNM AND NOT THE CONSOLE ? 01293000
L LCBPL@(,DTF),PL XR1 --> PARM LIST 01294000
.LJ020 ANOP 01295000
JC CMFVMD,FLSOHI NO-GO VERIFY THE MODE. 0B 01300000
MVC $BDWKB(2,DTF),LCBSRT(,DTF) SET CORRECT ADDRESS FOR OUTPU0B 01310000
MVC $BDREL(2,DTF),LCBADJ(,DTF) USE CORRECT LENGTH OF THE DAT0B 01320000
CMFVMD EQU * * 0B 01330000
.T1300 ANOP 01340000
AIF (&NAS).A0200 01350000
SPACE 01360000
* IF THIS IS AN ASCII TRANSLATE SITUATION, THEN USE RESERVED ASCII AB 01370000
* TRANSLATION BUFFER AS FROM ADDRESS. AB 01380000
SPACE 01390000
TBN $BDATT(,DTF),$BCASK ASCI LINE, AND AB 01400000
TBF SAVTA1,TASTRN * TRANSLATION DONE ? AB 01410000
JF CMFVOP NO-GO VERIFY OP CODE. AB 01420000
MVC $BDWKB(2,DTF),LCBATL(,DTF) USE ASCI XLATE BUFFER IN WKB. B 01430000
CMFVOP EQU * * AB 01440000
.A0200 ANOP 01450000
AIF (&N32).T1400 01460000
TBN PLOPC(,PL),OPGET GET TO BE PERFORMED NEXT ? 0B 01470000
JT CMFPEW YES-GO DO PUT EOT TO WACK. 0B 01480000
TBN PLOPC(,PL),OPMSG IS OP REQUESTED A 0B 01490000
TBF PLOPC(,PL),OPORDR-OPRUF * PUT-EOT? @18 01500000
SPACE 1 01510000
* SET PUT-EOT TO ACK OR WACK FOR 3270 SYSTEM FOR PUT-MSG. 0B 01520000
SPACE 1 01530000
JF CMFPT0 NO-NOT PUT-MSG, USE REGULAR OP0B 01540000
CMFPEW EQU * * 0B 01550000
L PLTUBA(,PL),TUB POINT TO THE TUB. 0B 01560000
CLI TUBPHY(,TUB),TUB5M2 3270 SYSTEM ? 0B 01570000
L LCBPL@(,DTF),PL XR1--> PARAM LIST 01575000
JH CMFPT0 NO-GO CHECK FOR PUT OF ZERO LE0B 01580000
MVI $BDOPC(,DTF),$BOPEW SET PUT-EOT TO ACK/WACK. 0B 01590000
SBN LCBAT2(,DTF),LCBSET SET SEND EOT IND. 0B 01600000
TBN PL$OPC(,PL),OPUSER SYSTEM OP? 01602000
JT CMBIOS YES-CALL MLMP IOCS 01603000
J CMFVPM GO CHECK LENGTHS 01604000
SPACE 1 01605000
J CMBIOS GO CALL MLMP IOCS. 0B 01610000
SPACE 1 01620000
CMFPT0 EQU * * 0B 01630000
.T1400 ANOP 01640000
TBF PL$OPC(,PL),OPUSER USER FUNCTION, AND B 01660000
TBF PLOPC(,PL),OPMSG RECORD MODE ? B 01670000
JT CMFVRC YES-GO HANDLE RECORDS. B 01680000
TBN PLOPC(,PL),OPMSG IS OP REQUESTED A B 01690000
* -----START-------------------@06 01695000
TBF PLOPC(,PL),OPORDR-OPRUF * PUT-EOT ? B 01700000
* -----END---------------------@06 01705000
CLC $BDREL(2,DTF),CC0000 ZERO LENGTH PUT-MSG ? B 01710000
JC CMFVPB,FLSNEQ NO-GO SET PUT BLOCK OP CODE. B 01720000
SBN LCBAT2(,DTF),LCBSET SET SEND EOT IND. B 01730000
CMFVET EQU * * B 01740000
TBN LCBAT2(,DTF),LCBABT ABORT OF A B 01741000
TBN LCBOPC(,DTF),OPPUT * PUT? B 01742000
JF CMFABT NO-CONTINUE B 01743000
L $BDWKA(,DTF),WKA XR1-->WORK AREA B 01744000
MVI WKERRD(,WKA),NOBIT ZERO RETRY COUNT IN WORK AREA B 01745000
MVC DCOUNT(2,WKA),X$FFFC SET DELAY COUNT VERY HIGH B 01746000
J CMFRTN GO POST AS NECESSARY B 01747000
CMFABT EQU * * B 01748000
MVI $BDOPC(,DTF),$BOPEF SET PUT END OF FILE OP CODE B 01750000
J CMFAKE GO FAKE CALL TO MLMP, FORCE CHKB 01760000
SPACE 01770000
CMFVPB EQU * * B 01780000
MVI $BDOPC(,DTF),$BOPEB SET OP CODE TO PUT END OF BLOCKB 01790000
CMFVPM EQU * * 01795000
CLC PLOUTL(2,PL),LCBKLC(,DTF) OUTL GREATER THAN BLOCK LEN ? B 01800000
JNH CMBIOS NO-GO CALL MLMP IOCS. B 01810000
MVC $BDREL(2,DTF),LCBKLC(,DTF) TRUNCATE TO BLOCK LENGTH. B 01820000
J CMFVSM GO SET TRUNCATED IND. B 01830000
SPACE 01840000
CMFVRC EQU * * B 01850000
L PLTUBA(,PL),TUB LOAD THE TUB REG. B 01860000
TBF SAVTA2,TASITB+TASPAN+TASVRL MLMP VARIABLE SUPPORT ? B 01870000
CLC $BDREL(2,DTF),TUBRCL(,TUB) OUTL LT TAS RECORD LEN ? B 01880000
JC CMBIOS,FLSOEQ YES-CALL MLMP, ALL IS SET. B 01890000
JL CMFVSM OUTL LT TAS RECL, BLANKS NEEDEDB 01900000
MVC $BDREL(2,DTF),TUBRCL(,TUB) USE TAS RECORD LEN FOR PUT. B 01910000
CMFVSM EQU * * B 01920000
SBN LCBAT2(,DTF),LCBTRC SET TRUNCATED INDICATOR. B 01930000
CMBIOS EQU * * B 01940000
L LCBPL@(,DTF),PL XR1 --> PARAM LIST 01940200
SBF LCBAT2(,DTF),LCBSEC SET SECOND BLOCK IND. OFF @09 01940400
TBN LCBAT2(,DTF),LCBRCI RECEIVE INITIAL? @09 01940600
JT CMSDTX YES - GO TO ML/MP @09 01940800
SPACE 1 01941000
* IF THIS IS A GET AND SEARCH EOT - CALL MLMP 01941200
* IF THIS IS NOT A GET - CALL MLMP 01941400
SPACE 1 01941600
SBN LCBAT2(,DTF),LCBSEC SET SECOND BLOCK IND ON @09 01941800
TBN PL$OPM(,PL),OPGET GET OPERATION AND -- 01942000
TBF LCBAT1(,DTF),LCBEOT NOT SEARCH EOT ? 01942200
JF CMSDTX NO - CALL ML/MP 01942400
SPACE 1 01942600
* HAVE A GET NOW. IF IT'S MESSAGE MODE - SKIP CALL OF MLMP 01942800
SPACE 1 01943000
TBF SAVTA2,TASBLK+TASREC RECORD OR BLOCK? @14 01943200
JT CMBNOG YES,SKIP CALL OF MLMP @14 01943400
SPACE 1 01943600
* HAVE A RECORD OR BLOCK MODE TERMINAL. IF RECORD IN PROCESS 01943800
* THEN FAKE AN OP END AND THE DATA WILL BE MOVED ON THE 01944000
* CHECK ENTRY. 01944200
SPACE 1 01944400
TBN SAVTA2,TASREC RECORD MODE AND-- @14 01944600
L $BDIOB(,DTF),XR1 XR1--IOB @14 01944800
CLI IOBCMP(,XR1),PROCES IN PROCESS-- @14 01945000
L LCBPL@(,DTF),PL XR1--PARAM LIST @14 01945200
JC CMBNOG,FLSNEQ NOT IN PROCESS,JUMP @14 01945400
ALC CCOECT(1),CC0001 UP OP END COUNT @14 01945600
ALC LCBOPE(1,DTF),CC0001 UP OP END COUNT @14 01945800
CMBNOG EQU * @14 01946000
SPACE 2 01946200
* GET OP AND NOT RECEIVE INITIAL AND NOT SEARCH EOT - DON'T BRANCH TO 01946400
* ML/MP. ML/MP IN ITS INFINITE WISDOM HAS ALREADY STARTED THE NEXT 01946600
* BLOCK OF DATA ON ITS WAY; THEREFORE, CM WILL WAIT FOR THE OP 01946800
* END TO OCCUR AND THEN GO TO CHECK TO MOVE THE DATA. 01947000
SPACE 2 01947200
SBF $BDAT1(,DTF),$BCNOW SET OFF SPAN RECORD IND. 01947400
MVI DTFCMP(,DTF),NOBIT SET TO OP ACCEPTED 01947600
L $BDWKA(,DTF),WKA XR1 --> ML/MP WORK AREA 01947800
SBF $BWFG3(,WKA),F3MOVE SET OFF ML/MP'S 'DATA MOVED' 01948000
L LCBPL@(,DTF),PL XR1 --> CURRENT PARM LIST 01948200
J CMTRGT SKIP CALL OF ML/MP 01948400
CMSDTX EQU * * @09 01948600
L LCBPL@(,DTF),PL RELOAD THE PL REG. B 01950000
B $$BSMS CALL MLMP IOCS. B 01960000
SPACE 01970000
CMTRGT EQU * * 01975000
B $CC4TT BRANCH TO TRACE SIO. B 01980000
DC AL1(TTMSIO) ID FOR START IO TO TP. B 01990000
SPACE 02000000
CMFMVD EQU * * B 02010000
SBN LCBAT2(,DTF),LCBACT SET LINE ACTIVE IND. B 02020000
TBN PLOPM(,PL),OPOLT ON LINE TEST REQUEST ? B 02030000
L $BDWKA(,DTF),WKA LOAD @ MLMP WORK AREA. B 02040000
JF CMFAKR NO-GO CHECK FOR ERROR POSTED. B 02050000
SBN $BWFG3(,WKA),$BWRFT SET RFT STARTED IND. B 02060000
SBN LCBAT2(,DTF),LCBSET SET SEND EOT INDICATOR. B 02070000
CMFAKR EQU * * B 02080000
TBF ACKS(,WKA),AKERR ERROR POST PENDING FROM MLMP ? B 02090000
JT CMNFAK NO - GO CHECK RECORD MOVED. B 02100000
CLI LCBOPE(,DTF),NOBIT OP END PENDING ALREADY ? B 02102000
JE CMFAKE NO - GO FAKE AN OP END. B 02104000
CMNFAK EQU * * LOCAL B 02106000
TBN $BWFG3(,WKA),F3MOVE RECORD MOVED INDICATOR ON ? B 02110000
JF CMFEOT NO-GO CHECK EOT POSTED IN IOB. B 02120000
SBN LCBOPC(,DTF),LCBMVD SET ON DATA MOVED INDICATOR. B 02130000
SPACE 1 02151000
* FOR BLOCK MODE TERMINALS,THE DATA HAS ALREADY BEEN MOVED B 02151500
* BY MLMP; HOWEVER,THE MAX RECORD LENGTH WAS USED. WE MUST B 02152000
* CALCULATE THE TRUE RECORD LENGTH BEFORE POSTING THE USER. B 02152500
SPACE 2 02153000
TBF SAVTA2,TASMSG NOT MESSAGE MODE ? B 02153500
JF CMNXP1 NO--CHECK EOT POSTED B 02154000
SLC SAVCAT-2(2),SAVCAT SUBTRACT SAVED CAR FROM TAR B 02154500
SLC SAVCAT-2(2),CC0001 DECREMENT FOR SOH OR STX B 02155000
TBN SAVTA2,TASTSP TRANSPARENCY ? B 02155500
JF CMNXPR NO - CONTINUE B 02156000
SLC SAVCAT-2(2),CC0001 DECREMENT FOR DLE B 02156500
CMNXPR EQU * * B 02157000
MVC $BDREL(2,XR2),SAVCAT-2 INSERT LNGTH IN DTF B 02158000
CMNXP1 EQU * * B 02158100
TBF LCBOPE(,DTF),ALLBIT ANY OP ENDS THIS LINE? B 02158200
JT CMFAKE NO-GO FAKE ONE B 02158300
CMFEOT EQU * * B 02160000
L $BDIOB(,DTF),IOB POINT TO THE IOB. B 02170000
CLI IOBCMP(,IOB),$BCEOT EOT POSTED IN THE IOB ? B 02180000
JNE CMFRTN NO-GO EXIT NORMALLY. B 02190000
CMFAKE EQU * * B 02200000
ALC CCOECT(1),CC0001 UP OP END COUNT BY ONE. B 02210000
ALC LCBOPE(1,DTF),CC0001 BUMP LINE OP END COUNT. B 02220000
CMFRTN EQU * * B 02230000
BC CMPAII,FLSCLR GO TO POSTING LOGIC, CLEAR FALSE 02240000
&MIX SETA &NSWL+&NCS 02250000
AIF (&MIX EQ '2').S0700 02260000
TITLE '$E092/CMBSKP---BSCA-POLL-SKIP-BIT-ROUTINE' 02270000
*********************************************************************** 02280000
* * 02290000
* NAME--CMBSKP * 02300000
* * 02310000
* TITLE--BSCA POLL SKIP BIT ROUTINE * 02320000
* * 02330000
* FUNCTION--SET THE SKIP ENTRY INDICATOR ON/OFF IN THE BSCA * 02340000
* POLLING LIST OR THE BSCA SWITCHED LINE ID VERIFICATION * 02350000
* LIST. * 02360000
* * 02370000
* OPERATION-- IF THIS DTF OR THIS PARTICULAR OPERATION DOES NOT * 02390000
* INVOLVE ONE OF THE BSCA LIST THEN RETURN WITHOUT * 02400000
* SETTING AND SKIP BIT. * 02410000
* . OTHERWISE, FIND THE ENTRY IN THE APPROPRIATE LIST. * 02420000
* . SET THE SKIP BIT AS SPECIFIED FOR ALL ENTRIES FOR * 02430000
* THE SAME TERMINAL. * 02440000
* * 02450000
* ENTRY POINTS--CMBSKP-ALL FUNCTIONS ABOVE. * 02460000
* --CMASCH-ONLY FIND THE ENTRY IN THE ADDRESSING LIST. * 02470000
* --CMPSCH-ONLY FIND THE ENTRY IN THE POLLING/SWITCHED * 02480000
* ID LIST. * 02490000
* * 02500000
* INPUT- XR1--ADDRESS OF THE TP PARAMETER LIST. * 02520000
* XR2--SAVED AD RESTORED. * 02530000
* CMB#SB--SBN2(X'BA') SET THE SKIP BIT ON, OR * 02540000
* SBF2(X'BB') SET THE SKIP BIT OFF. * 02550000
* TUBSID--ID OF THE ENTRY(S) TO PERFORM THE OPERATION ON. * 02560000
* * 02570000
* OUTPUT- XR1-ADDRESS OF THE TP PARAMETER LIST. * 02590000
* XR2-RESTORED TO ENTRY VALUE. * 02600000
* POLLING/SWITCHED ID LIST-SKIP BIT FOR APPROPRIATE ID SET * 02610000
* AS SPECIFIED. * 02620000
* * 02630000
* EXIT, NORMAL--TO NSI OF CALLER. * 02640000
* * 02650000
* EXIT, ERROR--CMASCH/CMPSCH WILL RETURN TO NSI+3 IF THE ENTRY IS * 02660000
* NOT FOUND. * 02670000
* * 02680000
*********************************************************************** 02690000
SPACE 02700000
LST EQU 2 POLL LIST REGISTER. CB 02710000
ONOFF EQU X'01' OP CODE BIT FOR SBN/SBF. B 02720000
CMBSKP EQU * * CB 02740000
SPACE 02750000
ST CMBXIT+3,ARR SAVE THE ARR CB 02760000
ST CMON1B+3,PL SAVE XR1 CB 02770000
ST CMBXR2+3,XR2 SAVE XR2 CB 02780000
L PLTUBA(,PL),TUB POINT XR1 AT TUB CB 02790000
L TUBDTF(,TUB),DTF POINT XR2 AT DTF CB 02800000
&MIX SETA &NPP+&NMP+&NSWL 02810000
AIF (&MIX EQ '3').S0600 02820000
TBN $BDATR(,DTF),$BCSWI MULTI-TERMINAL LINE ? C/SLB 02830000
JF CMOEXT NO-GO EXIT. CLB 02840000
AIF (&NSWL).S0600 02850000
TBF $BDATR(,DTF),$BCMPT SWITCHED SB 02860000
TBN TUBTA1(,TUB),TASCNC * CALL ? SB 02870000
JT CMOEXT YES-DON'T SET SKIP BITS. SB 02880000
.S0600 ANOP 02881000
MVC LCBID#(1,DTF),TUBSID(,TUB) MOVE POLL LIST ID INTO SAVE. CB 02882000
AIF (&NSWL).S0605 02883000
* -----START-------------------@07 02884000
TBN $BDATR(,DTF),$BCMCN CONTROL STATION LINE ? SB 02885000
JT CMONSD YES-SKIP SWITCHED CHECKING SB 02886000
TBF $BDATR(,DTF),$BCMPT SWITCHED AND SB 02887000
TBN TUBTA2(,TUB),TASVFY * NO VERIFY ? SB 02888000
JF CMONSD YES-GO PROCESS LIST. SB 02889000
TBF $BDATR(,DTF),$BCMPT SWITCHED AND SB 02890000
CLI CMB#SB,SBF2 ACTIVATE ENTRY ? SB 02905000
JC CMONO#,TRUAEQ YES-GO BUILD SWITCHED ENTRY. SB 02910000
L LCBNO#(,DTF),POL POINT TO SWITCHED LIST. SB 02911000
CLC LCBID#(1,DTF),POLID(,POL) THIS ENTRY IN LIST NOW ? SB 02912000
JNE CMOEXT NO-SKIP THIS ENTRY. SB 02913000
J CMSWFN GO SET SKIP BIT 02913500
CMONSD EQU * * LOCAL 02914000
* -----END---------------------@07 02915000
.S0605 ANOP 02920000
B CMPSCH GO TO FIND THE ID IN POLL LISTCB 02940000
CMSWFN EQU * * 02945000
SPACE 02950000
MVC CMOSAM+3,POLCNT(1,POL) USE CHAR COUNT TO BUILD COMPARCB 02960000
MVC CMOSAM+2(2),CMOSAM+3 * AND LOAD ADDRESS INSTRUCTIONCB 02970000
LA POLCNT(,POL),POL UP PTR TO COUNT BYTE. CB 02980000
L LCBPOL(,DTF),LST LOAD PTR TO POLLING LIST STARTCB 02990000
CMOCHK EQU * * CB 03000000
CLI POLID(,LST),POLEND END OF LIST ? CB 03010000
JNL CMOEXT YES-GO EXIT. CB 03020000
MVC CMOSTS+2,POLCNT(1,LST) SET UP LA INSTR. TO STATUS BYTCB 03030000
LA POLCNT(,LST),LST UP POLL LIST PTR TO COUNT BYTECB 03040000
CMOSAM EQU * * C 03050000
CLC #(#,LST),#(,POL) THIS ENTRY SAME AS REQUESTED ? C 03060000
CMOSTS EQU * * CB 03070000
LA #(,LST),LST UP POLL LIST PTR TO STATUS BYTCB 03080000
JNE CMONXT NO-IGNORE IT, GO TO NEXT ENTRYCB 03090000
CMB#SB EQU * * CB 03100000
SBN 1(,LST),SKIP SET POLL SKIP BIT ON / OFF. CB 03110000
CMONXT EQU * * CB 03120000
LA 2(,LST),LST UP PTR TO NEXT POLL LIST ENTRYCB 03130000
B CMOCHK GO CHECK THIS NEXT ENTRY. CB 03140000
SPACE 03150000
AIF (&NSWL).S0660 03151000
CMONO# EQU * * LOCAL SB 03152000
L LCBNO#(,DTF),POL LOAD SWITCHED ID LIST POINTER SB 03153000
TBN POLCNT+1(,POL),POLSKP SKIP BIT ON THIS ENTRY ? SB 03154000
JF CMOEXT NO - GO TO EXIT SB 03155000
MVC POLID(,POL),LCBID#(1,DTF) SET BLANK PARM LIST THIS ENTRYSB 03156000
SBF POLCNT+1(,POL),POLSKP SET SKIP BIT OFF SB 03157000
.S0660 ANOP 03158000
CMOEXT EQU * * CB 03160000
CMON1B EQU * * CB 03170000
LA *-*,PL RESTORE PARM LIST REG. CB 03180000
CMBXR2 EQU * * CB 03190000
LA #,XR2 RELOAD CALLER'S XR2. CB 03200000
CMBXIT EQU * * CB 03210000
B # RETURN TO CALLER. CB 03220000
EJECT 03230000
*********************************************************************** 03240000
* POLL/ADDR SEARCH ROUTINE. GIVE ID ENTRY BYTE IN DTF SAVE AREA, CB 03250000
* FIND THE CORRESPONDING ENTRY IN THE POLL LIST AND RETURN A POINTERCB 03260000
* TO THE PHYSICAL TERMINAL ADDRESS. CB 03270000
*********************************************************************** 03280000
SPACE 03290000
* ENTRY REGS: XR1-DON'T CARE, XR2-DTF. CB 03300000
* EXIT REGS: XR1-POLL LIST ENTRY, XR2-DTF. CB 03310000
SPACE 03320000
CMASCH EQU * ADDRESS LIST ENTRY POINT. CB 03330000
L LCBSEL(,DTF),POL LOAD ADDR LIST REGISTER. CB 03340000
J CMPNXT GO ENTER MAINLINE CODE. CB 03350000
SPACE 03360000
CMPSCH EQU * FIRST LEVEL SUBROUTINE. CB 03370000
L LCBPOL(,DTF),POL LOAD POLL LIST REGISTER. CB 03380000
CMPNXT EQU * * CB 03390000
ST LCBWRK(,DTF),ARR SAVE RETURN NSI. CB 03400000
CMPCHK EQU * * CB 03410000
CLC POLID(1,POL),LCBID#(,DTF) THIS WANTED TERMINAL ENTRY ? CB 03420000
JE CMPFND YES-GO SET UP RETURN REG. CB 03430000
MVC CMPLA+2,POLCNT(1,POL) USE COUNT TO GET TO NEXT ENTRYCB 03440000
CMPLA EQU * * CB 03450000
LA #(,POL),POL UPDATE REG PAST PHYSICAL ADDR.CB 03460000
LA POLNXT(,POL),POL UPDATE REG PAST ID/COUNT/STATUCB 03470000
AIF (&NSWL).S0680 03480000
CLI POLID(,POL),POLEND END OF LIST ? SB 03490000
BL CMPCHK NO-CONTINUE THE SEARCH. SB 03500000
ALC LCBWRK(2,DTF),THREE ADD 3 TO NSI ADDR FOR RETURN. SB 03510000
* RETURN TO NSI +3 ONLY FOR SWITCHED ID LIST. EITHER BOTH USER , SB 03520000
* AND CMASCH ARE IN CORE, OR BOTH ARE IN THE SAME TRANSIENT. SB 03530000
SPACE 1 03540000
AGO .S0690 03550000
.S0680 ANOP 03560000
B CMPCHK GO TO CHECK NEXT ENTRY. CB 03570000
.S0690 ANOP 03580000
SPACE 03590000
CMPFND EQU * * CB 03600000
* LA POLCNT(,POL),POL UPDATE REG PAST ID BYTE. CB 03610000
L LCBWRK(,DTF),IAR RETURN TO CALLER. CB 03620000
.S0700 ANOP 03621000
AIF (&MIN).N0400 03630000
TITLE '$E092/CMCSKP--SET-BSCA-CHECK-LIST-BIT-ON/OFF' 03640000
*********************************************************************** 03650000
* CHECK LIST SET SKIP BIT ROUTINE. B 03660000
*********************************************************************** 03670000
SPACE 03680000
* SET SKIP BIT ON OR OFF IN CHECK LIST FOR BSCA DTF'S. 03690000
* TO SET THE SKIP BIT ON, MOVE SBN2 INTO CMC#SB. B 03700000
* TO SET THE SKIP BIT OFF, MOVE SBF2 INTO CMC#SB. B 03710000
* ON ENTRY: XR1 -> IOB B 03720000
* ON EXIT: XR1=IOB, XR2=DTF. B 03730000
SPACE 03740000
CMCSKP EQU * * B 03750000
ST CMCSXT+3,ARR SAVE RETURN @. B 03760000
L CCKLST,XR2 LOAD CHECK LIST @ IN XR2. B 03770000
CMCSCK EQU * * B 03780000
CLC CKLDTF(2,XR2),IOBDTF(,IOB) THIS LIST ENTRY FOR THIS DTF? B 03790000
JE CMC#SB YES-GO SET SKIP BIT. B 03800000
LA CKLEN(,XR2),XR2 LOAD @ OF NEXT ENTRY. B 03810000
B CMCSCK GO AND CHECK THIS NEXT ENTRY. B 03820000
SPACE 03830000
CMC#SB EQU * * B 03840000
SBN CKLSTS(,XR2),CKLSKP SET SKIP AS DIRECTED BY CALLER.B 03850000
L CKLDTF(,XR2),DTF RESTORE DTF REGISTER. B 03860000
CMCSXT EQU * * B 03870000
B # RETURN TO CALLER. B 03880000
TITLE '$E092/CMBTAS--SET-DTF-AND-IOB-FROM-TAS' 03900000
*********************************************************************** 03910000
* SET UP DTF/IOB ATTRIBUTTES, AND OWNERSHIP STATUS. * 03920000
*********************************************************************** 03930000
SPACE 03940000
* ENTRY REGS: XR2=DTF B 03950000
* EXIT REGS: XR1=TUB, XR2=DTF. B 03960000
SPACE 03970000
* SET THE TERMINAL ATTRIBUTES IN THE DTF AND THE IOB. B 03980000
SPACE 03990000
CMBTAS EQU * * B 04000000
ST CMBTXT+3,ARR SAVE RETURN @. B 04010000
SBF $BDATT(,DTF),$BCRAN+$BCITB SET OF CURRENT TRANSP AND ITB.B 04020000
MVC CMBTS1+1(1),SAVTA2 MOVE IN TAS ATTR 2. B 04030000
SBF CMBTS1+1,ALL-TASITB-TASTSP LEAVE TRANSP AND ITB SETTINGS.B 04040000
ALC CMBTS1+1(1),CMBTS1+1 CORRECT TO DTF BIT DEFINITION. B 04050000
CMBTS1 EQU * * B 04060000
SBN $BDATT(,DTF),# SET TAS TRANSP AND ITB INTO DTFB 04070000
MNN $BDAT1(,DTF),SAVTA2 MOVE IN SPAN AND RECSEP IND'S. B 04080000
SBF $BDAT1(,DTF),ALL-$BCSEP-$BCSPN-$BCPLR SET OFF OTHERS. B 04090000
L LCBPL@(,DTF),PL LOAD PARM LIST REG. B 04100000
TBN PL$OPC(,PL),OPUSER SYSTEM FUNCTION ? B 04110000
L PLTUBA(,PL),TUB LOAD REG TO POINT TO TUB. B 04120000
AIF (&MOD4 NE '1').LJ040 04122000
TBF TUBAT1(,TUB),TUBKNM AND NOT THE CONSOLE ? 04124000
.LJ040 ANOP 04126000
JT CMBSYS YES-GO SET SYSTEM BLOCK LEN. B 04130000
SPACE 04140000
* DETERMINE THE BLOCK LENGTH GIVEN THE TAS RECORD LENGTH AND B 04150000
* BLOCKING FACTOR. B 04160000
SPACE 04170000
CMBLKG EQU * * B 04180000
MVC LCBKLC(2,DTF),TUBRCL(,TUB) MOVE IN CURRENT RECORD LENGTH.B 04190000
MVC LCBOWN(1,DTF),TUBBKF(,TUB) PUT BLOCK FACTOR IN WORK AREA.B 04200000
CMBLAD EQU * * B 04210000
SLC LCBOWN(1,DTF),CC0001 DECREMENT BLOCKING FACTOR. 0 ? B 04220000
JE CMBOWN YES-GO SET OWNERSHIP STATUS.B B 04230000
ALC LCBKLC(2,DTF),TUBRCL(,TUB) ADD ANOTHER RECORD LENGTH. B 04240000
B CMBLAD GO TO CHECK FOR MORE RECORDS. B 04250000
SPACE 04260000
CMBSYS EQU * SET SYSTEM BLOCK LENGTH. B 04270000
MVC LCBKLC(2,DTF),CC#MCL MOVE IN MAX COMMAND LENGTH. B 04280000
SPACE 04290000
* SET OWNERSHIP STATUS IN THE TUB AND THE LCB. 04300000
SPACE 04310000
CMBOWN EQU * SET OWNERSHIP. B 04320000
* DO NOT SET TUB OWNERSHIP IF ERROR POST CODE 04321000
L $BDIOB(,DTF),XR1 XR1 --> CURRENT IOB 04322000
CLI IOBCMP(,XR1),$BCEOT HIGHER THAN X'42' AND -->| 04323000
TBF IOBCMP(,XR1),BIT0 LESS THAN X'80' AND----->| 04324000
TBN LCBAT2(,DTF),LCBACT LINE ACTIVE ? ---------->| 04325000
L LCBPL@(,DTF),PL XR1 --> PARM LIST | 04326000
L PLTUBA(,PL),TUB XR1 --> TUB | 04327000
JC CMNOWN,X'13' JUMP IF ERROR POSTED<----| 04328000
SBN TUBAT2(,TUB),TUBOWN SET TUB OWNERSHIP. B 04330000
CMNOWN EQU * * 04335000
MVC LCBOWN(2,DTF),TUBTCB(,TUB) SAVE TCB @ OF OWNER IN LCB. B 04340000
AIF (&NSWL).S0900 04350000
&MIX SETA &NPP+&NMP+&NCS 04360000
AIF (&MIX EQ '3').S0800 04370000
TBN TUBAT1(,TUB),TUBSWC SWITCHED LINE ? SLB 04380000
JF CMBTXT NO-GO EXIT. SLB 04390000
.S0800 ANOP 04400000
ST LCBOWN(,DTF),TUB SET ADDRESS OF OWNING TUB. SB 04410000
.S0900 ANOP 04420000
J CMBTXT GO TO RETURN. B 04430000
AGO .N0500 04450000
.N0400 ANOP 04460000
TITLE '$E092/CMFORB--TRANSIENT-FORM-OF-CMFORB,-CMBTAS' 04470000
*********************************************************************** 04480000
* CALL IN TRANSIENT FORM OF 'CMFORB', AND 'CMBTAS'. * 04490000
*********************************************************************** 04500000
SPACE 1 04510000
CMTASV EQU * CALL $CC4B1 FOR TASV B 04520000
MVI CMTID1,CTTASV MOVE IN ID B 04530000
J CMCAL1 CALL THE TRANSIENT B 04540000
SPACE 04550000
CMSET MVI CMTID1,CTSET MOVE IN ID B 04560000
J CMCAL1 CALL THE TRANSIENT B 04570000
SPACE 04580000
CMREJT MVI CMTID1,CTREJC MOVE IN ID B 04590000
J CMCAL1 CALL THE TRANSIENT B 04600000
CMBTAS EQU * * B 04610000
MVI CMTID1,CTBTAS MOVE IN ID FOR 'CMBTAS'. B 04620000
CMCAL1 EQU * * B 04630000
ST CMRTN1+3,ARR SAVE THE RETURN ADDRESS. B 04640000
B $CC4PI CALL TRANSIENT HANDLER. B 04650000
DC AL1(CC4B1) CALL IN MIN XIENT #2. B 04660000
CMTID1 DC AL1(0) ID OF MIN SYST FUNCTION TO DO. B 04670000
SAVTA1 DC XL1'0' TERMINAL ATTRIBUTE SET BYTE 1. B 04680000
SAVTA2 DC XL1'0' TERMINAL ATTRIBUTE SET BYTE 2. B 04690000
SAVRCL DC XL2'00' TERM ATTR SET RECORD LENGTH. B 04700000
CMSPHY DC AL1(0) SAVE ARE FOR TUBPHY. B 04710000
CMSPL DC AL2(0) SAVED PARM LIST 04720000
GMLIST EQU * GETMAIN ADDR 04730000
DC XL4'00' AND SIZE 04740000
SPACE 1 04750000
CMRTN1 EQU * * B 04760000
B # RETURN TO CALLER. B 04770000
.N0500 ANOP 04780000
AIF (&MIN).N0600 04790000
TITLE '$E092/CMTASV--SET-AND-SAVE-TAS-VALUE-IN-CORE' 04810000
*********************************************************************** 04820000
* SUBROUTINE TO SAVE TAS BYTES 1 AND 2, AND CMSPHY BYTE. * 04830000
*********************************************************************** 04840000
SPACE 04850000
* ENTRY REGS: XR1-> PL. 04860000
* EXIT REGS: SAME AS ENTRY. 04870000
SPACE 04880000
CMTASV EQU * B 04890000
ST CMBTXT+3,ARR SAVE THE RETURN ADDRESS. B 04900000
ST CMTSX1+3,PL SAVE THE PL REG. B 04910000
SBF PL$OPC(,PL),OPUSER RESET FUNCTION INDICATOR. B 04920000
TBF PLOPM(,PL),OPREQR USER REQUEST, AND B 04930000
TBF PL$OPC(,PL),OPRFSH+OPLSNS * NOT POLL STATUS OR REFRESH ? B 04940000
L PLTUBA(,PL),TUB LOAD THE TUB REG. B 04950000
MVC CMSPHY,TUBPHY(1,TUB) SAVE THE TUBPHY BYTE IN CORE. B 04960000
JF CMTSYS NO-GO SET SYSTEM TAS VALUES. B 04970000
MVC SAVRCL,TUBRCL(4,TUB) SAVE THE USER TAS VALUES. B 04980000
J CMTSX1 GO TO EXIT. B 04990000
SPACE 05000000
CMTSYS EQU * FILL SYSTEM TAS VALUE. B 05010000
MVI SAVTA1,TASAUT SET AUTO CONNECT VALUE. B 05020000
MVI SAVTA2,TASMSG SET MESSAGE MODE IN TAS 2. B 05030000
L CMTSX1+3,PL RELOAD THE PL REG. B 05040000
SBN PL$OPC(,PL),OPUSER INDICATE SYSTEM FUNCTION. B 05050000
CMTSX1 EQU * * B 05060000
LA #,PL RELOAD THE USER PL REG. B 05070000
CMBTXT EQU * * B 05080000
B # RETURN. B 05090000
.N0600 ANOP 05110000
TITLE '$E092/CMGINL--DETERMINE-THE-OPERATION-INPUT-LENGTH' 05120000
*********************************************************************** 05130000
* * 05140000
* NAME--CMGINL * 05150000
* * 05160000
* TITLE--DETERMINE THE OPERATION INPUT LENGTH * 05170000
* * 05180000
* FUNCTION- DETERMINE THE INPUT RECORD LENGTH. SET TRUNCATED * 05200000
* INDICATOR IF INPUT LENGTH IS LESS THAN ACTUAL DATA * 05210000
* LENGTH. * 05220000
* * 05230000
* OPERATION-- SET THE INPUT LENGTH FOR THE OPERATION. * 05250000
* - POLL FOR STATUS, USE 20. * 05260000
* - RECORD MODE INPUT - USE PLINL IF PLINL LESS THAN * 05270000
* TUBRCL * 05280000
* - USE TUBRCL IF PLINL GREATER THAN * 05290000
* TUBRCL * 05300000
* * 05310000
* . IF NOT MLMP VARIABLE LENGTH RECORD SUPPORT ADJUST THE * 05320000
* INPUT LENGTH IF LESS DATA IS AVAILABLE IN THE ACTUAL * 05330000
* LINE BUFFER THAN IS REQUESTED. * 05340000
* * 05350000
* . IF MORE DATA IS AVAILABLE IN LINE BUFFER THAN * 05360000
* REQUESTED, THEN SET THE TRUNCATED DATA INDICATOR. * 05370000
* * 05380000
* . IF PURE GET REQUEST OR A MESSAGE MODE INPUT AT * 05390000
* OTHER THAN RECEIVE INITIAL TIME RETURN TO USER * 05400000
* AFTER PERFORMING THE ABOVE FUNCTIONS. * 05410000
* * 05420000
* . OTHERWISE, ADD 4 BYTES FOR GETMAIN PARAMETER LIST. * 05430000
* * 05440000
* . FREE THE CURRENT LCB HOLD BUFFER IF IT IS LARGER THAN * 05450000
* NEEDED, AND GETMAIN THE EXACT HOLD AREA NEEDED. * 05460000
* * 05470000
* . IF GETMAIN AREA NOT AVAILABLE, WAIT FOR IT TO BE * 05480000
* AVAILABLE. * 05490000
* * 05500000
* . OTHERWISE, SET UP THE ACQUIRED AREA FOR THE INVITE * 05510000
* INPUT OPERATION. * 05520000
* * 05530000
* ENTRY POINT--CMGINL * 05540000
* * 05550000
* INPUT--XR2 - ADDRESS OF THE DTF * 05570000
* * 05580000
* OUTPUT--XR1 - NOT RESTORED. * 05600000
* XR2 - ADDRESS OF THE DTF. * 05610000
* $BDREL - SET UP FOR INPUT LENGTH OF THE NEXT RECORD. * 05620000
* * 05630000
* EXTERNAL REFERENCES-- * 05640000
* CMFMRT - FREEMAIN CURRENT HOLD BUFFER IF LARGER * 05650000
* THAN IS NEEDED. * 05660000
* CMGMRT - GETMAIN EXACT BUFFER NEEDED. * 05670000
* * 05680000
* EXIT, NORMAL--TO NSI OF CALLER. * 05690000
* * 05700000
* EXIT, ERROR--IF SPACE IS NOT AVAILABLE, EXIT TO CMPAII AND WAIT * 05710000
* UNTIL THE REQUIRED SPACE IS AVAILABLE. * 05720000
* * 05730000
*********************************************************************** 05740000
SPACE 05750000
CMGINL EQU * * B 05760000
ST CMGIXT+3,ARR SAVE RETURN @. B 05770000
L LCBPL@(,DTF),PL LOAD PARM LIST PTR TO GET THE B 05780000
TBF $BDAT1(,DTF),$BCRES SPANNING RECORD IN PROCESS -- B 05790000
TBF LCBAT1(,DTF),LCBEOT - OR SEARCHING FOR EOT ? 05795000
BF CMGIXT YES-GO EXIT EVERYTING'S DONE. B 05800000
MVC $BDREL(2,DTF),PLINL(,PL) MOVE INL TO DTF RECL AREA. B 05810000
MVC $BDWKB(2,DTF),PLRECA(,PL) MOVE CURRENT RECORD ADDR TO DTFB 05820000
&MIX SETA &N32+&N37+&N41 05830000
AIF (&MIX EQ '3').T1500 05840000
* ------------------------> START --> @01 05845000
TBN PL$OPC(,PL),OPLSNS POLL FOR STATUS OP ? 0/5/7B 05850000
JF CMGIUT NO-GO CHECK INPUT MODE. 0/5/7B 05860000
MVC $BDREL(2,DTF),RELSNS USE STANDARD STATUS RECL. 0/5/7B 05870000
J CMGIRL USE IT AS INPUT LENGTH. 0/5/7B 05880000
* -------------------------> END --> @01 05885000
.T1500 ANOP 05890000
CMGIUT EQU * * B 05900000
TBN SAVTA2,TASREC RECORD MODE ? B 05910000
JF CMGIBK NO-GO CHECK DATA LEFT IN BLOCK.B 05920000
L PLTUBA(,PL),TUB LOAD THE TUB REG. B 05930000
CLC $BDREL(2,DTF),TUBRCL(,TUB) INL LT TAS RECL ? B 05940000
JL CMGIMX YES-GO FILL MAX RECL ACCEPTABLEB 05950000
MVC $BDREL(2,DTF),TUBRCL(,TUB) OTHERWISE USE TAS RECORD LEN. B 05960000
CMGIMX EQU * * B 05970000
MVC $BDMRL(2,DTF),$BDREL(,DTF) FILL MAX REC LEN ACCEPTABLE. B 05980000
SPACE 05990000
CMGIBK EQU * * B 06000000
TBF SAVTA2,TASITB+TASVRL+TASPAN MLMP VARIABLE RECORD SUPPORT?B 06010000
JF CMGII@ YES-GO GET II RECORD @. B 06020000
L $BDIOB(,DTF),IOB POINT TO THE IOB. B 06030000
CLI IOBCMP(,IOB),PROCES IOB BEING PROCESSED ? B 06040000
JE CMGIDX YES-IOB READY, GO CK DATA LEN. B 06050000
CLI IOBCMP(,IOB),$BCEOT EOT OR IOB COMPLETE ? B 06060000
TBF SAVTA2,TASMSG AND NOT MESSAGE MODE INPUT ? B 06070000
JC CMGI00,TRUAEQ EOT TO RECORD/BLOCK, 0 IN-LEN. B 06080000
JNL CMGIXT NOT COMPLETE, WAIT FOR OP END. B 06090000
MVC $BDBKX(2,DTF),IOBTAR(,IOB) SET UP BKX LIKE MLMP WILL. B 06100000
ALC $BDBKX(2,DTF),CC0001 UPDATE FOR -STX-. B 06110000
AIF (&NTSP).I0600 06120000
TBN SAVTA2,TASTSP TRANSPARENCY MODE ? XB 06130000
JF CMGIDX NOT TRANSP, GO CK DATA LEGTH. XB 06140000
ALC $BDBKX(2,DTF),CC0001 UPDATE FOR -DLE-. XB 06150000
.I0600 ANOP 06160000
CMGIDX EQU * * B 06170000
CLC $BDBKX(2,DTF),IOBCAR(,IOB) DATA LEFT IN BUFFER ? B 06180000
JNL CMGIXT NO-GO EXIT, WAIT FOR OP END. B 06190000
MVC LCBWRK(2,DTF),IOBCAR(,IOB) FIND THE NUMBER OF DATA B 06200000
SLC LCBWRK(2,DTF),$BDBKX(,DTF) * CHARACTERS LEFT IN BUFFER. B 06210000
CLC $BDREL(2,DTF),LCBWRK(,DTF) INL LT MAX LINE DATA LEFT. B 06220000
JNL CMGIAL NO-GO SET TO GET ALL DATA. B 06230000
SBN LCBAT2(,DTF),LCBTRC SET BLOCK TRUNCATED IND. B 06240000
J CMGII@ GO CHECK INVITE RECORD @. B 06250000
SPACE 06260000
CMGI00 EQU * * 06270000
SLC $BDREL(2,DTF),$BDREL(,DTF) ZERO OUT INPUT RECORD LENGTH. B 06280000
J CMGII@ GO CHECK INVITE RECORD LENGTH. B 06290000
SPACE 06300000
CMGIAL EQU * * B 06310000
MVC $BDREL(2,DTF),LCBWRK(,DTF) MOVE MAX LINE LEN TO RECL. B 06320000
SPACE 06330000
CMGII@ EQU * * B 06340000
L LCBPL@(,DTF),PL LOAD @ OF CURRENT PARM LIST. B 06350000
TBN PL$OPM(,PL),OPINV THIS AN INVITE REQUEST ? B 06360000
JF CMGIXT NO-GO EXIT, WORK IS DONE. B 06370000
TBN PLOPM(,PL),OPREQR SYSTEM REQUEST ? B 06380000
AIF (&NRUF).E0098 . SKIP IF NOT READ UNDER FORMAT 06381000
* -----START-------------------@06 06382000
L PLTUBA(,PL),XR2 XR2->TUB. 06383000
TBF TUBSCS(,XR2),TUBRUF AND NOT A RUF ? 06384000
L TUBDTF(,XR2),DTF XR2->LCB(DTF). 06385000
* -----END---------------------@06 06386000
.E0098 ANOP .* 06387000
JT CMGISR YES-GO SET UP SYSTEM RECORD LENB 06390000
AIF (&NMSG).E0100 06400000
TBN SAVTA2,TASMSG GET-MSG MODE ? GB 06410000
JT CMGIMG YES-GO CHECK RECEIVE INIT IND.GB 06420000
.E0100 ANOP 06430000
CMGIRL EQU * * B 06440000
MVC #BUFND,$BDREL(2,DTF) USE CURRENT RECORD LEN AND ADD B 06450000
J CMGICB GO ADD GETMAIN CONTROL BYTES. B 06460000
SPACE 06470000
CMGIMG EQU * * B 06480000
TBN LCBAT2(,DTF),LCBRCI RECEIVE INITIAL TIME ? B 06490000
JF CMGIXT NO-GO EXIT, BUFFERS ARE SET. B 06500000
CMGISR EQU * * B 06510000
MVC #BUFND,PLINL(2,PL) USE PARM LIST INL FOR SYST. B 06520000
CMGICB EQU * * B 06530000
ALC #BUFND(2),CC0004 * GETMAIN PARM LIST REQ'MTS. B 06540000
CLI LCBIBA-1(,DTF),NOBIT IS THERE A CURRENT INVITE BUF ?B 06550000
JE CMGIGM NO-GO RIGHT TO GETMAIN. B 06560000
SPACE 06570000
* IF CURRENT BUFFER FOR INVITE IS LARGER THAN NEED, THEN FREE THE 06580000
* CURRENT BUFFER, AND GET ONLY WHAT IS NEEDED. 06590000
SPACE 06600000
CLC #BUFND,LCBIBL(2,DTF) CURRENT LARGER THAN NEEDED ? B 06610000
JE CMGIUS NO-THEN MUST BE EQ, USE CURRENTB 06620000
L LCBIBA(,DTF),XR2 LOAD @ OF CURRENT BUFFER. B 06630000
B CMFMRT GO TO FREEMAIN RTN, FREE CUR'NTB 06640000
SPACE 06650000
L CMSDTF,DTF RELOAD DTF REG. B 06660000
MVI LCBIBA-1(,DTF),NOBIT ZERO INVITE BUF ADDR. B 06670000
CMGIGM EQU * * B 06680000
CLC #BUFND(2),CC#BMX MAX AVAIL TO SATISFY GETMAIN ? B 06690000
JH CMGINO NO-GO SET UP TO WAIT ON FREEMANB 06700000
MVC GMLIST+GMSIZE(2),#BUFND MOVE NEEDED LENGTH TO GM LIST. B 06710000
B CMGMRT GO TO GETMAIN RTN. B 06720000
SPACE 06730000
JOL CMGINO GETMAIN FAILED, GO WAIT. B 06740000
L GMLIST+GMADDR,XR1 LOAD @ OF GOTTN BUFFER. B 06750000
MVC GMSIZE(4,XR1),GMLIST+GMSIZE PUT GM LIST INTO BUFFER 1-4. B 06760000
ST LCBIBA(,DTF),XR1 PUT ADDR OF GOT BUF IN LCB. B 06770000
ALC LCBIBA(2,DTF),CC0004 CORRECT @ TO 5TH BYTE IN BUFR. B 06780000
MVC LCBIBL(2,DTF),GMSIZE(,XR1) FILL INVITE BUFF LENGTH FIELD.B 06790000
SPACE 06800000
* USE THE INVITE BUFFER AREA GOTTEN FOR THE MLMP OPERATION. 06810000
SPACE 06820000
CMGIUS EQU * * B 06830000
MVC $BDWKB(2,DTF),LCBIBA(,DTF) USE INVITE BUF AREA FOR MLMP. B 06840000
L LCBPL@(,DTF),PL LOAD PARM LIST REG. B 06850000
&MIX SETA &N32+&N37+&N41 06852000
AIF (&MIX EQ '3').T2000 06854000
* -------------------------- START @01 06856000
TBN PL$OPC(,PL),OPLSNS POLLING FOR STATUS ? 0/5/7B 06860000
JF CMGMOV YES-GO DO MOVE 0/5/7B 06870000
TBN PL$OPC(,PL),OPINV INVITE INPUT OP 0/5/7B 06872000
JF CMGIXT NO-DON'T MOVE 0/5/7B 06874000
CMGMOV EQU * LABEL 0/5/7B 06876000
* ------------------------------- END --@01 06877000
.T2000 ANOP 06878000
MVC PLRECA(2,PL),$BDWKB(,DTF) PUT INVITE @ INTO PARM LIST. B 06880000
J CMGIXT GO EXIT, WORK IS DONE. B 06890000
SPACE 06900000
* INDICATE GETMAIN NEEDED FOR THIS LINE. 06920000
CMGINO EQU * * B 06930000
SBN PL$OPM(,PL),OPGETM SET GETMAIN NEEDED IN PARM LST.B 06940000
SBN LCBATR(,DTF),LCBGMN SET GETMAIN NEEDED FOR LINE. B 06950000
SBN CMWTMK+1,WPBFR SET WAIT MASK FOR FREEMAIN B 06960000
B CMPAII GO POST USER AS NECESSARY. B 06970000
SPACE 06980000
CMGIXT EQU * * B 06990000
BC #,FLSCLR RETURN, RESET THE FALSE IND. B 07000000
.C0580 ANOP 07010000
MEND 07030000