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 <VADD> | 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 <VADD>" 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