|
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: 77470 (0x12e9e)
Types: s3xseg
Names: »S$E180«
└─⟦4498c64f7⟧ Bits:30009191 5704-sc2.V05.ccp
└─⟦95ee7795b⟧
└─⟦this⟧ »S$E180«
MACRO 00010000
.********************************************************************** 00020000
.* * 00030000
.* TITLE: $E180 - COMMON SUBROUTINES FOR COM SPVR. (CS) * 00040000
.* * 00050000
.* FUNCTION: PROVIDES FUNCTIONS COMMON TO THE BSCC SUPERVISOR * 00060000
.* (I.E. SAVE TUB ATTRIBUTES,SEARCH CLBPLQ, ETC.). * 00070000
.* * 00080000
.* INPUT: THE VARIOUS SUBROUTINES REQUIRE DIFFERENT INPUT - THE * 00090000
.* COMMENTS PRECEEDING EACH SUBROUTINE DEFINE THE REQUIRED * 00100000
.* INPUT PARAMETERS,REGS,ETC. * 00110000
.* * 00120000
.* OUTPUT: THE VARIOUS SUBROUTINES PRODUCE DIFFERENT OUTPUT - THE * 00130000
.* COMMENTS PRECEEDING EACH SUBROUTINE DEFINE THE OUTPUT * 00140000
.* RESULTS OF THAT SUBROUTINE. * 00150000
.* * 00160000
.* EXTERNAL REFERENCES: DEFINED BY COMMENTS PRECEEDING EACH SUB- * 00170000
.* ROUTINE. * 00180000
.* * 00190000
.* EXITS: RETURNS TO CALLER * 00200000
.* * 00210000
.* * 00220000
.********************************************************************** 00230000
.* * 00240000
.* GBLB &NDF * NO * DFF SUPPORT * 00250000
.* * 00260000
.* GBLB &CACI * NO * ASCII SUPPORT * 00270000
.* * 00280000
.* GBLB &NDME * NO * DATA MODE ESCAPE * 00290000
.* * 00300000
.* GBLB &NPBY * NO * BUSY PRINTER SUPPORT. * 00303000
.* * 00306000
.********************************************************************** 00310000
$E180 &DMESTR- 00320000
GBLB &NDF,&CACI,&NDME,&NPBY 00325000
GBLB &CSIO,&NCPOR 00330000
TABLE &DMESTR . DATA MODE ESCAPE STRING 00340000
'' TABDF CL6'//////' . DEFAULT CHARACTERS 00350000
TEXT 00360000
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S (C S S R C H)' 00370000
*********************************************************************** 00380000
* * 00390000
* NAME CSSRCH * 00400000
* * 00410000
* FUNCTION: SEARCH @CSNRQ FOR A PUT PL - IF NO PUT'S FOUND THEN * 00420000
* RETURN FIRST PL ON @CSNRQ * 00430000
* * 00440000
* INPUT: XR1--> NO MATTER * 00450000
* XR2--> NO MATTER * 00460000
* * 00470000
* OUTPUT: XR1--> PL TO USE * 00480000
* XR2--> PRECEEDING PL * 00490000
* * 00500000
* EXIT RETURN TO CALLER * 00510000
*********************************************************************** 00520000
SPACE 1 00530000
CSSRCH EQU * * 00540000
ST CSSR08+3,ARR SAVE RETURN ADDRESS 00550000
LA @CSNRQ-1,XR2 XR2 --> NEW REQUEST QUEUE 00560000
CSSR01 EQU * * 00570000
L PLCHN(,XR2),XR1 XR1 --> NEXT PARM LIST 00580000
TBN PLOPC(,XR1),OPPUT THIS A PUT AND -- 00590000
TBF PLOPM(,XR1),OPSTOP NOT A STOP ? 00600000
JT CSSR07 YES - RETURN TO CALLER 00610000
LA PLCHN-1(,XR1),XR2 XR2 --> NEXT PL 00620000
CLI PLCHN-1(,XR2),NOBIT END OF CHAIN ? 00630000
BNE CSSR01 NO - LOOK AGAIN 00640000
* NO PUTS FOUND POINT XR1 AT FIRST PL, XR2 AT PRECEEDING (@CSNRQ) 00650000
LA @CSNRQ-1,XR2 XR2 --> @CSNRQ 00660000
L PLCHN(,XR2),XR1 XR1 --> FIRST PL 00670000
AIF (&CSIO EQ '1').PT010 00670700
AGO .PT020 00670800
.PT010 ANOP 00670900
AIF (&NCPOR).PT030 00671000
.PT020 ANOP 00671100
SPACE 1 00671200
******************************************************************* @14 00671400
******* 00672100
CSSR07 SBN CSSWIT,CSSPRM INDICATE A PARM LIST FOUND 00673500
CSSR08 B # RETURN TO CALLER 00674200
******* 00675600
******************************************************************* @14 00675900
AGO .YP020 * 00677000
.PT030 ANOP 00677700
CSSR07 EQU * * 00678400
CSSR08 B # RETURN TO CALLER 00680000
.YP020 ANOP * 00685000
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S (C S P S T N)' 00690000
*********************************************************************** 00700000
* * 00710000
* NAME CSPSTN * 00720000
* * 00730000
* FUNCTION: POST A NEW REQUEST IF IT IS A NO-WAIT OPERATION * 00740000
* * 00750000
* INPUT: XR1--> NO MATTER * 00760000
* XR2--> NO MATTER * 00770000
* CSNWPL --> PL TO BE INSPECTED FOR A NO-WAIT OPERATION * 00780000
* * 00790000
* OUTPUT XR1--> NO MATTER * 00800000
* XR2--> NO MATTER * 00810000
* A NO-WAIT OP'S PLECB POSTED COMPLETE * 00820000
* * 00830000
* EXIT TO CHECK FOR MORE WORK FOR CS (CSNMOR) * 00840000
*********************************************************************** 00850000
SPACE 1 00860000
CSPSTN EQU * * 00870000
TBN CSSWIT,CSNRIP NEW REQUEST IN PROCESS AND ---| 00880000
SBF CSSWIT,CSNRIP SET IT OFF | 00890000
L CSNWPL,PL XR1 --> PL | 00900000
TBN PL$OPC(,PL),OPNOW IS THIS A NO-WAIT OPERATION?<-| 00910000
JF CSTN04 NO - GO CHECK FOR MORE WORK 00920000
AIF (&NPBY).BP500 BUSY PRINT SUPPORT? 00920700
* -----START-------------------@07 00921400
SPACE 1 00922100
* IF THE TUB FOR THIS OPERATION IS A BUSY PRINTER TUB, 00922800
* THEN DO NOT POST THE OPERATION SCHEDULED - WAIT TILL 00923500
* THE PRINTER RETURNS DEVICE END STATUS. 00924200
SPACE 1 00924900
L PLTUBA(,PL),XR2 FIND THE TUB. 00925600
TBN TUBAT4(,XR2),TUBWAT THIS A BUSY PRINTER OPERATION? 00926300
JT CSTN04 YES - DON'T POST AT THIS TIME. 00927000
* ------END--------------------@07 00927700
.BP500 ANOP * 00928400
* POST USER THAT OP IS SCHEDULED 00930000
LA PLECB(,PL),XR1 XR1 --> ECB 00940000
SVC 0 SPVR CALL 00950000
DC AL1(PSTRIB) POST RIB 00960000
CSTN04 B CSNMOR GO CHECK FOR MORE WORK 00970000
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S (C S C L B Q)' 00980000
*********************************************************************** 00990000
* * 01000000
* NAME CSCLBQ * 01010000
* * 01020000
* FUNCTION: DO GETMAINS AS REQUIRED, PUT THIS PL ON CLBPLQ * 01030000
* * 01040000
* INPUT: XR1--> PL TO BE QUEUED * 01050000
* XR2--> CLB ON WHICH TO QUEUE IT * 01060000
* * 01070000
* OUTPUT: XR1--> SAME AS INPUT * 01080000
* XR2--> SAME AS INPUT * 01090000
* PL WILL BE ON CLBPLQ * 01100000
* * 01110000
* EXIT RETURN TO CALLER * 01120000
* * 01130000
*********************************************************************** 01140000
SPACE 2 01150000
CSCLBQ EQU * ** 01160000
ST CSQARR+3,ARR SAVE RETURN ADDRESS 01170000
CCP MASK,PMR MASK ALL INTERRUPTS 01180000
TBN PL$OPM(,PL),OPNOW WAIT TYPE OP ? 01190000
BF CSQONQ YES - JUST QUEUE WAIT TYPE OPS 01200000
* ANY GETMAINS WILL BE DONE AT 01210000
* RESCHEDULE TIME 01220000
SPACE 1 01230000
* HAVE A NO-WAIT OP - MUST GETMAIN FOR A PARM LIST IF NOT SYS INVITE 01240000
TBN PLOPM(,PL),OP$SYS SYSTEM OP AND 01250000
CLI PLOPC(,PL),OPINV ONLY INVITE INPUT ? 01260000
BC CSQONQ,TRUAEQ YES - SKIP THE GETMAIN FOR PL 01270000
SPACE 1 01280000
TBF PLOPM(,PL),OP$SYS USER - 01290000
TBN PLOPC(,PL),OPINV INVITE INPUT? 01300000
JF CSQSPI NO - JUMP 01310000
SPACE 1 01320000
* HAVE A USER INVITE INPUT - GM FOR THE PARM LIST 01330000
SBN $FLGC,#INVPL SET TO GM FROM PL AREA ONLY 01340000
LA GMLIST,XR2 XR2 --> GM PARM LIST 01350000
MVI 0(,XR2),NOBIT MAKE IT A NO-WAIT GETMAIN 01360000
MVC GMSIZE(2,XR2),PLGMLN PUT LENGTH IN GM PARM LIST @13 01370000
B CSGMRQ GO DO THE GETMAIN 01380000
SPACE 1 01390000
* IF GETMAIN FAILED THEN PUT PL ON QUEUE OF WAITERS 01400000
JNOL CSQGMW JUMP IF GM WAS OK 01410000
SPACE 2 01420000
DC XL1'0' PROGRAM CHECK - GM SHOULD 01430000
* NEVER FAIL FOR AN INVITE 01440000
* GM FOR PL WORKED - MOVE PL TO GETMAINED AREA 01450000
CSQGMW EQU * * 01460000
L GMADDR(,XR2),XR2 XR2 --> GETMAINE AREA 01470000
MVC PLLNG+3(PLLNG,XR2),PLENDS(,PL) MOVE PL TO GETMAIN AREA @13 01480000
TBF PLOPM(,PL),ALLBIT Q-USER ........ @13 01481000
CLI PLOPC(,PL),OPINV .......INVITE? @13 01482000
JC CSQGM1,TRUAEQ YES-DO NOT MOVE ECB @13 01483000
SPACE 1 01484000
MVC PLLEN+3(3,XR2),PLECB+2(,PL) NO-MOVE IN ECB @13 01485000
CSQGM1 EQU * @13 01486000
A X$0004,XR2 BUMP TO NEW PL ADDRESS 01490000
ST CSSPL,XR2 SAVE THIS PL ADDRESS 01500000
LA 0(,XR2),PL XR1--> PL 01510000
L CSSCLB,CLB XR2 --> LCB 01520000
B CSQONQ GO QUEUE THIS PL 01530000
SPACE 2 01540000
* IF THIS IS A SYS PUT-NO-WAIT-INVITE THEN ONLY GM FOR REC AREA 01550000
CSQSPI EQU * * 01560000
TBN PLOPM(,PL),OP$SYS SYSTEM - 01570000
TBN PLOPC(,PL),OPINV+OPPUT PUT-NO-WAIT-INVITE ? 01580000
JF CSQUPT NO - JUMP 01590000
SPACE 1 01600000
* SYSTEM PUT-NO-WAIT-INVITE 01610000
SBN $FLGC,#PUTTP SET TO GM FROM ALMOST ANYWHERE 01620000
LA GMLIST,XR2 XR2 --> GM PARM LIST 01630000
MVI 0(,XR2),NOBIT MAKE IT A NO-WAIT REQUEST 01640000
MVC GMSIZE(2,XR2),PLOUTL(,PL) PUT SIZE IN PARM LIST 01650000
ALC GMSIZE(2,XR2),X$0004 ADD 4 01660000
B CSGMRQ GO DO GET MAIN 01670000
JNOL CSQMVD GM WORKED - JUMP 01680000
SPACE 1 01690000
* GM FAILED - MAKE IT A WAIT OP AND DO IT 01700000
CSQMKW EQU * * 01710000
SBF PL$OPM(,PL),OPNOW MAKE IT A WAIT OP 01720000
SBF PL$OPC(,PL),OPNOW MAKE IT A WAIT OP 01730000
L CSSCLB,CLB XR2 --> LCB 01740000
J CSQONQ GO QUEUE THIS OP 01750000
SPACE 1 01760000
* GM WORKED - GO MOVE DATA TO TP BUFFER 01770000
CSQMVD EQU * 01780000
B CSQMOV GO MOVE DATA TO TP BUFF 01790000
L CSSCLB,XR2 XR2 --> LCB 01800000
J CSQONQ GO QUEUE THIS PL 01810000
SPACE 1 01820000
* IF THIS IS A USER PUT-NO-WAIT - GM FOR PL AND RECORD AREA 01830000
CSQUPT EQU * * 01840000
TBF PLOPM(,PL),OP$SYS NOT SYSTEM OP (USER) AND 01850000
TBN PLOPC(,PL),OPPNW PUT-NO-WAIT ? 01860000
JF CSQSYS NO - JUMP 01870000
SPACE 1 01880000
* MAKE TASK WAIT IF GETMAIN WON'T WORK 01890000
MVC GMLIST+GMSIZE,PLOUTL(2,PL) PUT SIZE IN PARM LIST 01900000
ALC GMLIST+GMSIZE,X$0004(2) ADD GM PARM LIST LENGTH 01910000
ALC GMLIST+GMSIZE(2),PLGMLG ADD PL LENGTH 01920000
CLC #GMS+1(2),GMSIZE+GMLIST ENOUGHT TP BUFFER ? 01930000
JNL CSQPTG YES - JUMP 01940000
SBF PL$OPM(,PL),OPNOW MAKE IT A WAIT OP 01950000
SBF PL$OPC(,PL),OPNOW MAKE IT A WAIT OP 01960000
B CSWCRQ PUT IT ON CLBWCQ 01970000
SBF CSSWIT,CSNRIP SET OFF NEW REQUEST IN PROCESS 01980000
B CSNMOR GO CHECK FOR MORE WORK 01990000
SPACE 1 02000000
* DO THE GM 02010000
CSQPTG EQU * * 02020000
LA GMLIST,XR2 XR2 --> GM PARM LIST 02030000
MVI 0(,XR2),NOBIT MAKE IT A NO-WAIT REQUEST 02040000
SBN $FLGC,#PUTTP SET TO GET FROM ALMOST ANYWHERE 02050000
B CSGMRQ GO DO THE GETMAIN 02060000
B CSQMOV GO MOVE TEXT TO TP BUFFER 02070000
* --------------START----------@07 02071000
L PLTUBA(,PL),XR2 TUB@ 02071100
TBN TUBSCS(,XR2),TUBBPT IS BUSY PRINT ALLOWED? 02071400
JF CSPNWB NO, SKIP BUSY PRINT CODE 02071500
CLC PLOUTL(2,PL),X$0002 IS OUTPUT LENGTH 2? 02071600
JNH CSPNWB YES SKIP BSY PRT CODE 02071700
L PLRECA(,PL),XR2 XR2 --> RECORD AREA 02072000
TBN WCC(,XR2),STPRT START PRINT BIT ON ? 02073000
JF CSPNWB NO - DON'T SET PRINTER BUSY 02074000
L PLTUBA(,PL),TUB XR2 --> TUB 02075000
SBN TUBAT4(,TUB),TUBBSY YES - SET ON PRINTER BUSY BIT 02076000
CSPNWB EQU * 02077000
* --------------END------------@07 02078000
SPACE 1 02080000
* GET MAIN FOR THE PARM LIST 02090000
CSQPLG CLC #GMS+1(2),PLGMLG WILL GM FOR PL WORK ? 02100000
BL CSQMKW NO-MAKE IT A WAIT OP 02110000
LA GMLIST,XR2 XR2 --> GM PARM LIST 02120000
MVC GMSIZE(2,XR2),PLGMLG PUT IN LENGTH TO GETMAIN 02130000
MVI 0(,XR2),NOBIT MAKE IT A NO-WAIT REQUEST 02140000
SBN $FLGC,#PUTTP SET TO GM FROM PUT/GET AREA 02150000
B CSGMRQ GO DO GM 02160000
SPACE 1 02170000
* MOVE THE PL TO TP BUFFER AND QUEUE IT 02180000
B CSQGMW GO QUEUE THIS PL 02190000
SPACE 2 02200000
* MUST HAVE A SYSTEM PUT-NO-WAIT AT THIS POINT 02210000
CSQSYS EQU * * 02220000
LA GMLIST,XR2 XR2 --> GM PARM LIST 02230000
MVI 0(,XR2),NOBIT MAKE IT A NO-WAIT REQUEST 02240000
MVC GMSIZE(2,XR2),PLOUTL(,PL) PUT SIZE IN GM PL 02250000
ALC GMSIZE(2,XR2),X$0004 ADD 4 FOR GM PARM LIST 02260000
ALC GMSIZE(2,XR2),PLGMLG ADD LENGTH OF PL 02270000
CLC #GMS+1,GMSIZE(2,XR2) WILL GM WORK? 02280000
BL CSQMKW NO - GO MAKE THIS A WAIT OP 02290000
SBN $FLGC,#PUTTP SET TO GETMAIN FROM ANYWHERE @08 02295000
B CSGMRQ GO DO GET MAIN 02300000
L CSSPL,PL XR1 --> PL 02310000
B CSQMOV GO MOVE DATA TO TP BUFFER 02320000
B CSQPLG GO DO GM FOR PL 02330000
SPACE 1 02340000
* PUT THE PL ON CLBPLQ 02350000
CSQONQ EQU * 02360000
AIF (&CSIO EQ '1').PT040 02360500
AGO .PT050 02360560
.PT040 ANOP 02360620
AIF (&NCPOR).PT060 02360680
.PT050 ANOP 02360740
SPACE 1 02360800
******************************************************************* @14 02360860
******* 02360920
* IF A PORT DEVICE AND SOMETHING IS ON TUBDCH(TPBUFF) DATA Q, DO NOT 02362500
* Q THE PARM LIST. IF THIS IS A PUT, THE USER WILL GET A 0005 RETURN 02363000
* CODE. 02363500
TBN CLBBA3(,CLB),BA3POR PORTLINE OR SIOC DEVICE ? 02364000
JF CSQQPL NO 02364500
L PLTUBA(,PL),TUB XR2--> TUB 02365000
CLI TUBDCH-1(,TUB),NOBIT ANYTHING ON THE TPBUFF DATA Q 02365500
L CSSCLB,CLB XR2--> CLB 02366000
JNE CSQEXT YES,DO NOT Q THE PARM LIST 02366500
CSQQPL EQU * * 02367000
******* 02367500
******************************************************************* @14 02367700
SPACE 1 02368000
.PT060 ANOP 02369000
LA CLBPLQ-1(,CLB),XR2 XR2 -->BEGINNING OF QUEUE 02370000
CSQBMP EQU * * 02380000
CLI PLCHN-1(,XR2),NOBIT END OF CHAIN? 02390000
JE CSQIT YES - PUT IT ON THE QUEUE 02400000
L PLCHN(,XR2),XR2 XR2 --> NEXT PL 02410000
B CSQBMP GO LOOK AGAIN 02420000
CSQIT EQU * * 02430000
ST PLCHN(,XR2),PL PUT PL ON THE QUEUE 02440000
MVI PLCHN-1(,PL),NOBIT ASSURE THIS IS THE END-OF-CHAIN 02450000
CSQEXT EQU * * 02460000
CCP UNMASK,PMR ALLOW INTERRUPTS 02470000
L CSSCLB,CLB XR2 --> CLB 02480000
CSQARR B # RETURN 02490000
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S (C S P S T E)' 02500000
*********************************************************************** 02510000
* * 02520000
* NAME: CSPSTE * 02530000
* * 02540000
* FUNCTION: POST AN OP END, FREE BUFFERS IF REQUIRED, PUT OPENDED * 02550000
* PL ON TCBINQ (FOR INVITES) * 02560000
* * 02570000
* INPUT: XR1--> PL TO POST * 02580000
* XR2--> NO MATTER * 02590000
* * 02600000
* OUTPUT: XR1--> RESTORED * 02610000
* XR2--> RESTORED * 02620000
* PL POSTED COMPLETE * 02630000
* * 02640000
* EXIT: RETURN TO CALLER * 02650000
* * 02660000
*********************************************************************** 02670000
SPACE 1 02680000
CSPSTE EQU * 02690000
ST CSPARR+3,ARR SAVE RETURN ADDRESS 02700000
ST CSPX1+3,PL SAVE XR1 02710000
ST CSPX2+3,XR2 SAVE XR2 02720000
CCP MASK,PMR MASK ALL INTERRUPTS 02730000
TBN PL$OPM(,PL),OPPNW PUT-NO-WAIT OP ? 02740000
JF CSPNNW NO - JUMP 02750000
* HAVE PUT-NO-WAIT -JUST FREE - NO POST 02760000
B CSFREE GO FREE RECA AND PL AREA 02770000
B CSPEXT GO RETURN TO CALLER 02780000
SPACE 1 02790000
* CHECK FOR SYSTEM INVITE OP 02800000
CSPNNW EQU * * 02810000
MVC PLRTC(2,PL),PL$RTC(,PL) PUT RETURN CODE IN EXTERNAL 02820000
* SO USER CAN GET AT IT 02830000
TBN PL$OPM(,PL),OPINV INVITE INPUT AND 02840000
TBN PLOPM(,PL),OP$SYS SYSTEM OP ? 02850000
JF CSPCKT NO - SEE IF TASK IS IN TERMINATE 02860000
AIF (&NPBY).BP600 BUSY PRINTER SUPPORT? 02860400
* --------START----------------@07 02860800
SPACE 1 02861200
* CHECK THE TUB FOR THIS SYSTEM INVITE TO SEE IF IT IS A 02861600
* PRINTER THAT WAS BUSY. 02862000
* IF SO - POST THE USER - PLECB - SO THE NEXT PRINT OPERATION 02862400
* CAN BE STARTED 02862800
SPACE 1 02863200
L PLTUBA(,PL),TUB FIND THE TUB. 02863600
TBN TUBAT4(,TUB),TUBWAT THIS TUB WAITING - BUSY PRINTER? 02864000
SBF TUBAT4(,TUB),TUBWAT SET OFF WAITING BEFORE POST. 02864400
JF CSNBYP NO - CONTINUE HANDLING SYS/INV. 02864800
SBF TUBAT2(,TUB),TUBIIS SET OFF INPUT SCHEDULED. 02865200
L CSSPL,PL XR1 --> PL 02865600
L CSSCLB,CLB XR2 --> CLB 02866000
B CSFREE FREE THE INPUT BUFFER 02866400
LA PLECB(,PL),XR1 XR1 --> ECB 02866800
CCP UNMASK,PMR ALLOW INTERRUPTS 02867200
SVC 0 SPVR CALL 02867600
DC AL1(PSTRIB) RIB TO POST 02868000
B CSPEXT GO EXIT 02868400
CSNBYP EQU * * LOCAL 02868800
* ---------END-----------------@07 02869200
.BP600 ANOP * 02869600
SPACE 1 02870000
* SYSTEM INVITE INPUT - IF TASK IS IN RESIDENT TERMINATION THEN PUT 02880000
* PL ON OWNER'S TCB. IF NOT IN RESIDENT TERMINATION-PUT PL ON 02890000
* COMMAND PROCESSOR'S TCB. 02900000
SPACE 1 02910000
L PLTUBA(,PL),TUB XR2 --> TUB 02920000
TBN TUBAT4(,TUB),TUBTRM TASK IN RESIDENT TERMINATION 02930000
L @CPTCB,XR1 XR1 --> CP'S TCB 02940000
JF CSPCPQ NO - GO PUT TUB ON CP'S TCB 02950000
L TUBTCB(,TUB),XR1 XR1 --> OWNER'S TCB 02960000
* ADD TUB TO TCBINQ OF THE PROPER TCB 02970000
CSPCPQ EQU * * 02980000
MVI TUBINQ-1(,TUB),NOBIT ZIP THIS TUB'S CHAIN POINTER 02990000
LA TCBINQ-TUBINQ(,XR1),XR1 XR1 --> FIRST 'TUB' 03000000
CSPCPL EQU * * 03010000
CLI TUBINQ-1(,XR1),NOBIT END OF QUEUE? 03020000
JE CSPSTT YES - JUMP TO ADD THIS ONE 03030000
L TUBINQ(,XR1),XR1 XR1 --> NEXT TUB IN THE QUEUE 03040000
B CSPCPL GO LOOK AGAIN 03050000
CSPSTT EQU * * 03060000
ST TUBINQ(,XR1),TUB PUT THIS TUB IN THE QUEUE 03070000
L CSPX1+3,PL XR1 --> PL 03080000
ST TUBPL@(,TUB),PL PUT PL ADDR IN TUB 03090000
MVC PLRTC(2,PL),PL$RTC(,PL) PUT INTERNAL R.C. INTO EXTERNAL 03100000
SBN TUBAT2(,TUB),TUBIIS+TUBIIQ SET INPUT AVAILABLE IND. 03110000
TBN TUBAT4(,TUB),TUBTRM TASK IN RESIDENT TERMINATION? 03120000
JT CSPNSP YES - JUMP -NO POST INVOLVED 03130000
LA $CPCM,XR1 XR1 --> CP'S ECB 03140000
CCP UNMASK,PMR ALLOW INTERRUPTS 03150000
* POST THE COMMAND PROCESSOR 03160000
SVC 0 SPVR CALL 03170000
DC AL1(PSTRIB) RIB FOR A POST 03180000
CSPNSP EQU * * 03190000
B CSPEXT GO RETURN TO CALLER 03200000
SPACE 2 03210000
* CHECK FOR TASK IN TERMINATION (NON-RESIDENT) IF IT IS - JUST FREE 03220000
* BUFFERS AND RETURN TO CALLER 03230000
SPACE 1 03240000
CSPCKT EQU * * 03250000
AIF (&CSIO EQ '1').PT070 03250300
AGO .PT080 03250330
.PT070 ANOP 03250360
AIF (&NCPOR).PT090 03250390
.PT080 ANOP 03250420
SPACE 1 03250450
******************************************************************* @14 03250480
******* 03250510
* ALSO IF A GET. 03251500
* IF A PORT DEVICE,USER OP,NOT A STOP INVITE, AND COMMAND DATA, HAVE 03251800
* THE DATA QUEUED IN TPBUFF, INDICATE TO $CC4II TO GIVE A RETURN CODE 03252100
* TO THE USER, AND GIVE THE DATA TO THE COMMAND PROCESSOR. 03252400
* ALSO FREE THE PARM LIST,IF A NO-WAIT OP. 03252700
L CSSCLB,CLB XR2--> CLB 03253000
TBN CLBBA3(,CLB),BA3POR PORTLINE OR SIOC DEVICE ? 03253300
TBN CSSWIT,CSSCMD COMMAND DATA TO USER 03253600
JF CSPUDT IF NOT ALL, JUMP 03254200
SBF CSSWIT,CSSCMD CLEAR INDICATOR 03254300
L PLTUBA(,PL),TUB XR2--> TUB 03254500
SBN TUBAT3(,TUB),TUBCNC INDICATE COMMAND DATA TO CCP 03254800
MVI PLRECA-1(,PL),NOBIT CLEAR RECORD PTR SO NO DATA FREE 03255100
B CSFREE GO FREE PARM LIST IF NO-WAIT 03255400
TBN PL$OPM(,PL),OPINV INVITE INPUT OP 03255700
JT CSPINV YES, DO INVITE INPUT PROCESSING 03256000
J CSPDMO NO, POST PARM LIST AND EXIT 03256300
CSPUDT EQU * * 03256600
******* 03256900
******************************************************************* @14 03257000
SPACE 1 03257200
.PT090 ANOP 03257800
L PLTUBA(,PL),TUB XR2 --> TUB 03260000
L TUBTCB(,TUB),XR2 XR2 --> TCB OF OWNER 03270000
TBN TCBFG1(,XR2),TCBUSR+TCBNCL SYSTEM TASK AND 03280000
TBF PLOPM(,PL),OP$SYS USER OP 03290000
JT CSPJSF YES - TASK IS IN TERM -JUST FREE 03300000
TBN TCBFG2(,XR2),TCBTRC TERM INDICATOR ON IN THIS TASK? 03310000
AIF (&NDME).D0200 NO DME SUPPORT. 03320000
JF CSPCMI NO - CHECK FOR TASK IN DME 03330000
AGO .D0300 * 03340000
.D0200 ANOP * 03350000
JF CSPUIN NO - CHECK FOR USER INVITE. 03360000
.D0300 ANOP * 03370000
CSPJSF EQU * * 03380000
B CSFREE GO FREE BUFFERS AND PL AREA 03390000
L PLTUBA(,PL),TUB XR2 --> TUB 03400000
SBF TUBAT2(,TUB),TUBIIS+TUBIIQ SET OFF INPUT INDICATORS 03410000
J CSPEXT GO EXIT TO CALLER 03420000
AIF (&NDME).D0350 NO DME SUPPORT. 03430000
* CHECK FOR TASK IN DATA MODE ESCAPE 03440000
CSPCMI L PLTUBA(,PL),TUB XR2 --> TUB 03450000
TBN TUBAT2(,TUB),TUBCMD+TUBDTA IN DATA MODE ESCAPE ? 03460000
JF CSPUIN NO - CHECK FOR USER INVITE 03470000
* IN DATA MODE ESCAPE - POST THE COMMAND PROCESSOR IF AN OUTPUT WAIT- 03480000
* TYPE OP OR IF AN INPUT OP 03490000
SPACE 1 03500000
TBN PL$OPM(,PL),OPGET INPUT OP? 03510000
JF CSPDMO NO-JUMP 03520000
L @CPTCB,XR1 XR1 --> CP'S TCB 03530000
B CSPCPQ GO PUT ON CP'S TCB AND POST 03540000
.D0350 ANOP * 03542000
AIF (&CSIO EQ '0').YP045 SIOC SUPPORT YES 03544000
.*******************************************************************@20 03544300
AIF (&NCPOR).PT095 PORTLINE SUPPORT ? 03544600
AGO .YP045 YES - ADD THIS CODE 03544900
.PT095 ANOP NO CONTINUE 03545200
.*******************************************************************@20 03545500
AIF (&NDME).D0400 NO DME SUPPORT. 03546000
.YP045 ANOP 03548000
CSPDMO EQU * 03550000
* MUST BE A SIOC CHANNEL OPERATION OR 03555000
* OP MUST BE A WAIT AT THIS POINT AND BE IN DATA MODE ESCAPE-POST PLECB 03560000
* DO NOT FREEMAIN ANY AREAS 03570000
LA PLECB(,PL),XR1 XR1 --> ECB TO POST 03580000
CCP UNMASK,PMR ALLOW INTERRUPTS 03590000
SVC 0 SPVR CALL 03600000
DC AL1(PSTRIB) RIB FOR POST 03610000
J CSPEXT GO EXIT 03620000
SPACE 1 03630000
.D0400 ANOP * 03640000
* CHECK FOR A USER INVITE INPUT 03650000
CSPUIN EQU * * 03660000
TBN PL$OPM(,PL),OPINV INVITE INPUT AND 03670000
TBF PLOPM(,PL),OP$SYS NOT-SYSTEM (USER) OP ? 03680000
TBF PLOPM(,PL),OPSTOP NOT A STOP INVITE PARM LIST ? 03690000
JF CSPCGT NO - CHECK FOR A USER GET OP 03700000
* HAVE A USER INVITE INPUT - QUEUE IT AND POST OP COMPLETE 03710000
CSPINV EQU * * 03715000
L PLTUBA(,PL),TUB XR2 --> TUB 03720000
ST TUBPL@(,TUB),PL PUT PL ADDRESS IN THE TUB 03730000
SBN TUBAT2(,TUB),TUBIIS+TUBIIQ SET INPUT INDICATORS 03740000
L TUBTCB(,TUB),XR1 XR1 --> OWNERS TCB 03750000
LA TCBINQ-TUBINQ(,XR1),XR1 XR1 --> FIRST 'TUB' 03760000
CSPUQL EQU * * 03770000
CLI TUBINQ-1(,XR1),NOBIT END OF CHAIN? 03780000
JE CSPUQT YES - ADD THIS TUB 03790000
L TUBINQ(,XR1),XR1 XR1 --> NEXT TUB 03800000
B CSPUQL GO LOOK AGAIN 03810000
CSPUQT EQU * * 03820000
ST TUBINQ(,XR1),TUB PUT TUB IN THE CHAIN 03830000
MVI TUBINQ-1(,TUB),NOBIT ZIP THIS TUB'S POINTER 03840000
* DO NOT POST THE USER UNLESS IT IS AT AN ACCEPT INPUT WAIT 03850000
L TUBTCB(,TUB),XR1 XR1 -->TCB 03860000
TBN TCBECB(,XR1),TCBACW AT ACCEPT INPUT WAIT? 03870000
JF CSPEXT NO - GO RETURN TO CALLER 03880000
LA TCBECB(,XR1),XR1 XR1 --> ECB TO POST 03890000
CCP UNMASK,PMR ALLOW INTERRUPTS 03900000
SVC 0 SPVR CALL 03910000
DC AL1(PSTRIB) POST RIB 03920000
J CSPEXT GO RETURN TO CALLER 03930000
* CHECK FOR A USER GET OP 03940000
CSPCGT EQU * 03950000
TBF PLOPM(,PL),OP$SYS NOT SYSTEM (USER) OP 03960000
TBN PL$OPM(,PL),OPGET AND A GET (I.E. USER GET) ? 03970000
JF CSPPTW NO - CHECK FOR PUT-WAIT 03980000
* HAVE A USER GET - IF NON-DFF,MOVE THE TEXT TO USER'S BUFFER AND POST 03990000
* PLECB. IF DFF - PUT IT ON DFF'S QUEUE AND POST DFF 04000000
L PLTUBA(,PL),TUB XR2 --> TUB 04010000
SBF TUBAT2(,TUB),TUBIIS+TUBIIQ SET OFF INPUT INDICATORS 04020000
AIF (&NDF).F0700 NO DFF SUPPORT. 04030000
TBN TUBTA1(,TUB),TASDFF DFF TERMINAL ? 04040000
JF CSPNDF NO - JUMP 04050000
* PUT TERMINAL ON DFF'S QUEUE AND POST DFF IF RETURN CODE IS LESS THAN 04060000
* THREE 04070000
CLI PL$RTC(,PL),RCXEDT RETURN CODE > 3 ? 04080000
JH CSPGT3 YES - POST USER 04090000
B CSDFFQ GO PUT IT ON DFF'S QUEUE AND PST 04100000
J CSPEXT GO RETURN TO CALLER 04110000
CSPGT3 EQU * * 04120000
B CSFREE FREE INPUT BUFFER 04130000
LA PLECB(,PL),XR1 XR1 --> ECB 04140000
CCP UNMASK,PMR 04150000
SVC 0 SPVR CALL 04160000
DC AL1(PSTRIB) RIB TO POST 04170000
J CSPEXT GO EXIT 04180000
* NOT A DFF TERMINAL - MOVE THE TEXT AND POST THE USER 04190000
CSPNDF EQU * * 04200000
.F0700 ANOP * 04210000
SPACE 1 04220000
* SETUP THE MOVE PL 04230000
LA CS#MVL,XR2 XR2 --> MOVE PARM LIST 04240000
MVC MVLFRA(2,XR2),PLRECA(,PL) FROM ADDR. IS TPBUFF 04250000
MVI MVLTYP(,XR2),SWAPTO TYPE IS'TO USER AREA' 04260000
MVC MVLFRL(2,XR2),PLEFFL(,PL) FROM LENGTH IS PLEFFL 04270000
MVC MVLTOL(2,XR2),PLINL(,PL) TO LENGTH IS INL 04280000
L PLTUBA(,PL),XR1 XR1 --> TUB 04290000
MVC MVLTCB(2,XR2),TUBTCB(,XR1) TCB ADDRESS OF OWNER 04300000
L TUBTCB(,XR1),XR1 XR1 --> TCB 04310000
MVC MVLTOA(2,XR2),TCBWK(,XR1) TO ADDRESS IS USER'S RECORD AREA 04320000
B CC4MX GO MOVE THE TEXT 04330000
L CSSPL,PL XR1 --> PL 04340000
L CSSCLB,CLB XR2 --> CLB 04350000
B CSFREE FREE THE INPUT BUFFER 04360000
LA PLECB(,PL),XR1 XR1 --> ECB 04370000
CCP UNMASK,PMR ALLOW INTERRUPTS 04380000
SVC 0 SPVR CALL 04390000
DC AL1(PSTRIB) RIB TO POST 04400000
J CSPEXT GO EXIT 04410000
* CHECK FOR A PUT WAIT OP 04420000
CSPPTW EQU * * 04430000
TBN PL$OPC(,PL),OPPUT PUT - 04440000
TBF PL$OPC(,PL),OPNOW WAIT OP ? 04450000
JF CSPEXT NO - EXIT 04460000
* HAVE A PUT - WAIT OP -FREE THE BUFFER AND POST 04470000
B CSFREE GO FREE 04480000
LA PLECB(,PL),XR1 XR1 --> ECB 04490000
CCP UNMASK,PMR 04500000
SVC 0 SPVR CALL 04510000
DC AL1(PSTRIB) POST RIB 04520000
CSPEXT EQU * 04530000
CCP UNMASK,PMR ALLOW INTERRUPTS 04535000
CSPX1 LA #,XR1 RESTORE XR1 04540000
CSPX2 LA #,XR2 RESTORE XR2 04550000
CSPARR B # RETURN 04560000
AIF (&NDF).F0800 NO DFF SUPPORT. 04570000
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S (C S D F F Q)' 04580000
*********************************************************************** 04590000
* * 04600000
* NAME CSDFFQ * 04610000
* THIS SUBROUTINE PUTS A PL ON DFF'S QUEUE AND POSTS DFF * 04620000
* XR1 --> PL TO QUEUE * 04630000
* XR2 --> NO MATTER * 04640000
* * 04650000
*********************************************************************** 04660000
SPACE 3 04670000
CSDFFQ EQU * * 04680000
ST CSDFRT+3,ARR SAVE RETURN ADDRESS 04690000
ST CSDFX1+3,PL SAVE THE PL ADDRESS 04700000
ST CSDFX2+3,XR2 SAVE XR2 04710000
CCP MASK,PMR MASK INTERRUPTS 04720000
L PLTUBA(,PL),TUB XR2 --> TUB 04730000
L TUBTCB(,TUB),XR2 XR2 --> TCB OF OWNER 04740000
TBN TCBFG2(,XR2),TCBTRC TASK IN TERMINATION 04750000
JF CSDFNT NO - JUMP 04760000
SPACE 1 04770000
* TASK IS IN TERMINATION - JUST FREEMAIN THE AREAS - DON'T POST DFF 04780000
B CSFREE GO DO FREEMAINS 04790000
J CSDFX2 GO RETURN TO CALLER 04800000
SPACE 1 04810000
CSDFNT EQU * TASK IS NOT IN TERMINATION 04820000
MVI PLCHN-1(,PL),NOBIT ZIP THIS CHAIN POINTER 04830000
LA @DFFQ-1,XR2 XR2 --> DFF'S QUEUE 04840000
CSDFEN EQU * * 04850000
CLI PLCHN-1(,XR2),NOBIT END OF DFF'S CHAIN ? 04860000
JE CSDFAD YES - GO ADD THIS ONE 04870000
L PLCHN(,XR2),XR2 XR2 --> NEXT PL ON DFF'S QUEUE 04880000
B CSDFEN GO LOOK AGAIN 04890000
CSDFAD EQU * * 04900000
ST PLCHN(,XR2),PL PUT THIS PL ON THE QUEUE 04910000
CCP UNMASK,PMR ALLOW INTERRUPTS 04920000
SPACE 1 04930000
* POST DFF 04940000
LA $DFECB,XR1 XR1 --> DFF'S ECB 04950000
SVC 0 SUPERVISOR CALL 04960000
DC AL1(PSTRIB) RIB TO POST 04970000
SPACE 1 04980000
CSDFX2 LA #,XR2 RESTORE XR2 04990000
CSDFX1 LA #,PL RESTORE TH PL POINTER 05000000
CSDFRT B # RETURN TO CALLER 05010000
.F0800 ANOP * 05020000
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S (C S W C R Q)' 05030000
*********************************************************************** 05040000
* * 05050000
* NAME CSWCRQ * 05060000
* * 05070000
* THIS SUBROUTINE WILL MARK A PL AS WAITING FOR TPBUFF AND * 05080000
* PUT IT ON CLBWCQ * 05090000
* * 05100000
* XR1 --> PL TO MARK AND QUEUE * 05110000
* XR2 --> NO MATTER * 05120000
*********************************************************************** 05130000
SPACE 1 05140000
CSWCRQ EQU * * 05150000
ST CSWCRT+3,ARR SAVE THE RETURN ADDRESS 05160000
ST CSWCX2+3,XR2 SAVE XR2 05170000
SBN PL$OPM(,PL),OPGETM MARK PL AS WAITING FOR TPBUFF 05180000
SLC PLCHN(2,PL),PLCHN(,PL) ZIP THE CHAIN FIELD 05190000
L PLTUBA(,PL),TUB XR2 --> TUB 05200000
L TUBLCB(,TUB),CLB XR2 --> CLB 05210000
LA CLBWCQ-1(,CLB),XR2 XR2 --> BEGINNING OF QUEUE 05220000
CSWCAG EQU * * 05230000
CLI PLCHN-1(,XR2),NOBIT END OF CHAIN ? 05240000
JE CSWCAD YES - GO ADD THIS ONE 05250000
L PLCHN(,XR2),XR2 XR2 --> NEXT PL ON QUEUE 05260000
B CSWCAG GO LOOK FOR THE END 05270000
SPACE 1 05280000
* ADD THIS PL TO THE QUEUE OF THOSE WAITING FOR TPBUFF 05290000
SPACE 1 05300000
CSWCAD EQU * * 05310000
ST PLCHN(,XR2),PL ADD IT TO THE QUEUE 05320000
SPACE 1 05330000
CSWCX2 LA #,XR2 RESTORE XR2 05340000
CSWCRT B # RETURN TO CALLER 05350000
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S (C S G M R Q)' 05360000
*********************************************************************** 05370000
* * 05380000
* NAME: CSGMRQ * 05390000
* FUNCTION: INTERFACE WITH $CC4MS ( THE GETMAIN ROUTINE ) * 05400000
* * 05410000
* INPUT: XR1 AND XR2 --> NO MATTER * 05420000
* * 05430000
* OUTPUT: XR1--> RESTORED * 05440000
* XR2--> GETMAIN LIST * 05450000
*********************************************************************** 05460000
SPACE 1 05470000
CSGMRQ EQU * * 05480000
ST CSGMRT+3,ARR SAVE THE RETURN ADDRESS 05490000
ST CSGMX1+3,XR1 SAVE XR1 05500000
LA GMLIST,XR2 XR2 --> GM PARM LIST 05510000
MVI 0(,XR2),NOBIT MAKE IT A NO-WAIT REQUEST 05520000
CCP MASK,PMR MASK INTERRUPTS 05530000
B CC4GM GO DO THE GETMAIN 05540000
JOL CSGMX1 SKIP MOVE IF GET FAILED 05545000
L GMADDR(,XR2),XR1 XR1--> GM'ED AREA 05550000
MVC GMSIZE(4,XR1),GMSIZE(,XR2) PUT ADDR. AND LENGTH IN TPBUF 05560000
CSGMX1 LA #,XR1 RESTORE XR1 05570000
CSGMRT B # RETURN TO CALLER 05580000
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S (C S F R E E)' 05590000
*********************************************************************** 05600000
* * 05610000
* NAME: CSFREE * 05620000
* * 05630000
* FUNCTION: FREEMAIN THE RECORD AREA (PLRECA) AND THE PL. * 05640000
* PLRECA WILL BE FREEMAINED IF IT IS NON-ZERO. * 05650000
* THE PL WILL BE FREEMAINED IF IT IS A NO-WAIT PL AND * 05660000
* NOT A SYSTEM INVITE. * 05670000
* * 05680000
* INPUT: XR1--> PL * 05690000
* XR2--> NO MATTER * 05700000
* * 05710000
* OUTPUT: XR1--> PL * 05720000
* XR2--> RESTORED * 05730000
* * 05740000
*********************************************************************** 05750000
SPACE 2 05760000
CSFREE EQU * * 05770000
ST CSFRET+3,ARR SAVE THE RETURN ADDRESS 05780000
ST CSFX2+3,XR2 SAVE XR2 05790000
* IF THIS IS A SYSTEM WAIT-TYPE OP - DON'T FREEMAIN ANYTHING 05800000
TBN PL$OPC(,PL),OPSYS SYSTEM - 05810000
TBF PL$OPM(,PL),OPNOW WAIT-TYPE OP? 05820000
JT CSFEXT YES - RETURN TO CALLER 05830000
SPACE 1 05840000
* IF RECORD AREA IS NON-ZERO - FREEMAIN IT 05850000
CCP MASK,PMR DON'T ALLOW INTERRUPTS 05860000
CLI PLRECA-1(,PL),NOBIT RECORD AREA ALREADY FREE'ED? 05870000
JE CSFNRF YES - SKIP FREE OF RECORD AREA 05880000
SPACE 1 05890000
* FREE THE RECORD AREA 05900000
AIF (&CSIO EQ '1').NP050 05900700
SPACE 1 05901400
******************************************************************* @14 05901700
******* 05902100
* IF PORT DEVICE AND A PUT, DO NOT FREE USER'S BUFFER AREA 05903500
L PLTUBA(,PL),TUB XR2--> TUB 05904200
TBN TUBAT4(,TUB),TUBPCB PORT--------------------------->|05904900
TBN PL$OPM(,PL),OPPUT AND A PUT---------------------->|05905600
JT CSFSKF YES, DON'T FREE USER'S BUFFER<--|05906300
******* 05907700
******************************************************************* @14 05908000
.NP050 ANOP 05909100
SPACE 1 05909140
AIF (&NDF).NP055 05909180
* IF DFF USER PUT AND DFF BUFFER IS SUPPORTED, NO NOT FREEMAIN @13 05909220
SPACE 05909260
TBF PLOPM(,PL),OP$SYS Q-USER..... @13 05909300
TBN PL$OPC(,PL),OPPUT .....PUT?..... @13 05909340
JF CSFRDF NO-BRANCH @13 05909380
SPACE 05909420
L PLTUBA(,PL),TUB XR2-> TUB @13 05909460
TBN TUBTA1(,TUB),TASDFF Q-DFF REQUEST? @13 05909500
JF CSFRDF NO-BRANCH @13 05909540
SPACE 05909580
L TUBDTF(,TUB),CLB XR2-> BSC DTF @13 05909620
TBN CLBATA(,CLB),CLBDFF Q-DFF SUPPORTED? @13 05909660
JF CSFRDF NO-BRANCH @13 05909700
SPACE 05909740
MVI PLRECA-1(,PL),NOBIT PREVENT FREEMAIN @13 05909780
J CSFEXT RETURN TO CALLER @13 05909820
SPACE 05909860
CSFRDF EQU * . @13 05909900
.NP055 ANOP 05909940
L PLRECA(,PL),XR2 XR2--> RECORD AREA 05910000
B CC4FM GO TO FREEMAIN ROUTINE 05920000
* IF THE INPUT BUFFER FOR THIS LINE IS THE SAME AS PLRECA - THEN 05930000
* ZIP IT ALSO TO PREVENT A DUPLICATE FREEMAIN UPON RESCHEDULE 05940000
SPACE 1 05950000
CSFSKF EQU * * 05955000
L PLTUBA(,PL),TUB XR2--> TUB 05960000
L TUBLCB(,TUB),CLB XR2--> CLB 05970000
CLC PLRECA(2,PL),CLBIBA(,CLB) SAME ADDRESS? 05980000
JNE CSFJPL NO - JUST ZIP PLRECA 05990000
MVI CLBIBA-1(,CLB),NOBIT ZIP THE LINE RECORD ADDRESS 06000000
CSFJPL EQU * * 06010000
MVI PLRECA-1(,PL),NOBIT ZIP THE PL RECORD AREA ADDR. 06020000
SPACE 1 06030000
* IF THIS IS A WAIT TYPE OP THEN GO EXIT 06040000
CSFNRF EQU * * 06050000
TBF PL$OPM(,PL),OPNOW WAIT TYPE OP ? 06060000
JT CSFEXT YES - GO RETURN TO CALLER 06070000
* ZIP TUBPL@ FOR INVITE INPUT OP'S 06080000
TBN PLOPC(,PL),OPINV INVITE INPUT ? 06090000
JF CSFRPL NO - GO FREE THE PL 06100000
* THE INVITE INPUT PL IS NO LONGER VALID - ZIP IT OUT 06110000
L PLTUBA(,PL),TUB XR2--> TUB 06120000
MVI TUBPL@-1(,TUB),NOBIT ZIP THE PL POINTER 06130000
* DON'T FREEMAIN SYSTEM INVITES - THE PL IS IN THE TUB 06140000
SPACE 1 06150000
TBN PL$OPC(,PL),OPSYS SYSTEM OP ? 06160000
JT CSFEXT YES - GO RETURN TO CALLER 06170000
SPACE 1 06180000
* FREEMAIN THE PL 06190000
SPACE 1 06200000
CSFRPL EQU * * 06210000
AIF (&CSIO EQ '1').PT100 06210800
AGO .PT110 06210900
.PT100 ANOP 06211000
AIF (&NCPOR).PT120 06211100
.PT110 ANOP 06211200
SPACE 1 06211300
******************************************************************* @14 06211400
******* 06211500
* IF PORT DEVICE DUMMY PARM LIST, DO NOT FREE THE PARM LIST 06214000
TBN PLOPC(,PL),OPDMY PORT DEVICE DUMMY PARM LIST 06214800
JT CSFEXT YES, DO NOT FREE THE PARM LIST 06215600
******* 06216400
******************************************************************* @14 06216800
SPACE 1 06217200
.PT120 ANOP 06218800
LA 0(,PL),XR2 XR2--> PL 06220000
B CC4FM GO FREEMAIN THE PL 06230000
SPACE 1 06240000
* SET UP REGISTERS FOR RETURN TO CALLER 06250000
CSFEXT EQU * * 06260000
CSFX2 LA #,XR2 RESTORE XR2 06270000
* XR1 ALREADY POINTS TO THE PL 06280000
CCP UNMASK,PMR ALLOW INTERRUPTS 06290000
CSFRET B # RETURN TO CALLER 06300000
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S (C S D E Q)' 06310000
*********************************************************************** 06320000
* * 06330000
* NAME: CSDEQ * 06340000
* * 06350000
* FUNCTION: REMOCE A PL FROM CLBPLQ * 06360000
* * 06370000
* INPUT: XR1--> PL TO REMOVE * 06380000
* XR2--> NO MATTER * 06390000
* * 06400000
* OUTPUT: XR1--> REMOVED PL * 06410000
* XR2--> RESTORED * 06420000
* * 06430000
*********************************************************************** 06440000
SPACE 1 06450000
CSDEQ EQU * * 06460000
ST CSDQAR+3,ARR SAVE THE RETURN ADDRESS 06470000
ST CSDQX2+3,XR2 SAVE REG 2 06480000
ST CSDQPL,PL SAVE THE PL ADDRESS TO BE DEQED 06490000
L PLTUBA(,PL),TUB XR2--> TUB 06500000
L TUBLCB(,TUB),CLB XR2--> CLB 06510000
LA CLBPLQ-1(,CLB),XR2 XR2--> 1ST PL ON THE QUEUE 06520000
CSDQCP EQU * * 06530000
CLC PLCHN(2,XR2),CSDQPL THIS POINT TO ONE TO DEQUE? 06540000
JE CSDQOK YES - DEQUEUE THE PL 06550000
L PLCHN(,XR2),XR2 XR2--> NEXT PL 06560000
B CSDQCP GO LOOK AGAIN 06570000
SPACE 1 06580000
* DEQUEUE THE PL FROM CLBPLQ 06590000
CSDQOK EQU * * 06600000
MVC PLCHN(2,XR2),PLCHN(,PL) DEQUEUE THIS PL 06610000
* RETURN TO CALLER 06620000
CSDQX2 LA #,XR2 RESTORE XR2 06630000
CSDQAR B # RETURN TO CALLER 06640000
CSDQPL DC AL2(0) SAVE AREA FOR PL @ TO DEQUEUE 06650000
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S (C S T A S V)' 06660000
*********************************************************************** 06670000
* * 06680000
* NAME: CSTASV * 06690000
* * 06700000
* FUNCTION: SAVE THIS TUB'S ATTRIBUTES IN THE CLB * 06710000
* * 06720000
* * 06730000
* * 06740000
* CLBTBS * 06750000
* | * 06760000
* | -5 -4 -3 -2 -1 | | * 06770000
* |____|____|____|____|____|____| * 06780000
* * 06790000
* -5 = TUBTA1 * 06800000
* -4 = TUBTA2 * 06810000
* -3 -2 = TUBRCL ------------------| * 06820000
* -1 -0 = CALCULATED BLOCK LENGTH --|--> PLUGGED BY CSBTAS * 06830000
* * 06840000
* INPUT: XR1--> PL * 06850000
* XR2--> NO MATTER * 06860000
* * 06870000
*********************************************************************** 06880000
SPACE 1 06890000
CSTASV EQU * * 06900000
ST CSTS20+3,ARR SAVE THE RETURN ADDRESS 06910000
ST CSTS18+3,XR2 SAVE XR2 06920000
ST CSTSX1+3,PL SAVE THE PL ADDRESS 06930000
L PLTUBA(,PL),TUB XR2--> TUB 06940000
L TUBLCB(,TUB),XR1 XR1--> CLB 06950000
MVC CLBTBS-4(2,XR1),TUBTA2(,TUB) SAVE THIS TUB'S ATTRIBUTES 06960000
L CSTSX1+3,XR2 XR2--> PL 06970000
SBF PL$OPC(,XR2),OPSYS SET OFF SYSTEM IND 06980000
TBF PLOPM(,XR2),OP$SYS SYSTEM OP OR - 06990000
.*******************************************************************@18 06993000
AIF (&NDME).D500 IF NO DATA MODE ESCAPE ? 06996000
TBF PL$OPC(,XR2),OPRFSH+OPLSNS CLEAR MSG OR POLL FOR STATUS ? 07000000
AGO .D600 CONTINUE 07001000
.D500 ANOP IF DATA MODE ESCAPE 07002000
TBF PL$OPC(,XR2),OPLSNS POLL FOR STATUS 07003000
.D600 ANOP 07004000
.*******************************************************************@18 07005000
JT CSTS06 NO - JUMP 07010000
MVI CLBTBS-4(,XR1),TASMSG MAKE IT MSG MODE 07020000
SBN PL$OPC(,XR2),OPSYS MAKE IT A SYSTEM OP 07030000
CSTS06 EQU * * 07040000
CSTSX1 LA #,XR1 XR1--> PL 07050000
CSTS18 LA #,XR2 RESTORE XR2 07060000
CSTS20 B # RETURN TO CALLER 07070000
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S (C S B T A S)' 07080000
*********************************************************************** 07090000
* * 07100000
* NAME: CSBTAS * 07110000
* * 07120000
* FUNCTION: SAVE THE TUB'S ATTRIBUTES AND RECORD LENGTH IN THE CLB * 07130000
* ( SEE CSTASV FOR LAYOUT OF SAVE AREA) * 07140000
* * 07150000
* INPUT: XR1--> PL * 07160000
* XR2--> NO MATTER * 07170000
* * 07180000
* OUTPUT: XR1--> PL * 07190000
* XR2--> RESTORED * 07200000
* * 07210000
*********************************************************************** 07220000
SPACE 1 07230000
CSBTAS EQU * * 07240000
ST CSBT40+3,ARR SAVE THE RETURN ADDRESS 07250000
ST CSBT38+3,XR2 SAVE XR2 07260000
SPACE 1 07270000
B CSTASV GO SET UP THE ATTRIBUTES 07280000
SPACE 1 07290000
* SET UP THE BSCC ATTRIBUTES 07300000
SPACE 1 07310000
L CSSCLB,CLB XR2-->CLB 07320000
SPACE 1 07330000
* TRANSPARENCY IS SET ON BY THE BSCC DATA MANAGEMENT ON INPUT 07340000
* TRANSPARENCY IS SET UP BY CS ON OUTPUT 07350000
SPACE 1 07360000
SBF CLBATT(,CLB),ATTTRN SET OFF TRANSPARENCY 07370000
L PLTUBA(,PL),XR1 XR1--> TUB 07380000
MVC CLBTBS-2(2,CLB),TUBRCL(,XR1) PUT RECORD LNTH IN 07390000
AIF (&CSIO EQ '1').NP070 07390900
SPACE 1 07391800
******************************************************************* @14 07392200
******* 07392700
CLI CLBDEV(,CLB),DEVSIO SIOC ONLY DEVICE ? 07394500
JE CSBT37 YES 07395400
******* 07397200
******************************************************************* @14 07397600
SPACE 1 07398100
.NP070 ANOP 07399000
L CLBPL@(,CLB),PL XR1--> PL 07400000
TBN PL$OPM(,PL),OPPUT PUT OP AND - 07410000
TBN CLBTBS-4(,CLB),TASTSP TRANSPARENT TUB ? 07420000
JF CSBT06 NO - DON'T SET TRANSPARENCY 07430000
SBN CLBATT(,CLB),ATTTRN SET FOR TRANSPARENT TEXT 07440000
SPACE 1 07450000
CSBT06 EQU * * 07460000
MNN CLBAT1(,CLB),CLBTBS-4(,CLB) SET SPANNED RECORD ATT'S 07470000
SBF CLBAT1(,CLB),ALLBIT-AT1RSU-AT1SRU SET OTHERS OFF 07480000
SPACE 1 07490000
* SET UP THE BLOCK LENGTH 07500000
SPACE 1 07505000
MVC CLBTBS(2,CLB),CLBBFL(,CLB) SET FOR MAX LINE BUFFER 07580000
TBN PL$OPM(,PL),OPGET INPUT OP ? 07590000
JT CSBT30 YES - GO RETURN TO CALLER 07600000
* NOT AN INPUT OP. IF SYSTEM OUTPUT - USE #CCMCL FOR BLOCK SIZE 07610000
* IF IT IS A 3270 TERMINAL - $CC4U0 WILL PUT IN REAL BLOCK SIZE 07620000
MVC CLBTBS(2,CLB),#CCMCL SET FOR SYSTEM OP 07630000
TBN PL$OPC(,PL),OPSYS SYSTEM OP ? 07640000
JF CSBT15 NO - HANDLE USER OP 07650000
SPACE 1 07660000
* IF THIS IS AN ONLINE WRAP TEST SET BLOCK LENGTH TO 256 07670000
SPACE 1 07680000
TBN PLOPM(,PL),OPOLT ONLINE TEST AND - 07690000
L PLRECA(,PL),XR2 XR2--> TEXT 07700000
CLC 1(2,XR2),DEC99 WRAP TEST ? 07710000
L CSSCLB,CLB XR2--> CLB 07720000
JC CSBT30,FLSONE NO - JUMP 07730000
MVC CLBTBS(2,CLB),X0100 MAKE BLOCK LENGTH 256 07740000
J CSBT30 GO RETURN 07750000
SPACE 1 07760000
* MUST BE USER OUTPUT OP. SET BLOCK LENGTH FROM TUB 07770000
CSBT15 EQU * * 07780000
L PLTUBA(,PL),XR1 XR1--> TUB 07790000
MVC CLBTBS(2,CLB),TUBRCL(,XR1) PUT IN RECORD LENGTH 07800000
MVC CLBOWN(1,CLB),TUBBKF(,XR1) PUT IN BLOCK FACTOR 07810000
CSBT20 EQU * * 07820000
SLC CLBOWN(1,CLB),X$0001 SUBTRACT ONE FROM BLOCK FACTOR 07830000
JE CSBT22 IF DONE - CHECK FOR TRUNCATED 07840000
ALC CLBTBS(2,CLB),TUBRCL(,XR1) ADD ANOTHER RECORD LENGTH 07850000
B CSBT20 GO CHECK AGAIN 07860000
CSBT22 EQU * * 07870000
L CLBPL@(,CLB),PL XR1--> PL 07880000
TBF PLOPC(,PL),OPMSG BLOCK OR MSG MODE ? 07890000
JF CSBT24 YES - JUMP 07900000
* RECORD MODE OUTPUT - CHECK FOR EXCEEDING RECORD LENGTH 07910000
SPACE 1 07920000
MVC CLBREL(2,CLB),CLBTBS-2(,CLB) PUT TUB'S REC LENGTH IN 07930000
CLC PLOUTL(2,PL),CLBREL(,CLB) GREATER THAN REC LENGTH ? 07940000
JNH CSBT30 NO - JUMP 07950000
CSBT23 EQU * * 07960000
SBN CLBBA2(,CLB),BA2TRC SET 'TRUNCATED' 07970000
MVI PL$RTC(,PL),RCXDTR SET 'TRUNCATED' RETURN CODE 07980000
J CSBT30 GO RETURN TO CALLER 07990000
* BLOCK OR MESSAGE OUTPUT 08000000
CSBT24 EQU * * 08010000
CLC PLOUTL(2,PL),CLBTBS(,CLB) GREATER THAN BLOCK LENGTH ? 08020000
JNH CSBT30 NO - JUMP 08030000
MVC CLBREL(2,CLB),CLBTBS(,CLB) USE THE BLOCK LENGTH 08040000
B CSBT23 GO SET TRUNCATED 08050000
CSBT30 EQU * * 08060000
L PLTUBA(,PL),XR1 XR1--> TUB 08070000
CSBT35 EQU * * 08080000
MVC CLBBKL(2,CLB),CLBTBS(,CLB) PUT IN BLOCK LENGTH 08090000
CSBT37 EQU * * 08095000
MVC CLBOWN(2,CLB),TUBTCB(,XR1) PUT IN TCB ADDRESS OF OWNER 08100000
L CLBPL@(,CLB),PL XR1--> PL 08110000
CSBT38 LA #,XR2 RESTORE XR2 08120000
CSBT40 B # RETURN TO CALLER 08130000
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S (C S W P G Y)' 08140000
*********************************************************************** 08150000
* * 08160000
* NAME: CSWPGY * 08170000
* * 08180000
* FUNCTION: SET UP A PUT-THEN-GET PL FOR THE GET PORTION OF THE OP * 08190000
* * 08200000
* INPUT: XR1--> PL * 08210000
* XR2--> NO MATTER * 08220000
* * 08230000
* OUTPUT: XR1--> PL * 08240000
* XR2--> RESTORED * 08250000
* * 08260000
*********************************************************************** 08270000
SPACE 1 08280000
CSWPGY EQU * * 08290000
ST CSW040+3,ARR SAVE THE RETURN ADDRESS 08300000
ST CSWXR2+3,XR2 SAVE XR2 08310000
SLC PL$RTC(,PL),PL$RTC(2,PL) ZIP THE RETURN CODE 08320000
SBF PL$OPM(,PL),OPPUT SET OFF THE PUT BIT 08330000
SBN PL$OPM(,PL),OPGET SET ON THE GET BIT 08340000
AIF (&CSIO EQ '1').NP080 08340700
SPACE 1 08341400
******************************************************************* @14 08341700
******* 08342100
* IF A USER SIOC OPERATION, DO NOT FREE THE BUFFER. THE PUT IS DONE 08343500
* FROM THE USER'S BUFFER (NOT FROM TPBUFFER) 08344200
L PLTUBA(,PL),TUB XR2 --> TUB 08344900
TBN TUBAT4(,TUB),TUBPCB SIOC ONLY DEVICE ? 08345600
JT CSW035 YES 08346300
******* 08347000
******************************************************************* @14 08347300
SPACE 1 08347700
.NP080 ANOP 08349100
* IF THIS IS A USER OP - SKIP THE POST 08350000
TBF PLOPM(,PL),OP$SYS USER OP? 08360000
JT CSW030 YES - GO FREE THE RECORD AREA 08370000
* HAVE A SYSTEM PUT-THEN-GET - IF A NO-WAIT OP THEN JUST FREEMAIN 08380000
* THE POST WAS DONE AT NEW REQUEST TIME 08390000
SPACE 1 08400000
TBN PL$OPM(,PL),OPNOW A NO-WAIT OP? 08410000
JT CSW030 YES - GO FREEMAIN 08420000
* SYSTEM PUT-NO-WAIT CHANGED TO A WAIT -JUST POST (DON'T FREEMAIN) 08430000
SBN PL$OPM(,PL),OPNOW MAKE THE INVITE A NO-WAIT OP 08440000
LA PLECB(,PL),XR1 XR1--> ECB 08450000
SVC 0 SUPERVISOR CALL 08460000
DC AL1(PSTRIB) RIB TO POST 08470000
L CSSPL,PL XR1--> PL 08480000
J CSW035 GO RETURN 08490000
CSW030 EQU * * 08500000
CCP MASK,PMR DON'T ALLOW INTERRUPTS 08510000
L PLRECA(,PL),XR2 XR2-->AREA TO FREE 08520000
B CC4FM GO FREE THE RECORD AREA 08530000
CCP UNMASK,PMR ALLOW INTERRUPTS 08540000
CSW035 EQU * * 08550000
MVI PLRECA-1(,PL),NOBIT ZIP THE RECORD AREA 08560000
CSWXR2 LA #,XR2 RESTORE XR2 08570000
CSW040 B # RETURN 08580000
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S (C S C H R Q)' 08590000
*********************************************************************** 08600000
* * 08610000
* NAME: CSCHRQ * 08620000
* * 08630000
* FUNCTION: SEARCH CLBPLQ FOR THE NEXT OP TO PERFORM * 08640000
* * 08650000
* INPUT: XR1--> NO MATTER * 08660000
* XR2--> CLB TO SEARCH * 08670000
* * 08680000
* OUTPUT: XR1--> PL TO USE FOR RESCHEDULE * 08690000
* XR2--> CLB * 08700000
* * 08710000
* EXIT: RETURN TO CALLER IF A PL FOUND TO SCHEDULE * 08720000
* TO CSPSTN IF NONE FOUND TO SCHEDULE * 08730000
* * 08740000
*********************************************************************** 08750000
SPACE 1 08760000
CSCHRQ EQU * * 08770000
ST CSS200+3,ARR SAVE THE RETURN ADDRESS 08780000
SBF CLBATB(,CLB),ATBTIM SET OFF RESCHEDULE IND. 08790000
CLI CLBPLQ-1(,CLB),NOBIT ANY IN THE QUEUE 08800000
BE CSPSTN NO - GO POST AS NECESSARY 08810000
AIF (&CSIO EQ '1').PT130 08810800
AGO .PT140 08810900
.PT130 ANOP 08811000
AIF (&NCPOR).PT150 08811100
.PT140 ANOP 08811200
SPACE 1 08811300
******************************************************************* @14 08811400
******* 08811500
TBN CSSWIT,CSSGET NEED TO DO A GET 08814000
TBN CLBBA3(,CLB),BA3POR PORTLINE OR SIOC DEVICE ? @04 08814800
BT CSS150 YES TO BOTH - DO A GET @04 08815600
******* 08816400
******************************************************************* @14 08816800
.PT150 ANOP 08818800
SPACE 1 08820000
* LOOK FOR A POLL FOR STATUS, CLEAR KEY, OR A PUT FIRST 08830000
* IF NONE OF THE ABOVE - GO TO CSIVGM TO SCHEDULE A READ 08840000
L CLBPLQ(,CLB),PL XR1--> FIRST PL 08850000
CSS010 EQU * * 08860000
TBN PL$OPC(,PL),OPLSNS POLL FOR STATUS OP? 08870000
BT CSS150 YES - GO CALL CSIVGM 08880000
CSS020 EQU * * 08890000
TBN PL$OPC(,PL),OPRFSH CLEAR MSG TO SEND? 08900000
JF CSS025 NO - JUMP 08910000
MNN PL$OPM(,PL),CCPUT MAKE OP A PUT 08920000
B CSS190 GO RETURN TO SCHEDULE (THE RE- 08930000
* SERVED AREA IN $CC4U0 WILL BE 08940000
* USED FOR OUTPUT BUFFER) 08950000
CSS025 EQU * * 08960000
* SCAN THE QUEUE FOR A PUT TO DO 08970000
AIF (&NDF).NP095 08972000
CSS030 EQU * * 08975000
TBN PL$OPM(,PL),OPGETQ OPGETQ ON? @13 08975200
TBF PLOPM(,PL),OPREQR USER ... @13 08975400
TBN PLOPC(,PL),OPPUT ......PUT? @13 08975600
TBN CLBATA(,CLB),CLBDFF DFF SUPPORTED? @13 08975800
L PLTUBA(,PL),TUB GET TUB ADDRESS @13 08976000
TBN TUBTA1(,TUB),TASDFF ...DFF REQUEST? @13 08976200
JF CSS031 NO - JUMP @13 08976400
SPACE 1 08976600
L TUBLCB(,TUB),CLB POINT TO DTF @13 08976800
TBN CLBATA(,CLB),CLBDFB Q-DFF BUFFER BUSY? @13 08977000
JT CSS050 YES-MUST BE ANOTHER DFF PUT @13 08977200
* *ON SAME QUEUE,RESCHEDULE IT @13 08977400
ST CSDQPL,PL SAVE PL ADDRESS @13 08977600
B CSDEQ DEQUEUE THE REQUEST @13 08977800
SBF PL$OPM(,PL),OPGETQ SET OPGETQ OFF @13 08978000
B CSGDFF GO POST DFF @13 08978200
SPACE 08978400
CSS031 EQU * . @13 08978600
.NP095 ANOP 08978800
L PLTUBA(,PL),TUB XR2 --> TUB @13 08979000
TBN PL$OPM(,PL),OPPUT THIS A PUT AND ----------->| @13 08980000
TBF TUBAT3(,TUB),TUBERP NOT IN ERP ? ------------>| 09000000
L TUBLCB(,TUB),CLB XR2-->CLB | 09010000
JT CSS033 YES - GO DO IT <-----------| 09020000
SPACE 1 09030000
* IF THIS IS AN ONLINE WRAP TEST - ALLOW IT 09040000
SPACE 1 09050000
TBN PLOPM(,PL),OPOLT ONLINE TEST AND 09060000
L PLRECA(,PL),XR2 XR2--> TEXT 09070000
CLC 1(2,XR2),DEC99 WRAP TEST ? 09080000
L CSSCLB,CLB XR2--> CLB 09090000
JC CSS050,FLSONE NO - LOOK AT NEXT PL 09100000
CSS033 EQU * 09120000
AIF (&CSIO EQ '1').NP100 09120500
SPACE 1 09120600
******************************************************************* @14 09120700
******* 09121000
CLI CLBDEV(,CLB),DEVSIO SIOC DEVICE ? 09122500
TBN PL$OPM(,PL),OPPUT THIS A PUT ? 09123000
JC CSS034,FLSONE IF NO BOTH 09123500
L PLTUBA(,PL),TUB XR2--> TUB 09124000
L TUBTCB(,TUB),XR2 XR2--> TCB OF OWNER 09124500
MVC PLRECA(2,PL),TCBWK(,XR2) USER BUFFER ADDRESS TO PL 09125000
L CSSCLB,CLB XR2--> CLB 09125500
CSS034 EQU * * 09126000
******* 09126500
******************************************************************* @14 09126700
SPACE 1 09127000
.NP100 ANOP 09128000
* SEE IF A GETMAIN MUST BE DONE NOW 09128500
CLI PLRECA-1(,PL),NOBIT BUFFER ALREADY OBTAINED ? 09130000
JNE CSS190 YES - GO SCHEDULE THIS OP 09140000
* GETMAIN FOR THIS OP - IT CAN ONLY BE A USER PUT-WAIT AT THIS TIME 09150000
SPACE 1 09160000
CSS035 EQU * 09170000
CCP MASK,PMR MASK INTERRUPTS 09180000
LA GMLIST,XR2 XR2--> GM LIST 09190000
MVI 0(,XR2),NOBIT MAKE IT A NO-WAIT REQUEST 09200000
MVC GMSIZE(2,XR2),PLOUTL(,PL) PUT IN SIZE TO GETMAIN 09210000
ALC GMSIZE(2,XR2),X$0004 ADD 4 FOR THE GETMAIN PL 09220000
AIF (&NCPOR).PT160 09220600
SPACE 1 09221200
******************************************************************* @14 09221800
******* 09222400
L CSSCLB,CLB XR2 --> CLB 09223000
TBN CLBBA3(,CLB),BA3PON IS THIS A PORTLINE ONLY DEVICE ? 09223600
LA GMLIST,XR2 XR2 --> GM LIST 09224200
JF CSS036 NO - CONTINUE 09224800
ALC GMSIZE(2,XR2),X$0003 INCREMENT THE SIZE BY THREE 09225400
CSS036 EQU * * 09226000
******* 09226600
******************************************************************* @14 09227200
SPACE 1 09227800
.PT160 ANOP 09228400
CLC #GMS+1,GMSIZE(2,XR2) ENOUGH TPBUF FOR THIS GUY? 09230000
JL CSS040 NO - MAKE THIS GUY WAIT 09240000
SBN $FLGC,#PUTTP SET TO GETMAIN FROM ANYWHERE 09250000
B CSGMRQ GO DO THE GETMAIN 09260000
AIF (&NCPOR).PT170 09260700
SPACE 1 09261400
******************************************************************* @14 09262100
******* 09262800
L CSSCLB,CLB XR2 --> CLB 09263500
TBN CLBBA3(,CLB),BA3PON IS THIS A PORTLINE ONLY DEVICE ? 09264200
JF CSS037 NO - CONTINUE 09264900
ALC GMLIST+GMADDR(2),X$0003 INCREMENT THE ADDR BY THREE 09265600
CSS037 EQU * * 09266300
******* 09267000
******************************************************************* @14 09267700
.PT170 ANOP 09268400
SPACE 1 09270000
B CSQMOV GO MOVE TEXT TO TPBUF 09280000
CCP UNMASK,PMR ALLOW INTERRUPTS 09290000
AIF (&NCPOR).PT180 09290400
SPACE 1 09290800
******************************************************************* @14 09291200
******* 09291600
TBN CLBBA3(,CLB),BA3PON IS THIS A PORTLINE ONLY DEVICE ? 09292000
JF CSS039 NO - CONTINUE 09292400
SLC PLRECA(2,PL),X$0003 DECREMENT THE ADDR BY THREE 09292800
ALC PLOUTL(2,PL),X$0003 ADD 3 TO THE OUTPUT LENGTH 09293200
ST CSSPL,PL SAVE THE PARAMETER LIST 09293600
L PLRECA(,PL),XR2 XR2 --> RECORD AREA 09294000
L PLTUBA(,PL),XR1 XR1 --> TUB 09294400
MVC 0(1,XR2),TUBID(,XR1) MOVE THE PORT ID INTO THE BUFFER 09294800
L CSSPL,PL RESTORE THE PL REGISTER 09295200
TBN PLOPC(,PL),OPPCR IS THIS A PORT COMMAND REQUEST ? 09295600
JF CSS038 NO - CONTINUE 09296000
SBN 0(,XR2),TPXCMD SET ON THE COMMAND BIT 09296400
CSS038 EQU * 09296800
MVC 2(2,XR2),PLOUTL(,PL) MOVE THE OUTPUT LENGTH TO BUFFER 09297200
CSS039 EQU * * 09297600
******* 09298000
******************************************************************* @14 09298400
SPACE 1 09298800
.PT180 ANOP 09299200
L PLTUBA(,PL),TUB XR2--> TUB 09300000
L TUBLCB(,TUB),CLB XR2--> CLB 09310000
J CSS190 GO SCHEDULE THIS OP 09320000
SPACE 2 09330000
CSS040 EQU * * 09340000
B CSDEQ DEQUE FROM CLBPLQ 09350000
MVC CSTMPL,PLCHN(2,PL) SAVE CHAIN POINTER 09360000
B CSWCRQ GO MARK IT AS WAITING 09370000
LA CSTMPL-1,PL POINT AT SAVED ***PL*** 09380000
CCP UNMASK,PMR ALLOW INTERRUPTS 09390000
SPACE 1 09400000
* LOOK AT THE NEXT PL IN THE QUEUE 09410000
CSS050 EQU * * 09420000
CLI PLCHN-1(,PL),NOBIT ANY MORE PL'S ? 09430000
L CSSCLB,CLB XR2--> CLB 09440000
L PLCHN(,PL),PL XR1--> NEXT PL 09450000
BNE CSS020 YES - GO LOOK AT IT 09460000
* AT THE END OF THE QUEUE - TRY TO GET A READ GOING 09470000
CSS150 EQU * * 09480000
B CSIVGM TRY TO GETMAIN FOR ANY READS 09490000
TBN CSSWIT,CSRESH OK TO RESCHEDULE ? 09500000
SBF CSSWIT,CSRESH SET IT OFF 09510000
BF CSPSTN NO - GO POST (IF NECESSARY) 09520000
* OK TO SCHEDULE A READ - XR1--> PL TO USE 09530000
CSS190 EQU * * 09540000
ST CLBPL@(,CLB),PL PUT PL ADDRESS IN CLB 09550000
ST CSSPL,PL SAVE THE PL ADDRESS 09560000
CSS200 B # RETURN TO SCHEDULE 09570000
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S (C S I V G M)' 09580000
*********************************************************************** 09590000
* * 09600000
* * 09610000
* NAME: CSIVGM * 09620000
* * 09630000
* FUNCTION: GETMAIN FOR AN INPUT BUFFER FROM TPBUFFER. * 09640000
* IF POLL FOR STATUS OP THEN: * 09650000
* SAVE THE POLL LOOP COUNT * 09660000
* SET POLL LOOP COUNT TO 4 * 09670000
* DON'T DO A GETMAIN (RESERVED AREA IN $CC4U0 WILL BE * 09680000
* USED) * 09690000
* IF ONLY 3270'S IN THE QUEUE THEN: * 09700000
* FORCE OUTBOARD POLLING * 09710000
* IF NOT ENOUGH TP BUFFER FOR A PL THEN * 09720000
* DEQUE IT FROM CLBPLQ * 09730000
* QUEUE IT ON CLBWCQ * 09740000
* IF THERE ARE NO INPUT OP'S IN THE QUEUE THEN * 09750000
* DON'T SET 'OK TO SCHEDULE' INDICATOR ON * 09760000
* * 09770000
* INPUT: XR1--> NO MATTER * 09780000
* XR2--> CLB TO SCHEDULE * 09790000
* * 09800000
* OUTPUT: XR1--> PL TO USE FOR RESCHEDULE * 09810000
* XR2--> CLB TO RESCHEDULE * 09820000
* * 09830000
* NOTE: MUST REMAIN MASKED UNTIL EXIT OF THIS SUBROUTINE. * 09840000
* * 09850000
*********************************************************************** 09860000
SPACE 1 09870000
CSIVGM EQU * * 09880000
ST CSIRET+3,ARR SAVE THE RETURN ADDRESS 09890000
CCP MASK,PMR DON'T ALLOW INTERRUPTS 09900000
L @CMTCB,XR1 XR1 CM TCB 09902000
SBN TCBDS1(,XR1),X'80' MAKE CM-NON DISPATCABLE 09904000
CCP UNMASK,PMR ALLOW INTERRUPTS 09906000
SBN CLBBA2(,CLB),BA2POP FORCE OUTBOARD POLLING 09910000
SBF CSSWIT,CSRESH SET 'OK TO SCHEDULE' OFF 09920000
SLC GMLIST+GMSIZE(4),GMLIST+GMSIZE ZIP GETMAIN SIZE 09930000
AIF (&CSIO EQ '1').PT190 09930900
AGO .PT200 09931000
.PT190 ANOP 09931100
AIF (&NCPOR).PT210 09931200
.PT200 ANOP 09931300
SPACE 1 09931800
******************************************************************* @14 09932200
******* 09932700
TBN CLBBA3(,CLB),BA3POR PORTLINE OR SIOC DEVICE ? 09934500
JT CSINMR YES,SKIP POLL CODE 09935400
******* 09937200
******************************************************************* @14 09937600
.PT210 ANOP 09939000
SPACE 1 09939500
* SET ON ALL SKIP BITS FOR THIS LINE 09940000
L CLBPOL(,CLB),XR1 XR1--> POLL LIST 09950000
CSIALL EQU * * 09960000
CLI POLID(,XR1),POLEND END OF LIST ? 09970000
JNL CSINMR YES - EXIT THIS LOOP 09980000
MVC CSISTS+2,POLLTH(1,XR1) SET LA INST. TO BUMP TO STATUS 09990000
CSISTS LA #(,XR1),XR1 XR1--> 3 BEFORE STATUS BYTE 10000000
SBN POLSTS(,XR1),POLSKP SET THE SKIP BIT ON 10010000
LA POLNXT(,XR1),XR1 XR1--> NEXT ENTRY 10020000
B CSIALL GO CHECK NEXT ENTRY 10030000
SPACE 1 10040000
* FREE THE CURRENT INPUT BUFFER (IF THERE IS ONE) 10050000
CSINMR EQU * * 10060000
CLI CLBIBA-1(,CLB),NOBIT ANY TO FREE ? 10070000
JE CSICRD NO - SKIP THE FREEMAIN 10080000
* FREE CLBIBA 10090000
L CLBIBA(,CLB),XR2 XR2--> INPUT BUFFER 10100000
CCP MASK,PMR DONT ALLOW INTERRUPTS 10105000
B CC4FM GO FREE IT 10110000
CCP UNMASK,PMR ALLOW INTERRUPTS 10115000
L CSSCLB,CLB XR2--> CLB 10120000
MVI CLBIBA-1(,CLB),NOBIT ZIP THE POINTER 10130000
* SEE IF WE CAN DO A READ NOW 10140000
CSICRD EQU * * 10150000
CLI CLBPLQ-1(,CLB),NOBIT IS THE QUEUE EMPTY? 10160000
BE CSIMYB YES - RETURN TO CALLER @10 10170000
L CLBPLQ(,CLB),PL XR1 --> FIRST PL ON THE QUEUE 10180000
* SET UP POLL FOR STATUS IF APPLICABLE 10190000
TBN PL$OPC(,PL),OPLSNS POLL FOR STATUS OP ? 10200000
JF CSINST NO - JUMP 10210000
SPACE 1 10220000
* SET UP FOR A POLL FOR STATUS OPERATION 10230000
MVC CLBPLC(1,CLB),CLBCNT(,CLB) SAVE THE CURRENT POLL LOOP CNT 10240000
SBN CLBBA3(,CLB),BA3STS SET TO POLL FOR STATUS 10250000
MVC CLBCNT(1,CLB),X$0004 SET P LOOP COUNT TO 4 10260000
L PLTUBA(,PL),TUB XR2 --> TUB 10270000
B CSKPST SET OFF THE SKIP BIT 10280000
L TUBLCB(,TUB),CLB XR2 --> CLB 10290000
ST CSIPL+3,PL STORE PL ADDRESS TO RESTORE 10300000
J CSIEXT GO RETURN TO SCHEDULE THIS OP 10310000
SPACE 2 10320000
* SET UP THE INPUT BUFFER FOR ANY READS 10330000
SPACE 1 10340000
CSINST EQU * * 10350000
TBN PL$OPM(,PL),OPGET INPUT OP AND -----| 10360000
L PLTUBA(,PL),TUB XR2--> TUB | 10370000
TBF TUBAT3(,TUB),TUBERP NOT IN ERP ? <----| 10380000
L TUBLCB(,TUB),CLB XR2--> CLB 10390000
JF CSINXT NO - LOOK AT NEXT PL 10400000
SPACE 1 10410000
* HAVE A VALID INPUT OP - SEE IF ENOUGH TPBUFF IS AVAILABLE 10420000
SPACE 1 10430000
TBN PL$OPC(,PL),OPSYS SYSTEM OP? 10440000
JF CSIUSR NO - JUMP 10450000
L PLTUBA(,PL),TUB XR2--> TUB 10460000
MVC PLINL(2,PL),TUBPIL(,TUB) PUT PRUF LENGTH IN 10470000
TBN TUBSCS(,TUB),TUBRUF PRUF ACTIVE ? 10480000
L TUBLCB(,TUB),CLB XR2--> CLB 10490000
JT CSIUSR YES- GO SEE IF ENOUGH AVAILABLE 10500000
MVC PLINL(2,PL),#CCMCL NO PRUF - USE MAX CMD LENGTH 10510000
SPACE 10520000
CSIUSR EQU * * 10530000
AIF (&CSIO EQ '1').PT220 10530700
AGO .PT230 10530780
.PT220 ANOP 10530860
AIF (&NCPOR).PT240 10530940
.PT230 ANOP 10531020
SPACE 1 10531100
******************************************************************* @14 10531180
******* 10531260
TBN CLBBA3(,CLB),BA3POR PORTLINE OR SIOC DEVICE ? 10533500
JF CSINPT NO 10534200
B CSHPSI FILL IN GETMAIN LENGTH 10534900
J CSIYPT SKIP NEXT INSTRUCTION IF PORT 10535600
CSINPT EQU * * 10536300
******* 10537000
******************************************************************* @14 10537300
SPACE 1 10537700
.PT240 ANOP 10539100
MVC CSTPBF,PLINL(2,PL) MOVE IN SIZE TO GETMAIN 10540000
CSIYPT EQU * * 10545000
ALC CSTPBF(2),X$0004 ADD 4 FOR GETMAIN PL LENGTH 10550000
CLC CSTPBF(2),#ANYS+1 ENOUGH FOR THIS GUY? 10560000
JNH CSIMHI YES - JUMP 10570000
SPACE 1 10580000
* MAKE THIS GUY WAIT FOR TP BUFFER 10590000
B CSDEQ REMOVE THIS PL FROM CLBPLQ 10600000
MVC CSTMPL,PLCHN(2,PL) SAVE CHAIN POINTER 10610000
B CSWCRQ PUT IT ON CLBWCQ 10620000
LA CSTMPL-1,PL POINT AT SAVED ***PL*** 10630000
J CSINXT LOOK AT NEXT PL 10640000
CSIMHI EQU * * 10650000
* SET THE SKIP BITS OFF FOR THIS POLL ENTRY 10660000
L PLTUBA(,PL),TUB XR2--> TUB 10670000
CLI TUBPHY(,TUB),TUB5M2 THIS A 3270 TYPE TERM ? 10680000
JNH CSI327 YES - JUMP @10 10690000
L TUBLCB(,TUB),CLB XR2--> CLB 10700000
SBF CLBBA2(,CLB),BA2POP SET OFF OUTBOARD POLLING 10710000
AIF (&CSIO EQ '1').PT250 10710800
AGO .PT260 10710900
.PT250 ANOP 10711000
AIF (&NCPOR).PT270 10711100
.PT260 ANOP 10711200
SPACE 1 10711300
******************************************************************* @14 10711400
******* 10711500
TBN CLBBA3(,CLB),BA3POR PORTLINE OR SIOC DEVICE ? 10714000
JT CSGMTS YES,SKIP 'SKIP BIT' SETTING 10714800
******* 10715600
******************************************************************* @14 10716000
SPACE 1 10716400
.PT270 ANOP 10718000
J CSIFRC SET OFF THE SKIP BITS @10 10718800
CSI327 EQU * @10 10721000
L TUBLCB(,TUB),CLB XR2 --> CLB @10 10722000
CLC CLBBFL(2,CLB),X$012C IS THE BLKL < 300 ? @10 10723000
JNL CSIFRC NO - PERFORM OUTBOARD POLL @10 10724000
SBF CLBBA2(,CLB),BA2POP YES - CAN NOT OUTBOARD POLL @10 10725000
CSIFRC EQU * * 10730000
L PLTUBA(,PL),TUB XR2--> TUB @10 10735000
B CSKPST GO SET THE SKIP BITS OFF 10740000
L TUBLCB(,TUB),CLB XR2--> CLB 10750000
* USE THIS LENGTH IF IT IS LARGER THAN PREVIOUS LENGTHS 10760000
CSGMTS EQU * * 10765000
CLC GMLIST+GMSIZE(2),CSTPBF THIS PL NEED MORE THAN LAST PL? 10770000
ST CSIPL+3,PL SAVE THIS PL ADDRESS 10780000
JNL CSINXT NO - JUMP 10790000
MVC GMLIST+GMSIZE(2),CSTPBF MAKE THIS ONE BIGGEST 10800000
SPACE 1 10810000
* CONTINUE WITH NEXT PL 10820000
CSINXT EQU * * 10830000
CLI PLCHN-1(,PL),NOBIT END OF THE QUEUE? 10840000
L PLCHN(,PL),PL XR1--> NEXT PL 10850000
BNE CSINST NO - GO LOOK AT NEXT PL 10860000
SPACE 1 10870000
* END OF THE QUEUE - SEE IF WE FOUND ONE TO SCHEDULE 10880000
SPACE 1 10890000
CLC GMLIST+GMSIZE(2),X$0000 DID WE FIND ONE TO SCHEDULE? 10900000
JE CSIUNM NO - GO EXIT 10910000
* GETMAIN FOR THIS LINE 10920000
B CSGMRQ GO TO THE GETMAIN INTERFACE 10930000
L CSSCLB,CLB XR2--> CLB 10940000
MVC CLBIBA(2,CLB),GMLIST+GMADDR PUT ADDRESS IN CLB 10950000
ALC CLBIBA(2,CLB),X$0004 BUMP TO DATA AREA 10960000
MVC CLBIBL(2,CLB),GMLIST+GMSIZE MOVE GETAMAIN LENGTH INTO IBL 10970000
SLC CLBIBL(2,CLB),X$0004 DECREMENT TO REQUESTED LENGTH 10980000
CSIEXT EQU * * 10990000
SBN CSSWIT,CSRESH SET ' OK TO SCHEDULE' IND 11000000
CSIUNM EQU * * 11010000
* SET TO FORCE INTERVAL POLLING IF SPECIFIED 11020000
TBN CLBAT3(,CLB),AT3OUT OUTBOARD POLL ALWAYS ? 11030000
JF CSIMYB NO - LEAVE IT AS SET 11040000
SBN CLBBA2(,CLB),BA2POP FORCE OUTBOARD POLLING 11050000
CSIMYB EQU * * 11060000
CCP MASK,PMR DONT ALLOW INTERRUPTS 11060500
L @CMTCB,XR2 XR2 GETS CM'S TCB 11061000
L TCBRBP(,XR2),XR2 XR2 GETS CM'S RB 11061500
TBN 2(,XR2),X'80' IS THE WAITING BIT ON? 11062000
L @CMTCB,XR2 XR2 GETS CM'S TCB 11062500
JT CSIRES YES CM IS STILL WAITING 11063000
ST X'002C',XR2 MAKE CM NEXT TASK DISPACHED 11063500
SBF TCBDS1(,XR2),X'80' MAKE CM DISPATCHABLE 11064000
L @CSTCB,XR2 CS'S TCB @ 11064500
L TCBRBP(,XR2),XR2 XR2 CS RB 11065000
MVC 7(2,XR2),CSINDD MOVE IN RETURN @ 11065500
L X'0041',IAR BRANCH TO DISPATCHER 11066000
CSININ EQU * 11066500
JC CSIJMP,X'97' RESET CONDITION REGISTER 11067000
CSIRES EQU * 11067500
SBF TCBDS1(,XR2),X'80' MAKE CM DISPATCHABLE 11068000
CSIJMP EQU * 11068500
L CSSCLB,XR2 XR2 GETS CLB @ 11069000
CSIPL LA #,PL XR1--> PL TO USE FOR SCHEDULE 11070000
CCP UNMASK,PMR ALLOW INTERRUPTS 11080000
CSIRET B # RETURN 11090000
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S (C S K P S T)' 11100000
*********************************************************************** 11110000
* * 11120000
* * 11130000
* NAME: CSKPST * 11140000
* * 11150000
* FUNCTION: SET THE SKIP BITS OFF IN THE POLL LIST FOR THE RE- * 11160000
* QUESTED TUB. * 11170000
* * 11180000
* INPUT: XR1--> PL * 11190000
* XR2--> TUB * 11200000
* * 11210000
* OUTPUT: XR1--> RESTORED * 11220000
* XR2--> RESTORED * 11230000
* * 11240000
*********************************************************************** 11250000
SPACE 2 11260000
CSKPST EQU * * 11270000
ST CSKARR+3,ARR SAVE THE RETURN ADDRESS 11280000
ST CSKXR1+3,XR1 SAVE XR1 11290000
L TUBLCB(,TUB),XR1 XR1--> CLB 11300000
L CLBPOL(,XR1),XR1 XR1--> POLL LIST 11310000
CSKAGN EQU * * 11320000
CLI POLID(,XR1),POLEND END OF LIST ? 11330000
JNL CSKEXT YES - GO RETURN 11340000
CLC POLID(,XR1),TUBSID(1,TUB) THIS THE ENTRY ? 11350000
MVC CSKBMP+2,POLLTH(1,XR1) SET UP TO BUMP TO STATUS BYTE 11360000
CSKBMP LA #(,XR1),XR1 POINT 3 BYTES BEFORE STATUS 11370000
JNE CSKNXT NOT THE ENTRY - JUMP 11380000
SBF POLSTS(,XR1),POLSKP SET THE SKIP BIT OFF 11390000
CSKNXT EQU * * 11400000
LA POLNXT(,XR1),XR1 XR1--> NEXT ENTRY 11410000
B CSKAGN GO LOOK FOR A DUP 11420000
CSKEXT EQU * * 11430000
CSKXR1 LA #,XR1 RESTORE XR1 11440000
CSKARR B # RETURN TO CALLER 11450000
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S (C S X L A T)' 11460000
*********************************************************************** 11470000
* * 11480000
* NAME: CSXLAT * 11490000
* * 11500000
* FUNCTION: TRANSLATE THE TEXT TO EBCDIC AND/OR UPPER CASE * 11510000
* * 11520000
* INPUT: XR1--> PL * 11530000
* XR2--> NO MATTER * 11540000
* * 11550000
* OUTPUT: XR1--> PL * 11560000
* XR2--> RESTORED * 11570000
* TEXT IN TP BUFFER TRANSLATED TO EBCDIC OR UPPER CASE * 11580000
* * 11590000
*********************************************************************** 11600000
SPACE 2 11610000
CSXLAT EQU * * 11620000
ST CSXARR+3,ARR SAVE THE ARR 11630000
ST CSXXR2+3,XR2 SAVE XR2 11640000
AIF (&CACI).A0200 NO ASCII SUPPORT. 11650000
* TRANSLATE TO EBCDIC FIRST (IF THIS IS AN ASCII LINE) 11660000
L PLTUBA(,PL),TUB XR2--> TUB 11670000
L TUBLCB(,TUB),CLB XR2--> CLB 11680000
TBN CLBATT(,CLB),ATTCOD THIS AN ASCII LINE? 11690000
JF CSXNAS NO - JUMP 11700000
* CALL THE TRANSLATE TRANSIENT TO TRANSLATE FROM ASCII TO EBCDIC 11710000
B CC4TA CALL TRANSIENT AREA HANDLER 11720000
DC AL1(CC4UK) TRANSLATE TRANSIENT ID ($CC4UK) 11730000
SPACE 2 11740000
.A0200 ANOP * 11750000
* TRANSLATE THE TEXT TO UPPER CASE IF SYSTEM REQUEST OR IF 11760000
* THE USER SPECIFIED UPPER CASE 11770000
CSXNAS EQU * * 11780000
L PLTUBA(,PL),TUB XR2--> TUB 11790000
TBN PL$OPC(,PL),OPSYS SYSTEM OPERATION? 11800000
JT CSXEXT YES - DO NOT UPPER CASE @05 11810000
SPACE 1 11820000
TBN TUBTA1(,TUB),TASCAS FORCE UPPER CASE? (ON = NO) 11830000
JT CSXEXT NO - RETURN TO CALLER 11840000
SPACE 1 11850000
* FORCE THE INPUT TO UPPER CASE 11860000
CSXUPC EQU * * 11870000
MVC CSXCNT,PLEFFL(2,PL) USE EFFL FOR THE LENGTH 11880000
L PLRECA(,PL),XR2 XR2--> TEXT 11890000
CSXBMP EQU * * 11900000
CLC CSXCNT(2),X$0000 COUNT NOW ZIP ? 11910000
JE CSXEXT YES - GO RETURN TO CALLER 11920000
CLI 0(,XR2),X'40' X'40' OR HIGHER ? 11930000
JL CSXNXT NO - JUMP 11940000
SBN 0(,XR2),X'40' SET IT TO UPPER CASE 11950000
CSXNXT EQU * * 11960000
SLC CSXCNT(2),X$0001 DECREMENT THE COUNT BY ONE 11970000
LA 1(,XR2),XR2 BUMP TO NEXT CHARACTER 11980000
B CSXBMP GO LOOK AT NEXT CHARACTER 11990000
CSXEXT EQU * * 12000000
CSXXR2 LA #,XR2 RESTORE XR2 12010000
CSXARR B # RETURN TO CALLER 12020000
CSXCNT DC XL2'0' SCRATCH AREA FOR COUNT 12030000
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S (C S Q M O V)' 12040000
*********************************************************************** 12050000
* * 12060000
* NAME: CSQMOV * 12070000
* * 12080000
* FUNCTION: MOVE DATA TO TP BUFFER FROM USER PROGRAM AREA OR FROM * 12090000
* SYSTEM AREA (TRANSIENT AREA) * 12100000
* * 12110000
* INPUT: XR1--> PL * 12120000
* XR2--> NO MATTER * 12130000
* * 12140000
* OUTPUT: XR1--> PL * 12150000
* XR2--> RESTORED * 12160000
* DATA MOVED TO TP BUFFER * 12170000
* * 12180000
* EXIT: RETURN TO CALLER * 12190000
* * 12200000
* * 12210000
*********************************************************************** 12220000
SPACE 2 12230000
CSQMOV EQU * * 12240000
CCP MASK,PMR MASK INTERRUPTS 12250000
ST MOVARR+3,ARR SAVE THE RETURN ADDRESS 12260000
ST MOVXR2+3,XR2 SAVE XR2 12270000
MVI CS#MVL+MVLTYP,NOBIT MAKE IT A SYSTEM REQUEST 12280000
MVC CS#MVL+MVLFRA,PLRECA(2,PL) PUT FROM ADDR. IN MOVE LIST 12290000
TBN PLOPM(,PL),OP$SYS SYSTEM OP? 12300000
L PLTUBA(,PL),TUB XR2--> TUB 12310000
JT MOVMOV YES - GO PERFORM THE MOVE 12320000
SPACE 1 12330000
* HAVE A USER PL - SET SO MOVE ROUTINE WILL SWAP ATR'S 12340000
MVI CS#MVL+MVLTYP,SWAPFR FROM ADDR. IS IN UPA 12350000
L TUBTCB(,TUB),XR2 XR2--> TCB OF OWNER 12360000
MVC CS#MVL+MVLFRA,TCBWK(2,XR2) FROM ADDR. IS IN UPA 12370000
L PLTUBA(,PL),TUB XR2--> TUB 12380000
MOVMOV EQU * * 12390000
MVC PLRECA(2,PL),GMLIST+GMADDR GETMAINED ADDR. INTO PL 12400000
ALC PLRECA(2,PL),X$0004 ADD 4 TO GET RECORD ADDR. 12410000
MVC CS#MVL+MVLTOA,PLRECA(2,PL) TO ADDR IS TPBUFFER 12420000
MVC CS#MVL+MVLTOL,PLOUTL(2,PL) LENGTH IS PLOUTL (TO LENGTH) 12430000
MVC CS#MVL+MVLFRL,PLOUTL(2,PL) LENGTH IS PLOUTL (FROM LENGTH) 12440000
MVC CS#MVL+MVLTCB,TUBTCB(2,TUB) TCB ADDR. OF OWNER IN MOVE PL 12450000
LA CS#MVL,XR2 XR2--> MOVE LIST 12460000
B CC4MX GO TO THE MOVE ROUTINE 12470000
MOVXR2 LA #,XR2 RESTORE XR2 12480000
CCP UNMASK,PMR ALLOW INTERRUPTS 12490000
MOVARR B # RETURN TO CALLER 12500000
AIF (&CSIO EQ '1').PT280 12500050
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S (C S W A T E)' 12500250
*********************************************************************** 12500300
* * 12500350
* NAME: CSWATE * 12500400
* * 12500450
* FUNCTION: GO TO BSCC OR PORT WAIT ROUTINE * 12500500
* * 12500550
* INPUT: XR1--> PL * 12500600
* XR2--> CLB * 12500650
* * 12500700
* OUTPUT: XR1--> SAME * 12500750
* XR2--> SAME * 12500800
* * 12500850
* EXIT: RETURN TO CALLER * 12500900
* * 12500950
* * 12501000
*********************************************************************** 12501050
CSWATE ST CSWARR+3,ARR SAVE RETURN ADDRESS 12501100
CLI CLBDEV(,CLB),DEVSIO PORT DEVICE 12501150
JE CSWPWT YES,SKIP BSCC WAIT 12501200
B YMWAIT GO TO BSCC WAIT 12501250
J CSWARR RETURN TO CALLER 12501300
CSWPWT B CSENCK GO TO SIOC WAIT ROUTINE 12501350
ALC CTR5(3),X$0001 +1 TO NUMBER OF OUTPUT OPENDS 12501400
* A 34 RETURN CODE FROM DATA MANAGEMENT MEANS THE SAME AS A 40. 12501450
* THE 34 RETURN IS USED BY BATCH PROCESSING(SUBR17). 12501500
CLI CLBCMP(,CLB),CMPTUC DATA TRUNCATED RETURN CODE 12501550
JNE CSWARR NO 12501600
MVI CLBCMP(,CLB),CMPEND SET TO 40 RETURN CODE 12501650
CSWARR B # RETURN TO CALLER 12501700
.PT280 ANOP 12501720
AIF (&CSIO EQ '1').PT290 12501758
AGO .PT300 12501766
.PT290 ANOP 12501774
AIF (&NCPOR).PT310 12501782
.PT300 ANOP 12501790
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S (C S Y Q D T)' 12501800
*********************************************************************** 12501850
* * 12501900
* NAME: CSYQDT * 12501950
* * 12502000
* FUNCTION: PORT INPUT DATA THAT DOES NOT HAVE A USER PARM LIST * 12502050
* IS PUT ON A QUEUE THAT STARTS IN TUB (TUBDCH) * 12502100
* EACH BLOCK IS Q'D UNTIL THE USER REQUESTS THE DATA OR * 12502150
* UNTIL THE DATA IS PURGED * 12502200
* * 12502250
* INPUT: XR1--> PL * 12502300
* XR2--> NO MATTER * 12502350
* * 12502400
* OUTPUT: XR1--> SAME * 12502450
* XR2--> RESTORED * 12502500
* * 12502550
* EXIT: RETURN TO CALLER * 12502600
* * 12502650
* * 12502700
*********************************************************************** 12502750
CSYQDT ST CSYARR+3,ARR SAVE RETURN ADDRESS 12502800
ST CSYXR2+3,XR2 SAVE XR2 12502850
L PLTUBA(,PL),TUB XR2--> TUB 12502900
LA TUBDCH-TPXCHN(,TUB),XR2 XR2--> DATA Q IN TUB 12502950
CSYNXT CLI TPXCHN-1(,XR2),NOBIT END OF Q 12503000
JE CSYQIT YES, PUT NEW ENTRY ON Q 12503050
L TPXCHN(,XR2),XR2 XR2--> NEXT ENTRY ON Q 12503100
A BCKREG,XR2 * 12503150
B CSYNXT TRY FOR END OF Q 12503200
CSYQIT MVC TPXCHN(2,XR2),PLRECA(,PL) CHAIN IN TPBUFF DATA 12503250
L TPXCHN(,XR2),XR2 XR2 --> NEW DATA IN TPBUFF 12503300
A BCKREG,XR2 XR2 --> START OF TPBUFF AREA 12503350
MVC TPXRTC(2,XR2),PL$RTC(,PL) RETURN CODE TO TPBUFF SAVE AREA 12503400
CSYXR2 LA #,XR2 RESTORE XR2 12503450
CSYARR B # RETURN TO CALLER 12503500
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S (C S Z U D T)' 12503600
*********************************************************************** 12503650
* * 12503700
* NAME: CSZUDT * 12503750
* * 12503800
* FUNCTION: TAKE A MSG MODE MSG OF DATA OFF THE PORT INPUT DATA Q. * 12503850
* EACH TIME THE USER REQUEST'S DATA THRU A PARM LIST, * 12503900
* THIS MODULE WILL GIVE HIM 1 OF THESE BLOCKS. ALSO WILL PUT * 12503950
* THE DATA ADDRESS INTO PLRECA * 12504000
* * 12504050
* INPUT: XR1--> PL * 12504100
* XR2--> NO MATTER * 12504150
* * 12504200
* OUTPUT: XR1--> PL * 12504250
* XR2--> RESTORED * 12504300
* * 12504350
* EXIT: RETURN TO CALLER * 12504400
* * 12504450
* * 12504500
*********************************************************************** 12504550
CSZUDT ST CSZARR+3,ARR SAVE RETURN ADDRESS 12504600
ST CSZXR1+3,XR1 SAVE XR1 12504650
ST CSZXR2+3,XR2 SAVE XR2 12504700
L PLTUBA(,PL),TUB XR2--> TUB 12504750
MVC PLRECA(2,PL),TUBDCH(,TUB) DATA ADDRESS INTO PL 12504800
L TUBDCH(,TUB),XR2 XR2--> FIRST DATA BLOCK 12504850
A BCKREG,XR2 * 12504900
MVC PL$RTC(2,PL),TPXRTC(,XR2) USER RETURN CODE TO PL 12504950
MVC PLEFFL(2,PL),TPXDLN(,XR2) EFFECTIVE INPUT LENGTH TO PL 12505000
TBN PLOPM(,PL),OP$SYS SYSTEM OPCODE 12505050
JF CSZUSR NO 12505100
MVC PLINL(2,PL),TPXFRL(,XR2) LENGTH GETMAIN AREA 12505150
SLC PLINL(2,PL),X$0004 -4 FOR 1 GET/FREE PARM 12505200
J CSZCHN GO SET CHAIN ADDRESS 12505250
CSZUSR EQU * * 12505300
TBN TPXPID(,XR2),TPXCMD COMMAND DATA 12505350
JF CSZCHK NO 12505400
SBN CSSWIT,CSSCMD INDICATE COMMAND DATA TO USER 12505450
J CSZXR1 RETURN TO CALLER 12505500
CSZCHK EQU * * 12505550
CLC PLEFFL(2,PL),PLINL(,PL) CHECK IF TOO MUCH DATA 12505600
JNH CSZCHN NO 12505650
SBN PL$RTC(,PL),RCXDTR SET DATA TRUNCATED RETURN CODE 12505700
MVC PLEFFL(2,PL),PLINL(,PL) MAX INPUT FOR THIS USER 12505750
CSZCHN EQU * * 12505800
L PLTUBA(,PL),XR1 XR1--> TUB 12505850
* THIS WILL PUT ZERO'S IN TUBDCH, IF NO MORE ON CHAIN 12505900
MVC TUBDCH(2,XR1),TPXCHN(,XR2) CHAIN ADDRESS(IF PRESENT)TO TUB 12505950
CSZXR1 LA #,XR1 RESTORE XR1 12506000
CSZXR2 LA #,XR2 RESTORE XR2 12506050
CSZARR B # RETURN TO CALLER 12506100
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S (C S H P S I)' 12506200
*********************************************************************** 12506250
* * 12506300
* NAME: CSHPSI * 12506350
* * 12506400
* FUNCTION: FILL IN PLINL VALUE FOR PORT SYSTEM GETS * 12506450
* * 12506500
* INPUT: XR1--> PL * 12506550
* XR2--> CLB * 12506600
* * 12506650
* OUTPUT: XR1--> PL * 12506700
* XR2--> CLB * 12506750
* * 12506800
* EXIT: RETURN TO CALLER * 12506850
* * 12506900
* * 12506950
*********************************************************************** 12507000
CSHPSI ST CSHARR+3,ARR SAVE RETURN ADDRESS 12507050
MVI CSTPBF-1,NOBIT CLEAR FIRST BYTE 12507100
MVC CSTPBF(1),#PCTLN MAX PCT LENGTH 12507150
ALC CSTPBF,CLBMCL(2,CLB) ADD MAX MESSAGE LENGTH 12507200
ALC CSTPBF(2),LNTHCC LENGTH OF CONTROL INFORMATION 12507250
TBN PL$OPC(,PL),OPSYS SYSTEM OP 12507300
JF CSHARR NO, DO NOT CHANGE USER PLINL 12507350
MVC PLINL(2,PL),CSTPBF SETUP SYSTEM OP PLINL 12507400
CSHARR B # RETURN TO CALLER 12507450
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S ' 12507550
*********************************************************************** 12507600
* CONSTANTS AND MISCELLANEOUS EQUATES FOR PORT MANAGER * 12507650
*********************************************************************** 12507700
SPACE 1 12507750
* DUMMY PARM LIST TO DO A GET AT OPEND TIME, IF NO NORMAL PL FOUND 12507800
PRMDMY EQU * * 12507850
DC 2XL1'00' CHAIN ADDRESS 12507900
DC XL1'00' USER REQUEST 12507950
DC AL1(OPDMY) MESSAGE MODE INPUT, DUMMY PL BIT 12508000
DC 2XL1'00' EFFECTIVE INPUT LENGTH 12508050
DC 2XL1'00' MAXIMUM INPUT LENGTH 12508100
DC 2XL1'00' RECORD AREA ADDRESS 12508150
DC 2XL1'00' TUB ADDRESS 12508200
DC AL1(OPDMY-OPMSG) INTERNAL OPCODE AREA 12508250
DC AL1(OPDMY-OPMSG) INTERNAL OPCODE AREA 12508300
DC 3XL1'00' ECB FOR THE REQUEST 12508350
SPACE 12508400
* EQUATES AND CONSTANTS 12508450
@PRMDY DC AL2(PRMDMY) ADDRESS PORT DUMMY PARM LIST 12508500
BCKREG DC AL2(-TPXLNG) LENGTH TO BACK REG TO PL INFO 12508550
LNTHCC DC AL2(TPXLNG-4) PARM INFO LENGTH+ 1 GET/FREE PRM 12508600
X$0003 DC XL2'0003' CONSTANT OF 3 12508620
PRTWRK DC 2XL1'00' 2-BYTE ADD AREA FOR PCT LENGTH 12508650
PORTAR DC XL2'0000' TAR LOCATION USED BY PORT 12508670
CTR1 DC 3XL1'00' STATISTICS:# OF 43 AND 49 CODES 12508700
CTR2 DC 3XL1'00' STATISTICS:# OF 43 COMP CODES 12508750
CTR3 DC 3XL1'00' STATISTICS:# DATA GOES TO TPBUFF 12508800
CTR4 DC 3XL1'00' STATISTICS:# OF INPUT OPENDS 12508850
CTR5 DC 3XL1'00' STATISTICS:# OF OUTPUT OPENDS 12508900
CTR6 DC 3XL1'00' STATISTICS:# TIMES HAVE TO GET 12508950
.PT310 ANOP 12509150
TITLE '$ E 1 8 0 - C S S U B R O U T I N E S ' 12510000
*********************************************************************** 12520000
* CONSTANTS AND MISCELLANEOUS EQUATES FOR COM MANAGER * 12530000
*********************************************************************** 12540000
SPACE 1 12550000
MASK EQU PMRI12+PMRPRV+PMRINT MASK INTERRUPTS 12560000
UNMASK EQU PMRI12+PMRPRV UNMASK INTERRUPTS 12570000
TTMRIB EQU 22 STOP TIMER RIB 12580000
STMRIB EQU 21 START TIMER RIB 12590000
PSTRIB EQU 5 POST RIB 12600000
CCPRIB EQU 1 CCP RIB 12610000
SPACE 1 12620000
EBCLER EQU X'6D' EBCDIC CLEAR AID CHARACTER 12630000
ASCLER EQU X'5F' ASCII CLEAR AID CHARACTER 12640000
AIDCHR EQU 2 DISPLACEMENT OF 3270 AID CHAR. 12650000
SPACE 1 12660000
SWAPTO EQU 2 TO ADDRESS IS USER PGM AREA 12670000
SWAPFR EQU 1 FROM ADDRESS IS USER PGM AREA 12680000
HEX512 EQU 2 CONSTANT FOR 512 BYTES 12690000
WCC EQU 2 DISPLACEMENT OF WCC IN PLRECA 12692000
STPRT EQU X'08' START PRINT BIT IN WCC 12694000
I0002 EQU X'02' USED TO SET LOOP COUNT = 2 12696000
FC EQU X'FC' CAUSES A FALSE CONDITION IF 12700000
* GREATER THAN THREE 12710000
SPACE 1 12720000
FLSNLO EQU X'95' FALSE OR HIGH OR EQUAL COND. 12730000
FLSOEQ EQU X'91' FALSE OR EQUAL COND. 12740000
FLSONE EQU X'96' FALSE OR NOT EQUAL COND. 12750000
FLSOHI EQU X'94' FALSE OR HIGH COND 12760000
TRUALO EQU X'15' TRUE AND LOW CONDITION 12770000
TRUANL EQU X'12' TRUE AND NOT LOW CONDITION 12780000
TRUAEQ EQU X'16' TRUE AND EQUAL COND. 12790000
OPSYS EQU X'20' SYSTEM OP (IF ON IN PL$OPC) 12800000
SPACE 2 12810000
* EQUATES FOR THE BSCC POLL LIST 12820000
POLID EQU 0 DISPLACEMENT OF ID 12830000
POLLTH EQU 1 DISPLACEMENT OF LENGTH 12840000
POLADR EQU 2 DISPLACEMENT OF ADDRESS 12850000
POLSTS EQU 2 USED TO ADDRESS STATUS BYTE 12860000
POLSKP EQU 128 POLL SKIP BIT IN STATUS BYTE 12870000
POLNXT EQU 3 USED TO GET TO NEXT ENTRY 12880000
POLEND EQU 240 END OF LIST INDICATOR 12890000
SPACE 1 12900000
GMLIST EQU * GETMAIN PARM LIST 12910000
DS XL2 ADDRESS RETURNED BY CC4GM 12920000
DS XL2 LENGTH OF AREA REQUESTED 12930000
GMSIZE EQU 3 RIGHTMOST BYTE OF GM PL 12940000
GMADDR EQU 1 ADDRESS OF GETMAINED AREA 12950000
SPACE 1 12960000
* TIMER PARM LIST (IOB) 12970000
* 12980000
* |FLG| TIME | ECB | 12990000
* | | | | 13000000
* |---|---|---|---|---|---|---|---|---|---| 13010000
CSTIMR EQU * START OF TIMER IOB 13020000
TIMFLG EQU 0 TIMER FLG BYTE 13030000
DC XL1'02' 02=TIMER UNITS,FF=CANCEL TIME 13040000
TIMTIM EQU 6 RIGHTMOST BYTE OF TIME FIELD 13050000
DC XL6'000000000258' INIT TO 2 SECONDS 13060000
TIMECB EQU 7 LEFTMOST BYTE OF TIMER ECB 13070000
DC 3XL1'0' TIMER ECB 13080000
CSTECB EQU CSTIMR+TIMECB ADDRESS OF TIMER ECB 13090000
SPACE 1 13100000
CSOWNS DC AL2(0) TCB ADDRESS OF LINE OWNER 13110000
CCPUT DC XL1'02' OP CODE TO PUT A CLEAR MSG. 13120000
OLTLNG DC AL2(7) LENGTH OF OLT REQ PARM LIST 13130000
PLGMLG DC AL2(PLLEN+4) LENGTH TO USE FOR PARM LIST GM 13140000
PLGMLN DC AL2(PLLEN+1) PARM LIST GM LENGTH-USER PUTU@13 13145000
SPACE 1 13150000
CSSWIT EQU * INTERNAL SWITCH FOR CS 13160000
DC AL1(VALOPE) INITIALIZED TO OP END OCCURRED 13170000
CSNDCR EQU BIT0 INTERNAL FREEMAIN INDICATOR 13180000
CSNRIP EQU BIT1 NEQ REQUEST IN PROCESS 13190000
CSRESH EQU BIT2 OK TO RESCHEDULE THIS LINE 13200000
VALOPE EQU BIT3 OP END OCCURRED 13210000
CSSGET EQU BIT4 NEED TO DO A GET 13212000
CSSPRM EQU BIT5 ON IF FOUND NEW REQUEST PL 13214000
CSSCMD EQU BIT6 COMMAND DATA FOR USER PARM LIST 13216000
SPACE 1 13220000
LNTHSS DC XL2'0007' LENGTH OF A STATUS MESSAGE 13230000
X0000 DC 4XL1'0' CONSTANT OF 0,LENGTH OF 4 13240000
X0100 DC XL2'0100' CONSTANT OF 256,LENGTH OF 2 13250000
X$012C DC XL2'012C' CONSTANT OF 300,LENGTH OF 2 13260000
X0200 DC XL2'0200' CONSTANT OF 512,LENGTH OF 2 13270000
RND2K DC XL2'07FF' CONSTANT TO ROUND TO 2K @13 13273000
BND2K EQU X'07' EQUATE TO ROUND TO 2K @13 13276000
DEC99 DC 2XL1'F9' CONSTANT OF DECIMAL 99,LENGTH 2 13280000
SPACE 1 13290000
CSTPBF DC XL2'0' SAVE AREA FOR TPBUFF SIZE 13300000
CSTMPL DC CL2'TT' SAVE AREA FOR PL CHAIN PNTR 13310000
CSSCLB DC AL2(0) SAVE AREA FOR CURRENT CLB ADDR. 13320000
CSSPL DC AL2(0) SAVE AREA FOR CURRENT PL ADDR. 13330000
CSNWPL DC AL2(0) SAVE AREA FOR NO-WAIT PL ADDR. 13340000
CSINDD DC AL2(CSININ) RETURN @ FROM DISPATCHER 13345000
SPACE 1 13350000
CSDMES DC &DMESTR DATA MODE ESCAPE CHARACTERS 13360000
CSMANT EQU * 13370000
DC 3CL20'CS MAINTENANCE AREA ' MAINTENANCE AREA FOR CS 13380000
MEND 13390000