DIB TITLE 'DMKDIB (CP) VM/370 - RELEASE 6' 00001000
ISEQ 73,80 VALIDATE SEQUENCING OF SYSIN 00002000
COPY OPTIONS 00003000
COPY LOCAL 00004000
EJECT 00005000
DMKDIB START 00006000
SPACE 00007000
DC CL8'DMKDIB' PAGEABLE MODULE IDENTIFIER 00008000
SPACE 00009000
USING PSA,R0 00010000
USING VMBLOK,R11 00011000
USING SAVEAREA,R13 00012000
SPACE 00013000
EXTRN DMKACODV,DMKBLDVM,DMKCFPRD,DMKCVTBD @VA13704 00014000
EXTRN DMKCVTBH,DMKCVTHB,DMKERMSG,DMKRIORN @VA13704 00014200
EXTRN DMKRNHND,DMKSCHRT,DMKSCNAU,DMKSCNFD @VA13704 00014400
EXTRN DMKSCNRD,DMKSCNRN,DMKSCNRU,DMKSCNVD @VA13704 00014600
EXTRN DMKSCNVU,DMKSTKCP,DMKSYSND,DMKVCARS @VA13704 00014800
EXTRN DMKSTKIO @V407510 00015000
EXTRN DMKSYSRM @V407510 00016000
EJECT 00924000
*. 00925000
* MODULE NAME - 00926000
* 00927000
* 00927100
* DMKDIB 00927200
* 00927300
* CONTENTS - 00927400
* 00927500
* DMKDIBDR - DROP A DIALED LINE FROM A VIRTUAL MACHINE @VA13704 00927600
* DMKDIBCP - 'COUPLE' VIRTUAL CHANNEL-TO-CHANNEL ADAPTER@VA13704 00927700
* DMKDIBSM - SIMULATE STATUS FOR NOT-YET-DIALED LINE OR FOR 00928000
* NOT-YET-COUPLED CHANNEL-TO-CHANNEL ADAPTER 00929000
* 00930000
* FUNCTION - 00931000
* 00932000
* DMKDIBSM WILL SIMULATE SENSE DATA AND STATUS FOR VIRTUAL 00933000
* I/O TO A SIMULATED I/O DEVICE (2702 LINE OR CTCA) WHICH 00934000
* HAS NOT YET BEEN 'ACTIVATED' THROUGH EITHER THE CONSOLE 00935000
* FUNCTION 'DIAL' (FOR 2702 LINES) OR THE CONSOLE FUNCTION 00936000
* 'COUPLE' (FOR VIRTUAL CTCA'S). 00937000
* 00938000
* ENTRY POINT - 00939000
* 00940000
* DMKDIBSM 00941000
* 00942000
* ENTRY CONDITIONS - 00943000
* 00944000
* GPR 2 = 0 (FOR 2702 LINE) OR 'TYPCTCA' (FOR CTCA) 00945000
* OR TYP3277 FOR 3270 00946000
* GPR 8 = DISPLACEMENT (FROM VMDVSTRT) TO VDEVBLOK 00947000
* GPR 10 = ADDRESS OF IOBLOK AND CCW PACKAGES FOR I/O 00948000
* GPR 11 = VMBLOK ADDRESS 00949000
* GPR 12 = ADDRESS OF DMKDIBSM 00950000
* GPR 13 = ADDRESS OF STANDARD SAVE-AREA 00951000
* 00952000
* EXIT CONDITIONS - 00953000
* 00954000
* GPRS 0-15 UNCHANGED 00955000
* IOBLOK HAS BEEN UPDATED AND STACKED VIA 'DMKSTKIO' 00956000
* 00957000
* CALLS TO OTHER ROUTINES - 00958000
* 00959000
* DMKSTKIO - TO STACK THE IOBLOK FOR HANDLING BY DMKVIO 00960000
* DMKFREE - TO OBTAIN STORAGE FOR AN IOERBLOK, IF NEEDED 00961000
* DMKDIBDR - TO DROP A DIALED LINE @VA13704 00962000
* 00963000
* EXTERNAL REFERENCES - NONE 00964000
* 00965000
* TABLES / WORK AREAS - IOBLOK 00966000
* 00967000
* REGISTER USAGE - 00968000
* 00969000
* GPR 13 = SAVE-AREA ADDRESSABILITY 00970000
* GPR 12 = MODULE BASE ADDRESSABILITY 00971000
* GPR 11 = VMBLOK ADDRESSABILITY 00972000
* GPR 10 = IOBLOK ADDRESSABILITY 00973000
* GPR 9 = RCWCCW ADDRESSABILITY 00974000
* GPR 8 = VDEVBLOK ADDRESSABILITY 00975000
* GPR 7 = CSW CCW ADDRESS 00976000
* GPR 4 = CSW RESIDUAL COUNT 00977000
* GPRS 0-3, 5-6 ARE WORK REGISTERS 00978000
* 00979000
EJECT 00980000
* OPERATION - 00981000
* 00982000
* DMKDIBSM EXAMINES EACH CCW IN THE CCW STRING TO DETERMINE 00983000
* WHAT STATUS AND/OR ACTION SHOULD BE TAKEN TO SIMULATE THE 00984000
* ACTUAL OPERATION OF THE SIMULATED DEVICE BEING PROCESSED. 00985000
* FOR A NOT-YET-DIALED 2702 LINE: 00986000
* A. IF CCW IS A SENSE, SIMULATE SENSE DATA, ADVANCE 00987000
* B. IF CCW IS A NO-OP, ADVANCE 00988000
* C. IF CCW IS AN ENABLE, SET UP FOR PROCESSING BY D 00989000
* 'DMKDIAL' WHEN 'DIAL' COMMAND IS ISSUED. 00990000
* D. IF CCW IS NONE OF THE ABOVE, PRESENT UNIT CHECK, 00991000
* INTERVENTION REQUIRED. 00992000
* FOR AN ALREADY-DIALED LINE: (CCW STRING CONTAINS A DISABLE) 00993000
* A. IF CCW IS NOT A DISABLE, ADVANCE 00994000
* B. IF CCW IS A DISABLE, CALL DMKDIBDR TO DROP LINE 00995000
* AND RESUME PROCESSING AS IF LINE IS NOT DIALED 00996000
* FOR A NOT-YET-COUPLED CTCA: 00997000
* A. IF CCW IS A SENSE, SIMULATE SENSE DATA, ADVANCE 00998000
* B. IF CCW IS A NO-OP, ADVANCE 00999000
* C. IF CCW IS NONE OF THE ABOVE, PRESENT UNIT CHECK, 01000000
* INTERVENTIONREQUIRED. 01001000
* FOR ALL CASES, AN INVALID CCW WILL CAUSE A PROGRAM CHECK 01002000
* A SENSE INTO PROTECTED CORE WILL CAUSE A PROTECTION CHECK 01003000
* 2702 LINES NEVER PRODUCE CC = 1 TO SIO, CTCA'S WILL. 01004000
*. 01005000
EJECT 01006000
DMKDIBSM RELOC , SIMULATE ENDING STATUS FOR NOT-YET-DIAL-ED LINE 01007000
USING IOBLOK,R10 01008000
USING RCWCCW,R9 01009000
USING VDEVBLOK,R8 01010000
AL R8,VMDVSTRT RE-COMPUTE VDEVBLOK ADDRESS 01011000
SPACE 01012000
SLR R4,R4 SET RESIDUAL COUNT REGISTER ZERO 01013000
SLR R6,R6 SET IOERBLOK POINTER ZERO, ALSO 01014000
ST R6,SAVEWRK1 SET STATUS AND SENSE AREA ZERO 01015000
MVI SAVEWRK1,CE+DE INITIALIZE FOR ENDING STATUS 01016000
MVC IOBCSW(8),ZEROES CLEAR IOBCSW 01017000
SPACE 01018000
L R9,IOBCAW FIRST CCW ADDRESS 01019000
TM IOBCAW,X'0F' CAW BITS 4-7 ZERO? @VA02143 01020000
BC 5,DIAPRGC1 NO, CHAN. PROG. CK. @VA02143 01021000
DIACCWS EQU * INTERPRET CCW STRING 01022000
LA R7,8(0,R9) ADDRESS FOR CSW 01023000
ICM R4,B'0011',RCWCNT RESIDUAL COUNT FOR CSW 01024000
TM RCWCTL,RCWINVL IS THIS AN INVALID CCW ? 01025000
BO DIASTAT YES - CHECK FOR WHY 01026000
CLI RCWCOMND,X'08' IS THIS A TIC ? 01027000
BE DIALTIC YES - DO THE TRANSFER 01028000
CLI RCWCOMND,X'18' IS IT TIC AFTER CHAIN DATA ? 01029000
BE DIALTIC YES - GO DO IT 01030000
TM RCWFLAG,X'03' ARE THE 'MUST-BE-ZERO' BITS ZERO?@VA02143 01031000
BNZ DIAPRGC1 NO, CHAN. PROG. CK. @VA02143 01032000
CLI SAVER2+3,TYPCTCA CALLED FOR VIRT. CTCA ? 01033000
BE DIALNOP YES - DON'T WORRY ABOUT ENABLE, DISABLE 01034000
CLI SAVER2+3,TYP3277 3270 DEVICE ?? @V200730 01035000
BE DIALNOP YES, DONT TEST FOR DISABLE @V200730 01036000
CLI RCWCOMND,X'2F' IS THIS A DISABLE ? 01037000
BE DISABLE YES - VERY SPECIAL TYPE CCW 01038000
TM VDEVFLAG,VDEVDIAL IS THE LINE STILL DIALED ? 01039000
BO DIALADV YES - SKIP OTHER CHECKING FOR NOW 01040000
CLI RCWCOMND,X'27' IS THIS A RE-ENABLE ? 01041000
BE RENABLE YES - SPECIAL STUFF HERE, TOO 01042000
DIALNOP EQU * CHECK FOR SENSE OR NO-OP COMMAND 01043000
TM RCWCOMND,B'00001011' IS IT A SENSE ? 01044000
BZ DIASENS YES - PROCESS IT SPECIALLY 01045000
TM RCWCOMND,X'03' CONTROL-TYPE COMMAND ? 01046000
BNO DIASTAT NO -- GIVE UNIT CHECK, INT. REQ. 01047000
TM RCWCOMND,X'0C' NO-OP OR SOME OTHER CONTROL ? 01048000
BNZ DIASTAT SOME OTHER KIND - UNIT CHECK 01049000
TM RCWFLAG,CC CHAINED NOP ? @VA03261 01050000
BZ DIALCC1 NO..CHECK IF FIRST CCW @VA03261 01051000
DIALADV EQU * ADVANCE TO NEXT CCW 01052000
TM RCWFLAG,CC+CD CHAINED ? 01053000
BZ DIALCSW NO - CLEAN ENDING 01054000
LR R9,R7 NEXT ONE IN LINE... 01055000
B DIACCWS ...AND KEEP ON LOOKING 01056000
SPACE 01057000
DIALTIC EQU * PROCESS TRANSFER IN CHANNEL 01058000
CL R9,IOBCAW WORKING ON FIRST CCW? @VA02143 01059000
BE DIAPRGC1 YES, CC=1 PROG. CK. @VA02143 01060000
TM RCWCCW+3,X'07' DOUBLE-WORD ALIGNED? @VA02143 01061000
BNZ DIAPRGC NO, CHAN. PROG. CK. @VA02143 01062000
L R9,RCWADDR GET NEXT CCW ADDRESS @VA02143 01063000
CLI RCWCOMND,X'08' TIC TO A TIC? @VA02143 01064000
BE DIAPRGC YES, CHAN. PROG. CK. @VA02143 01065000
B DIACCWS NO, KEEP GOING... @VA02143 01066000
SPACE 2 01067000
DIASTAT EQU * SET SENSE BYTE, CSW STATUS 01068000
CLI RCWCOMND,X'00' IF OP-CODE IS ZERO, 01069000
BNE DIASTA1 NO -- MUST BE INVALID OP-CODE 01070000
CL R9,IOBCAW WORKING ON FIRST CCW? @VA02143 01071000
BNZ DIAPRGC NO, CHAN. PROG. CK. WITH CE/DE @VA02143 01072000
DIAPRGC1 EQU * NO C.E./D.E. STATUS @VA02143 01073000
MVI SAVEWRK1,X'00' RESET CE/DE STATUS @VA02143 01074000
DIAPRGC EQU * YES - CHANNEL PROGRAM CHECK 01075000
MVI SAVEWRK1+1,PRGC ADD THIS TO STATUS 01076000
B DIALCC1 ...AND GO SET THE CSW @VA02143 01077000
DIASTA1 EQU * CHECK FOR INTREQ OR CMDREJ 01078000
OI SAVEWRK1,UC SET UNIT CHECK IN STATUS 01079000
MVI SAVEWRK1+2,INTREQ SET INTREQ IN SENSE DATA 01080000
TM RCWCTL,RCWINVL IS IT ALSO INVALID OP ? 01081000
BZ DIALCSW NO - ALL SET AS IS 01082000
OI SAVEWRK1+2,CMDREJ COMMAND REJECT ALSO 01083000
DIALCSW EQU * CONSTRUCT DUMMY CSW 01084000
CLI SAVER2+3,TYPCTCA CALLED FROM DMKVCA ? 01085000
BE DIALCC1 YES, CONT @V200730 01086000
CLI SAVER2+3,TYP3277 3270 DEVICE ?? @V200730 01087000
BE DIALCC1 YES - MIGHT BE CC=1 @VA04021 01088000
CLI 0(R9),X'03' NO-OP TO A DIAL LINE? @VA04021 01089000
BNE DIALINT NO--FORCE CC=0, LATER INTERRUPT @VA04021 01090000
DIALCC1 DS 0H CHECK FOR CC=1 WITH STATUS @VA04021 01091000
CL R9,IOBCAW WORKING ON FIRST CCW ? 01092000
BNE DIALINT NO -- PRESENT THE ERROR AS AN INTERRUPT 01093000
CLI SAVEWRK1+3,X'80' WAS IT A SENSE COMMAND ? @V200820 01094000
BE DIALINT YES - CANNOT GIVE CC = 1 @V200820 01095000
CLI SAVER2+3,TYPCTCA @VA10350 01095100
BNE DIALCC1A @VA10350 01095200
TM VDEVSTAT,VDEVNRDY IS CTCA COUPLED? @VA10350 01095300
BZ DIALCC1A YES @VA10350 01095400
MVI IOBSTAT,IOBCC3 GIVE CC=3 @VA10350 01095500
B DIALSTK @VA14572 01095650
DIALCC1A DS 0H @VA10350 01095700
MVI IOBSTAT,IOBCC1 SET CC = 1 TO SIO 01096000
CLI SAVER2+3,TYP3277 3270 TYPE DEVICE @VA09176 01096100
BNE DIALSAT @VA09176 01096200
TM VDEVFLAG,VDEVDIAL IS THE LINE DIALED @VA09176 01096300
BO DIALSAT @VA09176 01096400
CLI RCWCOMND,X'03' IS THIS A NO-OP COMMAND @VA10844 01096430
BE DIALSAT @VA10844 01096460
NI SAVEWRK1,X'F3' NO-TURN OFF CE AND DE @VA09176 01096500
B DIALSAT ...AND GO FILL IN CSW STATUS 01097000
EJECT 01098000
DIALINT EQU * PRESENT STATUS AS AN I/O INTERRUPT 01099000
NI VMRSTAT,255-VMIOWAIT TAKE USER OUT OF IOWAIT 01100000
STH R4,IOBCSW+6 RESIDUAL COUNT INTO CSW 01101000
ST R7,IOBCSW SET CSW ADDRESS... 01102000
IC R1,IOBCAW GET PROTECTION KEY FROM CAW 01103000
STC R1,IOBCSW ...AND FILL IN CSW 01104000
DIALSAT EQU * STORE CSW STATUS ONLY 01105000
LH R1,SAVEWRK1 CSW STATUS... 01106000
STH R1,IOBCSW+4 ... 01107000
TM IOBCSW+4,UC DID WE CREATE A UNIT CHECK ? 01108000
BZ DIALSTK NO - THAT'S MUCH EASIER 01109000
LA R0,IOERSIZE GET AN IOERBLOK 01110000
CALL DMKFREE ...FOR SENSE DATA 01111000
LR R6,R1 01112000
USING IOERBLOK,R6 01113000
XC IOERBLOK(IOERSIZE*8),IOERBLOK CLEAR TO ZEROES 01114000
MVC IOERCSW(8),IOBCSW FILL IN CSW 01115000
LA R1,IOERDATA CONSTRUCT DUMMY SENSE CCW 01116000
ST R1,IOERCCW ... 01117000
MVI IOERCCW,X'04' ...MAKE IT A SENSE 01118000
MVC IOERCCW+4(4),=AL1(SILI,0,0,1) FLAGS+LENGTH 01119000
MVC IOERDATA(1),SAVEWRK1+2 SENSE BYTE 01120000
DROP R6 01121000
DIALSTK EQU * SETUP IOBLOK, STACK FOR DMKVIOEX 01122000
ST R6,IOBIOER SET IOERBLOK PTR, IF ANY 01123000
ST R11,IOBUSER MAKE SURE THIS IS CORRECT 01124000
CALL DMKSTKIO ...AND STACK THE IOBLOK 01125000
EXIT , RETURN TO DMKCCWTR 01126000
EJECT 01127000
DIASENS EQU * MIGHT BE A REAL SENSE 01128000
MVI SAVEWRK1+3,X'80' REMEMBER THE 'SENSE' @V200820 01129000
TM RCWFLAG,SKIP IF SKIP IS SET... 01130000
BO SETCNT DMKCCW FAKED IT -- ADJUST COUNT @VM01012 01131000
L R1,RCWADDR GET DATA ADDRESS 01132000
LA R1,0(0,R1) STRIP OFF OP-CODE 01133000
TM RCWFLAG,IDA IS IDA BIT SET ? 01134000
BZ *+8 THANK HEAVENS -- IT'S NOT 01135000
L R1,0(0,R1) GET ADDRESS FROM IDAL 01136000
L R2,=A(DMKSYSRM) GET REAL MACHINE @VA03162 01137000
L R2,0(,R2) SIZE... @VA03162 01138000
CLR R1,R2 VALID ADDRESS @VA03162 01139000
BNL DIAPRGC NO..CHANNEL PROGRAM CHECK @VA03162 01140000
LR R2,R1 SAVE THE REAL ADDRESS 01141000
CLI IOBCAW,0 CAW KEY ZERO ? @VA03814 01142000
BE SETSENS YES..STORE SENSE BYTE.. @VA03814 01143000
N R1,=X'00FFFFF0' ALIGN FOR AN 'ISK' 01144000
ISK R1,R1 GET THE REAL STORAGE KEY 01145000
N R1,F240 ISOLATE THE FOUR-BIT HUNK 01146000
CLM R1,B'0001',IOBCAW DOES IT MATCH THE CAW ? 01147000
BE SETSENS YES - LET HIM HAVE SOME DATA 01148000
MVI SAVEWRK1+1,PRTC PROTECTION CHECK 01149000
B DIALCSW GO SET CSW 01150000
SETSENS EQU * RETURN SENSE DATA TO USER 01151000
MVI 0(R2),X'40' SENSE IR @VA09186 01152100
SETCNT BCTR R4,0 ADJUST GR4 FOR RESIDUAL COUNT @VM01012 01153000
TM RCWFLAG,CD WAS THE SENSE DATA-CHAINED ? @VM01010 01154000
BZ DIALADV NO -- CHECK FOR CMD CHAIN @VM01010 01155000
MVI SAVEWRK1+1,IL INCORRECT LENGTH INDICATION @VM01010 01156000
B DIALCSW GO PRESENT STATUS @VM01010 01157000
SPACE 2 01158000
DISABLE EQU * 'DISABLE' CCW ENCOUNTERED 01159000
MVI SAVEWRK1+3,X'80' FORCE INTERRUPT IF 1ST CCW @VA08754 01159500
MVI RCWCOMND,X'03' MAKE IT A NO-OP 01160000
TM VDEVFLAG,VDEVDIAL IS THE LINE ACTIVE ? 01161000
BZ DIALADV NO - SKIP 'DROP' CALL 01162000
CALL DMKDIBDR DROP THE DIALED LINE @VA13704 01163000
B DIALADV GO CONTINUE WITH CCW SCAN 01164000
SPACE 01165000
RENABLE EQU * 'ENABLE' CCW ENCOUNTERED AFTER 'DISABLE' 01166000
MVI RCWCOMND,X'01' CHANGE ENABLE INTO WRITE CIRCLE-C 01167000
LA R1,1(0,0) DATA COUNT 01168000
STH R1,RCWCNT ... 01169000
* DMKCCWTR HAS ALREADY SET UP THE DATA ADDRESS AND CIRCLE-C BYTE 01170000
OI RCWFLAG,SILI ENSURE NO UNEXPECTED ERRORS 01171000
ICM R9,B'1000',IOBCAW GET ORIGINAL CAW KEY 01172000
ST R9,IOBRCAW ...AND SET THE RESTART CAW 01173000
OI IOBFLAG,IOBRSTRT ...FOR 'DIAL' SEQUENCE 01174000
OI VDEVFLAG,VDEVENAB DEVICE NOW ENABLED AGAIN 01175000
ST R10,VDEVIOB PRESERVE THE IOBLOK ADDRESS 01176000
EXIT , ...AND PASS IT BACK TO DMKCCWTR 01177000
EJECT 01178000
*. 01179000
* SUBROUTINE NAME - 01180000
* 01181000
* DMKDIBDR - DROP A DIALED LINE FROM A VIRTUAL SYSTEM @VA13704 01182000
* 01183000
* FUNCTION - 01184000
* 01185000
* TO RELEASE A TERMINAL LINE WHICH HAS BEEN IN USE BY A 01186000
* VIRTUAL SYSTEM VIA THE 'DIAL' COMMAND. THE LINE IS 01187000
* DETACHED FROM THE VIRTUAL SYSTEM AND MADE AVAILABLE FOR 01188000
* NORMAL LOGON TO VM/370. 01189000
* 01190000
* ENTRY POINT - 01191000
* 01192000
* DMKDIBDR @VA13704 01193000
* 01194000
* ENTRY CONDITIONS - 01195000
* 01196000
* GPR 8 = ADDRESS OF VDEVBLOK FOR DIALED LINE 01197000
* GPR 11 = VMBLOK ADDRESS OF DIALED SYSTEM 01198000
* GPR 12 = ADDRESS OF DMKDIBDR @VA13704 01199000
* GPR 13 = ADDRESS OF STANDARD SAVE AREA 01200000
* 01201000
* EXIT CONDITIONS - 01202000
* 01203000
* GPRS 0-15 UNCHANGED 01204000
* THE VDEVBLOK HAS BEEN MARKED NOT ENABLED, NOT DIALED, 01205000
* THE OPERATOR AND THE DIALED USER HAVE BEEN INFORMED 01206000
* OF THE LINE DROP, AND THE TERMINAL LINE IS AVAILABLE 01207000
* FOR VM/370 LOGON OR ANOTHER 'DIAL'. 01208000
* 01209000
* CALLS TO OTHER ROUTINES - 01210000
* 01211000
* DMKACODV - FOR ACCOUNTING OF DEDICATED DEVICES 01212000
* DMKBLDVM - TO BUILD A DUMMY VMBLOK FOR MESSAGES 01213000
* DMKQCNWT - TO TYPE MESSAGES TO THE DIALED USER 01214000
* DMKSCNRD - TO GET THE REAL ADDRESS OF THE TERMINAL 01215000
* DMKSCNVD - TO GET THE VIRTUAL ADDRESS OF THE LINE 01216000
* DMKCVTBH - TO CONVERT THE ADDRESSES TO EBCDIC 01217000
* DMKFREE - TO OBTAIN FREE STORAGE FOR MESSAGE BUFFER 01218000
* DMKFRET - TO RETURN DUMMY VMBLOK TO FREE STORAGE 01219000
* DMKDSPCH - TO WAIT FOR MESSAGE COMPLETION 01220000
* 01221000
* EXTERNAL REFERENCES - 01222000
* 01223000
* DMKSYSND - NUMBER OF DIALED USERS 01224000
* DMKSYSVM - SYSTEM VMBLOK CHAIN ANCHOR 01225000
* 01226000
* TABLES / WORK AREAS 01227000
* 01228000
* VDEVBLOK, RDEVBLOK, VMBLOK 01229000
* 01230000
EJECT 01231000
* REGISTER USAGE - 01232000
* 01233000
* GPR 13 = SAVE-AREA ADDRESSABILITY 01234000
* GPR 12 = MODULE BASE ADDRESSABILITY 01235000
* GPR 11 = VMBLOK ADDRESSABILITY 01236000
* GPR 9 = ADDRESS OF MESSAGE BUFFER 01237000
* GPR 8 = VDEVBLOK, RDEVBLOK ADDRESSES 01238000
* GPR 7 = CONSTANT ZERO 01239000
* GPRS 0-6 ARE WORK REGISTERS 01240000
* 01241000
* OPERATION - 01242000
* 01243000
* DMKDIBDR FIRST CALLS DMKACODV TO HANDLE THE TIME ACCOUT- 01244000
* ING FOR THE TIME THAT THE DIALED LINE WAS DEDICATED TO THE 01245000
* VIRTUAL SYSTEM. NEXT, THE VIRTUAL DEVICE IS DISCONNECTED 01246000
* FROM THE REAL DEVICE AND MARKED NON-ENABLED, NON-DIALED. 01247000
* DMKBLDVM IS CALLED TO BUILD A TEMPORARY VMBLOK ASSOC- 01248000
* IATED WITH THE PREVIOUSLY DIALED TERMINAL LINE, SUCH 01249000
* THAT DMKDIBDR CAN SEND THE 'LINE XXX DROP' MESSAGE TO 01250000
* THE DIALED USER. THE SYSTEM OPERATOR IS ALSO INFORMED OF 01251000
* THE LINE DROP AND THE NUMBER OF DIALED USERS, DMKSYSND, 01252000
* IS UPDATED. AFTER THE USER MESSAGE HAS COMPLETED, THE 01253000
* DUMMY VMBLOK IS REMOVED FROM THE VMBLOK CHAIN AND RETURNED 01254000
* TO FREE STORAGE VIA DMKFRET. EXIT. 01255000
*. 01256000
SPACE 4 01257000
DMKDIBDR RELOC , DROP DIALED LINE FROM VIRTUAL SYSTEM @VA13704 01258000
XC SAVEWRK1(4),SAVEWRK1 CLEAR FLAG BYTE AREA @V240820 01259000
EJECT 01260000
USING VDEVBLOK,R8 01261000
L R6,VDEVREAL POINTER TO RDEVBLOK 01262000
SLR R7,R7 GET A ZERO CONSTANT 01263000
CALL DMKACODV DO DEVICE RELEASE ACCOUNTING 01264000
* NOW START TO UN-DIAL THE LINE 01265000
NI VDEVSTAT,X'FF'-VDEVDED NO LONGER DEDICATED DEVICE 01266000
ST R7,VDEVREAL ... 01267000
NI VDEVFLAG,X'FF'-(VDEVENAB+VDEVDIAL) MARK IT FREE 01268000
CLI VDEVTYPC,CLASGRAF GRAF DEVICE ?? @V200730 01269000
BNE NOGRAF NO,DO NOT MAKE IT @VA09186 01270000
OI VDEVSTAT,VDEVNRDY NOT READY @VA09186 01271000
B NRSET SKIP RESET @VA09186 01272000
NOGRAF EQU * @VA09186 01273000
NI VDEVTYPE,X'F0' LEAVE ONLY ADAPTER TYPE @VA09186 01274000
NRSET LR R8,R6 ...WERE FINISHED WITH VDEVBLOK @VA09186 01275000
SWITCH SWITCH TO MAIN PROCESSOR @V407510 01276000
USING RDEVBLOK,R8 01277000
NI RDEVSTAT,X'FF'-RDEVDED REAL DEVICE NOT DEDICATED 01278000
STH R7,RDEVATT NO VIRTUAL ADDRESS 01279000
TM RDEVFLAG,RDEVEPMD SWITCHED-MODE 370X LINE ? @V240820 01280000
BZ SETUSER NO -- NO SPECIAL HANDLING @V240820 01281000
LH R9,RDEVCYL RESOURCE I.D. OF THE NCP LINE @V240820 01282000
L R7,RDEVCUA BACK UP TO THE CONTROL UNIT @V240820 01283000
USING RCUBLOK,R7 . . . @V240820 01284000
LH R1,RDEVADD DEVICE ADDRESS ALONE @V240820 01285000
SLL R1,1(0) SHIFT FOR INDEX TO RCUDVTBL @V240820 01286000
LA R1,RCUDVTBL(R1) POINT TO RDEVBLOK INDEX SLOT@V240820 01287000
MVC 0(2,R1),FFS DISCONNECT RDEVBLOK FROM RCUBLOK @V240820 01288000
DROP R7 @V240820 01289000
LR R4,R8 SAVE THE DYNAMIC RDEVBLOK ADDRESS@V240820 01290000
LH R1,RDEVBASE ADDRESS OF THE NATIVE SUB-CHANNEL@V240820 01291000
CALL DMKSCNRU GET THE 370X NATIVE BLOCKS @V240820 01292000
L R3,RDEVEPDV DYNAMIC RDEVBLOK CHAIN @V240820 01293000
ST R4,RDEVEPDV ADD RELEASED BLOCK TO THE CHAIN @V240820 01294000
ST R3,RDEVEPDV-RDEVBLOK(,R4) . . . @V240820 01295000
L R2,=A(DMKRIORN) TABLE OF 370X RDEVBLOK'S @V240820 01296000
L R3,0(0,R2) COUNT OF TABLE ENTRIES @V240820 01297000
GETCODE EQU * COMPUTE 370X DEVICE CODE @V240820 01298000
CH R1,6(0,R2) IS THIS THE CORRECT ENTRY ? @V240820 01299000
BE SETCODE YES - BUILD RESOURCE REFERENCE @V240820 01300000
LA R2,4(0,R2) NEXT ENTRY IN TABLE @V240820 01301000
BCT R3,GETCODE . . . @V240820 01302000
SETCODE EQU * BUILD TERMINAL RESOURCE REFERENCE@V240820 01303000
S R2,=A(DMKRIORN) COMPUTE TABLE DISPLACEMENT @V240820 01304000
SLL R2,10(0) SHIFT FOR REFERENCE FIELD @V240820 01305000
LA R2,1(R2,R9) ADD ONE TO LINE RESOURCE I.D. @V240820 01306000
STH R2,SAVEWRK3 SAVE THE VALUE FOR MESSAGES @V240820 01307000
EJECT 01308000
TM RDEVSTAT,RDEVNRDY IS THE NCP STILL ALIVE ? @V240820 01309000
BO SETDEAD NO -- DON'T PANIC OVER IT @V240820 01310000
TM RDEVFLAG,RDEVRCVY IS THE NCP STILL DYING ? @V240820 01311000
BO SETDEAD YES - LEAVE IT ALONE @V240820 01312000
TM RDEVFLAG,RDEVLNCP+RDEVLCEP MUST BE A PEP @V240820 01313000
BNO SETDEAD NO -- WE MISSED THE FUNERAL @V240820 01314000
MH R9,=AL2(NICSIZE*8) INDEX INTO THE NICBLOK LIST @V240820 01315000
AL R9,RDEVNICL GR9 = LINE NICBLOK ADDRESS @V240820 01316000
USING NICBLOK,R9 @V240820 01317000
TM NICSTAT,NICSWEP+NICEPMD STILL AS WE LEFT IT ? @V240820 01318000
BNO SETDEAD NO -- DO NOT DISTURB @V240820 01319000
LA R0,CSWLNCP SWITCH LINE MODE TO THE NCP @V240820 01320000
CALL DMKRNHND,PARM=0,AFFINITY SWITCH BACK TO NCP @V407510 01321000
BNZ SETDEAD BAIL OUT IF THE NCP DIES @V240820 01322000
LH R0,0(0,R1) SIZE OF THE RESPONSE BUFFER @V240820 01323000
CALL DMKFRET RETURN THE FREE STORAGE @V240820 01324000
NI NICSTAT,255-(NICDISA+NICEPMD) BACK IN NCP MODE @V240820 01325000
LA R9,NICSIZE*8(0,R9) FORWARD TO THE TERMINAL @V240820 01326000
NI NICSTAT,255-NICDISA TERMINAL IS BACK ONLINE @V240820 01327000
OI NICFLAG,NICSESN+NICENAB ENABLED AGAIN @V240820 01328000
OI SAVEWRK1,NCPTERM REMEMBER THE 370X NCP @V240820 01329000
DROP R9 @V240820 01330000
SPACE 01331000
SETUSER EQU * CREATE A TEMPORARY DUMMY USER @V240820 01332000
CALL DMKBLDVM,AFFINITY BUILD A VMBLOK AROUND RDEVBLOK @V407510 01333000
OI VMOSTAT,VMCF PREVENT ENTERING LOGOFF @VA01827 01334000
SPACE 01335000
CLI RDEVTYPC,CLASGRAF DIAL VIA A 3277 ? @V200820 01336000
BE SETGRAF YES - ADJUST FLAGS @V200820 01337000
CLI RDEVTYPC,CLASSPEC DROP FROM AN NCP LINE ? @V240820 01338000
BE SETMSG YES - FLAGS ARE ALL SET @V240820 01339000
NI RDEVTFLG,255-RDEVCTL TURN OFF CONTROL FLAG @V200820 01340000
NI RDEVFLAG,255-(RDEVACTV+RDEVPREP+RDEVHIO) @V200820 01341000
B SETMSG GO SEND DROP MESSAGES TO USERS @V200820 01342000
EJECT 01343000
SETDEAD EQU * COULD NOT RECOVER THE NCP LINE @V240820 01344000
OI SAVEWRK1,EPABORT REMEMBER THE SITUATION @V240820 01345000
B SETMSG CONTINUE NORMALLY FOR NOW @V240820 01346000
SPACE 01347000
SETGRAF EQU * SETUP FLAGS FOR DMKGRF @V200820 01348000
MVI RDEVTFLG,RDEVRUN SET TO RUNNING STATE @V200730 01349000
MVI RDEVCORD,00 WRITE AT LINE 00 @V200730 01350000
OI RDEVSTA3,RDEVEWRT An erase write required HRC071DK 01350100
SPACE 01351000
SETMSG EQU * SEND DROP MESSAGES @V200820 01352000
LA R0,MSGSIZE MESSAGE SIZE 01353000
CALL DMKFREE GET CORE FOR MESSAGES 01354000
LR R4,R1 ... 01355000
USING MSGDIAL,R4 USE OUR CONVENIENT DSECT 01356000
MVC MSGDIAL(8),BLANKS CLEAR IT 01357000
MVC MSGDIAL+8((MSGSIZE-1)*8),MSGDIAL 01358000
CLI RDEVTYPC,CLASSPEC DROP FROM A 370X NCP LINE ? @V240820 01359000
BE PEPTEXT YES - DIFFERENT TEXT IN MSG @V240820 01360000
TM RDEVADD,RDEVLDEV Is this an LDEV? HRC065DK 01360100
BO DROPLDEV Yes HRC065DK 01360200
CALL DMKSCNRN GET DEVICE NAME @V200730 01361000
ST R1,MSGDIAL SET DEVICE NAME IN MSG BUFFER @V240820 01362000
CALL DMKSCNRD RDEVBLOK IS STILL IN R8 01363000
CALL DMKCVTBH GET ADDRESS IN EBCDIC 01364000
STCM R1,B'0111',MSGRADD REAL ADDRESS TO MESSAGE 01365000
B GETUSER FINISH BUILDING USER MESSAGE @V240820 01366000
DROPLDEV EQU * HRC065DK 01366100
LH R1,RDEVADD Get the LDEV address HRC065DK 01366120
N R1,F4095 Keep only the dev num HRC065DK 01366140
CALL DMKCVTBH Make it displayable HRC065DK 01366160
STCM R1,7,MSGRADD Put dev addr in message HRC065DK 01366180
MVI MSGRADD-1,C'L' Move in LDEV indicator HRC065DK 01366200
MVC MSGDIAL(3),=CL3'GRF' Use short GRAF name HRC065DK 01366220
B GETUSER Go display msg HRC065DK 01366240
SPACE 01367000
PEPTEXT EQU * SETUP TYPE RADDR FOR PEP LINES @V240820 01368000
LH R1,SAVEWRK3 TERMINAL RESOURCE REFERENCE @V240820 01369000
CALL DMKCVTBH CONVERT FOR OUTPUT @V240820 01370000
L R0,=C'DEV ' 370X RESOURCE IS A 'DEV' @V240820 01371000
STM R0,R1,MSGDIAL SET TYPE AND REFERENCE IN MSG @V240820 01372000
* B GETUSER @V240820 01373000
EJECT 01374000
GETUSER EQU * FILL OUT MESSAGE FIELDS @V240820 01375000
MVC MSGFLD1(10),=C'DROP FROM ' ACTION CUE 01376000
LR R10,R11 SAVE VMBLOK CREATED BY BLDVM 01377000
* CPU TIMER DOES NOT MATCH CURRENT VMBLOK - OK IF CONTROL ISN'T LOST 01378000
L R11,SAVER11 BACK TO VMBLOK OF CALLER 01379000
MVC MSGUSER(8),VMUSER MOVE USERID TO MESSAGE 01380000
LR R9,R8 Save RDEVBLOK addr HRC065DK 01380100
L R8,SAVER8 VDEVBLOK ADDRESS 01381000
DROP R8 01382000
CALL DMKSCNVD GET VIRTUAL LINE ADDRESS 01383000
CALL DMKCVTBH CONVERT TO EBCDIC 01384000
STCM R1,B'0111',MSGVADD ...INTO MESSAGE 01385000
LR R11,R10 RESTORE VMBLOK - CPU TIMER MATCHES AGAIN 01386000
TM SAVEWRK1,EPABORT SHOULD WE SEND THE MESSAGE ?@V240820 01387000
BO OPERMSG NO -- JUST TELL THE OPERATOR@V240820 01388000
USING RDEVBLOK,R9 HRC065DK 01388100
TM RDEVADD,RDEVLDTR This LDEV terminating? HRC065DK 01388200
BO OPERMSG Yes, no msg to device HRC065DK 01388300
DROP R9 RDEVBLOK HRC065DK 01388400
LA R0,MSGVADD+4-MSGFLD1 SIZE FOR USER 01389000
LA R1,MSGFLD1 START OF MSG TO USER 01390000
CALL DMKQCNWT,PARM=PRIORITY+LOGHOLD WRITE, WAIT 01391000
SPACE 2 01392000
OPERMSG EQU * SEND DROP MESSAGE TO OPERATOR @V240820 01393000
LA R3,MSGSIZE FOR 'DFRET' LATER 01394000
MVC MSGVADD(8),=C'DIALED= ' OPERATOR CUE 01395000
L R2,=A(DMKSYSND) NUMBER OF DIALED USERS 01396000
L R1,0(0,R2) ... 01397000
S R1,F1 DECREMENT... 01398000
BNM *+6 DON'T LET IT GO NEGATIVE 01399000
SLR R1,R1 ... 01400000
ST R1,0(0,R2) RESET DIALED USER COUNT 01401000
CALL DMKCVTBD CONVERT TO DECIMAL FOR MSG 01402000
STCM R1,B'0111',MSGNDIL ... 01403000
LR R1,R4 MESSAGE ADDRESS @V240820 01404000
LA R0,MSGSIZE*8 ...LENGTH 01405000
CALL DMKQCNWT,PARM=NORET+DFRET+OPERATOR 01406000
DROP R4 01407000
EJECT 01408000
TM SAVEWRK1,EPABORT IS THERE A DUMMY VMBLOK ? @V240820 01409000
BO DROPEXT NO -- JUST EXIT GRACEFULLY @V240820 01410000
NI VMOSTAT,255-VMCF LET DSP CALL USO @VA01827 01411000
BAL R9,FRETVMB RELEASE DUMMY VMBLOK 01412000
DROPEXT EQU * @V240820 01413000
L R1,SAVER11 GET CALLER VMBLOK @V407510 01414000
SWTCHVM SWITCH BACK TO CALLER @V407510 01415000
DROPEXIT DS 0H @VA13704 01416000
EXIT ALL DONE 01417000
EJECT 01418000
* 01419000
* REMOVE VMBLOK FROM CHAIN OF ACTIVE VMBLOKS 01420000
* RETURN VMBLOK TO FREE STORAGE 01421000
* 01422000
FRETVMB EQU * REMOVE + FRET VMBLOK 01423000
LA R0,8 LENGTH OF USERID @VA13441 01424000
LA R1,VMUSER POINT TO USERID @VA13441 01425000
CALL DMKSCNAU SEE IF VMBLOK STILL VALID @VA13441 01426000
BMR R9 ALREADY GONE - RETURN @VA13441 01427000
BZ FRETVMB1 STILL THERE - NOW FRET IT @VA13441 01428000
TM VMRSTAT,VMLOGOFF IS LOGOFF IN PROCESS @VA13441 01429000
BOR R9 IF YES - BETTER DO NOTHING HERE @VA13441 01430000
TM VMOSTAT,VMKILL WILL DISPATCHER FORCE HIM OFF @VA13441 01431000
BOR R9 IF YES - STAY CLEAR OF FRETTING @VA13441 01432000
* VMBLOK 01433000
FRETVMB1 DS 0H @VA13441 01434000
L R2,ASYSVM THIS IS THE CHAIN ANCHOR @VA13441 01435000
CL R11,RUNUSER THIS IS EXTREMELY UNLIKELY 01436000
BNE FRETVM0 CHECK LASTUSER @V407510 01437000
ST R2,RUNUSER DON'T POINT AT FRET'ED BLOCK 01438000
B FRETVM1 START FREEING BLOK @V407510 01439000
FRETVM0 DS 0H @V407510 01440000
CL R11,LASTUSER SAME AS LASTUSER? @V407510 01441000
BNE FRETVM1 NO, START FREEING BLOK @V407510 01442000
ST R2,LASTUSER DON'T POINT AT FRET'ED BLOK @V407510 01443000
FRETVM1 EQU * HANDLE CHAIN ANCHOR PROBLEMS 01444000
L R3,VMPNT-VMBLOK(0,R2) FIRST USER AFTER ANCHOR 01445000
L R4,VMPNT USER AFTER OUR VMBLOK 01446000
CLR R4,R11 IF HE POINTS TO HIMSELF... 01447000
BNE FRETVM2 NO - GREAT 01448000
SLR R5,R5 ...ZERO ANCHOR BECAUSE NOBODY IS LEFT 01449000
B FRETVM3 ... 01450000
FRETVM2 EQU * NOW CHASE THE VMBLOK CHAIN 01451000
LR R5,R3 PREVIOUS BLOCK 01452000
L R3,VMPNT-VMBLOK(,R3) NEXT ONE... 01453000
CLR R3,R11 POINTED TO US THIS TIME ? 01454000
BNE FRETVM2 NO - KEEP CHASING 01455000
ST R4,VMPNT-VMBLOK(,R5) TAKE US OUT OF CHAIN 01456000
FRETVM3 EQU * NOW MOVE THE CHAIN ANCHOR JUST IN CASE 01457000
ST R5,VMPNT-VMBLOK(,R2) ...WE DELETED FIRST USER 01458000
XR R2,R11 EXCHANGE R11 & R2 @V4M0204 01459000
XR R11,R2 R11 = SYSTEM VMBLOK @V4M0204 01460000
XR R2,R11 R2 = VMBLOK TO BE FRET'D @V4M0204 01461000
CHARGE START CHARGE SYSTEM VMBLOK @V4M0204 01462000
L R1,VMDELAY-VMBLOK(,R2) @VA11836 01463000
LTR R1,R1 DO WE HAVE ONE? @VA08708 01464000
BZ FRETVM3A NO - DO NOT TRY TO FRET TRQ @VA08708 01465000
CLC TRQBFPNT-TRQBLOK(4,R1),ZEROES HAS THE TRQ BEEN @VA08708 01466000
* QUED? 01467000
BE FRETTRQ NO - GO FRET IT @VA08708 01468000
CALL DMKSCHRT YES - RESET IT THEN FRET IT @VA08708 01469000
FRETTRQ LA R0,TRQBSIZE LOAD TRQ SIZE FOR FRET @VA08708 01470000
CALL DMKFRET NOW GIVE IT BACK @VA08708 01471000
FRETVM3A EQU * @VA08708 01472000
L R1,VMDFTPNT-VMBLOK(,R2) GET DEFERRED POINTER @V4M0204 01473000
LTR R1,R1 DOES ONE EXIST? @V4M0204 01474000
BZ FRETVM4 NO, FRET VMBLOK @V4M0204 01475000
LA R0,CPEXSIZE GET SIZE OF DEFERRED BLOK @V4M0204 01476000
CALL DMKFRET FREE DEFERRED TASK BLOK @V4M0204 01477000
FRETVM4 DS 0H @V4M0204 01478000
LR R1,R2 GET ADDRESS OF VMBLOK @V4M0204 01479000
LA R0,VMBSIZE BLOCK SIZE = HUGE 01480000
MVI VMUSER-VMBLOK+7(R1),X'00' NULLIFY USERID @VA13441 01481000
CALL DMKFRET RELEASE THE VMBLOK 01482000
BR R9 RETURN TO CALLER 01483000
EJECT 01484000
*. 01485000
* SUBROUTINE NAME - 01486000
* 01487000
* DMKDIBCP - 'COUPLE' VIRTUAL CHANNEL-TO-CHANNEL ADAPTER@VA13704 01488000
* 01489000
* FUNCTION - 01490000
* 01491000
* TO ESTABLISH A VIRTUAL CONNECTION BETWEEN TWO VIRTUAL 01492000
* CHANNEL-TO-CHANNEL ADAPTERS, EITHER ON SEPARATE VIRTUAL 01493000
* MACHINES OR TWO ADAPTERS ON A SINGLE VIRTUAL MACHINE. 01494000
* 01495000
* COMMAND LINE FORMAT - 01496000
* 01497000
* +----------+-------------------------------+ 01498000
* | | | 01499000
* | COUPLE | VADDR <TO> USERID VADDR | 01500000
* | ---- | VADDR <TO> * VADDR | 01501000
* | | | 01502000
* +----------+-------------------------------+ 01503000
* 01504000
* ENTRY POINT - 01505000
* 01506000
* DMKDIBCP @VA13704 01507000
* 01508000
* ENTRY CONDITIONS - 01509000
* 01510000
* GPR 13 = ADDRESS OF STANDARD SAVE-AREA 01511000
* GPR 12 = ADDRESS OF DMKDIBCP @VA13704 01512000
* GPR 11 = ADDRESS OF CALLER'S VMBLOK 01513000
* GPR 9 = ADDRESS OF COMMAND BUFFER 01514000
* 01515000
* EXIT CONDITIONS - 01516000
* 01517000
* GPR 2 = ERROR CODE, OR ZERO IF NO ERRORS 01518000
* 01519000
* IF GPR 2 = 0, THE TWO CTCA'S SPECIFIED HAVE BEEN 01520000
* COUPLED TOGETHER AND ARE READY FOR USE BY THE VM. 01521000
* 01522000
* CALLS TO OTHER ROUTINES - 01523000
* 01524000
* DMKSCNFD 01525000
* DMKSCNVU 01526000
* DMKSCNAU 01527000
* DMKQCNWT 01528000
* DMKCVTHB 01529000
* DMKCVTBH 01530000
* DMKFREE 01531000
* DMKERMSG 01532000
* DMKVCARS 01533000
* 01534000
* EXTERNAL REFERENCES - NONE 01535000
* 01536000
* TABLES / WORK AREAS - 01537000
* 01538000
* VDEVBLOK, VCUBLOK, CHXBLOK, CHYBLOK 01539000
* 01540000
* REGISTER USAGE - 01541000
* 01542000
* GPR 13 = SAVE-AREA ADDRESSABILITY 01543000
* GPR 12 = MODULE BASE ADDRESSABILITY 01544000
* GPR 11 = VMBLOK ADDRESS OF X-SIDE USER 01545000
* GPR 10 = VMBLOK ADDRESS OF Y-SIDE USER 01546000
* GPR 9 = COMMAND BUFFER ADDRESS 01547000
* GPR 8 = VDEVBLOK ADDRESS, X-SIDE CTCA 01548000
* GPR 7 = VDEVBLOK ADDRESS, Y-SIDE CTCA 01549000
* GPRS 0-6 ARE WORK REGISTERS 01550000
* 01551000
* NOTES - 01552000
* 01553000
* THE 'CHXBLOK' AND 'CHYBLOK' CREATED BY DMKDIBCP IS IN @VA13704 01554000
* REALITY A SINGLE CONTROL BLOCK, ADDRESSED VIA TWO 01555000
* IDENTICAL DSECT'S FOR SYMMETRY. (SEE ACTUAL DSECTS) 01556000
* 01557000
* OPERATION - 01558000
* 01559000
* 1. THE COMMAND LINE IS SCANNED FOR ALL REQUIRED PARMS 01560000
* AND THE SPECIFIED DEVICES ARE CHECKED TO INSURE THAT 01561000
* THEY ARE CHANNEL-TO-CHANNEL ADAPTERS AND ARE AVAILABLE 01562000
* FOR USE. ERROR MESSAGES ARE TYPED IF ANY CHECKS FAIL. 01563000
* 01564000
* 2. THE INTERMEDIATE CONTROL BLOCKS, CHXBLOK AND CHYBLOK, 01565000
* ARE ALLOCATED FROM FREE STORAGE AND CONNECTED TO THE 01566000
* VDEVBLOKS OF THE X-SIDE AND Y-SIDE ADAPTERS. THE NOT- 01567000
* READY BIT IN THE VDEVBLOKS IS REMOVED AND THE ADAPTERS 01568000
* ARE READY FOR VIRTUAL MACHINE USE. VERIFICATION MESSAGES 01569000
* ARE SENT TO BOTH THE X-SIDE AND Y-SIDE USERS. 01570000
* 01571000
* RESPONSES - 01572000
* 01573000
* 'CTCA VADDR COUPLE TO USERID1 VADDR' (X-SIDE) 01574000
* 01575000
* 'CTCA VADDR COUPLE BY USERID2 VADDR' (Y-SIDE) 01576000
* 01577000
* ERROR MESSAGES - 01578000
* 01579000
* DMKDIB006E INVALID DEVICE TYPE - VADDR @VA13704 01580000
* DMKDIB011E INVALID DEVICE TYPE - $USERID$ VADDR @VA13704 01581000
* DMKDIB020E USERID MISSING OR INVALID @VA13704 01582000
* DMKDIB022E VADDR MISSING OR INVALID @VA13704 01583000
* DMKDIB040E DEV VADDR DOES NOT EXIST @VA13704 01584000
* DMKDIB045E $USERID$ NOT LOGGED ON @VA13704 01585000
* DMKDIB047E $USERID$ VADDR DOES NOT EXIST @VA13704 01586000
* DMKDIB058E CTCA VADDR BUSY ON $USERID$ @VA13704 01587000
*. 01588000
EJECT 01589000
DMKDIBCP RELOC , "COUPLE VADDR TO USERID VADDR" @VA13704 01590000
SPACE 2 01591000
MVI SAVEWRK1,X'00' CLEAR A FLAG BYTE 01592000
LA R6,INVVADD RETURN IF NO OPERAND FOUND @V240820 01593000
BAL R10,SCANCVT SCAN AND CONVERT DEVICE ADDRESS @V240820 01594000
SPACE 01595000
CALL DMKSCNFD SECOND PARM = OPTION 'TO' 01596000
BNZ NOUSRID USERID MISSING OR INVLAID 01597000
LR R2,R0 01598000
BCTR R2,0 DECREMENT COUNT FOR EXECUTED COMPARE 01599000
EX R2,CLCOPTO CLC 0(*-*,R1),=C'TO ' 01600000
BNE DIACPUSR MUST BE A USERID 01601000
CALL DMKSCNFD SCAN FOR USERID 01602000
BNZ NOUSRID 01603000
DIACPUSR EQU * FIND SPECIFIED USER VMBLOK 01604000
CLC 0(2,R1),=C'* ' WRAP CONNECTION TO HIMSELF ? 01605000
BNE DIACPOTH NO 01606000
LR R10,R11 SAME VMBLOK FOR BOTH DEVICES 01607000
OI SAVEWRK1,CTCWRAP REMEMBER SPECIAL COUPLE @VA02003 01608000
B DIACPAD2 GO GET SECOND VADDR 01609000
EJECT 01610000
DIACPOTH EQU * LOCATE VMBLOK OF REMOTE USER 01611000
CALL DMKSCNAU 01612000
BC 2,NOUSRID USERID INVALID 01613000
BC 5,NOTLOGD NOT LOGGED ON, OR WON'T BE SOON 01614000
LR R10,R1 SAVE VMBLOK ADDRESS IN GPR10 01615000
CLR R10,R11 WRAP CONNECTION TO HIMSELF ? 01616000
BNE DIACPAD2 NO - 01617000
OI SAVEWRK1,CTCWRAP INDICATE WRAP TO HIMSELF @VA02003 01618000
DIACPAD2 EQU * SCAN FOR REMOTE VADDR 01619000
ST R10,SAVEWRK5 SAVE ADDRESS OF REMOTE VMBLOK @V240820 01620000
BAL R14,SWPUSER SWITCH TO REMOTE VMBLOK @V240820 01621000
LA R6,INVVADD RETURN IF NO OPERAND @V240820 01622000
BAL R10,SCANCVT SCAN AND CONVERT DEVICE ADDRESS @V240820 01623000
BAL R14,SWPCALL BACK TO THE CALLER'S VMBLOK @V240820 01624000
L R10,SAVEWRK5 RESTORE ADDR OF REMOTE VMBLOK @VM01004 01625000
SPACE 01626000
LH R1,SAVEWRK2 VADDR OF LOCAL CTCA 01627000
CALL DMKSCNVU FIND THE VDEVBLOK 01628000
USING VDEVBLOK,R8 01629000
CLC VDEVTYPC(2),=AL1(CLASSPEC,TYPCTCA) 01630000
BNE BADVADD2 INVALID DEVICE TYPE - VADDR 01631000
TM VDEVSTAT,VDEVDED IS THE DEVICE DEDICATED ? 01632000
BO BADVADD2 YES - WE CAN'T DO THAT 01633000
CALL DMKCFPRD RESET LOCAL CTCA 01634000
CALL DMKVCARS RELEASE ANY PREVIOUS CONNECTION 01635000
LA R0,CPEXSIZE GET FREE STORAGE FOR A CPEXBLOK 01636000
CALL DMKFREE .. 01637000
LA R15,DIACPGO EXECTUION ADDRESS AFTER DELAY 01638000
STM R15,R14,CPEXADD-CPEXBLOK(R1) SET ADDR, REGISTERS 01639000
XC 0(12,R1),0(R1) CLEAR CPEXFPNT, CPEXBPNT, CPEXMISC 01640000
CALL DMKSTKCP STACK BLOCK FOR SEQUENCING DELAY 01641000
GOTO DMKDSPCH WAIT FOR THINGS TO QUIET DOWN 01642000
EJECT 01643000
DIACPGO EQU * RETURN AFTER NECESSARY DELAY 01644000
BAL R14,SWPUSER SWITCH TO REMOTE VMBLOK 01645000
LH R1,SAVEWRK2+2 VADDR OF REMOTE CTCA 01646000
CALL DMKSCNVU FIND THE VDEVBLOK 01647000
CLC VDEVTYPC(2),=AL1(CLASSPEC,TYPCTCA) 01648000
BNE BADVADD INVALID DEVICE TYPE - USERID VADDR 01649000
TM VDEVSTAT,VDEVDED IS IT DEDICATED ? 01650000
BO BADVADD YES - WE CAN'T DO THAT 01651000
TM VDEVSTAT,VDEVNRDY THIS IS SET IF DEVICE IS AVAILABLE 01652000
BZ CTCBUSY CTCA VADDR BUSY ON USERID 01653000
TM SAVEWRK1,CTCWRAP COUPLE TO HIMSELF ? @VA02003 01654000
BZ DIADBLCK NO -- SKIP DOUBLE-CHECK 01655000
CLC SAVEWRK2(2),SAVEWRK2+2 WRAP TO SAME DEVICE ? 01656000
BE CTCBUSY YES - CALL THE DEVICE BUSY 01657000
DIADBLCK EQU * ALL SET TO CONNECT THE ADAPTERS 01658000
BAL R14,SWPCALL GO BACK TO CALLER'S VMBLOK 01659000
LH R1,SAVEWRK2 VADDR OF LOCAL CTCA 01660000
CALL DMKSCNVU GET THE VDEVBLOK AGAIN 01661000
LA R0,CHBSIZE SIZE OF INTERCONNECTOR BLOCK 01662000
CALL DMKFREE GET FREE STORAGE FOR VIRTUAL CABLES 01663000
LR R9,R1 ADDRESS VIA GR9 01664000
USING CHXBLOK,R9 ... 01665000
XC CHXBLOK(CHBSIZE*8),CHXBLOK CLEAR ENTIRE BLOCK 01666000
ST R9,VDEVREAL PLUG IN THE X-SIDE 01667000
ST R10,CHXOTHR CONNECT Y-SIDE VMBLOK 01668000
LH R1,SAVEWRK2+2 Y-SIDE VADDR 01669000
STH R1,CHXYADD ...NEEDED BY X-SIDE ADAPTER 01670000
NI VDEVSTAT,X'FF'-VDEVNRDY THIS SIDE NOW READY 01671000
LA R9,4(0,R9) FLIP TO Y-SIDE BLOCK 01672000
USING CHYBLOK,R9 ... 01673000
L R1,SAVEWRK5 GET REMOTE VMBLOK ADDRESS @V407510 01674000
SWTCHVM SWITCH TO REMOTE USER @V407510 01675000
LH R1,SAVEWRK2+2 GET Y-SIDE VADDR FOR DMKSCNVU @V4M0170 01676000
CALL DMKSCNVU GET REMOTE VDEVBLOK (VADDR IS IN R1) 01677000
ST R9,VDEVREAL PLUG IN THE Y-SIDE 01678000
L R1,SAVER11 ADDRESS OF X-SIDE VMBLOK 01679000
ST R1,CHYOTHR SET FOR USE FROM Y-SIDE 01680000
LH R1,SAVEWRK2 X-SIDE VADDR 01681000
STH R1,CHYXADD ...NEEDED BY Y-SIDE ADAPTER 01682000
NI VDEVSTAT,X'FF'-VDEVNRDY NOW THIS SIDE IS READY 01683000
DROP R9 01684000
EJECT 01685000
MVC SAVEWRK8(8),BLANKS BLANK OUT THESE FIELDS @VA08677 01686000
MVC SAVEWRK9(3),SAVEWRK3+1 MOVE LOCAL VADDR DOWN @V240820 01687000
MVC SAVEWRK3(4),SAVEWRK4 MOVE REMOTE VADDR UP @V240820 01688000
MVC SAVEWRK2(4),=C'CTCA' NOW FILL IT OUT 01689000
MVC SAVEWRK4(12),=C' COUPLE BY ' 01690000
TM SAVEWRK1,CTCWRAP COUPLING TWO LOCAL CTCA'S @VA02003 01691000
BO DIACPLOC YES -- SKIP DOUBLE MESSAGES 01692000
L R11,SAVER11 GET CALLER'S VMBLOK JUST LONG ENOUGH... 01693000
MVC SAVEWRK6+3(8),VMUSER ...TO GET THE X-SIDE USERID 01694000
LR R11,R10 BACK TO REMOTE VMBLOK 01695000
LA R0,SAVEWRK9+3-SAVEWRK2 DATA LENGTH @VM01044 01696000
LA R1,SAVEWRK2 MSG START 01697000
CALL DMKQCNWT,PARM=NORET 01698000
DIACPLOC EQU * SEND MESSAGE ONLY ONCE 01699000
L R1,SAVER11 GET CALLER'S VMBLOK @V407510 01700000
SWTCHVM SWITCH BACK TO CALLER @V407510 01701000
L R1,SAVEWRK3 NOW SWAP THE TWO ADDRESSES 01702000
L R2,SAVEWRK9 ...FOR LOCAL USER MESSAGE 01703000
STCM R1,B'0111',SAVEWRK9 ... 01704000
STCM R2,B'1110',SAVEWRK3+1 01705000
MVC SAVEWRK6(3),=C'TO ' CHANGE THE PARTICIPLE 01706000
MVC SAVEWRK6+3(8),VMUSER-VMBLOK(R10) 01707000
LA R0,SAVEWRK9+3-SAVEWRK2 DATA LENGTH @VM01044 01708000
LA R1,SAVEWRK2 ADDRESS 01709000
CALL DMKQCNWT,PARM=NORET SEND LOCAL USER MESSAGE 01710000
SLR R2,R2 01711000
ST R2,SAVER2 ZERO RETURN CODE 01712000
EXIT , RETURN TO DMKCFM 01713000
SPACE 01714000
CLCOPTO CLC 0(*-*,R1),=C'TO ' OPTIONAL WORD TEST 01715000
EJECT 01716000
SWPUSER EQU * SWITCH TO OBJECTIVE VMBLOK 01717000
ST R14,SAVEWRK6 SAVE R14 ACROSS CHARGE @V4M0116 01718000
CHARGE SWITCH,SAVEWRK5 CHARGE 'OTHER' VMBLOK @V407510 01719000
L R14,SAVEWRK6 RESTORE REG 14 @V4M0116 01720000
BR R14 01721000
SPACE 01722000
SWPCALL EQU * SWITCH TO CALLER'S VMBLOK 01723000
ST R14,SAVEWRK6 SAVE R14 ACROSS CHARGE @V4M0116 01724000
CHARGE SWITCH,SAVER11 CHARGE CALLER @V407510 01725000
L R14,SAVEWRK6 RESTORE REG 14 @V4M0116 01726000
BR R14 01727000
SPACE 2 01728000
SCANCVT EQU * SCAN AND CONVERT DEVICE ADDRESS @V240820 01729000
CALL DMKSCNFD SCAN FOR THE NEXT OPERAND @V240820 01730000
BNZR R6 ERROR EXIT IF NOT FOUND @V240820 01731000
CL R0,F3 THREE CHARACTERS MAXIMUM @V240820 01732000
BH INVVADD INVALID VADDR @V240820 01733000
CALL DMKCVTHB CONVERT ADDRESS TO BINARY @V240820 01734000
BNZ INVVADD CONVERT FAILED - INVALID @V240820 01735000
MAXDV R15 GET MAXIMUM VALID ADDRESS IN GR15@V240820 01736000
CLR R1,R15 IS THE DEVICE ADDRESS POSSIBLE ? @V240820 01737000
BH INVVADD NO -- KICK IT OUT @V240820 01738000
LR R6,R1 REMEMBER ADDRESS FOR DMKSCNVU @V240820 01739000
CALL DMKCVTBH RE-CONVERT IT FOR MESSAGES @V240820 01740000
ICM R1,8,BLANKS GET A HIGH-ORDER BLANK @V240820 01741000
TM SAVEWRK1,FIRSTAD IS THIS THE FIRST PASS ? @V240820 01742000
BO SCANTWO NO -- USE REMOTE SLOTS @V240820 01743000
OI SAVEWRK1,FIRSTAD REMEMBER THE FIRST PASS @V240820 01744000
STH R6,SAVEWRK2 SAVE 'LOCAL' DEVICE ADDRESS @V240820 01745000
ST R1,SAVEWRK3 SAVE EBCDIC EQUIVALENT OF ADDRESS@V240820 01746000
B SCANSCN TRY TO FIND THE VIRTUAL BLOCKS @V240820 01747000
SCANTWO EQU * SAVE VALUES FOR REMOTE DEVICE @V240820 01748000
STH R6,SAVEWRK2+2 SLOT FOR REMOTE VIRTUAL ADDRESS @V240820 01749000
ST R1,SAVEWRK4 SLOT FOR EBCDIC EQUIVALENT @V240820 01750000
SCANSCN EQU * FIND THE VIRTUAL BLOCKS @V240820 01751000
LR R1,R6 ADDRESS BACK TO GR1 @V240820 01752000
CALL DMKSCNVU SCAN FOR THE DEVICE @V240820 01753000
BNZ UNKNOWN DEVICE DOES NOT EXIST @V240820 01754000
BR R10 RETURN INTERNALLY @V240820 01755000
EJECT 01756000
UNKNWN2 EQU * DEV VADDR DOES NOT EXIST 01757000
LA R2,040(,0) MSG= DMKDIB040E @VA13704 01758000
B VADONLY SET UP VARIABLE DATA 01759000
SPACE 01760000
BADVADD2 EQU * INVALID DEVICE TYPE - VADDR 01761000
LA R2,006(,0) MSG= DMKDIB006E @VA13704 01762000
VADONLY EQU * SET VARIABLE 'VADDR' 01763000
CALL DMKCVTBH CONVERT 01764000
STCM R1,B'0111',SAVEWRK2 01765000
LA R0,3 LENGTH 01766000
B MSGSEND 01767000
SPACE 01768000
NOUSRID EQU * USERID MISSING OR INVALID 01769000
LA R2,020(,0) MSG= DMKDIB020E @VA13704 01770000
B MSGONLY NO EXTRA DATA NEEDED 01771000
SPACE 01772000
NOTLOGD EQU * USERID NOT LOGGED ON 01773000
MVC SAVEWRK2(8),BALRSAVE USERID LEFT BY 'SCNAU' 01774000
LA R0,8 DATA LENGTH 01775000
LA R2,045(,0) MSG= DMKDIB045E @VA13704 01776000
B MSGSEND 01777000
SPACE 01778000
INVVADD EQU * VIRTUAL ADDRESS MISSING OR INVALID 01779000
LA R2,022(,0) MSG= DMKDIB022E @VA13704 01780000
B MSGONLY NO EXTRA DATA NEEDED 01781000
SPACE 01782000
CTCBUSY EQU * CTCA VADDR BUSY ON USERID 01783000
LA R2,058(,0) MSG= DMKDIB058E @VA13704 01784000
VADDUSR EQU * SET VARIABLES 'VADDR USERID' 01785000
CALL DMKSCNVD GET DEVICE ADDRESS IN 'CCU' FORM 01786000
CALL DMKCVTBH CONVERT TO HEX 01787000
STCM R1,B'0111',SAVEWRK2 01788000
MVI SAVEWRK2+3,X'00' DELIMITER 01789000
MVC SAVEWRK3(8),VMUSER SECOND FIELD 01790000
LA R0,12 DATA LENGTH 01791000
B MSGSEND SEND ERROR MSG AND EXIT @VA03704 01792000
EJECT 01793000
BADVADD EQU * VIRTUAL DEVICE IS NOT A LINE 01794000
LA R2,011(,0) MSG= DMKDIB011E @VA13704 01795000
B USRVADD SET UP VARIABLE STRING 01796000
SPACE 01797000
UNKNOWN EQU * USERID VADDR DOES NOT EXIST 01798000
CH R1,SAVEWRK2 IS THIS THE LOCAL DEVICE ? @VA02009 01799000
BE UNKNWN2 YES - DIFFERENT MESSAGE @V240820 01800000
LA R2,047(,0) MSG= DMKDIB047E @VA13704 01801000
USRVADD EQU * SET VARIABLES 'USERID VADDR' 01802000
MVC SAVEWRK2(8),VMUSER 01803000
MVI SAVEWRK4,X'00' DELIMITER 01804000
LA R0,12 01805000
B MSGSEND 01806000
SPACE 01807000
MSGONLY EQU * NO DATA TO BE ADDED TO MESSAGE 01808000
SLR R0,R0 01809000
SLR R1,R1 01810000
B MSGSEND+4 01811000
SPACE 01812000
MSGSEND EQU * SEND ERROR MSG TO USER 01813000
LA R1,SAVEWRK2 POINT TO START OF VARIABLE DATA 01814000
BAL R14,SWPCALL BACK TO CALLER'S VMBLOK 01815000
ICM R0,B'1110',DMKDIB+3 MODULE IDENTIFIER @VA13704 01816000
ST R2,SAVER2 PASS RETURN CODE BACK TO DMKCFM @V240820 01817000
LA R14,707(0) @VA09464 01818000
CR R14,R2 DOES R2 CONTAIN 707 MESSAGE ? @VA09464 01819000
BNE MSGBLD NO, DON'T PUT'A' IN MESSAGE @VA09464 01820000
ICM R2,4,=X'C1' DMKDIB707A @VA13704 01821000
MSGBLD ICM R2,8,=X'80' RETURN HERE AFTER ERROR MESSAGE @VA09464 01822000
CALL DMKERMSG BUILD + TYPE ERROR MESSAGE 01823000
B DROPEXIT CHECK FOR CLEAN-UP WORK TO DO @VA13704 01824000
EJECT 01825000
* 01826000
* MESSAGE MODEL FOR USER AND OPERATOR RESPONSES 01827000
* 01828000
SPACE 01829000
MSGDIAL DSECT 01830000
DC C'LINE ' REAL DEVICE TYPE 01831000
MSGRADD DC C'XXX ' " " " ADDRESS 01832000
MSGFLD1 DC C'DIALED TO ' ACTIVITY CUE 01833000
MSGUSER DC C'$USERID$ ' DIAL-ED USER 01834000
MSGVADD DC C'XXX ' DIAL-ED VIRTUAL ADDRESS 01835000
ORG MSGVADD ...OR... 01836000
DC C'DIALED= ' OPERATOR INFO 01837000
MSGNDIL DC C'NNN' NO. OF DIALED USERS 01838000
ORG 01839000
MSGSIZE EQU (*-MSGDIAL+7)/8 BUFFER LENGTH 01840000
SPACE 2 01841000
* EQUATES USED IN 'SAVEWRK1' FLAG BYTE: @V240820 01842000
GRAPHIC EQU X'80' DIAL VIA GRAPHIC TERMINAL @V240820 01843000
STRTSTP EQU X'40' DIAL VIA 270X/EMULATOR TERMINAL @V240820 01844000
NCPTERM EQU X'20' DIAL VIA PEP/NCP TERMINAL @V240820 01845000
FIRSTAD EQU X'10' FIRST ADDRESS HAS BEEN SCANNED @V240820 01846000
DYNABLK EQU X'08' DYNAMIC RDEVBLOK IS RESERVED @V240820 01847000
MSGFRET EQU X'04' MESSAGE BUFFER IS IN USE @V240820 01848000
CTCWRAP EQU X'02' 'COUPLE' FOR TWO LOCAL CTCA'S @VA02003 01849000
EPABORT EQU X'01' SWITCH TO EP-MODE FAILED @V240820 01850000
SPACE 2 01851000
DMKDIB CSECT , RE-ENTER PROGRAM CSECT @VA13704 01852000
EJECT 01853000
LTORG 01854000
EJECT 01855000
COPY VCTCA VIRTUAL CHANNEL-TO-CHANNEL ADAPTER BLOCKS 01856000
COPY TIMER @V200730 01857000
COPY NETWORK @V240820 01858000
COPY BTUCMD @V240820 01859000
COPY EQU 01860000
COPY DEVTYPES 01861000
PSA 01862000
COPY SAVE 01863000
COPY VMBLOK 01864000
COPY RBLOKS 01865000
COPY VBLOKS 01866000
COPY IOBLOKS 01867000
COPY IOER 01868000
END DMKDIB @VA13704 01869000