DIA TITLE 'DMKDIA (CP) VM/370 - RELEASE 6' 00001000 ISEQ 73,80 VALIDATE SEQUENCING OF SYSIN 00002000 COPY OPTIONS 00003000 COPY LOCAL 00004000 *. 00005000 * MODULE NAME - 00006000 * 00007000 * DMKDIA 00008000 * 00009000 * CONTENTS - 00010000 * 00011000 * DMKDIAL - 'DIAL' A VIRTUAL MULTI-ACCESS SYSTEM 00012000 *. 00016000 SPACE 2 00017000 DMKDIA START 00018000 SPACE 00019000 DC CL8'DMKDIA' PAGEABLE MODULE IDENTIFIER 00020000 SPACE 00021000 USING PSA,R0 00022000 USING VMBLOK,R11 00023000 USING SAVEAREA,R13 00024000 SPACE 00025000 EXTRN DMKCVTBH,DMKCVTHB,DMKCVTBD @V240820 00026000 EXTRN DMKSCNFD,DMKSCNRD,DMKSCNRU @V240820 00027000 EXTRN DMKSCNVU,DMKSCNAU,DMKSCNVD @V240820 00028000 EXTRN DMKIOSQR,DMKIOSHA,DMKERMSG @V240820 00029000 EXTRN DMKSCNRN @VA13704 00030000 EXTRN DMKSTKIO @VA13704 00030700 EXTRN DMKVIOIN,DMKRNHND @VA13704 00031400 EXTRN DMKQCNCL,DMKQCNWT @V407510 00033000 EXTRN DMKCVTAB @VA04301 00033100 EXTRN DMKSCHRT,DMKDIBDR @VA13704 00033200 EXTRN DMKQCNSY SYNCHRONIZE CONTASKS @VA11241 00033600 SPACE 00034000 EXTRN DMKSYSCK,DMKSYSND @VA13704 00035000 ENTRY DMKDIAIR @VA05089 00035500 EJECT 00036000 *. 00037000 * SUBROUTINE NAME - 00038000 * 00039000 * DMKDIAL - 'DIAL' A VIRTUAL MULTI-ACCESS SYSTEM 00040000 * 00041000 * FUNCTION - 00042000 * 00043000 * TO ATTACH A USER'S TERMINAL AS A DEDICATED DEVICE TO AN 00044000 * EXISTING VIRTUAL 270X TERMINAL LINE IN THE VIRTUAL 00045000 * MACHINE ADDRESSED BY THE COMMAND LINE. 00046000 * 00047000 * COMMAND LINE FORMAT - 00048000 * 00049000 * +--------+-------------------+ 00050000 * | | | 00051000 * | DIAL | USERID | 00052000 * | | | 00053000 * +--------+-------------------+ 00054000 * 00055000 * ENTRY CONDITIONS - 00056000 * 00057000 * GPR 2 = 0 00058000 * GPR 9 = ADDRESS OF COMMAND BUFFER 00059000 * GPR 11 = ADDRESS OF USER'S VMBLOK 00060000 * GPR 12 = ADDRESS OF DMKDIAL 00061000 * GPR 13 = ADDRESS OF STANDARD SAVE AREA 00062000 * 00063000 * EXIT CONDITIONS - 00064000 * 00065000 * IF THE COMMAND LINE WAS IN ERROR, OR IF THE CONNECT 00066000 * COULD NOT BE MADE, RETURNS TO CP370 WITH THE USER NOT 00067000 * YET LOGGED IN OR DIALED TO ANY SYSTEM. 00068000 * 00069000 * IF THE DIAL WAS COMPLETED, EXITS WITH THE SPECIFIED 00070000 * CONNECTION MADE, GPR 11 = VMBLOK OF DIAL-ED SYSTEM 00071000 * 00072000 * CALLS TO OTHER ROUTINES - 00073000 * 00074000 * DMKSCNFD 00075000 * DMKSCNRN 00076000 * DMKSCNRD 00077000 * DMKSCNVU 00078000 * DMKSCNAU 00079000 * DMKQCNWT 00080000 * DMKQCNSY 00080500 * DMKDSPCH 00081000 * DMKCVTBH 00082000 * DMKCVTBD 00083000 * DMKCVTHB 00084000 * DMKIOSQR 00085000 * DMKFREE 00086000 * DMKFRET 00087000 * 00088000 EJECT 00089000 * EXTERNAL REFERENCES - 00090000 * 00091000 * DMKSYSND - NUMBER OF DIALED USERS 00092000 * DMKVIOIN - INTERRUPT RETURN FOR DEDICATED DEVICES 00093000 * 00094000 * TABLES / WORK AREAS - NONE 00095000 * 00096000 * REGISTER USAGE - 00097000 * 00098000 * GPR 6 = ADDRESS OF VCHBLOK 00099000 * GPR 7 = ADDRESS OF VCUBLOK 00100000 * GPR 8 = ADDRESS OF VDEVBLOK 00101000 * GPR 9 = ADDRESS OF COMMAND BUFFER 00102000 * GPR 11 = ADDRESS OF USER'S VMBLOK 00103000 * GPR 12 = BASE REGISTER 00104000 * GPR 13 = ADDRESS OF STANDARD SAVE AREA 00105000 * 00106000 * NOTES - NONE 00107000 * 00108000 * OPERATION - 00109000 * 00110000 * 1. CHECKS COMMAND LINE (VIA DMKSCNFD) FOR PRESENCE OF 00111000 * SPECIFIED USERID (ERROR MESSAGE AND RETURN IF NOT PRESENT). 00112000 * CHECKS FOR SPECIFIED USERID ON RUNNING SYSTEM VIA DMKSCNAU 00113000 * (ERROR MESSAGE AND RETURN IF NOT ON SYSTEM). 00114000 * CHECKS THAT SPECIFIED USERID HAS ENABLED COMMUNICATIONS 00115000 * LINES AVAILABLE FOR USE (ERROR MESSAGE AND RETURN IF NOT). 00116000 * 00117000 * 2. IF ALL OF THE ABOVE CHECKS ARE SUCCESSFUL, CONNECTS 00118000 * RDEVBLOK OF THE DIAL-ER'S TERMINAL TO THE VDEVBLOK 00119000 * OF THE SLECTED LINE. AFTER THE DIAL VERIFICATION MESSAGE 00120000 * IS COMPLETE, THE DIAL-ER'S VMBLOK IS REMOVED FROM THE 00121000 * VMBLOK CHAIN AND RETURNED TO FREE STORAGE VIA DMKFRET. 00122000 * THE IOBLOK FOR THE VIRTUAL ENABLE SEQUENCE IS PICKED 00123000 * UP FROM THE VDEVBLOK AND STARTED VIA DMKIOSQR. RETURN 00124000 * IS MADE TO DMKCFM WITH THE VMBLOK OF THE DIAL-ED SYSTEM 00125000 * IN GPR 11 . 00126000 * 00127000 * RESPONSES - 00128000 * 00129000 * 'DIALED TO USERID AT CCU' 00130000 * 00131000 * 'LINE RADDR DIALED TO USERID DIALED= NNN' 00132000 * 00133000 * ERROR MESSAGES - 00134000 * 00135000 * DMKDIA011E INVALID DEVICE TYPE - $USERID$ VADDR 00136000 * DMKDIA020E USERID MISSING OR INVALID 00137000 * DMKDIA022E VADDR MISSING OR INVALID 00138000 * DMKDIA045E $USERID$ NOT LOGGED ON 00139000 * DMKDIA047E $USERID$ VADDR DOES NOT EXIST 00140000 * DMKDIA055E LINE(S) NOT AVAILABLE ON $USERID$ 00141000 * DMKDIA056E LINE VADDR BUSY ON $USERID$ 00142000 * DMKDIA098E DEV RID MODE SWITCH NOT POSSIBLE 00143000 *. 00144000 * DMKDIA707E DIAL FUNCTION NOT AVAILABLE 00145000 EJECT 00146000 DMKDIAL RELOC , "DIAL USERID " 00147000 XC SAVEWRK1(4),SAVEWRK1 CLEAR WORK AREAS @V240820 00148000 XC SAVEWRK2(8*4),SAVEWRK2 . . . @V240820 00149000 L R1,VMDELAY GET DELAY. @VA12101 00149100 LTR R1,R1 IS THERE A DELAY? @VA12101 00149110 BZ NOTRQ NO, CONTINUE. @VA12101 00149120 CALL DMKSCHRT UNCHAIN IT. @VA12101 00149130 LA R0,TRQBSIZE GET SIZE. @VA12101 00149140 CALL DMKFRET @VA12101 00149150 SR R1,R1 CLEAR REG. @VA12101 00149160 ST R1,VMDELAY ZERO VMDELAY. @VA12101 00149170 NOTRQ EQU * @VA12101 00149180 LM R0,R1,SAVER0 RESTORE REGS. @VA12101 00149190 SPACE 00150000 CALL DMKSCNFD GET USERID FROM COMMAND LINE 00151000 BNZ NOUSRID NOT SPECIFIED - ERROR 00152000 CALL DMKSCNAU FIND VMBLOK OF DIAL-ED USER 00153000 BC 2,NOUSRID USERID FIELD IS INVALID 00154000 BC 5,NOTLOGD HE'S NOT THERE, OR WON'T BE SOON 00155000 SWITCH SWITCH TO MAIN PROCESSOR @V407510 00155100 ST R1,SAVEWRK5 SAVE DIAL-ED VMBLOK ADDRESS @V240820 00156000 L R6,VMTERM RDEVBLOK ADDRESS OF DIALER @V240820 00157000 USING RDEVBLOK,R6 @V240820 00158000 TM RDEVADD,RDEVLDEV Is this an LDEV? HRC065DK 00158100 BZ NOTLDEV No, normal process then HRC065DK 00158200 PUSH USING HRC065DK 00158300 USING LDEVBLOK,R6 HRC065DK 00158400 C R1,LDEVUSER LDEV user trying to DIALHRC065DK 00158500 BE ERROR66 creator machine? Yes..HRC065DK 00158600 POP USING LDEVBLOK HRC065DK 00158700 NOTLDEV EQU * HRC065DK 00158800 ST R6,SAVEWRK8 SAVE THE ADDRESS FOR LATER @V240820 00159000 SPACE 00160000 MVI SAVEWRK1,GRAPHIC ASSUME GRAPHIC TERMINAL @V240820 00161000 TM RDEVTYPC,CLASGRAF GRAPHIC TERMINAL (327X) ? HRC101DK 00162190 BZ NOTTYP32 NO, TRY NEXT TYPE HRC101DK 00162380 TM RDEVTYPE,TYP3277+TYP3278 IS IT A 3277/3278 ? HRC101DK 00162570 BZ DIA707 NO, SEND NOT SUPPORTED MSG. HRC101DK 00162760 B DIALSWP YES, GO DIAL @VA08433 00163400 SPACE 00164000 NOTTYP32 EQU * @VA08433 00164500 MVI SAVEWRK1,STRTSTP TRY FOR 270X TERMINAL NEXT @V240820 00165000 CLI RDEVTYPC,CLASTERM START-STOP TERMINAL ? @V240820 00166000 BE DIALTYP YES - GET ADAPTER TYPE @V240820 00167000 SPACE 00168000 MVI SAVEWRK1,NCPTERM MUST BE AN NCP TERMINAL @V240820 00169000 BAL R14,DIALNIC GET ADDRESS OF NICBLOK (NCP TERM)@V240820 00170000 USING NICBLOK,R15 @V240820 00171000 SH R15,=AL2(NICSIZE*8) BACK UP TO PREVIOUS NICBLOK @V240820 00172000 TM NICTYPE,NICLINE THIS MUST BE THE LINE BLOCK @V240820 00173000 BZ BADSWCH NO -- CAN'T SWITCH MULTIDROP@V240820 00174000 TM NICSTAT,NICSWEP IS THE LINE SWITCHABLE ? @V240820 00175000 BZ BADSWCH NO -- CANNOT USE 'DIAL' @V240820 00176000 LH R1,NICEPAD CHECK OUT THE EMULATOR ADDRESS @V240820 00177000 CALL DMKSCNRU TRY TO FIND REAL DEVICE BLOCKS @V240820 00178000 BC 4+2,BADSWCH CHANNEL OR CTL UNIT NOT FOUND @V240820 00179000 BC 8,DIALNCP DEVICE BLOCK IS ALREADY ACTIVE @V240820 00180000 L R6,SAVEWRK8 RECOVER BASE RDEVBLOK ADDRESS @V240820 00181000 ICM R1,15,RDEVEPDV TEST FOR DYNAMIC RDEVBLOK CHAIN @V240820 00182000 BZ BADSWCH NONE AVAILABLE -- ERROR @V240820 00183000 ST R1,SAVEWRK7 SAVE THE DUMMY RDEVBLOK ADDRESS @V240820 00184000 L R1,RDEVEPDV-RDEVBLOK(,R1) REMOVE IT FROM CHAIN @V240820 00185000 ST R1,RDEVEPDV . . . @V240820 00186000 OI SAVEWRK1,DYNABLK DYNAMIC BLOCK IS RESERVED @V240820 00187000 EJECT 00188000 DIALNCP EQU * CHECK OUT INTERFACE ADAPTER TYPE @V240820 00189000 L R15,SAVEWRK9 RECOVER NICBLOK ADDRESS @V240820 00190000 LA R5,TYPIBM1 ASSUME IT'S A 2741 OR 1050 @V240820 00191000 TM NICTYPE,NICCIBM SELECTRIC-BASED TERMINAL ? @V240820 00192000 BO DIALSWP YES - GUESS WAS CORRECT @V240820 00193000 LA R5,TYPTELE2 MUST BE A TELEGRAPH ADAPTER @V240820 00194000 B DIALSWP . . . @V240820 00195000 DROP R15 @V240820 00196000 SPACE 2 00197000 DIALTYP EQU * GET ADAPTER TYPE FOR 270X TERM @V240820 00198000 CLI RDEVTYPE,TYPBSC IS THIS A 3270 REMOTE LINE @VM01092 00199000 BE DIA707 YES, SEND NOT SUPPORTED MSG. @VM01092 00200000 CLI RDEVTYPE,TYP3210 @VA05138 00200300 BE DIA707 @VA05138 00200600 IC R5,RDEVTYPE PICK UP THE DEVICE TYPE @V240820 00201000 N R5,F240 HIGH-ORDER FOUR BITS = ADAPTER @V240820 00202000 DROP R6 @V240820 00203000 SPACE 2 00204000 DIALSWP EQU * CHECK FOR ADDITIONAL OPERAND @V240820 00205000 BAL R14,SWPUSER SWITCH TO DIAL-ED VMBLOK @V240820 00206000 OI SAVEWRK1,FIRSTAD FORCE USE OF 'REMOTE' SLOTS @V240820 00207000 LA R6,DIALNAD RETURN IF NO OPERAND @V240820 00208000 BAL R10,SCANCVT SCAN FOR ADDRESS AND CONVERT IT @V240820 00209000 USING VDEVBLOK,R8 @V240820 00210000 SPACE 00211000 TM SAVEWRK1,GRAPHIC DIAL VIA GRAPHIC TERMINAL ? @V240820 00212000 BZ DIALINE NO -- CHECK ADAPTER TYPE @V240820 00213000 TM VDEVTYPC,CLASGRAF CORRECT VIRTUAL DEVICE TYPE HRC101DK 00214590 BZ BADVADD NO -- ERROR HRC101DK 00215180 TM VDEVTYPE,TYP3277+TYP3278 MUST BE A 3277/3278 HRC101DK 00215770 BZ BADVADD NO -- HRC101DK 00216360 TM VDEVFLAG,VDEVDIAL IS IT AVAILABLE? @VA05772 00217100 BO LINBUSY SO SORRY @VA05772 00217200 TM VDEVSTAT,VDEVDED ALREADY IN USE ? @V200820 00218000 BO LINBUSY YES - ERROR @V200820 00219000 B DIALGOT LOOKS O.K. FROM HERE @V200820 00220000 SPACE 2 00221000 DIALINE EQU * DIAL FROM START/STOP TERMINAL @V200820 00222000 CLI VDEVTYPC,CLASTERM TERMINAL TYPE DEVICE ? @V200820 00223000 BNE BADVADD NO @V200820 00224000 CLM R5,1,VDEVTYPE CORRECT ADAPTER TYPE ? 00225000 BNE BADVADD NO 00226000 TM VDEVFLAG,VDEVDIAL IS THIS LINE IS USE ? 00227000 BO LINBUSY YES 00228000 TM VDEVFLAG,VDEVENAB IS IT ENABLED ? 00229000 BZ NOLINES LINE IS NOT AVAILABLE 00230000 B DIALGOT EVERYTHING IS ALL RIGHT 00231000 EJECT 00232000 DIALNAD EQU * FIND AN ENABLED VIRTUAL LINE 00233000 LA R14,2(0) BXLE INDEX 00234000 LA R15,31(0) ... LIMIT 00235000 SLR R2,R2 VMCHTBL INDEX 00236000 DIALSCH EQU * SCAN VIRTUAL CHANNELS 00237000 LH R6,VMCHTBL(R2) FIND A CHANNEL 00238000 LTR R6,R6 ... 00239000 BM DLNXTCH NOT ACTIVE - TRY NEXT 00240000 A R6,VMCHSTRT ADD IN CHANNEL BASE 00241000 USING VCHBLOK,R6 @V240820 00242000 SLR R3,R3 VCHCUTBL INDEX 00243000 DIALSCU EQU * SCAN VIRTUAL CONTROL UNITS 00244000 LH R7,VCHCUTBL(R3) FIND A CONTROL UNIT 00245000 LTR R7,R7 ... 00246000 BM DLNXTCU NOT ACTIVE - TRY NEXT 00247000 A R7,VMCUSTRT ADD IN CONTROL-UNIT BASE 00248000 USING VCUBLOK,R7 @V240820 00249000 SLR R4,R4 VCUDVTBL INDEX 00250000 DIALSDV EQU * SCAN VIRTUAL DEVICES 00251000 LH R8,VCUDVTBL(R4) FIND A DEVICE 00252000 LTR R8,R8 ... 00253000 BM DLNXTDV NOT ACTIVE - TRY NEXT 00254000 AL R8,VMDVSTRT ADD IN DEVICE BASE 00255000 USING VDEVBLOK,R8 @V240820 00256000 SPACE 00257000 TM VDEVSTAT,VDEVDED IS IT DEDICATED ?? @V200730 00258000 BO DLNXTDV YES, KEEP LOOKING @V200730 00259000 SPACE 00260000 TM SAVEWRK1,GRAPHIC DIAL VIA GRAPHIC TERMINAL ? @V240820 00261000 BZ DIALTRM NO -- MUST BE TERMINAL TYPE @V240820 00262000 TM VDEVTYPC,CLASGRAF IS THIS A GRAPHIC DEVICE ? HRC101DK 00263590 BZ DLNXTDV NO -- SKIP TO NEXT DEVICE HRC101DK 00264180 TM VDEVTYPE,TYP3277+TYP3278 3277 OR 3278 ? HRC101DK 00264770 BZ DLNXTDV NOPE - CONTINUE HRC101DK 00265360 TM VDEVFLAG,VDEVDIAL IS IT AVAILABLE? @VA05772 00266100 BO DLNXTDV SO SORRY @VA05772 00266200 B DIALGOT FOUND THE VIRTUAL DEVICE @V200820 00267000 SPACE 00268000 DIALTRM EQU * CHECK FOR AVAILABLE TERMINAL @V200820 00269000 CLI VDEVTYPC,CLASTERM TERMINAL-CLASS UNIT? @V200820 00270000 BNE DLNXTDV NO - CONTINUE 00271000 CLM R5,1,VDEVTYPE CORRECT ADAPTER TYPE? 00272000 BNE DLNXTDV NO - CONTINUE 00273000 TM VDEVFLAG,VDEVENAB+VDEVDIAL IS LINE AVAILABLE @V240820 00274000 BM DIALGOT YES - TAKE IT AWAY @V240820 00275000 SPACE 00276000 DLNXTDV BXLE R4,R14,DIALSDV ... DEVICES 00277000 DLNXTCU BXLE R3,R14,DIALSCU ... CONTROL UNITS 00278000 DLNXTCH BXLE R2,R14,DIALSCH ... CHANNELS 00279000 B NOLINES NO LINES AVAILABLE 00280000 EJECT 00281000 DIALGOT EQU * FOUND AN AVAILABLE LINE 00282000 OI VDEVFLAG,VDEVDIAL THIS LINE NOW IN USE 00283000 LH R1,VDEVADD BUILD VIRTUAL DEVICE ADDRESS @V240820 00284000 AH R1,VCUADD . . . @V240820 00285000 AH R1,VCHADD . . . @V240820 00286000 STH R1,SAVEWRK2+2 SAVE IT FOR LATER USE @V240820 00287000 CALL DMKCVTBH CONVERT IT FOR MESSAGES @V240820 00288000 ICM R1,8,BLANKS INSERT A BLANK HIGH-ORDER @V240820 00289000 ST R1,SAVEWRK4 PUT IT DOWN HERE @V240820 00290000 BAL R14,SWPCALL BACK TO CALLER'S VMBLOK 00291000 SPACE 00292000 USING RDEVBLOK,R8 USE THE RDEVBLOK FOR A WHILE 00293000 L R8,VMTERM RDEVBLOK ADDRESS TO GR8 @V240820 00294000 LA R0,MSGSIZE MESSAGE BUFFER 00295000 CALL DMKFREE ... 00296000 LR R4,R1 @V200820 00297000 ST R4,SAVEWRK6 SAVE THE BUFFER ADDRESS @V240820 00298000 OI SAVEWRK1,MSGFRET REMEMBER TO RELEASE BUFFER @V240820 00299000 USING MSGDIAL,R4 @V200820 00300000 MVI MSGDIAL,X'40' CLEAR THE BUFFER 00301000 MVC MSGDIAL+1(MSGSIZE*8-1),MSGDIAL 00302000 TM SAVEWRK1,NCPTERM DIAL THROUGH THE 370X NCP ? @V240820 00303000 BO DIALMSG YES - SET UP MESSAGE HEADER @V240820 00304000 TM RDEVADD,RDEVLDEV Is this an LDEV? HRC065DK 00304100 BO DIALDEV Yes HRC065DK 00304200 SPACE 00305000 CALL DMKSCNRN GET DEVICE NAME @V200730 00306000 ST R1,MSGDIAL SET DEVICE NAME IN MESSAGE @V240820 00307000 CALL DMKSCNRD GET REAL ADDRESS IN 'CCU' FORM @V240820 00308000 LR R6,R1 SAVE IN GR6 FOR LATER USE @V240820 00309000 CALL DMKCVTBH 00310000 STCM R1,B'0111',MSGRADD THIS IS FOR THE OPERATOR 00311000 B DIALSND GO FINISH OFF THE MESSAGE @V240820 00312000 DIALDEV EQU * HRC065DK 00312100 LH R1,RDEVADD Get the LDEV address HRC065DK 00312200 N R1,F4095 Keep only the dev num HRC065DK 00312300 CALL DMKCVTBH Make it displayable HRC065DK 00312400 STCM R1,7,MSGRADD Put dev addr in message HRC065DK 00312500 MVI MSGRADD-1,C'L' Move in LDEV indicator HRC065DK 00312600 MVC MSGDIAL(3),=CL3'GRF' Use short GRAF name HRC065DK 00312700 B DIALSND Go display msg HRC065DK 00312800 EJECT 00313000 DIALMSG EQU * FORMAT MSG FOR NCP TERMINAL @V240820 00314000 LH R1,SAVEWRK1+2 TERMINAL RESOURCE REFERENCE @V240820 00315000 CALL DMKCVTBH CONVERT IT FOR OUTPUT @V240820 00316000 L R0,=C'DEV ' NCP TERMINAL IS A 'DEV' @V240820 00317000 STM R0,R1,MSGDIAL SET TYPE, RADDR IN MESSAGE @V240820 00318000 SPACE 00319000 DIALSND EQU * @V240820 00320000 MVC MSGFLD1(10),=C'DIALED TO ' 00321000 L R1,SAVEWRK5 VMBLOK FOR DIAL-ED SYSTEM @V240820 00322000 MVC MSGUSER(8),VMUSER-VMBLOK(R1) MOVE IN USERID @V240820 00323000 MVC MSGVADD(3),SAVEWRK4+1 THIS IS FOR THE USER @V240820 00324000 TM SAVEWRK1,GRAPHIC GRAPHICS DEVICE ? @VA09164 00324200 BNO NOTGR NO @VA09164 00324400 OI RDEVSTA3,RDEVDIIP DO NOT ALLOW ATTN @VA09164 00324600 NOTGR EQU * @VA09164 00324800 LA R0,MSGVADD+4-MSGFLD1 LENGTH OF USER MSG 00325000 LA R1,MSGFLD1 00326000 CALL DMKQCNWT,PARM=0,AFFINITY WRITE MESSAGE & WAIT @V407510 00327100 SPACE 00328000 CH R2,=H'12' LINE DROP WHILE TYPING ? 00329000 BE UNDIAL YES - GO NO FURTHER 00330000 TM SAVEWRK1,NCPTERM DIAL VIA THE 370X NCP/PEP ? @V240820 00331000 BO DIALPEP YES - SWITCH LINE TO EP-MODE@V240820 00332000 OI VMMLVL2,VMMDIAL NO MORE MESSAGES TO TERMINAL@VA11241 00332010 CALL DMKQCNSY SYNCHRONIZE THE TERMINAL @VA11241 00332020 SPACE 00333000 ICM R10,15,RDEVAIOB IS THERE AN ACTIVE IOBLOK ? @V240820 00334000 BNZ DIALSIO YES - STEAL IT @V240820 00335000 LA R0,IOBSIZE WE NEED AN IOBLOK NOW @V200820 00336000 CALL DMKFREE . . . @V200820 00337000 LR R10,R1 @V200820 00338000 USING IOBLOK,R10 @V200820 00339000 XC 0(IOBSIZE*8,R10),0(R10) CLEAR IT @V200820 00340000 STH R6,IOBRADD SET REAL DEVICE ADDRESS @V200820 00341000 MVI IOBFLAG,IOBCP CP-GENERATED I/O @V200820 00342000 ST R10,IOBLINK FORCE LINK TO ITSELF @V200820 00343000 DIALSIO EQU * SETUP REMAINDER OF IOBLOK FIELDS @V200820 00345000 LA R1,DMKDIAIR STEAL THE INTERRUPT @VA05089 00346000 ST R1,IOBIRA ...TO CLEAR UP ACTIVE I/O 00347000 ST R11,IOBUSER DON'T LOSE THE VMBLOK, EITHER 00348000 ST R13,IOBMISC PRESERVE THE SAVEAREA 00349000 TM SAVEWRK1,GRAPHIC GRAPHIC DEVICE DIALING ? @V240820 00350000 BO SKIPHIO YES - GO FINISH CONNECTION @V240820 00351000 ST R10,RDEVAIOB CONNECT IOBLOK TO RDEVBLOK @VA13362 00351100 CALL DMKIOSHA RESET ACTIVE I/O FOR THE LINE @V240820 00352000 GOTO DMKDSPCH ...UNTIL THE INTERRUPT COMES IN 00353000 DROP R4,R6,R7,R8 @V240820 00354000 EJECT 00355000 USING DMKDIAIR,R12 ADDRESSABILITY FROM DMKDSPCH @VA05089 00356000 DMKDIAIR DS 0D INTERRUPT RETURN ADDRESS @VA05089 00357000 SL R12,=A(DMKDIAIR-DMKDIA) ADJUST TO BASE @VA05089 00358000 USING DMKDIA,R12 NORMAL ADDRESSABILITY AGAIN 00359000 L R13,IOBMISC GET MY SAVEAREA BACK 00360000 DIALIOB EQU * @V200820 00361000 L R1,IOBIOER GET ERROR BLOK IF ANY 00362000 LTR R1,R1 TEST FOR ERROR 00363000 BZ FRTIOB NONE, CONT 00364000 LA R0,IOERSIZE GET SIZE 00365000 USING IOERBLOK,R1 00366000 AH R0,IOEREXT ADD EXTRA SIZE (IF ANY) OF IOERBLOK 00367000 CALL DMKFRET FRET 00368000 FRTIOB DS 0H 00369000 LR R1,R10 00370000 LA R0,IOBSIZE 00371000 CALL DMKFRET RELEASE THE IOBLOK 00372000 L R8,SAVEWRK8 DIALING RDEVBLOK ADDRESS @V240820 00373000 CALL DMKQCNCL FLUSH ANY CONTASK STACK @V240820 00374000 B SKIPHIO GO COMPLETE DIAL-ING 00375000 DROP R1,R10 @V240820 00376000 EJECT 00377000 USING RDEVBLOK,R8 @V240820 00378000 DIALPEP EQU * SWITCH LINE MODE FOR PEP DIAL @V240820 00379000 L R9,SAVEWRK9 TERMINAL NICBLOK ADDRESS @V240820 00380000 USING NICBLOK,R9 . . . @V240820 00381000 OI NICSTAT,NICDISA STOP ACCEPTING CONTASK'S @V240820 00382000 L R4,RDEVCON CURRENT CONTASK STACK, IF ANY @V240820 00383000 MVC RDEVCON(4),NICQPNT MOVE TASK CHAIN TO RDEVBLOK @V240820 00384000 XC NICQPNT(4),NICQPNT CLEAR THE NICBLOK CHAIN @V240820 00385000 CALL DMKQCNCL FLUSH THE CONTASK STACK FIRST @V240820 00386000 ST R4,RDEVCON RESTORE PREVIOUS CONTASK CHAIN @V240820 00387000 LA R0,CRESDQ RESET DEVICE QUEUE IN THE 370X @V240820 00388000 BAL R10,PEPCNTL ISSUE COMMAND, WAIT FOR RESPONSE @V240820 00389000 LA R0,CRESIMD RESET IMMEDIATE FOR ACTIVE I/O @V240820 00390000 BAL R10,PEPCNTL ISSUE COMMAND, WAIT FOR IT @V240820 00391000 LA R0,CCDESMD COPY DEVICE DESTINATION MODE @V240820 00392000 CALL DMKRNHND,PARM=0 WAIT FOR THE RETURNED DATA @V240820 00393000 BNZ UNDIAL BAIL OUT - SOMETHING WENT WRONG @V240820 00394000 LR R4,R1 MINI-CONTASK TO GR4 @V240820 00395000 USING CONCCW3,R4 . . . @V240820 00396000 CLI CONSYSR,X'60' COMPLETED SUCCESSFULLY ? @V240820 00397000 BNE NCPFAIL NO -- RELEASE STORAGE AND EXIT @V240820 00398000 NI CONDATA+1,255-X'02' TURN OFF MONITOR MODE FLAG @V240820 00399000 LH R2,CONDCNT LENGTH OF DESTINATION MODE DATA @V240820 00400000 LA R1,CONDATA POINT TO THE DATA FIELD @V240820 00401000 LA R0,CSETDSM SET DEVICE DESTINATION MODE @V240820 00402000 CALL DMKRNHND SEND COMMAND, WAIT FOR RESPON@V240820 00403000 BNZ NCPFAIL BAIL OUT NOW @V240820 00404000 BAL R10,FRTMINI RELEASE THE PREVIOUS RESPONSE @V240820 00405000 LR R4,R1 CURRENT RESPONSE TO GR4 @V240820 00406000 CLI CONSYSR,X'60' SET MODE COMPLETED O.K. ? @V240820 00407000 BNE NCPFAIL NOPE - BAIL OUT @V240820 00408000 BAL R10,FRTMINI RELEASE THE MINI-CONTASK @V240820 00409000 MVC NICUSER(4),ASYSVM RESET NICBLOK VMBLOK PTR @V240820 00410000 OI NICSTAT,NICDISA TEMPORARILY OFFLINE @V240820 00411000 NI NICFLAG,255-NICSESN NO ACTIVE USER @V240820 00412000 SH R9,=AL2(NICSIZE*8) BACK UP TO THE LINE NICBLOK @V240820 00413000 TM NICSTAT,NICLTRC IS LINE TRACE ACTIVE ? @V240820 00414000 BZ DIALSWT NO -- TRY THE MODE SWITCH @V240820 00415000 LA R0,CTRMLTR TERMINATE NCP LINE TRACE @V240820 00416000 CALL DMKRNHND,PARM=0 ISSUE THE CONTROL COMMAND @V240820 00417000 BNZ DROPUSR BAIL OUT NOW @V240820 00418000 BAL R10,FRETASK RELEASE THE RESPONSE AREA @V240820 00419000 NI NICSTAT,255-NICLTRC LINE TRACE NO LONGER ACTIVE @V240820 00420000 EJECT 00421000 DIALSWT EQU * @V240820 00422000 LA R0,CSWLMEP SWITCH LINE MODE TO EMULATION @V240820 00423000 CALL DMKRNHND,PARM=0 WAIT FOR COMPLETION @V240820 00424000 BNZ DROPUSR BAIL OUT IF THE NCP DIED @V240820 00425000 LR R4,R1 RESPONSE AREA TO GR4 @V240820 00426000 CLI CONSYSR,X'60' WAS THE MODE SWITCH SUCCESSFUL ? @V240820 00427000 BE *+8 YES - TRULY AMAZING ! @V240820 00428000 OI SAVEWRK1,EPABORT ABORT THE CONNECTION ASAP @V240820 00429000 BAL R10,FRTMINI RELEASE THE RESPONSE CONTASK @V240820 00430000 SPACE 00431000 OI NICSTAT,NICEPMD INTERFACE NOW AN E.P. LINE @V240820 00432000 OI RDEVFLAG,RDEVEPLN EMULATOR LINE NOW IN USE @V240820 00433000 LH R1,NICEPAD EMULATION SUB-CHANNEL ADDRESS @V240820 00434000 CALL DMKSCNRU LOCATE RCHBLOK, RCUBLOK, ETC. @V240820 00435000 BZ SETRDEV DEVICE BLOCK ALREADY CONNECTED @V240820 00436000 L R8,SAVEWRK7 RESERVED DYNAMIC RDEVBLOK @V240820 00437000 USING RCHBLOK,R6 @V240820 00438000 USING RCUBLOK,R7 @V240820 00439000 SPACE 00440000 LA R2,X'00F8' MASK FOR CONTROL UNIT ADDRESS @V240820 00441000 N R2,NICEPAD-2 EXTRACT CONTROL UNIT ADDRESS @V240820 00442000 SRL R2,2(0) SHIFT FOR RCHCUTBL INDEX @V240820 00443000 LH R7,RCHCUTBL(R2) DISPLACEMENT TO RCUBLOK @V240820 00444000 LTR R7,R7 IS THIS ONE AN ACTIVE SLOT ? @V240820 00445000 BNM *+8 YES - O.K. TO INSERT DEVICE @V240820 00446000 LH R7,RCHCUTBL-2(R2) BACK UP TO PREVIOUS SLOT @V240820 00447000 AL R7,ARIOCU GR7 = PHYSICAL CONTROL UNIT BLOCK@V240820 00448000 LA R2,X'000F' MASK FOR DEVICE ADDRESS ALONE @V240820 00449000 N R2,NICEPAD-2 EXTRACT THE DEVICE ADDRESS @V240820 00450000 STH R2,RDEVADD SET THE RDEVBLOK ADDRESS FIELD @V240820 00451000 SLL R2,1(0) SHIFT FOR RCUDVTBL INDEX @V240820 00452000 LR R1,R8 RDEVBLOK ADDRESS TO GR1 @V240820 00453000 SL R1,ARIODV COMPUTE DISPLACEMENT TO RDEVBLOK @V240820 00454000 SRL R1,3(0) . . .IN DOUBLE-WORDS @V240820 00455000 STH R1,RCUDVTBL(R2) CONNECT THE RDEVBLOK @V240820 00456000 ST R7,RDEVCUA . . . @V240820 00457000 EJECT 00458000 SETRDEV EQU * SETUP RDEVBLOK FOR DYNAMIC DIAL @V240820 00459000 MVI RDEVSTAT,RDEVDED DEVICE IS NOW DEDICATED @V240820 00460000 MVI RDEVFLAG,RDEVEPMD LINE SWITCHED FROM NCP MODE @V240820 00461000 MVI RDEVTYPC,CLASTERM TERMINAL CLASS DEVICE @V240820 00462000 NI SAVEWRK1,255-DYNABLK DYNAMIC BLOCK IN USE @V240820 00463000 L R4,SAVEWRK8 370X BASE RDEVBLOK TO GR4 @V240820 00464000 ST R8,SAVEWRK8 ACTUAL RDEVBLOK TO SAVEWRK8 @V240820 00465000 MVC RDEVCYL(2),NICNAME SAVE LINE RESOURCE I.D. @V240820 00466000 L R9,SAVEWRK9 TERMINAL NICBLOK ADDRESS AGAIN @V240820 00467000 MVI RDEVTYPE,TYPIBM1 ASSUME IBM TYPE 1 ADAPTER @V240820 00468000 TM NICTYPE,NICTELE TELEGRAPH TERMINAL TYPE ? @V240820 00469000 BZ *+8 NO -- CORRECT AS IS @V240820 00470000 MVI RDEVTYPE,TYPTELE2 SET TO TELEGRAPH TERMINAL @V240820 00471000 LR R8,R4 BASE RDEVBLOK TO GR8 @V240820 00472000 CALL DMKSCNRD GET 'CCU' ADDRESS IN GR1 @V240820 00473000 L R8,SAVEWRK8 BACK TO DYNAMIC RDEVBLOK @V240820 00474000 STH R1,RDEVBASE SET THE BASE ADDRESS @V240820 00475000 TM SAVEWRK1,EPABORT WAS THE SWITCH SUCCESSFUL ? @V240820 00476000 BZ SKIPHIO YES - O.K. TO CONTINUE @V240820 00477000 BAL R9,FRETVMB DUMP THE CALLER'S VMBLOK @V240820 00478000 L R1,SAVEWRK5 GET ADDRESS OF DIALED VMBLOK @V407510 00479100 SWTCHVM SWITCH TO DIALED SYSTEM @V407510 00479200 ST R11,SAVER11 DON'T RELOAD OLD VMBLOK ADDRESS @V240820 00480000 LH R1,SAVEWRK2+2 VIRTUAL LINE ADDRESS @V240820 00481000 CALL DMKSCNVU RE-ACCESS THE VIRTUAL BLOCKS @V240820 00482000 USING VDEVBLOK,R8 @V240820 00483000 MVC VDEVREAL(4),SAVEWRK8 SET VDEVREAL CORRECTLY @V240820 00484000 CALL DMKDIBDR DROP THE DIALED CONNECTION @VA13704 00485000 OI VDEVFLAG,VDEVENAB LINE IS STILL ENABLED @V240820 00486000 B DIALEXT RETURN TO DMKCFM - WE BLEW IT @V240820 00487000 DROP R8 @V240820 00488000 EJECT 00489000 PEPCNTL EQU * ISSUE CONTROL COMMAND FOR PEP @V240820 00490000 CALL DMKRNHND,PARM=0 EXECUTE THE COMMAND @V240820 00491000 BNZ UNDIAL BAIL OUT - SOMETHING WENT WRONG @V240820 00492000 B FRETASK FRET THE RESPONSE CONTASK @V240820 00493000 SPACE 00494000 FRTMINI EQU * RELEASE THE MINI-CONTASK @V240820 00495000 ST R1,BALR1 SAVE REGISTER ONE AT ENTRY @V240820 00496000 LTR R1,R4 IS THERE A MINI-TASK TO FRET ? @V240820 00497000 BZ FRETRET NO -- JUST EXIT @V240820 00498000 FRETASK EQU * @V240820 00499000 LH R0,0(0,R1) SIZE OF MINI-TASK IN DBL-WDS @V240820 00500000 CALL DMKFRET RETURN THE FREE STORAGE @V240820 00501000 SLR R4,R4 CLEAR MINI-TASK POINTER REGISTER @V240820 00502000 FRETRET EQU * @V240820 00503000 L R1,BALR1 RESTORE REGISTER R1 @V240820 00504000 BR R10 . . . @V240820 00505000 SPACE 2 00506000 DROPUSR EQU * GET RID OF THE DIALING USER @V240820 00507000 BAL R9,FRETVMB RELEASE CALLER'S VMBLOK @V240820 00508000 NCPFAIL EQU * RELEASE STORAGE AND BAIL OUT @V240820 00509000 BAL R10,FRTMINI RELEASE MINI-CONTASK RESPONSE @V240820 00510000 SPACE 00511000 UNDIAL EQU * THE DIAL-ING USER QUIT BEFORE DIAL WAS COMPLETE 00512000 L R1,SAVEWRK5 GET DIALED VMBLOK @V407510 00513100 SWTCHVM SWITCH TO DIALED SYSTEM @V407510 00513200 ST R11,SAVER11 DO NOT RELOAD OLD VMBLOK ADDRESS 00514000 TM SAVEWRK1,MSGFRET IS THERE A MESSAGE BUFFER ? @V240820 00515000 BZ UNDIALL NO -- DON'T TRY TO FRET IT @V240820 00516000 L R1,SAVEWRK6 MESSAGE BUFFER ADDRESS @V240820 00517000 LA R0,MSGSIZE ...SIZE 00518000 CALL DMKFRET RELEASE THE BUFFER 00519000 UNDIALL EQU * @V240820 00520000 LH R1,SAVEWRK2+2 RECOVER VIRTUAL DEVICE ADDRESS @V240820 00521000 CALL DMKSCNVU LOCATE VDEVBLOK AGAIN 00522000 BNZ DLABORT SKIP RESET IF BLOCK NOT FOUND @V240820 00523000 NI VDEVFLAG-VDEVBLOK(R8),255-VDEVDIAL ABORT DIAL @V240820 00524000 DLABORT EQU * RELEASE DYNAMIC RDEVBLOK, IF ANY @V240820 00525000 TM SAVEWRK1,DYNABLK DID WE RESERVE AN RDEVBLOK ?@V240820 00526000 BZ DIALOUT NO -- JUST EXIT NOW @V240820 00527000 L R8,SAVEWRK8 DIALING RDEVBLOK (FROM VMTERM) @V240820 00528000 USING RDEVBLOK,R8 @V240820 00529000 L R1,SAVEWRK7 RESERVED DYNAMIC RDEVBLOK ADDRESS@V240820 00530000 SWITCH SWITCH TO MAIN PROCESSOR @V407510 00530100 MVC RDEVEPDV-RDEVBLOK(4,R1),RDEVEPDV ADD TO CHAIN @V240820 00531000 ST R1,RDEVEPDV . . . @V240820 00532000 B DIALOUT EXIT FORTHWITH @V240820 00533000 EJECT 00534000 SKIPHIO EQU * ADJUST NUMBER OF DIALED USERS, ETC. 00535000 L R2,=A(DMKSYSND) NUMBER OF DIALED USERS 00536000 L R1,0(0,R2) ... 00537000 LA R1,1(0,R1) INCREMENT 00538000 ST R1,0(0,R2) ... 00539000 CALL DMKCVTBD CONVERT FOR PRINTING 00540000 L R4,SAVEWRK6 MESSAGE BUFFER ADDRESS @V240820 00541000 USING MSGDIAL,R4 . . . @V240820 00542000 MVC MSGVADD(8),=C'DIALED= ' 00543000 STCM R1,B'0111',MSGNDIL 00544000 LA R0,MSGSIZE*8 00545000 LR R1,R4 @V200820 00546000 LA R3,MSGSIZE NO. OF DBL-WDS FOR FRET 00547000 CALL DMKQCNWT,PARM=NORET+DFRET+OPERATOR 00548000 NI SAVEWRK1,255-MSGFRET BUFFER IS NOW GONE @V240820 00549000 DROP R4 @V200820 00550000 SPACE 00551000 BAL R9,FRETVMB RELEASE DIAL-ER'S VMBLOK 00552000 L R1,ASYSVM POINT AT SYSTEM VMBLOK @VA11612 00552100 ST R1,RDEVUSER SET RDEVUSER TO SYSTEM @VA11612 00552200 L R1,SAVEWRK5 GET SAVED VMBLOK ADDRESS @V407510 00553100 SWTCHVM SWITCH TO SAVED VMBLOK @V407510 00553200 ST R11,SAVER11 DO NOT RE-LOAD VMBLOK OF DIAL-ER 00554000 L R9,SAVEWRK8 RDEVBLOK IN R9 @VA09164 00554400 USING RDEVBLOK,R9 @VA09164 00554900 NI RDEVSTA3,255-RDEVDIIP TURN OFF DIAL IN PROGRESS @VA09164 00555400 * FINISH UP VIRTUAL-TO-REAL LINKAGE 00556000 LH R1,SAVEWRK2+2 VIRTUAL ADDRESS OF DIALED LINE @V240820 00557000 SWITCH SWITCH TO MAIN PROCESSOR @V407510 00557100 CALL DMKSCNVU SCAN AGAIN JUST IN CASE 00558000 BNZ DIABORT DEVICE NO LONGER THERE @VA05115 00558500 USING VDEVBLOK,R8 00559000 OI RDEVSTAT,RDEVDED DEDICATED 00562000 ST R9,VDEVREAL VIRTUAL POINTER TO REAL @V240820 00563000 OI VDEVSTAT,VDEVDED DEVICE DEDICATED @V200730 00564000 ST R11,RDEVUSER REAL DEVICE USER 00565000 STH R1,RDEVATT REAL 'ATTACHED AS' ADDRESS 00566000 L R15,=A(DMKSYSCK) @VM08883 00567000 STCK 0(R15) STORE TOD CLOCK VALUE @VM08883 00568000 BC 12,CLOCKOK IS CLOCK FUNCTIONING? @VA04301 00568250 GOTO DMKCVTAB CLOCK DAMAGED...ABEND CVT001 @VA04301 00568500 CLOCKOK EQU * @VA04301 00568750 MVC RDEVTMAT,0(R15) REMEMBER TIME ATTACHED @VM08883 00569000 LH R1,RDEVTYPC FORCE EQUAL TYPES 00570000 STH R1,VDEVTYPC ... 00571000 TM SAVEWRK1,GRAPHIC GRAPHIC TERMINAL DIALING ? @V240820 00572000 BO GRAFDEV YES - DIFFERENT HANDLING @V240820 00573000 EJECT 00574000 USING IOBLOK,R10 @V240820 00575000 L R10,VDEVIOB ENABLE IOBLOK 00576000 LTR R10,R10 IS THERE AN IOB? @VA11314 00576100 BNZ IOBGOOD YES, CONTINUE ON @VA11314 00576200 CALL DMKDIBDR NO, USE DROP ROUTINE... @VA13704 00576300 B DIALOUT ... AND GET OUT. @VA11314 00576400 IOBGOOD DS 0H @VA11314 00576500 ST R11,IOBUSER MAKE SURE THIS IS CORRECT @V240820 00577000 LR R8,R9 REAL DEVICE BLOCK TO GR8 00578000 L R1,IOBRCAW ENABLE CCW ADDRESS FROM DMKDIASM @V240820 00579000 MVI 0(R1),X'01' CHANGE TO A WRITE CIRCLE-C @V240820 00580000 TM SAVEWRK1,NCPTERM DIALING FROM AN NCP LINE ? @V240820 00581000 BZ *+8 NO -- CORRECT AS IT STANDS @V240820 00582000 MVI 0(R1),X'27' THE NCP NEEDS A REAL ENABLE @V240820 00583000 CALL DMKIOSQR START REAL ENABLE 00584000 SPACE 2 00585000 DIALEXT EQU * DIALED CONNECTION IS COMPLETE @V240820 00586000 L R15,SAVERETN RETURN ADDRESS (IN DMKCFM) @V240820 00587000 LA R15,12(R15) SET TO RUN DIALED USER @V200730 00588000 ST R15,SAVERETN SET RETURN @V200730 00589000 DIALOUT EQU * @V240820 00590000 EXIT @V200730 00591000 EJECT 00592000 USING IOBLOK,R10 @V200730 00593000 GRAFDEV EQU * DEVICE END FROM VIRTUAL POWER-ON @V240820 00594000 ST R11,IOBUSER SET USER OF BLOK @V200730 00595000 L R1,=A(DMKVIOIN) INTERRUPT RETURN ADDRESS @V200730 00596000 ST R1,IOBIRA SET IT @V200730 00597000 LH R1,SAVEWRK2+2 VIRTUAL DEVICE ADDRESS @V240820 00598000 STH R1,IOBVADD SET VIRT ADDRESS @V200730 00599000 MVC IOBCSW(8),ZEROES CLEAR OUT THE CSW @V200820 00600000 MVI IOBCSW+4,DE DEVICE END FROM POWER ON @V200730 00601000 CALL DMKSTKIO STACK IOBLOK @V200730 00602000 SLR R0,R0 @V200820 00603000 ST R0,RDEVAIOB CLEAR IOBLOK PTR IN RDEVBLOK @V200820 00604000 L R1,RDEVAIRA TRQBLOK ADDRESS FOR 3277, 3066 @V240820 00605000 LTR R1,R1 IS THERE A TRQBLOK NOW ? @V240820 00606000 BZ DIALEXT NO -- JUST EXIT @V240820 00607000 LA R0,TRQBSIZE+CRTEXT EXTRA DBL-WD FOR GRAPHICS HRC101DK 00608490 CALL DMKFRET RETURN TRQBLOK TO FREE STORAGE @V240820 00609000 SLR R0,R0 @V240820 00610000 ST R0,RDEVAIRA CLEAR OUT TRQBLOK POINTER @V240820 00611000 B DIALEXT DIAL COMMAND IS COMPLETE @V240820 00612000 DROP R8,R9,R10 @V240820 00613000 DIABORT EQU * @VA05115 00613050 L R9,SAVEWRK8 DIALING REAL DEVICE BLOK @VA05115 00613100 USING RDEVBLOK,R9 @VA05115 00613150 LR R1,R10 ADDR OF IOBLOK @VA05115 00613200 LA R0,IOBSIZE SIZE OF IOBLOK @VA05115 00613250 CALL DMKFRET RETURN IOBLOK TO FREE STORAGE @VA05115 00613300 SLR R0,R0 CLEAR REG 0 @VA05115 00613350 ST R0,RDEVAIOB CLEAR ACTIVE IOB PTR @VA05115 00613400 L R1,RDEVAIRA TRQBLOK PTR @VA05115 00613450 LTR R1,R1 ANY THERE? @VA05115 00613500 BZ DIALOUT NO--JUST EXIT @VA05115 00613550 LA R0,TRQBSIZE+CRTEXT EXTRA-WD FOR GRAPHICS HRC101DK 00613610 CALL DMKFRET RETURN TRQBLOK TO FREE STORAGE @VA05115 00613650 SLR R0,R0 ZERO REG0 @VA05115 00613700 ST R0,RDEVAIRA CLEAR TRQBLOK PTR @VA05115 00613750 B DIALOUT EXIT @VA05115 00613800 DROP R9 @VA05514 00613850 SPACE 2 00614000 USING RDEVBLOK,R6 ADDRESSABILITY FROM EARLIER USE @V240820 00615000 DIALNIC EQU * FIND NICBLOK FOR AN NCP TERMINAL @V240820 00616000 LH R15,VMTRMID TERMINAL RESOURCE REFERENCE @V240820 00617000 STH R15,SAVEWRK1+2 SAVE IT HERE FOR LATER USE @V240820 00618000 N R15,F4095 STRIP OFF THE DEVICE CODE @V240820 00619000 MH R15,=AL2(NICSIZE*8) DISPLACEMENT TO THE NICBLOK @V240820 00620000 AL R15,RDEVNICL COMPUTE ACTUAL NICBLOK ADDRESS @V240820 00621000 ST R15,SAVEWRK9 SAVE ADDRESS FOR LATER USE @V240820 00622000 BR R14 . . . @V240820 00623000 DROP R6 @V240820 00624000 EJECT 00625000 * 00626000 * MESSAGE MODEL FOR USER AND OPERATOR RESPONSES 00627000 * 00628000 SPACE 00629000 MSGDIAL DSECT 00630000 DC C'LINE ' REAL DEVICE TYPE 00631000 MSGRADD DC C'XXX ' " " " ADDRESS 00632000 MSGFLD1 DC C'DIALED TO ' ACTIVITY CUE 00633000 MSGUSER DC C'$USERID$ ' DIAL-ED USER 00634000 MSGVADD DC C'XXX ' DIAL-ED VIRTUAL ADDRESS 00635000 ORG MSGVADD ...OR... 00636000 DC C'DIALED= ' OPERATOR INFO 00637000 MSGNDIL DC C'NNN' NO. OF DIALED USERS 00638000 ORG 00639000 MSGSIZE EQU (*-MSGDIAL+7)/8 BUFFER LENGTH 00640000 SPACE 2 00641000 * EQUATES USED IN 'SAVEWRK1' FLAG BYTE: @V240820 00642000 GRAPHIC EQU X'80' DIAL VIA GRAPHIC TERMINAL @V240820 00643000 STRTSTP EQU X'40' DIAL VIA 270X/EMULATOR TERMINAL @V240820 00644000 NCPTERM EQU X'20' DIAL VIA PEP/NCP TERMINAL @V240820 00645000 FIRSTAD EQU X'10' FIRST ADDRESS HAS BEEN SCANNED @V240820 00646000 DYNABLK EQU X'08' DYNAMIC RDEVBLOK IS RESERVED @V240820 00647000 MSGFRET EQU X'04' MESSAGE BUFFER IS IN USE @V240820 00648000 CTCWRAP EQU X'02' 'COUPLE' FOR TWO LOCAL CTCA'S @VA02003 00649000 EPABORT EQU X'01' SWITCH TO EP-MODE FAILED @V240820 00650000 SPACE 2 00651000 DMKDIA CSECT , RE-ENTER PROGRAM CSECT 00652000 EJECT 00653000 * 00893000 * REMOVE VMBLOK FROM CHAIN OF ACTIVE VMBLOKS 00894000 * RETURN VMBLOK TO FREE STORAGE 00895000 * 00896000 FRETVMB EQU * REMOVE + FRET VMBLOK 00897000 L R2,ASYSVM THIS IS THE CHAIN ANCHOR 00898000 CL R11,RUNUSER THIS IS EXTREMELY UNLIKELY 00899000 BNE FRETVM0 CHECK LASTUSER @V407510 00900100 ST R2,RUNUSER DON'T POINT AT FRET'ED BLOCK 00901000 B FRETVM1 START FREEING BLOK @V407510 00901100 FRETVM0 DS 0H @V407510 00901200 CL R11,LASTUSER SAME AS LASTUSER? @V407510 00901300 BNE FRETVM1 NO, START FREEING BLOK @V407510 00901400 ST R2,LASTUSER DON'T POINT AT FRET'ED BLOK @V407510 00901500 FRETVM1 EQU * HANDLE CHAIN ANCHOR PROBLEMS 00902000 L R3,VMPNT-VMBLOK(0,R2) FIRST USER AFTER ANCHOR 00903000 L R4,VMPNT USER AFTER OUR VMBLOK 00904000 CLR R4,R11 IF HE POINTS TO HIMSELF... 00905000 BNE FRETVM2 NO - GREAT 00906000 SLR R5,R5 ...ZERO ANCHOR BECAUSE NOBODY IS LEFT 00907000 B FRETVM3 ... 00908000 FRETVM2 EQU * NOW CHASE THE VMBLOK CHAIN 00909000 LR R5,R3 PREVIOUS BLOCK 00910000 L R3,VMPNT-VMBLOK(,R3) NEXT ONE... 00911000 CLR R3,R11 POINTED TO US THIS TIME ? 00912000 BNE FRETVM2 NO - KEEP CHASING 00913000 ST R4,VMPNT-VMBLOK(,R5) TAKE US OUT OF CHAIN 00914000 FRETVM3 EQU * NOW MOVE THE CHAIN ANCHOR JUST IN CASE 00915000 ST R5,VMPNT-VMBLOK(,R2) ...WE DELETED FIRST USER 00916000 XR R2,R11 EXCHANGE R11 & R2 @V4M0204 00917100 XR R11,R2 R11 = SYSTEM VMBLOK @V4M0204 00917200 XR R2,R11 R2 = VMBLOK TO BE FRET'D @V4M0204 00917300 CHARGE START CHARGE SYSTEM VMBLOK @V4M0204 00917400 L R1,VMDELAY-VMBLOK(,R2) @VA11836 00917410 LTR R1,R1 DO WE HAVE ONE? @VA08708 00917415 BZ FRETVM3A NO - DO NOT TRY TO FRET TRQ @VA08708 00917420 CLC TRQBFPNT-TRQBLOK(4,R1),ZEROES HAS THE TRQ BEEN @VA08708 00917425 * QUED? 00917430 BE FRETTRQ NO - GO FRET IT @VA08708 00917435 CALL DMKSCHRT YES - RESET IT THEN FRET IT @VA08708 00917440 FRETTRQ LA R0,TRQBSIZE LOAD TRQ SIZE FOR FRET @VA08708 00917445 CALL DMKFRET NOW GIVE IT BACK @VA08708 00917450 FRETVM3A EQU * @VA08708 00917455 L R1,VMDFTPNT-VMBLOK(,R2) GET DEFERRED POINTER @V4M0204 00917500 LTR R1,R1 DOES ONE EXIST? @V4M0204 00917600 BZ FRETVM4 NO, FRET VMBLOK @V4M0204 00917700 LA R0,CPEXSIZE GET SIZE OF DEFERRED BLOK @V4M0204 00917800 CALL DMKFRET FREE DEFERRED TASK BLOK @V4M0204 00917900 FRETVM4 DS 0H @V4M0204 00918000 LR R1,R2 GET ADDRESS OF VMBLOK @V4M0204 00918100 LA R0,VMBSIZE BLOCK SIZE = HUGE 00920000 MVI VMUSER-VMBLOK+7(R1),X'00' NULLIFY USERID @VA13441 00920500 CALL DMKFRET RELEASE THE VMBLOK 00921000 BR R9 RETURN TO CALLER 00923000 EJECT 01179000 SWPUSER EQU * SWITCH TO OBJECTIVE VMBLOK 01409000 ST R14,SAVEWRK6 SAVE R14 ACROSS CHARGE @V4M0116 01409050 CHARGE SWITCH,SAVEWRK5 CHARGE 'OTHER' VMBLOK @V407510 01410100 L R14,SAVEWRK6 RESTORE REG 14 @V4M0116 01410150 BR R14 01413000 SPACE 01414000 SWPCALL EQU * SWITCH TO CALLER'S VMBLOK 01415000 ST R14,SAVEWRK6 SAVE R14 ACROSS CHARGE @V4M0116 01415050 CHARGE SWITCH,SAVER11 CHARGE CALLER @V407510 01416100 L R14,SAVEWRK6 RESTORE REG 14 @V4M0116 01416150 BR R14 01419000 SPACE 2 01420000 SCANCVT EQU * SCAN AND CONVERT DEVICE ADDRESS @V240820 01421000 CALL DMKSCNFD SCAN FOR THE NEXT OPERAND @V240820 01422000 BNZR R6 ERROR EXIT IF NOT FOUND @V240820 01423000 CL R0,F3 THREE CHARACTERS MAXIMUM @V240820 01424000 BH INVVADD INVALID VADDR @V240820 01425000 CALL DMKCVTHB CONVERT ADDRESS TO BINARY @V240820 01426000 BNZ INVVADD CONVERT FAILED - INVALID @V240820 01427000 MAXDV R15 GET MAXIMUM VALID ADDRESS IN GR15@V240820 01428000 CLR R1,R15 IS THE DEVICE ADDRESS POSSIBLE ? @V240820 01429000 BH INVVADD NO -- KICK IT OUT @V240820 01430000 LR R6,R1 REMEMBER ADDRESS FOR DMKSCNVU @V240820 01431000 CALL DMKCVTBH RE-CONVERT IT FOR MESSAGES @V240820 01432000 ICM R1,8,BLANKS GET A HIGH-ORDER BLANK @V240820 01433000 TM SAVEWRK1,FIRSTAD IS THIS THE FIRST PASS ? @V240820 01434000 BO SCANTWO NO -- USE REMOTE SLOTS @V240820 01435000 OI SAVEWRK1,FIRSTAD REMEMBER THE FIRST PASS @V240820 01436000 STH R6,SAVEWRK2 SAVE 'LOCAL' DEVICE ADDRESS @V240820 01437000 ST R1,SAVEWRK3 SAVE EBCDIC EQUIVALENT OF ADDRESS@V240820 01438000 B SCANSCN TRY TO FIND THE VIRTUAL BLOCKS @V240820 01439000 SCANTWO EQU * SAVE VALUES FOR REMOTE DEVICE @V240820 01440000 STH R6,SAVEWRK2+2 SLOT FOR REMOTE VIRTUAL ADDRESS @V240820 01441000 ST R1,SAVEWRK4 SLOT FOR EBCDIC EQUIVALENT @V240820 01442000 SCANSCN EQU * FIND THE VIRTUAL BLOCKS @V240820 01443000 LR R1,R6 ADDRESS BACK TO GR1 @V240820 01444000 CALL DMKSCNVU SCAN FOR THE DEVICE @V240820 01445000 BNZ UNKNOWN DEVICE DOES NOT EXIST @V240820 01446000 BR R10 RETURN INTERNALLY @V240820 01447000 EJECT 01448000 UNKNWN2 EQU * DEV VADDR DOES NOT EXIST 01449000 LA R2,040(,0) MSG= DMKDIA040E 01450000 B VADONLY SET UP VARIABLE DATA 01451000 SPACE 01452000 VADONLY EQU * SET VARIABLE 'VADDR' 01455000 CALL DMKCVTBH CONVERT 01456000 STCM R1,B'0111',SAVEWRK2 01457000 LA R0,3 LENGTH 01458000 B MSGSEND 01459000 SPACE 01460000 NOUSRID EQU * USERID MISSING OR INVALID 01461000 LA R2,020(,0) MSG= DMKDIA020E 01462000 B MSGONLY NO EXTRA DATA NEEDED 01463000 SPACE 01464000 NOTLOGD EQU * USERID NOT LOGGED ON 01465000 MVC SAVEWRK2(8),BALRSAVE USERID LEFT BY 'SCNAU' 01466000 LA R0,8 DATA LENGTH 01467000 LA R2,045(,0) MSG= DMKDIA045E 01468000 B MSGSEND 01469000 ERROR66 EQU * Cant connect to host VM HRC065DK 01469100 LA R2,66 MSG=DMKDIA066E HRC065DK 01469200 B MSGONLY Go write the msg HRC065DK 01469300 SPACE 01470000 INVVADD EQU * VIRTUAL ADDRESS MISSING OR INVALID 01471000 LA R2,022(,0) MSG= DMKDIA022E 01472000 B MSGONLY NO EXTRA DATA NEEDED 01473000 SPACE 01474000 NOLINES EQU * NO LINES AVAILABLE ON USERID 01475000 LA R0,8 DATA LENGTH 01476000 LA R1,VMUSER ...USERID 01477000 LA R2,055(,0) MSG= DMKDIA055E 01478000 B MSGSEND+4 01479000 SPACE 01480000 LINBUSY EQU * LINE SPECIFIED IS BUSY 01485000 LA R2,056(,0) MSG= DMKDIA056E 01486000 VADDUSR EQU * SET VARIABLES 'VADDR USERID' 01487000 CALL DMKSCNVD GET DEVICE ADDRESS IN 'CCU' FORM 01488000 CALL DMKCVTBH CONVERT TO HEX 01489000 STCM R1,B'0111',SAVEWRK2 01490000 MVI SAVEWRK2+3,X'00' DELIMITER 01491000 MVC SAVEWRK3(8),VMUSER SECOND FIELD 01492000 LA R0,12 DATA LENGTH 01493000 B MSGSEND SEND ERROR MSG AND EXIT @VA03704 01494000 EJECT 01495000 BADSWCH EQU * DMKDIA098E MODE SWITCH IMPOSSIBLE@V240820 01496000 LH R1,SAVEWRK1+2 TERMINAL RESOURCE REFERENCE @V240820 01497000 CALL DMKCVTBH CONVERT IT FOR OUTPUT MSG @V240820 01498000 ST R1,SAVEWRK2 . . . @V240820 01499000 LA R0,4 DATA LENGTH @V240820 01500000 LA R2,098(0) MSG= DMKDIA098E @V240820 01501000 B MSGSEND SEND ERROR MESSAGE AND EXIT @V240820 01502000 SPACE 01503000 BADVADD EQU * VIRTUAL DEVICE IS NOT A LINE 01504000 LA R2,011(,0) MSG= DMKDIA011E 01505000 B USRVADD SET UP VARIABLE STRING 01506000 SPACE 01507000 UNKNOWN EQU * USERID VADDR DOES NOT EXIST 01508000 CH R1,SAVEWRK2 IS THIS THE LOCAL DEVICE ? @VA02009 01509000 BE UNKNWN2 YES - DIFFERENT MESSAGE @V240820 01510000 LA R2,047(,0) MSG= DMKDIA047E 01511000 USRVADD EQU * SET VARIABLES 'USERID VADDR' 01512000 MVC SAVEWRK2(8),VMUSER 01513000 MVI SAVEWRK4,X'00' DELIMITER 01514000 LA R0,12 01515000 B MSGSEND 01516000 DIA707 EQU * DMKDIA707E DIAL FUNCTION NOT... @VM01092 01517000 SR R0,R0 LENGTH OF TEXT @VM01092 01518000 LA R2,707(0) GET MESSAGE NUMBER @VM01092 01519000 B MSGSEND SEND ERROR MESSAGE AND EXIT @VM01092 01520000 SPACE 01521000 MSGONLY EQU * NO DATA TO BE ADDED TO MESSAGE 01522000 SLR R0,R0 01523000 SLR R1,R1 01524000 B MSGSEND+4 01525000 SPACE 01526000 MSGSEND EQU * SEND ERROR MSG TO USER 01527000 LA R1,SAVEWRK2 POINT TO START OF VARIABLE DATA 01528000 BAL R14,SWPCALL BACK TO CALLER'S VMBLOK 01529000 ICM R0,B'1110',DMKDIA+3 MODULE IDENTIFIER 01530000 ST R2,SAVER2 PASS RETURN CODE BACK TO DMKCFM @V240820 01531000 LA R14,707(0) @VA09464 01531100 CR R14,R2 DOES R2 CONTAIN 707 MESSAGE ? @VA09464 01531200 BNE MSGBLD NO, DON'T PUT'A' IN MESSAGE @VA09464 01531300 ICM R2,4,=X'C1' DMKDIA707A @VA09464 01531400 MSGBLD ICM R2,8,=X'80' RETURN HERE AFTER ERROR MESSAGE @VA09464 01532100 CALL DMKERMSG BUILD + TYPE ERROR MESSAGE 01533000 B DLABORT CHECK FOR CLEAN-UP WORK TO DO @V240820 01534000 EJECT 01535000 LTORG 01536000 EJECT 01537000 COPY VCTCA VIRTUAL CHANNEL-TO-CHANNEL ADAPTER BLOCKS 01538000 COPY TIMER @V200730 01539000 COPY NETWORK @V240820 01540000 COPY BTUCMD @V240820 01541000 COPY EQU 01542000 COPY DEVTYPES 01543000 PSA 01544000 COPY SAVE 01545000 COPY VMBLOK 01546000 COPY RBLOKS 01547000 COPY VBLOKS 01548000 COPY IOBLOKS 01549000 COPY IOER 01550000 END DMKDIA 01551000