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 USERID VADDR | 01500000 * | ---- | VADDR * 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