ibm:vm370-lib:cp:dmkdib.assemble_src
Table of Contents
DMKDIB Source
References
- Fixes Applied : 11
- This Source Date : Thursday, December 7, 1978
- Last Fix ID : [HRC071DK]
Source Listing
- DMKDIB.ASSEMBLE.txt
- 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
ibm/vm370-lib/cp/dmkdib.assemble_src.txt · Last modified: 2023/08/06 13:36 by Site Administrator