|
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: 24892 (0x613c)
Types: s3xseg
Names: »S$E075«
└─⟦827b5bd03⟧ Bits:30009184 5702-sc1.V16.ccp
└─⟦f17e99db6⟧
└─⟦this⟧ »S$E075«
MACRO 00010000
.********************************************************************** 00010100
.* NAME: $E075 V-16, M-00. * 00010300
.********************************************************************** 00016600
$E075 &GEN- 00020000
GBLB &ONE,&NOB,&NOM,&MIN,&NDME,&NAS,&NMSG,&N32,&N37,&N41 00030000
GBLB &NCS,&NSWL,&NRUF 00050000
LCLA &MIX 00070000
TEXT 00080000
* R-16,C-00 CHANGE LEVEL 00085000
$CC4CM TITLE '$E075/CMREND---READ-OP-END-HANDLER' 00090000
AIF (&GEN EQ 'REJC').G0100 00095000
*********************************************************************** 00100000
* R E A D O P E N D H A N D L E R * 00110000
*********************************************************************** 00120000
SPACE 00130000
CMREND EQU * READ OP END HANDLER 00140000
SPACE 00150000
* XR1 POINTS TO PARM LIST AND XR2 POINTS TO THE DTF 00160000
SPACE 00170000
AIF (&ONE).C0140 00180000
TBN $BDDEV(,DTF),BSCA BSCA DTF ? 2 00190000
BF CMRDME NO--GO CHECK DME 2 00200000
.C0140 ANOP 00210000
AIF (&NOB).C0150 00220000
SPACE 00230000
* CHECK FOR SEARCH EOT OPERATION. IF SEARCH FOR EOT, AND EOT IS NOT B 00240000
* FOUND, CONTINUE SEARCH. IF EOT WAS FOUND, THEN DETERMINE B 00250000
* IF PARM LIST TO BE DEQUEUED. IF EOT IS FOUND FOR GET-MSG, B 00260000
* GO TO GET-MSG EOT PROCESSING LOGIC. B 00270000
SPACE 00280000
TBN LCBAT1(,DTF),LCBEOT SEARCH FOR EOT ON LINE ? B 00290000
JF CMPSAV NO-GO CHECK COMPLETION CODE. B 00300000
CLI $BDCMP(,DTF),$BCEOT EOT FOUND ? B 00310000
JNE CMPBKL NO-GO UPDATE BLK LEN TO NXT BLKB 00320000
&MIX SETA &N32+&N37+&N41 00320300
AIF (&MIX EQ '3').T0005 00320600
TBN PLOPM(,PL),OPSTOP STOP INVITE AND 0/5/7B 00321000
TBN PL$OPC(,PL),OPLSNS POLL FOR STATUS ? 0/5/7B 00322000
JF CMFRTZ NO-GO CHECK FOR DE-QUE 0/5/7B 00323000
SBN LCBAT1(,DTF),LCBDEQ SET TO DE-QUE 0/5/7B 00324000
SBN LCBOPC(,DTF),LCBERP SET ERP ON TO INSURE DEQ. 0/5/7B 00325000
SBN CMSWIT,CMSPSI SET INTERNAL IND. ON 0/5/7B 00326000
MVI PL$RTC(,PL),RCXSPI RTN CODE= SUCCESSFUL STOP.0/5/7B 00327000
CMFRTZ EQU * LABEL 0/5/7B 00328000
.T0005 ANOP 00329000
TBN LCBAT1(,DTF),LCBDEQ DEQUE WHEN EOT FOUND ? B 00330000
SLC LCBAT2(2,DTF),LCBAT2(,DTF) CLEAR LCBAT1 AND LCBAT2. B 00340000
L PLTUBA(,PL),XR2 LOAD REG TO THE TUB. B 00350000
SBF TUBAT2(,XR2),TUBOWN SET OFF TUB OWN INDICATOR. B 00360000
CLI TUBAT2(,XR2),TUBDTA+TUBCMD DATA MODE ESCAPE RECOGNIZED ?DB 00370000
BF CMREDO DON'T DEQ-GO RESCHEDULE LINE. B 00380000
TBN PL$OPC(,PL),OPGET GET OP BEING HANDLED ? B 00390000
JF CMRERP NO-GO CHECK FOR ERP. B 00400000
SBF TUBAT2(,XR2),TUBIIS SET OFF INVITE SCHEDULED. B 00410000
CMRERP EQU * * B 00420000
L TUBDTF(,XR2),DTF POINT TO THE DTF. B 00430000
TBF LCBOPC(,DTF),LCBERP LINE IN ERP PROCESS ? B 00440000
BC CMDEQ,FLSNLO ERP/DME-GO DEQ THE REQUEST. B 00450000
J CMREXT GO TO EXIT FROM READ OP END. B 00460000
SPACE 00470000
* IF EOT NOT FOUND FOR SEARCH EOT BY GET-MSG, THEN SET DATA B 00480000
* TRUNCATED INDICATION BEFORE CONTINUING THE SEARCH. B 00490000
SPACE 00500000
CMPBKL EQU * * B 00510000
AIF (&NMSG).E0300 00520000
TBN SAVTA2,TASMSG * GET MSG MODE ? GB 00530000
JF CMPBMP NO-GO TO BUMP BKX FOR NEXT BLOGB 00540000
SBN PL$RTC(,PL),RCXDTR SET DATA TRUNCATED RETURN CODEGB 00550000
.E0300 ANOP 00560000
CMPBMP EQU * * B 00570000
ALC $BDBKX(2,DTF),$BDBKL(,DTF) UPDATE BLK PTR TO GET NEXT BLKB 00580000
B CMFORM GO FORM NEXT OP ON THE LINE. B 00590000
SPACE 00600000
CMPSAV EQU * * B 00610000
MVC PL$RTC(1,PL),$BDCMP(,DTF) SAVE THE COMPLETION CODE. B 00620000
SBF PL$RTC(,PL),BIT1 SET OFF X'40' IN RETURN CODE. B 00630000
EJECT 00640000
* HAVE A SUCCESSFUL READ OPERATION. B 00650000
* CHECK FOR RECEIVE INITIAL AND DATA RETURNED. IF YES, CHECK FOR B 00660000
* CONFLICTING REQUESTS IN THE BSCA LINE QUEUE. B 00670000
* IF NOT RECEIVE INITIAL AND DATA IS RETURNED, GO HANDLE THE DATA B 00680000
* ONLY SITUATION. B 00690000
* IF EOT WAS RECEIVED FOR CANCEL RECEIVE INITIAL OPERATION, THEN B 00700000
* CHECK WHETHER PRIORITY CANCEL OR STOP POLLING REQUEST. B 00710000
* OTHERWISE EOT WAS RECEIVED FOR DATA. CHECK FOR MESSAGE MODE B 00720000
* PROCESSING. IF GET-MSG, CLEAN UP THE OPERATION. B 00730000
SPACE 00740000
TBF PL$RTC(,PL),$BCEOT-BIT1 DATA RECEIVED FOR A B 00750000
TBN LCBAT2(,DTF),LCBRCI RECEIVE INITIAL ON THE LINE ? B 00760000
SBF LCBAT2(,DTF),LCBRCI+LCBPUT SET OFF RCVI AND PUT IND'S. B 00770000
L PLTUBA(,PL),TUB LOAD TUB REG. B 00780000
JT CMREJC YES-DATA HIT, CHECK CONFLICTS. B 00790000
CLI $BDCMP(,DTF),$BCEOT EOT RECEIVED ? B 00800000
BNE CMRECA NOT EOT, DATA FOR NON-RCVI. B 00810000
TBN LCBAT1(,DTF),LCBPRI PRIORITY CANCEL REQUESTED ? B 00820000
SLC LCBAT2(2,DTF),LCBAT2(,DTF) CLEAR LCBAT1 AND LCBAT2. B 00830000
SBF TUBAT2(,TUB),TUBOWN SET OFF TUB OWN INDICATOR. B 00840000
JF CMNRX1 NOT PRIORITY CANCEL-JUMP B 00850000
MVC LCBLID(,DTF),$BDIND(,DTF) SAVE LAST POLLED TERM ID 00852000
B CMRSCH GO RESCHEDULE 00854000
CMNRX1 EQU * * 00856000
SBF TUBAT2(,TUB),TUBIIS SET OFF INPUT SCHEDULED. B 00860000
SPACE 00870000
* SINCE ALL SYSTEM REQUESTS SHOULD HAVE A SEARCH EOT UP AND NOT GET B 00880000
* THIS FAR, IT MUST BE A USER REQUEST. B 00890000
SPACE 00900000
CMREXT EQU * * B 00910000
L LCBPL@(,DTF),PL POINT TO THE PARM LIST B 00920000
AIF (&NRUF).E0348 00921000
* -----START-------------------@06 00922000
* IF RUF PGM REQUEST, HANDLE LIKE A USER GET-MESSAGE OPERATION. 00923000
L PLTUBA(,PL),XR2 XR2->TUB. 00924000
TBN TUBSCS(,XR2),TUBRUF RUF ON THE SCREEN ? 00925000
L TUBDTF(,XR2),DTF XR2->LCB(DTF). 00926000
JT CMRGOM YES-GO HANDLE AS USER GET-MSG. 00927000
* -------END-------------------@06 00928000
.E0348 ANOP 00929000
CLI PLOPM(,PL),OPREQR USER REQUEST, AND B 00931000
AIF (&NMSG).E0350 00932000
TBN SAVTA2,TASMSG GET-MSG MODE ? GB 00950000
JC CMRGOM,TRUALO YES-GO HANDLE GET-MESSAGE. GB 00960000
.E0350 ANOP 00961000
SPACE 00961500
* INDICATE NO HOLD BUFFER IF EOT TO INVITE AND NOT MESSAGE MODE. B 00962000
SPACE 00962500
* -----START-------------------@02 00962540
BNL CMDEQ BRANCH IF SYSTEM OP TO DEQUE B 00962580
* USER OP AT THIS POINT AND NON-MSG MODE B 00962620
TBN PL$OPM(,PL),OPNOW INVITE OP ? B 00962660
BF CMRBMV NO-GO BLANK BUFFER B 00962700
L PLTUBA(,PL),XR2 XR2--> TUB B 00962740
SBN TUBAT2(,XR2),TUBIMI SET IMI ON AND - B 00962780
SLC PLEFFL(2,PL),PLEFFL(,PL) EFFL TO ZERO SO II WON'T FREE B 00962820
L TUBDTF(,XR2),XR2 XR2 --> DTF FOR DE-QUE B 00962840
B CMDEQ GO DE-QUEUE B 00962860
* -------END-------------------@02 00962900
AIF (&NMSG).E0400 00966500
SPACE 00970000
* EOT FOUND FOR GET-MSG MODE OPERATON. RESTORE PARM LIST GB 00980000
* RECORD ADDRESS AND IN LENGTH, AND THE DTF RECORD LENGTH. GB 00990000
* THEN GO DIRECTLY TO TEST FOR TRANSLATION. GB 01000000
SPACE 01010000
CMRGOM EQU * * GB 01020000
MVC PLRECA(4,PL),LCBMR@(,DTF) RESOTRE RECA AND INL. GB 01030000
CLI PL$RTC(,PL),RCXCLR CLEAR RETURN CODE GOING BACK ?GB 01040000
BE CMDEQ YES-GO TO DEQUEUE THE REQUEST.GB 01050000
SBF PL$RTC(,PL),$BCEOT SET OFF EOT R.C. FOR GET-MSG. GB 01060000
MVC $BDREL(2,DTF),LCBMRL(,DTF) RESTORE THE DTF RECORD LEN. GB 01070000
B CMRBMV GO TO CHECK FOR XLATE. GB 01080000
SPACE 01090000
.E0400 ANOP 01110000
.G0100 ANOP 01125000
* REMOVE CONFLICTING ACCEPTED REQUESTS. ONLY INVITES AND/OR B 01140000
* PUT-NO-WAITS-MESSAGE REQUESTS MAY BE IN THE QUEUE. BECAUSE B 01150000
* OF BSCA LINE HANDLING, AT OP END TIME MORE THAN ONE GET OR PUT B 01160000
* FOR RECORD, BLOCK, MESSAGE, OR PUT-NO-WAIT FOR RECORD OR B 01170000
* BLOCK COULD BE IN THE LINE QUEUE AT THE TIME. AT MOST, ONE WAIT B 01180000
* TYPE OPERATION WILL HAVE TO BE REMOVED. B 01190000
SPACE 01200000
CMREJC EQU * * B 01210000
AIF (&MIN).N0100 01215000
L LCBPL@(,DTF),PL RELOAD THE PL REG. B 01220000
SPACE 01230000
* SAVE PARM LIST AND DTF DATA ADDR'S AND LENGTHS. THEY WILL BE USEDB 01240000
* ONLY BY GET-MESSAGE PROCESSING. B 01250000
SPACE 01260000
AIF (&NMSG).E0600 01270000
MVC LCBMR@(4,DTF),PLRECA(,PL) SAVE PARM INL AND RECORD ADDR.GB 01280000
SLC LCBMRL(2,DTF),LCBMRL(,DTF) ZERO OUT INCREMENT RECORD LENGB 01290000
.E0600 ANOP 01300000
SBF LCBAT1(,DTF),LCBPRI SET OFF PRIORITY CANCEL IND. B 01310000
MVC CMIIND,LCBOWN(2,DTF) SAVE TCB @ OF OWNER. B 01320000
TBF PL$OPC(,PL),OPLSNS POLL FOR STATUS, OR B 01330000
TBF SAVTA2,TASMSG * GET-MESSAGE MODE ? B 01340000
JF CMRECX YES-GO READY FOR RECORD CHECK. B 01350000
LA LCBPLQ-1(,DTF),PL LOAD REG. TO DTF PARM LIST QUE.B 01360000
CMREQR EQU * * B 01370000
CLC PLCHN(2,PL),CMSPL NEXT PARM LIST SAME AS OP ENDED? 01380000
L PLCHN(,PL),PL LOAD REG TO NEXT PARM LIST. B 01390000
JE CMRZRO YES-SKIP IT GO CHECK FOR ANOTHR. 01400000
L PLTUBA(,PL),XR2 LOAD WORK REG WITH TUB @. B 01410000
CLC CMIIND,TUBTCB(2,XR2) THIS TUB FOR SAME OWNER ? B 01420000
JNE CMRZRO NO-GO CHECK FOR ANOTHER. B 01430000
TBN PLOPC(,PL),OPNOW NO WAIT OPERATION ? B 01440000
JF CMRCAN NO-GO CANCEL ANY WAIT OP'S. B 01450000
TBN PLOPC(,PL),OPGET THIS AN INVITE INPUT ? B 01460000
JT CMRZRO YES-GO CHECK FOR ANOTHER. B 01470000
TBN PLOPM(,PL),OPREQR SYSTEM REQUEST ? B 01480000
JT CMRZRO YES-TREAT AS PUT-MSG/NOWAIT. B 01490000
TBN PLOPC(,PL),OPMSG PUT/MSG REQUEST ? B 01500000
JF CMRCAN NO-GO CANCEL NON-PUT/MSG OP'S. B 01510000
CMRZRO EQU * * B 01520000
CLI PLCHN-1(,PL),CMZERO ANOTHER PARM LIST IN CHAIN ? B 01530000
BNE CMREQR YES-GO CHECK FOR REQUEST REJECTB 01540000
L CMSDTF,DTF RELOAD THE DTF REG. B 01550000
L LCBPL@(,DTF),PL RELOAD THE PL REG. B 01560000
J CMRECX GO CHECK THE RECORD AREA. B 01570000
SPACE 01580000
CMRCAN EQU * * B 01590000
AIF (&GEN EQ 'REJC').G0200 01595000
B $CC4PI CALL IN BSCA OPERATION REJECT B 01600000
DC AL1(CC4BR) * TRANSIENT. B 01610000
SPACE 01620000
CMRECX EQU * * B 01630000
AGO .C0145 01632000
.N0100 B CMREJT CALL REJECT LOGIC IN $CC4B1 01634000
.C0145 ANOP 01636000
L PLTUBA(,PL),TUB POINT TO THE TUB. B 01640000
J CMRECA GO CHECK THE RECORD AREA. B 01650000
CMRDME EQU * * B 01660000
.C0150 ANOP 01670000
SPACE 01680000
* GET TUB ADDRESS FROM THE PARAMETER LIST 01690000
SPACE 01700000
L PLTUBA(,XR1),XR1 POINT XR1 TO TUB 01710000
SBF TUBAT2(,XR1),TUBIIS SET OFF INVITE SCHEDULED 01720000
SPACE 01730000
AIF (&NOM).M0300 01740000
SPACE 01750000
* HAVE HAD SUCCESSFUL READ OPERATION M 01760000
* IF THIS TERMINAL IS IN DATA MODE AND IS ALSO A REQUESTING TERMINAL M 01770000
* FOR THE PROGRAM TO WHICH IT IS CURRENTLY ALLOCATED - THEN CM MUST M 01780000
* CHECK FOR A DATA MODE ESCAPE COMMAND M 01790000
SPACE 01800000
MVC SAVTA2(2),TUBTA2(,XR1) MOVE TERM ATTR TO SAVE AREA M 01810000
SPACE 01820000
.M0300 ANOP 01830000
AIF (&NDME).D5000 01840000
AIF (&NOM).M0400 DM 01850000
************************************************************************01860000
* DATA MODE ESCAPE CHECK *01870000
************************************************************************01880000
SPACE 01890000
* CHECK TERMINAL QUALIFICATIONS FOR DATA MODE ESCAPE DM 01900000
SPACE 01910000
TBF TUBAT2(,XR1),TUBCMD TEST FOR NOT IN COMMAND MODE DM 01920000
TBN TUBAT2(,XR1),TUBDTA IS TUB IN DATA MODE DM 01930000
TBN TUBAT1(,XR1),TUBREQ IS TUB REQ'R OF CURRENT PGM ? DM 01940000
JF CMRECA JUMP IF NOT DATA MODE + RQTER DM 01950000
SPACE 01960000
* TERMINAL IS QUALIFIED TO ENTER DATA MODE ESCAPE COMMAND DM 01970000
* THUS CM MUST CHECK FIRST 6 BYTES OF INPUT FOR DME SEQUENCE DM 01980000
SPACE 01990000
* BUILD TRANSLATE LIST FOR TRANSLATION OF 1ST 6 BYTES OF RECORD DM 02000000
* IN ORDER TO CHECK THEM FOR THE DATA MODE ESCAPE COMMAND DM 02010000
* USE THE SPECIAL TRANSLATE LIST PROVIDED JUST FOR THIS PURPOSE DM 02020000
SPACE 02030000
* ALL FIELDS IN THE TRANSLATE LIST ARE PRESET EXCEPT FOR DM 02040000
* THE FROM ADDRESS DM 02050000
SPACE 02060000
MVI CMDMTL+TLTOL,DMELEN MOVE DME LENGTH TO TRAN LIST DM 02070000
MVC CMDMTL+TLFRMA(2),$MDCRA(,XR2) MOVE 'FRM' ADD TO XLAT LSTDM 02080000
MVC CMTDME(1),LCBLLE(,XR2) MOVE TRANSLATE TRANSIENT ID DM 02090000
LA CMDMTL,XR1 POINT XR1 AT TRANSLATE LIST DM 02100000
SPACE 02110000
B $CC4PI BRANCH TO BRING IN TRANSLATE DM 02120000
* TRANSIENT 02130000
CMTDME DC AL1(0) PLUGGED WITH TRANSIENT ID DM 02140000
SPACE 02150000
* COMPARE TRANSLATE INPUT AGAINST DATA MODE ESCAPE COMMAND SEQUENCE DM 02160000
SPACE 02170000
CLC CMDMEB+5(6),CMDME CHECK FOR DME COMMAND DM 02180000
BNE CMRECA JUMP IF NOT DATA MODE ESCAPE DM 02190000
SPACE 02200000
******* GOT DATA MODE ESCAPE SEQUENCE FROM TERMINAL ***************** 02210000
SPACE 02220000
SPACE 02230000
************************************************************************02240000
* ON RECOGNIZING A VALID DATA MODE ESCAPE COMMAND - $CC4CM MUST DM 02250000
* PUT THE TUB IN COMMAND INTERRUPT MODE DM 02260000
* SET A BIT OFF IN TPOPM SO THAT CP RECOGNIZES THIS AS A DATA MODE DM 02270000
* ESCAPE COMMAND AND CALL S IN THE PROPER TRANSIENT DM 02280000
* MOVE TO TUBDML THE ADDR OF THE PARM LIST DM 02290000
* DEQUEUE THE PARAMETER LIST DM 02300000
* PUT THE TUB ON CP TUB INPUT QUEUE DM 02310000
************************************************************************02320000
SPACE 3 02330000
L CMSPL,XR1 POINT XR1 AT PARM LIST DM 02340000
L PLTUBA(,XR1),XR2 POINT XR2 AT TUB DM 02350000
SBN TUBAT2(,XR2),TUBCMD PUT TUB IN COM.INT. MODE DM 02360000
SBF TPOPM(,XR2),OP$SYS ASSURE SYS. BIT OFF IN TUB PL DM 02370000
* TO INDICATE TO $CC4CP THAT DM 02380000
* THIS IS D M E COMMAND DM 02390000
ST TUBDML(,XR2),XR1 STORE PARM LIST ADDR IN TUB DM 02400000
B CMDEQ BR TO DEQUEUE THE PARM LIST DM 02410000
EJECT 02420000
.M0400 ANOP 02430000
.D5000 ANOP 02440000
************************************************************************02450000
* INVITE INPUT OP END ANALYSIS *02460000
************************************************************************02470000
SPACE 02480000
CMRECA EQU * RECORD AREA ANALYSIS 02490000
SPACE 02500000
* XR2 POINTS TO DTF 02510000
SPACE 02520000
AIF (&ONE).C0240 02530000
TBN $BDDEV(,DTF),BSCA BSCA DTF ? 2 02540000
BF CMRDAT NO-GO TO REGULAR DATA MODE. 2 02550000
.C0240 ANOP 02560000
AIF (&NOB).C0250 02570000
AIF (&N32).T0010 02580000
TBN TUBSCS(,TUB),TUBCLR CLEAR KEY HIT ? 0B 02590000
SBF TUBSCS(,TUB),TUBCLR SET OFF CLEAR KEY HIT. 0B 02600000
AIF (&NDME).D0300 02610000
JT CMRCRC YES-GO SET CLEAR RETURN CODE.0DB 02620000
AGO .T0010 02630000
.D0300 ANOP 02640000
JF CMR327 NO-GO CHECK TERMINAL TYPE. 0B 02650000
.T0010 ANOP 02660000
AIF (&NDME).D0500 02670000
TBF TUBSCS(,TUB),TUBDME+TUBDMF DME HANDLED BY INQUIRY XIENT DB 02680000
JT CMR327 NO-GO TO CHECK FOR 3270. DB 02690000
AIF (&N32).D0400 02700000
TBN TUBSCS(,TUB),TUBDMF DME FAILED ? 0DB 02710000
.D0400 ANOP 02720000
SBF TUBSCS(,TUB),TUBDME+TUBDMF RESET THE DME INDICATORS. DB 02730000
AIF (&N32).D0600 02740000
JF CMREOT NO-GO SET SEARCH FOR EOT. 0DB 02750000
.D0500 ANOP 02760000
AIF (&N32).D0600 02770000
CMRCRC EQU * * 0B 02780000
L LCBPL@(,DTF),PL POINT TO THE PARM LIST. 0B 02790000
MVI PL$RTC(,PL),RCXCLR SET CLEAR RETURN CODE. 0B 02800000
.D0600 ANOP 02810000
&MIX SETA &N32+&NDME 02820000
AIF (&MIX EQ '2').D0700 02830000
CMREOT EQU * * 0/DB 02840000
SBN LCBAT1(,DTF),LCBEOT+LCBDEQ SET SEARCH EOT, AND DEQ. 0/DB 02850000
B CMFORM GO FORM THE OPERATION. 0/DB 02860000
SPACE 1 02870000
CMR327 EQU * * 0/DB 02880000
.D0700 ANOP 02890000
* --------------------------> START --> @01 02895000
&MIX SETA &N32+&N37+&N41 02900000
AIF (&MIX EQ '3').T0100 02910000
CLI TUBPHY(,TUB),TUB375 THIS A 3270 OR 3735 ? 0/5B 02920000
AIF (&N41).T0020 02922000
TBN TUBPHY(,TUB),TUB374 OR A 3741 ? 7B 02924000
.T0020 ANOP 02926000
L $BDWKB(,DTF),XR1 XR1--> LOGICAL DATA ARES. 0/5/7B 02930000
AIF (&N41).T0030 02930500
JF CMN374 NOT A 3471, GO TRY 3735/3270. 7B 02931000
CLC S374ID(2,XR1),CM3741 3741 STATUS MSG (EBCDIC) ? 7B 02931500
AIF (&NAS).T0025 02932000
TBN $BDATT(,DTF),$BCASK THIS AN ASCII LINE ? 7AB 02932500
JF CM374X NO-GO TO STATUS TEST JUMP. 7AB 02933000
CLC S374ID(2,XR1),CM374A 3741 STATUS MSG (ASCII) ? 7AB 02933500
CM374X EQU * * 7AB 02934000
.T0025 ANOP 02934500
JNE CMRCMD NOT STATUS, GO HANDLE DATA. 7B 02935000
B $CC4PI CALL IN 7B 02935500
DC AL1(CC4B7) * 3741 STATUS XIENT. 7B 02936000
L LCBPL@(,DTF),PL POINT TO PARM LIST @20 02936500
B CMFORM GO EXECUTE NEXT OPERATION. 7B 02937000
SPACE 02937500
CMN374 EQU * * 7B 02938000
.T0030 ANOP 02938500
* ----------------------------> END --> @01 02939000
AIF (&N37).T0050 02940000
JNE CMRN37 NOT 3735, GO CHECK 3270. 5B 02950000
CLC S375NL(3,XR1),CMNULS THIS NUL-S-NUL MESSAGE ? 5B 02960000
AIF (&NAS).T0040 02961000
TBN $BDATT(,DTF),$BCASK THIS A ASCII LINE ? 5AB 02962000
JF CMR375 NO-GO TO 3735 JUMP COND. 5AB 02963000
CLC S375NL(3,XR1),CMNULA THIS NUL-S-NUL (ASCII) MSG ? 5AB 02964000
CMR375 EQU * * 5AB 02965000
.T0040 ANOP 02966000
JNE CMRCMD NO-GO CHECK COMMAND MODE. 5B 02970000
B $CC4PI CALL TRANSIENT REQUEST. 5B 02980000
DC AL1(CC4B5) BRING IN 3735 STATUS XIENT. 5B 02990000
L LCBPL@(,DTF),PL POINT XR1 TO PARM LIST @20 03000000
B CMFORM GO REQUEST NEXT OP ON THE LINE5B 03010000
SPACE 1 03020000
CMRN37 EQU * * 5B 03030000
.T0050 ANOP 03040000
AIF (&N32).T0100 03050000
JNL CMRCMD NOT 3270, GO CHECK COMMAND MOD0B 03060000
SPACE 03061000
* IGNORE CHECKING FOR CLEAR KEY IF NOT THE FIRST TEXT BLOCK. 03062000
SPACE 03064000
TBN LCBAT2(,DTF),LCBSEC NON-FIRST BLOCK ? @09 03065000
JT CMRCMD YES-DON'T CHK FOR CLEAR KEY @09 03066000
AIF (&NAS).A0030 03070000
TBN $BDATT(,DTF),$BCASK THIS A ASCI LINE ? 0AB 03080000
JF CMRSTS NO-GO CHECK EBCDIC STATUS MSG0AB 03090000
CLC SNSTAS(2,XR1),CMSTAS THIS ASCI '%R' STATUS MSG ? 0AB 03100000
J CMRNEB GO TO CONDITIONAL JUMP. 0AB 03110000
SPACE 1 03120000
.A0030 ANOP 03130000
CMRSTS EQU * * 0B 03140000
CLC SNSTAS(2,XR1),CMSTUS THIS A STATUS MESSAGE ? 0B 03150000
CMRNEB EQU * * 0B 03160000
JNE CMRAID NO-GO CHECK AID. 0B 03170000
B $CC4PI GO TO CALL IN 0B 03180000
DC AL1(CC4BA) THE 3270 SENSE STATUS XIENT. 0B 03190000
L LCBPL@(,DTF),PL POINT XR1 TO PARM LIST @20 03200000
B CMFORM GO FORM NEXT OP ON THE LINE. 0B 03210000
SPACE 03220000
CMRAID EQU * * 0B 03230000
* -----------------------------START--@07 03230900
AIF (&NCS).T0052 03231800
AIF (&NSWL).T0051 03232700
TBN $BDATR(,DTF),$BCMCN SWITCHED LINE ? 0B 03233600
JF CMSAID YES-DON'T UPDATE TO CS AID 0B 03234500
.T0051 ANOP 03235400
LA 2(,XR1),XR1 BUMP POINTER FOR CONTROL STA. 0B 03236300
CMSAID EQU * * LOCAL 0B 03237200
.T0052 ANOP 03238100
* -----------------------------END----@07 03239000
AIF (&NAS).A0050 03240000
TBN $BDATT(,DTF),$BCASK THIS A ASCI LINE ? 0AB 03250000
JF CMRADE NO-GO CHECK EBCDIC AID VALUE.0AB 03260000
CLI AID(,XR1),ASCCLR THIS ASCI CLEAR INDICATION ? 0AB 03270000
J CMRPLS GO TO CONDTIONAL JUMP. 0AB 03280000
SPACE 1 03290000
CMRADE EQU * * 0AB 03300000
.A0050 ANOP 03310000
CLI AID(,XR1),AIDCLR CLEAR KEY HIT ? 0B 03320000
CMRPLS EQU * * 0B 03330000
L CMSPL,PL GET PARM LIST @ TO. 0B 03340000
TBN PL$OPC(,PL),OPLSNS POLLING FOR STATUS ? 0B 03350000
SBF PL$OPC(,PL),OPLSNS SET OFF POLL FOR STATUS IND. 0B 03360000
JF CMRCLR NO-GO SET CLEAR INDICATOR. 0B 03370000
L PLTUBA(,PL),XR2 POINT TO THE TUB. 0B 03380000
SBF TUBSCS(,XR2),TUBSSP SET OFF STATUS POLL IND. 0B 03390000
L TUBDTF(,XR2),DTF RELOAD THE DTF REG. 0B 03400000
MNN PL$OPM(,PL),PL$OPC(,PL) RESTORE ORIGINAL OP CODE. 0B 03410000
CMRCLR EQU * * 0B 03420000
JNE CMRCMD NOT CLEAR KEY, GO CK CMD MODE.0B 03430000
SPACE 03440000
* INDICATE CLEAR KEY HIT IF NOT SYSTEM USER. 0B 03450000
SPACE 03460000
TBN PLOPM(,PL),OPREQR SYSTEM USER ? 0B 03470000
SBN LCBAT1(,DTF),LCBEOT SET SEARCH EOT, DON'T DEQUE. 0B 03480000
SBN PL$OPC(,PL),OPRFSH SET REFRESH OPERATION NEEDED. 0B 03490000
MNN PL$OPC(,PL),PL$OPM(,PL) SAVE THE CURRENT OP CODE. 0B 03500000
* -------START-----------------@05 03503000
&MIX SETA &NRUF+&NDME 03504000
AIF (&MIX EQ '2').T0060 03506000
L PLTUBA(,PL),TUB * GET THE TUB ADDR. 0B 03510000
AIF (&NRUF).T0055 03512000
SBF TUBSCS(,TUB),TUBRUF RESET PRUF INDICATOR 03514000
.T0055 ANOP 03516000
AIF (&NDME).T0060 03518000
JT CMFOR1 GO TO CMFORM. 0B 03520000
SBN TUBSCS(,TUB),TUBCLR MARK TUB AS CLEAR KEY HIT. 0B 03530000
AGO .T0070 03531000
.T0060 ANOP 03532000
BF CMRCRC GO SEARCH EOT AND DE-Q 0B 03533000
.T0070 ANOP 03534000
* -------END-------------------@05 03535000
CMFOR1 EQU * BRANCH TO CMFORM. 0B 03540000
B CMFORM GO FORM NEXT OP ON THE LINE. 0B 03550000
SPACE 03560000
.T0100 ANOP 03570000
CMRCMD EQU * * B 03580000
L LCBPL@(,DTF),PL POINT TO THE PARM LIST. B 03590000
TBN PLOPM(,PL),OPREQR SYSTEM REQUEST ? B 03600000
JF CMRDAT NO-GO HANDLE DATA MODE. B 03610000
AIF (&NRUF).C0248 03611000
* -----START-------------------@06 03612000
* IF RUF PGM REQUEST, HANDLE LIKE A USER GET-MESSAGE OPERATION. 03613000
L PLTUBA(,PL),XR2 XR2->TUB. 03614000
TBN TUBSCS(,XR2),TUBRUF RUF ON THE SCREEN ? 03615000
L TUBDTF(,XR2),DTF XR2->LCB(DTF). 03616000
JT CMUSRC YES-GO HANDLE AS USER GET-MSG. 03617000
* -------END-------------------@06 03618000
.C0248 ANOP 03619000
SBN LCBAT1(,DTF),LCBEOT+LCBDEQ SET SEARCH EOT AND DEQUEUE. B 03620000
CMRDAT EQU * * B 03630000
.C0250 ANOP 03640000
L CMSPL,XR1 POINT XR1 AT PARM LIST 03650000
SPACE 03660000
* DETERMINE IF HAVE INVITE INPUT OR GET SPECIFIC 03670000
SPACE 03680000
TBN PL$OPM(,XR1),OPNOW IS NO WAIT BIT ON 03690000
JF CMRDMV JUMP IF WAIT OPERATION 03700000
AIF (&ONE).C0260 03710000
TBN $BDDEV(,DTF),BSCA BSCA DTF ? 2 03730000
JT CMRDMX USE CURRENT HOLD BUFFER. 2 03740000
.C0260 ANOP 03750000
SPACE 03760000
AIF (&NOM).M0500 03770000
* HAVE INVITE INPUT WHICH OP ENDED - MUST DO ANALYSIS OF HOLD BUFFER M 03780000
* AVAILABLE AGAINST WHAT IS NEEDED M 03790000
* BR TO DETERMINE STORAGE NEEDED FOR THIS PARM LIST IN XR1 M 03800000
SPACE 03810000
B CMSTOR BR TO ROUTINE WHICH DETERMINES M 03820000
* STORAGE NEEDED BY THIS OP. M 03830000
SPACE 03840000
* COMPARE STORAGE AREA NEEDED BY THIS OP AGAINST WHAT HAS ALREADY M 03850000
* BEEN GETMAINED FOR THIS LINE M 03860000
SPACE 03870000
CLC #BUFND(2),LCBIBL(,XR2) COMPARE NEEDED AGAINST GOTTEN M 03880000
JE CMUSRC JUMP IF EQ TO USE AREA GOTTE M 03890000
SPACE 03900000
* AREA NEEDED LESS THAN AREA GOTTEN - THUS MAY BE ABLE TO GETMAIN M 03910000
* FOR JUST WHAT IS NEEDED FOR THIS OPERATION LEAVING THE ALREADY M 03920000
* GOTTEN STORAGE FOR ANY OUTSTANDING INVITE INPUTS IN THE LINE QUEUE M 03930000
SPACE 03940000
* COMPARE STORAGE NEEDED AGAINST WHAT IS AVAILABLE WITH GETMAIN M 03950000
* IF NOT ENOUGH AVAILABLE USE ALREADY GOTTEN STORAGE M 03960000
* IF STORAGE AVAILABLE - GETMAIN IT AND USE FOR HOLD BUFFER M 03970000
SPACE 03980000
CLC #BUFND(2),CC#BMX CHECK NEEDED AGAINST AVAILABLE M 03990000
JH CMUSRC IF NEEDED HIGH, GO TO USE THIS M 04000000
* ALREADY GOTTEN RECORD AREA M 04010000
SPACE 04020000
* STORAGE AVAILABLE FOR A GETMAIN M 04030000
* GETMAIN FOR WHAT IS NEEDED AND USE THE NEW AREA FOR THIS RECORD M 04040000
* THUS LEAVING THE ALREADY GOTTEN STORAGE FOR THE REMAINING INVITE M 04050000
SPACE 04060000
MVC GMLIST+GMSIZE(2),#BUFND MOVE SIZE NEEDED TO GETMN LIST M 04070000
B CMGMRT BR TO GETMAIN INTERFACE ROUTINEM 04080000
SPACE 04090000
JOL CMUSRC JUMP IF GETMAIN FAILED M 04100000
SPACE 04110000
* GETMAIN WORKED - SO MOVE GETMAIN PARM LIST TO AREA JUST OBTAINED M 04120000
SPACE 04130000
L GMLIST+GMADDR,XR1 POINT XR1 AT AREA JUST GETMAINEM 04140000
MVC 3(4,XR1),GMLIST+GMSIZE MOVE GETMAIN PARM LIST TO AREA M 04150000
SPACE 04160000
SPACE 04170000
L CMSPL,XR1 RESTORE PARM LIST ADDR M 04180000
ALC GMLIST+GMADDR(2),CC0004 ADD 4 TO PT TO RECORD AREA M 04190000
MVC PLRECA(2,XR1),GMLIST+GMADDR MOVE ADDR TO PARM LIST M 04200000
SPACE 04210000
* FREEMAIN THE HOLD BUFFER WHICH IS NOT NEEDED M 04220000
SPACE 04230000
L LCBIBA(,XR2),XR2 POINT XR2 AT RECORD AREA M 04240000
B CMFMRT BRANCH TO FREEMAIN INTERFACE M 04250000
L CMSLCB,XR2 POINT XR2 AT DTF M 04260000
SPACE 04270000
J CMRDMX JUMP M 04280000
SPACE 04290000
.M0500 ANOP 04295000
CMUSRC EQU * USE THIS RECORD AREA M 04300000
AIF (&NOB).C0265 SKIP IF NO BSCA 04310000
TBN LCBAT2(,DTF),LCBSEC NON 1ST BLOCK? @09 04312000
TBN $BDDEV(,XR2),BSCA AND BSCA ? @10 04314000
JT CMNON1 ..YES, KEEP BUFFER @09 S312348 04316000
.C0265 ANOP 04318000
* MOVE THE HOLD BUFFER ADDRESS TO THE PARM LIST M 04320000
SPACE 04330000
MVC PLRECA(2,XR1),LCBIBA(,XR2) MOVE HOLD BUF ADDR TO PL M 04340000
SPACE 04350000
* MUST USE THIS CURRENT HOLD BUFFER FOR INVITE INPUT M 04360000
* THEREFORE MUST INIDCATE IN LCB THAT NO HOLD BUFFER IS AVAILABLE M 04370000
SPACE 04380000
.M0500 ANOP 04390000
CMRDMX EQU * READ/MOVE DATA 04400000
MVI LCBIBA-1(,XR2),NOBIT ZERO HIGH ORDER BYTE OF BUFR ADDR04410000
CMNON1 EQU * S312348 04415000
SPACE 04420000
.G0200 ANOP 04425000
MEND 04430000