|
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: 47244 (0xb88c)
Types: s3xseg
Names: »S$E120«
└─⟦4498c64f7⟧ Bits:30009191 5704-sc2.V05.ccp
└─⟦95ee7795b⟧
└─⟦this⟧ »S$E120«
MACRO 00010000
.********************************************************************** 00020000
.* * 00030000
.* TITLE: $E120 - INPUT OP END FROM BSCC (LINE 3 OR 4) * 00040000
.* * 00050000
.* STATUS: V4 M0 * 00060000
.* * 00070000
.* FUNCTION: HANDLE READ-TYPE OP ENDS FOR BSCC LINES 3 AND 4. * 00080000
.* SET UP THE CLB FOR THE CALL TO BSCC DATA MANAGEMENT. * 00090000
.* CALL TRANSIENT $CC4UE FOR ANY ERROR COMPLETION CODES. * 00100000
.* FOR MSG MODE TUB'S - BLOCK THE INPUT TEXT FOR THE * 00110000
.* USER,DEQUEUE THE OP ENDED OPERATION (PL) FROM THE * 00120000
.* CLB QUEUE. FOR INVITE INPUT OP ENDS - PUT THE PL ON * 00130000
.* THE USER'S TCB,POST THE USER THAT AN OP END HAS * 00140000
.* OCCURRED. * 00150000
.* * 00160000
.* OUTPUT: USER'S PL SET UP WITH LENGTH, TEXT POINTER, TEXT, AND * 00170000
.* RETURN CODE * 00180000
.* * 00190000
.* EXTERNAL REFERENCES: $CC4U0 - 3270 SYS INVITE TEXT EDITOR * 00200000
.* CSPSTE - SUBROUTINE TO POST USER AND QUEUE * 00210000
.* PL ON USER'S TCB * 00220000
.* YMWAIT - BSCC WAIT ROUTINE (IN MODULE * 00230000
.* $$BSYM) * 00240000
.* CC4FM - FREE MAIN ROUTINE * 00250000
.* POST - SYSTEM POST ROUTINE * 00260000
.* CC4MX - CCP MOVE ROUTINE * 00270000
.* CC4TT - SYSTEM TRACE ROUTINE * 00280000
.* CC4GM - GET MAIN ROUTINE * 00290000
.* CSDEQ - REMOVE PL FROM CLBPLQ * 00300000
.* * 00310000
.* EXITS: $E100 - TO CHECK FOR MORE WORK * 00320000
.* $E140 - TO SCHEDULE THE OP ENDED LINE * 00330000
.* * 00340000
.********************************************************************** 00350000
.* * 00360000
.* GBLB &NDME * NO * DATA MODE ESCAPE SUPPORT * 00370000
.* * 00380000
.* GBLB &CACI * NO * ASCII SUPPORT * 00390000
.* * 00400000
.* GBLB &CINT * NO * INTERVAL POLLING * 00410000
.* * 00420000
.* GBLA &C#NL * NUMBER * OF BSCC LINES * 00430000
.* * VALUE OF 1 OR 2 * 00440000
.* * 00442000
.* GBLB &NPBY * NO * BUSY PRINT SUPPORT. * 00444000
.* * 00444500
.* GBLB &NBCPP * NO * POINT TO POINT SUPPORT. * 00445000
.* * 00445500
.* * 00448000
.********************************************************************** 00460000
$E120 00470000
GBLB &CSIO 0=SUPPORTED,1=NOT SUPPORTED 00475000
GBLB &NDME,&CACI,&CINT,&NPBY 00480000
GBLA &C#NL 00490000
GBLB &NBCPP,&NCPOR 00495000
TEXT 00500000
TITLE '$ E 1 2 0 - I N P U T O P E N D ' 00510000
* HANDLE ANY INPUT OP ENDS (XR2 --> OP-ENDED CLB) 00520000
SPACE 1 00530000
CSREAD EQU * 00540000
ST CSSCLB,CLB SAVE CLB ADDRESS 00550000
AIF (&CSIO EQ '1').NP005 00550700
SPACE 1 00551400
******************************************************************* @14 00552100
******* 00552800
CLI CLBDEV(,CLB),DEVSIO SIOC ONLY DEVICE ? 00553500
JNE CSRPTN NO 00554200
ALC CTR4(3),X$0001 +1 TO NUMBER INPUT OPENDS 00554900
CSRPTN EQU * * 00555600
******* 00556300
******************************************************************* @14 00556600
SPACE 1 00557000
.NP005 ANOP 00558400
MVC CSSPL,CLBPL@(2,CLB) SAVE THE CURRENT P.L. ADDRESS 00560000
TBN CLBBA2(,CLB),BA2RCI THIS THE FIRST BLOCK? 00570000
BF CSRNFB NO--GO DO NON-FIRST BLOCK SETUP 00580000
SPACE 2 00590000
* HAVE AN OP-END FROM A POLL - FIND THE ASSOCIATED PL ON CLBPLQ OR 00600000
* ON CLBSTQ 00610000
SPACE 1 00620000
AIF (&NCPOR).PT010 00620400
******************************************************************* @14 00620800
******* 00621200
TBN CLBBA3(,CLB),BA3PON PORTLINE ONLY ? 00621600
JF CSRPNP NO - CONTINUE 00622000
L CLBCIB(,CLB),XR1 XR1 --> CIB 00622400
TBN 6(,XR1),X'04' IS THE DATA IN YET ? 00622800
JF CSRNOD YES - GO GET THE DATA 00623200
L CLBPL@(,CLB),PL XR1 --> PL 00623600
B CSRWAT GO TO THE WAIT ROUTINE 00624000
CSRNOD EQU * 00624400
MVC PORTAR(2),12(,XR1) MOVE IN THE DATA BUFFER ADDRESS 00624800
ALC PORTAR(2),21(,XR1) ADD THE TAR DISPLACEMENT TO IT 00625200
L PORTAR,XR1 XR1 --> DATA RECEIVED 00625600
MVC CLBIND(1,CLB),0(,XR1) MOVE IN THE PORT ID BYTE 00626000
MVC CLBREL(2,CLB),2(,XR1) MOVE IN THE OTHER SYSTEMS RECL 00626400
CSRPNP EQU * * 00626800
******* 00627200
******************************************************************* @14 00627600
SPACE 1 00628000
.PT010 ANOP 00628400
LA CLBPLQ-1(,CLB),PL XR1 --> BEGIN OF QUEUE 00630000
AIF (&CSIO EQ '1').PT020 00630700
AGO .PT030 00631400
.PT020 ANOP 00632100
AIF (&NCPOR).PT040 00632200
.PT030 ANOP 00632300
SPACE 1 00632400
******************************************************************* @14 00632500
******* 00632800
MVC CSRRPI+1,CLBIND(1,CLB) SAVE CLBIND FOR PORT DEVICE 00633500
TBN CLBBA3(,CLB),BA3POR PORTLINE OR SIOC DEVICE ? 00634200
JF CSRLAG NO 00634900
SBF CLBIND(,CLB),TPXCMD TURN OFF COMMAND INDICATOR 00635600
MVI CSRPOS-1,TUBID-1 ADJUST THE CLC FOR PORTLINE 00635900
******* 00636300
******************************************************************* @14 00636600
SPACE 1 00638000
.PT040 ANOP 00638400
CSRLAG EQU * * 00640000
CLI PLCHN-1(,PL),NOBIT END OF CHAIN? 00650000
AIF (&CSIO EQ '1').PT050 00651000
AGO .PT060 00651100
.PT050 ANOP 00651200
AIF (&NCPOR).PT070 00651300
.PT060 ANOP 00651400
SPACE 1 00651500
******************************************************************* @14 00651600
******* 00653000
ST CSRSPM+3,PL SAVE ADDRESS OF LAST ON CHAIN 00655000
******* 00656000
******************************************************************* @14 00656500
SPACE 1 00658000
.PT070 ANOP 00659000
JE CSRCST YES - CHECK STOP INVITE QUEUE 00660000
L PLCHN(,PL),PL XR1 --> NEXT PL 00670000
ST CLBPL@(,CLB),PL SAVE THIS PL ADDRESS 00680000
AIF (&NBCPP).PP010 00680800
SPACE 1 00681600
******************************************************************* @14 00682400
******* 00683200
TBF CLBATR(,CLB),ATRCTL IS THIS A POINT TO POINT LINE ? 00684000
TBF CLBBA3(,CLB),BA3POR AND NOT A PORTLINE OPERATION ? 00684800
JT CSRNPP YES - POINT TO POINT 00685600
******* 00686400
******************************************************************* @14 00687200
SPACE 1 00688000
.PP010 ANOP 00688800
TBN PL$OPM(,PL),OPGET THIS A GET PL AND 00690000
L PLTUBA(,PL),XR1 XR1 --> TUB 00700000
CLC CLBIND(1,CLB),TUBSID(,XR1) SAME TERMINAL ID? 00710000
CSRPOS EQU * 00715000
L CLBPL@(,CLB),PL XR1 --> PL 00720000
BC CSRLAG,FLSONE NO - LOOK AGAIN 00730000
SPACE 2 00740000
* FOUND THE OP-ENDED PL - GO SET UP CLB FOR BSCC WAIT ROUTINE 00750000
CSRNPP EQU * 00760000
J CSRSTU GO SET UP THE CLB 00770000
SPACE 2 00780000
* PL NOT FOUND ON CLBPLQ - LOOK ON STOP INVITE QUEUE 00790000
SPACE 1 00800000
CSRCST EQU * 00810000
AIF (&CSIO EQ '1').PT080 00810600
AGO .PT090 00811200
.PT080 ANOP 00811800
AIF (&NCPOR).PT100 00812400
.PT090 ANOP 00813000
SPACE 1 00813600
******************************************************************* @14 00814200
******* 00814800
TBN CLBBA3(,CLB),BA3POR IS THIS A PORTLINE OPERATION ? 00815400
JT CSRDST YES - RECEIVE THE DATA IN DUMMY 00816000
******* 00816600
******************************************************************* @14 00817200
SPACE 1 00817800
.PT100 ANOP 00818400
LA CLBSTQ-1(,CLB),PL XR1 --> START OF QUEUE 00820000
CSRSLA EQU * * 00830000
CLI PLCHN-1(,PL),NOBIT END OF CHAIN? 00840000
JE CSRDST YES - ERROR CRASH THE SYSTEM 00850000
L PLCHN(,PL),PL XR1 --> NEXT PL 00860000
ST CLBPL@(,CLB),PL SAVE THIS PL ADDRESS 00870000
AIF (&NBCPP).PP020 00870900
SPACE 1 00871800
******************************************************************* @14 00872700
******* 00873600
TBN CLBATR(,CLB),ATRCTL IS THIS CONTROL STATION 00874500
JF CSRPLF NO, THEN POINT TO POINT 00875400
******* 00876300
******************************************************************* @14 00877200
SPACE 1 00878100
.PP020 ANOP 00879000
L PLTUBA(,PL),XR1 XR1 --> TUB 00880000
CLC CLBIND(1,CLB),TUBSID(,XR1) SAME TUB? 00890000
L CLBPL@(,CLB),PL XR1--> PL 00900000
BNE CSRSLA NO - LOOK AGAIN 00910000
SPACE 1 00920000
* HAVE FOUND THE PL - GO SET UP THE CLB FOR BSCC WAIT ROUTINE 00930000
SPACE 1 00940000
CSRPLF J CSRSTU GO SET UP THE CLB 00950000
CSRDST EQU * * 00950100
AIF (&CSIO EQ '1').PT110 00950200
AGO .PT120 00950210
.PT110 ANOP 00950220
AIF (&NCPOR).PT130 00950230
.PT120 ANOP 00950240
SPACE 1 00950250
******************************************************************* @14 00950260
******* 00950300
* RTN TO SET UP PL FOR SIOC INPUT WITHOUT A GET 00950600
* FILL IN PL FIELDS THAT ARE NECESSARY 00950700
* PUT PL ON CLBPLQ 00950800
SPACE 00950900
TBN CLBBA3(,CLB),BA3POR PORTLINE OR SIOC DEVICE ? 00951000
JF CSRDTT NO, NOW A DISASTER 00951100
CSRSPM LA #,PL POINT TO LAST ON CHAIN 00951200
MVC PLCHN(2,PL),@PRMDY CHAIN IN DUMMY PARM LIST 00951300
L @PRMDY,PL POINT TO DUMMY PARM LIST 00951400
MVI PLCHN-1(,PL),NOBIT ASSURE THIS IS THE END-OF-CHAIN 00951500
ST CLBPL@(,CLB),PL SAVE THIS PL ADDRESS 00951600
MVC PLINL(2,PL),CLBMCL(,CLB) MAX MESSAGE LENGTH 00951700
* FIND TUB TO GO WITH THIS OPERATION 00951800
L @TUBQ,XR1 POINT TO FIRST TUB 00951900
* THERE MUST BE A PORT FOR THE DATA. 00952000
* IF NOT,THE USER DID NOT ASSIGN A PORT TO GO WITH THE PORT HE PUT 00952100
* FROM IN THE OTHER CPU 00952200
CSRSNP CLI TUBCCP(,XR1),TUBSTP END OF TUBS 00952300
JE CSRLDT YES 00952400
TBN TUBPHY(,XR1),TUBAPT PORT TUB ? 00952500
JF CSRSLP NO - CONTINUE LOOKING 00952600
CLC CLBIND(1,CLB),TUBID-1(,XR1) FIND CORRECT TUB 00952700
JNE CSRSLP NO - CONTINUE LOOKING 00952800
CLC CSSCLB(2),TUBDTF(,XR1) IS THIS THE CORRECT DTF ? 00952810
JE CSRSFT YES - THIS IS THE CORRECT PORT 00952820
CSRSLP EQU * 00952830
TBN TUBCHR(,XR1),TUBCMN IS THIS A COMMAND MODE TUB ? 00952840
JF CSRSLT NO - THIS IS A SHORT TUB 00952850
LA TUBLNC-TUBLN(,XR1),XR1 BUMP FOR COMMAND MODE TUB 00953100
CSRSLT EQU * 00953130
LA TUBLN(,XR1),XR1 BUMP FOR NON-COMMAND MODE TUB 00953160
B CSRSNP GO TRY NEXT TUB 00953300
CSRSFT L @PRMDY,XR2 POINT TO DUMMY PARM LIST 00953400
ST PLTUBA(,XR2),XR1 SAVE TUB ADDRESS IN PL 00953500
MVC PL$TNT(2,XR2),TUBTNT(,XR1) TNT ENTRY ADDRESS 00953600
L CSSCLB,CLB XR2-->CLB 00953700
L CLBPL@(,CLB),PL XR1--> PL 00953800
J CSRSTU GO SET UP THE CLB 00953900
* NO PORT TUB WAS FOUND FOR THE DATA. GO TO YMWAIT TO GET THE @22 00953950
* COMPLETION CODE. IF COMPLETION CODE WAS A 40, PUT IN A 4D @22 00954000
* COMP. CODE AND GO TO $CC4UE TO U-CR (THE OTHER SYSTEM DID A @22 00954010
* PUT TO A PORT THAT WE DO NOT HAVE). IF COMPLETION CODE WAS NOT @22 00954020
* A 40, GO TO $CC4UE TO HANDLE WHAT EVER IT IS (WE MAY HAVE GOTTEN @22 00954030
* AN UNEXPECTED OP END SUCH AS A TIME OUT SO THAT THE TUB ID @22 00954040
* WAS NOT IN THE DATA STREAM ). @22 00954050
CSRLDT EQU * * 00954100
B YMWAIT CALL BSCC WAIT ROUTINE @22 00954110
SBF $FLGC,#NTRCS SET TO TRACE THIS OP-END @22 00954120
B CC4TT TRACE THE CHECK ENTRY @22 00954130
DC AL1(TTMOPN) TRACE ID @22 00954140
CCP UNMASK,PMR ALLOW INTERRUPTS @22 00954150
CLI CLBCMP(,CLB),CMPEND NORMAL COMPLETION? @22 00954160
JE CSRUDS YES, U-CR WITH 4D COMP CODE @22 00954170
L CSSPL,PL NO, POINT TO CLBPL@ @22 00954180
J CSRGUE GO TO UE TO HANDLE BAD COMP @22 00954190
CSRUDS MVI CLBCMP(,CLB),CMPIRQ SET CANCEL CODE FOR $CC4UF @22 00954200
L @PRMDY,PL XR1 --> PL 00954300
CSRGUE B CC4TA CALL TRANSIENT AREA HANDLER @22 00954400
DC AL1(CC4UE) ERROR TRANSIENT ID ($CC4UE) 00954500
* GO SCHEDULE THIS LINE @22 00954510
SLC #CSOND(1),X$0001 DECREMENT OP END COUNT @22 00954520
SLC CLBOPE(1,CLB),X$0001 DECREMENT CLB OP END COUNT @22 00954530
B CSCHED GO SCHEDULE THIS LINE @22 00954540
* @22 00954550
CSRDTT EQU * * 00954600
******* 00954700
******************************************************************* @14 00954750
SPACE 1 00954800
.PT130 ANOP 00955000
DC AL2(0) DISASTER ERROR--NO PL ON THE 00960000
* QUEUE FOR THE OP-ENDED TERMINAL 00970000
EJECT 00980000
* SET UP THE CLB FOR THE BSCC WAIT ROUTINE 00990000
* XR2 --> CLB 01000000
* CLBPL@ CONTAINS THE PL ADDRESS 01010000
SPACE 1 01020000
CSRSTU EQU * * 01030000
AIF (&CSIO EQ '1').PT140 01031000
AGO .PT150 01031100
.PT140 ANOP 01031200
AIF (&NCPOR).PT160 01031300
.PT150 ANOP 01031400
SPACE 1 01031500
******************************************************************* @14 01031600
******* 01031700
CSRRPI MVI CLBIND(,CLB),# RESTORE PORTID TO CLB 01035000
MVI CSRPOS-1,TUBSID RESTORE THE CLC FOR BSCC OP ENDS 01035500
******* 01037000
******************************************************************* @14 01037500
SPACE 1 01038000
.PT160 ANOP 01039000
L CLBPL@(,CLB),PL XR1 --> PL 01040000
ST CSSPL,PL SAVE THE PL ADDRESS 01050000
L PLTUBA(,PL),XR1 XR1 --> TUB 01060000
MVC CLBOWN(2,CLB),TUBTCB(,XR1) CURRENT TCB@ 01065000
SBN TUBAT2(,XR1),TUBOWN SET TUB OWNERSHIP INDICATOR 01070000
L CLBPL@(,CLB),PL XR1 --> PL 01080000
B CSTASV SAVE THIS TUB'S ATTRIBUTES 01090000
SPACE 1 01100000
* GETMAIN THE REQUIRED AMOUNT OF TP BUFFERS 01110000
SPACE 1 01120000
CLI CLBIBA-1(,CLB),NOBIT ANY TO FREE? 01130000
JE CSRNFE NO - SKIP FREEMAIN 01140000
* MUST REMAIN MASKED UNTIL AFTER THE GET-MAIN TO PREVENT CM FROM 01150000
* SNATCHING THE TP BUFFER AREA THAT WAS PREVIOUSLY RESERVED--------->| 01160000
CCP MASK,PMR MASK INTERRUPTS | 01170000
L CLBIBA(,CLB),XR2 XR2 --> AREA TO FREE | 01180000
B CC4FM GO TO FREEMAIN ROUTINE | 01190000
L CSSCLB,CLB XR2 --> CLB | 01200000
MVI CLBIBA-1(,CLB),NOBIT ZIP LEFT-MOST BYTE | 01210000
CSRNFE EQU * * | 01220000
TBF CLBAT1(,CLB),AT1SOH STATUS MSG COMING IN? | 01230000
TBF CLBBA3(,CLB),BA3STS OR SHOULD BE COMING IN ? | 01240000
JT CSRNOS NO - JUMP | 01250000
SPACE 1 | 01260000
* USE THE STATUS AREA IN $CC4U0 FOR THIS TEXT--IT IS EITHER A STATUS | 01270000
* MSG OR WE ARE GOING TO SWALLOW THIS DATA | 01280000
CSRSTS EQU * | 01290000
CCP UNMASK,PMR ALLOW INTERRUPTS | 01300000
AIF (&CSIO EQ '1').PT170 01300300
AGO .PT180 01300330
.PT170 ANOP 01300360
AIF (&NCPOR).PT190 01300390
.PT180 ANOP 01300420
SPACE 1 01300450
******************************************************************* @14 01300480
******* 01300510
* IF PORT DEVICE, PUT IN ADDRESS OF PORT AREA TO EAT THE DATA | 01301500
TBN CLBBA3(,CLB),BA3POR PORTLINE OR SIOC DEVICE ? | 01301800
JF CSRPNT NO | 01302100
SPACE 01302400
CSRCMD TBN CLBIND(,CLB),TPXCMD COMMAND DATA | 01302700
JT CSRKEP YES, KEEP THE DATA | 01303000
MVI CLBOPC(,CLB),OPCFAB PUT ABORT OP IN THE CLB | 01303300
SBN CLBBA2(,CLB),BA2ABT SET ABORT REQUEST | 01303600
TBN PLOPC(,PL),OPDMY DUMMY PARM LIST | 01303900
JF CSRAGN NO | 01304200
B CSDEQ GO DEQUEUE PL FROM CLBPLQ | 01304500
CSRAGN EQU * * | 01304800
B CSNOEN GO WAIT ON THE ABORT | 01305100
CSRKEP EQU * * | 01305400
SBF CLBBA2(,CLB),BA2ABT CLEAR ABORT REQUEST | 01305700
L PLTUBA(,PL),XR1 XR1--> TUB | 01306000
SBF TUBSCS(,XR1),TUBPRG SET OFF PORT PURGE INDICATOR | 01306300
L CLBPL@(,CLB),PL XR1--> PL | 01306600
J CSRGTM GO TO NORMAL PROCESSING | 01306900
CSRPNT EQU * * | 01307200
******* | 01307500
******************************************************************* @14 01307600
SPACE 1 | 01307800
.PT190 ANOP 01308400
MVC CLBWKB(2,CLB),@CSTS3 PUT LINE 3 ADDRESS IN | 01310000
AIF (&C#NL EQ '1').L0600 ONE LINE ONLY. 01320000
CLI CLBDEV(,CLB),DEVBS3 LINE 3? | 01330000
JE CSRIS3 YES - JUMP | 01340000
MVC CLBWKB(2,CLB),@CSTS4 PUT LINE 4 ADDRESS IN | 01350000
CSRIS3 EQU * * | 01360000
.L0600 ANOP * 01370000
MVC CLBREL(2,CLB),LNTHSS PUT STATUS MSG LENGTH IN | 01380000
CSRNSS EQU * * | 01390000
TBN CLBBA3(,CLB),BA3STS WAS A POLL FOR STATUS ACTIVE | 01400000
TBF CLBAT1(,CLB),AT1SOH AND NO STATUS RECEIVED ? | 01410000
BF CSRWAT NO - CALL BSCC WAIT ROUTINE | 01420000
SPACE 1 | 01430000
* DID A POLL FOR STATUS BUT DID NOT GET STATUS - RATHER THAN | 01440000
* HANGING THE SYSTEM IN A POLL FOR STATUS LOOP - PUT THIS | 01450000
* TERMINAL INTO ERROR RECOVERY OR GIVE THE USER A NEGATIVE | 01460000
* RETURN CODE | 01470000
SPACE 1 | 01480000
TBN CLBBA1(,CLB),BA1CRI STOP INVITE REQUESTED ? @11 01481000
JF CSRNSI NO - $CC4UE TO HANDLE ERROR @11 01482000
B *+5 SET ARR FOR TERM. BRANCH @11 01483000
DC AL1(TINS) U-NS HALT @11 01484000
L @CC4TH,IAR BRANCH TO TERMINATION @11 01485000
CSRNSI EQU * @11 01486000
B YMWAIT CALL BSCC WAIT ROUTINE | 01490000
SBF $FLGC,#NTRCS SET TO TRACE THIS OP-END | 01500000
B CC4TT TRACE THE CHECK ENTRY | 01510000
DC AL1(TTMOPN) TRACE ID | 01520000
CCP UNMASK,PMR ALLOW INTERRUPTS | 01530000
B CC4TA CALL TRANSIENT AREA HANDLER | 01540000
DC AL1(CC4UE) ERROR TRANSIENT ID - $CC4UE | 01550000
* GO SCHEDULE THIS LINE | 01560000
SLC #CSOND(1),X$0001 DECREMENT OP-END COUNT @03 | 01563000
SLC CLBOPE(1,CLB),X$0001 DECREMENT CLB OP-END COUNT @03 | 01566000
B CSCHED GO SCHEDULE THIS LINE | 01580000
SPACE 2 | 01590000
* NOT A STATUS MSG - SEE IF THIS IS A PURGE PL | 01600000
SPACE 1 | 01610000
CSRNOS EQU * * | 01620000
TBN PLOPC(,PL),OPPUT+OPGET IS THIS A --- | 01630000
TBN PLOPM(,PL),OPSTOP PURGE PL? | 01640000
BT CSRSTS YES - USE STATUS HOLD AREA | 01650000
AIF (&CSIO EQ '1').NP060 01650600
SPACE 1 | 01651200
******************************************************************* @14 01651500
******* | 01651800
TBN PL$OPM(,PL),OPGET GET OP CODE | 01653000
L PLTUBA(,PL),TUB XR2--> TUB | 01653600
TBN TUBSCS(,TUB),TUBPRG PORT PURGE IN PROCESS | 01654200
L CSSCLB,CLB XR2--> CLB | 01654800
CLI CLBDEV(,CLB),DEVSIO SIOC ONLY DEVICE ? | 01655400
BC CSRSTS,TRUAEQ IF SIOC PURGE, GO THROW DATA | 01656000
******* | 01656600
******************************************************************* @14 01656900
.NP060 ANOP 01658400
SPACE 2 | 01660000
* GETMAIN THE CORRECT SIZE INPUT AREA USING PLINL AND PUT IT'S | 01670000
* ADDRESS INTO THE CLB | 01680000
SPACE 1 | 01690000
CSRGTM EQU * * | 01695000
LA GMLIST,XR2 XR2 --> GM PL | 01700000
MVI 0(,XR2),NOBIT MAKE IT A NOWAIT REQUEST | 01710000
MVC GMSIZE(2,XR2),PLINL(,PL) PUT IN REQUIRED SIZE | 01720000
AIF (&CSIO EQ '1').PT200 01730400
AGO .PT210 01730450
.PT200 ANOP 01730500
AIF (&NCPOR).PT220 01730550
.PT210 ANOP 01730600
SPACE 1 01730650
******************************************************************* @14 01730700
******* | 01730750
L CSSCLB,XR1 XR1--> CLB | 01732000
TBN CLBBA3(,XR1),BA3POR PORTLINE OR SIOC DEVICE ? | 01732400
JF CSRGPL NO | 01732800
MVC GMSIZE(2,XR2),CLBBKL(,XR1) USE LENGTH FROM OTHER SYSTEM | 01733200
TBN CLBBA3(,XR1),BA3PON IS THIS A PORTLINE ONLY CLB ? | 01733280
JF CSRGP1 NO - CONTINUE | 01733360
MVC GMSIZE(2,XR2),CLBREL(,XR1) USE LENGTH FROM OTHER SYSTEM | 01733440
CSRGP1 EQU * | 01733520
ALC GMSIZE(2,XR2),LNTHCC ADD LENGTH FOR CONTROL INFO | 01733600
TBN CLBIND(,XR1),TPXCMD COMMAND DATA | 01734000
L CLBPL@(,XR1),PL XR1--> PL | 01734400
JF CSRINL NO | 01734800
MVC PRTWRK(1),#PCTLN MAXPCT TO 2-BYTE ADD AREA | 01735200
ALC GMSIZE(2,XR2),PRTWRK ADD MAXPCT LENGTH | 01735600
CSRINL EQU * * | 01736000
TBN PLOPM(,PL),OP$SYS SYSTEM OP | 01736400
JF CSRGPL NO | 01736800
MVC PLINL(2,PL),GMSIZE(,XR2) SET LENGTH OF TPBUFF INPUT AREA| 01737200
CSRGPL EQU * * | 01737600
******* | 01738000
******************************************************************* @14 01738200
SPACE 1 | 01738800
.PT220 ANOP 01739200
ALC GMSIZE(2,XR2),X$0004 ADD 4 FOR GM PL | 01739600
B CSGMRQ GO DO THE GM | 01740000
JNOL CSRGMW GM WORKED - JUMP | 01750000
DC AL1(0) GM FAILED - SHOULDN'T HAVE | 01760000
CSRGMW EQU * * | 01770000
LA 0(,XR2),XR1 XR1 --> GM PL LIST | 01780000
L CSSCLB,CLB XR2 --> CLB | 01790000
MVC CLBIBA(2,CLB),GMADDR(,XR1) PUT ADDRESS IN CLB | 01800000
AIF (&CSIO EQ '1').PT230 01800500
AGO .PT240 01800560
.PT230 ANOP 01800620
AIF (&NCPOR).PT250 01800680
.PT240 ANOP 01800740
SPACE 1 01800800
******************************************************************* @14 01800860
******* | 01800920
* SET UP GETMAIN AREA FOR PORTS (SEE MACRO $ETPX) | 01802500
TBN CLBBA3(,CLB),BA3POR PORTLINE OR SIOC DEVICE ? | 01803000
JF CSRNPT NO | 01803500
L CLBIBA(,CLB),XR1 XR1 --> GETMAIN AREA | 01804000
SLC TPXRTC(4,XR1),TPXRTC(,XR1) CLEAR RETURN CODE/DATA ADDRESS| 01804500
ALC CLBIBA(2,CLB),LNTHCC BUMP TPBUFF ADDR PAST SAVE AREA| 01805000
MVC TPXFRL(4,XR1),TPXFRP(,XR1) MOVE GETMAIN/FREEMAIN PARMS | 01805500
MVC TPXPID(1,XR1),CLBIND(,CLB) PORT ID TO TPBUFF | 01806000
MVC TPXDLN(2,XR1),CLBBKL(,CLB) LENGTH OF TEXT TO TPBUFF | 01806500
TBN CLBBA3(,CLB),BA3PON IS THIS A PORTLINE ONLY CLB ? | 01806600
JF CSRNPT NO - CONTINUE | 01806700
MVC TPXDLN(2,XR1),CLBREL(,CLB) LENGTH OF TEXT TO TPBUFF | 01806800
SLC TPXDLN(2,XR1),X$0003 -3 FROM PLEFFL FOR CONTROL DATA| 01806900
CSRNPT EQU * * | 01807000
******* | 01807500
******************************************************************* @14 01807700
SPACE 1 | 01808000
.PT250 ANOP 01809000
CCP UNMASK,PMR UNMASK INTERRUPTS <------------| 01810000
ALC CLBIBA(2,CLB),X$0004 UP ADDRESS TO DATA FIELD 01820000
L CLBPL@(,CLB),PL XR1 --> PL 01830000
MVC CLBIBL(2,CLB),PLINL(,PL) PUT SIZE IN CLB 01840000
AIF (&CSIO EQ '1').PT260 01840600
AGO .PT270 01840680
.PT260 ANOP 01840760
AIF (&NCPOR).PT280 01840840
.PT270 ANOP 01840920
SPACE 1 01841000
******************************************************************* @14 01841080
******* 01841200
* USE LENGTH OF DATA SENT FROM OTHER SYSTEM 01843000
* LENGTH PUT IN CLBBKL BY PORT INTERRUPT HANDLER 01843600
TBN CLBBA3(,CLB),BA3POR PORTLINE OR SIOC DEVICE ? 01844200
JF CSRUPL NO 01844800
MVC CLBIBL(2,CLB),CLBBKL(,CLB) LENGTH FROM OTHER SYSTEM 01845400
TBN CLBBA3(,CLB),BA3PON IS THIS A PORTLINE ONLY CLB ? 01845500
JF CSRUPL NO - CONTINUE 01845600
MVC CLBIBL(2,CLB),CLBREL(,CLB) LENGTH FROM OTHER SYSTEM 01845700
CSRUPL EQU * * 01846000
******* 01846600
******************************************************************* @14 01846900
SPACE 1 01847200
.PT280 ANOP 01848400
MVC CLBMR@(4,CLB),CLBIBA(,CLB) SAVE ORIGINAL SIZE AND LENGTH 01850000
MVC CLBWKB(2,CLB),CLBIBA(,CLB) PUT ADDRESS IN FOR BSCC WAIT 01860000
MVC CLBREL(2,CLB),CLBIBL(,CLB) PUT IN LENGTH WANTED 01870000
SPACE 3 01880000
* GO TO THE BSCC WAIT ROUTINE TO MOVE THE TEXT 01890000
SPACE 2 01900000
CSRWAT EQU * * 01910000
AIF (&CSIO EQ '1').NP100 01910900
SPACE 1 01912700
******************************************************************* @14 01913100
******* 01913600
B CSWATE GO TO BSCC OR SIOC WAIT 01914500
******* 01915400
******************************************************************* @14 01915800
SPACE 1 01916300
AGO .YP100 01918100
.NP100 ANOP 01919000
B YMWAIT BSCC WAIT ROUTINE 01920000
.YP100 ANOP 01925000
* TRACE THE OP-END - UNLESS THIS IS INTERVAL POLLING AND 01930000
* ALL TERMINALS HAVE RESPONDED WITH EOT (NO TEXT TO SEND) 01940000
TBN CLBBA2(,CLB),BA2RCI POLLING AND - 01950000
CLI CLBCMP(,CLB),CMPNEG NEGATIVE RESPONSE - 01960000
TBN $FLGC,#NTRCS AND WANT TO SKIP TRACE ? 01970000
JC CSRSTR,TRUAEQ YES - SKIP TRACE 01980000
B CC4TT GO TO TRACE SUBROUTINE 01990000
DC AL1(TTMOPN) OP-END TRACE 02000000
* TRACE ROUTINE RETURNS WITH INTERRUPTS MASKED 02010000
CCP UNMASK,PMR ALLOW INTERRUPTS 02020000
CSRSTR EQU * * 02030000
SLC #CSOND(1),X$0001 DECREMENT OP-END COUNT 02040000
SLC CLBOPE(1,CLB),X$0001 DECREMENT CLB OP-END COUNT 02050000
SPACE 2 02060000
* CHECK FOR AND HANDLE ANY STOP INVITES 02070000
TBN CLBBA1(,CLB),BA1CRI STOP INVITE PREVIOUSLY REQUESTED 02080000
JF CSRNST NO - GO CHECK COMP CODE 02090000
SPACE 1 02100000
* CALL THE STOP INVITE TRANSIENT TO CLEAN UP ANY OUTSTANDING STOPS 02110000
SPACE 1 02120000
B CC4TA CALL TRANSIENT AREA HANDLER 02130000
DC AL1(CC4UT) TRANSIENT ID - $CC4UT 02140000
SPACE 2 02150000
* TRANSIENT WILL RETURN ON THE ARR TO RESCHEDULE THE LINE 02160000
* WILL RETURN ON ARR+4 TO HANDLE THE OP-END 02170000
SPACE 1 02180000
B CSCHED GO SCHEDULE THE LINE 02190000
SPACE 1 02200000
* HANDLE THE OP-END 02210000
SPACE 1 02220000
CSRNST EQU * * 02230000
CLI CLBCMP(,CLB),CMPCMP NOT DONE YET COMP CODE? 02240000
JNE CSRCPL NO - JUMP 02250000
L PLTUBA(,PL),TUB XR2--> TUB 02260000
SBF TUBAT2(,TUB),TUBOWN SET OFF OWNERSHIP IND 02270000
B CSNMOR GO CHECK FOR MORE WORK 02280000
CSRCPL EQU * * 02290000
SPACE 1 02300000
AIF (&CINT).IP201 NO INT POLL,CHK BSY PRT 02310000
AGO .IP202 WHEN INTPOL,SKIP BSY PRT TST 02312000
.IP201 ANOP 02314000
AIF (&NPBY).I0100 . NOT BSYPRT OR INTPOL 02316000
.IP202 ANOP . BUSY PRINT,OR INTERVAL POLL 02318000
* CHECK FOR INTERVAL POLLING WAIT REQUIRED 02320000
SPACE 1 02330000
CLI CLBCMP(,CLB),CMPNEG 44 COMP CODE AND 02340000
TBN CLBBA2(,CLB),BA2RCI POLLING? 02350000
JC CSRNIP,FLSONE NO - JUMP 02360000
AIF (&CINT).IP203 . SKIP IF ONLY BUSY PRINTER 02365000
SBN $FLGC,#NTRCS SET TO SKIP TRACE (INT POLL) 02370000
.IP203 ANOP . BSY PRT OR INTERVAL POLL 02375000
SPACE 1 02380000
* GET TIME REMAINING FROM INTERVAL TIMER - IF IT IS ZERO, THEN GO WAIT 02390000
SPACE 1 02400000
SLC CLBBA2(2,CLB),CLBBA2(,CLB) ZIP THE LINE ATTRIBUTES 02410000
L PLTUBA(,PL),XR1 XR1--> TUB 02420000
SBF TUBAT2(,XR1),TUBOWN SET OFF TUB OWNER IND 02430000
SPACE 1 02440000
* FREE ANY INPUT AREA - CM MAY BE ABLE TO USE IT 02450000
SPACE 1 02460000
CLI CLBIBA-1(,CLB),NOBIT ANY TO FREE? 02470000
JE CSRTNF NO - JUMP 02480000
L CLBIBA(,CLB),XR2 XR2 --> AREA TO FREE 02490000
CCP MASK,PMR MASK INTERRUPTS 02500000
B CC4FM GO FREE IT 02510000
CCP UNMASK,PMR UNMASK INTERRUPTS 02520000
L CSSCLB,CLB XR2 --> CLB 02530000
MVI CLBIBA-1(,CLB),NOBIT WIPE OUT THE ADDR 02540000
CSRTNF EQU * 02550000
AIF (&CINT).IP204 . INT POLL ONLY 02555000
LA CSTIMR,XR2 XR2 --> TIMER IOB 02560000
MVI TIMFLG(,XR2),ALLBIT SET TO CANCEL TIME REMAINING 02570000
SVC 0 SPVR CALL 02580000
DC AL1(TTMRIB) TIMER RIB - GET TIME REMAINING 02590000
SBF TIMECB(,XR2),POST+WAIT SET OFF POSTED BITS 02600000
TBN CSSWIT,VALOPE OP-END SINCE LAST HERE? 02610000
SBF CSSWIT,VALOPE SET IT OFF 02620000
MVI TIMFLG(,XR2),X'02' SET FOR TIMER UNITS 02630000
JF CSRTCW NO - SEE IF WE MUST WAIT 02640000
MVC TIMTIM(4,XR2),POLTIM PUT TIME TO POLL IN 02650000
CSRTSP EQU * 02660000
L CSSCLB,CLB XR2 --> CLB TO SCHEDULE 02670000
AIF (&NPBY).BP300 BUSY PRINT SUPPORTED? 02671000
.IP204 ANOP . BUSY PRINT BUT NOT INT POLL 02671500
* ------START------------------@07 02672000
TBN CLBBA3(,CLB),BA3BYP ANY PRINTERS BEING POLLED? 02673000
JF CSNCLN NO - DON'T NEED TO CLEANUP. 02674000
B CC4TA CALL TRANSIENT HANDLER 02675000
DC AL1(CC4UP) BUSY PRINTER CLEANUP 02676000
CSNCLN EQU * * LOCAL 02677000
* -------END-------------------@07 02678000
.BP300 ANOP * 02679000
B CSCHED GO SCHEDULE THIS LINE 02680000
AIF (&CINT).IP205 . WHEN ONLY BSY PRT: SKIP 02685000
SPACE 2 02690000
* SEE IF A WAIT SHOULD BE DONE NOW 02700000
CSRTCW EQU * 02710000
CLC TIMTIM(4,XR2),X0000 TIME ZERO ? 02720000
JE CSRTWT YES - GO WAIT 02730000
SPACE 1 02740000
* NOT ZERO YET - GO POLL AGAIN 02750000
B CSRTSP GO POLL AGAIN 02760000
SPACE 1 02770000
* PREPARE TO WAIT ON TIMER ALSO 02780000
CSRTWT EQU * 02790000
SBF TIMECB(,XR2),SKIP SET TO WAIT ON TIMER ALSO 02800000
MVC TIMTIM(3,XR2),WAITIM PUT TIME IN IOB 02810000
SVC 0 SPVR CALL 02820000
DC AL1(STMRIB) START TIMER RIB 02830000
L CSSCLB,CLB XR2--> CLB 02840000
SBN CLBATB(,CLB),ATBTIM SET TO RESCHEDULE 02850000
B CSSTRT GO WAIT 02860000
SPACE 3 02870000
.IP205 ANOP . BSYPRNTR ONLY OR BOTH 02875000
CSRNIP EQU * * 02880000
.I0100 ANOP * 02890000
SBN CSSWIT,VALOPE SET VALID OP END IND 02900000
CLI CLBCMP(,CLB),CMPEOF ERROR COMP CODE? 02910000
JNH CSROK NO - GO HANDLE SUCCESSFUL OPEND 02920000
SPACE 2 02930000
* CALL ERROR TRANSIENT 02940000
SPACE 2 02950000
CSRERR EQU * * 02960000
B CC4TA CALL TRANSIENT AREA HANDLER 02970000
DC AL1(CC4UE) ERROR TRANSIENT ID - $CC4UE 02980000
SPACE 1 02980500
AIF (&CSIO EQ '1').NP110 02981000
******************************************************************* @14 02981200
******* 02981500
* IF THE RETURN IS WHEN PROCESSING A PORT DEVICE OPERATION, AND THE 02983000
* USER IS BEING CANCELLED BY $CC4II, GO TO EOT PROCESSING 02983500
CLI CLBDEV(,CLB),DEVSIO SIOC DEVICE ? 02984000
JNE CSRGSH NO 02984500
L CLBPL@(,CLB),PL XR1 --> PL 02985000
CLI PL$RTC-1(,PL),RCRTRM NEED TO CANCEL USER IN $CC4II 02985500
BE CSREOT YES 02986000
CSRGSH EQU * * 02986500
******* 02987000
******************************************************************* @14 02987200
SPACE 1 02988000
.NP110 ANOP 02988500
* GO SCHEDULE THIS LINE 02990000
B CSCHED GO SCHEDULE THIS LINE 03000000
SPACE 1 03010000
CSROK EQU * 03020000
CLI CLBCMP(,CLB),CMPEOF EOT RECEIVED? 03030000
JNE CSRAOK NO - HAVE SUCCESSFUL OPERATION 03040000
SPACE 1 03050000
TBN CLBBA1(,CLB),BA1PRI IS A PRIORITY STOP PENDING ? 03060000
BF CSRERR NO - EOT TO RCV INIT IS INVALID 03070000
L PLTUBA(,PL),XR1 XR1 --> TUB 03080000
SBF TUBAT2(,XR1),TUBOWN SET OFF OWNERSHIP IND 03090000
SLC CLBBA2(2,CLB),CLBBA2(,CLB) ZIP THE ATTRIBUTES 03100000
B CSCHED GO SCHEDULE THIS LINE 03110000
SPACE 2 03120000
CSRAOK EQU * 03130000
SBF CLBBA1(,CLB),BA1PRI SET OFF PRIORITY PUT IND 03140000
SLC PL$RTC(2,PL),PL$RTC(,PL) ZIP THE INTERNAL RETURN CODE 03150000
CLI CLBCMP(,CLB),CMPTUC DATA TRUNCATED? 03160000
JNE CSRNTC NO - JUMP 03170000
SBN PL$RTC(,PL),RCXDTR SET TRUNCATED RETURN CODE 03180000
CSRNTC EQU * * 03190000
TBN CLBAT1(,CLB),AT1SOH STATUS MSG RECEIVED 03200000
JF CSRDAT NO - JUMP 03210000
SPACE 1 03240000
* HAVE RECEIVED A STATUS MSG - CALL THE TRANSIENT STATUS HANDLER 03250000
SPACE 03260000
B CC4TA CALL TRANSIENT AREA HANDLER 03270000
DC AL1(CC4UX) TRANSIENT ID ($CC4UX) 03280000
SPACE 1 03290000
* RESCHEDULE THE LINE TO GET THE EOT FROM STATUS MSG 03300000
B CSCHED GO RESCHEDULE THIS LINE 03310000
SPACE 2 03320000
CSRDAT EQU * * 03330000
TBF CLBTBS-4(,CLB),TASREC+TASBLK REC OR BLK MODE AND ---| 03340000
TBF PL$OPC(,PL),OPLSNS+OPRFSH NOT POLL FOR STATUS OR --| 03350000
* CLEAR MSG ? <-----------| 03360000
JT CSRBOK JUMP IF NO REC,BLK,CLR, OR STS 03370000
SPACE 2 03380000
* RECORD OR BLK MODE OP END - SEE IF THERE ARE ANY WAIT TYPE OPS 03390000
* IN THE QUEUE FOR THIS LINE OWNER 03400000
SPACE 2 03410000
L PLTUBA(,PL),XR1 XR1 --> TUB OF LINE OWNER 03420000
MVC CSOWNS,TUBTCB(2,XR1) SAVE TCB @ OF LINE OWNER 03430000
LA CLBPLQ-1(,CLB),PL XR1--> START OF LINE QUEUE 03440000
CSREQR EQU * 03450000
CLC PLCHN(2,PL),CSSPL NEXT PL THE OP ENDED ONE ? 03460000
L PLCHN(,PL),PL XR1 --> NEXT PL 03470000
JE CSRZRO YES - JUMP 03480000
L PLTUBA(,PL),TUB XR2 --> TUB 03490000
CLC CSOWNS,TUBTCB(2,TUB) SAME TCB @ ? 03500000
JNE CSRZRO NO - LOOK AT NEXT PL 03510000
TBF PL$OPM(,PL),OPNOW THIS REQUEST A NO-WAIT OP -- 03520000
TBF PLOPM(,PL),OP$SYS OR SYSTEM OP? 03530000
JF CSRZRO YES - LOOK AT NEXT PL 03540000
* CALL REJECT XIENT 03550000
B CC4TA CALL TRANSIENT AREA HANDLER 03560000
DC AL1(CC4UR) TRANSIENT ID = $CC4UR 03570000
DC XL1'FF' SUB-RIB FOR $CC4UR 03580000
J CSRBOK CONTINUE TO HANDLE OP END 03590000
CSRZRO EQU * * 03600000
CLI PLCHN-1(,PL),NOBIT END OF CHAIN ? 03610000
BNE CSREQR NO - LOOK AT NEXT PL 03620000
SPACE 2 03630000
* OP IS OK - CONTINUE PROCESSING IT 03640000
CSRBOK EQU * * 03650000
L CSSCLB,CLB XR2 --> CLB 03660000
L CLBPL@(,CLB),PL XR1 --> PL 03670000
AIF (&NDME).D0050 NO DME SUPPORT. 03680000
TBF PLOPM(,PL),OPSTOP NOT A STOP INVITE PARM LIST ? 03690000
.D0050 ANOP * 03700000
L PLTUBA(,PL),XR1 XR1 --> TUB 03710000
AIF (&NDME).D0100 NO DME SUPPORT. 03720000
CLI TUBPHY(,XR1),TUB375 CPU TYPE TERMINAL? 03723000
JH CSCPUT YES,FORGET CLEAR KEY 03726000
TBN TUBSCS(,XR1),TUBCLR CLEAR KEY DEPRESSED ON LAST ENTR 03730000
CSCPUT EQU * CPU TYPE 03735000
TBF TUBAT2(,XR1),TUBCMD AND NOT COMMAND MODE 03740000
TBN TUBAT2(,XR1),TUBDTA AND IN DATA MODE 03750000
TBN TUBAT1(,XR1),TUBREQ AND IS REQUESTER OF A PROGRAM ? 03760000
JF CSRNDE NO - SKIP DATA MODE ESCAPE CHECK 03770000
* CHECK FOR DATA MODE ESCAPE 03780000
LA CSDMES,XR1 XR1--> DME STRING (FOR XIENT) 03790000
B CC4TA CALL TRANSIENT AREA HANDLER 03800000
DC AL1(CC4UI) CALL TRANSIENT $CC4UI -DME CHECK 03810000
* TRANSIENT RETURNS AT ARR(SEARCH EOT AND DEQUEUE) 03820000
* RETURNS ON ARR + 4 FOR CPU NOT DME 03825000
B CSCHED GO RESCHEDULE THE LINE 03830000
SPACE 2 03840000
CSRNDE EQU * 03850000
L CLBPL@(,CLB),PL RELOAD X1 WITH PL@ 03853000
L PLTUBA(,XR1),XR1 POINT TO TUB 03856000
.D0100 ANOP * 03860000
SPACE 1 @06 03861000
* SET OFF AUTO ERP BIT TO ASSURE AUTO ERP MESSAGES ARE PRINTED @06 03862000
SPACE 1 @06 03863000
SBF TUBAT4(,XR1),TUBEMS SET OF AUTO ERP BIT @06 03864000
SPACE 1 @06 03865000
* CHECK FOR 3270 CLEAR KEY (XR1 --> TUB, XR2 --> CLB) 03870000
SPACE 1 03875000
CLI TUBPHY(,XR1),TUB5M2 3270 TYPE TERMINAL? 03880000
L CLBPL@(,CLB),PL XR1--> PL 03890000
JH CSRN32 NO - JUMP 03900000
SPACE 1 03910000
* CHECK FOR CLEAR AID CHARACTER 03920000
SPACE 1 03930000
MVI CSCLR+1,EBCLER PUT EBCDIC CLEAR AID IN 03940000
AIF (&CACI).A0100 NO ASCII. 03950000
TBN CLBATT(,CLB),ATTCOD ASCII CODE ? 03960000
JF CSPTBF NO - JUMP 03970000
MVI CSCLR+1,ASCLER PUT ASCII CLEAR AID IN 03980000
CSPTBF EQU * * 03990000
.A0100 ANOP * 04000000
L CLBWKB(,CLB),XR1 XR1 --> INPUT TEXT 04010000
CSCLR CLI AIDCHR(,XR1),EBCLER CLEAR KEY DEPRESSED ? 04020000
L CLBPL@(,CLB),PL XR1 --> PL 04030000
JNE CSRN32 NO - GO SET UP PL FOR INPUT 04040000
SPACE 1 04050000
* CLEAR KEY HAS BEEN DEPRESSED ON A 3270 TYPE TERMINAL 04060000
* IF THIS IS A SYSTEM PL OR DME HAS BEEN GEN'ED - SEND A11 CLEAR MSG 04070000
* IF DME HAS NOT BEEN GEN'ED - GIVE USER AN 07 RETURN CODE 04080000
SPACE 2 04090000
L PLTUBA(,PL),XR1 XR1 --> TUB @02 04092000
SBF TUBSCS(,XR1),TUBRUF RESET THE TERM TO NON-PRUF @02 04094000
L CLBPL@(,CLB),PL XR1 --> PARAMETER LIST @02 04096000
SLC PLEFFL(2,PL),PLEFFL(,PL) ZIP EFFECTIVE LENGTH 04100000
TBN PLOPM(,PL),OP$SYS SYSTEM OP ? 04110000
JF CSRCLU NO - HANDLE USER 04120000
* SYSTEM OP - SEND CLEAR MSG 04130000
CSRCLR EQU * 04140000
MNN PL$OPC(,PL),PL$OPM(,PL) SAVE THE CURRENT OP 04150000
SBN PL$OPC(,PL),OPRFSH SET REFRESH BIT IN PL 04160000
SBN CLBBA1(,CLB),BA1EOT SET 'SEARCH EOT' (DON'T DEQUE) 04170000
B CSCHED GO SCHEDULE THIS LINE 04180000
SPACE 1 04190000
* USER PL AND CLEAR KEY DEPRESSED 04200000
CSRCLU EQU * * 04210000
MVI PL$RTC(,PL),RCXCLR PUT IN CLEAR RETURN CODE 04220000
AIF (&NDME).D0200 04230000
L PLTUBA(,PL),TUB XR2 --> TUB 04240000
SBN TUBSCS(,TUB),TUBCLR SET CLEAR IND. IN TUB 04250000
L TUBLCB(,TUB),CLB XR2 --> CLB 04260000
B CSRCLR GO SEARCH EOT - NO DEQUEUE 04270000
AGO .D0300 04280000
.D0200 ANOP 04290000
SBN CLBBA1(,CLB),BA1DEQ SET TO DEQUE 04300000
B CSRCLR GO SEARCH EOT 04310000
.D0300 ANOP 04320000
CSRN32 EQU * * 04330000
* SET UP CLB FOR INPUT OPERATION 04340000
MVC PLRECA(2,PL),CLBWKB(,CLB) PUT ADDRESS OF TEXT IN PL 04350000
AIF (&NCPOR).PT290 04350400
SPACE 1 04350800
******************************************************************* @14 04351200
******* 04351600
TBN CLBBA3(,CLB),BA3PON PORTLINE ONLY DEVICE ? 04352000
JF CSRNS1 NO - CONTINUE 04352400
SLC CLBIBA(2,CLB),X$0001 BACK UP FROM CLBIBA 1 BYTE 04352800
L CLBIBA(,CLB),XR1 XR1 --> INPUT BUFFER AREA 04353200
MVC 3(4,XR1),0(,XR1) MOVE THE TPBUFFER PARM LIST 04353600
SLC CLBIBA(2,CLB),LNTHCC BACK UP 13 BYTES 04354000
L CLBIBA(,CLB),XR1 XR1 --> INPUT BUFFER AREA 04354400
MVC 8(1,XR1),5(,XR1) MOVE UP THE PORT ID 04354800
MVC 10(2,XR1),7(,XR1) MOVE UP THE LENGTH 04355200
L CLBPL@(,CLB),PL XR1 --> PL 04355600
ALC PLRECA(2,PL),X$0003 BUMP PLRECA PAST THIS STUFF 04356000
SLC CLBREL(2,CLB),X$0003 DECREMENT THE REL BY THREE 04356400
CSRNS1 EQU * 04356800
******* 04357200
******************************************************************* @14 04357600
SPACE 1 04358000
.PT290 ANOP 04358400
MVI CLBIBA-1(,CLB),NOBIT ZIP IBA SO FREE WON'T OCCUR 04360000
SLC CLBIBL(2,CLB),CLBREL(,CLB) DECREMENT MAX INPUT LENGTH 04370000
* NOTE THAT IF THE LENGTH BECOMES ZERO BSCC DATA MANAGEMENT WILL: 04380000
* 1) NOT MOVE ANY DATA ON SUBSEQUENT CHECK ENTRIES 04390000
* 2) IF MORE DATA COMES IN ON SUBSEQUENT CHECK ENTRIES THEN 04400000
* DATA TRUNCATED WILL BE RETURNED (CLBCMP=CMPTRC) 04410000
* 3) IF EOT COMES IN ON THE NEXT ENTRY THEN WE RECEIVED EXACTLY 04420000
* THE AMOUNT OF DATA REQUESTED 04430000
MVC PLEFFL(2,PL),CLBREL(,CLB) PUT IN LENGTH OF TEXT RCV'ED 04440000
SPACE 2 04450000
* IF THIS IS A SYSTEM REQUEST WITHOUT PRUF - ONLY ALLOW ONE BLOCK 04460000
* OF TEXT TO BE ENTERED 04470000
SPACE 1 04480000
TBN PLOPM(,PL),OP$SYS SYS REQ 04490000
L PLTUBA(,PL),TUB XR2 --> TUB 04500000
TBF TUBSCS(,TUB),TUBRUF AND NOT PRUF ? 04510000
L TUBLCB(,TUB),CLB XR2 --> CLB 04520000
JF CSRNSR JUMP ON USER OP OR PRUF INPUT 04530000
AIF (&CSIO EQ '1').PT300 04530900
AGO .PT310 04531000
.PT300 ANOP 04531100
AIF (&NCPOR).PT320 04531200
.PT310 ANOP 04531300
SPACE 1 04531400
******************************************************************* @14 04531500
******* 04531600
TBN CLBBA3(,CLB),BA3POR PORTLINE DEVICE ? 04534500
JT CSRNSR YES, ALLOW MORE THAN 1 BLOCK 04535400
******* 04536300
******************************************************************* @14 04536700
.PT320 ANOP 04539000
SPACE 1 04540000
* SYS REQ AND NO PRUF - SET SEARCH EOT AND DEQUE 04550000
SBN CLBBA1(,CLB),BA1EOT+BA1DEQ SET SEARCH EOT AND DEQUEUE 04560000
B CSCHED GO SCHEDULE THIS LINE 04570000
SPACE 1 04580000
* DETERMINE TYPE OF INPUT -MSG,REC,OR BLK AND DWA 04590000
SPACE 1 04600000
CSRNSR EQU * * 04610000
TBN PLOPM(,PL),OP$SYS SYSTEM OP 04620000
JT CSRSYS YES - GO BLOCK DATA IN 04630000
TBF CLBTBS-4(,CLB),TASREC+TASBLK MSG MODE TUB ? 04640000
JF CSRROB NO - GO HANDLE REC OR BLOCK 04650000
SPACE 1 04660000
* MSG MODE INPUT-BLOCK THE DATA INTO TP BUFFER (UNLESS TRUNCATED TXT) 04670000
CSRSYS EQU * * 04680000
CLI CLBCMP(,CLB),CMPTUC TRUNCATED DATA RETURN CODE ? 04690000
JNE CSRNTR NO - JUMP 04700000
* TOO MUCH TEXT - FLUSH THE REST 04710000
SBN CLBBA1(,CLB),BA1DEQ+BA1EOT SET SEARCH EOT AND DEQUE 04720000
SBN PL$RTC(,PL),RCXDTR SET TRUNCATED RETURN CODE 04730000
B CSCHED GO SCHEDULE THIS LINE 04740000
SPACE 1 04750000
* SET TO GET NEXT BLOCK OF TEXT 04760000
CSRNTR EQU * 04770000
ALC CLBWKB(2,CLB),CLBREL(,CLB) BUMP TEXT POINTER 04780000
MVC CLBREL(2,CLB),CLBIBL(,CLB) PUT NEW MAX LENGTH IN 04790000
B CSCHED GO SCHEDULE THIS LINE 04800000
SPACE 2 04810000
* HAVE RECORD OR BLOCK MODE TERMINAL - TRASLATE DATA-POST USER, ETC. 04820000
SPACE 1 04830000
CSRROB EQU * * 04840000
TBN CLBTBS-5(,CLB),TASTRN SKIP TRANSLATE ? 04850000
JT CSRNXL YES - JUMP 04860000
B CSXLAT GO XLATE THE TEXT 04870000
CSRNXL EQU * * 04880000
* IF THIS IS A RECORD MODE TUB AND INPUT TEXT DOES NOT FILL OUT 04890000
* THE RECORD - CMPSTE ROUTINE WILL EFFECT A PAD OUT WITH BLANKS 04900000
* WHEN IT GOES TO THE MOVE ROUTINE TO MOVE THE TEXT TO THE USER'S 04910000
* BUFFER 04920000
SPACE 1 04930000
SBN CLBBA1(,CLB),BA1NTQ SET IND ACTIVE PL REMOVED FROM Q 04940000
SBF CLBBA2(,CLB),BA2RCI SET OFF FIRST BLOCK IND. 04950000
B CSDEQ GO DEQUEUE PL FROM CLB 04960000
B CSPSTE GO POST USER AND MOVE DATA 04970000
B CSNMOR GO CHECK FOR MORE WORK 04980000
EJECT 04990000
*---------------------------------------------------------------------* 05000000
* * 05010000
* NON-FIRST BLOCK RECEIVED - XR2 --> OP ENDED CLB 05020000
* * 05030000
*---------------------------------------------------------------------* 05040000
SPACE 1 05050000
CSRNFB EQU * 05060000
* GO TO BSCC CHECK ROUTINE TO MOVE DATA - CLB WAS SET UP ON FIRST BLOCK 05070000
L CLBPL@(,CLB),PL XR1--> PL 05080000
B CSTASV SAVE THIS TUB'S ATTRIBUTES 05090000
AIF (&CSIO EQ '1').NP130 05090900
SPACE 1 05091800
******************************************************************* @14 05092200
******* 05092700
B CSWATE GO TO BSCC OR SIOC CHECK ROUTINE 05094500
******* 05096300
******************************************************************* @14 05096700
AGO .YP130 05098100
.NP130 ANOP 05099000
B YMWAIT GO TO BSCC CHECK ROUTINE 05100000
.YP130 ANOP 05105000
SPACE 1 05110000
* TRACE THE OP END 05120000
B CC4TT GO TRACE THIS OP END 05130000
DC AL1(TTMOPN) OP END TRACE 05140000
* TRACE ROUTINE RETURNS WITH INTERRUPTS MASKED 05150000
CCP UNMASK,PMR ALLOW INTERRUPTS 05160000
SPACE 1 05170000
SLC #CSOND(1),X$0001 DECREMENT OP-END COUNT 05180000
SLC CLBOPE(1,CLB),X$0001 DECREMENT CLB OP-END COUNT 05190000
SPACE 2 05200000
CLI CLBCMP(,CLB),CMPEND COMP CODE 40 OR LOWER ? 05210000
JH CSRN40 NO - JUMP 05220000
* IF SEARCHING FOR EOT - JUST GO SCHEDULE ANOTHER GET 05230000
TBN CLBBA1(,CLB),BA1EOT SEARCHING FOR EOT ? 05240000
BT CSCHED YES - DO ANOTHER GET 05250000
SPACE 1 05260000
* DATA RECEIVED - HANDLE IT 05270000
SLC CLBIBL(2,CLB),CLBREL(,CLB) DECREMENT MAX ALLOWABLE---| 05280000
* SEE NOTE AFTER LABEL CSRN32 <-----------------------------------| 05290000
L CLBPL@(,CLB),PL XR1 --> OP ENDED PL 05300000
ALC PLEFFL(2,PL),CLBREL(,CLB) UP EFFECTIVE INPUT LENGTH 05310000
CLI CLBCMP(,CLB),CMPTUC DATA TRUNCATED ? 05320000
JNE CSRRBD NO - JUMP 05330000
SBN PL$RTC(,PL),RCXDTR SET DATA TRUNCATED RETURN CODE 05340000
* TOO MUCH DATA - IF SYS OP OR MSG MODE THEN SEARCH FOR EOT 05350000
SPACE 1 05360000
TBF PLOPM(,PL),OP$SYS SYS OP OR 05370000
TBF CLBTBS-4(,CLB),TASMSG MSG MODE TUB ? 05380000
JT CSRRBD NO - JUMP 05390000
SPACE 1 05400000
* SEARCH FOR EOT - TOO MUCH DATA CAME IN 05410000
SPACE 1 05420000
SBN CLBBA1(,CLB),BA1EOT+BA1DEQ SET SEARCH EOT + DEQUEUE 05430000
B CSCHED GO SCHEDULE THIS LINE 05440000
SPACE 1 05450000
CSRRBD EQU * * 05460000
TBF PLOPM(,PL),OP$SYS SYS OP OR 05470000
TBF CLBTBS-4(,CLB),TASMSG MSG MODE TERMINAL ? 05480000
JT CSRHRB NO - JUMP 05490000
* MSG MODE TERMINAL OP END - BLOCK IN THE TEXT 05500000
ALC CLBWKB(2,CLB),CLBREL(,CLB) UP THE TEXT POINER 05510000
MVC CLBREL(2,CLB),CLBIBL(,CLB) PUT IN NEW MAX LENGTH 05520000
B CSCHED GO SCHEDULE THIS LINE 05530000
SPACE 1 05540000
* REC OR BLOCK MODE TERMINAL - SETUP THE PL AND THEN GO DEQUEUE IT,ETC. 05550000
CSRHRB EQU * 05560000
MVC PLRECA(2,PL),CLBWKB(,CLB) PUT ADDRESS OF TEXT IN 05570000
MVC PLEFFL(2,PL),CLBREL(,CLB) PUT IN LENGTH 05580000
MVI CLBIBA-1(,CLB),NOBIT ZIP IBA SO FREE WON'T OCCUR 05590000
SBN CLBBA1(,CLB),BA1NTQ SET 'REMOVED FROM Q' IND. 05600000
B CSRROB GO FINISH UP REC OR BLOCK OP 05610000
SPACE 2 05620000
* CHECK FOR ERROR COMPLETION CODE 05630000
SPACE 1 05640000
CSRN40 EQU * * 05650000
CLI CLBCMP(,CLB),CMPEOF EOT RECEIVED ? 05660000
JE CSREOT YES - JUMP 05670000
CLI CLBCMP(,CLB),CMPCMP NOT DONE YET COMP CODE? 05680000
BE CSNMOR YES - GO CHECK FOR MORE WORK 05690000
SPACE 2 05700000
* CALL THE ERROR RECOVERY XIENT TO HANDLE THIS OP END 05710000
SPACE 05720000
B CC4TA CALL TRANSIENT AREA HANDLER 05730000
DC AL1(CC4UE) ERROR XIENT ID 05740000
SPACE 1 05740500
AIF (&CSIO EQ '1').NP140 05741000
******************************************************************* @14 05741200
******* 05741500
* IF THE RETURN IS WHEN PROCESSING A SIOC DEVICE OPERATION, AND THE 05743000
* USER IS BEING CANCELLED BY $CC4II, GO TO EOT PROCESSING 05743500
CLI CLBDEV(,CLB),DEVSIO PORT DEVICE 05744000
JNE CSRNTP NO 05744500
L CLBPL@(,CLB),PL XR1 --> PL 05745000
CLI PL$RTC-1(,PL),RCRTRM NEED TO CANCEL USER IN $CC4II 05745500
JE CSREOT YES 05746000
CSRNTP EQU * * 05746500
******* 05748000
******************************************************************* @14 05748100
SPACE 1 05748200
.NP140 ANOP 05748500
B CSCHED GO SCHEDULE THIS LINE 05760000
EJECT 05770000
*---------------------------------------------------------------------* 05780000
* * 05790000
* FINALLY GOT THE EOT (WHEW) PROCESS IT * 05800000
* * 05810000
*---------------------------------------------------------------------* 05820000
SPACE 1 05830000
CSREOT EQU * * 05840000
TBN CLBBA1(,CLB),BA1EOT SEARCH EOT AND NO - 05850000
TBF CLBBA1(,CLB),BA1DEQ DEQUEUE ? 05860000
JF CSRNED NO - JUMP 05870000
SPACE 1 05880000
* SEARCHED EOT - NO DEQUEUE SPECIFIED - JUST GO SCHEDULE THIS LINE 05890000
SPACE 1 05900000
SLC CLBBA2(2,CLB),CLBBA2(,CLB) ZIP THE CLB ATTRIBUTES 05910000
L PLTUBA(,PL),TUB XR2 --> TUB 05920000
SBF TUBAT2(,TUB),TUBOWN SET OF OWNERSHP IND. 05930000
L TUBLCB(,TUB),CLB XR2 --> CLB 05940000
TBN PLOPM(,PL),OPSTOP WAS THE CURRENT OP A STOP ? 05950000
BF CSCHED NO - SCHEDULE THE LINE 05960000
* MVI PLRTC(,PL),RCXCLR CLEAR KEY RETURN CODE @15 05970000
MVI PL$RTC(,PL),RCXCLR CLEAR KEY RETURN CODE 05980000
TBN PL$OPC(,PL),OPRFSH WAS A CLEAR KEY ENTERED ? 05990000
JT CSRDND YES - DEQUEUE THE PARM LIST 06000000
* MVI PLRTC(,PL),RCXSPI NO - MOVE IN STOP OK R.C. @15 06010000
MVI PL$RTC(,PL),RCXSPI MOVE IN STOP OK RETURN CODE 06020000
J CSRDND DEQUEUE THE PARAMETER LIST 06030000
SPACE 2 06040000
* IF THE EOT IS FOR A RECORD OR BLOCK MODE TERMINAL - JUST ZERO 06050000
* PLEFFL - NO TRANSLATE REQUIRED 06060000
SPACE 1 06065000
CSRNED EQU * * 06070000
TBF CLBTBS-4(,CLB),TASMSG MSG MODE OR 06080000
TBF PLOPM(,PL),OP$SYS SYS OPERATION ? 06090000
JT CSRSRC NO - JUMP 06100000
SPACE 1 06101000
* IF STATUS WAS JUST RECEIVED DO NOT TRANSLATE TO UPPER CASE @09 06102000
SPACE 1 06103000
TBN CLBAT1(,CLB),AT1SOH WAS STATUS RECEIVED ? @09 06104000
JT CSRNFM YES - DO NOT TRANSLATE @09 06105000
SPACE 1 06106000
* TRANSLATE THE TEXT IF SPECIFIED (MSG MODE TERMINAL) 06110000
SPACE 1 06115000
TBN CLBTBS-5(,CLB),TASTRN SKIP XLATE ? 06120000
TBF PL$OPC(,PL),OPSYS A USER OPERATION ? 06130000
JT CSRNTL YES - JUMP (NO TRANSLATION) 06140000
SPACE 1 06150000
B CSXLAT GO TRANSLATE THE TEXT 06160000
CSRNTL EQU * **** 06170000
TBN PL$OPC(,PL),OPSYS SYSTEM INPUT OP --| 06180000
L PLTUBA(,PL),TUB XR2--> TUB | 06190000
CLI TUBPHY(,TUB),TUB5M2 AND A 3270 ? <----| 06200000
JC CSRNFM,FLSOHI NO - SKIP FORMATING 06210000
SPACE 1 06220000
* CALL THE RESIDENT FORMAT ROUTINE TO FORMAT THE DATA FOR THE 06230000
* COMMAND PROCESSOR 06240000
SPACE 1 06250000
L TUBLCB(,TUB),CLB XR2 --> CLB 06260000
B CC4U0 GO FORMAT THE INPUT 06270000
SPACE 1 06280000
CSRNFM EQU * * 06290000
J CSRDND GO POST,DEQUE,ETC. 06300000
SPACE 1 06310000
* REC OR BLOCK MODE TUB - PUT IN EOT RETURN CODE 06320000
CSRSRC EQU * * 06330000
TBN PL$OPM(,PL),OPPUT IS THE CURRENT OP A PUT ? @12 06332000
JT CSRDND YES - POLL FOR STATUS WAS @12 06334000
* DONE, DO NOT ZIP PLRECA @12 06336000
MVI PL$RTC(,PL),RCXEOT PUT IN EOT RETURN CODE 06340000
MVI PLRECA-1(,PL),NOBIT ZIP RECA - CLBIBA HAS THE @ IN 06350000
** IT - THIS WILL BE FREED AT SCHED 06360000
SLC PLEFFL(2,PL),PLEFFL(,PL) ZIP EFFL FOR USER (NO DATA) 06370000
SPACE 2 06380000
* DEQUE PL - GO POST USER 'OP COMPLETE' - RESCHEDULE THE LINE 06390000
SPACE 1 06400000
CSRDND EQU * * 06410000
B CSDEQ GO DEQUEUE PL FROM CLBPLQ 06420000
L PLTUBA(,PL),TUB XR2 --> TUB 06430000
SBF TUBAT2(,TUB),TUBOWN SET OF OWNERSHIP INDICATOR 06440000
L TUBLCB(,TUB),CLB XR2 --> CLB 06450000
SPACE 1 06460000
SLC CLBBA2(2,CLB),CLBBA2(,CLB) ZIP THE CLB ATTRIBUTES 06470000
AIF (&CSIO EQ '1').PT330 06470300
AGO .PT340 06470330
.PT330 ANOP 06470360
AIF (&NCPOR).PT350 06470390
.PT340 ANOP 06470420
SPACE 1 06470450
******************************************************************* @14 06470480
******* 06470510
* IF PORT DEVICE WITH DUMMY PARM LIST: 06471500
* .PUT PL INTO TPBUFF 06471800
* .DO NOT POST USER,MOVE DATA TO USER, OR FREE BUFFERS 06472100
* .BECAUSE THE USER HAS NOT DONE A GET YET 06472400
* IF A USER OPCODE AND IT IS COMMAND DATA: 06472700
* .Q THE DATA IN TPBUFF 06473000
* .THE COMMAND PROCESSOR WILL GET THE DATA 06473300
* .THE USER WILL LOSE THE PORT 06473600
SPACE 06473900
TBN CLBBA3(,CLB),BA3POR PORTLINE OR SIOC DEVICE ? 06474200
JF CSRPST NO 06474500
TBN PLOPC(,PL),OPDMY DUMMY PARM LIST 06474800
JT CSRQUE YES, Q THE DATA IN TPBUFF 06475100
TBF PLOPM(,PL),OP$SYS USER OP 06475400
TBN CSRRPI+1,TPXCMD COMMAND DATA ? 06475700
JF CSRPST IF NOT BOTH, DO NOT Q DATA 06476000
SBN CSSWIT,CSSCMD INDICATE COMMAND DATA TO USER 06476300
CSRQUE EQU * * 06476600
B CSYQDT PORT DATA ON TUBDCH Q 06476900
ALC CTR3(3),X$0001 +1 TO # TIMES DATA TO TPBUFF 06477200
TBN CSSWIT,CSSCMD COMMAND DATA TO USER 06477500
JF CSRSCH NO, GO SCHEDULE THE LINE 06477800
CSRPST EQU * * 06478100
******* 06478400
******************************************************************* @14 06478500
SPACE 1 06478700
.PT350 ANOP 06479300
B CSPSTE GO POST AND FREE AS NECESSARY 06480000
SPACE 1 06490000
CSRSCH EQU * * 06495000
B CSCHED GO SCHEDULE THIS LINE 06500000
MEND 06510000