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